ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
dgsum2d_.c
Go to the documentation of this file.
1 #include "Bdef.h"
2 
3 
4 #if (INTFACE == C_CALL)
5 void Cdgsum2d(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 dgsum2d_(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 precision 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 precision 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_dvvsum(int, char *, char *);
76 /*
77  * Variable Declarations
78  */
79  BLACBUFF *bp, *bp2;
80  BLACSCONTEXT *ctxt;
81  char ttop, tscope;
82  int N, length, dest, tlda, trdest, ierr;
83  extern BLACBUFF *BI_ActiveQ;
84  extern BLACBUFF BI_AuxBuff;
85 
86  MGetConTxt(Mpval(ConTxt), ctxt);
87  ttop = F2C_CharTrans(top);
88  ttop = Mlowcase(ttop);
89  tscope = F2C_CharTrans(scope);
90  tscope = Mlowcase(tscope);
91 /*
92  * If the user has set the default combine topology, use it instead of
93  * BLACS default
94  */
95 #ifdef DefCombTop
96  if (ttop == ' ') ttop = DefCombTop;
97 #endif
98  if (Mpval(cdest) == -1) trdest = -1;
99  else trdest = Mpval(rdest);
100 #if (BlacsDebugLvl > 0)
101  BI_ArgCheck(Mpval(ConTxt), RT_COMB, __FILE__, tscope, 'u', 'u', Mpval(m),
102  Mpval(n), Mpval(lda), 1, &trdest, Mpaddress(cdest));
103 #endif
104  if (Mpval(lda) >= Mpval(m)) tlda = Mpval(lda);
105  else tlda = Mpval(m);
106  switch(tscope)
107  {
108  case 'r':
109  ctxt->scp = &ctxt->rscp;
110  if (trdest == -1) dest = -1;
111  else dest = Mpval(cdest);
112  break;
113  case 'c':
114  ctxt->scp = &ctxt->cscp;
115  dest = trdest;
116  break;
117  case 'a':
118  ctxt->scp = &ctxt->ascp;
119  if (trdest == -1) dest = -1;
120  else dest = Mvkpnum(ctxt, trdest, Mpval(cdest));
121  break;
122  default:
123  BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown scope '%c'",
124  tscope);
125  }
126 
127 
128 /*
129  * It's not defined how MPI reacts to 0 element reductions, so use BLACS 1-tree
130  * topology if we've got one. Also, we can't use MPI functions if we need to
131  * guarantee repeatability.
132  */
133  if (ttop == ' ')
134  if ( (Mpval(m) < 1) || (Mpval(n) < 1) || (ctxt->TopsRepeat) ) ttop = '1';
135  N = Mpval(m) * Mpval(n);
136  length = N * sizeof(double);
137 /*
138  * If A is contiguous, we can use it as one of the buffers
139  */
140  if ( (Mpval(m) == tlda) || (Mpval(n) == 1) )
141  {
142  bp = &BI_AuxBuff;
143  bp->Buff = (char *) A;
144  bp2 = BI_GetBuff(length);
145  }
146 /*
147  * Otherwise, we must allocate both buffers
148  */
149  else
150  {
151  bp = BI_GetBuff(length*2);
152  bp2 = &BI_AuxBuff;
153  bp2->Buff = &bp->Buff[length];
154  BI_dmvcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff);
155  }
156  bp->dtype = bp2->dtype = MPI_DOUBLE;
157  bp->N = bp2->N = N;
158 
159  switch(ttop)
160  {
161  case ' ': /* use MPI's reduction by default */
162  if (dest != -1)
163  {
164  ierr=MPI_Reduce(bp->Buff, bp2->Buff, bp->N, bp->dtype, MPI_SUM,
165  dest, ctxt->scp->comm);
166  if (ctxt->scp->Iam == dest)
167  BI_dvmcopy(Mpval(m), Mpval(n), A, tlda, bp2->Buff);
168  }
169  else
170  {
171  ierr=MPI_Allreduce(bp->Buff, bp2->Buff, bp->N, bp->dtype, MPI_SUM,
172  ctxt->scp->comm);
173  BI_dvmcopy(Mpval(m), Mpval(n), A, tlda, bp2->Buff);
174  }
175  if (BI_ActiveQ) BI_UpdateBuffs(NULL);
176  return;
177  break;
178  case 'i':
179  BI_MringComb(ctxt, bp, bp2, N, BI_dvvsum, dest, 1);
180  break;
181  case 'd':
182  BI_MringComb(ctxt, bp, bp2, N, BI_dvvsum, dest, -1);
183  break;
184  case 's':
185  BI_MringComb(ctxt, bp, bp2, N, BI_dvvsum, dest, 2);
186  break;
187  case 'm':
188  BI_MringComb(ctxt, bp, bp2, N, BI_dvvsum, dest, ctxt->Nr_co);
189  break;
190  case '1':
191  case '2':
192  case '3':
193  case '4':
194  case '5':
195  case '6':
196  case '7':
197  case '8':
198  case '9':
199  BI_TreeComb(ctxt, bp, bp2, N, BI_dvvsum, dest, ttop-47);
200  break;
201  case 'f':
202  BI_TreeComb(ctxt, bp, bp2, N, BI_dvvsum, dest, FULLCON);
203  break;
204  case 't':
205  BI_TreeComb(ctxt, bp, bp2, N, BI_dvvsum, dest, ctxt->Nb_co);
206  break;
207  case 'h':
208 /*
209  * Use bidirectional exchange if everyone wants answer
210  */
211  if ( (trdest == -1) && !(ctxt->TopsCohrnt) )
212  BI_BeComb(ctxt, bp, bp2, N, BI_dvvsum);
213  else
214  BI_TreeComb(ctxt, bp, bp2, N, BI_dvvsum, dest, 2);
215  break;
216  default :
217  BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown topology '%c'",
218  ttop);
219  }
220 
221 /*
222  * If I am selected to receive answer
223  */
224  if (bp != &BI_AuxBuff)
225  {
226  if ( (ctxt->scp->Iam == dest) || (dest == -1) )
227  BI_dvmcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff);
228  BI_UpdateBuffs(bp);
229  }
230  else
231  {
232  if (BI_ActiveQ) BI_UpdateBuffs(NULL);
233  BI_BuffIsFree(bp, 1);
234  }
235 }
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
dgsum2d_
F_VOID_FUNC dgsum2d_(int *ConTxt, F_CHAR scope, F_CHAR top, int *m, int *n, double *A, int *lda, int *rdest, int *cdest)
Definition: dgsum2d_.c:8
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
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
BI_dvvsum
void BI_dvvsum(int N, char *vec1, char *vec2)
Definition: BI_dvvsum.c:2
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
Cdgsum2d
void Cdgsum2d()
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
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
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