::::::::::::::
avevar.c
::::::::::::::
/* revised to use j=0;j<n for data[j]
/* H. Fang 07.31.2010*/

void avevar(float data[], unsigned long n, float *ave, float *var)

{
  unsigned long j;
  float s,ep;

  for (*ave=0.0,j=0;j<n;j++) *ave += data[j];
  *ave /= n;
  *var=ep=0.0;
  for (j=0;j<n;j++) {
    s=data[j]-(*ave);
    ep += s;
    *var += s*s;
  }
  *var=(*var-ep*ep/n)/(n-1); 
}
::::::::::::::
brent.c
::::::::::::::
#include <math.h>
#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;
}
::::::::::::::
chixy.c
::::::::::::::
/* revised to use j=0;j<n for data[j]
/* H. Fang 07.31.2010*/

#include <math.h>
#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=0;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];
printf("%6.2f",ww[j]);
  }
  avex /= sumw;
  avey /= sumw;
  aa=avey-b*avex;
  for (ans = -offs,j=0;j<nn;j++) {
    ans += ww[j]*SQR(yy[j]-aa-b*xx[j]);
printf("\n chixy %6.2f%10.4f%10.4f%6.2f%6.2f%6.2f\n",
       ww[j],aa,b,xx[j],yy[j],ans);   
  
  }
  return ans;
}
::::::::::::::
fit.c
::::::::::::::
/* revised to use j=0;j<n for data[j]
/* H. Fang 07.31.2010*/

#include <math.h>
#include "nrutil.h"

void fit(float x[], float y[], int ndata, float sig[], int mwt, float *a,
  float *b, float *siga, float *sigb, float *chi2, float *q)
{
  float gammq(float a, float x);
  int i;
  float wt,t,sxoss,sx=0.0,sy=0.0,st2=0.0,ss,sigdat;

  *b=0.0;
  if (mwt) { 
    ss=0.0;
    for (i=0;i<ndata;i++) { 
      wt=1.0/SQR(sig[i]);
      ss += wt;
      sx += x[i]*wt;
      sy += y[i]*wt;
/*   printf("fit A %3d%6.2f%6.2f%6.2f%6.2f\n",i,sig[i],SQR(sig[i]),wt,ss);
*/

    }
  } else {
    for (i=0;i<ndata;i++) {
      sx += x[i];
      sy += y[i];
    }
    ss=ndata;
  }
  sxoss=sx/ss;
  if (mwt) {
    for (i=0;i<ndata;i++) {
      t=(x[i]-sxoss)/sig[i];
      st2 += t*t;
      *b += t*y[i]/sig[i];
    }
  } else {
    for (i=0;i<ndata;i++) {
      t=x[i]-sxoss;
      st2 += t*t;
      *b += t*y[i];
    }
  }
  *b /= st2;
  *a=(sy-sx*(*b))/ss;
  *siga=sqrt((1.0+sx*sx/(ss*st2))/ss);
  *sigb=sqrt(1.0/st2);
  *chi2=0.0;
  *q=1.0;
  if (mwt == 0) {
    for (i=0;i<ndata;i++)
      *chi2 += SQR(y[i]-(*a)-(*b)*x[i]);
    sigdat=sqrt((*chi2)/(ndata-2)); 
    *siga *= sigdat;
    *sigb *= sigdat;
  } else {
    for (i=0;i<ndata;i++) {
      *chi2 += SQR((y[i]-(*a)-(*b)*x[i])/sig[i]);
/*
printf("fit B %6d%6.2f%6.2f%6.2f%6.2f%6.2f%12.4f\n",i,y[i],*a,*b,x[i],sig[i],*chi2);
*/
    }
    if (ndata>2) *q=gammq(0.5*(ndata-2),0.5*(*chi2));
  }
}

::::::::::::::
fitexy.c
::::::::::::::
/* revised to use j=0;j<n for data[j]
/* H. Fang 07.31.2010*/

#include <math.h>
#include "nrutil.h"
#define POTN 1.571000
#define BIG 1.0e30
#define PI 3.14159265
#define ACC 1.0e-3

int nn;
float *xx,*yy,*sx,*sy,*ww,aa,offs;

