567 lines
		
	
	
		
			15 KiB
		
	
	
	
		
			C
		
	
	
	
			
		
		
	
	
			567 lines
		
	
	
		
			15 KiB
		
	
	
	
		
			C
		
	
	
	
| /* f2c.h  --  Standard Fortran to C header file */
 | |
| 
 | |
| /**  barf  [ba:rf]  2.  "He suggested using FORTRAN, and everybody barfed."
 | |
| 
 | |
| 	- From The Shogakukan DICTIONARY OF NEW ENGLISH (Second edition) */
 | |
| 
 | |
| #ifndef F2C_INCLUDE
 | |
| #define F2C_INCLUDE
 | |
| 
 | |
| #include <math.h>
 | |
| #include <stdlib.h>
 | |
| #include <string.h>
 | |
| #include <stdio.h>
 | |
| #include <complex.h>
 | |
| #ifdef complex
 | |
| #undef complex
 | |
| #endif
 | |
| #ifdef I
 | |
| #undef I
 | |
| #endif
 | |
| 
 | |
| typedef int integer;
 | |
| typedef unsigned int uinteger;
 | |
| typedef char *address;
 | |
| typedef short int shortint;
 | |
| typedef float real;
 | |
| typedef double doublereal;
 | |
| typedef struct { real r, i; } complex;
 | |
| typedef struct { doublereal r, i; } doublecomplex;
 | |
| static inline _Complex float Cf(complex *z) {return z->r + z->i*_Complex_I;}
 | |
| static inline _Complex double Cd(doublecomplex *z) {return z->r + z->i*_Complex_I;}
 | |
| static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;}
 | |
| static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;}
 | |
| #define pCf(z) (*_pCf(z))
 | |
| #define pCd(z) (*_pCd(z))
 | |
| typedef int logical;
 | |
| typedef short int shortlogical;
 | |
| typedef char logical1;
 | |
| typedef char integer1;
 | |
| 
 | |
| #define TRUE_ (1)
 | |
| #define FALSE_ (0)
 | |
| 
 | |
| /* Extern is for use with -E */
 | |
| #ifndef Extern
 | |
| #define Extern extern
 | |
| #endif
 | |
| 
 | |
| /* I/O stuff */
 | |
| 
 | |
| typedef int flag;
 | |
| typedef int ftnlen;
 | |
| typedef int ftnint;
 | |
| 
 | |
| /*external read, write*/
 | |
| typedef struct
 | |
| {	flag cierr;
 | |
| 	ftnint ciunit;
 | |
| 	flag ciend;
 | |
| 	char *cifmt;
 | |
| 	ftnint cirec;
 | |
| } cilist;
 | |
| 
 | |
| /*internal read, write*/
 | |
| typedef struct
 | |
| {	flag icierr;
 | |
| 	char *iciunit;
 | |
| 	flag iciend;
 | |
| 	char *icifmt;
 | |
| 	ftnint icirlen;
 | |
| 	ftnint icirnum;
 | |
| } icilist;
 | |
| 
 | |
| /*open*/
 | |
| typedef struct
 | |
| {	flag oerr;
 | |
| 	ftnint ounit;
 | |
| 	char *ofnm;
 | |
| 	ftnlen ofnmlen;
 | |
| 	char *osta;
 | |
| 	char *oacc;
 | |
| 	char *ofm;
 | |
| 	ftnint orl;
 | |
| 	char *oblnk;
 | |
| } olist;
 | |
| 
 | |
| /*close*/
 | |
| typedef struct
 | |
| {	flag cerr;
 | |
| 	ftnint cunit;
 | |
| 	char *csta;
 | |
| } cllist;
 | |
| 
 | |
| /*rewind, backspace, endfile*/
 | |
| typedef struct
 | |
| {	flag aerr;
 | |
| 	ftnint aunit;
 | |
| } alist;
 | |
| 
 | |
| /* inquire */
 | |
