eigs function added (See SEP #82) 44/7544/18
Adeline CARNIS [Thu, 14 Jun 2012 10:14:17 +0000 (12:14 +0200)]
test_run("arnoldi","eigs")

Change-Id: I9f0e4c0fcc74a54ff5abf46232d36202a09225cc

28 files changed:
SEP/SEP_082_eigs.odt [new file with mode: 0644]
scilab/CHANGES_5.4.X
scilab/modules/arnoldi/Makefile.am
scilab/modules/arnoldi/Makefile.in
scilab/modules/arnoldi/arnoldi.vcxproj
scilab/modules/arnoldi/arnoldi.vcxproj.filters
scilab/modules/arnoldi/core_Import.def
scilab/modules/arnoldi/etc/arnoldi.start
scilab/modules/arnoldi/help/en_US/eigs.xml [new file with mode: 0644]
scilab/modules/arnoldi/includes/eigs.h [new file with mode: 0644]
scilab/modules/arnoldi/includes/eigs_dependencies.h [new file with mode: 0644]
scilab/modules/arnoldi/includes/gw_arnoldi.h
scilab/modules/arnoldi/macros/buildmacros.sce
scilab/modules/arnoldi/macros/eigs.sci [new file with mode: 0644]
scilab/modules/arnoldi/sci_gateway/arnoldi_gateway.xml
scilab/modules/arnoldi/sci_gateway/c/gw_arnoldi.c
scilab/modules/arnoldi/sci_gateway/c/sci_dnaupd.c
scilab/modules/arnoldi/sci_gateway/c/sci_dneupd.c
scilab/modules/arnoldi/sci_gateway/c/sci_dsaupd.c
scilab/modules/arnoldi/sci_gateway/c/sci_dseupd.c
scilab/modules/arnoldi/sci_gateway/c/sci_eigs.c [new file with mode: 0644]
scilab/modules/arnoldi/sci_gateway/c/sci_znaupd.c
scilab/modules/arnoldi/sci_gateway/c/sci_zneupd.c
scilab/modules/arnoldi/src/c/DllmainArnoldi.c
scilab/modules/arnoldi/src/c/eigs.c [new file with mode: 0644]
scilab/modules/arnoldi/src/c/eigs_dependencies.c [new file with mode: 0644]
scilab/modules/arnoldi/tests/unit_tests/eigs.dia.ref [new file with mode: 0644]
scilab/modules/arnoldi/tests/unit_tests/eigs.tst [new file with mode: 0644]

diff --git a/SEP/SEP_082_eigs.odt b/SEP/SEP_082_eigs.odt
new file mode 100644 (file)
index 0000000..0438741
Binary files /dev/null and b/SEP/SEP_082_eigs.odt differ
index 7bef219..f1056d9 100644 (file)
@@ -53,6 +53,13 @@ Obsolete Functions
 * uipopup function is now obsolete. Please use 'uicontextmenu' instead.
 
 
+Arnoldi Package
+====================
+
+* New function:
+  - eigs function added (See SEP #82)
+
+
 Unitary tests
 =============
 
index 173311e..6d88d52 100644 (file)
@@ -1,33 +1,41 @@
 # Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
 # Copyright (C) 2006 - INRIA - Sylvestre LEDRU
+# Copyright (C) 2012 - Scilab Enterprises- Cedric Delamarre
 #
 # This file is distributed under the same license as the Scilab package.
 
-
-GATEWAY_C_SOURCES = sci_gateway/c/sci_zneupd \
-sci_gateway/c/sci_dseupd.c \
-sci_gateway/c/sci_zneupd.c \
-sci_gateway/c/gw_arnoldi.c \
-sci_gateway/c/sci_dnaupd.c \
-sci_gateway/c/sci_dneupd.c \
-sci_gateway/c/sci_dsaupd.c \
-sci_gateway/c/sci_znaupd.c
-
-libsciarnoldi_la_CPPFLAGS=     -I$(top_srcdir)/libs/MALLOC/includes/ \
-                               -I$(srcdir)/includes/ \
-                               -I$(top_srcdir)/modules/api_scilab/includes/ \
-                               -I$(top_srcdir)/modules/localization/includes/ \
-                               -I$(top_srcdir)/modules/output_stream/includes/ \
-                               $(AM_CPPFLAGS)
+ARNOLDI_C_SOURCES = \
+    src/c/eigs.c \
+    src/c/eigs_dependencies.c
+
+GATEWAY_C_SOURCES = \
+    sci_gateway/c/sci_zneupd \
+    sci_gateway/c/sci_dseupd.c \
+    sci_gateway/c/sci_zneupd.c \
+    sci_gateway/c/gw_arnoldi.c \
+    sci_gateway/c/sci_dnaupd.c \
+    sci_gateway/c/sci_dneupd.c \
+    sci_gateway/c/sci_dsaupd.c \
+    sci_gateway/c/sci_znaupd.c \
+    sci_gateway/c/sci_eigs.c
+
+libsciarnoldi_la_CPPFLAGS = \
+    -I$(top_srcdir)/libs/MALLOC/includes/ \
+    -I$(srcdir)/includes/ \
+    -I$(top_srcdir)/modules/api_scilab/includes/ \
+    -I$(top_srcdir)/modules/localization/includes/ \
+    -I$(top_srcdir)/modules/output_stream/includes/ \
+    -I$(top_srcdir)/modules/core/includes/ \
+    $(AM_CPPFLAGS)
 
 pkglib_LTLIBRARIES = libsciarnoldi.la
 
 libsciarnoldi_la_LDFLAGS = $(LAPACK_LIBS) $(ARPACK_LIBS) $(AM_LDFLAGS)
 
-libsciarnoldi_la_SOURCES = $(GATEWAY_C_SOURCES)
+libsciarnoldi_la_SOURCES = $(ARNOLDI_C_SOURCES) $(GATEWAY_C_SOURCES)
 
 # For the code check (splint)
-CHECK_SRC= $(GATEWAY_C_SOURCES)
+CHECK_SRC= $(ARNOLDI_C_SOURCES) $(GATEWAY_C_SOURCES)
 INCLUDE_FLAGS = $(libsciarnoldi_la_CPPFLAGS)
 
 #### Target ######
@@ -36,7 +44,7 @@ modulename=arnoldi
 
 #### arnoldi : Conf files ####
 libsciarnoldi_la_rootdir = $(mydatadir)
-libsciarnoldi_la_root_DATA =  license.txt 
+libsciarnoldi_la_root_DATA =  license.txt
 
 
 #### arnoldi : init scripts ####
index 239ca18..3dd7189 100644 (file)
@@ -17,6 +17,7 @@
 
 # Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
 # Copyright (C) 2006 - INRIA - Sylvestre LEDRU
+# Copyright (C) 2012 - Scilab Enterprises- Cedric Delamarre
 #
 # This file is distributed under the same license as the Scilab package.
 
@@ -116,11 +117,14 @@ am__installdirs = "$(DESTDIR)$(pkglibdir)" \
        "$(DESTDIR)$(libsciarnoldi_la_sci_gatewaydir)"
 LTLIBRARIES = $(pkglib_LTLIBRARIES)
 libsciarnoldi_la_LIBADD =
-am__objects_1 = libsciarnoldi_la-sci_dseupd.lo \
+am__objects_1 = libsciarnoldi_la-eigs.lo \
+       libsciarnoldi_la-eigs_dependencies.lo
+am__objects_2 = libsciarnoldi_la-sci_dseupd.lo \
        libsciarnoldi_la-sci_zneupd.lo libsciarnoldi_la-gw_arnoldi.lo \
        libsciarnoldi_la-sci_dnaupd.lo libsciarnoldi_la-sci_dneupd.lo \
-       libsciarnoldi_la-sci_dsaupd.lo libsciarnoldi_la-sci_znaupd.lo
-am_libsciarnoldi_la_OBJECTS = $(am__objects_1)
+       libsciarnoldi_la-sci_dsaupd.lo libsciarnoldi_la-sci_znaupd.lo \
+       libsciarnoldi_la-sci_eigs.lo
+am_libsciarnoldi_la_OBJECTS = $(am__objects_1) $(am__objects_2)
 libsciarnoldi_la_OBJECTS = $(am_libsciarnoldi_la_OBJECTS)
 libsciarnoldi_la_LINK = $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) \
        $(LIBTOOLFLAGS) --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) \
@@ -398,28 +402,36 @@ target_alias = @target_alias@
 top_build_prefix = @top_build_prefix@
 top_builddir = @top_builddir@
 top_srcdir = @top_srcdir@
-GATEWAY_C_SOURCES = sci_gateway/c/sci_zneupd \
-sci_gateway/c/sci_dseupd.c \
-sci_gateway/c/sci_zneupd.c \
-sci_gateway/c/gw_arnoldi.c \
-sci_gateway/c/sci_dnaupd.c \
-sci_gateway/c/sci_dneupd.c \
-sci_gateway/c/sci_dsaupd.c \
-sci_gateway/c/sci_znaupd.c
-
-libsciarnoldi_la_CPPFLAGS = -I$(top_srcdir)/libs/MALLOC/includes/ \
-                               -I$(srcdir)/includes/ \
-                               -I$(top_srcdir)/modules/api_scilab/includes/ \
-                               -I$(top_srcdir)/modules/localization/includes/ \
-                               -I$(top_srcdir)/modules/output_stream/includes/ \
-                               $(AM_CPPFLAGS)
+ARNOLDI_C_SOURCES = \
+    src/c/eigs.c \
+    src/c/eigs_dependencies.c
+
+GATEWAY_C_SOURCES = \
+    sci_gateway/c/sci_zneupd \
+    sci_gateway/c/sci_dseupd.c \
+    sci_gateway/c/sci_zneupd.c \
+    sci_gateway/c/gw_arnoldi.c \
+    sci_gateway/c/sci_dnaupd.c \
+    sci_gateway/c/sci_dneupd.c \
+    sci_gateway/c/sci_dsaupd.c \
+    sci_gateway/c/sci_znaupd.c \
+    sci_gateway/c/sci_eigs.c
+
+libsciarnoldi_la_CPPFLAGS = \
+    -I$(top_srcdir)/libs/MALLOC/includes/ \
+    -I$(srcdir)/includes/ \
+    -I$(top_srcdir)/modules/api_scilab/includes/ \
+    -I$(top_srcdir)/modules/localization/includes/ \
+    -I$(top_srcdir)/modules/output_stream/includes/ \
+    -I$(top_srcdir)/modules/core/includes/ \
+    $(AM_CPPFLAGS)
 
 pkglib_LTLIBRARIES = libsciarnoldi.la
 libsciarnoldi_la_LDFLAGS = $(LAPACK_LIBS) $(ARPACK_LIBS) $(AM_LDFLAGS)
-libsciarnoldi_la_SOURCES = $(GATEWAY_C_SOURCES)
+libsciarnoldi_la_SOURCES = $(ARNOLDI_C_SOURCES) $(GATEWAY_C_SOURCES)
 
 # For the code check (splint)
-CHECK_SRC = $(GATEWAY_C_SOURCES)
+CHECK_SRC = $(ARNOLDI_C_SOURCES) $(GATEWAY_C_SOURCES)
 INCLUDE_FLAGS = $(libsciarnoldi_la_CPPFLAGS)
 
 #### Target ######
@@ -427,7 +439,7 @@ modulename = arnoldi
 
 #### arnoldi : Conf files ####
 libsciarnoldi_la_rootdir = $(mydatadir)
-libsciarnoldi_la_root_DATA = license.txt 
+libsciarnoldi_la_root_DATA = license.txt
 
 #### arnoldi : init scripts ####
 libsciarnoldi_la_etcdir = $(mydatadir)/etc
@@ -584,11 +596,14 @@ mostlyclean-compile:
 distclean-compile:
        -rm -f *.tab.c
 
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libsciarnoldi_la-eigs.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libsciarnoldi_la-eigs_dependencies.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libsciarnoldi_la-gw_arnoldi.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libsciarnoldi_la-sci_dnaupd.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libsciarnoldi_la-sci_dneupd.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libsciarnoldi_la-sci_dsaupd.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libsciarnoldi_la-sci_dseupd.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libsciarnoldi_la-sci_eigs.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libsciarnoldi_la-sci_znaupd.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libsciarnoldi_la-sci_zneupd.Plo@am__quote@
 
@@ -613,6 +628,20 @@ distclean-compile:
 @AMDEP_TRUE@@am__fastdepCC_FALSE@      DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
 @am__fastdepCC_FALSE@  $(LTCOMPILE) -c -o $@ $<
 
+libsciarnoldi_la-eigs.lo: src/c/eigs.c
+@am__fastdepCC_TRUE@   $(LIBTOOL)  --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libsciarnoldi_la_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT libsciarnoldi_la-eigs.lo -MD -MP -MF $(DEPDIR)/libsciarnoldi_la-eigs.Tpo -c -o libsciarnoldi_la-eigs.lo `test -f 'src/c/eigs.c' || echo '$(srcdir)/'`src/c/eigs.c
+@am__fastdepCC_TRUE@   $(am__mv) $(DEPDIR)/libsciarnoldi_la-eigs.Tpo $(DEPDIR)/libsciarnoldi_la-eigs.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      source='src/c/eigs.c' object='libsciarnoldi_la-eigs.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@  $(LIBTOOL)  --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libsciarnoldi_la_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o libsciarnoldi_la-eigs.lo `test -f 'src/c/eigs.c' || echo '$(srcdir)/'`src/c/eigs.c
+
+libsciarnoldi_la-eigs_dependencies.lo: src/c/eigs_dependencies.c
+@am__fastdepCC_TRUE@   $(LIBTOOL)  --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libsciarnoldi_la_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT libsciarnoldi_la-eigs_dependencies.lo -MD -MP -MF $(DEPDIR)/libsciarnoldi_la-eigs_dependencies.Tpo -c -o libsciarnoldi_la-eigs_dependencies.lo `test -f 'src/c/eigs_dependencies.c' || echo '$(srcdir)/'`src/c/eigs_dependencies.c
+@am__fastdepCC_TRUE@   $(am__mv) $(DEPDIR)/libsciarnoldi_la-eigs_dependencies.Tpo $(DEPDIR)/libsciarnoldi_la-eigs_dependencies.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      source='src/c/eigs_dependencies.c' object='libsciarnoldi_la-eigs_dependencies.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@  $(LIBTOOL)  --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libsciarnoldi_la_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o libsciarnoldi_la-eigs_dependencies.lo `test -f 'src/c/eigs_dependencies.c' || echo '$(srcdir)/'`src/c/eigs_dependencies.c
+
 libsciarnoldi_la-sci_dseupd.lo: sci_gateway/c/sci_dseupd.c
 @am__fastdepCC_TRUE@   $(LIBTOOL)  --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libsciarnoldi_la_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT libsciarnoldi_la-sci_dseupd.lo -MD -MP -MF $(DEPDIR)/libsciarnoldi_la-sci_dseupd.Tpo -c -o libsciarnoldi_la-sci_dseupd.lo `test -f 'sci_gateway/c/sci_dseupd.c' || echo '$(srcdir)/'`sci_gateway/c/sci_dseupd.c
 @am__fastdepCC_TRUE@   $(am__mv) $(DEPDIR)/libsciarnoldi_la-sci_dseupd.Tpo $(DEPDIR)/libsciarnoldi_la-sci_dseupd.Plo
@@ -662,6 +691,13 @@ libsciarnoldi_la-sci_znaupd.lo: sci_gateway/c/sci_znaupd.c
 @AMDEP_TRUE@@am__fastdepCC_FALSE@      DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
 @am__fastdepCC_FALSE@  $(LIBTOOL)  --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libsciarnoldi_la_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o libsciarnoldi_la-sci_znaupd.lo `test -f 'sci_gateway/c/sci_znaupd.c' || echo '$(srcdir)/'`sci_gateway/c/sci_znaupd.c
 
+libsciarnoldi_la-sci_eigs.lo: sci_gateway/c/sci_eigs.c
+@am__fastdepCC_TRUE@   $(LIBTOOL)  --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libsciarnoldi_la_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT libsciarnoldi_la-sci_eigs.lo -MD -MP -MF $(DEPDIR)/libsciarnoldi_la-sci_eigs.Tpo -c -o libsciarnoldi_la-sci_eigs.lo `test -f 'sci_gateway/c/sci_eigs.c' || echo '$(srcdir)/'`sci_gateway/c/sci_eigs.c
+@am__fastdepCC_TRUE@   $(am__mv) $(DEPDIR)/libsciarnoldi_la-sci_eigs.Tpo $(DEPDIR)/libsciarnoldi_la-sci_eigs.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      source='sci_gateway/c/sci_eigs.c' object='libsciarnoldi_la-sci_eigs.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@  $(LIBTOOL)  --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libsciarnoldi_la_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o libsciarnoldi_la-sci_eigs.lo `test -f 'sci_gateway/c/sci_eigs.c' || echo '$(srcdir)/'`sci_gateway/c/sci_eigs.c
+
 mostlyclean-libtool:
        -rm -f *.lo
 
index 6169bf4..37c107f 100644 (file)
     </Link>
   </ItemDefinitionGroup>
   <ItemGroup>
+    <ClCompile Include="sci_gateway\c\sci_eigs.c" />
     <ClCompile Include="src\c\DllmainArnoldi.c" />
     <ClCompile Include="sci_gateway\c\gw_arnoldi.c" />
     <ClCompile Include="sci_gateway\c\sci_dnaupd.c" />
     <ClCompile Include="sci_gateway\c\sci_dseupd.c" />
     <ClCompile Include="sci_gateway\c\sci_znaupd.c" />
     <ClCompile Include="sci_gateway\c\sci_zneupd.c" />
+    <ClCompile Include="src\c\eigs.c" />
+    <ClCompile Include="src\c\eigs_dependencies.c" />
   </ItemGroup>
   <ItemGroup>
     <ClInclude Include="includes\dynlib_arnoldi.h" />
+    <ClInclude Include="includes\eigs.h" />
+    <ClInclude Include="includes\eigs_dependencies.h" />
     <ClInclude Include="includes\gw_arnoldi.h" />
   </ItemGroup>
   <ItemGroup>
index 6aec840..4af16d7 100644 (file)
     <ClCompile Include="sci_gateway\c\sci_zneupd.c">
       <Filter>Source Files</Filter>
     </ClCompile>
+    <ClCompile Include="src\c\eigs.c">
+      <Filter>Source Files</Filter>
+    </ClCompile>
+    <ClCompile Include="src\c\eigs_dependencies.c">
+      <Filter>Source Files</Filter>
+    </ClCompile>
+    <ClCompile Include="sci_gateway\c\sci_eigs.c">
+      <Filter>Source Files</Filter>
+    </ClCompile>
   </ItemGroup>
   <ItemGroup>
     <ClInclude Include="includes\dynlib_arnoldi.h">
     <ClInclude Include="includes\gw_arnoldi.h">
       <Filter>Header Files</Filter>
     </ClInclude>
+    <ClInclude Include="includes\eigs.h">
+      <Filter>Header Files</Filter>
+    </ClInclude>
+    <ClInclude Include="includes\eigs_dependencies.h">
+      <Filter>Header Files</Filter>
+    </ClInclude>
   </ItemGroup>
   <ItemGroup>
     <ResourceCompile Include="src\c\arnoldi.rc">
index f5cd1cf..d0156e7 100644 (file)
@@ -7,3 +7,6 @@
 // are also available at
 // http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
 
+//Load  functions libraries
+// =============================================================================
+load('SCI/modules/arnoldi/macros/lib');
\ No newline at end of file
diff --git a/scilab/modules/arnoldi/help/en_US/eigs.xml b/scilab/modules/arnoldi/help/en_US/eigs.xml
new file mode 100644 (file)
index 0000000..6093b52
--- /dev/null
@@ -0,0 +1,506 @@
+<?xml version="1.0" encoding="utf-8"?>
+<!--
+ * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
+ * Copyright (C) 2012 - Scilab Enterprises - Adeline CARNIS
+ * 
+ * This file must be used under the terms of the CeCILL.
+ * This source file is licensed as described in the file COPYING, which
+ * you should have received as part of this distribution.  The terms
+ * are also available at    
+ * http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
+ *
+ -->
+<refentry xmlns="http://docbook.org/ns/docbook" xmlns:xlink="http://www.w3.org/1999/xlink" xmlns:svg="http://www.w3.org/2000/svg" xmlns:ns5="http://www.w3.org/1999/xhtml" xmlns:mml="http://www.w3.org/1998/Math/MathML" xmlns:db="http://docbook.org/ns/docbook" version="5.0-subset Scilab" xml:id="eigs" xml:lang="en">
+  <refnamediv>
+    <refname>eigs</refname>
+    <refpurpose>calculates eigenvalues and eigenvectors of matrices</refpurpose>
+  </refnamediv>
+  <refsynopsisdiv>
+    <title>Calling Sequence</title>
+    <synopsis>
+      d = eigs(A [,B [,k [,sigma [,opts]]]])
+      [d, v] = eigs(A [,B [,k [,sigma [,opts]]]])
+
+      d = eigs(Af, n [,B [,k [,sigma [,opts]]]])
+      [d, v] = eigs(Af, n [,B [,k [,sigma [,opts]]]])
+    </synopsis>
+  </refsynopsisdiv>
+  <refsection>
+    <title>Arguments</title>
+    <variablelist>
+      <varlistentry>
+        <term>A </term>
+        <listitem>
+          <para>a full or sparse, real or complex, symmetric or non-symmetric square matrix</para>
+        </listitem>
+      </varlistentry>
+      <varlistentry>
+        <term>Af </term>
+        <listitem>
+          <para>a function</para>
+        </listitem>
+      </varlistentry>
+      <varlistentry>
+        <term>n </term>
+        <listitem>
+          <para>
+            a scalar, defined only if <literal>A</literal> is a function
+          </para>
+        </listitem>
+      </varlistentry>
+      <varlistentry>
+        <term>B</term>
+        <listitem>
+          <para>
+            a sparse, real or complex, square matrix with same dimensions as
+            <literal> A</literal>
+          </para>
+        </listitem>
+      </varlistentry>
+      <varlistentry>
+        <term>k</term>
+        <listitem>
+          <para>a integer, number of eigenvalues to be computed</para>
+        </listitem>
+      </varlistentry>
+      <varlistentry>
+        <term>sigma</term>
+        <listitem>
+          <para>a real scalar or a string of length 2</para>
+        </listitem>
+      </varlistentry>
+      <varlistentry>
+        <term>opts</term>
+        <listitem>
+          <para>a structure</para>
+        </listitem>
+      </varlistentry>
+      <varlistentry>
+        <term>d</term>
+        <listitem>
+          <para>a real or complex eigenvalues vector or diagonal matrix (eigenvalues along the diagonal)</para>
+        </listitem>
+      </varlistentry>
+      <varlistentry>
+        <term>v</term>
+        <listitem>
+          <para>
+            real or complex eigenvector matrix
+          </para>
+        </listitem>
+      </varlistentry>
+    </variablelist>
+  </refsection>
+  <refsection>
+    <title>Description</title>
+    <variablelist>
+      <varlistentry>
+        <term>d = eigs(A) or d = eigs(Af, n)</term>
+        <listitem>
+          <para>
+            solves the eigenvalue problem <literal>A * v = lambda * v</literal>. This calling returns a vector <literal>d</literal> containing the six largest magnitude eigenvalues.
+            <literal>A</literal> is either a square matrix, which can be symmetric or non-symmetric, real or complex, full or sparse.
+          </para>
+          <para>
+            <literal>A</literal> should be represented by a function <literal>Af</literal>. In this instance, a scalar <literal>n</literal> designating
+            the length of the vector argument, must be defined. It must have the following header :
+          </para>
+          <programlisting role="no-scilab-exec">
+            <![CDATA[ 
+function y = A ( x )
+ ]]>
+          </programlisting>
+          <para>
+            This function <literal>Af</literal> must return one of the four following expressions :
+            <itemizedlist>
+              <listitem>
+                <term>A * x</term>
+                <para> if sigma is not given or is a string other than 'SM'.</para>
+              </listitem>
+              <listitem>
+                <term>A \ x</term>
+                <para> if sigma is 0 or 'SM'.</para>
+              </listitem>
+              <listitem>
+                <term>(A - sigma * I) \ x</term>
+                <para>for the standart eigenvalue problem, where I is the identity matrix.</para>
+              </listitem>
+              <listitem>
+                <term>(A - sigma * B) \ x</term>
+                <para> for the generalized eigenvalue problem.</para>
+              </listitem>
+            </itemizedlist>
+          </para>
+        </listitem>
+      </varlistentry>
+      <varlistentry>
+        <term>[d, v] = eigs(A) or [d, v] = eigs(Af, n)</term>
+        <listitem>
+          <para>
+            returns a diagonal matrix <literal>d</literal> containing the six largest magnitude eigenvalues on the diagonal.
+            <literal>v</literal> is a n by six matrix whose columns are the six eigenvectors corresponding to the returned eigenvalues.
+          </para>
+        </listitem>
+      </varlistentry>
+      <varlistentry>
+        <term>d = eigs(A, B)</term>
+        <listitem>
+          <para>
+            solves the generalized eigenvalue problem <literal>A * v = lambda  * B * v </literal> with positive, definite matrix <literal>B</literal>.
+          </para>
+          <itemizedlist>
+            <listitem>
+              <para>
+                if <literal>B</literal> is not specified, <literal>B = []</literal> is used.
+              </para>
+            </listitem>
+            <listitem>
+              <para>
+                if <literal>B</literal> is specified, <literal>B</literal> must be the same size as A.
+              </para>
+            </listitem>
+          </itemizedlist>
+        </listitem>
+      </varlistentry>
+      <varlistentry>
+        <term>d = eigs(A, B, k)</term>
+        <listitem>
+          <para>
+            returns in vector <literal>d</literal> the <literal>k</literal> eigenvalues.
+            If <literal>k</literal> is not specified, <literal>k = min(n, 6)</literal>, where n is the row number of A.
+          </para>
+        </listitem>
+      </varlistentry>
+      <varlistentry>
+        <term>d = eigs(A, B, k, sigma)</term>
+        <listitem>
+          <para>
+            returns in vector <literal>d</literal> the <literal>k</literal> eigenvalues determined by <literal>sigma</literal>.
+            <literal>sigma</literal> can be either a real or complex including 0 scalar or string.
+            If sigma is a string of length 2, it takes one of the following values :
+          </para>
+          <itemizedlist>
+            <listitem>
+              <para>
+                <literal>'LM'</literal> compute the NEV largest in magnitude eigenvalues (by default).
+              </para>
+            </listitem>
+            <listitem>
+              <para>
+                <literal>'SM'</literal> compute the NEV smallest in magnitude eigenvalues (same as sigma = 0).
+              </para>
+            </listitem>
+            <listitem>
+              <para>
+                <literal>'LA'</literal> compute the NEV Largest Algebraic eigenvalues, only for real symmetric problems.
+              </para>
+            </listitem>
+            <listitem>
+              <para>
+                <literal>'SA'</literal> compute the NEV Smallest Algebraic eigenvalues, only for real symmetric problems.
+              </para>
+            </listitem>
+            <listitem>
+              <para>
+                <literal>'BE'</literal> compute NEV eigenvalues, half from each end of the spectrum, only for real symmetric problems.
+              </para>
+            </listitem>
+            <listitem>
+              <para>
+                <literal>'LR'</literal> compute the NEV eigenvalues of Largest Real part, only for real non-symmetric or complex problems.
+              </para>
+            </listitem>
+            <listitem>
+              <para>
+                <literal>'SR'</literal> compute the NEV eigenvalues of Smallest Real part, only for real non-symmetric or complex problems.
+              </para>
+            </listitem>
+            <listitem>
+              <para>
+                <literal>'LI'</literal> compute the NEV eigenvalues of Largest Imaginary part, only for real non-symmetric or complex problems.
+              </para>
+            </listitem>
+            <listitem>
+              <para>
+                <literal>'SI'</literal> compute the NEV eigenvalues of Smallest Imaginary part, only for real non-symmetric or complex problems.
+              </para>
+            </listitem>
+          </itemizedlist>
+        </listitem>
+      </varlistentry>
+      <varlistentry>
+        <term>d = eigs(A, B, k, sigma, opts)</term>
+        <listitem>
+          <para>
+            If the <literal> opts </literal> structure is specified, different options can be used to compute the <literal>k</literal> eigenvalues :
+          </para>
+          <itemizedlist>
+            <listitem>
+              <para>
+                <term>tol</term>
+                <para>
+                  required convergence tolerance. By default, <literal>tol = %eps</literal>.
+                </para>
+              </para>
+            </listitem>
+            <listitem>
+              <para>
+                <term>maxiter</term>
+                <para>
+                  maximum number of iterations. By default, <literal>maxiter = 300</literal>.
+                </para>
+              </para>
+            </listitem>
+            <listitem>
+              <para>
+                <term>ncv</term>
+                <para>
+                  number of Lanzcos basis vectors to use. The <literal>ncv</literal> value must be greater or equal than <literal>2 * k + 1 </literal> for real non-symmetric
+                  problems. For real symmetric or complex problems, <literal>ncv</literal> must be greater or equal <literal>2 * k </literal>.
+                </para>
+              </para>
+            </listitem>
+            <listitem>
+              <para>
+                <term>resid</term>
+                <para>
+                  starting vector whose contains the initial residual vector, possibly from a previous run. By default,
+                  <literal>resid</literal> is a random initial vector.
+                </para>
+              </para>
+            </listitem>
+            <listitem>
+              <para>
+                <term>cholB</term>
+                <para>
+                  if <literal>chol(B)</literal> is passed rather than <literal>B</literal>. By default, <literal>cholB</literal> is 0.
+                </para>
+              </para>
+            </listitem>
+            <listitem>
+              <para>
+                <term>isreal</term>
+                <para>
+                  if <literal>Af</literal> is given, <literal>isreal</literal> can be defined. By default, <literal>isreal</literal> is 1.
+                  This argument should not be indicated if <literal>A</literal> is a matrix.
+                </para>
+              </para>
+            </listitem>
+            <listitem>
+              <para>
+                <term>issym</term>
+                <para>
+                  if <literal>Af</literal> is given, <literal>issym</literal> can be defined. By default, <literal>isreal</literal> is 0.
+                  This argument should not be indicated if <literal>A</literal> is a matrix.
+                </para>
+              </para>
+            </listitem>
+          </itemizedlist>
+        </listitem>
+      </varlistentry>
+    </variablelist>
+  </refsection>
+  <refsection>
+    <title>References</title>
+    <para>
+      This function is based on the ARPACK package written by R. Lehoucq, K. Maschhoff, D. Sorensen, and C. Yang.
+    </para>
+    <itemizedlist>
+      <listitem>
+        <para>DSAUPD and DSEUPD routines for real symmetric problems,</para>
+      </listitem>
+      <listitem>
+        <para>DNAUPD and DNEUPD routines for real non-symmetric problems.</para>
+      </listitem>
+      <listitem>
+        <para>ZNAUPD and ZNEUPD routines for complex problems.</para>
+      </listitem>
+    </itemizedlist>
+  </refsection>
+  <refsection>
+    <title>Example for real symmetric problems</title>
+    <programlisting role="example">
+      <![CDATA[ 
+A            = diag(10*ones(10,1));
+A(1:$-1,2:$) = A(1:$-1,2:$) + diag(6*ones(9,1));
+A(2:$,1:$-1) = A(2:$,1:$-1) + diag(6*ones(9,1));
+
+B = eye(10,10);
+k = 8;
+sigma = 'SM';
+opts.cholB = 1;
+
+d = eigs(A)
+[d, v] = eigs(A)
+
+d = eigs(A, B, k, sigma)
+[d, v] = eigs(A, B, k, sigma)
+
+d = eigs(A, B, k, sigma, opts)
+[d, v] = eigs(A, B, k, sigma, opts)
+
+// With sparses
+AS = sparse(A);
+BS = sparse(B);
+
+d = eigs(AS)
+[d, v] = eigs(AS)
+
+d = eigs(AS, BS, k, sigma)
+[d, v] = eigs(AS, BS, k, sigma)
+
+d = eigs(AS, BS, k, sigma, opts)
+[d, v] = eigs(AS, BS, k, sigma, opts)
+
+// With function
+clear opts
+function y = fn(x)
+   y = A * x;
+endfunction
+
+opts.isreal = 1;
+opts.issym = 1;
+
+d = eigs(fn, 10, [], k, 'LM', opts)
+
+function y = fn(x)
+   y = A \ x;
+endfunction
+
+d = eigs(fn, 10, [], k, 'SM', opts)
+
+function y = fn(x)
+   y = (A - 4 * eye(10,10)) \ x;
+endfunction
+
+d = eigs(fn, 10, [], k, 4, opts)
+ ]]>
+    </programlisting>
+  </refsection>
+  <refsection>
+    <title>Example for real non-symmetric problems</title>
+    <programlisting role="example">
+      <![CDATA[ 
+    A            = diag(10*ones(10,1));
+    A(1:$-1,2:$) = A(1:$-1,2:$) + diag(6*ones(9,1));
+    A(2:$,1:$-1) = A(2:$,1:$-1) + diag(-6*ones(9,1));
+
+    B = eye(10,10);
+    k = 8;
+    sigma = 'SM';
+    opts.cholB = 1;
+    
+    d = eigs(A)
+[d, v] = eigs(A)
+    
+    d = eigs(A, B, k, sigma)
+    [d, v] = eigs(A, B, k, sigma) 
+
+    d = eigs(A, B, k, sigma, opts)
+    [d, v] = eigs(A, B, k, sigma, opts)
+
+// With sparses
+    AS = sparse(A);
+    BS = sparse(B);
+
+d = eigs(AS)
+[d, v] = eigs(AS)
+    d = eigs(AS, BS, k, sigma)
+    [d, v] = eigs(AS, BS, k, sigma)
+
+    d = eigs(AS, BS, k, sigma, opts)
+    [d, v] = eigs(AS, BS, k, sigma, opts)
+    
+    // With function
+clear opts
+function y = fn(x)
+   y = A * x;
+endfunction
+
+opts.isreal = 1;
+opts.issym = 0;
+
+d = eigs(fn, 10, [], k, 'LM', opts)
+
+function y = fn(x)
+   y = A \ x;
+endfunction
+
+d = eigs(fn, 10, [], k, 'SM', opts)
+
+function y = fn(x)
+   y = (A - 4 * eye(10,10)) \ x;
+endfunction
+
+d = eigs(fn, 10, [], k, 4, opts)
+    ]]>
+    </programlisting>
+  </refsection>
+  <refsection>
+    <title>Example for complex problems</title>
+    <programlisting role="example">
+      <![CDATA[ 
+    A            = diag(10*ones(10,1) + %i * ones(10,1));
+    A(1:$-1,2:$) = A(1:$-1,2:$) + diag(6*ones(9,1));
+    A(2:$,1:$-1) = A(2:$,1:$-1) + diag(-6*ones(9,1));
+
+    B = eye(10,10);
+    k = 8;
+    sigma = 'LM';
+    opts.cholB = 1;
+    
+    d = eigs(A)
+[d, v] = eigs(A)
+
+    d = eigs(A, B, k, sigma)
+    [d, v] = eigs(A, B, k, sigma)
+    d = eigs(A, B, k, sigma, opts)
+    [d, v] = eigs(A, B, k, sigma, opts)
+    
+    // With sparses
+    AS = sparse(A);
+    BS = sparse(B);
+    
+    d = eigs(AS)
+[d, v] = eigs(AS)
+
+    d = eigs(AS, BS, k, sigma)
+    [d, v] = eigs(AS, BS, k, sigma)
+
+    d = eigs(AS, BS, k, sigma, opts)
+    [d, v] = eigs(AS, BS, k, sigma, opts)
+    
+    // With function
+clear opts
+function y = fn(x)
+   y = A * x;
+endfunction
+
+opts.isreal = 0;
+opts.issym = 0;
+
+d = eigs(fn, 10, [], k, 'LM', opts)
+
+function y = fn(x)
+   y = A \ x;
+endfunction
+
+d = eigs(fn, 10, [], k, 'SM', opts)
+
+function y = fn(x)
+   y = (A - 4 * eye(10,10)) \ x;
+endfunction
+
+d = eigs(fn, 10, [], k, 4, opts)
+    ]]>
+    </programlisting>
+  </refsection>
+  <refsection role="see also">
+    <title>See Also</title>
+    <simplelist type="inline">
+      <member>
+        <link linkend="spec">spec</link>
+      </member>
+    </simplelist>
+  </refsection>
+</refentry>
diff --git a/scilab/modules/arnoldi/includes/eigs.h b/scilab/modules/arnoldi/includes/eigs.h
new file mode 100644 (file)
index 0000000..4bd7305
--- /dev/null
@@ -0,0 +1,21 @@
+/*
+ * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
+ * Copyright (C) 2011 - Scilab Enterprises - Adeline CARNIS
+ *
+ * This file must be used under the terms of the CeCILL.
+ * This source file is licensed as described in the file COPYING, which
+ * you should have received as part of this distribution.  The terms
+ * are also available at
+ * http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
+ *
+ */
+/*--------------------------------------------------------------------------*/
+#ifndef __EIGS_H__
+#define __EIGS_H__
+#include "doublecomplex.h"
+
+int eigs(double *, doublecomplex *, int, int, int, double*, doublecomplex*, int, int, int, doublecomplex*, char*, double*, double*, double*, double*, doublecomplex*, int*, double*, int, doublecomplex*, doublecomplex*);
+
+#endif /* __EIGS_H__ */
+/*--------------------------------------------------------------------------*/
+
diff --git a/scilab/modules/arnoldi/includes/eigs_dependencies.h b/scilab/modules/arnoldi/includes/eigs_dependencies.h
new file mode 100644 (file)
index 0000000..cf70789
--- /dev/null
@@ -0,0 +1,38 @@
+/*
+ * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
+ * Copyright (C) 2011 - Scilab Enterprises - Adeline CARNIS
+ *
+ * This file must be used under the terms of the CeCILL.
+ * This source file is licensed as described in the file COPYING, which
+ * you should have received as part of this distribution.  The terms
+ * are also available at
+ * http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
+ *
+ */
+/*--------------------------------------------------------------------------*/
+#ifndef __RTIMESRprime_H__
+#define __RTIMESRprime_H__
+#include "doublecomplex.h"
+#include <string.h>
+#include <math.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include "stack-c.h"
+#include "MALLOC.h"
+#include "sciprint.h"
+
+void RtimesRprime(double*, double *, double*, int);
+
+void invR_times_A_times_invRprime(double *, double*, double*, double*, int);
+
+void invU_times_invL_times_E(double*, double*, double*, double*, int);
+
+void RCtimesRCprime(doublecomplex*, doublecomplex *, doublecomplex*, int);
+
+void invRC_times_AC_times_invRCprime(doublecomplex *, doublecomplex*, doublecomplex*, doublecomplex*, int);
+
+void invUC_times_invLC_times_EC(doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, int);
+
+#endif /* __RTIMESRprime_H__ */
+/*--------------------------------------------------------------------------*/
+
index 1076267..97519c2 100644 (file)
@@ -24,6 +24,7 @@ ARNOLDI_IMPEXP int sci_znaupd(char *fname,unsigned long fname_len);
 ARNOLDI_IMPEXP int sci_dseupd(char *fname,unsigned long fname_len);
 ARNOLDI_IMPEXP int sci_dneupd(char *fname,unsigned long fname_len);
 ARNOLDI_IMPEXP int sci_zneupd(char *fname,unsigned long fname_len);
+ARNOLDI_IMPEXP int sci_eigs(char *fname,unsigned long fname_len);
 /*--------------------------------------------------------------------------*/
 #endif /* __GW_ARNOLDI_H__ */
 /*--------------------------------------------------------------------------*/
index 820f381..38ed301 100644 (file)
@@ -13,5 +13,5 @@ if (isdef('genlib') == %f) then
   exec(SCI+'/modules/functions/scripts/buildmacros/loadgenlib.sce');
 end
 //------------------------------------
-//genlib('arnoldilib','SCI/modules/arnoldi/macros',%f,%t);
+genlib('arnoldilib','SCI/modules/arnoldi/macros',%f,%t);
 //------------------------------------
diff --git a/scilab/modules/arnoldi/macros/eigs.sci b/scilab/modules/arnoldi/macros/eigs.sci
new file mode 100644 (file)
index 0000000..d6f811c
--- /dev/null
@@ -0,0 +1,1234 @@
+// Scilab ( http://www.scilab.org/ ) - This file is part of Scilab\r
+// Copyright (C) 2012 - Scilab Enterprises - Adeline CARNIS\r
+//\r
+// This file must be used under the terms of the CeCILL.\r
+// This source file is licensed as described in the file COPYING, which\r
+// you should have received as part of this distribution.  The terms\r
+// are also available at\r
+// http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt\r
+\r
+function [d, v] = eigs(varargin)\r
+    lhs = argn(1);\r
+    rhs = argn(2);\r
+\r
+    if(rhs == 0 | rhs > 6)\r
+        error(msprintf(gettext("%s : Wrong number of input arguments : %d to %d expected.\n"), "eigs", 1, 6));\r
+    end\r
+\r
+    if(rhs >= 1)\r
+        if((typeof(varargin(1)) <> "constant")  & typeof(varargin(1)) <> "function" & (typeof(varargin(1)) <> "sparse") | varargin(1) == [])\r
+            error(msprintf(gettext("%s: Wrong type for input argument #%d: a full or sparse square matrix or a function expected"), "eigs", 1));\r
+        end\r
+    end\r
+\r
+    if(rhs >= 1 & typeof(varargin(1)) <> "function")\r
+        if(isreal(varargin(1)))\r
+            resid = rand(size(varargin(1), "r"), 1);\r
+        else\r
+            resid = rand(size(varargin(1), "r"), 1).* %i;\r
+        end\r
+    end\r
+    \r
+    if(rhs > 1 & typeof(varargin(1)) ==  "function")\r
+        if(size(varargin(2)) <> 1)\r
+            error(msprintf(gettext("%s: Wrong type for input argument #%d: a positive integer expected if the first input argument is a function, "), "eigs",2));\r
+        end\r
+        a_real = 1;\r
+        a_sym = 0;\r
+        resid = rand(varargin(2),1);\r
+        info = 0;\r
+    end\r
+\r
+    maxiter = 300;\r
+    tol = %eps;\r
+    ncv = [];\r
+    cholB = 0;\r
+    info = 0;\r
+\r
+    if(rhs == 1)\r
+        if(~issparse(varargin(1)))\r
+            info = int32(0);\r
+        end\r
+    else\r
+        if(~issparse(varargin(1)) & ~issparse(varargin(2)))\r
+            info = int32(0);\r
+        end\r
+    end\r
+\r
+\r
+    if(typeof(varargin(1)) <> "function")\r
+        select rhs\r
+        case 1\r
+            nev =  min(size(varargin(1), 'r'), 6)\r
+            select lhs\r
+            case 1\r
+                if(issparse(varargin(1)))\r
+                    d = speigs(varargin(1), [], nev, 'LM', maxiter, tol, ncv, cholB, resid, info);\r
+                else\r
+                    d = %_eigs(varargin(1), [], nev, 'LM', maxiter, tol, ncv, cholB, resid, info);\r
+                end\r
+            case 2\r
+                if(issparse(varargin(1)))\r
+                    [d, v] = speigs(varargin(1), [], nev, 'LM', maxiter, tol, ncv, cholB, resid, info);\r
+                else\r
+                    [d, v] = %_eigs(varargin(1), [], nev, 'LM', maxiter, tol, ncv, cholB, resid, info);\r
+                end\r
+            end\r
+\r
+        case 2\r
+            nev = min(size(varargin(1), 'r'), 6)\r
+            select lhs\r
+            case 1\r
+                if(issparse(varargin(1)) | issparse(varargin(2)))\r
+                    d = speigs(varargin(1), varargin(2), nev, 'LM', maxiter, tol, ncv, cholB, resid, info);\r
+                else\r
+                    d = %_eigs(varargin(1), varargin(2), nev, 'LM', maxiter, tol, ncv, cholB, resid, info);\r
+                end\r
+            case 2\r
+                if(issparse(varargin(1)) | issparse(varargin(2)))\r
+                    [d, v] = speigs(varargin(1), varargin(2), nev, 'LM', maxiter, tol, ncv, cholB, resid, info);\r
+                else\r
+                    [d, v] = %_eigs(varargin(1), varargin(2), nev, 'LM', maxiter, tol, ncv, cholB, resid, info);\r
+                end\r
+            end\r
+\r
+        case 3\r
+            select lhs\r
+            case 1\r
+                if(issparse(varargin(1)) | issparse(varargin(2)))\r
+                    d = speigs(varargin(1), varargin(2), varargin(3), 'LM', maxiter, tol, ncv, cholB, resid, info);\r
+                else\r
+                    d = %_eigs(varargin(1), varargin(2), varargin(3), 'LM', maxiter, tol, ncv, cholB, resid, info);\r
+                end\r
+            case 2\r
+                if(issparse(varargin(1)) | issparse(varargin(2)))\r
+                    [d, v] = speigs(varargin(1), varargin(2), varargin(3), 'LM', maxiter, tol, ncv, cholB, resid, info);\r
+                else\r
+                    [d, v] = %_eigs(varargin(1), varargin(2), varargin(3), 'LM', maxiter, tol, ncv, cholB, resid, info);\r
+                end\r
+            end\r
+\r
+        case 4\r
+            select lhs\r
+            case 1\r
+                if(issparse(varargin(1)) | issparse(varargin(2)))\r
+                    d = speigs(varargin(1), varargin(2), varargin(3), varargin(4), maxiter, tol, ncv, cholB, resid, info);\r
+                else\r
+                    d = %_eigs(varargin(1), varargin(2), varargin(3), varargin(4), maxiter, tol, ncv, cholB, resid, info);\r
+                end\r
+            case 2\r
+                if(issparse(varargin(1)) | issparse(varargin(2)))\r
+                    [d, v] = speigs(varargin(1), varargin(2), varargin(3), varargin(4), maxiter, tol, ncv, cholB, resid, info);\r
+                else\r
+                    [d, v] = %_eigs(varargin(1), varargin(2), varargin(3), varargin(4), maxiter, tol, ncv, cholB, resid, info);\r
+                end\r
+            end\r
+\r
+        case 5\r
+            select lhs\r
+            case 1\r
+                opts = varargin(5);\r
+                if(~isstruct(opts))\r
+                    error(msprintf(gettext("%s: Wrong type for input argument #%d: A structure expected"), "eigs", 5));\r
+                end\r
+                if(and(~isfield(opts, ["tol", "maxiter", "ncv", "resid", "cholB"])))\r
+                    error(msprintf(gettext("%s: Wrong type for input argument: If A is a matrix, use opts with tol, maxiter, ncv, resid, cholB"), "eigs"));\r
+                end\r
+                if(isfield(opts, "tol"))\r
+                    tol = opts.tol;\r
+                end\r
+                if(isfield(opts, "maxiter"))\r
+                    maxiter = opts.maxiter;\r
+                end\r
+                if(isfield(opts, "ncv"))\r
+                    ncv = opts.ncv;\r
+                end\r
+                if(isfield(opts, "resid"))\r
+                    resid = opts.resid;\r
+                    if(issparse(varargin(1)) | issparse(varargin(2)))\r
+                        info = 1;\r
+                    else\r
+                        info = int32(1);\r
+                    end\r
+                    if(and(resid==0))\r
+                        if(issparse(varargin(1)) | issparse(varargin(2)))\r
+                            info = 0;\r
+                        else\r
+                            info = int32(0);\r
+                        end\r
+                    end\r
+                end\r
+                if(isfield(opts,"cholB"))\r
+                    cholB = opts.cholB;\r
+                end\r
+                if(issparse(varargin(1)) | issparse(varargin(2)))\r
+                    d = speigs(varargin(1), varargin(2), varargin(3), varargin(4), maxiter, tol, ncv, cholB, resid, info);\r
+                else\r
+                    d = %_eigs(varargin(1), varargin(2), varargin(3), varargin(4), maxiter, tol, ncv, cholB, resid, info);\r
+                end\r
+            case 2\r
+                opts = varargin(5);\r
+                if(~isstruct(opts))\r
+                    error(msprintf(gettext("%s: Wrong type for input argument #%d: A structure expected"), "eigs",5));\r
+                end\r
+                if(and(~isfield(opts, ["tol", "maxiter", "ncv", "resid", "cholB"])))\r
+                    error(msprintf(gettext("%s: Wrong type for input argument: If A is a matrix, use opts with tol, maxiter, ncv, resid, cholB"), "eigs"));\r
+                end\r
+                if(isfield(opts, "tol"))\r
+                    tol = opts.tol;\r
+                end\r
+                if(isfield(opts, "maxiter"))\r
+                    maxiter = opts.maxiter;\r
+                end\r
+                if(isfield(opts, "ncv"))\r
+                    ncv = opts.ncv;\r
+                end\r
+                if(isfield(opts, "resid"))\r
+                    resid = opts.resid;\r
+                    if(issparse(varargin(1)) | issparse(varargin(2)))\r
+                        info = 1;\r
+                    else\r
+                        info = int32(1);\r
+                    end\r
+                    if(and(resid==0))\r
+                        if(issparse(varargin(1)) | issparse(varargin(2)))\r
+                            info = 0;\r
+                        else\r
+                            info = int32(0);\r
+                        end\r
+                    end\r
+                end\r
+                if(isfield(opts, "cholB"))\r
+                    cholB = opts.cholB;\r
+                end\r
+                if(issparse(varargin(1)))\r
+                    [d, v] = speigs(varargin(1), varargin(2), varargin(3), varargin(4), maxiter, tol, ncv, cholB, resid, info);\r
+                else\r
+                    [d, v] = %_eigs(varargin(1), varargin(2), varargin(3), varargin(4), maxiter, tol, ncv, cholB, resid, info);\r
+                end\r
+            end\r
+        end\r
+    else\r
+        select rhs\r
+        case 2\r
+            nev = min(varargin(2), 6)\r
+            select lhs\r
+            case 1\r
+                d = feigs(varargin(1), varargin(2), [], nev, 'LM', maxiter, tol, ncv, cholB, resid, info, a_real, a_sym);\r
+            case 2\r
+                [d, v] = feigs(varargin(1), varargin(2), [], nev, 'LM', maxiter, tol, ncv, cholB, resid, info, a_real, a_sym);\r
+            end\r
+        case 3\r
+            nev = min(varargin(2), 6);\r
+            select lhs\r
+            case 1\r
+                d = feigs(varargin(1), varargin(2), varargin(3), nev, 'LM', maxiter, tol, ncv, cholB, resid, info, a_real, a_sym);\r
+            case 2\r
+                [d, v] = feigs(varargin(1), varargin(2), varargin(3), nev, 'LM', maxiter, tol, ncv, cholB, resid, info, a_real, a_sym);\r
+            end\r
+\r
+        case 4\r
+            select lhs\r
+            case 1\r
+                d = feigs(varargin(1), varargin(2), varargin(3), varargin(4), 'LM', maxiter, tol, ncv, cholB, resid, info, a_real, a_sym);\r
+            case 2\r
+                [d, v] = feigs(varargin(1), varargin(2), varargin(3), varargin(4), 'LM', maxiter, tol, ncv, cholB, resid, info, a_real, a_sym);\r
+            end\r
+\r
+        case 5\r
+            select lhs\r
+            case 1\r
+                d = feigs(varargin(1), varargin(2), varargin(3), varargin(4), varargin(5), maxiter, tol, ncv, cholB, resid, info, a_real, a_sym);\r
+            case 2\r
+                [d, v] = feigs(varargin(1), varargin(2), varargin(3), varargin(4), varargin(5), maxiter, tol, ncv, cholB, resid, info, a_real, a_sym);\r
+            end\r
+\r
+        case 6\r
+            select lhs\r
+            case 1\r
+                opts = varargin(6);\r
+                if(~isstruct(opts)) then\r
+                    error(msprintf(gettext("%s: Wrong type for input argument #%d: A structure expected"), "eigs",5));\r
+                end\r
+                if(and(~isfield(opts, ["tol", "maxiter", "ncv", "resid", "cholB", "issym", "isreal"])))\r
+                    error(msprintf(gettext("%s: Wrong type for input argument: Use opts with tol, maxiter, ncv, resid, cholB, issym, isreal"), "eigs"));\r
+                end\r
+                if(isfield(opts,"tol"))\r
+                    tol = opts.tol;\r
+                end\r
+                if(isfield(opts,"maxiter"))\r
+                    maxiter = opts.maxiter;\r
+                end\r
+                if(isfield(opts, "ncv"))\r
+                    ncv = opts.ncv;\r
+                end\r
+                if(isfield(opts,"resid"))\r
+                    resid = opts.resid;\r
+                    info = 1;\r
+                    if(and(resid==0))\r
+                        info = 0;\r
+                    end\r
+                end\r
+                if(isfield(opts,"cholB"))\r
+                    cholB = opts.cholB;\r
+                end\r
+                if(isfield(opts,"issym"))\r
+                    a_sym = opts.issym;\r
+                end\r
+                if(isfield(opts,"isreal"))\r
+                    a_real = opts.isreal;\r
+                    if(~a_real & ~isfield(opts,"resid"))\r
+                        resid = rand(varargin(2),1).*%i;\r
+                    end\r
+                end\r
+\r
+                d = feigs(varargin(1), varargin(2), varargin(3), varargin(4), varargin(5), maxiter, tol, ncv, cholB, resid, info, a_real, a_sym);\r
+            case 2\r
+                opts = varargin(6);\r
+                if (~isstruct(opts)) then\r
+                    error(msprintf(gettext("%s: Wrong type for input argument #%d: A structure expected"), "eigs",5));\r
+                end\r
+                if (and(~isfield(opts, ["tol", "maxiter", "ncv", "resid", "cholB" ])))\r
+                    error(msprintf(gettext("%s: Wrong type for input argument: Use opts with tol, maxiter, ncv, resid, cholB, issym, isreal"), "eigs"));\r
+                end\r
+                if (isfield(opts,"tol"))\r
+                    tol = opts.tol;\r
+                end\r
+                if (isfield(opts,"maxiter"))\r
+                    maxiter = opts.maxiter;\r
+                end\r
+                if (isfield(opts, "ncv"))\r
+                    ncv = opts.ncv;\r
+                end\r
+                if(isfield(opts,"resid"))\r
+                    resid = opts.resid;\r
+                    info = 1;\r
+                    if(and(resid==0))\r
+                        info = 0;\r
+                    end\r
+                end\r
+                if (isfield(opts,"cholB"))\r
+                    cholB = opts.cholB;\r
+                end\r
+                if (isfield(opts,"isreal"))\r
+                    a_real = opts.isreal;\r
+                    if(~a_real & ~isfield(opts,"resid"))\r
+                        resid = rand(varargin(2),1).*%i;\r
+                    end\r
+                end\r
+                if (isfield(opts,"issym"))\r
+                    a_sym = opts.issym;\r
+                end\r
+                [d, v] = feigs(varargin(1), varargin(2), varargin(3), varargin(4), varargin(5), maxiter, tol, ncv, cholB, resid, info, a_real, a_sym);\r
+            end\r
+        end\r
+    end\r
+\r
+endfunction\r
+\r
+function [res_d, res_v] = speigs(A, B, nev, which, maxiter, tol, ncv, cholB, resid, info)\r
+    lhs = argn(1);\r
+    rvec = 0;\r
+    if(lhs > 1)\r
+        rvec = 1;\r
+    end\r
+\r
+    //**************************\r
+    //First variable A :\r
+    //**************************\r
+    [mA, nA] = size(A);\r
+\r
+    //check if A is a square matrix\r
+    if(mA * nA < 2 | mA <> nA)\r
+        error(msprintf(gettext("%s: Wrong dimension for input argument #%d: a square matrix expected.\n"), "speigs", 1));\r
+    end\r
+\r
+    //check if A is complex\r
+    Areal = isreal(A);\r
+\r
+    //check if A is symetric\r
+    Asym = and(A == A');\r
+\r
+    //*************************\r
+    //Second variable B :\r
+    //*************************\r
+    if((typeof(B) <> "constant") & (typeof(B) <> "sparse"))\r
+        error(msprintf(gettext("%s: Wrong type for input argument #%d: a empty matrix or full or sparse square matrix expected. \n"), "speigs", 2));\r
+    end\r
+    [mB, nB] = size(B);\r
+\r
+    //Check if B is a square matrix\r
+    if(mB * nB == 1 | mB <> nB)\r
+        error(msprintf(gettext("%s: Wrong dimension for input argument #%d: B must be a same size as A.\n"), "speigs", 2));\r
+    end\r
+\r
+    //check if B is complex\r
+    Breal = isreal(B);\r
+    matB = mB * nB;\r
+\r
+    //*************************\r
+    //NEV :\r
+    //*************************\r
+    //verification du type de nev\r
+    if(typeof(nev) <> "constant")\r
+        error(msprintf(gettext("%s: Wrong type for input argument #%d: an integer expected. \n"), "speigs", 3));\r
+    end\r
+\r
+    //check if nev is complex?\r
+    if(~isreal(nev))\r
+        error(msprintf(gettext("%s: Wrong type for input argument #%d: an integer expected. \n"), "speigs", 3));\r
+    end\r
+\r
+    if(size(nev, "*") <> 1)\r
+        error(msprintf(gettext("%s: Wrong dimension for input argument #%d: k must be 1 by 1 size. \n"), "speigs", 3));\r
+    end\r
+\r
+    if(nev <> floor(nev) | (nev<=0))\r
+        error(msprintf(gettext("%s: Wrong type for input argument #%d: k must be a positive integer. \n"), "speigs", 3));\r
+    end\r
+\r
+    if(Asym & Areal & Breal)\r
+        if(nev >= nA)\r
+            error(msprintf(gettext("%s: Wrong type for input argument #%d: For real symmetric problems, k must be in the range 1 to N - 1. \n"), "speigs", 3));\r
+        end\r
+    else\r
+        if(nev >= nA - 1)\r
+            error(msprintf(gettext("%s: Wrong type for input argument #%d: For real non symmetric or complex problems, k must be in the range 1 to N - 2. \n"), "speigs", 3));\r
+        end\r
+    end\r
+\r
+    //*************************\r
+    //SIGMA AND WHICH :\r
+    //*************************\r
+    //Check type\r
+    select type(which)\r
+    case 1 then\r
+        if(typeof(which) <> "constant" | which == [] | isnan(which))\r
+            error(msprintf(gettext("%s: Wrong type for input argument #%d: a scalar expected. \n"), "speigs", 4));\r
+        end\r
+        sigma = which;\r
+        which = 'LM';\r
+    case 10 then\r
+        [mWHICH, nWHICH] = size(which);\r
+        if(mWHICH * nWHICH <> 1)\r
+            error(msprintf(gettext("%s: Wrong dimension for input argument #%d: a string expected. \n"), "speigs", 4));\r
+        end\r
+        if(strcmp(which,'LM') ~= 0 & strcmp(which,'SM') ~= 0  & strcmp(which,'LR') ~= 0 & strcmp(which,'SR') ~= 0 & strcmp(which,'LI') ~= 0 & strcmp(which,'SI') ~= 0 & strcmp(which,'LA') ~= 0 & strcmp(which,'SA') ~= 0 & strcmp(which,'BE') ~= 0)\r
+            if(Areal & Breal & Asym)\r
+                error(msprintf(gettext("%s: Wrong value for input argument #%d : Unrecognized sigma value.\n Sigma must be one of LM, SM, LA, SA or BE. \n"), "speigs", 4));\r
+            else\r
+                error(msprintf(gettext("%s: Wrong value for input argument #%d : Unrecognized sigma value.\n Sigma must be one of LM, SM, LR, SR, LI or SI. \n"), "speigs", 4));\r
+            end\r
+        end\r
+        if((~Areal | ~Breal | ~Asym) & (strcmp(which,'LA') == 0 | strcmp(which,'SA') == 0 | strcmp(which,'BE') == 0))\r
+            error(msprintf(gettext("%s: Invalid sigma value for complex or non symmetric problem. \n"), "speigs"));\r
+        end\r
+        if(Areal & Breal & Asym & (strcmp(which,'LR') == 0 | strcmp(which,'SR') == 0 | strcmp(which,'LI') == 0 | strcmp(which,'SI') == 0))\r
+            error(msprintf(gettext("%s: Invalid sigma value for real symmetric problem. \n"), "speigs"));\r
+        end\r
+        sigma = 0;\r
+    else\r
+        error(msprintf(gettext("%s: Wrong type for input argument #%d: a real scalar or a string expected. \n"), "speigs", 4));\r
+    end\r
+\r
+    if(~Areal | ~Breal)\r
+        sigma = complex(sigma);\r
+    end\r
+\r
+    //*************************\r
+    //MAXITER :\r
+    //*************************\r
+    if(typeof(maxiter) <> "constant")\r
+        error(msprintf(gettext("%s: Wrong type for input argument #%d: opts.maxiter must be a scalar. \n"), "speigs", 5));\r
+    end\r
+\r
+    //check if maxiter is complex?\r
+    if(~isreal(maxiter))\r
+        error(msprintf(gettext("%s: Wrong type for input argument #%d: opts.maxiter must be a scalar. \n"), "speigs", 5));\r
+    end\r
+\r
+    if(size(maxiter, "*") <> 1)\r
+        error(msprintf(gettext("%s: Wrong dimension for input argument(s) #%d: opts.maxiter must be a scalar. \n"), "speigs", 5));\r
+    end\r
+\r
+    if((maxiter <> floor(maxiter)) | (maxiter <= 0) )\r
+        error(msprintf(gettext("%s: Wrong type for input argument #%d: opts.maxiter must be an integer positive value. \n"), "speigs", 5));\r
+    end\r
+\r
+    //*************************\r
+    //TOL :\r
+    //*************************\r
+    if(typeof(tol) <> "constant")\r
+        error(msprintf(gettext("%s: Wrong type for input argument #%d: opts.tol must be a real scalar. \n"), "speigs", 6));\r
+    end\r
+\r
+    //check if tol is complex?\r
+    if(~isreal(tol) | isnan(tol))\r
+        error(msprintf(gettext("%s: Wrong type for input argument #%d: opts.tol must be a real scalar. \n"), "speigs", 6));\r
+    end\r
+\r
+    if(size(tol, "*") <> 1)\r
+        error(msprintf(gettext("%s: Wrong dimension for input argument #%d: opts.tol must be 1 by 1 size. \n"), "speigs", 6));\r
+    end\r
+\r
+    //*************************\r
+    //NCV :\r
+    //*************************\r
+    if(typeof(ncv) <> "constant")\r
+        error(msprintf(gettext("%s: Wrong type for input argument #%d: opts.ncv must be a integer scalar. \n"), "speigs", 7));\r
+    end\r
+\r
+    //check if ncv is complex?\r
+    if(~isreal(ncv))\r
+        error(msprintf(gettext("%s: Wrong type for input argument #%d: opts.ncv must be a integer scalar. \n"), "speigs", 7));\r
+    end\r
+\r
+    if(size(ncv, "*") > 1 | ncv <> floor(ncv) | (ncv <> [] & ncv <= 0))\r
+        error(msprintf(gettext("%s: Wrong dimension for input argument #%d: opts.ncv must be a integer scalar. \n"), "speigs", 7));\r
+    end\r
+\r
+    if(ncv <> floor(ncv))\r
+        error(msprintf(gettext("%s: Wrong type for input argument #%d: opts.nev must be a integer scalar. \n"), "speigs", 7));\r
+    end\r
+\r
+    if(ncv <= 0 & ncv <> [])\r
+        error(msprintf(gettext("%s: Wrong type for input argument #%d: opts.nev must be a integer scalar. \n"), "speigs", 7));\r
+    end\r
+\r
+    if(isempty(ncv))\r
+        if(~Asym & Areal & Breal)\r
+            ncv = min(max(2*nev+1, 20), nA);\r
+        else\r
+            ncv = min(max(2*nev, 20), nA);\r
+        end\r
+    else\r
+        if(ncv <= nev | ncv > nA)\r
+            if(Asym & Areal & Breal)\r
+                error(msprintf(gettext("%s: Wrong type for input argument #%d : For real symmetric problems, NCV must be NEV < NCV <= N. \n"), "speigs", 7));\r
+            elseif(~Asym & Areal & Breal)\r
+                error(msprintf(gettext("%s: Wrong type for input argument #%d : For real non symmetric problems, NCV must be NEV+2 < NCV < N. \n"), "speigs", 7));\r
+            else\r
+                error(msprintf(gettext("%s: Wrong type for input argument #%d : For complex problems, NCV must be NEV+1 < NCV <= N. \n"), "speigs", 7));\r
+            end\r
+        end\r
+    end\r
+\r
+    //*************************\r
+    //CHOL :\r
+    //*************************\r
+    if(typeof(cholB) <> "constant")\r
+        error(msprintf(gettext("%s: Wrong type for input argument #%d: opts.cholB must be a integer scalar. \n"), "speigs", 8));\r
+    end\r
+\r
+    //check if chol is complex?\r
+    if(~isreal(cholB))\r
+        error(msprintf(gettext("%s: Wrong type for input argument #%d: opts.cholB must be a integer scalar. \n"), "speigs", 8));\r
+    end\r
+\r
+    if(size(cholB, "*") <> 1 | cholB <> floor(cholB) | cholB > 1)\r
+        error(msprintf(gettext("%s: Wrong dimension for input argument #%d: opts.cholB must be between 0 and 1 . \n"), "speigs", 8));\r
+    end\r
+\r
+    if(cholB <> floor(cholB) | cholB > 1)\r
+        error(msprintf(gettext("%s: Wrong type for input argument #%d: opts.cholB must be a integer scalar. \n"), "speigs", 8));\r
+    end\r
+\r
+    //*************************\r
+    //RESID :\r
+    //*************************\r
+    if(typeof(resid) <> "constant")\r
+        error(msprintf(gettext("%s: Wrong type for input argument #%d: A real or complex matrix expected. \n"), "speigs", 9));\r
+    end\r
+\r
+    [mRESID, nRESID] = size(resid);\r
+    if(mRESID * nRESID ~= nA)\r
+        error(msprintf(gettext("%s: Wrong dimension for input argument #%d: Start vector opts.resid must be N by 1. \n"), "speigs", 9));\r
+    end\r
+\r
+    if(Areal & Breal)\r
+        //resid complexe ?\r
+        if(~isreal(resid))\r
+            error(msprintf(gettext("%s: Wrong type for input argument #%d: Start vector opts.resid must be real for real problems. \n"), "speigs", 9));\r
+        end\r
+    else\r
+        if(isreal(resid))\r
+            error(msprintf(gettext("%s: Wrong type for input argument #%d: Start vector opts.resid must be complex for complex problems. \n"), "speigs", 9));\r
+        end\r
+    end\r
+\r
+    iparam = zeros(11,1);\r
+    iparam(1) = 1;\r
+    iparam(3) = maxiter;\r
+    iparam(7) = 1;\r
+\r
+    ipntr = zeros(14,1);\r
+\r
+    //MODE 1, 2, 3, 4, 5\r
+    if(~strcmp(which,'SM') | sigma <> 0)\r
+        iparam(7) = 3;\r
+        which = 'LM';\r
+    end\r
+\r
+    //bmat initialization\r
+    if(matB == 0 | iparam(7) == 1)\r
+        bmat = 'I';\r
+    else\r
+        bmat = 'G';\r
+    end\r
+\r
+    if(cholB)\r
+        if(~and(triu(B) == B))\r
+            error(msprintf(gettext("%s: Wrong type for input argument #%d: B must be symmmetric or hermitian, definite, semi positive. \n"), "speigs", 2));\r
+        end\r
+        R = B;\r
+        Rprime = R';\r
+    end\r
+\r
+    if(~cholB & matB <> 0 & iparam(7) == 1)\r
+        if(~Breal)\r
+            error(msprintf(gettext("%s: Impossible to use the Cholesky factorisation with complex sparses matrices. \n"), "speigs"));\r
+        else\r
+            [R,P] = spchol(B);\r
+        end\r
+        Rprime = R';\r
+    end\r
+\r
+    //Main\r
+    howmny = 'A';\r
+    ido = 0;\r
+    info_eupd = 0;\r
+    _select = zeros(ncv,1);\r
+    if(iparam(7) == 3)\r
+        if(matB == 0)\r
+            AMSB = A - sigma * speye(nA, nA);\r
+        else\r
+            if(cholB)\r
+                AMSB = A - (sigma * Rprime * R);\r
+            else\r
+                AMSB = A - sigma * B;\r
+            end\r
+        end\r
+        if(~isreal(AMSB))\r
+            Lup = umf_lufact(AMSB);\r
+            [L, U, p, q, R] = umf_luget(Lup);\r
+            R = diag(R);\r
+            P = zeros(nA, nA);\r
+            Q = zeros(nA, nA);\r
+            for i = 1:nA\r
+                P(i,p(i)) = 1;\r
+                Q(q(i),i) = 1;\r
+            end\r
+            umf_ludel(Lup);\r
+        else\r
+            [hand, rk] = lufact(AMSB);\r
+            [P, L, U, Q] = luget(hand);\r
+            ludel(hand);\r
+        end\r
+    end\r
+\r
+    if(Areal)\r
+        if(Asym)\r
+            lworkl = ncv * ncv + 8 * ncv;\r
+            v = zeros(nA, ncv);\r
+            workl = zeros(lworkl, 1);\r
+            workd = zeros(3 * nA, 1);\r
+            d = zeros(nev, 1);\r
+            z = zeros(nA, nev);\r
+        else\r
+            lworkl = 3 * ncv * (ncv + 2);\r
+            v = zeros(nA, ncv);  \r
+            workl = zeros(lworkl, 1);\r
+            workd = zeros(3 * nA, 1);\r
+            dr = zeros(nev+1, 1);\r
+            di = zeros(nev+1, 1);\r
+            z = zeros(nA, nev + 1);\r
+            workev = zeros(3 * ncv, 1);\r
+        end\r
+    else\r
+        lworkl = 3 * ncv * ncv + 5 * ncv;\r
+        v = zeros(nA, ncv) + 0 * %i;\r
+        workl = zeros(lworkl, 1) + 0 * %i;\r
+        workd = zeros(3 * nA, 1) + 0 * %i;\r
+        rwork = zeros(ncv, 1);\r
+        d = zeros(nev + 1, 1) + 0 * %i;\r
+        z = zeros(nA, nev) + 0 * %i;\r
+        workev = zeros(2 * ncv, 1) + 0 * %i;\r
+    end\r
+\r
+    while(ido <> 99)\r
+        if(Areal & Breal)\r
+            if(Asym)\r
+                [ido, resid, v, iparam, ipntr, workd, workl, info] = dsaupd(ido, bmat, nA, which, nev, tol, resid, ncv, v, iparam, ipntr, workd, workl, info);\r
+                if(info < 0)\r
+                    error(msprintf(gettext("%s: Error with DSAUPD, info = %d. \n"), "speigs", info));\r
+                end\r
+            else\r
+                [ido, resid, v, iparam, ipntr, workd, workl, info] = dnaupd(ido, bmat, nA, which, nev, tol, resid, ncv, v, iparam, ipntr, workd, workl, info);\r
+                if(info < 0)\r
+                    error(msprintf(gettext("%s: Error with DNAUPD, info = %d. \n"), "speigs", info));\r
+                end\r
+            end\r
+        else\r
+            [ido, resid, v, iparam, ipntr, workd, workl, rwork, info] = znaupd(ido, bmat, nA, which, nev, tol, resid, ncv, v, iparam, ipntr, workd, workl, rwork, info);\r
+            if(info < 0)\r
+                error(msprintf(gettext("%s: Error with ZNAUPD, info = %d. \n"), "speigs", info));\r
+            end\r
+        end\r
+\r
+        if(ido == -1 | ido == 1 | ido == 2)\r
+            if(iparam(7) == 1)\r
+                if(matB == 0)\r
+                    workd(ipntr(2):ipntr(2)+nA-1) = A * workd(ipntr(1):ipntr(1)+nA-1);\r
+                else\r
+                    workd(ipntr(2):ipntr(2)+nA-1) = inv(Rprime) * A * inv(R) * workd(ipntr(1):ipntr(1)+nA-1);\r
+                end\r
+            elseif(iparam(7) == 3)\r
+                if(matB == 0)\r
+                    if(ido == 2)\r
+                        workd(ipntr(2):ipntr(2)+nA-1) = workd(ipntr(1):ipntr(1)+nA-1);\r
+                    else\r
+                        if(Areal & Breal)\r
+                            workd(ipntr(2):ipntr(2)+nA-1) = inv(Q) * inv(U) * inv(L) * inv(P) *workd(ipntr(1):ipntr(1)+nA-1);\r
+                        else\r
+                            if(~isreal(L) | ~isreal(U))\r
+                                error(msprintf(gettext("%s: Impossible to invert complex sparse matrix. \n"), "speigs"));\r
+                            else\r
+                                workd(ipntr(2):ipntr(2)+nA-1) = Q * inv(U) * inv(L) * P * inv(R) * workd(ipntr(1):ipntr(1)+nA-1);\r
+                            end\r
+                        end\r
+                    end\r
+                else\r
+                    if(ido == 2)\r
+                        if(cholB)\r
+                            workd(ipntr(2):ipntr(2)+nA-1) = Rprime * R * workd(ipntr(1):ipntr(1)+nA-1);\r
+                        else\r
+                            workd(ipntr(2):ipntr(2)+nA-1) = B * workd(ipntr(1):ipntr(1)+nA-1);\r
+                        end\r
+                    elseif(ido == -1)\r
+                        if(cholB)\r
+                            workd(ipntr(2):ipntr(2)+nA-1) = Rprime * R * workd(ipntr(1):ipntr(1)+nA-1);\r
+                        else\r
+                            workd(ipntr(2):ipntr(2)+nA-1) = B * workd(ipntr(1):ipntr(1)+nA-1);\r
+                        end\r
+                        if(Areal & Breal)\r
+                            workd(ipntr(2):ipntr(2)+nA-1) = inv(Q) * inv(U) * inv(L) * inv(P) *workd(ipntr(2):ipntr(2)+nA-1);\r
+                        else\r
+                            if(~isreal(L) | ~isreal(U))\r
+                                error(msprintf(gettext("%s: Impossible to invert complex sparse matrix. \n"), "speigs"));\r
+                            else\r
+                                workd(ipntr(2):ipntr(2)+nA-1) = Q * inv(U) * inv(L) * P * inv(R) * workd(ipntr(2):ipntr(2)+nA-1);\r
+                            end\r
+                        end\r
+                    else\r
+                        if(Areal & Breal)\r
+                            workd(ipntr(2):ipntr(2)+nA-1) = inv(Q) * inv(U) * inv(L) * inv(P) * workd(ipntr(3):ipntr(3)+nA-1);\r
+                        else\r
+                            if(~isreal(L) | ~isreal(U))\r
+                                error(msprintf(gettext("%s: Impossible to invert complex sparse matrix. \n"), "speigs"));\r
+                            else\r
+                                workd(ipntr(2):ipntr(2)+nA-1) = Q * inv(U) * inv(L) * P * inv(R) * workd(ipntr(3):ipntr(3)+nA-1);\r
+                            end\r
+                        end\r
+                    end\r
+                end\r
+            else\r
+                if(Areal & Breal)\r
+                    if(Asym)\r
+                        error(msprintf(gettext("%s: Error with DSAUPD, unknown mode returned. \n"), "speigs"));\r
+                    else\r
+                        error(msprintf(gettext("%s: Error with DNAUPD, unknown mode returned. \n"), "speigs"));\r
+                    end\r
+                else\r
+                    error(msprintf(gettext("%s: Error with ZNAUPD, unknown mode returned. \n"), "speigs"));\r
+                end\r
+            end\r
+        end\r
+    end\r
+\r
+    if(Areal & Breal)\r
+        if(Asym)\r
+            [d, z, resid, v, iparam, iptnr, workd, workl, info_eupd] = dseupd(rvec, howmny, _select, d, z, sigma, bmat, nA, which, nev, tol, resid, ncv, v, iparam, ipntr, workd, workl, info_eupd);\r
+            if(info_eupd <> 0)\r
+                error(msprintf(gettext("%s: Error with DSEUPD, info = %d. \n"), "speigs", info_eupd));\r
+            else\r
+                res_d = d;\r
+                if(rvec)\r
+                    res_d = diag(res_d);\r
+                    res_v = z;\r
+                end\r
+            end\r
+        else\r
+            sigmar = real(sigma);\r
+            sigmai = imag(sigma);\r
+            [dr, di, z, resid, v, iparam, ipntr, workd, workl, info_eupd] = dneupd(rvec, howmny, _select, dr, di, z, sigmar, sigmai, workev, bmat, nA, which, nev, tol, resid, ncv, v, iparam, ipntr, workd, workl, info_eupd);\r
+            if(info_eupd <> 0)\r
+                error(msprintf(gettext("%s: Error with DNEUPD, info = %d. \n"), "speigs", info_eupd));\r
+            else\r
+                res_d = complex(dr,di);\r
+                res_d(nev+1) = [];\r
+                if(rvec)\r
+                    res_d = diag(res_d)\r
+                    res_v = z;\r
+                    c1 = 1:2:nev + 1;\r
+                    c2 = 2:2:nev + 1;\r
+                    if(modulo(nev + 1, 2) == 1)\r
+                        c1($) = [];\r
+                    end\r
+                    res_v(:,[c1, c2]) = [res_v(:,c1) + res_v(:,c2) * %i res_v(:,c1) - res_v(:,c2) * %i];\r
+                    res_v(:,$) = [];\r
+                end\r
+            end\r
+        end\r
+    else\r
+        [d, z, resid, iparam, ipntr, workd, workl, rwork, info_eupd] = zneupd(rvec, howmny, _select, d, z, sigma, workev, bmat, nA, which, nev, tol, resid, ncv, v, iparam, ipntr, workd, workl, rwork, info_eupd);\r
+        if(info_eupd <> 0)\r
+            error(msprintf(gettext("%s: Error with ZNEUPD, info = %d. \n"), "speigs", info_eupd));\r
+        else\r
+            d(nev+1) = []\r
+            res_d = d;\r
+            if(rvec)\r
+                res_d = diag(d);\r
+                res_v = z;\r
+            end\r
+        end\r
+    end\r
+endfunction\r
+\r
+\r
+function [res_d, res_v] = feigs(A_fun, nA, B, nev, which, maxiter, tol, ncv, cholB, resid, info, a_real, a_sym)\r
+    lhs = argn(1);\r
+    rvec = 0;\r
+    if(lhs > 1)\r
+        rvec = 1;\r
+    end\r
+\r
+    //**************************\r
+    //Second variable nA :\r
+    //**************************\r
+    if(size(nA,'*') <> 1 | ~isreal(nA) | typeof(nA) <> "constant")\r
+        error(msprintf(gettext("%s: Wrong type for input argument #%d: n must be a positive integer. \n"), "feigs", 2));\r
+    end\r
+\r
+    if(floor(nA) <> nA | nA <= 0)\r
+        error(msprintf(gettext("%s: Wrong type for input argument #%d: n must be a positive integer. \n"), "feigs", 2));\r
+    end\r
+\r
+    //*************************\r
+    //Third variable B :\r
+    //*************************\r
+    if((typeof(B) <> "constant") & (typeof(B) <> "sparse"))\r
+        error(msprintf(gettext("%s: Wrong type for input argument #%d: a empty matrix or full or sparse square matrix expected. \n"), "feigs", 3));\r
+    end\r
+    [mB, nB] = size(B);\r
+\r
+    //Check if B is a square matrix\r
+    if(mB * nB == 1 | mB <> nB)\r
+        error(msprintf(gettext("%s: Wrong dimension for input argument #%d: B must be a same size as A.\n"), "feigs", 3));\r
+    end\r
+\r
+    //check if B is complex\r
+    Breal = isreal(B);\r
+    matB = mB * nB;\r
+\r
+    //*************************\r
+    //NEV :\r
+    //*************************\r
+    //Check nev type\r
+    if(typeof(nev) <> "constant")\r
+        error(msprintf(gettext("%s: Wrong type for input argument #%d: an integer expected. \n"), "feigs", 4));\r
+    end\r
+\r
+    //check if nev is complex?\r
+    if(~isreal(nev))\r
+        error(msprintf(gettext("%s: Wrong type for input argument #%d: an integer expected. \n"), "feigs", 4));\r
+    end\r
+\r
+    if(size(nev,'*') <> 1)\r
+        error(msprintf(gettext("%s: Wrong dimension for input argument #%d: k must be 1 by 1 size. \n"), "feigs", 3));\r
+    end\r
+\r
+    if(nev <> floor(nev) | (nev<=0))\r
+        error(msprintf(gettext("%s: Wrong type for input argument #%d: k must be a positive integer. \n"), "feigs", 4));\r
+    end\r
+\r
+    if(a_sym & a_real & Breal)\r
+        if(nev >= nA)\r
+            error(msprintf(gettext("%s: Wrong type for input argument #%d: For real symmetric problems, k must be in the range 1 to N - 1. \n"), "feigs", 4));\r
+        end\r
+    else\r
+        if(nev >= nA - 1)\r
+            error(msprintf(gettext("%s: Wrong type for input argument #%d: For real non symmetric or complex problems, k must be in the range 1 to N - 2. \n"), "feigs", 4));\r
+        end\r
+    end\r
+\r
+    //*************************\r
+    //SIGMA AND WHICH :\r
+    //*************************\r
+    //Check type\r
+    select type(which)\r
+    case 1 then\r
+        if(typeof(which) <> "constant" | which == [] | isnan(which))\r
+            error(msprintf(gettext("%s: Wrong type for input argument #%d: a scalar expected. \n"), "feigs", 5));\r
+        end\r
+        sigma = which;\r
+        which = 'LM';\r
+    case 10 then\r
+        [mWHICH, nWHICH] = size(which);\r
+        if(mWHICH * nWHICH <> 1)\r
+            error(msprintf(gettext("%s: Wrong dimension for input argument(s) #%d: a string expected. \n"), "feigs", 5));\r
+        end\r
+        if(strcmp(which,'LM') ~= 0 & strcmp(which,'SM') ~= 0  & strcmp(which,'LR') ~= 0 & strcmp(which,'SR') ~= 0 & strcmp(which,'LI') ~= 0 & strcmp(which,'SI') ~= 0 & strcmp(which,'LA') ~= 0 & strcmp(which,'SA') ~= 0 & strcmp(which,'BE') ~= 0)\r
+            if(a_real & Breal & a_sym)\r
+                error(msprintf(gettext("%s: Wrong value for input argument #%d : Unrecognized sigma value.\n Sigma must be one of LM, SM, LA, SA or BE. \n"), "feigs", 5));\r
+            else\r
+                error(msprintf(gettext("%s: Wrong value for input argument #%d : Unrecognized sigma value.\n Sigma must be one of LM, SM, LR, SR, LI or SI. \n"), "feigs", 5));\r
+            end\r
+        end\r
+        if((~a_real | ~Breal | ~a_sym) & (strcmp(which,'LA') == 0 | strcmp(which,'SA') == 0 | strcmp(which,'BE') == 0))\r
+            error(msprintf(gettext("%s: Invalid sigma value for complex or non symmetric problem. \n"), "feigs"));\r
+        end\r
+        if(a_real & Breal & a_sym & (strcmp(which,'LR') == 0 | strcmp(which,'SR') == 0 | strcmp(which,'LI') == 0 | strcmp(which,'SI') == 0))\r
+            error(msprintf(gettext("%s: Invalid sigma value for real symmetric problem. \n"), "feigs"));\r
+        end\r
+        sigma = 0;\r
+    else\r
+        error(msprintf(gettext("%s: Wrong type for input argument #%d: a real scalar or a string expected. \n"), "feigs", 5));\r
+    end\r
+\r
+    if(~a_real | ~Breal)\r
+        sigma = complex(sigma);\r
+    end\r
+\r
+    //*************************\r
+    //MAXITER :\r
+    //*************************\r
+    if(typeof(maxiter) <> "constant")\r
+        error(msprintf(gettext("%s: Wrong type for input argument #%d: opts.maxiter must be a scalar. \n"), "feigs", 6));\r
+    end\r
+\r
+    //check if maxiter is complex?\r
+    if(~isreal(maxiter))\r
+        error(msprintf(gettext("%s: Wrong type for input argument #%d: opts.maxiter must be a scalar. \n"), "feigs", 6));\r
+    end\r
+\r
+    if(size(maxiter,'*') <> 1)\r
+        error(msprintf(gettext("%s: Wrong dimension for input argument #%d: opts.maxiter must be a scalar. \n"), "feigs", 6));\r
+    end\r
+\r
+    if((maxiter <> floor(maxiter)) | (maxiter <= 0) )\r
+        error(msprintf(gettext("%s: Wrong type for input argument #%d: opts.maxiter must be an integer positive value. \n"), "feigs", 6));\r
+    end\r
+\r
+    //*************************\r
+    //TOL :\r
+    //*************************\r
+    if(typeof(tol) <> "constant")\r
+        error(msprintf(gettext("%s: Wrong type for input argument #%d: opts.tol must be a real scalar. \n"), "feigs", 7));\r
+    end\r
+\r
+    //check if tol is complex?\r
+    if(~isreal(tol) | isnan(tol))\r
+        error(msprintf(gettext("%s: Wrong type for input argument #%d: opts.tol must be a real scalar. \n"), "feigs", 7));\r
+    end\r
+\r
+    if(size(tol,'*') <> 1)\r
+        error(msprintf(gettext("%s: Wrong dimension for input argument #%d: opts.tol must be 1 by 1 size. \n"), "feigs", 7));\r
+    end\r
+\r
+    //*************************\r
+    //NCV :\r
+    //*************************\r
+    if(typeof(ncv) <> "constant")\r
+        error(msprintf(gettext("%s: Wrong type for input argument #%d: opts.ncv must be a integer scalar. \n"), "feigs", 8));\r
+    end\r
+\r
+    //check if ncv is complex?\r
+    if(~isreal(ncv))\r
+        error(msprintf(gettext("%s: Wrong type for input argument #%d: opts.ncv must be a integer scalar. \n"), "feigs", 8));\r
+    end\r
+\r
+    if(size(ncv,'*') > 1 | ncv <> floor(ncv) | (ncv <> [] & ncv <= 0))\r
+        error(msprintf(gettext("%s: Wrong dimension for input argument #%d: opts.ncv must be a integer scalar. \n"), "feigs", 8));\r
+    end\r
+\r
+\r
+\r
+    if(isempty(ncv))\r
+        if(~a_sym & a_real & Breal)\r
+            ncv = min(max(2*nev+1, 20), nA);\r
+        else\r
+            ncv = min(max(2*nev, 20), nA);\r
+        end\r
+    else\r
+        if(ncv <= nev | ncv > nA)\r
+            if(a_sym & a_real & Breal)\r
+                error(msprintf(gettext("%s: Wrong type for input argument #%d : For real symmetric problems, NCV must be NEV < NCV <= N. \n"), "feigs", 8));\r
+            elseif(~a_sym & a_real & Breal)\r
+                error(msprintf(gettext("%s: Wrong type for input argument #%d : For real non symmetric problems, NCV must be NEV+2 < NCV < N. \n"), "feigs", 8));\r
+\r
+            else\r
+                error(msprintf(gettext("%s: Wrong type for input argument #%d : For complex problems, NCV must be NEV+1 < NCV <= N. \n"), "feigs", 8));\r
+            end\r
+        end\r
+    end\r
+    if(ncv == nA & rvec & ~a_sym & Areal & Breal)\r
+        error(msprintf(gettext("%s: Wrong type for input argument #%d : For real non symmetric problems, NCV must be less than N. \n"), "feigs", 7));\r
+    end\r
+\r
+\r
+    //*************************\r
+    //CHOL :\r
+    //*************************\r
+    if(typeof(cholB) <> "constant")\r
+        error(msprintf(gettext("%s: Wrong type for input argument #%d: opts.cholB must be a integer scalar. \n"), "feigs", 9));\r
+    end\r
+\r
+    //check if chol is complex?\r
+    if(~isreal(cholB))\r
+        error(msprintf(gettext("%s: Wrong type for input argument #%d: opts.cholB must be a integer scalar. \n"), "feigs", 9));\r
+    end\r
+\r
+    if(size(cholB,'*') <> 1 | cholB <> floor(cholB) | cholB > 1)\r
+        error(msprintf(gettext("%s: Wrong dimension for input argument #%d: opts.cholB must be between 0 and 1 . \n"), "feigs", 9));\r
+    end\r
+\r
+    //*************************\r
+    //RESID :\r
+    //*************************\r
+    if(typeof(resid) <> "constant")\r
+        error(msprintf(gettext("%s: Wrong type for input argument #%d: A real or complex matrix expected. \n"), "feigs", 10));\r
+    end\r
+\r
+    if(size(resid,'*') ~= nA)\r
+        error(msprintf(gettext("%s: Wrong dimension for input argument #%d: Start vector opts.resid must be N by 1. \n"), "feigs", 10));\r
+    end\r
+\r
+    if(a_real & Breal)\r
+        //resid complexe ?\r
+        if(~isreal(resid))\r
+            error(msprintf(gettext("%s: Wrong type for input argument #%d: Start vector opts.resid must be real for real problems. \n"), "feigs", 10));\r
+        end\r
+    else\r
+        if(isreal(resid))\r
+            error(msprintf(gettext("%s: Wrong type for input argument #%d: Start vector opts.resid must be complex for complex problems. \n"), "feigs", 10));\r
+        end\r
+    end\r
+\r
+    iparam = zeros(11,1);\r
+    iparam(1) = 1;\r
+    iparam(3) = maxiter;\r
+    iparam(7) = 1;\r
+\r
+    ipntr = zeros(14,1);\r
+\r
+    //MODE 1, 2, 3, 4, 5\r
+    if(~strcmp(which,'SM') | sigma <> 0)\r
+        iparam(7) = 3;\r
+        which = 'LM';\r
+    end\r
+\r
+    //bmat initialization\r
+    if(matB == 0 | iparam(7) == 1)\r
+        bmat = 'I';\r
+    else\r
+        bmat = 'G';\r
+    end\r
+\r
+    if(cholB)\r
+        if(~and(triu(B) == B))\r
+            error(msprintf(gettext("%s: Wrong type for input argument #%d: B must be symmmetric or hermitian, definite, semi positive. \n"), "feigs", 2));\r
+        end\r
+        R = B;\r
+        Rprime = R';\r
+    end\r
+\r
+    if(~cholB & matB <> 0 & iparam(7) == 1)\r
+        if(~Breal)\r
+            error(msprintf(gettext("%s: Impossible to use the Cholesky factorisation with complex sparses matrices. \n"), "feigs"));\r
+        else\r
+            if(issparse(B))\r
+                [R,P] = spchol(B);\r
+            else\r
+                R = chol(B);\r
+            end\r
+            Rprime = R';\r
+        end\r
+    end\r
+\r
+    //Main\r
+    howmny = 'A';\r
+    ido = 0;\r
+    info_aupd = 0;\r
+    _select = zeros(ncv,1);\r
+\r
+    if(a_real)\r
+        if(a_sym)\r
+            lworkl = ncv * ncv + 8 * ncv;\r
+            v = zeros(nA, ncv);\r
+            workl = zeros(lworkl, 1);\r
+            workd = zeros(3 * nA, 1);\r
+            d = zeros(nev, 1); \r
+            z = zeros(nA, nev); \r
+        else\r
+            lworkl = 3 * ncv * (ncv + 2);\r
+            v = zeros(nA, ncv);\r
+            workl = zeros(lworkl, 1);\r
+            workd = zeros(3 * nA, 1);\r
+            dr = zeros(nev+1, 1);\r
+            di = zeros(nev+1, 1);\r
+            z = zeros(nA, nev + 1);\r
+            workev = zeros(3 * ncv, 1);\r
+        end\r
+    else\r
+        lworkl = 3 * ncv * ncv + 5 * ncv;\r
+        v = zeros(nA, ncv) + 0 * %i;\r
+        workl = zeros(lworkl, 1) + 0 * %i;\r
+        workd = zeros(3 * nA, 1) + 0 * %i;\r
+        rwork = zeros(ncv, 1);\r
+        d = zeros(nev + 1, 1) + 0 * %i;\r
+        z = zeros(nA, nev) + 0 * %i;\r
+        workev = zeros(2 * ncv, 1) + 0 * %i; \r
+    end\r
+\r
+    while(ido <> 99)\r
+        if(a_real & Breal)\r
+            if(a_sym)\r
+                [ido, resid, v, iparam, ipntr, workd, workl, info] = dsaupd(ido, bmat, nA, which, nev, tol, resid, ncv, v, iparam, ipntr, workd, workl, info_aupd);\r
+                if(info_aupd <0)\r
+                    error(msprintf(gettext("%s: Error with DSAUPD, info = %d. \n"), "feigs", info_aupd));\r
+                end\r
+            else\r
+                [ido, resid, v, iparam, ipntr, workd, workl, info] = dnaupd(ido, bmat, nA, which, nev, tol, resid, ncv, v, iparam, ipntr, workd, workl, info_aupd);\r
+                if(info_aupd <0)\r
+                    error(msprintf(gettext("%s: Error with DNAUPD, info = %d. \n"), "feigs", info_aupd));\r
+                end\r
+            end\r
+        else\r
+            [ido, resid, v, iparam, ipntr, workd, workl, rwork, info] = znaupd(ido, bmat, nA, which, nev, tol, resid, ncv, v, iparam, ipntr, workd, workl, rwork, info_aupd);\r
+            if(info_aupd <0)\r
+                error(msprintf(gettext("%s: Error with ZNAUPD, info = %d. \n"), "feigs", info_aupd));\r
+            end\r
+        end\r
+\r
+        if(ido == -1 | ido == 1 | ido == 2)\r
+            if(iparam(7) == 1)\r
+                if(matB == 0)\r
+                    ierr = execstr('A_fun(workd(ipntr(1):ipntr(1)+nA-1))', 'errcatch');\r
+                    if(ierr <> 0)\r
+                        break;\r
+                    end\r
+                    workd(ipntr(2):ipntr(2)+nA-1) = A_fun(workd(ipntr(1):ipntr(1)+nA-1));\r
+                else\r
+                    ierr = execstr('A_fun(inv(R) * workd(ipntr(1):ipntr(1)+nA-1))', 'errcatch');\r
+                    if(ierr <> 0)\r
+                        break;\r
+                    end\r
+                    workd(ipntr(2):ipntr(2)+nA-1) = inv(Rprime) * A_fun(inv(R) * workd(ipntr(1):ipntr(1)+nA-1));\r
+                end\r
+            elseif(iparam(7) == 3)\r
+                if(matB == 0)\r
+                    if(ido == 2)\r
+                        workd(ipntr(2):ipntr(2)+nA-1) = workd(ipntr(1):ipntr(1)+nA-1);\r
+                    else\r
+                        ierr = execstr('A_fun(workd(ipntr(1):ipntr(1)+nA-1))', 'errcatch');\r
+                        if(ierr <> 0)\r
+                            break;\r
+                        end\r
+                        workd(ipntr(2):ipntr(2)+nA-1) = A_fun(workd(ipntr(1):ipntr(1)+nA-1));\r
+                    end\r
+                else\r
+                    if(ido == 2)\r
+                        if(cholB)\r
+                            workd(ipntr(2):ipntr(2)+nA-1) = Rprime * R * workd(ipntr(1):ipntr(1)+nA-1);\r
+                        else\r
+                            workd(ipntr(2):ipntr(2)+nA-1) = B * workd(ipntr(1):ipntr(1)+nA-1);\r
+                        end\r
+                    elseif(ido == -1)\r
+                        if(cholB)\r
+                            workd(ipntr(2):ipntr(2)+nA-1) = Rprime * R * workd(ipntr(1):ipntr(1)+nA-1);\r
+                        else\r
+                            workd(ipntr(2):ipntr(2)+nA-1) = B * workd(ipntr(1):ipntr(1)+nA-1);\r
+                        end\r
+                        ierr = execstr('A_fun(workd(ipntr(2):ipntr(2)+nA-1))', 'errcatch');\r
+                        if(ierr <> 0)\r
+                            break;\r
+                        end\r
+                        workd(ipntr(2):ipntr(2)+nA-1) = A_fun(workd(ipntr(2):ipntr(2)+nA-1));\r
+                    else\r
+                        ierr = execstr('A_fun(workd(ipntr(3):ipntr(3)+nA-1))', 'errcatch');\r
+                        if(ierr <> 0)\r
+                            break;\r
+                        end\r
+                        workd(ipntr(2):ipntr(2)+nA-1) = A_fun(workd(ipntr(3):ipntr(3)+nA-1));\r
+                    end\r
+                end\r
+            else\r
+                if(a_real & Breal)\r
+                    if(a_sym)\r
+                        error(msprintf(gettext("%s: Error with DSAUPD, unknown mode returned. \n"), "feigs"));\r
+                    else\r
+                        error(msprintf(gettext("%s: Error with DNAUPD, unknown mode returned. \n"), "feigs"));\r
+                    end\r
+                else\r
+                    error(msprintf(gettext("%s: Error with ZNAUPD, unknown mode returned. \n"), "feigs"));\r
+                end\r
+            end\r
+        end\r
+    end\r
+\r
+    if(ierr <> 0)\r
+        if(ierr == 10)\r
+            error(msprintf(gettext("%s: Wrong type for input argument #%d: n does not match rows number of matrix A. \n"), "feigs", 2));\r
+        end\r
+        error(msprintf(gettext("%s: Wrong type or value for input arguments. \n"), "feigs"));                            \r
+    end\r
+\r
+    if(a_real & Breal)\r
+        if(a_sym)\r
+            [d, z, resid, v, iparam, iptnr, workd, workl, info_eupd] = dseupd(rvec, howmny, _select, d, z, sigma, bmat, nA, which, nev, tol, resid, ncv, v, iparam, ipntr, workd, workl, info);\r
+            if(info <> 0)\r
+                error(msprintf(gettext("%s: Error with DSEUPD, info = %d. \n"), "feigs", info));\r
+            else\r
+                res_d = d;\r
+\r
+                if(rvec)\r
+                    res_d = diag(res_d);\r
+                    res_v = z;\r
+                end\r
+            end\r
+        else\r
+            sigmar = real(sigma);\r
+            sigmai = imag(sigma);\r
+            [dr, di, z, resid, v, iparam, ipntr, workd, workl, info_eupd] = dneupd(rvec, howmny, _select, dr, di, z, sigmar, sigmai, workev, bmat, nA, which, nev, tol, resid, ncv, v, iparam, ipntr, workd, workl, info);\r
+            if(info <> 0)\r
+                error(msprintf(gettext("%s: Error with DNEUPD, info = %d. \n"), "feigs", info));\r
+            else\r
+                res_d = complex(dr,di);\r
+                res_d(nev+1) = [];\r
+                if(rvec)\r
+                    res_d = diag(res_d)\r
+                    res_v = z;\r
+                    c1 = 1:2:nev + 1;\r
+                    c2 = 2:2:nev + 1;\r
+                    if(modulo(nev,2) == 1)\r
+                        c1($) = [];\r
+                    end\r
+                    res_v(:,[c1, c2]) = [res_v(:,c1) + res_v(:,c2) * %i res_v(:,c1) - res_v(:,c2) * %i];\r
+                    res_v(:,$) = [];\r
+                end\r
+            end\r
+        end\r
+    else\r
+        [d, z, resid, iparam, ipntr, workd, workl, rwork, info_eupd] = zneupd(rvec, howmny, _select, d, z, sigma, workev, bmat, nA, which, nev, tol, resid, ncv, v, iparam, ipntr, workd, workl, rwork, info);\r
+        if(info <> 0)\r
+            error(msprintf(gettext("%s: Error with ZNEUPD, info = %d. \n"), "feigs", info));\r
+        else\r
+            d(nev+1) = []\r
+            res_d = d;\r
+            if(rvec)\r
+                res_d = diag(d);\r
+                res_v = z;\r
+            end\r
+        end\r
+    end\r
+endfunction\r
index f6963e1..a82782c 100644 (file)
@@ -39,4 +39,5 @@
 <PRIMITIVE gatewayId="35" primitiveId="4" primitiveName="dseupd" />
 <PRIMITIVE gatewayId="35" primitiveId="5" primitiveName="dneupd" />
 <PRIMITIVE gatewayId="35" primitiveId="6" primitiveName="zneupd" />
+<PRIMITIVE gatewayId="35" primitiveId="7" primitiveName="%_eigs" />
 </GATEWAY>
\ No newline at end of file
index da10ecc..c284904 100644 (file)
@@ -26,7 +26,8 @@ static gw_generic_table Tab[] =
   {sci_znaupd,"znaupd"},
   {sci_dseupd,"dseupd"},
   {sci_dneupd,"dneupd"},
-  {sci_zneupd,"zneupd"}
+  {sci_zneupd,"zneupd"},
+  {sci_eigs,"%_eigs"}
 };
 /*--------------------------------------------------------------------------*/
 int gw_arnoldi(void)
index 4700a42..2a27db5 100644 (file)
 #include "localization.h"
 #include "Scierror.h"
 /*--------------------------------------------------------------------------*/
-extern int C2F(dnaupd)(int *ido, char *bmat, int *n, char *which, int *nev, 
-                      double *tol, double *resid, int *ncv, double *v, 
-                      int *ldv, int *iparam, int *ipntr, double *workd, 
-                      double *workl, int *lworkl, int *info, 
-                      unsigned long bmat_len, unsigned long which_len);
+extern int C2F(dnaupd)(int *ido, char *bmat, int *n, char *which, int *nev,
+                       double *tol, double *resid, int *ncv, double *v,
+                       int *ldv, int *iparam, int *ipntr, double *workd,
+                       double *workl, int *lworkl, int *info,
+                       unsigned long bmat_len, unsigned long which_len);
 /*--------------------------------------------------------------------------*/
-int sci_dnaupd(char *fname,unsigned long fname_len)
+int sci_dnaupd(char *fname, unsigned long fname_len)
 {
-  int IDO,   mIDO,   nIDO,    pIDO;
-  int mBMAT,  nBMAT,   pBMAT;
-  int mN,     nN,      pN;
-  int mWHICH, nWHICH,  pWHICH;
-  int mNEV,   nNEV,    pNEV;
-  int mTOL,   nTOL,    pTOL;
-  int RESID, mRESID, nRESID,  pRESID;
-  int mNCV,   nNCV,    pNCV;
-  int V,     mV,     nV,      pV;
-  int IPARAM,mIPARAM,nIPARAM, pIPARAM;
-  int IPNTR, mIPNTR, nIPNTR,  pIPNTR;
-  int WORKD, mWORKD, nWORKD,  pWORKD;
-  int WORKL, mWORKL, nWORKL,  pWORKL;
-  int INFO,  mINFO,  nINFO,   pINFO;
-
-  int minlhs=1, minrhs=14, maxlhs=8, maxrhs=14;
-  int LDV, LWORKL;
-  int sizeWORKL = 0;
-
-  /* [IDO,RESID,V,IPARAM,IPNTR,WORKD,WORKL,INFO]=dnaupd...
-     (ID0,BMAT,N,WHICH,NEV,TOL,RESID,NCV,V,IPARAM,IPNTR,WORKD,WORKL,INFO) */
-
-  CheckRhs(minrhs,maxrhs);  
-  CheckLhs(minlhs,maxlhs);
-
-  /*                                                  VARIABLE = NUMBER   */
-  GetRhsVar( 1,MATRIX_OF_INTEGER_DATATYPE, &mIDO,    &nIDO,    &pIDO);            IDO =  1;
-  GetRhsVar( 2,STRING_DATATYPE,            &mBMAT,   &nBMAT,   &pBMAT);
-  GetRhsVar( 3,MATRIX_OF_INTEGER_DATATYPE, &mN,      &nN,      &pN);
-  GetRhsVar( 4,STRING_DATATYPE,            &mWHICH,  &nWHICH,  &pWHICH);
-  GetRhsVar( 5,MATRIX_OF_INTEGER_DATATYPE, &mNEV,    &nNEV,    &pNEV);
-  GetRhsVar( 6,MATRIX_OF_DOUBLE_DATATYPE,  &mTOL,    &nTOL,    &pTOL);
-  GetRhsVar( 7,MATRIX_OF_DOUBLE_DATATYPE,  &mRESID,  &nRESID,  &pRESID);        RESID =  7;
-  GetRhsVar( 8,MATRIX_OF_INTEGER_DATATYPE, &mNCV,    &nNCV,    &pNCV);
-  GetRhsVar( 9,MATRIX_OF_DOUBLE_DATATYPE,  &mV,      &nV,      &pV);                V =  9;
-  GetRhsVar(10,MATRIX_OF_INTEGER_DATATYPE, &mIPARAM, &nIPARAM, &pIPARAM);      IPARAM = 10;
-  GetRhsVar(11,MATRIX_OF_INTEGER_DATATYPE, &mIPNTR,  &nIPNTR,  &pIPNTR);        IPNTR = 11;
-  GetRhsVar(12,MATRIX_OF_DOUBLE_DATATYPE,  &mWORKD,  &nWORKD,  &pWORKD);        WORKD = 12;
-  GetRhsVar(13,MATRIX_OF_DOUBLE_DATATYPE,  &mWORKL,  &nWORKL,  &pWORKL);        WORKL = 13;
-  GetRhsVar(14,MATRIX_OF_INTEGER_DATATYPE, &mINFO,   &nINFO,   &pINFO);          INFO = 14;
-
-  LWORKL = mWORKL*nWORKL;   LDV=Max(1,*istk(pN));
-
-  /* Don't call dnaupd if ido == 99 */
-  if (*istk(pIDO)==99)
+    int IDO,   mIDO,   nIDO,    pIDO;
+    int mBMAT,  nBMAT,   pBMAT;
+    int mN,     nN,      pN;
+    int mWHICH, nWHICH,  pWHICH;
+    int mNEV,   nNEV,    pNEV;
+    int mTOL,   nTOL,    pTOL;
+    int RESID, mRESID, nRESID,  pRESID;
+    int mNCV,   nNCV,    pNCV;
+    int V,     mV,     nV,      pV;
+    int IPARAM, mIPARAM, nIPARAM, pIPARAM;
+    int IPNTR, mIPNTR, nIPNTR,  pIPNTR;
+    int WORKD, mWORKD, nWORKD,  pWORKD;
+    int WORKL, mWORKL, nWORKL,  pWORKL;
+    int INFO,  mINFO,  nINFO,   pINFO;
+
+    int minlhs = 1, minrhs = 14, maxlhs = 8, maxrhs = 14;
+    int LDV, LWORKL;
+    int sizeWORKL = 0;
+
+    /* [IDO,RESID,V,IPARAM,IPNTR,WORKD,WORKL,INFO]=dnaupd...
+       (ID0,BMAT,N,WHICH,NEV,TOL,RESID,NCV,V,IPARAM,IPNTR,WORKD,WORKL,INFO) */
+
+    CheckRhs(minrhs, maxrhs);
+    CheckLhs(minlhs, maxlhs);
+
+    /*                                                  VARIABLE = NUMBER   */
+    GetRhsVar( 1, MATRIX_OF_INTEGER_DATATYPE, &mIDO,    &nIDO,    &pIDO);
+    IDO =  1;
+    GetRhsVar( 2, STRING_DATATYPE,            &mBMAT,   &nBMAT,   &pBMAT);
+    GetRhsVar( 3, MATRIX_OF_INTEGER_DATATYPE, &mN,      &nN,      &pN);
+    GetRhsVar( 4, STRING_DATATYPE,            &mWHICH,  &nWHICH,  &pWHICH);
+    GetRhsVar( 5, MATRIX_OF_INTEGER_DATATYPE, &mNEV,    &nNEV,    &pNEV);
+    GetRhsVar( 6, MATRIX_OF_DOUBLE_DATATYPE,  &mTOL,    &nTOL,    &pTOL);
+    GetRhsVar( 7, MATRIX_OF_DOUBLE_DATATYPE,  &mRESID,  &nRESID,  &pRESID);
+    RESID =  7;
+    GetRhsVar( 8, MATRIX_OF_INTEGER_DATATYPE, &mNCV,    &nNCV,    &pNCV);
+    GetRhsVar( 9, MATRIX_OF_DOUBLE_DATATYPE,  &mV,      &nV,      &pV);
+    V =  9;
+    GetRhsVar(10, MATRIX_OF_INTEGER_DATATYPE, &mIPARAM, &nIPARAM, &pIPARAM);
+    IPARAM = 10;
+    GetRhsVar(11, MATRIX_OF_INTEGER_DATATYPE, &mIPNTR,  &nIPNTR,  &pIPNTR);
+    IPNTR = 11;
+    GetRhsVar(12, MATRIX_OF_DOUBLE_DATATYPE,  &mWORKD,  &nWORKD,  &pWORKD);
+    WORKD = 12;
+    GetRhsVar(13, MATRIX_OF_DOUBLE_DATATYPE,  &mWORKL,  &nWORKL,  &pWORKL);
+    WORKL = 13;
+    GetRhsVar(14, MATRIX_OF_INTEGER_DATATYPE, &mINFO,   &nINFO,   &pINFO);
+    INFO = 14;
+
+    LWORKL = mWORKL * nWORKL;
+    LDV = Max(1, *istk(pN));
+
+    /* Don't call dnaupd if ido == 99 */
+    if (*istk(pIDO) == 99)
     {
-      Scierror(999,_("%s: the computation is already terminated\n"),fname);
-      return 0;
+        Scierror(999, _("%s: the computation is already terminated\n"), fname);
+        return 0;
     }
 
-  /* Check some sizes */
-  if (mIPARAM*nIPARAM!=11)
+    /* Check some sizes */
+    if (mIPARAM*nIPARAM != 11)
     {
-      Scierror(999,_("%s: Wrong size for input argument %s: An array of size %d expected.\n"),fname, "IPARAM", 11);
-      return 0;
+        Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "IPARAM", 11);
+        return 0;
     }
 
-  if (mIPNTR*nIPNTR!=14)
+    if (mIPNTR*nIPNTR != 14)
     {
-      Scierror(999,_("%s: Wrong size for input argument %s: An array of size %d expected.\n"),fname, "IPNTR", 14);
-      return 0;
+        Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "IPNTR", 14);
+        return 0;
     }
 
-  if (mRESID*nRESID!=*istk(pN))
+    if (mRESID*nRESID != *istk(pN))
     {
-      Scierror(999,_("%s: Wrong size for input argument %s: An array of size %d expected.\n"),fname, "RESID", *istk(pN));
-      return 0;
+        Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "RESID", *istk(pN));
+        return 0;
     }
-    
-  if ((mV!=*istk(pN))&&(nV!=*istk(pNCV)))
+
+    if ((mV != *istk(pN)) || (nV != *istk(pNCV)))
     {
-      Scierror(999,_("%s: Wrong size for input argument %s: A matrix of size %dx%d expected.\n"),fname, "V", *istk(pN),*istk(pNCV));
-      return 0;
+        Scierror(999, _("%s: Wrong size for input argument %s: A matrix of size %dx%d expected.\n"), fname, "V", *istk(pN), *istk(pNCV));
+        return 0;
     }
 
-  if (mWORKD*nWORKD<3 * *istk(pN))
+    if (mWORKD * nWORKD < 3 * *istk(pN))
     {
-      Scierror(999,_("%s: Wrong size for input argument %s: An array of size %d expected.\n"),fname, "WORKD", 3* *istk(pN));
-      return 0;
+        Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "WORKD", 3 * *istk(pN));
+        return 0;
     }
 
-  sizeWORKL = 3 * *istk(pNCV) * *istk(pNCV) + 6 * *istk(pNCV);
+    sizeWORKL = 3 * *istk(pNCV) * *istk(pNCV) + 6 * *istk(pNCV);
 
-  if (mWORKL*nWORKL<sizeWORKL)
+    if (mWORKL * nWORKL < sizeWORKL)
     {
-      Scierror(999,_("%s: Wrong size for input argument %s: An array of size %d expected.\n"),fname, "WORKL", sizeWORKL);
-      return 0;
+        Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "WORKL", sizeWORKL);
+        return 0;
     }
 
-  C2F(dnaupd)(istk(pIDO),   cstk(pBMAT),  istk(pN),
-             cstk(pWHICH), istk(pNEV),   stk(pTOL),
-               stk(pRESID), istk(pNCV),   stk(pV), &LDV,
-              istk(pIPARAM),istk(pIPNTR), stk(pWORKD),
-               stk(pWORKL), &LWORKL,      istk(pINFO), 1L, 2L);
+    C2F(dnaupd)(istk(pIDO),   cstk(pBMAT),  istk(pN),
+                cstk(pWHICH), istk(pNEV),   stk(pTOL),
+                stk(pRESID), istk(pNCV),   stk(pV), &LDV,
+                istk(pIPARAM), istk(pIPNTR), stk(pWORKD),
+                stk(pWORKL), &LWORKL,      istk(pINFO), 1L, 2L);
 
-  if (*istk(pINFO) < 0) {
-    C2F(errorinfo)("dnaupd", istk(pINFO), 6L);
-    return 0;
-  }
+    if (*istk(pINFO) < 0)
+    {
+        C2F(errorinfo)("dnaupd", istk(pINFO), 6L);
+        return 0;
+    }
 
-  LhsVar(1) = IDO;    
-  LhsVar(2) = RESID; 
-  LhsVar(3) = V;
-  LhsVar(4) = IPARAM; 
-  LhsVar(5) = IPNTR;
-  LhsVar(6) = WORKD;  
-  LhsVar(7) = WORKL; 
-  LhsVar(8) = INFO;
+    LhsVar(1) = IDO;
+    LhsVar(2) = RESID;
+    LhsVar(3) = V;
+    LhsVar(4) = IPARAM;
+    LhsVar(5) = IPNTR;
+    LhsVar(6) = WORKD;
+    LhsVar(7) = WORKL;
+    LhsVar(8) = INFO;
 
-  PutLhsVar();
+    PutLhsVar();
 
-  return 0;
+    return 0;
 }
 /*--------------------------------------------------------------------------*/
index 9b6f59c..e70dfbb 100644 (file)
 #include "localization.h"
 #include "Scierror.h"
 /*--------------------------------------------------------------------------*/
-extern int C2F(dneupd)(int *rvec, char *howmny, int *select, double *dr, 
-                      double *di, double *z, int *ldz, double *sigmar, 
-                      double *sigmai, double *workev, char *bmat, int *n, 
-                      char *which, int *nev, double *tol, double *resid, 
-                      int *ncv, double *v, int *ldv, int *iparam, int *ipntr, 
-                      double *workd, double *workl, int *lworkl, int *info);
+extern int C2F(dneupd)(int *rvec, char *howmny, int *select, double *dr,
+                       double *di, double *z, int *ldz, double *sigmar,
+                       double *sigmai, double *workev, char *bmat, int *n,
+                       char *which, int *nev, double *tol, double *resid,
+                       int *ncv, double *v, int *ldv, int *iparam, int *ipntr,
+                       double *workd, double *workl, int *lworkl, int *info);
 /*--------------------------------------------------------------------------*/
-int sci_dneupd(char *fname,unsigned long fname_len)
+int sci_dneupd(char *fname, unsigned long fname_len)
 {
-  int mRVEC,     nRVEC,      pRVEC;
-  int mHOWMANY,  nHOWMANY,   pHOWMANY;
-  int mSELECT,   nSELECT,    pSELECT;
-  int Dr,       mDr,       nDr,        pDr;
-  int Di,       mDi,       nDi,        pDi;
-  int Z,        mZ,        nZ,         pZ;
-  int mSIGMAr,   nSIGMAr,    pSIGMAr;
-  int mSIGMAi,   nSIGMAi,    pSIGMAi;
-  int mWORKev,   nWORKev,    pWORKev;
-  int mBMAT,     nBMAT,      pBMAT;
-  int mN,        nN,         pN;
-  int mWHICH,    nWHICH,     pWHICH;
-  int mNEV,      nNEV,       pNEV;
-  int mTOL,      nTOL,       pTOL;
-  int RESID,    mRESID,    nRESID,     pRESID;
-  int mNCV,      nNCV,       pNCV;
-  int V,        mV,        nV,         pV;
-  int IPARAM,   mIPARAM,   nIPARAM,    pIPARAM;
-  int IPNTR,    mIPNTR,    nIPNTR,     pIPNTR;
-  int WORKD,    mWORKD,    nWORKD,     pWORKD;
-  int WORKL,    mWORKL,    nWORKL,     pWORKL;
-  int INFO,     mINFO,     nINFO,      pINFO;
-
-  int minlhs=1, minrhs=22, maxlhs=10, maxrhs=22;
-  int LDZ, LDV, LWORKL;
-  int sizeWORKL = 0;
-
-  CheckRhs(minrhs,maxrhs);
-  CheckLhs(minlhs,maxlhs);
-
-  /*                                                  VARIABLE = NUMBER   */
-  GetRhsVar( 1,MATRIX_OF_INTEGER_DATATYPE, &mRVEC,   &nRVEC,   &pRVEC);
-  GetRhsVar( 2,STRING_DATATYPE,            &mHOWMANY,&nHOWMANY,&pHOWMANY);
-  GetRhsVar( 3,MATRIX_OF_INTEGER_DATATYPE, &mSELECT, &nSELECT, &pSELECT);
-  GetRhsVar( 4,MATRIX_OF_DOUBLE_DATATYPE,  &mDr,     &nDr,     &pDr);              Dr =  4;
-  GetRhsVar( 5,MATRIX_OF_DOUBLE_DATATYPE,  &mDi,     &nDi,     &pDi);              Di =  5;
-  GetRhsVar( 6,MATRIX_OF_DOUBLE_DATATYPE,  &mZ,      &nZ,      &pZ);                Z =  6;
-  GetRhsVar( 7,MATRIX_OF_DOUBLE_DATATYPE,  &mSIGMAr, &nSIGMAr, &pSIGMAr);
-  GetRhsVar( 8,MATRIX_OF_DOUBLE_DATATYPE,  &mSIGMAi, &nSIGMAi, &pSIGMAi);
-  GetRhsVar( 9,MATRIX_OF_DOUBLE_DATATYPE,  &mWORKev, &nWORKev, &pWORKev);
-  GetRhsVar(10,STRING_DATATYPE,            &mBMAT,   &nBMAT,   &pBMAT);
-  GetRhsVar(11,MATRIX_OF_INTEGER_DATATYPE, &mN,      &nN,      &pN);
-  GetRhsVar(12,STRING_DATATYPE,            &mWHICH,  &nWHICH,  &pWHICH);
-  GetRhsVar(13,MATRIX_OF_INTEGER_DATATYPE, &mNEV,    &nNEV,    &pNEV);
-  GetRhsVar(14,MATRIX_OF_DOUBLE_DATATYPE,  &mTOL,    &nTOL,    &pTOL);
-  GetRhsVar(15,MATRIX_OF_DOUBLE_DATATYPE,  &mRESID,  &nRESID,  &pRESID);        RESID = 15;
-  GetRhsVar(16,MATRIX_OF_INTEGER_DATATYPE, &mNCV,    &nNCV,    &pNCV);
-  GetRhsVar(17,MATRIX_OF_DOUBLE_DATATYPE,  &mV,      &nV,      &pV);                V = 17;
-  GetRhsVar(18,MATRIX_OF_INTEGER_DATATYPE, &mIPARAM, &nIPARAM, &pIPARAM);      IPARAM = 18;
-  GetRhsVar(19,MATRIX_OF_INTEGER_DATATYPE, &mIPNTR,  &nIPNTR,  &pIPNTR);        IPNTR = 19;
-  GetRhsVar(20,MATRIX_OF_DOUBLE_DATATYPE,  &mWORKD,  &nWORKD,  &pWORKD);        WORKD = 20;
-  GetRhsVar(21,MATRIX_OF_DOUBLE_DATATYPE,  &mWORKL,  &nWORKL,  &pWORKL);        WORKL = 21;
-  GetRhsVar(22,MATRIX_OF_INTEGER_DATATYPE, &mINFO,   &nINFO,   &pINFO);          INFO = 22;
-
-  LWORKL = mWORKL*nWORKL;   LDV=Max(1,*istk(pN)); LDZ=LDV;
-
-  /* Check some sizes */
-  if (mIPARAM*nIPARAM!=11)
+    int mRVEC,     nRVEC,      pRVEC;
+    int mHOWMANY,  nHOWMANY,   pHOWMANY;
+    int mSELECT,   nSELECT,    pSELECT;
+    int Dr,       mDr,       nDr,        pDr;
+    int Di,       mDi,       nDi,        pDi;
+    int Z,        mZ,        nZ,         pZ;
+    int mSIGMAr,   nSIGMAr,    pSIGMAr;
+    int mSIGMAi,   nSIGMAi,    pSIGMAi;
+    int mWORKev,   nWORKev,    pWORKev;
+    int mBMAT,     nBMAT,      pBMAT;
+    int mN,        nN,         pN;
+    int mWHICH,    nWHICH,     pWHICH;
+    int mNEV,      nNEV,       pNEV;
+    int mTOL,      nTOL,       pTOL;
+    int RESID,    mRESID,    nRESID,     pRESID;
+    int mNCV,      nNCV,       pNCV;
+    int V,        mV,        nV,         pV;
+    int IPARAM,   mIPARAM,   nIPARAM,    pIPARAM;
+    int IPNTR,    mIPNTR,    nIPNTR,     pIPNTR;
+    int WORKD,    mWORKD,    nWORKD,     pWORKD;
+    int WORKL,    mWORKL,    nWORKL,     pWORKL;
+    int INFO,     mINFO,     nINFO,      pINFO;
+
+    int minlhs = 1, minrhs = 22, maxlhs = 10, maxrhs = 22;
+    int LDZ, LDV, LWORKL;
+    int sizeWORKL = 0;
+
+    CheckRhs(minrhs, maxrhs);
+    CheckLhs(minlhs, maxlhs);
+
+    /*                                                  VARIABLE = NUMBER   */
+    GetRhsVar( 1, MATRIX_OF_INTEGER_DATATYPE, &mRVEC,   &nRVEC,   &pRVEC);
+    GetRhsVar( 2, STRING_DATATYPE,            &mHOWMANY, &nHOWMANY, &pHOWMANY);
+    GetRhsVar( 3, MATRIX_OF_INTEGER_DATATYPE, &mSELECT, &nSELECT, &pSELECT);
+    GetRhsVar( 4, MATRIX_OF_DOUBLE_DATATYPE,  &mDr,     &nDr,     &pDr);
+    Dr =  4;
+    GetRhsVar( 5, MATRIX_OF_DOUBLE_DATATYPE,  &mDi,     &nDi,     &pDi);
+    Di =  5;
+    GetRhsVar( 6, MATRIX_OF_DOUBLE_DATATYPE,  &mZ,      &nZ,      &pZ);
+    Z =  6;
+    GetRhsVar( 7, MATRIX_OF_DOUBLE_DATATYPE,  &mSIGMAr, &nSIGMAr, &pSIGMAr);
+    GetRhsVar( 8, MATRIX_OF_DOUBLE_DATATYPE,  &mSIGMAi, &nSIGMAi, &pSIGMAi);
+    GetRhsVar( 9, MATRIX_OF_DOUBLE_DATATYPE,  &mWORKev, &nWORKev, &pWORKev);
+    GetRhsVar(10, STRING_DATATYPE,            &mBMAT,   &nBMAT,   &pBMAT);
+    GetRhsVar(11, MATRIX_OF_INTEGER_DATATYPE, &mN,      &nN,      &pN);
+    GetRhsVar(12, STRING_DATATYPE,            &mWHICH,  &nWHICH,  &pWHICH);
+    GetRhsVar(13, MATRIX_OF_INTEGER_DATATYPE, &mNEV,    &nNEV,    &pNEV);
+    GetRhsVar(14, MATRIX_OF_DOUBLE_DATATYPE,  &mTOL,    &nTOL,    &pTOL);
+    GetRhsVar(15, MATRIX_OF_DOUBLE_DATATYPE,  &mRESID,  &nRESID,  &pRESID);
+    RESID = 15;
+    GetRhsVar(16, MATRIX_OF_INTEGER_DATATYPE, &mNCV,    &nNCV,    &pNCV);
+    GetRhsVar(17, MATRIX_OF_DOUBLE_DATATYPE,  &mV,      &nV,      &pV);
+    V = 17;
+    GetRhsVar(18, MATRIX_OF_INTEGER_DATATYPE, &mIPARAM, &nIPARAM, &pIPARAM);
+    IPARAM = 18;
+    GetRhsVar(19, MATRIX_OF_INTEGER_DATATYPE, &mIPNTR,  &nIPNTR,  &pIPNTR);
+    IPNTR = 19;
+    GetRhsVar(20, MATRIX_OF_DOUBLE_DATATYPE,  &mWORKD,  &nWORKD,  &pWORKD);
+    WORKD = 20;
+    GetRhsVar(21, MATRIX_OF_DOUBLE_DATATYPE,  &mWORKL,  &nWORKL,  &pWORKL);
+    WORKL = 21;
+    GetRhsVar(22, MATRIX_OF_INTEGER_DATATYPE, &mINFO,   &nINFO,   &pINFO);
+    INFO = 22;
+
+    LWORKL = mWORKL * nWORKL;
+    LDV = Max(1, *istk(pN));
+    LDZ = LDV;
+
+    /* Check some sizes */
+    if (mIPARAM*nIPARAM != 11)
     {
-      Scierror(999,_("%s: Wrong size for input argument %s: An array of size %d expected.\n"),fname, "IPARAM", 11);
-      return 0;
+        Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "IPARAM", 11);
+        return 0;
     }
 
-  if (mIPNTR*nIPNTR!=14)
+    if (mIPNTR*nIPNTR != 14)
     {
-      Scierror(999,_("%s: Wrong size for input argument %s: An array of size %d expected.\n"),fname, "IPNTR", 14);
-      return 0;
+        Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "IPNTR", 14);
+        return 0;
     }
 
-  if (mRESID*nRESID!=*istk(pN))
+    if (mRESID*nRESID != *istk(pN))
     {
-      Scierror(999,_("%s: Wrong size for input argument %s: An array of size %d expected.\n"),fname, "RESID", *istk(pN));
-      return 0;
+        Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "RESID", *istk(pN));
+        return 0;
     }
 
-  if (mWORKD*nWORKD<3 * *istk(pN))
+    if (mWORKD * nWORKD < 3 * *istk(pN))
     {
-      Scierror(999,_("%s: Wrong size for input argument %s: An array of size %d expected.\n"),fname, "WORKD", 3* *istk(pN));
-      return 0;
+        Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "WORKD", 3 * *istk(pN));
+        return 0;
     }
 
-  if (mSELECT*nSELECT!=*istk(pNCV))
+    if (mSELECT*nSELECT != *istk(pNCV))
     {
-      Scierror(999,_("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "SELECT", *istk(pNCV));
-      return 0;
+        Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "SELECT", *istk(pNCV));
+        return 0;
     }
 
-  if (mDr*nDr!=(*istk(pNEV)+1))
+    if (mDr*nDr != (*istk(pNEV) + 1))
     {
-      Scierror(999,_("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "Dr", *istk(pNEV) + 1);
-      return 0;
+        Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "Dr", *istk(pNEV) + 1);
+        return 0;
     }
 
-  if (mDi*nDi!=(*istk(pNEV)+1))
+    if (mDi*nDi != (*istk(pNEV) + 1))
     {
-      Scierror(999,_("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "Di", *istk(pNEV) + 1);
-      return 0;
+        Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "Di", *istk(pNEV) + 1);
+        return 0;
     }
 
-  if ((mZ!=*istk(pN))&&(nZ!=*istk(pNEV)+1))
+    if ((mZ != *istk(pN)) || (nZ != *istk(pNEV) + 1))
     {
-      Scierror(999,_("%s: Wrong size for input argument %s: A matrix of size %dx%d expected.\n"), fname, "Z", *istk(pN), *istk(pNEV) + 1);
-      return 0;
+        Scierror(999, _("%s: Wrong size for input argument %s: A matrix of size %dx%d expected.\n"), fname, "Z", *istk(pN), *istk(pNEV) + 1);
+        return 0;
     }
 
-  if (mWORKev*nWORKev!=3 * *istk(pNCV))
+    if (mWORKev*nWORKev != 3 * *istk(pNCV))
     {
-      Scierror(999,_("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "WORKev", 3 * *istk(pNCV));
-      return 0;
+        Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "WORKev", 3 * *istk(pNCV));
+        return 0;
     }
 
-  if ((mV!=*istk(pN))&&(mV!=*istk(pNCV)))
+    if ((mV != *istk(pN)) || (nV != *istk(pNCV)))
     {
-      Scierror(999,_("%s: Wrong size for input argument %s: A matrix of size %dx%d expected.\n"), fname, "V", *istk(pN),*istk(pNCV));
-      return 0;
+        Scierror(999, _("%s: Wrong size for input argument %s: A matrix of size %dx%d expected.\n"), fname, "V", *istk(pN), *istk(pNCV));
+        return 0;
     }
 
-  sizeWORKL = 3 * *istk(pNCV) * *istk(pNCV) + 6 * *istk(pNCV);
+    sizeWORKL = 3 * *istk(pNCV) * *istk(pNCV) + 6 * *istk(pNCV);
 
-  if ((mWORKL*nWORKL<sizeWORKL))
+    if ((mWORKL * nWORKL < sizeWORKL))
     {
-      Scierror(999,_("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "WORKL", sizeWORKL);
-      return 0;
+        Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "WORKL", sizeWORKL);
+        return 0;
     }
 
 
-  C2F(dneupd)(istk(pRVEC), cstk(pHOWMANY),  istk(pSELECT),
-             stk(pDr), stk(pDi), stk(pZ),   &LDZ,
-             stk(pSIGMAr), stk(pSIGMAi), stk(pWORKev),
-              cstk(pBMAT), istk(pN), cstk(pWHICH),
-              istk(pNEV), stk(pTOL), stk(pRESID),
-              istk(pNCV), stk(pV), &LDV,
-             istk(pIPARAM), istk(pIPNTR),
-               stk(pWORKD), stk(pWORKL), &LWORKL,
-              istk(pINFO));
+    C2F(dneupd)(istk(pRVEC), cstk(pHOWMANY),  istk(pSELECT),
+                stk(pDr), stk(pDi), stk(pZ),   &LDZ,
+                stk(pSIGMAr), stk(pSIGMAi), stk(pWORKev),
+                cstk(pBMAT), istk(pN), cstk(pWHICH),
+                istk(pNEV), stk(pTOL), stk(pRESID),
+                istk(pNCV), stk(pV), &LDV,
+                istk(pIPARAM), istk(pIPNTR),
+                stk(pWORKD), stk(pWORKL), &LWORKL,
+                istk(pINFO));
+
+    if (*istk(pINFO) < 0)
+    {
+        C2F(errorinfo)("dneupd", istk(pINFO), 6L);
+        return 0;
+    }
+
+    LhsVar(1)  = Dr;
+    LhsVar(2)  = Di;
+    LhsVar(3)  = Z;
+    LhsVar(4)  = RESID;
+    LhsVar(5)  = V;
+    LhsVar(6)  = IPARAM;
+    LhsVar(7)  = IPNTR;
+    LhsVar(8)  = WORKD;
+    LhsVar(9)  = WORKL;
+    LhsVar(10) = INFO;
+
+    PutLhsVar();
 
-  if (*istk(pINFO) < 0) {
-    C2F(errorinfo)("dneupd", istk(pINFO), 6L);
     return 0;
-  }
-
-  LhsVar(1)  = Dr;
-  LhsVar(2)  = Di;
-  LhsVar(3)  = Z;
-  LhsVar(4)  = RESID; 
-  LhsVar(5)  = V; 
-  LhsVar(6)  = IPARAM;
-  LhsVar(7)  = IPNTR;  
-  LhsVar(8)  = WORKD; 
-  LhsVar(9)  = WORKL; 
-  LhsVar(10) = INFO;
-
-  PutLhsVar();
-
-  return 0;
 }
 /*--------------------------------------------------------------------------*/
index e156426..b4b8d42 100644 (file)
 #include "localization.h"
 #include "Scierror.h"
 /*--------------------------------------------------------------------------*/
-extern int C2F(dsaupd)(int *ido, char *bmat, int *n, char *which, int *nev, 
-                      double *tol, double *resid, int *ncv, double *v, 
-                      int *ldv, int *iparam, int *ipntr, double *workd, 
-                      double *workl, int *lworkl, int *info);
+extern int C2F(dsaupd)(int *ido, char *bmat, int *n, char *which, int *nev,
+                       double *tol, double *resid, int *ncv, double *v,
+                       int *ldv, int *iparam, int *ipntr, double *workd,
+                       double *workl, int *lworkl, int *info);
 /*--------------------------------------------------------------------------*/
-int sci_dsaupd(char *fname,unsigned long fname_len)
+int sci_dsaupd(char *fname, unsigned long fname_len)
 {
-  int IDO,   mIDO,   nIDO,    pIDO;
-  int mBMAT,  nBMAT,   pBMAT;
-  int mN,     nN,      pN;
-  int mWHICH, nWHICH,  pWHICH;
-  int mNEV,   nNEV,    pNEV;
-  int mTOL,   nTOL,    pTOL;
-  int RESID, mRESID, nRESID,  pRESID;
-  int mNCV,   nNCV,    pNCV;
-  int V,     mV,     nV,      pV;
-  int IPARAM,mIPARAM,nIPARAM, pIPARAM;
-  int IPNTR, mIPNTR, nIPNTR,  pIPNTR;
-  int WORKD, mWORKD, nWORKD,  pWORKD;
-  int WORKL, mWORKL, nWORKL,  pWORKL;
-  int INFO,  mINFO,  nINFO,   pINFO;
-
-  int minlhs=1, minrhs=14, maxlhs=8, maxrhs=14;
-  int LDV, LWORKL;
-  int sizeWORKL = 0;
-
-  /* [IDO,RESID,V,IPARAM,IPNTR,WORKD,WORKL,INFO]=dsaupd...
-     (ID0,BMAT,N,WHICH,NEV,TOL,RESID,NCV,V,IPARAM,IPNTR,WORKD,WORKL,INFO) */
-
-  CheckRhs(minrhs,maxrhs);
-  CheckLhs(minlhs,maxlhs);
-
-  /*                                                  VARIABLE = NUMBER   */
-  GetRhsVar( 1,MATRIX_OF_INTEGER_DATATYPE, &mIDO,    &nIDO,    &pIDO);            IDO =  1;
-  GetRhsVar( 2,STRING_DATATYPE,            &mBMAT,   &nBMAT,   &pBMAT);
-  GetRhsVar( 3,MATRIX_OF_INTEGER_DATATYPE, &mN,      &nN,      &pN);
-  GetRhsVar( 4,STRING_DATATYPE,            &mWHICH,  &nWHICH,  &pWHICH);
-  GetRhsVar( 5,MATRIX_OF_INTEGER_DATATYPE, &mNEV,    &nNEV,    &pNEV);
-  GetRhsVar( 6,MATRIX_OF_DOUBLE_DATATYPE,  &mTOL,    &nTOL,    &pTOL);
-  GetRhsVar( 7,MATRIX_OF_DOUBLE_DATATYPE,  &mRESID,  &nRESID,  &pRESID);        RESID =  7;
-  GetRhsVar( 8,MATRIX_OF_INTEGER_DATATYPE, &mNCV,    &nNCV,    &pNCV);
-  GetRhsVar( 9,MATRIX_OF_DOUBLE_DATATYPE,  &mV,      &nV,      &pV);                V =  9;
-  GetRhsVar(10,MATRIX_OF_INTEGER_DATATYPE, &mIPARAM, &nIPARAM, &pIPARAM);      IPARAM = 10;
-  GetRhsVar(11,MATRIX_OF_INTEGER_DATATYPE, &mIPNTR,  &nIPNTR,  &pIPNTR);        IPNTR = 11;
-  GetRhsVar(12,MATRIX_OF_DOUBLE_DATATYPE,  &mWORKD,  &nWORKD,  &pWORKD);        WORKD = 12;
-  GetRhsVar(13,MATRIX_OF_DOUBLE_DATATYPE,  &mWORKL,  &nWORKL,  &pWORKL);        WORKL = 13;
-  GetRhsVar(14,MATRIX_OF_INTEGER_DATATYPE, &mINFO,   &nINFO,   &pINFO);          INFO = 14;
-
-  LWORKL = mWORKL*nWORKL;   LDV=Max(1, *istk(pN));
-
-  /* Don't call dnaupd if ido == 99 */
-  if (*istk(pIDO)==99)
+    int IDO,   mIDO,   nIDO,    pIDO;
+    int mBMAT,  nBMAT,   pBMAT;
+    int mN,     nN,      pN;
+    int mWHICH, nWHICH,  pWHICH;
+    int mNEV,   nNEV,    pNEV;
+    int mTOL,   nTOL,    pTOL;
+    int RESID, mRESID, nRESID,  pRESID;
+    int mNCV,   nNCV,    pNCV;
+    int V,     mV,     nV,      pV;
+    int IPARAM, mIPARAM, nIPARAM, pIPARAM;
+    int IPNTR, mIPNTR, nIPNTR,  pIPNTR;
+    int WORKD, mWORKD, nWORKD,  pWORKD;
+    int WORKL, mWORKL, nWORKL,  pWORKL;
+    int INFO,  mINFO,  nINFO,   pINFO;
+
+    int minlhs = 1, minrhs = 14, maxlhs = 8, maxrhs = 14;
+    int LDV, LWORKL;
+    int sizeWORKL = 0;
+
+    /* [IDO,RESID,V,IPARAM,IPNTR,WORKD,WORKL,INFO]=dsaupd...
+       (ID0,BMAT,N,WHICH,NEV,TOL,RESID,NCV,V,IPARAM,IPNTR,WORKD,WORKL,INFO) */
+
+    CheckRhs(minrhs, maxrhs);
+    CheckLhs(minlhs, maxlhs);
+
+    /*                                                  VARIABLE = NUMBER   */
+    GetRhsVar( 1, MATRIX_OF_INTEGER_DATATYPE, &mIDO,    &nIDO,    &pIDO);
+    IDO =  1;
+    GetRhsVar( 2, STRING_DATATYPE,            &mBMAT,   &nBMAT,   &pBMAT);
+    GetRhsVar( 3, MATRIX_OF_INTEGER_DATATYPE, &mN,      &nN,      &pN);
+    GetRhsVar( 4, STRING_DATATYPE,            &mWHICH,  &nWHICH,  &pWHICH);
+    GetRhsVar( 5, MATRIX_OF_INTEGER_DATATYPE, &mNEV,    &nNEV,    &pNEV);
+    GetRhsVar( 6, MATRIX_OF_DOUBLE_DATATYPE,  &mTOL,    &nTOL,    &pTOL);
+    GetRhsVar( 7, MATRIX_OF_DOUBLE_DATATYPE,  &mRESID,  &nRESID,  &pRESID);
+    RESID =  7;
+    GetRhsVar( 8, MATRIX_OF_INTEGER_DATATYPE, &mNCV,    &nNCV,    &pNCV);
+    GetRhsVar( 9, MATRIX_OF_DOUBLE_DATATYPE,  &mV,      &nV,      &pV);
+    V =  9;
+    GetRhsVar(10, MATRIX_OF_INTEGER_DATATYPE, &mIPARAM, &nIPARAM, &pIPARAM);
+    IPARAM = 10;
+    GetRhsVar(11, MATRIX_OF_INTEGER_DATATYPE, &mIPNTR,  &nIPNTR,  &pIPNTR);
+    IPNTR = 11;
+    GetRhsVar(12, MATRIX_OF_DOUBLE_DATATYPE,  &mWORKD,  &nWORKD,  &pWORKD);
+    WORKD = 12;
+    GetRhsVar(13, MATRIX_OF_DOUBLE_DATATYPE,  &mWORKL,  &nWORKL,  &pWORKL);
+    WORKL = 13;
+    GetRhsVar(14, MATRIX_OF_INTEGER_DATATYPE, &mINFO,   &nINFO,   &pINFO);
+    INFO = 14;
+
+    LWORKL = mWORKL * nWORKL;
+    LDV = Max(1, *istk(pN));
+
+    /* Don't call dnaupd if ido == 99 */
+    if (*istk(pIDO) == 99)
     {
-      Scierror(999,_("%s: Wrong size for input argument %s: An array of size %d expected.\n"),fname);
-      return 0;
+        Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname);
+        return 0;
     }
 
-  /* Check some sizes */
-  if (mIPARAM*nIPARAM!=11)
+    /* Check some sizes */
+    if (mIPARAM*nIPARAM != 11)
     {
-      Scierror(999,_("%s: Wrong size for input argument %s: An array of size %d expected.\n"),fname, "IPARAM", 11);
-      return 0;
+        Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "IPARAM", 11);
+        return 0;
     }
 
-  if (mIPNTR*nIPNTR!=14)
+    if (mIPNTR*nIPNTR != 14)
     {
-      Scierror(999,_("%s: Wrong size for input argument %s: An array of size %d expected.\n"),fname, "IPNTR", 14);
-      return 0;
+        Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "IPNTR", 14);
+        return 0;
     }
 
-  if (mRESID*nRESID!=*istk(pN))
+    if (mRESID*nRESID != *istk(pN))
     {
-      Scierror(999,_("%s: Wrong size for input argument %s: An array of size %d expected.\n"),fname, "RESID", *istk(pN));
-      return 0;
+        Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "RESID", *istk(pN));
+        return 0;
     }
-    
-  if ((mV!=*istk(pN))&&(nV!=*istk(pNCV)))
+
+    if ((mV != *istk(pN)) || (nV != *istk(pNCV)))
+    {
+        Scierror(999, _("%s: Wrong size for input argument %s: A matrix of size %dx%d expected.\n"), fname, "V", *istk(pN), *istk(pNCV));
+        return 0;
+    }
+
+    if (mWORKD * nWORKD < 3 * *istk(pN))
     {
-      Scierror(999,_("%s: Wrong size for input argument %s: A matrix of size %dx%d expected.\n"),fname, "V", *istk(pN),*istk(pNCV));
-      return 0;
+        Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "WORKD", 3 * *istk(pN));
+        return 0;
     }
 
-  if (mWORKD*nWORKD<3 * *istk(pN))
+    sizeWORKL = *istk(pNCV) * *istk(pNCV) + 8 * *istk(pNCV);
+
+    if (mWORKL * nWORKL < sizeWORKL)
     {
-      Scierror(999,_("%s: Wrong size for input argument %s: An array of size %d expected.\n"),fname, "WORKD", 3* *istk(pN));
-      return 0;
+        Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "WORKL", sizeWORKL);
+        return 0;
     }
 
-  sizeWORKL = *istk(pNCV) * *istk(pNCV) + 8 * *istk(pNCV);
+    C2F(dsaupd)(istk(pIDO), cstk(pBMAT), istk(pN),
+                cstk(pWHICH), istk(pNEV), stk(pTOL),
+                stk(pRESID), istk(pNCV), stk(pV), &LDV,
+                istk(pIPARAM), istk(pIPNTR), stk(pWORKD),
+                stk(pWORKL), &LWORKL, istk(pINFO));
 
-  if (mWORKL*nWORKL<sizeWORKL)
+    if (*istk(pINFO) < 0)
     {
-      Scierror(999,_("%s: Wrong size for input argument %s: An array of size %d expected.\n"),fname, "WORKL", sizeWORKL);
-      return 0;
+        C2F(errorinfo)("dsaupd", istk(pINFO), 6L);
+        return 0;
     }
 
-  C2F(dsaupd)(istk(pIDO), cstk(pBMAT), istk(pN),
-             cstk(pWHICH), istk(pNEV), stk(pTOL),
-              stk(pRESID), istk(pNCV), stk(pV), &LDV,
-              istk(pIPARAM), istk(pIPNTR), stk(pWORKD),
-              stk(pWORKL), &LWORKL, istk(pINFO));
+    LhsVar(1) = IDO;
+    LhsVar(2) = RESID;
+    LhsVar(3) = V;
+    LhsVar(4) = IPARAM;
+    LhsVar(5) = IPNTR;
+    LhsVar(6) = WORKD;
+    LhsVar(7) = WORKL;
+    LhsVar(8) = INFO;
+
+    PutLhsVar();
 
-  if (*istk(pINFO) < 0) {
-    C2F(errorinfo)("dsaupd", istk(pINFO), 6L);
     return 0;
-  }
-
-  LhsVar(1) = IDO;
-  LhsVar(2) = RESID;
-  LhsVar(3) = V;
-  LhsVar(4) = IPARAM;
-  LhsVar(5) = IPNTR;
-  LhsVar(6) = WORKD;
-  LhsVar(7) = WORKL;
-  LhsVar(8) = INFO;
-  
-  PutLhsVar();
-
-  return 0;
 }
 /*--------------------------------------------------------------------------*/
index 53ec378..7613bbf 100644 (file)
 #include "localization.h"
 #include "Scierror.h"
 /*--------------------------------------------------------------------------*/
-extern int C2F(dseupd)(int *rvec, char *howmny, int *select, double *d, 
-                      double *z, int *ldz, double *sigma, char *bmat, 
-                      int *n, char *which, int *nev ,double *tol, 
-                      double *resid, int *ncv, double *v ,int *ldv, 
-                      int *iparam,int *ipntr, double *workd,double *workl,
-                      int *lworkl,int *info, unsigned long rvec_length, 
-                      unsigned long howmany_length, 
-                      unsigned long bmat_length, unsigned long which_len);
+extern int C2F(dseupd)(int *rvec, char *howmny, int *select, double *d,
+                       double *z, int *ldz, double *sigma, char *bmat,
+                       int *n, char *which, int *nev , double *tol,
+                       double *resid, int *ncv, double *v , int *ldv,
+                       int *iparam, int *ipntr, double *workd, double *workl,
+                       int *lworkl, int *info, unsigned long rvec_length,
+                       unsigned long howmany_length,
+                       unsigned long bmat_length, unsigned long which_len);
 /*--------------------------------------------------------------------------*/
-int sci_dseupd(char *fname,unsigned long fname_len)
+int sci_dseupd(char *fname, unsigned long fname_len)
 {
-  int mRVEC,     nRVEC,      pRVEC;
-  int mHOWMANY,  nHOWMANY,   pHOWMANY;
-  int mSELECT,   nSELECT,    pSELECT;
-  int D,        mD,        nD,         pD;
-  int Z,        mZ,        nZ,         pZ;
-  int mSIGMA,    nSIGMA,     pSIGMA;
-  int mBMAT,     nBMAT,      pBMAT;
-  int mN,        nN,         pN;
-  int mWHICH,    nWHICH,     pWHICH;
-  int mNEV,      nNEV,       pNEV;
-  int mTOL,      nTOL,       pTOL;
-  int RESID,    mRESID,    nRESID,     pRESID;
-  int mNCV,      nNCV,       pNCV;
-  int V,        mV,        nV,         pV;
-  int IPARAM,   mIPARAM,   nIPARAM,    pIPARAM;
-  int IPNTR,    mIPNTR,    nIPNTR,     pIPNTR;
-  int WORKD,    mWORKD,    nWORKD,     pWORKD;
-  int WORKL,    mWORKL,    nWORKL,     pWORKL;
-  int INFO,     mINFO,     nINFO,      pINFO;
-
-  int minlhs=1, minrhs=19, maxlhs=9, maxrhs=19;
-  int LDZ, LDV, LWORKL;
-  int sizeWORKL = 0;
-
-  /* [D,Z,RESID,V,IPARAM,IPNTR,WORKD,WORKL,INFO]=dseupd...
-     (RVEC,HOWMANY,SELECT,D,Z,SIGMA,BMAT,N,WHICH,NEV,TOL,RESID,NCV,V,IPARAM,IPNTR,WORKD,WORKL,INFO) */
-
-  CheckRhs(minrhs,maxrhs);  
-  CheckLhs(minlhs,maxlhs);
-
-  /*                                                  VARIABLE = NUMBER   */
-  GetRhsVar( 1,MATRIX_OF_INTEGER_DATATYPE, &mRVEC,   &nRVEC,   &pRVEC);
-  GetRhsVar( 2,STRING_DATATYPE,            &mHOWMANY,&nHOWMANY,&pHOWMANY);
-  GetRhsVar( 3,MATRIX_OF_INTEGER_DATATYPE, &mSELECT, &nSELECT, &pSELECT);
-  GetRhsVar( 4,MATRIX_OF_DOUBLE_DATATYPE,  &mD,      &nD,      &pD);                D =  4;
-  GetRhsVar( 5,MATRIX_OF_DOUBLE_DATATYPE,  &mZ,      &nZ,      &pZ);                Z =  5;
-  GetRhsVar( 6,MATRIX_OF_DOUBLE_DATATYPE,  &mSIGMA,  &nSIGMA,  &pSIGMA);
-  GetRhsVar( 7,STRING_DATATYPE,            &mBMAT,   &nBMAT,   &pBMAT);
-  GetRhsVar( 8,MATRIX_OF_INTEGER_DATATYPE, &mN,      &nN,      &pN);
-  GetRhsVar( 9,STRING_DATATYPE,            &mWHICH,  &nWHICH,  &pWHICH);
-  GetRhsVar(10,MATRIX_OF_INTEGER_DATATYPE, &mNEV,    &nNEV,    &pNEV);
-  GetRhsVar(11,MATRIX_OF_DOUBLE_DATATYPE,  &mTOL,    &nTOL,    &pTOL);
-  GetRhsVar(12,MATRIX_OF_DOUBLE_DATATYPE,  &mRESID,  &nRESID,  &pRESID);        RESID = 12;
-  GetRhsVar(13,MATRIX_OF_INTEGER_DATATYPE, &mNCV,    &nNCV,    &pNCV);
-  GetRhsVar(14,MATRIX_OF_DOUBLE_DATATYPE,  &mV,      &nV,      &pV);                V = 14;
-  GetRhsVar(15,MATRIX_OF_INTEGER_DATATYPE, &mIPARAM, &nIPARAM, &pIPARAM);      IPARAM = 15;
-  GetRhsVar(16,MATRIX_OF_INTEGER_DATATYPE, &mIPNTR,  &nIPNTR,  &pIPNTR);        IPNTR = 16;
-  GetRhsVar(17,MATRIX_OF_DOUBLE_DATATYPE,  &mWORKD,  &nWORKD,  &pWORKD);        WORKD = 17;
-  GetRhsVar(18,MATRIX_OF_DOUBLE_DATATYPE,  &mWORKL,  &nWORKL,  &pWORKL);        WORKL = 18;
-  GetRhsVar(19,MATRIX_OF_INTEGER_DATATYPE, &mINFO,   &nINFO,   &pINFO);          INFO = 19;
-
-  LWORKL = mWORKL*nWORKL;   LDV=Max(1,*istk(pN)); LDZ=LDV;
-
-  /* Check some sizes */
-  if (mIPARAM*nIPARAM!=11)
+    int mRVEC,     nRVEC,      pRVEC;
+    int mHOWMANY,  nHOWMANY,   pHOWMANY;
+    int mSELECT,   nSELECT,    pSELECT;
+    int D,        mD,        nD,         pD;
+    int Z,        mZ,        nZ,         pZ;
+    int mSIGMA,    nSIGMA,     pSIGMA;
+    int mBMAT,     nBMAT,      pBMAT;
+    int mN,        nN,         pN;
+    int mWHICH,    nWHICH,     pWHICH;
+    int mNEV,      nNEV,       pNEV;
+    int mTOL,      nTOL,       pTOL;
+    int RESID,    mRESID,    nRESID,     pRESID;
+    int mNCV,      nNCV,       pNCV;
+    int V,        mV,        nV,         pV;
+    int IPARAM,   mIPARAM,   nIPARAM,    pIPARAM;
+    int IPNTR,    mIPNTR,    nIPNTR,     pIPNTR;
+    int WORKD,    mWORKD,    nWORKD,     pWORKD;
+    int WORKL,    mWORKL,    nWORKL,     pWORKL;
+    int INFO,     mINFO,     nINFO,      pINFO;
+
+    int minlhs = 1, minrhs = 19, maxlhs = 9, maxrhs = 19;
+    int LDZ, LDV, LWORKL;
+    int sizeWORKL = 0;
+
+    /* [D,Z,RESID,V,IPARAM,IPNTR,WORKD,WORKL,INFO]=dseupd...
+       (RVEC,HOWMANY,SELECT,D,Z,SIGMA,BMAT,N,WHICH,NEV,TOL,RESID,NCV,V,IPARAM,IPNTR,WORKD,WORKL,INFO) */
+
+    CheckRhs(minrhs, maxrhs);
+    CheckLhs(minlhs, maxlhs);
+
+    /*                                                  VARIABLE = NUMBER   */
+    GetRhsVar( 1, MATRIX_OF_INTEGER_DATATYPE, &mRVEC,   &nRVEC,   &pRVEC);
+    GetRhsVar( 2, STRING_DATATYPE,            &mHOWMANY, &nHOWMANY, &pHOWMANY);
+    GetRhsVar( 3, MATRIX_OF_INTEGER_DATATYPE, &mSELECT, &nSELECT, &pSELECT);
+    GetRhsVar( 4, MATRIX_OF_DOUBLE_DATATYPE,  &mD,      &nD,      &pD);
+    D =  4;
+    GetRhsVar( 5, MATRIX_OF_DOUBLE_DATATYPE,  &mZ,      &nZ,      &pZ);
+    Z =  5;
+    GetRhsVar( 6, MATRIX_OF_DOUBLE_DATATYPE,  &mSIGMA,  &nSIGMA,  &pSIGMA);
+    GetRhsVar( 7, STRING_DATATYPE,            &mBMAT,   &nBMAT,   &pBMAT);
+    GetRhsVar( 8, MATRIX_OF_INTEGER_DATATYPE, &mN,      &nN,      &pN);
+    GetRhsVar( 9, STRING_DATATYPE,            &mWHICH,  &nWHICH,  &pWHICH);
+    GetRhsVar(10, MATRIX_OF_INTEGER_DATATYPE, &mNEV,    &nNEV,    &pNEV);
+    GetRhsVar(11, MATRIX_OF_DOUBLE_DATATYPE,  &mTOL,    &nTOL,    &pTOL);
+    GetRhsVar(12, MATRIX_OF_DOUBLE_DATATYPE,  &mRESID,  &nRESID,  &pRESID);
+    RESID = 12;
+    GetRhsVar(13, MATRIX_OF_INTEGER_DATATYPE, &mNCV,    &nNCV,    &pNCV);
+    GetRhsVar(14, MATRIX_OF_DOUBLE_DATATYPE,  &mV,      &nV,      &pV);
+    V = 14;
+    GetRhsVar(15, MATRIX_OF_INTEGER_DATATYPE, &mIPARAM, &nIPARAM, &pIPARAM);
+    IPARAM = 15;
+    GetRhsVar(16, MATRIX_OF_INTEGER_DATATYPE, &mIPNTR,  &nIPNTR,  &pIPNTR);
+    IPNTR = 16;
+    GetRhsVar(17, MATRIX_OF_DOUBLE_DATATYPE,  &mWORKD,  &nWORKD,  &pWORKD);
+    WORKD = 17;
+    GetRhsVar(18, MATRIX_OF_DOUBLE_DATATYPE,  &mWORKL,  &nWORKL,  &pWORKL);
+    WORKL = 18;
+    GetRhsVar(19, MATRIX_OF_INTEGER_DATATYPE, &mINFO,   &nINFO,   &pINFO);
+    INFO = 19;
+
+    LWORKL = mWORKL * nWORKL;
+    LDV = Max(1, *istk(pN));
+    LDZ = LDV;
+
+    /* Check some sizes */
+    if (mIPARAM*nIPARAM != 11)
     {
-      Scierror(999,_("%s: Wrong size for input argument %s: An array of size %d expected.\n"),fname, "IPARAM", 11);
-      return 0;
+        Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "IPARAM", 11);
+        return 0;
     }
 
-  if (mIPNTR*nIPNTR!=14)
+    if (mIPNTR*nIPNTR != 14)
     {
-      Scierror(999,_("%s: Wrong size for input argument %s: An array of size %d expected.\n"),fname, "IPNTR", 14);
-      return 0;
+        Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "IPNTR", 14);
+        return 0;
     }
 
-  if (mRESID*nRESID!=*istk(pN))
+    if (mRESID*nRESID != *istk(pN))
     {
-      Scierror(999,_("%s: Wrong size for input argument %s: An array of size %d expected.\n"),fname, "RESID", *istk(pN));
-      return 0;
+        Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "RESID", *istk(pN));
+        return 0;
     }
 
-  if (mWORKD*nWORKD<3 * *istk(pN))
+    if (mWORKD * nWORKD < 3 * *istk(pN))
     {
-      Scierror(999,_("%s: Wrong size for input argument %s: An array of size %d expected.\n"),fname, "WORKD", 3* *istk(pN));
-      return 0;
+        Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "WORKD", 3 * *istk(pN));
+        return 0;
     }
 
-  if (mSELECT*nSELECT!=*istk(pNCV))
+    if (mSELECT*nSELECT != *istk(pNCV))
     {
-      Scierror(999,_("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "SELECT", *istk(pNCV));
-      return 0;
+        Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "SELECT", *istk(pNCV));
+        return 0;
     }
 
-  if (mD*nD!=(*istk(pNEV)+1))
+    if (mD*nD != (*istk(pNEV)))
     {
-      Scierror(999,_("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "D", *istk(pNEV) + 1);
-      return 0;
+        Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "D", *istk(pNEV));
+        return 0;
     }
 
-  if ((mZ!=*istk(pN))&&(nZ!=*istk(pNEV)+1))
+    if ((mZ != *istk(pN)) || (nZ != *istk(pNEV)))
     {
-      Scierror(999,_("%s: Wrong size for input argument %s: A matrix of size %dx%d expected.\n"), fname, "Z", *istk(pN), *istk(pNEV) + 1);
-      return 0;
+        Scierror(999, _("%s: Wrong size for input argument %s: A matrix of size %dx%d expected.\n"), fname, "Z", *istk(pN), *istk(pNEV));
+        return 0;
     }
 
-  if ((mV!=*istk(pN))&&(mV!=*istk(pNCV)))
+    if ((mV != *istk(pN)) || (nV != *istk(pNCV)))
     {
-      Scierror(999,_("%s: Wrong size for input argument %s: A matrix of size %dx%d expected.\n"), fname, "V", *istk(pN),*istk(pNCV));
-      return 0;
+        Scierror(999, _("%s: Wrong size for input argument %s: A matrix of size %dx%d expected.\n"), fname, "V", *istk(pN), *istk(pNCV));
+        return 0;
     }
 
-  sizeWORKL = *istk(pNCV) * *istk(pNCV) + 8 * *istk(pNCV);
+    sizeWORKL = *istk(pNCV) * *istk(pNCV) + 8 * *istk(pNCV);
 
-  if ((mWORKL*nWORKL<sizeWORKL))
+    if ((mWORKL * nWORKL < sizeWORKL))
     {
-      Scierror(999,_("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "WORKL", sizeWORKL);
-      return 0;
+        Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "WORKL", sizeWORKL);
+        return 0;
     }
 
-  C2F(dseupd)(istk(pRVEC), cstk(pHOWMANY),  istk(pSELECT),
-             stk(pD), stk(pZ),   &LDZ,
-             stk(pSIGMA), cstk(pBMAT), istk(pN), cstk(pWHICH),
-              istk(pNEV), stk(pTOL), stk(pRESID),
-              istk(pNCV), stk(pV), &LDV,
-             istk(pIPARAM), istk(pIPNTR),
-               stk(pWORKD), stk(pWORKL), &LWORKL,
-              istk(pINFO), 1L, 1L, 1L, 2L);
-
-  if (*istk(pINFO) < 0) {
-    C2F(errorinfo)("dseupd", istk(pINFO), 6L);
-    return 0;
-  }
+    C2F(dseupd)(istk(pRVEC), cstk(pHOWMANY),  istk(pSELECT),
+                stk(pD), stk(pZ),   &LDZ,
+                stk(pSIGMA), cstk(pBMAT), istk(pN), cstk(pWHICH),
+                istk(pNEV), stk(pTOL), stk(pRESID),
+                istk(pNCV), stk(pV), &LDV,
+                istk(pIPARAM), istk(pIPNTR),
+                stk(pWORKD), stk(pWORKL), &LWORKL,
+                istk(pINFO), 1L, 1L, 1L, 2L);
 
-  LhsVar(1) = D;
-  LhsVar(2) = Z; 
-  LhsVar(3) = RESID;
-  LhsVar(4) = V;
-  LhsVar(5) = IPARAM;
-  LhsVar(6) = IPNTR;
-  LhsVar(7) = WORKD;
-  LhsVar(8) = WORKL;
-  LhsVar(9) = INFO;
+    if (*istk(pINFO) < 0)
+    {
+        C2F(errorinfo)("dseupd", istk(pINFO), 6L);
+        return 0;
+    }
 
-  PutLhsVar();
+    LhsVar(1) = D;
+    LhsVar(2) = Z;
+    LhsVar(3) = RESID;
+    LhsVar(4) = V;
+    LhsVar(5) = IPARAM;
+    LhsVar(6) = IPNTR;
+    LhsVar(7) = WORKD;
+    LhsVar(8) = WORKL;
+    LhsVar(9) = INFO;
 
-  return 0;
+    PutLhsVar();
+
+    return 0;
 }
 /*--------------------------------------------------------------------------*/
 
diff --git a/scilab/modules/arnoldi/sci_gateway/c/sci_eigs.c b/scilab/modules/arnoldi/sci_gateway/c/sci_eigs.c
new file mode 100644 (file)
index 0000000..b99f77b
--- /dev/null
@@ -0,0 +1,716 @@
+/*
+* Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
+* Copyright (C) 2012 - Scilab Enterprises - Adeline CARNIS
+*
+* This file must be used under the terms of the CeCILL.
+* This source file is licensed as described in the file COPYING, which
+* you should have received as part of this distribution.  The terms
+* are also available at
+* http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
+*
+*/
+
+#include <math.h>
+#include <string.h>
+#include "stack-c.h"
+#include "isanan.h"
+#include "core_math.h"
+#include "gw_arnoldi.h"
+#include "localization.h"
+#include "Scierror.h"
+#include "api_scilab.h"
+#include "stdio.h"
+#include "stdlib.h"
+#include "sciprint.h"
+#include "doublecomplex.h"
+#include "MALLOC.h"
+#include "eigs.h"
+
+int sci_eigs(char *fname, unsigned long fname_len)
+{
+    int *piAddressVarOne       = NULL;
+    int iRowsOne                       = 0;
+    int iColsOne                       = 0;
+    double elemt1                      = 0;
+    double elemt2                      = 0;
+    double* Areal                      = NULL;
+    doublecomplex* Acplx       = NULL;
+    int Asym                           = 1;
+    int Acomplex                       = 0;
+    int N                                      = 0;
+
+    int *piAddressVarTwo       = NULL;
+    int iTypeVarTwo                    = 0;
+    int iRowsTwo                       = 0;
+    int iColsTwo                       = 0;
+    double* Breal                      = NULL;
+    doublecomplex* Bcplx       = NULL;
+    int Bcomplex                       = 0;
+    int matB                           = 0;
+
+    int *piAddressVarThree     = NULL;
+    double dblNEV                      = 0;
+    int iNEV                           = 0;
+
+    int *piAddressVarFour      = NULL;
+    int iTypeVarFour           = 0;
+    int iRowsFour                      = 0;
+    int iColsFour                      = 0;
+    int iLen                           = 0;
+    char* pstData                      = NULL;
+    doublecomplex* SIGMA       = NULL;
+
+    int *piAddressVarFive      = NULL;
+    double dblMAXITER          = 0;
+
+    int *piAddressVarSix       = NULL;
+    double dblTOL                      = 0;
+
+    int *piAddressVarSeven     = NULL;
+    int TypeVarSeven           = 0;
+    int RowsSeven                      = 0;
+    int ColsSeven                      = 0;
+    double* dblNCV                     = NULL;
+
+    int *piAddressVarEight     = NULL;
+    double dblCHOLB                    = 0;
+
+    int *piAddressVarNine      = NULL;
+    int iTypeVarNine           = 0;
+    int iRowsNine                      = 0;
+    int iColsNine                      = 0;
+    double* RESID                      = NULL;
+    doublecomplex* RESIDC      = NULL;
+
+    int *piAddressVarTen       = NULL;
+    int iINFO                          = 0;
+
+    // Output arguments
+    doublecomplex* eigenvalue          = NULL;
+    doublecomplex* mat_eigenvalue      = NULL;
+    doublecomplex* eigenvector         = NULL;
+    int INFO_EUPD                                      = 0;
+    int error                                          = 0;
+
+    SciErr sciErr;
+    int iErr                           = 0;
+    int i                                      = 0;
+    int j                                      = 0;
+
+    CheckRhs(1, 10);
+    CheckLhs(0, 2);
+
+    /****************************************
+    *          First variable : A              *
+    *****************************************/
+
+    sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddressVarOne);
+    if (sciErr.iErr)
+    {
+        printError(&sciErr, 0);
+        Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
+        return 0;
+    }
+
+    sciErr = getVarDimension(pvApiCtx, piAddressVarOne, &iRowsOne, &iColsOne);
+    //check if A is a square matrix
+    if (iRowsOne * iColsOne == 1 || iRowsOne != iColsOne)
+    {
+        Scierror(999, _("%s: Wrong dimension for input argument #%d: A square matrix expected.\n"), fname, 1);
+        return 0;
+    }
+
+    N = iRowsOne;
+
+    //check if A is complex
+    if (isVarComplex(pvApiCtx, piAddressVarOne))
+    {
+        sciErr = getComplexZMatrixOfDouble(pvApiCtx, piAddressVarOne, &iRowsOne, &iColsOne, &Acplx);
+        Acomplex = 1;
+    }
+    else
+    {
+        sciErr = getMatrixOfDouble(pvApiCtx, piAddressVarOne, &iRowsOne, &iColsOne, &Areal);
+
+        for (i = 0; i < iColsOne; i++)
+        {
+            for (j = 0; j < i; j++)
+            {
+                elemt1 = Areal[j + i * iColsOne];
+                elemt2 = Areal[j * iColsOne + i];
+                if (fabs(elemt1 - elemt2) > 0)
+                {
+                    Asym = 0;
+                    break;
+                }
+            }
+            if (Asym == 0)
+            {
+                break;
+            }
+        }
+    }
+
+    /****************************************
+    *          Second variable : B             *
+    *****************************************/
+    sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddressVarTwo);
+    if (sciErr.iErr)
+    {
+        printError(&sciErr, 0);
+        Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 2);
+        return 0;
+    }
+
+    sciErr = getVarType(pvApiCtx, piAddressVarTwo, &iTypeVarTwo);
+    if (sciErr.iErr || iTypeVarTwo != sci_matrix)
+    {
+        printError(&sciErr, 0);
+        Scierror(999, _("%s: Wrong type for input argument #%d: a full or sparse matrix expected\n"), fname, 2);
+        return 0;
+    }
+
+    sciErr = getVarDimension(pvApiCtx, piAddressVarTwo, &iRowsTwo, &iColsTwo);
+    if (iRowsTwo * iColsTwo == 1 || iRowsTwo != iColsTwo)
+    {
+        Scierror(999, _("%s: Wrong dimension for input argument #%d: B must be a same size as A. \n"), fname, 2);
+        return 0;
+    }
+
+    matB = iRowsTwo * iColsTwo;
+    if (isVarComplex(pvApiCtx, piAddressVarTwo))
+    {
+        sciErr = getComplexZMatrixOfDouble(pvApiCtx, piAddressVarTwo, &iRowsTwo, &iColsTwo, &Bcplx);
+        Bcomplex = 1;
+    }
+    else
+    {
+        sciErr = getMatrixOfDouble(pvApiCtx, piAddressVarTwo, &iRowsTwo, &iColsTwo, &Breal);
+    }
+
+    if (matB != 0)
+    {
+        if (Acomplex && !Bcomplex)
+        {
+            Bcplx = (doublecomplex*)malloc(N * N * sizeof(doublecomplex));
+            memset(Bcplx, 0, N * N * sizeof(doublecomplex));
+            Bcomplex = 1;
+            for (i = 0 ; i < N * N ;  i++)
+            {
+                Bcplx[i].r = Breal[i];
+            }
+        }
+        if (!Acomplex && Bcomplex)
+        {
+            Acplx = (doublecomplex*)malloc(N * N * sizeof(doublecomplex));
+            memset(Acplx, 0, N * N * sizeof(doublecomplex));
+            Acomplex = 1;
+            for (i = 0 ; i < N * N ;  i++)
+            {
+                Acplx[i].r = Areal[i];
+            }
+        }
+    }
+
+
+    /****************************************
+    *                          NEV                                     *
+    *****************************************/
+    sciErr = getVarAddressFromPosition(pvApiCtx, 3, &piAddressVarThree);
+    if (sciErr.iErr)
+    {
+        printError(&sciErr, 0);
+        Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 3);
+        return 0;
+    }
+
+    iErr = getScalarDouble(pvApiCtx, piAddressVarThree, &dblNEV);
+    if (iErr)
+    {
+        Scierror(999, _("%s: Wrong dimension for input argument #%d: A scalar expected.\n"), fname, 3);
+        return 0;
+    }
+
+    if (dblNEV != floor(dblNEV) || (dblNEV <= 0))
+    {
+        Scierror(999, _("%s: Wrong type for input argument #%d: k must be a positive integer. \n"), fname, 3);
+        return 0;
+    }
+
+    if (!finite(dblNEV))
+    {
+        Scierror(999, _("%s: Wrong type for input argument #%d: k must be int the range 1 to N. \n"), fname, 3);
+        return 0;
+    }
+
+
+    iNEV = (int)dblNEV;
+
+    /****************************************
+    *                  SIGMA AND WHICH                         *
+    *****************************************/
+    sciErr = getVarAddressFromPosition(pvApiCtx, 4, &piAddressVarFour);
+    if (sciErr.iErr)
+    {
+        printError(&sciErr, 0);
+        Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 4);
+        return 0;
+    }
+
+    sciErr = getVarType(pvApiCtx, piAddressVarFour, &iTypeVarFour);
+    if (sciErr.iErr || (iTypeVarFour != sci_matrix && iTypeVarFour != sci_strings))
+    {
+        Scierror(999, _("%s: Wrong type for input argument #%d : a scalar expected \n"), fname, 4);
+        return 0;
+    }
+
+    if (iTypeVarFour == sci_strings)
+    {
+        int iErr = getAllocatedSingleString(pvApiCtx, piAddressVarFour, &pstData);
+        if (iErr)
+        {
+            return 0;
+        }
+
+        if (strcmp(pstData, "LM") != 0 && strcmp(pstData, "SM") != 0  && strcmp(pstData, "LR") != 0 && strcmp(pstData, "SR") != 0 && strcmp(pstData, "LI") != 0
+                && strcmp(pstData, "SI") != 0 && strcmp(pstData, "LA") != 0 && strcmp(pstData, "SA") != 0 && strcmp(pstData, "BE") != 0)
+        {
+            if (!Acomplex && Asym)
+            {
+                Scierror(999, _("%s: Wrong input argument #%d : Unrecognized sigma value.\n Sigma must be one of 'LM', 'SM','LA', 'SA' or 'BE'. \n" ), fname, 4);
+                return 0;
+            }
+            else
+            {
+                Scierror(999, _("%s: Wrong input argument #%d : Unrecognized sigma value.\n Sigma must be one of 'LM', 'SM','LR', 'SR', 'LI' or 'SI'.\n " ), fname, 4);
+                return 0;
+            }
+        }
+
+        if ((Acomplex || !Asym) && (strcmp(pstData, "LA") == 0 || strcmp(pstData, "SA") == 0 || strcmp(pstData, "BE") == 0))
+        {
+            Scierror(999, _("%s: Invalid sigma value for complex or non symmetric problem.\n"), fname, 4);
+            return 0;
+        }
+
+        if (!Acomplex && Asym && (strcmp(pstData, "LR") == 0 || strcmp(pstData, "SR") == 0 || strcmp(pstData, "LI") == 0 || strcmp(pstData, "SI") == 0))
+        {
+            Scierror(999, _("%s: Invalid sigma value for real symmetric problem.\n"), fname, 4);
+            return 0;
+        }
+
+        SIGMA = (doublecomplex*)malloc(1 * sizeof(doublecomplex));
+        SIGMA[0].r = 0;
+        SIGMA[0].i = 0;
+    }
+
+    if (iTypeVarFour == sci_matrix)
+    {
+        sciErr = getVarDimension(pvApiCtx, piAddressVarFour, &iRowsFour, &iColsFour);
+        if (iRowsFour * iColsFour != 1)
+        {
+            Scierror(999, _("%s: Wrong type for input argument #%d: a scalar expected. \n"), fname, 4);
+            return 0;
+        }
+
+        SIGMA = (doublecomplex*)malloc(1 * sizeof(doublecomplex));
+        sciErr = getComplexZMatrixOfDouble(pvApiCtx, piAddressVarFour, &iRowsFour, &iColsFour, &SIGMA);
+        if (sciErr.iErr)
+        {
+            printError(&sciErr, 0);
+            Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 4);
+            return 0;
+        }
+
+        if (C2F(isanan)(&SIGMA[0].r) || C2F(isanan)(&SIGMA[0].i))
+        {
+            Scierror(999, _("%s: Wrong type for input argument #%d: sigma must be a real. \n"), fname, 4);
+            return 0;
+        }
+
+        pstData = "LM";
+    }
+
+    /****************************************
+    *                          MAXITER                                 *
+    *****************************************/
+    sciErr = getVarAddressFromPosition(pvApiCtx, 5, &piAddressVarFive);
+    if (sciErr.iErr)
+    {
+        printError(&sciErr, 0);
+        Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 5);
+        return 0;
+    }
+
+    iErr = getScalarDouble(pvApiCtx, piAddressVarFive, &dblMAXITER);
+    if (iErr)
+    {
+        Scierror(999, _("%s: Wrong dimension for input argument #%d: opts.maxiter must be a scalar.\n"), fname, 5);
+        return 0;
+    }
+
+    if ((dblMAXITER != floor(dblMAXITER)) || (dblMAXITER <= 0))
+    {
+        Scierror(999, _("%s: Wrong type for input argument #%d: opts.maxiter must be an integer positive value.\n"), fname, 5);
+        return 0;
+    }
+
+    /****************************************
+    *                                  TOL                             *
+    *****************************************/
+    sciErr = getVarAddressFromPosition(pvApiCtx, 6, &piAddressVarSix);
+    if (sciErr.iErr)
+    {
+        printError(&sciErr, 0);
+        Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 6);
+        return 0;
+    }
+
+    iErr = getScalarDouble(pvApiCtx, piAddressVarSix, &dblTOL);
+    if (iErr)
+    {
+        Scierror(999, _("%s: Wrong dimension for input argument #%d: opts.tol must be a real scalar.\n"), fname, 6);
+        return 0;
+    }
+
+    if (C2F(isanan)(&dblTOL))
+    {
+        Scierror(999, _("%s: Wrong type for input argument #%d: opts.tol must be a real scalar.\n"), fname, 6);
+        return 0;
+    }
+
+    /****************************************
+    *                                  NCV                             *
+    *****************************************/
+    sciErr = getVarAddressFromPosition(pvApiCtx, 7, &piAddressVarSeven);
+    if (sciErr.iErr)
+    {
+        printError(&sciErr, 0);
+        Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 7);
+        return 0;
+    }
+
+    sciErr = getVarType(pvApiCtx, piAddressVarSeven, &TypeVarSeven);
+    if (sciErr.iErr || TypeVarSeven != sci_matrix)
+    {
+        printError(&sciErr, 0);
+        Scierror(999, _("%s: Wrong type for input argument #%d: opts.nev must be a integer scalar..\n"), fname, 7);
+        return 0;
+    }
+    else
+    {
+        if (isVarComplex(pvApiCtx, piAddressVarSeven))
+        {
+            Scierror(999, _("%s: Wrong type for input argument #%d: opts.nev must be a integer scalar.\n"), fname, 7);
+            0;
+        }
+        else
+        {
+            sciErr = getVarDimension(pvApiCtx, piAddressVarSeven, &RowsSeven, &ColsSeven);
+            if (RowsSeven * ColsSeven > 1)
+            {
+                Scierror(999, _("%s: Wrong type for input argument #%d: opts.nev must be a integer scalar.\n"), fname, 7);
+                return 0;
+            }
+
+            if (RowsSeven * ColsSeven == 1)
+            {
+                sciErr = getMatrixOfDouble(pvApiCtx, piAddressVarSeven, &RowsSeven, &ColsSeven, &dblNCV);
+                if (sciErr.iErr)
+                {
+                    printError(&sciErr, 0);
+                    Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 7);
+                    return 0;
+                }
+
+                if (dblNCV[0] != floor(dblNCV[0]))
+                {
+                    Scierror(999, _("%s: Wrong type for input argument #%d: opts.nev must be a integer scalar.\n"), fname, 7);
+                    return 0;
+                }
+            }
+        }
+    }
+
+    /****************************************
+    *                          CHOLB                           *
+    *****************************************/
+    sciErr = getVarAddressFromPosition(pvApiCtx, 8, &piAddressVarEight);
+    if (sciErr.iErr)
+    {
+        printError(&sciErr, 0);
+        Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 8);
+        return 0;
+    }
+
+    iErr = getScalarDouble(pvApiCtx, piAddressVarEight, &dblCHOLB);
+    if (iErr)
+    {
+        Scierror(999, _("%s: Wrong dimension for input argument #%d: opts.cholB must be a integer scalar.\n"), fname, 8);
+        return 0;
+    }
+
+    if (dblCHOLB != floor(dblCHOLB) || dblCHOLB > 1)
+    {
+        Scierror(999, _("%s: Wrong type for input argument #%d: opts.cholB must be between 0 and 1.\n"), fname, 8);
+        return 0;
+    }
+
+    /****************************************
+    *                          RESID                           *
+    *****************************************/
+    sciErr = getVarAddressFromPosition(pvApiCtx, 9, &piAddressVarNine);
+    if (sciErr.iErr)
+    {
+        printError(&sciErr, 0);
+        Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 9);
+        return 0;
+    }
+
+    sciErr = getVarType(pvApiCtx, piAddressVarNine, &iTypeVarNine);
+    if (sciErr.iErr || iTypeVarNine != sci_matrix)
+    {
+        printError(&sciErr, 0);
+        Scierror(999, _("%s: Wrong type for input argument #%d: A matrix expected.\n"), fname, 9);
+        return 0;
+    }
+    else
+    {
+        sciErr = getVarDimension(pvApiCtx, piAddressVarNine, &iRowsNine, &iColsNine);
+        if (iRowsNine*iColsNine == 1 || iRowsNine*iColsNine != N)
+        {
+            Scierror(999, _("%s: Wrong type for input argument #%d: Start vector opts.resid must be N by 1.\n"), fname, 9);
+            return 0;
+        }
+    }
+
+    if (!Acomplex && !Bcomplex)
+    {
+        if (isVarComplex(pvApiCtx, piAddressVarNine))
+        {
+            Scierror(999, _("%s: Wrong type for input argument #%d: Start vector opts.resid must be real for real problems.\n"), fname, 9);
+            return 0;
+        }
+        else
+        {
+            sciErr = getMatrixOfDouble(pvApiCtx, piAddressVarNine, &iRowsNine, &iColsNine, &RESID);
+            if (sciErr.iErr)
+            {
+                printError(&sciErr, 0);
+                Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 9);
+                return 0;
+            }
+        }
+    }
+    else
+    {
+        sciErr = getComplexZMatrixOfDouble(pvApiCtx, piAddressVarNine, &iRowsNine, &iColsNine, &RESIDC);
+        if (sciErr.iErr)
+        {
+            printError(&sciErr, 0);
+            Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 9);
+            return 0;
+        }
+    }
+
+    /****************************************
+    *                          INFO                            *
+    *****************************************/
+    sciErr = getVarAddressFromPosition(pvApiCtx, 10, &piAddressVarTen);
+    if (sciErr.iErr)
+    {
+        printError(&sciErr, 0);
+        Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 9);
+        return 0;
+    }
+
+    iErr = getScalarInteger32(pvApiCtx, piAddressVarTen, &iINFO);
+    if (iErr)
+    {
+        Scierror(999, _("%s: Wrong dimension for input argument #%d: an integer expected.\n"), fname, 1);
+        return 0;
+    }
+
+    // Initialization output arguments
+    eigenvalue = (doublecomplex*) malloc((iNEV + 1) * sizeof(doublecomplex));
+    memset(eigenvalue, 0, (iNEV + 1) * sizeof(doublecomplex));
+
+    if (Lhs > 1)
+    {
+        mat_eigenvalue = (doublecomplex*) malloc((iNEV + 1) * (iNEV + 1) * sizeof(doublecomplex));
+        memset(mat_eigenvalue, 0, (iNEV + 1) * (iNEV + 1) * sizeof(doublecomplex));
+
+        eigenvector = (doublecomplex*) malloc(N * (iNEV + 1) * sizeof(doublecomplex));
+        memset(eigenvector, 0, N * (iNEV + 1) * sizeof(doublecomplex));
+    }
+
+    error = eigs(Areal, Acplx, N, Acomplex, Asym, Breal, Bcplx, Bcomplex, matB, iNEV, SIGMA, pstData, &dblMAXITER,
+                 &dblTOL, dblNCV, RESID, RESIDC, &iINFO, &dblCHOLB, INFO_EUPD, eigenvalue, eigenvector);
+
+    switch (error)
+    {
+        case -1 :
+            if (Asym && !Acomplex && !Bcomplex)
+            {
+                Scierror(999, _("%s: Wrong dimension for input argument #%d: For real symmetric problems, NCV must be k < NCV <= N.\n"), fname, 7);
+            }
+            else
+            {
+                if (!Asym && !Acomplex && !Bcomplex)
+                {
+                    Scierror(999, _("%s: Wrong dimension for input argument #%d: For real non symmetric problems, NCV must be k + 2 < NCV <= N. \n"), fname, 7);
+                }
+                else
+                {
+                    Scierror(999, _("%s: Wrong dimension for input argument #%d: For complex problems, NCV must be k + 1 < NCV <= N. \n"), fname, 7);
+                }
+            }
+            PutLhsVar();
+            return 0;
+
+        case -2 :
+            if (Asym && !Acomplex && !Bcomplex)
+            {
+                Scierror(999, _("%s: Wrong dimension for input argument #%d: For real symmetric problems, k must be in the range 1 to N - 1.\n"), fname, 3);
+            }
+            else
+            {
+                Scierror(999, _("%s: Wrong dimension for input argument #%d: For real non symmetric or complex problems, k must be in the range 1 to N - 2. \n"), fname, 3);
+            }
+            PutLhsVar();
+            return 0;
+
+        case -3 :
+            Scierror(999, _("%s: Wrong type for input argument(s) #%d: B must be symmmetric or hemitian, definite, semi positive. \n"), fname, 2);
+            PutLhsVar();
+            return 0;
+
+        case -4 :
+            if (!Acomplex && !Bcomplex)
+            {
+                if (Asym)
+                {
+                    Scierror(999, _("%s: Error with DSAUPD, info = %d \n"), fname, iINFO);
+                }
+                else
+                {
+                    Scierror(999, _("%s: Error with DNAUPD, info = %d \n"), fname, iINFO);
+                }
+            }
+            else
+            {
+                Scierror(999, _("%s: Error with ZNAUPD, info = %d \n"), fname, iINFO);
+            }
+            PutLhsVar();
+            return 0;
+
+        case -5 :
+            if (!Acomplex && !Bcomplex)
+            {
+                if (Asym)
+                {
+                    Scierror(999, _("%s: Error with DSAUPD : unknown mode returned.\n"), fname);
+                }
+                else
+                {
+                    Scierror(999, _("%s: Error with DNAUPD: unknown mode returned.\n"), fname);
+                }
+            }
+            else
+            {
+                Scierror(999, _("%s: Error with ZNAUPD: unknown mode returned. \n"), fname);
+            }
+            PutLhsVar();
+            return 0;
+
+        case -6 :
+            if (!Acomplex && !Bcomplex)
+            {
+                if (Asym)
+                {
+                    Scierror(999, _("%s: Error with DSEUPD, info = %d \n"), fname, INFO_EUPD);
+                }
+                else
+                {
+                    Scierror(999, _("%s: Error with DNEUPD, info = %d \n"), fname, INFO_EUPD);
+                }
+            }
+            else
+            {
+                Scierror(999, _("%s: Error with ZNEUPD, info = %d \n"), fname, INFO_EUPD);
+            }
+            PutLhsVar();
+            return 0;
+    }
+
+    if (Lhs <= 1)
+    {
+        sciErr = createComplexZMatrixOfDouble(pvApiCtx, Rhs + 1, iNEV, 1, eigenvalue);
+        if (sciErr.iErr)
+        {
+            printError(&sciErr, 0);
+            Scierror(999, _("%s: Memory allocation error.\n"), fname);
+            return 0;
+        }
+
+        LhsVar(1) = Rhs + 1;
+    }
+    else
+    {
+        // create a matrix which contains the eigenvalues
+        for (i = 0; i < iNEV ; i++)
+        {
+            mat_eigenvalue[i * iNEV + i].r = eigenvalue[i].r;
+            mat_eigenvalue[i * iNEV + i].i = eigenvalue[i].i;
+        }
+
+        sciErr = createComplexZMatrixOfDouble(pvApiCtx, Rhs + 1, iNEV, iNEV, mat_eigenvalue);
+        if (sciErr.iErr)
+        {
+            printError(&sciErr, 0);
+            Scierror(999, _("%s: Memory allocation error.\n"), fname);
+            return 0;
+        }
+
+        sciErr = createComplexZMatrixOfDouble(pvApiCtx, Rhs + 2, N, iNEV, eigenvector);
+        if (sciErr.iErr)
+        {
+            printError(&sciErr, 0);
+            Scierror(999, _("%s: Memory allocation error.\n"), fname);
+            return 0;
+        }
+
+        LhsVar(1) = Rhs + 1;
+        LhsVar(2) = Rhs + 2;
+    }
+
+    if (iTypeVarFour == sci_strings)
+    {
+        freeAllocatedSingleString(pstData);
+    }
+
+    free(SIGMA);
+
+    free(eigenvalue);
+
+    if (matB != 0)
+    {
+        if (Acomplex && !Bcomplex)
+        {
+            free(Bcplx);
+        }
+        if (!Acomplex && Bcomplex)
+        {
+            free(Acplx);
+        }
+    }
+
+    if (Lhs > 1)
+    {
+        free(mat_eigenvalue);
+        free(eigenvector);
+    }
+    PutLhsVar();
+    return 0;
+}
+
index 254b5a1..93ac3e0 100644 (file)
 #include "localization.h"
 #include "Scierror.h"
 /*--------------------------------------------------------------------------*/
-extern int C2F(znaupd)(int * ido, char * bmat, int * n, char * which, 
-                      int * nev, double * tol, doublecomplex * resid, 
-                      int * ncv, doublecomplex * v, int * ldv, int * iparam,
-                      int * ipntr, doublecomplex * workd, 
-                      doublecomplex * workl, int * lworkl, double * rwork, 
-                      int * info);
+extern int C2F(znaupd)(int * ido, char * bmat, int * n, char * which,
+                       int * nev, double * tol, doublecomplex * resid,
+                       int * ncv, doublecomplex * v, int * ldv, int * iparam,
+                       int * ipntr, doublecomplex * workd,
+                       doublecomplex * workl, int * lworkl, double * rwork,
+                       int * info);
 /*--------------------------------------------------------------------------*/
-int sci_znaupd(char *fname,unsigned long fname_len)
+int sci_znaupd(char *fname, unsigned long fname_len)
 {
-  int IDO,   mIDO,   nIDO,    pIDO;
-  int mBMAT,  nBMAT,   pBMAT;
-  int mN,     nN,      pN;
-  int mWHICH, nWHICH,  pWHICH;
-  int mNEV,   nNEV,    pNEV;
-  int mTOL,   nTOL,    pTOL;
-  int RESID, mRESID, nRESID,  pRESID;
-  int mNCV,   nNCV,    pNCV;
-  int V,     mV,     nV,      pV;
-  int IPARAM,mIPARAM,nIPARAM, pIPARAM;
-  int IPNTR, mIPNTR, nIPNTR,  pIPNTR;
-  int WORKD, mWORKD, nWORKD,  pWORKD;
-  int WORKL, mWORKL, nWORKL,  pWORKL;
-  int RWORK, mRWORK, nRWORK,  pRWORK;
-  int INFO,  mINFO,  nINFO,   pINFO;
-
-  int minlhs=1, minrhs=15, maxlhs=9, maxrhs=15;
-  int LDV, LWORKL;
-  int sizeWORKL = 0;
-
-  CheckRhs(minrhs,maxrhs);  
-  CheckLhs(minlhs,maxlhs);
-
-  /*                                                  VARIABLE = NUMBER   */
-  GetRhsVar( 1,MATRIX_OF_INTEGER_DATATYPE, &mIDO,    &nIDO,    &pIDO);            IDO =  1;
-  GetRhsVar( 2,STRING_DATATYPE,            &mBMAT,   &nBMAT,   &pBMAT);
-  GetRhsVar( 3,MATRIX_OF_INTEGER_DATATYPE, &mN,      &nN,      &pN);
-  GetRhsVar( 4,STRING_DATATYPE,            &mWHICH,  &nWHICH,  &pWHICH);
-  GetRhsVar( 5,MATRIX_OF_INTEGER_DATATYPE, &mNEV,    &nNEV,    &pNEV);
-  GetRhsVar( 6,MATRIX_OF_DOUBLE_DATATYPE,  &mTOL,    &nTOL,    &pTOL);
-  GetRhsVar( 7,MATRIX_OF_COMPLEX_DATATYPE, &mRESID,  &nRESID,  &pRESID);        RESID =  7;
-  GetRhsVar( 8,MATRIX_OF_INTEGER_DATATYPE, &mNCV,    &nNCV,    &pNCV);
-  GetRhsVar( 9,MATRIX_OF_COMPLEX_DATATYPE, &mV,      &nV,      &pV);                V =  9;
-  GetRhsVar(10,MATRIX_OF_INTEGER_DATATYPE, &mIPARAM, &nIPARAM, &pIPARAM);      IPARAM = 10;
-  GetRhsVar(11,MATRIX_OF_INTEGER_DATATYPE, &mIPNTR,  &nIPNTR,  &pIPNTR);        IPNTR = 11;
-  GetRhsVar(12,MATRIX_OF_COMPLEX_DATATYPE, &mWORKD,  &nWORKD,  &pWORKD);        WORKD = 12;
-  GetRhsVar(13,MATRIX_OF_COMPLEX_DATATYPE, &mWORKL,  &nWORKL,  &pWORKL);        WORKL = 13;
-  GetRhsVar(14,MATRIX_OF_DOUBLE_DATATYPE,  &mRWORK,  &nRWORK,  &pRWORK);        RWORK = 14;
-  GetRhsVar(15,MATRIX_OF_INTEGER_DATATYPE, &mINFO,   &nINFO,   &pINFO);          INFO = 15;
-
-  LWORKL = mWORKL*nWORKL;   LDV=Max(1,*istk(pN));
-
-  /* Don't call dnaupd if ido == 99 */
-  if (*istk(pIDO)==99)
+    int IDO,   mIDO,   nIDO,    pIDO;
+    int mBMAT,  nBMAT,   pBMAT;
+    int mN,     nN,      pN;
+    int mWHICH, nWHICH,  pWHICH;
+    int mNEV,   nNEV,    pNEV;
+    int mTOL,   nTOL,    pTOL;
+    int RESID, mRESID, nRESID,  pRESID;
+    int mNCV,   nNCV,    pNCV;
+    int V,     mV,     nV,      pV;
+    int IPARAM, mIPARAM, nIPARAM, pIPARAM;
+    int IPNTR, mIPNTR, nIPNTR,  pIPNTR;
+    int WORKD, mWORKD, nWORKD,  pWORKD;
+    int WORKL, mWORKL, nWORKL,  pWORKL;
+    int RWORK, mRWORK, nRWORK,  pRWORK;
+    int INFO,  mINFO,  nINFO,   pINFO;
+
+    int minlhs = 1, minrhs = 15, maxlhs = 9, maxrhs = 15;
+    int LDV, LWORKL;
+    int sizeWORKL = 0;
+
+    CheckRhs(minrhs, maxrhs);
+    CheckLhs(minlhs, maxlhs);
+
+    /*                                                  VARIABLE = NUMBER   */
+    GetRhsVar( 1, MATRIX_OF_INTEGER_DATATYPE, &mIDO,    &nIDO,    &pIDO);
+    IDO =  1;
+    GetRhsVar( 2, STRING_DATATYPE,            &mBMAT,   &nBMAT,   &pBMAT);
+    GetRhsVar( 3, MATRIX_OF_INTEGER_DATATYPE, &mN,      &nN,      &pN);
+    GetRhsVar( 4, STRING_DATATYPE,            &mWHICH,  &nWHICH,  &pWHICH);
+    GetRhsVar( 5, MATRIX_OF_INTEGER_DATATYPE, &mNEV,    &nNEV,    &pNEV);
+    GetRhsVar( 6, MATRIX_OF_DOUBLE_DATATYPE,  &mTOL,    &nTOL,    &pTOL);
+    GetRhsVar( 7, MATRIX_OF_COMPLEX_DATATYPE, &mRESID,  &nRESID,  &pRESID);
+    RESID =  7;
+    GetRhsVar( 8, MATRIX_OF_INTEGER_DATATYPE, &mNCV,    &nNCV,    &pNCV);
+    GetRhsVar( 9, MATRIX_OF_COMPLEX_DATATYPE, &mV,      &nV,      &pV);
+    V =  9;
+    GetRhsVar(10, MATRIX_OF_INTEGER_DATATYPE, &mIPARAM, &nIPARAM, &pIPARAM);
+    IPARAM = 10;
+    GetRhsVar(11, MATRIX_OF_INTEGER_DATATYPE, &mIPNTR,  &nIPNTR,  &pIPNTR);
+    IPNTR = 11;
+    GetRhsVar(12, MATRIX_OF_COMPLEX_DATATYPE, &mWORKD,  &nWORKD,  &pWORKD);
+    WORKD = 12;
+    GetRhsVar(13, MATRIX_OF_COMPLEX_DATATYPE, &mWORKL,  &nWORKL,  &pWORKL);
+    WORKL = 13;
+    GetRhsVar(14, MATRIX_OF_DOUBLE_DATATYPE,  &mRWORK,  &nRWORK,  &pRWORK);
+    RWORK = 14;
+    GetRhsVar(15, MATRIX_OF_INTEGER_DATATYPE, &mINFO,   &nINFO,   &pINFO);
+    INFO = 15;
+
+    LWORKL = mWORKL * nWORKL;
+    LDV = Max(1, *istk(pN));
+
+    /* Don't call dnaupd if ido == 99 */
+    if (*istk(pIDO) == 99)
     {
-      Scierror(999,_("%s: the computation is already terminated\n"),fname);
-      return 0;
+        Scierror(999, _("%s: the computation is already terminated\n"), fname);
+        return 0;
     }
 
-  /* Check some sizes */
-  if (mIPARAM*nIPARAM!=11)
+    /* Check some sizes */
+    if (mIPARAM*nIPARAM != 11)
     {
-      Scierror(999,_("%s: Wrong size for input argument %s: An array of size %d expected.\n"),fname, "IPARAM", 11);
-      return 0;
+        Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "IPARAM", 11);
+        return 0;
     }
 
-  if (mIPNTR*nIPNTR!=14)
+    if (mIPNTR*nIPNTR != 14)
     {
-      Scierror(999,_("%s: Wrong size for input argument %s: An array of size %d expected.\n"),fname, "IPNTR", 14);
-      return 0;
+        Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "IPNTR", 14);
+        return 0;
     }
 
-  if (mRESID*nRESID!=*istk(pN))
+    if (mRESID*nRESID != *istk(pN))
     {
-      Scierror(999,_("%s: Wrong size for input argument %s: An array of size %d expected.\n"),fname, "RESID", *istk(pN));
-      return 0;
+        Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "RESID", *istk(pN));
+        return 0;
     }
-    
-  if ((mV!=*istk(pN))&&(nV!=*istk(pNCV)))
+
+    if ((mV != *istk(pN)) || (nV != *istk(pNCV)))
     {
-      Scierror(999,_("%s: Wrong size for input argument %s: A matrix of size %dx%d expected.\n"),fname, "V", *istk(pN),*istk(pNCV));
-      return 0;
+        Scierror(999, _("%s: Wrong size for input argument %s: A matrix of size %dx%d expected.\n"), fname, "V", *istk(pN), *istk(pNCV));
+        return 0;
     }
 
-  if (mWORKD*nWORKD<3 * *istk(pN))
+    if (mWORKD * nWORKD < 3 * *istk(pN))
     {
-      Scierror(999,_("%s: Wrong size for input argument %s: An array of size %d expected.\n"),fname, "WORKD", 3* *istk(pN));
-      return 0;
+        Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "WORKD", 3 * *istk(pN));
+        return 0;
     }
 
-  sizeWORKL = 3 * *istk(pNCV) * *istk(pNCV) + 5 * *istk(pNCV);
+    sizeWORKL = 3 * *istk(pNCV) * *istk(pNCV) + 5 * *istk(pNCV);
 
-  if (mWORKL*nWORKL<sizeWORKL)
+    if (mWORKL * nWORKL < sizeWORKL)
     {
-      Scierror(999,_("%s: Wrong size for input argument %s: An array of size %d expected.\n"),fname, "WORKL", sizeWORKL);
-      return 0;
+        Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "WORKL", sizeWORKL);
+        return 0;
     }
 
-  C2F(znaupd)(istk(pIDO), cstk(pBMAT), istk(pN),
-             cstk(pWHICH), istk(pNEV), stk(pTOL),
-              zstk(pRESID), istk(pNCV), zstk(pV), &LDV,
-              istk(pIPARAM), istk(pIPNTR), zstk(pWORKD),
-              zstk(pWORKL), &LWORKL, stk(pRWORK), istk(pINFO));
+    C2F(znaupd)(istk(pIDO), cstk(pBMAT), istk(pN),
+                cstk(pWHICH), istk(pNEV), stk(pTOL),
+                zstk(pRESID), istk(pNCV), zstk(pV), &LDV,
+                istk(pIPARAM), istk(pIPNTR), zstk(pWORKD),
+                zstk(pWORKL), &LWORKL, stk(pRWORK), istk(pINFO));
 
-  if (*istk(pINFO) < 0) {
-    C2F(errorinfo)("znaupd", istk(pINFO), 6L);
-    return 0;
-  }
+    if (*istk(pINFO) < 0)
+    {
+        C2F(errorinfo)("znaupd", istk(pINFO), 6L);
+        return 0;
+    }
 
-  LhsVar(1) = IDO;    
-  LhsVar(2) = RESID; 
-  LhsVar(3) = V;
-  LhsVar(4) = IPARAM; 
-  LhsVar(5) = IPNTR;
-  LhsVar(6) = WORKD;  
-  LhsVar(7) = WORKL; 
-  LhsVar(8) = RWORK; 
-  LhsVar(9) = INFO;
+    LhsVar(1) = IDO;
+    LhsVar(2) = RESID;
+    LhsVar(3) = V;
+    LhsVar(4) = IPARAM;
+    LhsVar(5) = IPNTR;
+    LhsVar(6) = WORKD;
+    LhsVar(7) = WORKL;
+    LhsVar(8) = RWORK;
+    LhsVar(9) = INFO;
 
-  PutLhsVar();
+    PutLhsVar();
 
-  return 0;
+    return 0;
 }
 /*--------------------------------------------------------------------------*/
index 40249ac..47a2657 100644 (file)
 #include "localization.h"
 #include "Scierror.h"
 /*--------------------------------------------------------------------------*/
-extern int C2F(zneupd)(int * rvec, char * howmny, int * select, 
-                      doublecomplex * d, doublecomplex * z, int * ldz, 
-                      doublecomplex * sigma, doublecomplex * workev, 
-                      char * bmat, int * n, char * which, int * nev, 
-                      double *  tol, doublecomplex * resid, int * ncv,
-                      doublecomplex * v, int * ldv, int * iparam, int * ipntr,
-                      doublecomplex * workd, doublecomplex * workl, 
-                      int * lworkl, double * rwork, int * info);
+extern int C2F(zneupd)(int * rvec, char * howmny, int * select,
+                       doublecomplex * d, doublecomplex * z, int * ldz,
+                       doublecomplex * sigma, doublecomplex * workev,
+                       char * bmat, int * n, char * which, int * nev,
+                       double *  tol, doublecomplex * resid, int * ncv,
+                       doublecomplex * v, int * ldv, int * iparam, int * ipntr,
+                       doublecomplex * workd, doublecomplex * workl,
+                       int * lworkl, double * rwork, int * info);
 /*--------------------------------------------------------------------------*/
-int sci_zneupd(char *fname,unsigned long fname_len)
+int sci_zneupd(char *fname, unsigned long fname_len)
 {
-  int mRVEC,     nRVEC,      pRVEC;
-  int mHOWMANY,  nHOWMANY,   pHOWMANY;
-  int mSELECT,   nSELECT,    pSELECT;
-  int D,        mD,        nD,         pD;
-  int Z,        mZ,        nZ,         pZ;
-  int mSIGMA,    nSIGMA,     pSIGMA;
-  int mWORKev,   nWORKev,    pWORKev;
-  int mBMAT,     nBMAT,      pBMAT;
-  int mN,        nN,         pN;
-  int mWHICH,    nWHICH,     pWHICH;
-  int mNEV,      nNEV,       pNEV;
-  int mTOL,      nTOL,       pTOL;
-  int RESID,    mRESID,    nRESID,     pRESID;
-  int mNCV,      nNCV,       pNCV;
-  int mV,        nV,         pV;
-  int IPARAM,   mIPARAM,   nIPARAM,    pIPARAM;
-  int IPNTR,    mIPNTR,    nIPNTR,     pIPNTR;
-  int WORKD,    mWORKD,    nWORKD,     pWORKD;
-  int WORKL,    mWORKL,    nWORKL,     pWORKL;
-  int RWORK,    mRWORK,    nRWORK,     pRWORK;
-  int INFO,     mINFO,     nINFO,      pINFO;
-
-  int minlhs=1, minrhs=21, maxlhs=9, maxrhs=21;
-  int LDZ, LDV, LWORKL;
-  int sizeWORKL = 0;
-
-  CheckRhs(minrhs,maxrhs);  
-  CheckLhs(minlhs,maxlhs);
-
-  /*                                                  VARIABLE = NUMBER   */
-  GetRhsVar( 1,MATRIX_OF_INTEGER_DATATYPE, &mRVEC,   &nRVEC,   &pRVEC);
-  GetRhsVar( 2,STRING_DATATYPE,            &mHOWMANY,&nHOWMANY,&pHOWMANY);
-  GetRhsVar( 3,MATRIX_OF_INTEGER_DATATYPE, &mSELECT, &nSELECT, &pSELECT);
-  GetRhsVar( 4,MATRIX_OF_COMPLEX_DATATYPE, &mD,      &nD,      &pD);                D =  4;
-  GetRhsVar( 5,MATRIX_OF_COMPLEX_DATATYPE, &mZ,      &nZ,      &pZ);                Z =  5;
-  GetRhsVar( 6,MATRIX_OF_COMPLEX_DATATYPE, &mSIGMA,  &nSIGMA,  &pSIGMA);
-  GetRhsVar( 7,MATRIX_OF_COMPLEX_DATATYPE, &mWORKev, &nWORKev, &pWORKev);
-  GetRhsVar( 8,STRING_DATATYPE,            &mBMAT,   &nBMAT,   &pBMAT);
-  GetRhsVar( 9,MATRIX_OF_INTEGER_DATATYPE, &mN,      &nN,      &pN);
-  GetRhsVar(10,STRING_DATATYPE,            &mWHICH,  &nWHICH,  &pWHICH);
-  GetRhsVar(11,MATRIX_OF_INTEGER_DATATYPE, &mNEV,    &nNEV,    &pNEV);
-  GetRhsVar(12,MATRIX_OF_DOUBLE_DATATYPE,  &mTOL,    &nTOL,    &pTOL);
-  GetRhsVar(13,MATRIX_OF_COMPLEX_DATATYPE, &mRESID,  &nRESID,  &pRESID);        RESID = 13;
-  GetRhsVar(14,MATRIX_OF_INTEGER_DATATYPE, &mNCV,    &nNCV,    &pNCV);
-  GetRhsVar(15,MATRIX_OF_COMPLEX_DATATYPE, &mV,      &nV,      &pV);
-  GetRhsVar(16,MATRIX_OF_INTEGER_DATATYPE, &mIPARAM, &nIPARAM, &pIPARAM);      IPARAM = 16;
-  GetRhsVar(17,MATRIX_OF_INTEGER_DATATYPE, &mIPNTR,  &nIPNTR,  &pIPNTR);        IPNTR = 17;
-  GetRhsVar(18,MATRIX_OF_COMPLEX_DATATYPE, &mWORKD,  &nWORKD,  &pWORKD);        WORKD = 18;
-  GetRhsVar(19,MATRIX_OF_COMPLEX_DATATYPE, &mWORKL,  &nWORKL,  &pWORKL);        WORKL = 19;
-  GetRhsVar(20,MATRIX_OF_DOUBLE_DATATYPE,  &mRWORK,  &nRWORK,  &pRWORK);        RWORK = 20;
-  GetRhsVar(21,MATRIX_OF_INTEGER_DATATYPE, &mINFO,   &nINFO,   &pINFO);          INFO = 21;
-
-  LWORKL = mWORKL*nWORKL;   LDV=Max(1,*istk(pN)); LDZ=LDV;
-
-  /* Check some sizes */
-  if (mIPARAM*nIPARAM!=11)
+    int mRVEC,     nRVEC,      pRVEC;
+    int mHOWMANY,  nHOWMANY,   pHOWMANY;
+    int mSELECT,   nSELECT,    pSELECT;
+    int D,        mD,        nD,         pD;
+    int Z,        mZ,        nZ,         pZ;
+    int mSIGMA,    nSIGMA,     pSIGMA;
+    int mWORKev,   nWORKev,    pWORKev;
+    int mBMAT,     nBMAT,      pBMAT;
+    int mN,        nN,         pN;
+    int mWHICH,    nWHICH,     pWHICH;
+    int mNEV,      nNEV,       pNEV;
+    int mTOL,      nTOL,       pTOL;
+    int RESID,    mRESID,    nRESID,     pRESID;
+    int mNCV,      nNCV,       pNCV;
+    int mV,        nV,         pV;
+    int IPARAM,   mIPARAM,   nIPARAM,    pIPARAM;
+    int IPNTR,    mIPNTR,    nIPNTR,     pIPNTR;
+    int WORKD,    mWORKD,    nWORKD,     pWORKD;
+    int WORKL,    mWORKL,    nWORKL,     pWORKL;
+    int RWORK,    mRWORK,    nRWORK,     pRWORK;
+    int INFO,     mINFO,     nINFO,      pINFO;
+
+    int minlhs = 1, minrhs = 21, maxlhs = 9, maxrhs = 21;
+    int LDZ, LDV, LWORKL;
+    int sizeWORKL = 0;
+
+    CheckRhs(minrhs, maxrhs);
+    CheckLhs(minlhs, maxlhs);
+
+    /*                                                  VARIABLE = NUMBER   */
+    GetRhsVar( 1, MATRIX_OF_INTEGER_DATATYPE, &mRVEC,   &nRVEC,   &pRVEC);
+    GetRhsVar( 2, STRING_DATATYPE,            &mHOWMANY, &nHOWMANY, &pHOWMANY);
+    GetRhsVar( 3, MATRIX_OF_INTEGER_DATATYPE, &mSELECT, &nSELECT, &pSELECT);
+    GetRhsVar( 4, MATRIX_OF_COMPLEX_DATATYPE, &mD,      &nD,      &pD);
+    D =  4;
+    GetRhsVar( 5, MATRIX_OF_COMPLEX_DATATYPE, &mZ,      &nZ,      &pZ);
+    Z =  5;
+    GetRhsVar( 6, MATRIX_OF_COMPLEX_DATATYPE, &mSIGMA,  &nSIGMA,  &pSIGMA);
+    GetRhsVar( 7, MATRIX_OF_COMPLEX_DATATYPE, &mWORKev, &nWORKev, &pWORKev);
+    GetRhsVar( 8, STRING_DATATYPE,            &mBMAT,   &nBMAT,   &pBMAT);
+    GetRhsVar( 9, MATRIX_OF_INTEGER_DATATYPE, &mN,      &nN,      &pN);
+    GetRhsVar(10, STRING_DATATYPE,            &mWHICH,  &nWHICH,  &pWHICH);
+    GetRhsVar(11, MATRIX_OF_INTEGER_DATATYPE, &mNEV,    &nNEV,    &pNEV);
+    GetRhsVar(12, MATRIX_OF_DOUBLE_DATATYPE,  &mTOL,    &nTOL,    &pTOL);
+    GetRhsVar(13, MATRIX_OF_COMPLEX_DATATYPE, &mRESID,  &nRESID,  &pRESID);
+    RESID = 13;
+    GetRhsVar(14, MATRIX_OF_INTEGER_DATATYPE, &mNCV,    &nNCV,    &pNCV);
+    GetRhsVar(15, MATRIX_OF_COMPLEX_DATATYPE, &mV,      &nV,      &pV);
+    GetRhsVar(16, MATRIX_OF_INTEGER_DATATYPE, &mIPARAM, &nIPARAM, &pIPARAM);
+    IPARAM = 16;
+    GetRhsVar(17, MATRIX_OF_INTEGER_DATATYPE, &mIPNTR,  &nIPNTR,  &pIPNTR);
+    IPNTR = 17;
+    GetRhsVar(18, MATRIX_OF_COMPLEX_DATATYPE, &mWORKD,  &nWORKD,  &pWORKD);
+    WORKD = 18;
+    GetRhsVar(19, MATRIX_OF_COMPLEX_DATATYPE, &mWORKL,  &nWORKL,  &pWORKL);
+    WORKL = 19;
+    GetRhsVar(20, MATRIX_OF_DOUBLE_DATATYPE,  &mRWORK,  &nRWORK,  &pRWORK);
+    RWORK = 20;
+    GetRhsVar(21, MATRIX_OF_INTEGER_DATATYPE, &mINFO,   &nINFO,   &pINFO);
+    INFO = 21;
+
+    LWORKL = mWORKL * nWORKL;
+    LDV = Max(1, *istk(pN));
+    LDZ = LDV;
+
+    /* Check some sizes */
+    if (mIPARAM*nIPARAM != 11)
     {
-      Scierror(999,_("%s: Wrong size for input argument %s: An array of size %d expected.\n"),fname, "IPARAM", 11);
-      return 0;
+        Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "IPARAM", 11);
+        return 0;
     }
 
-  if (mIPNTR*nIPNTR!=14)
+    if (mIPNTR*nIPNTR != 14)
     {
-      Scierror(999,_("%s: Wrong size for input argument %s: An array of size %d expected.\n"),fname, "IPNTR", 14);
-      return 0;
+        Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "IPNTR", 14);
+        return 0;
     }
 
-  if (mRESID*nRESID!=*istk(pN))
+    if (mRESID*nRESID != *istk(pN))
     {
-      Scierror(999,_("%s: Wrong size for input argument %s: An array of size %d expected.\n"),fname, "RESID", *istk(pN));
-      return 0;
+        Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "RESID", *istk(pN));
+        return 0;
     }
 
-  if (mWORKD*nWORKD<3 * *istk(pN))
+    if (mWORKD * nWORKD < 3 * *istk(pN))
     {
-      Scierror(999,_("%s: Wrong size for input argument %s: An array of size %d expected.\n"),fname, "WORKD", 3* *istk(pN));
-      return 0;
+        Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "WORKD", 3 * *istk(pN));
+        return 0;
     }
 
-  if (mSELECT*nSELECT!=*istk(pNCV))
+    if (mSELECT*nSELECT != *istk(pNCV))
     {
-      Scierror(999,_("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "SELECT", *istk(pNCV));
-      return 0;
+        Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "SELECT", *istk(pNCV));
+        return 0;
     }
 
-  if (mD*nD!=(*istk(pNEV)+1))
+    if (mD*nD != (*istk(pNEV) + 1))
     {
-      Scierror(999,_("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "D", *istk(pNEV) + 1);
-      return 0;
+        Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "D", *istk(pNEV) + 1);
+        return 0;
     }
 
-  if ((mZ!=*istk(pN))&&(nZ!=*istk(pNEV)+1))
+    if ((mZ != *istk(pN)) || (nZ != *istk(pNEV)))
     {
-      Scierror(999,_("%s: Wrong size for input argument %s: A matrix of size %dx%d expected.\n"), fname, "Z", *istk(pN), *istk(pNEV) + 1);
-      return 0;
+        Scierror(999, _("%s: Wrong size for input argument %s: A matrix of size %dx%d expected.\n"), fname, "Z", *istk(pN), *istk(pNEV));
+        return 0;
     }
 
-  if (mWORKev*nWORKev!=3 * *istk(pNCV))
+    if (mWORKev*nWORKev != 2 * *istk(pNCV))
     {
-      Scierror(999,_("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "WORKev", 3 * *istk(pNCV));
-      return 0;
+        Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "WORKev", 2 * *istk(pNCV));
+        return 0;
     }
 
-  if ((mV!=*istk(pN))&&(mV!=*istk(pNCV)))
+    if ((mV != *istk(pN)) || (nV != *istk(pNCV)))
     {
-      Scierror(999,_("%s: Wrong size for input argument %s: A matrix of size %dx%d expected.\n"), fname, "V", *istk(pN),*istk(pNCV));
-      return 0;
+        Scierror(999, _("%s: Wrong size for input argument %s: A matrix of size %dx%d expected.\n"), fname, "V", *istk(pN), *istk(pNCV));
+        return 0;
     }
 
-  sizeWORKL = 3 * *istk(pNCV) * *istk(pNCV) + 5 * *istk(pNCV);
+    sizeWORKL = 3 * *istk(pNCV) * *istk(pNCV) + 5 * *istk(pNCV);
 
-  if ((mWORKL*nWORKL<sizeWORKL))
+    if ((mWORKL * nWORKL < sizeWORKL))
     {
-      Scierror(999,_("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "WORKL", sizeWORKL);
-      return 0;
+        Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "WORKL", sizeWORKL);
+        return 0;
     }
 
-  C2F(zneupd)(istk(pRVEC), cstk(pHOWMANY), istk(pSELECT), zstk(pD),
-              zstk(pZ), &LDZ, zstk(pSIGMA), zstk(pWORKev),
-              cstk(pBMAT), istk(pN), cstk(pWHICH), istk(pNEV),
-              stk(pTOL), zstk(pRESID), istk(pNCV), zstk(pV),
-              &LDV, istk(pIPARAM), istk(pIPNTR), zstk(pWORKD),
-              zstk(pWORKL), &LWORKL, stk(pRWORK), istk(pINFO));
+    C2F(zneupd)(istk(pRVEC), cstk(pHOWMANY), istk(pSELECT), zstk(pD),
+                zstk(pZ), &LDZ, zstk(pSIGMA), zstk(pWORKev),
+                cstk(pBMAT), istk(pN), cstk(pWHICH), istk(pNEV),
+                stk(pTOL), zstk(pRESID), istk(pNCV), zstk(pV),
+                &LDV, istk(pIPARAM), istk(pIPNTR), zstk(pWORKD),
+                zstk(pWORKL), &LWORKL, stk(pRWORK), istk(pINFO));
 
-  if (*istk(pINFO) < 0) {
-    C2F(errorinfo)("zneupd", istk(pINFO), 6L);
-    return 0;
-  }
+    if (*istk(pINFO) < 0)
+    {
+        C2F(errorinfo)("zneupd", istk(pINFO), 6L);
+        return 0;
+    }
 
-  LhsVar(1) = D;
-  LhsVar(2) = Z;
-  LhsVar(3) = RESID;
-  LhsVar(4) = IPARAM;
-  LhsVar(5) = IPNTR;
-  LhsVar(6) = WORKD; 
-  LhsVar(7) = WORKL;
-  LhsVar(8) = RWORK; 
-  LhsVar(9) = INFO;
+    LhsVar(1) = D;
+    LhsVar(2) = Z;
+    LhsVar(3) = RESID;
+    LhsVar(4) = IPARAM;
+    LhsVar(5) = IPNTR;
+    LhsVar(6) = WORKD;
+    LhsVar(7) = WORKL;
+    LhsVar(8) = RWORK;
+    LhsVar(9) = INFO;
 
-  PutLhsVar();
+    PutLhsVar();
 
-  return 0;
+    return 0;
 }
 /*--------------------------------------------------------------------------*/
index 3cd1c07..a628733 100644 (file)
@@ -15,6 +15,8 @@
 /*--------------------------------------------------------------------------*/
 #pragma comment(lib,"../../bin/libintl.lib")
 #pragma comment(lib,"../../bin/arpack.lib")
+#pragma comment(lib,"../../bin/blasplus.lib")
+#pragma comment(lib,"../../bin/lapack.lib")
 /*--------------------------------------------------------------------------*/
 int WINAPI DllMain (HINSTANCE hInstance , DWORD reason, PVOID pvReserved)
 {
diff --git a/scilab/modules/arnoldi/src/c/eigs.c b/scilab/modules/arnoldi/src/c/eigs.c
new file mode 100644 (file)
index 0000000..bb14d4c
--- /dev/null
@@ -0,0 +1,1251 @@
+/*
+* Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
+* Copyright (C) 2012 -Scilab Enterprises - Adeline CARNIS
+*
+* This file must be used under the terms of the CeCILL.
+* This source file is licensed as described in the file COPYING, which
+* you should have received as part of this distribution.  The terms
+* are also available at
+* http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
+*
+*/
+/*--------------------------------------------------------------------------*/
+#include <string.h>
+#include <math.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include "eigs.h"
+#include "stack-c.h"
+#include "MALLOC.h"
+#include "sciprint.h"
+#include "eigs_dependencies.h"
+/*--------------------------------------------------------------------------*/
+
+/*--------------------------------------------------------------------------*/
+// dgemm performs one of the matrix-matrix operations
+extern int C2F(dgemm)(char* transa, char* transb, int* m, int* n, int* k, double* alpha, double* A, int* lda, double* B, int* ldb, double* beta, double* C, int* ldc);
+
+// zgemm performs one of the matrix-matrix operations
+extern int C2F(zgemm)(char* transa, char* transb, int* m, int* n, int* k, doublecomplex* alpha, doublecomplex* A, int* lda,
+    doublecomplex* B, int* ldb, doublecomplex* beta, doublecomplex* C, int* ldc);
+
+// dgetrf computes an LU factorization of a general M by N matrix A (double) using partial pivoting with row interchanges
+extern int C2F(dgetrf)(int* m, int* n, double* A, int* lda, int* ipiv, int* info);
+
+// zgetrd computes an LU factorization of a general M by N matrix A (complex*16) using partial pivoting with row interchanges
+extern int C2F(zgetrf)(int* m, int* n, doublecomplex* A, int* lda, int* ipiv, int* info);
+
+// dlaswp performs a series of row interchanges on the matrix A
+// one row interchange is initiated for each of rows k1 through k2 of A
+extern int C2F(dlaswp)(int* n, double* A, int* lda, int* k1, int* k2, int* ipiv, int* incx);
+
+// dpotrf computes the cholesky factorization of a real symmetric positive definite matrix A
+extern int C2F(dpotrf)(char* uplo, int* n, double* A, int* lda, int* info);
+
+// zpotrf computes the cholesky factorization of a real hermitian positive definite matrix A
+extern int C2F(zpotrf)(char* uplo, int* n, doublecomplex* A, int* lda, int* info);
+
+// dgetri computes the inverse of a matrix using the LU factorization computed by dgetrf
+extern int C2F(dgetri)(int* n, double* A, int* lda, int* ipiv, double* work, int* lworkl, int* info);
+
+// zgetri computes the inverse of a matrix using the LU factorization computed by zgetrf
+extern int C2F(zgetri)(int* n, doublecomplex* A, int* lda, int* ipiv, doublecomplex* work, int* lworkl, int* info);
+/*--------------------------------------------------------------------------*/
+
+/*--------------------------------------------------------------------------*/
+extern int C2F(dsaupd)(int *ido, char *bmat, int *n, char *which, int *nev,
+    double *tol, double *resid, int *ncv, double *v,
+    int *ldv, int *iparam, int *ipntr, double *workd,
+    double *workl, int *lworkl, int *info);
+/*--------------------------------------------------------------------------*/
+
+/*--------------------------------------------------------------------------*/
+extern int C2F(dseupd)(int *rvec, char *howmny, int *select, double *d,
+    double *z, int *ldz, double *sigma, char *bmat,
+    int *n, char *which, int *nev , double *tol,
+    double *resid, int *ncv, double *v , int *ldv,
+    int *iparam, int *ipntr, double *workd, double *workl,
+    int *lworkl, int *info, unsigned long rvec_length,
+    unsigned long howmany_length,
+    unsigned long bmat_length, unsigned long which_len);
+/*--------------------------------------------------------------------------*/
+
+/*--------------------------------------------------------------------------*/
+extern int C2F(dnaupd)(int *ido, char *bmat, int *n, char *which, int *nev,
+    double *tol, double *resid, int *ncv, double *v,
+    int *ldv, int *iparam, int *ipntr, double *workd,
+    double *workl, int *lworkl, int *info,
+    unsigned long bmat_len, unsigned long which_len);
+/*--------------------------------------------------------------------------*/
+
+/*--------------------------------------------------------------------------*/
+extern int C2F(dneupd)(int *rvec, char *howmny, int *select, double *dr,
+    double *di, double *z, int *ldz, double *sigmar,
+    double *sigmai, double *workev, char *bmat, int *n,
+    char *which, int *nev, double *tol, double *resid,
+    int *ncv, double *v, int *ldv, int *iparam, int *ipntr,
+    double *workd, double *workl, int *lworkl, int *info);
+/*--------------------------------------------------------------------------*/
+
+/*--------------------------------------------------------------------------*/
+extern int C2F(znaupd)(int * ido, char * bmat, int * n, char * which,
+    int * nev, double * tol, doublecomplex * resid,
+    int * ncv, doublecomplex * v, int * ldv, int * iparam,
+    int * ipntr, doublecomplex * workd,
+    doublecomplex * workl, int * lworkl, double * rwork,
+    int * info);
+/*--------------------------------------------------------------------------*/
+
+/*--------------------------------------------------------------------------*/
+extern int C2F(zneupd)(int * rvec, char * howmny, int * select,
+    doublecomplex * d, doublecomplex * z, int * ldz,
+    doublecomplex * sigma, doublecomplex * workev,
+    char * bmat, int * n, char * which, int * nev,
+    double *  tol, doublecomplex * resid, int * ncv,
+    doublecomplex * v, int * ldv, int * iparam, int * ipntr,
+    doublecomplex * workd, doublecomplex * workl,
+    int * lworkl, double * rwork, int * info);
+/*--------------------------------------------------------------------------*/
+
+static double alpha = 1.;
+static double beta = 0.;
+
+static doublecomplex alphac = {1., 0.};
+static doublecomplex betac = {0., 0.};
+
+int eigs(double *AR, doublecomplex *AC, int N, int Acomplex, int Asym, double* B,
+    doublecomplex* BC, int Bcomplex, int matB, int nev, doublecomplex* SIGMA,
+    char* which, double* maxiter, double* tol, double* NCV, double* RESID, doublecomplex* RESIDC,
+    int* INFO, double* cholB, int INFO_EUPD, doublecomplex* eigenvalue, doublecomplex* eigenvector)
+{
+
+    int index = 0;
+    // GENERAL VARIABLES
+    int i                      = 0;
+    int j                      = 0;
+    int        k                       = 0;
+    int        l                       = 0;
+    int INFO_CHOL      = 0;
+    int INFO_LU                = 0;
+    int k1                     = 1;
+    int iOne           = 1;
+
+    // VARIABLES DSAUPD, DNAUPD, ZNAUPD
+    int LWORKL         = 0;
+    int IDO                    = 0;
+    int LDV                    = Max(1, N);
+    int ncv                    = 0;
+
+    int* IPARAM                = NULL;
+    int* IPNTR         = NULL;
+
+    double* V                  = NULL;
+    doublecomplex* VC  = NULL;
+
+    double* WORKD                      = NULL;
+    doublecomplex* WORKDC      = NULL;
+
+    double* WORKL                      = NULL;
+    doublecomplex* WORKLC      = NULL;
+
+    double* RWORK                      = NULL;
+
+    char* bmat = "I";
+
+    // VARIABLES DSEUPD, DNEUPD, ZNEUPD
+    int RVEC                   = 0;    // compute eigenvalues if RVEC = 1 also compute eigenvalues and eigenvectors
+    char* HOWMNY               = "A";
+
+    int* SELECT                        = NULL;
+
+    double* D                  = NULL;
+    double* DI                 = NULL;
+    double* DR                 = NULL;
+    doublecomplex* DC  = NULL;
+
+    double* WORKEV                     = NULL;
+    doublecomplex* WORKEVC     = NULL;
+
+    double* Z                  = NULL;
+    doublecomplex* ZC  = NULL;
+
+    double SIGMAR              = SIGMA[0].r;
+    double SIGMAI              = SIGMA[0].i;
+
+    double* R = (double*)malloc(N * N * sizeof(double));
+    double* Rprime = (double*)malloc(N * N * sizeof(double));
+
+    double* AMSB                       = NULL;
+    doublecomplex* AMSBC       = NULL;
+
+    double* L  = NULL;
+    double* U  = NULL;
+    double* E  = NULL;
+
+    doublecomplex* RC = (doublecomplex*)malloc(N * N * sizeof(doublecomplex));
+    doublecomplex* RCprime = (doublecomplex*)malloc(N * N * sizeof(doublecomplex));
+
+    doublecomplex* LC  = NULL;
+    doublecomplex* UC  = NULL;
+    doublecomplex* EC  = NULL;
+
+    double* tmp_WORKD  = NULL;
+    doublecomplex* tmp_WORKDC  = NULL;
+
+    double* R_Rprime   = NULL;
+    double* invR_A_invRprime   = NULL;
+    double* invU_invL_E        = NULL;
+
+    doublecomplex* RC_RCprime                  = NULL;
+    doublecomplex* invRC_AC_invRCprime = NULL;
+    doublecomplex* invUC_invLC_EC              = NULL;
+
+    int* IPVT  = NULL;
+
+    IPARAM = (int*)malloc(11 * sizeof(int));
+    memset(IPARAM, 0, 11 * sizeof(int));
+    IPARAM[0] = 1;
+    IPARAM[2] = (int) maxiter[0];
+    IPARAM[6] = 1; // by default mode = 1
+
+    IPNTR = (int*)malloc(14 * sizeof(int));
+    memset(IPNTR, 0, 14 * sizeof(int));
+
+    tmp_WORKD = (double*)malloc(N * sizeof(double));
+    memset(tmp_WORKD, 0, N * sizeof(double));
+    tmp_WORKDC = (doublecomplex*)malloc(N * sizeof(doublecomplex));
+    memset(tmp_WORKDC, 0, N * sizeof(doublecomplex));
+
+    // END VARIABLES
+
+    // Info to compute eigenvalues and eigenvectors
+    if (eigenvector != NULL)
+    {
+        RVEC = 1;
+    }
+
+    // MODE
+    if (!strcmp(which, "SM") || (SIGMAR != 0 || SIGMAI != 0))
+    {
+        IPARAM[6] = 3;
+        which = "LM";
+    }
+
+    // BMAT
+    if ((matB == 0) || (IPARAM[6] == 1)) // if B = [] or mode = 1 -> bmat = 'I' : standart eigenvalue problem
+    {
+        bmat = "I";
+    }
+    else   // generalized eigenvalue problem
+    {
+        bmat = "G";
+    }
+
+    // NCV
+    if (NCV == NULL)
+    {
+        if (Asym == 0 && !Acomplex && !Bcomplex) // if dnaupd  ncv = 2*nev+1
+        {
+            ncv = Max(2 * nev + 1, 20);            
+        }
+        else // if dsaupd or znaupd ncv = 2*nev
+        {
+            ncv = Max(2 * nev, 20);
+        }
+        if (ncv > N)
+        {
+            ncv = N; 
+        }
+    }
+    else
+    {
+        ncv = (int) NCV[0];
+        if (ncv <= nev || ncv > N) // Error
+        {
+            free(IPARAM);
+            free(IPNTR);
+            free(R);
+            free(Rprime);
+            free(RC);
+            free(RCprime);
+            free(tmp_WORKD);
+            free(tmp_WORKDC);
+            return -1;
+
+        }
+    }
+
+    // NEV
+    if ((!Acomplex && !Bcomplex && Asym == 1 && nev >= N) || (!(!Acomplex && !Bcomplex && Asym == 1) && nev >= N - 1))
+    {
+        free(IPARAM);
+        free(IPNTR);
+        free(R);
+        free(Rprime);
+        free(RC);
+        free(RCprime);
+        free(tmp_WORKD);
+        free(tmp_WORKDC);
+        return -2;
+    }
+
+    // B must be symmetric (hermitian) positive (semi-) positive
+    if (matB != 0)
+    {
+        if (cholB[0]) // Comparison between B and upper triangular matrix
+        {
+            if (!Bcomplex) // B is real
+            {
+                for (i = 0 ; i < N ; i++)
+                {
+                    for (j = i + 1 ; j < N ; j++)
+                    {
+                        if (B[j + i * N] != 0)
+                        {
+                            free(IPARAM);
+                            free(IPNTR);
+                            free(R);
+                            free(Rprime);
+                            free(RC);
+                            free(RCprime);
+                            free(tmp_WORKD);
+                            free(tmp_WORKDC);
+                            free(IPVT);
+                            return -3;
+                        }
+                    }
+                }
+
+                memcpy(Rprime, B, N * N * sizeof(double));
+
+                // Compute the lower triangular matrix
+                memset(R, 0, N * N * sizeof(double));
+                for (i = 0 ; i < N ; i++)
+                {
+                    for (j = 0 ; j < N  ; j++)
+                    {
+                        R[i * N + j] = B[j * N + i];
+                    }
+                }
+            }
+            else       // if B is complex
+            {
+                for (i = 0 ; i < N ; i++)
+                {
+                    for (j = i + 1 ; j < N ; j++)
+                    {
+                        if (BC[j + i * N].r != 0 || BC[j + i * N].i != 0)
+                        {
+                            free(IPARAM);
+                            free(IPNTR);
+                            free(R);
+                            free(Rprime);
+                            free(RC);
+                            free(RCprime);
+                            free(tmp_WORKD);
+                            free(tmp_WORKDC);
+                            return -3;
+                        }
+                    }
+                }
+
+                memcpy(RCprime, BC, N * N * sizeof(doublecomplex));
+
+                // Computes the lower triangular matrix BC
+                memset(RC, 0, N * N * sizeof(doublecomplex));
+                for (i = 0 ; i < N ; i++)
+                {
+                    for (j = 0 ; j < N ; j++)
+                    {
+                        RC[i * N + j].r = BC[j * N + i].r;
+                        RC[i * N + j].i = (-1) * BC[j * N + i].i;
+                    }
+                }
+            }
+
+        }
+    }
+
+    if (!cholB[0] && IPARAM[6] == 1 && matB != 0)
+    {
+        if (!Bcomplex) // B is real
+        {
+            memcpy(R, B, N * N * sizeof(double));
+            memcpy(Rprime, B, N * N * sizeof(double));
+
+            C2F(dpotrf)("L", &N, R, &N, &INFO_CHOL); // Compute the lower triangular matrix R
+            if (INFO_CHOL != 0) // Errors
+            {
+                free(IPARAM);
+                free(IPNTR);
+                free(R);
+                free(Rprime);
+                free(RC);
+                free(RCprime);
+                free(tmp_WORKD);
+                free(tmp_WORKDC);
+                return -3;
+            }
+
+            C2F(dpotrf)("U", &N, Rprime, &N, &INFO_CHOL);   // Compute the upper triangular matrix Rprime
+            if (INFO_CHOL != 0)
+            {
+                free(IPARAM);
+                free(IPNTR);
+                free(R);
+                free(Rprime);
+                free(RC);
+                free(RCprime);
+                free(tmp_WORKD);
+                free(tmp_WORKDC);
+                return -3;
+            }
+
+            for (j = 0 ; j < N ; j++)
+            {
+                for (i = 0 ; i < j ; i++)
+                {
+                    R[i + j * N] = 0;
+                    Rprime[j + i * N] = 0;
+                }
+            }
+        }
+        else   // B is complex
+        {
+            memcpy(RC, BC, N * N * sizeof(doublecomplex));
+            memcpy(RCprime, BC, N * N * sizeof(doublecomplex));
+
+            C2F(zpotrf)("L", &N, RC, &N, &INFO_CHOL); // Computes the lower triangular matrix
+            if (INFO_CHOL != 0)
+            {
+                free(IPARAM);
+                free(IPNTR);
+                free(R);
+                free(Rprime);
+                free(RC);
+                free(RCprime);
+                free(tmp_WORKD);
+                free(tmp_WORKDC);
+                return -3;
+            }
+
+            C2F(zpotrf)("U", &N, RCprime, &N, &INFO_CHOL);     // Computes the upper triangular matrix
+            if (INFO_CHOL != 0)
+            {
+                free(IPARAM);
+                free(IPNTR);
+                free(R);
+                free(Rprime);
+                free(RC);
+                free(RCprime);
+                free(tmp_WORKD);
+                free(tmp_WORKDC);
+                return -3;
+            }
+
+            for (j = 0 ; j < N ; j++)
+            {
+                for (i = 0 ; i < j ; i++)
+                {
+                    RC[i + j * N].r = 0;
+                    RC[i + j * N].i = 0;
+
+                    RCprime[j + i * N].r = 0;
+                    RCprime[j + i * N].i = 0;
+                }
+            }
+        }
+    }
+
+    // MAIN
+    if (!Acomplex && !Bcomplex)                // A and B are not complex
+    {
+        if (IPARAM[6] == 3)    // if mode = 3
+        {
+            AMSB = (double*)malloc(N * N * sizeof(double));
+            memcpy(AMSB, AR, N * N * sizeof(double));
+
+            // Compute LU decomposition AMSB = A - sigma*B
+            if (matB == 0) // if B = [] -> standart eigenvalue problem : A - sigma
+            {
+                for (i = 0 ; i < N ; i++)
+                {
+                    AMSB[i + i * N] = AMSB[i + i * N] - SIGMAR;
+                }
+            }
+            else       // generalized eigenvalue problem
+            {
+                if (cholB[0])
+                {
+                    if (R_Rprime == NULL)
+                    {
+                        R_Rprime = (double*)malloc(N * N * sizeof(double));
+                        RtimesRprime(R_Rprime, R, Rprime, N);
+                    }
+
+                    for (i = 0 ; i < N * N ; i++)
+                    {
+                        AMSB[i] = AR[i] - (SIGMAR * R_Rprime[i]);
+                    }
+                }
+                else
+                {
+                    for (i = 0 ; i < N * N ; i++)
+                    {
+                        AMSB[i] = AR[i] - (SIGMAR * B[i]);
+                    }
+                }
+            }
+
+            // LU decomposition
+            IPVT = (int*) malloc(N * sizeof(int));
+            memset(IPVT, 0, N * sizeof(int));
+            C2F(dgetrf)(&N, &N, AMSB, &N, IPVT, &INFO_LU);
+
+            // Computes the lower triangular matrix L
+            L = (double*)malloc(N * N * sizeof(double));
+            memset(L, 0, N * N * sizeof(double));
+
+            for (i = 0 ; i < N ; i++)
+            {
+                for (j = 0 ; j < i ; j++)
+                {
+                    L[i + j * N] = AMSB[i + j * N];
+                }
+
+                L[i + i * N] = 1;
+            }
+
+            // Computes the upper triangular matrix U
+            U = (double*)malloc(N * N * sizeof(double));
+            memset(U, 0, N * N * sizeof(double));
+
+            for (j = 0 ; j < N ; j++)
+            {
+                for (i = 0 ; i <= j ; i++)
+                {
+                    //if(i <= j)
+                    U[i + j * N] = AMSB[i + j * N];
+                }
+            }
+
+            // Computes the permutation matrix E
+            E = (double*) malloc(N * N * sizeof(double));
+            memset(E, 0, N * N * sizeof(double));
+
+            for (i = 0 ; i < N ; i++)
+            {
+                E[i * N + i] = 1;
+            }
+
+            C2F(dlaswp)(&N, E, &N, &k1, &N, IPVT, &k1);
+
+            free(AMSB);
+            free(IPVT);
+        }
+
+        if (Asym) // DSAUPD
+        {
+            LWORKL = ncv * ncv + 8 * ncv;
+
+            WORKL = (double*)malloc(LWORKL * sizeof(double));
+            memset(WORKL, 0, LWORKL * sizeof(double));
+        }
+        else   // DNAUPD
+        {
+            LWORKL = 3 * ncv * (ncv + 2);
+
+            WORKL = (double*)malloc(LWORKL * sizeof(double));
+            memset(WORKL, 0, LWORKL * sizeof(double));
+        }
+
+        WORKD = (double*)malloc(3 * N * sizeof(double));
+        memset(WORKD, 0, 3 * N * sizeof(double));
+
+        V = (double*)malloc(N * ncv * sizeof(double));  
+        memset(V, 0, N * ncv * sizeof(double));
+
+        while (IDO != 99)
+        {
+            if (Asym) // DSAUPD
+            {
+                C2F(dsaupd)(&IDO, bmat, &N, which, &nev, tol, RESID, &ncv, V, &LDV, IPARAM, IPNTR, WORKD, WORKL, &LWORKL, &INFO[0]);
+            }
+            else       // DNAUPD
+            {
+                C2F(dnaupd)(&IDO, bmat, &N, which, &nev, tol, RESID, &ncv, V, &LDV, IPARAM, IPNTR, WORKD, WORKL, &LWORKL, &INFO[0], 1L, 2L);
+            }
+
+            if (INFO[0] < 0)
+            {
+                free(IPARAM);
+                free(IPNTR);
+                free(R);
+                free(Rprime);
+                free(RC);
+                free(RCprime);
+                free(tmp_WORKD);
+                free(tmp_WORKDC);
+                free(WORKD);
+                free(WORKL);
+                free(V);
+                free(U);
+                free(L);
+                free(E);
+                if (R_Rprime != NULL)
+                {
+                    free(R_Rprime);
+                }
+                return -4;
+            }
+
+            if (IDO == -1 || IDO == 1 || IDO == 2)
+            {
+                if (IPARAM[6] == 1) // mode = 1
+                {
+                    if (matB == 0) // B = [] -> standart eigenvalue problem
+                    {
+                        // OP = A*x
+                        C2F(dgemm)("n", "n", &N, &iOne, &N, &alpha, AR, &N, WORKD + IPNTR[0] - 1, &N, &beta, WORKD + IPNTR[1] - 1, &N);
+                    }
+                    else // generalized eigenvalue problem
+                    {
+                        // OP = inv(Rprime)*A*inv(R)*x
+                        if (invR_A_invRprime == NULL)
+                        {
+                            invR_A_invRprime = (double*)malloc(N * N * sizeof(double));
+                            invR_times_A_times_invRprime(invR_A_invRprime, R, AR, Rprime, N);
+                        }
+
+                        C2F(dgemm)("n", "n", &N, &iOne, &N, &alpha, invR_A_invRprime, &N, WORKD + IPNTR[0] - 1, &N, &beta, WORKD + IPNTR[1] - 1, &N);
+                    }
+                }
+                else
+                {
+                    if (IPARAM[6] == 3) // mode = 3
+                    {
+                        if (matB == 0) // B = [] -> standart eigenvalue problem
+                        {
+                            if (IDO == 2)
+                            {
+                                // y = B*x where B = I so workd[ipntr[1]-1:ipntr[1]+N-1] = workd[ipntr[0]-1:ipntr[0]+N-1]
+                                memcpy(WORKD + IPNTR[1] - 1, WORKD + IPNTR[0] - 1, N * sizeof(double));
+                            }
+                            else
+                            {
+                                // workd[ipntr[1]-1:ipntr[1]+N-1] = inv(U)*inv(L)*inv(P)*workd[ipntr[0]-1:ipntr[0]+N-1]
+
+                                if (invU_invL_E == NULL)
+                                {
+                                    invU_invL_E = (double*)malloc(N * N * sizeof(double));
+                                    invU_times_invL_times_E(invU_invL_E, U, L, E, N);
+                                }
+
+                                C2F(dgemm)("n", "n", &N, &iOne, &N, &alpha, invU_invL_E, &N, WORKD + IPNTR[0] - 1, &N, &beta, WORKD + IPNTR[1] - 1, &N);
+                            }
+                        }
+                        else  // matB == 1 so B is not empty and bmat = 'G'-> generalized eigenvalue problem
+                        {
+                            if (IDO == 2)
+                            {
+                                if (cholB[0]) // workd[ipntr[1]-1:ipntr[1]+N-1] = R * Rprime * workd[ipntr[0]-1:ipntr[0]+N-1]
+                                {
+                                    if (R_Rprime == NULL)
+                                    {
+                                        R_Rprime = (double*)malloc(N * N * sizeof(double));
+                                        RtimesRprime(R_Rprime, R, Rprime, N);
+                                    }
+
+                                    C2F(dgemm)("n", "n", &N, &iOne, &N, &alpha, R_Rprime, &N, WORKD + IPNTR[0] - 1, &N, &beta, WORKD + IPNTR[1] - 1, &N);
+                                }
+                                else   //  workd[ipntr[1]-1:ipntr[1]+N-1] = B * workd[ipntr[0]-1:ipntr[0]+N-1]
+                                {
+                                    C2F(dgemm)("n", "n", &N, &iOne, &N, &alpha, B, &N, WORKD + IPNTR[0] - 1, &N, &beta, WORKD + IPNTR[1] - 1, &N);
+                                }
+                            }
+                            else
+                            {
+                                if (IDO == -1)
+                                {
+                                    if (cholB[0])  // workd[ipntr[1]-1:ipntr[1]+N-1] = R * Rprime * workd[ipntr[0]-1:ipntr[0]+N-1]
+                                    {
+                                        if (R_Rprime == NULL)
+                                        {
+                                            R_Rprime = (double*)malloc(N * N * sizeof(double));
+                                            RtimesRprime(R_Rprime, R, Rprime, N);
+                                        }
+
+                                        C2F(dgemm)("n", "n", &N, &iOne, &N, &alpha, R_Rprime, &N, WORKD + IPNTR[0] - 1, &N, &beta, WORKD + IPNTR[1] - 1, &N);
+                                    }
+                                    else       // workd[ipntr[1]-1:ipntr[1]+N-1] = B * workd[ipntr[0]-1:ipntr[0]+N-1]
+                                    {
+                                        C2F(dgemm)("n", "n", &N, &iOne, &N, &alpha, B, &N, WORKD + IPNTR[0] - 1, &N, &beta, WORKD + IPNTR[1] - 1, &N);
+                                    }
+                                    // compute workd[ipntr[1]-1:ipntr[1]+N-1] = inv(U)*inv(L)*inv(P)*workd[ipntr[1]-1:ipntr[1]+N-1]
+
+                                    if (invU_invL_E == NULL)
+                                    {
+                                        invU_invL_E = (double*)malloc(N * N * sizeof(double));
+                                        invU_times_invL_times_E(invU_invL_E, U, L, E, N);
+                                    }
+
+                                    C2F(dgemm)("n", "n", &N, &iOne, &N, &alpha, invU_invL_E, &N, WORKD + IPNTR[1] - 1, &N, &beta, tmp_WORKD, &N);
+                                    memcpy(WORKD + IPNTR[1] - 1, tmp_WORKD, N * sizeof(double));
+                                }
+                                else
+                                {
+                                    if (IDO == 1)
+                                    {
+                                        // computes workd[ipntr[1]-1:ipntr[1]+N-1] = inv(U)*inv(L)*inv(P)*workd[ipntr[2]-1:ipntr[2]+N-1]
+                                        if (invU_invL_E == NULL)
+                                        {
+                                            invU_invL_E = (double*)malloc(N * N * sizeof(double));
+                                            invU_times_invL_times_E(invU_invL_E, U, L, E, N);
+                                        }
+
+                                        C2F(dgemm)("n", "n", &N, &iOne, &N, &alpha, invU_invL_E, &N, WORKD + IPNTR[2] - 1, &N, &beta, WORKD + IPNTR[1] - 1, &N);
+                                    }
+                                }
+                            }
+                        }
+                    }
+                    else
+                    {
+                        free(IPARAM);
+                        free(IPNTR);
+                        free(R);
+                        free(Rprime);
+                        free(RC);
+                        free(RCprime);
+                        free(tmp_WORKD);
+                        free(tmp_WORKDC);
+                        free(WORKD);
+                        free(WORKL);
+                        free(V);
+                        free(U);
+                        free(L);
+                        free(E);
+                        
+                        return -5;
+                    }
+                }
+            }
+        } // END WHILE
+
+        free(L);
+        free(U);
+        free(E);
+
+        if (R_Rprime != NULL)
+        {
+            free(R_Rprime);
+        }
+
+        if (invR_A_invRprime != NULL)
+        {
+            free(invR_A_invRprime);
+        }
+
+        if (invU_invL_E != NULL)
+        {
+            free(invU_invL_E);
+        }
+
+        SELECT = (int*)malloc(ncv * sizeof(int));
+        memset(SELECT, 0, ncv * sizeof(int));
+
+        if (Asym) // DSEUPD
+        {
+            D = (double*)malloc(nev * sizeof(double));
+            memset(D, 0, nev * sizeof(double));
+
+            Z = (double*)malloc(N * nev * sizeof(double));
+            memset(Z, 0, N * nev * sizeof(double));
+
+            C2F(dseupd)(&RVEC, HOWMNY, SELECT, D, Z, &LDV, &SIGMAR, bmat, &N, which, &nev, tol, RESID, &ncv, V, &LDV, IPARAM, IPNTR, WORKD, WORKL, &LWORKL, &INFO_EUPD, 1L, 1L, 1L, 2L);
+
+            if (INFO_EUPD != 0)
+            {
+                free(IPARAM);
+                free(IPNTR);
+                free(R);
+                free(Rprime);
+                free(RC);
+                free(RCprime);
+                free(tmp_WORKD);
+                free(tmp_WORKDC);
+                free(WORKD);
+                free(WORKL);
+                free(V);
+                free(D);
+                free(Z);
+                free(SELECT);
+                return -6;
+            }
+            else
+            {
+                for (i = 0 ; i < nev ; i++)
+                {
+                    eigenvalue[i].r = D[i];
+                }
+
+                if (RVEC)
+                {
+                    for (i = 0 ; i < N * nev ; i++)
+                    {
+                        eigenvector[i].r = Z[i];
+                    }
+                }
+            }
+
+            free(D);
+            free(Z);
+        }
+        else   // DNEUPD
+        {
+            DR = (double*)malloc((nev + 1) * sizeof(double));
+            memset(DR, 0, (nev + 1) * sizeof(double));
+
+            DI = (double*)malloc((nev + 1) * sizeof(double));
+            memset(DI, 0, (nev + 1) * sizeof(double));
+
+            Z = (double*) malloc(N * (nev + 1) * sizeof(double));
+            memset(Z, 0, N * (nev + 1) * sizeof(double));
+
+            WORKEV = (double*)malloc(3 * ncv * sizeof(double));
+            memset(WORKEV, 0, 3 * ncv * sizeof(double));
+
+            C2F(dneupd)(&RVEC, HOWMNY, SELECT, DR, DI, Z, &LDV, &SIGMAR, &SIGMAI, WORKEV, bmat, &N, which, &nev, tol, RESID, &ncv, V, &LDV, IPARAM, IPNTR, WORKD, WORKL, &LWORKL, &INFO_EUPD);
+
+            if (INFO_EUPD != 0)
+            {
+                free(IPARAM);
+                free(IPNTR);
+                free(R);
+                free(Rprime);
+                free(RC);
+                free(RCprime);
+                free(tmp_WORKD);
+                free(tmp_WORKDC);
+                free(WORKD);
+                free(WORKL);
+                free(V);
+                free(DR);
+                free(DI);
+                free(Z);
+                free(WORKEV);
+                free(SELECT);
+                return -6;
+            }
+            else
+            {
+                for (i = 0 ; i < nev ; i++)
+                {
+                    eigenvalue[i].r = DR[i];
+                    eigenvalue[i].i = DI[i];
+                }
+
+                if (RVEC)
+                {
+                    i = 0;
+                    while (i <= (nev - 2))
+                    {
+                        for (j = 0; j < N; j++)
+                        {
+                            eigenvector[i * N + j].r = Z[i * N + j];
+                            eigenvector[i * N + j].i = Z[(i + 1) * N + j];
+                            eigenvector[(i + 1)*N + j].r = Z[i * N + j];
+                            eigenvector[(i + 1)*N + j].i = -Z[(i + 1) * N + j];
+                        }
+                        i = i + 2;
+                    }
+                }
+
+            }
+            free(DR);
+            free(DI);
+            free(Z);
+            free(WORKEV);
+        }
+
+        free(V);
+        free(WORKD);
+        free(WORKL);
+        free(SELECT);
+    }
+    else // A or/and B complex
+    {
+        if (IPARAM[6] == 3)    // mode = 3
+        {
+            AMSBC = (doublecomplex*)malloc(N * N * sizeof(doublecomplex));
+            memcpy(AMSBC, AC, N * N * sizeof(doublecomplex));
+            if (matB == 0)     // standart eigenvalue problem
+            {
+                for (i = 0 ; i < N ; i++)
+                {
+                    AMSBC[i + i * N].r = AMSBC[i + i * N].r - SIGMAR;
+                    AMSBC[i + i * N].i = AMSBC[i + i * N].i - SIGMAI;
+                }
+            }
+            else       // generalized eigenvalue problem
+            {
+                if (cholB[0])
+                {
+                    if (RC_RCprime == NULL)
+                    {
+                        RC_RCprime = (doublecomplex*)malloc(N * N * sizeof(doublecomplex));
+                        RCtimesRCprime(RC_RCprime, RC, RCprime, N);
+                    }
+
+                    for (i = 0 ; i < N * N ; i++)
+                    {
+                        AMSBC[i].r = AMSBC[i].r - (SIGMAR * RC_RCprime[i].r + SIGMAI * RC_RCprime[i].i);
+                        AMSBC[i].i = AMSBC[i].i - (SIGMAR * RC_RCprime[i].i + SIGMAI * RC_RCprime[i].r);
+                    }
+                }
+                else
+                {
+                    for (i = 0 ; i < N * N ; i++)
+                    {
+                        AMSBC[i].r = AMSBC[i].r - (SIGMA[0].r * BC[i].r);
+                        AMSBC[i].i = AMSBC[i].i - (SIGMA[0].i * BC[i].i);
+                    }
+                }
+            }
+
+            // LU decomposition
+            IPVT = (int*) malloc(N * sizeof(int));
+            memset(IPVT, 0, N * sizeof(int));
+            C2F(zgetrf)(&N, &N, AMSBC, &N, IPVT, &INFO_LU);
+
+            // Computes the lower triangular matrix L
+            LC = (doublecomplex*)malloc(N * N * sizeof(doublecomplex));
+            memset(LC, 0, N * N * sizeof(doublecomplex));
+            for (i = 0 ; i < N ; i++)
+            {
+                for (j = 0 ; j < i ; j++)
+                {
+                    LC[i + j * N].r = AMSBC[i + j * N].r;
+                    LC[i + j * N].i = AMSBC[i + j * N].i;
+                }
+                LC[i + i * N].r = 1;
+                LC[i + i * N].i = 0;
+            }
+
+            // Computes the upper triangular matrix U
+
+            UC = (doublecomplex*)malloc(N * N * sizeof(doublecomplex));
+            memset(UC, 0, N * N * sizeof(doublecomplex));
+            for (j = 0 ; j < N ; j++)
+            {
+                for (i = 0 ; i <= j ; i++)
+                {
+                    UC[i + j * N].r = AMSBC[i + j * N].r;
+                    UC[i + j * N].i = AMSBC[i + j * N].i;
+                }
+            }
+
+            // Computes the permutation matrix E
+            EC = (doublecomplex*)malloc(N * N * sizeof(doublecomplex));
+            E = (double*)malloc(N * N * sizeof(double));
+            memset(E, 0, N * N * sizeof(double));
+
+            for (i = 0 ; i < N ; i++)
+            {
+                E[i * N + i] = 1;
+            }
+
+            C2F(dlaswp)(&N, E, &N, &k1, &N, IPVT, &k1);
+
+            memset(EC, 0, N * N * sizeof(doublecomplex));
+            for (i = 0 ; i < N * N ; i++)
+            {
+                EC[i].r = E[i];
+            }
+
+            free(AMSBC);
+            free(IPVT);
+        }
+
+        LWORKL = 3 * ncv * ncv + 5 * ncv;
+
+        VC = (doublecomplex*)malloc(N * ncv * sizeof(doublecomplex));
+        memset(VC, 0, N * ncv * sizeof(doublecomplex));
+
+        WORKLC = (doublecomplex*)malloc(LWORKL * sizeof(doublecomplex));
+        memset(WORKLC, 0, LWORKL * sizeof(doublecomplex));
+
+        WORKDC = (doublecomplex*)malloc(3 * N * sizeof(doublecomplex));
+        memset(WORKDC, 0, 3 * N * sizeof(doublecomplex));
+
+        RWORK = (double*)malloc(ncv * sizeof(double));
+        memset(RWORK, 0, ncv * sizeof(double));
+
+        while (IDO != 99)
+        {
+            C2F(znaupd)(&IDO, bmat, &N, which, &nev, tol, RESIDC, &ncv, VC, &LDV, IPARAM, IPNTR, WORKDC, WORKLC, &LWORKL, RWORK, &INFO[0]);
+
+            if (INFO[0] < 0)
+            {
+                free(IPARAM);
+                free(IPNTR);
+                free(R);
+                free(Rprime);
+                free(RC);
+                free(RCprime);
+                free(tmp_WORKD);
+                free(tmp_WORKDC);
+                free(LC);
+                free(UC);
+                free(EC);
+                free(E);
+                free(WORKDC);
+                free(WORKLC);
+                free(VC);
+                free(RWORK);
+                if (RC_RCprime != NULL)
+                {
+                    free(RC_RCprime);
+                }
+                return -4;
+            }
+
+            if (IDO == -1 || IDO == 1 || IDO == 2)
+            {
+                if (IPARAM[6] == 1) // mode = 1
+                {
+                    if (matB == 0) // B = I
+                    {
+                        // OP = A*x
+                        C2F(zgemm)("n", "n", &N, &iOne, &N, &alphac, AC, &N, WORKDC + IPNTR[0] - 1, &N, &betac, WORKDC + IPNTR[1] - 1, &N);
+                    }
+                    else
+                    {
+                        // OP = inv(R')*A*inv(R)*x
+                        if (invRC_AC_invRCprime == NULL)
+                        {
+                            invRC_AC_invRCprime = (doublecomplex*)malloc(N * N * sizeof(doublecomplex));
+                            invRC_times_AC_times_invRCprime(invRC_AC_invRCprime, RC, AC,  RCprime, N);
+                        }
+
+                        C2F(zgemm)("n", "n", &N, &iOne, &N, &alphac, invRC_AC_invRCprime, &N, WORKDC + IPNTR[0] - 1, &N, &betac, WORKDC + IPNTR[1] - 1, &N);
+                    }
+                }
+                else
+                {
+                    if (IPARAM[6] == 3) // si mode = 3
+                    {
+                        if (matB == 0) // B = [] -> matB is empty -> standart eigenvalue problem
+                        {
+                            if (IDO == 2)
+                            {
+                                // y = B*x where B = I so workd[ipntr[1]-1:ipntr[1]+N-1] = workd[ipntr[0]-1:ipntr[0]+N-1]
+                                memcpy(WORKDC + IPNTR[1] - 1, WORKDC + IPNTR[0] - 1, N * sizeof(doublecomplex));
+                            }
+                            else
+                            {
+                                // workd[ipntr[1]-1:ipntr[1]+N-1] = inv(U)*inv(L)*inv(P)*workd[ipntr[0]-1:ipntr[0]+N-1]
+                                if (invUC_invLC_EC == NULL)
+                                {
+                                    invUC_invLC_EC = (doublecomplex*)malloc(N * N * sizeof(doublecomplex));
+                                    invUC_times_invLC_times_EC(invUC_invLC_EC, UC, LC, EC, N);
+                                }
+                                C2F(zgemm)("n", "n", &N, &iOne, &N, &alphac, invUC_invLC_EC, &N, WORKDC + IPNTR[0] - 1, &N, &betac, WORKDC + IPNTR[1] - 1, &N);
+                            }
+
+                        }
+                        else  // matB == 1 so B is not empty and bmat = 'G'-> generalized eigenvalue problem
+                        {
+                            if (IDO == 2)
+                            {
+                                if (cholB[0]) // workd[ipntr[1]-1:ipntr[1]+N-1] = RC * RCprime * workd[ipntr[0]-1:ipntr[0]+N-1]
+                                {
+                                    if (RC_RCprime == NULL)
+                                    {
+                                        RC_RCprime = (doublecomplex*)malloc(N * N * sizeof(doublecomplex));
+                                        RCtimesRCprime(RC_RCprime, RC, RCprime, N);
+                                    }
+
+                                    C2F(zgemm)("n", "n", &N, &iOne, &N, &alphac, RC_RCprime, &N, WORKDC + IPNTR[0] - 1, &N, &betac, WORKDC + IPNTR[1] - 1, &N);
+                                }
+                                else   // workd[ipntr[1]-1:ipntr[1]+N-1] = B *workd[ipntr[0]-1:ipntr[0]+N-1]
+                                {
+                                    C2F(zgemm)("n", "n", &N, &iOne, &N, &alphac, BC, &N, WORKDC + IPNTR[0] - 1, &N, &betac, WORKDC + IPNTR[1] - 1, &N);
+                                }
+                            }
+                            else
+                            {
+                                if (IDO == -1)
+                                {
+                                    if (cholB[0])  // workd[ipntr[1]-1:ipntr[1]+N-1] = RC*RCprime*workd[ipntr[0]-1:ipntr[0]+N-1]
+                                    {
+                                        if (RC_RCprime == NULL)
+                                        {
+                                            RC_RCprime = (doublecomplex*)malloc(N * N * sizeof(doublecomplex));
+                                            RCtimesRCprime(RC_RCprime, RC, RCprime, N);
+                                        }
+
+                                        C2F(zgemm)("n", "n", &N, &iOne, &N, &alphac, RC_RCprime, &N, WORKDC + IPNTR[0] - 1, &N, &betac, WORKDC + IPNTR[1] - 1, &N);
+                                    }
+                                    else       // workd[ipntr[1]-1:ipntr[1]+N-1] = B * workd[ipntr[0]-1:ipntr[0]+N-1]
+                                    {
+                                        C2F(zgemm)("n", "n", &N, &iOne, &N, &alphac, BC, &N, WORKDC + IPNTR[0] - 1, &N, &betac, WORKDC + IPNTR[1] - 1, &N);
+                                    }
+
+                                    // compute workd[ipntr[1]-1:ipntr[1]+N-1] = inv(U)*inv(L)*inv(P)*workd[ipntr[1]-1:ipntr[1]+N-1]
+                                    if (invUC_invLC_EC == NULL)
+                                    {
+                                        invUC_invLC_EC = (doublecomplex*)malloc(N * N * sizeof(doublecomplex));
+                                        invUC_times_invLC_times_EC(invUC_invLC_EC, UC, LC, EC, N);
+                                    }
+
+                                    C2F(zgemm)("n", "n", &N, &iOne, &N, &alphac, invUC_invLC_EC, &N, WORKDC + IPNTR[1] - 1, &N, &betac, tmp_WORKDC, &N);
+                                    memcpy(WORKDC + IPNTR[1] - 1, tmp_WORKDC, N * sizeof(doublecomplex*));
+                                }
+                                else
+                                {
+                                    if (IDO == 1)
+                                    {
+                                        // compute workd[ipntr[1]-1:ipntr[1]+N-1] = inv(U)*inv(L)*inv(P)*workd[ipntr[2]-1:ipntr[2]+N-1]
+                                        if (invUC_invLC_EC == NULL)
+                                        {
+                                            invUC_invLC_EC = (doublecomplex*)malloc(N * N * sizeof(doublecomplex));
+                                            invUC_times_invLC_times_EC(invUC_invLC_EC, UC, LC, EC, N);
+                                        }
+
+                                        C2F(zgemm)("n", "n", &N, &iOne, &N, &alphac, invUC_invLC_EC, &N, WORKDC + IPNTR[2] - 1, &N, &betac, WORKDC + IPNTR[1] - 1, &N);
+                                    }
+                                }
+                            }
+                        }
+                    }
+                    else
+                    {
+                        free(IPARAM);
+                        free(IPNTR);
+                        free(R);
+                        free(Rprime);
+                        free(RC);
+                        free(RCprime);
+                        free(tmp_WORKD);
+                        free(tmp_WORKDC);
+                        free(LC);
+                        free(UC);
+                        free(EC);
+                        free(E);
+                        free(WORKDC);
+                        free(WORKLC);
+                        free(VC);
+                        free(RWORK);
+                        if (RC_RCprime != NULL)
+                        {
+                            free(RC_RCprime);
+                        }
+
+                        if (invRC_AC_invRCprime != NULL)
+                        {
+                            free(invRC_AC_invRCprime);
+                        }
+
+                        if (invUC_invLC_EC != NULL)
+                        {
+                            free(invUC_invLC_EC);
+                        }
+                        return -5;
+                    }
+                }
+            }
+        } // END WHILE
+        free(LC);
+        free(UC);
+        free(EC);
+        free(E);
+
+        if (RC_RCprime != NULL)
+        {
+            free(RC_RCprime);
+        }
+
+        if (invRC_AC_invRCprime != NULL)
+        {
+            free(invRC_AC_invRCprime);
+        }
+
+        if (invUC_invLC_EC != NULL)
+        {
+            free(invUC_invLC_EC);
+        }
+
+        SELECT = (int*)malloc(ncv * sizeof(int));
+        memset(SELECT, 0, ncv * sizeof(int));
+
+        DC = (doublecomplex*)malloc((nev + 1) * sizeof(doublecomplex));
+        memset(DC, 0, (nev + 1) * sizeof(doublecomplex));
+
+        ZC = (doublecomplex*)malloc(N * nev * sizeof(doublecomplex));
+        memset(ZC, 0, N * nev * sizeof(doublecomplex));
+
+        WORKEVC = (doublecomplex*)malloc(2 * ncv * sizeof(doublecomplex));
+        memset(WORKEVC, 0, 2 * ncv * sizeof(doublecomplex));
+
+        C2F(zneupd)(&RVEC, HOWMNY, SELECT, DC, ZC, &LDV, SIGMA, WORKEVC, bmat, &N, which, &nev, tol, RESIDC, &ncv, VC, &LDV, IPARAM, IPNTR, WORKDC, WORKLC, &LWORKL, RWORK, &INFO_EUPD);
+        if (INFO_EUPD != 0)
+        {
+            free(IPARAM);
+            free(IPNTR);
+            free(R);
+            free(Rprime);
+            free(RC);
+            free(RCprime);
+            free(tmp_WORKD);
+            free(tmp_WORKDC);
+            free(WORKDC);
+            free(WORKLC);
+            free(VC);
+            free(SELECT);
+            free(DC);
+            free(ZC);
+            free(WORKEVC);
+            free(RWORK);
+
+            return -6;
+        }
+        else
+        {
+            if (!RVEC)
+            {
+                for (i = 0; i < nev; i++)
+                {
+                    eigenvalue[i].r = DC[i].r;
+                    eigenvalue[i].i = DC[i].i;
+                }
+            }
+            else  // return eigenvalues and eigenvectors
+            {
+                memcpy(eigenvalue, DC, nev * sizeof(doublecomplex));
+                memcpy(eigenvector, ZC, N * nev * sizeof(doublecomplex));
+            }
+        }
+
+        free(SELECT);
+        free(DC);
+        free(ZC);
+        free(WORKEVC);
+
+        free(VC);
+        free(WORKDC);
+        free(WORKLC);
+        free(RWORK);
+    }
+
+    free(IPARAM);
+    free(IPNTR);
+
+    free(R);
+    free(Rprime);
+    free(RC);
+    free(RCprime);
+
+    return 0;
+}
+
diff --git a/scilab/modules/arnoldi/src/c/eigs_dependencies.c b/scilab/modules/arnoldi/src/c/eigs_dependencies.c
new file mode 100644 (file)
index 0000000..3c97f76
--- /dev/null
@@ -0,0 +1,224 @@
+/*
+ * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
+ * Copyright (C) 2011 - Scilab Enterprises - Adeline CARNIS
+ * 
+ * This file must be used under the terms of the CeCILL.
+ * This source file is licensed as described in the file COPYING, which
+ * you should have received as part of this distribution.  The terms
+ * are also available at    
+ * http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
+ *
+ */
+
+#include "eigs_dependencies.h"
+
+// dgemm performs one of the matrix-matrix operations
+extern int C2F(dgemm)(char* transa, char* transb, int* m, int* n, int* k, double* alpha, double* A, int* lda, double* B, int* ldb, double* beta, double* C, int* ldc); 
+
+// dgetrf computes an LU factorization of a general M by N matrix A (double) using partial pivoting with row interchanges
+extern int C2F(dgetrf)(int* m, int* n, double* A, int* lda, int* ipiv, int* info); 
+
+// dgetri computes the inverse of a matrix using the LU factorization computed by dgetrf
+extern int C2F(dgetri)(int* n, double* A, int* lda, int* ipiv, double* work, int* lworkl, int* info); 
+
+// zgemm performs one of the matrix-matrix operations
+extern int C2F(zgemm)(char* transa, char* transb, int* m, int* n, int* k, doublecomplex* alpha, doublecomplex* A, int* lda,
+       doublecomplex* B, int* ldb, doublecomplex* beta, doublecomplex* C, int* ldc);
+
+// zgetrd computes an LU factorization of a general M by N matrix A (complex*16) using partial pivoting with row interchanges
+extern int C2F(zgetrf)(int* m, int* n, doublecomplex* A, int* lda, int* ipiv, int* info); 
+
+// zgetri computes the inverse of a matrix using the LU factorization computed by zgetrf
+extern int C2F(zgetri)(int* n, doublecomplex* A, int* lda, int* ipiv, doublecomplex* work, int* lworkl, int* info);
+
+static double alpha = 1.;
+static double beta = 0.;
+
+static doublecomplex alphac = {1.,0.};
+static doublecomplex betac = {0.,0.};
+
+void RtimesRprime(double* result, double* R, double* Rprime, int N)
+{
+       C2F(dgemm)("n", "n", &N, &N, &N, &alpha, R, &N, Rprime, &N, &beta, result, &N);
+}
+
+void invR_times_A_times_invRprime(double* result, double* R, double* A, double* Rprime, int N)
+{
+       double* invRxA = NULL;
+       int* IPVT = NULL;
+       double* work = NULL;
+       double* invR = NULL;
+       double* invRprime = NULL;
+       int INFO_LU = 0;
+
+       invRxA = (double*)malloc(N * N * sizeof(double));
+       invR = (double*)malloc(N * N * sizeof(double));
+       invRprime = (double*)malloc(N * N * sizeof(double));
+       work = (double*)malloc(N * N * sizeof(double));
+
+
+       IPVT = (int*) malloc(N * sizeof(int));
+       memset(IPVT, 0, N * sizeof(int));
+
+       // inv(R)
+       memcpy(invR, R, N * N * sizeof(double));   // copy R to invR
+       C2F(dgetrf)(&N, &N, invR ,&N, IPVT, &INFO_LU);  // LU decomposition
+
+       memset(work, 0, N * N * sizeof(double));
+       C2F(dgetri)(&N, invR, &N, IPVT, work, &N, &INFO_LU);  // Obtain inverse matrix R
+
+       // inv(Rprime)
+       memset(IPVT, 0, N * sizeof(int));
+       memcpy(invRprime, Rprime, N * N * sizeof(double));      
+       C2F(dgetrf)(&N, &N, invRprime, &N, IPVT, &INFO_LU);     // LU decomposition
+
+       memset(work, 0, N * N * sizeof(double));
+       C2F(dgetri)(&N, invRprime, &N, IPVT, work, &N,&INFO_LU);        // Obtain inverse matrix Rprime
+
+       C2F(dgemm)("n", "n", &N, &N, &N, &alpha, invR, &N, A, &N, &beta, invRxA, &N);
+
+       C2F(dgemm)("n", "n", &N, &N, &N, &alpha, invRxA, &N, invRprime, &N, &beta, result, &N);
+
+       free(invRxA);
+       free(IPVT);
+       free(work);
+       free(invR);
+       free(invRprime);
+}
+
+void invU_times_invL_times_E(double* result, double* U, double* L, double* E, int N)
+{
+       double* invUxinvL = NULL;
+       int* IPVT = NULL;
+       double* work = NULL;
+       double* invU = NULL;
+       double* invL = NULL;
+       int INFO_LU = 0;
+
+       invUxinvL = (double*)malloc(N * N * sizeof(double));
+       invU = (double*)malloc(N * N * sizeof(double));
+       invL = (double*)malloc(N * N* sizeof(double));
+       work = (double*)malloc(N * N * sizeof(double));
+
+       IPVT = (int*) malloc(N * sizeof(int));
+       memset(IPVT, 0, N * sizeof(int));
+       
+       // inv L -> L obtained with LU decomposition
+       memcpy(invL, L, N * N * sizeof(double));
+       C2F(dgetrf)(&N, &N, invL, &N, IPVT, &INFO_LU); // LU decomposition
+
+       memset(work, 0, N * N * sizeof(double));
+       C2F(dgetri)(&N, invL, &N, IPVT, work, &N, &INFO_LU);  // inv(L)
+
+       // inv U -> U obtained with LU decomposition
+       memcpy(invU, U, N * N * sizeof(double));
+       memset(IPVT, 0, N*sizeof(int));
+       C2F(dgetrf)(&N, &N, invU, &N, IPVT, &INFO_LU); // LU decomposition
+
+       memset(work, 0, N * N * sizeof(double));
+       C2F(dgetri)(&N, invU, &N, IPVT, work, &N, &INFO_LU); // inv(U)
+
+       C2F(dgemm)("n", "n", &N, &N, &N, &alpha, invU, &N, invL, &N, &beta, invUxinvL, &N);
+
+       C2F(dgemm)("n", "n", &N, &N, &N, &alpha, invUxinvL, &N, E, &N, &beta, result, &N);
+
+       free(invUxinvL);
+       free(IPVT);
+       free(work);
+       free(invU);
+       free(invL);
+}
+
+
+void RCtimesRCprime(doublecomplex* result, doublecomplex* R, doublecomplex* Rprime, int N)
+{
+       C2F(zgemm)("n", "n", &N, &N, &N, &alphac, R, &N, Rprime, &N, &betac, result, &N);
+}
+
+void invRC_times_AC_times_invRCprime(doublecomplex* result, doublecomplex* R, doublecomplex* A, doublecomplex* Rprime, int N)
+{
+       doublecomplex* invRxA = NULL;
+       int* IPVT = NULL;
+       doublecomplex* work = NULL;
+       doublecomplex* invR = NULL;
+       doublecomplex* invRprime = NULL;
+       int INFO_LU = 0;
+
+       invRxA = (doublecomplex*)malloc(N * N * sizeof(doublecomplex));
+       invR = (doublecomplex*)malloc(N * N * sizeof(doublecomplex));
+       invRprime = (doublecomplex*)malloc(N * N * sizeof(doublecomplex));
+       work = (doublecomplex*)malloc(N * N * sizeof(doublecomplex));
+
+
+       IPVT = (int*) malloc(N * sizeof(int));
+       memset(IPVT, 0, N * sizeof(int));
+
+       // inv(R)
+       memcpy(invR, R, N * N * sizeof(doublecomplex));   // copy R to invR
+       C2F(zgetrf)(&N, &N, invR ,&N, IPVT, &INFO_LU);  // LU decomposition
+
+       memset(work, 0, N * N * sizeof(doublecomplex));
+       C2F(zgetri)(&N, invR, &N, IPVT, work, &N, &INFO_LU);  // Obtain inverse matrix R
+
+       // inv(Rprime)
+       memset(IPVT, 0, N * sizeof(int));
+       memcpy(invRprime, Rprime, N * N * sizeof(doublecomplex));       
+       C2F(zgetrf)(&N, &N, invRprime, &N, IPVT, &INFO_LU);     // LU decomposition
+
+       memset(work, 0, N * N * sizeof(doublecomplex));
+       C2F(zgetri)(&N, invRprime, &N, IPVT, work, &N,&INFO_LU);        // Obtain inverse matrix Rprime
+
+       C2F(zgemm)("n", "n", &N, &N, &N, &alphac, invR, &N, A, &N, &betac, invRxA, &N);
+
+       C2F(zgemm)("n", "n", &N, &N, &N, &alphac, invRxA, &N, invRprime, &N, &betac, result, &N);
+
+       free(invRxA);
+       free(IPVT);
+       free(work);
+       free(invR);
+       free(invRprime);
+}
+
+
+void invUC_times_invLC_times_EC(doublecomplex* result, doublecomplex* U, doublecomplex* L, doublecomplex* E, int N)
+{
+       doublecomplex* invUxinvL = NULL;
+       int* IPVT = NULL;
+       doublecomplex* work = NULL;
+       doublecomplex* invU = NULL;
+       doublecomplex* invL = NULL;
+       int INFO_LU = 0;
+
+       invUxinvL = (doublecomplex*)malloc(N * N * sizeof(doublecomplex));
+       invU = (doublecomplex*)malloc(N * N * sizeof(doublecomplex));
+       invL = (doublecomplex*)malloc(N * N* sizeof(doublecomplex));
+       work = (doublecomplex*)malloc(N * N * sizeof(doublecomplex));
+
+       IPVT = (int*) malloc(N * sizeof(int));
+       memset(IPVT, 0, N * sizeof(int));
+       
+       // inv L -> L obtained with LU decomposition
+       memcpy(invL, L, N * N * sizeof(doublecomplex));
+       C2F(zgetrf)(&N, &N, invL, &N, IPVT, &INFO_LU); // LU decomposition
+
+       memset(work, 0, N * N * sizeof(doublecomplex));
+       C2F(zgetri)(&N, invL, &N, IPVT, work, &N, &INFO_LU);  // inv(L)
+
+       // inv U -> U obtained with LU decomposition
+       memcpy(invU, U, N * N * sizeof(doublecomplex));
+       memset(IPVT, 0, N*sizeof(int));
+       C2F(zgetrf)(&N, &N, invU, &N, IPVT, &INFO_LU); // LU decomposition
+
+       memset(work, 0, N * N * sizeof(doublecomplex));
+       C2F(zgetri)(&N, invU, &N, IPVT, work, &N, &INFO_LU); // inv(U)
+
+       C2F(zgemm)("n", "n", &N, &N, &N, &alphac, invU, &N, invL, &N, &betac, invUxinvL, &N);
+
+       C2F(zgemm)("n", "n", &N, &N, &N, &alphac, invUxinvL, &N, E, &N, &betac, result, &N);
+
+       free(invUxinvL);
+       free(IPVT);
+       free(work);
+       free(invU);
+       free(invL);
+}
\ No newline at end of file
diff --git a/scilab/modules/arnoldi/tests/unit_tests/eigs.dia.ref b/scilab/modules/arnoldi/tests/unit_tests/eigs.dia.ref
new file mode 100644 (file)
index 0000000..87dc747
--- /dev/null
@@ -0,0 +1,632 @@
+// =============================================================================
+// Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
+// Copyright (C) 2012 - Scilab Enterprises - Adeline CARNIS
+//
+//  This file is distributed under the same license as the Scilab package.
+// =============================================================================
+// <-- CLI SHELL MODE -->
+// unit tests for eigs function 
+// =============================================================================
+// Interface
+// =========
+assert_checkfalse(execstr("eigs()"   ,"errcatch") == 0);
+assert_checkfalse(execstr("eigs(1)","errcatch") == 0);
+assert_checkfalse(execstr("eigs([])", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(%nan)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(%inf)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(%eps)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs([%f %f])", "errcatch") == 0);
+assert_checkfalse(execstr("eigs([%f %f])", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(sparse([%f %f]))", "errcatch") == 0);
+assert_checkfalse(execstr("eigs([1 2])", "errcatch") == 0);
+assert_checkfalse(execstr("eigs([1; 2])", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(sparse([1 2]))", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(sparse([1; 2]))", "errcatch") == 0);
+n = 20;
+A            = diag(10*ones(n,1));
+A(1:$-1,2:$) = A(1:$-1,2:$) + diag(6*ones(n-1,1));
+A(2:$,1:$-1) = A(2:$,1:$-1) + diag(6*ones(n-1,1));
+assert_checkfalse(execstr("eigs(A, %f)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(A, %nan)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(A, %inf)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(A, %eps)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(sparse(A), %f)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(sparse(A), %nan)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(sparse(A), %inf)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(sparse(A), %eps)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(A,[1 2])", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(A,[1;2])", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(sparse(A), [1 2])", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(sparse(A), [1;2])", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(A, [], [])", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(A, [], %f)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(A, [], 2*%i)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(A, [], -15)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(A, [], 5.6)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(A, [], [1 2])", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(A, [], %nan)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(A, [], %eps)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(A, [], %inf)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(sparse(A), [], %f)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(sparse(A), [], 2*%i)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(sparse(A), [], -15)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(sparse(A), [], 5.6)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(sparse(A), [], [1 2])", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(A, [], 4, [])", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(A, [], 4, %nan)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(A, [], 4, %f)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, [])", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, %nan)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, %f)", "errcatch") == 0);
+which = 'ahh';
+assert_checkfalse(execstr("eigs(A, [], 4, which)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which)", "errcatch") == 0);
+which = 'LM';
+assert_checkfalse(execstr("eigs(A, [], 4, which ,%nan)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,%nan)", "errcatch") == 0);
+opts.var = %nan;
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,optsn)", "errcatch") == 0);
+clear opts
+opts.maxiter  = [];
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);
+opts.maxiter  = %nan;
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);
+opts.maxiter  = %f;
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);
+opts.maxiter  = "ahh";
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);
+opts.maxiter = 5.1;
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);
+opts.maxiter = -5.1;
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);
+clear opts
+opts.tol  = [];
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);
+opts.tol  = %nan;
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);
+opts.tol  = %f;
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);
+opts.tol  = "ahh";
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);
+clear opts
+opts.ncv  = %nan;
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);
+opts.ncv  = %f;
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);
+opts.ncv  = "ahh";
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);
+opts.ncv  = %eps;
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);
+opts.ncv  = -5.1;
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);
+opts.ncv  = 5.1;
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);
+opts.ncv = n + 6;
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);
+clear opts
+opts.cholB  = %nan;
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);
+opts.cholB  = %f;
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);
+opts.cholB  = "ahh";
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);
+opts.cholB  = %eps;
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);
+opts.cholB  = -5.1;
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);
+opts.cholB  = 5.1;
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);
+opts.cholB = [];
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);
+clear opts
+opts.resid  = %nan;
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);
+opts.resid  = %f;
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);
+opts.resid  = "ahh";
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);
+opts.resid  = %eps;
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);
+opts.resid  = [1 2];
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);
+opts.resid  = [1;2];
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);
+opts.resid = [];
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);
+clear opts
+opts.issym = 0;
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);
+clear opts
+opts.isreal = 0;
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);
+clear opts
+n = 20;
+k = 5;
+A            = diag(10*ones(n,1));
+A(1:$-1,2:$) = A(1:$-1,2:$) + diag(6*ones(n-1,1));
+A(2:$,1:$-1) = A(2:$,1:$-1) + diag(6*ones(n-1,1));
+A = sparse(A);
+d1 = eigs(A, [], k);
+d0 = spec(full(A));
+assert_checkalmostequal(d1, d0(($-k+1):$), 1.e-10);
+d1 = eigs(A, [], k, 'LM');
+assert_checkalmostequal(d1, d0(($-k+1):$), 1.e-10);
+d1 = eigs(A, [], k, 'SM');
+assert_checkalmostequal(d1, d0(1:k), 1.e-10); 
+d1 = eigs(A, [], k, 'LA');
+assert_checkalmostequal(d1, d0(($-k+1):$), 1.e-10);
+d1 = eigs(A, [], k, 'SA');
+assert_checkalmostequal(d1, d0(k:-1:1), 1.e-10);
+d1 = eigs(A, [], k, 'BE');
+assert_checkalmostequal(d1, d0(($-k+1):$), 1.e-10);
+d1 = eigs(A, [], k, 2); 
+assert_checkalmostequal(d1, d0(3:3+k-1), 1.e-10); 
+d1 = eigs(A, speye(n,n), k, 'LM');
+assert_checkalmostequal(d1, d0(($-k+1):$), 1.e-10);
+d1 = eigs(A, speye(n,n), k, 2);
+assert_checkalmostequal(d1, d0(3:3+k-1), 1.e-10);  
+opts.cholB = 1;
+d1 = eigs(A, speye(n,n), k, 'LM', opts); 
+assert_checkalmostequal(d1, d0(($-k+1):$), 1.e-10);
+opts.cholB = 1;
+d1 = eigs(A, speye(n,n), k, 2, opts); 
+assert_checkalmostequal(eigs(A, [],k, 2), d0(3:3+k-1), 1.e-10);
+[d1, v1] = eigs(A, [], k, 'LM');
+assert_checkalmostequal(A*v1, v1*d1,sqrt(%eps), 1.e-10);
+[d1, v1] = eigs(A, [], k, 'SM');
+assert_checkalmostequal(A*v1, v1*d1,sqrt(%eps), 1.e-10);
+[d1, v1] = eigs(A, [], k, 'LA');
+assert_checkalmostequal(A*v1, v1*d1,sqrt(%eps), 1.e-10);
+[d1, v1] = eigs(A, [], k, 'SA');
+assert_checkalmostequal(A*v1, v1*d1,sqrt(%eps), 1.e-10);
+[d1, v1] = eigs(A, [], k, 'BE');
+assert_checkalmostequal(A*v1, v1*d1,sqrt(%eps), 1.e-10);
+n = 20;
+k = 5;
+A            = diag((1:n));
+A(1:$-1,2:$) = A(1:$-1,2:$) + diag(6*ones(n-1,1));
+A(2:$,1:$-1) = A(2:$,1:$-1) + diag(-6*ones(n-1,1));
+A = sparse(A);
+d1 = eigs(A, [], k);
+d0 = gsort(spec(full(A)));
+assert_checkalmostequal(abs(d1), abs(d0(k+2-1:-1:2)), 1.e-10); 
+d1 = eigs(A, [], k, 'LM');
+assert_checkalmostequal(abs(d1), abs(d0(k+2-1:-1:2)), 1.e-10);
+d1 = eigs(A, [], k, 'SM');
+assert_checkalmostequal(abs(d1), abs(d0($-k:$-1)), 1.e-10);
+d1 = eigs(A, [], k, 'LR');
+assert_checkalmostequal(real(d1), real(d0(k+2-1:-1:2)), 1.e-10);
+d1 = eigs(A, [], k, 'SR');
+assert_checkalmostequal(real(d1), gsort(real(d0([13 14 18 19 20]))), 1.e-10);
+d1 = eigs(A, [], k, 'LI');
+assert_checkalmostequal(abs(imag(d1)), abs(imag(d0([3 4 2 1 18]))), 1.e-10);
+d1 = eigs(A, [], k, 'SI');
+assert_checkalmostequal(abs(imag(d1)), abs(imag(d0([9 10 11 12 15]))), 1.e-10);
+d1 = eigs(A, [], k, 2); 
+assert_checkalmostequal(abs(d1), abs(d0([19 20 12 11 15])), 1.e-10);
+d1 = eigs(A, speye(n,n), k, 'LM');
+assert_checkalmostequal(abs(d1), abs(d0(k+2-1:-1:2)), 1.e-10);
+d1 = eigs(A, speye(n,n), k, 2);
+assert_checkalmostequal(abs(d1), abs(d0([19 20 12 11 15])), 1.e-10);
+opts.cholB = 1;
+d1 = eigs(A, speye(n,n), k, 'LM', opts);
+assert_checkalmostequal(abs(d1), abs(d0(k+2-1:-1:2)), 1.e-10);
+opts.cholB = 1;
+d1 = eigs(A, speye(n,n), k, 2, opts);
+assert_checkalmostequal(abs(d1), abs(d0([19 20 12 11 15])), 1.e-10);
+[d1, v1] = eigs(A, [], k, 'LM');
+assert_checkalmostequal(A*v1, v1*d1,sqrt(%eps), 1.e-10);
+[d1, v1] = eigs(A, [], k, 'SM');
+assert_checkalmostequal(A*v1, v1*d1,sqrt(%eps), 1.e-10);
+[d1, v1] = eigs(A, [], k, 'LR');
+assert_checkalmostequal(A*v1, v1*d1,sqrt(%eps), 1.e-10);
+[d1, v1] = eigs(A, [], k, 'SR');
+assert_checkalmostequal(A*v1, v1*d1,sqrt(%eps), 1.e-10);
+[d1, v1] = eigs(A, [], k, 'LI');
+assert_checkalmostequal(A*v1, v1*d1,sqrt(%eps), 1.e-10);
+[d1, v1] = eigs(A, [], k, 'SI');
+assert_checkalmostequal(A*v1, v1*d1,sqrt(%eps), 1.e-10);
+n = 20;
+k = 5;
+A            = diag((1:n) + %i * ones(1,n));
+A(1:$-1,2:$) = A(1:$-1,2:$) + diag(6*ones(n-1,1));
+A(2:$,1:$-1) = A(2:$,1:$-1) + diag(-6*ones(n-1,1));
+A = sparse(A);
+d1 = eigs(A, [], k);
+d0 = gsort(spec(full(A)));
+r = gsort(real(d0));
+im = gsort(imag(d0));
+assert_checkalmostequal(abs(d1), abs(d0(k:-1:1)), 1.e-10);
+d1 = eigs(A, [], k, 'LM');
+assert_checkalmostequal(abs(d1), abs(d0(k:-1:1)), 1.e-10); 
+//d1 = eigs(A, [], k, 'SM');
+//assert_checkalmostequal(abs(d1), abs(d0(1:k)), 1.e-14); // error -> impossible to invert complex sparse matrix
+d1 = eigs(A, [], k, 'LR');
+assert_checkalmostequal(real(d1), real(d0(k:-1:1)), 1.e-10);
+d1 = eigs(A, [], k, 'SR');
+assert_checkalmostequal(real(d1), r($-k+1:$), 1.e-10);
+d1 = eigs(A, [], k, 'LI');
+assert_checkalmostequal(imag(d1), im(k:-1:1), 1.e-10); 
+d1 = eigs(A, [], k, 'SI');
+assert_checkalmostequal(imag(d1), im($-k+1:$), 1.e-10); 
+d1 = eigs(A, speye(n,n), k, 'LM');
+assert_checkalmostequal(abs(d1), abs(d0(k:-1:1)), 1.e-10); 
+opts.cholB = 1;
+d1 = eigs(A, speye(n,n), k, 'LM', opts);
+assert_checkalmostequal(abs(d1), abs(d0(k:-1:1)), 1.e-10); 
+[d1, v1] = eigs(A, [], k, 'LM');
+assert_checkalmostequal(A*v1, v1*d1,sqrt(%eps), 1.e-10);
+[d1, v1] = eigs(A, [], k, 'LR');
+assert_checkalmostequal(A*v1, v1*d1,sqrt(%eps), 1.e-10);
+[d1, v1] = eigs(A, [], k, 'SR');
+assert_checkalmostequal(A*v1, v1*d1,sqrt(%eps), 1.e-10);
+[d1, v1] = eigs(A, [], k, 'LI');
+assert_checkalmostequal(A*v1, v1*d1,sqrt(%eps), 1.e-10);
+[d1, v1] = eigs(A, [], k, 'SI');
+assert_checkalmostequal(A*v1, v1*d1,sqrt(%eps), 1.e-10);
+n = 20;
+k = 5;
+A            = diag(10*ones(n,1));
+A(1:$-1,2:$) = A(1:$-1,2:$) + diag(6*ones(n-1,1));
+A(2:$,1:$-1) = A(2:$,1:$-1) + diag(6*ones(n-1,1));
+d1 = eigs(A, [], k);
+d0 = spec(A);
+assert_checkalmostequal(d1, d0(($-k+1):$), 1.e-10);
+d1 = eigs(A, [], k, 'LM');
+assert_checkalmostequal(d1, d0(($-k+1):$), 1.e-10);
+d1 = eigs(A, [], k, 'SM');
+assert_checkalmostequal(d1, d0(1:k), 1.e-10); 
+d1 = eigs(A, [], k, 'LA');
+assert_checkalmostequal(d1, d0(($-k+1):$), 1.e-10);
+d1 = eigs(A, [], k, 'SA');
+assert_checkalmostequal(d1, d0(k:-1:1), 1.e-10);
+d1 = eigs(A, [], k, 'BE');
+assert_checkalmostequal(d1, d0(($-k+1):$), 1.e-10);
+d1 = eigs(A, [], k, 2); 
+assert_checkalmostequal(d1, d0(3:3+k-1), 1.e-10); 
+d1 = eigs(A, eye(n,n), k, 'LM');
+assert_checkalmostequal(d1, d0(($-k+1):$), 1.e-10);
+d1 = eigs(A, eye(n,n), k, 2);
+assert_checkalmostequal(d1, d0(3:3+k-1), 1.e-10);  
+opts.cholB = 1;
+d1 = eigs(A, eye(n,n), k, 'LM', opts); 
+assert_checkalmostequal(d1, d0(($-k+1):$), 1.e-10);
+opts.cholB = 1;
+d1 = eigs(A, eye(n,n), k, 2, opts); 
+assert_checkalmostequal(eigs(A, [],k, 2), d0(3:3+k-1), 1.e-10);
+[d1, v1] = eigs(A, [], k, 'LM');
+assert_checkalmostequal(A*v1, v1*d1,sqrt(%eps), 1.e-10);
+[d1, v1] = eigs(A, [], k, 'SM');
+assert_checkalmostequal(A*v1, v1*d1,sqrt(%eps), 1.e-10);
+[d1, v1] = eigs(A, [], k, 'LA');
+assert_checkalmostequal(A*v1, v1*d1,sqrt(%eps), 1.e-10);
+[d1, v1] = eigs(A, [], k, 'SA');
+assert_checkalmostequal(A*v1, v1*d1,sqrt(%eps), 1.e-10);
+[d1, v1] = eigs(A, [], k, 'BE');
+assert_checkalmostequal(A*v1, v1*d1,sqrt(%eps), 1.e-10);
+n = 20;
+k = 5;
+A            = diag((1:n));
+A(1:$-1,2:$) = A(1:$-1,2:$) + diag(6*ones(n-1,1));
+A(2:$,1:$-1) = A(2:$,1:$-1) + diag(-6*ones(n-1,1));
+d1 = eigs(A, [], k);
+d0 = gsort(spec(A));
+assert_checkalmostequal(abs(d1), abs(d0(k+2-1:-1:2)), 1.e-10); 
+d1 = eigs(A, [], k, 'LM');
+assert_checkalmostequal(abs(d1), abs(d0(k+2-1:-1:2)), 1.e-10);
+d1 = eigs(A, [], k, 'SM');
+assert_checkalmostequal(abs(d1), abs(d0($-k:$-1)), 1.e-10);
+d1 = eigs(A, [], k, 'LR');
+assert_checkalmostequal(real(d1), real(d0(k+2-1:-1:2)), 1.e-10);
+d1 = eigs(A, [], k, 'SR');
+assert_checkalmostequal(real(d1), gsort(real(d0([13 14 18 19 20]))), 1.e-10);
+d1 = eigs(A, [], k, 'LI');
+assert_checkalmostequal(abs(imag(d1)), abs(imag(d0([3 4 2 1 18]))), 1.e-10);
+d1 = eigs(A, [], k, 'SI');
+assert_checkalmostequal(abs(imag(d1)), abs(imag(d0([9 10 11 12 15]))), 1.e-10);
+d1 = eigs(A, [], k, 2); 
+assert_checkalmostequal(abs(d1), abs(d0([19 20 12 11 15])), 1.e-10);
+d1 = eigs(A, eye(n,n), k, 'LM');
+assert_checkalmostequal(abs(d1), abs(d0(k+2-1:-1:2)), 1.e-10);
+d1 = eigs(A, eye(n,n), k, 2);
+assert_checkalmostequal(abs(d1), abs(d0([19 20 12 11 15])), 1.e-10);
+opts.cholB = 1;
+d1 = eigs(A, eye(n,n), k, 'LM', opts);
+assert_checkalmostequal(abs(d1), abs(d0(k+2-1:-1:2)), 1.e-10);
+opts.cholB = 1;
+d1 = eigs(A, eye(n,n), k, 2, opts);
+assert_checkalmostequal(abs(d1), abs(d0([19 20 12 11 15])), 1.e-10);
+[d1, v1] = eigs(A, [], k, 'LM');
+assert_checkalmostequal(A*v1, v1*d1,sqrt(%eps), 1.e-10);
+[d1, v1] = eigs(A, [], k, 'SM');
+assert_checkalmostequal(A*v1, v1*d1,sqrt(%eps), 1.e-10);
+[d1, v1] = eigs(A, [], k, 'LR');
+assert_checkalmostequal(A*v1, v1*d1,sqrt(%eps), 1.e-10);
+[d1, v1] = eigs(A, [], k, 'SR');
+assert_checkalmostequal(A*v1, v1*d1,sqrt(%eps), 1.e-10);
+[d1, v1] = eigs(A, [], k, 'LI');
+assert_checkalmostequal(A*v1, v1*d1,sqrt(%eps), 1.e-10);
+[d1, v1] = eigs(A, [], k, 'SI');
+assert_checkalmostequal(A*v1, v1*d1,sqrt(%eps), 1.e-10);
+n = 20;
+k = 5;
+A            = diag((1:n) + %i * ones(1,n));
+A(1:$-1,2:$) = A(1:$-1,2:$) + diag(6*ones(n-1,1));
+A(2:$,1:$-1) = A(2:$,1:$-1) + diag(-6*ones(n-1,1));
+d1 = eigs(A, [], k);
+d0 = gsort(spec(A));
+r = gsort(real(d0));
+im = gsort(imag(d0));
+assert_checkalmostequal(abs(d1), abs(d0(k:-1:1)), 1.e-10);
+d1 = eigs(A, [], k, 'LM');
+assert_checkalmostequal(abs(d1), abs(d0(k:-1:1)), 1.e-10);
+d1 = eigs(A, [], k, 'SM');
+assert_checkalmostequal(abs(d1), abs(d0($-k+1:$)), 1.e-10); 
+d1 = eigs(A, [], k, 'LR');
+assert_checkalmostequal(real(d1), r(k:-1:1), 1.e-10);
+d1 = eigs(A, [], k, 'SR');
+assert_checkalmostequal(real(d1), r($-k+1:$), 1.e-10);  
+d1 = eigs(A, [], k, 'LI');
+assert_checkalmostequal(imag(d1), im(k:-1:1), 1.e-10); 
+d1 = eigs(A, [], k, 'SI');
+assert_checkalmostequal(imag(d1), im($-k+1:$), 1.e-10);
+d1 = eigs(A, [], k, 2); 
+assert_checkalmostequal(gsort(abs(d1)), gsort(abs(d0($-1:-1:$-k))), 1.e-10);
+d1 = eigs(A, eye(n,n), k, 'LM');
+assert_checkalmostequal(abs(d1), abs(d0(k:-1:1)), 1.e-10);
+opts.cholB = 1;
+d1 = eigs(A, eye(n,n), k, 'LM', opts);
+assert_checkalmostequal(abs(d1), abs(d0(k:-1:1)), 1.e-10); 
+opts.cholB = 1;
+d1 = eigs(A, eye(n,n), k, 2, opts);
+assert_checkalmostequal(abs(eigs(A, [], k, 2)), abs(d1), 1.e-10);  
+[d1, v1] = eigs(A, [], k, 'LM');
+assert_checkalmostequal(A*v1, v1*d1, sqrt(%eps), 1.e-10);
+[d1, v1] = eigs(A, [], k, 'LR');
+assert_checkalmostequal(A*v1, v1*d1, sqrt(%eps), 1.e-10);
+[d1, v1] = eigs(A, [], k, 'SR');
+assert_checkalmostequal(A*v1, v1*d1, sqrt(%eps), 1.e-10);
+[d1, v1] = eigs(A, [], k, 'LI');
+assert_checkalmostequal(A*v1, v1*d1, sqrt(%eps), 1.e-10);
+[d1, v1] = eigs(A, [], k, 'SI');
+assert_checkalmostequal(A*v1, v1*d1, sqrt(%eps), 1.e-10);
+clear opts
+// Tests : A is a function
+// Sparse matrix tests
+n = 20;
+k = 5;
+A            = diag(10*ones(n,1));
+A(1:$-1,2:$) = A(1:$-1,2:$) + diag(6*ones(n-1,1));
+A(2:$,1:$-1) = A(2:$,1:$-1) + diag(6*ones(n-1,1));
+A = sparse(A);
+function y = fn(x)
+    y = A * x;
+endfunction
+opts.isreal = 1;
+opts.issym = 1;
+d1 = eigs(fn, n, [], k, 'LM', opts );
+d0 = spec(full(A));
+assert_checkalmostequal(d1, d0(($-k+1):$), 1.e-10);
+function y = fn(x)
+    y = A \x;
+endfunction
+Attention : Redéfinition de la fonction : fn                      . Utilisez funcprot(0) pour ne pas afficher ce message.
+
+opts.isreal = 1;
+opts.issym = 1;
+d1 = eigs(fn, n, [], k, 'SM', opts );
+assert_checkalmostequal(d1, d0(1:k), 1.e-10);
+function y = fn(x)
+    y = (A - 2 * speye(n,n)) \x;
+endfunction
+Attention : Redéfinition de la fonction : fn                      . Utilisez funcprot(0) pour ne pas afficher ce message.
+
+opts.isreal = 1;
+opts.issym = 1;
+d1 = eigs(fn, n, [], k, 2, opts);
+assert_checkalmostequal(d1, d0(3:3+k-1), 1.e-10);
+n = 20;
+k = 5;
+A            = diag((1:n));
+A(1:$-1,2:$) = A(1:$-1,2:$) + diag(6*ones(n-1,1));
+A(2:$,1:$-1) = A(2:$,1:$-1) + diag(-6*ones(n-1,1));
+A = sparse(A);
+function y = fn(x)
+    y = A * x;
+endfunction
+Attention : Redéfinition de la fonction : fn                      . Utilisez funcprot(0) pour ne pas afficher ce message.
+
+opts.isreal = 1;
+opts.issym = 0;
+d1 = eigs(fn, n, [], k, 'LM', opts );
+d0 = gsort(spec(full(A)));
+assert_checkalmostequal(abs(d1), abs(d0(k+2-1:-1:2)), 1.e-10);
+function y = fn(x)
+    y = A \x;
+endfunction
+Attention : Redéfinition de la fonction : fn                      . Utilisez funcprot(0) pour ne pas afficher ce message.
+
+opts.isreal = 1;
+opts.issym = 0;
+d1 = eigs(fn, n, [], k, 'SM', opts );
+assert_checkalmostequal(abs(d1), abs(d0($-k:$-1)), 1.e-10);
+function y = fn(x)
+    y = (A - 2 * speye(n,n)) \x;
+endfunction
+Attention : Redéfinition de la fonction : fn                      . Utilisez funcprot(0) pour ne pas afficher ce message.
+
+opts.isreal = 1;
+opts.issym = 0;
+d1 = eigs(fn, n, [], k, 2, opts );
+assert_checkalmostequal(abs(d1), abs(d0([19 20 12 11 15])), 1.e-10);
+n = 20;
+k = 5;
+A            = diag((1:n) + %i * ones(1,n));
+A(1:$-1,2:$) = A(1:$-1,2:$) + diag(6*ones(n-1,1));
+A(2:$,1:$-1) = A(2:$,1:$-1) + diag(-6*ones(n-1,1));
+A = sparse(A);
+function y = fn(x)
+    y = A * x;
+endfunction
+Attention : Redéfinition de la fonction : fn                      . Utilisez funcprot(0) pour ne pas afficher ce message.
+
+opts.isreal = 0;
+opts.issym = 0;
+d1 = eigs(fn, n, [], k, 'LM', opts );
+d0 = gsort(spec(full(A)));
+r = gsort(real(d0));
+im = gsort(imag(d0));
+assert_checkalmostequal(abs(d1), abs(d0(k:-1:1)), 1.e-10);
+function y = fn(x)
+    y = A \x;
+endfunction
+Attention : Redéfinition de la fonction : fn                      . Utilisez funcprot(0) pour ne pas afficher ce message.
+
+opts.isreal = 0;
+opts.issym = 0;
+d1 = eigs(fn, n, [], k, 'SM', opts );
+assert_checkalmostequal(abs(d1), abs(d0($-k+1:$)), 1.e-10); 
+function y = fn(x)
+    y = (A - 2 * speye(n,n)) \x;
+endfunction
+Attention : Redéfinition de la fonction : fn                      . Utilisez funcprot(0) pour ne pas afficher ce message.
+
+opts.isreal = 0;
+opts.issym = 0;
+d1 = eigs(fn, n, [], k, 2, opts );
+assert_checkalmostequal(gsort(abs(d1)), gsort(abs(d0($-1:-1:$-k))), 1.e-10);
+clear opts
+// Full matrix tests
+n = 20;
+k = 5;
+A            = diag(10*ones(n,1));
+A(1:$-1,2:$) = A(1:$-1,2:$) + diag(6*ones(n-1,1));
+A(2:$,1:$-1) = A(2:$,1:$-1) + diag(6*ones(n-1,1));
+function y = fn(x)
+    y = A * x;
+endfunction
+Attention : Redéfinition de la fonction : fn                      . Utilisez funcprot(0) pour ne pas afficher ce message.
+
+opts.isreal = 1;
+opts.issym = 1;
+d1 = eigs(fn, n, [], k, 'LM', opts );
+d0 = spec(A);
+assert_checkalmostequal(d1, d0(($-k+1):$), 1.e-10);
+function y = fn(x)
+    y = A \x;
+endfunction
+Attention : Redéfinition de la fonction : fn                      . Utilisez funcprot(0) pour ne pas afficher ce message.
+
+opts.isreal = 1;
+opts.issym = 1;
+d1 = eigs(fn, n, [], k, 'SM', opts );
+assert_checkalmostequal(d1, d0(1:k), 1.e-10);
+function y = fn(x)
+    y = (A - 2 * speye(n,n)) \x;
+endfunction
+Attention : Redéfinition de la fonction : fn                      . Utilisez funcprot(0) pour ne pas afficher ce message.
+
+opts.isreal = 1;
+opts.issym = 1;
+d1 = eigs(fn, n, [], k, 2, opts);
+assert_checkalmostequal(d1, d0(3:3+k-1), 1.e-10);
+n = 20;
+k = 5;
+A            = diag((1:n));
+A(1:$-1,2:$) = A(1:$-1,2:$) + diag(6*ones(n-1,1));
+A(2:$,1:$-1) = A(2:$,1:$-1) + diag(-6*ones(n-1,1));
+function y = fn(x)
+    y = A * x;
+endfunction
+Attention : Redéfinition de la fonction : fn                      . Utilisez funcprot(0) pour ne pas afficher ce message.
+
+opts.isreal = 1;
+opts.issym = 0;
+d1 = eigs(fn, n, [], k, 'LM', opts );
+d0 = gsort(spec(A));
+assert_checkalmostequal(abs(d1), abs(d0(k+2-1:-1:2)), 1.e-10);
+function y = fn(x)
+    y = A \x;
+endfunction
+Attention : Redéfinition de la fonction : fn                      . Utilisez funcprot(0) pour ne pas afficher ce message.
+
+opts.isreal = 1;
+opts.issym = 0;
+d1 = eigs(fn, n, [], k, 'SM', opts );
+assert_checkalmostequal(abs(d1), abs(d0($-k:$-1)), 1.e-10);
+function y = fn(x)
+    y = (A - 2 * speye(n,n)) \x;
+endfunction
+Attention : Redéfinition de la fonction : fn                      . Utilisez funcprot(0) pour ne pas afficher ce message.
+
+opts.isreal = 1;
+opts.issym = 0;
+d1 = eigs(fn, n, [], k, 2, opts );
+assert_checkalmostequal(abs(d1), abs(d0([19 20 12 11 15])), 1.e-10);
+n = 20;
+k = 5;
+A            = diag((1:n) + %i * ones(1,n));
+A(1:$-1,2:$) = A(1:$-1,2:$) + diag(6*ones(n-1,1));
+A(2:$,1:$-1) = A(2:$,1:$-1) + diag(-6*ones(n-1,1));
+function y = fn(x)
+    y = A * x;
+endfunction
+Attention : Redéfinition de la fonction : fn                      . Utilisez funcprot(0) pour ne pas afficher ce message.
+
+opts.isreal = 0;
+opts.issym = 0;
+d1 = eigs(fn, n, [], k, 'LM', opts );
+d0 = gsort(spec(A));
+r = gsort(real(d0));
+im = gsort(imag(d0));
+assert_checkalmostequal(abs(d1), abs(d0(k:-1:1)), 1.e-10);
+function y = fn(x)
+    y = A \x;
+endfunction
+Attention : Redéfinition de la fonction : fn                      . Utilisez funcprot(0) pour ne pas afficher ce message.
+
+opts.isreal = 0;
+opts.issym = 0;
+d1 = eigs(fn, n, [], k, 'SM', opts );
+assert_checkalmostequal(abs(d1), abs(d0($-k+1:$)), 1.e-10); 
+function y = fn(x)
+    y = (A - 2 * speye(n,n)) \x;
+endfunction
+Attention : Redéfinition de la fonction : fn                      . Utilisez funcprot(0) pour ne pas afficher ce message.
+
+opts.isreal = 0;
+opts.issym = 0;
+d1 = eigs(fn, n, [], k, 2, opts );
+assert_checkalmostequal(gsort(abs(d1)), gsort(abs(d0($-1:-1:$-k))), 1.e-10);
diff --git a/scilab/modules/arnoldi/tests/unit_tests/eigs.tst b/scilab/modules/arnoldi/tests/unit_tests/eigs.tst
new file mode 100644 (file)
index 0000000..5b13f56
--- /dev/null
@@ -0,0 +1,791 @@
+// =============================================================================\r
+// Scilab ( http://www.scilab.org/ ) - This file is part of Scilab\r
+// Copyright (C) 2012 - Scilab Enterprises - Adeline CARNIS\r
+//\r
+//  This file is distributed under the same license as the Scilab package.\r
+// =============================================================================\r
+\r
+// <-- CLI SHELL MODE -->\r
+\r
+// unit tests for eigs function \r
+// =============================================================================\r
+\r
+// Interface\r
+// =========\r
+assert_checkfalse(execstr("eigs()"   ,"errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(1)","errcatch") == 0);\r
+assert_checkfalse(execstr("eigs([])", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(%nan)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(%inf)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(%eps)", "errcatch") == 0);\r
+\r
+assert_checkfalse(execstr("eigs([%f %f])", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs([%f %f])", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(sparse([%f %f]))", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs([1 2])", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs([1; 2])", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(sparse([1 2]))", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(sparse([1; 2]))", "errcatch") == 0);\r
+\r
+n = 20;\r
+A            = diag(10*ones(n,1));\r
+A(1:$-1,2:$) = A(1:$-1,2:$) + diag(6*ones(n-1,1));\r
+A(2:$,1:$-1) = A(2:$,1:$-1) + diag(6*ones(n-1,1));\r
+\r
+assert_checkfalse(execstr("eigs(A, %f)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(A, %nan)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(A, %inf)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(A, %eps)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(sparse(A), %f)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(sparse(A), %nan)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(sparse(A), %inf)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(sparse(A), %eps)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(A,[1 2])", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(A,[1;2])", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(sparse(A), [1 2])", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(sparse(A), [1;2])", "errcatch") == 0);\r
+\r
+assert_checkfalse(execstr("eigs(A, [], [])", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(A, [], %f)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(A, [], 2*%i)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(A, [], -15)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(A, [], 5.6)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(A, [], [1 2])", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(A, [], %nan)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(A, [], %eps)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(A, [], %inf)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(sparse(A), [], %f)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(sparse(A), [], 2*%i)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(sparse(A), [], -15)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(sparse(A), [], 5.6)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(sparse(A), [], [1 2])", "errcatch") == 0);\r
+\r
+assert_checkfalse(execstr("eigs(A, [], 4, [])", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(A, [], 4, %nan)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(A, [], 4, %f)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, [])", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, %nan)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, %f)", "errcatch") == 0);\r
+which = 'ahh';\r
+assert_checkfalse(execstr("eigs(A, [], 4, which)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which)", "errcatch") == 0);\r
+\r
+which = 'LM';\r
+assert_checkfalse(execstr("eigs(A, [], 4, which ,%nan)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,%nan)", "errcatch") == 0);\r
+opts.var = %nan;\r
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,optsn)", "errcatch") == 0);\r
+\r
+clear opts\r
+opts.maxiter  = [];\r
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);\r
+opts.maxiter  = %nan;\r
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);\r
+opts.maxiter  = %f;\r
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);\r
+opts.maxiter  = "ahh";\r
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);\r
+opts.maxiter = 5.1;\r
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);\r
+opts.maxiter = -5.1;\r
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);\r
+\r
+clear opts\r
+opts.tol  = [];\r
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);\r
+opts.tol  = %nan;\r
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);\r
+opts.tol  = %f;\r
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);\r
+opts.tol  = "ahh";\r
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);\r
+\r
+clear opts\r
+opts.ncv  = %nan;\r
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);\r
+opts.ncv  = %f;\r
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);\r
+opts.ncv  = "ahh";\r
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);\r
+opts.ncv  = %eps;\r
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);\r
+opts.ncv  = -5.1;\r
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);\r
+opts.ncv  = 5.1;\r
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);\r
+opts.ncv = n + 6;\r
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);\r
+\r
+clear opts\r
+opts.cholB  = %nan;\r
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);\r
+opts.cholB  = %f;\r
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);\r
+opts.cholB  = "ahh";\r
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);\r
+opts.cholB  = %eps;\r
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);\r
+opts.cholB  = -5.1;\r
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);\r
+opts.cholB  = 5.1;\r
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);\r
+opts.cholB = [];\r
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);\r
+\r
+clear opts\r
+opts.resid  = %nan;\r
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);\r
+opts.resid  = %f;\r
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);\r
+opts.resid  = "ahh";\r
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);\r
+opts.resid  = %eps;\r
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);\r
+opts.resid  = [1 2];\r
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);\r
+opts.resid  = [1;2];\r
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);\r
+opts.resid = [];\r
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);\r
+assert_checkfalse(execstr("eigs(sparse(A), [], 4, which ,opts)", "errcatch") == 0);\r
+\r
+clear opts\r
+opts.issym = 0;\r
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);\r
+\r
+clear opts\r
+opts.isreal = 0;\r
+assert_checkfalse(execstr("eigs(A, [], 4, which ,opts)", "errcatch") == 0);\r
+\r
+clear opts\r
+n = 20;\r
+k = 5;\r
+A            = diag(10*ones(n,1));\r
+A(1:$-1,2:$) = A(1:$-1,2:$) + diag(6*ones(n-1,1));\r
+A(2:$,1:$-1) = A(2:$,1:$-1) + diag(6*ones(n-1,1));\r
+A = sparse(A);\r
+\r
+d1 = eigs(A, [], k);\r
+d0 = spec(full(A));\r
+assert_checkalmostequal(d1, d0(($-k+1):$), 1.e-10);\r
+\r
+d1 = eigs(A, [], k, 'LM');\r
+assert_checkalmostequal(d1, d0(($-k+1):$), 1.e-10);\r
+\r
+d1 = eigs(A, [], k, 'SM');\r
+assert_checkalmostequal(d1, d0(1:k), 1.e-10); \r
+\r
+d1 = eigs(A, [], k, 'LA');\r
+assert_checkalmostequal(d1, d0(($-k+1):$), 1.e-10);\r
+\r
+d1 = eigs(A, [], k, 'SA');\r
+assert_checkalmostequal(d1, d0(k:-1:1), 1.e-10);\r
+\r
+d1 = eigs(A, [], k, 'BE');\r
+assert_checkalmostequal(d1, d0(($-k+1):$), 1.e-10);\r
+\r
+d1 = eigs(A, [], k, 2); \r
+assert_checkalmostequal(d1, d0(3:3+k-1), 1.e-10); \r
+\r
+d1 = eigs(A, speye(n,n), k, 'LM');\r
+assert_checkalmostequal(d1, d0(($-k+1):$), 1.e-10);\r
+\r
+d1 = eigs(A, speye(n,n), k, 2);\r
+assert_checkalmostequal(d1, d0(3:3+k-1), 1.e-10);  \r
+\r
+opts.cholB = 1;\r
+d1 = eigs(A, speye(n,n), k, 'LM', opts); \r
+assert_checkalmostequal(d1, d0(($-k+1):$), 1.e-10);\r
+\r
+opts.cholB = 1;\r
+d1 = eigs(A, speye(n,n), k, 2, opts); \r
+assert_checkalmostequal(eigs(A, [],k, 2), d0(3:3+k-1), 1.e-10);\r
+\r
+[d1, v1] = eigs(A, [], k, 'LM');\r
+assert_checkalmostequal(A*v1, v1*d1,sqrt(%eps), 1.e-10);\r
+\r
+[d1, v1] = eigs(A, [], k, 'SM');\r
+assert_checkalmostequal(A*v1, v1*d1,sqrt(%eps), 1.e-10);\r
+\r
+[d1, v1] = eigs(A, [], k, 'LA');\r
+assert_checkalmostequal(A*v1, v1*d1,sqrt(%eps), 1.e-10);\r
+\r
+[d1, v1] = eigs(A, [], k, 'SA');\r
+assert_checkalmostequal(A*v1, v1*d1,sqrt(%eps), 1.e-10);\r
+\r
+[d1, v1] = eigs(A, [], k, 'BE');\r
+assert_checkalmostequal(A*v1, v1*d1,sqrt(%eps), 1.e-10);\r
+\r
+\r
+n = 20;\r
+k = 5;\r
+A            = diag((1:n));\r
+A(1:$-1,2:$) = A(1:$-1,2:$) + diag(6*ones(n-1,1));\r
+A(2:$,1:$-1) = A(2:$,1:$-1) + diag(-6*ones(n-1,1));\r
+A = sparse(A);\r
+\r
+d1 = eigs(A, [], k);\r
+d0 = gsort(spec(full(A)));\r
+\r
+assert_checkalmostequal(abs(d1), abs(d0(k+2-1:-1:2)), 1.e-10); \r
+\r
+d1 = eigs(A, [], k, 'LM');\r
+assert_checkalmostequal(abs(d1), abs(d0(k+2-1:-1:2)), 1.e-10);\r
+\r
+d1 = eigs(A, [], k, 'SM');\r
+assert_checkalmostequal(abs(d1), abs(d0($-k:$-1)), 1.e-10);\r
+\r
+d1 = eigs(A, [], k, 'LR');\r
+assert_checkalmostequal(real(d1), real(d0(k+2-1:-1:2)), 1.e-10);\r
+\r
+d1 = eigs(A, [], k, 'SR');\r
+assert_checkalmostequal(real(d1), gsort(real(d0([13 14 18 19 20]))), 1.e-10);\r
+\r
+d1 = eigs(A, [], k, 'LI');\r
+assert_checkalmostequal(abs(imag(d1)), abs(imag(d0([3 4 2 1 18]))), 1.e-10);\r
+\r
+d1 = eigs(A, [], k, 'SI');\r
+assert_checkalmostequal(abs(imag(d1)), abs(imag(d0([9 10 11 12 15]))), 1.e-10);\r
+\r
+d1 = eigs(A, [], k, 2); \r
+assert_checkalmostequal(abs(d1), abs(d0([19 20 12 11 15])), 1.e-10);\r
+\r
+d1 = eigs(A, speye(n,n), k, 'LM');\r
+assert_checkalmostequal(abs(d1), abs(d0(k+2-1:-1:2)), 1.e-10);\r
+\r
+d1 = eigs(A, speye(n,n), k, 2);\r
+assert_checkalmostequal(abs(d1), abs(d0([19 20 12 11 15])), 1.e-10);\r
+\r
+opts.cholB = 1;\r
+d1 = eigs(A, speye(n,n), k, 'LM', opts);\r
+assert_checkalmostequal(abs(d1), abs(d0(k+2-1:-1:2)), 1.e-10);\r
+\r
+opts.cholB = 1;\r
+d1 = eigs(A, speye(n,n), k, 2, opts);\r
+assert_checkalmostequal(abs(d1), abs(d0([19 20 12 11 15])), 1.e-10);\r
+\r
+[d1, v1] = eigs(A, [], k, 'LM');\r
+assert_checkalmostequal(A*v1, v1*d1,sqrt(%eps), 1.e-10);\r
+\r
+[d1, v1] = eigs(A, [], k, 'SM');\r
+assert_checkalmostequal(A*v1, v1*d1,sqrt(%eps), 1.e-10);\r
+\r
+[d1, v1] = eigs(A, [], k, 'LR');\r
+assert_checkalmostequal(A*v1, v1*d1,sqrt(%eps), 1.e-10);\r
+\r
+[d1, v1] = eigs(A, [], k, 'SR');\r
+assert_checkalmostequal(A*v1, v1*d1,sqrt(%eps), 1.e-10);\r
+\r
+[d1, v1] = eigs(A, [], k, 'LI');\r
+assert_checkalmostequal(A*v1, v1*d1,sqrt(%eps), 1.e-10);\r
+\r
+[d1, v1] = eigs(A, [], k, 'SI');\r
+assert_checkalmostequal(A*v1, v1*d1,sqrt(%eps), 1.e-10);\r
+\r
+n = 20;\r
+k = 5;\r
+A            = diag((1:n) + %i * ones(1,n));\r
+A(1:$-1,2:$) = A(1:$-1,2:$) + diag(6*ones(n-1,1));\r
+A(2:$,1:$-1) = A(2:$,1:$-1) + diag(-6*ones(n-1,1));\r
+A = sparse(A);\r
+\r
+d1 = eigs(A, [], k);\r
+d0 = gsort(spec(full(A)));\r
+r = gsort(real(d0));\r
+im = gsort(imag(d0));\r
+assert_checkalmostequal(abs(d1), abs(d0(k:-1:1)), 1.e-10);\r
+\r
+d1 = eigs(A, [], k, 'LM');\r
+assert_checkalmostequal(abs(d1), abs(d0(k:-1:1)), 1.e-10); \r
+\r
+//d1 = eigs(A, [], k, 'SM');\r
+//assert_checkalmostequal(abs(d1), abs(d0(1:k)), 1.e-14); // error -> impossible to invert complex sparse matrix\r
+\r
+d1 = eigs(A, [], k, 'LR');\r
+assert_checkalmostequal(real(d1), real(d0(k:-1:1)), 1.e-10);\r
+\r
+d1 = eigs(A, [], k, 'SR');\r
+assert_checkalmostequal(real(d1), r($-k+1:$), 1.e-10);\r
+\r
+d1 = eigs(A, [], k, 'LI');\r
+assert_checkalmostequal(imag(d1), im(k:-1:1), 1.e-10); \r
+\r
+d1 = eigs(A, [], k, 'SI');\r
+assert_checkalmostequal(imag(d1), im($-k+1:$), 1.e-10); \r
+\r
+d1 = eigs(A, speye(n,n), k, 'LM');\r
+assert_checkalmostequal(abs(d1), abs(d0(k:-1:1)), 1.e-10); \r
+\r
+opts.cholB = 1;\r
+d1 = eigs(A, speye(n,n), k, 'LM', opts);\r
+assert_checkalmostequal(abs(d1), abs(d0(k:-1:1)), 1.e-10); \r
+\r
+[d1, v1] = eigs(A, [], k, 'LM');\r
+assert_checkalmostequal(A*v1, v1*d1,sqrt(%eps), 1.e-10);\r
+\r
+[d1, v1] = eigs(A, [], k, 'LR');\r
+assert_checkalmostequal(A*v1, v1*d1,sqrt(%eps), 1.e-10);\r
+\r
+[d1, v1] = eigs(A, [], k, 'SR');\r
+assert_checkalmostequal(A*v1, v1*d1,sqrt(%eps), 1.e-10);\r
+\r
+[d1, v1] = eigs(A, [], k, 'LI');\r
+assert_checkalmostequal(A*v1, v1*d1,sqrt(%eps), 1.e-10);\r
+\r
+[d1, v1] = eigs(A, [], k, 'SI');\r
+assert_checkalmostequal(A*v1, v1*d1,sqrt(%eps), 1.e-10);\r
+\r
+\r
+n = 20;\r
+k = 5;\r
+A            = diag(10*ones(n,1));\r
+A(1:$-1,2:$) = A(1:$-1,2:$) + diag(6*ones(n-1,1));\r
+A(2:$,1:$-1) = A(2:$,1:$-1) + diag(6*ones(n-1,1));\r
+\r
+d1 = eigs(A, [], k);\r
+d0 = spec(A);\r
+\r
+assert_checkalmostequal(d1, d0(($-k+1):$), 1.e-10);\r
+\r
+d1 = eigs(A, [], k, 'LM');\r
+assert_checkalmostequal(d1, d0(($-k+1):$), 1.e-10);\r
+\r
+d1 = eigs(A, [], k, 'SM');\r
+assert_checkalmostequal(d1, d0(1:k), 1.e-10); \r
+\r
+d1 = eigs(A, [], k, 'LA');\r
+assert_checkalmostequal(d1, d0(($-k+1):$), 1.e-10);\r
+\r
+d1 = eigs(A, [], k, 'SA');\r
+assert_checkalmostequal(d1, d0(k:-1:1), 1.e-10);\r
+\r
+d1 = eigs(A, [], k, 'BE');\r
+assert_checkalmostequal(d1, d0(($-k+1):$), 1.e-10);\r
+\r
+d1 = eigs(A, [], k, 2); \r
+assert_checkalmostequal(d1, d0(3:3+k-1), 1.e-10); \r
+\r
+d1 = eigs(A, eye(n,n), k, 'LM');\r
+assert_checkalmostequal(d1, d0(($-k+1):$), 1.e-10);\r
+\r
+d1 = eigs(A, eye(n,n), k, 2);\r
+assert_checkalmostequal(d1, d0(3:3+k-1), 1.e-10);  \r
+\r
+opts.cholB = 1;\r
+d1 = eigs(A, eye(n,n), k, 'LM', opts); \r
+assert_checkalmostequal(d1, d0(($-k+1):$), 1.e-10);\r
+\r
+opts.cholB = 1;\r
+d1 = eigs(A, eye(n,n), k, 2, opts); \r
+assert_checkalmostequal(eigs(A, [],k, 2), d0(3:3+k-1), 1.e-10);\r
+\r
+[d1, v1] = eigs(A, [], k, 'LM');\r
+assert_checkalmostequal(A*v1, v1*d1,sqrt(%eps), 1.e-10);\r
+\r
+[d1, v1] = eigs(A, [], k, 'SM');\r
+assert_checkalmostequal(A*v1, v1*d1,sqrt(%eps), 1.e-10);\r
+\r
+[d1, v1] = eigs(A, [], k, 'LA');\r
+assert_checkalmostequal(A*v1, v1*d1,sqrt(%eps), 1.e-10);\r
+\r
+[d1, v1] = eigs(A, [], k, 'SA');\r
+assert_checkalmostequal(A*v1, v1*d1,sqrt(%eps), 1.e-10);\r
+\r
+[d1, v1] = eigs(A, [], k, 'BE');\r
+assert_checkalmostequal(A*v1, v1*d1,sqrt(%eps), 1.e-10);\r
+\r
+n = 20;\r
+k = 5;\r
+A            = diag((1:n));\r
+A(1:$-1,2:$) = A(1:$-1,2:$) + diag(6*ones(n-1,1));\r
+A(2:$,1:$-1) = A(2:$,1:$-1) + diag(-6*ones(n-1,1));\r
+\r
+d1 = eigs(A, [], k);\r
+d0 = gsort(spec(A));\r
+\r
+assert_checkalmostequal(abs(d1), abs(d0(k+2-1:-1:2)), 1.e-10); \r
+\r
+d1 = eigs(A, [], k, 'LM');\r
+assert_checkalmostequal(abs(d1), abs(d0(k+2-1:-1:2)), 1.e-10);\r
+\r
+d1 = eigs(A, [], k, 'SM');\r
+assert_checkalmostequal(abs(d1), abs(d0($-k:$-1)), 1.e-10);\r
+\r
+d1 = eigs(A, [], k, 'LR');\r
+assert_checkalmostequal(real(d1), real(d0(k+2-1:-1:2)), 1.e-10);\r
+\r
+d1 = eigs(A, [], k, 'SR');\r
+assert_checkalmostequal(real(d1), gsort(real(d0([13 14 18 19 20]))), 1.e-10);\r
+\r
+d1 = eigs(A, [], k, 'LI');\r
+assert_checkalmostequal(abs(imag(d1)), abs(imag(d0([3 4 2 1 18]))), 1.e-10);\r
+\r
+d1 = eigs(A, [], k, 'SI');\r
+assert_checkalmostequal(abs(imag(d1)), abs(imag(d0([9 10 11 12 15]))), 1.e-10);\r
+\r
+d1 = eigs(A, [], k, 2); \r
+assert_checkalmostequal(abs(d1), abs(d0([19 20 12 11 15])), 1.e-10);\r
+\r
+d1 = eigs(A, eye(n,n), k, 'LM');\r
+assert_checkalmostequal(abs(d1), abs(d0(k+2-1:-1:2)), 1.e-10);\r
+\r
+d1 = eigs(A, eye(n,n), k, 2);\r
+assert_checkalmostequal(abs(d1), abs(d0([19 20 12 11 15])), 1.e-10);\r
+\r
+opts.cholB = 1;\r
+d1 = eigs(A, eye(n,n), k, 'LM', opts);\r
+assert_checkalmostequal(abs(d1), abs(d0(k+2-1:-1:2)), 1.e-10);\r
+\r
+opts.cholB = 1;\r
+d1 = eigs(A, eye(n,n), k, 2, opts);\r
+assert_checkalmostequal(abs(d1), abs(d0([19 20 12 11 15])), 1.e-10);\r
+\r
+[d1, v1] = eigs(A, [], k, 'LM');\r
+assert_checkalmostequal(A*v1, v1*d1,sqrt(%eps), 1.e-10);\r
+\r
+[d1, v1] = eigs(A, [], k, 'SM');\r
+assert_checkalmostequal(A*v1, v1*d1,sqrt(%eps), 1.e-10);\r
+\r
+[d1, v1] = eigs(A, [], k, 'LR');\r
+assert_checkalmostequal(A*v1, v1*d1,sqrt(%eps), 1.e-10);\r
+\r
+[d1, v1] = eigs(A, [], k, 'SR');\r
+assert_checkalmostequal(A*v1, v1*d1,sqrt(%eps), 1.e-10);\r
+\r
+[d1, v1] = eigs(A, [], k, 'LI');\r
+assert_checkalmostequal(A*v1, v1*d1,sqrt(%eps), 1.e-10);\r
+\r
+[d1, v1] = eigs(A, [], k, 'SI');\r
+assert_checkalmostequal(A*v1, v1*d1,sqrt(%eps), 1.e-10);\r
+\r
+\r
+n = 20;\r
+k = 5;\r
+A            = diag((1:n) + %i * ones(1,n));\r
+A(1:$-1,2:$) = A(1:$-1,2:$) + diag(6*ones(n-1,1));\r
+A(2:$,1:$-1) = A(2:$,1:$-1) + diag(-6*ones(n-1,1));\r
+\r
+d1 = eigs(A, [], k);\r
+d0 = gsort(spec(A));\r
+r = gsort(real(d0));\r
+im = gsort(imag(d0));\r
+\r
+assert_checkalmostequal(abs(d1), abs(d0(k:-1:1)), 1.e-10);\r
+\r
+d1 = eigs(A, [], k, 'LM');\r
+assert_checkalmostequal(abs(d1), abs(d0(k:-1:1)), 1.e-10);\r
+\r
+d1 = eigs(A, [], k, 'SM');\r
+assert_checkalmostequal(abs(d1), abs(d0($-k+1:$)), 1.e-10); \r
+\r
+d1 = eigs(A, [], k, 'LR');\r
+assert_checkalmostequal(real(d1), r(k:-1:1), 1.e-10);\r
+\r
+d1 = eigs(A, [], k, 'SR');\r
+assert_checkalmostequal(real(d1), r($-k+1:$), 1.e-10);  \r
+\r
+d1 = eigs(A, [], k, 'LI');\r
+assert_checkalmostequal(imag(d1), im(k:-1:1), 1.e-10); \r
+\r
+d1 = eigs(A, [], k, 'SI');\r
+assert_checkalmostequal(imag(d1), im($-k+1:$), 1.e-10);\r
+\r
+d1 = eigs(A, [], k, 2); \r
+assert_checkalmostequal(gsort(abs(d1)), gsort(abs(d0($-1:-1:$-k))), 1.e-10);\r
+\r
+d1 = eigs(A, eye(n,n), k, 'LM');\r
+assert_checkalmostequal(abs(d1), abs(d0(k:-1:1)), 1.e-10);\r
+\r
+opts.cholB = 1;\r
+d1 = eigs(A, eye(n,n), k, 'LM', opts);\r
+assert_checkalmostequal(abs(d1), abs(d0(k:-1:1)), 1.e-10); \r
+\r
+opts.cholB = 1;\r
+d1 = eigs(A, eye(n,n), k, 2, opts);\r
+assert_checkalmostequal(abs(eigs(A, [], k, 2)), abs(d1), 1.e-10);  \r
+\r
+[d1, v1] = eigs(A, [], k, 'LM');\r
+assert_checkalmostequal(A*v1, v1*d1, sqrt(%eps), 1.e-10);\r
+\r
+[d1, v1] = eigs(A, [], k, 'LR');\r
+assert_checkalmostequal(A*v1, v1*d1, sqrt(%eps), 1.e-10);\r
+\r
+[d1, v1] = eigs(A, [], k, 'SR');\r
+assert_checkalmostequal(A*v1, v1*d1, sqrt(%eps), 1.e-10);\r
+\r
+[d1, v1] = eigs(A, [], k, 'LI');\r
+assert_checkalmostequal(A*v1, v1*d1, sqrt(%eps), 1.e-10);\r
+\r
+[d1, v1] = eigs(A, [], k, 'SI');\r
+assert_checkalmostequal(A*v1, v1*d1, sqrt(%eps), 1.e-10);\r
+\r
+clear opts\r
+// Tests : A is a function\r
+// Sparse matrix tests\r
+n = 20;\r
+k = 5;\r
+A            = diag(10*ones(n,1));\r
+A(1:$-1,2:$) = A(1:$-1,2:$) + diag(6*ones(n-1,1));\r
+A(2:$,1:$-1) = A(2:$,1:$-1) + diag(6*ones(n-1,1));\r
+A = sparse(A);\r
+\r
+function y = fn(x)\r
+    y = A * x;\r
+endfunction\r
+\r
+opts.isreal = 1;\r
+opts.issym = 1;\r
+\r
+d1 = eigs(fn, n, [], k, 'LM', opts );\r
+d0 = spec(full(A));\r
+assert_checkalmostequal(d1, d0(($-k+1):$), 1.e-10);\r
+\r
+function y = fn(x)\r
+    y = A \x;\r
+endfunction\r
+\r
+opts.isreal = 1;\r
+opts.issym = 1;\r
+\r
+d1 = eigs(fn, n, [], k, 'SM', opts );\r
+assert_checkalmostequal(d1, d0(1:k), 1.e-10);\r
+\r
+function y = fn(x)\r
+    y = (A - 2 * speye(n,n)) \x;\r
+endfunction\r
+\r
+opts.isreal = 1;\r
+opts.issym = 1;\r
+\r
+d1 = eigs(fn, n, [], k, 2, opts);\r
+assert_checkalmostequal(d1, d0(3:3+k-1), 1.e-10);\r
+\r
+n = 20;\r
+k = 5;\r
+A            = diag((1:n));\r
+A(1:$-1,2:$) = A(1:$-1,2:$) + diag(6*ones(n-1,1));\r
+A(2:$,1:$-1) = A(2:$,1:$-1) + diag(-6*ones(n-1,1));\r
+A = sparse(A);\r
+\r
+function y = fn(x)\r
+    y = A * x;\r
+endfunction\r
+\r
+opts.isreal = 1;\r
+opts.issym = 0;\r
+\r
+d1 = eigs(fn, n, [], k, 'LM', opts );\r
+d0 = gsort(spec(full(A)));\r
+assert_checkalmostequal(abs(d1), abs(d0(k+2-1:-1:2)), 1.e-10);\r
+\r
+function y = fn(x)\r
+    y = A \x;\r
+endfunction\r
+\r
+opts.isreal = 1;\r
+opts.issym = 0;\r
+\r
+d1 = eigs(fn, n, [], k, 'SM', opts );\r
+assert_checkalmostequal(abs(d1), abs(d0($-k:$-1)), 1.e-10);\r
+\r
+function y = fn(x)\r
+    y = (A - 2 * speye(n,n)) \x;\r
+endfunction\r
+\r
+opts.isreal = 1;\r
+opts.issym = 0;\r
+\r
+d1 = eigs(fn, n, [], k, 2, opts );\r
+assert_checkalmostequal(abs(d1), abs(d0([19 20 12 11 15])), 1.e-10);\r
+\r
+\r
+n = 20;\r
+k = 5;\r
+A            = diag((1:n) + %i * ones(1,n));\r
+A(1:$-1,2:$) = A(1:$-1,2:$) + diag(6*ones(n-1,1));\r
+A(2:$,1:$-1) = A(2:$,1:$-1) + diag(-6*ones(n-1,1));\r
+A = sparse(A);\r
+\r
+function y = fn(x)\r
+    y = A * x;\r
+endfunction\r
+\r
+opts.isreal = 0;\r
+opts.issym = 0;\r
+\r
+d1 = eigs(fn, n, [], k, 'LM', opts );\r
+d0 = gsort(spec(full(A)));\r
+r = gsort(real(d0));\r
+im = gsort(imag(d0));\r
+assert_checkalmostequal(abs(d1), abs(d0(k:-1:1)), 1.e-10);\r
+\r
+\r
+function y = fn(x)\r
+    y = A \x;\r
+endfunction\r
+\r
+opts.isreal = 0;\r
+opts.issym = 0;\r
+\r
+d1 = eigs(fn, n, [], k, 'SM', opts );\r
+assert_checkalmostequal(abs(d1), abs(d0($-k+1:$)), 1.e-10); \r
+\r
+function y = fn(x)\r
+    y = (A - 2 * speye(n,n)) \x;\r
+endfunction\r
+\r
+opts.isreal = 0;\r
+opts.issym = 0;\r
+\r
+d1 = eigs(fn, n, [], k, 2, opts );\r
+assert_checkalmostequal(gsort(abs(d1)), gsort(abs(d0($-1:-1:$-k))), 1.e-10);\r
+\r
+\r\r
+clear opts\r
+// Full matrix tests\r
+n = 20;\r
+k = 5;\r
+A            = diag(10*ones(n,1));\r
+A(1:$-1,2:$) = A(1:$-1,2:$) + diag(6*ones(n-1,1));\r
+A(2:$,1:$-1) = A(2:$,1:$-1) + diag(6*ones(n-1,1));\r
+\r
+function y = fn(x)\r
+    y = A * x;\r
+endfunction\r
+\r
+opts.isreal = 1;\r
+opts.issym = 1;\r
+\r
+d1 = eigs(fn, n, [], k, 'LM', opts );\r
+d0 = spec(A);\r
+assert_checkalmostequal(d1, d0(($-k+1):$), 1.e-10);\r
+\r
+function y = fn(x)\r
+    y = A \x;\r
+endfunction\r
+\r
+opts.isreal = 1;\r
+opts.issym = 1;\r
+\r
+d1 = eigs(fn, n, [], k, 'SM', opts );\r
+assert_checkalmostequal(d1, d0(1:k), 1.e-10);\r
+\r
+function y = fn(x)\r
+    y = (A - 2 * speye(n,n)) \x;\r
+endfunction\r
+\r
+opts.isreal = 1;\r
+opts.issym = 1;\r
+\r
+d1 = eigs(fn, n, [], k, 2, opts);\r
+assert_checkalmostequal(d1, d0(3:3+k-1), 1.e-10);\r
+\r
+n = 20;\r
+k = 5;\r
+A            = diag((1:n));\r
+A(1:$-1,2:$) = A(1:$-1,2:$) + diag(6*ones(n-1,1));\r
+A(2:$,1:$-1) = A(2:$,1:$-1) + diag(-6*ones(n-1,1));\r
+\r
+function y = fn(x)\r
+    y = A * x;\r
+endfunction\r
+\r
+opts.isreal = 1;\r
+opts.issym = 0;\r
+\r
+d1 = eigs(fn, n, [], k, 'LM', opts );\r
+d0 = gsort(spec(A));\r
+assert_checkalmostequal(abs(d1), abs(d0(k+2-1:-1:2)), 1.e-10);\r
+\r
+function y = fn(x)\r
+    y = A \x;\r
+endfunction\r
+\r
+opts.isreal = 1;\r
+opts.issym = 0;\r
+\r
+d1 = eigs(fn, n, [], k, 'SM', opts );\r
+assert_checkalmostequal(abs(d1), abs(d0($-k:$-1)), 1.e-10);\r
+\r
+function y = fn(x)\r
+    y = (A - 2 * speye(n,n)) \x;\r
+endfunction\r
+\r
+opts.isreal = 1;\r
+opts.issym = 0;\r
+\r
+d1 = eigs(fn, n, [], k, 2, opts );\r
+assert_checkalmostequal(abs(d1), abs(d0([19 20 12 11 15])), 1.e-10);\r
+\r
+\r
+n = 20;\r
+k = 5;\r
+A            = diag((1:n) + %i * ones(1,n));\r
+A(1:$-1,2:$) = A(1:$-1,2:$) + diag(6*ones(n-1,1));\r
+A(2:$,1:$-1) = A(2:$,1:$-1) + diag(-6*ones(n-1,1));\r
+\r
+function y = fn(x)\r
+    y = A * x;\r
+endfunction\r
+\r
+opts.isreal = 0;\r
+opts.issym = 0;\r
+\r
+d1 = eigs(fn, n, [], k, 'LM', opts );\r
+d0 = gsort(spec(A));\r
+r = gsort(real(d0));\r
+im = gsort(imag(d0));\r
+assert_checkalmostequal(abs(d1), abs(d0(k:-1:1)), 1.e-10);\r
+\r
+\r
+function y = fn(x)\r
+    y = A \x;\r
+endfunction\r
+\r
+opts.isreal = 0;\r
+opts.issym = 0;\r
+\r
+d1 = eigs(fn, n, [], k, 'SM', opts );\r
+assert_checkalmostequal(abs(d1), abs(d0($-k+1:$)), 1.e-10); \r
+\r
+function y = fn(x)\r
+    y = (A - 2 * speye(n,n)) \x;\r
+endfunction\r
+\r
+opts.isreal = 0;\r
+opts.issym = 0;\r
+\r
+d1 = eigs(fn, n, [], k, 2, opts );\r
+assert_checkalmostequal(gsort(abs(d1)), gsort(abs(d0($-1:-1:$-k))), 1.e-10);\r
+\r\r