void fitexy(float x[], float y[], int ndat, float sigx[], float sigy[],
    float *a, float *b, float *siga, float *sigb, float *chi2, float *q)
{
  void avevar(float data[], unsigned long n, float *ave, float *var);
  float brent(float ax, float bx, float cx,
    float (*f)(float), float tol, float *xmin);
  float chixy(float bang);
  void fit(float x[], float y[], int ndata, float sig[], int mwt,
    float *a, float *b, float *siga, float *sigb, float *chi2, float *q);
  float gammq(float a, float x);
  void mnbrak(float *ax, float *bx, float *cx, float *fa, float *fb,
    float *fc, float (*func)(float));
  float zbrent(float (*func)(float), float x1, float x2, float tol);

  int j;
  float swap,amx,amn,varx,vary,ang[7],ch[7],scale,bmn,bmx,d1,d2,r2,
    dum1,dum2,dum3,dum4,dum5;

  xx=vector(1,ndat);
  yy=vector(1,ndat);
  sx=vector(1,ndat);
  sy=vector(1,ndat);
  ww=vector(1,ndat);
  avevar(x,ndat,&dum1,&varx);
  avevar(y,ndat,&dum1,&vary);
  scale=sqrt(varx/vary);
  nn=ndat;
/*
printf("fitexy scale=%6.2f\n",scale);
*/
  for (j=0;j<ndat;j++) {
    xx[j]=x[j];
    yy[j]=y[j]*scale;
    sx[j]=sigx[j];
    sy[j]=sigy[j]*scale;
    ww[j]=sqrt(SQR(sx[j])+SQR(sy[j])); 
/*
printf("fitexy %6.2f%6.2f%6.2f%6.2f%6.2f\n", 
          sigx[j],sigy[j],sx[j],sy[j],ww[j]);
*/
  }

  fit(xx,yy,nn,ww,1,&dum1,b,&dum2,&dum3,&dum4,&dum5); 

  offs=ang[1]=0.0;
  ang[2]=atan(*b);
  ang[4]=0.0;
  ang[5]=ang[2];
  ang[6]=POTN;
  for (j=4;j<=6;j++) ch[j]=chixy(ang[j]);
  
  mnbrak(&ang[1],&ang[2],&ang[3],&ch[1],&ch[2],&ch[3],chixy);

  *chi2=brent(ang[1],ang[2],ang[3],chixy,ACC,b);
  *chi2=chixy(*b);
  *a=aa;
/* printf("fitexy %10.6f%10.6f\n",*b,*chi2);
*/
  *q=gammq(0.5*(nn-2),*chi2*0.5);
  for (r2=0.0,j=0;j<nn;j++) r2 += ww[j]; 
  r2=1.0/r2; 
  bmx=BIG;
  bmn=BIG;
  offs=(*chi2)+1.0;
  for (j=1;j<=6;j++) { 
    if (ch[j] > offs) {
      d1=fabs(ang[j]-(*b));
      while (d1 >= PI) d1 -= PI;
      d2=PI-d1;
      if (ang[j] < *b) {
        swap=d1;
        d1=d2;
        d2=swap;
      }
      if (d1 < bmx) bmx=d1;
      if (d2 < bmn) bmn=d2;
    }
  }
  if (bmx < BIG) { 
/* printf("fitexy AA %6.2f%6.2f\n",*b,*b+bmx); */
    bmx=zbrent(chixy,*b,*b+bmx,ACC)-(*b);
    amx=aa-(*a);
/* printf("fitexy BB %6.2f%6.2f\n",*b,*b-bmn); */ 
    bmn=zbrent(chixy,*b,*b-bmn,ACC)-(*b);
    amn=aa-(*a);
  } else (*sigb)=(*siga)=BIG; 

  *a /= scale;
  *b=tan(*b)/scale;

  free_vector(ww,1,ndat);
  free_vector(sy,1,ndat);
  free_vector(sx,1,ndat);
  free_vector(yy,1,ndat);
  free_vector(xx,1,ndat);
}
::::::::::::::
gammln.c
::::::::::::::
#include <math.h>

float gammln(float xx)
{
  double x,y,tmp,ser;
  static double cof[6]={76.18009172947146,-86.50532032941677,
    24.01409824083091,-1.231739572450155,
    0.1208650973866179e-2,-0.5395239384953e-5};
  int j;

  y=x=xx;
  tmp=x+5.5;
  tmp -= (x+0.5)*log(tmp);
  ser=1.000000000190015;
  for (j=0;j<=5;j++) ser += cof[j]/++y;
  return -tmp+log(2.5066282746310005*ser/x);
}