| typedef struct
 | |
| {	flag inerr;
 | |
| 	ftnint inunit;
 | |
| 	char *infile;
 | |
| 	ftnlen infilen;
 | |
| 	ftnint	*inex;	/*parameters in standard's order*/
 | |
| 	ftnint	*inopen;
 | |
| 	ftnint	*innum;
 | |
| 	ftnint	*innamed;
 | |
| 	char	*inname;
 | |
| 	ftnlen	innamlen;
 | |
| 	char	*inacc;
 | |
| 	ftnlen	inacclen;
 | |
| 	char	*inseq;
 | |
| 	ftnlen	inseqlen;
 | |
| 	char 	*indir;
 | |
| 	ftnlen	indirlen;
 | |
| 	char	*infmt;
 | |
| 	ftnlen	infmtlen;
 | |
| 	char	*inform;
 | |
| 	ftnint	informlen;
 | |
| 	char	*inunf;
 | |
| 	ftnlen	inunflen;
 | |
| 	ftnint	*inrecl;
 | |
| 	ftnint	*innrec;
 | |
| 	char	*inblank;
 | |
| 	ftnlen	inblanklen;
 | |
| } inlist;
 | |
| 
 | |
| #define VOID void
 | |
| 
 | |
| union Multitype {	/* for multiple entry points */
 | |
| 	integer1 g;
 | |
| 	shortint h;
 | |
| 	integer i;
 | |
| 	/* longint j; */
 | |
| 	real r;
 | |
| 	doublereal d;
 | |
| 	complex c;
 | |
| 	doublecomplex z;
 | |
| 	};
 | |
| 
 | |
| typedef union Multitype Multitype;
 | |
| 
 | |
| struct Vardesc {	/* for Namelist */
 | |
| 	char *name;
 | |
| 	char *addr;
 | |
| 	ftnlen *dims;
 | |
| 	int  type;
 | |
| 	};
 | |
| typedef struct Vardesc Vardesc;
 | |
| 
 | |
| struct Namelist {
 | |
| 	char *name;
 | |
| 	Vardesc **vars;
 | |
| 	int nvars;
 | |
| 	};
 | |
| typedef struct Namelist Namelist;
 | |
| 
 | |
| #define abs(x) ((x) >= 0 ? (x) : -(x))
 | |
| #define dabs(x) (fabs(x))
 | |
| #define f2cmin(a,b) ((a) <= (b) ? (a) : (b))
 | |
| #define f2cmax(a,b) ((a) >= (b) ? (a) : (b))
 | |
| #define dmin(a,b) (f2cmin(a,b))
 | |
| #define dmax(a,b) (f2cmax(a,b))
 | |
| #define bit_test(a,b)	((a) >> (b) & 1)
 | |
| #define bit_clear(a,b)	((a) & ~((uinteger)1 << (b)))
 | |
| #define bit_set(a,b)	((a) |  ((uinteger)1 << (b)))
 | |
| 
 | |
| #define abort_() { sig_die("Fortran abort routine called", 1); }
 | |
| #define c_abs(z) (cabsf(Cf(z)))
 | |
| #define c_cos(R,Z) { pCf(R)=ccos(Cf(Z)); }
 | |
| #define c_div(c, a, b) {pCf(c) = Cf(a)/Cf(b);}
 | |
| #define z_div(c, a, b) {pCd(c) = Cd(a)/Cd(b);}
 | |
| #define c_exp(R, Z) {pCf(R) = cexpf(Cf(Z));}
 | |
| #define c_log(R, Z) {pCf(R) = clogf(Cf(Z));}
 | |
| #define c_sin(R, Z) {pCf(R) = csinf(Cf(Z));}
 | |
| //#define c_sqrt(R, Z) {*(R) = csqrtf(Cf(Z));}
 | |
| #define c_sqrt(R, Z) {pCf(R) = csqrtf(Cf(Z));}
 | |
