libflame revision_anchor
Functions
FLA_Misc.c File Reference

(r)

Functions

FLA_Error FLA_Obj_set_to_scalar (FLA_Obj alpha, FLA_Obj A)
void FLA_Obj_extract_real_scalar (FLA_Obj alpha, double *alpha_value)
void FLA_Obj_extract_complex_scalar (FLA_Obj alpha, dcomplex *alpha_value)
void FLA_Obj_extract_real_part (FLA_Obj alpha, FLA_Obj beta)
void FLA_Obj_extract_imag_part (FLA_Obj alpha, FLA_Obj beta)
void FLA_Obj_set_real_part (FLA_Obj alpha, FLA_Obj beta)
void FLA_Obj_set_imag_part (FLA_Obj alpha, FLA_Obj beta)
FLA_Error FLA_Obj_set_diagonal_to_scalar (FLA_Obj alpha, FLA_Obj A)
FLA_Error FLA_Obj_set_to_identity (FLA_Obj A)
FLA_Error FLA_Obj_add_to_diagonal (void *diag_value, FLA_Obj A)
FLA_Error FLA_Obj_shift_diagonal (FLA_Conj conj, FLA_Obj sigma, FLA_Obj A)
FLA_Error FLA_Obj_scale_diagonal (FLA_Conj conj, FLA_Obj alpha, FLA_Obj A)
FLA_Error FLA_Obj_fshow (FILE *file, char *s1, FLA_Obj A, char *format, char *s2)
FLA_Error FLA_Obj_show (char *s1, FLA_Obj A, char *format, char *s2)

Function Documentation

FLA_Error FLA_Obj_add_to_diagonal ( void *  diag_value,
FLA_Obj  A 
)

References FLA_Check_error_level(), FLA_Obj_add_to_diagonal_check(), FLA_Obj_col_stride(), FLA_Obj_datatype(), FLA_Obj_min_dim(), FLA_Obj_row_stride(), dcomplex::imag, scomplex::imag, dcomplex::real, and scomplex::real.

{
  FLA_Datatype datatype;
  dim_t        j, min_m_n;
  dim_t        rs, cs;

  if ( FLA_Check_error_level() >= FLA_MIN_ERROR_CHECKING )
    FLA_Obj_add_to_diagonal_check( diag_value, A );

  datatype = FLA_Obj_datatype( A );
  min_m_n  = FLA_Obj_min_dim( A );
  rs       = FLA_Obj_row_stride( A );
  cs       = FLA_Obj_col_stride( A );

  switch ( datatype ){

  case FLA_FLOAT:
  {
    float *buff_A    = ( float * ) FLA_FLOAT_PTR( A );
    float *value_ptr = ( float * ) diag_value;

    for ( j = 0; j < min_m_n; j++ )
      buff_A[ j*cs + j*rs ] += *value_ptr;

    break;
  }

  case FLA_DOUBLE:
  {
    double *buff_A    = ( double * ) FLA_DOUBLE_PTR( A );
    double *value_ptr = ( double * ) diag_value;

    for ( j = 0; j < min_m_n; j++ )
      buff_A[ j*cs + j*rs ] += *value_ptr;

    break;
  }

  case FLA_COMPLEX:
  {
    scomplex *buff_A    = ( scomplex * ) FLA_COMPLEX_PTR( A );
    scomplex *value_ptr = ( scomplex * ) diag_value;

    for ( j = 0; j < min_m_n; j++ )
    {
      buff_A[ j*cs + j*rs ].real += value_ptr->real;
      buff_A[ j*cs + j*rs ].imag += value_ptr->imag;
    }

    break;
  }

  case FLA_DOUBLE_COMPLEX:
  {
    dcomplex *buff_A    = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
    dcomplex *value_ptr = ( dcomplex * ) diag_value;

    for ( j = 0; j < min_m_n; j++ )
    {
      buff_A[ j*cs + j*rs ].real += value_ptr->real;
      buff_A[ j*cs + j*rs ].imag += value_ptr->imag;
    }

    break;
  }

  }

  return FLA_SUCCESS;
}
void FLA_Obj_extract_complex_scalar ( FLA_Obj  alpha,
dcomplex alpha_value 
)

