1 #include "Bdef.h"
2
3 #if (INTFACE == C_CALL)
Ccgebs2d(int ConTxt,char * scope,char * top,int m,int n,float * A,int lda)4 void Ccgebs2d(int ConTxt, char *scope, char *top, int m, int n, float *A, int lda)
5 #else
6 F_VOID_FUNC cgebs2d_(int *ConTxt, F_CHAR scope, F_CHAR top, int *m, int *n,
7 float *A, int *lda)
8 #endif
9 /*
10 * -- V1.1 BLACS routine --
11 * University of Tennessee, May 1, 1996
12 * Written by Clint Whaley.
13 *
14 * Purpose
15 * =======
16 * Broadcast/send for general complex arrays.
17 *
18 * Arguments
19 * =========
20 *
21 * ConTxt (input) Ptr to int
22 * Index into MyConTxts00 (my contexts array).
23 *
24 * SCOPE (input) Ptr to char
25 * Limit the scope of the operation.
26 * = 'R' : Operation is performed by a process row.
27 * = 'C' : Operation is performed by a process column.
28 * = 'A' : Operation is performed by all processes in grid.
29 *
30 * TOP (input) Ptr to char
31 * Controls fashion in which messages flow within the operation.
32 *
33 * M (input) Ptr to int
34 * The number of rows of the matrix A. M >= 0.
35 *
36 * N (input) Ptr to int
37 * The number of columns of the matrix A. N >= 0.
38 *
39 * A (input) Ptr to complex two dimensional array
40 * The m by n matrix A. Fortran77 (column-major) storage
41 * assumed.
42 *
43 * LDA (input) Ptr to int
44 * The leading dimension of the array A. LDA >= M.
45 *
46 * ------------------------------------------------------------------------
47 */
48 {
49 void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int,
50 int *, int *);
51 int BI_HypBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR);
52 void BI_IdringBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int);
53 void BI_SringBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR);
54 void BI_MpathBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int);
55 void BI_TreeBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int);
56 void BI_UpdateBuffs(BLACBUFF *);
57 BLACBUFF *BI_GetBuff(int);
58 int BI_BuffIsFree(BLACBUFF *, int);
59 BI_MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int,
60 BI_MPI_Datatype, int *);
61 BLACBUFF *BI_Pack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype);
62 void BI_Ssend(BLACSCONTEXT *, int, int, BLACBUFF *);
63 void BI_Asend(BLACSCONTEXT *, int, int, BLACBUFF *);
64
65 char ttop, tscope;
66 int error, tlda;
67 BI_MPI_Datatype MatTyp;
68 SDRVPTR send;
69 BLACBUFF *bp;
70 BLACSCONTEXT *ctxt;
71 extern BLACBUFF BI_AuxBuff, *BI_ActiveQ;
72 /*
73 * get context, lowcase char variables, and perform parameter checking
74 */
75 MGetConTxt(Mpval(ConTxt), ctxt);
76 ttop = F2C_CharTrans(top);
77 ttop = Mlowcase(ttop);
78 tscope = F2C_CharTrans(scope);
79 tscope = Mlowcase(tscope);
80 #if (BlacsDebugLvl > 0)
81 BI_ArgCheck(Mpval(ConTxt), RT_BS, __FILE__, 'a', 'u', 'u', Mpval(m),
82 Mpval(n), Mpval(lda), 0, NULL, NULL);
83 #endif
84 /*
85 * If the user has set the default broadcast topology, use it instead of
86 * BLACS default
87 */
88 #ifdef DefBSTop
89 if (ttop == ' ') ttop = DefBSTop;
90 #endif
91 if (Mpval(lda) < Mpval(m)) tlda = Mpval(m);
92 else tlda = Mpval(lda);
93
94 switch(tscope)
95 {
96 case 'r':
97 ctxt->scp = &ctxt->rscp;
98 break;
99 case 'c':
100 ctxt->scp = &ctxt->cscp;
101 break;
102 case 'a':
103 ctxt->scp = &ctxt->ascp;
104 break;
105 default:
106 BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown scope '%c'",
107 tscope);
108 }
109
110 MatTyp = BI_GetMpiGeType(ctxt, Mpval(m), Mpval(n), tlda,
111 BI_MPI_COMPLEX, &BI_AuxBuff.N);
112 /*
113 * If using default topology, use MPI native broadcast
114 */
115 if (ttop == ' ')
116 {
117 BI_MPI_Bcast(A, BI_AuxBuff.N, MatTyp, ctxt->scp->Iam, ctxt->scp->comm,
118 error);
119 BI_MPI_Type_free(&MatTyp, error);
120 if (BI_ActiveQ) BI_UpdateBuffs(NULL);
121 return;
122 }
123 /*
124 * If MPI handles non-contiguous buffering well, always use MPI data types
125 * instead of packing
126 */
127 #ifndef MpiBuffGood
128 /*
129 * If A is contiguous, send directly from it
130 */
131 else if ( (tlda == Mpval(m)) || (Mpval(n) == 1) )
132 {
133 #endif
134 send = BI_Ssend;
135 BI_AuxBuff.Buff = (char *) A;
136 BI_AuxBuff.dtype = MatTyp;
137 bp = &BI_AuxBuff;
138 #ifndef MpiBuffGood
139 }
140 else
141 {
142 send = BI_Asend;
143 bp = BI_Pack(ctxt, (BVOID *) A, NULL, MatTyp);
144 }
145 #endif
146
147 /*
148 * Call correct topology for BS/BR
149 */
150 switch(ttop)
151 {
152 case 'h':
153 error = BI_HypBS(ctxt, bp, send);
154 if (error == NPOW2) BI_TreeBS(ctxt, bp, send, 2);
155 break;
156 case '1':
157 case '2':
158 case '3':
159 case '4':
160 case '5':
161 case '6':
162 case '7':
163 case '8':
164 case '9':
165 BI_TreeBS(ctxt, bp, send, ttop-47);
166 break;
167 case 't':
168 BI_TreeBS(ctxt, bp, send, ctxt->Nb_bs);
169 break;
170 case 'i':
171 BI_IdringBS(ctxt, bp, send, 1);
172 break;
173 case 'd':
174 BI_IdringBS(ctxt, bp, send, -1);
175 break;
176 case 's':
177 BI_SringBS(ctxt, bp, send);
178 break;
179 case 'f':
180 BI_MpathBS(ctxt, bp, send, FULLCON);
181 break;
182 case 'm':
183 BI_MpathBS(ctxt, bp, send, ctxt->Nr_bs);
184 break;
185 default :
186 BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown topology '%c'",
187 ttop);
188 }
189
190 BI_MPI_Type_free(&MatTyp, error);
191 if (bp == &BI_AuxBuff)
192 {
193 if (BI_ActiveQ) BI_UpdateBuffs(NULL);
194 }
195 else BI_UpdateBuffs(bp);
196 } /* end cgebs2d_ */
197