FLA_Misc.c File Reference

(r)

Functions
FLA_Error	FLA_Obj_copy_view (FLA_Obj A, FLA_Obj *B)
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 B)
void	FLA_Obj_set_imag_part (FLA_Obj alpha, FLA_Obj B)
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_copy_view	(	FLA_Obj	A,
		FLA_Obj *	B
	)

References FLA_Check_error_level(), FLA_Obj_copy_view_check(), FLASH_Obj_scalar_length(), FLASH_Obj_scalar_width(), FLA_Obj_view::m_inner, and FLA_Obj_view::n_inner.

{
  FLA_Obj  A_view;

  if ( FLA_Check_error_level() >= FLA_MIN_ERROR_CHECKING )
    FLA_Obj_copy_view_check( A, B );

  // Set the m_inner and n_inner fields of a temporary copy of A.
  A_view         = A;
  A_view.m_inner = FLASH_Obj_scalar_length( A );
  A_view.n_inner = FLASH_Obj_scalar_width( A ); 

  // Copy the modified view into B. 
  *B = A_view; 

  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_Set(), FLA_ZERO, scomplex::imag, and dcomplex::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_Set( 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(), scomplex::real, and dcomplex::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, scomplex::real, and dcomplex::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, format, buffer[ j*cs + i*rs ].real );
        fprintf( file, " + " );
        fprintf( file, format, 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, format, buffer[ j*cs + i*rs ].real );
        fprintf( file, " + " );
        fprintf( file, format, 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;
}

void FLA_Obj_set_imag_part	(	FLA_Obj	alpha,
		FLA_Obj	B
	)

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

Referenced by FLA_Bidiag_UT_l_realify_unb(), and FLA_Bidiag_UT_u_realify_unb().

{
  dim_t m_B;
  dim_t n_B;
  dim_t rs_B;
  dim_t cs_B;
  dim_t i, j;

  m_B  = FLA_Obj_length( B );
  n_B  = FLA_Obj_width( B );
  rs_B = FLA_Obj_row_stride( B );
  cs_B = FLA_Obj_col_stride( B );

  if ( FLA_Check_error_level() >= FLA_MIN_ERROR_CHECKING )
    FLA_Obj_set_imag_part_check( alpha, B );

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

      for ( j = 0; j < n_B; ++j )
      {
        for ( i = 0; i < m_B; ++i )
        {
          scomplex* beta11 = buff_B + rs_B * i + cs_B * j;

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

      for ( j = 0; j < n_B; ++j )
      {
        for ( i = 0; i < m_B; ++i )
        {
          dcomplex* beta11 = buff_B + rs_B * i + cs_B * j;

          beta11->imag = *buff_alpha;
        }
      }
    }
  }
}

void FLA_Obj_set_real_part	(	FLA_Obj	alpha,
		FLA_Obj	B
	)

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

{
  dim_t m_B;
  dim_t n_B;
  dim_t rs_B;
  dim_t cs_B;
  dim_t i, j;

  m_B  = FLA_Obj_length( B );
  n_B  = FLA_Obj_width( B );
  rs_B = FLA_Obj_row_stride( B );
  cs_B = FLA_Obj_col_stride( B );

  if ( FLA_Check_error_level() >= FLA_MIN_ERROR_CHECKING )
    FLA_Obj_set_real_part_check( alpha, B );

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

      for ( j = 0; j < n_B; ++j )
      {
        for ( i = 0; i < m_B; ++i )
        {
          scomplex* beta11 = buff_B + rs_B * i + cs_B * j;

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

      for ( j = 0; j < n_B; ++j )
      {
        for ( i = 0; i < m_B; ++i )
        {
          dcomplex* beta11 = buff_B + rs_B * i + cs_B * j;

          beta11->real = *buff_alpha;
        }
      }
    }
  }
}

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 );
}