ScaLAPACK  2.0.2
ScaLAPACK: Scalable Linear Algebra PACKage
zgebs2d_.c
Go to the documentation of this file.
00001 #include "Bdef.h"
00002 
00003 #if (INTFACE == C_CALL)
00004 void Czgebs2d(int ConTxt, char *scope, char *top, int m, int n, double *A, int lda)
00005 #else
00006 F_VOID_FUNC zgebs2d_(int *ConTxt, F_CHAR scope, F_CHAR top, int *m, int *n,
00007                      double *A, int *lda)
00008 #endif
00009 /*
00010  *  -- V1.1 BLACS routine --
00011  *  University of Tennessee, May 1, 1996
00012  *  Written by Clint Whaley.
00013  *
00014  *  Purpose
00015  *  =======
00016  *  Broadcast/send for general double complex arrays.
00017  *
00018  *  Arguments
00019  *  =========
00020  *
00021  *  ConTxt  (input) Ptr to int
00022  *          Index into MyConTxts00 (my contexts array).
00023  *
00024  *  SCOPE   (input) Ptr to char
00025  *          Limit the scope of the operation.
00026  *          = 'R' :   Operation is performed by a process row.
00027  *          = 'C' :   Operation is performed by a process column.
00028  *          = 'A' :   Operation is performed by all processes in grid.
00029  *
00030  *  TOP     (input) Ptr to char
00031  *          Controls fashion in which messages flow within the operation.
00032  *
00033  *  M       (input) Ptr to int
00034  *          The number of rows of the matrix A.  M >= 0.
00035  *
00036  *  N       (input) Ptr to int
00037  *          The number of columns of the matrix A.  N >= 0.
00038  *
00039  *  A       (input) Ptr to double complex two dimensional array
00040  *          The m by n matrix A.  Fortran77 (column-major) storage
00041  *          assumed.
00042  *
00043  *  LDA     (input) Ptr to int
00044  *          The leading dimension of the array A.  LDA >= M.
00045  *
00046  * ------------------------------------------------------------------------
00047  */
00048 {
00049    void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int,
00050                     int *, int *);
00051    int BI_HypBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR);
00052    void BI_IdringBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int);
00053    void BI_SringBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR);
00054    void BI_MpathBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int);
00055    void BI_TreeBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int);
00056    void BI_UpdateBuffs(BLACBUFF *);
00057    BLACBUFF *BI_GetBuff(int);
00058    int BI_BuffIsFree(BLACBUFF *, int);
00059    MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int,
00060                                    MPI_Datatype, int *);
00061    BLACBUFF *BI_Pack(BLACSCONTEXT *, BVOID *, BLACBUFF *, MPI_Datatype);
00062    void BI_Ssend(BLACSCONTEXT *, int, int, BLACBUFF *);
00063    void BI_Asend(BLACSCONTEXT *, int, int, BLACBUFF *);
00064 
00065    char ttop, tscope;
00066    int error, tlda;
00067    MPI_Datatype MatTyp;
00068    SDRVPTR send;
00069    BLACBUFF *bp;
00070    BLACSCONTEXT *ctxt;
00071    extern BLACBUFF BI_AuxBuff, *BI_ActiveQ;
00072 /*
00073  * get context, lowcase char variables, and perform parameter checking
00074  */
00075    MGetConTxt(Mpval(ConTxt), ctxt);
00076    ttop = F2C_CharTrans(top);
00077    ttop = Mlowcase(ttop);
00078    tscope = F2C_CharTrans(scope);
00079    tscope = Mlowcase(tscope);
00080 #if (BlacsDebugLvl > 0)
00081    BI_ArgCheck(Mpval(ConTxt), RT_BS, __FILE__, 'a', 'u', 'u', Mpval(m),
00082                Mpval(n), Mpval(lda), 0, NULL, NULL);
00083 #endif
00084 /*
00085  *  If the user has set the default broadcast topology, use it instead of
00086  *  BLACS default
00087  */
00088 #ifdef DefBSTop
00089    if (ttop == ' ') ttop = DefBSTop;
00090 #endif
00091    if (Mpval(lda) < Mpval(m)) tlda = Mpval(m);
00092    else tlda = Mpval(lda);
00093 
00094    switch(tscope)
00095    {
00096    case 'r':
00097       ctxt->scp = &ctxt->rscp;
00098       break;
00099    case 'c':
00100       ctxt->scp = &ctxt->cscp;
00101       break;
00102    case 'a':
00103       ctxt->scp = &ctxt->ascp;
00104       break;
00105    default:
00106       BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown scope '%c'",
00107                   tscope);
00108    }
00109 
00110    MatTyp = BI_GetMpiGeType(ctxt, Mpval(m), Mpval(n), tlda,
00111                             MPI_DOUBLE_COMPLEX, &BI_AuxBuff.N);
00112 /*
00113  * If using default topology, use MPI native broadcast
00114  */
00115    if (ttop == ' ')
00116    {
00117       error=MPI_Bcast(A, BI_AuxBuff.N, MatTyp, ctxt->scp->Iam, ctxt->scp->comm);
00118       error=BI_MPI_TYPE_FREE(&MatTyp);
00119       if (BI_ActiveQ) BI_UpdateBuffs(NULL);
00120       return;
00121    }
00122 /*
00123  * If MPI handles non-contiguous buffering well, always use MPI data types
00124  * instead of packing
00125  */
00126 #ifndef MpiBuffGood
00127 /*
00128  * If A is contiguous, send directly from it
00129  */
00130    else if ( (tlda == Mpval(m)) || (Mpval(n) == 1) )
00131    {
00132 #endif
00133       send = BI_Ssend;
00134       BI_AuxBuff.Buff = (char *) A;
00135       BI_AuxBuff.dtype = MatTyp;
00136       bp = &BI_AuxBuff;
00137 #ifndef MpiBuffGood
00138    }
00139    else
00140    {
00141       send = BI_Asend;
00142       bp = BI_Pack(ctxt, (BVOID *) A, NULL, MatTyp);
00143    }
00144 #endif
00145 
00146 /*
00147  * Call correct topology for BS/BR
00148  */
00149    switch(ttop)
00150    {
00151    case 'h':
00152       error = BI_HypBS(ctxt, bp, send);
00153       if (error == NPOW2) BI_TreeBS(ctxt, bp, send, 2);
00154       break;
00155    case '1':
00156    case '2':
00157    case '3':
00158    case '4':
00159    case '5':
00160    case '6':
00161    case '7':
00162    case '8':
00163    case '9':
00164       BI_TreeBS(ctxt, bp, send, ttop-47);
00165       break;
00166    case 't':
00167       BI_TreeBS(ctxt, bp, send, ctxt->Nb_bs);
00168       break;
00169    case 'i':
00170       BI_IdringBS(ctxt, bp, send, 1);
00171       break;
00172    case 'd':
00173       BI_IdringBS(ctxt, bp, send, -1);
00174       break;
00175    case 's':
00176       BI_SringBS(ctxt, bp, send);
00177       break;
00178    case 'f':
00179       BI_MpathBS(ctxt, bp, send, FULLCON);
00180       break;
00181    case 'm':
00182       BI_MpathBS(ctxt, bp, send, ctxt->Nr_bs);
00183       break;
00184    default :
00185       BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown topology '%c'",
00186                   ttop);
00187    }
00188 
00189    error=BI_MPI_TYPE_FREE(&MatTyp);
00190    if (bp == &BI_AuxBuff)
00191    {
00192       if (BI_ActiveQ) BI_UpdateBuffs(NULL);
00193    }
00194    else BI_UpdateBuffs(bp);
00195 }  /* end  zgebs2d_  */