FLA_blas1_prototypes.h File Reference

(r)

Go to the source code of this file.

Functions

FLA_Error FLA_Asum (FLA_Obj x, FLA_Obj asum_x)
FLA_Error FLA_Axpy (FLA_Obj alpha, FLA_Obj A, FLA_Obj B)
FLA_Error FLA_Axpys (FLA_Obj alpha0, FLA_Obj alpha1, FLA_Obj A, FLA_Obj beta, FLA_Obj B)
FLA_Error FLA_Axpyt (FLA_Trans trans, FLA_Obj alpha, FLA_Obj A, FLA_Obj B)
FLA_Error FLA_Copy (FLA_Obj A, FLA_Obj B)
FLA_Error FLA_Copyr (FLA_Uplo uplo, FLA_Obj A, FLA_Obj B)
FLA_Error FLA_Copyt (FLA_Trans trans, FLA_Obj A, FLA_Obj B)
FLA_Error FLA_Dot (FLA_Obj x, FLA_Obj y, FLA_Obj rho)
FLA_Error FLA_Dot2cs (FLA_Conj conj, FLA_Obj alpha, FLA_Obj x, FLA_Obj y, FLA_Obj beta, FLA_Obj rho)
FLA_Error FLA_Dot2s (FLA_Obj alpha, FLA_Obj x, FLA_Obj y, FLA_Obj beta, FLA_Obj rho)
FLA_Error FLA_Dotc (FLA_Conj conj, FLA_Obj x, FLA_Obj y, FLA_Obj rho)
FLA_Error FLA_Dotcs (FLA_Conj conj, FLA_Obj alpha, FLA_Obj x, FLA_Obj y, FLA_Obj beta, FLA_Obj rho)
FLA_Error FLA_Dots (FLA_Obj alpha, FLA_Obj x, FLA_Obj y, FLA_Obj beta, FLA_Obj rho)
FLA_Error FLA_Iamax (FLA_Obj x, FLA_Obj index)
FLA_Error FLA_Inv_scal (FLA_Obj alpha, FLA_Obj A)
FLA_Error FLA_Inv_scalc (FLA_Conj conjalpha, FLA_Obj alpha, FLA_Obj A)
FLA_Error FLA_Nrm2 (FLA_Obj x, FLA_Obj norm_x)
FLA_Error FLA_Scal (FLA_Obj alpha, FLA_Obj A)
FLA_Error FLA_Scalc (FLA_Conj conjalpha, FLA_Obj alpha, FLA_Obj A)
FLA_Error FLA_Scalr (FLA_Uplo uplo, FLA_Obj alpha, FLA_Obj A)
FLA_Error FLA_Swap (FLA_Obj A, FLA_Obj B)
FLA_Error FLA_Swapt (FLA_Trans trans, FLA_Obj A, FLA_Obj B)
void FLA_F2C() fla_axpy_f (F_INT *alpha, F_INT *A, F_INT *B, F_INT *IERROR)
void FLA_F2C() fla_copy_f (F_INT *A, F_INT *B, F_INT *IERROR)
FLA_Error FLA_Axpy_task (FLA_Obj alpha, FLA_Obj A, FLA_Obj B, fla_axpy_t *cntl)
FLA_Error FLA_Copy_task (FLA_Obj A, FLA_Obj B, fla_copy_t *cntl)
FLA_Error FLA_Axpy_internal (FLA_Obj alpha, FLA_Obj A, FLA_Obj B, fla_axpy_t *cntl)
FLA_Error FLA_Copy_internal (FLA_Obj A, FLA_Obj B, fla_copy_t *cntl)
FLA_Error FLA_Asum_external (FLA_Obj x, FLA_Obj asum_x)
FLA_Error FLA_Axpy_external (FLA_Obj alpha, FLA_Obj A, FLA_Obj B)
FLA_Error FLA_Axpys_external (FLA_Obj alpha0, FLA_Obj alpha1, FLA_Obj A, FLA_Obj beta, FLA_Obj B)
FLA_Error FLA_Axpyt_external (FLA_Trans trans, FLA_Obj alpha, FLA_Obj A, FLA_Obj B)
FLA_Error FLA_Copy_external (FLA_Obj A, FLA_Obj B)
FLA_Error FLA_Copyr_external (FLA_Uplo uplo, FLA_Obj A, FLA_Obj B)
FLA_Error FLA_Copyt_external (FLA_Trans trans, FLA_Obj A, FLA_Obj B)
FLA_Error FLA_Dot_external (FLA_Obj x, FLA_Obj y, FLA_Obj rho)
FLA_Error FLA_Dotc_external (FLA_Conj conj, FLA_Obj x, FLA_Obj y, FLA_Obj rho)
FLA_Error FLA_Dots_external (FLA_Obj alpha, FLA_Obj x, FLA_Obj y, FLA_Obj beta, FLA_Obj rho)
FLA_Error FLA_Dotcs_external (FLA_Conj conj, FLA_Obj alpha, FLA_Obj x, FLA_Obj y, FLA_Obj beta, FLA_Obj rho)
FLA_Error FLA_Dot2s_external (FLA_Obj alpha, FLA_Obj x, FLA_Obj y, FLA_Obj beta, FLA_Obj rho)
FLA_Error FLA_Dot2cs_external (FLA_Conj conj, FLA_Obj alpha, FLA_Obj x, FLA_Obj y, FLA_Obj beta, FLA_Obj rho)
FLA_Error FLA_Iamax_external (FLA_Obj x, FLA_Obj index)
FLA_Error FLA_Inv_scal_external (FLA_Obj alpha, FLA_Obj A)
FLA_Error FLA_Inv_scalc_external (FLA_Conj conjalpha, FLA_Obj alpha, FLA_Obj A)
FLA_Error FLA_Nrm2_external (FLA_Obj x, FLA_Obj nrm_x)
FLA_Error FLA_Scal_external (FLA_Obj alpha, FLA_Obj A)
FLA_Error FLA_Scalc_external (FLA_Conj conjalpha, FLA_Obj alpha, FLA_Obj A)
FLA_Error FLA_Scalr_external (FLA_Uplo uplo, FLA_Obj alpha, FLA_Obj A)
FLA_Error FLA_Swap_external (FLA_Obj A, FLA_Obj B)
FLA_Error FLA_Swapt_external (FLA_Trans trans, FLA_Obj A, FLA_Obj B)
void FLA_F2C() fla_asum_external_f (F_INT *X, F_INT *rho, F_INT *IERROR)
void FLA_F2C() fla_axpy_external_f (F_INT *alpha, F_INT *A, F_INT *B, F_INT *IERROR)
void FLA_F2C() fla_axpys_external_f (F_INT *alpha0, F_INT *alpha1, F_INT *A, F_INT *beta, F_INT *B, F_INT *IERROR)
void FLA_F2C() fla_axpyt_external_f (F_INT *trans, F_INT *alpha, F_INT *A, F_INT *B, F_INT *IERROR)
void FLA_F2C() fla_copy_external_f (F_INT *A, F_INT *B, F_INT *IERROR)
void FLA_F2C() fla_copyr_external_f (F_INT *uplo, F_INT *A, F_INT *B, F_INT *IERROR)
void FLA_F2C() fla_copyt_external_f (F_INT *trans, F_INT *A, F_INT *B, F_INT *IERROR)
void FLA_F2C() fla_dot_external_f (F_INT *X, F_INT *Y, F_INT *rho, F_INT *IERROR)
void FLA_F2C() fla_dotc_external_f (F_INT *conj, F_INT *X, F_INT *Y, F_INT *rho, F_INT *IERROR)
void FLA_F2C() fla_dots_external_f (F_INT *alpha, F_INT *X, F_INT *Y, F_INT *beta, F_INT *rho, F_INT *IERROR)
void FLA_F2C() fla_dotcs_external_f (F_INT *conj, F_INT *alpha, F_INT *X, F_INT *Y, F_INT *beta, F_INT *rho, F_INT *IERROR)
void FLA_F2C() fla_dot2s_external_f (F_INT *alpha, F_INT *X, F_INT *Y, F_INT *beta, F_INT *rho, F_INT *IERROR)
void FLA_F2C() fla_dot2cs_external_f (F_INT *conj, F_INT *alpha, F_INT *X, F_INT *Y, F_INT *beta, F_INT *rho, F_INT *IERROR)
void FLA_F2C() fla_iamax_external_f (F_INT *X, F_INT *index, F_INT *IERROR)
void FLA_F2C() fla_inv_scal_external_f (F_INT *alpha, F_INT *A, F_INT *IERROR)
void FLA_F2C() fla_inv_scalc_external_f (F_INT *conjalpha, F_INT *alpha, F_INT *A, F_INT *IERROR)
void FLA_F2C() fla_nrm2_external_f (F_INT *X, F_INT *rho, F_INT *IERROR)
void FLA_F2C() fla_scal_external_f (F_INT *alpha, F_INT *A, F_INT *IERROR)
void FLA_F2C() fla_scalc_external_f (F_INT *conjalpha, F_INT *alpha, F_INT *A, F_INT *IERROR)
void FLA_F2C() fla_scalr_external_f (F_INT *uplo, F_INT *alpha, F_INT *A, F_INT *IERROR)
void FLA_F2C() fla_swap_external_f (F_INT *A, F_INT *B, F_INT *IERROR)
void FLA_F2C() fla_swapt_external_f (F_INT *trans, F_INT *A, F_INT *B, F_INT *IERROR)
void FLA_F2C() fla_cdotu (int *n, scomplex *x, int *incx, scomplex *y, int *incy, scomplex *rval)
void FLA_F2C() fla_cdotc (int *n, scomplex *x, int *incx, scomplex *y, int *incy, scomplex *rval)
void FLA_F2C() fla_zdotu (int *n, dcomplex *x, int *incx, dcomplex *y, int *incy, dcomplex *rval)
void FLA_F2C() fla_zdotc (int *n, dcomplex *x, int *incx, dcomplex *y, int *incy, dcomplex *rval)
FLA_Error FLA_Asum_check (FLA_Obj x, FLA_Obj asum_x)
FLA_Error FLA_Axpy_check (FLA_Obj alpha, FLA_Obj A, FLA_Obj B)
FLA_Error FLA_Axpys_check (FLA_Obj alpha0, FLA_Obj alpha1, FLA_Obj A, FLA_Obj beta, FLA_Obj B)
FLA_Error FLA_Axpyt_check (FLA_Trans trans, FLA_Obj alpha, FLA_Obj A, FLA_Obj B)
FLA_Error FLA_Copy_check (FLA_Obj A, FLA_Obj B)
FLA_Error FLA_Copyr_check (FLA_Uplo uplo, FLA_Obj A, FLA_Obj B)
FLA_Error FLA_Copyt_check (FLA_Trans trans, FLA_Obj A, FLA_Obj B)
FLA_Error FLA_Dot_check (FLA_Obj x, FLA_Obj y, FLA_Obj rho)
FLA_Error FLA_Dotc_check (FLA_Conj conj, FLA_Obj x, FLA_Obj y, FLA_Obj rho)
FLA_Error FLA_Dots_check (FLA_Obj alpha, FLA_Obj x, FLA_Obj y, FLA_Obj beta, FLA_Obj rho)
FLA_Error FLA_Dotcs_check (FLA_Conj conj, FLA_Obj alpha, FLA_Obj x, FLA_Obj y, FLA_Obj beta, FLA_Obj rho)
FLA_Error FLA_Dot2s_check (FLA_Obj alpha, FLA_Obj x, FLA_Obj y, FLA_Obj beta, FLA_Obj rho)
FLA_Error FLA_Dot2cs_check (FLA_Conj conj, FLA_Obj alpha, FLA_Obj x, FLA_Obj y, FLA_Obj beta, FLA_Obj rho)
FLA_Error FLA_Iamax_check (FLA_Obj x, FLA_Obj index)
FLA_Error FLA_Inv_scal_check (FLA_Obj alpha, FLA_Obj A)
FLA_Error FLA_Inv_scalc_check (FLA_Conj conjalpha, FLA_Obj alpha, FLA_Obj A)
FLA_Error FLA_Nrm2_check (FLA_Obj x, FLA_Obj nrm_x)
FLA_Error FLA_Scal_check (FLA_Obj alpha, FLA_Obj A)
FLA_Error FLA_Scalc_check (FLA_Conj conjalpha, FLA_Obj alpha, FLA_Obj A)
FLA_Error FLA_Scalr_check (FLA_Uplo uplo, FLA_Obj alpha, FLA_Obj A)
FLA_Error FLA_Swap_check (FLA_Obj A, FLA_Obj B)
FLA_Error FLA_Swapt_check (FLA_Trans trans, FLA_Obj A, FLA_Obj B)
FLA_Error FLA_Axpy_internal_check (FLA_Obj alpha, FLA_Obj A, FLA_Obj B, fla_axpy_t *cntl)
FLA_Error FLA_Copy_internal_check (FLA_Obj A, FLA_Obj B, fla_copy_t *cntl)


Function Documentation

FLA_Error FLA_Asum ( FLA_Obj  x,
FLA_Obj  asum_x 
)

References FLA_Asum_external().

00036 {
00037     return FLA_Asum_external( x, asum_x );
00038 }

FLA_Error FLA_Asum_check ( FLA_Obj  x,
FLA_Obj  asum_x 
)

References FLA_Check_floating_object(), FLA_Check_identical_object_precision(), FLA_Check_if_scalar(), FLA_Check_if_vector(), FLA_Check_nonconstant_object(), and FLA_Check_real_object().

Referenced by FLA_Asum_external().

00036 {
00037   FLA_Error e_val;
00038 
00039   e_val = FLA_Check_floating_object( x );
00040   FLA_Check_error_code( e_val );
00041 
00042   e_val = FLA_Check_nonconstant_object( x );
00043   FLA_Check_error_code( e_val );
00044 
00045   e_val = FLA_Check_real_object( asum_x );
00046   FLA_Check_error_code( e_val );
00047 
00048   e_val = FLA_Check_identical_object_precision( x, asum_x );
00049   FLA_Check_error_code( e_val );
00050 
00051   e_val = FLA_Check_if_scalar( asum_x );
00052   FLA_Check_error_code( e_val );
00053 
00054   e_val = FLA_Check_if_vector( x );
00055   FLA_Check_error_code( e_val );
00056 
00057   return FLA_SUCCESS;
00058 }

FLA_Error FLA_Asum_external ( FLA_Obj  x,
FLA_Obj  asum_x 
)

References cblas_dasum(), cblas_dzasum(), cblas_sasum(), cblas_scasum(), dasum(), dzasum(), FLA_Asum_check(), FLA_Check_error_level(), FLA_Obj_datatype(), FLA_Obj_has_zero_dim(), FLA_Obj_ldim(), FLA_Obj_length(), FLA_Obj_set_to_scalar(), FLA_Obj_vector_dim(), FLA_ZERO, sasum(), and scasum().

Referenced by FLA_Asum(), fla_asum_external_f(), FLA_Norm1(), and FLA_Norm_inf().

00036 {
00037   FLA_Datatype datatype;
00038   int          num_elem;
00039   int          m_x, inc_x, ldim_x;
00040 
00041   if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING ) 
00042     FLA_Asum_check( x, asum_x );
00043 
00044   if ( FLA_Obj_has_zero_dim( x ) )
00045   {
00046     FLA_Obj_set_to_scalar( FLA_ZERO, asum_x );
00047     return FLA_SUCCESS;
00048   }
00049 
00050   datatype = FLA_Obj_datatype( x );
00051 
00052   m_x      = FLA_Obj_length( x );
00053   ldim_x   = FLA_Obj_ldim( x );
00054 
00055   inc_x    = ( m_x == 1 ? ldim_x : 1 );
00056   num_elem = FLA_Obj_vector_dim( x );
00057 
00058 
00059   switch ( datatype ){
00060 
00061   case FLA_FLOAT:
00062   {
00063     float *buff_x      = ( float * ) FLA_FLOAT_PTR( x );
00064     float *buff_asum_x = ( float * ) FLA_FLOAT_PTR( asum_x );
00065 
00066 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00067     *buff_asum_x = cblas_sasum( num_elem, buff_x, inc_x );
00068 #else
00069     *buff_asum_x = FLA_C2F( sasum ) ( &num_elem, buff_x, &inc_x );
00070 #endif
00071 
00072     break;
00073   }
00074 
00075   case FLA_DOUBLE:
00076   {
00077     double *buff_x      = ( double * ) FLA_DOUBLE_PTR( x );
00078     double *buff_asum_x = ( double * ) FLA_DOUBLE_PTR( asum_x );
00079 
00080 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00081     *buff_asum_x = cblas_dasum( num_elem, buff_x, inc_x );
00082 #else
00083     *buff_asum_x = FLA_C2F( dasum ) ( &num_elem, buff_x, &inc_x );
00084 #endif
00085 
00086     break;
00087   }
00088 
00089   case FLA_COMPLEX:
00090   {
00091     scomplex *buff_x      = ( scomplex * ) FLA_COMPLEX_PTR( x );
00092     float    *buff_asum_x = ( float    * ) FLA_FLOAT_PTR( asum_x );
00093 
00094 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00095     *buff_asum_x = cblas_scasum( num_elem, buff_x, inc_x );
00096 #else
00097     *buff_asum_x = FLA_C2F( scasum ) ( &num_elem, buff_x, &inc_x );
00098 #endif
00099 
00100     break;
00101   }
00102 
00103   case FLA_DOUBLE_COMPLEX:
00104   {
00105     dcomplex *buff_x      = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( x );
00106     double   *buff_asum_x = ( double   * ) FLA_DOUBLE_PTR( asum_x );
00107 
00108 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00109     *buff_asum_x = cblas_dzasum( num_elem, buff_x, inc_x );
00110 #else
00111     *buff_asum_x = FLA_C2F( dzasum ) ( &num_elem, buff_x, &inc_x );
00112 #endif
00113 
00114     break;
00115   }
00116 
00117   }
00118 
00119   return FLA_SUCCESS;
00120 }

void FLA_F2C() fla_asum_external_f ( F_INT *  X,
F_INT *  rho,
F_INT *  IERROR 
)

References FLA_Asum_external().

00125 {
00126   *IERROR = FLA_Asum_external( *( ( FLA_Obj * ) x   ), 
00127                                *( ( FLA_Obj * ) rho ) );
00128 }

FLA_Error FLA_Axpy ( FLA_Obj  alpha,
FLA_Obj  A,
FLA_Obj  B 
)

References FLA_Axpy_check(), FLA_Axpy_external(), FLA_Axpy_internal(), and FLA_Check_error_level().

Referenced by fla_axpy_f().

00036 {
00037     return FLA_Axpy_external( alpha, A, B );
00038 }

FLA_Error FLA_Axpy_check ( FLA_Obj  alpha,
FLA_Obj  A,
FLA_Obj  B 
)

References FLA_Check_conformal_dims(), FLA_Check_consistent_object_datatype(), FLA_Check_equal_vector_lengths(), FLA_Check_floating_object(), FLA_Check_identical_object_datatype(), FLA_Check_nonconstant_object(), and FLA_Obj_is_vector().

Referenced by FLA_Axpy(), FLA_Axpy_external(), and FLASH_Axpy().

00036 {
00037   FLA_Error e_val;
00038 
00039   e_val = FLA_Check_floating_object( A );
00040   FLA_Check_error_code( e_val );
00041 
00042   e_val = FLA_Check_nonconstant_object( A );
00043   FLA_Check_error_code( e_val );
00044 
00045   e_val = FLA_Check_identical_object_datatype( A, B );
00046   FLA_Check_error_code( e_val );
00047 
00048   e_val = FLA_Check_consistent_object_datatype( A, alpha );
00049   FLA_Check_error_code( e_val );
00050 
00051   if ( FLA_Obj_is_vector( A ) && FLA_Obj_is_vector( B ) )
00052   {
00053     e_val = FLA_Check_equal_vector_lengths( A, B );
00054     FLA_Check_error_code( e_val );
00055   }
00056   else
00057   {
00058     e_val = FLA_Check_conformal_dims( FLA_NO_TRANSPOSE, A, B );
00059     FLA_Check_error_code( e_val );
00060   }
00061 
00062   return FLA_SUCCESS;
00063 }

FLA_Error FLA_Axpy_external ( FLA_Obj  alpha,
FLA_Obj  A,
FLA_Obj  B 
)

References caxpy(), cblas_caxpy(), cblas_daxpy(), cblas_saxpy(), cblas_zaxpy(), daxpy(), FLA_Axpy_check(), FLA_Check_error_level(), FLA_Obj_datatype(), FLA_Obj_has_zero_dim(), FLA_Obj_is_vector(), FLA_Obj_ldim(), FLA_Obj_length(), FLA_Obj_vector_dim(), FLA_Obj_width(), saxpy(), and zaxpy().

Referenced by FLA_Apply_househ2_UT(), FLA_Axpy(), fla_axpy_external_f(), FLA_Axpy_internal(), FLA_Axpy_task(), FLA_Axpys_external(), FLA_Axpyt_external(), FLA_LQ_UT_blk_var2(), FLA_QR_UT_Accum_T_blk_var1(), FLA_QR_UT_blk_var2(), FLA_Trmmsx_external(), FLA_Trmvsx_external(), FLA_Trsmsx_external(), FLA_Trsvsx_external(), FLASH_Axpy_hierarchy_r(), and FLASH_Obj_exec_parallel().

00036 {
00037   FLA_Datatype datatype;
00038   int          j, n_iter;
00039   int          num_elem;
00040   int          m_A, n_A, inc_A, ldim_A;
00041   int          m_B,      inc_B, ldim_B;
00042 
00043   if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING ) 
00044     FLA_Axpy_check( alpha, A, B );
00045 
00046   if ( FLA_Obj_has_zero_dim( A ) ) return FLA_SUCCESS;
00047 
00048   datatype = FLA_Obj_datatype( A );
00049 
00050   m_A      = FLA_Obj_length( A );
00051   n_A      = FLA_Obj_width( A );
00052   ldim_A   = FLA_Obj_ldim( A );
00053 
00054   m_B      = FLA_Obj_length( B );
00055   ldim_B   = FLA_Obj_ldim( B );
00056 
00057   if ( FLA_Obj_is_vector( A ) )
00058   {
00059     inc_A    = ( m_A == 1 ? ldim_A : 1 );
00060     inc_B    = ( m_B == 1 ? ldim_B : 1 );
00061     n_iter   = 1;
00062     num_elem = FLA_Obj_vector_dim( A );
00063   }
00064   else
00065   {
00066     inc_A    = 1;
00067     inc_B    = 1;
00068     n_iter   = n_A;
00069     num_elem = m_A;
00070   }
00071 
00072   switch ( datatype ){
00073 
00074   case FLA_FLOAT:
00075   {
00076     float *buff_alpha = ( float * ) FLA_FLOAT_PTR( alpha );
00077     float *buff_A     = ( float * ) FLA_FLOAT_PTR( A );
00078     float *buff_B     = ( float * ) FLA_FLOAT_PTR( B );
00079 
00080     for ( j = 0; j < n_iter; ++j )
00081     {
00082 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00083       cblas_saxpy( num_elem,
00084                    *buff_alpha, 
00085                    buff_A + j*ldim_A, inc_A, 
00086                    buff_B + j*ldim_B, inc_B );
00087 #else
00088       FLA_C2F( saxpy )( &num_elem,
00089                         buff_alpha, 
00090                         buff_A + j*ldim_A, &inc_A, 
00091                         buff_B + j*ldim_B, &inc_B );
00092 #endif
00093     }
00094 
00095     break;
00096   }
00097 
00098   case FLA_DOUBLE:
00099   {
00100     double *buff_alpha = ( double * ) FLA_DOUBLE_PTR( alpha );
00101     double *buff_A     = ( double * ) FLA_DOUBLE_PTR( A );
00102     double *buff_B     = ( double * ) FLA_DOUBLE_PTR( B );
00103 
00104     for ( j = 0; j < n_iter; ++j )
00105     {
00106 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00107       cblas_daxpy( num_elem,
00108                    *buff_alpha, 
00109                    buff_A + j*ldim_A, inc_A, 
00110                    buff_B + j*ldim_B, inc_B );
00111 #else
00112       FLA_C2F( daxpy )( &num_elem,
00113                         buff_alpha, 
00114                         buff_A + j*ldim_A, &inc_A, 
00115                         buff_B + j*ldim_B, &inc_B );
00116 #endif
00117     }
00118 
00119     break;
00120   }
00121 
00122   case FLA_COMPLEX:
00123   {
00124     scomplex *buff_alpha = ( scomplex * ) FLA_COMPLEX_PTR( alpha );
00125     scomplex *buff_A =     ( scomplex * ) FLA_COMPLEX_PTR( A );
00126     scomplex *buff_B =     ( scomplex * ) FLA_COMPLEX_PTR( B );
00127 
00128     for ( j = 0; j < n_iter; ++j )
00129     {
00130 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00131       cblas_caxpy( num_elem,
00132                    *buff_alpha, 
00133                    buff_A + j*ldim_A, inc_A, 
00134                    buff_B + j*ldim_B, inc_B );
00135 #else
00136       FLA_C2F( caxpy )( &num_elem,
00137                         buff_alpha, 
00138                         buff_A + j*ldim_A, &inc_A, 
00139                         buff_B + j*ldim_B, &inc_B );
00140 #endif
00141     }
00142 
00143     break;
00144   }
00145 
00146   case FLA_DOUBLE_COMPLEX:
00147   {
00148     dcomplex *buff_alpha = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( alpha );
00149     dcomplex *buff_A     = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
00150     dcomplex *buff_B     = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( B );
00151 
00152     for ( j = 0; j < n_iter; ++j )
00153     {
00154 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00155       cblas_zaxpy( num_elem,
00156                    *buff_alpha, 
00157                    buff_A + j*ldim_A, inc_A, 
00158                    buff_B + j*ldim_B, inc_B );
00159 #else
00160       FLA_C2F( zaxpy )( &num_elem,
00161                         buff_alpha, 
00162                         buff_A + j*ldim_A, &inc_A, 
00163                         buff_B + j*ldim_B, &inc_B );
00164 #endif
00165     }
00166 
00167     break;
00168   }
00169 
00170   }
00171   
00172   return FLA_SUCCESS;
00173 }

void FLA_F2C() fla_axpy_external_f ( F_INT *  alpha,
F_INT *  A,
F_INT *  B,
F_INT *  IERROR 
)

References FLA_Axpy_external().

00177 {
00178   *IERROR = FLA_Axpy_external( *( ( FLA_Obj * ) alpha ), 
00179                                *( ( FLA_Obj * ) A     ), 
00180                                *( ( FLA_Obj * ) B     ) );
00181 }

void FLA_F2C() fla_axpy_f ( F_INT *  alpha,
F_INT *  A,
F_INT *  B,
F_INT *  IERROR 
)

References FLA_Axpy().

00054 {
00055   *IERROR = FLA_Axpy( *( ( FLA_Obj * ) alpha ),
00056                       *( ( FLA_Obj * ) A     ),
00057                       *( ( FLA_Obj * ) B     ) );
00058 }

FLA_Error FLA_Axpy_internal ( FLA_Obj  alpha,
FLA_Obj  A,
FLA_Obj  B,
fla_axpy_t cntl 
)

Referenced by FLA_Apply_Q_UT_lhc_blk_var1(), FLA_Apply_Q_UT_UD_lhc_blk_var1(), FLA_Axpy(), FLA_Axpy_blk_var1(), FLA_Axpy_blk_var2(), FLA_Axpy_blk_var3(), FLA_Axpy_blk_var4(), FLA_Axpy_internal(), FLA_QR_UT_UD_blk_var1(), and FLASH_Axpy().

