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 );
}
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;
}
/* Subroutine */ int PASTEF77(cs,rot)(const bla_integer *n, bla_scomplex *cx, const bla_integer *incx, bla_scomplex *cy, const bla_integer *incy, const bla_real *c__, const bla_real *s)
{
/* System generated locals */
bla_integer i__1, i__2, i__3, i__4;
bla_scomplex q__1, q__2, q__3;
/* Local variables */
bla_integer i__;
bla_scomplex ctemp;
bla_integer ix, iy;
/* applies a plane rotation, where the cos and sin (c and s) are bla_real */
/* and the vectors cx and cy are complex. */
/* jack dongarra, linpack, 3/11/78. */
/* Parameter adjustments */
--cy;
--cx;
/* 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_csets( (*c__ * bli_creal(cx[i__2])), (*c__ * bli_cimag(cx[i__2])), q__2 );
i__3 = iy;
bli_csets( (*s * bli_creal(cy[i__3])), (*s * bli_cimag(cy[i__3])), q__3 );
bli_csets( (bli_creal(q__2) + bli_creal(q__3)), (bli_cimag(q__2) + bli_cimag(q__3)), q__1 );
bli_csets( (bli_creal(q__1)), (bli_cimag(q__1)), ctemp );
i__2 = iy;
i__3 = iy;
bli_csets( (*c__ * bli_creal(cy[i__3])), (*c__ * bli_cimag(cy[i__3])), q__2 );
i__4 = ix;
bli_csets( (*s * bli_creal(cx[i__4])), (*s * bli_cimag(cx[i__4])), q__3 );
bli_csets( (bli_creal(q__2) - bli_creal(q__3)), (bli_cimag(q__2) - bli_cimag(q__3)), q__1 );
bli_csets( (bli_creal(q__1)), (bli_cimag(q__1)), cy[i__2] );
i__2 = ix;
bli_csets( (bli_creal(ctemp)), (bli_cimag(ctemp)), cx[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_csets( (*c__ * bli_creal(cx[i__2])), (*c__ * bli_cimag(cx[i__2])), q__2 );
i__3 = i__;
bli_csets( (*s * bli_creal(cy[i__3])), (*s * bli_cimag(cy[i__3])), q__3 );
bli_csets( (bli_creal(q__2) + bli_creal(q__3)), (bli_cimag(q__2) + bli_cimag(q__3)), q__1 );
bli_csets( (bli_creal(q__1)), (bli_cimag(q__1)), ctemp );
i__2 = i__;
i__3 = i__;
bli_csets( (*c__ * bli_creal(cy[i__3])), (*c__ * bli_cimag(cy[i__3])), q__2 );
i__4 = i__;
bli_csets( (*s * bli_creal(cx[i__4])), (*s * bli_cimag(cx[i__4])), q__3 );
bli_csets( (bli_creal(q__2) - bli_creal(q__3)), (bli_cimag(q__2) - bli_cimag(q__3)), q__1 );
bli_csets( (bli_creal(q__1)), (bli_cimag(q__1)), cy[i__2] );
i__2 = i__;
bli_csets( (bli_creal(ctemp)), (bli_cimag(ctemp)), cx[i__2] );
/* L30: */
}
return 0;
} /* csrot_ */
double bla_c_abs(const bla_scomplex *z)
{
return( bla_f__cabs( bli_creal( *z ),
bli_cimag( *z ) ) );
}
/* Subroutine */ int PASTEF77(c,rotg)(singlecomplex *ca, singlecomplex *cb, real *c__, singlecomplex *s)
{
/* System generated locals */
real r__1, r__2;
singlecomplex q__1, q__2, q__3;
/* Builtin functions */
double bla_c_abs(singlecomplex *), sqrt(doublereal);
void bla_r_cnjg(singlecomplex *, singlecomplex *);
/* Local variables */
real norm;
singlecomplex alpha;
real scale;
if (bla_c_abs(ca) != 0.f) {
goto L10;
}
*c__ = 0.f;
bli_csets( 1.f, 0.f, *s );
bli_csets( bli_creal(*cb), bli_cimag(*cb), *ca );
goto L20;
L10:
scale = bla_c_abs(ca) + bla_c_abs(cb);
bli_csets( (bli_creal(*ca) / scale), (bli_cimag(*ca) / scale), q__1 );
/* Computing 2nd power */
r__1 = bla_c_abs(&q__1);
bli_csets( (bli_creal(*cb) / scale), (bli_cimag(*cb) / scale), q__2 );
/* Computing 2nd power */
r__2 = bla_c_abs(&q__2);
norm = scale * sqrt(r__1 * r__1 + r__2 * r__2);
r__1 = bla_c_abs(ca);
bli_csets( (bli_creal(*ca) / r__1), (bli_cimag(*ca) / r__1), q__1 );
bli_csets( (bli_creal(q__1)), (bli_cimag(q__1)), alpha );
*c__ = bla_c_abs(ca) / norm;
bla_r_cnjg(&q__3, cb);
bli_csets( (bli_creal(alpha) * bli_creal(q__3) - bli_cimag(alpha) * bli_cimag(q__3)), (bli_creal(alpha) * bli_cimag(q__3) + bli_cimag(alpha) * bli_creal(q__3)), q__2 );
bli_csets( (bli_creal(q__2) / norm), (bli_cimag(q__2) / norm), q__1 );
bli_csets( bli_creal(q__1), bli_cimag(q__1), *s );
bli_csets( (norm * bli_creal(alpha)), (norm * bli_cimag(alpha)), q__1 );
bli_csets( bli_creal(q__1), bli_cimag(q__1), *ca );
L20:
return 0;
} /* crotg_ */
