ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
zgebr2d_.c
Go to the documentation of this file.
1 #include "Bdef.h"
2 
3 #if (INTFACE == C_CALL)
4 void Czgebr2d(int ConTxt, char *scope, char *top, int m, int n, double *A,
5  int lda, int rsrc, int csrc)
6 #else
7 F_VOID_FUNC zgebr2d_(int *ConTxt, F_CHAR scope, F_CHAR top, int *m, int *n,
8  double *A, int *lda, int *rsrc, int *csrc)
9 #endif
10 /*
11  * -- V1.1 BLACS routine --
12  * University of Tennessee, May 1, 1996
13  * Written by Clint Whaley.
14  *
15  * Purpose
16  * =======
17  * Broadcast/receive for general double complex arrays.
18  *
19  * Arguments
20  * =========
21  *
22  * ConTxt (input) Ptr to int
23  * Index into MyConTxts00 (my contexts array).
24  *
25  * SCOPE (input) Ptr to char
26  * Limit the scope of the operation.
27  * = 'R' : Operation is performed by a process row.
28  * = 'C' : Operation is performed by a process column.
29  * = 'A' : Operation is performed by all processes in grid.
30  *
31  * TOP (input) Ptr to char
32  * Controls fashion in which messages flow within the operation.
33  *
34  * M (input) Ptr to int
35  * The number of rows of the matrix A. M >= 0.
36  *
37  * N (input) Ptr to int
38  * The number of columns of the matrix A. N >= 0.
39  *
40  * A (output) Ptr to double complex two dimensional array
41  * The m by n matrix A. Fortran77 (column-major) storage
42  * assumed.
43  *
44  * LDA (input) Ptr to int
45  * The leading dimension of the array A. LDA >= M.
46  *
47  *
48  * RSRC (input) Ptr to int
49  * The process row of the source of the matrix.
50  *
51  * CSRC (input) Ptr to int
52  * The process column of the source of the matrix.
53  *
54  *
55  * ------------------------------------------------------------------------
56  */
57 {
58  void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int,
59  int *, int *);
60  int BI_HypBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int);
61  void BI_IdringBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int, int);
62  void BI_SringBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int);
63  void BI_MpathBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int, int);
64  void BI_TreeBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int, int);
65  void BI_UpdateBuffs(BLACBUFF *);
66  BLACBUFF *BI_GetBuff(int);
67  int BI_BuffIsFree(BLACBUFF *, int);
68  MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int,
69  MPI_Datatype, int *);
70  void BI_Unpack(BLACSCONTEXT *, BVOID *, BLACBUFF *, MPI_Datatype);
71  void BI_Ssend(BLACSCONTEXT *, int, int, BLACBUFF *);
72  void BI_Asend(BLACSCONTEXT *, int, int, BLACBUFF *);
73 
74  BLACSCONTEXT *ctxt;
75  BLACBUFF *bp=NULL;
76  SDRVPTR send;
77  MPI_Datatype MatTyp;
78  int length, src, tlda, error, one=1;
79  char ttop, tscope;
81 
82  MGetConTxt(Mpval(ConTxt), ctxt);
83  ttop = F2C_CharTrans(top);
84  ttop = Mlowcase(ttop);
85  tscope = F2C_CharTrans(scope);
86  tscope = Mlowcase(tscope);
87 #if (BlacsDebugLvl > 0)
88  BI_ArgCheck(Mpval(ConTxt), RT_BR, __FILE__, tscope, 'u', 'u', Mpval(m),
89  Mpval(n), Mpval(lda), 1, Mpaddress(rsrc), Mpaddress(csrc));
90 #endif
91 /*
92  * If the user has set the default broadcast topology, use it instead of
93  * BLACS default
94  */
95 #ifdef DefBSTop
96  if (ttop == ' ') ttop = DefBSTop;
97 #endif
98  if (Mpval(m) <= Mpval(lda)) tlda = Mpval(lda);
99  else tlda = Mpval(m);
100 
101  switch(tscope)
102  {
103  case 'r':
104  ctxt->scp = &ctxt->rscp;
105  src = Mpval(csrc);
106  break;
107  case 'c':
108  ctxt->scp = &ctxt->cscp;
109  src = Mpval(rsrc);
110  break;
111  case 'a':
112  ctxt->scp = &ctxt->ascp;
113  src = Mvkpnum(ctxt, Mpval(rsrc), Mpval(csrc));
114  break;
115  default:
116  BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown scope '%c'",
117  tscope);
118  }
119 
120  MatTyp = BI_GetMpiGeType(ctxt, Mpval(m), Mpval(n), tlda,
121  MPI_DOUBLE_COMPLEX, &BI_AuxBuff.N);
122 /*
123  * If using default topology, use MPI native broadcast
124  */
125  if (ttop == ' ')
126  {
127  error=MPI_Bcast(A, BI_AuxBuff.N, MatTyp, src, ctxt->scp->comm);
128  error=BI_MPI_TYPE_FREE(&MatTyp);
129  if (BI_ActiveQ) BI_UpdateBuffs(NULL);
130  return;
131  }
132 /*
133  * If MPI handles non-contiguous buffering well, always use MPI data types
134  * instead of packing
135  */
136 #ifndef MpiBuffGood
137 /*
138  * If A is contiguous, receive and send directly to/from it
139  */
140  else if ( (tlda == Mpval(m)) || (Mpval(n) == 1) )
141  {
142 #endif
143  send = BI_Ssend;
144  BI_AuxBuff.Buff = (char *) A;
145  BI_AuxBuff.dtype = MatTyp;
146  bp = &BI_AuxBuff;
147 #ifndef MpiBuffGood
148  }
149 /*
150  * If A is not contiguous, we receive message as packed so it can be
151  * forwarded without further system intervention
152  */
153  else
154  {
155  send = BI_Asend;
156  MPI_Pack_size(one, MatTyp, ctxt->scp->comm, &length);
157  bp = BI_GetBuff(length);
158  bp->N = length;
159  bp->dtype = MPI_PACKED;
160 #if ZeroByteTypeBug
161  if (MatTyp == MPI_BYTE)
162  {
163  send = BI_Ssend;
164  bp->N = 0;
165  bp->dtype = MPI_BYTE;
166  }
167 #endif
168  }
169 #endif
170 
171  switch(ttop)
172  {
173  case 'h':
174  error = BI_HypBR(ctxt, bp, send, src);
175  if (error == NPOW2) BI_TreeBR(ctxt, bp, send, src, 2);
176  break;
177  case '1':
178  case '2':
179  case '3':
180  case '4':
181  case '5':
182  case '6':
183  case '7':
184  case '8':
185  case '9':
186  BI_TreeBR(ctxt, bp, send, src, ttop-47);
187  break;
188  case 't':
189  BI_TreeBR(ctxt, bp, send, src, ctxt->Nb_bs);
190  break;
191  case 'i':
192  BI_IdringBR(ctxt, bp, send, src, 1);
193  break;
194  case 'd':
195  BI_IdringBR(ctxt, bp, send, src, -1);
196  break;
197  case 's':
198  BI_SringBR(ctxt, bp, send, src);
199  break;
200  case 'm':
201  BI_MpathBR(ctxt, bp, send, src, ctxt->Nr_bs);
202  break;
203  case 'f':
204  BI_MpathBR(ctxt, bp, send, src, FULLCON);
205  break;
206  default :
207  BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown topology '%c'",
208  ttop);
209  }
210 
211 /*
212  * If we buffered, unpack.
213  */
214 #ifndef MpiBuffGood
215  if (bp != &BI_AuxBuff)
216  {
217  BI_Unpack(ctxt, (BVOID *) A, bp, MatTyp);
218  BI_UpdateBuffs(bp);
219  }
220  else
221 #endif
222  {
223  error=BI_MPI_TYPE_FREE(&MatTyp);
224  if (BI_ActiveQ) BI_UpdateBuffs(NULL);
225  }
226 }
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
BI_Asend
void BI_Asend(BLACSCONTEXT *ctxt, int dest, int msgid, BLACBUFF *bp)
Definition: BI_Asend.c:3
FULLCON
#define FULLCON
Definition: Bdef.h:100
BI_SringBR
void BI_SringBR(BLACSCONTEXT *ctxt, BLACBUFF *bp, SDRVPTR send, int src)
Definition: BI_SringBR.c:3
BI_Ssend
void BI_Ssend(BLACSCONTEXT *ctxt, int dest, int msgid, BLACBUFF *bp)
Definition: BI_Ssend.c:3
F_CHAR
char * F_CHAR
Definition: pblas.h:109
bLaCsCoNtExT::ascp
BLACSSCOPE ascp
Definition: Bdef.h:25
BI_MpathBR
void BI_MpathBR(BLACSCONTEXT *ctxt, BLACBUFF *bp, SDRVPTR send, int src, int npaths)
Definition: BI_MpathBR.c:3
zgebr2d_
F_VOID_FUNC zgebr2d_(int *ConTxt, F_CHAR scope, F_CHAR top, int *m, int *n, double *A, int *lda, int *rsrc, int *csrc)
Definition: zgebr2d_.c:7
MGetConTxt
#define MGetConTxt(Context, ctxtptr)
Definition: Bdef.h:200
Czgebr2d
void Czgebr2d()
BI_HypBR
int BI_HypBR(BLACSCONTEXT *ctxt, BLACBUFF *bp, SDRVPTR send, int src)
Definition: BI_HypBR.c:3
BVOID
#define BVOID
Definition: Bdef.h:136
bLaCbUfF
Definition: Bdef.h:54
BI_IdringBR
void BI_IdringBR(BLACSCONTEXT *ctxt, BLACBUFF *bp, SDRVPTR send, int src, int step)
Definition: BI_IdringBR.c:3
BI_ActiveQ
BLACBUFF * BI_ActiveQ
Definition: BI_GlobalVars.c:9
bLaCbUfF::N
int N
Definition: Bdef.h:61
BI_TreeBR
void BI_TreeBR(BLACSCONTEXT *ctxt, BLACBUFF *bp, SDRVPTR send, int src, int nbranches)
Definition: BI_TreeBR.c:3
bLaCsCoNtExT::Nb_bs
int Nb_bs
Definition: Bdef.h:29
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
bLaCsCoNtExT::Nr_bs
int Nr_bs
Definition: Bdef.h:29
Mpaddress
#define Mpaddress(para)
Definition: Bdef.h:262
SDRVPTR
void(* SDRVPTR)(BLACSCONTEXT *, int, int, BLACBUFF *)
Definition: Bdef.h:69
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
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
RT_BR
#define RT_BR
Definition: Bdef.h:108
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_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
NPOW2
#define NPOW2
Definition: Bdef.h:88
BI_BuffIsFree
int BI_BuffIsFree(BLACBUFF *bp, int Wait)
Definition: BI_BuffIsFree.c:3