00039 {
00040     FLA_Error r_val = FLA_SUCCESS;
00041 
00042     if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING )
00043         FLA_Axpy_internal_check( alpha, A, B, cntl );
00044 
00045     if      ( FLA_Cntl_matrix_type( cntl ) == FLA_HIER &&
00046               FLA_Obj_elemtype( A ) == FLA_MATRIX &&
00047               FLA_Cntl_variant( cntl ) == FLA_SUBPROBLEM )
00048     {
00049         // Recurse
00050         r_val = FLA_Axpy_internal( alpha,
00051                                    *FLASH_OBJ_PTR_AT( A ),
00052                                    *FLASH_OBJ_PTR_AT( B ),
00053                                    flash_axpy_cntl );
00054     }
00055     else if ( FLA_Cntl_matrix_type( cntl ) == FLA_HIER &&
00056               FLA_Obj_elemtype( A ) == FLA_SCALAR &&
00057               FLASH_Queue_get_enabled( ) )
00058     {
00059         // Enqueue
00060         ENQUEUE_FLASH_Axpy( alpha, A, B, cntl );
00061     }
00062     else
00063     {
00064         if ( FLA_Cntl_matrix_type( cntl ) == FLA_HIER &&
00065              FLA_Obj_elemtype( A ) == FLA_SCALAR &&
00066              !FLASH_Queue_get_enabled( ) )
00067         {
00068             // Execute leaf
00069             cntl = flash_axpy_cntl_blas;
00070         }
00071         
00072         // Parameter combinations
00073         if      ( FLA_Cntl_variant( cntl ) == FLA_SUBPROBLEM )
00074         {
00075             r_val = FLA_Axpy_external( alpha, A, B );
00076         }
00077         else if ( FLA_Cntl_variant( cntl ) == FLA_BLOCKED_VARIANT1 )
00078         {
00079             r_val = FLA_Axpy_blk_var1( alpha, A, B, cntl );
00080         }
00081 #ifdef FLA_ENABLE_NON_CRITICAL_CODE
00082         else if ( FLA_Cntl_variant( cntl ) == FLA_BLOCKED_VARIANT2 )
00083         {
00084             r_val = FLA_Axpy_blk_var2( alpha, A, B, cntl );
00085         }
00086 #endif
00087         else if ( FLA_Cntl_variant( cntl ) == FLA_BLOCKED_VARIANT3 )
00088         {
00089             r_val = FLA_Axpy_blk_var3( alpha, A, B, cntl );
00090         }
00091 #ifdef FLA_ENABLE_NON_CRITICAL_CODE
00092         else if ( FLA_Cntl_variant( cntl ) == FLA_BLOCKED_VARIANT4 )
00093         {
00094             r_val = FLA_Axpy_blk_var4( alpha, A, B, cntl );
00095         }
00096 #endif
00097     }
00098 
00099     return r_val;
00100 }

FLA_Error FLA_Axpy_internal_check ( FLA_Obj  alpha,
FLA_Obj  A,
FLA_Obj  B,
fla_axpy_t cntl 
)

References FLA_Check_conformal_dims(), FLA_Check_identical_object_elemtype(), and FLA_Check_null_pointer().

Referenced by FLA_Axpy_internal().

00036 {
00037     FLA_Error e_val;
00038 
00039     // Abort if the control structure is NULL.
00040     e_val = FLA_Check_null_pointer( ( void* ) cntl );
00041     FLA_Check_error_code( e_val );
00042 
00043     // Verify that the object element types are identical.
00044     e_val = FLA_Check_identical_object_elemtype( A, B );
00045     FLA_Check_error_code( e_val );
00046 
00047     // Verify conformality between all the objects. This check works regardless
00048     // of whether the element type is FLA_MATRIX or FLA_SCALAR because the
00049     // element length and width are used instead of scalar length and width.
00050     e_val = FLA_Check_conformal_dims( FLA_NO_TRANSPOSE, A, B );
00051     FLA_Check_error_code( e_val );
00052 
00053     return FLA_SUCCESS;
00054 }

FLA_Error FLA_Axpy_task ( FLA_Obj  alpha,
FLA_Obj  A,
FLA_Obj  B,
fla_axpy_t cntl 
)

References FLA_Axpy_external().

Referenced by FLASH_Queue_exec_task().

00036 {
00037   FLA_Axpy_external( alpha, A, B );
00038 
00039   return FLA_SUCCESS;
00040 }

FLA_Error FLA_Axpys ( FLA_Obj  alpha0,
FLA_Obj  alpha1,
FLA_Obj  A,
FLA_Obj  beta,
FLA_Obj  B 
)

References FLA_Axpys_external().

00036 {
00037     return FLA_Axpys_external( alpha0, alpha1, A, beta, B );
00038 }

FLA_Error FLA_Axpys_check ( FLA_Obj  alpha0,
FLA_Obj  alpha1,
FLA_Obj  A,
FLA_Obj  beta,
FLA_Obj  B 
)

References FLA_Check_conformal_dims(), FLA_Check_consistent_object_datatype(), FLA_Check_floating_object(), FLA_Check_identical_object_datatype(), FLA_Check_if_scalar(), and FLA_Check_nonconstant_object().

Referenced by FLA_Axpys_external().

00036 {
00037   FLA_Error e_val;
00038 
00039   e_val = FLA_Check_floating_object( A );
00040   FLA_Check_error_code( e_val );
00041 
00042   e_val = FLA_Check_nonconstant_object( A );
00043   FLA_Check_error_code( e_val );
00044 
00045   e_val = FLA_Check_identical_object_datatype( A, B );
00046   FLA_Check_error_code( e_val );
00047 
00048   e_val = FLA_Check_consistent_object_datatype( A, alpha0 );
00049   FLA_Check_error_code( e_val );
00050 
00051   e_val = FLA_Check_consistent_object_datatype( A, alpha1 );
00052   FLA_Check_error_code( e_val );
00053 
00054   e_val = FLA_Check_consistent_object_datatype( A, beta );
00055   FLA_Check_error_code( e_val );
00056 
00057   e_val = FLA_Check_if_scalar( alpha0 );
00058   FLA_Check_error_code( e_val );
00059 
00060   e_val = FLA_Check_if_scalar( alpha1 );
00061   FLA_Check_error_code( e_val );
00062 
00063   e_val = FLA_Check_if_scalar( beta );
00064   FLA_Check_error_code( e_val );
00065 
00066   e_val = FLA_Check_conformal_dims( FLA_NO_TRANSPOSE, A, B );
00067   FLA_Check_error_code( e_val );
00068 
00069   return FLA_SUCCESS;
00070 }

FLA_Error FLA_Axpys_external ( FLA_Obj  alpha0,
FLA_Obj  alpha1,
FLA_Obj  A,
FLA_Obj  beta,
FLA_Obj  B 
)

References FLA_Axpy_external(), FLA_Axpys_check(), FLA_Check_error_level(), FLA_Copy_external(), FLA_Copyt_external(), FLA_Obj_create(), FLA_Obj_create_conf_to(), FLA_Obj_datatype(), FLA_Obj_equals(), FLA_Obj_free(), FLA_Obj_is_vector(), FLA_ONE, FLA_Scal_external(), and FLA_ZERO.

Referenced by FLA_Axpys(), fla_axpys_external_f(), FLA_Hemm_ll_unb_var1(), FLA_Hemm_ll_unb_var2(), FLA_Hemm_ll_unb_var3(), FLA_Hemm_ll_unb_var4(), FLA_Hemm_ll_unb_var5(), FLA_Hemm_ll_unb_var6(), FLA_Hemm_ll_unb_var7(), FLA_Hemm_ll_unb_var8(), FLA_Hemm_lu_unb_var1(), FLA_Hemm_lu_unb_var2(), FLA_Hemm_lu_unb_var3(), FLA_Hemm_lu_unb_var4(), FLA_Hemm_lu_unb_var5(), FLA_Hemm_lu_unb_var6(), FLA_Hemm_lu_unb_var7(), FLA_Hemm_lu_unb_var8(), FLA_Hemm_rl_unb_var1(), FLA_Hemm_rl_unb_var2(), FLA_Hemm_rl_unb_var3(), FLA_Hemm_rl_unb_var4(), FLA_Hemm_rl_unb_var5(), FLA_Hemm_rl_unb_var6(), FLA_Hemm_rl_unb_var7(), FLA_Hemm_rl_unb_var8(), FLA_Hemm_ru_unb_var1(), FLA_Hemm_ru_unb_var2(), FLA_Hemm_ru_unb_var3(), FLA_Hemm_ru_unb_var4(), FLA_Hemm_ru_unb_var5(), FLA_Hemm_ru_unb_var6(), FLA_Hemm_ru_unb_var7(), FLA_Hemm_ru_unb_var8(), FLA_Symm_ll_unb_var1(), FLA_Symm_ll_unb_var2(), FLA_Symm_ll_unb_var3(), FLA_Symm_ll_unb_var4(), FLA_Symm_ll_unb_var5(), FLA_Symm_ll_unb_var6(), FLA_Symm_ll_unb_var7(), FLA_Symm_ll_unb_var8(), FLA_Symm_lu_unb_var1(), FLA_Symm_lu_unb_var2(), FLA_Symm_lu_unb_var3(), FLA_Symm_lu_unb_var4(), FLA_Symm_lu_unb_var5(), FLA_Symm_lu_unb_var6(), FLA_Symm_lu_unb_var7(), FLA_Symm_lu_unb_var8(), FLA_Symm_rl_unb_var1(), FLA_Symm_rl_unb_var2(), FLA_Symm_rl_unb_var3(), FLA_Symm_rl_unb_var4(), FLA_Symm_rl_unb_var5(), FLA_Symm_rl_unb_var6(), FLA_Symm_rl_unb_var7(), FLA_Symm_rl_unb_var8(), FLA_Symm_ru_unb_var1(), FLA_Symm_ru_unb_var2(), FLA_Symm_ru_unb_var3(), FLA_Symm_ru_unb_var4(), FLA_Symm_ru_unb_var5(), FLA_Symm_ru_unb_var6(), FLA_Symm_ru_unb_var7(), and FLA_Symm_ru_unb_var8().

00036 {
00037   FLA_Obj   A_copy;
00038   FLA_Obj   alpha_copy;
00039 
00040   if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING )
00041     FLA_Axpys_check( alpha0, alpha1, A, beta, B );
00042 
00043   if ( FLA_Obj_equals( beta, FLA_ONE ) == FALSE  )
00044     FLA_Scal_external( beta, B );
00045 
00046   if ( FLA_Obj_equals( alpha0, FLA_ZERO ) || 
00047        FLA_Obj_equals( alpha1, FLA_ZERO ) )
00048     return FLA_SUCCESS;
00049 
00050   if ( FLA_Obj_is_vector( A ) )
00051   {
00052     FLA_Obj_create( FLA_Obj_datatype( A ), 1, 1, &alpha_copy );
00053 
00054     FLA_Copy_external( alpha1, alpha_copy );
00055 
00056     FLA_Scal_external( alpha0, alpha_copy );
00057 
00058     FLA_Axpy_external( alpha_copy, A, B );
00059 
00060     FLA_Obj_free( &alpha_copy );
00061   }
00062   else
00063   {
00064     FLA_Obj_create_conf_to( FLA_NO_TRANSPOSE, A, &A_copy );
00065 
00066     FLA_Copyt_external( FLA_NO_TRANSPOSE, A, A_copy );
00067 
00068     FLA_Scal_external( alpha0, A_copy );
00069 
00070     FLA_Axpy_external( alpha1, A_copy, B );
00071 
00072     FLA_Obj_free( &A_copy );
00073   }
00074 
00075   return FLA_SUCCESS;
00076 }

void FLA_F2C() fla_axpys_external_f ( F_INT *  alpha0,
F_INT *  alpha1,
F_INT *  A,
F_INT *  beta,
F_INT *  B,
F_INT *  IERROR 
)

References FLA_Axpys_external().

00080 {
00081   *IERROR = FLA_Axpys_external( *( ( FLA_Obj * ) alpha0 ),
00082                                 *( ( FLA_Obj * ) alpha1 ),
00083                                 *( ( FLA_Obj * ) A      ),
00084                                 *( ( FLA_Obj * ) beta   ),
00085                                 *( ( FLA_Obj * ) B      ) );
00086 }

FLA_Error FLA_Axpyt ( FLA_Trans  trans,
FLA_Obj  alpha,
FLA_Obj  A,
FLA_Obj  B 
)

References FLA_Axpyt_external().

00036 {
00037     return FLA_Axpyt_external( trans, alpha, A, B );
00038 }

FLA_Error FLA_Axpyt_check ( FLA_Trans  trans,
FLA_Obj  alpha,
FLA_Obj  A,
FLA_Obj  B 
)

References FLA_Check_conformal_dims(), FLA_Check_consistent_object_datatype(), FLA_Check_equal_vector_lengths(), FLA_Check_floating_object(), FLA_Check_identical_object_datatype(), FLA_Check_if_scalar(), FLA_Check_nonconstant_object(), FLA_Check_valid_trans(), and FLA_Obj_is_vector().

Referenced by FLA_Axpyt_external().

00036 {
00037   FLA_Error e_val;
00038 
00039   e_val = FLA_Check_valid_trans( trans );
00040   FLA_Check_error_code( e_val );
00041 
00042   e_val = FLA_Check_floating_object( A );
00043   FLA_Check_error_code( e_val );
00044 
00045   e_val = FLA_Check_nonconstant_object( A );
00046   FLA_Check_error_code( e_val );
00047 
00048   e_val = FLA_Check_identical_object_datatype( A, B );
00049   FLA_Check_error_code( e_val );
00050 
00051   e_val = FLA_Check_consistent_object_datatype( A, alpha );
00052   FLA_Check_error_code( e_val );
00053 
00054   e_val = FLA_Check_if_scalar( alpha );
00055   FLA_Check_error_code( e_val );
00056 
00057   if ( FLA_Obj_is_vector( A ) && FLA_Obj_is_vector( B ) )
00058   {
00059     e_val = FLA_Check_equal_vector_lengths( A, B );
00060     FLA_Check_error_code( e_val );
00061   }
00062   else
00063   {
00064     e_val = FLA_Check_conformal_dims( trans, A, B );
00065     FLA_Check_error_code( e_val );
00066   }
00067 
00068   return FLA_SUCCESS;
00069 }

FLA_Error FLA_Axpyt_external ( FLA_Trans  trans,
FLA_Obj  alpha,
FLA_Obj  A,
FLA_Obj  B 
)

References FLA_Axpy_external(), FLA_Axpyt_check(), FLA_Check_error_level(), FLA_Copyt_external(), FLA_Obj_create_conf_to(), FLA_Obj_free(), and FLA_Obj_is_vector().

Referenced by FLA_Axpy_global_to_submatrix(), FLA_Axpy_submatrix_to_global(), FLA_Axpyt(), fla_axpyt_external_f(), and FLA_LQ_UT_Accum_T_blk_var1().

00036 {
00037   FLA_Obj   A_copy;
00038   FLA_Trans trans_real;
00039   FLA_Trans trans_conj;
00040 
00041   if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING ) 
00042     FLA_Axpyt_check( trans, alpha, A, B );
00043 
00044   if ( FLA_Obj_is_vector( A ) )
00045   {
00046     trans_conj = FLA_TRANS_MAP_TO_NC( trans );
00047 
00048     FLA_Obj_create_conf_to( FLA_NO_TRANSPOSE, A, &A_copy );
00049 
00050     FLA_Copyt_external( trans_conj, A, A_copy );
00051 
00052     FLA_Axpy_external( alpha, A_copy, B );
00053 
00054     FLA_Obj_free( &A_copy );
00055   }
00056   else
00057   {
00058     trans_real = FLA_TRANS_MAP_TO_NT( trans );
00059 
00060     FLA_Obj_create_conf_to( trans_real, A, &A_copy );
00061 
00062     FLA_Copyt_external( trans, A, A_copy );
00063 
00064     FLA_Axpy_external( alpha, A_copy, B );
00065 
00066     FLA_Obj_free( &A_copy );
00067   }
00068 
00069   return FLA_SUCCESS;
00070 }

void FLA_F2C() fla_axpyt_external_f ( F_INT *  trans,
F_INT *  alpha,
F_INT *  A,
F_INT *  B,
F_INT *  IERROR 
)

References FLA_Axpyt_external().

00074 {
00075   *IERROR = FLA_Axpyt_external( *( ( FLA_Trans * ) trans ), 
00076                                 *( ( FLA_Obj   * ) alpha ), 
00077                                 *( ( FLA_Obj   * ) A     ), 
00078                                 *( ( FLA_Obj   * ) B     ) );
00079 }

void FLA_F2C() fla_cdotc ( int *  n,
scomplex x,
int *  incx,
scomplex y,
int *  incy,
scomplex rval 
)

void FLA_F2C() fla_cdotu ( int *  n,
scomplex x,
int *  incx,
scomplex y,
int *  incy,
scomplex rval 
)

FLA_Error FLA_Copy ( FLA_Obj  A,
FLA_Obj  B 
)

References FLA_Check_error_level(), FLA_Copy_check(), FLA_Copy_external(), and FLA_Copy_internal().

Referenced by fla_copy_f().

00036 {
00037     return FLA_Copy_external( A, B );
00038 }

FLA_Error FLA_Copy_check ( FLA_Obj  A,
FLA_Obj  B 
)

References FLA_Check_conformal_dims(), FLA_Check_consistent_object_datatype(), FLA_Check_equal_vector_lengths(), FLA_Check_nonconstant_object(), FLA_Check_valid_object_datatype(), and FLA_Obj_is_vector().

Referenced by FLA_Copy(), FLA_Copy_external(), and FLASH_Copy().

00036 {
00037   FLA_Error e_val;
00038 
00039   e_val = FLA_Check_valid_object_datatype( A );
00040   FLA_Check_error_code( e_val );
00041 
00042   e_val = FLA_Check_nonconstant_object( B );
00043   FLA_Check_error_code( e_val );
00044 
00045   e_val = FLA_Check_consistent_object_datatype( A, B );
00046   FLA_Check_error_code( e_val );
00047 
00048   if ( FLA_Obj_is_vector( A ) && FLA_Obj_is_vector( B ) )
00049   {
00050     e_val = FLA_Check_equal_vector_lengths( A, B );
00051     FLA_Check_error_code( e_val );
00052   }
00053   else
00054   {
00055     e_val = FLA_Check_conformal_dims( FLA_NO_TRANSPOSE, A, B );
00056     FLA_Check_error_code( e_val );
00057   }
00058 
00059   return FLA_SUCCESS;
00060 }

FLA_Error FLA_Copy_external ( FLA_Obj  A,
FLA_Obj  B 
)

References cblas_ccopy(), cblas_dcopy(), cblas_scopy(), cblas_zcopy(), ccopy(), dcopy(), FLA_Check_error_level(), FLA_Copy_check(), FLA_Obj_datatype(), FLA_Obj_has_zero_dim(), FLA_Obj_is_vector(), FLA_Obj_ldim(), FLA_Obj_length(), FLA_Obj_vector_dim(), FLA_Obj_width(), scopy(), and zcopy().

Referenced by FLA_Accum_T_UT_fc_unb_var1(), FLA_Apply_househ2_UT(), FLA_Axpys_external(), FLA_Copy(), fla_copy_external_f(), FLA_Copy_internal(), FLA_Copy_task(), FLA_LQ_UT_Accum_T_blk_var1(), FLA_LQ_UT_blk_var2(), FLA_LQ_UT_recover_tau_submatrix(), FLA_LU_piv_copy_task(), FLA_QR_UT_Accum_T_blk_var1(), FLA_QR_UT_blk_var2(), FLA_QR_UT_recover_tau_submatrix(), FLA_SA_LU_unb(), FLA_Trmmsx_external(), FLA_Trmvsx_external(), FLA_Trsmsx_external(), FLA_Trsvsx_external(), FLASH_Copy_hierarchy_r(), and FLASH_Obj_exec_parallel().

00036 {
00037   FLA_Datatype datatype;
00038   int          j, n_iter;
00039   int          num_elem;
00040   int          m_A, n_A, inc_A, ldim_A;
00041   int          m_B,      inc_B, ldim_B;
00042 
00043   if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING ) 
00044     FLA_Copy_check( A, B );
00045 
00046   if ( FLA_Obj_has_zero_dim( A ) ) return FLA_SUCCESS;
00047 
00048   // It is important that we get the datatype of B and not A, since A could
00049   // be an FLA_CONSTANT.
00050   datatype = FLA_Obj_datatype( B );
00051 
00052   m_A      = FLA_Obj_length( A );
00053   n_A      = FLA_Obj_width( A );
00054   ldim_A   = FLA_Obj_ldim( A );
00055 
00056   m_B      = FLA_Obj_length( B );
00057   ldim_B   = FLA_Obj_ldim( B );
00058 
00059   if ( FLA_Obj_is_vector( A ) )
00060   {
00061     inc_A    = ( m_A == 1 ? ldim_A : 1 );
00062     inc_B    = ( m_B == 1 ? ldim_B : 1 );
00063     n_iter   = 1;
00064     num_elem = FLA_Obj_vector_dim( A );
00065   }
00066   else
00067   {
00068     inc_A    = 1;
00069     inc_B    = 1;
00070     n_iter   = n_A;
00071     num_elem = m_A;
00072   }
00073 
00074   switch ( datatype ){
00075 
00076   case FLA_INT:
00077   case FLA_FLOAT:
00078   {
00079     float *buff_A = ( float * ) FLA_FLOAT_PTR( A );
00080     float *buff_B = ( float * ) FLA_FLOAT_PTR( B );
00081 
00082     for ( j = 0; j < n_iter; ++j )
00083     {
00084 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00085       cblas_scopy( num_elem,
00086                    buff_A + j*ldim_A, inc_A,
00087                    buff_B + j*ldim_B, inc_B );
00088 #else
00089       FLA_C2F( scopy )( &num_elem,
00090                         buff_A + j*ldim_A, &inc_A,
00091                         buff_B + j*ldim_B, &inc_B );
00092 #endif
00093     }
00094 
00095     break;
00096   }
00097 
00098   case FLA_DOUBLE:
00099   {
00100     double *buff_A = ( double * ) FLA_DOUBLE_PTR( A );
00101     double *buff_B = ( double * ) FLA_DOUBLE_PTR( B );
00102 
00103     for ( j = 0; j < n_iter; ++j )
00104     {
00105 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00106       cblas_dcopy( num_elem,
00107                    buff_A + j*ldim_A, inc_A,
00108                    buff_B + j*ldim_B, inc_B );
00109 #else
00110       FLA_C2F( dcopy )( &num_elem,
00111                         buff_A + j*ldim_A, &inc_A,
00112                         buff_B + j*ldim_B, &inc_B );
00113 #endif
00114     }
00115 
00116     break;
00117   }
00118 
00119   case FLA_COMPLEX:
00120   {
00121     scomplex *buff_A = ( scomplex * ) FLA_COMPLEX_PTR( A );
00122     scomplex *buff_B = ( scomplex * ) FLA_COMPLEX_PTR( B );
00123 
00124     for ( j = 0; j < n_iter; ++j )
00125     {
00126 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00127       cblas_ccopy( num_elem,
00128                    buff_A + j*ldim_A, inc_A,
00129                    buff_B + j*ldim_B, inc_B );
00130 #else
00131       FLA_C2F( ccopy )( &num_elem,
00132                         buff_A + j*ldim_A, &inc_A,
00133                         buff_B + j*ldim_B, &inc_B );
00134 #endif
00135     }
00136 
00137     break;
00138   }
00139 
00140   case FLA_DOUBLE_COMPLEX:
00141   {
00142     dcomplex *buff_A = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
00143     dcomplex *buff_B = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( B );
00144  
00145     for ( j = 0; j < n_iter; ++j )
00146     {
00147 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00148       cblas_zcopy( num_elem,
00149                    buff_A + j*ldim_A, inc_A,
00150                    buff_B + j*ldim_B, inc_B );
00151 #else
00152       FLA_C2F( zcopy )( &num_elem,
00153                         buff_A + j*ldim_A, &inc_A,
00154                         buff_B + j*ldim_B, &inc_B );
00155 #endif
00156     }
00157 
00158     break;
00159   }
00160 
00161   }
00162   
00163   return FLA_SUCCESS;
00164 }

void FLA_F2C() fla_copy_external_f ( F_INT *  A,
F_INT *  B,
F_INT *  IERROR 
)

References FLA_Copy_external().

00168 {
00169   *IERROR = FLA_Copy_external( *( ( FLA_Obj * ) A ),
00170                                *( ( FLA_Obj * ) B ) );
00171 }

void FLA_F2C() fla_copy_f ( F_INT *  A,
F_INT *  B,
F_INT *  IERROR 
)

References FLA_Copy().

00054 {
00055   *IERROR = FLA_Copy( *( ( FLA_Obj * ) A ),
00056                       *( ( FLA_Obj * ) B ) );
00057 }

FLA_Error FLA_Copy_internal ( FLA_Obj  A,
FLA_Obj  B,
fla_copy_t cntl 
)

Referenced by FLA_Apply_Q_UT_lhc_blk_var1(), FLA_Apply_Q_UT_UD_lhc_blk_var1(), FLA_Copy(), FLA_Copy_blk_var1(), FLA_Copy_blk_var2(), FLA_Copy_blk_var3(), FLA_Copy_blk_var4(), FLA_Copy_internal(), FLA_QR_UT_UD_blk_var1(), and FLASH_Copy().

00039 {
00040     FLA_Error r_val = FLA_SUCCESS;
00041 
00042     if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING )
00043         FLA_Copy_internal_check( A, B, cntl );
00044 
00045     if      ( FLA_Cntl_matrix_type( cntl ) == FLA_HIER &&
00046               FLA_Obj_elemtype( A ) == FLA_MATRIX &&
00047               FLA_Cntl_variant( cntl ) == FLA_SUBPROBLEM )
00048     {
00049         // Recurse
00050         r_val = FLA_Copy_internal( *FLASH_OBJ_PTR_AT( A ),
00051                                    *FLASH_OBJ_PTR_AT( B ),
00052                                    flash_copy_cntl );
00053     }
00054     else if ( FLA_Cntl_matrix_type( cntl ) == FLA_HIER &&
00055               FLA_Obj_elemtype( A ) == FLA_SCALAR &&
00056               FLASH_Queue_get_enabled( ) )
00057     {
00058         // Enqueue
00059         ENQUEUE_FLASH_Copy( A, B, cntl );
00060     }
00061     else
00062     {
00063         if ( FLA_Cntl_matrix_type( cntl ) == FLA_HIER &&
00064              FLA_Obj_elemtype( A ) == FLA_SCALAR &&
00065              !FLASH_Queue_get_enabled( ) )
00066         {
00067             // Execute leaf
00068             cntl = flash_copy_cntl_blas;
00069         }
00070         
00071         // Parameter combinations
00072         if      ( FLA_Cntl_variant( cntl ) == FLA_SUBPROBLEM )
00073         {
00074             r_val = FLA_Copy_external( A, B );
00075         }
00076         else if ( FLA_Cntl_variant( cntl ) == FLA_BLOCKED_VARIANT1 )
00077         {
00078             r_val = FLA_Copy_blk_var1( A, B, cntl );
00079         }
00080 #ifdef FLA_ENABLE_NON_CRITICAL_CODE
00081         else if ( FLA_Cntl_variant( cntl ) == FLA_BLOCKED_VARIANT2 )
00082         {
00083             r_val = FLA_Copy_blk_var2( A, B, cntl );
00084         }
00085 #endif
00086         else if ( FLA_Cntl_variant( cntl ) == FLA_BLOCKED_VARIANT3 )
00087         {
00088             r_val = FLA_Copy_blk_var3( A, B, cntl );
00089         }
00090 #ifdef FLA_ENABLE_NON_CRITICAL_CODE
00091         else if ( FLA_Cntl_variant( cntl ) == FLA_BLOCKED_VARIANT4 )
00092         {
00093             r_val = FLA_Copy_blk_var4( A, B, cntl );
00094         }
00095 #endif
00096     }
00097 
00098     return r_val;
00099 }

FLA_Error FLA_Copy_internal_check ( FLA_Obj  A,
FLA_Obj  B,
fla_copy_t cntl 
)

References FLA_Check_conformal_dims(), FLA_Check_identical_object_elemtype(), and FLA_Check_null_pointer().

Referenced by FLA_Copy_internal().

00036 {
00037     FLA_Error e_val;
00038 
00039     // Abort if the control structure is NULL.
00040     e_val = FLA_Check_null_pointer( ( void* ) cntl );
00041     FLA_Check_error_code( e_val );
00042 
00043     // Verify that the object element types are identical.
00044     e_val = FLA_Check_identical_object_elemtype( A, B );
00045     FLA_Check_error_code( e_val );
00046 
00047     // Verify conformality between all the objects. This check works regardless
00048     // of whether the element type is FLA_MATRIX or FLA_SCALAR because the
00049     // element length and width are used instead of scalar length and width.
00050     e_val = FLA_Check_conformal_dims( FLA_NO_TRANSPOSE, A, B );
00051     FLA_Check_error_code( e_val );
00052 
00053     return FLA_SUCCESS;
00054 }

