Functions | |
FLA_Error | FLA_Syr2k_external (FLA_Uplo uplo, FLA_Trans trans, FLA_Obj alpha, FLA_Obj A, FLA_Obj B, FLA_Obj beta, FLA_Obj C) |
void FLA_F2C() | fla_syr2k_external_f (F_INT *uplo, F_INT *trans, F_INT *alpha, F_INT *A, F_INT *B, F_INT *beta, F_INT *C, F_INT *IERROR) |
FLA_Error FLA_Syr2k_external | ( | FLA_Uplo | uplo, | |
FLA_Trans | trans, | |||
FLA_Obj | alpha, | |||
FLA_Obj | A, | |||
FLA_Obj | B, | |||
FLA_Obj | beta, | |||
FLA_Obj | C | |||
) |
References cblas_csyr2k(), cblas_dsyr2k(), cblas_ssyr2k(), cblas_zsyr2k(), CblasColMajor, csyr2k(), dsyr2k(), FLA_Check_error_level(), FLA_Obj_datatype(), FLA_Obj_has_zero_dim(), FLA_Obj_ldim(), FLA_Obj_length(), FLA_Obj_width(), FLA_Param_map_to_blas_trans(), FLA_Param_map_to_blas_uplo(), FLA_Syr2k_check(), ssyr2k(), and zsyr2k().
Referenced by FLA_Syr2k(), fla_syr2k_external_f(), FLA_Syr2k_ln_task(), FLA_Syr2k_lt_task(), FLA_Syr2k_task(), FLA_Syr2k_un_task(), and FLA_Syr2k_ut_task().
00036 { 00037 FLA_Datatype datatype; 00038 int k_AB; 00039 int m_A, n_A, ldim_A; 00040 int ldim_B; 00041 int m_C, ldim_C; 00042 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00043 CBLAS_ORDER cblas_order = CblasColMajor; 00044 CBLAS_UPLO blas_uplo; 00045 CBLAS_TRANSPOSE blas_trans; 00046 #else 00047 char blas_uplo; 00048 char blas_trans; 00049 #endif 00050 00051 if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING ) 00052 FLA_Syr2k_check( uplo, trans, alpha, A, B, beta, C ); 00053 00054 if ( FLA_Obj_has_zero_dim( C ) ) return FLA_SUCCESS; 00055 00056 datatype = FLA_Obj_datatype( A ); 00057 00058 m_A = FLA_Obj_length( A ); 00059 n_A = FLA_Obj_width( A ); 00060 ldim_A = FLA_Obj_ldim( A ); 00061 00062 ldim_B = FLA_Obj_ldim( B ); 00063 00064 m_C = FLA_Obj_length( C ); 00065 ldim_C = FLA_Obj_ldim( C ); 00066 00067 if ( trans == FLA_NO_TRANSPOSE ) 00068 k_AB = n_A; 00069 else 00070 k_AB = m_A; 00071 00072 FLA_Param_map_to_blas_uplo( uplo, &blas_uplo ); 00073 FLA_Param_map_to_blas_trans( trans, &blas_trans ); 00074 00075 00076 switch( datatype ){ 00077 00078 case FLA_FLOAT: 00079 { 00080 float *buff_A = ( float * ) FLA_FLOAT_PTR( A ); 00081 float *buff_B = ( float * ) FLA_FLOAT_PTR( B ); 00082 float *buff_C = ( float * ) FLA_FLOAT_PTR( C ); 00083 float *buff_alpha = ( float * ) FLA_FLOAT_PTR( alpha ); 00084 float *buff_beta = ( float * ) FLA_FLOAT_PTR( beta ); 00085 00086 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00087 cblas_ssyr2k( cblas_order, 00088 blas_uplo, 00089 blas_trans, 00090 m_C, 00091 k_AB, 00092 *buff_alpha, 00093 buff_A, ldim_A, 00094 buff_B, ldim_B, 00095 *buff_beta, 00096 buff_C, ldim_C ); 00097 #else 00098 FLA_C2F( ssyr2k )( &blas_uplo, 00099 &blas_trans, 00100 &m_C, 00101 &k_AB, 00102 buff_alpha, 00103 buff_A, &ldim_A, 00104 buff_B, &ldim_B, 00105 buff_beta, 00106 buff_C, &ldim_C ); 00107 #endif 00108 break; 00109 } 00110 00111 case FLA_DOUBLE: 00112 { 00113 double *buff_A = ( double * ) FLA_DOUBLE_PTR( A ); 00114 double *buff_B = ( double * ) FLA_DOUBLE_PTR( B ); 00115 double *buff_C = ( double * ) FLA_DOUBLE_PTR( C ); 00116 double *buff_alpha = ( double * ) FLA_DOUBLE_PTR( alpha ); 00117 double *buff_beta = ( double * ) FLA_DOUBLE_PTR( beta ); 00118 00119 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00120 cblas_dsyr2k( cblas_order, 00121 blas_uplo, 00122 blas_trans, 00123 m_C, 00124 k_AB, 00125 *buff_alpha, 00126 buff_A, ldim_A, 00127 buff_B, ldim_B, 00128 *buff_beta, 00129 buff_C, ldim_C ); 00130 #else 00131 FLA_C2F( dsyr2k )( &blas_uplo, 00132 &blas_trans, 00133 &m_C, 00134 &k_AB, 00135 buff_alpha, 00136 buff_A, &ldim_A, 00137 buff_B, &ldim_B, 00138 buff_beta, 00139 buff_C, &ldim_C ); 00140 #endif 00141 break; 00142 } 00143 00144 case FLA_COMPLEX: 00145 { 00146 scomplex *buff_A = ( scomplex * ) FLA_COMPLEX_PTR( A ); 00147 scomplex *buff_B = ( scomplex * ) FLA_COMPLEX_PTR( B ); 00148 scomplex *buff_C = ( scomplex * ) FLA_COMPLEX_PTR( C ); 00149 scomplex *buff_alpha = ( scomplex * ) FLA_COMPLEX_PTR( alpha ); 00150 scomplex *buff_beta = ( scomplex * ) FLA_COMPLEX_PTR( beta ); 00151 00152 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00153 cblas_csyr2k( cblas_order, 00154 blas_uplo, 00155 blas_trans, 00156 m_C, 00157 k_AB, 00158 buff_alpha, 00159 buff_A, ldim_A, 00160 buff_B, ldim_B, 00161 buff_beta, 00162 buff_C, ldim_C ); 00163 #else 00164 FLA_C2F( csyr2k )( &blas_uplo, 00165 &blas_trans, 00166 &m_C, 00167 &k_AB, 00168 buff_alpha, 00169 buff_A, &ldim_A, 00170 buff_B, &ldim_B, 00171 buff_beta, 00172 buff_C, &ldim_C ); 00173 #endif 00174 break; 00175 } 00176 case FLA_DOUBLE_COMPLEX: 00177 { 00178 dcomplex *buff_A = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A ); 00179 dcomplex *buff_B = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( B ); 00180 dcomplex *buff_C = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( C ); 00181 dcomplex *buff_alpha = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( alpha ); 00182 dcomplex *buff_beta = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( beta ); 00183 00184 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00185 cblas_zsyr2k( cblas_order, 00186 blas_uplo, 00187 blas_trans, 00188 m_C, 00189 k_AB, 00190 buff_alpha, 00191 buff_A, ldim_A, 00192 buff_B, ldim_B, 00193 buff_beta, 00194 buff_C, ldim_C ); 00195 #else 00196 FLA_C2F( zsyr2k )( &blas_uplo, 00197 &blas_trans, 00198 &m_C, 00199 &k_AB, 00200 buff_alpha, 00201 buff_A, &ldim_A, 00202 buff_B, &ldim_B, 00203 buff_beta, 00204 buff_C, &ldim_C ); 00205 #endif 00206 break; 00207 } 00208 00209 } 00210 00211 return FLA_SUCCESS; 00212 }
void FLA_F2C() fla_syr2k_external_f | ( | F_INT * | uplo, | |
F_INT * | trans, | |||
F_INT * | alpha, | |||
F_INT * | A, | |||
F_INT * | B, | |||
F_INT * | beta, | |||
F_INT * | C, | |||
F_INT * | IERROR | |||
) |
References FLA_Syr2k_external().
00216 { 00217 *IERROR = FLA_Syr2k_external( *( ( FLA_Uplo * ) uplo ), 00218 *( ( FLA_Trans * ) trans ), 00219 *( ( FLA_Obj * ) alpha ), 00220 *( ( FLA_Obj * ) A ), 00221 *( ( FLA_Obj * ) B ), 00222 *( ( FLA_Obj * ) beta ), 00223 *( ( FLA_Obj * ) C ) ); 00224 }