yenru0/2025-02-Numerical
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

add numerical recipes library

Browse Source
This commit is contained in:
yenru0
2025-09-12 18:55:25 +09:00
parent d4dff245bd
commit 2c75620ec9
1344 changed files with 63869 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

11
lib/nr/ansi/recipes/addint.c Normal file
View File

@@ -0,0 +1,11 @@
void addint(double **uf, double **uc, double **res, int nf)
{
void interp(double **uf, double **uc, int nf);
int i,j;
interp(res,uc,nf);
for (j=1;j<=nf;j++)
for (i=1;i<=nf;i++)
uf[i][j] += res[i][j];
}

43
lib/nr/ansi/recipes/airy.c Normal file
View File

@@ -0,0 +1,43 @@
#include <math.h>
#define PI 3.1415927
#define THIRD (1.0/3.0)
#define TWOTHR (2.0*THIRD)
#define ONOVRT 0.57735027
void airy(float x, float *ai, float *bi, float *aip, float *bip)
{
void bessik(float x, float xnu, float *ri, float *rk, float *rip,
float *rkp);
void bessjy(float x, float xnu, float *rj, float *ry, float *rjp,
float *ryp);
float absx,ri,rip,rj,rjp,rk,rkp,rootx,ry,ryp,z;
absx=fabs(x);
rootx=sqrt(absx);
z=TWOTHR*absx*rootx;
if (x > 0.0) {
bessik(z,THIRD,&ri,&rk,&rip,&rkp);
*ai=rootx*ONOVRT*rk/PI;
*bi=rootx*(rk/PI+2.0*ONOVRT*ri);
bessik(z,TWOTHR,&ri,&rk,&rip,&rkp);
*aip = -x*ONOVRT*rk/PI;
*bip=x*(rk/PI+2.0*ONOVRT*ri);
} else if (x < 0.0) {
bessjy(z,THIRD,&rj,&ry,&rjp,&ryp);
*ai=0.5*rootx*(rj-ONOVRT*ry);
*bi = -0.5*rootx*(ry+ONOVRT*rj);
bessjy(z,TWOTHR,&rj,&ry,&rjp,&ryp);
*aip=0.5*absx*(ONOVRT*ry+rj);
*bip=0.5*absx*(ONOVRT*rj-ry);
} else {
*ai=0.35502805;
*bi=(*ai)/ONOVRT;
*aip = -0.25881940;
*bip = -(*aip)/ONOVRT;
}
}
#undef PI
#undef THIRD
#undef TWOTHR
#undef ONOVRT

87
lib/nr/ansi/recipes/amebsa.c Normal file
View File

@@ -0,0 +1,87 @@
#include <math.h>
#define NRANSI
#include "nrutil.h"
#define GET_PSUM \
for (n=1;n<=ndim;n++) {\
for (sum=0.0,m=1;m<=mpts;m++) sum += p[m][n];\
psum[n]=sum;}
extern long idum;
float tt;
void amebsa(float **p, float y[], int ndim, float pb[], float *yb, float ftol,
float (*funk)(float []), int *iter, float temptr)
{
float amotsa(float **p, float y[], float psum[], int ndim, float pb[],
float *yb, float (*funk)(float []), int ihi, float *yhi, float fac);
float ran1(long *idum);
int i,ihi,ilo,j,m,n,mpts=ndim+1;
float rtol,sum,swap,yhi,ylo,ynhi,ysave,yt,ytry,*psum;
psum=vector(1,ndim);
tt = -temptr;
GET_PSUM
for (;;) {
ilo=1;
ihi=2;
ynhi=ylo=y[1]+tt*log(ran1(&idum));
yhi=y[2]+tt*log(ran1(&idum));
if (ylo > yhi) {
ihi=1;
ilo=2;
ynhi=yhi;
yhi=ylo;
ylo=ynhi;
}
for (i=3;i<=mpts;i++) {
yt=y[i]+tt*log(ran1(&idum));
if (yt <= ylo) {
ilo=i;
ylo=yt;
}
if (yt > yhi) {
ynhi=yhi;
ihi=i;
yhi=yt;
} else if (yt > ynhi) {
ynhi=yt;
}
}
rtol=2.0*fabs(yhi-ylo)/(fabs(yhi)+fabs(ylo));
if (rtol < ftol || *iter < 0) {
swap=y[1];
y[1]=y[ilo];
y[ilo]=swap;
for (n=1;n<=ndim;n++) {
swap=p[1][n];
p[1][n]=p[ilo][n];
p[ilo][n]=swap;
}
break;
}
*iter -= 2;
ytry=amotsa(p,y,psum,ndim,pb,yb,funk,ihi,&yhi,-1.0);
if (ytry <= ylo) {
ytry=amotsa(p,y,psum,ndim,pb,yb,funk,ihi,&yhi,2.0);
} else if (ytry >= ynhi) {
ysave=yhi;
ytry=amotsa(p,y,psum,ndim,pb,yb,funk,ihi,&yhi,0.5);
if (ytry >= ysave) {
for (i=1;i<=mpts;i++) {
if (i != ilo) {
for (j=1;j<=ndim;j++) {
psum[j]=0.5*(p[i][j]+p[ilo][j]);
p[i][j]=psum[j];
}
y[i]=(*funk)(psum);
}
}
*iter -= ndim;
GET_PSUM
}
} else ++(*iter);
}
free_vector(psum,1,ndim);
}
#undef GET_PSUM
#undef NRANSI

66
lib/nr/ansi/recipes/amoeba.c Normal file
View File

@@ -0,0 +1,66 @@
#include <math.h>
#define NRANSI
#include "nrutil.h"
#define TINY 1.0e-10
#define NMAX 5000
#define GET_PSUM \
for (j=1;j<=ndim;j++) {\
for (sum=0.0,i=1;i<=mpts;i++) sum += p[i][j];\
psum[j]=sum;}
#define SWAP(a,b) {swap=(a);(a)=(b);(b)=swap;}
void amoeba(float **p, float y[], int ndim, float ftol,
float (*funk)(float []), int *nfunk)
{
float amotry(float **p, float y[], float psum[], int ndim,
float (*funk)(float []), int ihi, float fac);
int i,ihi,ilo,inhi,j,mpts=ndim+1;
float rtol,sum,swap,ysave,ytry,*psum;
psum=vector(1,ndim);
*nfunk=0;
GET_PSUM
for (;;) {
ilo=1;
ihi = y[1]>y[2] ? (inhi=2,1) : (inhi=1,2);
for (i=1;i<=mpts;i++) {
if (y[i] <= y[ilo]) ilo=i;
if (y[i] > y[ihi]) {
inhi=ihi;
ihi=i;
} else if (y[i] > y[inhi] && i != ihi) inhi=i;
}
rtol=2.0*fabs(y[ihi]-y[ilo])/(fabs(y[ihi])+fabs(y[ilo])+TINY);
if (rtol < ftol) {
SWAP(y[1],y[ilo])
for (i=1;i<=ndim;i++) SWAP(p[1][i],p[ilo][i])
break;
}
if (*nfunk >= NMAX) nrerror("NMAX exceeded");
*nfunk += 2;
ytry=amotry(p,y,psum,ndim,funk,ihi,-1.0);
if (ytry <= y[ilo])
ytry=amotry(p,y,psum,ndim,funk,ihi,2.0);
else if (ytry >= y[inhi]) {
ysave=y[ihi];
ytry=amotry(p,y,psum,ndim,funk,ihi,0.5);
if (ytry >= ysave) {
for (i=1;i<=mpts;i++) {
if (i != ilo) {
for (j=1;j<=ndim;j++)
p[i][j]=psum[j]=0.5*(p[i][j]+p[ilo][j]);
y[i]=(*funk)(psum);
}
}
*nfunk += ndim;
GET_PSUM
}
} else --(*nfunk);
}
free_vector(psum,1,ndim);
}
#undef SWAP
#undef GET_PSUM
#undef NMAX
#undef NRANSI

26
lib/nr/ansi/recipes/amotry.c Normal file
View File

@@ -0,0 +1,26 @@
#define NRANSI
#include "nrutil.h"
float amotry(float **p, float y[], float psum[], int ndim,
float (*funk)(float []), int ihi, float fac)
{
int j;
float fac1,fac2,ytry,*ptry;
ptry=vector(1,ndim);
fac1=(1.0-fac)/ndim;
fac2=fac1-fac;
for (j=1;j<=ndim;j++) ptry[j]=psum[j]*fac1-p[ihi][j]*fac2;
ytry=(*funk)(ptry);
if (ytry < y[ihi]) {
y[ihi]=ytry;
for (j=1;j<=ndim;j++) {
psum[j] += ptry[j]-p[ihi][j];
p[ihi][j]=ptry[j];
}
}
free_vector(ptry,1,ndim);
return ytry;
}
#undef NRANSI

38
lib/nr/ansi/recipes/amotsa.c Normal file
View File

@@ -0,0 +1,38 @@
#include <math.h>
#define NRANSI
#include "nrutil.h"
extern long idum;
extern float tt;
float amotsa(float **p, float y[], float psum[], int ndim, float pb[],
float *yb, float (*funk)(float []), int ihi, float *yhi, float fac)
{
float ran1(long *idum);
int j;
float fac1,fac2,yflu,ytry,*ptry;
ptry=vector(1,ndim);
fac1=(1.0-fac)/ndim;
fac2=fac1-fac;
for (j=1;j<=ndim;j++)
ptry[j]=psum[j]*fac1-p[ihi][j]*fac2;
ytry=(*funk)(ptry);
if (ytry <= *yb) {
for (j=1;j<=ndim;j++) pb[j]=ptry[j];
*yb=ytry;
}
yflu=ytry-tt*log(ran1(&idum));
if (yflu < *yhi) {
y[ihi]=ytry;
*yhi=yflu;
for (j=1;j<=ndim;j++) {
psum[j] += ptry[j]-p[ihi][j];
p[ihi][j]=ptry[j];
}
}
free_vector(ptry,1,ndim);
return yflu;
}
#undef NRANSI

76
lib/nr/ansi/recipes/anneal.c Normal file
View File

@@ -0,0 +1,76 @@
#include <stdio.h>
#include <math.h>
#define TFACTR 0.9
#define ALEN(a,b,c,d) sqrt(((b)-(a))*((b)-(a))+((d)-(c))*((d)-(c)))
void anneal(float x[], float y[], int iorder[], int ncity)
{
int irbit1(unsigned long *iseed);
int metrop(float de, float t);
float ran3(long *idum);
float revcst(float x[], float y[], int iorder[], int ncity, int n[]);
void reverse(int iorder[], int ncity, int n[]);
float trncst(float x[], float y[], int iorder[], int ncity, int n[]);
void trnspt(int iorder[], int ncity, int n[]);
int ans,nover,nlimit,i1,i2;
int i,j,k,nsucc,nn,idec;
static int n[7];
long idum;
unsigned long iseed;
float path,de,t;
nover=100*ncity;
nlimit=10*ncity;
path=0.0;
t=0.5;
for (i=1;i<ncity;i++) {
i1=iorder[i];
i2=iorder[i+1];
path += ALEN(x[i1],x[i2],y[i1],y[i2]);
}
i1=iorder[ncity];
i2=iorder[1];
path += ALEN(x[i1],x[i2],y[i1],y[i2]);
idum = -1;
iseed=111;
for (j=1;j<=100;j++) {
nsucc=0;
for (k=1;k<=nover;k++) {
do {
n[1]=1+(int) (ncity*ran3(&idum));
n[2]=1+(int) ((ncity-1)*ran3(&idum));
if (n[2] >= n[1]) ++n[2];
nn=1+((n[1]-n[2]+ncity-1) % ncity);
} while (nn<3);
idec=irbit1(&iseed);
if (idec == 0) {
n[3]=n[2]+(int) (abs(nn-2)*ran3(&idum))+1;
n[3]=1+((n[3]-1) % ncity);
de=trncst(x,y,iorder,ncity,n);
ans=metrop(de,t);
if (ans) {
++nsucc;
path += de;
trnspt(iorder,ncity,n);
}
} else {
de=revcst(x,y,iorder,ncity,n);
ans=metrop(de,t);
if (ans) {
++nsucc;
path += de;
reverse(iorder,ncity,n);
}
}
if (nsucc >= nlimit) break;
}
printf("\n %s %10.6f %s %12.6f \n","T =",t,
" Path Length =",path);
printf("Successful Moves: %6d\n",nsucc);
t *= TFACTR;
if (nsucc == 0) return;
}
}
#undef TFACTR
#undef ALEN

13
lib/nr/ansi/recipes/anorm2.c Normal file
View File

@@ -0,0 +1,13 @@
#include <math.h>
double anorm2(double **a, int n)
{
int i,j;
double sum=0.0;
for (j=1;j<=n;j++)
for (i=1;i<=n;i++)
sum += a[i][j]*a[i][j];
return sqrt(sum)/n;
}

34
lib/nr/ansi/recipes/arcmak.c Normal file
View File

@@ -0,0 +1,34 @@
#define NRANSI
#include "nrutil.h"
#include <limits.h>
#define MC 512
#ifdef ULONG_MAX
#define MAXINT (ULONG_MAX >> 1)
#else
#define MAXINT 2147483647
#endif
typedef struct {
unsigned long *ilob,*iupb,*ncumfq,jdif,nc,minint,nch,ncum,nrad;
} arithcode;
void arcmak(unsigned long nfreq[], unsigned long nchh, unsigned long nradd,
arithcode *acode)
{
unsigned long j;
if (nchh > MC) nrerror("input radix may not exceed MC in arcmak.");
if (nradd > 256) nrerror("output radix may not exceed 256 in arcmak.");
acode->minint=MAXINT/nradd;
acode->nch=nchh;
acode->nrad=nradd;
acode->ncumfq[1]=0;
for (j=2;j<=acode->nch+1;j++)
acode->ncumfq[j]=acode->ncumfq[j-1]+IMAX(nfreq[j-1],1);
acode->ncum=acode->ncumfq[acode->nch+2]=acode->ncumfq[acode->nch+1]+1;
}
#undef MC
#undef MAXINT
#undef NRANSI

86
lib/nr/ansi/recipes/arcode.c Normal file
View File

@@ -0,0 +1,86 @@
#include <stdio.h>
#include <stdlib.h>
#define NWK 20
#define JTRY(j,k,m) ((long)((((double)(k))*((double)(j)))/((double)(m))))
typedef struct {
unsigned long *ilob,*iupb,*ncumfq,jdif,nc,minint,nch,ncum,nrad;
} arithcode;
void arcode(unsigned long *ich, unsigned char **codep, unsigned long *lcode,
unsigned long *lcd, int isign, arithcode *acode)
{
void arcsum(unsigned long iin[], unsigned long iout[], unsigned long ja,
int nwk, unsigned long nrad, unsigned long nc);
void nrerror(char error_text[]);
int j,k;
unsigned long ihi,ja,jh,jl,m;
if (!isign) {
acode->jdif=acode->nrad-1;
for (j=NWK;j>=1;j--) {
acode->iupb[j]=acode->nrad-1;
acode->ilob[j]=0;
acode->nc=j;
if (acode->jdif > acode->minint) return;
acode->jdif=(acode->jdif+1)*acode->nrad-1;
}
nrerror("NWK too small in arcode.");
} else {
if (isign > 0) {
if (*ich > acode->nch) nrerror("bad ich in arcode.");
}
else {
ja=(*codep)[*lcd]-acode->ilob[acode->nc];
for (j=acode->nc+1;j<=NWK;j++) {
ja *= acode->nrad;
ja += ((*codep)[*lcd+j-acode->nc]-acode->ilob[j]);
}
ihi=acode->nch+1;
*ich=0;
while (ihi-(*ich) > 1) {
m=(*ich+ihi)>>1;
if (ja >= JTRY(acode->jdif,acode->ncumfq[m+1],acode->ncum))
*ich=m;
else ihi=m;
}
if (*ich == acode->nch) return;
}
jh=JTRY(acode->jdif,acode->ncumfq[*ich+2],acode->ncum);
jl=JTRY(acode->jdif,acode->ncumfq[*ich+1],acode->ncum);
acode->jdif=jh-jl;
arcsum(acode->ilob,acode->iupb,jh,NWK,acode->nrad,acode->nc);
arcsum(acode->ilob,acode->ilob,jl,NWK,acode->nrad,acode->nc);
for (j=acode->nc;j<=NWK;j++) {
if (*ich != acode->nch && acode->iupb[j] != acode->ilob[j]) break;
if (*lcd > *lcode) {
fprintf(stderr,"Reached the end of the 'code' array.\n");
fprintf(stderr,"Attempting to expand its size.\n");
*lcode += *lcode/2;
if ((*codep=(unsigned char *)realloc(*codep,
(unsigned)(*lcode*sizeof(unsigned char)))) == NULL) {
nrerror("Size expansion failed");
}
}
if (isign > 0) (*codep)[*lcd]=(unsigned char)acode->ilob[j];
++(*lcd);
}
if (j > NWK) return;
acode->nc=j;
for(j=0;acode->jdif<acode->minint;j++)
acode->jdif *= acode->nrad;
if (acode->nc-j < 1) nrerror("NWK too small in arcode.");
if (j) {
for (k=acode->nc;k<=NWK;k++) {
acode->iupb[k-j]=acode->iupb[k];
acode->ilob[k-j]=acode->ilob[k];
}
}
acode->nc -= j;
for (k=NWK-j+1;k<=NWK;k++) acode->iupb[k]=acode->ilob[k]=0;
}
return;
}
#undef NWK
#undef JTRY