::::::::::::::
gammq.c
::::::::::::::
float gammq(float a, float x)
{
  void gcf(float *gammcf, float a, float x, float *gln);
  void gser(float *gamser, float a, float x, float *gln);
  void nrerror(char error_text[]);
  float gamser,gammcf,gln;

  if (x < 0.0 || a <= 0.0) nrerror("Invalid arguments in routine gammq");
  if (x < (a+1.0)) {
    gser(&gamser,a,x,&gln);
    return 1.0-gamser;
  } else { 
    gcf(&gammcf,a,x,&gln);
    return gammcf;
  }  
}

::::::::::::::
gcf.c
::::::::::::::
#include <math.h>
#define ITMAX 100
#define EPS 3.0e-7
#define FPMIN 1.0e-30

void gcf(float *gammcf, float a, float x, float *gln)
{
  float gammln(float xx);
  void nrerror(char error_text[]);
  int i;
  float an,b,c,d,del,h;

  *gln=gammln(a);
  b=x+1.0-a;
  c=1.0/FPMIN;
  d=1.0/b;
  h=d;
  for (i=1;i<=ITMAX;i++) {
    an = -i*(i-a);
    b += 2.0;
    d=an*d+b;
    if (fabs(d) < FPMIN) d=FPMIN;
    c=b+an/c;
    if (fabs(c) < FPMIN) c=FPMIN;
    d=1.0/d;
    del=d*c;
    h *= del;

  printf("gcf %3d%6.2f%8.0f%6.2f%6.2f%6.2f%6.2f%6.2f%12.4e\n",
          i,a,an,b,c,d,del,h,fabs(del-1.0));

    if (fabs(del-1.0) < EPS) break;
  }
/*  if (i > ITMAX) nrerror("a too large, ITMAX too small in gcf");
*/
  if (i > ITMAX) nrerror("a too large, check sigx, sigy in fitexy");
  *gammcf=exp(-x+a*log(x)-(*gln))*h; 
}

::::::::::::::
gser.c
::::::::::::::
#include <math.h>
#define ITMAX 100
#define EPS 3.0e-7

void gser(float *gamser, float a, float x, float *gln)
{
  float gammln(float xx);
  void nrerror(char error_text[]);
  int n;
  float sum,del,ap;

  *gln=gammln(a);
  if (x <= 0.0) {
    if (x < 0.0) nrerror("x less than 0 in routine gser");
    *gamser=0.0;
    return;
  } else {
    ap=a;
    del=sum=1.0/a;
    for (n=1;n<=ITMAX;n++) {
      ++ap;
      del *= x/ap;
      sum += del;
      if (fabs(del) < fabs(sum)*EPS) {
        *gamser=sum*exp(-x+a*log(x)-(*gln));
        return;
      }
    }  
    nrerror("a too large, ITMAX too small in routine gser");
    return;
  }
}

::::::::::::::
linfit.c
::::::::::::::
/* return field containing calibration and error numbers
*/
#include <stdio.h>
#include <stdlib.h>
#include <math.h>
#include <string.h>

float mean(float *a,int n);
void deviation (float *a,float mean,int n,float *d,float *S);

void linfit(float *x,float *y,int n,
    float *corr_coeff,float *reg_offset_yx,float *reg_coeff_yx)
{
  float sy,sx,mean_x,mean_y,sum_xy=0;
  float dx[n],dy[n];
  int i;   

  mean_x=mean(x,n);
  mean_y=mean(y,n);
  deviation(x,mean_x,n,dx,&sx);
  deviation(y,mean_y,n,dy,&sy);

  for(i=0;i<n;i++)
    sum_xy=sum_xy+dx[i]*dy[i];

  *corr_coeff = sum_xy/(n*sx*sy);
  *reg_coeff_yx = *corr_coeff*(sy/sx);
  *reg_offset_yx = mean_y - *reg_coeff_yx * mean_x;

}

float mean(float *a, int n)
{
  int i;
  float sum=0.0;

  for(i=0;i<n;i++) {
    sum += a[i];
  }
  sum=sum/n;
  return (sum);

}

void deviation(float *a, float mean, int n, float *d, float *s)
{
  int i;
  float sum=0,t;

  for(i=0;i<n;i++) {  
    d[i]=a[i]-mean;
    t=d[i]*d[i];
    sum += t;
  }
  sum = sum/n;
  *s=sqrt(sum);

} 
::::::::::::::
main.c
::::::::::::::
/* return field containing calibration and error numbers
*/
#include <stdio.h>
#include <stdlib.h>
#include <math.h>
#include <string.h>
   
#define XTILE 1000
#define YTILE 1000
#define XDIM 36000
#define YDIM 13100  /* 56S ~ 75N */

#define NW 5

