├── README.md ├── example ├── 199807191558.s06.2.sac ├── 199807191558.s06.3.sac ├── 199807191558.s38.2.sac ├── 199807191558.s38.3.sac └── .gitignore ├── .gitignore ├── betai.c ├── sac_help.h ├── rmeantaper.c ├── gsl_seis.h ├── Makefile ├── invfisher.c ├── README ├── multisplit.h ├── sac_help.c ├── sac.h ├── gsl_seis.c ├── split_cor.c ├── scripts └── show-overview-SKS.gmt ├── LICENSE ├── error_stack.c └── multisplit.c /README.md: -------------------------------------------------------------------------------- 1 | multisplit 2 | ========== 3 | 4 | measure shear wave splitting from SAC files 5 | -------------------------------------------------------------------------------- /example/199807191558.s06.2.sac: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ftilmann/multisplit/HEAD/example/199807191558.s06.2.sac -------------------------------------------------------------------------------- /example/199807191558.s06.3.sac: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ftilmann/multisplit/HEAD/example/199807191558.s06.3.sac -------------------------------------------------------------------------------- /example/199807191558.s38.2.sac: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ftilmann/multisplit/HEAD/example/199807191558.s38.2.sac -------------------------------------------------------------------------------- /example/199807191558.s38.3.sac: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ftilmann/multisplit/HEAD/example/199807191558.s38.3.sac -------------------------------------------------------------------------------- /example/.gitignore: -------------------------------------------------------------------------------- 1 | *.ps 2 | *.hdr 3 | *.grd 4 | *.xy 5 | *.description 6 | *.bin 7 | *.cont 8 | *.gmt 9 | *.txt 10 | .gmtcommands* 11 | .gmtdefaults* 12 | .gmt 13 | gmt.history 14 | gmt.conf 15 | .gmt_bb_info 16 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # Compiled Object files 2 | *.slo 3 | *.lo 4 | *.o 5 | *.obj 6 | 7 | # Compiled Dynamic libraries 8 | *.so 9 | *.dylib 10 | *.dll 11 | 12 | # Compiled Static libraries 13 | *.lai 14 | *.la 15 | *.a 16 | *.lib 17 | 18 | # Executables 19 | *.exe 20 | *.out 21 | *.app 22 | multisplit 23 | error_stack 24 | split_cor 25 | 26 | 27 | -------------------------------------------------------------------------------- /betai.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | 5 | /* wrapper routine for gsl_betai function using NR syntac */ 6 | double betai(double a, double b, double x) 7 | { 8 | if (x < 0.0 || x > 1.0) { 9 | fprintf(stderr,"Numerical error: Bad x (%f) in routine betai\n",x); 10 | exit(10); 11 | } 12 | return gsl_sf_beta_inc(a,b,x); 13 | } 14 | -------------------------------------------------------------------------------- /sac_help.h: -------------------------------------------------------------------------------- 1 | #include 2 | #include "sac.h" 3 | typedef struct sac sachdr; 4 | 5 | int make_abort(int hello); 6 | int check_consistency(sachdr *hdr1, sachdr *hdr2, unsigned int mode); 7 | void make_rhs(sachdr **hdr1, gsl_vector_float **data1, sachdr **hdr2, gsl_vector_float **data2); 8 | void read_seis_file(char *fname, sachdr **hdr, gsl_vector_float **data); 9 | void write_seis_file(char *fname, sachdr *hdr, gsl_vector_float *data); 10 | 11 | /* Modes for check_consistency */ 12 | #define CONSISTENCY_VERBOSE 1<<1 13 | #define CONSISTENCY_STATION 1<<2 14 | #define CONSISTENCY_EVENT 1<<3 15 | #define CONSISTENCY_BEGIN 1<<4 16 | -------------------------------------------------------------------------------- /rmeantaper.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | 4 | void rmean_and_taper(float data[], long int len, float del, int rmean, float taperlen) { 5 | long i; 6 | float mean,fac; 7 | long talen; 8 | 9 | /* fprintf(stderr,"rmean_and_taper %d %f\n",rmean,taperlen); */ 10 | if (rmean) { 11 | mean=0; 12 | for (i=0; i0.0) { 19 | /* fprintf(stderr,"Taper\n"); */ 20 | talen=(unsigned long int)(taperlen/del); 21 | if (talen>len/2) 22 | talen=len/2; 23 | for (i=0; i 2 | #include 3 | #include 4 | 5 | 6 | int gsl_float_rotate(gsl_vector_float *hn, gsl_vector_float *he, float angle); 7 | void gsl_float_write_pmp(FILE *fid,gsl_vector_float *data_x, gsl_vector_float *data_y); 8 | void gsl_float_write_timeseries(FILE *fid,gsl_vector_float *data, float beg, float delta); 9 | 10 | double gsl_df_polarisation(gsl_vector_float *data_n, gsl_vector_float *data_e, double *lin); 11 | double gsl_df_normsqr(gsl_vector_float *a); 12 | double gsl_df_dotprod(gsl_vector_float *a, gsl_vector_float *b); 13 | void gsl_df_corrshift(gsl_vector *c, gsl_vector_float *x1, long beg1, gsl_vector_float *x2, long beg2, long len, long maxlag, int mode); 14 | 15 | void gsl_rotcr(gsl_vector *cor_mat[2][2], double azimuth); 16 | 17 | long nxtpwr2( long n) ; 18 | 19 | /* modes gos gsl_df_corrshift */ 20 | #define GSL_CORRSHIFT_PARTITION 0 /* partition shift between both vectors */ 21 | #define GSL_CORRSHIFT_ONE 1 /* only shift the first sequence */ 22 | #define GSL_CORRSHIFT_TWO 2 /* only shift the second sequence */ 23 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | # Minimal Makefile 2 | #CFLAGS=-O 3 | CC=gcc 4 | 5 | # Adapt to location of SAC distribution 6 | SACDIR=/usr/local/sac 7 | SACLIB = -lsacio 8 | CFLAGS = -g -I$(SACDIR)/include -L$(SACDIR)/lib 9 | 10 | LIBS = 11 | GSLLIBS = -lgsl -lgslcblas -lm 12 | 13 | # Executables will be placed here (NB: no separate installation, final link directly generates executable here) 14 | BIN=$(HOME)/bin/$(ARCH) 15 | #BIN = . 16 | 17 | EXEC = multisplit split_cor error_stack 18 | SCRIPTS = scripts/show-overview-SKS.gmt 19 | 20 | .PHONY: install clean 21 | default: $(EXEC) 22 | 23 | multisplit: multisplit.o rmeantaper.o gsl_seis.o invfisher.o betai.o sac_help.o 24 | $(CC) $(CFLAGS) -o $@ $^ $(SACLIB) $(GSLLIBS) $(LIBS) 25 | 26 | split_cor: split_cor.o gsl_seis.o sac_help.o 27 | $(CC) $(CFLAGS) -o $@ $^ $(SACLIB) $(GSLLIBS) $(LIBS) 28 | 29 | error_stack: error_stack.o invfisher.o betai.o 30 | $(CC) $(CFLAGS) -o $@ $^ $(SACLIB) $(GSLLIBS) $(LIBS) 31 | # betacf.o gammln.o nrutil.o 32 | 33 | gsl_seis.o: gsl_seis.h 34 | 35 | multisplit.o: multisplit.h 36 | 37 | clean: 38 | rm *.o $(EXEC) 39 | 40 | install: $(EXEC) $(SCRIPTS) 41 | install $(EXEC) $(BIN) 42 | install $(SCRIPTS) $(BIN) 43 | 44 | 45 | -------------------------------------------------------------------------------- /invfisher.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | 4 | #define MAX(a,b) ((a)>(b)?(a):(b)) 5 | 6 | double betai(double a, double b, double x); 7 | 8 | double invfisher(double nu1,double nu2,double conf) { 9 | /* note this routine is transliterated from MATLAB function */ 10 | /* function e95=invfisher(nu1,nu2,conf) 11 | % invfisher calculates inverse Fisher distribution 12 | % e95=invfisher(nu1,nu2,x) 13 | % Perform bisection to find the the x confidence interval for 14 | % degrees of freedom nu1,nu1 15 | % x defaults to 0.95 16 | % 17 | % Taken from M.Bostock, T.Hearn's code erranal.m for splitting analysis 18 | % Generalised by F Tilmann 19 | */ 20 | int jmax=40,j; 21 | double x1,x2,f,fmid,rtbis,dx,xmid; 22 | double xacc=0.01*nu2/(nu2+nu1*200.0); 23 | /*% 24 | % Bracket the root between values of F = 1 and 100. Note 25 | % that we are determining the f(1-a) confidence region 26 | % a=0.05. */ 27 | x1=nu2/(nu2+nu1*10000.0); 28 | f=(1.0-betai(nu2/2.0,nu1/2.0,x1))-conf; 29 | x2=nu2/(nu2+nu1*1.0); 30 | fmid=(1.0-betai(nu2/2.0,nu1/2.0,x2))-conf; 31 | if (f*fmid >= 0) { 32 | fprintf(stderr,"ERROR invfisher: root must be bracketed"); 33 | return(-1); 34 | /* exit(10); */ 35 | } 36 | if (f < 0) { 37 | rtbis=x1; 38 | dx=x2-x1; 39 | } else { 40 | rtbis=x2; 41 | dx=x1-x2; 42 | } 43 | j=0; 44 | while (j < jmax) { 45 | dx=dx*0.5; 46 | xmid=rtbis+dx; 47 | fmid=(1.0-betai(nu2/2.0,nu1/2.0,xmid))-conf; 48 | if (fmid <= 0) 49 | rtbis=xmid; 50 | j=j+1; 51 | if ( MAX(dx,-dx) < xacc || fmid == 0) 52 | break; 53 | } 54 | if (j>jmax) 55 | fprintf(stderr,"WARNING invfisher: root finding did not converge. Error estimates likely to be meaningless"); 56 | return (nu2/xmid-nu2)/nu1; 57 | } 58 | -------------------------------------------------------------------------------- /README: -------------------------------------------------------------------------------- 1 | Multisplit package for shear wave splitting studies 2 | 3 | 4 | Author: Frederik Tilmann 5 | (for bug reports and patches tilmann---gfz-potsdam.de) 6 | 7 | License: GPL3.0 8 | 9 | Requirements: SAC libraries (tested under Version 101.5c) - 10 | GMT (tested under 4.5) 11 | 12 | Installation: 13 | 14 | Unpack 15 | tar -z -xvf multisplit.tgz 16 | 17 | Compile 18 | The gsl packages are needed. On Ubuntu (12.04 LTS) and probably other versions these can be made available by executing 19 | sudo apt-get install libgsl0-dev libgsl0ldbl libgsl0-dev libgsl0ldbl 20 | 21 | Adapt Makefile for location of binary files and location of SAC libraries and include files 22 | make 23 | 24 | Description: 25 | Use option '-h' to get usage information 26 | 27 | MULTISPLIT Measure single layer splitting parameters from two (or four) horizontal component waveforms in SAC format 28 | Measure (note that not all functionality listed in the usage information is implemented) 29 | SPLIT_COR Apply inverse or forward single-layer splitting operator to two horizontal components 30 | ERROR_STACK stack error surfaces (method of Wolfe and Silver (1998) 31 | 32 | Example: 33 | Go to sub-directory example 34 | SKS splitting (Null-splitting), Minimum Transverse Energy Method: 35 | multisplit -v -mintransverse -single 1 0.05 2.5 -data 199807191558.s06.2.sac 199807191558.s06.3.sac -taper 1.0 -winp a f 36 | SKS splitting (Null-splitting), Minimum Eigenvalue Method: 37 | multisplit -v -minevalue -single 1 0.05 2.5 -data 199807191558.s06.2.sac 199807191558.s06.3.sac -taper 1.0 -winp a f 38 | SKS splitting 39 | multisplit -v -mintransverse -single 1 0.05 2.5 -data 199807191558.s38.2.sac 199807191558.s38.3.sac -taper 1.0 -winp a f -grd -gmt 40 | multisplit -v -minevalue -single 1 0.05 2.5 -data 199807191558.s38.2.sac 199807191558.s38.3.sac -taper 1.0 -winp a f -grd -gmt 41 | 42 | Reference station method, using s06 as reference station: 43 | multisplit -v -correl 4.0 199807191558.s06.2.sac 199807191558.s06.3.sac -single 5 0.1 2.0 -data 199807191558.s38.2.sac 199807191558.s38.3.sac -winp a f -gmt 44 | 45 | Splitting correction: 46 | split_cor -data 199807191558.s38.2.sac 199807191558.s38.3.sac -split 94 1.75 -app _splitcor 47 | 48 | 49 | References: 50 | Reference station method (Option -correl): 51 | Eken T. and Tilmann, F. The use of direct shear waves in quantifying seismic anisotropy: exploiting regional arrays, submitted to BSSA: 52 | 53 | SKS splitting methods: 54 | Silver, P. G. & Chan, W. W., 1991, Shear wave splitting and subcontinental mantle deformation, J. Geophys. Res., , 96, 16429-16454 55 | 56 | Error stacking: 57 | Wolfe, C. J., and P. Silver (1998). Seismic anisotropy of oceanic mantle: 58 | Shear wave splitting methodologies and observations, J. Geophys. 59 | Res. 103, no. B1, 749–771. 60 | 61 | 62 | If you use this code for SKS measurements, please note that the following paper describes an example usage of this code: 63 | Eken, T.; Tilmann, F.; Mechie, J.; Zhao, W.; Kind, R.; Su, H.; Xue, G. & Karplus, M., 2013, Seismic Anisotropy from SKS splitting beneath Northeastern Tibet, Bul. Seism. Soc. Am., 103, 3362-3371 , doi:10.1785/0120130054 64 | 65 | 66 | 67 | -------------------------------------------------------------------------------- /multisplit.h: -------------------------------------------------------------------------------- 1 | #include 2 | #include "gsl_seis.h" 3 | #include "sac.h" 4 | 5 | #define SQR(a) ((a)*(a)) 6 | #define CUB(a) ((a)*(a)*(a)) 7 | #define ABS2(a,b) ((a)*(a)+(b)*(b)) 8 | #define ABS(real,im) (sqrt((real)*(real)+(im)*(im))) 9 | #define ARG(real,im) (atan2((im),(real))) 10 | 11 | #define F_EQ(a,b) (2.*fabs((a)-(b))/((a)+(b)+10*TOLERANCE)(b)?(a):(b)) 15 | 16 | /* Note: my system at home does not appear to have the round function */ 17 | #define ROUND(a) (floor((a)+0.5)) 18 | 19 | /* PER(per,x) return a value v with range 0..per-1 such that v+n*per=x (n an integer). It only works for integers */ 20 | #define PER(per,x) ( x<0 ? (x + per*(1+(-x)/per)) : (x%per) ) 21 | 22 | #define PI 3.14159265358979323846 23 | #define TOLERANCE 1e-5 24 | #ifndef NAN 25 | #define NAN (strtod("NAN",NULL)) 26 | #endif 27 | 28 | #define CMAT_MEMCPY(dest,src) { \ 29 | gsl_vector_memcpy(dest[0][0],src[0][0]); \ 30 | gsl_vector_memcpy(dest[0][1],src[0][1]); \ 31 | gsl_vector_memcpy(dest[1][0],src[1][0]); \ 32 | gsl_vector_memcpy(dest[1][1],src[1][1]); } 33 | 34 | #define CMAT_ALLOCATE(mat,length) { \ 35 | mat[0][0]=gsl_vector_alloc(length); \ 36 | mat[0][1]=gsl_vector_alloc(length); \ 37 | mat[1][0]=gsl_vector_alloc(length); \ 38 | mat[1][1]=gsl_vector_alloc(length);} 39 | 40 | #define CMAT_FREE(mat) { \ 41 | gsl_vector_free(mat[0][0]); \ 42 | gsl_vector_free(mat[0][1]); \ 43 | gsl_vector_free(mat[1][0]); \ 44 | gsl_vector_free(mat[1][1]); } 45 | 46 | #define TRUE 1 47 | #define FALSE 0 48 | 49 | #define WRITEVEC(name,vec) { {\ 50 | FILE *vectorout;\ 51 | vectorout=fopen(name,"w");\ 52 | if (!vectorout) { \ 53 | sprintf(abort_str,"Cannot open %s for output.",name);\ 54 | abort_msg(abort_str);\ 55 | }\ 56 | gsl_vector_fprintf(vectorout,vec,"%f");\ 57 | fclose(vectorout); }\ 58 | } 59 | 60 | #define WRITEVECFLOAT(name,vec) { {\ 61 | FILE *vectorout;\ 62 | vectorout=fopen(name,"w");\ 63 | if (!vectorout) { \ 64 | sprintf(abort_str,"Cannot open %s for output.",name);\ 65 | abort_msg(abort_str);\ 66 | }\ 67 | gsl_vector_float_fprintf(vectorout,vec,"%f");\ 68 | fclose(vectorout); }\ 69 | } 70 | 71 | 72 | 73 | typedef int logical; 74 | 75 | 76 | /* Method specific parameters */ 77 | typedef struct { 78 | float maxshift; 79 | sachdr *hdr_ref1; 80 | gsl_vector_float *data_ref1; 81 | 82 | sachdr *hdr_ref2; 83 | gsl_vector_float *data_ref2; 84 | } correl_params; 85 | 86 | /* Model specific parameters */ 87 | typedef struct { 88 | float faststep; 89 | float fastmin; 90 | float fastmax; 91 | float timemin; 92 | float timemax; 93 | float timestep; 94 | } hor_split; 95 | 96 | typedef struct { 97 | hor_split top; /* splitting parameters of top layer */ 98 | hor_split bot; /* splitting parameters of bottom layer */ 99 | } split_params; 100 | 101 | typedef struct { 102 | char phase_start[9]; 103 | char phase_end[9]; 104 | float offset_start; 105 | float offset_end; 106 | float taper ; /* if taper<0 then do not taper but move windows through data */ 107 | } analysis_window; 108 | 109 | /* Global parameters */ 110 | typedef struct { 111 | /* Input data */ 112 | sachdr *hdr_hor1; 113 | gsl_vector_float *data_hor1; 114 | sachdr *hdr_hor2; 115 | gsl_vector_float *data_hor2; 116 | /* Method */ 117 | int method ; 118 | union { 119 | correl_params cor_par; 120 | } method_q; 121 | /* Model space definition */ 122 | int model; 123 | union { 124 | split_params split_par; 125 | } model_q; 126 | /* Window definition */ 127 | analysis_window window; 128 | /* Modifiers */ 129 | int make_grd ; /* MAKE_GRD : create GMT grid files MAKE_GMT: create and execute full GMT scripts */ 130 | float dof_s ; /* degrees of freedom per second */ 131 | char root[128] ; /* Root for filename */ 132 | } ms_params ; 133 | 134 | /* METHOD IDENTIFIERS */ 135 | #define MINEVALUE 1 136 | #define MINTRANSVERSE 2 137 | #define CONV 3 138 | #define CORREL 4 139 | 140 | /* MODEL IDENTIFIERS */ 141 | #define SINGLE_HOR_SPLIT 1 142 | #define DOUBLE_HOR_SPLIT 2 143 | 144 | /* make_grd identifieres */ 145 | #define MAKE_GRD 1 146 | #define MAKE_GMT 2 147 | #define MAKE_GMT5 (2|4) /* note that MAKE_GMT5 implies MAKE_GMT (second bit set) */ 148 | 149 | /* Function protoptypes */ 150 | void abort_msg(char *); 151 | void double_split_sks(int method, hor_split *hsplit_top, hor_split *hsplit_bot, gsl_vector_float *north, gsl_vector_float *east, long beg, long len, float delta, float baz, gsl_vector *res_energy_doublelayer ); 152 | void err_single_split_sks(ms_params *par, gsl_matrix *m_res_energy, gsl_vector_float *north, gsl_vector_float *east,long beg, long len, long mod_par, char *phase, gsl_matrix *m_aux1, gsl_matrix *m_aux2, gsl_vector_float *ref_north, gsl_vector_float *ref_east, long refbeg); 153 | void err_double_split_sks(ms_params *par, gsl_vector *res_energy_doublelayer, gsl_vector_float *north, gsl_vector_float *east,long beg, long len, char *phase); 154 | float find_phase(sachdr *hdr,char *phase_name, char *phase_out); 155 | gsl_vector_float *find_window(sachdr *hdr, gsl_vector_float *data, analysis_window *win, float maxlag, long *beg, long *len, char *phase); 156 | double invfisher(double nu1,double nu2,double conf); 157 | void make_event_name(char *string, sachdr *hdr, int mode); 158 | FILE *open_for_write(char *root,char *extension); 159 | void parse(int argc, char **argv, ms_params *par); 160 | void single_split_correl(int method, hor_split *hsplit, float maxshift, gsl_vector_float *nspl, gsl_vector_float *espl, long beg, gsl_vector_float *ref_north, gsl_vector_float *ref_east, long ref_beg, long len, float delta, gsl_matrix *m_res_energy, gsl_matrix *m_delay, gsl_matrix *m_alpha); 161 | void single_split_sks(int method, hor_split *hsplit, gsl_vector_float *north, gsl_vector_float *east, long beg, long len, float delta, float baz, gsl_matrix *res_energy, gsl_matrix *pol); 162 | void usage(char *cmd); 163 | void warn_msg(char *); 164 | 165 | 166 | /* Modes for make_event_name */ 167 | #define EVN_YYJJJHHMM 1 168 | 169 | /* External function prototypes */ 170 | void rmean_and_taper(float data[], long int len, float del, int rmean, float taperlen); 171 | double gammln(double xx); 172 | double betai(double a, double b, double x); 173 | double betacf(double a, double b, double x); 174 | -------------------------------------------------------------------------------- /sac_help.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | 5 | #include "sac_help.h" 6 | 7 | #define F_EQ(a,b) (2.*fabs((a)-(b))/((a)+(b)+10*TOLERANCE)delta,hdr2->delta)) { 38 | /* if (hdr1->delta != hdr2->delta ) { */ 39 | if (verb) 40 | fprintf(stderr,"Inconsistency in sampling rates: %f vs %f\n",hdr1->delta,hdr2->delta); 41 | return(1); 42 | } 43 | if (mode & CONSISTENCY_EVENT) { 44 | if ( !F_EQ(hdr1->evla,hdr2->evla) 45 | || !F_EQ(hdr1->evlo,hdr2->evlo) 46 | || !F_EQ(hdr1->evdp,hdr2->evdp) ) { 47 | if (verb) 48 | fprintf(stderr,"Inconsistency in event location: (%f,%f,%f) vs (%f,%f,%f)\n", 49 | hdr1->evla,hdr1->evlo,hdr1->evdp, 50 | hdr2->evla,hdr2->evlo,hdr2->evdp); 51 | return(1); 52 | } 53 | if ( hdr1->nzyear != hdr2->nzyear 54 | || hdr1->nzjday != hdr2->nzjday 55 | || hdr1->nzhour != hdr2->nzhour 56 | || hdr1->nzmin != hdr2->nzmin 57 | || hdr1->nzsec != hdr2->nzsec ) { 58 | if (verb) 59 | fprintf(stderr,"Inconsistency in reference time\n"); 60 | return(1); 61 | } 62 | } 63 | if (mode & CONSISTENCY_STATION) { 64 | if ( strncmp(hdr1->knetwk,hdr2->knetwk,8) 65 | || strncmp(hdr1->kstnm,hdr2->kstnm,8) 66 | || strncmp(hdr1->khole,hdr2->khole,8) ) { 67 | if (verb) 68 | fprintf(stderr,"Inconsistency in station information (%.8s,%.8s,%.8s) vs (%.8s,%.8s,%.8s)\n", 69 | hdr1->knetwk,hdr1->kstnm,hdr1->khole, 70 | hdr2->knetwk,hdr2->kstnm,hdr2->khole); 71 | return(1); 72 | } 73 | } 74 | if (mode & CONSISTENCY_BEGIN) { 75 | if ( !F_EQ(hdr1->b,hdr2->b)) { 76 | if (verb) 77 | fprintf(stderr,"Inconsistency in seismogram begin time: %f vs %f\n", 78 | hdr1->b,hdr2->b); 79 | return(1); 80 | } 81 | } 82 | 83 | return(0); 84 | } 85 | 86 | void make_rhs(sachdr **hdr1, gsl_vector_float **data1, sachdr **hdr2, gsl_vector_float **data2) { 87 | /* checks that horizontal azimuths differ by 90 degree and exit with an error message if they are not 88 | . If the second component is not to the right of the first component, exchange the components */ 89 | sachdr *dummy; 90 | gsl_vector_float *vector_dummy; 91 | if (F_EQ(fmod((*hdr1)->cmpaz-(*hdr2)->cmpaz+180,360)-180,90)) { 92 | /* components form LHS system, need to mirror one of them */ 93 | warn_msg("Horizontal components form LHS system. Exchanging components.\n"); 94 | dummy=*hdr1; 95 | *hdr1=(*hdr2); 96 | (*hdr2)=dummy; 97 | vector_dummy=*data1; 98 | *data1=*data2; 99 | *data2=vector_dummy; 100 | } 101 | else if (!F_EQ(fmod((*hdr2)->cmpaz-(*hdr1)->cmpaz+180,360)-180,90)) { 102 | sac_help_abort_msg("Horizontal components not perpendicular"); 103 | } 104 | } 105 | 106 | void read_seis_file(char *fname, sachdr **hdr, gsl_vector_float **data) { 107 | /* read header and data of SAC file. Function allocates spaces for header and data 108 | Input: char *fname File name of sac file 109 | 110 | Ouput: sachdr *hdr Sac header structure 111 | gsl_vector_float *data Vector containing seismic data 112 | 113 | 114 | Note: this function reads the sac header directly without using 115 | SAC library functions. It might not work with future versions 116 | of SAC files 117 | */ 118 | FILE *in; 119 | float dummy; 120 | if((in=fopen(fname,"rb"))==NULL) { 121 | fprintf(stderr,"Error opening SAC file %s.",fname); sac_help_abort_msg(""); 122 | } 123 | 124 | *hdr=(sachdr *)malloc(sizeof(sachdr)); 125 | 126 | if (fread(*hdr,sizeof(sachdr),1,in)!=1) { 127 | fprintf(stderr,"Error reading SAC file %s.",fname); sac_help_abort_msg(""); 128 | } 129 | /* Check that this is really a SAC file */ 130 | if((*hdr)->internal2 != -12345. || (*hdr)->internal3 != -12345. || (*hdr)->nvhdr > 6) { 131 | fprintf(stderr,"%s does not appear to be a SAC file or has wrong byte order.",fname); 132 | sac_help_abort_msg(""); 133 | } 134 | /* VRBD(printf("DEBUG: Reading sacfile %s length %d, year %d,nvhdr %d \n",fname,(*hdr)->npts,(*hdr)->nzyear,fname,(*hdr)->nvhdr)); */ 135 | *data=gsl_vector_float_alloc((*hdr)->npts); /* NOTE: gsl error routine takes care off files which are too short */ 136 | gsl_vector_float_fread(in,*data); 137 | fread(&dummy,sizeof(float),1,in); 138 | if (!feof(in)) { 139 | fprintf(stderr,"File length too long for NPTS value %d in sac file %s",(*hdr)->npts,fname); 140 | gsl_vector_float_free(*data); 141 | sac_help_abort_msg(""); 142 | } 143 | } 144 | 145 | void write_seis_file(char *fname, sachdr *hdr, gsl_vector_float *data) { 146 | /* read header and data of SAC file. 147 | Input: char *fname File name of sac file 148 | 149 | sachdr *hdr Sac header structure 150 | gsl_vector_float *data Vector containing seismic data 151 | 152 | 153 | Note: this function writes the sac header directly without using 154 | SAC library functions. It might not work with future versions 155 | of SAC files 156 | */ 157 | FILE *out; 158 | float dummy; 159 | if((out=fopen(fname,"wb"))==NULL) { 160 | fprintf(stderr,"Error opening SAC file %s.",fname); sac_help_abort_msg(""); 161 | } 162 | 163 | if (fwrite(hdr,sizeof(sachdr),1,out)!=1) { 164 | fprintf(stderr,"Error writing SAC file %s.",fname); sac_help_abort_msg(""); 165 | } 166 | if (gsl_vector_float_fwrite(out,data) != 0) { 167 | fprintf(stderr,"Error writing SAC file %s.",fname); sac_help_abort_msg(""); 168 | } 169 | } 170 | 171 | -------------------------------------------------------------------------------- /sac.h: -------------------------------------------------------------------------------- 1 | /* $Id: sac.h,v 16.0.1.1 1997/04/28 12:16:40 root Exp root $ */ 2 | /* 3 | *$Log: sac.h,v $ 4 | * Revision 16.0.1.1 1997/04/28 12:16:40 root 5 | * \#makecheckin 6 | * 7 | *Revision 16.0 1997/04/10 18:38:42 root 8 | *\#makecheckin 9 | * 10 | *Revision 15.1 1997/04/10 18:10:59 root 11 | *\#makecheckin 12 | * 13 | *Revision 12.0 1997/03/08 23:17:27 root 14 | *\#makecheckin 15 | * 16 | *Revision 11.0 1997/03/08 23:16:00 root 17 | *\#makecheckin 18 | * 19 | *Revision 10.1 1997/03/08 23:14:34 root 20 | **** empty log message *** 21 | * 22 | */ 23 | 24 | #ifndef __SAC_H__ 25 | #define __SAC_H__ 26 | #include 27 | struct sac { 28 | float delta, depmin, depmax, scale, odelta; 29 | float b, e, o, a, internal1; 30 | float t0, t1, t2, t3, t4; 31 | float t5, t6, t7, t8, t9; 32 | float f, resp0, resp1, resp2, resp3; 33 | float resp4, resp5, resp6, resp7, resp8; 34 | float resp9, stla, stlo, stel, stdp; 35 | float evla, evlo, evel, evdp, unused1; 36 | float user0, user1, user2, user3, user4; 37 | float user5, user6, user7, user8, user9; 38 | float dist, az, baz, gcarc, internal2; 39 | float internal3, depmen, cmpaz, cmpinc, unused2; 40 | float unused3, unused4, unused5, unused6, unused7; 41 | float unused8, unused9, unused10, unused11, unused12; 42 | int32_t nzyear, nzjday, nzhour, nzmin, nzsec; 43 | // long nzmsec, internal4, internal5, internal6, npts; 44 | int32_t nzmsec, nvhdr, norid, nevid, npts; 45 | int32_t internal7, internal8, unused13, unused14, unused15; 46 | int32_t iftype, idep, iztype, unused16, iinst; 47 | int32_t istreg, ievreg, ievtyp, iqual, isynth; 48 | int32_t unused17, unused18, unused19, unused20, unused21; 49 | int32_t unused22, unused23, unused24, unused25, unused26; 50 | int32_t leven, lpspol, lovrok, lcalda, unused27; 51 | char kstnm[8], kevnm[16]; 52 | char khole[8], ko[8], ka[8]; 53 | char kt0[8], kt1[8], kt2[8]; 54 | char kt3[8], kt4[8], kt5[8]; 55 | char kt6[8], kt7[8], kt8[8]; 56 | char kt9[8], kf[8], kuser0[8]; 57 | char kuser1[8], kuser2[8], kcmpnm[8]; 58 | char knetwk[8], kdatrd[8], kinst[8]; 59 | }; 60 | 61 | static struct sac sac_null = { 62 | -12345., -12345., -12345., -12345., -12345., 63 | -12345., -12345., -12345., -12345., -12345., 64 | -12345., -12345., -12345., -12345., -12345., 65 | -12345., -12345., -12345., -12345., -12345., 66 | -12345., -12345., -12345., -12345., -12345., 67 | -12345., -12345., -12345., -12345., -12345., 68 | -12345., -12345., -12345., -12345., -12345., 69 | -12345., -12345., -12345., -12345., -12345., 70 | -12345., -12345., -12345., -12345., -12345., 71 | -12345., -12345., -12345., -12345., -12345., 72 | -12345., -12345., -12345., -12345., -12345., 73 | -12345., -12345., -12345., -12345., -12345., 74 | -12345., -12345., -12345., -12345., -12345., 75 | -12345., -12345., -12345., -12345., -12345., 76 | -12345, -12345, -12345, -12345, -12345, 77 | -12345, 6, 0, 0, -12345, 78 | -12345, -12345, -12345, -12345, -12345, 79 | -12345, -12345, -12345, -12345, -12345, 80 | -12345, -12345, -12345, -12345, -12345, 81 | -12345, -12345, -12345, -12345, -12345, 82 | -12345, -12345, -12345, -12345, -12345, 83 | 1, 0, 0, 0, 0, 84 | { '-','1','2','3','4','5',' ',' ' }, 85 | { '-','1','2','3','4','5',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ' }, 86 | { '-','1','2','3','4','5',' ',' ' }, { '-','1','2','3','4','5',' ',' ' }, 87 | { '-','1','2','3','4','5',' ',' ' }, { '-','1','2','3','4','5',' ',' ' }, 88 | { '-','1','2','3','4','5',' ',' ' }, { '-','1','2','3','4','5',' ',' ' }, 89 | { '-','1','2','3','4','5',' ',' ' }, { '-','1','2','3','4','5',' ',' ' }, 90 | { '-','1','2','3','4','5',' ',' ' }, { '-','1','2','3','4','5',' ',' ' }, 91 | { '-','1','2','3','4','5',' ',' ' }, { '-','1','2','3','4','5',' ',' ' }, 92 | { '-','1','2','3','4','5',' ',' ' }, { '-','1','2','3','4','5',' ',' ' }, 93 | { '-','1','2','3','4','5',' ',' ' }, { '-','1','2','3','4','5',' ',' ' }, 94 | { '-','1','2','3','4','5',' ',' ' }, { '-','1','2','3','4','5',' ',' ' }, 95 | { '-','1','2','3','4','5',' ',' ' }, { '-','1','2','3','4','5',' ',' ' }, 96 | { '-','1','2','3','4','5',' ',' ' } 97 | }; 98 | 99 | /* defines for logical data types */ 100 | #ifndef TRUE 101 | #define TRUE 1 102 | #endif 103 | #ifndef FALSE 104 | #define FALSE 0 105 | #endif 106 | 107 | /* defines for enumerated data types */ 108 | #define IREAL 0 109 | #define ITIME 1 110 | #define IRLIM 2 111 | #define IAMPH 3 112 | #define IXY 4 113 | #define IUNKN 5 114 | #define IDISP 6 115 | #define IVEL 7 116 | #define IACC 8 117 | #define IB 9 118 | #define IDAY 10 119 | #define IO 11 120 | #define IA 12 121 | #define IT0 13 122 | #define IT1 14 123 | #define IT2 15 124 | #define IT3 16 125 | #define IT4 17 126 | #define IT5 18 127 | #define IT6 19 128 | #define IT7 20 129 | #define IT8 21 130 | #define IT9 22 131 | #define IRADNV 23 132 | #define ITANNV 24 133 | #define IRADEV 25 134 | #define ITANEV 26 135 | #define INORTH 27 136 | #define IEAST 28 137 | #define IHORZA 29 138 | #define IDOWN 30 139 | #define IUP 31 140 | #define ILLLBB 32 141 | #define IWWSN1 33 142 | #define IWWSN2 34 143 | #define IHGLP 35 144 | #define ISRO 36 145 | #define INUCL 37 146 | #define IPREN 38 147 | #define IPOSTN 39 148 | #define IQUAKE 40 149 | #define IPREQ 41 150 | #define IPOSTQ 42 151 | #define ICHEM 43 152 | #define IOTHER 44 153 | #define IGOOD 45 154 | #define IGLCH 46 155 | #define IDROP 47 156 | #define ILOWSN 48 157 | #define IRLDTA 49 158 | #define IVOLTS 50 159 | #define INIV51 51 160 | #define INIV52 52 161 | #define INIV53 53 162 | #define INIV54 54 163 | #define INIV55 55 164 | #define INIV56 56 165 | #define INIV57 57 166 | #define INIV58 58 167 | #define INIV59 59 168 | #define INIV60 60 169 | 170 | #define FCS "%15.7f%15.7f%15.7f%15.7f%15.7f\n" 171 | #define ICS "%10d%10d%10d%10d%10d\n" 172 | #define CCS1 "%-8.8s%-8.8s%-8.8s\n" 173 | #define CCS2 "%-8.8s%-16.16s\n" 174 | 175 | #endif /* __SAC_H__ */ 176 | -------------------------------------------------------------------------------- /gsl_seis.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include "gsl_seis.h" 8 | 9 | #define PI 3.14159265358979323846 10 | #define MIN(a,b) ((a)<(b)?(a):(b)) 11 | 12 | int gsl_float_rotate(gsl_vector_float *hn, gsl_vector_float *he, float angle) { 13 | /* rotates CCW in place seismic components hn, he which must form a RHS system by 14 | angle (in deg)*/ 15 | float c=cos(angle*PI/180.),s=sin(angle*PI/180.); 16 | /* printf("Rotate by angle %f c=%f s=%f\n",angle,c,s); */ 17 | /* printf("Pre-rotation 0th element: %g %g\n",gsl_vector_float_get(hn,0),gsl_vector_float_get(he,0)); */ 18 | gsl_blas_srot(he,hn,c,s); 19 | /* printf("Post-rotation 0th element: %g %g\n",gsl_vector_float_get(hn,0),gsl_vector_float_get(he,0)); */ 20 | return(0); 21 | } 22 | 23 | void gsl_rotcr(gsl_vector *cor_mat[2][2], double azimuth) { 24 | /*% gsl_rotcr rotatin place2 D-cross-correlation matrix 25 | % crot=rotcr(C,azimuth) r otates cross-correlation matrix 26 | % C=[ n1n1 e1n2 ; n1e2 e2e2 ] to direction azimuth (clockwise from N) 27 | NB Definition of angle is the opposite of gsl_float_rotate */ 28 | double c=cos(azimuth*PI/180.),s=sin(azimuth*PI/180.); 29 | 30 | /* Left side mulltiplication with rotation matrix */ 31 | gsl_blas_drot(cor_mat[0][0],cor_mat[1][0],c,s); 32 | gsl_blas_drot(cor_mat[0][1],cor_mat[1][1],c,s); 33 | /* Right side mulltiplication with rotation matrix transposed */ 34 | gsl_blas_drot(cor_mat[0][0],cor_mat[0][1],c,s); 35 | gsl_blas_drot(cor_mat[1][0],cor_mat[1][1],c,s); 36 | } 37 | 38 | 39 | 40 | double gsl_df_normsqr(gsl_vector_float *a) { 41 | /* calculates Squared Norm=a_i a_i (summation convention) of vector */ 42 | int i; 43 | double sum=0,b; 44 | for(i=0;isize;i++) { 45 | b=(double)a->data[i*a->stride]; 46 | sum+=b*b; 47 | } 48 | return(sum); 49 | } 50 | 51 | double gsl_df_dotprod(gsl_vector_float *a, gsl_vector_float *b) { 52 | /* calculates dot product=a_i b_i (summation convention) of vectors a,b */ 53 | double result; 54 | gsl_blas_dsdot (a,b,&result); 55 | return(result); 56 | } 57 | 58 | void gsl_df_corrshift(gsl_vector *c, gsl_vector_float *x1, long beg1, gsl_vector_float *x2, long beg2, long len, long maxlag, int mode) { 59 | /* calculates the modified cross-correlation, i.e. the dot product of vectors x1(b1-i/2:b1+len-1) and x2(b2+i/2:b2+len-1) 60 | For indices i between -maxlag and maxlag. x(j) for j<1 or j> length(x) is assumed to 61 | be zero. 62 | The result will be identical to the cross-correlation(a,b,maxlag) if x1,x2 are 0 outside the 63 | interval [bi:bi+len-1]. 64 | 65 | mode: 66 | GSL_CORRSHIFT_PARTITION 0 partition shift between both vectors 67 | GSL_CORRSHIFT_ONE 1 only shift the first sequence 68 | GSL_CORRSHIFT_TWO 2 only shift the second sequence 69 | 70 | Output: 71 | c the modified cross-correlation. C must be allocated outside the routine with 72 | a size of at least 2*maxlag+1 (if it is larger elements beyoun 2*maxlag remain 73 | unchanged. 74 | */ 75 | gsl_vector_float_view vue1,vue2; 76 | long i, b1,b2,l; 77 | 78 | for(i=-maxlag;i<=maxlag;i++) { 79 | l=len; 80 | switch(mode) { 81 | case GSL_CORRSHIFT_PARTITION: 82 | b1=beg1+i/2-i; 83 | b2=beg2+i/2; 84 | break; 85 | case GSL_CORRSHIFT_ONE: 86 | b1=beg1-i; 87 | b2=beg2; 88 | break; 89 | case GSL_CORRSHIFT_TWO: 90 | b1=beg1; 91 | b2=beg2+i; 92 | break; 93 | } 94 | /* make sure bounds are within physical array. If not truncate summations */ 95 | if (b1<0) { 96 | b2 -= b1; /* If part of first series is missing, then the corresponding parts 97 | of the second would have been multiplied by two and also should not 98 | have been used */ 99 | l -= b1; 100 | b1 =0; 101 | } 102 | if (b2<0) { 103 | b1 -= b2; 104 | l -= b2; 105 | b2 =0; 106 | } 107 | if(b1+l > x1->size) 108 | l = x1->size - b1; 109 | if(b2+l > x2->size) 110 | l = x2->size - b2; 111 | 112 | /* if (l!=len) printf("CORRSHIFT: adjusted parameters: i=%d b1 %d b2 %d l %d len %d beg1 %d len1 %d beg2 %d len2 %d\n",i,b1,b2,l,len,beg1,x1->size,beg2,x2->size); */ 113 | 114 | vue1=gsl_vector_float_subvector(x1,b1,l); 115 | vue2=gsl_vector_float_subvector(x2,b2,l); 116 | gsl_blas_dsdot (&vue1.vector,&vue2.vector,gsl_vector_ptr(c,maxlag+i)); /* dot product of two sub-vectors i s the cross-correlation at that lag U*/ 117 | } 118 | } 119 | 120 | void gsl_float_write_timeseries(FILE *fid,gsl_vector_float *data, float beg, float delta) { 121 | /* writes out a gsl_vector_float as xy file with x being determined from time of first sample, beg, 122 | and sampling interval, delta */ 123 | long i; 124 | for (i=0; isize;i++) 125 | fprintf(fid,"%-20g %-20g\n",beg+i*delta,gsl_vector_float_get(data,i)); 126 | } 127 | 128 | void gsl_float_write_pmp(FILE *fid,gsl_vector_float *data_x, gsl_vector_float *data_y) { 129 | /* writes out a two gsl_vector_float as parametric plot (e.g. for particle motion diagram) */ 130 | long i,imax=MIN(data_y->size,data_x->size); 131 | for (i=0; ie2 eigenvalues of correlation matrix) 139 | lin = 1 for perfectly linear particle motion 140 | lin = 0 for circular motion */ 141 | gsl_matrix *m2_cov=gsl_matrix_alloc(2,2); 142 | gsl_eigen_symmv_workspace *ws_eigen=gsl_eigen_symmv_alloc(2); 143 | gsl_matrix *m2_evec=gsl_matrix_alloc(2,2); 144 | gsl_vector *eval=gsl_vector_alloc(2); 145 | double pol; 146 | 147 | gsl_matrix_set(m2_cov,0,0,gsl_df_dotprod(data_n,data_n)); 148 | gsl_matrix_set(m2_cov,0,1,gsl_df_dotprod(data_n,data_e)); 149 | gsl_matrix_set(m2_cov,1,0,gsl_matrix_get(m2_cov,0,1)); 150 | gsl_matrix_set(m2_cov,1,1,gsl_df_dotprod(data_e,data_e)); 151 | 152 | gsl_eigen_symmv(m2_cov, eval, m2_evec, ws_eigen); /* Calculate eigenvalues and vectors */ 153 | gsl_eigen_symmv_sort(eval, m2_evec, GSL_EIGEN_SORT_VAL_ASC); /* Sort them */ 154 | 155 | *lin=1-gsl_vector_get(eval,0)/gsl_vector_get(eval,1); 156 | pol=atan2(gsl_matrix_get(m2_evec,1,1),gsl_matrix_get(m2_evec,0,1)); 157 | return(pol*180/PI); 158 | } 159 | 160 | 161 | long nxtpwr2( long n) { 162 | long r; 163 | for(r=1 ; r 14 | #include 15 | #include 16 | #include 17 | #include 18 | #include 19 | 20 | #include "gsl_seis.h" 21 | #include "sac_help.h" 22 | 23 | #define MAXLEN 4194304 24 | 25 | typedef struct { 26 | /* Input data */ 27 | sachdr *hdr_hor1; 28 | gsl_vector_float *data_hor1; 29 | char *file1; 30 | sachdr *hdr_hor2; 31 | gsl_vector_float *data_hor2; 32 | char *file2; 33 | float fast; 34 | float time; 35 | char pstr[32]; 36 | char astr[32]; 37 | } params; 38 | 39 | int verbose=0; 40 | #define VRB(command) { if(verbose) { command ; fflush(stdout); }} 41 | 42 | 43 | void abort_msg(char *msg) { 44 | fprintf(stderr,"%s\n ABORT \n",msg); 45 | exit(10); 46 | } 47 | 48 | void warn_msg(char *msg) { 49 | fprintf(stderr,"WARNING: %s\n",msg); 50 | } 51 | 52 | void usage(char *cmd) { 53 | fprintf(stderr,"Usage: %s [OPTIONS] \n",cmd); 54 | fprintf(stderr,"\ 55 | OPTIONS:\n\ 56 | \n\ 57 | Required:\n\ 58 | \n\ 59 | -data hor1 hor2\n\ 60 | hor1 and hor2 are sac files containing the S phase for which splitting\n\ 61 | should be measured. The header variables CMPAZ must be set. Note that\n\ 62 | the whole time series is splitting-corrected even though this might\n\ 63 | not always be appropriate\n\ 64 | \n\ 65 | -split fast time Give fast direction in degree clockwise from N, and splitting time in s\n\ 66 | \n\ 67 | Choose at least one of:\n\ 68 | \n\ 69 | -pre pstr Generate output file names by prepending pstr to filenames\n\ 70 | \n\ 71 | -ap astr Generate output file names by appending pstr to filenames\n\ 72 | \n\ 73 | Optional modifiers:\n\ 74 | \n\ 75 | -forward Apply splitting to waveform\n\ 76 | (Default is to remove specified splitting from waveform)\n\ 77 | \n\ 78 | Status options:\n\ 79 | \n\ 80 | -v Verbose output (for debugging)\n\ 81 | -h Print out this help text\n\ 82 | "); 83 | exit(10); 84 | } 85 | 86 | void parse(int argc, char **argv, params *par) { 87 | int iarg; 88 | char *dummy; 89 | int read_data=0, invert=1; 90 | /* Required arguments: initialise and check later */ 91 | par->fast=-999; 92 | par->time=-999; 93 | par->pstr[0]='\0'; 94 | par->astr[0]='\0'; 95 | par->pstr[31]='\0'; 96 | par->astr[31]='\0'; 97 | 98 | iarg=0; 99 | if (argc==1) 100 | usage("split_cor"); 101 | while(++iarg=argc ) 109 | abort_msg("-data option must be followed by two sac-filenames (horizontal components)."); 110 | read_seis_file(argv[++iarg],&(par->hdr_hor1),&(par->data_hor1)); 111 | par->file1=strdup(argv[iarg]); 112 | read_seis_file(argv[++iarg],&(par->hdr_hor2),&(par->data_hor2)); 113 | par->file2=strdup(argv[iarg]); 114 | } 115 | else if(!strncasecmp(argv[iarg],"-pre",4)) { 116 | iarg++; 117 | strncpy(par->pstr,argv[iarg],31); 118 | } 119 | else if(!strncasecmp(argv[iarg],"-app",4)) { 120 | iarg++; 121 | strncpy(par->astr,argv[iarg],31); 122 | } 123 | else if(!strncasecmp(argv[iarg],"-spl",3)) { 124 | par->fast=atof(argv[++iarg]); 125 | par->time=atof(argv[++iarg]); 126 | } 127 | else if(!strncasecmp(argv[iarg],"-for",4)) { 128 | invert=0; 129 | } 130 | else if(!strcasecmp(argv[iarg],"-v") ) { 131 | verbose=1; 132 | } 133 | else if(!strcasecmp(argv[iarg],"-h") ) { 134 | usage("split_cor"); 135 | } 136 | else { 137 | fprintf(stderr,"%s ",argv[iarg]); 138 | abort_msg("is not a known option"); 139 | } 140 | } 141 | if (!read_data) 142 | abort_msg("Need to specify -data option"); 143 | if (par->fast==-999) 144 | abort_msg("Need to specify fast direction and splitting time"); 145 | if (strlen(par->pstr)==0 && strlen(par->astr)==0) 146 | abort_msg("Need to define at least one of -pstr, -astr"); 147 | if(invert==1) 148 | par->time = -par->time; 149 | } 150 | 151 | 152 | 153 | int main(int argc, char **argv) 154 | { 155 | params *par=(params *) malloc(sizeof(params)); 156 | char output[256]; 157 | long ishift; 158 | gsl_vector_float_view vue_fast,vue_slow; 159 | 160 | gsl_vector_float *hor1,*hor2; 161 | 162 | parse(argc,argv, par); 163 | 164 | /* Check that sac files are consistent */ 165 | if(check_consistency(par->hdr_hor1,par->hdr_hor2, 166 | CONSISTENCY_STATION | CONSISTENCY_EVENT | CONSISTENCY_VERBOSE | CONSISTENCY_BEGIN )) 167 | abort_msg("Data files inconsistent"); 168 | make_rhs(&par->hdr_hor1,&par->data_hor1,&par->hdr_hor2,&par->data_hor2); 169 | 170 | if (par->time < 0) { 171 | par->time = -par->time; 172 | par->fast = par->fast+90; 173 | } 174 | /* rotate to fast/slow */ 175 | gsl_float_rotate(par->data_hor1,par->data_hor2, par->hdr_hor1->cmpaz - par->fast); 176 | ishift=(long)rint(par->time/par->hdr_hor1->delta); 177 | VRB(printf("Shift %f ishift %ld New length %ld\n",par->time,ishift,par->data_hor1->size-ishift)); 178 | vue_fast=gsl_vector_float_subvector(par->data_hor1,ishift,par->data_hor1->size-ishift); 179 | vue_slow=gsl_vector_float_subvector(par->data_hor2,0,par->data_hor2->size-ishift); 180 | par->hdr_hor1->npts -= ishift; 181 | par->hdr_hor2->npts -= ishift; 182 | par->hdr_hor1->b += par->hdr_hor1->delta*ishift/2; 183 | par->hdr_hor2->b += par->hdr_hor2->delta*ishift/2; 184 | 185 | /* rotate back to CMPAZ (also mangles original data vectors */ 186 | gsl_float_rotate(&vue_fast.vector,&vue_slow.vector, -par->hdr_hor1->cmpaz + par->fast); 187 | 188 | /* and write out */ 189 | strcpy(output,par->pstr); 190 | strcat(output,par->file1); 191 | strcat(output,par->astr); 192 | write_seis_file(output,par->hdr_hor1,&vue_fast.vector); 193 | 194 | strcpy(output,par->pstr); 195 | strcat(output,par->file2); 196 | strcat(output,par->astr); 197 | write_seis_file(output,par->hdr_hor2,&vue_slow.vector); 198 | 199 | } 200 | 201 | 202 | 203 | 204 | -------------------------------------------------------------------------------- /scripts/show-overview-SKS.gmt: -------------------------------------------------------------------------------- 1 | #!/bin/csh 2 | # Designed to be run after 3 | 4 | use_gmt4 5 | 6 | 7 | # Example usage (some of this is assumed) for run 8 | # set sta RUE 9 | # error_stack -gmt -name ${sta]-summary *_err.bin | tee ${sta}-summary.txt 10 | # show-overview.gmt ${sta}-summary $sta 11 | 12 | # Variable parameters: 13 | set rootin=$1 14 | set sta=$2 15 | set rootout=${sta}-overview-SKS 16 | set psfile=${rootout}.ps 17 | 18 | set label0="Fast Direction (deg)" 19 | set label1="Split Delay (s)" 20 | 21 | # 22 | makecpt -T0/180/10 -Ccyclic > baz.cpt 23 | 24 | set grdrange=`grdinfo -C ${rootin}.grd | awk '{print $2 "/" $3 "/" $4 "/" $5 }'` 25 | 26 | 27 | 28 | gmtdefaults -D >.gmtdefaults 29 | gmtset PAGE_ORIENTATION portrait MEASURE_UNIT cm WANT_EURO_FONT TRUE LABEL_FONT_SIZE 12 ANOT_FONT_SIZE 10 PAPER_MEDIA a4 D_FORMAT %lg 30 | 31 | # extract 32 | # FPD TD BAZ ERRdelay ERRfast # for good and fair 33 | # FPD TD BAZ ERRdelay ERRfast # for poor and null splitting 34 | # FPD TD BAZ ERRdelay ERRfast # for near null splitting 35 | 36 | # Good splittings : null rejected at 95% confidence; FPD err <= 10 (ignore TD error) 37 | awk 'FNR==2 && $18==0 { if ( $10+0>95.0 && $7+0<=10.0) print $8,$6,$11,$9,$7 }' *${sta}_split.txt > ${rootout}-good.xy 38 | # Fair splittings: null rejected at 95% confidence; FPD err <= 25 39 | awk 'FNR==2 && $18==0 { if ( $10+0>95.0 && $7+0<=25.0 && $7+0>10) print $8,$6,$11,$9,$7 }' *${sta}_split.txt > ${rootout}-fair.xy 40 | # Poor splittings: null rejected at 95% confidence; FPD err >25 41 | awk 'FNR==2 && $18==0 { if ( $10+0>95.0 && $7+0>25.0 ) print $8,$6,$11,$9,$7 }' *${sta}_split.txt > ${rootout}-poor.xy 42 | # Null splittings: 43 | awk 'FNR==2 && $18==1 { print $8,$6,$11,$9,$7}' *${sta}_split.txt > ${rootout}-null.xy 44 | # Near null splitting - null rejected at less then or equal 95% conf. interval but more than 68% 45 | awk 'FNR==2 && $18==0 { if ($10+0<=95.0) print $8,$6,$11,$9,$7}' *${sta}_split.txt > ${rootout}-nearnull.xy 46 | 47 | # 3cm Descriptive text 48 | pstext -M -X0 -Y0 -R0/20/0/29 -Jx1 -N -K > $psfile < ${rootin}.description 49 | 50 | # 8 cm Error surface 51 | #grdcontour -X2 -Y20.5 ${root}.grd -C${root}.cont -R$grdrange -JX16/6.5 -B0.5:"$label1":/20:"$label0":WSen -O -K -A-1f1 -G1000 -Wa1.5p -Wc0.5p >>$psfile 52 | 53 | # draw thin horizontal line at FPD (for judging if null splits are close to that line) 54 | awk '/Fast/ && /SplitDly/ { if ($10+0 >= .95 ) \ 55 | print "> -Z"$2 ; print 0,$2; print 10,$2 ; \ 56 | print "> -Z"$2+90; print 0,$2+90 ; print 10,$2+90 ; \ 57 | print "> -Z"$2-90; print 0,$2-90 ; print 10,$2-90 ; \ 58 | }' ${rootin}.description \ 59 | | psxy -X2 -Y20.5 -B0.5:"$label1":/20:"$label0":WSen -R$grdrange -JX16.9/6.5 -W1p,200/200/200,- -Cbaz.cpt -m -O -K >>$psfile 60 | 61 | # plot joint estimate but only if null splitting is rejected at 95% confidence 62 | awk '/Fast/ && /SplitDly/ { if ($10+0 >= .95 ) print $6, $2,$8,$4 }' ${rootin}.description \ 63 | | psxy -R -JX -W2p/100/100/100 -Exy/2p,100/100/100 -O -K >>$psfile 64 | #psxy < ${rootin}_allsplit.xy -R -JX -S+0.2 -W1p -O -K >>$psfile 65 | 66 | awk '{print $1,$2,$3%180,$5 }' ${rootout}-good.xy | psxy -R -JX -Ey/+1p -Sc0.3 -Cbaz.cpt -O -K >>$psfile 67 | awk '{print $1,$2,$3%180,$5 }' ${rootout}-fair.xy | psxy -R -JX -Ey/+0.5p -Sc0.2 -Cbaz.cpt -O -K >>$psfile 68 | awk '{print $1,$2,$3%180 }' ${rootout}-poor.xy | psxy -R -JX -Sc0.15 -Cbaz.cpt -O -K >>$psfile 69 | awk '{print $1,$2,$3%180 }' ${rootout}-nearnull.xy | psxy -R -JX -SD0.15 -Cbaz.cpt -O -K >>$psfile 70 | awk '{print $1,$2,$3%180 }' ${rootout}-null.xy | psxy -R -JX -S+0.2 -W1p -Cbaz.cpt -O -K >>$psfile 71 | 72 | psscale -D17/3.25/6.5/0.25 -Cbaz.cpt -B45:"Backazimuth modulo 180 deg": --LABEL_FONT_SIZE=9p -O -K >> $psfile 73 | 74 | # Legend 75 | echo ' 0 -2 125 0.4' | psxy -R0/16.9/0/6.5 -Jx1 -Ey/+1p -Sc0.3 -Cbaz.cpt -N -O -K >>$psfile # good 76 | echo ' 2 -2 125 0.4' | psxy -R -Jx1 -Ey/+0.5p -Sc0.2 -Cbaz.cpt -N -O -K >>$psfile # fair 77 | echo ' 4 -2 125' | psxy -R -Jx1 -Sc0.15 -Cbaz.cpt -N -O -K >>$psfile # poor 78 | echo ' 5.5 -2 125' | psxy -R -Jx1 -SD0.15 -Cbaz.cpt -N -O -K >>$psfile # near null 79 | echo ' 9.5 -2 125' | psxy -R -Jx1 -S+0.2 -W1p -Cbaz.cpt -N -O -K >>$psfile # null 80 | echo ' 12.8 -2 0.4 0.4' | psxy -Jx1 -R -W2p/100/100/100 -Exy/2p,100/100/100 -N -O -K >> $psfile # joint 81 | 82 | echo ' 4 -2.8 ' | psxy -R -Jx1 -S+0.2 -W1p,200/200/200 -N -O -K >>$psfile # null (plotted at BAZ) 83 | echo "12.8 -2.8" | psxy -R -Jx1 -S-1.5 -W0.75p,gray -N -O -K >>$psfile 84 | 85 | pstext -R -Jx -D0.3/0 -N -O -K >> $psfile <= .95 ) \ 101 | print "> -W0.75p,gray" ; print 0,$2; print 360,$2 ; \ 102 | print "> -W0.5p,lightgray,. " ; print 0,$2+90 ; print 360,$2+90 ; \ 103 | print "> -W0.5p,lightgray,. " ; print 0,$2-90 ; print 360,$2-90 ; \ 104 | }' ${rootin}.description \ 105 | | psxy -X0 -Y-11 -B90/20:"$label0":WseN -R0/360/$fpdrange -JX -m -O -K >>$psfile 106 | 107 | awk '{print $3,$2,$3%180,$5 }' ${rootout}-good.xy | psxy -R -JX -Ey/+1p -Sc0.3 -Cbaz.cpt -O -K >>$psfile 108 | awk '{print $3,$2,$3%180,$5 }' ${rootout}-fair.xy | psxy -R -JX -Ey/+0.5p -Sc0.2 -Cbaz.cpt -O -K >>$psfile 109 | awk '{print $3,$2,$3%180,$5 }' ${rootout}-poor.xy | psxy -R -Ey0.1/+0.25p -JX -Sc0.15 -Cbaz.cpt -O -K >>$psfile 110 | awk '{print $3,$2,$3%180 }' ${rootout}-null.xy | psxy -R -JX -S+0.2 -W1p -Cbaz.cpt -O -K >>$psfile 111 | awk '{print $3,$3%180;}' ${rootout}-null.xy | psxy -R -JX -S+0.2 -W1p,200/200/200 -O -K >>$psfile 112 | awk '{print $3,$2,$3%180 }' ${rootout}-nearnull.xy | psxy -R -JX -SD0.15 -Cbaz.cpt -O -K >>$psfile 113 | 114 | 115 | 116 | 117 | # TD vs BAZ plot 118 | # draw thin horizontal line at FPD (for judging if null splits are close to that line) 119 | awk '/Fast/ && /SplitDly/ { if ($10+0 >= .95 ) \ 120 | print "> -W0.75p,gray" ; print 0,$6; print 360,$6 ; \ 121 | }' ${rootin}.description \ 122 | | psxy -X0 -Y-7 -B90:"Backazimuth":/0.5:"$label1":WSen -R0/360/$tdrange -JX -Cbaz.cpt -m -O -K >>$psfile 123 | 124 | awk '{print $3,$1,$3%180,$4 }' ${rootout}-good.xy | psxy -R -JX -Ey/+1p -Sc0.3 -Cbaz.cpt -O -K >>$psfile 125 | awk '{print $3,$1,$3%180,$4 }' ${rootout}-fair.xy | psxy -R -JX -Ey/+0.5p -Sc0.2 -Cbaz.cpt -O -K >>$psfile 126 | awk '{print $3,$1,$3%180,$4 }' ${rootout}-poor.xy | psxy -R -Ey0.1/+0.25p -JX -Sc0.15 -Cbaz.cpt -O -K >>$psfile 127 | #awk '{print $3,$1,$3%180 }' ${rootout}-null.xy | psxy -R -JX -S+0.2 -W1p -Cbaz.cpt -O -K >>$psfile 128 | awk '{print $3,0.05,$3%180 }' ${rootout}-null.xy | psxy -R -JX -S+0.2 -W1p,150/150/150 -O -K >>$psfile 129 | awk '{print $3,$1,$3%180 }' ${rootout}-nearnull.xy | psxy -R -JX -SD0.15 -Cbaz.cpt -O -K >>$psfile 130 | 131 | 132 | psxy < /dev/null -Jx1 -R -O >>$psfile 133 | 134 | 135 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | GNU GENERAL PUBLIC LICENSE 2 | Version 2, June 1991 3 | 4 | Copyright (C) 1989, 1991 Free Software Foundation, Inc., 5 | 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 6 | Everyone is permitted to copy and distribute verbatim copies 7 | of this license document, but changing it is not allowed. 8 | 9 | Preamble 10 | 11 | The licenses for most software are designed to take away your 12 | freedom to share and change it. By contrast, the GNU General Public 13 | License is intended to guarantee your freedom to share and change free 14 | software--to make sure the software is free for all its users. This 15 | General Public License applies to most of the Free Software 16 | Foundation's software and to any other program whose authors commit to 17 | using it. (Some other Free Software Foundation software is covered by 18 | the GNU Lesser General Public License instead.) You can apply it to 19 | your programs, too. 20 | 21 | When we speak of free software, we are referring to freedom, not 22 | price. Our General Public Licenses are designed to make sure that you 23 | have the freedom to distribute copies of free software (and charge for 24 | this service if you wish), that you receive source code or can get it 25 | if you want it, that you can change the software or use pieces of it 26 | in new free programs; and that you know you can do these things. 27 | 28 | To protect your rights, we need to make restrictions that forbid 29 | anyone to deny you these rights or to ask you to surrender the rights. 30 | These restrictions translate to certain responsibilities for you if you 31 | distribute copies of the software, or if you modify it. 32 | 33 | For example, if you distribute copies of such a program, whether 34 | gratis or for a fee, you must give the recipients all the rights that 35 | you have. You must make sure that they, too, receive or can get the 36 | source code. And you must show them these terms so they know their 37 | rights. 38 | 39 | We protect your rights with two steps: (1) copyright the software, and 40 | (2) offer you this license which gives you legal permission to copy, 41 | distribute and/or modify the software. 42 | 43 | Also, for each author's protection and ours, we want to make certain 44 | that everyone understands that there is no warranty for this free 45 | software. If the software is modified by someone else and passed on, we 46 | want its recipients to know that what they have is not the original, so 47 | that any problems introduced by others will not reflect on the original 48 | authors' reputations. 49 | 50 | Finally, any free program is threatened constantly by software 51 | patents. We wish to avoid the danger that redistributors of a free 52 | program will individually obtain patent licenses, in effect making the 53 | program proprietary. To prevent this, we have made it clear that any 54 | patent must be licensed for everyone's free use or not licensed at all. 55 | 56 | The precise terms and conditions for copying, distribution and 57 | modification follow. 58 | 59 | GNU GENERAL PUBLIC LICENSE 60 | TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 61 | 62 | 0. This License applies to any program or other work which contains 63 | a notice placed by the copyright holder saying it may be distributed 64 | under the terms of this General Public License. The "Program", below, 65 | refers to any such program or work, and a "work based on the Program" 66 | means either the Program or any derivative work under copyright law: 67 | that is to say, a work containing the Program or a portion of it, 68 | either verbatim or with modifications and/or translated into another 69 | language. (Hereinafter, translation is included without limitation in 70 | the term "modification".) Each licensee is addressed as "you". 71 | 72 | Activities other than copying, distribution and modification are not 73 | covered by this License; they are outside its scope. The act of 74 | running the Program is not restricted, and the output from the Program 75 | is covered only if its contents constitute a work based on the 76 | Program (independent of having been made by running the Program). 77 | Whether that is true depends on what the Program does. 78 | 79 | 1. You may copy and distribute verbatim copies of the Program's 80 | source code as you receive it, in any medium, provided that you 81 | conspicuously and appropriately publish on each copy an appropriate 82 | copyright notice and disclaimer of warranty; keep intact all the 83 | notices that refer to this License and to the absence of any warranty; 84 | and give any other recipients of the Program a copy of this License 85 | along with the Program. 86 | 87 | You may charge a fee for the physical act of transferring a copy, and 88 | you may at your option offer warranty protection in exchange for a fee. 89 | 90 | 2. You may modify your copy or copies of the Program or any portion 91 | of it, thus forming a work based on the Program, and copy and 92 | distribute such modifications or work under the terms of Section 1 93 | above, provided that you also meet all of these conditions: 94 | 95 | a) You must cause the modified files to carry prominent notices 96 | stating that you changed the files and the date of any change. 97 | 98 | b) You must cause any work that you distribute or publish, that in 99 | whole or in part contains or is derived from the Program or any 100 | part thereof, to be licensed as a whole at no charge to all third 101 | parties under the terms of this License. 102 | 103 | c) If the modified program normally reads commands interactively 104 | when run, you must cause it, when started running for such 105 | interactive use in the most ordinary way, to print or display an 106 | announcement including an appropriate copyright notice and a 107 | notice that there is no warranty (or else, saying that you provide 108 | a warranty) and that users may redistribute the program under 109 | these conditions, and telling the user how to view a copy of this 110 | License. (Exception: if the Program itself is interactive but 111 | does not normally print such an announcement, your work based on 112 | the Program is not required to print an announcement.) 113 | 114 | These requirements apply to the modified work as a whole. If 115 | identifiable sections of that work are not derived from the Program, 116 | and can be reasonably considered independent and separate works in 117 | themselves, then this License, and its terms, do not apply to those 118 | sections when you distribute them as separate works. But when you 119 | distribute the same sections as part of a whole which is a work based 120 | on the Program, the distribution of the whole must be on the terms of 121 | this License, whose permissions for other licensees extend to the 122 | entire whole, and thus to each and every part regardless of who wrote it. 123 | 124 | Thus, it is not the intent of this section to claim rights or contest 125 | your rights to work written entirely by you; rather, the intent is to 126 | exercise the right to control the distribution of derivative or 127 | collective works based on the Program. 128 | 129 | In addition, mere aggregation of another work not based on the Program 130 | with the Program (or with a work based on the Program) on a volume of 131 | a storage or distribution medium does not bring the other work under 132 | the scope of this License. 133 | 134 | 3. You may copy and distribute the Program (or a work based on it, 135 | under Section 2) in object code or executable form under the terms of 136 | Sections 1 and 2 above provided that you also do one of the following: 137 | 138 | a) Accompany it with the complete corresponding machine-readable 139 | source code, which must be distributed under the terms of Sections 140 | 1 and 2 above on a medium customarily used for software interchange; or, 141 | 142 | b) Accompany it with a written offer, valid for at least three 143 | years, to give any third party, for a charge no more than your 144 | cost of physically performing source distribution, a complete 145 | machine-readable copy of the corresponding source code, to be 146 | distributed under the terms of Sections 1 and 2 above on a medium 147 | customarily used for software interchange; or, 148 | 149 | c) Accompany it with the information you received as to the offer 150 | to distribute corresponding source code. (This alternative is 151 | allowed only for noncommercial distribution and only if you 152 | received the program in object code or executable form with such 153 | an offer, in accord with Subsection b above.) 154 | 155 | The source code for a work means the preferred form of the work for 156 | making modifications to it. For an executable work, complete source 157 | code means all the source code for all modules it contains, plus any 158 | associated interface definition files, plus the scripts used to 159 | control compilation and installation of the executable. However, as a 160 | special exception, the source code distributed need not include 161 | anything that is normally distributed (in either source or binary 162 | form) with the major components (compiler, kernel, and so on) of the 163 | operating system on which the executable runs, unless that component 164 | itself accompanies the executable. 165 | 166 | If distribution of executable or object code is made by offering 167 | access to copy from a designated place, then offering equivalent 168 | access to copy the source code from the same place counts as 169 | distribution of the source code, even though third parties are not 170 | compelled to copy the source along with the object code. 171 | 172 | 4. You may not copy, modify, sublicense, or distribute the Program 173 | except as expressly provided under this License. Any attempt 174 | otherwise to copy, modify, sublicense or distribute the Program is 175 | void, and will automatically terminate your rights under this License. 176 | However, parties who have received copies, or rights, from you under 177 | this License will not have their licenses terminated so long as such 178 | parties remain in full compliance. 179 | 180 | 5. You are not required to accept this License, since you have not 181 | signed it. However, nothing else grants you permission to modify or 182 | distribute the Program or its derivative works. These actions are 183 | prohibited by law if you do not accept this License. Therefore, by 184 | modifying or distributing the Program (or any work based on the 185 | Program), you indicate your acceptance of this License to do so, and 186 | all its terms and conditions for copying, distributing or modifying 187 | the Program or works based on it. 188 | 189 | 6. Each time you redistribute the Program (or any work based on the 190 | Program), the recipient automatically receives a license from the 191 | original licensor to copy, distribute or modify the Program subject to 192 | these terms and conditions. You may not impose any further 193 | restrictions on the recipients' exercise of the rights granted herein. 194 | You are not responsible for enforcing compliance by third parties to 195 | this License. 196 | 197 | 7. If, as a consequence of a court judgment or allegation of patent 198 | infringement or for any other reason (not limited to patent issues), 199 | conditions are imposed on you (whether by court order, agreement or 200 | otherwise) that contradict the conditions of this License, they do not 201 | excuse you from the conditions of this License. If you cannot 202 | distribute so as to satisfy simultaneously your obligations under this 203 | License and any other pertinent obligations, then as a consequence you 204 | may not distribute the Program at all. For example, if a patent 205 | license would not permit royalty-free redistribution of the Program by 206 | all those who receive copies directly or indirectly through you, then 207 | the only way you could satisfy both it and this License would be to 208 | refrain entirely from distribution of the Program. 209 | 210 | If any portion of this section is held invalid or unenforceable under 211 | any particular circumstance, the balance of the section is intended to 212 | apply and the section as a whole is intended to apply in other 213 | circumstances. 214 | 215 | It is not the purpose of this section to induce you to infringe any 216 | patents or other property right claims or to contest validity of any 217 | such claims; this section has the sole purpose of protecting the 218 | integrity of the free software distribution system, which is 219 | implemented by public license practices. Many people have made 220 | generous contributions to the wide range of software distributed 221 | through that system in reliance on consistent application of that 222 | system; it is up to the author/donor to decide if he or she is willing 223 | to distribute software through any other system and a licensee cannot 224 | impose that choice. 225 | 226 | This section is intended to make thoroughly clear what is believed to 227 | be a consequence of the rest of this License. 228 | 229 | 8. If the distribution and/or use of the Program is restricted in 230 | certain countries either by patents or by copyrighted interfaces, the 231 | original copyright holder who places the Program under this License 232 | may add an explicit geographical distribution limitation excluding 233 | those countries, so that distribution is permitted only in or among 234 | countries not thus excluded. In such case, this License incorporates 235 | the limitation as if written in the body of this License. 236 | 237 | 9. The Free Software Foundation may publish revised and/or new versions 238 | of the General Public License from time to time. Such new versions will 239 | be similar in spirit to the present version, but may differ in detail to 240 | address new problems or concerns. 241 | 242 | Each version is given a distinguishing version number. If the Program 243 | specifies a version number of this License which applies to it and "any 244 | later version", you have the option of following the terms and conditions 245 | either of that version or of any later version published by the Free 246 | Software Foundation. If the Program does not specify a version number of 247 | this License, you may choose any version ever published by the Free Software 248 | Foundation. 249 | 250 | 10. If you wish to incorporate parts of the Program into other free 251 | programs whose distribution conditions are different, write to the author 252 | to ask for permission. For software which is copyrighted by the Free 253 | Software Foundation, write to the Free Software Foundation; we sometimes 254 | make exceptions for this. Our decision will be guided by the two goals 255 | of preserving the free status of all derivatives of our free software and 256 | of promoting the sharing and reuse of software generally. 257 | 258 | NO WARRANTY 259 | 260 | 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY 261 | FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN 262 | OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES 263 | PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED 264 | OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 265 | MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS 266 | TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE 267 | PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, 268 | REPAIR OR CORRECTION. 269 | 270 | 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING 271 | WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR 272 | REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, 273 | INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING 274 | OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED 275 | TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY 276 | YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER 277 | PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE 278 | POSSIBILITY OF SUCH DAMAGES. 279 | 280 | END OF TERMS AND CONDITIONS 281 | 282 | How to Apply These Terms to Your New Programs 283 | 284 | If you develop a new program, and you want it to be of the greatest 285 | possible use to the public, the best way to achieve this is to make it 286 | free software which everyone can redistribute and change under these terms. 287 | 288 | To do so, attach the following notices to the program. It is safest 289 | to attach them to the start of each source file to most effectively 290 | convey the exclusion of warranty; and each file should have at least 291 | the "copyright" line and a pointer to where the full notice is found. 292 | 293 | {description} 294 | Copyright (C) {year} {fullname} 295 | 296 | This program is free software; you can redistribute it and/or modify 297 | it under the terms of the GNU General Public License as published by 298 | the Free Software Foundation; either version 2 of the License, or 299 | (at your option) any later version. 300 | 301 | This program is distributed in the hope that it will be useful, 302 | but WITHOUT ANY WARRANTY; without even the implied warranty of 303 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 304 | GNU General Public License for more details. 305 | 306 | You should have received a copy of the GNU General Public License along 307 | with this program; if not, write to the Free Software Foundation, Inc., 308 | 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 309 | 310 | Also add information on how to contact you by electronic and paper mail. 311 | 312 | If the program is interactive, make it output a short notice like this 313 | when it starts in an interactive mode: 314 | 315 | Gnomovision version 69, Copyright (C) year name of author 316 | Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. 317 | This is free software, and you are welcome to redistribute it 318 | under certain conditions; type `show c' for details. 319 | 320 | The hypothetical commands `show w' and `show c' should show the appropriate 321 | parts of the General Public License. Of course, the commands you use may 322 | be called something other than `show w' and `show c'; they could even be 323 | mouse-clicks or menu items--whatever suits your program. 324 | 325 | You should also get your employer (if you work as a programmer) or your 326 | school, if any, to sign a "copyright disclaimer" for the program, if 327 | necessary. Here is a sample; alter the names: 328 | 329 | Yoyodyne, Inc., hereby disclaims all copyright interest in the program 330 | `Gnomovision' (which makes passes at compilers) written by James Hacker. 331 | 332 | {signature of Ty Coon}, 1 April 1989 333 | Ty Coon, President of Vice 334 | 335 | This General Public License does not permit incorporating your program into 336 | proprietary programs. If your program is a subroutine library, you may 337 | consider it more useful to permit linking proprietary applications with the 338 | library. If this is what you want to do, use the GNU Lesser General 339 | Public License instead of this License. 340 | -------------------------------------------------------------------------------- /error_stack.c: -------------------------------------------------------------------------------- 1 | /* errror_stack */ 2 | /* Author: F Tilmann */ 3 | /* Contact: tilmann|a|gfz-potsdam.de */ 4 | 5 | /* Stack error surface files produced by multisplit and find best overall 6 | splitting parameter */ 7 | 8 | 9 | /* (C) 2004 F Tilmann */ 10 | /* This code is released under the GNU public license */ 11 | 12 | /* Code uses gsl and gslblas library */ 13 | /* History: */ 14 | #include 15 | #include 16 | #include 17 | #include 18 | #include 19 | #include 20 | #include 21 | #include 22 | #include 23 | #include 24 | 25 | 26 | int verbose=0; 27 | #define VRB(command) { if(verbose) { command ; fflush(stdout); }} 28 | #define ASSERT(cond,msg) { if (!(cond)) { fprintf(stderr,"ASSERTION VIOLATION: %s\n ABORT \n",msg); exit(10);}} 29 | #define WRITEVEC(name,vec) { {\ 30 | FILE *vectorout;\ 31 | vectorout=fopen(name,"w");\ 32 | if (!vectorout) { \ 33 | sprintf(abort_str,"Cannot open %s for output.",name);\ 34 | abort_msg(abort_str);\ 35 | }\ 36 | gsl_vector_fprintf(vectorout,vec,"%f");\ 37 | fclose(vectorout); }\ 38 | } 39 | 40 | #if !defined NAN 41 | #define NAN (strtod("NAN",NULL)) 42 | #endif 43 | 44 | #define MAX(a,b) ((a)>(b)?(a):(b)) 45 | #define MIN(a,b) ((a)<(b)?(a):(b)) 46 | /* PER(per,x) return a value v with range 0..per-1 such that v+n*per=x (n an integer). It only works for integers */ 47 | #define PER(per,x) ( x<0 ? (x + per*(1+(-x)/per)) : (x%per) ) 48 | 49 | 50 | #define MAXFILES 256 51 | #define MAXDIM 4 52 | 53 | 54 | 55 | typedef struct { 56 | int gmt; 57 | int weight; 58 | char root[256]; 59 | int nfiles; 60 | int mcsamples; 61 | int bootstrap_samples; // Number of bootstrap samples 62 | int use_exact; 63 | float scale_dof; 64 | char *fnames[MAXFILES]; 65 | } params; 66 | 67 | const gsl_rng_type * rng_type; 68 | gsl_rng * rng; 69 | 70 | 71 | char warn_str[1024]; 72 | char abort_str[1024]; 73 | 74 | FILE *open_for_write(char *root,char *extension); 75 | FILE *open_for_read(char *root,char *extension); 76 | void parse(int argc, char **argv, params *par); 77 | void warn_msg(char *msg); 78 | void abort_msg(char *msg); 79 | void usage(char *cmd); 80 | double invfisher(double nu1,double nu2,double conf); 81 | double betai(double a, double b, double x); 82 | 83 | 84 | void ind2sub(int *sub,long int ind1d, int sizes[], int rank) { 85 | /* convert one-dimensional index to multi-dimensional indices */ 86 | /* Input: int1d : 1D index 87 | sizes[] : Arrays giving the number of elements in each dimension 88 | rank: number of dimensions (indices) 89 | Output: sub[] A vector containing the multi-dimensional indices */ 90 | int i; 91 | 92 | for(i=rank-1; i>=0; i--) { 93 | sub[i]=ind1d % sizes[i]; 94 | /* imin_1d-=imin[k][i]; */ // redundant as this part is removed by integer division in next line anywat 95 | ind1d /= sizes[i]; 96 | // VRB(printf("DEBUG i: %d imin_1d: %ld m[i]: %d imin[i]: %d\n",i,imin_1d,m[i],imin[k][i])) 97 | } 98 | ASSERT(ind1d==0,"ind1d should be zero at this stage, as all indices determined and there is no larger dimension left.") 99 | } 100 | 101 | long *bootstrap_analysis(gsl_vector *v_err_surf[],int nfiles,int bootstrap_samples, params *par) { 102 | int l,k; // loop variables 103 | unsigned long int r; 104 | long imin; 105 | int use_count[nfiles]; // how many times is a file represented in a bootstrap sample 106 | float weight=1; // as default use 1 for weight 107 | long *imin1d_bootstrap=malloc(bootstrap_samples*sizeof(long)); 108 | 109 | gsl_vector *v_err_stack=gsl_vector_alloc(v_err_surf[0]->size); 110 | gsl_vector *v_temp=gsl_vector_alloc(v_err_surf[0]->size); 111 | 112 | for (l=0; lweight) { 131 | // weight with the inverse of minimum energy (if relative weighting is selected) 132 | imin=gsl_vector_min_index(v_err_surf[k]); 133 | weight=1/gsl_vector_get(v_err_surf[k],imin); 134 | } 135 | gsl_vector_memcpy(v_temp,v_err_surf[k]); 136 | gsl_vector_scale(v_temp,weight); 137 | gsl_vector_add(v_err_stack,v_temp); 138 | } 139 | // find index of minimum in bootstrapped stacks 140 | imin1d_bootstrap[l]=gsl_vector_min_index(v_err_stack); 141 | } 142 | // free allocated vector space 143 | gsl_vector_free(v_err_stack); 144 | gsl_vector_free(v_temp); 145 | return(imin1d_bootstrap); 146 | } 147 | 148 | 149 | 150 | int main(int argc, char **argv) 151 | { 152 | params *par=(params *) malloc(sizeof(params)); 153 | FILE *hdr_file, *bin_file; 154 | FILE *output; 155 | int i,j,k,l; 156 | /* Properties of each file */ 157 | float split_par; 158 | char methodstring[128],label[MAXDIM][128]; 159 | int dim,m[MAXDIM]; 160 | float min[MAXDIM],max[MAXDIM],step[MAXDIM]; 161 | /* gsl_matrix *err_surf; */ 162 | gsl_matrix *err_stack; // for 2D error-surfaces 163 | 164 | gsl_vector *v_err_surf[MAXFILES], *v_err_stack, *v_temp; // for arbitrary dimension error surfaces 165 | float weight; 166 | /* Properties of first file */ 167 | char rmethodstring[128],rlabel[MAXDIM][128]; 168 | int rdim,rm[MAXDIM]; 169 | float rmin[MAXDIM],rmax[MAXDIM],rstep[MAXDIM]; 170 | /* Variables for ensemble (including arrays for remembering a value for each file) */ 171 | int imin[MAXFILES][MAXDIM],imint[MAXDIM],imcmc[MAXDIM],ibootstrap[MAXDIM]; 172 | long imin_1d,imint_1d,tot_length; 173 | float dof[MAXFILES],postconf[MAXFILES]; 174 | int conflevel[MAXFILES]; 175 | float tot_dof,valmin[MAXFILES]; 176 | float tot_weight; 177 | long *imin1d_bootstrap; 178 | 179 | double maxval,emin,misfit,logprob,value,best[MAXDIM],lbound[MAXDIM],ubound[MAXDIM],err[MAXDIM]; 180 | /* error analysis */ 181 | double conf[9]={.68, .95,.99, .999,.9999,.99999,.999999,.9999999, .99999999 }; /* conf[1] is the level of significance */ 182 | double contour[9]; 183 | double null; 184 | int j1,j2,k1,k2; 185 | int periodic; 186 | char cmdstring[1024]; 187 | gsl_vector_view dvue1; 188 | gsl_matrix_view vue_matrix; 189 | 190 | int status; 191 | char rejectstring[128]; 192 | 193 | // set up global variables related to random number generation 194 | gsl_rng_env_setup(); 195 | rng_type = gsl_rng_default; 196 | rng = gsl_rng_alloc (rng_type); 197 | 198 | // parse command line arguments 199 | parse(argc,argv, par); 200 | 201 | tot_dof=0; 202 | /* tot_weight=0; */ 203 | 204 | for (k=0;knfiles;++k) { /* read loop */ 205 | hdr_file=open_for_read(par->fnames[k],".hdr"); 206 | bin_file=open_for_read(par->fnames[k],".bin"); 207 | if ( fscanf(hdr_file,"%s %f %f\n",methodstring,&split_par,&dof[k]) != 3 ) { 208 | fprintf(stderr,"Format error in %s.hdr file line 1",par->fnames[k]); 209 | abort_msg(abort_str); 210 | } 211 | if ( fscanf(hdr_file,"%d\n",&dim) != 1 ) { 212 | sprintf(abort_str,"Format error in %s.hdr file line 2",par->fnames[k]); 213 | abort_msg(abort_str); 214 | } 215 | if (dim>MAXDIM) 216 | abort_msg("Maximum number of dimensions exceeded. Increase MAXDIM in source and recompile"); 217 | for (i=0; ifnames[k]); 220 | abort_msg(abort_str); 221 | } 222 | } 223 | for (i=0; ifnames[k],4+i); 226 | abort_msg(abort_str); 227 | } 228 | } 229 | if(k==0) { 230 | strcpy(rmethodstring,methodstring); 231 | rdim=dim; 232 | tot_length=1; 233 | for(i=0;ifnames[0],par->fnames[k],rmethodstring,methodstring); 250 | strcpy(rmethodstring,"Mixed"); 251 | warn_msg(warn_str); 252 | } 253 | if (rdim != dim) { 254 | sprintf(abort_str,"Number of dimensions in %s and %s disagree:\n %d vs %d",par->fnames[0],par->fnames[k],rdim,dim); 255 | abort_msg(abort_str); 256 | } 257 | for(i=0;ifnames[0],par->fnames[k],i); 260 | abort_msg(abort_str); 261 | } 262 | } 263 | } 264 | // dimension agnostic code 265 | v_err_surf[k]=gsl_vector_alloc(tot_length); 266 | if( gsl_vector_fread(bin_file,v_err_surf[k]) ) { 267 | sprintf(abort_str,"There was a problem reading %s.bin",par->fnames[k]); 268 | abort_msg(abort_str); 269 | } 270 | } /* end of read loop */ 271 | 272 | for (k=0;knfiles;++k) { /* Analysis loop */ 273 | imin_1d=gsl_vector_min_index(v_err_surf[k]); 274 | valmin[k]=gsl_vector_get(v_err_surf[k],imin_1d); 275 | /* Code specific to 2D matrix 276 | /* if( gsl_matrix_fread(bin_file,err_surf) ) { */ 277 | /* sprintf(abort_str,"There was a problem reading %s.bin",par->fnames[k]); */ 278 | /* abort_msg(abort_str); */ 279 | /* } */ 280 | // /* find minimum index */ 281 | /* gsl_matrix_min_index(err_surf,(size_t *)&imin[k][0],(size_t *)&imin[k][1]); */ 282 | /* valmin[k]=gsl_matrix_get(err_surf,imin[k][0],imin[k][1]); */ 283 | /* printf("%25s %s: %6f %s: %6f emin: %f dof: %f\n",par->fnames[k], */ 284 | /* rlabel[0],min[0]+imin[k][0]*step[0], */ 285 | /* rlabel[1],min[1]+imin[k][1]*step[1],valmin[k],dof[k]); */ 286 | dof[k]*=par->scale_dof; 287 | printf("%25s emin:%f dof: %f",par->fnames[k],valmin[k],dof[k]); 288 | // VRB(printf("\n DEBUG imin_1d: %ld dim: %d\n",imin_1d,dim)); 289 | ind2sub(&imin[k][0],imin_1d,rm,dim); 290 | 291 | for(i=0; iweight) /* normalise by minimum value if requested */ 296 | weight=1/valmin[k]; 297 | else 298 | weight=1; 299 | /* Code for 2D matrix */ 300 | /* gsl_matrix_scale(err_surf,weight); */ 301 | /* gsl_matrix_add(err_stack,err_surf); */ 302 | /* dimension agnostic */ 303 | gsl_vector_memcpy(v_temp,v_err_surf[k]); 304 | gsl_vector_scale(v_temp,weight); 305 | gsl_vector_add(v_err_stack,v_temp); 306 | 307 | 308 | tot_dof += weight*(dof[k]+par->scale_dof*split_par);; 309 | /* I am not sure if this way of manipulating degrees of reedom is correct.*/ 310 | /* However, we must introduce some weighing of the degrees of freedom, otherwise */ 311 | /* I could take one good measurement and lots of bad ones, get the results of the */ 312 | /* good one but with apparently much diminished error because of the greater number */ 313 | /* of DOFs */ 314 | tot_weight+= weight; 315 | } /* end of analysis loop */ 316 | 317 | 318 | /* Analysis of error surface */ 319 | /* 2D code: */ 320 | /* gsl_matrix_min_index(err_stack,(size_t *)&imint[0],(size_t *)&imint[1]); */ 321 | /* emin=gsl_matrix_get(err_stack,imint[0],imint[1]); */ 322 | imint_1d=gsl_vector_min_index(v_err_stack); 323 | emin=gsl_vector_get(v_err_stack,imint_1d); 324 | ind2sub(imint,imint_1d,rm,dim); 325 | 326 | for (i=0;infiles*tot_dof/tot_weight; 331 | tot_dof-=par->scale_dof*split_par; 332 | 333 | 334 | VRB(printf("DEBUG: before calculating confidence intervals\n")); 335 | 336 | float tot_dof_eff=tot_dof; 337 | float tot_dof_thresh=200.; 338 | if ( tot_dof>tot_dof_thresh) { 339 | fprintf(stderr,"WARNING: for very large total number of degrees of freedom \n\ 340 | (equiv. total length of analysed data), the confidence interval calculation leads \n\ 341 | to underflow. The effective number of degrees of freedom for conf. level calculation\n\ 342 | has thus been reduced from %.2f to %.0f\n",tot_dof,tot_dof_thresh); 343 | tot_dof_eff=tot_dof_thresh; 344 | } 345 | for(i=0;i<9;i++) { /* loop over confidence intervals */ 346 | VRB(printf("i: %d confidence %f tot_dof %f split_par %f\n",i,conf[i],tot_dof,split_par)); 347 | contour[i]=1+split_par*invfisher((double)split_par,(double)tot_dof_eff,conf[i])/tot_dof_eff; 348 | VRB(printf("i: %d confidence %f contour %f tot_dof %f split_par %f\n",i,conf[i],contour[i],tot_dof,split_par)); 349 | } 350 | VRB(printf("DEBUG: after calculating confidence intervals\n")); 351 | 352 | printf("Number of files in stack: %d\n",par->nfiles); 353 | printf("Total degrees of freedom: %f\n",tot_dof); 354 | printf("Norm. energy minimum: %f\n",emin/tot_weight); 355 | 356 | if ( dim==2 ) { 357 | vue_matrix=gsl_matrix_view_vector(v_err_stack,m[0],m[1]); 358 | err_stack=&vue_matrix.matrix; 359 | if (par->gmt) { 360 | output=open_for_write(par->root,".cont"); 361 | for (i=0;i<9;i++){ 362 | fprintf(output,"%f %s\n",contour[i]*emin, (i==1 ? "A" : "C" )); 363 | } 364 | fclose(output); 365 | } 366 | null=-1; 367 | for(i=0;i<9;i++) { 368 | if (rmin[1]==0.0 && contour[i]*emin=imint[1];k1--) { 382 | dvue1=gsl_matrix_column(err_stack,k1); 383 | if (gsl_vector_min(&dvue1.vector) <= contour[1]*emin) 384 | break; 385 | } 386 | for (k2=0; k2<=imint[1];k2++) { 387 | dvue1=gsl_matrix_column(err_stack,k2); 388 | if (gsl_vector_min(&dvue1.vector) <= contour[1]*emin) 389 | break; 390 | } 391 | 392 | lbound[1]=rmin[1]+k2*rstep[1]; 393 | ubound[1]=rmin[1]+k1*rstep[1]; 394 | err[1]=MAX(ubound[1]-best[1],best[1]-lbound[1]); 395 | VRB(printf("Global search time %f-%f (E: %f)\n",lbound[1],ubound[1],err[1])); 396 | if (k1==rm[1]-1 && k2==0) /* both bounds at limit of grid search -> no constraints */ 397 | /* err_time=nan(""); */ /* set to NaN */ 398 | err[1]=NAN; 399 | else if (k1==rm[1]-1 ) /* upper bounds at limit of grid search */ 400 | err[1]=-err[1]; /* set error to negative (as flag) */ 401 | 402 | /* Global search parameter 0: (normally this is the fast direction */ 403 | if(!strcasecmp(rlabel[0],"Fast") && 180+rmin[0]-rmax[0]<2*rstep[0]) { 404 | VRB(printf("Periodic fast direction (parameter 0)\n")); 405 | periodic=1; 406 | } else { 407 | VRB(printf("Non-Periodic fast direction (parameter 1)\n")); 408 | periodic=0; 409 | } 410 | for (j1=(periodic ? imint[0]+rm[0]/2 : rm[0]-1); j1>=imint[0];j1--) { 411 | dvue1=gsl_matrix_row(err_stack,PER(rm[0],j1)); 412 | if (gsl_vector_min(&dvue1.vector) <= contour[1]*emin) 413 | break; 414 | } 415 | for (j2=(periodic ? imint[0]-rm[0]/2 : 0); j2<=imint[0];j2++) { 416 | dvue1=gsl_matrix_row(err_stack,PER(rm[0],j2)); 417 | if (gsl_vector_min(&dvue1.vector) <= contour[1]*emin) 418 | break; 419 | } 420 | ubound[0]=rmin[0]+j1*step[0]; 421 | lbound[0]=rmin[0]+j2*step[0]; 422 | err[0]=MAX(ubound[0]-best[0],best[0]-lbound[0]); 423 | VRB(printf("Global search fast direction %f-%f (E: %f)\n",lbound[0],ubound[0],err[0])); 424 | 425 | if (err[0]>75. && periodic) 426 | err[0]=NAN; 427 | else if (!periodic && j1==rm[0]-1 && j2==0) /* both bounds at limit of grid search -> no constraints */ 428 | /* err_time=nan(""); */ /* set to NaN */ 429 | err[0]=NAN; 430 | else if (!periodic && ( j1==rm[0]-1 || j2==0 ) ) /* upper bounds at limit of grid search */ 431 | err[0]=-err[1]; /* set error to negative (as flag) */ 432 | printf("%24s: %3.0f +- %3.0f (% 4.0f - %3.0f )\n",rlabel[0],best[0],err[0],lbound[0],ubound[0]); 433 | printf("%24s: %4.2f +- %4.2f (% 4.2f - %4.2f )\n",rlabel[1],best[1],err[1],lbound[1],ubound[1]); 434 | if (strncmp(rejectstring,"UNK",3)) 435 | printf("Reject Null (%%) : %s (E: %f)\n",rejectstring,gsl_matrix_get(err_stack,0,0)/tot_weight); 436 | } /* end of special part for single layer splitting */ 437 | else { 438 | /* part for dim>2, no more plotting, no more upper, lower bound, instead draw from probability distribution */ 439 | /* gsl_vector *v_logprob_surf =v_err_surf; // resuse already allocated vector to save memory but give it a new name for transparency */ 440 | gsl_vector *v_logprob_surf =gsl_vector_calloc(tot_length); 441 | // display best solution 442 | for (i=0;isize; i++) { 447 | misfit=gsl_vector_get(v_err_stack,i); 448 | // use distribution for unknown error level and number of data points equal to number of Degrees of freedom 449 | // Presumably because the number of data points is very large, this puts nearly all probability onto the minimum misfit 450 | // point 451 | logprob=-((tot_dof+split_par)/2) * log(misfit); // pow(misfit,-(tot_dof+split_par)/2.); 452 | // Alternative: assume error level given by minimum 453 | // logprob=exp(-misfit/(2*emin)); 454 | gsl_vector_set(v_logprob_surf,i,logprob); 455 | } 456 | 457 | // Convert to absolute probabilities; we need to substract maximum of logarithm to avoid overflow 458 | maxval=gsl_vector_max(v_logprob_surf); 459 | for (i=0;isize; i++) { 460 | value=exp(gsl_vector_get(v_logprob_surf,i)-maxval); 461 | gsl_vector_set(v_logprob_surf,i,value); 462 | } 463 | // WRITEVEC("probabilities.txt",v_logprob_surf); 464 | // WRITEVEC("misfit.txt",v_err_stack); 465 | 466 | // Calculate cumulative sum 467 | for (i=1;isize; i++) { 468 | value=gsl_vector_get(v_logprob_surf,i-1)+gsl_vector_get(v_logprob_surf,i); 469 | gsl_vector_set(v_logprob_surf,i,value); 470 | } 471 | // WRITEVEC("cumprob.xy",v_logprob_surf); 472 | 473 | // generate Monte-Carlo samples 474 | maxval=gsl_vector_get(v_logprob_surf,i-1); 475 | VRB(printf("Generating MC samples\n")); 476 | 477 | output=open_for_write(par->root,"_mc.x"); 478 | fprintf(output,"#"); 479 | for (j=0;jmcsamples;i++) { 483 | double r; 484 | r=gsl_rng_uniform(rng)*maxval; 485 | for (k=0;ksize; k++) { 486 | if (ruse_exact) { 494 | out+= (-0.5+gsl_rng_uniform(rng))*step[j]; 495 | } 496 | fprintf(output,"%f ",out); 497 | } 498 | fprintf(output,"\n"); 499 | } 500 | fclose(output); 501 | } 502 | 503 | if (par->bootstrap_samples>0) { 504 | VRB(printf("Generating bootstrap samples\n")); 505 | imin1d_bootstrap=bootstrap_analysis(v_err_surf,par->nfiles,par->bootstrap_samples,par); 506 | // output bootstrap samples 507 | 508 | output=open_for_write(par->root,"_bootstrap.x"); 509 | fprintf(output,"#"); 510 | for (j=0;jbootstrap_samples;i++) { 514 | ind2sub(ibootstrap,imin1d_bootstrap[i],rm,dim); 515 | for (j=0;juse_exact) { 519 | out+= (-0.5+gsl_rng_uniform(rng))*step[j]; 520 | } 521 | fprintf(output,"%f ",out); 522 | } 523 | fprintf(output,"\n"); 524 | } 525 | fclose(output); 526 | } 527 | 528 | /* write bin file */ 529 | output=open_for_write(par->root,".hdr"); 530 | fprintf(output,"Stack_%s %f %f\n",rmethodstring,split_par,tot_dof); 531 | fprintf(output,"%d\n",rdim); 532 | for(i=0;iroot,".bin"); 539 | /* gsl_matrix_fwrite(output,err_stack); */ 540 | gsl_vector_fwrite(output,v_err_stack); 541 | fclose(output); 542 | 543 | /* now go through all input error surfaces again, and check which confidence interval the best choice corresponds to */ 544 | for (k=0;knfiles;++k) { 545 | double x; 546 | // no need to re-read as all inputs are stored in memory 547 | /* bin_file=open_for_read(par->fnames[k],".bin"); */ 548 | // gsl_matrix_fread(bin_file,err_surf); /* we read this successfully before */ 549 | // emin=gsl_matrix_get(err_surf,imint[0],imint[1]); /* get energy value at best splitting parameters of ensemble */ 550 | /* gsl_vector_fread(bin_file,v_err_surf); */ 551 | emin=gsl_vector_get(v_err_surf[k],imint_1d); 552 | VRB(printf("File %d: %s emin %f valmin[k]: %f\n",k,par->fnames[k],emin,valmin[k])); 553 | 554 | /* this is the forward calculation of the confidence level from the energy ratio */ 555 | x=(emin/valmin[k]-1)*dof[k]/split_par; 556 | x=MIN(1,(double)(dof[k]/(dof[k]+split_par*x))); /* for exact co-incidence round-off can lead to x values slightly larger than 1, hence have to use MIN */ 557 | VRB(printf("X=%f\n",x)); 558 | postconf[k]=1-betai((double)dof[k]/2.,(double)split_par/2,x); 559 | 560 | for (l=0;l<9;l++) { 561 | if (postconf[k]<=conf[l]) 562 | break; 563 | } 564 | conflevel[k]=l; 565 | 566 | printf("Confidence value for %s : %f\n",par->fnames[k],postconf[k]); 567 | /* fclose(bin_file); */ 568 | } 569 | 570 | if (par->gmt && dim==2) { 571 | /*convert bin error surface to grd file*/ 572 | sprintf(cmdstring,"xyz2grd %s.bin -D%s/%s/%s/1/0/SingleSplit/\"Created by error_stack\" -G%s.grd -I%f/%f -R%f/%f/%f/%f -ZBLd", 573 | par->root,rlabel[1],rlabel[0],methodstring,par->root, 574 | rstep[1],rstep[0], 575 | rmin[1],rmax[1],rmin[0],rmax[0]); 576 | VRB(printf("GRD conversion: %s\n",cmdstring)); 577 | status=system(cmdstring); 578 | if (status) { 579 | sprintf(warn_str,"External GMT command xyz2grd execution failed. Error status: %d",status); 580 | warn_msg(warn_str); 581 | } 582 | output=open_for_write(par->root,".gmt"); 583 | fprintf(output,"#!/bin/csh\n"); 584 | fprintf(output,"# script auto-generated by multisplit\n"); 585 | fprintf(output,"\n"); 586 | fprintf(output,"# Variable parameters:\n"); 587 | fprintf(output,"set root=%s\n",par->root); 588 | fprintf(output,"set best0=%f\n",best[0]); 589 | fprintf(output,"set best1=%f\n",best[1]); 590 | fprintf(output,"set label0=\"%s\"\n",rlabel[0]); 591 | fprintf(output,"set label1=\"%s\"\n",rlabel[1]); 592 | fprintf(output,"cat > $root.description < 10 29.5 12 0 0 CT 0.564 20 c\n"); 594 | fprintf(output,"%s\n\n",par->root); 595 | fprintf(output,"%s %s stack of %d files.\n\n",rmethodstring,(par->weight ? "weighted" : "unweighted" ),par->nfiles); 596 | fprintf(output,"Energy Minimum %f (normalised: %f) DOF %f\n\n",emin,emin/tot_weight,tot_dof); 597 | fprintf(output," %s %3.0f \\261 %3.0f %s %4.2f \\261 %4.2f RejectNull %s\n", 598 | rlabel[0],best[0],err[0], rlabel[1],best[1],err[1],rejectstring); 599 | fprintf(output,"EOF\n\n"); 600 | fprintf(output,"cat > /tmp/${root}_legend.txt <=3?l-2:0),100*conf[l]); 604 | } 605 | fprintf(output,"EOF\n\n"); 606 | fprintf(output,"cat > ${root}_allsplit.xy <nfiles;k++) 608 | fprintf(output,"%f %f %d\n",min[1]+imin[k][1]*step[1],min[0]+imin[k][0]*step[0],conflevel[k]); 609 | fprintf(output,"EOF\n\n"); 610 | fprintf(output,"\ 611 | ### Everything below this line is independent of the particular event used\n\ 612 | \n\ 613 | set grdrange=`grdinfo -C ${root}.grd | awk '{print $2 \"/\" $3 \"/\" $4 \"/\" $5 }'`\n\ 614 | set psfile=${root}.ps\n\ 615 | \n\ 616 | gmtdefaults -D >.gmtdefaults\n\ 617 | gmtset PAGE_ORIENTATION portrait MEASURE_UNIT cm WANT_EURO_FONT TRUE LABEL_FONT_SIZE 12 ANOT_FONT_SIZE 10 PAPER_MEDIA a4 D_FORMAT %%lg\n\ 618 | \n\ 619 | \n\ 620 | # color scheme dark green - light green - orange - orangered - red - dark red\n\ 621 | # schemecolor.com red orange and green scheme\n\ 622 | cat > /tmp/${root}.cpt < $psfile <${root}.description\n\ 634 | \n\ 635 | # 8 cm Error surface\n\ 636 | grdcontour -X2 -Y20.5 ${root}.grd -C${root}.cont -R$grdrange -JX17/6.5 -B0.5:\"$label1\":/20:\"$label0\":WSen -O -K -A-1f1 -G1000 -Wa1.5p -Wc0.5p >>$psfile\n\ 637 | psxy -R -JX -Sx0.5 -W2p/100/100/100 -O -K >>$psfile <>$psfile \n\ 641 | \n\ 642 | \n\ 643 | # Legend\n\ 644 | psxy -C/tmp/$root.cpt -R0/17/0/6.5 -Jx1 -S+0.2 -W1p -N -O -K >>$psfile <>$psfile >$psfile\n\ 656 | \\rm /tmp/${root}.cpt /tmp/${root}_legend.txt\n\ 657 | "); 658 | fclose(output); 659 | sprintf(cmdstring,"csh %s.gmt",par->root); 660 | VRB(printf("Executing GMT script %s\n",cmdstring)); 661 | status=system(cmdstring); 662 | /* status=system("echo hello world; csh err_stack_test.gmt ; echo hello world again"); */ 663 | if (status) { 664 | sprintf(warn_str,"Execution of GMT script failed. Error status: %d",status); 665 | warn_msg(warn_str); 666 | } 667 | } 668 | return 0; 669 | } 670 | 671 | 672 | 673 | FILE *open_for_write(char *root,char *extension){ 674 | char tmpstring[256]; 675 | FILE *output; 676 | strcpy(tmpstring, root); 677 | strcat(tmpstring, extension); 678 | 679 | output=fopen(tmpstring,"wb"); 680 | if (!output) { 681 | sprintf(abort_str,"Cannot open %s for output.",tmpstring); 682 | abort_msg(abort_str); 683 | } 684 | return(output); 685 | } 686 | 687 | FILE *open_for_read(char *root,char *extension){ 688 | char tmpstring[256]; 689 | FILE *output; 690 | strcpy(tmpstring, root); 691 | strcat(tmpstring, extension); 692 | 693 | output=fopen(tmpstring,"r"); 694 | if (!output) { 695 | sprintf(abort_str,"Cannot open %s for input.",tmpstring); 696 | abort_msg(abort_str); 697 | } 698 | return(output); 699 | } 700 | 701 | 702 | void parse(int argc, char **argv, params *par) { 703 | int iarg; 704 | char *dummy; 705 | /* Default markers ( Defaults depend on other options ) */ 706 | par->root[0]='\0'; 707 | par->weight=0; 708 | par->gmt=0; 709 | par->nfiles=0; 710 | par->use_exact=0; 711 | par->mcsamples=100; 712 | par->bootstrap_samples=0; 713 | par->scale_dof=1.; 714 | 715 | iarg=0; 716 | while(++iarguse_exact = 1; } 726 | else if(!strncasecmp(argv[iarg],"-weig",5)) { 727 | par->weight = 1; } 728 | else if(!strncasecmp(argv[iarg],"-gmt",4)) { 729 | par->gmt = 1; } 730 | else if(!strncasecmp(argv[iarg],"-name",5) ) { 731 | if ( iarg+1>=argc ) 732 | abort_msg("-name must be followed by 1 argument (file name root)"); 733 | strncpy(par->root,argv[++iarg],256); par->root[255]='\0'; 734 | } 735 | else if(!strncasecmp(argv[iarg],"-mc",3) ) { 736 | if ( iarg+1>=argc ) 737 | abort_msg("-mc must be followed by 1 argument (number of samples)"); 738 | par->mcsamples=(int)strtol(argv[++iarg],NULL,10); 739 | if (errno || par->mcsamples<=0 ) { 740 | abort_msg("Argument of -mc must be a positive integer number"); 741 | } 742 | } 743 | else if(!strncasecmp(argv[iarg],"-bootstrap",10) ) { 744 | if ( iarg+1>=argc ) 745 | abort_msg("-bootstrap must be followed by 1 argument (number of samples)"); 746 | par->bootstrap_samples=(int)strtol(argv[++iarg],NULL,10); 747 | if (errno || par->bootstrap_samples<0 ) { // accept 0 as meaning effectively no bootstrap samples 748 | abort_msg("Argument of -bootstrap must be a positive integer number"); 749 | } 750 | } 751 | else if(!strncasecmp(argv[iarg],"-scale-dof",10) ) { 752 | if ( iarg+1>=argc ) 753 | abort_msg("-scale-dof must be followed by 1 argument (float)"); 754 | par->scale_dof=(float)strtod(argv[++iarg],NULL); 755 | if (errno || par->scale_dof<=0 ) { 756 | abort_msg("Argument of -mc must be a positive (float) number"); 757 | } 758 | } 759 | else if(!strncasecmp(argv[iarg],"-h",2)) { 760 | usage("error_stack"); } 761 | else if(!strncasecmp(argv[iarg],"-v",2)) { 762 | verbose=1; } 763 | else { 764 | fprintf(stderr,"%s ",argv[iarg]); 765 | abort_msg("is not a known option"); 766 | } 767 | } 768 | for (iarg=iarg;iargfnames[par->nfiles]=strdup(argv[iarg]); 770 | dummy=rindex(argv[iarg],'.'); 771 | if (!strcmp(dummy,".bin")) { 772 | /* strip .bin extension */ 773 | par->fnames[par->nfiles][(size_t)(dummy-argv[iarg])]='\0'; 774 | } 775 | if (strlen(par->root)==0) { 776 | strncpy(par->root,par->fnames[par->nfiles],240); 777 | strcat(par->root,"_stack"); 778 | } 779 | ++par->nfiles; 780 | if (par->nfiles >= MAXFILES ) { 781 | sprintf(abort_str,"ERROR: maximum number of files (%d) exceeded. Increase MAXFILES in error_stack.c and recompile\n",MAXFILES); 782 | abort_msg(abort_str); 783 | } 784 | } 785 | if (par->nfiles==0) 786 | abort_msg("For stacking we need at least one surface to stack. Use -h option to get help"); 787 | } 788 | 789 | void abort_msg(char *msg) { 790 | fprintf(stderr,"%s\n ABORT \n",msg); 791 | exit(10); 792 | } 793 | 794 | void warn_msg(char *msg) { 795 | fprintf(stderr,"WARNING: %s\n",msg); 796 | } 797 | 798 | void usage(char *cmd) { 799 | fprintf(stderr,"Usage: %s [OPTIONS] file1 file2 file3 ... \n",cmd); 800 | fprintf(stderr,"\ 801 | file1 ... must be .bin files (output of e.g. multisplit). \n\ 802 | The corresponding .hdr files must also be present. Note that the .bin\n\ 803 | extension of the files can be omitted.\n\ 804 | \n\ 805 | OUTPUT FILES\n\ 806 | \n\ 807 | .bin, .hdr the stacked error surfaces\n\ 808 | \n\ 809 | .grd,.gmt,.ps grdfile, GMT scripts and postscript for visualisation \n\ 810 | of result (only for number of parameters equal 2)\n \ 811 | (if -gmt option has been selected)\n\ 812 | \n\ 813 | OPTIONS:\n\ 814 | \n\ 815 | -weight normalise error surfaces by minimum value before\n\ 816 | stacking (default is no normalisation)\n\ 817 | \n\ 818 | -name Set root of output file names\n\ 819 | (Default: derive name from first input file root)\n\ 820 | \n\ 821 | -gmt Plot results with GMT (only for number of parameters equal 2\n \ 822 | \n\ 823 | -mc How many Monte Carlo samples to use (only for number of parameters not equal two\n\ 824 | [ Default 100]\n\ 825 | -exact When calculating sample of distribution, use the exact point of the grid search\n\ 826 | [Default: randomize sample point within half a step length either way of the gridpoint]\n\ 827 | -scale-dof Used to scale the input degrees-of-freedom. Overestimate in number of degrees of\n\ 828 | results in underestimate in uncertainty. So if the uncertainty appears too small,\n\ 829 | use a scalefactor less than 1, if they appear too big, use a scalefactor of more than 1.\n\ 830 | \n\ 831 | -bootstrap Use bootstrap over error surfaces to estimate uncertainty\n\ 832 | Also affected by -exact option\n\ 833 | [ Default do not estimate bootstrap errors]\n\ 834 | \n\ 835 | -v Verbose output\n\ 836 | "); 837 | exit(10); 838 | } 839 | -------------------------------------------------------------------------------- /multisplit.c: -------------------------------------------------------------------------------- 1 | /* multisplit */ 2 | /* Author: F Tilmann */ 3 | /* Contact: tilmann|a|gfz-potsdam.de */ 4 | 5 | /* Create splitting estimate and error surface by grid search for splitting parameters */ 6 | /* Several different methods of measuring splitting are implemented */ 7 | 8 | /* (C) 2004 F Tilmann */ 9 | /* This source code is released under the GNU public license */ 10 | 11 | /* Code uses sac, gsl and gslblas libraries and needs GMT programs to be installed */ 12 | 13 | /* History: 14 | no version number: single layer splitting 15 | v0.1 : first version with double layer splitting 16 | bug fix in single_split_sks - when calculating convolution in freq domain, the exceptions at i=0 and i=N/2 were not taken into account properly 17 | */ 18 | #define MULTISPLIT_VERSION "0.1a" 19 | 20 | #include 21 | #include 22 | #include 23 | #include 24 | #include 25 | #include 26 | 27 | #include 28 | #include 29 | #include 30 | #include 31 | #include 32 | #include 33 | /* #include */ 34 | #include 35 | 36 | /* #include "saclib.h" */ 37 | /* multisplit.h includes: sac.h */ 38 | #include "sac_help.h" 39 | #include "multisplit.h" 40 | 41 | 42 | 43 | int verbose=0; 44 | #define VRB(command) { if(verbose) { command ; fflush(stdout); }} 45 | #define ASSERT(cond,msg) { if (!(cond)) { fprintf(stderr,"ASSERTION VIOLATION: %s\n ABORT \n",msg); /* exit(10); */}} 46 | 47 | char warn_str[1024]; 48 | char abort_str[1024]; 49 | 50 | int main(int argc, char **argv) 51 | { 52 | ms_params *par=(ms_params *) malloc(sizeof(ms_params)); 53 | /* window definition */ 54 | long wbeg,wlen; 55 | long refwbeg,refwlen; 56 | float maxsumlag; 57 | gsl_vector_float *hor1,*hor2,*ref1,*ref2; 58 | 59 | hor_split *hsplit,*hsplit_top,*hsplit_bot; 60 | /* Grid search arrays */ 61 | gsl_matrix *mat_res,*mat_pol,*mat_delay, *mat_alpha; 62 | gsl_vector *res_energy_doublelayer; 63 | 64 | long ldum1,ldum2; 65 | int n,m,n_top,m_top,n_bot,m_bot; 66 | int mod_par; 67 | char tmpstring[256],phase[9]; 68 | 69 | /* invfisher test */ 70 | /* printf("1. %f\n",invfisher(2,20.85,0.68)); */ 71 | /* printf("2. %f\n",invfisher(20.85,2,0.68)); */ 72 | /* printf("3. %f\n",invfisher(2,20.85,0.95)); */ 73 | /* printf("4. %f\n",invfisher(20.85,2,0.95)); */ 74 | /* printf("PER(360,0)=%d\n",PER(360,0)); */ 75 | /* printf("PER(360,340)=%d\n",PER(360,340)); */ 76 | /* printf("PER(360,450)=%d\n",PER(360,450)); */ 77 | /* printf("PER(360,-20)=%d\n",PER(360,-20)); */ 78 | /* printf("PER(360,-380)=%d\n",PER(360,-380)); */ 79 | /* exit(0); */ 80 | 81 | parse(argc,argv, par); 82 | /* Check that sac files are consistent */ 83 | if(check_consistency(par->hdr_hor1,par->hdr_hor2, 84 | CONSISTENCY_STATION | CONSISTENCY_EVENT | CONSISTENCY_VERBOSE | CONSISTENCY_BEGIN )) 85 | abort_msg("Data files inconsistent"); 86 | make_rhs(&par->hdr_hor1,&par->data_hor1,&par->hdr_hor2,&par->data_hor2); 87 | 88 | if(!F_EQ(par->hdr_hor1->cmpaz,0.0)){ 89 | printf("Rotating components from %f/%f to NE system\n",par->hdr_hor1->cmpaz,par->hdr_hor2->cmpaz); 90 | gsl_float_rotate(par->data_hor1,par->data_hor2,par->hdr_hor1->cmpaz); 91 | par->hdr_hor1->cmpaz=0.0; 92 | par->hdr_hor2->cmpaz=90.0; 93 | } 94 | 95 | if(par->method==CORREL) { 96 | if(check_consistency(par->hdr_hor1,par->method_q.cor_par.hdr_ref1, 97 | CONSISTENCY_EVENT | CONSISTENCY_VERBOSE )) 98 | abort_msg("Inconsistency between data and reference files"); 99 | if(check_consistency(par->method_q.cor_par.hdr_ref1,par->method_q.cor_par.hdr_ref2, 100 | CONSISTENCY_STATION | CONSISTENCY_EVENT | CONSISTENCY_VERBOSE | CONSISTENCY_BEGIN )) 101 | abort_msg("Reference files inconsistent"); 102 | make_rhs(&par->method_q.cor_par.hdr_ref1,&par->method_q.cor_par.data_ref1, 103 | &par->method_q.cor_par.hdr_ref2,&par->method_q.cor_par.data_ref2); 104 | if(!F_EQ(par->method_q.cor_par.hdr_ref1->cmpaz,0.0)){ 105 | printf("Rotating components from %f/%f to NE system\n",par->method_q.cor_par.hdr_ref1->cmpaz,par->method_q.cor_par.hdr_ref2->cmpaz); 106 | gsl_float_rotate(par->method_q.cor_par.data_ref1,par->method_q.cor_par.data_ref2,par->method_q.cor_par.hdr_ref1->cmpaz); 107 | par->method_q.cor_par.hdr_ref1->cmpaz=0.0; 108 | par->method_q.cor_par.hdr_ref2->cmpaz=90.0; 109 | } 110 | } 111 | 112 | /* maxsumlag: maximum shift between seismograms in s */ 113 | maxsumlag=par->model_q.split_par.top.timemax + par->model_q.split_par.bot.timemax ; 114 | 115 | if(par->method==CORREL) { 116 | maxsumlag += par->method_q.cor_par.maxshift; 117 | } 118 | hor1=find_window(par->hdr_hor1,par->data_hor1,&par->window,maxsumlag,&wbeg,&wlen,phase); 119 | hor2=find_window(par->hdr_hor2,par->data_hor2,&par->window,maxsumlag,&ldum1,&ldum2,tmpstring); 120 | if (ldum1 != wbeg || ldum2 != wlen) { 121 | abort_msg("Inconsistent window definition (begin or length) between components for data files"); 122 | } 123 | if (strcmp(tmpstring,phase)) { 124 | sprintf(abort_str,"Inconsistent phase name between components for data files %s vs %s",tmpstring,phase); 125 | abort_msg(abort_str); 126 | } 127 | 128 | if(par->method==CORREL) { 129 | ref1=find_window(par->method_q.cor_par.hdr_ref1,par->method_q.cor_par.data_ref1, 130 | &par->window,0.0,&refwbeg,&refwlen,tmpstring); 131 | ref2=find_window(par->method_q.cor_par.hdr_ref2,par->method_q.cor_par.data_ref2, 132 | &par->window,0.0,&ldum1,&ldum2,tmpstring); 133 | /* setting maxsumlag to 0.0 for reference trace as we only shift the data trace */ 134 | if (ldum1 != refwbeg || ldum2 != refwlen) { 135 | /* fprintf(stderr,"DEBUG refwbeg %d ldum1 %d refwln %d ldum2 %d\n",refwbeg,ldum1,refwlen,ldum2); */ 136 | abort_msg("Inconsistent window definition (begin or length) between components for reference files"); 137 | } 138 | if ( refwlen != wlen ) { 139 | VRB(printf("refwlen %ld wlen %ld\n",refwlen,wlen)); 140 | abort_msg("Length of analysis window for data and reference files must be identical"); 141 | } 142 | if (strcmp(tmpstring,phase)) { 143 | abort_msg("Inconsistent phase names between data and reference files"); 144 | } 145 | } 146 | /* Initialise grid search */ 147 | VRB(printf("Init grid search\n")); 148 | switch (par->model) { 149 | case SINGLE_HOR_SPLIT: 150 | hsplit=&(par->model_q.split_par.bot); 151 | m=(hsplit->fastmax-hsplit->fastmin+TOLERANCE)/hsplit->faststep + 1; 152 | n=(hsplit->timemax-hsplit->timemin+TOLERANCE)/hsplit->timestep + 1; 153 | VRB(printf("Grid search matrix size %d x %d\n",m,n)); 154 | mat_res=gsl_matrix_alloc(m,n); 155 | if (par->method==MINEVALUE || par->method==MINTRANSVERSE ) 156 | mat_pol=gsl_matrix_alloc(m,n); 157 | else if (par->method==CORREL) { 158 | mat_delay=gsl_matrix_alloc(m,n); 159 | mat_alpha=gsl_matrix_alloc(m,n); 160 | } 161 | break ; 162 | case DOUBLE_HOR_SPLIT: 163 | hsplit_top=&(par->model_q.split_par.top); 164 | m_top=(hsplit_top->fastmax-hsplit_top->fastmin+TOLERANCE)/hsplit_top->faststep + 1; 165 | n_top=(hsplit_top->timemax-hsplit_top->timemin+TOLERANCE)/hsplit_top->timestep + 1; 166 | hsplit_bot=&(par->model_q.split_par.bot); 167 | m_bot=(hsplit_bot->fastmax-hsplit_bot->fastmin+TOLERANCE)/hsplit_bot->faststep + 1; 168 | n_bot=(hsplit_bot->timemax-hsplit_bot->timemin+TOLERANCE)/hsplit_bot->timestep + 1; 169 | // VRB(printf("hsplit_top = %f %f %f %f\n", 170 | // hsplit_top->fastmin, hsplit_top->fastmax,hsplit_top->faststep, (hsplit_top->fastmax-hsplit_top->fastmin+TOLERANCE)/hsplit_top->faststep + 1)); 171 | //VRB(printf("hsplit_top = %f %f %f\n", 172 | // hsplit_top->timemin, hsplit_top->timemax,hsplit_top->timestep )); 173 | 174 | VRB(printf("Grid search matrix size %d x %d x %d x %d = %d\n",m_top,n_top,m_bot,n_bot,m_top*n_top*m_bot*n_bot)); 175 | res_energy_doublelayer=gsl_vector_alloc(m_top*n_top*m_bot*n_bot); 176 | /* for Debug purposes to make sure all elements of vector filled */ 177 | gsl_vector_set_all( res_energy_doublelayer,-1.234); 178 | /* if (par->method==CORREL) { */ 179 | /* mat_delay=gsl_matrix_alloc(m,n); */ 180 | /* mat_alpha=gsl_matrix_alloc(m,n); */ 181 | /* } */ 182 | break ; 183 | } 184 | 185 | /* Single splitting implementation (later put this in loop over top layer for two layer splitting) */ 186 | switch (par->method) { 187 | case MINEVALUE: 188 | case MINTRANSVERSE: 189 | mod_par=(par->method==MINEVALUE ? 3 : 2); 190 | if (par->model== SINGLE_HOR_SPLIT) { 191 | single_split_sks(par->method, hsplit, hor1, hor2, wbeg, wlen, par->hdr_hor1->delta, par->hdr_hor1->baz, mat_res, mat_pol); 192 | } else if (par->model== DOUBLE_HOR_SPLIT) { 193 | double_split_sks(par->method, hsplit_top,hsplit_bot, hor1, hor2, wbeg, wlen, par->hdr_hor1->delta, par->hdr_hor1->baz, res_energy_doublelayer); 194 | } 195 | break; 196 | case CONV: 197 | abort_msg("CONV method not implemented yet"); 198 | break; 199 | case CORREL: 200 | mod_par=4; 201 | single_split_correl(par->method, hsplit, par->method_q.cor_par.maxshift, hor1, hor2, wbeg, ref1, ref2, refwbeg, wlen, par->hdr_hor1->delta, mat_res, mat_delay, mat_alpha); 202 | mat_pol=mat_delay; /* fiddle such that I can use standard err_single_split processing */ 203 | break; 204 | } 205 | 206 | /* Now we have the error surface and have to pick the best value and do error analysis */ 207 | VRB(printf("Error analysis\n")); 208 | if (par->model==SINGLE_HOR_SPLIT) { 209 | switch(par->method) { 210 | case MINEVALUE: 211 | /* Note: there are really three model parameters as the polarisation is undetermined 212 | (none of the papers seem to do it this way, though, so maybe my thinking is wrong and 213 | it should be just 2 model parameters? */ 214 | err_single_split_sks(par, mat_res, hor1,hor2,wbeg,wlen,1,phase, mat_pol, NULL, NULL, NULL, -1); 215 | break; 216 | case MINTRANSVERSE: 217 | err_single_split_sks(par, mat_res, hor1,hor2,wbeg,wlen,0,phase, NULL, NULL, NULL, NULL, -1); 218 | break; 219 | case CONV: 220 | abort_msg("CONV method not implemented yet"); 221 | break; 222 | case CORREL: 223 | par->dof_s *=2; /* multiply degrees of freedom per second by two as there are two traces! */ 224 | err_single_split_sks(par, mat_res,hor1,hor2,wbeg,wlen,2,phase,mat_delay,mat_alpha,ref1,ref2,refwbeg); 225 | break; 226 | } 227 | } else if (par->model==DOUBLE_HOR_SPLIT) { 228 | switch(par->method) { 229 | case MINEVALUE: 230 | case MINTRANSVERSE: 231 | err_double_split_sks(par,res_energy_doublelayer,hor1,hor2,wbeg,wlen,phase); 232 | break; 233 | default: 234 | abort_msg("Error analysis for double layer splitting only implemented for minimum eigenvaluer and minimum transverse criteria"); 235 | break; 236 | } 237 | } 238 | return(0); 239 | } 240 | 241 | void err_double_split_sks(ms_params *par, gsl_vector *res_energy_doublelayer, gsl_vector_float *north, gsl_vector_float *east,long beg, long len, char *phase) { 242 | /* Error analysis and output 243 | *res_energy_doublelayer unwrapped four-dimensional matrix of misfits 244 | 245 | Task: 246 | * writes 4-D error surface as binary file (for later averaging) 247 | * output best estimate (note that this is not meaningful due to non-uniqueness for single event measurement 248 | */ 249 | hor_split *hsplit_top=&par->model_q.split_par.top; 250 | hor_split *hsplit_bot=&par->model_q.split_par.bot; 251 | int m_top=(hsplit_bot->fastmax-hsplit_bot->fastmin+TOLERANCE)/hsplit_bot->faststep + 1; 252 | int n_top=(hsplit_bot->timemax-hsplit_bot->timemin+TOLERANCE)/hsplit_bot->timestep + 1; 253 | int m_bot=(hsplit_bot->fastmax-hsplit_bot->fastmin+TOLERANCE)/hsplit_bot->faststep + 1; 254 | int n_bot=(hsplit_bot->timemax-hsplit_bot->timemin+TOLERANCE)/hsplit_bot->timestep + 1; 255 | long int imin; 256 | int j_top,k_top,j_bot,k_bot; 257 | double emin; 258 | double best_fast_top, best_time_top, best_fast_bot, best_time_bot; 259 | sachdr *hdr=par->hdr_hor1; 260 | char evname[256],tmpstring[256],*methodstring; 261 | float delta=par->hdr_hor1->delta; 262 | int split_par=4; /* Number of splitting parameters fast and spl delay for top and bottom layer */ 263 | double data_dof=par->dof_s * (len * delta - MAX(par->window.taper,0.0)); 264 | double dof; 265 | int mod_par; 266 | FILE *output; 267 | 268 | /* WRITEVEC("res_energy_doublelayer.xy",res_energy_doublelayer); */ 269 | 270 | switch (par->method) { 271 | case MINTRANSVERSE: 272 | methodstring=strdup("MinimumTransverse"); 273 | mod_par=0; 274 | break; 275 | case MINEVALUE: 276 | methodstring=strdup("MinimumEigenvalue"); 277 | mod_par=1; 278 | break; 279 | } 280 | dof=data_dof-mod_par-split_par; 281 | 282 | /* determine minimum solution */ 283 | imin=gsl_vector_min_index(res_energy_doublelayer); 284 | emin=gsl_vector_get(res_energy_doublelayer,imin); 285 | 286 | // ind2sub: get to 4-D index from two-D index 287 | k_bot=imin % n_bot; 288 | j_bot=(imin / n_bot) % m_bot; 289 | k_top=(imin / (n_bot*m_bot)) % n_top; 290 | j_top=(imin / (n_bot*m_bot*n_top)) % m_top ; // which should be the same as (imin / (n_bot*m_bot*n_top) 291 | best_fast_top=hsplit_top->fastmin+j_top*hsplit_top->faststep; 292 | best_time_top=hsplit_top->timemin+k_top*hsplit_top->timestep; 293 | best_fast_bot=hsplit_bot->fastmin+j_bot*hsplit_bot->faststep; 294 | best_time_bot=hsplit_bot->timemin+k_bot*hsplit_bot->timestep; 295 | 296 | /* stdout: */ 297 | make_event_name(evname,hdr,EVN_YYJJJHHMM); 298 | printf("Event: %s\n",evname); 299 | printf("Station: %8.8s\n",hdr->kstnm); 300 | printf("Backazimuth (dg): %3.0f\n",hdr->baz); 301 | printf("Distance (dg): %3.0f\n",hdr->gcarc); 302 | printf("Depth (km): %3.0f\n",hdr->evdp); 303 | printf("Phase: %-8s\n",phase); 304 | printf("%s: %f\n",methodstring,emin); 305 | printf("Top Fast dir.: %3.0f Split Delay: %4.2f s\n",best_fast_top,best_time_top); 306 | printf("Bot Fast dir.: %3.0f Split Delay: %4.2f s\n",best_fast_bot,best_time_bot); 307 | 308 | /* Err_hdr */ 309 | strcpy(tmpstring, par->root); 310 | strcat(tmpstring, "_err2.hdr"); 311 | output=fopen(tmpstring,"w"); 312 | if (!output) { 313 | sprintf(abort_str,"Cannot open %s for output.",tmpstring); 314 | abort_msg(abort_str); 315 | } 316 | fprintf(output,"%s %d %f\n",methodstring,split_par,dof); 317 | fprintf(output,"4\n"); 318 | fprintf(output,"%d %d %d %d\n",m_top,n_top,m_bot,n_bot); 319 | fprintf(output,"TopFast %f %f %f\n",hsplit_top->fastmin,hsplit_top->fastmin+(m_top-1)*hsplit_top->faststep,hsplit_top->faststep); 320 | fprintf(output,"TopSplitDly %f %f %f\n",hsplit_top->timemin,hsplit_top->timemin+(n_top-1)*hsplit_top->timestep,hsplit_top->timestep); 321 | fprintf(output,"BotFast %f %f %f\n",hsplit_bot->fastmin,hsplit_bot->fastmin+(m_bot-1)*hsplit_bot->faststep,hsplit_bot->faststep); 322 | fprintf(output,"BotSplitDly %f %f %f\n",hsplit_bot->timemin,hsplit_bot->timemin+(n_bot-1)*hsplit_bot->timestep,hsplit_bot->timestep); 323 | fclose(output); 324 | /* err bin */ 325 | strcpy(tmpstring, par->root); 326 | strcat(tmpstring, "_err2.bin"); 327 | output=fopen(tmpstring,"wb"); 328 | if (!output) { 329 | sprintf(abort_str,"Cannot open %s for output.",tmpstring); 330 | abort_msg(abort_str); 331 | } 332 | gsl_vector_fwrite(output, res_energy_doublelayer); 333 | fclose(output); 334 | 335 | } 336 | 337 | 338 | void err_single_split_sks(ms_params *par, gsl_matrix *m_res_energy, gsl_vector_float *north, gsl_vector_float *east,long beg, long len, long mod_par, char *phase, gsl_matrix *m_aux1, gsl_matrix *m_aux2, gsl_vector_float *ref_north, gsl_vector_float *ref_east, long refbeg) { 339 | /* Error analysis and output 340 | m_err matrix containing residual energy estimates 341 | len: length of analysis window in samples 342 | mod_par: number of additional model parameters (e.g. 0 for Min Transvers, or 1 for Min E Value (polarisation), 2 for reference station method (alpha value and delay) 343 | phase: name of the phase to be used 344 | 345 | Compact output format 346 | Output: 347 | summary of result to standard out 348 | 349 | root_split.txt: one line summary 350 | event station phase fast errfast(perp) split-delay errdelay(perp) reject-null? baz dist depth pol accept-null 351 | 352 | pol: inferred initial polarisation direction (either from BAZ or eigenvector) 353 | accept-null : 1 if pattern appears to be zero-splitting pattern 354 | 0 noisy or significant splitting (zero=0 and reject-null<0.95 implies noisy data) 355 | 356 | root_err.hdr: text file with information about _err.bin file 357 | line0: file info 358 | 359 | line1: dim (number of dimensions of grid file) 360 | line2: m n ... (number of values along each dimension 361 | line3: descr1 min1 max1 step1 data for first dimension 362 | line4: descr2 min2 max2 step2 363 | 364 | Alternatives for line0 365 | line0: MinTransverse mod_par dof 366 | line0: MinEvalue mod_par dof 367 | line0: ResidualRefObsData mod_par dof 368 | line0: POLARIZATION 369 | (NB Only output polarisation file for MINEVALUE method) 370 | 371 | root_err.bin: Error surface as binary table 372 | 373 | Optional: 374 | root_err.grd: GMT format error surface (normalised such that minimum value = 1 but retain actual value in scale parameter 375 | root_err.cont: Contour file with 68%,95.2%,99%, 99.9%,99.99% and 99.999% confidence intervals 376 | */ 377 | double conf[9]={.68, .95,.99, .999,.9999,.99999,.999999,.9999999, .99999999 }; /* conf[1] is the level of significance */ 378 | double contour[9]; 379 | double data_dof,dof; 380 | double null; 381 | double emin; 382 | double pol=NAN,lin=NAN; 383 | double best_time,best_fast; 384 | float delta=par->hdr_hor1->delta; 385 | float maxamp,tmpmax,tmpmin; 386 | double lbound_fast,ubound_fast,err_fast,lbound_time,ubound_time,err_time; 387 | size_t dum1,dum2; 388 | long split_par; 389 | long jpol=-1,jpolp=-1; 390 | long i,jmin,kmin,j1,j2,k1,k2,m,n,k1sec; 391 | hor_split *hsplit=&par->model_q.split_par.bot; 392 | int periodic,zero; 393 | char evname[256],tmpstring[256],dummystring[256],cmdstring[256],rejectstring[256]; 394 | char *methodstring; 395 | char *descrip1=NULL,*ext1=NULL,*ext,*descrip; 396 | char *descrip2=NULL,*ext2=NULL; 397 | sachdr *hdr=par->hdr_hor1; 398 | FILE *output; 399 | int status; 400 | gsl_matrix *m_aux; 401 | gsl_vector_float_view vue1,vue2; 402 | gsl_vector_view dvue1; 403 | gsl_vector_float *vec1=gsl_vector_float_alloc(len); 404 | gsl_vector_float *vec2=gsl_vector_float_alloc(len); 405 | 406 | m=m_res_energy->size1; 407 | n=m_res_energy->size2; 408 | 409 | /* determine minimum solution */ 410 | gsl_matrix_min_index(m_res_energy,&dum1,&dum2); jmin=(long)dum1; kmin=(long)dum2; 411 | emin=gsl_matrix_get(m_res_energy,jmin,kmin); 412 | best_fast=hsplit->fastmin+jmin*hsplit->faststep; 413 | best_time=hsplit->timemin+kmin*hsplit->timestep; 414 | 415 | split_par=2; /* Number of parameters of splitting model: Fast direction and splitting delay */ 416 | /* Method specific values */ 417 | switch (par->method) { 418 | case MINTRANSVERSE: 419 | methodstring=strdup("MinimumTransverse"); 420 | pol=hdr->baz; 421 | /* polarity is BAZ mod 180 */ 422 | if (pol<0) pol+=180; 423 | if (pol>180) pol-=180; 424 | break; 425 | case MINEVALUE: 426 | methodstring=strdup("MinimumEigenvalue"); 427 | descrip1=strdup("Polarisation"); 428 | ext1=strdup("pol"); 429 | /* Get polarity from measurement */ 430 | pol=gsl_matrix_get(m_aux1,jmin,kmin); 431 | break; 432 | case CORREL: 433 | methodstring=strdup("ResidualRefObsData"); 434 | descrip1=strdup("Shift"); 435 | ext1=strdup("dly"); 436 | descrip2=strdup("AmplitudeFactor"); 437 | ext2=strdup("alpha"); 438 | 439 | vue1=gsl_vector_float_subvector(ref_north,refbeg,len); 440 | vue2=gsl_vector_float_subvector(ref_east,refbeg,len); 441 | pol=gsl_df_polarisation(&vue1.vector,&vue2.vector,&lin); 442 | break; 443 | } 444 | /* compute confidence levels (multipliers of minimum energy) */ 445 | data_dof=par->dof_s * (len * delta - MAX(par->window.taper,0.0)); 446 | dof=data_dof-mod_par-split_par; 447 | VRB(printf("data_dof %f len*delta %f taper %f mod_par %ld split_par %ld dof %f\n",data_dof,len*delta,par->window.taper,mod_par,split_par,dof)); 448 | if (dof<2) { 449 | sprintf(warn_str,"Degrees of freedom less than 2 (DOF=%f). Set to 2 but error estimates likely to be meaningless.",dof); 450 | warn_msg(warn_str); 451 | dof=2; 452 | } 453 | if (!isnan(pol)) { 454 | /* index in table corresponding to inferred initial polarisation */ 455 | jpol=ROUND((pol-hsplit->fastmin)/hsplit->faststep); 456 | /* index in table corresponding to direction perpendicular to inferred initial polarisation */ 457 | jpolp=ROUND(((pol>=90 ? pol-90 : pol+90) -hsplit->fastmin)/hsplit->faststep); 458 | } 459 | /* index corresponding to splitting delay of 1s */ 460 | k1sec=ROUND((1-hsplit->timemin)/hsplit->timestep); 461 | null=0.0; 462 | 463 | /* check error bounds and likelyhood level of null splitting */ 464 | for(i=0;i<9;i++) { 465 | double invfish=invfisher((double)split_par,dof,conf[i]); 466 | if (invfish>=0.0) { 467 | contour[i]=1+split_par*invfish/dof; 468 | } else { 469 | /* if calculation fails choose some defaults that don't make sense but will not crash */ 470 | if (i>0) 471 | contour[i]=contour[i-1]; 472 | else 473 | contour[i]=1; 474 | } 475 | VRB(printf("i: %ld confidence %f contour %f\n",i,conf[i],contour[i])); 476 | if (F_EQ(hsplit->timemin,0.0) && contour[i]*eminmake_grd) { 480 | strcpy(dummystring, par->root); 481 | strcat(dummystring, ".cont"); 482 | output=fopen(dummystring,"w"); 483 | if (!output) { 484 | sprintf(abort_str,"Cannot open %s for output.",dummystring); 485 | abort_msg(abort_str); 486 | } 487 | for (i=0;i<9;i++){ 488 | fprintf(output,"%f %s\n",contour[i]*emin, (i==1 ? "A" : "C" )); 489 | } 490 | fclose(output); 491 | } 492 | 493 | if(hsplit->timemin!=0.0) 494 | null=-1; /* Null confidence level is only meaningful if first column represents 0 splitting */ 495 | /* Test whether data is not only consistent with null splitting but whether the patterns is the typical 496 | two-branch zero splitting pattern. If 497 | 1. fast or slow direction perpendicular to backazimuth and a splitting delay of 1s is accepted within 95% conf. 498 | interval 499 | 2. fast or slow direction at 45 degree to backazimuth and a splitting delay of 1s is rejected at 95% confidence 500 | then call the result a likely null 501 | (NB the proper way to do this would be to compare the variances for these two splitting parameters with an 502 | F-test) 503 | */ 504 | VRB(printf("jpol: %ld jpolp %ld\n",jpol,jpolp)); 505 | if ( jpol>=0 && jpol=0 && jpolp=0 && k1sec=gsl_matrix_get(m_res_energy,jpol,k1sec) 507 | && contour[1]*emin>=gsl_matrix_get(m_res_energy,jpolp,k1sec) 508 | && contour[1]*emincontour[1]*emin) 520 | break; 521 | } 522 | for(k2=kmin-1;k2>=0;k2--) { 523 | if (gsl_matrix_get(m_res_energy,jmin,k2)>contour[1]*emin) 524 | break; 525 | } 526 | lbound_time=hsplit->timemin+(k2+1)*hsplit->timestep; 527 | ubound_time=hsplit->timemin+(k1-1)*hsplit->timestep; 528 | err_time=MAX(ubound_time-best_time,best_time-lbound_time); 529 | VRB(printf("Local search time %f-%f (E: %f)\n",lbound_time,ubound_time,err_time)); 530 | /* Global search, overwrite results of perpendicular search: */ 531 | for (k1=n-1; k1>=kmin;k1--) { 532 | dvue1=gsl_matrix_column(m_res_energy,k1); 533 | if (gsl_vector_min(&dvue1.vector) <= contour[1]*emin) 534 | break; 535 | } 536 | for (k2=0; k2<=kmin;k2++) { 537 | dvue1=gsl_matrix_column(m_res_energy,k2); 538 | if (gsl_vector_min(&dvue1.vector) <= contour[1]*emin) 539 | break; 540 | } 541 | 542 | lbound_time=hsplit->timemin+k2*hsplit->timestep; 543 | ubound_time=hsplit->timemin+k1*hsplit->timestep; 544 | err_time=MAX(ubound_time-best_time,best_time-lbound_time); 545 | VRB(printf("Global search time %f-%f (E: %f)\n",lbound_time,ubound_time,err_time)); 546 | if (k1==n-1 && k2==0) /* both bounds at limit of grid search -> no constraints */ 547 | /* err_time=nan(""); */ /* set to NaN */ 548 | err_time=NAN; 549 | else if (k1==n-1 ) /* upper bounds at limit of grid search */ 550 | err_time=-err_time; /* set error to negative (as flag) */ 551 | 552 | /* Fast direction: there is a complication here because of the 180 deg periodicity of solutions. 553 | We resolve this by wrapping round the 554 | search but only if 180+fastmin-fastmax is less than 2 faststep (otherwise only a sub-region is searched 555 | and wrap around is not an issue */ 556 | if(180+hsplit->fastmin-hsplit->fastmax<2*hsplit->faststep) { 557 | VRB(printf("Periodic fast direction\n")); 558 | periodic=1; 559 | } else { 560 | VRB(printf("Non-Periodic fast direction\n")); 561 | periodic=0; 562 | } 563 | for(j1=jmin+1; j1<(periodic ? m/2+1+jmin: m); j1++) { 564 | /* VRB(printf("j1=%d Stop at %d\n",j1, (periodic ? jmin+m : m))); */ 565 | if (gsl_matrix_get(m_res_energy,PER(m,j1),kmin)>contour[1]*emin) 566 | break; 567 | } 568 | /* VRB(printf("Init j2=%d Stop at %d\n",jmin-1, (periodic ? jmin-m+1 : 0))); */ 569 | for(j2=jmin-1; j2>=(periodic ? jmin-m/2 : 0) ;j2--) { 570 | /* VRB(printf("j2=%d Stop at %d\n",j2, (periodic ? jmin-m+1 : 0))); */ 571 | if (gsl_matrix_get(m_res_energy,PER(m,j2),kmin)>contour[1]*emin) 572 | break; 573 | } 574 | ubound_fast=hsplit->fastmin+(j1-1)*hsplit->faststep; 575 | lbound_fast=hsplit->fastmin+(j2+1)*hsplit->faststep; 576 | err_fast=MAX(ubound_fast-best_fast,best_fast-lbound_fast); 577 | VRB(printf("Local search fast direction %f-%f (E: %f)\n",lbound_fast,ubound_fast,err_fast)); 578 | 579 | /* Global search, overwrite results of perpendicular search: */ 580 | for (j1=(periodic ? jmin+m/2 : m-1); j1>=jmin;j1--) { 581 | dvue1=gsl_matrix_row(m_res_energy,PER(m,j1)); 582 | if (gsl_vector_min(&dvue1.vector) <= contour[1]*emin) 583 | break; 584 | } 585 | for (j2=(periodic ? jmin-m/2 : 0); j2<=jmin;j2++) { 586 | dvue1=gsl_matrix_row(m_res_energy,PER(m,j2)); 587 | if (gsl_vector_min(&dvue1.vector) <= contour[1]*emin) 588 | break; 589 | } 590 | ubound_fast=hsplit->fastmin+j1*hsplit->faststep; 591 | lbound_fast=hsplit->fastmin+j2*hsplit->faststep; 592 | err_fast=MAX(ubound_fast-best_fast,best_fast-lbound_fast); 593 | VRB(printf("Global search fast direction %f-%f (E: %f)\n",lbound_fast,ubound_fast,err_fast)); 594 | 595 | if (err_fast>75.) 596 | err_fast=NAN; 597 | 598 | 599 | 600 | /* Output */ 601 | 602 | /* stdout: */ 603 | make_event_name(evname,hdr,EVN_YYJJJHHMM); 604 | if ((null)<0) 605 | strcpy(rejectstring, "UNK"); 606 | else if (null==0.0) 607 | strcpy(rejectstring, "<68"); 608 | else 609 | sprintf(rejectstring,"%7.4f",null*100); 610 | /* strncpy(dummystring,hdr->kstnm,8); dummystring[8]='\0'; */ 611 | /* VRB( printf("Energy: %f\n",emin)); */ 612 | 613 | 614 | printf("Event: %s\n",evname); 615 | printf("Station: %8.8s\n",hdr->kstnm); 616 | printf("Phase: %-8s\n",phase); 617 | printf("%s: %f\n",methodstring,emin); 618 | printf("Fast direction: %3.0f +- %3.0f (% 4.0f - %3.0f )\n",best_fast,err_fast,lbound_fast,ubound_fast); 619 | printf("Splitting delay : %4.2f +- %4.2f (% 4.2f - %4.2f )\n",best_time,err_time,lbound_time,ubound_time); 620 | if (strncmp(rejectstring,"UNK",3)) 621 | printf("Reject Null (%%) : %s (E: %f)\n",rejectstring,gsl_matrix_get(m_res_energy,0,0)); 622 | printf("Backazimuth (dg): %3.0f\n",hdr->baz); 623 | printf("Distance (dg): %3.0f\n",hdr->gcarc); 624 | printf("Depth (km): %3.0f\n",hdr->evdp); 625 | if (!isnan(pol)) 626 | printf("Initial Pol.(dg): %3.0f\n",pol); 627 | if (!isnan(lin)) 628 | printf("Linearity: %4.2f\n",lin); 629 | if (descrip1) 630 | printf("%-18s%f\n",descrip1,gsl_matrix_get(m_aux1,jmin,kmin)); 631 | if (descrip2) 632 | printf("%-18s%f\n",descrip2,gsl_matrix_get(m_aux2,jmin,kmin)); 633 | VRB(printf("Zero: %d, null %f\n",zero,null)); 634 | VRB(printf("Null %f conf[1] %f cond %d\n",null,conf[1],null>=conf[1])); 635 | 636 | if(zero==1) { 637 | if (null=conf[1]){ 644 | printf("Significant splitting likely\n"); 645 | } else { 646 | printf("Null accepted but no null pattern: Data likely to be noisy or splitting model not sufficiently complex\n"); 647 | } 648 | } 649 | 650 | /* compact one line output */ 651 | strcpy(dummystring, par->root); 652 | strcat(dummystring, "_split.txt"); 653 | output=fopen(dummystring,"w"); 654 | if (!output) { 655 | sprintf(abort_str,"Cannot open %s for output.",dummystring); 656 | abort_msg(abort_str); 657 | } 658 | 659 | fprintf(output, 660 | "#Event Station Phase Fast Err SDel Err Rej-0 BAZ Dis Dpt Pol Emin %-7s %-7s Zero?\n", 661 | ext1 ? ext1 : "", ext2 ? ext2 : ""); 662 | 663 | fprintf(output, 664 | "%s %8.8s %-8s %3.0f %3.0f %4.2f %5.2f %-7.7s %3.0f %3.0f %3.0f %3.0f %6.4f %-7.3f %-7.3f %1s\n", 665 | evname, 666 | hdr->kstnm, 667 | phase, 668 | best_fast,err_fast, 669 | best_time,err_time, 670 | rejectstring, 671 | hdr->baz, 672 | hdr->gcarc, 673 | hdr->evdp, 674 | pol, 675 | emin, 676 | m_aux1 ? gsl_matrix_get(m_aux1,jmin,kmin) : NAN, 677 | m_aux2 ? gsl_matrix_get(m_aux2,jmin,kmin) : NAN, 678 | zero==-1 ? "?" : (zero==1?"1":"0") ); 679 | fclose(output); 680 | 681 | /* Err_hdr */ 682 | strcpy(tmpstring, par->root); 683 | strcat(tmpstring, "_err.hdr"); 684 | output=fopen(tmpstring,"w"); 685 | if (!output) { 686 | sprintf(abort_str,"Cannot open %s for output.",tmpstring); 687 | abort_msg(abort_str); 688 | } 689 | fprintf(output,"%s %ld %f\n",methodstring,split_par,dof); 690 | fprintf(output,"2\n"); 691 | fprintf(output,"%ld %ld\n",m,n); 692 | fprintf(output,"Fast %f %f %f\n",hsplit->fastmin,hsplit->fastmin+(m-1)*hsplit->faststep,hsplit->faststep); 693 | fprintf(output,"SplitDly %f %f %f\n",hsplit->timemin,hsplit->timemin+(n-1)*hsplit->timestep,hsplit->timestep); 694 | fclose(output); 695 | /* err bin */ 696 | strcpy(tmpstring, par->root); 697 | strcat(tmpstring, "_err.bin"); 698 | output=fopen(tmpstring,"wb"); 699 | if (!output) { 700 | sprintf(abort_str,"Cannot open %s for output.",tmpstring); 701 | abort_msg(abort_str); 702 | } 703 | gsl_matrix_fwrite(output, m_res_energy); 704 | fclose(output); 705 | 706 | if (par->make_grd ) { 707 | sprintf(cmdstring,"%s %s_err.bin -DSplitDly/Fast/%s/1/0/SingleSplit/\"Created by multisplit\" -G%s_err.grd -I%f/%f -R%f/%f/%f/%f -ZBLd", 708 | par->make_grd == MAKE_GMT5 ? "gmt xyz2grd" :"xyz2grd", 709 | par->root,methodstring,par->root, 710 | hsplit->timestep,hsplit->faststep, 711 | hsplit->timemin,hsplit->timemin+(n-1)*hsplit->timestep,hsplit->fastmin,hsplit->fastmin+(m-1)*hsplit->faststep); 712 | VRB(printf("GRD conversion: %s\n",cmdstring)); 713 | status=system(cmdstring); 714 | if (status) { 715 | sprintf(warn_str,"External GMT command xyz2grd execution failed. Error status: %d",status); 716 | warn_msg(warn_str); 717 | } 718 | } 719 | 720 | /* treat both auxilary variables the same way */ 721 | for(i=0; i<2;i++) { 722 | switch (i) { 723 | case 0: 724 | m_aux=m_aux1; 725 | descrip=descrip1; 726 | ext=ext1; 727 | break; 728 | case 1: 729 | m_aux=m_aux2; 730 | descrip=descrip2; 731 | ext=ext2; 732 | break; 733 | } 734 | VRB(printf("i %ld M_AUX %p %p %p\n",i,m_aux,m_aux1,m_aux2)); 735 | 736 | if ( m_aux && descrip ) { 737 | VRB(printf("Generating bin files for %s\n",descrip)); 738 | sprintf(tmpstring,"%s_%s.hdr",par->root,ext); 739 | /* strcpy(tmpstring, par->root); */ 740 | /* strcat(tmpstring, "_pol.hdr"); */ 741 | output=fopen(tmpstring,"w"); 742 | if (!output) { 743 | sprintf(abort_str,"Cannot open %s for output.",tmpstring); 744 | abort_msg(abort_str); 745 | } 746 | fprintf(output,"%s\n",descrip); 747 | fprintf(output,"2\n"); 748 | fprintf(output,"%ld %ld\n",m,n); 749 | fprintf(output,"Fast %f %f %f\n",hsplit->fastmin,hsplit->fastmin+(m-1)*hsplit->faststep,hsplit->faststep); 750 | fprintf(output,"SplitDly %f %f %f\n",hsplit->timemin,hsplit->timemin+(n-1)*hsplit->timestep,hsplit->timestep); 751 | fclose(output); 752 | /* err bin */ 753 | sprintf(tmpstring,"%s_%s.bin",par->root,ext); 754 | /* strcpy(tmpstring, par->root); */ 755 | /* strcat(tmpstring, "_pol.bin"); */ 756 | output=fopen(tmpstring,"wb"); 757 | if (!output) { 758 | sprintf(abort_str,"Cannot open %s for output.",tmpstring); 759 | abort_msg(abort_str); 760 | } 761 | gsl_matrix_fwrite(output, m_aux); 762 | fclose(output); 763 | if (par->make_grd ) { 764 | sprintf(cmdstring, "%s %s_%s.bin -DSplitDly/Fast/%s/1/0/SingleSplit/\"Created by multisplit - minevalue mode\" -G%s_%s.grd -I%f/%f -R%f/%f/%f/%f -ZBLd", 765 | par->make_grd == MAKE_GMT5 ? "gmt xyz2grd" :"xyz2grd", 766 | par->root,ext,descrip,par->root,ext, 767 | hsplit->timestep,hsplit->faststep, 768 | hsplit->timemin,hsplit->timemin+(n-1)*hsplit->timestep,hsplit->fastmin,hsplit->fastmin+(m-1)*hsplit->faststep); 769 | VRB(printf("GRD conversion: %s\n",cmdstring)); 770 | status=system(cmdstring); 771 | if (status) { 772 | sprintf(warn_str,"External GMT command xyz2grd execution failed. Error status: %d",status); 773 | warn_msg(warn_str); 774 | } 775 | } 776 | } 777 | } 778 | if ( par->make_grd | MAKE_GMT ) { 779 | /* Output time series */ 780 | long itime; 781 | 782 | vue1=gsl_vector_float_subvector(north,beg,len); 783 | vue2=gsl_vector_float_subvector(east,beg,len); 784 | 785 | gsl_vector_float_memcpy(vec1, &vue1.vector); 786 | gsl_vector_float_memcpy(vec2, &vue2.vector); 787 | 788 | maxamp=0; 789 | /* output=open_for_write(par->root,"_north.xy"); */ 790 | /* gsl_float_write_timeseries(output,vec1,0,delta); */ 791 | /* fclose(output); */ 792 | 793 | /* output=open_for_write(par->root,"_east.xy"); */ 794 | /* gsl_float_write_timeseries(output,vec2,0,delta); */ 795 | /* fclose(output); */ 796 | 797 | /* Rotate to baz */ 798 | gsl_float_rotate(vec1,vec2,180-hdr->baz); 799 | 800 | VRB(printf("Writing radial\n")); 801 | gsl_vector_float_minmax(vec1,&tmpmin,&tmpmax); 802 | maxamp=MAX(maxamp,MAX(tmpmax,-tmpmin)); 803 | output=open_for_write(par->root,"_rad.xy"); 804 | gsl_float_write_timeseries(output,vec1,0,delta); 805 | fclose(output); 806 | 807 | VRB(printf("Writing transverse\n")); 808 | gsl_vector_float_minmax(vec2,&tmpmin,&tmpmax); 809 | maxamp=MAX(maxamp,MAX(tmpmax,-tmpmin)); 810 | output=open_for_write(par->root,"_tra.xy"); 811 | gsl_float_write_timeseries(output,vec2,0,delta); 812 | fclose(output); 813 | 814 | 815 | /* VRB(printf("Writing rad/tra particle motion\n")); */ 816 | /* output=open_for_write(par->root,"_rt_pmp.xy"); */ 817 | /* gsl_float_write_pmp(output,vec2,vec1); */ 818 | /* fclose(output); */ 819 | 820 | /* rotate to F/S */ 821 | gsl_float_rotate(vec1,vec2,180+hdr->baz-best_fast); 822 | 823 | /* gsl_vector_float_memcpy(vec1, north); */ 824 | /* gsl_vector_float_memcpy(vec2, east); */ 825 | /* gsl_float_rotate(vec1,vec2,-hdr->baz+180); */ 826 | 827 | VRB(printf("Writing fast\n")); 828 | gsl_vector_float_minmax(vec1,&tmpmin,&tmpmax); 829 | maxamp=MAX(maxamp,MAX(tmpmax,-tmpmin)); 830 | output=open_for_write(par->root,"_fast.xy"); 831 | gsl_float_write_timeseries(output,vec1,0,delta); 832 | fclose(output); 833 | 834 | VRB(printf("Writing slow\n")); 835 | gsl_vector_float_minmax(vec2,&tmpmin,&tmpmax); 836 | maxamp=MAX(maxamp,MAX(tmpmax,-tmpmin)); 837 | output=open_for_write(par->root,"_slow.xy"); 838 | gsl_float_write_timeseries(output,vec2,0,delta); 839 | fclose(output); 840 | 841 | /* VRB(printf("Writing fast/slow particle motion\n")); */ 842 | /* output=open_for_write(par->root,"_fs_pmp.xy"); */ 843 | /* gsl_float_write_pmp(output,vec2,vec1); */ 844 | /* fclose(output); */ 845 | 846 | itime=(long)ROUND(best_time/delta); 847 | vue1=gsl_vector_float_subvector(vec1,0,len-itime); /* retarded fast */ 848 | vue2=gsl_vector_float_subvector(vec2,itime,len-itime); /* time advanced slow */ 849 | 850 | VRB(printf("Writing fastcor\n")); 851 | gsl_vector_float_minmax(&vue1.vector,&tmpmin,&tmpmax); 852 | maxamp=MAX(maxamp,MAX(tmpmax,-tmpmin)); 853 | output=open_for_write(par->root,"_fastcor.xy"); 854 | gsl_float_write_timeseries(output,&(vue1.vector),(itime/2)*delta,delta); 855 | fclose(output); 856 | 857 | VRB(printf("Writing slowcor\n")); 858 | gsl_vector_float_minmax(&vue2.vector,&tmpmin,&tmpmax); 859 | maxamp=MAX(maxamp,MAX(tmpmax,-tmpmin)); 860 | output=open_for_write(par->root,"_slowcor.xy"); 861 | gsl_float_write_timeseries(output,&(vue2.vector),(itime/2)*delta,delta); 862 | fclose(output); 863 | 864 | /* VRB(printf("Writing fast/slowcor particle motion\n")); */ 865 | /* output=open_for_write(par->root,"_fscor_pmp.xy"); */ 866 | /* gsl_float_write_pmp(output,&vue2.vector,&vue1.vector); */ 867 | /* fclose(output); */ 868 | 869 | /* rotate back to BAZ */ 870 | gsl_float_rotate(&vue1.vector,&vue2.vector,180-hdr->baz+best_fast); 871 | 872 | VRB(printf("Writing radcor\n")); 873 | gsl_vector_float_minmax(&vue1.vector,&tmpmin,&tmpmax); 874 | maxamp=MAX(maxamp,MAX(tmpmax,-tmpmin)); 875 | output=open_for_write(par->root,"_radcor.xy"); 876 | gsl_float_write_timeseries(output,&(vue1.vector),(itime/2)*delta,delta); 877 | fclose(output); 878 | 879 | VRB(printf("Writing tracor\n")); 880 | gsl_vector_float_minmax(&vue2.vector,&tmpmin,&tmpmax); 881 | maxamp=MAX(maxamp,MAX(tmpmax,-tmpmin)); 882 | output=open_for_write(par->root,"_tracor.xy"); 883 | gsl_float_write_timeseries(output,&(vue2.vector),(itime/2)*delta,delta); 884 | fclose(output); 885 | 886 | /* VRB(printf("Writing rad/tracor particle motion\n")); */ 887 | /* output=open_for_write(par->root,"_rtcor_pmp.xy"); */ 888 | /* gsl_float_write_pmp(output,&vue2.vector,&vue1.vector); */ 889 | /* fclose(output); */ 890 | 891 | VRB(printf("Writing GMT script\n")); 892 | output=open_for_write(par->root,".gmt"); 893 | fprintf(output,"#!/bin/csh\n"); 894 | fprintf(output,"# script auto-generated by multisplit\n"); 895 | fprintf(output,"\n"); 896 | fprintf(output,"# Station-event dependent:\n"); 897 | fprintf(output,"set root=%s\n",par->root); 898 | fprintf(output,"set maxamp=%g\n",maxamp); 899 | fprintf(output,"set bestfast=%f\n",best_fast); 900 | fprintf(output,"set besttime=%f\n",best_time); 901 | fprintf(output,"set baz=%f\n",hdr->baz); 902 | if (par->make_grd == MAKE_GMT5) { 903 | // fprintf(stderr,"DEBUG: make_grd %d %d %d\n",par->make_grd, MAKE_GMT5,par->make_grd == MAKE_GMT5 ); 904 | fprintf(output,"alias grdinfo gmt grdinfo\n"); 905 | fprintf(output,"alias psxy gmt psxy\n"); 906 | fprintf(output,"alias pstext gmt pstext\n"); 907 | fprintf(output,"alias grdcontour gmt grdcontour\n"); 908 | fprintf(output,"alias gmtset gmt gmtset\n"); 909 | fprintf(output,"alias gmtdefaults gmt gmtdefaults\n"); 910 | /* continue here to put gmt5 commands */ 911 | } 912 | if(!isnan(pol)) 913 | fprintf(output,"set pol=%f\n",pol); 914 | fprintf(output,"cat > $root.description <make_grd == MAKE_GMT5) { 916 | fprintf(output,"> 10 29 15p 20 c\n"); 917 | } else { 918 | fprintf(output,"> 10 29 14 0 0 CT 0.564 20 c\n"); 919 | } 920 | fprintf(output,"%s %8.8s %-8s BAZ %3.0f Dist %3.0f Dp %3.0f\n\n",evname,hdr->kstnm,phase,hdr->baz, hdr->gcarc, hdr->evdp); 921 | fprintf(output,"%s: Res %f",methodstring,emin); 922 | if (descrip1 && m_aux1) 923 | fprintf(output," %s %f",descrip1,gsl_matrix_get(m_aux1,jmin,kmin)); 924 | if (descrip2 && m_aux2) 925 | fprintf(output," %s %f",descrip2,gsl_matrix_get(m_aux2,jmin,kmin)); 926 | fprintf(output," \n\nFast %3.0f \\261 %3.0f Time %4.2f \\261 %4.2f RejectNull %s", 927 | best_fast,err_fast, best_time,err_time,rejectstring); 928 | if (!isnan(pol)) 929 | fprintf(output," Pol %3.0f (Dev: %ld)\n",pol,PER(180,(long)(pol-hdr->baz+0.5+90))-90 ); 930 | else 931 | fprintf(output,"\n"); 932 | fprintf(output,"EOF\n\n"); 933 | fprintf(output,"\ 934 | ### Everything below this line is independent of the particular event used\n\ 935 | set grdrange=`grdinfo -C ${root}_err.grd | awk '{print $2 \"/\" $3 \"/\" $4 \"/\" $5 }'`\n\ 936 | set maxamp2=`echo $maxamp | awk '{ print 2*$1}'`\n\ 937 | \n\ 938 | set timerange=( `awk 'NR==1 { print $1 } { lastx=$1 } END { print lastx }' ${root}_rad.xy` )\n\ 939 | \n\ 940 | set psfile=${root}.ps\n\ 941 | \n"); 942 | 943 | if (par->make_grd == MAKE_GMT5) { 944 | fprintf(output,"\ 945 | gmtdefaults -D > gmt.conf\n\ 946 | gmtset PS_PAGE_ORIENTATION portrait PROJ_LENGTH_UNIT cm FONT_LABEL 12p,Helvetica,black FONT_ANNOT_PRIMARY 10p,Helvetica,black PS_MEDIA a4 FORMAT_FLOAT_OUT %%lg\n\ 947 | # 3cm Descriptive text\n\ 948 | pstext -M -X0 -Y0 -R0/20/0/29 -F+f14,Arial+jCT -Jx1 -K > $psfile <${root}.description\n"); 949 | } else { 950 | fprintf(output,"\ 951 | gmtdefaults -D >.gmtdefaults4\n\ 952 | gmtset PAGE_ORIENTATION portrait MEASURE_UNIT cm WANT_EURO_FONT TRUE LABEL_FONT_SIZE 12 ANOT_FONT_SIZE 10 PAPER_MEDIA a4 D_FORMAT %%lg\n\ 953 | # 3cm Descriptive text\n\ 954 | pstext -M -X0 -Y0 -R0/20/0/29 -Jx1 -K > $psfile <${root}.description\n"); 955 | } 956 | fprintf(output,"\ 957 | \n\ 958 | # 8 cm Error surface\n\ 959 | # For GMT6 need option -A1+f1p instead.\n"); 960 | if (par->make_grd == MAKE_GMT5) 961 | fprintf(output,"\ 962 | grdcontour -X2 -Y20.5 ${root}_err.grd -C${root}.cont -R$grdrange -JX17/6.5 -B0.5:\"Splitting Delay (s)\":/20:\"Fast direction\":WSen -O -K -A1+f1p -Wa1.5p -Wc0.5p >>$psfile\n"); 963 | else 964 | fprintf(output,"\ 965 | grdcontour -X2 -Y20.5 ${root}_err.grd -C${root}.cont -R$grdrange -JX17/6.5 -B0.5:\"Splitting Delay (s)\":/20:\"Fast direction\":WSen -O -K -A-1f1 -Wa1.5p -Wc0.5p >>$psfile\n"); 966 | fprintf(output,"\ 967 | psxy -R -JX -W1p,200/200/200,. -O -K >>$psfile <>$psfile <\n\ 976 | 0 $pol\n\ 977 | 10 $pol\n\ 978 | > \n\ 979 | 0 $polp\n\ 980 | 10 $polp\n\ 981 | EOF\n\ 982 | endif\n\ 983 | # best solution\n\ 984 | psxy -R -JX -Sx0.3 -W2p,blue -O -K >>$psfile <>$psfile\n\ 989 | psxy ${root}_tra.xy -R$timerange[1]/$timerange[2]/-$maxamp/$maxamp -JX -W1p,0/0/0,. -O -K >>$psfile\n\ 990 | pstext <>$psfile\n\ 991 | 0.05 0.95 12 0 0 LT Radial-Transverse\n\ 992 | EOF\n\ 993 | paste ${root}_rad.xy ${root}_tra.xy | awk '{ print $4,$2 }' | psxy -X13 -R-${maxamp}/${maxamp}/-${maxamp}/${maxamp} -JX4/4 -W1p -B${maxamp}:\"Transverse\":/${maxamp2}:\"Radial\":wsen -O -K >>$psfile\n\ 994 | #psxy ${root}_rt_pmp.xy -X13 -R-${maxamp}/${maxamp}/-${maxamp}/${maxamp} -JX4/4 -W1p -B${maxamp}:\"Transverse\":/${maxamp2}:\"Radial\":wsen -O -K >>$psfile\n\ 995 | \n\ 996 | # 4 cm Fast Slow\n\ 997 | psxy ${root}_fast.xy -X-13 -Y-4 -R$timerange[1]/$timerange[2]/-$maxamp/$maxamp -JX13/4 -Ba5f1/${maxamp}::wsen -W1p -O -K >>$psfile\n\ 998 | psxy ${root}_slow.xy -R$timerange[1]/$timerange[2]/-$maxamp/$maxamp -JX -W1p,0/0/0,. -O -K >>$psfile\n\ 999 | pstext <>$psfile\n\ 1000 | 0.05 0.95 12 0 0 LT Fast-Slow\n\ 1001 | EOF\n\ 1002 | paste ${root}_fast.xy ${root}_slow.xy | awk '{ print $4,$2 }' | psxy -X13 -R-${maxamp}/${maxamp}/-${maxamp}/${maxamp} -JX4/4 -W1p -B${maxamp}:\"Slow\":/${maxamp2}:\"Fast\":wsen -O -K >>$psfile\n\ 1003 | #psxy ${root}_fs_pmp.xy -X13 -R-${maxamp}/${maxamp}/-${maxamp}/${maxamp} -JX4/4 -W1p -B${maxamp}:\"Slow\":/${maxamp2}:\"Fast\":wsen -O -K >>$psfile\n\ 1004 | \n\ 1005 | # 4 cm Fast Slow, corrected\n\ 1006 | psxy ${root}_fastcor.xy -X-13 -Y-4 -R$timerange[1]/$timerange[2]/-$maxamp/$maxamp -JX13/4 -Ba5f1/${maxamp}::wsen -W1p -O -K >>$psfile\n\ 1007 | psxy ${root}_slowcor.xy -R$timerange[1]/$timerange[2]/-$maxamp/$maxamp -JX -W1p,0/0/0,. -O -K >>$psfile\n\ 1008 | pstext <>$psfile\n\ 1009 | 0.05 0.95 12 0 0 LT Fast-Slow, corrected\n\ 1010 | EOF\n\ 1011 | paste ${root}_fastcor.xy ${root}_slowcor.xy | awk '{ print $4,$2 }' | psxy -X13 -R-${maxamp}/${maxamp}/-${maxamp}/${maxamp} -JX4/4 -W1p -B${maxamp}:\"Slow\":/${maxamp2}:\"Fast\":wsen -O -K >>$psfile\n\ 1012 | #psxy ${root}_fscor_pmp.xy -X13 -R-${maxamp}/${maxamp}/-${maxamp}/${maxamp} -JX4/4 -W1p -B${maxamp}:\"Slow\":/${maxamp2}:\"Fast\":wsen -O -K >>$psfile\n\ 1013 | \n\ 1014 | \n\ 1015 | # 4 cm Rad Transverse, corrected \n\ 1016 | psxy ${root}_radcor.xy -X-13 -Y-4 -R$timerange[1]/$timerange[2]/-$maxamp/$maxamp -JX13/4 -Ba5f1:\"Time (s)\":/${maxamp}::wSen -W1p -O -K >>$psfile\n\ 1017 | psxy ${root}_tracor.xy -R$timerange[1]/$timerange[2]/-$maxamp/$maxamp -JX -W1p,0/0/0,. -O -K >>$psfile\n\ 1018 | pstext <>$psfile\n\ 1019 | 0.05 0.95 12 0 0 LT Radial-Transverse, corrected\n\ 1020 | EOF\n\ 1021 | paste ${root}_radcor.xy ${root}_tracor.xy | awk '{ print $4,$2 }' | psxy -X13 -R-${maxamp}/${maxamp}/-${maxamp}/${maxamp} -JX4/4 -W1p -B${maxamp}:\"Transverse\":/${maxamp2}:\"Radial\":wsen -O -K >>$psfile\n\ 1022 | #psxy ${root}_rtcor_pmp.xy -X13 -R-${maxamp}/${maxamp}/-${maxamp}/${maxamp} -JX4/4 -W1p -B${maxamp}:\"Transverse\":/${maxamp2}:\"Radial\":wsen -O -K >>$psfile\n\ 1023 | \n\ 1024 | \n\ 1025 | psxy < /dev/null -Jx1 -R -O >>$psfile\n\ 1026 | "); 1027 | fclose(output); 1028 | 1029 | VRB(printf("Executing GMT script\n")); 1030 | sprintf(cmdstring,"csh %s.gmt",par->root); 1031 | status=system(cmdstring); 1032 | if (status) { 1033 | sprintf(warn_str,"Execution of GMT script failed. Error status: %d",status); 1034 | warn_msg(warn_str); 1035 | } 1036 | if ( ref_north && ref_east && !strcmp(ext1,"dly")) { 1037 | double delay=gsl_matrix_get(m_aux1,jmin,kmin); 1038 | double alpha=gsl_matrix_get(m_aux2,jmin,kmin); 1039 | 1040 | vue1=gsl_vector_float_subvector(ref_north,refbeg,len); 1041 | vue2=gsl_vector_float_subvector(ref_east,refbeg,len); 1042 | gsl_vector_float_memcpy(vec1, &vue1.vector); 1043 | gsl_vector_float_memcpy(vec2, &vue2.vector); 1044 | gsl_float_rotate(vec1,vec2,180-hdr->baz); 1045 | 1046 | VRB(printf("Writing radial reference trace\n")); 1047 | gsl_vector_float_minmax(vec1,&tmpmin,&tmpmax); 1048 | maxamp=MAX(maxamp,MAX(tmpmax,-tmpmin)); 1049 | output=open_for_write(par->root,"_refrad.xy"); 1050 | gsl_float_write_timeseries(output,vec1,0,delta); 1051 | fclose(output); 1052 | 1053 | VRB(printf("Writing transverse reference trace\n")); 1054 | gsl_vector_float_minmax(vec2,&tmpmin,&tmpmax); 1055 | maxamp=MAX(maxamp,MAX(tmpmax,-tmpmin)); 1056 | output=open_for_write(par->root,"_reftra.xy"); 1057 | gsl_float_write_timeseries(output,vec2,0,delta); 1058 | fclose(output); 1059 | 1060 | output=open_for_write(par->root,"-aux.gmt"); 1061 | fprintf(output,"#/bin/csh\n"); 1062 | fprintf(output,"# script auto-generated by multisplit\n"); 1063 | fprintf(output,"\n"); 1064 | fprintf(output,"# Station-event dependent:\n"); 1065 | fprintf(output,"set root=%s\n",par->root); 1066 | fprintf(output,"set maxamp=%g\n",maxamp); 1067 | fprintf(output,"set bestfast=%f\n",best_fast); 1068 | fprintf(output,"set besttime=%f\n",best_time); 1069 | fprintf(output,"set delay=%f\n",delay); 1070 | fprintf(output,"set alpha=%f\n",alpha); 1071 | fprintf(output,"set baz=%f\n",hdr->baz); 1072 | fprintf(output,"cat > $root.description < 10 29 14 0 0 CT 0.564 20 c\n"); 1074 | fprintf(output,"%s %8.8s %-8s BAZ %3.0f Dist %3.0f Dp %3.0f\n\n",evname,hdr->kstnm,phase,hdr->baz, hdr->gcarc, hdr->evdp); 1075 | fprintf(output,"%s: Res %f",methodstring,emin); 1076 | if (descrip1 && m_aux1) 1077 | fprintf(output,"%s %f ",descrip1,gsl_matrix_get(m_aux1,jmin,kmin)); 1078 | if (descrip2 && m_aux2) 1079 | fprintf(output,"%s %f",descrip2,gsl_matrix_get(m_aux2,jmin,kmin)); 1080 | fprintf(output," \n\nFast %3.0f \\261 %3.0f Time %4.2f \\261 %4.2f RejectNull %s", 1081 | best_fast,err_fast, best_time,err_time,rejectstring); 1082 | if (!isnan(pol)) 1083 | fprintf(output," Pol %3.0f (Dev: %ld)\n",pol,PER(180,(long)(pol-hdr->baz+0.5+90))-90 ); 1084 | else 1085 | fprintf(output,"\n"); 1086 | fprintf(output,"EOF\n\n"); 1087 | 1088 | fprintf(output,"\ 1089 | ### Everything below this line is independent of the particular event used\n\ 1090 | \n\ 1091 | set grdrange=`grdinfo -C ${root}_dly.grd | awk '{print $2 \"/\" $3 \"/\" $4 \"/\" $5 }'`\n\ 1092 | set maxamp2=`echo $maxamp | awk '{ print 2*$1}'`\n\ 1093 | \n\ 1094 | set timerange=( `awk 'NR==1 { print $1 } { lastx=$1 } END { print lastx }' ${root}_rad.xy` )\n\ 1095 | \n\ 1096 | set psfile=${root}-aux.ps\n\ 1097 | \n\ 1098 | gmtdefaults -D >.gmtdefaults4\n\ 1099 | gmtset PAGE_ORIENTATION portrait MEASURE_UNIT cm WANT_EURO_FONT TRUE LABEL_FONT_SIZE 12 ANOT_FONT_SIZE 10 PAPER_MEDIA a4 D_FORMAT %%lg\n\ 1100 | # 3cm Descriptive text\n\ 1101 | pstext -M -X0 -Y0 -R0/20/0/29 -Jx1 -K > $psfile <${root}.description\n\ 1102 | \n\ 1103 | # Map delay\n\ 1104 | grdcontour -X2 -Y20.5 ${root}_dly.grd -C0.1 -A0.5f7 -R$grdrange -JX17/6.5 -B0.5:\"Splitting Delay (s)\":/20:\"Fast direction\":WSen -O -K -G4c -Wa1.5p -Wc0.5p >>$psfile\n\ 1105 | psxy -R -JX -Sx0.3 -W2p -O -K >>$psfile < ${root}_tmp.acont\n\ 1110 | grdcontour ${root}_err.grd -C${root}_tmp.acont -m -D${root}_tmp.95cont -JX -R > /dev/null\n\ 1111 | psxy ${root}_tmp.95cont -m -R -JX -W1p/200/200/200ta -O -K >>$psfile \n\ 1112 | \n\ 1113 | # 4 cm RefRad refTransverse\n\ 1114 | psxy ${root}_refrad.xy -Y-6.5 -R$timerange[1]/$timerange[2]/-$maxamp/$maxamp -JX13/4 -Ba5f1/${maxamp}::wseN -W1p -O -K >>$psfile\n\ 1115 | psxy ${root}_reftra.xy -R$timerange[1]/$timerange[2]/-$maxamp/$maxamp -JX -W1p0/0/0to -O -K >>$psfile\n\ 1116 | pstext <>$psfile\n\ 1117 | 0.05 0.95 12 0 0 LT Reference Radial-Transverse\n\ 1118 | EOF\n\ 1119 | paste ${root}_refrad.xy ${root}_reftra.xy | awk '{ print $4,$2 }' | psxy -X13 -R-${maxamp}/${maxamp}/-${maxamp}/${maxamp} -JX4/4 -W1p -B${maxamp}:\"Transverse\":/${maxamp2}:\"Radial\":wsen -O -K >>$psfile\n\ 1120 | \n\ 1121 | # 4 cm Data radial-transverse\n\ 1122 | psxy ${root}_rad.xy -X-13 -Y-4 -R$timerange[1]/$timerange[2]/-$maxamp/$maxamp -JX13/4 -Ba5f1/${maxamp}::wsen -W1p -O -K >>$psfile\n\ 1123 | psxy ${root}_tra.xy -R$timerange[1]/$timerange[2]/-$maxamp/$maxamp -JX -W1p0/0/0to -O -K >>$psfile\n\ 1124 | pstext <>$psfile\n\ 1125 | 0.05 0.95 12 0 0 LT Observed Radial-Transverse\n\ 1126 | EOF\n\ 1127 | paste ${root}_rad.xy ${root}_tra.xy | awk '{ print $4,$2 }' | psxy -X13 -R-${maxamp}/${maxamp}/-${maxamp}/${maxamp} -JX4/4 -W1p -B${maxamp}:\"Transverse\":/${maxamp2}:\"Radial\":wsen -O -K >>$psfile\n\ 1128 | \n\ 1129 | # make amplitude and delay corrected traces\n\ 1130 | awk '{ print $1-delay,$2*alpha/(1-alpha) }' delay=$delay alpha=$alpha ${root}_radcor.xy > ${root}_tmp_radcorcor.xy\n\ 1131 | awk '{ print $1-delay,$2*alpha/(1-alpha) }' delay=$delay alpha=$alpha ${root}_tracor.xy > ${root}_tmp_tracorcor.xy\n\ 1132 | # Interpolate reference station to grid of those data\n\ 1133 | sample1d ${root}_refrad.xy -N${root}_tmp_radcorcor.xy > ${root}_tmp_refrad.xy\n\ 1134 | sample1d ${root}_reftra.xy -N${root}_tmp_tracorcor.xy > ${root}_tmp_reftra.xy\n\ 1135 | # Resample corrected data again on this grid to make sure we really share the same grid\n\ 1136 | sample1d ${root}_tmp_radcorcor.xy -N${root}_tmp_refrad.xy > ${root}_tmp_radcc.xy\n\ 1137 | sample1d ${root}_tmp_tracorcor.xy -N${root}_tmp_reftra.xy > ${root}_tmp_tracc.xy\n\ 1138 | # Residual Observed-reference\n\ 1139 | paste ${root}_tmp_radcc.xy ${root}_tmp_refrad.xy | awk '{ print $1,$2-$4 }' > ${root}_tmp_resrad.xy\n\ 1140 | paste ${root}_tmp_tracc.xy ${root}_tmp_reftra.xy | awk '{ print $1,$2-$4 }' > ${root}_tmp_restra.xy\n\ 1141 | \n\ 1142 | # 4 cm radial transverse, corrected (including amplitude and delay correction)\n\ 1143 | psxy ${root}_tmp_radcorcor.xy -X-13 -Y-4 -R$timerange[1]/$timerange[2]/-$maxamp/$maxamp -JX13/4 -Ba5f1/${maxamp}::wsen -W1p -O -K >>$psfile\n\ 1144 | psxy ${root}_tmp_tracorcor.xy -R$timerange[1]/$timerange[2]/-$maxamp/$maxamp -JX -W1p0/0/0to -O -K >>$psfile\n\ 1145 | pstext <>$psfile\n\ 1146 | 0.05 0.95 12 0 0 LT Corrected Radial-Transverse\n\ 1147 | EOF\n\ 1148 | paste ${root}_tmp_radcorcor.xy ${root}_tmp_tracorcor.xy | awk '{ print $4,$2 }' | psxy -X13 -R-${maxamp}/${maxamp}/-${maxamp}/${maxamp} -JX4/4 -W1p -B${maxamp}:\"Transverse\":/${maxamp2}:\"Radial\":wsen -O -K >>$psfile\n\ 1149 | \n\ 1150 | \n\ 1151 | # 4 cm Residual (Observed - reference)\n\ 1152 | psxy ${root}_tmp_resrad.xy -X-13 -Y-4 -R$timerange[1]/$timerange[2]/-$maxamp/$maxamp -JX13/4 -Ba5f1:\"Time (s)\":/${maxamp}::wSen -W1p -O -K >>$psfile\n\ 1153 | psxy ${root}_tmp_restra.xy -R$timerange[1]/$timerange[2]/-$maxamp/$maxamp -JX -W1p0/0/0to -O -K >>$psfile\n\ 1154 | pstext <>$psfile\n\ 1155 | 0.05 0.95 12 0 0 LT Residual Radial-Transverse\n\ 1156 | EOF\n\ 1157 | paste ${root}_tmp_resrad.xy ${root}_tmp_restra.xy | awk '{ print $4,$2 }' | psxy -X13 -R-${maxamp}/${maxamp}/-${maxamp}/${maxamp} -JX4/4 -W1p -B${maxamp}:\"Transverse\":/${maxamp2}:\"Radial\":wsen -O -K >>$psfile\n\ 1158 | #psxy ${root}_rtcor_pmp.xy -X13 -R-${maxamp}/${maxamp}/-${maxamp}/${maxamp} -JX4/4 -W1p -B${maxamp}:\"Transverse\":/${maxamp2}:\"Radial\":wsen -O -K >>$psfile\n\ 1159 | \n\ 1160 | psxy < /dev/null -Jx1 -R -O >>$psfile\n\ 1161 | \\rm ${root}_tmp*\n\ 1162 | "); 1163 | fclose(output); 1164 | VRB(printf("Executing GMT-aux script\n")); 1165 | sprintf(cmdstring,"csh %s-aux.gmt",par->root); 1166 | status=system(cmdstring); 1167 | if (status) { 1168 | sprintf(warn_str,"Execution of GMT script failed. Error status: %d",status); 1169 | warn_msg(warn_str); 1170 | } 1171 | VRB(printf("Writing GMT script colour\n")); 1172 | output=open_for_write(par->root,"-colour.gmt"); 1173 | fprintf(output,"#/bin/csh\n"); 1174 | fprintf(output,"# script auto-generated by multisplit\n"); 1175 | fprintf(output,"\n"); 1176 | fprintf(output,"# Station-event dependent:\n"); 1177 | fprintf(output,"set root=%s\n",par->root); 1178 | fprintf(output,"set maxamp=%g\n",maxamp); 1179 | fprintf(output,"set bestfast=%f\n",best_fast); 1180 | fprintf(output,"set besttime=%f\n",best_time); 1181 | fprintf(output,"set delay=%f\n",delay); 1182 | fprintf(output,"set alpha=%f\n",alpha); 1183 | fprintf(output,"set baz=%f\n",hdr->baz); 1184 | fprintf(output,"cat > $root.description < 5.7 29.5 12 0 0 CT 0.564 20 c\n"); 1186 | fprintf(output,"%s %8.8s %-8s BAZ %3.0f\\232 Dist %3.0f\\232 Dep %3.0f\n",evname,hdr->kstnm,phase,hdr->baz, hdr->gcarc, hdr->evdp); 1187 | /* fprintf(output,"%s: Res %f",methodstring,emin); */ 1188 | fprintf(output,"\nFast %3.0f \\261 %3.0f SplittingDelay %4.2f \\261 %4.2f\n\n", 1189 | best_fast,err_fast, best_time,fabs(err_time)); 1190 | if (descrip1 && m_aux1) 1191 | fprintf(output,"%s %.2f ",descrip1,gsl_matrix_get(m_aux1,jmin,kmin)); 1192 | if (descrip2 && m_aux2) 1193 | fprintf(output,"%s %.2f",descrip2,gsl_matrix_get(m_aux2,jmin,kmin)); 1194 | if (!isnan(pol) && !m_aux1) 1195 | fprintf(output," Pol %3.0f (Dev: %ld)\n",pol,PER(180,(long)(pol-hdr->baz+0.5+90))-90 ); 1196 | else 1197 | fprintf(output,"\n"); 1198 | fprintf(output,"EOF\n\n"); 1199 | fprintf(output,"\ 1200 | ### Everything below this line is independent of the particular event used\n\ 1201 | set grdrange=`grdinfo -C ${root}_err.grd | awk '{print $2 \"/\" $3 \"/\" $4 \"/\" $5 }'`\n\ 1202 | set maxamp2=`echo $maxamp | awk '{ print 2*$1}'`\n\ 1203 | \n\ 1204 | set timerange=( `awk 'NR==1 { print $1 } { lastx=$1 } END { print lastx }' ${root}_rad.xy` )\n\ 1205 | \n\ 1206 | set psfile=${root}-colour.ps\n\ 1207 | \n\ 1208 | gmtdefaults -D >.gmtdefaults4\n\ 1209 | gmtset PAGE_ORIENTATION portrait MEASURE_UNIT cm WANT_EURO_FONT TRUE LABEL_FONT_SIZE 12 ANOT_FONT_SIZE 10 PAPER_MEDIA a4 D_FORMAT %%lg LABEL_OFFSET 0.05c ANNOT_OFFSET_PRIMARY 0.15c\n\ 1210 | # 3cm Descriptive text\n\ 1211 | pstext -m -X0 -Y0 -R0/20/0/30 -Jx1 -K > $psfile <${root}.description\n\ 1212 | # 8 cm Error surface\n\ 1213 | \n"); 1214 | if (par->make_grd == MAKE_GMT5) 1215 | fprintf(output,"\ 1216 | grdcontour -X2 -Y22 ${root}_err.grd -C${root}.cont -R$grdrange -JX9.1/5.8 -B0.5:\"Splitting Delay (s)\":/20:\"Fast direction\":WSen -O -K -A1+1f1p -G1000 -Wa1.5p -Wc0.5p >>$psfile\n"); 1217 | else 1218 | fprintf(output,"\ 1219 | grdcontour -X2 -Y22 ${root}_err.grd -C${root}.cont -R$grdrange -JX9.1/5.8 -B0.5:\"Splitting Delay (s)\":/20:\"Fast direction\":WSen -O -K -A-1f1 -G1000 -Wa1.5p -Wc0.5p >>$psfile\n"); 1220 | fprintf(output,"\ 1221 | psxy -R -JX -S+0.3 -W3p,150/150/150 -O -K >>$psfile <>$psfile <>$psfile <\n\ 1232 | 0 $pol\n\ 1233 | 10 $pol\n\ 1234 | > \n\ 1235 | 0 $polp\n\ 1236 | 10 $polp\n\ 1237 | EOF\n\ 1238 | endif\n\ 1239 | # 4 cm RefRad refTransverse\n\ 1240 | psxy ${root}_refrad.xy -Y-5.5 -X-1 -R$timerange[1]/$timerange[2]/-$maxamp/$maxamp -JX7.1/3 -Ba5f1/${maxamp}::wseN -W1p -O -K >>$psfile\n\ 1241 | psxy ${root}_reftra.xy -R$timerange[1]/$timerange[2]/-$maxamp/$maxamp -JX -W1p,blue,- -O -K >>$psfile\n\ 1242 | pstext <>$psfile\n\ 1243 | 0.05 0.95 12 0 0 LT Reference Radial-Transverse\n\ 1244 | EOF\n\ 1245 | paste ${root}_refrad.xy ${root}_reftra.xy | awk '{ print $4,$2 }' | psxy -X7.1 -R-${maxamp}/${maxamp}/-${maxamp}/${maxamp} -JX3/3 -W1p -B${maxamp}:\"Transverse\":/${maxamp2}:\"Radial\":wsen -O -K >>$psfile\n\ 1246 | \n\ 1247 | # 4 cm Data radial-transverse\n\ 1248 | psxy ${root}_rad.xy -X-7.1 -Y-3 -R$timerange[1]/$timerange[2]/-$maxamp/$maxamp -JX7.1/3 -Ba5f1/${maxamp}::wsen -W1p -O -K >>$psfile\n\ 1249 | psxy ${root}_tra.xy -R$timerange[1]/$timerange[2]/-$maxamp/$maxamp -JX -W1p,blue,- -O -K >>$psfile\n\ 1250 | pstext <>$psfile\n\ 1251 | 0.05 0.95 12 0 0 LT Observed Radial-Transverse\n\ 1252 | EOF\n\ 1253 | paste ${root}_rad.xy ${root}_tra.xy | awk '{ print $4,$2 }' | psxy -X7.1 -R-${maxamp}/${maxamp}/-${maxamp}/${maxamp} -JX3/3 -W1p -B${maxamp}:\"Transverse\":/${maxamp2}:\"Radial\":wsen -O -K >>$psfile\n\ 1254 | \n\ 1255 | # 4 cm Fast Slow\n\ 1256 | psxy ${root}_fast.xy -X-7.1 -Y-3 -R$timerange[1]/$timerange[2]/-$maxamp/$maxamp -JX7.1/3 -Ba5f1/${maxamp}::wsen -W1p -O -K >>$psfile\n\ 1257 | psxy ${root}_slow.xy -R$timerange[1]/$timerange[2]/-$maxamp/$maxamp -JX -W1p,blue,- -O -K >>$psfile\n\ 1258 | pstext <>$psfile\n\ 1259 | 0.05 0.95 12 0 0 LT Observed Fast-Slow\n\ 1260 | EOF\n\ 1261 | paste ${root}_fast.xy ${root}_slow.xy | awk '{ print $4,$2 }' | psxy -X7.1 -R-${maxamp}/${maxamp}/-${maxamp}/${maxamp} -JX3/3 -W1p -B${maxamp}:\"Slow\":/${maxamp2}:\"Fast\":wsen -O -K >>$psfile\n\ 1262 | #psxy ${root}_fs_pmp.xy -X7.1 -R-${maxamp}/${maxamp}/-${maxamp}/${maxamp} -JX3/3 -W1p -B${maxamp}:\"Slow\":/${maxamp2}:\"Fast\":wsen -O -K >>$psfile\n\ 1263 | \n\ 1264 | # 4 cm Fast Slow, corrected\n\ 1265 | psxy ${root}_fastcor.xy -X-7.1 -Y-3 -R$timerange[1]/$timerange[2]/-$maxamp/$maxamp -JX7.1/3 -Ba5f1/${maxamp}::wsen -W1p -O -K >>$psfile\n\ 1266 | psxy ${root}_slowcor.xy -R$timerange[1]/$timerange[2]/-$maxamp/$maxamp -JX -W1p,blue,- -O -K >>$psfile\n\ 1267 | pstext <>$psfile\n\ 1268 | 0.05 0.95 12 0 0 LT Corrected Fast-Slow\n\ 1269 | EOF\n\ 1270 | paste ${root}_fastcor.xy ${root}_slowcor.xy | awk '{ print $4,$2 }' | psxy -X7.1 -R-${maxamp}/${maxamp}/-${maxamp}/${maxamp} -JX3/3 -W1p -B${maxamp}:\"Slow\":/${maxamp2}:\"Fast\":wsen -O -K >>$psfile\n\ 1271 | #psxy ${root}_fscor_pmp.xy -X7.1 -R-${maxamp}/${maxamp}/-${maxamp}/${maxamp} -JX3/3 -W1p -B${maxamp}:\"Slow\":/${maxamp2}:\"Fast\":wsen -O -K >>$psfile\n\ 1272 | \n\ 1273 | \n\ 1274 | # 4 cm Rad Transverse, corrected \n\ 1275 | psxy ${root}_radcor.xy -X-7.1 -Y-3 -R$timerange[1]/$timerange[2]/-$maxamp/$maxamp -JX7.1/3 -Ba5f1:\"Time (s)\":/${maxamp}::wsen -W1p -O -K >>$psfile\n\ 1276 | psxy ${root}_tracor.xy -R$timerange[1]/$timerange[2]/-$maxamp/$maxamp -JX -W1p,blue,- -O -K >>$psfile\n\ 1277 | pstext <>$psfile\n\ 1278 | 0.05 0.95 12 0 0 LT Corrected Radial-Transverse\n\ 1279 | EOF\n\ 1280 | paste ${root}_radcor.xy ${root}_tracor.xy | awk '{ print $4,$2 }' | psxy -X7.1 -R-${maxamp}/${maxamp}/-${maxamp}/${maxamp} -JX3/3 -W1p -B${maxamp}:\"Transverse\":/${maxamp2}:\"Radial\":wsen -O -K >>$psfile\n\ 1281 | #psxy ${root}_rtcor_pmp.xy -X7.1 -R-${maxamp}/${maxamp}/-${maxamp}/${maxamp} -JX3/3 -W1p -B${maxamp}:\"Transverse\":/${maxamp2}:\"Radial\":wsen -O -K >>$psfile\n\ 1282 | \n\ 1283 | # make amplitude and delay corrected traces\n\ 1284 | awk '{ print $1-delay,$2*alpha/(1-alpha) }' delay=$delay alpha=$alpha ${root}_radcor.xy > ${root}_tmp_radcorcor.xy\n\ 1285 | awk '{ print $1-delay,$2*alpha/(1-alpha) }' delay=$delay alpha=$alpha ${root}_tracor.xy > ${root}_tmp_tracorcor.xy\n\ 1286 | # Interpolate reference station to grid of those data\n\ 1287 | sample1d ${root}_refrad.xy -N${root}_tmp_radcorcor.xy > ${root}_tmp_refrad.xy\n\ 1288 | sample1d ${root}_reftra.xy -N${root}_tmp_tracorcor.xy > ${root}_tmp_reftra.xy\n\ 1289 | # Resample corrected data again on this grid to make sure we really share the same grid\n\ 1290 | sample1d ${root}_tmp_radcorcor.xy -N${root}_tmp_refrad.xy > ${root}_tmp_radcc.xy\n\ 1291 | sample1d ${root}_tmp_tracorcor.xy -N${root}_tmp_reftra.xy > ${root}_tmp_tracc.xy\n\ 1292 | # Residual Observed-reference\n\ 1293 | paste ${root}_tmp_radcc.xy ${root}_tmp_refrad.xy | awk '{ print $1,$2-$4 }' > ${root}_tmp_resrad.xy\n\ 1294 | paste ${root}_tmp_tracc.xy ${root}_tmp_reftra.xy | awk '{ print $1,$2-$4 }' > ${root}_tmp_restra.xy\n\ 1295 | \n\ 1296 | \n\ 1297 | # 4 cm Residual (Observed - reference)\n\ 1298 | psxy ${root}_tmp_resrad.xy -X-7.1 -Y-3 -R$timerange[1]/$timerange[2]/-$maxamp/$maxamp -JX7.1/3 -Ba5f1:\"Time (s)\":/${maxamp}::wSen -W1p -O -K >>$psfile\n\ 1299 | psxy ${root}_tmp_restra.xy -R$timerange[1]/$timerange[2]/-$maxamp/$maxamp -JX -W1p,blue,- -O -K >>$psfile\n\ 1300 | pstext <>$psfile\n\ 1301 | 0.05 0.95 12 0 0 LT Residual Radial-Transverse\n\ 1302 | EOF\n\ 1303 | paste ${root}_tmp_resrad.xy ${root}_tmp_restra.xy | awk '{ print $4,$2 }' | psxy -X7.1 -R-${maxamp}/${maxamp}/-${maxamp}/${maxamp} -JX3/3 -W1p -B${maxamp}:\"Transverse\":/${maxamp2}:\"Radial\":wsen -O -K >>$psfile\n\ 1304 | #psxy ${root}_rtcor_pmp.xy -X7.1 -R-${maxamp}/${maxamp}/-${maxamp}/${maxamp} -JX3/3 -W1p -B${maxamp}:\"Transverse\":/${maxamp2}:\"Radial\":wsen -O -K >>$psfile\n\ 1305 | \n\ 1306 | psxy < /dev/null -Jx1 -R -O >>$psfile\n\ 1307 | \\rm ${root}_tmp*\n\ 1308 | "); 1309 | fclose(output); 1310 | 1311 | VRB(printf("Executing GMT script\n")); 1312 | sprintf(cmdstring,"csh %s-colour.gmt",par->root); 1313 | status=system(cmdstring); 1314 | if (status) { 1315 | sprintf(warn_str,"Execution of GMT script failed. Error status: %d",status); 1316 | warn_msg(warn_str); 1317 | } 1318 | 1319 | } 1320 | 1321 | gsl_vector_float_free(vec1); 1322 | gsl_vector_float_free(vec2); 1323 | } 1324 | } 1325 | 1326 | FILE *open_for_write(char *root,char *extension){ 1327 | char tmpstring[256]; 1328 | FILE *output; 1329 | strcpy(tmpstring, root); 1330 | strcat(tmpstring, extension); 1331 | 1332 | output=fopen(tmpstring,"wb"); 1333 | if (!output) { 1334 | sprintf(abort_str,"Cannot open %s for output.",tmpstring); 1335 | abort_msg(abort_str); 1336 | } 1337 | return(output); 1338 | } 1339 | 1340 | 1341 | void make_event_name(char *string, sachdr *hdr, int mode) { 1342 | /* make event name from information in SAC header. 1343 | mode=EVN_YYJJJHHMM yy jjj hh:mm */ 1344 | switch(mode) { 1345 | case EVN_YYJJJHHMM: 1346 | sprintf(string,"%02d %03d %02d:%02d",hdr->nzyear%100,hdr->nzjday,hdr->nzhour,hdr->nzmin); 1347 | break; 1348 | default: 1349 | abort_msg("make_event_name: Illegal mode"); 1350 | } 1351 | } 1352 | 1353 | 1354 | void single_split_correl(int method, hor_split *hsplit, float maxshift, gsl_vector_float *nspl, gsl_vector_float *espl, long beg, gsl_vector_float *ref_north, gsl_vector_float *ref_east, long ref_beg, long len, float delta, gsl_matrix *m_res_energy, gsl_matrix *m_delay, gsl_matrix *m_alpha) { 1355 | /* Grid search for splitting by comparison with reference trace */ 1356 | /* transcribed from matlab function split/grdsplit5.m */ 1357 | long maxlag,maxxclag,npts,itime,itshiftf,itshifts; 1358 | int i,j,k; 1359 | double fast,time; 1360 | double mc,energy_ref,energy_obs,alpha,en_res; 1361 | long mi,idelay; 1362 | 1363 | gsl_vector_float_view vue1,vue2,nrefview,erefview; 1364 | gsl_vector_view dvue1,dvue2; 1365 | gsl_vector_float *nref; 1366 | gsl_vector_float *eref; 1367 | gsl_vector *x1; 1368 | gsl_vector *EOns[2][2],*Cns[2][2],*EOfs[2][2],*Cfs[2][2]; 1369 | double nsplfi, nsplbi_1, nsplf1_i, nsplb_i, esplfi, esplbi_1, esplf1_i, esplb_i ; 1370 | 1371 | 1372 | npts=nspl->size; 1373 | if (beg==0 && len==npts) 1374 | abort_msg("Fourier-domain calculation of correlation for reference station method not yet implemented"); 1375 | 1376 | 1377 | /* Isolate relevant part of reference vector from ref_bef Length len*/ 1378 | nrefview=gsl_vector_float_subvector(ref_north,ref_beg,len); 1379 | erefview=gsl_vector_float_subvector(ref_east,ref_beg,len); 1380 | nref=&nrefview.vector; 1381 | eref=&erefview.vector; 1382 | 1383 | /* xc=zeros(length(vfstdir),length(vtsplt)) ; */ 1384 | /* delay=zeros(size(xc)); */ 1385 | /* en_res=zeros(size(xc)); */ 1386 | 1387 | /* maxlag=round(MAXLAG/SAMPLE_INTERVAL); */ 1388 | maxlag=(long)ROUND(maxshift/delta); 1389 | 1390 | /* maxxclag=maxlag+ceil(0.5*max(vtsplt)/SAMPLE_INTERVAL) ; */ 1391 | maxxclag=maxlag+(long)ROUND(hsplit->timemax/delta) ; 1392 | 1393 | VRB(printf("maxlag %ld maxxclag %ld\n",maxlag,maxxclag)); 1394 | /* len=length(nref) ; */ 1395 | /* f=bspl+len-1 ; */ 1396 | /* overlag=max(maxxclag-bspl+1,bspl+len-1+maxxclag-length(nspl)) ; */ 1397 | /* if overlag>0 */ 1398 | /* maxlag=maxlag-overlag ; */ 1399 | /* maxxclag=maxxclag-overlag ; */ 1400 | /* if(maxxclag<0) */ 1401 | /* error('nspl,espl too short to accommodate maximum time shift even at zero delay') */ 1402 | /* else */ 1403 | /* warning(sprintf('nspl,espl too short to accommodate maximum time shift and lag without introducing edge effects\nReducing maxlag to %4.2f sec.',maxlag*SAMPLE_INTERVAL)) */ 1404 | /* end */ 1405 | /* end */ 1406 | 1407 | x1=gsl_vector_alloc(2*maxlag+1); 1408 | 1409 | /* energy_ref=nref'*nref + eref'*eref ; */ 1410 | energy_ref=gsl_df_normsqr(nref)+gsl_df_normsqr(eref); 1411 | VRB(printf("Energy Ref: %g\n",energy_ref)); 1412 | /* % energy_obs has to be calculated for all possible lags (implying a different window) and separately for n,e as these are potentially time-shifted */ 1413 | /* % Matrix of energy in observed signal for different window shift, have to calculate n*n,e*e, and n*e to be able to */ 1414 | /* % transform into fast,slow direction */ 1415 | /* EOns=zeros(2*maxxclag+1,2,2); */ 1416 | /* EOns[0][0]=gsl_vector_alloc(2*maxxclag+1); */ 1417 | /* EOns[0][1]=gsl_vector_alloc(2*maxxclag+1); */ 1418 | /* EOns[1][0]=gsl_vector_alloc(2*maxxclag+1); */ 1419 | /* EOns[1][1]=gsl_vector_alloc(2*maxxclag+1); */ 1420 | /* EOfs[0][0]=gsl_vector_alloc(2*maxxclag+1); */ 1421 | /* EOfs[0][1]=gsl_vector_alloc(2*maxxclag+1); */ 1422 | /* EOfs[1][0]=gsl_vector_alloc(2*maxxclag+1); */ 1423 | /* EOfs[1][1]=gsl_vector_alloc(2*maxxclag+1); */ 1424 | /* Cns[0][0] =gsl_vector_alloc(2*maxxclag+1); */ 1425 | /* Cns[0][1] =gsl_vector_alloc(2*maxxclag+1); */ 1426 | /* Cns[1][0] =gsl_vector_alloc(2*maxxclag+1); */ 1427 | /* Cns[1][1] =gsl_vector_alloc(2*maxxclag+1); */ 1428 | /* Cfs[0][0] =gsl_vector_alloc(2*maxxclag+1); */ 1429 | /* Cfs[0][1] =gsl_vector_alloc(2*maxxclag+1); */ 1430 | /* Cfs[1][0] =gsl_vector_alloc(2*maxxclag+1); */ 1431 | /* Cfs[1][1] =gsl_vector_alloc(2*maxxclag+1); */ 1432 | CMAT_ALLOCATE(EOns,2*maxxclag+1); 1433 | CMAT_ALLOCATE(EOfs,2*maxxclag+1); 1434 | CMAT_ALLOCATE(Cns,2*maxxclag+1); 1435 | CMAT_ALLOCATE(Cfs,2*maxxclag+1); 1436 | 1437 | if (beg==0 && len==npts) { 1438 | abort_msg("FFT type cross-correlation for reference station correlation method not yet implemented"); 1439 | } else { 1440 | /* EOns(maxxclag+1,1,1)=nspl(bspl:f)'*nspl(bspl:f) ; */ 1441 | vue1=gsl_vector_float_subvector(nspl,beg,len); 1442 | vue2=gsl_vector_float_subvector(espl,beg,len); 1443 | gsl_vector_set(EOns[0][0],maxxclag,gsl_df_normsqr(&vue1.vector)); 1444 | /* EOns(maxxclag+1,2,2)=espl(bspl:f)'*espl(bspl:f) ; */ 1445 | gsl_vector_set(EOns[1][1],maxxclag,gsl_df_normsqr(&vue2.vector)); 1446 | /* EOns(maxxclag+1,2,1)=nspl(bspl:f)'*espl(bspl:f) ; */ 1447 | gsl_vector_set(EOns[1][0],maxxclag,gsl_df_dotprod(&vue1.vector,&vue2.vector)); 1448 | gsl_vector_set(EOns[0][1],maxxclag,gsl_df_dotprod(&vue1.vector,&vue2.vector)); 1449 | /* determine correlations for other window positions by sequential updates */ 1450 | VRB(printf("EOns(zero lag): [ %g %g ; %g %g ]\n", 1451 | gsl_vector_get(EOns[0][0],maxxclag), 1452 | gsl_vector_get(EOns[0][1],maxxclag), 1453 | gsl_vector_get(EOns[1][0],maxxclag), 1454 | gsl_vector_get(EOns[1][1],maxxclag))); 1455 | /* for i=1:maxxclag */ 1456 | for(i=1;i<=maxxclag;i++){ 1457 | nsplfi =(double)gsl_vector_float_get(nspl,beg+len-1+i); /* nspl(f+i) */ 1458 | nsplbi_1=(double)gsl_vector_float_get(nspl,beg+i-1); /* nspl(bspl+i-1) */ 1459 | nsplf1_i=(double)gsl_vector_float_get(nspl,beg+len-i); /* nspl(f+1-i) */ 1460 | nsplb_i =(double)gsl_vector_float_get(nspl,beg-i); /* nspl(bspl-i) */ 1461 | esplfi =(double)gsl_vector_float_get(espl,beg+len-1+i); /* espl(f+i) */ 1462 | esplbi_1=(double)gsl_vector_float_get(espl,beg+i-1); /* espl(bspl+i-1) */ 1463 | esplf1_i=(double)gsl_vector_float_get(espl,beg+len-i); /* espl(f+1-i) */ 1464 | esplb_i =(double)gsl_vector_float_get(espl,beg-i); /* espl(bspl-i) */ 1465 | 1466 | /* EOns(maxxclag+1+i,1,1)=EOns(maxxclag+i,1,1) +nspl(f+i)^2 -nspl(bspl+i-1)^2 ; */ 1467 | gsl_vector_set(EOns[0][0],maxxclag+i, 1468 | gsl_vector_get(EOns[0][0],maxxclag+i-1)+SQR(nsplfi)-SQR(nsplbi_1)); 1469 | /* EOns(maxxclag+1-i,1,1)=EOns(maxxclag+2-i,1,1)-nspl(f+1-i)^2+nspl(bspl-i)^2 ; */ 1470 | gsl_vector_set(EOns[0][0],maxxclag-i, 1471 | gsl_vector_get(EOns[0][0],maxxclag-i+1)-SQR(nsplf1_i)+SQR(nsplb_i)); 1472 | /* EOns(maxxclag+1+i,2,2)=EOns(maxxclag+i,2,2) +espl(f+i)^2 -espl(bspl+i-1)^2 ; */ 1473 | gsl_vector_set(EOns[1][1],maxxclag+i, 1474 | gsl_vector_get(EOns[1][1],maxxclag+i-1)+SQR(esplfi)-SQR(esplbi_1)); 1475 | /* EOns(maxxclag+1-i,2,2)=EOns(maxxclag+2-i,2,2)-espl(f+1-i)^2+espl(bspl-i)^2 ; */ 1476 | gsl_vector_set(EOns[1][1],maxxclag-i, 1477 | gsl_vector_get(EOns[1][1],maxxclag-i+1)-SQR(esplf1_i)+SQR(esplb_i)); 1478 | /* EOns(maxxclag+1+i,2,1)=EOns(maxxclag+i,2,1) +nspl(f+i)*espl(f+i) -nspl(bspl+i-1)*espl(bspl+i-1) ; */ 1479 | gsl_vector_set(EOns[1][0],maxxclag+i, 1480 | gsl_vector_get(EOns[1][0],maxxclag+i-1)+nsplfi*esplfi-nsplbi_1*esplbi_1); 1481 | /* EOns(maxxclag+1-i,2,1)=EOns(maxxclag+2-i,2,1)-nspl(f+1-i)*espl(f+1-i)+nspl(bspl-i)*espl(bspl-i) ; */ 1482 | gsl_vector_set(EOns[1][0],maxxclag-i, 1483 | gsl_vector_get(EOns[1][0],maxxclag-i+1)-nsplf1_i*esplf1_i+nsplb_i*esplb_i); 1484 | /* end */ 1485 | /* EOns(:,1,2)=EOns(:,2,1) ; */ 1486 | gsl_vector_set(EOns[0][1],maxxclag+i,gsl_vector_get(EOns[1][0],maxxclag+i)); 1487 | gsl_vector_set(EOns[0][1],maxxclag-i,gsl_vector_get(EOns[1][0],maxxclag-i)); 1488 | } 1489 | /* plot out EOns */ 1490 | 1491 | /* % calculate elements of cross-correlation matrix */ 1492 | /* Cns=zeros(2*maxxclag+1,2,2); */ 1493 | Cns[0][0]=gsl_vector_alloc(2*maxxclag+1); 1494 | Cns[0][1]=gsl_vector_alloc(2*maxxclag+1); 1495 | Cns[1][0]=gsl_vector_alloc(2*maxxclag+1); 1496 | Cns[1][1]=gsl_vector_alloc(2*maxxclag+1); 1497 | /* Cns(:,1,1)=corrshift(nref,nspl,bspl,maxxclag); */ 1498 | gsl_df_corrshift(Cns[0][0],nref,0,nspl,beg,len,maxxclag,GSL_CORRSHIFT_TWO); 1499 | /* Cns(:,1,2)=corrshift(eref,nspl,bspl,maxxclag); */ 1500 | gsl_df_corrshift(Cns[0][1],eref,0,nspl,beg,len,maxxclag,GSL_CORRSHIFT_TWO); 1501 | /* Cns(:,2,1)=corrshift(nref,espl,bspl,maxxclag); */ 1502 | gsl_df_corrshift(Cns[1][0],nref,0,espl,beg,len,maxxclag,GSL_CORRSHIFT_TWO); 1503 | /* Cns(:,2,2)=corrshift(eref,espl,bspl,maxxclag); */ 1504 | gsl_df_corrshift(Cns[1][1],eref,0,espl,beg,len,maxxclag,GSL_CORRSHIFT_TWO); 1505 | 1506 | /* { */ 1507 | /* FILE *tmpfid; */ 1508 | /* tmpfid=fopen("tmp.Cns00","w"); */ 1509 | /* gsl_vector_fprintf(tmpfid, Cns[0][0],"%g"); */ 1510 | /* fclose(tmpfid); */ 1511 | /* tmpfid=fopen("tmp.Cns01","w"); */ 1512 | /* gsl_vector_fprintf(tmpfid, Cns[0][1],"%g"); */ 1513 | /* fclose(tmpfid); */ 1514 | /* tmpfid=fopen("tmp.Cns10","w"); */ 1515 | /* gsl_vector_fprintf(tmpfid, Cns[1][0],"%g"); */ 1516 | /* fclose(tmpfid); */ 1517 | /* tmpfid=fopen("tmp.Cns11","w"); */ 1518 | /* gsl_vector_fprintf(tmpfid, Cns[1][1],"%g"); */ 1519 | /* fclose(tmpfid); */ 1520 | /* } */ 1521 | 1522 | } 1523 | /* disp('Start grid search'); */ 1524 | /* for i=1:length(vfstdir) */ 1525 | /* fstdir=vfstdir(i) ; */ 1526 | for (fast=hsplit->fastmin,j=0; fast<=hsplit->fastmax+TOLERANCE; fast+=hsplit->faststep, j++) { 1527 | VRB(printf("j=%d Fast=%f \n",j,fast)); 1528 | /* Cfs=rotcr(Cns,fstdir); */ 1529 | /* gsl_vector_memcpy(Cfs[0][0],Cns[0][0]); */ 1530 | /* gsl_vector_memcpy(Cfs[0][1],Cns[0][1]); */ 1531 | /* gsl_vector_memcpy(Cfs[1][0],Cns[1][0]); */ 1532 | /* gsl_vector_memcpy(Cfs[1][1],Cns[1][1]); */ 1533 | CMAT_MEMCPY(Cfs,Cns); 1534 | gsl_rotcr(Cfs,fast); 1535 | /* % the following statement is a bit of an overkill as only few elements of EOns are actually needed. However, */ 1536 | /* % it makes the code look somewhat neater and will actually be faster */ 1537 | /* % if length(vtsplt) is of similar magnitude to maxxclag+length(nref) */ 1538 | /* EOfs=rotcr(EOns,fstdir); */ 1539 | CMAT_MEMCPY(EOfs,EOns); 1540 | gsl_rotcr(EOfs,fast); 1541 | 1542 | /* for j=1:length(vtsplt) */ 1543 | /* tsplt=vtsplt(j) ; */ 1544 | for (time=hsplit->timemin,k=0; time<=hsplit->timemax+TOLERANCE; time+=hsplit->timestep, k++) { 1545 | /* tshift=round(tsplt/(2*SAMPLE_INTERVAL)) ; */ 1546 | itime=(long)ROUND(time/delta); 1547 | /* VRB(printf("k=%d Time=%f itime=%d\n",k,time,itime)); */ 1548 | /* if tsplt==0.0 & i>=2 */ 1549 | /* % for zero splitting, fast direction does not matter and we can */ 1550 | /* % just copy the result from the first fast direction */ 1551 | if(itime==0 && j>=1) { 1552 | /* fast direction is irrelevant for zero splitting time, ie we can just copy result */ 1553 | /* en_res(i,j)=en_res(1,j) ; */ 1554 | /* m_res_energy[j,k]=m_res_energy[1,k] */ 1555 | gsl_matrix_set(m_res_energy,j,k,gsl_matrix_get(m_res_energy,0,k)); 1556 | /* xc(i,j)=xc(1,j) ; */ 1557 | 1558 | /* delay(i,j)=delay(1,j) ; */ 1559 | gsl_matrix_set(m_delay,j,k,gsl_matrix_get(m_delay,0,k)); 1560 | 1561 | gsl_matrix_set(m_alpha,j,k,gsl_matrix_get(m_alpha,0,k)); 1562 | continue; 1563 | /* else */ 1564 | } else { 1565 | /* tshift=round(tsplt/(2*SAMPLE_INTERVAL)) ; */ 1566 | /* x1=tshiftadd(Cfs(:,1,1),Cfs(:,2,2),tshift,maxlag); */ 1567 | itshiftf=itime/2; 1568 | itshifts=itime-itshiftf; 1569 | dvue1=gsl_vector_subvector(Cfs[0][0],maxxclag-maxlag-itshiftf,2*maxlag+1); 1570 | dvue2=gsl_vector_subvector(Cfs[1][1],maxxclag-maxlag+itshifts,2*maxlag+1); 1571 | gsl_vector_memcpy(x1,&dvue1.vector); 1572 | gsl_vector_add(x1,&dvue2.vector); 1573 | /* [mc,mi]=max(x1) ; */ 1574 | mi=(long)gsl_vector_max_index(x1); 1575 | mc=gsl_vector_get(x1,mi); 1576 | /* %%% xc(i,j)=mc ; */ 1577 | /* delay(i,j)=(mi-(length(x1)+1)/2); */ 1578 | idelay=(mi-maxlag); 1579 | gsl_matrix_set(m_delay,j,k,idelay*delta); 1580 | /* % energy_obs: energy in spl seismogram within reference window after applying delay and splitting correction */ 1581 | /* me=maxxclag+1+delay(i,j); */ 1582 | /* energy_obs=EOfs(me-tshift,1,1)+EOfs(me+tshift,2,2) ; */ 1583 | energy_obs=gsl_vector_get(EOfs[0][0],maxxclag-itshiftf+idelay) 1584 | +gsl_vector_get(EOfs[1][1],maxxclag+itshiftf+idelay); 1585 | /* % calculate residual energy between corrected seismogram and reference seismogram allowing for amplitude differences (final amplitude is normalised with respect to amplitude of reference signal */ 1586 | /* % NB mc(fast,slow)=mc(north,east) */ 1587 | /* % can calculate residual energy directly, without */ 1588 | /* % calculating alpha (amplitude correction factor) and residual */ 1589 | /* % vectors first, after some algebra (in notes). Prefactor 4 such that this corresponds to physical */ 1590 | /* % energy if there is no amplitude difference */ 1591 | /* en_res(i,j)=4*(energy_ref*energy_obs^2+2*energy_ref*energy_obs*mc-(energy_ref+energy_obs)*mc^2 ... */ 1592 | /* -2*mc^3+energy_ref^2*energy_obs)/(energy_ref+2*mc+energy_obs)^2; */ 1593 | en_res=4*(energy_ref*SQR(energy_obs)+2*energy_ref*energy_obs*mc-(energy_ref+energy_obs)*SQR(mc)-2*CUB(mc)+SQR(energy_ref)*energy_obs)/SQR(energy_ref+2*mc+energy_obs); 1594 | 1595 | /* % ALTERNATIVE : no alpha correction */ 1596 | /* % en_res(i,j)=(energy_ref-2*mc+energy_obs); */ 1597 | /* if(lshow) */ 1598 | /* % Axis scale factors are adjusted such that reference, corrected data, and residual time series are */ 1599 | /* % visually directly comparable, i.e. amplitude correction has been performed. They are in a way */ 1600 | /* % normalised to amplitude of reference signal (but not actually, just on figure) */ 1601 | /* scale=1.1*max(abs([nref ; eref])); */ 1602 | /* [ns,es]=splitopdel(nspl,espl,bspl,len,tsplt,fstdir,delay(i,j)*SAMPLE_INTERVAL,-1) ; */ 1603 | /* [pol,lin]=pmotion(ns,es) ; */ 1604 | 1605 | /* alpha=(energy_ref+mc)/(energy_obs+2*mc+energy_ref) ; */ 1606 | alpha=(energy_ref+mc)/(energy_obs+2*mc+energy_ref); 1607 | /* in contrast to matlab version, normalise by total energy available */ 1608 | gsl_matrix_set(m_res_energy,j,k,en_res/(SQR(1-alpha)*energy_ref+SQR(alpha)*energy_obs)); 1609 | /* gsl_matrix_set(m_res_energy,j,k,en_res); */ 1610 | gsl_matrix_set(m_alpha,j,k,alpha) ; 1611 | 1612 | /* % ALTERNATIVE : no alpha correction */ 1613 | /* % alpha=0.5 ; */ 1614 | /* % (alpha < 0.5 amplitudes of reference trace smaller than station trace */ 1615 | /* % (alpha > 0.5 amplitudes of reference trace larger than station race */ 1616 | /* nres=2*((1-alpha)*nref-alpha*ns); */ 1617 | /* eres=2*((1-alpha)*eref-alpha*es); */ 1618 | /* fprintf('DEBUG: Direct obs. energy estimate :%.4g vs. pre-calc %.4g dif = %.4g\n', ... */ 1619 | /* nres'*nres+eres'*eres,en_res(i,j),nres'*nres+eres'*eres-en_res(i,j)) ; */ 1620 | /* fprintf('DEBUG: Direct obs.energy :%.4g vs. precalc %.4g dif = %.4g\n', ... */ 1621 | /* ns'*ns+es'*es,energy_obs,ns'*ns+es'*es-energy_obs) ; */ 1622 | /* fprintf('DEBUG: Direct cross.correl :%.4g vs. precalc %.4g dif = %.4g\n', ... */ 1623 | /* nref'*ns+eref'*es,mc,nref'*ns+eref'*es-mc) ; */ 1624 | /* if(en_res(i,j)<0) */ 1625 | /* error('Negative energy. This indicates a bug in the program') */ 1626 | /* end */ 1627 | VRB(if (k==1)printf(" m_res=%g delay=%f alpha=%f\n",gsl_matrix_get(m_res_energy,j,k),gsl_matrix_get(m_delay,j,k),gsl_matrix_get(m_alpha,j,k))); 1628 | } 1629 | } /* end loop over splitting times */ 1630 | } /* end loop over fast directions */ 1631 | /* gsl_vector_free(EOns[0][0]); */ 1632 | /* gsl_vector_free(EOns[0][1]); */ 1633 | /* gsl_vector_free(EOns[1][0]); */ 1634 | /* gsl_vector_free(EOns[1][1]); */ 1635 | /* gsl_vector_free(EOfs[0][0]); */ 1636 | /* gsl_vector_free(EOfs[0][1]); */ 1637 | /* gsl_vector_free(EOfs[1][0]); */ 1638 | /* gsl_vector_free(EOfs[1][1]); */ 1639 | /* gsl_vector_free(Cns[0][0] ); */ 1640 | /* gsl_vector_free(Cns[0][1] ); */ 1641 | /* gsl_vector_free(Cns[1][0] ); */ 1642 | /* gsl_vector_free(Cns[1][1] ); */ 1643 | /* gsl_vector_free(Cfs[0][0] ); */ 1644 | /* gsl_vector_free(Cfs[0][1] ); */ 1645 | /* gsl_vector_free(Cfs[1][0] ); */ 1646 | /* gsl_vector_free(Cfs[1][1] ); */ 1647 | CMAT_FREE(EOns); 1648 | CMAT_FREE(EOfs); 1649 | CMAT_FREE(Cns); 1650 | CMAT_FREE(Cfs); 1651 | } 1652 | 1653 | void double_split_sks(int method, hor_split *hsplit_top, hor_split *hsplit_bot, gsl_vector_float *north, gsl_vector_float *east, long beg, long len, float delta, float baz, gsl_vector *res_energy_doublelayer ) 1654 | { 1655 | /* Grid search for double-layer SKS splitting */ 1656 | /* Inputs: 1657 | method: MINTRANSVERSE or MINEVALUE 1658 | hsplit_top: Input parameters for grid search top layer 1659 | hsplit_bot: Input parameters for grid search bottom layer 1660 | north: north component seismogram (gsl_vector_float) 1661 | east: east component seismogram (gsl_vector_float) 1662 | delta: sampling interval 1663 | baz: backazimuth 1664 | Output: are 2D matrices 1665 | m_res_energy_double: 4-D misfit surface (minimum represents best model) 1666 | 1667 | beg,len: position within the time-series vector at zero offset - note that some information from outside this window is used based on time delay in top layer 1668 | If the input vectors are too short to accommodate the maximum time shift, they are zero-padded to sufficient length 1669 | */ 1670 | 1671 | /* The strategy is to rotate and shift in the time-domain the time series for the top layer, then use the single-split code on the top-layer corrected waveforms for the bottom layer */ 1672 | double top_fast,c,s,time; 1673 | long itime; 1674 | 1675 | int m_top=(hsplit_top->fastmax-hsplit_top->fastmin+TOLERANCE)/hsplit_top->faststep + 1; 1676 | int n_top=(hsplit_top->timemax-hsplit_top->timemin+TOLERANCE)/hsplit_top->timestep + 1; 1677 | int m_bot=(hsplit_bot->fastmax-hsplit_bot->fastmin+TOLERANCE)/hsplit_bot->faststep + 1; 1678 | int n_bot=(hsplit_bot->timemax-hsplit_bot->timemin+TOLERANCE)/hsplit_bot->timestep + 1; 1679 | int i,j,k; 1680 | gsl_matrix *m_res_energy=gsl_matrix_alloc(m_bot,n_bot); 1681 | gsl_matrix *m_pol=gsl_matrix_alloc(m_bot,n_bot); /* is not used further but needed as input argument for single_split_sks */ 1682 | gsl_vector_float *vec_fast; 1683 | gsl_vector_float *vec_slow; 1684 | gsl_vector_float_view vue_fastcor, vue_slowcor,vue_v1, vue_v2, vue_va, vue_vb; 1685 | gsl_vector_view vue_res_energy_doublelayer_row; 1686 | gsl_vector_float *northcor =gsl_vector_float_alloc(len); 1687 | gsl_vector_float *eastcor=gsl_vector_float_alloc(len); 1688 | 1689 | long itimemax=(long)ROUND(hsplit_top->timemax/delta)+TOLERANCE; 1690 | long ibeg,ilen; 1691 | long offsetmax=itimemax/2+1; 1692 | 1693 | 1694 | ASSERT(m_top*n_top*m_bot*n_bot==res_energy_doublelayer->size,"double_split_sks: size of preallocated output vector m_res_energy_doublelayer does not match definitions"); 1695 | /* Initialise - fast direction - N; slow direction - east */ 1696 | 1697 | VRB(printf("sks_Grid search matrix size %d x %d x %d x %d = %d\n",m_top,n_top,m_bot,n_bot,m_top*n_top*m_bot*n_bot)); 1698 | 1699 | 1700 | 1701 | 1702 | /* Cut out a long enough sequence from data, zero-padding if necessary */ 1703 | // use calloc to set input vector elements to zero 1704 | vec_fast=gsl_vector_float_calloc(north->size+2*offsetmax); 1705 | vec_slow=gsl_vector_float_calloc(north->size+2*offsetmax); 1706 | // set vec_fast to north and vec_slow to east 1707 | // only copy those parts which could potentially be needed (governed by offsetmax) 1708 | // and zero-pad if no real data available 1709 | ibeg=offsetmax-beg; 1710 | if (ibeg<0) ibeg=0; 1711 | ilen=len+2*offsetmax-ibeg; 1712 | if (ibeg+ilen > north->size) ilen=north->size-ibeg; 1713 | vue_v1=gsl_vector_float_subvector(vec_fast,ibeg,ilen); 1714 | vue_v2=gsl_vector_float_subvector(vec_slow,ibeg,ilen); 1715 | vue_va=gsl_vector_float_subvector(north,beg+ibeg-offsetmax,ilen); 1716 | vue_vb=gsl_vector_float_subvector(east, beg+ibeg-offsetmax,ilen); 1717 | 1718 | gsl_vector_float_memcpy(&vue_v1.vector, &vue_va.vector); 1719 | gsl_vector_float_memcpy(&vue_v2.vector, &vue_vb.vector); 1720 | 1721 | // reset beg to account for the shift 1722 | beg=offsetmax; 1723 | 1724 | /* Rotate in place to first vec_fast direction (NBL the negative angle is used as gsl_rotate assumes positiv CCW rotation \ 1725 | but azimuth is measured CW from North*/ 1726 | gsl_float_rotate(vec_fast,vec_slow,-hsplit_top->fastmin); 1727 | 1728 | for (top_fast=hsplit_top->fastmin,j=0; top_fast<=hsplit_top->fastmax+TOLERANCE; top_fast+=hsplit_top->faststep, j++) { 1729 | VRB(printf("Top j=%d Fast=%f \n",j,top_fast)); 1730 | /* rot: rotate from ne to fs - done by initial rotation and then incremental*/ 1731 | for (time=hsplit_top->timemin,k=0; time<=hsplit_top->timemax+TOLERANCE; time+=hsplit_top->timestep, k++) { 1732 | itime=(long)ROUND(time/delta); 1733 | /* if ( j!=17 || k!=26 ){ */ 1734 | 1735 | /* continue; */ 1736 | /* } */ 1737 | vue_fastcor=gsl_vector_float_subvector(vec_fast,beg-itime/2,len); 1738 | vue_slowcor=gsl_vector_float_subvector(vec_slow,beg-itime/2+itime,len); 1739 | 1740 | // rotate back to north-south system (later I can try dealing with this by manipulating the backazimuth I think 1741 | gsl_vector_float_memcpy(northcor, &vue_fastcor.vector); 1742 | gsl_vector_float_memcpy(eastcor, &vue_slowcor.vector); 1743 | gsl_float_rotate(northcor,eastcor,top_fast); 1744 | 1745 | /* if (j==07 && k==0 ) { */ 1746 | /* WRITEVECFLOAT("northcor0700.xy",northcor); */ 1747 | /* WRITEVECFLOAT("eastcor0700.xy",eastcor); */ 1748 | /* } */ 1749 | /* if (j==25 && k==0 ) { */ 1750 | /* WRITEVECFLOAT("northcor2500.xy",northcor); */ 1751 | /* WRITEVECFLOAT("eastcor2500.xy",eastcor); */ 1752 | /* } */ 1753 | 1754 | single_split_sks(method,hsplit_bot,northcor,eastcor,0,len,delta,baz,m_res_energy,m_pol); 1755 | // copy result into appropriate part of big results vector 1756 | for (i=0; isize1; i++) { 1757 | // VRB(printf("Copying row i %i\n",i)); 1758 | vue_res_energy_doublelayer_row=gsl_vector_subvector(res_energy_doublelayer,j*n_top*m_bot*n_bot+k*m_bot*n_bot+i*n_bot,n_bot); 1759 | // Debug: double check that all values are unset 1760 | ASSERT(gsl_vector_max(&vue_res_energy_doublelayer_row.vector) <= 0.0,"Trying to set element of res_energy_doublelayer twice"); 1761 | 1762 | gsl_matrix_get_row(&vue_res_energy_doublelayer_row.vector,m_res_energy,i); 1763 | } 1764 | } 1765 | /* rotate to next angle */ 1766 | gsl_float_rotate(vec_fast,vec_slow,-hsplit_top->faststep); 1767 | } 1768 | } 1769 | 1770 | void single_split_sks(int method, hor_split *hsplit, gsl_vector_float *north, gsl_vector_float *east, long beg, long len, float delta, float baz, gsl_matrix *m_res_energy, gsl_matrix *m_pol) { 1771 | /* Grid search for single layer SKS splitting */ 1772 | /* Inputs: 1773 | method: MINTRANSVERSE or MINEVALUE 1774 | hsplit: Input parameters for grid search 1775 | north: north component seismogram (gsl_vector_float) 1776 | east: east component seismogram (gsl_vector_float) 1777 | delta: sampling interval 1778 | baz: backazimuth 1779 | Output: are 2D matrices 1780 | m_res_energy: misfit surface (minimum represents best model 1781 | m_pol: final inferred polarisation, for MINEVALUE, this is derived from first eigenvector, for MINTRANSVERSE simply inferred from baz mod 180 1782 | ( for future extensions 1783 | beg,len: currently must be set to 0 and length of north component 1784 | */ 1785 | float *cnn,*cee,*cne,*data_e,*data_n; 1786 | long npts; 1787 | long maxlag,n2,itime; 1788 | int i,j,k; 1789 | double fast,c,s,time; 1790 | double pol,pol_n,pol_e,pol_f,pol_s,tot_energy; 1791 | /* for matrix calculations */ 1792 | gsl_matrix *m2_cor0=gsl_matrix_alloc(2,2); 1793 | gsl_matrix *m2_corn=gsl_matrix_alloc(2,2); 1794 | gsl_matrix *m2_rot=gsl_matrix_alloc(2,2); 1795 | gsl_matrix *m2_rotbaz=gsl_matrix_alloc(2,2); 1796 | gsl_matrix *m2_aux=gsl_matrix_alloc(2,2); 1797 | gsl_matrix *m2_fscor0=gsl_matrix_alloc(2,2); 1798 | gsl_matrix *m2_fscorn=gsl_matrix_alloc(2,2); 1799 | /* for eigenvalue analysis */ 1800 | gsl_eigen_symmv_workspace *ws_eigen=gsl_eigen_symmv_alloc(2); 1801 | gsl_matrix *m2_evec=gsl_matrix_alloc(2,2); 1802 | gsl_vector *eval=gsl_vector_alloc(2); 1803 | 1804 | // suppress following print-out because this is overwhelming if it is inside a double layer loop iteration 1805 | // VRB(printf("in single_split_sks %f %f %f\n",hsplit->timemax,delta,ROUND(hsplit->timemax/delta))); 1806 | npts=north->size; 1807 | maxlag=(long)ROUND(hsplit->timemax/delta); 1808 | 1809 | /* Calculate cross-correlation matrices */ 1810 | if (beg==0 && len==npts) { 1811 | /* FILE *tmpfid; */ 1812 | /* gsl_vector_float_view tmpvecview; */ 1813 | /* tapered sequences - can use fft to calculate cross-correlations */ 1814 | n2=nxtpwr2(npts+maxlag); 1815 | /* VRB(printf("calculate cross-correlation with FFT maxlag=%ld npts=%ld n2=%ld\n",maxlag,npts,n2)); */ 1816 | cnn=(float *)malloc(n2*sizeof(float)); 1817 | cee=(float *)malloc(n2*sizeof(float)); 1818 | cne=(float *)malloc(n2*sizeof(float)); 1819 | 1820 | data_n=(float *)calloc(sizeof(float),n2); 1821 | data_e=(float *)calloc(sizeof(float),n2); 1822 | if (! ( cnn || cee || cne || data_n || data_e )) { 1823 | abort_msg("single-split-sks: Out of memory"); 1824 | } 1825 | memcpy(data_n,north->data,npts*sizeof(float)); 1826 | memcpy(data_e,east->data,npts*sizeof(float)); 1827 | /* FFT */ 1828 | /* VRB(printf("FFT\n")); */ 1829 | gsl_fft_real_float_radix2_transform(data_n,1,n2); 1830 | gsl_fft_real_float_radix2_transform(data_e,1,n2); 1831 | /* Multiply with complex conjugate in Freq domain */ 1832 | /* VRB(printf("Correlation in freq domain\n")); */ 1833 | for (i=0;i<=n2/2;i++) { 1834 | if (i==0 || i==n2/2 ) { 1835 | // Special case: only real components exist 1836 | cnn[i]=SQR(data_n[i]); 1837 | cee[i]=SQR(data_e[i]); 1838 | cne[i]=data_n[i]*data_e[i]; 1839 | } else { 1840 | // real component in index [i], imaginary component in index [j] 1841 | cnn[i]=ABS2(data_n[i],data_n[n2-i]); /*REAL*/ /* cnn=data_n* data_n */ 1842 | cnn[n2-i]=0; /*IMAG*/ 1843 | cee[i]=ABS2(data_e[i],data_e[n2-i]); /*REAL*/ /* cee=data_e* data_e */ 1844 | cee[n2-i]=0; /*IMAG*/ 1845 | cne[i]=data_n[i]*data_e[i]+data_n[n2-i]*data_e[n2-i]; /*REAL*/ /* cne=data_n* data_e */ 1846 | cne[n2-i]=-data_n[n2-i]*data_e[i]+data_n[i]*data_e[n2-i]; /*IMAG*/ 1847 | } 1848 | /* ASSERT(cnn[i]<1e4,"unusually large real cnn"); */ 1849 | /* ASSERT(cnn[n2-i]<1e4,"unusually large imag cnn"); */ 1850 | /* ASSERT(cee[i]<1e4,"unusually large real cee"); */ 1851 | /* ASSERT(cee[n2-i]<1e4,"unusually large imag cee"); */ 1852 | /* ASSERT(cne[i]<1e4,"unusually large real cee"); */ 1853 | /* ASSERT(cne[n2-i]<1e4,"unusually large imag cee"); */ 1854 | } 1855 | /* IFFT */ 1856 | /* VRB(printf("IFFT\n");) */ 1857 | gsl_fft_halfcomplex_float_radix2_inverse(cnn,1,n2); 1858 | gsl_fft_halfcomplex_float_radix2_inverse(cee,1,n2); 1859 | gsl_fft_halfcomplex_float_radix2_inverse(cne,1,n2); 1860 | /* NB time domain xcorrel stored in wrap around order - only good up to a lag of maxlag */ 1861 | /* DEBUG: output cross correlations */ 1862 | /* tmpfid=fopen("tmp.cnn","w"); */ 1863 | /* tmpvecview=gsl_vector_float_view_array(cnn,n2); */ 1864 | /* gsl_vector_float_fprintf(tmpfid, &tmpvecview.vector,"%g"); */ 1865 | /* fclose(tmpfid); */ 1866 | 1867 | /* tmpfid=fopen("tmp.cee","w"); */ 1868 | /* tmpvecview=gsl_vector_float_view_array(cee,n2); */ 1869 | /* gsl_vector_float_fprintf(tmpfid, &tmpvecview.vector,"%g"); */ 1870 | /* fclose(tmpfid); */ 1871 | 1872 | /* tmpfid=fopen("tmp.cne","w"); */ 1873 | /* tmpvecview=gsl_vector_float_view_array(cne,n2); */ 1874 | /* gsl_vector_float_fprintf(tmpfid, &tmpvecview.vector,"%g"); */ 1875 | /* fclose(tmpfid); */ 1876 | /* END DEBUG */ 1877 | 1878 | tot_energy=cnn[0]+cee[0]; /* normalise by sum of auto-correlation at zero lag, representative of the total energy in the two components */ 1879 | } 1880 | else { 1881 | /* calculate by time-shifting window */ 1882 | abort_msg("Time-shifting algorithm for SKS not yet implemented"); 1883 | } 1884 | gsl_matrix_set(m2_cor0,0,0,(double)cnn[0]); 1885 | gsl_matrix_set(m2_cor0,0,1,(double)cne[0]); 1886 | gsl_matrix_set(m2_cor0,1,0,(double)cne[0]); 1887 | gsl_matrix_set(m2_cor0,1,1,(double)cee[0]); 1888 | /* VRB(printf("m2_cor0:\n"); gsl_matrix_fprintf(stdout,m2_cor0,"%g")); */ 1889 | 1890 | for (fast=hsplit->fastmin,j=0; fast<=hsplit->fastmax+TOLERANCE; fast+=hsplit->faststep, j++) { 1891 | // VRB(printf("j=%d Fast=%f \n",j,fast)); 1892 | /* rot: rotate from ne to fs */ 1893 | c=cos(fast*PI/180); s=sin(fast*PI/180); 1894 | gsl_matrix_set(m2_rot,0,0,(double)c); 1895 | gsl_matrix_set(m2_rot,0,1,(double)s); 1896 | gsl_matrix_set(m2_rot,1,0,(double)-s); 1897 | gsl_matrix_set(m2_rot,1,1,(double)c); 1898 | /* rotbaz: rotate from fs to rt */ 1899 | c=cos((baz-fast)*PI/180); s=sin((baz-fast)*PI/180); 1900 | gsl_matrix_set(m2_rotbaz,0,0,(double)c); 1901 | gsl_matrix_set(m2_rotbaz,0,1,(double)s); 1902 | gsl_matrix_set(m2_rotbaz,1,0,(double)-s); 1903 | gsl_matrix_set(m2_rotbaz,1,1,(double)c); 1904 | /* fscor0 = rot*cor0*rot' (zero lag cross-correlation matrix in fast-slow coordinate system */ 1905 | /* VRB(printf("m2_rot:\n"); gsl_matrix_fprintf(stdout,m2_rot,"%g")); */ 1906 | /* VRB(printf("m2_rotbaz:\n"); gsl_matrix_fprintf(stdout,m2_rotbaz,"%g")); */ 1907 | gsl_blas_dgemm(CblasNoTrans,CblasNoTrans,1.0,m2_rot,m2_cor0,0.0,m2_aux); 1908 | gsl_blas_dgemm(CblasNoTrans,CblasTrans,1.0,m2_aux,m2_rot,0.0,m2_fscor0); 1909 | /* VRB(printf("m2_fscor0:\n"); gsl_matrix_fprintf(stdout,m2_fscor0,"%g")); */ 1910 | for (time=hsplit->timemin,k=0; time<=hsplit->timemax+TOLERANCE; time+=hsplit->timestep, k++) { 1911 | itime=(long)ROUND(time/delta); 1912 | /* VRB(printf("k=%d time=%f itime=%d\n",k,time,itime)); */ 1913 | if(itime==0 && j>=1) { 1914 | /* fast direction is irrelevant for zero splitting time, ie we can just copy result */ 1915 | /* m_res_energy[j,k]=m_res_energy[1,k] */ 1916 | gsl_matrix_set(m_res_energy,j,k,gsl_matrix_get(m_res_energy,0,k)); 1917 | gsl_matrix_set(m_pol,j,k,gsl_matrix_get(m_pol,0,k)); 1918 | continue; 1919 | } else if (itime==0) { 1920 | /* for zero splitting time can copy correlation matrix for zero lag */ 1921 | gsl_matrix_memcpy(m2_fscorn,m2_fscor0); 1922 | } else { 1923 | /* corn: cross-correlation matrix at n=itime */ 1924 | gsl_matrix_set(m2_corn,0,0,(double)cnn[itime]); 1925 | gsl_matrix_set(m2_corn,0,1,(double)cne[itime]); 1926 | gsl_matrix_set(m2_corn,1,0,(double)cne[n2-itime]); /* cne[itime]=cen[-itime]=cen[n2-itime] */ 1927 | gsl_matrix_set(m2_corn,1,1,(double)cee[itime]); 1928 | 1929 | /* VRB(printf("m2_corn:\n"); gsl_matrix_fprintf(stdout,m2_corn,"%g")); */ 1930 | /* fscorn = rot*corn*rot' (correlation matrix in fast-slow coordinate system between advanced and retarded traces) */ 1931 | gsl_blas_dgemm(CblasNoTrans,CblasNoTrans,1.0,m2_rot,m2_corn,0.0,m2_aux); 1932 | gsl_blas_dgemm(CblasNoTrans,CblasTrans,1.0,m2_aux,m2_rot,0.0,m2_fscorn); 1933 | /* VRB(printf("m2_fscorn:\n"); gsl_matrix_fprintf(stdout,m2_fscorn,"%g")); */ 1934 | } 1935 | /* aux=[fscor0[11],fscorn[12];fscorn[12],fscor0[22]; note that fscorn[12] is used twice rather than fscorn[21] as we need f's but not fs' (with f' being the time-advanced fast component and s the slow component */ 1936 | gsl_matrix_set(m2_aux,0,0,gsl_matrix_get(m2_fscor0,0,0)); 1937 | gsl_matrix_set(m2_aux,0,1,gsl_matrix_get(m2_fscorn,0,1)); 1938 | gsl_matrix_set(m2_aux,1,0,gsl_matrix_get(m2_fscorn,0,1)); 1939 | gsl_matrix_set(m2_aux,1,1,gsl_matrix_get(m2_fscor0,1,1)); 1940 | /* VRB(printf("m2_aux(composite):\n"); gsl_matrix_fprintf(stdout,m2_aux,"%g")); */ 1941 | 1942 | switch(method){ 1943 | case MINEVALUE: 1944 | gsl_eigen_symmv(m2_aux, eval, m2_evec, ws_eigen); /* Calculate eigenvalues and vectors */ 1945 | gsl_eigen_symmv_sort(eval, m2_evec, GSL_EIGEN_SORT_VAL_ASC); /* Sort them */ 1946 | 1947 | gsl_matrix_set(m_res_energy,j,k,gsl_vector_get(eval,0)/tot_energy); /* Remember smallest eigenvalue */ 1948 | /* VRB(printf("Min. E Value energy: %f\n",gsl_vector_get(eval,0)/tot_energy)); */ 1949 | /* Rotate eigenvector associated with larger eigenvalue back into N/S system */ 1950 | c=cos((-fast)*PI/180); s=sin((-fast)*PI/180); 1951 | pol_f=gsl_matrix_get(m2_evec,0,1); pol_s=gsl_matrix_get(m2_evec,1,1); 1952 | pol_n= c*pol_f + s*pol_s; 1953 | pol_e=-s*pol_f + c*pol_s; 1954 | pol=atan2(pol_e,pol_n)*180/PI; if (pol<0) pol+=360; 1955 | gsl_matrix_set(m_pol,j,k,pol); 1956 | break; 1957 | case MINTRANSVERSE: 1958 | /* aux = rotbaz*aux*rotbaz' (using fscorn for intermediate result) */ 1959 | gsl_blas_dgemm(CblasNoTrans,CblasNoTrans,1.0,m2_rotbaz,m2_aux,0.0,m2_fscorn); 1960 | gsl_blas_dgemm(CblasNoTrans,CblasTrans,1.0,m2_fscorn,m2_rotbaz,0.0,m2_aux); 1961 | gsl_matrix_set(m_res_energy,j,k,gsl_matrix_get(m2_aux,1,1)/tot_energy); 1962 | gsl_matrix_set(m_pol,j,k,fmod(baz,180.)); 1963 | /* ASSERT(gsl_matrix_get(m_res_energy,j,k)>=0.0,"negative energy"); */ 1964 | if ( gsl_matrix_get(m_res_energy,j,k)<0.0 ) { 1965 | fprintf(stderr,"ASSERTION VIOLATION: negative energy %d %d %f\n",j,k,gsl_matrix_get(m_res_energy,j,k)); 1966 | } 1967 | /* if (fabs(gsl_matrix_get(m_res_energy,j,k)-0.861669)<0.000001 ) { */ 1968 | /* fprintf(stderr,"ASSERTION VIOLATION: Weird value %d %d %f itime %ld cnn[itime] %f\n",j,k,gsl_matrix_get(m_res_energy,j,k),itime,cnn[itime]); */ 1969 | /* gsl_matrix_fprintf(stdout,m2_corn,"%g"); */ 1970 | /* WRITEVECFLOAT("north.xy",north); */ 1971 | /* WRITEVECFLOAT("east.xy",east); */ 1972 | /* // if (j!=0 && k!=0) exit(10); */ 1973 | /* } */ 1974 | /* VRB(printf("Norm. Transverse energy: %f %f\n",gsl_matrix_get(m2_aux,1,1)/tot_energy,gsl_matrix_get(m_res_energy,j,k))); */ 1975 | break; 1976 | } 1977 | } /* continue for(time...) */ 1978 | } /* continue for(fast...) */ 1979 | /* free allocated memory */ 1980 | gsl_matrix_free(m2_cor0); 1981 | gsl_matrix_free(m2_corn); 1982 | gsl_matrix_free(m2_rot); 1983 | gsl_matrix_free(m2_rotbaz); 1984 | gsl_matrix_free(m2_aux); 1985 | gsl_matrix_free(m2_fscor0); 1986 | gsl_matrix_free(m2_fscorn); 1987 | gsl_eigen_symmv_free(ws_eigen); 1988 | gsl_matrix_free(m2_evec); 1989 | gsl_vector_free(eval); 1990 | free(cnn); free(cee); free(cne); 1991 | free(data_n); free(data_e); 1992 | } 1993 | 1994 | 1995 | 1996 | gsl_vector_float *find_window(sachdr *hdr, gsl_vector_float *data, 1997 | analysis_window *win, float maxlag, long *beg, long *len,char *phase) { 1998 | /* determines begin and length of analysis window in terms of samples 1999 | carries out tapering on the actual data if requested 2000 | warns if no tapering is employed and there are less than maxlag seconds 2001 | available (necessary for shift-correlation) 2002 | 2003 | Input: 2004 | hdr, data : SAC header, data 2005 | win : Analysis window structure (phase_start,phase_end, offset_start, offset_end, taper) 2006 | maxlag : maximum amount of lag (in s) to be expected from later analysis 2007 | 2008 | Output: 2009 | beg,len : Begin and length of analysis window in samples (0-based) 2010 | Note that samples outside the analysis window can be important for 2011 | non-zero lag if tapering is not employed 2012 | phase: Decription of phase used 2013 | 2014 | Returns: 2015 | pointer to gsl_vector_float 2016 | 2017 | 2018 | Depends On: find_phase 2019 | */ 2020 | float del=hdr->delta,b=hdr->b; 2021 | float wb,we; 2022 | char phase_dum[9]; 2023 | gsl_vector_float_view vec_vue; 2024 | gsl_vector_float *vec=malloc(sizeof(gsl_vector_float)); 2025 | 2026 | wb=find_phase(hdr,win->phase_start,phase)+win->offset_start; 2027 | if (isnan(wb)) { 2028 | fprintf(stderr,"Could not find phase name %s.",win->phase_start); abort_msg(""); } 2029 | we=find_phase(hdr,win->phase_end,phase_dum)+win->offset_end; 2030 | if (isnan(we)) { 2031 | fprintf(stderr,"Could not find phase name %s.",win->phase_end); abort_msg(""); } 2032 | 2033 | /* fprintf(stderr,"DEBUG find_window wb b del refwbeg %d ldum1 %d refwln %d ldum2 %d\n",refwbeg,ldum1,refwlen,ldum2); */ 2034 | *beg=(long)ROUND((wb-b)/del); 2035 | *len=(long)ROUND((we-wb)/del)+1; 2036 | if ( *beg<0 || *beg+*len > hdr->npts || *len<3 ) { 2037 | sprintf(warn_str,"Illegal win definition - beg(s)=%f end(s)=%f beg(smpl)=%ld length(smpl)=%ld b(sac)=%f delta=%f npts=%d", 2038 | wb,we,*beg,*len,b,del,hdr->npts); 2039 | abort_msg(warn_str); 2040 | } 2041 | 2042 | if (win->taper>=0) { 2043 | VRB(fprintf(stderr,"Tapering with taper length %f.\n", win->taper)); 2044 | /* Create sub-vector */ 2045 | vec_vue=gsl_vector_float_subvector(data,*beg,*len); 2046 | rmean_and_taper(gsl_vector_float_ptr(&vec_vue.vector,0),*len,del,0,win->taper); 2047 | *beg=0; 2048 | *vec=vec_vue.vector; /* copy actual vector structure to prevent it going out of scope on exiting */ 2049 | return(vec); 2050 | } else { 2051 | /* Check that there is enough data around analysis window to accommodate maximum shifts */ 2052 | if (wb-b < maxlag || hdr->e-we < maxlag ) { 2053 | sprintf(warn_str,"Length of time series too short to accommodate maximum lag %f (pre-window: %f, post-window: %f)", 2054 | maxlag, wb-b, hdr->e-we); 2055 | warn_msg(warn_str); 2056 | } 2057 | return(data); 2058 | } 2059 | } 2060 | 2061 | 2062 | float find_phase(sachdr *hdr,char *phase_name,char *phase_out) { 2063 | /* 2064 | Input 2065 | hdr: pointer to SAC header 2066 | phase_name: either SAC header variable or phase name (to be matched with pick descriptions 2067 | returns time in s of SAC phase phase_name 2068 | returns NaN if no match can be found 2069 | Auxiliary output: 2070 | phase_out: Name of phase finally chosen 2071 | */ 2072 | phase_out[8]='\0'; 2073 | if (!strcasecmp(phase_name,"b")) { 2074 | strcpy(phase_out," "); 2075 | return(hdr->b); } 2076 | else if (!strcasecmp(phase_name,"e")) { 2077 | strcpy(phase_out," "); 2078 | return(hdr->e); } 2079 | else if (!strcasecmp(phase_name,"o")) { 2080 | strcpy(phase_out,"O"); 2081 | return(hdr->o); } 2082 | else if (!strcasecmp(phase_name,"a")) { 2083 | /* if (strncasecmp("-12345",hdr->ka,6)) */ 2084 | /* strncpy(phase_out,hdr->ka,8); */ 2085 | /* else */ 2086 | strcpy(phase_out,"A"); 2087 | return(hdr->a); } 2088 | else if (!strcasecmp(phase_name,"f")) { 2089 | strcpy(phase_out,"F"); 2090 | return(hdr->f); } 2091 | else if (!strcasecmp(phase_name,"t0")) { 2092 | if (strncasecmp("-12345",hdr->kt0,6)) 2093 | strncpy(phase_out,hdr->kt0,8); 2094 | else 2095 | strcpy(phase_out,"T0"); 2096 | return(hdr->t0); } 2097 | else if (!strcasecmp(phase_name,"t1")) { 2098 | if (strncasecmp("-12345",hdr->kt1,6)) 2099 | strncpy(phase_out,hdr->kt1,8); 2100 | else 2101 | strcpy(phase_out,"T1"); 2102 | return(hdr->t1); } 2103 | else if (!strcasecmp(phase_name,"t2")) { 2104 | if (strncasecmp("-12345",hdr->kt2,6)) 2105 | strncpy(phase_out,hdr->kt2,8); 2106 | else 2107 | strcpy(phase_out,"T2"); 2108 | return(hdr->t2); } 2109 | else if (!strcasecmp(phase_name,"t3")) { 2110 | if (strncasecmp("-12345",hdr->kt3,6)) 2111 | strncpy(phase_out,hdr->kt3,8); 2112 | else 2113 | strcpy(phase_out,"T3"); 2114 | return(hdr->t3); } 2115 | else if (!strcasecmp(phase_name,"t4")) { 2116 | if (strncasecmp("-12345",hdr->kt4,6)) 2117 | strncpy(phase_out,hdr->kt4,8); 2118 | else 2119 | strcpy(phase_out,"T4"); 2120 | return(hdr->t4); } 2121 | else if (!strcasecmp(phase_name,"t5")) { 2122 | if (strncasecmp("-12345",hdr->kt5,6)) 2123 | strncpy(phase_out,hdr->kt5,8); 2124 | else 2125 | strcpy(phase_out,"T5"); 2126 | return(hdr->t5); } 2127 | else if (!strcasecmp(phase_name,"t6")) { 2128 | if (strncasecmp("-12345",hdr->kt6,6)) 2129 | strncpy(phase_out,hdr->kt6,8); 2130 | else 2131 | strcpy(phase_out,"T6"); 2132 | return(hdr->t6); } 2133 | else if (!strcasecmp(phase_name,"t7")) { 2134 | if (strncasecmp("-12345",hdr->kt7,6)) 2135 | strncpy(phase_out,hdr->kt7,8); 2136 | else 2137 | strcpy(phase_out,"T7"); 2138 | return(hdr->t7); } 2139 | else if (!strcasecmp(phase_name,"t8")) { 2140 | if (strncasecmp("-12345",hdr->kt8,6)) 2141 | strncpy(phase_out,hdr->kt8,8); 2142 | else 2143 | strcpy(phase_out,"T8"); 2144 | return(hdr->t8); } 2145 | else if (!strcasecmp(phase_name,"t9")) { 2146 | if (strncasecmp("-12345",hdr->kt9,6)) 2147 | strncpy(phase_out,hdr->kt9,8); 2148 | else 2149 | strcpy(phase_out,"T9"); 2150 | return(hdr->t9); } 2151 | else if (!strncasecmp(phase_name,hdr->kt0,8)) { 2152 | return(hdr->t0); } 2153 | else if (!strncasecmp(phase_name,hdr->kt1,8)) { 2154 | return(hdr->t1); } 2155 | else if (!strncasecmp(phase_name,hdr->kt2,8)) { 2156 | return(hdr->t2); } 2157 | else if (!strncasecmp(phase_name,hdr->kt3,8)) { 2158 | return(hdr->t3); } 2159 | else if (!strncasecmp(phase_name,hdr->kt4,8)) { 2160 | return(hdr->t4); } 2161 | else if (!strncasecmp(phase_name,hdr->kt5,8)) { 2162 | return(hdr->t5); } 2163 | else if (!strncasecmp(phase_name,hdr->kt6,8)) { 2164 | return(hdr->t6); } 2165 | else if (!strncasecmp(phase_name,hdr->kt7,8)) { 2166 | return(hdr->t7); } 2167 | else if (!strncasecmp(phase_name,hdr->kt8,8)) { 2168 | return(hdr->t8); } 2169 | else if (!strncasecmp(phase_name,hdr->kt9,8)) { 2170 | return(hdr->t9); } 2171 | else { 2172 | warn_msg("Cannot find phase name match"); 2173 | return (float)NAN; 2174 | } 2175 | } 2176 | 2177 | void parse(int argc, char **argv, ms_params *par) { 2178 | int iarg; 2179 | char *dummy; 2180 | logical read_data=FALSE, define_win=FALSE; 2181 | /* Required arguments: initialise to 0 and check later */ 2182 | par->method=0; 2183 | par->model=0; 2184 | /* Default markers ( Defaults depend on other options ) */ 2185 | par->root[0]='\0'; 2186 | /* Defaults */ 2187 | strcpy(par->window.phase_start,"B"); 2188 | strcpy(par->window.phase_end,"E"); 2189 | par->window.offset_start=0.0; 2190 | par->window.offset_end=0.0; 2191 | par->window.taper=-1; 2192 | par->make_grd=FALSE; 2193 | par->dof_s=1; 2194 | 2195 | iarg=0; 2196 | while(++iarg=argc ) 2205 | abort_msg("-data option must be followed by two sac-filenames (horizontal components)."); 2206 | read_seis_file(argv[++iarg],&(par->hdr_hor1),&(par->data_hor1)); 2207 | read_seis_file(argv[++iarg],&(par->hdr_hor2),&(par->data_hor2)); 2208 | 2209 | if (strlen(par->root)==0) { 2210 | /* set default root name to root of first data file */ 2211 | if ( dummy=rindex(argv[iarg-1],'.') ) 2212 | strncpy(par->root,argv[iarg-1],(size_t)(dummy-argv[iarg-1])); 2213 | else 2214 | strcpy(par->root,argv[iarg-1]); 2215 | } 2216 | } 2217 | /* Method options */ 2218 | else if(!strcasecmp(argv[iarg],"-me") || !strcasecmp(argv[iarg],"-minevalue")) { 2219 | par->method = MINEVALUE; } 2220 | else if(!strcasecmp(argv[iarg],"-mt") || !strcasecmp(argv[iarg],"-mintransverse")) { 2221 | par->method = MINTRANSVERSE; } 2222 | else if(!strcasecmp(argv[iarg],"-conv")) { 2223 | par->method = CONV; } 2224 | else if(!strcasecmp(argv[iarg],"-cx") || !strcasecmp(argv[iarg],"-correl")) { 2225 | par->method = CORREL; 2226 | if ( iarg+3>=argc ) 2227 | abort_msg("-correl option must be followed by maxshift (in seconds) and two sac-filenames (horizontal components)."); 2228 | par->method_q.cor_par.maxshift=atof(argv[++iarg]); 2229 | read_seis_file(argv[++iarg],&(par->method_q.cor_par.hdr_ref1),&(par->method_q.cor_par.data_ref1)); 2230 | read_seis_file(argv[++iarg],&(par->method_q.cor_par.hdr_ref2),&(par->method_q.cor_par.data_ref2)); 2231 | } 2232 | /* Splitting model options */ 2233 | else if(!strcasecmp(argv[iarg],"-single")) { 2234 | par->model = SINGLE_HOR_SPLIT; 2235 | if ( iarg+3>=argc ) 2236 | abort_msg("-single option must be followed by 3 arguments (stepfast, stepdelay, maxdelay)"); 2237 | par->model_q.split_par.bot.faststep = atof(argv[++iarg]); 2238 | par->model_q.split_par.bot.fastmin = 0; 2239 | par->model_q.split_par.bot.fastmax = 180; 2240 | par->model_q.split_par.bot.timestep = atof(argv[++iarg]); 2241 | par->model_q.split_par.bot.timemin = 0; 2242 | par->model_q.split_par.bot.timemax = atof(argv[++iarg]); 2243 | 2244 | par->model_q.split_par.top.faststep = par->model_q.split_par.top.timestep = 1.0; 2245 | par->model_q.split_par.top.fastmin = par->model_q.split_par.top.timemin = 0.0; 2246 | par->model_q.split_par.top.fastmax = par->model_q.split_par.top.timemax =0.0; 2247 | } 2248 | else if(!strcasecmp(argv[iarg],"-double")) { 2249 | par->model = DOUBLE_HOR_SPLIT; 2250 | if ( iarg+3>=argc ) 2251 | abort_msg("-double option must be followed by 3 arguments (stepfast, stepdelay, maxdelay)"); 2252 | par->model_q.split_par.top.faststep= par->model_q.split_par.bot.faststep= atof(argv[++iarg]); 2253 | par->model_q.split_par.top.fastmin = par->model_q.split_par.bot.fastmin = 0; 2254 | par->model_q.split_par.top.fastmax = par->model_q.split_par.bot.fastmax = 180; 2255 | par->model_q.split_par.top.timestep= par->model_q.split_par.bot.timestep= atof(argv[++iarg]); 2256 | par->model_q.split_par.top.timemin = par->model_q.split_par.bot.timemin = 0; 2257 | par->model_q.split_par.top.timemax = par->model_q.split_par.bot.timemax = atof(argv[++iarg]); 2258 | } 2259 | else if(!strcasecmp(argv[iarg],"-singlesub") ) { 2260 | par->model = SINGLE_HOR_SPLIT; 2261 | if ( iarg+6>=argc ) 2262 | abort_msg("-singlesub option must be followed by 6 arguments (stepfast minfast maxfast stepdelay mindelay maxdelay)"); 2263 | par->model_q.split_par.bot.faststep = atof(argv[++iarg]); 2264 | par->model_q.split_par.bot.fastmin = atof(argv[++iarg]); 2265 | par->model_q.split_par.bot.fastmax = atof(argv[++iarg]); 2266 | par->model_q.split_par.bot.timestep = atof(argv[++iarg]); 2267 | par->model_q.split_par.bot.timemin = atof(argv[++iarg]); 2268 | par->model_q.split_par.bot.timemax = atof(argv[++iarg]); 2269 | 2270 | par->model_q.split_par.top.faststep = par->model_q.split_par.top.timestep = 1.0; 2271 | par->model_q.split_par.top.fastmin = par->model_q.split_par.top.timemin = 0.0; 2272 | par->model_q.split_par.top.fastmax = par->model_q.split_par.top.timemax =0.0; 2273 | } 2274 | /* Window definition */ 2275 | else if(!strcasecmp(argv[iarg],"-winp") ) { 2276 | if ( iarg+2>=argc ) 2277 | abort_msg("-winp must be followed by 2 arguments (two phase names)"); 2278 | define_win=TRUE; 2279 | strncpy(par->window.phase_start,argv[++iarg],8); par->window.phase_start[8]='\0'; 2280 | par->window.offset_start=0.0; 2281 | strncpy(par->window.phase_end,argv[++iarg],8); par->window.phase_end[8]='\0'; 2282 | par->window.offset_end=0.0; 2283 | } 2284 | else if(!strcasecmp(argv[iarg],"-wint") ) { 2285 | if ( iarg+3>=argc ) 2286 | abort_msg("-winp must be followed by 3 arguments (phase name, offset_start,offset_end)"); 2287 | define_win=TRUE; 2288 | strncpy(par->window.phase_start,argv[++iarg],8); par->window.phase_start[8]='\0'; 2289 | strcpy(par->window.phase_end,par->window.phase_start); 2290 | par->window.offset_start=atof(argv[++iarg]); 2291 | par->window.offset_end=atof(argv[++iarg]); 2292 | } 2293 | else if(!strcasecmp(argv[iarg],"-taper") ) { 2294 | if ( iarg+1>=argc ) 2295 | abort_msg("-taper must be followed by 1 argument (taper length in sec)"); 2296 | par->window.taper=atof(argv[++iarg]); 2297 | } 2298 | else if(!strcasecmp(argv[iarg],"-grd") ) { 2299 | if (!par->make_grd) 2300 | par->make_grd=MAKE_GRD; 2301 | } 2302 | else if(!strcasecmp(argv[iarg],"-gmt") ) { 2303 | par->make_grd=MAKE_GMT; 2304 | // fprintf(stderr,"DEBUG: make_gmt4\n"); 2305 | } 2306 | else if(!strcasecmp(argv[iarg],"-gmt5") || !strcasecmp(argv[iarg],"-gmt6") ) { 2307 | par->make_grd=MAKE_GMT5; 2308 | // fprintf(stderr,"DEBUG: make_gmt5\n"); 2309 | } 2310 | else if(!strcasecmp(argv[iarg],"-dof") ) { 2311 | if ( iarg+1>=argc ) 2312 | abort_msg("-dof must be followed by 1 argument (degrees of freedom per sec)"); 2313 | par->dof_s=atof(argv[++iarg]); 2314 | } 2315 | else if(!strcasecmp(argv[iarg],"-name") ) { 2316 | if ( iarg+1>=argc ) 2317 | abort_msg("-name must be followed by 1 argument (file name root)"); 2318 | strncpy(par->root,argv[++iarg],128); 2319 | par->root[127]='\0'; 2320 | } 2321 | else if(!strcasecmp(argv[iarg],"-v") ) { 2322 | verbose=1; 2323 | } 2324 | else if(!strcasecmp(argv[iarg],"-h") ) { 2325 | usage("multisplit"); 2326 | } 2327 | else if(!strcasecmp(argv[iarg],"-version") ) { 2328 | fprintf(stderr,"Version: %s\n",MULTISPLIT_VERSION); 2329 | exit(10); 2330 | } 2331 | else { 2332 | fprintf(stderr,"%s ",argv[iarg]); 2333 | abort_msg("is not a known option"); 2334 | } 2335 | } 2336 | /* Consistency and error checking */ 2337 | if (!read_data) 2338 | abort_msg("Need to specify -data option"); 2339 | if(par->method==0) 2340 | abort_msg("Need to choose a method (one of -minevalue -mintransverse -conv -correl)"); 2341 | if(par->model==0) 2342 | abort_msg("Need to choose a splitting model (one of -single -double -singlesub)"); 2343 | /* set taper to 2 s if undefined and whole record is used */ 2344 | if (!define_win && par->window.taper<0 ) { 2345 | warn_msg("Setting taper to 2 s for whole record mode."); 2346 | par->window.taper=2.0; 2347 | } 2348 | } 2349 | 2350 | void abort_msg(char *msg) { 2351 | fprintf(stderr,"%s\n ABORT \n",msg); 2352 | exit(10); 2353 | } 2354 | 2355 | void warn_msg(char *msg) { 2356 | fprintf(stderr,"WARNING: %s\n",msg); 2357 | } 2358 | 2359 | void usage(char *cmd) { 2360 | fprintf(stderr,"Usage: %s [OPTIONS] \n",cmd); 2361 | fprintf(stderr,"\ 2362 | OPTIONS:\n\ 2363 | \n\ 2364 | Required:\n\ 2365 | \n\ 2366 | -data hor1 hor2\n\ 2367 | hor1 and hor2 are sac files containing the S phase for which splitting\n\ 2368 | should be measured. The header variables CMPAZ and BAZ must be set.\n\ 2369 | \n\ 2370 | Method: Choose one of\n\ 2371 | \n\ 2372 | -me or -minevalue Minimise second eigenvalue (i.e. impose as linear a motion as possible)\n\ 2373 | (Secondary result: polarisation) - e.g. Silver and Chan, 1991\n\ 2374 | \n\ 2375 | -mt or -mintransverse Minimise transverse energy - e.g. Silver and Chan, 1991\n\ 2376 | \n\ 2377 | -conv Convolution method - Menke and Levin, 2003\n\ 2378 | \n\ 2379 | -cx or -correl maxshift refh1 refh2 Reference station method (see Eken and Tilmann BSSA, 2014, doi:10.1785/0120140020 )\n\ 2380 | Minimise difference to reference station\n\ 2381 | maxshift: maximum amount of travel time shift between stations\n\ 2382 | refh1, refh2: sac file containing two horizontal components with\n\ 2383 | reference trace\n\ 2384 | (Secondary results: time shift, scale factor)\n\ 2385 | \n\ 2386 | \n\ 2387 | Splitting model: choose one of\n\ 2388 | \n\ 2389 | -single stepfast stepdelay maxdelay\n\ 2390 | Single layer splitting. \n\ 2391 | stepfast, stepdelay: stepwidths for grid search\n\ 2392 | maxdelay: maximum splitting delay\n\ 2393 | \n\ 2394 | -double stepfast stepdelay maxdelay\n\ 2395 | Two layer splitting\n\ 2396 | \n\ 2397 | -singlesub stepfast minfast maxfast stepdelay mindelay maxdelay \n\ 2398 | Search selected fast directions\n\ 2399 | \n\ 2400 | Window definition: Choose one of\n\ 2401 | \n\ 2402 | -winp t1 t2 n1,n2 can be arbitray header variable-names. If there are not one of the \n\ 2403 | valid SAC header variables, multisplit looks for headernames matching those\n\ 2404 | \n\ 2405 | -wint t1 start end Phase name or header variable and offset to start and end of analysis window\n\ 2406 | \n\ 2407 | DEFAULT Use the whole record.\n\ 2408 | \n\ 2409 | \n\ 2410 | Optional modifiers\n\ 2411 | \n\ 2412 | -taper sec Taper records with taper length sec. If no tapering is carried out\n\ 2413 | shift windows to calculate cross-correlation rather than calculating\n\ 2414 | cross-correlation of windowed traces.\n\ 2415 | \n\ 2416 | -grd Convert 2-parameter error surface binary files to GMT grid files\n\ 2417 | \n\ 2418 | -gmt Create and execute GMT script for display - write out time series files (GMT4)\n\ 2419 | -gmt6, --gmt5 Create and execute GMT script for display - write out time series files (GMT6)\n\ 2420 | \n\ 2421 | -name root Set root of output file names\n\ 2422 | (Default: derive name from first input file root)\n\ 2423 | \n\ 2424 | -dof f Set number of degrees of freedom per second (Default: 1s)\n\ 2425 | \n\ 2426 | -v Verbose output\n\ 2427 | \n\ 2428 | Other options\n\ 2429 | \n\ 2430 | -h Show this help text\n\ 2431 | -version Show version number\n\ 2432 | \n\ 2433 | "); 2434 | fprintf(stderr,"Version: %s\n",MULTISPLIT_VERSION); 2435 | exit(10); 2436 | } 2437 | 2438 | 2439 | /* Spares: 2440 | The first digit gives the parameter number for x-axis, the second 2441 | digit the parameter for the y-axis (e.g. -grd 34 for the two 2442 | layer problem would give the bottom layer parameters) 2443 | */ 2444 | --------------------------------------------------------------------------------