18
lib/nr/ansi/recipes/arcsum.c Normal file
View File

@@ -0,0 +1,18 @@
void arcsum(unsigned long iin[], unsigned long iout[], unsigned long ja,
int nwk, unsigned long nrad, unsigned long nc)
{
int j,karry=0;
unsigned long jtmp;
for (j=nwk;j>nc;j--) {
jtmp=ja;
ja /= nrad;
iout[j]=iin[j]+(jtmp-ja*nrad)+karry;
if (iout[j] >= nrad) {
iout[j] -= nrad;
karry=1;
} else karry=0;
}
iout[nc]=iin[nc]+ja+karry;
}

10
lib/nr/ansi/recipes/asolve.c Normal file
View File

@@ -0,0 +1,10 @@
extern unsigned long ija[];
extern double sa[];
void asolve(unsigned long n, double b[], double x[], int itrnsp)
{
unsigned long i;
for(i=1;i<=n;i++) x[i]=(sa[i] != 0.0 ? b[i]/sa[i] : b[i]);
}

14
lib/nr/ansi/recipes/atimes.c Normal file
View File

@@ -0,0 +1,14 @@
extern unsigned long ija[];
extern double sa[];
void atimes(unsigned long n, double x[], double r[], int itrnsp)
{
void dsprsax(double sa[], unsigned long ija[], double x[], double b[],
unsigned long n);
void dsprstx(double sa[], unsigned long ija[], double x[], double b[],
unsigned long n);
if (itrnsp) dsprstx(sa,ija,x,r,n);
else dsprsax(sa,ija,x,r,n);
}

16
lib/nr/ansi/recipes/avevar.c Normal file
View File

@@ -0,0 +1,16 @@
void avevar(float data[], unsigned long n, float *ave, float *var)
{
unsigned long j;
float s,ep;
for (*ave=0.0,j=1;j<=n;j++) *ave += data[j];
*ave /= n;
*var=ep=0.0;
for (j=1;j<=n;j++) {
s=data[j]-(*ave);
ep += s;
*var += s*s;
}
*var=(*var-ep*ep/n)/(n-1);
}

52
lib/nr/ansi/recipes/badluk.c Normal file
View File

@@ -0,0 +1,52 @@
#include <stdio.h>
#include <math.h>
#define ZON -5.0
#define IYBEG 1900
#define IYEND 2000
int main(void) /* Program badluk */
{
void flmoon(int n, int nph, long *jd, float *frac);
long julday(int mm, int id, int iyyy);
int ic,icon,idwk,im,iyyy,n;
float timzon = ZON/24.0,frac;
long jd,jday;
printf("\nFull moons on Friday the 13th from %5d to %5d\n",IYBEG,IYEND);
for (iyyy=IYBEG;iyyy<=IYEND;iyyy++) {
for (im=1;im<=12;im++) {
jday=julday(im,13,iyyy);
idwk=(int) ((jday+1) % 7);
if (idwk == 5) {
n=(int)(12.37*(iyyy-1900+(im-0.5)/12.0));
icon=0;
for (;;) {
flmoon(n,2,&jd,&frac);
frac=24.0*(frac+timzon);
if (frac < 0.0) {
--jd;
frac += 24.0;
}
if (frac > 12.0) {
++jd;
frac -= 12.0;
} else
frac += 12.0;
if (jd == jday) {
printf("\n%2d/13/%4d\n",im,iyyy);
printf("%s %5.1f %s\n","Full moon",frac,
" hrs after midnight (EST)");
break;
} else {
ic=(jday >= jd ? 1 : -1);
if (ic == (-icon)) break;
icon=ic;
n += ic;
}
}
}
}
}
return 0;
}

44
lib/nr/ansi/recipes/balanc.c Normal file
View File

@@ -0,0 +1,44 @@
#include <math.h>
#define RADIX 2.0
void balanc(float **a, int n)
{
int last,j,i;
float s,r,g,f,c,sqrdx;
sqrdx=RADIX*RADIX;
last=0;
while (last == 0) {
last=1;
for (i=1;i<=n;i++) {
r=c=0.0;
for (j=1;j<=n;j++)
if (j != i) {
c += fabs(a[j][i]);
r += fabs(a[i][j]);
}
if (c && r) {
g=r/RADIX;
f=1.0;
s=c+r;
while (c<g) {
f *= RADIX;
c *= sqrdx;
}
g=r*RADIX;
while (c>g) {
f /= RADIX;
c /= sqrdx;
}
if ((c+r)/f < 0.95*s) {
last=0;
g=1.0/f;
for (j=1;j<=n;j++) a[i][j] *= g;
for (j=1;j<=n;j++) a[j][i] *= f;
}
}
}
}
}
#undef RADIX

27
lib/nr/ansi/recipes/banbks.c Normal file
View File

@@ -0,0 +1,27 @@
#define SWAP(a,b) {dum=(a);(a)=(b);(b)=dum;}
void banbks(float **a, unsigned long n, int m1, int m2, float **al,
unsigned long indx[], float b[])
{
unsigned long i,k,l;
int mm;
float dum;
mm=m1+m2+1;
l=m1;
for (k=1;k<=n;k++) {
i=indx[k];
if (i != k) SWAP(b[k],b[i])
if (l < n) l++;
for (i=k+1;i<=l;i++) b[i] -= al[k][i-k]*b[k];
}
l=1;
for (i=n;i>=1;i--) {
dum=b[i];
for (k=2;k<=l;k++) dum -= a[i][k]*b[k+i-1];
b[i]=dum/a[i][1];
if (l < mm) l++;
}
}
#undef SWAP

47
lib/nr/ansi/recipes/bandec.c Normal file
View File

@@ -0,0 +1,47 @@
#include <math.h>
#define SWAP(a,b) {dum=(a);(a)=(b);(b)=dum;}
#define TINY 1.0e-20
void bandec(float **a, unsigned long n, int m1, int m2, float **al,
unsigned long indx[], float *d)
{
unsigned long i,j,k,l;
int mm;
float dum;
mm=m1+m2+1;
l=m1;
for (i=1;i<=m1;i++) {
for (j=m1+2-i;j<=mm;j++) a[i][j-l]=a[i][j];
l--;
for (j=mm-l;j<=mm;j++) a[i][j]=0.0;
}
*d=1.0;
l=m1;
for (k=1;k<=n;k++) {
dum=a[k][1];
i=k;
if (l < n) l++;
for (j=k+1;j<=l;j++) {
if (fabs(a[j][1]) > fabs(dum)) {
dum=a[j][1];
i=j;
}
}
indx[k]=i;
if (dum == 0.0) a[k][1]=TINY;
if (i != k) {
*d = -(*d);
for (j=1;j<=mm;j++) SWAP(a[k][j],a[i][j])
}
for (i=k+1;i<=l;i++) {
dum=a[i][1]/a[k][1];
al[k][i-k]=dum;
for (j=2;j<=mm;j++) a[i][j-1]=a[i][j]-dum*a[k][j];
a[i][mm]=0.0;
}
}
}
#undef SWAP
#undef TINY

16
lib/nr/ansi/recipes/banmul.c Normal file
View File

@@ -0,0 +1,16 @@
#define NRANSI
#include "nrutil.h"
void banmul(float **a, unsigned long n, int m1, int m2, float x[], float b[])
{
unsigned long i,j,k,tmploop;
for (i=1;i<=n;i++) {
k=i-m1-1;
tmploop=LMIN(m1+m2+1,n-k);
b[i]=0.0;
for (j=LMAX(1,1-k);j<=tmploop;j++) b[i] += a[i][j]*x[j+k];
}
}
#undef NRANSI

40
lib/nr/ansi/recipes/bcucof.c Normal file
View File

@@ -0,0 +1,40 @@
void bcucof(float y[], float y1[], float y2[], float y12[], float d1, float d2,
float **c)
{
static int wt[16][16]=
{ 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,
-3,0,0,3,0,0,0,0,-2,0,0,-1,0,0,0,0,
2,0,0,-2,0,0,0,0,1,0,0,1,0,0,0,0,
0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,
0,0,0,0,-3,0,0,3,0,0,0,0,-2,0,0,-1,
0,0,0,0,2,0,0,-2,0,0,0,0,1,0,0,1,
-3,3,0,0,-2,-1,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,-3,3,0,0,-2,-1,0,0,
9,-9,9,-9,6,3,-3,-6,6,-6,-3,3,4,2,1,2,
-6,6,-6,6,-4,-2,2,4,-3,3,3,-3,-2,-1,-1,-2,
2,-2,0,0,1,1,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,2,-2,0,0,1,1,0,0,
-6,6,-6,6,-3,-3,3,3,-4,4,2,-2,-2,-2,-1,-1,
4,-4,4,-4,2,2,-2,-2,2,-2,-2,2,1,1,1,1};
int l,k,j,i;
float xx,d1d2,cl[16],x[16];
d1d2=d1*d2;
for (i=1;i<=4;i++) {
x[i-1]=y[i];
x[i+3]=y1[i]*d1;
x[i+7]=y2[i]*d2;
x[i+11]=y12[i]*d1d2;
}
for (i=0;i<=15;i++) {
xx=0.0;
for (k=0;k<=15;k++) xx += wt[i][k]*x[k];
cl[i]=xx;
}
l=0;
for (i=1;i<=4;i++)
for (j=1;j<=4;j++) c[i][j]=cl[l++];
}

31
lib/nr/ansi/recipes/bcuint.c Normal file
View File

@@ -0,0 +1,31 @@
#define NRANSI
#include "nrutil.h"
void bcuint(float y[], float y1[], float y2[], float y12[], float x1l,
float x1u, float x2l, float x2u, float x1, float x2, float *ansy,
float *ansy1, float *ansy2)
{
void bcucof(float y[], float y1[], float y2[], float y12[], float d1,
float d2, float **c);
int i;
float t,u,d1,d2,**c;
c=matrix(1,4,1,4);
d1=x1u-x1l;
d2=x2u-x2l;
bcucof(y,y1,y2,y12,d1,d2,c);
if (x1u == x1l || x2u == x2l) nrerror("Bad input in routine bcuint");
t=(x1-x1l)/d1;
u=(x2-x2l)/d2;
*ansy=(*ansy2)=(*ansy1)=0.0;
for (i=4;i>=1;i--) {
*ansy=t*(*ansy)+((c[i][4]*u+c[i][3])*u+c[i][2])*u+c[i][1];
*ansy2=t*(*ansy2)+(3.0*c[i][4]*u+2.0*c[i][3])*u+c[i][2];
*ansy1=u*(*ansy1)+(3.0*c[4][i]*t+2.0*c[3][i])*t+c[2][i];
}
*ansy1 /= d1;
*ansy2 /= d2;
free_matrix(c,1,4,1,4);
}
#undef NRANSI

25
lib/nr/ansi/recipes/beschb.c Normal file
View File

@@ -0,0 +1,25 @@
#define NUSE1 5
#define NUSE2 5
void beschb(double x, double *gam1, double *gam2, double *gampl, double *gammi)
{
float chebev(float a, float b, float c[], int m, float x);
float xx;
static float c1[] = {
-1.142022680371168e0,6.5165112670737e-3,
3.087090173086e-4,-3.4706269649e-6,6.9437664e-9,
3.67795e-11,-1.356e-13};
static float c2[] = {
1.843740587300905e0,-7.68528408447867e-2,
1.2719271366546e-3,-4.9717367042e-6,-3.31261198e-8,
2.423096e-10,-1.702e-13,-1.49e-15};
xx=8.0*x*x-1.0;
*gam1=chebev(-1.0,1.0,c1,NUSE1,xx);
*gam2=chebev(-1.0,1.0,c2,NUSE2,xx);
*gampl= *gam2-x*(*gam1);
*gammi= *gam2+x*(*gam1);
}
#undef NUSE1
#undef NUSE2

38
lib/nr/ansi/recipes/bessi.c Normal file
View File

@@ -0,0 +1,38 @@
#include <math.h>
#define ACC 40.0
#define BIGNO 1.0e10
#define BIGNI 1.0e-10
float bessi(int n, float x)
{
float bessi0(float x);
void nrerror(char error_text[]);
int j;
float bi,bim,bip,tox,ans;
if (n < 2) nrerror("Index n less than 2 in bessi");
if (x == 0.0)
return 0.0;
else {
tox=2.0/fabs(x);
bip=ans=0.0;
bi=1.0;
for (j=2*(n+(int) sqrt(ACC*n));j>0;j--) {
bim=bip+j*tox*bi;
bip=bi;
bi=bim;
if (fabs(bi) > BIGNO) {
ans *= BIGNI;
bi *= BIGNI;
bip *= BIGNI;
}
if (j == n) ans=bip;
}
ans *= bessi0(x)/bi;
return x < 0.0 && (n & 1) ? -ans : ans;
}
}
#undef ACC
#undef BIGNO
#undef BIGNI

22
lib/nr/ansi/recipes/bessi0.c Normal file
View File

@@ -0,0 +1,22 @@
#include <math.h>
float bessi0(float x)
{
float ax,ans;
double y;
if ((ax=fabs(x)) < 3.75) {
y=x/3.75;
y*=y;
ans=1.0+y*(3.5156229+y*(3.0899424+y*(1.2067492
+y*(0.2659732+y*(0.360768e-1+y*0.45813e-2)))));
} else {
y=3.75/ax;
ans=(exp(ax)/sqrt(ax))*(0.39894228+y*(0.1328592e-1
+y*(0.225319e-2+y*(-0.157565e-2+y*(0.916281e-2
+y*(-0.2057706e-1+y*(0.2635537e-1+y*(-0.1647633e-1
+y*0.392377e-2))))))));
}
return ans;
}

23
lib/nr/ansi/recipes/bessi1.c Normal file
View File

@@ -0,0 +1,23 @@
#include <math.h>
float bessi1(float x)
{
float ax,ans;
double y;
if ((ax=fabs(x)) < 3.75) {
y=x/3.75;
y*=y;
ans=ax*(0.5+y*(0.87890594+y*(0.51498869+y*(0.15084934
+y*(0.2658733e-1+y*(0.301532e-2+y*0.32411e-3))))));
} else {
y=3.75/ax;
ans=0.2282967e-1+y*(-0.2895312e-1+y*(0.1787654e-1
-y*0.420059e-2));
ans=0.39894228+y*(-0.3988024e-1+y*(-0.362018e-2
+y*(0.163801e-2+y*(-0.1031555e-1+y*ans))));
ans *= (exp(ax)/sqrt(ax));
}
return x < 0.0 ? -ans : ans;
}

127
lib/nr/ansi/recipes/bessik.c Normal file
View File

@@ -0,0 +1,127 @@
#include <math.h>
#define EPS 1.0e-10
#define FPMIN 1.0e-30
#define MAXIT 10000
#define XMIN 2.0
#define PI 3.141592653589793
void bessik(float x, float xnu, float *ri, float *rk, float *rip, float *rkp)
{
void beschb(double x, double *gam1, double *gam2, double *gampl,
double *gammi);
void nrerror(char error_text[]);
int i,l,nl;
double a,a1,b,c,d,del,del1,delh,dels,e,f,fact,fact2,ff,gam1,gam2,
gammi,gampl,h,p,pimu,q,q1,q2,qnew,ril,ril1,rimu,rip1,ripl,
ritemp,rk1,rkmu,rkmup,rktemp,s,sum,sum1,x2,xi,xi2,xmu,xmu2;
if (x <= 0.0 || xnu < 0.0) nrerror("bad arguments in bessik");
nl=(int)(xnu+0.5);
xmu=xnu-nl;
xmu2=xmu*xmu;
xi=1.0/x;
xi2=2.0*xi;
h=xnu*xi;
if (h < FPMIN) h=FPMIN;
b=xi2*xnu;
d=0.0;
c=h;
for (i=1;i<=MAXIT;i++) {
b += xi2;
d=1.0/(b+d);
c=b+1.0/c;
del=c*d;
h=del*h;
if (fabs(del-1.0) < EPS) break;
}
if (i > MAXIT) nrerror("x too large in bessik; try asymptotic expansion");
ril=FPMIN;
ripl=h*ril;
ril1=ril;
rip1=ripl;
fact=xnu*xi;
for (l=nl;l>=1;l--) {
ritemp=fact*ril+ripl;
fact -= xi;
ripl=fact*ritemp+ril;
ril=ritemp;
}
f=ripl/ril;
if (x < XMIN) {
x2=0.5*x;
pimu=PI*xmu;
fact = (fabs(pimu) < EPS ? 1.0 : pimu/sin(pimu));
d = -log(x2);
e=xmu*d;
fact2 = (fabs(e) < EPS ? 1.0 : sinh(e)/e);
beschb(xmu,&gam1,&gam2,&gampl,&gammi);
ff=fact*(gam1*cosh(e)+gam2*fact2*d);
sum=ff;
e=exp(e);
p=0.5*e/gampl;
q=0.5/(e*gammi);
c=1.0;
d=x2*x2;
sum1=p;
for (i=1;i<=MAXIT;i++) {
ff=(i*ff+p+q)/(i*i-xmu2);
c *= (d/i);
p /= (i-xmu);
q /= (i+xmu);
del=c*ff;
sum += del;
del1=c*(p-i*ff);
sum1 += del1;
if (fabs(del) < fabs(sum)*EPS) break;
}
if (i > MAXIT) nrerror("bessk series failed to converge");
rkmu=sum;
rk1=sum1*xi2;
} else {
b=2.0*(1.0+x);
d=1.0/b;
h=delh=d;
q1=0.0;
q2=1.0;
a1=0.25-xmu2;
q=c=a1;
a = -a1;
s=1.0+q*delh;
for (i=2;i<=MAXIT;i++) {
a -= 2*(i-1);
c = -a*c/i;
qnew=(q1-b*q2)/a;
q1=q2;
q2=qnew;
q += c*qnew;
b += 2.0;
d=1.0/(b+a*d);
delh=(b*d-1.0)*delh;
h += delh;
dels=q*delh;
s += dels;
if (fabs(dels/s) < EPS) break;
}
if (i > MAXIT) nrerror("bessik: failure to converge in cf2");
h=a1*h;
rkmu=sqrt(PI/(2.0*x))*exp(-x)/s;
rk1=rkmu*(xmu+x+0.5-h)*xi;
}
rkmup=xmu*xi*rkmu-rk1;
rimu=xi/(f*rkmu-rkmup);
*ri=(rimu*ril1)/ril;
*rip=(rimu*rip1)/ril;
for (i=1;i<=nl;i++) {
rktemp=(xmu+i)*xi2*rk1+rkmu;
rkmu=rk1;
rk1=rktemp;
}
*rk=rkmu;
*rkp=xnu*xi*rkmu-rk1;
}
#undef EPS
#undef FPMIN
#undef MAXIT
#undef XMIN
#undef PI