static char 
/*  f_ind_bin[]="/disk2/fanghl/VGT/CYCLOPES/A2003/index_vgt2003.bin.txt",
  dir_bin[]="/disk2/fanghl/VGT/CYCLOPES/A2003/data_bin/",
  fs_out[]="/disk2/fanghl/VGT/CYCLOPES/A2003/vgt.lai.globe.2003.bin";
*/
  f_np[]="np.globe.0.05D",
  fout1[]="lin.globe.0.05D",
  fout2[]="tcem.globe.0.05D";

main (int argc, char *argv[])
{
  void triplecol(float *,float *,float *,int,
     float, float, float, float,float []);
  void linfit(float *,float *,int,float *,float *,float *);

  int i,j,k,m,n,np;
  int imon,iw,jw;
  float co_xy,co_xz,co_yz;
  float y_a,y_b,z_a,z_b,t_a,t_b;
  float lin_cal[3],tcem_cal[3];
  float dum1,dum2,dum3,varx,vary,varz;
  float x[NW*NW],y[NW*NW],z[NW*NW];
  unsigned char OneLine1[XTILE],OneLine2[XTILE],OneLine3[XTILE];
  unsigned char ***mod,***vgt,***glc;
  FILE *fm,*fv,*fg,*fnp,*fp1,*fp2;
  
  mod = (unsigned char ***) malloc (sizeof(unsigned char **) *12);
  vgt = (unsigned char ***) malloc (sizeof(unsigned char **) *12);
  glc = (unsigned char ***) malloc (sizeof(unsigned char **) *12);
  for (k=0;k<12;k++) {
    mod[k]=(unsigned char **) malloc (sizeof(unsigned char *) *YTILE);
    vgt[k]=(unsigned char **) malloc (sizeof(unsigned char *) *YTILE);
    glc[k]=(unsigned char **) malloc (sizeof(unsigned char *) *YTILE);
    for (i=0;i<YDIM;i++) {
      mod[k][i]=(unsigned char *) malloc (sizeof(unsigned char) *XTILE);
      vgt[k][i]=(unsigned char *) malloc (sizeof(unsigned char) *XTILE);
      glc[k][i]=(unsigned char *) malloc (sizeof(unsigned char) *XTILE);
  }}

/*  printf("%s\n",fout1);
*/

  fnp=fopen(f_np,"wb");
  fp1=fopen(fout1,"wb");
  fp2=fopen(fout2,"wb");

/* loop to read files */
  fm=fopen("/disk2/weiss/Triple/MCD15.globe.2003_0.01D_Asia_10D","rb");
  fv=fopen("/disk2/weiss/Triple/VGT.globe.2003_0.01D_Asia_10D","rb");
  fg=fopen("/disk2/weiss/Triple/GC.globe.2003_0.01D_Asia_10D","rb");

  for (imon=0;imon<12;imon++) {
    for (i=0;i<YTILE;i++) {
      fread(OneLine1,sizeof(unsigned char),XTILE,fm); 
      fread(OneLine2,sizeof(unsigned char),XTILE,fv); 
      fread(OneLine3,sizeof(unsigned char),XTILE,fg); 
      for (j=0;j<XTILE;j++) {
        mod[imon][i][j] = OneLine1[j];
        vgt[imon][i][j] = OneLine2[j];
        glc[imon][i][j] = OneLine3[j];
      }
    }

    for (i=0;i<YTILE;i+=NW)
      for (j=0;j<XTILE;j+=NW) { 
        np=0;  
        for (k=0;k<3;k++) {
          lin_cal[k] = 99.0;
          tcem_cal[k] = 99.0;
        }
      
/*        printf("%6d%6d\n",i,j);   */

        for (iw=0;iw<NW;iw++)
          for (jw=0;jw<NW;jw++) {
/*           printf("%6d%6d%6d\n",mod[imon][i+iw][j+jw],
              vgt[imon][i+iw][j+jw],glc[imon][i+iw][j+jw]);
*/
            if (mod[imon][i+iw][j+jw] < 180 &&
              vgt[imon][i+iw][j+jw] < 180 &&
              glc[imon][i+iw][j+jw] < 180) {
                x[np] = (float) mod[imon][i+iw][j+jw] * 0.1;
                y[np] = (float) vgt[imon][i+iw][j+jw] * 0.1;
                z[np] = (float) glc[imon][i+iw][j+jw] * 0.1;
/*        printf("%6d%6.2f%6.2f%6.2f\n",np,x[np],y[np],z[np]);
*/
                np++;
              } 
          }
 
        if (np > 10 ) {
/*
          for (m=0;m<np;m++)
            printf("AA %4d%6.2f%6.2f%6.2f\n",m,x[m],y[m],z[m]);
*/
          linfit(x,y,np,&co_xy,&y_a,&y_b);
          linfit(x,z,np,&co_xz,&z_a,&z_b);
          linfit(y,z,np,&co_yz,&t_a,&t_b);
          lin_cal[0] = co_xy;
          lin_cal[1] = co_xz;
          lin_cal[2] = co_yz;
          
          avevar(x,np,&dum1,&varx);
          avevar(y,np,&dum2,&vary);
          avevar(z,np,&dum3,&varz);
/*
printf("BB %6d%6d%6.2f%6.2f%6.2f%6.2f%6.2f%6.2f%10.6f%10.6f%10.6f\n",
       i,j,co_xy,co_xz,co_yz,y_b,z_b,t_b,varx,vary,varz);
*/
          if (vary ==0 || varz == 0) { 
            tcem_cal[0] = 98;
            tcem_cal[1] = 98;
            tcem_cal[2] = 98;
            continue;
          }

          if (fabs(co_xy) >= 0.2 && fabs(co_xz) >= 0.2 && fabs(co_yz) >= 0.2)
            triplecol(x,y,z,np,y_a,y_b,z_a,z_b,tcem_cal);

        }

        fwrite(&np,sizeof(unsigned char),1,fnp);
        fwrite(lin_cal,sizeof(float),3,fp1);
        fwrite(tcem_cal,sizeof(float),3,fp2);

    }
  }     

  fclose(fm); fclose(fv); fclose(fg);
  fclose(fnp); fclose(fp1); fclose(fp2);

}
::::::::::::::
mnbrak.c
::::::::::::::
#include <math.h>
#include "nrutil.h"
#define GOLD 1.618034
#define GLIMIT 100.0
#define TINY 1.0e-20
#define SHFT(a,b,c,d) (a)=(b);(b)=(c);(c)=(d);

