/*---------------------------------------------------------------------------*/
void
sparse_solve(sparse_t *A, double *b, double *x)
/*---------------------------------------------------------------------------*/
{
assert (A->m == A->n);
if (sparse_is_triangular(A))
{
sparse_solve_triangular(A, b, x);
return;
}
int n = A->m;
/* UMFPACK expect compressed-sparse-column format. */
sparse_t *B = NULL; sparse_copy(&B, A);
B = sparse_transpose(B);
double *null = (double *) NULL ;
void *Symbolic, *Numeric ;
umfpack_di_symbolic (n, n, B->ia, B->ja, B->a, &Symbolic, null, null) ;
umfpack_di_numeric (B->ia, B->ja, B->a, Symbolic, &Numeric, null, null) ;
umfpack_di_free_symbolic (&Symbolic);
umfpack_di_solve (UMFPACK_A, B->ia, B->ja, B->a, x, b, Numeric, null, null) ;
umfpack_di_free_numeric (&Numeric);
sparse_free(B);
}
Sparse* phytree_compute_inverse_sparse(PhyTree *tree) {
Sparse *M,*S;
double v, *diag;
int nnodes,dim,nzmax;
int root,node_id, node_idx,parent_id,parent_idx,i;
nnodes = tree->num_nodes;
dim = nnodes-1;
nzmax = dim + 2*tree->num_internal*tree->max_descendants;
diag = (double*)PM_MEM_ALLOC(dim*sizeof(double));
if (diag==NULL) return NULL;
M = sparse_spalloc(dim,dim,nzmax,1,1); /* triplet */
root = tree->preorder[0]; /* should be zero */
for(i=1; i < nnodes; i++) {
node_id = tree->preorder[i];
parent_id = tree->parent[node_id];
/* adjust index: we are skipping the root */
node_idx = node_id-1;
v = 1.0/tree->edge_length[node_id];
/* m[node_idx*dim + node_idx] = v; */
diag[node_idx] = v;
if (parent_id != root) {
parent_idx = parent_id-1;
/* m[parent_idx*dim + parent_idx] += v; */
diag[parent_idx] += v;
/* m[parent_idx*dim + node_idx] = -v; */
sparse_entry(M,parent_idx,node_idx,-v);
/* m[node_idx*dim + parent_idx] = -v; */
sparse_entry(M,node_idx,parent_idx,-v);
}
}
for(i=0; i < dim; i++) {
sparse_entry(M,i,i,diag[i]);
}
PM_MEM_FREE(diag);
S = sparse_compress(M);
sparse_free(M);
return S;
}
/*---------------------------------------------------------------------------*/
static void
solve_sparse_diag_block(int begin, int end, sparse_t *A, double *B, double *x)
/*---------------------------------------------------------------------------*/
{
int n = end-begin;
int i,j,k;
int nnz = A->ia[end]-A->ia[begin];
sparse_t *a = sparse_alloc(n, n, nnz);
double *b = calloc(n, sizeof *b);
int pos = 0;
for (i=begin; i<end; ++i)
b [i-begin] = B [i];
a->ia[0] = 0;
for (i=begin; i<end; ++i)
{
int I = i-begin;
for (k=A->ia[i]; k<A->ia[i+1]; ++k)
{
j = A->ja[k]-begin; assert(j<end);
if (j<0)
b[I] -= A->a[k]*x[begin+j];
else /* i==j */
{
a->ja[pos] = j;
a->a [pos] = A->a[k];
++pos;
}
}
a->ia[i+1-begin]=pos;
}
/* sparse_display(a, stderr);fprintf(stderr, "\n"); */
sparse_solve(a, b, x+begin);
free(b);
sparse_free(a);
}
int main(int argc, char* argv[])
{
bool hermite_false, hermite_true;
int n1, n2, npml, pad1, pad2, ns, nw, nh;
float d1, d2, **v, ds, os, dw, ow;
double omega;
sf_complex ***f, ***srcw, ***recw, ***obs, ***obs_cut;
sf_file in, out, source, receiver, record;
int uts, mts;
char *order;
int is, i, j, iw, ih;
float ***image, **recloc;
sf_init(argc, argv);
in = sf_input("in");
out = sf_output("out");
if (!sf_getint("nh",&nh)) nh=0;
if (!sf_getint("uts",&uts)) uts=0;
//#ifdef _OPENMP
// mts = omp_get_max_threads();
//#else
mts = 1;
//#endif
uts = (uts < 1)? mts: uts;
hermite_false=false;
hermite_true=true;
/* Hermite operator */
if (!sf_getint("npml",&npml)) npml=20;
/* PML width */
if (NULL == (order = sf_getstring("order"))) order="j";
/* discretization scheme (default optimal 9-point) */
fdprep_order(order);
/* read input dimension */
if (!sf_histint(in,"n1",&n1)) sf_error("No n1= in input.");
if (!sf_histint(in,"n2",&n2)) sf_error("No n2= in input.");
if (!sf_histfloat(in,"d1",&d1)) sf_error("No d1= in input.");
if (!sf_histfloat(in,"d2",&d2)) sf_error("No d2= in input.");
v = sf_floatalloc2(n1,n2);
sf_floatread(v[0],n1*n2,in);
/* PML padding */
pad1 = n1+2*npml;
pad2 = n2+2*npml;
/* read receiver */
if (NULL == sf_getstring("receiver")) sf_error("Need receiver=");
receiver = sf_input("receiver");
recloc=sf_floatalloc2(n1,n2);
sf_floatread(recloc[0],n1*n2,receiver);
/* read source */
if (NULL == sf_getstring("source")) sf_error("Need source=");
source = sf_input("source");
if (!sf_histint(source,"n3",&ns)) sf_error("No ns=.");
if (!sf_histfloat(source,"d3",&ds)) ds=d2;
if (!sf_histfloat(source,"o3",&os)) os=0.;
f = sf_complexalloc3(n1,n2,ns);
/* read observed data */
if (NULL == sf_getstring("record")) sf_error("Need record=");
record = sf_input("record");
if (!sf_histint(record,"n4",&nw)) sf_error("No nw=.");
if (!sf_histfloat(record,"d4",&dw)) sf_error("No dw=.");
if (!sf_histfloat(record,"o4",&ow)) sf_error("No ow=.");
obs = sf_complexalloc3(n1,n2,ns);
obs_cut = sf_complexalloc3(n1,n2,ns);
srcw = sf_complexalloc3(n1,n2,ns);
recw = sf_complexalloc3(n1,n2,ns);
image = sf_floatalloc3(n1,n2,2*nh+1);
/* Loop over frequency */
for (iw=0; iw<nw; iw++ ) {
omega=(double) 2.*SF_PI*(ow+iw*dw);
sf_warning("Calculating frequency %d out of %d for %f HZ.",iw+1,nw,ow+iw*dw);
sf_complexread(f[0][0],n1*n2*ns,source);
sf_complexread(obs[0][0],n1*n2*ns,record);
/* generate adjoint source for reverse time migration */
genadjsrc_rtm(obs, obs_cut, recloc, n1, n2, ns);
/* initialize sparse solver */
sparse_init(uts, pad1, pad2);
/* factorize matrix, change according to different frequencies and models */
sparse_factor(omega,n1,n2,d1,d2,v,npml,pad1,pad2,uts);
for (is=0; is < ns; is++ ) {
for (j=0; j < n2; j++ ) {
for (i=0; i < n1; i++ ) {
srcw[is][j][i]=f[is][j][i];
recw[is][j][i]=obs_cut[is][j][i];
}
}
}
/* sparse solver for source wavefield */
sparse_solve(npml, pad1, pad2, srcw, hermite_false, ns, uts);
/* sparse solver for receiver wavefield */
sparse_solve(npml, pad1, pad2, recw, hermite_true, ns, uts);
/* imaging condition */
for (ih=-nh; ih < nh+1; ih++ ) {
for (j=0; j<n2; j++ ) {
for (i=0; i< n1; i++ ) {
for (is=0; is < ns; is++ ) {
if (j-abs(ih) >= 0 && j+abs(ih) < n2) {
image[ih+nh][j][i] += crealf(omega*omega*conjf(srcw[is][j-ih][i])*recw[is][j+ih][i]/(v[j][i]*v[j][i]));
}
}
}
}
}
/* free memory */
sparse_free(uts);
} /* end frequency */
sf_putint(out,"n1",n1);
sf_putint(out,"n2",n2);
sf_putint(out,"n3",2*nh+1);
sf_putfloat(out,"d3",d2);
sf_putfloat(out,"o3", (float) -nh*d2);
sf_floatwrite(image[0][0],n1*n2*(2*nh+1),out);
exit(0);
}
int main(int argc, char* argv[])
{
bool hermite;
int n1, n2, npml, pad1, pad2, ns, nw, iw;
float d1, d2, **v, ds, os, ow, dw;
double omega;
sf_complex ***f;
sf_file in, out, source;
int uts, mts;
char *order;
sf_init(argc, argv);
in = sf_input("in");
out = sf_output("out");
if (!sf_getint("uts",&uts)) uts=0;
//#ifdef _OPENMP
// mts = omp_get_max_threads();
//#else
mts = 1;
//#endif
uts = (uts < 1)? mts: uts;
sf_warning("Using %d out of %d threads!", uts, mts);
if (!sf_getbool("hermite",&hermite)) hermite=false;
/* Hermite operator */
if (!sf_getint("npml",&npml)) npml=20;
/* PML width */
if (NULL == (order = sf_getstring("order"))) order="j";
/* discretization scheme (default optimal 9-point) */
fdprep_order(order);
/* read input dimension */
if (!sf_histint(in,"n1",&n1)) sf_error("No n1= in input.");
if (!sf_histint(in,"n2",&n2)) sf_error("No n2= in input.");
if (!sf_histfloat(in,"d1",&d1)) sf_error("No d1= in input.");
if (!sf_histfloat(in,"d2",&d2)) sf_error("No d2= in input.");
v = sf_floatalloc2(n1,n2);
sf_floatread(v[0],n1*n2,in);
/* PML padding */
pad1 = n1+2*npml;
pad2 = n2+2*npml;
/* read source */
if (NULL == sf_getstring("source"))
sf_error("Need source=");
source = sf_input("source");
if (!sf_histint(source,"n3",&ns)) sf_error("No ns=.");
if (!sf_histfloat(source,"d3",&ds)) ds=d2;
if (!sf_histfloat(source,"o3",&os)) os=0.;
if (!sf_histint(source,"n4",&nw)) sf_error("No nw=.");
if (!sf_histfloat(source,"d4",&dw)) sf_error("No dw=.");
if (!sf_histfloat(source,"o4",&ow)) sf_error("No ow=.");
f = sf_complexalloc3(n1,n2,ns);
/* write out forward simulation */
sf_settype(out,SF_COMPLEX);
sf_putint(out,"n3",ns);
sf_putfloat(out,"d3",ds);
sf_putfloat(out,"o3",os);
sf_putstring(out,"label3","Shot");
sf_putstring(out,"unit3","");
sf_putint(out,"n4",nw);
sf_putfloat(out,"d4",dw);
sf_putfloat(out,"o4",ow);
sf_putstring(out,"label4","Frequency");
sf_putstring(out,"unit4","Hz");
/* Loop over frequency */
for (iw=0; iw<nw; iw++ ) {
omega=(double) 2.*SF_PI*(ow+iw*dw);
sf_warning("Calculating frequency %d out of %d for %f HZ.",iw+1,nw,ow+iw*dw);
/* read in source */
sf_complexread(f[0][0],n1*n2*ns,source);
/* initialize sparse solver */
sparse_init(uts, pad1, pad2);
/* factorize matrix, change according to different frequencies and models */
sparse_factor(omega, n1, n2, d1, d2, v, npml, pad1, pad2);
/* sparse solver */
sparse_solve(npml, pad1, pad2, f, hermite, ns, uts);
/* write out wavefield */
sf_complexwrite(f[0][0],n1*n2*ns,out);
sparse_free(uts);
}
exit(0);
}