56
lib/nr/ansi/recipes/bessj.c Normal file
View File

@@ -0,0 +1,56 @@
#include <math.h>
#define ACC 40.0
#define BIGNO 1.0e10
#define BIGNI 1.0e-10
float bessj(int n, float x)
{
float bessj0(float x);
float bessj1(float x);
void nrerror(char error_text[]);
int j,jsum,m;
float ax,bj,bjm,bjp,sum,tox,ans;
if (n < 2) nrerror("Index n less than 2 in bessj");
ax=fabs(x);
if (ax == 0.0)
return 0.0;
else if (ax > (float) n) {
tox=2.0/ax;
bjm=bessj0(ax);
bj=bessj1(ax);
for (j=1;j<n;j++) {
bjp=j*tox*bj-bjm;
bjm=bj;
bj=bjp;
}
ans=bj;
} else {
tox=2.0/ax;
m=2*((n+(int) sqrt(ACC*n))/2);
jsum=0;
bjp=ans=sum=0.0;
bj=1.0;
for (j=m;j>0;j--) {
bjm=j*tox*bj-bjp;
bjp=bj;
bj=bjm;
if (fabs(bj) > BIGNO) {
bj *= BIGNI;
bjp *= BIGNI;
ans *= BIGNI;
sum *= BIGNI;
}
if (jsum) sum += bj;
jsum=!jsum;
if (j == n) ans=bjp;
}
sum=2.0*sum-bj;
ans /= sum;
}
return x < 0.0 && (n & 1) ? -ans : ans;
}
#undef ACC
#undef BIGNO
#undef BIGNI

28
lib/nr/ansi/recipes/bessj0.c Normal file
View File

@@ -0,0 +1,28 @@
#include <math.h>
float bessj0(float x)
{
float ax,z;
double xx,y,ans,ans1,ans2;
if ((ax=fabs(x)) < 8.0) {
y=x*x;
ans1=57568490574.0+y*(-13362590354.0+y*(651619640.7
+y*(-11214424.18+y*(77392.33017+y*(-184.9052456)))));
ans2=57568490411.0+y*(1029532985.0+y*(9494680.718
+y*(59272.64853+y*(267.8532712+y*1.0))));
ans=ans1/ans2;
} else {
z=8.0/ax;
y=z*z;
xx=ax-0.785398164;
ans1=1.0+y*(-0.1098628627e-2+y*(0.2734510407e-4
+y*(-0.2073370639e-5+y*0.2093887211e-6)));
ans2 = -0.1562499995e-1+y*(0.1430488765e-3
+y*(-0.6911147651e-5+y*(0.7621095161e-6
-y*0.934945152e-7)));
ans=sqrt(0.636619772/ax)*(cos(xx)*ans1-z*sin(xx)*ans2);
}
return ans;
}

29
lib/nr/ansi/recipes/bessj1.c Normal file
View File

@@ -0,0 +1,29 @@
#include <math.h>
float bessj1(float x)
{
float ax,z;
double xx,y,ans,ans1,ans2;
if ((ax=fabs(x)) < 8.0) {
y=x*x;
ans1=x*(72362614232.0+y*(-7895059235.0+y*(242396853.1
+y*(-2972611.439+y*(15704.48260+y*(-30.16036606))))));
ans2=144725228442.0+y*(2300535178.0+y*(18583304.74
+y*(99447.43394+y*(376.9991397+y*1.0))));
ans=ans1/ans2;
} else {
z=8.0/ax;
y=z*z;
xx=ax-2.356194491;
ans1=1.0+y*(0.183105e-2+y*(-0.3516396496e-4
+y*(0.2457520174e-5+y*(-0.240337019e-6))));
ans2=0.04687499995+y*(-0.2002690873e-3
+y*(0.8449199096e-5+y*(-0.88228987e-6
+y*0.105787412e-6)));
ans=sqrt(0.636619772/ax)*(cos(xx)*ans1-z*sin(xx)*ans2);
if (x < 0.0) ans = -ans;
}
return ans;
}

156
lib/nr/ansi/recipes/bessjy.c Normal file
View File

@@ -0,0 +1,156 @@
#include <math.h>
#define NRANSI
#include "nrutil.h"
#define EPS 1.0e-10
#define FPMIN 1.0e-30
#define MAXIT 10000
#define XMIN 2.0
#define PI 3.141592653589793
void bessjy(float x, float xnu, float *rj, float *ry, float *rjp, float *ryp)
{
void beschb(double x, double *gam1, double *gam2, double *gampl,
double *gammi);
int i,isign,l,nl;
double a,b,br,bi,c,cr,ci,d,del,del1,den,di,dlr,dli,dr,e,f,fact,fact2,
fact3,ff,gam,gam1,gam2,gammi,gampl,h,p,pimu,pimu2,q,r,rjl,
rjl1,rjmu,rjp1,rjpl,rjtemp,ry1,rymu,rymup,rytemp,sum,sum1,
temp,w,x2,xi,xi2,xmu,xmu2;
if (x <= 0.0 || xnu < 0.0) nrerror("bad arguments in bessjy");
nl=(x < XMIN ? (int)(xnu+0.5) : IMAX(0,(int)(xnu-x+1.5)));
xmu=xnu-nl;
xmu2=xmu*xmu;
xi=1.0/x;
xi2=2.0*xi;
w=xi2/PI;
isign=1;
h=xnu*xi;
if (h < FPMIN) h=FPMIN;
b=xi2*xnu;
d=0.0;
c=h;
for (i=1;i<=MAXIT;i++) {
b += xi2;
d=b-d;
if (fabs(d) < FPMIN) d=FPMIN;
c=b-1.0/c;
if (fabs(c) < FPMIN) c=FPMIN;
d=1.0/d;
del=c*d;
h=del*h;
if (d < 0.0) isign = -isign;
if (fabs(del-1.0) < EPS) break;
}
if (i > MAXIT) nrerror("x too large in bessjy; try asymptotic expansion");
rjl=isign*FPMIN;
rjpl=h*rjl;
rjl1=rjl;
rjp1=rjpl;
fact=xnu*xi;
for (l=nl;l>=1;l--) {
rjtemp=fact*rjl+rjpl;
fact -= xi;
rjpl=fact*rjtemp-rjl;
rjl=rjtemp;
}
if (rjl == 0.0) rjl=EPS;
f=rjpl/rjl;
if (x < XMIN) {
x2=0.5*x;
pimu=PI*xmu;
fact = (fabs(pimu) < EPS ? 1.0 : pimu/sin(pimu));
d = -log(x2);
e=xmu*d;
fact2 = (fabs(e) < EPS ? 1.0 : sinh(e)/e);
beschb(xmu,&gam1,&gam2,&gampl,&gammi);
ff=2.0/PI*fact*(gam1*cosh(e)+gam2*fact2*d);
e=exp(e);
p=e/(gampl*PI);
q=1.0/(e*PI*gammi);
pimu2=0.5*pimu;
fact3 = (fabs(pimu2) < EPS ? 1.0 : sin(pimu2)/pimu2);
r=PI*pimu2*fact3*fact3;
c=1.0;
d = -x2*x2;
sum=ff+r*q;
sum1=p;
for (i=1;i<=MAXIT;i++) {
ff=(i*ff+p+q)/(i*i-xmu2);
c *= (d/i);
p /= (i-xmu);
q /= (i+xmu);
del=c*(ff+r*q);
sum += del;
del1=c*p-i*del;
sum1 += del1;
if (fabs(del) < (1.0+fabs(sum))*EPS) break;
}
if (i > MAXIT) nrerror("bessy series failed to converge");
rymu = -sum;
ry1 = -sum1*xi2;
rymup=xmu*xi*rymu-ry1;
rjmu=w/(rymup-f*rymu);
} else {
a=0.25-xmu2;
p = -0.5*xi;
q=1.0;
br=2.0*x;
bi=2.0;
fact=a*xi/(p*p+q*q);
cr=br+q*fact;
ci=bi+p*fact;
den=br*br+bi*bi;
dr=br/den;
di = -bi/den;
dlr=cr*dr-ci*di;
dli=cr*di+ci*dr;
temp=p*dlr-q*dli;
q=p*dli+q*dlr;
p=temp;
for (i=2;i<=MAXIT;i++) {
a += 2*(i-1);
bi += 2.0;
dr=a*dr+br;
di=a*di+bi;
if (fabs(dr)+fabs(di) < FPMIN) dr=FPMIN;
fact=a/(cr*cr+ci*ci);
cr=br+cr*fact;
ci=bi-ci*fact;
if (fabs(cr)+fabs(ci) < FPMIN) cr=FPMIN;
den=dr*dr+di*di;
dr /= den;
di /= -den;
dlr=cr*dr-ci*di;
dli=cr*di+ci*dr;
temp=p*dlr-q*dli;
q=p*dli+q*dlr;
p=temp;
if (fabs(dlr-1.0)+fabs(dli) < EPS) break;
}
if (i > MAXIT) nrerror("cf2 failed in bessjy");
gam=(p-f)/q;
rjmu=sqrt(w/((p-f)*gam+q));
rjmu=SIGN(rjmu,rjl);
rymu=rjmu*gam;
rymup=rymu*(p+q/gam);
ry1=xmu*xi*rymu-rymup;
}
fact=rjmu/rjl;
*rj=rjl1*fact;
*rjp=rjp1*fact;
for (i=1;i<=nl;i++) {
rytemp=(xmu+i)*xi2*ry1-rymu;
rymu=ry1;
ry1=rytemp;
}
*ry=rymu;
*ryp=xnu*xi*rymu-ry1;
}
#undef EPS
#undef FPMIN
#undef MAXIT
#undef XMIN
#undef PI
#undef NRANSI

20
lib/nr/ansi/recipes/bessk.c Normal file
View File

@@ -0,0 +1,20 @@
float bessk(int n, float x)
{
float bessk0(float x);
float bessk1(float x);
void nrerror(char error_text[]);
int j;
float bk,bkm,bkp,tox;
if (n < 2) nrerror("Index n less than 2 in bessk");
tox=2.0/x;
bkm=bessk0(x);
bk=bessk1(x);
for (j=1;j<n;j++) {
bkp=bkm+j*tox*bk;
bkm=bk;
bk=bkp;
}
return bk;
}

21
lib/nr/ansi/recipes/bessk0.c Normal file
View File

@@ -0,0 +1,21 @@
#include <math.h>
float bessk0(float x)
{
float bessi0(float x);
double y,ans;
if (x <= 2.0) {
y=x*x/4.0;
ans=(-log(x/2.0)*bessi0(x))+(-0.57721566+y*(0.42278420
+y*(0.23069756+y*(0.3488590e-1+y*(0.262698e-2
+y*(0.10750e-3+y*0.74e-5))))));
} else {
y=2.0/x;
ans=(exp(-x)/sqrt(x))*(1.25331414+y*(-0.7832358e-1
+y*(0.2189568e-1+y*(-0.1062446e-1+y*(0.587872e-2
+y*(-0.251540e-2+y*0.53208e-3))))));
}
return ans;
}

21
lib/nr/ansi/recipes/bessk1.c Normal file
View File

@@ -0,0 +1,21 @@
#include <math.h>
float bessk1(float x)
{
float bessi1(float x);
double y,ans;
if (x <= 2.0) {
y=x*x/4.0;
ans=(log(x/2.0)*bessi1(x))+(1.0/x)*(1.0+y*(0.15443144
+y*(-0.67278579+y*(-0.18156897+y*(-0.1919402e-1
+y*(-0.110404e-2+y*(-0.4686e-4)))))));
} else {
y=2.0/x;
ans=(exp(-x)/sqrt(x))*(1.25331414+y*(0.23498619
+y*(-0.3655620e-1+y*(0.1504268e-1+y*(-0.780353e-2
+y*(0.325614e-2+y*(-0.68245e-3)))))));
}
return ans;
}

20
lib/nr/ansi/recipes/bessy.c Normal file
View File

@@ -0,0 +1,20 @@
float bessy(int n, float x)
{
float bessy0(float x);
float bessy1(float x);
void nrerror(char error_text[]);
int j;
float by,bym,byp,tox;
if (n < 2) nrerror("Index n less than 2 in bessy");
tox=2.0/x;
by=bessy1(x);
bym=bessy0(x);
for (j=1;j<n;j++) {
byp=j*tox*by-bym;
bym=by;
by=byp;
}
return by;
}

29
lib/nr/ansi/recipes/bessy0.c Normal file
View File

@@ -0,0 +1,29 @@
#include <math.h>
float bessy0(float x)
{
float bessj0(float x);
float z;
double xx,y,ans,ans1,ans2;
if (x < 8.0) {
y=x*x;
ans1 = -2957821389.0+y*(7062834065.0+y*(-512359803.6
+y*(10879881.29+y*(-86327.92757+y*228.4622733))));
ans2=40076544269.0+y*(745249964.8+y*(7189466.438
+y*(47447.26470+y*(226.1030244+y*1.0))));
ans=(ans1/ans2)+0.636619772*bessj0(x)*log(x);
} else {
z=8.0/x;
y=z*z;
xx=x-0.785398164;
ans1=1.0+y*(-0.1098628627e-2+y*(0.2734510407e-4
+y*(-0.2073370639e-5+y*0.2093887211e-6)));
ans2 = -0.1562499995e-1+y*(0.1430488765e-3
+y*(-0.6911147651e-5+y*(0.7621095161e-6
+y*(-0.934945152e-7))));
ans=sqrt(0.636619772/x)*(sin(xx)*ans1+z*cos(xx)*ans2);
}
return ans;
}

31
lib/nr/ansi/recipes/bessy1.c Normal file
View File

@@ -0,0 +1,31 @@
#include <math.h>
float bessy1(float x)
{
float bessj1(float x);
float z;
double xx,y,ans,ans1,ans2;
if (x < 8.0) {
y=x*x;
ans1=x*(-0.4900604943e13+y*(0.1275274390e13
+y*(-0.5153438139e11+y*(0.7349264551e9
+y*(-0.4237922726e7+y*0.8511937935e4)))));
ans2=0.2499580570e14+y*(0.4244419664e12
+y*(0.3733650367e10+y*(0.2245904002e8
+y*(0.1020426050e6+y*(0.3549632885e3+y)))));
ans=(ans1/ans2)+0.636619772*(bessj1(x)*log(x)-1.0/x);
} else {
z=8.0/x;
y=z*z;
xx=x-2.356194491;
ans1=1.0+y*(0.183105e-2+y*(-0.3516396496e-4
+y*(0.2457520174e-5+y*(-0.240337019e-6))));
ans2=0.04687499995+y*(-0.2002690873e-3
+y*(0.8449199096e-5+y*(-0.88228987e-6
+y*0.105787412e-6)));
ans=sqrt(0.636619772/x)*(sin(xx)*ans1+z*cos(xx)*ans2);
}
return ans;
}

9
lib/nr/ansi/recipes/beta.c Normal file
View File

@@ -0,0 +1,9 @@
#include <math.h>
float beta(float z, float w)
{
float gammln(float xx);
return exp(gammln(z)+gammln(w)-gammln(z+w));
}

45
lib/nr/ansi/recipes/betacf.c Normal file
View File

@@ -0,0 +1,45 @@
#include <math.h>
#define MAXIT 100
#define EPS 3.0e-7
#define FPMIN 1.0e-30
float betacf(float a, float b, float x)
{
void nrerror(char error_text[]);
int m,m2;
float aa,c,d,del,h,qab,qam,qap;
qab=a+b;
qap=a+1.0;
qam=a-1.0;
c=1.0;
d=1.0-qab*x/qap;
if (fabs(d) < FPMIN) d=FPMIN;
d=1.0/d;
h=d;
for (m=1;m<=MAXIT;m++) {
m2=2*m;
aa=m*(b-m)*x/((qam+m2)*(a+m2));
d=1.0+aa*d;
if (fabs(d) < FPMIN) d=FPMIN;
c=1.0+aa/c;
if (fabs(c) < FPMIN) c=FPMIN;
d=1.0/d;
h *= d*c;
aa = -(a+m)*(qab+m)*x/((a+m2)*(qap+m2));
d=1.0+aa*d;
if (fabs(d) < FPMIN) d=FPMIN;
c=1.0+aa/c;
if (fabs(c) < FPMIN) c=FPMIN;
d=1.0/d;
del=d*c;
h *= del;
if (fabs(del-1.0) < EPS) break;
}
if (m > MAXIT) nrerror("a or b too big, or MAXIT too small in betacf");
return h;
}
#undef MAXIT
#undef EPS
#undef FPMIN

