← Back to branch summary

~ubuntu-branches/ubuntu/saucy/python-scipy/saucy

« back to all changes in this revision

Viewing changes to Lib/sandbox/pysparse/superlu/zsnode_bmod.c

  • Committer: Bazaar Package Importer
  • Author(s): Ondrej Certik
  • Date: 2008-06-16 22:58:01 UTC
  • mfrom: (2.1.24 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080616225801-irdhrpcwiocfbcmt
Tags: 0.6.0-12
http://bugs.debian.org/489149
* The description updated to match the current SciPy (Closes: #489149).
* Standards-Version bumped to 3.8.0 (no action needed)
* Build-Depends: netcdf-dev changed to libnetcdf-dev

Show diffs side-by-side

added added

removed removed

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