void mnbrak(float *ax, float *bx, float *cx, float *fa, float *fb, float *fc,
  float (*func)(float))
{
  float ulim,u,r,q,fu,dum;

  *fa=(*func)(*ax);
  *fb=(*func)(*bx);
  if (*fb > *fa) {
    SHFT(dum,*ax,*bx,dum)
    SHFT(dum,*fb,*fa,dum)
  }
  *cx=(*bx)+GOLD*(*bx-*ax); 
  *fc=(*func)(*cx);
  while (*fb > *fc) { 
    r=(*bx-*ax)*(*fb-*fc); 
    q=(*bx-*cx)*(*fb-*fa);
    u=(*bx)-((*bx-*cx)*q-(*bx-*ax)*r)/
      (2.0*SIGN(FMAX(fabs(q-r),TINY),q-r));
    ulim=(*bx)+GLIMIT*(*cx-*bx);
    if ((*bx-u)*(u-*cx) > 0.0) {
      fu=(*func)(u);
      if (fu < *fc) {
        *ax=(*bx);
        *bx=u;
        *fa=(*fb);
        *fb=fu;
        return;
      } else if (fu > *fb) { 
        *cx=u;
        *fc=fu;
        return;
      }
      u=(*cx)+GOLD*(*cx-*bx);
      fu=(*func)(u); 
    } else if ((*cx-u)*(u-ulim) > 0.0) { 
      fu=(*func)(u); 
      if (fu < *fc) {
        SHFT(*bx,*cx,u,*cx+GOLD*(*cx-*bx))
        SHFT(*fb,*fc,fu,(*func)(u))
      }  
    } else if ((u-ulim)*(ulim-*cx) >= 0.0) {
      u=ulim; 
      fu=(*func)(u);
    } else {
      u=(*cx)+GOLD*(*cx-*bx); 
      fu=(*func)(u);
    }
    SHFT(*ax,*bx,*cx,u) 
    SHFT(*fa,*fb,*fc,fu)
  }
}

::::::::::::::
nrutil.c
::::::::::::::
#include <stdio.h>
#include <stddef.h>
#include <stdlib.h>
#include "nrutil.h"

#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<nrow;i++,j++) m[j]=m[j-1]+ncol;
   /* return pointer to array of pointers to rows */
   return m;
}

