void libblis_test_her_check( obj_t* alpha, obj_t* x, obj_t* a, obj_t* a_orig, double* resid ) { num_t dt = bli_obj_datatype( *a ); num_t dt_real = bli_obj_datatype_proj_to_real( *a ); dim_t m_a = bli_obj_length( *a ); obj_t xh, t, v, w; obj_t tau, rho, norm; double junk; // // Pre-conditions: // - x is randomized. // - a is randomized and Hermitian. // Note: // - alpha must be real-valued. // // Under these conditions, we assume that the implementation for // // A := A_orig + alpha * conjx(x) * conjx(x)^H // // is functioning correctly if // // normf( v - w ) // // is negligible, where // // v = A * t // w = ( A_orig + alpha * conjx(x) * conjx(x)^H ) * t // = A_orig * t + alpha * conjx(x) * conjx(x)^H * t // = A_orig * t + alpha * conjx(x) * rho // = A_orig * t + w // bli_mkherm( a ); bli_mkherm( a_orig ); bli_obj_set_struc( BLIS_GENERAL, *a ); bli_obj_set_struc( BLIS_GENERAL, *a_orig ); bli_obj_set_uplo( BLIS_DENSE, *a ); bli_obj_set_uplo( BLIS_DENSE, *a_orig ); bli_obj_scalar_init_detached( dt, &tau ); bli_obj_scalar_init_detached( dt, &rho ); bli_obj_scalar_init_detached( dt_real, &norm ); bli_obj_create( dt, m_a, 1, 0, 0, &t ); bli_obj_create( dt, m_a, 1, 0, 0, &v ); bli_obj_create( dt, m_a, 1, 0, 0, &w ); bli_obj_alias_with_conj( BLIS_CONJUGATE, *x, xh ); bli_setsc( 1.0/( double )m_a, -1.0/( double )m_a, &tau ); bli_setv( &tau, &t ); bli_gemv( &BLIS_ONE, a, &t, &BLIS_ZERO, &v ); bli_dotv( &xh, &t, &rho ); bli_mulsc( alpha, &rho ); bli_scal2v( &rho, x, &w ); bli_gemv( &BLIS_ONE, a_orig, &t, &BLIS_ONE, &w ); bli_subv( &w, &v ); bli_normfv( &v, &norm ); bli_getsc( &norm, resid, &junk ); bli_obj_free( &t ); bli_obj_free( &v ); bli_obj_free( &w ); }
void bli_ger_int( conj_t conjx, conj_t conjy, obj_t* alpha, obj_t* x, obj_t* y, obj_t* a, cntx_t* cntx, ger_t* cntl ) { varnum_t n; impl_t i; FUNCPTR_T f; obj_t alpha_local; obj_t x_local; obj_t y_local; obj_t a_local; // Check parameters. if ( bli_error_checking_is_enabled() ) bli_ger_check( alpha, x, y, a ); // If A has a zero dimension, return early. if ( bli_obj_has_zero_dim( a ) ) return; // If x or y has a zero dimension, return early. if ( bli_obj_has_zero_dim( x ) || bli_obj_has_zero_dim( y ) ) return; // Alias the objects, applying conjx and conjy to x and y, respectively. bli_obj_alias_with_conj( conjx, x, &x_local ); bli_obj_alias_with_conj( conjy, y, &y_local ); bli_obj_alias_to( a, &a_local ); // If matrix A is marked for conjugation, we interpret this as a request // to apply a conjugation to the other operands. if ( bli_obj_has_conj( &a_local ) ) { bli_obj_toggle_conj( &a_local ); bli_obj_toggle_conj( &x_local ); bli_obj_toggle_conj( &y_local ); bli_obj_scalar_init_detached_copy_of( bli_obj_dt( alpha ), BLIS_CONJUGATE, alpha, &alpha_local ); } else { bli_obj_alias_to( *alpha, alpha_local ); } // If we are about the call a leaf-level implementation, and matrix A // still needs a transposition, then we must induce one by swapping the // strides and dimensions. if ( bli_cntl_is_leaf( cntl ) && bli_obj_has_trans( &a_local ) ) { bli_obj_induce_trans( &a_local ); bli_obj_set_onlytrans( BLIS_NO_TRANSPOSE, &a_local ); } // Extract the variant number and implementation type. n = bli_cntl_var_num( cntl ); i = bli_cntl_impl_type( cntl ); // Index into the variant array to extract the correct function pointer. f = vars[n][i]; // Invoke the variant. f( &alpha_local, &x_local, &y_local, &a_local, cntx, cntl ); }