void reduce_eqkfm_memory(struct eqkfm *eqkfm0, int NF){
/* Frees empty arrays in eqkfm0 structure.
* Input:
* eqkfm0= pointer to eqkfm array. (*eqkfm)[0...NF-1]
* NF=no of faults, i.e. no. of *eqkfm elements.
* Output:
* frees eqkfm.slip_str, eqkfm.slip_dip, eqkfm.slip_open arrays when needed.
*/
double toll=1e-10; //tolerance
int is_str, is_dip, is_open; //flags used to determine which components of deformations are needed (to save memory).
//check if all elements are 0, and is so set flag.
for (int nf=0; nf<NF; nf++){
check_empty_eqkfm(eqkfm0[nf], toll, &is_str, &is_dip, &is_open);
//free memory if elements are all 0.
if (is_str==0){
//if condition needed since the element may have been freed before:
if (eqkfm0[nf].slip_str) free_darray(eqkfm0[nf].slip_str,1, eqkfm0[nf].np_st*eqkfm0[nf].np_di);
eqkfm0[nf].slip_str=NULL;
}
if (is_dip==0){
if (eqkfm0[nf].slip_dip) free_darray(eqkfm0[nf].slip_dip,1, eqkfm0[nf].np_st*eqkfm0[nf].np_di);
eqkfm0[nf].slip_dip=NULL;
}
if (is_open==0){
if (eqkfm0[nf].open) free_darray(eqkfm0[nf].open,1, eqkfm0[nf].np_st*eqkfm0[nf].np_di);
eqkfm0[nf].open=NULL;
}
}
}
/**
* @brief Create a new trie
*
* @param alpha_map : the alphabet set for the trie
*
* @return a pointer to the newly created trie, NULL on failure
*
* Create a new empty trie object based on the given @a alpha_map alphabet
* set. The trie contents can then be added and deleted with trie_store() and
* trie_delete() respectively.
*
* The created object must be freed with trie_free().
*/
trie_t
make_trie(void)
{
trie_t trie;
if ((trie = (trie_t)malloc(sizeof(*trie))) == NULL) {
return NULL;
}
if ((trie->da = make_darray()) == NULL) {
goto exit_trie_created;
}
if ((trie->tail = make_tail()) == NULL) {
goto exit_da_created;
}
trie->dirtyp = 1;
return trie;
exit_da_created:
free_darray(trie->da);
exit_trie_created:
free(trie);
return NULL;
}
/**
* @brief Free a trie object
*
* @param trie : the trie object to free
*
* Destruct the @a trie and free its allocated memory.
*/
void
free_trie(trie_t trie)
{
free_darray(trie->da);
free_tail(trie->tail);
free(trie);
return;
}
double *smoothed_rate_Helmstetter(double *xgrid, double *ygrid, double dx, double dy, int Ngrid, double *xs, double *ys, double *err, double *weights, int N, int ord){
/* Calculates background rate from a catalog, using the algorithm from:
* Helmstetter et al (2007) "High-resolution Time-independent Grid-based Forecast for M ≥ 5 Earthquakes in California"
*
* Input:
* xgrid, ygrid: x,y grid for which rate should be calculated. size [1...Ngrid]
* dx, dy: spacing between grid points.
* xs, ys: x,y coordinates of events. size [1...N]
* err= location error associated with each event. size [1...N]
* weights: weight assigned to each event. Can be used as flag for declustering (0/1 for excluded/selected events), or to weight some events more than others.
* if weights==NULL, all events are selected with weight=1. size [1...N]
* ord= 1,2: indicates if first o second nearest neighbour should be used.
*
* Output:
* vector of size [1...Ngrid] containing number of events in each grid point for the total time period.
*/
double d, w;
double *dist=NULL;
int *ind, no_ind;
double *rate, *rate_tot;
ind=iarray(1,Ngrid);
rate=darray(0,Ngrid);
rate_tot=darray(1,Ngrid);
for (int i=1; i<=Ngrid; i++) rate_tot[i]=0.0;
switch (ord){
//calculate first or second nearest neighbor distance for each earthquake:
case 1:
all_nearestneighbours(xs, ys, N, NULL, &dist);
break;
case 2:
all_2ndnearestneighbours(xs, ys, N, NULL, &dist);
break;
default:
print_screen("** Error: illegal value for variable 'ord' in smoothed_rate_Helmstetter.c. \n**");
print_logfile("** Error: illegal value for variable 'ord' in smoothed_rate_Helmstetter.c. \n**");
return NULL;
}
//todo could parallelize (omp)
for (int eq=1; eq<=N; eq++){
if (!weights || (weights[eq]>0.0)){ //skip if weight=0.0
d=fmax(dist[eq],err[eq]);
find_gridpoints_exact(ygrid, xgrid, NULL, dx, dy, 0.0, Ngrid, Ngrid, ys[eq], xs[eq], d, 0.0, 0.0, 10000, &no_ind, &ind, &rate, 1, 0);
w= (weights)? weights[eq] : 1.0;
for (int i=1; i<=no_ind; i++) rate_tot[ind[i]]+=w*rate[i];
}
}
free_iarray(ind,1,Ngrid);
free_darray(rate,0,Ngrid);
return rate_tot;
}
void free_cat(struct catalog cat){
/* Deallocates memory from variables in catalog structure.
*/
//assumes that elements have been initialized at position 1.
free_darray(cat.t,1, 0);
free_darray(cat.mag,1, 0);
free_darray(cat.lat0,1, 0);
free_darray(cat.lon0,1, 0);
free_darray(cat.x0,1, 0);
free_darray(cat.y0,1, 0);
free_darray(cat.depths0,1, 0);
free_iarray(cat.ngrid,1, 0);
free_i2array_firstlevel(cat.ngridpoints,1,cat.Z,1,0); //uses 0 for upper index, since it doesn't matter.
free_d2array_firstlevel(cat.weights,1,cat.Z, 1,0);
}
double *fit_depth(double *zgrid, double dz, int Ngrid, double *zs, double *err, double *weights, int N){
/* Returns the number of events in depth bins.
*
* Input:
*
* zgrid, ygrid: vertical grid for which rate should be calculated. size [1...Ngrid]
* dz: spacing between grid points.
* zs: depth of events. size [1...N]
* err= location error associated with each event. size [1...N]. Used as st. dev. for smoothing.
* weights: weight assigned to each event. Can be used as flag for declustering (0/1 for excluded/selected events), or to weight some events more than others.
* if weights==NULL, all events are selected with weight=1. size [1...N]
*
* Output:
* vector of size [1...Ngrid] containing number of events in each grid point for the total time period.
*
*/
double *prob0, *prob;
double probCum;
double rz, w;
prob0=darray(1,Ngrid);
prob=darray(1,Ngrid);
for (int n=1; n<=Ngrid; n++) prob[n]=0;
//todo could parallelize(omp)
for (int eq=1; eq<=N; eq++){
probCum=0;
for (int n=1; n<=Ngrid; n++){
rz=fabs(zgrid[n]-zs[eq]);
//smooth event across grid points:
prob0[n]=exact_prob_1d(rz, dz, err[eq]);
}
w=(weights)? weights[eq] : 1.0;
for (int n=1; n<=Ngrid; n++) prob[n]+=w*prob0[n];
}
free_darray(prob0,1,Ngrid);
return prob;
}
static trie_t
trie_fmread(fmcmb_t stream)
{
trie_t trie;
if ((trie = malloc(sizeof(*trie))) == NULL) {
return NULL;
}
if ((trie->da = darray_fmread(stream)) == NULL) {
goto exit_trie_created;
}
if ((trie->tail = tail_fmread(stream)) == NULL) {
goto exit_da_created;
}
trie->dirtyp = 0;
return trie;
exit_da_created:
free_darray(trie->da);
exit_trie_created:
free(trie);
return NULL;
}
trie_t
clone_trie(const_trie_t src)
{
trie_t res;
if ((res = (trie_t)malloc(sizeof(*res))) == NULL) {
return NULL;
}
if ((res->da = clone_darray(src->da)) == NULL) {
goto exit_trie_created;
}
if ((res->tail = clone_tail(src->tail)) == NULL) {
goto exit_da_created;
}
res->dirtyp = src->dirtyp;
return res;
exit_da_created:
free_darray(res->da);
exit_trie_created:
free(res);
return NULL;
}
void Mie(double x,struct c_complex m,double*mu,long nangles,struct c_complex*s1,
struct c_complex*s2,double*qext,double*qsca,double*qback,double*g)
/*:34*/
#line 519 "./mie.w"
{
/*36:*/
#line 546 "./mie.w"
struct c_complex*D;
struct c_complex z1,an,bn,bnm1,anm1,qbcalc;
double*pi0,*pi1,*tau;
struct c_complex xi,xi0,xi1;
double psi,psi0,psi1;
double alpha,beta,factor;
long n,k,nstop,sign;
*qext= -1;
*qsca= -1;
*qback= -1;
*g= -1;
/*:36*/
#line 522 "./mie.w"
/*37:*/
#line 559 "./mie.w"
if(m.im> 0.0){
mie_error("This program requires m.im>=0",1);
return;
}
if(x<=0.0){
mie_error("This program requires positive sphere sizes",2);
return;
}
if(nangles<0){
mie_error("This program requires non-negative angle sizes",3);
return;
}
if(nangles<0){
mie_error("This program requires non-negative angle sizes",4);
return;
}
if((nangles> 0)&&(s1==NULL)){
mie_error("Space must be allocated for s1 if nangles!=0",5);
return;
}
if((nangles> 0)&&(s2==NULL)){
mie_error("Space must be allocated for s2if nangles!=0",6);
return;
}
if(x> 20000){
mie_error("Program not validated for spheres with x>20000",7);
return;
}
/*:37*/
#line 524 "./mie.w"
/*38:*/
#line 589 "./mie.w"
if((m.re==0)&&(x<0.1)){
small_conducting_Mie(x,m,mu,nangles,s1,s2,qext,qsca,qback,g);
return;
}
if((m.re> 0.0)&&(c_abs(m)*x<0.1)){
small_Mie(x,m,mu,nangles,s1,s2,qext,qsca,qback,g);
return;
}
/*:38*/
#line 525 "./mie.w"
/*40:*/
#line 616 "./mie.w"
nstop= floor(x+4.05*pow(x,0.33333)+2.0);
/*:40*/
#line 527 "./mie.w"
/*39:*/
#line 600 "./mie.w"
if(nangles> 0){
set_carray(s1,nangles,c_set(0.0,0.0));
set_carray(s2,nangles,c_set(0.0,0.0));
pi0= new_darray(nangles);
pi1= new_darray(nangles);
tau= new_darray(nangles);
set_darray(pi0,nangles,0.0);
set_darray(tau,nangles,0.0);
set_darray(pi1,nangles,1.0);
}
/*:39*/
#line 529 "./mie.w"
if(m.re> 0)
/*41:*/
#line 634 "./mie.w"
{
struct c_complex z;
z= c_smul(x,m);
D= new_carray(nstop+1);
if(D==NULL){
mie_error("Cannot allocate log array",8);
return;
}
if(fabs(m.im*x)<((13.78*m.re-10.8)*m.re+3.9))
Dn_up(z,nstop,D);
else
Dn_down(z,nstop,D);
}
/*:41*/
#line 531 "./mie.w"
/*42:*/
#line 671 "./mie.w"
psi0= sin(x);
psi1= psi0/x-cos(x);
xi0= c_set(psi0,cos(x));
xi1= c_set(psi1,cos(x)/x+sin(x));
*qsca= 0.0;
*g= 0.0;
*qext= 0.0;
sign= 1;
qbcalc= c_set(0.0,0.0);
anm1= c_set(0.0,0.0);
bnm1= c_set(0.0,0.0);
/*:42*/
#line 533 "./mie.w"
for(n= 1;n<=nstop;n++){
/*43:*/
#line 696 "./mie.w"
if(m.re==0.0){
an= c_sdiv(n*psi1/x-psi0,c_sub(c_smul(n/x,xi1),xi0));
bn= c_sdiv(psi1,xi1);
}else if(m.im==0.0){
z1.re= D[n].re/m.re+n/x;
an= c_sdiv(z1.re*psi1-psi0,c_sub(c_smul(z1.re,xi1),xi0));
z1.re= D[n].re*m.re+n/x;
bn= c_sdiv(z1.re*psi1-psi0,c_sub(c_smul(z1.re,xi1),xi0));
}else{
z1= c_div(D[n],m);
z1.re+= n/x;
an= c_div(c_set(z1.re*psi1-psi0,z1.im*psi1),c_sub(c_mul(z1,xi1),xi0));
z1= c_mul(D[n],m);
z1.re+= n/x;
bn= c_div(c_set(z1.re*psi1-psi0,z1.im*psi1),c_sub(c_mul(z1,xi1),xi0));
}
/*:43*/
#line 536 "./mie.w"
/*44:*/
#line 734 "./mie.w"
for(k= 0;k<nangles;k++){
factor= (2.0*n+1.0)/(n+1.0)/n;
tau[k]= n*mu[k]*pi1[k]-(n+1)*pi0[k];
alpha= factor*pi1[k];
beta= factor*tau[k];
s1[k].re+= alpha*an.re+beta*bn.re;
s1[k].im+= alpha*an.im+beta*bn.im;
s2[k].re+= alpha*bn.re+beta*an.re;
s2[k].im+= alpha*bn.im+beta*an.im;
}
for(k= 0;k<nangles;k++){
factor= pi1[k];
pi1[k]= ((2.0*n+1.0)*mu[k]*pi1[k]-(n+1.0)*pi0[k])/n;
pi0[k]= factor;
}
/*:44*/
#line 537 "./mie.w"
/*45:*/
#line 780 "./mie.w"
factor= 2.0*n+1.0;
*g+= (n-1.0/n)*(anm1.re*an.re+anm1.im*an.im+bnm1.re*bn.re+bnm1.im*bn.im);
*g+= factor/n/(n+1.0)*(an.re*bn.re+an.im*bn.im);
*qsca+= factor*(c_norm(an)+c_norm(bn));
*qext+= factor*(an.re+bn.re);
sign*= -1;
qbcalc.re+= sign*factor*(an.re-bn.re);
qbcalc.im+= sign*factor*(an.im-bn.im);
/*:45*/
#line 538 "./mie.w"
/*46:*/
#line 804 "./mie.w"
factor= (2.0*n+1.0)/x;
xi= c_sub(c_smul(factor,xi1),xi0);
xi0= xi1;
xi1= xi;
psi= factor*psi1-psi0;
psi0= psi1;
psi1= xi1.re;
anm1= an;
bnm1= bn;
/*:46*/
#line 539 "./mie.w"
}
/*47:*/
#line 817 "./mie.w"
*qsca*= 2/(x*x);
*qext*= 2/(x*x);
*g*= 4/(*qsca)/(x*x);
*qback= c_norm(qbcalc)/(x*x);
/*:47*/
#line 542 "./mie.w"
/*48:*/
#line 823 "./mie.w"
if(m.re> 0)free_carray(D);
if(nangles> 0){
free_darray(pi0);
free_darray(pi1);
free_darray(tau);
}
/*:48*/
#line 543 "./mie.w"
}
