diff options
Diffstat (limited to 'gsl-1.9/blas')
| -rw-r--r-- | gsl-1.9/blas/ChangeLog | 73 | ||||
| -rw-r--r-- | gsl-1.9/blas/Makefile.am | 14 | ||||
| -rw-r--r-- | gsl-1.9/blas/Makefile.in | 453 | ||||
| -rw-r--r-- | gsl-1.9/blas/TODO | 9 | ||||
| -rw-r--r-- | gsl-1.9/blas/blas.c | 2190 | ||||
| -rw-r--r-- | gsl-1.9/blas/gsl_blas.h | 602 | ||||
| -rw-r--r-- | gsl-1.9/blas/gsl_blas_types.h | 54 |
7 files changed, 3395 insertions, 0 deletions
diff --git a/gsl-1.9/blas/ChangeLog b/gsl-1.9/blas/ChangeLog new file mode 100644 index 0000000..4605079 --- /dev/null +++ b/gsl-1.9/blas/ChangeLog @@ -0,0 +1,73 @@ +2005-04-05 Brian Gough <bjg@network-theory.co.uk> + + * blas.c (gsl_blas_ssyrk): test conformance against size correctly + allowing for transpose + +2004-12-21 Brian Gough <bjg@network-theory.co.uk> + + * blas.c (gsl_blas_ssyrk): corrected K to be A->size2 instead of + A->size1 + (gsl_blas_dsyrk): as above + (gsl_blas_csyrk): as above + (gsl_blas_zsyrk): as above + (gsl_blas_cherk): as above + (gsl_blas_zherk): as above + +Mon Mar 18 19:39:34 2002 Brian Gough <bjg@network-theory.co.uk> + + * blas.c (gsl_blas_zgemv): added missing case of CblasConjTrans to + zgemv and cgemv + +Mon Feb 18 20:01:49 2002 Brian Gough <bjg@network-theory.co.uk> + + * gsl_blas_types.h: removed unneeded header files + +Sat Apr 28 15:25:16 2001 Brian Gough <bjg@network-theory.co.uk> + + * blas.c: cast size_t to int for calls to CBLAS + +Mon Mar 19 17:04:47 2001 Brian Gough <bjg@network-theory.co.uk> + + * split cblas routines out into a separate directory and library + which can be used as a cblas outside gsl + +Tue Sep 19 19:07:44 2000 Brian Gough <bjg@network-theory.co.uk> + + * test_blas_raw.c: added tests for dtbsv + +Sat Sep 16 20:27:18 2000 Brian Gough <bjg@network-theory.co.uk> + + * blas.c: use GSL_ERROR macro to signal errors + +Fri Sep 15 20:04:28 2000 Brian Gough <bjg@network-theory.co.uk> + + * source_iamax_r.h source_iamax_c.h: initialize max index to zero + before loop, so that the result is defined for a null vector + +Mon May 22 12:27:47 2000 Brian Gough <bjg@network-theory.co.uk> + + * Makefile.am (lib_LTLIBRARIES): renamed libgslblasnative.la to + libgslblas.la since "native" is ambiguous (suggests + system-supplied blas). + + * test_blas_raw.c (test_L1): added test to cover for initial + run-in of odd lengths on loop unrolling in saxpy. + +Tue Mar 21 14:22:30 2000 Brian Gough <bjg@network-theory.co.uk> + + * test_blas_raw.c (test_L1): test norms for zero vectors + + * source_nrm2_r.h, source_nrm2_r.h: skip zero elements of array, + as in original BLAS, fixes bug for vectors with leading zeros. + +Tue Mar 7 19:05:43 2000 Brian Gough <bjg@network-theory.co.uk> + + * Makefile.am (noinst_LTLIBRARIES): with libtool blasnative and + blascblas layers need to be installed as additional libraries, not + in libgsl.a. + +Fri Oct 1 15:50:14 1999 Brian Gough <bjg@network-theory.co.uk> + + * blas.c: make use of "trailing dimension" in matrix struct to + support LDA arguments for level 2 BLAS. + diff --git a/gsl-1.9/blas/Makefile.am b/gsl-1.9/blas/Makefile.am new file mode 100644 index 0000000..33ee747 --- /dev/null +++ b/gsl-1.9/blas/Makefile.am @@ -0,0 +1,14 @@ +noinst_LTLIBRARIES = libgslblas.la + +pkginclude_HEADERS = gsl_blas.h gsl_blas_types.h + +INCLUDES= -I$(top_srcdir) + +libgslblas_la_SOURCES = blas.c + +#check_PROGRAMS = test +#TESTS = test +#test_LDADD = libgslblas.la ../ieee-utils/libgslieeeutils.la ../err/libgslerr.la ../test/libgsltest.la ../sys/libgslsys.la +#test_SOURCES = test_blas_raw.c test_cases.c test_cases.h + + diff --git a/gsl-1.9/blas/Makefile.in b/gsl-1.9/blas/Makefile.in new file mode 100644 index 0000000..e813d3c --- /dev/null +++ b/gsl-1.9/blas/Makefile.in @@ -0,0 +1,453 @@ +# Makefile.in generated by automake 1.9.6 from Makefile.am. +# @configure_input@ + +# Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, +# 2003, 2004, 2005 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@ + + +srcdir = @srcdir@ +top_srcdir = @top_srcdir@ +VPATH = @srcdir@ +pkgdatadir = $(datadir)/@PACKAGE@ +pkglibdir = $(libdir)/@PACKAGE@ +pkgincludedir = $(includedir)/@PACKAGE@ +top_builddir = .. +am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd +INSTALL = @INSTALL@ +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 = blas +DIST_COMMON = $(pkginclude_HEADERS) $(srcdir)/Makefile.am \ + $(srcdir)/Makefile.in ChangeLog TODO +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 = $(SHELL) $(top_srcdir)/mkinstalldirs +CONFIG_HEADER = $(top_builddir)/config.h +CONFIG_CLEAN_FILES = +LTLIBRARIES = $(noinst_LTLIBRARIES) +libgslblas_la_LIBADD = +am_libgslblas_la_OBJECTS = blas.lo +libgslblas_la_OBJECTS = $(am_libgslblas_la_OBJECTS) +DEFAULT_INCLUDES = -I. -I$(srcdir) -I$(top_builddir) +depcomp = +am__depfiles_maybe = +COMPILE = $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) \ + $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) +LTCOMPILE = $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) \ + $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) \ + $(AM_CFLAGS) $(CFLAGS) +CCLD = $(CC) +LINK = $(LIBTOOL) --tag=CC --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) \ + $(AM_LDFLAGS) $(LDFLAGS) -o $@ +SOURCES = $(libgslblas_la_SOURCES) +DIST_SOURCES = $(libgslblas_la_SOURCES) +am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`; +am__vpath_adj = case $$p in \ + $(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \ + *) f=$$p;; \ + esac; +am__strip_dir = `echo $$p | sed -e 's|^.*/||'`; +am__installdirs = "$(DESTDIR)$(pkgincludedir)" +pkgincludeHEADERS_INSTALL = $(INSTALL_HEADER) +HEADERS = $(pkginclude_HEADERS) +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@ +CFLAGS = @CFLAGS@ +CPP = @CPP@ +CPPFLAGS = @CPPFLAGS@ +CYGPATH_W = @CYGPATH_W@ +DEFS = @DEFS@ +ECHO = @ECHO@ +ECHO_C = @ECHO_C@ +ECHO_N = @ECHO_N@ +ECHO_T = @ECHO_T@ +EGREP = @EGREP@ +EXEEXT = @EXEEXT@ +GSL_CFLAGS = @GSL_CFLAGS@ +GSL_LIBS = @GSL_LIBS@ +GSL_LT_CBLAS_VERSION = @GSL_LT_CBLAS_VERSION@ +GSL_LT_VERSION = @GSL_LT_VERSION@ +HAVE_AIX_IEEE_INTERFACE = @HAVE_AIX_IEEE_INTERFACE@ +HAVE_DARWIN86_IEEE_INTERFACE = @HAVE_DARWIN86_IEEE_INTERFACE@ +HAVE_DARWIN_IEEE_INTERFACE = @HAVE_DARWIN_IEEE_INTERFACE@ +HAVE_EXTENDED_PRECISION_REGISTERS = @HAVE_EXTENDED_PRECISION_REGISTERS@ +HAVE_FREEBSD_IEEE_INTERFACE = @HAVE_FREEBSD_IEEE_INTERFACE@ +HAVE_GNUM68K_IEEE_INTERFACE = @HAVE_GNUM68K_IEEE_INTERFACE@ +HAVE_GNUPPC_IEEE_INTERFACE = @HAVE_GNUPPC_IEEE_INTERFACE@ +HAVE_GNUSPARC_IEEE_INTERFACE = @HAVE_GNUSPARC_IEEE_INTERFACE@ +HAVE_GNUX86_IEEE_INTERFACE = @HAVE_GNUX86_IEEE_INTERFACE@ +HAVE_HPUX11_IEEE_INTERFACE = @HAVE_HPUX11_IEEE_INTERFACE@ +HAVE_HPUX_IEEE_INTERFACE = @HAVE_HPUX_IEEE_INTERFACE@ +HAVE_IEEE_COMPARISONS = @HAVE_IEEE_COMPARISONS@ +HAVE_IEEE_DENORMALS = @HAVE_IEEE_DENORMALS@ +HAVE_INLINE = @HAVE_INLINE@ +HAVE_IRIX_IEEE_INTERFACE = @HAVE_IRIX_IEEE_INTERFACE@ +HAVE_NETBSD_IEEE_INTERFACE = @HAVE_NETBSD_IEEE_INTERFACE@ +HAVE_OPENBSD_IEEE_INTERFACE = @HAVE_OPENBSD_IEEE_INTERFACE@ +HAVE_OS2EMX_IEEE_INTERFACE = @HAVE_OS2EMX_IEEE_INTERFACE@ +HAVE_PRINTF_LONGDOUBLE = @HAVE_PRINTF_LONGDOUBLE@ +HAVE_SOLARIS_IEEE_INTERFACE = @HAVE_SOLARIS_IEEE_INTERFACE@ +HAVE_SUNOS4_IEEE_INTERFACE = @HAVE_SUNOS4_IEEE_INTERFACE@ +HAVE_TRU64_IEEE_INTERFACE = @HAVE_TRU64_IEEE_INTERFACE@ +INSTALL_DATA = @INSTALL_DATA@ +INSTALL_PROGRAM = @INSTALL_PROGRAM@ +INSTALL_SCRIPT = @INSTALL_SCRIPT@ +INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@ +LDFLAGS = @LDFLAGS@ +LIBOBJS = @LIBOBJS@ +LIBS = @LIBS@ +LIBTOOL = @LIBTOOL@ +LN_S = @LN_S@ +LTLIBOBJS = @LTLIBOBJS@ +MAINT = @MAINT@ +MAINTAINER_MODE_FALSE = @MAINTAINER_MODE_FALSE@ +MAINTAINER_MODE_TRUE = @MAINTAINER_MODE_TRUE@ +MAKEINFO = @MAKEINFO@ +OBJEXT = @OBJEXT@ +PACKAGE = @PACKAGE@ +PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@ +PACKAGE_NAME = @PACKAGE_NAME@ +PACKAGE_STRING = @PACKAGE_STRING@ +PACKAGE_TARNAME = @PACKAGE_TARNAME@ +PACKAGE_VERSION = @PACKAGE_VERSION@ +PATH_SEPARATOR = @PATH_SEPARATOR@ +RANLIB = @RANLIB@ +RELEASED = @RELEASED@ +SET_MAKE = @SET_MAKE@ +SHELL = @SHELL@ +STRIP = @STRIP@ +VERSION = @VERSION@ +ac_ct_AR = @ac_ct_AR@ +ac_ct_CC = @ac_ct_CC@ +ac_ct_RANLIB = @ac_ct_RANLIB@ +ac_ct_STRIP = @ac_ct_STRIP@ +am__leading_dot = @am__leading_dot@ +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@ +datadir = @datadir@ +exec_prefix = @exec_prefix@ +host = @host@ +host_alias = @host_alias@ +host_cpu = @host_cpu@ +host_os = @host_os@ +host_vendor = @host_vendor@ +includedir = @includedir@ +infodir = @infodir@ +install_sh = @install_sh@ +libdir = @libdir@ +libexecdir = @libexecdir@ +localstatedir = @localstatedir@ +mandir = @mandir@ +mkdir_p = @mkdir_p@ +oldincludedir = @oldincludedir@ +prefix = @prefix@ +program_transform_name = @program_transform_name@ +sbindir = @sbindir@ +sharedstatedir = @sharedstatedir@ +sysconfdir = @sysconfdir@ +target_alias = @target_alias@ +noinst_LTLIBRARIES = libgslblas.la +pkginclude_HEADERS = gsl_blas.h gsl_blas_types.h +INCLUDES = -I$(top_srcdir) +libgslblas_la_SOURCES = blas.c +all: all-am + +.SUFFIXES: +.SUFFIXES: .c .lo .o .obj +$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am $(am__configure_deps) + @for dep in $?; do \ + case '$(am__configure_deps)' in \ + *$$dep*) \ + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh \ + && exit 0; \ + exit 1;; \ + esac; \ + done; \ + echo ' cd $(top_srcdir) && $(AUTOMAKE) --gnu --ignore-deps blas/Makefile'; \ + cd $(top_srcdir) && \ + $(AUTOMAKE) --gnu --ignore-deps 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 + +clean-noinstLTLIBRARIES: + -test -z "$(noinst_LTLIBRARIES)" || rm -f $(noinst_LTLIBRARIES) + @list='$(noinst_LTLIBRARIES)'; for p in $$list; do \ + dir="`echo $$p | sed -e 's|/[^/]*$$||'`"; \ + test "$$dir" != "$$p" || dir=.; \ + echo "rm -f \"$${dir}/so_locations\""; \ + rm -f "$${dir}/so_locations"; \ + done +libgslblas.la: $(libgslblas_la_OBJECTS) $(libgslblas_la_DEPENDENCIES) + $(LINK) $(libgslblas_la_LDFLAGS) $(libgslblas_la_OBJECTS) $(libgslblas_la_LIBADD) $(LIBS) + +mostlyclean-compile: + -rm -f *.$(OBJEXT) + +distclean-compile: + -rm -f *.tab.c + +.c.o: + $(COMPILE) -c $< + +.c.obj: + $(COMPILE) -c `$(CYGPATH_W) '$<'` + +.c.lo: + $(LTCOMPILE) -c -o $@ $< + +mostlyclean-libtool: + -rm -f *.lo + +clean-libtool: + -rm -rf .libs _libs + +distclean-libtool: + -rm -f libtool +uninstall-info-am: +install-pkgincludeHEADERS: $(pkginclude_HEADERS) + @$(NORMAL_INSTALL) + test -z "$(pkgincludedir)" || $(mkdir_p) "$(DESTDIR)$(pkgincludedir)" + @list='$(pkginclude_HEADERS)'; for p in $$list; do \ + if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \ + f=$(am__strip_dir) \ + echo " $(pkgincludeHEADERS_INSTALL) '$$d$$p' '$(DESTDIR)$(pkgincludedir)/$$f'"; \ + $(pkgincludeHEADERS_INSTALL) "$$d$$p" "$(DESTDIR)$(pkgincludedir)/$$f"; \ + done + +uninstall-pkgincludeHEADERS: + @$(NORMAL_UNINSTALL) + @list='$(pkginclude_HEADERS)'; for p in $$list; do \ + f=$(am__strip_dir) \ + echo " rm -f '$(DESTDIR)$(pkgincludedir)/$$f'"; \ + rm -f "$(DESTDIR)$(pkgincludedir)/$$f"; \ + done + +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; } \ + END { for (i in files) print i; }'`; \ + mkid -fID $$unique +tags: TAGS + +TAGS: $(HEADERS) $(SOURCES) $(TAGS_DEPENDENCIES) \ + $(TAGS_FILES) $(LISP) + tags=; \ + here=`pwd`; \ + list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \ + unique=`for i in $$list; do \ + if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ + done | \ + $(AWK) ' { files[$$0] = 1; } \ + END { for (i in files) print i; }'`; \ + if test -z "$(ETAGS_ARGS)$$tags$$unique"; then :; else \ + test -n "$$unique" || unique=$$empty_fix; \ + $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ + $$tags $$unique; \ + fi +ctags: CTAGS +CTAGS: $(HEADERS) $(SOURCES) $(TAGS_DEPENDENCIES) \ + $(TAGS_FILES) $(LISP) + tags=; \ + 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; } \ + END { for (i in files) print i; }'`; \ + test -z "$(CTAGS_ARGS)$$tags$$unique" \ + || $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \ + $$tags $$unique + +GTAGS: + here=`$(am__cd) $(top_builddir) && pwd` \ + && cd $(top_srcdir) \ + && gtags -i $(GTAGS_ARGS) $$here + +distclean-tags: + -rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags + +distdir: $(DISTFILES) + @srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`; \ + topsrcdirstrip=`echo "$(top_srcdir)" | sed 's|.|.|g'`; \ + list='$(DISTFILES)'; for file in $$list; do \ + case $$file in \ + $(srcdir)/*) file=`echo "$$file" | sed "s|^$$srcdirstrip/||"`;; \ + $(top_srcdir)/*) file=`echo "$$file" | sed "s|^$$topsrcdirstrip/|$(top_builddir)/|"`;; \ + esac; \ + if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \ + dir=`echo "$$file" | sed -e 's,/[^/]*$$,,'`; \ + if test "$$dir" != "$$file" && test "$$dir" != "."; then \ + dir="/$$dir"; \ + $(mkdir_p) "$(distdir)$$dir"; \ + else \ + dir=''; \ + fi; \ + if test -d $$d/$$file; then \ + if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \ + cp -pR $(srcdir)/$$file $(distdir)$$dir || exit 1; \ + fi; \ + cp -pR $$d/$$file $(distdir)$$dir || exit 1; \ + else \ + test -f $(distdir)/$$file \ + || cp -p $$d/$$file $(distdir)/$$file \ + || exit 1; \ + fi; \ + done +check-am: all-am +check: check-am +all-am: Makefile $(LTLIBRARIES) $(HEADERS) +installdirs: + for dir in "$(DESTDIR)$(pkgincludedir)"; do \ + test -z "$$dir" || $(mkdir_p) "$$dir"; \ + done +install: install-am +install-exec: install-exec-am +install-data: install-data-am +uninstall: uninstall-am + +install-am: all-am + @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am + +installcheck: installcheck-am +install-strip: + $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ + install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ + `test -z '$(STRIP)' || \ + echo "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'"` install +mostlyclean-generic: + +clean-generic: + +distclean-generic: + -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) + +maintainer-clean-generic: + @echo "This command is intended for maintainers to use" + @echo "it deletes files that may require special tools to rebuild." +clean: clean-am + +clean-am: clean-generic clean-libtool clean-noinstLTLIBRARIES \ + mostlyclean-am + +distclean: distclean-am + -rm -f Makefile +distclean-am: clean-am distclean-compile distclean-generic \ + distclean-libtool distclean-tags + +dvi: dvi-am + +dvi-am: + +html: html-am + +info: info-am + +info-am: + +install-data-am: install-pkgincludeHEADERS + +install-exec-am: + +install-info: install-info-am + +install-man: + +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-info-am uninstall-pkgincludeHEADERS + +.PHONY: CTAGS GTAGS all all-am check check-am clean clean-generic \ + clean-libtool clean-noinstLTLIBRARIES 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-exec \ + install-exec-am install-info install-info-am install-man \ + install-pkgincludeHEADERS 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-info-am \ + uninstall-pkgincludeHEADERS + + +#check_PROGRAMS = test +#TESTS = test +#test_LDADD = libgslblas.la ../ieee-utils/libgslieeeutils.la ../err/libgslerr.la ../test/libgsltest.la ../sys/libgslsys.la +#test_SOURCES = test_blas_raw.c test_cases.c test_cases.h +# 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/gsl-1.9/blas/TODO b/gsl-1.9/blas/TODO new file mode 100644 index 0000000..ffc34e5 --- /dev/null +++ b/gsl-1.9/blas/TODO @@ -0,0 +1,9 @@ + +* We need a test suite for this directory! + +* Verify that we support the full CBLAS interface and that the GSL +CBLAS library can be used standalone + +* Check that substituting the Reference Blas, ATLAS, and Intel BLAS +all work correctly + diff --git a/gsl-1.9/blas/blas.c b/gsl-1.9/blas/blas.c new file mode 100644 index 0000000..56ca963 --- /dev/null +++ b/gsl-1.9/blas/blas.c @@ -0,0 +1,2190 @@ +/* blas/blas.c + * + * Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001 Gerard Jungman & Brian + * Gough + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or (at + * your option) any later version. + * + * This program is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. + */ + +/* GSL implementation of BLAS operations for vectors and dense + * matrices. Note that GSL native storage is row-major. */ + +#include <config.h> +#include <gsl/gsl_math.h> +#include <gsl/gsl_errno.h> +#include <gsl/gsl_cblas.h> +#include <gsl/gsl_cblas.h> +#include <gsl/gsl_blas_types.h> +#include <gsl/gsl_blas.h> + +/* ======================================================================== + * Level 1 + * ======================================================================== + */ + +/* CBLAS defines vector sizes in terms of int. GSL defines sizes in + terms of size_t, so we need to convert these into integers. There + is the possibility of overflow here. FIXME: Maybe this could be + caught */ + +#define INT(X) ((int)(X)) + +int +gsl_blas_sdsdot (float alpha, const gsl_vector_float * X, + const gsl_vector_float * Y, float *result) +{ + if (X->size == Y->size) + { + *result = + cblas_sdsdot (INT (X->size), alpha, X->data, INT (X->stride), Y->data, + INT (Y->stride)); + return GSL_SUCCESS; + } + else + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } +} + +int +gsl_blas_dsdot (const gsl_vector_float * X, const gsl_vector_float * Y, + double *result) +{ + if (X->size == Y->size) + { + *result = + cblas_dsdot (INT (X->size), X->data, INT (X->stride), Y->data, + INT (Y->stride)); + return GSL_SUCCESS; + } + else + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } +} + +int +gsl_blas_sdot (const gsl_vector_float * X, const gsl_vector_float * Y, + float *result) +{ + if (X->size == Y->size) + { + *result = + cblas_sdot (INT (X->size), X->data, INT (X->stride), Y->data, + INT (Y->stride)); + return GSL_SUCCESS; + } + else + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } +} + +int +gsl_blas_ddot (const gsl_vector * X, const gsl_vector * Y, double *result) +{ + if (X->size == Y->size) + { + *result = + cblas_ddot (INT (X->size), X->data, INT (X->stride), Y->data, + INT (Y->stride)); + return GSL_SUCCESS; + } + else + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } +} + + +int +gsl_blas_cdotu (const gsl_vector_complex_float * X, + const gsl_vector_complex_float * Y, gsl_complex_float * dotu) +{ + if (X->size == Y->size) + { + cblas_cdotu_sub (INT (X->size), X->data, INT (X->stride), Y->data, + INT (Y->stride), GSL_COMPLEX_P (dotu)); + return GSL_SUCCESS; + } + else + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } +} + + +int +gsl_blas_cdotc (const gsl_vector_complex_float * X, + const gsl_vector_complex_float * Y, gsl_complex_float * dotc) +{ + if (X->size == Y->size) + { + cblas_cdotc_sub (INT (X->size), X->data, INT (X->stride), Y->data, + INT (Y->stride), GSL_COMPLEX_P (dotc)); + return GSL_SUCCESS; + } + else + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } +} + + +int +gsl_blas_zdotu (const gsl_vector_complex * X, const gsl_vector_complex * Y, + gsl_complex * dotu) +{ + if (X->size == Y->size) + { + cblas_zdotu_sub (INT (X->size), X->data, INT (X->stride), Y->data, + INT (Y->stride), GSL_COMPLEX_P (dotu)); + return GSL_SUCCESS; + } + else + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } +} + + +int +gsl_blas_zdotc (const gsl_vector_complex * X, const gsl_vector_complex * Y, + gsl_complex * dotc) +{ + if (X->size == Y->size) + { + cblas_zdotc_sub (INT (X->size), X->data, INT (X->stride), Y->data, + INT (Y->stride), GSL_COMPLEX_P (dotc)); + return GSL_SUCCESS; + } + else + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } +} + +/* Norms of vectors */ + +float +gsl_blas_snrm2 (const gsl_vector_float * X) +{ + return cblas_snrm2 (INT (X->size), X->data, INT (X->stride)); +} + +double +gsl_blas_dnrm2 (const gsl_vector * X) +{ + return cblas_dnrm2 (INT (X->size), X->data, INT (X->stride)); +} + +float +gsl_blas_scnrm2 (const gsl_vector_complex_float * X) +{ + return cblas_scnrm2 (INT (X->size), X->data, INT (X->stride)); +} + +double +gsl_blas_dznrm2 (const gsl_vector_complex * X) +{ + return cblas_dznrm2 (INT (X->size), X->data, INT (X->stride)); +} + +/* Absolute sums of vectors */ + +float +gsl_blas_sasum (const gsl_vector_float * X) +{ + return cblas_sasum (INT (X->size), X->data, INT (X->stride)); +} + +double +gsl_blas_dasum (const gsl_vector * X) +{ + return cblas_dasum (INT (X->size), X->data, INT (X->stride)); +} + +float +gsl_blas_scasum (const gsl_vector_complex_float * X) +{ + return cblas_scasum (INT (X->size), X->data, INT (X->stride)); +} + +double +gsl_blas_dzasum (const gsl_vector_complex * X) +{ + return cblas_dzasum (INT (X->size), X->data, INT (X->stride)); +} + +/* Maximum elements of vectors */ + +CBLAS_INDEX_t +gsl_blas_isamax (const gsl_vector_float * X) +{ + return cblas_isamax (INT (X->size), X->data, INT (X->stride)); +} + +CBLAS_INDEX_t +gsl_blas_idamax (const gsl_vector * X) +{ + return cblas_idamax (INT (X->size), X->data, INT (X->stride)); +} + +CBLAS_INDEX_t +gsl_blas_icamax (const gsl_vector_complex_float * X) +{ + return cblas_icamax (INT (X->size), X->data, INT (X->stride)); +} + +CBLAS_INDEX_t +gsl_blas_izamax (const gsl_vector_complex * X) +{ + return cblas_izamax (INT (X->size), X->data, INT (X->stride)); +} + + +/* Swap vectors */ + +int +gsl_blas_sswap (gsl_vector_float * X, gsl_vector_float * Y) +{ + if (X->size == Y->size) + { + cblas_sswap (INT (X->size), X->data, INT (X->stride), Y->data, + INT (Y->stride)); + return GSL_SUCCESS; + } + else + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } +} + +int +gsl_blas_dswap (gsl_vector * X, gsl_vector * Y) +{ + if (X->size == Y->size) + { + cblas_dswap (INT (X->size), X->data, INT (X->stride), Y->data, + INT (Y->stride)); + return GSL_SUCCESS; + } + else + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + }; +} + +int +gsl_blas_cswap (gsl_vector_complex_float * X, gsl_vector_complex_float * Y) +{ + if (X->size == Y->size) + { + cblas_cswap (INT (X->size), X->data, INT (X->stride), Y->data, + INT (Y->stride)); + return GSL_SUCCESS; + } + else + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } +} + +int +gsl_blas_zswap (gsl_vector_complex * X, gsl_vector_complex * Y) +{ + if (X->size == Y->size) + { + cblas_zswap (INT (X->size), X->data, INT (X->stride), Y->data, + INT (Y->stride)); + return GSL_SUCCESS; + } + else + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } +} + + +/* Copy vectors */ + +int +gsl_blas_scopy (const gsl_vector_float * X, gsl_vector_float * Y) +{ + if (X->size == Y->size) + { + cblas_scopy (INT (X->size), X->data, INT (X->stride), Y->data, + INT (Y->stride)); + return GSL_SUCCESS; + } + else + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } +} + +int +gsl_blas_dcopy (const gsl_vector * X, gsl_vector * Y) +{ + if (X->size == Y->size) + { + cblas_dcopy (INT (X->size), X->data, INT (X->stride), Y->data, + INT (Y->stride)); + return GSL_SUCCESS; + } + else + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } +} + +int +gsl_blas_ccopy (const gsl_vector_complex_float * X, + gsl_vector_complex_float * Y) +{ + if (X->size == Y->size) + { + cblas_ccopy (INT (X->size), X->data, INT (X->stride), Y->data, + INT (Y->stride)); + return GSL_SUCCESS; + } + else + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } +} + +int +gsl_blas_zcopy (const gsl_vector_complex * X, gsl_vector_complex * Y) +{ + if (X->size == Y->size) + { + cblas_zcopy (INT (X->size), X->data, INT (X->stride), Y->data, + INT (Y->stride)); + return GSL_SUCCESS; + } + else + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } +} + + +/* Compute Y = alpha X + Y */ + +int +gsl_blas_saxpy (float alpha, const gsl_vector_float * X, gsl_vector_float * Y) +{ + if (X->size == Y->size) + { + cblas_saxpy (INT (X->size), alpha, X->data, INT (X->stride), Y->data, + INT (Y->stride)); + return GSL_SUCCESS; + } + else + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } +} + +int +gsl_blas_daxpy (double alpha, const gsl_vector * X, gsl_vector * Y) +{ + if (X->size == Y->size) + { + cblas_daxpy (INT (X->size), alpha, X->data, INT (X->stride), Y->data, + INT (Y->stride)); + return GSL_SUCCESS; + } + else + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } +} + +int +gsl_blas_caxpy (const gsl_complex_float alpha, + const gsl_vector_complex_float * X, + gsl_vector_complex_float * Y) +{ + if (X->size == Y->size) + { + cblas_caxpy (INT (X->size), GSL_COMPLEX_P (&alpha), X->data, + INT (X->stride), Y->data, INT (Y->stride)); + return GSL_SUCCESS; + } + else + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } +} + +int +gsl_blas_zaxpy (const gsl_complex alpha, const gsl_vector_complex * X, + gsl_vector_complex * Y) +{ + if (X->size == Y->size) + { + cblas_zaxpy (INT (X->size), GSL_COMPLEX_P (&alpha), X->data, + INT (X->stride), Y->data, INT (Y->stride)); + return GSL_SUCCESS; + } + else + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } +} + +/* Generate rotation */ + +int +gsl_blas_srotg (float a[], float b[], float c[], float s[]) +{ + cblas_srotg (a, b, c, s); + return GSL_SUCCESS; +} + +int +gsl_blas_drotg (double a[], double b[], double c[], double s[]) +{ + cblas_drotg (a, b, c, s); + return GSL_SUCCESS; +} + +/* Apply rotation to vectors */ + +int +gsl_blas_srot (gsl_vector_float * X, gsl_vector_float * Y, float c, float s) +{ + if (X->size == Y->size) + { + cblas_srot (INT (X->size), X->data, INT (X->stride), Y->data, + INT (Y->stride), c, s); + return GSL_SUCCESS; + } + else + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } +} + +int +gsl_blas_drot (gsl_vector * X, gsl_vector * Y, const double c, const double s) +{ + if (X->size == Y->size) + { + cblas_drot (INT (X->size), X->data, INT (X->stride), Y->data, + INT (Y->stride), c, s); + return GSL_SUCCESS; + } + else + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } +} + + +/* Generate modified rotation */ + +int +gsl_blas_srotmg (float d1[], float d2[], float b1[], float b2, float P[]) +{ + cblas_srotmg (d1, d2, b1, b2, P); + return GSL_SUCCESS; +} + +int +gsl_blas_drotmg (double d1[], double d2[], double b1[], double b2, double P[]) +{ + cblas_drotmg (d1, d2, b1, b2, P); + return GSL_SUCCESS; +} + + +/* Apply modified rotation */ + +int +gsl_blas_srotm (gsl_vector_float * X, gsl_vector_float * Y, const float P[]) +{ + if (X->size == Y->size) + { + cblas_srotm (INT (X->size), X->data, INT (X->stride), Y->data, + INT (Y->stride), P); + return GSL_SUCCESS; + } + else + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } +} + +int +gsl_blas_drotm (gsl_vector * X, gsl_vector * Y, const double P[]) +{ + if (X->size != Y->size) + { + cblas_drotm (INT (X->size), X->data, INT (X->stride), Y->data, + INT (Y->stride), P); + return GSL_SUCCESS; + } + else + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } +} + + +/* Scale vector */ + +void +gsl_blas_sscal (float alpha, gsl_vector_float * X) +{ + cblas_sscal (INT (X->size), alpha, X->data, INT (X->stride)); +} + +void +gsl_blas_dscal (double alpha, gsl_vector * X) +{ + cblas_dscal (INT (X->size), alpha, X->data, INT (X->stride)); +} + +void +gsl_blas_cscal (const gsl_complex_float alpha, gsl_vector_complex_float * X) +{ + cblas_cscal (INT (X->size), GSL_COMPLEX_P (&alpha), X->data, + INT (X->stride)); +} + +void +gsl_blas_zscal (const gsl_complex alpha, gsl_vector_complex * X) +{ + cblas_zscal (INT (X->size), GSL_COMPLEX_P (&alpha), X->data, + INT (X->stride)); +} + +void +gsl_blas_csscal (float alpha, gsl_vector_complex_float * X) +{ + cblas_csscal (INT (X->size), alpha, X->data, INT (X->stride)); +} + +void +gsl_blas_zdscal (double alpha, gsl_vector_complex * X) +{ + cblas_zdscal (INT (X->size), alpha, X->data, INT (X->stride)); +} + +/* =========================================================================== + * Level 2 + * =========================================================================== + */ + +/* GEMV */ + +int +gsl_blas_sgemv (CBLAS_TRANSPOSE_t TransA, float alpha, + const gsl_matrix_float * A, const gsl_vector_float * X, + float beta, gsl_vector_float * Y) +{ + const size_t M = A->size1; + const size_t N = A->size2; + + if ((TransA == CblasNoTrans && N == X->size && M == Y->size) + || (TransA == CblasTrans && M == X->size && N == Y->size)) + { + cblas_sgemv (CblasRowMajor, TransA, INT (M), INT (N), alpha, A->data, + INT (A->tda), X->data, INT (X->stride), beta, Y->data, + INT (Y->stride)); + return GSL_SUCCESS; + } + else + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } +} + + +int +gsl_blas_dgemv (CBLAS_TRANSPOSE_t TransA, double alpha, const gsl_matrix * A, + const gsl_vector * X, double beta, gsl_vector * Y) +{ + const size_t M = A->size1; + const size_t N = A->size2; + + if ((TransA == CblasNoTrans && N == X->size && M == Y->size) + || (TransA == CblasTrans && M == X->size && N == Y->size)) + { + cblas_dgemv (CblasRowMajor, TransA, INT (M), INT (N), alpha, A->data, + INT (A->tda), X->data, INT (X->stride), beta, Y->data, + INT (Y->stride)); + return GSL_SUCCESS; + } + else + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } +} + + +int +gsl_blas_cgemv (CBLAS_TRANSPOSE_t TransA, const gsl_complex_float alpha, + const gsl_matrix_complex_float * A, + const gsl_vector_complex_float * X, + const gsl_complex_float beta, gsl_vector_complex_float * Y) +{ + const size_t M = A->size1; + const size_t N = A->size2; + + if ((TransA == CblasNoTrans && N == X->size && M == Y->size) + || (TransA == CblasTrans && M == X->size && N == Y->size) + || (TransA == CblasConjTrans && M == X->size && N == Y->size)) + { + cblas_cgemv (CblasRowMajor, TransA, INT (M), INT (N), + GSL_COMPLEX_P (&alpha), A->data, INT (A->tda), X->data, + INT (X->stride), GSL_COMPLEX_P (&beta), Y->data, + INT (Y->stride)); + return GSL_SUCCESS; + } + else + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } +} + + +int +gsl_blas_zgemv (CBLAS_TRANSPOSE_t TransA, const gsl_complex alpha, + const gsl_matrix_complex * A, const gsl_vector_complex * X, + const gsl_complex beta, gsl_vector_complex * Y) +{ + const size_t M = A->size1; + const size_t N = A->size2; + + if ((TransA == CblasNoTrans && N == X->size && M == Y->size) + || (TransA == CblasTrans && M == X->size && N == Y->size) + || (TransA == CblasConjTrans && M == X->size && N == Y->size)) + { + cblas_zgemv (CblasRowMajor, TransA, INT (M), INT (N), + GSL_COMPLEX_P (&alpha), A->data, INT (A->tda), X->data, + INT (X->stride), GSL_COMPLEX_P (&beta), Y->data, + INT (Y->stride)); + return GSL_SUCCESS; + } + else + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } +} + + + +/* HEMV */ + +int +gsl_blas_chemv (CBLAS_UPLO_t Uplo, const gsl_complex_float alpha, + const gsl_matrix_complex_float * A, + const gsl_vector_complex_float * X, + const gsl_complex_float beta, gsl_vector_complex_float * Y) +{ + const size_t M = A->size1; + const size_t N = A->size2; + + if (M != N) + { + GSL_ERROR ("matrix must be square", GSL_ENOTSQR); + } + else if (N != X->size || N != Y->size) + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } + + cblas_chemv (CblasRowMajor, Uplo, INT (N), GSL_COMPLEX_P (&alpha), A->data, + INT (A->tda), X->data, INT (X->stride), GSL_COMPLEX_P (&beta), + Y->data, INT (Y->stride)); + return GSL_SUCCESS; +} + +int +gsl_blas_zhemv (CBLAS_UPLO_t Uplo, const gsl_complex alpha, + const gsl_matrix_complex * A, const gsl_vector_complex * X, + const gsl_complex beta, gsl_vector_complex * Y) +{ + const size_t M = A->size1; + const size_t N = A->size2; + + if (M != N) + { + GSL_ERROR ("matrix must be square", GSL_ENOTSQR); + } + else if (N != X->size || N != Y->size) + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } + + cblas_zhemv (CblasRowMajor, Uplo, INT (N), GSL_COMPLEX_P (&alpha), A->data, + INT (A->tda), X->data, INT (X->stride), GSL_COMPLEX_P (&beta), + Y->data, INT (Y->stride)); + return GSL_SUCCESS; +} + + +/* SYMV */ + +int +gsl_blas_ssymv (CBLAS_UPLO_t Uplo, float alpha, const gsl_matrix_float * A, + const gsl_vector_float * X, float beta, gsl_vector_float * Y) +{ + const size_t M = A->size1; + const size_t N = A->size2; + + if (M != N) + { + GSL_ERROR ("matrix must be square", GSL_ENOTSQR); + } + else if (N != X->size || N != Y->size) + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } + + cblas_ssymv (CblasRowMajor, Uplo, INT (N), alpha, A->data, INT (A->tda), + X->data, INT (X->stride), beta, Y->data, INT (Y->stride)); + return GSL_SUCCESS; +} + +int +gsl_blas_dsymv (CBLAS_UPLO_t Uplo, double alpha, const gsl_matrix * A, + const gsl_vector * X, double beta, gsl_vector * Y) +{ + const size_t M = A->size1; + const size_t N = A->size2; + + if (M != N) + { + GSL_ERROR ("matrix must be square", GSL_ENOTSQR); + } + else if (N != X->size || N != Y->size) + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } + + cblas_dsymv (CblasRowMajor, Uplo, INT (N), alpha, A->data, INT (A->tda), + X->data, INT (X->stride), beta, Y->data, INT (Y->stride)); + return GSL_SUCCESS; +} + + +/* TRMV */ + +int +gsl_blas_strmv (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t TransA, + CBLAS_DIAG_t Diag, const gsl_matrix_float * A, + gsl_vector_float * X) +{ + const size_t M = A->size1; + const size_t N = A->size2; + + if (M != N) + { + GSL_ERROR ("matrix must be square", GSL_ENOTSQR); + } + else if (N != X->size) + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } + + cblas_strmv (CblasRowMajor, Uplo, TransA, Diag, INT (N), A->data, + INT (A->tda), X->data, INT (X->stride)); + return GSL_SUCCESS; +} + + +int +gsl_blas_dtrmv (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t TransA, + CBLAS_DIAG_t Diag, const gsl_matrix * A, gsl_vector * X) +{ + const size_t M = A->size1; + const size_t N = A->size2; + + if (M != N) + { + GSL_ERROR ("matrix must be square", GSL_ENOTSQR); + } + else if (N != X->size) + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } + + cblas_dtrmv (CblasRowMajor, Uplo, TransA, Diag, INT (N), A->data, + INT (A->tda), X->data, INT (X->stride)); + return GSL_SUCCESS; +} + + +int +gsl_blas_ctrmv (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t TransA, + CBLAS_DIAG_t Diag, const gsl_matrix_complex_float * A, + gsl_vector_complex_float * X) +{ + const size_t M = A->size1; + const size_t N = A->size2; + + if (M != N) + { + GSL_ERROR ("matrix must be square", GSL_ENOTSQR); + } + else if (N != X->size) + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } + + cblas_ctrmv (CblasRowMajor, Uplo, TransA, Diag, INT (N), A->data, + INT (A->tda), X->data, INT (X->stride)); + return GSL_SUCCESS; +} + + +int +gsl_blas_ztrmv (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t TransA, + CBLAS_DIAG_t Diag, const gsl_matrix_complex * A, + gsl_vector_complex * X) +{ + const size_t M = A->size1; + const size_t N = A->size2; + + if (M != N) + { + GSL_ERROR ("matrix must be square", GSL_ENOTSQR); + } + else if (N != X->size) + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } + + cblas_ztrmv (CblasRowMajor, Uplo, TransA, Diag, INT (N), A->data, + INT (A->tda), X->data, INT (X->stride)); + return GSL_SUCCESS; +} + + +/* TRSV */ + +int +gsl_blas_strsv (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t TransA, + CBLAS_DIAG_t Diag, const gsl_matrix_float * A, + gsl_vector_float * X) +{ + const size_t M = A->size1; + const size_t N = A->size2; + + if (M != N) + { + GSL_ERROR ("matrix must be square", GSL_ENOTSQR); + } + else if (N != X->size) + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } + + cblas_strsv (CblasRowMajor, Uplo, TransA, Diag, INT (N), A->data, + INT (A->tda), X->data, INT (X->stride)); + return GSL_SUCCESS; +} + + +int +gsl_blas_dtrsv (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t TransA, + CBLAS_DIAG_t Diag, const gsl_matrix * A, gsl_vector * X) +{ + const size_t M = A->size1; + const size_t N = A->size2; + + if (M != N) + { + GSL_ERROR ("matrix must be square", GSL_ENOTSQR); + } + else if (N != X->size) + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } + + cblas_dtrsv (CblasRowMajor, Uplo, TransA, Diag, INT (N), A->data, + INT (A->tda), X->data, INT (X->stride)); + return GSL_SUCCESS; +} + + +int +gsl_blas_ctrsv (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t TransA, + CBLAS_DIAG_t Diag, const gsl_matrix_complex_float * A, + gsl_vector_complex_float * X) +{ + const size_t M = A->size1; + const size_t N = A->size2; + + if (M != N) + { + GSL_ERROR ("matrix must be square", GSL_ENOTSQR); + } + else if (N != X->size) + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } + + cblas_ctrsv (CblasRowMajor, Uplo, TransA, Diag, INT (N), A->data, + INT (A->tda), X->data, INT (X->stride)); + return GSL_SUCCESS; +} + + +int +gsl_blas_ztrsv (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t TransA, + CBLAS_DIAG_t Diag, const gsl_matrix_complex * A, + gsl_vector_complex * X) +{ + const size_t M = A->size1; + const size_t N = A->size2; + + if (M != N) + { + GSL_ERROR ("matrix must be square", GSL_ENOTSQR); + } + else if (N != X->size) + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } + + cblas_ztrsv (CblasRowMajor, Uplo, TransA, Diag, INT (N), A->data, + INT (A->tda), X->data, INT (X->stride)); + return GSL_SUCCESS; +} + + +/* GER */ + +int +gsl_blas_sger (float alpha, const gsl_vector_float * X, + const gsl_vector_float * Y, gsl_matrix_float * A) +{ + const size_t M = A->size1; + const size_t N = A->size2; + + if (X->size == M && Y->size == N) + { + cblas_sger (CblasRowMajor, INT (M), INT (N), alpha, X->data, + INT (X->stride), Y->data, INT (Y->stride), A->data, + INT (A->tda)); + return GSL_SUCCESS; + } + else + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } +} + + +int +gsl_blas_dger (double alpha, const gsl_vector * X, const gsl_vector * Y, + gsl_matrix * A) +{ + const size_t M = A->size1; + const size_t N = A->size2; + + if (X->size == M && Y->size == N) + { + cblas_dger (CblasRowMajor, INT (M), INT (N), alpha, X->data, + INT (X->stride), Y->data, INT (Y->stride), A->data, + INT (A->tda)); + return GSL_SUCCESS; + } + else + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } +} + + +/* GERU */ + +int +gsl_blas_cgeru (const gsl_complex_float alpha, + const gsl_vector_complex_float * X, + const gsl_vector_complex_float * Y, + gsl_matrix_complex_float * A) +{ + const size_t M = A->size1; + const size_t N = A->size2; + + if (X->size == M && Y->size == N) + { + cblas_cgeru (CblasRowMajor, INT (M), INT (N), GSL_COMPLEX_P (&alpha), + X->data, INT (X->stride), Y->data, INT (Y->stride), + A->data, INT (A->tda)); + return GSL_SUCCESS; + } + else + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } +} + +int +gsl_blas_zgeru (const gsl_complex alpha, const gsl_vector_complex * X, + const gsl_vector_complex * Y, gsl_matrix_complex * A) +{ + const size_t M = A->size1; + const size_t N = A->size2; + + if (X->size == M && Y->size == N) + { + cblas_zgeru (CblasRowMajor, INT (M), INT (N), GSL_COMPLEX_P (&alpha), + X->data, INT (X->stride), Y->data, INT (Y->stride), + A->data, INT (A->tda)); + return GSL_SUCCESS; + } + else + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } +} + + +/* GERC */ + +int +gsl_blas_cgerc (const gsl_complex_float alpha, + const gsl_vector_complex_float * X, + const gsl_vector_complex_float * Y, + gsl_matrix_complex_float * A) +{ + const size_t M = A->size1; + const size_t N = A->size2; + + if (X->size == M && Y->size == N) + { + cblas_cgerc (CblasRowMajor, INT (M), INT (N), GSL_COMPLEX_P (&alpha), + X->data, INT (X->stride), Y->data, INT (Y->stride), + A->data, INT (A->tda)); + return GSL_SUCCESS; + } + else + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } +} + + +int +gsl_blas_zgerc (const gsl_complex alpha, const gsl_vector_complex * X, + const gsl_vector_complex * Y, gsl_matrix_complex * A) +{ + const size_t M = A->size1; + const size_t N = A->size2; + + if (X->size == M && Y->size == N) + { + cblas_zgerc (CblasRowMajor, INT (M), INT (N), GSL_COMPLEX_P (&alpha), + X->data, INT (X->stride), Y->data, INT (Y->stride), + A->data, INT (A->tda)); + return GSL_SUCCESS; + } + else + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } +} + +/* HER */ + +int +gsl_blas_cher (CBLAS_UPLO_t Uplo, float alpha, + const gsl_vector_complex_float * X, + gsl_matrix_complex_float * A) +{ + const size_t M = A->size1; + const size_t N = A->size2; + + if (M != N) + { + GSL_ERROR ("matrix must be square", GSL_ENOTSQR); + } + else if (X->size != N) + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } + + cblas_cher (CblasRowMajor, Uplo, INT (M), alpha, X->data, INT (X->stride), + A->data, INT (A->tda)); + return GSL_SUCCESS; +} + + +int +gsl_blas_zher (CBLAS_UPLO_t Uplo, double alpha, const gsl_vector_complex * X, + gsl_matrix_complex * A) +{ + const size_t M = A->size1; + const size_t N = A->size2; + + if (M != N) + { + GSL_ERROR ("matrix must be square", GSL_ENOTSQR); + } + else if (X->size != N) + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } + + cblas_zher (CblasRowMajor, Uplo, INT (N), alpha, X->data, INT (X->stride), + A->data, INT (A->tda)); + return GSL_SUCCESS; +} + + +/* HER2 */ + +int +gsl_blas_cher2 (CBLAS_UPLO_t Uplo, const gsl_complex_float alpha, + const gsl_vector_complex_float * X, + const gsl_vector_complex_float * Y, + gsl_matrix_complex_float * A) +{ + const size_t M = A->size1; + const size_t N = A->size2; + + if (M != N) + { + GSL_ERROR ("matrix must be square", GSL_ENOTSQR); + } + else if (X->size != N || Y->size != N) + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } + + cblas_cher2 (CblasRowMajor, Uplo, INT (N), GSL_COMPLEX_P (&alpha), X->data, + INT (X->stride), Y->data, INT (Y->stride), A->data, + INT (A->tda)); + return GSL_SUCCESS; +} + + +int +gsl_blas_zher2 (CBLAS_UPLO_t Uplo, const gsl_complex alpha, + const gsl_vector_complex * X, const gsl_vector_complex * Y, + gsl_matrix_complex * A) +{ + const size_t M = A->size1; + const size_t N = A->size2; + + if (M != N) + { + GSL_ERROR ("matrix must be square", GSL_ENOTSQR); + } + else if (X->size != N || Y->size != N) + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } + + cblas_zher2 (CblasRowMajor, Uplo, INT (N), GSL_COMPLEX_P (&alpha), X->data, + INT (X->stride), Y->data, INT (Y->stride), A->data, + INT (A->tda)); + return GSL_SUCCESS; +} + + +/* SYR */ + +int +gsl_blas_ssyr (CBLAS_UPLO_t Uplo, float alpha, const gsl_vector_float * X, + gsl_matrix_float * A) +{ + const size_t M = A->size1; + const size_t N = A->size2; + + if (M != N) + { + GSL_ERROR ("matrix must be square", GSL_ENOTSQR); + } + else if (X->size != N) + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } + + cblas_ssyr (CblasRowMajor, Uplo, INT (N), alpha, X->data, INT (X->stride), + A->data, INT (A->tda)); + return GSL_SUCCESS; +} + + +int +gsl_blas_dsyr (CBLAS_UPLO_t Uplo, double alpha, const gsl_vector * X, + gsl_matrix * A) +{ + const size_t M = A->size1; + const size_t N = A->size2; + + if (M != N) + { + GSL_ERROR ("matrix must be square", GSL_ENOTSQR); + } + else if (X->size != N) + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } + + cblas_dsyr (CblasRowMajor, Uplo, INT (N), alpha, X->data, INT (X->stride), + A->data, INT (A->tda)); + return GSL_SUCCESS; +} + + +/* SYR2 */ + +int +gsl_blas_ssyr2 (CBLAS_UPLO_t Uplo, float alpha, const gsl_vector_float * X, + const gsl_vector_float * Y, gsl_matrix_float * A) +{ + const size_t M = A->size1; + const size_t N = A->size2; + + if (M != N) + { + GSL_ERROR ("matrix must be square", GSL_ENOTSQR); + } + else if (X->size != N || Y->size != N) + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } + + cblas_ssyr2 (CblasRowMajor, Uplo, INT (N), alpha, X->data, INT (X->stride), + Y->data, INT (Y->stride), A->data, INT (A->tda)); + return GSL_SUCCESS; +} + + +int +gsl_blas_dsyr2 (CBLAS_UPLO_t Uplo, double alpha, const gsl_vector * X, + const gsl_vector * Y, gsl_matrix * A) +{ + const size_t M = A->size1; + const size_t N = A->size2; + + if (M != N) + { + GSL_ERROR ("matrix must be square", GSL_ENOTSQR); + } + else if (X->size != N || Y->size != N) + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } + + cblas_dsyr2 (CblasRowMajor, Uplo, INT (N), alpha, X->data, INT (X->stride), + Y->data, INT (Y->stride), A->data, INT (A->tda)); + return GSL_SUCCESS; +} + + +/* + * =========================================================================== + * Prototypes for level 3 BLAS + * =========================================================================== + */ + + +/* GEMM */ + +int +gsl_blas_sgemm (CBLAS_TRANSPOSE_t TransA, CBLAS_TRANSPOSE_t TransB, + float alpha, const gsl_matrix_float * A, + const gsl_matrix_float * B, float beta, gsl_matrix_float * C) +{ + const size_t M = C->size1; + const size_t N = C->size2; + const size_t MA = (TransA == CblasNoTrans) ? A->size1 : A->size2; + const size_t NA = (TransA == CblasNoTrans) ? A->size2 : A->size1; + const size_t MB = (TransB == CblasNoTrans) ? B->size1 : B->size2; + const size_t NB = (TransB == CblasNoTrans) ? B->size2 : B->size1; + + if (M == MA && N == NB && NA == MB) /* [MxN] = [MAxNA][MBxNB] */ + { + cblas_sgemm (CblasRowMajor, TransA, TransB, INT (M), INT (N), INT (NA), + alpha, A->data, INT (A->tda), B->data, INT (B->tda), beta, + C->data, INT (C->tda)); + return GSL_SUCCESS; + } + else + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } +} + + +int +gsl_blas_dgemm (CBLAS_TRANSPOSE_t TransA, CBLAS_TRANSPOSE_t TransB, + double alpha, const gsl_matrix * A, const gsl_matrix * B, + double beta, gsl_matrix * C) +{ + const size_t M = C->size1; + const size_t N = C->size2; + const size_t MA = (TransA == CblasNoTrans) ? A->size1 : A->size2; + const size_t NA = (TransA == CblasNoTrans) ? A->size2 : A->size1; + const size_t MB = (TransB == CblasNoTrans) ? B->size1 : B->size2; + const size_t NB = (TransB == CblasNoTrans) ? B->size2 : B->size1; + + if (M == MA && N == NB && NA == MB) /* [MxN] = [MAxNA][MBxNB] */ + { + cblas_dgemm (CblasRowMajor, TransA, TransB, INT (M), INT (N), INT (NA), + alpha, A->data, INT (A->tda), B->data, INT (B->tda), beta, + C->data, INT (C->tda)); + return GSL_SUCCESS; + } + else + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } +} + + +int +gsl_blas_cgemm (CBLAS_TRANSPOSE_t TransA, CBLAS_TRANSPOSE_t TransB, + const gsl_complex_float alpha, + const gsl_matrix_complex_float * A, + const gsl_matrix_complex_float * B, + const gsl_complex_float beta, gsl_matrix_complex_float * C) +{ + const size_t M = C->size1; + const size_t N = C->size2; + const size_t MA = (TransA == CblasNoTrans) ? A->size1 : A->size2; + const size_t NA = (TransA == CblasNoTrans) ? A->size2 : A->size1; + const size_t MB = (TransB == CblasNoTrans) ? B->size1 : B->size2; + const size_t NB = (TransB == CblasNoTrans) ? B->size2 : B->size1; + + if (M == MA && N == NB && NA == MB) /* [MxN] = [MAxNA][MBxNB] */ + { + cblas_cgemm (CblasRowMajor, TransA, TransB, INT (M), INT (N), INT (NA), + GSL_COMPLEX_P (&alpha), A->data, INT (A->tda), B->data, + INT (B->tda), GSL_COMPLEX_P (&beta), C->data, + INT (C->tda)); + return GSL_SUCCESS; + } + else + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } +} + + +int +gsl_blas_zgemm (CBLAS_TRANSPOSE_t TransA, CBLAS_TRANSPOSE_t TransB, + const gsl_complex alpha, const gsl_matrix_complex * A, + const gsl_matrix_complex * B, const gsl_complex beta, + gsl_matrix_complex * C) +{ + const size_t M = C->size1; + const size_t N = C->size2; + const size_t MA = (TransA == CblasNoTrans) ? A->size1 : A->size2; + const size_t NA = (TransA == CblasNoTrans) ? A->size2 : A->size1; + const size_t MB = (TransB == CblasNoTrans) ? B->size1 : B->size2; + const size_t NB = (TransB == CblasNoTrans) ? B->size2 : B->size1; + + if (M == MA && N == NB && NA == MB) /* [MxN] = [MAxNA][MBxNB] */ + { + cblas_zgemm (CblasRowMajor, TransA, TransB, INT (M), INT (N), INT (NA), + GSL_COMPLEX_P (&alpha), A->data, INT (A->tda), B->data, + INT (B->tda), GSL_COMPLEX_P (&beta), C->data, + INT (C->tda)); + return GSL_SUCCESS; + } + else + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } +} + + +/* SYMM */ + +int +gsl_blas_ssymm (CBLAS_SIDE_t Side, CBLAS_UPLO_t Uplo, float alpha, + const gsl_matrix_float * A, const gsl_matrix_float * B, + float beta, gsl_matrix_float * C) +{ + const size_t M = C->size1; + const size_t N = C->size2; + const size_t MA = A->size1; + const size_t NA = A->size2; + const size_t MB = B->size1; + const size_t NB = B->size2; + + if (MA != NA) + { + GSL_ERROR ("matrix A must be square", GSL_ENOTSQR); + } + + if ((Side == CblasLeft && (M == MA && N == NB && NA == MB)) + || (Side == CblasRight && (M == MB && N == NA && NB == MA))) + { + cblas_ssymm (CblasRowMajor, Side, Uplo, INT (M), INT (N), alpha, + A->data, INT (A->tda), B->data, INT (B->tda), beta, + C->data, INT (C->tda)); + return GSL_SUCCESS; + } + else + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } + +} + + +int +gsl_blas_dsymm (CBLAS_SIDE_t Side, CBLAS_UPLO_t Uplo, double alpha, + const gsl_matrix * A, const gsl_matrix * B, double beta, + gsl_matrix * C) +{ + const size_t M = C->size1; + const size_t N = C->size2; + const size_t MA = A->size1; + const size_t NA = A->size2; + const size_t MB = B->size1; + const size_t NB = B->size2; + + if (MA != NA) + { + GSL_ERROR ("matrix A must be square", GSL_ENOTSQR); + } + + if ((Side == CblasLeft && (M == MA && N == NB && NA == MB)) + || (Side == CblasRight && (M == MB && N == NA && NB == MA))) + { + cblas_dsymm (CblasRowMajor, Side, Uplo, INT (M), INT (N), alpha, + A->data, INT (A->tda), B->data, INT (B->tda), beta, + C->data, INT (C->tda)); + return GSL_SUCCESS; + } + else + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } +} + + +int +gsl_blas_csymm (CBLAS_SIDE_t Side, CBLAS_UPLO_t Uplo, + const gsl_complex_float alpha, + const gsl_matrix_complex_float * A, + const gsl_matrix_complex_float * B, + const gsl_complex_float beta, gsl_matrix_complex_float * C) +{ + const size_t M = C->size1; + const size_t N = C->size2; + const size_t MA = A->size1; + const size_t NA = A->size2; + const size_t MB = B->size1; + const size_t NB = B->size2; + + if (MA != NA) + { + GSL_ERROR ("matrix A must be square", GSL_ENOTSQR); + } + + if ((Side == CblasLeft && (M == MA && N == NB && NA == MB)) + || (Side == CblasRight && (M == MB && N == NA && NB == MA))) + { + cblas_csymm (CblasRowMajor, Side, Uplo, INT (M), INT (N), + GSL_COMPLEX_P (&alpha), A->data, INT (A->tda), B->data, + INT (B->tda), GSL_COMPLEX_P (&beta), C->data, + INT (C->tda)); + return GSL_SUCCESS; + } + else + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } +} + +int +gsl_blas_zsymm (CBLAS_SIDE_t Side, CBLAS_UPLO_t Uplo, + const gsl_complex alpha, const gsl_matrix_complex * A, + const gsl_matrix_complex * B, const gsl_complex beta, + gsl_matrix_complex * C) +{ + const size_t M = C->size1; + const size_t N = C->size2; + const size_t MA = A->size1; + const size_t NA = A->size2; + const size_t MB = B->size1; + const size_t NB = B->size2; + + if (MA != NA) + { + GSL_ERROR ("matrix A must be square", GSL_ENOTSQR); + } + + if ((Side == CblasLeft && (M == MA && N == NB && NA == MB)) + || (Side == CblasRight && (M == MB && N == NA && NB == MA))) + { + cblas_zsymm (CblasRowMajor, Side, Uplo, INT (M), INT (N), + GSL_COMPLEX_P (&alpha), A->data, INT (A->tda), B->data, + INT (B->tda), GSL_COMPLEX_P (&beta), C->data, + INT (C->tda)); + return GSL_SUCCESS; + } + else + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } +} + + +/* HEMM */ + +int +gsl_blas_chemm (CBLAS_SIDE_t Side, CBLAS_UPLO_t Uplo, + const gsl_complex_float alpha, + const gsl_matrix_complex_float * A, + const gsl_matrix_complex_float * B, + const gsl_complex_float beta, gsl_matrix_complex_float * C) +{ + const size_t M = C->size1; + const size_t N = C->size2; + const size_t MA = A->size1; + const size_t NA = A->size2; + const size_t MB = B->size1; + const size_t NB = B->size2; + + if (MA != NA) + { + GSL_ERROR ("matrix A must be square", GSL_ENOTSQR); + } + + if ((Side == CblasLeft && (M == MA && N == NB && NA == MB)) + || (Side == CblasRight && (M == MB && N == NA && NB == MA))) + { + cblas_chemm (CblasRowMajor, Side, Uplo, INT (M), INT (N), + GSL_COMPLEX_P (&alpha), A->data, INT (A->tda), B->data, + INT (B->tda), GSL_COMPLEX_P (&beta), C->data, + INT (C->tda)); + return GSL_SUCCESS; + } + else + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } + +} + + +int +gsl_blas_zhemm (CBLAS_SIDE_t Side, CBLAS_UPLO_t Uplo, + const gsl_complex alpha, const gsl_matrix_complex * A, + const gsl_matrix_complex * B, const gsl_complex beta, + gsl_matrix_complex * C) +{ + const size_t M = C->size1; + const size_t N = C->size2; + const size_t MA = A->size1; + const size_t NA = A->size2; + const size_t MB = B->size1; + const size_t NB = B->size2; + + if (MA != NA) + { + GSL_ERROR ("matrix A must be square", GSL_ENOTSQR); + } + + if ((Side == CblasLeft && (M == MA && N == NB && NA == MB)) + || (Side == CblasRight && (M == MB && N == NA && NB == MA))) + { + cblas_zhemm (CblasRowMajor, Side, Uplo, INT (M), INT (N), + GSL_COMPLEX_P (&alpha), A->data, INT (A->tda), B->data, + INT (B->tda), GSL_COMPLEX_P (&beta), C->data, + INT (C->tda)); + return GSL_SUCCESS; + } + else + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } +} + +/* SYRK */ + +int +gsl_blas_ssyrk (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t Trans, float alpha, + const gsl_matrix_float * A, float beta, gsl_matrix_float * C) +{ + const size_t M = C->size1; + const size_t N = C->size2; + const size_t J = (Trans == CblasNoTrans) ? A->size1 : A->size2; + const size_t K = (Trans == CblasNoTrans) ? A->size2 : A->size1; + + if (M != N) + { + GSL_ERROR ("matrix C must be square", GSL_ENOTSQR); + } + else if (N != J) + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } + + cblas_ssyrk (CblasRowMajor, Uplo, Trans, INT (N), INT (K), alpha, A->data, + INT (A->tda), beta, C->data, INT (C->tda)); + return GSL_SUCCESS; +} + + +int +gsl_blas_dsyrk (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t Trans, double alpha, + const gsl_matrix * A, double beta, gsl_matrix * C) +{ + const size_t M = C->size1; + const size_t N = C->size2; + const size_t J = (Trans == CblasNoTrans) ? A->size1 : A->size2; + const size_t K = (Trans == CblasNoTrans) ? A->size2 : A->size1; + + if (M != N) + { + GSL_ERROR ("matrix C must be square", GSL_ENOTSQR); + } + else if (N != J) + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } + + cblas_dsyrk (CblasRowMajor, Uplo, Trans, INT (N), INT (K), alpha, A->data, + INT (A->tda), beta, C->data, INT (C->tda)); + return GSL_SUCCESS; + +} + + +int +gsl_blas_csyrk (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t Trans, + const gsl_complex_float alpha, + const gsl_matrix_complex_float * A, + const gsl_complex_float beta, gsl_matrix_complex_float * C) +{ + const size_t M = C->size1; + const size_t N = C->size2; + const size_t J = (Trans == CblasNoTrans) ? A->size1 : A->size2; + const size_t K = (Trans == CblasNoTrans) ? A->size2 : A->size1; + + if (M != N) + { + GSL_ERROR ("matrix C must be square", GSL_ENOTSQR); + } + else if (N != J) + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } + + cblas_csyrk (CblasRowMajor, Uplo, Trans, INT (N), INT (K), + GSL_COMPLEX_P (&alpha), A->data, INT (A->tda), + GSL_COMPLEX_P (&beta), C->data, INT (C->tda)); + return GSL_SUCCESS; +} + + +int +gsl_blas_zsyrk (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t Trans, + const gsl_complex alpha, const gsl_matrix_complex * A, + const gsl_complex beta, gsl_matrix_complex * C) +{ + const size_t M = C->size1; + const size_t N = C->size2; + const size_t J = (Trans == CblasNoTrans) ? A->size1 : A->size2; + const size_t K = (Trans == CblasNoTrans) ? A->size2 : A->size1; + + if (M != N) + { + GSL_ERROR ("matrix C must be square", GSL_ENOTSQR); + } + else if (N != J) + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } + + cblas_zsyrk (CblasRowMajor, Uplo, Trans, INT (N), INT (K), + GSL_COMPLEX_P (&alpha), A->data, INT (A->tda), + GSL_COMPLEX_P (&beta), C->data, INT (C->tda)); + return GSL_SUCCESS; +} + +/* HERK */ + +int +gsl_blas_cherk (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t Trans, float alpha, + const gsl_matrix_complex_float * A, float beta, + gsl_matrix_complex_float * C) +{ + const size_t M = C->size1; + const size_t N = C->size2; + const size_t J = (Trans == CblasNoTrans) ? A->size1 : A->size2; + const size_t K = (Trans == CblasNoTrans) ? A->size2 : A->size1; + + if (M != N) + { + GSL_ERROR ("matrix C must be square", GSL_ENOTSQR); + } + else if (N != J) + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } + + cblas_cherk (CblasRowMajor, Uplo, Trans, INT (N), INT (K), alpha, A->data, + INT (A->tda), beta, C->data, INT (C->tda)); + return GSL_SUCCESS; +} + + +int +gsl_blas_zherk (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t Trans, double alpha, + const gsl_matrix_complex * A, double beta, + gsl_matrix_complex * C) +{ + const size_t M = C->size1; + const size_t N = C->size2; + const size_t J = (Trans == CblasNoTrans) ? A->size1 : A->size2; + const size_t K = (Trans == CblasNoTrans) ? A->size2 : A->size1; + + if (M != N) + { + GSL_ERROR ("matrix C must be square", GSL_ENOTSQR); + } + else if (N != J) + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } + + cblas_zherk (CblasRowMajor, Uplo, Trans, INT (N), INT (K), alpha, A->data, + INT (A->tda), beta, C->data, INT (C->tda)); + return GSL_SUCCESS; +} + +/* SYR2K */ + +int +gsl_blas_ssyr2k (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t Trans, float alpha, + const gsl_matrix_float * A, const gsl_matrix_float * B, + float beta, gsl_matrix_float * C) +{ + const size_t M = C->size1; + const size_t N = C->size2; + const size_t MA = (Trans == CblasNoTrans) ? A->size1 : A->size2; + const size_t NA = (Trans == CblasNoTrans) ? A->size2 : A->size1; + const size_t MB = (Trans == CblasNoTrans) ? B->size1 : B->size2; + const size_t NB = (Trans == CblasNoTrans) ? B->size2 : B->size1; + + if (M != N) + { + GSL_ERROR ("matrix C must be square", GSL_ENOTSQR); + } + else if (N != MA || N != MB || NA != NB) + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } + + cblas_ssyr2k (CblasRowMajor, Uplo, Trans, INT (N), INT (NA), alpha, A->data, + INT (A->tda), B->data, INT (B->tda), beta, C->data, + INT (C->tda)); + return GSL_SUCCESS; +} + + +int +gsl_blas_dsyr2k (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t Trans, double alpha, + const gsl_matrix * A, const gsl_matrix * B, double beta, + gsl_matrix * C) +{ + const size_t M = C->size1; + const size_t N = C->size2; + const size_t MA = (Trans == CblasNoTrans) ? A->size1 : A->size2; + const size_t NA = (Trans == CblasNoTrans) ? A->size2 : A->size1; + const size_t MB = (Trans == CblasNoTrans) ? B->size1 : B->size2; + const size_t NB = (Trans == CblasNoTrans) ? B->size2 : B->size1; + + if (M != N) + { + GSL_ERROR ("matrix C must be square", GSL_ENOTSQR); + } + else if (N != MA || N != MB || NA != NB) + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } + + cblas_dsyr2k (CblasRowMajor, Uplo, Trans, INT (N), INT (NA), alpha, A->data, + INT (A->tda), B->data, INT (B->tda), beta, C->data, + INT (C->tda)); + return GSL_SUCCESS; +} + + +int +gsl_blas_csyr2k (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t Trans, + const gsl_complex_float alpha, + const gsl_matrix_complex_float * A, + const gsl_matrix_complex_float * B, + const gsl_complex_float beta, gsl_matrix_complex_float * C) +{ + const size_t M = C->size1; + const size_t N = C->size2; + const size_t MA = (Trans == CblasNoTrans) ? A->size1 : A->size2; + const size_t NA = (Trans == CblasNoTrans) ? A->size2 : A->size1; + const size_t MB = (Trans == CblasNoTrans) ? B->size1 : B->size2; + const size_t NB = (Trans == CblasNoTrans) ? B->size2 : B->size1; + + if (M != N) + { + GSL_ERROR ("matrix C must be square", GSL_ENOTSQR); + } + else if (N != MA || N != MB || NA != NB) + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } + + cblas_csyr2k (CblasRowMajor, Uplo, Trans, INT (N), INT (NA), + GSL_COMPLEX_P (&alpha), A->data, INT (A->tda), B->data, + INT (B->tda), GSL_COMPLEX_P (&beta), C->data, INT (C->tda)); + return GSL_SUCCESS; +} + + + +int +gsl_blas_zsyr2k (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t Trans, + const gsl_complex alpha, const gsl_matrix_complex * A, + const gsl_matrix_complex * B, const gsl_complex beta, + gsl_matrix_complex * C) +{ + const size_t M = C->size1; + const size_t N = C->size2; + const size_t MA = (Trans == CblasNoTrans) ? A->size1 : A->size2; + const size_t NA = (Trans == CblasNoTrans) ? A->size2 : A->size1; + const size_t MB = (Trans == CblasNoTrans) ? B->size1 : B->size2; + const size_t NB = (Trans == CblasNoTrans) ? B->size2 : B->size1; + + if (M != N) + { + GSL_ERROR ("matrix C must be square", GSL_ENOTSQR); + } + else if (N != MA || N != MB || NA != NB) + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } + + cblas_zsyr2k (CblasRowMajor, Uplo, Trans, INT (N), INT (NA), + GSL_COMPLEX_P (&alpha), A->data, INT (A->tda), B->data, + INT (B->tda), GSL_COMPLEX_P (&beta), C->data, INT (C->tda)); + return GSL_SUCCESS; +} + +/* HER2K */ + +int +gsl_blas_cher2k (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t Trans, + const gsl_complex_float alpha, + const gsl_matrix_complex_float * A, + const gsl_matrix_complex_float * B, float beta, + gsl_matrix_complex_float * C) +{ + const size_t M = C->size1; + const size_t N = C->size2; + const size_t MA = (Trans == CblasNoTrans) ? A->size1 : A->size2; + const size_t NA = (Trans == CblasNoTrans) ? A->size2 : A->size1; + const size_t MB = (Trans == CblasNoTrans) ? B->size1 : B->size2; + const size_t NB = (Trans == CblasNoTrans) ? B->size2 : B->size1; + + if (M != N) + { + GSL_ERROR ("matrix C must be square", GSL_ENOTSQR); + } + else if (N != MA || N != MB || NA != NB) + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } + + cblas_cher2k (CblasRowMajor, Uplo, Trans, INT (N), INT (NA), + GSL_COMPLEX_P (&alpha), A->data, INT (A->tda), B->data, + INT (B->tda), beta, C->data, INT (C->tda)); + return GSL_SUCCESS; + +} + + +int +gsl_blas_zher2k (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t Trans, + const gsl_complex alpha, const gsl_matrix_complex * A, + const gsl_matrix_complex * B, double beta, + gsl_matrix_complex * C) +{ + const size_t M = C->size1; + const size_t N = C->size2; + const size_t MA = (Trans == CblasNoTrans) ? A->size1 : A->size2; + const size_t NA = (Trans == CblasNoTrans) ? A->size2 : A->size1; + const size_t MB = (Trans == CblasNoTrans) ? B->size1 : B->size2; + const size_t NB = (Trans == CblasNoTrans) ? B->size2 : B->size1; + + if (M != N) + { + GSL_ERROR ("matrix C must be square", GSL_ENOTSQR); + } + else if (N != MA || N != MB || NA != NB) + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } + + cblas_zher2k (CblasRowMajor, Uplo, Trans, INT (N), INT (NA), + GSL_COMPLEX_P (&alpha), A->data, INT (A->tda), B->data, + INT (B->tda), beta, C->data, INT (C->tda)); + return GSL_SUCCESS; + +} + +/* TRMM */ + +int +gsl_blas_strmm (CBLAS_SIDE_t Side, CBLAS_UPLO_t Uplo, + CBLAS_TRANSPOSE_t TransA, CBLAS_DIAG_t Diag, float alpha, + const gsl_matrix_float * A, gsl_matrix_float * B) +{ + const size_t M = B->size1; + const size_t N = B->size2; + const size_t MA = A->size1; + const size_t NA = A->size2; + + if (MA != NA) + { + GSL_ERROR ("matrix A must be square", GSL_ENOTSQR); + } + + if ((Side == CblasLeft && M == MA) || (Side == CblasRight && N == MA)) + { + cblas_strmm (CblasRowMajor, Side, Uplo, TransA, Diag, INT (M), INT (N), + alpha, A->data, INT (A->tda), B->data, INT (B->tda)); + return GSL_SUCCESS; + } + else + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } +} + + +int +gsl_blas_dtrmm (CBLAS_SIDE_t Side, CBLAS_UPLO_t Uplo, + CBLAS_TRANSPOSE_t TransA, CBLAS_DIAG_t Diag, double alpha, + const gsl_matrix * A, gsl_matrix * B) +{ + const size_t M = B->size1; + const size_t N = B->size2; + const size_t MA = A->size1; + const size_t NA = A->size2; + + if (MA != NA) + { + GSL_ERROR ("matrix A must be square", GSL_ENOTSQR); + } + + if ((Side == CblasLeft && M == MA) || (Side == CblasRight && N == MA)) + { + cblas_dtrmm (CblasRowMajor, Side, Uplo, TransA, Diag, INT (M), INT (N), + alpha, A->data, INT (A->tda), B->data, INT (B->tda)); + return GSL_SUCCESS; + } + else + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } +} + + +int +gsl_blas_ctrmm (CBLAS_SIDE_t Side, CBLAS_UPLO_t Uplo, + CBLAS_TRANSPOSE_t TransA, CBLAS_DIAG_t Diag, + const gsl_complex_float alpha, + const gsl_matrix_complex_float * A, + gsl_matrix_complex_float * B) +{ + const size_t M = B->size1; + const size_t N = B->size2; + const size_t MA = A->size1; + const size_t NA = A->size2; + + if (MA != NA) + { + GSL_ERROR ("matrix A must be square", GSL_ENOTSQR); + } + + if ((Side == CblasLeft && M == MA) || (Side == CblasRight && N == MA)) + { + cblas_ctrmm (CblasRowMajor, Side, Uplo, TransA, Diag, INT (M), INT (N), + GSL_COMPLEX_P (&alpha), A->data, INT (A->tda), B->data, + INT (B->tda)); + return GSL_SUCCESS; + } + else + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } +} + + +int +gsl_blas_ztrmm (CBLAS_SIDE_t Side, CBLAS_UPLO_t Uplo, + CBLAS_TRANSPOSE_t TransA, CBLAS_DIAG_t Diag, + const gsl_complex alpha, const gsl_matrix_complex * A, + gsl_matrix_complex * B) +{ + const size_t M = B->size1; + const size_t N = B->size2; + const size_t MA = A->size1; + const size_t NA = A->size2; + + if (MA != NA) + { + GSL_ERROR ("matrix A must be square", GSL_ENOTSQR); + } + + if ((Side == CblasLeft && M == MA) || (Side == CblasRight && N == MA)) + { + cblas_ztrmm (CblasRowMajor, Side, Uplo, TransA, Diag, INT (M), INT (N), + GSL_COMPLEX_P (&alpha), A->data, INT (A->tda), B->data, + INT (B->tda)); + return GSL_SUCCESS; + } + else + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } +} + + +/* TRSM */ + +int +gsl_blas_strsm (CBLAS_SIDE_t Side, CBLAS_UPLO_t Uplo, + CBLAS_TRANSPOSE_t TransA, CBLAS_DIAG_t Diag, float alpha, + const gsl_matrix_float * A, gsl_matrix_float * B) +{ + const size_t M = B->size1; + const size_t N = B->size2; + const size_t MA = A->size1; + const size_t NA = A->size2; + + if (MA != NA) + { + GSL_ERROR ("matrix A must be square", GSL_ENOTSQR); + } + + if ((Side == CblasLeft && M == MA) || (Side == CblasRight && N == MA)) + { + cblas_strsm (CblasRowMajor, Side, Uplo, TransA, Diag, INT (M), INT (N), + alpha, A->data, INT (A->tda), B->data, INT (B->tda)); + return GSL_SUCCESS; + } + else + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } +} + + +int +gsl_blas_dtrsm (CBLAS_SIDE_t Side, CBLAS_UPLO_t Uplo, + CBLAS_TRANSPOSE_t TransA, CBLAS_DIAG_t Diag, double alpha, + const gsl_matrix * A, gsl_matrix * B) +{ + const size_t M = B->size1; + const size_t N = B->size2; + const size_t MA = A->size1; + const size_t NA = A->size2; + + if (MA != NA) + { + GSL_ERROR ("matrix A must be square", GSL_ENOTSQR); + } + + if ((Side == CblasLeft && M == MA) || (Side == CblasRight && N == MA)) + { + cblas_dtrsm (CblasRowMajor, Side, Uplo, TransA, Diag, INT (M), INT (N), + alpha, A->data, INT (A->tda), B->data, INT (B->tda)); + return GSL_SUCCESS; + } + else + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } +} + + +int +gsl_blas_ctrsm (CBLAS_SIDE_t Side, CBLAS_UPLO_t Uplo, + CBLAS_TRANSPOSE_t TransA, CBLAS_DIAG_t Diag, + const gsl_complex_float alpha, + const gsl_matrix_complex_float * A, + gsl_matrix_complex_float * B) +{ + const size_t M = B->size1; + const size_t N = B->size2; + const size_t MA = A->size1; + const size_t NA = A->size2; + + if (MA != NA) + { + GSL_ERROR ("matrix A must be square", GSL_ENOTSQR); + } + + if ((Side == CblasLeft && M == MA) || (Side == CblasRight && N == MA)) + { + cblas_ctrsm (CblasRowMajor, Side, Uplo, TransA, Diag, INT (M), INT (N), + GSL_COMPLEX_P (&alpha), A->data, INT (A->tda), B->data, + INT (B->tda)); + return GSL_SUCCESS; + } + else + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } +} + + +int +gsl_blas_ztrsm (CBLAS_SIDE_t Side, CBLAS_UPLO_t Uplo, + CBLAS_TRANSPOSE_t TransA, CBLAS_DIAG_t Diag, + const gsl_complex alpha, const gsl_matrix_complex * A, + gsl_matrix_complex * B) +{ + const size_t M = B->size1; + const size_t N = B->size2; + const size_t MA = A->size1; + const size_t NA = A->size2; + + if (MA != NA) + { + GSL_ERROR ("matrix A must be square", GSL_ENOTSQR); + } + + if ((Side == CblasLeft && M == MA) || (Side == CblasRight && N == MA)) + { + cblas_ztrsm (CblasRowMajor, Side, Uplo, TransA, Diag, INT (M), INT (N), + GSL_COMPLEX_P (&alpha), A->data, INT (A->tda), B->data, + INT (B->tda)); + return GSL_SUCCESS; + } + else + { + GSL_ERROR ("invalid length", GSL_EBADLEN); + } +} diff --git a/gsl-1.9/blas/gsl_blas.h b/gsl-1.9/blas/gsl_blas.h new file mode 100644 index 0000000..3323f66 --- /dev/null +++ b/gsl-1.9/blas/gsl_blas.h @@ -0,0 +1,602 @@ +/* blas/gsl_blas.h + * + * Copyright (C) 1996, 1997, 1998, 1999, 2000 Gerard Jungman + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or (at + * your option) any later version. + * + * This program is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. + */ + +/* + * Author: G. Jungman + */ +#ifndef __GSL_BLAS_H__ +#define __GSL_BLAS_H__ + +#include <gsl/gsl_vector.h> +#include <gsl/gsl_matrix.h> + +#include <gsl/gsl_blas_types.h> + + +#undef __BEGIN_DECLS +#undef __END_DECLS +#ifdef __cplusplus +# define __BEGIN_DECLS extern "C" { +# define __END_DECLS } +#else +# define __BEGIN_DECLS /* empty */ +# define __END_DECLS /* empty */ +#endif + +__BEGIN_DECLS + + +/* ======================================================================== + * Level 1 + * ======================================================================== + */ + +int gsl_blas_sdsdot (float alpha, + const gsl_vector_float * X, + const gsl_vector_float * Y, + float * result + ); + +int gsl_blas_dsdot (const gsl_vector_float * X, + const gsl_vector_float * Y, + double * result + ); + +int gsl_blas_sdot (const gsl_vector_float * X, + const gsl_vector_float * Y, + float * result + ); + +int gsl_blas_ddot (const gsl_vector * X, + const gsl_vector * Y, + double * result + ); + + +int gsl_blas_cdotu (const gsl_vector_complex_float * X, + const gsl_vector_complex_float * Y, + gsl_complex_float * dotu); + +int gsl_blas_cdotc (const gsl_vector_complex_float * X, + const gsl_vector_complex_float * Y, + gsl_complex_float * dotc); + +int gsl_blas_zdotu (const gsl_vector_complex * X, + const gsl_vector_complex * Y, + gsl_complex * dotu); + +int gsl_blas_zdotc (const gsl_vector_complex * X, + const gsl_vector_complex * Y, + gsl_complex * dotc); + + +float gsl_blas_snrm2 (const gsl_vector_float * X); +float gsl_blas_sasum (const gsl_vector_float * X); +double gsl_blas_dnrm2 (const gsl_vector * X); +double gsl_blas_dasum (const gsl_vector * X); +float gsl_blas_scnrm2 (const gsl_vector_complex_float * X); +float gsl_blas_scasum (const gsl_vector_complex_float * X); +double gsl_blas_dznrm2 (const gsl_vector_complex * X); +double gsl_blas_dzasum (const gsl_vector_complex * X); + + +CBLAS_INDEX_t gsl_blas_isamax (const gsl_vector_float * X); +CBLAS_INDEX_t gsl_blas_idamax (const gsl_vector * X); +CBLAS_INDEX_t gsl_blas_icamax (const gsl_vector_complex_float * X); +CBLAS_INDEX_t gsl_blas_izamax (const gsl_vector_complex * X); + + +int gsl_blas_sswap (gsl_vector_float * X, + gsl_vector_float * Y); + +int gsl_blas_scopy (const gsl_vector_float * X, + gsl_vector_float * Y); + +int gsl_blas_saxpy (float alpha, + const gsl_vector_float * X, + gsl_vector_float * Y); + +int gsl_blas_dswap (gsl_vector * X, + gsl_vector * Y); + +int gsl_blas_dcopy (const gsl_vector * X, + gsl_vector * Y); + +int gsl_blas_daxpy (double alpha, + const gsl_vector * X, + gsl_vector * Y); + +int gsl_blas_cswap (gsl_vector_complex_float * X, + gsl_vector_complex_float * Y); + +int gsl_blas_ccopy (const gsl_vector_complex_float * X, + gsl_vector_complex_float * Y); + +int gsl_blas_caxpy (const gsl_complex_float alpha, + const gsl_vector_complex_float * X, + gsl_vector_complex_float * Y); + +int gsl_blas_zswap (gsl_vector_complex * X, + gsl_vector_complex * Y); + +int gsl_blas_zcopy (const gsl_vector_complex * X, + gsl_vector_complex * Y); + +int gsl_blas_zaxpy (const gsl_complex alpha, + const gsl_vector_complex * X, + gsl_vector_complex * Y); + + +int gsl_blas_srotg (float a[], float b[], float c[], float s[]); + +int gsl_blas_srotmg (float d1[], float d2[], float b1[], float b2, float P[]); + +int gsl_blas_srot (gsl_vector_float * X, + gsl_vector_float * Y, + float c, float s); + +int gsl_blas_srotm (gsl_vector_float * X, + gsl_vector_float * Y, + const float P[]); + +int gsl_blas_drotg (double a[], double b[], double c[], double s[]); + +int gsl_blas_drotmg (double d1[], double d2[], double b1[], + double b2, double P[]); + +int gsl_blas_drot (gsl_vector * X, + gsl_vector * Y, + const double c, const double s); + +int gsl_blas_drotm (gsl_vector * X, + gsl_vector * Y, + const double P[]); + + +void gsl_blas_sscal (float alpha, gsl_vector_float * X); +void gsl_blas_dscal (double alpha, gsl_vector * X); +void gsl_blas_cscal (const gsl_complex_float alpha, gsl_vector_complex_float * X); +void gsl_blas_zscal (const gsl_complex alpha, gsl_vector_complex * X); +void gsl_blas_csscal (float alpha, gsl_vector_complex_float * X); +void gsl_blas_zdscal (double alpha, gsl_vector_complex * X); + + +/* =========================================================================== + * Level 2 + * =========================================================================== + */ + +/* + * Routines with standard 4 prefixes (S, D, C, Z) + */ +int gsl_blas_sgemv (CBLAS_TRANSPOSE_t TransA, + float alpha, + const gsl_matrix_float * A, + const gsl_vector_float * X, + float beta, + gsl_vector_float * Y); + +int gsl_blas_strmv (CBLAS_UPLO_t Uplo, + CBLAS_TRANSPOSE_t TransA, CBLAS_DIAG_t Diag, + const gsl_matrix_float * A, + gsl_vector_float * X); + +int gsl_blas_strsv (CBLAS_UPLO_t Uplo, + CBLAS_TRANSPOSE_t TransA, CBLAS_DIAG_t Diag, + const gsl_matrix_float * A, + gsl_vector_float * X); + +int gsl_blas_dgemv (CBLAS_TRANSPOSE_t TransA, + double alpha, + const gsl_matrix * A, + const gsl_vector * X, + double beta, + gsl_vector * Y); + +int gsl_blas_dtrmv (CBLAS_UPLO_t Uplo, + CBLAS_TRANSPOSE_t TransA, CBLAS_DIAG_t Diag, + const gsl_matrix * A, + gsl_vector * X); + +int gsl_blas_dtrsv (CBLAS_UPLO_t Uplo, + CBLAS_TRANSPOSE_t TransA, CBLAS_DIAG_t Diag, + const gsl_matrix * A, + gsl_vector * X); + +int gsl_blas_cgemv (CBLAS_TRANSPOSE_t TransA, + const gsl_complex_float alpha, + const gsl_matrix_complex_float * A, + const gsl_vector_complex_float * X, + const gsl_complex_float beta, + gsl_vector_complex_float * Y); + +int gsl_blas_ctrmv (CBLAS_UPLO_t Uplo, + CBLAS_TRANSPOSE_t TransA, CBLAS_DIAG_t Diag, + const gsl_matrix_complex_float * A, + gsl_vector_complex_float * X); + +int gsl_blas_ctrsv (CBLAS_UPLO_t Uplo, + CBLAS_TRANSPOSE_t TransA, CBLAS_DIAG_t Diag, + const gsl_matrix_complex_float * A, + gsl_vector_complex_float * X); + +int gsl_blas_zgemv (CBLAS_TRANSPOSE_t TransA, + const gsl_complex alpha, + const gsl_matrix_complex * A, + const gsl_vector_complex * X, + const gsl_complex beta, + gsl_vector_complex * Y); + +int gsl_blas_ztrmv (CBLAS_UPLO_t Uplo, + CBLAS_TRANSPOSE_t TransA, CBLAS_DIAG_t Diag, + const gsl_matrix_complex * A, + gsl_vector_complex * X); + +int gsl_blas_ztrsv (CBLAS_UPLO_t Uplo, + CBLAS_TRANSPOSE_t TransA, CBLAS_DIAG_t Diag, + const gsl_matrix_complex * A, + gsl_vector_complex *X); + +/* + * Routines with S and D prefixes only + */ +int gsl_blas_ssymv (CBLAS_UPLO_t Uplo, + float alpha, + const gsl_matrix_float * A, + const gsl_vector_float * X, + float beta, + gsl_vector_float * Y); + +int gsl_blas_sger (float alpha, + const gsl_vector_float * X, + const gsl_vector_float * Y, + gsl_matrix_float * A); + +int gsl_blas_ssyr (CBLAS_UPLO_t Uplo, + float alpha, + const gsl_vector_float * X, + gsl_matrix_float * A); + +int gsl_blas_ssyr2 (CBLAS_UPLO_t Uplo, + float alpha, + const gsl_vector_float * X, + const gsl_vector_float * Y, + gsl_matrix_float * A); + +int gsl_blas_dsymv (CBLAS_UPLO_t Uplo, + double alpha, + const gsl_matrix * A, + const gsl_vector * X, + double beta, + gsl_vector * Y); +int gsl_blas_dger (double alpha, + const gsl_vector * X, + const gsl_vector * Y, + gsl_matrix * A); + +int gsl_blas_dsyr (CBLAS_UPLO_t Uplo, + double alpha, + const gsl_vector * X, + gsl_matrix * A); + +int gsl_blas_dsyr2 (CBLAS_UPLO_t Uplo, + double alpha, + const gsl_vector * X, + const gsl_vector * Y, + gsl_matrix * A); + +/* + * Routines with C and Z prefixes only + */ + +int gsl_blas_chemv (CBLAS_UPLO_t Uplo, + const gsl_complex_float alpha, + const gsl_matrix_complex_float * A, + const gsl_vector_complex_float * X, + const gsl_complex_float beta, + gsl_vector_complex_float * Y); + +int gsl_blas_cgeru (const gsl_complex_float alpha, + const gsl_vector_complex_float * X, + const gsl_vector_complex_float * Y, + gsl_matrix_complex_float * A); + +int gsl_blas_cgerc (const gsl_complex_float alpha, + const gsl_vector_complex_float * X, + const gsl_vector_complex_float * Y, + gsl_matrix_complex_float * A); + +int gsl_blas_cher (CBLAS_UPLO_t Uplo, + float alpha, + const gsl_vector_complex_float * X, + gsl_matrix_complex_float * A); + +int gsl_blas_cher2 (CBLAS_UPLO_t Uplo, + const gsl_complex_float alpha, + const gsl_vector_complex_float * X, + const gsl_vector_complex_float * Y, + gsl_matrix_complex_float * A); + +int gsl_blas_zhemv (CBLAS_UPLO_t Uplo, + const gsl_complex alpha, + const gsl_matrix_complex * A, + const gsl_vector_complex * X, + const gsl_complex beta, + gsl_vector_complex * Y); + +int gsl_blas_zgeru (const gsl_complex alpha, + const gsl_vector_complex * X, + const gsl_vector_complex * Y, + gsl_matrix_complex * A); + +int gsl_blas_zgerc (const gsl_complex alpha, + const gsl_vector_complex * X, + const gsl_vector_complex * Y, + gsl_matrix_complex * A); + +int gsl_blas_zher (CBLAS_UPLO_t Uplo, + double alpha, + const gsl_vector_complex * X, + gsl_matrix_complex * A); + +int gsl_blas_zher2 (CBLAS_UPLO_t Uplo, + const gsl_complex alpha, + const gsl_vector_complex * X, + const gsl_vector_complex * Y, + gsl_matrix_complex * A); + +/* + * =========================================================================== + * Prototypes for level 3 BLAS + * =========================================================================== + */ + +/* + * Routines with standard 4 prefixes (S, D, C, Z) + */ +int gsl_blas_sgemm (CBLAS_TRANSPOSE_t TransA, + CBLAS_TRANSPOSE_t TransB, + float alpha, + const gsl_matrix_float * A, + const gsl_matrix_float * B, + float beta, + gsl_matrix_float * C); + +int gsl_blas_ssymm (CBLAS_SIDE_t Side, CBLAS_UPLO_t Uplo, + float alpha, + const gsl_matrix_float * A, + const gsl_matrix_float * B, + float beta, + gsl_matrix_float * C); + +int gsl_blas_ssyrk (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t Trans, + float alpha, + const gsl_matrix_float * A, + float beta, + gsl_matrix_float * C); + +int gsl_blas_ssyr2k (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t Trans, + float alpha, + const gsl_matrix_float * A, + const gsl_matrix_float * B, + float beta, + gsl_matrix_float * C); + +int gsl_blas_strmm (CBLAS_SIDE_t Side, + CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t TransA, + CBLAS_DIAG_t Diag, + float alpha, + const gsl_matrix_float * A, + gsl_matrix_float * B); + +int gsl_blas_strsm (CBLAS_SIDE_t Side, + CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t TransA, + CBLAS_DIAG_t Diag, + float alpha, + const gsl_matrix_float * A, + gsl_matrix_float * B); + +int gsl_blas_dgemm (CBLAS_TRANSPOSE_t TransA, + CBLAS_TRANSPOSE_t TransB, + double alpha, + const gsl_matrix * A, + const gsl_matrix * B, + double beta, + gsl_matrix * C); + +int gsl_blas_dsymm (CBLAS_SIDE_t Side, + CBLAS_UPLO_t Uplo, + double alpha, + const gsl_matrix * A, + const gsl_matrix * B, + double beta, + gsl_matrix * C); + +int gsl_blas_dsyrk (CBLAS_UPLO_t Uplo, + CBLAS_TRANSPOSE_t Trans, + double alpha, + const gsl_matrix * A, + double beta, + gsl_matrix * C); + +int gsl_blas_dsyr2k (CBLAS_UPLO_t Uplo, + CBLAS_TRANSPOSE_t Trans, + double alpha, + const gsl_matrix * A, + const gsl_matrix * B, + double beta, + gsl_matrix * C); + +int gsl_blas_dtrmm (CBLAS_SIDE_t Side, + CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t TransA, + CBLAS_DIAG_t Diag, + double alpha, + const gsl_matrix * A, + gsl_matrix * B); + +int gsl_blas_dtrsm (CBLAS_SIDE_t Side, + CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t TransA, + CBLAS_DIAG_t Diag, + double alpha, + const gsl_matrix * A, + gsl_matrix * B); + +int gsl_blas_cgemm (CBLAS_TRANSPOSE_t TransA, + CBLAS_TRANSPOSE_t TransB, + const gsl_complex_float alpha, + const gsl_matrix_complex_float * A, + const gsl_matrix_complex_float * B, + const gsl_complex_float beta, + gsl_matrix_complex_float * C); + +int gsl_blas_csymm (CBLAS_SIDE_t Side, + CBLAS_UPLO_t Uplo, + const gsl_complex_float alpha, + const gsl_matrix_complex_float * A, + const gsl_matrix_complex_float * B, + const gsl_complex_float beta, + gsl_matrix_complex_float * C); + +int gsl_blas_csyrk (CBLAS_UPLO_t Uplo, + CBLAS_TRANSPOSE_t Trans, + const gsl_complex_float alpha, + const gsl_matrix_complex_float * A, + const gsl_complex_float beta, + gsl_matrix_complex_float * C); + +int gsl_blas_csyr2k (CBLAS_UPLO_t Uplo, + CBLAS_TRANSPOSE_t Trans, + const gsl_complex_float alpha, + const gsl_matrix_complex_float * A, + const gsl_matrix_complex_float * B, + const gsl_complex_float beta, + gsl_matrix_complex_float * C); + +int gsl_blas_ctrmm (CBLAS_SIDE_t Side, + CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t TransA, + CBLAS_DIAG_t Diag, + const gsl_complex_float alpha, + const gsl_matrix_complex_float * A, + gsl_matrix_complex_float * B); + +int gsl_blas_ctrsm (CBLAS_SIDE_t Side, + CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t TransA, + CBLAS_DIAG_t Diag, + const gsl_complex_float alpha, + const gsl_matrix_complex_float * A, + gsl_matrix_complex_float * B); + +int gsl_blas_zgemm (CBLAS_TRANSPOSE_t TransA, + CBLAS_TRANSPOSE_t TransB, + const gsl_complex alpha, + const gsl_matrix_complex * A, + const gsl_matrix_complex * B, + const gsl_complex beta, + gsl_matrix_complex * C); + +int gsl_blas_zsymm (CBLAS_SIDE_t Side, + CBLAS_UPLO_t Uplo, + const gsl_complex alpha, + const gsl_matrix_complex * A, + const gsl_matrix_complex * B, + const gsl_complex beta, + gsl_matrix_complex * C); + +int gsl_blas_zsyrk (CBLAS_UPLO_t Uplo, + CBLAS_TRANSPOSE_t Trans, + const gsl_complex alpha, + const gsl_matrix_complex * A, + const gsl_complex beta, + gsl_matrix_complex * C); + +int gsl_blas_zsyr2k (CBLAS_UPLO_t Uplo, + CBLAS_TRANSPOSE_t Trans, + const gsl_complex alpha, + const gsl_matrix_complex * A, + const gsl_matrix_complex * B, + const gsl_complex beta, + gsl_matrix_complex *C); + +int gsl_blas_ztrmm (CBLAS_SIDE_t Side, + CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t TransA, + CBLAS_DIAG_t Diag, + const gsl_complex alpha, + const gsl_matrix_complex * A, + gsl_matrix_complex * B); + +int gsl_blas_ztrsm (CBLAS_SIDE_t Side, + CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t TransA, + CBLAS_DIAG_t Diag, + const gsl_complex alpha, + const gsl_matrix_complex * A, + gsl_matrix_complex * B); + +/* + * Routines with prefixes C and Z only + */ +int gsl_blas_chemm (CBLAS_SIDE_t Side, + CBLAS_UPLO_t Uplo, + const gsl_complex_float alpha, + const gsl_matrix_complex_float * A, + const gsl_matrix_complex_float * B, + const gsl_complex_float beta, + gsl_matrix_complex_float * C); + +int gsl_blas_cherk (CBLAS_UPLO_t Uplo, + CBLAS_TRANSPOSE_t Trans, + float alpha, + const gsl_matrix_complex_float * A, + float beta, + gsl_matrix_complex_float * C); + +int gsl_blas_cher2k (CBLAS_UPLO_t Uplo, + CBLAS_TRANSPOSE_t Trans, + const gsl_complex_float alpha, + const gsl_matrix_complex_float * A, + const gsl_matrix_complex_float * B, + float beta, + gsl_matrix_complex_float * C); + +int gsl_blas_zhemm (CBLAS_SIDE_t Side, + CBLAS_UPLO_t Uplo, + const gsl_complex alpha, + const gsl_matrix_complex * A, + const gsl_matrix_complex * B, + const gsl_complex beta, + gsl_matrix_complex * C); + +int gsl_blas_zherk (CBLAS_UPLO_t Uplo, + CBLAS_TRANSPOSE_t Trans, + double alpha, + const gsl_matrix_complex * A, + double beta, + gsl_matrix_complex * C); + +int gsl_blas_zher2k (CBLAS_UPLO_t Uplo, + CBLAS_TRANSPOSE_t Trans, + const gsl_complex alpha, + const gsl_matrix_complex * A, + const gsl_matrix_complex * B, + double beta, + gsl_matrix_complex * C); + + +__END_DECLS + +#endif /* __GSL_BLAS_H__ */ diff --git a/gsl-1.9/blas/gsl_blas_types.h b/gsl-1.9/blas/gsl_blas_types.h new file mode 100644 index 0000000..ff9dfa3 --- /dev/null +++ b/gsl-1.9/blas/gsl_blas_types.h @@ -0,0 +1,54 @@ +/* blas/gsl_blas_types.h + * + * Copyright (C) 1996, 1997, 1998, 1999, 2000 Gerard Jungman + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or (at + * your option) any later version. + * + * This program is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. + */ + +/* + * Author: G. Jungman + */ +/* Based on draft BLAST C interface specification [Jul 7 1998] + */ +#ifndef __GSL_BLAS_TYPES_H__ +#define __GSL_BLAS_TYPES_H__ + +#include <gsl/gsl_cblas.h> + +#undef __BEGIN_DECLS +#undef __END_DECLS +#ifdef __cplusplus +# define __BEGIN_DECLS extern "C" { +# define __END_DECLS } +#else +# define __BEGIN_DECLS /* empty */ +# define __END_DECLS /* empty */ +#endif + +__BEGIN_DECLS + +typedef CBLAS_INDEX CBLAS_INDEX_t; +typedef enum CBLAS_ORDER CBLAS_ORDER_t; +typedef enum CBLAS_TRANSPOSE CBLAS_TRANSPOSE_t; +typedef enum CBLAS_UPLO CBLAS_UPLO_t; +typedef enum CBLAS_DIAG CBLAS_DIAG_t; +typedef enum CBLAS_SIDE CBLAS_SIDE_t; + +/* typedef gsl_complex COMPLEX; */ + +__END_DECLS + + +#endif /* __GSL_BLAS_TYPES_H__ */ |