diff main/sparse/SuperLU/SRC/dsnode_bmod.c @ 0:6b33357c7561 octave-forge

Initial revision
author pkienzle
date Wed, 10 Oct 2001 19:54:49 +0000
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/dsnode_bmod.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,118 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+/*
+  Copyright (c) 1994 by Xerox Corporation.  All rights reserved.
+ 
+  THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY
+  EXPRESSED OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ 
+  Permission is hereby granted to use or copy this program for any
+  purpose, provided the above notices are retained on all copies.
+  Permission to modify the code and to distribute modified code is
+  granted, provided the above notices are retained, and a notice that
+  the code was modified is included with the above copyright notice.
+*/
+
+#include "dsp_defs.h"
+#include "util.h"
+
+
+/*
+ * Performs numeric block updates within the relaxed snode. 
+ */
+int
+dsnode_bmod (
+	    const int  jcol,	  /* in */
+	    const int  jsupno,    /* in */
+	    const int  fsupc,     /* in */
+	    double     *dense,    /* in */
+	    double     *tempv,    /* working array */
+	    GlobalLU_t *Glu       /* modified */
+	    )
+{
+#ifdef USE_VENDOR_BLAS
+#ifdef _CRAY
+    _fcd ftcs1 = _cptofcd("L", strlen("L")),
+	 ftcs2 = _cptofcd("N", strlen("N")),
+	 ftcs3 = _cptofcd("U", strlen("U"));
+#endif
+    int            incx = 1, incy = 1;
+    double         alpha = -1.0, beta = 1.0;
+#endif
+
+    int            luptr, nsupc, nsupr, nrow;
+    int            isub, irow, i, iptr; 
+    register int   ufirst, nextlu;
+    int            *lsub, *xlsub;
+    double         *lusup;
+    int            *xlusup;
+    extern SuperLUStat_t SuperLUStat;
+    flops_t *ops = SuperLUStat.ops;
+
+    lsub    = Glu->lsub;
+    xlsub   = Glu->xlsub;
+    lusup   = Glu->lusup;
+    xlusup  = Glu->xlusup;
+
+    nextlu = xlusup[jcol];
+    
+    /*
+     *	Process the supernodal portion of L\U[*,j]
+     */
+    for (isub = xlsub[fsupc]; isub < xlsub[fsupc+1]; isub++) {
+  	irow = lsub[isub];
+	lusup[nextlu] = dense[irow];
+	dense[irow] = 0;
+	++nextlu;
+    }
+
+    xlusup[jcol + 1] = nextlu;	/* Initialize xlusup for next column */
+    
+    if ( fsupc < jcol ) {
+
+	luptr = xlusup[fsupc];
+	nsupr = xlsub[fsupc+1] - xlsub[fsupc];
+	nsupc = jcol - fsupc;	/* Excluding jcol */
+	ufirst = xlusup[jcol];	/* Points to the beginning of column
+				   jcol in supernode L\U(jsupno). */
+	nrow = nsupr - nsupc;
+
+	ops[TRSV] += nsupc * (nsupc - 1);
+	ops[GEMV] += 2 * nrow * nsupc;
+
+#ifdef USE_VENDOR_BLAS
+#ifdef _CRAY
+	STRSV( ftcs1, ftcs2, ftcs3, &nsupc, &lusup[luptr], &nsupr, 
+	      &lusup[ufirst], &incx );
+	SGEMV( ftcs2, &nrow, &nsupc, &alpha, &lusup[luptr+nsupc], &nsupr, 
+		&lusup[ufirst], &incx, &beta, &lusup[ufirst+nsupc], &incy );
+#else
+	dtrsv_( "L", "N", "U", &nsupc, &lusup[luptr], &nsupr, 
+	      &lusup[ufirst], &incx );
+	dgemv_( "N", &nrow, &nsupc, &alpha, &lusup[luptr+nsupc], &nsupr, 
+		&lusup[ufirst], &incx, &beta, &lusup[ufirst+nsupc], &incy );
+#endif
+#else
+	dlsolve ( nsupr, nsupc, &lusup[luptr], &lusup[ufirst] );
+	dmatvec ( nsupr, nrow, nsupc, &lusup[luptr+nsupc], 
+			&lusup[ufirst], &tempv[0] );
+
+        /* Scatter tempv[*] into lusup[*] */
+	iptr = ufirst + nsupc;
+	for (i = 0; i < nrow; i++) {
+	    lusup[iptr++] -= tempv[i];
+	    tempv[i] = 0.0;
+	}
+#endif
+
+    }
+
+    return 0;
+}