FLA_Error FLA_Copy_task ( FLA_Obj  A,
FLA_Obj  B,
fla_copy_t cntl 
)

References FLA_Copy_external().

Referenced by FLASH_Queue_exec_task().

00036 {
00037   FLA_Copy_external( A, B );
00038 
00039   return FLA_SUCCESS;
00040 }

FLA_Error FLA_Copyr ( FLA_Uplo  uplo,
FLA_Obj  A,
FLA_Obj  B 
)

References FLA_Copyr_external().

00036 {
00037     return FLA_Copyr_external( uplo, A, B );
00038 }

FLA_Error FLA_Copyr_check ( FLA_Uplo  uplo,
FLA_Obj  A,
FLA_Obj  B 
)

References FLA_Check_conformal_dims(), FLA_Check_consistent_object_datatype(), FLA_Check_nonconstant_object(), FLA_Check_square(), FLA_Check_valid_object_datatype(), and FLA_Check_valid_uplo().

Referenced by FLA_Copyr_external().

00036 {
00037   FLA_Error e_val;
00038 
00039   e_val = FLA_Check_valid_uplo( uplo );
00040   FLA_Check_error_code( e_val );
00041 
00042   e_val = FLA_Check_valid_object_datatype( A );
00043   FLA_Check_error_code( e_val );
00044 
00045   e_val = FLA_Check_nonconstant_object( B );
00046   FLA_Check_error_code( e_val );
00047 
00048   e_val = FLA_Check_consistent_object_datatype( A, B );
00049   FLA_Check_error_code( e_val );
00050 
00051   e_val = FLA_Check_square( A );
00052   FLA_Check_error_code( e_val );
00053 
00054   e_val = FLA_Check_conformal_dims( FLA_NO_TRANSPOSE, A, B );
00055   FLA_Check_error_code( e_val );
00056 
00057   return FLA_SUCCESS;
00058 }

FLA_Error FLA_Copyr_external ( FLA_Uplo  uplo,
FLA_Obj  A,
FLA_Obj  B 
)

References cblas_ccopy(), cblas_dcopy(), cblas_scopy(), cblas_zcopy(), ccopy(), dcopy(), FLA_Check_error_level(), FLA_Copyr_check(), FLA_Obj_datatype(), FLA_Obj_has_zero_dim(), FLA_Obj_ldim(), FLA_Obj_length(), FLA_Obj_width(), scopy(), and zcopy().

Referenced by FLA_Copyr(), fla_copyr_external_f(), and FLA_QR_UT_copy_task().

00036 {
00037   FLA_Datatype datatype;
00038   int          j, n_iter;
00039   int          num_elem;
00040   int          m_A, n_A, inc_A, ldim_A;
00041   int          m_B,      inc_B, ldim_B;
00042 
00043   if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING ) 
00044     FLA_Copyr_check( uplo, A, B );
00045 
00046   if ( FLA_Obj_has_zero_dim( A ) ) return FLA_SUCCESS;
00047 
00048   datatype = FLA_Obj_datatype( A );
00049 
00050   m_A      = FLA_Obj_length( A );
00051   n_A      = FLA_Obj_width( A );
00052   ldim_A   = FLA_Obj_ldim( A );
00053 
00054   m_B      = FLA_Obj_length( B );
00055   ldim_B   = FLA_Obj_ldim( B );
00056 
00057   inc_A    = 1;
00058   inc_B    = 1;
00059   n_iter   = n_A;
00060 
00061 
00062   switch ( datatype ){
00063 
00064   case FLA_INT:
00065   case FLA_FLOAT:
00066   {
00067     float *buff_A = ( float * ) FLA_FLOAT_PTR( A );
00068     float *buff_B = ( float * ) FLA_FLOAT_PTR( B );
00069 
00070     if ( uplo == FLA_LOWER_TRIANGULAR )
00071     {
00072       for ( j = 0; j < n_A; ++j )
00073       {
00074         num_elem = n_A - j;
00075 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00076         cblas_scopy( num_elem,
00077                      buff_A + j*ldim_A + j, inc_A, 
00078                      buff_B + j*ldim_B + j, inc_B );
00079 #else
00080         FLA_C2F( scopy )( &num_elem,
00081                           buff_A + j*ldim_A + j, &inc_A, 
00082                           buff_B + j*ldim_B + j, &inc_B );
00083 #endif
00084       }
00085     }
00086     else
00087     {
00088       for ( j = 0; j < n_A; ++j )
00089       {
00090         num_elem = j + 1;
00091 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00092         cblas_scopy( num_elem,
00093                      buff_A + j*ldim_A, inc_A, 
00094                      buff_B + j*ldim_B, inc_B );
00095 #else
00096         FLA_C2F( scopy )( &num_elem,
00097                           buff_A + j*ldim_A, &inc_A, 
00098                           buff_B + j*ldim_B, &inc_B );
00099 #endif
00100       }
00101     }
00102 
00103     break;
00104   }
00105 
00106   case FLA_DOUBLE:
00107   {
00108     double *buff_A = ( double * ) FLA_DOUBLE_PTR( A );
00109     double *buff_B = ( double * ) FLA_DOUBLE_PTR( B );
00110 
00111     if ( uplo == FLA_LOWER_TRIANGULAR )
00112     {
00113       for ( j = 0; j < n_A; ++j )
00114       {
00115         num_elem = n_A - j;
00116 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00117         cblas_dcopy( num_elem,
00118                      buff_A + j*ldim_A + j, inc_A, 
00119                      buff_B + j*ldim_B + j, inc_B );
00120 #else
00121         FLA_C2F( dcopy )( &num_elem,
00122                           buff_A + j*ldim_A + j, &inc_A, 
00123                           buff_B + j*ldim_B + j, &inc_B );
00124 #endif
00125       }
00126     }
00127     else
00128     {
00129       for ( j = 0; j < n_A; ++j )
00130       {
00131         num_elem = j + 1;
00132 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00133         cblas_dcopy( num_elem,
00134                      buff_A + j*ldim_A, inc_A, 
00135                      buff_B + j*ldim_B, inc_B );
00136 #else
00137         FLA_C2F( dcopy )( &num_elem,
00138                           buff_A + j*ldim_A, &inc_A, 
00139                           buff_B + j*ldim_B, &inc_B );
00140 #endif
00141       }
00142     }
00143 
00144     break;
00145   }
00146 
00147   case FLA_COMPLEX:
00148   {
00149     scomplex *buff_A = ( scomplex * ) FLA_COMPLEX_PTR( A );
00150     scomplex *buff_B = ( scomplex * ) FLA_COMPLEX_PTR( B );
00151 
00152     if ( uplo == FLA_LOWER_TRIANGULAR )
00153     {
00154       for ( j = 0; j < n_A; ++j )
00155       {
00156         num_elem = n_A - j;
00157 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00158         cblas_ccopy( num_elem,
00159                      buff_A + j*ldim_A + j, inc_A, 
00160                      buff_B + j*ldim_B + j, inc_B );
00161 #else
00162         FLA_C2F( ccopy )( &num_elem,
00163                           buff_A + j*ldim_A + j, &inc_A, 
00164                           buff_B + j*ldim_B + j, &inc_B );
00165 #endif
00166       }
00167     }
00168     else
00169     {
00170       for ( j = 0; j < n_A; ++j )
00171       {
00172         num_elem = j + 1;
00173 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00174         cblas_ccopy( num_elem,
00175                      buff_A + j*ldim_A, inc_A, 
00176                      buff_B + j*ldim_B, inc_B );
00177 #else
00178         FLA_C2F( ccopy )( &num_elem,
00179                           buff_A + j*ldim_A, &inc_A, 
00180                           buff_B + j*ldim_B, &inc_B );
00181 #endif
00182       }
00183     }
00184 
00185     break;
00186   }
00187 
00188   case FLA_DOUBLE_COMPLEX:
00189   {
00190     dcomplex *buff_A = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
00191     dcomplex *buff_B = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( B );
00192 
00193     if ( uplo == FLA_LOWER_TRIANGULAR )
00194     {
00195       for ( j = 0; j < n_A; ++j )
00196       {
00197         num_elem = n_A - j;
00198 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00199         cblas_zcopy( num_elem,
00200                      buff_A + j*ldim_A + j, inc_A, 
00201                      buff_B + j*ldim_B + j, inc_B );
00202 #else
00203         FLA_C2F( zcopy )( &num_elem,
00204                           buff_A + j*ldim_A + j, &inc_A, 
00205                           buff_B + j*ldim_B + j, &inc_B );
00206 #endif
00207       }
00208     }
00209     else
00210     {
00211       for ( j = 0; j < n_A; ++j )
00212       {
00213         num_elem = j + 1;
00214 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00215         cblas_zcopy( num_elem,
00216                      buff_A + j*ldim_A, inc_A, 
00217                      buff_B + j*ldim_B, inc_B );
00218 #else
00219         FLA_C2F( zcopy )( &num_elem,
00220                           buff_A + j*ldim_A, &inc_A, 
00221                           buff_B + j*ldim_B, &inc_B );
00222 #endif
00223       }
00224     }
00225 
00226     break;
00227   }
00228 
00229   }
00230   
00231   return FLA_SUCCESS;
00232 }

void FLA_F2C() fla_copyr_external_f ( F_INT *  uplo,
F_INT *  A,
F_INT *  B,
F_INT *  IERROR 
)

References FLA_Copyr_external().

00236 {
00237   *IERROR = FLA_Copyr_external( *( ( FLA_Uplo * ) uplo ),
00238                                 *( ( FLA_Obj  * ) A    ),
00239                                 *( ( FLA_Obj  * ) B    ) );
00240 }

FLA_Error FLA_Copyt ( FLA_Trans  trans,
FLA_Obj  A,
FLA_Obj  B 
)

References FLA_Copyt_external().

00036 {
00037     return FLA_Copyt_external( trans, A, B );
00038 }

FLA_Error FLA_Copyt_check ( FLA_Trans  trans,
FLA_Obj  A,
FLA_Obj  B 
)

References FLA_Check_conformal_dims(), FLA_Check_consistent_object_datatype(), FLA_Check_equal_vector_lengths(), FLA_Check_nonconstant_object(), FLA_Check_valid_object_datatype(), FLA_Check_valid_trans(), and FLA_Obj_is_vector().

Referenced by FLA_Copyt_external().

00036 {
00037   FLA_Error e_val;
00038 
00039   e_val = FLA_Check_valid_trans( trans );
00040   FLA_Check_error_code( e_val );
00041 
00042   e_val = FLA_Check_valid_object_datatype( A );
00043   FLA_Check_error_code( e_val );
00044 
00045   e_val = FLA_Check_nonconstant_object( B );
00046   FLA_Check_error_code( e_val );
00047 
00048   e_val = FLA_Check_consistent_object_datatype( A, B );
00049   FLA_Check_error_code( e_val );
00050 
00051   if ( FLA_Obj_is_vector( A ) && FLA_Obj_is_vector( B ) )
00052   {
00053     e_val = FLA_Check_equal_vector_lengths( A, B );
00054     FLA_Check_error_code( e_val );
00055   }
00056   else
00057   {
00058     e_val = FLA_Check_conformal_dims( trans, A, B );
00059     FLA_Check_error_code( e_val );
00060   }
00061 
00062   return FLA_SUCCESS;
00063 }

FLA_Error FLA_Copyt_external ( FLA_Trans  trans,
FLA_Obj  A,
FLA_Obj  B 
)

References cblas_ccopy(), cblas_dcopy(), cblas_scopy(), cblas_zcopy(), ccopy(), dcopy(), FLA_Check_error_level(), FLA_Conjugate(), FLA_Copyt_check(), FLA_Obj_datatype(), FLA_Obj_has_zero_dim(), FLA_Obj_is_vector(), FLA_Obj_ldim(), FLA_Obj_length(), FLA_Obj_vector_dim(), FLA_Obj_width(), scopy(), and zcopy().

Referenced by FLA_Accum_T_UT_fc_unb_var1(), FLA_Axpys_external(), FLA_Axpyt_external(), FLA_Copy_global_to_submatrix(), FLA_Copy_submatrix_to_global(), FLA_Copyt(), fla_copyt_external_f(), FLA_Gemm_external(), FLA_Gemv_external(), FLA_Gemvc_external(), FLA_Gerc_external(), FLA_Hemvc_external(), FLA_Her2c_external(), FLA_Herc_external(), FLA_LQ_UT_Accum_T_blk_var1(), FLA_QR_UT_Accum_T_blk_var1(), FLA_QR_UT_Accum_T_unb_var1(), FLA_Trmm_external(), FLA_Trmv_external(), FLA_Trsm_external(), and FLA_Trsv_external().

00036 {
00037   FLA_Datatype datatype;
00038   int          j, n_iter;
00039   int          num_elem;
00040   int          m_A, n_A, inc_A, ldim_A;
00041   int          m_B,      inc_B, ldim_B;
00042   int          ldim_B_trans, inc_B_trans;
00043 
00044   if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING ) 
00045     FLA_Copyt_check( trans, A, B );
00046 
00047   if ( FLA_Obj_has_zero_dim( A ) ) return FLA_SUCCESS;
00048 
00049   datatype = FLA_Obj_datatype( A );
00050 
00051   m_A      = FLA_Obj_length( A );
00052   n_A      = FLA_Obj_width( A );
00053   ldim_A   = FLA_Obj_ldim( A );
00054 
00055   m_B      = FLA_Obj_length( B );
00056   ldim_B   = FLA_Obj_ldim( B );
00057 
00058   if ( FLA_Obj_is_vector( A ) )
00059   {
00060     inc_A    = ( m_A == 1 ? ldim_A : 1 );
00061     inc_B    = ( m_B == 1 ? ldim_B : 1 );
00062     n_iter   = 1;
00063     num_elem = FLA_Obj_vector_dim( A );
00064 
00065     ldim_B_trans = ldim_B;
00066     inc_B_trans  = inc_B;
00067   }
00068   else
00069   {
00070     inc_A    = 1;
00071     inc_B    = 1;
00072     n_iter   = n_A;
00073     num_elem = m_A;
00074 
00075     if ( trans == FLA_NO_TRANSPOSE || trans == FLA_CONJ_NO_TRANSPOSE )
00076     {
00077       ldim_B_trans = ldim_B;
00078       inc_B_trans  = inc_B;
00079     }
00080     else // ( trans == FLA_TRANSPOSE || trans == FLA_CONJ_TRANSPOSE )
00081     {
00082       ldim_B_trans = inc_B;
00083       inc_B_trans  = ldim_B;
00084     }
00085   }
00086 
00087 
00088   switch ( datatype ){
00089 
00090   case FLA_INT:
00091   case FLA_FLOAT:
00092   {
00093     float *buff_A = ( float * ) FLA_FLOAT_PTR( A );
00094     float *buff_B = ( float * ) FLA_FLOAT_PTR( B );
00095 
00096     for ( j = 0; j < n_iter; j++ )
00097     {
00098 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00099       cblas_scopy( num_elem,
00100                    buff_A + j*ldim_A,       inc_A, 
00101                    buff_B + j*ldim_B_trans, inc_B_trans );
00102 #else
00103       FLA_C2F( scopy )( &num_elem,
00104                         buff_A + j*ldim_A,       &inc_A, 
00105                         buff_B + j*ldim_B_trans, &inc_B_trans );
00106 #endif
00107     }
00108 
00109     break;
00110   }
00111 
00112   case FLA_DOUBLE:
00113   {
00114     double *buff_A = ( double * ) FLA_DOUBLE_PTR( A );
00115     double *buff_B = ( double * ) FLA_DOUBLE_PTR( B );
00116 
00117     for ( j = 0; j < n_iter; j++ )
00118     {
00119 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00120       cblas_dcopy( num_elem,
00121                    buff_A + j*ldim_A,       inc_A, 
00122                    buff_B + j*ldim_B_trans, inc_B_trans );
00123 #else
00124       FLA_C2F( dcopy )( &num_elem,
00125                         buff_A + j*ldim_A,       &inc_A, 
00126                         buff_B + j*ldim_B_trans, &inc_B_trans );
00127 #endif
00128     }
00129 
00130     break;
00131   }
00132 
00133   case FLA_COMPLEX:
00134   {
00135     scomplex *buff_A = ( scomplex * ) FLA_COMPLEX_PTR( A );
00136     scomplex *buff_B = ( scomplex * ) FLA_COMPLEX_PTR( B );
00137 
00138     for ( j = 0; j < n_iter; j++ )
00139     {
00140 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00141       cblas_ccopy( num_elem,
00142                    buff_A + j*ldim_A,       inc_A, 
00143                    buff_B + j*ldim_B_trans, inc_B_trans );
00144 #else
00145       FLA_C2F( ccopy )( &num_elem,
00146                         buff_A + j*ldim_A,       &inc_A, 
00147                         buff_B + j*ldim_B_trans, &inc_B_trans );
00148 #endif
00149     }
00150 
00151     break;
00152   }
00153 
00154   case FLA_DOUBLE_COMPLEX:
00155   {
00156     dcomplex *buff_A = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
00157     dcomplex *buff_B = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( B );
00158 
00159     for ( j = 0; j < n_iter; j++ )
00160     {
00161 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00162       cblas_zcopy( num_elem,
00163                    buff_A + j*ldim_A,       inc_A, 
00164                    buff_B + j*ldim_B_trans, inc_B_trans );
00165 #else
00166       FLA_C2F( zcopy )( &num_elem,
00167                         buff_A + j*ldim_A,       &inc_A, 
00168                         buff_B + j*ldim_B_trans, &inc_B_trans );
00169 #endif
00170     }
00171 
00172     break;
00173   }
00174 
00175   }
00176   
00177   if ( trans == FLA_CONJ_NO_TRANSPOSE || trans == FLA_CONJ_TRANSPOSE )
00178     FLA_Conjugate( B );
00179   
00180   return FLA_SUCCESS;
00181 }

void FLA_F2C() fla_copyt_external_f ( F_INT *  trans,
F_INT *  A,
F_INT *  B,
F_INT *  IERROR 
)

References FLA_Copyt_external().

00185 {
00186   *IERROR = FLA_Copyt_external( *( ( FLA_Trans * ) trans ),
00187                                 *( ( FLA_Obj   * ) A     ),
00188                                 *( ( FLA_Obj   * ) B     ) );
00189 }

FLA_Error FLA_Dot ( FLA_Obj  x,
FLA_Obj  y,
FLA_Obj  rho 
)

References FLA_Dot_external().

00036 {
00037     return FLA_Dot_external( x, y, rho );
00038 }

FLA_Error FLA_Dot2cs ( FLA_Conj  conj,
FLA_Obj  alpha,
FLA_Obj  x,
FLA_Obj  y,
FLA_Obj  beta,
FLA_Obj  rho 
)

References FLA_Dot2cs_external().

00036 {
00037     return FLA_Dot2cs_external( conj, alpha, x, y, beta, rho );
00038 }

FLA_Error FLA_Dot2cs_check ( FLA_Conj  conj,
FLA_Obj  alpha,
FLA_Obj  x,
FLA_Obj  y,
FLA_Obj  beta,
FLA_Obj  rho 
)

References FLA_Check_consistent_object_datatype(), FLA_Check_equal_vector_lengths(), FLA_Check_floating_object(), FLA_Check_identical_object_datatype(), FLA_Check_if_scalar(), FLA_Check_if_vector(), FLA_Check_nonconstant_object(), and FLA_Check_valid_conj().

Referenced by FLA_Dot2cs_external().

00036 {
00037   FLA_Error e_val;
00038 
00039   e_val = FLA_Check_valid_conj( conj );
00040   FLA_Check_error_code( e_val );
00041 
00042   e_val = FLA_Check_floating_object( x );
00043   FLA_Check_error_code( e_val );
00044 
00045   e_val = FLA_Check_nonconstant_object( x );
00046   FLA_Check_error_code( e_val );
00047 
00048   e_val = FLA_Check_identical_object_datatype( x, y );
00049   FLA_Check_error_code( e_val );
00050 
00051   e_val = FLA_Check_identical_object_datatype( x, rho );
00052   FLA_Check_error_code( e_val );
00053 
00054   e_val = FLA_Check_consistent_object_datatype( x, alpha );
00055   FLA_Check_error_code( e_val );
00056 
00057   e_val = FLA_Check_consistent_object_datatype( x, beta );
00058   FLA_Check_error_code( e_val );
00059 
00060   e_val = FLA_Check_if_vector( x );
00061   FLA_Check_error_code( e_val );
00062 
00063   e_val = FLA_Check_if_vector( y );
00064   FLA_Check_error_code( e_val );
00065 
00066   e_val = FLA_Check_if_scalar( alpha );
00067   FLA_Check_error_code( e_val );
00068 
00069   e_val = FLA_Check_if_scalar( beta );
00070   FLA_Check_error_code( e_val );
00071 
00072   e_val = FLA_Check_if_scalar( rho );
00073   FLA_Check_error_code( e_val );
00074 
00075   e_val = FLA_Check_equal_vector_lengths( x, y );
00076   FLA_Check_error_code( e_val );
00077 
00078   return FLA_SUCCESS;
00079 }

FLA_Error FLA_Dot2cs_external ( FLA_Conj  conj,
FLA_Obj  alpha,
FLA_Obj  x,
FLA_Obj  y,
FLA_Obj  beta,
FLA_Obj  rho 
)

References cblas_cdotc_sub(), cblas_cdotu_sub(), cblas_ddot(), cblas_sdot(), cblas_zdotc_sub(), cblas_zdotu_sub(), ddot(), fla_cdotc(), fla_cdotu(), FLA_Check_error_level(), FLA_Dot2cs_check(), FLA_Obj_datatype(), FLA_Obj_has_zero_dim(), FLA_Obj_ldim(), FLA_Obj_length(), FLA_Obj_vector_dim(), FLA_Scal_external(), fla_zdotc(), fla_zdotu(), dcomplex::imag, scomplex::imag, dcomplex::real, scomplex::real, and sdot().

Referenced by FLA_Dot2cs(), fla_dot2cs_external_f(), FLA_Her2k_lh_unb_var1(), FLA_Her2k_lh_unb_var2(), FLA_Her2k_lh_unb_var3(), FLA_Her2k_lh_unb_var4(), FLA_Her2k_lh_unb_var5(), FLA_Her2k_lh_unb_var6(), FLA_Her2k_lh_unb_var7(), FLA_Her2k_lh_unb_var8(), FLA_Her2k_ln_unb_var1(), FLA_Her2k_ln_unb_var2(), FLA_Her2k_ln_unb_var3(), FLA_Her2k_ln_unb_var4(), FLA_Her2k_ln_unb_var5(), FLA_Her2k_ln_unb_var6(), FLA_Her2k_ln_unb_var7(), FLA_Her2k_ln_unb_var8(), FLA_Her2k_uh_unb_var1(), FLA_Her2k_uh_unb_var2(), FLA_Her2k_uh_unb_var3(), FLA_Her2k_uh_unb_var4(), FLA_Her2k_uh_unb_var5(), FLA_Her2k_uh_unb_var6(), FLA_Her2k_uh_unb_var7(), FLA_Her2k_uh_unb_var8(), FLA_Her2k_un_unb_var1(), FLA_Her2k_un_unb_var2(), FLA_Her2k_un_unb_var3(), FLA_Her2k_un_unb_var4(), FLA_Her2k_un_unb_var5(), FLA_Her2k_un_unb_var6(), FLA_Her2k_un_unb_var7(), and FLA_Her2k_un_unb_var8().

00036 {
00037   FLA_Datatype datatype;
00038   int          num_elem;
00039   int          m_x, inc_x, ldim_x;
00040   int          m_y, inc_y, ldim_y;
00041 
00042   if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING ) 
00043     FLA_Dot2cs_check( conj, alpha, x, y, beta, rho );
00044 
00045   if ( FLA_Obj_has_zero_dim( x ) )
00046   {
00047     FLA_Scal_external( beta, rho );
00048     return FLA_SUCCESS;
00049   }
00050 
00051   datatype = FLA_Obj_datatype( x );
00052 
00053   m_x      = FLA_Obj_length( x );
00054   ldim_x   = FLA_Obj_ldim( x );
00055 
00056   m_y      = FLA_Obj_length( y );
00057   ldim_y   = FLA_Obj_ldim( y ); 
00058 
00059   inc_x    = ( m_x == 1 ? ldim_x : 1 );
00060   inc_y    = ( m_y == 1 ? ldim_y : 1 );
00061   num_elem = FLA_Obj_vector_dim( x );
00062 
00063 
00064   switch ( datatype ){
00065   
00066   case FLA_FLOAT:
00067   {
00068     float *buff_x      = ( float * ) FLA_FLOAT_PTR( x );
00069     float *buff_y      = ( float * ) FLA_FLOAT_PTR( y );
00070     float *buff_rho    = ( float * ) FLA_FLOAT_PTR( rho );
00071     float *buff_alpha  = ( float * ) FLA_FLOAT_PTR( alpha );
00072     float *buff_beta   = ( float * ) FLA_FLOAT_PTR( beta );
00073     float  temp;
00074 
00075 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00076     temp = cblas_sdot( num_elem, 
00077                        buff_x, inc_x, 
00078                        buff_y, inc_y ); 
00079 #else
00080     temp = FLA_C2F( sdot ) ( &num_elem, 
00081                              buff_x, &inc_x, 
00082                              buff_y, &inc_y ); 
00083 #endif
00084 
00085     *buff_rho = 2.0F * (*buff_alpha) * temp + (*buff_beta) * (*buff_rho);
00086 
00087     break;
00088   }
00089 
00090   case FLA_DOUBLE:
00091   {
00092     double *buff_x      = ( double * ) FLA_DOUBLE_PTR( x );
00093     double *buff_y      = ( double * ) FLA_DOUBLE_PTR( y );
00094     double *buff_rho    = ( double * ) FLA_DOUBLE_PTR( rho );
00095     double *buff_alpha  = ( double * ) FLA_DOUBLE_PTR( alpha );
00096     double *buff_beta   = ( double * ) FLA_DOUBLE_PTR( beta );
00097     double  temp;
00098 
00099 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00100     temp = cblas_ddot( num_elem, 
00101                        buff_x, inc_x, 
00102                        buff_y, inc_y ); 
00103 #else
00104     temp = FLA_C2F( ddot ) ( &num_elem, 
00105                              buff_x, &inc_x, 
00106                              buff_y, &inc_y ); 
00107 #endif
00108 
00109     *buff_rho = 2.0 * (*buff_alpha) * temp + (*buff_beta) * (*buff_rho);
00110 
00111     break;
00112   }
00113 
00114   case FLA_COMPLEX:
00115   {
00116     scomplex *buff_x      = ( scomplex * ) FLA_COMPLEX_PTR( x );
00117     scomplex *buff_y      = ( scomplex * ) FLA_COMPLEX_PTR( y );
00118     scomplex *buff_rho    = ( scomplex * ) FLA_COMPLEX_PTR( rho );
00119     scomplex *buff_alpha  = ( scomplex * ) FLA_COMPLEX_PTR( alpha );
00120     scomplex *buff_beta   = ( scomplex * ) FLA_COMPLEX_PTR( beta );
00121     scomplex  temp, temp2, alphac, temp_rho;
00122     
00123     alphac = *buff_alpha;
00124     alphac.imag *= -1.0F;
00125 
00126     if ( conj == FLA_NO_CONJUGATE )
00127     {
00128 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00129       cblas_cdotu_sub( num_elem, 
00130                        buff_x, inc_x, 
00131                        buff_y, inc_y, &temp ); 
00132       cblas_cdotu_sub( num_elem, 
00133                        buff_y, inc_y, 
00134                        buff_x, inc_x, &temp2 ); 
00135 #else
00136       FLA_F2C( fla_cdotu ) ( &num_elem, 
00137                              buff_x, &inc_x, 
00138                              buff_y, &inc_y, &temp ); 
00139       FLA_F2C( fla_cdotu ) ( &num_elem, 
00140                              buff_y, &inc_y, 
00141                              buff_x, &inc_x, &temp2 ); 
00142 #endif
00143     }
00144     else
00145     {
00146 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00147       cblas_cdotc_sub( num_elem, 
00148                        buff_x, inc_x, 
00149                        buff_y, inc_y, &temp ); 
00150       cblas_cdotc_sub( num_elem, 
00151                        buff_y, inc_y, 
00152                        buff_x, inc_x, &temp2 ); 
00153 #else
00154       FLA_F2C( fla_cdotc ) ( &num_elem, 
00155                              buff_x, &inc_x, 
00156                              buff_y, &inc_y, &temp ); 
00157       FLA_F2C( fla_cdotc ) ( &num_elem, 
00158                              buff_y, &inc_y, 
00159                              buff_x, &inc_x, &temp2 ); 
00160 #endif
00161     }
00162 
00163     temp_rho.real = buff_alpha->real  * temp.real      - buff_alpha->imag  * temp.imag +
00164                     alphac.real       * temp2.real     - alphac.imag       * temp2.imag +
00165                     buff_beta->real   * buff_rho->real - buff_beta->imag   * buff_rho->imag;
00166 
00167     temp_rho.imag = buff_alpha->real  * temp.imag      + buff_alpha->imag  * temp.real +
00168                     alphac.real       * temp2.imag     + alphac.imag       * temp2.real +
00169                     buff_beta->real   * buff_rho->imag + buff_beta->imag   * buff_rho->real;
00170 
00171     buff_rho->real = temp_rho.real;
00172     buff_rho->imag = temp_rho.imag;
00173 
00174     break;
00175   }
00176 
00177   case FLA_DOUBLE_COMPLEX:
00178   {
00179     dcomplex *buff_x      = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( x );
00180     dcomplex *buff_y      = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( y );
00181     dcomplex *buff_rho    = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( rho );
00182     dcomplex *buff_alpha  = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( alpha );
00183     dcomplex *buff_beta   = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( beta );
00184     dcomplex  temp, temp2, alphac, temp_rho;
00185 
00186     alphac = *buff_alpha;
00187     alphac.imag *= -1.0;
00188 
00189     if ( conj == FLA_NO_CONJUGATE )
00190     {
00191 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00192       cblas_zdotu_sub( num_elem, 
00193                        buff_x, inc_x, 
00194                        buff_y, inc_y, &temp ); 
00195       cblas_zdotu_sub( num_elem, 
00196                        buff_y, inc_y, 
00197                        buff_x, inc_x, &temp2 ); 
00198 #else
00199       FLA_F2C( fla_zdotu ) ( &num_elem, 
00200                              buff_x, &inc_x, 
00201                              buff_y, &inc_y, &temp ); 
00202       FLA_F2C( fla_zdotu ) ( &num_elem, 
00203                              buff_y, &inc_y, 
00204                              buff_x, &inc_x, &temp2 ); 
00205 #endif
00206     }
00207     else
00208     {
00209 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00210       cblas_zdotc_sub( num_elem, 
00211                        buff_x, inc_x, 
00212                        buff_y, inc_y, &temp ); 
00213       cblas_zdotc_sub( num_elem, 
00214                        buff_y, inc_y, 
00215                        buff_x, inc_x, &temp2 ); 
00216 #else
00217       FLA_F2C( fla_zdotc ) ( &num_elem, 
00218                              buff_x, &inc_x, 
00219                              buff_y, &inc_y, &temp ); 
00220       FLA_F2C( fla_zdotc ) ( &num_elem, 
00221                              buff_y, &inc_y, 
00222                              buff_x, &inc_x, &temp2 ); 
00223 #endif
00224     }
00225 
00226     temp_rho.real = buff_alpha->real  * temp.real      - buff_alpha->imag  * temp.imag +
00227                     alphac.real       * temp2.real     - alphac.imag       * temp2.imag +
00228                     buff_beta->real   * buff_rho->real - buff_beta->imag   * buff_rho->imag;
00229 
00230     temp_rho.imag = buff_alpha->real  * temp.imag      + buff_alpha->imag  * temp.real +
00231                     alphac.real       * temp2.imag     + alphac.imag       * temp2.real +
00232                     buff_beta->real   * buff_rho->imag + buff_beta->imag   * buff_rho->real;
00233 
00234     buff_rho->real = temp_rho.real;
00235     buff_rho->imag = temp_rho.imag;
00236 
00237     break;
00238   }
00239 
00240   }
00241 
00242   return FLA_SUCCESS;
00243 }

