/*
* Function quantile seeks the number with certain quantile in an array "thedata"
* Input argument: numrows is the length of the array "thedata"
* thedata is an unordered array
* indx storess the indeces of elements in "thedata" and when sorting
* the array, indx is changed to store the order while "thedata" remains unchanged
* percent is the quantile, such as "0.05"
* It return the number of certain quantile in "thedata".
*/
double quantile(int numrows, double thedata[], int indx[], float percent)
{
int y;
y = numrows*percent;
indexx(numrows,thedata,indx);
return thedata[indx[y]];
}
/*
** Same as below, but with floating point (single precision) arrays.
*/
float interpxy(float x0,float *x,float *y,long n)
{
long i;
i=indexx(x0,x,n);
if (i<0)
return(y[0]);
if (i>=n-1)
return(y[n-1]);
return(y[i] + (x0-x[i])*(y[i+1]-y[i])/(x[i+1]-x[i]));
}
void NR::sort3(Vec_IO_DP &ra, Vec_IO_DP &rb, Vec_IO_DP &rc)
{
int j;
int n=ra.size();
Vec_INT iwksp(n);
Vec_DP wksp(n);
indexx(ra,iwksp);
for (j=0;j<n;j++) wksp[j]=ra[j];
for (j=0;j<n;j++) ra[j]=wksp[iwksp[j]];
for (j=0;j<n;j++) wksp[j]=rb[j];
for (j=0;j<n;j++) rb[j]=wksp[iwksp[j]];
for (j=0;j<n;j++) wksp[j]=rc[j];
for (j=0;j<n;j++) rc[j]=wksp[iwksp[j]];
}
void sort3(unsigned long n, float ra[], float rb[], float rc[])
{
void indexx(unsigned long n, float arr[], unsigned long indx[]);
unsigned long j,*iwksp;
float *wksp;
iwksp=lvector(1,n);
wksp=vector(1,n);
indexx(n,ra,iwksp);
for (j=1;j<=n;j++) wksp[j]=ra[j];
for (j=1;j<=n;j++) ra[j]=wksp[iwksp[j]];
for (j=1;j<=n;j++) wksp[j]=rb[j];
for (j=1;j<=n;j++) rb[j]=wksp[iwksp[j]];
for (j=1;j<=n;j++) wksp[j]=rc[j];
for (j=1;j<=n;j++) rc[j]=wksp[iwksp[j]];
free_vector(wksp,1,n);
free_lvector(iwksp,1,n);
}
int main(void)
{
char txt[MAXSTR];
unsigned long i,j,k,l,*indx,*irank;
float *a,b[11];
FILE *fp;
indx=lvector(1,NP);
irank=lvector(1,NP);
a=vector(1,NP);
if ((fp = fopen("tarray.dat","r")) == NULL)
nrerror("Data file tarray.dat not found\n");
fgets(txt,MAXSTR,fp);
for (i=1;i<=NP;i++) fscanf(fp,"%f",&a[i]);
fclose(fp);
indexx(NP,a,indx);
rank(NP,indx,irank);
printf("original array is:\n");
for (i=0;i<=9;i++) {
for (j=1;j<=10;j++) printf("%7.2f",a[10*i+j]);
printf("\n");
}
printf("table of ranks is:\n");
for (i=0;i<=9;i++) {
for (j=1;j<=10;j++) printf("%7d",irank[10*i+j]);
printf("\n");
}
printf("press return to continue...\n");
(void) getchar();
printf("array sorted according to rank table:\n");
for (i=0;i<=9;i++) {
for (j=1;j<=10;j++) {
k=10*i+j;
for (l=1;l<=NP;l++)
if (irank[l] == k) b[j]=a[l];
}
for (j=1;j<=10;j++) printf("%7.2f",b[j]);
printf("\n");
}
free_vector(a,1,NP);
free_lvector(irank,1,NP);
free_lvector(indx,1,NP);
return 0;
}
void print_F_POP_to_file(FILE* outfile,CHAIN chain,SEQDATA data,int **indx)
{
int j;
double *F_res;
F_res=dvector(0,data.popnum);
fprintf(outfile,"\nThe Posterior distribution of Inbreeding Coefficients:\n");
fprintf(outfile,"\t\tMean\tVar\n");
for(j=0;j<data.popnum;j++)
{
F_res[j+1]=chain.inbreed[j];
indexx(data.popnum,F_res,*indx);
}
for(j=0;j<data.popnum;j++)
{
fprintf(outfile,"Cluster %d\t%.3f\t%.3f\n",j+1,chain.inbreed[(*indx)[j+1]-1],chain.inbreed2[(*indx)[j+1]-1]-chain.inbreed[(*indx)[j+1]-1]*chain.inbreed[(*indx)[j+1]-1]);
}
free_dvector(F_res,0,data.popnum);
}
void matinverse
( std::vector< std::vector<double> > mat,
// double mat[3][3],
int order,
std::vector< std::vector<double> > &matinv
// double matinv[3][3]
)
{
int i, j;
std::vector< int > indexx(order+1);
//std::vector< std::vector<double> > lu(order+1,order+1);
//std::vector< std::vector<double> > b(order+1,2);
std::vector< std::vector<double> > lu(order+1,std::vector<double>(order+1,0.0)); //DEBUG: updated the vector<vector<double>> constructor.
std::vector< std::vector<double> > b(order+1,std::vector<double>(2,0.0)); //DEBUG: updated the vector<vector<double>> constructor.
matinv.resize(order); // rows
for (std::vector< std::vector<double> >::iterator it=matinv.begin(); it != matinv.end();++it)
it->resize(order);
for (i = 1; i <= order; i++)
{
indexx[i] = i;
for (j = 1; j <= order; j++)
lu[i][j] = mat[i-1][j-1];
}
ludecomp(lu, indexx, order);
for (j = 1; j <= order; j++)
{
for (i = 1; i <= order; i++)
{
if (i == j)
b[i][1] = 1.0;
else
b[i][1] = 0.0;
}
lubksub(lu, indexx, order, b);
for (i = 1; i <= order; i++)
matinv[i-1][j-1] = b[i][1];
}
} // procedure matinverse
void print_S_POP_to_file(FILE* outfile,CHAIN chain,SEQDATA data,int **indx)
{
int j;
double *F_res;
//print the summarized information into output file
F_res=dvector(0,data.popnum);
fprintf(outfile,"\nThe Posterior distribution of Selfing Rates:\n");
fprintf(outfile,"\t\tMean\tVar\n");
for(j=0;j<data.popnum;j++)
{
F_res[j+1]=chain.self_rates[j];
indexx(data.popnum,F_res,*indx);
}
for(j=0;j<data.popnum;j++)
{
fprintf(outfile,"Cluster %d\t%.3f\t%.3f\n",j+1,chain.self_rates[(*indx)[j+1]-1],chain.self_rates2[(*indx)[j+1]-1]-chain.self_rates[(*indx)[j+1]-1]*chain.self_rates[(*indx)[j+1]-1]);
}
free_dvector(F_res,0,data.popnum);
}
void Ctest_stream_power_model::streampower()
{
FILE *fp1;
float deltah,time,max;
int printinterval,idum,i,j,t,step;
fp1=fopen(fname,"w");
idum=-678;
//U=1; /* m/kyr */
//K=0.05; /* kyr^-1 */
printinterval=duration;
deltax=200.0; /* m */
thresh=0.58*deltax; /* 30 deg */
timestep=1; /* kyr */
//duration=100;
setupgridneighbors();
topo=matrix(1,lattice_size_x,1,lattice_size_y);
topo2=matrix(1,lattice_size_x,1,lattice_size_y);
topoold=matrix(1,lattice_size_x,1,lattice_size_y);
slope=matrix(1,lattice_size_x,1,lattice_size_y);
flow=matrix(1,lattice_size_x,1,lattice_size_y);
flow1=matrix(1,lattice_size_x,1,lattice_size_y);
flow2=matrix(1,lattice_size_x,1,lattice_size_y);
flow3=matrix(1,lattice_size_x,1,lattice_size_y);
flow4=matrix(1,lattice_size_x,1,lattice_size_y);
flow5=matrix(1,lattice_size_x,1,lattice_size_y);
flow6=matrix(1,lattice_size_x,1,lattice_size_y);
flow7=matrix(1,lattice_size_x,1,lattice_size_y);
flow8=matrix(1,lattice_size_x,1,lattice_size_y);
topovec=vector(1,lattice_size_x*lattice_size_y);
topovecind=ivector(1,lattice_size_x*lattice_size_y);
// was <=
for (i=1;i<lattice_size_x;i++)
{
// was <=
for (j=1;j<lattice_size_y;j++)
{
topo[i][j] = InputGrid->asFloat(i, j);
topo[i][j]=0.5*gasdev(&idum);
topoold[i][j]=topo[i][j];
flow[i][j]=1;
}
}
/*construct diffusional landscape for initial flow routing */
for (step=1;step<=10;step++)
{hillslopediffusioninit();
for (i=2;i<=lattice_size_x-1;i++)
for (j=2;j<=lattice_size_y-1;j++)
{topo[i][j]+=0.1;
topoold[i][j]+=0.1;}}
time=0;
while (time<duration && Process_Get_Okay(true))
{
/*perform landsliding*/
for (j=1;j<=lattice_size_y;j++)
for (i=1;i<=lattice_size_x;i++)
topovec[(j-1)*lattice_size_x+i]=topo[i][j];
indexx(lattice_size_x*lattice_size_y,topovec,topovecind);
t=0;
while (t<lattice_size_x*lattice_size_y)
{t++;
i=(topovecind[t])%lattice_size_x;
if (i==0) i=lattice_size_x;
j=(topovecind[t])/lattice_size_x+1;
if (i==lattice_size_x) j--;
avalanche(i,j);}
for (j=1;j<=lattice_size_y;j++)
for (i=1;i<=lattice_size_x;i++)
topoold[i][j]=topo[i][j];
for (j=1;j<=lattice_size_y;j++)
for (i=1;i<=lattice_size_x;i++)
fillinpitsandflats(i,j);
for (j=1;j<=lattice_size_y;j++)
for (i=1;i<=lattice_size_x;i++)
{flow[i][j]=1;
topovec[(j-1)*lattice_size_x+i]=topo[i][j];}
indexx(lattice_size_x*lattice_size_y,topovec,topovecind);
t=lattice_size_x*lattice_size_y+1;
while (t>1)
{t--;
i=(topovecind[t])%lattice_size_x;
if (i==0) i=lattice_size_x;
j=(topovecind[t])/lattice_size_x+1;
if (i==lattice_size_x) j--;
mfdflowroute(i,j);}
for (i=2;i<=lattice_size_x-1;i++)
for (j=2;j<=lattice_size_y-1;j++)
{topo[i][j]+=U*timestep;
topoold[i][j]+=U*timestep;}
/*perform upwind erosion*/
max=0;
// Potential parallel
for (i=2;i<=lattice_size_x-1;i++)
for (j=2;j<=lattice_size_y-1;j++)
{calculatealongchannelslope(i,j);
deltah=timestep*K*sqrt(flow[i][j])*deltax*slope[i][j];
topo[i][j]-=deltah;
if (topo[i][j]<0) topo[i][j]=0;
if (K*sqrt(flow[i][j])*deltax>max) max=K*sqrt(flow[i][j])*deltax;}
time+=timestep;
if (max>0.3*deltax/timestep)
{time-=timestep;
timestep/=2.0;
for (i=2;i<=lattice_size_x-1;i++)
for (j=2;j<=lattice_size_y-1;j++)
topo[i][j]=topoold[i][j]-U*timestep;}
else
{if (max<0.03*deltax/timestep) timestep*=1.2;
for (j=1;j<=lattice_size_y;j++)
for (i=1;i<=lattice_size_x;i++)
topoold[i][j]=topo[i][j];}
if ((int)time == printinterval )
{
printinterval+=printinterval;
// This was <=
for (i=1;i<lattice_size_x;i++)
{
// This was <=
for (j=1;j<lattice_size_y;j++)
{
// NOTE: Output grid size is incorrect, needs to account for 1 cell boundary
OutputGrid->Set_Value(i, j, topo[i][j]);
//fprintf(fp1,"%f\n",topo[i][j]);
}
}
}
}
}
int *bpp_chans(double bw, int mb_start_addr, int mb_end_addr, int mb_start_brd, int mb_end_brd, int *cb_id, double *aib_los, float *dfb_sram_freqs, double rf_lo) /* includefile */
{
int i, n=0, dfb_chan, logical_brd, regid, bid, nibble, *table;
double f_aib, u_or_l, f_sram, fc;
float *fmhz;
unsigned long *nridx;
double rf_lo_mhz;
nchans = (mb_end_addr/2-mb_start_addr/2+1)*(mb_end_brd-mb_start_brd+1)*4;
fmhz = (float *) malloc(nchans*sizeof(float));
table = (int *) malloc(nchans*sizeof(int));
nridx = (unsigned long *) malloc(nchans*sizeof(unsigned long));
if (-1.e6<rf_lo && rf_lo<1.e6)
rf_lo_mhz = rf_lo;
else
rf_lo_mhz = rf_lo/1.e6;
/*
Loop over (16-bit) regs per board. divide by 2's are to make them
word addresses instead of byte addresses so we can index with them.
Normal modes will be regid = 0..3, 0..7, or 4..7
*/
for (regid=mb_start_addr/2; regid<=mb_end_addr/2; regid++)
/* Loop over each board */
for (bid=mb_start_brd;bid<=mb_end_brd;bid++) {
/* Now find which LOGICAL CB we are reading */
logical_brd = -1;
for (i=0; i<MAXNUMCB; i++) {
if (bid == cb_id[i]) {
logical_brd = i;
break;
}
}
if (logical_brd == -1) error_message("bpp_chan - logical_brd not found");
/* Assumes cabling so that LO0 feeds MF0,1 which feeds leftmost CB! */
f_aib = aib_los[logical_brd];
/* Loop over 4 nibbles per reg */
for (nibble=0; nibble<4; nibble++) {
dfb_chan = dfb_chan_lookup[regid][nibble];
u_or_l = sideband_lookup[regid][nibble];
f_sram = dfb_sram_freqs[dfb_chan];
fc = f_aib + f_sram + u_or_l * bw/4.0;
if (rf_lo_mhz<1.e4) /* below 10 GHz LSB; above 10 GHz USB */
fmhz[n++]=rf_lo_mhz+800-fc/1.0e6;
else
fmhz[n++]=rf_lo_mhz+fc/1.0e6;
}
}
/* produce lookup table which gives channels in order of descending freq */
indexx(96,fmhz-1,nridx-1);
if (nchans==192) {
nifs=2;
indexx(96,fmhz+96-1,nridx+96-1);
for (i=96; i<192; i++)
nridx[i] += 96;
}
n=nchans;
for (i=0;i<nchans;i++)
table[i]=nridx[--n]-1;
nchans/=nifs;
fmid=0.5*(fmhz[table[0]]+fmhz[table[95]]);
fch1=fmhz[table[0]];
foff=fch1-fmhz[table[1]];
free(fmhz);
free(nridx);
return(table);
}
main(int argc, char **argv)
{
float tsec,fmhz,peak=1.0,sum,sumsq,sigma,sig2,mean,meansq,chi2,diff;
float *pcopy,n;
int hh,mm,i,j,row,dummy,mbins=64,obins,first=1,idx,nprof=1,display=0,rc2=0,flux=0;
unsigned long *indx;
char line[240], hash, gry[10], message[80];
strcpy(gry," ,:o*@$#");
input=stdin;
if (argc > 1) {
print_version(argv[0],argv[1]);
if (help_required(argv[1])) {
profile_help();
exit(0);
}
i=1;
while (i<argc) {
if (file_exists(argv[i])) {
input=open_file(argv[i],"r");
} else if (strings_equal(argv[i],"-frequency")) {
display=1;
} else if (strings_equal(argv[i],"-chi2")) {
rc2=1;
} else if (strings_equal(argv[i],"-sum")) {
flux=1;
} else if (strings_equal(argv[i],"-p")) {
peak=atof(argv[++i]);
} else {
sprintf(message,"command-line argument %s not recognized...",argv[i]);
error_message(message);
}
i++;
}
}
fgets(line,sizeof(line),input);
sscanf(line,"%c %lf %lf %lf %ld %lf %lf %d",&hash,
&mjdobs,&tstart,&period,&np,&fch1,&refdm,&nbins);
if (nbins > 0) {
while (!feof(input)) {
profile=(float *) malloc(sizeof(float)*nbins);
for (i=0; i<nbins; i++) {
fscanf(input,"%d %f",&dummy,&profile[i]);
}
if (rc2 || flux) {
pcopy=(float *) malloc(sizeof(float)*nbins);
for (i=0;i<nbins;i++) pcopy[i]=profile[i];
indx=(unsigned long *) malloc(sizeof(unsigned long)*nbins);
indexx((unsigned long)nbins,pcopy,indx);
if (flux) {
n=sum=sumsq=0.0;
for (i=0;i<40;i++) {
sum+=profile[i];
sumsq+=profile[i]*profile[i];
n+=1.0;
}
mean=sum/n;
meansq=sumsq/n;
sigma=sqrt(meansq-mean*mean)/sqrt(n-1.0);
n=sum=sumsq=0.0;
for (i=43;i<52;i++) {
sum+=profile[i];
sumsq+=profile[i]*profile[i];
n+=1.0;
}
printf("%f %f\n",sum/n,sigma);
exit(0);
}
n=sum=sumsq=0.0;
for (i=0;i<nbins/2;i++) {
j=indx[i];
sum+=profile[j];
sumsq+=profile[j]*profile[j];
n+=1.0;
}
mean=sum/n;
meansq=sumsq/n;
sigma=sqrt(meansq-mean*mean);
sig2=sigma*sigma;
sumsq=0.0;
for (i=0;i<nbins;i++) {
diff=profile[i]-mean;
sumsq+=diff*diff;
}
//chi2=sumsq/sig2/(float)(nbins-1);
chi2=sumsq/(float)(nbins-1);
printf("%f %f\n",period,chi2);
exit(0);
}
if (nbins>mbins) {
add_channels(profile,nbins,nbins/mbins);
nbins=mbins;
}
pmin=vmin(profile,nbins);
pmax=vmax(profile,nbins)*peak;
prng=pmax-pmin;
for (i=0; i<nbins; i++) profile[i]=19.0*(profile[i]-pmin)/prng+1.0;
for (row=20; row>=1; row--) {
for (i=0; i<nbins; i++) {
if (profile[i]>=(float) row)
printf("#");
else
printf(" ");
}
printf("\n");
}
free(profile);
nbins=0;
fgets(line,sizeof(line),input);
fgets(line,sizeof(line),input);
sscanf(line,"%c %lf %lf %lf %ld %lf %lf %d",&hash,
&mjdobs,&tstart,&period,&np,&fch1,&refdm,&nbins);
if (nbins<=0) break;
}
} else {
while (!feof(input)) {
sscanf(line,"#START %d %f %f",&nbins,&tsec,&fmhz);
if (nbins <=0) break;
profile=(float *) malloc(sizeof(float)*nbins);
for (i=0; i<nbins; i++) fscanf(input,"%d %f",&dummy,&profile[i]);
fgets(line,sizeof(line),input);
fgets(line,sizeof(line),input);
if (nbins>mbins) {
obins=nbins;
add_channels(profile,nbins,nbins/mbins);
nbins=mbins;
}
if (first) {
pmin=vmin(profile,nbins);
pmax=vmax(profile,nbins)*peak;
prng=pmax-pmin;
/*first=0;*/
}
if (display) {
printf("|%04d|%11.6f|",nprof,fmhz);
} else {
hh=(int) tsec/3600.0;
tsec-=(float) hh*3600.0;
mm=(int) tsec/60.0;
tsec-=(float) mm*60.0;
printf("|%04d|%02d:%02d:%02d|",nprof,hh,mm,(int)tsec);
}
for (i=0; i<nbins; i++) {
idx=(int) (9.0*(profile[i]-pmin)/prng);
if (idx<0) idx=0;
if (idx>9) idx=9;
putchar(gry[idx]);
}
puts("|");
free(profile);
fgets(line,sizeof(line),input);
nbins=0;
nprof++;
}
}
}