float ***f3tensor(long nrl, long nrh, long ncl, long nch, long ndl, long ndh)
/* allocate a float 3tensor with range t[nrl..nrh][ncl..nch][ndl..ndh] */
{
   long i,j,nrow=nrh-nrl+1,ncol=nch-ncl+1,ndep=ndh-ndl+1;
   float ***t;

   /* allocate pointers to pointers to rows */
   t=(float ***) malloc((size_t)((nrow+NR_END)*sizeof(float**)));
   if (!t) nrerror("allocation failure 1 in f3tensor()");
   t += NR_END;
   t -= nrl;

   /* allocate pointers to rows and set pointers to them */
   t[nrl]=(float **) malloc((size_t)((nrow*ncol+NR_END)*sizeof(float*)));
   if (!t[nrl]) nrerror("allocation failure 2 in f3tensor()");
   t[nrl] += NR_END;
   t[nrl] -= ncl;

   /* allocate rows and set pointers to them */
   t[nrl][ncl]=(float *) malloc((size_t)((nrow*ncol*ndep+NR_END)*sizeof(float)));
   if (!t[nrl][ncl]) nrerror("allocation failure 3 in f3tensor()");
   t[nrl][ncl] += NR_END;
   t[nrl][ncl] -= ndl;

   for(j=ncl+1;j<=nch;j++) t[nrl][j]=t[nrl][j-1]+ndep;
   for(i=nrl+1;i<=nrh;i++) {
      t[i]=t[i-1]+ncol;
      t[i][ncl]=t[i-1][ncl]+ncol*ndep;
      for(j=ncl+1;j<=nch;j++) t[i][j]=t[i][j-1]+ndep;
     }
   /* return pointer to array of pointers to rows */
   return t;
}

void free_vector(float *v, long nl, long nh)
/* free a float vector allocated with vector() */
{
   free((FREE_ARG) (v+nl-NR_END));
}

void free_ivector(int *v, long nl, long nh)
/* free an int vector allocated with ivector() */
{
   free((FREE_ARG) (v+nl-NR_END));
}

void free_cvector(unsigned char *v, long nl, long nh)
/* free an unsigned char vector allocated with cvector() */
{
   free((FREE_ARG) (v+nl-NR_END));
}

void free_lvector(unsigned long *v, long nl, long nh)
/* free an unsigned long vector allocated with lvector() */
{
   free((FREE_ARG) (v+nl-NR_END));
}
void free_dvector(double *v, long nl, long nh)
/* free a double vector allocated with dvector() */
{
   free((FREE_ARG) (v+nl-NR_END));
}

void free_matrix(float **m, long nrl, long nrh, long ncl, long nch)
/* free a float matrix allocated by matrix() */
{
   free((FREE_ARG) (m[nrl]+ncl-NR_END));
   free((FREE_ARG) (m+nrl-NR_END));
}

void free_dmatrix(double **m, long nrl, long nrh, long ncl, long nch)
/* free a double matrix allocated by dmatrix() */
{
   free((FREE_ARG) (m[nrl]+ncl-NR_END));
   free((FREE_ARG) (m+nrl-NR_END));
}

void free_imatrix(int **m, long nrl, long nrh, long ncl, long nch)
/* free an int matrix allocated by imatrix() */
{
   free((FREE_ARG) (m[nrl]+ncl-NR_END));
   free((FREE_ARG) (m+nrl-NR_END));
}

void free_submatrix(float **b, long nrl, long nrh, long ncl, long nch)
/* free a submatrix allocated by submatrix() */
{
   free((FREE_ARG) (b+nrl-NR_END));
}

void free_convert_matrix(float **b, long nrl, long nrh, long ncl, long nch)
/* free a matrix allocated by convert_matrix() */
{
  free((FREE_ARG) (b+nrl-NR_END));
}

void free_f3tensor(float ***t, long nrl, long nrh, long ncl, long nch,
long ndl, long ndh)
/* free a float f3tensor allocated by f3tensor() */
{
   free((FREE_ARG) (t[nrl][ncl]+ndl-NR_END));
   free((FREE_ARG) (t[nrl]+ncl-NR_END));
   free((FREE_ARG) (t+nrl-NR_END));
}
::::::::::::::
t.c
::::::::::::::
/* return field containing calibration and error numbers
*/
#include <stdio.h>
#include <stdlib.h>
#include <math.h>
#include <string.h>

float mean(float *a,int n);
void deviation (float *a,float mean,int n,float *d,float *S);
void linfit(float *x,float *y,int n,float *,float *,float *);

