コード例 #1
0
ファイル: flame_wrapper.c プロジェクト: chueter/phonopy
int phonopy_pinv_libflame(double *matrix,
			  double *eigvals,
			  const int size,
			  const double cutoff)
{
  FLA_Obj A, B, l;
  /* FLA_Obj C; */
  double *inv_eigvals;
  int i;

  inv_eigvals = (double*)malloc(sizeof(double) * size);
  
  FLA_Init();
  FLA_Obj_create_without_buffer(FLA_DOUBLE, size, size, &A);
  FLA_Obj_attach_buffer(matrix, 0, 0, &A);
  
  FLA_Obj_create_without_buffer(FLA_DOUBLE, size, 1, &l);
  FLA_Obj_attach_buffer(eigvals, 0, 0, &l);

  /* Eigensolver */
  FLA_Obj_create_copy_of(FLA_NO_TRANSPOSE, A, &B);
  FLA_Hevd(FLA_EVD_WITH_VECTORS, FLA_LOWER_TRIANGULAR, B, l);

  /* SVD */
  /* FLA_Obj_create(FLA_DOUBLE, size, size, 0, 0, &B); */
  /* use U */
  /* FLA_Svd(FLA_SVD_VECTORS_ALL, FLA_SVD_VECTORS_NONE, A, l, B, C); */
  /* use V */
  /* FLA_Svd(FLA_SVD_VECTORS_NONE, FLA_SVD_VECTORS_ALL, A, l, C, B); */
  
  FLA_Obj_free_without_buffer(&l);
  
  for (i = 0; i < size; i++) {
    if (eigvals[i] < cutoff) {
      inv_eigvals[i] = 0;
    } else {
      inv_eigvals[i] = 1.0 / sqrt(eigvals[i]);
    }
  }
  
  FLA_Obj_create_without_buffer(FLA_DOUBLE, size, 1, &l);
  FLA_Obj_attach_buffer(inv_eigvals, 0, 0, &l);
  
  FLA_Apply_diag_matrix(FLA_RIGHT, FLA_NO_CONJUGATE, l, B);
  FLA_Syrk(FLA_LOWER_TRIANGULAR, FLA_NO_TRANSPOSE, FLA_ONE, B, FLA_ZERO, A);
  FLA_Symmetrize(FLA_LOWER_TRIANGULAR, A);
  
  FLA_Obj_free_without_buffer(&A);
  FLA_Obj_free_without_buffer(&l);
  FLA_Obj_free(&B);

  FLA_Finalize();

  free(inv_eigvals);
  
  return 0;
}
コード例 #2
0
// ============================================================================
void compute_case1( int m, int n, int k, int l, 
         FLA_Obj cb_A, FLA_Obj cb_B, FLA_Obj C, int print_data ) {
  FLA_Obj  slice_A, slice_B;
  int      datatype, h;
  double   * buff_cb_A, * buff_cb_B;

  // Some initializations.
  datatype  = FLA_Obj_datatype( cb_A );
  buff_cb_A = ( double * ) FLA_Obj_buffer_at_view( cb_A );
  buff_cb_B = ( double * ) FLA_Obj_buffer_at_view( cb_B );

  // Prepare temporal slices.
  FLA_Obj_create_without_buffer( datatype, m, k, & slice_A );
  FLA_Obj_create_without_buffer( datatype, n, k, & slice_B );

  // Initialize matrix C for the result.
  MyFLA_Obj_set_to_zero( C );

  // Show data.
  if( print_data == 1 ) {
    FLA_Obj_show( " Ci = [ ", C, "%le", " ];" );
    FLA_Obj_show( " cb_A = [ ", cb_A, "%le", " ];" );
    FLA_Obj_show( " cb_B = [ ", cb_B, "%le", " ];" );
  }

  // Perform computation.
  for( h = 0; h < l; h++ ) {
    FLA_Obj_attach_buffer( buff_cb_A + m * k * h, 1, m, & slice_A );
    FLA_Obj_attach_buffer( buff_cb_B + n * k * h, 1, n, & slice_B );
    FLA_Gemm( FLA_NO_TRANSPOSE, FLA_TRANSPOSE, 
              FLA_ONE, slice_A, slice_B, FLA_ONE, C );
  }
  
  // Remove temporal slices.
  FLA_Obj_free_without_buffer( & slice_A );
  FLA_Obj_free_without_buffer( & slice_B );

  // Show data.
  if( print_data == 1 ) {
    FLA_Obj_show( " Cf = [ ", C, "%le", " ];" );
  }
}
コード例 #3
0
void F77_fla_obj_show( char* prefix, int* m, int* n, void* buffer, int* ldim )
{
    FLA_Error    init_result;
    FLA_Datatype datatype;
    FLA_Obj      A;

    switch( *prefix ) {
    case 'i':
    case 'I':
        datatype = FLA_INT;
        break;
    case 's':
    case 'S':
        datatype = FLA_FLOAT;
        break;
    case 'd':
    case 'D':
        datatype = FLA_DOUBLE;
        break;
    case 'c':
    case 'C':
        datatype = FLA_COMPLEX;
        break;
    case 'z':
    case 'Z':
        datatype = FLA_DOUBLE_COMPLEX;
        break;
    default:
        fprintf(stderr, "Invalid prefix %c, where i,s,d,c,z are allowed.\n", *prefix);
        FLA_Abort();
    }

    FLA_Init_safe( &init_result );

    FLA_Obj_create_without_buffer( datatype, *m, *n, &A );
    FLA_Obj_attach_buffer( buffer, 1, *ldim, &A );
    FLA_Obj_fshow( stdout,
                   "= F77_FLA_OBJ_SHOW =", A, "% 6.4e",
                   "=-=-=-=-=-=-=-=-=-=-\n");
    FLA_Obj_free_without_buffer( &A );

    FLA_Finalize_safe( init_result );
}
コード例 #4
0
ファイル: FLA_Copy_to.c プロジェクト: anaptyxis/libflame
FLA_Error FLA_Copy_object_to_buffer( FLA_Trans trans, dim_t i, dim_t j, FLA_Obj A, dim_t m, dim_t n, void* B_buffer, dim_t rs, dim_t cs )
{
  FLA_Obj  B;
  FLA_Obj  ATL, ATR, 
           ABL, Aij;

  if ( FLA_Check_error_level() >= FLA_MIN_ERROR_CHECKING )
    FLA_Copy_object_to_buffer_check( trans, i, j, A, m, n, B_buffer, rs, cs );

  FLA_Part_2x2( A,  &ATL, &ATR,
                    &ABL, &Aij,     i, j, FLA_TL );

  FLA_Obj_create_without_buffer( FLA_Obj_datatype( A ), m, n, &B );
  FLA_Obj_attach_buffer( B_buffer, rs, cs, &B );

  FLA_Copyt_external( trans, Aij, B );

  FLA_Obj_free_without_buffer( &B );

  return FLA_SUCCESS;
}
コード例 #5
0
ファイル: FLA_Copy_to.c プロジェクト: anaptyxis/libflame
FLA_Error FLA_Copy_buffer_to_object( FLA_Trans trans, dim_t m, dim_t n, void* A_buffer, dim_t rs, dim_t cs, dim_t i, dim_t j, FLA_Obj B )
{
  FLA_Obj  A;
  FLA_Obj  BTL, BTR, 
           BBL, Bij;

  if ( FLA_Check_error_level() >= FLA_MIN_ERROR_CHECKING )
    FLA_Copy_buffer_to_object_check( trans, m, n, A_buffer, rs, cs, i, j, B );

  FLA_Part_2x2( B,  &BTL, &BTR,
                    &BBL, &Bij,     i, j, FLA_TL );

  FLA_Obj_create_without_buffer( FLA_Obj_datatype( B ), m, n, &A );
  FLA_Obj_attach_buffer( A_buffer, rs, cs, &A );

  FLA_Copyt_external( trans, A, Bij );

  FLA_Obj_free_without_buffer( &A );

  return FLA_SUCCESS;
}
コード例 #6
0
ファイル: FLASH_Axpy_other.c プロジェクト: pgawron/tlash
FLA_Error FLASH_Axpy_hier_to_buffer( FLA_Obj alpha, dim_t i, dim_t j, FLA_Obj H, dim_t m, dim_t n, void* buffer, dim_t rs, dim_t cs )
{
	FLA_Obj      flat_matrix;
	FLA_Datatype datatype;
	FLA_Error    e_val;

	if ( FLA_Check_error_level() >= FLA_MIN_ERROR_CHECKING )
	{
		e_val = FLA_Check_if_scalar( alpha );
		FLA_Check_error_code( e_val );

		e_val = FLA_Check_consistent_object_datatype( alpha, H );
		FLA_Check_error_code( e_val );

		e_val = FLA_Check_matrix_strides( m, n, rs, cs );
		FLA_Check_error_code( e_val );

		e_val = FLA_Check_submatrix_dims_and_offset( m, n, i, j, H );
		FLA_Check_error_code( e_val );
	}

	// Acquire the datatype from the hierarchical matrix object.
	datatype = FLASH_Obj_datatype( H );

	// Create a temporary conventional matrix object of the requested datatype
	// and dimensions and attach the given buffer containing the incoming data.
	FLA_Obj_create_without_buffer( datatype, m, n, &flat_matrix );
	FLA_Obj_attach_buffer( buffer, rs, cs, &flat_matrix );

	// Recurse through H, adding in the corresponding elements of flat_matrix,
	// starting at the (i,j) element offset.
	FLASH_Axpy_hier_to_flat( alpha, i, j, H, flat_matrix );

	// Free the object (but don't free the buffer!).
	FLA_Obj_free_without_buffer( &flat_matrix );

	return FLA_SUCCESS;
}
コード例 #7
0
ファイル: tensor_psym.c プロジェクト: pgawron/tlash
int main(int argc, char* argv[]){
	dim_t order;
	TLA_sym sym;
	dim_t n[FLA_MAX_ORDER];
	dim_t b[FLA_MAX_ORDER];
	dim_t permutation[FLA_MAX_ORDER];
	FLA_Obj T;

	FLA_Init();


	//Parse inputs
	if(parse_input(argc, argv, &order, &sym, n, b, permutation) == FLA_FAILURE){
	    Usage();
	    FLA_Finalize();
	    return 0;
	}

	//Error check
	if(check_errors(order, sym, n, b, permutation) == FLA_FAILURE){
		Usage();
	    FLA_Finalize();
	    return 0;
	}

	//Perform test

	create_psym_tensor(order, sym, n, b, &T);
	FLA_Obj_print_matlab("T", T);
	
	test_permute_tensor(permutation, T);

    FLA_Obj_blocked_psym_tensor_free_buffer(&T);
    FLA_Obj_free_without_buffer(&T);

    FLA_Finalize();
	return 0;
}
コード例 #8
0
// ============================================================================
void compute_case4b( int size_a, int size_b, int size_c, int size_d,
                     int size_i, int size_j, FLA_Obj cb_A, FLA_Obj cb_B, FLA_Obj cb_C,
                     int print_data ) {
    FLA_Obj  slice_C;
    int      datatype, size_ab, size_abc, size_ia, size_iaj, size_jc, size_jci,
             iter_a, iter_b, iter_c, iter_d, iter_i, iter_j, ldim_slice_C;
    size_t   idx_A, idx_B, idx_C;
    double   * buff_cb_A, * buff_cb_B, * buff_cb_C, * buff_slice_C, d_one = 1.0;

    // Some initializations.
    datatype  = FLA_Obj_datatype( cb_A );
    buff_cb_A = ( double * ) FLA_Obj_buffer_at_view( cb_A );
    buff_cb_B = ( double * ) FLA_Obj_buffer_at_view( cb_B );
    buff_cb_C = ( double * ) FLA_Obj_buffer_at_view( cb_C );

    size_ab  = size_a * size_b;
    size_abc = size_a * size_b * size_c;

    size_ia  = size_i * size_a;
    size_iaj = size_i * size_a * size_j;

    size_jc  = size_j * size_c;
    size_jci = size_j * size_c * size_i;

    // Show data.
    if( print_data == 1 ) {
        FLA_Obj_show( " cb_A_i = [ ", cb_A, "%le", " ];" );
        FLA_Obj_show( " cb_B_i = [ ", cb_B, "%le", " ];" );
        FLA_Obj_show( " cb_C_i = [ ", cb_C, "%le", " ];" );
    }

    // Prepare temporal slices without buffer.
    FLA_Obj_create_without_buffer( datatype, size_a, size_c, & slice_C );
#if 0
    FLA_Obj_create_without_buffer( datatype, size_a, 1, & slice_A );
    FLA_Obj_create_without_buffer( datatype, size_c, 1, & slice_B );
#endif

    // Perform computation.
    for( iter_b = 0; iter_b < size_b; iter_b++ ) {

        for( iter_d = 0; iter_d < size_d; iter_d++ ) {

            // Define slice_C.
            iter_a = 0;
            iter_c = 0;
            idx_C = ( ( size_t ) iter_a ) +
                    ( ( size_t ) iter_b * size_a ) +
                    ( ( size_t ) iter_c * size_ab ) +
                    ( ( size_t ) iter_d * size_abc );
            FLA_Obj_attach_buffer( & buff_cb_C[ idx_C ], 1, size_ab, & slice_C );
            buff_slice_C = ( double * ) FLA_Obj_buffer_at_view( slice_C );
            ldim_slice_C = FLA_Obj_col_stride( slice_C );

            // Initialize slice_C.
            MyFLA_Obj_set_to_zero( slice_C );

            for( iter_i = 0; iter_i < size_i; iter_i++ ) {

                for( iter_j = 0; iter_j < size_j; iter_j++ ) {
#if 0
                    // Define slice_A.
                    FLA_Obj_attach_buffer(
                        & buff_cb_A[ iter_i + 0 * size_i + iter_j * size_ia +
                                     iter_b * size_iaj ],
                        size_i, 1, & slice_A );

                    // Define slice_B.
                    FLA_Obj_attach_buffer(
                        & buff_cb_B[ iter_j + 0 * size_j + iter_i * size_jc +
                                     iter_d * size_jci ],
                        size_j, 1, & slice_B );

                    // Compute DGER operation.
                    FLA_Ger( FLA_ONE, slice_A, slice_B, slice_C );
#endif
                    idx_A = ( ( size_t ) iter_i ) +
                            ( ( size_t ) 0 * size_i ) +
                            ( ( size_t ) iter_j * size_ia ) +
                            ( ( size_t ) iter_b * size_iaj );
                    idx_B = ( ( size_t ) iter_j ) +
                            ( ( size_t ) 0 * size_j ) +
                            ( ( size_t ) iter_i * size_jc ) +
                            ( ( size_t ) iter_d * size_jci );

                    dger_( & size_a, & size_c,
                           & d_one,
                           & buff_cb_A[ idx_A ], & size_i,
                           & buff_cb_B[ idx_B ], & size_j,
                           buff_slice_C, & ldim_slice_C );
                }
            }

        }
    }

    // Show data.
    if( print_data == 1 ) {
        FLA_Obj_show( " cb_A_f = [ ", cb_A, "%le", " ];" );
        FLA_Obj_show( " cb_B_f = [ ", cb_B, "%le", " ];" );
        FLA_Obj_show( " cb_C_f = [ ", cb_C, "%le", " ];" );
    }

    // Remove temporal slices.
    FLA_Obj_free_without_buffer( & slice_C );
#if 0
    FLA_Obj_free_without_buffer( & slice_A );
    FLA_Obj_free_without_buffer( & slice_B );
#endif
}
コード例 #9
0
// ============================================================================
void compute_case2b( int size_a, int size_b, int size_c, int size_d,
         int size_i, int size_j, FLA_Obj cb_A, FLA_Obj cb_B, FLA_Obj cb_C, 
         int print_data ) {
  FLA_Obj  slice_A, slice_B, slice_C;
  int      datatype, size_ab, size_abc, size_ia, size_iaj, size_jc, size_jci,
           iter_a, iter_b, iter_c, iter_d, iter_i, iter_j, 
           ii, jj, ldim_slice_B;
  size_t   idx_A, idx_B, idx_C;
  double   * buff_cb_A, * buff_cb_B, * buff_cb_C, * buff_slice_B;

  // Some initializations.
  datatype  = FLA_Obj_datatype( cb_A );
  buff_cb_A = ( double * ) FLA_Obj_buffer_at_view( cb_A );
  buff_cb_B = ( double * ) FLA_Obj_buffer_at_view( cb_B );
  buff_cb_C = ( double * ) FLA_Obj_buffer_at_view( cb_C );
  
  size_ab  = size_a * size_b;
  size_abc = size_a * size_b * size_c;

  size_ia  = size_i * size_a;
  size_iaj = size_i * size_a * size_j;

  size_jc  = size_j * size_c;
  size_jci = size_j * size_c * size_i;

  // Show data.
  if( print_data == 1 ) {
    FLA_Obj_show( " cb_A_i = [ ", cb_A, "%le", " ];" );
    FLA_Obj_show( " cb_B_i = [ ", cb_B, "%le", " ];" );
    FLA_Obj_show( " cb_C_i = [ ", cb_C, "%le", " ];" );
  }

  // Prepare temporal slices without buffer.
  FLA_Obj_create_without_buffer( datatype, size_i, size_a, & slice_A );
  FLA_Obj_create( datatype, size_i, size_d, 0, 0, & slice_B );
  FLA_Obj_create_without_buffer( datatype, size_a, size_d, & slice_C );

  // Perform computation.
  for( iter_b = 0; iter_b < size_b; iter_b++ ) {
   
    for( iter_c = 0; iter_c < size_c; iter_c++ ) {

      iter_a = 0;
      iter_d = 0;
      iter_i = 0;

      idx_C = ( ( size_t ) iter_a ) +
              ( ( size_t ) iter_b * size_a ) +
              ( ( size_t ) iter_c * size_ab ) +
              ( ( size_t ) iter_d * size_abc ),
      FLA_Obj_attach_buffer( & buff_cb_C[ idx_C ], 1, size_abc, & slice_C );
      MyFLA_Obj_set_to_zero( slice_C );
 
      for( iter_j = 0; iter_j < size_j; iter_j++ ) {

        // Define Ai.
        idx_A = ( ( size_t ) iter_i ) +
                ( ( size_t ) iter_a * size_i ) +
                ( ( size_t ) iter_j * size_ia ) +
                ( ( size_t ) iter_b * size_iaj );
        FLA_Obj_attach_buffer( & buff_cb_A[ idx_A ], 1, size_i, & slice_A );

        // Define Bi.
        buff_slice_B = ( double * ) FLA_Obj_buffer_at_view( slice_B );
        ldim_slice_B = FLA_Obj_col_stride( slice_B );
        for( jj = 0; jj < size_d; jj++ ) {
          for( ii = 0; ii < size_i; ii++ ) {
            idx_B = ( ( size_t ) iter_j ) +
                    ( ( size_t ) iter_c * size_j ) + 
                    ( ( size_t ) ii * size_jc ) +
                    ( ( size_t ) jj * size_jci );
            buff_slice_B[ ii + jj * ldim_slice_B ] = buff_cb_B[ idx_B ];
          }
        }

        // Compute Ai' * Bi.
        FLA_Gemm( FLA_TRANSPOSE, FLA_NO_TRANSPOSE, 
                  FLA_ONE, slice_A, slice_B, FLA_ONE, slice_C );
      }
    }
  }

  // Show data.
  if( print_data == 1 ) {
    FLA_Obj_show( " cb_A_f = [ ", cb_A, "%le", " ];" );
    FLA_Obj_show( " cb_B_f = [ ", cb_B, "%le", " ];" );
    FLA_Obj_show( " cb_C_f = [ ", cb_C, "%le", " ];" );
  }

  // Remove temporal slices.
  FLA_Obj_free_without_buffer( & slice_A );
  FLA_Obj_free( & slice_B );
  FLA_Obj_free_without_buffer( & slice_C );
}