References FLA_Check_error_level(), FLA_Obj_extract_complex_scalar_check(), FLA_Obj_is_single_precision(), scomplex::imag, dcomplex::imag, scomplex::real, and dcomplex::real.

{
  if ( FLA_Check_error_level() >= FLA_MIN_ERROR_CHECKING )
    FLA_Obj_extract_complex_scalar_check( alpha, alpha_value );

  if ( FLA_Obj_is_single_precision( alpha ) )
  {
    scomplex temp = *FLA_COMPLEX_PTR( alpha );
    alpha_value->real = ( double ) temp.real;
    alpha_value->imag = ( double ) temp.imag;
  }
  else
    *alpha_value = *FLA_DOUBLE_COMPLEX_PTR( alpha );
}
void FLA_Obj_extract_imag_part ( FLA_Obj  alpha,
FLA_Obj  beta 
)

References FLA_Check_error_level(), FLA_Obj_datatype(), FLA_Obj_extract_imag_part_check(), FLA_Obj_is_real(), FLA_Obj_set_to_scalar(), FLA_ZERO, dcomplex::imag, and scomplex::imag.

{
  if ( FLA_Check_error_level() >= FLA_MIN_ERROR_CHECKING )
    FLA_Obj_extract_imag_part_check( alpha, beta );

  if ( FLA_Obj_is_real( alpha ) )
    FLA_Obj_set_to_scalar( FLA_ZERO, beta );
  else // if ( FLA_Obj_is_complex( alpha ) )
  {
    if      ( FLA_Obj_datatype( alpha ) == FLA_COMPLEX )
    {
      scomplex* buff_alpha = FLA_COMPLEX_PTR( alpha );
      float*    buff_beta  = FLA_FLOAT_PTR( beta );

      *buff_beta = buff_alpha->imag;
    }
    else if ( FLA_Obj_datatype( alpha ) == FLA_DOUBLE_COMPLEX )
    {
      dcomplex* buff_alpha = FLA_DOUBLE_COMPLEX_PTR( alpha );
      double*   buff_beta  = FLA_DOUBLE_PTR( beta );

      *buff_beta = buff_alpha->imag;
    }
  }
}
void FLA_Obj_extract_real_part ( FLA_Obj  alpha,
FLA_Obj  beta 
)

References FLA_Check_error_level(), FLA_Copy(), FLA_Obj_datatype(), FLA_Obj_extract_real_part_check(), FLA_Obj_is_real(), dcomplex::real, and scomplex::real.

{
  if ( FLA_Check_error_level() >= FLA_MIN_ERROR_CHECKING )
    FLA_Obj_extract_real_part_check( alpha, beta );

  if ( FLA_Obj_is_real( alpha ) )
    FLA_Copy( alpha, beta );
  else // if ( FLA_Obj_is_complex( alpha ) )
  {
    if      ( FLA_Obj_datatype( alpha ) == FLA_COMPLEX )
    {
      scomplex* buff_alpha = FLA_COMPLEX_PTR( alpha );
      float*    buff_beta  = FLA_FLOAT_PTR( beta );

      *buff_beta = buff_alpha->real;
    }
    else if ( FLA_Obj_datatype( alpha ) == FLA_DOUBLE_COMPLEX )
    {
      dcomplex* buff_alpha = FLA_DOUBLE_COMPLEX_PTR( alpha );
      double*   buff_beta  = FLA_DOUBLE_PTR( beta );

      *buff_beta = buff_alpha->real;
    }
  }
}
void FLA_Obj_extract_real_scalar ( FLA_Obj  alpha,
double *  alpha_value 
)