void linfit(float *x,float *y,int n,
    float *corr_coeff,float *reg_offset_yx,float *reg_coeff_yx)
{
  float sy,sx,mean_x,mean_y,sum_xy=0;
  float dx[n],dy[n];
  int i;   

  mean_x=mean(x,n);
  mean_y=mean(y,n);
  deviation(x,mean_x,n,dx,&sx);
  deviation(y,mean_y,n,dy,&sy);

  for(i=0;i<n;i++)
    sum_xy=sum_xy+dx[i]*dy[i];

  *corr_coeff = sum_xy/(n*sx*sy);
  *reg_coeff_yx = *corr_coeff*(sy/sx);
  *reg_offset_yx = mean_y - *reg_coeff_yx * mean_x;

}

float mean(float *a, int n)
{
  int i;
  float sum=0.0;

  for(i=0;i<n;i++) {
    sum += a[i];
  }
  sum=sum/n;
  return (sum);

}

void deviation(float *a, float mean, int n, float *d, float *s)
{
  int i;
  float sum=0,t;

  for(i=0;i<n;i++) {  
    d[i]=a[i]-mean;
    t=d[i]*d[i];
    sum += t;
  }
  sum = sum/n;
  *s=sqrt(sum);

} 

main (int argc, char *argv[])
{

  float x[6]={1,2,3,4,5,6};
  float y[6]={5,7,9,11,13,15};
  float co,a,b;
  int n=6;
  linfit(x,y,n,&co,&a,&b);

  printf("%6.2f%6.2f%6.2f\n",co,a,b);


}
::::::::::::::
triplecol.c
::::::::::::::
/* use array x_sig[],y_sig[] instead of scalar */
/* H. Fang, 08.03.2010 */ 
#include <math.h>
   
void triplecol(float *x,float *y,float *z,int ndat,
   float y_a, float y_b, float z_a, float z_b, float cal[3])
{
  void linfit(float *,float *,int,float *,float *,float *);
  float mean(float *,int); 
  void fitexy(float [],float [],int,float [],float [],
     float *,float *,float *,float *,float *,float *);

  int maxiter,iter;
  int i,j,n;
  float eps,x_e,y_e,z_e;
  float y_e_old,z_e_old;
  float x_a,x_b;
  float x_t[ndat],y_t[ndat],z_t[ndat];
  float y_q,z_q,y_chi_sq,z_chi_sq;
  float xx_t[ndat],yy_t[ndat],zz_t[ndat];
  float x_sig[ndat],y_sig[ndat],z_sig[ndat];
  float ay_sigma,az_sigma,by_sigma,bz_sigma;
  float co_xy,co_xz,co_yz;
  float tol;

  eps=0.0001; maxiter=20; iter=0;

  x_e=1000.0; y_e=1000.0; z_e=1000.0;
  x_a=0; x_b=1.0;

/*
  linfit(x,y,ndat,&co_xy,&y_a,&y_b);
  linfit(x,z,ndat,&co_xz,&z_a,&z_b);

  printf("triplecol %6.2f%6.2f%6.2f%6.2f\n",y_a,y_b,z_a,z_b);
*/

  do {

    iter=iter+1;

    y_e_old=y_e;
    z_e_old=z_e;

    for (i=0;i<ndat;i++) {
      x_t[i] = x[i]/x_b - x_a/x_b;
      y_t[i] = y[i]/y_b - y_a/y_b;
      z_t[i] = z[i]/z_b - z_a/z_b;
      xx_t[i] = (x_t[i] - y_t[i]) * (x_t[i] - z_t[i]);
      yy_t[i] = (y_t[i] - x_t[i]) * (y_t[i] - z_t[i]);
      zz_t[i] = (z_t[i] - x_t[i]) * (z_t[i] - y_t[i]);

/*
 printf("%6.2f%6.2f%6.2f",z[i],z_a,z_b); 
 printf("%6.2f%6.2f%6.2f",x_t[i],y_t[i],z_t[i]); 
 printf("%6.2f%6.2f%6.2f\n",xx_t[i],yy_t[i],zz_t[i]); 
*/
    }

    x_e = mean(xx_t,ndat);
    y_e = mean(yy_t,ndat);
    z_e = mean(zz_t,ndat);

/* printf("triplecol A %12.6f%12.6f%12.6f\n",x_e,y_e,z_e);
*/
    if (x_e <= eps) x_e=0.1;
    if (y_e <= eps) y_e=0.1;
    if (z_e <= eps) z_e=0.1;
/*
printf("triplecol B %12.6f%12.6f%12.6f\n",x_b,x_e,z_e);
*/
  for (i=0;i<ndat;i++) {
    x_sig[i] = x_b * sqrt(x_e);
    y_sig[i] = y_b * sqrt(y_e);
    z_sig[i] = y_b * sqrt(z_e);
  }
/*
    x_sig = x_b * sqrt(x_e);
    y_sig = y_b * sqrt(y_e);
    z_sig = z_b * sqrt(z_e);
*/
/*
 printf("A1 x_sig=%8.4f y_sig=%8.4f y_a=%8.4f y_b=%8.4f\n",
       x_sig,y_sig,y_a,y_b);
*/
    fitexy(x,y,ndat,x_sig,y_sig,&y_a,&y_b,&ay_sigma,&by_sigma,&y_chi_sq,&y_q);

/*    x_sig = x_b * sqrt(x_e);
    z_sig = z_b * sqrt(z_e);
*/

/*printf("AA x_sig=%8.4f z_sig=%8.4f z_a=%8.4f z_b=%8.4f\n",
       x_sig,z_sig,z_a,z_b);
*/
    fitexy(x,z,ndat,x_sig,z_sig,&z_a,&z_b,&az_sigma,&bz_sigma,&z_chi_sq,&z_q);
/*
printf("BB %8.4f%8.4f%8.4f%8.4f\n",x_sig,z_sig,z_a,z_b);
printf("CC %4d%12.6f%12.6f%12.6f\n",iter,eps,fabs(y_e-y_e_old),fabs(z_e-z_e_old));
*/
  } while ( (fabs(y_e-y_e_old) >= eps || fabs(z_e-z_e_old) >= eps) && (iter < maxiter) );
/* printf("%6d\n",iter);
*/
  if (iter <= maxiter) 
    {
      cal[0]=sqrt(x_e);
      cal[1]=sqrt(y_e);
      cal[2]=sqrt(z_e);
    }
  else 
    for (i=0;i<3;i++)
        cal[i]=9999;

/*
  for (i=0;i<3;i++) {
      printf("%12.5f",cal[i]);
    printf("\n");
  }
*/

/* print out the hypothetical truth  

  for (i=0;i<ndat;i++) 
   printf("%6.2f%6.2f%6.2f\n",(x[i]-x_a-sqrt(x_e))/x_b,(y[i]-y_a-sqrt(y_e))/y_b,(z[i]-z_a-sqrt(z_e))/z_b);
*/
}
::::::::::::::
zbrent.c
::::::::::::::
#include <math.h>
#include "nrutil.h"
#define ITMAX 100
#define EPS 3.0e-8

