FLA_Her2_external.c File Reference

(r)


Functions

FLA_Error FLA_Her2_external (FLA_Uplo uplo, FLA_Obj alpha, FLA_Obj x, FLA_Obj y, FLA_Obj A)
void FLA_F2C() fla_her2_external_f (F_INT *uplo, F_INT *alpha, F_INT *x, F_INT *y, F_INT *A, F_INT *IERROR)

Function Documentation

FLA_Error FLA_Her2_external ( FLA_Uplo  uplo,
FLA_Obj  alpha,
FLA_Obj  x,
FLA_Obj  y,
FLA_Obj  A 
)

References cblas_cher2(), cblas_zher2(), CblasColMajor, cher2(), FLA_Check_error_level(), FLA_Her2_check(), FLA_Obj_datatype(), FLA_Obj_has_zero_dim(), FLA_Obj_ldim(), FLA_Obj_length(), FLA_Param_map_to_blas_uplo(), and zher2().

Referenced by FLA_Her2(), fla_her2_external_f(), FLA_Her2k_ln_unb_var10(), FLA_Her2k_ln_unb_var9(), FLA_Her2k_un_unb_var10(), and FLA_Her2k_un_unb_var9().

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 
00048   if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING ) 
00049     FLA_Her2_check( uplo, alpha, x, y, 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   m_y      = FLA_Obj_length( y );
00062   ldim_y   = FLA_Obj_ldim( y );
00063 
00064   inc_x    = ( m_x == 1 ? ldim_x : 1 );
00065   inc_y    = ( m_y == 1 ? ldim_y : 1 );
00066 
00067   FLA_Param_map_to_blas_uplo( uplo, &blas_uplo );
00068 
00069 
00070   switch( datatype ){
00071 
00072   case FLA_COMPLEX:
00073   {
00074     scomplex *buff_A     = ( scomplex * ) FLA_COMPLEX_PTR( A );
00075     scomplex *buff_x     = ( scomplex * ) FLA_COMPLEX_PTR( x );
00076     scomplex *buff_y     = ( scomplex * ) FLA_COMPLEX_PTR( y );
00077     scomplex *buff_alpha = ( scomplex * ) FLA_COMPLEX_PTR( alpha );
00078 
00079 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00080     cblas_cher2( cblas_order,
00081                  blas_uplo,
00082                  m_A,
00083                  buff_alpha,
00084                  buff_x, inc_x,
00085                  buff_y, inc_y,
00086                  buff_A, ldim_A ); 
00087 #else
00088     FLA_C2F( cher2 )( &blas_uplo,
00089                       &m_A,
00090                       buff_alpha,
00091                       buff_x, &inc_x,
00092                       buff_y, &inc_y,
00093                       buff_A, &ldim_A ); 
00094 #endif
00095     break;
00096   }
00097 
00098   case FLA_DOUBLE_COMPLEX:
00099   {
00100     dcomplex *buff_A     = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
00101     dcomplex *buff_x     = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( x );
00102     dcomplex *buff_y     = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( y );
00103     dcomplex *buff_alpha = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( alpha );
00104 
00105 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00106     cblas_zher2( cblas_order,
00107                  blas_uplo,
00108                  m_A,
00109                  buff_alpha,
00110                  buff_x, inc_x,
00111                  buff_y, inc_y,
00112                  buff_A, ldim_A ); 
00113 #else
00114     FLA_C2F( zher2 )( &blas_uplo,
00115                       &m_A,
00116                       buff_alpha,
00117                       buff_x, &inc_x,
00118                       buff_y, &inc_y,
00119                       buff_A, &ldim_A ); 
00120 #endif
00121     break;
00122   }
00123 
00124   }
00125   
00126   return FLA_SUCCESS;
00127 }

void FLA_F2C() fla_her2_external_f ( F_INT *  uplo,
F_INT *  alpha,
F_INT *  x,
F_INT *  y,
F_INT *  A,
F_INT *  IERROR 
)

References FLA_Her2_external().

00132 {
00133   *IERROR = FLA_Her2_external( *( ( FLA_Uplo * ) uplo  ), 
00134                                *( ( FLA_Obj  * ) alpha ), 
00135                                *( ( FLA_Obj  * ) x     ),
00136                                *( ( FLA_Obj  * ) y     ),
00137                                *( ( FLA_Obj  * ) A     ) );
00138 }


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