void forward_modeling_a(sf_file Fdat, sf_mpi *mpipar, sf_sou soupar, sf_acqui acpar, sf_vec array, bool verb)
/*< acoustic forward modeling >*/
{
int ix, iz, is, ir, it;
int sx, rx, sz, rz, rectx, rectz;
int nz, nx, padnz, padnx, padnzx, nt, nr, nb;
float dx2, dz2, dt2, dt;
float **vv, **dd;
float **p0, **p1, **p2, **term, **tmparray, *rr;
FILE *swap;
MPI_Comm comm=MPI_COMM_WORLD;
swap=fopen("temswap.bin", "wb+");
padnz=acpar->padnz;
padnx=acpar->padnx;
padnzx=padnz*padnx;
nz=acpar->nz;
nx=acpar->nx;
nt=acpar->nt;
nr=acpar->nr;
nb=acpar->nb;
sz=acpar->sz;
rz=acpar->rz;
rectx=soupar->rectx;
rectz=soupar->rectz;
dx2=acpar->dx*acpar->dx;
dz2=acpar->dz*acpar->dz;
dt2=acpar->dt*acpar->dt;
dt=acpar->dt;
vv = sf_floatalloc2(padnz, padnx);
dd=sf_floatalloc2(nt, nr);
p0=sf_floatalloc2(padnz, padnx);
p1=sf_floatalloc2(padnz, padnx);
p2=sf_floatalloc2(padnz, padnx);
term=sf_floatalloc2(padnz, padnx);
rr=sf_floatalloc(padnzx);
/* padding and convert vector to 2-d array */
pad2d(array->vv, vv, nz, nx, nb);
for(is=mpipar->cpuid; is<acpar->ns; is+=mpipar->numprocs){
sf_warning("###### is=%d ######", is+1);
memset(dd[0], 0., nr*nt*sizeof(float));
memset(p0[0], 0., padnzx*sizeof(float));
memset(p1[0], 0., padnzx*sizeof(float));
memset(p2[0], 0., padnzx*sizeof(float));
sx=acpar->s0_v+is*acpar->ds_v;
source_map(sx, sz, rectx, rectz, padnx, padnz, padnzx, rr);
for(it=0; it<nt; it++){
if(verb) sf_warning("Modeling is=%d; it=%d;", is+1, it);
/* output data */
for(ir=0; ir<acpar->nr2[is]; ir++){
rx=acpar->r0_v[is]+ir*acpar->dr_v;
dd[acpar->r02[is]+ir][it]=p1[rx][rz];
}
/* laplacian operator */
laplace(p1, term, padnx, padnz, dx2, dz2);
/* load source */
for(ix=0; ix<padnx; ix++){
for(iz=0; iz<padnz; iz++){
term[ix][iz] += rr[ix*padnz+iz]*array->ww[it];
}
}
/* update */
for(ix=0; ix<padnx; ix++){
for(iz=0; iz<padnz; iz++){
p2[ix][iz]=2*p1[ix][iz]-p0[ix][iz]+vv[ix][iz]*vv[ix][iz]*dt2*term[ix][iz];
}
}
/* swap wavefield pointer of different time steps */
tmparray=p0; p0=p1; p1=p2; p2=tmparray;
/* boundary condition */
apply_sponge(p0, acpar->bc, padnx, padnz, nb);
apply_sponge(p1, acpar->bc, padnx, padnz, nb);
} // end of time loop
fseeko(swap, is*nr*nt*sizeof(float), SEEK_SET);
fwrite(dd[0], sizeof(float), nr*nt, swap);
}// end of shot loop
fclose(swap);
MPI_Barrier(comm);
/* transfer data to Fdat */
if(mpipar->cpuid==0){
swap=fopen("temswap.bin", "rb");
for(is=0; is<acpar->ns; is++){
fseeko(swap, is*nr*nt*sizeof(float), SEEK_SET);
fread(dd[0], sizeof(float), nr*nt, swap);
sf_floatwrite(dd[0], nr*nt, Fdat);
}
fclose(swap);
remove("temswap.bin");
}
MPI_Barrier(comm);
/* release allocated memory */
free(*p0); free(p0); free(*p1); free(p1);
free(*p2); free(p2); free(*vv); free(vv);
free(*dd); free(dd);
free(rr); free(*term); free(term);
}
void gradient_standard(float *x, float *fcost, float *grad)
/*< standard velocity gradient >*/
{
int ix, iz, is, ir, it, wit, iturn;
int sx, rx;
float temp, dmax;
float **p0, **p1, **p2, **term, **tmparray, *rr, ***wave, **pp;
float *sendbuf, *recvbuf;
/* residual file */
sf_file Fres;
Fres=sf_output("Fres");
sf_putint(Fres,"n1",nt);
sf_putint(Fres,"n2",nr);
/* initialize fcost */
*fcost=0.;
/* update velocity */
pad2d(x, vv, nz, nx, nb);
/* initialize gradient */
memset(grad, 0., nzx*sizeof(float));
/* initialize data misfit */
swap=0.;
/* memory allocation */
p0=sf_floatalloc2(padnz, padnx);
p1=sf_floatalloc2(padnz, padnx);
p2=sf_floatalloc2(padnz, padnx);
term=sf_floatalloc2(padnz, padnx);
rr=sf_floatalloc(padnzx);
wave=sf_floatalloc3(nz, nx, wnt);
pp=sf_floatalloc2(nt, nr);
iturn=0;
for(is=cpuid; is<ns; is+=numprocs){
if(cpuid==0) sf_warning("###### is=%d ######", is+1);
memset(p0[0], 0., padnzx*sizeof(float));
memset(p1[0], 0., padnzx*sizeof(float));
memset(p2[0], 0., padnzx*sizeof(float));
memset(pp[0], 0., nr*nt*sizeof(float));
sx=s0_v+is*ds_v;
source_map(sx, sz, frectx, frectz, padnx, padnz, padnzx, rr);
wit=0;
/* forward propagation */
for(it=0; it<nt; it++){
if(verb) sf_warning("Forward propagation is=%d; it=%d;", is+1, it);
/* output predicted data */
for(ir=0; ir<nr2[is]; ir++){
rx=r0_v[is]+ir*dr_v;
pp[r02[is]+ir][it]=p1[rx][rz];
}
/* save wavefield */
if(it%interval==0){
#ifdef _OPENMP
#pragma omp parallel for \
private(ix,iz) \
shared(wave,p1,wit,nb,nx,nz)
#endif
for(ix=0; ix<nx; ix++)
for(iz=0; iz<nz; iz++)
wave[wit][ix][iz]=p1[ix+nb][iz+nb];
wit++;
}
/* laplacian operator */
laplace(p1, term, padnx, padnz, dx2, dz2);
/* load source */
#ifdef _OPENMP
#pragma omp parallel for \
private(ix,iz) \
shared(term,rr,padnx,padnz,ww,it)
#endif
for(ix=0; ix<padnx; ix++){
for(iz=0; iz<padnz; iz++){
term[ix][iz] += rr[ix*padnz+iz]*ww[it];
}
}
/* update */
#ifdef _OPENMP
#pragma omp parallel for \
private(ix,iz) \
shared(p0,p1,p2,vv,term,padnx,padnz,dt2)
#endif
for(ix=4; ix<padnx-4; ix++){
for(iz=4; iz<padnz-4; iz++){
p2[ix][iz]=2*p1[ix][iz]-p0[ix][iz]+vv[ix][iz]*vv[ix][iz]*dt2*term[ix][iz];
}
}
/* swap wavefield pointer of different time steps */
tmparray=p0; p0=p1; p1=p2; p2=tmparray;
/* boundary condition */
apply_sponge(p0, bc, padnx, padnz, nb);
apply_sponge(p1, bc, padnx, padnz, nb);
} // end of time loop
/* check */
if(wit != wnt) sf_error("Incorrect number of wavefield snapshots");
wit--;
/* calculate data residual and data misfit */
for(ir=0; ir<nr; ir++){
for(it=0; it<nt; it++){
pp[ir][it]=dd[iturn][ir][it]-pp[ir][it];
pp[ir][it] *= weight[ir][it];
swap += 0.5*pp[ir][it]*pp[ir][it];
}
}
smooth_misfit(pp, fcost, nr, nt, drectx, drectz, nrepeat, ider);
iturn++;
/* check the data residual */
if(is==ns/2) sf_floatwrite(pp[0], nr*nt, Fres);
sf_fileclose(Fres);
/* initialization */
memset(p0[0], 0., padnzx*sizeof(float));
memset(p1[0], 0., padnzx*sizeof(float));
memset(p2[0], 0., padnzx*sizeof(float));
memset(term[0], 0., padnzx*sizeof(float));
/* backward propagation */
for(it=nt-1; it>=0; it--){
if(verb) sf_warning("Backward propagation is=%d; it=%d;", is+1, it);
/* laplacian operator */
laplace(p1, term, padnx, padnz, dx2, dz2);
/* load data residual */
for(ir=0; ir<nr2[is]; ir++){
rx=r0_v[is]+ir*dr_v;
term[rx][rz] += pp[r02[is]+ir][it];
}
/* update */
#ifdef _OPENMP
#pragma omp parallel for \
private(ix,iz) \
shared(p0,p1,p2,vv,term,padnx,padnz,dt2)
#endif
for(ix=4; ix<padnx-4; ix++){
for(iz=4; iz<padnz-4; iz++){
p2[ix][iz]=2*p1[ix][iz]-p0[ix][iz]+vv[ix][iz]*vv[ix][iz]*dt2*term[ix][iz];
}
}
/* calculate gradient */
if(it%interval==0){
if(wit != wnt-1 && wit != 0){ // avoid the first and last time step
#ifdef _OPENMP
#pragma omp parallel for \
private(ix,iz,temp) \
shared(nx,nz,vv,wave,p1,wit,wdt2,grad)
#endif
for(ix=0; ix<nx; ix++){
for(iz=0; iz<nz; iz++){
temp=vv[ix+nb][iz+nb];
temp=temp*temp*temp;
temp=-2./temp;
grad[ix*nz+iz] += (wave[wit+1][ix][iz]-2.*wave[wit][ix][iz]+wave[wit-1][ix][iz])/wdt2*p1[ix+nb][iz+nb]*temp;
}
}
}
wit--;
}
/* swap wavefield pointer of different time steps */
tmparray=p0; p0=p1; p1=p2; p2=tmparray;
/* boundary condition */
apply_sponge(p0, bc, padnx, padnz, nb);
apply_sponge(p1, bc, padnx, padnz, nb);
} // end of time loop
}// end of shot loop
MPI_Barrier(comm);
/* misfit reduction */
//MPI_ALLreduce(sendbuf, recvbuf, 1, MPI_FLOAT, MPI_SUM, comm);
if(cpuid==0){
sendbuf=MPI_IN_PLACE;
recvbuf=fcost;
}else{
sendbuf=fcost;
recvbuf=NULL;
}
MPI_Reduce(sendbuf, recvbuf, 1, MPI_FLOAT, MPI_SUM, 0, comm);
MPI_Bcast(fcost, 1, MPI_FLOAT, 0, comm);
if(cpuid==0){
sendbuf=MPI_IN_PLACE;
recvbuf=&swap;
}else{
sendbuf=&swap;
recvbuf=NULL;
}
MPI_Reduce(sendbuf, recvbuf, 1, MPI_FLOAT, MPI_SUM, 0, comm);
MPI_Bcast(&swap, 1, MPI_FLOAT, 0, comm);
/* gradient reduction */
//MPI_ALLreduce(sendbuf, recvbuf, nzx, MPI_FLOAT, MPI_SUM, comm);
if(cpuid==0){
sendbuf=MPI_IN_PLACE;
recvbuf=grad;
}else{
sendbuf=grad;
recvbuf=NULL;
}
MPI_Reduce(sendbuf, recvbuf, nzx, MPI_FLOAT, MPI_SUM, 0, comm);
MPI_Bcast(grad, nzx, MPI_FLOAT, 0, comm);
/* scaling gradient */
if(first){
dmax=0.;
for(ix=0; ix<nzx; ix++)
if(fabsf(grad[ix])>dmax)
dmax=fabsf(grad[ix]);
scaling=0.1/dmax;
first=false;
}
/* smooth gradient */
gradient_smooth2(grectx, grectz, nx, nz, waterz, scaling, grad);
/* free allocated memory */
free(*p0); free(p0); free(*p1); free(p1);
free(*p2); free(p2); free(*pp); free(pp);
free(**wave); free(*wave); free(wave);
free(rr); free(*term); free(term);
}
void rtm(sf_file Fdat, sf_file Fimg, sf_mpi *mpipar, sf_sou soupar, sf_acqui acpar, sf_vec_s array, bool verb)
/*< acoustic rtm >*/
{
int ix, iz, is, ir, it, wit;
int sx, rx, sz, rz, frectx, frectz;
int nz, nx, nzx, padnz, padnx, padnzx, nt, nr, nb, wnt;
float dx2, dz2, dt2, dt;
float **vv, **dd, **mm;
float **p0, **p1, **p2, **term, **tmparray, *rr, ***wave;
float *sendbuf, *recvbuf;
//sf_file Fwfl1, Fwfl2;
//Fwfl1=sf_output("Fwfl1");
//Fwfl2=sf_output("Fwfl2");
MPI_Comm comm=MPI_COMM_WORLD;
nz=acpar->nz;
nx=acpar->nx;
nzx=nz*nx;
padnz=acpar->padnz;
padnx=acpar->padnx;
padnzx=padnz*padnx;
nr=acpar->nr;
nb=acpar->nb;
sz=acpar->sz;
rz=acpar->rz;
frectx=soupar->frectx;
frectz=soupar->frectz;
nt=acpar->nt;
wnt=(nt-1)/acpar->interval+1;
dx2=acpar->dx*acpar->dx;
dz2=acpar->dz*acpar->dz;
dt2=acpar->dt*acpar->dt;
dt=acpar->dt;
//sf_putint(Fwfl1, "n1", padnz);
//sf_putint(Fwfl1, "n2",padnx);
//sf_putint(Fwfl1, "n3",(nt-1)/50+1);
//sf_putint(Fwfl2, "n1", padnz);
//sf_putint(Fwfl2, "n2",padnx);
//sf_putint(Fwfl2, "n3",(nt-1)/50+1);
/* memory allocation */
vv = sf_floatalloc2(padnz, padnx);
dd=sf_floatalloc2(nt, nr);
mm=sf_floatalloc2(nz, nx);
p0=sf_floatalloc2(padnz, padnx);
p1=sf_floatalloc2(padnz, padnx);
p2=sf_floatalloc2(padnz, padnx);
term=sf_floatalloc2(padnz, padnx);
rr=sf_floatalloc(padnzx);
wave=sf_floatalloc3(nz, nx, wnt);
/* padding and convert vector to 2-d array */
pad2d(array->vv, vv, nz, nx, nb);
memset(mm[0], 0., nzx*sizeof(float));
for(is=mpipar->cpuid; is<acpar->ns; is+=mpipar->numprocs){
sf_warning("###### is=%d ######", is+1);
memset(p0[0], 0., padnzx*sizeof(float));
memset(p1[0], 0., padnzx*sizeof(float));
memset(p2[0], 0., padnzx*sizeof(float));
sx=acpar->s0_v+is*acpar->ds_v;
source_map(sx, sz, frectx, frectz, padnx, padnz, padnzx, rr);
wit=0;
/* forward propagation */
for(it=0; it<nt; it++){
if(verb) sf_warning("Forward propagation is=%d; it=%d;", is+1, it);
/* save wavefield */
if(it%acpar->interval==0){
#ifdef _OPENMP
#pragma omp parallel for \
private(ix,iz) \
shared(wave,p1,wit,nb,nx,nz)
#endif
for(ix=0; ix<nx; ix++)
for(iz=0; iz<nz; iz++)
wave[wit][ix][iz]=p1[ix+nb][iz+nb];
wit++;
}
//if(is==acpar->ns/2 && it%50==0) sf_floatwrite(p1[0],padnzx, Fwfl1);
/* laplacian operator */
laplace(p1, term, padnx, padnz, dx2, dz2);
/* load source */
#ifdef _OPENMP
#pragma omp parallel for \
private(ix,iz) \
shared(term,rr,padnx,padnz,it)
#endif
for(ix=0; ix<padnx; ix++){
for(iz=0; iz<padnz; iz++){
term[ix][iz] += rr[ix*padnz+iz]*array->ww[it];
}
}
/* update */
#ifdef _OPENMP
#pragma omp parallel for \
private(ix,iz) \
shared(p0,p1,p2,vv,term,padnx,padnz,dt2)
#endif
for(ix=4; ix<padnx-4; ix++){
for(iz=4; iz<padnz-4; iz++){
p2[ix][iz]=2*p1[ix][iz]-p0[ix][iz]+vv[ix][iz]*vv[ix][iz]*dt2*term[ix][iz];
}
}
/* swap wavefield pointer of different time steps */
tmparray=p0; p0=p1; p1=p2; p2=tmparray;
/* boundary condition */
apply_sponge(p0, acpar->bc, padnx, padnz, nb);
apply_sponge(p1, acpar->bc, padnx, padnz, nb);
} // end of time loop
/* check */
if(wit != wnt) sf_error("Incorrect number of wavefield snapshots");
wit--;
/* read data */
sf_seek(Fdat, is*nr*nt*sizeof(float), SEEK_SET);
sf_floatread(dd[0], nr*nt, Fdat);
/* initialization */
memset(p0[0], 0., padnzx*sizeof(float));
memset(p1[0], 0., padnzx*sizeof(float));
memset(p2[0], 0., padnzx*sizeof(float));
memset(term[0], 0., padnzx*sizeof(float));
/* backward propagation */
for(it=nt-1; it>=0; it--){
if(verb) sf_warning("Backward propagation is=%d; it=%d;", is+1, it);
/* laplacian operator */
laplace(p1, term, padnx, padnz, dx2, dz2);
/* load data */
for(ir=0; ir<acpar->nr2[is]; ir++){
rx=acpar->r0_v[is]+ir*acpar->dr_v;
term[rx][rz] += dd[acpar->r02[is]+ir][it];
}
/* update */
#ifdef _OPENMP
#pragma omp parallel for \
private(ix,iz) \
shared(p0,p1,p2,vv,term,padnx,padnz,dt2)
#endif
for(ix=4; ix<padnx-4; ix++){
for(iz=4; iz<padnz-4; iz++){
p2[ix][iz]=2*p1[ix][iz]-p0[ix][iz]+vv[ix][iz]*vv[ix][iz]*dt2*term[ix][iz];
}
}
//if(is==acpar->ns/2 && it%50==0) sf_floatwrite(p1[0],padnzx, Fwfl2);
/* calculate image */
if(it%acpar->interval==0){
#ifdef _OPENMP
#pragma omp parallel for \
private(ix,iz) \
shared(p1,wave,nx,nz,wit,mm,nb)
#endif
for(ix=0; ix<nx; ix++)
for(iz=0; iz<nz; iz++)
mm[ix][iz] += wave[wit][ix][iz]*p1[ix+nb][iz+nb];
wit--;
}
/* swap wavefield pointer of different time steps */
tmparray=p0; p0=p1; p1=p2; p2=tmparray;
/* boundary condition */
apply_sponge(p0, acpar->bc, padnx, padnz, nb);
apply_sponge(p1, acpar->bc, padnx, padnz, nb);
} // end of time loop
}// end of shot loop
MPI_Barrier(comm);
//sf_fileclose(Fwfl1);
//sf_fileclose(Fwfl2);
if(mpipar->cpuid==0){
sendbuf=MPI_IN_PLACE;
recvbuf=mm[0];
}else{
sendbuf=mm[0];
recvbuf=NULL;
}
MPI_Reduce(sendbuf, recvbuf, nzx, MPI_FLOAT, MPI_SUM, 0, comm);
if(mpipar->cpuid==0) sf_floatwrite(mm[0], nzx, Fimg);
MPI_Barrier(comm);
/* release allocated memory */
free(*p0); free(p0); free(*p1); free(p1);
free(*p2); free(p2); free(*vv); free(vv);
free(*dd); free(dd); free(*mm); free(mm);
free(rr); free(*term); free(term);
free(**wave); free(*wave); free(wave);
}
void rtm_q(sf_file Fdat, sf_file Fimg, sf_mpi *mpipar, sf_sou soupar, sf_acqui acpar, sf_vec_q array, bool verb)
/*< visco-acoustic rtm >*/
{
int ix, iz, is, ir, it, wit;
int sx, rx, sz, rz, frectx, frectz;
int nz, nx, nzx, padnz, padnx, padnzx, nt, nr, nb, wnt;
float dx2, dz2, dt2, dt;
float **vv, **tau, **taus, **dd, **mm;
float **p0, **p1, **p2, **r1, **r2, **term, **tmparray, *rr, ***wave;
float *sendbuf, *recvbuf;
MPI_Comm comm=MPI_COMM_WORLD;
nz=acpar->nz;
nx=acpar->nx;
nzx=nz*nx;
padnz=acpar->padnz;
padnx=acpar->padnx;
padnzx=padnz*padnx;
nr=acpar->nr;
nb=acpar->nb;
sz=acpar->sz;
rz=acpar->rz;
frectx=soupar->frectx;
frectz=soupar->frectz;
nt=acpar->nt;
wnt=(nt-1)/acpar->interval+1;
dx2=acpar->dx*acpar->dx;
dz2=acpar->dz*acpar->dz;
dt2=acpar->dt*acpar->dt;
dt=acpar->dt;
/* memory allocation */
vv = sf_floatalloc2(padnz, padnx);
tau= sf_floatalloc2(padnz, padnx);
taus=sf_floatalloc2(padnz, padnx);
dd=sf_floatalloc2(nt, nr);
mm=sf_floatalloc2(nz, nx);
p0=sf_floatalloc2(padnz, padnx);
p1=sf_floatalloc2(padnz, padnx);
p2=sf_floatalloc2(padnz, padnx);
r1=sf_floatalloc2(padnz, padnx);
r2=sf_floatalloc2(padnz, padnx);
term=sf_floatalloc2(padnz, padnx);
rr=sf_floatalloc(padnzx);
wave=sf_floatalloc3(nz, nx, wnt);
/* padding and convert vector to 2-d array */
pad2d(array->vv, vv, nz, nx, nb);
pad2d(array->tau, tau, nz, nx, nb);
pad2d(array->taus, taus, nz, nx, nb);
memset(mm[0], 0., nzx*sizeof(float));
for(is=mpipar->cpuid; is<acpar->ns; is+=mpipar->numprocs){
sf_warning("###### is=%d ######", is+1);
memset(p0[0], 0., padnzx*sizeof(float));
memset(p1[0], 0., padnzx*sizeof(float));
memset(p2[0], 0., padnzx*sizeof(float));
memset(r1[0], 0., padnzx*sizeof(float));
memset(r2[0], 0., padnzx*sizeof(float));
memset(term[0], 0., padnzx*sizeof(float));
sx=acpar->s0_v+is*acpar->ds_v;
source_map(sx, sz, frectx, frectz, padnx, padnz, padnzx, rr);
wit=0;
/* forward propagation */
for(it=0; it<nt; it++){
if(verb) sf_warning("Forward propagation is=%d; it=%d;", is+1, it);
/* save wavefield */
if(it%acpar->interval==0){
for(ix=0; ix<nx; ix++)
for(iz=0; iz<nz; iz++)
wave[wit][ix][iz]=p1[ix+nb][iz+nb];
wit++;
}
/* load source */
for(ix=0; ix<padnx; ix++){
for(iz=0; iz<padnz; iz++){
p1[ix][iz] += rr[ix*padnz+iz]*array->ww[it];
}
}
/* laplacian operator */
laplace(p1, term, padnx, padnz, dx2, dz2);
/* update */
for(ix=4; ix<padnx-4; ix++){
for(iz=4; iz<padnz-4; iz++){
r2[ix][iz]=
(-tau[ix][iz]/taus[ix][iz]*term[ix][iz]
+ (1./dt-0.5/taus[ix][iz])*r1[ix][iz])
/(1./dt+0.5/taus[ix][iz]);
term[ix][iz]=term[ix][iz]*(1.+tau[ix][iz])+(r2[ix][iz]+r1[ix][iz])*0.5;
p2[ix][iz]=2*p1[ix][iz]-p0[ix][iz]+vv[ix][iz]*vv[ix][iz]*dt2*term[ix][iz];
}
}
/* swap wavefield pointer of different time steps */
tmparray=p0; p0=p1; p1=p2; p2=tmparray;
tmparray=r1; r1=r2; r2=tmparray;
/* boundary condition */
apply_sponge(p0, acpar->bc, padnx, padnz, nb);
apply_sponge(p1, acpar->bc, padnx, padnz, nb);
apply_sponge(r1, acpar->bc, padnx, padnz, nb);
} // end of time loop
/* check */
if(wit != wnt) sf_error("Incorrect number of wavefield snapshots");
/* read data */
sf_seek(Fdat, is*nr*nt*sizeof(float), SEEK_SET);
sf_floatread(dd[0], nr*nt, Fdat);
/* initialization */
memset(p0[0], 0., padnzx*sizeof(float));
memset(p1[0], 0., padnzx*sizeof(float));
memset(p2[0], 0., padnzx*sizeof(float));
memset(r1[0], 0., padnzx*sizeof(float));
memset(r2[0], 0., padnzx*sizeof(float));
memset(term[0], 0., padnzx*sizeof(float));
/* backward propagation */
for(it=nt-1; it>=0; it--){
if(verb) sf_warning("Backward propagation is=%d; it=%d;", is+1, it);
/* load data */
for(ir=0; ir<acpar->nr2[is]; ir++){
rx=acpar->r0_v[is]+ir*acpar->dr_v;
p1[rx][rz]=dd[acpar->r02[is]+ir][it];
}
/* laplacian operator */
laplace(p1, term, padnx, padnz, dx2, dz2);
/* update */
for(ix=4; ix<padnx-4; ix++){
for(iz=4; iz<padnz-4; iz++){
r2[ix][iz]=
(-tau[ix][iz]/taus[ix][iz]*term[ix][iz]
+ (1./dt-0.5/taus[ix][iz])*r1[ix][iz])
/(1./dt+0.5/taus[ix][iz]);
term[ix][iz]=term[ix][iz]*(1.+tau[ix][iz])+(r2[ix][iz]+r1[ix][iz])*0.5;
p2[ix][iz]=2*p1[ix][iz]-p0[ix][iz]+vv[ix][iz]*vv[ix][iz]*dt2*term[ix][iz];
}
}
/* calculate image */
if(it%acpar->interval==0){
for(ix=0; ix<nx; ix++)
for(iz=0; iz<nz; iz++)
mm[ix][iz] += wave[wit-1][ix][iz]*p2[ix+nb][iz+nb];
wit--;
}
/* swap wavefield pointer of different time steps */
tmparray=p0; p0=p1; p1=p2; p2=tmparray;
tmparray=r1; r1=r2; r2=tmparray;
/* boundary condition */
apply_sponge(p0, acpar->bc, padnx, padnz, nb);
apply_sponge(p1, acpar->bc, padnx, padnz, nb);
apply_sponge(r1, acpar->bc, padnx, padnz, nb);
} // end of time loop
}// end of shot loop
MPI_Barrier(comm);
if(mpipar->cpuid==0){
sendbuf=MPI_IN_PLACE;
recvbuf=mm[0];
}else{
sendbuf=mm[0];
recvbuf=NULL;
}
MPI_Reduce(sendbuf, recvbuf, nzx, MPI_FLOAT, MPI_SUM, 0, comm);
if(mpipar->cpuid==0) sf_floatwrite(mm[0], nzx, Fimg);
MPI_Barrier(comm);
}
void prtm2d_lop(bool adj, bool add, int nm, int nd, float *mod, float *dat)
/*< prtm2d linear operator >*/
{
int i1,i2,it,is,ig, gx, gz;
if(nm!=nx*nz) sf_error("model size mismatch: %d!=%d",nm, nx*nz);
if(nd!=nt*ng*ns) sf_error("data size mismatch: %d!=%d",nd,nt*ng*ns);
sf_adjnull(adj, add, nm, nd, mod, dat);
for(is=0; is<ns; is++) {/* it may be parallized using MPI */
/* initialize is-th source wavefield Ps[] */
memset(sp0[0], 0, nzpad*nxpad*sizeof(float));
memset(sp1[0], 0, nzpad*nxpad*sizeof(float));
if (csdgather){
gxbeg=sxbeg+is*jsx-distx;
sg_init(gxz, gzbeg, gxbeg, jgz, jgx, ng);
}
if(adj){/* migration: mm=Lt dd */
for(it=0; it<nt; it++){
add_source(&sxz[is], sp1, 1, &wlt[it], true);
step_forward(sp0, sp1, vv, false);
apply_sponge(sp0);
apply_sponge(sp1);
ptr=sp0; sp0=sp1; sp1=ptr;
boundary_rw(sp0, &rwbndr[it*4*(nx+nz)], false);
}
memset(gp0[0], 0, nzpad*nxpad*sizeof(float));
memset(gp1[0], 0, nzpad*nxpad*sizeof(float));
for (it=nt-1; it >-1; it--) {
/* reverse time order, Img[]+=Ps[]* Pg[]; */
if(verb) sf_warning("%d;",it);
/* reconstruct source wavefield Ps[] */
boundary_rw(sp0, &rwbndr[it*4*(nx+nz)], true);
ptr=sp0; sp0=sp1; sp1=ptr;
step_forward(sp0, sp1, vv, false);
add_source(&sxz[is], sp1, 1, &wlt[it], false);
/* backpropagate receiver wavefield */
for(ig=0;ig<ng; ig++){
gx=gxz[ig]/nz;
gz=gxz[ig]%nz;
gp1[gx+nb][gz+nb]+=dat[it+ig*nt+is*nt*ng];
}
step_forward(gp0, gp1, vv, false);
apply_sponge(gp0);
apply_sponge(gp1);
ptr=gp0; gp0=gp1; gp1=ptr;
for(i2=0; i2<nx; i2++)
for(i1=0; i1<nz; i1++)
mod[i1+nz*i2]+=sp0[i2+nb][i1+nb]*gp1[i2+nb][i1+nb];
}
}else{/* Born modeling/demigration: dd=L mm */
for(it=0; it<nt; it++){
/* forward time order, Pg[]+=Ps[]* Img[]; */
if(verb) sf_warning("%d;",it);
for(i2=0; i2<nx; i2++)
for(i1=0; i1<nz; i1++)
gp1[i2+nb][i1+nb]+=sp0[i2+nb][i1+nb]*mod[i1+nz*i2];
ptr=gp0; gp0=gp1; gp1=ptr;
apply_sponge(gp0);
apply_sponge(gp1);
step_forward(gp0, gp1, vv, true);
for(ig=0;ig<ng; ig++){
gx=gxz[ig]/nz;
gz=gxz[ig]%nz;
dat[it+ig*nt+is*nt*ng]+=gp1[gx+nb][gz+nb];
}
add_source(&sxz[is], sp1, 1, &wlt[it], true);
step_forward(sp0, sp1, vv, false);
apply_sponge(sp0);
apply_sponge(sp1);
ptr=sp0; sp0=sp1; sp1=ptr;
}
}
}
}
//JS
//static int counter=0;
void gradient_pas_av(float *x, float *fcost, float *grad)
/*< acoustic velocity gradient >*/
{
int ix, iz, is, ir, it, wit, iturn;
int rx;
float temp, dmax;
float **p0, **p1, **p2, **term, **tmparray, ***wave, **pp;
float *sendbuf, *recvbuf;
/*
//JS
sf_file Fwfl1, Fwfl2, Fres;
counter++;
if (cpuid==0 && counter==3) {
Fwfl1=sf_output("Fwfl1");
Fwfl2=sf_output("Fwfl2");
Fres=sf_output("Fres");
sf_putint(Fwfl1,"n1",padnz);
sf_putint(Fwfl1,"n2",padnx);
sf_putint(Fwfl1,"n3",(nt-1)/50+1);
sf_putint(Fwfl2,"n1",padnz);
sf_putint(Fwfl2,"n2",padnx);
sf_putint(Fwfl2,"n3",(nt-1)/50+1);
sf_putint(Fres,"n1",nt);
sf_putint(Fres,"n2",nr);
}
*/
/* initialize fcost */
*fcost=0.;
/* update velocity */
pad2d(x, vv, nz, nx, nb);
/* initialize gradient */
memset(grad, 0., nzx*sizeof(float));
/* memory allocation */
p0=sf_floatalloc2(padnz, padnx);
p1=sf_floatalloc2(padnz, padnx);
p2=sf_floatalloc2(padnz, padnx);
term=sf_floatalloc2(padnz, padnx);
wave=sf_floatalloc3(nz, nx, wnt);
pp=sf_floatalloc2(nt, nr);
iturn=0;
for(is=cpuid; is<ns; is+=numprocs){
if(cpuid==0) sf_warning("###### is=%d ######", is+1);
memset(p0[0], 0., padnzx*sizeof(float));
memset(p1[0], 0., padnzx*sizeof(float));
memset(p2[0], 0., padnzx*sizeof(float));
memset(pp[0], 0., nr*nt*sizeof(float));
wit=0;
/* forward propagation */
for(it=0; it<nt; it++){
if(verb) sf_warning("Forward propagation it=%d;", it);
/* output predicted data */
for(ir=0; ir<nr; ir++){
rx=r0_v[0]+ir*dr_v;
pp[ir][it]=p1[rx][rz];
}
/* save wavefield */
if(it%interval==0){
#ifdef _OPENMP
#pragma omp parallel for \
private(ix,iz) \
shared(wave,p1,wit,nb,nx,nz)
#endif
for(ix=0; ix<nx; ix++)
for(iz=0; iz<nz; iz++)
wave[wit][ix][iz]=p1[ix+nb][iz+nb];
wit++;
}
/*
//JS
if(is==0 && counter==3 && it%50==0) sf_floatwrite(p1[0],padnzx,Fwfl1);
*/
/* laplacian operator */
laplace(p1, term, padnx, padnz, dx2, dz2);
/* load source */
#ifdef _OPENMP
#pragma omp parallel for \
private(ix,iz) \
shared(term,nb,ww3,it)
#endif
for(ix=0; ix<nx; ix++){
for(iz=0; iz<nz; iz++){
term[ix+nb][iz+nb] += ww3[iturn][it][ix][iz];
}
}
/* update */
#ifdef _OPENMP
#pragma omp parallel for \
private(ix,iz) \
shared(p0,p1,p2,vv,term,padnx,padnz,dt2)
#endif
for(ix=4; ix<padnx-4; ix++){
for(iz=4; iz<padnz-4; iz++){
p2[ix][iz]=2*p1[ix][iz]-p0[ix][iz]+vv[ix][iz]*vv[ix][iz]*dt2*term[ix][iz];
}
}
/* swap wavefield pointer of different time steps */
tmparray=p0; p0=p1; p1=p2; p2=tmparray;
/* boundary condition */
apply_sponge(p0, bc, padnx, padnz, nb);
apply_sponge(p1, bc, padnx, padnz, nb);
} // end of time loop
/* check */
if(wit != wnt) sf_error("Incorrect number of wavefield snapshots");
wit--;
/* calculate data residual and data misfit */
for(ir=0; ir<nr; ir++){
for(it=0; it<nt; it++){
pp[ir][it]=dd[iturn][ir][it]-pp[ir][it];
*fcost += 0.5*pp[ir][it]*pp[ir][it];
}
}
/* window the data residual */
for(ir=0; ir<nr; ir++){
/* multiscale */
if(NULL != blo){
sf_butter_apply(blo, nt, pp[ir]);
sf_reverse(nt, pp[ir]);
sf_butter_apply(blo, nt, pp[ir]);
sf_reverse(nt, pp[ir]);
}
if(NULL != bhi){
sf_butter_apply(bhi, nt, pp[ir]);
sf_reverse(nt, pp[ir]);
sf_butter_apply(bhi, nt, pp[ir]);
sf_reverse(nt, pp[ir]);
}
for(it=0; it<nt; it++){
pp[ir][it] *= weight[ir][it];
}
}
/*
// JS
if(is==0 && counter==3) sf_floatwrite(pp[0], nr*nt, Fres);
*/
/* initialization */
memset(p0[0], 0., padnzx*sizeof(float));
memset(p1[0], 0., padnzx*sizeof(float));
memset(p2[0], 0., padnzx*sizeof(float));
memset(term[0], 0., padnzx*sizeof(float));
/* backward propagation */
for(it=nt-1; it>=0; it--){
if(verb) sf_warning("Backward propagation it=%d;", it);
/* laplacian operator */
laplace(p1, term, padnx, padnz, dx2, dz2);
/* load data residual*/
for(ir=0; ir<nr; ir++){
rx=r0_v[0]+ir*dr_v;
term[rx][rz] += pp[ir][it];
}
/* update */
#ifdef _OPENMP
#pragma omp parallel for \
private(ix,iz) \
shared(p0,p1,p2,vv,term,padnx,padnz,dt2)
#endif
for(ix=4; ix<padnx-4; ix++){
for(iz=4; iz<padnz-4; iz++){
p2[ix][iz]=2*p1[ix][iz]-p0[ix][iz]+vv[ix][iz]*vv[ix][iz]*dt2*term[ix][iz];
}
}
/*
// JS
if(is==0 && counter==3 && it%50==0) sf_floatwrite(p1[0],padnzx,Fwfl2);
*/
/* calculate gradient */
if(it%interval==0){
if(wit != wnt-1 && wit != 0){ // avoid the first and last time step
#ifdef _OPENMP
#pragma omp parallel for \
private(ix,iz,temp) \
shared(nx,nz,vv,wave,p1,wit,wdt2,grad)
#endif
for(ix=0; ix<nx; ix++){
for(iz=0; iz<nz; iz++){
temp=vv[ix+nb][iz+nb];
temp=temp*temp*temp;
temp=-2./temp;
grad[ix*nz+iz] += gwt[iturn][it][ix][iz]*(wave[wit+1][ix][iz]-2.*wave[wit][ix][iz]+wave[wit-1][ix][iz])/wdt2*p1[ix+nb][iz+nb]*temp;
}
}
}
wit--;
}
/* swap wavefield pointer of different time steps */
tmparray=p0; p0=p1; p1=p2; p2=tmparray;
/* boundary condition */
apply_sponge(p0, bc, padnx, padnz, nb);
apply_sponge(p1, bc, padnx, padnz, nb);
} // end of time loop
iturn++;
/*
// JS
if(is==0 && counter==3){
sf_fileclose(Fwfl1);
sf_fileclose(Fwfl2);
sf_fileclose(Fres);
}
sf_warning("---counter=%d fcost=%3.3e---",counter, *fcost);
*/
} // end of shot loop
MPI_Barrier(comm);
/* misfit reduction */
if(cpuid==0){
sendbuf=MPI_IN_PLACE;
recvbuf=fcost;
}else{
sendbuf=fcost;
recvbuf=NULL;
}
MPI_Reduce(sendbuf, recvbuf, 1, MPI_FLOAT, MPI_SUM, 0, comm);
MPI_Bcast(fcost, 1, MPI_FLOAT, 0, comm);
/* gradient reduction */
if(cpuid==0){
sendbuf=MPI_IN_PLACE;
recvbuf=grad;
}else{
sendbuf=grad;
recvbuf=NULL;
}
MPI_Reduce(sendbuf, recvbuf, nzx, MPI_FLOAT, MPI_SUM, 0, comm);
MPI_Bcast(grad, nzx, MPI_FLOAT, 0, comm);
/* scaling gradient */
if(first){
dmax=0.;
for(ix=0; ix<nzx; ix++)
if(fabsf(grad[ix])>dmax)
dmax=fabsf(grad[ix]);
scaling=0.1/dmax;
first=false;
}
/* smooth gradient */
gradient_smooth2b(grectx, grectz, nx, nz, waterz, waterzb, scaling, grad);
/* free allocated memory */
free(*p0); free(p0); free(*p1); free(p1);
free(*p2); free(p2); free(*pp); free(pp);
free(**wave); free(*wave); free(wave);
free(*term); free(term);
}
void step_fields(int iyear, int itts, int imon, int iterno) {
int i, j, k, l, m;
int mdt;
double inv_mdt;
int ibiodt;
//DT
double Tmptr[NXMEM][NYMEM];
int n;
double secperyr = 365.25 * 60 * 60 * 24;
//DT
/*-----------------------------------------
*
* PARAMETER VALUES
*
*-----------------------------------------*/
/*-----------------------------------------
*
* SCREEN PRINT CONTROL
*
*-----------------------------------------*/
doprint = 0;
pquant[1] = 0; /* print mass conservation checks? (1 = yes) */
pquant[2] = 1; /* print single grid point at each step? (1 = yes) */
pquant[3] = 1; /* print negative concentrations? */
/* pq3=1 => print warning */
/* pq3=0 => set concentration to trwarn */
/* pq3=2 => do both */
/* pq3=3 => do nothing */
/*-----------------------------------------
*
* CALCULATE PRELIMINARY QUANTITIES
*
*-----------------------------------------*/
// z_depth(h, depth);
/*-----------------------------------------
*
* PRINT TO SCREEN #1
*
*-----------------------------------------*/
pstage = 1;
// print_to_screen(pquant, pstage);
/*-----------------------------------------
*
* STEP 1: PHYSICAL TRANSPORT
*
*-----------------------------------------*/
printf("Calculate tracer transport. \n");
tracer(itts); /* perform transport time step */
#ifdef MERGED_ML
merge_ml_tr();
#endif
/*-----------------------------------------
*
* PRINT TO SCREEN #2
*
*-----------------------------------------*/
pstage = 2;
// print_to_screen(pquant, pstage);
/*-----------------------------------------
*
* STEP 2: BIOTIC SOURCE/SINK TERMS
*
*-----------------------------------------*/
/*-----------------------------------------
*
* CALCULATE BIOTIC SOURCE/SINK TERMS
* based on OCMIP scheme in which
* biological pump is linked to PO4
*
*-----------------------------------------*/
#if defined(PHOSPHATE) && defined(OXYGEN)
ibiodt = 1; // number of biotic time steps per transport time step (dt)
// Update phosphate concentration for surface value restoration
read_woa_file(imon, hstart, po4_star_lay, "woa09.phos.nc", "p_an",1e-3);
/*
set_fix_darray3d_zero(jo2,NZ);
set_fix_darray3d_zero(jdop,NZ);
set_fix_darray3d_zero(jpo4,NZ);
set_fix_darray3d_zero(jprod,NZ);
set_fix_darray3d_zero(jremin,NZ);
set_fix_darray3d_zero(jremdop,NZ);
set_fix_darray2d_zero(flux_pop);
*/
printf("Calculating biotic sources/sinks\n");
biotic_sms(ibiodt);
merge_ml_tr();
merge_ml_j();
apply_oxygen_jterms();
apply_phosphate_jterms();
surface_oxygen();
#endif
/*-----------------------------------------
*
* APPLY BIOTIC SOURCE/SINK TERMS
* step tr array forward using Euler method
* calculate global integral for mass conservation checking
*
*-----------------------------------------*/
for (i = 0; i <= NXMEM - 1; i++) {
for (j = 0; j <= NYMEM - 1; j++) {
//BX - reinstated by HF
if (D[i][j] > MINIMUM_DEPTH) {
for (k = 0; k < NZ; k++) {
}
//BX - reinstated by HF
} else {
for (k = 0; k < NZ; k++) {
#ifdef AGE
tr[mAGE][k][i][j] = misval;
#endif
}
}
}
}
#ifdef AGE
for (i = 0; i <= NXMEM - 1; i++) {
for (j = 0; j <= NYMEM - 1; j++) {
if (D[i][j] > MINIMUM_DEPTH) {
tr[mAGE][0][i][j] = 0.0;
for (k = 1; k < NZ; k++) {
tr[mAGE][k][i][j] += dt;
}
}
}
}
#endif
#ifdef MERGED_ML
merge_ml_tr();
#endif
/*-----------------------------------------
*
* OVERWRITE RESULTS IN SPECIAL CASES
*
*-----------------------------------------*/
/*-----------------------------------------
*
* Sponges and Re-Entrant Boundaries
*
*-----------------------------------------*/
#ifdef SPONGE
apply_sponge(h, dt, ea, eb);
#endif
/* undo effect of oxygen sponge on delo18 */
/* reset tr[mo18] to maintain old delo18 */
/* zonal, meridional re-entrance */
for (m = 0; m < NTR; m++) {
for (k = 0; k < NZ; k++) {
for (j = 0; j <= NYMEM - 1; j++) {
tr[m][k][0][j] = tr[m][k][nx - 1][j];
tr[m][k][1][j] = tr[m][k][nx][j];
tr[m][k][nx + 1][j] = tr[m][k][2][j];
tr[m][k][nx + 2][j] = tr[m][k][3][j];
}
}
for (i = 2; i <= nx; i++) {
ii = 363 - i;
for (k = 0; k < NZ; k++) {
tr[m][k][ii][ny + 1] = tr[m][k][i][ny];
tr[m][k][ii][ny + 2] = tr[m][k][i][ny - 1];
}
}
}
/*-----------------------------------------
*
* PRINT TO SCREEN #3
*
*-----------------------------------------*/
pstage = 3;
// print_to_screen(pquant, pstage);
/*-----------------------------------------
*
* store new tr array into named arrays for output
*
*-----------------------------------------*/
for (k = 0; k < NZ; k++) {
for (i = 0; i <= NXMEM - 1; i++) {
for (j = 0; j <= NYMEM - 1; j++) {
#ifdef AGE
age[k][i][j] = tr[mAGE][k][i][j] / (365.0 * 86400.0); /*years*/
#endif
}
}
}
} /* end time step */