void FLA_F2C() fla_dot2cs_external_f ( F_INT *  conj,
F_INT *  alpha,
F_INT *  X,
F_INT *  Y,
F_INT *  beta,
F_INT *  rho,
F_INT *  IERROR 
)

References FLA_Dot2cs_external().

00247 {
00248   *IERROR = FLA_Dot2cs_external( *( ( FLA_Conj * ) conj  ),
00249                                  *( ( FLA_Obj  * ) alpha ),
00250                                  *( ( FLA_Obj  * ) x     ),
00251                                  *( ( FLA_Obj  * ) y     ),
00252                                  *( ( FLA_Obj  * ) beta  ),
00253                                  *( ( FLA_Obj  * ) rho   ) );
00254 }

FLA_Error FLA_Dot2s ( FLA_Obj  alpha,
FLA_Obj  x,
FLA_Obj  y,
FLA_Obj  beta,
FLA_Obj  rho 
)

References FLA_Dot2s_external().

00036 {
00037     return FLA_Dot2s_external( alpha, x, y, beta, rho );
00038 }

FLA_Error FLA_Dot2s_check ( FLA_Obj  alpha,
FLA_Obj  x,
FLA_Obj  y,
FLA_Obj  beta,
FLA_Obj  rho 
)

References FLA_Check_consistent_object_datatype(), FLA_Check_equal_vector_lengths(), FLA_Check_floating_object(), FLA_Check_identical_object_datatype(), FLA_Check_if_scalar(), FLA_Check_if_vector(), and FLA_Check_nonconstant_object().

00036 {
00037   FLA_Error e_val;
00038 
00039   e_val = FLA_Check_floating_object( x );
00040   FLA_Check_error_code( e_val );
00041 
00042   e_val = FLA_Check_nonconstant_object( x );
00043   FLA_Check_error_code( e_val );
00044 
00045   e_val = FLA_Check_identical_object_datatype( x, y );
00046   FLA_Check_error_code( e_val );
00047 
00048   e_val = FLA_Check_identical_object_datatype( x, rho );
00049   FLA_Check_error_code( e_val );
00050 
00051   e_val = FLA_Check_consistent_object_datatype( x, alpha );
00052   FLA_Check_error_code( e_val );
00053 
00054   e_val = FLA_Check_consistent_object_datatype( x, beta );
00055   FLA_Check_error_code( e_val );
00056 
00057   e_val = FLA_Check_if_vector( x );
00058   FLA_Check_error_code( e_val );
00059 
00060   e_val = FLA_Check_if_vector( y );
00061   FLA_Check_error_code( e_val );
00062 
00063   e_val = FLA_Check_if_scalar( alpha );
00064   FLA_Check_error_code( e_val );
00065 
00066   e_val = FLA_Check_if_scalar( beta );
00067   FLA_Check_error_code( e_val );
00068 
00069   e_val = FLA_Check_if_scalar( rho );
00070   FLA_Check_error_code( e_val );
00071 
00072   e_val = FLA_Check_equal_vector_lengths( x, y );
00073   FLA_Check_error_code( e_val );
00074 
00075   return FLA_SUCCESS;
00076 }

FLA_Error FLA_Dot2s_external ( FLA_Obj  alpha,
FLA_Obj  x,
FLA_Obj  y,
FLA_Obj  beta,
FLA_Obj  rho 
)

References cblas_cdotu_sub(), cblas_ddot(), cblas_sdot(), cblas_zdotu_sub(), ddot(), fla_cdotu(), FLA_Check_error_level(), FLA_Dots_check(), FLA_Obj_datatype(), FLA_Obj_has_zero_dim(), FLA_Obj_ldim(), FLA_Obj_length(), FLA_Obj_vector_dim(), FLA_Scal_external(), fla_zdotu(), dcomplex::imag, scomplex::imag, dcomplex::real, scomplex::real, and sdot().

Referenced by FLA_Dot2s(), fla_dot2s_external_f(), FLA_Syr2k_ln_unb_var1(), FLA_Syr2k_ln_unb_var2(), FLA_Syr2k_ln_unb_var3(), FLA_Syr2k_ln_unb_var4(), FLA_Syr2k_ln_unb_var5(), FLA_Syr2k_ln_unb_var6(), FLA_Syr2k_ln_unb_var7(), FLA_Syr2k_ln_unb_var8(), FLA_Syr2k_lt_unb_var1(), FLA_Syr2k_lt_unb_var2(), FLA_Syr2k_lt_unb_var3(), FLA_Syr2k_lt_unb_var4(), FLA_Syr2k_lt_unb_var5(), FLA_Syr2k_lt_unb_var6(), FLA_Syr2k_lt_unb_var7(), FLA_Syr2k_lt_unb_var8(), FLA_Syr2k_un_unb_var1(), FLA_Syr2k_un_unb_var2(), FLA_Syr2k_un_unb_var3(), FLA_Syr2k_un_unb_var4(), FLA_Syr2k_un_unb_var5(), FLA_Syr2k_un_unb_var6(), FLA_Syr2k_un_unb_var7(), FLA_Syr2k_un_unb_var8(), FLA_Syr2k_ut_unb_var1(), FLA_Syr2k_ut_unb_var2(), FLA_Syr2k_ut_unb_var3(), FLA_Syr2k_ut_unb_var4(), FLA_Syr2k_ut_unb_var5(), FLA_Syr2k_ut_unb_var6(), FLA_Syr2k_ut_unb_var7(), and FLA_Syr2k_ut_unb_var8().

00036 {
00037   FLA_Datatype datatype;
00038   int          num_elem;
00039   int          m_x, inc_x, ldim_x;
00040   int          m_y, inc_y, ldim_y;
00041 
00042   if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING ) 
00043     FLA_Dots_check( alpha, x, y, beta, rho );
00044 
00045   if ( FLA_Obj_has_zero_dim( x ) )
00046   {
00047     FLA_Scal_external( beta, rho );
00048     return FLA_SUCCESS;
00049   }
00050 
00051   datatype = FLA_Obj_datatype( x );
00052 
00053   m_x      = FLA_Obj_length( x );
00054   ldim_x   = FLA_Obj_ldim( x );
00055 
00056   m_y      = FLA_Obj_length( y );
00057   ldim_y   = FLA_Obj_ldim( y ); 
00058 
00059   inc_x    = ( m_x == 1 ? ldim_x : 1 );
00060   inc_y    = ( m_y == 1 ? ldim_y : 1 );
00061   num_elem = FLA_Obj_vector_dim( x );
00062 
00063 
00064   switch ( datatype ){
00065   
00066   case FLA_FLOAT:
00067   {
00068     float *buff_x      = ( float * ) FLA_FLOAT_PTR( x );
00069     float *buff_y      = ( float * ) FLA_FLOAT_PTR( y );
00070     float *buff_rho    = ( float * ) FLA_FLOAT_PTR( rho );
00071     float *buff_alpha  = ( float * ) FLA_FLOAT_PTR( alpha );
00072     float *buff_beta   = ( float * ) FLA_FLOAT_PTR( beta );
00073     float  temp;
00074 
00075 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00076     temp = cblas_sdot( num_elem, 
00077                        buff_x, inc_x, 
00078                        buff_y, inc_y ); 
00079 #else
00080     temp = FLA_C2F( sdot ) ( &num_elem, 
00081                              buff_x, &inc_x, 
00082                              buff_y, &inc_y ); 
00083 #endif
00084 
00085     *buff_rho = 2.0F * (*buff_alpha) * temp + (*buff_beta) * (*buff_rho);
00086 
00087     break;
00088   }
00089 
00090   case FLA_DOUBLE:
00091   {
00092     double *buff_x      = ( double * ) FLA_DOUBLE_PTR( x );
00093     double *buff_y      = ( double * ) FLA_DOUBLE_PTR( y );
00094     double *buff_rho    = ( double * ) FLA_DOUBLE_PTR( rho );
00095     double *buff_alpha  = ( double * ) FLA_DOUBLE_PTR( alpha );
00096     double *buff_beta   = ( double * ) FLA_DOUBLE_PTR( beta );
00097     double  temp;
00098 
00099 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00100     temp = cblas_ddot( num_elem, 
00101                        buff_x, inc_x, 
00102                        buff_y, inc_y ); 
00103 #else
00104     temp = FLA_C2F( ddot ) ( &num_elem, 
00105                              buff_x, &inc_x, 
00106                              buff_y, &inc_y ); 
00107 #endif
00108 
00109     *buff_rho = 2.0 * (*buff_alpha) * temp + (*buff_beta) * (*buff_rho);
00110 
00111     break;
00112   }
00113 
00114   case FLA_COMPLEX:
00115   {
00116     scomplex *buff_x      = ( scomplex * ) FLA_COMPLEX_PTR( x );
00117     scomplex *buff_y      = ( scomplex * ) FLA_COMPLEX_PTR( y );
00118     scomplex *buff_rho    = ( scomplex * ) FLA_COMPLEX_PTR( rho );
00119     scomplex *buff_alpha  = ( scomplex * ) FLA_COMPLEX_PTR( alpha );
00120     scomplex *buff_beta   = ( scomplex * ) FLA_COMPLEX_PTR( beta );
00121     scomplex  temp, temp2, alphac, temp_rho;
00122     
00123     alphac = *buff_alpha;
00124     alphac.imag *= -1.0F;
00125 
00126 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00127     cblas_cdotu_sub( num_elem, 
00128                      buff_x, inc_x, 
00129                      buff_y, inc_y, &temp ); 
00130     cblas_cdotu_sub( num_elem, 
00131                      buff_y, inc_y, 
00132                      buff_x, inc_x, &temp2 ); 
00133 #else
00134     FLA_F2C( fla_cdotu ) ( &num_elem, 
00135                            buff_x, &inc_x, 
00136                            buff_y, &inc_y, &temp ); 
00137     FLA_F2C( fla_cdotu ) ( &num_elem, 
00138                            buff_y, &inc_y, 
00139                            buff_x, &inc_x, &temp2 ); 
00140 #endif
00141 
00142 
00143     temp_rho.real = buff_alpha->real  * temp.real      - buff_alpha->imag  * temp.imag +
00144                     alphac.real       * temp2.real     - alphac.imag       * temp2.imag +
00145                     buff_beta->real   * buff_rho->real - buff_beta->imag   * buff_rho->imag;
00146 
00147     temp_rho.imag = buff_alpha->real  * temp.imag      + buff_alpha->imag  * temp.real +
00148                     alphac.real       * temp2.imag     + alphac.imag       * temp2.real +
00149                     buff_beta->real   * buff_rho->imag + buff_beta->imag   * buff_rho->real;
00150 
00151     buff_rho->real = temp_rho.real;
00152     buff_rho->imag = temp_rho.imag;
00153 
00154     break;
00155   }
00156 
00157   case FLA_DOUBLE_COMPLEX:
00158   {
00159     dcomplex *buff_x      = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( x );
00160     dcomplex *buff_y      = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( y );
00161     dcomplex *buff_rho    = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( rho );
00162     dcomplex *buff_alpha  = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( alpha );
00163     dcomplex *buff_beta   = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( beta );
00164     dcomplex  temp, temp2, alphac, temp_rho;
00165     
00166     alphac = *buff_alpha;
00167     alphac.imag *= -1.0;
00168 
00169 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00170     cblas_zdotu_sub( num_elem, 
00171                      buff_x, inc_x, 
00172                      buff_y, inc_y, &temp ); 
00173     cblas_zdotu_sub( num_elem, 
00174                      buff_x, inc_x, 
00175                      buff_y, inc_y, &temp2 ); 
00176 #else
00177     FLA_F2C( fla_zdotu ) ( &num_elem, 
00178                            buff_x, &inc_x, 
00179                            buff_y, &inc_y, &temp ); 
00180     FLA_F2C( fla_zdotu ) ( &num_elem, 
00181                            buff_x, &inc_x, 
00182                            buff_y, &inc_y, &temp2 ); 
00183 #endif
00184 
00185     temp_rho.real = buff_alpha->real  * temp.real      - buff_alpha->imag  * temp.imag +
00186                     alphac.real       * temp2.real     - alphac.imag       * temp2.imag +
00187                     buff_beta->real   * buff_rho->real - buff_beta->imag   * buff_rho->imag;
00188 
00189     temp_rho.imag = buff_alpha->real  * temp.imag      + buff_alpha->imag  * temp.real +
00190                     alphac.real       * temp2.imag     + alphac.imag       * temp2.real +
00191                     buff_beta->real   * buff_rho->imag + buff_beta->imag   * buff_rho->real;
00192 
00193     buff_rho->real = temp_rho.real;
00194     buff_rho->imag = temp_rho.imag;
00195 
00196     break;
00197   }
00198 
00199   }
00200 
00201   return FLA_SUCCESS;
00202 }

void FLA_F2C() fla_dot2s_external_f ( F_INT *  alpha,
F_INT *  X,
F_INT *  Y,
F_INT *  beta,
F_INT *  rho,
F_INT *  IERROR 
)

References FLA_Dot2s_external().

00206 {
00207   *IERROR = FLA_Dot2s_external( *( ( FLA_Obj * ) alpha ),
00208                                 *( ( FLA_Obj * ) x     ),
00209                                 *( ( FLA_Obj * ) y     ),
00210                                 *( ( FLA_Obj * ) beta  ),
00211                                 *( ( FLA_Obj * ) rho   ) );
00212 }

FLA_Error FLA_Dot_check ( FLA_Obj  x,
FLA_Obj  y,
FLA_Obj  rho 
)

References FLA_Check_equal_vector_lengths(), FLA_Check_floating_object(), FLA_Check_identical_object_datatype(), FLA_Check_if_vector(), and FLA_Check_nonconstant_object().

Referenced by FLA_Dot_external().

00036 {
00037   FLA_Error e_val;
00038 
00039   e_val = FLA_Check_floating_object( x );
00040   FLA_Check_error_code( e_val );
00041 
00042   e_val = FLA_Check_nonconstant_object( x );
00043   FLA_Check_error_code( e_val );
00044 
00045   e_val = FLA_Check_identical_object_datatype( x, y );
00046   FLA_Check_error_code( e_val );
00047 
00048   e_val = FLA_Check_identical_object_datatype( x, rho );
00049   FLA_Check_error_code( e_val );
00050 
00051   e_val = FLA_Check_if_vector( x );
00052   FLA_Check_error_code( e_val );
00053 
00054   e_val = FLA_Check_if_vector( y );
00055   FLA_Check_error_code( e_val );
00056 
00057   e_val = FLA_Check_equal_vector_lengths( x, y );
00058   FLA_Check_error_code( e_val );
00059 
00060   return FLA_SUCCESS;
00061 }

FLA_Error FLA_Dot_external ( FLA_Obj  x,
FLA_Obj  y,
FLA_Obj  rho 
)

References cblas_cdotu_sub(), cblas_ddot(), cblas_sdot(), cblas_zdotu_sub(), ddot(), fla_cdotu(), FLA_Check_error_level(), FLA_Dot_check(), FLA_Obj_datatype(), FLA_Obj_has_zero_dim(), FLA_Obj_ldim(), FLA_Obj_length(), FLA_Obj_vector_dim(), fla_zdotu(), and sdot().

Referenced by FLA_Dot(), and fla_dot_external_f().

00036 {
00037   FLA_Datatype datatype;
00038   int          num_elem;
00039   int          m_x, inc_x, ldim_x;
00040   int          m_y, inc_y, ldim_y;
00041 
00042   if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING ) 
00043     FLA_Dot_check( x, y, rho );
00044 
00045   if ( FLA_Obj_has_zero_dim( x ) ) return FLA_SUCCESS;
00046 
00047   datatype = FLA_Obj_datatype( x );
00048 
00049   m_x      = FLA_Obj_length( x );
00050   ldim_x   = FLA_Obj_ldim( x );
00051 
00052   m_y      = FLA_Obj_length( y );
00053   ldim_y   = FLA_Obj_ldim( y ); 
00054 
00055   inc_x    = ( m_x == 1 ? ldim_x : 1 );
00056   inc_y    = ( m_y == 1 ? ldim_y : 1 );
00057   num_elem = FLA_Obj_vector_dim( x );
00058 
00059 
00060   switch ( datatype ){
00061 
00062   case FLA_FLOAT:
00063   {
00064     float *buff_x   = ( float * ) FLA_FLOAT_PTR( x );
00065     float *buff_y   = ( float * ) FLA_FLOAT_PTR( y );
00066     float *buff_rho = ( float * ) FLA_FLOAT_PTR( rho );
00067 
00068 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00069     *buff_rho = 
00070       cblas_sdot( num_elem, 
00071                   buff_x, inc_x,
00072                   buff_y, inc_y );
00073 #else
00074     *buff_rho = 
00075       FLA_C2F( sdot ) ( &num_elem, 
00076                         buff_x, &inc_x,
00077                         buff_y, &inc_y );
00078 #endif
00079 
00080     break;
00081   }
00082 
00083   case FLA_DOUBLE:
00084   {
00085     double *buff_x   = ( double * ) FLA_DOUBLE_PTR( x );
00086     double *buff_y   = ( double * ) FLA_DOUBLE_PTR( y );
00087     double *buff_rho = ( double * ) FLA_DOUBLE_PTR( rho );
00088 
00089 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00090     *buff_rho = 
00091       cblas_ddot( num_elem, 
00092                   buff_x, inc_x,
00093                   buff_y, inc_y );
00094 #else
00095     *buff_rho = 
00096       FLA_C2F( ddot ) ( &num_elem, 
00097                         buff_x, &inc_x,
00098                         buff_y, &inc_y );
00099 #endif
00100 
00101     break;
00102   }
00103 
00104   case FLA_COMPLEX:
00105   {
00106     scomplex *buff_x   = ( scomplex * ) FLA_COMPLEX_PTR( x );
00107     scomplex *buff_y   = ( scomplex * ) FLA_COMPLEX_PTR( y );
00108     scomplex *buff_rho = ( scomplex * ) FLA_COMPLEX_PTR( rho );
00109 
00110 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00111     cblas_cdotu_sub( num_elem, 
00112                      buff_x, inc_x,
00113                      buff_y, inc_y, buff_rho );
00114 #else
00115     // Using FLA_F2C here is not a bug! FLA_C2F() appends an (possibly) incorrect number
00116     // of underscores.
00117     FLA_F2C( fla_cdotu ) ( &num_elem, 
00118                            buff_x, &inc_x,
00119                            buff_y, &inc_y, buff_rho );
00120 #endif
00121 
00122     break;
00123   }
00124 
00125   case FLA_DOUBLE_COMPLEX:
00126   {
00127     dcomplex *buff_x   = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( x );
00128     dcomplex *buff_y   = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( y );
00129     dcomplex *buff_rho = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( rho );
00130 
00131 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00132     cblas_zdotu_sub( num_elem, 
00133                      buff_x, inc_x,
00134                      buff_y, inc_y, buff_rho );
00135 #else
00136     // Using FLA_F2C here is not a bug! FLA_C2F() appends an (possibly) incorrect number
00137     // of underscores.
00138     FLA_F2C( fla_zdotu ) ( &num_elem, 
00139                            buff_x, &inc_x,
00140                            buff_y, &inc_y, buff_rho );
00141 #endif
00142 
00143     break;
00144   }
00145 
00146   }
00147 
00148   return FLA_SUCCESS;
00149 }

void FLA_F2C() fla_dot_external_f ( F_INT *  X,
F_INT *  Y,
F_INT *  rho,
F_INT *  IERROR 
)

References FLA_Dot_external().

00153 {
00154   *IERROR = FLA_Dot_external( *( ( FLA_Obj * ) x   ), 
00155                               *( ( FLA_Obj * ) y   ),
00156                               *( ( FLA_Obj * ) rho ) );
00157 }

FLA_Error FLA_Dotc ( FLA_Conj  conj,
FLA_Obj  x,
FLA_Obj  y,
FLA_Obj  rho 
)

References FLA_Dotc_external().

00036 {
00037     return FLA_Dotc_external( conj, x, y, rho );
00038 }

FLA_Error FLA_Dotc_check ( FLA_Conj  conj,
FLA_Obj  x,
FLA_Obj  y,
FLA_Obj  rho 
)

References FLA_Check_equal_vector_lengths(), FLA_Check_floating_object(), FLA_Check_identical_object_datatype(), FLA_Check_if_vector(), FLA_Check_nonconstant_object(), and FLA_Check_valid_conj().

Referenced by FLA_Dotc_external().

00036 {
00037   FLA_Error e_val;
00038 
00039   e_val = FLA_Check_valid_conj( conj );
00040   FLA_Check_error_code( e_val );
00041 
00042   e_val = FLA_Check_floating_object( x );
00043   FLA_Check_error_code( e_val );
00044 
00045   e_val = FLA_Check_nonconstant_object( x );
00046   FLA_Check_error_code( e_val );
00047 
00048   e_val = FLA_Check_identical_object_datatype( x, y );
00049   FLA_Check_error_code( e_val );
00050 
00051   e_val = FLA_Check_identical_object_datatype( x, rho );
00052   FLA_Check_error_code( e_val );
00053 
00054   e_val = FLA_Check_if_vector( x );
00055   FLA_Check_error_code( e_val );
00056 
00057   e_val = FLA_Check_if_vector( y );
00058   FLA_Check_error_code( e_val );
00059 
00060   e_val = FLA_Check_equal_vector_lengths( x, y );
00061   FLA_Check_error_code( e_val );
00062 
00063   return FLA_SUCCESS;
00064 }

FLA_Error FLA_Dotc_external ( FLA_Conj  conj,
FLA_Obj  x,
FLA_Obj  y,
FLA_Obj  rho 
)

References cblas_cdotc_sub(), cblas_cdotu_sub(), cblas_ddot(), cblas_sdot(), cblas_zdotc_sub(), cblas_zdotu_sub(), ddot(), fla_cdotc(), fla_cdotu(), FLA_Check_error_level(), FLA_Dotc_check(), FLA_Obj_datatype(), FLA_Obj_has_zero_dim(), FLA_Obj_ldim(), FLA_Obj_length(), FLA_Obj_vector_dim(), fla_zdotc(), fla_zdotu(), and sdot().

Referenced by FLA_Dotc(), and fla_dotc_external_f().