References FLA_Check_error_level(), FLA_Obj_extract_real_scalar_check(), and FLA_Obj_is_single_precision().

{
  if ( FLA_Check_error_level() >= FLA_MIN_ERROR_CHECKING )
    FLA_Obj_extract_real_scalar_check( alpha, alpha_value );

  if ( FLA_Obj_is_single_precision( alpha ) )
    *alpha_value = ( double ) *FLA_FLOAT_PTR( alpha );
  else
    *alpha_value = *FLA_DOUBLE_PTR( alpha );
}
FLA_Error FLA_Obj_fshow ( FILE *  file,
char *  s1,
FLA_Obj  A,
char *  format,
char *  s2 
)

References FLA_Check_error_level(), FLA_Obj_col_stride(), FLA_Obj_datatype(), FLA_Obj_fshow_check(), FLA_Obj_length(), FLA_Obj_row_stride(), FLA_Obj_width(), scomplex::imag, dcomplex::real, and scomplex::real.

Referenced by FLA_Obj_show().

{
  FLA_Datatype datatype;
  dim_t        i, j, m, n;
  dim_t        rs, cs;

  if ( FLA_Check_error_level() >= FLA_MIN_ERROR_CHECKING )
    FLA_Obj_fshow_check( file, s1, A, format, s2 );

  datatype = FLA_Obj_datatype( A );
  m        = FLA_Obj_length( A );
  n        = FLA_Obj_width( A );
  rs       = FLA_Obj_row_stride( A );
  cs       = FLA_Obj_col_stride( A );

  fprintf( file, "%s\n", s1 );

  switch ( datatype ){

  case FLA_CONSTANT:
  {
    int*      consti = FLA_INT_PTR( A );
    float*    consts = FLA_FLOAT_PTR( A );
    double*   constd = FLA_DOUBLE_PTR( A );
    scomplex* constc = FLA_COMPLEX_PTR( A );
    dcomplex* constz = FLA_DOUBLE_COMPLEX_PTR( A );

    fprintf( file, "int      = %d\n", *consti );
    fprintf( file, "float    = %e\n", *consts );
    fprintf( file, "double   = %e\n", *constd );
    fprintf( file, "scomplex = %e + %e\n", constc->real, constc->imag );
    fprintf( file, "dcomplex = %e + %e\n", constz->real, constc->imag );

    break;
  }

  case FLA_FLOAT:
  {
    float *buffer = ( float * ) FLA_FLOAT_PTR( A );

    for ( i = 0; i < m; i++ )
    {
      for ( j = 0; j < n; j++ )
      {
        fprintf( file, format, buffer[ j*cs + i*rs ] );
        fprintf( file, " " );
      }
      fprintf( file, "\n" );
    }

    break;
  }

  case FLA_DOUBLE:
  {
    double *buffer = ( double * ) FLA_DOUBLE_PTR( A );

    for ( i = 0; i < m; i++ )
    {
      for ( j = 0; j < n; j++ )
      {
        fprintf( file, format, buffer[ j*cs + i*rs ] );
        fprintf( file, " " );
      }
      fprintf( file, "\n" );
    }

    break;
  }

  case FLA_COMPLEX:
  {
    scomplex *buffer = ( scomplex * ) FLA_COMPLEX_PTR( A );

    for ( i = 0; i < m; i++ )
    {
      for ( j = 0; j < n; j++ )
      {
        fprintf( file, format, buffer[ j*cs + i*rs ].real, buffer[ j*cs + i*rs ].imag );
        fprintf( file, " " );
      }
      fprintf( file, "\n" );
    }

    break;
  }

  case FLA_DOUBLE_COMPLEX:
  {
    dcomplex *buffer = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );

    for ( i = 0; i < m; i++ )
    {
      for ( j = 0; j < n; j++ )
      {
        fprintf( file, format, buffer[ j*cs + i*rs ].real, buffer[ j*cs + i*rs ].imag );
        fprintf( file, " " );
      }
      fprintf( file, "\n" );
    }

    break;
  }

  case FLA_INT:
  {
    int *buffer = ( int * ) FLA_INT_PTR( A );

    for ( i = 0; i < m; i++ )
    {
      for ( j = 0; j < n; j++ )
      {
        fprintf( file, format, buffer[ j*cs + i*rs ] );
        fprintf( file, " " );
      }
      fprintf( file, "\n" );
    }

    break;
  }

  }

  fprintf( file, "%s\n", s2 );

  return FLA_SUCCESS;
}
FLA_Error FLA_Obj_scale_diagonal ( FLA_Conj  conj,
FLA_Obj  alpha,
FLA_Obj  A 
)

