FLA_Bsvdd_external.c File Reference

(r12600)

Functions
FLA_Error	FLA_Bsvdd_external (FLA_Uplo uplo, FLA_Obj d, FLA_Obj e, FLA_Obj U, FLA_Obj V)

---

Function Documentation

FLA_Error FLA_Bsvdd_external	(	FLA_Uplo	uplo,
		FLA_Obj	d,
		FLA_Obj	e,
		FLA_Obj	U,
		FLA_Obj	V
	)

References F77_dbdsdc(), F77_sbdsdc(), FLA_Obj_col_stride(), FLA_Obj_create(), FLA_Obj_datatype(), FLA_Obj_datatype_proj_to_real(), FLA_Obj_free(), FLA_Obj_has_zero_dim(), FLA_Obj_length(), FLA_Obj_vector_dim(), FLA_Obj_vector_inc(), and FLA_Param_map_flame_to_netlib_uplo().

{
  int          info = 0;
#ifdef FLA_ENABLE_EXTERNAL_LAPACK_INTERFACES
  FLA_Datatype datatype;
  FLA_Datatype dt_real;
  int          m_U, cs_U;
  int          n_V, cs_V;
  int          n_C, cs_C;
  int          min_m_n;
  int          inc_d, inc_e;
  int          lwork, liwork;
  FLA_Obj      work, iwork;
  char         blas_uplo;
  char         blas_compq = 'I';

  //if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING )
  //  FLA_Bsvd_check( uplo, d, e, U, V );

  if ( FLA_Obj_has_zero_dim( d ) ) return FLA_SUCCESS;

  datatype = FLA_Obj_datatype( U );
  dt_real  = FLA_Obj_datatype_proj_to_real( U );

  m_U      = FLA_Obj_length( U );
  cs_U     = FLA_Obj_col_stride( U );

  n_V      = FLA_Obj_length( V );
  cs_V     = FLA_Obj_col_stride( V );

  n_C      = 0;
  cs_C     = 1;

  min_m_n  = FLA_Obj_vector_dim( d );

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

  lwork   = max( 1, 3*min_m_n*min_m_n + 4*min_m_n );
  liwork  = 8*min_m_n;

  FLA_Obj_create( dt_real, lwork,  1, 0, 0, &work );
  FLA_Obj_create( FLA_INT, liwork, 1, 0, 0, &iwork );

  FLA_Param_map_flame_to_netlib_uplo( uplo, &blas_uplo );

    switch( datatype ) {

    case FLA_FLOAT:
    {
      float*    buff_d     = ( float * ) FLA_FLOAT_PTR( d );
      float*    buff_e     = ( float * ) FLA_FLOAT_PTR( e );
      float*    buff_U     = ( float * ) FLA_FLOAT_PTR( U );
      float*    buff_V     = ( float * ) FLA_FLOAT_PTR( V );
      float*    buff_Q     = ( float * ) NULL;
      float*    buff_IQ    = ( float * ) NULL;
      float*    buff_work  = ( float * ) FLA_FLOAT_PTR( work );
      int*      buff_iwork = ( int   * ) FLA_INT_PTR( iwork );
  
      F77_sbdsdc( &blas_uplo,
                  &blas_compq,
                  &min_m_n,
                  buff_d,
                  buff_e,
                  buff_U, &cs_U,
                  buff_V, &cs_V,
                  buff_Q,
                  buff_IQ,
                  buff_work,
                  buff_iwork,
                  &info );

      break;
    }

    case FLA_DOUBLE:
    {
      double*   buff_d     = ( double * ) FLA_DOUBLE_PTR( d );
      double*   buff_e     = ( double * ) FLA_DOUBLE_PTR( e );
      double*   buff_U     = ( double * ) FLA_DOUBLE_PTR( U );
      double*   buff_V     = ( double * ) FLA_DOUBLE_PTR( V );
      double*   buff_Q     = ( double * ) NULL;
      double*   buff_IQ    = ( double * ) NULL;
      double*   buff_work  = ( double * ) FLA_DOUBLE_PTR( work );
      int*      buff_iwork = ( int    * ) FLA_INT_PTR( iwork );
  
      F77_dbdsdc( &blas_uplo,
                  &blas_compq,
                  &min_m_n,
                  buff_d,
                  buff_e,
                  buff_U, &cs_U,
                  buff_V, &cs_V,
                  buff_Q,
                  buff_IQ,
                  buff_work,
                  buff_iwork,
                  &info );

      break;
    } 
  
    }

  FLA_Obj_free( &work );
  FLA_Obj_free( &iwork );

#else
  FLA_Check_error_code( FLA_EXTERNAL_LAPACK_NOT_IMPLEMENTED );
#endif

  return info;
}