00036 {
00037   FLA_Datatype datatype;
00038   int          num_elem;
00039   int          m_x, inc_x, ldim_x;
00040   int          m_y, inc_y, ldim_y;
00041 
00042   if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING ) 
00043     FLA_Dotc_check( conj, x, y, rho );
00044 
00045   if ( FLA_Obj_has_zero_dim( x ) ) return FLA_SUCCESS;
00046 
00047   datatype = FLA_Obj_datatype( x );
00048 
00049   m_x      = FLA_Obj_length( x );
00050   ldim_x   = FLA_Obj_ldim( x );
00051 
00052   m_y      = FLA_Obj_length( y );
00053   ldim_y   = FLA_Obj_ldim( y ); 
00054 
00055   inc_x    = ( m_x == 1 ? ldim_x : 1 );
00056   inc_y    = ( m_y == 1 ? ldim_y : 1 );
00057   num_elem = FLA_Obj_vector_dim( x );
00058 
00059 
00060   switch ( datatype ){
00061 
00062   case FLA_FLOAT:
00063   {
00064     float *buff_x   = ( float * ) FLA_FLOAT_PTR( x );
00065     float *buff_y   = ( float * ) FLA_FLOAT_PTR( y );
00066     float *buff_rho = ( float * ) FLA_FLOAT_PTR( rho );
00067 
00068 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00069     *buff_rho = 
00070       cblas_sdot( num_elem, 
00071                   buff_x, inc_x,
00072                   buff_y, inc_y );
00073 #else
00074     *buff_rho = 
00075       FLA_C2F( sdot ) ( &num_elem, 
00076                         buff_x, &inc_x,
00077                         buff_y, &inc_y );
00078 #endif
00079 
00080     break;
00081   }
00082 
00083   case FLA_DOUBLE:
00084   {
00085     double *buff_x   = ( double * ) FLA_DOUBLE_PTR( x );
00086     double *buff_y   = ( double * ) FLA_DOUBLE_PTR( y );
00087     double *buff_rho = ( double * ) FLA_DOUBLE_PTR( rho );
00088 
00089 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00090     *buff_rho = 
00091       cblas_ddot( num_elem, 
00092                   buff_x, inc_x,
00093                   buff_y, inc_y );
00094 #else
00095     *buff_rho = 
00096       FLA_C2F( ddot ) ( &num_elem, 
00097                         buff_x, &inc_x,
00098                         buff_y, &inc_y );
00099 #endif
00100 
00101     break;
00102   }
00103 
00104   case FLA_COMPLEX:
00105   {
00106     scomplex *buff_x   = ( scomplex * ) FLA_COMPLEX_PTR( x );
00107     scomplex *buff_y   = ( scomplex * ) FLA_COMPLEX_PTR( y );
00108     scomplex *buff_rho = ( scomplex * ) FLA_COMPLEX_PTR( rho );
00109 
00110     if ( conj == FLA_NO_CONJUGATE )
00111     {
00112 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00113       cblas_cdotu_sub( num_elem, 
00114                        buff_x, inc_x,
00115                        buff_y, inc_y, buff_rho );
00116 #else
00117       FLA_F2C( fla_cdotu ) ( &num_elem, 
00118                              buff_x, &inc_x,
00119                              buff_y, &inc_y, buff_rho );
00120 #endif
00121     }
00122     else
00123     {
00124 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00125       cblas_cdotc_sub( num_elem, 
00126                        buff_x, inc_x,
00127                        buff_y, inc_y, buff_rho );
00128 #else
00129       FLA_F2C( fla_cdotc ) ( &num_elem, 
00130                              buff_x, &inc_x,
00131                              buff_y, &inc_y, buff_rho );
00132 #endif
00133     }
00134 
00135     break;
00136   }
00137 
00138   case FLA_DOUBLE_COMPLEX:
00139   {
00140     dcomplex *buff_x   = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( x );
00141     dcomplex *buff_y   = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( y );
00142     dcomplex *buff_rho = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( rho );
00143 
00144     if ( conj == FLA_NO_CONJUGATE )
00145     {
00146 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00147       cblas_zdotu_sub( num_elem, 
00148                        buff_x, inc_x,
00149                        buff_y, inc_y, buff_rho );
00150 #else
00151       FLA_F2C( fla_zdotu ) ( &num_elem, 
00152                              buff_x, &inc_x,
00153                              buff_y, &inc_y, buff_rho );
00154 #endif
00155     }
00156     else
00157     {
00158 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00159       cblas_zdotc_sub( num_elem, 
00160                        buff_x, inc_x,
00161                        buff_y, inc_y, buff_rho );
00162 #else
00163       FLA_F2C( fla_zdotc ) ( &num_elem, 
00164                              buff_x, &inc_x,
00165                              buff_y, &inc_y, buff_rho );
00166 #endif
00167     }
00168 
00169     break;
00170   }
00171 
00172   }
00173 
00174   return FLA_SUCCESS;
00175 }

void FLA_F2C() fla_dotc_external_f ( F_INT *  conj,
F_INT *  X,
F_INT *  Y,
F_INT *  rho,
F_INT *  IERROR 
)

References FLA_Dotc_external().

00179 {
00180   *IERROR = FLA_Dotc_external( *( ( FLA_Conj * ) conj ), 
00181                                *( ( FLA_Obj  * ) x    ), 
00182                                *( ( FLA_Obj  * ) y    ),
00183                                *( ( FLA_Obj  * ) rho  ) );
00184 }

FLA_Error FLA_Dotcs ( FLA_Conj  conj,
FLA_Obj  alpha,
FLA_Obj  x,
FLA_Obj  y,
FLA_Obj  beta,
FLA_Obj  rho 
)

References FLA_Dotcs_external().

00036 {
00037     return FLA_Dotcs_external( conj, alpha, x, y, beta, rho );
00038 }

FLA_Error FLA_Dotcs_check ( FLA_Conj  conj,
FLA_Obj  alpha,
FLA_Obj  x,
FLA_Obj  y,
FLA_Obj  beta,
FLA_Obj  rho 
)

References FLA_Check_consistent_object_datatype(), FLA_Check_equal_vector_lengths(), FLA_Check_floating_object(), FLA_Check_identical_object_datatype(), FLA_Check_if_scalar(), FLA_Check_if_vector(), FLA_Check_nonconstant_object(), and FLA_Check_valid_conj().

Referenced by FLA_Dotcs_external().

00036 {
00037   FLA_Error e_val;
00038 
00039   e_val = FLA_Check_valid_conj( conj );
00040   FLA_Check_error_code( e_val );
00041 
00042   e_val = FLA_Check_floating_object( x );
00043   FLA_Check_error_code( e_val );
00044 
00045   e_val = FLA_Check_nonconstant_object( x );
00046   FLA_Check_error_code( e_val );
00047 
00048   e_val = FLA_Check_identical_object_datatype( x, y );
00049   FLA_Check_error_code( e_val );
00050 
00051   e_val = FLA_Check_identical_object_datatype( x, rho );
00052   FLA_Check_error_code( e_val );
00053 
00054   e_val = FLA_Check_consistent_object_datatype( x, alpha );
00055   FLA_Check_error_code( e_val );
00056 
00057   e_val = FLA_Check_consistent_object_datatype( x, beta );
00058   FLA_Check_error_code( e_val );
00059 
00060   e_val = FLA_Check_if_vector( x );
00061   FLA_Check_error_code( e_val );
00062 
00063   e_val = FLA_Check_if_vector( y );
00064   FLA_Check_error_code( e_val );
00065 
00066   e_val = FLA_Check_if_scalar( alpha );
00067   FLA_Check_error_code( e_val );
00068 
00069   e_val = FLA_Check_if_scalar( beta );
00070   FLA_Check_error_code( e_val );
00071 
00072   e_val = FLA_Check_if_scalar( rho );
00073   FLA_Check_error_code( e_val );
00074 
00075   e_val = FLA_Check_equal_vector_lengths( x, y );
00076   FLA_Check_error_code( e_val );
00077 
00078   return FLA_SUCCESS;
00079 }

FLA_Error FLA_Dotcs_external ( FLA_Conj  conj,
FLA_Obj  alpha,
FLA_Obj  x,
FLA_Obj  y,
FLA_Obj  beta,
FLA_Obj  rho 
)

References cblas_cdotc_sub(), cblas_cdotu_sub(), cblas_ddot(), cblas_sdot(), cblas_zdotc_sub(), cblas_zdotu_sub(), ddot(), fla_cdotc(), fla_cdotu(), FLA_Check_error_level(), FLA_Dotcs_check(), FLA_Obj_datatype(), FLA_Obj_has_zero_dim(), FLA_Obj_ldim(), FLA_Obj_length(), FLA_Obj_vector_dim(), FLA_Scal_external(), fla_zdotc(), fla_zdotu(), dcomplex::imag, scomplex::imag, dcomplex::real, scomplex::real, and sdot().

Referenced by FLA_Chol_l_unb_var1(), FLA_Chol_l_unb_var2(), FLA_Chol_u_unb_var1(), FLA_Chol_u_unb_var2(), FLA_Dotcs(), fla_dotcs_external_f(), FLA_Herk_lh_unb_var1(), FLA_Herk_lh_unb_var2(), FLA_Herk_lh_unb_var3(), FLA_Herk_lh_unb_var4(), FLA_Herk_ln_unb_var1(), FLA_Herk_ln_unb_var2(), FLA_Herk_ln_unb_var3(), FLA_Herk_ln_unb_var4(), FLA_Herk_uh_unb_var1(), FLA_Herk_uh_unb_var2(), FLA_Herk_uh_unb_var3(), FLA_Herk_uh_unb_var4(), FLA_Herk_un_unb_var1(), FLA_Herk_un_unb_var2(), FLA_Herk_un_unb_var3(), FLA_Herk_un_unb_var4(), FLA_Ttmm_l_unb_var2(), FLA_Ttmm_l_unb_var3(), FLA_Ttmm_u_unb_var2(), and FLA_Ttmm_u_unb_var3().

00036 {
00037   FLA_Datatype datatype;
00038   int          num_elem;
00039   int          m_x, inc_x, ldim_x;
00040   int          m_y, inc_y, ldim_y;
00041 
00042   if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING ) 
00043     FLA_Dotcs_check( conj, alpha, x, y, beta, rho );
00044 
00045   if ( FLA_Obj_has_zero_dim( x ) )
00046   {
00047     FLA_Scal_external( beta, rho );
00048     return FLA_SUCCESS;
00049   }
00050 
00051   datatype = FLA_Obj_datatype( x );
00052 
00053   m_x      = FLA_Obj_length( x );
00054   ldim_x   = FLA_Obj_ldim( x );
00055 
00056   m_y      = FLA_Obj_length( y );
00057   ldim_y   = FLA_Obj_ldim( y ); 
00058 
00059   inc_x    = ( m_x == 1 ? ldim_x : 1 );
00060   inc_y    = ( m_y == 1 ? ldim_y : 1 );
00061   num_elem = FLA_Obj_vector_dim( x );
00062 
00063 
00064   switch ( datatype ){
00065   
00066   case FLA_FLOAT:
00067   {
00068     float *buff_x      = ( float * ) FLA_FLOAT_PTR( x );
00069     float *buff_y      = ( float * ) FLA_FLOAT_PTR( y );
00070     float *buff_rho    = ( float * ) FLA_FLOAT_PTR( rho );
00071     float *buff_alpha  = ( float * ) FLA_FLOAT_PTR( alpha );
00072     float *buff_beta   = ( float * ) FLA_FLOAT_PTR( beta );
00073     float  temp;
00074 
00075 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00076     temp = cblas_sdot( num_elem, 
00077                        buff_x, inc_x, 
00078                        buff_y, inc_y ); 
00079 #else
00080     temp = FLA_C2F( sdot ) ( &num_elem, 
00081                              buff_x, &inc_x, 
00082                              buff_y, &inc_y ); 
00083 #endif
00084 
00085     *buff_rho = (*buff_alpha) * temp + (*buff_beta) * (*buff_rho);
00086 
00087     break;
00088   }
00089 
00090   case FLA_DOUBLE:
00091   {
00092     double *buff_x      = ( double * ) FLA_DOUBLE_PTR( x );
00093     double *buff_y      = ( double * ) FLA_DOUBLE_PTR( y );
00094     double *buff_rho    = ( double * ) FLA_DOUBLE_PTR( rho );
00095     double *buff_alpha  = ( double * ) FLA_DOUBLE_PTR( alpha );
00096     double *buff_beta   = ( double * ) FLA_DOUBLE_PTR( beta );
00097     double  temp;
00098 
00099 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00100     temp = cblas_ddot( num_elem, 
00101                        buff_x, inc_x, 
00102                        buff_y, inc_y ); 
00103 #else
00104     temp = FLA_C2F( ddot ) ( &num_elem, 
00105                              buff_x, &inc_x, 
00106                              buff_y, &inc_y ); 
00107 #endif
00108 
00109     *buff_rho = (*buff_alpha) * temp + (*buff_beta) * (*buff_rho);
00110 
00111     break;
00112   }
00113 
00114   case FLA_COMPLEX:
00115   {
00116     scomplex *buff_x      = ( scomplex * ) FLA_COMPLEX_PTR( x );
00117     scomplex *buff_y      = ( scomplex * ) FLA_COMPLEX_PTR( y );
00118     scomplex *buff_rho    = ( scomplex * ) FLA_COMPLEX_PTR( rho );
00119     scomplex *buff_alpha  = ( scomplex * ) FLA_COMPLEX_PTR( alpha );
00120     scomplex *buff_beta   = ( scomplex * ) FLA_COMPLEX_PTR( beta );
00121     scomplex  temp, temp_rho;
00122 
00123     if ( conj == FLA_NO_CONJUGATE )
00124     {
00125 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00126       cblas_cdotu_sub( num_elem, 
00127                        buff_x, inc_x, 
00128                        buff_y, inc_y, &temp ); 
00129 #else
00130       FLA_F2C( fla_cdotu ) ( &num_elem, 
00131                              buff_x, &inc_x, 
00132                              buff_y, &inc_y, &temp ); 
00133 #endif
00134     }
00135     else
00136     {
00137 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00138       cblas_cdotc_sub( num_elem, 
00139                        buff_x, inc_x, 
00140                        buff_y, inc_y, &temp ); 
00141 #else
00142       FLA_F2C( fla_cdotc ) ( &num_elem, 
00143                              buff_x, &inc_x, 
00144                              buff_y, &inc_y, &temp ); 
00145 #endif
00146     }
00147 
00148     temp_rho.real = buff_alpha->real * temp.real      - buff_alpha->imag * temp.imag +
00149                     buff_beta->real  * buff_rho->real - buff_beta->imag  * buff_rho->imag;
00150 
00151     temp_rho.imag = buff_alpha->real * temp.imag      + buff_alpha->imag * temp.real +
00152                     buff_beta->real  * buff_rho->imag + buff_beta->imag  * buff_rho->real;
00153 
00154     buff_rho->real = temp_rho.real;
00155     buff_rho->imag = temp_rho.imag;
00156 
00157     break;
00158   }
00159 
00160   case FLA_DOUBLE_COMPLEX:
00161   {
00162     dcomplex *buff_x      = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( x );
00163     dcomplex *buff_y      = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( y );
00164     dcomplex *buff_rho    = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( rho );
00165     dcomplex *buff_alpha  = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( alpha );
00166     dcomplex *buff_beta   = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( beta );
00167     dcomplex  temp, temp_rho;
00168 
00169     if ( conj == FLA_NO_CONJUGATE )
00170     {
00171 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00172       cblas_zdotu_sub( num_elem, 
00173                        buff_x, inc_x, 
00174                        buff_y, inc_y, &temp ); 
00175 #else
00176       FLA_F2C( fla_zdotu ) ( &num_elem, 
00177                              buff_x, &inc_x, 
00178                              buff_y, &inc_y, &temp ); 
00179 #endif
00180     }
00181     else
00182     {
00183 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00184       cblas_zdotc_sub( num_elem, 
00185                        buff_x, inc_x, 
00186                        buff_y, inc_y, &temp ); 
00187 #else
00188       FLA_F2C( fla_zdotc ) ( &num_elem, 
00189                              buff_x, &inc_x, 
00190                              buff_y, &inc_y, &temp ); 
00191 #endif
00192     }
00193 
00194     temp_rho.real = buff_alpha->real * temp.real      - buff_alpha->imag * temp.imag +
00195                     buff_beta->real  * buff_rho->real - buff_beta->imag  * buff_rho->imag;
00196 
00197     temp_rho.imag = buff_alpha->real * temp.imag      + buff_alpha->imag * temp.real +
00198                     buff_beta->real  * buff_rho->imag + buff_beta->imag  * buff_rho->real;
00199 
00200     buff_rho->real = temp_rho.real;
00201     buff_rho->imag = temp_rho.imag;
00202 
00203     break;
00204   }
00205 
00206   }
00207   
00208   return FLA_SUCCESS;
00209 }

void FLA_F2C() fla_dotcs_external_f ( F_INT *  conj,
F_INT *  alpha,
F_INT *  X,
F_INT *  Y,
F_INT *  beta,
F_INT *  rho,
F_INT *  IERROR 
)

References FLA_Dotcs_external().

00213 {
00214   *IERROR = FLA_Dotcs_external( *( ( FLA_Conj * ) conj  ),
00215                                 *( ( FLA_Obj  * ) alpha ),
00216                                 *( ( FLA_Obj  * ) x     ),
00217                                 *( ( FLA_Obj  * ) y     ),
00218                                 *( ( FLA_Obj  * ) beta  ),
00219                                 *( ( FLA_Obj  * ) rho   ) );
00220 }

FLA_Error FLA_Dots ( FLA_Obj  alpha,
FLA_Obj  x,
FLA_Obj  y,
FLA_Obj  beta,
FLA_Obj  rho 
)

References FLA_Dots_external().

00036 {
00037     return FLA_Dots_external( alpha, x, y, beta, rho );
00038 }

FLA_Error FLA_Dots_check ( FLA_Obj  alpha,
FLA_Obj  x,
FLA_Obj  y,
FLA_Obj  beta,
FLA_Obj  rho 
)

References FLA_Check_consistent_object_datatype(), FLA_Check_equal_vector_lengths(), FLA_Check_floating_object(), FLA_Check_identical_object_datatype(), FLA_Check_if_scalar(), FLA_Check_if_vector(), and FLA_Check_nonconstant_object().

Referenced by FLA_Dot2s_external(), and FLA_Dots_external().

00036 {
00037   FLA_Error e_val;
00038 
00039   e_val = FLA_Check_floating_object( x );
00040   FLA_Check_error_code( e_val );
00041 
00042   e_val = FLA_Check_nonconstant_object( x );
00043   FLA_Check_error_code( e_val );
00044 
00045   e_val = FLA_Check_identical_object_datatype( x, y );
00046   FLA_Check_error_code( e_val );
00047 
00048   e_val = FLA_Check_identical_object_datatype( x, rho );
00049   FLA_Check_error_code( e_val );
00050 
00051   e_val = FLA_Check_consistent_object_datatype( x, alpha );
00052   FLA_Check_error_code( e_val );
00053 
00054   e_val = FLA_Check_consistent_object_datatype( x, beta );
00055   FLA_Check_error_code( e_val );
00056 
00057   e_val = FLA_Check_if_vector( x );
00058   FLA_Check_error_code( e_val );
00059 
00060   e_val = FLA_Check_if_vector( y );
00061   FLA_Check_error_code( e_val );
00062 
00063   e_val = FLA_Check_if_scalar( alpha );
00064   FLA_Check_error_code( e_val );
00065 
00066   e_val = FLA_Check_if_scalar( beta );
00067   FLA_Check_error_code( e_val );
00068 
00069   e_val = FLA_Check_if_scalar( rho );
00070   FLA_Check_error_code( e_val );
00071 
00072   e_val = FLA_Check_equal_vector_lengths( x, y );
00073   FLA_Check_error_code( e_val );
00074 
00075   return FLA_SUCCESS;
00076 }

FLA_Error FLA_Dots_external ( FLA_Obj  alpha,
FLA_Obj  x,
FLA_Obj  y,
FLA_Obj  beta,
FLA_Obj  rho 
)

References cblas_cdotu_sub(), cblas_ddot(), cblas_sdot(), cblas_zdotu_sub(), ddot(), fla_cdotu(), FLA_Check_error_level(), FLA_Dots_check(), FLA_Obj_datatype(), FLA_Obj_has_zero_dim(), FLA_Obj_ldim(), FLA_Obj_length(), FLA_Obj_vector_dim(), FLA_Scal_external(), fla_zdotu(), dcomplex::imag, scomplex::imag, dcomplex::real, scomplex::real, and sdot().

Referenced by FLA_Chol_l_unb_var1(), FLA_Chol_l_unb_var2(), FLA_Chol_u_unb_var1(), FLA_Chol_u_unb_var2(), FLA_Dots(), fla_dots_external_f(), FLA_LU_nopiv_unb_var1(), FLA_LU_nopiv_unb_var2(), FLA_LU_nopiv_unb_var3(), FLA_LU_nopiv_unb_var4(), FLA_LU_piv_unb_var3(), FLA_LU_piv_unb_var3b(), FLA_LU_piv_unb_var4(), FLA_Syrk_ln_unb_var1(), FLA_Syrk_ln_unb_var2(), FLA_Syrk_ln_unb_var3(), FLA_Syrk_ln_unb_var4(), FLA_Syrk_lt_unb_var1(), FLA_Syrk_lt_unb_var2(), FLA_Syrk_lt_unb_var3(), FLA_Syrk_lt_unb_var4(), FLA_Syrk_un_unb_var1(), FLA_Syrk_un_unb_var2(), FLA_Syrk_un_unb_var3(), FLA_Syrk_un_unb_var4(), FLA_Syrk_ut_unb_var1(), FLA_Syrk_ut_unb_var2(), FLA_Syrk_ut_unb_var3(), FLA_Syrk_ut_unb_var4(), FLA_Ttmm_l_unb_var2(), FLA_Ttmm_l_unb_var3(), FLA_Ttmm_u_unb_var2(), and FLA_Ttmm_u_unb_var3().

00036 {
00037   FLA_Datatype datatype;
00038   int          num_elem;
00039   int          m_x, inc_x, ldim_x;
00040   int          m_y, inc_y, ldim_y;
00041 
00042   if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING ) 
00043     FLA_Dots_check( alpha, x, y, beta, rho );
00044 
00045   if ( FLA_Obj_has_zero_dim( x ) )
00046   {
00047     FLA_Scal_external( beta, rho );
00048     return FLA_SUCCESS;
00049   }
00050 
00051   datatype = FLA_Obj_datatype( x );
00052 
00053   m_x      = FLA_Obj_length( x );
00054   ldim_x   = FLA_Obj_ldim( x );
00055 
00056   m_y      = FLA_Obj_length( y );
00057   ldim_y   = FLA_Obj_ldim( y ); 
00058 
00059   inc_x    = ( m_x == 1 ? ldim_x : 1 );
00060   inc_y    = ( m_y == 1 ? ldim_y : 1 );
00061   num_elem = FLA_Obj_vector_dim( x );
00062 
00063 
00064   switch ( datatype ){
00065   
00066   case FLA_FLOAT:
00067   {
00068     float *buff_x      = ( float * ) FLA_FLOAT_PTR( x );
00069     float *buff_y      = ( float * ) FLA_FLOAT_PTR( y );
00070     float *buff_rho    = ( float * ) FLA_FLOAT_PTR( rho );
00071     float *buff_alpha  = ( float * ) FLA_FLOAT_PTR( alpha );
00072     float *buff_beta   = ( float * ) FLA_FLOAT_PTR( beta );
00073     float  temp;
00074 
00075 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00076     temp = cblas_sdot( num_elem, 
00077                        buff_x, inc_x, 
00078                        buff_y, inc_y ); 
00079 #else
00080     temp = FLA_C2F( sdot ) ( &num_elem, 
00081                              buff_x, &inc_x, 
00082                              buff_y, &inc_y ); 
00083 #endif
00084 
00085     *buff_rho = (*buff_alpha) * temp + (*buff_beta) * (*buff_rho);
00086 
00087     break;
00088   }
00089 
00090   case FLA_DOUBLE:
00091   {
00092     double *buff_x      = ( double * ) FLA_DOUBLE_PTR( x );
00093     double *buff_y      = ( double * ) FLA_DOUBLE_PTR( y );
00094     double *buff_rho    = ( double * ) FLA_DOUBLE_PTR( rho );
00095     double *buff_alpha  = ( double * ) FLA_DOUBLE_PTR( alpha );
00096     double *buff_beta   = ( double * ) FLA_DOUBLE_PTR( beta );
00097     double  temp;
00098 
00099 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00100     temp = cblas_ddot( num_elem, 
00101                        buff_x, inc_x, 
00102                        buff_y, inc_y ); 
00103 #else
00104     temp = FLA_C2F( ddot ) ( &num_elem, 
00105                              buff_x, &inc_x, 
00106                              buff_y, &inc_y ); 
00107 #endif
00108 
00109     *buff_rho = (*buff_alpha) * temp + (*buff_beta) * (*buff_rho);
00110 
00111     break;
00112   }
00113 
00114   case FLA_COMPLEX:
00115   {
00116     scomplex *buff_x      = ( scomplex * ) FLA_COMPLEX_PTR( x );
00117     scomplex *buff_y      = ( scomplex * ) FLA_COMPLEX_PTR( y );
00118     scomplex *buff_rho    = ( scomplex * ) FLA_COMPLEX_PTR( rho );
00119     scomplex *buff_alpha  = ( scomplex * ) FLA_COMPLEX_PTR( alpha );
00120     scomplex *buff_beta   = ( scomplex * ) FLA_COMPLEX_PTR( beta );
00121     scomplex  temp, temp_rho;
00122 
00123 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00124     cblas_cdotu_sub( num_elem, 
00125                      buff_x, inc_x, 
00126                      buff_y, inc_y, &temp ); 
00127 #else
00128     // Using FLA_F2C here is not a bug! FLA_C2F() appends an (possibly) incorrect number
00129     // of underscores.
00130     FLA_F2C( fla_cdotu ) ( &num_elem, 
00131                            buff_x, &inc_x, 
00132                            buff_y, &inc_y, &temp ); 
00133 #endif
00134 
00135     temp_rho.real = buff_alpha->real * temp.real      - buff_alpha->imag * temp.imag +
00136                     buff_beta->real  * buff_rho->real - buff_beta->imag  * buff_rho->imag;
00137 
00138     temp_rho.imag = buff_alpha->real * temp.imag      + buff_alpha->imag * temp.real +
00139                     buff_beta->real  * buff_rho->imag + buff_beta->imag  * buff_rho->real;
00140 
00141     buff_rho->real = temp_rho.real;
00142     buff_rho->imag = temp_rho.imag;
00143 
00144     break;
00145   }
00146 
00147   case FLA_DOUBLE_COMPLEX:
00148   {
00149     dcomplex *buff_x      = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( x );
00150     dcomplex *buff_y      = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( y );
00151     dcomplex *buff_rho    = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( rho );
00152     dcomplex *buff_alpha  = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( alpha );
00153     dcomplex *buff_beta   = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( beta );
00154     dcomplex  temp, temp_rho;
00155 
00156 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00157     cblas_zdotu_sub( num_elem, 
00158                      buff_x, inc_x, 
00159                      buff_y, inc_y, &temp ); 
00160 #else
00161     // Using FLA_F2C here is not a bug! FLA_C2F() appends an (possibly) incorrect number
00162     // of underscores.
00163     FLA_F2C( fla_zdotu ) ( &num_elem, 
00164                            buff_x, &inc_x, 
00165                            buff_y, &inc_y, &temp ); 
00166 #endif
00167 
00168     temp_rho.real = buff_alpha->real * temp.real      - buff_alpha->imag * temp.imag +
00169                     buff_beta->real  * buff_rho->real - buff_beta->imag  * buff_rho->imag;
00170 
00171     temp_rho.imag = buff_alpha->real * temp.imag      + buff_alpha->imag * temp.real +
00172                     buff_beta->real  * buff_rho->imag + buff_beta->imag  * buff_rho->real;
00173 
00174     buff_rho->real = temp_rho.real;
00175     buff_rho->imag = temp_rho.imag;
00176 
00177     break;
00178   }
00179 
00180   }
00181   
00182   return FLA_SUCCESS;
00183 }

void FLA_F2C() fla_dots_external_f ( F_INT *  alpha,
F_INT *  X,
F_INT *  Y,
F_INT *  beta,
F_INT *  rho,
F_INT *  IERROR 
)

References FLA_Dots_external().

00187 {
00188   *IERROR = FLA_Dots_external( *( ( FLA_Obj * ) alpha ), 
00189                                *( ( FLA_Obj * ) x     ),
00190                                *( ( FLA_Obj * ) y     ), 
00191                                *( ( FLA_Obj * ) beta  ),
00192                                *( ( FLA_Obj * ) rho   ) );
00193 }

FLA_Error FLA_Iamax ( FLA_Obj  x,
FLA_Obj  index 
)

References FLA_Iamax_external().

00036 {
00037     return FLA_Iamax_external( x, index );
00038 }

FLA_Error FLA_Iamax_check ( FLA_Obj  x,
FLA_Obj  index 
)

References FLA_Check_floating_object(), FLA_Check_if_scalar(), FLA_Check_if_vector(), FLA_Check_int_object(), and FLA_Check_nonconstant_object().

Referenced by FLA_Iamax_external().

00036 {
00037   FLA_Error e_val;
00038 
00039   e_val = FLA_Check_floating_object( x );
00040   FLA_Check_error_code( e_val );
00041 
00042   e_val = FLA_Check_nonconstant_object( x );
00043   FLA_Check_error_code( e_val );
00044 
00045   e_val = FLA_Check_if_vector( x );
00046   FLA_Check_error_code( e_val );
00047 
00048   e_val = FLA_Check_int_object( index ); 
00049   FLA_Check_error_code( e_val );
00050 
00051   e_val = FLA_Check_nonconstant_object( index );
00052   FLA_Check_error_code( e_val );
00053 
00054   e_val = FLA_Check_if_scalar( index );
00055   FLA_Check_error_code( e_val );
00056 
00057   return FLA_SUCCESS;
00058 }

FLA_Error FLA_Iamax_external ( FLA_Obj  x,
FLA_Obj  index 
)

