FLA_Syr2k_external.c File Reference

(r)


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)

Function Documentation

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 }


Generated on Mon Jul 6 05:45:53 2009 for libflame by  doxygen 1.5.9