File:
[LON-CAPA] /
capa /
capa51 /
pProj /
linpack.c
Revision
1.4:
download - view:
text,
annotated -
select for diffs
Mon Aug 7 20:47:29 2000 UTC (24 years, 2 months ago) by
albertel
Branches:
MAIN
CVS tags:
version_2_9_X,
version_2_9_99_0,
version_2_9_1,
version_2_9_0,
version_2_8_X,
version_2_8_99_1,
version_2_8_99_0,
version_2_8_2,
version_2_8_1,
version_2_8_0,
version_2_7_X,
version_2_7_99_1,
version_2_7_99_0,
version_2_7_1,
version_2_7_0,
version_2_6_X,
version_2_6_99_1,
version_2_6_99_0,
version_2_6_3,
version_2_6_2,
version_2_6_1,
version_2_6_0,
version_2_5_X,
version_2_5_99_1,
version_2_5_99_0,
version_2_5_2,
version_2_5_1,
version_2_5_0,
version_2_4_X,
version_2_4_99_0,
version_2_4_2,
version_2_4_1,
version_2_4_0,
version_2_3_X,
version_2_3_99_0,
version_2_3_2,
version_2_3_1,
version_2_3_0,
version_2_2_X,
version_2_2_99_1,
version_2_2_99_0,
version_2_2_2,
version_2_2_1,
version_2_2_0,
version_2_1_X,
version_2_1_99_3,
version_2_1_99_2,
version_2_1_99_1,
version_2_1_99_0,
version_2_1_3,
version_2_1_2,
version_2_1_1,
version_2_1_0,
version_2_12_X,
version_2_11_X,
version_2_11_5_msu,
version_2_11_5,
version_2_11_4_uiuc,
version_2_11_4_msu,
version_2_11_4,
version_2_11_3_uiuc,
version_2_11_3_msu,
version_2_11_3,
version_2_11_2_uiuc,
version_2_11_2_msu,
version_2_11_2_educog,
version_2_11_2,
version_2_11_1,
version_2_11_0_RC3,
version_2_11_0_RC2,
version_2_11_0_RC1,
version_2_11_0,
version_2_10_X,
version_2_10_1,
version_2_10_0_RC2,
version_2_10_0_RC1,
version_2_10_0,
version_2_0_X,
version_2_0_99_1,
version_2_0_2,
version_2_0_1,
version_2_0_0,
version_1_99_3,
version_1_99_2,
version_1_99_1_tmcc,
version_1_99_1,
version_1_99_0_tmcc,
version_1_99_0,
version_1_3_X,
version_1_3_3,
version_1_3_2,
version_1_3_1,
version_1_3_0,
version_1_2_X,
version_1_2_99_1,
version_1_2_99_0,
version_1_2_1,
version_1_2_0,
version_1_1_X,
version_1_1_99_5,
version_1_1_99_4,
version_1_1_99_3,
version_1_1_99_2,
version_1_1_99_1,
version_1_1_99_0,
version_1_1_3,
version_1_1_2,
version_1_1_1,
version_1_1_0,
version_1_0_99_3,
version_1_0_99_2,
version_1_0_99_1,
version_1_0_99,
version_1_0_3,
version_1_0_2,
version_1_0_1,
version_1_0_0,
version_0_99_5,
version_0_99_4,
version_0_99_3,
version_0_99_2,
version_0_99_1,
version_0_99_0,
version_0_6_2,
version_0_6,
version_0_5_1,
version_0_5,
version_0_4,
stable_2002_spring,
stable_2002_july,
stable_2002_april,
stable_2001_fall,
release_5-1-3,
loncapaMITrelate_1,
language_hyphenation_merge,
language_hyphenation,
conference_2003,
bz6209-base,
bz6209,
STABLE,
HEAD,
GCI_3,
GCI_2,
GCI_1,
CAPA_5-1-6,
CAPA_5-1-5,
CAPA_5-1-4_RC1,
BZ4492-merge,
BZ4492-feature_horizontal_radioresponse,
BZ4492-feature_Support_horizontal_radioresponse,
BZ4492-Support_horizontal_radioresponse
- fixed license notices the reference the GNU GPL rather than the GNU LGPL
/* functions to support the random number genrator
Copyright (C) 1992-2000 Michigan State University
The CAPA system is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License as
published by the Free Software Foundation; either version 2 of the
License, or (at your option) any later version.
The CAPA system is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You should have received a copy of the GNU General Public
License along with the CAPA system; see the file COPYING. If not,
write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.
As a special exception, you have permission to link this program
with the TtH/TtM library and distribute executables, as long as you
follow the requirements of the GNU GPL in regard to all of the
software in the executable aside from TtH/TtM.
*/
#include <math.h>
float sdot(long n,float *sx,long incx,float *sy,long incy)
{
static long i,ix,iy,m,mp1;
static float sdot,stemp;
stemp = sdot = 0.0;
if(n <= 0) return sdot;
if(incx == 1 && incy == 1) goto S20;
ix = iy = 1;
if(incx < 0) ix = (-n+1)*incx+1;
if(incy < 0) iy = (-n+1)*incy+1;
for(i=1; i<=n; i++) {
stemp += (*(sx+ix-1)**(sy+iy-1));
ix += incx;
iy += incy;
}
sdot = stemp;
return sdot;
S20:
m = n % 5L;
if(m == 0) goto S40;
for(i=0; i<m; i++) stemp += (*(sx+i)**(sy+i));
if(n < 5) goto S60;
S40:
mp1 = m+1;
for(i=mp1; i<=n; i+=5) stemp += (*(sx+i-1)**(sy+i-1)+*(sx+i)**(sy+i)+*(sx+i
+1)**(sy+i+1)+*(sx+i+2)**(sy+i+2)+*(sx+i+3)**(sy+i+3));
S60:
sdot = stemp;
return sdot;
}
void spofa(float *a,long lda,long n,long *info)
/*
SPOFA FACTORS A REAL SYMMETRIC POSITIVE DEFINITE MATRIX.
SPOFA IS USUALLY CALLED BY SPOCO, BUT IT CAN BE CALLED
DIRECTLY WITH A SAVING IN TIME IF RCOND IS NOT NEEDED.
(TIME FOR SPOCO) = (1 + 18/N)*(TIME FOR SPOFA) .
ON ENTRY
A REAL(LDA, N)
THE SYMMETRIC MATRIX TO BE FACTORED. ONLY THE
DIAGONAL AND UPPER TRIANGLE ARE USED.
LDA INTEGER
THE LEADING DIMENSION OF THE ARRAY A .
N INTEGER
THE ORDER OF THE MATRIX A .
ON RETURN
A AN UPPER TRIANGULAR MATRIX R SO THAT A = TRANS(R)*R
WHERE TRANS(R) IS THE TRANSPOSE.
THE STRICT LOWER TRIANGLE IS UNALTERED.
IF INFO .NE. 0 , THE FACTORIZATION IS NOT COMPLETE.
INFO INTEGER
= 0 FOR NORMAL RETURN.
= K SIGNALS AN ERROR CONDITION. THE LEADING MINOR
OF ORDER K IS NOT POSITIVE DEFINITE.
LINPACK. THIS VERSION DATED 08/14/78 .
CLEVE MOLER, UNIVERSITY OF NEW MEXICO, ARGONNE NATIONAL LAB.
SUBROUTINES AND FUNCTIONS
BLAS SDOT
FORTRAN SQRT
INTERNAL VARIABLES
*/
{
extern float sdot(long n,float *sx,long incx,float *sy,long incy);
static long j,jm1,k;
static float t,s;
/*
BEGIN BLOCK WITH ...EXITS TO 40
*/
for(j=1; j<=n; j++) {
*info = j;
s = 0.0;
jm1 = j-1;
if(jm1 < 1) goto S20;
for(k=0; k<jm1; k++) {
t = *(a+k+(j-1)*lda)-sdot(k,(a+k*lda),1L,(a+(j-1)*lda),1L);
t /= *(a+k+k*lda);
*(a+k+(j-1)*lda) = t;
s += (t*t);
}
S20:
s = *(a+j-1+(j-1)*lda)-s;
/*
......EXIT
*/
if(s <= 0.0) goto S40;
*(a+j-1+(j-1)*lda) = sqrt(s);
}
*info = 0;
S40:
return;
}
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>