References bli_cscalediag(), bli_csscalediag(), bli_dscalediag(), bli_sscalediag(), bli_zdscalediag(), bli_zscalediag(), FLA_Check_error_level(), FLA_Obj_col_stride(), FLA_Obj_datatype(), FLA_Obj_length(), FLA_Obj_row_stride(), FLA_Obj_scale_diagonal_check(), FLA_Obj_width(), and FLA_Param_map_flame_to_blis_conj().

Referenced by FLA_UDdate_UT_unb_var1().

{
  FLA_Datatype datatype_A;
  FLA_Datatype datatype_alpha;
  dim_t        m_A, n_A;
  dim_t        rs_A, cs_A;
  char         blis_conj;

  if ( FLA_Check_error_level() >= FLA_MIN_ERROR_CHECKING )
    FLA_Obj_scale_diagonal_check( conj, alpha, A );

  datatype_A     = FLA_Obj_datatype( A );
  datatype_alpha = FLA_Obj_datatype( alpha );
  m_A            = FLA_Obj_length( A );
  n_A            = FLA_Obj_width( A );
  rs_A           = FLA_Obj_row_stride( A );
  cs_A           = FLA_Obj_col_stride( A );
  
  FLA_Param_map_flame_to_blis_conj( conj, &blis_conj );

  switch( datatype_A ){

  case FLA_FLOAT:
  {
    float *buff_A     = ( float * ) FLA_FLOAT_PTR( A );
    float *buff_alpha = ( float * ) FLA_FLOAT_PTR( alpha );

    bli_sscalediag( blis_conj,
                    0,
                    m_A,
                    n_A,
                    buff_alpha,
                    buff_A, rs_A, cs_A );

    break;
  }

  case FLA_DOUBLE:
  {
    double *buff_A     = ( double * ) FLA_DOUBLE_PTR( A );
    double *buff_alpha = ( double * ) FLA_DOUBLE_PTR( alpha );

    bli_dscalediag( blis_conj,
                    0,
                    m_A,
                    n_A,
                    buff_alpha,
                    buff_A, rs_A, cs_A );

    break;
  }

  case FLA_COMPLEX:
  {
    if ( datatype_alpha == FLA_COMPLEX )
    {
      scomplex *buff_A     = ( scomplex * ) FLA_COMPLEX_PTR( A );
      scomplex *buff_alpha = ( scomplex * ) FLA_COMPLEX_PTR( alpha );
  
      bli_cscalediag( blis_conj,
                      0,
                      m_A,
                      n_A,
                      buff_alpha,
                      buff_A, rs_A, cs_A );
    }
    else
    {
      scomplex *buff_A     = ( scomplex * ) FLA_COMPLEX_PTR( A );
      float    *buff_alpha = ( float    * ) FLA_FLOAT_PTR( alpha );
  
      bli_csscalediag( blis_conj,
                       0,
                       m_A,
                       n_A,
                       buff_alpha,
                       buff_A, rs_A, cs_A );
    }

    break;
  }

  case FLA_DOUBLE_COMPLEX:
  {
    if ( datatype_alpha == FLA_DOUBLE_COMPLEX )
    {
      dcomplex *buff_A     = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
      dcomplex *buff_alpha = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( alpha );

      bli_zscalediag( blis_conj,
                      0,
                      m_A,
                      n_A,
                      buff_alpha,
                      buff_A, rs_A, cs_A );
    }
    else
    {
      dcomplex *buff_A     = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
      double   *buff_alpha = ( double   * ) FLA_DOUBLE_PTR( alpha );

      bli_zdscalediag( blis_conj,
                       0,
                       m_A,
                       n_A,
                       buff_alpha,
                       buff_A, rs_A, cs_A );
    }

    break;
  }

  }

  return FLA_SUCCESS;
}
FLA_Error FLA_Obj_set_diagonal_to_scalar ( FLA_Obj  alpha,
FLA_Obj  A 
)

