ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
dgamx2d_.c
Go to the documentation of this file.
1 #include "Bdef.h"
2 
3 
4 
5 #if (INTFACE == C_CALL)
6 void Cdgamx2d(int ConTxt, char *scope, char *top, int m, int n, double *A,
7  int lda, int *rA, int *cA, int ldia, int rdest, int cdest)
8 #else
9 F_VOID_FUNC dgamx2d_(int *ConTxt, F_CHAR scope, F_CHAR top, int *m, int *n,
10  double *A, int *lda, int *rA, int *cA, int *ldia,
11  int *rdest, int *cdest)
12 #endif
13 /*
14  * -- V1.1 BLACS routine --
15  * University of Tennessee, May 1, 1996
16  * Written by Clint Whaley.
17  *
18  * Purpose
19  * =======
20  * Combine amx operation for double precision rectangular matrices.
21  *
22  * Arguments
23  * =========
24  *
25  * ConTxt (input) Ptr to int
26  * Index into MyConTxts00 (my contexts array).
27  *
28  * SCOPE (input) Ptr to char
29  * Limit the scope of the operation.
30  * = 'R' : Operation is performed by a process row.
31  * = 'C' : Operation is performed by a process column.
32  * = 'A' : Operation is performed by all processes in grid.
33  *
34  * TOP (input) Ptr to char
35  * Controls fashion in which messages flow within the operation.
36  *
37  * M (input) Ptr to int
38  * The number of rows of the matrix A. M >= 0.
39  *
40  * N (input) Ptr to int
41  * The number of columns of the matrix A. N >= 0.
42  *
43  * A (output) Ptr to double precision two dimensional array
44  * The m by n matrix A. Fortran77 (column-major) storage
45  * assumed.
46  *
47  * LDA (input) Ptr to int
48  * The leading dimension of the array A. LDA >= M.
49  *
50  * RA (output) Integer Array, dimension (LDIA, N)
51  * Contains process row that the amx of each element
52  * of A was found on: i.e., rA(1,2) contains the process
53  * row that the amx of A(1,2) was found on.
54  * Values are left on process {rdest, cdest} only, others
55  * may be modified, but not left with interesting data.
56  * If rdest == -1, then result is left on all processes in scope.
57  * If LDIA == -1, this array is not accessed, and need not exist.
58  *
59  * CA (output) Integer Array, dimension (LDIA, N)
60  * Contains process column that the amx of each element
61  * of A was found on: i.e., cA(1,2) contains the process
62  * column that the max/min of A(1,2) was found on.
63  * Values are left on process {rdest, cdest} only, others
64  * may be modified, but not left with interesting data.
65  * If rdest == -1, then result is left on all processes in scope.
66  * If LDIA == -1, this array is not accessed, and need not exist.
67  *
68  * LDIA (input) Ptr to int
69  * If (LDIA == -1), then the arrays RA and CA are not accessed.
70  * ELSE leading dimension of the arrays RA and CA. LDIA >= M.
71  *
72  * RDEST (input) Ptr to int
73  * The process row of the destination of the amx.
74  * If rdest == -1, then result is left on all processes in scope.
75  *
76  * CDEST (input) Ptr to int
77  * The process column of the destination of the amx.
78  * If rdest == -1, then CDEST ignored.
79  *
80  * ------------------------------------------------------------------------
81  */
82 {
83  void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int,
84  int *, int *);
85  void BI_UpdateBuffs(BLACBUFF *);
86  BLACBUFF *BI_GetBuff(int);
87  int BI_BuffIsFree(BLACBUFF *, int);
88  MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int,
89  MPI_Datatype, int *);
90  BLACBUFF *BI_Pack(BLACSCONTEXT *, BVOID *, BLACBUFF *, MPI_Datatype);
91  MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int,
92  MPI_Datatype, int *);
93  void BI_Unpack(BLACSCONTEXT *, BVOID *, BLACBUFF *, MPI_Datatype);
95  int, int);
97  int, int);
98  void BI_BeComb(BLACSCONTEXT *, BLACBUFF *, BLACBUFF *, int, VVFUNPTR);
99  void BI_dvvamx(int, char *, char *);
100  void BI_dvvamx2(int, char *, char *);
101  void BI_dMPI_amx(void *, void *, int *, MPI_Datatype *);
102  void BI_dMPI_amx2(void *, void *, int *, MPI_Datatype *);
103 /*
104  * Variable Declarations
105  */
106  VVFUNPTR vvop;
107  BLACBUFF *bp, *bp2;
108  BLACSCONTEXT *ctxt;
109  char ttop, tscope;
110  int i, j, N, dest, idist, length, tlda, tldia, trdest, ierr;
111  int len[2];
112  MPI_Aint disp[2];
113  MPI_Datatype dtypes[2];
114  MPI_Op BlacComb;
115  MPI_Datatype MyType;
116  BI_DistType *dist, mydist;
117  extern BLACBUFF *BI_ActiveQ;
118  extern BLACBUFF BI_AuxBuff;
119 
120  MGetConTxt(Mpval(ConTxt), ctxt);
121  ttop = F2C_CharTrans(top);
122  ttop = Mlowcase(ttop);
123  tscope = F2C_CharTrans(scope);
124  tscope = Mlowcase(tscope);
125 /*
126  * If the user has set the default combine topology, use it instead of
127  * BLACS default
128  */
129 #ifdef DefCombTop
130  if (ttop == ' ') ttop = DefCombTop;
131 #endif
132  if (Mpval(cdest) == -1) trdest = -1;
133  else trdest = Mpval(rdest);
134 #if (BlacsDebugLvl > 0)
135  BI_ArgCheck(Mpval(ConTxt), RT_COMB, __FILE__, tscope, 'u', 'u', Mpval(m),
136  Mpval(n), Mpval(lda), 1, &trdest, Mpaddress(cdest));
137  if (Mpval(ldia) < Mpval(m))
138  {
139  if (Mpval(ldia) != -1)
140  BI_BlacsWarn(Mpval(ConTxt), __LINE__, __FILE__,
141  "LDIA too small (LDIA=%d, but M=%d)", Mpval(ldia),
142  Mpval(m));
143  }
144 #endif
145  if (Mpval(lda) >= Mpval(m)) tlda = Mpval(lda);
146  else tlda = Mpval(m);
147  if (Mpval(ldia) < Mpval(m)) tldia = Mpval(m);
148  else tldia = Mpval(ldia);
149  switch(tscope)
150  {
151  case 'r':
152  ctxt->scp = &ctxt->rscp;
153  if (trdest == -1) dest = -1;
154  else dest = Mpval(cdest);
155  break;
156  case 'c':
157  ctxt->scp = &ctxt->cscp;
158  dest = trdest;
159  break;
160  case 'a':
161  ctxt->scp = &ctxt->ascp;
162  if (trdest == -1) dest = -1;
163  else dest = Mvkpnum(ctxt, trdest, Mpval(cdest));
164  break;
165  default:
166  BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown scope '%c'",
167  tscope);
168  }
169 
170 
171 /*
172  * It's not defined how MPI reacts to 0 element reductions, so use BLACS 1-tree
173  * topology if we've got one
174  */
175  if (ttop == ' ')
176  if ( (Mpval(m) < 1) || (Mpval(n) < 1) || (ctxt->TopsRepeat) ) ttop = '1';
177  N = Mpval(m) * Mpval(n);
178 /*
179  * If process who has amx is to be communicated, must set up distance
180  * vector after value vector
181  */
182  if (Mpval(ldia) != -1)
183  {
184  vvop = BI_dvvamx;
185  length = N * sizeof(double);
186  i = length % sizeof(BI_DistType); /* ensure dist vec aligned correctly */
187  if (i) length += sizeof(BI_DistType) - i;
188  idist = length;
189  length += N * sizeof(BI_DistType);
190 /*
191  * For performance, insist second buffer is at least 8-byte aligned
192  */
193  j = 8;
194  if (sizeof(double) > j) j = sizeof(double);
195  i = length % j;
196  if (i) length += j - i;
197  i = 2 * length;
198 
199  bp = BI_GetBuff(i);
200  bp2 = &BI_AuxBuff;
201  bp2->Buff = &bp->Buff[length];
202  BI_dmvcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff);
203 /*
204  * Fill in distance vector
205  */
206  if (dest == -1) mydist = ctxt->scp->Iam;
207  else mydist = (ctxt->scp->Np + ctxt->scp->Iam - dest) % ctxt->scp->Np;
208  dist = (BI_DistType *) &bp->Buff[idist];
209  for (i=0; i < N; i++) dist[i] = mydist;
210 
211 /*
212  * Create the MPI datatype holding both user's buffer and distance vector
213  */
214  len[0] = len[1] = N;
215  disp[0] = 0;
216  disp[1] = idist;
217  dtypes[0] = MPI_DOUBLE;
218  dtypes[1] = BI_MpiDistType;
219 #ifdef ZeroByteTypeBug
220  if (N > 0)
221  {
222 #endif
223  i = 2;
224  ierr=MPI_Type_create_struct(i, len, disp, dtypes, &MyType);
225  ierr=MPI_Type_commit(&MyType);
226  bp->N = bp2->N = 1;
227  bp->dtype = bp2->dtype = MyType;
228 #ifdef ZeroByteTypeBug
229  }
230  else
231  {
232  bp->N = bp2->N = 0;
233  bp->dtype = bp2->dtype = MPI_INT;
234  }
235 #endif
236  }
237  else
238  {
239  vvop = BI_dvvamx2;
240  length = N * sizeof(double);
241 /*
242  * If A is contiguous, we can use it as one of our buffers
243  */
244  if ( (Mpval(m) == tlda) || (Mpval(n) == 1) )
245  {
246  bp = &BI_AuxBuff;
247  bp->Buff = (char *) A;
248  bp2 = BI_GetBuff(length);
249  }
250  else
251  {
252  bp = BI_GetBuff(length*2);
253  bp2 = &BI_AuxBuff;
254  bp2->Buff = &bp->Buff[length];
255  BI_dmvcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff);
256  }
257  bp->N = bp2->N = N;
258  bp->dtype = bp2->dtype = MPI_DOUBLE;
259  }
260 
261  switch(ttop)
262  {
263  case ' ': /* use MPI's reduction by default */
264  i = 1;
265  if (Mpval(ldia) == -1)
266  {
267  ierr=MPI_Op_create(BI_dMPI_amx2, i, &BlacComb);
268  }
269  else
270  {
271  ierr=MPI_Op_create(BI_dMPI_amx, i, &BlacComb);
272  BI_AuxBuff.Len = N; /* set this up for the MPI OP wrappers */
273  }
274 
275  if (trdest != -1)
276  {
277  ierr=MPI_Reduce(bp->Buff, bp2->Buff, bp->N, bp->dtype, BlacComb, dest,
278  ctxt->scp->comm);
279  if (ctxt->scp->Iam == dest)
280  {
281  BI_dvmcopy(Mpval(m), Mpval(n), A, tlda, bp2->Buff);
282  if (Mpval(ldia) != -1)
283  BI_TransDist(ctxt, tscope, Mpval(m), Mpval(n), rA, cA, tldia,
284  (BI_DistType *) &bp2->Buff[idist],
285  trdest, Mpval(cdest));
286  }
287  }
288  else
289  {
290  ierr=MPI_Allreduce(bp->Buff, bp2->Buff, bp->N, bp->dtype, BlacComb,
291  ctxt->scp->comm);
292  BI_dvmcopy(Mpval(m), Mpval(n), A, tlda, bp2->Buff);
293  if (Mpval(ldia) != -1)
294  BI_TransDist(ctxt, tscope, Mpval(m), Mpval(n), rA, cA, tldia,
295  (BI_DistType *) &bp2->Buff[idist],
296  trdest, Mpval(cdest));
297  }
298  ierr=MPI_Op_free(&BlacComb);
299  if (Mpval(ldia) != -1)
300 #ifdef ZeroByteTypeBug
301  if (N > 0)
302 #endif
303  ierr=BI_MPI_TYPE_FREE(&MyType);
304  if (BI_ActiveQ) BI_UpdateBuffs(NULL);
305  return;
306  break;
307  case 'i':
308  BI_MringComb(ctxt, bp, bp2, N, vvop, dest, 1);
309  break;
310  case 'd':
311  BI_MringComb(ctxt, bp, bp2, N, vvop, dest, -1);
312  break;
313  case 's':
314  BI_MringComb(ctxt, bp, bp2, N, vvop, dest, 2);
315  break;
316  case 'm':
317  BI_MringComb(ctxt, bp, bp2, N, vvop, dest, ctxt->Nr_co);
318  break;
319  case '1':
320  case '2':
321  case '3':
322  case '4':
323  case '5':
324  case '6':
325  case '7':
326  case '8':
327  case '9':
328  BI_TreeComb(ctxt, bp, bp2, N, vvop, dest, ttop-47);
329  break;
330  case 'f':
331  BI_TreeComb(ctxt, bp, bp2, N, vvop, dest, FULLCON);
332  break;
333  case 't':
334  BI_TreeComb(ctxt, bp, bp2, N, vvop, dest, ctxt->Nb_co);
335  break;
336  case 'h':
337 /*
338  * Use bidirectional exchange if everyone wants answer
339  */
340  if ( (trdest == -1) && !(ctxt->TopsCohrnt) )
341  BI_BeComb(ctxt, bp, bp2, N, vvop);
342  else
343  BI_TreeComb(ctxt, bp, bp2, N, vvop, dest, 2);
344  break;
345  default :
346  BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown topology '%c'",
347  ttop);
348  }
349 
350  if (Mpval(ldia) != -1)
351 #ifdef ZeroByteTypeBug
352  if (N > 0)
353 #endif
354  ierr=BI_MPI_TYPE_FREE(&MyType);
355 /*
356  * If I am selected to receive answer
357  */
358  if ( (ctxt->scp->Iam == dest) || (dest == -1) )
359  {
360 /*
361  * Translate the distances stored in the latter part of bp->Buff into
362  * process grid coordinates, and output these coordinates in the
363  * arrays rA and cA.
364  */
365  if (Mpval(ldia) != -1)
366  BI_TransDist(ctxt, tscope, Mpval(m), Mpval(n), rA, cA, tldia,
367  dist, trdest, Mpval(cdest));
368 /*
369  * Unpack the amx array
370  */
371  if (bp != &BI_AuxBuff) BI_dvmcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff);
372  }
373 }
bLaCsCoNtExT::TopsRepeat
int TopsRepeat
Definition: Bdef.h:27
BI_TransDist
void BI_TransDist(BLACSCONTEXT *ctxt, char scope, int m, int n, int *rA, int *cA, int ldrc, BI_DistType *dist, int rdest, int cdest)
Definition: BI_TransDist.c:3
BI_Pack
BLACBUFF * BI_Pack(BLACSCONTEXT *ctxt, BVOID *A, BLACBUFF *bp, MPI_Datatype Dtype)
Definition: BI_Pack.c:2
BI_BeComb
void BI_BeComb(BLACSCONTEXT *ctxt, BLACBUFF *bp, BLACBUFF *bp2, int N, VVFUNPTR Xvvop)
Definition: BI_BeComb.c:10
BI_MpiDistType
#define BI_MpiDistType
Definition: Bdef.h:73
BI_GetBuff
BLACBUFF * BI_GetBuff(int length)
Definition: BI_GetBuff.c:36
bLaCbUfF::Buff
char * Buff
Definition: Bdef.h:56
BI_dvvamx
void BI_dvvamx(int N, char *vec1, char *vec2)
Definition: BI_dvvamx.c:2
BI_dMPI_amx2
void BI_dMPI_amx2(void *in, void *inout, int *N, MPI_Datatype *dtype)
Definition: BI_dMPI_amx2.c:2
BI_Unpack
void BI_Unpack(BLACSCONTEXT *ctxt, BVOID *A, BLACBUFF *bp, MPI_Datatype Dtype)
Definition: BI_Unpack.c:3
bLaCsCoNtExT::rscp
BLACSSCOPE rscp
Definition: Bdef.h:25
FULLCON
#define FULLCON
Definition: Bdef.h:100
dgamx2d_
F_VOID_FUNC dgamx2d_(int *ConTxt, F_CHAR scope, F_CHAR top, int *m, int *n, double *A, int *lda, int *rA, int *cA, int *ldia, int *rdest, int *cdest)
Definition: dgamx2d_.c:9
F_CHAR
char * F_CHAR
Definition: pblas.h:109
bLaCsCoNtExT::ascp
BLACSSCOPE ascp
Definition: Bdef.h:25
MGetConTxt
#define MGetConTxt(Context, ctxtptr)
Definition: Bdef.h:200
BVOID
#define BVOID
Definition: Bdef.h:136
bLaCbUfF::Len
int Len
Definition: Bdef.h:57
bLaCbUfF
Definition: Bdef.h:54
VVFUNPTR
void(* VVFUNPTR)(int, char *, char *)
Definition: Bdef.h:68
RT_COMB
#define RT_COMB
Definition: Bdef.h:109
BI_ActiveQ
BLACBUFF * BI_ActiveQ
Definition: BI_GlobalVars.c:9
bLaCsScOpE::Iam
int Iam
Definition: Bdef.h:17
bLaCsCoNtExT::TopsCohrnt
int TopsCohrnt
Definition: Bdef.h:28
BI_MringComb
void BI_MringComb(BLACSCONTEXT *ctxt, BLACBUFF *bp, BLACBUFF *bp2, int N, VVFUNPTR Xvvop, int dest, int nrings)
Definition: BI_MringComb.c:2
bLaCsCoNtExT::Nb_co
int Nb_co
Definition: Bdef.h:30
Cdgamx2d
void Cdgamx2d()
bLaCbUfF::N
int N
Definition: Bdef.h:61
BI_dvmcopy
void BI_dvmcopy(int m, int n, double *A, int lda, double *buff)
Definition: BI_dvmcopy.c:3
F2C_CharTrans
#define F2C_CharTrans(c)
Definition: Bdef.h:246
Mpval
#define Mpval(para)
Definition: Bdef.h:261
Mlowcase
#define Mlowcase(C)
Definition: Bdef.h:145
bLaCsCoNtExT
Definition: Bdef.h:23
Mpaddress
#define Mpaddress(para)
Definition: Bdef.h:262
BI_TreeComb
void BI_TreeComb(BLACSCONTEXT *ctxt, BLACBUFF *bp, BLACBUFF *bp2, int N, VVFUNPTR Xvvop, int dest, int nbranches)
Definition: BI_TreeComb.c:19
F_VOID_FUNC
#define F_VOID_FUNC
Definition: Bdef.h:232
bLaCsCoNtExT::cscp
BLACSSCOPE cscp
Definition: Bdef.h:25
bLaCsCoNtExT::scp
BLACSSCOPE * scp
Definition: Bdef.h:26
Bdef.h
bLaCsScOpE::comm
MPI_Comm comm
Definition: Bdef.h:15
BI_GetMpiGeType
MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *ctxt, int m, int n, int lda, MPI_Datatype Dtype, int *N)
Definition: BI_GetMpiGeType.c:2
BI_AuxBuff
BLACBUFF BI_AuxBuff
Definition: BI_GlobalVars.c:10
BI_dMPI_amx
void BI_dMPI_amx(void *in, void *inout, int *N, MPI_Datatype *dtype)
Definition: BI_dMPI_amx.c:3
BI_dvvamx2
void BI_dvvamx2(int N, char *vec1, char *vec2)
Definition: BI_dvvamx2.c:2
bLaCbUfF::dtype
MPI_Datatype dtype
Definition: Bdef.h:60
BI_BlacsErr
void BI_BlacsErr(int ConTxt, int line, char *file, char *form,...)
Definition: BI_BlacsErr.c:3
bLaCsCoNtExT::Nr_co
int Nr_co
Definition: Bdef.h:30
bLaCsScOpE::Np
int Np
Definition: Bdef.h:17
BI_BlacsWarn
void BI_BlacsWarn(int ConTxt, int line, char *file, char *form,...)
Definition: BI_BlacsWarn.c:3
BI_ArgCheck
void 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)
Definition: BI_ArgCheck.c:4
BI_DistType
#define BI_DistType
Definition: Bdef.h:72
BI_MPI_TYPE_FREE
#define BI_MPI_TYPE_FREE(t)
Definition: Bdef.h:305
Mvkpnum
#define Mvkpnum(ctxt, prow, pcol)
Definition: Bdef.h:174
BI_UpdateBuffs
void BI_UpdateBuffs(BLACBUFF *Newbp)
Definition: BI_UpdateBuffs.c:3
BI_BuffIsFree
int BI_BuffIsFree(BLACBUFF *bp, int Wait)
Definition: BI_BuffIsFree.c:3
BI_dmvcopy
void BI_dmvcopy(int m, int n, double *A, int lda, double *buff)
Definition: BI_dmvcopy.c:2