Пример #1
0
/* Subroutine */ int PASTEF77(z,rotg)(doublecomplex *ca, doublecomplex *cb, doublereal *c__, doublecomplex *s)
{
    /* System generated locals */
    doublereal d__1, d__2;
    doublecomplex z__1, z__2, z__3, z__4;

    /* Builtin functions */
    double bla_z_abs(doublecomplex *);
    void bla_z_div(doublecomplex *, doublecomplex *, doublecomplex *);
    double sqrt(doublereal);
    void bla_d_cnjg(doublecomplex *, doublecomplex *);

    /* Local variables */
    doublereal norm;
    doublecomplex alpha;
    doublereal scale;

    if (bla_z_abs(ca) != 0.) {
	goto L10;
    }
    *c__ = 0.;
    bli_zsets( 1., 0., *s );
    bli_zsets( bli_zreal(*cb), bli_zimag(*cb), *ca );
    goto L20;
L10:
    scale = bla_z_abs(ca) + bla_z_abs(cb);
    bli_zsets( (scale), (0.), z__2 );
    bla_z_div(&z__1, ca, &z__2);
/* Computing 2nd power */
    d__1 = bla_z_abs(&z__1);
    bli_zsets( (scale), (0.), z__4 );
    bla_z_div(&z__3, cb, &z__4);
/* Computing 2nd power */
    d__2 = bla_z_abs(&z__3);
    norm = scale * sqrt(d__1 * d__1 + d__2 * d__2);
    d__1 = bla_z_abs(ca);
    bli_zsets( (bli_zreal(*ca) / d__1), (bli_zimag(*ca) / d__1), z__1 );
    bli_zsets( (bli_zreal(z__1)), (bli_zimag(z__1)), alpha );
    *c__ = bla_z_abs(ca) / norm;
    bla_d_cnjg(&z__3, cb);
    bli_zsets( (bli_zreal(alpha) * bli_zreal(z__3) - bli_zimag(alpha) * bli_zimag(z__3)), (bli_zreal(alpha) * bli_zimag(z__3) + bli_zimag(alpha) * bli_zreal(z__3)), z__2 );
    bli_zsets( (bli_zreal(z__2) / norm), (bli_zimag(z__2) / norm), z__1 );
    bli_zsets( bli_zreal(z__1), bli_zimag(z__1), *s );
    bli_zsets( (norm * bli_zreal(alpha)), (norm * bli_zimag(alpha)), z__1 );
    bli_zsets( bli_zreal(z__1), bli_zimag(z__1), *ca );
L20:
    return 0;
} /* zrotg_ */
Пример #2
0
void bli_fprintm( FILE* file, char* s1, obj_t* x, char* format, char* s2 )
{
	num_t     dt_x      = bli_obj_datatype( *x );

	dim_t     m         = bli_obj_length( *x );
	dim_t     n         = bli_obj_width( *x );

	inc_t     rs_x      = bli_obj_row_stride( *x );
	inc_t     cs_x      = bli_obj_col_stride( *x );
	void*     buf_x     = bli_obj_buffer_at_off( *x );

	FUNCPTR_T f;

	if ( bli_error_checking_is_enabled() )
		bli_fprintm_check( file, s1, x, format, s2 );

	// Handle constants up front.
	if ( dt_x == BLIS_CONSTANT )
	{
		float*    sp = bli_obj_buffer_for_const( BLIS_FLOAT,    *x );
		double*   dp = bli_obj_buffer_for_const( BLIS_DOUBLE,   *x );
		scomplex* cp = bli_obj_buffer_for_const( BLIS_SCOMPLEX, *x );
		dcomplex* zp = bli_obj_buffer_for_const( BLIS_DCOMPLEX, *x );
		gint_t*   ip = bli_obj_buffer_for_const( BLIS_INT,      *x );

		fprintf( file, "%s\n", s1 );
		fprintf( file, " float:     %9.2e\n",         bli_sreal( *sp ) );
		fprintf( file, " double:    %9.2e\n",         bli_dreal( *dp ) );
		fprintf( file, " scomplex:  %9.2e + %9.2e\n", bli_creal( *cp ), bli_cimag( *cp ) );
		fprintf( file, " dcomplex:  %9.2e + %9.2e\n", bli_zreal( *zp ), bli_zimag( *zp ) );
		fprintf( file, " int:       %ld\n",           *ip );
		fprintf( file, "\n" );
		return;
	}

	// Index into the type combination array to extract the correct
	// function pointer.
	f = ftypes[dt_x];

	// Invoke the function.
	f( file,
	   s1,
	   m,
	   n,
	   buf_x, rs_x, cs_x,
	   format,
	   s2 );
}
Пример #3
0
bool_t bli_obj_scalar_has_nonzero_imag( obj_t* a )
{
	bool_t r_val     = FALSE;
	num_t  dt        = bli_obj_datatype( *a );
	void*  scalar_a  = bli_obj_internal_scalar_buffer( *a );

	if      ( bli_is_real( dt ) )
	{
		r_val = FALSE;
	}
	else if ( bli_is_scomplex( dt ) )
	{
		r_val = ( bli_cimag( *(( scomplex* )scalar_a) ) != 0.0F );
	}
	else if ( bli_is_dcomplex( dt ) )
	{
		r_val = ( bli_zimag( *(( dcomplex* )scalar_a) ) != 0.0  );
	}

	return r_val;
}
Пример #4
0
double bla_z_abs(const bla_dcomplex *z)
{
	return( bla_f__cabs( bli_zreal( *z ),
	                     bli_zimag( *z ) ) );
}
Пример #5
0
double bla_d_imag(doublecomplex *z)
{
	return bli_zimag( *z );
}
Пример #6
0
/* Subroutine */ int PASTEF77(zd,rot)(const bla_integer *n, bla_dcomplex *zx, const bla_integer *incx, bla_dcomplex *zy, const bla_integer *incy, const bla_double *c__, const bla_double *s)
{
    /* System generated locals */
    bla_integer i__1, i__2, i__3, i__4;
    bla_dcomplex z__1, z__2, z__3;

    /* Local variables */
    bla_integer i__;
    bla_dcomplex ztemp;
    bla_integer ix, iy;


/*     applies a plane rotation, where the cos and sin (c and s) are */
/*     double precision and the vectors zx and zy are double complex. */
/*     jack dongarra, linpack, 3/11/78. */


    /* Parameter adjustments */
    --zy;
    --zx;

    /* Function Body */
    if (*n <= 0) {
	return 0;
    }
    if (*incx == 1 && *incy == 1) {
	goto L20;
    }

/*       code for unequal increments or equal increments not equal */
/*         to 1 */

    ix = 1;
    iy = 1;
    if (*incx < 0) {
	ix = (-(*n) + 1) * *incx + 1;
    }
    if (*incy < 0) {
	iy = (-(*n) + 1) * *incy + 1;
    }
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	i__2 = ix;
	bli_zsets( (*c__ * bli_zreal(zx[i__2])), (*c__ * bli_zimag(zx[i__2])), z__2 );
	i__3 = iy;
	bli_zsets( (*s * bli_zreal(zy[i__3])), (*s * bli_zimag(zy[i__3])), z__3 );
	bli_zsets( (bli_zreal(z__2) + bli_zreal(z__3)), (bli_zimag(z__2) + bli_zimag(z__3)), z__1 );
	bli_zsets( (bli_zreal(z__1)), (bli_zimag(z__1)), ztemp );
	i__2 = iy;
	i__3 = iy;
	bli_zsets( (*c__ * bli_zreal(zy[i__3])), (*c__ * bli_zimag(zy[i__3])), z__2 );
	i__4 = ix;
	bli_zsets( (*s * bli_zreal(zx[i__4])), (*s * bli_zimag(zx[i__4])), z__3 );
	bli_zsets( (bli_zreal(z__2) - bli_zreal(z__3)), (bli_zimag(z__2) - bli_zimag(z__3)), z__1 );
	bli_zsets( (bli_zreal(z__1)), (bli_zimag(z__1)), zy[i__2] );
	i__2 = ix;
	bli_zsets( (bli_zreal(ztemp)), (bli_zimag(ztemp)), zx[i__2] );
	ix += *incx;
	iy += *incy;
/* L10: */
    }
    return 0;

