1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
|
#include "tools.h"
void pchkvec(n, npos0, ix, jx, desc_X, incX, xpos0, info0, nprow, npcol, myrow,
mycol)
int n;
int npos0;
int ix;
int jx;
int *desc_X;
int incX;
int xpos0;
int *info0;
int nprow;
int npcol;
int myrow;
int mycol;
{
#define DESCMULT 100
#define BIGNUM 10000
int Cnumroc2();
int info, npos, ixpos, jxpos, incpos, descpos, LOCp;
info = *info0;
npos = npos0 * DESCMULT;
ixpos = (xpos0 - 2) * DESCMULT;
jxpos = (xpos0 - 1) * DESCMULT;
incpos = (xpos0 + 1) * DESCMULT;
descpos = xpos0 * DESCMULT;
if (nprow == -1)
{
info = -info;
if (info < DESCMULT) *info0 = -descpos - CTXT_ - 1;
else if ( (info % DESCMULT) != CTXT_+1 ) *info0 = -descpos - CTXT_ - 1;
return;
}
if (info == 0) info = BIGNUM;
else if (info < 0) info = -info;
if (info < DESCMULT) info = info * DESCMULT;
/*
* Check that matrix values make sense from local viewpoint
*/
if(desc_X[DT_] != BLOCK_CYCLIC_2D) info = MIN(info, descpos+DT_+1);
else if (n < 0) info = MIN(info, npos);
else if (ix < 1) info = MIN(info, ixpos);
else if (jx < 1) info = MIN(info, jxpos);
else if (desc_X[MB_] < 1) info = MIN(info, descpos+MB_+1);
else if (desc_X[NB_] < 1) info = MIN(info, descpos+NB_+1);
else if ( (desc_X[RSRC_] < 0) || (desc_X[RSRC_] >= nprow) )
info = MIN(info, descpos+RSRC_+1);
else if ( (desc_X[CSRC_] < 0) || (desc_X[CSRC_] >= npcol) )
info = MIN(info, descpos+CSRC_+1);
else if ( (incX != 1) && (incX != desc_X[M_]) ) info = MIN(info, incpos);
else if (desc_X[LLD_] < 1) info = MIN(info, descpos+LLD_+1);
/*
* If we have null matrix, relax some checks
*/
if (n == 0)
{
if (desc_X[M_] < 0) info = MIN(info, descpos+M_+1);
if (desc_X[N_] < 0) info = MIN(info, descpos+N_+1);
}
/*
* More rigorous checks for non-degenerate matrices
*/
else
{
if (desc_X[M_] < 1) info = MIN(info, descpos+M_+1);
else if (desc_X[N_] < 1) info = MIN(info, descpos+N_+1);
else if (incX == desc_X[M_]) /* row vector */
{
if (ix > desc_X[M_]) info = MIN(info, ixpos);
else if (jx+n-1 > desc_X[N_]) info = MIN(info, jxpos);
}
else /* column matrix */
{
if (ix+n-1 > desc_X[M_]) info = MIN(info, ixpos);
else if (jx > desc_X[N_]) info = MIN(info, jxpos);
}
if (info == BIGNUM)
{
LOCp = Cnumroc2(desc_X[M_], 0, desc_X[MB_], myrow, desc_X[RSRC_],
nprow);
if (LOCp < 1) LOCp = 1;
if (desc_X[LLD_] < LOCp)
{
if ( Cnumroc2(desc_X[N_], 0, desc_X[NB_], mycol, desc_X[CSRC_],
npcol) )
info = descpos+LLD_+1;
}
}
}
/*
* Prepare output: set info = 0 if there is no error, and divide by DESCMULT if
* error is not a descriptor entry
*/
if (info == BIGNUM) *info0 = 0;
else if (info % DESCMULT == 0) *info0 = -info / DESCMULT;
else *info0 = -info;
}
|
