Functions | |
FLA_Error | FLA_Her2c_external (FLA_Uplo uplo, FLA_Conj conjxy, FLA_Obj alpha, FLA_Obj x, FLA_Obj y, FLA_Obj A) |
void FLA_F2C() | fla_her2c_external_f (F_INT *uplo, F_INT *conjxy, F_INT *alpha, F_INT *x, F_INT *y, F_INT *A, F_INT *IERROR) |
FLA_Error FLA_Her2c_external | ( | FLA_Uplo | uplo, | |
FLA_Conj | conjxy, | |||
FLA_Obj | alpha, | |||
FLA_Obj | x, | |||
FLA_Obj | y, | |||
FLA_Obj | A | |||
) |
References cblas_cher2(), cblas_zher2(), CblasColMajor, cher2(), FLA_Check_error_level(), FLA_Copyt_external(), FLA_Her2c_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(), dcomplex::imag, scomplex::imag, and zher2().
Referenced by FLA_Her2c(), fla_her2c_external_f(), FLA_Her2k_lh_unb_var10(), FLA_Her2k_lh_unb_var9(), FLA_Her2k_uh_unb_var10(), and FLA_Her2k_uh_unb_var9().
00036 { 00037 FLA_Datatype datatype; 00038 int m_A, ldim_A; 00039 int m_x, ldim_x, inc_x; 00040 int m_y, ldim_y, inc_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 x_copy, y_copy; 00048 00049 if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING ) 00050 FLA_Her2c_check( uplo, conjxy, alpha, x, y, A ); 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 ( conjxy == FLA_CONJUGATE ) 00069 { 00070 FLA_Obj_create_conf_to( FLA_NO_TRANSPOSE, x, &x_copy ); 00071 FLA_Copyt_external( FLA_CONJ_NO_TRANSPOSE, x, x_copy ); 00072 00073 FLA_Obj_create_conf_to( FLA_NO_TRANSPOSE, y, &y_copy ); 00074 FLA_Copyt_external( FLA_CONJ_NO_TRANSPOSE, y, y_copy ); 00075 00076 m_x = FLA_Obj_length( x_copy ); 00077 ldim_x = FLA_Obj_ldim( x_copy ); 00078 inc_x = ( m_x == 1 ? ldim_x : 1 ); 00079 00080 m_y = FLA_Obj_length( y_copy ); 00081 ldim_y = FLA_Obj_ldim( y_copy ); 00082 inc_y = ( m_y == 1 ? ldim_y : 1 ); 00083 } 00084 else 00085 { 00086 x_copy = x; 00087 y_copy = y; 00088 } 00089 00090 FLA_Param_map_to_blas_uplo( uplo, &blas_uplo ); 00091 00092 00093 switch( datatype ){ 00094 00095 case FLA_COMPLEX: 00096 { 00097 scomplex *buff_A = ( scomplex * ) FLA_COMPLEX_PTR( A ); 00098 scomplex *buff_x = ( scomplex * ) FLA_COMPLEX_PTR( x_copy ); 00099 scomplex *buff_y = ( scomplex * ) FLA_COMPLEX_PTR( y_copy ); 00100 scomplex *buff_alpha = ( scomplex * ) FLA_COMPLEX_PTR( alpha ); 00101 scomplex alphac; 00102 00103 alphac = *buff_alpha; 00104 alphac.imag *= -1.0F; 00105 00106 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00107 cblas_cher2( cblas_order, 00108 blas_uplo, 00109 m_A, 00110 &alphac, 00111 buff_x, inc_x, 00112 buff_y, inc_y, 00113 buff_A, ldim_A ); 00114 #else 00115 FLA_C2F( cher2 )( &blas_uplo, 00116 &m_A, 00117 &alphac, 00118 buff_x, &inc_x, 00119 buff_y, &inc_y, 00120 buff_A, &ldim_A ); 00121 #endif 00122 break; 00123 } 00124 00125 case FLA_DOUBLE_COMPLEX: 00126 { 00127 dcomplex *buff_A = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A ); 00128 dcomplex *buff_x = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( x_copy ); 00129 dcomplex *buff_y = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( y_copy ); 00130 dcomplex *buff_alpha = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( alpha ); 00131 dcomplex alphac; 00132 00133 alphac = *buff_alpha; 00134 alphac.imag *= -1.0; 00135 00136 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00137 cblas_zher2( cblas_order, 00138 blas_uplo, 00139 m_A, 00140 &alphac, 00141 buff_x, inc_x, 00142 buff_y, inc_y, 00143 buff_A, ldim_A ); 00144 #else 00145 FLA_C2F( zher2 )( &blas_uplo, 00146 &m_A, 00147 &alphac, 00148 buff_x, &inc_x, 00149 buff_y, &inc_y, 00150 buff_A, &ldim_A ); 00151 #endif 00152 break; 00153 } 00154 00155 } 00156 00157 if ( conjxy == FLA_CONJUGATE ) 00158 { 00159 FLA_Obj_free( &x_copy ); 00160 FLA_Obj_free( &y_copy ); 00161 } 00162 00163 return FLA_SUCCESS; 00164 }
void FLA_F2C() fla_her2c_external_f | ( | F_INT * | uplo, | |
F_INT * | conjxy, | |||
F_INT * | alpha, | |||
F_INT * | x, | |||
F_INT * | y, | |||
F_INT * | A, | |||
F_INT * | IERROR | |||
) |
References FLA_Her2c_external().
00169 { 00170 *IERROR = FLA_Her2c_external( *( ( FLA_Uplo * ) uplo ), 00171 *( ( FLA_Conj * ) conjxy ), 00172 *( ( FLA_Obj * ) alpha ), 00173 *( ( FLA_Obj * ) x ), 00174 *( ( FLA_Obj * ) y ), 00175 *( ( FLA_Obj * ) A ) ); 00176 }