| #define d_abs(x) (fabs(*(x)))
 | |
| #define d_acos(x) (acos(*(x)))
 | |
| #define d_asin(x) (asin(*(x)))
 | |
| #define d_atan(x) (atan(*(x)))
 | |
| #define d_atn2(x, y) (atan2(*(x),*(y)))
 | |
| #define d_cnjg(R, Z) { pCd(R) = conj(Cd(Z)); }
 | |
| #define r_cnjg(R, Z) { pCf(R) = conj(Cf(Z)); }
 | |
| #define d_cos(x) (cos(*(x)))
 | |
| #define d_cosh(x) (cosh(*(x)))
 | |
| #define d_dim(__a, __b) ( *(__a) > *(__b) ? *(__a) - *(__b) : 0.0 )
 | |
| #define d_exp(x) (exp(*(x)))
 | |
| #define d_imag(z) (cimag(Cd(z)))
 | |
| #define r_imag(z) (cimag(Cf(z)))
 | |
| #define d_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x)))
 | |
| #define r_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x)))
 | |
| #define d_lg10(x) ( 0.43429448190325182765 * log(*(x)) )
 | |
| #define r_lg10(x) ( 0.43429448190325182765 * log(*(x)) )
 | |
| #define d_log(x) (log(*(x)))
 | |
| #define d_mod(x, y) (fmod(*(x), *(y)))
 | |
| #define u_nint(__x) ((__x)>=0 ? floor((__x) + .5) : -floor(.5 - (__x)))
 | |
| #define d_nint(x) u_nint(*(x))
 | |
| #define u_sign(__a,__b) ((__b) >= 0 ? ((__a) >= 0 ? (__a) : -(__a)) : -((__a) >= 0 ? (__a) : -(__a)))
 | |
| #define d_sign(a,b) u_sign(*(a),*(b))
 | |
| #define r_sign(a,b) u_sign(*(a),*(b))
 | |
| #define d_sin(x) (sin(*(x)))
 | |
| #define d_sinh(x) (sinh(*(x)))
 | |
| #define d_sqrt(x) (sqrt(*(x)))
 | |
| #define d_tan(x) (tan(*(x)))
 | |
| #define d_tanh(x) (tanh(*(x)))
 | |
| #define i_abs(x) abs(*(x))
 | |
| #define i_dnnt(x) ((integer)u_nint(*(x)))
 | |
| #define i_len(s, n) (n)
 | |
| #define i_nint(x) ((integer)u_nint(*(x)))
 | |
| #define i_sign(a,b) ((integer)u_sign((integer)*(a),(integer)*(b)))
 | |
| #define pow_dd(ap, bp) ( pow(*(ap), *(bp)))
 | |
| #define pow_si(B,E) spow_ui(*(B),*(E))
 | |
| #define pow_ri(B,E) spow_ui(*(B),*(E))
 | |
| #define pow_di(B,E) dpow_ui(*(B),*(E))
 | |
| #define pow_zi(p, a, b) {pCd(p) = zpow_ui(Cd(a), *(b));}
 | |
| #define pow_ci(p, a, b) {pCf(p) = cpow_ui(Cf(a), *(b));}
 | |
| #define pow_zz(R,A,B) {pCd(R) = cpow(Cd(A),*(B));}
 | |
| #define s_cat(lpp, rpp, rnp, np, llp) { 	ftnlen i, nc, ll; char *f__rp, *lp; 	ll = (llp); lp = (lpp); 	for(i=0; i < (int)*(np); ++i) {         	nc = ll; 	        if((rnp)[i] < nc) nc = (rnp)[i]; 	        ll -= nc;         	f__rp = (rpp)[i]; 	        while(--nc >= 0) *lp++ = *(f__rp)++;         } 	while(--ll >= 0) *lp++ = ' '; }
 | |
| #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d))))
 | |
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; }
 | |
| #define sig_die(s, kill) { exit(1); }
 | |