19
lib/nr/ansi/recipes/betai.c Normal file
View File

@@ -0,0 +1,19 @@
#include <math.h>
float betai(float a, float b, float x)
{
float betacf(float a, float b, float x);
float gammln(float xx);
void nrerror(char error_text[]);
float bt;
if (x < 0.0 || x > 1.0) nrerror("Bad x in routine betai");
if (x == 0.0 || x == 1.0) bt=0.0;
else
bt=exp(gammln(a+b)-gammln(a)-gammln(b)+a*log(x)+b*log(1.0-x));
if (x < (a+1.0)/(a+b+2.0))
return bt*betacf(a,b,x)/a;
else
return 1.0-bt*betacf(b,a,1.0-x)/b;
}

9
lib/nr/ansi/recipes/bico.c Normal file
View File

@@ -0,0 +1,9 @@
#include <math.h>
float bico(int n, int k)
{
float factln(int n);
return floor(0.5+exp(factln(n)-factln(k)-factln(n-k)));
}

23
lib/nr/ansi/recipes/bksub.c Normal file
View File

@@ -0,0 +1,23 @@
void bksub(int ne, int nb, int jf, int k1, int k2, float ***c)
{
int nbf,im,kp,k,j,i;
float xx;
nbf=ne-nb;
im=1;
for (k=k2;k>=k1;k--) {
if (k == k1) im=nbf+1;
kp=k+1;
for (j=1;j<=nbf;j++) {
xx=c[j][jf][kp];
for (i=im;i<=ne;i++)
c[i][jf][k] -= c[i][j][k]*xx;
}
}
for (k=k1;k<=k2;k++) {
kp=k+1;
for (i=1;i<=nb;i++) c[i][1][k]=c[i+nbf][jf][k];
for (i=1;i<=nbf;i++) c[i+nb][1][k]=c[i][jf][kp];
}
}

55
lib/nr/ansi/recipes/bnldev.c Normal file
View File

@@ -0,0 +1,55 @@
#include <math.h>
#define PI 3.141592654
float bnldev(float pp, int n, long *idum)
{
float gammln(float xx);
float ran1(long *idum);
int j;
static int nold=(-1);
float am,em,g,angle,p,bnl,sq,t,y;
static float pold=(-1.0),pc,plog,pclog,en,oldg;
p=(pp <= 0.5 ? pp : 1.0-pp);
am=n*p;
if (n < 25) {
bnl=0.0;
for (j=1;j<=n;j++)
if (ran1(idum) < p) ++bnl;
} else if (am < 1.0) {
g=exp(-am);
t=1.0;
for (j=0;j<=n;j++) {
t *= ran1(idum);
if (t < g) break;
}
bnl=(j <= n ? j : n);
} else {
if (n != nold) {
en=n;
oldg=gammln(en+1.0);
nold=n;
} if (p != pold) {
pc=1.0-p;
plog=log(p);
pclog=log(pc);
pold=p;
}
sq=sqrt(2.0*am*pc);
do {
do {
angle=PI*ran1(idum);
y=tan(angle);
em=sq*y+am;
} while (em < 0.0 || em >= (en+1.0));
em=floor(em);
t=1.2*sq*(1.0+y*y)*exp(oldg-gammln(em+1.0)
-gammln(en-em+1.0)+em*plog+(en-em)*pclog);
} while (ran1(idum) > t);
bnl=em;
}
if (p != pp) bnl=n-bnl;
return bnl;
}
#undef PI

75
lib/nr/ansi/recipes/brent.c Normal file
View File

@@ -0,0 +1,75 @@
#include <math.h>
#define NRANSI
#include "nrutil.h"
#define ITMAX 100
#define CGOLD 0.3819660
#define ZEPS 1.0e-10
#define SHFT(a,b,c,d) (a)=(b);(b)=(c);(c)=(d);
float brent(float ax, float bx, float cx, float (*f)(float), float tol,
float *xmin)
{
int iter;
float a,b,d,etemp,fu,fv,fw,fx,p,q,r,tol1,tol2,u,v,w,x,xm;
float e=0.0;
a=(ax < cx ? ax : cx);
b=(ax > cx ? ax : cx);
x=w=v=bx;
fw=fv=fx=(*f)(x);
for (iter=1;iter<=ITMAX;iter++) {
xm=0.5*(a+b);
tol2=2.0*(tol1=tol*fabs(x)+ZEPS);
if (fabs(x-xm) <= (tol2-0.5*(b-a))) {
*xmin=x;
return fx;
}
if (fabs(e) > tol1) {
r=(x-w)*(fx-fv);
q=(x-v)*(fx-fw);
p=(x-v)*q-(x-w)*r;
q=2.0*(q-r);
if (q > 0.0) p = -p;
q=fabs(q);
etemp=e;
e=d;
if (fabs(p) >= fabs(0.5*q*etemp) || p <= q*(a-x) || p >= q*(b-x))
d=CGOLD*(e=(x >= xm ? a-x : b-x));
else {
d=p/q;
u=x+d;
if (u-a < tol2 || b-u < tol2)
d=SIGN(tol1,xm-x);
}
} else {
d=CGOLD*(e=(x >= xm ? a-x : b-x));
}
u=(fabs(d) >= tol1 ? x+d : x+SIGN(tol1,d));
fu=(*f)(u);
if (fu <= fx) {
if (u >= x) a=x; else b=x;
SHFT(v,w,x,u)
SHFT(fv,fw,fx,fu)
} else {
if (u < x) a=u; else b=u;
if (fu <= fw || w == x) {
v=w;
w=u;
fv=fw;
fw=fu;
} else if (fu <= fv || v == x || v == w) {
v=u;
fv=fu;
}
}
}
nrerror("Too many iterations in brent");
*xmin=x;
return fx;
}
#undef ITMAX
#undef CGOLD
#undef ZEPS
#undef SHFT
#undef NRANSI

167
lib/nr/ansi/recipes/broydn.c Normal file
View File

@@ -0,0 +1,167 @@
#include <math.h>
#define NRANSI
#include "nrutil.h"
#define MAXITS 200
#define EPS 1.0e-7
#define TOLF 1.0e-4
#define TOLX EPS
#define STPMX 100.0
#define TOLMIN 1.0e-6
#define FREERETURN {free_vector(fvec,1,n);free_vector(xold,1,n);\
free_vector(w,1,n);free_vector(t,1,n);free_vector(s,1,n);\
free_matrix(r,1,n,1,n);free_matrix(qt,1,n,1,n);free_vector(p,1,n);\
free_vector(g,1,n);free_vector(fvcold,1,n);free_vector(d,1,n);\
free_vector(c,1,n);return;}
int nn;
float *fvec;
void (*nrfuncv)(int n, float v[], float f[]);
void broydn(float x[], int n, int *check,
void (*vecfunc)(int, float [], float []))
{
void fdjac(int n, float x[], float fvec[], float **df,
void (*vecfunc)(int, float [], float []));
float fmin(float x[]);
void lnsrch(int n, float xold[], float fold, float g[], float p[], float x[],
float *f, float stpmax, int *check, float (*func)(float []));
void qrdcmp(float **a, int n, float *c, float *d, int *sing);
void qrupdt(float **r, float **qt, int n, float u[], float v[]);
void rsolv(float **a, int n, float d[], float b[]);
int i,its,j,k,restrt,sing,skip;
float den,f,fold,stpmax,sum,temp,test,*c,*d,*fvcold;
float *g,*p,**qt,**r,*s,*t,*w,*xold;
c=vector(1,n);
d=vector(1,n);
fvcold=vector(1,n);
g=vector(1,n);
p=vector(1,n);
qt=matrix(1,n,1,n);
r=matrix(1,n,1,n);
s=vector(1,n);
t=vector(1,n);
w=vector(1,n);
xold=vector(1,n);
fvec=vector(1,n);
nn=n;
nrfuncv=vecfunc;
f=fmin(x);
test=0.0;
for (i=1;i<=n;i++)
if (fabs(fvec[i]) > test)test=fabs(fvec[i]);
if (test < 0.01*TOLF) {
*check=0;
FREERETURN
}
for (sum=0.0,i=1;i<=n;i++) sum += SQR(x[i]);
stpmax=STPMX*FMAX(sqrt(sum),(float)n);
restrt=1;
for (its=1;its<=MAXITS;its++) {
if (restrt) {
fdjac(n,x,fvec,r,vecfunc);
qrdcmp(r,n,c,d,&sing);
if (sing) nrerror("singular Jacobian in broydn");
for (i=1;i<=n;i++) {
for (j=1;j<=n;j++) qt[i][j]=0.0;
qt[i][i]=1.0;
}
for (k=1;k<n;k++) {
if (c[k]) {
for (j=1;j<=n;j++) {
sum=0.0;
for (i=k;i<=n;i++)
sum += r[i][k]*qt[i][j];
sum /= c[k];
for (i=k;i<=n;i++)
qt[i][j] -= sum*r[i][k];
}
}
}
for (i=1;i<=n;i++) {
r[i][i]=d[i];
for (j=1;j<i;j++) r[i][j]=0.0;
}
} else {
for (i=1;i<=n;i++) s[i]=x[i]-xold[i];
for (i=1;i<=n;i++) {
for (sum=0.0,j=i;j<=n;j++) sum += r[i][j]*s[j];
t[i]=sum;
}
skip=1;
for (i=1;i<=n;i++) {
for (sum=0.0,j=1;j<=n;j++) sum += qt[j][i]*t[j];
w[i]=fvec[i]-fvcold[i]-sum;
if (fabs(w[i]) >= EPS*(fabs(fvec[i])+fabs(fvcold[i]))) skip=0;
else w[i]=0.0;
}
if (!skip) {
for (i=1;i<=n;i++) {
for (sum=0.0,j=1;j<=n;j++) sum += qt[i][j]*w[j];
t[i]=sum;
}
for (den=0.0,i=1;i<=n;i++) den += SQR(s[i]);
for (i=1;i<=n;i++) s[i] /= den;
qrupdt(r,qt,n,t,s);
for (i=1;i<=n;i++) {
if (r[i][i] == 0.0) nrerror("r singular in broydn");
d[i]=r[i][i];
}
}
}
for (i=1;i<=n;i++) {
for (sum=0.0,j=1;j<=n;j++) sum += qt[i][j]*fvec[j];
p[i] = -sum;
}
for (i=n;i>=1;i--) {
for (sum=0.0,j=1;j<=i;j++) sum -= r[j][i]*p[j];
g[i]=sum;
}
for (i=1;i<=n;i++) {
xold[i]=x[i];
fvcold[i]=fvec[i];
}
fold=f;
rsolv(r,n,d,p);
lnsrch(n,xold,fold,g,p,x,&f,stpmax,check,fmin);
test=0.0;
for (i=1;i<=n;i++)
if (fabs(fvec[i]) > test) test=fabs(fvec[i]);
if (test < TOLF) {
*check=0;
FREERETURN
}
if (*check) {
if (restrt) FREERETURN
else {
test=0.0;
den=FMAX(f,0.5*n);
for (i=1;i<=n;i++) {
temp=fabs(g[i])*FMAX(fabs(x[i]),1.0)/den;
if (temp > test) test=temp;
}
if (test < TOLMIN) FREERETURN
else restrt=1;
}
} else {
restrt=0;
test=0.0;
for (i=1;i<=n;i++) {
temp=(fabs(x[i]-xold[i]))/FMAX(fabs(x[i]),1.0);
if (temp > test) test=temp;
}
if (test < TOLX) FREERETURN
}
}
nrerror("MAXITS exceeded in broydn");
FREERETURN
}
#undef MAXITS
#undef EPS
#undef TOLF
#undef TOLMIN
#undef TOLX
#undef STPMX
#undef FREERETURN
#undef NRANSI

141
lib/nr/ansi/recipes/bsstep.c Normal file
View File

@@ -0,0 +1,141 @@
#include <math.h>
#define NRANSI
#include "nrutil.h"
#define KMAXX 8
#define IMAXX (KMAXX+1)
#define SAFE1 0.25
#define SAFE2 0.7
#define REDMAX 1.0e-5
#define REDMIN 0.7
#define TINY 1.0e-30
#define SCALMX 0.1
float **d,*x;
void bsstep(float y[], float dydx[], int nv, float *xx, float htry, float eps,
float yscal[], float *hdid, float *hnext,
void (*derivs)(float, float [], float []))
{
void mmid(float y[], float dydx[], int nvar, float xs, float htot,
int nstep, float yout[], void (*derivs)(float, float[], float[]));
void pzextr(int iest, float xest, float yest[], float yz[], float dy[],
int nv);
int i,iq,k,kk,km;
static int first=1,kmax,kopt;
static float epsold = -1.0,xnew;
float eps1,errmax,fact,h,red,scale,work,wrkmin,xest;
float *err,*yerr,*ysav,*yseq;
static float a[IMAXX+1];
static float alf[KMAXX+1][KMAXX+1];
static int nseq[IMAXX+1]={0,2,4,6,8,10,12,14,16,18};
int reduct,exitflag=0;
d=matrix(1,nv,1,KMAXX);
err=vector(1,KMAXX);
x=vector(1,KMAXX);
yerr=vector(1,nv);
ysav=vector(1,nv);
yseq=vector(1,nv);
if (eps != epsold) {
*hnext = xnew = -1.0e29;
eps1=SAFE1*eps;
a[1]=nseq[1]+1;
for (k=1;k<=KMAXX;k++) a[k+1]=a[k]+nseq[k+1];
for (iq=2;iq<=KMAXX;iq++) {
for (k=1;k<iq;k++)
alf[k][iq]=pow(eps1,(a[k+1]-a[iq+1])/
((a[iq+1]-a[1]+1.0)*(2*k+1)));
}
epsold=eps;
for (kopt=2;kopt<KMAXX;kopt++)
if (a[kopt+1] > a[kopt]*alf[kopt-1][kopt]) break;
kmax=kopt;
}
h=htry;
for (i=1;i<=nv;i++) ysav[i]=y[i];
if (*xx != xnew || h != (*hnext)) {
first=1;
kopt=kmax;
}
reduct=0;
for (;;) {
for (k=1;k<=kmax;k++) {
xnew=(*xx)+h;
if (xnew == (*xx)) nrerror("step size underflow in bsstep");
mmid(ysav,dydx,nv,*xx,h,nseq[k],yseq,derivs);
xest=SQR(h/nseq[k]);
pzextr(k,xest,yseq,y,yerr,nv);
if (k != 1) {
errmax=TINY;
for (i=1;i<=nv;i++) errmax=FMAX(errmax,fabs(yerr[i]/yscal[i]));
errmax /= eps;
km=k-1;
err[km]=pow(errmax/SAFE1,1.0/(2*km+1));
}
if (k != 1 && (k >= kopt-1 || first)) {
if (errmax < 1.0) {
exitflag=1;
break;
}
if (k == kmax || k == kopt+1) {
red=SAFE2/err[km];
break;
}
else if (k == kopt && alf[kopt-1][kopt] < err[km]) {
red=1.0/err[km];
break;
}
else if (kopt == kmax && alf[km][kmax-1] < err[km]) {
red=alf[km][kmax-1]*SAFE2/err[km];
break;
}
else if (alf[km][kopt] < err[km]) {
red=alf[km][kopt-1]/err[km];
break;
}
}
}
if (exitflag) break;
red=FMIN(red,REDMIN);
red=FMAX(red,REDMAX);
h *= red;
reduct=1;
}
*xx=xnew;
*hdid=h;
first=0;
wrkmin=1.0e35;
for (kk=1;kk<=km;kk++) {
fact=FMAX(err[kk],SCALMX);
work=fact*a[kk+1];
if (work < wrkmin) {
scale=fact;
wrkmin=work;
kopt=kk+1;
}
}
*hnext=h/scale;
if (kopt >= k && kopt != kmax && !reduct) {
fact=FMAX(scale/alf[kopt-1][kopt],SCALMX);
if (a[kopt+1]*fact <= wrkmin) {
*hnext=h/fact;
kopt++;
}
}
free_vector(yseq,1,nv);
free_vector(ysav,1,nv);
free_vector(yerr,1,nv);
free_vector(x,1,KMAXX);
free_vector(err,1,KMAXX);
free_matrix(d,1,nv,1,KMAXX);
}
#undef KMAXX
#undef IMAXX
#undef SAFE1
#undef SAFE2
#undef REDMAX
#undef REDMIN
#undef TINY
#undef SCALMX
#undef NRANSI

28
lib/nr/ansi/recipes/caldat.c Normal file
View File

