int init_FIR(double *coeffs,int Ncoeffs,FIR_filter *FIR)
{
int i,j,N;
double anorm=0.;
N = Ncoeffs*2-1;
if (PARYTY_EVEN)
N += 1;
FIR->coeffs = double_alloc(N);
for(i=0;i<Ncoeffs;i++)
{
FIR->coeffs[i] = coeffs[i];
anorm += coeffs[i];
}
FIR->n2 = Ncoeffs;
anorm *= 2.;
anorm -= FIR->coeffs[Ncoeffs-1];
FIR->n1 = FIR->n2 - 1;
if (PARYTY_EVEN)
{
FIR->n1 += 1;
anorm += FIR->coeffs[Ncoeffs-1];
}
for(j=0; j < FIR->n2; j++)
FIR->coeffs[j] /= anorm;
for(j=0; j < FIR->n1; j++)
FIR->coeffs[j+FIR->n2] = FIR->coeffs[FIR->n1-1-j];
return 0;
}
EXT generator* generator_new
(int p_size)
{
generator* g = quix_object_alloc(generator);
if (p_size > 0) g-> parameters = double_alloc(p_size);
else g-> parameters = NULL;
return g;
}
EXT void maxlik_m2dmat_single
(maxlik_dmatrix_wk* wk, dmatrix* state)
{
marginal* margi = (marginal*) wk-> data;
int i, j, k, l, iter,
J = wk-> iterations,
N = wk-> photons,
M = wk-> photons + 1,
K = margi-> samples;
double norm = 1.0 / (K),
*quad = margi-> quad,
*h_lup = double_alloc(M),
*c_lup = double_alloc(K),
*s_lup = double_alloc(K);
loop(k,K) {
c_lup[k] = cos(margi-> phase[k]);
s_lup[k] = sin(margi-> phase[k]);
}
EXT wigner* wigner_new
(grid* g)
{
int i,
Nx = g-> x-> n_val,
Ny = g-> y-> n_val;
wigner* w = quix_object_alloc(wigner);
w-> gd = grid_copy(g);
w-> val = quix_alloc(double*,Nx);
alloc_check(w-> val,"wigner_new");
loop(i,Nx) {
w-> val[i] = double_alloc(Ny);
alloc_check(w-> val[i],"wigner_new");
}
EXT double* kirt_mc_h2neg_var
(int n, double cutoff, get_histogram callback)
{
int i;
double neg, nrm, avrg = 0.0, disp = 0.0, buff = 0.0;
double* dispersion = double_alloc(n);
loop(i,n) {
histogram* h = callback();
kirt_h2neg(h,cutoff, &neg);
disp += neg * neg;
avrg += neg;
nrm = 1.0 / (i+1);
dispersion[i] = sqrt( nrm * ( disp - nrm * avrg*avrg ) );
histogram_free(h);
}
calc_kernel(str_quake_params *eq,structopt *opt,sachdr *hd_synth,int nsac,char *itype,int nd,double *dv,double *tv, double ***G,FILE *o_log)
{
int i,j,ns,jsac,nsects,flag,flag2,ngfcomp=6,ierror=1 ;
long int nerr ;
char ori ;
float *stlats,*stlons,*dists,*azs,*bazs,*xdegs ;
double **GFs,*S,*TH,*PH,*x_conv ;
double gcarc,Ptt,twp_beg,twp_end, *ref_vm=NULL ;
double *b1,*b2,*a1,*a2,gain,dt=1.;
sachdr hdr;
make_chan_list(hd_synth,nsac,&stlats,&stlons);
/* Memory Allocations */
if (opt->ref_flag)
{
ref_vm = double_alloc(NM);
for(i=0;i<NM;i++)
ref_vm[i] = eq->vm[1][i] ;
}
dists = float_calloc(nsac) ;
azs = float_calloc(nsac) ;
bazs = float_calloc(nsac) ;
xdegs = float_calloc(nsac) ;
GFs = double_alloc2(10,__LEN_SIG__) ;/* GFs: Rrr, Rtt, Rpp, Rrt */
S = double_alloc(__LEN_SIG__) ;/* Vertical components */
TH = double_alloc(__LEN_SIG__) ;/* Radial components */
PH = double_alloc(__LEN_SIG__) ;/* Transverse components */
x_conv = double_alloc(__LEN_SIG__) ;
hdr_init(&hdr) ; /* SAC header allocation */
nsects = (eq->flow > 0.)? eq->filtorder : eq->filtorder/2 ;
b1 = double_alloc(nsects) ;
b2 = double_alloc(nsects) ;
a1 = double_alloc(nsects) ;
a2 = double_alloc(nsects) ;
/* Distance, azimuth, back-azimuth, etc */
distaz(eq->evla, eq->evlo, stlats, stlons, nsac, dists, azs, bazs, xdegs, &nerr) ;
flag = 0 ;
for(i=0;i<ngfcomp;i++) /* Main loop */
{
ns = 0 ; /* Channel counter */
for(j=0;j<ngfcomp;j++) /* Inititializing the MT components */
eq->vm[1][j] = 0. ;
eq->vm[1][i] = 1. ;
for(jsac=0;jsac<nsac;jsac++)
{
gcarc = (double)hd_synth[jsac].gcarc;
trav_time(gcarc,tv,dv,nd,&Ptt,&ierror) ;
wp_time_window(gcarc,eq->wp_win4,&twp_beg,&twp_end) ; /* Data Time Window */
flag2 = 0;
ori = hd_synth[ns].kcmpnm[2];
if ( ori == 'Z' )
fast_synth_only_Z_sub(azs[jsac],bazs[jsac],xdegs[jsac], tv,dv,nd,eq,&hdr,GFs,S);
else if ( ori == 'N' || ori == 'E' || ori == '1' || ori == '2' )
{
fast_synth_only_Hs_sub(azs[jsac],bazs[jsac],xdegs[jsac],tv,dv,nd,eq,&hdr,GFs,TH,PH);
rotate_traces(TH, PH, hd_synth[jsac].baz-hd_synth[jsac].cmpaz, hdr.npts, S) ; /*Rotating TH, PH to H*/
}
else
continue;
conv_by_stf(eq->ts,eq->hd,itype,&hdr,S,x_conv) ;/* Perform convolution */
if (flag == 0) /* Set the butterworth sos (dt must be the same for all stations) */
{
flag = 1 ;
dt = (double)hdr.delta;
if (eq->flow>0.)
bpbu2sos(eq->flow,eq->fhigh,dt,eq->filtorder,&gain,b1,b2,a1,a2);
else
lpbu2sos(eq->fhigh,dt,eq->filtorder,&gain,b1,b2,a1,a2);
}
else if (dt != (double)hdr.delta) /* Check the sampling frequency (must be uniform) */
{
fprintf(stderr, "*** ERROR: non uniform samp. period between sac files (%s)\n",hd_synth[jsac].kstnm);
fprintf(stderr," -> Exiting\n") ;
fflush(stderr);
exit(1);
}
filter_with_sos(gain,b1,b2,a1,a2,nsects,x_conv,hdr.npts) ; /* Apply sos */
flag2 = fill_kernel_G(&hdr,&(hd_synth[jsac]),Ptt,twp_beg,twp_end,x_conv,G[jsac][i],opt,o_log);
if (flag2)
{
fprintf(stderr,"*** ERROR: Incomplete green function for %s\n",hd_synth[jsac].kstnm) ;
fprintf(stderr," -> Exiting\n") ;
fflush(stderr);
exit(1);
}
hd_synth[jsac].b = hdr.b + hd_synth[jsac].o - hdr.o;
ns++;
} /*endfor nsac*/
if (nsac!=ns)
{
fprintf(stderr,"\n*** ERROR: Kernel G is incomplete (%d vs %d)\n",nsac,ns);
fprintf(stderr," -> Exiting\n");
fflush(stderr);
exit(1);
}
} /*endfor ngfcomp*/
/* Free Memory */
if (opt->ref_flag)
{
for(i=0;i<NM;i++)
eq->vm[1][i] = ref_vm[i] ;
free((void*)ref_vm);
}
free((void*)stlats) ;
free((void*)stlons) ;
free((void*)dists) ;
free((void*)xdegs) ;
free((void*)bazs) ;
free((void*)azs) ;
for(i=0;i<10;i++)
free((void*)GFs[i]);
free((void**)GFs) ;
free((void*)x_conv) ;
free((void*)S) ;
free((void*)TH) ;
free((void*)PH) ;
free((void*)a1) ;
free((void*)a2) ;
free((void*)b1) ;
free((void*)b2) ;
}
int main(int argc, char *argv[])
{
int i, j, ns, flag, flagr, ierror, nsects, nh=NDEPTHS, nd=NDISTAS ;
long int nerr ;
double **GFs,*S,*TH,*PH,*x_conv ;
double *b1, *b2, *a1, *a2, gain, dt=1.0 ;
double *tv, *dv ;
float dist,az,baz,xdeg;
char i_master[FSIZE], i_wpfilname[FSIZE], datafile[FSIZE], buf[200] ;
char o_dir[FSIZE], *o_file,stnm[9],netwk[9],cmpnm[9], khole[9];
char stacmp[]= {'Z','N','E','1','2'} ;
char itype[2]="l", ori;
str_quake_params eq ;
sachdr hd_data, hd_synt ;
FILE *i_wp ;
/* Input params */
if (argc < 5)
{
fprintf(stderr,"Error input params \n");
fprintf(stderr,"Syntax : %s i_master cmtfile i_wpinversion o_direct [stftype]\n", argv[0]);
fprintf(stderr,"stftype (optionnal) can be either:\n g (gaussian),\n q (parabolic),\n l (triangle,\n default),\n b(boxcar) or\n c (cosine)\n");
exit(1);
}
strcpy( i_master, argv[1]) ;
strcpy(i_wpfilname, argv[3]) ;
strcpy( o_dir, argv[4]) ;
get_params(i_master, &eq) ;
strcpy( eq.cmtfile, argv[2]) ;
if (argc==6)
{
if (strlen(argv[5])==1)
strcpy(itype,argv[5]);
else
{
fprintf(stderr,"Error input params \n");
fprintf(stderr,"Syntax : %s i_master cmtfile i_wpinversion o_direct [stftype]\n", argv[0]);
fprintf(stderr,"stftype (optionnal) can be either:\n g (gaussian),\n q (parabolic),\n l (triangle,\n default),\n b(boxcar) or\n c (cosine)\n");
exit(1);
}
}
/* Allocates memory */
eq.vm = double_alloc2p(2) ;
eq.vm[0] = double_calloc(6) ;
eq.vm[1] = double_calloc(6) ;
GFs = double_alloc2(10,__LEN_SIG__) ;/* GFs: Rrr, Rtt, Rpp, Rrt */
S = double_alloc(__LEN_SIG__) ;/* Vertical components */
TH = double_alloc(__LEN_SIG__) ;/* Radial components */
PH = double_alloc(__LEN_SIG__) ;/* Transverse components */
x_conv = double_alloc(__LEN_SIG__) ;
hdr_init(&hd_data) ;
hdr_init(&hd_synt) ;
nsects = (eq.flow > 0.)? eq.filtorder : eq.filtorder/2 ;
b1 = double_alloc(nsects) ;
b2 = double_alloc(nsects) ;
a1 = double_alloc(nsects) ;
a2 = double_alloc(nsects) ;
tv = double_alloc(nd); /* travel times */
dv = double_alloc(nd); /* distances */
/* Read CMTFILE */
get_cmtf(&eq,2) ;
/* Set travel time table for depth = dep */
ierror = 1 ;
trav_time_init(nh,nd,eq.evdp,dv,tv,&ierror) ;
/* Read list of data files */
flag = 0 ;
i_wp = openfile_rt(i_wpfilname, &ns);
for(i=0; i<ns; i++)
{
flagr = fscanf (i_wp, "%s", datafile) ;
fgets(buf,200,i_wp); /* end of line */
check_scan(1, flagr, i_wpfilname, i_wp) ;
rhdrsac(datafile, &hd_data, &ierror) ;
/* Calculate azimuths, back-azimuths */
dist = 0. ;
az = 0. ;
baz = 0. ;
xdeg = 0. ;
distaz(eq.evla,eq.evlo,&hd_data.stla,&hd_data.stlo,1,&dist,&az,&baz,&xdeg,&nerr) ;
ori = hd_data.kcmpnm[2];
if ( ori == 'Z' )
fast_synth_only_Z_sub(az,baz,xdeg, tv,dv,nd,&eq,&hd_synt,GFs,S);
else if ( ori == 'N' || ori == 'E' || ori == '1' || ori == '2' )
{
fast_synth_only_Hs_sub(az,baz,xdeg,tv,dv,nd,&eq,&hd_synt,GFs,TH,PH);
rotate_traces(TH, PH, baz-hd_data.cmpaz,hd_synt.npts, S) ; /*Rotating TH, PH to H*/
}
else
continue;
sscanf(hd_data.kstnm,"%s",stnm);
sscanf(hd_data.knetwk,"%s",netwk);
sscanf(hd_data.kcmpnm,"%s",cmpnm);
strcpy(khole, hd_data.khole); // It can contain blanks
for(j=0; j<5; j++)
{
if (cmpnm[2] == stacmp[j])
break;
}
if (j==5)
{
fprintf(stderr,"*** ERROR: Unknownk component %s for sta %s\n",cmpnm,stnm) ;
fprintf(stderr," -> Exiting\n") ;
fflush(stderr);
exit(1);
}
conv_by_stf(eq.ts,eq.hd,itype,&hd_synt,S,x_conv) ;/* Perform convolution */
strcpy(hd_synt.kstnm,hd_data.kstnm) ;
strcpy(hd_synt.kcmpnm,hd_data.kcmpnm) ;
strcpy(hd_synt.knetwk,hd_data.knetwk) ;
hd_synt.stla = hd_data.stla ;
hd_synt.stlo = hd_data.stlo ;
hd_synt.evla = eq.pde_evla;
hd_synt.evlo = eq.pde_evlo;
hd_synt.evdp = eq.pde_evdp;
/* Write output file 1 */
o_file = get_gf_filename(o_dir,stnm,netwk,cmpnm,khole,".complete_synth.sac") ;
wsac(o_file,&hd_synt,x_conv);
free((void*)o_file) ;
if (flag == 0) /* Set the butterworth sos (dt must be the same for all stations) */
{
flag = 1 ;
dt = (double)hd_data.delta;
if (eq.flow>0.)
bpbu2sos(eq.flow,eq.fhigh,dt,eq.filtorder,&gain,b1,b2,a1,a2);
else
lpbu2sos(eq.fhigh,dt,eq.filtorder,&gain,b1,b2,a1,a2);
}
else if ((int)(dt*1000+0.5) != (int)((double)hd_data.delta*1000+0.5))
{
fprintf(stderr, "ERROR: non uniform samp. period between sac files, file : %s\n",datafile);
exit(1);
}
filter_with_sos(gain,b1,b2,a1,a2,nsects,x_conv,hd_synt.npts) ; /* Apply sos */
/* Write output file 2 */
o_file = get_gf_filename(o_dir,stnm,netwk,cmpnm,khole,".complete_synth.bp.sac") ;
printf("Writing sac file : %s\n",o_file) ;
wsac(o_file,&hd_synt,x_conv);
free((void*)o_file) ;
}
fclose(i_wp);
free((void*)S);
free((void*)TH);
free((void*)PH);
for(j=0; j<10; j++)
free((void*)GFs[j]);
free((void**)GFs);
free((void*)x_conv);
free((void*)b1);
free((void*)b2);
free((void*)a1);
free((void*)a2);
return 0;
}
int main(int argc, char **argv)
{
int i,j,flag,jchan,nchans,ngfcomp=6,nsects,ierror=1 ;
int tapering=NON,nh=NDEPTHS,nd=NDISTAS ;
long int nerr = 0 ;
char stat_file[FSIZE],i_master[FSIZE],path[FSIZE];
char sacfile[FSIZE],itype[2], ori;
char *gfcomp[]={"rr","tt","pp","rt","rp","tp"};
char **stats, **nets, **cmps, **locs ;
float *stlats,*stlons,*dists,*cmpazs, *azs,*bazs,*xdegs ;
double **GFs,*S,*TH,*PH,*x_conv,*tv,*dv ;
double *b1,*b2,*a1,*a2,gain,dt=1.;
str_quake_params eq;
sachdr hdr;
/* Set input parameters */
get_params(argc, argv, stat_file, itype, i_master, &eq, &tapering) ;
get_cmtf(&eq, 1) ;
/* Allocations */
GFs = double_alloc2(10,__LEN_SIG__);/* GFs: Rrr, Rtt, Rpp, Rrt */
TH = double_alloc(__LEN_SIG__) ; /* Radial components */
PH = double_alloc(__LEN_SIG__) ; /* Transverse components */
S = double_alloc(__LEN_SIG__) ; /* work copy */
x_conv = double_alloc((int)__LEN_SIG__) ;
eq.vm = double_alloc2p(2) ;
eq.vm[1] = double_alloc(6) ;
eq.vm[0] = double_alloc(6) ;
hdr_init(&hdr) ; /* SAC header allocation */
nsects = (eq.flow > 0.)? eq.filtorder : eq.filtorder/2 ;
b1 = double_alloc(nsects) ;
b2 = double_alloc(nsects) ;
a1 = double_alloc(nsects) ;
a2 = double_alloc(nsects) ;
tv = double_alloc(nd); /* travel times */
dv = double_alloc(nd); /* distances */
/* Reading CMTSOLUTION and STAT_FILE */
nchans = r_scr_dat_fil_list(stat_file, &stats, &nets, &cmps, &locs, &stlats, &stlons,&cmpazs) ;
dists = float_calloc(nchans) ;
azs = float_calloc(nchans) ;
bazs = float_calloc(nchans) ;
xdegs = float_calloc(nchans) ;
/* Distance, azimuth, back-azimuth, etc */
distaz(eq.evla, eq.evlo, stlats, stlons, nchans, dists, azs, bazs, xdegs, &nerr) ;
/* Set travel time table for depth = dep */
trav_time_init(nh,nd,eq.evdp,dv,tv,&ierror);
/* Excitation kernels calculation */
crea_dir(eq.gf_dir) ;
flag = 0 ;
for(i=0;i<ngfcomp;i++)
{
printf("**************************************\n");
printf("Computing synthetics for M_%s...\n",gfcomp[i]);
strcpy(path,eq.gf_dir) ;
strcat(path,"gf_") ;
strcat(path,gfcomp[i]) ;
crea_dir(path) ;
strcat(path,"/") ;
for(j=0;j<ngfcomp;j++)/* Inititializing the MT components */
eq.vm[1][j] = 0. ;
eq.vm[1][i] = 1. ;
for(jchan=0;jchan<nchans;jchan++) /* Computing kernels for MT component #i at each station */
{
flag = 0;
/* Computing Z, TH, PH */
ori = cmps[jchan][2];
printf("%-5s", stats[jchan]) ;
if ( ori == 'Z' )
{
fast_synth_only_Z_sub(azs[jchan], bazs[jchan], xdegs[jchan], tv,dv,nd,&eq,&hdr,GFs,S);
hdr.cmpaz = 0.;
hdr.cmpinc = 0.;
}
else if ( ori == 'N' || ori == 'E' || ori == '1' || ori == '2' )
{
fast_synth_only_Hs_sub(azs[jchan], bazs[jchan], xdegs[jchan],tv,dv,nd,&eq,&hdr,GFs,TH,PH);
rotate_traces(TH, PH, bazs[jchan]-cmpazs[jchan], hdr.npts, S) ; /*Rotating TH, PH to H*/
hdr.cmpaz = cmpazs[jchan];
hdr.cmpinc = 90.;
}
else
continue;
if (tapering == YES)
taper_one_trace(S,&hdr);
strcpy(sacfile,path) ; /* Save Raw GF SAC */
strcat(sacfile,stats[jchan]) ;
strcat(sacfile,".") ;
strcat(sacfile,nets[jchan]) ;
strcat(sacfile,".") ;
strcat(sacfile,cmps[jchan]) ;
strcat(sacfile,".") ;
strcat(sacfile,locs[jchan]) ;
strcat(sacfile,".SAC") ;
save_gf_sac(sacfile,stats[jchan],nets[jchan],cmps[jchan],locs[jchan],&stlats[jchan],&stlons[jchan],&hdr,S) ;
conv_by_stf(eq.ts,eq.hd,itype,&hdr,S,x_conv) ;/* Perform convolution */
if (flag == 0) /* Set the butterworth sos (dt must be the same for all stations) */
{
flag = 1 ;
dt = (double)hdr.delta ;
if (eq.flow>0.)
bpbu2sos(eq.flow,eq.fhigh,dt,eq.filtorder,&gain,b1,b2,a1,a2);
else
lpbu2sos(eq.fhigh,dt,eq.filtorder,&gain,b1,b2,a1,a2);
}
else if (dt != (double)hdr.delta)
{
fprintf(stderr, "ERROR: non uniform samp. period between sac files, file : %s\n",sacfile);
fprintf(stderr, "%f != %f\n", dt, hdr.delta);
exit(1);
}
strcat(sacfile,".sac") ; /* Save SAC after STF convolution */
save_gf_sac(sacfile,stats[jchan],nets[jchan],cmps[jchan],locs[jchan],&stlats[jchan],&stlons[jchan],&hdr,x_conv) ;
filter_with_sos(gain,b1,b2,a1,a2,nsects,x_conv,hdr.npts) ; /* Apply sos */
strcat(sacfile,".bp") ; /* Save SAC after bandpass filtering */
save_gf_sac(sacfile,stats[jchan],nets[jchan],cmps[jchan],locs[jchan],&stlats[jchan],&stlons[jchan],&hdr,x_conv) ;
}
printf("\n");
}
/* Freeing memory */
free((void*)b1) ;
free((void*)b2) ;
free((void*)a1) ;
free((void*)a2) ;
free((void*)S) ;
free((void*)PH);
free((void*)TH);
free((void*)x_conv);
for(i=0; i<10; i++)
free((void *)GFs[i]) ;
free((void**)GFs) ;
free((void*)eq.vm[0]) ;
free((void*)eq.vm[1]) ;
free((void**)eq.vm) ;
free((void*)dists) ;
free((void*)azs) ;
free((void*)bazs) ;
free((void*)xdegs) ;
for (i=0;i< nchans;i++)
{
free((void*)stats[i]) ;
free((void*)nets[i]) ;
}
free((void**)stats) ;
free((void**)nets) ;
free((void*)stlats) ;
free((void*)stlons) ;
free((void*)cmpazs) ;
if(tapering == YES)
{
free((void*)tv);
free((void*)dv);
}
printf("\n");
return 0;
}
