mirror of
https://github.com/amd/blis.git
synced 2026-05-11 09:39:59 +00:00
766769eeb9
* Revert "restore bli_extern_defs exporting for now" This reverts commit 09fb07c350b2acee17645e8e9e1b8d829c73dca8. * Remove symbols not intended to be public * No need of def file anymore * Fix whitespace * No need of configure option * Remove export macro from definitions * Remove blas export macro from definitions
373 lines
8.8 KiB
C
373 lines
8.8 KiB
C
/*
|
|
|
|
BLIS
|
|
An object-based framework for developing high-performance BLAS-like
|
|
libraries.
|
|
|
|
Copyright (C) 2014, The University of Texas at Austin
|
|
|
|
Redistribution and use in source and binary forms, with or without
|
|
modification, are permitted provided that the following conditions are
|
|
met:
|
|
- Redistributions of source code must retain the above copyright
|
|
notice, this list of conditions and the following disclaimer.
|
|
- Redistributions in binary form must reproduce the above copyright
|
|
notice, this list of conditions and the following disclaimer in the
|
|
documentation and/or other materials provided with the distribution.
|
|
- Neither the name(s) of the copyright holder(s) nor the names of its
|
|
contributors may be used to endorse or promote products derived
|
|
from this software without specific prior written permission.
|
|
|
|
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
|
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
|
|
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
|
|
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
|
|
HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
|
|
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
|
|
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
|
|
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
|
|
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
|
|
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
|
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
|
|
|
*/
|
|
|
|
#include "blis.h"
|
|
|
|
#ifdef BLIS_ENABLE_BLAS
|
|
|
|
/* srotm.f -- translated by f2c (version 19991025).
|
|
You must link the resulting object file with the libraries:
|
|
-lf2c -lm (in that order)
|
|
*/
|
|
|
|
/* Subroutine */ int PASTEF77(s,rotm)(const bla_integer *n, bla_real *sx, const bla_integer *incx, bla_real *sy, const bla_integer *incy, const bla_real *sparam)
|
|
{
|
|
/* Initialized data */
|
|
|
|
static bla_real zero = 0.f;
|
|
static bla_real two = 2.f;
|
|
|
|
/* System generated locals */
|
|
bla_integer i__1, i__2;
|
|
|
|
/* Local variables */
|
|
bla_integer i__;
|
|
bla_real w, z__, sflag;
|
|
bla_integer kx, ky, nsteps;
|
|
bla_real sh11, sh12, sh21, sh22;
|
|
|
|
|
|
/* APPLY THE MODIFIED GIVENS TRANSFORMATION, H, TO THE 2 BY N MATRIX */
|
|
|
|
/* (SX**T) , WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF SX ARE IN */
|
|
/* (DX**T) */
|
|
|
|
/* SX(LX+I*INCX), I = 0 TO N-1, WHERE LX = 1 IF INCX .GE. 0, ELSE */
|
|
/* LX = (-INCX)*N, AND SIMILARLY FOR SY USING USING LY AND INCY. */
|
|
/* WITH SPARAM(1)=SFLAG, H HAS ONE OF THE FOLLOWING FORMS.. */
|
|
|
|
/* SFLAG=-1.E0 SFLAG=0.E0 SFLAG=1.E0 SFLAG=-2.E0 */
|
|
|
|
/* (SH11 SH12) (1.E0 SH12) (SH11 1.E0) (1.E0 0.E0) */
|
|
/* H=( ) ( ) ( ) ( ) */
|
|
/* (SH21 SH22), (SH21 1.E0), (-1.E0 SH22), (0.E0 1.E0). */
|
|
/* SEE SROTMG FOR A DESCRIPTION OF DATA STORAGE IN SPARAM. */
|
|
|
|
/* Parameter adjustments */
|
|
--sparam;
|
|
--sy;
|
|
--sx;
|
|
|
|
/* Function Body */
|
|
|
|
sflag = sparam[1];
|
|
if (*n <= 0 || sflag + two == zero) {
|
|
goto L140;
|
|
}
|
|
if (! (*incx == *incy && *incx > 0)) {
|
|
goto L70;
|
|
}
|
|
|
|
nsteps = *n * *incx;
|
|
if (sflag < 0.f) {
|
|
goto L50;
|
|
} else if (sflag == 0) {
|
|
goto L10;
|
|
} else {
|
|
goto L30;
|
|
}
|
|
L10:
|
|
sh12 = sparam[4];
|
|
sh21 = sparam[3];
|
|
i__1 = nsteps;
|
|
i__2 = *incx;
|
|
for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
|
|
w = sx[i__];
|
|
z__ = sy[i__];
|
|
sx[i__] = w + z__ * sh12;
|
|
sy[i__] = w * sh21 + z__;
|
|
/* L20: */
|
|
}
|
|
goto L140;
|
|
L30:
|
|
sh11 = sparam[2];
|
|
sh22 = sparam[5];
|
|
i__2 = nsteps;
|
|
i__1 = *incx;
|
|
for (i__ = 1; i__1 < 0 ? i__ >= i__2 : i__ <= i__2; i__ += i__1) {
|
|
w = sx[i__];
|
|
z__ = sy[i__];
|
|
sx[i__] = w * sh11 + z__;
|
|
sy[i__] = -w + sh22 * z__;
|
|
/* L40: */
|
|
}
|
|
goto L140;
|
|
L50:
|
|
sh11 = sparam[2];
|
|
sh12 = sparam[4];
|
|
sh21 = sparam[3];
|
|
sh22 = sparam[5];
|
|
i__1 = nsteps;
|
|
i__2 = *incx;
|
|
for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
|
|
w = sx[i__];
|
|
z__ = sy[i__];
|
|
sx[i__] = w * sh11 + z__ * sh12;
|
|
sy[i__] = w * sh21 + z__ * sh22;
|
|
/* L60: */
|
|
}
|
|
goto L140;
|
|
L70:
|
|
kx = 1;
|
|
ky = 1;
|
|
if (*incx < 0) {
|
|
kx = (1 - *n) * *incx + 1;
|
|
}
|
|
if (*incy < 0) {
|
|
ky = (1 - *n) * *incy + 1;
|
|
}
|
|
|
|
if (sflag < 0.f) {
|
|
goto L120;
|
|
} else if (sflag == 0) {
|
|
goto L80;
|
|
} else {
|
|
goto L100;
|
|
}
|
|
L80:
|
|
sh12 = sparam[4];
|
|
sh21 = sparam[3];
|
|
i__2 = *n;
|
|
for (i__ = 1; i__ <= i__2; ++i__) {
|
|
w = sx[kx];
|
|
z__ = sy[ky];
|
|
sx[kx] = w + z__ * sh12;
|
|
sy[ky] = w * sh21 + z__;
|
|
kx += *incx;
|
|
ky += *incy;
|
|
/* L90: */
|
|
}
|
|
goto L140;
|
|
L100:
|
|
sh11 = sparam[2];
|
|
sh22 = sparam[5];
|
|
i__2 = *n;
|
|
for (i__ = 1; i__ <= i__2; ++i__) {
|
|
w = sx[kx];
|
|
z__ = sy[ky];
|
|
sx[kx] = w * sh11 + z__;
|
|
sy[ky] = -w + sh22 * z__;
|
|
kx += *incx;
|
|
ky += *incy;
|
|
/* L110: */
|
|
}
|
|
goto L140;
|
|
L120:
|
|
sh11 = sparam[2];
|
|
sh12 = sparam[4];
|
|
sh21 = sparam[3];
|
|
sh22 = sparam[5];
|
|
i__2 = *n;
|
|
for (i__ = 1; i__ <= i__2; ++i__) {
|
|
w = sx[kx];
|
|
z__ = sy[ky];
|
|
sx[kx] = w * sh11 + z__ * sh12;
|
|
sy[ky] = w * sh21 + z__ * sh22;
|
|
kx += *incx;
|
|
ky += *incy;
|
|
/* L130: */
|
|
}
|
|
L140:
|
|
return 0;
|
|
} /* srotm_ */
|
|
|
|
/* drotm.f -- translated by f2c (version 19991025).
|
|
You must link the resulting object file with the libraries:
|
|
-lf2c -lm (in that order)
|
|
*/
|
|
|
|
/* Subroutine */ int PASTEF77(d,rotm)(const bla_integer *n, bla_double *dx, const bla_integer *incx, bla_double *dy, const bla_integer *incy, const bla_double *dparam)
|
|
{
|
|
/* Initialized data */
|
|
|
|
static bla_double zero = 0.;
|
|
static bla_double two = 2.;
|
|
|
|
/* System generated locals */
|
|
bla_integer i__1, i__2;
|
|
|
|
/* Local variables */
|
|
bla_integer i__;
|
|
bla_double dflag, w, z__;
|
|
bla_integer kx, ky, nsteps;
|
|
bla_double dh11, dh12, dh22, dh21;
|
|
|
|
|
|
/* APPLY THE MODIFIED GIVENS TRANSFORMATION, H, TO THE 2 BY N MATRIX */
|
|
|
|
/* (DX**T) , WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF DX ARE IN */
|
|
/* (DY**T) */
|
|
|
|
/* DX(LX+I*INCX), I = 0 TO N-1, WHERE LX = 1 IF INCX .GE. 0, ELSE */
|
|
/* LX = (-INCX)*N, AND SIMILARLY FOR SY USING LY AND INCY. */
|
|
/* WITH DPARAM(1)=DFLAG, H HAS ONE OF THE FOLLOWING FORMS.. */
|
|
|
|
/* DFLAG=-1.D0 DFLAG=0.D0 DFLAG=1.D0 DFLAG=-2.D0 */
|
|
|
|
/* (DH11 DH12) (1.D0 DH12) (DH11 1.D0) (1.D0 0.D0) */
|
|
/* H=( ) ( ) ( ) ( ) */
|
|
/* (DH21 DH22), (DH21 1.D0), (-1.D0 DH22), (0.D0 1.D0). */
|
|
/* SEE DROTMG FOR A DESCRIPTION OF DATA STORAGE IN DPARAM. */
|
|
|
|
/* Parameter adjustments */
|
|
--dparam;
|
|
--dy;
|
|
--dx;
|
|
|
|
/* Function Body */
|
|
|
|
dflag = dparam[1];
|
|
if (*n <= 0 || dflag + two == zero) {
|
|
goto L140;
|
|
}
|
|
if (! (*incx == *incy && *incx > 0)) {
|
|
goto L70;
|
|
}
|
|
|
|
nsteps = *n * *incx;
|
|
if (dflag < 0.) {
|
|
goto L50;
|
|
} else if (dflag == 0) {
|
|
goto L10;
|
|
} else {
|
|
goto L30;
|
|
}
|
|
L10:
|
|
dh12 = dparam[4];
|
|
dh21 = dparam[3];
|
|
i__1 = nsteps;
|
|
i__2 = *incx;
|
|
for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
|
|
w = dx[i__];
|
|
z__ = dy[i__];
|
|
dx[i__] = w + z__ * dh12;
|
|
dy[i__] = w * dh21 + z__;
|
|
/* L20: */
|
|
}
|
|
goto L140;
|
|
L30:
|
|
dh11 = dparam[2];
|
|
dh22 = dparam[5];
|
|
i__2 = nsteps;
|
|
i__1 = *incx;
|
|
for (i__ = 1; i__1 < 0 ? i__ >= i__2 : i__ <= i__2; i__ += i__1) {
|
|
w = dx[i__];
|
|
z__ = dy[i__];
|
|
dx[i__] = w * dh11 + z__;
|
|
dy[i__] = -w + dh22 * z__;
|
|
/* L40: */
|
|
}
|
|
goto L140;
|
|
L50:
|
|
dh11 = dparam[2];
|
|
dh12 = dparam[4];
|
|
dh21 = dparam[3];
|
|
dh22 = dparam[5];
|
|
i__1 = nsteps;
|
|
i__2 = *incx;
|
|
for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
|
|
w = dx[i__];
|
|
z__ = dy[i__];
|
|
dx[i__] = w * dh11 + z__ * dh12;
|
|
dy[i__] = w * dh21 + z__ * dh22;
|
|
/* L60: */
|
|
}
|
|
goto L140;
|
|
L70:
|
|
kx = 1;
|
|
ky = 1;
|
|
if (*incx < 0) {
|
|
kx = (1 - *n) * *incx + 1;
|
|
}
|
|
if (*incy < 0) {
|
|
ky = (1 - *n) * *incy + 1;
|
|
}
|
|
|
|
if (dflag < 0.) {
|
|
goto L120;
|
|
} else if (dflag == 0) {
|
|
goto L80;
|
|
} else {
|
|
goto L100;
|
|
}
|
|
L80:
|
|
dh12 = dparam[4];
|
|
dh21 = dparam[3];
|
|
i__2 = *n;
|
|
for (i__ = 1; i__ <= i__2; ++i__) {
|
|
w = dx[kx];
|
|
z__ = dy[ky];
|
|
dx[kx] = w + z__ * dh12;
|
|
dy[ky] = w * dh21 + z__;
|
|
kx += *incx;
|
|
ky += *incy;
|
|
/* L90: */
|
|
}
|
|
goto L140;
|
|
L100:
|
|
dh11 = dparam[2];
|
|
dh22 = dparam[5];
|
|
i__2 = *n;
|
|
for (i__ = 1; i__ <= i__2; ++i__) {
|
|
w = dx[kx];
|
|
z__ = dy[ky];
|
|
dx[kx] = w * dh11 + z__;
|
|
dy[ky] = -w + dh22 * z__;
|
|
kx += *incx;
|
|
ky += *incy;
|
|
/* L110: */
|
|
}
|
|
goto L140;
|
|
L120:
|
|
dh11 = dparam[2];
|
|
dh12 = dparam[4];
|
|
dh21 = dparam[3];
|
|
dh22 = dparam[5];
|
|
i__2 = *n;
|
|
for (i__ = 1; i__ <= i__2; ++i__) {
|
|
w = dx[kx];
|
|
z__ = dy[ky];
|
|
dx[kx] = w * dh11 + z__ * dh12;
|
|
dy[ky] = w * dh21 + z__ * dh22;
|
|
kx += *incx;
|
|
ky += *incy;
|
|
/* L130: */
|
|
}
|
|
L140:
|
|
return 0;
|
|
} /* drotm_ */
|
|
|
|
#endif
|
|
|