1 #include "Bdef.h"
2
3
BI_ArgCheck(int ConTxt,int RoutType,char * routine,char scope,char uplo,char diag,int m,int n,int lda,int nprocs,int * prows,int * pcols)4 void BI_ArgCheck(int ConTxt, int RoutType, char *routine, char scope,
5 char uplo, char diag, int m, int n, int lda, int nprocs,
6 int *prows, int *pcols)
7 {
8 #if (BlacsDebugLvl > 0)
9 char *srcdest;
10 int i=1, prow, pcol, Ng, nprow, npcol, myrow, mycol;
11 BLACSCONTEXT *ctxt;
12
13 MGetConTxt(ConTxt, ctxt);
14 Mgridinfo(ctxt, Ng, nprow, npcol, myrow, mycol);
15
16 if ( (scope != 'r') && (scope != 'c') && (scope != 'a') )
17 BI_BlacsErr(ConTxt, -1, routine, "Unknown scope, scope=%c", scope);
18 if ( (uplo != 'u') && (uplo != 'l') )
19 {
20 if (RoutType != RT_COMB)
21 BI_BlacsWarn(ConTxt, -1, routine,
22 "UPLO=%c, will be assumed to mean LOWER", uplo);
23 else i = 0; /* combine aux, for rect. matrix */
24 }
25 if ( (diag != 'u') && (diag != 'n') )
26 {
27 if (i) BI_BlacsWarn(ConTxt, -1, routine,
28 "DIAG=%c, will be assumed to mean NON-UNIT", diag);
29 }
30 if (m * n != 0)
31 {
32 if (m < 0)
33 BI_BlacsErr(ConTxt, -1, routine, "Illegal number of rows, M=%d", m);
34 if (n < 0)
35 BI_BlacsErr(ConTxt, -1, routine, "Illegal number of columns, N=%d", n);
36 if (lda < m)
37 BI_BlacsWarn(ConTxt, -1, routine,
38 "Illegal LDA, LDA=%d, M=%d; LDA assumed to be %d",
39 lda, m, m);
40 }
41
42 if ( (RoutType == RT_RV) || (RoutType == RT_BR) ) srcdest = "SRC";
43 else srcdest = "DEST";
44
45 if (RoutType == RT_SD)
46 {
47 if ( (nprocs > Ng) || (nprocs < 0) )
48 BI_BlacsErr(ConTxt, -1, routine,
49 "Trying to send to %d procs, but only %d in grid",
50 nprocs, Ng);
51 }
52
53 for (i=0; i < nprocs; i++)
54 {
55 prow = prows[i];
56 pcol = pcols[i];
57
58 if ( (prow < 0) || (prow >= nprow) )
59 {
60 if ( !((RoutType == RT_COMB) && (prow == -1)) )
61 BI_BlacsErr(ConTxt, -1, routine,
62 "R%s out of range; R%s=%d, NPROW=%d",
63 srcdest, srcdest, prow, nprow);
64 }
65 if ( (pcol < 0) || (pcol >= npcol) )
66 {
67 if ( !((RoutType == RT_COMB) && (prow == -1)) )
68 BI_BlacsErr(ConTxt, -1, routine,
69 "C%s out of range; C%s=%d, NPCOL=%d",
70 srcdest, srcdest, pcol, npcol);
71 }
72 if (RoutType == RT_SD) /* point to point send */
73 {
74 if ( (prow == myrow) && (pcol == mycol) )
75 BI_BlacsWarn(ConTxt, -1, routine, "Node sending message to itself");
76 }
77 else if (RoutType == RT_RV) /* point to point send */
78 {
79 if ( (prow == myrow) && (pcol == mycol) )
80 BI_BlacsWarn(ConTxt, -1, routine,
81 "Node recving message from itself");
82 }
83 else if (RoutType == RT_BR) /* broadcast/recv */
84 {
85 if ( (prow == myrow) && (pcol == mycol) )
86 BI_BlacsErr(ConTxt, -1, routine,
87 "Node tries to recv its own broadcast");
88
89 if (scope == 'r')
90 {
91 if (myrow != prow)
92 BI_BlacsWarn(ConTxt, -1, routine,
93 "Row broadcast: MYROW=%d, but RSRC=%d",
94 myrow, prow);
95 }
96 else if (scope == 'c')
97 {
98 if (mycol != pcol)
99 {
100 BI_BlacsErr(ConTxt, -1, routine,
101 "Column broadcast: MYCOL=%d, but CSRC=%d",
102 mycol, pcol);
103 }
104 }
105 }
106 }
107 #endif
108 }
109