ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
dtrbr2d_.c
Go to the documentation of this file.
1 #include "Bdef.h"
2 
3 #if (INTFACE == C_CALL)
4 void Cdtrbr2d(int ConTxt, char *scope, char *top, char *uplo, char *diag,
5  int m, int n, double *A, int lda, int rsrc, int csrc)
6 #else
7 F_VOID_FUNC dtrbr2d_(int *ConTxt, F_CHAR scope, F_CHAR top, F_CHAR uplo,
8  F_CHAR diag, int *m, int *n, double *A, int *lda,
9  int *rsrc, int *csrc)
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  * Broadcast/receive for trapezoidal double precision arrays.
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  * UPLO (input) Ptr to char
36  * Specifies the part of the matrix to be sent.
37  * = 'U': Upper trapezoidal part
38  * ELSE : Lower trapezoidal part
39  *
40  * DIAG (input) Ptr to char
41  * Specifies whether the matrix is unit diagonal or not.
42  * = 'U': Matrix is unit diagonal, diagonal not communicated.
43  * ELSE : Matrix is not unit diagonal, diagonal is communicated.
44  *
45  * M (input) Ptr to int
46  * The number of rows of the matrix A. M >= 0.
47  *
48  * N (input) Ptr to int
49  * The number of columns of the matrix A. N >= 0.
50  *
51  * A (output) Ptr to double precision two dimensional array
52  * The m by n matrix A. Fortran77 (column-major) storage
53  * assumed.
54  * If UPLO = 'U', only the upper trapezoid is accessed;
55  * if UPLO = 'L', only the lower trapezoid is accessed.
56  *
57  * LDA (input) Ptr to int
58  * The leading dimension of the array A. LDA >= M.
59  *
60  *
61  * RSRC (input) Ptr to int
62  * The process row of the source of the matrix.
63  *
64  * CSRC (input) Ptr to int
65  * The process column of the source of the matrix.
66  *
67  *
68  * ------------------------------------------------------------------------
69  */
70 {
71  void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int,
72  int *, int *);
73  int BI_HypBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int);
74  void BI_IdringBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int, int);
75  void BI_SringBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int);
76  void BI_MpathBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int, int);
77  void BI_TreeBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int, int);
78  void BI_UpdateBuffs(BLACBUFF *);
79  BLACBUFF *BI_GetBuff(int);
80  int BI_BuffIsFree(BLACBUFF *, int);
81  MPI_Datatype BI_GetMpiTrType(BLACSCONTEXT *, char, char, int, int, int,
82  MPI_Datatype, int *);
83  void BI_Unpack(BLACSCONTEXT *, BVOID *, BLACBUFF *, MPI_Datatype);
84  void BI_Ssend(BLACSCONTEXT *, int, int, BLACBUFF *);
85  void BI_Asend(BLACSCONTEXT *, int, int, BLACBUFF *);
86 
87  BLACSCONTEXT *ctxt;
88  BLACBUFF *bp=NULL;
89  SDRVPTR send;
90  MPI_Datatype MatTyp;
91  int length, src, tlda, error, one=1;
92  char ttop, tscope, tuplo, tdiag;
94 
95  MGetConTxt(Mpval(ConTxt), ctxt);
96  ttop = F2C_CharTrans(top);
97  ttop = Mlowcase(ttop);
98  tscope = F2C_CharTrans(scope);
99  tscope = Mlowcase(tscope);
100  tdiag = F2C_CharTrans(diag);
101  tdiag = Mlowcase(tdiag);
102  tuplo = F2C_CharTrans(uplo);
103  tuplo = Mlowcase(tuplo);
104 #if (BlacsDebugLvl > 0)
105  BI_ArgCheck(Mpval(ConTxt), RT_BR, __FILE__, tscope, tuplo, tdiag, Mpval(m),
106  Mpval(n), Mpval(lda), 1, Mpaddress(rsrc), Mpaddress(csrc));
107 #endif
108 /*
109  * If the user has set the default broadcast topology, use it instead of
110  * BLACS default
111  */
112 #ifdef DefBSTop
113  if (ttop == ' ') ttop = DefBSTop;
114 #endif
115  if (Mpval(m) <= Mpval(lda)) tlda = Mpval(lda);
116  else tlda = Mpval(m);
117 
118  switch(tscope)
119  {
120  case 'r':
121  ctxt->scp = &ctxt->rscp;
122  src = Mpval(csrc);
123  break;
124  case 'c':
125  ctxt->scp = &ctxt->cscp;
126  src = Mpval(rsrc);
127  break;
128  case 'a':
129  ctxt->scp = &ctxt->ascp;
130  src = Mvkpnum(ctxt, Mpval(rsrc), Mpval(csrc));
131  break;
132  default:
133  BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown scope '%c'",
134  tscope);
135  }
136 
137  MatTyp = BI_GetMpiTrType(ctxt, tuplo, tdiag, Mpval(m), Mpval(n), tlda,
138  MPI_DOUBLE, &BI_AuxBuff.N);
139 /*
140  * If using default topology, use MPI native broadcast
141  */
142  if (ttop == ' ')
143  {
144  error=MPI_Bcast(A, BI_AuxBuff.N, MatTyp, src, ctxt->scp->comm);
145  error=BI_MPI_TYPE_FREE(&MatTyp);
146  if (BI_ActiveQ) BI_UpdateBuffs(NULL);
147  return;
148  }
149 /*
150  * If MPI handles non-contiguous buffering well, always use MPI data types
151  * instead of packing
152  */
153 #ifdef MpiBuffGood
154  send = BI_Ssend;
155  BI_AuxBuff.Buff = (char *) A;
156  BI_AuxBuff.dtype = MatTyp;
157  bp = &BI_AuxBuff;
158 #else
159 
160  send = BI_Asend;
161  MPI_Pack_size(one, MatTyp, ctxt->scp->comm, &length);
162  bp = BI_GetBuff(length);
163  bp->N = length;
164  bp->dtype = MPI_PACKED;
165 #if ZeroByteTypeBug
166  if (MatTyp == MPI_BYTE)
167  {
168  send = BI_Ssend;
169  bp->N = 0;
170  bp->dtype = MPI_BYTE;
171  }
172 #endif
173 
174 #endif
175 
176  switch(ttop)
177  {
178  case 'h':
179  error = BI_HypBR(ctxt, bp, send, src);
180  if (error == NPOW2) BI_TreeBR(ctxt, bp, send, src, 2);
181  break;
182  case '1':
183  case '2':
184  case '3':
185  case '4':
186  case '5':
187  case '6':
188  case '7':
189  case '8':
190  case '9':
191  BI_TreeBR(ctxt, bp, send, src, ttop-47);
192  break;
193  case 't':
194  BI_TreeBR(ctxt, bp, send, src, ctxt->Nb_bs);
195  break;
196  case 'i':
197  BI_IdringBR(ctxt, bp, send, src, 1);
198  break;
199  case 'd':
200  BI_IdringBR(ctxt, bp, send, src, -1);
201  break;
202  case 's':
203  BI_SringBR(ctxt, bp, send, src);
204  break;
205  case 'm':
206  BI_MpathBR(ctxt, bp, send, src, ctxt->Nr_bs);
207  break;
208  case 'f':
209  BI_MpathBR(ctxt, bp, send, src, FULLCON);
210  break;
211  default :
212  BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown topology '%c'",
213  ttop);
214  }
215 
216 #ifdef MpiBuffGood
217  error=BI_MPI_TYPE_FREE(&MatTyp);
218  if (BI_ActiveQ) BI_UpdateBuffs(NULL);
219 #endif
220 #ifndef MpiBuffGood
221  BI_Unpack(ctxt, (BVOID *) A, bp, MatTyp);
222  BI_UpdateBuffs(bp);
223 #endif
224 }
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_GetMpiTrType
MPI_Datatype BI_GetMpiTrType(BLACSCONTEXT *ctxt, char uplo, char diag, int m, int n, int lda, MPI_Datatype Dtype, int *N)
Definition: BI_GetMpiTrType.c:4
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
MGetConTxt
#define MGetConTxt(Context, ctxtptr)
Definition: Bdef.h:200
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
Cdtrbr2d
void Cdtrbr2d()
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_AuxBuff
BLACBUFF BI_AuxBuff
Definition: BI_GlobalVars.c:10
dtrbr2d_
F_VOID_FUNC dtrbr2d_(int *ConTxt, F_CHAR scope, F_CHAR top, F_CHAR uplo, F_CHAR diag, int *m, int *n, double *A, int *lda, int *rsrc, int *csrc)
Definition: dtrbr2d_.c:7
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