Original Version

82 files changed, 17003 insertions, 0 deletions

diff --git a/src/fortran/blas/Makefile.am b/src/fortran/blas/Makefile.am
new file mode 100644
index 0000000..6b8b83d
--- /dev/null
+++ b/src/fortran/blas/Makefile.am
@@ -0,0 +1,86 @@
+##########
+### Sylvestre Ledru <sylvestre.ledru@inria.fr>
+### INRIA - Scilab 2006
+##########
+
+BLAS_FORTRAN_SOURCES = zrotg.f \
+zhpr2.f \
+zher2k.f \
+dspr.f \
+xerbla.f \
+dcopy.f \
+dsyr2k.f \
+zsymm.f \
+zhemm.f \
+dtbsv.f \
+dtrmm.f \
+dscal.f \
+ddot.f \
+dgbmv.f \
+dtpsv.f \
+dtrsv.f \
+dgemv.f \
+idamax.f \
+dzasum.f \
+zcopy.f \
+zher.f \
+drot.f \
+ztbsv.f \
+dasum.f \
+ztrmm.f \
+dsbmv.f \
+zscal.f \
+dswap.f \
+zdotc.f \
+zgbmv.f \
+ztpsv.f \
+zgemv.f \
+ztrsv.f \
+izamax.f \
+dspmv.f \
+dcabs1.f \
+dsymv.f \
+zswap.f \
+zdotu.f \
+zgerc.f \
+dznrm2.f \
+dtbmv.f \
+zdscal.f \
+dger.f \
+dnrm2.f \
+zhpr.f \
+daxpy.f \
+zhbmv.f \
+zhemv.f \
+dtrsm.f \
+dgemm.f \
+dspr2.f \
+dtpmv.f \
+zgeru.f \
+dtrmv.f \
+dsyrk.f \
+lsame.f \
+ztbmv.f \
+dsyr2.f \
+zhpmv.f \
+zsyr2k.f \
+zaxpy.f \
+zgemm.f \
+drotg.f \
+ztrsm.f \
+ztpmv.f \
+dsyr.f \
+zsyrk.f \
+ztrmv.f \
+zherk.f \
+dsymm.f \
+zher2.f
+
+instdir = $(top_builddir)/lib
+
+pkglib_LTLIBRARIES = libsciblas.la
+
+HEAD = $(top_builddir)/includes/blas.h
+
+libsciblas_la_SOURCES = $(HEAD) $(BLAS_FORTRAN_SOURCES)
+
diff --git a/src/fortran/blas/Makefile.in b/src/fortran/blas/Makefile.in
new file mode 100644
index 0000000..b265181
--- /dev/null
+++ b/src/fortran/blas/Makefile.in
@@ -0,0 +1,601 @@
+# Makefile.in generated by automake 1.11.1 from Makefile.am.
+# @configure_input@
+
+# Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
+# 2003, 2004, 2005, 2006, 2007, 2008, 2009  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@
+pkgincludedir = $(includedir)/@PACKAGE@
+pkglibdir = $(libdir)/@PACKAGE@
+pkglibexecdir = $(libexecdir)/@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 = src/fortran/blas
+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 =
+CONFIG_CLEAN_VPATH_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 = f=`echo $$p | sed -e 's|^.*/||'`;
+am__install_max = 40
+am__nobase_strip_setup = \
+  srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*|]/\\\\&/g'`
+am__nobase_strip = \
+  for p in $$list; do echo "$$p"; done | sed -e "s|$$srcdirstrip/||"
+am__nobase_list = $(am__nobase_strip_setup); \
+  for p in $$list; do echo "$$p $$p"; done | \
+  sed "s| $$srcdirstrip/| |;"' / .*\//!s/ .*/ ./; s,\( .*\)/[^/]*$$,\1,' | \
+  $(AWK) 'BEGIN { files["."] = "" } { files[$$2] = files[$$2] " " $$1; \
+    if (++n[$$2] == $(am__install_max)) \
+      { print $$2, files[$$2]; n[$$2] = 0; files[$$2] = "" } } \
+    END { for (dir in files) print dir, files[dir] }'
+am__base_list = \
+  sed '$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;s/\n/ /g' | \
+  sed '$$!N;$$!N;$$!N;$$!N;s/\n/ /g'
+am__installdirs = "$(DESTDIR)$(pkglibdir)"
+LTLIBRARIES = $(pkglib_LTLIBRARIES)
+libsciblas_la_LIBADD =
+am__objects_1 =
+am__objects_2 = zrotg.lo zhpr2.lo zher2k.lo dspr.lo xerbla.lo dcopy.lo \
+	dsyr2k.lo zsymm.lo zhemm.lo dtbsv.lo dtrmm.lo dscal.lo ddot.lo \
+	dgbmv.lo dtpsv.lo dtrsv.lo dgemv.lo idamax.lo dzasum.lo \
+	zcopy.lo zher.lo drot.lo ztbsv.lo dasum.lo ztrmm.lo dsbmv.lo \
+	zscal.lo dswap.lo zdotc.lo zgbmv.lo ztpsv.lo zgemv.lo ztrsv.lo \
+	izamax.lo dspmv.lo dcabs1.lo dsymv.lo zswap.lo zdotu.lo \
+	zgerc.lo dznrm2.lo dtbmv.lo zdscal.lo dger.lo dnrm2.lo zhpr.lo \
+	daxpy.lo zhbmv.lo zhemv.lo dtrsm.lo dgemm.lo dspr2.lo dtpmv.lo \
+	zgeru.lo dtrmv.lo dsyrk.lo lsame.lo ztbmv.lo dsyr2.lo zhpmv.lo \
+	zsyr2k.lo zaxpy.lo zgemm.lo drotg.lo ztrsm.lo ztpmv.lo dsyr.lo \
+	zsyrk.lo ztrmv.lo zherk.lo dsymm.lo zher2.lo
+am_libsciblas_la_OBJECTS = $(am__objects_1) $(am__objects_2)
+libsciblas_la_OBJECTS = $(am_libsciblas_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 = $(libsciblas_la_SOURCES)
+DIST_SOURCES = $(libsciblas_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@
+DUMPBIN = @DUMPBIN@
+ECHO_C = @ECHO_C@
+ECHO_N = @ECHO_N@
+ECHO_T = @ECHO_T@
+EGREP = @EGREP@
+EXEEXT = @EXEEXT@
+F77 = @F77@
+FFLAGS = @FFLAGS@
+FGREP = @FGREP@
+GREP = @GREP@
+INSTALL = @INSTALL@
+INSTALL_DATA = @INSTALL_DATA@
+INSTALL_PROGRAM = @INSTALL_PROGRAM@
+INSTALL_SCRIPT = @INSTALL_SCRIPT@
+INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@
+LD = @LD@
+LDFLAGS = @LDFLAGS@
+LIBMATH = @LIBMATH@
+LIBOBJS = @LIBOBJS@
+LIBS = @LIBS@
+LIBTOOL = @LIBTOOL@
+LIPO = @LIPO@
+LN_S = @LN_S@
+LTLIBOBJS = @LTLIBOBJS@
+MAINT = @MAINT@
+MAKEINFO = @MAKEINFO@
+MKDIR_P = @MKDIR_P@
+NM = @NM@
+NMEDIT = @NMEDIT@
+OBJDUMP = @OBJDUMP@
+OBJEXT = @OBJEXT@
+OTOOL = @OTOOL@
+OTOOL64 = @OTOOL64@
+PACKAGE = @PACKAGE@
+PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@
+PACKAGE_NAME = @PACKAGE_NAME@
+PACKAGE_STRING = @PACKAGE_STRING@
+PACKAGE_TARNAME = @PACKAGE_TARNAME@
+PACKAGE_URL = @PACKAGE_URL@
+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_DUMPBIN = @ac_ct_DUMPBIN@
+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@
+lt_ECHO = @lt_ECHO@
+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_build_prefix = @top_build_prefix@
+top_builddir = @top_builddir@
+top_srcdir = @top_srcdir@
+BLAS_FORTRAN_SOURCES = zrotg.f \
+zhpr2.f \
+zher2k.f \
+dspr.f \
+xerbla.f \
+dcopy.f \
+dsyr2k.f \
+zsymm.f \
+zhemm.f \
+dtbsv.f \
+dtrmm.f \
+dscal.f \
+ddot.f \
+dgbmv.f \
+dtpsv.f \
+dtrsv.f \
+dgemv.f \
+idamax.f \
+dzasum.f \
+zcopy.f \
+zher.f \
+drot.f \
+ztbsv.f \
+dasum.f \
+ztrmm.f \
+dsbmv.f \
+zscal.f \
+dswap.f \
+zdotc.f \
+zgbmv.f \
+ztpsv.f \
+zgemv.f \
+ztrsv.f \
+izamax.f \
+dspmv.f \
+dcabs1.f \
+dsymv.f \
+zswap.f \
+zdotu.f \
+zgerc.f \
+dznrm2.f \
+dtbmv.f \
+zdscal.f \
+dger.f \
+dnrm2.f \
+zhpr.f \
+daxpy.f \
+zhbmv.f \
+zhemv.f \
+dtrsm.f \
+dgemm.f \
+dspr2.f \
+dtpmv.f \
+zgeru.f \
+dtrmv.f \
+dsyrk.f \
+lsame.f \
+ztbmv.f \
+dsyr2.f \
+zhpmv.f \
+zsyr2k.f \
+zaxpy.f \
+zgemm.f \
+drotg.f \
+ztrsm.f \
+ztpmv.f \
+dsyr.f \
+zsyrk.f \
+ztrmv.f \
+zherk.f \
+dsymm.f \
+zher2.f
+
+instdir = $(top_builddir)/lib
+pkglib_LTLIBRARIES = libsciblas.la
+HEAD = $(top_builddir)/includes/blas.h
+libsciblas_la_SOURCES = $(HEAD) $(BLAS_FORTRAN_SOURCES)
+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 ) \
+	        && { if test -f $@; then exit 0; else break; fi; }; \
+	      exit 1;; \
+	  esac; \
+	done; \
+	echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign src/fortran/blas/Makefile'; \
+	$(am__cd) $(top_srcdir) && \
+	  $(AUTOMAKE) --foreign src/fortran/blas/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
+$(am__aclocal_m4_deps):
+install-pkglibLTLIBRARIES: $(pkglib_LTLIBRARIES)
+	@$(NORMAL_INSTALL)
+	test -z "$(pkglibdir)" || $(MKDIR_P) "$(DESTDIR)$(pkglibdir)"
+	@list='$(pkglib_LTLIBRARIES)'; test -n "$(pkglibdir)" || list=; \
+	list2=; for p in $$list; do \
+	  if test -f $$p; then \
+	    list2="$$list2 $$p"; \
+	  else :; fi; \
+	done; \
+	test -z "$$list2" || { \
+	  echo " $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL) $(INSTALL_STRIP_FLAG) $$list2 '$(DESTDIR)$(pkglibdir)'"; \
+	  $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL) $(INSTALL_STRIP_FLAG) $$list2 "$(DESTDIR)$(pkglibdir)"; \
+	}
+
+uninstall-pkglibLTLIBRARIES:
+	@$(NORMAL_UNINSTALL)
+	@list='$(pkglib_LTLIBRARIES)'; test -n "$(pkglibdir)" || list=; \
+	for p in $$list; do \
+	  $(am__strip_dir) \
+	  echo " $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=uninstall rm -f '$(DESTDIR)$(pkglibdir)/$$f'"; \
+	  $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=uninstall rm -f "$(DESTDIR)$(pkglibdir)/$$f"; \
+	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
+libsciblas.la: $(libsciblas_la_OBJECTS) $(libsciblas_la_DEPENDENCIES) 
+	$(F77LINK) -rpath $(pkglibdir) $(libsciblas_la_OBJECTS) $(libsciblas_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; nonempty = 1; } \
+	      END { if (nonempty) { for (i in files) print i; }; }'`; \
+	mkid -fID $$unique
+tags: TAGS
+
+TAGS:  $(HEADERS) $(SOURCES)  $(TAGS_DEPENDENCIES) \
+		$(TAGS_FILES) $(LISP)
+	set x; \
+	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; }; }'`; \
+	shift; \
+	if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \
+	  test -n "$$unique" || unique=$$empty_fix; \
+	  if test $$# -gt 0; then \
+	    $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
+	      "$$@" $$unique; \
+	  else \
+	    $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
+	      $$unique; \
+	  fi; \
+	fi
+ctags: CTAGS
+CTAGS:  $(HEADERS) $(SOURCES)  $(TAGS_DEPENDENCIES) \
+		$(TAGS_FILES) $(LISP)
+	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)$$unique" \
+	  || $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \
+	     $$unique
+
+GTAGS:
+	here=`$(am__cd) $(top_builddir) && pwd` \
+	  && $(am__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 "$(distdir)/$$file"; then \
+	      find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
+	    fi; \
+	    if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \
+	      cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \
+	      find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
+	    fi; \
+	    cp -fpR $$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)
+	-test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_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-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
+
+html-am:
+
+info: info-am
+
+info-am:
+
+install-data-am:
+
+install-dvi: install-dvi-am
+
+install-dvi-am:
+
+install-exec-am: install-pkglibLTLIBRARIES
+
+install-html: install-html-am
+
+install-html-am:
+
+install-info: install-info-am
+
+install-info-am:
+
+install-man:
+
+install-pdf: install-pdf-am
+
+install-pdf-am:
+
+install-ps: install-ps-am
+
+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-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
+
+
+# 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/fortran/blas/README b/src/fortran/blas/README
new file mode 100644
index 0000000..8c28166
--- /dev/null
+++ b/src/fortran/blas/README
@@ -0,0 +1,6 @@
+This directory contains double precision version of the standard blas routines.
+ The makefile produces <SCIDIR>/libs/blas.a
+
+However this code is intended for use only if there is no other implementation
+of the BLAS already available on your machine; 
+
diff --git a/src/fortran/blas/blas_f/blasplus.def b/src/fortran/blas/blas_f/blasplus.def
new file mode 100644
index 0000000..336d98a
--- /dev/null
+++ b/src/fortran/blas/blas_f/blasplus.def
@@ -0,0 +1,74 @@
+LIBRARY    blasplus.dll

+

+EXPORTS

+ dasum       	 

+ daxpy          

+ dcopy          

+ ddot           

+ dgbmv          

+ dgemm          

+ dgemv          

+ dger           

+ dnrm2          

+ drot           

+ drotg          

+ dsbmv          

+ dscal          

+ dspmv          

+ dspr           

+ dspr2          

+ dswap          

+ dsymm          

+ dsymv          

+ dsyr           

+ dsyr2          

+ dsyr2k         

+ dsyrk          

+ dtbmv          

+ dtbsv          

+ dtpmv          

+ dtpsv          

+ dtrmm          

+ dtrmv          

+ dtrsm          

+ dtrsv          

+ dzasum         

+ dznrm2         

+ idamax         

+ izamax         

+ xerbla         

+ zaxpy          

+ zcopy          

+ zdotc          

+ zdotu          

+ zdscal         

+ zgbmv          

+ zgemm          

+ zgemv          

+ zgerc          

+ zgeru          

+ zhbmv          

+ zhemm          

+ zhemv          

+ zher           

+ zher2          

+ zher2k         

+ zherk          

+ zhpmv          

+ zhpr           

+ zhpr2          

+ zrotg          

+ zscal          

+ zswap          

+ zsymm          

+ zsyr2k         

+ zsyrk          

+ ztbmv          

+ ztbsv          

+ ztpmv          

+ ztpsv          

+ ztrmm          

+ ztrmv          

+ ztrsm          

+ ztrsv          

+           
\ No newline at end of file
diff --git a/src/fortran/blas/blas_f/blasplusAtlas.def b/src/fortran/blas/blas_f/blasplusAtlas.def
new file mode 100644
index 0000000..d13dde9
--- /dev/null
+++ b/src/fortran/blas/blas_f/blasplusAtlas.def
@@ -0,0 +1,144 @@
+LIBRARY    blasplus.dll

+

+EXPORTS

+ dasum_       	   @1

+ dasum = dasum_

+ daxpy_            @2

+ daxpy = daxpy_

+ dcopy_            @3

+ dcopy = dcopy_

+ ddot_             @4

+ ddot = ddot_

+ dgbmv_            @5

+ dgbmv = dgbmv_

+ dgemm_            @6

+ dgemm = dgemm_

+ dgemv_            @7

+ dgemv = dgemv_

+ dger_             @8

+ dger = dger_

+ dnrm2_            @9

+ dnrm2 = dnrm2_

+ drot_            @10

+ drot = drot_

+ drotg_           @11

+ drotg = drotg_

+ dsbmv_           @12

+ dsbmv = dsbmv_

+ dscal_           @13

+ dscal = dscal_

+ dspmv_           @14

+ dspmv = dspmv_

+ dspr_            @15

+ dspr = dspr_

+ dspr2_           @16

+ dspr2 = dspr2_

+ dswap_           @17

+ dswap = dswap_

+ dsymm_           @18

+ dsymm = dsymm_

+ dsymv_           @19

+ dsymv = dsymv_

+ dsyr_            @20

+ dsyr = dsyr_

+ dsyr2_           @21

+ dsyr2 = dsyr2_

+ dsyr2k_          @22

+ dsyr2k = dsyr2k_

+ dsyrk_           @23

+ dsyrk = dsyrk_

+ dtbmv_           @24

+ dtbmv = dtbmv_

+ dtbsv_           @25

+ dtbsv = dtbsv_

+ dtpmv_           @26

+ dtpmv = dtpmv_

+ dtpsv_           @27

+ dtpsv = dtpsv_

+ dtrmm_           @28

+ dtrmm = dtrmm_

+ dtrmv_           @29

+ dtrmv = dtrmv_

+ dtrsm_           @30

+ dtrsm = dtrsm_

+ dtrsv_           @31

+ dtrsv = dtrsv_

+ dzasum_          @32

+ dzasum = dzasum_

+ dznrm2_          @33

+ dznrm2 = dznrm2_

+ idamax_          @34

+ idamax = idamax_

+ izamax_          @35

+ izamax = izamax_

+ xerbla_          @36

+ xerbla = xerbla_

+ zaxpy_           @37

+ zaxpy = zaxpy_

+ zcopy_           @38

+ zcopy = zcopy_

+ zdotc_           @39

+ zdotc = zdotc_

+ zdotu_           @40

+ zdotu = zdotu_

+ zdscal_          @41

+ zdscal = zdscal_

+ zgbmv_           @42

+ zgbmv = zgbmv_

+ zgemm_           @43

+ zgemm = zgemm_

+ zgemv_           @44

+ zgemv = zgemv_

+ zgerc_           @45

+ zgerc = zgerc_

+ zgeru_           @46

+ zgeru = zgeru_

+ zhbmv_           @47

+ zhbmv = zhbmv_

+ zhemm_           @48

+ zhemm = zhemm_

+ zhemv_           @49

+ zhemv = zhemv_

+ zher_            @50

+ zher = zher_

+ zher2_           @51

+ zher2 = zher2_

+ zher2k_          @52

+ zher2k = zher2k_

+ zherk_           @53

+ zherk = zherk_

+ zhpmv_           @54

+ zhpmv = zhpmv_

+ zhpr_            @55

+ zhpr = zhpr_

+ zhpr2_           @56

+ zhpr2 = zhpr2_

+ zrotg_           @57

+ zrotg = zrotg_

+ zscal_           @58

+ zscal = zscal_

+ zswap_           @59

+ zswap = zswap_

+ zsymm_           @60

+ zsymm = zsymm_

+ zsyr2k_           @61

+ zsyr2k = zsyr2k_

+ zsyrk_            @62

+ zsyrk = zsyrk_

+ ztbmv_            @63

+ ztbmv = ztbmv_

+ ztbsv_            @64

+ ztbsv = ztbsv_

+ ztpmv_            @65

+ ztpmv = ztpmv_

+ ztpsv_            @66

+ ztpsv = ztpsv_

+ ztrmm_            @67

+ ztrmm =ztrmm_

+ ztrmv_            @68

+ ztrmv = ztrmv_

+ ztrsm_            @69

+ ztrsm = ztrsm_

+ ztrsv_            @70

+ ztrsv = ztrsv_

+ 
\ No newline at end of file
diff --git a/src/fortran/blas/blas_f/blasplus_DLL.suo b/src/fortran/blas/blas_f/blasplus_DLL.suo
new file mode 100644
index 0000000..b83ddab
--- /dev/null
+++ b/src/fortran/blas/blas_f/blasplus_DLL.suo
diff --git a/src/fortran/blas/blas_f/blasplus_DLL.vfproj b/src/fortran/blas/blas_f/blasplus_DLL.vfproj
new file mode 100644
index 0000000..c1f337d
--- /dev/null
+++ b/src/fortran/blas/blas_f/blasplus_DLL.vfproj
@@ -0,0 +1,124 @@
+<?xml version="1.0" encoding="UTF-8"?>

+<VisualStudioProject ProjectType="typeDynamicLibrary" ProjectCreator="Intel Fortran" Keyword="Dll" Version="11.0" ProjectIdGuid="{78BD64CE-181D-4D3F-9254-5C4F55C1EDC9}">

+	<Platforms>

+		<Platform Name="Win32"/>

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

+	<Configurations>

+		<Configuration Name="Debug|Win32" OutputDirectory="$(SolutionDir)bin\" IntermediateDirectory="$(ProjectDir)$(Configuration)\" DeleteExtensionsOnClean="*.obj;*.mod;*.pdb;*.asm;*.map;*.dyn;*.dpi;*.tmp;*.log;*.ilk;*.dll;$(TargetPath)" ConfigurationType="typeDynamicLibrary">

+				<Tool Name="VFFortranCompilerTool" AdditionalOptions="/dll " SuppressStartupBanner="true" DebugInformationFormat="debugEnabled" Optimization="optimizeDisabled" F77RuntimeCompatibility="true" CallingConvention="callConventionCRef" ModulePath="$(INTDIR)/" ObjectFile="$(INTDIR)/" Traceback="true" BoundsCheck="true" RuntimeLibrary="rtMultiThreadedDebug"/>

+				<Tool Name="VFLinkerTool" OutputFile="$(SolutionDir)bin/blasplus.dll" LinkIncremental="linkIncrementalNo" SuppressStartupBanner="true" IgnoreDefaultLibraryNames="msvcrtd.lib" ModuleDefinitionFile="blasplus.def" GenerateDebugInformation="true" SubSystem="subSystemWindows" ImportLibrary="$(SolutionDir)bin/blasplus.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" CommandLine="lib /def:blasplusAtlas.def /Machine:X86 /OUT:$(SolutionDir)bin/blasplus.lib" Description="Create blasplus.lib for Scilab"/>

+				<Tool Name="VFManifestTool" SuppressStartupBanner="true"/></Configuration>

+		<Configuration Name="Release|Win32" OutputDirectory="$(SolutionDir)bin\" IntermediateDirectory="$(ProjectDir)$(Configuration)\" DeleteExtensionsOnClean="*.obj;*.mod;*.pdb;*.asm;*.map;*.dyn;*.dpi;*.tmp;*.log;*.ilk;*.dll;$(TargetPath)" ConfigurationType="typeDynamicLibrary">

+				<Tool Name="VFFortranCompilerTool" AdditionalOptions="/dll" SuppressStartupBanner="true" AlternateParameterSyntax="false" F77RuntimeCompatibility="true" BackslashAsNormalCharacter="false" FPS4Libs="false" CallingConvention="callConventionCRef" ModulePath="$(INTDIR)/" ObjectFile="$(INTDIR)/" RuntimeLibrary="rtMultiThreaded"/>

+				<Tool Name="VFLinkerTool" OutputFile="$(SolutionDir)bin/blasplus.dll" LinkIncremental="linkIncrementalNo" SuppressStartupBanner="true" IgnoreDefaultLibraryNames="msvcrt.lib" ModuleDefinitionFile="blasplus.def" SubSystem="subSystemWindows" SupportUnloadOfDelayLoadedDLL="true" ImportLibrary="$(SolutionDir)bin/blasplus.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" CommandLine="lib /def:blasplusAtlas.def /Machine:X86 /OUT:$(SolutionDir)bin/blasplus.lib" Description="Create blasplus.lib (Atlas compatibility)"/>

+				<Tool Name="VFManifestTool" SuppressStartupBanner="true"/></Configuration>

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

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

+				<Tool Name="VFLinkerTool" OutputFile="$(SolutionDir)bin/blasplus.dll" LinkIncremental="linkIncrementalNo" SuppressStartupBanner="true" IgnoreDefaultLibraryNames="msvcrtd.lib" ModuleDefinitionFile="blasplus.def" GenerateDebugInformation="true" SubSystem="subSystemWindows" ImportLibrary="$(SolutionDir)bin/blasplus.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" CommandLine="lib /def:blasplusAtlas.def /Machine:X64 /OUT:$(SolutionDir)bin/blasplus.lib" Description="Create blasplus.lib for Scilab"/>

+				<Tool Name="VFManifestTool" SuppressStartupBanner="true"/></Configuration>

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

+				<Tool Name="VFFortranCompilerTool" AdditionalOptions="/dll" SuppressStartupBanner="true" AlternateParameterSyntax="false" F77RuntimeCompatibility="true" BackslashAsNormalCharacter="false" FPS4Libs="false" CallingConvention="callConventionCRef" ModulePath="$(INTDIR)/" ObjectFile="$(INTDIR)/"/>

+				<Tool Name="VFLinkerTool" OutputFile="$(SolutionDir)bin/blasplus.dll" LinkIncremental="linkIncrementalNo" SuppressStartupBanner="true" IgnoreDefaultLibraryNames="msvcrt.lib" ModuleDefinitionFile="blasplus.def" SubSystem="subSystemWindows" SupportUnloadOfDelayLoadedDLL="true" ImportLibrary="$(SolutionDir)bin/blasplus.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" CommandLine="lib /def:blasplusAtlas.def /Machine:X64 /OUT:$(SolutionDir)bin/blasplus.lib" Description="Create blasplus.lib (Atlas compatibility)"/>

+				<Tool Name="VFManifestTool" SuppressStartupBanner="true"/></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="..\dasum.f"/>

+		<File RelativePath="..\daxpy.f"/>

+		<File RelativePath="..\dcabs1.f"/>

+		<File RelativePath="..\dcopy.f"/>

+		<File RelativePath="..\ddot.f"/>

+		<File RelativePath="..\dgbmv.f"/>

+		<File RelativePath="..\dgemm.f"/>

+		<File RelativePath="..\dgemv.f"/>

+		<File RelativePath="..\dger.f"/>

+		<File RelativePath="..\dnrm2.f"/>

+		<File RelativePath="..\drot.f"/>

+		<File RelativePath="..\drotg.f"/>

+		<File RelativePath="..\dsbmv.f"/>

+		<File RelativePath="..\dscal.f"/>

+		<File RelativePath="..\dspmv.f"/>

+		<File RelativePath="..\dspr.f"/>

+		<File RelativePath="..\dspr2.f"/>

+		<File RelativePath="..\dswap.f"/>

+		<File RelativePath="..\dsymm.f"/>

+		<File RelativePath="..\dsymv.f"/>

+		<File RelativePath="..\dsyr.f"/>

+		<File RelativePath="..\dsyr2.f"/>

+		<File RelativePath="..\dsyr2k.f"/>

+		<File RelativePath="..\dsyrk.f"/>

+		<File RelativePath="..\dtbmv.f"/>

+		<File RelativePath="..\dtbsv.f"/>

+		<File RelativePath="..\dtpmv.f"/>

+		<File RelativePath="..\dtpsv.f"/>

+		<File RelativePath="..\dtrmm.f"/>

+		<File RelativePath="..\dtrmv.f"/>

+		<File RelativePath="..\dtrsm.f"/>

+		<File RelativePath="..\dtrsv.f"/>

+		<File RelativePath="..\dzasum.f"/>

+		<File RelativePath="..\dznrm2.f"/>

+		<File RelativePath="..\idamax.f"/>

+		<File RelativePath="..\izamax.f"/>

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

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

+		<File RelativePath="..\zaxpy.f"/>

+		<File RelativePath="..\zcopy.f"/>

+		<File RelativePath="..\zdotc.f"/>

+		<File RelativePath="..\zdotu.f"/>

+		<File RelativePath="..\zdscal.f"/>

+		<File RelativePath="..\zgbmv.f"/>

+		<File RelativePath="..\zgemm.f"/>

+		<File RelativePath="..\zgemv.f"/>

+		<File RelativePath="..\zgerc.f"/>

+		<File RelativePath="..\zgeru.f"/>

+		<File RelativePath="..\zhbmv.f"/>

+		<File RelativePath="..\zhemm.f"/>

+		<File RelativePath="..\zhemv.f"/>

+		<File RelativePath="..\zher.f"/>

+		<File RelativePath="..\zher2.f"/>

+		<File RelativePath="..\zher2k.f"/>

+		<File RelativePath="..\zherk.f"/>

+		<File RelativePath="..\zhpmv.f"/>

+		<File RelativePath="..\zhpr.f"/>

+		<File RelativePath="..\zhpr2.f"/>

+		<File RelativePath="..\zrotg.f"/>

+		<File RelativePath="..\zscal.f"/>

+		<File RelativePath="..\zswap.f"/>

+		<File RelativePath="..\zsymm.f"/>

+		<File RelativePath="..\zsyr2k.f"/>

+		<File RelativePath="..\zsyrk.f"/>

+		<File RelativePath="..\ztbmv.f"/>

+		<File RelativePath="..\ztbsv.f"/>

+		<File RelativePath="..\ztpmv.f"/>

+		<File RelativePath="..\ztpsv.f"/>

+		<File RelativePath="..\ztrmm.f"/>

+		<File RelativePath="..\ztrmv.f"/>

+		<File RelativePath="..\ztrsm.f"/>

+		<File RelativePath="..\ztrsv.f"/></Filter>

+		<File RelativePath=".\blasplusAtlas.def"/></Files>

+	<Globals/></VisualStudioProject>

diff --git a/src/fortran/blas/blas_f/blasplus_DLL_f2c.vcxproj b/src/fortran/blas/blas_f/blasplus_DLL_f2c.vcxproj
new file mode 100644
index 0000000..d557d2b
--- /dev/null
+++ b/src/fortran/blas/blas_f/blasplus_DLL_f2c.vcxproj
@@ -0,0 +1,370 @@
+<?xml version="1.0" encoding="utf-8"?>

+<Project DefaultTargets="Build" ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">

+  <ItemGroup Label="ProjectConfigurations">

+    <ProjectConfiguration Include="Debug|Win32">

+      <Configuration>Debug</Configuration>

+      <Platform>Win32</Platform>

+    </ProjectConfiguration>

+    <ProjectConfiguration Include="Debug|x64">

+      <Configuration>Debug</Configuration>

+      <Platform>x64</Platform>

+    </ProjectConfiguration>

+    <ProjectConfiguration Include="Release|Win32">

+      <Configuration>Release</Configuration>

+      <Platform>Win32</Platform>

+    </ProjectConfiguration>

+    <ProjectConfiguration Include="Release|x64">

+      <Configuration>Release</Configuration>

+      <Platform>x64</Platform>

+    </ProjectConfiguration>

+  </ItemGroup>

+  <PropertyGroup Label="Globals">

+    <ProjectName>blasplus_f2c_DLL</ProjectName>

+    <ProjectGuid>{78BD64CE-181D-4D3F-9254-5C4F55C1EDC9}</ProjectGuid>

+    <RootNamespace>blas_f2c</RootNamespace>

+    <Keyword>Win32Proj</Keyword>

+  </PropertyGroup>

+  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.Default.props" />

+  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="Configuration">

+    <ConfigurationType>DynamicLibrary</ConfigurationType>

+    <CharacterSet>MultiByte</CharacterSet>

+  </PropertyGroup>

+  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="Configuration">

+    <ConfigurationType>DynamicLibrary</ConfigurationType>

+    <CharacterSet>MultiByte</CharacterSet>

+  </PropertyGroup>

+  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="Configuration">

+    <ConfigurationType>DynamicLibrary</ConfigurationType>

+    <CharacterSet>MultiByte</CharacterSet>

+  </PropertyGroup>

+  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="Configuration">

+    <ConfigurationType>DynamicLibrary</ConfigurationType>

+    <CharacterSet>MultiByte</CharacterSet>

+  </PropertyGroup>

+  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.props" />

+  <ImportGroup Label="ExtensionSettings">

+    <Import Project="..\..\..\..\Visual-Studio-settings\f2c.props" />

+  </ImportGroup>

+  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="PropertySheets">

+    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />

+  </ImportGroup>

+  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="PropertySheets">

+    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />

+  </ImportGroup>

+  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="PropertySheets">

+    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />

+  </ImportGroup>

+  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="PropertySheets">

+    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />

+  </ImportGroup>

+  <PropertyGroup Label="UserMacros" />

+  <PropertyGroup>

+    <_ProjectFileVersion>10.0.40219.1</_ProjectFileVersion>

+    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">$(SolutionDir)bin\</OutDir>

+    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">$(ProjectDir)$(Configuration)\</IntDir>

+    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">$(ProjectDir)$(Configuration)\</OutDir>

+    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">$(ProjectDir)$(Configuration)\</IntDir>

+    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">$(SolutionDir)bin\</OutDir>

+    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">$(ProjectDir)$(Configuration)\</IntDir>

+    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">$(SolutionDir)bin\</OutDir>

+    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">$(ProjectDir)$(Configuration)\</IntDir>

+  </PropertyGroup>

+  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">

+    <PreBuildEvent>

+      <Command>

+      </Command>

+    </PreBuildEvent>

+    <ClCompile>

+      <Optimization>Disabled</Optimization>

+      <AdditionalIncludeDirectories>../../f2c;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>

+      <PreprocessorDefinitions>STRICT;__STDC__;_CRT_SECURE_NO_DEPRECATE;%(PreprocessorDefinitions)</PreprocessorDefinitions>

+      <MinimalRebuild>true</MinimalRebuild>

+      <BasicRuntimeChecks>Default</BasicRuntimeChecks>

+      <RuntimeLibrary>MultiThreadedDebug</RuntimeLibrary>

+      <PrecompiledHeader>

+      </PrecompiledHeader>

+      <ObjectFileName>$(Configuration)/</ObjectFileName>

+      <ProgramDataBaseFileName>$(Configuration)/vc80.pdb</ProgramDataBaseFileName>

+      <WarningLevel>Level3</WarningLevel>

+      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>

+    </ClCompile>

+    <Link>

+      <AdditionalOptions>/fixed:no %(AdditionalOptions)</AdditionalOptions>

+      <OutputFile>$(SolutionDir)bin\blasplus.dll</OutputFile>

+      <ModuleDefinitionFile>blasplusAtlas.def</ModuleDefinitionFile>

+      <RandomizedBaseAddress>false</RandomizedBaseAddress>

+      <DataExecutionPrevention>

+      </DataExecutionPrevention>

+      <ImportLibrary>$(SolutionDir)bin\blasplus.lib</ImportLibrary>

+      <CLRUnmanagedCodeCheck>true</CLRUnmanagedCodeCheck>

+    </Link>

+    <PostBuildEvent>

+      <Command>

+      </Command>

+    </PostBuildEvent>

+  </ItemDefinitionGroup>

+  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">

+    <PreBuildEvent>

+      <Command>

+      </Command>

+    </PreBuildEvent>

+    <Midl>

+      <TargetEnvironment>X64</TargetEnvironment>

+    </Midl>

+    <ClCompile>

+      <Optimization>Disabled</Optimization>

+      <AdditionalIncludeDirectories>../../f2c;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>

+      <PreprocessorDefinitions>STRICT;__STDC__;_CRT_SECURE_NO_DEPRECATE;%(PreprocessorDefinitions)</PreprocessorDefinitions>

+      <MinimalRebuild>true</MinimalRebuild>

+      <BasicRuntimeChecks>Default</BasicRuntimeChecks>

+      <RuntimeLibrary>MultiThreadedDebug</RuntimeLibrary>

+      <PrecompiledHeader>

+      </PrecompiledHeader>

+      <ObjectFileName>$(Configuration)/</ObjectFileName>

+      <ProgramDataBaseFileName>$(Configuration)/vc80.pdb</ProgramDataBaseFileName>

+      <WarningLevel>Level3</WarningLevel>

+      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>

+    </ClCompile>

+    <Link>

+      <AdditionalOptions>/fixed:no %(AdditionalOptions)</AdditionalOptions>

+      <OutputFile>../../../bin/blasplus.dll</OutputFile>

+      <ModuleDefinitionFile>blasplusAtlas.def</ModuleDefinitionFile>

+      <RandomizedBaseAddress>false</RandomizedBaseAddress>

+      <DataExecutionPrevention>

+      </DataExecutionPrevention>

+      <ImportLibrary>../../../bin/blasplus.lib</ImportLibrary>

+      <TargetMachine>MachineX64</TargetMachine>

+      <CLRUnmanagedCodeCheck>true</CLRUnmanagedCodeCheck>

+    </Link>

+    <PostBuildEvent>

+      <Command>

+      </Command>

+    </PostBuildEvent>

+  </ItemDefinitionGroup>

+  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">

+    <PreBuildEvent>

+      <Command>

+      </Command>

+    </PreBuildEvent>

+    <ClCompile>

+      <FavorSizeOrSpeed>Speed</FavorSizeOrSpeed>

+      <AdditionalIncludeDirectories>../../f2c;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>

+      <PreprocessorDefinitions>STRICT;__STDC__;_CRT_SECURE_NO_DEPRECATE;%(PreprocessorDefinitions)</PreprocessorDefinitions>

+      <RuntimeLibrary>MultiThreaded</RuntimeLibrary>

+      <EnableEnhancedInstructionSet>NotSet</EnableEnhancedInstructionSet>

+      <PrecompiledHeader>

+      </PrecompiledHeader>

+      <ObjectFileName>$(Configuration)/</ObjectFileName>

+      <ProgramDataBaseFileName>$(Configuration)/vc80.pdb</ProgramDataBaseFileName>

+      <WarningLevel>Level3</WarningLevel>

+      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>

+    </ClCompile>

+    <Link>

+      <OutputFile>$(SolutionDir)bin\blasplus.dll</OutputFile>

+      <ModuleDefinitionFile>blasplusAtlas.def</ModuleDefinitionFile>

+      <RandomizedBaseAddress>false</RandomizedBaseAddress>

+      <DataExecutionPrevention>

+      </DataExecutionPrevention>

+      <ImportLibrary>$(SolutionDir)bin\blasplus.lib</ImportLibrary>

+      <CLRUnmanagedCodeCheck>true</CLRUnmanagedCodeCheck>

+    </Link>

+    <PostBuildEvent>

+      <Command>

+      </Command>

+    </PostBuildEvent>

+  </ItemDefinitionGroup>

+  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'">

+    <PreBuildEvent>

+      <Command>

+      </Command>

+    </PreBuildEvent>

+    <Midl>

+      <TargetEnvironment>X64</TargetEnvironment>

+    </Midl>

+    <ClCompile>

+      <FavorSizeOrSpeed>Speed</FavorSizeOrSpeed>

+      <AdditionalIncludeDirectories>../../f2c;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>

+      <PreprocessorDefinitions>STRICT;__STDC__;_CRT_SECURE_NO_DEPRECATE;%(PreprocessorDefinitions)</PreprocessorDefinitions>

+      <RuntimeLibrary>MultiThreaded</RuntimeLibrary>

+      <EnableEnhancedInstructionSet>StreamingSIMDExtensions</EnableEnhancedInstructionSet>

+      <PrecompiledHeader>

+      </PrecompiledHeader>

+      <ObjectFileName>$(Configuration)/</ObjectFileName>

+      <ProgramDataBaseFileName>$(Configuration)/vc80.pdb</ProgramDataBaseFileName>

+      <WarningLevel>Level3</WarningLevel>

+      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>

+    </ClCompile>

+    <Link>

+      <OutputFile>../../../bin/blasplus.dll</OutputFile>

+      <ModuleDefinitionFile>blasplusAtlas.def</ModuleDefinitionFile>

+      <RandomizedBaseAddress>false</RandomizedBaseAddress>

+      <DataExecutionPrevention>

+      </DataExecutionPrevention>

+      <ImportLibrary>../../../bin/blasplus.lib</ImportLibrary>

+      <TargetMachine>MachineX64</TargetMachine>

+      <CLRUnmanagedCodeCheck>true</CLRUnmanagedCodeCheck>

+    </Link>

+    <PostBuildEvent>

+      <Command>

+      </Command>

+    </PostBuildEvent>

+  </ItemDefinitionGroup>

+  <ItemGroup>

+    <ClCompile Include="..\dasum.c" />

+    <ClCompile Include="..\daxpy.c" />

+    <ClCompile Include="..\dcabs1.c" />

+    <ClCompile Include="..\dcopy.c" />

+    <ClCompile Include="..\ddot.c" />

+    <ClCompile Include="..\dgbmv.c" />

+    <ClCompile Include="..\dgemm.c" />

+    <ClCompile Include="..\dgemv.c" />

+    <ClCompile Include="..\dger.c" />

+    <ClCompile Include="..\dnrm2.c" />

+    <ClCompile Include="..\drot.c" />

+    <ClCompile Include="..\drotg.c" />

+    <ClCompile Include="..\dsbmv.c" />

+    <ClCompile Include="..\dscal.c" />

+    <ClCompile Include="..\dspmv.c" />

+    <ClCompile Include="..\dspr.c" />

+    <ClCompile Include="..\dspr2.c" />

+    <ClCompile Include="..\dswap.c" />

+    <ClCompile Include="..\dsymm.c" />

+    <ClCompile Include="..\dsymv.c" />

+    <ClCompile Include="..\dsyr.c" />

+    <ClCompile Include="..\dsyr2.c" />

+    <ClCompile Include="..\dsyr2k.c" />

+    <ClCompile Include="..\dsyrk.c" />

+    <ClCompile Include="..\dtbmv.c" />

+    <ClCompile Include="..\dtbsv.c" />

+    <ClCompile Include="..\dtpmv.c" />

+    <ClCompile Include="..\dtpsv.c" />

+    <ClCompile Include="..\dtrmm.c" />

+    <ClCompile Include="..\dtrmv.c" />

+    <ClCompile Include="..\dtrsm.c" />

+    <ClCompile Include="..\dtrsv.c" />

+    <ClCompile Include="..\dzasum.c" />

+    <ClCompile Include="..\dznrm2.c" />

+    <ClCompile Include="..\idamax.c" />

+    <ClCompile Include="..\izamax.c" />

+    <ClCompile Include="..\lsame.c" />

+    <ClCompile Include="..\xerbla.c" />

+    <ClCompile Include="..\zaxpy.c" />

+    <ClCompile Include="..\zcopy.c" />

+    <ClCompile Include="..\zdotc.c" />

+    <ClCompile Include="..\zdotu.c" />

+    <ClCompile Include="..\zdscal.c" />

+    <ClCompile Include="..\zgbmv.c" />

+    <ClCompile Include="..\zgemm.c" />

+    <ClCompile Include="..\zgemv.c" />

+    <ClCompile Include="..\zgerc.c" />

+    <ClCompile Include="..\zgeru.c" />

+    <ClCompile Include="..\zhbmv.c" />

+    <ClCompile Include="..\zhemm.c" />

+    <ClCompile Include="..\zhemv.c" />

+    <ClCompile Include="..\zher.c" />

+    <ClCompile Include="..\zher2.c" />

+    <ClCompile Include="..\zher2k.c" />

+    <ClCompile Include="..\zherk.c" />

+    <ClCompile Include="..\zhpmv.c" />

+    <ClCompile Include="..\zhpr.c" />

+    <ClCompile Include="..\zhpr2.c" />

+    <ClCompile Include="..\zrotg.c" />

+    <ClCompile Include="..\zscal.c" />

+    <ClCompile Include="..\zswap.c" />

+    <ClCompile Include="..\zsymm.c" />

+    <ClCompile Include="..\zsyr2k.c" />

+    <ClCompile Include="..\zsyrk.c" />

+    <ClCompile Include="..\ztbmv.c" />

+    <ClCompile Include="..\ztbsv.c" />

+    <ClCompile Include="..\ztpmv.c" />

+    <ClCompile Include="..\ztpsv.c" />

+    <ClCompile Include="..\ztrmm.c" />

+    <ClCompile Include="..\ztrmv.c" />

+    <ClCompile Include="..\ztrsm.c" />

+    <ClCompile Include="..\ztrsv.c" />

+  </ItemGroup>

+  <ItemGroup>

+    <f2c_rule Include="..\dasum.f" />

+    <f2c_rule Include="..\daxpy.f" />

+    <f2c_rule Include="..\dcabs1.f" />

+    <f2c_rule Include="..\dcopy.f" />

+    <f2c_rule Include="..\ddot.f" />

+    <f2c_rule Include="..\dgbmv.f" />

+    <f2c_rule Include="..\dgemm.f" />

+    <f2c_rule Include="..\dgemv.f" />

+    <f2c_rule Include="..\dger.f" />

+    <f2c_rule Include="..\dnrm2.f" />

+    <f2c_rule Include="..\drot.f" />

+    <f2c_rule Include="..\drotg.f" />

+    <f2c_rule Include="..\dsbmv.f" />

+    <f2c_rule Include="..\dscal.f" />

+    <f2c_rule Include="..\dspmv.f" />

+    <f2c_rule Include="..\dspr.f" />

+    <f2c_rule Include="..\dspr2.f" />

+    <f2c_rule Include="..\dswap.f" />

+    <f2c_rule Include="..\dsymm.f" />

+    <f2c_rule Include="..\dsymv.f" />

+    <f2c_rule Include="..\dsyr.f" />

+    <f2c_rule Include="..\dsyr2.f" />

+    <f2c_rule Include="..\dsyr2k.f" />

+    <f2c_rule Include="..\dsyrk.f" />

+    <f2c_rule Include="..\dtbmv.f" />

+    <f2c_rule Include="..\dtbsv.f" />

+    <f2c_rule Include="..\dtpmv.f" />

+    <f2c_rule Include="..\dtpsv.f" />

+    <f2c_rule Include="..\dtrmm.f" />

+    <f2c_rule Include="..\dtrmv.f" />

+    <f2c_rule Include="..\dtrsm.f" />

+    <f2c_rule Include="..\dtrsv.f" />

+    <f2c_rule Include="..\dzasum.f" />

+    <f2c_rule Include="..\dznrm2.f" />

+    <f2c_rule Include="..\idamax.f" />

+    <f2c_rule Include="..\izamax.f" />

+    <f2c_rule Include="..\lsame.f" />

+    <f2c_rule Include="..\xerbla.f" />

+    <f2c_rule Include="..\zaxpy.f" />

+    <f2c_rule Include="..\zcopy.f" />

+    <f2c_rule Include="..\zdotc.f" />

+    <f2c_rule Include="..\zdotu.f" />

+    <f2c_rule Include="..\zdscal.f" />

+    <f2c_rule Include="..\zgbmv.f" />

+    <f2c_rule Include="..\zgemm.f" />

+    <f2c_rule Include="..\zgemv.f" />

+    <f2c_rule Include="..\zgerc.f" />

+    <f2c_rule Include="..\zgeru.f" />

+    <f2c_rule Include="..\zhbmv.f" />

+    <f2c_rule Include="..\zhemm.f" />

+    <f2c_rule Include="..\zhemv.f" />

+    <f2c_rule Include="..\zher.f" />

+    <f2c_rule Include="..\zher2.f" />

+    <f2c_rule Include="..\zher2k.f" />

+    <f2c_rule Include="..\zherk.f" />

+    <f2c_rule Include="..\zhpmv.f" />

+    <f2c_rule Include="..\zhpr.f" />

+    <f2c_rule Include="..\zhpr2.f" />

+    <f2c_rule Include="..\zrotg.f" />

+    <f2c_rule Include="..\zscal.f" />

+    <f2c_rule Include="..\zswap.f" />

+    <f2c_rule Include="..\zsymm.f" />

+    <f2c_rule Include="..\zsyr2k.f" />

+    <f2c_rule Include="..\zsyrk.f" />

+    <f2c_rule Include="..\ztbmv.f" />

+    <f2c_rule Include="..\ztbsv.f" />

+    <f2c_rule Include="..\ztpmv.f" />

+    <f2c_rule Include="..\ztpsv.f" />

+    <f2c_rule Include="..\ztrmm.f" />

+    <f2c_rule Include="..\ztrmv.f" />

+    <f2c_rule Include="..\ztrsm.f" />

+    <f2c_rule Include="..\ztrsv.f" />

+  </ItemGroup>

+  <ItemGroup>

+    <Library Include="..\..\..\..\bin\libf2c.lib" />

+  </ItemGroup>

+  <ItemGroup>

+    <None Include="..\Makefile.am" />

+  </ItemGroup>

+  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.targets" />

+  <ImportGroup Label="ExtensionTargets">

+    <Import Project="..\..\..\..\Visual-Studio-settings\f2c.targets" />

+  </ImportGroup>

+</Project>
\ No newline at end of file
diff --git a/src/fortran/blas/blas_f/blasplus_DLL_f2c.vcxproj.filters b/src/fortran/blas/blas_f/blasplus_DLL_f2c.vcxproj.filters
new file mode 100644
index 0000000..7930e6c
--- /dev/null
+++ b/src/fortran/blas/blas_f/blasplus_DLL_f2c.vcxproj.filters
@@ -0,0 +1,463 @@
+<?xml version="1.0" encoding="utf-8"?>

+<Project ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">

+  <ItemGroup>

+    <Filter Include="Source Files">

+      <UniqueIdentifier>{1601b9fb-7d71-4db3-a10f-2ebf4e42eb41}</UniqueIdentifier>

+      <Extensions>cpp;c;cxx;def;odl;idl;hpj;bat;asm;asmx</Extensions>

+    </Filter>

+    <Filter Include="Header Files">

+      <UniqueIdentifier>{00d1d9d7-fbdc-44d6-8833-2fe6c3202478}</UniqueIdentifier>

+      <Extensions>h;hpp;hxx;hm;inl;inc;xsd</Extensions>

+    </Filter>

+    <Filter Include="Resource Files">

+      <UniqueIdentifier>{e894258f-c565-49f3-a686-3d4b79d703a9}</UniqueIdentifier>

+      <Extensions>rc;ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe;resx</Extensions>

+    </Filter>

+    <Filter Include="Fortran Files">

+      <UniqueIdentifier>{f47cf0f8-ff06-42b4-86b2-ffa42424f976}</UniqueIdentifier>

+      <Extensions>*.f</Extensions>

+    </Filter>

+  </ItemGroup>

+  <ItemGroup>

+    <ClCompile Include="..\dasum.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\daxpy.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\dcabs1.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\dcopy.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\ddot.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\dgbmv.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\dgemm.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\dgemv.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\dger.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\dnrm2.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\drot.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\drotg.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\dsbmv.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\dscal.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\dspmv.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\dspr.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\dspr2.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\dswap.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\dsymm.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\dsymv.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\dsyr.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\dsyr2.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\dsyr2k.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\dsyrk.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\dtbmv.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\dtbsv.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\dtpmv.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\dtpsv.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\dtrmm.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\dtrmv.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\dtrsm.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\dtrsv.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\dzasum.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\dznrm2.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\idamax.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\izamax.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\lsame.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\xerbla.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\zaxpy.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\zcopy.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\zdotc.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\zdotu.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\zdscal.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\zgbmv.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\zgemm.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\zgemv.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\zgerc.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\zgeru.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\zhbmv.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\zhemm.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\zhemv.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\zher.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\zher2.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\zher2k.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\zherk.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\zhpmv.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\zhpr.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\zhpr2.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\zrotg.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\zscal.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\zswap.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\zsymm.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\zsyr2k.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\zsyrk.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\ztbmv.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\ztbsv.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\ztpmv.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\ztpsv.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\ztrmm.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\ztrmv.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\ztrsm.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+    <ClCompile Include="..\ztrsv.c">

+      <Filter>Source Files</Filter>

+    </ClCompile>

+  </ItemGroup>

+  <ItemGroup>

+    <f2c_rule Include="..\dasum.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\daxpy.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\dcabs1.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\dcopy.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\ddot.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\dgbmv.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\dgemm.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\dgemv.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\dger.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\dnrm2.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\drot.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\drotg.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\dsbmv.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\dscal.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\dspmv.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\dspr.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\dspr2.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\dswap.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\dsymm.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\dsymv.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\dsyr.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\dsyr2.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\dsyr2k.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\dsyrk.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\dtbmv.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\dtbsv.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\dtpmv.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\dtpsv.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\dtrmm.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\dtrmv.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\dtrsm.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\dtrsv.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\dzasum.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\dznrm2.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\idamax.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\izamax.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\lsame.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\xerbla.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\zaxpy.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\zcopy.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\zdotc.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\zdotu.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\zdscal.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\zgbmv.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\zgemm.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\zgemv.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\zgerc.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\zgeru.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\zhbmv.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\zhemm.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\zhemv.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\zher.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\zher2.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\zher2k.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\zherk.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\zhpmv.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\zhpr.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\zhpr2.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\zrotg.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\zscal.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\zswap.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\zsymm.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\zsyr2k.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\zsyrk.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\ztbmv.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\ztbsv.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\ztpmv.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\ztpsv.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\ztrmm.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\ztrmv.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\ztrsm.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+    <f2c_rule Include="..\ztrsv.f">

+      <Filter>Fortran Files</Filter>

+    </f2c_rule>

+  </ItemGroup>

+  <ItemGroup>

+    <Library Include="..\..\..\..\bin\libf2c.lib" />

+  </ItemGroup>

+  <ItemGroup>

+    <None Include="..\Makefile.am" />

+  </ItemGroup>

+</Project>
\ No newline at end of file
diff --git a/src/fortran/blas/dasum.f b/src/fortran/blas/dasum.f
new file mode 100644
index 0000000..28b128a
--- /dev/null
+++ b/src/fortran/blas/dasum.f
@@ -0,0 +1,43 @@
+      double precision function dasum(n,dx,incx)
+c
+c     takes the sum of the absolute values.
+c     jack dongarra, linpack, 3/11/78.
+c     modified 3/93 to return if incx .le. 0.
+c     modified 12/3/93, array(1) declarations changed to array(*)
+c
+      double precision dx(*),dtemp
+      integer i,incx,m,mp1,n,nincx
+c
+      dasum = 0.0d0
+      dtemp = 0.0d0
+      if( n.le.0 .or. incx.le.0 )return
+      if(incx.eq.1)go to 20
+c
+c        code for increment not equal to 1
+c
+      nincx = n*incx
+      do 10 i = 1,nincx,incx
+        dtemp = dtemp + dabs(dx(i))
+   10 continue
+      dasum = dtemp
+      return
+c
+c        code for increment equal to 1
+c
+c
+c        clean-up loop
+c
+   20 m = mod(n,6)
+      if( m .eq. 0 ) go to 40
+      do 30 i = 1,m
+        dtemp = dtemp + dabs(dx(i))
+   30 continue
+      if( n .lt. 6 ) go to 60
+   40 mp1 = m + 1
+      do 50 i = mp1,n,6
+        dtemp = dtemp + dabs(dx(i)) + dabs(dx(i + 1)) + dabs(dx(i + 2))
+     *  + dabs(dx(i + 3)) + dabs(dx(i + 4)) + dabs(dx(i + 5))
+   50 continue
+   60 dasum = dtemp
+      return
+      end
diff --git a/src/fortran/blas/daxpy.f b/src/fortran/blas/daxpy.f
new file mode 100644
index 0000000..91daa3c
--- /dev/null
+++ b/src/fortran/blas/daxpy.f
@@ -0,0 +1,48 @@
+      subroutine daxpy(n,da,dx,incx,dy,incy)
+c
+c     constant times a vector plus a vector.
+c     uses unrolled loops for increments equal to one.
+c     jack dongarra, linpack, 3/11/78.
+c     modified 12/3/93, array(1) declarations changed to array(*)
+c
+      double precision dx(*),dy(*),da
+      integer i,incx,incy,ix,iy,m,mp1,n
+c
+      if(n.le.0)return
+      if (da .eq. 0.0d0) return
+      if(incx.eq.1.and.incy.eq.1)go to 20
+c
+c        code for unequal increments or equal increments
+c          not equal to 1
+c
+      ix = 1
+      iy = 1
+      if(incx.lt.0)ix = (-n+1)*incx + 1
+      if(incy.lt.0)iy = (-n+1)*incy + 1
+      do 10 i = 1,n
+        dy(iy) = dy(iy) + da*dx(ix)
+        ix = ix + incx
+        iy = iy + incy
+   10 continue
+      return
+c
+c        code for both increments equal to 1
+c
+c
+c        clean-up loop
+c
+   20 m = mod(n,4)
+      if( m .eq. 0 ) go to 40
+      do 30 i = 1,m
+        dy(i) = dy(i) + da*dx(i)
+   30 continue
+      if( n .lt. 4 ) return
+   40 mp1 = m + 1
+      do 50 i = mp1,n,4
+        dy(i) = dy(i) + da*dx(i)
+        dy(i + 1) = dy(i + 1) + da*dx(i + 1)
+        dy(i + 2) = dy(i + 2) + da*dx(i + 2)
+        dy(i + 3) = dy(i + 3) + da*dx(i + 3)
+   50 continue
+      return
+      end
diff --git a/src/fortran/blas/dcabs1.f b/src/fortran/blas/dcabs1.f
new file mode 100644
index 0000000..385ea5e
--- /dev/null
+++ b/src/fortran/blas/dcabs1.f
@@ -0,0 +1,8 @@
+      double precision function dcabs1(z)
+      double complex z,zz
+      double precision t(2)
+      equivalence (zz,t(1))
+      zz = z
+      dcabs1 = dabs(t(1)) + dabs(t(2))
+      return
+      end
diff --git a/src/fortran/blas/dcopy.f b/src/fortran/blas/dcopy.f
new file mode 100644
index 0000000..e168927
--- /dev/null
+++ b/src/fortran/blas/dcopy.f
@@ -0,0 +1,50 @@
+      subroutine  dcopy(n,dx,incx,dy,incy)
+c
+c     copies a vector, x, to a vector, y.
+c     uses unrolled loops for increments equal to one.
+c     jack dongarra, linpack, 3/11/78.
+c     modified 12/3/93, array(1) declarations changed to array(*)
+c
+      double precision dx(*),dy(*)
+      integer i,incx,incy,ix,iy,m,mp1,n
+c
+      if(n.le.0)return
+      if(incx.eq.1.and.incy.eq.1)go to 20
+c
+c        code for unequal increments or equal increments
+c          not equal to 1
+c
+      ix = 1
+      iy = 1
+      if(incx.lt.0)ix = (-n+1)*incx + 1
+      if(incy.lt.0)iy = (-n+1)*incy + 1
+      do 10 i = 1,n
+        dy(iy) = dx(ix)
+        ix = ix + incx
+        iy = iy + incy
+   10 continue
+      return
+c
+c        code for both increments equal to 1
+c
+c
+c        clean-up loop
+c
+   20 m = mod(n,7)
+      if( m .eq. 0 ) go to 40
+      do 30 i = 1,m
+        dy(i) = dx(i)
+   30 continue
+      if( n .lt. 7 ) return
+   40 mp1 = m + 1
+      do 50 i = mp1,n,7
+        dy(i) = dx(i)
+        dy(i + 1) = dx(i + 1)
+        dy(i + 2) = dx(i + 2)
+        dy(i + 3) = dx(i + 3)
+        dy(i + 4) = dx(i + 4)
+        dy(i + 5) = dx(i + 5)
+        dy(i + 6) = dx(i + 6)
+   50 continue
+      return
+      end
diff --git a/src/fortran/blas/ddot.f b/src/fortran/blas/ddot.f
new file mode 100644
index 0000000..e04c7c2
--- /dev/null
+++ b/src/fortran/blas/ddot.f
@@ -0,0 +1,49 @@
+      double precision function ddot(n,dx,incx,dy,incy)
+c
+c     forms the dot product of two vectors.
+c     uses unrolled loops for increments equal to one.
+c     jack dongarra, linpack, 3/11/78.
+c     modified 12/3/93, array(1) declarations changed to array(*)
+c
+      double precision dx(*),dy(*),dtemp
+      integer i,incx,incy,ix,iy,m,mp1,n
+c
+      ddot = 0.0d0
+      dtemp = 0.0d0
+      if(n.le.0)return
+      if(incx.eq.1.and.incy.eq.1)go to 20
+c
+c        code for unequal increments or equal increments
+c          not equal to 1
+c
+      ix = 1
+      iy = 1
+      if(incx.lt.0)ix = (-n+1)*incx + 1
+      if(incy.lt.0)iy = (-n+1)*incy + 1
+      do 10 i = 1,n
+        dtemp = dtemp + dx(ix)*dy(iy)
+        ix = ix + incx
+        iy = iy + incy
+   10 continue
+      ddot = dtemp
+      return
+c
+c        code for both increments equal to 1
+c
+c
+c        clean-up loop
+c
+   20 m = mod(n,5)
+      if( m .eq. 0 ) go to 40
+      do 30 i = 1,m
+        dtemp = dtemp + dx(i)*dy(i)
+   30 continue
+      if( n .lt. 5 ) go to 60
+   40 mp1 = m + 1
+      do 50 i = mp1,n,5
+        dtemp = dtemp + dx(i)*dy(i) + dx(i + 1)*dy(i + 1) +
+     *   dx(i + 2)*dy(i + 2) + dx(i + 3)*dy(i + 3) + dx(i + 4)*dy(i + 4)
+   50 continue
+   60 ddot = dtemp
+      return
+      end
diff --git a/src/fortran/blas/dgbmv.f b/src/fortran/blas/dgbmv.f
new file mode 100644
index 0000000..e9c8f76
--- /dev/null
+++ b/src/fortran/blas/dgbmv.f
@@ -0,0 +1,300 @@
+      SUBROUTINE DGBMV ( TRANS, M, N, KL, KU, ALPHA, A, LDA, X, INCX,
+     $                   BETA, Y, INCY )
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION   ALPHA, BETA
+      INTEGER            INCX, INCY, KL, KU, LDA, M, N
+      CHARACTER*1        TRANS
+*     .. Array Arguments ..
+      DOUBLE PRECISION   A( LDA, * ), X( * ), Y( * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  DGBMV  performs one of the matrix-vector operations
+*
+*     y := alpha*A*x + beta*y,   or   y := alpha*A'*x + beta*y,
+*
+*  where alpha and beta are scalars, x and y are vectors and A is an
+*  m by n band matrix, with kl sub-diagonals and ku super-diagonals.
+*
+*  Parameters
+*  ==========
+*
+*  TRANS  - CHARACTER*1.
+*           On entry, TRANS specifies the operation to be performed as
+*           follows:
+*
+*              TRANS = 'N' or 'n'   y := alpha*A*x + beta*y.
+*
+*              TRANS = 'T' or 't'   y := alpha*A'*x + beta*y.
+*
+*              TRANS = 'C' or 'c'   y := alpha*A'*x + beta*y.
+*
+*           Unchanged on exit.
+*
+*  M      - INTEGER.
+*           On entry, M specifies the number of rows of the matrix A.
+*           M must be at least zero.
+*           Unchanged on exit.
+*
+*  N      - INTEGER.
+*           On entry, N specifies the number of columns of the matrix A.
+*           N must be at least zero.
+*           Unchanged on exit.
+*
+*  KL     - INTEGER.
+*           On entry, KL specifies the number of sub-diagonals of the
+*           matrix A. KL must satisfy  0 .le. KL.
+*           Unchanged on exit.
+*
+*  KU     - INTEGER.
+*           On entry, KU specifies the number of super-diagonals of the
+*           matrix A. KU must satisfy  0 .le. KU.
+*           Unchanged on exit.
+*
+*  ALPHA  - DOUBLE PRECISION.
+*           On entry, ALPHA specifies the scalar alpha.
+*           Unchanged on exit.
+*
+*  A      - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+*           Before entry, the leading ( kl + ku + 1 ) by n part of the
+*           array A must contain the matrix of coefficients, supplied
+*           column by column, with the leading diagonal of the matrix in
+*           row ( ku + 1 ) of the array, the first super-diagonal
+*           starting at position 2 in row ku, the first sub-diagonal
+*           starting at position 1 in row ( ku + 2 ), and so on.
+*           Elements in the array A that do not correspond to elements
+*           in the band matrix (such as the top left ku by ku triangle)
+*           are not referenced.
+*           The following program segment will transfer a band matrix
+*           from conventional full matrix storage to band storage:
+*
+*                 DO 20, J = 1, N
+*                    K = KU + 1 - J
+*                    DO 10, I = MAX( 1, J - KU ), MIN( M, J + KL )
+*                       A( K + I, J ) = matrix( I, J )
+*              10    CONTINUE
+*              20 CONTINUE
+*
+*           Unchanged on exit.
+*
+*  LDA    - INTEGER.
+*           On entry, LDA specifies the first dimension of A as declared
+*           in the calling (sub) program. LDA must be at least
+*           ( kl + ku + 1 ).
+*           Unchanged on exit.
+*
+*  X      - DOUBLE PRECISION array of DIMENSION at least
+*           ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
+*           and at least
+*           ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
+*           Before entry, the incremented array X must contain the
+*           vector x.
+*           Unchanged on exit.
+*
+*  INCX   - INTEGER.
+*           On entry, INCX specifies the increment for the elements of
+*           X. INCX must not be zero.
+*           Unchanged on exit.
+*
+*  BETA   - DOUBLE PRECISION.
+*           On entry, BETA specifies the scalar beta. When BETA is
+*           supplied as zero then Y need not be set on input.
+*           Unchanged on exit.
+*
+*  Y      - DOUBLE PRECISION array of DIMENSION at least
+*           ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
+*           and at least
+*           ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
+*           Before entry, the incremented array Y must contain the
+*           vector y. On exit, Y is overwritten by the updated vector y.
+*
+*  INCY   - INTEGER.
+*           On entry, INCY specifies the increment for the elements of
+*           Y. INCY must not be zero.
+*           Unchanged on exit.
+*
+*
+*  Level 2 Blas routine.
+*
+*  -- Written on 22-October-1986.
+*     Jack Dongarra, Argonne National Lab.
+*     Jeremy Du Croz, Nag Central Office.
+*     Sven Hammarling, Nag Central Office.
+*     Richard Hanson, Sandia National Labs.
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ONE         , ZERO
+      PARAMETER        ( ONE = 1.0D+0, ZERO = 0.0D+0 )
+*     .. Local Scalars ..
+      DOUBLE PRECISION   TEMP
+      INTEGER            I, INFO, IX, IY, J, JX, JY, K, KUP1, KX, KY,
+     $                   LENX, LENY
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX, MIN
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF     ( .NOT.LSAME( TRANS, 'N' ).AND.
+     $         .NOT.LSAME( TRANS, 'T' ).AND.
+     $         .NOT.LSAME( TRANS, 'C' )      )THEN
+         INFO = 1
+      ELSE IF( M.LT.0 )THEN
+         INFO = 2
+      ELSE IF( N.LT.0 )THEN
+         INFO = 3
+      ELSE IF( KL.LT.0 )THEN
+         INFO = 4
+      ELSE IF( KU.LT.0 )THEN
+         INFO = 5
+      ELSE IF( LDA.LT.( KL + KU + 1 ) )THEN
+         INFO = 8
+      ELSE IF( INCX.EQ.0 )THEN
+         INFO = 10
+      ELSE IF( INCY.EQ.0 )THEN
+         INFO = 13
+      END IF
+      IF( INFO.NE.0 )THEN
+         CALL XERBLA( 'DGBMV ', INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF( ( M.EQ.0 ).OR.( N.EQ.0 ).OR.
+     $    ( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) ) )
+     $   RETURN
+*
+*     Set  LENX  and  LENY, the lengths of the vectors x and y, and set
+*     up the start points in  X  and  Y.
+*
+      IF( LSAME( TRANS, 'N' ) )THEN
+         LENX = N
+         LENY = M
+      ELSE
+         LENX = M
+         LENY = N
+      END IF
+      IF( INCX.GT.0 )THEN
+         KX = 1
+      ELSE
+         KX = 1 - ( LENX - 1 )*INCX
+      END IF
+      IF( INCY.GT.0 )THEN
+         KY = 1
+      ELSE
+         KY = 1 - ( LENY - 1 )*INCY
+      END IF
+*
+*     Start the operations. In this version the elements of A are
+*     accessed sequentially with one pass through the band part of A.
+*
+*     First form  y := beta*y.
+*
+      IF( BETA.NE.ONE )THEN
+         IF( INCY.EQ.1 )THEN
+            IF( BETA.EQ.ZERO )THEN
+               DO 10, I = 1, LENY
+                  Y( I ) = ZERO
+   10          CONTINUE
+            ELSE
+               DO 20, I = 1, LENY
+                  Y( I ) = BETA*Y( I )
+   20          CONTINUE
+            END IF
+         ELSE
+            IY = KY
+            IF( BETA.EQ.ZERO )THEN
+               DO 30, I = 1, LENY
+                  Y( IY ) = ZERO
+                  IY      = IY   + INCY
+   30          CONTINUE
+            ELSE
+               DO 40, I = 1, LENY
+                  Y( IY ) = BETA*Y( IY )
+                  IY      = IY           + INCY
+   40          CONTINUE
+            END IF
+         END IF
+      END IF
+      IF( ALPHA.EQ.ZERO )
+     $   RETURN
+      KUP1 = KU + 1
+      IF( LSAME( TRANS, 'N' ) )THEN
+*
+*        Form  y := alpha*A*x + y.
+*
+         JX = KX
+         IF( INCY.EQ.1 )THEN
+            DO 60, J = 1, N
+               IF( X( JX ).NE.ZERO )THEN
+                  TEMP = ALPHA*X( JX )
+                  K    = KUP1 - J
+                  DO 50, I = MAX( 1, J - KU ), MIN( M, J + KL )
+                     Y( I ) = Y( I ) + TEMP*A( K + I, J )
+   50             CONTINUE
+               END IF
+               JX = JX + INCX
+   60       CONTINUE
+         ELSE
+            DO 80, J = 1, N
+               IF( X( JX ).NE.ZERO )THEN
+                  TEMP = ALPHA*X( JX )
+                  IY   = KY
+                  K    = KUP1 - J
+                  DO 70, I = MAX( 1, J - KU ), MIN( M, J + KL )
+                     Y( IY ) = Y( IY ) + TEMP*A( K + I, J )
+                     IY      = IY      + INCY
+   70             CONTINUE
+               END IF
+               JX = JX + INCX
+               IF( J.GT.KU )
+     $            KY = KY + INCY
+   80       CONTINUE
+         END IF
+      ELSE
+*
+*        Form  y := alpha*A'*x + y.
+*
+         JY = KY
+         IF( INCX.EQ.1 )THEN
+            DO 100, J = 1, N
+               TEMP = ZERO
+               K    = KUP1 - J
+               DO 90, I = MAX( 1, J - KU ), MIN( M, J + KL )
+                  TEMP = TEMP + A( K + I, J )*X( I )
+   90          CONTINUE
+               Y( JY ) = Y( JY ) + ALPHA*TEMP
+               JY      = JY      + INCY
+  100       CONTINUE
+         ELSE
+            DO 120, J = 1, N
+               TEMP = ZERO
+               IX   = KX
+               K    = KUP1 - J
+               DO 110, I = MAX( 1, J - KU ), MIN( M, J + KL )
+                  TEMP = TEMP + A( K + I, J )*X( IX )
+                  IX   = IX   + INCX
+  110          CONTINUE
+               Y( JY ) = Y( JY ) + ALPHA*TEMP
+               JY      = JY      + INCY
+               IF( J.GT.KU )
+     $            KX = KX + INCX
+  120       CONTINUE
+         END IF
+      END IF
+*
+      RETURN
+*
+*     End of DGBMV .
+*
+      END
diff --git a/src/fortran/blas/dgemm.f b/src/fortran/blas/dgemm.f
new file mode 100644
index 0000000..1531fd5
--- /dev/null
+++ b/src/fortran/blas/dgemm.f
@@ -0,0 +1,315 @@
+      SUBROUTINE DGEMM ( TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB,
+     $                   BETA, C, LDC )
+*     .. Scalar Arguments ..
+      CHARACTER*1        TRANSA, TRANSB
+      INTEGER            M, N, K, LDA, LDB, LDC
+      DOUBLE PRECISION   ALPHA, BETA
+*     .. Array Arguments ..
+      DOUBLE PRECISION   A( LDA, * ), B( LDB, * ), C( LDC, * )
+*     ..
+C     WARNING : this routine has been modified for Scilab (see comments
+C     Cscilab)  because algorithm is not ok if A matrix contains NaN
+C     (NaN*0 should be NaN, not 0)
+*  Purpose
+*  =======
+*
+*  DGEMM  performs one of the matrix-matrix operations
+*
+*     C := alpha*op( A )*op( B ) + beta*C,
+*
+*  where  op( X ) is one of
+*
+*     op( X ) = X   or   op( X ) = X',
+*
+*  alpha and beta are scalars, and A, B and C are matrices, with op( A )
+*  an m by k matrix,  op( B )  a  k by n matrix and  C an m by n matrix.
+*
+*  Parameters
+*  ==========
+*
+*  TRANSA - CHARACTER*1.
+*           On entry, TRANSA specifies the form of op( A ) to be used in
+*           the matrix multiplication as follows:
+*
+*              TRANSA = 'N' or 'n',  op( A ) = A.
+*
+*              TRANSA = 'T' or 't',  op( A ) = A'.
+*
+*              TRANSA = 'C' or 'c',  op( A ) = A'.
+*
+*           Unchanged on exit.
+*
+*  TRANSB - CHARACTER*1.
+*           On entry, TRANSB specifies the form of op( B ) to be used in
+*           the matrix multiplication as follows:
+*
+*              TRANSB = 'N' or 'n',  op( B ) = B.
+*
+*              TRANSB = 'T' or 't',  op( B ) = B'.
+*
+*              TRANSB = 'C' or 'c',  op( B ) = B'.
+*
+*           Unchanged on exit.
+*
+*  M      - INTEGER.
+*           On entry,  M  specifies  the number  of rows  of the  matrix
+*           op( A )  and of the  matrix  C.  M  must  be at least  zero.
+*           Unchanged on exit.
+*
+*  N      - INTEGER.
+*           On entry,  N  specifies the number  of columns of the matrix
+*           op( B ) and the number of columns of the matrix C. N must be
+*           at least zero.
+*           Unchanged on exit.
+*
+*  K      - INTEGER.
+*           On entry,  K  specifies  the number of columns of the matrix
+*           op( A ) and the number of rows of the matrix op( B ). K must
+*           be at least  zero.
+*           Unchanged on exit.
+*
+*  ALPHA  - DOUBLE PRECISION.
+*           On entry, ALPHA specifies the scalar alpha.
+*           Unchanged on exit.
+*
+*  A      - DOUBLE PRECISION array of DIMENSION ( LDA, ka ), where ka is
+*           k  when  TRANSA = 'N' or 'n',  and is  m  otherwise.
+*           Before entry with  TRANSA = 'N' or 'n',  the leading  m by k
+*           part of the array  A  must contain the matrix  A,  otherwise
+*           the leading  k by m  part of the array  A  must contain  the
+*           matrix A.
+*           Unchanged on exit.
+*
+*  LDA    - INTEGER.
+*           On entry, LDA specifies the first dimension of A as declared
+*           in the calling (sub) program. When  TRANSA = 'N' or 'n' then
+*           LDA must be at least  max( 1, m ), otherwise  LDA must be at
+*           least  max( 1, k ).
+*           Unchanged on exit.
+*
+*  B      - DOUBLE PRECISION array of DIMENSION ( LDB, kb ), where kb is
+*           n  when  TRANSB = 'N' or 'n',  and is  k  otherwise.
+*           Before entry with  TRANSB = 'N' or 'n',  the leading  k by n
+*           part of the array  B  must contain the matrix  B,  otherwise
+*           the leading  n by k  part of the array  B  must contain  the
+*           matrix B.
+*           Unchanged on exit.
+*
+*  LDB    - INTEGER.
+*           On entry, LDB specifies the first dimension of B as declared
+*           in the calling (sub) program. When  TRANSB = 'N' or 'n' then
+*           LDB must be at least  max( 1, k ), otherwise  LDB must be at
+*           least  max( 1, n ).
+*           Unchanged on exit.
+*
+*  BETA   - DOUBLE PRECISION.
+*           On entry,  BETA  specifies the scalar  beta.  When  BETA  is
+*           supplied as zero then C need not be set on input.
+*           Unchanged on exit.
+*
+*  C      - DOUBLE PRECISION array of DIMENSION ( LDC, n ).
+*           Before entry, the leading  m by n  part of the array  C must
+*           contain the matrix  C,  except when  beta  is zero, in which
+*           case C need not be set on entry.
+*           On exit, the array  C  is overwritten by the  m by n  matrix
+*           ( alpha*op( A )*op( B ) + beta*C ).
+*
+*  LDC    - INTEGER.
+*           On entry, LDC specifies the first dimension of C as declared
+*           in  the  calling  (sub)  program.   LDC  must  be  at  least
+*           max( 1, m ).
+*           Unchanged on exit.
+*
+*
+*  Level 3 Blas routine.
+*
+*  -- Written on 8-February-1989.
+*     Jack Dongarra, Argonne National Laboratory.
+*     Iain Duff, AERE Harwell.
+*     Jeremy Du Croz, Numerical Algorithms Group Ltd.
+*     Sven Hammarling, Numerical Algorithms Group Ltd.
+*
+*
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     .. Local Scalars ..
+      LOGICAL            NOTA, NOTB
+      INTEGER            I, INFO, J, L, NCOLA, NROWA, NROWB
+      DOUBLE PRECISION   TEMP
+*     .. Parameters ..
+      DOUBLE PRECISION   ONE         , ZERO
+      PARAMETER        ( ONE = 1.0D+0, ZERO = 0.0D+0 )
+*     ..
+*     .. Executable Statements ..
+*
+*     Set  NOTA  and  NOTB  as  true if  A  and  B  respectively are not
+*     transposed and set  NROWA, NCOLA and  NROWB  as the number of rows
+*     and  columns of  A  and the  number of  rows  of  B  respectively.
+*
+      NOTA  = LSAME( TRANSA, 'N' )
+      NOTB  = LSAME( TRANSB, 'N' )
+      IF( NOTA )THEN
+         NROWA = M
+         NCOLA = K
+      ELSE
+         NROWA = K
+         NCOLA = M
+      END IF
+      IF( NOTB )THEN
+         NROWB = K
+      ELSE
+         NROWB = N
+      END IF
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF(      ( .NOT.NOTA                 ).AND.
+     $         ( .NOT.LSAME( TRANSA, 'C' ) ).AND.
+     $         ( .NOT.LSAME( TRANSA, 'T' ) )      )THEN
+         INFO = 1
+      ELSE IF( ( .NOT.NOTB                 ).AND.
+     $         ( .NOT.LSAME( TRANSB, 'C' ) ).AND.
+     $         ( .NOT.LSAME( TRANSB, 'T' ) )      )THEN
+         INFO = 2
+      ELSE IF( M  .LT.0               )THEN
+         INFO = 3
+      ELSE IF( N  .LT.0               )THEN
+         INFO = 4
+      ELSE IF( K  .LT.0               )THEN
+         INFO = 5
+      ELSE IF( LDA.LT.MAX( 1, NROWA ) )THEN
+         INFO = 8
+      ELSE IF( LDB.LT.MAX( 1, NROWB ) )THEN
+         INFO = 10
+      ELSE IF( LDC.LT.MAX( 1, M     ) )THEN
+         INFO = 13
+      END IF
+      IF( INFO.NE.0 )THEN
+         CALL XERBLA( 'DGEMM ', INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF( ( M.EQ.0 ).OR.( N.EQ.0 ).OR.
+     $    ( ( ( ALPHA.EQ.ZERO ).OR.( K.EQ.0 ) ).AND.( BETA.EQ.ONE ) ) )
+     $   RETURN
+*
+*     And if  alpha.eq.zero.
+*
+      IF( ALPHA.EQ.ZERO )THEN
+         IF( BETA.EQ.ZERO )THEN
+            DO 20, J = 1, N
+               DO 10, I = 1, M
+                  C( I, J ) = ZERO
+   10          CONTINUE
+   20       CONTINUE
+         ELSE
+            DO 40, J = 1, N
+               DO 30, I = 1, M
+                  C( I, J ) = BETA*C( I, J )
+   30          CONTINUE
+   40       CONTINUE
+         END IF
+         RETURN
+      END IF
+*
+*     Start the operations.
+*
+      IF( NOTB )THEN
+         IF( NOTA )THEN
+*
+*           Form  C := alpha*A*B + beta*C.
+*
+            DO 90, J = 1, N
+               IF( BETA.EQ.ZERO )THEN
+                  DO 50, I = 1, M
+                     C( I, J ) = ZERO
+   50             CONTINUE
+               ELSE IF( BETA.NE.ONE )THEN
+                  DO 60, I = 1, M
+                     C( I, J ) = BETA*C( I, J )
+   60             CONTINUE
+               END IF
+               DO 80, L = 1, K
+Cscilab                  IF( B( L, J ).NE.ZERO )THEN
+                     TEMP = ALPHA*B( L, J )
+                     DO 70, I = 1, M
+                        C( I, J ) = C( I, J ) + TEMP*A( I, L )
+   70                CONTINUE
+Cscilab                   END IF
+   80          CONTINUE
+   90       CONTINUE
+         ELSE
+*
+*           Form  C := alpha*A'*B + beta*C
+*
+            DO 120, J = 1, N
+               DO 110, I = 1, M
+                  TEMP = ZERO
+                  DO 100, L = 1, K
+                     TEMP = TEMP + A( L, I )*B( L, J )
+  100             CONTINUE
+                  IF( BETA.EQ.ZERO )THEN
+                     C( I, J ) = ALPHA*TEMP
+                  ELSE
+                     C( I, J ) = ALPHA*TEMP + BETA*C( I, J )
+                  END IF
+  110          CONTINUE
+  120       CONTINUE
+         END IF
+      ELSE
+         IF( NOTA )THEN
+*
+*           Form  C := alpha*A*B' + beta*C
+*
+            DO 170, J = 1, N
+               IF( BETA.EQ.ZERO )THEN
+                  DO 130, I = 1, M
+                     C( I, J ) = ZERO
+  130             CONTINUE
+               ELSE IF( BETA.NE.ONE )THEN
+                  DO 140, I = 1, M
+                     C( I, J ) = BETA*C( I, J )
+  140             CONTINUE
+               END IF
+               DO 160, L = 1, K
+Cscilab                   IF( B( J, L ).NE.ZERO )THEN
+                     TEMP = ALPHA*B( J, L )
+                     DO 150, I = 1, M
+                        C( I, J ) = C( I, J ) + TEMP*A( I, L )
+  150                CONTINUE
+Cscilab                   END IF
+  160          CONTINUE
+  170       CONTINUE
+         ELSE
+*
+*           Form  C := alpha*A'*B' + beta*C
+*
+            DO 200, J = 1, N
+               DO 190, I = 1, M
+                  TEMP = ZERO
+                  DO 180, L = 1, K
+                     TEMP = TEMP + A( L, I )*B( J, L )
+  180             CONTINUE
+                  IF( BETA.EQ.ZERO )THEN
+                     C( I, J ) = ALPHA*TEMP
+                  ELSE
+                     C( I, J ) = ALPHA*TEMP + BETA*C( I, J )
+                  END IF
+  190          CONTINUE
+  200       CONTINUE
+         END IF
+      END IF
+*
+      RETURN
+*
+*     End of DGEMM .
+*
+      END
diff --git a/src/fortran/blas/dgemv.f b/src/fortran/blas/dgemv.f
new file mode 100644
index 0000000..8ef80b3
--- /dev/null
+++ b/src/fortran/blas/dgemv.f
@@ -0,0 +1,261 @@
+      SUBROUTINE DGEMV ( TRANS, M, N, ALPHA, A, LDA, X, INCX,
+     $                   BETA, Y, INCY )
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION   ALPHA, BETA
+      INTEGER            INCX, INCY, LDA, M, N
+      CHARACTER*1        TRANS
+*     .. Array Arguments ..
+      DOUBLE PRECISION   A( LDA, * ), X( * ), Y( * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  DGEMV  performs one of the matrix-vector operations
+*
+*     y := alpha*A*x + beta*y,   or   y := alpha*A'*x + beta*y,
+*
+*  where alpha and beta are scalars, x and y are vectors and A is an
+*  m by n matrix.
+*
+*  Parameters
+*  ==========
+*
+*  TRANS  - CHARACTER*1.
+*           On entry, TRANS specifies the operation to be performed as
+*           follows:
+*
+*              TRANS = 'N' or 'n'   y := alpha*A*x + beta*y.
+*
+*              TRANS = 'T' or 't'   y := alpha*A'*x + beta*y.
+*
+*              TRANS = 'C' or 'c'   y := alpha*A'*x + beta*y.
+*
+*           Unchanged on exit.
+*
+*  M      - INTEGER.
+*           On entry, M specifies the number of rows of the matrix A.
+*           M must be at least zero.
+*           Unchanged on exit.
+*
+*  N      - INTEGER.
+*           On entry, N specifies the number of columns of the matrix A.
+*           N must be at least zero.
+*           Unchanged on exit.
+*
+*  ALPHA  - DOUBLE PRECISION.
+*           On entry, ALPHA specifies the scalar alpha.
+*           Unchanged on exit.
+*
+*  A      - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+*           Before entry, the leading m by n part of the array A must
+*           contain the matrix of coefficients.
+*           Unchanged on exit.
+*
+*  LDA    - INTEGER.
+*           On entry, LDA specifies the first dimension of A as declared
+*           in the calling (sub) program. LDA must be at least
+*           max( 1, m ).
+*           Unchanged on exit.
+*
+*  X      - DOUBLE PRECISION array of DIMENSION at least
+*           ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
+*           and at least
+*           ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
+*           Before entry, the incremented array X must contain the
+*           vector x.
+*           Unchanged on exit.
+*
+*  INCX   - INTEGER.
+*           On entry, INCX specifies the increment for the elements of
+*           X. INCX must not be zero.
+*           Unchanged on exit.
+*
+*  BETA   - DOUBLE PRECISION.
+*           On entry, BETA specifies the scalar beta. When BETA is
+*           supplied as zero then Y need not be set on input.
+*           Unchanged on exit.
+*
+*  Y      - DOUBLE PRECISION array of DIMENSION at least
+*           ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
+*           and at least
+*           ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
+*           Before entry with BETA non-zero, the incremented array Y
+*           must contain the vector y. On exit, Y is overwritten by the
+*           updated vector y.
+*
+*  INCY   - INTEGER.
+*           On entry, INCY specifies the increment for the elements of
+*           Y. INCY must not be zero.
+*           Unchanged on exit.
+*
+*
+*  Level 2 Blas routine.
+*
+*  -- Written on 22-October-1986.
+*     Jack Dongarra, Argonne National Lab.
+*     Jeremy Du Croz, Nag Central Office.
+*     Sven Hammarling, Nag Central Office.
+*     Richard Hanson, Sandia National Labs.
+*
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ONE         , ZERO
+      PARAMETER        ( ONE = 1.0D+0, ZERO = 0.0D+0 )
+*     .. Local Scalars ..
+      DOUBLE PRECISION   TEMP
+      INTEGER            I, INFO, IX, IY, J, JX, JY, KX, KY, LENX, LENY
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF     ( .NOT.LSAME( TRANS, 'N' ).AND.
+     $         .NOT.LSAME( TRANS, 'T' ).AND.
+     $         .NOT.LSAME( TRANS, 'C' )      )THEN
+         INFO = 1
+      ELSE IF( M.LT.0 )THEN
+         INFO = 2
+      ELSE IF( N.LT.0 )THEN
+         INFO = 3
+      ELSE IF( LDA.LT.MAX( 1, M ) )THEN
+         INFO = 6
+      ELSE IF( INCX.EQ.0 )THEN
+         INFO = 8
+      ELSE IF( INCY.EQ.0 )THEN
+         INFO = 11
+      END IF
+      IF( INFO.NE.0 )THEN
+         CALL XERBLA( 'DGEMV ', INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF( ( M.EQ.0 ).OR.( N.EQ.0 ).OR.
+     $    ( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) ) )
+     $   RETURN
+*
+*     Set  LENX  and  LENY, the lengths of the vectors x and y, and set
+*     up the start points in  X  and  Y.
+*
+      IF( LSAME( TRANS, 'N' ) )THEN
+         LENX = N
+         LENY = M
+      ELSE
+         LENX = M
+         LENY = N
+      END IF
+      IF( INCX.GT.0 )THEN
+         KX = 1
+      ELSE
+         KX = 1 - ( LENX - 1 )*INCX
+      END IF
+      IF( INCY.GT.0 )THEN
+         KY = 1
+      ELSE
+         KY = 1 - ( LENY - 1 )*INCY
+      END IF
+*
+*     Start the operations. In this version the elements of A are
+*     accessed sequentially with one pass through A.
+*
+*     First form  y := beta*y.
+*
+      IF( BETA.NE.ONE )THEN
+         IF( INCY.EQ.1 )THEN
+            IF( BETA.EQ.ZERO )THEN
+               DO 10, I = 1, LENY
+                  Y( I ) = ZERO
+   10          CONTINUE
+            ELSE
+               DO 20, I = 1, LENY
+                  Y( I ) = BETA*Y( I )
+   20          CONTINUE
+            END IF
+         ELSE
+            IY = KY
+            IF( BETA.EQ.ZERO )THEN
+               DO 30, I = 1, LENY
+                  Y( IY ) = ZERO
+                  IY      = IY   + INCY
+   30          CONTINUE
+            ELSE
+               DO 40, I = 1, LENY
+                  Y( IY ) = BETA*Y( IY )
+                  IY      = IY           + INCY
+   40          CONTINUE
+            END IF
+         END IF
+      END IF
+      IF( ALPHA.EQ.ZERO )
+     $   RETURN
+      IF( LSAME( TRANS, 'N' ) )THEN
+*
+*        Form  y := alpha*A*x + y.
+*
+         JX = KX
+         IF( INCY.EQ.1 )THEN
+            DO 60, J = 1, N
+               IF( X( JX ).NE.ZERO )THEN
+                  TEMP = ALPHA*X( JX )
+                  DO 50, I = 1, M
+                     Y( I ) = Y( I ) + TEMP*A( I, J )
+   50             CONTINUE
+               END IF
+               JX = JX + INCX
+   60       CONTINUE
+         ELSE
+            DO 80, J = 1, N
+               IF( X( JX ).NE.ZERO )THEN
+                  TEMP = ALPHA*X( JX )
+                  IY   = KY
+                  DO 70, I = 1, M
+                     Y( IY ) = Y( IY ) + TEMP*A( I, J )
+                     IY      = IY      + INCY
+   70             CONTINUE
+               END IF
+               JX = JX + INCX
+   80       CONTINUE
+         END IF
+      ELSE
+*
+*        Form  y := alpha*A'*x + y.
+*
+         JY = KY
+         IF( INCX.EQ.1 )THEN
+            DO 100, J = 1, N
+               TEMP = ZERO
+               DO 90, I = 1, M
+                  TEMP = TEMP + A( I, J )*X( I )
+   90          CONTINUE
+               Y( JY ) = Y( JY ) + ALPHA*TEMP
+               JY      = JY      + INCY
+  100       CONTINUE
+         ELSE
+            DO 120, J = 1, N
+               TEMP = ZERO
+               IX   = KX
+               DO 110, I = 1, M
+                  TEMP = TEMP + A( I, J )*X( IX )
+                  IX   = IX   + INCX
+  110          CONTINUE
+               Y( JY ) = Y( JY ) + ALPHA*TEMP
+               JY      = JY      + INCY
+  120       CONTINUE
+         END IF
+      END IF
+*
+      RETURN
+*
+*     End of DGEMV .
+*
+      END
diff --git a/src/fortran/blas/dger.f b/src/fortran/blas/dger.f
new file mode 100644
index 0000000..d316000
--- /dev/null
+++ b/src/fortran/blas/dger.f
@@ -0,0 +1,157 @@
+      SUBROUTINE DGER  ( M, N, ALPHA, X, INCX, Y, INCY, A, LDA )
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION   ALPHA
+      INTEGER            INCX, INCY, LDA, M, N
+*     .. Array Arguments ..
+      DOUBLE PRECISION   A( LDA, * ), X( * ), Y( * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  DGER   performs the rank 1 operation
+*
+*     A := alpha*x*y' + A,
+*
+*  where alpha is a scalar, x is an m element vector, y is an n element
+*  vector and A is an m by n matrix.
+*
+*  Parameters
+*  ==========
+*
+*  M      - INTEGER.
+*           On entry, M specifies the number of rows of the matrix A.
+*           M must be at least zero.
+*           Unchanged on exit.
+*
+*  N      - INTEGER.
+*           On entry, N specifies the number of columns of the matrix A.
+*           N must be at least zero.
+*           Unchanged on exit.
+*
+*  ALPHA  - DOUBLE PRECISION.
+*           On entry, ALPHA specifies the scalar alpha.
+*           Unchanged on exit.
+*
+*  X      - DOUBLE PRECISION array of dimension at least
+*           ( 1 + ( m - 1 )*abs( INCX ) ).
+*           Before entry, the incremented array X must contain the m
+*           element vector x.
+*           Unchanged on exit.
+*
+*  INCX   - INTEGER.
+*           On entry, INCX specifies the increment for the elements of
+*           X. INCX must not be zero.
+*           Unchanged on exit.
+*
+*  Y      - DOUBLE PRECISION array of dimension at least
+*           ( 1 + ( n - 1 )*abs( INCY ) ).
+*           Before entry, the incremented array Y must contain the n
+*           element vector y.
+*           Unchanged on exit.
+*
+*  INCY   - INTEGER.
+*           On entry, INCY specifies the increment for the elements of
+*           Y. INCY must not be zero.
+*           Unchanged on exit.
+*
+*  A      - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+*           Before entry, the leading m by n part of the array A must
+*           contain the matrix of coefficients. On exit, A is
+*           overwritten by the updated matrix.
+*
+*  LDA    - INTEGER.
+*           On entry, LDA specifies the first dimension of A as declared
+*           in the calling (sub) program. LDA must be at least
+*           max( 1, m ).
+*           Unchanged on exit.
+*
+*
+*  Level 2 Blas routine.
+*
+*  -- Written on 22-October-1986.
+*     Jack Dongarra, Argonne National Lab.
+*     Jeremy Du Croz, Nag Central Office.
+*     Sven Hammarling, Nag Central Office.
+*     Richard Hanson, Sandia National Labs.
+*
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO
+      PARAMETER        ( ZERO = 0.0D+0 )
+*     .. Local Scalars ..
+      DOUBLE PRECISION   TEMP
+      INTEGER            I, INFO, IX, J, JY, KX
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF     ( M.LT.0 )THEN
+         INFO = 1
+      ELSE IF( N.LT.0 )THEN
+         INFO = 2
+      ELSE IF( INCX.EQ.0 )THEN
+         INFO = 5
+      ELSE IF( INCY.EQ.0 )THEN
+         INFO = 7
+      ELSE IF( LDA.LT.MAX( 1, M ) )THEN
+         INFO = 9
+      END IF
+      IF( INFO.NE.0 )THEN
+         CALL XERBLA( 'DGER  ', INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF( ( M.EQ.0 ).OR.( N.EQ.0 ).OR.( ALPHA.EQ.ZERO ) )
+     $   RETURN
+*
+*     Start the operations. In this version the elements of A are
+*     accessed sequentially with one pass through A.
+*
+      IF( INCY.GT.0 )THEN
+         JY = 1
+      ELSE
+         JY = 1 - ( N - 1 )*INCY
+      END IF
+      IF( INCX.EQ.1 )THEN
+         DO 20, J = 1, N
+            IF( Y( JY ).NE.ZERO )THEN
+               TEMP = ALPHA*Y( JY )
+               DO 10, I = 1, M
+                  A( I, J ) = A( I, J ) + X( I )*TEMP
+   10          CONTINUE
+            END IF
+            JY = JY + INCY
+   20    CONTINUE
+      ELSE
+         IF( INCX.GT.0 )THEN
+            KX = 1
+         ELSE
+            KX = 1 - ( M - 1 )*INCX
+         END IF
+         DO 40, J = 1, N
+            IF( Y( JY ).NE.ZERO )THEN
+               TEMP = ALPHA*Y( JY )
+               IX   = KX
+               DO 30, I = 1, M
+                  A( I, J ) = A( I, J ) + X( IX )*TEMP
+                  IX        = IX        + INCX
+   30          CONTINUE
+            END IF
+            JY = JY + INCY
+   40    CONTINUE
+      END IF
+*
+      RETURN
+*
+*     End of DGER  .
+*
+      END
diff --git a/src/fortran/blas/dnrm2.f b/src/fortran/blas/dnrm2.f
new file mode 100644
index 0000000..119d047
--- /dev/null
+++ b/src/fortran/blas/dnrm2.f
@@ -0,0 +1,60 @@
+      DOUBLE PRECISION FUNCTION DNRM2 ( N, X, INCX )
+*     .. Scalar Arguments ..
+      INTEGER                           INCX, N
+*     .. Array Arguments ..
+      DOUBLE PRECISION                  X( * )
+*     ..
+*
+*  DNRM2 returns the euclidean norm of a vector via the function
+*  name, so that
+*
+*     DNRM2 := sqrt( x'*x )
+*
+*
+*
+*  -- This version written on 25-October-1982.
+*     Modified on 14-October-1993 to inline the call to DLASSQ.
+*     Sven Hammarling, Nag Ltd.
+*
+*
+*     .. Parameters ..
+      DOUBLE PRECISION      ONE         , ZERO
+      PARAMETER           ( ONE = 1.0D+0, ZERO = 0.0D+0 )
+*     .. Local Scalars ..
+      INTEGER               IX
+      DOUBLE PRECISION      ABSXI, NORM, SCALE, SSQ
+*     .. Intrinsic Functions ..
+      INTRINSIC             ABS, SQRT
+*     ..
+*     .. Executable Statements ..
+      IF( N.LT.1 .OR. INCX.LT.1 )THEN
+         NORM  = ZERO
+      ELSE IF( N.EQ.1 )THEN
+         NORM  = ABS( X( 1 ) )
+      ELSE
+         SCALE = ZERO
+         SSQ   = ONE
+*        The following loop is equivalent to this call to the LAPACK
+*        auxiliary routine:
+*        CALL DLASSQ( N, X, INCX, SCALE, SSQ )
+*
+         DO 10, IX = 1, 1 + ( N - 1 )*INCX, INCX
+            IF( X( IX ).NE.ZERO )THEN
+               ABSXI = ABS( X( IX ) )
+               IF( SCALE.LT.ABSXI )THEN
+                  SSQ   = ONE   + SSQ*( SCALE/ABSXI )**2
+                  SCALE = ABSXI
+               ELSE
+                  SSQ   = SSQ   +     ( ABSXI/SCALE )**2
+               END IF
+            END IF
+   10    CONTINUE
+         NORM  = SCALE * SQRT( SSQ )
+      END IF
+*
+      DNRM2 = NORM
+      RETURN
+*
+*     End of DNRM2.
+*
+      END
diff --git a/src/fortran/blas/drot.f b/src/fortran/blas/drot.f
new file mode 100644
index 0000000..b9ea3bd
--- /dev/null
+++ b/src/fortran/blas/drot.f
@@ -0,0 +1,37 @@
+      subroutine  drot (n,dx,incx,dy,incy,c,s)
+c
+c     applies a plane rotation.
+c     jack dongarra, linpack, 3/11/78.
+c     modified 12/3/93, array(1) declarations changed to array(*)
+c
+      double precision dx(*),dy(*),dtemp,c,s
+      integer i,incx,incy,ix,iy,n
+c
+      if(n.le.0)return
+      if(incx.eq.1.and.incy.eq.1)go to 20
+c
+c       code for unequal increments or equal increments not equal
+c         to 1
+c
+      ix = 1
+      iy = 1
+      if(incx.lt.0)ix = (-n+1)*incx + 1
+      if(incy.lt.0)iy = (-n+1)*incy + 1
+      do 10 i = 1,n
+        dtemp = c*dx(ix) + s*dy(iy)
+        dy(iy) = c*dy(iy) - s*dx(ix)
+        dx(ix) = dtemp
+        ix = ix + incx
+        iy = iy + incy
+   10 continue
+      return
+c
+c       code for both increments equal to 1
+c
+   20 do 30 i = 1,n
+        dtemp = c*dx(i) + s*dy(i)
+        dy(i) = c*dy(i) - s*dx(i)
+        dx(i) = dtemp
+   30 continue
+      return
+      end
diff --git a/src/fortran/blas/drotg.f b/src/fortran/blas/drotg.f
new file mode 100644
index 0000000..67838e2
--- /dev/null
+++ b/src/fortran/blas/drotg.f
@@ -0,0 +1,27 @@
+      subroutine drotg(da,db,c,s)
+c
+c     construct givens plane rotation.
+c     jack dongarra, linpack, 3/11/78.
+c
+      double precision da,db,c,s,roe,scale,r,z
+c
+      roe = db
+      if( dabs(da) .gt. dabs(db) ) roe = da
+      scale = dabs(da) + dabs(db)
+      if( scale .ne. 0.0d0 ) go to 10
+         c = 1.0d0
+         s = 0.0d0
+         r = 0.0d0
+         z = 0.0d0
+         go to 20
+   10 r = scale*dsqrt((da/scale)**2 + (db/scale)**2)
+      r = dsign(1.0d0,roe)*r
+      c = da/r
+      s = db/r
+      z = 1.0d0
+      if( dabs(da) .gt. dabs(db) ) z = s
+      if( dabs(db) .ge. dabs(da) .and. c .ne. 0.0d0 ) z = 1.0d0/c
+   20 da = r
+      db = z
+      return
+      end
diff --git a/src/fortran/blas/dsbmv.f b/src/fortran/blas/dsbmv.f
new file mode 100644
index 0000000..272042a
--- /dev/null
+++ b/src/fortran/blas/dsbmv.f
@@ -0,0 +1,303 @@
+      SUBROUTINE DSBMV ( UPLO, N, K, ALPHA, A, LDA, X, INCX,
+     $                   BETA, Y, INCY )
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION   ALPHA, BETA
+      INTEGER            INCX, INCY, K, LDA, N
+      CHARACTER*1        UPLO
+*     .. Array Arguments ..
+      DOUBLE PRECISION   A( LDA, * ), X( * ), Y( * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  DSBMV  performs the matrix-vector  operation
+*
+*     y := alpha*A*x + beta*y,
+*
+*  where alpha and beta are scalars, x and y are n element vectors and
+*  A is an n by n symmetric band matrix, with k super-diagonals.
+*
+*  Parameters
+*  ==========
+*
+*  UPLO   - CHARACTER*1.
+*           On entry, UPLO specifies whether the upper or lower
+*           triangular part of the band matrix A is being supplied as
+*           follows:
+*
+*              UPLO = 'U' or 'u'   The upper triangular part of A is
+*                                  being supplied.
+*
+*              UPLO = 'L' or 'l'   The lower triangular part of A is
+*                                  being supplied.
+*
+*           Unchanged on exit.
+*
+*  N      - INTEGER.
+*           On entry, N specifies the order of the matrix A.
+*           N must be at least zero.
+*           Unchanged on exit.
+*
+*  K      - INTEGER.
+*           On entry, K specifies the number of super-diagonals of the
+*           matrix A. K must satisfy  0 .le. K.
+*           Unchanged on exit.
+*
+*  ALPHA  - DOUBLE PRECISION.
+*           On entry, ALPHA specifies the scalar alpha.
+*           Unchanged on exit.
+*
+*  A      - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+*           Before entry with UPLO = 'U' or 'u', the leading ( k + 1 )
+*           by n part of the array A must contain the upper triangular
+*           band part of the symmetric matrix, supplied column by
+*           column, with the leading diagonal of the matrix in row
+*           ( k + 1 ) of the array, the first super-diagonal starting at
+*           position 2 in row k, and so on. The top left k by k triangle
+*           of the array A is not referenced.
+*           The following program segment will transfer the upper
+*           triangular part of a symmetric band matrix from conventional
+*           full matrix storage to band storage:
+*
+*                 DO 20, J = 1, N
+*                    M = K + 1 - J
+*                    DO 10, I = MAX( 1, J - K ), J
+*                       A( M + I, J ) = matrix( I, J )
+*              10    CONTINUE
+*              20 CONTINUE
+*
+*           Before entry with UPLO = 'L' or 'l', the leading ( k + 1 )
+*           by n part of the array A must contain the lower triangular
+*           band part of the symmetric matrix, supplied column by
+*           column, with the leading diagonal of the matrix in row 1 of
+*           the array, the first sub-diagonal starting at position 1 in
+*           row 2, and so on. The bottom right k by k triangle of the
+*           array A is not referenced.
+*           The following program segment will transfer the lower
+*           triangular part of a symmetric band matrix from conventional
+*           full matrix storage to band storage:
+*
+*                 DO 20, J = 1, N
+*                    M = 1 - J
+*                    DO 10, I = J, MIN( N, J + K )
+*                       A( M + I, J ) = matrix( I, J )
+*              10    CONTINUE
+*              20 CONTINUE
+*
+*           Unchanged on exit.
+*
+*  LDA    - INTEGER.
+*           On entry, LDA specifies the first dimension of A as declared
+*           in the calling (sub) program. LDA must be at least
+*           ( k + 1 ).
+*           Unchanged on exit.
+*
+*  X      - DOUBLE PRECISION array of DIMENSION at least
+*           ( 1 + ( n - 1 )*abs( INCX ) ).
+*           Before entry, the incremented array X must contain the
+*           vector x.
+*           Unchanged on exit.
+*
+*  INCX   - INTEGER.
+*           On entry, INCX specifies the increment for the elements of
+*           X. INCX must not be zero.
+*           Unchanged on exit.
+*
+*  BETA   - DOUBLE PRECISION.
+*           On entry, BETA specifies the scalar beta.
+*           Unchanged on exit.
+*
+*  Y      - DOUBLE PRECISION array of DIMENSION at least
+*           ( 1 + ( n - 1 )*abs( INCY ) ).
+*           Before entry, the incremented array Y must contain the
+*           vector y. On exit, Y is overwritten by the updated vector y.
+*
+*  INCY   - INTEGER.
+*           On entry, INCY specifies the increment for the elements of
+*           Y. INCY must not be zero.
+*           Unchanged on exit.
+*
+*
+*  Level 2 Blas routine.
+*
+*  -- Written on 22-October-1986.
+*     Jack Dongarra, Argonne National Lab.
+*     Jeremy Du Croz, Nag Central Office.
+*     Sven Hammarling, Nag Central Office.
+*     Richard Hanson, Sandia National Labs.
+*
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ONE         , ZERO
+      PARAMETER        ( ONE = 1.0D+0, ZERO = 0.0D+0 )
+*     .. Local Scalars ..
+      DOUBLE PRECISION   TEMP1, TEMP2
+      INTEGER            I, INFO, IX, IY, J, JX, JY, KPLUS1, KX, KY, L
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX, MIN
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF     ( .NOT.LSAME( UPLO, 'U' ).AND.
+     $         .NOT.LSAME( UPLO, 'L' )      )THEN
+         INFO = 1
+      ELSE IF( N.LT.0 )THEN
+         INFO = 2
+      ELSE IF( K.LT.0 )THEN
+         INFO = 3
+      ELSE IF( LDA.LT.( K + 1 ) )THEN
+         INFO = 6
+      ELSE IF( INCX.EQ.0 )THEN
+         INFO = 8
+      ELSE IF( INCY.EQ.0 )THEN
+         INFO = 11
+      END IF
+      IF( INFO.NE.0 )THEN
+         CALL XERBLA( 'DSBMV ', INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF( ( N.EQ.0 ).OR.( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) ) )
+     $   RETURN
+*
+*     Set up the start points in  X  and  Y.
+*
+      IF( INCX.GT.0 )THEN
+         KX = 1
+      ELSE
+         KX = 1 - ( N - 1 )*INCX
+      END IF
+      IF( INCY.GT.0 )THEN
+         KY = 1
+      ELSE
+         KY = 1 - ( N - 1 )*INCY
+      END IF
+*
+*     Start the operations. In this version the elements of the array A
+*     are accessed sequentially with one pass through A.
+*
+*     First form  y := beta*y.
+*
+      IF( BETA.NE.ONE )THEN
+         IF( INCY.EQ.1 )THEN
+            IF( BETA.EQ.ZERO )THEN
+               DO 10, I = 1, N
+                  Y( I ) = ZERO
+   10          CONTINUE
+            ELSE
+               DO 20, I = 1, N
+                  Y( I ) = BETA*Y( I )
+   20          CONTINUE
+            END IF
+         ELSE
+            IY = KY
+            IF( BETA.EQ.ZERO )THEN
+               DO 30, I = 1, N
+                  Y( IY ) = ZERO
+                  IY      = IY   + INCY
+   30          CONTINUE
+            ELSE
+               DO 40, I = 1, N
+                  Y( IY ) = BETA*Y( IY )
+                  IY      = IY           + INCY
+   40          CONTINUE
+            END IF
+         END IF
+      END IF
+      IF( ALPHA.EQ.ZERO )
+     $   RETURN
+      IF( LSAME( UPLO, 'U' ) )THEN
+*
+*        Form  y  when upper triangle of A is stored.
+*
+         KPLUS1 = K + 1
+         IF( ( INCX.EQ.1 ).AND.( INCY.EQ.1 ) )THEN
+            DO 60, J = 1, N
+               TEMP1 = ALPHA*X( J )
+               TEMP2 = ZERO
+               L     = KPLUS1 - J
+               DO 50, I = MAX( 1, J - K ), J - 1
+                  Y( I ) = Y( I ) + TEMP1*A( L + I, J )
+                  TEMP2  = TEMP2  + A( L + I, J )*X( I )
+   50          CONTINUE
+               Y( J ) = Y( J ) + TEMP1*A( KPLUS1, J ) + ALPHA*TEMP2
+   60       CONTINUE
+         ELSE
+            JX = KX
+            JY = KY
+            DO 80, J = 1, N
+               TEMP1 = ALPHA*X( JX )
+               TEMP2 = ZERO
+               IX    = KX
+               IY    = KY
+               L     = KPLUS1 - J
+               DO 70, I = MAX( 1, J - K ), J - 1
+                  Y( IY ) = Y( IY ) + TEMP1*A( L + I, J )
+                  TEMP2   = TEMP2   + A( L + I, J )*X( IX )
+                  IX      = IX      + INCX
+                  IY      = IY      + INCY
+   70          CONTINUE
+               Y( JY ) = Y( JY ) + TEMP1*A( KPLUS1, J ) + ALPHA*TEMP2
+               JX      = JX      + INCX
+               JY      = JY      + INCY
+               IF( J.GT.K )THEN
+                  KX = KX + INCX
+                  KY = KY + INCY
+               END IF
+   80       CONTINUE
+         END IF
+      ELSE
+*
+*        Form  y  when lower triangle of A is stored.
+*
+         IF( ( INCX.EQ.1 ).AND.( INCY.EQ.1 ) )THEN
+            DO 100, J = 1, N
+               TEMP1  = ALPHA*X( J )
+               TEMP2  = ZERO
+               Y( J ) = Y( J )       + TEMP1*A( 1, J )
+               L      = 1            - J
+               DO 90, I = J + 1, MIN( N, J + K )
+                  Y( I ) = Y( I ) + TEMP1*A( L + I, J )
+                  TEMP2  = TEMP2  + A( L + I, J )*X( I )
+   90          CONTINUE
+               Y( J ) = Y( J ) + ALPHA*TEMP2
+  100       CONTINUE
+         ELSE
+            JX = KX
+            JY = KY
+            DO 120, J = 1, N
+               TEMP1   = ALPHA*X( JX )
+               TEMP2   = ZERO
+               Y( JY ) = Y( JY )       + TEMP1*A( 1, J )
+               L       = 1             - J
+               IX      = JX
+               IY      = JY
+               DO 110, I = J + 1, MIN( N, J + K )
+                  IX      = IX      + INCX
+                  IY      = IY      + INCY
+                  Y( IY ) = Y( IY ) + TEMP1*A( L + I, J )
+                  TEMP2   = TEMP2   + A( L + I, J )*X( IX )
+  110          CONTINUE
+               Y( JY ) = Y( JY ) + ALPHA*TEMP2
+               JX      = JX      + INCX
+               JY      = JY      + INCY
+  120       CONTINUE
+         END IF
+      END IF
+*
+      RETURN
+*
+*     End of DSBMV .
+*
+      END
diff --git a/src/fortran/blas/dscal.f b/src/fortran/blas/dscal.f
new file mode 100644
index 0000000..e1467fa
--- /dev/null
+++ b/src/fortran/blas/dscal.f
@@ -0,0 +1,43 @@
+      subroutine  dscal(n,da,dx,incx)
+c
+c     scales a vector by a constant.
+c     uses unrolled loops for increment equal to one.
+c     jack dongarra, linpack, 3/11/78.
+c     modified 3/93 to return if incx .le. 0.
+c     modified 12/3/93, array(1) declarations changed to array(*)
+c
+      double precision da,dx(*)
+      integer i,incx,m,mp1,n,nincx
+c
+      if( n.le.0 .or. incx.le.0 )return
+      if(incx.eq.1)go to 20
+c
+c        code for increment not equal to 1
+c
+      nincx = n*incx
+      do 10 i = 1,nincx,incx
+        dx(i) = da*dx(i)
+   10 continue
+      return
+c
+c        code for increment equal to 1
+c
+c
+c        clean-up loop
+c
+   20 m = mod(n,5)
+      if( m .eq. 0 ) go to 40
+      do 30 i = 1,m
+        dx(i) = da*dx(i)
+   30 continue
+      if( n .lt. 5 ) return
+   40 mp1 = m + 1
+      do 50 i = mp1,n,5
+        dx(i) = da*dx(i)
+        dx(i + 1) = da*dx(i + 1)
+        dx(i + 2) = da*dx(i + 2)
+        dx(i + 3) = da*dx(i + 3)
+        dx(i + 4) = da*dx(i + 4)
+   50 continue
+      return
+      end
diff --git a/src/fortran/blas/dspmv.f b/src/fortran/blas/dspmv.f
new file mode 100644
index 0000000..3ace7bf
--- /dev/null
+++ b/src/fortran/blas/dspmv.f
@@ -0,0 +1,262 @@
+      SUBROUTINE DSPMV ( UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY )
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION   ALPHA, BETA
+      INTEGER            INCX, INCY, N
+      CHARACTER*1        UPLO
+*     .. Array Arguments ..
+      DOUBLE PRECISION   AP( * ), X( * ), Y( * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  DSPMV  performs the matrix-vector operation
+*
+*     y := alpha*A*x + beta*y,
+*
+*  where alpha and beta are scalars, x and y are n element vectors and
+*  A is an n by n symmetric matrix, supplied in packed form.
+*
+*  Parameters
+*  ==========
+*
+*  UPLO   - CHARACTER*1.
+*           On entry, UPLO specifies whether the upper or lower
+*           triangular part of the matrix A is supplied in the packed
+*           array AP as follows:
+*
+*              UPLO = 'U' or 'u'   The upper triangular part of A is
+*                                  supplied in AP.
+*
+*              UPLO = 'L' or 'l'   The lower triangular part of A is
+*                                  supplied in AP.
+*
+*           Unchanged on exit.
+*
+*  N      - INTEGER.
+*           On entry, N specifies the order of the matrix A.
+*           N must be at least zero.
+*           Unchanged on exit.
+*
+*  ALPHA  - DOUBLE PRECISION.
+*           On entry, ALPHA specifies the scalar alpha.
+*           Unchanged on exit.
+*
+*  AP     - DOUBLE PRECISION array of DIMENSION at least
+*           ( ( n*( n + 1 ) )/2 ).
+*           Before entry with UPLO = 'U' or 'u', the array AP must
+*           contain the upper triangular part of the symmetric matrix
+*           packed sequentially, column by column, so that AP( 1 )
+*           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 )
+*           and a( 2, 2 ) respectively, and so on.
+*           Before entry with UPLO = 'L' or 'l', the array AP must
+*           contain the lower triangular part of the symmetric matrix
+*           packed sequentially, column by column, so that AP( 1 )
+*           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 )
+*           and a( 3, 1 ) respectively, and so on.
+*           Unchanged on exit.
+*
+*  X      - DOUBLE PRECISION array of dimension at least
+*           ( 1 + ( n - 1 )*abs( INCX ) ).
+*           Before entry, the incremented array X must contain the n
+*           element vector x.
+*           Unchanged on exit.
+*
+*  INCX   - INTEGER.
+*           On entry, INCX specifies the increment for the elements of
+*           X. INCX must not be zero.
+*           Unchanged on exit.
+*
+*  BETA   - DOUBLE PRECISION.
+*           On entry, BETA specifies the scalar beta. When BETA is
+*           supplied as zero then Y need not be set on input.
+*           Unchanged on exit.
+*
+*  Y      - DOUBLE PRECISION array of dimension at least
+*           ( 1 + ( n - 1 )*abs( INCY ) ).
+*           Before entry, the incremented array Y must contain the n
+*           element vector y. On exit, Y is overwritten by the updated
+*           vector y.
+*
+*  INCY   - INTEGER.
+*           On entry, INCY specifies the increment for the elements of
+*           Y. INCY must not be zero.
+*           Unchanged on exit.
+*
+*
+*  Level 2 Blas routine.
+*
+*  -- Written on 22-October-1986.
+*     Jack Dongarra, Argonne National Lab.
+*     Jeremy Du Croz, Nag Central Office.
+*     Sven Hammarling, Nag Central Office.
+*     Richard Hanson, Sandia National Labs.
+*
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ONE         , ZERO
+      PARAMETER        ( ONE = 1.0D+0, ZERO = 0.0D+0 )
+*     .. Local Scalars ..
+      DOUBLE PRECISION   TEMP1, TEMP2
+      INTEGER            I, INFO, IX, IY, J, JX, JY, K, KK, KX, KY
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF     ( .NOT.LSAME( UPLO, 'U' ).AND.
+     $         .NOT.LSAME( UPLO, 'L' )      )THEN
+         INFO = 1
+      ELSE IF( N.LT.0 )THEN
+         INFO = 2
+      ELSE IF( INCX.EQ.0 )THEN
+         INFO = 6
+      ELSE IF( INCY.EQ.0 )THEN
+         INFO = 9
+      END IF
+      IF( INFO.NE.0 )THEN
+         CALL XERBLA( 'DSPMV ', INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF( ( N.EQ.0 ).OR.( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) ) )
+     $   RETURN
+*
+*     Set up the start points in  X  and  Y.
+*
+      IF( INCX.GT.0 )THEN
+         KX = 1
+      ELSE
+         KX = 1 - ( N - 1 )*INCX
+      END IF
+      IF( INCY.GT.0 )THEN
+         KY = 1
+      ELSE
+         KY = 1 - ( N - 1 )*INCY
+      END IF
+*
+*     Start the operations. In this version the elements of the array AP
+*     are accessed sequentially with one pass through AP.
+*
+*     First form  y := beta*y.
+*
+      IF( BETA.NE.ONE )THEN
+         IF( INCY.EQ.1 )THEN
+            IF( BETA.EQ.ZERO )THEN
+               DO 10, I = 1, N
+                  Y( I ) = ZERO
+   10          CONTINUE
+            ELSE
+               DO 20, I = 1, N
+                  Y( I ) = BETA*Y( I )
+   20          CONTINUE
+            END IF
+         ELSE
+            IY = KY
+            IF( BETA.EQ.ZERO )THEN
+               DO 30, I = 1, N
+                  Y( IY ) = ZERO
+                  IY      = IY   + INCY
+   30          CONTINUE
+            ELSE
+               DO 40, I = 1, N
+                  Y( IY ) = BETA*Y( IY )
+                  IY      = IY           + INCY
+   40          CONTINUE
+            END IF
+         END IF
+      END IF
+      IF( ALPHA.EQ.ZERO )
+     $   RETURN
+      KK = 1
+      IF( LSAME( UPLO, 'U' ) )THEN
+*
+*        Form  y  when AP contains the upper triangle.
+*
+         IF( ( INCX.EQ.1 ).AND.( INCY.EQ.1 ) )THEN
+            DO 60, J = 1, N
+               TEMP1 = ALPHA*X( J )
+               TEMP2 = ZERO
+               K     = KK
+               DO 50, I = 1, J - 1
+                  Y( I ) = Y( I ) + TEMP1*AP( K )
+                  TEMP2  = TEMP2  + AP( K )*X( I )
+                  K      = K      + 1
+   50          CONTINUE
+               Y( J ) = Y( J ) + TEMP1*AP( KK + J - 1 ) + ALPHA*TEMP2
+               KK     = KK     + J
+   60       CONTINUE
+         ELSE
+            JX = KX
+            JY = KY
+            DO 80, J = 1, N
+               TEMP1 = ALPHA*X( JX )
+               TEMP2 = ZERO
+               IX    = KX
+               IY    = KY
+               DO 70, K = KK, KK + J - 2
+                  Y( IY ) = Y( IY ) + TEMP1*AP( K )
+                  TEMP2   = TEMP2   + AP( K )*X( IX )
+                  IX      = IX      + INCX
+                  IY      = IY      + INCY
+   70          CONTINUE
+               Y( JY ) = Y( JY ) + TEMP1*AP( KK + J - 1 ) + ALPHA*TEMP2
+               JX      = JX      + INCX
+               JY      = JY      + INCY
+               KK      = KK      + J
+   80       CONTINUE
+         END IF
+      ELSE
+*
+*        Form  y  when AP contains the lower triangle.
+*
+         IF( ( INCX.EQ.1 ).AND.( INCY.EQ.1 ) )THEN
+            DO 100, J = 1, N
+               TEMP1  = ALPHA*X( J )
+               TEMP2  = ZERO
+               Y( J ) = Y( J )       + TEMP1*AP( KK )
+               K      = KK           + 1
+               DO 90, I = J + 1, N
+                  Y( I ) = Y( I ) + TEMP1*AP( K )
+                  TEMP2  = TEMP2  + AP( K )*X( I )
+                  K      = K      + 1
+   90          CONTINUE
+               Y( J ) = Y( J ) + ALPHA*TEMP2
+               KK     = KK     + ( N - J + 1 )
+  100       CONTINUE
+         ELSE
+            JX = KX
+            JY = KY
+            DO 120, J = 1, N
+               TEMP1   = ALPHA*X( JX )
+               TEMP2   = ZERO
+               Y( JY ) = Y( JY )       + TEMP1*AP( KK )
+               IX      = JX
+               IY      = JY
+               DO 110, K = KK + 1, KK + N - J
+                  IX      = IX      + INCX
+                  IY      = IY      + INCY
+                  Y( IY ) = Y( IY ) + TEMP1*AP( K )
+                  TEMP2   = TEMP2   + AP( K )*X( IX )
+  110          CONTINUE
+               Y( JY ) = Y( JY ) + ALPHA*TEMP2
+               JX      = JX      + INCX
+               JY      = JY      + INCY
+               KK      = KK      + ( N - J + 1 )
+  120       CONTINUE
+         END IF
+      END IF
+*
+      RETURN
+*
+*     End of DSPMV .
+*
+      END
diff --git a/src/fortran/blas/dspr.f b/src/fortran/blas/dspr.f
new file mode 100644
index 0000000..3da6889
--- /dev/null
+++ b/src/fortran/blas/dspr.f
@@ -0,0 +1,198 @@
+      SUBROUTINE DSPR  ( UPLO, N, ALPHA, X, INCX, AP )
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION   ALPHA
+      INTEGER            INCX, N
+      CHARACTER*1        UPLO
+*     .. Array Arguments ..
+      DOUBLE PRECISION   AP( * ), X( * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  DSPR    performs the symmetric rank 1 operation
+*
+*     A := alpha*x*x' + A,
+*
+*  where alpha is a real scalar, x is an n element vector and A is an
+*  n by n symmetric matrix, supplied in packed form.
+*
+*  Parameters
+*  ==========
+*
+*  UPLO   - CHARACTER*1.
+*           On entry, UPLO specifies whether the upper or lower
+*           triangular part of the matrix A is supplied in the packed
+*           array AP as follows:
+*
+*              UPLO = 'U' or 'u'   The upper triangular part of A is
+*                                  supplied in AP.
+*
+*              UPLO = 'L' or 'l'   The lower triangular part of A is
+*                                  supplied in AP.
+*
+*           Unchanged on exit.
+*
+*  N      - INTEGER.
+*           On entry, N specifies the order of the matrix A.
+*           N must be at least zero.
+*           Unchanged on exit.
+*
+*  ALPHA  - DOUBLE PRECISION.
+*           On entry, ALPHA specifies the scalar alpha.
+*           Unchanged on exit.
+*
+*  X      - DOUBLE PRECISION array of dimension at least
+*           ( 1 + ( n - 1 )*abs( INCX ) ).
+*           Before entry, the incremented array X must contain the n
+*           element vector x.
+*           Unchanged on exit.
+*
+*  INCX   - INTEGER.
+*           On entry, INCX specifies the increment for the elements of
+*           X. INCX must not be zero.
+*           Unchanged on exit.
+*
+*  AP     - DOUBLE PRECISION array of DIMENSION at least
+*           ( ( n*( n + 1 ) )/2 ).
+*           Before entry with  UPLO = 'U' or 'u', the array AP must
+*           contain the upper triangular part of the symmetric matrix
+*           packed sequentially, column by column, so that AP( 1 )
+*           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 )
+*           and a( 2, 2 ) respectively, and so on. On exit, the array
+*           AP is overwritten by the upper triangular part of the
+*           updated matrix.
+*           Before entry with UPLO = 'L' or 'l', the array AP must
+*           contain the lower triangular part of the symmetric matrix
+*           packed sequentially, column by column, so that AP( 1 )
+*           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 )
+*           and a( 3, 1 ) respectively, and so on. On exit, the array
+*           AP is overwritten by the lower triangular part of the
+*           updated matrix.
+*
+*
+*  Level 2 Blas routine.
+*
+*  -- Written on 22-October-1986.
+*     Jack Dongarra, Argonne National Lab.
+*     Jeremy Du Croz, Nag Central Office.
+*     Sven Hammarling, Nag Central Office.
+*     Richard Hanson, Sandia National Labs.
+*
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO
+      PARAMETER        ( ZERO = 0.0D+0 )
+*     .. Local Scalars ..
+      DOUBLE PRECISION   TEMP
+      INTEGER            I, INFO, IX, J, JX, K, KK, KX
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF     ( .NOT.LSAME( UPLO, 'U' ).AND.
+     $         .NOT.LSAME( UPLO, 'L' )      )THEN
+         INFO = 1
+      ELSE IF( N.LT.0 )THEN
+         INFO = 2
+      ELSE IF( INCX.EQ.0 )THEN
+         INFO = 5
+      END IF
+      IF( INFO.NE.0 )THEN
+         CALL XERBLA( 'DSPR  ', INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF( ( N.EQ.0 ).OR.( ALPHA.EQ.ZERO ) )
+     $   RETURN
+*
+*     Set the start point in X if the increment is not unity.
+*
+      IF( INCX.LE.0 )THEN
+         KX = 1 - ( N - 1 )*INCX
+      ELSE IF( INCX.NE.1 )THEN
+         KX = 1
+      END IF
+*
+*     Start the operations. In this version the elements of the array AP
+*     are accessed sequentially with one pass through AP.
+*
+      KK = 1
+      IF( LSAME( UPLO, 'U' ) )THEN
+*
+*        Form  A  when upper triangle is stored in AP.
+*
+         IF( INCX.EQ.1 )THEN
+            DO 20, J = 1, N
+               IF( X( J ).NE.ZERO )THEN
+                  TEMP = ALPHA*X( J )
+                  K    = KK
+                  DO 10, I = 1, J
+                     AP( K ) = AP( K ) + X( I )*TEMP
+                     K       = K       + 1
+   10             CONTINUE
+               END IF
+               KK = KK + J
+   20       CONTINUE
+         ELSE
+            JX = KX
+            DO 40, J = 1, N
+               IF( X( JX ).NE.ZERO )THEN
+                  TEMP = ALPHA*X( JX )
+                  IX   = KX
+                  DO 30, K = KK, KK + J - 1
+                     AP( K ) = AP( K ) + X( IX )*TEMP
+                     IX      = IX      + INCX
+   30             CONTINUE
+               END IF
+               JX = JX + INCX
+               KK = KK + J
+   40       CONTINUE
+         END IF
+      ELSE
+*
+*        Form  A  when lower triangle is stored in AP.
+*
+         IF( INCX.EQ.1 )THEN
+            DO 60, J = 1, N
+               IF( X( J ).NE.ZERO )THEN
+                  TEMP = ALPHA*X( J )
+                  K    = KK
+                  DO 50, I = J, N
+                     AP( K ) = AP( K ) + X( I )*TEMP
+                     K       = K       + 1
+   50             CONTINUE
+               END IF
+               KK = KK + N - J + 1
+   60       CONTINUE
+         ELSE
+            JX = KX
+            DO 80, J = 1, N
+               IF( X( JX ).NE.ZERO )THEN
+                  TEMP = ALPHA*X( JX )
+                  IX   = JX
+                  DO 70, K = KK, KK + N - J
+                     AP( K ) = AP( K ) + X( IX )*TEMP
+                     IX      = IX      + INCX
+   70             CONTINUE
+               END IF
+               JX = JX + INCX
+               KK = KK + N - J + 1
+   80       CONTINUE
+         END IF
+      END IF
+*
+      RETURN
+*
+*     End of DSPR  .
+*
+      END
diff --git a/src/fortran/blas/dspr2.f b/src/fortran/blas/dspr2.f
new file mode 100644
index 0000000..1cfce21
--- /dev/null
+++ b/src/fortran/blas/dspr2.f
@@ -0,0 +1,229 @@
+      SUBROUTINE DSPR2 ( UPLO, N, ALPHA, X, INCX, Y, INCY, AP )
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION   ALPHA
+      INTEGER            INCX, INCY, N
+      CHARACTER*1        UPLO
+*     .. Array Arguments ..
+      DOUBLE PRECISION   AP( * ), X( * ), Y( * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  DSPR2  performs the symmetric rank 2 operation
+*
+*     A := alpha*x*y' + alpha*y*x' + A,
+*
+*  where alpha is a scalar, x and y are n element vectors and A is an
+*  n by n symmetric matrix, supplied in packed form.
+*
+*  Parameters
+*  ==========
+*
+*  UPLO   - CHARACTER*1.
+*           On entry, UPLO specifies whether the upper or lower
+*           triangular part of the matrix A is supplied in the packed
+*           array AP as follows:
+*
+*              UPLO = 'U' or 'u'   The upper triangular part of A is
+*                                  supplied in AP.
+*
+*              UPLO = 'L' or 'l'   The lower triangular part of A is
+*                                  supplied in AP.
+*
+*           Unchanged on exit.
+*
+*  N      - INTEGER.
+*           On entry, N specifies the order of the matrix A.
+*           N must be at least zero.
+*           Unchanged on exit.
+*
+*  ALPHA  - DOUBLE PRECISION.
+*           On entry, ALPHA specifies the scalar alpha.
+*           Unchanged on exit.
+*
+*  X      - DOUBLE PRECISION array of dimension at least
+*           ( 1 + ( n - 1 )*abs( INCX ) ).
+*           Before entry, the incremented array X must contain the n
+*           element vector x.
+*           Unchanged on exit.
+*
+*  INCX   - INTEGER.
+*           On entry, INCX specifies the increment for the elements of
+*           X. INCX must not be zero.
+*           Unchanged on exit.
+*
+*  Y      - DOUBLE PRECISION array of dimension at least
+*           ( 1 + ( n - 1 )*abs( INCY ) ).
+*           Before entry, the incremented array Y must contain the n
+*           element vector y.
+*           Unchanged on exit.
+*
+*  INCY   - INTEGER.
+*           On entry, INCY specifies the increment for the elements of
+*           Y. INCY must not be zero.
+*           Unchanged on exit.
+*
+*  AP     - DOUBLE PRECISION array of DIMENSION at least
+*           ( ( n*( n + 1 ) )/2 ).
+*           Before entry with  UPLO = 'U' or 'u', the array AP must
+*           contain the upper triangular part of the symmetric matrix
+*           packed sequentially, column by column, so that AP( 1 )
+*           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 )
+*           and a( 2, 2 ) respectively, and so on. On exit, the array
+*           AP is overwritten by the upper triangular part of the
+*           updated matrix.
+*           Before entry with UPLO = 'L' or 'l', the array AP must
+*           contain the lower triangular part of the symmetric matrix
+*           packed sequentially, column by column, so that AP( 1 )
+*           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 )
+*           and a( 3, 1 ) respectively, and so on. On exit, the array
+*           AP is overwritten by the lower triangular part of the
+*           updated matrix.
+*
+*
+*  Level 2 Blas routine.
+*
+*  -- Written on 22-October-1986.
+*     Jack Dongarra, Argonne National Lab.
+*     Jeremy Du Croz, Nag Central Office.
+*     Sven Hammarling, Nag Central Office.
+*     Richard Hanson, Sandia National Labs.
+*
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO
+      PARAMETER        ( ZERO = 0.0D+0 )
+*     .. Local Scalars ..
+      DOUBLE PRECISION   TEMP1, TEMP2
+      INTEGER            I, INFO, IX, IY, J, JX, JY, K, KK, KX, KY
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF     ( .NOT.LSAME( UPLO, 'U' ).AND.
+     $         .NOT.LSAME( UPLO, 'L' )      )THEN
+         INFO = 1
+      ELSE IF( N.LT.0 )THEN
+         INFO = 2
+      ELSE IF( INCX.EQ.0 )THEN
+         INFO = 5
+      ELSE IF( INCY.EQ.0 )THEN
+         INFO = 7
+      END IF
+      IF( INFO.NE.0 )THEN
+         CALL XERBLA( 'DSPR2 ', INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF( ( N.EQ.0 ).OR.( ALPHA.EQ.ZERO ) )
+     $   RETURN
+*
+*     Set up the start points in X and Y if the increments are not both
+*     unity.
+*
+      IF( ( INCX.NE.1 ).OR.( INCY.NE.1 ) )THEN
+         IF( INCX.GT.0 )THEN
+            KX = 1
+         ELSE
+            KX = 1 - ( N - 1 )*INCX
+         END IF
+         IF( INCY.GT.0 )THEN
+            KY = 1
+         ELSE
+            KY = 1 - ( N - 1 )*INCY
+         END IF
+         JX = KX
+         JY = KY
+      END IF
+*
+*     Start the operations. In this version the elements of the array AP
+*     are accessed sequentially with one pass through AP.
+*
+      KK = 1
+      IF( LSAME( UPLO, 'U' ) )THEN
+*
+*        Form  A  when upper triangle is stored in AP.
+*
+         IF( ( INCX.EQ.1 ).AND.( INCY.EQ.1 ) )THEN
+            DO 20, J = 1, N
+               IF( ( X( J ).NE.ZERO ).OR.( Y( J ).NE.ZERO ) )THEN
+                  TEMP1 = ALPHA*Y( J )
+                  TEMP2 = ALPHA*X( J )
+                  K     = KK
+                  DO 10, I = 1, J
+                     AP( K ) = AP( K ) + X( I )*TEMP1 + Y( I )*TEMP2
+                     K       = K       + 1
+   10             CONTINUE
+               END IF
+               KK = KK + J
+   20       CONTINUE
+         ELSE
+            DO 40, J = 1, N
+               IF( ( X( JX ).NE.ZERO ).OR.( Y( JY ).NE.ZERO ) )THEN
+                  TEMP1 = ALPHA*Y( JY )
+                  TEMP2 = ALPHA*X( JX )
+                  IX    = KX
+                  IY    = KY
+                  DO 30, K = KK, KK + J - 1
+                     AP( K ) = AP( K ) + X( IX )*TEMP1 + Y( IY )*TEMP2
+                     IX      = IX      + INCX
+                     IY      = IY      + INCY
+   30             CONTINUE
+               END IF
+               JX = JX + INCX
+               JY = JY + INCY
+               KK = KK + J
+   40       CONTINUE
+         END IF
+      ELSE
+*
+*        Form  A  when lower triangle is stored in AP.
+*
+         IF( ( INCX.EQ.1 ).AND.( INCY.EQ.1 ) )THEN
+            DO 60, J = 1, N
+               IF( ( X( J ).NE.ZERO ).OR.( Y( J ).NE.ZERO ) )THEN
+                  TEMP1 = ALPHA*Y( J )
+                  TEMP2 = ALPHA*X( J )
+                  K     = KK
+                  DO 50, I = J, N
+                     AP( K ) = AP( K ) + X( I )*TEMP1 + Y( I )*TEMP2
+                     K       = K       + 1
+   50             CONTINUE
+               END IF
+               KK = KK + N - J + 1
+   60       CONTINUE
+         ELSE
+            DO 80, J = 1, N
+               IF( ( X( JX ).NE.ZERO ).OR.( Y( JY ).NE.ZERO ) )THEN
+                  TEMP1 = ALPHA*Y( JY )
+                  TEMP2 = ALPHA*X( JX )
+                  IX    = JX
+                  IY    = JY
+                  DO 70, K = KK, KK + N - J
+                     AP( K ) = AP( K ) + X( IX )*TEMP1 + Y( IY )*TEMP2
+                     IX      = IX      + INCX
+                     IY      = IY      + INCY
+   70             CONTINUE
+               END IF
+               JX = JX + INCX
+               JY = JY + INCY
+               KK = KK + N - J + 1
+   80       CONTINUE
+         END IF
+      END IF
+*
+      RETURN
+*
+*     End of DSPR2 .
+*
+      END
diff --git a/src/fortran/blas/dswap.f b/src/fortran/blas/dswap.f
new file mode 100644
index 0000000..7f7d1fb
--- /dev/null
+++ b/src/fortran/blas/dswap.f
@@ -0,0 +1,56 @@
+      subroutine  dswap (n,dx,incx,dy,incy)
+c
+c     interchanges two vectors.
+c     uses unrolled loops for increments equal one.
+c     jack dongarra, linpack, 3/11/78.
+c     modified 12/3/93, array(1) declarations changed to array(*)
+c
+      double precision dx(*),dy(*),dtemp
+      integer i,incx,incy,ix,iy,m,mp1,n
+c
+      if(n.le.0)return
+      if(incx.eq.1.and.incy.eq.1)go to 20
+c
+c       code for unequal increments or equal increments not equal
+c         to 1
+c
+      ix = 1
+      iy = 1
+      if(incx.lt.0)ix = (-n+1)*incx + 1
+      if(incy.lt.0)iy = (-n+1)*incy + 1
+      do 10 i = 1,n
+        dtemp = dx(ix)
+        dx(ix) = dy(iy)
+        dy(iy) = dtemp
+        ix = ix + incx
+        iy = iy + incy
+   10 continue
+      return
+c
+c       code for both increments equal to 1
+c
+c
+c       clean-up loop
+c
+   20 m = mod(n,3)
+      if( m .eq. 0 ) go to 40
+      do 30 i = 1,m
+        dtemp = dx(i)
+        dx(i) = dy(i)
+        dy(i) = dtemp
+   30 continue
+      if( n .lt. 3 ) return
+   40 mp1 = m + 1
+      do 50 i = mp1,n,3
+        dtemp = dx(i)
+        dx(i) = dy(i)
+        dy(i) = dtemp
+        dtemp = dx(i + 1)
+        dx(i + 1) = dy(i + 1)
+        dy(i + 1) = dtemp
+        dtemp = dx(i + 2)
+        dx(i + 2) = dy(i + 2)
+        dy(i + 2) = dtemp
+   50 continue
+      return
+      end
diff --git a/src/fortran/blas/dsymm.f b/src/fortran/blas/dsymm.f
new file mode 100644
index 0000000..0f25141
--- /dev/null
+++ b/src/fortran/blas/dsymm.f
@@ -0,0 +1,294 @@
+      SUBROUTINE DSYMM ( SIDE, UPLO, M, N, ALPHA, A, LDA, B, LDB,
+     $                   BETA, C, LDC )
+*     .. Scalar Arguments ..
+      CHARACTER*1        SIDE, UPLO
+      INTEGER            M, N, LDA, LDB, LDC
+      DOUBLE PRECISION   ALPHA, BETA
+*     .. Array Arguments ..
+      DOUBLE PRECISION   A( LDA, * ), B( LDB, * ), C( LDC, * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  DSYMM  performs one of the matrix-matrix operations
+*
+*     C := alpha*A*B + beta*C,
+*
+*  or
+*
+*     C := alpha*B*A + beta*C,
+*
+*  where alpha and beta are scalars,  A is a symmetric matrix and  B and
+*  C are  m by n matrices.
+*
+*  Parameters
+*  ==========
+*
+*  SIDE   - CHARACTER*1.
+*           On entry,  SIDE  specifies whether  the  symmetric matrix  A
+*           appears on the  left or right  in the  operation as follows:
+*
+*              SIDE = 'L' or 'l'   C := alpha*A*B + beta*C,
+*
+*              SIDE = 'R' or 'r'   C := alpha*B*A + beta*C,
+*
+*           Unchanged on exit.
+*
+*  UPLO   - CHARACTER*1.
+*           On  entry,   UPLO  specifies  whether  the  upper  or  lower
+*           triangular  part  of  the  symmetric  matrix   A  is  to  be
+*           referenced as follows:
+*
+*              UPLO = 'U' or 'u'   Only the upper triangular part of the
+*                                  symmetric matrix is to be referenced.
+*
+*              UPLO = 'L' or 'l'   Only the lower triangular part of the
+*                                  symmetric matrix is to be referenced.
+*
+*           Unchanged on exit.
+*
+*  M      - INTEGER.
+*           On entry,  M  specifies the number of rows of the matrix  C.
+*           M  must be at least zero.
+*           Unchanged on exit.
+*
+*  N      - INTEGER.
+*           On entry, N specifies the number of columns of the matrix C.
+*           N  must be at least zero.
+*           Unchanged on exit.
+*
+*  ALPHA  - DOUBLE PRECISION.
+*           On entry, ALPHA specifies the scalar alpha.
+*           Unchanged on exit.
+*
+*  A      - DOUBLE PRECISION array of DIMENSION ( LDA, ka ), where ka is
+*           m  when  SIDE = 'L' or 'l'  and is  n otherwise.
+*           Before entry  with  SIDE = 'L' or 'l',  the  m by m  part of
+*           the array  A  must contain the  symmetric matrix,  such that
+*           when  UPLO = 'U' or 'u', the leading m by m upper triangular
+*           part of the array  A  must contain the upper triangular part
+*           of the  symmetric matrix and the  strictly  lower triangular
+*           part of  A  is not referenced,  and when  UPLO = 'L' or 'l',
+*           the leading  m by m  lower triangular part  of the  array  A
+*           must  contain  the  lower triangular part  of the  symmetric
+*           matrix and the  strictly upper triangular part of  A  is not
+*           referenced.
+*           Before entry  with  SIDE = 'R' or 'r',  the  n by n  part of
+*           the array  A  must contain the  symmetric matrix,  such that
+*           when  UPLO = 'U' or 'u', the leading n by n upper triangular
+*           part of the array  A  must contain the upper triangular part
+*           of the  symmetric matrix and the  strictly  lower triangular
+*           part of  A  is not referenced,  and when  UPLO = 'L' or 'l',
+*           the leading  n by n  lower triangular part  of the  array  A
+*           must  contain  the  lower triangular part  of the  symmetric
+*           matrix and the  strictly upper triangular part of  A  is not
+*           referenced.
+*           Unchanged on exit.
+*
+*  LDA    - INTEGER.
+*           On entry, LDA specifies the first dimension of A as declared
+*           in the calling (sub) program.  When  SIDE = 'L' or 'l'  then
+*           LDA must be at least  max( 1, m ), otherwise  LDA must be at
+*           least  max( 1, n ).
+*           Unchanged on exit.
+*
+*  B      - DOUBLE PRECISION array of DIMENSION ( LDB, n ).
+*           Before entry, the leading  m by n part of the array  B  must
+*           contain the matrix B.
+*           Unchanged on exit.
+*
+*  LDB    - INTEGER.
+*           On entry, LDB specifies the first dimension of B as declared
+*           in  the  calling  (sub)  program.   LDB  must  be  at  least
+*           max( 1, m ).
+*           Unchanged on exit.
+*
+*  BETA   - DOUBLE PRECISION.
+*           On entry,  BETA  specifies the scalar  beta.  When  BETA  is
+*           supplied as zero then C need not be set on input.
+*           Unchanged on exit.
+*
+*  C      - DOUBLE PRECISION array of DIMENSION ( LDC, n ).
+*           Before entry, the leading  m by n  part of the array  C must
+*           contain the matrix  C,  except when  beta  is zero, in which
+*           case C need not be set on entry.
+*           On exit, the array  C  is overwritten by the  m by n updated
+*           matrix.
+*
+*  LDC    - INTEGER.
+*           On entry, LDC specifies the first dimension of C as declared
+*           in  the  calling  (sub)  program.   LDC  must  be  at  least
+*           max( 1, m ).
+*           Unchanged on exit.
+*
+*
+*  Level 3 Blas routine.
+*
+*  -- Written on 8-February-1989.
+*     Jack Dongarra, Argonne National Laboratory.
+*     Iain Duff, AERE Harwell.
+*     Jeremy Du Croz, Numerical Algorithms Group Ltd.
+*     Sven Hammarling, Numerical Algorithms Group Ltd.
+*
+*
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     .. Local Scalars ..
+      LOGICAL            UPPER
+      INTEGER            I, INFO, J, K, NROWA
+      DOUBLE PRECISION   TEMP1, TEMP2
+*     .. Parameters ..
+      DOUBLE PRECISION   ONE         , ZERO
+      PARAMETER        ( ONE = 1.0D+0, ZERO = 0.0D+0 )
+*     ..
+*     .. Executable Statements ..
+*
+*     Set NROWA as the number of rows of A.
+*
+      IF( LSAME( SIDE, 'L' ) )THEN
+         NROWA = M
+      ELSE
+         NROWA = N
+      END IF
+      UPPER = LSAME( UPLO, 'U' )
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF(      ( .NOT.LSAME( SIDE, 'L' ) ).AND.
+     $         ( .NOT.LSAME( SIDE, 'R' ) )      )THEN
+         INFO = 1
+      ELSE IF( ( .NOT.UPPER              ).AND.
+     $         ( .NOT.LSAME( UPLO, 'L' ) )      )THEN
+         INFO = 2
+      ELSE IF( M  .LT.0               )THEN
+         INFO = 3
+      ELSE IF( N  .LT.0               )THEN
+         INFO = 4
+      ELSE IF( LDA.LT.MAX( 1, NROWA ) )THEN
+         INFO = 7
+      ELSE IF( LDB.LT.MAX( 1, M     ) )THEN
+         INFO = 9
+      ELSE IF( LDC.LT.MAX( 1, M     ) )THEN
+         INFO = 12
+      END IF
+      IF( INFO.NE.0 )THEN
+         CALL XERBLA( 'DSYMM ', INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF( ( M.EQ.0 ).OR.( N.EQ.0 ).OR.
+     $    ( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) ) )
+     $   RETURN
+*
+*     And when  alpha.eq.zero.
+*
+      IF( ALPHA.EQ.ZERO )THEN
+         IF( BETA.EQ.ZERO )THEN
+            DO 20, J = 1, N
+               DO 10, I = 1, M
+                  C( I, J ) = ZERO
+   10          CONTINUE
+   20       CONTINUE
+         ELSE
+            DO 40, J = 1, N
+               DO 30, I = 1, M
+                  C( I, J ) = BETA*C( I, J )
+   30          CONTINUE
+   40       CONTINUE
+         END IF
+         RETURN
+      END IF
+*
+*     Start the operations.
+*
+      IF( LSAME( SIDE, 'L' ) )THEN
+*
+*        Form  C := alpha*A*B + beta*C.
+*
+         IF( UPPER )THEN
+            DO 70, J = 1, N
+               DO 60, I = 1, M
+                  TEMP1 = ALPHA*B( I, J )
+                  TEMP2 = ZERO
+                  DO 50, K = 1, I - 1
+                     C( K, J ) = C( K, J ) + TEMP1    *A( K, I )
+                     TEMP2     = TEMP2     + B( K, J )*A( K, I )
+   50             CONTINUE
+                  IF( BETA.EQ.ZERO )THEN
+                     C( I, J ) = TEMP1*A( I, I ) + ALPHA*TEMP2
+                  ELSE
+                     C( I, J ) = BETA *C( I, J ) +
+     $                           TEMP1*A( I, I ) + ALPHA*TEMP2
+                  END IF
+   60          CONTINUE
+   70       CONTINUE
+         ELSE
+            DO 100, J = 1, N
+               DO 90, I = M, 1, -1
+                  TEMP1 = ALPHA*B( I, J )
+                  TEMP2 = ZERO
+                  DO 80, K = I + 1, M
+                     C( K, J ) = C( K, J ) + TEMP1    *A( K, I )
+                     TEMP2     = TEMP2     + B( K, J )*A( K, I )
+   80             CONTINUE
+                  IF( BETA.EQ.ZERO )THEN
+                     C( I, J ) = TEMP1*A( I, I ) + ALPHA*TEMP2
+                  ELSE
+                     C( I, J ) = BETA *C( I, J ) +
+     $                           TEMP1*A( I, I ) + ALPHA*TEMP2
+                  END IF
+   90          CONTINUE
+  100       CONTINUE
+         END IF
+      ELSE
+*
+*        Form  C := alpha*B*A + beta*C.
+*
+         DO 170, J = 1, N
+            TEMP1 = ALPHA*A( J, J )
+            IF( BETA.EQ.ZERO )THEN
+               DO 110, I = 1, M
+                  C( I, J ) = TEMP1*B( I, J )
+  110          CONTINUE
+            ELSE
+               DO 120, I = 1, M
+                  C( I, J ) = BETA*C( I, J ) + TEMP1*B( I, J )
+  120          CONTINUE
+            END IF
+            DO 140, K = 1, J - 1
+               IF( UPPER )THEN
+                  TEMP1 = ALPHA*A( K, J )
+               ELSE
+                  TEMP1 = ALPHA*A( J, K )
+               END IF
+               DO 130, I = 1, M
+                  C( I, J ) = C( I, J ) + TEMP1*B( I, K )
+  130          CONTINUE
+  140       CONTINUE
+            DO 160, K = J + 1, N
+               IF( UPPER )THEN
+                  TEMP1 = ALPHA*A( J, K )
+               ELSE
+                  TEMP1 = ALPHA*A( K, J )
+               END IF
+               DO 150, I = 1, M
+                  C( I, J ) = C( I, J ) + TEMP1*B( I, K )
+  150          CONTINUE
+  160       CONTINUE
+  170    CONTINUE
+      END IF
+*
+      RETURN
+*
+*     End of DSYMM .
+*
+      END
diff --git a/src/fortran/blas/dsymv.f b/src/fortran/blas/dsymv.f
new file mode 100644
index 0000000..7592d15
--- /dev/null
+++ b/src/fortran/blas/dsymv.f
@@ -0,0 +1,262 @@
+      SUBROUTINE DSYMV ( UPLO, N, ALPHA, A, LDA, X, INCX,
+     $                   BETA, Y, INCY )
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION   ALPHA, BETA
+      INTEGER            INCX, INCY, LDA, N
+      CHARACTER*1        UPLO
+*     .. Array Arguments ..
+      DOUBLE PRECISION   A( LDA, * ), X( * ), Y( * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  DSYMV  performs the matrix-vector  operation
+*
+*     y := alpha*A*x + beta*y,
+*
+*  where alpha and beta are scalars, x and y are n element vectors and
+*  A is an n by n symmetric matrix.
+*
+*  Parameters
+*  ==========
+*
+*  UPLO   - CHARACTER*1.
+*           On entry, UPLO specifies whether the upper or lower
+*           triangular part of the array A is to be referenced as
+*           follows:
+*
+*              UPLO = 'U' or 'u'   Only the upper triangular part of A
+*                                  is to be referenced.
+*
+*              UPLO = 'L' or 'l'   Only the lower triangular part of A
+*                                  is to be referenced.
+*
+*           Unchanged on exit.
+*
+*  N      - INTEGER.
+*           On entry, N specifies the order of the matrix A.
+*           N must be at least zero.
+*           Unchanged on exit.
+*
+*  ALPHA  - DOUBLE PRECISION.
+*           On entry, ALPHA specifies the scalar alpha.
+*           Unchanged on exit.
+*
+*  A      - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+*           Before entry with  UPLO = 'U' or 'u', the leading n by n
+*           upper triangular part of the array A must contain the upper
+*           triangular part of the symmetric matrix and the strictly
+*           lower triangular part of A is not referenced.
+*           Before entry with UPLO = 'L' or 'l', the leading n by n
+*           lower triangular part of the array A must contain the lower
+*           triangular part of the symmetric matrix and the strictly
+*           upper triangular part of A is not referenced.
+*           Unchanged on exit.
+*
+*  LDA    - INTEGER.
+*           On entry, LDA specifies the first dimension of A as declared
+*           in the calling (sub) program. LDA must be at least
+*           max( 1, n ).
+*           Unchanged on exit.
+*
+*  X      - DOUBLE PRECISION array of dimension at least
+*           ( 1 + ( n - 1 )*abs( INCX ) ).
+*           Before entry, the incremented array X must contain the n
+*           element vector x.
+*           Unchanged on exit.
+*
+*  INCX   - INTEGER.
+*           On entry, INCX specifies the increment for the elements of
+*           X. INCX must not be zero.
+*           Unchanged on exit.
+*
+*  BETA   - DOUBLE PRECISION.
+*           On entry, BETA specifies the scalar beta. When BETA is
+*           supplied as zero then Y need not be set on input.
+*           Unchanged on exit.
+*
+*  Y      - DOUBLE PRECISION array of dimension at least
+*           ( 1 + ( n - 1 )*abs( INCY ) ).
+*           Before entry, the incremented array Y must contain the n
+*           element vector y. On exit, Y is overwritten by the updated
+*           vector y.
+*
+*  INCY   - INTEGER.
+*           On entry, INCY specifies the increment for the elements of
+*           Y. INCY must not be zero.
+*           Unchanged on exit.
+*
+*
+*  Level 2 Blas routine.
+*
+*  -- Written on 22-October-1986.
+*     Jack Dongarra, Argonne National Lab.
+*     Jeremy Du Croz, Nag Central Office.
+*     Sven Hammarling, Nag Central Office.
+*     Richard Hanson, Sandia National Labs.
+*
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ONE         , ZERO
+      PARAMETER        ( ONE = 1.0D+0, ZERO = 0.0D+0 )
+*     .. Local Scalars ..
+      DOUBLE PRECISION   TEMP1, TEMP2
+      INTEGER            I, INFO, IX, IY, J, JX, JY, KX, KY
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF     ( .NOT.LSAME( UPLO, 'U' ).AND.
+     $         .NOT.LSAME( UPLO, 'L' )      )THEN
+         INFO = 1
+      ELSE IF( N.LT.0 )THEN
+         INFO = 2
+      ELSE IF( LDA.LT.MAX( 1, N ) )THEN
+         INFO = 5
+      ELSE IF( INCX.EQ.0 )THEN
+         INFO = 7
+      ELSE IF( INCY.EQ.0 )THEN
+         INFO = 10
+      END IF
+      IF( INFO.NE.0 )THEN
+         CALL XERBLA( 'DSYMV ', INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF( ( N.EQ.0 ).OR.( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) ) )
+     $   RETURN
+*
+*     Set up the start points in  X  and  Y.
+*
+      IF( INCX.GT.0 )THEN
+         KX = 1
+      ELSE
+         KX = 1 - ( N - 1 )*INCX
+      END IF
+      IF( INCY.GT.0 )THEN
+         KY = 1
+      ELSE
+         KY = 1 - ( N - 1 )*INCY
+      END IF
+*
+*     Start the operations. In this version the elements of A are
+*     accessed sequentially with one pass through the triangular part
+*     of A.
+*
+*     First form  y := beta*y.
+*
+      IF( BETA.NE.ONE )THEN
+         IF( INCY.EQ.1 )THEN
+            IF( BETA.EQ.ZERO )THEN
+               DO 10, I = 1, N
+                  Y( I ) = ZERO
+   10          CONTINUE
+            ELSE
+               DO 20, I = 1, N
+                  Y( I ) = BETA*Y( I )
+   20          CONTINUE
+            END IF
+         ELSE
+            IY = KY
+            IF( BETA.EQ.ZERO )THEN
+               DO 30, I = 1, N
+                  Y( IY ) = ZERO
+                  IY      = IY   + INCY
+   30          CONTINUE
+            ELSE
+               DO 40, I = 1, N
+                  Y( IY ) = BETA*Y( IY )
+                  IY      = IY           + INCY
+   40          CONTINUE
+            END IF
+         END IF
+      END IF
+      IF( ALPHA.EQ.ZERO )
+     $   RETURN
+      IF( LSAME( UPLO, 'U' ) )THEN
+*
+*        Form  y  when A is stored in upper triangle.
+*
+         IF( ( INCX.EQ.1 ).AND.( INCY.EQ.1 ) )THEN
+            DO 60, J = 1, N
+               TEMP1 = ALPHA*X( J )
+               TEMP2 = ZERO
+               DO 50, I = 1, J - 1
+                  Y( I ) = Y( I ) + TEMP1*A( I, J )
+                  TEMP2  = TEMP2  + A( I, J )*X( I )
+   50          CONTINUE
+               Y( J ) = Y( J ) + TEMP1*A( J, J ) + ALPHA*TEMP2
+   60       CONTINUE
+         ELSE
+            JX = KX
+            JY = KY
+            DO 80, J = 1, N
+               TEMP1 = ALPHA*X( JX )
+               TEMP2 = ZERO
+               IX    = KX
+               IY    = KY
+               DO 70, I = 1, J - 1
+                  Y( IY ) = Y( IY ) + TEMP1*A( I, J )
+                  TEMP2   = TEMP2   + A( I, J )*X( IX )
+                  IX      = IX      + INCX
+                  IY      = IY      + INCY
+   70          CONTINUE
+               Y( JY ) = Y( JY ) + TEMP1*A( J, J ) + ALPHA*TEMP2
+               JX      = JX      + INCX
+               JY      = JY      + INCY
+   80       CONTINUE
+         END IF
+      ELSE
+*
+*        Form  y  when A is stored in lower triangle.
+*
+         IF( ( INCX.EQ.1 ).AND.( INCY.EQ.1 ) )THEN
+            DO 100, J = 1, N
+               TEMP1  = ALPHA*X( J )
+               TEMP2  = ZERO
+               Y( J ) = Y( J )       + TEMP1*A( J, J )
+               DO 90, I = J + 1, N
+                  Y( I ) = Y( I ) + TEMP1*A( I, J )
+                  TEMP2  = TEMP2  + A( I, J )*X( I )
+   90          CONTINUE
+               Y( J ) = Y( J ) + ALPHA*TEMP2
+  100       CONTINUE
+         ELSE
+            JX = KX
+            JY = KY
+            DO 120, J = 1, N
+               TEMP1   = ALPHA*X( JX )
+               TEMP2   = ZERO
+               Y( JY ) = Y( JY )       + TEMP1*A( J, J )
+               IX      = JX
+               IY      = JY
+               DO 110, I = J + 1, N
+                  IX      = IX      + INCX
+                  IY      = IY      + INCY
+                  Y( IY ) = Y( IY ) + TEMP1*A( I, J )
+                  TEMP2   = TEMP2   + A( I, J )*X( IX )
+  110          CONTINUE
+               Y( JY ) = Y( JY ) + ALPHA*TEMP2
+               JX      = JX      + INCX
+               JY      = JY      + INCY
+  120       CONTINUE
+         END IF
+      END IF
+*
+      RETURN
+*
+*     End of DSYMV .
+*
+      END
diff --git a/src/fortran/blas/dsyr.f b/src/fortran/blas/dsyr.f
new file mode 100644
index 0000000..8737719
--- /dev/null
+++ b/src/fortran/blas/dsyr.f
@@ -0,0 +1,197 @@
+      SUBROUTINE DSYR  ( UPLO, N, ALPHA, X, INCX, A, LDA )
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION   ALPHA
+      INTEGER            INCX, LDA, N
+      CHARACTER*1        UPLO
+*     .. Array Arguments ..
+      DOUBLE PRECISION   A( LDA, * ), X( * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  DSYR   performs the symmetric rank 1 operation
+*
+*     A := alpha*x*x' + A,
+*
+*  where alpha is a real scalar, x is an n element vector and A is an
+*  n by n symmetric matrix.
+*
+*  Parameters
+*  ==========
+*
+*  UPLO   - CHARACTER*1.
+*           On entry, UPLO specifies whether the upper or lower
+*           triangular part of the array A is to be referenced as
+*           follows:
+*
+*              UPLO = 'U' or 'u'   Only the upper triangular part of A
+*                                  is to be referenced.
+*
+*              UPLO = 'L' or 'l'   Only the lower triangular part of A
+*                                  is to be referenced.
+*
+*           Unchanged on exit.
+*
+*  N      - INTEGER.
+*           On entry, N specifies the order of the matrix A.
+*           N must be at least zero.
+*           Unchanged on exit.
+*
+*  ALPHA  - DOUBLE PRECISION.
+*           On entry, ALPHA specifies the scalar alpha.
+*           Unchanged on exit.
+*
+*  X      - DOUBLE PRECISION array of dimension at least
+*           ( 1 + ( n - 1 )*abs( INCX ) ).
+*           Before entry, the incremented array X must contain the n
+*           element vector x.
+*           Unchanged on exit.
+*
+*  INCX   - INTEGER.
+*           On entry, INCX specifies the increment for the elements of
+*           X. INCX must not be zero.
+*           Unchanged on exit.
+*
+*  A      - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+*           Before entry with  UPLO = 'U' or 'u', the leading n by n
+*           upper triangular part of the array A must contain the upper
+*           triangular part of the symmetric matrix and the strictly
+*           lower triangular part of A is not referenced. On exit, the
+*           upper triangular part of the array A is overwritten by the
+*           upper triangular part of the updated matrix.
+*           Before entry with UPLO = 'L' or 'l', the leading n by n
+*           lower triangular part of the array A must contain the lower
+*           triangular part of the symmetric matrix and the strictly
+*           upper triangular part of A is not referenced. On exit, the
+*           lower triangular part of the array A is overwritten by the
+*           lower triangular part of the updated matrix.
+*
+*  LDA    - INTEGER.
+*           On entry, LDA specifies the first dimension of A as declared
+*           in the calling (sub) program. LDA must be at least
+*           max( 1, n ).
+*           Unchanged on exit.
+*
+*
+*  Level 2 Blas routine.
+*
+*  -- Written on 22-October-1986.
+*     Jack Dongarra, Argonne National Lab.
+*     Jeremy Du Croz, Nag Central Office.
+*     Sven Hammarling, Nag Central Office.
+*     Richard Hanson, Sandia National Labs.
+*
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO
+      PARAMETER        ( ZERO = 0.0D+0 )
+*     .. Local Scalars ..
+      DOUBLE PRECISION   TEMP
+      INTEGER            I, INFO, IX, J, JX, KX
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF     ( .NOT.LSAME( UPLO, 'U' ).AND.
+     $         .NOT.LSAME( UPLO, 'L' )      )THEN
+         INFO = 1
+      ELSE IF( N.LT.0 )THEN
+         INFO = 2
+      ELSE IF( INCX.EQ.0 )THEN
+         INFO = 5
+      ELSE IF( LDA.LT.MAX( 1, N ) )THEN
+         INFO = 7
+      END IF
+      IF( INFO.NE.0 )THEN
+         CALL XERBLA( 'DSYR  ', INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF( ( N.EQ.0 ).OR.( ALPHA.EQ.ZERO ) )
+     $   RETURN
+*
+*     Set the start point in X if the increment is not unity.
+*
+      IF( INCX.LE.0 )THEN
+         KX = 1 - ( N - 1 )*INCX
+      ELSE IF( INCX.NE.1 )THEN
+         KX = 1
+      END IF
+*
+*     Start the operations. In this version the elements of A are
+*     accessed sequentially with one pass through the triangular part
+*     of A.
+*
+      IF( LSAME( UPLO, 'U' ) )THEN
+*
+*        Form  A  when A is stored in upper triangle.
+*
+         IF( INCX.EQ.1 )THEN
+            DO 20, J = 1, N
+               IF( X( J ).NE.ZERO )THEN
+                  TEMP = ALPHA*X( J )
+                  DO 10, I = 1, J
+                     A( I, J ) = A( I, J ) + X( I )*TEMP
+   10             CONTINUE
+               END IF
+   20       CONTINUE
+         ELSE
+            JX = KX
+            DO 40, J = 1, N
+               IF( X( JX ).NE.ZERO )THEN
+                  TEMP = ALPHA*X( JX )
+                  IX   = KX
+                  DO 30, I = 1, J
+                     A( I, J ) = A( I, J ) + X( IX )*TEMP
+                     IX        = IX        + INCX
+   30             CONTINUE
+               END IF
+               JX = JX + INCX
+   40       CONTINUE
+         END IF
+      ELSE
+*
+*        Form  A  when A is stored in lower triangle.
+*
+         IF( INCX.EQ.1 )THEN
+            DO 60, J = 1, N
+               IF( X( J ).NE.ZERO )THEN
+                  TEMP = ALPHA*X( J )
+                  DO 50, I = J, N
+                     A( I, J ) = A( I, J ) + X( I )*TEMP
+   50             CONTINUE
+               END IF
+   60       CONTINUE
+         ELSE
+            JX = KX
+            DO 80, J = 1, N
+               IF( X( JX ).NE.ZERO )THEN
+                  TEMP = ALPHA*X( JX )
+                  IX   = JX
+                  DO 70, I = J, N
+                     A( I, J ) = A( I, J ) + X( IX )*TEMP
+                     IX        = IX        + INCX
+   70             CONTINUE
+               END IF
+               JX = JX + INCX
+   80       CONTINUE
+         END IF
+      END IF
+*
+      RETURN
+*
+*     End of DSYR  .
+*
+      END
diff --git a/src/fortran/blas/dsyr2.f b/src/fortran/blas/dsyr2.f
new file mode 100644
index 0000000..918ad8a
--- /dev/null
+++ b/src/fortran/blas/dsyr2.f
@@ -0,0 +1,230 @@
+      SUBROUTINE DSYR2 ( UPLO, N, ALPHA, X, INCX, Y, INCY, A, LDA )
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION   ALPHA
+      INTEGER            INCX, INCY, LDA, N
+      CHARACTER*1        UPLO
+*     .. Array Arguments ..
+      DOUBLE PRECISION   A( LDA, * ), X( * ), Y( * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  DSYR2  performs the symmetric rank 2 operation
+*
+*     A := alpha*x*y' + alpha*y*x' + A,
+*
+*  where alpha is a scalar, x and y are n element vectors and A is an n
+*  by n symmetric matrix.
+*
+*  Parameters
+*  ==========
+*
+*  UPLO   - CHARACTER*1.
+*           On entry, UPLO specifies whether the upper or lower
+*           triangular part of the array A is to be referenced as
+*           follows:
+*
+*              UPLO = 'U' or 'u'   Only the upper triangular part of A
+*                                  is to be referenced.
+*
+*              UPLO = 'L' or 'l'   Only the lower triangular part of A
+*                                  is to be referenced.
+*
+*           Unchanged on exit.
+*
+*  N      - INTEGER.
+*           On entry, N specifies the order of the matrix A.
+*           N must be at least zero.
+*           Unchanged on exit.
+*
+*  ALPHA  - DOUBLE PRECISION.
+*           On entry, ALPHA specifies the scalar alpha.
+*           Unchanged on exit.
+*
+*  X      - DOUBLE PRECISION array of dimension at least
+*           ( 1 + ( n - 1 )*abs( INCX ) ).
+*           Before entry, the incremented array X must contain the n
+*           element vector x.
+*           Unchanged on exit.
+*
+*  INCX   - INTEGER.
+*           On entry, INCX specifies the increment for the elements of
+*           X. INCX must not be zero.
+*           Unchanged on exit.
+*
+*  Y      - DOUBLE PRECISION array of dimension at least
+*           ( 1 + ( n - 1 )*abs( INCY ) ).
+*           Before entry, the incremented array Y must contain the n
+*           element vector y.
+*           Unchanged on exit.
+*
+*  INCY   - INTEGER.
+*           On entry, INCY specifies the increment for the elements of
+*           Y. INCY must not be zero.
+*           Unchanged on exit.
+*
+*  A      - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+*           Before entry with  UPLO = 'U' or 'u', the leading n by n
+*           upper triangular part of the array A must contain the upper
+*           triangular part of the symmetric matrix and the strictly
+*           lower triangular part of A is not referenced. On exit, the
+*           upper triangular part of the array A is overwritten by the
+*           upper triangular part of the updated matrix.
+*           Before entry with UPLO = 'L' or 'l', the leading n by n
+*           lower triangular part of the array A must contain the lower
+*           triangular part of the symmetric matrix and the strictly
+*           upper triangular part of A is not referenced. On exit, the
+*           lower triangular part of the array A is overwritten by the
+*           lower triangular part of the updated matrix.
+*
+*  LDA    - INTEGER.
+*           On entry, LDA specifies the first dimension of A as declared
+*           in the calling (sub) program. LDA must be at least
+*           max( 1, n ).
+*           Unchanged on exit.
+*
+*
+*  Level 2 Blas routine.
+*
+*  -- Written on 22-October-1986.
+*     Jack Dongarra, Argonne National Lab.
+*     Jeremy Du Croz, Nag Central Office.
+*     Sven Hammarling, Nag Central Office.
+*     Richard Hanson, Sandia National Labs.
+*
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO
+      PARAMETER        ( ZERO = 0.0D+0 )
+*     .. Local Scalars ..
+      DOUBLE PRECISION   TEMP1, TEMP2
+      INTEGER            I, INFO, IX, IY, J, JX, JY, KX, KY
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF     ( .NOT.LSAME( UPLO, 'U' ).AND.
+     $         .NOT.LSAME( UPLO, 'L' )      )THEN
+         INFO = 1
+      ELSE IF( N.LT.0 )THEN
+         INFO = 2
+      ELSE IF( INCX.EQ.0 )THEN
+         INFO = 5
+      ELSE IF( INCY.EQ.0 )THEN
+         INFO = 7
+      ELSE IF( LDA.LT.MAX( 1, N ) )THEN
+         INFO = 9
+      END IF
+      IF( INFO.NE.0 )THEN
+         CALL XERBLA( 'DSYR2 ', INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF( ( N.EQ.0 ).OR.( ALPHA.EQ.ZERO ) )
+     $   RETURN
+*
+*     Set up the start points in X and Y if the increments are not both
+*     unity.
+*
+      IF( ( INCX.NE.1 ).OR.( INCY.NE.1 ) )THEN
+         IF( INCX.GT.0 )THEN
+            KX = 1
+         ELSE
+            KX = 1 - ( N - 1 )*INCX
+         END IF
+         IF( INCY.GT.0 )THEN
+            KY = 1
+         ELSE
+            KY = 1 - ( N - 1 )*INCY
+         END IF
+         JX = KX
+         JY = KY
+      END IF
+*
+*     Start the operations. In this version the elements of A are
+*     accessed sequentially with one pass through the triangular part
+*     of A.
+*
+      IF( LSAME( UPLO, 'U' ) )THEN
+*
+*        Form  A  when A is stored in the upper triangle.
+*
+         IF( ( INCX.EQ.1 ).AND.( INCY.EQ.1 ) )THEN
+            DO 20, J = 1, N
+               IF( ( X( J ).NE.ZERO ).OR.( Y( J ).NE.ZERO ) )THEN
+                  TEMP1 = ALPHA*Y( J )
+                  TEMP2 = ALPHA*X( J )
+                  DO 10, I = 1, J
+                     A( I, J ) = A( I, J ) + X( I )*TEMP1 + Y( I )*TEMP2
+   10             CONTINUE
+               END IF
+   20       CONTINUE
+         ELSE
+            DO 40, J = 1, N
+               IF( ( X( JX ).NE.ZERO ).OR.( Y( JY ).NE.ZERO ) )THEN
+                  TEMP1 = ALPHA*Y( JY )
+                  TEMP2 = ALPHA*X( JX )
+                  IX    = KX
+                  IY    = KY
+                  DO 30, I = 1, J
+                     A( I, J ) = A( I, J ) + X( IX )*TEMP1
+     $                                     + Y( IY )*TEMP2
+                     IX        = IX        + INCX
+                     IY        = IY        + INCY
+   30             CONTINUE
+               END IF
+               JX = JX + INCX
+               JY = JY + INCY
+   40       CONTINUE
+         END IF
+      ELSE
+*
+*        Form  A  when A is stored in the lower triangle.
+*
+         IF( ( INCX.EQ.1 ).AND.( INCY.EQ.1 ) )THEN
+            DO 60, J = 1, N
+               IF( ( X( J ).NE.ZERO ).OR.( Y( J ).NE.ZERO ) )THEN
+                  TEMP1 = ALPHA*Y( J )
+                  TEMP2 = ALPHA*X( J )
+                  DO 50, I = J, N
+                     A( I, J ) = A( I, J ) + X( I )*TEMP1 + Y( I )*TEMP2
+   50             CONTINUE
+               END IF
+   60       CONTINUE
+         ELSE
+            DO 80, J = 1, N
+               IF( ( X( JX ).NE.ZERO ).OR.( Y( JY ).NE.ZERO ) )THEN
+                  TEMP1 = ALPHA*Y( JY )
+                  TEMP2 = ALPHA*X( JX )
+                  IX    = JX
+                  IY    = JY
+                  DO 70, I = J, N
+                     A( I, J ) = A( I, J ) + X( IX )*TEMP1
+     $                                     + Y( IY )*TEMP2
+                     IX        = IX        + INCX
+                     IY        = IY        + INCY
+   70             CONTINUE
+               END IF
+               JX = JX + INCX
+               JY = JY + INCY
+   80       CONTINUE
+         END IF
+      END IF
+*
+      RETURN
+*
+*     End of DSYR2 .
+*
+      END
diff --git a/src/fortran/blas/dsyr2k.f b/src/fortran/blas/dsyr2k.f
new file mode 100644
index 0000000..ac7d97d
--- /dev/null
+++ b/src/fortran/blas/dsyr2k.f
@@ -0,0 +1,327 @@
+      SUBROUTINE DSYR2K( UPLO, TRANS, N, K, ALPHA, A, LDA, B, LDB,
+     $                   BETA, C, LDC )
+*     .. Scalar Arguments ..
+      CHARACTER*1        UPLO, TRANS
+      INTEGER            N, K, LDA, LDB, LDC
+      DOUBLE PRECISION   ALPHA, BETA
+*     .. Array Arguments ..
+      DOUBLE PRECISION   A( LDA, * ), B( LDB, * ), C( LDC, * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  DSYR2K  performs one of the symmetric rank 2k operations
+*
+*     C := alpha*A*B' + alpha*B*A' + beta*C,
+*
+*  or
+*
+*     C := alpha*A'*B + alpha*B'*A + beta*C,
+*
+*  where  alpha and beta  are scalars, C is an  n by n  symmetric matrix
+*  and  A and B  are  n by k  matrices  in the  first  case  and  k by n
+*  matrices in the second case.
+*
+*  Parameters
+*  ==========
+*
+*  UPLO   - CHARACTER*1.
+*           On  entry,   UPLO  specifies  whether  the  upper  or  lower
+*           triangular  part  of the  array  C  is to be  referenced  as
+*           follows:
+*
+*              UPLO = 'U' or 'u'   Only the  upper triangular part of  C
+*                                  is to be referenced.
+*
+*              UPLO = 'L' or 'l'   Only the  lower triangular part of  C
+*                                  is to be referenced.
+*
+*           Unchanged on exit.
+*
+*  TRANS  - CHARACTER*1.
+*           On entry,  TRANS  specifies the operation to be performed as
+*           follows:
+*
+*              TRANS = 'N' or 'n'   C := alpha*A*B' + alpha*B*A' +
+*                                        beta*C.
+*
+*              TRANS = 'T' or 't'   C := alpha*A'*B + alpha*B'*A +
+*                                        beta*C.
+*
+*              TRANS = 'C' or 'c'   C := alpha*A'*B + alpha*B'*A +
+*                                        beta*C.
+*
+*           Unchanged on exit.
+*
+*  N      - INTEGER.
+*           On entry,  N specifies the order of the matrix C.  N must be
+*           at least zero.
+*           Unchanged on exit.
+*
+*  K      - INTEGER.
+*           On entry with  TRANS = 'N' or 'n',  K  specifies  the number
+*           of  columns  of the  matrices  A and B,  and on  entry  with
+*           TRANS = 'T' or 't' or 'C' or 'c',  K  specifies  the  number
+*           of rows of the matrices  A and B.  K must be at least  zero.
+*           Unchanged on exit.
+*
+*  ALPHA  - DOUBLE PRECISION.
+*           On entry, ALPHA specifies the scalar alpha.
+*           Unchanged on exit.
+*
+*  A      - DOUBLE PRECISION array of DIMENSION ( LDA, ka ), where ka is
+*           k  when  TRANS = 'N' or 'n',  and is  n  otherwise.
+*           Before entry with  TRANS = 'N' or 'n',  the  leading  n by k
+*           part of the array  A  must contain the matrix  A,  otherwise
+*           the leading  k by n  part of the array  A  must contain  the
+*           matrix A.
+*           Unchanged on exit.
+*
+*  LDA    - INTEGER.
+*           On entry, LDA specifies the first dimension of A as declared
+*           in  the  calling  (sub)  program.   When  TRANS = 'N' or 'n'
+*           then  LDA must be at least  max( 1, n ), otherwise  LDA must
+*           be at least  max( 1, k ).
+*           Unchanged on exit.
+*
+*  B      - DOUBLE PRECISION array of DIMENSION ( LDB, kb ), where kb is
+*           k  when  TRANS = 'N' or 'n',  and is  n  otherwise.
+*           Before entry with  TRANS = 'N' or 'n',  the  leading  n by k
+*           part of the array  B  must contain the matrix  B,  otherwise
+*           the leading  k by n  part of the array  B  must contain  the
+*           matrix B.
+*           Unchanged on exit.
+*
+*  LDB    - INTEGER.
+*           On entry, LDB specifies the first dimension of B as declared
+*           in  the  calling  (sub)  program.   When  TRANS = 'N' or 'n'
+*           then  LDB must be at least  max( 1, n ), otherwise  LDB must
+*           be at least  max( 1, k ).
+*           Unchanged on exit.
+*
+*  BETA   - DOUBLE PRECISION.
+*           On entry, BETA specifies the scalar beta.
+*           Unchanged on exit.
+*
+*  C      - DOUBLE PRECISION array of DIMENSION ( LDC, n ).
+*           Before entry  with  UPLO = 'U' or 'u',  the leading  n by n
+*           upper triangular part of the array C must contain the upper
+*           triangular part  of the  symmetric matrix  and the strictly
+*           lower triangular part of C is not referenced.  On exit, the
+*           upper triangular part of the array  C is overwritten by the
+*           upper triangular part of the updated matrix.
+*           Before entry  with  UPLO = 'L' or 'l',  the leading  n by n
+*           lower triangular part of the array C must contain the lower
+*           triangular part  of the  symmetric matrix  and the strictly
+*           upper triangular part of C is not referenced.  On exit, the
+*           lower triangular part of the array  C is overwritten by the
+*           lower triangular part of the updated matrix.
+*
+*  LDC    - INTEGER.
+*           On entry, LDC specifies the first dimension of C as declared
+*           in  the  calling  (sub)  program.   LDC  must  be  at  least
+*           max( 1, n ).
+*           Unchanged on exit.
+*
+*
+*  Level 3 Blas routine.
+*
+*
+*  -- Written on 8-February-1989.
+*     Jack Dongarra, Argonne National Laboratory.
+*     Iain Duff, AERE Harwell.
+*     Jeremy Du Croz, Numerical Algorithms Group Ltd.
+*     Sven Hammarling, Numerical Algorithms Group Ltd.
+*
+*
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     .. Local Scalars ..
+      LOGICAL            UPPER
+      INTEGER            I, INFO, J, L, NROWA
+      DOUBLE PRECISION   TEMP1, TEMP2
+*     .. Parameters ..
+      DOUBLE PRECISION   ONE         , ZERO
+      PARAMETER        ( ONE = 1.0D+0, ZERO = 0.0D+0 )
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      IF( LSAME( TRANS, 'N' ) )THEN
+         NROWA = N
+      ELSE
+         NROWA = K
+      END IF
+      UPPER = LSAME( UPLO, 'U' )
+*
+      INFO = 0
+      IF(      ( .NOT.UPPER               ).AND.
+     $         ( .NOT.LSAME( UPLO , 'L' ) )      )THEN
+         INFO = 1
+      ELSE IF( ( .NOT.LSAME( TRANS, 'N' ) ).AND.
+     $         ( .NOT.LSAME( TRANS, 'T' ) ).AND.
+     $         ( .NOT.LSAME( TRANS, 'C' ) )      )THEN
+         INFO = 2
+      ELSE IF( N  .LT.0               )THEN
+         INFO = 3
+      ELSE IF( K  .LT.0               )THEN
+         INFO = 4
+      ELSE IF( LDA.LT.MAX( 1, NROWA ) )THEN
+         INFO = 7
+      ELSE IF( LDB.LT.MAX( 1, NROWA ) )THEN
+         INFO = 9
+      ELSE IF( LDC.LT.MAX( 1, N     ) )THEN
+         INFO = 12
+      END IF
+      IF( INFO.NE.0 )THEN
+         CALL XERBLA( 'DSYR2K', INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF( ( N.EQ.0 ).OR.
+     $    ( ( ( ALPHA.EQ.ZERO ).OR.( K.EQ.0 ) ).AND.( BETA.EQ.ONE ) ) )
+     $   RETURN
+*
+*     And when  alpha.eq.zero.
+*
+      IF( ALPHA.EQ.ZERO )THEN
+         IF( UPPER )THEN
+            IF( BETA.EQ.ZERO )THEN
+               DO 20, J = 1, N
+                  DO 10, I = 1, J
+                     C( I, J ) = ZERO
+   10             CONTINUE
+   20          CONTINUE
+            ELSE
+               DO 40, J = 1, N
+                  DO 30, I = 1, J
+                     C( I, J ) = BETA*C( I, J )
+   30             CONTINUE
+   40          CONTINUE
+            END IF
+         ELSE
+            IF( BETA.EQ.ZERO )THEN
+               DO 60, J = 1, N
+                  DO 50, I = J, N
+                     C( I, J ) = ZERO
+   50             CONTINUE
+   60          CONTINUE
+            ELSE
+               DO 80, J = 1, N
+                  DO 70, I = J, N
+                     C( I, J ) = BETA*C( I, J )
+   70             CONTINUE
+   80          CONTINUE
+            END IF
+         END IF
+         RETURN
+      END IF
+*
+*     Start the operations.
+*
+      IF( LSAME( TRANS, 'N' ) )THEN
+*
+*        Form  C := alpha*A*B' + alpha*B*A' + C.
+*
+         IF( UPPER )THEN
+            DO 130, J = 1, N
+               IF( BETA.EQ.ZERO )THEN
+                  DO 90, I = 1, J
+                     C( I, J ) = ZERO
+   90             CONTINUE
+               ELSE IF( BETA.NE.ONE )THEN
+                  DO 100, I = 1, J
+                     C( I, J ) = BETA*C( I, J )
+  100             CONTINUE
+               END IF
+               DO 120, L = 1, K
+                  IF( ( A( J, L ).NE.ZERO ).OR.
+     $                ( B( J, L ).NE.ZERO )     )THEN
+                     TEMP1 = ALPHA*B( J, L )
+                     TEMP2 = ALPHA*A( J, L )
+                     DO 110, I = 1, J
+                        C( I, J ) = C( I, J ) +
+     $                              A( I, L )*TEMP1 + B( I, L )*TEMP2
+  110                CONTINUE
+                  END IF
+  120          CONTINUE
+  130       CONTINUE
+         ELSE
+            DO 180, J = 1, N
+               IF( BETA.EQ.ZERO )THEN
+                  DO 140, I = J, N
+                     C( I, J ) = ZERO
+  140             CONTINUE
+               ELSE IF( BETA.NE.ONE )THEN
+                  DO 150, I = J, N
+                     C( I, J ) = BETA*C( I, J )
+  150             CONTINUE
+               END IF
+               DO 170, L = 1, K
+                  IF( ( A( J, L ).NE.ZERO ).OR.
+     $                ( B( J, L ).NE.ZERO )     )THEN
+                     TEMP1 = ALPHA*B( J, L )
+                     TEMP2 = ALPHA*A( J, L )
+                     DO 160, I = J, N
+                        C( I, J ) = C( I, J ) +
+     $                              A( I, L )*TEMP1 + B( I, L )*TEMP2
+  160                CONTINUE
+                  END IF
+  170          CONTINUE
+  180       CONTINUE
+         END IF
+      ELSE
+*
+*        Form  C := alpha*A'*B + alpha*B'*A + C.
+*
+         IF( UPPER )THEN
+            DO 210, J = 1, N
+               DO 200, I = 1, J
+                  TEMP1 = ZERO
+                  TEMP2 = ZERO
+                  DO 190, L = 1, K
+                     TEMP1 = TEMP1 + A( L, I )*B( L, J )
+                     TEMP2 = TEMP2 + B( L, I )*A( L, J )
+  190             CONTINUE
+                  IF( BETA.EQ.ZERO )THEN
+                     C( I, J ) = ALPHA*TEMP1 + ALPHA*TEMP2
+                  ELSE
+                     C( I, J ) = BETA *C( I, J ) +
+     $                           ALPHA*TEMP1 + ALPHA*TEMP2
+                  END IF
+  200          CONTINUE
+  210       CONTINUE
+         ELSE
+            DO 240, J = 1, N
+               DO 230, I = J, N
+                  TEMP1 = ZERO
+                  TEMP2 = ZERO
+                  DO 220, L = 1, K
+                     TEMP1 = TEMP1 + A( L, I )*B( L, J )
+                     TEMP2 = TEMP2 + B( L, I )*A( L, J )
+  220             CONTINUE
+                  IF( BETA.EQ.ZERO )THEN
+                     C( I, J ) = ALPHA*TEMP1 + ALPHA*TEMP2
+                  ELSE
+                     C( I, J ) = BETA *C( I, J ) +
+     $                           ALPHA*TEMP1 + ALPHA*TEMP2
+                  END IF
+  230          CONTINUE
+  240       CONTINUE
+         END IF
+      END IF
+*
+      RETURN
+*
+*     End of DSYR2K.
+*
+      END
diff --git a/src/fortran/blas/dsyrk.f b/src/fortran/blas/dsyrk.f
new file mode 100644
index 0000000..b618b29
--- /dev/null
+++ b/src/fortran/blas/dsyrk.f
@@ -0,0 +1,294 @@
+      SUBROUTINE DSYRK ( UPLO, TRANS, N, K, ALPHA, A, LDA,
+     $                   BETA, C, LDC )
+*     .. Scalar Arguments ..
+      CHARACTER*1        UPLO, TRANS
+      INTEGER            N, K, LDA, LDC
+      DOUBLE PRECISION   ALPHA, BETA
+*     .. Array Arguments ..
+      DOUBLE PRECISION   A( LDA, * ), C( LDC, * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  DSYRK  performs one of the symmetric rank k operations
+*
+*     C := alpha*A*A' + beta*C,
+*
+*  or
+*
+*     C := alpha*A'*A + beta*C,
+*
+*  where  alpha and beta  are scalars, C is an  n by n  symmetric matrix
+*  and  A  is an  n by k  matrix in the first case and a  k by n  matrix
+*  in the second case.
+*
+*  Parameters
+*  ==========
+*
+*  UPLO   - CHARACTER*1.
+*           On  entry,   UPLO  specifies  whether  the  upper  or  lower
+*           triangular  part  of the  array  C  is to be  referenced  as
+*           follows:
+*
+*              UPLO = 'U' or 'u'   Only the  upper triangular part of  C
+*                                  is to be referenced.
+*
+*              UPLO = 'L' or 'l'   Only the  lower triangular part of  C
+*                                  is to be referenced.
+*
+*           Unchanged on exit.
+*
+*  TRANS  - CHARACTER*1.
+*           On entry,  TRANS  specifies the operation to be performed as
+*           follows:
+*
+*              TRANS = 'N' or 'n'   C := alpha*A*A' + beta*C.
+*
+*              TRANS = 'T' or 't'   C := alpha*A'*A + beta*C.
+*
+*              TRANS = 'C' or 'c'   C := alpha*A'*A + beta*C.
+*
+*           Unchanged on exit.
+*
+*  N      - INTEGER.
+*           On entry,  N specifies the order of the matrix C.  N must be
+*           at least zero.
+*           Unchanged on exit.
+*
+*  K      - INTEGER.
+*           On entry with  TRANS = 'N' or 'n',  K  specifies  the number
+*           of  columns   of  the   matrix   A,   and  on   entry   with
+*           TRANS = 'T' or 't' or 'C' or 'c',  K  specifies  the  number
+*           of rows of the matrix  A.  K must be at least zero.
+*           Unchanged on exit.
+*
+*  ALPHA  - DOUBLE PRECISION.
+*           On entry, ALPHA specifies the scalar alpha.
+*           Unchanged on exit.
+*
+*  A      - DOUBLE PRECISION array of DIMENSION ( LDA, ka ), where ka is
+*           k  when  TRANS = 'N' or 'n',  and is  n  otherwise.
+*           Before entry with  TRANS = 'N' or 'n',  the  leading  n by k
+*           part of the array  A  must contain the matrix  A,  otherwise
+*           the leading  k by n  part of the array  A  must contain  the
+*           matrix A.
+*           Unchanged on exit.
+*
+*  LDA    - INTEGER.
+*           On entry, LDA specifies the first dimension of A as declared
+*           in  the  calling  (sub)  program.   When  TRANS = 'N' or 'n'
+*           then  LDA must be at least  max( 1, n ), otherwise  LDA must
+*           be at least  max( 1, k ).
+*           Unchanged on exit.
+*
+*  BETA   - DOUBLE PRECISION.
+*           On entry, BETA specifies the scalar beta.
+*           Unchanged on exit.
+*
+*  C      - DOUBLE PRECISION array of DIMENSION ( LDC, n ).
+*           Before entry  with  UPLO = 'U' or 'u',  the leading  n by n
+*           upper triangular part of the array C must contain the upper
+*           triangular part  of the  symmetric matrix  and the strictly
+*           lower triangular part of C is not referenced.  On exit, the
+*           upper triangular part of the array  C is overwritten by the
+*           upper triangular part of the updated matrix.
+*           Before entry  with  UPLO = 'L' or 'l',  the leading  n by n
+*           lower triangular part of the array C must contain the lower
+*           triangular part  of the  symmetric matrix  and the strictly
+*           upper triangular part of C is not referenced.  On exit, the
+*           lower triangular part of the array  C is overwritten by the
+*           lower triangular part of the updated matrix.
+*
+*  LDC    - INTEGER.
+*           On entry, LDC specifies the first dimension of C as declared
+*           in  the  calling  (sub)  program.   LDC  must  be  at  least
+*           max( 1, n ).
+*           Unchanged on exit.
+*
+*
+*  Level 3 Blas routine.
+*
+*  -- Written on 8-February-1989.
+*     Jack Dongarra, Argonne National Laboratory.
+*     Iain Duff, AERE Harwell.
+*     Jeremy Du Croz, Numerical Algorithms Group Ltd.
+*     Sven Hammarling, Numerical Algorithms Group Ltd.
+*
+*
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     .. Local Scalars ..
+      LOGICAL            UPPER
+      INTEGER            I, INFO, J, L, NROWA
+      DOUBLE PRECISION   TEMP
+*     .. Parameters ..
+      DOUBLE PRECISION   ONE ,         ZERO
+      PARAMETER        ( ONE = 1.0D+0, ZERO = 0.0D+0 )
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      IF( LSAME( TRANS, 'N' ) )THEN
+         NROWA = N
+      ELSE
+         NROWA = K
+      END IF
+      UPPER = LSAME( UPLO, 'U' )
+*
+      INFO = 0
+      IF(      ( .NOT.UPPER               ).AND.
+     $         ( .NOT.LSAME( UPLO , 'L' ) )      )THEN
+         INFO = 1
+      ELSE IF( ( .NOT.LSAME( TRANS, 'N' ) ).AND.
+     $         ( .NOT.LSAME( TRANS, 'T' ) ).AND.
+     $         ( .NOT.LSAME( TRANS, 'C' ) )      )THEN
+         INFO = 2
+      ELSE IF( N  .LT.0               )THEN
+         INFO = 3
+      ELSE IF( K  .LT.0               )THEN
+         INFO = 4
+      ELSE IF( LDA.LT.MAX( 1, NROWA ) )THEN
+         INFO = 7
+      ELSE IF( LDC.LT.MAX( 1, N     ) )THEN
+         INFO = 10
+      END IF
+      IF( INFO.NE.0 )THEN
+         CALL XERBLA( 'DSYRK ', INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF( ( N.EQ.0 ).OR.
+     $    ( ( ( ALPHA.EQ.ZERO ).OR.( K.EQ.0 ) ).AND.( BETA.EQ.ONE ) ) )
+     $   RETURN
+*
+*     And when  alpha.eq.zero.
+*
+      IF( ALPHA.EQ.ZERO )THEN
+         IF( UPPER )THEN
+            IF( BETA.EQ.ZERO )THEN
+               DO 20, J = 1, N
+                  DO 10, I = 1, J
+                     C( I, J ) = ZERO
+   10             CONTINUE
+   20          CONTINUE
+            ELSE
+               DO 40, J = 1, N
+                  DO 30, I = 1, J
+                     C( I, J ) = BETA*C( I, J )
+   30             CONTINUE
+   40          CONTINUE
+            END IF
+         ELSE
+            IF( BETA.EQ.ZERO )THEN
+               DO 60, J = 1, N
+                  DO 50, I = J, N
+                     C( I, J ) = ZERO
+   50             CONTINUE
+   60          CONTINUE
+            ELSE
+               DO 80, J = 1, N
+                  DO 70, I = J, N
+                     C( I, J ) = BETA*C( I, J )
+   70             CONTINUE
+   80          CONTINUE
+            END IF
+         END IF
+         RETURN
+      END IF
+*
+*     Start the operations.
+*
+      IF( LSAME( TRANS, 'N' ) )THEN
+*
+*        Form  C := alpha*A*A' + beta*C.
+*
+         IF( UPPER )THEN
+            DO 130, J = 1, N
+               IF( BETA.EQ.ZERO )THEN
+                  DO 90, I = 1, J
+                     C( I, J ) = ZERO
+   90             CONTINUE
+               ELSE IF( BETA.NE.ONE )THEN
+                  DO 100, I = 1, J
+                     C( I, J ) = BETA*C( I, J )
+  100             CONTINUE
+               END IF
+               DO 120, L = 1, K
+                  IF( A( J, L ).NE.ZERO )THEN
+                     TEMP = ALPHA*A( J, L )
+                     DO 110, I = 1, J
+                        C( I, J ) = C( I, J ) + TEMP*A( I, L )
+  110                CONTINUE
+                  END IF
+  120          CONTINUE
+  130       CONTINUE
+         ELSE
+            DO 180, J = 1, N
+               IF( BETA.EQ.ZERO )THEN
+                  DO 140, I = J, N
+                     C( I, J ) = ZERO
+  140             CONTINUE
+               ELSE IF( BETA.NE.ONE )THEN
+                  DO 150, I = J, N
+                     C( I, J ) = BETA*C( I, J )
+  150             CONTINUE
+               END IF
+               DO 170, L = 1, K
+                  IF( A( J, L ).NE.ZERO )THEN
+                     TEMP      = ALPHA*A( J, L )
+                     DO 160, I = J, N
+                        C( I, J ) = C( I, J ) + TEMP*A( I, L )
+  160                CONTINUE
+                  END IF
+  170          CONTINUE
+  180       CONTINUE
+         END IF
+      ELSE
+*
+*        Form  C := alpha*A'*A + beta*C.
+*
+         IF( UPPER )THEN
+            DO 210, J = 1, N
+               DO 200, I = 1, J
+                  TEMP = ZERO
+                  DO 190, L = 1, K
+                     TEMP = TEMP + A( L, I )*A( L, J )
+  190             CONTINUE
+                  IF( BETA.EQ.ZERO )THEN
+                     C( I, J ) = ALPHA*TEMP
+                  ELSE
+                     C( I, J ) = ALPHA*TEMP + BETA*C( I, J )
+                  END IF
+  200          CONTINUE
+  210       CONTINUE
+         ELSE
+            DO 240, J = 1, N
+               DO 230, I = J, N
+                  TEMP = ZERO
+                  DO 220, L = 1, K
+                     TEMP = TEMP + A( L, I )*A( L, J )
+  220             CONTINUE
+                  IF( BETA.EQ.ZERO )THEN
+                     C( I, J ) = ALPHA*TEMP
+                  ELSE
+                     C( I, J ) = ALPHA*TEMP + BETA*C( I, J )
+                  END IF
+  230          CONTINUE
+  240       CONTINUE
+         END IF
+      END IF
+*
+      RETURN
+*
+*     End of DSYRK .
+*
+      END
diff --git a/src/fortran/blas/dtbmv.f b/src/fortran/blas/dtbmv.f
new file mode 100644
index 0000000..1363db7
--- /dev/null
+++ b/src/fortran/blas/dtbmv.f
@@ -0,0 +1,342 @@
+      SUBROUTINE DTBMV ( UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX )
+*     .. Scalar Arguments ..
+      INTEGER            INCX, K, LDA, N
+      CHARACTER*1        DIAG, TRANS, UPLO
+*     .. Array Arguments ..
+      DOUBLE PRECISION   A( LDA, * ), X( * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  DTBMV  performs one of the matrix-vector operations
+*
+*     x := A*x,   or   x := A'*x,
+*
+*  where x is an n element vector and  A is an n by n unit, or non-unit,
+*  upper or lower triangular band matrix, with ( k + 1 ) diagonals.
+*
+*  Parameters
+*  ==========
+*
+*  UPLO   - CHARACTER*1.
+*           On entry, UPLO specifies whether the matrix is an upper or
+*           lower triangular matrix as follows:
+*
+*              UPLO = 'U' or 'u'   A is an upper triangular matrix.
+*
+*              UPLO = 'L' or 'l'   A is a lower triangular matrix.
+*
+*           Unchanged on exit.
+*
+*  TRANS  - CHARACTER*1.
+*           On entry, TRANS specifies the operation to be performed as
+*           follows:
+*
+*              TRANS = 'N' or 'n'   x := A*x.
+*
+*              TRANS = 'T' or 't'   x := A'*x.
+*
+*              TRANS = 'C' or 'c'   x := A'*x.
+*
+*           Unchanged on exit.
+*
+*  DIAG   - CHARACTER*1.
+*           On entry, DIAG specifies whether or not A is unit
+*           triangular as follows:
+*
+*              DIAG = 'U' or 'u'   A is assumed to be unit triangular.
+*
+*              DIAG = 'N' or 'n'   A is not assumed to be unit
+*                                  triangular.
+*
+*           Unchanged on exit.
+*
+*  N      - INTEGER.
+*           On entry, N specifies the order of the matrix A.
+*           N must be at least zero.
+*           Unchanged on exit.
+*
+*  K      - INTEGER.
+*           On entry with UPLO = 'U' or 'u', K specifies the number of
+*           super-diagonals of the matrix A.
+*           On entry with UPLO = 'L' or 'l', K specifies the number of
+*           sub-diagonals of the matrix A.
+*           K must satisfy  0 .le. K.
+*           Unchanged on exit.
+*
+*  A      - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+*           Before entry with UPLO = 'U' or 'u', the leading ( k + 1 )
+*           by n part of the array A must contain the upper triangular
+*           band part of the matrix of coefficients, supplied column by
+*           column, with the leading diagonal of the matrix in row
+*           ( k + 1 ) of the array, the first super-diagonal starting at
+*           position 2 in row k, and so on. The top left k by k triangle
+*           of the array A is not referenced.
+*           The following program segment will transfer an upper
+*           triangular band matrix from conventional full matrix storage
+*           to band storage:
+*
+*                 DO 20, J = 1, N
+*                    M = K + 1 - J
+*                    DO 10, I = MAX( 1, J - K ), J
+*                       A( M + I, J ) = matrix( I, J )
+*              10    CONTINUE
+*              20 CONTINUE
+*
+*           Before entry with UPLO = 'L' or 'l', the leading ( k + 1 )
+*           by n part of the array A must contain the lower triangular
+*           band part of the matrix of coefficients, supplied column by
+*           column, with the leading diagonal of the matrix in row 1 of
+*           the array, the first sub-diagonal starting at position 1 in
+*           row 2, and so on. The bottom right k by k triangle of the
+*           array A is not referenced.
+*           The following program segment will transfer a lower
+*           triangular band matrix from conventional full matrix storage
+*           to band storage:
+*
+*                 DO 20, J = 1, N
+*                    M = 1 - J
+*                    DO 10, I = J, MIN( N, J + K )
+*                       A( M + I, J ) = matrix( I, J )
+*              10    CONTINUE
+*              20 CONTINUE
+*
+*           Note that when DIAG = 'U' or 'u' the elements of the array A
+*           corresponding to the diagonal elements of the matrix are not
+*           referenced, but are assumed to be unity.
+*           Unchanged on exit.
+*
+*  LDA    - INTEGER.
+*           On entry, LDA specifies the first dimension of A as declared
+*           in the calling (sub) program. LDA must be at least
+*           ( k + 1 ).
+*           Unchanged on exit.
+*
+*  X      - DOUBLE PRECISION array of dimension at least
+*           ( 1 + ( n - 1 )*abs( INCX ) ).
+*           Before entry, the incremented array X must contain the n
+*           element vector x. On exit, X is overwritten with the
+*           tranformed vector x.
+*
+*  INCX   - INTEGER.
+*           On entry, INCX specifies the increment for the elements of
+*           X. INCX must not be zero.
+*           Unchanged on exit.
+*
+*
+*  Level 2 Blas routine.
+*
+*  -- Written on 22-October-1986.
+*     Jack Dongarra, Argonne National Lab.
+*     Jeremy Du Croz, Nag Central Office.
+*     Sven Hammarling, Nag Central Office.
+*     Richard Hanson, Sandia National Labs.
+*
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO
+      PARAMETER        ( ZERO = 0.0D+0 )
+*     .. Local Scalars ..
+      DOUBLE PRECISION   TEMP
+      INTEGER            I, INFO, IX, J, JX, KPLUS1, KX, L
+      LOGICAL            NOUNIT
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX, MIN
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF     ( .NOT.LSAME( UPLO , 'U' ).AND.
+     $         .NOT.LSAME( UPLO , 'L' )      )THEN
+         INFO = 1
+      ELSE IF( .NOT.LSAME( TRANS, 'N' ).AND.
+     $         .NOT.LSAME( TRANS, 'T' ).AND.
+     $         .NOT.LSAME( TRANS, 'C' )      )THEN
+         INFO = 2
+      ELSE IF( .NOT.LSAME( DIAG , 'U' ).AND.
+     $         .NOT.LSAME( DIAG , 'N' )      )THEN
+         INFO = 3
+      ELSE IF( N.LT.0 )THEN
+         INFO = 4
+      ELSE IF( K.LT.0 )THEN
+         INFO = 5
+      ELSE IF( LDA.LT.( K + 1 ) )THEN
+         INFO = 7
+      ELSE IF( INCX.EQ.0 )THEN
+         INFO = 9
+      END IF
+      IF( INFO.NE.0 )THEN
+         CALL XERBLA( 'DTBMV ', INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF( N.EQ.0 )
+     $   RETURN
+*
+      NOUNIT = LSAME( DIAG, 'N' )
+*
+*     Set up the start point in X if the increment is not unity. This
+*     will be  ( N - 1 )*INCX   too small for descending loops.
+*
+      IF( INCX.LE.0 )THEN
+         KX = 1 - ( N - 1 )*INCX
+      ELSE IF( INCX.NE.1 )THEN
+         KX = 1
+      END IF
+*
+*     Start the operations. In this version the elements of A are
+*     accessed sequentially with one pass through A.
+*
+      IF( LSAME( TRANS, 'N' ) )THEN
+*
+*         Form  x := A*x.
+*
+         IF( LSAME( UPLO, 'U' ) )THEN
+            KPLUS1 = K + 1
+            IF( INCX.EQ.1 )THEN
+               DO 20, J = 1, N
+                  IF( X( J ).NE.ZERO )THEN
+                     TEMP = X( J )
+                     L    = KPLUS1 - J
+                     DO 10, I = MAX( 1, J - K ), J - 1
+                        X( I ) = X( I ) + TEMP*A( L + I, J )
+   10                CONTINUE
+                     IF( NOUNIT )
+     $                  X( J ) = X( J )*A( KPLUS1, J )
+                  END IF
+   20          CONTINUE
+            ELSE
+               JX = KX
+               DO 40, J = 1, N
+                  IF( X( JX ).NE.ZERO )THEN
+                     TEMP = X( JX )
+                     IX   = KX
+                     L    = KPLUS1  - J
+                     DO 30, I = MAX( 1, J - K ), J - 1
+                        X( IX ) = X( IX ) + TEMP*A( L + I, J )
+                        IX      = IX      + INCX
+   30                CONTINUE
+                     IF( NOUNIT )
+     $                  X( JX ) = X( JX )*A( KPLUS1, J )
+                  END IF
+                  JX = JX + INCX
+                  IF( J.GT.K )
+     $               KX = KX + INCX
+   40          CONTINUE
+            END IF
+         ELSE
+            IF( INCX.EQ.1 )THEN
+               DO 60, J = N, 1, -1
+                  IF( X( J ).NE.ZERO )THEN
+                     TEMP = X( J )
+                     L    = 1      - J
+                     DO 50, I = MIN( N, J + K ), J + 1, -1
+                        X( I ) = X( I ) + TEMP*A( L + I, J )
+   50                CONTINUE
+                     IF( NOUNIT )
+     $                  X( J ) = X( J )*A( 1, J )
+                  END IF
+   60          CONTINUE
+            ELSE
+               KX = KX + ( N - 1 )*INCX
+               JX = KX
+               DO 80, J = N, 1, -1
+                  IF( X( JX ).NE.ZERO )THEN
+                     TEMP = X( JX )
+                     IX   = KX
+                     L    = 1       - J
+                     DO 70, I = MIN( N, J + K ), J + 1, -1
+                        X( IX ) = X( IX ) + TEMP*A( L + I, J )
+                        IX      = IX      - INCX
+   70                CONTINUE
+                     IF( NOUNIT )
+     $                  X( JX ) = X( JX )*A( 1, J )
+                  END IF
+                  JX = JX - INCX
+                  IF( ( N - J ).GE.K )
+     $               KX = KX - INCX
+   80          CONTINUE
+            END IF
+         END IF
+      ELSE
+*
+*        Form  x := A'*x.
+*
+         IF( LSAME( UPLO, 'U' ) )THEN
+            KPLUS1 = K + 1
+            IF( INCX.EQ.1 )THEN
+               DO 100, J = N, 1, -1
+                  TEMP = X( J )
+                  L    = KPLUS1 - J
+                  IF( NOUNIT )
+     $               TEMP = TEMP*A( KPLUS1, J )
+                  DO 90, I = J - 1, MAX( 1, J - K ), -1
+                     TEMP = TEMP + A( L + I, J )*X( I )
+   90             CONTINUE
+                  X( J ) = TEMP
+  100          CONTINUE
+            ELSE
+               KX = KX + ( N - 1 )*INCX
+               JX = KX
+               DO 120, J = N, 1, -1
+                  TEMP = X( JX )
+                  KX   = KX      - INCX
+                  IX   = KX
+                  L    = KPLUS1  - J
+                  IF( NOUNIT )
+     $               TEMP = TEMP*A( KPLUS1, J )
+                  DO 110, I = J - 1, MAX( 1, J - K ), -1
+                     TEMP = TEMP + A( L + I, J )*X( IX )
+                     IX   = IX   - INCX
+  110             CONTINUE
+                  X( JX ) = TEMP
+                  JX      = JX   - INCX
+  120          CONTINUE
+            END IF
+         ELSE
+            IF( INCX.EQ.1 )THEN
+               DO 140, J = 1, N
+                  TEMP = X( J )
+                  L    = 1      - J
+                  IF( NOUNIT )
+     $               TEMP = TEMP*A( 1, J )
+                  DO 130, I = J + 1, MIN( N, J + K )
+                     TEMP = TEMP + A( L + I, J )*X( I )
+  130             CONTINUE
+                  X( J ) = TEMP
+  140          CONTINUE
+            ELSE
+               JX = KX
+               DO 160, J = 1, N
+                  TEMP = X( JX )
+                  KX   = KX      + INCX
+                  IX   = KX
+                  L    = 1       - J
+                  IF( NOUNIT )
+     $               TEMP = TEMP*A( 1, J )
+                  DO 150, I = J + 1, MIN( N, J + K )
+                     TEMP = TEMP + A( L + I, J )*X( IX )
+                     IX   = IX   + INCX
+  150             CONTINUE
+                  X( JX ) = TEMP
+                  JX      = JX   + INCX
+  160          CONTINUE
+            END IF
+         END IF
+      END IF
+*
+      RETURN
+*
+*     End of DTBMV .
+*
+      END
diff --git a/src/fortran/blas/dtbsv.f b/src/fortran/blas/dtbsv.f
new file mode 100644
index 0000000..d87ed82
--- /dev/null
+++ b/src/fortran/blas/dtbsv.f
@@ -0,0 +1,346 @@
+      SUBROUTINE DTBSV ( UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX )
+*     .. Scalar Arguments ..
+      INTEGER            INCX, K, LDA, N
+      CHARACTER*1        DIAG, TRANS, UPLO
+*     .. Array Arguments ..
+      DOUBLE PRECISION   A( LDA, * ), X( * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  DTBSV  solves one of the systems of equations
+*
+*     A*x = b,   or   A'*x = b,
+*
+*  where b and x are n element vectors and A is an n by n unit, or
+*  non-unit, upper or lower triangular band matrix, with ( k + 1 )
+*  diagonals.
+*
+*  No test for singularity or near-singularity is included in this
+*  routine. Such tests must be performed before calling this routine.
+*
+*  Parameters
+*  ==========
+*
+*  UPLO   - CHARACTER*1.
+*           On entry, UPLO specifies whether the matrix is an upper or
+*           lower triangular matrix as follows:
+*
+*              UPLO = 'U' or 'u'   A is an upper triangular matrix.
+*
+*              UPLO = 'L' or 'l'   A is a lower triangular matrix.
+*
+*           Unchanged on exit.
+*
+*  TRANS  - CHARACTER*1.
+*           On entry, TRANS specifies the equations to be solved as
+*           follows:
+*
+*              TRANS = 'N' or 'n'   A*x = b.
+*
+*              TRANS = 'T' or 't'   A'*x = b.
+*
+*              TRANS = 'C' or 'c'   A'*x = b.
+*
+*           Unchanged on exit.
+*
+*  DIAG   - CHARACTER*1.
+*           On entry, DIAG specifies whether or not A is unit
+*           triangular as follows:
+*
+*              DIAG = 'U' or 'u'   A is assumed to be unit triangular.
+*
+*              DIAG = 'N' or 'n'   A is not assumed to be unit
+*                                  triangular.
+*
+*           Unchanged on exit.
+*
+*  N      - INTEGER.
+*           On entry, N specifies the order of the matrix A.
+*           N must be at least zero.
+*           Unchanged on exit.
+*
+*  K      - INTEGER.
+*           On entry with UPLO = 'U' or 'u', K specifies the number of
+*           super-diagonals of the matrix A.
+*           On entry with UPLO = 'L' or 'l', K specifies the number of
+*           sub-diagonals of the matrix A.
+*           K must satisfy  0 .le. K.
+*           Unchanged on exit.
+*
+*  A      - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+*           Before entry with UPLO = 'U' or 'u', the leading ( k + 1 )
+*           by n part of the array A must contain the upper triangular
+*           band part of the matrix of coefficients, supplied column by
+*           column, with the leading diagonal of the matrix in row
+*           ( k + 1 ) of the array, the first super-diagonal starting at
+*           position 2 in row k, and so on. The top left k by k triangle
+*           of the array A is not referenced.
+*           The following program segment will transfer an upper
+*           triangular band matrix from conventional full matrix storage
+*           to band storage:
+*
+*                 DO 20, J = 1, N
+*                    M = K + 1 - J
+*                    DO 10, I = MAX( 1, J - K ), J
+*                       A( M + I, J ) = matrix( I, J )
+*              10    CONTINUE
+*              20 CONTINUE
+*
+*           Before entry with UPLO = 'L' or 'l', the leading ( k + 1 )
+*           by n part of the array A must contain the lower triangular
+*           band part of the matrix of coefficients, supplied column by
+*           column, with the leading diagonal of the matrix in row 1 of
+*           the array, the first sub-diagonal starting at position 1 in
+*           row 2, and so on. The bottom right k by k triangle of the
+*           array A is not referenced.
+*           The following program segment will transfer a lower
+*           triangular band matrix from conventional full matrix storage
+*           to band storage:
+*
+*                 DO 20, J = 1, N
+*                    M = 1 - J
+*                    DO 10, I = J, MIN( N, J + K )
+*                       A( M + I, J ) = matrix( I, J )
+*              10    CONTINUE
+*              20 CONTINUE
+*
+*           Note that when DIAG = 'U' or 'u' the elements of the array A
+*           corresponding to the diagonal elements of the matrix are not
+*           referenced, but are assumed to be unity.
+*           Unchanged on exit.
+*
+*  LDA    - INTEGER.
+*           On entry, LDA specifies the first dimension of A as declared
+*           in the calling (sub) program. LDA must be at least
+*           ( k + 1 ).
+*           Unchanged on exit.
+*
+*  X      - DOUBLE PRECISION array of dimension at least
+*           ( 1 + ( n - 1 )*abs( INCX ) ).
+*           Before entry, the incremented array X must contain the n
+*           element right-hand side vector b. On exit, X is overwritten
+*           with the solution vector x.
+*
+*  INCX   - INTEGER.
+*           On entry, INCX specifies the increment for the elements of
+*           X. INCX must not be zero.
+*           Unchanged on exit.
+*
+*
+*  Level 2 Blas routine.
+*
+*  -- Written on 22-October-1986.
+*     Jack Dongarra, Argonne National Lab.
+*     Jeremy Du Croz, Nag Central Office.
+*     Sven Hammarling, Nag Central Office.
+*     Richard Hanson, Sandia National Labs.
+*
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO
+      PARAMETER        ( ZERO = 0.0D+0 )
+*     .. Local Scalars ..
+      DOUBLE PRECISION   TEMP
+      INTEGER            I, INFO, IX, J, JX, KPLUS1, KX, L
+      LOGICAL            NOUNIT
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX, MIN
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF     ( .NOT.LSAME( UPLO , 'U' ).AND.
+     $         .NOT.LSAME( UPLO , 'L' )      )THEN
+         INFO = 1
+      ELSE IF( .NOT.LSAME( TRANS, 'N' ).AND.
+     $         .NOT.LSAME( TRANS, 'T' ).AND.
+     $         .NOT.LSAME( TRANS, 'C' )      )THEN
+         INFO = 2
+      ELSE IF( .NOT.LSAME( DIAG , 'U' ).AND.
+     $         .NOT.LSAME( DIAG , 'N' )      )THEN
+         INFO = 3
+      ELSE IF( N.LT.0 )THEN
+         INFO = 4
+      ELSE IF( K.LT.0 )THEN
+         INFO = 5
+      ELSE IF( LDA.LT.( K + 1 ) )THEN
+         INFO = 7
+      ELSE IF( INCX.EQ.0 )THEN
+         INFO = 9
+      END IF
+      IF( INFO.NE.0 )THEN
+         CALL XERBLA( 'DTBSV ', INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF( N.EQ.0 )
+     $   RETURN
+*
+      NOUNIT = LSAME( DIAG, 'N' )
+*
+*     Set up the start point in X if the increment is not unity. This
+*     will be  ( N - 1 )*INCX  too small for descending loops.
+*
+      IF( INCX.LE.0 )THEN
+         KX = 1 - ( N - 1 )*INCX
+      ELSE IF( INCX.NE.1 )THEN
+         KX = 1
+      END IF
+*
+*     Start the operations. In this version the elements of A are
+*     accessed by sequentially with one pass through A.
+*
+      IF( LSAME( TRANS, 'N' ) )THEN
+*
+*        Form  x := inv( A )*x.
+*
+         IF( LSAME( UPLO, 'U' ) )THEN
+            KPLUS1 = K + 1
+            IF( INCX.EQ.1 )THEN
+               DO 20, J = N, 1, -1
+                  IF( X( J ).NE.ZERO )THEN
+                     L = KPLUS1 - J
+                     IF( NOUNIT )
+     $                  X( J ) = X( J )/A( KPLUS1, J )
+                     TEMP = X( J )
+                     DO 10, I = J - 1, MAX( 1, J - K ), -1
+                        X( I ) = X( I ) - TEMP*A( L + I, J )
+   10                CONTINUE
+                  END IF
+   20          CONTINUE
+            ELSE
+               KX = KX + ( N - 1 )*INCX
+               JX = KX
+               DO 40, J = N, 1, -1
+                  KX = KX - INCX
+                  IF( X( JX ).NE.ZERO )THEN
+                     IX = KX
+                     L  = KPLUS1 - J
+                     IF( NOUNIT )
+     $                  X( JX ) = X( JX )/A( KPLUS1, J )
+                     TEMP = X( JX )
+                     DO 30, I = J - 1, MAX( 1, J - K ), -1
+                        X( IX ) = X( IX ) - TEMP*A( L + I, J )
+                        IX      = IX      - INCX
+   30                CONTINUE
+                  END IF
+                  JX = JX - INCX
+   40          CONTINUE
+            END IF
+         ELSE
+            IF( INCX.EQ.1 )THEN
+               DO 60, J = 1, N
+                  IF( X( J ).NE.ZERO )THEN
+                     L = 1 - J
+                     IF( NOUNIT )
+     $                  X( J ) = X( J )/A( 1, J )
+                     TEMP = X( J )
+                     DO 50, I = J + 1, MIN( N, J + K )
+                        X( I ) = X( I ) - TEMP*A( L + I, J )
+   50                CONTINUE
+                  END IF
+   60          CONTINUE
+            ELSE
+               JX = KX
+               DO 80, J = 1, N
+                  KX = KX + INCX
+                  IF( X( JX ).NE.ZERO )THEN
+                     IX = KX
+                     L  = 1  - J
+                     IF( NOUNIT )
+     $                  X( JX ) = X( JX )/A( 1, J )
+                     TEMP = X( JX )
+                     DO 70, I = J + 1, MIN( N, J + K )
+                        X( IX ) = X( IX ) - TEMP*A( L + I, J )
+                        IX      = IX      + INCX
+   70                CONTINUE
+                  END IF
+                  JX = JX + INCX
+   80          CONTINUE
+            END IF
+         END IF
+      ELSE
+*
+*        Form  x := inv( A')*x.
+*
+         IF( LSAME( UPLO, 'U' ) )THEN
+            KPLUS1 = K + 1
+            IF( INCX.EQ.1 )THEN
+               DO 100, J = 1, N
+                  TEMP = X( J )
+                  L    = KPLUS1 - J
+                  DO 90, I = MAX( 1, J - K ), J - 1
+                     TEMP = TEMP - A( L + I, J )*X( I )
+   90             CONTINUE
+                  IF( NOUNIT )
+     $               TEMP = TEMP/A( KPLUS1, J )
+                  X( J ) = TEMP
+  100          CONTINUE
+            ELSE
+               JX = KX
+               DO 120, J = 1, N
+                  TEMP = X( JX )
+                  IX   = KX
+                  L    = KPLUS1  - J
+                  DO 110, I = MAX( 1, J - K ), J - 1
+                     TEMP = TEMP - A( L + I, J )*X( IX )
+                     IX   = IX   + INCX
+  110             CONTINUE
+                  IF( NOUNIT )
+     $               TEMP = TEMP/A( KPLUS1, J )
+                  X( JX ) = TEMP
+                  JX      = JX   + INCX
+                  IF( J.GT.K )
+     $               KX = KX + INCX
+  120          CONTINUE
+            END IF
+         ELSE
+            IF( INCX.EQ.1 )THEN
+               DO 140, J = N, 1, -1
+                  TEMP = X( J )
+                  L    = 1      - J
+                  DO 130, I = MIN( N, J + K ), J + 1, -1
+                     TEMP = TEMP - A( L + I, J )*X( I )
+  130             CONTINUE
+                  IF( NOUNIT )
+     $               TEMP = TEMP/A( 1, J )
+                  X( J ) = TEMP
+  140          CONTINUE
+            ELSE
+               KX = KX + ( N - 1 )*INCX
+               JX = KX
+               DO 160, J = N, 1, -1
+                  TEMP = X( JX )
+                  IX   = KX
+                  L    = 1       - J
+                  DO 150, I = MIN( N, J + K ), J + 1, -1
+                     TEMP = TEMP - A( L + I, J )*X( IX )
+                     IX   = IX   - INCX
+  150             CONTINUE
+                  IF( NOUNIT )
+     $               TEMP = TEMP/A( 1, J )
+                  X( JX ) = TEMP
+                  JX      = JX   - INCX
+                  IF( ( N - J ).GE.K )
+     $               KX = KX - INCX
+  160          CONTINUE
+            END IF
+         END IF
+      END IF
+*
+      RETURN
+*
+*     End of DTBSV .
+*
+      END
diff --git a/src/fortran/blas/dtpmv.f b/src/fortran/blas/dtpmv.f
new file mode 100644
index 0000000..ee11bc1
--- /dev/null
+++ b/src/fortran/blas/dtpmv.f
@@ -0,0 +1,299 @@
+      SUBROUTINE DTPMV ( UPLO, TRANS, DIAG, N, AP, X, INCX )
+*     .. Scalar Arguments ..
+      INTEGER            INCX, N
+      CHARACTER*1        DIAG, TRANS, UPLO
+*     .. Array Arguments ..
+      DOUBLE PRECISION   AP( * ), X( * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  DTPMV  performs one of the matrix-vector operations
+*
+*     x := A*x,   or   x := A'*x,
+*
+*  where x is an n element vector and  A is an n by n unit, or non-unit,
+*  upper or lower triangular matrix, supplied in packed form.
+*
+*  Parameters
+*  ==========
+*
+*  UPLO   - CHARACTER*1.
+*           On entry, UPLO specifies whether the matrix is an upper or
+*           lower triangular matrix as follows:
+*
+*              UPLO = 'U' or 'u'   A is an upper triangular matrix.
+*
+*              UPLO = 'L' or 'l'   A is a lower triangular matrix.
+*
+*           Unchanged on exit.
+*
+*  TRANS  - CHARACTER*1.
+*           On entry, TRANS specifies the operation to be performed as
+*           follows:
+*
+*              TRANS = 'N' or 'n'   x := A*x.
+*
+*              TRANS = 'T' or 't'   x := A'*x.
+*
+*              TRANS = 'C' or 'c'   x := A'*x.
+*
+*           Unchanged on exit.
+*
+*  DIAG   - CHARACTER*1.
+*           On entry, DIAG specifies whether or not A is unit
+*           triangular as follows:
+*
+*              DIAG = 'U' or 'u'   A is assumed to be unit triangular.
+*
+*              DIAG = 'N' or 'n'   A is not assumed to be unit
+*                                  triangular.
+*
+*           Unchanged on exit.
+*
+*  N      - INTEGER.
+*           On entry, N specifies the order of the matrix A.
+*           N must be at least zero.
+*           Unchanged on exit.
+*
+*  AP     - DOUBLE PRECISION array of DIMENSION at least
+*           ( ( n*( n + 1 ) )/2 ).
+*           Before entry with  UPLO = 'U' or 'u', the array AP must
+*           contain the upper triangular matrix packed sequentially,
+*           column by column, so that AP( 1 ) contains a( 1, 1 ),
+*           AP( 2 ) and AP( 3 ) contain a( 1, 2 ) and a( 2, 2 )
+*           respectively, and so on.
+*           Before entry with UPLO = 'L' or 'l', the array AP must
+*           contain the lower triangular matrix packed sequentially,
+*           column by column, so that AP( 1 ) contains a( 1, 1 ),
+*           AP( 2 ) and AP( 3 ) contain a( 2, 1 ) and a( 3, 1 )
+*           respectively, and so on.
+*           Note that when  DIAG = 'U' or 'u', the diagonal elements of
+*           A are not referenced, but are assumed to be unity.
+*           Unchanged on exit.
+*
+*  X      - DOUBLE PRECISION array of dimension at least
+*           ( 1 + ( n - 1 )*abs( INCX ) ).
+*           Before entry, the incremented array X must contain the n
+*           element vector x. On exit, X is overwritten with the
+*           tranformed vector x.
+*
+*  INCX   - INTEGER.
+*           On entry, INCX specifies the increment for the elements of
+*           X. INCX must not be zero.
+*           Unchanged on exit.
+*
+*
+*  Level 2 Blas routine.
+*
+*  -- Written on 22-October-1986.
+*     Jack Dongarra, Argonne National Lab.
+*     Jeremy Du Croz, Nag Central Office.
+*     Sven Hammarling, Nag Central Office.
+*     Richard Hanson, Sandia National Labs.
+*
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO
+      PARAMETER        ( ZERO = 0.0D+0 )
+*     .. Local Scalars ..
+      DOUBLE PRECISION   TEMP
+      INTEGER            I, INFO, IX, J, JX, K, KK, KX
+      LOGICAL            NOUNIT
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF     ( .NOT.LSAME( UPLO , 'U' ).AND.
+     $         .NOT.LSAME( UPLO , 'L' )      )THEN
+         INFO = 1
+      ELSE IF( .NOT.LSAME( TRANS, 'N' ).AND.
+     $         .NOT.LSAME( TRANS, 'T' ).AND.
+     $         .NOT.LSAME( TRANS, 'C' )      )THEN
+         INFO = 2
+      ELSE IF( .NOT.LSAME( DIAG , 'U' ).AND.
+     $         .NOT.LSAME( DIAG , 'N' )      )THEN
+         INFO = 3
+      ELSE IF( N.LT.0 )THEN
+         INFO = 4
+      ELSE IF( INCX.EQ.0 )THEN
+         INFO = 7
+      END IF
+      IF( INFO.NE.0 )THEN
+         CALL XERBLA( 'DTPMV ', INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF( N.EQ.0 )
+     $   RETURN
+*
+      NOUNIT = LSAME( DIAG, 'N' )
+*
+*     Set up the start point in X if the increment is not unity. This
+*     will be  ( N - 1 )*INCX  too small for descending loops.
+*
+      IF( INCX.LE.0 )THEN
+         KX = 1 - ( N - 1 )*INCX
+      ELSE IF( INCX.NE.1 )THEN
+         KX = 1
+      END IF
+*
+*     Start the operations. In this version the elements of AP are
+*     accessed sequentially with one pass through AP.
+*
+      IF( LSAME( TRANS, 'N' ) )THEN
+*
+*        Form  x:= A*x.
+*
+         IF( LSAME( UPLO, 'U' ) )THEN
+            KK =1
+            IF( INCX.EQ.1 )THEN
+               DO 20, J = 1, N
+                  IF( X( J ).NE.ZERO )THEN
+                     TEMP = X( J )
+                     K    = KK
+                     DO 10, I = 1, J - 1
+                        X( I ) = X( I ) + TEMP*AP( K )
+                        K      = K      + 1
+   10                CONTINUE
+                     IF( NOUNIT )
+     $                  X( J ) = X( J )*AP( KK + J - 1 )
+                  END IF
+                  KK = KK + J
+   20          CONTINUE
+            ELSE
+               JX = KX
+               DO 40, J = 1, N
+                  IF( X( JX ).NE.ZERO )THEN
+                     TEMP = X( JX )
+                     IX   = KX
+                     DO 30, K = KK, KK + J - 2
+                        X( IX ) = X( IX ) + TEMP*AP( K )
+                        IX      = IX      + INCX
+   30                CONTINUE
+                     IF( NOUNIT )
+     $                  X( JX ) = X( JX )*AP( KK + J - 1 )
+                  END IF
+                  JX = JX + INCX
+                  KK = KK + J
+   40          CONTINUE
+            END IF
+         ELSE
+            KK = ( N*( N + 1 ) )/2
+            IF( INCX.EQ.1 )THEN
+               DO 60, J = N, 1, -1
+                  IF( X( J ).NE.ZERO )THEN
+                     TEMP = X( J )
+                     K    = KK
+                     DO 50, I = N, J + 1, -1
+                        X( I ) = X( I ) + TEMP*AP( K )
+                        K      = K      - 1
+   50                CONTINUE
+                     IF( NOUNIT )
+     $                  X( J ) = X( J )*AP( KK - N + J )
+                  END IF
+                  KK = KK - ( N - J + 1 )
+   60          CONTINUE
+            ELSE
+               KX = KX + ( N - 1 )*INCX
+               JX = KX
+               DO 80, J = N, 1, -1
+                  IF( X( JX ).NE.ZERO )THEN
+                     TEMP = X( JX )
+                     IX   = KX
+                     DO 70, K = KK, KK - ( N - ( J + 1 ) ), -1
+                        X( IX ) = X( IX ) + TEMP*AP( K )
+                        IX      = IX      - INCX
+   70                CONTINUE
+                     IF( NOUNIT )
+     $                  X( JX ) = X( JX )*AP( KK - N + J )
+                  END IF
+                  JX = JX - INCX
+                  KK = KK - ( N - J + 1 )
+   80          CONTINUE
+            END IF
+         END IF
+      ELSE
+*
+*        Form  x := A'*x.
+*
+         IF( LSAME( UPLO, 'U' ) )THEN
+            KK = ( N*( N + 1 ) )/2
+            IF( INCX.EQ.1 )THEN
+               DO 100, J = N, 1, -1
+                  TEMP = X( J )
+                  IF( NOUNIT )
+     $               TEMP = TEMP*AP( KK )
+                  K = KK - 1
+                  DO 90, I = J - 1, 1, -1
+                     TEMP = TEMP + AP( K )*X( I )
+                     K    = K    - 1
+   90             CONTINUE
+                  X( J ) = TEMP
+                  KK     = KK   - J
+  100          CONTINUE
+            ELSE
+               JX = KX + ( N - 1 )*INCX
+               DO 120, J = N, 1, -1
+                  TEMP = X( JX )
+                  IX   = JX
+                  IF( NOUNIT )
+     $               TEMP = TEMP*AP( KK )
+                  DO 110, K = KK - 1, KK - J + 1, -1
+                     IX   = IX   - INCX
+                     TEMP = TEMP + AP( K )*X( IX )
+  110             CONTINUE
+                  X( JX ) = TEMP
+                  JX      = JX   - INCX
+                  KK      = KK   - J
+  120          CONTINUE
+            END IF
+         ELSE
+            KK = 1
+            IF( INCX.EQ.1 )THEN
+               DO 140, J = 1, N
+                  TEMP = X( J )
+                  IF( NOUNIT )
+     $               TEMP = TEMP*AP( KK )
+                  K = KK + 1
+                  DO 130, I = J + 1, N
+                     TEMP = TEMP + AP( K )*X( I )
+                     K    = K    + 1
+  130             CONTINUE
+                  X( J ) = TEMP
+                  KK     = KK   + ( N - J + 1 )
+  140          CONTINUE
+            ELSE
+               JX = KX
+               DO 160, J = 1, N
+                  TEMP = X( JX )
+                  IX   = JX
+                  IF( NOUNIT )
+     $               TEMP = TEMP*AP( KK )
+                  DO 150, K = KK + 1, KK + N - J
+                     IX   = IX   + INCX
+                     TEMP = TEMP + AP( K )*X( IX )
+  150             CONTINUE
+                  X( JX ) = TEMP
+                  JX      = JX   + INCX
+                  KK      = KK   + ( N - J + 1 )
+  160          CONTINUE
+            END IF
+         END IF
+      END IF
+*
+      RETURN
+*
+*     End of DTPMV .
+*
+      END
diff --git a/src/fortran/blas/dtpsv.f b/src/fortran/blas/dtpsv.f
new file mode 100644
index 0000000..91930d9
--- /dev/null
+++ b/src/fortran/blas/dtpsv.f
@@ -0,0 +1,302 @@
+      SUBROUTINE DTPSV ( UPLO, TRANS, DIAG, N, AP, X, INCX )
+*     .. Scalar Arguments ..
+      INTEGER            INCX, N
+      CHARACTER*1        DIAG, TRANS, UPLO
+*     .. Array Arguments ..
+      DOUBLE PRECISION   AP( * ), X( * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  DTPSV  solves one of the systems of equations
+*
+*     A*x = b,   or   A'*x = b,
+*
+*  where b and x are n element vectors and A is an n by n unit, or
+*  non-unit, upper or lower triangular matrix, supplied in packed form.
+*
+*  No test for singularity or near-singularity is included in this
+*  routine. Such tests must be performed before calling this routine.
+*
+*  Parameters
+*  ==========
+*
+*  UPLO   - CHARACTER*1.
+*           On entry, UPLO specifies whether the matrix is an upper or
+*           lower triangular matrix as follows:
+*
+*              UPLO = 'U' or 'u'   A is an upper triangular matrix.
+*
+*              UPLO = 'L' or 'l'   A is a lower triangular matrix.
+*
+*           Unchanged on exit.
+*
+*  TRANS  - CHARACTER*1.
+*           On entry, TRANS specifies the equations to be solved as
+*           follows:
+*
+*              TRANS = 'N' or 'n'   A*x = b.
+*
+*              TRANS = 'T' or 't'   A'*x = b.
+*
+*              TRANS = 'C' or 'c'   A'*x = b.
+*
+*           Unchanged on exit.
+*
+*  DIAG   - CHARACTER*1.
+*           On entry, DIAG specifies whether or not A is unit
+*           triangular as follows:
+*
+*              DIAG = 'U' or 'u'   A is assumed to be unit triangular.
+*
+*              DIAG = 'N' or 'n'   A is not assumed to be unit
+*                                  triangular.
+*
+*           Unchanged on exit.
+*
+*  N      - INTEGER.
+*           On entry, N specifies the order of the matrix A.
+*           N must be at least zero.
+*           Unchanged on exit.
+*
+*  AP     - DOUBLE PRECISION array of DIMENSION at least
+*           ( ( n*( n + 1 ) )/2 ).
+*           Before entry with  UPLO = 'U' or 'u', the array AP must
+*           contain the upper triangular matrix packed sequentially,
+*           column by column, so that AP( 1 ) contains a( 1, 1 ),
+*           AP( 2 ) and AP( 3 ) contain a( 1, 2 ) and a( 2, 2 )
+*           respectively, and so on.
+*           Before entry with UPLO = 'L' or 'l', the array AP must
+*           contain the lower triangular matrix packed sequentially,
+*           column by column, so that AP( 1 ) contains a( 1, 1 ),
+*           AP( 2 ) and AP( 3 ) contain a( 2, 1 ) and a( 3, 1 )
+*           respectively, and so on.
+*           Note that when  DIAG = 'U' or 'u', the diagonal elements of
+*           A are not referenced, but are assumed to be unity.
+*           Unchanged on exit.
+*
+*  X      - DOUBLE PRECISION array of dimension at least
+*           ( 1 + ( n - 1 )*abs( INCX ) ).
+*           Before entry, the incremented array X must contain the n
+*           element right-hand side vector b. On exit, X is overwritten
+*           with the solution vector x.
+*
+*  INCX   - INTEGER.
+*           On entry, INCX specifies the increment for the elements of
+*           X. INCX must not be zero.
+*           Unchanged on exit.
+*
+*
+*  Level 2 Blas routine.
+*
+*  -- Written on 22-October-1986.
+*     Jack Dongarra, Argonne National Lab.
+*     Jeremy Du Croz, Nag Central Office.
+*     Sven Hammarling, Nag Central Office.
+*     Richard Hanson, Sandia National Labs.
+*
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO
+      PARAMETER        ( ZERO = 0.0D+0 )
+*     .. Local Scalars ..
+      DOUBLE PRECISION   TEMP
+      INTEGER            I, INFO, IX, J, JX, K, KK, KX
+      LOGICAL            NOUNIT
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF     ( .NOT.LSAME( UPLO , 'U' ).AND.
+     $         .NOT.LSAME( UPLO , 'L' )      )THEN
+         INFO = 1
+      ELSE IF( .NOT.LSAME( TRANS, 'N' ).AND.
+     $         .NOT.LSAME( TRANS, 'T' ).AND.
+     $         .NOT.LSAME( TRANS, 'C' )      )THEN
+         INFO = 2
+      ELSE IF( .NOT.LSAME( DIAG , 'U' ).AND.
+     $         .NOT.LSAME( DIAG , 'N' )      )THEN
+         INFO = 3
+      ELSE IF( N.LT.0 )THEN
+         INFO = 4
+      ELSE IF( INCX.EQ.0 )THEN
+         INFO = 7
+      END IF
+      IF( INFO.NE.0 )THEN
+         CALL XERBLA( 'DTPSV ', INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF( N.EQ.0 )
+     $   RETURN
+*
+      NOUNIT = LSAME( DIAG, 'N' )
+*
+*     Set up the start point in X if the increment is not unity. This
+*     will be  ( N - 1 )*INCX  too small for descending loops.
+*
+      IF( INCX.LE.0 )THEN
+         KX = 1 - ( N - 1 )*INCX
+      ELSE IF( INCX.NE.1 )THEN
+         KX = 1
+      END IF
+*
+*     Start the operations. In this version the elements of AP are
+*     accessed sequentially with one pass through AP.
+*
+      IF( LSAME( TRANS, 'N' ) )THEN
+*
+*        Form  x := inv( A )*x.
+*
+         IF( LSAME( UPLO, 'U' ) )THEN
+            KK = ( N*( N + 1 ) )/2
+            IF( INCX.EQ.1 )THEN
+               DO 20, J = N, 1, -1
+                  IF( X( J ).NE.ZERO )THEN
+                     IF( NOUNIT )
+     $                  X( J ) = X( J )/AP( KK )
+                     TEMP = X( J )
+                     K    = KK     - 1
+                     DO 10, I = J - 1, 1, -1
+                        X( I ) = X( I ) - TEMP*AP( K )
+                        K      = K      - 1
+   10                CONTINUE
+                  END IF
+                  KK = KK - J
+   20          CONTINUE
+            ELSE
+               JX = KX + ( N - 1 )*INCX
+               DO 40, J = N, 1, -1
+                  IF( X( JX ).NE.ZERO )THEN
+                     IF( NOUNIT )
+     $                  X( JX ) = X( JX )/AP( KK )
+                     TEMP = X( JX )
+                     IX   = JX
+                     DO 30, K = KK - 1, KK - J + 1, -1
+                        IX      = IX      - INCX
+                        X( IX ) = X( IX ) - TEMP*AP( K )
+   30                CONTINUE
+                  END IF
+                  JX = JX - INCX
+                  KK = KK - J
+   40          CONTINUE
+            END IF
+         ELSE
+            KK = 1
+            IF( INCX.EQ.1 )THEN
+               DO 60, J = 1, N
+                  IF( X( J ).NE.ZERO )THEN
+                     IF( NOUNIT )
+     $                  X( J ) = X( J )/AP( KK )
+                     TEMP = X( J )
+                     K    = KK     + 1
+                     DO 50, I = J + 1, N
+                        X( I ) = X( I ) - TEMP*AP( K )
+                        K      = K      + 1
+   50                CONTINUE
+                  END IF
+                  KK = KK + ( N - J + 1 )
+   60          CONTINUE
+            ELSE
+               JX = KX
+               DO 80, J = 1, N
+                  IF( X( JX ).NE.ZERO )THEN
+                     IF( NOUNIT )
+     $                  X( JX ) = X( JX )/AP( KK )
+                     TEMP = X( JX )
+                     IX   = JX
+                     DO 70, K = KK + 1, KK + N - J
+                        IX      = IX      + INCX
+                        X( IX ) = X( IX ) - TEMP*AP( K )
+   70                CONTINUE
+                  END IF
+                  JX = JX + INCX
+                  KK = KK + ( N - J + 1 )
+   80          CONTINUE
+            END IF
+         END IF
+      ELSE
+*
+*        Form  x := inv( A' )*x.
+*
+         IF( LSAME( UPLO, 'U' ) )THEN
+            KK = 1
+            IF( INCX.EQ.1 )THEN
+               DO 100, J = 1, N
+                  TEMP = X( J )
+                  K    = KK
+                  DO 90, I = 1, J - 1
+                     TEMP = TEMP - AP( K )*X( I )
+                     K    = K    + 1
+   90             CONTINUE
+                  IF( NOUNIT )
+     $               TEMP = TEMP/AP( KK + J - 1 )
+                  X( J ) = TEMP
+                  KK     = KK   + J
+  100          CONTINUE
+            ELSE
+               JX = KX
+               DO 120, J = 1, N
+                  TEMP = X( JX )
+                  IX   = KX
+                  DO 110, K = KK, KK + J - 2
+                     TEMP = TEMP - AP( K )*X( IX )
+                     IX   = IX   + INCX
+  110             CONTINUE
+                  IF( NOUNIT )
+     $               TEMP = TEMP/AP( KK + J - 1 )
+                  X( JX ) = TEMP
+                  JX      = JX   + INCX
+                  KK      = KK   + J
+  120          CONTINUE
+            END IF
+         ELSE
+            KK = ( N*( N + 1 ) )/2
+            IF( INCX.EQ.1 )THEN
+               DO 140, J = N, 1, -1
+                  TEMP = X( J )
+                  K = KK
+                  DO 130, I = N, J + 1, -1
+                     TEMP = TEMP - AP( K )*X( I )
+                     K    = K    - 1
+  130             CONTINUE
+                  IF( NOUNIT )
+     $               TEMP = TEMP/AP( KK - N + J )
+                  X( J ) = TEMP
+                  KK     = KK   - ( N - J + 1 )
+  140          CONTINUE
+            ELSE
+               KX = KX + ( N - 1 )*INCX
+               JX = KX
+               DO 160, J = N, 1, -1
+                  TEMP = X( JX )
+                  IX   = KX
+                  DO 150, K = KK, KK - ( N - ( J + 1 ) ), -1
+                     TEMP = TEMP - AP( K )*X( IX )
+                     IX   = IX   - INCX
+  150             CONTINUE
+                  IF( NOUNIT )
+     $               TEMP = TEMP/AP( KK - N + J )
+                  X( JX ) = TEMP
+                  JX      = JX   - INCX
+                  KK      = KK   - (N - J + 1 )
+  160          CONTINUE
+            END IF
+         END IF
+      END IF
+*
+      RETURN
+*
+*     End of DTPSV .
+*
+      END
diff --git a/src/fortran/blas/dtrmm.f b/src/fortran/blas/dtrmm.f
new file mode 100644
index 0000000..f98da46
--- /dev/null
+++ b/src/fortran/blas/dtrmm.f
@@ -0,0 +1,355 @@
+      SUBROUTINE DTRMM ( SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA,
+     $                   B, LDB )
+*     .. Scalar Arguments ..
+      CHARACTER*1        SIDE, UPLO, TRANSA, DIAG
+      INTEGER            M, N, LDA, LDB
+      DOUBLE PRECISION   ALPHA
+*     .. Array Arguments ..
+      DOUBLE PRECISION   A( LDA, * ), B( LDB, * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  DTRMM  performs one of the matrix-matrix operations
+*
+*     B := alpha*op( A )*B,   or   B := alpha*B*op( A ),
+*
+*  where  alpha  is a scalar,  B  is an m by n matrix,  A  is a unit, or
+*  non-unit,  upper or lower triangular matrix  and  op( A )  is one  of
+*
+*     op( A ) = A   or   op( A ) = A'.
+*
+*  Parameters
+*  ==========
+*
+*  SIDE   - CHARACTER*1.
+*           On entry,  SIDE specifies whether  op( A ) multiplies B from
+*           the left or right as follows:
+*
+*              SIDE = 'L' or 'l'   B := alpha*op( A )*B.
+*
+*              SIDE = 'R' or 'r'   B := alpha*B*op( A ).
+*
+*           Unchanged on exit.
+*
+*  UPLO   - CHARACTER*1.
+*           On entry, UPLO specifies whether the matrix A is an upper or
+*           lower triangular matrix as follows:
+*
+*              UPLO = 'U' or 'u'   A is an upper triangular matrix.
+*
+*              UPLO = 'L' or 'l'   A is a lower triangular matrix.
+*
+*           Unchanged on exit.
+*
+*  TRANSA - CHARACTER*1.
+*           On entry, TRANSA specifies the form of op( A ) to be used in
+*           the matrix multiplication as follows:
+*
+*              TRANSA = 'N' or 'n'   op( A ) = A.
+*
+*              TRANSA = 'T' or 't'   op( A ) = A'.
+*
+*              TRANSA = 'C' or 'c'   op( A ) = A'.
+*
+*           Unchanged on exit.
+*
+*  DIAG   - CHARACTER*1.
+*           On entry, DIAG specifies whether or not A is unit triangular
+*           as follows:
+*
+*              DIAG = 'U' or 'u'   A is assumed to be unit triangular.
+*
+*              DIAG = 'N' or 'n'   A is not assumed to be unit
+*                                  triangular.
+*
+*           Unchanged on exit.
+*
+*  M      - INTEGER.
+*           On entry, M specifies the number of rows of B. M must be at
+*           least zero.
+*           Unchanged on exit.
+*
+*  N      - INTEGER.
+*           On entry, N specifies the number of columns of B.  N must be
+*           at least zero.
+*           Unchanged on exit.
+*
+*  ALPHA  - DOUBLE PRECISION.
+*           On entry,  ALPHA specifies the scalar  alpha. When  alpha is
+*           zero then  A is not referenced and  B need not be set before
+*           entry.
+*           Unchanged on exit.
+*
+*  A      - DOUBLE PRECISION array of DIMENSION ( LDA, k ), where k is m
+*           when  SIDE = 'L' or 'l'  and is  n  when  SIDE = 'R' or 'r'.
+*           Before entry  with  UPLO = 'U' or 'u',  the  leading  k by k
+*           upper triangular part of the array  A must contain the upper
+*           triangular matrix  and the strictly lower triangular part of
+*           A is not referenced.
+*           Before entry  with  UPLO = 'L' or 'l',  the  leading  k by k
+*           lower triangular part of the array  A must contain the lower
+*           triangular matrix  and the strictly upper triangular part of
+*           A is not referenced.
+*           Note that when  DIAG = 'U' or 'u',  the diagonal elements of
+*           A  are not referenced either,  but are assumed to be  unity.
+*           Unchanged on exit.
+*
+*  LDA    - INTEGER.
+*           On entry, LDA specifies the first dimension of A as declared
+*           in the calling (sub) program.  When  SIDE = 'L' or 'l'  then
+*           LDA  must be at least  max( 1, m ),  when  SIDE = 'R' or 'r'
+*           then LDA must be at least max( 1, n ).
+*           Unchanged on exit.
+*
+*  B      - DOUBLE PRECISION array of DIMENSION ( LDB, n ).
+*           Before entry,  the leading  m by n part of the array  B must
+*           contain the matrix  B,  and  on exit  is overwritten  by the
+*           transformed matrix.
+*
+*  LDB    - INTEGER.
+*           On entry, LDB specifies the first dimension of B as declared
+*           in  the  calling  (sub)  program.   LDB  must  be  at  least
+*           max( 1, m ).
+*           Unchanged on exit.
+*
+*
+*  Level 3 Blas routine.
+*
+*  -- Written on 8-February-1989.
+*     Jack Dongarra, Argonne National Laboratory.
+*     Iain Duff, AERE Harwell.
+*     Jeremy Du Croz, Numerical Algorithms Group Ltd.
+*     Sven Hammarling, Numerical Algorithms Group Ltd.
+*
+*
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     .. Local Scalars ..
+      LOGICAL            LSIDE, NOUNIT, UPPER
+      INTEGER            I, INFO, J, K, NROWA
+      DOUBLE PRECISION   TEMP
+*     .. Parameters ..
+      DOUBLE PRECISION   ONE         , ZERO
+      PARAMETER        ( ONE = 1.0D+0, ZERO = 0.0D+0 )
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      LSIDE  = LSAME( SIDE  , 'L' )
+      IF( LSIDE )THEN
+         NROWA = M
+      ELSE
+         NROWA = N
+      END IF
+      NOUNIT = LSAME( DIAG  , 'N' )
+      UPPER  = LSAME( UPLO  , 'U' )
+*
+      INFO   = 0
+      IF(      ( .NOT.LSIDE                ).AND.
+     $         ( .NOT.LSAME( SIDE  , 'R' ) )      )THEN
+         INFO = 1
+      ELSE IF( ( .NOT.UPPER                ).AND.
+     $         ( .NOT.LSAME( UPLO  , 'L' ) )      )THEN
+         INFO = 2
+      ELSE IF( ( .NOT.LSAME( TRANSA, 'N' ) ).AND.
+     $         ( .NOT.LSAME( TRANSA, 'T' ) ).AND.
+     $         ( .NOT.LSAME( TRANSA, 'C' ) )      )THEN
+         INFO = 3
+      ELSE IF( ( .NOT.LSAME( DIAG  , 'U' ) ).AND.
+     $         ( .NOT.LSAME( DIAG  , 'N' ) )      )THEN
+         INFO = 4
+      ELSE IF( M  .LT.0               )THEN
+         INFO = 5
+      ELSE IF( N  .LT.0               )THEN
+         INFO = 6
+      ELSE IF( LDA.LT.MAX( 1, NROWA ) )THEN
+         INFO = 9
+      ELSE IF( LDB.LT.MAX( 1, M     ) )THEN
+         INFO = 11
+      END IF
+      IF( INFO.NE.0 )THEN
+         CALL XERBLA( 'DTRMM ', INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF( N.EQ.0 )
+     $   RETURN
+*
+*     And when  alpha.eq.zero.
+*
+      IF( ALPHA.EQ.ZERO )THEN
+         DO 20, J = 1, N
+            DO 10, I = 1, M
+               B( I, J ) = ZERO
+   10       CONTINUE
+   20    CONTINUE
+         RETURN
+      END IF
+*
+*     Start the operations.
+*
+      IF( LSIDE )THEN
+         IF( LSAME( TRANSA, 'N' ) )THEN
+*
+*           Form  B := alpha*A*B.
+*
+            IF( UPPER )THEN
+               DO 50, J = 1, N
+                  DO 40, K = 1, M
+                     IF( B( K, J ).NE.ZERO )THEN
+                        TEMP = ALPHA*B( K, J )
+                        DO 30, I = 1, K - 1
+                           B( I, J ) = B( I, J ) + TEMP*A( I, K )
+   30                   CONTINUE
+                        IF( NOUNIT )
+     $                     TEMP = TEMP*A( K, K )
+                        B( K, J ) = TEMP
+                     END IF
+   40             CONTINUE
+   50          CONTINUE
+            ELSE
+               DO 80, J = 1, N
+                  DO 70 K = M, 1, -1
+                     IF( B( K, J ).NE.ZERO )THEN
+                        TEMP      = ALPHA*B( K, J )
+                        B( K, J ) = TEMP
+                        IF( NOUNIT )
+     $                     B( K, J ) = B( K, J )*A( K, K )
+                        DO 60, I = K + 1, M
+                           B( I, J ) = B( I, J ) + TEMP*A( I, K )
+   60                   CONTINUE
+                     END IF
+   70             CONTINUE
+   80          CONTINUE
+            END IF
+         ELSE
+*
+*           Form  B := alpha*B*A'.
+*
+            IF( UPPER )THEN
+               DO 110, J = 1, N
+                  DO 100, I = M, 1, -1
+                     TEMP = B( I, J )
+                     IF( NOUNIT )
+     $                  TEMP = TEMP*A( I, I )
+                     DO 90, K = 1, I - 1
+                        TEMP = TEMP + A( K, I )*B( K, J )
+   90                CONTINUE
+                     B( I, J ) = ALPHA*TEMP
+  100             CONTINUE
+  110          CONTINUE
+            ELSE
+               DO 140, J = 1, N
+                  DO 130, I = 1, M
+                     TEMP = B( I, J )
+                     IF( NOUNIT )
+     $                  TEMP = TEMP*A( I, I )
+                     DO 120, K = I + 1, M
+                        TEMP = TEMP + A( K, I )*B( K, J )
+  120                CONTINUE
+                     B( I, J ) = ALPHA*TEMP
+  130             CONTINUE
+  140          CONTINUE
+            END IF
+         END IF
+      ELSE
+         IF( LSAME( TRANSA, 'N' ) )THEN
+*
+*           Form  B := alpha*B*A.
+*
+            IF( UPPER )THEN
+               DO 180, J = N, 1, -1
+                  TEMP = ALPHA
+                  IF( NOUNIT )
+     $               TEMP = TEMP*A( J, J )
+                  DO 150, I = 1, M
+                     B( I, J ) = TEMP*B( I, J )
+  150             CONTINUE
+                  DO 170, K = 1, J - 1
+                     IF( A( K, J ).NE.ZERO )THEN
+                        TEMP = ALPHA*A( K, J )
+                        DO 160, I = 1, M
+                           B( I, J ) = B( I, J ) + TEMP*B( I, K )
+  160                   CONTINUE
+                     END IF
+  170             CONTINUE
+  180          CONTINUE
+            ELSE
+               DO 220, J = 1, N
+                  TEMP = ALPHA
+                  IF( NOUNIT )
+     $               TEMP = TEMP*A( J, J )
+                  DO 190, I = 1, M
+                     B( I, J ) = TEMP*B( I, J )
+  190             CONTINUE
+                  DO 210, K = J + 1, N
+                     IF( A( K, J ).NE.ZERO )THEN
+                        TEMP = ALPHA*A( K, J )
+                        DO 200, I = 1, M
+                           B( I, J ) = B( I, J ) + TEMP*B( I, K )
+  200                   CONTINUE
+                     END IF
+  210             CONTINUE
+  220          CONTINUE
+            END IF
+         ELSE
+*
+*           Form  B := alpha*B*A'.
+*
+            IF( UPPER )THEN
+               DO 260, K = 1, N
+                  DO 240, J = 1, K - 1
+                     IF( A( J, K ).NE.ZERO )THEN
+                        TEMP = ALPHA*A( J, K )
+                        DO 230, I = 1, M
+                           B( I, J ) = B( I, J ) + TEMP*B( I, K )
+  230                   CONTINUE
+                     END IF
+  240             CONTINUE
+                  TEMP = ALPHA
+                  IF( NOUNIT )
+     $               TEMP = TEMP*A( K, K )
+                  IF( TEMP.NE.ONE )THEN
+                     DO 250, I = 1, M
+                        B( I, K ) = TEMP*B( I, K )
+  250                CONTINUE
+                  END IF
+  260          CONTINUE
+            ELSE
+               DO 300, K = N, 1, -1
+                  DO 280, J = K + 1, N
+                     IF( A( J, K ).NE.ZERO )THEN
+                        TEMP = ALPHA*A( J, K )
+                        DO 270, I = 1, M
+                           B( I, J ) = B( I, J ) + TEMP*B( I, K )
+  270                   CONTINUE
+                     END IF
+  280             CONTINUE
+                  TEMP = ALPHA
+                  IF( NOUNIT )
+     $               TEMP = TEMP*A( K, K )
+                  IF( TEMP.NE.ONE )THEN
+                     DO 290, I = 1, M
+                        B( I, K ) = TEMP*B( I, K )
+  290                CONTINUE
+                  END IF
+  300          CONTINUE
+            END IF
+         END IF
+      END IF
+*
+      RETURN
+*
+*     End of DTRMM .
+*
+      END
diff --git a/src/fortran/blas/dtrmv.f b/src/fortran/blas/dtrmv.f
new file mode 100644
index 0000000..3d5c61b
--- /dev/null
+++ b/src/fortran/blas/dtrmv.f
@@ -0,0 +1,286 @@
+      SUBROUTINE DTRMV ( UPLO, TRANS, DIAG, N, A, LDA, X, INCX )
+*     .. Scalar Arguments ..
+      INTEGER            INCX, LDA, N
+      CHARACTER*1        DIAG, TRANS, UPLO
+*     .. Array Arguments ..
+      DOUBLE PRECISION   A( LDA, * ), X( * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  DTRMV  performs one of the matrix-vector operations
+*
+*     x := A*x,   or   x := A'*x,
+*
+*  where x is an n element vector and  A is an n by n unit, or non-unit,
+*  upper or lower triangular matrix.
+*
+*  Parameters
+*  ==========
+*
+*  UPLO   - CHARACTER*1.
+*           On entry, UPLO specifies whether the matrix is an upper or
+*           lower triangular matrix as follows:
+*
+*              UPLO = 'U' or 'u'   A is an upper triangular matrix.
+*
+*              UPLO = 'L' or 'l'   A is a lower triangular matrix.
+*
+*           Unchanged on exit.
+*
+*  TRANS  - CHARACTER*1.
+*           On entry, TRANS specifies the operation to be performed as
+*           follows:
+*
+*              TRANS = 'N' or 'n'   x := A*x.
+*
+*              TRANS = 'T' or 't'   x := A'*x.
+*
+*              TRANS = 'C' or 'c'   x := A'*x.
+*
+*           Unchanged on exit.
+*
+*  DIAG   - CHARACTER*1.
+*           On entry, DIAG specifies whether or not A is unit
+*           triangular as follows:
+*
+*              DIAG = 'U' or 'u'   A is assumed to be unit triangular.
+*
+*              DIAG = 'N' or 'n'   A is not assumed to be unit
+*                                  triangular.
+*
+*           Unchanged on exit.
+*
+*  N      - INTEGER.
+*           On entry, N specifies the order of the matrix A.
+*           N must be at least zero.
+*           Unchanged on exit.
+*
+*  A      - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+*           Before entry with  UPLO = 'U' or 'u', the leading n by n
+*           upper triangular part of the array A must contain the upper
+*           triangular matrix and the strictly lower triangular part of
+*           A is not referenced.
+*           Before entry with UPLO = 'L' or 'l', the leading n by n
+*           lower triangular part of the array A must contain the lower
+*           triangular matrix and the strictly upper triangular part of
+*           A is not referenced.
+*           Note that when  DIAG = 'U' or 'u', the diagonal elements of
+*           A are not referenced either, but are assumed to be unity.
+*           Unchanged on exit.
+*
+*  LDA    - INTEGER.
+*           On entry, LDA specifies the first dimension of A as declared
+*           in the calling (sub) program. LDA must be at least
+*           max( 1, n ).
+*           Unchanged on exit.
+*
+*  X      - DOUBLE PRECISION array of dimension at least
+*           ( 1 + ( n - 1 )*abs( INCX ) ).
+*           Before entry, the incremented array X must contain the n
+*           element vector x. On exit, X is overwritten with the
+*           tranformed vector x.
+*
+*  INCX   - INTEGER.
+*           On entry, INCX specifies the increment for the elements of
+*           X. INCX must not be zero.
+*           Unchanged on exit.
+*
+*
+*  Level 2 Blas routine.
+*
+*  -- Written on 22-October-1986.
+*     Jack Dongarra, Argonne National Lab.
+*     Jeremy Du Croz, Nag Central Office.
+*     Sven Hammarling, Nag Central Office.
+*     Richard Hanson, Sandia National Labs.
+*
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO
+      PARAMETER        ( ZERO = 0.0D+0 )
+*     .. Local Scalars ..
+      DOUBLE PRECISION   TEMP
+      INTEGER            I, INFO, IX, J, JX, KX
+      LOGICAL            NOUNIT
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF     ( .NOT.LSAME( UPLO , 'U' ).AND.
+     $         .NOT.LSAME( UPLO , 'L' )      )THEN
+         INFO = 1
+      ELSE IF( .NOT.LSAME( TRANS, 'N' ).AND.
+     $         .NOT.LSAME( TRANS, 'T' ).AND.
+     $         .NOT.LSAME( TRANS, 'C' )      )THEN
+         INFO = 2
+      ELSE IF( .NOT.LSAME( DIAG , 'U' ).AND.
+     $         .NOT.LSAME( DIAG , 'N' )      )THEN
+         INFO = 3
+      ELSE IF( N.LT.0 )THEN
+         INFO = 4
+      ELSE IF( LDA.LT.MAX( 1, N ) )THEN
+         INFO = 6
+      ELSE IF( INCX.EQ.0 )THEN
+         INFO = 8
+      END IF
+      IF( INFO.NE.0 )THEN
+         CALL XERBLA( 'DTRMV ', INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF( N.EQ.0 )
+     $   RETURN
+*
+      NOUNIT = LSAME( DIAG, 'N' )
+*
+*     Set up the start point in X if the increment is not unity. This
+*     will be  ( N - 1 )*INCX  too small for descending loops.
+*
+      IF( INCX.LE.0 )THEN
+         KX = 1 - ( N - 1 )*INCX
+      ELSE IF( INCX.NE.1 )THEN
+         KX = 1
+      END IF
+*
+*     Start the operations. In this version the elements of A are
+*     accessed sequentially with one pass through A.
+*
+      IF( LSAME( TRANS, 'N' ) )THEN
+*
+*        Form  x := A*x.
+*
+         IF( LSAME( UPLO, 'U' ) )THEN
+            IF( INCX.EQ.1 )THEN
+               DO 20, J = 1, N
+                  IF( X( J ).NE.ZERO )THEN
+                     TEMP = X( J )
+                     DO 10, I = 1, J - 1
+                        X( I ) = X( I ) + TEMP*A( I, J )
+   10                CONTINUE
+                     IF( NOUNIT )
+     $                  X( J ) = X( J )*A( J, J )
+                  END IF
+   20          CONTINUE
+            ELSE
+               JX = KX
+               DO 40, J = 1, N
+                  IF( X( JX ).NE.ZERO )THEN
+                     TEMP = X( JX )
+                     IX   = KX
+                     DO 30, I = 1, J - 1
+                        X( IX ) = X( IX ) + TEMP*A( I, J )
+                        IX      = IX      + INCX
+   30                CONTINUE
+                     IF( NOUNIT )
+     $                  X( JX ) = X( JX )*A( J, J )
+                  END IF
+                  JX = JX + INCX
+   40          CONTINUE
+            END IF
+         ELSE
+            IF( INCX.EQ.1 )THEN
+               DO 60, J = N, 1, -1
+                  IF( X( J ).NE.ZERO )THEN
+                     TEMP = X( J )
+                     DO 50, I = N, J + 1, -1
+                        X( I ) = X( I ) + TEMP*A( I, J )
+   50                CONTINUE
+                     IF( NOUNIT )
+     $                  X( J ) = X( J )*A( J, J )
+                  END IF
+   60          CONTINUE
+            ELSE
+               KX = KX + ( N - 1 )*INCX
+               JX = KX
+               DO 80, J = N, 1, -1
+                  IF( X( JX ).NE.ZERO )THEN
+                     TEMP = X( JX )
+                     IX   = KX
+                     DO 70, I = N, J + 1, -1
+                        X( IX ) = X( IX ) + TEMP*A( I, J )
+                        IX      = IX      - INCX
+   70                CONTINUE
+                     IF( NOUNIT )
+     $                  X( JX ) = X( JX )*A( J, J )
+                  END IF
+                  JX = JX - INCX
+   80          CONTINUE
+            END IF
+         END IF
+      ELSE
+*
+*        Form  x := A'*x.
+*
+         IF( LSAME( UPLO, 'U' ) )THEN
+            IF( INCX.EQ.1 )THEN
+               DO 100, J = N, 1, -1
+                  TEMP = X( J )
+                  IF( NOUNIT )
+     $               TEMP = TEMP*A( J, J )
+                  DO 90, I = J - 1, 1, -1
+                     TEMP = TEMP + A( I, J )*X( I )
+   90             CONTINUE
+                  X( J ) = TEMP
+  100          CONTINUE
+            ELSE
+               JX = KX + ( N - 1 )*INCX
+               DO 120, J = N, 1, -1
+                  TEMP = X( JX )
+                  IX   = JX
+                  IF( NOUNIT )
+     $               TEMP = TEMP*A( J, J )
+                  DO 110, I = J - 1, 1, -1
+                     IX   = IX   - INCX
+                     TEMP = TEMP + A( I, J )*X( IX )
+  110             CONTINUE
+                  X( JX ) = TEMP
+                  JX      = JX   - INCX
+  120          CONTINUE
+            END IF
+         ELSE
+            IF( INCX.EQ.1 )THEN
+               DO 140, J = 1, N
+                  TEMP = X( J )
+                  IF( NOUNIT )
+     $               TEMP = TEMP*A( J, J )
+                  DO 130, I = J + 1, N
+                     TEMP = TEMP + A( I, J )*X( I )
+  130             CONTINUE
+                  X( J ) = TEMP
+  140          CONTINUE
+            ELSE
+               JX = KX
+               DO 160, J = 1, N
+                  TEMP = X( JX )
+                  IX   = JX
+                  IF( NOUNIT )
+     $               TEMP = TEMP*A( J, J )
+                  DO 150, I = J + 1, N
+                     IX   = IX   + INCX
+                     TEMP = TEMP + A( I, J )*X( IX )
+  150             CONTINUE
+                  X( JX ) = TEMP
+                  JX      = JX   + INCX
+  160          CONTINUE
+            END IF
+         END IF
+      END IF
+*
+      RETURN
+*
+*     End of DTRMV .
+*
+      END
diff --git a/src/fortran/blas/dtrsm.f b/src/fortran/blas/dtrsm.f
new file mode 100644
index 0000000..e842514
--- /dev/null
+++ b/src/fortran/blas/dtrsm.f
@@ -0,0 +1,378 @@
+      SUBROUTINE DTRSM ( SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA,
+     $                   B, LDB )
+*     .. Scalar Arguments ..
+      CHARACTER*1        SIDE, UPLO, TRANSA, DIAG
+      INTEGER            M, N, LDA, LDB
+      DOUBLE PRECISION   ALPHA
+*     .. Array Arguments ..
+      DOUBLE PRECISION   A( LDA, * ), B( LDB, * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  DTRSM  solves one of the matrix equations
+*
+*     op( A )*X = alpha*B,   or   X*op( A ) = alpha*B,
+*
+*  where alpha is a scalar, X and B are m by n matrices, A is a unit, or
+*  non-unit,  upper or lower triangular matrix  and  op( A )  is one  of
+*
+*     op( A ) = A   or   op( A ) = A'.
+*
+*  The matrix X is overwritten on B.
+*
+*  Parameters
+*  ==========
+*
+*  SIDE   - CHARACTER*1.
+*           On entry, SIDE specifies whether op( A ) appears on the left
+*           or right of X as follows:
+*
+*              SIDE = 'L' or 'l'   op( A )*X = alpha*B.
+*
+*              SIDE = 'R' or 'r'   X*op( A ) = alpha*B.
+*
+*           Unchanged on exit.
+*
+*  UPLO   - CHARACTER*1.
+*           On entry, UPLO specifies whether the matrix A is an upper or
+*           lower triangular matrix as follows:
+*
+*              UPLO = 'U' or 'u'   A is an upper triangular matrix.
+*
+*              UPLO = 'L' or 'l'   A is a lower triangular matrix.
+*
+*           Unchanged on exit.
+*
+*  TRANSA - CHARACTER*1.
+*           On entry, TRANSA specifies the form of op( A ) to be used in
+*           the matrix multiplication as follows:
+*
+*              TRANSA = 'N' or 'n'   op( A ) = A.
+*
+*              TRANSA = 'T' or 't'   op( A ) = A'.
+*
+*              TRANSA = 'C' or 'c'   op( A ) = A'.
+*
+*           Unchanged on exit.
+*
+*  DIAG   - CHARACTER*1.
+*           On entry, DIAG specifies whether or not A is unit triangular
+*           as follows:
+*
+*              DIAG = 'U' or 'u'   A is assumed to be unit triangular.
+*
+*              DIAG = 'N' or 'n'   A is not assumed to be unit
+*                                  triangular.
+*
+*           Unchanged on exit.
+*
+*  M      - INTEGER.
+*           On entry, M specifies the number of rows of B. M must be at
+*           least zero.
+*           Unchanged on exit.
+*
+*  N      - INTEGER.
+*           On entry, N specifies the number of columns of B.  N must be
+*           at least zero.
+*           Unchanged on exit.
+*
+*  ALPHA  - DOUBLE PRECISION.
+*           On entry,  ALPHA specifies the scalar  alpha. When  alpha is
+*           zero then  A is not referenced and  B need not be set before
+*           entry.
+*           Unchanged on exit.
+*
+*  A      - DOUBLE PRECISION array of DIMENSION ( LDA, k ), where k is m
+*           when  SIDE = 'L' or 'l'  and is  n  when  SIDE = 'R' or 'r'.
+*           Before entry  with  UPLO = 'U' or 'u',  the  leading  k by k
+*           upper triangular part of the array  A must contain the upper
+*           triangular matrix  and the strictly lower triangular part of
+*           A is not referenced.
+*           Before entry  with  UPLO = 'L' or 'l',  the  leading  k by k
+*           lower triangular part of the array  A must contain the lower
+*           triangular matrix  and the strictly upper triangular part of
+*           A is not referenced.
+*           Note that when  DIAG = 'U' or 'u',  the diagonal elements of
+*           A  are not referenced either,  but are assumed to be  unity.
+*           Unchanged on exit.
+*
+*  LDA    - INTEGER.
+*           On entry, LDA specifies the first dimension of A as declared
+*           in the calling (sub) program.  When  SIDE = 'L' or 'l'  then
+*           LDA  must be at least  max( 1, m ),  when  SIDE = 'R' or 'r'
+*           then LDA must be at least max( 1, n ).
+*           Unchanged on exit.
+*
+*  B      - DOUBLE PRECISION array of DIMENSION ( LDB, n ).
+*           Before entry,  the leading  m by n part of the array  B must
+*           contain  the  right-hand  side  matrix  B,  and  on exit  is
+*           overwritten by the solution matrix  X.
+*
+*  LDB    - INTEGER.
+*           On entry, LDB specifies the first dimension of B as declared
+*           in  the  calling  (sub)  program.   LDB  must  be  at  least
+*           max( 1, m ).
+*           Unchanged on exit.
+*
+*
+*  Level 3 Blas routine.
+*
+*
+*  -- Written on 8-February-1989.
+*     Jack Dongarra, Argonne National Laboratory.
+*     Iain Duff, AERE Harwell.
+*     Jeremy Du Croz, Numerical Algorithms Group Ltd.
+*     Sven Hammarling, Numerical Algorithms Group Ltd.
+*
+*
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     .. Local Scalars ..
+      LOGICAL            LSIDE, NOUNIT, UPPER
+      INTEGER            I, INFO, J, K, NROWA
+      DOUBLE PRECISION   TEMP
+*     .. Parameters ..
+      DOUBLE PRECISION   ONE         , ZERO
+      PARAMETER        ( ONE = 1.0D+0, ZERO = 0.0D+0 )
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      LSIDE  = LSAME( SIDE  , 'L' )
+      IF( LSIDE )THEN
+         NROWA = M
+      ELSE
+         NROWA = N
+      END IF
+      NOUNIT = LSAME( DIAG  , 'N' )
+      UPPER  = LSAME( UPLO  , 'U' )
+*
+      INFO   = 0
+      IF(      ( .NOT.LSIDE                ).AND.
+     $         ( .NOT.LSAME( SIDE  , 'R' ) )      )THEN
+         INFO = 1
+      ELSE IF( ( .NOT.UPPER                ).AND.
+     $         ( .NOT.LSAME( UPLO  , 'L' ) )      )THEN
+         INFO = 2
+      ELSE IF( ( .NOT.LSAME( TRANSA, 'N' ) ).AND.
+     $         ( .NOT.LSAME( TRANSA, 'T' ) ).AND.
+     $         ( .NOT.LSAME( TRANSA, 'C' ) )      )THEN
+         INFO = 3
+      ELSE IF( ( .NOT.LSAME( DIAG  , 'U' ) ).AND.
+     $         ( .NOT.LSAME( DIAG  , 'N' ) )      )THEN
+         INFO = 4
+      ELSE IF( M  .LT.0               )THEN
+         INFO = 5
+      ELSE IF( N  .LT.0               )THEN
+         INFO = 6
+      ELSE IF( LDA.LT.MAX( 1, NROWA ) )THEN
+         INFO = 9
+      ELSE IF( LDB.LT.MAX( 1, M     ) )THEN
+         INFO = 11
+      END IF
+      IF( INFO.NE.0 )THEN
+         CALL XERBLA( 'DTRSM ', INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF( N.EQ.0 )
+     $   RETURN
+*
+*     And when  alpha.eq.zero.
+*
+      IF( ALPHA.EQ.ZERO )THEN
+         DO 20, J = 1, N
+            DO 10, I = 1, M
+               B( I, J ) = ZERO
+   10       CONTINUE
+   20    CONTINUE
+         RETURN
+      END IF
+*
+*     Start the operations.
+*
+      IF( LSIDE )THEN
+         IF( LSAME( TRANSA, 'N' ) )THEN
+*
+*           Form  B := alpha*inv( A )*B.
+*
+            IF( UPPER )THEN
+               DO 60, J = 1, N
+                  IF( ALPHA.NE.ONE )THEN
+                     DO 30, I = 1, M
+                        B( I, J ) = ALPHA*B( I, J )
+   30                CONTINUE
+                  END IF
+                  DO 50, K = M, 1, -1
+                     IF( B( K, J ).NE.ZERO )THEN
+                        IF( NOUNIT )
+     $                     B( K, J ) = B( K, J )/A( K, K )
+                        DO 40, I = 1, K - 1
+                           B( I, J ) = B( I, J ) - B( K, J )*A( I, K )
+   40                   CONTINUE
+                     END IF
+   50             CONTINUE
+   60          CONTINUE
+            ELSE
+               DO 100, J = 1, N
+                  IF( ALPHA.NE.ONE )THEN
+                     DO 70, I = 1, M
+                        B( I, J ) = ALPHA*B( I, J )
+   70                CONTINUE
+                  END IF
+                  DO 90 K = 1, M
+                     IF( B( K, J ).NE.ZERO )THEN
+                        IF( NOUNIT )
+     $                     B( K, J ) = B( K, J )/A( K, K )
+                        DO 80, I = K + 1, M
+                           B( I, J ) = B( I, J ) - B( K, J )*A( I, K )
+   80                   CONTINUE
+                     END IF
+   90             CONTINUE
+  100          CONTINUE
+            END IF
+         ELSE
+*
+*           Form  B := alpha*inv( A' )*B.
+*
+            IF( UPPER )THEN
+               DO 130, J = 1, N
+                  DO 120, I = 1, M
+                     TEMP = ALPHA*B( I, J )
+                     DO 110, K = 1, I - 1
+                        TEMP = TEMP - A( K, I )*B( K, J )
+  110                CONTINUE
+                     IF( NOUNIT )
+     $                  TEMP = TEMP/A( I, I )
+                     B( I, J ) = TEMP
+  120             CONTINUE
+  130          CONTINUE
+            ELSE
+               DO 160, J = 1, N
+                  DO 150, I = M, 1, -1
+                     TEMP = ALPHA*B( I, J )
+                     DO 140, K = I + 1, M
+                        TEMP = TEMP - A( K, I )*B( K, J )
+  140                CONTINUE
+                     IF( NOUNIT )
+     $                  TEMP = TEMP/A( I, I )
+                     B( I, J ) = TEMP
+  150             CONTINUE
+  160          CONTINUE
+            END IF
+         END IF
+      ELSE
+         IF( LSAME( TRANSA, 'N' ) )THEN
+*
+*           Form  B := alpha*B*inv( A ).
+*
+            IF( UPPER )THEN
+               DO 210, J = 1, N
+                  IF( ALPHA.NE.ONE )THEN
+                     DO 170, I = 1, M
+                        B( I, J ) = ALPHA*B( I, J )
+  170                CONTINUE
+                  END IF
+                  DO 190, K = 1, J - 1
+                     IF( A( K, J ).NE.ZERO )THEN
+                        DO 180, I = 1, M
+                           B( I, J ) = B( I, J ) - A( K, J )*B( I, K )
+  180                   CONTINUE
+                     END IF
+  190             CONTINUE
+                  IF( NOUNIT )THEN
+                     TEMP = ONE/A( J, J )
+                     DO 200, I = 1, M
+                        B( I, J ) = TEMP*B( I, J )
+  200                CONTINUE
+                  END IF
+  210          CONTINUE
+            ELSE
+               DO 260, J = N, 1, -1
+                  IF( ALPHA.NE.ONE )THEN
+                     DO 220, I = 1, M
+                        B( I, J ) = ALPHA*B( I, J )
+  220                CONTINUE
+                  END IF
+                  DO 240, K = J + 1, N
+                     IF( A( K, J ).NE.ZERO )THEN
+                        DO 230, I = 1, M
+                           B( I, J ) = B( I, J ) - A( K, J )*B( I, K )
+  230                   CONTINUE
+                     END IF
+  240             CONTINUE
+                  IF( NOUNIT )THEN
+                     TEMP = ONE/A( J, J )
+                     DO 250, I = 1, M
+                       B( I, J ) = TEMP*B( I, J )
+  250                CONTINUE
+                  END IF
+  260          CONTINUE
+            END IF
+         ELSE
+*
+*           Form  B := alpha*B*inv( A' ).
+*
+            IF( UPPER )THEN
+               DO 310, K = N, 1, -1
+                  IF( NOUNIT )THEN
+                     TEMP = ONE/A( K, K )
+                     DO 270, I = 1, M
+                        B( I, K ) = TEMP*B( I, K )
+  270                CONTINUE
+                  END IF
+                  DO 290, J = 1, K - 1
+                     IF( A( J, K ).NE.ZERO )THEN
+                        TEMP = A( J, K )
+                        DO 280, I = 1, M
+                           B( I, J ) = B( I, J ) - TEMP*B( I, K )
+  280                   CONTINUE
+                     END IF
+  290             CONTINUE
+                  IF( ALPHA.NE.ONE )THEN
+                     DO 300, I = 1, M
+                        B( I, K ) = ALPHA*B( I, K )
+  300                CONTINUE
+                  END IF
+  310          CONTINUE
+            ELSE
+               DO 360, K = 1, N
+                  IF( NOUNIT )THEN
+                     TEMP = ONE/A( K, K )
+                     DO 320, I = 1, M
+                        B( I, K ) = TEMP*B( I, K )
+  320                CONTINUE
+                  END IF
+                  DO 340, J = K + 1, N
+                     IF( A( J, K ).NE.ZERO )THEN
+                        TEMP = A( J, K )
+                        DO 330, I = 1, M
+                           B( I, J ) = B( I, J ) - TEMP*B( I, K )
+  330                   CONTINUE
+                     END IF
+  340             CONTINUE
+                  IF( ALPHA.NE.ONE )THEN
+                     DO 350, I = 1, M
+                        B( I, K ) = ALPHA*B( I, K )
+  350                CONTINUE
+                  END IF
+  360          CONTINUE
+            END IF
+         END IF
+      END IF
+*
+      RETURN
+*
+*     End of DTRSM .
+*
+      END
diff --git a/src/fortran/blas/dtrsv.f b/src/fortran/blas/dtrsv.f
new file mode 100644
index 0000000..9c3e90a
--- /dev/null
+++ b/src/fortran/blas/dtrsv.f
@@ -0,0 +1,289 @@
+      SUBROUTINE DTRSV ( UPLO, TRANS, DIAG, N, A, LDA, X, INCX )
+*     .. Scalar Arguments ..
+      INTEGER            INCX, LDA, N
+      CHARACTER*1        DIAG, TRANS, UPLO
+*     .. Array Arguments ..
+      DOUBLE PRECISION   A( LDA, * ), X( * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  DTRSV  solves one of the systems of equations
+*
+*     A*x = b,   or   A'*x = b,
+*
+*  where b and x are n element vectors and A is an n by n unit, or
+*  non-unit, upper or lower triangular matrix.
+*
+*  No test for singularity or near-singularity is included in this
+*  routine. Such tests must be performed before calling this routine.
+*
+*  Parameters
+*  ==========
+*
+*  UPLO   - CHARACTER*1.
+*           On entry, UPLO specifies whether the matrix is an upper or
+*           lower triangular matrix as follows:
+*
+*              UPLO = 'U' or 'u'   A is an upper triangular matrix.
+*
+*              UPLO = 'L' or 'l'   A is a lower triangular matrix.
+*
+*           Unchanged on exit.
+*
+*  TRANS  - CHARACTER*1.
+*           On entry, TRANS specifies the equations to be solved as
+*           follows:
+*
+*              TRANS = 'N' or 'n'   A*x = b.
+*
+*              TRANS = 'T' or 't'   A'*x = b.
+*
+*              TRANS = 'C' or 'c'   A'*x = b.
+*
+*           Unchanged on exit.
+*
+*  DIAG   - CHARACTER*1.
+*           On entry, DIAG specifies whether or not A is unit
+*           triangular as follows:
+*
+*              DIAG = 'U' or 'u'   A is assumed to be unit triangular.
+*
+*              DIAG = 'N' or 'n'   A is not assumed to be unit
+*                                  triangular.
+*
+*           Unchanged on exit.
+*
+*  N      - INTEGER.
+*           On entry, N specifies the order of the matrix A.
+*           N must be at least zero.
+*           Unchanged on exit.
+*
+*  A      - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+*           Before entry with  UPLO = 'U' or 'u', the leading n by n
+*           upper triangular part of the array A must contain the upper
+*           triangular matrix and the strictly lower triangular part of
+*           A is not referenced.
+*           Before entry with UPLO = 'L' or 'l', the leading n by n
+*           lower triangular part of the array A must contain the lower
+*           triangular matrix and the strictly upper triangular part of
+*           A is not referenced.
+*           Note that when  DIAG = 'U' or 'u', the diagonal elements of
+*           A are not referenced either, but are assumed to be unity.
+*           Unchanged on exit.
+*
+*  LDA    - INTEGER.
+*           On entry, LDA specifies the first dimension of A as declared
+*           in the calling (sub) program. LDA must be at least
+*           max( 1, n ).
+*           Unchanged on exit.
+*
+*  X      - DOUBLE PRECISION array of dimension at least
+*           ( 1 + ( n - 1 )*abs( INCX ) ).
+*           Before entry, the incremented array X must contain the n
+*           element right-hand side vector b. On exit, X is overwritten
+*           with the solution vector x.
+*
+*  INCX   - INTEGER.
+*           On entry, INCX specifies the increment for the elements of
+*           X. INCX must not be zero.
+*           Unchanged on exit.
+*
+*
+*  Level 2 Blas routine.
+*
+*  -- Written on 22-October-1986.
+*     Jack Dongarra, Argonne National Lab.
+*     Jeremy Du Croz, Nag Central Office.
+*     Sven Hammarling, Nag Central Office.
+*     Richard Hanson, Sandia National Labs.
+*
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO
+      PARAMETER        ( ZERO = 0.0D+0 )
+*     .. Local Scalars ..
+      DOUBLE PRECISION   TEMP
+      INTEGER            I, INFO, IX, J, JX, KX
+      LOGICAL            NOUNIT
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF     ( .NOT.LSAME( UPLO , 'U' ).AND.
+     $         .NOT.LSAME( UPLO , 'L' )      )THEN
+         INFO = 1
+      ELSE IF( .NOT.LSAME( TRANS, 'N' ).AND.
+     $         .NOT.LSAME( TRANS, 'T' ).AND.
+     $         .NOT.LSAME( TRANS, 'C' )      )THEN
+         INFO = 2
+      ELSE IF( .NOT.LSAME( DIAG , 'U' ).AND.
+     $         .NOT.LSAME( DIAG , 'N' )      )THEN
+         INFO = 3
+      ELSE IF( N.LT.0 )THEN
+         INFO = 4
+      ELSE IF( LDA.LT.MAX( 1, N ) )THEN
+         INFO = 6
+      ELSE IF( INCX.EQ.0 )THEN
+         INFO = 8
+      END IF
+      IF( INFO.NE.0 )THEN
+         CALL XERBLA( 'DTRSV ', INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF( N.EQ.0 )
+     $   RETURN
+*
+      NOUNIT = LSAME( DIAG, 'N' )
+*
+*     Set up the start point in X if the increment is not unity. This
+*     will be  ( N - 1 )*INCX  too small for descending loops.
+*
+      IF( INCX.LE.0 )THEN
+         KX = 1 - ( N - 1 )*INCX
+      ELSE IF( INCX.NE.1 )THEN
+         KX = 1
+      END IF
+*
+*     Start the operations. In this version the elements of A are
+*     accessed sequentially with one pass through A.
+*
+      IF( LSAME( TRANS, 'N' ) )THEN
+*
+*        Form  x := inv( A )*x.
+*
+         IF( LSAME( UPLO, 'U' ) )THEN
+            IF( INCX.EQ.1 )THEN
+               DO 20, J = N, 1, -1
+                  IF( X( J ).NE.ZERO )THEN
+                     IF( NOUNIT )
+     $                  X( J ) = X( J )/A( J, J )
+                     TEMP = X( J )
+                     DO 10, I = J - 1, 1, -1
+                        X( I ) = X( I ) - TEMP*A( I, J )
+   10                CONTINUE
+                  END IF
+   20          CONTINUE
+            ELSE
+               JX = KX + ( N - 1 )*INCX
+               DO 40, J = N, 1, -1
+                  IF( X( JX ).NE.ZERO )THEN
+                     IF( NOUNIT )
+     $                  X( JX ) = X( JX )/A( J, J )
+                     TEMP = X( JX )
+                     IX   = JX
+                     DO 30, I = J - 1, 1, -1
+                        IX      = IX      - INCX
+                        X( IX ) = X( IX ) - TEMP*A( I, J )
+   30                CONTINUE
+                  END IF
+                  JX = JX - INCX
+   40          CONTINUE
+            END IF
+         ELSE
+            IF( INCX.EQ.1 )THEN
+               DO 60, J = 1, N
+                  IF( X( J ).NE.ZERO )THEN
+                     IF( NOUNIT )
+     $                  X( J ) = X( J )/A( J, J )
+                     TEMP = X( J )
+                     DO 50, I = J + 1, N
+                        X( I ) = X( I ) - TEMP*A( I, J )
+   50                CONTINUE
+                  END IF
+   60          CONTINUE
+            ELSE
+               JX = KX
+               DO 80, J = 1, N
+                  IF( X( JX ).NE.ZERO )THEN
+                     IF( NOUNIT )
+     $                  X( JX ) = X( JX )/A( J, J )
+                     TEMP = X( JX )
+                     IX   = JX
+                     DO 70, I = J + 1, N
+                        IX      = IX      + INCX
+                        X( IX ) = X( IX ) - TEMP*A( I, J )
+   70                CONTINUE
+                  END IF
+                  JX = JX + INCX
+   80          CONTINUE
+            END IF
+         END IF
+      ELSE
+*
+*        Form  x := inv( A' )*x.
+*
+         IF( LSAME( UPLO, 'U' ) )THEN
+            IF( INCX.EQ.1 )THEN
+               DO 100, J = 1, N
+                  TEMP = X( J )
+                  DO 90, I = 1, J - 1
+                     TEMP = TEMP - A( I, J )*X( I )
+   90             CONTINUE
+                  IF( NOUNIT )
+     $               TEMP = TEMP/A( J, J )
+                  X( J ) = TEMP
+  100          CONTINUE
+            ELSE
+               JX = KX
+               DO 120, J = 1, N
+                  TEMP = X( JX )
+                  IX   = KX
+                  DO 110, I = 1, J - 1
+                     TEMP = TEMP - A( I, J )*X( IX )
+                     IX   = IX   + INCX
+  110             CONTINUE
+                  IF( NOUNIT )
+     $               TEMP = TEMP/A( J, J )
+                  X( JX ) = TEMP
+                  JX      = JX   + INCX
+  120          CONTINUE
+            END IF
+         ELSE
+            IF( INCX.EQ.1 )THEN
+               DO 140, J = N, 1, -1
+                  TEMP = X( J )
+                  DO 130, I = N, J + 1, -1
+                     TEMP = TEMP - A( I, J )*X( I )
+  130             CONTINUE
+                  IF( NOUNIT )
+     $               TEMP = TEMP/A( J, J )
+                  X( J ) = TEMP
+  140          CONTINUE
+            ELSE
+               KX = KX + ( N - 1 )*INCX
+               JX = KX
+               DO 160, J = N, 1, -1
+                  TEMP = X( JX )
+                  IX   = KX
+                  DO 150, I = N, J + 1, -1
+                     TEMP = TEMP - A( I, J )*X( IX )
+                     IX   = IX   - INCX
+  150             CONTINUE
+                  IF( NOUNIT )
+     $               TEMP = TEMP/A( J, J )
+                  X( JX ) = TEMP
+                  JX      = JX   - INCX
+  160          CONTINUE
+            END IF
+         END IF
+      END IF
+*
+      RETURN
+*
+*     End of DTRSV .
+*
+      END
diff --git a/src/fortran/blas/dzasum.f b/src/fortran/blas/dzasum.f
new file mode 100644
index 0000000..d21c1ff
--- /dev/null
+++ b/src/fortran/blas/dzasum.f
@@ -0,0 +1,34 @@
+      double precision function dzasum(n,zx,incx)
+c
+c     takes the sum of the absolute values.
+c     jack dongarra, 3/11/78.
+c     modified 3/93 to return if incx .le. 0.
+c     modified 12/3/93, array(1) declarations changed to array(*)
+c
+      double complex zx(*)
+      double precision stemp,dcabs1
+      integer i,incx,ix,n
+c
+      dzasum = 0.0d0
+      stemp = 0.0d0
+      if( n.le.0 .or. incx.le.0 )return
+      if(incx.eq.1)go to 20
+c
+c        code for increment not equal to 1
+c
+      ix = 1
+      do 10 i = 1,n
+        stemp = stemp + dcabs1(zx(ix))
+        ix = ix + incx
+   10 continue
+      dzasum = stemp
+      return
+c
+c        code for increment equal to 1
+c
+   20 do 30 i = 1,n
+        stemp = stemp + dcabs1(zx(i))
+   30 continue
+      dzasum = stemp
+      return
+      end
diff --git a/src/fortran/blas/dznrm2.f b/src/fortran/blas/dznrm2.f
new file mode 100644
index 0000000..205ce39
--- /dev/null
+++ b/src/fortran/blas/dznrm2.f
@@ -0,0 +1,67 @@
+      DOUBLE PRECISION FUNCTION DZNRM2( N, X, INCX )
+*     .. Scalar Arguments ..
+      INTEGER                           INCX, N
+*     .. Array Arguments ..
+      COMPLEX*16                        X( * )
+*     ..
+*
+*  DZNRM2 returns the euclidean norm of a vector via the function
+*  name, so that
+*
+*     DZNRM2 := sqrt( conjg( x' )*x )
+*
+*
+*
+*  -- This version written on 25-October-1982.
+*     Modified on 14-October-1993 to inline the call to ZLASSQ.
+*     Sven Hammarling, Nag Ltd.
+*
+*
+*     .. Parameters ..
+      DOUBLE PRECISION      ONE         , ZERO
+      PARAMETER           ( ONE = 1.0D+0, ZERO = 0.0D+0 )
+*     .. Local Scalars ..
+      INTEGER               IX
+      DOUBLE PRECISION      NORM, SCALE, SSQ, TEMP
+*     .. Intrinsic Functions ..
+      INTRINSIC             ABS, DIMAG, DBLE, SQRT
+*     ..
+*     .. Executable Statements ..
+      IF( N.LT.1 .OR. INCX.LT.1 )THEN
+         NORM  = ZERO
+      ELSE
+         SCALE = ZERO
+         SSQ   = ONE
+*        The following loop is equivalent to this call to the LAPACK
+*        auxiliary routine:
+*        CALL ZLASSQ( N, X, INCX, SCALE, SSQ )
+*
+         DO 10, IX = 1, 1 + ( N - 1 )*INCX, INCX
+            IF( DBLE( X( IX ) ).NE.ZERO )THEN
+               TEMP = ABS( DBLE( X( IX ) ) )
+               IF( SCALE.LT.TEMP )THEN
+                  SSQ   = ONE   + SSQ*( SCALE/TEMP )**2
+                  SCALE = TEMP
+               ELSE
+                  SSQ   = SSQ   +     ( TEMP/SCALE )**2
+               END IF
+            END IF
+            IF( DIMAG( X( IX ) ).NE.ZERO )THEN
+               TEMP = ABS( DIMAG( X( IX ) ) )
+               IF( SCALE.LT.TEMP )THEN
+                  SSQ   = ONE   + SSQ*( SCALE/TEMP )**2
+                  SCALE = TEMP
+               ELSE
+                  SSQ   = SSQ   +     ( TEMP/SCALE )**2
+               END IF
+            END IF
+   10    CONTINUE
+         NORM  = SCALE * SQRT( SSQ )
+      END IF
+*
+      DZNRM2 = NORM
+      RETURN
+*
+*     End of DZNRM2.
+*
+      END
diff --git a/src/fortran/blas/idamax.f b/src/fortran/blas/idamax.f
new file mode 100644
index 0000000..59d80dc
--- /dev/null
+++ b/src/fortran/blas/idamax.f
@@ -0,0 +1,39 @@
+      integer function idamax(n,dx,incx)
+c
+c     finds the index of element having max. absolute value.
+c     jack dongarra, linpack, 3/11/78.
+c     modified 3/93 to return if incx .le. 0.
+c     modified 12/3/93, array(1) declarations changed to array(*)
+c
+      double precision dx(*),dmax
+      integer i,incx,ix,n
+c
+      idamax = 0
+      if( n.lt.1 .or. incx.le.0 ) return
+      idamax = 1
+      if(n.eq.1)return
+      if(incx.eq.1)go to 20
+c
+c        code for increment not equal to 1
+c
+      ix = 1
+      dmax = dabs(dx(1))
+      ix = ix + incx
+      do 10 i = 2,n
+         if(dabs(dx(ix)).le.dmax) go to 5
+         idamax = i
+         dmax = dabs(dx(ix))
+    5    ix = ix + incx
+   10 continue
+      return
+c
+c        code for increment equal to 1
+c
+   20 dmax = dabs(dx(1))
+      do 30 i = 2,n
+         if(dabs(dx(i)).le.dmax) go to 30
+         idamax = i
+         dmax = dabs(dx(i))
+   30 continue
+      return
+      end
diff --git a/src/fortran/blas/izamax.f b/src/fortran/blas/izamax.f
new file mode 100644
index 0000000..ec14f82
--- /dev/null
+++ b/src/fortran/blas/izamax.f
@@ -0,0 +1,41 @@
+      integer function izamax(n,zx,incx)
+c
+c     finds the index of element having max. absolute value.
+c     jack dongarra, 1/15/85.
+c     modified 3/93 to return if incx .le. 0.
+c     modified 12/3/93, array(1) declarations changed to array(*)
+c
+      double complex zx(*)
+      double precision smax
+      integer i,incx,ix,n
+      double precision dcabs1
+c
+      izamax = 0
+      if( n.lt.1 .or. incx.le.0 )return
+      izamax = 1
+      if(n.eq.1)return
+      if(incx.eq.1)go to 20
+c
+c        code for increment not equal to 1
+c
+      ix = 1
+      smax = dcabs1(zx(1))
+      ix = ix + incx
+      do 10 i = 2,n
+         if(dcabs1(zx(ix)).le.smax) go to 5
+         izamax = i
+         smax = dcabs1(zx(ix))
+    5    ix = ix + incx
+   10 continue
+      return
+c
+c        code for increment equal to 1
+c
+   20 smax = dcabs1(zx(1))
+      do 30 i = 2,n
+         if(dcabs1(zx(i)).le.smax) go to 30
+         izamax = i
+         smax = dcabs1(zx(i))
+   30 continue
+      return
+      end
diff --git a/src/fortran/blas/license.txt b/src/fortran/blas/license.txt
new file mode 100644
index 0000000..8014a5b
--- /dev/null
+++ b/src/fortran/blas/license.txt
@@ -0,0 +1,6 @@
+This software is in the public domain
+
+
+More information:
+http://www.netlib.org/blas/faq.html#2
+http://packages.debian.org/changelogs/pool/main/b/blas/blas_1.1-14/blas.copyright
\ No newline at end of file
diff --git a/src/fortran/blas/lsame.f b/src/fortran/blas/lsame.f
new file mode 100644
index 0000000..bf25d86
--- /dev/null
+++ b/src/fortran/blas/lsame.f
@@ -0,0 +1,87 @@
+      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/fortran/blas/xerbla.f b/src/fortran/blas/xerbla.f
new file mode 100644
index 0000000..6e11175
--- /dev/null
+++ b/src/fortran/blas/xerbla.f
@@ -0,0 +1,46 @@
+      SUBROUTINE XERBLA( SRNAME, INFO )
+*
+*  -- 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*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/fortran/blas/zaxpy.f b/src/fortran/blas/zaxpy.f
new file mode 100644
index 0000000..4fa3b1e
--- /dev/null
+++ b/src/fortran/blas/zaxpy.f
@@ -0,0 +1,34 @@
+      subroutine zaxpy(n,za,zx,incx,zy,incy)
+c
+c     constant times a vector plus a vector.
+c     jack dongarra, 3/11/78.
+c     modified 12/3/93, array(1) declarations changed to array(*)
+c
+      double complex zx(*),zy(*),za
+      integer i,incx,incy,ix,iy,n
+      double precision dcabs1
+      if(n.le.0)return
+      if (dcabs1(za) .eq. 0.0d0) return
+      if (incx.eq.1.and.incy.eq.1)go to 20
+c
+c        code for unequal increments or equal increments
+c          not equal to 1
+c
+      ix = 1
+      iy = 1
+      if(incx.lt.0)ix = (-n+1)*incx + 1
+      if(incy.lt.0)iy = (-n+1)*incy + 1
+      do 10 i = 1,n
+        zy(iy) = zy(iy) + za*zx(ix)
+        ix = ix + incx
+        iy = iy + incy
+   10 continue
+      return
+c
+c        code for both increments equal to 1
+c
+   20 do 30 i = 1,n
+        zy(i) = zy(i) + za*zx(i)
+   30 continue
+      return
+      end
diff --git a/src/fortran/blas/zcopy.f b/src/fortran/blas/zcopy.f
new file mode 100644
index 0000000..9ccfa88
--- /dev/null
+++ b/src/fortran/blas/zcopy.f
@@ -0,0 +1,33 @@
+      subroutine  zcopy(n,zx,incx,zy,incy)
+c
+c     copies a vector, x, to a vector, y.
+c     jack dongarra, linpack, 4/11/78.
+c     modified 12/3/93, array(1) declarations changed to array(*)
+c
+      double complex zx(*),zy(*)
+      integer i,incx,incy,ix,iy,n
+c
+      if(n.le.0)return
+      if(incx.eq.1.and.incy.eq.1)go to 20
+c
+c        code for unequal increments or equal increments
+c          not equal to 1
+c
+      ix = 1
+      iy = 1
+      if(incx.lt.0)ix = (-n+1)*incx + 1
+      if(incy.lt.0)iy = (-n+1)*incy + 1
+      do 10 i = 1,n
+        zy(iy) = zx(ix)
+        ix = ix + incx
+        iy = iy + incy
+   10 continue
+      return
+c
+c        code for both increments equal to 1
+c
+   20 do 30 i = 1,n
+        zy(i) = zx(i)
+   30 continue
+      return
+      end
diff --git a/src/fortran/blas/zdotc.f b/src/fortran/blas/zdotc.f
new file mode 100644
index 0000000..d6ac685
--- /dev/null
+++ b/src/fortran/blas/zdotc.f
@@ -0,0 +1,36 @@
+      double complex function zdotc(n,zx,incx,zy,incy)
+c
+c     forms the dot product of a vector.
+c     jack dongarra, 3/11/78.
+c     modified 12/3/93, array(1) declarations changed to array(*)
+c
+      double complex zx(*),zy(*),ztemp
+      integer i,incx,incy,ix,iy,n
+      ztemp = (0.0d0,0.0d0)
+      zdotc = (0.0d0,0.0d0)
+      if(n.le.0)return
+      if(incx.eq.1.and.incy.eq.1)go to 20
+c
+c        code for unequal increments or equal increments
+c          not equal to 1
+c
+      ix = 1
+      iy = 1
+      if(incx.lt.0)ix = (-n+1)*incx + 1
+      if(incy.lt.0)iy = (-n+1)*incy + 1
+      do 10 i = 1,n
+        ztemp = ztemp + dconjg(zx(ix))*zy(iy)
+        ix = ix + incx
+        iy = iy + incy
+   10 continue
+      zdotc = ztemp
+      return
+c
+c        code for both increments equal to 1
+c
+   20 do 30 i = 1,n
+        ztemp = ztemp + dconjg(zx(i))*zy(i)
+   30 continue
+      zdotc = ztemp
+      return
+      end
diff --git a/src/fortran/blas/zdotu.f b/src/fortran/blas/zdotu.f
new file mode 100644
index 0000000..329e988
--- /dev/null
+++ b/src/fortran/blas/zdotu.f
@@ -0,0 +1,36 @@
+      double complex function zdotu(n,zx,incx,zy,incy)
+c
+c     forms the dot product of two vectors.
+c     jack dongarra, 3/11/78.
+c     modified 12/3/93, array(1) declarations changed to array(*)
+c
+      double complex zx(*),zy(*),ztemp
+      integer i,incx,incy,ix,iy,n
+      ztemp = (0.0d0,0.0d0)
+      zdotu = (0.0d0,0.0d0)
+      if(n.le.0)return
+      if(incx.eq.1.and.incy.eq.1)go to 20
+c
+c        code for unequal increments or equal increments
+c          not equal to 1
+c
+      ix = 1
+      iy = 1
+      if(incx.lt.0)ix = (-n+1)*incx + 1
+      if(incy.lt.0)iy = (-n+1)*incy + 1
+      do 10 i = 1,n
+        ztemp = ztemp + zx(ix)*zy(iy)
+        ix = ix + incx
+        iy = iy + incy
+   10 continue
+      zdotu = ztemp
+      return
+c
+c        code for both increments equal to 1
+c
+   20 do 30 i = 1,n
+        ztemp = ztemp + zx(i)*zy(i)
+   30 continue
+      zdotu = ztemp
+      return
+      end
diff --git a/src/fortran/blas/zdscal.f b/src/fortran/blas/zdscal.f
new file mode 100644
index 0000000..8123424
--- /dev/null
+++ b/src/fortran/blas/zdscal.f
@@ -0,0 +1,30 @@
+      subroutine  zdscal(n,da,zx,incx)
+c
+c     scales a vector by a constant.
+c     jack dongarra, 3/11/78.
+c     modified 3/93 to return if incx .le. 0.
+c     modified 12/3/93, array(1) declarations changed to array(*)
+c
+      double complex zx(*)
+      double precision da
+      integer i,incx,ix,n
+c
+      if( n.le.0 .or. incx.le.0 )return
+      if(incx.eq.1)go to 20
+c
+c        code for increment not equal to 1
+c
+      ix = 1
+      do 10 i = 1,n
+        zx(ix) = dcmplx(da,0.0d0)*zx(ix)
+        ix = ix + incx
+   10 continue
+      return
+c
+c        code for increment equal to 1
+c
+   20 do 30 i = 1,n
+        zx(i) = dcmplx(da,0.0d0)*zx(i)
+   30 continue
+      return
+      end
diff --git a/src/fortran/blas/zgbmv.f b/src/fortran/blas/zgbmv.f
new file mode 100644
index 0000000..91ce9a6
--- /dev/null
+++ b/src/fortran/blas/zgbmv.f
@@ -0,0 +1,322 @@
+      SUBROUTINE ZGBMV ( TRANS, M, N, KL, KU, ALPHA, A, LDA, X, INCX,
+     $                   BETA, Y, INCY )
+*     .. Scalar Arguments ..
+      COMPLEX*16         ALPHA, BETA
+      INTEGER            INCX, INCY, KL, KU, LDA, M, N
+      CHARACTER*1        TRANS
+*     .. Array Arguments ..
+      COMPLEX*16         A( LDA, * ), X( * ), Y( * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  ZGBMV  performs one of the matrix-vector operations
+*
+*     y := alpha*A*x + beta*y,   or   y := alpha*A'*x + beta*y,   or
+*
+*     y := alpha*conjg( A' )*x + beta*y,
+*
+*  where alpha and beta are scalars, x and y are vectors and A is an
+*  m by n band matrix, with kl sub-diagonals and ku super-diagonals.
+*
+*  Parameters
+*  ==========
+*
+*  TRANS  - CHARACTER*1.
+*           On entry, TRANS specifies the operation to be performed as
+*           follows:
+*
+*              TRANS = 'N' or 'n'   y := alpha*A*x + beta*y.
+*
+*              TRANS = 'T' or 't'   y := alpha*A'*x + beta*y.
+*
+*              TRANS = 'C' or 'c'   y := alpha*conjg( A' )*x + beta*y.
+*
+*           Unchanged on exit.
+*
+*  M      - INTEGER.
+*           On entry, M specifies the number of rows of the matrix A.
+*           M must be at least zero.
+*           Unchanged on exit.
+*
+*  N      - INTEGER.
+*           On entry, N specifies the number of columns of the matrix A.
+*           N must be at least zero.
+*           Unchanged on exit.
+*
+*  KL     - INTEGER.
+*           On entry, KL specifies the number of sub-diagonals of the
+*           matrix A. KL must satisfy  0 .le. KL.
+*           Unchanged on exit.
+*
+*  KU     - INTEGER.
+*           On entry, KU specifies the number of super-diagonals of the
+*           matrix A. KU must satisfy  0 .le. KU.
+*           Unchanged on exit.
+*
+*  ALPHA  - COMPLEX*16      .
+*           On entry, ALPHA specifies the scalar alpha.
+*           Unchanged on exit.
+*
+*  A      - COMPLEX*16       array of DIMENSION ( LDA, n ).
+*           Before entry, the leading ( kl + ku + 1 ) by n part of the
+*           array A must contain the matrix of coefficients, supplied
+*           column by column, with the leading diagonal of the matrix in
+*           row ( ku + 1 ) of the array, the first super-diagonal
+*           starting at position 2 in row ku, the first sub-diagonal
+*           starting at position 1 in row ( ku + 2 ), and so on.
+*           Elements in the array A that do not correspond to elements
+*           in the band matrix (such as the top left ku by ku triangle)
+*           are not referenced.
+*           The following program segment will transfer a band matrix
+*           from conventional full matrix storage to band storage:
+*
+*                 DO 20, J = 1, N
+*                    K = KU + 1 - J
+*                    DO 10, I = MAX( 1, J - KU ), MIN( M, J + KL )
+*                       A( K + I, J ) = matrix( I, J )
+*              10    CONTINUE
+*              20 CONTINUE
+*
+*           Unchanged on exit.
+*
+*  LDA    - INTEGER.
+*           On entry, LDA specifies the first dimension of A as declared
+*           in the calling (sub) program. LDA must be at least
+*           ( kl + ku + 1 ).
+*           Unchanged on exit.
+*
+*  X      - COMPLEX*16       array of DIMENSION at least
+*           ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
+*           and at least
+*           ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
+*           Before entry, the incremented array X must contain the
+*           vector x.
+*           Unchanged on exit.
+*
+*  INCX   - INTEGER.
+*           On entry, INCX specifies the increment for the elements of
+*           X. INCX must not be zero.
+*           Unchanged on exit.
+*
+*  BETA   - COMPLEX*16      .
+*           On entry, BETA specifies the scalar beta. When BETA is
+*           supplied as zero then Y need not be set on input.
+*           Unchanged on exit.
+*
+*  Y      - COMPLEX*16       array of DIMENSION at least
+*           ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
+*           and at least
+*           ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
+*           Before entry, the incremented array Y must contain the
+*           vector y. On exit, Y is overwritten by the updated vector y.
+*
+*
+*  INCY   - INTEGER.
+*           On entry, INCY specifies the increment for the elements of
+*           Y. INCY must not be zero.
+*           Unchanged on exit.
+*
+*
+*  Level 2 Blas routine.
+*
+*  -- Written on 22-October-1986.
+*     Jack Dongarra, Argonne National Lab.
+*     Jeremy Du Croz, Nag Central Office.
+*     Sven Hammarling, Nag Central Office.
+*     Richard Hanson, Sandia National Labs.
+*
+*
+*     .. Parameters ..
+      COMPLEX*16         ONE
+      PARAMETER        ( ONE  = ( 1.0D+0, 0.0D+0 ) )
+      COMPLEX*16         ZERO
+      PARAMETER        ( ZERO = ( 0.0D+0, 0.0D+0 ) )
+*     .. Local Scalars ..
+      COMPLEX*16         TEMP
+      INTEGER            I, INFO, IX, IY, J, JX, JY, K, KUP1, KX, KY,
+     $                   LENX, LENY
+      LOGICAL            NOCONJ
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA
+*     .. Intrinsic Functions ..
+      INTRINSIC          DCONJG, MAX, MIN
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF     ( .NOT.LSAME( TRANS, 'N' ).AND.
+     $         .NOT.LSAME( TRANS, 'T' ).AND.
+     $         .NOT.LSAME( TRANS, 'C' )      )THEN
+         INFO = 1
+      ELSE IF( M.LT.0 )THEN
+         INFO = 2
+      ELSE IF( N.LT.0 )THEN
+         INFO = 3
+      ELSE IF( KL.LT.0 )THEN
+         INFO = 4
+      ELSE IF( KU.LT.0 )THEN
+         INFO = 5
+      ELSE IF( LDA.LT.( KL + KU + 1 ) )THEN
+         INFO = 8
+      ELSE IF( INCX.EQ.0 )THEN
+         INFO = 10
+      ELSE IF( INCY.EQ.0 )THEN
+         INFO = 13
+      END IF
+      IF( INFO.NE.0 )THEN
+         CALL XERBLA( 'ZGBMV ', INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF( ( M.EQ.0 ).OR.( N.EQ.0 ).OR.
+     $    ( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) ) )
+     $   RETURN
+*
+      NOCONJ = LSAME( TRANS, 'T' )
+*
+*     Set  LENX  and  LENY, the lengths of the vectors x and y, and set
+*     up the start points in  X  and  Y.
+*
+      IF( LSAME( TRANS, 'N' ) )THEN
+         LENX = N
+         LENY = M
+      ELSE
+         LENX = M
+         LENY = N
+      END IF
+      IF( INCX.GT.0 )THEN
+         KX = 1
+      ELSE
+         KX = 1 - ( LENX - 1 )*INCX
+      END IF
+      IF( INCY.GT.0 )THEN
+         KY = 1
+      ELSE
+         KY = 1 - ( LENY - 1 )*INCY
+      END IF
+*
+*     Start the operations. In this version the elements of A are
+*     accessed sequentially with one pass through the band part of A.
+*
+*     First form  y := beta*y.
+*
+      IF( BETA.NE.ONE )THEN
+         IF( INCY.EQ.1 )THEN
+            IF( BETA.EQ.ZERO )THEN
+               DO 10, I = 1, LENY
+                  Y( I ) = ZERO
+   10          CONTINUE
+            ELSE
+               DO 20, I = 1, LENY
+                  Y( I ) = BETA*Y( I )
+   20          CONTINUE
+            END IF
+         ELSE
+            IY = KY
+            IF( BETA.EQ.ZERO )THEN
+               DO 30, I = 1, LENY
+                  Y( IY ) = ZERO
+                  IY      = IY   + INCY
+   30          CONTINUE
+            ELSE
+               DO 40, I = 1, LENY
+                  Y( IY ) = BETA*Y( IY )
+                  IY      = IY           + INCY
+   40          CONTINUE
+            END IF
+         END IF
+      END IF
+      IF( ALPHA.EQ.ZERO )
+     $   RETURN
+      KUP1 = KU + 1
+      IF( LSAME( TRANS, 'N' ) )THEN
+*
+*        Form  y := alpha*A*x + y.
+*
+         JX = KX
+         IF( INCY.EQ.1 )THEN
+            DO 60, J = 1, N
+               IF( X( JX ).NE.ZERO )THEN
+                  TEMP = ALPHA*X( JX )
+                  K    = KUP1 - J
+                  DO 50, I = MAX( 1, J - KU ), MIN( M, J + KL )
+                     Y( I ) = Y( I ) + TEMP*A( K + I, J )
+   50             CONTINUE
+               END IF
+               JX = JX + INCX
+   60       CONTINUE
+         ELSE
+            DO 80, J = 1, N
+               IF( X( JX ).NE.ZERO )THEN
+                  TEMP = ALPHA*X( JX )
+                  IY   = KY
+                  K    = KUP1 - J
+                  DO 70, I = MAX( 1, J - KU ), MIN( M, J + KL )
+                     Y( IY ) = Y( IY ) + TEMP*A( K + I, J )
+                     IY      = IY      + INCY
+   70             CONTINUE
+               END IF
+               JX = JX + INCX
+               IF( J.GT.KU )
+     $            KY = KY + INCY
+   80       CONTINUE
+         END IF
+      ELSE
+*
+*        Form  y := alpha*A'*x + y  or  y := alpha*conjg( A' )*x + y.
+*
+         JY = KY
+         IF( INCX.EQ.1 )THEN
+            DO 110, J = 1, N
+               TEMP = ZERO
+               K    = KUP1 - J
+               IF( NOCONJ )THEN
+                  DO 90, I = MAX( 1, J - KU ), MIN( M, J + KL )
+                     TEMP = TEMP + A( K + I, J )*X( I )
+   90             CONTINUE
+               ELSE
+                  DO 100, I = MAX( 1, J - KU ), MIN( M, J + KL )
+                     TEMP = TEMP + DCONJG( A( K + I, J ) )*X( I )
+  100             CONTINUE
+               END IF
+               Y( JY ) = Y( JY ) + ALPHA*TEMP
+               JY      = JY      + INCY
+  110       CONTINUE
+         ELSE
+            DO 140, J = 1, N
+               TEMP = ZERO
+               IX   = KX
+               K    = KUP1 - J
+               IF( NOCONJ )THEN
+                  DO 120, I = MAX( 1, J - KU ), MIN( M, J + KL )
+                     TEMP = TEMP + A( K + I, J )*X( IX )
+                     IX   = IX   + INCX
+  120             CONTINUE
+               ELSE
+                  DO 130, I = MAX( 1, J - KU ), MIN( M, J + KL )
+                     TEMP = TEMP + DCONJG( A( K + I, J ) )*X( IX )
+                     IX   = IX   + INCX
+  130             CONTINUE
+               END IF
+               Y( JY ) = Y( JY ) + ALPHA*TEMP
+               JY      = JY      + INCY
+               IF( J.GT.KU )
+     $            KX = KX + INCX
+  140       CONTINUE
+         END IF
+      END IF
+*
+      RETURN
+*
+*     End of ZGBMV .
+*
+      END
diff --git a/src/fortran/blas/zgemm.f b/src/fortran/blas/zgemm.f
new file mode 100644
index 0000000..09cd151
--- /dev/null
+++ b/src/fortran/blas/zgemm.f
@@ -0,0 +1,415 @@
+      SUBROUTINE ZGEMM ( TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB,
+     $                   BETA, C, LDC )
+*     .. Scalar Arguments ..
+      CHARACTER*1        TRANSA, TRANSB
+      INTEGER            M, N, K, LDA, LDB, LDC
+      COMPLEX*16         ALPHA, BETA
+*     .. Array Arguments ..
+      COMPLEX*16         A( LDA, * ), B( LDB, * ), C( LDC, * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  ZGEMM  performs one of the matrix-matrix operations
+*
+*     C := alpha*op( A )*op( B ) + beta*C,
+*
+*  where  op( X ) is one of
+*
+*     op( X ) = X   or   op( X ) = X'   or   op( X ) = conjg( X' ),
+*
+*  alpha and beta are scalars, and A, B and C are matrices, with op( A )
+*  an m by k matrix,  op( B )  a  k by n matrix and  C an m by n matrix.
+*
+*  Parameters
+*  ==========
+*
+*  TRANSA - CHARACTER*1.
+*           On entry, TRANSA specifies the form of op( A ) to be used in
+*           the matrix multiplication as follows:
+*
+*              TRANSA = 'N' or 'n',  op( A ) = A.
+*
+*              TRANSA = 'T' or 't',  op( A ) = A'.
+*
+*              TRANSA = 'C' or 'c',  op( A ) = conjg( A' ).
+*
+*           Unchanged on exit.
+*
+*  TRANSB - CHARACTER*1.
+*           On entry, TRANSB specifies the form of op( B ) to be used in
+*           the matrix multiplication as follows:
+*
+*              TRANSB = 'N' or 'n',  op( B ) = B.
+*
+*              TRANSB = 'T' or 't',  op( B ) = B'.
+*
+*              TRANSB = 'C' or 'c',  op( B ) = conjg( B' ).
+*
+*           Unchanged on exit.
+*
+*  M      - INTEGER.
+*           On entry,  M  specifies  the number  of rows  of the  matrix
+*           op( A )  and of the  matrix  C.  M  must  be at least  zero.
+*           Unchanged on exit.
+*
+*  N      - INTEGER.
+*           On entry,  N  specifies the number  of columns of the matrix
+*           op( B ) and the number of columns of the matrix C. N must be
+*           at least zero.
+*           Unchanged on exit.
+*
+*  K      - INTEGER.
+*           On entry,  K  specifies  the number of columns of the matrix
+*           op( A ) and the number of rows of the matrix op( B ). K must
+*           be at least  zero.
+*           Unchanged on exit.
+*
+*  ALPHA  - COMPLEX*16      .
+*           On entry, ALPHA specifies the scalar alpha.
+*           Unchanged on exit.
+*
+*  A      - COMPLEX*16       array of DIMENSION ( LDA, ka ), where ka is
+*           k  when  TRANSA = 'N' or 'n',  and is  m  otherwise.
+*           Before entry with  TRANSA = 'N' or 'n',  the leading  m by k
+*           part of the array  A  must contain the matrix  A,  otherwise
+*           the leading  k by m  part of the array  A  must contain  the
+*           matrix A.
+*           Unchanged on exit.
+*
+*  LDA    - INTEGER.
+*           On entry, LDA specifies the first dimension of A as declared
+*           in the calling (sub) program. When  TRANSA = 'N' or 'n' then
+*           LDA must be at least  max( 1, m ), otherwise  LDA must be at
+*           least  max( 1, k ).
+*           Unchanged on exit.
+*
+*  B      - COMPLEX*16       array of DIMENSION ( LDB, kb ), where kb is
+*           n  when  TRANSB = 'N' or 'n',  and is  k  otherwise.
+*           Before entry with  TRANSB = 'N' or 'n',  the leading  k by n
+*           part of the array  B  must contain the matrix  B,  otherwise
+*           the leading  n by k  part of the array  B  must contain  the
+*           matrix B.
+*           Unchanged on exit.
+*
+*  LDB    - INTEGER.
+*           On entry, LDB specifies the first dimension of B as declared
+*           in the calling (sub) program. When  TRANSB = 'N' or 'n' then
+*           LDB must be at least  max( 1, k ), otherwise  LDB must be at
+*           least  max( 1, n ).
+*           Unchanged on exit.
+*
+*  BETA   - COMPLEX*16      .
+*           On entry,  BETA  specifies the scalar  beta.  When  BETA  is
+*           supplied as zero then C need not be set on input.
+*           Unchanged on exit.
+*
+*  C      - COMPLEX*16       array of DIMENSION ( LDC, n ).
+*           Before entry, the leading  m by n  part of the array  C must
+*           contain the matrix  C,  except when  beta  is zero, in which
+*           case C need not be set on entry.
+*           On exit, the array  C  is overwritten by the  m by n  matrix
+*           ( alpha*op( A )*op( B ) + beta*C ).
+*
+*  LDC    - INTEGER.
+*           On entry, LDC specifies the first dimension of C as declared
+*           in  the  calling  (sub)  program.   LDC  must  be  at  least
+*           max( 1, m ).
+*           Unchanged on exit.
+*
+*
+*  Level 3 Blas routine.
+*
+*  -- Written on 8-February-1989.
+*     Jack Dongarra, Argonne National Laboratory.
+*     Iain Duff, AERE Harwell.
+*     Jeremy Du Croz, Numerical Algorithms Group Ltd.
+*     Sven Hammarling, Numerical Algorithms Group Ltd.
+*
+*
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA
+*     .. Intrinsic Functions ..
+      INTRINSIC          DCONJG, MAX
+*     .. Local Scalars ..
+      LOGICAL            CONJA, CONJB, NOTA, NOTB
+      INTEGER            I, INFO, J, L, NCOLA, NROWA, NROWB
+      COMPLEX*16         TEMP
+*     .. Parameters ..
+      COMPLEX*16         ONE
+      PARAMETER        ( ONE  = ( 1.0D+0, 0.0D+0 ) )
+      COMPLEX*16         ZERO
+      PARAMETER        ( ZERO = ( 0.0D+0, 0.0D+0 ) )
+*     ..
+*     .. Executable Statements ..
+*
+*     Set  NOTA  and  NOTB  as  true if  A  and  B  respectively are not
+*     conjugated or transposed, set  CONJA and CONJB  as true if  A  and
+*     B  respectively are to be  transposed but  not conjugated  and set
+*     NROWA, NCOLA and  NROWB  as the number of rows and  columns  of  A
+*     and the number of rows of  B  respectively.
+*
+      NOTA  = LSAME( TRANSA, 'N' )
+      NOTB  = LSAME( TRANSB, 'N' )
+      CONJA = LSAME( TRANSA, 'C' )
+      CONJB = LSAME( TRANSB, 'C' )
+      IF( NOTA )THEN
+         NROWA = M
+         NCOLA = K
+      ELSE
+         NROWA = K
+         NCOLA = M
+      END IF
+      IF( NOTB )THEN
+         NROWB = K
+      ELSE
+         NROWB = N
+      END IF
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF(      ( .NOT.NOTA                 ).AND.
+     $         ( .NOT.CONJA                ).AND.
+     $         ( .NOT.LSAME( TRANSA, 'T' ) )      )THEN
+         INFO = 1
+      ELSE IF( ( .NOT.NOTB                 ).AND.
+     $         ( .NOT.CONJB                ).AND.
+     $         ( .NOT.LSAME( TRANSB, 'T' ) )      )THEN
+         INFO = 2
+      ELSE IF( M  .LT.0               )THEN
+         INFO = 3
+      ELSE IF( N  .LT.0               )THEN
+         INFO = 4
+      ELSE IF( K  .LT.0               )THEN
+         INFO = 5
+      ELSE IF( LDA.LT.MAX( 1, NROWA ) )THEN
+         INFO = 8
+      ELSE IF( LDB.LT.MAX( 1, NROWB ) )THEN
+         INFO = 10
+      ELSE IF( LDC.LT.MAX( 1, M     ) )THEN
+         INFO = 13
+      END IF
+      IF( INFO.NE.0 )THEN
+         CALL XERBLA( 'ZGEMM ', INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF( ( M.EQ.0 ).OR.( N.EQ.0 ).OR.
+     $    ( ( ( ALPHA.EQ.ZERO ).OR.( K.EQ.0 ) ).AND.( BETA.EQ.ONE ) ) )
+     $   RETURN
+*
+*     And when  alpha.eq.zero.
+*
+      IF( ALPHA.EQ.ZERO )THEN
+         IF( BETA.EQ.ZERO )THEN
+            DO 20, J = 1, N
+               DO 10, I = 1, M
+                  C( I, J ) = ZERO
+   10          CONTINUE
+   20       CONTINUE
+         ELSE
+            DO 40, J = 1, N
+               DO 30, I = 1, M
+                  C( I, J ) = BETA*C( I, J )
+   30          CONTINUE
+   40       CONTINUE
+         END IF
+         RETURN
+      END IF
+*
+*     Start the operations.
+*
+      IF( NOTB )THEN
+         IF( NOTA )THEN
+*
+*           Form  C := alpha*A*B + beta*C.
+*
+            DO 90, J = 1, N
+               IF( BETA.EQ.ZERO )THEN
+                  DO 50, I = 1, M
+                     C( I, J ) = ZERO
+   50             CONTINUE
+               ELSE IF( BETA.NE.ONE )THEN
+                  DO 60, I = 1, M
+                     C( I, J ) = BETA*C( I, J )
+   60             CONTINUE
+               END IF
+               DO 80, L = 1, K
+                  IF( B( L, J ).NE.ZERO )THEN
+                     TEMP = ALPHA*B( L, J )
+                     DO 70, I = 1, M
+                        C( I, J ) = C( I, J ) + TEMP*A( I, L )
+   70                CONTINUE
+                  END IF
+   80          CONTINUE
+   90       CONTINUE
+         ELSE IF( CONJA )THEN
+*
+*           Form  C := alpha*conjg( A' )*B + beta*C.
+*
+            DO 120, J = 1, N
+               DO 110, I = 1, M
+                  TEMP = ZERO
+                  DO 100, L = 1, K
+                     TEMP = TEMP + DCONJG( A( L, I ) )*B( L, J )
+  100             CONTINUE
+                  IF( BETA.EQ.ZERO )THEN
+                     C( I, J ) = ALPHA*TEMP
+                  ELSE
+                     C( I, J ) = ALPHA*TEMP + BETA*C( I, J )
+                  END IF
+  110          CONTINUE
+  120       CONTINUE
+         ELSE
+*
+*           Form  C := alpha*A'*B + beta*C
+*
+            DO 150, J = 1, N
+               DO 140, I = 1, M
+                  TEMP = ZERO
+                  DO 130, L = 1, K
+                     TEMP = TEMP + A( L, I )*B( L, J )
+  130             CONTINUE
+                  IF( BETA.EQ.ZERO )THEN
+                     C( I, J ) = ALPHA*TEMP
+                  ELSE
+                     C( I, J ) = ALPHA*TEMP + BETA*C( I, J )
+                  END IF
+  140          CONTINUE
+  150       CONTINUE
+         END IF
+      ELSE IF( NOTA )THEN
+         IF( CONJB )THEN
+*
+*           Form  C := alpha*A*conjg( B' ) + beta*C.
+*
+            DO 200, J = 1, N
+               IF( BETA.EQ.ZERO )THEN
+                  DO 160, I = 1, M
+                     C( I, J ) = ZERO
+  160             CONTINUE
+               ELSE IF( BETA.NE.ONE )THEN
+                  DO 170, I = 1, M
+                     C( I, J ) = BETA*C( I, J )
+  170             CONTINUE
+               END IF
+               DO 190, L = 1, K
+                  IF( B( J, L ).NE.ZERO )THEN
+                     TEMP = ALPHA*DCONJG( B( J, L ) )
+                     DO 180, I = 1, M
+                        C( I, J ) = C( I, J ) + TEMP*A( I, L )
+  180                CONTINUE
+                  END IF
+  190          CONTINUE
+  200       CONTINUE
+         ELSE
+*
+*           Form  C := alpha*A*B'          + beta*C
+*
+            DO 250, J = 1, N
+               IF( BETA.EQ.ZERO )THEN
+                  DO 210, I = 1, M
+                     C( I, J ) = ZERO
+  210             CONTINUE
+               ELSE IF( BETA.NE.ONE )THEN
+                  DO 220, I = 1, M
+                     C( I, J ) = BETA*C( I, J )
+  220             CONTINUE
+               END IF
+               DO 240, L = 1, K
+                  IF( B( J, L ).NE.ZERO )THEN
+                     TEMP = ALPHA*B( J, L )
+                     DO 230, I = 1, M
+                        C( I, J ) = C( I, J ) + TEMP*A( I, L )
+  230                CONTINUE
+                  END IF
+  240          CONTINUE
+  250       CONTINUE
+         END IF
+      ELSE IF( CONJA )THEN
+         IF( CONJB )THEN
+*
+*           Form  C := alpha*conjg( A' )*conjg( B' ) + beta*C.
+*
+            DO 280, J = 1, N
+               DO 270, I = 1, M
+                  TEMP = ZERO
+                  DO 260, L = 1, K
+                     TEMP = TEMP +
+     $                      DCONJG( A( L, I ) )*DCONJG( B( J, L ) )
+  260             CONTINUE
+                  IF( BETA.EQ.ZERO )THEN
+                     C( I, J ) = ALPHA*TEMP
+                  ELSE
+                     C( I, J ) = ALPHA*TEMP + BETA*C( I, J )
+                  END IF
+  270          CONTINUE
+  280       CONTINUE
+         ELSE
+*
+*           Form  C := alpha*conjg( A' )*B' + beta*C
+*
+            DO 310, J = 1, N
+               DO 300, I = 1, M
+                  TEMP = ZERO
+                  DO 290, L = 1, K
+                     TEMP = TEMP + DCONJG( A( L, I ) )*B( J, L )
+  290             CONTINUE
+                  IF( BETA.EQ.ZERO )THEN
+                     C( I, J ) = ALPHA*TEMP
+                  ELSE
+                     C( I, J ) = ALPHA*TEMP + BETA*C( I, J )
+                  END IF
+  300          CONTINUE
+  310       CONTINUE
+         END IF
+      ELSE
+         IF( CONJB )THEN
+*
+*           Form  C := alpha*A'*conjg( B' ) + beta*C
+*
+            DO 340, J = 1, N
+               DO 330, I = 1, M
+                  TEMP = ZERO
+                  DO 320, L = 1, K
+                     TEMP = TEMP + A( L, I )*DCONJG( B( J, L ) )
+  320             CONTINUE
+                  IF( BETA.EQ.ZERO )THEN
+                     C( I, J ) = ALPHA*TEMP
+                  ELSE
+                     C( I, J ) = ALPHA*TEMP + BETA*C( I, J )
+                  END IF
+  330          CONTINUE
+  340       CONTINUE
+         ELSE
+*
+*           Form  C := alpha*A'*B' + beta*C
+*
+            DO 370, J = 1, N
+               DO 360, I = 1, M
+                  TEMP = ZERO
+                  DO 350, L = 1, K
+                     TEMP = TEMP + A( L, I )*B( J, L )
+  350             CONTINUE
+                  IF( BETA.EQ.ZERO )THEN
+                     C( I, J ) = ALPHA*TEMP
+                  ELSE
+                     C( I, J ) = ALPHA*TEMP + BETA*C( I, J )
+                  END IF
+  360          CONTINUE
+  370       CONTINUE
+         END IF
+      END IF
+*
+      RETURN
+*
+*     End of ZGEMM .
+*
+      END
diff --git a/src/fortran/blas/zgemv.f b/src/fortran/blas/zgemv.f
new file mode 100644
index 0000000..014a5e0
--- /dev/null
+++ b/src/fortran/blas/zgemv.f
@@ -0,0 +1,281 @@
+      SUBROUTINE ZGEMV ( TRANS, M, N, ALPHA, A, LDA, X, INCX,
+     $                   BETA, Y, INCY )
+*     .. Scalar Arguments ..
+      COMPLEX*16         ALPHA, BETA
+      INTEGER            INCX, INCY, LDA, M, N
+      CHARACTER*1        TRANS
+*     .. Array Arguments ..
+      COMPLEX*16         A( LDA, * ), X( * ), Y( * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  ZGEMV  performs one of the matrix-vector operations
+*
+*     y := alpha*A*x + beta*y,   or   y := alpha*A'*x + beta*y,   or
+*
+*     y := alpha*conjg( A' )*x + beta*y,
+*
+*  where alpha and beta are scalars, x and y are vectors and A is an
+*  m by n matrix.
+*
+*  Parameters
+*  ==========
+*
+*  TRANS  - CHARACTER*1.
+*           On entry, TRANS specifies the operation to be performed as
+*           follows:
+*
+*              TRANS = 'N' or 'n'   y := alpha*A*x + beta*y.
+*
+*              TRANS = 'T' or 't'   y := alpha*A'*x + beta*y.
+*
+*              TRANS = 'C' or 'c'   y := alpha*conjg( A' )*x + beta*y.
+*
+*           Unchanged on exit.
+*
+*  M      - INTEGER.
+*           On entry, M specifies the number of rows of the matrix A.
+*           M must be at least zero.
+*           Unchanged on exit.
+*
+*  N      - INTEGER.
+*           On entry, N specifies the number of columns of the matrix A.
+*           N must be at least zero.
+*           Unchanged on exit.
+*
+*  ALPHA  - COMPLEX*16      .
+*           On entry, ALPHA specifies the scalar alpha.
+*           Unchanged on exit.
+*
+*  A      - COMPLEX*16       array of DIMENSION ( LDA, n ).
+*           Before entry, the leading m by n part of the array A must
+*           contain the matrix of coefficients.
+*           Unchanged on exit.
+*
+*  LDA    - INTEGER.
+*           On entry, LDA specifies the first dimension of A as declared
+*           in the calling (sub) program. LDA must be at least
+*           max( 1, m ).
+*           Unchanged on exit.
+*
+*  X      - COMPLEX*16       array of DIMENSION at least
+*           ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
+*           and at least
+*           ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
+*           Before entry, the incremented array X must contain the
+*           vector x.
+*           Unchanged on exit.
+*
+*  INCX   - INTEGER.
+*           On entry, INCX specifies the increment for the elements of
+*           X. INCX must not be zero.
+*           Unchanged on exit.
+*
+*  BETA   - COMPLEX*16      .
+*           On entry, BETA specifies the scalar beta. When BETA is
+*           supplied as zero then Y need not be set on input.
+*           Unchanged on exit.
+*
+*  Y      - COMPLEX*16       array of DIMENSION at least
+*           ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
+*           and at least
+*           ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
+*           Before entry with BETA non-zero, the incremented array Y
+*           must contain the vector y. On exit, Y is overwritten by the
+*           updated vector y.
+*
+*  INCY   - INTEGER.
+*           On entry, INCY specifies the increment for the elements of
+*           Y. INCY must not be zero.
+*           Unchanged on exit.
+*
+*
+*  Level 2 Blas routine.
+*
+*  -- Written on 22-October-1986.
+*     Jack Dongarra, Argonne National Lab.
+*     Jeremy Du Croz, Nag Central Office.
+*     Sven Hammarling, Nag Central Office.
+*     Richard Hanson, Sandia National Labs.
+*
+*
+*     .. Parameters ..
+      COMPLEX*16         ONE
+      PARAMETER        ( ONE  = ( 1.0D+0, 0.0D+0 ) )
+      COMPLEX*16         ZERO
+      PARAMETER        ( ZERO = ( 0.0D+0, 0.0D+0 ) )
+*     .. Local Scalars ..
+      COMPLEX*16         TEMP
+      INTEGER            I, INFO, IX, IY, J, JX, JY, KX, KY, LENX, LENY
+      LOGICAL            NOCONJ
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA
+*     .. Intrinsic Functions ..
+      INTRINSIC          DCONJG, MAX
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF     ( .NOT.LSAME( TRANS, 'N' ).AND.
+     $         .NOT.LSAME( TRANS, 'T' ).AND.
+     $         .NOT.LSAME( TRANS, 'C' )      )THEN
+         INFO = 1
+      ELSE IF( M.LT.0 )THEN
+         INFO = 2
+      ELSE IF( N.LT.0 )THEN
+         INFO = 3
+      ELSE IF( LDA.LT.MAX( 1, M ) )THEN
+         INFO = 6
+      ELSE IF( INCX.EQ.0 )THEN
+         INFO = 8
+      ELSE IF( INCY.EQ.0 )THEN
+         INFO = 11
+      END IF
+      IF( INFO.NE.0 )THEN
+         CALL XERBLA( 'ZGEMV ', INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF( ( M.EQ.0 ).OR.( N.EQ.0 ).OR.
+     $    ( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) ) )
+     $   RETURN
+*
+      NOCONJ = LSAME( TRANS, 'T' )
+*
+*     Set  LENX  and  LENY, the lengths of the vectors x and y, and set
+*     up the start points in  X  and  Y.
+*
+      IF( LSAME( TRANS, 'N' ) )THEN
+         LENX = N
+         LENY = M
+      ELSE
+         LENX = M
+         LENY = N
+      END IF
+      IF( INCX.GT.0 )THEN
+         KX = 1
+      ELSE
+         KX = 1 - ( LENX - 1 )*INCX
+      END IF
+      IF( INCY.GT.0 )THEN
+         KY = 1
+      ELSE
+         KY = 1 - ( LENY - 1 )*INCY
+      END IF
+*
+*     Start the operations. In this version the elements of A are
+*     accessed sequentially with one pass through A.
+*
+*     First form  y := beta*y.
+*
+      IF( BETA.NE.ONE )THEN
+         IF( INCY.EQ.1 )THEN
+            IF( BETA.EQ.ZERO )THEN
+               DO 10, I = 1, LENY
+                  Y( I ) = ZERO
+   10          CONTINUE
+            ELSE
+               DO 20, I = 1, LENY
+                  Y( I ) = BETA*Y( I )
+   20          CONTINUE
+            END IF
+         ELSE
+            IY = KY
+            IF( BETA.EQ.ZERO )THEN
+               DO 30, I = 1, LENY
+                  Y( IY ) = ZERO
+                  IY      = IY   + INCY
+   30          CONTINUE
+            ELSE
+               DO 40, I = 1, LENY
+                  Y( IY ) = BETA*Y( IY )
+                  IY      = IY           + INCY
+   40          CONTINUE
+            END IF
+         END IF
+      END IF
+      IF( ALPHA.EQ.ZERO )
+     $   RETURN
+      IF( LSAME( TRANS, 'N' ) )THEN
+*
+*        Form  y := alpha*A*x + y.
+*
+         JX = KX
+         IF( INCY.EQ.1 )THEN
+            DO 60, J = 1, N
+               IF( X( JX ).NE.ZERO )THEN
+                  TEMP = ALPHA*X( JX )
+                  DO 50, I = 1, M
+                     Y( I ) = Y( I ) + TEMP*A( I, J )
+   50             CONTINUE
+               END IF
+               JX = JX + INCX
+   60       CONTINUE
+         ELSE
+            DO 80, J = 1, N
+               IF( X( JX ).NE.ZERO )THEN
+                  TEMP = ALPHA*X( JX )
+                  IY   = KY
+                  DO 70, I = 1, M
+                     Y( IY ) = Y( IY ) + TEMP*A( I, J )
+                     IY      = IY      + INCY
+   70             CONTINUE
+               END IF
+               JX = JX + INCX
+   80       CONTINUE
+         END IF
+      ELSE
+*
+*        Form  y := alpha*A'*x + y  or  y := alpha*conjg( A' )*x + y.
+*
+         JY = KY
+         IF( INCX.EQ.1 )THEN
+            DO 110, J = 1, N
+               TEMP = ZERO
+               IF( NOCONJ )THEN
+                  DO 90, I = 1, M
+                     TEMP = TEMP + A( I, J )*X( I )
+   90             CONTINUE
+               ELSE
+                  DO 100, I = 1, M
+                     TEMP = TEMP + DCONJG( A( I, J ) )*X( I )
+  100             CONTINUE
+               END IF
+               Y( JY ) = Y( JY ) + ALPHA*TEMP
+               JY      = JY      + INCY
+  110       CONTINUE
+         ELSE
+            DO 140, J = 1, N
+               TEMP = ZERO
+               IX   = KX
+               IF( NOCONJ )THEN
+                  DO 120, I = 1, M
+                     TEMP = TEMP + A( I, J )*X( IX )
+                     IX   = IX   + INCX
+  120             CONTINUE
+               ELSE
+                  DO 130, I = 1, M
+                     TEMP = TEMP + DCONJG( A( I, J ) )*X( IX )
+                     IX   = IX   + INCX
+  130             CONTINUE
+               END IF
+               Y( JY ) = Y( JY ) + ALPHA*TEMP
+               JY      = JY      + INCY
+  140       CONTINUE
+         END IF
+      END IF
+*
+      RETURN
+*
+*     End of ZGEMV .
+*
+      END
diff --git a/src/fortran/blas/zgerc.f b/src/fortran/blas/zgerc.f
new file mode 100644
index 0000000..968c5b4
--- /dev/null
+++ b/src/fortran/blas/zgerc.f
@@ -0,0 +1,157 @@
+      SUBROUTINE ZGERC ( M, N, ALPHA, X, INCX, Y, INCY, A, LDA )
+*     .. Scalar Arguments ..
+      COMPLEX*16         ALPHA
+      INTEGER            INCX, INCY, LDA, M, N
+*     .. Array Arguments ..
+      COMPLEX*16         A( LDA, * ), X( * ), Y( * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  ZGERC  performs the rank 1 operation
+*
+*     A := alpha*x*conjg( y' ) + A,
+*
+*  where alpha is a scalar, x is an m element vector, y is an n element
+*  vector and A is an m by n matrix.
+*
+*  Parameters
+*  ==========
+*
+*  M      - INTEGER.
+*           On entry, M specifies the number of rows of the matrix A.
+*           M must be at least zero.
+*           Unchanged on exit.
+*
+*  N      - INTEGER.
+*           On entry, N specifies the number of columns of the matrix A.
+*           N must be at least zero.
+*           Unchanged on exit.
+*
+*  ALPHA  - COMPLEX*16      .
+*           On entry, ALPHA specifies the scalar alpha.
+*           Unchanged on exit.
+*
+*  X      - COMPLEX*16       array of dimension at least
+*           ( 1 + ( m - 1 )*abs( INCX ) ).
+*           Before entry, the incremented array X must contain the m
+*           element vector x.
+*           Unchanged on exit.
+*
+*  INCX   - INTEGER.
+*           On entry, INCX specifies the increment for the elements of
+*           X. INCX must not be zero.
+*           Unchanged on exit.
+*
+*  Y      - COMPLEX*16       array of dimension at least
+*           ( 1 + ( n - 1 )*abs( INCY ) ).
+*           Before entry, the incremented array Y must contain the n
+*           element vector y.
+*           Unchanged on exit.
+*
+*  INCY   - INTEGER.
+*           On entry, INCY specifies the increment for the elements of
+*           Y. INCY must not be zero.
+*           Unchanged on exit.
+*
+*  A      - COMPLEX*16       array of DIMENSION ( LDA, n ).
+*           Before entry, the leading m by n part of the array A must
+*           contain the matrix of coefficients. On exit, A is
+*           overwritten by the updated matrix.
+*
+*  LDA    - INTEGER.
+*           On entry, LDA specifies the first dimension of A as declared
+*           in the calling (sub) program. LDA must be at least
+*           max( 1, m ).
+*           Unchanged on exit.
+*
+*
+*  Level 2 Blas routine.
+*
+*  -- Written on 22-October-1986.
+*     Jack Dongarra, Argonne National Lab.
+*     Jeremy Du Croz, Nag Central Office.
+*     Sven Hammarling, Nag Central Office.
+*     Richard Hanson, Sandia National Labs.
+*
+*
+*     .. Parameters ..
+      COMPLEX*16         ZERO
+      PARAMETER        ( ZERO = ( 0.0D+0, 0.0D+0 ) )
+*     .. Local Scalars ..
+      COMPLEX*16         TEMP
+      INTEGER            I, INFO, IX, J, JY, KX
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA
+*     .. Intrinsic Functions ..
+      INTRINSIC          DCONJG, MAX
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF     ( M.LT.0 )THEN
+         INFO = 1
+      ELSE IF( N.LT.0 )THEN
+         INFO = 2
+      ELSE IF( INCX.EQ.0 )THEN
+         INFO = 5
+      ELSE IF( INCY.EQ.0 )THEN
+         INFO = 7
+      ELSE IF( LDA.LT.MAX( 1, M ) )THEN
+         INFO = 9
+      END IF
+      IF( INFO.NE.0 )THEN
+         CALL XERBLA( 'ZGERC ', INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF( ( M.EQ.0 ).OR.( N.EQ.0 ).OR.( ALPHA.EQ.ZERO ) )
+     $   RETURN
+*
+*     Start the operations. In this version the elements of A are
+*     accessed sequentially with one pass through A.
+*
+      IF( INCY.GT.0 )THEN
+         JY = 1
+      ELSE
+         JY = 1 - ( N - 1 )*INCY
+      END IF
+      IF( INCX.EQ.1 )THEN
+         DO 20, J = 1, N
+            IF( Y( JY ).NE.ZERO )THEN
+               TEMP = ALPHA*DCONJG( Y( JY ) )
+               DO 10, I = 1, M
+                  A( I, J ) = A( I, J ) + X( I )*TEMP
+   10          CONTINUE
+            END IF
+            JY = JY + INCY
+   20    CONTINUE
+      ELSE
+         IF( INCX.GT.0 )THEN
+            KX = 1
+         ELSE
+            KX = 1 - ( M - 1 )*INCX
+         END IF
+         DO 40, J = 1, N
+            IF( Y( JY ).NE.ZERO )THEN
+               TEMP = ALPHA*DCONJG( Y( JY ) )
+               IX   = KX
+               DO 30, I = 1, M
+                  A( I, J ) = A( I, J ) + X( IX )*TEMP
+                  IX        = IX        + INCX
+   30          CONTINUE
+            END IF
+            JY = JY + INCY
+   40    CONTINUE
+      END IF
+*
+      RETURN
+*
+*     End of ZGERC .
+*
+      END
diff --git a/src/fortran/blas/zgeru.f b/src/fortran/blas/zgeru.f
new file mode 100644
index 0000000..5283af6
--- /dev/null
+++ b/src/fortran/blas/zgeru.f
@@ -0,0 +1,157 @@
+      SUBROUTINE ZGERU ( M, N, ALPHA, X, INCX, Y, INCY, A, LDA )
+*     .. Scalar Arguments ..
+      COMPLEX*16         ALPHA
+      INTEGER            INCX, INCY, LDA, M, N
+*     .. Array Arguments ..
+      COMPLEX*16         A( LDA, * ), X( * ), Y( * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  ZGERU  performs the rank 1 operation
+*
+*     A := alpha*x*y' + A,
+*
+*  where alpha is a scalar, x is an m element vector, y is an n element
+*  vector and A is an m by n matrix.
+*
+*  Parameters
+*  ==========
+*
+*  M      - INTEGER.
+*           On entry, M specifies the number of rows of the matrix A.
+*           M must be at least zero.
+*           Unchanged on exit.
+*
+*  N      - INTEGER.
+*           On entry, N specifies the number of columns of the matrix A.
+*           N must be at least zero.
+*           Unchanged on exit.
+*
+*  ALPHA  - COMPLEX*16      .
+*           On entry, ALPHA specifies the scalar alpha.
+*           Unchanged on exit.
+*
+*  X      - COMPLEX*16       array of dimension at least
+*           ( 1 + ( m - 1 )*abs( INCX ) ).
+*           Before entry, the incremented array X must contain the m
+*           element vector x.
+*           Unchanged on exit.
+*
+*  INCX   - INTEGER.
+*           On entry, INCX specifies the increment for the elements of
+*           X. INCX must not be zero.
+*           Unchanged on exit.
+*
+*  Y      - COMPLEX*16       array of dimension at least
+*           ( 1 + ( n - 1 )*abs( INCY ) ).
+*           Before entry, the incremented array Y must contain the n
+*           element vector y.
+*           Unchanged on exit.
+*
+*  INCY   - INTEGER.
+*           On entry, INCY specifies the increment for the elements of
+*           Y. INCY must not be zero.
+*           Unchanged on exit.
+*
+*  A      - COMPLEX*16       array of DIMENSION ( LDA, n ).
+*           Before entry, the leading m by n part of the array A must
+*           contain the matrix of coefficients. On exit, A is
+*           overwritten by the updated matrix.
+*
+*  LDA    - INTEGER.
+*           On entry, LDA specifies the first dimension of A as declared
+*           in the calling (sub) program. LDA must be at least
+*           max( 1, m ).
+*           Unchanged on exit.
+*
+*
+*  Level 2 Blas routine.
+*
+*  -- Written on 22-October-1986.
+*     Jack Dongarra, Argonne National Lab.
+*     Jeremy Du Croz, Nag Central Office.
+*     Sven Hammarling, Nag Central Office.
+*     Richard Hanson, Sandia National Labs.
+*
+*
+*     .. Parameters ..
+      COMPLEX*16         ZERO
+      PARAMETER        ( ZERO = ( 0.0D+0, 0.0D+0 ) )
+*     .. Local Scalars ..
+      COMPLEX*16         TEMP
+      INTEGER            I, INFO, IX, J, JY, KX
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF     ( M.LT.0 )THEN
+         INFO = 1
+      ELSE IF( N.LT.0 )THEN
+         INFO = 2
+      ELSE IF( INCX.EQ.0 )THEN
+         INFO = 5
+      ELSE IF( INCY.EQ.0 )THEN
+         INFO = 7
+      ELSE IF( LDA.LT.MAX( 1, M ) )THEN
+         INFO = 9
+      END IF
+      IF( INFO.NE.0 )THEN
+         CALL XERBLA( 'ZGERU ', INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF( ( M.EQ.0 ).OR.( N.EQ.0 ).OR.( ALPHA.EQ.ZERO ) )
+     $   RETURN
+*
+*     Start the operations. In this version the elements of A are
+*     accessed sequentially with one pass through A.
+*
+      IF( INCY.GT.0 )THEN
+         JY = 1
+      ELSE
+         JY = 1 - ( N - 1 )*INCY
+      END IF
+      IF( INCX.EQ.1 )THEN
+         DO 20, J = 1, N
+            IF( Y( JY ).NE.ZERO )THEN
+               TEMP = ALPHA*Y( JY )
+               DO 10, I = 1, M
+                  A( I, J ) = A( I, J ) + X( I )*TEMP
+   10          CONTINUE
+            END IF
+            JY = JY + INCY
+   20    CONTINUE
+      ELSE
+         IF( INCX.GT.0 )THEN
+            KX = 1
+         ELSE
+            KX = 1 - ( M - 1 )*INCX
+         END IF
+         DO 40, J = 1, N
+            IF( Y( JY ).NE.ZERO )THEN
+               TEMP = ALPHA*Y( JY )
+               IX   = KX
+               DO 30, I = 1, M
+                  A( I, J ) = A( I, J ) + X( IX )*TEMP
+                  IX        = IX        + INCX
+   30          CONTINUE
+            END IF
+            JY = JY + INCY
+   40    CONTINUE
+      END IF
+*
+      RETURN
+*
+*     End of ZGERU .
+*
+      END
diff --git a/src/fortran/blas/zhbmv.f b/src/fortran/blas/zhbmv.f
new file mode 100644
index 0000000..1c04493
--- /dev/null
+++ b/src/fortran/blas/zhbmv.f
@@ -0,0 +1,309 @@
+      SUBROUTINE ZHBMV ( UPLO, N, K, ALPHA, A, LDA, X, INCX,
+     $                   BETA, Y, INCY )
+*     .. Scalar Arguments ..
+      COMPLEX*16         ALPHA, BETA
+      INTEGER            INCX, INCY, K, LDA, N
+      CHARACTER*1        UPLO
+*     .. Array Arguments ..
+      COMPLEX*16         A( LDA, * ), X( * ), Y( * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  ZHBMV  performs the matrix-vector  operation
+*
+*     y := alpha*A*x + beta*y,
+*
+*  where alpha and beta are scalars, x and y are n element vectors and
+*  A is an n by n hermitian band matrix, with k super-diagonals.
+*
+*  Parameters
+*  ==========
+*
+*  UPLO   - CHARACTER*1.
+*           On entry, UPLO specifies whether the upper or lower
+*           triangular part of the band matrix A is being supplied as
+*           follows:
+*
+*              UPLO = 'U' or 'u'   The upper triangular part of A is
+*                                  being supplied.
+*
+*              UPLO = 'L' or 'l'   The lower triangular part of A is
+*                                  being supplied.
+*
+*           Unchanged on exit.
+*
+*  N      - INTEGER.
+*           On entry, N specifies the order of the matrix A.
+*           N must be at least zero.
+*           Unchanged on exit.
+*
+*  K      - INTEGER.
+*           On entry, K specifies the number of super-diagonals of the
+*           matrix A. K must satisfy  0 .le. K.
+*           Unchanged on exit.
+*
+*  ALPHA  - COMPLEX*16      .
+*           On entry, ALPHA specifies the scalar alpha.
+*           Unchanged on exit.
+*
+*  A      - COMPLEX*16       array of DIMENSION ( LDA, n ).
+*           Before entry with UPLO = 'U' or 'u', the leading ( k + 1 )
+*           by n part of the array A must contain the upper triangular
+*           band part of the hermitian matrix, supplied column by
+*           column, with the leading diagonal of the matrix in row
+*           ( k + 1 ) of the array, the first super-diagonal starting at
+*           position 2 in row k, and so on. The top left k by k triangle
+*           of the array A is not referenced.
+*           The following program segment will transfer the upper
+*           triangular part of a hermitian band matrix from conventional
+*           full matrix storage to band storage:
+*
+*                 DO 20, J = 1, N
+*                    M = K + 1 - J
+*                    DO 10, I = MAX( 1, J - K ), J
+*                       A( M + I, J ) = matrix( I, J )
+*              10    CONTINUE
+*              20 CONTINUE
+*
+*           Before entry with UPLO = 'L' or 'l', the leading ( k + 1 )
+*           by n part of the array A must contain the lower triangular
+*           band part of the hermitian matrix, supplied column by
+*           column, with the leading diagonal of the matrix in row 1 of
+*           the array, the first sub-diagonal starting at position 1 in
+*           row 2, and so on. The bottom right k by k triangle of the
+*           array A is not referenced.
+*           The following program segment will transfer the lower
+*           triangular part of a hermitian band matrix from conventional
+*           full matrix storage to band storage:
+*
+*                 DO 20, J = 1, N
+*                    M = 1 - J
+*                    DO 10, I = J, MIN( N, J + K )
+*                       A( M + I, J ) = matrix( I, J )
+*              10    CONTINUE
+*              20 CONTINUE
+*
+*           Note that the imaginary parts of the diagonal elements need
+*           not be set and are assumed to be zero.
+*           Unchanged on exit.
+*
+*  LDA    - INTEGER.
+*           On entry, LDA specifies the first dimension of A as declared
+*           in the calling (sub) program. LDA must be at least
+*           ( k + 1 ).
+*           Unchanged on exit.
+*
+*  X      - COMPLEX*16       array of DIMENSION at least
+*           ( 1 + ( n - 1 )*abs( INCX ) ).
+*           Before entry, the incremented array X must contain the
+*           vector x.
+*           Unchanged on exit.
+*
+*  INCX   - INTEGER.
+*           On entry, INCX specifies the increment for the elements of
+*           X. INCX must not be zero.
+*           Unchanged on exit.
+*
+*  BETA   - COMPLEX*16      .
+*           On entry, BETA specifies the scalar beta.
+*           Unchanged on exit.
+*
+*  Y      - COMPLEX*16       array of DIMENSION at least
+*           ( 1 + ( n - 1 )*abs( INCY ) ).
+*           Before entry, the incremented array Y must contain the
+*           vector y. On exit, Y is overwritten by the updated vector y.
+*
+*  INCY   - INTEGER.
+*           On entry, INCY specifies the increment for the elements of
+*           Y. INCY must not be zero.
+*           Unchanged on exit.
+*
+*
+*  Level 2 Blas routine.
+*
+*  -- Written on 22-October-1986.
+*     Jack Dongarra, Argonne National Lab.
+*     Jeremy Du Croz, Nag Central Office.
+*     Sven Hammarling, Nag Central Office.
+*     Richard Hanson, Sandia National Labs.
+*
+*
+*     .. Parameters ..
+      COMPLEX*16         ONE
+      PARAMETER        ( ONE  = ( 1.0D+0, 0.0D+0 ) )
+      COMPLEX*16         ZERO
+      PARAMETER        ( ZERO = ( 0.0D+0, 0.0D+0 ) )
+*     .. Local Scalars ..
+      COMPLEX*16         TEMP1, TEMP2
+      INTEGER            I, INFO, IX, IY, J, JX, JY, KPLUS1, KX, KY, L
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA
+*     .. Intrinsic Functions ..
+      INTRINSIC          DCONJG, MAX, MIN, DBLE
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF     ( .NOT.LSAME( UPLO, 'U' ).AND.
+     $         .NOT.LSAME( UPLO, 'L' )      )THEN
+         INFO = 1
+      ELSE IF( N.LT.0 )THEN
+         INFO = 2
+      ELSE IF( K.LT.0 )THEN
+         INFO = 3
+      ELSE IF( LDA.LT.( K + 1 ) )THEN
+         INFO = 6
+      ELSE IF( INCX.EQ.0 )THEN
+         INFO = 8
+      ELSE IF( INCY.EQ.0 )THEN
+         INFO = 11
+      END IF
+      IF( INFO.NE.0 )THEN
+         CALL XERBLA( 'ZHBMV ', INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF( ( N.EQ.0 ).OR.( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) ) )
+     $   RETURN
+*
+*     Set up the start points in  X  and  Y.
+*
+      IF( INCX.GT.0 )THEN
+         KX = 1
+      ELSE
+         KX = 1 - ( N - 1 )*INCX
+      END IF
+      IF( INCY.GT.0 )THEN
+         KY = 1
+      ELSE
+         KY = 1 - ( N - 1 )*INCY
+      END IF
+*
+*     Start the operations. In this version the elements of the array A
+*     are accessed sequentially with one pass through A.
+*
+*     First form  y := beta*y.
+*
+      IF( BETA.NE.ONE )THEN
+         IF( INCY.EQ.1 )THEN
+            IF( BETA.EQ.ZERO )THEN
+               DO 10, I = 1, N
+                  Y( I ) = ZERO
+   10          CONTINUE
+            ELSE
+               DO 20, I = 1, N
+                  Y( I ) = BETA*Y( I )
+   20          CONTINUE
+            END IF
+         ELSE
+            IY = KY
+            IF( BETA.EQ.ZERO )THEN
+               DO 30, I = 1, N
+                  Y( IY ) = ZERO
+                  IY      = IY   + INCY
+   30          CONTINUE
+            ELSE
+               DO 40, I = 1, N
+                  Y( IY ) = BETA*Y( IY )
+                  IY      = IY           + INCY
+   40          CONTINUE
+            END IF
+         END IF
+      END IF
+      IF( ALPHA.EQ.ZERO )
+     $   RETURN
+      IF( LSAME( UPLO, 'U' ) )THEN
+*
+*        Form  y  when upper triangle of A is stored.
+*
+         KPLUS1 = K + 1
+         IF( ( INCX.EQ.1 ).AND.( INCY.EQ.1 ) )THEN
+            DO 60, J = 1, N
+               TEMP1 = ALPHA*X( J )
+               TEMP2 = ZERO
+               L     = KPLUS1 - J
+               DO 50, I = MAX( 1, J - K ), J - 1
+                  Y( I ) = Y( I ) + TEMP1*A( L + I, J )
+                  TEMP2  = TEMP2  + DCONJG( A( L + I, J ) )*X( I )
+   50          CONTINUE
+               Y( J ) = Y( J ) + TEMP1*DBLE( A( KPLUS1, J ) )
+     $                         + ALPHA*TEMP2
+   60       CONTINUE
+         ELSE
+            JX = KX
+            JY = KY
+            DO 80, J = 1, N
+               TEMP1 = ALPHA*X( JX )
+               TEMP2 = ZERO
+               IX    = KX
+               IY    = KY
+               L     = KPLUS1 - J
+               DO 70, I = MAX( 1, J - K ), J - 1
+                  Y( IY ) = Y( IY ) + TEMP1*A( L + I, J )
+                  TEMP2   = TEMP2   + DCONJG( A( L + I, J ) )*X( IX )
+                  IX      = IX      + INCX
+                  IY      = IY      + INCY
+   70          CONTINUE
+               Y( JY ) = Y( JY ) + TEMP1*DBLE( A( KPLUS1, J ) )
+     $                           + ALPHA*TEMP2
+               JX      = JX      + INCX
+               JY      = JY      + INCY
+               IF( J.GT.K )THEN
+                  KX = KX + INCX
+                  KY = KY + INCY
+               END IF
+   80       CONTINUE
+         END IF
+      ELSE
+*
+*        Form  y  when lower triangle of A is stored.
+*
+         IF( ( INCX.EQ.1 ).AND.( INCY.EQ.1 ) )THEN
+            DO 100, J = 1, N
+               TEMP1  = ALPHA*X( J )
+               TEMP2  = ZERO
+               Y( J ) = Y( J ) + TEMP1*DBLE( A( 1, J ) )
+               L      = 1      - J
+               DO 90, I = J + 1, MIN( N, J + K )
+                  Y( I ) = Y( I ) + TEMP1*A( L + I, J )
+                  TEMP2  = TEMP2  + DCONJG( A( L + I, J ) )*X( I )
+   90          CONTINUE
+               Y( J ) = Y( J ) + ALPHA*TEMP2
+  100       CONTINUE
+         ELSE
+            JX = KX
+            JY = KY
+            DO 120, J = 1, N
+               TEMP1   = ALPHA*X( JX )
+               TEMP2   = ZERO
+               Y( JY ) = Y( JY ) + TEMP1*DBLE( A( 1, J ) )
+               L       = 1       - J
+               IX      = JX
+               IY      = JY
+               DO 110, I = J + 1, MIN( N, J + K )
+                  IX      = IX      + INCX
+                  IY      = IY      + INCY
+                  Y( IY ) = Y( IY ) + TEMP1*A( L + I, J )
+                  TEMP2   = TEMP2   + DCONJG( A( L + I, J ) )*X( IX )
+  110          CONTINUE
+               Y( JY ) = Y( JY ) + ALPHA*TEMP2
+               JX      = JX      + INCX
+               JY      = JY      + INCY
+  120       CONTINUE
+         END IF
+      END IF
+*
+      RETURN
+*
+*     End of ZHBMV .
+*
+      END
diff --git a/src/fortran/blas/zhemm.f b/src/fortran/blas/zhemm.f
new file mode 100644
index 0000000..d3912c0
--- /dev/null
+++ b/src/fortran/blas/zhemm.f
@@ -0,0 +1,304 @@
+      SUBROUTINE ZHEMM ( SIDE, UPLO, M, N, ALPHA, A, LDA, B, LDB,
+     $                   BETA, C, LDC )
+*     .. Scalar Arguments ..
+      CHARACTER*1        SIDE, UPLO
+      INTEGER            M, N, LDA, LDB, LDC
+      COMPLEX*16         ALPHA, BETA
+*     .. Array Arguments ..
+      COMPLEX*16         A( LDA, * ), B( LDB, * ), C( LDC, * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  ZHEMM  performs one of the matrix-matrix operations
+*
+*     C := alpha*A*B + beta*C,
+*
+*  or
+*
+*     C := alpha*B*A + beta*C,
+*
+*  where alpha and beta are scalars, A is an hermitian matrix and  B and
+*  C are m by n matrices.
+*
+*  Parameters
+*  ==========
+*
+*  SIDE   - CHARACTER*1.
+*           On entry,  SIDE  specifies whether  the  hermitian matrix  A
+*           appears on the  left or right  in the  operation as follows:
+*
+*              SIDE = 'L' or 'l'   C := alpha*A*B + beta*C,
+*
+*              SIDE = 'R' or 'r'   C := alpha*B*A + beta*C,
+*
+*           Unchanged on exit.
+*
+*  UPLO   - CHARACTER*1.
+*           On  entry,   UPLO  specifies  whether  the  upper  or  lower
+*           triangular  part  of  the  hermitian  matrix   A  is  to  be
+*           referenced as follows:
+*
+*              UPLO = 'U' or 'u'   Only the upper triangular part of the
+*                                  hermitian matrix is to be referenced.
+*
+*              UPLO = 'L' or 'l'   Only the lower triangular part of the
+*                                  hermitian matrix is to be referenced.
+*
+*           Unchanged on exit.
+*
+*  M      - INTEGER.
+*           On entry,  M  specifies the number of rows of the matrix  C.
+*           M  must be at least zero.
+*           Unchanged on exit.
+*
+*  N      - INTEGER.
+*           On entry, N specifies the number of columns of the matrix C.
+*           N  must be at least zero.
+*           Unchanged on exit.
+*
+*  ALPHA  - COMPLEX*16      .
+*           On entry, ALPHA specifies the scalar alpha.
+*           Unchanged on exit.
+*
+*  A      - COMPLEX*16       array of DIMENSION ( LDA, ka ), where ka is
+*           m  when  SIDE = 'L' or 'l'  and is n  otherwise.
+*           Before entry  with  SIDE = 'L' or 'l',  the  m by m  part of
+*           the array  A  must contain the  hermitian matrix,  such that
+*           when  UPLO = 'U' or 'u', the leading m by m upper triangular
+*           part of the array  A  must contain the upper triangular part
+*           of the  hermitian matrix and the  strictly  lower triangular
+*           part of  A  is not referenced,  and when  UPLO = 'L' or 'l',
+*           the leading  m by m  lower triangular part  of the  array  A
+*           must  contain  the  lower triangular part  of the  hermitian
+*           matrix and the  strictly upper triangular part of  A  is not
+*           referenced.
+*           Before entry  with  SIDE = 'R' or 'r',  the  n by n  part of
+*           the array  A  must contain the  hermitian matrix,  such that
+*           when  UPLO = 'U' or 'u', the leading n by n upper triangular
+*           part of the array  A  must contain the upper triangular part
+*           of the  hermitian matrix and the  strictly  lower triangular
+*           part of  A  is not referenced,  and when  UPLO = 'L' or 'l',
+*           the leading  n by n  lower triangular part  of the  array  A
+*           must  contain  the  lower triangular part  of the  hermitian
+*           matrix and the  strictly upper triangular part of  A  is not
+*           referenced.
+*           Note that the imaginary parts  of the diagonal elements need
+*           not be set, they are assumed to be zero.
+*           Unchanged on exit.
+*
+*  LDA    - INTEGER.
+*           On entry, LDA specifies the first dimension of A as declared
+*           in the  calling (sub) program. When  SIDE = 'L' or 'l'  then
+*           LDA must be at least  max( 1, m ), otherwise  LDA must be at
+*           least max( 1, n ).
+*           Unchanged on exit.
+*
+*  B      - COMPLEX*16       array of DIMENSION ( LDB, n ).
+*           Before entry, the leading  m by n part of the array  B  must
+*           contain the matrix B.
+*           Unchanged on exit.
+*
+*  LDB    - INTEGER.
+*           On entry, LDB specifies the first dimension of B as declared
+*           in  the  calling  (sub)  program.   LDB  must  be  at  least
+*           max( 1, m ).
+*           Unchanged on exit.
+*
+*  BETA   - COMPLEX*16      .
+*           On entry,  BETA  specifies the scalar  beta.  When  BETA  is
+*           supplied as zero then C need not be set on input.
+*           Unchanged on exit.
+*
+*  C      - COMPLEX*16       array of DIMENSION ( LDC, n ).
+*           Before entry, the leading  m by n  part of the array  C must
+*           contain the matrix  C,  except when  beta  is zero, in which
+*           case C need not be set on entry.
+*           On exit, the array  C  is overwritten by the  m by n updated
+*           matrix.
+*
+*  LDC    - INTEGER.
+*           On entry, LDC specifies the first dimension of C as declared
+*           in  the  calling  (sub)  program.   LDC  must  be  at  least
+*           max( 1, m ).
+*           Unchanged on exit.
+*
+*
+*  Level 3 Blas routine.
+*
+*  -- Written on 8-February-1989.
+*     Jack Dongarra, Argonne National Laboratory.
+*     Iain Duff, AERE Harwell.
+*     Jeremy Du Croz, Numerical Algorithms Group Ltd.
+*     Sven Hammarling, Numerical Algorithms Group Ltd.
+*
+*
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA
+*     .. Intrinsic Functions ..
+      INTRINSIC          DCONJG, MAX, DBLE
+*     .. Local Scalars ..
+      LOGICAL            UPPER
+      INTEGER            I, INFO, J, K, NROWA
+      COMPLEX*16         TEMP1, TEMP2
+*     .. Parameters ..
+      COMPLEX*16         ONE
+      PARAMETER        ( ONE  = ( 1.0D+0, 0.0D+0 ) )
+      COMPLEX*16         ZERO
+      PARAMETER        ( ZERO = ( 0.0D+0, 0.0D+0 ) )
+*     ..
+*     .. Executable Statements ..
+*
+*     Set NROWA as the number of rows of A.
+*
+      IF( LSAME( SIDE, 'L' ) )THEN
+         NROWA = M
+      ELSE
+         NROWA = N
+      END IF
+      UPPER = LSAME( UPLO, 'U' )
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF(      ( .NOT.LSAME( SIDE, 'L' ) ).AND.
+     $         ( .NOT.LSAME( SIDE, 'R' ) )      )THEN
+         INFO = 1
+      ELSE IF( ( .NOT.UPPER              ).AND.
+     $         ( .NOT.LSAME( UPLO, 'L' ) )      )THEN
+         INFO = 2
+      ELSE IF( M  .LT.0               )THEN
+         INFO = 3
+      ELSE IF( N  .LT.0               )THEN
+         INFO = 4
+      ELSE IF( LDA.LT.MAX( 1, NROWA ) )THEN
+         INFO = 7
+      ELSE IF( LDB.LT.MAX( 1, M     ) )THEN
+         INFO = 9
+      ELSE IF( LDC.LT.MAX( 1, M     ) )THEN
+         INFO = 12
+      END IF
+      IF( INFO.NE.0 )THEN
+         CALL XERBLA( 'ZHEMM ', INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF( ( M.EQ.0 ).OR.( N.EQ.0 ).OR.
+     $    ( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) ) )
+     $   RETURN
+*
+*     And when  alpha.eq.zero.
+*
+      IF( ALPHA.EQ.ZERO )THEN
+         IF( BETA.EQ.ZERO )THEN
+            DO 20, J = 1, N
+               DO 10, I = 1, M
+                  C( I, J ) = ZERO
+   10          CONTINUE
+   20       CONTINUE
+         ELSE
+            DO 40, J = 1, N
+               DO 30, I = 1, M
+                  C( I, J ) = BETA*C( I, J )
+   30          CONTINUE
+   40       CONTINUE
+         END IF
+         RETURN
+      END IF
+*
+*     Start the operations.
+*
+      IF( LSAME( SIDE, 'L' ) )THEN
+*
+*        Form  C := alpha*A*B + beta*C.
+*
+         IF( UPPER )THEN
+            DO 70, J = 1, N
+               DO 60, I = 1, M
+                  TEMP1 = ALPHA*B( I, J )
+                  TEMP2 = ZERO
+                  DO 50, K = 1, I - 1
+                     C( K, J ) = C( K, J ) + TEMP1*A( K, I )
+                     TEMP2     = TEMP2     +
+     $                           B( K, J )*DCONJG( A( K, I ) )
+   50             CONTINUE
+                  IF( BETA.EQ.ZERO )THEN
+                     C( I, J ) = TEMP1*DBLE( A( I, I ) ) +
+     $                           ALPHA*TEMP2
+                  ELSE
+                     C( I, J ) = BETA *C( I, J )         +
+     $                           TEMP1*DBLE( A( I, I ) ) +
+     $                           ALPHA*TEMP2
+                  END IF
+   60          CONTINUE
+   70       CONTINUE
+         ELSE
+            DO 100, J = 1, N
+               DO 90, I = M, 1, -1
+                  TEMP1 = ALPHA*B( I, J )
+                  TEMP2 = ZERO
+                  DO 80, K = I + 1, M
+                     C( K, J ) = C( K, J ) + TEMP1*A( K, I )
+                     TEMP2     = TEMP2     +
+     $                           B( K, J )*DCONJG( A( K, I ) )
+   80             CONTINUE
+                  IF( BETA.EQ.ZERO )THEN
+                     C( I, J ) = TEMP1*DBLE( A( I, I ) ) +
+     $                           ALPHA*TEMP2
+                  ELSE
+                     C( I, J ) = BETA *C( I, J )         +
+     $                           TEMP1*DBLE( A( I, I ) ) +
+     $                           ALPHA*TEMP2
+                  END IF
+   90          CONTINUE
+  100       CONTINUE
+         END IF
+      ELSE
+*
+*        Form  C := alpha*B*A + beta*C.
+*
+         DO 170, J = 1, N
+            TEMP1 = ALPHA*DBLE( A( J, J ) )
+            IF( BETA.EQ.ZERO )THEN
+               DO 110, I = 1, M
+                  C( I, J ) = TEMP1*B( I, J )
+  110          CONTINUE
+            ELSE
+               DO 120, I = 1, M
+                  C( I, J ) = BETA*C( I, J ) + TEMP1*B( I, J )
+  120          CONTINUE
+            END IF
+            DO 140, K = 1, J - 1
+               IF( UPPER )THEN
+                  TEMP1 = ALPHA*A( K, J )
+               ELSE
+                  TEMP1 = ALPHA*DCONJG( A( J, K ) )
+               END IF
+               DO 130, I = 1, M
+                  C( I, J ) = C( I, J ) + TEMP1*B( I, K )
+  130          CONTINUE
+  140       CONTINUE
+            DO 160, K = J + 1, N
+               IF( UPPER )THEN
+                  TEMP1 = ALPHA*DCONJG( A( J, K ) )
+               ELSE
+                  TEMP1 = ALPHA*A( K, J )
+               END IF
+               DO 150, I = 1, M
+                  C( I, J ) = C( I, J ) + TEMP1*B( I, K )
+  150          CONTINUE
+  160       CONTINUE
+  170    CONTINUE
+      END IF
+*
+      RETURN
+*
+*     End of ZHEMM .
+*
+      END
diff --git a/src/fortran/blas/zhemv.f b/src/fortran/blas/zhemv.f
new file mode 100644
index 0000000..54aa7b9
--- /dev/null
+++ b/src/fortran/blas/zhemv.f
@@ -0,0 +1,266 @@
+      SUBROUTINE ZHEMV ( UPLO, N, ALPHA, A, LDA, X, INCX,
+     $                   BETA, Y, INCY )
+*     .. Scalar Arguments ..
+      COMPLEX*16         ALPHA, BETA
+      INTEGER            INCX, INCY, LDA, N
+      CHARACTER*1        UPLO
+*     .. Array Arguments ..
+      COMPLEX*16         A( LDA, * ), X( * ), Y( * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  ZHEMV  performs the matrix-vector  operation
+*
+*     y := alpha*A*x + beta*y,
+*
+*  where alpha and beta are scalars, x and y are n element vectors and
+*  A is an n by n hermitian matrix.
+*
+*  Parameters
+*  ==========
+*
+*  UPLO   - CHARACTER*1.
+*           On entry, UPLO specifies whether the upper or lower
+*           triangular part of the array A is to be referenced as
+*           follows:
+*
+*              UPLO = 'U' or 'u'   Only the upper triangular part of A
+*                                  is to be referenced.
+*
+*              UPLO = 'L' or 'l'   Only the lower triangular part of A
+*                                  is to be referenced.
+*
+*           Unchanged on exit.
+*
+*  N      - INTEGER.
+*           On entry, N specifies the order of the matrix A.
+*           N must be at least zero.
+*           Unchanged on exit.
+*
+*  ALPHA  - COMPLEX*16      .
+*           On entry, ALPHA specifies the scalar alpha.
+*           Unchanged on exit.
+*
+*  A      - COMPLEX*16       array of DIMENSION ( LDA, n ).
+*           Before entry with  UPLO = 'U' or 'u', the leading n by n
+*           upper triangular part of the array A must contain the upper
+*           triangular part of the hermitian matrix and the strictly
+*           lower triangular part of A is not referenced.
+*           Before entry with UPLO = 'L' or 'l', the leading n by n
+*           lower triangular part of the array A must contain the lower
+*           triangular part of the hermitian matrix 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.
+*           Unchanged on exit.
+*
+*  LDA    - INTEGER.
+*           On entry, LDA specifies the first dimension of A as declared
+*           in the calling (sub) program. LDA must be at least
+*           max( 1, n ).
+*           Unchanged on exit.
+*
+*  X      - COMPLEX*16       array of dimension at least
+*           ( 1 + ( n - 1 )*abs( INCX ) ).
+*           Before entry, the incremented array X must contain the n
+*           element vector x.
+*           Unchanged on exit.
+*
+*  INCX   - INTEGER.
+*           On entry, INCX specifies the increment for the elements of
+*           X. INCX must not be zero.
+*           Unchanged on exit.
+*
+*  BETA   - COMPLEX*16      .
+*           On entry, BETA specifies the scalar beta. When BETA is
+*           supplied as zero then Y need not be set on input.
+*           Unchanged on exit.
+*
+*  Y      - COMPLEX*16       array of dimension at least
+*           ( 1 + ( n - 1 )*abs( INCY ) ).
+*           Before entry, the incremented array Y must contain the n
+*           element vector y. On exit, Y is overwritten by the updated
+*           vector y.
+*
+*  INCY   - INTEGER.
+*           On entry, INCY specifies the increment for the elements of
+*           Y. INCY must not be zero.
+*           Unchanged on exit.
+*
+*
+*  Level 2 Blas routine.
+*
+*  -- Written on 22-October-1986.
+*     Jack Dongarra, Argonne National Lab.
+*     Jeremy Du Croz, Nag Central Office.
+*     Sven Hammarling, Nag Central Office.
+*     Richard Hanson, Sandia National Labs.
+*
+*
+*     .. Parameters ..
+      COMPLEX*16         ONE
+      PARAMETER        ( ONE  = ( 1.0D+0, 0.0D+0 ) )
+      COMPLEX*16         ZERO
+      PARAMETER        ( ZERO = ( 0.0D+0, 0.0D+0 ) )
+*     .. Local Scalars ..
+      COMPLEX*16         TEMP1, TEMP2
+      INTEGER            I, INFO, IX, IY, J, JX, JY, KX, KY
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA
+*     .. Intrinsic Functions ..
+      INTRINSIC          DCONJG, MAX, DBLE
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF     ( .NOT.LSAME( UPLO, 'U' ).AND.
+     $         .NOT.LSAME( UPLO, 'L' )      )THEN
+         INFO = 1
+      ELSE IF( N.LT.0 )THEN
+         INFO = 2
+      ELSE IF( LDA.LT.MAX( 1, N ) )THEN
+         INFO = 5
+      ELSE IF( INCX.EQ.0 )THEN
+         INFO = 7
+      ELSE IF( INCY.EQ.0 )THEN
+         INFO = 10
+      END IF
+      IF( INFO.NE.0 )THEN
+         CALL XERBLA( 'ZHEMV ', INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF( ( N.EQ.0 ).OR.( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) ) )
+     $   RETURN
+*
+*     Set up the start points in  X  and  Y.
+*
+      IF( INCX.GT.0 )THEN
+         KX = 1
+      ELSE
+         KX = 1 - ( N - 1 )*INCX
+      END IF
+      IF( INCY.GT.0 )THEN
+         KY = 1
+      ELSE
+         KY = 1 - ( N - 1 )*INCY
+      END IF
+*
+*     Start the operations. In this version the elements of A are
+*     accessed sequentially with one pass through the triangular part
+*     of A.
+*
+*     First form  y := beta*y.
+*
+      IF( BETA.NE.ONE )THEN
+         IF( INCY.EQ.1 )THEN
+            IF( BETA.EQ.ZERO )THEN
+               DO 10, I = 1, N
+                  Y( I ) = ZERO
+   10          CONTINUE
+            ELSE
+               DO 20, I = 1, N
+                  Y( I ) = BETA*Y( I )
+   20          CONTINUE
+            END IF
+         ELSE
+            IY = KY
+            IF( BETA.EQ.ZERO )THEN
+               DO 30, I = 1, N
+                  Y( IY ) = ZERO
+                  IY      = IY   + INCY
+   30          CONTINUE
+            ELSE
+               DO 40, I = 1, N
+                  Y( IY ) = BETA*Y( IY )
+                  IY      = IY           + INCY
+   40          CONTINUE
+            END IF
+         END IF
+      END IF
+      IF( ALPHA.EQ.ZERO )
+     $   RETURN
+      IF( LSAME( UPLO, 'U' ) )THEN
+*
+*        Form  y  when A is stored in upper triangle.
+*
+         IF( ( INCX.EQ.1 ).AND.( INCY.EQ.1 ) )THEN
+            DO 60, J = 1, N
+               TEMP1 = ALPHA*X( J )
+               TEMP2 = ZERO
+               DO 50, I = 1, J - 1
+                  Y( I ) = Y( I ) + TEMP1*A( I, J )
+                  TEMP2  = TEMP2  + DCONJG( A( I, J ) )*X( I )
+   50          CONTINUE
+               Y( J ) = Y( J ) + TEMP1*DBLE( A( J, J ) ) + ALPHA*TEMP2
+   60       CONTINUE
+         ELSE
+            JX = KX
+            JY = KY
+            DO 80, J = 1, N
+               TEMP1 = ALPHA*X( JX )
+               TEMP2 = ZERO
+               IX    = KX
+               IY    = KY
+               DO 70, I = 1, J - 1
+                  Y( IY ) = Y( IY ) + TEMP1*A( I, J )
+                  TEMP2   = TEMP2   + DCONJG( A( I, J ) )*X( IX )
+                  IX      = IX      + INCX
+                  IY      = IY      + INCY
+   70          CONTINUE
+               Y( JY ) = Y( JY ) + TEMP1*DBLE( A( J, J ) ) + ALPHA*TEMP2
+               JX      = JX      + INCX
+               JY      = JY      + INCY
+   80       CONTINUE
+         END IF
+      ELSE
+*
+*        Form  y  when A is stored in lower triangle.
+*
+         IF( ( INCX.EQ.1 ).AND.( INCY.EQ.1 ) )THEN
+            DO 100, J = 1, N
+               TEMP1  = ALPHA*X( J )
+               TEMP2  = ZERO
+               Y( J ) = Y( J ) + TEMP1*DBLE( A( J, J ) )
+               DO 90, I = J + 1, N
+                  Y( I ) = Y( I ) + TEMP1*A( I, J )
+                  TEMP2  = TEMP2  + DCONJG( A( I, J ) )*X( I )
+   90          CONTINUE
+               Y( J ) = Y( J ) + ALPHA*TEMP2
+  100       CONTINUE
+         ELSE
+            JX = KX
+            JY = KY
+            DO 120, J = 1, N
+               TEMP1   = ALPHA*X( JX )
+               TEMP2   = ZERO
+               Y( JY ) = Y( JY ) + TEMP1*DBLE( A( J, J ) )
+               IX      = JX
+               IY      = JY
+               DO 110, I = J + 1, N
+                  IX      = IX      + INCX
+                  IY      = IY      + INCY
+                  Y( IY ) = Y( IY ) + TEMP1*A( I, J )
+                  TEMP2   = TEMP2   + DCONJG( A( I, J ) )*X( IX )
+  110          CONTINUE
+               Y( JY ) = Y( JY ) + ALPHA*TEMP2
+               JX      = JX      + INCX
+               JY      = JY      + INCY
+  120       CONTINUE
+         END IF
+      END IF
+*
+      RETURN
+*
+*     End of ZHEMV .
+*
+      END
diff --git a/src/fortran/blas/zher.f b/src/fortran/blas/zher.f
new file mode 100644
index 0000000..fcf40a5
--- /dev/null
+++ b/src/fortran/blas/zher.f
@@ -0,0 +1,212 @@
+      SUBROUTINE ZHER  ( UPLO, N, ALPHA, X, INCX, A, LDA )
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION   ALPHA
+      INTEGER            INCX, LDA, N
+      CHARACTER*1        UPLO
+*     .. Array Arguments ..
+      COMPLEX*16         A( LDA, * ), X( * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  ZHER   performs the hermitian rank 1 operation
+*
+*     A := alpha*x*conjg( x' ) + A,
+*
+*  where alpha is a real scalar, x is an n element vector and A is an
+*  n by n hermitian matrix.
+*
+*  Parameters
+*  ==========
+*
+*  UPLO   - CHARACTER*1.
+*           On entry, UPLO specifies whether the upper or lower
+*           triangular part of the array A is to be referenced as
+*           follows:
+*
+*              UPLO = 'U' or 'u'   Only the upper triangular part of A
+*                                  is to be referenced.
+*
+*              UPLO = 'L' or 'l'   Only the lower triangular part of A
+*                                  is to be referenced.
+*
+*           Unchanged on exit.
+*
+*  N      - INTEGER.
+*           On entry, N specifies the order of the matrix A.
+*           N must be at least zero.
+*           Unchanged on exit.
+*
+*  ALPHA  - DOUBLE PRECISION.
+*           On entry, ALPHA specifies the scalar alpha.
+*           Unchanged on exit.
+*
+*  X      - COMPLEX*16       array of dimension at least
+*           ( 1 + ( n - 1 )*abs( INCX ) ).
+*           Before entry, the incremented array X must contain the n
+*           element vector x.
+*           Unchanged on exit.
+*
+*  INCX   - INTEGER.
+*           On entry, INCX specifies the increment for the elements of
+*           X. INCX must not be zero.
+*           Unchanged on exit.
+*
+*  A      - COMPLEX*16       array of DIMENSION ( LDA, n ).
+*           Before entry with  UPLO = 'U' or 'u', the leading n by n
+*           upper triangular part of the array A must contain the upper
+*           triangular part of the hermitian matrix and the strictly
+*           lower triangular part of A is not referenced. On exit, the
+*           upper triangular part of the array A is overwritten by the
+*           upper triangular part of the updated matrix.
+*           Before entry with UPLO = 'L' or 'l', the leading n by n
+*           lower triangular part of the array A must contain the lower
+*           triangular part of the hermitian matrix and the strictly
+*           upper triangular part of A is not referenced. On exit, the
+*           lower triangular part of the array A is overwritten by the
+*           lower triangular part of the updated matrix.
+*           Note that the imaginary parts of the diagonal elements need
+*           not be set, they are assumed to be zero, and on exit they
+*           are set to zero.
+*
+*  LDA    - INTEGER.
+*           On entry, LDA specifies the first dimension of A as declared
+*           in the calling (sub) program. LDA must be at least
+*           max( 1, n ).
+*           Unchanged on exit.
+*
+*
+*  Level 2 Blas routine.
+*
+*  -- Written on 22-October-1986.
+*     Jack Dongarra, Argonne National Lab.
+*     Jeremy Du Croz, Nag Central Office.
+*     Sven Hammarling, Nag Central Office.
+*     Richard Hanson, Sandia National Labs.
+*
+*
+*     .. Parameters ..
+      COMPLEX*16         ZERO
+      PARAMETER        ( ZERO = ( 0.0D+0, 0.0D+0 ) )
+*     .. Local Scalars ..
+      COMPLEX*16         TEMP
+      INTEGER            I, INFO, IX, J, JX, KX
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA
+*     .. Intrinsic Functions ..
+      INTRINSIC          DCONJG, MAX, DBLE
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF     ( .NOT.LSAME( UPLO, 'U' ).AND.
+     $         .NOT.LSAME( UPLO, 'L' )      )THEN
+         INFO = 1
+      ELSE IF( N.LT.0 )THEN
+         INFO = 2
+      ELSE IF( INCX.EQ.0 )THEN
+         INFO = 5
+      ELSE IF( LDA.LT.MAX( 1, N ) )THEN
+         INFO = 7
+      END IF
+      IF( INFO.NE.0 )THEN
+         CALL XERBLA( 'ZHER  ', INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF( ( N.EQ.0 ).OR.( ALPHA.EQ.DBLE( ZERO ) ) )
+     $   RETURN
+*
+*     Set the start point in X if the increment is not unity.
+*
+      IF( INCX.LE.0 )THEN
+         KX = 1 - ( N - 1 )*INCX
+      ELSE IF( INCX.NE.1 )THEN
+         KX = 1
+      END IF
+*
+*     Start the operations. In this version the elements of A are
+*     accessed sequentially with one pass through the triangular part
+*     of A.
+*
+      IF( LSAME( UPLO, 'U' ) )THEN
+*
+*        Form  A  when A is stored in upper triangle.
+*
+         IF( INCX.EQ.1 )THEN
+            DO 20, J = 1, N
+               IF( X( J ).NE.ZERO )THEN
+                  TEMP = ALPHA*DCONJG( X( J ) )
+                  DO 10, I = 1, J - 1
+                     A( I, J ) = A( I, J ) + X( I )*TEMP
+   10             CONTINUE
+                  A( J, J ) = DBLE( A( J, J ) ) + DBLE( X( J )*TEMP )
+               ELSE
+                  A( J, J ) = DBLE( A( J, J ) )
+               END IF
+   20       CONTINUE
+         ELSE
+            JX = KX
+            DO 40, J = 1, N
+               IF( X( JX ).NE.ZERO )THEN
+                  TEMP = ALPHA*DCONJG( X( JX ) )
+                  IX   = KX
+                  DO 30, I = 1, J - 1
+                     A( I, J ) = A( I, J ) + X( IX )*TEMP
+                     IX        = IX        + INCX
+   30             CONTINUE
+                  A( J, J ) = DBLE( A( J, J ) ) + DBLE( X( JX )*TEMP )
+               ELSE
+                  A( J, J ) = DBLE( A( J, J ) )
+               END IF
+               JX = JX + INCX
+   40       CONTINUE
+         END IF
+      ELSE
+*
+*        Form  A  when A is stored in lower triangle.
+*
+         IF( INCX.EQ.1 )THEN
+            DO 60, J = 1, N
+               IF( X( J ).NE.ZERO )THEN
+                  TEMP      = ALPHA*DCONJG( X( J ) )
+                  A( J, J ) = DBLE( A( J, J ) ) + DBLE( TEMP*X( J ) )
+                  DO 50, I = J + 1, N
+                     A( I, J ) = A( I, J ) + X( I )*TEMP
+   50             CONTINUE
+               ELSE
+                  A( J, J ) = DBLE( A( J, J ) )
+               END IF
+   60       CONTINUE
+         ELSE
+            JX = KX
+            DO 80, J = 1, N
+               IF( X( JX ).NE.ZERO )THEN
+                  TEMP      = ALPHA*DCONJG( X( JX ) )
+                  A( J, J ) = DBLE( A( J, J ) ) + DBLE( TEMP*X( JX ) )
+                  IX        = JX
+                  DO 70, I = J + 1, N
+                     IX        = IX        + INCX
+                     A( I, J ) = A( I, J ) + X( IX )*TEMP
+   70             CONTINUE
+               ELSE
+                  A( J, J ) = DBLE( A( J, J ) )
+               END IF
+               JX = JX + INCX
+   80       CONTINUE
+         END IF
+      END IF
+*
+      RETURN
+*
+*     End of ZHER  .
+*
+      END
diff --git a/src/fortran/blas/zher2.f b/src/fortran/blas/zher2.f
new file mode 100644
index 0000000..06acdff
--- /dev/null
+++ b/src/fortran/blas/zher2.f
@@ -0,0 +1,249 @@
+      SUBROUTINE ZHER2 ( UPLO, N, ALPHA, X, INCX, Y, INCY, A, LDA )
+*     .. Scalar Arguments ..
+      COMPLEX*16         ALPHA
+      INTEGER            INCX, INCY, LDA, N
+      CHARACTER*1        UPLO
+*     .. Array Arguments ..
+      COMPLEX*16         A( LDA, * ), X( * ), Y( * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  ZHER2  performs the hermitian rank 2 operation
+*
+*     A := alpha*x*conjg( y' ) + conjg( alpha )*y*conjg( x' ) + A,
+*
+*  where alpha is a scalar, x and y are n element vectors and A is an n
+*  by n hermitian matrix.
+*
+*  Parameters
+*  ==========
+*
+*  UPLO   - CHARACTER*1.
+*           On entry, UPLO specifies whether the upper or lower
+*           triangular part of the array A is to be referenced as
+*           follows:
+*
+*              UPLO = 'U' or 'u'   Only the upper triangular part of A
+*                                  is to be referenced.
+*
+*              UPLO = 'L' or 'l'   Only the lower triangular part of A
+*                                  is to be referenced.
+*
+*           Unchanged on exit.
+*
+*  N      - INTEGER.
+*           On entry, N specifies the order of the matrix A.
+*           N must be at least zero.
+*           Unchanged on exit.
+*
+*  ALPHA  - COMPLEX*16      .
+*           On entry, ALPHA specifies the scalar alpha.
+*           Unchanged on exit.
+*
+*  X      - COMPLEX*16       array of dimension at least
+*           ( 1 + ( n - 1 )*abs( INCX ) ).
+*           Before entry, the incremented array X must contain the n
+*           element vector x.
+*           Unchanged on exit.
+*
+*  INCX   - INTEGER.
+*           On entry, INCX specifies the increment for the elements of
+*           X. INCX must not be zero.
+*           Unchanged on exit.
+*
+*  Y      - COMPLEX*16       array of dimension at least
+*           ( 1 + ( n - 1 )*abs( INCY ) ).
+*           Before entry, the incremented array Y must contain the n
+*           element vector y.
+*           Unchanged on exit.
+*
+*  INCY   - INTEGER.
+*           On entry, INCY specifies the increment for the elements of
+*           Y. INCY must not be zero.
+*           Unchanged on exit.
+*
+*  A      - COMPLEX*16       array of DIMENSION ( LDA, n ).
+*           Before entry with  UPLO = 'U' or 'u', the leading n by n
+*           upper triangular part of the array A must contain the upper
+*           triangular part of the hermitian matrix and the strictly
+*           lower triangular part of A is not referenced. On exit, the
+*           upper triangular part of the array A is overwritten by the
+*           upper triangular part of the updated matrix.
+*           Before entry with UPLO = 'L' or 'l', the leading n by n
+*           lower triangular part of the array A must contain the lower
+*           triangular part of the hermitian matrix and the strictly
+*           upper triangular part of A is not referenced. On exit, the
+*           lower triangular part of the array A is overwritten by the
+*           lower triangular part of the updated matrix.
+*           Note that the imaginary parts of the diagonal elements need
+*           not be set, they are assumed to be zero, and on exit they
+*           are set to zero.
+*
+*  LDA    - INTEGER.
+*           On entry, LDA specifies the first dimension of A as declared
+*           in the calling (sub) program. LDA must be at least
+*           max( 1, n ).
+*           Unchanged on exit.
+*
+*
+*  Level 2 Blas routine.
+*
+*  -- Written on 22-October-1986.
+*     Jack Dongarra, Argonne National Lab.
+*     Jeremy Du Croz, Nag Central Office.
+*     Sven Hammarling, Nag Central Office.
+*     Richard Hanson, Sandia National Labs.
+*
+*
+*     .. Parameters ..
+      COMPLEX*16         ZERO
+      PARAMETER        ( ZERO = ( 0.0D+0, 0.0D+0 ) )
+*     .. Local Scalars ..
+      COMPLEX*16         TEMP1, TEMP2
+      INTEGER            I, INFO, IX, IY, J, JX, JY, KX, KY
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA
+*     .. Intrinsic Functions ..
+      INTRINSIC          DCONJG, MAX, DBLE
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF     ( .NOT.LSAME( UPLO, 'U' ).AND.
+     $         .NOT.LSAME( UPLO, 'L' )      )THEN
+         INFO = 1
+      ELSE IF( N.LT.0 )THEN
+         INFO = 2
+      ELSE IF( INCX.EQ.0 )THEN
+         INFO = 5
+      ELSE IF( INCY.EQ.0 )THEN
+         INFO = 7
+      ELSE IF( LDA.LT.MAX( 1, N ) )THEN
+         INFO = 9
+      END IF
+      IF( INFO.NE.0 )THEN
+         CALL XERBLA( 'ZHER2 ', INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF( ( N.EQ.0 ).OR.( ALPHA.EQ.ZERO ) )
+     $   RETURN
+*
+*     Set up the start points in X and Y if the increments are not both
+*     unity.
+*
+      IF( ( INCX.NE.1 ).OR.( INCY.NE.1 ) )THEN
+         IF( INCX.GT.0 )THEN
+            KX = 1
+         ELSE
+            KX = 1 - ( N - 1 )*INCX
+         END IF
+         IF( INCY.GT.0 )THEN
+            KY = 1
+         ELSE
+            KY = 1 - ( N - 1 )*INCY
+         END IF
+         JX = KX
+         JY = KY
+      END IF
+*
+*     Start the operations. In this version the elements of A are
+*     accessed sequentially with one pass through the triangular part
+*     of A.
+*
+      IF( LSAME( UPLO, 'U' ) )THEN
+*
+*        Form  A  when A is stored in the upper triangle.
+*
+         IF( ( INCX.EQ.1 ).AND.( INCY.EQ.1 ) )THEN
+            DO 20, J = 1, N
+               IF( ( X( J ).NE.ZERO ).OR.( Y( J ).NE.ZERO ) )THEN
+                  TEMP1 = ALPHA*DCONJG( Y( J ) )
+                  TEMP2 = DCONJG( ALPHA*X( J ) )
+                  DO 10, I = 1, J - 1
+                     A( I, J ) = A( I, J ) + X( I )*TEMP1 + Y( I )*TEMP2
+   10             CONTINUE
+                  A( J, J ) = DBLE( A( J, J ) ) +
+     $                        DBLE( X( J )*TEMP1 + Y( J )*TEMP2 )
+               ELSE
+                  A( J, J ) = DBLE( A( J, J ) )
+               END IF
+   20       CONTINUE
+         ELSE
+            DO 40, J = 1, N
+               IF( ( X( JX ).NE.ZERO ).OR.( Y( JY ).NE.ZERO ) )THEN
+                  TEMP1 = ALPHA*DCONJG( Y( JY ) )
+                  TEMP2 = DCONJG( ALPHA*X( JX ) )
+                  IX    = KX
+                  IY    = KY
+                  DO 30, I = 1, J - 1
+                     A( I, J ) = A( I, J ) + X( IX )*TEMP1
+     $                                     + Y( IY )*TEMP2
+                     IX        = IX        + INCX
+                     IY        = IY        + INCY
+   30             CONTINUE
+                  A( J, J ) = DBLE( A( J, J ) ) +
+     $                        DBLE( X( JX )*TEMP1 + Y( JY )*TEMP2 )
+               ELSE
+                  A( J, J ) = DBLE( A( J, J ) )
+               END IF
+               JX = JX + INCX
+               JY = JY + INCY
+   40       CONTINUE
+         END IF
+      ELSE
+*
+*        Form  A  when A is stored in the lower triangle.
+*
+         IF( ( INCX.EQ.1 ).AND.( INCY.EQ.1 ) )THEN
+            DO 60, J = 1, N
+               IF( ( X( J ).NE.ZERO ).OR.( Y( J ).NE.ZERO ) )THEN
+                  TEMP1     = ALPHA*DCONJG( Y( J ) )
+                  TEMP2     = DCONJG( ALPHA*X( J ) )
+                  A( J, J ) = DBLE( A( J, J ) ) +
+     $                        DBLE( X( J )*TEMP1 + Y( J )*TEMP2 )
+                  DO 50, I = J + 1, N
+                     A( I, J ) = A( I, J ) + X( I )*TEMP1 + Y( I )*TEMP2
+   50             CONTINUE
+               ELSE
+                  A( J, J ) = DBLE( A( J, J ) )
+               END IF
+   60       CONTINUE
+         ELSE
+            DO 80, J = 1, N
+               IF( ( X( JX ).NE.ZERO ).OR.( Y( JY ).NE.ZERO ) )THEN
+                  TEMP1     = ALPHA*DCONJG( Y( JY ) )
+                  TEMP2     = DCONJG( ALPHA*X( JX ) )
+                  A( J, J ) = DBLE( A( J, J ) ) +
+     $                        DBLE( X( JX )*TEMP1 + Y( JY )*TEMP2 )
+                  IX        = JX
+                  IY        = JY
+                  DO 70, I = J + 1, N
+                     IX        = IX        + INCX
+                     IY        = IY        + INCY
+                     A( I, J ) = A( I, J ) + X( IX )*TEMP1
+     $                                     + Y( IY )*TEMP2
+   70             CONTINUE
+               ELSE
+                  A( J, J ) = DBLE( A( J, J ) )
+               END IF
+               JX = JX + INCX
+               JY = JY + INCY
+   80       CONTINUE
+         END IF
+      END IF
+*
+      RETURN
+*
+*     End of ZHER2 .
+*
+      END
diff --git a/src/fortran/blas/zher2k.f b/src/fortran/blas/zher2k.f
new file mode 100644
index 0000000..408d75c
--- /dev/null
+++ b/src/fortran/blas/zher2k.f
@@ -0,0 +1,372 @@
+      SUBROUTINE ZHER2K( UPLO, TRANS, N, K, ALPHA, A, LDA, B, LDB, BETA,
+     $                   C, LDC )
+*     .. Scalar Arguments ..
+      CHARACTER          TRANS, UPLO
+      INTEGER            K, LDA, LDB, LDC, N
+      DOUBLE PRECISION   BETA
+      COMPLEX*16         ALPHA
+*     ..
+*     .. Array Arguments ..
+      COMPLEX*16         A( LDA, * ), B( LDB, * ), C( LDC, * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  ZHER2K  performs one of the hermitian rank 2k operations
+*
+*     C := alpha*A*conjg( B' ) + conjg( alpha )*B*conjg( A' ) + beta*C,
+*
+*  or
+*
+*     C := alpha*conjg( A' )*B + conjg( alpha )*conjg( B' )*A + beta*C,
+*
+*  where  alpha and beta  are scalars with  beta  real,  C is an  n by n
+*  hermitian matrix and  A and B  are  n by k matrices in the first case
+*  and  k by n  matrices in the second case.
+*
+*  Parameters
+*  ==========
+*
+*  UPLO   - CHARACTER*1.
+*           On  entry,   UPLO  specifies  whether  the  upper  or  lower
+*           triangular  part  of the  array  C  is to be  referenced  as
+*           follows:
+*
+*              UPLO = 'U' or 'u'   Only the  upper triangular part of  C
+*                                  is to be referenced.
+*
+*              UPLO = 'L' or 'l'   Only the  lower triangular part of  C
+*                                  is to be referenced.
+*
+*           Unchanged on exit.
+*
+*  TRANS  - CHARACTER*1.
+*           On entry,  TRANS  specifies the operation to be performed as
+*           follows:
+*
+*              TRANS = 'N' or 'n'    C := alpha*A*conjg( B' )          +
+*                                         conjg( alpha )*B*conjg( A' ) +
+*                                         beta*C.
+*
+*              TRANS = 'C' or 'c'    C := alpha*conjg( A' )*B          +
+*                                         conjg( alpha )*conjg( B' )*A +
+*                                         beta*C.
+*
+*           Unchanged on exit.
+*
+*  N      - INTEGER.
+*           On entry,  N specifies the order of the matrix C.  N must be
+*           at least zero.
+*           Unchanged on exit.
+*
+*  K      - INTEGER.
+*           On entry with  TRANS = 'N' or 'n',  K  specifies  the number
+*           of  columns  of the  matrices  A and B,  and on  entry  with
+*           TRANS = 'C' or 'c',  K  specifies  the number of rows of the
+*           matrices  A and B.  K must be at least zero.
+*           Unchanged on exit.
+*
+*  ALPHA  - COMPLEX*16         .
+*           On entry, ALPHA specifies the scalar alpha.
+*           Unchanged on exit.
+*
+*  A      - COMPLEX*16       array of DIMENSION ( LDA, ka ), where ka is
+*           k  when  TRANS = 'N' or 'n',  and is  n  otherwise.
+*           Before entry with  TRANS = 'N' or 'n',  the  leading  n by k
+*           part of the array  A  must contain the matrix  A,  otherwise
+*           the leading  k by n  part of the array  A  must contain  the
+*           matrix A.
+*           Unchanged on exit.
+*
+*  LDA    - INTEGER.
+*           On entry, LDA specifies the first dimension of A as declared
+*           in  the  calling  (sub)  program.   When  TRANS = 'N' or 'n'
+*           then  LDA must be at least  max( 1, n ), otherwise  LDA must
+*           be at least  max( 1, k ).
+*           Unchanged on exit.
+*
+*  B      - COMPLEX*16       array of DIMENSION ( LDB, kb ), where kb is
+*           k  when  TRANS = 'N' or 'n',  and is  n  otherwise.
+*           Before entry with  TRANS = 'N' or 'n',  the  leading  n by k
+*           part of the array  B  must contain the matrix  B,  otherwise
+*           the leading  k by n  part of the array  B  must contain  the
+*           matrix B.
+*           Unchanged on exit.
+*
+*  LDB    - INTEGER.
+*           On entry, LDB specifies the first dimension of B as declared
+*           in  the  calling  (sub)  program.   When  TRANS = 'N' or 'n'
+*           then  LDB must be at least  max( 1, n ), otherwise  LDB must
+*           be at least  max( 1, k ).
+*           Unchanged on exit.
+*
+*  BETA   - DOUBLE PRECISION            .
+*           On entry, BETA specifies the scalar beta.
+*           Unchanged on exit.
+*
+*  C      - COMPLEX*16          array of DIMENSION ( LDC, n ).
+*           Before entry  with  UPLO = 'U' or 'u',  the leading  n by n
+*           upper triangular part of the array C must contain the upper
+*           triangular part  of the  hermitian matrix  and the strictly
+*           lower triangular part of C is not referenced.  On exit, the
+*           upper triangular part of the array  C is overwritten by the
+*           upper triangular part of the updated matrix.
+*           Before entry  with  UPLO = 'L' or 'l',  the leading  n by n
+*           lower triangular part of the array C must contain the lower
+*           triangular part  of the  hermitian matrix  and the strictly
+*           upper triangular part of C is not referenced.  On exit, the
+*           lower triangular part of the array  C is overwritten by the
+*           lower triangular part of the updated matrix.
+*           Note that the imaginary parts of the diagonal elements need
+*           not be set,  they are assumed to be zero,  and on exit they
+*           are set to zero.
+*
+*  LDC    - INTEGER.
+*           On entry, LDC specifies the first dimension of C as declared
+*           in  the  calling  (sub)  program.   LDC  must  be  at  least
+*           max( 1, n ).
+*           Unchanged on exit.
+*
+*
+*  Level 3 Blas routine.
+*
+*  -- Written on 8-February-1989.
+*     Jack Dongarra, Argonne National Laboratory.
+*     Iain Duff, AERE Harwell.
+*     Jeremy Du Croz, Numerical Algorithms Group Ltd.
+*     Sven Hammarling, Numerical Algorithms Group Ltd.
+*
+*  -- Modified 8-Nov-93 to set C(J,J) to DBLE( C(J,J) ) when BETA = 1.
+*     Ed Anderson, Cray Research Inc.
+*
+*
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          DBLE, DCONJG, MAX
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            UPPER
+      INTEGER            I, INFO, J, L, NROWA
+      COMPLEX*16         TEMP1, TEMP2
+*     ..
+*     .. Parameters ..
+      DOUBLE PRECISION   ONE
+      PARAMETER          ( ONE = 1.0D+0 )
+      COMPLEX*16         ZERO
+      PARAMETER          ( ZERO = ( 0.0D+0, 0.0D+0 ) )
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      IF( LSAME( TRANS, 'N' ) ) THEN
+         NROWA = N
+      ELSE
+         NROWA = K
+      END IF
+      UPPER = LSAME( UPLO, 'U' )
+*
+      INFO = 0
+      IF( ( .NOT.UPPER ) .AND. ( .NOT.LSAME( UPLO, 'L' ) ) ) THEN
+         INFO = 1
+      ELSE IF( ( .NOT.LSAME( TRANS, 'N' ) ) .AND.
+     $         ( .NOT.LSAME( TRANS, 'C' ) ) ) THEN
+         INFO = 2
+      ELSE IF( N.LT.0 ) THEN
+         INFO = 3
+      ELSE IF( K.LT.0 ) THEN
+         INFO = 4
+      ELSE IF( LDA.LT.MAX( 1, NROWA ) ) THEN
+         INFO = 7
+      ELSE IF( LDB.LT.MAX( 1, NROWA ) ) THEN
+         INFO = 9
+      ELSE IF( LDC.LT.MAX( 1, N ) ) THEN
+         INFO = 12
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'ZHER2K', INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF( ( N.EQ.0 ) .OR. ( ( ( ALPHA.EQ.ZERO ) .OR. ( K.EQ.0 ) ) .AND.
+     $    ( BETA.EQ.ONE ) ) )RETURN
+*
+*     And when  alpha.eq.zero.
+*
+      IF( ALPHA.EQ.ZERO ) THEN
+         IF( UPPER ) THEN
+            IF( BETA.EQ.DBLE( ZERO ) ) THEN
+               DO 20 J = 1, N
+                  DO 10 I = 1, J
+                     C( I, J ) = ZERO
+   10             CONTINUE
+   20          CONTINUE
+            ELSE
+               DO 40 J = 1, N
+                  DO 30 I = 1, J - 1
+                     C( I, J ) = BETA*C( I, J )
+   30             CONTINUE
+                  C( J, J ) = BETA*DBLE( C( J, J ) )
+   40          CONTINUE
+            END IF
+         ELSE
+            IF( BETA.EQ.DBLE( ZERO ) ) THEN
+               DO 60 J = 1, N
+                  DO 50 I = J, N
+                     C( I, J ) = ZERO
+   50             CONTINUE
+   60          CONTINUE
+            ELSE
+               DO 80 J = 1, N
+                  C( J, J ) = BETA*DBLE( C( J, J ) )
+                  DO 70 I = J + 1, N
+                     C( I, J ) = BETA*C( I, J )
+   70             CONTINUE
+   80          CONTINUE
+            END IF
+         END IF
+         RETURN
+      END IF
+*
+*     Start the operations.
+*
+      IF( LSAME( TRANS, 'N' ) ) THEN
+*
+*        Form  C := alpha*A*conjg( B' ) + conjg( alpha )*B*conjg( A' ) +
+*                   C.
+*
+         IF( UPPER ) THEN
+            DO 130 J = 1, N
+               IF( BETA.EQ.DBLE( ZERO ) ) THEN
+                  DO 90 I = 1, J
+                     C( I, J ) = ZERO
+   90             CONTINUE
+               ELSE IF( BETA.NE.ONE ) THEN
+                  DO 100 I = 1, J - 1
+                     C( I, J ) = BETA*C( I, J )
+  100             CONTINUE
+                  C( J, J ) = BETA*DBLE( C( J, J ) )
+               ELSE
+                  C( J, J ) = DBLE( C( J, J ) )
+               END IF
+               DO 120 L = 1, K
+                  IF( ( A( J, L ).NE.ZERO ) .OR. ( B( J, L ).NE.ZERO ) )
+     $                 THEN
+                     TEMP1 = ALPHA*DCONJG( B( J, L ) )
+                     TEMP2 = DCONJG( ALPHA*A( J, L ) )
+                     DO 110 I = 1, J - 1
+                        C( I, J ) = C( I, J ) + A( I, L )*TEMP1 +
+     $                              B( I, L )*TEMP2
+  110                CONTINUE
+                     C( J, J ) = DBLE( C( J, J ) ) +
+     $                           DBLE( A( J, L )*TEMP1+B( J, L )*TEMP2 )
+                  END IF
+  120          CONTINUE
+  130       CONTINUE
+         ELSE
+            DO 180 J = 1, N
+               IF( BETA.EQ.DBLE( ZERO ) ) THEN
+                  DO 140 I = J, N
+                     C( I, J ) = ZERO
+  140             CONTINUE
+               ELSE IF( BETA.NE.ONE ) THEN
+                  DO 150 I = J + 1, N
+                     C( I, J ) = BETA*C( I, J )
+  150             CONTINUE
+                  C( J, J ) = BETA*DBLE( C( J, J ) )
+               ELSE
+                  C( J, J ) = DBLE( C( J, J ) )
+               END IF
+               DO 170 L = 1, K
+                  IF( ( A( J, L ).NE.ZERO ) .OR. ( B( J, L ).NE.ZERO ) )
+     $                 THEN
+                     TEMP1 = ALPHA*DCONJG( B( J, L ) )
+                     TEMP2 = DCONJG( ALPHA*A( J, L ) )
+                     DO 160 I = J + 1, N
+                        C( I, J ) = C( I, J ) + A( I, L )*TEMP1 +
+     $                              B( I, L )*TEMP2
+  160                CONTINUE
+                     C( J, J ) = DBLE( C( J, J ) ) +
+     $                           DBLE( A( J, L )*TEMP1+B( J, L )*TEMP2 )
+                  END IF
+  170          CONTINUE
+  180       CONTINUE
+         END IF
+      ELSE
+*
+*        Form  C := alpha*conjg( A' )*B + conjg( alpha )*conjg( B' )*A +
+*                   C.
+*
+         IF( UPPER ) THEN
+            DO 210 J = 1, N
+               DO 200 I = 1, J
+                  TEMP1 = ZERO
+                  TEMP2 = ZERO
+                  DO 190 L = 1, K
+                     TEMP1 = TEMP1 + DCONJG( A( L, I ) )*B( L, J )
+                     TEMP2 = TEMP2 + DCONJG( B( L, I ) )*A( L, J )
+  190             CONTINUE
+                  IF( I.EQ.J ) THEN
+                     IF( BETA.EQ.DBLE( ZERO ) ) THEN
+                        C( J, J ) = DBLE( ALPHA*TEMP1+DCONJG( ALPHA )*
+     $                              TEMP2 )
+                     ELSE
+                        C( J, J ) = BETA*DBLE( C( J, J ) ) +
+     $                              DBLE( ALPHA*TEMP1+DCONJG( ALPHA )*
+     $                              TEMP2 )
+                     END IF
+                  ELSE
+                     IF( BETA.EQ.DBLE( ZERO ) ) THEN
+                        C( I, J ) = ALPHA*TEMP1 + DCONJG( ALPHA )*TEMP2
+                     ELSE
+                        C( I, J ) = BETA*C( I, J ) + ALPHA*TEMP1 +
+     $                              DCONJG( ALPHA )*TEMP2
+                     END IF
+                  END IF
+  200          CONTINUE
+  210       CONTINUE
+         ELSE
+            DO 240 J = 1, N
+               DO 230 I = J, N
+                  TEMP1 = ZERO
+                  TEMP2 = ZERO
+                  DO 220 L = 1, K
+                     TEMP1 = TEMP1 + DCONJG( A( L, I ) )*B( L, J )
+                     TEMP2 = TEMP2 + DCONJG( B( L, I ) )*A( L, J )
+  220             CONTINUE
+                  IF( I.EQ.J ) THEN
+                     IF( BETA.EQ.DBLE( ZERO ) ) THEN
+                        C( J, J ) = DBLE( ALPHA*TEMP1+DCONJG( ALPHA )*
+     $                              TEMP2 )
+                     ELSE
+                        C( J, J ) = BETA*DBLE( C( J, J ) ) +
+     $                              DBLE( ALPHA*TEMP1+DCONJG( ALPHA )*
+     $                              TEMP2 )
+                     END IF
+                  ELSE
+                     IF( BETA.EQ.DBLE( ZERO ) ) THEN
+                        C( I, J ) = ALPHA*TEMP1 + DCONJG( ALPHA )*TEMP2
+                     ELSE
+                        C( I, J ) = BETA*C( I, J ) + ALPHA*TEMP1 +
+     $                              DCONJG( ALPHA )*TEMP2
+                     END IF
+                  END IF
+  230          CONTINUE
+  240       CONTINUE
+         END IF
+      END IF
+*
+      RETURN
+*
+*     End of ZHER2K.
+*
+      END
diff --git a/src/fortran/blas/zherk.f b/src/fortran/blas/zherk.f
new file mode 100644
index 0000000..cfbf718
--- /dev/null
+++ b/src/fortran/blas/zherk.f
@@ -0,0 +1,330 @@
+      SUBROUTINE ZHERK( UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C, LDC )
+*     .. Scalar Arguments ..
+      CHARACTER          TRANS, UPLO
+      INTEGER            K, LDA, LDC, N
+      DOUBLE PRECISION   ALPHA, BETA
+*     ..
+*     .. Array Arguments ..
+      COMPLEX*16         A( LDA, * ), C( LDC, * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  ZHERK  performs one of the hermitian rank k operations
+*
+*     C := alpha*A*conjg( A' ) + beta*C,
+*
+*  or
+*
+*     C := alpha*conjg( A' )*A + beta*C,
+*
+*  where  alpha and beta  are  real scalars,  C is an  n by n  hermitian
+*  matrix and  A  is an  n by k  matrix in the  first case and a  k by n
+*  matrix in the second case.
+*
+*  Parameters
+*  ==========
+*
+*  UPLO   - CHARACTER*1.
+*           On  entry,   UPLO  specifies  whether  the  upper  or  lower
+*           triangular  part  of the  array  C  is to be  referenced  as
+*           follows:
+*
+*              UPLO = 'U' or 'u'   Only the  upper triangular part of  C
+*                                  is to be referenced.
+*
+*              UPLO = 'L' or 'l'   Only the  lower triangular part of  C
+*                                  is to be referenced.
+*
+*           Unchanged on exit.
+*
+*  TRANS  - CHARACTER*1.
+*           On entry,  TRANS  specifies the operation to be performed as
+*           follows:
+*
+*              TRANS = 'N' or 'n'   C := alpha*A*conjg( A' ) + beta*C.
+*
+*              TRANS = 'C' or 'c'   C := alpha*conjg( A' )*A + beta*C.
+*
+*           Unchanged on exit.
+*
+*  N      - INTEGER.
+*           On entry,  N specifies the order of the matrix C.  N must be
+*           at least zero.
+*           Unchanged on exit.
+*
+*  K      - INTEGER.
+*           On entry with  TRANS = 'N' or 'n',  K  specifies  the number
+*           of  columns   of  the   matrix   A,   and  on   entry   with
+*           TRANS = 'C' or 'c',  K  specifies  the number of rows of the
+*           matrix A.  K must be at least zero.
+*           Unchanged on exit.
+*
+*  ALPHA  - DOUBLE PRECISION            .
+*           On entry, ALPHA specifies the scalar alpha.
+*           Unchanged on exit.
+*
+*  A      - COMPLEX*16       array of DIMENSION ( LDA, ka ), where ka is
+*           k  when  TRANS = 'N' or 'n',  and is  n  otherwise.
+*           Before entry with  TRANS = 'N' or 'n',  the  leading  n by k
+*           part of the array  A  must contain the matrix  A,  otherwise
+*           the leading  k by n  part of the array  A  must contain  the
+*           matrix A.
+*           Unchanged on exit.
+*
+*  LDA    - INTEGER.
+*           On entry, LDA specifies the first dimension of A as declared
+*           in  the  calling  (sub)  program.   When  TRANS = 'N' or 'n'
+*           then  LDA must be at least  max( 1, n ), otherwise  LDA must
+*           be at least  max( 1, k ).
+*           Unchanged on exit.
+*
+*  BETA   - DOUBLE PRECISION.
+*           On entry, BETA specifies the scalar beta.
+*           Unchanged on exit.
+*
+*  C      - COMPLEX*16          array of DIMENSION ( LDC, n ).
+*           Before entry  with  UPLO = 'U' or 'u',  the leading  n by n
+*           upper triangular part of the array C must contain the upper
+*           triangular part  of the  hermitian matrix  and the strictly
+*           lower triangular part of C is not referenced.  On exit, the
+*           upper triangular part of the array  C is overwritten by the
+*           upper triangular part of the updated matrix.
+*           Before entry  with  UPLO = 'L' or 'l',  the leading  n by n
+*           lower triangular part of the array C must contain the lower
+*           triangular part  of the  hermitian matrix  and the strictly
+*           upper triangular part of C is not referenced.  On exit, the
+*           lower triangular part of the array  C is overwritten by the
+*           lower triangular part of the updated matrix.
+*           Note that the imaginary parts of the diagonal elements need
+*           not be set,  they are assumed to be zero,  and on exit they
+*           are set to zero.
+*
+*  LDC    - INTEGER.
+*           On entry, LDC specifies the first dimension of C as declared
+*           in  the  calling  (sub)  program.   LDC  must  be  at  least
+*           max( 1, n ).
+*           Unchanged on exit.
+*
+*
+*  Level 3 Blas routine.
+*
+*  -- Written on 8-February-1989.
+*     Jack Dongarra, Argonne National Laboratory.
+*     Iain Duff, AERE Harwell.
+*     Jeremy Du Croz, Numerical Algorithms Group Ltd.
+*     Sven Hammarling, Numerical Algorithms Group Ltd.
+*
+*  -- Modified 8-Nov-93 to set C(J,J) to DBLE( C(J,J) ) when BETA = 1.
+*     Ed Anderson, Cray Research Inc.
+*
+*
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          DBLE, DCMPLX, DCONJG, MAX
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            UPPER
+      INTEGER            I, INFO, J, L, NROWA
+      DOUBLE PRECISION   RTEMP
+      COMPLEX*16         TEMP
+*     ..
+*     .. Parameters ..
+      DOUBLE PRECISION   ONE, ZERO
+      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      IF( LSAME( TRANS, 'N' ) ) THEN
+         NROWA = N
+      ELSE
+         NROWA = K
+      END IF
+      UPPER = LSAME( UPLO, 'U' )
+*
+      INFO = 0
+      IF( ( .NOT.UPPER ) .AND. ( .NOT.LSAME( UPLO, 'L' ) ) ) THEN
+         INFO = 1
+      ELSE IF( ( .NOT.LSAME( TRANS, 'N' ) ) .AND.
+     $         ( .NOT.LSAME( TRANS, 'C' ) ) ) THEN
+         INFO = 2
+      ELSE IF( N.LT.0 ) THEN
+         INFO = 3
+      ELSE IF( K.LT.0 ) THEN
+         INFO = 4
+      ELSE IF( LDA.LT.MAX( 1, NROWA ) ) THEN
+         INFO = 7
+      ELSE IF( LDC.LT.MAX( 1, N ) ) THEN
+         INFO = 10
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'ZHERK ', INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF( ( N.EQ.0 ) .OR. ( ( ( ALPHA.EQ.ZERO ) .OR. ( K.EQ.0 ) ) .AND.
+     $    ( BETA.EQ.ONE ) ) )RETURN
+*
+*     And when  alpha.eq.zero.
+*
+      IF( ALPHA.EQ.ZERO ) THEN
+         IF( UPPER ) THEN
+            IF( BETA.EQ.ZERO ) THEN
+               DO 20 J = 1, N
+                  DO 10 I = 1, J
+                     C( I, J ) = ZERO
+   10             CONTINUE
+   20          CONTINUE
+            ELSE
+               DO 40 J = 1, N
+                  DO 30 I = 1, J - 1
+                     C( I, J ) = BETA*C( I, J )
+   30             CONTINUE
+                  C( J, J ) = BETA*DBLE( C( J, J ) )
+   40          CONTINUE
+            END IF
+         ELSE
+            IF( BETA.EQ.ZERO ) THEN
+               DO 60 J = 1, N
+                  DO 50 I = J, N
+                     C( I, J ) = ZERO
+   50             CONTINUE
+   60          CONTINUE
+            ELSE
+               DO 80 J = 1, N
+                  C( J, J ) = BETA*DBLE( C( J, J ) )
+                  DO 70 I = J + 1, N
+                     C( I, J ) = BETA*C( I, J )
+   70             CONTINUE
+   80          CONTINUE
+            END IF
+         END IF
+         RETURN
+      END IF
+*
+*     Start the operations.
+*
+      IF( LSAME( TRANS, 'N' ) ) THEN
+*
+*        Form  C := alpha*A*conjg( A' ) + beta*C.
+*
+         IF( UPPER ) THEN
+            DO 130 J = 1, N
+               IF( BETA.EQ.ZERO ) THEN
+                  DO 90 I = 1, J
+                     C( I, J ) = ZERO
+   90             CONTINUE
+               ELSE IF( BETA.NE.ONE ) THEN
+                  DO 100 I = 1, J - 1
+                     C( I, J ) = BETA*C( I, J )
+  100             CONTINUE
+                  C( J, J ) = BETA*DBLE( C( J, J ) )
+               ELSE
+                  C( J, J ) = DBLE( C( J, J ) )
+               END IF
+               DO 120 L = 1, K
+                  IF( A( J, L ).NE.DCMPLX( ZERO ) ) THEN
+                     TEMP = ALPHA*DCONJG( A( J, L ) )
+                     DO 110 I = 1, J - 1
+                        C( I, J ) = C( I, J ) + TEMP*A( I, L )
+  110                CONTINUE
+                     C( J, J ) = DBLE( C( J, J ) ) +
+     $                           DBLE( TEMP*A( I, L ) )
+                  END IF
+  120          CONTINUE
+  130       CONTINUE
+         ELSE
+            DO 180 J = 1, N
+               IF( BETA.EQ.ZERO ) THEN
+                  DO 140 I = J, N
+                     C( I, J ) = ZERO
+  140             CONTINUE
+               ELSE IF( BETA.NE.ONE ) THEN
+                  C( J, J ) = BETA*DBLE( C( J, J ) )
+                  DO 150 I = J + 1, N
+                     C( I, J ) = BETA*C( I, J )
+  150             CONTINUE
+               ELSE
+                  C( J, J ) = DBLE( C( J, J ) )
+               END IF
+               DO 170 L = 1, K
+                  IF( A( J, L ).NE.DCMPLX( ZERO ) ) THEN
+                     TEMP = ALPHA*DCONJG( A( J, L ) )
+                     C( J, J ) = DBLE( C( J, J ) ) +
+     $                           DBLE( TEMP*A( J, L ) )
+                     DO 160 I = J + 1, N
+                        C( I, J ) = C( I, J ) + TEMP*A( I, L )
+  160                CONTINUE
+                  END IF
+  170          CONTINUE
+  180       CONTINUE
+         END IF
+      ELSE
+*
+*        Form  C := alpha*conjg( A' )*A + beta*C.
+*
+         IF( UPPER ) THEN
+            DO 220 J = 1, N
+               DO 200 I = 1, J - 1
+                  TEMP = ZERO
+                  DO 190 L = 1, K
+                     TEMP = TEMP + DCONJG( A( L, I ) )*A( L, J )
+  190             CONTINUE
+                  IF( BETA.EQ.ZERO ) THEN
+                     C( I, J ) = ALPHA*TEMP
+                  ELSE
+                     C( I, J ) = ALPHA*TEMP + BETA*C( I, J )
+                  END IF
+  200          CONTINUE
+               RTEMP = ZERO
+               DO 210 L = 1, K
+                  RTEMP = RTEMP + DCONJG( A( L, J ) )*A( L, J )
+  210          CONTINUE
+               IF( BETA.EQ.ZERO ) THEN
+                  C( J, J ) = ALPHA*RTEMP
+               ELSE
+                  C( J, J ) = ALPHA*RTEMP + BETA*DBLE( C( J, J ) )
+               END IF
+  220       CONTINUE
+         ELSE
+            DO 260 J = 1, N
+               RTEMP = ZERO
+               DO 230 L = 1, K
+                  RTEMP = RTEMP + DCONJG( A( L, J ) )*A( L, J )
+  230          CONTINUE
+               IF( BETA.EQ.ZERO ) THEN
+                  C( J, J ) = ALPHA*RTEMP
+               ELSE
+                  C( J, J ) = ALPHA*RTEMP + BETA*DBLE( C( J, J ) )
+               END IF
+               DO 250 I = J + 1, N
+                  TEMP = ZERO
+                  DO 240 L = 1, K
+                     TEMP = TEMP + DCONJG( A( L, I ) )*A( L, J )
+  240             CONTINUE
+                  IF( BETA.EQ.ZERO ) THEN
+                     C( I, J ) = ALPHA*TEMP
+                  ELSE
+                     C( I, J ) = ALPHA*TEMP + BETA*C( I, J )
+                  END IF
+  250          CONTINUE
+  260       CONTINUE
+         END IF
+      END IF
+*
+      RETURN
+*
+*     End of ZHERK .
+*
+      END
diff --git a/src/fortran/blas/zhpmv.f b/src/fortran/blas/zhpmv.f
new file mode 100644
index 0000000..9cde923
--- /dev/null
+++ b/src/fortran/blas/zhpmv.f
@@ -0,0 +1,270 @@
+      SUBROUTINE ZHPMV ( UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY )
+*     .. Scalar Arguments ..
+      COMPLEX*16         ALPHA, BETA
+      INTEGER            INCX, INCY, N
+      CHARACTER*1        UPLO
+*     .. Array Arguments ..
+      COMPLEX*16         AP( * ), X( * ), Y( * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  ZHPMV  performs the matrix-vector operation
+*
+*     y := alpha*A*x + beta*y,
+*
+*  where alpha and beta are scalars, x and y are n element vectors and
+*  A is an n by n hermitian matrix, supplied in packed form.
+*
+*  Parameters
+*  ==========
+*
+*  UPLO   - CHARACTER*1.
+*           On entry, UPLO specifies whether the upper or lower
+*           triangular part of the matrix A is supplied in the packed
+*           array AP as follows:
+*
+*              UPLO = 'U' or 'u'   The upper triangular part of A is
+*                                  supplied in AP.
+*
+*              UPLO = 'L' or 'l'   The lower triangular part of A is
+*                                  supplied in AP.
+*
+*           Unchanged on exit.
+*
+*  N      - INTEGER.
+*           On entry, N specifies the order of the matrix A.
+*           N must be at least zero.
+*           Unchanged on exit.
+*
+*  ALPHA  - COMPLEX*16      .
+*           On entry, ALPHA specifies the scalar alpha.
+*           Unchanged on exit.
+*
+*  AP     - COMPLEX*16       array of DIMENSION at least
+*           ( ( n*( n + 1 ) )/2 ).
+*           Before entry with UPLO = 'U' or 'u', the array AP must
+*           contain the upper triangular part of the hermitian matrix
+*           packed sequentially, column by column, so that AP( 1 )
+*           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 )
+*           and a( 2, 2 ) respectively, and so on.
+*           Before entry with UPLO = 'L' or 'l', the array AP must
+*           contain the lower triangular part of the hermitian matrix
+*           packed sequentially, column by column, so that AP( 1 )
+*           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 )
+*           and a( 3, 1 ) respectively, and so on.
+*           Note that the imaginary parts of the diagonal elements need
+*           not be set and are assumed to be zero.
+*           Unchanged on exit.
+*
+*  X      - COMPLEX*16       array of dimension at least
+*           ( 1 + ( n - 1 )*abs( INCX ) ).
+*           Before entry, the incremented array X must contain the n
+*           element vector x.
+*           Unchanged on exit.
+*
+*  INCX   - INTEGER.
+*           On entry, INCX specifies the increment for the elements of
+*           X. INCX must not be zero.
+*           Unchanged on exit.
+*
+*  BETA   - COMPLEX*16      .
+*           On entry, BETA specifies the scalar beta. When BETA is
+*           supplied as zero then Y need not be set on input.
+*           Unchanged on exit.
+*
+*  Y      - COMPLEX*16       array of dimension at least
+*           ( 1 + ( n - 1 )*abs( INCY ) ).
+*           Before entry, the incremented array Y must contain the n
+*           element vector y. On exit, Y is overwritten by the updated
+*           vector y.
+*
+*  INCY   - INTEGER.
+*           On entry, INCY specifies the increment for the elements of
+*           Y. INCY must not be zero.
+*           Unchanged on exit.
+*
+*
+*  Level 2 Blas routine.
+*
+*  -- Written on 22-October-1986.
+*     Jack Dongarra, Argonne National Lab.
+*     Jeremy Du Croz, Nag Central Office.
+*     Sven Hammarling, Nag Central Office.
+*     Richard Hanson, Sandia National Labs.
+*
+*
+*     .. Parameters ..
+      COMPLEX*16         ONE
+      PARAMETER        ( ONE  = ( 1.0D+0, 0.0D+0 ) )
+      COMPLEX*16         ZERO
+      PARAMETER        ( ZERO = ( 0.0D+0, 0.0D+0 ) )
+*     .. Local Scalars ..
+      COMPLEX*16         TEMP1, TEMP2
+      INTEGER            I, INFO, IX, IY, J, JX, JY, K, KK, KX, KY
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA
+*     .. Intrinsic Functions ..
+      INTRINSIC          DCONJG, DBLE
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF     ( .NOT.LSAME( UPLO, 'U' ).AND.
+     $         .NOT.LSAME( UPLO, 'L' )      )THEN
+         INFO = 1
+      ELSE IF( N.LT.0 )THEN
+         INFO = 2
+      ELSE IF( INCX.EQ.0 )THEN
+         INFO = 6
+      ELSE IF( INCY.EQ.0 )THEN
+         INFO = 9
+      END IF
+      IF( INFO.NE.0 )THEN
+         CALL XERBLA( 'ZHPMV ', INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF( ( N.EQ.0 ).OR.( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) ) )
+     $   RETURN
+*
+*     Set up the start points in  X  and  Y.
+*
+      IF( INCX.GT.0 )THEN
+         KX = 1
+      ELSE
+         KX = 1 - ( N - 1 )*INCX
+      END IF
+      IF( INCY.GT.0 )THEN
+         KY = 1
+      ELSE
+         KY = 1 - ( N - 1 )*INCY
+      END IF
+*
+*     Start the operations. In this version the elements of the array AP
+*     are accessed sequentially with one pass through AP.
+*
+*     First form  y := beta*y.
+*
+      IF( BETA.NE.ONE )THEN
+         IF( INCY.EQ.1 )THEN
+            IF( BETA.EQ.ZERO )THEN
+               DO 10, I = 1, N
+                  Y( I ) = ZERO
+   10          CONTINUE
+            ELSE
+               DO 20, I = 1, N
+                  Y( I ) = BETA*Y( I )
+   20          CONTINUE
+            END IF
+         ELSE
+            IY = KY
+            IF( BETA.EQ.ZERO )THEN
+               DO 30, I = 1, N
+                  Y( IY ) = ZERO
+                  IY      = IY   + INCY
+   30          CONTINUE
+            ELSE
+               DO 40, I = 1, N
+                  Y( IY ) = BETA*Y( IY )
+                  IY      = IY           + INCY
+   40          CONTINUE
+            END IF
+         END IF
+      END IF
+      IF( ALPHA.EQ.ZERO )
+     $   RETURN
+      KK = 1
+      IF( LSAME( UPLO, 'U' ) )THEN
+*
+*        Form  y  when AP contains the upper triangle.
+*
+         IF( ( INCX.EQ.1 ).AND.( INCY.EQ.1 ) )THEN
+            DO 60, J = 1, N
+               TEMP1 = ALPHA*X( J )
+               TEMP2 = ZERO
+               K     = KK
+               DO 50, I = 1, J - 1
+                  Y( I ) = Y( I ) + TEMP1*AP( K )
+                  TEMP2  = TEMP2  + DCONJG( AP( K ) )*X( I )
+                  K      = K      + 1
+   50          CONTINUE
+               Y( J ) = Y( J ) + TEMP1*DBLE( AP( KK + J - 1 ) )
+     $                         + ALPHA*TEMP2
+               KK     = KK     + J
+   60       CONTINUE
+         ELSE
+            JX = KX
+            JY = KY
+            DO 80, J = 1, N
+               TEMP1 = ALPHA*X( JX )
+               TEMP2 = ZERO
+               IX    = KX
+               IY    = KY
+               DO 70, K = KK, KK + J - 2
+                  Y( IY ) = Y( IY ) + TEMP1*AP( K )
+                  TEMP2   = TEMP2   + DCONJG( AP( K ) )*X( IX )
+                  IX      = IX      + INCX
+                  IY      = IY      + INCY
+   70          CONTINUE
+               Y( JY ) = Y( JY ) + TEMP1*DBLE( AP( KK + J - 1 ) )
+     $                           + ALPHA*TEMP2
+               JX      = JX      + INCX
+               JY      = JY      + INCY
+               KK      = KK      + J
+   80       CONTINUE
+         END IF
+      ELSE
+*
+*        Form  y  when AP contains the lower triangle.
+*
+         IF( ( INCX.EQ.1 ).AND.( INCY.EQ.1 ) )THEN
+            DO 100, J = 1, N
+               TEMP1  = ALPHA*X( J )
+               TEMP2  = ZERO
+               Y( J ) = Y( J ) + TEMP1*DBLE( AP( KK ) )
+               K      = KK     + 1
+               DO 90, I = J + 1, N
+                  Y( I ) = Y( I ) + TEMP1*AP( K )
+                  TEMP2  = TEMP2  + DCONJG( AP( K ) )*X( I )
+                  K      = K      + 1
+   90          CONTINUE
+               Y( J ) = Y( J ) + ALPHA*TEMP2
+               KK     = KK     + ( N - J + 1 )
+  100       CONTINUE
+         ELSE
+            JX = KX
+            JY = KY
+            DO 120, J = 1, N
+               TEMP1   = ALPHA*X( JX )
+               TEMP2   = ZERO
+               Y( JY ) = Y( JY ) + TEMP1*DBLE( AP( KK ) )
+               IX      = JX
+               IY      = JY
+               DO 110, K = KK + 1, KK + N - J
+                  IX      = IX      + INCX
+                  IY      = IY      + INCY
+                  Y( IY ) = Y( IY ) + TEMP1*AP( K )
+                  TEMP2   = TEMP2   + DCONJG( AP( K ) )*X( IX )
+  110          CONTINUE
+               Y( JY ) = Y( JY ) + ALPHA*TEMP2
+               JX      = JX      + INCX
+               JY      = JY      + INCY
+               KK      = KK      + ( N - J + 1 )
+  120       CONTINUE
+         END IF
+      END IF
+*
+      RETURN
+*
+*     End of ZHPMV .
+*
+      END
diff --git a/src/fortran/blas/zhpr.f b/src/fortran/blas/zhpr.f
new file mode 100644
index 0000000..2e368de
--- /dev/null
+++ b/src/fortran/blas/zhpr.f
@@ -0,0 +1,217 @@
+      SUBROUTINE ZHPR  ( UPLO, N, ALPHA, X, INCX, AP )
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION   ALPHA
+      INTEGER            INCX, N
+      CHARACTER*1        UPLO
+*     .. Array Arguments ..
+      COMPLEX*16         AP( * ), X( * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  ZHPR    performs the hermitian rank 1 operation
+*
+*     A := alpha*x*conjg( x' ) + A,
+*
+*  where alpha is a real scalar, x is an n element vector and A is an
+*  n by n hermitian matrix, supplied in packed form.
+*
+*  Parameters
+*  ==========
+*
+*  UPLO   - CHARACTER*1.
+*           On entry, UPLO specifies whether the upper or lower
+*           triangular part of the matrix A is supplied in the packed
+*           array AP as follows:
+*
+*              UPLO = 'U' or 'u'   The upper triangular part of A is
+*                                  supplied in AP.
+*
+*              UPLO = 'L' or 'l'   The lower triangular part of A is
+*                                  supplied in AP.
+*
+*           Unchanged on exit.
+*
+*  N      - INTEGER.
+*           On entry, N specifies the order of the matrix A.
+*           N must be at least zero.
+*           Unchanged on exit.
+*
+*  ALPHA  - DOUBLE PRECISION.
+*           On entry, ALPHA specifies the scalar alpha.
+*           Unchanged on exit.
+*
+*  X      - COMPLEX*16       array of dimension at least
+*           ( 1 + ( n - 1 )*abs( INCX ) ).
+*           Before entry, the incremented array X must contain the n
+*           element vector x.
+*           Unchanged on exit.
+*
+*  INCX   - INTEGER.
+*           On entry, INCX specifies the increment for the elements of
+*           X. INCX must not be zero.
+*           Unchanged on exit.
+*
+*  AP     - COMPLEX*16       array of DIMENSION at least
+*           ( ( n*( n + 1 ) )/2 ).
+*           Before entry with  UPLO = 'U' or 'u', the array AP must
+*           contain the upper triangular part of the hermitian matrix
+*           packed sequentially, column by column, so that AP( 1 )
+*           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 )
+*           and a( 2, 2 ) respectively, and so on. On exit, the array
+*           AP is overwritten by the upper triangular part of the
+*           updated matrix.
+*           Before entry with UPLO = 'L' or 'l', the array AP must
+*           contain the lower triangular part of the hermitian matrix
+*           packed sequentially, column by column, so that AP( 1 )
+*           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 )
+*           and a( 3, 1 ) respectively, and so on. On exit, the array
+*           AP is overwritten by the lower triangular part of the
+*           updated matrix.
+*           Note that the imaginary parts of the diagonal elements need
+*           not be set, they are assumed to be zero, and on exit they
+*           are set to zero.
+*
+*
+*  Level 2 Blas routine.
+*
+*  -- Written on 22-October-1986.
+*     Jack Dongarra, Argonne National Lab.
+*     Jeremy Du Croz, Nag Central Office.
+*     Sven Hammarling, Nag Central Office.
+*     Richard Hanson, Sandia National Labs.
+*
+*
+*     .. Parameters ..
+      COMPLEX*16         ZERO
+      PARAMETER        ( ZERO = ( 0.0D+0, 0.0D+0 ) )
+*     .. Local Scalars ..
+      COMPLEX*16         TEMP
+      INTEGER            I, INFO, IX, J, JX, K, KK, KX
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA
+*     .. Intrinsic Functions ..
+      INTRINSIC          DCONJG, DBLE
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF     ( .NOT.LSAME( UPLO, 'U' ).AND.
+     $         .NOT.LSAME( UPLO, 'L' )      )THEN
+         INFO = 1
+      ELSE IF( N.LT.0 )THEN
+         INFO = 2
+      ELSE IF( INCX.EQ.0 )THEN
+         INFO = 5
+      END IF
+      IF( INFO.NE.0 )THEN
+         CALL XERBLA( 'ZHPR  ', INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF( ( N.EQ.0 ).OR.( ALPHA.EQ.DBLE( ZERO ) ) )
+     $   RETURN
+*
+*     Set the start point in X if the increment is not unity.
+*
+      IF( INCX.LE.0 )THEN
+         KX = 1 - ( N - 1 )*INCX
+      ELSE IF( INCX.NE.1 )THEN
+         KX = 1
+      END IF
+*
+*     Start the operations. In this version the elements of the array AP
+*     are accessed sequentially with one pass through AP.
+*
+      KK = 1
+      IF( LSAME( UPLO, 'U' ) )THEN
+*
+*        Form  A  when upper triangle is stored in AP.
+*
+         IF( INCX.EQ.1 )THEN
+            DO 20, J = 1, N
+               IF( X( J ).NE.ZERO )THEN
+                  TEMP = ALPHA*DCONJG( X( J ) )
+                  K    = KK
+                  DO 10, I = 1, J - 1
+                     AP( K ) = AP( K ) + X( I )*TEMP
+                     K       = K       + 1
+   10             CONTINUE
+                  AP( KK + J - 1 ) = DBLE( AP( KK + J - 1 ) )
+     $                               + DBLE( X( J )*TEMP )
+               ELSE
+                  AP( KK + J - 1 ) = DBLE( AP( KK + J - 1 ) )
+               END IF
+               KK = KK + J
+   20       CONTINUE
+         ELSE
+            JX = KX
+            DO 40, J = 1, N
+               IF( X( JX ).NE.ZERO )THEN
+                  TEMP = ALPHA*DCONJG( X( JX ) )
+                  IX   = KX
+                  DO 30, K = KK, KK + J - 2
+                     AP( K ) = AP( K ) + X( IX )*TEMP
+                     IX      = IX      + INCX
+   30             CONTINUE
+                  AP( KK + J - 1 ) = DBLE( AP( KK + J - 1 ) )
+     $                               + DBLE( X( JX )*TEMP )
+               ELSE
+                  AP( KK + J - 1 ) = DBLE( AP( KK + J - 1 ) )
+               END IF
+               JX = JX + INCX
+               KK = KK + J
+   40       CONTINUE
+         END IF
+      ELSE
+*
+*        Form  A  when lower triangle is stored in AP.
+*
+         IF( INCX.EQ.1 )THEN
+            DO 60, J = 1, N
+               IF( X( J ).NE.ZERO )THEN
+                  TEMP     = ALPHA*DCONJG( X( J ) )
+                  AP( KK ) = DBLE( AP( KK ) ) + DBLE( TEMP*X( J ) )
+                  K        = KK               + 1
+                  DO 50, I = J + 1, N
+                     AP( K ) = AP( K ) + X( I )*TEMP
+                     K       = K       + 1
+   50             CONTINUE
+               ELSE
+                  AP( KK ) = DBLE( AP( KK ) )
+               END IF
+               KK = KK + N - J + 1
+   60       CONTINUE
+         ELSE
+            JX = KX
+            DO 80, J = 1, N
+               IF( X( JX ).NE.ZERO )THEN
+                  TEMP    = ALPHA*DCONJG( X( JX ) )
+                  AP( KK ) = DBLE( AP( KK ) ) + DBLE( TEMP*X( JX ) )
+                  IX      = JX
+                  DO 70, K = KK + 1, KK + N - J
+                     IX      = IX      + INCX
+                     AP( K ) = AP( K ) + X( IX )*TEMP
+   70             CONTINUE
+               ELSE
+                  AP( KK ) = DBLE( AP( KK ) )
+               END IF
+               JX = JX + INCX
+               KK = KK + N - J + 1
+   80       CONTINUE
+         END IF
+      END IF
+*
+      RETURN
+*
+*     End of ZHPR  .
+*
+      END
diff --git a/src/fortran/blas/zhpr2.f b/src/fortran/blas/zhpr2.f
new file mode 100644
index 0000000..e10774b
--- /dev/null
+++ b/src/fortran/blas/zhpr2.f
@@ -0,0 +1,251 @@
+      SUBROUTINE ZHPR2 ( UPLO, N, ALPHA, X, INCX, Y, INCY, AP )
+*     .. Scalar Arguments ..
+      COMPLEX*16         ALPHA
+      INTEGER            INCX, INCY, N
+      CHARACTER*1        UPLO
+*     .. Array Arguments ..
+      COMPLEX*16         AP( * ), X( * ), Y( * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  ZHPR2  performs the hermitian rank 2 operation
+*
+*     A := alpha*x*conjg( y' ) + conjg( alpha )*y*conjg( x' ) + A,
+*
+*  where alpha is a scalar, x and y are n element vectors and A is an
+*  n by n hermitian matrix, supplied in packed form.
+*
+*  Parameters
+*  ==========
+*
+*  UPLO   - CHARACTER*1.
+*           On entry, UPLO specifies whether the upper or lower
+*           triangular part of the matrix A is supplied in the packed
+*           array AP as follows:
+*
+*              UPLO = 'U' or 'u'   The upper triangular part of A is
+*                                  supplied in AP.
+*
+*              UPLO = 'L' or 'l'   The lower triangular part of A is
+*                                  supplied in AP.
+*
+*           Unchanged on exit.
+*
+*  N      - INTEGER.
+*           On entry, N specifies the order of the matrix A.
+*           N must be at least zero.
+*           Unchanged on exit.
+*
+*  ALPHA  - COMPLEX*16      .
+*           On entry, ALPHA specifies the scalar alpha.
+*           Unchanged on exit.
+*
+*  X      - COMPLEX*16       array of dimension at least
+*           ( 1 + ( n - 1 )*abs( INCX ) ).
+*           Before entry, the incremented array X must contain the n
+*           element vector x.
+*           Unchanged on exit.
+*
+*  INCX   - INTEGER.
+*           On entry, INCX specifies the increment for the elements of
+*           X. INCX must not be zero.
+*           Unchanged on exit.
+*
+*  Y      - COMPLEX*16       array of dimension at least
+*           ( 1 + ( n - 1 )*abs( INCY ) ).
+*           Before entry, the incremented array Y must contain the n
+*           element vector y.
+*           Unchanged on exit.
+*
+*  INCY   - INTEGER.
+*           On entry, INCY specifies the increment for the elements of
+*           Y. INCY must not be zero.
+*           Unchanged on exit.
+*
+*  AP     - COMPLEX*16       array of DIMENSION at least
+*           ( ( n*( n + 1 ) )/2 ).
+*           Before entry with  UPLO = 'U' or 'u', the array AP must
+*           contain the upper triangular part of the hermitian matrix
+*           packed sequentially, column by column, so that AP( 1 )
+*           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 )
+*           and a( 2, 2 ) respectively, and so on. On exit, the array
+*           AP is overwritten by the upper triangular part of the
+*           updated matrix.
+*           Before entry with UPLO = 'L' or 'l', the array AP must
+*           contain the lower triangular part of the hermitian matrix
+*           packed sequentially, column by column, so that AP( 1 )
+*           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 )
+*           and a( 3, 1 ) respectively, and so on. On exit, the array
+*           AP is overwritten by the lower triangular part of the
+*           updated matrix.
+*           Note that the imaginary parts of the diagonal elements need
+*           not be set, they are assumed to be zero, and on exit they
+*           are set to zero.
+*
+*
+*  Level 2 Blas routine.
+*
+*  -- Written on 22-October-1986.
+*     Jack Dongarra, Argonne National Lab.
+*     Jeremy Du Croz, Nag Central Office.
+*     Sven Hammarling, Nag Central Office.
+*     Richard Hanson, Sandia National Labs.
+*
+*
+*     .. Parameters ..
+      COMPLEX*16         ZERO
+      PARAMETER        ( ZERO = ( 0.0D+0, 0.0D+0 ) )
+*     .. Local Scalars ..
+      COMPLEX*16         TEMP1, TEMP2
+      INTEGER            I, INFO, IX, IY, J, JX, JY, K, KK, KX, KY
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA
+*     .. Intrinsic Functions ..
+      INTRINSIC          DCONJG, DBLE
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF     ( .NOT.LSAME( UPLO, 'U' ).AND.
+     $         .NOT.LSAME( UPLO, 'L' )      )THEN
+         INFO = 1
+      ELSE IF( N.LT.0 )THEN
+         INFO = 2
+      ELSE IF( INCX.EQ.0 )THEN
+         INFO = 5
+      ELSE IF( INCY.EQ.0 )THEN
+         INFO = 7
+      END IF
+      IF( INFO.NE.0 )THEN
+         CALL XERBLA( 'ZHPR2 ', INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF( ( N.EQ.0 ).OR.( ALPHA.EQ.ZERO ) )
+     $   RETURN
+*
+*     Set up the start points in X and Y if the increments are not both
+*     unity.
+*
+      IF( ( INCX.NE.1 ).OR.( INCY.NE.1 ) )THEN
+         IF( INCX.GT.0 )THEN
+            KX = 1
+         ELSE
+            KX = 1 - ( N - 1 )*INCX
+         END IF
+         IF( INCY.GT.0 )THEN
+            KY = 1
+         ELSE
+            KY = 1 - ( N - 1 )*INCY
+         END IF
+         JX = KX
+         JY = KY
+      END IF
+*
+*     Start the operations. In this version the elements of the array AP
+*     are accessed sequentially with one pass through AP.
+*
+      KK = 1
+      IF( LSAME( UPLO, 'U' ) )THEN
+*
+*        Form  A  when upper triangle is stored in AP.
+*
+         IF( ( INCX.EQ.1 ).AND.( INCY.EQ.1 ) )THEN
+            DO 20, J = 1, N
+               IF( ( X( J ).NE.ZERO ).OR.( Y( J ).NE.ZERO ) )THEN
+                  TEMP1 = ALPHA*DCONJG( Y( J ) )
+                  TEMP2 = DCONJG( ALPHA*X( J ) )
+                  K     = KK
+                  DO 10, I = 1, J - 1
+                     AP( K ) = AP( K ) + X( I )*TEMP1 + Y( I )*TEMP2
+                     K       = K       + 1
+   10             CONTINUE
+                  AP( KK + J - 1 ) = DBLE( AP( KK + J - 1 ) ) +
+     $                               DBLE( X( J )*TEMP1 + Y( J )*TEMP2 )
+               ELSE
+                  AP( KK + J - 1 ) = DBLE( AP( KK + J - 1 ) )
+               END IF
+               KK = KK + J
+   20       CONTINUE
+         ELSE
+            DO 40, J = 1, N
+               IF( ( X( JX ).NE.ZERO ).OR.( Y( JY ).NE.ZERO ) )THEN
+                  TEMP1 = ALPHA*DCONJG( Y( JY ) )
+                  TEMP2 = DCONJG( ALPHA*X( JX ) )
+                  IX    = KX
+                  IY    = KY
+                  DO 30, K = KK, KK + J - 2
+                     AP( K ) = AP( K ) + X( IX )*TEMP1 + Y( IY )*TEMP2
+                     IX      = IX      + INCX
+                     IY      = IY      + INCY
+   30             CONTINUE
+                  AP( KK + J - 1 ) = DBLE( AP( KK + J - 1 ) ) +
+     $                               DBLE( X( JX )*TEMP1 +
+     $                                     Y( JY )*TEMP2 )
+               ELSE
+                  AP( KK + J - 1 ) = DBLE( AP( KK + J - 1 ) )
+               END IF
+               JX = JX + INCX
+               JY = JY + INCY
+               KK = KK + J
+   40       CONTINUE
+         END IF
+      ELSE
+*
+*        Form  A  when lower triangle is stored in AP.
+*
+         IF( ( INCX.EQ.1 ).AND.( INCY.EQ.1 ) )THEN
+            DO 60, J = 1, N
+               IF( ( X( J ).NE.ZERO ).OR.( Y( J ).NE.ZERO ) )THEN
+                  TEMP1   = ALPHA*DCONJG( Y( J ) )
+                  TEMP2   = DCONJG( ALPHA*X( J ) )
+                  AP( KK ) = DBLE( AP( KK ) ) +
+     $                       DBLE( X( J )*TEMP1 + Y( J )*TEMP2 )
+                  K        = KK               + 1
+                  DO 50, I = J + 1, N
+                     AP( K ) = AP( K ) + X( I )*TEMP1 + Y( I )*TEMP2
+                     K       = K       + 1
+   50             CONTINUE
+               ELSE
+                  AP( KK ) = DBLE( AP( KK ) )
+               END IF
+               KK = KK + N - J + 1
+   60       CONTINUE
+         ELSE
+            DO 80, J = 1, N
+               IF( ( X( JX ).NE.ZERO ).OR.( Y( JY ).NE.ZERO ) )THEN
+                  TEMP1    = ALPHA*DCONJG( Y( JY ) )
+                  TEMP2    = DCONJG( ALPHA*X( JX ) )
+                  AP( KK ) = DBLE( AP( KK ) ) +
+     $                       DBLE( X( JX )*TEMP1 + Y( JY )*TEMP2 )
+                  IX       = JX
+                  IY       = JY
+                  DO 70, K = KK + 1, KK + N - J
+                     IX      = IX      + INCX
+                     IY      = IY      + INCY
+                     AP( K ) = AP( K ) + X( IX )*TEMP1 + Y( IY )*TEMP2
+   70             CONTINUE
+               ELSE
+                  AP( KK ) = DBLE( AP( KK ) )
+               END IF
+               JX = JX + INCX
+               JY = JY + INCY
+               KK = KK + N - J + 1
+   80       CONTINUE
+         END IF
+      END IF
+*
+      RETURN
+*
+*     End of ZHPR2 .
+*
+      END
diff --git a/src/fortran/blas/zrotg.f b/src/fortran/blas/zrotg.f
new file mode 100644
index 0000000..f6a4aa1
--- /dev/null
+++ b/src/fortran/blas/zrotg.f
@@ -0,0 +1,21 @@
+      subroutine zrotg(ca,cb,c,s)
+      double complex ca,cb,s
+      double precision c
+      double precision norm,scale
+      double complex alpha
+      if (cdabs(ca) .ne. 0.0d0) go to 10
+         c = 0.0d0
+         s = (1.0d0,0.0d0)
+         ca = cb
+         go to 20
+   10 continue
+         scale = cdabs(ca) + cdabs(cb)
+         norm = scale*dsqrt((cdabs(ca/dcmplx(scale,0.0d0)))**2 +
+     *                      (cdabs(cb/dcmplx(scale,0.0d0)))**2)
+         alpha = ca /cdabs(ca)
+         c = cdabs(ca) / norm
+         s = alpha * dconjg(cb) / norm
+         ca = alpha * norm
+   20 continue
+      return
+      end
diff --git a/src/fortran/blas/zscal.f b/src/fortran/blas/zscal.f
new file mode 100644
index 0000000..6fa8576
--- /dev/null
+++ b/src/fortran/blas/zscal.f
@@ -0,0 +1,29 @@
+      subroutine  zscal(n,za,zx,incx)
+c
+c     scales a vector by a constant.
+c     jack dongarra, 3/11/78.
+c     modified 3/93 to return if incx .le. 0.
+c     modified 12/3/93, array(1) declarations changed to array(*)
+c
+      double complex za,zx(*)
+      integer i,incx,ix,n
+c
+      if( n.le.0 .or. incx.le.0 )return
+      if(incx.eq.1)go to 20
+c
+c        code for increment not equal to 1
+c
+      ix = 1
+      do 10 i = 1,n
+        zx(ix) = za*zx(ix)
+        ix = ix + incx
+   10 continue
+      return
+c
+c        code for increment equal to 1
+c
+   20 do 30 i = 1,n
+        zx(i) = za*zx(i)
+   30 continue
+      return
+      end
diff --git a/src/fortran/blas/zswap.f b/src/fortran/blas/zswap.f
new file mode 100644
index 0000000..f28a4e4
--- /dev/null
+++ b/src/fortran/blas/zswap.f
@@ -0,0 +1,36 @@
+      subroutine  zswap (n,zx,incx,zy,incy)
+c
+c     interchanges two vectors.
+c     jack dongarra, 3/11/78.
+c     modified 12/3/93, array(1) declarations changed to array(*)
+c
+      double complex zx(*),zy(*),ztemp
+      integer i,incx,incy,ix,iy,n
+c
+      if(n.le.0)return
+      if(incx.eq.1.and.incy.eq.1)go to 20
+c
+c       code for unequal increments or equal increments not equal
+c         to 1
+c
+      ix = 1
+      iy = 1
+      if(incx.lt.0)ix = (-n+1)*incx + 1
+      if(incy.lt.0)iy = (-n+1)*incy + 1
+      do 10 i = 1,n
+        ztemp = zx(ix)
+        zx(ix) = zy(iy)
+        zy(iy) = ztemp
+        ix = ix + incx
+        iy = iy + incy
+   10 continue
+      return
+c
+c       code for both increments equal to 1
+   20 do 30 i = 1,n
+        ztemp = zx(i)
+        zx(i) = zy(i)
+        zy(i) = ztemp
+   30 continue
+      return
+      end
diff --git a/src/fortran/blas/zsymm.f b/src/fortran/blas/zsymm.f
new file mode 100644
index 0000000..20b7c08
--- /dev/null
+++ b/src/fortran/blas/zsymm.f
@@ -0,0 +1,296 @@
+      SUBROUTINE ZSYMM ( SIDE, UPLO, M, N, ALPHA, A, LDA, B, LDB,
+     $                   BETA, C, LDC )
+*     .. Scalar Arguments ..
+      CHARACTER*1        SIDE, UPLO
+      INTEGER            M, N, LDA, LDB, LDC
+      COMPLEX*16         ALPHA, BETA
+*     .. Array Arguments ..
+      COMPLEX*16         A( LDA, * ), B( LDB, * ), C( LDC, * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  ZSYMM  performs one of the matrix-matrix operations
+*
+*     C := alpha*A*B + beta*C,
+*
+*  or
+*
+*     C := alpha*B*A + beta*C,
+*
+*  where  alpha and beta are scalars, A is a symmetric matrix and  B and
+*  C are m by n matrices.
+*
+*  Parameters
+*  ==========
+*
+*  SIDE   - CHARACTER*1.
+*           On entry,  SIDE  specifies whether  the  symmetric matrix  A
+*           appears on the  left or right  in the  operation as follows:
+*
+*              SIDE = 'L' or 'l'   C := alpha*A*B + beta*C,
+*
+*              SIDE = 'R' or 'r'   C := alpha*B*A + beta*C,
+*
+*           Unchanged on exit.
+*
+*  UPLO   - CHARACTER*1.
+*           On  entry,   UPLO  specifies  whether  the  upper  or  lower
+*           triangular  part  of  the  symmetric  matrix   A  is  to  be
+*           referenced as follows:
+*
+*              UPLO = 'U' or 'u'   Only the upper triangular part of the
+*                                  symmetric matrix is to be referenced.
+*
+*              UPLO = 'L' or 'l'   Only the lower triangular part of the
+*                                  symmetric matrix is to be referenced.
+*
+*           Unchanged on exit.
+*
+*  M      - INTEGER.
+*           On entry,  M  specifies the number of rows of the matrix  C.
+*           M  must be at least zero.
+*           Unchanged on exit.
+*
+*  N      - INTEGER.
+*           On entry, N specifies the number of columns of the matrix C.
+*           N  must be at least zero.
+*           Unchanged on exit.
+*
+*  ALPHA  - COMPLEX*16      .
+*           On entry, ALPHA specifies the scalar alpha.
+*           Unchanged on exit.
+*
+*  A      - COMPLEX*16       array of DIMENSION ( LDA, ka ), where ka is
+*           m  when  SIDE = 'L' or 'l'  and is n  otherwise.
+*           Before entry  with  SIDE = 'L' or 'l',  the  m by m  part of
+*           the array  A  must contain the  symmetric matrix,  such that
+*           when  UPLO = 'U' or 'u', the leading m by m upper triangular
+*           part of the array  A  must contain the upper triangular part
+*           of the  symmetric matrix and the  strictly  lower triangular
+*           part of  A  is not referenced,  and when  UPLO = 'L' or 'l',
+*           the leading  m by m  lower triangular part  of the  array  A
+*           must  contain  the  lower triangular part  of the  symmetric
+*           matrix and the  strictly upper triangular part of  A  is not
+*           referenced.
+*           Before entry  with  SIDE = 'R' or 'r',  the  n by n  part of
+*           the array  A  must contain the  symmetric matrix,  such that
+*           when  UPLO = 'U' or 'u', the leading n by n upper triangular
+*           part of the array  A  must contain the upper triangular part
+*           of the  symmetric matrix and the  strictly  lower triangular
+*           part of  A  is not referenced,  and when  UPLO = 'L' or 'l',
+*           the leading  n by n  lower triangular part  of the  array  A
+*           must  contain  the  lower triangular part  of the  symmetric
+*           matrix and the  strictly upper triangular part of  A  is not
+*           referenced.
+*           Unchanged on exit.
+*
+*  LDA    - INTEGER.
+*           On entry, LDA specifies the first dimension of A as declared
+*           in the  calling (sub) program. When  SIDE = 'L' or 'l'  then
+*           LDA must be at least  max( 1, m ), otherwise  LDA must be at
+*           least max( 1, n ).
+*           Unchanged on exit.
+*
+*  B      - COMPLEX*16       array of DIMENSION ( LDB, n ).
+*           Before entry, the leading  m by n part of the array  B  must
+*           contain the matrix B.
+*           Unchanged on exit.
+*
+*  LDB    - INTEGER.
+*           On entry, LDB specifies the first dimension of B as declared
+*           in  the  calling  (sub)  program.   LDB  must  be  at  least
+*           max( 1, m ).
+*           Unchanged on exit.
+*
+*  BETA   - COMPLEX*16      .
+*           On entry,  BETA  specifies the scalar  beta.  When  BETA  is
+*           supplied as zero then C need not be set on input.
+*           Unchanged on exit.
+*
+*  C      - COMPLEX*16       array of DIMENSION ( LDC, n ).
+*           Before entry, the leading  m by n  part of the array  C must
+*           contain the matrix  C,  except when  beta  is zero, in which
+*           case C need not be set on entry.
+*           On exit, the array  C  is overwritten by the  m by n updated
+*           matrix.
+*
+*  LDC    - INTEGER.
+*           On entry, LDC specifies the first dimension of C as declared
+*           in  the  calling  (sub)  program.   LDC  must  be  at  least
+*           max( 1, m ).
+*           Unchanged on exit.
+*
+*
+*  Level 3 Blas routine.
+*
+*  -- Written on 8-February-1989.
+*     Jack Dongarra, Argonne National Laboratory.
+*     Iain Duff, AERE Harwell.
+*     Jeremy Du Croz, Numerical Algorithms Group Ltd.
+*     Sven Hammarling, Numerical Algorithms Group Ltd.
+*
+*
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     .. Local Scalars ..
+      LOGICAL            UPPER
+      INTEGER            I, INFO, J, K, NROWA
+      COMPLEX*16         TEMP1, TEMP2
+*     .. Parameters ..
+      COMPLEX*16         ONE
+      PARAMETER        ( ONE  = ( 1.0D+0, 0.0D+0 ) )
+      COMPLEX*16         ZERO
+      PARAMETER        ( ZERO = ( 0.0D+0, 0.0D+0 ) )
+*     ..
+*     .. Executable Statements ..
+*
+*     Set NROWA as the number of rows of A.
+*
+      IF( LSAME( SIDE, 'L' ) )THEN
+         NROWA = M
+      ELSE
+         NROWA = N
+      END IF
+      UPPER = LSAME( UPLO, 'U' )
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF(      ( .NOT.LSAME( SIDE, 'L' ) ).AND.
+     $         ( .NOT.LSAME( SIDE, 'R' ) )      )THEN
+         INFO = 1
+      ELSE IF( ( .NOT.UPPER              ).AND.
+     $         ( .NOT.LSAME( UPLO, 'L' ) )      )THEN
+         INFO = 2
+      ELSE IF( M  .LT.0               )THEN
+         INFO = 3
+      ELSE IF( N  .LT.0               )THEN
+         INFO = 4
+      ELSE IF( LDA.LT.MAX( 1, NROWA ) )THEN
+         INFO = 7
+      ELSE IF( LDB.LT.MAX( 1, M     ) )THEN
+         INFO = 9
+      ELSE IF( LDC.LT.MAX( 1, M     ) )THEN
+         INFO = 12
+      END IF
+      IF( INFO.NE.0 )THEN
+         CALL XERBLA( 'ZSYMM ', INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF( ( M.EQ.0 ).OR.( N.EQ.0 ).OR.
+     $    ( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) ) )
+     $   RETURN
+*
+*     And when  alpha.eq.zero.
+*
+      IF( ALPHA.EQ.ZERO )THEN
+         IF( BETA.EQ.ZERO )THEN
+            DO 20, J = 1, N
+               DO 10, I = 1, M
+                  C( I, J ) = ZERO
+   10          CONTINUE
+   20       CONTINUE
+         ELSE
+            DO 40, J = 1, N
+               DO 30, I = 1, M
+                  C( I, J ) = BETA*C( I, J )
+   30          CONTINUE
+   40       CONTINUE
+         END IF
+         RETURN
+      END IF
+*
+*     Start the operations.
+*
+      IF( LSAME( SIDE, 'L' ) )THEN
+*
+*        Form  C := alpha*A*B + beta*C.
+*
+         IF( UPPER )THEN
+            DO 70, J = 1, N
+               DO 60, I = 1, M
+                  TEMP1 = ALPHA*B( I, J )
+                  TEMP2 = ZERO
+                  DO 50, K = 1, I - 1
+                     C( K, J ) = C( K, J ) + TEMP1    *A( K, I )
+                     TEMP2     = TEMP2     + B( K, J )*A( K, I )
+   50             CONTINUE
+                  IF( BETA.EQ.ZERO )THEN
+                     C( I, J ) = TEMP1*A( I, I ) + ALPHA*TEMP2
+                  ELSE
+                     C( I, J ) = BETA *C( I, J ) +
+     $                           TEMP1*A( I, I ) + ALPHA*TEMP2
+                  END IF
+   60          CONTINUE
+   70       CONTINUE
+         ELSE
+            DO 100, J = 1, N
+               DO 90, I = M, 1, -1
+                  TEMP1 = ALPHA*B( I, J )
+                  TEMP2 = ZERO
+                  DO 80, K = I + 1, M
+                     C( K, J ) = C( K, J ) + TEMP1    *A( K, I )
+                     TEMP2     = TEMP2     + B( K, J )*A( K, I )
+   80             CONTINUE
+                  IF( BETA.EQ.ZERO )THEN
+                     C( I, J ) = TEMP1*A( I, I ) + ALPHA*TEMP2
+                  ELSE
+                     C( I, J ) = BETA *C( I, J ) +
+     $                           TEMP1*A( I, I ) + ALPHA*TEMP2
+                  END IF
+   90          CONTINUE
+  100       CONTINUE
+         END IF
+      ELSE
+*
+*        Form  C := alpha*B*A + beta*C.
+*
+         DO 170, J = 1, N
+            TEMP1 = ALPHA*A( J, J )
+            IF( BETA.EQ.ZERO )THEN
+               DO 110, I = 1, M
+                  C( I, J ) = TEMP1*B( I, J )
+  110          CONTINUE
+            ELSE
+               DO 120, I = 1, M
+                  C( I, J ) = BETA*C( I, J ) + TEMP1*B( I, J )
+  120          CONTINUE
+            END IF
+            DO 140, K = 1, J - 1
+               IF( UPPER )THEN
+                  TEMP1 = ALPHA*A( K, J )
+               ELSE
+                  TEMP1 = ALPHA*A( J, K )
+               END IF
+               DO 130, I = 1, M
+                  C( I, J ) = C( I, J ) + TEMP1*B( I, K )
+  130          CONTINUE
+  140       CONTINUE
+            DO 160, K = J + 1, N
+               IF( UPPER )THEN
+                  TEMP1 = ALPHA*A( J, K )
+               ELSE
+                  TEMP1 = ALPHA*A( K, J )
+               END IF
+               DO 150, I = 1, M
+                  C( I, J ) = C( I, J ) + TEMP1*B( I, K )
+  150          CONTINUE
+  160       CONTINUE
+  170    CONTINUE
+      END IF
+*
+      RETURN
+*
+*     End of ZSYMM .
+*
+      END
diff --git a/src/fortran/blas/zsyr2k.f b/src/fortran/blas/zsyr2k.f
new file mode 100644
index 0000000..aba2071
--- /dev/null
+++ b/src/fortran/blas/zsyr2k.f
@@ -0,0 +1,324 @@
+      SUBROUTINE ZSYR2K( UPLO, TRANS, N, K, ALPHA, A, LDA, B, LDB,
+     $                   BETA, C, LDC )
+*     .. Scalar Arguments ..
+      CHARACTER*1        UPLO, TRANS
+      INTEGER            N, K, LDA, LDB, LDC
+      COMPLEX*16         ALPHA, BETA
+*     .. Array Arguments ..
+      COMPLEX*16         A( LDA, * ), B( LDB, * ), C( LDC, * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  ZSYR2K  performs one of the symmetric rank 2k operations
+*
+*     C := alpha*A*B' + alpha*B*A' + beta*C,
+*
+*  or
+*
+*     C := alpha*A'*B + alpha*B'*A + beta*C,
+*
+*  where  alpha and beta  are scalars,  C is an  n by n symmetric matrix
+*  and  A and B  are  n by k  matrices  in the  first  case  and  k by n
+*  matrices in the second case.
+*
+*  Parameters
+*  ==========
+*
+*  UPLO   - CHARACTER*1.
+*           On  entry,   UPLO  specifies  whether  the  upper  or  lower
+*           triangular  part  of the  array  C  is to be  referenced  as
+*           follows:
+*
+*              UPLO = 'U' or 'u'   Only the  upper triangular part of  C
+*                                  is to be referenced.
+*
+*              UPLO = 'L' or 'l'   Only the  lower triangular part of  C
+*                                  is to be referenced.
+*
+*           Unchanged on exit.
+*
+*  TRANS  - CHARACTER*1.
+*           On entry,  TRANS  specifies the operation to be performed as
+*           follows:
+*
+*              TRANS = 'N' or 'n'    C := alpha*A*B' + alpha*B*A' +
+*                                         beta*C.
+*
+*              TRANS = 'T' or 't'    C := alpha*A'*B + alpha*B'*A +
+*                                         beta*C.
+*
+*           Unchanged on exit.
+*
+*  N      - INTEGER.
+*           On entry,  N specifies the order of the matrix C.  N must be
+*           at least zero.
+*           Unchanged on exit.
+*
+*  K      - INTEGER.
+*           On entry with  TRANS = 'N' or 'n',  K  specifies  the number
+*           of  columns  of the  matrices  A and B,  and on  entry  with
+*           TRANS = 'T' or 't',  K  specifies  the number of rows of the
+*           matrices  A and B.  K must be at least zero.
+*           Unchanged on exit.
+*
+*  ALPHA  - COMPLEX*16      .
+*           On entry, ALPHA specifies the scalar alpha.
+*           Unchanged on exit.
+*
+*  A      - COMPLEX*16       array of DIMENSION ( LDA, ka ), where ka is
+*           k  when  TRANS = 'N' or 'n',  and is  n  otherwise.
+*           Before entry with  TRANS = 'N' or 'n',  the  leading  n by k
+*           part of the array  A  must contain the matrix  A,  otherwise
+*           the leading  k by n  part of the array  A  must contain  the
+*           matrix A.
+*           Unchanged on exit.
+*
+*  LDA    - INTEGER.
+*           On entry, LDA specifies the first dimension of A as declared
+*           in  the  calling  (sub)  program.   When  TRANS = 'N' or 'n'
+*           then  LDA must be at least  max( 1, n ), otherwise  LDA must
+*           be at least  max( 1, k ).
+*           Unchanged on exit.
+*
+*  B      - COMPLEX*16       array of DIMENSION ( LDB, kb ), where kb is
+*           k  when  TRANS = 'N' or 'n',  and is  n  otherwise.
+*           Before entry with  TRANS = 'N' or 'n',  the  leading  n by k
+*           part of the array  B  must contain the matrix  B,  otherwise
+*           the leading  k by n  part of the array  B  must contain  the
+*           matrix B.
+*           Unchanged on exit.
+*
+*  LDB    - INTEGER.
+*           On entry, LDB specifies the first dimension of B as declared
+*           in  the  calling  (sub)  program.   When  TRANS = 'N' or 'n'
+*           then  LDB must be at least  max( 1, n ), otherwise  LDB must
+*           be at least  max( 1, k ).
+*           Unchanged on exit.
+*
+*  BETA   - COMPLEX*16      .
+*           On entry, BETA specifies the scalar beta.
+*           Unchanged on exit.
+*
+*  C      - COMPLEX*16       array of DIMENSION ( LDC, n ).
+*           Before entry  with  UPLO = 'U' or 'u',  the leading  n by n
+*           upper triangular part of the array C must contain the upper
+*           triangular part  of the  symmetric matrix  and the strictly
+*           lower triangular part of C is not referenced.  On exit, the
+*           upper triangular part of the array  C is overwritten by the
+*           upper triangular part of the updated matrix.
+*           Before entry  with  UPLO = 'L' or 'l',  the leading  n by n
+*           lower triangular part of the array C must contain the lower
+*           triangular part  of the  symmetric matrix  and the strictly
+*           upper triangular part of C is not referenced.  On exit, the
+*           lower triangular part of the array  C is overwritten by the
+*           lower triangular part of the updated matrix.
+*
+*  LDC    - INTEGER.
+*           On entry, LDC specifies the first dimension of C as declared
+*           in  the  calling  (sub)  program.   LDC  must  be  at  least
+*           max( 1, n ).
+*           Unchanged on exit.
+*
+*
+*  Level 3 Blas routine.
+*
+*  -- Written on 8-February-1989.
+*     Jack Dongarra, Argonne National Laboratory.
+*     Iain Duff, AERE Harwell.
+*     Jeremy Du Croz, Numerical Algorithms Group Ltd.
+*     Sven Hammarling, Numerical Algorithms Group Ltd.
+*
+*
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     .. Local Scalars ..
+      LOGICAL            UPPER
+      INTEGER            I, INFO, J, L, NROWA
+      COMPLEX*16         TEMP1, TEMP2
+*     .. Parameters ..
+      COMPLEX*16         ONE
+      PARAMETER        ( ONE  = ( 1.0D+0, 0.0D+0 ) )
+      COMPLEX*16         ZERO
+      PARAMETER        ( ZERO = ( 0.0D+0, 0.0D+0 ) )
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      IF( LSAME( TRANS, 'N' ) )THEN
+         NROWA = N
+      ELSE
+         NROWA = K
+      END IF
+      UPPER = LSAME( UPLO, 'U' )
+*
+      INFO = 0
+      IF(      ( .NOT.UPPER               ).AND.
+     $         ( .NOT.LSAME( UPLO , 'L' ) )      )THEN
+         INFO = 1
+      ELSE IF( ( .NOT.LSAME( TRANS, 'N' ) ).AND.
+     $         ( .NOT.LSAME( TRANS, 'T' ) )      )THEN
+         INFO = 2
+      ELSE IF( N  .LT.0               )THEN
+         INFO = 3
+      ELSE IF( K  .LT.0               )THEN
+         INFO = 4
+      ELSE IF( LDA.LT.MAX( 1, NROWA ) )THEN
+         INFO = 7
+      ELSE IF( LDB.LT.MAX( 1, NROWA ) )THEN
+         INFO = 9
+      ELSE IF( LDC.LT.MAX( 1, N     ) )THEN
+         INFO = 12
+      END IF
+      IF( INFO.NE.0 )THEN
+         CALL XERBLA( 'ZSYR2K', INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF( ( N.EQ.0 ).OR.
+     $    ( ( ( ALPHA.EQ.ZERO ).OR.( K.EQ.0 ) ).AND.( BETA.EQ.ONE ) ) )
+     $   RETURN
+*
+*     And when  alpha.eq.zero.
+*
+      IF( ALPHA.EQ.ZERO )THEN
+         IF( UPPER )THEN
+            IF( BETA.EQ.ZERO )THEN
+               DO 20, J = 1, N
+                  DO 10, I = 1, J
+                     C( I, J ) = ZERO
+   10             CONTINUE
+   20          CONTINUE
+            ELSE
+               DO 40, J = 1, N
+                  DO 30, I = 1, J
+                     C( I, J ) = BETA*C( I, J )
+   30             CONTINUE
+   40          CONTINUE
+            END IF
+         ELSE
+            IF( BETA.EQ.ZERO )THEN
+               DO 60, J = 1, N
+                  DO 50, I = J, N
+                     C( I, J ) = ZERO
+   50             CONTINUE
+   60          CONTINUE
+            ELSE
+               DO 80, J = 1, N
+                  DO 70, I = J, N
+                     C( I, J ) = BETA*C( I, J )
+   70             CONTINUE
+   80          CONTINUE
+            END IF
+         END IF
+         RETURN
+      END IF
+*
+*     Start the operations.
+*
+      IF( LSAME( TRANS, 'N' ) )THEN
+*
+*        Form  C := alpha*A*B' + alpha*B*A' + C.
+*
+         IF( UPPER )THEN
+            DO 130, J = 1, N
+               IF( BETA.EQ.ZERO )THEN
+                  DO 90, I = 1, J
+                     C( I, J ) = ZERO
+   90             CONTINUE
+               ELSE IF( BETA.NE.ONE )THEN
+                  DO 100, I = 1, J
+                     C( I, J ) = BETA*C( I, J )
+  100             CONTINUE
+               END IF
+               DO 120, L = 1, K
+                  IF( ( A( J, L ).NE.ZERO ).OR.
+     $                ( B( J, L ).NE.ZERO )     )THEN
+                     TEMP1 = ALPHA*B( J, L )
+                     TEMP2 = ALPHA*A( J, L )
+                     DO 110, I = 1, J
+                        C( I, J ) = C( I, J ) + A( I, L )*TEMP1 +
+     $                                          B( I, L )*TEMP2
+  110                CONTINUE
+                  END IF
+  120          CONTINUE
+  130       CONTINUE
+         ELSE
+            DO 180, J = 1, N
+               IF( BETA.EQ.ZERO )THEN
+                  DO 140, I = J, N
+                     C( I, J ) = ZERO
+  140             CONTINUE
+               ELSE IF( BETA.NE.ONE )THEN
+                  DO 150, I = J, N
+                     C( I, J ) = BETA*C( I, J )
+  150             CONTINUE
+               END IF
+               DO 170, L = 1, K
+                  IF( ( A( J, L ).NE.ZERO ).OR.
+     $                ( B( J, L ).NE.ZERO )     )THEN
+                     TEMP1 = ALPHA*B( J, L )
+                     TEMP2 = ALPHA*A( J, L )
+                     DO 160, I = J, N
+                        C( I, J ) = C( I, J ) + A( I, L )*TEMP1 +
+     $                                          B( I, L )*TEMP2
+  160                CONTINUE
+                  END IF
+  170          CONTINUE
+  180       CONTINUE
+         END IF
+      ELSE
+*
+*        Form  C := alpha*A'*B + alpha*B'*A + C.
+*
+         IF( UPPER )THEN
+            DO 210, J = 1, N
+               DO 200, I = 1, J
+                  TEMP1 = ZERO
+                  TEMP2 = ZERO
+                  DO 190, L = 1, K
+                     TEMP1 = TEMP1 + A( L, I )*B( L, J )
+                     TEMP2 = TEMP2 + B( L, I )*A( L, J )
+  190             CONTINUE
+                  IF( BETA.EQ.ZERO )THEN
+                     C( I, J ) = ALPHA*TEMP1 + ALPHA*TEMP2
+                  ELSE
+                     C( I, J ) = BETA *C( I, J ) +
+     $                           ALPHA*TEMP1 + ALPHA*TEMP2
+                  END IF
+  200          CONTINUE
+  210       CONTINUE
+         ELSE
+            DO 240, J = 1, N
+               DO 230, I = J, N
+                  TEMP1 = ZERO
+                  TEMP2 = ZERO
+                  DO 220, L = 1, K
+                     TEMP1 = TEMP1 + A( L, I )*B( L, J )
+                     TEMP2 = TEMP2 + B( L, I )*A( L, J )
+  220             CONTINUE
+                  IF( BETA.EQ.ZERO )THEN
+                     C( I, J ) = ALPHA*TEMP1 + ALPHA*TEMP2
+                  ELSE
+                     C( I, J ) = BETA *C( I, J ) +
+     $                           ALPHA*TEMP1 + ALPHA*TEMP2
+                  END IF
+  230          CONTINUE
+  240       CONTINUE
+         END IF
+      END IF
+*
+      RETURN
+*
+*     End of ZSYR2K.
+*
+      END
diff --git a/src/fortran/blas/zsyrk.f b/src/fortran/blas/zsyrk.f
new file mode 100644
index 0000000..77e2c20
--- /dev/null
+++ b/src/fortran/blas/zsyrk.f
@@ -0,0 +1,293 @@
+      SUBROUTINE ZSYRK ( UPLO, TRANS, N, K, ALPHA, A, LDA,
+     $                   BETA, C, LDC )
+*     .. Scalar Arguments ..
+      CHARACTER*1        UPLO, TRANS
+      INTEGER            N, K, LDA, LDC
+      COMPLEX*16         ALPHA, BETA
+*     .. Array Arguments ..
+      COMPLEX*16         A( LDA, * ), C( LDC, * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  ZSYRK  performs one of the symmetric rank k operations
+*
+*     C := alpha*A*A' + beta*C,
+*
+*  or
+*
+*     C := alpha*A'*A + beta*C,
+*
+*  where  alpha and beta  are scalars,  C is an  n by n symmetric matrix
+*  and  A  is an  n by k  matrix in the first case and a  k by n  matrix
+*  in the second case.
+*
+*  Parameters
+*  ==========
+*
+*  UPLO   - CHARACTER*1.
+*           On  entry,   UPLO  specifies  whether  the  upper  or  lower
+*           triangular  part  of the  array  C  is to be  referenced  as
+*           follows:
+*
+*              UPLO = 'U' or 'u'   Only the  upper triangular part of  C
+*                                  is to be referenced.
+*
+*              UPLO = 'L' or 'l'   Only the  lower triangular part of  C
+*                                  is to be referenced.
+*
+*           Unchanged on exit.
+*
+*  TRANS  - CHARACTER*1.
+*           On entry,  TRANS  specifies the operation to be performed as
+*           follows:
+*
+*              TRANS = 'N' or 'n'   C := alpha*A*A' + beta*C.
+*
+*              TRANS = 'T' or 't'   C := alpha*A'*A + beta*C.
+*
+*           Unchanged on exit.
+*
+*  N      - INTEGER.
+*           On entry,  N specifies the order of the matrix C.  N must be
+*           at least zero.
+*           Unchanged on exit.
+*
+*  K      - INTEGER.
+*           On entry with  TRANS = 'N' or 'n',  K  specifies  the number
+*           of  columns   of  the   matrix   A,   and  on   entry   with
+*           TRANS = 'T' or 't',  K  specifies  the number of rows of the
+*           matrix A.  K must be at least zero.
+*           Unchanged on exit.
+*
+*  ALPHA  - COMPLEX*16      .
+*           On entry, ALPHA specifies the scalar alpha.
+*           Unchanged on exit.
+*
+*  A      - COMPLEX*16       array of DIMENSION ( LDA, ka ), where ka is
+*           k  when  TRANS = 'N' or 'n',  and is  n  otherwise.
+*           Before entry with  TRANS = 'N' or 'n',  the  leading  n by k
+*           part of the array  A  must contain the matrix  A,  otherwise
+*           the leading  k by n  part of the array  A  must contain  the
+*           matrix A.
+*           Unchanged on exit.
+*
+*  LDA    - INTEGER.
+*           On entry, LDA specifies the first dimension of A as declared
+*           in  the  calling  (sub)  program.   When  TRANS = 'N' or 'n'
+*           then  LDA must be at least  max( 1, n ), otherwise  LDA must
+*           be at least  max( 1, k ).
+*           Unchanged on exit.
+*
+*  BETA   - COMPLEX*16      .
+*           On entry, BETA specifies the scalar beta.
+*           Unchanged on exit.
+*
+*  C      - COMPLEX*16       array of DIMENSION ( LDC, n ).
+*           Before entry  with  UPLO = 'U' or 'u',  the leading  n by n
+*           upper triangular part of the array C must contain the upper
+*           triangular part  of the  symmetric matrix  and the strictly
+*           lower triangular part of C is not referenced.  On exit, the
+*           upper triangular part of the array  C is overwritten by the
+*           upper triangular part of the updated matrix.
+*           Before entry  with  UPLO = 'L' or 'l',  the leading  n by n
+*           lower triangular part of the array C must contain the lower
+*           triangular part  of the  symmetric matrix  and the strictly
+*           upper triangular part of C is not referenced.  On exit, the
+*           lower triangular part of the array  C is overwritten by the
+*           lower triangular part of the updated matrix.
+*
+*  LDC    - INTEGER.
+*           On entry, LDC specifies the first dimension of C as declared
+*           in  the  calling  (sub)  program.   LDC  must  be  at  least
+*           max( 1, n ).
+*           Unchanged on exit.
+*
+*
+*  Level 3 Blas routine.
+*
+*  -- Written on 8-February-1989.
+*     Jack Dongarra, Argonne National Laboratory.
+*     Iain Duff, AERE Harwell.
+*     Jeremy Du Croz, Numerical Algorithms Group Ltd.
+*     Sven Hammarling, Numerical Algorithms Group Ltd.
+*
+*
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     .. Local Scalars ..
+      LOGICAL            UPPER
+      INTEGER            I, INFO, J, L, NROWA
+      COMPLEX*16         TEMP
+*     .. Parameters ..
+      COMPLEX*16         ONE
+      PARAMETER        ( ONE  = ( 1.0D+0, 0.0D+0 ) )
+      COMPLEX*16         ZERO
+      PARAMETER        ( ZERO = ( 0.0D+0, 0.0D+0 ) )
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      IF( LSAME( TRANS, 'N' ) )THEN
+         NROWA = N
+      ELSE
+         NROWA = K
+      END IF
+      UPPER = LSAME( UPLO, 'U' )
+*
+      INFO = 0
+      IF(      ( .NOT.UPPER               ).AND.
+     $         ( .NOT.LSAME( UPLO , 'L' ) )      )THEN
+         INFO = 1
+      ELSE IF( ( .NOT.LSAME( TRANS, 'N' ) ).AND.
+     $         ( .NOT.LSAME( TRANS, 'T' ) )      )THEN
+         INFO = 2
+      ELSE IF( N  .LT.0               )THEN
+         INFO = 3
+      ELSE IF( K  .LT.0               )THEN
+         INFO = 4
+      ELSE IF( LDA.LT.MAX( 1, NROWA ) )THEN
+         INFO = 7
+      ELSE IF( LDC.LT.MAX( 1, N     ) )THEN
+         INFO = 10
+      END IF
+      IF( INFO.NE.0 )THEN
+         CALL XERBLA( 'ZSYRK ', INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF( ( N.EQ.0 ).OR.
+     $    ( ( ( ALPHA.EQ.ZERO ).OR.( K.EQ.0 ) ).AND.( BETA.EQ.ONE ) ) )
+     $   RETURN
+*
+*     And when  alpha.eq.zero.
+*
+      IF( ALPHA.EQ.ZERO )THEN
+         IF( UPPER )THEN
+            IF( BETA.EQ.ZERO )THEN
+               DO 20, J = 1, N
+                  DO 10, I = 1, J
+                     C( I, J ) = ZERO
+   10             CONTINUE
+   20          CONTINUE
+            ELSE
+               DO 40, J = 1, N
+                  DO 30, I = 1, J
+                     C( I, J ) = BETA*C( I, J )
+   30             CONTINUE
+   40          CONTINUE
+            END IF
+         ELSE
+            IF( BETA.EQ.ZERO )THEN
+               DO 60, J = 1, N
+                  DO 50, I = J, N
+                     C( I, J ) = ZERO
+   50             CONTINUE
+   60          CONTINUE
+            ELSE
+               DO 80, J = 1, N
+                  DO 70, I = J, N
+                     C( I, J ) = BETA*C( I, J )
+   70             CONTINUE
+   80          CONTINUE
+            END IF
+         END IF
+         RETURN
+      END IF
+*
+*     Start the operations.
+*
+      IF( LSAME( TRANS, 'N' ) )THEN
+*
+*        Form  C := alpha*A*A' + beta*C.
+*
+         IF( UPPER )THEN
+            DO 130, J = 1, N
+               IF( BETA.EQ.ZERO )THEN
+                  DO 90, I = 1, J
+                     C( I, J ) = ZERO
+   90             CONTINUE
+               ELSE IF( BETA.NE.ONE )THEN
+                  DO 100, I = 1, J
+                     C( I, J ) = BETA*C( I, J )
+  100             CONTINUE
+               END IF
+               DO 120, L = 1, K
+                  IF( A( J, L ).NE.ZERO )THEN
+                     TEMP = ALPHA*A( J, L )
+                     DO 110, I = 1, J
+                        C( I, J ) = C( I, J ) + TEMP*A( I, L )
+  110                CONTINUE
+                  END IF
+  120          CONTINUE
+  130       CONTINUE
+         ELSE
+            DO 180, J = 1, N
+               IF( BETA.EQ.ZERO )THEN
+                  DO 140, I = J, N
+                     C( I, J ) = ZERO
+  140             CONTINUE
+               ELSE IF( BETA.NE.ONE )THEN
+                  DO 150, I = J, N
+                     C( I, J ) = BETA*C( I, J )
+  150             CONTINUE
+               END IF
+               DO 170, L = 1, K
+                  IF( A( J, L ).NE.ZERO )THEN
+                     TEMP      = ALPHA*A( J, L )
+                     DO 160, I = J, N
+                        C( I, J ) = C( I, J ) + TEMP*A( I, L )
+  160                CONTINUE
+                  END IF
+  170          CONTINUE
+  180       CONTINUE
+         END IF
+      ELSE
+*
+*        Form  C := alpha*A'*A + beta*C.
+*
+         IF( UPPER )THEN
+            DO 210, J = 1, N
+               DO 200, I = 1, J
+                  TEMP = ZERO
+                  DO 190, L = 1, K
+                     TEMP = TEMP + A( L, I )*A( L, J )
+  190             CONTINUE
+                  IF( BETA.EQ.ZERO )THEN
+                     C( I, J ) = ALPHA*TEMP
+                  ELSE
+                     C( I, J ) = ALPHA*TEMP + BETA*C( I, J )
+                  END IF
+  200          CONTINUE
+  210       CONTINUE
+         ELSE
+            DO 240, J = 1, N
+               DO 230, I = J, N
+                  TEMP = ZERO
+                  DO 220, L = 1, K
+                     TEMP = TEMP + A( L, I )*A( L, J )
+  220             CONTINUE
+                  IF( BETA.EQ.ZERO )THEN
+                     C( I, J ) = ALPHA*TEMP
+                  ELSE
+                     C( I, J ) = ALPHA*TEMP + BETA*C( I, J )
+                  END IF
+  230          CONTINUE
+  240       CONTINUE
+         END IF
+      END IF
+*
+      RETURN
+*
+*     End of ZSYRK .
+*
+      END
diff --git a/src/fortran/blas/ztbmv.f b/src/fortran/blas/ztbmv.f
new file mode 100644
index 0000000..1794408
--- /dev/null
+++ b/src/fortran/blas/ztbmv.f
@@ -0,0 +1,377 @@
+      SUBROUTINE ZTBMV ( UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX )
+*     .. Scalar Arguments ..
+      INTEGER            INCX, K, LDA, N
+      CHARACTER*1        DIAG, TRANS, UPLO
+*     .. Array Arguments ..
+      COMPLEX*16         A( LDA, * ), X( * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  ZTBMV  performs one of the matrix-vector operations
+*
+*     x := A*x,   or   x := A'*x,   or   x := conjg( A' )*x,
+*
+*  where x is an n element vector and  A is an n by n unit, or non-unit,
+*  upper or lower triangular band matrix, with ( k + 1 ) diagonals.
+*
+*  Parameters
+*  ==========
+*
+*  UPLO   - CHARACTER*1.
+*           On entry, UPLO specifies whether the matrix is an upper or
+*           lower triangular matrix as follows:
+*
+*              UPLO = 'U' or 'u'   A is an upper triangular matrix.
+*
+*              UPLO = 'L' or 'l'   A is a lower triangular matrix.
+*
+*           Unchanged on exit.
+*
+*  TRANS  - CHARACTER*1.
+*           On entry, TRANS specifies the operation to be performed as
+*           follows:
+*
+*              TRANS = 'N' or 'n'   x := A*x.
+*
+*              TRANS = 'T' or 't'   x := A'*x.
+*
+*              TRANS = 'C' or 'c'   x := conjg( A' )*x.
+*
+*           Unchanged on exit.
+*
+*  DIAG   - CHARACTER*1.
+*           On entry, DIAG specifies whether or not A is unit
+*           triangular as follows:
+*
+*              DIAG = 'U' or 'u'   A is assumed to be unit triangular.
+*
+*              DIAG = 'N' or 'n'   A is not assumed to be unit
+*                                  triangular.
+*
+*           Unchanged on exit.
+*
+*  N      - INTEGER.
+*           On entry, N specifies the order of the matrix A.
+*           N must be at least zero.
+*           Unchanged on exit.
+*
+*  K      - INTEGER.
+*           On entry with UPLO = 'U' or 'u', K specifies the number of
+*           super-diagonals of the matrix A.
+*           On entry with UPLO = 'L' or 'l', K specifies the number of
+*           sub-diagonals of the matrix A.
+*           K must satisfy  0 .le. K.
+*           Unchanged on exit.
+*
+*  A      - COMPLEX*16       array of DIMENSION ( LDA, n ).
+*           Before entry with UPLO = 'U' or 'u', the leading ( k + 1 )
+*           by n part of the array A must contain the upper triangular
+*           band part of the matrix of coefficients, supplied column by
+*           column, with the leading diagonal of the matrix in row
+*           ( k + 1 ) of the array, the first super-diagonal starting at
+*           position 2 in row k, and so on. The top left k by k triangle
+*           of the array A is not referenced.
+*           The following program segment will transfer an upper
+*           triangular band matrix from conventional full matrix storage
+*           to band storage:
+*
+*                 DO 20, J = 1, N
+*                    M = K + 1 - J
+*                    DO 10, I = MAX( 1, J - K ), J
+*                       A( M + I, J ) = matrix( I, J )
+*              10    CONTINUE
+*              20 CONTINUE
+*
+*           Before entry with UPLO = 'L' or 'l', the leading ( k + 1 )
+*           by n part of the array A must contain the lower triangular
+*           band part of the matrix of coefficients, supplied column by
+*           column, with the leading diagonal of the matrix in row 1 of
+*           the array, the first sub-diagonal starting at position 1 in
+*           row 2, and so on. The bottom right k by k triangle of the
+*           array A is not referenced.
+*           The following program segment will transfer a lower
+*           triangular band matrix from conventional full matrix storage
+*           to band storage:
+*
+*                 DO 20, J = 1, N
+*                    M = 1 - J
+*                    DO 10, I = J, MIN( N, J + K )
+*                       A( M + I, J ) = matrix( I, J )
+*              10    CONTINUE
+*              20 CONTINUE
+*
+*           Note that when DIAG = 'U' or 'u' the elements of the array A
+*           corresponding to the diagonal elements of the matrix are not
+*           referenced, but are assumed to be unity.
+*           Unchanged on exit.
+*
+*  LDA    - INTEGER.
+*           On entry, LDA specifies the first dimension of A as declared
+*           in the calling (sub) program. LDA must be at least
+*           ( k + 1 ).
+*           Unchanged on exit.
+*
+*  X      - COMPLEX*16       array of dimension at least
+*           ( 1 + ( n - 1 )*abs( INCX ) ).
+*           Before entry, the incremented array X must contain the n
+*           element vector x. On exit, X is overwritten with the
+*           tranformed vector x.
+*
+*  INCX   - INTEGER.
+*           On entry, INCX specifies the increment for the elements of
+*           X. INCX must not be zero.
+*           Unchanged on exit.
+*
+*
+*  Level 2 Blas routine.
+*
+*  -- Written on 22-October-1986.
+*     Jack Dongarra, Argonne National Lab.
+*     Jeremy Du Croz, Nag Central Office.
+*     Sven Hammarling, Nag Central Office.
+*     Richard Hanson, Sandia National Labs.
+*
+*
+*     .. Parameters ..
+      COMPLEX*16         ZERO
+      PARAMETER        ( ZERO = ( 0.0D+0, 0.0D+0 ) )
+*     .. Local Scalars ..
+      COMPLEX*16         TEMP
+      INTEGER            I, INFO, IX, J, JX, KPLUS1, KX, L
+      LOGICAL            NOCONJ, NOUNIT
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA
+*     .. Intrinsic Functions ..
+      INTRINSIC          DCONJG, MAX, MIN
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF     ( .NOT.LSAME( UPLO , 'U' ).AND.
+     $         .NOT.LSAME( UPLO , 'L' )      )THEN
+         INFO = 1
+      ELSE IF( .NOT.LSAME( TRANS, 'N' ).AND.
+     $         .NOT.LSAME( TRANS, 'T' ).AND.
+     $         .NOT.LSAME( TRANS, 'C' )      )THEN
+         INFO = 2
+      ELSE IF( .NOT.LSAME( DIAG , 'U' ).AND.
+     $         .NOT.LSAME( DIAG , 'N' )      )THEN
+         INFO = 3
+      ELSE IF( N.LT.0 )THEN
+         INFO = 4
+      ELSE IF( K.LT.0 )THEN
+         INFO = 5
+      ELSE IF( LDA.LT.( K + 1 ) )THEN
+         INFO = 7
+      ELSE IF( INCX.EQ.0 )THEN
+         INFO = 9
+      END IF
+      IF( INFO.NE.0 )THEN
+         CALL XERBLA( 'ZTBMV ', INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF( N.EQ.0 )
+     $   RETURN
+*
+      NOCONJ = LSAME( TRANS, 'T' )
+      NOUNIT = LSAME( DIAG , 'N' )
+*
+*     Set up the start point in X if the increment is not unity. This
+*     will be  ( N - 1 )*INCX   too small for descending loops.
+*
+      IF( INCX.LE.0 )THEN
+         KX = 1 - ( N - 1 )*INCX
+      ELSE IF( INCX.NE.1 )THEN
+         KX = 1
+      END IF
+*
+*     Start the operations. In this version the elements of A are
+*     accessed sequentially with one pass through A.
+*
+      IF( LSAME( TRANS, 'N' ) )THEN
+*
+*         Form  x := A*x.
+*
+         IF( LSAME( UPLO, 'U' ) )THEN
+            KPLUS1 = K + 1
+            IF( INCX.EQ.1 )THEN
+               DO 20, J = 1, N
+                  IF( X( J ).NE.ZERO )THEN
+                     TEMP = X( J )
+                     L    = KPLUS1 - J
+                     DO 10, I = MAX( 1, J - K ), J - 1
+                        X( I ) = X( I ) + TEMP*A( L + I, J )
+   10                CONTINUE
+                     IF( NOUNIT )
+     $                  X( J ) = X( J )*A( KPLUS1, J )
+                  END IF
+   20          CONTINUE
+            ELSE
+               JX = KX
+               DO 40, J = 1, N
+                  IF( X( JX ).NE.ZERO )THEN
+                     TEMP = X( JX )
+                     IX   = KX
+                     L    = KPLUS1  - J
+                     DO 30, I = MAX( 1, J - K ), J - 1
+                        X( IX ) = X( IX ) + TEMP*A( L + I, J )
+                        IX      = IX      + INCX
+   30                CONTINUE
+                     IF( NOUNIT )
+     $                  X( JX ) = X( JX )*A( KPLUS1, J )
+                  END IF
+                  JX = JX + INCX
+                  IF( J.GT.K )
+     $               KX = KX + INCX
+   40          CONTINUE
+            END IF
+         ELSE
+            IF( INCX.EQ.1 )THEN
+               DO 60, J = N, 1, -1
+                  IF( X( J ).NE.ZERO )THEN
+                     TEMP = X( J )
+                     L    = 1      - J
+                     DO 50, I = MIN( N, J + K ), J + 1, -1
+                        X( I ) = X( I ) + TEMP*A( L + I, J )
+   50                CONTINUE
+                     IF( NOUNIT )
+     $                  X( J ) = X( J )*A( 1, J )
+                  END IF
+   60          CONTINUE
+            ELSE
+               KX = KX + ( N - 1 )*INCX
+               JX = KX
+               DO 80, J = N, 1, -1
+                  IF( X( JX ).NE.ZERO )THEN
+                     TEMP = X( JX )
+                     IX   = KX
+                     L    = 1       - J
+                     DO 70, I = MIN( N, J + K ), J + 1, -1
+                        X( IX ) = X( IX ) + TEMP*A( L + I, J )
+                        IX      = IX      - INCX
+   70                CONTINUE
+                     IF( NOUNIT )
+     $                  X( JX ) = X( JX )*A( 1, J )
+                  END IF
+                  JX = JX - INCX
+                  IF( ( N - J ).GE.K )
+     $               KX = KX - INCX
+   80          CONTINUE
+            END IF
+         END IF
+      ELSE
+*
+*        Form  x := A'*x  or  x := conjg( A' )*x.
+*
+         IF( LSAME( UPLO, 'U' ) )THEN
+            KPLUS1 = K + 1
+            IF( INCX.EQ.1 )THEN
+               DO 110, J = N, 1, -1
+                  TEMP = X( J )
+                  L    = KPLUS1 - J
+                  IF( NOCONJ )THEN
+                     IF( NOUNIT )
+     $                  TEMP = TEMP*A( KPLUS1, J )
+                     DO 90, I = J - 1, MAX( 1, J - K ), -1
+                        TEMP = TEMP + A( L + I, J )*X( I )
+   90                CONTINUE
+                  ELSE
+                     IF( NOUNIT )
+     $                  TEMP = TEMP*DCONJG( A( KPLUS1, J ) )
+                     DO 100, I = J - 1, MAX( 1, J - K ), -1
+                        TEMP = TEMP + DCONJG( A( L + I, J ) )*X( I )
+  100                CONTINUE
+                  END IF
+                  X( J ) = TEMP
+  110          CONTINUE
+            ELSE
+               KX = KX + ( N - 1 )*INCX
+               JX = KX
+               DO 140, J = N, 1, -1
+                  TEMP = X( JX )
+                  KX   = KX      - INCX
+                  IX   = KX
+                  L    = KPLUS1  - J
+                  IF( NOCONJ )THEN
+                     IF( NOUNIT )
+     $                  TEMP = TEMP*A( KPLUS1, J )
+                     DO 120, I = J - 1, MAX( 1, J - K ), -1
+                        TEMP = TEMP + A( L + I, J )*X( IX )
+                        IX   = IX   - INCX
+  120                CONTINUE
+                  ELSE
+                     IF( NOUNIT )
+     $                  TEMP = TEMP*DCONJG( A( KPLUS1, J ) )
+                     DO 130, I = J - 1, MAX( 1, J - K ), -1
+                        TEMP = TEMP + DCONJG( A( L + I, J ) )*X( IX )
+                        IX   = IX   - INCX
+  130                CONTINUE
+                  END IF
+                  X( JX ) = TEMP
+                  JX      = JX   - INCX
+  140          CONTINUE
+            END IF
+         ELSE
+            IF( INCX.EQ.1 )THEN
+               DO 170, J = 1, N
+                  TEMP = X( J )
+                  L    = 1      - J
+                  IF( NOCONJ )THEN
+                     IF( NOUNIT )
+     $                  TEMP = TEMP*A( 1, J )
+                     DO 150, I = J + 1, MIN( N, J + K )
+                        TEMP = TEMP + A( L + I, J )*X( I )
+  150                CONTINUE
+                  ELSE
+                     IF( NOUNIT )
+     $                  TEMP = TEMP*DCONJG( A( 1, J ) )
+                     DO 160, I = J + 1, MIN( N, J + K )
+                        TEMP = TEMP + DCONJG( A( L + I, J ) )*X( I )
+  160                CONTINUE
+                  END IF
+                  X( J ) = TEMP
+  170          CONTINUE
+            ELSE
+               JX = KX
+               DO 200, J = 1, N
+                  TEMP = X( JX )
+                  KX   = KX      + INCX
+                  IX   = KX
+                  L    = 1       - J
+                  IF( NOCONJ )THEN
+                     IF( NOUNIT )
+     $                  TEMP = TEMP*A( 1, J )
+                     DO 180, I = J + 1, MIN( N, J + K )
+                        TEMP = TEMP + A( L + I, J )*X( IX )
+                        IX   = IX   + INCX
+  180                CONTINUE
+                  ELSE
+                     IF( NOUNIT )
+     $                  TEMP = TEMP*DCONJG( A( 1, J ) )
+                     DO 190, I = J + 1, MIN( N, J + K )
+                        TEMP = TEMP + DCONJG( A( L + I, J ) )*X( IX )
+                        IX   = IX   + INCX
+  190                CONTINUE
+                  END IF
+                  X( JX ) = TEMP
+                  JX      = JX   + INCX
+  200          CONTINUE
+            END IF
+         END IF
+      END IF
+*
+      RETURN
+*
+*     End of ZTBMV .
+*
+      END
diff --git a/src/fortran/blas/ztbsv.f b/src/fortran/blas/ztbsv.f
new file mode 100644
index 0000000..f3ded81
--- /dev/null
+++ b/src/fortran/blas/ztbsv.f
@@ -0,0 +1,381 @@
+      SUBROUTINE ZTBSV ( UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX )
+*     .. Scalar Arguments ..
+      INTEGER            INCX, K, LDA, N
+      CHARACTER*1        DIAG, TRANS, UPLO
+*     .. Array Arguments ..
+      COMPLEX*16         A( LDA, * ), X( * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  ZTBSV  solves one of the systems of equations
+*
+*     A*x = b,   or   A'*x = b,   or   conjg( A' )*x = b,
+*
+*  where b and x are n element vectors and A is an n by n unit, or
+*  non-unit, upper or lower triangular band matrix, with ( k + 1 )
+*  diagonals.
+*
+*  No test for singularity or near-singularity is included in this
+*  routine. Such tests must be performed before calling this routine.
+*
+*  Parameters
+*  ==========
+*
+*  UPLO   - CHARACTER*1.
+*           On entry, UPLO specifies whether the matrix is an upper or
+*           lower triangular matrix as follows:
+*
+*              UPLO = 'U' or 'u'   A is an upper triangular matrix.
+*
+*              UPLO = 'L' or 'l'   A is a lower triangular matrix.
+*
+*           Unchanged on exit.
+*
+*  TRANS  - CHARACTER*1.
+*           On entry, TRANS specifies the equations to be solved as
+*           follows:
+*
+*              TRANS = 'N' or 'n'   A*x = b.
+*
+*              TRANS = 'T' or 't'   A'*x = b.
+*
+*              TRANS = 'C' or 'c'   conjg( A' )*x = b.
+*
+*           Unchanged on exit.
+*
+*  DIAG   - CHARACTER*1.
+*           On entry, DIAG specifies whether or not A is unit
+*           triangular as follows:
+*
+*              DIAG = 'U' or 'u'   A is assumed to be unit triangular.
+*
+*              DIAG = 'N' or 'n'   A is not assumed to be unit
+*                                  triangular.
+*
+*           Unchanged on exit.
+*
+*  N      - INTEGER.
+*           On entry, N specifies the order of the matrix A.
+*           N must be at least zero.
+*           Unchanged on exit.
+*
+*  K      - INTEGER.
+*           On entry with UPLO = 'U' or 'u', K specifies the number of
+*           super-diagonals of the matrix A.
+*           On entry with UPLO = 'L' or 'l', K specifies the number of
+*           sub-diagonals of the matrix A.
+*           K must satisfy  0 .le. K.
+*           Unchanged on exit.
+*
+*  A      - COMPLEX*16       array of DIMENSION ( LDA, n ).
+*           Before entry with UPLO = 'U' or 'u', the leading ( k + 1 )
+*           by n part of the array A must contain the upper triangular
+*           band part of the matrix of coefficients, supplied column by
+*           column, with the leading diagonal of the matrix in row
+*           ( k + 1 ) of the array, the first super-diagonal starting at
+*           position 2 in row k, and so on. The top left k by k triangle
+*           of the array A is not referenced.
+*           The following program segment will transfer an upper
+*           triangular band matrix from conventional full matrix storage
+*           to band storage:
+*
+*                 DO 20, J = 1, N
+*                    M = K + 1 - J
+*                    DO 10, I = MAX( 1, J - K ), J
+*                       A( M + I, J ) = matrix( I, J )
+*              10    CONTINUE
+*              20 CONTINUE
+*
+*           Before entry with UPLO = 'L' or 'l', the leading ( k + 1 )
+*           by n part of the array A must contain the lower triangular
+*           band part of the matrix of coefficients, supplied column by
+*           column, with the leading diagonal of the matrix in row 1 of
+*           the array, the first sub-diagonal starting at position 1 in
+*           row 2, and so on. The bottom right k by k triangle of the
+*           array A is not referenced.
+*           The following program segment will transfer a lower
+*           triangular band matrix from conventional full matrix storage
+*           to band storage:
+*
+*                 DO 20, J = 1, N
+*                    M = 1 - J
+*                    DO 10, I = J, MIN( N, J + K )
+*                       A( M + I, J ) = matrix( I, J )
+*              10    CONTINUE
+*              20 CONTINUE
+*
+*           Note that when DIAG = 'U' or 'u' the elements of the array A
+*           corresponding to the diagonal elements of the matrix are not
+*           referenced, but are assumed to be unity.
+*           Unchanged on exit.
+*
+*  LDA    - INTEGER.
+*           On entry, LDA specifies the first dimension of A as declared
+*           in the calling (sub) program. LDA must be at least
+*           ( k + 1 ).
+*           Unchanged on exit.
+*
+*  X      - COMPLEX*16       array of dimension at least
+*           ( 1 + ( n - 1 )*abs( INCX ) ).
+*           Before entry, the incremented array X must contain the n
+*           element right-hand side vector b. On exit, X is overwritten
+*           with the solution vector x.
+*
+*  INCX   - INTEGER.
+*           On entry, INCX specifies the increment for the elements of
+*           X. INCX must not be zero.
+*           Unchanged on exit.
+*
+*
+*  Level 2 Blas routine.
+*
+*  -- Written on 22-October-1986.
+*     Jack Dongarra, Argonne National Lab.
+*     Jeremy Du Croz, Nag Central Office.
+*     Sven Hammarling, Nag Central Office.
+*     Richard Hanson, Sandia National Labs.
+*
+*
+*     .. Parameters ..
+      COMPLEX*16         ZERO
+      PARAMETER        ( ZERO = ( 0.0D+0, 0.0D+0 ) )
+*     .. Local Scalars ..
+      COMPLEX*16         TEMP
+      INTEGER            I, INFO, IX, J, JX, KPLUS1, KX, L
+      LOGICAL            NOCONJ, NOUNIT
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA
+*     .. Intrinsic Functions ..
+      INTRINSIC          DCONJG, MAX, MIN
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF     ( .NOT.LSAME( UPLO , 'U' ).AND.
+     $         .NOT.LSAME( UPLO , 'L' )      )THEN
+         INFO = 1
+      ELSE IF( .NOT.LSAME( TRANS, 'N' ).AND.
+     $         .NOT.LSAME( TRANS, 'T' ).AND.
+     $         .NOT.LSAME( TRANS, 'C' )      )THEN
+         INFO = 2
+      ELSE IF( .NOT.LSAME( DIAG , 'U' ).AND.
+     $         .NOT.LSAME( DIAG , 'N' )      )THEN
+         INFO = 3
+      ELSE IF( N.LT.0 )THEN
+         INFO = 4
+      ELSE IF( K.LT.0 )THEN
+         INFO = 5
+      ELSE IF( LDA.LT.( K + 1 ) )THEN
+         INFO = 7
+      ELSE IF( INCX.EQ.0 )THEN
+         INFO = 9
+      END IF
+      IF( INFO.NE.0 )THEN
+         CALL XERBLA( 'ZTBSV ', INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF( N.EQ.0 )
+     $   RETURN
+*
+      NOCONJ = LSAME( TRANS, 'T' )
+      NOUNIT = LSAME( DIAG , 'N' )
+*
+*     Set up the start point in X if the increment is not unity. This
+*     will be  ( N - 1 )*INCX  too small for descending loops.
+*
+      IF( INCX.LE.0 )THEN
+         KX = 1 - ( N - 1 )*INCX
+      ELSE IF( INCX.NE.1 )THEN
+         KX = 1
+      END IF
+*
+*     Start the operations. In this version the elements of A are
+*     accessed by sequentially with one pass through A.
+*
+      IF( LSAME( TRANS, 'N' ) )THEN
+*
+*        Form  x := inv( A )*x.
+*
+         IF( LSAME( UPLO, 'U' ) )THEN
+            KPLUS1 = K + 1
+            IF( INCX.EQ.1 )THEN
+               DO 20, J = N, 1, -1
+                  IF( X( J ).NE.ZERO )THEN
+                     L = KPLUS1 - J
+                     IF( NOUNIT )
+     $                  X( J ) = X( J )/A( KPLUS1, J )
+                     TEMP = X( J )
+                     DO 10, I = J - 1, MAX( 1, J - K ), -1
+                        X( I ) = X( I ) - TEMP*A( L + I, J )
+   10                CONTINUE
+                  END IF
+   20          CONTINUE
+            ELSE
+               KX = KX + ( N - 1 )*INCX
+               JX = KX
+               DO 40, J = N, 1, -1
+                  KX = KX - INCX
+                  IF( X( JX ).NE.ZERO )THEN
+                     IX = KX
+                     L  = KPLUS1 - J
+                     IF( NOUNIT )
+     $                  X( JX ) = X( JX )/A( KPLUS1, J )
+                     TEMP = X( JX )
+                     DO 30, I = J - 1, MAX( 1, J - K ), -1
+                        X( IX ) = X( IX ) - TEMP*A( L + I, J )
+                        IX      = IX      - INCX
+   30                CONTINUE
+                  END IF
+                  JX = JX - INCX
+   40          CONTINUE
+            END IF
+         ELSE
+            IF( INCX.EQ.1 )THEN
+               DO 60, J = 1, N
+                  IF( X( J ).NE.ZERO )THEN
+                     L = 1 - J
+                     IF( NOUNIT )
+     $                  X( J ) = X( J )/A( 1, J )
+                     TEMP = X( J )
+                     DO 50, I = J + 1, MIN( N, J + K )
+                        X( I ) = X( I ) - TEMP*A( L + I, J )
+   50                CONTINUE
+                  END IF
+   60          CONTINUE
+            ELSE
+               JX = KX
+               DO 80, J = 1, N
+                  KX = KX + INCX
+                  IF( X( JX ).NE.ZERO )THEN
+                     IX = KX
+                     L  = 1  - J
+                     IF( NOUNIT )
+     $                  X( JX ) = X( JX )/A( 1, J )
+                     TEMP = X( JX )
+                     DO 70, I = J + 1, MIN( N, J + K )
+                        X( IX ) = X( IX ) - TEMP*A( L + I, J )
+                        IX      = IX      + INCX
+   70                CONTINUE
+                  END IF
+                  JX = JX + INCX
+   80          CONTINUE
+            END IF
+         END IF
+      ELSE
+*
+*        Form  x := inv( A' )*x  or  x := inv( conjg( A') )*x.
+*
+         IF( LSAME( UPLO, 'U' ) )THEN
+            KPLUS1 = K + 1
+            IF( INCX.EQ.1 )THEN
+               DO 110, J = 1, N
+                  TEMP = X( J )
+                  L    = KPLUS1 - J
+                  IF( NOCONJ )THEN
+                     DO 90, I = MAX( 1, J - K ), J - 1
+                        TEMP = TEMP - A( L + I, J )*X( I )
+   90                CONTINUE
+                     IF( NOUNIT )
+     $                  TEMP = TEMP/A( KPLUS1, J )
+                  ELSE
+                     DO 100, I = MAX( 1, J - K ), J - 1
+                        TEMP = TEMP - DCONJG( A( L + I, J ) )*X( I )
+  100                CONTINUE
+                     IF( NOUNIT )
+     $                  TEMP = TEMP/DCONJG( A( KPLUS1, J ) )
+                  END IF
+                  X( J ) = TEMP
+  110          CONTINUE
+            ELSE
+               JX = KX
+               DO 140, J = 1, N
+                  TEMP = X( JX )
+                  IX   = KX
+                  L    = KPLUS1  - J
+                  IF( NOCONJ )THEN
+                     DO 120, I = MAX( 1, J - K ), J - 1
+                        TEMP = TEMP - A( L + I, J )*X( IX )
+                        IX   = IX   + INCX
+  120                CONTINUE
+                     IF( NOUNIT )
+     $                  TEMP = TEMP/A( KPLUS1, J )
+                  ELSE
+                     DO 130, I = MAX( 1, J - K ), J - 1
+                        TEMP = TEMP - DCONJG( A( L + I, J ) )*X( IX )
+                        IX   = IX   + INCX
+  130                CONTINUE
+                     IF( NOUNIT )
+     $                  TEMP = TEMP/DCONJG( A( KPLUS1, J ) )
+                  END IF
+                  X( JX ) = TEMP
+                  JX      = JX   + INCX
+                  IF( J.GT.K )
+     $               KX = KX + INCX
+  140          CONTINUE
+            END IF
+         ELSE
+            IF( INCX.EQ.1 )THEN
+               DO 170, J = N, 1, -1
+                  TEMP = X( J )
+                  L    = 1      - J
+                  IF( NOCONJ )THEN
+                     DO 150, I = MIN( N, J + K ), J + 1, -1
+                        TEMP = TEMP - A( L + I, J )*X( I )
+  150                CONTINUE
+                     IF( NOUNIT )
+     $                  TEMP = TEMP/A( 1, J )
+                  ELSE
+                     DO 160, I = MIN( N, J + K ), J + 1, -1
+                        TEMP = TEMP - DCONJG( A( L + I, J ) )*X( I )
+  160                CONTINUE
+                     IF( NOUNIT )
+     $                  TEMP = TEMP/DCONJG( A( 1, J ) )
+                  END IF
+                  X( J ) = TEMP
+  170          CONTINUE
+            ELSE
+               KX = KX + ( N - 1 )*INCX
+               JX = KX
+               DO 200, J = N, 1, -1
+                  TEMP = X( JX )
+                  IX   = KX
+                  L    = 1       - J
+                  IF( NOCONJ )THEN
+                     DO 180, I = MIN( N, J + K ), J + 1, -1
+                        TEMP = TEMP - A( L + I, J )*X( IX )
+                        IX   = IX   - INCX
+  180                CONTINUE
+                     IF( NOUNIT )
+     $                  TEMP = TEMP/A( 1, J )
+                  ELSE
+                     DO 190, I = MIN( N, J + K ), J + 1, -1
+                        TEMP = TEMP - DCONJG( A( L + I, J ) )*X( IX )
+                        IX   = IX   - INCX
+  190                CONTINUE
+                     IF( NOUNIT )
+     $                  TEMP = TEMP/DCONJG( A( 1, J ) )
+                  END IF
+                  X( JX ) = TEMP
+                  JX      = JX   - INCX
+                  IF( ( N - J ).GE.K )
+     $               KX = KX - INCX
+  200          CONTINUE
+            END IF
+         END IF
+      END IF
+*
+      RETURN
+*
+*     End of ZTBSV .
+*
+      END
diff --git a/src/fortran/blas/ztpmv.f b/src/fortran/blas/ztpmv.f
new file mode 100644
index 0000000..4fad3a8
--- /dev/null
+++ b/src/fortran/blas/ztpmv.f
@@ -0,0 +1,338 @@
+      SUBROUTINE ZTPMV ( UPLO, TRANS, DIAG, N, AP, X, INCX )
+*     .. Scalar Arguments ..
+      INTEGER            INCX, N
+      CHARACTER*1        DIAG, TRANS, UPLO
+*     .. Array Arguments ..
+      COMPLEX*16         AP( * ), X( * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  ZTPMV  performs one of the matrix-vector operations
+*
+*     x := A*x,   or   x := A'*x,   or   x := conjg( A' )*x,
+*
+*  where x is an n element vector and  A is an n by n unit, or non-unit,
+*  upper or lower triangular matrix, supplied in packed form.
+*
+*  Parameters
+*  ==========
+*
+*  UPLO   - CHARACTER*1.
+*           On entry, UPLO specifies whether the matrix is an upper or
+*           lower triangular matrix as follows:
+*
+*              UPLO = 'U' or 'u'   A is an upper triangular matrix.
+*
+*              UPLO = 'L' or 'l'   A is a lower triangular matrix.
+*
+*           Unchanged on exit.
+*
+*  TRANS  - CHARACTER*1.
+*           On entry, TRANS specifies the operation to be performed as
+*           follows:
+*
+*              TRANS = 'N' or 'n'   x := A*x.
+*
+*              TRANS = 'T' or 't'   x := A'*x.
+*
+*              TRANS = 'C' or 'c'   x := conjg( A' )*x.
+*
+*           Unchanged on exit.
+*
+*  DIAG   - CHARACTER*1.
+*           On entry, DIAG specifies whether or not A is unit
+*           triangular as follows:
+*
+*              DIAG = 'U' or 'u'   A is assumed to be unit triangular.
+*
+*              DIAG = 'N' or 'n'   A is not assumed to be unit
+*                                  triangular.
+*
+*           Unchanged on exit.
+*
+*  N      - INTEGER.
+*           On entry, N specifies the order of the matrix A.
+*           N must be at least zero.
+*           Unchanged on exit.
+*
+*  AP     - COMPLEX*16       array of DIMENSION at least
+*           ( ( n*( n + 1 ) )/2 ).
+*           Before entry with  UPLO = 'U' or 'u', the array AP must
+*           contain the upper triangular matrix packed sequentially,
+*           column by column, so that AP( 1 ) contains a( 1, 1 ),
+*           AP( 2 ) and AP( 3 ) contain a( 1, 2 ) and a( 2, 2 )
+*           respectively, and so on.
+*           Before entry with UPLO = 'L' or 'l', the array AP must
+*           contain the lower triangular matrix packed sequentially,
+*           column by column, so that AP( 1 ) contains a( 1, 1 ),
+*           AP( 2 ) and AP( 3 ) contain a( 2, 1 ) and a( 3, 1 )
+*           respectively, and so on.
+*           Note that when  DIAG = 'U' or 'u', the diagonal elements of
+*           A are not referenced, but are assumed to be unity.
+*           Unchanged on exit.
+*
+*  X      - COMPLEX*16       array of dimension at least
+*           ( 1 + ( n - 1 )*abs( INCX ) ).
+*           Before entry, the incremented array X must contain the n
+*           element vector x. On exit, X is overwritten with the
+*           tranformed vector x.
+*
+*  INCX   - INTEGER.
+*           On entry, INCX specifies the increment for the elements of
+*           X. INCX must not be zero.
+*           Unchanged on exit.
+*
+*
+*  Level 2 Blas routine.
+*
+*  -- Written on 22-October-1986.
+*     Jack Dongarra, Argonne National Lab.
+*     Jeremy Du Croz, Nag Central Office.
+*     Sven Hammarling, Nag Central Office.
+*     Richard Hanson, Sandia National Labs.
+*
+*
+*     .. Parameters ..
+      COMPLEX*16         ZERO
+      PARAMETER        ( ZERO = ( 0.0D+0, 0.0D+0 ) )
+*     .. Local Scalars ..
+      COMPLEX*16         TEMP
+      INTEGER            I, INFO, IX, J, JX, K, KK, KX
+      LOGICAL            NOCONJ, NOUNIT
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA
+*     .. Intrinsic Functions ..
+      INTRINSIC          DCONJG
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF     ( .NOT.LSAME( UPLO , 'U' ).AND.
+     $         .NOT.LSAME( UPLO , 'L' )      )THEN
+         INFO = 1
+      ELSE IF( .NOT.LSAME( TRANS, 'N' ).AND.
+     $         .NOT.LSAME( TRANS, 'T' ).AND.
+     $         .NOT.LSAME( TRANS, 'C' )      )THEN
+         INFO = 2
+      ELSE IF( .NOT.LSAME( DIAG , 'U' ).AND.
+     $         .NOT.LSAME( DIAG , 'N' )      )THEN
+         INFO = 3
+      ELSE IF( N.LT.0 )THEN
+         INFO = 4
+      ELSE IF( INCX.EQ.0 )THEN
+         INFO = 7
+      END IF
+      IF( INFO.NE.0 )THEN
+         CALL XERBLA( 'ZTPMV ', INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF( N.EQ.0 )
+     $   RETURN
+*
+      NOCONJ = LSAME( TRANS, 'T' )
+      NOUNIT = LSAME( DIAG , 'N' )
+*
+*     Set up the start point in X if the increment is not unity. This
+*     will be  ( N - 1 )*INCX  too small for descending loops.
+*
+      IF( INCX.LE.0 )THEN
+         KX = 1 - ( N - 1 )*INCX
+      ELSE IF( INCX.NE.1 )THEN
+         KX = 1
+      END IF
+*
+*     Start the operations. In this version the elements of AP are
+*     accessed sequentially with one pass through AP.
+*
+      IF( LSAME( TRANS, 'N' ) )THEN
+*
+*        Form  x:= A*x.
+*
+         IF( LSAME( UPLO, 'U' ) )THEN
+            KK = 1
+            IF( INCX.EQ.1 )THEN
+               DO 20, J = 1, N
+                  IF( X( J ).NE.ZERO )THEN
+                     TEMP = X( J )
+                     K    = KK
+                     DO 10, I = 1, J - 1
+                        X( I ) = X( I ) + TEMP*AP( K )
+                        K      = K      + 1
+   10                CONTINUE
+                     IF( NOUNIT )
+     $                  X( J ) = X( J )*AP( KK + J - 1 )
+                  END IF
+                  KK = KK + J
+   20          CONTINUE
+            ELSE
+               JX = KX
+               DO 40, J = 1, N
+                  IF( X( JX ).NE.ZERO )THEN
+                     TEMP = X( JX )
+                     IX   = KX
+                     DO 30, K = KK, KK + J - 2
+                        X( IX ) = X( IX ) + TEMP*AP( K )
+                        IX      = IX      + INCX
+   30                CONTINUE
+                     IF( NOUNIT )
+     $                  X( JX ) = X( JX )*AP( KK + J - 1 )
+                  END IF
+                  JX = JX + INCX
+                  KK = KK + J
+   40          CONTINUE
+            END IF
+         ELSE
+            KK = ( N*( N + 1 ) )/2
+            IF( INCX.EQ.1 )THEN
+               DO 60, J = N, 1, -1
+                  IF( X( J ).NE.ZERO )THEN
+                     TEMP = X( J )
+                     K    = KK
+                     DO 50, I = N, J + 1, -1
+                        X( I ) = X( I ) + TEMP*AP( K )
+                        K      = K      - 1
+   50                CONTINUE
+                     IF( NOUNIT )
+     $                  X( J ) = X( J )*AP( KK - N + J )
+                  END IF
+                  KK = KK - ( N - J + 1 )
+   60          CONTINUE
+            ELSE
+               KX = KX + ( N - 1 )*INCX
+               JX = KX
+               DO 80, J = N, 1, -1
+                  IF( X( JX ).NE.ZERO )THEN
+                     TEMP = X( JX )
+                     IX   = KX
+                     DO 70, K = KK, KK - ( N - ( J + 1 ) ), -1
+                        X( IX ) = X( IX ) + TEMP*AP( K )
+                        IX      = IX      - INCX
+   70                CONTINUE
+                     IF( NOUNIT )
+     $                  X( JX ) = X( JX )*AP( KK - N + J )
+                  END IF
+                  JX = JX - INCX
+                  KK = KK - ( N - J + 1 )
+   80          CONTINUE
+            END IF
+         END IF
+      ELSE
+*
+*        Form  x := A'*x  or  x := conjg( A' )*x.
+*
+         IF( LSAME( UPLO, 'U' ) )THEN
+            KK = ( N*( N + 1 ) )/2
+            IF( INCX.EQ.1 )THEN
+               DO 110, J = N, 1, -1
+                  TEMP = X( J )
+                  K    = KK     - 1
+                  IF( NOCONJ )THEN
+                     IF( NOUNIT )
+     $                  TEMP = TEMP*AP( KK )
+                     DO 90, I = J - 1, 1, -1
+                        TEMP = TEMP + AP( K )*X( I )
+                        K    = K    - 1
+   90                CONTINUE
+                  ELSE
+                     IF( NOUNIT )
+     $                  TEMP = TEMP*DCONJG( AP( KK ) )
+                     DO 100, I = J - 1, 1, -1
+                        TEMP = TEMP + DCONJG( AP( K ) )*X( I )
+                        K    = K    - 1
+  100                CONTINUE
+                  END IF
+                  X( J ) = TEMP
+                  KK     = KK   - J
+  110          CONTINUE
+            ELSE
+               JX = KX + ( N - 1 )*INCX
+               DO 140, J = N, 1, -1
+                  TEMP = X( JX )
+                  IX   = JX
+                  IF( NOCONJ )THEN
+                     IF( NOUNIT )
+     $                  TEMP = TEMP*AP( KK )
+                     DO 120, K = KK - 1, KK - J + 1, -1
+                        IX   = IX   - INCX
+                        TEMP = TEMP + AP( K )*X( IX )
+  120                CONTINUE
+                  ELSE
+                     IF( NOUNIT )
+     $                  TEMP = TEMP*DCONJG( AP( KK ) )
+                     DO 130, K = KK - 1, KK - J + 1, -1
+                        IX   = IX   - INCX
+                        TEMP = TEMP + DCONJG( AP( K ) )*X( IX )
+  130                CONTINUE
+                  END IF
+                  X( JX ) = TEMP
+                  JX      = JX   - INCX
+                  KK      = KK   - J
+  140          CONTINUE
+            END IF
+         ELSE
+            KK = 1
+            IF( INCX.EQ.1 )THEN
+               DO 170, J = 1, N
+                  TEMP = X( J )
+                  K    = KK     + 1
+                  IF( NOCONJ )THEN
+                     IF( NOUNIT )
+     $                  TEMP = TEMP*AP( KK )
+                     DO 150, I = J + 1, N
+                        TEMP = TEMP + AP( K )*X( I )
+                        K    = K    + 1
+  150                CONTINUE
+                  ELSE
+                     IF( NOUNIT )
+     $                  TEMP = TEMP*DCONJG( AP( KK ) )
+                     DO 160, I = J + 1, N
+                        TEMP = TEMP + DCONJG( AP( K ) )*X( I )
+                        K    = K    + 1
+  160                CONTINUE
+                  END IF
+                  X( J ) = TEMP
+                  KK     = KK   + ( N - J + 1 )
+  170          CONTINUE
+            ELSE
+               JX = KX
+               DO 200, J = 1, N
+                  TEMP = X( JX )
+                  IX   = JX
+                  IF( NOCONJ )THEN
+                     IF( NOUNIT )
+     $                  TEMP = TEMP*AP( KK )
+                     DO 180, K = KK + 1, KK + N - J
+                        IX   = IX   + INCX
+                        TEMP = TEMP + AP( K )*X( IX )
+  180                CONTINUE
+                  ELSE
+                     IF( NOUNIT )
+     $                  TEMP = TEMP*DCONJG( AP( KK ) )
+                     DO 190, K = KK + 1, KK + N - J
+                        IX   = IX   + INCX
+                        TEMP = TEMP + DCONJG( AP( K ) )*X( IX )
+  190                CONTINUE
+                  END IF
+                  X( JX ) = TEMP
+                  JX      = JX   + INCX
+                  KK      = KK   + ( N - J + 1 )
+  200          CONTINUE
+            END IF
+         END IF
+      END IF
+*
+      RETURN
+*
+*     End of ZTPMV .
+*
+      END
diff --git a/src/fortran/blas/ztpsv.f b/src/fortran/blas/ztpsv.f
new file mode 100644
index 0000000..8649f47
--- /dev/null
+++ b/src/fortran/blas/ztpsv.f
@@ -0,0 +1,341 @@
+      SUBROUTINE ZTPSV ( UPLO, TRANS, DIAG, N, AP, X, INCX )
+*     .. Scalar Arguments ..
+      INTEGER            INCX, N
+      CHARACTER*1        DIAG, TRANS, UPLO
+*     .. Array Arguments ..
+      COMPLEX*16         AP( * ), X( * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  ZTPSV  solves one of the systems of equations
+*
+*     A*x = b,   or   A'*x = b,   or   conjg( A' )*x = b,
+*
+*  where b and x are n element vectors and A is an n by n unit, or
+*  non-unit, upper or lower triangular matrix, supplied in packed form.
+*
+*  No test for singularity or near-singularity is included in this
+*  routine. Such tests must be performed before calling this routine.
+*
+*  Parameters
+*  ==========
+*
+*  UPLO   - CHARACTER*1.
+*           On entry, UPLO specifies whether the matrix is an upper or
+*           lower triangular matrix as follows:
+*
+*              UPLO = 'U' or 'u'   A is an upper triangular matrix.
+*
+*              UPLO = 'L' or 'l'   A is a lower triangular matrix.
+*
+*           Unchanged on exit.
+*
+*  TRANS  - CHARACTER*1.
+*           On entry, TRANS specifies the equations to be solved as
+*           follows:
+*
+*              TRANS = 'N' or 'n'   A*x = b.
+*
+*              TRANS = 'T' or 't'   A'*x = b.
+*
+*              TRANS = 'C' or 'c'   conjg( A' )*x = b.
+*
+*           Unchanged on exit.
+*
+*  DIAG   - CHARACTER*1.
+*           On entry, DIAG specifies whether or not A is unit
+*           triangular as follows:
+*
+*              DIAG = 'U' or 'u'   A is assumed to be unit triangular.
+*
+*              DIAG = 'N' or 'n'   A is not assumed to be unit
+*                                  triangular.
+*
+*           Unchanged on exit.
+*
+*  N      - INTEGER.
+*           On entry, N specifies the order of the matrix A.
+*           N must be at least zero.
+*           Unchanged on exit.
+*
+*  AP     - COMPLEX*16       array of DIMENSION at least
+*           ( ( n*( n + 1 ) )/2 ).
+*           Before entry with  UPLO = 'U' or 'u', the array AP must
+*           contain the upper triangular matrix packed sequentially,
+*           column by column, so that AP( 1 ) contains a( 1, 1 ),
+*           AP( 2 ) and AP( 3 ) contain a( 1, 2 ) and a( 2, 2 )
+*           respectively, and so on.
+*           Before entry with UPLO = 'L' or 'l', the array AP must
+*           contain the lower triangular matrix packed sequentially,
+*           column by column, so that AP( 1 ) contains a( 1, 1 ),
+*           AP( 2 ) and AP( 3 ) contain a( 2, 1 ) and a( 3, 1 )
+*           respectively, and so on.
+*           Note that when  DIAG = 'U' or 'u', the diagonal elements of
+*           A are not referenced, but are assumed to be unity.
+*           Unchanged on exit.
+*
+*  X      - COMPLEX*16       array of dimension at least
+*           ( 1 + ( n - 1 )*abs( INCX ) ).
+*           Before entry, the incremented array X must contain the n
+*           element right-hand side vector b. On exit, X is overwritten
+*           with the solution vector x.
+*
+*  INCX   - INTEGER.
+*           On entry, INCX specifies the increment for the elements of
+*           X. INCX must not be zero.
+*           Unchanged on exit.
+*
+*
+*  Level 2 Blas routine.
+*
+*  -- Written on 22-October-1986.
+*     Jack Dongarra, Argonne National Lab.
+*     Jeremy Du Croz, Nag Central Office.
+*     Sven Hammarling, Nag Central Office.
+*     Richard Hanson, Sandia National Labs.
+*
+*
+*     .. Parameters ..
+      COMPLEX*16         ZERO
+      PARAMETER        ( ZERO = ( 0.0D+0, 0.0D+0 ) )
+*     .. Local Scalars ..
+      COMPLEX*16         TEMP
+      INTEGER            I, INFO, IX, J, JX, K, KK, KX
+      LOGICAL            NOCONJ, NOUNIT
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA
+*     .. Intrinsic Functions ..
+      INTRINSIC          DCONJG
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF     ( .NOT.LSAME( UPLO , 'U' ).AND.
+     $         .NOT.LSAME( UPLO , 'L' )      )THEN
+         INFO = 1
+      ELSE IF( .NOT.LSAME( TRANS, 'N' ).AND.
+     $         .NOT.LSAME( TRANS, 'T' ).AND.
+     $         .NOT.LSAME( TRANS, 'C' )      )THEN
+         INFO = 2
+      ELSE IF( .NOT.LSAME( DIAG , 'U' ).AND.
+     $         .NOT.LSAME( DIAG , 'N' )      )THEN
+         INFO = 3
+      ELSE IF( N.LT.0 )THEN
+         INFO = 4
+      ELSE IF( INCX.EQ.0 )THEN
+         INFO = 7
+      END IF
+      IF( INFO.NE.0 )THEN
+         CALL XERBLA( 'ZTPSV ', INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF( N.EQ.0 )
+     $   RETURN
+*
+      NOCONJ = LSAME( TRANS, 'T' )
+      NOUNIT = LSAME( DIAG , 'N' )
+*
+*     Set up the start point in X if the increment is not unity. This
+*     will be  ( N - 1 )*INCX  too small for descending loops.
+*
+      IF( INCX.LE.0 )THEN
+         KX = 1 - ( N - 1 )*INCX
+      ELSE IF( INCX.NE.1 )THEN
+         KX = 1
+      END IF
+*
+*     Start the operations. In this version the elements of AP are
+*     accessed sequentially with one pass through AP.
+*
+      IF( LSAME( TRANS, 'N' ) )THEN
+*
+*        Form  x := inv( A )*x.
+*
+         IF( LSAME( UPLO, 'U' ) )THEN
+            KK = ( N*( N + 1 ) )/2
+            IF( INCX.EQ.1 )THEN
+               DO 20, J = N, 1, -1
+                  IF( X( J ).NE.ZERO )THEN
+                     IF( NOUNIT )
+     $                  X( J ) = X( J )/AP( KK )
+                     TEMP = X( J )
+                     K    = KK     - 1
+                     DO 10, I = J - 1, 1, -1
+                        X( I ) = X( I ) - TEMP*AP( K )
+                        K      = K      - 1
+   10                CONTINUE
+                  END IF
+                  KK = KK - J
+   20          CONTINUE
+            ELSE
+               JX = KX + ( N - 1 )*INCX
+               DO 40, J = N, 1, -1
+                  IF( X( JX ).NE.ZERO )THEN
+                     IF( NOUNIT )
+     $                  X( JX ) = X( JX )/AP( KK )
+                     TEMP = X( JX )
+                     IX   = JX
+                     DO 30, K = KK - 1, KK - J + 1, -1
+                        IX      = IX      - INCX
+                        X( IX ) = X( IX ) - TEMP*AP( K )
+   30                CONTINUE
+                  END IF
+                  JX = JX - INCX
+                  KK = KK - J
+   40          CONTINUE
+            END IF
+         ELSE
+            KK = 1
+            IF( INCX.EQ.1 )THEN
+               DO 60, J = 1, N
+                  IF( X( J ).NE.ZERO )THEN
+                     IF( NOUNIT )
+     $                  X( J ) = X( J )/AP( KK )
+                     TEMP = X( J )
+                     K    = KK     + 1
+                     DO 50, I = J + 1, N
+                        X( I ) = X( I ) - TEMP*AP( K )
+                        K      = K      + 1
+   50                CONTINUE
+                  END IF
+                  KK = KK + ( N - J + 1 )
+   60          CONTINUE
+            ELSE
+               JX = KX
+               DO 80, J = 1, N
+                  IF( X( JX ).NE.ZERO )THEN
+                     IF( NOUNIT )
+     $                  X( JX ) = X( JX )/AP( KK )
+                     TEMP = X( JX )
+                     IX   = JX
+                     DO 70, K = KK + 1, KK + N - J
+                        IX      = IX      + INCX
+                        X( IX ) = X( IX ) - TEMP*AP( K )
+   70                CONTINUE
+                  END IF
+                  JX = JX + INCX
+                  KK = KK + ( N - J + 1 )
+   80          CONTINUE
+            END IF
+         END IF
+      ELSE
+*
+*        Form  x := inv( A' )*x  or  x := inv( conjg( A' ) )*x.
+*
+         IF( LSAME( UPLO, 'U' ) )THEN
+            KK = 1
+            IF( INCX.EQ.1 )THEN
+               DO 110, J = 1, N
+                  TEMP = X( J )
+                  K    = KK
+                  IF( NOCONJ )THEN
+                     DO 90, I = 1, J - 1
+                        TEMP = TEMP - AP( K )*X( I )
+                        K    = K    + 1
+   90                CONTINUE
+                     IF( NOUNIT )
+     $                  TEMP = TEMP/AP( KK + J - 1 )
+                  ELSE
+                     DO 100, I = 1, J - 1
+                        TEMP = TEMP - DCONJG( AP( K ) )*X( I )
+                        K    = K    + 1
+  100                CONTINUE
+                     IF( NOUNIT )
+     $                  TEMP = TEMP/DCONJG( AP( KK + J - 1 ) )
+                  END IF
+                  X( J ) = TEMP
+                  KK     = KK   + J
+  110          CONTINUE
+            ELSE
+               JX = KX
+               DO 140, J = 1, N
+                  TEMP = X( JX )
+                  IX   = KX
+                  IF( NOCONJ )THEN
+                     DO 120, K = KK, KK + J - 2
+                        TEMP = TEMP - AP( K )*X( IX )
+                        IX   = IX   + INCX
+  120                CONTINUE
+                     IF( NOUNIT )
+     $                  TEMP = TEMP/AP( KK + J - 1 )
+                  ELSE
+                     DO 130, K = KK, KK + J - 2
+                        TEMP = TEMP - DCONJG( AP( K ) )*X( IX )
+                        IX   = IX   + INCX
+  130                CONTINUE
+                     IF( NOUNIT )
+     $                  TEMP = TEMP/DCONJG( AP( KK + J - 1 ) )
+                  END IF
+                  X( JX ) = TEMP
+                  JX      = JX   + INCX
+                  KK      = KK   + J
+  140          CONTINUE
+            END IF
+         ELSE
+            KK = ( N*( N + 1 ) )/2
+            IF( INCX.EQ.1 )THEN
+               DO 170, J = N, 1, -1
+                  TEMP = X( J )
+                  K    = KK
+                  IF( NOCONJ )THEN
+                     DO 150, I = N, J + 1, -1
+                        TEMP = TEMP - AP( K )*X( I )
+                        K    = K    - 1
+  150                CONTINUE
+                     IF( NOUNIT )
+     $                  TEMP = TEMP/AP( KK - N + J )
+                  ELSE
+                     DO 160, I = N, J + 1, -1
+                        TEMP = TEMP - DCONJG( AP( K ) )*X( I )
+                        K    = K    - 1
+  160                CONTINUE
+                     IF( NOUNIT )
+     $                  TEMP = TEMP/DCONJG( AP( KK - N + J ) )
+                  END IF
+                  X( J ) = TEMP
+                  KK     = KK   - ( N - J + 1 )
+  170          CONTINUE
+            ELSE
+               KX = KX + ( N - 1 )*INCX
+               JX = KX
+               DO 200, J = N, 1, -1
+                  TEMP = X( JX )
+                  IX   = KX
+                  IF( NOCONJ )THEN
+                     DO 180, K = KK, KK - ( N - ( J + 1 ) ), -1
+                        TEMP = TEMP - AP( K )*X( IX )
+                        IX   = IX   - INCX
+  180                CONTINUE
+                     IF( NOUNIT )
+     $                  TEMP = TEMP/AP( KK - N + J )
+                  ELSE
+                     DO 190, K = KK, KK - ( N - ( J + 1 ) ), -1
+                        TEMP = TEMP - DCONJG( AP( K ) )*X( IX )
+                        IX   = IX   - INCX
+  190                CONTINUE
+                     IF( NOUNIT )
+     $                  TEMP = TEMP/DCONJG( AP( KK - N + J ) )
+                  END IF
+                  X( JX ) = TEMP
+                  JX      = JX   - INCX
+                  KK      = KK   - ( N - J + 1 )
+  200          CONTINUE
+            END IF
+         END IF
+      END IF
+*
+      RETURN
+*
+*     End of ZTPSV .
+*
+      END
diff --git a/src/fortran/blas/ztrmm.f b/src/fortran/blas/ztrmm.f
new file mode 100644
index 0000000..30910d1
--- /dev/null
+++ b/src/fortran/blas/ztrmm.f
@@ -0,0 +1,392 @@
+      SUBROUTINE ZTRMM ( SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA,
+     $                   B, LDB )
+*     .. Scalar Arguments ..
+      CHARACTER*1        SIDE, UPLO, TRANSA, DIAG
+      INTEGER            M, N, LDA, LDB
+      COMPLEX*16         ALPHA
+*     .. Array Arguments ..
+      COMPLEX*16         A( LDA, * ), B( LDB, * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  ZTRMM  performs one of the matrix-matrix operations
+*
+*     B := alpha*op( A )*B,   or   B := alpha*B*op( A )
+*
+*  where  alpha  is a scalar,  B  is an m by n matrix,  A  is a unit, or
+*  non-unit,  upper or lower triangular matrix  and  op( A )  is one  of
+*
+*     op( A ) = A   or   op( A ) = A'   or   op( A ) = conjg( A' ).
+*
+*  Parameters
+*  ==========
+*
+*  SIDE   - CHARACTER*1.
+*           On entry,  SIDE specifies whether  op( A ) multiplies B from
+*           the left or right as follows:
+*
+*              SIDE = 'L' or 'l'   B := alpha*op( A )*B.
+*
+*              SIDE = 'R' or 'r'   B := alpha*B*op( A ).
+*
+*           Unchanged on exit.
+*
+*  UPLO   - CHARACTER*1.
+*           On entry, UPLO specifies whether the matrix A is an upper or
+*           lower triangular matrix as follows:
+*
+*              UPLO = 'U' or 'u'   A is an upper triangular matrix.
+*
+*              UPLO = 'L' or 'l'   A is a lower triangular matrix.
+*
+*           Unchanged on exit.
+*
+*  TRANSA - CHARACTER*1.
+*           On entry, TRANSA specifies the form of op( A ) to be used in
+*           the matrix multiplication as follows:
+*
+*              TRANSA = 'N' or 'n'   op( A ) = A.
+*
+*              TRANSA = 'T' or 't'   op( A ) = A'.
+*
+*              TRANSA = 'C' or 'c'   op( A ) = conjg( A' ).
+*
+*           Unchanged on exit.
+*
+*  DIAG   - CHARACTER*1.
+*           On entry, DIAG specifies whether or not A is unit triangular
+*           as follows:
+*
+*              DIAG = 'U' or 'u'   A is assumed to be unit triangular.
+*
+*              DIAG = 'N' or 'n'   A is not assumed to be unit
+*                                  triangular.
+*
+*           Unchanged on exit.
+*
+*  M      - INTEGER.
+*           On entry, M specifies the number of rows of B. M must be at
+*           least zero.
+*           Unchanged on exit.
+*
+*  N      - INTEGER.
+*           On entry, N specifies the number of columns of B.  N must be
+*           at least zero.
+*           Unchanged on exit.
+*
+*  ALPHA  - COMPLEX*16      .
+*           On entry,  ALPHA specifies the scalar  alpha. When  alpha is
+*           zero then  A is not referenced and  B need not be set before
+*           entry.
+*           Unchanged on exit.
+*
+*  A      - COMPLEX*16       array of DIMENSION ( LDA, k ), where k is m
+*           when  SIDE = 'L' or 'l'  and is  n  when  SIDE = 'R' or 'r'.
+*           Before entry  with  UPLO = 'U' or 'u',  the  leading  k by k
+*           upper triangular part of the array  A must contain the upper
+*           triangular matrix  and the strictly lower triangular part of
+*           A is not referenced.
+*           Before entry  with  UPLO = 'L' or 'l',  the  leading  k by k
+*           lower triangular part of the array  A must contain the lower
+*           triangular matrix  and the strictly upper triangular part of
+*           A is not referenced.
+*           Note that when  DIAG = 'U' or 'u',  the diagonal elements of
+*           A  are not referenced either,  but are assumed to be  unity.
+*           Unchanged on exit.
+*
+*  LDA    - INTEGER.
+*           On entry, LDA specifies the first dimension of A as declared
+*           in the calling (sub) program.  When  SIDE = 'L' or 'l'  then
+*           LDA  must be at least  max( 1, m ),  when  SIDE = 'R' or 'r'
+*           then LDA must be at least max( 1, n ).
+*           Unchanged on exit.
+*
+*  B      - COMPLEX*16       array of DIMENSION ( LDB, n ).
+*           Before entry,  the leading  m by n part of the array  B must
+*           contain the matrix  B,  and  on exit  is overwritten  by the
+*           transformed matrix.
+*
+*  LDB    - INTEGER.
+*           On entry, LDB specifies the first dimension of B as declared
+*           in  the  calling  (sub)  program.   LDB  must  be  at  least
+*           max( 1, m ).
+*           Unchanged on exit.
+*
+*
+*  Level 3 Blas routine.
+*
+*  -- Written on 8-February-1989.
+*     Jack Dongarra, Argonne National Laboratory.
+*     Iain Duff, AERE Harwell.
+*     Jeremy Du Croz, Numerical Algorithms Group Ltd.
+*     Sven Hammarling, Numerical Algorithms Group Ltd.
+*
+*
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA
+*     .. Intrinsic Functions ..
+      INTRINSIC          DCONJG, MAX
+*     .. Local Scalars ..
+      LOGICAL            LSIDE, NOCONJ, NOUNIT, UPPER
+      INTEGER            I, INFO, J, K, NROWA
+      COMPLEX*16         TEMP
+*     .. Parameters ..
+      COMPLEX*16         ONE
+      PARAMETER        ( ONE  = ( 1.0D+0, 0.0D+0 ) )
+      COMPLEX*16         ZERO
+      PARAMETER        ( ZERO = ( 0.0D+0, 0.0D+0 ) )
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      LSIDE  = LSAME( SIDE  , 'L' )
+      IF( LSIDE )THEN
+         NROWA = M
+      ELSE
+         NROWA = N
+      END IF
+      NOCONJ = LSAME( TRANSA, 'T' )
+      NOUNIT = LSAME( DIAG  , 'N' )
+      UPPER  = LSAME( UPLO  , 'U' )
+*
+      INFO   = 0
+      IF(      ( .NOT.LSIDE                ).AND.
+     $         ( .NOT.LSAME( SIDE  , 'R' ) )      )THEN
+         INFO = 1
+      ELSE IF( ( .NOT.UPPER                ).AND.
+     $         ( .NOT.LSAME( UPLO  , 'L' ) )      )THEN
+         INFO = 2
+      ELSE IF( ( .NOT.LSAME( TRANSA, 'N' ) ).AND.
+     $         ( .NOT.LSAME( TRANSA, 'T' ) ).AND.
+     $         ( .NOT.LSAME( TRANSA, 'C' ) )      )THEN
+         INFO = 3
+      ELSE IF( ( .NOT.LSAME( DIAG  , 'U' ) ).AND.
+     $         ( .NOT.LSAME( DIAG  , 'N' ) )      )THEN
+         INFO = 4
+      ELSE IF( M  .LT.0               )THEN
+         INFO = 5
+      ELSE IF( N  .LT.0               )THEN
+         INFO = 6
+      ELSE IF( LDA.LT.MAX( 1, NROWA ) )THEN
+         INFO = 9
+      ELSE IF( LDB.LT.MAX( 1, M     ) )THEN
+         INFO = 11
+      END IF
+      IF( INFO.NE.0 )THEN
+         CALL XERBLA( 'ZTRMM ', INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF( N.EQ.0 )
+     $   RETURN
+*
+*     And when  alpha.eq.zero.
+*
+      IF( ALPHA.EQ.ZERO )THEN
+         DO 20, J = 1, N
+            DO 10, I = 1, M
+               B( I, J ) = ZERO
+   10       CONTINUE
+   20    CONTINUE
+         RETURN
+      END IF
+*
+*     Start the operations.
+*
+      IF( LSIDE )THEN
+         IF( LSAME( TRANSA, 'N' ) )THEN
+*
+*           Form  B := alpha*A*B.
+*
+            IF( UPPER )THEN
+               DO 50, J = 1, N
+                  DO 40, K = 1, M
+                     IF( B( K, J ).NE.ZERO )THEN
+                        TEMP = ALPHA*B( K, J )
+                        DO 30, I = 1, K - 1
+                           B( I, J ) = B( I, J ) + TEMP*A( I, K )
+   30                   CONTINUE
+                        IF( NOUNIT )
+     $                     TEMP = TEMP*A( K, K )
+                        B( K, J ) = TEMP
+                     END IF
+   40             CONTINUE
+   50          CONTINUE
+            ELSE
+               DO 80, J = 1, N
+                  DO 70 K = M, 1, -1
+                     IF( B( K, J ).NE.ZERO )THEN
+                        TEMP      = ALPHA*B( K, J )
+                        B( K, J ) = TEMP
+                        IF( NOUNIT )
+     $                     B( K, J ) = B( K, J )*A( K, K )
+                        DO 60, I = K + 1, M
+                           B( I, J ) = B( I, J ) + TEMP*A( I, K )
+   60                   CONTINUE
+                     END IF
+   70             CONTINUE
+   80          CONTINUE
+            END IF
+         ELSE
+*
+*           Form  B := alpha*A'*B   or   B := alpha*conjg( A' )*B.
+*
+            IF( UPPER )THEN
+               DO 120, J = 1, N
+                  DO 110, I = M, 1, -1
+                     TEMP = B( I, J )
+                     IF( NOCONJ )THEN
+                        IF( NOUNIT )
+     $                     TEMP = TEMP*A( I, I )
+                        DO 90, K = 1, I - 1
+                           TEMP = TEMP + A( K, I )*B( K, J )
+   90                   CONTINUE
+                     ELSE
+                        IF( NOUNIT )
+     $                     TEMP = TEMP*DCONJG( A( I, I ) )
+                        DO 100, K = 1, I - 1
+                           TEMP = TEMP + DCONJG( A( K, I ) )*B( K, J )
+  100                   CONTINUE
+                     END IF
+                     B( I, J ) = ALPHA*TEMP
+  110             CONTINUE
+  120          CONTINUE
+            ELSE
+               DO 160, J = 1, N
+                  DO 150, I = 1, M
+                     TEMP = B( I, J )
+                     IF( NOCONJ )THEN
+                        IF( NOUNIT )
+     $                     TEMP = TEMP*A( I, I )
+                        DO 130, K = I + 1, M
+                           TEMP = TEMP + A( K, I )*B( K, J )
+  130                   CONTINUE
+                     ELSE
+                        IF( NOUNIT )
+     $                     TEMP = TEMP*DCONJG( A( I, I ) )
+                        DO 140, K = I + 1, M
+                           TEMP = TEMP + DCONJG( A( K, I ) )*B( K, J )
+  140                   CONTINUE
+                     END IF
+                     B( I, J ) = ALPHA*TEMP
+  150             CONTINUE
+  160          CONTINUE
+            END IF
+         END IF
+      ELSE
+         IF( LSAME( TRANSA, 'N' ) )THEN
+*
+*           Form  B := alpha*B*A.
+*
+            IF( UPPER )THEN
+               DO 200, J = N, 1, -1
+                  TEMP = ALPHA
+                  IF( NOUNIT )
+     $               TEMP = TEMP*A( J, J )
+                  DO 170, I = 1, M
+                     B( I, J ) = TEMP*B( I, J )
+  170             CONTINUE
+                  DO 190, K = 1, J - 1
+                     IF( A( K, J ).NE.ZERO )THEN
+                        TEMP = ALPHA*A( K, J )
+                        DO 180, I = 1, M
+                           B( I, J ) = B( I, J ) + TEMP*B( I, K )
+  180                   CONTINUE
+                     END IF
+  190             CONTINUE
+  200          CONTINUE
+            ELSE
+               DO 240, J = 1, N
+                  TEMP = ALPHA
+                  IF( NOUNIT )
+     $               TEMP = TEMP*A( J, J )
+                  DO 210, I = 1, M
+                     B( I, J ) = TEMP*B( I, J )
+  210             CONTINUE
+                  DO 230, K = J + 1, N
+                     IF( A( K, J ).NE.ZERO )THEN
+                        TEMP = ALPHA*A( K, J )
+                        DO 220, I = 1, M
+                           B( I, J ) = B( I, J ) + TEMP*B( I, K )
+  220                   CONTINUE
+                     END IF
+  230             CONTINUE
+  240          CONTINUE
+            END IF
+         ELSE
+*
+*           Form  B := alpha*B*A'   or   B := alpha*B*conjg( A' ).
+*
+            IF( UPPER )THEN
+               DO 280, K = 1, N
+                  DO 260, J = 1, K - 1
+                     IF( A( J, K ).NE.ZERO )THEN
+                        IF( NOCONJ )THEN
+                           TEMP = ALPHA*A( J, K )
+                        ELSE
+                           TEMP = ALPHA*DCONJG( A( J, K ) )
+                        END IF
+                        DO 250, I = 1, M
+                           B( I, J ) = B( I, J ) + TEMP*B( I, K )
+  250                   CONTINUE
+                     END IF
+  260             CONTINUE
+                  TEMP = ALPHA
+                  IF( NOUNIT )THEN
+                     IF( NOCONJ )THEN
+                        TEMP = TEMP*A( K, K )
+                     ELSE
+                        TEMP = TEMP*DCONJG( A( K, K ) )
+                     END IF
+                  END IF
+                  IF( TEMP.NE.ONE )THEN
+                     DO 270, I = 1, M
+                        B( I, K ) = TEMP*B( I, K )
+  270                CONTINUE
+                  END IF
+  280          CONTINUE
+            ELSE
+               DO 320, K = N, 1, -1
+                  DO 300, J = K + 1, N
+                     IF( A( J, K ).NE.ZERO )THEN
+                        IF( NOCONJ )THEN
+                           TEMP = ALPHA*A( J, K )
+                        ELSE
+                           TEMP = ALPHA*DCONJG( A( J, K ) )
+                        END IF
+                        DO 290, I = 1, M
+                           B( I, J ) = B( I, J ) + TEMP*B( I, K )
+  290                   CONTINUE
+                     END IF
+  300             CONTINUE
+                  TEMP = ALPHA
+                  IF( NOUNIT )THEN
+                     IF( NOCONJ )THEN
+                        TEMP = TEMP*A( K, K )
+                     ELSE
+                        TEMP = TEMP*DCONJG( A( K, K ) )
+                     END IF
+                  END IF
+                  IF( TEMP.NE.ONE )THEN
+                     DO 310, I = 1, M
+                        B( I, K ) = TEMP*B( I, K )
+  310                CONTINUE
+                  END IF
+  320          CONTINUE
+            END IF
+         END IF
+      END IF
+*
+      RETURN
+*
+*     End of ZTRMM .
+*
+      END
diff --git a/src/fortran/blas/ztrmv.f b/src/fortran/blas/ztrmv.f
new file mode 100644
index 0000000..677e212
--- /dev/null
+++ b/src/fortran/blas/ztrmv.f
@@ -0,0 +1,321 @@
+      SUBROUTINE ZTRMV ( UPLO, TRANS, DIAG, N, A, LDA, X, INCX )
+*     .. Scalar Arguments ..
+      INTEGER            INCX, LDA, N
+      CHARACTER*1        DIAG, TRANS, UPLO
+*     .. Array Arguments ..
+      COMPLEX*16         A( LDA, * ), X( * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  ZTRMV  performs one of the matrix-vector operations
+*
+*     x := A*x,   or   x := A'*x,   or   x := conjg( A' )*x,
+*
+*  where x is an n element vector and  A is an n by n unit, or non-unit,
+*  upper or lower triangular matrix.
+*
+*  Parameters
+*  ==========
+*
+*  UPLO   - CHARACTER*1.
+*           On entry, UPLO specifies whether the matrix is an upper or
+*           lower triangular matrix as follows:
+*
+*              UPLO = 'U' or 'u'   A is an upper triangular matrix.
+*
+*              UPLO = 'L' or 'l'   A is a lower triangular matrix.
+*
+*           Unchanged on exit.
+*
+*  TRANS  - CHARACTER*1.
+*           On entry, TRANS specifies the operation to be performed as
+*           follows:
+*
+*              TRANS = 'N' or 'n'   x := A*x.
+*
+*              TRANS = 'T' or 't'   x := A'*x.
+*
+*              TRANS = 'C' or 'c'   x := conjg( A' )*x.
+*
+*           Unchanged on exit.
+*
+*  DIAG   - CHARACTER*1.
+*           On entry, DIAG specifies whether or not A is unit
+*           triangular as follows:
+*
+*              DIAG = 'U' or 'u'   A is assumed to be unit triangular.
+*
+*              DIAG = 'N' or 'n'   A is not assumed to be unit
+*                                  triangular.
+*
+*           Unchanged on exit.
+*
+*  N      - INTEGER.
+*           On entry, N specifies the order of the matrix A.
+*           N must be at least zero.
+*           Unchanged on exit.
+*
+*  A      - COMPLEX*16       array of DIMENSION ( LDA, n ).
+*           Before entry with  UPLO = 'U' or 'u', the leading n by n
+*           upper triangular part of the array A must contain the upper
+*           triangular matrix and the strictly lower triangular part of
+*           A is not referenced.
+*           Before entry with UPLO = 'L' or 'l', the leading n by n
+*           lower triangular part of the array A must contain the lower
+*           triangular matrix and the strictly upper triangular part of
+*           A is not referenced.
+*           Note that when  DIAG = 'U' or 'u', the diagonal elements of
+*           A are not referenced either, but are assumed to be unity.
+*           Unchanged on exit.
+*
+*  LDA    - INTEGER.
+*           On entry, LDA specifies the first dimension of A as declared
+*           in the calling (sub) program. LDA must be at least
+*           max( 1, n ).
+*           Unchanged on exit.
+*
+*  X      - COMPLEX*16       array of dimension at least
+*           ( 1 + ( n - 1 )*abs( INCX ) ).
+*           Before entry, the incremented array X must contain the n
+*           element vector x. On exit, X is overwritten with the
+*           tranformed vector x.
+*
+*  INCX   - INTEGER.
+*           On entry, INCX specifies the increment for the elements of
+*           X. INCX must not be zero.
+*           Unchanged on exit.
+*
+*
+*  Level 2 Blas routine.
+*
+*  -- Written on 22-October-1986.
+*     Jack Dongarra, Argonne National Lab.
+*     Jeremy Du Croz, Nag Central Office.
+*     Sven Hammarling, Nag Central Office.
+*     Richard Hanson, Sandia National Labs.
+*
+*
+*     .. Parameters ..
+      COMPLEX*16         ZERO
+      PARAMETER        ( ZERO = ( 0.0D+0, 0.0D+0 ) )
+*     .. Local Scalars ..
+      COMPLEX*16         TEMP
+      INTEGER            I, INFO, IX, J, JX, KX
+      LOGICAL            NOCONJ, NOUNIT
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA
+*     .. Intrinsic Functions ..
+      INTRINSIC          DCONJG, MAX
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF     ( .NOT.LSAME( UPLO , 'U' ).AND.
+     $         .NOT.LSAME( UPLO , 'L' )      )THEN
+         INFO = 1
+      ELSE IF( .NOT.LSAME( TRANS, 'N' ).AND.
+     $         .NOT.LSAME( TRANS, 'T' ).AND.
+     $         .NOT.LSAME( TRANS, 'C' )      )THEN
+         INFO = 2
+      ELSE IF( .NOT.LSAME( DIAG , 'U' ).AND.
+     $         .NOT.LSAME( DIAG , 'N' )      )THEN
+         INFO = 3
+      ELSE IF( N.LT.0 )THEN
+         INFO = 4
+      ELSE IF( LDA.LT.MAX( 1, N ) )THEN
+         INFO = 6
+      ELSE IF( INCX.EQ.0 )THEN
+         INFO = 8
+      END IF
+      IF( INFO.NE.0 )THEN
+         CALL XERBLA( 'ZTRMV ', INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF( N.EQ.0 )
+     $   RETURN
+*
+      NOCONJ = LSAME( TRANS, 'T' )
+      NOUNIT = LSAME( DIAG , 'N' )
+*
+*     Set up the start point in X if the increment is not unity. This
+*     will be  ( N - 1 )*INCX  too small for descending loops.
+*
+      IF( INCX.LE.0 )THEN
+         KX = 1 - ( N - 1 )*INCX
+      ELSE IF( INCX.NE.1 )THEN
+         KX = 1
+      END IF
+*
+*     Start the operations. In this version the elements of A are
+*     accessed sequentially with one pass through A.
+*
+      IF( LSAME( TRANS, 'N' ) )THEN
+*
+*        Form  x := A*x.
+*
+         IF( LSAME( UPLO, 'U' ) )THEN
+            IF( INCX.EQ.1 )THEN
+               DO 20, J = 1, N
+                  IF( X( J ).NE.ZERO )THEN
+                     TEMP = X( J )
+                     DO 10, I = 1, J - 1
+                        X( I ) = X( I ) + TEMP*A( I, J )
+   10                CONTINUE
+                     IF( NOUNIT )
+     $                  X( J ) = X( J )*A( J, J )
+                  END IF
+   20          CONTINUE
+            ELSE
+               JX = KX
+               DO 40, J = 1, N
+                  IF( X( JX ).NE.ZERO )THEN
+                     TEMP = X( JX )
+                     IX   = KX
+                     DO 30, I = 1, J - 1
+                        X( IX ) = X( IX ) + TEMP*A( I, J )
+                        IX      = IX      + INCX
+   30                CONTINUE
+                     IF( NOUNIT )
+     $                  X( JX ) = X( JX )*A( J, J )
+                  END IF
+                  JX = JX + INCX
+   40          CONTINUE
+            END IF
+         ELSE
+            IF( INCX.EQ.1 )THEN
+               DO 60, J = N, 1, -1
+                  IF( X( J ).NE.ZERO )THEN
+                     TEMP = X( J )
+                     DO 50, I = N, J + 1, -1
+                        X( I ) = X( I ) + TEMP*A( I, J )
+   50                CONTINUE
+                     IF( NOUNIT )
+     $                  X( J ) = X( J )*A( J, J )
+                  END IF
+   60          CONTINUE
+            ELSE
+               KX = KX + ( N - 1 )*INCX
+               JX = KX
+               DO 80, J = N, 1, -1
+                  IF( X( JX ).NE.ZERO )THEN
+                     TEMP = X( JX )
+                     IX   = KX
+                     DO 70, I = N, J + 1, -1
+                        X( IX ) = X( IX ) + TEMP*A( I, J )
+                        IX      = IX      - INCX
+   70                CONTINUE
+                     IF( NOUNIT )
+     $                  X( JX ) = X( JX )*A( J, J )
+                  END IF
+                  JX = JX - INCX
+   80          CONTINUE
+            END IF
+         END IF
+      ELSE
+*
+*        Form  x := A'*x  or  x := conjg( A' )*x.
+*
+         IF( LSAME( UPLO, 'U' ) )THEN
+            IF( INCX.EQ.1 )THEN
+               DO 110, J = N, 1, -1
+                  TEMP = X( J )
+                  IF( NOCONJ )THEN
+                     IF( NOUNIT )
+     $                  TEMP = TEMP*A( J, J )
+                     DO 90, I = J - 1, 1, -1
+                        TEMP = TEMP + A( I, J )*X( I )
+   90                CONTINUE
+                  ELSE
+                     IF( NOUNIT )
+     $                  TEMP = TEMP*DCONJG( A( J, J ) )
+                     DO 100, I = J - 1, 1, -1
+                        TEMP = TEMP + DCONJG( A( I, J ) )*X( I )
+  100                CONTINUE
+                  END IF
+                  X( J ) = TEMP
+  110          CONTINUE
+            ELSE
+               JX = KX + ( N - 1 )*INCX
+               DO 140, J = N, 1, -1
+                  TEMP = X( JX )
+                  IX   = JX
+                  IF( NOCONJ )THEN
+                     IF( NOUNIT )
+     $                  TEMP = TEMP*A( J, J )
+                     DO 120, I = J - 1, 1, -1
+                        IX   = IX   - INCX
+                        TEMP = TEMP + A( I, J )*X( IX )
+  120                CONTINUE
+                  ELSE
+                     IF( NOUNIT )
+     $                  TEMP = TEMP*DCONJG( A( J, J ) )
+                     DO 130, I = J - 1, 1, -1
+                        IX   = IX   - INCX
+                        TEMP = TEMP + DCONJG( A( I, J ) )*X( IX )
+  130                CONTINUE
+                  END IF
+                  X( JX ) = TEMP
+                  JX      = JX   - INCX
+  140          CONTINUE
+            END IF
+         ELSE
+            IF( INCX.EQ.1 )THEN
+               DO 170, J = 1, N
+                  TEMP = X( J )
+                  IF( NOCONJ )THEN
+                     IF( NOUNIT )
+     $                  TEMP = TEMP*A( J, J )
+                     DO 150, I = J + 1, N
+                        TEMP = TEMP + A( I, J )*X( I )
+  150                CONTINUE
+                  ELSE
+                     IF( NOUNIT )
+     $                  TEMP = TEMP*DCONJG( A( J, J ) )
+                     DO 160, I = J + 1, N
+                        TEMP = TEMP + DCONJG( A( I, J ) )*X( I )
+  160                CONTINUE
+                  END IF
+                  X( J ) = TEMP
+  170          CONTINUE
+            ELSE
+               JX = KX
+               DO 200, J = 1, N
+                  TEMP = X( JX )
+                  IX   = JX
+                  IF( NOCONJ )THEN
+                     IF( NOUNIT )
+     $                  TEMP = TEMP*A( J, J )
+                     DO 180, I = J + 1, N
+                        IX   = IX   + INCX
+                        TEMP = TEMP + A( I, J )*X( IX )
+  180                CONTINUE
+                  ELSE
+                     IF( NOUNIT )
+     $                  TEMP = TEMP*DCONJG( A( J, J ) )
+                     DO 190, I = J + 1, N
+                        IX   = IX   + INCX
+                        TEMP = TEMP + DCONJG( A( I, J ) )*X( IX )
+  190                CONTINUE
+                  END IF
+                  X( JX ) = TEMP
+                  JX      = JX   + INCX
+  200          CONTINUE
+            END IF
+         END IF
+      END IF
+*
+      RETURN
+*
+*     End of ZTRMV .
+*
+      END
diff --git a/src/fortran/blas/ztrsm.f b/src/fortran/blas/ztrsm.f
new file mode 100644
index 0000000..e414ec6
--- /dev/null
+++ b/src/fortran/blas/ztrsm.f
@@ -0,0 +1,414 @@
+      SUBROUTINE ZTRSM ( SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA,
+     $                   B, LDB )
+*     .. Scalar Arguments ..
+      CHARACTER*1        SIDE, UPLO, TRANSA, DIAG
+      INTEGER            M, N, LDA, LDB
+      COMPLEX*16         ALPHA
+*     .. Array Arguments ..
+      COMPLEX*16         A( LDA, * ), B( LDB, * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  ZTRSM  solves one of the matrix equations
+*
+*     op( A )*X = alpha*B,   or   X*op( A ) = alpha*B,
+*
+*  where alpha is a scalar, X and B are m by n matrices, A is a unit, or
+*  non-unit,  upper or lower triangular matrix  and  op( A )  is one  of
+*
+*     op( A ) = A   or   op( A ) = A'   or   op( A ) = conjg( A' ).
+*
+*  The matrix X is overwritten on B.
+*
+*  Parameters
+*  ==========
+*
+*  SIDE   - CHARACTER*1.
+*           On entry, SIDE specifies whether op( A ) appears on the left
+*           or right of X as follows:
+*
+*              SIDE = 'L' or 'l'   op( A )*X = alpha*B.
+*
+*              SIDE = 'R' or 'r'   X*op( A ) = alpha*B.
+*
+*           Unchanged on exit.
+*
+*  UPLO   - CHARACTER*1.
+*           On entry, UPLO specifies whether the matrix A is an upper or
+*           lower triangular matrix as follows:
+*
+*              UPLO = 'U' or 'u'   A is an upper triangular matrix.
+*
+*              UPLO = 'L' or 'l'   A is a lower triangular matrix.
+*
+*           Unchanged on exit.
+*
+*  TRANSA - CHARACTER*1.
+*           On entry, TRANSA specifies the form of op( A ) to be used in
+*           the matrix multiplication as follows:
+*
+*              TRANSA = 'N' or 'n'   op( A ) = A.
+*
+*              TRANSA = 'T' or 't'   op( A ) = A'.
+*
+*              TRANSA = 'C' or 'c'   op( A ) = conjg( A' ).
+*
+*           Unchanged on exit.
+*
+*  DIAG   - CHARACTER*1.
+*           On entry, DIAG specifies whether or not A is unit triangular
+*           as follows:
+*
+*              DIAG = 'U' or 'u'   A is assumed to be unit triangular.
+*
+*              DIAG = 'N' or 'n'   A is not assumed to be unit
+*                                  triangular.
+*
+*           Unchanged on exit.
+*
+*  M      - INTEGER.
+*           On entry, M specifies the number of rows of B. M must be at
+*           least zero.
+*           Unchanged on exit.
+*
+*  N      - INTEGER.
+*           On entry, N specifies the number of columns of B.  N must be
+*           at least zero.
+*           Unchanged on exit.
+*
+*  ALPHA  - COMPLEX*16      .
+*           On entry,  ALPHA specifies the scalar  alpha. When  alpha is
+*           zero then  A is not referenced and  B need not be set before
+*           entry.
+*           Unchanged on exit.
+*
+*  A      - COMPLEX*16       array of DIMENSION ( LDA, k ), where k is m
+*           when  SIDE = 'L' or 'l'  and is  n  when  SIDE = 'R' or 'r'.
+*           Before entry  with  UPLO = 'U' or 'u',  the  leading  k by k
+*           upper triangular part of the array  A must contain the upper
+*           triangular matrix  and the strictly lower triangular part of
+*           A is not referenced.
+*           Before entry  with  UPLO = 'L' or 'l',  the  leading  k by k
+*           lower triangular part of the array  A must contain the lower
+*           triangular matrix  and the strictly upper triangular part of
+*           A is not referenced.
+*           Note that when  DIAG = 'U' or 'u',  the diagonal elements of
+*           A  are not referenced either,  but are assumed to be  unity.
+*           Unchanged on exit.
+*
+*  LDA    - INTEGER.
+*           On entry, LDA specifies the first dimension of A as declared
+*           in the calling (sub) program.  When  SIDE = 'L' or 'l'  then
+*           LDA  must be at least  max( 1, m ),  when  SIDE = 'R' or 'r'
+*           then LDA must be at least max( 1, n ).
+*           Unchanged on exit.
+*
+*  B      - COMPLEX*16       array of DIMENSION ( LDB, n ).
+*           Before entry,  the leading  m by n part of the array  B must
+*           contain  the  right-hand  side  matrix  B,  and  on exit  is
+*           overwritten by the solution matrix  X.
+*
+*  LDB    - INTEGER.
+*           On entry, LDB specifies the first dimension of B as declared
+*           in  the  calling  (sub)  program.   LDB  must  be  at  least
+*           max( 1, m ).
+*           Unchanged on exit.
+*
+*
+*  Level 3 Blas routine.
+*
+*  -- Written on 8-February-1989.
+*     Jack Dongarra, Argonne National Laboratory.
+*     Iain Duff, AERE Harwell.
+*     Jeremy Du Croz, Numerical Algorithms Group Ltd.
+*     Sven Hammarling, Numerical Algorithms Group Ltd.
+*
+*
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA
+*     .. Intrinsic Functions ..
+      INTRINSIC          DCONJG, MAX
+*     .. Local Scalars ..
+      LOGICAL            LSIDE, NOCONJ, NOUNIT, UPPER
+      INTEGER            I, INFO, J, K, NROWA
+      COMPLEX*16         TEMP
+*     .. Parameters ..
+      COMPLEX*16         ONE
+      PARAMETER        ( ONE  = ( 1.0D+0, 0.0D+0 ) )
+      COMPLEX*16         ZERO
+      PARAMETER        ( ZERO = ( 0.0D+0, 0.0D+0 ) )
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      LSIDE  = LSAME( SIDE  , 'L' )
+      IF( LSIDE )THEN
+         NROWA = M
+      ELSE
+         NROWA = N
+      END IF
+      NOCONJ = LSAME( TRANSA, 'T' )
+      NOUNIT = LSAME( DIAG  , 'N' )
+      UPPER  = LSAME( UPLO  , 'U' )
+*
+      INFO   = 0
+      IF(      ( .NOT.LSIDE                ).AND.
+     $         ( .NOT.LSAME( SIDE  , 'R' ) )      )THEN
+         INFO = 1
+      ELSE IF( ( .NOT.UPPER                ).AND.
+     $         ( .NOT.LSAME( UPLO  , 'L' ) )      )THEN
+         INFO = 2
+      ELSE IF( ( .NOT.LSAME( TRANSA, 'N' ) ).AND.
+     $         ( .NOT.LSAME( TRANSA, 'T' ) ).AND.
+     $         ( .NOT.LSAME( TRANSA, 'C' ) )      )THEN
+         INFO = 3
+      ELSE IF( ( .NOT.LSAME( DIAG  , 'U' ) ).AND.
+     $         ( .NOT.LSAME( DIAG  , 'N' ) )      )THEN
+         INFO = 4
+      ELSE IF( M  .LT.0               )THEN
+         INFO = 5
+      ELSE IF( N  .LT.0               )THEN
+         INFO = 6
+      ELSE IF( LDA.LT.MAX( 1, NROWA ) )THEN
+         INFO = 9
+      ELSE IF( LDB.LT.MAX( 1, M     ) )THEN
+         INFO = 11
+      END IF
+      IF( INFO.NE.0 )THEN
+         CALL XERBLA( 'ZTRSM ', INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF( N.EQ.0 )
+     $   RETURN
+*
+*     And when  alpha.eq.zero.
+*
+      IF( ALPHA.EQ.ZERO )THEN
+         DO 20, J = 1, N
+            DO 10, I = 1, M
+               B( I, J ) = ZERO
+   10       CONTINUE
+   20    CONTINUE
+         RETURN
+      END IF
+*
+*     Start the operations.
+*
+      IF( LSIDE )THEN
+         IF( LSAME( TRANSA, 'N' ) )THEN
+*
+*           Form  B := alpha*inv( A )*B.
+*
+            IF( UPPER )THEN
+               DO 60, J = 1, N
+                  IF( ALPHA.NE.ONE )THEN
+                     DO 30, I = 1, M
+                        B( I, J ) = ALPHA*B( I, J )
+   30                CONTINUE
+                  END IF
+                  DO 50, K = M, 1, -1
+                     IF( B( K, J ).NE.ZERO )THEN
+                        IF( NOUNIT )
+     $                     B( K, J ) = B( K, J )/A( K, K )
+                        DO 40, I = 1, K - 1
+                           B( I, J ) = B( I, J ) - B( K, J )*A( I, K )
+   40                   CONTINUE
+                     END IF
+   50             CONTINUE
+   60          CONTINUE
+            ELSE
+               DO 100, J = 1, N
+                  IF( ALPHA.NE.ONE )THEN
+                     DO 70, I = 1, M
+                        B( I, J ) = ALPHA*B( I, J )
+   70                CONTINUE
+                  END IF
+                  DO 90 K = 1, M
+                     IF( B( K, J ).NE.ZERO )THEN
+                        IF( NOUNIT )
+     $                     B( K, J ) = B( K, J )/A( K, K )
+                        DO 80, I = K + 1, M
+                           B( I, J ) = B( I, J ) - B( K, J )*A( I, K )
+   80                   CONTINUE
+                     END IF
+   90             CONTINUE
+  100          CONTINUE
+            END IF
+         ELSE
+*
+*           Form  B := alpha*inv( A' )*B
+*           or    B := alpha*inv( conjg( A' ) )*B.
+*
+            IF( UPPER )THEN
+               DO 140, J = 1, N
+                  DO 130, I = 1, M
+                     TEMP = ALPHA*B( I, J )
+                     IF( NOCONJ )THEN
+                        DO 110, K = 1, I - 1
+                           TEMP = TEMP - A( K, I )*B( K, J )
+  110                   CONTINUE
+                        IF( NOUNIT )
+     $                     TEMP = TEMP/A( I, I )
+                     ELSE
+                        DO 120, K = 1, I - 1
+                           TEMP = TEMP - DCONJG( A( K, I ) )*B( K, J )
+  120                   CONTINUE
+                        IF( NOUNIT )
+     $                     TEMP = TEMP/DCONJG( A( I, I ) )
+                     END IF
+                     B( I, J ) = TEMP
+  130             CONTINUE
+  140          CONTINUE
+            ELSE
+               DO 180, J = 1, N
+                  DO 170, I = M, 1, -1
+                     TEMP = ALPHA*B( I, J )
+                     IF( NOCONJ )THEN
+                        DO 150, K = I + 1, M
+                           TEMP = TEMP - A( K, I )*B( K, J )
+  150                   CONTINUE
+                        IF( NOUNIT )
+     $                     TEMP = TEMP/A( I, I )
+                     ELSE
+                        DO 160, K = I + 1, M
+                           TEMP = TEMP - DCONJG( A( K, I ) )*B( K, J )
+  160                   CONTINUE
+                        IF( NOUNIT )
+     $                     TEMP = TEMP/DCONJG( A( I, I ) )
+                     END IF
+                     B( I, J ) = TEMP
+  170             CONTINUE
+  180          CONTINUE
+            END IF
+         END IF
+      ELSE
+         IF( LSAME( TRANSA, 'N' ) )THEN
+*
+*           Form  B := alpha*B*inv( A ).
+*
+            IF( UPPER )THEN
+               DO 230, J = 1, N
+                  IF( ALPHA.NE.ONE )THEN
+                     DO 190, I = 1, M
+                        B( I, J ) = ALPHA*B( I, J )
+  190                CONTINUE
+                  END IF
+                  DO 210, K = 1, J - 1
+                     IF( A( K, J ).NE.ZERO )THEN
+                        DO 200, I = 1, M
+                           B( I, J ) = B( I, J ) - A( K, J )*B( I, K )
+  200                   CONTINUE
+                     END IF
+  210             CONTINUE
+                  IF( NOUNIT )THEN
+                     TEMP = ONE/A( J, J )
+                     DO 220, I = 1, M
+                        B( I, J ) = TEMP*B( I, J )
+  220                CONTINUE
+                  END IF
+  230          CONTINUE
+            ELSE
+               DO 280, J = N, 1, -1
+                  IF( ALPHA.NE.ONE )THEN
+                     DO 240, I = 1, M
+                        B( I, J ) = ALPHA*B( I, J )
+  240                CONTINUE
+                  END IF
+                  DO 260, K = J + 1, N
+                     IF( A( K, J ).NE.ZERO )THEN
+                        DO 250, I = 1, M
+                           B( I, J ) = B( I, J ) - A( K, J )*B( I, K )
+  250                   CONTINUE
+                     END IF
+  260             CONTINUE
+                  IF( NOUNIT )THEN
+                     TEMP = ONE/A( J, J )
+                     DO 270, I = 1, M
+                       B( I, J ) = TEMP*B( I, J )
+  270                CONTINUE
+                  END IF
+  280          CONTINUE
+            END IF
+         ELSE
+*
+*           Form  B := alpha*B*inv( A' )
+*           or    B := alpha*B*inv( conjg( A' ) ).
+*
+            IF( UPPER )THEN
+               DO 330, K = N, 1, -1
+                  IF( NOUNIT )THEN
+                     IF( NOCONJ )THEN
+                        TEMP = ONE/A( K, K )
+                     ELSE
+                        TEMP = ONE/DCONJG( A( K, K ) )
+                     END IF
+                     DO 290, I = 1, M
+                        B( I, K ) = TEMP*B( I, K )
+  290                CONTINUE
+                  END IF
+                  DO 310, J = 1, K - 1
+                     IF( A( J, K ).NE.ZERO )THEN
+                        IF( NOCONJ )THEN
+                           TEMP = A( J, K )
+                        ELSE
+                           TEMP = DCONJG( A( J, K ) )
+                        END IF
+                        DO 300, I = 1, M
+                           B( I, J ) = B( I, J ) - TEMP*B( I, K )
+  300                   CONTINUE
+                     END IF
+  310             CONTINUE
+                  IF( ALPHA.NE.ONE )THEN
+                     DO 320, I = 1, M
+                        B( I, K ) = ALPHA*B( I, K )
+  320                CONTINUE
+                  END IF
+  330          CONTINUE
+            ELSE
+               DO 380, K = 1, N
+                  IF( NOUNIT )THEN
+                     IF( NOCONJ )THEN
+                        TEMP = ONE/A( K, K )
+                     ELSE
+                        TEMP = ONE/DCONJG( A( K, K ) )
+                     END IF
+                     DO 340, I = 1, M
+                        B( I, K ) = TEMP*B( I, K )
+  340                CONTINUE
+                  END IF
+                  DO 360, J = K + 1, N
+                     IF( A( J, K ).NE.ZERO )THEN
+                        IF( NOCONJ )THEN
+                           TEMP = A( J, K )
+                        ELSE
+                           TEMP = DCONJG( A( J, K ) )
+                        END IF
+                        DO 350, I = 1, M
+                           B( I, J ) = B( I, J ) - TEMP*B( I, K )
+  350                   CONTINUE
+                     END IF
+  360             CONTINUE
+                  IF( ALPHA.NE.ONE )THEN
+                     DO 370, I = 1, M
+                        B( I, K ) = ALPHA*B( I, K )
+  370                CONTINUE
+                  END IF
+  380          CONTINUE
+            END IF
+         END IF
+      END IF
+*
+      RETURN
+*
+*     End of ZTRSM .
+*
+      END
diff --git a/src/fortran/blas/ztrsv.f b/src/fortran/blas/ztrsv.f
new file mode 100644
index 0000000..d0a57c4
--- /dev/null
+++ b/src/fortran/blas/ztrsv.f
@@ -0,0 +1,324 @@
+      SUBROUTINE ZTRSV ( UPLO, TRANS, DIAG, N, A, LDA, X, INCX )
+*     .. Scalar Arguments ..
+      INTEGER            INCX, LDA, N
+      CHARACTER*1        DIAG, TRANS, UPLO
+*     .. Array Arguments ..
+      COMPLEX*16         A( LDA, * ), X( * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  ZTRSV  solves one of the systems of equations
+*
+*     A*x = b,   or   A'*x = b,   or   conjg( A' )*x = b,
+*
+*  where b and x are n element vectors and A is an n by n unit, or
+*  non-unit, upper or lower triangular matrix.
+*
+*  No test for singularity or near-singularity is included in this
+*  routine. Such tests must be performed before calling this routine.
+*
+*  Parameters
+*  ==========
+*
+*  UPLO   - CHARACTER*1.
+*           On entry, UPLO specifies whether the matrix is an upper or
+*           lower triangular matrix as follows:
+*
+*              UPLO = 'U' or 'u'   A is an upper triangular matrix.
+*
+*              UPLO = 'L' or 'l'   A is a lower triangular matrix.
+*
+*           Unchanged on exit.
+*
+*  TRANS  - CHARACTER*1.
+*           On entry, TRANS specifies the equations to be solved as
+*           follows:
+*
+*              TRANS = 'N' or 'n'   A*x = b.
+*
+*              TRANS = 'T' or 't'   A'*x = b.
+*
+*              TRANS = 'C' or 'c'   conjg( A' )*x = b.
+*
+*           Unchanged on exit.
+*
+*  DIAG   - CHARACTER*1.
+*           On entry, DIAG specifies whether or not A is unit
+*           triangular as follows:
+*
+*              DIAG = 'U' or 'u'   A is assumed to be unit triangular.
+*
+*              DIAG = 'N' or 'n'   A is not assumed to be unit
+*                                  triangular.
+*
+*           Unchanged on exit.
+*
+*  N      - INTEGER.
+*           On entry, N specifies the order of the matrix A.
+*           N must be at least zero.
+*           Unchanged on exit.
+*
+*  A      - COMPLEX*16       array of DIMENSION ( LDA, n ).
+*           Before entry with  UPLO = 'U' or 'u', the leading n by n
+*           upper triangular part of the array A must contain the upper
+*           triangular matrix and the strictly lower triangular part of
+*           A is not referenced.
+*           Before entry with UPLO = 'L' or 'l', the leading n by n
+*           lower triangular part of the array A must contain the lower
+*           triangular matrix and the strictly upper triangular part of
+*           A is not referenced.
+*           Note that when  DIAG = 'U' or 'u', the diagonal elements of
+*           A are not referenced either, but are assumed to be unity.
+*           Unchanged on exit.
+*
+*  LDA    - INTEGER.
+*           On entry, LDA specifies the first dimension of A as declared
+*           in the calling (sub) program. LDA must be at least
+*           max( 1, n ).
+*           Unchanged on exit.
+*
+*  X      - COMPLEX*16       array of dimension at least
+*           ( 1 + ( n - 1 )*abs( INCX ) ).
+*           Before entry, the incremented array X must contain the n
+*           element right-hand side vector b. On exit, X is overwritten
+*           with the solution vector x.
+*
+*  INCX   - INTEGER.
+*           On entry, INCX specifies the increment for the elements of
+*           X. INCX must not be zero.
+*           Unchanged on exit.
+*
+*
+*  Level 2 Blas routine.
+*
+*  -- Written on 22-October-1986.
+*     Jack Dongarra, Argonne National Lab.
+*     Jeremy Du Croz, Nag Central Office.
+*     Sven Hammarling, Nag Central Office.
+*     Richard Hanson, Sandia National Labs.
+*
+*
+*     .. Parameters ..
+      COMPLEX*16         ZERO
+      PARAMETER        ( ZERO = ( 0.0D+0, 0.0D+0 ) )
+*     .. Local Scalars ..
+      COMPLEX*16         TEMP
+      INTEGER            I, INFO, IX, J, JX, KX
+      LOGICAL            NOCONJ, NOUNIT
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA
+*     .. Intrinsic Functions ..
+      INTRINSIC          DCONJG, MAX
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF     ( .NOT.LSAME( UPLO , 'U' ).AND.
+     $         .NOT.LSAME( UPLO , 'L' )      )THEN
+         INFO = 1
+      ELSE IF( .NOT.LSAME( TRANS, 'N' ).AND.
+     $         .NOT.LSAME( TRANS, 'T' ).AND.
+     $         .NOT.LSAME( TRANS, 'C' )      )THEN
+         INFO = 2
+      ELSE IF( .NOT.LSAME( DIAG , 'U' ).AND.
+     $         .NOT.LSAME( DIAG , 'N' )      )THEN
+         INFO = 3
+      ELSE IF( N.LT.0 )THEN
+         INFO = 4
+      ELSE IF( LDA.LT.MAX( 1, N ) )THEN
+         INFO = 6
+      ELSE IF( INCX.EQ.0 )THEN
+         INFO = 8
+      END IF
+      IF( INFO.NE.0 )THEN
+         CALL XERBLA( 'ZTRSV ', INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF( N.EQ.0 )
+     $   RETURN
+*
+      NOCONJ = LSAME( TRANS, 'T' )
+      NOUNIT = LSAME( DIAG , 'N' )
+*
+*     Set up the start point in X if the increment is not unity. This
+*     will be  ( N - 1 )*INCX  too small for descending loops.
+*
+      IF( INCX.LE.0 )THEN
+         KX = 1 - ( N - 1 )*INCX
+      ELSE IF( INCX.NE.1 )THEN
+         KX = 1
+      END IF
+*
+*     Start the operations. In this version the elements of A are
+*     accessed sequentially with one pass through A.
+*
+      IF( LSAME( TRANS, 'N' ) )THEN
+*
+*        Form  x := inv( A )*x.
+*
+         IF( LSAME( UPLO, 'U' ) )THEN
+            IF( INCX.EQ.1 )THEN
+               DO 20, J = N, 1, -1
+                  IF( X( J ).NE.ZERO )THEN
+                     IF( NOUNIT )
+     $                  X( J ) = X( J )/A( J, J )
+                     TEMP = X( J )
+                     DO 10, I = J - 1, 1, -1
+                        X( I ) = X( I ) - TEMP*A( I, J )
+   10                CONTINUE
+                  END IF
+   20          CONTINUE
+            ELSE
+               JX = KX + ( N - 1 )*INCX
+               DO 40, J = N, 1, -1
+                  IF( X( JX ).NE.ZERO )THEN
+                     IF( NOUNIT )
+     $                  X( JX ) = X( JX )/A( J, J )
+                     TEMP = X( JX )
+                     IX   = JX
+                     DO 30, I = J - 1, 1, -1
+                        IX      = IX      - INCX
+                        X( IX ) = X( IX ) - TEMP*A( I, J )
+   30                CONTINUE
+                  END IF
+                  JX = JX - INCX
+   40          CONTINUE
+            END IF
+         ELSE
+            IF( INCX.EQ.1 )THEN
+               DO 60, J = 1, N
+                  IF( X( J ).NE.ZERO )THEN
+                     IF( NOUNIT )
+     $                  X( J ) = X( J )/A( J, J )
+                     TEMP = X( J )
+                     DO 50, I = J + 1, N
+                        X( I ) = X( I ) - TEMP*A( I, J )
+   50                CONTINUE
+                  END IF
+   60          CONTINUE
+            ELSE
+               JX = KX
+               DO 80, J = 1, N
+                  IF( X( JX ).NE.ZERO )THEN
+                     IF( NOUNIT )
+     $                  X( JX ) = X( JX )/A( J, J )
+                     TEMP = X( JX )
+                     IX   = JX
+                     DO 70, I = J + 1, N
+                        IX      = IX      + INCX
+                        X( IX ) = X( IX ) - TEMP*A( I, J )
+   70                CONTINUE
+                  END IF
+                  JX = JX + INCX
+   80          CONTINUE
+            END IF
+         END IF
+      ELSE
+*
+*        Form  x := inv( A' )*x  or  x := inv( conjg( A' ) )*x.
+*
+         IF( LSAME( UPLO, 'U' ) )THEN
+            IF( INCX.EQ.1 )THEN
+               DO 110, J = 1, N
+                  TEMP = X( J )
+                  IF( NOCONJ )THEN
+                     DO 90, I = 1, J - 1
+                        TEMP = TEMP - A( I, J )*X( I )
+   90                CONTINUE
+                     IF( NOUNIT )
+     $                  TEMP = TEMP/A( J, J )
+                  ELSE
+                     DO 100, I = 1, J - 1
+                        TEMP = TEMP - DCONJG( A( I, J ) )*X( I )
+  100                CONTINUE
+                     IF( NOUNIT )
+     $                  TEMP = TEMP/DCONJG( A( J, J ) )
+                  END IF
+                  X( J ) = TEMP
+  110          CONTINUE
+            ELSE
+               JX = KX
+               DO 140, J = 1, N
+                  IX   = KX
+                  TEMP = X( JX )
+                  IF( NOCONJ )THEN
+                     DO 120, I = 1, J - 1
+                        TEMP = TEMP - A( I, J )*X( IX )
+                        IX   = IX   + INCX
+  120                CONTINUE
+                     IF( NOUNIT )
+     $                  TEMP = TEMP/A( J, J )
+                  ELSE
+                     DO 130, I = 1, J - 1
+                        TEMP = TEMP - DCONJG( A( I, J ) )*X( IX )
+                        IX   = IX   + INCX
+  130                CONTINUE
+                     IF( NOUNIT )
+     $                  TEMP = TEMP/DCONJG( A( J, J ) )
+                  END IF
+                  X( JX ) = TEMP
+                  JX      = JX   + INCX
+  140          CONTINUE
+            END IF
+         ELSE
+            IF( INCX.EQ.1 )THEN
+               DO 170, J = N, 1, -1
+                  TEMP = X( J )
+                  IF( NOCONJ )THEN
+                     DO 150, I = N, J + 1, -1
+                        TEMP = TEMP - A( I, J )*X( I )
+  150                CONTINUE
+                     IF( NOUNIT )
+     $                  TEMP = TEMP/A( J, J )
+                  ELSE
+                     DO 160, I = N, J + 1, -1
+                        TEMP = TEMP - DCONJG( A( I, J ) )*X( I )
+  160                CONTINUE
+                     IF( NOUNIT )
+     $                  TEMP = TEMP/DCONJG( A( J, J ) )
+                  END IF
+                  X( J ) = TEMP
+  170          CONTINUE
+            ELSE
+               KX = KX + ( N - 1 )*INCX
+               JX = KX
+               DO 200, J = N, 1, -1
+                  IX   = KX
+                  TEMP = X( JX )
+                  IF( NOCONJ )THEN
+                     DO 180, I = N, J + 1, -1
+                        TEMP = TEMP - A( I, J )*X( IX )
+                        IX   = IX   - INCX
+  180                CONTINUE
+                     IF( NOUNIT )
+     $                  TEMP = TEMP/A( J, J )
+                  ELSE
+                     DO 190, I = N, J + 1, -1
+                        TEMP = TEMP - DCONJG( A( I, J ) )*X( IX )
+                        IX   = IX   - INCX
+  190                CONTINUE
+                     IF( NOUNIT )
+     $                  TEMP = TEMP/DCONJG( A( J, J ) )
+                  END IF
+                  X( JX ) = TEMP
+                  JX      = JX   - INCX
+  200          CONTINUE
+            END IF
+         END IF
+      END IF
+*
+      RETURN
+*
+*     End of ZTRSV .
+*
+      END