References bli_csetdiag(), bli_dsetdiag(), bli_ssetdiag(), bli_zsetdiag(), FLA_Check_error_level(), FLA_Obj_col_stride(), FLA_Obj_datatype(), FLA_Obj_length(), FLA_Obj_row_stride(), FLA_Obj_set_diagonal_to_scalar_check(), and FLA_Obj_width().

Referenced by FLA_Obj_set_to_identity().

{
  FLA_Datatype datatype;
  int          m_A, n_A;
  int          rs_A, cs_A;

  if ( FLA_Check_error_level() >= FLA_MIN_ERROR_CHECKING )
    FLA_Obj_set_diagonal_to_scalar_check( alpha, A );

  datatype = FLA_Obj_datatype( A );
  m_A      = FLA_Obj_length( A );
  n_A      = FLA_Obj_width( A );
  rs_A     = FLA_Obj_row_stride( A );
  cs_A     = FLA_Obj_col_stride( A );

  switch ( datatype ){

  case FLA_INT:
  {
    int *buff_A     = ( int * ) FLA_INT_PTR( A );
    int *buff_alpha = ( int * ) FLA_INT_PTR( alpha );
    int i;

    for ( i = 0; i < min( m_A, n_A ); i++ )
      buff_A[ i*cs_A + i*rs_A ] = *buff_alpha;

    break;
  }

  case FLA_FLOAT:
  {
    float *buff_A     = ( float * ) FLA_FLOAT_PTR( A );
    float *buff_alpha = ( float * ) FLA_FLOAT_PTR( alpha );

    bli_ssetdiag( 0,
                  m_A,
                  n_A,
                  buff_alpha,
                  buff_A, rs_A, cs_A );

    break;
  }

  case FLA_DOUBLE:
  {
    double *buff_A     = ( double * ) FLA_DOUBLE_PTR( A );
    double *buff_alpha = ( double * ) FLA_DOUBLE_PTR( alpha );

    bli_dsetdiag( 0,
                  m_A,
                  n_A,
                  buff_alpha,
                  buff_A, rs_A, cs_A );

    break;
  }

  case FLA_COMPLEX:
  {
    scomplex *buff_A     = ( scomplex * ) FLA_COMPLEX_PTR( A );
    scomplex *buff_alpha = ( scomplex * ) FLA_COMPLEX_PTR( alpha );

    bli_csetdiag( 0,
                  m_A,
                  n_A,
                  buff_alpha,
                  buff_A, rs_A, cs_A );

    break;
  }

  case FLA_DOUBLE_COMPLEX:
  {
    dcomplex *buff_A     = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
    dcomplex *buff_alpha = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( alpha );

    bli_zsetdiag( 0,
                  m_A,
                  n_A,
                  buff_alpha,
                  buff_A, rs_A, cs_A );

    break;
  }

  }

  return FLA_SUCCESS;
}
void FLA_Obj_set_imag_part ( FLA_Obj  alpha,
FLA_Obj  beta 
)

References FLA_Check_error_level(), FLA_Obj_datatype(), FLA_Obj_is_complex(), FLA_Obj_set_imag_part_check(), dcomplex::imag, and scomplex::imag.

