#include "Bdef.h"

#if (INTFACE == C_CALL)
void Czgebs2d(ConTxt, scope, top, m, n, A, lda)
int  ConTxt;
char  *scope;
char  *top;
int  m;
int  n;
double  *A;
int  lda;
#else
void zgebs2d_(ConTxt, scope, top, m, n, A, lda)
int  *ConTxt;
char  *scope;
char  *top;
int  *m;
int  *n;
double  *A;
int  *lda;
#endif
/*
 *  -- V1.1 BLACS routine --
 *  University of Tennessee, May 1, 1996
 *  Written by Clint Whaley.
 *
 *  Purpose
 *  =======
 *  Broadcast/send for general double complex arrays.
 *
 *  Arguments
 *  =========
 *
 *  ConTxt  (input) Ptr to int
 *          Index into MyConTxts00 (my contexts array).
 *
 *  SCOPE   (input) Ptr to char
 *          Limit the scope of the operation.
 *          = 'R' :   Operation is performed by a process row.
 *          = 'C' :   Operation is performed by a process column.
 *          = 'A' :   Operation is performed by all processes in grid.
 *
 *  TOP     (input) Ptr to char
 *          Controls fashion in which messages flow within the operation.
 *
 *  M       (input) Ptr to int
 *          The number of rows of the matrix A.  M >= 0.
 *
 *  N       (input) Ptr to int
 *          The number of columns of the matrix A.  N >= 0.
 *
 *  A       (input) Ptr to double complex two dimensional array
 *          The m by n matrix A.  Fortran77 (column-major) storage
 *          assumed.
 *
 *  LDA     (input) Ptr to int
 *          The leading dimension of the array A.  LDA >= M.
 *
 * ------------------------------------------------------------------------
 */
{
#if (BlacsDebugLvl > 0)
   void ArgCheck00();
#endif
   void zpack00();
   int Shyp_bs();
   int Sidring_bs();
   int Ssring_bs();
   int Smpath_bs();
   int Stree_bs();
   char *getbuff();

   char ttop, tscope;
   int error, tlda;
   BLACSCONTEXT *ctxt;
/*
 * get context, lowcase char variables, and perform parameter checking
 */
   MGetConTxt(Mpval(ConTxt), ctxt);
   ttop = Mlowcase(*top);
   tscope = Mlowcase(*scope);
#if (BlacsDebugLvl > 0)
   ArgCheck00(Mpval(ConTxt), RT_BS, __FILE__, 'a', 'u', 'u', Mpval(m),
              Mpval(n), Mpval(lda), 0, NULL, NULL);
#endif
   if (Mpval(lda) < Mpval(m)) tlda = Mpval(m);
   else tlda = Mpval(lda);

   zpack00(Mpval(m), Mpval(n), (DCOMPLEX *) A, tlda);

/*
 * Call correct topology for BS/BR
 */
   switch(ttop)
   {
   case ' ':
      error = Stree_bs(ctxt, tscope, 2);
      break;
   case 'h':
      error = Shyp_bs(ctxt, tscope);
      if (error == NPOW2)
         error = Stree_bs(ctxt, tscope, 2);
      break;
   case '1':
   case '2':
   case '3':
   case '4':
   case '5':
   case '6':
   case '7':
   case '8':
   case '9':
      error = Stree_bs(ctxt, tscope, ttop-47);
      break;
   case 't':
      error = Stree_bs(ctxt, tscope, ctxt->Nb_bs);
      break;
   case 'i':
      error = Sidring_bs(ctxt, tscope, 1);
      break;
   case 'd':
      error = Sidring_bs(ctxt, tscope, -1);
      break;
   case 's':
      error = Ssring_bs(ctxt, tscope);
      break;
   case 'f':
      error = Smpath_bs(ctxt, tscope, FULLCON);
      break;
   case 'm':
      error = Smpath_bs(ctxt, tscope, ctxt->Nr_bs);
      break;
   default :
      BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown topology '%c'",*top);
   }

#if (BlacsDebugLvl > 0)
   if (error == BADSCP)
      BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown scope '%c'", *scope);
#endif

}  /* end  zgebs2d_  */
