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