Files
OpenBLAS/relapack/src/f2c.c
T
Martin Kroeker 798c448b0c Add support for INTERFACE64 and fix XERBLA calls
1. Replaced all instances of "int" with "blasint"
2. Added string length as "hidden" third parameter in calls to fortran XERBLA
2019-04-27 19:06:00 +02:00

110 lines
2.0 KiB
C

#include "stdlib.h"
#include "stdio.h"
#include "signal.h"
#include "f2c.h"
#ifndef SIGIOT
#ifdef SIGABRT
#define SIGIOT SIGABRT
#endif
#endif
void sig_die(const char *s, blasint kill) {
/* print error message, then clear buffers */
fprintf(stderr, "%s\n", s);
if(kill) {
fflush(stderr);
/* now get a core */
signal(SIGIOT, SIG_DFL);
abort();
} else
exit(1);
}
void c_div(complex *c, complex *a, complex *b) {
double ratio, den;
double abr, abi, cr;
if( (abr = b->r) < 0.)
abr = - abr;
if( (abi = b->i) < 0.)
abi = - abi;
if( abr <= abi ) {
if(abi == 0) {
#ifdef IEEE_COMPLEX_DIVIDE
float af, bf;
af = bf = abr;
if (a->i != 0 || a->r != 0)
af = 1.;
c->i = c->r = af / bf;
return;
#else
sig_die("complex division by zero", 1);
#endif
}
ratio = (double)b->r / b->i ;
den = b->i * (1 + ratio*ratio);
cr = (a->r*ratio + a->i) / den;
c->i = (a->i*ratio - a->r) / den;
} else {
ratio = (double)b->i / b->r ;
den = b->r * (1 + ratio*ratio);
cr = (a->r + a->i*ratio) / den;
c->i = (a->i - a->r*ratio) / den;
}
c->r = cr;
}
void z_div(doublecomplex *c, doublecomplex *a, doublecomplex *b) {
double ratio, den;
double abr, abi, cr;
if( (abr = b->r) < 0.)
abr = - abr;
if( (abi = b->i) < 0.)
abi = - abi;
if( abr <= abi ) {
if(abi == 0) {
#ifdef IEEE_COMPLEX_DIVIDE
if (a->i != 0 || a->r != 0)
abi = 1.;
c->i = c->r = abi / abr;
return;
#else
sig_die("complex division by zero", 1);
#endif
}
ratio = b->r / b->i ;
den = b->i * (1 + ratio*ratio);
cr = (a->r*ratio + a->i) / den;
c->i = (a->i*ratio - a->r) / den;
} else {
ratio = b->i / b->r ;
den = b->r * (1 + ratio*ratio);
cr = (a->r + a->i*ratio) / den;
c->i = (a->i - a->r*ratio) / den;
}
c->r = cr;
}
float r_imag(complex *z) {
return z->i;
}
void r_cnjg(complex *r, complex *z) {
float zi = z->i;
r->r = z->r;
r->i = -zi;
}
double d_imag(doublecomplex *z) {
return z->i;
}
void d_cnjg(doublecomplex *r, doublecomplex *z) {
double zi = z->i;
r->r = z->r;
r->i = -zi;
}