@@ -0,0 +1,28 @@
#include <math.h>
#define IGREG 2299161
void caldat(long julian, int *mm, int *id, int *iyyy)
{
long ja,jalpha,jb,jc,jd,je;
if (julian >= IGREG) {
jalpha=(long)(((double) (julian-1867216)-0.25)/36524.25);
ja=julian+1+jalpha-(long) (0.25*jalpha);
} else if (julian < 0) {
ja=julian+36525*(1-julian/36525);
} else
ja=julian;
jb=ja+1524;
jc=(long)(6680.0+((double) (jb-2439870)-122.1)/365.25);
jd=(long)(365*jc+(0.25*jc));
je=(long)((jb-jd)/30.6001);
*id=jb-jd-(long) (30.6001*je);
*mm=je-1;
if (*mm > 12) *mm -= 12;
*iyyy=jc-4715;
if (*mm > 2) --(*iyyy);
if (*iyyy <= 0) --(*iyyy);
if (julian < 0) *iyyy -= 100*(1-julian/36525);
}
#undef IGREG

14
lib/nr/ansi/recipes/chder.c Normal file
View File

@@ -0,0 +1,14 @@
void chder(float a, float b, float c[], float cder[], int n)
{
int j;
float con;
cder[n-1]=0.0;
cder[n-2]=2*(n-1)*c[n-1];
for (j=n-3;j>=0;j--)
cder[j]=cder[j+2]+2*(j+1)*c[j+1];
con=2.0/(b-a);
for (j=0;j<n;j++)
cder[j] *= con;
}

16
lib/nr/ansi/recipes/chebev.c Normal file
View File

@@ -0,0 +1,16 @@
float chebev(float a, float b, float c[], int m, float x)
{
void nrerror(char error_text[]);
float d=0.0,dd=0.0,sv,y,y2;
int j;
if ((x-a)*(x-b) > 0.0) nrerror("x not in range in routine chebev");
y2=2.0*(y=(2.0*x-a-b)/(b-a));
for (j=m-1;j>=1;j--) {
sv=d;
d=y2*d-dd+c[j];
dd=sv;
}
return y*d-dd+0.5*c[0];
}

29
lib/nr/ansi/recipes/chebft.c Normal file
View File

@@ -0,0 +1,29 @@
#include <math.h>
#define NRANSI
#include "nrutil.h"
#define PI 3.141592653589793
void chebft(float a, float b, float c[], int n, float (*func)(float))
{
int k,j;
float fac,bpa,bma,*f;
f=vector(0,n-1);
bma=0.5*(b-a);
bpa=0.5*(b+a);
for (k=0;k<n;k++) {
float y=cos(PI*(k+0.5)/n);
f[k]=(*func)(y*bma+bpa);
}
fac=2.0/n;
for (j=0;j<n;j++) {
double sum=0.0;
for (k=0;k<n;k++)
sum += f[k]*cos(PI*j*(k+0.5)/n);
c[j]=fac*sum;
}
free_vector(f,0,n-1);
}
#undef PI
#undef NRANSI

28
lib/nr/ansi/recipes/chebpc.c Normal file
View File

@@ -0,0 +1,28 @@
#define NRANSI
#include "nrutil.h"
void chebpc(float c[], float d[], int n)
{
int k,j;
float sv,*dd;
dd=vector(0,n-1);
for (j=0;j<n;j++) d[j]=dd[j]=0.0;
d[0]=c[n-1];
for (j=n-2;j>=1;j--) {
for (k=n-j;k>=1;k--) {
sv=d[k];
d[k]=2.0*d[k-1]-dd[k];
dd[k]=sv;
}
sv=d[0];
d[0] = -dd[0]+c[j];
dd[0]=sv;
}
for (j=n-1;j>=1;j--)
d[j]=d[j-1]-dd[j];
d[0] = -dd[0]+0.5*c[0];
free_vector(dd,0,n-1);
}
#undef NRANSI

16
lib/nr/ansi/recipes/chint.c Normal file
View File

@@ -0,0 +1,16 @@
void chint(float a, float b, float c[], float cint[], int n)
{
int j;
float sum=0.0,fac=1.0,con;
con=0.25*(b-a);
for (j=1;j<=n-2;j++) {
cint[j]=con*(c[j-1]-c[j+1])/j;
sum += fac*cint[j];
fac = -fac;
}
cint[n-1]=con*c[n-2]/(n-1);
sum += fac*cint[n-1];
cint[0]=2.0*sum;
}

30
lib/nr/ansi/recipes/chixy.c Normal file
View File

@@ -0,0 +1,30 @@
#include <math.h>
#define NRANSI
#include "nrutil.h"
#define BIG 1.0e30
extern int nn;
extern float *xx,*yy,*sx,*sy,*ww,aa,offs;
float chixy(float bang)
{
int j;
float ans,avex=0.0,avey=0.0,sumw=0.0,b;
b=tan(bang);
for (j=1;j<=nn;j++) {
ww[j] = SQR(b*sx[j])+SQR(sy[j]);
sumw += (ww[j] = (ww[j] < 1.0/BIG ? BIG : 1.0/ww[j]));
avex += ww[j]*xx[j];
avey += ww[j]*yy[j];
}
avex /= sumw;
avey /= sumw;
aa=avey-b*avex;
for (ans = -offs,j=1;j<=nn;j++)
ans += ww[j]*SQR(yy[j]-aa-b*xx[j]);
return ans;
}
#undef BIG
#undef NRANSI

20
lib/nr/ansi/recipes/choldc.c Normal file
View File

@@ -0,0 +1,20 @@
#include <math.h>
void choldc(float **a, int n, float p[])
{
void nrerror(char error_text[]);
int i,j,k;
float sum;
for (i=1;i<=n;i++) {
for (j=i;j<=n;j++) {
for (sum=a[i][j],k=i-1;k>=1;k--) sum -= a[i][k]*a[j][k];
if (i == j) {
if (sum <= 0.0)
nrerror("choldc failed");
p[i]=sqrt(sum);
} else a[j][i]=sum/p[i];
}
}
}

15
lib/nr/ansi/recipes/cholsl.c Normal file
View File

@@ -0,0 +1,15 @@
void cholsl(float **a, int n, float p[], float b[], float x[])
{
int i,k;
float sum;
for (i=1;i<=n;i++) {
for (sum=b[i],k=i-1;k>=1;k--) sum -= a[i][k]*x[k];
x[i]=sum/p[i];
}
for (i=n;i>=1;i--) {
for (sum=x[i],k=i+1;k<=n;k++) sum -= a[k][i]*x[k];
x[i]=sum/p[i];
}
}

18
lib/nr/ansi/recipes/chsone.c Normal file
View File

@@ -0,0 +1,18 @@
void chsone(float bins[], float ebins[], int nbins, int knstrn, float *df,
float *chsq, float *prob)
{
float gammq(float a, float x);
void nrerror(char error_text[]);
int j;
float temp;
*df=nbins-knstrn;
*chsq=0.0;
for (j=1;j<=nbins;j++) {
if (ebins[j] <= 0.0) nrerror("Bad expected number in chsone");
temp=bins[j]-ebins[j];
*chsq += temp*temp/ebins[j];
}
*prob=gammq(0.5*(*df),0.5*(*chsq));
}

19
lib/nr/ansi/recipes/chstwo.c Normal file
View File

@@ -0,0 +1,19 @@
void chstwo(float bins1[], float bins2[], int nbins, int knstrn, float *df,
float *chsq, float *prob)
{
float gammq(float a, float x);
int j;
float temp;
*df=nbins-knstrn;
*chsq=0.0;
for (j=1;j<=nbins;j++)
if (bins1[j] == 0.0 && bins2[j] == 0.0)
--(*df);
else {
temp=bins1[j]-bins2[j];
*chsq += temp*temp/(bins1[j]+bins2[j]);
}
*prob=gammq(0.5*(*df),0.5*(*chsq));
}

81
lib/nr/ansi/recipes/cisi.c Normal file
View File

@@ -0,0 +1,81 @@
#include <math.h>
#include "complex.h"
#define EPS 6.0e-8
#define EULER 0.57721566
#define MAXIT 100
#define PIBY2 1.5707963
#define FPMIN 1.0e-30
#define TMIN 2.0
#define TRUE 1
#define ONE Complex(1.0,0.0)
void cisi(float x, float *ci, float *si)
{
void nrerror(char error_text[]);
int i,k,odd;
float a,err,fact,sign,sum,sumc,sums,t,term;
fcomplex h,b,c,d,del;
t=fabs(x);
if (t == 0.0) {
*si=0.0;
*ci = -1.0/FPMIN;
return;
}
if (t > TMIN) {
b=Complex(1.0,t);
c=Complex(1.0/FPMIN,0.0);
d=h=Cdiv(ONE,b);
for (i=2;i<=MAXIT;i++) {
a = -(i-1)*(i-1);
b=Cadd(b,Complex(2.0,0.0));
d=Cdiv(ONE,Cadd(RCmul(a,d),b));
c=Cadd(b,Cdiv(Complex(a,0.0),c));
del=Cmul(c,d);
h=Cmul(h,del);
if (fabs(del.r-1.0)+fabs(del.i) < EPS) break;
}
if (i > MAXIT) nrerror("cf failed in cisi");
h=Cmul(Complex(cos(t),-sin(t)),h);
*ci = -h.r;
*si=PIBY2+h.i;
} else {
if (t < sqrt(FPMIN)) {
sumc=0.0;
sums=t;
} else {
sum=sums=sumc=0.0;
sign=fact=1.0;
odd=TRUE;
for (k=1;k<=MAXIT;k++) {
fact *= t/k;
term=fact/k;
sum += sign*term;
err=term/fabs(sum);
if (odd) {
sign = -sign;
sums=sum;
sum=sumc;
} else {
sumc=sum;
sum=sums;
}
if (err < EPS) break;
odd=!odd;
}
if (k > MAXIT) nrerror("maxits exceeded in cisi");
}
*si=sums;
*ci=sumc+log(t)+EULER;
}
if (x < 0.0) *si = -(*si);
}
#undef EPS
#undef EULER
#undef MAXIT
#undef PIBY2
#undef FPMIN
#undef TMIN
#undef TRUE
#undef ONE

48
lib/nr/ansi/recipes/cntab1.c Normal file
View File

@@ -0,0 +1,48 @@
#include <math.h>
#define NRANSI
#include "nrutil.h"
#define TINY 1.0e-30
void cntab1(int **nn, int ni, int nj, float *chisq, float *df, float *prob,
float *cramrv, float *ccc)
{
float gammq(float a, float x);
int nnj,nni,j,i,minij;
float sum=0.0,expctd,*sumi,*sumj,temp;
sumi=vector(1,ni);
sumj=vector(1,nj);
nni=ni;
nnj=nj;
for (i=1;i<=ni;i++) {
sumi[i]=0.0;
for (j=1;j<=nj;j++) {
sumi[i] += nn[i][j];
sum += nn[i][j];
}
if (sumi[i] == 0.0) --nni;
}
for (j=1;j<=nj;j++) {
sumj[j]=0.0;
for (i=1;i<=ni;i++) sumj[j] += nn[i][j];
if (sumj[j] == 0.0) --nnj;
}
*df=nni*nnj-nni-nnj+1;
*chisq=0.0;
for (i=1;i<=ni;i++) {
for (j=1;j<=nj;j++) {
expctd=sumj[j]*sumi[i]/sum;
temp=nn[i][j]-expctd;
*chisq += temp*temp/(expctd+TINY);
}
}
*prob=gammq(0.5*(*df),0.5*(*chisq));
minij = nni < nnj ? nni-1 : nnj-1;
*cramrv=sqrt(*chisq/(sum*minij));
*ccc=sqrt(*chisq/(*chisq+sum));
free_vector(sumj,1,nj);
free_vector(sumi,1,ni);
}
#undef TINY
#undef NRANSI

55
lib/nr/ansi/recipes/cntab2.c Normal file
View File

@@ -0,0 +1,55 @@
#include <math.h>
#define NRANSI
#include "nrutil.h"
#define TINY 1.0e-30
void cntab2(int **nn, int ni, int nj, float *h, float *hx, float *hy,
float *hygx, float *hxgy, float *uygx, float *uxgy, float *uxy)
{
int i,j;
float sum=0.0,p,*sumi,*sumj;
sumi=vector(1,ni);
sumj=vector(1,nj);
for (i=1;i<=ni;i++) {
sumi[i]=0.0;
for (j=1;j<=nj;j++) {
sumi[i] += nn[i][j];
sum += nn[i][j];
}
}
for (j=1;j<=nj;j++) {
sumj[j]=0.0;
for (i=1;i<=ni;i++)
sumj[j] += nn[i][j];
}
*hx=0.0;
for (i=1;i<=ni;i++)
if (sumi[i]) {
p=sumi[i]/sum;
*hx -= p*log(p);
}
*hy=0.0;
for (j=1;j<=nj;j++)
if (sumj[j]) {
p=sumj[j]/sum;
*hy -= p*log(p);
}
*h=0.0;
for (i=1;i<=ni;i++)
for (j=1;j<=nj;j++)
if (nn[i][j]) {
p=nn[i][j]/sum;
*h -= p*log(p);
}
*hygx=(*h)-(*hx);
*hxgy=(*h)-(*hy);
*uygx=(*hy-*hygx)/(*hy+TINY);
*uxgy=(*hx-*hxgy)/(*hx+TINY);
*uxy=2.0*(*hx+*hy-*h)/(*hx+*hy+TINY);
free_vector(sumj,1,nj);
free_vector(sumi,1,ni);
}
#undef TINY
#undef NRANSI

125
lib/nr/ansi/recipes/complex.c Normal file
View File

@@ -0,0 +1,125 @@
/* CAUTION: This is the ANSI C (only) version of the Numerical Recipes
utility file complex.c. Do not confuse this file with the same-named
file complex.c that is supplied in the same subdirectory or archive
as the header file complex.h. *That* file contains both ANSI and
traditional K&R versions, along with #ifdef macros to select the
correct version. *This* file contains only ANSI C. */
#include <math.h>
typedef struct FCOMPLEX {float r,i;} fcomplex;
fcomplex Cadd(fcomplex a, fcomplex b)
{
fcomplex c;
c.r=a.r+b.r;
c.i=a.i+b.i;
return c;
}
fcomplex Csub(fcomplex a, fcomplex b)
{
fcomplex c;
c.r=a.r-b.r;
c.i=a.i-b.i;
return c;
}
fcomplex Cmul(fcomplex a, fcomplex b)
{
fcomplex c;
c.r=a.r*b.r-a.i*b.i;
c.i=a.i*b.r+a.r*b.i;
return c;
}
fcomplex Complex(float re, float im)
{
fcomplex c;
c.r=re;
c.i=im;
return c;
}
fcomplex Conjg(fcomplex z)
{
fcomplex c;
c.r=z.r;
c.i = -z.i;
return c;
}
fcomplex Cdiv(fcomplex a, fcomplex b)
{
fcomplex c;
float r,den;
if (fabs(b.r) >= fabs(b.i)) {
r=b.i/b.r;
den=b.r+r*b.i;
c.r=(a.r+r*a.i)/den;
c.i=(a.i-r*a.r)/den;
} else {
r=b.r/b.i;
den=b.i+r*b.r;
c.r=(a.r*r+a.i)/den;
c.i=(a.i*r-a.r)/den;
}
return c;
}
float Cabs(fcomplex z)
{
float x,y,ans,temp;
x=fabs(z.r);
y=fabs(z.i);
if (x == 0.0)
ans=y;
else if (y == 0.0)
ans=x;
else if (x > y) {
temp=y/x;
ans=x*sqrt(1.0+temp*temp);
} else {
temp=x/y;
ans=y*sqrt(1.0+temp*temp);
}
return ans;
}
fcomplex Csqrt(fcomplex z)
{
fcomplex c;
float x,y,w,r;
if ((z.r == 0.0) && (z.i == 0.0)) {
c.r=0.0;
c.i=0.0;
return c;
} else {
x=fabs(z.r);
y=fabs(z.i);
if (x >= y) {
r=y/x;
w=sqrt(x)*sqrt(0.5*(1.0+sqrt(1.0+r*r)));
} else {
r=x/y;
w=sqrt(y)*sqrt(0.5*(r+sqrt(1.0+r*r)));
}
if (z.r >= 0.0) {
c.r=w;
c.i=z.i/(2.0*w);
} else {
c.i=(z.i >= 0) ? w : -w;
c.r=z.i/(2.0*c.i);
}
return c;
}
}
fcomplex RCmul(float x, fcomplex a)
{
fcomplex c;
c.r=x*a.r;
c.i=x*a.i;
return c;
}

36
lib/nr/ansi/recipes/convlv.c Normal file
View File

@@ -0,0 +1,36 @@
#define NRANSI
#include "nrutil.h"
void convlv(float data[], unsigned long n, float respns[], unsigned long m,
int isign, float ans[])
{
void realft(float data[], unsigned long n, int isign);
void twofft(float data1[], float data2[], float fft1[], float fft2[],
unsigned long n);
unsigned long i,no2;
float dum,mag2,*fft;
fft=vector(1,n<<1);
for (i=1;i<=(m-1)/2;i++)
respns[n+1-i]=respns[m+1-i];
for (i=(m+3)/2;i<=n-(m-1)/2;i++)
respns[i]=0.0;
twofft(data,respns,fft,ans,n);
no2=n>>1;
for (i=2;i<=n+2;i+=2) {
if (isign == 1) {
ans[i-1]=(fft[i-1]*(dum=ans[i-1])-fft[i]*ans[i])/no2;
ans[i]=(fft[i]*dum+fft[i-1]*ans[i])/no2;
} else if (isign == -1) {
if ((mag2=SQR(ans[i-1])+SQR(ans[i])) == 0.0)
nrerror("Deconvolving at response zero in convlv");
ans[i-1]=(fft[i-1]*(dum=ans[i-1])+fft[i]*ans[i])/mag2/no2;
ans[i]=(fft[i]*dum-fft[i-1]*ans[i])/mag2/no2;
} else nrerror("No meaning for isign in convlv");
}
ans[2]=ans[n+1];
realft(ans,n,-1);
free_vector(fft,1,n<<1);
}
#undef NRANSI