References cblas_icamax(), cblas_idamax(), cblas_isamax(), cblas_izamax(), FLA_Check_error_level(), FLA_Iamax_check(), FLA_Obj_datatype(), FLA_Obj_has_zero_dim(), FLA_Obj_ldim(), FLA_Obj_length(), FLA_Obj_vector_dim(), icamax(), idamax(), isamax(), and izamax().

Referenced by FLA_Iamax(), fla_iamax_external_f(), FLA_LU_piv_unb_var3(), FLA_LU_piv_unb_var3b(), FLA_LU_piv_unb_var4(), and FLA_LU_piv_unb_var5().

00036 {
00037   FLA_Datatype datatype;
00038   int          num_elem;
00039   int          m_x, inc_x, ldim_x;
00040   int         *buff_index;
00041 
00042   if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING ) 
00043     FLA_Iamax_check( x, index );
00044 
00045   buff_index = ( int * ) FLA_INT_PTR( index );
00046 
00047   if ( FLA_Obj_has_zero_dim( x ) )
00048   {
00049     *buff_index = 0;
00050     return FLA_SUCCESS;
00051   }
00052 
00053   datatype = FLA_Obj_datatype( x );
00054 
00055   m_x      = FLA_Obj_length( x );
00056   ldim_x   = FLA_Obj_ldim( x );
00057 
00058   inc_x    = ( m_x == 1 ? ldim_x : 1 );
00059   num_elem = FLA_Obj_vector_dim( x );
00060 
00061 
00062   switch ( datatype ){
00063 
00064   case FLA_FLOAT:
00065   {
00066     float* buff_x = ( float * ) FLA_FLOAT_PTR( x );
00067 
00068 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00069     *buff_index = cblas_isamax( num_elem, buff_x, inc_x );
00070 #else
00071     *buff_index = FLA_C2F( isamax )( &num_elem, buff_x, &inc_x ) - 1;
00072 #endif
00073 
00074     break;
00075   }
00076   
00077   case FLA_DOUBLE:
00078   {
00079     double* buff_x = ( double * ) FLA_DOUBLE_PTR( x );
00080 
00081 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00082     *buff_index = cblas_idamax( num_elem, buff_x, inc_x );
00083 #else
00084     *buff_index = FLA_C2F( idamax )( &num_elem, buff_x, &inc_x ) - 1;
00085 #endif
00086 
00087     break;
00088   }
00089   
00090   case FLA_COMPLEX:
00091   {
00092     scomplex* buff_x = ( scomplex * ) FLA_COMPLEX_PTR( x );
00093 
00094 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00095     *buff_index = cblas_icamax( num_elem, buff_x, inc_x );
00096 #else
00097     *buff_index = FLA_C2F( icamax )( &num_elem, buff_x, &inc_x ) - 1;
00098 #endif
00099 
00100     break;
00101   }
00102 
00103   case FLA_DOUBLE_COMPLEX:
00104   {
00105     dcomplex* buff_x = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( x );
00106 
00107 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00108     *buff_index = cblas_izamax( num_elem, buff_x, inc_x );
00109 #else
00110     *buff_index = FLA_C2F( izamax )( &num_elem, buff_x, &inc_x ) - 1;
00111 #endif
00112 
00113     break;
00114   }
00115 
00116   }
00117 
00118   return FLA_SUCCESS;
00119 }

void FLA_F2C() fla_iamax_external_f ( F_INT *  X,
F_INT *  index,
F_INT *  IERROR 
)

References FLA_Iamax_external().

00123 {
00124   *IERROR = FLA_Iamax_external( *( ( FLA_Obj * ) x     ),
00125                                 *( ( FLA_Obj * ) index ) );
00126 }

FLA_Error FLA_Inv_scal ( FLA_Obj  alpha,
FLA_Obj  A 
)

References FLA_Inv_scal_external().

00036 {
00037     return FLA_Inv_scal_external( alpha, A );
00038 }

FLA_Error FLA_Inv_scal_check ( FLA_Obj  alpha,
FLA_Obj  A 
)

References FLA_Check_consistent_object_datatype(), FLA_Check_divide_by_zero(), FLA_Check_floating_object(), FLA_Check_identical_object_precision(), FLA_Check_if_scalar(), FLA_Check_nonconstant_object(), and FLA_Obj_is_real().

Referenced by FLA_Inv_scal_external().

00036 {
00037   FLA_Error e_val;
00038 
00039   e_val = FLA_Check_floating_object( A );
00040   FLA_Check_error_code( e_val );
00041 
00042   e_val = FLA_Check_nonconstant_object( A );
00043   FLA_Check_error_code( e_val );
00044 
00045   if ( FLA_Obj_is_real( A ) )
00046   {
00047     e_val = FLA_Check_consistent_object_datatype( A, alpha );
00048     FLA_Check_error_code( e_val );
00049   }
00050   else
00051   {
00052     e_val = FLA_Check_identical_object_precision( A, alpha );
00053     FLA_Check_error_code( e_val );
00054   }
00055 
00056   e_val = FLA_Check_if_scalar( alpha );
00057   FLA_Check_error_code( e_val );
00058 
00059   e_val = FLA_Check_divide_by_zero( alpha );
00060   FLA_Check_error_code( e_val );
00061 
00062   return FLA_SUCCESS;
00063 }

FLA_Error FLA_Inv_scal_external ( FLA_Obj  alpha,
FLA_Obj  A 
)

References cblas_cscal(), cblas_csscal(), cblas_dscal(), cblas_sscal(), cblas_zdscal(), cblas_zscal(), cscal(), csscal(), dscal(), FLA_Check_error_level(), FLA_Inv_scal_check(), FLA_MINUS_ONE, FLA_Negate(), FLA_Obj_datatype(), FLA_Obj_equals(), FLA_Obj_has_zero_dim(), FLA_Obj_is_vector(), FLA_Obj_ldim(), FLA_Obj_length(), FLA_Obj_vector_dim(), FLA_Obj_width(), FLA_ONE, dcomplex::imag, scomplex::imag, dcomplex::real, scomplex::real, sscal(), zdscal(), and zscal().

Referenced by FLA_Chol_l_unb_var2(), FLA_Chol_l_unb_var3(), FLA_Chol_u_unb_var2(), FLA_Chol_u_unb_var3(), FLA_Inv_scal(), fla_inv_scal_external_f(), FLA_LU_nopiv_unb_var3(), FLA_LU_nopiv_unb_var4(), FLA_LU_nopiv_unb_var5(), FLA_LU_piv_unb_var3(), FLA_LU_piv_unb_var3b(), FLA_LU_piv_unb_var4(), FLA_LU_piv_unb_var5(), FLA_Trsm_lln_unb_var1(), FLA_Trsm_lln_unb_var2(), FLA_Trsm_llt_unb_var1(), FLA_Trsm_llt_unb_var2(), FLA_Trsm_lun_unb_var1(), FLA_Trsm_lun_unb_var2(), FLA_Trsm_lut_unb_var1(), FLA_Trsm_lut_unb_var2(), FLA_Trsm_rln_unb_var1(), FLA_Trsm_rln_unb_var2(), FLA_Trsm_rlt_unb_var1(), FLA_Trsm_rlt_unb_var2(), FLA_Trsm_run_unb_var1(), FLA_Trsm_run_unb_var2(), FLA_Trsm_rut_unb_var1(), and FLA_Trsm_rut_unb_var2().

00036 {
00037   FLA_Datatype datatype, dt_alpha;
00038   int          j, n_iter;
00039   int          num_elem;
00040   int          m_A, n_A, inc_A, ldim_A;
00041 
00042   if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING ) 
00043     FLA_Inv_scal_check( alpha, A );
00044  
00045   if ( FLA_Obj_has_zero_dim( A ) ) return FLA_SUCCESS;
00046 
00047   if ( FLA_Obj_equals( alpha, FLA_ONE ) )
00048   {
00049     return FLA_SUCCESS;
00050   }
00051   else if ( FLA_Obj_equals( alpha, FLA_MINUS_ONE ) )
00052   {
00053     FLA_Negate( A );
00054     return FLA_SUCCESS;
00055   }
00056 
00057   dt_alpha = FLA_Obj_datatype( alpha );
00058   datatype = FLA_Obj_datatype( A );
00059 
00060   m_A      = FLA_Obj_length( A );
00061   n_A      = FLA_Obj_width( A );
00062   ldim_A   = FLA_Obj_ldim( A );
00063 
00064   if ( FLA_Obj_is_vector( A ) )
00065   {
00066     inc_A    = ( m_A == 1 ? ldim_A : 1 );
00067     n_iter   = 1;
00068     num_elem = FLA_Obj_vector_dim( A );
00069   }
00070   else
00071   {
00072     inc_A    = 1;
00073     n_iter   = n_A;
00074     num_elem = m_A;
00075   }
00076 
00077   switch ( datatype ){
00078 
00079   case FLA_FLOAT:
00080   {
00081     float *buff_A     = ( float * ) FLA_FLOAT_PTR( A );
00082     float *buff_alpha = ( float * ) FLA_FLOAT_PTR( alpha );
00083     float  alpha_inv  =             1.0F / (*buff_alpha);
00084 
00085     for ( j = 0; j < n_iter; ++j )
00086     {
00087 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00088       cblas_sscal( num_elem,
00089                    alpha_inv,   
00090                    buff_A + j*ldim_A, inc_A );
00091 #else
00092       FLA_C2F( sscal )( &num_elem,
00093                         &alpha_inv,   
00094                         buff_A + j*ldim_A, &inc_A );
00095 #endif
00096     }
00097 
00098     break;
00099   }
00100 
00101   case FLA_DOUBLE:
00102   {
00103     double *buff_A     = ( double * ) FLA_DOUBLE_PTR( A );
00104     double *buff_alpha = ( double * ) FLA_DOUBLE_PTR( alpha );
00105     double  alpha_inv  =              1.0 / (*buff_alpha);
00106 
00107     for ( j = 0; j < n_iter; ++j )
00108     {
00109 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00110       cblas_dscal( num_elem,
00111                    alpha_inv,   
00112                    buff_A + j*ldim_A, inc_A );
00113 #else
00114       FLA_C2F( dscal )( &num_elem,
00115                         &alpha_inv,   
00116                         buff_A + j*ldim_A, &inc_A );
00117 #endif
00118     }
00119 
00120     break;
00121   }
00122 
00123   case FLA_COMPLEX:
00124   {
00125     if ( dt_alpha == FLA_COMPLEX )
00126     {
00127       scomplex *buff_A     = ( scomplex * ) FLA_COMPLEX_PTR( A );
00128       scomplex *buff_alpha = ( scomplex * ) FLA_COMPLEX_PTR( alpha );
00129       scomplex  alpha_inv;
00130       float     temp;
00131 
00132       temp = 1.0F / ( buff_alpha->real * buff_alpha->real +
00133                       buff_alpha->imag * buff_alpha->imag );
00134 
00135       alpha_inv.real = buff_alpha->real *  temp;
00136       alpha_inv.imag = buff_alpha->imag * -temp;
00137 
00138       for ( j = 0; j < n_iter; ++j )
00139       {
00140 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00141         cblas_cscal( num_elem,
00142                      alpha_inv,   
00143                      buff_A + j*ldim_A, inc_A );
00144 #else
00145         FLA_C2F( cscal )( &num_elem,
00146                           &alpha_inv,   
00147                           buff_A + j*ldim_A, &inc_A );
00148 #endif
00149       }
00150     }
00151     else if ( dt_alpha == FLA_FLOAT )
00152     {
00153       scomplex *buff_A     = ( scomplex * ) FLA_FLOAT_PTR( A );
00154       float    *buff_alpha = ( float    * ) FLA_FLOAT_PTR( alpha );
00155       float     alpha_inv  =                1.0F / (*buff_alpha);
00156 
00157       for ( j = 0; j < n_iter; ++j )
00158       {
00159 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00160         cblas_csscal( num_elem,
00161                       alpha_inv,
00162                       buff_A + j*ldim_A, inc_A );
00163 #else
00164         FLA_C2F( csscal )( &num_elem,
00165                            &alpha_inv,
00166                            buff_A + j*ldim_A, &inc_A );
00167 #endif
00168       }
00169     }
00170 
00171     break;
00172   }
00173 
00174   case FLA_DOUBLE_COMPLEX:
00175   { 
00176     if ( dt_alpha == FLA_DOUBLE_COMPLEX )
00177     {
00178       dcomplex *buff_A     = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
00179       dcomplex *buff_alpha = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( alpha );
00180       dcomplex  alpha_inv;
00181       double    temp;
00182 
00183       temp = 1.0 / ( buff_alpha->real * buff_alpha->real +
00184                      buff_alpha->imag * buff_alpha->imag );
00185 
00186       alpha_inv.real = buff_alpha->real *  temp;
00187       alpha_inv.imag = buff_alpha->imag * -temp;
00188  
00189       for ( j = 0; j < n_iter; ++j )
00190       {
00191 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00192         cblas_zscal( num_elem,
00193                      alpha_inv,   
00194                      buff_A + j*ldim_A, inc_A );
00195 #else
00196         FLA_C2F( zscal )( &num_elem,
00197                           &alpha_inv,   
00198                           buff_A + j*ldim_A, &inc_A );
00199 #endif
00200       }
00201     }
00202     else if ( dt_alpha == FLA_DOUBLE )
00203     {
00204       dcomplex *buff_A     = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
00205       double   *buff_alpha = ( double   * ) FLA_DOUBLE_PTR( alpha );
00206       double    alpha_inv  =                1.0 / (*buff_alpha);
00207 
00208       for ( j = 0; j < n_iter; ++j )
00209       {
00210 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00211         cblas_zdscal( num_elem,
00212                       alpha_inv,   
00213                       buff_A + j*ldim_A, inc_A );
00214 #else
00215         FLA_C2F( zdscal )( &num_elem,
00216                            &alpha_inv,   
00217                            buff_A + j*ldim_A, &inc_A );
00218 #endif
00219       }
00220     }
00221 
00222     break;
00223   }
00224 
00225   }
00226   
00227   return FLA_SUCCESS;
00228 }

void FLA_F2C() fla_inv_scal_external_f ( F_INT *  alpha,
F_INT *  A,
F_INT *  IERROR 
)

References FLA_Inv_scal_external().

00232 {
00233   *IERROR = FLA_Inv_scal_external( *( ( FLA_Obj * ) alpha ),
00234                                    *( ( FLA_Obj * ) A     ) );
00235 }

FLA_Error FLA_Inv_scalc ( FLA_Conj  conjalpha,
FLA_Obj  alpha,
FLA_Obj  A 
)

References FLA_Inv_scalc_external().

00036 {
00037     return FLA_Inv_scalc_external( conjalpha, alpha, A );
00038 }

FLA_Error FLA_Inv_scalc_check ( FLA_Conj  conjalpha,
FLA_Obj  alpha,
FLA_Obj  A 
)

References FLA_Check_consistent_object_datatype(), FLA_Check_divide_by_zero(), FLA_Check_floating_object(), FLA_Check_identical_object_precision(), FLA_Check_if_scalar(), FLA_Check_nonconstant_object(), FLA_Check_valid_conj(), and FLA_Obj_is_real().

Referenced by FLA_Inv_scalc_external().

00036 {
00037   FLA_Error e_val;
00038 
00039   e_val = FLA_Check_valid_conj( conjalpha );
00040   FLA_Check_error_code( e_val );
00041 
00042   e_val = FLA_Check_floating_object( A );
00043   FLA_Check_error_code( e_val );
00044 
00045   e_val = FLA_Check_nonconstant_object( A );
00046   FLA_Check_error_code( e_val );
00047 
00048   if ( FLA_Obj_is_real( A ) )
00049   {
00050     e_val = FLA_Check_consistent_object_datatype( A, alpha );
00051     FLA_Check_error_code( e_val );
00052   }
00053   else
00054   {
00055     e_val = FLA_Check_identical_object_precision( A, alpha );
00056     FLA_Check_error_code( e_val );
00057   }
00058 
00059   e_val = FLA_Check_if_scalar( alpha );
00060   FLA_Check_error_code( e_val );
00061 
00062   e_val = FLA_Check_divide_by_zero( alpha );
00063   FLA_Check_error_code( e_val );
00064 
00065   return FLA_SUCCESS;
00066 }

FLA_Error FLA_Inv_scalc_external ( FLA_Conj  conjalpha,
FLA_Obj  alpha,
FLA_Obj  A 
)

References cblas_cscal(), cblas_csscal(), cblas_dscal(), cblas_sscal(), cblas_zdscal(), cblas_zscal(), cscal(), csscal(), dscal(), FLA_Check_error_level(), FLA_Inv_scalc_check(), FLA_MINUS_ONE, FLA_Negate(), FLA_Obj_datatype(), FLA_Obj_equals(), FLA_Obj_has_zero_dim(), FLA_Obj_is_vector(), FLA_Obj_ldim(), FLA_Obj_length(), FLA_Obj_vector_dim(), FLA_Obj_width(), FLA_ONE, dcomplex::imag, scomplex::imag, dcomplex::real, scomplex::real, sscal(), zdscal(), and zscal().

Referenced by FLA_Apply_househ2_UT(), FLA_Inv_scalc(), fla_inv_scalc_external_f(), FLA_Trsm_llh_unb_var1(), FLA_Trsm_llh_unb_var2(), FLA_Trsm_luh_unb_var1(), FLA_Trsm_luh_unb_var2(), FLA_Trsm_rlh_unb_var1(), FLA_Trsm_rlh_unb_var2(), FLA_Trsm_ruh_unb_var1(), and FLA_Trsm_ruh_unb_var2().

00036 {
00037   FLA_Datatype datatype, dt_alpha;
00038   int          j, n_iter;
00039   int          num_elem;
00040   int          m_A, n_A, inc_A, ldim_A;
00041 
00042   if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING ) 
00043     FLA_Inv_scalc_check( conjalpha, alpha, A );
00044  
00045   if ( FLA_Obj_has_zero_dim( A ) ) return FLA_SUCCESS;
00046 
00047   if ( FLA_Obj_equals( alpha, FLA_ONE ) )
00048   {
00049     return FLA_SUCCESS;
00050   }
00051   else if ( FLA_Obj_equals( alpha, FLA_MINUS_ONE ) )
00052   {
00053     FLA_Negate( A );
00054     return FLA_SUCCESS;
00055   }
00056 
00057   dt_alpha = FLA_Obj_datatype( alpha );
00058   datatype = FLA_Obj_datatype( A );
00059 
00060   m_A      = FLA_Obj_length( A );
00061   n_A      = FLA_Obj_width( A );
00062   ldim_A   = FLA_Obj_ldim( A );
00063 
00064   if ( FLA_Obj_is_vector( A ) )
00065   {
00066     inc_A    = ( m_A == 1 ? ldim_A : 1 );
00067     n_iter   = 1;
00068     num_elem = FLA_Obj_vector_dim( A );
00069   }
00070   else
00071   {
00072     inc_A    = 1;
00073     n_iter   = n_A;
00074     num_elem = m_A;
00075   }
00076 
00077   switch ( datatype ){
00078 
00079   case FLA_FLOAT:
00080   {
00081     float *buff_A     = ( float * ) FLA_FLOAT_PTR( A );
00082     float *buff_alpha = ( float * ) FLA_FLOAT_PTR( alpha );
00083     float  alpha_inv  =             1.0F / (*buff_alpha);
00084 
00085     for ( j = 0; j < n_iter; ++j )
00086     {
00087 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00088       cblas_sscal( num_elem,
00089                    alpha_inv,   
00090                    buff_A + j*ldim_A, inc_A );
00091 #else
00092       FLA_C2F( sscal )( &num_elem,
00093                         &alpha_inv,   
00094                         buff_A + j*ldim_A, &inc_A );
00095 #endif
00096     }
00097 
00098     break;
00099   }
00100 
00101   case FLA_DOUBLE:
00102   {
00103     double *buff_A     = ( double * ) FLA_DOUBLE_PTR( A );
00104     double *buff_alpha = ( double * ) FLA_DOUBLE_PTR( alpha );
00105     double  alpha_inv  =              1.0 / (*buff_alpha);
00106 
00107     for ( j = 0; j < n_iter; ++j )
00108     {
00109 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00110       cblas_dscal( num_elem,
00111                    alpha_inv,   
00112                    buff_A + j*ldim_A, inc_A );
00113 #else
00114       FLA_C2F( dscal )( &num_elem,
00115                         &alpha_inv,   
00116                         buff_A + j*ldim_A, &inc_A );
00117 #endif
00118     }
00119 
00120     break;
00121   }
00122 
00123   case FLA_COMPLEX:
00124   {
00125     if ( dt_alpha == FLA_COMPLEX )
00126     {
00127       scomplex *buff_A     = ( scomplex * ) FLA_COMPLEX_PTR( A );
00128       scomplex *buff_alpha = ( scomplex * ) FLA_COMPLEX_PTR( alpha );
00129       scomplex  alpha_inv;
00130       float     temp;
00131 
00132       temp = 1.0F / ( buff_alpha->real * buff_alpha->real +
00133                       buff_alpha->imag * buff_alpha->imag );
00134 
00135       if ( conjalpha == FLA_CONJUGATE )
00136       {
00137         alpha_inv.real = buff_alpha->real * temp; 
00138         alpha_inv.imag = buff_alpha->imag * temp; 
00139       }
00140       else
00141       {
00142         alpha_inv.real = buff_alpha->real * temp; 
00143         alpha_inv.imag = buff_alpha->imag * -temp; 
00144       }
00145 
00146       for ( j = 0; j < n_iter; ++j )
00147       {
00148 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00149         cblas_cscal( num_elem,
00150                      alpha_inv,   
00151                      buff_A + j*ldim_A, inc_A );
00152 #else
00153         FLA_C2F( cscal )( &num_elem,
00154                           &alpha_inv,   
00155                           buff_A + j*ldim_A, &inc_A );
00156 #endif
00157       }
00158     }
00159     else if ( dt_alpha == FLA_FLOAT )
00160     {
00161       scomplex *buff_A     = ( scomplex * ) FLA_FLOAT_PTR( A );
00162       float    *buff_alpha = ( float    * ) FLA_FLOAT_PTR( alpha );
00163       float     alpha_inv  =                1.0F / (*buff_alpha);
00164 
00165       for ( j = 0; j < n_iter; ++j )
00166       {
00167 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00168         cblas_csscal( num_elem,
00169                       alpha_inv,
00170                       buff_A + j*ldim_A, inc_A );
00171 #else
00172         FLA_C2F( csscal )( &num_elem,
00173                            &alpha_inv,
00174                            buff_A + j*ldim_A, &inc_A );
00175 #endif
00176       }
00177     }
00178 
00179     break;
00180   }
00181 
00182   case FLA_DOUBLE_COMPLEX:
00183   { 
00184     if ( dt_alpha == FLA_DOUBLE_COMPLEX )
00185     {
00186       dcomplex *buff_A     = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
00187       dcomplex *buff_alpha = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( alpha );
00188       dcomplex  alpha_inv;
00189       double    temp;
00190 
00191       temp = 1.0 / ( buff_alpha->real * buff_alpha->real +
00192                      buff_alpha->imag * buff_alpha->imag );
00193 
00194       if ( conjalpha == FLA_CONJUGATE )
00195       {
00196         alpha_inv.real = buff_alpha->real * temp; 
00197         alpha_inv.imag = buff_alpha->imag * temp; 
00198       }
00199       else
00200       {
00201         alpha_inv.real = buff_alpha->real * temp; 
00202         alpha_inv.imag = buff_alpha->imag * -temp; 
00203       }
00204  
00205       for ( j = 0; j < n_iter; ++j )
00206       {
00207 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00208         cblas_zscal( num_elem,
00209                      alpha_inv,   
00210                      buff_A + j*ldim_A, inc_A );
00211 #else
00212         FLA_C2F( zscal )( &num_elem,
00213                           &alpha_inv,   
00214                           buff_A + j*ldim_A, &inc_A );
00215 #endif
00216       }
00217     }
00218     else if ( dt_alpha == FLA_DOUBLE )
00219     {
00220       dcomplex *buff_A     = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
00221       double   *buff_alpha = ( double   * ) FLA_DOUBLE_PTR( alpha );
00222       double    alpha_inv  =                1.0 / (*buff_alpha);
00223 
00224       for ( j = 0; j < n_iter; ++j )
00225       {
00226 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00227         cblas_zdscal( num_elem,
00228                       alpha_inv,   
00229                       buff_A + j*ldim_A, inc_A );
00230 #else
00231         FLA_C2F( zdscal )( &num_elem,
00232                            &alpha_inv,   
00233                            buff_A + j*ldim_A, &inc_A );
00234 #endif
00235       }
00236     }
00237 
00238     break;
00239   }
00240 
00241   }
00242   
00243   return FLA_SUCCESS;
00244 }

void FLA_F2C() fla_inv_scalc_external_f ( F_INT *  conjalpha,
F_INT *  alpha,
F_INT *  A,
F_INT *  IERROR 
)

References FLA_Inv_scalc_external().

00248 {
00249   *IERROR = FLA_Inv_scalc_external( *( ( FLA_Conj * ) conjalpha ),
00250                                     *( ( FLA_Obj  * ) alpha     ),
00251                                     *( ( FLA_Obj  * ) A         ) );
00252 }

FLA_Error FLA_Nrm2 ( FLA_Obj  x,
FLA_Obj  norm_x 
)

References FLA_Nrm2_external().

00036 {
00037     return FLA_Nrm2_external( x, norm_x );
00038 }

FLA_Error FLA_Nrm2_check ( FLA_Obj  x,
FLA_Obj  nrm_x 
)

References FLA_Check_floating_object(), FLA_Check_identical_object_precision(), FLA_Check_if_scalar(), FLA_Check_if_vector(), FLA_Check_nonconstant_object(), and FLA_Check_real_object().

Referenced by FLA_Nrm2_external().

00036 {
00037   FLA_Error e_val;
00038 
00039   e_val = FLA_Check_floating_object( x );
00040   FLA_Check_error_code( e_val );
00041 
00042   e_val = FLA_Check_nonconstant_object( x );
00043   FLA_Check_error_code( e_val );
00044 
00045   e_val = FLA_Check_real_object( nrm_x );
00046   FLA_Check_error_code( e_val );
00047 
00048   e_val = FLA_Check_nonconstant_object( nrm_x );
00049   FLA_Check_error_code( e_val );
00050 
00051   e_val = FLA_Check_identical_object_precision( x, nrm_x );
00052   FLA_Check_error_code( e_val );
00053 
00054   e_val = FLA_Check_if_scalar( nrm_x );
00055   FLA_Check_error_code( e_val );
00056 
00057   e_val = FLA_Check_if_vector( x );
00058   FLA_Check_error_code( e_val );
00059 
00060   return FLA_SUCCESS;
00061 }

FLA_Error FLA_Nrm2_external ( FLA_Obj  x,
FLA_Obj  nrm_x 
)

References cblas_dnrm2(), cblas_dznrm2(), cblas_scnrm2(), cblas_snrm2(), dnrm2(), dznrm2(), FLA_Check_error_level(), FLA_Nrm2_check(), FLA_Obj_datatype(), FLA_Obj_has_zero_dim(), FLA_Obj_ldim(), FLA_Obj_length(), FLA_Obj_set_to_scalar(), FLA_Obj_vector_dim(), FLA_ZERO, scnrm2(), and snrm2().

Referenced by FLA_Nrm2(), and fla_nrm2_external_f().