| #define s_stop(s, n) {exit(0);}
 | |
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n";
 | |
| #define z_abs(z) (cabs(Cd(z)))
 | |
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));}
 | |
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));}
 | |
| #define myexit_() break;
 | |
| #define mycycle_() continue;
 | |
| #define myceiling_(w) ceil(w)
 | |
| #define myhuge_(w) HUGE_VAL
 | |
| //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);}
 | |
| #define mymaxloc_(w,s,e,n) dmaxloc_(w,*(s),*(e),n)
 | |
| 
 | |
| /* procedure parameter types for -A and -C++ */
 | |
| 
 | |
| #define F2C_proc_par_types 1
 | |
| #ifdef __cplusplus
 | |
| typedef logical (*L_fp)(...);
 | |
| #else
 | |
| typedef logical (*L_fp)();
 | |
| #endif
 | |
| 
 | |
| static float spow_ui(float x, integer n) {
 | |
| 	float pow=1.0; unsigned long int u;
 | |
| 	if(n != 0) {
 | |
| 		if(n < 0) n = -n, x = 1/x;
 | |
| 		for(u = n; ; ) {
 | |
| 			if(u & 01) pow *= x;
 | |
| 			if(u >>= 1) x *= x;
 | |
| 			else break;
 | |
| 		}
 | |
| 	}
 | |
| 	return pow;
 | |
| }
 | |
| static double dpow_ui(double x, integer n) {
 | |
| 	double pow=1.0; unsigned long int u;
 | |
| 	if(n != 0) {
 | |
| 		if(n < 0) n = -n, x = 1/x;
 | |
| 		for(u = n; ; ) {
 | |
| 			if(u & 01) pow *= x;
 | |
| 			if(u >>= 1) x *= x;
 | |
| 			else break;
 | |
| 		}
 | |
| 	}
 | |
| 	return pow;
 | |
| }
 | |
| static _Complex float cpow_ui(_Complex float x, integer n) {
 | |
| 	_Complex float pow=1.0; unsigned long int u;
 | |
| 	if(n != 0) {
 | |
| 		if(n < 0) n = -n, x = 1/x;
 | |
| 		for(u = n; ; ) {
 | |
| 			if(u & 01) pow *= x;
 | |
| 			if(u >>= 1) x *= x;
 | |
| 			else break;
 | |
| 		}
 | |
| 	}
 | |
| 	return pow;
 | |
| }
 | |
| static _Complex double zpow_ui(_Complex double x, integer n) {
 | |
| 	_Complex double pow=1.0; unsigned long int u;
 | |
| 	if(n != 0) {
 | |
| 		if(n < 0) n = -n, x = 1/x;
 | |
| 		for(u = n; ; ) {
 | |
| 			if(u & 01) pow *= x;
 | |
| 			if(u >>= 1) x *= x;
 | |
| 			else break;
 | |
| 		}
 | |
| 	}
 | |
| 	return pow;
 | |
| }
 | |
| static integer pow_ii(integer x, integer n) {
 | |
| 	integer pow; unsigned long int u;
 | |
| 	if (n <= 0) {
 | |
| 		if (n == 0 || x == 1) pow = 1;
 | |
| 		else if (x != -1) pow = x == 0 ? 1/x : 0;
 | |
| 		else n = -n;
 | |
| 	}
 | |
| 	if ((n > 0) || !(n == 0 || x == 1 || x != -1)) {
 | |
| 		u = n;
 | |
| 		for(pow = 1; ; ) {
 | |
| 			if(u & 01) pow *= x;
 | |
| 			if(u >>= 1) x *= x;
 | |
| 			else break;
 | |
| 		}
 | |
| 	}
 | |
| 	return pow;
 | |
| }
 | |
| static integer dmaxloc_(double *w, integer s, integer e, integer *n)
 | |
