C++ FLA_Obj_datatype函数代码示例

FLA_Error FLA_Check_identical_object_datatype( FLA_Obj A, FLA_Obj B )
{
  FLA_Error e_val = FLA_SUCCESS;

  if ( FLA_Obj_datatype( A ) != FLA_Obj_datatype( B ) )
    e_val = FLA_OBJECT_DATATYPES_NOT_EQUAL;

  return e_val;
}

FLA_Error FLA_Check_consistent_datatype( FLA_Datatype datatype, FLA_Obj A )
{
  FLA_Error e_val = FLA_SUCCESS;

  if ( FLA_Obj_datatype( A ) != FLA_CONSTANT &&
                    datatype != FLA_CONSTANT )
    if ( FLA_Obj_datatype( A ) != datatype )
      e_val = FLA_INCONSISTENT_DATATYPES;

  return e_val;
}

FLA_Error FLA_Check_consistent_object_datatype( FLA_Obj A, FLA_Obj B )
{
  FLA_Error e_val = FLA_SUCCESS;

  if ( FLA_Obj_datatype( A ) != FLA_CONSTANT &&
       FLA_Obj_datatype( B ) != FLA_CONSTANT )
    if ( FLA_Obj_datatype( A ) != FLA_Obj_datatype( B ) )
      e_val = FLA_INCONSISTENT_DATATYPES;

  return e_val;
}

FLA_Error REF_Syrk_ln( FLA_Obj A, FLA_Obj C )
{
  FLA_Datatype datatype;
  int          k, m, ldim_A, ldim_C;

  datatype = FLA_Obj_datatype( A );
  ldim_A   = FLA_Obj_ldim( A );
  ldim_C   = FLA_Obj_ldim( C );
  k        = FLA_Obj_width( A );
  m        = FLA_Obj_length( A );
  
  switch( datatype ){
    case FLA_DOUBLE:
    {
      double *buff_A, *buff_C, d_one=1.0;

      buff_A = ( double * ) FLA_Obj_buffer_at_view( A );
      buff_C = ( double * ) FLA_Obj_buffer_at_view( C );
    
      dsyrk_( "L", "N", &m, &k,
              &d_one, buff_A, &ldim_A, &d_one, buff_C, &ldim_C );
    } break;
  }
  
  return 0;
}

FLA_Error REF_Gemm_nn( FLA_Obj A, FLA_Obj B, FLA_Obj C )
{
  FLA_Datatype datatype;
  int          m, k, n, ldim_A, ldim_B, ldim_C;

  datatype = FLA_Obj_datatype( A );
  ldim_A   = FLA_Obj_ldim( A );
  ldim_B   = FLA_Obj_ldim( B );
  ldim_C   = FLA_Obj_ldim( C );
  m        = FLA_Obj_length( A );
  k        = FLA_Obj_width( A );
  n        = FLA_Obj_width( B );
  
  switch( datatype ){
    case FLA_DOUBLE:
    {
      double *buff_A, *buff_B, *buff_C, d_one=1.0;

      buff_A = ( double * ) FLA_Obj_buffer_at_view( A );
      buff_B = ( double * ) FLA_Obj_buffer_at_view( B );
      buff_C = ( double * ) FLA_Obj_buffer_at_view( C );
    
      FLA_C2F( dgemm )( "N", "N", &m, &n, &k,
                        &d_one, buff_A, &ldim_A, buff_B, &ldim_B,
                        &d_one, buff_C, &ldim_C );
    } break;
  }
  
  return 0;
}

FLA_Error FLA_Chol_u_opt_var3( FLA_Obj A )
{
  FLA_Error    r_val = FLA_SUCCESS;
  FLA_Datatype datatype;
  int          mn_A;
  int          rs_A, cs_A;

  datatype = FLA_Obj_datatype( A );

  mn_A     = FLA_Obj_length( A );
  rs_A     = FLA_Obj_row_stride( A );
  cs_A     = FLA_Obj_col_stride( A );
  

  switch ( datatype )
  {
    case FLA_FLOAT:
    {
      float* buff_A = FLA_FLOAT_PTR( A );

      r_val = FLA_Chol_u_ops_var3( mn_A,
                                   buff_A, rs_A, cs_A );

      break;
    }

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

      r_val = FLA_Chol_u_opd_var3( mn_A,
                                   buff_A, rs_A, cs_A );

      break;
    }

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

      r_val = FLA_Chol_u_opc_var3( mn_A,
                                   buff_A, rs_A, cs_A );

      break;
    }

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

      r_val = FLA_Chol_u_opz_var3( mn_A,
                                   buff_A, rs_A, cs_A );

      break;
    }
  }

  return r_val;
}

