Functions | |
FLA_Error | FLA_Hemvc_external (FLA_Uplo uplo, FLA_Conj conja, FLA_Obj alpha, FLA_Obj A, FLA_Obj x, FLA_Obj beta, FLA_Obj y) |
void FLA_F2C() | fla_hemvc_external_f (F_INT *uplo, F_INT *conj, F_INT *alpha, F_INT *A, F_INT *x, F_INT *beta, F_INT *y, F_INT *IERROR) |
FLA_Error FLA_Hemvc_external | ( | FLA_Uplo | uplo, | |
FLA_Conj | conja, | |||
FLA_Obj | alpha, | |||
FLA_Obj | A, | |||
FLA_Obj | x, | |||
FLA_Obj | beta, | |||
FLA_Obj | y | |||
) |
References cblas_chemv(), cblas_zhemv(), CblasColMajor, chemv(), FLA_Check_error_level(), FLA_Copyt_external(), FLA_Hemvc_check(), FLA_Obj_create_conf_to(), FLA_Obj_datatype(), FLA_Obj_free(), FLA_Obj_has_zero_dim(), FLA_Obj_ldim(), FLA_Obj_length(), FLA_Param_map_to_blas_uplo(), and zhemv().
Referenced by FLA_Hemm_rl_unb_var10(), FLA_Hemm_rl_unb_var9(), FLA_Hemm_ru_unb_var10(), FLA_Hemm_ru_unb_var9(), FLA_Hemvc(), and fla_hemvc_external_f().
00036 { 00037 FLA_Datatype datatype; 00038 int m_A, ldim_A; 00039 int m_x, inc_x, ldim_x; 00040 int m_y, inc_y, ldim_y; 00041 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00042 CBLAS_ORDER cblas_order = CblasColMajor; 00043 CBLAS_UPLO blas_uplo; 00044 #else 00045 char blas_uplo; 00046 #endif 00047 FLA_Obj A_copy; 00048 00049 if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING ) 00050 FLA_Hemvc_check( uplo, conja, alpha, A, x, beta, y ); 00051 00052 if ( FLA_Obj_has_zero_dim( A ) ) return FLA_SUCCESS; 00053 00054 datatype = FLA_Obj_datatype( A ); 00055 00056 m_A = FLA_Obj_length( A ); 00057 ldim_A = FLA_Obj_ldim( A ); 00058 00059 m_x = FLA_Obj_length( x ); 00060 ldim_x = FLA_Obj_ldim( x ); 00061 00062 m_y = FLA_Obj_length( y ); 00063 ldim_y = FLA_Obj_ldim( y ); 00064 00065 inc_x = ( m_x == 1 ? ldim_x : 1 ); 00066 inc_y = ( m_y == 1 ? ldim_y : 1 ); 00067 00068 if ( conja == FLA_CONJUGATE ) 00069 { 00070 FLA_Obj_create_conf_to( FLA_NO_TRANSPOSE, A, &A_copy ); 00071 FLA_Copyt_external( FLA_CONJ_NO_TRANSPOSE, A, A_copy ); 00072 00073 ldim_A = FLA_Obj_ldim( A_copy ); 00074 } 00075 else 00076 { 00077 A_copy = A; 00078 } 00079 00080 FLA_Param_map_to_blas_uplo( uplo, &blas_uplo ); 00081 00082 00083 switch( datatype ){ 00084 00085 case FLA_COMPLEX: 00086 { 00087 scomplex *buff_A = ( scomplex * ) FLA_COMPLEX_PTR( A_copy ); 00088 scomplex *buff_x = ( scomplex * ) FLA_COMPLEX_PTR( x ); 00089 scomplex *buff_y = ( scomplex * ) FLA_COMPLEX_PTR( y ); 00090 scomplex *buff_alpha = ( scomplex * ) FLA_COMPLEX_PTR( alpha ); 00091 scomplex *buff_beta = ( scomplex * ) FLA_COMPLEX_PTR( beta ); 00092 00093 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00094 cblas_chemv( cblas_order, 00095 blas_uplo, 00096 m_A, 00097 buff_alpha, 00098 buff_A, ldim_A, 00099 buff_x, inc_x, 00100 buff_beta, 00101 buff_y, inc_y ); 00102 #else 00103 FLA_C2F( chemv )( &blas_uplo, 00104 &m_A, 00105 buff_alpha, 00106 buff_A, &ldim_A, 00107 buff_x, &inc_x, 00108 buff_beta, 00109 buff_y, &inc_y ); 00110 #endif 00111 break; 00112 } 00113 00114 case FLA_DOUBLE_COMPLEX: 00115 { 00116 dcomplex *buff_A = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A_copy ); 00117 dcomplex *buff_x = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( x ); 00118 dcomplex *buff_y = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( y ); 00119 dcomplex *buff_alpha = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( alpha ); 00120 dcomplex *buff_beta = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( beta ); 00121 00122 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00123 cblas_zhemv( cblas_order, 00124 blas_uplo, 00125 m_A, 00126 buff_alpha, 00127 buff_A, ldim_A, 00128 buff_x, inc_x, 00129 buff_beta, 00130 buff_y, inc_y ); 00131 #else 00132 FLA_C2F( zhemv )( &blas_uplo, 00133 &m_A, 00134 buff_alpha, 00135 buff_A, &ldim_A, 00136 buff_x, &inc_x, 00137 buff_beta, 00138 buff_y, &inc_y ); 00139 #endif 00140 break; 00141 } 00142 00143 } 00144 00145 if ( conja == FLA_CONJUGATE ) 00146 FLA_Obj_free( &A_copy ); 00147 00148 return FLA_SUCCESS; 00149 }
void FLA_F2C() fla_hemvc_external_f | ( | F_INT * | uplo, | |
F_INT * | conj, | |||
F_INT * | alpha, | |||
F_INT * | A, | |||
F_INT * | x, | |||
F_INT * | beta, | |||
F_INT * | y, | |||
F_INT * | IERROR | |||
) |
References FLA_Hemvc_external().
00153 { 00154 *IERROR = FLA_Hemvc_external( *( ( FLA_Uplo * ) uplo ), 00155 *( ( FLA_Conj * ) conj ), 00156 *( ( FLA_Obj * ) alpha ), 00157 *( ( FLA_Obj * ) A ), 00158 *( ( FLA_Obj * ) x ), 00159 *( ( FLA_Obj * ) beta ), 00160 *( ( FLA_Obj * ) y ) ); 00161 }