| {
 | |
| 	double m; integer i, mi;
 | |
| 	for(m=w[s-1], mi=s, i=s+1; i<=e; i++)
 | |
| 		if (w[i-1]>m) mi=i ,m=w[i-1];
 | |
| 	return mi-s+1;
 | |
| }
 | |
| static integer smaxloc_(float *w, integer s, integer e, integer *n)
 | |
| {
 | |
| 	float m; integer i, mi;
 | |
| 	for(m=w[s-1], mi=s, i=s+1; i<=e; i++)
 | |
| 		if (w[i-1]>m) mi=i ,m=w[i-1];
 | |
| 	return mi-s+1;
 | |
| }
 | |
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) {
 | |
| 	integer n = *n_, incx = *incx_, incy = *incy_, i;
 | |
| 	_Complex float zdotc = 0.0;
 | |
| 	if (incx == 1 && incy == 1) {
 | |
| 		for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
 | |
| 			zdotc += conjf(Cf(&x[i])) * Cf(&y[i]);
 | |
| 		}
 | |
| 	} else {
 | |
| 		for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
 | |
| 			zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]);
 | |
| 		}
 | |
| 	}
 | |
| 	pCf(z) = zdotc;
 | |
| }
 | |
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) {
 | |
| 	integer n = *n_, incx = *incx_, incy = *incy_, i;
 | |
| 	_Complex double zdotc = 0.0;
 | |
| 	if (incx == 1 && incy == 1) {
 | |
| 		for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
 | |
| 			zdotc += conj(Cd(&x[i])) * Cd(&y[i]);
 | |
| 		}
 | |
| 	} else {
 | |
| 		for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
 | |
| 			zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]);
 | |
| 		}
 | |
| 	}
 | |
| 	pCd(z) = zdotc;
 | |
| }	
 | |
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) {
 | |
| 	integer n = *n_, incx = *incx_, incy = *incy_, i;
 | |
| 	_Complex float zdotc = 0.0;
 | |
| 	if (incx == 1 && incy == 1) {
 | |
| 		for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
 | |
| 			zdotc += Cf(&x[i]) * Cf(&y[i]);
 | |
| 		}
 | |
| 	} else {
 | |
| 		for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
 | |
| 			zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]);
 | |
| 		}
 | |
| 	}
 | |
| 	pCf(z) = zdotc;
 | |
| }
 | |
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) {
 | |
| 	integer n = *n_, incx = *incx_, incy = *incy_, i;
 | |
| 	_Complex double zdotc = 0.0;
 | |
| 	if (incx == 1 && incy == 1) {
 | |
| 		for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
 | |
| 			zdotc += Cd(&x[i]) * Cd(&y[i]);
 | |
| 		}
 | |
| 	} else {
 | |
| 		for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
 | |
| 			zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]);
 | |
| 		}
 | |
| 	}
 | |
| 	pCd(z) = zdotc;
 | |
| }
 | |
| #endif
 | |
| /*  -- translated by f2c (version 20000121).
 | |
|    You must link the resulting object file with the libraries:
 | |
| 	-lf2c -lm   (in that order)
 | |
| */
 | |
| 
 | |
| 
 | |
| 
 | |
| /* Table of constant values */
 | |
| 
 | |
| static integer c__1 = 1;
 | |
| static integer c__1000 = 1000;
 | |
| 
 | |
| /* > \brief \b SECONDTST */
 | |
| 
 | |
| /*  =========== DOCUMENTATION =========== */
 | |
| 
 | |
| /* Online html documentation available at */
 | |
| /*            http://www.netlib.org/lapack/explore-html/ */
 | |
| 
 | |
| 
 | |
| /*  Authors: */
 | |
| /*  ======== */
 | |
| 
 | |
| /* > \author Univ. of Tennessee */
 | |
| /* > \author Univ. of California Berkeley */
 | |
| /* > \author Univ. of Colorado Denver */
 | |
| /* > \author NAG Ltd. */
 | |
| 
 | |
