libflame  revision_anchor
Functions
FLA_Hevd.h File Reference

(r)

Go to the source code of this file.

Functions

FLA_Error FLA_Hevd_compute_scaling (FLA_Uplo uplo, FLA_Obj A, FLA_Obj sigma)
FLA_Error FLA_Hevd (FLA_Evd_type jobz, FLA_Uplo uplo, FLA_Obj A, FLA_Obj l)

Function Documentation

FLA_Error FLA_Hevd ( FLA_Evd_type  jobz,
FLA_Uplo  uplo,
FLA_Obj  A,
FLA_Obj  l 
)

References FLA_Check_error_level(), FLA_Hevd_check(), and FLA_Hevd_lv_unb_var1().

{
  FLA_Error r_val      = FLA_SUCCESS;
  dim_t     n_iter_max = 30;
  dim_t     k_accum    = 32;
  dim_t     b_alg      = 512;

  // Check parameters.
  if ( FLA_Check_error_level() >= FLA_MIN_ERROR_CHECKING )
    FLA_Hevd_check( jobz, uplo, A, l );

  // Invoke FLA_Hevd_external() for now.
  if ( jobz == FLA_EVD_WITH_VECTORS )
  {
    if ( uplo == FLA_LOWER_TRIANGULAR )
    {
      r_val = FLA_Hevd_lv_unb_var1( n_iter_max, A, l, k_accum, b_alg );
    }
    else // if ( uplo == FLA_UPPER_TRIANGULAR )
    {
      FLA_Check_error_code( FLA_NOT_YET_IMPLEMENTED );
    }
  }
  else // if ( jobz == FLA_EVD_WITHOUT_VECTORS )
  {
    if ( uplo == FLA_LOWER_TRIANGULAR )
    {
      FLA_Check_error_code( FLA_NOT_YET_IMPLEMENTED );
    }
    else // if ( uplo == FLA_UPPER_TRIANGULAR )
    {
      FLA_Check_error_code( FLA_NOT_YET_IMPLEMENTED );
    }
  }

  return r_val;
}

References FLA_Check_error_level(), FLA_Copy(), FLA_Hevd_compute_scaling_check(), FLA_Inv_scal(), FLA_Invert(), FLA_Mach_params(), FLA_Max_abs_value_herm(), FLA_Obj_create(), FLA_Obj_datatype_proj_to_real(), FLA_Obj_free(), FLA_Obj_gt(), FLA_Obj_lt(), FLA_ONE, FLA_Sqrt(), and FLA_ZERO.

Referenced by FLA_Hevd_lv_unb_var1(), and FLA_Hevd_lv_unb_var2().

{
    FLA_Datatype dt_real;
    FLA_Obj      norm;
    FLA_Obj      safmin;
    FLA_Obj      prec;
    FLA_Obj      rmin;
    FLA_Obj      rmax;

    if ( FLA_Check_error_level() >= FLA_MIN_ERROR_CHECKING )
        FLA_Hevd_compute_scaling_check( uplo, A, sigma );

    dt_real = FLA_Obj_datatype_proj_to_real( A );

    FLA_Obj_create( dt_real, 1, 1, 0, 0, &norm );
    FLA_Obj_create( dt_real, 1, 1, 0, 0, &safmin );
    FLA_Obj_create( dt_real, 1, 1, 0, 0, &prec );
    FLA_Obj_create( dt_real, 1, 1, 0, 0, &rmin );
    FLA_Obj_create( dt_real, 1, 1, 0, 0, &rmax );

    // Query safmin, precision.
    FLA_Mach_params( FLA_MACH_SFMIN, safmin );
    FLA_Mach_params( FLA_MACH_PREC,  prec );

//FLA_Obj_show( "safmin", safmin, "%20.12e", "" );
//FLA_Obj_show( "prec", prec, "%20.12e", "" );

    // rmin = sqrt( safmin / prec );
    FLA_Copy( safmin, rmin );
    FLA_Inv_scal( prec, rmin );
    FLA_Copy( rmin, rmax );
    FLA_Sqrt( rmin );

    // rmax = sqrt( 1 / ( safmin / prec ) );
    FLA_Invert( FLA_NO_CONJUGATE, rmax );
    FLA_Sqrt( rmax );

//FLA_Obj_show( "rmin", rmin, "%20.12e", "" );
//FLA_Obj_show( "rmax", rmax, "%20.12e", "" );

    // Find the maximum absolute value of A.
    FLA_Max_abs_value_herm( uplo, A, norm );

    if ( FLA_Obj_gt( norm, FLA_ZERO ) && FLA_Obj_lt( norm, rmin ) )
    {
        // sigma = rmin / norm;
        FLA_Copy( rmin, sigma );
        FLA_Inv_scal( norm, sigma );
    }
    else if ( FLA_Obj_gt( norm, rmax ) )
    {
        // sigma = rmax / norm;
        FLA_Copy( rmax, sigma );
        FLA_Inv_scal( norm, sigma );
    }
    else
    {
        // sigma = 1.0;
        FLA_Copy( FLA_ONE, sigma );
    }

    FLA_Obj_free( &norm );
    FLA_Obj_free( &safmin );
    FLA_Obj_free( &prec );
    FLA_Obj_free( &rmin );
    FLA_Obj_free( &rmax );

    return FLA_SUCCESS;
}