00036 {
00037   FLA_Datatype datatype;
00038   int          num_elem;
00039   int          m_x, inc_x, ldim_x;
00040 
00041   if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING ) 
00042     FLA_Nrm2_check( x, norm_x );
00043 
00044   if ( FLA_Obj_has_zero_dim( x ) )
00045   {
00046     FLA_Obj_set_to_scalar( FLA_ZERO, norm_x );
00047     return FLA_SUCCESS;
00048   }
00049 
00050   datatype = FLA_Obj_datatype( x );
00051 
00052   m_x      = FLA_Obj_length( x );
00053   ldim_x   = FLA_Obj_ldim( x );
00054 
00055   inc_x    = ( m_x == 1 ? ldim_x : 1 );
00056   num_elem = FLA_Obj_vector_dim( x );
00057 
00058 
00059   switch ( datatype ){
00060 
00061   case FLA_FLOAT:
00062   {
00063     float *buff_x      = ( float * ) FLA_FLOAT_PTR( x );
00064     float *buff_norm_x = ( float * ) FLA_FLOAT_PTR( norm_x );
00065 
00066 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00067     *buff_norm_x = cblas_snrm2( num_elem, buff_x, inc_x );
00068 #else
00069     *buff_norm_x = FLA_C2F( snrm2 ) ( &num_elem, buff_x, &inc_x );
00070 #endif
00071 
00072     break;
00073   }
00074 
00075   case FLA_DOUBLE:
00076   {
00077     double *buff_x      = ( double * ) FLA_DOUBLE_PTR( x );
00078     double *buff_norm_x = ( double * ) FLA_DOUBLE_PTR( norm_x );
00079 
00080 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00081     *buff_norm_x = cblas_dnrm2( num_elem, buff_x, inc_x );
00082 #else
00083     *buff_norm_x = FLA_C2F( dnrm2 ) ( &num_elem, buff_x, &inc_x );
00084 #endif
00085 
00086     break;
00087   }
00088 
00089   case FLA_COMPLEX:
00090   {
00091     scomplex *buff_x      = ( scomplex * ) FLA_COMPLEX_PTR( x );
00092     float    *buff_norm_x = ( float    * ) FLA_COMPLEX_PTR( norm_x );
00093 
00094 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00095     *buff_norm_x = cblas_scnrm2( num_elem, buff_x, inc_x );
00096 #else
00097     *buff_norm_x = FLA_C2F( scnrm2 ) ( &num_elem, buff_x, &inc_x );
00098 #endif
00099 
00100     break;
00101   }
00102 
00103   case FLA_DOUBLE_COMPLEX:
00104   {
00105     dcomplex *buff_x      = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( x );
00106     double   *buff_norm_x = ( double   * ) FLA_DOUBLE_COMPLEX_PTR( norm_x );
00107 
00108 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00109     *buff_norm_x = cblas_dznrm2( num_elem, buff_x, inc_x );
00110 #else
00111     *buff_norm_x = FLA_C2F( dznrm2 ) ( &num_elem, buff_x, &inc_x );
00112 #endif
00113 
00114     break;
00115   }
00116 
00117   }
00118   
00119   return FLA_SUCCESS;
00120 }

void FLA_F2C() fla_nrm2_external_f ( F_INT *  X,
F_INT *  rho,
F_INT *  IERROR 
)

References FLA_Nrm2_external().

00125 {
00126   *IERROR = FLA_Nrm2_external( *( ( FLA_Obj * ) x      ),
00127                                *( ( FLA_Obj * ) norm_x ) );
00128 }

FLA_Error FLA_Scal ( FLA_Obj  alpha,
FLA_Obj  A 
)

References FLA_Scal_external().

00036 {
00037     return FLA_Scal_external( alpha, A );
00038 }

FLA_Error FLA_Scal_check ( FLA_Obj  alpha,
FLA_Obj  A 
)

References FLA_Check_consistent_object_datatype(), FLA_Check_floating_object(), FLA_Check_identical_object_precision(), FLA_Check_if_scalar(), FLA_Check_nonconstant_object(), and FLA_Obj_is_real().

Referenced by FLA_Scal_external().

00036 {
00037   FLA_Error e_val;
00038 
00039   e_val = FLA_Check_floating_object( A );
00040   FLA_Check_error_code( e_val );
00041 
00042   e_val = FLA_Check_nonconstant_object( A );
00043   FLA_Check_error_code( e_val );
00044 
00045   if ( FLA_Obj_is_real( A ) )
00046   {
00047     e_val = FLA_Check_consistent_object_datatype( A, alpha );
00048     FLA_Check_error_code( e_val );
00049   }
00050   else
00051   {
00052     e_val = FLA_Check_identical_object_precision( A, alpha );
00053     FLA_Check_error_code( e_val );
00054   }
00055 
00056   e_val = FLA_Check_if_scalar( alpha );
00057   FLA_Check_error_code( e_val );
00058 
00059   return FLA_SUCCESS;
00060 }

FLA_Error FLA_Scal_external ( FLA_Obj  alpha,
FLA_Obj  A 
)

References cblas_cscal(), cblas_csscal(), cblas_dscal(), cblas_sscal(), cblas_zdscal(), cblas_zscal(), cscal(), csscal(), dscal(), FLA_Check_error_level(), FLA_Obj_datatype(), FLA_Obj_equals(), FLA_Obj_has_zero_dim(), FLA_Obj_is_vector(), FLA_Obj_ldim(), FLA_Obj_length(), FLA_Obj_set_to_scalar(), FLA_Obj_vector_dim(), FLA_Obj_width(), FLA_ONE, FLA_Scal_check(), FLA_ZERO, sscal(), zdscal(), and zscal().

Referenced by FLA_Axpys_external(), FLA_Dot2cs_external(), FLA_Dot2s_external(), FLA_Dotcs_external(), FLA_Dots_external(), FLA_Gemm_external(), FLA_Gemm_hh_unb_var1(), FLA_Gemm_hh_unb_var2(), FLA_Gemm_hh_unb_var3(), FLA_Gemm_hh_unb_var4(), FLA_Gemm_hh_unb_var5(), FLA_Gemm_hh_unb_var6(), FLA_Gemm_hn_unb_var1(), FLA_Gemm_hn_unb_var2(), FLA_Gemm_hn_unb_var3(), FLA_Gemm_hn_unb_var4(), FLA_Gemm_hn_unb_var5(), FLA_Gemm_hn_unb_var6(), FLA_Gemm_ht_unb_var1(), FLA_Gemm_ht_unb_var2(), FLA_Gemm_ht_unb_var3(), FLA_Gemm_ht_unb_var4(), FLA_Gemm_ht_unb_var5(), FLA_Gemm_ht_unb_var6(), FLA_Gemm_nh_unb_var1(), FLA_Gemm_nh_unb_var2(), FLA_Gemm_nh_unb_var3(), FLA_Gemm_nh_unb_var4(), FLA_Gemm_nh_unb_var5(), FLA_Gemm_nh_unb_var6(), FLA_Gemm_nn_unb_var1(), FLA_Gemm_nn_unb_var2(), FLA_Gemm_nn_unb_var3(), FLA_Gemm_nn_unb_var4(), FLA_Gemm_nn_unb_var5(), FLA_Gemm_nn_unb_var6(), FLA_Gemm_nt_unb_var1(), FLA_Gemm_nt_unb_var2(), FLA_Gemm_nt_unb_var3(), FLA_Gemm_nt_unb_var4(), FLA_Gemm_nt_unb_var5(), FLA_Gemm_nt_unb_var6(), FLA_Gemm_th_unb_var1(), FLA_Gemm_th_unb_var2(), FLA_Gemm_th_unb_var3(), FLA_Gemm_th_unb_var4(), FLA_Gemm_th_unb_var5(), FLA_Gemm_th_unb_var6(), FLA_Gemm_tn_unb_var1(), FLA_Gemm_tn_unb_var2(), FLA_Gemm_tn_unb_var3(), FLA_Gemm_tn_unb_var4(), FLA_Gemm_tn_unb_var5(), FLA_Gemm_tn_unb_var6(), FLA_Gemm_tt_unb_var1(), FLA_Gemm_tt_unb_var2(), FLA_Gemm_tt_unb_var3(), FLA_Gemm_tt_unb_var4(), FLA_Gemm_tt_unb_var5(), FLA_Gemm_tt_unb_var6(), FLA_Negate(), FLA_Scal(), fla_scal_external_f(), FLA_Trinv_l_unb_var1(), FLA_Trinv_l_unb_var2(), FLA_Trinv_l_unb_var3(), FLA_Trinv_l_unb_var4(), FLA_Trinv_u_unb_var1(), FLA_Trinv_u_unb_var2(), FLA_Trinv_u_unb_var3(), FLA_Trinv_u_unb_var4(), FLA_Trmm_llh_unb_var1(), FLA_Trmm_llh_unb_var2(), FLA_Trmm_llh_unb_var3(), FLA_Trmm_llh_unb_var4(), FLA_Trmm_lln_unb_var1(), FLA_Trmm_lln_unb_var2(), FLA_Trmm_lln_unb_var3(), FLA_Trmm_lln_unb_var4(), FLA_Trmm_llt_unb_var1(), FLA_Trmm_llt_unb_var2(), FLA_Trmm_llt_unb_var3(), FLA_Trmm_llt_unb_var4(), FLA_Trmm_luh_unb_var1(), FLA_Trmm_luh_unb_var2(), FLA_Trmm_luh_unb_var3(), FLA_Trmm_luh_unb_var4(), FLA_Trmm_lun_unb_var1(), FLA_Trmm_lun_unb_var2(), FLA_Trmm_lun_unb_var3(), FLA_Trmm_lun_unb_var4(), FLA_Trmm_lut_unb_var1(), FLA_Trmm_lut_unb_var2(), FLA_Trmm_lut_unb_var3(), FLA_Trmm_lut_unb_var4(), FLA_Trmm_rlh_unb_var1(), FLA_Trmm_rlh_unb_var2(), FLA_Trmm_rlh_unb_var3(), FLA_Trmm_rlh_unb_var4(), FLA_Trmm_rln_unb_var1(), FLA_Trmm_rln_unb_var2(), FLA_Trmm_rln_unb_var3(), FLA_Trmm_rln_unb_var4(), FLA_Trmm_rlt_unb_var1(), FLA_Trmm_rlt_unb_var2(), FLA_Trmm_rlt_unb_var3(), FLA_Trmm_rlt_unb_var4(), FLA_Trmm_ruh_unb_var1(), FLA_Trmm_ruh_unb_var2(), FLA_Trmm_ruh_unb_var3(), FLA_Trmm_ruh_unb_var4(), FLA_Trmm_run_unb_var1(), FLA_Trmm_run_unb_var2(), FLA_Trmm_run_unb_var3(), FLA_Trmm_run_unb_var4(), FLA_Trmm_rut_unb_var1(), FLA_Trmm_rut_unb_var2(), FLA_Trmm_rut_unb_var3(), FLA_Trmm_rut_unb_var4(), FLA_Trmmsx_external(), FLA_Trmvsx_external(), FLA_Trsm_llh_unb_var1(), FLA_Trsm_llh_unb_var2(), FLA_Trsm_llh_unb_var3(), FLA_Trsm_llh_unb_var4(), FLA_Trsm_lln_unb_var1(), FLA_Trsm_lln_unb_var2(), FLA_Trsm_lln_unb_var3(), FLA_Trsm_lln_unb_var4(), FLA_Trsm_llt_unb_var1(), FLA_Trsm_llt_unb_var2(), FLA_Trsm_llt_unb_var3(), FLA_Trsm_llt_unb_var4(), FLA_Trsm_luh_unb_var1(), FLA_Trsm_luh_unb_var2(), FLA_Trsm_luh_unb_var3(), FLA_Trsm_luh_unb_var4(), FLA_Trsm_lun_unb_var1(), FLA_Trsm_lun_unb_var2(), FLA_Trsm_lun_unb_var3(), FLA_Trsm_lun_unb_var4(), FLA_Trsm_lut_unb_var1(), FLA_Trsm_lut_unb_var2(), FLA_Trsm_lut_unb_var3(), FLA_Trsm_lut_unb_var4(), FLA_Trsm_rlh_unb_var1(), FLA_Trsm_rlh_unb_var2(), FLA_Trsm_rlh_unb_var3(), FLA_Trsm_rlh_unb_var4(), FLA_Trsm_rln_unb_var1(), FLA_Trsm_rln_unb_var2(), FLA_Trsm_rln_unb_var3(), FLA_Trsm_rln_unb_var4(), FLA_Trsm_rlt_unb_var1(), FLA_Trsm_rlt_unb_var2(), FLA_Trsm_rlt_unb_var3(), FLA_Trsm_rlt_unb_var4(), FLA_Trsm_ruh_unb_var1(), FLA_Trsm_ruh_unb_var2(), FLA_Trsm_ruh_unb_var3(), FLA_Trsm_ruh_unb_var4(), FLA_Trsm_run_unb_var1(), FLA_Trsm_run_unb_var2(), FLA_Trsm_run_unb_var3(), FLA_Trsm_run_unb_var4(), FLA_Trsm_rut_unb_var1(), FLA_Trsm_rut_unb_var2(), FLA_Trsm_rut_unb_var3(), FLA_Trsm_rut_unb_var4(), FLA_Trsmsx_external(), FLA_Trsvsx_external(), FLA_Ttmm_l_unb_var1(), FLA_Ttmm_l_unb_var2(), FLA_Ttmm_u_unb_var1(), and FLA_Ttmm_u_unb_var2().

00036 {
00037   FLA_Datatype datatype, dt_alpha;
00038   int          j, n_iter;
00039   int          num_elem;
00040   int          m_A, n_A, inc_A, ldim_A;
00041 
00042   if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING )
00043     FLA_Scal_check( alpha, A );
00044 
00045   if ( FLA_Obj_has_zero_dim( A ) ) return FLA_SUCCESS;
00046 
00047   if ( FLA_Obj_equals( alpha, FLA_ONE ) )
00048   {
00049     return FLA_SUCCESS;
00050   }
00051   else if ( FLA_Obj_equals( alpha, FLA_ZERO ) )
00052   {
00053     FLA_Obj_set_to_scalar( FLA_ZERO, A );
00054     return FLA_SUCCESS;
00055   }
00056 
00057   dt_alpha = FLA_Obj_datatype( alpha );
00058   datatype = FLA_Obj_datatype( A );
00059 
00060   m_A      = FLA_Obj_length( A );
00061   n_A      = FLA_Obj_width( A );
00062   ldim_A   = FLA_Obj_ldim( A );
00063 
00064   if ( FLA_Obj_is_vector( A ) )
00065   {
00066     inc_A    = ( m_A == 1 ? ldim_A : 1 );
00067     n_iter   = 1;
00068     num_elem = FLA_Obj_vector_dim( A );
00069   }
00070   else
00071   {
00072     inc_A    = 1;
00073     n_iter   = n_A;
00074     num_elem = m_A;
00075   }
00076 
00077   switch ( datatype ){
00078 
00079   case FLA_FLOAT:
00080   {
00081     float *buff_A     = ( float * ) FLA_FLOAT_PTR( A );
00082     float *buff_alpha = ( float * ) FLA_FLOAT_PTR( alpha );
00083 
00084     for ( j = 0; j < n_iter; ++j )
00085     {
00086 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00087       cblas_sscal( num_elem,
00088                    *buff_alpha,
00089                    buff_A + j*ldim_A, inc_A );
00090 #else
00091       FLA_C2F( sscal )( &num_elem,
00092                         buff_alpha,
00093                         buff_A + j*ldim_A, &inc_A );
00094 #endif
00095     }
00096 
00097     break;
00098   }
00099 
00100   case FLA_DOUBLE:
00101   {
00102     double *buff_A     = ( double * ) FLA_DOUBLE_PTR( A );
00103     double *buff_alpha = ( double * ) FLA_DOUBLE_PTR( alpha );
00104 
00105     for ( j = 0; j < n_iter; ++j )
00106     {
00107 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00108       cblas_dscal( num_elem,
00109                    *buff_alpha,
00110                    buff_A + j*ldim_A, inc_A );
00111 #else
00112       FLA_C2F( dscal )( &num_elem,
00113                         buff_alpha,
00114                         buff_A + j*ldim_A, &inc_A );
00115 #endif
00116     }
00117 
00118     break;
00119   }
00120 
00121   case FLA_COMPLEX:
00122   {
00123     if ( dt_alpha == FLA_COMPLEX )
00124     {
00125       scomplex *buff_A     = ( scomplex * ) FLA_COMPLEX_PTR( A );
00126       scomplex *buff_alpha = ( scomplex * ) FLA_COMPLEX_PTR( alpha );
00127 
00128       for ( j = 0; j < n_iter; ++j )
00129       {
00130 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00131         cblas_cscal( num_elem,
00132                      *buff_alpha,
00133                      buff_A + j*ldim_A, inc_A );
00134 #else
00135         FLA_C2F( cscal )( &num_elem,
00136                           buff_alpha,
00137                           buff_A + j*ldim_A, &inc_A );
00138 #endif
00139       }
00140     }
00141     else if ( dt_alpha == FLA_FLOAT )
00142     {
00143       scomplex *buff_A     = ( scomplex * ) FLA_FLOAT_PTR( A );
00144       float    *buff_alpha = ( float    * ) FLA_FLOAT_PTR( alpha );
00145 
00146       for ( j = 0; j < n_iter; ++j )
00147       {
00148 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00149         cblas_csscal( num_elem,
00150                       *buff_alpha,
00151                       buff_A + j*ldim_A, inc_A );
00152 #else
00153         FLA_C2F( csscal )( &num_elem,
00154                            buff_alpha,
00155                            buff_A + j*ldim_A, &inc_A );
00156 #endif
00157       }
00158     }
00159 
00160     break;
00161   }
00162 
00163   case FLA_DOUBLE_COMPLEX:
00164   {
00165     if ( dt_alpha == FLA_DOUBLE_COMPLEX )
00166     {
00167       dcomplex *buff_A     = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
00168       dcomplex *buff_alpha = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( alpha );
00169 
00170       for ( j = 0; j < n_iter; ++j )
00171       {
00172 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00173         cblas_zscal( num_elem,
00174                      *buff_alpha,
00175                      buff_A + j*ldim_A, inc_A );
00176 #else
00177         FLA_C2F( zscal )( &num_elem,
00178                           buff_alpha,
00179                           buff_A + j*ldim_A, &inc_A );
00180 #endif
00181       }
00182     }
00183     else if ( dt_alpha == FLA_DOUBLE )
00184     {
00185       dcomplex *buff_A     = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
00186       double   *buff_alpha = ( double   * ) FLA_DOUBLE_PTR( alpha );
00187 
00188       for ( j = 0; j < n_iter; ++j )
00189       {
00190 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00191         cblas_zdscal( num_elem,
00192                       *buff_alpha,
00193                       buff_A + j*ldim_A, inc_A );
00194 #else
00195         FLA_C2F( zdscal )( &num_elem,
00196                            buff_alpha,
00197                            buff_A + j*ldim_A, &inc_A );
00198 #endif
00199       }
00200     }
00201 
00202     break;
00203   }
00204 
00205   }
00206 
00207   return FLA_SUCCESS;
00208 }

void FLA_F2C() fla_scal_external_f ( F_INT *  alpha,
F_INT *  A,
F_INT *  IERROR 
)

References FLA_Scal_external().

00212 {
00213   *IERROR = FLA_Scal_external( *( ( FLA_Obj * ) alpha ),
00214                                *( ( FLA_Obj * ) A     ) );
00215 }

FLA_Error FLA_Scalc ( FLA_Conj  conjalpha,
FLA_Obj  alpha,
FLA_Obj  A 
)

References FLA_Scalc_external().

00036 {
00037     return FLA_Scalc_external( conjalpha, alpha, A );
00038 }

FLA_Error FLA_Scalc_check ( FLA_Conj  conjalpha,
FLA_Obj  alpha,
FLA_Obj  A 
)

References FLA_Check_consistent_object_datatype(), FLA_Check_floating_object(), FLA_Check_identical_object_precision(), FLA_Check_if_scalar(), FLA_Check_nonconstant_object(), FLA_Check_valid_conj(), and FLA_Obj_is_real().

Referenced by FLA_Scalc_external().

00036 {
00037   FLA_Error e_val;
00038 
00039   e_val = FLA_Check_valid_conj( conjalpha );
00040   FLA_Check_error_code( e_val );
00041 
00042   e_val = FLA_Check_floating_object( A );
00043   FLA_Check_error_code( e_val );
00044 
00045   e_val = FLA_Check_nonconstant_object( A );
00046   FLA_Check_error_code( e_val );
00047 
00048   if ( FLA_Obj_is_real( A ) )
00049   {
00050     e_val = FLA_Check_consistent_object_datatype( A, alpha );
00051     FLA_Check_error_code( e_val );
00052   }
00053   else
00054   {
00055     e_val = FLA_Check_identical_object_precision( A, alpha );
00056     FLA_Check_error_code( e_val );
00057   }
00058 
00059   e_val = FLA_Check_if_scalar( alpha );
00060   FLA_Check_error_code( e_val );
00061 
00062   return FLA_SUCCESS;
00063 }

FLA_Error FLA_Scalc_external ( FLA_Conj  conjalpha,
FLA_Obj  alpha,
FLA_Obj  A 
)

References cblas_cscal(), cblas_csscal(), cblas_dscal(), cblas_sscal(), cblas_zdscal(), cblas_zscal(), cscal(), csscal(), dscal(), FLA_Check_error_level(), FLA_MINUS_ONE, FLA_Negate(), FLA_Obj_datatype(), FLA_Obj_equals(), FLA_Obj_has_zero_dim(), FLA_Obj_is_vector(), FLA_Obj_ldim(), FLA_Obj_length(), FLA_Obj_set_to_scalar(), FLA_Obj_vector_dim(), FLA_Obj_width(), FLA_ONE, FLA_Scalc_check(), FLA_ZERO, dcomplex::imag, scomplex::imag, sscal(), zdscal(), and zscal().

Referenced by FLA_Scalc(), fla_scalc_external_f(), FLA_Trmm_llh_unb_var1(), FLA_Trmm_llh_unb_var2(), FLA_Trmm_luh_unb_var1(), FLA_Trmm_luh_unb_var2(), FLA_Trmm_rlh_unb_var1(), FLA_Trmm_rlh_unb_var2(), FLA_Trmm_ruh_unb_var1(), and FLA_Trmm_ruh_unb_var2().

00036 {
00037   FLA_Datatype datatype, dt_alpha;
00038   int          j, n_iter;
00039   int          num_elem;
00040   int          m_A, n_A, inc_A, ldim_A;
00041 
00042   if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING )
00043     FLA_Scalc_check( conjalpha, alpha, A );
00044 
00045   if ( FLA_Obj_has_zero_dim( A ) ) return FLA_SUCCESS;
00046 
00047   if ( FLA_Obj_equals( alpha, FLA_ONE ) )
00048   {
00049     return FLA_SUCCESS;
00050   }
00051   else if ( FLA_Obj_equals( alpha, FLA_ZERO ) )
00052   {
00053     FLA_Obj_set_to_scalar( FLA_ZERO, A );
00054     return FLA_SUCCESS;
00055   }
00056   else if ( FLA_Obj_equals( alpha, FLA_MINUS_ONE ) )
00057   {
00058     FLA_Negate( A );
00059     return FLA_SUCCESS;
00060   }
00061 
00062   dt_alpha = FLA_Obj_datatype( alpha );
00063   datatype = FLA_Obj_datatype( A );
00064 
00065   m_A      = FLA_Obj_length( A );
00066   n_A      = FLA_Obj_width( A );
00067   ldim_A   = FLA_Obj_ldim( A );
00068 
00069   if ( FLA_Obj_is_vector( A ) )
00070   {
00071     inc_A    = ( m_A == 1 ? ldim_A : 1 );
00072     n_iter   = 1;
00073     num_elem = FLA_Obj_vector_dim( A );
00074   }
00075   else
00076   {
00077     inc_A    = 1;
00078     n_iter   = n_A;
00079     num_elem = m_A;
00080   }
00081 
00082 
00083   switch ( datatype ){
00084 
00085   case FLA_FLOAT:
00086   {
00087     float *buff_A     = ( float * ) FLA_FLOAT_PTR( A );
00088     float *buff_alpha = ( float * ) FLA_FLOAT_PTR( alpha );
00089 
00090     for ( j = 0; j < n_iter; ++j )
00091     {
00092 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00093       cblas_sscal( num_elem,
00094                    *buff_alpha,
00095                    buff_A + j*ldim_A, inc_A );
00096 #else
00097       FLA_C2F( sscal )( &num_elem,
00098                         buff_alpha,
00099                         buff_A + j*ldim_A, &inc_A );
00100 #endif
00101     }
00102 
00103     break;
00104   }
00105 
00106   case FLA_DOUBLE:
00107   {
00108     double *buff_A     = ( double * ) FLA_DOUBLE_PTR( A );
00109     double *buff_alpha = ( double * ) FLA_DOUBLE_PTR( alpha );
00110 
00111     for ( j = 0; j < n_iter; ++j )
00112     {
00113 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00114       cblas_dscal( num_elem,
00115                    *buff_alpha,
00116                    buff_A + j*ldim_A, inc_A );
00117 #else
00118       FLA_C2F( dscal )( &num_elem,
00119                         buff_alpha,
00120                         buff_A + j*ldim_A, &inc_A );
00121 #endif
00122     }
00123 
00124     break;
00125   }
00126 
00127   case FLA_COMPLEX:
00128   {
00129     if ( dt_alpha == FLA_COMPLEX )
00130     {
00131       scomplex *buff_A     = ( scomplex * ) FLA_COMPLEX_PTR( A );
00132       scomplex *buff_alpha = ( scomplex * ) FLA_COMPLEX_PTR( alpha );
00133       scomplex  temp_alpha = *buff_alpha;
00134 
00135       if ( conjalpha == FLA_CONJUGATE )
00136         temp_alpha.imag *= -1.0F;
00137 
00138       for ( j = 0; j < n_iter; ++j )
00139       {
00140 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00141         cblas_cscal( num_elem,
00142                      &temp_alpha,
00143                      buff_A + j*ldim_A, inc_A );
00144 #else
00145         FLA_C2F( cscal )( &num_elem,
00146                           &temp_alpha,
00147                           buff_A + j*ldim_A, &inc_A );
00148 #endif
00149       }
00150     }
00151     else if ( dt_alpha == FLA_FLOAT )
00152     {
00153       scomplex *buff_A     = ( scomplex * ) FLA_FLOAT_PTR( A );
00154       float    *buff_alpha = ( float    * ) FLA_FLOAT_PTR( alpha );
00155 
00156       for ( j = 0; j < n_iter; ++j )
00157       {
00158 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00159         cblas_csscal( num_elem,
00160                       *buff_alpha,
00161                       buff_A + j*ldim_A, inc_A );
00162 #else
00163         FLA_C2F( csscal )( &num_elem,
00164                            buff_alpha,
00165                            buff_A + j*ldim_A, &inc_A );
00166 #endif
00167       }
00168     }
00169 
00170     break;
00171   }
00172 
00173   case FLA_DOUBLE_COMPLEX:
00174   {
00175     if ( dt_alpha == FLA_DOUBLE_COMPLEX )
00176     {
00177       dcomplex *buff_A     = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
00178       dcomplex *buff_alpha = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( alpha );
00179       dcomplex  temp_alpha = *buff_alpha;
00180 
00181       if ( conjalpha == FLA_CONJUGATE )
00182         temp_alpha.imag *= -1.0;
00183 
00184       for ( j = 0; j < n_iter; ++j )
00185       {
00186 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00187         cblas_zscal( num_elem,
00188                      &temp_alpha,
00189                      buff_A + j*ldim_A, inc_A );
00190 #else
00191         FLA_C2F( zscal )( &num_elem,
00192                           &temp_alpha,
00193                           buff_A + j*ldim_A, &inc_A );
00194 #endif
00195       }
00196     }
00197     else if ( dt_alpha == FLA_DOUBLE )
00198     {
00199       dcomplex *buff_A     = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
00200       double   *buff_alpha = ( double   * ) FLA_DOUBLE_PTR( alpha );
00201 
00202       for ( j = 0; j < n_iter; ++j )
00203       {
00204 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00205         cblas_zdscal( num_elem,
00206                       *buff_alpha,
00207                       buff_A + j*ldim_A, inc_A );
00208 #else
00209         FLA_C2F( zdscal )( &num_elem,
00210                            buff_alpha,
00211                            buff_A + j*ldim_A, &inc_A );
00212 #endif
00213       }
00214     }
00215 
00216     break;
00217   }
00218 
00219   }
00220 
00221   return FLA_SUCCESS;
00222 }

void FLA_F2C() fla_scalc_external_f ( F_INT *  conjalpha,
F_INT *  alpha,
F_INT *  A,
F_INT *  IERROR 
)

References FLA_Scalc_external().

00226 {
00227   *IERROR = FLA_Scalc_external( *( ( FLA_Conj * ) conjalpha ),
00228                                 *( ( FLA_Obj  * ) alpha     ),
00229                                 *( ( FLA_Obj  * ) A         ) );
00230 }

FLA_Error FLA_Scalr ( FLA_Uplo  uplo,
FLA_Obj  alpha,
FLA_Obj  A 
)

References FLA_Scalr_external().

00036 {
00037     return FLA_Scalr_external( uplo, alpha, A );
00038 }