| /* > \date November 2017 */
 | |
| 
 | |
| /* > \ingroup auxOTHERcomputational */
 | |
| 
 | |
| /*  =====================================================================      PROGRAM SECONDTST */
 | |
| 
 | |
| /*  -- LAPACK test routine (version 3.8.0) -- */
 | |
| 
 | |
| /*  -- LAPACK computational routine (version 3.8.0) -- */
 | |
| /*  -- LAPACK is a software package provided by Univ. of Tennessee,    -- */
 | |
| /*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */
 | |
| /*     November 2017 */
 | |
| 
 | |
| /* ===================================================================== */
 | |
| 
 | |
| /* Main program */ main(void)
 | |
| {
 | |
|     /* Format strings */
 | |
|     static char fmt_9999[] = "(\002 Time for \002,g10.3,\002 SAXPY ops = "
 | |
| 	    "\002,g10.3,\002 seconds\002)";
 | |
|     static char fmt_9998[] = "(\002 SAXPY performance rate        = \002,g10"
 | |
| 	    ".3,\002 mflops \002)";
 | |
|     static char fmt_9994[] = "(\002 *** Warning:  Time for operations was le"
 | |
| 	    "ss or equal\002,\002 than zero => timing in TESTING might be dub"
 | |
| 	    "ious\002)";
 | |
|     static char fmt_9997[] = "(\002 Including SECOND, time        = \002,g10"
 | |
| 	    ".3,\002 seconds\002)";
 | |
|     static char fmt_9996[] = "(\002 Average time for SECOND       = \002,g10"
 | |
| 	    ".3,\002 milliseconds\002)";
 | |
|     static char fmt_9995[] = "(\002 Equivalent floating point ops = \002,g10"
 | |
| 	    ".3,\002 ops\002)";
 | |
| 
 | |
|     /* System generated locals */
 | |
|     real r__1;
 | |
| 
 | |
|     /* Local variables */
 | |
|     integer i__, j;
 | |
|     real alpha, x[1000], y[1000], total;
 | |
|     extern /* Subroutine */ int mysub_(integer *, real *, real *);
 | |
|     real t1, t2;
 | |
|     extern real second_(void);
 | |
|     real tnosec, avg;
 | |
| 
 | |
|     /* Fortran I/O blocks */
 | |
|     static cilist io___10 = { 0, 6, 0, fmt_9999, 0 };
 | |
|     static cilist io___11 = { 0, 6, 0, fmt_9998, 0 };
 | |
|     static cilist io___12 = { 0, 6, 0, fmt_9994, 0 };
 | |
|     static cilist io___13 = { 0, 6, 0, fmt_9997, 0 };
 | |
|     static cilist io___15 = { 0, 6, 0, fmt_9996, 0 };
 | |
|     static cilist io___16 = { 0, 6, 0, fmt_9995, 0 };
 | |
| 
 | |
| 
 | |
| 
 | |
|     total = 1e8f;
 | |
| 
 | |
| /*     Initialize X and Y */
 | |
| 
 | |
|     for (i__ = 1; i__ <= 1000; ++i__) {
 | |
| 	x[i__ - 1] = 1.f / (real) i__;
 | |
| 	y[i__ - 1] = (real) (1000 - i__) / 1e3f;
 | |
| /* L10: */
 | |
|     }
 | |
|     alpha = .315f;
 | |
| 
 | |
| /*     Time TOTAL SAXPY operations */
 | |
| 
 | |
|     t1 = second_();
 | |
|     for (j = 1; j <= 50000; ++j) {
 | |
| 	for (i__ = 1; i__ <= 1000; ++i__) {
 | |
| 	    y[i__ - 1] += alpha * x[i__ - 1];
 | |
| /* L20: */
 | |
| 	}
 | |
| 	alpha = -alpha;
 | |
| /* L30: */
 | |
|     }
 | |
|     t2 = second_();
 | |
|     tnosec = t2 - t1;
 | |
| /*
 | |
|     s_wsfe(&io___10);
 | |
|     do_fio(&c__1, (char *)&total, (ftnlen)sizeof(real));
 | |
|     do_fio(&c__1, (char *)&tnosec, (ftnlen)sizeof(real));
 | |
|     e_wsfe();
 | |
|     if (tnosec > 0.f) {
 | |
| 	s_wsfe(&io___11);
 | |
| 	r__1 = total / 1e6f / tnosec;
 | |
| 	do_fio(&c__1, (char *)&r__1, (ftnlen)sizeof(real));
 | |
| 	e_wsfe();
 | |
|     } else {
 | |
| 	s_wsfe(&io___12);
 | |
| 	e_wsfe();
 | |
|     }
 | |
| */
 | |
|     printf("Time for %f10.3 SAXPY ops = %f10.3 seconds\n",total,tnosec);
 | |
|     if (tnosec > 0.f) {
 | |
|     printf("SAXPY performance rate        = %f10.3 mflops\n",total/1.e6/tnosec );
 | |
|     } else {
 | |
|     printf("*** Warning:  Time for operations was less or equal than zero => timing in TESTING might be dubious\n" );
 | |
|     }
 | |
| /*     Time TOTAL SAXPY operations with SECOND in the outer loop */
 | |
| 
 | |
|     t1 = second_();
 | |
|     for (j = 1; j <= 50000; ++j) {
 | |
| 	for (i__ = 1; i__ <= 1000; ++i__) {
 | |
| 	    y[i__ - 1] += alpha * x[i__ - 1];
 | |
| /* L40: */
 | |
| 	}
 | |
| 	alpha = -alpha;
 | |
| 	t2 = second_();
 | |
| /* L50: */
 | |
|     }
 | |
| 
 | |
| /*     Compute the time used in milliseconds used by an average call */
 | |
| /*     to SECOND. */
 | |
| /*
 | |
|     s_wsfe(&io___13);
 | |
|     r__1 = t2 - t1;
 | |
|     do_fio(&c__1, (char *)&r__1, (ftnlen)sizeof(real));
 | |
|     e_wsfe();
 | |
| */
 | |
|     printf("Including SECOND, time        = %f10.3 seconds\n",t2-t1);
 | |
|     avg = (t2 - t1 - tnosec) * 1e3f / 5e4f;
 | |
|     if (avg > 0.f) {
 | |
|      printf("Average time for SECOND       =  %f10.3 milliseconds\n",avg );
 | |
| 
 | |
|     /*
 | |
|  	s_wsfe(&io___15);
 | |
| 	do_fio(&c__1, (char *)&avg, (ftnlen)sizeof(real));
 | |
| 	e_wsfe();
 | |
| */
 | |
| 	}
 | |
| 
 | |
| /*     Compute the equivalent number of floating point operations used */
 | |
| /*     by an average call to SECOND. */
 | |
| 
 | |
|     if (avg > 0.f && tnosec > 0.f) {
 | |
| printf("Equivalent floating point ops = %f10.3 ops\n", avg/1000*total/tnosec);	    
 | |
| /*	s_wsfe(&io___16);
 | |
| 	r__1 = avg / 1000 * total / tnosec;
 | |
| 	do_fio(&c__1, (char *)&r__1, (ftnlen)sizeof(real));
 | |
| 	e_wsfe();
 | |
| */
 | |
|     	}
 | |
| 
 | |
|     mysub_(&c__1000, x, y);
 | |
|     return 0;
 | |
| } /* MAIN__ */
 | |
| 
 | |
| /* Subroutine */ int mysub_(integer *n, real *x, real *y)
 | |
| {
 | |
|     /* Parameter adjustments */
 | |
|     --y;
 | |
|     --x;
 | |
| 
 | |
|     /* Function Body */
 | |
|     return 0;
 | |
| } /* mysub_ */
 | |
| 
 |