FLA_Her2c_external.c File Reference

(r)


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)

Function Documentation

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 }


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