Referenced by FLA_Bidiag_UT_l_realify_unb(), and FLA_Bidiag_UT_u_realify_unb().

{
  if ( FLA_Check_error_level() >= FLA_MIN_ERROR_CHECKING )
    FLA_Obj_set_imag_part_check( alpha, beta );

  if ( FLA_Obj_is_complex( beta ) )
  {
    if      ( FLA_Obj_datatype( beta ) == FLA_COMPLEX )
    {
      float*    buff_alpha = FLA_FLOAT_PTR( alpha );
      scomplex* buff_beta  = FLA_COMPLEX_PTR( beta );

      buff_beta->imag = *buff_alpha;
    }
    else if ( FLA_Obj_datatype( beta ) == FLA_DOUBLE_COMPLEX )
    {
      double*   buff_alpha = FLA_DOUBLE_PTR( alpha );
      dcomplex* buff_beta  = FLA_DOUBLE_COMPLEX_PTR( beta );

      buff_beta->imag = *buff_alpha;
    }
  }
}
void FLA_Obj_set_real_part ( FLA_Obj  alpha,
FLA_Obj  beta 
)

References FLA_Check_error_level(), FLA_Copy(), FLA_Obj_datatype(), FLA_Obj_is_complex(), FLA_Obj_set_real_part_check(), dcomplex::real, and scomplex::real.

{
  if ( FLA_Check_error_level() >= FLA_MIN_ERROR_CHECKING )
    FLA_Obj_set_real_part_check( alpha, beta );

  if ( FLA_Obj_is_complex( beta ) )
  {
    if      ( FLA_Obj_datatype( beta ) == FLA_COMPLEX )
    {
      float*    buff_alpha = FLA_FLOAT_PTR( alpha );
      scomplex* buff_beta  = FLA_COMPLEX_PTR( beta );

      buff_beta->real = *buff_alpha;
    }
    else if ( FLA_Obj_datatype( beta ) == FLA_DOUBLE_COMPLEX )
    {
      double*   buff_alpha = FLA_DOUBLE_PTR( alpha );
      dcomplex* buff_beta  = FLA_DOUBLE_COMPLEX_PTR( beta );

      buff_beta->real = *buff_alpha;
    }
  }
  else
  {
    FLA_Copy( alpha, beta );
  }
}
FLA_Error FLA_Obj_set_to_identity ( FLA_Obj  A)
FLA_Error FLA_Obj_set_to_scalar ( FLA_Obj  alpha,
FLA_Obj  A 
)

References FLA_Check_error_level(), FLA_Obj_col_stride(), FLA_Obj_datatype(), FLA_Obj_length(), FLA_Obj_row_stride(), FLA_Obj_set_to_scalar_check(), and FLA_Obj_width().

Referenced by FLA_Asum_external(), FLA_Bidiag_UT_l_realify_unb(), FLA_Bidiag_UT_u_blk_var4(), FLA_Bidiag_UT_u_blk_var5(), FLA_Bidiag_UT_u_realify_unb(), FLA_Bidiag_UT_u_step_unb_var1(), FLA_Bidiag_UT_u_step_unb_var2(), FLA_Bidiag_UT_u_step_unb_var4(), FLA_Bidiag_UT_u_step_unb_var5(), FLA_Hess_UT_blk_var1(), FLA_Hess_UT_blk_var2(), FLA_Hess_UT_blk_var3(), FLA_Hess_UT_blk_var4(), FLA_Hess_UT_step_unb_var1(), FLA_Hess_UT_step_unb_var2(), FLA_Hess_UT_step_unb_var3(), FLA_Hess_UT_step_unb_var4(), FLA_Hess_UT_step_unb_var5(), FLA_LQ_UT_solve(), FLA_Nrm2_external(), FLA_Obj_create_buffer_task(), FLA_Obj_extract_imag_part(), FLA_Obj_set_to_identity(), FLA_Scal_external(), FLA_Scalc_external(), FLA_Sylv_unb_external(), FLA_Tridiag_UT_l_blk_var3(), FLA_Tridiag_UT_l_realify_unb(), FLA_Tridiag_UT_l_step_unb_var1(), FLA_Tridiag_UT_l_step_unb_var2(), FLA_Tridiag_UT_l_step_unb_var3(), FLA_Tridiag_UT_u_realify_unb(), FLASH_Norm1(), and FLASH_Obj_set_to_scalar().

