linpack.c revision 60c45ed01d4f99571d468c42f609d11a099fab1e
/*
* CDDL HEADER START
*
* The contents of this file are subject to the terms of the
* Common Development and Distribution License (the "License").
* You may not use this file except in compliance with the License.
*
* You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
* See the License for the specific language governing permissions
* and limitations under the License.
*
* When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at usr/src/OPENSOLARIS.LICENSE.
* If applicable, add the following below this CDDL HEADER, with the
* fields enclosed by brackets "[]" replaced with your own identifying
* information: Portions Copyright [yyyy] [name of copyright owner]
*
* CDDL HEADER END
*/
/*
* Copyright 2008 Sun Microsystems, Inc.
* All rights reserved.
* Use is subject to license terms.
*/
#pragma ident "%Z%%M% %I% %E% SMI"
#include <errno.h>
#include <stdio.h>
#include <stdlib.h>
#include <unistd.h>
#include <externs.h>
#include <fp.h>
#include <fps_ereport.h>
#include <fpstestmsg.h>
#include <linpack.h>
#ifdef __i386
#else
#include <sunperf.h>
#endif
double fabs(double x);
extern void ___pl_dss_set_chip_cache_(int *cache_size);
extern int errno;
static int MAT_SIZE;
/*
* LINPACK(int Stress, int unit, struct fps_test_ereport *report,
* int fps_verbose_msg)
* performs the single and double precision lapack test. If an
* error is found, relevant data is collected and stored in report.
*/
int
int fps_verbose_msg)
{
char err_data[MAX_INFO_SIZE];
char l_buf[64];
int c_index;
int ret;
#ifdef FPS_LAPA_UNK
#ifndef DP
if (Stress > 1000)
return (0);
#endif /* DP */
#endif /* FPS_LAPA_UNK */
if (Stress > 10000)
return (0);
/*
* make sure is no dependency on the E$ size Without this call the
* computed results will depend on the size of the E$ (
* sos10/libsunperf ) IIIi computed results != IV+/IV/III+/III ...
*/
if (2000 == c_index)
c_index = 1001;
if (3000 == c_index)
c_index = 1002;
if (4016 == c_index)
c_index = 1003;
if (5000 == c_index)
c_index = 1004;
if (6000 == c_index)
c_index = 1005;
if (7016 == c_index)
c_index = 1006;
if (8034 == c_index)
c_index = 1007;
if (9000 == c_index)
c_index = 1008;
if (10000 == c_index)
c_index = 1009;
if (2 == ret) {
else
}
#ifdef FPS_LAPA_UNK
#ifdef DP
EPS = 2.2204460492503131e-16;
#else /* DP */
EPS = 1.1920928955078125e-07;
#endif /* DP */
#else /* FPS_LAPA_UNK */
#endif /* FPS_LAPA_UNK */
return (0);
} else {
"\nExpected: %.16e, %.16e, %.16e, %.16e, %.16e"
"\nObserved: %.16e, %.16e, %.16e, %.16e, %.16e",
#ifdef DP
#else
#endif
return (-1);
}
}
/*
* LINSUB(REAL *residn, REAL *resid, REAL *eps,
* REAL *x11, REAL *xn1, int fps_verbose_msg)begins
* the lapack calculation calls.
*/
static int
int fps_verbose_msg)
{
int i;
int lda;
int n;
int nr_malloc;
REAL *a;
REAL *b;
REAL *x;
long info;
long *ipvt;
nr_malloc = 0;
if (NULL != a)
free(a);
if (NULL != b)
free(b);
if (NULL != x)
free(x);
/* sleep 10 ms. wait for 100 ms */
if (nr_malloc++ < 11) {
goto mallocAgain;
}
"Malloc failed in lapack, matrix size %d",
MAT_SIZE);
return (2);
}
n = MAT_SIZE;
for (i = 0; i < n; i++) {
x[i] = b[i];
}
for (i = 0; i < n; i++) {
b[i] = -b[i];
}
free(a);
*resid = 0.0;
normx = 0.0;
for (i = 0; i < n; i++) {
}
free(b);
*x11 = x[0] - 1;
free(x);
return (0);
}
/*
* dran(int iseed[4]) returns a random real number from a
* uniform (0,1) distribution.
*/
static double
{
double r;
double value;
int ipw2;
int it1;
int it2;
int it3;
int it4;
int m1;
int m2;
int m3;
int m4;
/* Set constants */
m1 = 494;
m2 = 322;
m3 = 2508;
m4 = 2549;
ipw2 = 4096;
r = 1.0 / ipw2;
/* multiply the seed by the multiplier modulo 2**48 */
/* return updated seed */
/* convert 48-bit integer to a real number in the interval (0,1) */
r * ((double)it4))));
return (value);
}
/*
* MATGEN(REAL a[], int lda, int n, REAL b[], REAL *norma)
* generates matrix a and b.
*/
#define ALPHA 1.68750
static int
{
int i;
int init[4];
int j;
init[0] = 1;
for (j = 0; j < n; j++) {
for (i = 0; i < n; i++) {
#ifdef FPS_LAPA_UNK
a[lda*j+i] =
(i < j) ? (double)(i+1) : (double)(j+ALPHA);
} /* i */
#else
}
} /* i */
#endif /* FPS_LAPA_UNK */
} /* j */
for (i = 0; i < n; i++) {
b[i] = LP_ZERO;
}
for (j = 0; j < n; j++) {
for (i = 0; i < n; i++) {
b[i] = b[i] + a[lda * j + i];
}
}
return (0);
}
/*
* IAMAX(int n, REAL dx[])finds the index of element
* having maximum absolute value.
*/
int
{
double abs;
double dmax;
int i;
int itemp;
if (n < 1)
return (-1);
if (n == 1)
return (0);
itemp = 0;
for (i = 1; i < n; i++) {
itemp = i;
}
}
return (itemp);
}
/*
* EPSLON(REAL x) estimates unit roundoff in
* quantities of size x.
*/
static REAL
{
REAL a;
REAL b;
REAL c;
a = 4.0e0 / 3.0e0;
b = a - LP_ONE;
c = b + b + b;
}
}
/*
* MXPY(int n1, REAL y[], int n2, int ldm, REAL x[], REAL m[])
* multiplies matrix m times vector x and add the result to
* vector y.
*/
static void
{
int i;
int j;
int jmin;
/* cleanup odd vector */
j = n2 % 2;
if (j >= 1) {
j = j - 1;
for (i = 0; i < n1; i++)
y[i] = (y[i]) + x[j] * m[ldm * j + i];
}
/* cleanup odd group of two vectors */
j = n2 % 4;
if (j >= 2) {
j = j - 1;
for (i = 0; i < n1; i++)
y[i] = ((y[i])
+ x[j] * m[ldm * j + i];
}
/* cleanup odd group of four vectors */
j = n2 % 8;
if (j >= 4) {
j = j - 1;
for (i = 0; i < n1; i++)
y[i] = ((((y[i])
+ x[j] * m[ldm * j + i];
}
/* cleanup odd group of eight vectors */
j = n2 % 16;
if (j >= 8) {
j = j - 1;
for (i = 0; i < n1; i++)
y[i] = ((((((((y[i])
+ x[j] * m[ldm * j + i];
}
/* main loop - groups of sixteen vectors */
for (i = 0; i < n1; i++)
y[i] = ((((((((((((((((y[i])
+ x[j] * m[ldm * j + i];
}
}