Functions | |
FLA_Error | FLA_Herc_external (FLA_Uplo uplo, FLA_Conj conjx, FLA_Obj alpha, FLA_Obj x, FLA_Obj A) |
void FLA_F2C() | fla_herc_external_f (F_INT *uplo, F_INT *conjx, F_INT *alpha, F_INT *x, F_INT *A, F_INT *IERROR) |
References cblas_cher(), cblas_zher(), CblasColMajor, cher(), FLA_Check_error_level(), FLA_Copyt_external(), FLA_Herc_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 zher().
Referenced by FLA_Chol_u_unb_var3(), FLA_Herc(), fla_herc_external_f(), FLA_Herk_lh_unb_var5(), FLA_Herk_lh_unb_var6(), FLA_Herk_uh_unb_var5(), FLA_Herk_uh_unb_var6(), and FLA_Ttmm_l_unb_var1().
00036 { 00037 FLA_Datatype datatype; 00038 int m_A, ldim_A; 00039 int m_x, ldim_x, inc_x; 00040 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00041 CBLAS_ORDER cblas_order = CblasColMajor; 00042 CBLAS_UPLO blas_uplo; 00043 #else 00044 char blas_uplo; 00045 #endif 00046 FLA_Obj x_copy; 00047 00048 if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING ) 00049 FLA_Herc_check( uplo, conjx, alpha, x, A ); 00050 00051 if ( FLA_Obj_has_zero_dim( A ) ) return FLA_SUCCESS; 00052 00053 datatype = FLA_Obj_datatype( A ); 00054 00055 m_A = FLA_Obj_length( A ); 00056 ldim_A = FLA_Obj_ldim( A ); 00057 00058 m_x = FLA_Obj_length( x ); 00059 ldim_x = FLA_Obj_ldim( x ); 00060 00061 inc_x = ( m_x == 1 ? ldim_x : 1 ); 00062 00063 if ( conjx == FLA_CONJUGATE ) 00064 { 00065 FLA_Obj_create_conf_to( FLA_NO_TRANSPOSE, x, &x_copy ); 00066 FLA_Copyt_external( FLA_CONJ_NO_TRANSPOSE, x, x_copy ); 00067 00068 m_x = FLA_Obj_length( x_copy ); 00069 ldim_x = FLA_Obj_ldim( x_copy ); 00070 inc_x = ( m_x == 1 ? ldim_x : 1 ); 00071 } 00072 else 00073 { 00074 x_copy = x; 00075 } 00076 00077 FLA_Param_map_to_blas_uplo( uplo, &blas_uplo ); 00078 00079 00080 switch( datatype ){ 00081 00082 case FLA_COMPLEX: 00083 { 00084 scomplex *buff_A = ( scomplex * ) FLA_COMPLEX_PTR( A ); 00085 scomplex *buff_x = ( scomplex * ) FLA_COMPLEX_PTR( x_copy ); 00086 float *buff_alpha = ( float * ) FLA_FLOAT_PTR( alpha ); 00087 00088 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00089 cblas_cher( cblas_order, 00090 blas_uplo, 00091 m_A, 00092 buff_alpha->real, 00093 buff_x, inc_x, 00094 buff_A, ldim_A ); 00095 #else 00096 FLA_C2F( cher )( &blas_uplo, 00097 &m_A, 00098 buff_alpha, 00099 buff_x, &inc_x, 00100 buff_A, &ldim_A ); 00101 #endif 00102 break; 00103 } 00104 00105 case FLA_DOUBLE_COMPLEX: 00106 { 00107 dcomplex *buff_A = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A ); 00108 dcomplex *buff_x = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( x_copy ); 00109 double *buff_alpha = ( double * ) FLA_DOUBLE_PTR( alpha ); 00110 00111 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00112 cblas_zher( cblas_order, 00113 blas_uplo, 00114 m_A, 00115 buff_alpha->real, 00116 buff_x, inc_x, 00117 buff_A, ldim_A ); 00118 #else 00119 FLA_C2F( zher )( &blas_uplo, 00120 &m_A, 00121 buff_alpha, 00122 buff_x, &inc_x, 00123 buff_A, &ldim_A ); 00124 #endif 00125 break; 00126 } 00127 00128 } 00129 00130 if ( conjx == FLA_CONJUGATE ) 00131 FLA_Obj_free( &x_copy ); 00132 00133 return FLA_SUCCESS; 00134 }
void FLA_F2C() fla_herc_external_f | ( | F_INT * | uplo, | |
F_INT * | conjx, | |||
F_INT * | alpha, | |||
F_INT * | x, | |||
F_INT * | A, | |||
F_INT * | IERROR | |||
) |
References FLA_Herc_external().
00139 { 00140 *IERROR = FLA_Herc_external( *( ( FLA_Uplo * ) uplo ), 00141 *( ( FLA_Conj * ) conjx ), 00142 *( ( FLA_Obj * ) alpha ), 00143 *( ( FLA_Obj * ) x ), 00144 *( ( FLA_Obj * ) A ) ); 00145 }