Go to the source code of this file.
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 }
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 }
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 }
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 }
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 }
References FLA_Axpys_external().
00036 { 00037 return FLA_Axpys_external( alpha0, alpha1, A, beta, B ); 00038 }
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 }
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 }
References FLA_Axpyt_external().
00036 { 00037 return FLA_Axpyt_external( trans, alpha, A, B ); 00038 }
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 }
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 | |||
) |
Referenced by FLA_Dot2cs_external(), FLA_Dotc_external(), and FLA_Dotcs_external().
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 }
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 }
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 | |||
) |
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 }
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 }
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 }
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 }
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_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 }
References FLA_Dot2s_external().
00036 { 00037 return FLA_Dot2s_external( alpha, x, y, beta, rho ); 00038 }
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 }
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 }
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 }
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 }
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 }
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 }
References FLA_Dots_external().
00036 { 00037 return FLA_Dots_external( alpha, x, y, beta, rho ); 00038 }
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 }
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 }
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 }
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 }
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 }
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 }
References FLA_Inv_scalc_external().
00036 { 00037 return FLA_Inv_scalc_external( conjalpha, alpha, A ); 00038 }
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 }
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 }
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 }
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 }
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 }
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 }
References FLA_Scalc_external().
00036 { 00037 return FLA_Scalc_external( conjalpha, alpha, A ); 00038 }
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 }
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 }
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 }
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 }
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 }
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 }
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 }
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 | |||
) |
Referenced by FLA_Dot2cs_external(), FLA_Dotc_external(), and FLA_Dotcs_external().