FLA_Error FLA_Scalr_check ( FLA_Uplo  uplo,
FLA_Obj  alpha,
FLA_Obj  A 
)

References FLA_Check_consistent_object_datatype(), FLA_Check_floating_object(), FLA_Check_identical_object_precision(), FLA_Check_if_scalar(), FLA_Check_nonconstant_object(), FLA_Check_square(), FLA_Check_valid_uplo(), and FLA_Obj_is_real().

Referenced by FLA_Scalr_external().

00036 {
00037   FLA_Error e_val;
00038 
00039   e_val = FLA_Check_valid_uplo( uplo );
00040   FLA_Check_error_code( e_val );
00041 
00042   e_val = FLA_Check_floating_object( A );
00043   FLA_Check_error_code( e_val );
00044 
00045   e_val = FLA_Check_nonconstant_object( A );
00046   FLA_Check_error_code( e_val );
00047 
00048   if ( FLA_Obj_is_real( A ) )
00049   {
00050     e_val = FLA_Check_consistent_object_datatype( A, alpha );
00051     FLA_Check_error_code( e_val );
00052   }
00053   else
00054   {
00055     e_val = FLA_Check_identical_object_precision( A, alpha );
00056     FLA_Check_error_code( e_val );
00057   }
00058 
00059   e_val = FLA_Check_if_scalar( alpha );
00060   FLA_Check_error_code( e_val );
00061 
00062   e_val = FLA_Check_square( A );
00063   FLA_Check_error_code( e_val );
00064 
00065   return FLA_SUCCESS;
00066 }

FLA_Error FLA_Scalr_external ( FLA_Uplo  uplo,
FLA_Obj  alpha,
FLA_Obj  A 
)

References cblas_cscal(), cblas_csscal(), cblas_dscal(), cblas_sscal(), cblas_zdscal(), cblas_zscal(), cscal(), csscal(), dscal(), FLA_Check_error_level(), FLA_Obj_datatype(), FLA_Obj_has_zero_dim(), FLA_Obj_ldim(), FLA_Obj_width(), FLA_Scalr_check(), sscal(), zdscal(), and zscal().

Referenced by FLA_Her2k_lh_unb_var10(), FLA_Her2k_lh_unb_var9(), FLA_Her2k_ln_unb_var10(), FLA_Her2k_ln_unb_var9(), FLA_Her2k_uh_unb_var10(), FLA_Her2k_uh_unb_var9(), FLA_Her2k_un_unb_var10(), FLA_Her2k_un_unb_var9(), FLA_Herk_lh_unb_var1(), FLA_Herk_lh_unb_var2(), FLA_Herk_lh_unb_var3(), FLA_Herk_lh_unb_var4(), FLA_Herk_lh_unb_var5(), FLA_Herk_lh_unb_var6(), FLA_Herk_ln_unb_var1(), FLA_Herk_ln_unb_var2(), FLA_Herk_ln_unb_var3(), FLA_Herk_ln_unb_var4(), FLA_Herk_ln_unb_var5(), FLA_Herk_ln_unb_var6(), FLA_Herk_uh_unb_var1(), FLA_Herk_uh_unb_var2(), FLA_Herk_uh_unb_var3(), FLA_Herk_uh_unb_var4(), FLA_Herk_uh_unb_var5(), FLA_Herk_uh_unb_var6(), FLA_Herk_un_unb_var1(), FLA_Herk_un_unb_var2(), FLA_Herk_un_unb_var3(), FLA_Herk_un_unb_var4(), FLA_Herk_un_unb_var5(), FLA_Herk_un_unb_var6(), FLA_Scalr(), fla_scalr_external_f(), FLA_Syr2k_ln_unb_var10(), FLA_Syr2k_ln_unb_var9(), FLA_Syr2k_lt_unb_var10(), FLA_Syr2k_lt_unb_var9(), FLA_Syr2k_un_unb_var10(), FLA_Syr2k_un_unb_var9(), FLA_Syr2k_ut_unb_var10(), FLA_Syr2k_ut_unb_var9(), FLA_Syrk_ln_unb_var1(), FLA_Syrk_ln_unb_var2(), FLA_Syrk_ln_unb_var3(), FLA_Syrk_ln_unb_var4(), FLA_Syrk_ln_unb_var5(), FLA_Syrk_ln_unb_var6(), FLA_Syrk_lt_unb_var1(), FLA_Syrk_lt_unb_var2(), FLA_Syrk_lt_unb_var3(), FLA_Syrk_lt_unb_var4(), FLA_Syrk_lt_unb_var5(), FLA_Syrk_lt_unb_var6(), FLA_Syrk_un_unb_var1(), FLA_Syrk_un_unb_var2(), FLA_Syrk_un_unb_var3(), FLA_Syrk_un_unb_var4(), FLA_Syrk_un_unb_var5(), FLA_Syrk_un_unb_var6(), FLA_Syrk_ut_unb_var1(), FLA_Syrk_ut_unb_var2(), FLA_Syrk_ut_unb_var3(), FLA_Syrk_ut_unb_var4(), FLA_Syrk_ut_unb_var5(), and FLA_Syrk_ut_unb_var6().

00036 {
00037   FLA_Datatype datatype, dt_alpha;
00038   int          j, i_one = 1;
00039   int          num_elem;
00040   int          n_A, ldim_A;
00041 
00042   if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING ) 
00043     FLA_Scalr_check( uplo, alpha, A );
00044 
00045   if ( FLA_Obj_has_zero_dim( A ) ) return FLA_SUCCESS;
00046 
00047   dt_alpha = FLA_Obj_datatype( alpha );
00048   datatype = FLA_Obj_datatype( A );
00049 
00050   n_A      = FLA_Obj_width( A );
00051   ldim_A   = FLA_Obj_ldim( A );
00052 
00053   switch ( datatype ){
00054 
00055   case FLA_FLOAT:
00056   {
00057     float *buff_A     = ( float * ) FLA_FLOAT_PTR( A );
00058     float *buff_alpha = ( float * ) FLA_FLOAT_PTR( alpha );
00059 
00060     if ( uplo == FLA_LOWER_TRIANGULAR )
00061     {
00062       for ( j = 0; j < n_A; ++j )
00063       {
00064         num_elem = n_A - j;
00065 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00066         cblas_sscal( num_elem, 
00067                      *buff_alpha,
00068                      buff_A + j*ldim_A + j, i_one );
00069 #else
00070         FLA_C2F( sscal )( &num_elem,
00071                           buff_alpha,
00072                           buff_A + j*ldim_A + j, &i_one );
00073 #endif
00074       }
00075     }
00076     else
00077     {
00078       for ( j = 0; j < n_A; ++j )
00079       {
00080         num_elem = j + 1;
00081 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00082         cblas_sscal( num_elem, 
00083                      *buff_alpha,
00084                      buff_A + j*ldim_A, i_one );
00085 #else
00086         FLA_C2F( sscal )( &num_elem,
00087                           buff_alpha,
00088                           buff_A + j*ldim_A, &i_one );
00089 #endif
00090       }
00091     }
00092 
00093     break;
00094   }
00095 
00096   case FLA_DOUBLE:
00097   {
00098     double *buff_A     = ( double * ) FLA_DOUBLE_PTR( A );
00099     double *buff_alpha = ( double * ) FLA_DOUBLE_PTR( alpha );
00100 
00101     if ( uplo == FLA_LOWER_TRIANGULAR )
00102     {
00103       for ( j = 0; j < n_A; ++j )
00104       {
00105         num_elem = n_A - j;
00106 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00107         cblas_dscal( num_elem,
00108                      *buff_alpha,
00109                      buff_A + j*ldim_A + j, i_one );
00110 #else
00111         FLA_C2F( dscal )( &num_elem,
00112                           buff_alpha,
00113                           buff_A + j*ldim_A + j, &i_one );
00114 #endif
00115       }
00116     }
00117     else
00118     {
00119       for ( j = 0; j < n_A; ++j )
00120       {
00121         num_elem = j + 1;
00122 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00123         cblas_dscal( num_elem,
00124                      *buff_alpha,
00125                      buff_A + j*ldim_A, i_one );
00126 #else
00127         FLA_C2F( dscal )( &num_elem,
00128                           buff_alpha,
00129                           buff_A + j*ldim_A, &i_one );
00130 #endif
00131       }
00132     }
00133 
00134     break;
00135   }
00136 
00137   case FLA_COMPLEX:
00138   {
00139     if ( dt_alpha == FLA_COMPLEX )
00140     {
00141       scomplex *buff_A     = ( scomplex * ) FLA_COMPLEX_PTR( A );
00142       scomplex *buff_alpha = ( scomplex * ) FLA_COMPLEX_PTR( alpha );
00143   
00144       if ( uplo == FLA_LOWER_TRIANGULAR )
00145       {
00146         for ( j = 0; j < n_A; ++j )
00147         {
00148           num_elem = n_A - j;
00149 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00150           cblas_cscal( num_elem,
00151                        buff_alpha,
00152                        buff_A + j*ldim_A + j, i_one );
00153 #else
00154           FLA_C2F( cscal )( &num_elem,
00155                             buff_alpha,
00156                             buff_A + j*ldim_A + j, &i_one );
00157 #endif
00158         }
00159       }
00160       else
00161       {
00162         for ( j = 0; j < n_A; ++j )
00163         {
00164           num_elem = j + 1;
00165 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00166           cblas_cscal( num_elem,
00167                        buff_alpha,
00168                        buff_A + j*ldim_A, i_one );
00169 #else
00170           FLA_C2F( cscal )( &num_elem,
00171                             buff_alpha,
00172                             buff_A + j*ldim_A, &i_one );
00173 #endif
00174         }
00175       }
00176     }
00177     else if ( dt_alpha == FLA_FLOAT )
00178     {
00179       scomplex *buff_A     = ( scomplex * ) FLA_COMPLEX_PTR( A );
00180       float    *buff_alpha = ( float    * ) FLA_FLOAT_PTR( alpha );
00181 
00182       if ( uplo == FLA_LOWER_TRIANGULAR )
00183       {
00184         for ( j = 0; j < n_A; ++j )
00185         {
00186           num_elem = n_A - j;
00187 #ifdef FLA_ENABLE_CBLAS_INTERFACE 
00188           cblas_csscal( num_elem,
00189                         *buff_alpha,
00190                         buff_A + j*ldim_A + j, i_one );
00191 #else
00192           FLA_C2F( csscal )( &num_elem,
00193                              buff_alpha,
00194                              buff_A + j*ldim_A + j, &i_one );
00195 #endif
00196         }
00197       }
00198       else
00199       {
00200         for ( j = 0; j < n_A; ++j )
00201         {
00202           num_elem = j + 1;
00203 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00204           cblas_csscal( num_elem,
00205                         *buff_alpha,
00206                         buff_A + j*ldim_A, i_one );
00207 #else
00208           FLA_C2F( csscal )( &num_elem,
00209                              buff_alpha,
00210                              buff_A + j*ldim_A, &i_one );
00211 #endif
00212         }
00213       }
00214     }
00215 
00216     break;
00217   }
00218 
00219   case FLA_DOUBLE_COMPLEX:
00220   {
00221     if ( dt_alpha == FLA_DOUBLE_COMPLEX )
00222     {
00223       dcomplex *buff_A     = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
00224       dcomplex *buff_alpha = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( alpha );
00225   
00226       if ( uplo == FLA_LOWER_TRIANGULAR )
00227       {
00228         for ( j = 0; j < n_A; ++j )
00229         {
00230           num_elem = n_A - j;
00231 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00232           cblas_zscal( num_elem,
00233                        buff_alpha,
00234                        buff_A + j*ldim_A + j, i_one );
00235 #else
00236           FLA_C2F( zscal )( &num_elem,
00237                             buff_alpha,
00238                             buff_A + j*ldim_A + j, &i_one );
00239 #endif
00240         }
00241       }
00242       else
00243       {
00244         for ( j = 0; j < n_A; ++j )
00245         {
00246           num_elem = j + 1;
00247 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00248           cblas_zscal( num_elem,
00249                        buff_alpha,
00250                        buff_A + j*ldim_A, i_one );
00251 #else
00252           FLA_C2F( zscal )( &num_elem,
00253                             buff_alpha,
00254                             buff_A + j*ldim_A, &i_one );
00255 #endif
00256         }
00257       }
00258     }
00259     else if ( dt_alpha == FLA_DOUBLE )
00260     {
00261       dcomplex *buff_A     = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
00262       double   *buff_alpha = ( double   * ) FLA_DOUBLE_PTR( alpha );
00263   
00264       if ( uplo == FLA_LOWER_TRIANGULAR )
00265       {
00266         for ( j = 0; j < n_A; ++j )
00267         {
00268           num_elem = n_A - j;
00269 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00270           cblas_zdscal( num_elem,
00271                         *buff_alpha,
00272                         buff_A + j*ldim_A + j, i_one );
00273 #else
00274           FLA_C2F( zdscal )( &num_elem,
00275                              buff_alpha,
00276                              buff_A + j*ldim_A + j, &i_one );
00277 #endif
00278         }
00279       }
00280       else
00281       {
00282         for ( j = 0; j < n_A; ++j )
00283         {
00284           num_elem = j + 1;
00285 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00286           cblas_zdscal( num_elem,
00287                         *buff_alpha,
00288                         buff_A + j*ldim_A, i_one );
00289 #else
00290           FLA_C2F( zdscal )( &num_elem,
00291                              buff_alpha,
00292                              buff_A + j*ldim_A, &i_one );
00293 #endif
00294         }
00295       }
00296     }
00297 
00298     break;
00299   }
00300 
00301   }
00302 
00303   return FLA_SUCCESS;
00304 }

void FLA_F2C() fla_scalr_external_f ( F_INT *  uplo,
F_INT *  alpha,
F_INT *  A,
F_INT *  IERROR 
)

References FLA_Scalr_external().

00308 {
00309   *IERROR = FLA_Scalr_external( *( ( FLA_Uplo * ) uplo  ),
00310                                 *( ( FLA_Obj  * ) alpha ),
00311                                 *( ( FLA_Obj  * ) A     ) );
00312 }

FLA_Error FLA_Swap ( FLA_Obj  A,
FLA_Obj  B 
)

References FLA_Swap_external().

00036 {
00037     return FLA_Swap_external( A, B );
00038 }

FLA_Error FLA_Swap_check ( FLA_Obj  A,
FLA_Obj  B 
)

References FLA_Check_conformal_dims(), FLA_Check_floating_object(), FLA_Check_identical_object_datatype(), and FLA_Check_nonconstant_object().

Referenced by FLA_Swap_external().

00036 {
00037   FLA_Error e_val;
00038 
00039   e_val = FLA_Check_floating_object( A );
00040   FLA_Check_error_code( e_val );
00041 
00042   e_val = FLA_Check_nonconstant_object( A );
00043   FLA_Check_error_code( e_val );
00044 
00045   e_val = FLA_Check_identical_object_datatype( A, B );
00046   FLA_Check_error_code( e_val );
00047 
00048   e_val = FLA_Check_conformal_dims( FLA_NO_TRANSPOSE, A, B );
00049   FLA_Check_error_code( e_val );
00050 
00051   return FLA_SUCCESS;
00052 }

FLA_Error FLA_Swap_external ( FLA_Obj  A,
FLA_Obj  B 
)

References cblas_cswap(), cblas_dswap(), cblas_sswap(), cblas_zswap(), cswap(), dswap(), FLA_Check_error_level(), FLA_Obj_datatype(), FLA_Obj_has_zero_dim(), FLA_Obj_is_vector(), FLA_Obj_ldim(), FLA_Obj_length(), FLA_Obj_vector_dim(), FLA_Obj_width(), FLA_Swap_check(), sswap(), and zswap().

Referenced by FLA_Swap(), and fla_swap_external_f().

00036 {
00037   FLA_Datatype datatype;
00038   int          j, n_iter;
00039   int          num_elem;
00040   int          m_A, n_A, inc_A, ldim_A;
00041   int          m_B,      inc_B, ldim_B;
00042 
00043   if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING ) 
00044     FLA_Swap_check( A, B );
00045 
00046   if ( FLA_Obj_has_zero_dim( A ) ) return FLA_SUCCESS;
00047 
00048   datatype = FLA_Obj_datatype( A );
00049 
00050   m_A      = FLA_Obj_length( A );
00051   n_A      = FLA_Obj_width( A );
00052   ldim_A   = FLA_Obj_ldim( A );
00053 
00054   m_B      = FLA_Obj_length( B );
00055   ldim_B   = FLA_Obj_ldim( B );
00056 
00057   if ( FLA_Obj_is_vector( A ) )
00058   {
00059     inc_A    = ( m_A == 1 ? ldim_A : 1 );
00060     inc_B    = ( m_B == 1 ? ldim_B : 1 );
00061     n_iter   = 1;
00062     num_elem = FLA_Obj_vector_dim( A );
00063   }
00064   else
00065   {
00066     inc_A    = 1;
00067     inc_B    = 1;
00068     n_iter   = n_A;
00069     num_elem = m_A;
00070   }
00071 
00072   switch ( datatype ){
00073 
00074   case FLA_FLOAT:
00075   {
00076     float* buff_A = ( float * ) FLA_FLOAT_PTR( A );
00077     float* buff_B = ( float * ) FLA_FLOAT_PTR( B );
00078 
00079     for ( j = 0; j < n_iter; ++j )
00080     {
00081 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00082       cblas_sswap( num_elem,
00083                    buff_A + j*ldim_A, inc_A,
00084                    buff_B + j*ldim_B, inc_B );
00085 #else
00086       FLA_C2F( sswap )( &num_elem,
00087                         buff_A + j*ldim_A, &inc_A,
00088                         buff_B + j*ldim_B, &inc_B );
00089 #endif
00090     }
00091 
00092     break;
00093   }
00094 
00095   case FLA_DOUBLE:
00096   {
00097     double* buff_A = ( double * ) FLA_DOUBLE_PTR( A );
00098     double* buff_B = ( double * ) FLA_DOUBLE_PTR( B );
00099 
00100     for ( j = 0; j < n_iter; ++j )
00101     {
00102 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00103       cblas_dswap( num_elem,
00104                    buff_A + j*ldim_A, inc_A,
00105                    buff_B + j*ldim_B, inc_B );
00106 #else
00107       FLA_C2F( dswap )( &num_elem,
00108                         buff_A + j*ldim_A, &inc_A,
00109                         buff_B + j*ldim_B, &inc_B );
00110 #endif
00111     }
00112 
00113     break;
00114   }
00115 
00116   case FLA_COMPLEX:
00117   {
00118     scomplex* buff_A = ( scomplex * ) FLA_COMPLEX_PTR( A );
00119     scomplex* buff_B = ( scomplex * ) FLA_COMPLEX_PTR( B );
00120 
00121     for ( j = 0; j < n_iter; ++j )
00122     {
00123 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00124       cblas_cswap( num_elem,
00125                    buff_A + j*ldim_A, inc_A,
00126                    buff_B + j*ldim_B, inc_B );
00127 #else
00128       FLA_C2F( cswap )( &num_elem,
00129                         buff_A + j*ldim_A, &inc_A,
00130                         buff_B + j*ldim_B, &inc_B );
00131 #endif
00132     }
00133 
00134     break;
00135   }
00136 
00137   case FLA_DOUBLE_COMPLEX:
00138   {
00139     dcomplex* buff_A = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
00140     dcomplex* buff_B = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( B );
00141 
00142     for ( j = 0; j < n_iter; ++j )
00143     {
00144 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00145       cblas_zswap( num_elem,
00146                    buff_A + j*ldim_A, inc_A,
00147                    buff_B + j*ldim_B, inc_B );
00148 #else
00149       FLA_C2F( zswap )( &num_elem,
00150                         buff_A + j*ldim_A, &inc_A,
00151                         buff_B + j*ldim_B, &inc_B );
00152 #endif
00153     }
00154 
00155     break;
00156   }
00157 
00158   }
00159   
00160   return FLA_SUCCESS;
00161 }

void FLA_F2C() fla_swap_external_f ( F_INT *  A,
F_INT *  B,
F_INT *  IERROR 
)

References FLA_Swap_external().

00165 {
00166   *IERROR = FLA_Swap_external( *( ( FLA_Obj * ) A ),
00167                                *( ( FLA_Obj * ) B ) );
00168 }

FLA_Error FLA_Swapt ( FLA_Trans  trans,
FLA_Obj  A,
FLA_Obj  B 
)

References FLA_Swapt_external().

00036 {
00037     return FLA_Swapt_external( trans, A, B );
00038 }

FLA_Error FLA_Swapt_check ( FLA_Trans  trans,
FLA_Obj  A,
FLA_Obj  B 
)

References FLA_Check_conformal_dims(), FLA_Check_floating_object(), FLA_Check_identical_object_datatype(), FLA_Check_nonconstant_object(), and FLA_Check_valid_trans().

Referenced by FLA_Swapt_external().

00036 {
00037   FLA_Error e_val;
00038 
00039   e_val = FLA_Check_valid_trans( trans );
00040   FLA_Check_error_code( e_val );
00041 
00042   e_val = FLA_Check_floating_object( A );
00043   FLA_Check_error_code( e_val );
00044 
00045   e_val = FLA_Check_nonconstant_object( A );
00046   FLA_Check_error_code( e_val );
00047 
00048   e_val = FLA_Check_identical_object_datatype( A, B );
00049   FLA_Check_error_code( e_val );
00050 
00051   e_val = FLA_Check_conformal_dims( trans, A, B );
00052   FLA_Check_error_code( e_val );
00053 
00054   return FLA_SUCCESS;
00055 }

FLA_Error FLA_Swapt_external ( FLA_Trans  trans,
FLA_Obj  A,
FLA_Obj  B 
)

References cblas_cswap(), cblas_dswap(), cblas_sswap(), cblas_zswap(), cswap(), dswap(), FLA_Check_error_level(), FLA_Conjugate(), FLA_Obj_datatype(), FLA_Obj_has_zero_dim(), FLA_Obj_is_vector(), FLA_Obj_ldim(), FLA_Obj_length(), FLA_Obj_vector_dim(), FLA_Obj_width(), FLA_Swapt_check(), sswap(), and zswap().

Referenced by FLA_Swap_t_blk_var1(), FLA_Swap_t_blk_var2(), FLA_Swapt(), fla_swapt_external_f(), FLA_Transpose_unb_var1(), and FLA_Transpose_unb_var2().

00036 {
00037   FLA_Datatype datatype;
00038   int          j, n_iter;
00039   int          num_elem;
00040   int          m_A, n_A, inc_A, ldim_A;
00041   int          m_B,      inc_B, ldim_B;
00042   int          ldim_B_trans, inc_B_trans;
00043 
00044   if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING ) 
00045     FLA_Swapt_check( trans, A, B );
00046 
00047   if ( FLA_Obj_has_zero_dim( A ) ) return FLA_SUCCESS;
00048 
00049   datatype = FLA_Obj_datatype( A );
00050 
00051   m_A      = FLA_Obj_length( A );
00052   n_A      = FLA_Obj_width( A );
00053   ldim_A   = FLA_Obj_ldim( A );
00054 
00055   m_B      = FLA_Obj_length( B );
00056   ldim_B   = FLA_Obj_ldim( B );
00057 
00058   if ( FLA_Obj_is_vector( A ) )
00059   {
00060     inc_A    = ( m_A == 1 ? ldim_A : 1 );
00061     inc_B    = ( m_B == 1 ? ldim_B : 1 );
00062     n_iter   = 1;
00063     num_elem = FLA_Obj_vector_dim( A );
00064 
00065     ldim_B_trans = ldim_B;
00066     inc_B_trans  = inc_B;
00067   }
00068   else
00069   {
00070     inc_A    = 1;
00071     inc_B    = 1;
00072     n_iter   = n_A;
00073     num_elem = m_A;
00074 
00075     if ( trans == FLA_NO_TRANSPOSE || trans == FLA_CONJ_NO_TRANSPOSE )
00076     {
00077       ldim_B_trans = ldim_B;
00078       inc_B_trans  = inc_B;
00079     }
00080     else // ( trans == FLA_TRANSPOSE || trans == FLA_CONJ_TRANSPOSE )
00081     {
00082       ldim_B_trans = inc_B;
00083       inc_B_trans  = ldim_B;
00084     }
00085   }
00086 
00087   switch ( datatype ){
00088 
00089   case FLA_FLOAT:
00090   {
00091     float* buff_A = ( float * ) FLA_FLOAT_PTR( A );
00092     float* buff_B = ( float * ) FLA_FLOAT_PTR( B );
00093 
00094     for ( j = 0; j < n_iter; j++ )
00095     {
00096 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00097       cblas_sswap( num_elem,
00098                    buff_A + j*ldim_A,       inc_A,
00099                    buff_B + j*ldim_B_trans, inc_B_trans );
00100 #else
00101       FLA_C2F( sswap )( &num_elem,
00102                         buff_A + j*ldim_A,       &inc_A,
00103                         buff_B + j*ldim_B_trans, &inc_B_trans );
00104 #endif
00105     }
00106  
00107     break;
00108   }
00109 
00110   case FLA_DOUBLE:
00111   {
00112     double* buff_A = ( double * ) FLA_DOUBLE_PTR( A );
00113     double* buff_B = ( double * ) FLA_DOUBLE_PTR( B );
00114 
00115     for ( j = 0; j < n_iter; j++ )
00116     {
00117 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00118       cblas_dswap( num_elem,
00119                    buff_A + j*ldim_A,       inc_A,
00120                    buff_B + j*ldim_B_trans, inc_B_trans );
00121 #else
00122       FLA_C2F( dswap )( &num_elem,
00123                         buff_A + j*ldim_A,       &inc_A,
00124                         buff_B + j*ldim_B_trans, &inc_B_trans );
00125 #endif
00126     }
00127  
00128     break;
00129   }
00130 
00131   case FLA_COMPLEX:
00132   {
00133     scomplex* buff_A = ( scomplex * ) FLA_COMPLEX_PTR( A );
00134     scomplex* buff_B = ( scomplex * ) FLA_COMPLEX_PTR( B );
00135 
00136     for ( j = 0; j < n_iter; j++ )
00137     {
00138 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00139       cblas_cswap( num_elem,
00140                    buff_A + j*ldim_A,       inc_A,
00141                    buff_B + j*ldim_B_trans, inc_B_trans );
00142 #else
00143       FLA_C2F( cswap )( &num_elem,
00144                         buff_A + j*ldim_A,       &inc_A,
00145                         buff_B + j*ldim_B_trans, &inc_B_trans );
00146 #endif
00147     }
00148  
00149     break;
00150   }
00151 
00152   case FLA_DOUBLE_COMPLEX:
00153   {
00154     dcomplex* buff_A = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
00155     dcomplex* buff_B = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( B );
00156 
00157     for ( j = 0; j < n_iter; j++ )
00158     {
00159 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00160       cblas_zswap( num_elem,
00161                    buff_A + j*ldim_A,       inc_A,
00162                    buff_B + j*ldim_B_trans, inc_B_trans );
00163 #else
00164       FLA_C2F( zswap )( &num_elem,
00165                         buff_A + j*ldim_A,       &inc_A,
00166                         buff_B + j*ldim_B_trans, &inc_B_trans );
00167 #endif
00168     }
00169  
00170     break;
00171   }
00172 
00173   }
00174   
00175   if ( trans == FLA_CONJ_NO_TRANSPOSE || trans == FLA_CONJ_TRANSPOSE )
00176   {
00177     FLA_Conjugate( A );
00178     FLA_Conjugate( B );
00179   }
00180 
00181   return FLA_SUCCESS;
00182 }

void FLA_F2C() fla_swapt_external_f ( F_INT *  trans,
F_INT *  A,
F_INT *  B,
F_INT *  IERROR 
)

References FLA_Swapt_external().

00186 {
00187   *IERROR = FLA_Swapt_external( *( ( FLA_Trans * ) trans ),
00188                                 *( ( FLA_Obj   * ) A     ),
00189                                 *( ( FLA_Obj   * ) B     ) );
00190 }

void FLA_F2C() fla_zdotc ( int *  n,
dcomplex x,
int *  incx,
dcomplex y,
int *  incy,
dcomplex rval 
)

void FLA_F2C() fla_zdotu ( int *  n,
dcomplex x,
int *  incx,
dcomplex y,
int *  incy,
dcomplex rval 
)


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