libflame revision_anchor
Functions
FLA_Tevd_external.c File Reference

(r)

Functions

FLA_Error FLA_Tevd_external (FLA_Evd_type jobz, FLA_Obj d, FLA_Obj e, FLA_Obj A)
 

Function Documentation

◆ FLA_Tevd_external()

FLA_Error FLA_Tevd_external ( FLA_Evd_type jobz,
FLA_Obj d,
FLA_Obj e,
FLA_Obj A )
14{
15 int info = 0;
16#ifdef FLA_ENABLE_EXTERNAL_LAPACK_INTERFACES
17 FLA_Datatype datatype;
18 FLA_Datatype dt_real;
19 int n_A, cs_A;
20 int inc_d, inc_e;
21 int lwork;
22 FLA_Obj work, d_use, e_use;
23 char blas_jobz;
24
25 //if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING )
26 // FLA_Hevd_check( jobz, uplo, A, e );
27
28 if ( FLA_Obj_has_zero_dim( A ) ) return FLA_SUCCESS;
29
30 datatype = FLA_Obj_datatype( A );
31 dt_real = FLA_Obj_datatype_proj_to_real( A );
32
33 n_A = FLA_Obj_vector_dim( d );
34 cs_A = FLA_Obj_col_stride( A );
35
36 if ( FLA_Obj_vector_inc( d ) != 1 )
37 {
38 FLA_Obj_create( dt_real, n_A, 1, 0, 0, &d_use );
39 FLA_Copy( d, d_use );
40 }
41 else { d_use = d; }
42
43 if ( FLA_Obj_vector_inc( e ) != 1 )
44 {
45 FLA_Obj_create( dt_real, n_A-1, 1, 0, 0, &e_use );
46 FLA_Copy( e, e_use );
47 }
48 else { e_use = e; }
49
50 inc_d = FLA_Obj_vector_inc( d_use );
51 inc_e = FLA_Obj_vector_inc( e_use );
52
53 // Allocate thw work array up front.
54 lwork = max( 1.0, 2.0 * n_A - 2 );
55 FLA_Obj_create( dt_real, lwork, 1, 0, 0, &work );
56
57 FLA_Param_map_flame_to_netlib_evd_type( jobz, &blas_jobz );
58
59 switch( datatype ) {
60
61 case FLA_FLOAT:
62 {
63 float* buff_A = ( float * ) FLA_FLOAT_PTR( A );
64 float* buff_d = ( float * ) FLA_FLOAT_PTR( d_use );
65 float* buff_e = ( float * ) FLA_FLOAT_PTR( e_use );
66 float* buff_work = ( float * ) FLA_FLOAT_PTR( work );
67
68 F77_ssteqr( &blas_jobz,
69 &n_A,
70 buff_d,
71 buff_e,
72 buff_A, &cs_A,
73 buff_work,
74 &info );
75
76 break;
77 }
78
79 case FLA_DOUBLE:
80 {
81 double* buff_A = ( double * ) FLA_DOUBLE_PTR( A );
82 double* buff_d = ( double * ) FLA_DOUBLE_PTR( d_use );
83 double* buff_e = ( double * ) FLA_DOUBLE_PTR( e_use );
84 double* buff_work = ( double * ) FLA_DOUBLE_PTR( work );
85
86 F77_dsteqr( &blas_jobz,
87 &n_A,
88 buff_d,
89 buff_e,
90 buff_A, &cs_A,
91 buff_work,
92 &info );
93
94 break;
95 }
96
97 case FLA_COMPLEX:
98 {
99 scomplex* buff_A = ( scomplex * ) FLA_COMPLEX_PTR( A );
100 float* buff_d = ( float * ) FLA_FLOAT_PTR( d_use );
101 float* buff_e = ( float * ) FLA_FLOAT_PTR( e_use );
102 float* buff_work = ( float * ) FLA_FLOAT_PTR( work );
103
104 F77_csteqr( &blas_jobz,
105 &n_A,
106 buff_d,
107 buff_e,
108 buff_A, &cs_A,
109 buff_work,
110 &info );
111
112 break;
113 }
114
115 case FLA_DOUBLE_COMPLEX:
116 {
117 dcomplex* buff_A = ( dcomplex* ) FLA_DOUBLE_COMPLEX_PTR( A );
118 double* buff_d = ( double* ) FLA_DOUBLE_PTR( d_use );
119 double* buff_e = ( double* ) FLA_DOUBLE_PTR( e_use );
120 double* buff_work = ( double* ) FLA_DOUBLE_PTR( work );
121
122 F77_zsteqr( &blas_jobz,
123 &n_A,
124 buff_d,
125 buff_e,
126 buff_A, &cs_A,
127 buff_work,
128 &info );
129
130 break;
131 }
132
133 }
134
135 if ( FLA_Obj_vector_inc( d ) != 1 )
136 {
137 FLA_Copy( d_use, d );
138 FLA_Obj_free( &d_use );
139 }
140 if ( FLA_Obj_vector_inc( e ) != 1 )
141 {
142 FLA_Copy( e_use, e );
143 FLA_Obj_free( &e_use );
144 }
145
146 FLA_Obj_free( &work );
147
148#else
149 FLA_Check_error_code( FLA_EXTERNAL_LAPACK_NOT_IMPLEMENTED );
150#endif
151
152 return info;
153}
FLA_Copy
FLA_Error FLA_Copy(FLA_Obj A, FLA_Obj B)
Definition FLA_Copy.c:15
F77_ssteqr
int F77_ssteqr(char *jobz, int *n, float *d, float *e, float *z, int *ldz, float *work, int *info)
F77_csteqr
int F77_csteqr(char *jobz, int *n, float *d, float *e, scomplex *z, int *ldz, float *work, int *info)
F77_dsteqr
int F77_dsteqr(char *jobz, int *n, double *d, double *e, double *z, int *ldz, double *work, int *info)
F77_zsteqr
int F77_zsteqr(char *jobz, int *n, double *d, double *e, dcomplex *z, int *ldz, double *work, int *info)
FLA_Param_map_flame_to_netlib_evd_type
void FLA_Param_map_flame_to_netlib_evd_type(FLA_Evd_type evd_type, void *lapack_evd_type)
Definition FLA_Param.c:151
FLA_Obj_create
FLA_Error FLA_Obj_create(FLA_Datatype datatype, dim_t m, dim_t n, dim_t rs, dim_t cs, FLA_Obj *obj)
Definition FLA_Obj.c:55
FLA_Obj_has_zero_dim
FLA_Bool FLA_Obj_has_zero_dim(FLA_Obj A)
Definition FLA_Query.c:400
FLA_Obj_datatype_proj_to_real
FLA_Datatype FLA_Obj_datatype_proj_to_real(FLA_Obj A)
Definition FLA_Query.c:23
FLA_Obj_col_stride
dim_t FLA_Obj_col_stride(FLA_Obj obj)
Definition FLA_Query.c:174
FLA_Obj_free
FLA_Error FLA_Obj_free(FLA_Obj *obj)
Definition FLA_Obj.c:588
FLA_Obj_vector_inc
dim_t FLA_Obj_vector_inc(FLA_Obj obj)
Definition FLA_Query.c:145
FLA_Obj_vector_dim
dim_t FLA_Obj_vector_dim(FLA_Obj obj)
Definition FLA_Query.c:137
FLA_Obj_datatype
FLA_Datatype FLA_Obj_datatype(FLA_Obj obj)
Definition FLA_Query.c:13
FLA_Datatype
int FLA_Datatype
Definition FLA_type_defs.h:49
FLA_Obj_view
Definition FLA_type_defs.h:159
dcomplex
Definition blis_type_defs.h:138
scomplex
Definition blis_type_defs.h:133

References F77_csteqr(), F77_dsteqr(), F77_ssteqr(), F77_zsteqr(), FLA_Copy(), 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_vector_dim(), FLA_Obj_vector_inc(), and FLA_Param_map_flame_to_netlib_evd_type().

Generated on Thu Sep 23 2021 17:46:17 for libflame by doxygen 1.12.0