{
  FLA_Datatype datatype;
  dim_t        m, n;
  dim_t        rs, cs;
  dim_t        i, j;

  if ( FLA_Check_error_level() >= FLA_MIN_ERROR_CHECKING )
    FLA_Obj_set_to_scalar_check( alpha, A );

  datatype = FLA_Obj_datatype( A );
  m        = FLA_Obj_length( A );
  n        = FLA_Obj_width( A );
  rs       = FLA_Obj_row_stride( A );
  cs       = FLA_Obj_col_stride( A );

  switch ( datatype ){

  case FLA_INT:
  {
    int *buff_A     = ( int * ) FLA_INT_PTR( A );
    int *buff_alpha = ( int * ) FLA_INT_PTR( alpha );
 
    for ( j = 0; j < n; j++ )
      for ( i = 0; i < m; i++ )
        buff_A[ j*cs + i*rs ] = *buff_alpha;

    break;
  }

  case FLA_FLOAT:
  {
    float *buff_A     = ( float * ) FLA_FLOAT_PTR( A );
    float *buff_alpha = ( float * ) FLA_FLOAT_PTR( alpha );
 
    for ( j = 0; j < n; j++ )
      for ( i = 0; i < m; i++ )
        buff_A[ j*cs + i*rs ] = *buff_alpha;

    break;
  }

  case FLA_DOUBLE:
  {
    double *buff_A     = ( double * ) FLA_DOUBLE_PTR( A );
    double *buff_alpha = ( double * ) FLA_DOUBLE_PTR( alpha );
 
    for ( j = 0; j < n; j++ )
      for ( i = 0; i < m; i++ )
        buff_A[ j*cs + i*rs ] = *buff_alpha;

    break;
  }

  case FLA_COMPLEX:
  {
    scomplex *buff_A     = ( scomplex * ) FLA_COMPLEX_PTR( A );
    scomplex *buff_alpha = ( scomplex * ) FLA_COMPLEX_PTR( alpha );
 
    for ( j = 0; j < n; j++ )
      for ( i = 0; i < m; i++ )
        buff_A[ j*cs + i*rs ] = *buff_alpha;

    break;
  }

  case FLA_DOUBLE_COMPLEX:
  {
    dcomplex *buff_A     = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
    dcomplex *buff_alpha = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( alpha );
 
    for ( j = 0; j < n; j++ )
      for ( i = 0; i < m; i++ )
        buff_A[ j*cs + i*rs ] = *buff_alpha;

    break;
  }

  }

  return FLA_SUCCESS;
}
FLA_Error FLA_Obj_shift_diagonal ( FLA_Conj  conj,
FLA_Obj  sigma,
FLA_Obj  A 
)

References bli_cshiftdiag(), bli_csshiftdiag(), bli_dshiftdiag(), bli_sshiftdiag(), bli_zdshiftdiag(), bli_zshiftdiag(), FLA_Check_error_level(), FLA_Obj_col_stride(), FLA_Obj_datatype(), FLA_Obj_length(), FLA_Obj_row_stride(), FLA_Obj_shift_diagonal_check(), FLA_Obj_width(), and FLA_Param_map_flame_to_blis_conj().

Referenced by FLA_Lyap_h_unb_var1(), FLA_Lyap_h_unb_var2(), FLA_Lyap_h_unb_var3(), FLA_Lyap_h_unb_var4(), FLA_Lyap_n_unb_var1(), FLA_Lyap_n_unb_var2(), FLA_Lyap_n_unb_var3(), FLA_Lyap_n_unb_var4(), and FLASH_Obj_shift_diagonal().