FLA_Error FLA_Tevd_eigval_v_opt_var1( FLA_Obj G, FLA_Obj d, FLA_Obj e, FLA_Obj k )
{
	FLA_Datatype datatype;
	int          m_A, n_G;
	int          rs_G, cs_G;
	int          inc_d;
	int          inc_e;

	datatype = FLA_Obj_datatype( d );

	m_A      = FLA_Obj_vector_dim( d );
	n_G      = FLA_Obj_width( G );

	rs_G     = FLA_Obj_row_stride( G );
	cs_G     = FLA_Obj_col_stride( G );

	inc_d    = FLA_Obj_vector_inc( d );
	inc_e    = FLA_Obj_vector_inc( e );
	

	switch ( datatype )
	{
		case FLA_FLOAT:
		{
			scomplex* buff_G = FLA_COMPLEX_PTR( G );
			float*    buff_d = FLA_FLOAT_PTR( d );
			float*    buff_e = FLA_FLOAT_PTR( e );
			int*      buff_k = FLA_INT_PTR( k );

			FLA_Tevd_eigval_v_ops_var1( m_A,
			                            n_G,
			                            buff_G, rs_G, cs_G,
			                            buff_d, inc_d,
			                            buff_e, inc_e,
			                            buff_k );

			break;
		}

		case FLA_DOUBLE:
		{
			dcomplex* buff_G = FLA_DOUBLE_COMPLEX_PTR( G );
			double*   buff_d = FLA_DOUBLE_PTR( d );
			double*   buff_e = FLA_DOUBLE_PTR( e );
			int*      buff_k = FLA_INT_PTR( k );

			FLA_Tevd_eigval_v_opd_var1( m_A,
			                            n_G,
			                            buff_G, rs_G, cs_G,
			                            buff_d, inc_d,
			                            buff_e, inc_e,
			                            buff_k );

			break;
		}
	}

	return FLA_SUCCESS;
}

FLA_Error FLA_Norm_inf( FLA_Obj A, FLA_Obj norm )
{
  FLA_Obj AT,              A0,
          AB,              a1t,
                           A2;

  FLA_Obj bT,              b0,
          bB,              beta1,
                           b2;
  FLA_Obj b;

  if ( FLA_Check_error_level() >= FLA_MIN_ERROR_CHECKING )
    FLA_Norm_inf_check( A, norm );

  FLA_Obj_create( FLA_Obj_datatype( A ), FLA_Obj_length( A ), 1, 0, 0, &b );

  FLA_Part_2x1( A,    &AT, 
                      &AB,            0, FLA_TOP );

  FLA_Part_2x1( b,    &bT, 
                      &bB,            0, FLA_TOP );

  while ( FLA_Obj_length( AT ) < FLA_Obj_length( A ) ){

    FLA_Repart_2x1_to_3x1( AT,                &A0, 
                        /* ** */            /* *** */
                                              &a1t, 
                           AB,                &A2,        1, FLA_BOTTOM );

    FLA_Repart_2x1_to_3x1( bT,                &b0, 
                        /* ** */            /* ***** */
                                              &beta1, 
                           bB,                &b2,        1, FLA_BOTTOM );

    /*------------------------------------------------------------*/

    FLA_Asum( a1t, beta1 );

    /*------------------------------------------------------------*/

    FLA_Cont_with_3x1_to_2x1( &AT,                A0, 
                                                  a1t, 
                            /* ** */           /* *** */
                              &AB,                A2,     FLA_TOP );

    FLA_Cont_with_3x1_to_2x1( &bT,                b0, 
                                                  beta1, 
                            /* ** */           /* ***** */
                              &bB,                b2,     FLA_TOP );

  }

  FLA_Max_abs_value( b, norm );

  FLA_Obj_free( &b );

  return FLA_SUCCESS;
}