9
lib/nr/ansi/recipes/copy.c Normal file
View File

@@ -0,0 +1,9 @@
void copy(double **aout, double **ain, int n)
{
int i,j;
for (i=1;i<=n;i++)
for (j=1;j<=n;j++)
aout[j][i]=ain[j][i];
}

24
lib/nr/ansi/recipes/correl.c Normal file
View File

@@ -0,0 +1,24 @@
#define NRANSI
#include "nrutil.h"
void correl(float data1[], float data2[], unsigned long n, float ans[])
{
void realft(float data[], unsigned long n, int isign);
void twofft(float data1[], float data2[], float fft1[], float fft2[],
unsigned long n);
unsigned long no2,i;
float dum,*fft;
fft=vector(1,n<<1);
twofft(data1,data2,fft,ans,n);
no2=n>>1;
for (i=2;i<=n+2;i+=2) {
ans[i-1]=(fft[i-1]*(dum=ans[i-1])+fft[i]*ans[i])/no2;
ans[i]=(fft[i]*dum-fft[i-1]*ans[i])/no2;
}
ans[2]=ans[n+1];
realft(ans,n,-1);
free_vector(fft,1,n<<1);
}
#undef NRANSI

36
lib/nr/ansi/recipes/cosft1.c Normal file
View File

@@ -0,0 +1,36 @@
#include <math.h>
#define PI 3.141592653589793
void cosft1(float y[], int n)
{
void realft(float data[], unsigned long n, int isign);
int j,n2;
float sum,y1,y2;
double theta,wi=0.0,wpi,wpr,wr=1.0,wtemp;
theta=PI/n;
wtemp=sin(0.5*theta);
wpr = -2.0*wtemp*wtemp;
wpi=sin(theta);
sum=0.5*(y[1]-y[n+1]);
y[1]=0.5*(y[1]+y[n+1]);
n2=n+2;
for (j=2;j<=(n>>1);j++) {
wr=(wtemp=wr)*wpr-wi*wpi+wr;
wi=wi*wpr+wtemp*wpi+wi;
y1=0.5*(y[j]+y[n2-j]);
y2=(y[j]-y[n2-j]);
y[j]=y1-wi*y2;
y[n2-j]=y1+wi*y2;
sum += wr*y2;
}
realft(y,n,1);
y[n+1]=y[2];
y[2]=sum;
for (j=4;j<=n;j+=2) {
sum += y[j];
y[j]=sum;
}
}
#undef PI

64
lib/nr/ansi/recipes/cosft2.c Normal file
View File

@@ -0,0 +1,64 @@
#include <math.h>
#define PI 3.141592653589793
void cosft2(float y[], int n, int isign)
{
void realft(float data[], unsigned long n, int isign);
int i;
float sum,sum1,y1,y2,ytemp;
double theta,wi=0.0,wi1,wpi,wpr,wr=1.0,wr1,wtemp;
theta=0.5*PI/n;
wr1=cos(theta);
wi1=sin(theta);
wpr = -2.0*wi1*wi1;
wpi=sin(2.0*theta);
if (isign == 1) {
for (i=1;i<=n/2;i++) {
y1=0.5*(y[i]+y[n-i+1]);
y2=wi1*(y[i]-y[n-i+1]);
y[i]=y1+y2;
y[n-i+1]=y1-y2;
wr1=(wtemp=wr1)*wpr-wi1*wpi+wr1;
wi1=wi1*wpr+wtemp*wpi+wi1;
}
realft(y,n,1);
for (i=3;i<=n;i+=2) {
wr=(wtemp=wr)*wpr-wi*wpi+wr;
wi=wi*wpr+wtemp*wpi+wi;
y1=y[i]*wr-y[i+1]*wi;
y2=y[i+1]*wr+y[i]*wi;
y[i]=y1;
y[i+1]=y2;
}
sum=0.5*y[2];
for (i=n;i>=2;i-=2) {
sum1=sum;
sum += y[i];
y[i]=sum1;
}
} else if (isign == -1) {
ytemp=y[n];
for (i=n;i>=4;i-=2) y[i]=y[i-2]-y[i];
y[2]=2.0*ytemp;
for (i=3;i<=n;i+=2) {
wr=(wtemp=wr)*wpr-wi*wpi+wr;
wi=wi*wpr+wtemp*wpi+wi;
y1=y[i]*wr+y[i+1]*wi;
y2=y[i+1]*wr-y[i]*wi;
y[i]=y1;
y[i+1]=y2;
}
realft(y,n,-1);
for (i=1;i<=n/2;i++) {
y1=y[i]+y[n-i+1];
y2=(0.5/wi1)*(y[i]-y[n-i+1]);
y[i]=0.5*(y1+y2);
y[n-i+1]=0.5*(y1-y2);
wr1=(wtemp=wr1)*wpr-wi1*wpi+wr1;
wi1=wi1*wpr+wtemp*wpi+wi1;
}
}
}
#undef PI

20
lib/nr/ansi/recipes/covsrt.c Normal file
View File

@@ -0,0 +1,20 @@
#define SWAP(a,b) {swap=(a);(a)=(b);(b)=swap;}
void covsrt(float **covar, int ma, int ia[], int mfit)
{
int i,j,k;
float swap;
for (i=mfit+1;i<=ma;i++)
for (j=1;j<=i;j++) covar[i][j]=covar[j][i]=0.0;
k=mfit;
for (j=ma;j>=1;j--) {
if (ia[j]) {
for (i=1;i<=ma;i++) SWAP(covar[i][k],covar[i][j])
for (i=1;i<=ma;i++) SWAP(covar[k][i],covar[j][i])
k--;
}
}
}
#undef SWAP

22
lib/nr/ansi/recipes/crank.c Normal file
View File

@@ -0,0 +1,22 @@
void crank(unsigned long n, float w[], float *s)
{
unsigned long j=1,ji,jt;
float t,rank;
*s=0.0;
while (j < n) {
if (w[j+1] != w[j]) {
w[j]=j;
++j;
} else {
for (jt=j+1;jt<=n && w[jt]==w[j];jt++);
rank=0.5*(j+jt-1);
for (ji=j;ji<=(jt-1);ji++) w[ji]=rank;
t=jt-j;
*s += t*t*t-t;
j=jt;
}
}
if (j == n) w[n]=n;
}

33
lib/nr/ansi/recipes/cyclic.c Normal file
View File

@@ -0,0 +1,33 @@
#define NRANSI
#include "nrutil.h"
void cyclic(float a[], float b[], float c[], float alpha, float beta,
float r[], float x[], unsigned long n)
{
void tridag(float a[], float b[], float c[], float r[], float u[],
unsigned long n);
unsigned long i;
float fact,gamma,*bb,*u,*z;
if (n <= 2) nrerror("n too small in cyclic");
bb=vector(1,n);
u=vector(1,n);
z=vector(1,n);
gamma = -b[1];
bb[1]=b[1]-gamma;
bb[n]=b[n]-alpha*beta/gamma;
for (i=2;i<n;i++) bb[i]=b[i];
tridag(a,bb,c,r,x,n);
u[1]=gamma;
u[n]=alpha;
for (i=2;i<n;i++) u[i]=0.0;
tridag(a,bb,c,u,z,n);
fact=(x[1]+beta*x[n]/gamma)/
(1.0+z[1]+beta*z[n]/gamma);
for (i=1;i<=n;i++) x[i] -= fact*z[i];
free_vector(z,1,n);
free_vector(u,1,n);
free_vector(bb,1,n);
}
#undef NRANSI

39
lib/nr/ansi/recipes/daub4.c Normal file
View File

@@ -0,0 +1,39 @@
#define NRANSI
#include "nrutil.h"
#define C0 0.4829629131445341
#define C1 0.8365163037378079
#define C2 0.2241438680420134
#define C3 -0.1294095225512604
void daub4(float a[], unsigned long n, int isign)
{
float *wksp;
unsigned long nh,nh1,i,j;
if (n < 4) return;
wksp=vector(1,n);
nh1=(nh=n >> 1)+1;
if (isign >= 0) {
for (i=1,j=1;j<=n-3;j+=2,i++) {
wksp[i]=C0*a[j]+C1*a[j+1]+C2*a[j+2]+C3*a[j+3];
wksp[i+nh] = C3*a[j]-C2*a[j+1]+C1*a[j+2]-C0*a[j+3];
}
wksp[i]=C0*a[n-1]+C1*a[n]+C2*a[1]+C3*a[2];
wksp[i+nh] = C3*a[n-1]-C2*a[n]+C1*a[1]-C0*a[2];
} else {
wksp[1]=C2*a[nh]+C1*a[n]+C0*a[1]+C3*a[nh1];
wksp[2] = C3*a[nh]-C0*a[n]+C1*a[1]-C2*a[nh1];
for (i=1,j=3;i<nh;i++) {
wksp[j++]=C2*a[i]+C1*a[i+nh]+C0*a[i+1]+C3*a[i+nh1];
wksp[j++] = C3*a[i]-C0*a[i+nh]+C1*a[i+1]-C2*a[i+nh1];
}
}
for (i=1;i<=n;i++) a[i]=wksp[i];
free_vector(wksp,1,n);
}
#undef C0
#undef C1
#undef C2
#undef C3
#undef NRANSI

45
lib/nr/ansi/recipes/dawson.c Normal file
View File

@@ -0,0 +1,45 @@
#include <math.h>
#define NRANSI
#include "nrutil.h"
#define NMAX 6
#define H 0.4
#define A1 (2.0/3.0)
#define A2 0.4
#define A3 (2.0/7.0)
float dawson(float x)
{
int i,n0;
float d1,d2,e1,e2,sum,x2,xp,xx,ans;
static float c[NMAX+1];
static int init = 0;
if (init == 0) {
init=1;
for (i=1;i<=NMAX;i++) c[i]=exp(-SQR((2.0*i-1.0)*H));
}
if (fabs(x) < 0.2) {
x2=x*x;
ans=x*(1.0-A1*x2*(1.0-A2*x2*(1.0-A3*x2)));
} else {
xx=fabs(x);
n0=2*(int)(0.5*xx/H+0.5);
xp=xx-n0*H;
e1=exp(2.0*xp*H);
e2=e1*e1;
d1=n0+1;
d2=d1-2.0;
sum=0.0;
for (i=1;i<=NMAX;i++,d1+=2.0,d2-=2.0,e1*=e2)
sum += c[i]*(e1/d1+1.0/(d2*e1));
ans=0.5641895835*SIGN(exp(-xp*xp),x)*sum;
}
return ans;
}
#undef NMAX
#undef H
#undef A1
#undef A2
#undef A3
#undef NRANSI

93
lib/nr/ansi/recipes/dbrent.c Normal file
View File

@@ -0,0 +1,93 @@
#include <math.h>
#define NRANSI
#include "nrutil.h"
#define ITMAX 100
#define ZEPS 1.0e-10
#define MOV3(a,b,c, d,e,f) (a)=(d);(b)=(e);(c)=(f);
float dbrent(float ax, float bx, float cx, float (*f)(float),
float (*df)(float), float tol, float *xmin)
{
int iter,ok1,ok2;
float a,b,d,d1,d2,du,dv,dw,dx,e=0.0;
float fu,fv,fw,fx,olde,tol1,tol2,u,u1,u2,v,w,x,xm;
a=(ax < cx ? ax : cx);
b=(ax > cx ? ax : cx);
x=w=v=bx;
fw=fv=fx=(*f)(x);
dw=dv=dx=(*df)(x);
for (iter=1;iter<=ITMAX;iter++) {
xm=0.5*(a+b);
tol1=tol*fabs(x)+ZEPS;
tol2=2.0*tol1;
if (fabs(x-xm) <= (tol2-0.5*(b-a))) {
*xmin=x;
return fx;
}
if (fabs(e) > tol1) {
d1=2.0*(b-a);
d2=d1;
if (dw != dx) d1=(w-x)*dx/(dx-dw);
if (dv != dx) d2=(v-x)*dx/(dx-dv);
u1=x+d1;
u2=x+d2;
ok1 = (a-u1)*(u1-b) > 0.0 && dx*d1 <= 0.0;
ok2 = (a-u2)*(u2-b) > 0.0 && dx*d2 <= 0.0;
olde=e;
e=d;
if (ok1 || ok2) {
if (ok1 && ok2)
d=(fabs(d1) < fabs(d2) ? d1 : d2);
else if (ok1)
d=d1;
else
d=d2;
if (fabs(d) <= fabs(0.5*olde)) {
u=x+d;
if (u-a < tol2 || b-u < tol2)
d=SIGN(tol1,xm-x);
} else {
d=0.5*(e=(dx >= 0.0 ? a-x : b-x));
}
} else {
d=0.5*(e=(dx >= 0.0 ? a-x : b-x));
}
} else {
d=0.5*(e=(dx >= 0.0 ? a-x : b-x));
}
if (fabs(d) >= tol1) {
u=x+d;
fu=(*f)(u);
} else {
u=x+SIGN(tol1,d);
fu=(*f)(u);
if (fu > fx) {
*xmin=x;
return fx;
}
}
du=(*df)(u);
if (fu <= fx) {
if (u >= x) a=x; else b=x;
MOV3(v,fv,dv, w,fw,dw)
MOV3(w,fw,dw, x,fx,dx)
MOV3(x,fx,dx, u,fu,du)
} else {
if (u < x) a=u; else b=u;
if (fu <= fw || w == x) {
MOV3(v,fv,dv, w,fw,dw)
MOV3(w,fw,dw, u,fu,du)
} else if (fu < fv || v == x || v == w) {
MOV3(v,fv,dv, u,fu,du)
}
}
}
nrerror("Too many iterations in routine dbrent");
return 0.0;
}
#undef ITMAX
#undef ZEPS
#undef MOV3
#undef NRANSI

19
lib/nr/ansi/recipes/ddpoly.c Normal file
View File

@@ -0,0 +1,19 @@
void ddpoly(float c[], int nc, float x, float pd[], int nd)
{
int nnd,j,i;
float cnst=1.0;
pd[0]=c[nc];
for (j=1;j<=nd;j++) pd[j]=0.0;
for (i=nc-1;i>=0;i--) {
nnd=(nd < (nc-i) ? nd : nc-i);
for (j=nnd;j>=1;j--)
pd[j]=pd[j]*x+pd[j-1];
pd[0]=pd[0]*x+c[i];
}
for (i=2;i<=nd;i++) {
cnst *= i;
pd[i] *= cnst;
}
}

23
lib/nr/ansi/recipes/decchk.c Normal file
View File

@@ -0,0 +1,23 @@
int decchk(char string[], int n, char *ch)
{
char c;
int j,k=0,m=0;
static int ip[10][8]={0,1,5,8,9,4,2,7,1,5, 8,9,4,2,7,0,2,7,0,1,
5,8,9,4,3,6,3,6,3,6, 3,6,4,2,7,0,1,5,8,9, 5,8,9,4,2,7,0,1,6,3,
6,3,6,3,6,3,7,0,1,5, 8,9,4,2,8,9,4,2,7,0, 1,5,9,4,2,7,0,1,5,8};
static int ij[10][10]={0,1,2,3,4,5,6,7,8,9, 1,2,3,4,0,6,7,8,9,5,
2,3,4,0,1,7,8,9,5,6, 3,4,0,1,2,8,9,5,6,7, 4,0,1,2,3,9,5,6,7,8,
5,9,8,7,6,0,4,3,2,1, 6,5,9,8,7,1,0,4,3,2, 7,6,5,9,8,2,1,0,4,3,
8,7,6,5,9,3,2,1,0,4, 9,8,7,6,5,4,3,2,1,0};
for (j=0;j<n;j++) {
c=string[j];
if (c >= 48 && c <= 57)
k=ij[k][ip[(c+2) % 10][7 & m++]];
}
for (j=0;j<=9;j++)
if (!ij[k][ip[j][m & 7]]) break;
*ch=j+48;
return k==0;
}

24
lib/nr/ansi/recipes/df1dim.c Normal file
View File

@@ -0,0 +1,24 @@
#define NRANSI
#include "nrutil.h"
extern int ncom;
extern float *pcom,*xicom,(*nrfunc)(float []);
extern void (*nrdfun)(float [], float []);
float df1dim(float x)
{
int j;
float df1=0.0;
float *xt,*df;
xt=vector(1,ncom);
df=vector(1,ncom);
for (j=1;j<=ncom;j++) xt[j]=pcom[j]+x*xicom[j];
(*nrdfun)(xt,df);
for (j=1;j<=ncom;j++) df1 += df[j]*xicom[j];
free_vector(df,1,ncom);
free_vector(xt,1,ncom);
return df1;
}
#undef NRANSI

50
lib/nr/ansi/recipes/dfour1.c Normal file
View File

