ScaLAPACK 2.1  2.1 ScaLAPACK: Scalable Linear Algebra PACKage
zgsum2d_.c
Go to the documentation of this file.
1 #include "Bdef.h"
2
3
4 #if (INTFACE == C_CALL)
5 void Czgsum2d(int ConTxt, char *scope, char *top, int m, int n, double *A,
6  int lda, int rdest, int cdest)
7 #else
8 F_VOID_FUNC zgsum2d_(int *ConTxt, F_CHAR scope, F_CHAR top, int *m, int *n,
9  double *A, int *lda, int *rdest, int *cdest)
10 #endif
11 /*
12  * -- V1.1 BLACS routine --
13  * University of Tennessee, May 1, 1996
14  * Written by Clint Whaley.
15  *
16  * Purpose
17  * =======
18  * Combine sum operation for double complex rectangular matrices.
19  *
20  * Arguments
21  * =========
22  *
23  * ConTxt (input) Ptr to int
24  * Index into MyConTxts00 (my contexts array).
25  *
26  * SCOPE (input) Ptr to char
27  * Limit the scope of the operation.
28  * = 'R' : Operation is performed by a process row.
29  * = 'C' : Operation is performed by a process column.
30  * = 'A' : Operation is performed by all processes in grid.
31  *
32  * TOP (input) Ptr to char
33  * Controls fashion in which messages flow within the operation.
34  *
35  * M (input) Ptr to int
36  * The number of rows of the matrix A. M >= 0.
37  *
38  * N (input) Ptr to int
39  * The number of columns of the matrix A. N >= 0.
40  *
41  * A (output) Ptr to double complex two dimensional array
42  * The m by n matrix A. Fortran77 (column-major) storage
43  * assumed.
44  *
45  * LDA (input) Ptr to int
46  * The leading dimension of the array A. LDA >= M.
47  *
48  * RDEST (input) Ptr to int
49  * The process row of the destination of the sum.
50  * If rdest == -1, then result is left on all processes in scope.
51  *
52  * CDEST (input) Ptr to int
53  * The process column of the destination of the sum.
54  * If rdest == -1, then CDEST ignored.
55  *
56  * ------------------------------------------------------------------------
57  */
58 {
59  void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int,
60  int *, int *);
61  void BI_UpdateBuffs(BLACBUFF *);
62  BLACBUFF *BI_GetBuff(int);
63  int BI_BuffIsFree(BLACBUFF *, int);
64  MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int,
65  MPI_Datatype, int *);
66  BLACBUFF *BI_Pack(BLACSCONTEXT *, BVOID *, BLACBUFF *, MPI_Datatype);
67  MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int,
68  MPI_Datatype, int *);
69  void BI_Unpack(BLACSCONTEXT *, BVOID *, BLACBUFF *, MPI_Datatype);
71  int, int);
73  int, int);
74  void BI_BeComb(BLACSCONTEXT *, BLACBUFF *, BLACBUFF *, int, VVFUNPTR);
75  void BI_zvvsum(int, char *, char *);
76  void BI_zMPI_sum(void *, void *, int *, MPI_Datatype *);
77 /*
78  * Variable Declarations
79  */
80  BLACBUFF *bp, *bp2;
81  BLACSCONTEXT *ctxt;
82  char ttop, tscope;
83  int N, length, dest, tlda, trdest, ierr;
84  MPI_Op BlacComb;
85  extern BLACBUFF *BI_ActiveQ;
86  extern BLACBUFF BI_AuxBuff;
87
88  MGetConTxt(Mpval(ConTxt), ctxt);
89  ttop = F2C_CharTrans(top);
90  ttop = Mlowcase(ttop);
91  tscope = F2C_CharTrans(scope);
92  tscope = Mlowcase(tscope);
93 /*
94  * If the user has set the default combine topology, use it instead of
95  * BLACS default
96  */
97 #ifdef DefCombTop
98  if (ttop == ' ') ttop = DefCombTop;
99 #endif
100  if (Mpval(cdest) == -1) trdest = -1;
101  else trdest = Mpval(rdest);
102 #if (BlacsDebugLvl > 0)
103  BI_ArgCheck(Mpval(ConTxt), RT_COMB, __FILE__, tscope, 'u', 'u', Mpval(m),
104  Mpval(n), Mpval(lda), 1, &trdest, Mpaddress(cdest));
105 #endif
106  if (Mpval(lda) >= Mpval(m)) tlda = Mpval(lda);
107  else tlda = Mpval(m);
108  switch(tscope)
109  {
110  case 'r':
111  ctxt->scp = &ctxt->rscp;
112  if (trdest == -1) dest = -1;
113  else dest = Mpval(cdest);
114  break;
115  case 'c':
116  ctxt->scp = &ctxt->cscp;
117  dest = trdest;
118  break;
119  case 'a':
120  ctxt->scp = &ctxt->ascp;
121  if (trdest == -1) dest = -1;
122  else dest = Mvkpnum(ctxt, trdest, Mpval(cdest));
123  break;
124  default:
125  BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown scope '%c'",
126  tscope);
127  }
128
129
130 /*
131  * It's not defined how MPI reacts to 0 element reductions, so use BLACS 1-tree
132  * topology if we've got one. Also, we can't use MPI functions if we need to
133  * guarantee repeatability.
134  */
135  if (ttop == ' ')
136  if ( (Mpval(m) < 1) || (Mpval(n) < 1) || (ctxt->TopsRepeat) ) ttop = '1';
137  N = Mpval(m) * Mpval(n);
138  length = N * sizeof(DCOMPLEX);
139 /*
140  * If A is contiguous, we can use it as one of the buffers
141  */
142  if ( (Mpval(m) == tlda) || (Mpval(n) == 1) )
143  {
144  bp = &BI_AuxBuff;
145  bp->Buff = (char *) A;
146  bp2 = BI_GetBuff(length);
147  }
148 /*
149  * Otherwise, we must allocate both buffers
150  */
151  else
152  {
153  bp = BI_GetBuff(length*2);
154  bp2 = &BI_AuxBuff;
155  bp2->Buff = &bp->Buff[length];
156  BI_zmvcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff);
157  }
158  bp->dtype = bp2->dtype = MPI_DOUBLE_COMPLEX;
159  bp->N = bp2->N = N;
160
161  switch(ttop)
162  {
163  case ' ': /* use MPI's reduction by default */
164  length = 1;
165  ierr=MPI_Op_create(BI_zMPI_sum, length, &BlacComb);
166  if (dest != -1)
167  {
168  ierr=MPI_Reduce(bp->Buff, bp2->Buff, bp->N, bp->dtype, BlacComb,
169  dest, ctxt->scp->comm);
170  if (ctxt->scp->Iam == dest)
171  BI_zvmcopy(Mpval(m), Mpval(n), A, tlda, bp2->Buff);
172  }
173  else
174  {
175  ierr=MPI_Allreduce(bp->Buff, bp2->Buff, bp->N, bp->dtype, BlacComb,
176  ctxt->scp->comm);
177  BI_zvmcopy(Mpval(m), Mpval(n), A, tlda, bp2->Buff);
178  }
179  ierr=MPI_Op_free(&BlacComb);
180  if (BI_ActiveQ) BI_UpdateBuffs(NULL);
181  return;
182  break;
183  case 'i':
184  BI_MringComb(ctxt, bp, bp2, N, BI_zvvsum, dest, 1);
185  break;
186  case 'd':
187  BI_MringComb(ctxt, bp, bp2, N, BI_zvvsum, dest, -1);
188  break;
189  case 's':
190  BI_MringComb(ctxt, bp, bp2, N, BI_zvvsum, dest, 2);
191  break;
192  case 'm':
193  BI_MringComb(ctxt, bp, bp2, N, BI_zvvsum, dest, ctxt->Nr_co);
194  break;
195  case '1':
196  case '2':
197  case '3':
198  case '4':
199  case '5':
200  case '6':
201  case '7':
202  case '8':
203  case '9':
204  BI_TreeComb(ctxt, bp, bp2, N, BI_zvvsum, dest, ttop-47);
205  break;
206  case 'f':
207  BI_TreeComb(ctxt, bp, bp2, N, BI_zvvsum, dest, FULLCON);
208  break;
209  case 't':
210  BI_TreeComb(ctxt, bp, bp2, N, BI_zvvsum, dest, ctxt->Nb_co);
211  break;
212  case 'h':
213 /*
214  * Use bidirectional exchange if everyone wants answer
215  */
216  if ( (trdest == -1) && !(ctxt->TopsCohrnt) )
217  BI_BeComb(ctxt, bp, bp2, N, BI_zvvsum);
218  else
219  BI_TreeComb(ctxt, bp, bp2, N, BI_zvvsum, dest, 2);
220  break;
221  default :
222  BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown topology '%c'",
223  ttop);
224  }
225
226 /*
228  */
229  if (bp != &BI_AuxBuff)
230  {
231  if ( (ctxt->scp->Iam == dest) || (dest == -1) )
232  BI_zvmcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff);
233  BI_UpdateBuffs(bp);
234  }
235  else
236  {
237  if (BI_ActiveQ) BI_UpdateBuffs(NULL);
238  BI_BuffIsFree(bp, 1);
239  }
240 }
bLaCsCoNtExT::TopsRepeat
int TopsRepeat
Definition: Bdef.h:27
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_GetBuff
BLACBUFF * BI_GetBuff(int length)
Definition: BI_GetBuff.c:36
bLaCbUfF::Buff
char * Buff
Definition: Bdef.h:56
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
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
BI_zMPI_sum
void BI_zMPI_sum(void *in, void *inout, int *N, MPI_Datatype *dtype)
Definition: BI_zMPI_sum.c:2
BVOID
#define BVOID
Definition: Bdef.h:136
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
DCOMPLEX
Definition: Bdef.h:37
BI_zvmcopy
#define BI_zvmcopy(m, n, A, lda, buff)
Definition: Bdef.h:296
bLaCbUfF::N
int N
Definition: Bdef.h:61
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
Definition: Bdef.h:262
BI_zmvcopy
#define BI_zmvcopy(m, n, A, lda, buff)
Definition: Bdef.h:294
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
BI_zvvsum
void BI_zvvsum(int N, char *vec1, char *vec2)
Definition: BI_zvvsum.c:2
bLaCsCoNtExT::cscp
BLACSSCOPE cscp
Definition: Bdef.h:25
bLaCsCoNtExT::scp
BLACSSCOPE * scp
Definition: Bdef.h:26
Bdef.h
Czgsum2d
void Czgsum2d()
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
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
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
Mvkpnum
#define Mvkpnum(ctxt, prow, pcol)
Definition: Bdef.h:174
zgsum2d_
F_VOID_FUNC zgsum2d_(int *ConTxt, F_CHAR scope, F_CHAR top, int *m, int *n, double *A, int *lda, int *rdest, int *cdest)
Definition: zgsum2d_.c:8
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