FLA_Error FLA_Obj_create_conf_to( FLA_Trans trans, FLA_Obj obj_cur, FLA_Obj *obj_new )
{
  FLA_Datatype datatype;
  FLA_Elemtype elemtype;
  dim_t        m, n;
  dim_t        rs, cs;

  if ( FLA_Check_error_level() >= FLA_MIN_ERROR_CHECKING )
    FLA_Obj_create_conf_to_check( trans, obj_cur, obj_new );

  datatype = FLA_Obj_datatype( obj_cur );
  elemtype = FLA_Obj_elemtype( obj_cur );

  // Query the dimensions of the existing object.
  if ( trans == FLA_NO_TRANSPOSE || trans == FLA_CONJ_NO_TRANSPOSE )
  {
    m = FLA_Obj_length( obj_cur );
    n = FLA_Obj_width( obj_cur );
  }
  else // if ( trans == FLA_TRANSPOSE || trans == FLA_CONJ_TRANSPOSE )
  {
    m = FLA_Obj_width( obj_cur );
    n = FLA_Obj_length( obj_cur );
  }

  // Query the row and column strides of the existing object. We don't care
  // about the actual leading dimension of the existing object, only whether
  // it is in row- or column-major format.
  rs = FLA_Obj_row_stride( obj_cur );
  cs = FLA_Obj_col_stride( obj_cur );

  if ( ( rs == 1 && cs == 1 ) )
  {
    // Do nothing. This special case will be handled by FLA_adjust_strides().
    ;
  }
  else if ( rs == 1 )
  {
    // For column-major storage, use the m dimension as the column stride.
    // Row stride is already set to 1.
    cs = m;
  }
  else if ( cs == 1 )
  {
    // For row-major storage, use the n dimension as the row stride.
    // Column stride is already set to 1.
    rs = n;
  }

  // Handle empty views.
  if ( m == 0 ) cs = 1;
  if ( n == 0 ) rs = 1;

  FLA_Obj_create_ext( datatype, elemtype, m, n, m, n, rs, cs, obj_new );

  return FLA_SUCCESS;
}

FLA_Error FLA_Absolute_value( FLA_Obj alpha )
{
  FLA_Datatype datatype;

  if ( FLA_Check_error_level() >= FLA_MIN_ERROR_CHECKING )
    FLA_Absolute_value_check( alpha );

  datatype = FLA_Obj_datatype( alpha );
  
  switch ( datatype ){

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

    *buff_alpha = ( float ) fabs( ( double ) *buff_alpha );

    break;
  }

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

    *buff_alpha = fabs( *buff_alpha );

    break;
  }

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

    buff_alpha->real = ( float ) sqrt( ( double ) buff_alpha->real * buff_alpha->real + 
                                                  buff_alpha->imag * buff_alpha->imag );
    buff_alpha->imag = 0.0F; 


    break;
  }

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

    buff_alpha->real = sqrt( buff_alpha->real * buff_alpha->real + 
                             buff_alpha->imag * buff_alpha->imag );
    buff_alpha->imag = 0.0; 

    break;
  }

  }

  return FLA_SUCCESS;
}

FLA_Error FLA_Check_valid_object_datatype( FLA_Obj A )
{
  FLA_Error    e_val;
  FLA_Datatype datatype;

  datatype = FLA_Obj_datatype( A );

  e_val = FLA_Check_valid_datatype( datatype );

  return e_val;
}

FLA_Error FLA_Check_complex_object( FLA_Obj A )
{
  FLA_Error    e_val = FLA_SUCCESS;
  FLA_Datatype datatype;

  datatype = FLA_Obj_datatype( A );

  if ( FLA_Check_complex_datatype( datatype ) != FLA_SUCCESS )
    e_val = FLA_OBJECT_NOT_COMPLEX;

  return e_val;
}

FLA_Error FLA_Check_real_object( FLA_Obj A )
{
  FLA_Error    e_val = FLA_SUCCESS;
  FLA_Datatype datatype;

  datatype = FLA_Obj_datatype( A );

  if ( FLA_Check_real_datatype( datatype ) != FLA_SUCCESS )
    e_val = FLA_OBJECT_NOT_REAL;

  return e_val;
}

FLA_Error FLA_Check_int_object( FLA_Obj A )
{
  FLA_Error    e_val = FLA_SUCCESS;
  FLA_Datatype datatype;

  datatype = FLA_Obj_datatype( A );

  if ( FLA_Check_int_datatype( datatype ) != FLA_SUCCESS )
    e_val = FLA_OBJECT_NOT_INTEGER;

  return e_val;
}

FLA_Error FLA_Check_floating_object( FLA_Obj A )
{
  FLA_Error    e_val = FLA_SUCCESS;
  FLA_Datatype datatype;

  datatype = FLA_Obj_datatype( A );

  if ( FLA_Check_floating_datatype( datatype ) != FLA_SUCCESS )
    e_val = FLA_OBJECT_NOT_FLOATING_POINT;

  return e_val;
}