float zbrent(float (*func)(float), float x1, float x2, float tol)
{
  int iter;
  float a=x1,b=x2,c=x2,d,e,min1,min2;
  float fa=(*func)(a),fb=(*func)(b),fc,p,q,r,s,tol1,xm;

  if ((fa > 0.0 && fb > 0.0) || (fa < 0.0 && fb < 0.0))
    nrerror("Root must be bracketed in zbrent");
  fc=fb;
  for (iter=1;iter<=ITMAX;iter++) {
    if ((fb > 0.0 && fc > 0.0) || (fb < 0.0 && fc < 0.0)) {
      c=a; 
      fc=fa; 
      e=d=b-a;
    }
    if (fabs(fc) < fabs(fb)) {
      a=b;
      b=c;
      c=a;
      fa=fb;
      fb=fc;
      fc=fa;
    }
    tol1=2.0*EPS*fabs(b)+0.5*tol; 
    xm=0.5*(c-b);
    if (fabs(xm) <= tol1 || fb == 0.0) return b;
    if (fabs(e) >= tol1 && fabs(fa) > fabs(fb)) {
      s=fb/fa; 
      if (a == c) {
        p=2.0*xm*s;
        q=1.0-s;
      } else {
        q=fa/fc;
        r=fb/fc;
        p=s*(2.0*xm*q*(q-r)-(b-a)*(r-1.0));
        q=(q-1.0)*(r-1.0)*(s-1.0);
      }
      if (p > 0.0) q = -q; 
      p=fabs(p);
      min1=3.0*xm*q-fabs(tol1*q);
      min2=fabs(e*q);
      if (2.0*p < (min1 < min2 ? min1 : min2)) {
        e=d; 
        d=p/q;
      } else {
        d=xm;
        e=d;
      }
    } else { 
      d=xm;
      e=d;
    }
    a=b; 
    fa=fb;
    if (fabs(d) > tol1) 
      b += d;
    else
      b += SIGN(tol1,xm);
    fb=(*func)(b);
  }
  nrerror("Maximum number of iterations exceeded in zbrent");
  return 0.0; 
}