@@ -0,0 +1,50 @@
#include <math.h>
#define SWAP(a,b) tempr=(a);(a)=(b);(b)=tempr
void dfour1(double data[], unsigned long nn, int isign)
{
unsigned long n,mmax,m,j,istep,i;
double wtemp,wr,wpr,wpi,wi,theta;
double tempr,tempi;
n=nn << 1;
j=1;
for (i=1;i<n;i+=2) {
if (j > i) {
SWAP(data[j],data[i]);
SWAP(data[j+1],data[i+1]);
}
m=n >> 1;
while (m >= 2 && j > m) {
j -= m;
m >>= 1;
}
j += m;
}
mmax=2;
while (n > mmax) {
istep=mmax << 1;
theta=isign*(6.28318530717959/mmax);
wtemp=sin(0.5*theta);
wpr = -2.0*wtemp*wtemp;
wpi=sin(theta);
wr=1.0;
wi=0.0;
for (m=1;m<mmax;m+=2) {
for (i=m;i<=n;i+=istep) {
j=i+mmax;
tempr=wr*data[j]-wi*data[j+1];
tempi=wr*data[j+1]+wi*data[j];
data[j]=data[i]-tempr;
data[j+1]=data[i+1]-tempi;
data[i] += tempr;
data[i+1] += tempi;
}
wr=(wtemp=wr)*wpr-wi*wpi+wr;
wi=wi*wpr+wtemp*wpi+wi;
}
mmax=istep;
}
}
#undef SWAP

104
lib/nr/ansi/recipes/dfpmin.c Normal file
View File

@@ -0,0 +1,104 @@
#include <math.h>
#define NRANSI
#include "nrutil.h"
#define ITMAX 200
#define EPS 3.0e-8
#define TOLX (4*EPS)
#define STPMX 100.0
#define FREEALL free_vector(xi,1,n);free_vector(pnew,1,n); \
free_matrix(hessin,1,n,1,n);free_vector(hdg,1,n);free_vector(g,1,n); \
free_vector(dg,1,n);
void dfpmin(float p[], int n, float gtol, int *iter, float *fret,
float(*func)(float []), void (*dfunc)(float [], float []))
{
void lnsrch(int n, float xold[], float fold, float g[], float p[], float x[],
float *f, float stpmax, int *check, float (*func)(float []));
int check,i,its,j;
float den,fac,fad,fae,fp,stpmax,sum=0.0,sumdg,sumxi,temp,test;
float *dg,*g,*hdg,**hessin,*pnew,*xi;
dg=vector(1,n);
g=vector(1,n);
hdg=vector(1,n);
hessin=matrix(1,n,1,n);
pnew=vector(1,n);
xi=vector(1,n);
fp=(*func)(p);
(*dfunc)(p,g);
for (i=1;i<=n;i++) {
for (j=1;j<=n;j++) hessin[i][j]=0.0;
hessin[i][i]=1.0;
xi[i] = -g[i];
sum += p[i]*p[i];
}
stpmax=STPMX*FMAX(sqrt(sum),(float)n);
for (its=1;its<=ITMAX;its++) {
*iter=its;
lnsrch(n,p,fp,g,xi,pnew,fret,stpmax,&check,func);
fp = *fret;
for (i=1;i<=n;i++) {
xi[i]=pnew[i]-p[i];
p[i]=pnew[i];
}
test=0.0;
for (i=1;i<=n;i++) {
temp=fabs(xi[i])/FMAX(fabs(p[i]),1.0);
if (temp > test) test=temp;
}
if (test < TOLX) {
FREEALL
return;
}
for (i=1;i<=n;i++) dg[i]=g[i];
(*dfunc)(p,g);
test=0.0;
den=FMAX(*fret,1.0);
for (i=1;i<=n;i++) {
temp=fabs(g[i])*FMAX(fabs(p[i]),1.0)/den;
if (temp > test) test=temp;
}
if (test < gtol) {
FREEALL
return;
}
for (i=1;i<=n;i++) dg[i]=g[i]-dg[i];
for (i=1;i<=n;i++) {
hdg[i]=0.0;
for (j=1;j<=n;j++) hdg[i] += hessin[i][j]*dg[j];
}
fac=fae=sumdg=sumxi=0.0;
for (i=1;i<=n;i++) {
fac += dg[i]*xi[i];
fae += dg[i]*hdg[i];
sumdg += SQR(dg[i]);
sumxi += SQR(xi[i]);
}
if (fac > sqrt(EPS*sumdg*sumxi)) {
fac=1.0/fac;
fad=1.0/fae;
for (i=1;i<=n;i++) dg[i]=fac*xi[i]-fad*hdg[i];
for (i=1;i<=n;i++) {
for (j=i;j<=n;j++) {
hessin[i][j] += fac*xi[i]*xi[j]
-fad*hdg[i]*hdg[j]+fae*dg[i]*dg[j];
hessin[j][i]=hessin[i][j];
}
}
}
for (i=1;i<=n;i++) {
xi[i]=0.0;
for (j=1;j<=n;j++) xi[i] -= hessin[i][j]*g[j];
}
}
nrerror("too many iterations in dfpmin");
FREEALL
}
#undef ITMAX
#undef EPS
#undef TOLX
#undef STPMX
#undef FREEALL
#undef NRANSI

44
lib/nr/ansi/recipes/dfridr.c Normal file
View File

@@ -0,0 +1,44 @@
#include <math.h>
#define NRANSI
#include "nrutil.h"
#define CON 1.4
#define CON2 (CON*CON)
#define BIG 1.0e30
#define NTAB 10
#define SAFE 2.0
float dfridr(float (*func)(float), float x, float h, float *err)
{
int i,j;
float errt,fac,hh,**a,ans;
if (h == 0.0) nrerror("h must be nonzero in dfridr.");
a=matrix(1,NTAB,1,NTAB);
hh=h;
a[1][1]=((*func)(x+hh)-(*func)(x-hh))/(2.0*hh);
*err=BIG;
for (i=2;i<=NTAB;i++) {
hh /= CON;
a[1][i]=((*func)(x+hh)-(*func)(x-hh))/(2.0*hh);
fac=CON2;
for (j=2;j<=i;j++) {
a[j][i]=(a[j-1][i]*fac-a[j-1][i-1])/(fac-1.0);
fac=CON2*fac;
errt=FMAX(fabs(a[j][i]-a[j-1][i]),fabs(a[j][i]-a[j-1][i-1]));
if (errt <= *err) {
*err=errt;
ans=a[j][i];
}
}
if (fabs(a[i][i]-a[i-1][i-1]) >= SAFE*(*err)) break;
}
free_matrix(a,1,NTAB,1,NTAB);
return ans;
}
#undef CON
#undef CON2
#undef BIG
#undef NTAB
#undef SAFE
#undef NRANSI

58
lib/nr/ansi/recipes/dftcor.c Normal file
View File

@@ -0,0 +1,58 @@
#include <math.h>
void dftcor(float w, float delta, float a, float b, float endpts[],
float *corre, float *corim, float *corfac)
{
void nrerror(char error_text[]);
float a0i,a0r,a1i,a1r,a2i,a2r,a3i,a3r,arg,c,cl,cr,s,sl,sr,t;
float t2,t4,t6;
double cth,ctth,spth2,sth,sth4i,stth,th,th2,th4,tmth2,tth4i;
th=w*delta;
if (a >= b || th < 0.0e0 || th > 3.1416e0) nrerror("bad arguments to dftcor");
if (fabs(th) < 5.0e-2) {
t=th;
t2=t*t;
t4=t2*t2;
t6=t4*t2;
*corfac=1.0-(11.0/720.0)*t4+(23.0/15120.0)*t6;
a0r=(-2.0/3.0)+t2/45.0+(103.0/15120.0)*t4-(169.0/226800.0)*t6;
a1r=(7.0/24.0)-(7.0/180.0)*t2+(5.0/3456.0)*t4-(7.0/259200.0)*t6;
a2r=(-1.0/6.0)+t2/45.0-(5.0/6048.0)*t4+t6/64800.0;
a3r=(1.0/24.0)-t2/180.0+(5.0/24192.0)*t4-t6/259200.0;
a0i=t*(2.0/45.0+(2.0/105.0)*t2-(8.0/2835.0)*t4+(86.0/467775.0)*t6);
a1i=t*(7.0/72.0-t2/168.0+(11.0/72576.0)*t4-(13.0/5987520.0)*t6);
a2i=t*(-7.0/90.0+t2/210.0-(11.0/90720.0)*t4+(13.0/7484400.0)*t6);
a3i=t*(7.0/360.0-t2/840.0+(11.0/362880.0)*t4-(13.0/29937600.0)*t6);
} else {
cth=cos(th);
sth=sin(th);
ctth=cth*cth-sth*sth;
stth=2.0e0*sth*cth;
th2=th*th;
th4=th2*th2;
tmth2=3.0e0-th2;
spth2=6.0e0+th2;
sth4i=1.0/(6.0e0*th4);
tth4i=2.0e0*sth4i;
*corfac=tth4i*spth2*(3.0e0-4.0e0*cth+ctth);
a0r=sth4i*(-42.0e0+5.0e0*th2+spth2*(8.0e0*cth-ctth));
a0i=sth4i*(th*(-12.0e0+6.0e0*th2)+spth2*stth);
a1r=sth4i*(14.0e0*tmth2-7.0e0*spth2*cth);
a1i=sth4i*(30.0e0*th-5.0e0*spth2*sth);
a2r=tth4i*(-4.0e0*tmth2+2.0e0*spth2*cth);
a2i=tth4i*(-12.0e0*th+2.0e0*spth2*sth);
a3r=sth4i*(2.0e0*tmth2-spth2*cth);
a3i=sth4i*(6.0e0*th-spth2*sth);
}
cl=a0r*endpts[1]+a1r*endpts[2]+a2r*endpts[3]+a3r*endpts[4];
sl=a0i*endpts[1]+a1i*endpts[2]+a2i*endpts[3]+a3i*endpts[4];
cr=a0r*endpts[8]+a1r*endpts[7]+a2r*endpts[6]+a3r*endpts[5];
sr = -a0i*endpts[8]-a1i*endpts[7]-a2i*endpts[6]-a3i*endpts[5];
arg=w*(b-a);
c=cos(arg);
s=sin(arg);
*corre=cl+c*cr-s*sr;
*corim=sl+s*cr+c*sr;
}

70
lib/nr/ansi/recipes/dftint.c Normal file
View File

@@ -0,0 +1,70 @@
#include <math.h>
#define NRANSI
#include "nrutil.h"
#define M 64
#define NDFT 1024
#define MPOL 6
#define TWOPI (2.0*3.14159265)
void dftint(float (*func)(float), float a, float b, float w, float *cosint,
float *sinint)
{
void dftcor(float w, float delta, float a, float b, float endpts[],
float *corre, float *corim, float *corfac);
void polint(float xa[], float ya[], int n, float x, float *y, float *dy);
void realft(float data[], unsigned long n, int isign);
static int init=0;
int j,nn;
static float aold = -1.e30,bold = -1.e30,delta,(*funcold)(float);
static float data[NDFT+1],endpts[9];
float c,cdft,cerr,corfac,corim,corre,en,s;
float sdft,serr,*cpol,*spol,*xpol;
cpol=vector(1,MPOL);
spol=vector(1,MPOL);
xpol=vector(1,MPOL);
if (init != 1 || a != aold || b != bold || func != funcold) {
init=1;
aold=a;
bold=b;
funcold=func;
delta=(b-a)/M;
for (j=1;j<=M+1;j++)
data[j]=(*func)(a+(j-1)*delta);
for (j=M+2;j<=NDFT;j++)
data[j]=0.0;
for (j=1;j<=4;j++) {
endpts[j]=data[j];
endpts[j+4]=data[M-3+j];
}
realft(data,NDFT,1);
data[2]=0.0;
}
en=w*delta*NDFT/TWOPI+1.0;
nn=IMIN(IMAX((int)(en-0.5*MPOL+1.0),1),NDFT/2-MPOL+1);
for (j=1;j<=MPOL;j++,nn++) {
cpol[j]=data[2*nn-1];
spol[j]=data[2*nn];
xpol[j]=nn;
}
polint(xpol,cpol,MPOL,en,&cdft,&cerr);
polint(xpol,spol,MPOL,en,&sdft,&serr);
dftcor(w,delta,a,b,endpts,&corre,&corim,&corfac);
cdft *= corfac;
sdft *= corfac;
cdft += corre;
sdft += corim;
c=delta*cos(w*a);
s=delta*sin(w*a);
*cosint=c*cdft-s*sdft;
*sinint=s*cdft+c*sdft;
free_vector(cpol,1,MPOL);
free_vector(spol,1,MPOL);
free_vector(xpol,1,MPOL);
}
#undef M
#undef NDFT
#undef MPOL
#undef TWOPI
#undef NRANSI

59
lib/nr/ansi/recipes/difeq.c Normal file
View File

@@ -0,0 +1,59 @@
extern int mm,n,mpt;
extern float h,c2,anorm,x[];
void difeq(int k, int k1, int k2, int jsf, int is1, int isf, int indexv[],
int ne, float **s, float **y)
{
float temp,temp1,temp2;
if (k == k1) {
if (n+mm & 1) {
s[3][3+indexv[1]]=1.0;
s[3][3+indexv[2]]=0.0;
s[3][3+indexv[3]]=0.0;
s[3][jsf]=y[1][1];
} else {
s[3][3+indexv[1]]=0.0;
s[3][3+indexv[2]]=1.0;
s[3][3+indexv[3]]=0.0;
s[3][jsf]=y[2][1];
}
} else if (k > k2) {
s[1][3+indexv[1]] = -(y[3][mpt]-c2)/(2.0*(mm+1.0));
s[1][3+indexv[2]]=1.0;
s[1][3+indexv[3]] = -y[1][mpt]/(2.0*(mm+1.0));
s[1][jsf]=y[2][mpt]-(y[3][mpt]-c2)*y[1][mpt]/(2.0*(mm+1.0));
s[2][3+indexv[1]]=1.0;
s[2][3+indexv[2]]=0.0;
s[2][3+indexv[3]]=0.0;
s[2][jsf]=y[1][mpt]-anorm;
} else {
s[1][indexv[1]] = -1.0;
s[1][indexv[2]] = -0.5*h;
s[1][indexv[3]]=0.0;
s[1][3+indexv[1]]=1.0;
s[1][3+indexv[2]] = -0.5*h;
s[1][3+indexv[3]]=0.0;
temp1=x[k]+x[k-1];
temp=h/(1.0-temp1*temp1*0.25);
temp2=0.5*(y[3][k]+y[3][k-1])-c2*0.25*temp1*temp1;
s[2][indexv[1]]=temp*temp2*0.5;
s[2][indexv[2]] = -1.0-0.5*temp*(mm+1.0)*temp1;
s[2][indexv[3]]=0.25*temp*(y[1][k]+y[1][k-1]);
s[2][3+indexv[1]]=s[2][indexv[1]];
s[2][3+indexv[2]]=2.0+s[2][indexv[2]];
s[2][3+indexv[3]]=s[2][indexv[3]];
s[3][indexv[1]]=0.0;
s[3][indexv[2]]=0.0;
s[3][indexv[3]] = -1.0;
s[3][3+indexv[1]]=0.0;
s[3][3+indexv[2]]=0.0;
s[3][3+indexv[3]]=1.0;
s[1][jsf]=y[1][k]-y[1][k-1]-0.5*h*(y[2][k]+y[2][k-1]);
s[2][jsf]=y[2][k]-y[2][k-1]-temp*((x[k]+x[k-1])
*0.5*(mm+1.0)*(y[2][k]+y[2][k-1])-temp2
*0.5*(y[1][k]+y[1][k-1]));
s[3][jsf]=y[3][k]-y[3][k-1];
}
}

43
lib/nr/ansi/recipes/dlinmin.c Normal file
View File

@@ -0,0 +1,43 @@
#define NRANSI
#include "nrutil.h"
#define TOL 2.0e-4
int ncom;
float *pcom,*xicom,(*nrfunc)(float []);
void (*nrdfun)(float [], float []);
void dlinmin(float p[], float xi[], int n, float *fret, float (*func)(float []),
void (*dfunc)(float [], float []))
{
float dbrent(float ax, float bx, float cx,
float (*f)(float), float (*df)(float), float tol, float *xmin);
float f1dim(float x);
float df1dim(float x);
void mnbrak(float *ax, float *bx, float *cx, float *fa, float *fb,
float *fc, float (*func)(float));
int j;
float xx,xmin,fx,fb,fa,bx,ax;
ncom=n;
pcom=vector(1,n);
xicom=vector(1,n);
nrfunc=func;
nrdfun=dfunc;
for (j=1;j<=n;j++) {
pcom[j]=p[j];
xicom[j]=xi[j];
}
ax=0.0;
xx=1.0;
mnbrak(&ax,&xx,&bx,&fa,&fx,&fb,f1dim);
*fret=dbrent(ax,xx,bx,f1dim,df1dim,TOL,&xmin);
for (j=1;j<=n;j++) {
xi[j] *= xmin;
p[j] += xi[j];
}
free_vector(xicom,1,n);
free_vector(pcom,1,n);
}
#undef TOL
#undef NRANSI

14
lib/nr/ansi/recipes/dpythag.c Normal file
View File

@@ -0,0 +1,14 @@
#include <math.h>
#define NRANSI
#include "nrutil.h"
double dpythag(double a, double b)
{
double absa,absb;
absa=fabs(a);
absb=fabs(b);
if (absa > absb) return absa*sqrt(1.0+DSQR(absb/absa));
else return (absb == 0.0 ? 0.0 : absb*sqrt(1.0+DSQR(absa/absb)));
}
#undef NRANSI

46
lib/nr/ansi/recipes/drealft.c Normal file
View File

