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