{
  FLA_Datatype datatype_A;
  FLA_Datatype datatype_sigma;
  dim_t        m_A, n_A;
  dim_t        rs_A, cs_A;
  char         blis_conj;

  if ( FLA_Check_error_level() >= FLA_MIN_ERROR_CHECKING )
    FLA_Obj_shift_diagonal_check( conj, sigma, A );

  datatype_A     = FLA_Obj_datatype( A );
  datatype_sigma = FLA_Obj_datatype( sigma );
  m_A            = FLA_Obj_length( A );
  n_A            = FLA_Obj_width( A );
  rs_A           = FLA_Obj_row_stride( A );
  cs_A           = FLA_Obj_col_stride( A );
  
  FLA_Param_map_flame_to_blis_conj( conj, &blis_conj );

  switch( datatype_A ){

  case FLA_FLOAT:
  {
    float *buff_A     = ( float * ) FLA_FLOAT_PTR( A );
    float *buff_sigma = ( float * ) FLA_FLOAT_PTR( sigma );

    bli_sshiftdiag( blis_conj,
                    0,
                    m_A,
                    n_A,
                    buff_sigma,
                    buff_A, rs_A, cs_A );

    break;
  }

  case FLA_DOUBLE:
  {
    double *buff_A     = ( double * ) FLA_DOUBLE_PTR( A );
    double *buff_sigma = ( double * ) FLA_DOUBLE_PTR( sigma );

    bli_dshiftdiag( blis_conj,
                    0,
                    m_A,
                    n_A,
                    buff_sigma,
                    buff_A, rs_A, cs_A );

    break;
  }

  case FLA_COMPLEX:
  {
    if ( datatype_sigma == FLA_COMPLEX )
    {
      scomplex *buff_A     = ( scomplex * ) FLA_COMPLEX_PTR( A );
      scomplex *buff_sigma = ( scomplex * ) FLA_COMPLEX_PTR( sigma );
  
      bli_cshiftdiag( blis_conj,
                      0,
                      m_A,
                      n_A,
                      buff_sigma,
                      buff_A, rs_A, cs_A );
    }
    else
    {
      scomplex *buff_A     = ( scomplex * ) FLA_COMPLEX_PTR( A );
      float    *buff_sigma = ( float    * ) FLA_FLOAT_PTR( sigma );
  
      bli_csshiftdiag( blis_conj,
                       0,
                       m_A,
                       n_A,
                       buff_sigma,
                       buff_A, rs_A, cs_A );
    }

    break;
  }

  case FLA_DOUBLE_COMPLEX:
  {
    if ( datatype_sigma == FLA_DOUBLE_COMPLEX )
    {
      dcomplex *buff_A     = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
      dcomplex *buff_sigma = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( sigma );

      bli_zshiftdiag( blis_conj,
                      0,
                      m_A,
                      n_A,
                      buff_sigma,
                      buff_A, rs_A, cs_A );
    }
    else
    {
      dcomplex *buff_A     = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
      double   *buff_sigma = ( double   * ) FLA_DOUBLE_PTR( sigma );

      bli_zdshiftdiag( blis_conj,
                       0,
                       m_A,
                       n_A,
                       buff_sigma,
                       buff_A, rs_A, cs_A );
    }

    break;
  }

  }

  return FLA_SUCCESS;
}
FLA_Error FLA_Obj_show ( char *  s1,
FLA_Obj  A,
char *  format,
char *  s2 
)

References FLA_Check_error_level(), FLA_Obj_fshow(), and FLA_Obj_show_check().

Referenced by FLASH_Obj_show().

{
  if ( FLA_Check_error_level() >= FLA_MIN_ERROR_CHECKING )
    FLA_Obj_show_check( s1, A, format, s2 );

  return FLA_Obj_fshow( stdout, s1, A, format, s2 );
}