//Useful mathematical functions from numerical recipes library //Square function for floats and doubles #ifndef SQR_H #define SQR_H #ifdef __GNUC__ #define SQR_ATTR __attribute__((__const__)) #else #define SQR_ATTR #endif SQR_ATTR double sqr(double a) { return a*a; } SQR_ATTR float fsqr(float a) { return a*a; } #undef SQR_ATTR #endif #ifndef _NR_UTILS_H_ #define _NR_UTILS_H_ static float sqrarg; #define SQR(a) ((sqrarg=(a)) == 0.0 ? 0.0 : sqrarg*sqrarg) static double dsqrarg; #define DSQR(a) ((dsqrarg=(a)) == 0.0 ? 0.0 : dsqrarg*dsqrarg) static double dmaxarg1,dmaxarg2; #define DMAX(a,b) (dmaxarg1=(a),dmaxarg2=(b),(dmaxarg1) > (dmaxarg2) ?\ (dmaxarg1) : (dmaxarg2)) static double dminarg1,dminarg2; #define DMIN(a,b) (dminarg1=(a),dminarg2=(b),(dminarg1) < (dminarg2) ?\ (dminarg1) : (dminarg2)) static float maxarg1,maxarg2; #define FMAX(a,b) (maxarg1=(a),maxarg2=(b),(maxarg1) > (maxarg2) ?\ (maxarg1) : (maxarg2)) static float minarg1,minarg2; #define FMIN(a,b) (minarg1=(a),minarg2=(b),(minarg1) < (minarg2) ?\ (minarg1) : (minarg2)) static long lmaxarg1,lmaxarg2; #define LMAX(a,b) (lmaxarg1=(a),lmaxarg2=(b),(lmaxarg1) > (lmaxarg2) ?\ (lmaxarg1) : (lmaxarg2)) static long lminarg1,lminarg2; #define LMIN(a,b) (lminarg1=(a),lminarg2=(b),(lminarg1) < (lminarg2) ?\ (lminarg1) : (lminarg2)) static int imaxarg1,imaxarg2; #define IMAX(a,b) (imaxarg1=(a),imaxarg2=(b),(imaxarg1) > (imaxarg2) ?\ (imaxarg1) : (imaxarg2)) static int iminarg1,iminarg2; #define IMIN(a,b) (iminarg1=(a),iminarg2=(b),(iminarg1) < (iminarg2) ?\ (iminarg1) : (iminarg2)) #define SIGN(a,b) ((b) >= 0.0 ? fabs(a) : -fabs(a)) void nrerror(char error_text[]); float *vector(long nl, long nh); int *ivector(long nl, long nh); unsigned char *cvector(long nl, long nh); unsigned long *lvector(long nl, long nh); double *dvector(long nl, long nh); float **matrix(long nrl, long nrh, long ncl, long nch); double **dmatrix(long nrl, long nrh, long ncl, long nch); int **imatrix(long nrl, long nrh, long ncl, long nch); float **submatrix(float **a, long oldrl, long oldrh, long oldcl, long oldch, long newrl, long newcl); float **convert_matrix(float *a, long nrl, long nrh, long ncl, long nch); float ***f3tensor(long nrl, long nrh, long ncl, long nch, long ndl, long ndh); void free_vector(float *v, long nl, long nh); void free_ivector(int *v, long nl, long nh); void free_cvector(unsigned char *v, long nl, long nh); void free_lvector(unsigned long *v, long nl, long nh); void free_dvector(double *v, long nl, long nh); void free_matrix(float **m, long nrl, long nrh, long ncl, long nch); void free_dmatrix(double **m, long nrl, long nrh, long ncl, long nch); void free_imatrix(int **m, long nrl, long nrh, long ncl, long nch); void free_submatrix(float **b, long nrl, long nrh, long ncl, long nch); void free_convert_matrix(float **b, long nrl, long nrh, long ncl, long nch); void free_f3tensor(float ***t, long nrl, long nrh, long ncl, long nch, long ndl, long ndh); #endif /* _NR_UTILS_H_ */ #include #include #include #define NR_END 1 #define FREE_ARG char* void nrerror(char error_text[]) /* Numerical Recipes standard error handler */ { fprintf(stderr,"Numerical Recipes run-time error...\n"); fprintf(stderr,"%s\n",error_text); fprintf(stderr,"...now exiting to system...\n"); exit(1); } float *vector(long nl, long nh) /* allocate a float vector with subscript range v[nl..nh] */ { float *v; v=(float *)malloc((size_t) ((nh-nl+1+NR_END)*sizeof(float))); if (!v) nrerror("allocation failure in vector()"); return v-nl+NR_END; } int *ivector(long nl, long nh) /* allocate an int vector with subscript range v[nl..nh] */ { int *v; v=(int *)malloc((size_t) ((nh-nl+1+NR_END)*sizeof(int))); if (!v) nrerror("allocation failure in ivector()"); return v-nl+NR_END; } unsigned char *cvector(long nl, long nh) /* allocate an unsigned char vector with subscript range v[nl..nh] */ { unsigned char *v; v=(unsigned char *)malloc((size_t) ((nh-nl+1+NR_END)*sizeof(unsigned char))); if (!v) nrerror("allocation failure in cvector()"); return v-nl+NR_END; } unsigned long *lvector(long nl, long nh) /* allocate an unsigned long vector with subscript range v[nl..nh] */ { unsigned long *v; v=(unsigned long *)malloc((size_t) ((nh-nl+1+NR_END)*sizeof(long))); if (!v) nrerror("allocation failure in lvector()"); return v-nl+NR_END; } double *dvector(long nl, long nh) /* allocate a double vector with subscript range v[nl..nh] */ { double *v; v=(double *)malloc((size_t) ((nh-nl+1+NR_END)*sizeof(double))); if (!v) nrerror("allocation failure in dvector()"); return v-nl+NR_END; } float **matrix(long nrl, long nrh, long ncl, long nch) /* allocate a float matrix with subscript range m[nrl..nrh][ncl..nch] */ { long i, nrow=nrh-nrl+1,ncol=nch-ncl+1; float **m; /* allocate pointers to rows */ m=(float **) malloc((size_t)((nrow+NR_END)*sizeof(float*))); if (!m) nrerror("allocation failure 1 in matrix()"); m += NR_END; m -= nrl; /* allocate rows and set pointers to them */ m[nrl]=(float *) malloc((size_t)((nrow*ncol+NR_END)*sizeof(float))); if (!m[nrl]) nrerror("allocation failure 2 in matrix()"); m[nrl] += NR_END; m[nrl] -= ncl; for(i=nrl+1;i<=nrh;i++) m[i]=m[i-1]+ncol; /* return pointer to array of pointers to rows */ return m; } double **dmatrix(long nrl, long nrh, long ncl, long nch) /* allocate a double matrix with subscript range m[nrl..nrh][ncl..nch] */ { long i, nrow=nrh-nrl+1,ncol=nch-ncl+1; double **m; /* allocate pointers to rows */ m=(double **) malloc((size_t)((nrow+NR_END)*sizeof(double*))); if (!m) nrerror("allocation failure 1 in matrix()"); m += NR_END; m -= nrl; /* allocate rows and set pointers to them */ m[nrl]=(double *) malloc((size_t)((nrow*ncol+NR_END)*sizeof(double))); if (!m[nrl]) nrerror("allocation failure 2 in matrix()"); m[nrl] += NR_END; m[nrl] -= ncl; for(i=nrl+1;i<=nrh;i++) m[i]=m[i-1]+ncol; /* return pointer to array of pointers to rows */ return m; } int **imatrix(long nrl, long nrh, long ncl, long nch) /* allocate a int matrix with subscript range m[nrl..nrh][ncl..nch] */ { long i, nrow=nrh-nrl+1,ncol=nch-ncl+1; int **m; /* allocate pointers to rows */ m=(int **) malloc((size_t)((nrow+NR_END)*sizeof(int*))); if (!m) nrerror("allocation failure 1 in matrix()"); m += NR_END; m -= nrl; /* allocate rows and set pointers to them */ m[nrl]=(int *) malloc((size_t)((nrow*ncol+NR_END)*sizeof(int))); if (!m[nrl]) nrerror("allocation failure 2 in matrix()"); m[nrl] += NR_END; m[nrl] -= ncl; for(i=nrl+1;i<=nrh;i++) m[i]=m[i-1]+ncol; /* return pointer to array of pointers to rows */ return m; } float **submatrix(float **a, long oldrl, long oldrh, long oldcl, long oldch, long newrl, long newcl) /* point a submatrix [newrl..][newcl..] to a[oldrl..oldrh][oldcl..oldch] */ { long i,j,nrow=oldrh-oldrl+1,ncol=oldcl-newcl; float **m; /* allocate array of pointers to rows */ m=(float **) malloc((size_t) ((nrow+NR_END)*sizeof(float*))); if (!m) nrerror("allocation failure in submatrix()"); m += NR_END; m -= newrl; /* set pointers to rows */ for(i=oldrl,j=newrl;i<=oldrh;i++,j++) m[j]=a[i]+ncol; /* return pointer to array of pointers to rows */ return m; } float **convert_matrix(float *a, long nrl, long nrh, long ncl, long nch) /* allocate a float matrix m[nrl..nrh][ncl..nch] that points to the matrix declared in the standard C manner as a[nrow][ncol], where nrow=nrh-nrl+1 and ncol=nch-ncl+1. The routine should be called with the address &a[0][0] as the first argument. */ { long i,j,nrow=nrh-nrl+1,ncol=nch-ncl+1; float **m; /* allocate pointers to rows */ m=(float **) malloc((size_t) ((nrow+NR_END)*sizeof(float*))); if (!m) nrerror("allocation failure in convert_matrix()"); m += NR_END; m -= nrl; /* set pointers to rows */ m[nrl]=a-ncl; for(i=1,j=nrl+1;i #define NRANSI float pythag(float a, float b) { float absa,absb; absa=fabs(a); absb=fabs(b); if (absa > absb) return absa*sqrt(1.0+SQR(absb/absa)); else return (absb == 0.0 ? 0.0 : absb*sqrt(1.0+SQR(absa/absb))); } #undef NRANSI /* note #undef's at end of file */ #define IM1 2147483563 #define IM2 2147483399 #define AM (1.0/IM1) #define IMM1 (IM1-1) #define IA1 40014 #define IA2 40692 #define IQ1 53668 #define IQ2 52774 #define IR1 12211 #define IR2 3791 #define NTAB 32 #define NDIV (1+IMM1/NTAB) #define EPS 1.2e-7 #define RNMX (1.0-EPS) float ran2(long *idum) { int j; long k; static long idum2=123456789; static long iy=0; static long iv[NTAB]; float temp; if (*idum <= 0) { if (-(*idum) < 1) *idum=1; else *idum = -(*idum); idum2=(*idum); for (j=NTAB+7;j>=0;j--) { k=(*idum)/IQ1; *idum=IA1*(*idum-k*IQ1)-k*IR1; if (*idum < 0) *idum += IM1; if (j < NTAB) iv[j] = *idum; } iy=iv[0]; } k=(*idum)/IQ1; *idum=IA1*(*idum-k*IQ1)-k*IR1; if (*idum < 0) *idum += IM1; k=idum2/IQ2; idum2=IA2*(idum2-k*IQ2)-k*IR2; if (idum2 < 0) idum2 += IM2; j=iy/NDIV; iy=iv[j]-idum2; iv[j] = *idum; if (iy < 1) iy += IMM1; if ((temp=AM*iy) > RNMX) return RNMX; else return temp; } #undef IM1 #undef IM2 #undef AM #undef IMM1 #undef IA1 #undef IA2 #undef IQ1 #undef IQ2 #undef IR1 #undef IR2 #undef NTAB #undef NDIV #undef EPS #undef RNMX #include #define NRANSI int tqli(float d[], float e[], int n, float **z) { float pythag(float a, float b); int m,l,iter,i,k; float s,r,p,g,f,dd,c,b; for (i=2;i<=n;i++) e[i-1]=e[i]; e[n]=0.0; for (l=1;l<=n;l++) { iter=0; do { for (m=l;m<=n-1;m++) { dd=fabs(d[m])+fabs(d[m+1]); if ((float)(fabs(e[m])+dd) == dd) break; } if (m != l) { if (iter++ == 30){ nrerror("Too many iterations in tqli"); return 1; } g=(d[l+1]-d[l])/(2.0*e[l]); r=pythag(g,1.0); g=d[m]-d[l]+e[l]/(g+SIGN(r,g)); s=c=1.0; p=0.0; for (i=m-1;i>=l;i--) { f=s*e[i]; b=c*e[i]; e[i+1]=(r=pythag(f,g)); if (r == 0.0) { d[i+1] -= p; e[m]=0.0; break; } s=f/r; c=g/r; g=d[i+1]-p; r=(d[i]-g)*s+2.0*c*b; d[i+1]=g+(p=s*r); g=c*r-b; for (k=1;k<=n;k++) { f=z[k][i+1]; z[k][i+1]=s*z[k][i]+c*f; z[k][i]=c*z[k][i]-s*f; } } if (r == 0.0 && i >= l) continue; d[l] -= p; e[l]=g; e[m]=0.0; } } while (m != l); } return 0; } #undef NRANSI #include void tred2(float **a, int n, float d[], float e[]) { int l,k,j,i; float scale,hh,h,g,f; for (i=n;i>=2;i--) { l=i-1; h=scale=0.0; if (l > 1) { for (k=1;k<=l;k++) scale += fabs(a[i][k]); if (scale == 0.0) e[i]=a[i][l]; else { for (k=1;k<=l;k++) { a[i][k] /= scale; h += a[i][k]*a[i][k]; } f=a[i][l]; g=(f >= 0.0 ? -sqrt(h) : sqrt(h)); e[i]=scale*g; h -= f*g; a[i][l]=f-g; f=0.0; for (j=1;j<=l;j++) { a[j][i]=a[i][j]/h; g=0.0; for (k=1;k<=j;k++) g += a[j][k]*a[i][k]; for (k=j+1;k<=l;k++) g += a[k][j]*a[i][k]; e[j]=g/h; f += e[j]*a[i][j]; } hh=f/(h+h); for (j=1;j<=l;j++) { f=a[i][j]; e[j]=g=e[j]-hh*f; for (k=1;k<=j;k++) a[j][k] -= (f*e[k]+g*a[i][k]); } } } else e[i]=a[i][l]; d[i]=h; } d[1]=0.0; e[1]=0.0; /* Contents of this loop can be omitted if eigenvectors not wanted except for statement d[i]=a[i][i]; */ for (i=1;i<=n;i++) { l=i-1; if (d[i]) { for (j=1;j<=l;j++) { g=0.0; for (k=1;k<=l;k++) g += a[i][k]*a[k][j]; for (k=1;k<=l;k++) a[k][j] -= g*a[k][i]; } } d[i]=a[i][i]; a[i][i]=1.0; for (j=1;j<=l;j++) a[j][i]=a[i][j]=0.0; } }