@@ -0,0 +1,46 @@
#include <math.h>
void drealft(double data[], unsigned long n, int isign)
{
void dfour1(double data[], unsigned long nn, int isign);
unsigned long i,i1,i2,i3,i4,np3;
double c1=0.5,c2,h1r,h1i,h2r,h2i;
double wr,wi,wpr,wpi,wtemp,theta;
theta=3.141592653589793/(double) (n>>1);
if (isign == 1) {
c2 = -0.5;
dfour1(data,n>>1,1);
} else {
c2=0.5;
theta = -theta;
}
wtemp=sin(0.5*theta);
wpr = -2.0*wtemp*wtemp;
wpi=sin(theta);
wr=1.0+wpr;
wi=wpi;
np3=n+3;
for (i=2;i<=(n>>2);i++) {
i4=1+(i3=np3-(i2=1+(i1=i+i-1)));
h1r=c1*(data[i1]+data[i3]);
h1i=c1*(data[i2]-data[i4]);
h2r = -c2*(data[i2]+data[i4]);
h2i=c2*(data[i1]-data[i3]);
data[i1]=h1r+wr*h2r-wi*h2i;
data[i2]=h1i+wr*h2i+wi*h2r;
data[i3]=h1r-wr*h2r+wi*h2i;
data[i4] = -h1i+wr*h2i+wi*h2r;
wr=(wtemp=wr)*wpr-wi*wpi+wr;
wi=wi*wpr+wtemp*wpi+wi;
}
if (isign == 1) {
data[1] = (h1r=data[1])+data[2];
data[2] = h1r-data[2];
} else {
data[1]=c1*((h1r=data[1])+data[2]);
data[2]=c1*(h1r-data[2]);
dfour1(data,n>>1,-1);
}
}

12
lib/nr/ansi/recipes/dsprsax.c Normal file
View File

@@ -0,0 +1,12 @@
void dsprsax(double sa[], unsigned long ija[], double x[], double b[], unsigned long n)
{
void nrerror(char error_text[]);
unsigned long i,k;
if (ija[1] != n+2) nrerror("dsprsax: mismatched vector and matrix");
for (i=1;i<=n;i++) {
b[i]=sa[i]*x[i];
for (k=ija[i];k<=ija[i+1]-1;k++) b[i] += sa[k]*x[ija[k]];
}
}

14
lib/nr/ansi/recipes/dsprstx.c Normal file
View File

@@ -0,0 +1,14 @@
void dsprstx(double sa[], unsigned long ija[], double x[], double b[], unsigned long n)
{
void nrerror(char error_text[]);
unsigned long i,j,k;
if (ija[1] != n+2) nrerror("mismatched vector and matrix in dsprstx");
for (i=1;i<=n;i++) b[i]=sa[i]*x[i];
for (i=1;i<=n;i++) {
for (k=ija[i];k<=ija[i+1]-1;k++) {
j=ija[k];
b[j] += sa[k]*x[i];
}
}
}

26
lib/nr/ansi/recipes/dsvbksb.c Normal file
View File

@@ -0,0 +1,26 @@
#define NRANSI
#include "nrutil.h"
void dsvbksb(double **u, double w[], double **v, int m, int n, double b[], double x[])
{
int jj,j,i;
double s,*tmp;
tmp=dvector(1,n);
for (j=1;j<=n;j++) {
s=0.0;
if (w[j]) {
for (i=1;i<=m;i++) s += u[i][j]*b[i];
s /= w[j];
}
tmp[j]=s;
}
for (j=1;j<=n;j++) {
s=0.0;
for (jj=1;jj<=n;jj++) s += v[j][jj]*tmp[jj];
x[j]=s;
}
free_dvector(tmp,1,n);
}
#undef NRANSI

183
lib/nr/ansi/recipes/dsvdcmp.c Normal file
View File

@@ -0,0 +1,183 @@
#include <math.h>
#define NRANSI
#include "nrutil.h"
void dsvdcmp(double **a, int m, int n, double w[], double **v)
{
double dpythag(double a, double b);
int flag,i,its,j,jj,k,l,nm;
double anorm,c,f,g,h,s,scale,x,y,z,*rv1;
rv1=dvector(1,n);
g=scale=anorm=0.0;
for (i=1;i<=n;i++) {
l=i+1;
rv1[i]=scale*g;
g=s=scale=0.0;
if (i <= m) {
for (k=i;k<=m;k++) scale += fabs(a[k][i]);
if (scale) {
for (k=i;k<=m;k++) {
a[k][i] /= scale;
s += a[k][i]*a[k][i];
}
f=a[i][i];
g = -SIGN(sqrt(s),f);
h=f*g-s;
a[i][i]=f-g;
for (j=l;j<=n;j++) {
for (s=0.0,k=i;k<=m;k++) s += a[k][i]*a[k][j];
f=s/h;
for (k=i;k<=m;k++) a[k][j] += f*a[k][i];
}
for (k=i;k<=m;k++) a[k][i] *= scale;
}
}
w[i]=scale *g;
g=s=scale=0.0;
if (i <= m && i != n) {
for (k=l;k<=n;k++) scale += fabs(a[i][k]);
if (scale) {
for (k=l;k<=n;k++) {
a[i][k] /= scale;
s += a[i][k]*a[i][k];
}
f=a[i][l];
g = -SIGN(sqrt(s),f);
h=f*g-s;
a[i][l]=f-g;
for (k=l;k<=n;k++) rv1[k]=a[i][k]/h;
for (j=l;j<=m;j++) {
for (s=0.0,k=l;k<=n;k++) s += a[j][k]*a[i][k];
for (k=l;k<=n;k++) a[j][k] += s*rv1[k];
}
for (k=l;k<=n;k++) a[i][k] *= scale;
}
}
anorm=DMAX(anorm,(fabs(w[i])+fabs(rv1[i])));
}
for (i=n;i>=1;i--) {
if (i < n) {
if (g) {
for (j=l;j<=n;j++) v[j][i]=(a[i][j]/a[i][l])/g;
for (j=l;j<=n;j++) {
for (s=0.0,k=l;k<=n;k++) s += a[i][k]*v[k][j];
for (k=l;k<=n;k++) v[k][j] += s*v[k][i];
}
}
for (j=l;j<=n;j++) v[i][j]=v[j][i]=0.0;
}
v[i][i]=1.0;
g=rv1[i];
l=i;
}
for (i=IMIN(m,n);i>=1;i--) {
l=i+1;
g=w[i];
for (j=l;j<=n;j++) a[i][j]=0.0;
if (g) {
g=1.0/g;
for (j=l;j<=n;j++) {
for (s=0.0,k=l;k<=m;k++) s += a[k][i]*a[k][j];
f=(s/a[i][i])*g;
for (k=i;k<=m;k++) a[k][j] += f*a[k][i];
}
for (j=i;j<=m;j++) a[j][i] *= g;
} else for (j=i;j<=m;j++) a[j][i]=0.0;
++a[i][i];
}
for (k=n;k>=1;k--) {
for (its=1;its<=30;its++) {
flag=1;
for (l=k;l>=1;l--) {
nm=l-1;
if ((double)(fabs(rv1[l])+anorm) == anorm) {
flag=0;
break;
}
if ((double)(fabs(w[nm])+anorm) == anorm) break;
}
if (flag) {
c=0.0;
s=1.0;
for (i=l;i<=k;i++) {
f=s*rv1[i];
rv1[i]=c*rv1[i];
if ((double)(fabs(f)+anorm) == anorm) break;
g=w[i];
h=dpythag(f,g);
w[i]=h;
h=1.0/h;
c=g*h;
s = -f*h;
for (j=1;j<=m;j++) {
y=a[j][nm];
z=a[j][i];
a[j][nm]=y*c+z*s;
a[j][i]=z*c-y*s;
}
}
}
z=w[k];
if (l == k) {
if (z < 0.0) {
w[k] = -z;
for (j=1;j<=n;j++) v[j][k] = -v[j][k];
}
break;
}
if (its == 30) nrerror("no convergence in 30 dsvdcmp iterations");
x=w[l];
nm=k-1;
y=w[nm];
g=rv1[nm];
h=rv1[k];
f=((y-z)*(y+z)+(g-h)*(g+h))/(2.0*h*y);
g=dpythag(f,1.0);
f=((x-z)*(x+z)+h*((y/(f+SIGN(g,f)))-h))/x;
c=s=1.0;
for (j=l;j<=nm;j++) {
i=j+1;
g=rv1[i];
y=w[i];
h=s*g;
g=c*g;
z=dpythag(f,h);
rv1[j]=z;
c=f/z;
s=h/z;
f=x*c+g*s;
g = g*c-x*s;
h=y*s;
y *= c;
for (jj=1;jj<=n;jj++) {
x=v[jj][j];
z=v[jj][i];
v[jj][j]=x*c+z*s;
v[jj][i]=z*c-x*s;
}
z=dpythag(f,h);
w[j]=z;
if (z) {
z=1.0/z;
c=f*z;
s=h*z;
}
f=c*g+s*y;
x=c*y-s*g;
for (jj=1;jj<=m;jj++) {
y=a[jj][j];
z=a[jj][i];
a[jj][j]=y*c+z*s;
a[jj][i]=z*c-y*s;
}
}
rv1[l]=0.0;
rv1[k]=f;
w[k]=x;
}
}
free_dvector(rv1,1,n);
}
#undef NRANSI

16
lib/nr/ansi/recipes/eclass.c Normal file
View File

@@ -0,0 +1,16 @@
void eclass(int nf[], int n, int lista[], int listb[], int m)
{
int l,k,j;
for (k=1;k<=n;k++) nf[k]=k;
for (l=1;l<=m;l++) {
j=lista[l];
while (nf[j] != j) j=nf[j];
k=listb[l];
while (nf[k] != k) k=nf[k];
if (j != k) nf[j]=k;
}
for (j=1;j<=n;j++)
while (nf[j] != nf[nf[j]]) nf[j]=nf[nf[j]];
}

15
lib/nr/ansi/recipes/eclazz.c Normal file
View File

@@ -0,0 +1,15 @@
void eclazz(int nf[], int n, int (*equiv)(int, int))
{
int kk,jj;
nf[1]=1;
for (jj=2;jj<=n;jj++) {
nf[jj]=jj;
for (kk=1;kk<=(jj-1);kk++) {
nf[kk]=nf[nf[kk]];
if ((*equiv)(jj,kk)) nf[nf[nf[kk]]]=jj;
}
}
for (jj=1;jj<=n;jj++) nf[jj]=nf[nf[jj]];
}

46
lib/nr/ansi/recipes/ei.c Normal file
View File

@@ -0,0 +1,46 @@
#include <math.h>
#define EULER 0.57721566
#define MAXIT 100
#define FPMIN 1.0e-30
#define EPS 6.0e-8
float ei(float x)
{
void nrerror(char error_text[]);
int k;
float fact,prev,sum,term;
if (x <= 0.0) nrerror("Bad argument in ei");
if (x < FPMIN) return log(x)+EULER;
if (x <= -log(EPS)) {
sum=0.0;
fact=1.0;
for (k=1;k<=MAXIT;k++) {
fact *= x/k;
term=fact/k;
sum += term;
if (term < EPS*sum) break;
}
if (k > MAXIT) nrerror("Series failed in ei");
return sum+log(x)+EULER;
} else {
sum=0.0;
term=1.0;
for (k=1;k<=MAXIT;k++) {
prev=term;
term *= k/x;
if (term < EPS) break;
if (term < prev) sum += term;
else {
sum -= prev;
break;
}
}
return exp(x)*(1.0+sum)/x;
}
}
#undef EPS
#undef EULER
#undef MAXIT
#undef FPMIN

21
lib/nr/ansi/recipes/eigsrt.c Normal file
View File

@@ -0,0 +1,21 @@
void eigsrt(float d[], float **v, int n)
{
int k,j,i;
float p;
for (i=1;i<n;i++) {
p=d[k=i];
for (j=i+1;j<=n;j++)
if (d[j] >= p) p=d[k=j];
if (k != i) {
d[k]=d[i];
d[i]=p;
for (j=1;j<=n;j++) {
p=v[j][i];
v[j][i]=v[j][k];
v[j][k]=p;
}
}
}
}

17
lib/nr/ansi/recipes/elle.c Normal file
View File

@@ -0,0 +1,17 @@
#include <math.h>
#define NRANSI
#include "nrutil.h"
float elle(float phi, float ak)
{
float rd(float x, float y, float z);
float rf(float x, float y, float z);
float cc,q,s;
s=sin(phi);
cc=SQR(cos(phi));
q=(1.0-s*ak)*(1.0+s*ak);
return s*(rf(cc,q,1.0)-(SQR(s*ak))*rd(cc,q,1.0)/3.0);
}
#undef NRANSI

14
lib/nr/ansi/recipes/ellf.c Normal file
View File

@@ -0,0 +1,14 @@
#include <math.h>
#define NRANSI
#include "nrutil.h"
float ellf(float phi, float ak)
{
float rf(float x, float y, float z);
float s;
s=sin(phi);
return s*rf(SQR(cos(phi)),(1.0-s*ak)*(1.0+s*ak),1.0);
}
#undef NRANSI

18
lib/nr/ansi/recipes/ellpi.c Normal file
View File

@@ -0,0 +1,18 @@
#include <math.h>
#define NRANSI
#include "nrutil.h"
float ellpi(float phi, float en, float ak)
{
float rf(float x, float y, float z);
float rj(float x, float y, float z, float p);
float cc,enss,q,s;
s=sin(phi);
enss=en*s*s;
cc=SQR(cos(phi));
q=(1.0-s*ak)*(1.0+s*ak);
return s*(rf(cc,q,1.0)-enss*rj(cc,q,1.0,1.0+enss)/3.0);
}
#undef NRANSI

37
lib/nr/ansi/recipes/elmhes.c Normal file
View File

@@ -0,0 +1,37 @@
#include <math.h>
#define SWAP(g,h) {y=(g);(g)=(h);(h)=y;}
void elmhes(float **a, int n)
{
int m,j,i;
float y,x;
for (m=2;m<n;m++) {
x=0.0;
i=m;
for (j=m;j<=n;j++) {
if (fabs(a[j][m-1]) > fabs(x)) {
x=a[j][m-1];
i=j;
}
}
if (i != m) {
for (j=m-1;j<=n;j++) SWAP(a[i][j],a[m][j])
for (j=1;j<=n;j++) SWAP(a[j][i],a[j][m])
}
if (x) {
for (i=m+1;i<=n;i++) {
if ((y=a[i][m-1]) != 0.0) {
y /= x;
a[i][m-1]=y;
for (j=m;j<=n;j++)
a[i][j] -= y*a[m][j];
for (j=1;j<=n;j++)
a[j][m] += y*a[j][i];
}
}
}
}
}
#undef SWAP

14
lib/nr/ansi/recipes/erfcc.c Normal file
View File

@@ -0,0 +1,14 @@
#include <math.h>
float erfcc(float x)
{
float t,z,ans;
z=fabs(x);
t=1.0/(1.0+0.5*z);
ans=t*exp(-z*z-1.26551223+t*(1.00002368+t*(0.37409196+t*(0.09678418+
t*(-0.18628806+t*(0.27886807+t*(-1.13520398+t*(1.48851587+
t*(-0.82215223+t*0.17087277)))))))));
return x >= 0.0 ? ans : 2.0-ans;
}

7
lib/nr/ansi/recipes/erff.c Normal file
View File

@@ -0,0 +1,7 @@
float erff(float x)
{
float gammp(float a, float x);
return x < 0.0 ? -gammp(0.5,x*x) : gammp(0.5,x*x);
}

8
lib/nr/ansi/recipes/erffc.c Normal file
View File

@@ -0,0 +1,8 @@
float erffc(float x)
{
float gammp(float a, float x);
float gammq(float a, float x);
return x < 0.0 ? 1.0+gammp(0.5,x*x) : gammq(0.5,x*x);
}

27
lib/nr/ansi/recipes/eulsum.c Normal file
View File

@@ -0,0 +1,27 @@
#include <math.h>
void eulsum(float *sum, float term, int jterm, float wksp[])
{
int j;
static int nterm;
float tmp,dum;
if (jterm == 1) {
nterm=1;
*sum=0.5*(wksp[1]=term);
} else {
tmp=wksp[1];
wksp[1]=term;
for (j=1;j<=nterm-1;j++) {
dum=wksp[j+1];
wksp[j+1]=0.5*(wksp[j]+tmp);
tmp=dum;
}
wksp[nterm+1]=0.5*(wksp[nterm]+tmp);
if (fabs(wksp[nterm+1]) <= fabs(wksp[nterm]))
*sum += (0.5*wksp[++nterm]);
else
*sum += wksp[nterm+1];
}
}

20
lib/nr/ansi/recipes/evlmem.c Normal file
View File

@@ -0,0 +1,20 @@
#include <math.h>
float evlmem(float fdt, float d[], int m, float xms)
{
int i;
float sumr=1.0,sumi=0.0;
double wr=1.0,wi=0.0,wpr,wpi,wtemp,theta;
theta=6.28318530717959*fdt;
wpr=cos(theta);
wpi=sin(theta);
for (i=1;i<=m;i++) {
wr=(wtemp=wr)*wpr-wi*wpi;
wi=wi*wpr+wtemp*wpi;
sumr -= d[i]*wr;
sumi -= d[i]*wi;
}
return xms/(sumr*sumr+sumi*sumi);
}

Some files were not shown because too many files have changed in this diff Show More