/*       code for both increments equal to 1 */

L20:
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	i__2 = i__;
	bli_zsets( (*c__ * bli_zreal(zx[i__2])), (*c__ * bli_zimag(zx[i__2])), z__2 );
	i__3 = i__;
	bli_zsets( (*s * bli_zreal(zy[i__3])), (*s * bli_zimag(zy[i__3])), z__3 );
	bli_zsets( (bli_zreal(z__2) + bli_zreal(z__3)), (bli_zimag(z__2) + bli_zimag(z__3)), z__1 );
	bli_zsets( (bli_zreal(z__1)), (bli_zimag(z__1)), ztemp );
	i__2 = i__;
	i__3 = i__;
	bli_zsets( (*c__ * bli_zreal(zy[i__3])), (*c__ * bli_zimag(zy[i__3])), z__2 );
	i__4 = i__;
	bli_zsets( (*s * bli_zreal(zx[i__4])), (*s * bli_zimag(zx[i__4])), z__3 );
	bli_zsets( (bli_zreal(z__2) - bli_zreal(z__3)), (bli_zimag(z__2) - bli_zimag(z__3)), z__1 );
	bli_zsets( (bli_zreal(z__1)), (bli_zimag(z__1)), zy[i__2] );
	i__2 = i__;
	bli_zsets( (bli_zreal(ztemp)), (bli_zimag(ztemp)), zx[i__2] );
/* L30: */
    }
    return 0;
} /* zdrot_ */
Пример #7
0
double bla_d_imag(const bla_dcomplex *z)
{
	return bli_zimag( *z );
}