← Back to branch summary

~ubuntu-branches/ubuntu/karmic/python-scipy/karmic

« back to all changes in this revision

Viewing changes to Lib/sparse/SuperLU/SRC/ssnode_bmod.c

  • Committer: Bazaar Package Importer
  • Author(s): Daniel T. Chen (new)
  • Date: 2005-03-16 02:15:29 UTC
  • Revision ID: james.westby@ubuntu.com-20050316021529-xrjlowsejs0cijig
Tags: upstream-0.3.2
Import upstream version 0.3.2

Show diffs side-by-side

added added

removed removed

Lines of Context:
Lib/sparse/SuperLU/SRC/ssnode_bmod.c
 
1
 
 
2
/*
 
3
 * -- SuperLU routine (version 3.0) --
 
4
 * Univ. of California Berkeley, Xerox Palo Alto Research Center,
 
5
 * and Lawrence Berkeley National Lab.
 
6
 * October 15, 2003
 
7
 *
 
8
 */
 
9
/*
 
10
  Copyright (c) 1994 by Xerox Corporation.  All rights reserved.
 
11
 
 
12
  THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY
 
13
  EXPRESSED OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
 
14
 
 
15
  Permission is hereby granted to use or copy this program for any
 
16
  purpose, provided the above notices are retained on all copies.
 
17
  Permission to modify the code and to distribute modified code is
 
18
  granted, provided the above notices are retained, and a notice that
 
19
  the code was modified is included with the above copyright notice.
 
20
*/
 
21
 
 
22
#include "ssp_defs.h"
 
23
 
 
24
 
 
25
/*
 
26
 * Performs numeric block updates within the relaxed snode. 
 
27
 */
 
28
int
 
29
ssnode_bmod (
 
30
            const int  jcol,      /* in */
 
31
            const int  jsupno,    /* in */
 
32
            const int  fsupc,     /* in */
 
33
            float     *dense,    /* in */
 
34
            float     *tempv,    /* working array */
 
35
            GlobalLU_t *Glu,      /* modified */
 
36
            SuperLUStat_t *stat   /* output */
 
37
            )
 
38
{
 
39
#ifdef USE_VENDOR_BLAS
 
40
#ifdef _CRAY
 
41
    _fcd ftcs1 = _cptofcd("L", strlen("L")),
 
42
         ftcs2 = _cptofcd("N", strlen("N")),
 
43
         ftcs3 = _cptofcd("U", strlen("U"));
 
44
#endif
 
45
    int            incx = 1, incy = 1;
 
46
    float         alpha = -1.0, beta = 1.0;
 
47
#endif
 
48
 
 
49
    int            luptr, nsupc, nsupr, nrow;
 
50
    int            isub, irow, i, iptr; 
 
51
    register int   ufirst, nextlu;
 
52
    int            *lsub, *xlsub;
 
53
    float         *lusup;
 
54
    int            *xlusup;
 
55
    flops_t *ops = stat->ops;
 
56
 
 
57
    lsub    = Glu->lsub;
 
58
    xlsub   = Glu->xlsub;
 
59
    lusup   = Glu->lusup;
 
60
    xlusup  = Glu->xlusup;
 
61
 
 
62
    nextlu = xlusup[jcol];
 
63
    
 
64
    /*
 
65
     *  Process the supernodal portion of L\U[*,j]
 
66
     */
 
67
    for (isub = xlsub[fsupc]; isub < xlsub[fsupc+1]; isub++) {
 
68
        irow = lsub[isub];
 
69
        lusup[nextlu] = dense[irow];
 
70
        dense[irow] = 0;
 
71
        ++nextlu;
 
72
    }
 
73
 
 
74
    xlusup[jcol + 1] = nextlu;  /* Initialize xlusup for next column */
 
75
    
 
76
    if ( fsupc < jcol ) {
 
77
 
 
78
        luptr = xlusup[fsupc];
 
79
        nsupr = xlsub[fsupc+1] - xlsub[fsupc];
 
80
        nsupc = jcol - fsupc;   /* Excluding jcol */
 
81
        ufirst = xlusup[jcol];  /* Points to the beginning of column
 
82
                                   jcol in supernode L\U(jsupno). */
 
83
        nrow = nsupr - nsupc;
 
84
 
 
85
        ops[TRSV] += nsupc * (nsupc - 1);
 
86
        ops[GEMV] += 2 * nrow * nsupc;
 
87
 
 
88
#ifdef USE_VENDOR_BLAS
 
89
#ifdef _CRAY
 
90
        STRSV( ftcs1, ftcs2, ftcs3, &nsupc, &lusup[luptr], &nsupr, 
 
91
              &lusup[ufirst], &incx );
 
92
        SGEMV( ftcs2, &nrow, &nsupc, &alpha, &lusup[luptr+nsupc], &nsupr, 
 
93
                &lusup[ufirst], &incx, &beta, &lusup[ufirst+nsupc], &incy );
 
94
#else
 
95
        strsv_( "L", "N", "U", &nsupc, &lusup[luptr], &nsupr, 
 
96
              &lusup[ufirst], &incx );
 
97
        sgemv_( "N", &nrow, &nsupc, &alpha, &lusup[luptr+nsupc], &nsupr, 
 
98
                &lusup[ufirst], &incx, &beta, &lusup[ufirst+nsupc], &incy );
 
99
#endif
 
100
#else
 
101
        slsolve ( nsupr, nsupc, &lusup[luptr], &lusup[ufirst] );
 
102
        smatvec ( nsupr, nrow, nsupc, &lusup[luptr+nsupc], 
 
103
                        &lusup[ufirst], &tempv[0] );
 
104
 
 
105
        /* Scatter tempv[*] into lusup[*] */
 
106
        iptr = ufirst + nsupc;
 
107
        for (i = 0; i < nrow; i++) {
 
108
            lusup[iptr++] -= tempv[i];
 
109
            tempv[i] = 0.0;
 
110
        }
 
111
#endif
 
112
 
 
113
    }
 
114
 
 
115
    return 0;
 
116
}