debian/0000755000000000000000000000000011773100734007171 5ustar debian/yorick-soy.keywords0000644000000000000000000000002611772607232013074 0ustar rco ruo sparse matrix debian/rules0000755000000000000000000000045011773100445010247 0ustar #!/usr/bin/make -f %: dh $@ override_dh_auto_build: $(MAKE) COPT_DEFAULT="" \ Y_CFLAGS="$(CFLAGS) $(CPPFLAGS)" \ Y_LDFLAGS="$(LDFLAGS)" override_dh_auto_install-arch: dh_installyorick override_dh_auto_clean: $(MAKE) Y_MAKEDIR=/usr/lib/yorick Y_EXE=/usr/bin/yorick clean debian/changelog0000644000000000000000000000311611773077141011051 0ustar yorick-soy (1.4.0-3) unstable; urgency=low * Fortify (don't rely on yorick to provide right flags) -- Thibaut Paumard Thu, 28 Jun 2012 17:55:13 +0200 yorick-soy (1.4.0-2) unstable; urgency=low * Amend debian/control to abide by Debian Science Policy * Patch Makefile instead of running yorick -batch make.i * Simplfiy debian/rules with short dh notation -- Thibaut Paumard Wed, 27 Jun 2012 15:56:04 +0200 yorick-soy (1.4.0-1) unstable; urgency=low * New upstream release -- Thibaut Paumard Mon, 16 Apr 2012 09:04:34 +0200 yorick-soy (1.2.01-3) unstable; urgency=low * Move to source format "3.0 (quilt)" in order to drop depencedy on dpatch (thanks to Jari Aalto). * Move to section science. * Check against standards version 3.9.3. * Add check target. -- Thibaut Paumard Mon, 05 Mar 2012 11:59:10 +0100 yorick-soy (1.2.01-2) unstable; urgency=low * debian/control: * DM-Upload-Allowed field added * upgraded to Standards-Version: 3.7.3.0 * upgrade build dependency on yorick-dev (>= 2.1.05+dfsg-2~bpo40+1) * debian/rules: converted to dh_installyorick * added debian/ynstall * added debian/yorick-soy.packinfo * added debian/yorick-soy.keywords -- Thibaut Paumard Tue, 15 Jan 2008 13:04:29 +0100 yorick-soy (1.2.01-1) unstable; urgency=low * Initial Release. Closes: #366706 -- Thibaut Paumard Mon, 1 May 2006 07:34:49 +0200 debian/watch0000644000000000000000000000011411772607723010227 0ustar version=3 https://github.com/frigaut/yorick-soy/tags .*/tarball/(\d[\d\.]+) debian/docs0000644000000000000000000000000711772607232010045 0ustar README debian/yorick-soy.packinfo0000644000000000000000000000015211772607232013017 0ustar :newsubsection soy: sparse matrix operations :soy operations on matrices compressed in RCO or RUO format debian/control0000644000000000000000000000316211773077052010604 0ustar Source: yorick-soy Section: science Priority: extra Maintainer: Debian Science Maintainers Uploaders: Thibaut Paumard Build-Depends: debhelper (>= 9), yorick-dev (>= 2.1.05+dfsg-2~bpo40+1), yorick-yutils Standards-Version: 3.9.3 DM-Upload-Allowed: yes Vcs-Git: git://git.debian.org/git/debian-science/packages/yorick-soy.git Vcs-Browser: http://git.debian.org/?p=debian-science/packages/yorick-soy.git Homepage: http://homepage.mac.com/rflicker/soy.htm Package: yorick-soy Architecture: any Depends: yorick (>= 1.6.02), yorick-yutils, ${shlibs:Depends}, ${misc:Depends} Description: sparse matrix operations for the Yorick language Sparse Operations with Yorick is a plugin for Yorick (an interpreted computer language specialized for numerical and scientific problems) that allows performing efficient operations on sparse matrices. This software is also available for the commercial language IDL. . Features: * Utilizes a sparse row-wise format optimized for fast matrix-vector multiplication * Structure implementation for user-friendly interface on the Yorick/IDL scripting level * Explicit memory handling on the scripting level * As of v1.2 portable to 64-bit computing platforms * Offers basic matrix algebra and manipulation in single or double precision * Offers scripts for solving linear systems by e.g. conjugate gradients * Offers saving of sparse structures on a common FITS format or an internal binary format. Using the FITS format makes the saved matrices portable between the IDL/Yorick distributions. debian/compat0000644000000000000000000000000211773077106010375 0ustar 9 debian/copyright0000644000000000000000000000243711772610723011135 0ustar Format: http://www.debian.org/doc/packaging-manuals/copyright-format/1.0/ Upstream-Name: SOYI Upstream-Contact: François Rigaut Source: https://github.com/frigaut/yorick-soy Files: * Copyright: 2004, Ralf Flicker (deceased 2009) 2010-2012 Marcos van Dam License: GPL-2+ Files: debian/* Copyright: 2006, 2008, 2012 Thibaut Paumard License: GPL-2+ License: GPL-2+ This package is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. . This package is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. . You should have received a copy of the GNU General Public License along with this package; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. . On Debian systems, the complete text of the GNU General Public License can be found in `/usr/share/common-licenses/GPL'. debian/README.Debian0000644000000000000000000000063611772607232011243 0ustar Yorick SOY plugin for Debian ------------------------------- This is the `soy' plugin by Ralf Flicker for the Yorick interpreted language, prepackaged for Debian GNU/Linux. A sample/test file is provided in /usr/share/doc/yorick-soy/examples/. You can run it with "yorick -batch check.i" after decompressing the file somewhere. Thibaut Paumard , Fri, 01 Sep 2006 09:51:44 +0200 debian/source/0000755000000000000000000000000011772607232010475 5ustar debian/source/format0000644000000000000000000000001411772607232011703 0ustar 3.0 (quilt) debian/patches/0000755000000000000000000000000011772611006010616 5ustar debian/patches/configure0000644000000000000000000000160111772611006012520 0ustar Description: configure this package Yorick packages are usually configured by running yorick -batch make.i which modifies Makefile. Modifying source files at build time is not very well supported in the quilt / git workflow, so let's just patch Makefile and not run yorick -batch make.i at build time. Author: Thibaut Paumard Origin: Vendor Forwarded: not-needed Last-Update: 2012-06-27 --- This patch header follows DEP-3: http://dep.debian.net/deps/dep3/ --- a/Makefile +++ b/Makefile @@ -1,8 +1,9 @@ -Y_MAKEDIR=/usr/lib/yorick/2.2 -Y_EXE=/usr/lib/yorick/2.2/bin/yorick +Y_MAKEDIR=/usr/lib/yorick +Y_EXE=/usr/lib/yorick/bin/yorick Y_EXE_PKGS= -Y_EXE_HOME=/usr/lib/yorick/2.2 -Y_EXE_SITE=/usr/share/yorick/2.2 +Y_EXE_HOME=/usr/lib/yorick +Y_EXE_SITE=/usr/lib/yorick +Y_HOME_PKG= # ----------------------------------------------------- optimization flags debian/patches/checki0000644000000000000000000000067611772607723012013 0ustar Author: Thibaut Paumard Date: 2006-05-11 22:50:14.237782544 Last-Update: Mon, 16 Apr 2012 10:27:02 +0200 Subject: Allow running check.i from built source Forwarded: not needed --- a/check.i +++ b/check.i @@ -20,6 +20,8 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ +if (open("soy.so", "r", 1)) plug_dir, _(".", plug_dir()); + require,"soy.i"; require,"random.i"; debian/patches/series0000644000000000000000000000002111772610067012032 0ustar configure checki debian/patches/git-backport0000644000000000000000000031022311772607232013136 0ustar diff -urN '--exclude=debian' '--exclude=.git' yorick-soy-1.2.01/check.i yorick-soy/check.i --- yorick-soy-1.2.01/check.i 2012-03-05 15:48:40.000000000 +0100 +++ yorick-soy/check.i 2012-03-05 15:48:10.000000000 +0100 @@ -1,23 +1,36 @@ +// check-plug.i script for SOY, 18 Nov 2004 + /* - check.i - script for testing SOY 1.2 plugin. - Author: Ralf Flicker (rflicker@mac.com) + SOY: Sparse Operations with Yorick + Copyright (C) 2004 Ralf Flicker (rflicker@mac.com) + Copyright (C) 2010 MArcos van Dam (marcos@flatwavefronts.com) + + This work free software; you can redistribute it and/or + modify it under the terms of the Creative Commons License + Attribution-NonCommercial-ShareAlike 2.0. This software + is distributed in the hope that it will be useful, but + WITHOUT ANY WARRANTY. Follow the CC links on the distribution + site for more details: http://homepage.mac.com/rflicker/soy.htm */ +//plug_dir,"."; -#include "soy/soy.i" +require,"soy.i"; +require,"random.i"; extern MR,MN,errors,errflg; +MR = 50000; +MN = 500000; -MR = 5000; -MN = 50000; errors = []; errflg = []; + ftol = 1.e-6; dtol = 1.e-12; -write,"\nDefault error tolerances : "; +write,"\nSetting error tolerances : "; write,format=" >> single precision: %5.0e\n",ftol; write,format=" >> double precision: %5.0e\n\n",dtol; -write,"(absolute numerical errors larger than these will be reported as ERROR OVERFLOW)\n"; + // Random rectangular matrices A = float(random([2,200,100])-0.5); @@ -47,7 +60,7 @@ grow,errors,err; grow,errflg,(err != 0); if ((err != 0)) { - write,format="ERROR OVERFLOW%s","\n"; + write,format="ERROR OVERFLOW%s","!\n"; } else { write,format="OK%s\n","."; } @@ -58,7 +71,7 @@ grow,errors,err; grow,errflg,(err != 0); if ( (err != 0)) { - write,format="ERROR OVERFLOW%s","\n"; + write,format="ERROR OVERFLOW%s","!\n"; } else { write,format="OK%s\n","."; } @@ -69,7 +82,7 @@ grow,errors,err; grow,errflg,(err != 0); if ( (err != 0)) { - write,format="ERROR OVERFLOW%s","\n"; + write,format="ERROR OVERFLOW%s","!\n"; } else { write,format="OK%s\n","."; } @@ -80,7 +93,7 @@ grow,errors,err; grow,errflg,(err != 0); if ( (err != 0)) { - write,format="ERROR OVERFLOW%s","\n"; + write,format="ERROR OVERFLOW%s","!\n"; } else { write,format="OK%s\n","."; } @@ -91,45 +104,46 @@ grow,errors,err; grow,errflg,(err != 0); if ( (err != 0)) { - write,format="ERROR OVERFLOW%s","\n"; + write,format="ERROR OVERFLOW%s","!\n"; } else { write,format="OK%s\n","."; } -write,format="testing spruo(a) and ruoinf (double)...%s","."; +write,format="testing sprco(a) and rcoinf (double)...%s","."; a = spruo(T); AA = ruoinf(a); err = max(abs(AA-T)); grow,errors,err; grow,errflg,(err != 0); if ( (err != 0)) { - write,format="ERROR OVERFLOW%s","\n"; + write,format="ERROR OVERFLOW%s","!\n"; } else { write,format="OK%s\n","."; } -write,format="testing spruo(a,ur=200,un=10000) and ruoinf (float)...%s","."; +write,format="testing sprco(a,ur=200,un=10000) and rcoinf (float)...%s","."; a = spruo(S,ur=200,un=10000); AA = ruoinf(a); err = max(abs(AA-S)); grow,errors,err; grow,errflg,(err != 0); if ( (err != 0)) { - write,format="ERROR OVERFLOW%s","\n"; + write,format="ERROR OVERFLOW%s","!\n"; } else { write,format="OK%s\n","."; } -write,format="testing spruo(a,ur=200,un=10000) and ruoinf (double)...%s","."; +write,format="testing sprco(a,ur=200,un=10000) and rcoinf (double)...%s","."; a = spruo(T,ur=200,un=10000); AA = ruoinf(a); err = max(abs(AA-T)); grow,errors,err; grow,errflg,(err != 0); if ( (err != 0)) { - write,format="ERROR OVERFLOW%s","\n"; + write,format="ERROR OVERFLOW%s","!\n"; } else { write,format="OK%s\n","."; } + // Test 2: rcoxv and ruoxv write,format="testing rcoxv(a,v) (float)...%s","."; vv = A(+,)*v(+); @@ -139,7 +153,7 @@ grow,errors,err; grow,errflg,(err > ftol); if ( (err > ftol)) { - write,format="ERROR OVERFLOW%s","\n"; + write,format="ERROR OVERFLOW%s","!\n"; } else { write,format="OK%s\n","."; } @@ -151,7 +165,7 @@ grow,errors,err; grow,errflg,(err > dtol); if ( (err > dtol)) { - write,format="ERROR OVERFLOW%s","\n"; + write,format="ERROR OVERFLOW%s","!\n"; } else { write,format="OK%s\n","."; } @@ -163,7 +177,7 @@ grow,errors,err; grow,errflg,(err > ftol); if ( (err > ftol)) { - write,format="ERROR OVERFLOW%s","\n"; + write,format="ERROR OVERFLOW%s","!\n"; } else { write,format="OK%s\n","."; } @@ -175,11 +189,12 @@ grow,errors,err; grow,errflg,(err > dtol); if ( (err > dtol)) { - write,format="ERROR OVERFLOW%s","\n"; + write,format="ERROR OVERFLOW%s","!\n"; } else { write,format="OK%s\n","."; } + // Test 3: rcoadd and ruoadd write,format="testing rcoadd(a,b) (float)...%s","."; C = float(B); @@ -192,7 +207,7 @@ grow,errors,err; grow,errflg,(err > ftol); if ( (err > ftol)) { - write,format="ERROR OVERFLOW%s","\n"; + write,format="ERROR OVERFLOW%s","!\n"; } else { write,format="OK%s\n","."; } @@ -207,7 +222,7 @@ grow,errors,err; grow,errflg,(err > dtol); if ( (err > dtol)) { - write,format="ERROR OVERFLOW%s","\n"; + write,format="ERROR OVERFLOW%s","!\n"; } else { write,format="OK%s\n","."; } @@ -222,7 +237,7 @@ grow,errors,err; grow,errflg,(err > ftol); if ( (err > ftol)) { - write,format="ERROR OVERFLOW%s","\n"; + write,format="ERROR OVERFLOW%s","!\n"; } else { write,format="OK%s\n","."; } @@ -237,7 +252,7 @@ grow,errors,err; grow,errflg,(err > dtol); if ( (err > dtol)) { - write,format="ERROR OVERFLOW%s","\n"; + write,format="ERROR OVERFLOW%s","!\n"; } else { write,format="OK%s\n","."; } @@ -252,7 +267,7 @@ grow,errors,err; grow,errflg,(err > ftol); if ( (err > ftol)) { - write,format="ERROR OVERFLOW%s","\n"; + write,format="ERROR OVERFLOW%s","!\n"; } else { write,format="OK%s\n","."; } @@ -267,7 +282,7 @@ grow,errors,err; grow,errflg,(err > dtol); if ( (err > dtol)) { - write,format="ERROR OVERFLOW%s","\n"; + write,format="ERROR OVERFLOW%s","!\n"; } else { write,format="OK%s\n","."; } @@ -282,7 +297,7 @@ grow,errors,err; grow,errflg,(err > ftol); if ( (err > ftol)) { - write,format="ERROR OVERFLOW%s","\n"; + write,format="ERROR OVERFLOW%s","!\n"; } else { write,format="OK%s\n","."; } @@ -297,11 +312,12 @@ grow,errors,err; grow,errflg,(err > dtol); if ( (err > dtol)) { - write,format="ERROR OVERFLOW%s","\n"; + write,format="ERROR OVERFLOW%s","!\n"; } else { write,format="OK%s\n","."; } + // Test 4: rcoata write,format="testing rcoata(a) (float)...%s","."; ATA = A(+,)*A(+,); @@ -312,7 +328,7 @@ grow,errors,err; grow,errflg,(err > ftol); if ( (err > ftol)) { - write,format="ERROR OVERFLOW%s","\n"; + write,format="ERROR OVERFLOW%s","!\n"; } else { write,format="OK%s\n","."; } @@ -325,7 +341,7 @@ grow,errors,err; grow,errflg,(err > dtol); if ( (err > dtol)) { - write,format="ERROR OVERFLOW%s","\n"; + write,format="ERROR OVERFLOW%s","!\n"; } else { write,format="OK%s\n","."; } @@ -338,7 +354,7 @@ grow,errors,err; grow,errflg,(err > ftol); if ( (err > ftol)) { - write,format="ERROR OVERFLOW%s","\n"; + write,format="ERROR OVERFLOW%s","!\n"; } else { write,format="OK%s\n","."; } @@ -351,12 +367,13 @@ grow,errors,err; grow,errflg,(err > dtol); if ( (err > dtol)) { - write,format="ERROR OVERFLOW%s","\n"; + write,format="ERROR OVERFLOW%s","!\n"; } else { write,format="OK%s\n","."; } + // Test 5: rcoatb write,format="testing rcoatb(a,b) (float)...%s","."; C = float(B); @@ -369,7 +386,7 @@ grow,errors,err; grow,errflg,(err > ftol); if ( (err > ftol)) { - write,format="ERROR OVERFLOW%s","\n"; + write,format="ERROR OVERFLOW%s","!\n"; } else { write,format="OK%s\n","."; } @@ -384,7 +401,7 @@ grow,errors,err; grow,errflg,(err > dtol); if ( (err > dtol)) { - write,format="ERROR OVERFLOW%s","\n"; + write,format="ERROR OVERFLOW%s","!\n"; } else { write,format="OK%s\n","."; } @@ -399,7 +416,7 @@ grow,errors,err; grow,errflg,(err > ftol); if ( (err > ftol)) { - write,format="ERROR OVERFLOW%s","\n"; + write,format="ERROR OVERFLOW%s","!\n"; } else { write,format="OK%s\n","."; } @@ -414,13 +431,14 @@ grow,errors,err; grow,errflg,(err > dtol); if ( (err > dtol)) { - write,format="ERROR OVERFLOW%s","\n"; + write,format="ERROR OVERFLOW%s","!\n"; } else { write,format="OK%s\n","."; } -// Test 6: rcotr + +// Test 6: rcoatb write,format="testing rcotr(a) (float)...%s","."; AT = transpose(A); a = sprco(A,ur=210,un=10000); @@ -430,7 +448,7 @@ grow,errors,err; grow,errflg,(err > ftol); if ( (err > ftol)) { - write,format="ERROR OVERFLOW%s","\n"; + write,format="ERROR OVERFLOW%s","!\n"; } else { write,format="OK%s\n","."; } @@ -443,18 +461,20 @@ grow,errors,err; grow,errflg,(err > ftol); if ( (err > ftol)) { - write,format="ERROR OVERFLOW%s","\n"; + write,format="ERROR OVERFLOW%s","!\n"; } else { write,format="OK%s\n","."; } -write,"\nFinished.\n"; +write,"\nFinished!\n"; if (anyof(errflg)) { write,format="The script encountered %i (recoverable) error(s).\n",sum(errflg); - write,format="The largest error by absolute value was %5.3e.\n\n",max(errors); - write,format="If this is significantly greater than the single precision error tolerance (%4.0e), then something might be wrong with your installation (if it is close, then no worries).\n\n",ftol; + write,format="The largest error by absolute value was %5.3e.\n",max(errors); + write,"If this is much greater than the single precision error"; + write,format=" tolerance (%4.0e), then something went seriously wrong.\n",ftol; + write,"(if it is close, then no worries)\n" write,"To submit a bug report, email: rflicker@mac.com.\n"; } else { write,"All functions returned without errors.\n"; diff -urN '--exclude=debian' '--exclude=.git' yorick-soy-1.2.01/Makefile yorick-soy/Makefile diff -urN '--exclude=debian' '--exclude=.git' yorick-soy-1.2.01/README yorick-soy/README --- yorick-soy-1.2.01/README 2006-05-03 19:40:23.000000000 +0200 +++ yorick-soy/README 2012-03-05 15:48:10.000000000 +0100 @@ -1,61 +1,19 @@ -======================================================== -SOY/i v1.2 Sparse Operations with Yorick/IDL -Author: Ralf Flicker (rflicker@mac.com) -Web site: http://homepage.mac.com/rflicker/soy.htm +SOY (Sparse Operations with Yorick) +Copyright (C) 2004 Ralf Flicker (rflicker@mac.com) +Copyright (C) 2010 MArcos van Dam (marcos@flatwavefronts.com) -This work free software; you may redistribute and modify -it under the terms of the GNU General Public License. +Installation instructions (Yorick v. >= 1.6) -2005-Dec-01 -======================================================== + * Unzip and untar into ($Y_SITE)/contrib/ -Revision history: + * cd soy, yorick -batch make.i - 2004/11/14: SOY v1.0 - - Wrappers translated from IDL to Yorick (v1.5.15) +(if, for any reason, this doesn't give you the proper +Makefile, just edit the included Makefile to point to +your Make.cfg) - 2004/11/18: SOY v1.1 - - Adapted as a plugin for Yorick v1.6.01 - - Memory management from Yorick scripting level + * make plugin, make check-plug, make install-plug - 2005/04/11: SOY v1.2 - - Updated for Yorick v1.6.02 - - Ported for 64-bit OS compatibility + * To load the plugin into yorick, type #include "soy.i" - 2005/10/07: SOY V1.2.01 - - Several minor revisions and bugfixes - - 2005/12/01: SOI V1.2 - - New wrappers for IDL 6.2 provided - -======================================================== - -Installation instructions (Yorick v1.6.02) -(for Yorick 2.1 you can use the package manager instead) - - . Unzip and untar into ($Y_SITE)/contrib/ - . cd soy - . yorick -batch make.i - . make - . make check - . make install - - To load the plugin into yorick, type #include "soy.i" - -======================================================== - -Installation instructions for IDL - ->>> NOTE: this release was developed in IDL 6.2, and - appears not to be backwards compatible to 6.0. The - fix is simple (do not use /sname in call to "size"), - but I have not done it yet - - . Place the wrappers soi.pro in your IDL path - . Build the shared object, for instance: - gcc -O2 -shared -o soy.so soy.c (your specific computer - architecture may require additional compilation flags) - . Set SOI_DIR in the shell to the directory of soi.so - -======================================================== diff -urN '--exclude=debian' '--exclude=.git' yorick-soy-1.2.01/soy.c yorick-soy/soy.c --- yorick-soy-1.2.01/soy.c 2006-05-03 19:46:09.000000000 +0200 +++ yorick-soy/soy.c 2012-03-05 15:48:10.000000000 +0100 @@ -1,846 +1,561 @@ /* - SOY 1.2 (2005-Apr-11) Sparse Operations with Yorick - Author: Ralf Flicker (rflicker@mac.com) - Web site: http://homepage.mac.com/rflicker/soy.htm - - This work free software; you may redistribute and modify - it under the terms of the GNU General Public License. + SOY: Sparse Operations with Yorick + Copyright (C) 2004 Ralf Flicker (rflicker@mac.com) + Copyright (C) 2010 MArcos van Dam (marcos@flatwavefronts.com) + + This work free software; you can redistribute it and/or + modify it under the terms of the Creative Commons License + Attribution-NonCommercial-ShareAlike 2.0. This software + is distributed in the hope that it will be useful, but + WITHOUT ANY WARRANTY. Follow the CC links on the distribution + site for more details: http://homepage.mac.com/rflicker/soy.htm */ -// gcc -O2 -shared -o soy.so soy.c - #include #include -//#include -int sprco_float(argc,argv) +typedef struct { + long r,c,n,*ix,*jx; + float *xn,t;} rco; + +typedef struct { + long r,c,n,*ix,*jx; + double *xn,t;} rco_d; + +typedef struct { + long r,n,*ix,*jx; + float *xn,*xd,t;} ruo; + +typedef struct { + long r,n,*ix,*jx; + double *xn,*xd,t;} ruo_d; + +long sprco_float(argc,argv) int argc; void *argv[]; { - int i,j,k; - int *r,*c,*ix,*jx; - float *t,*x,*xn; - x = (float *)argv[0]; - r = (int *)argv[1]; - c = (int *)argv[2]; - t = (float *)argv[3]; - ix = (int *)argv[4]; - jx = (int *)argv[5]; - xn = (float *)argv[6]; + rco* s; + long i,j,k; + float *x; + s = (rco *)argv[0]; + x = (float *)argv[1]; k = 0; - for (i=0; i < *r; i++) { - for (j=0; j < *c; j++) { - if (fabs(x[*c*i+j]) > *t) { - xn[k] = x[*c*i+j]; - jx[k] = j; - //printf("%u %u %u %u %u \n",i,j,k,ix[i],jx[k]); - k++; - } - } - ix[i+1] = k; - } + for (i=0; i < s->r; i++) { + for (j=0; j < s->c; j++) { + if (fabs(x[s->c*i+j]) > s->t) { + (s->xn)[k] = x[s->c*i+j]; + (s->jx)[k] = j; + k++;}} + (s->ix)[i+1] = k;} + s->n = k; return k; } -//------------------------------------------------ -int sprco_double(argc,argv) + +long sprco_double(argc,argv) int argc; void *argv[]; { - int i,j,k; - int *r,*c,*ix,*jx; - double *t,*x,*xn; - x = (double *)argv[0]; - r = (int *)argv[1]; - c = (int *)argv[2]; - t = (double *)argv[3]; - ix = (int *)argv[4]; - jx = (int *)argv[5]; - xn = (double *)argv[6]; + rco_d* s; + long i,j,k; + double *x; + s = (rco_d *)argv[0]; + x = (double *)argv[1]; k = 0; - for (i=0; i < *r; i++) { - for (j=0; j < *c; j++) { - if (fabs(x[*c*i+j]) > *t) { - xn[k] = x[*c*i+j]; - jx[k] = j; - k++; - } - } - ix[i+1] = k; - } + for (i=0; i < s->r; i++) { + for (j=0; j < s->c; j++) { + if (fabs(x[s->c*i+j]) > s->t) { + (s->xn)[k] = x[s->c*i+j]; + (s->jx)[k] = j; + k++;}} + (s->ix)[i+1] = k;} + s->n = k; return k; } -//------------------------------------------------ -int spruo_float(argc,argv) + +long spruo_float(argc,argv) int argc; void *argv[]; { - int i,j,k; - int *r,*ix,*jx; - float *x,*t,*xn,*xd; - x = (float *)argv[0]; - r = (int *)argv[1]; - t = (float *)argv[2]; - ix = (int *)argv[3]; - jx = (int *)argv[4]; - xn = (float *)argv[5]; - xd = (float *)argv[6]; + ruo* s; + long i,j,k; + float *x; + s = (ruo *)argv[0]; + x = (float *)argv[1]; k = 0; - for (i=0; i < *r; i++) xd[i] = x[*r*i+i]; - for (i=0; i < *r-1; i++) { - for (j=i+1; j < *r; j++) { - if (fabs(x[*r*i+j]) > *t) { - xn[k] = x[*r*i+j]; - jx[k] = j; - k++; - } - } - ix[i+1] = k;} + for (i=0; i < s->r; i++) (s->xd)[i] = x[s->r*i+i]; + for (i=0; i < s->r-1; i++) { + for (j=i+1; j < s->r; j++) { + if (fabs(x[s->r*i+j]) > s->t) { + (s->xn)[k] = x[s->r*i+j]; + (s->jx)[k] = j; + k++;}} + (s->ix)[i+1] = k;} + s->n = k; return k; } -//------------------------------------------------ -int spruo_double(argc,argv) + +long spruo_double(argc,argv) int argc; void *argv[]; { - int i,j,k; - int *r,*ix,*jx; - double *x,*t,*xn,*xd; - x = (double *)argv[0]; - r = (int *)argv[1]; - t = (double *)argv[2]; - ix = (int *)argv[3]; - jx = (int *)argv[4]; - xn = (double *)argv[5]; - xd = (double *)argv[6]; + ruo_d* s; + long i,j,k; + double *x; + s = (ruo_d *)argv[0]; + x = (double *)argv[1]; k = 0; - for (i=0; i < *r; i++) xd[i] = x[*r*i+i]; - for (i=0; i < *r-1; i++) { - for (j=i+1; j < *r; j++) { - if (fabs(x[*r*i+j]) > *t) { - xn[k] = x[*r*i+j]; - jx[k] = j; - k++; - } - } - ix[i+1] = k;} - return k; -} -//------------------------------------------------ -int rcoxv_float(argc,argv) + for (i=0; i < s->r; i++) (s->xd)[i] = x[s->r*i+i]; + for (i=0; i < s->r-1; i++) { + for (j=i+1; j < s->r; j++) { + if (fabs(x[s->r*i+j]) > s->t) { + (s->xn)[k] = x[s->r*i+j]; + (s->jx)[k] = j; + k++;}} + (s->ix)[i+1] = k;} + s->n = k; + return k; +} + +long rcoxv_float(argc,argv) int argc; void *argv[]; { - int i,j; - float *v, *u, *xn; - int *ix,*jx, *r; - v = (float *)argv[0]; - u = (float *)argv[1]; - r = (int *)argv[2]; - ix = (int *)argv[3]; - jx = (int *)argv[4]; - xn = (float *)argv[5]; + rco* s; + long i,j,k; + float *v, *u; + s = (rco *)argv[0]; + v = (float *)argv[1]; + u = (float *)argv[2]; /* struct timeval tod0,tod1; gettimeofday(&tod0,NULL); */ - j = 0; - for (i=0; i < *r; i++) { - if (ix[i+1]-ix[i] > 0) { - for (j=ix[i]; j < ix[i+1]; j++) { - u[i] += xn[j]*v[jx[j]]; - } - } - } + for (i=0; i < s->r; i++) { + if ((s->ix)[i+1]-(s->ix)[i] > 0) { + for (j=(s->ix)[i]; j < (s->ix)[i+1]; j++) { + u[i] += (s->xn)[j]*v[(s->jx)[j]];}}} /* gettimeofday(&tod1,NULL); printf("Time X: %u\n",(unsigned long)tod1.tv_usec-(unsigned long)tod0.tv_usec); */ return j; } -//------------------------------------------------ -int rcoxv_double(argc,argv) + +long rcoxv_double(argc,argv) int argc; void *argv[]; { - int i,j; - double *v, *u, *xn; - int *ix,*jx, *r; - v = (double *)argv[0]; - u = (double *)argv[1]; - r = (int *)argv[2]; - ix = (int *)argv[3]; - jx = (int *)argv[4]; - xn = (double *)argv[5]; - /* struct timeval tod0,tod1; - gettimeofday(&tod0,NULL); */ - j = 0; - for (i=0; i < *r; i++) { - if (ix[i+1]-ix[i] > 0) { - for (j=ix[i]; j < ix[i+1]; j++) { - u[i] += xn[j]*v[jx[j]]; - } - } - } - /* gettimeofday(&tod1,NULL); - printf("Time X: %u\n",(unsigned long)tod1.tv_usec-(unsigned long)tod0.tv_usec); */ - return j; -} -//------------------------------------------------ -int ruoxv_float(argc,argv) + rco_d* s; + long i,j; + double *v, *u; + s = (rco_d *)argv[0]; + v = (double *)argv[1]; + u = (double *)argv[2]; + for (i=0; i < s->r; i++) { + if ((s->ix)[i+1]-(s->ix)[i] > 0) { + for (j=(s->ix)[i]; j < (s->ix)[i+1]; j++) { + u[i] += (s->xn)[j]*v[(s->jx)[j]];}}} + return j; +} + +long ruoxv_float(argc,argv) int argc; void *argv[]; { - int i,j; - int *ix,*jx, *r; - float *v,*u,*w,*xn,*xd; - v = (float *)argv[0]; - u = (float *)argv[1]; - w = (float *)argv[2]; - r = (int *)argv[3]; - ix = (int *)argv[4]; - jx = (int *)argv[5]; - xn = (float *)argv[6]; - xd = (float *)argv[7]; - j = 0; - for (i=0; i < *r; i++) u[i] = xd[i]*v[i]; - for (i=0; i < *r-1; i++) { - if (ix[i+1] > ix[i]) { - for (j=ix[i]; j < ix[i+1]; j++) { - u[i] += xn[j]*v[jx[j]]; - w[jx[j]] += xn[j]*v[i]; - } - } - } - for (i=0; i < *r; i++) u[i] += w[i]; + ruo* a; + long i,j; + float *v, *u, *w; + a = (ruo *)argv[0]; + v = (float *)argv[1]; + u = (float *)argv[2]; + w = (float *)argv[3]; + for (i=0; i < a->r; i++) u[i] = (a->xd)[i]*v[i]; + for (i=0; i < a->r-1; i++) { + if ((a->ix)[i+1] > (a->ix)[i]) { + for (j=(a->ix)[i]; j < (a->ix)[i+1]; j++) { + u[i] += (a->xn)[j]*v[(a->jx)[j]]; + w[(a->jx)[j]] += (a->xn)[j]*v[i];}}} + for (i=0; i < a->r; i++) u[i] += w[i]; return j; } -//------------------------------------------------ -int ruoxv_double(argc,argv) + +long ruoxv_double(argc,argv) int argc; void *argv[]; { - int i,j; - int *ix,*jx, *r; - double *v,*u,*w,*xn,*xd; - v = (double *)argv[0]; - u = (double *)argv[1]; - w = (double *)argv[2]; - r = (int *)argv[3]; - ix = (int *)argv[4]; - jx = (int *)argv[5]; - xn = (double *)argv[6]; - xd = (double *)argv[7]; - j = 0; - for (i=0; i < *r; i++) u[i] = xd[i]*v[i]; - for (i=0; i < *r-1; i++) { - if (ix[i+1] > ix[i]) { - for (j=ix[i]; j < ix[i+1]; j++) { - u[i] += xn[j]*v[jx[j]]; - w[jx[j]] += xn[j]*v[i]; - } - } - } - for (i=0; i < *r; i++) u[i] += w[i]; + ruo_d* a; + long i,j; + double *v, *u, *w; + a = (ruo_d *)argv[0]; + v = (double *)argv[1]; + u = (double *)argv[2]; + w = (double *)argv[3]; + for (i=0; i < a->r; i++) u[i] = (a->xd)[i]*v[i]; + for (i=0; i < a->r-1; i++) { + if ((a->ix)[i+1] > (a->ix)[i]) { + for (j=(a->ix)[i]; j < (a->ix)[i+1]; j++) { + u[i] += (a->xn)[j]*v[(a->jx)[j]]; + w[(a->jx)[j]] += (a->xn)[j]*v[i];}}} + for (i=0; i < a->r; i++) u[i] += w[i]; return j; } -//------------------------------------------------ -int rcoadd_float(argc,argv) + +long rcoadd_float(argc,argv) int argc; void *argv[]; { - int i,j,p,*s; - float *t,*axn,*bxn,*cxn; - int *aix,*ajx,*ar,*ac; - int *bix,*bjx,*br,*bc; - int *cix,*cjx,*cr,*cc; - ar = (int *)argv[0]; - ac = (int *)argv[1]; - aix = (int *)argv[2]; - ajx = (int *)argv[3]; - axn = (float *)argv[4]; - br = (int *)argv[5]; - bc = (int *)argv[6]; - bix = (int *)argv[7]; - bjx = (int *)argv[8]; - bxn = (float *)argv[9]; - cr = (int *)argv[10]; - cc = (int *)argv[11]; - cix = (int *)argv[12]; - cjx = (int *)argv[13]; - cxn = (float *)argv[14]; - t = (float *)argv[15]; - s = (int *)argv[16]; + rco* a; + rco* b; + rco* c; + long i,j,p,*s; + float *t; + a = (rco *)argv[0]; + b = (rco *)argv[1]; + c = (rco *)argv[2]; + t = (float *)argv[3]; + s = (long *)argv[4]; p = 0; - - - for (i=0; i < *ac; i++) s[i] = -1; - for (i=0; i < *ar; i++) { - cix[i] = p; - if (aix[i+1] > aix[i]) { - for (j=aix[i]; j < aix[i+1]; j++) { - cjx[p++] = ajx[j]; - s[ajx[j]] = i; - } - } - if (bix[i+1] > bix[i]) { - for (j=bix[i]; j < bix[i+1]; j++) { - if (s[bjx[j]] != i) cjx[p++] = bjx[j]; - } - } - } - cix[*ar] = p; - for (i=0; i < *ar; i++) { - if (cix[i+1] > cix[i]) { - for (j=cix[i]; j < cix[i+1]; j++) { - //printf("%u %u %u %u \n",j,cix[i],cix[i+1],cjx[j]); - t[cjx[j]] = 0.0; - } - if (aix[i+1] > aix[i]) { - for (j=aix[i]; j < aix[i+1]; j++) t[ajx[j]] = axn[j]; - } - if (bix[i+1] > bix[i]) { - for (j=bix[i]; j < bix[i+1]; j++) t[bjx[j]] = t[bjx[j]]+bxn[j]; - } - for (j=cix[i]; j < cix[i+1]; j++) cxn[j] = t[cjx[j]]; - } - } + for (i=0; i < a->c; i++) s[i] = -1; + for (i=0; i < a->r; i++) { + (c->ix)[i] = p; + if ((a->ix)[i+1] > (a->ix)[i]) { + for (j=(a->ix)[i]; j < (a->ix)[i+1]; j++) { + (c->jx)[p++] = (a->jx)[j]; + s[(a->jx)[j]] = i;}} + if ((b->ix)[i+1] > (b->ix)[i]) { + for (j=(b->ix)[i]; j < (b->ix)[i+1]; j++) { + if (s[(b->jx)[j]] != i) (c->jx)[p++] = (b->jx)[j];}}} + (c->ix)[a->r] = p; + for (i=0; i < a->r; i++) { + if ((c->ix)[i+1] > (c->ix)[i]) { + for (j=(c->ix)[i]; j < (c->ix)[i+1]; j++) t[(c->jx)[j]] = 0.0; + if ((a->ix)[i+1] > (a->ix)[i]) { + for (j=(a->ix)[i]; j < (a->ix)[i+1]; j++) t[(a->jx)[j]] = (a->xn)[j];} + if ((b->ix)[i+1] > (b->ix)[i]) { + for (j=(b->ix)[i]; j < (b->ix)[i+1]; j++) t[(b->jx)[j]] = t[(b->jx)[j]]+(b->xn)[j];} + for (j=(c->ix)[i]; j < (c->ix)[i+1]; j++) (c->xn)[j] = t[(c->jx)[j]];}} + c->n = p; return p; } -//------------------------------------------------ -int rcoadd_double(argc,argv) + +long rcoadd_double(argc,argv) int argc; void *argv[]; { - int i,j,p,*s; - double *t,*axn,*bxn,*cxn; - int *aix,*ajx,*ar,*ac; - int *bix,*bjx,*br,*bc; - int *cix,*cjx,*cr,*cc; - ar = (int *)argv[0]; - ac = (int *)argv[1]; - aix = (int *)argv[2]; - ajx = (int *)argv[3]; - axn = (double *)argv[4]; - br = (int *)argv[5]; - bc = (int *)argv[6]; - bix = (int *)argv[7]; - bjx = (int *)argv[8]; - bxn = (double *)argv[9]; - cr = (int *)argv[10]; - cc = (int *)argv[11]; - cix = (int *)argv[12]; - cjx = (int *)argv[13]; - cxn = (double *)argv[14]; - t = (double *)argv[15]; - s = (int *)argv[16]; + rco_d* a; + rco_d* b; + rco_d* c; + long i,j,p,*s; + double *t; + a = (rco_d *)argv[0]; + b = (rco_d *)argv[1]; + c = (rco_d *)argv[2]; + t = (double *)argv[3]; + s = (long *)argv[4]; p = 0; - - for (i=0; i < *ac; i++) s[i] = -1; - for (i=0; i < *ar; i++) { - cix[i] = p; - if (aix[i+1] > aix[i]) { - for (j=aix[i]; j < aix[i+1]; j++) { - cjx[p++] = ajx[j]; - s[ajx[j]] = i; - } - } - if (bix[i+1] > bix[i]) { - for (j=bix[i]; j < bix[i+1]; j++) { - if (s[bjx[j]] != i) cjx[p++] = bjx[j]; - } - } - } - cix[*ar] = p; - for (i=0; i < *ar; i++) { - if (cix[i+1] > cix[i]) { - for (j=cix[i]; j < cix[i+1]; j++) t[cjx[j]] = 0.0; - if (aix[i+1] > aix[i]) { - for (j=aix[i]; j < aix[i+1]; j++) t[ajx[j]] = axn[j]; - } - if (bix[i+1] > bix[i]) { - for (j=bix[i]; j < bix[i+1]; j++) t[bjx[j]] = t[bjx[j]]+bxn[j]; - } - for (j=cix[i]; j < cix[i+1]; j++) cxn[j] = t[cjx[j]]; - } - } + for (i=0; i < a->c; i++) s[i] = -1; + for (i=0; i < a->r; i++) { + (c->ix)[i] = p; + if ((a->ix)[i+1] > (a->ix)[i]) { + for (j=(a->ix)[i]; j < (a->ix)[i+1]; j++) { + (c->jx)[p++] = (a->jx)[j]; + s[(a->jx)[j]] = i;}} + if ((b->ix)[i+1] > (b->ix)[i]) { + for (j=(b->ix)[i]; j < (b->ix)[i+1]; j++) { + if (s[(b->jx)[j]] != i) (c->jx)[p++] = (b->jx)[j];}}} + (c->ix)[a->r] = p; + for (i=0; i < a->r; i++) { + if ((c->ix)[i+1] > (c->ix)[i]) { + for (j=(c->ix)[i]; j < (c->ix)[i+1]; j++) t[(c->jx)[j]] = 0.0; + if ((a->ix)[i+1] > (a->ix)[i]) { + for (j=(a->ix)[i]; j < (a->ix)[i+1]; j++) t[(a->jx)[j]] = (a->xn)[j];} + if ((b->ix)[i+1] > (b->ix)[i]) { + for (j=(b->ix)[i]; j < (b->ix)[i+1]; j++) t[(b->jx)[j]] = t[(b->jx)[j]]+(b->xn)[j];} + for (j=(c->ix)[i]; j < (c->ix)[i+1]; j++) (c->xn)[j] = t[(c->jx)[j]];}} + c->n = p; return p; } -//------------------------------------------------ -int ruoadd_float(argc,argv) + +long ruoadd_float(argc,argv) int argc; void *argv[]; { - int i,j,p,*s; - float *tt,*axn,*axd,*bxn,*bxd,*cxn,*cxd; - int *aix,*ajx,*ar; - int *bix,*bjx,*br; - int *cix,*cjx,*cr; - ar = (int *)argv[0]; - axd = (float *)argv[1]; - aix = (int *)argv[2]; - ajx = (int *)argv[3]; - axn = (float *)argv[4]; - br = (int *)argv[5]; - bxd = (float *)argv[6]; - bix = (int *)argv[7]; - bjx = (int *)argv[8]; - bxn = (float *)argv[9]; - cr = (int *)argv[10]; - cxd = (float *)argv[11]; - cix = (int *)argv[12]; - cjx = (int *)argv[13]; - cxn = (float *)argv[14]; - tt = (float *)argv[15]; - s = (int *)argv[16]; - - for (i=0; i < *ar; i++) cxd[i] = axd[i]+bxd[i]; - for (i=0; i < *ar; i++) s[i] = -1; + ruo* a; + ruo* b; + ruo* c; + long i,j,p,*s; + float *tt; + a = (ruo *)argv[0]; + b = (ruo *)argv[1]; + c = (ruo *)argv[2]; + tt = (float *)argv[3]; + s = (long *)argv[4]; + for (i=0; i < a->r; i++) (c->xd)[i] = (a->xd)[i]+(b->xd)[i]; + for (i=0; i < a->r; i++) s[i] = -1; p = 0; - for (i=0; i < *ar-1; i++) { - cix[i] = p; - if (aix[i+1] > aix[i]) { - for (j=aix[i]; j < aix[i+1]; j++) { - cjx[p++] = ajx[j]; - s[ajx[j]] = i; - } - } - if (bix[i+1] > bix[i]) { - for (j=bix[i]; j < bix[i+1]; j++) { - if (s[bjx[j]] != i) cjx[p++] = bjx[j]; - } - } - } - cix[*ar-1] = p; - for (i=0; i < *ar-1; i++) { - if (cix[i+1] > cix[i]) { - for (j=cix[i]; j < cix[i+1]; j++) tt[cjx[j]] = 0.0; - if (aix[i+1] > aix[i]) { - for (j=aix[i]; j < aix[i+1]; j++) tt[ajx[j]] = axn[j]; - } - if (bix[i+1] > bix[i]) { - for (j=bix[i]; j < bix[i+1]; j++) tt[bjx[j]] = tt[bjx[j]]+bxn[j]; - } - for (j=cix[i]; j < cix[i+1]; j++) cxn[j] = tt[cjx[j]]; - } - } + for (i=0; i < a->r-1; i++) { + (c->ix)[i] = p; + if ((a->ix)[i+1] > (a->ix)[i]) { + for (j=(a->ix)[i]; j < (a->ix)[i+1]; j++) { + (c->jx)[p++] = (a->jx)[j]; + s[(a->jx)[j]] = i;}} + if ((b->ix)[i+1] > (b->ix)[i]) { + for (j=(b->ix)[i]; j < (b->ix)[i+1]; j++) { + if (s[(b->jx)[j]] != i) (c->jx)[p++] = (b->jx)[j];}}} + (c->ix)[a->r-1] = p; + for (i=0; i < a->r-1; i++) { + if ((c->ix)[i+1] > (c->ix)[i]) { + for (j=(c->ix)[i]; j < (c->ix)[i+1]; j++) tt[(c->jx)[j]] = 0.0; + if ((a->ix)[i+1] > (a->ix)[i]) { + for (j=(a->ix)[i]; j < (a->ix)[i+1]; j++) tt[(a->jx)[j]] = (a->xn)[j];} + if ((b->ix)[i+1] > (b->ix)[i]) { + for (j=(b->ix)[i]; j < (b->ix)[i+1]; j++) tt[(b->jx)[j]] = tt[(b->jx)[j]]+(b->xn)[j];} + for (j=(c->ix)[i]; j < (c->ix)[i+1]; j++) (c->xn)[j] = tt[(c->jx)[j]];}} + c->n = p; return p; } -//------------------------------------------------ -int ruoadd_double(argc,argv) + +long ruoadd_double(argc,argv) int argc; void *argv[]; { - int i,j,p,*s; - double *tt,*axn,*axd,*bxn,*bxd,*cxn,*cxd; - int *aix,*ajx,*ar; - int *bix,*bjx,*br; - int *cix,*cjx,*cr; - ar = (int *)argv[0]; - axd = (double *)argv[1]; - aix = (int *)argv[2]; - ajx = (int *)argv[3]; - axn = (double *)argv[4]; - br = (int *)argv[5]; - bxd = (double *)argv[6]; - bix = (int *)argv[7]; - bjx = (int *)argv[8]; - bxn = (double *)argv[9]; - cr = (int *)argv[10]; - cxd = (double *)argv[11]; - cix = (int *)argv[12]; - cjx = (int *)argv[13]; - cxn = (double *)argv[14]; - tt = (double *)argv[15]; - s = (int *)argv[16]; - - for (i=0; i < *ar; i++) cxd[i] = axd[i]+bxd[i]; - for (i=0; i < *ar; i++) s[i] = -1; + ruo_d* a; + ruo_d* b; + ruo_d* c; + long i,j,p,*s; + double *tt; + a = (ruo_d *)argv[0]; + b = (ruo_d *)argv[1]; + c = (ruo_d *)argv[2]; + tt = (double *)argv[3]; + s = (long *)argv[4]; + for (i=0; i < a->r; i++) (c->xd)[i] = (a->xd)[i]+(b->xd)[i]; + for (i=0; i < a->r; i++) s[i] = -1; p = 0; - for (i=0; i < *ar-1; i++) { - cix[i] = p; - if (aix[i+1] > aix[i]) { - for (j=aix[i]; j < aix[i+1]; j++) { - cjx[p++] = ajx[j]; - s[ajx[j]] = i; - } - } - if (bix[i+1] > bix[i]) { - for (j=bix[i]; j < bix[i+1]; j++) { - if (s[bjx[j]] != i) cjx[p++] = bjx[j]; - } - } - } - cix[*ar-1] = p; - for (i=0; i < *ar-1; i++) { - if (cix[i+1] > cix[i]) { - for (j=cix[i]; j < cix[i+1]; j++) tt[cjx[j]] = 0.0; - if (aix[i+1] > aix[i]) { - for (j=aix[i]; j < aix[i+1]; j++) tt[ajx[j]] = axn[j]; - } - if (bix[i+1] > bix[i]) { - for (j=bix[i]; j < bix[i+1]; j++) tt[bjx[j]] = tt[bjx[j]]+bxn[j]; - } - for (j=cix[i]; j < cix[i+1]; j++) cxn[j] = tt[cjx[j]]; - } - } + for (i=0; i < a->r-1; i++) { + (c->ix)[i] = p; + if ((a->ix)[i+1] > (a->ix)[i]) { + for (j=(a->ix)[i]; j < (a->ix)[i+1]; j++) { + (c->jx)[p++] = (a->jx)[j]; + s[(a->jx)[j]] = i;}} + if ((b->ix)[i+1] > (b->ix)[i]) { + for (j=(b->ix)[i]; j < (b->ix)[i+1]; j++) { + if (s[(b->jx)[j]] != i) (c->jx)[p++] = (b->jx)[j];}}} + (c->ix)[a->r-1] = p; + for (i=0; i < a->r-1; i++) { + if ((c->ix)[i+1] > (c->ix)[i]) { + for (j=(c->ix)[i]; j < (c->ix)[i+1]; j++) tt[(c->jx)[j]] = 0.0; + if ((a->ix)[i+1] > (a->ix)[i]) { + for (j=(a->ix)[i]; j < (a->ix)[i+1]; j++) tt[(a->jx)[j]] = (a->xn)[j];} + if ((b->ix)[i+1] > (b->ix)[i]) { + for (j=(b->ix)[i]; j < (b->ix)[i+1]; j++) tt[(b->jx)[j]] = tt[(b->jx)[j]]+(b->xn)[j];} + for (j=(c->ix)[i]; j < (c->ix)[i+1]; j++) (c->xn)[j] = tt[(c->jx)[j]];}} + c->n = p; return p; } -//------------------------------------------------ -int rcoata_float(argc,argv) + +long rcoata_float(argc,argv) int argc; void *argv[]; { - int i,j,k,l,p,ni,nj; + rco* a; + ruo* b; + long i,j,k,l,p,ni,nj; float mb=0.0; - int *ar,*aix,*ajx,*bix,*bjx; - float *bt,*axn,*bxn,*bxd; - ar = (int *)argv[0]; - aix = (int *)argv[1]; - ajx = (int *)argv[2]; - axn = (float *)argv[3]; - bt = (float *)argv[4]; - bix = (int *)argv[5]; - bjx = (int *)argv[6]; - bxn = (float *)argv[7]; - bxd = (float *)argv[8]; - - //printf("row "); - for (i=0; i < *ar; i++) { - //printf("%u ",i);; - if (aix[i+1]-aix[i] > 0) { - for (k=aix[i]; k < aix[i+1]; k++) { - bxd[i] += axn[k]*axn[k]; - } - } - } + a = (rco *)argv[0]; + b = (ruo *)argv[1]; + for (i=0; ir; i++) { + if ((a->ix)[i+1]-(a->ix)[i] > 0) { + for (k=(a->ix)[i]; k<(a->ix)[i+1]; k++) { + (b->xd)[i] += (a->xn)[k]*(a->xn)[k];}}} p = 0; - //printf("row "); - for (i=0; i < *ar-1; i++) { - //printf("i%u ",i); - for (j=i+1; j < *ar; j++) { - //printf("j%u ",j); - ni = aix[i+1]-aix[i]; - nj = aix[j+1]-aix[j]; + for (i=0; i < a->r-1; i++) { + for (j=i+1; j < a->r; j++) { + ni = (a->ix)[i+1]-(a->ix)[i]; + nj = (a->ix)[j+1]-(a->ix)[j]; if (ni > 0 && nj > 0) { mb = 0.0; for (k=0; k < ni; k++) { - //printf("k%u ",k); for (l=0; l < nj; l++) { - //printf("l%u ",l); - if (ajx[aix[i]+k] == ajx[aix[j]+l]) { - mb += axn[aix[i]+k]*(axn[aix[j]+l]); - } - } - } - if (fabs(mb) > *bt) { - bxn[p] = mb; - bjx[p] = j; - p++; - } - } - } - bix[i+1] = p; - } + if ((a->jx)[(a->ix)[i]+k] == (a->jx)[(a->ix)[j]+l]) + mb += (a->xn)[(a->ix)[i]+k]*((a->xn)[(a->ix)[j]+l]);}} + if (fabs(mb) > b->t) { + (b->xn)[p] = mb; + (b->jx)[p] = j; + p++;}}} + (b->ix)[i+1] = p;} + b->n = p; return p; } -//------------------------------------------------ -int rcoata_double(argc,argv) + +long rcoata_double(argc,argv) int argc; void *argv[]; { - int i,j,k,l,p,ni,nj; + rco_d* a; + ruo_d* b; + long i,j,k,l,p,ni,nj; double mb=0.0; - int *ar,*aix,*ajx,*bix,*bjx; - double *bt,*axn,*bxn,*bxd; - ar = (int *)argv[0]; - aix = (int *)argv[1]; - ajx = (int *)argv[2]; - axn = (double *)argv[3]; - bt = (double *)argv[4]; - bix = (int *)argv[5]; - bjx = (int *)argv[6]; - bxn = (double *)argv[7]; - bxd = (double *)argv[8]; - - for (i=0; i < *ar; i++) { - if (aix[i+1]-aix[i] > 0) { - for (k=aix[i]; k < aix[i+1]; k++) { - bxd[i] += axn[k]*axn[k]; - } - } - } + a = (rco_d *)argv[0]; + b = (ruo_d *)argv[1]; + for (i=0; ir; i++) { + if ((a->ix)[i+1]-(a->ix)[i] > 0) { + for (k=(a->ix)[i]; k<(a->ix)[i+1]; k++) { + (b->xd)[i] += (a->xn)[k]*(a->xn)[k];}}} p = 0; - for (i=0; i < *ar-1; i++) { - for (j=i+1; j < *ar; j++) { - ni = aix[i+1]-aix[i]; - nj = aix[j+1]-aix[j]; + for (i=0; i < a->r-1; i++) { + for (j=i+1; j < a->r; j++) { + ni = (a->ix)[i+1]-(a->ix)[i]; + nj = (a->ix)[j+1]-(a->ix)[j]; if (ni > 0 && nj > 0) { mb = 0.0; for (k=0; k < ni; k++) { for (l=0; l < nj; l++) { - if (ajx[aix[i]+k] == ajx[aix[j]+l]) - mb += axn[aix[i]+k]*(axn[aix[j]+l]); - } - } - if (fabs(mb) > *bt) { - bxn[p] = mb; - bjx[p] = j; - p++; - } - } - } - bix[i+1] = p; - } + if ((a->jx)[(a->ix)[i]+k] == (a->jx)[(a->ix)[j]+l]) + mb += (a->xn)[(a->ix)[i]+k]*((a->xn)[(a->ix)[j]+l]);}} + if (fabs(mb) > b->t) { + (b->xn)[p] = mb; + (b->jx)[p] = j; + p++;}}} + (b->ix)[i+1] = p;} + b->n = p; return p; } -//------------------------------------------------ -int rcoatb_float(argc,argv) + +long rcoatb_float(argc,argv) int argc; void *argv[]; { - int i,j,k,l,p,ni,nj; + rco* a; + rco* b; + rco* c; + long i,j,k,l,p,ni,nj; float mb=0.0; - int *ar,*aix,*ajx,*br,*bix,*bjx,*cix,*cjx; - float *ct,*axn,*bxn,*cxn; - ar = (int *)argv[0]; - aix = (int *)argv[1]; - ajx = (int *)argv[2]; - axn = (float *)argv[3]; - br = (int *)argv[4]; - bix = (int *)argv[5]; - bjx = (int *)argv[6]; - bxn = (float *)argv[7]; - ct = (float *)argv[8]; - cix = (int *)argv[9]; - cjx = (int *)argv[10]; - cxn = (float *)argv[11]; - + a = (rco *)argv[0]; + b = (rco *)argv[1]; + c = (rco *)argv[2]; p = 0; - for (i=0; i < *ar; i++) { - for (j=0; j < *br; j++) { - ni = aix[i+1]-aix[i]; - nj = bix[j+1]-bix[j]; + for (i=0; i < a->r; i++) { + for (j=0; j < b->r; j++) { + ni = (a->ix)[i+1]-(a->ix)[i]; + nj = (b->ix)[j+1]-(b->ix)[j]; if (ni > 0 && nj > 0) { mb = 0.0; for (k=0; k < ni; k++) { for (l=0; l < nj; l++) { - if (ajx[aix[i]+k] == bjx[bix[j]+l]) - mb += axn[aix[i]+k]*(bxn[bix[j]+l]); - } - } - if (fabs(mb) > *ct) { - cxn[p] = mb; - cjx[p] = j; - p++; - } - } - } - cix[i+1] = p; - } + if ((a->jx)[(a->ix)[i]+k] == (b->jx)[(b->ix)[j]+l]) + mb += (a->xn)[(a->ix)[i]+k]*((b->xn)[(b->ix)[j]+l]);}} + if (fabs(mb) > c->t) { + (c->xn)[p] = mb; + (c->jx)[p] = j; + p++;}}} + (c->ix)[i+1] = p;} + c->n = p; return p; } -//------------------------------------------------ -int rcoatb_double(argc,argv) + +long rcoatb_double(argc,argv) int argc; void *argv[]; { - int i,j,k,l,p,ni,nj; + rco_d* a; + rco_d* b; + rco_d* c; + long i,j,k,l,p,ni,nj; double mb=0.0; - int *ar,*aix,*ajx,*br,*bix,*bjx,*cix,*cjx; - double *ct,*axn,*bxn,*cxn; - ar = (int *)argv[0]; - aix = (int *)argv[1]; - ajx = (int *)argv[2]; - axn = (double *)argv[3]; - br = (int *)argv[4]; - bix = (int *)argv[5]; - bjx = (int *)argv[6]; - bxn = (double *)argv[7]; - ct = (double *)argv[8]; - cix = (int *)argv[9]; - cjx = (int *)argv[10]; - cxn = (double *)argv[11]; - + a = (rco_d *)argv[0]; + b = (rco_d *)argv[1]; + c = (rco_d *)argv[2]; p = 0; - for (i=0; i < *ar; i++) { - for (j=0; j < *br; j++) { - ni = aix[i+1]-aix[i]; - nj = bix[j+1]-bix[j]; + for (i=0; i < a->r; i++) { + for (j=0; j < b->r; j++) { + ni = (a->ix)[i+1]-(a->ix)[i]; + nj = (b->ix)[j+1]-(b->ix)[j]; if (ni > 0 && nj > 0) { mb = 0.0; for (k=0; k < ni; k++) { for (l=0; l < nj; l++) { - if (ajx[aix[i]+k] == bjx[bix[j]+l]) - mb += axn[aix[i]+k]*(bxn[bix[j]+l]); - } - } - if (fabs(mb) > *ct) { - cxn[p] = mb; - cjx[p] = j; - p++; - } - } - } - cix[i+1] = p; - } + if ((a->jx)[(a->ix)[i]+k] == (b->jx)[(b->ix)[j]+l]) + mb += (a->xn)[(a->ix)[i]+k]*((b->xn)[(b->ix)[j]+l]);}} + if (fabs(mb) > c->t) { + (c->xn)[p] = mb; + (c->jx)[p] = j; + p++;}}} + (c->ix)[i+1] = p;} + c->n = p; return p; } -//------------------------------------------------ -int rcoatb2_float(argc,argv) -int argc; -void *argv[]; -{ - int i,j,k,l,p,ni,nj; - float mb=0.0; - int *ar,*aix,*ajx,*br,*bix,*bjx,*cix,*cjx; - float *ct,*axn,*bxn,*cxn,*cxd; - ar = (int *)argv[0]; - aix = (int *)argv[1]; - ajx = (int *)argv[2]; - axn = (float *)argv[3]; - br = (int *)argv[4]; - bix = (int *)argv[5]; - bjx = (int *)argv[6]; - bxn = (float *)argv[7]; - ct = (float *)argv[8]; - cix = (int *)argv[9]; - cjx = (int *)argv[10]; - cxn = (float *)argv[11]; - cxd = (float *)argv[12]; - p = 0; - for (i=0; i < *ar; i++) { - for (j=i; j < *br; j++) { - ni = aix[i+1]-aix[i]; - nj = bix[j+1]-bix[j]; - if (ni > 0 && nj > 0) { - mb = 0.0; - for (k=0; k < ni; k++) { - for (l=0; l < nj; l++) { - if (ajx[aix[i]+k] == bjx[bix[j]+l]) - mb += axn[aix[i]+k]*(bxn[bix[j]+l]); - } - } - if (fabs(mb) > *ct && i != j) { - cxn[p] = mb; - cjx[p] = j; - p++; - } else if (i == j) { - cxd[i] = mb; - } - } - } - if (i != j) {cix[i+1] = p;} - } - return p; -} -//------------------------------------------------ -int rcotr_fix(argc,argv) +long rcotr_float(argc,argv) int argc; void *argv[]; { - int i,j,nz; - int *ax,*acx,*hjx,*rind,*ar,*ac,*an,*aix; - ax = (int *)argv[0]; - acx = (int *)argv[1]; - hjx = (int *)argv[2]; - rind = (int *)argv[3]; - ar = (int *)argv[4]; - ac = (int *)argv[5]; - an = (int *)argv[6]; - aix = (int *)argv[7]; + rco* a; + long i,j,nz; + long *ax, *acx, *hjx, *rind; + ax = (long *)argv[0]; + acx = (long *)argv[1]; + hjx = (long *)argv[2]; + rind = (long *)argv[3]; + a = (rco *)argv[4]; nz = 0; - for (i=0; i < *an; i++) {ax[hjx[i]] += 1;} - for (i=1; i < *ac+1; i++) {acx[i] = ax[i-1]+acx[i-1];} - for (i=0; i < *ar; i++) { - nz = aix[i+1]-aix[i]; + for (i=0; i < a->n; i++) {ax[hjx[i]] += 1;} + for (i=1; i < a->c+1; i++) {acx[i] = ax[i-1]+acx[i-1];} + for (i=0; i < a->r; i++) { + nz = (a->ix)[i+1]-(a->ix)[i]; if (nz > 0) { - for (j=0; j < nz; j++) {rind[aix[i]+j] = i; - } - } - } + for (j=0; j < nz; j++) {rind[(a->ix)[i]+j] = i;}}} return i; } -//------------------------------------------------ -int laplace1_float(argc,argv) + +long rcotr_double(argc,argv) + int argc; void *argv[]; { - int i, xc, yc; - int *x, *y, *ind, *inds, *validx, *nx, *dim; - x = (int *)argv[0]; - y = (int *)argv[1]; - ind = (int *)argv[2]; - inds = (int *)argv[3]; - validx = (int *)argv[4]; - nx = (int *)argv[5]; - dim = (int *)argv[6]; - for (i=0; i < *nx; i++) { - // printf("nx = %u",i); - xc = x[ind[i]-1]-1; - yc = y[ind[i]-1]-1; - if (xc < *dim-1) validx[i*4] = inds[*dim*yc+xc+1] > 0; - if (yc < *dim-1) validx[i*4+1] = inds[*dim*(yc+1)+xc] > 0; - if (xc > 0) validx[i*4+2] = inds[*dim*yc+xc-1] > 0; - if (yc > 0) validx[i*4+3] = inds[*dim*(yc-1)+xc] > 0; - } + rco_d* a; + long i,j,nz; + long *ax, *acx, *hjx, *rind; + ax = (long *)argv[0]; + acx = (long *)argv[1]; + hjx = (long *)argv[2]; + rind = (long *)argv[3]; + a = (rco_d *)argv[4]; + nz = 0; + for (i=0; i < a->n; i++) {ax[hjx[i]] += 1;} + for (i=1; i < a->c+1; i++) {acx[i] = ax[i-1]+acx[i-1];} + for (i=0; i < a->r; i++) { + nz = (a->ix)[i+1]-(a->ix)[i]; + if (nz > 0) { + for (j=0; j < nz; j++) {rind[(a->ix)[i]+j] = i;}}} return i; } -//------------------------------------------------ -int laplace2_float(argc,argv) + +long ruosgs_float(argc,argv) int argc; void *argv[]; { - int i,j,cn,cp,xc,yc,*nx,*dim; - float *xn,*v5,*v4,*v3; - int *ix,*jx,*validx,*inds,*aind; - ix = (int *)argv[0]; - jx = (int *)argv[1]; - xn = (float *)argv[2]; - validx = (int *)argv[3]; - nx = (int *)argv[4]; - dim = (int *)argv[5]; - inds = (int *)argv[6]; - aind = (int *)argv[7]; - v5 = (float *)argv[8]; - v4 = (float *)argv[9]; - v3 = (float *)argv[10]; - cp = 0; - for (i=0; i < *nx; i++) { - cn = 0; - jx[cp] = i; - cn++; - xc = aind[i]-1; - yc = aind[*nx+i]-1; - if (validx[i*4] == 1) { - jx[cp+cn] = i+1; - cn++; - } - if (validx[i*4+1] == 1) { - jx[cp+cn] = inds[*dim*(yc+1)+xc]-1; - cn++; - } - if (validx[i*4+2] == 1) { - jx[cp+cn] = i-1; - cn++; - } - if (validx[i*4+3] == 1) { - jx[cp+cn] = inds[*dim*(yc-1)+xc]-1; - cn++; - } - if (cn == 5) { - for (j=0; j < cn; j++) { - xn[cp+j] = v5[j]; - } - } else if (cn == 4) { - for (j=0; j < cn; j++) { - xn[cp+j] = v4[j]; - } - } else if (cn == 3){ - for (j=0; j < cn; j++) { - xn[cp+j] = v3[j]; + rco* a; + rco* b; + long i,j; + float *d, *u, *v, *x; + a = (rco *)argv[0]; + b = (rco *)argv[1]; + d = (float *)argv[2]; + u = (float *)argv[3]; + v = (float *)argv[4]; + x = (float *)argv[5]; + for (i=0; i < a->r; i++) { + if ((a->ix)[i+1] > (a->ix)[i]) { + for (j=(a->ix)[i]; j < (a->ix)[i+1]; j++) { + u[i] = (a->xn)[j]*x[(a->jx)[j]]; + } + } + if (i > 0) { + if ((b->ix)[i+1] > (b->ix)[i]) { + for (j=(b->ix)[i]; j < (b->ix)[i+1]; j++) { + u[i] += (b->xn)[j]*x[(b->jx)[j]]; + } } } - cp += cn; - ix[i+1] = cp; + x[i] = (v[i]-u[i])/d[i]; } - return cp; -} + return j; +} -//------------------------------------------------ diff -urN '--exclude=debian' '--exclude=.git' yorick-soy-1.2.01/soy.i yorick-soy/soy.i --- yorick-soy-1.2.01/soy.i 2006-05-03 19:54:59.000000000 +0200 +++ yorick-soy/soy.i 2012-03-05 15:48:10.000000000 +0100 @@ -1,41 +1,28 @@ /* - SOY 1.2 (2005-Apr-11) Sparse Operations with Yorick - Author: Ralf Flicker (rflicker@mac.com) - Web site: http://homepage.mac.com/rflicker/soy.htm - - This work free software; you may redistribute and modify - it under the terms of the GNU General Public License. + SOY: Sparse Operations with Yorick + Copyright (C) 2004 Ralf Flicker + Copyright (C) 2010 Marcos van Dam (marcos@flatwavefronts.com) - Revision history: - - 2004/11/14: SOY v1.0 - - Wrappers translated from IDL to Yorick (v1.5.15) - - 2004/11/18: SOY v1.1 - - Adapted as a plugin for Yorick v1.6.01 - - Memory management from Yorick scripting level - - 2005/04/11: SOY v1.2 - - Updated for Yorick v1.6.02 - - Ported for 64-bit OS compatibility + This work free software; you can redistribute it and/or + modify it under the terms of the Creative Commons License + Attribution-NonCommercial-ShareAlike 2.0. This software + is distributed in the hope that it will be useful, but + WITHOUT ANY WARRANTY. Follow the CC links on the distribution + site for more details: http://homepage.mac.com/rflicker/soy.htm */ -/* MAKE-INSTRUCTIONS -SRCS = soy.c -LIB = soy -*/ - //================================================================== -if (!is_void(plug_in)) plug_in, "soy"; -write,"SOY v1.2.01 (COW-development version)"; +plug_in, "soy"; +soy_version = "1.3.2"; +write,format="SOY %s plugin loaded\n",soy_version; struct rco { - int r; - int c; - int n; + long r; + long c; + long n; pointer ix; pointer jx; pointer xn; @@ -44,9 +31,9 @@ struct rco_d { - int r; - int c; - int n; + long r; + long c; + long n; pointer ix; pointer jx; pointer xn; @@ -55,8 +42,8 @@ struct ruo { - int r; - int n; + long r; + long n; pointer ix; pointer jx; pointer xn; @@ -66,8 +53,8 @@ struct ruo_d { - int r; - int n; + long r; + long n; pointer ix; pointer jx; pointer xn; @@ -76,239 +63,119 @@ } //================================================================== -func rcoinf(a) - /* DOCUMENT func rcoinf(a) - Inflates RCO compressed matrix to full form. - */ -{ - if (typeof(*a.xn) == "float") x = array(float,a.c,a.r); - else if (typeof(*a.xn) == "double") x = array(double,a.c,a.r); - else error,"Unsupported Data Type"; - for (i=1; i<=a.r; i++) { - if ((*a.ix)(i+1) > (*a.ix)(i)) { - for (j=(*a.ix)(i)+1; j<=(*a.ix)(i+1); j++) { - x((*a.jx)(j)+1,i)=(*a.xn)(j);}}} - return x; -} - -//================================================================== -func ruoinf(a) - /* DOCUMENT func ruoinf(a) - Inflates RUO compressed matrix to full form. - */ -{ - if (typeof(*a.xn) == "float") x = array(float,a.r,a.r); - else if (typeof(*a.xn) == "double") x = array(double,a.r,a.r); - else error,"Unsupported Data Type"; - for (i=1; i<=a.r; i++) x(i,i) = (*a.xd)(i); - for (i=1; i (*a.ix)(i)) { - //k++; - //write,format="%i %i %i %i\n",k,(*a.ix)(i),(*a.ix)(i+1),(*a.ix)(i+1) > (*a.ix)(i); - for (j=(*a.ix)(i)+1; j<=(*a.ix)(i+1); j++) { - x(i,(*a.jx)(j)+1)=x((*a.jx)(j)+1,i)=(*a.xn)(j);}}} - return x; -} - -//================================================================== -func rcox(a,c) - /* DOCUMENT func rcox(a,c) - Multiplies RCO compressed matrix by a scalar. - */ -{ - if (typeof(*a.xn) != typeof(c)) error,"Mixed Data Types"; - (*a.xn)(1:a.n) = c*(*a.xn)(1:a.n); -} -//================================================================== -func ruox(a,c) - /* DOCUMENT func ruox(a,c) - Multiplies RUO matrix "a" by a scalar "c". +func sprco(x,ur=,un=) + /* DOCUMENT func sprco(x,ur=,un=) + Store a 2D matrix on sparse RCO form (see SOY documentation + for more info on this and other formats used). + SEE ALSO: sprco_float.c, sprco_double.c (soy.c) */ { - if (typeof(*a.xn) != typeof(c)) error,"Mixed Data Types"; - (*a.xn)(1:a.n) = c*(*a.xn)(1:a.n); - (*a.xd)(1:a.r) = c*(*a.xd)(1:a.r); -} - -//================================================================== -func rcos(a) - /* DOCUMENT func rcos(a) - Computes the sparseness (or rather, the "fill") of a matrix on RCO format. - */ -{ - if (a.r != 0) {xfill = float(a.n)/float(a.c)/float(a.r);} - else {xfill = 0;} - return xfill; -} - -//================================================================== -func ruos(a) - /* DOCUMENT func ruos(a) - Computes the sparseness (or rather, the "fill") of a matrix on RUO format. - */ -{ - if (a.r != 0) {xfill = (float(a.n)*2.0f+float(a.r))/float(a.r)^2.;} - else {xfill = 0;} - return xfill; -} - -//================================================================== -func spinfo(A) - /* DOCUMENT func spinfo(a) - Prints information about a sparse matrix in RCO or RUO format. - */ -{ - nsx = dimsof(A)(0); - if (nsx == 0 && (typeof(A(1)) == "struct_instance")) nsx = 1; - for (nx=1; nx<=nsx; nx++) { - a = A(nx); - if (nsx > 1) write,format="Block # %i\n",nx; - if (typeof(a) != "struct_instance") {error,"Argument not a RCO or RUO structure!";} - members= strtok(strtok(print(structof(a))(2:-1))(2,)," (;")(1,); - if (numberof(members) != 7) {error,"Argument not a RCO or RUO structure!";} - if (members(2) == "c") { - sptype = "RCO"; - if (a.n != 0) {xfill = rcos(a)*100.;} - else {error,"empty structure";} - } else { - sptype = "RUO"; - if (a.n != 0) {xfill = ruos(a)*100.;} - else {error,"empty structure";} - } - ur = numberof(*a.ix); - un = numberof(*a.xn); - sfilln = float(a.n)/float(un)*100.; - sfillr = float(a.r)/float(ur)*100.; - ptype = typeof((*a.xn)(1)); - write,sptype+", "+ptype+" stored max. usage"; - write,format="no. rows : %8i %9i %4.2f%%\n",a.r,ur,sfillr; - write,format="elements : %8i %9i %4.2f%%\n",a.n,un,sfilln; - if (sptype == "RCO") write,format=" (cols : %8i)\n",a.c; - write,format="matrix fill : %4.2f%%\n",xfill; - } -} -//================================================================== -func sprco(x,t=,ur=,un=) - /* DOCUMENT func sprco(x,t=,ur=,un=) - Compress a 2D matrix on sparse RCO format. - SEE ALSO: sprco_float (soy.c) - */ -{ - argc = 7; + argc = 2; if (ur == []) ur = MR; if (un == []) un = MN; - c = int((dimsof(x))(2)); - r = int((dimsof(x))(3)); - ix = array(int,ur); - jx = array(int,un); if (typeof(x) == "float") { - if (t != []) {t = float(t);} - else {t = float(0);} - xn = array(float,un); - a = [&x,&r,&c,&t,&ix,&jx,&xn]; - n = sprco_float(argc,&a); s = rco(); - } else if (typeof(x) == "double") { - if (t != []) {t = double(t);} - else {t = double(0);} - xn = array(double,un); - a = [&x,&r,&c,&t,&ix,&jx,&xn]; - n = sprco_double(argc,&a); + s.c = long((dimsof(x))(2)); + s.r = long((dimsof(x))(3)); + s.ix = &(array(long,ur)); + s.jx = &(array(long,un)); + s.xn = &(array(float,un)); + a = [&s,&x]; + tmp = sprco_float(argc,&a); + return s;} + else if (typeof(x) == "double") { s = rco_d(); - } else error,"Unsupported Data Type"; - s.r = r; - s.c = c; - s.n = n; - s.t = t; - s.ix = &ix; - s.jx = &jx; - s.xn = &xn; - return s; + s.c = long((dimsof(x))(2)); + s.r = long((dimsof(x))(3)); + s.ix = &(array(long,ur)); + s.jx = &(array(long,un)); + s.xn = &(array(double,un)); + a = [&s,&x]; + tmp = sprco_double(argc,&a); + return s;} + else error,"Unsupported Data Type"; } extern sprco_float; /* PROTOTYPE - int sprco_float(int argc, pointer a) + long sprco_float(int argc, pointer a) */ + extern sprco_double; /* PROTOTYPE - int sprco_double(int argc, pointer a) + long sprco_double(int argc, pointer a) */ //================================================================== -func spruo(x,t=,ur=,un=) - /* DOCUMENT func spruo(x,t=,ur=,un=) - Compress a 2D matrix on sparse RUO format. - SEE ALSO: spruo_float (soy.c) +func spruo(x,ur=,un=) + /* DOCUMENT func spruo(x) + Store a square matrix on sparse RUO format. + SEE ALSO: spruo_float.c, spruo_double.c (soy.c) */ { - argc = 7; + argc = 2; if (ur == []) ur = MR; if (un == []) un = MN; - r = int((dimsof(x))(3)); - ix = array(int,ur); - jx = array(int,un); if (typeof(x) == "float") { - if (t != []) {t = float(t);} - else {t = float(0);} - xn = array(float,un); - xd = array(float,ur); - a = [&x,&r,&t,&ix,&jx,&xn,&xd]; - n = spruo_float(argc,&a); s = ruo(); - } else if (typeof(x) == "double") { - if (t != []) {t = double(t);} - else {t = double(0);} - xn = array(double,un); - xd = array(double,ur); - a = [&x,&r,&t,&ix,&jx,&xn,&xd]; - n = spruo_double(argc,&a); + s.r = long((dimsof(x))(3)); + s.ix = &(array(long,ur)); + s.jx = &(array(long,un)); + s.xn = &(array(float,un)); + s.xd = &(array(float,ur)); + a = [&s,&x]; + tmp = spruo_float(argc,&a); + return s;} + else if (typeof(x) == "double") { s = ruo_d(); - } else error,"Unsupported Data Type"; - s.r = r; - s.n = n; - s.t = t; - s.ix = &ix; - s.jx = &jx; - s.xn = &xn; - s.xd = &xd; - return s; + s.r = long((dimsof(x))(3)); + s.ix = &(array(long,ur)); + s.jx = &(array(long,un)); + s.xn = &(array(double,un)); + s.xd = &(array(double,ur)); + a = [&s,&x]; + tmp = spruo_double(argc,&a); + return s;} + else error,"Unsupported Data Type"; } extern spruo_float; /* PROTOTYPE - int spruo_float(int argc, pointer a) + long spruo_float(int argc, pointer a) */ + extern spruo_double; /* PROTOTYPE - int spruo_double(int argc, pointer a) + long spruo_double(int argc, pointer a) */ //================================================================== func rcoxv(a,v) /* DOCUMENT func rcoxv(a,v) - Sparse matrix-vector multiplication of RCO and real vector. - SEE ALSO: rcoxv_float (soy.c) + Matrix-vector multiplication with RCO matrix "a" and real "v". + SEE ALSO: rcoxv.c (soy.c) */ { - argc = 6; + argc = 3; if (typeof(v) == "float" && typeof(*a.xn) == "float") { u = array(float,a.r); - s = [&v,&u,&a.r,a.ix,a.jx,a.xn]; + s = [&a,&v,&u]; tmp = rcoxv_float(argc,&s); - } else if (typeof(v) == "double" && typeof(*a.xn) == "double") { + return u;} + else if (typeof(v) == "double" && typeof(*a.xn) == "double") { u = array(double,a.r); - s = [&v,&u,&a.r,a.ix,a.jx,a.xn]; + s = [&a,&v,&u]; tmp = rcoxv_double(argc,&s); - } - return u; + return u;} + else error,"Unsupported/mixed Data Types"; } extern rcoxv_float; /* PROTOTYPE int rcoxv_float(int argc, pointer s) */ + extern rcoxv_double; /* PROTOTYPE int rcoxv_double(int argc, pointer s) @@ -317,267 +184,249 @@ //================================================================== func ruoxv(a,v) /* DOCUMENT func ruoxv(a,v) - Sparse matrix-vector multiplication of RUO and real vector. - SEE ALSO: ruoxv_float (soy.c) + Matrix-vetor multiplication with RUO matrix "a" and real "v". + SEE ALSO: ruoxv_float.c, ruoxv_double.c (soy.c) */ { - argc = 8; + argc = 4; if (typeof(v) == "float" && typeof(*a.xn) == "float") { u = array(float,a.r); w = array(float,a.r); - s = [&v,&u,&w,&a.r,a.ix,a.jx,a.xn,a.xd]; - tmp = ruoxv_float(argc,&s); - } else if (typeof(v) == "double" && typeof(*a.xn) == "double") { + s = [&a,&v,&u,&w]; + tmp = ruoxv_float(argc, &s); + return u;} + else if (typeof(v) == "double" && typeof(*a.xn) == "double") { u = array(double,a.r); w = array(double,a.r); - s = [&v,&u,&w,&a.r,a.ix,a.jx,a.xn,a.xd]; - tmp = ruoxv_double(argc,&s); - } - return u; + s = [&a,&v,&u,&w]; + tmp = ruoxv_double(argc, &s); + return u;} + else error,"Unsupported/mixed Data Types"; } extern ruoxv_float; /* PROTOTYPE - int ruoxv_float(int argc, pointer s) + long ruoxv_float(int argc, pointer s) */ + extern ruoxv_double; /* PROTOTYPE - int ruoxv_double(int argc, pointer s) + long ruoxv_double(int argc, pointer s) */ + //================================================================== func rcoadd(a,b,ur=,un=) - /* DOCUMENT func rcoadd(a,b,ur=,un=) - Sparse addition of two RCO matrices. - SEE ALSO: rcoadd_float (soy.c) + /* DOCUMENT func rcoadd(a,b) + Addition of two RCO matrices "a" and "b". + SEE ALSO: rcoadd_float.c, rcoadd_double.c (soy.c) */ { if (typeof(*a.xn) != typeof(*b.xn)) error,"Mixed Data Types"; if (a.r != b.r || a.c != b.c) error,"Matrices have incompatible dimensions!"; - argc = 17; - if (ur == []) {ur = 2*(a.r+b.r);} - if (un == []) {un = 2*(a.n+b.n);} - ss = array(int,ur); + argc = 5; + if (ur == []) ur = MR; + if (un == []) un = MN; + ss = array(long,ur); if (typeof(*a.xn) == "float") { c = rco(); c.r = a.r; c.c = a.c; c.t = a.t; - c.ix = &(array(int,ur)); - c.jx = &(array(int,un)); + c.ix = &(array(long,ur)); + c.jx = &(array(long,un)); c.xn = &(array(float,un)); t = array(float,ur); - s = [&a.r,&a.c,a.ix,a.jx,a.xn,&b.r,&b.c,b.ix,b.jx,b.xn,&c.r,&c.c,c.ix,c.jx,c.xn,&t,&ss]; - n = rcoadd_float(argc, &s); - } + s = [&a,&b,&c,&t,&ss]; + tmp = rcoadd_float(argc, &s); + return c;} else if (typeof(*a.xn) == "double") { c = rco_d(); c.r = a.r; c.c = a.c; c.t = a.t; - c.ix = &(array(int,ur)); - c.jx = &(array(int,un)); + c.ix = &(array(long,ur)); + c.jx = &(array(long,un)); c.xn = &(array(double,un)); t = array(double,ur); - s = [&a.r,&a.c,a.ix,a.jx,a.xn,&b.r,&b.c,b.ix,b.jx,b.xn,&c.r,&c.c,c.ix,c.jx,c.xn,&t,&ss]; - n = rcoadd_double(argc,&s); - } + s = [&a,&b,&c,&t,&ss]; + tmp = rcoadd_double(argc, &s); + return c;} else error,"Unsupported Data Type"; - c.n = n; - return c; } extern rcoadd_float; /* PROTOTYPE - int rcoadd_float(int argc, pointer s) + long rcoadd_float(int argc, pointer s) */ + extern rcoadd_double; /* PROTOTYPE - int rcoadd_double(int argc, pointer s) + long rcoadd_double(int argc, pointer s) */ + //================================================================== func ruoadd(a,b,ur=,un=) - /* DOCUMENT func ruoadd(a,b,ur=,un=) - Sparse addition of two RUO matrices. - SEE ALSO: ruoadd_float (soy.c) + /* DOCUMENT func ruoadd(a,b) + Addition of two square symmetric RUO matrices "a" and "b". + SEE ALSO: ruoadd_float.c, ruoadd_double.c (soy.c) + Modified by Marcos van Dam, April 2011. + Now adds diagonal matrices */ { if (typeof(*a.xn) != typeof(*b.xn)) error,"Mixed Data Types"; if (a.r != b.r) error,"Matrices have incompatible dimensions!"; - argc = 17; - if (ur == []) {ur = a.r+b.r;} - if (un == []) {un = 2*(a.n+b.n);} - ss = array(int,ur); + + argc = 5; + if (ur == []) ur = MR; + if (un == []) un = MN; + s = array(long,a.r); if (typeof(*a.xn) == "float") { c = ruo(); c.r = a.r; c.t = a.t; - c.ix = &(array(int,ur)); - c.jx = &(array(int,un)); + c.ix = &(array(long,ur)); + c.jx = &(array(long,un)); c.xn = &(array(float,un)); - c.xd = &(array(float,ur)); - tt = array(float,ur); - s = [&a.r,a.xd,a.ix,a.jx,a.xn,&b.r,b.xd,b.ix,b.jx,b.xn,&c.r,c.xd,c.ix,c.jx,c.xn,&tt,&ss]; - n = ruoadd_float(argc, &s); - } + if (a.n+b.n == 0){ // fix bug when adding two diagonal matrices + c.xd = &(*a.xd + *b.xd); + } else { + c.xd = &(array(float,ur)); + tt = array(float,a.n+b.n); + t = [&a,&b,&c,&tt,&s]; + tmp = ruoadd_float(argc, &t); + } + return c;} else if (typeof(*a.xn) == "double") { c = ruo_d(); c.r = a.r; c.t = a.t; - c.ix = &(array(int,ur)); - c.jx = &(array(int,un)); + c.ix = &(array(long,ur)); + c.jx = &(array(long,un)); c.xn = &(array(double,un)); - c.xd = &(array(double,ur)); - tt = array(double,ur); - s = [&a.r,a.xd,a.ix,a.jx,a.xn,&b.r,b.xd,b.ix,b.jx,b.xn,&c.r,c.xd,c.ix,c.jx,c.xn,&tt,&ss]; - n = ruoadd_double(argc,&s); - } + if (a.n+b.n == 0){ // fix bug when adding two diagonal matrices + c.xd = &(*a.xd + *b.xd); + } else { + c.xd = &(array(double,ur)); + tt = array(double,a.n+b.n); + t = [&a,&b,&c,&tt,&s]; + tmp = ruoadd_double(argc, &t); + } + return c;} else error,"Unsupported Data Type"; - c.n = n; - return c; } extern ruoadd_float; /* PROTOTYPE - int ruoadd_float(int argc, pointer s) + long ruoadd_float(int argc, pointer t) */ + extern ruoadd_double; /* PROTOTYPE - int ruoadd_double(int argc, pointer s) + long ruoadd_double(int argc, pointer t) */ + //================================================================== -func rcoata(a,ur=,un=,t=) - /* DOCUMENT func rcoata(a,ur=,un=,t=) - Sparse mutiplication of an RCO matrix with its transpose from - the left, i.e. transpose(a)##a - SEE ALSO: rcoata_float (soy.c) +func rcoata(a,ur=,un=) + /* DOCUMENT func rcoata(a) + Matrix mutiplication of RCO matrix "a" with its transpose from + the left, e.g. returns transpose(a)#a. + SEE ALSO: rcoata_float.c, rcoata_double.c (soy.c) */ { - argc = 9; - if (ur == [] && MR != []) ur = MR; - if (ur == [] && MR == []) { - ur = int(a.r+2); - } - if (un == [] && MN != []) un = MN; - if (un == [] && MN == []) { - un = int(a.n*5); - } + argc = 2; + if (ur == []) ur = MR; + if (un == []) un = MN; if (typeof(*a.xn) == "float") { b = ruo(); b.r = a.r; - if (is_set(t)) b.t = t; - else b.t = float(a.t^2.); - b.ix = &(array(int,ur)); - b.jx = &(array(int,un)); + b.t = a.t; + b.ix = &(array(long,ur)); + b.jx = &(array(long,un)); b.xn = &(array(float,un)); b.xd = &(array(float,ur)); - s = [&a.r,a.ix,a.jx,a.xn,&b.t,b.ix,b.jx,b.xn,b.xd]; - n = rcoata_float(argc,&s); - } + s = [&a,&b]; + tmp = rcoata_float(argc, &s); + return b;} else if (typeof(*a.xn) == "double") { b = ruo_d(); b.r = a.r; - if (is_set(t)) b.t = t; - else b.t = double(a.t^2.); - b.ix = &(array(int,ur)); - b.jx = &(array(int,un)); + b.t = a.t; + b.ix = &(array(long,ur)); + b.jx = &(array(long,un)); b.xn = &(array(double,un)); b.xd = &(array(double,ur)); - s = [&a.r,a.ix,a.jx,a.xn,&b.t,b.ix,b.jx,b.xn,b.xd]; - n = rcoata_double(argc, &s); - } + s = [&a,&b]; + tmp = rcoata_double(argc, &s); + return b;} else error,"Unsupported Data Type"; - b.n = n; - return b; } extern rcoata_float; /* PROTOTYPE - int rcoata_float(int argc, pointer s) + long rcoata_float(int argc, pointer s) */ + extern rcoata_double; /* PROTOTYPE - int rcoata_double(int argc, pointer s) + long rcoata_double(int argc, pointer s) */ + //================================================================== -func rcoatb(a,b,ur=,un=,t=,u=) - /* DOCUMENT func rcoatb(a,b,ur=,un=,t=,u=) - Sparse mutiplication of two RCO matrices, a'.b. Setting u=1 - ("upper") computes only the upper triangular and diagonal - elements of the matrix product, and returns an RUO matrix. - Use this when computing e.g. the final step of a 3-matrix - product of the type M = A'.W.A, where A is RCO, W is RUO - and you know that the final result must be RUO. - SEE ALSO: rcoatb_float (soy.c) +func rcoatb(a,b,ur=,un=) + /* DOCUMENT func rcoatb(a) + Matrix mutiplication of two RCO matrices "a" and transpose "b". + SEE ALSO: rcoatb_float.c (soy.c) */ { + argc = 3; if (ur == []) ur = MR; if (un == []) un = MN; if (typeof(*a.xn) == "float" && typeof(*b.xn) == "float") { - if (u == 1) { - argc = 13; - c = ruo(); - c.r = a.r; - if (is_set(t)) c.t = t; - else c.t = min([a.t,b.t]); - c.ix = &(array(int,ur)); - c.jx = &(array(int,un)); - c.xn = &(array(float,un)); - c.xd = &(array(float,ur)); - s = [&a.r,a.ix,a.jx,a.xn,&b.r,b.ix,b.jx,b.xn,&c.t,c.ix,c.jx,c.xn,c.xd]; - n = rcoatb2_float(argc,&s); - } - else { - argc = 12; - c = rco(); - c.r = a.r; - c.c = b.r; - if (is_set(t)) c.t = t; - else c.t = min([a.t,b.t]); - c.ix = &(array(int,ur)); - c.jx = &(array(int,un)); - c.xn = &(array(float,un)); - s = [&a.r,a.ix,a.jx,a.xn,&b.r,b.ix,b.jx,b.xn,&c.t,c.ix,c.jx,c.xn]; - n = rcoatb_float(argc,&s); - } - } + c = rco(); + c.r = a.r; + c.c = b.r; + c.t = min([a.t,b.t]); + c.ix = &(array(long,ur)); + c.jx = &(array(long,un)); + c.xn = &(array(float,un)); + s = [&a,&b,&c]; + tmp = rcoatb_float(argc, &s); + return c;} else if (typeof(*a.xn) == "double" && typeof(*b.xn) == "double") { - argc = 12; c = rco_d(); c.r = a.r; c.c = b.r; - if (is_set(t)) c.t = t; - else c.t = min([a.t,b.t]); - c.ix = &(array(int,ur)); - c.jx = &(array(int,un)); + c.t = min([a.t,b.t]); + c.ix = &(array(long,ur)); + c.jx = &(array(long,un)); c.xn = &(array(double,un)); - s = [&a.r,a.ix,a.jx,a.xn,&b.r,b.ix,b.jx,b.xn,&c.t,c.ix,c.jx,c.xn]; - n = rcoatb_double(argc,&s); - } + s = [&a,&b,&c]; + tmp = rcoatb_double(argc, &s); + return c;} else error,"Unsupported or mixed data type(s)"; - c.n = n; - return c; } extern rcoatb_float; /* PROTOTYPE - int rcoatb_float(int argc, pointer s) -*/ -extern rcoatb2_float; -/* PROTOTYPE - int rcoatb2_float(int argc, pointer s) + long rcoatb_float(int argc, pointer s) */ + extern rcoatb_double; /* PROTOTYPE - int rcoatb_double(int argc, pointer s) + long rcoatb_double(int argc, pointer s) */ + //================================================================== func rcotr(a) - /* DOCUMENT func rcotr(arg) - Transposes an RCO matrix. Uses one builtin Yorick function - (sort) to make the rest a little bit easier. + /* DOCUMENT func rcotr(a) + Transposes an RCO matrix. This is actually quite complicated, + so I use one builtin Yorick function first (sort) to make life + just a little bit easier. + Modified 2010/07/29 by Marcos van Dam + Fixed problem with zero matrices not transposing */ { - argc = 8; + argc = 5; ur = dimsof(*a.ix); un = dimsof(*a.xn); if (typeof(*a.xn) == "float") { @@ -593,25 +442,172 @@ at.r = a.c; at.c = a.r; at.t = a.t; - at.ix = &(array(int,a.c+2)); - at.jx = &(array(int,un)); - sjx = int(sort((*a.jx)(1:a.n))); - hjx = (*a.jx)(sjx); - ax = array(int,a.c); - acx = array(int,a.c+2); - rind = array(int,at.n); - s = [&ax,&acx,&hjx,&rind,&a.r,&a.c,&a.n,a.ix]; - tmp = rcotr_fix(argc, &s); - (*at.ix)(1:at.r+1) = acx(1:at.r+1); - (*at.jx)(1:at.n) = rind(sjx); - (*at.xn)(1:at.n) = (*a.xn)(sjx); + at.ix = &(array(long,ur)); + at.jx = &(array(long,un)); + if (a.n > 0){ + sjx = long(sort((*a.jx)(1:a.n))); + hjx = (*a.jx)(sjx); + ax = array(long,a.c); + acx = array(long,a.c+1); + rind = array(long,at.n); + s = [&ax,&acx,&hjx,&rind,&a]; + if (typeof(*a.xn) == "float") tmp = rcotr_float(argc, &s); + if (typeof(*a.xn) == "double") tmp = rcotr_double(argc, &s); + (*at.ix)(1:at.r+1) = acx; + (*at.jx)(1:at.n) = rind(sjx); + (*at.xn)(1:at.n) = (*a.xn)(sjx); + } return at; } -extern rcotr_fix; +extern rcotr_float; +/* PROTOTYPE + long rcotr_float(int argc, pointer s) +*/ + +extern rcotr_double; /* PROTOTYPE - int rcotr_fix(int argc, pointer s) + long rcotr_double(int argc, pointer s) */ + +//================================================================== +func ruosgs(a,b,d,n,x,v) + /* DOCUMENT func ruosgs(a,b,n,x,v) + Symmetric Gauss-Seidel iterations. + */ +{ + argc = 6; + u = array(float,a.r); + s = [&a,&b,&d,&u,&v,&x]; + for (nn=1; nn<=n; nn++) { + tmp = ruosgs_float(argc, &s); + if (nn < n) u = array(float,a.r); + } + return x; +} + +extern ruosgs_float; +/* PROTOTYPE + long ruosgs_float(int argc, pointer s) +*/ + +//================================================================== +//func rcoxv_mt(a,v) +// /* DOCUMENT func rcoxv_mt(a,v) +// Multi-threaded sparse matrix-vector multiplication +// with RCO matrix "a" and real vector "v". +// SEE ALSO: rcoxv_threads_float.c (soy.c) +// */ +//{ +// argc = 3; +// u = array(float,a.r); +// s = [&a,&v,&u]; +// tmp = rcoxv_thread(argc,&s); +// return u; +//} +// +//extern rcoxv_thread; +///* PROTOTYPE +// int rcoxv_thread(int argc, pointer s) +//*/ + +//================================================================== +func rcoinf(a) + /* DOCUMENT func rcoinf(a) + Inflates RCO matrix "a" to its full form, the explicit 2D matrix. + */ +{ + if (typeof(*a.xn) == "float") x = array(float,a.c,a.r); + else if (typeof(*a.xn) == "double") x = array(double,a.c,a.r); + else error,"Unsupported Data Type"; + for (i=1; i<=a.r; i++) { + if ((*a.ix)(i+1) > (*a.ix)(i)) { + for (j=(*a.ix)(i)+1; j<=(*a.ix)(i+1); j++) { + x((*a.jx)(j)+1,i)=(*a.xn)(j);}}} + return x; +} + +func ruoinf(a) + /* DOCUMENT func ruoinf(a) + Inflates RUO matrix "a" to full form. + */ +{ + if (typeof(*a.xn) == "float") x = array(float,a.r,a.r); + else if (typeof(*a.xn) == "double") x = array(double,a.r,a.r); + else error,"Unsupported Data Type"; + for (i=1; i<=a.r; i++) x(i,i) = (*a.xd)(i); + for (i=1; i (*a.ix)(i)) { + for (j=(*a.ix)(i)+1; j<=(*a.ix)(i+1); j++) { + x(i,(*a.jx)(j)+1)=x((*a.jx)(j)+1,i)=(*a.xn)(j);}}} + return x; +} + +func rcox(a,c) + /* DOCUMENT func rcox(a,c) + Multiplies RCO matrix "a" with a scalar "c". + */ +{ + if (typeof(*a.xn) != typeof(c)) error,"Mixed Data Types"; + (*a.xn)(1:a.n) = c*(*a.xn)(1:a.n); +} + +func ruox(a,c) + /* DOCUMENT func ruox(a,c) + Multiplies RUO matrix "a" with scalar "c". + */ +{ + if (typeof(*a.xn) != typeof(c)) error,"Mixed Data Types"; + (*a.xn)(1:a.n) = c*(*a.xn)(1:a.n); + (*a.xd)(1:a.r) = c*(*a.xd)(1:a.r); +} + +func rcos(a) + /* DOCUMENT func rcos(a) + Computes the sparseness (or rather, the "fill") of a matrix on RCO format. + */ +{ + if (a.r != 0) {xfill = float(a.n)/float(a.c*a.r);} + else {xfill = 0;} + return xfill; +} + +func ruos(a) + /* DOCUMENT func ruos(a) + Computes the sparseness (or rather, the "fill") of a matrix on RUO format. + */ +{ + if (a.r != 0) {xfill = float(a.n*2+a.r)/float(a.r^2.);} + else {xfill = 0;} + return xfill; +} + +func spinfo(a) + /* DOCUMENT func spinfo(a) + Prints information about a sparse matrix in RCO or RUO format. + */ +{ + if (typeof(a) != "struct_instance") {error,"Argument not a RCO or RUO structure!";} + members= strtok(strtok(print(structof(a))(2:-1))(2,)," (;")(1,); + if (numberof(members) != 7) {error,"Argument not a RCO or RUO structure!";} + if (members(2) == "c") { + sptype = "RCO"; + xfill = rcos(a)*100.; + } else { + sptype = "RUO"; + xfill = ruos(a)*100.; + } + ur = numberof(*a.ix); + un = numberof(*a.xn); + sfilln = float(a.n)/float(un)*100.; + sfillr = float(a.r)/float(ur)*100.; + write,"["+sptype+"] stored max. usage"; + write,format="no. rows : %8i %9i %4.2f%%\n",a.r,ur,sfillr; + write,format="elements : %8i %9i %4.2f%%\n",a.n,un,sfilln; + if (sptype == "RCO") write,format=" (cols : %8i)\n",a.c; + write,format="matrix fill : %4.2f%%\n",xfill; +} + //================================================================== func ruopcg(a,b,x0,&nit,tol=,itmax=,sgs=) /* DOCUMENT func ruopcg(a,b,x0,&nit,tol=,itmax=,sgs=) @@ -633,12 +629,9 @@ if (tol == []) tol = 1.e-4; x = array(double,a.r); bnrm = sum(b^2.); - u = ruoxv(a,x0(1:a.r)); + u = ruoxv(a,x0); r = b-u; - //tmp = float(sqrt((*a.xd)(1:a.r))); - tmp = (*a.xd)(1:a.r); - //if (sgs == []) {z = r/(*a.xd)(1:a.r);} // Jacobi preconditioner - if (sgs == []) {z = r/tmp;} // Jacobi preconditioner + if (sgs == []) {z = r/(*a.xd)(1:a.r);} // Jacobi preconditioner // else {z = ruosgs_Y(x0,r,sgs,U,D,L);} // Gauss-Seidel iterations else {z = ruosgs(U,L,D,sgs,x0*0.f,r);} // Gauss-Seidel iterations k = 0; @@ -651,15 +644,14 @@ p = bk*p+z;} else p = z; bkden = bknum; - if (prec == "float") u = ruoxv(a,float(p(1:a.r))); - else u = ruoxv(a,double(p(1:a.r))); + if (prec == "float") u = ruoxv(a,float(p)); + else u = ruoxv(a,double(p)); z = u; akden = sum(z*p); ak = bknum/akden; x += ak*p; r -= ak*z; - // if (sgs == []) {z = r/(*a.xd)(1:a.r);} // Jacobi preconditioner - if (sgs == []) {z = r/tmp;} // Jacobi preconditioner + if (sgs == []) {z = r/(*a.xd)(1:a.r);} // Jacobi preconditioner // else {z = ruosgs(x0,r,sgs,U,D,L);} // Gauss-Seidel iterations else {z = ruosgs(U,L,D,sgs,x0*0.f,r);} // Gauss-Seidel iterations err = sum(r^2.)/bnrm; @@ -671,8 +663,8 @@ //================================================================== func rcobuild(&a,v,t,ur=,un=) - /* DOCUMENT func rcobuild(a,v,t,ur=,un=) - Appends a row-vector v to an RCO matrix a, at threshold t. + /* DOCUMENT func rcobuild(a,v,r,t,ur=,un=) + Appends row-vectors v to an RCO matrix a, at threshold t. */ { if (ur == []) ur = MR; @@ -681,23 +673,23 @@ if (a == [] && typeof(v) == "double") a = rco_d(); if (*a.xn == [] && typeof(v) == "float") a.xn = &(array(float,un)); if (*a.xn == [] && typeof(v) == "double") a.xn = &(array(float,un)); - if (*a.ix == []) a.ix = &(array(int,ur)); - if (*a.jx == []) a.jx = &(array(int,un)); + if (*a.ix == []) a.ix = &(array(long,ur)); + if (*a.jx == []) a.jx = &(array(long,un)); if (a.c == 0) { - a.c = int(numberof(v)); - a.r = int(0); + a.c = numberof(v); + a.r = 0; a.t = t; - a.n = int(0); + a.n = 0; } - a.r += int(1); - tmp0 = (abs(v) > t); + a.r += 1; + tmp0 = (abs(v) >= t); if (anyof(tmp0)) { tmp = where(tmp0); n = numberof(tmp); - (*a.jx)(1+a.n:a.n+n) = int(tmp-1); + (*a.jx)(1+a.n:a.n+n) = tmp-1; (*a.xn)(1+a.n:a.n+n) = v(tmp); - (*a.ix)(a.r+1) = int((*a.ix)(a.r)+n); - a.n += int(n); + (*a.ix)(a.r+1) = (*a.ix)(a.r)+n; + a.n += n; } else { (*a.ix)(a.r+1) = (*a.ix)(a.r); } @@ -713,15 +705,15 @@ { if (ur == []) ur = nact+2; if (un == []) un = nact*5+1; - w = array(int,5); + w = array(long,5); v = [&float([-1.,0.25,0.25,0.25,0.25]),\ &float([-0.75,0.25,0.25,0.25]),\ &float([-2./3.,1./3.,1./3.])]; c = rco(); - c.r = int(nact); - c.c = int(nact); - c.ix = &(array(int,ur)); - c.jx = &(array(int,un)); + c.r = nact; + c.c = nact; + c.ix = &(array(long,ur)); + c.jx = &(array(long,un)); c.xn = &(array(float,un)); c.t = 0.; cp = 0; @@ -739,515 +731,210 @@ z = where(w > 0); nz = numberof(z); (*c.xn)(cp+1:cp+nz) = *v(6-nz); - (*c.jx)(cp+1:cp+nz) = int(w(z)-1); + (*c.jx)(cp+1:cp+nz) = w(z)-1; cp += nz; - (*c.ix)(i+1) = int(cp); + (*c.ix)(i+1) = cp; } - c.n = int(cp); + c.n = cp; return c; } //================================================================== -func Laplace_FDA2(ap,ur=,un=) - /* DOCUMENT Laplace_FDA2(ap,ur=,un=) - Same as Laplace_FDA, but MUCH faster. In fact, so fast that I - don't need to bother with going to a C implementation. - Input is a [0,1]-valued aperture function. - */ -{ - dim = dimsof(ap)(0); - nx = sum(ap); - ind = where(ap); - x = span(1,dim,dim)(,-:1:dim); - y = transpose(x); - aind = array(long,nx,2); - aind(,1) = x(ind); - aind(,2) = y(ind); - inds = int(ap*0); - inds(ind) = int(span(1,nx,nx)); - - //Symbolic build - validx = array(int,nx*4); - for (i=1; i<=nx; i++) { - xc = int(x(ind(i))); - yc = int(y(ind(i))); - if (xc < dim) validx((i-1)*4+1) = inds(xc+1,yc)>0; //right - if (yc < dim) validx((i-1)*4+2) = inds(xc,yc+1)>0; //up - if (xc > 1) validx((i-1)*4+3) = inds(xc-1,yc)>0; //left - if (yc > 1) validx((i-1)*4+4) = inds(xc,yc-1)>0; //down - } - - if ((ur == []) || (ur < nx)) ur = nx+1; - if ((un == []) || (un < nx*5)) un = nx*5+1; - w = array(int,5); - v = [&float([-1.,0.25,0.25,0.25,0.25]),\ - &float([-0.75,0.25,0.25,0.25]),\ - &float([-2./3.,1./3.,1./3.])]; - c = rco(); - c.r = int(nx); - c.c = int(nx); - c.ix = &(array(int,ur)); - c.jx = &(array(int,un)); - c.xn = &(array(float,un)); - c.t = float(0.); - cp = int(0); - - //Numeric build - for (i=1; i<=nx; i++) { - w *= int(0); - cn = int(1); - w(1) = i; - if (validx((i-1)*4+1)) { - cn++; - w(cn) = w(1)+1; - } - if (validx((i-1)*4+2)) { - cn++; - w(cn) = inds(aind(i,1),aind(i,2)+1); - } - if (validx((i-1)*4+3)) { - cn++; - w(cn) = w(1)-1; - } - if (validx((i-1)*4+4)) { - cn++; - w(cn) = inds(aind(i,1),aind(i,2)-1); - } - (*c.xn)(cp+1:cp+cn) = *v(6-cn); - (*c.jx)(cp+1:cp+cn) = int(w(1:cn)-1); - cp += cn; - (*c.ix)(i+1) = int(cp); - } - c.n = int(cp); - return c; -} - -//================================================================== -func Laplace_FDA3(ap,ur=,un=) - /* DOCUMENT Laplace_FDA3(ap,ur=,un=) - Same as Laplace_FDA2, but with C implementation (faster). - Input is a [0,1]-valued aperture function. - */ -{ - /* - dim = 64; - ap = dist(dim) 0){ // fixed bug if n == 0 + v(3:n+2) = (*a.xn)(1:n); + v(n+3:2*n+2) = float((*a.jx)(1:n)); } - else error,"Unsupported data type"; - if (is_set(bin)) { - if (nsx0 == 0) {fname = fn+swrite(format="%i",int(nx))+".bin";} - else {fname = fn+".bin";} - save,createb(fname),v; - } else { - if (nsx0 == 0) {fname = fn+swrite(format="%i",int(nx))+".fits";} - else {fname = fn+".fits";} - img_write,v,fname,type="fits"; + v(2*n+3:2*n+r+4) = float((*a.ix)(1:r+2)); + v(2*n+r+5:2*n+2*r+4) = (*a.xd)(1:r); + } + else if (typeof(*a.xn) == "double") { + v = array(double,n*2+r*2+4); + v(1:2) = double([n,r]); + if (n > 0){ // fixed bug if n == 0 + v(3:n+2) = (*a.xn)(1:n); + v(n+3:2*n+2) = double((*a.jx)(1:n)); } + v(2*n+3:2*n+r+4) = double((*a.ix)(1:r+2)); + v(2*n+r+5:2*n+2*r+4) = (*a.xd)(1:r); } + else error,"Unsupported data type"; + save,createb(fn),v; } //================================================================== -func float_rco(&a) - /* DOCUMENT float_rco(&a) - Converts the double rco_d structure to float rco. - */ -{ - b = rco(); - b.r = a.r; - b.c = a.c; - b.n = a.n; - b.t = float(a.t); - b.ix = a.ix; - b.jx = a.jx; - b.xn = &float(*a.xn); - a = b; -} -//================================================================== -func float_ruo(&a) - /* DOCUMENT float_ruo(&a) - Converts the double ruo_d structure to float ruo. - */ -{ - b = ruo(); - b.r = a.r; - b.n = a.n; - b.t = float(a.t); - b.ix = a.ix; - b.jx = a.jx; - b.xn = &float(*a.xn); - b.xd = &float(*a.xd); - a = b; -} -//================================================================== -func double_rco(&a) - /* DOCUMENT double_rco(&a) - Converts the float rco structure to double rco_d. - */ -{ - b = rco_d(); - b.r = a.r; - b.c = a.c; - b.n = a.n; - b.t = double(a.t); - b.ix = a.ix; - b.jx = a.jx; - b.xn = &double(*a.xn); - a = b; -} -//================================================================== -func double_ruo(&a) - /* DOCUMENT double_ruo(&a) - Converts the float ruo structure to double ruo_d. - */ -{ - b = ruo_d(); - b.r = a.r; - b.n = a.n; - b.t = double(a.t); - b.ix = a.ix; - b.jx = a.jx; - b.xn = &double(*a.xn); - b.xd = &double(*a.xd); - a = b; -} -//================================================================== -func restore_rco(fn,bin=) - /* DOCUMENT restore_rco(fn,bin=) +func restore_rco(fn, ur=, un=) + /* DOCUMENT restore_rco(fn, ur=, un=) Returns the RCO structure saved in the file fn by save_rco. + Modified by Marcos van Dam, August 2010. + Now pads out the pointers, so that the matrices can be manipulated */ { - if (is_set(bin)) restore,openb(fn),v; - else v = img_read(fn); + if (ur == []) ur = MR; + if (un == []) un = MN; + restore,openb(fn),v; if (typeof(v) == "float") {a = rco();} else if (typeof(v) == "double") {a = rco_d();} else error,"Unsupported data type"; - a.n = int(v(1)); - a.r = int(v(2)); - a.c = int(v(3)); - a.t = v(4); - a.xn = &(v(5:a.n+4)); - a.jx = &(int(v(a.n+5:2*a.n+4))); - a.ix = &(int(v(2*a.n+5:2*a.n+a.r+5))); + a.n = long(v(1)); + a.r = long(v(2)); + a.c = long(v(3)); + + a.ix = &(array(long,ur)); + a.jx = &(array(long,un)); + a.xn = &(array(float,un)); + + xn = v(4:a.n+3); + jx = long(v(a.n+4:2*a.n+3)); + ix = long(v(2*a.n+4:2*a.n+a.r+5)); + + (*a.xn)(1:a.n) = xn; + (*a.jx)(1:numberof(jx)) = jx; + (*a.ix)(1:numberof(ix)) = ix; + return a; } //================================================================== -func restore_ruo(fn,bin=) - /* DOCUMENT restore_ruo(fn,bin=) +func restore_ruo(fn, ur=, un=) + /* DOCUMENT restore_ruo(fn, ur=, un=) Returns the RUO structure saved in the file fn by save_rco. + Modified by Marcos van Dam, August 2010. + Now pads out the pointers, so that the matrices can be manipulated + Modified by Marcos van Dam, April 2011. + Now restores diagonal matrices */ { - if (is_set(bin)) restore,openb(fn),v; - else v = img_read(fn); + if (ur == []) ur = MR; + if (un == []) un = MN; + restore,openb(fn),v; if (typeof(v) == "float") a = ruo(); else if (typeof(v) == "double") a = ruo_d(); else error,"Unsupported data type in"; - a.n = int(v(1)); - a.r = int(v(2)); - a.t = v(3); - a.xn = &(v(4:a.n+3)); - a.jx = &(int(v(a.n+4:2*a.n+3))); - a.ix = &(int(v(2*a.n+4:2*a.n+a.r+3))); - a.xd = &(v(2*a.n+a.r+4:2*a.n+2*a.r+3)); + a.n = long(v(1)); + a.r = long(v(2)); + + a.ix = &(array(long,ur)); + a.jx = &(array(long,un)); + a.xn = &(array(float,un)); + a.xd = &(array(float,ur)); + + if (a.n > 0){ // fixed bug if n == 0 + xn = v(3:a.n+2); + jx = long(v(a.n+3:2*a.n+2)); + (*a.xn)(1:numberof(xn)) = xn; + (*a.jx)(1:numberof(jx)) = jx; + } + ix = long(v(2*a.n+3:2*a.n+a.r+4)); + xd = v(2*a.n+a.r+5:2*a.n+2*a.r+4); + (*a.ix)(1:numberof(ix)) = ix; + (*a.xd)(1:numberof(xd)) = xd; + return a; } //================================================================== func rcodr(&a,r) - /* DOCUMENT rcodr(a,r) + /* DOCUMENT rcodr(&a,r) Delete a specific row from an RCO structure. */ { nel = (*a.ix)(r+1)-(*a.ix)(r); - /* if (nel == 0) { - if (r == 1) { (*a.ix)(2:a.r) = (*a.ix)(3:a.r+1); } else if (r < a.r) { (*a.ix)(r+1:a.r) = (*a.ix)(r+2:a.r+1); } - + (*a.ix)(a.r+1) = 0; } else { - if (r == a.r) { (*a.jx)(a.n-nel+1:a.n) *= 0; (*a.xn)(a.n-nel+1:a.n) *= 0.0f; - + (*a.ix)(a.r+1) = 0; } else if (r == 1) { (*a.jx)(1:a.n-nel) = (*a.jx)(nel+1:a.n); (*a.xn)(1:a.n-nel) = (*a.xn)(nel+1:a.n); (*a.ix)(2:a.r) = (*a.ix)(3:a.r+1)-nel; - + (*a.ix)(a.r+1) = 0; } else { - if ((*a.ix)(r) > 0) { + // modification made by Marcos van Dam, 28 May 2010 + //(*a.jx)((*a.ix)(r):a.n-nel-1) = (*a.jx)((*a.ix)(r+1):a.n-1); //orig + //(*a.xn)((*a.ix)(r):a.n-nel-1) = (*a.xn)((*a.ix)(r+1):a.n-1); //orig + (*a.jx)((*a.ix)(r)+1:a.n) = (*a.jx)((*a.ix)(r)+1+nel:a.n+nel); //rev + (*a.xn)((*a.ix)(r)+1:a.n) = (*a.xn)((*a.ix)(r)+1+nel:a.n+nel); //rev - (*a.jx)((*a.ix)(r):a.n-nel-1) = (*a.jx)((*a.ix)(r+1):a.n-1); - (*a.xn)((*a.ix)(r):a.n-nel-1) = (*a.xn)((*a.ix)(r+1):a.n-1); - (*a.ix)(r+1:a.r) = (*a.ix)(r+2:a.r+1)-nel; - - } else { - (*a.jx)(1:a.n-nel) = (*a.jx)((*a.ix)(r+1):a.n-1); - (*a.xn)(1:a.n-nel) = (*a.xn)((*a.ix)(r+1):a.n-1); - (*a.ix)(r+1:a.r) = (*a.ix)(r+2:a.r+1)-nel; - } + (*a.ix)(r+1:a.r) = (*a.ix)(r+2:a.r+1)-nel; + (*a.ix)(a.r+1) = 0; } } - (*a.ix)(a.r+1) = 0; - */ - - if (nel == 0) { - - if (r == 1) { - /* - ix1 = (*a.ix)(1); - ix2 = (*a.ix)(3:a.r+1); - ix = []; - grow,ix,ix1; - grow,ix,ix2; - */ - (*a.ix)(2:a.r) = (*a.ix)(3:a.r+1); - } else if (r < a.r) { - /* - ix1 = (*a.ix)(1:r); - ix2 = (*a.ix)(r+2:a.r+1); - ix = []; - grow,ix,ix1; - grow,ix,ix2; - */ - (*a.ix)(r+1:a.r) = (*a.ix)(r+2:a.r+1); - } - - a.r = a.r-1n; - - /* - if (r == a.r) { - ix = (*a.ix)(1:a.r+1); - ix(a.r+1) = ix(a.r); - } else if (r == 1) { - ix = (*a.ix)(2:a.r+1) - } else if (r < a.r) { - ix1 = (*a.ix)(1:r-1); - ix2 = (*a.ix)(r+1:a.r+1); - ix = []; - grow,ix,ix1; - grow,ix,ix2; - } - */ - - /* - - Example 1: row 3 empty - ---------------------- - - # [1] [2] [3] [4] [5] [6] - ix 0 5 7 7 12 15 ... - / / / / / - row 1 2 3 4 5 - nel 5 2 0 5 3 - - After operation: - - # [1] [2] [3] [4] [5] - ix 0 5 7 12 15 ... - / / / / - row 1 2 3 4 - nel 5 2 5 3 - - What happened: ix = [ ix(1:r-1) , ix(r+1:) ] - - Example 2: last row empty - ------------------------- - - ix 0 5 7 9 12 12 ... - / / / / / - row 1 2 3 4 5 - nel 5 2 2 3 0 - - After operation: - - ix 0 5 7 9 12 ... - / / / / - row 1 2 3 4 - nel 5 2 2 3 - - */ - - } else { - - if (r == a.r) { - //write,"case 1"; - ix = (*a.ix)(1:r); - jx = (*a.jx)(1:a.n-nel); - xn = (*a.xn)(1:a.n-nel); - } else if (r == 1) { - //write,"case 2"; - ix = (*a.ix)(2:a.r+1)-nel; - jx = (*a.jx)((*a.ix)(2)+1:(*a.ix)(a.r+1)); - xn = (*a.xn)((*a.ix)(2)+1:(*a.ix)(a.r+1)); - } else { - //write,"case 3"; - jx1 = (*a.jx)((*a.ix)(1)+1:(*a.ix)(r)); - jx2 = (*a.jx)((*a.ix)(r+1)+1:); - xn1 = (*a.xn)((*a.ix)(1)+1:(*a.ix)(r)); - xn2 = (*a.xn)((*a.ix)(r+1)+1:); - jx = xn = []; - grow,jx,jx1; - grow,jx,jx2; - grow,xn,xn1; - grow,xn,xn2; - ix1 = (*a.ix)(1:r-1); - ix2 = (*a.ix)(r+1:a.r+1)-nel; - ix = []; - grow,ix,ix1; - grow,ix,ix2; - } - a.n = a.n-nel; - a.ix = &(ix); - a.jx = &(jx); - a.xn = &(xn); - a.r = a.r-1n; - } - //return a; + a.r -= 1; + a.n -= nel; } //================================================================== func spcon(&a,b,diag=,ruo=) /* DOCUMENT spcon(&a,b,diag=,ruo=) - Concatennate two RCO matrices row-wise (default), diagonally + Concatenate two RCO matrices row-wise (default), diagonally (diag=1), or two RUO matrices diagonally (ruo=1). + + Modified 2010/7/29, Marcos van Dam + Fixed bugs with concatenating ruo matrices + + Modified 2010/09/04, Marcos van Dam + Fixed bug concatenating a matrix with a matrix of zeros */ { - (*a.jx)(a.n+1:a.n+b.n) = (*b.jx)(1:b.n); - if (diag == 1 && ruo != 1) (*a.jx)(a.n+1:a.n+b.n) += a.c-1; - if (ruo == 1) (*a.jx)(a.n+1:a.n+b.n) += a.r-1; - (*a.xn)(a.n+1:a.n+b.n) = (*b.xn)(1:b.n); + if (b.n > 0){ + (*a.jx)(a.n+1:a.n+b.n) = (*b.jx)(1:b.n); + if (diag == 1 && ruo != 1) (*a.jx)(a.n+1:a.n+b.n) += a.c; + if (ruo == 1) (*a.jx)(a.n+1:a.n+b.n) += a.r; + (*a.xn)(a.n+1:a.n+b.n) = (*b.xn)(1:b.n); + } if (ruo == 1) (*a.xd)(a.r+1:a.r+b.r) = (*b.xd)(1:b.r); - if (ruo == 1) (*a.ix)(a.r+1:a.r+b.r-1) = (*b.ix)(2:b.r)+(*a.ix)(a.r); + if (ruo == 1) (*a.ix)(a.r+1:a.r+b.r) = (*b.ix)(1:b.r)+(*a.ix)(a.r); else (*a.ix)(a.r+2:a.r+b.r+1) = (*b.ix)(2:b.r+1)+(*a.ix)(a.r+1); a.r += b.r; a.n += b.n; @@ -1259,116 +946,81 @@ } //================================================================== -func rcocc(&a,b) - /* DOCUMENT rcocc(&a,b) - Concatennate two RCO matrices row-wise - */ - -{ - bix = (*b.ix)(2:b.r+1); - bjx = (*b.jx)(1:b.n); - bxn = (*b.xn)(1:b.n); - if (sizeof(*a.ix) == 0 || a == []) { - a = rco(); - a.ix = &([0n]); - aix = 0n; - ajx = axn = []; - } else { - aix = (*a.ix)(1:a.r+1); - ajx = (*a.jx)(1:a.n); - axn = (*a.xn)(1:a.n); - } - grow,aix,bix+(*a.ix)(a.r+1); - grow,ajx,bjx - grow,axn,bxn; - if (a.c == 0 && b.c == 0) { - error,"matrix width unknown (specify #columns)"; - } else { - a.c = b.c; - } - a.r += b.r; - a.n += b.n; - a.ix = &aix; - a.jx = &ajx; - a.xn = &axn; -} - -//================================================================== -func ruocc(&a,b) - /* DOCUMENT ruocc(&a,b) - Concatennate two RUO matrices block-diagonally - */ -{ - bjx = (*b.jx)(1:b.n); - bxn = (*b.xn)(1:b.n); - bxd = (*b.xd)(1:b.r); - if (sizeof(*a.ix) == 0) { - bix = (*b.ix)(2:b.r+1); - a.ix = &([0n]); - aix = 0n; - ajx = axn = axd = []; - grow,aix,bix+a.n; - } else { - bix = (*b.ix)(1:b.r); - aix = (*a.ix)(1:a.r); - ajx = (*a.jx)(1:a.n); - axn = (*a.xn)(1:a.n); - axd = (*a.xd)(1:a.r); - grow,aix,bix+a.n; - } - grow,ajx,bjx+a.r; - grow,axn,bxn; - grow,axd,bxd; - a.r += b.r; - a.n += b.n; - a.ix = &aix; - a.jx = &ajx; - a.xn = &axn; - a.xd = &axd; +func ruo_UDL(a) + /* DOCUMENT func ruo_UDL(a) + Splits an RUO matrix into its upper triangular (U), + diagonal (D), and lower tringular (L) parts. + */ +{ + D = (*a.xd)(1:a.r); + U = rco(); + U.jx = &((*a.jx)(1:a.n)); + U.xn = &((*a.xn)(1:a.n)); + U.ix = &((*a.ix)(1:a.r+1)); + (*U.ix)(a.r+1) = (*U.ix)(a.r); + U.r = a.r; + U.c = U.r; + U.n = a.n; + L = rcotr(U); + return [&U,&D,&L]; } - //================================================================== func ruo2rco(a) /* DOCUMENT func ruo2rco(a) - Converts an RUO matrix into RCO. Calls both rcotr and rcoadd. - This is not very efficient, and should be used sparingly. + Converts an RUO matrix into RCO. + Calls rcotr and rcoadd. */ { - xd = (*a.xd)(1:a.r); - d = rco(); - d.c = a.r; - d.r = a.r; - d.n = a.r; - d.xn = &xd; - dix = int(span(0,a.r,a.r+1)); - d.ix = &dix; - djx = int(span(0,a.r-1,a.r)); - d.jx = &djx; + d = (*a.xd)(1:a.r); u = rco(); - uix = *a.ix; - ujx = *a.jx; - uxn = *a.xn; - u.jx = &ujx; - u.xn = &uxn; - if (dimsof(uix)(0) == a.r) { - grow,uix,[(*a.ix)(a.r),(*a.ix)(a.r)]; - } else if (dimsof(uix)(0) > a.r) { - uix = uix(1:a.r); - grow,uix,[(*a.ix)(a.r),(*a.ix)(a.r)]; - } else { - error,"Something wrong - vector IX has too few elements"; - } - u.ix = &uix; + u.jx = &((*a.jx)(1:a.n+2)); + u.xn = &((*a.xn)(1:a.n+2)); + u.ix = &((*a.ix)(1:a.r+3)); + (*u.ix)(a.r+1) = (*u.ix)(a.r); u.r = a.r; u.c = u.r; u.n = a.n; - tmp = rcoadd(u,d,ur=a.r+10n,un=int(a.n*2+a.r*2)); - l = rcotr(u); - b = rcoadd(tmp,l,ur=a.r+10n,un=int(a.n*2+a.r*2)); - + l = rcotr(u); + + // now embed the diagonal into u + dix = (*u.ix)(1:u.r+2); + dix(1:u.r+1) += long(span(1,u.r+1,u.r+1)-1); + dix(u.r+2) = dix(u.r+1); + djx = array(long,u.n+u.r+2); + dxn = array(float,u.n+u.r+2); + for (i=1; i<=u.r; i++) { + djx(dix(i)+1) = i-1; + dxn(dix(i)+1) = d(i); + if ( (*u.ix)(i+1) > (*u.ix)(i) ) { + djx(dix(i)+2:dix(i+1)+1) = (*u.jx)((*u.ix)(i)+1:(*u.ix)(i+1)+1); + dxn(dix(i)+2:dix(i+1)+1) = (*u.xn)((*u.ix)(i)+1:(*u.ix)(i+1)+1); + } + } + u.ix = &(dix); + u.jx = &(djx); + u.xn = &(dxn); + u.n += u.r; + b = rcoadd(u,l); + return b; } //================================================================== +func ruosgs_Y(u,v,n,U,D,L) + /* DOCUMENT func ruosgs_Y(u,v,n,U,D,L) + Symmetric Gauss-Seidel iterations. + SEE ALSO: ruo_UDL + */ +{ + u = v/D; + for (i=1;i<=n;i++) { + tmp = v-rcoxv(U,u); + u = tmp/D; + tmp = v-rcoxv(L,u); + u = tmp/D; + } + return u; +} +//================================================================== func intop(dims) /* DOCUMENT int(dims) Interpolating operators implemented as sparse matrices. @@ -1380,12 +1032,14 @@ { nd = numberof(dims); a = array(rco,nd); + b = array(rco,nd); for (i=1;i<=nd;i++) { - ur = dims(i)*dims(i)+1; - un = int(ur*2.25); - a(i).ix = &(array(int,ur)); - a(i).jx = &(array(int,un)); - a(i).xn = &(array(float,un)); + a.ix = &(array(long,MR)); + a.jx = &(array(long,MN)); + a.xn = &(array(float,MN)); + b.ix = &(array(long,MR)); + b.jx = &(array(long,MN)); + b.xn = &(array(float,MN)); } v1 = array(0.5f,2); v2 = array(0.25f,4); @@ -1394,7 +1048,7 @@ for (i=1;i<=dims(k);i++) { for (j=1;j<=dims(k);j++) { //ind = (i-1)*dims(k)+j-1; - ind = (int((i+1)/2)-1)*dims(k)/2+int((j+1)/2)-1; + ind = (long((i+1)/2)-1)*dims(k)/2+long((j+1)/2)-1; i2 = i%2; j2 = j%2; write,format="%2d %2d %2d %d %2d %d %d %d %4d\n",j,i,j2,i2,\ ((1-j2) && i2),((1-i2) && j2),((1-i2) && (1-j2)),(i2 && j2),ind; @@ -1405,37 +1059,35 @@ for (k=1;k<=nd;k++) { ii = 1; n = 1; - d1 = dims(k)/2; - d2 = (dims(k)/2)^2; for (i=1;i<=dims(k);i++) { for (j=1;j<=dims(k);j++) { // ind = (i-1)*dims(k)+j-1; - ind = int((int((i+1)/2)-1)*d1+int((j+1)/2)-1); + ind = (long((i+1)/2)-1)*dims(k)/2+long((j+1)/2)-1; i2 = i%2; j2 = j%2; if ((1-j2) && i2) { // x-interpolation (*a(k).xn)(n:n+1) = v1; inds = [ind,ind+1]; - if (j == dims(k)) inds(2) -= d1; + if (j == dims(k)) inds(2) -= dims(k)/2; (*a(k).jx)(n:n+1) = inds; (*a(k).ix)(ii+1) = (*a(k).ix)(ii)+2; n += 2; } else if ((1-i2) && j2) { // y-interpolation (*a(k).xn)(n:n+1) = v1; - inds = [ind,ind+d1]; - if (i == dims(k)) inds(2) -= d2; + inds = [ind,ind+dims(k)/2]; + if (i == dims(k)) inds(2) -= (dims(k)/2)^2; (*a(k).jx)(n:n+1) = inds; (*a(k).ix)(ii+1) = (*a(k).ix)(ii)+2; n += 2; } else if ((1-i2) && (1-j2)) { // xy-interpolation (*a(k).xn)(n:n+3) = v2; - inds = [ind,ind+1,ind+d1,ind+d1+1]; + inds = [ind,ind+1,ind+dims(k)/2,ind+dims(k)/2+1]; if (j == dims(k)) { - inds(2) -= d1; - inds(4) -= d1; + inds(2) -= dims(k)/2; + inds(4) -= dims(k)/2; } if (i == dims(k)) { - inds(3) -= d2; - inds(4) -= d2; + inds(3) -= (dims(k)/2)^2; + inds(4) -= (dims(k)/2)^2; } (*a(k).jx)(n:n+3) = inds; (*a(k).ix)(ii+1) = (*a(k).ix)(ii)+4; @@ -1449,14 +1101,58 @@ ii++; } } - a(k).r = int(dims(k)^2); - a(k).c = int(dims(k)^2/4); - a(k).n = int(n-1); - } - b = array(rco,nd); - for (k=1;k<=nd;k++) { + a(k).r = long(dims(k)^2); + a(k).c = long(dims(k)^2/4); + a(k).n = n-1; b(k) = rcotr(a(k)); } return [&a,&b]; } + +//================================================================== +func spunit(n, precision=) + /* DOCUMENT spunit(n, precision=) + Create an identity matrix with n rows and columns + Marcos van Dam, July 2010 + */ +{ + n = long(n); + if (precision=="double"){ + spidentity = spruo(double(unit(1))); + } + else { + spidentity = spruo(float(unit(1))); + } + + spidentity.r = n; + (*spidentity.xd)(1:n) = 1; + + return spidentity; +} + + //================================================================== +func spzeros(m, n, precision=) +/* DOCUMENT spzeros(n, m, precision=) + Create an matrix of zeros with m rows and n columns + Marcos van Dam, July 2010 +*/ + +{ + if (precision=="double"){ + zero_row = sprco(array(double,[2,n,1])); + } + else { + zero_row = sprco(array(float,[2,n,1])); + } + + for (row_counter=1;row_counter<=m;row_counter++){ + if (row_counter == 1){ + zero_matrix = zero_row; + } + else { + spcon, zero_matrix, zero_row; + } + } + return zero_matrix; +} diff -urN '--exclude=debian' '--exclude=.git' yorick-soy-1.2.01/soy.info yorick-soy/soy.info --- yorick-soy-1.2.01/soy.info 1970-01-01 01:00:00.000000000 +0100 +++ yorick-soy/soy.info 2012-03-05 15:48:10.000000000 +0100 @@ -0,0 +1,45 @@ +Package: soy +Kind: plugin +Version: 1.3.2 +Revision: 1 +Description: Sparse Matrix Operations +License: GPL +Author: Ralf Flicker, Marcos van Dam +Maintainer: Francois Rigaut +OS: +Depends: yorick(>=1.6.02) +Source: http://www.maumae.net/yorick/packages/%o/tarballs/soy-%v-%o.tgz +Source-MD5: +Source-Directory: contrib/soy +DocFiles: README TODO VERSION NEWS LEGAL doc/README:README.doc doc/FILE_FORMATS doc/*.doc doc/*.pdf doc/*.ps doc/*.tex +Homepage: http://www.maumae.net/yorick/doc/plugins.php +DescDetail: << + +SOY: Sparse Operations with Yorick +Ralf Flicker (rflicker@mac.com), 18 Nov 2004 +Additions and bugfixes by Marcos van Dam (2010) + +Installation instructions (Yorick v. >= 1.6) + + * Unzip and untar into ($Y_SITE)/contrib/ + + * cd soy, yorick -batch make.i + +(if, for any reason, this doesn't give you the proper +Makefile, just edit the included Makefile to point to +your Make.cfg) + + * make plugin, make check-plug, make install-plug + + * To load the plugin into yorick, type #include "soy.i" +<< +DescUsage: << + * make plugin, make check-plug, make install-plug + + * To load the plugin into yorick, type #include "soy.i" +<< +DescPort: << +This package will compile Yorick only on MacOSX 10.3.4 or later, because +of a bug in the system math library libm (part of /usr/lib/LibSystem.dylib) +in earlier versions of MacOSX 10.3. +<< debian/examples0000644000000000000000000000001011772607232010725 0ustar check.i debian/ynstall0000644000000000000000000000007711772607723010617 0ustar soy.info debian/yorick-soy.packinfo debian/yorick-soy.keywords