Example #1
0
int
main(int argc, char** argv)
{

    bool verb, fsrf, snap, expl, dabc, cden, adj;
    bool optfd, hybrid, sinc; 
    int jsnap, jdata;

    /* I/O files */
    sf_file file_wav=NULL; /* wavelet */
    sf_file file_vel=NULL; /* velocity */
    sf_file file_den=NULL; /* density */
    sf_file file_wfl=NULL; /* wavefield */
    sf_file file_dat=NULL; /* data */
    sf_file file_src=NULL; /* sources */
    sf_file file_rec=NULL; /* receivers */

    /* cube axes */
    sf_axis at = NULL, az = NULL, ax = NULL, ay = NULL;
    sf_axis as = NULL, ar = NULL;

    int nbd;  /* ABC boundary size */
    int fdorder;  /* finite difference spatial accuracy order */
    int nzpad,nxpad,nypad; /* boundary padded model size */
    int ix,iy,it,is,nx,ny,nz,nt,ns,nr;
    float dx,dy,dz,dt,dt2;
    float* damp=NULL; /* damping profile for hybrid bc */
    float* ws;  /* wavelet */
    float*** vel=NULL;  /* velocity */
    float*** rho=NULL; /* density */
    float*** u0=NULL;  /* wavefield array u@t-1 (u@t+1) */
    float*** u1=NULL;  /* wavefield array u@t */
    float* u_dat=NULL; /* output data */
    float*** ptr_tmp=NULL;   
    pt3d* src3d=NULL;  /* source position */
    pt3d* rec3d=NULL;  /*receiver position*/
    scoef3d cssinc = NULL, crsinc = NULL; 
    lint3d cslint = NULL, crlint = NULL;

    /* FDM structure */
    fdm3d fdm = NULL;
    abcone3d abc = NULL;
    sponge spo = NULL;

    int nbell;

    float* fdcoef_d2;
    float* fdcoef_d1;

    sf_axis acz = NULL, acx = NULL, acy = NULL;
    int nqz, nqx, nqy;
    float oqz, oqx, oqy, dqz, dqx, dqy;

    float** oslice = NULL; /* output 3D wavefield slice-by-slice */
    float*** tmp_array;

    double wall_clock_time_s, wall_clock_time_e;

    const int SECOND_DERIV = 2;
    const int FIRST_DERIV = 1;

    int nop;

#if defined _OPENMP && _DEBUG
    double tic;
    double toc;
#endif

    /* init RSF */
    sf_init(argc,argv);

#ifdef _OPENMP
    omp_init();
    wall_clock_time_s = omp_get_wtime();
#else
    wall_clock_time_s = (double) clock() / CLOCKS_PER_SEC;
#endif

    if (!sf_getbool("verb",&verb))  verb=false; /* Verbosity flag */
    if (!sf_getbool("snap",&snap))  snap=false; /* Wavefield snapshots flag */
    if (!sf_getbool("expl",&expl))  expl=false; /* Multiple sources, one wvlt*/
    if (!sf_getbool("dabc",&dabc))  dabc=false; /* Absorbing BC */
    if (!sf_getbool("cden",&cden))  cden=false; /* Constant density */
    if (!sf_getbool("adj",&adj))    adj=false; /* adjoint flag */

    if (!sf_getbool("free",&fsrf) && !sf_getbool("fsrf",&fsrf)) fsrf=false; /* Free surface flag */

    if (!sf_getint("nbell",&nbell)) nbell=5; /* gaussian for source injection */

    if (!sf_getbool("optfd",&optfd))  optfd=false; /* optimized FD coefficients flag */
    if (!sf_getint("fdorder",&fdorder))  fdorder=4; /* spatial FD order */
    if (!sf_getbool("hybridbc",&hybrid))  hybrid=false;  /* hybrid Absorbing BC */
    if (!sf_getbool("sinc",&sinc)) sinc=false; /* sinc source injection */
  
    /* Initialize variables */
    file_wav = sf_input("in"); /* wavelet */
    file_vel = sf_input("vel"); /* velocity */ 
    file_src = sf_input("sou"); /* sources */
    file_rec = sf_input("rec"); /* receivers */
    file_dat = sf_output("out"); /* data */

    if (snap)  file_wfl = sf_output("wfl"); /* wavefield */
    if (!cden) {
	if (sf_getstring("cden")) {
	    file_den = sf_input ("den"); /* density */
	} else {
	    cden = true;
	    if (verb) sf_warning("No density file provided, running with constant density");
	}
    }
  
    at = sf_iaxa(file_wav,2); sf_setlabel(at,"t"); if(verb) sf_raxa(at); /* time */
    az = sf_iaxa(file_vel,1); sf_setlabel(az,"z"); if(verb) sf_raxa(az); /* depth */
    ax = sf_iaxa(file_vel,2); sf_setlabel(ax,"x"); if(verb) sf_raxa(ax); /* space */
    ay = sf_iaxa(file_vel,3); sf_setlabel(ay,"y"); if(verb) sf_raxa(ay); /* space */

    as = sf_iaxa(file_src,2); sf_setlabel(as,"s"); if(verb) sf_raxa(as); /* sources */
    ar = sf_iaxa(file_rec,2); sf_setlabel(ar,"r"); if(verb) sf_raxa(ar); /* receivers */

    nt = sf_n(at); dt = sf_d(at); 
    nz = sf_n(az); dz = sf_d(az); 
    nx = sf_n(ax); dx = sf_d(ax); 
    ny = sf_n(ay); dy = sf_d(ay); 
    ns = sf_n(as);
    nr = sf_n(ar);

    /* other execution parameters */
    if (snap) {
	if (!sf_getint("jsnap",&jsnap))  jsnap=nt;
	/* # of t steps at which to save wavefield */
    }
    if (!sf_getint("jdata",&jdata)) jdata=1;
    /* # of t steps at which to save receiver data */

    /* setup output data header */
    sf_oaxa(file_dat,ar,1);
    sf_setn(at,(nt-1)/jdata+1);
    sf_setd(at,dt*jdata);
    sf_oaxa(file_dat,at,2);

    /* wavefield cut params */
    /* setup output wavefield header */
    if (snap) {
	if (!sf_getint  ("nqz",&nqz)) nqz=sf_n(az); /* Saved wfld window nz */
	if (!sf_getint  ("nqx",&nqx)) nqx=sf_n(ax); /* Saved wfld window nx */
	if (!sf_getint  ("nqy",&nqy)) nqy=sf_n(ay); /* Saved wfld window ny */

	if (!sf_getfloat("oqz",&oqz)) oqz=sf_o(az); /* Saved wfld window oz */
	if (!sf_getfloat("oqx",&oqx)) oqx=sf_o(ax); /* Saved wfld window ox */
	if (!sf_getfloat("oqy",&oqy)) oqy=sf_o(ay); /* Saved wfld window oy */

	if (!sf_getfloat("dqz",&dqz)) dqz=sf_d(az); /* Saved wfld window dz */
	if (!sf_getfloat("dqx",&dqx)) dqx=sf_d(ax); /* Saved wfld window dx */
	if (!sf_getfloat("dqy",&dqy)) dqy=sf_d(ay); /* Saved wfld window dy */
    
	acz = sf_maxa(nqz,oqz,dqz); if (verb) sf_raxa(acz);
	acx = sf_maxa(nqx,oqx,dqx); if (verb) sf_raxa(acx);
	acy = sf_maxa(nqy,oqy,dqy); if (verb) sf_raxa(acy);
	/* check if the imaging window fits in the wavefield domain */
	sf_setn(at,(nt-1)/jsnap+1);
	sf_setd(at,dt*jsnap);
	if (verb) sf_raxa(at);
    
	sf_oaxa(file_wfl,acz,1);
	sf_oaxa(file_wfl,acx,2);
	sf_oaxa(file_wfl,acy,3);
	sf_oaxa(file_wfl,at,4);
    }

    /* 2-2N finite difference coefficient */
    nop = fdorder/2; /* fd half-length stencil */
    if (!sf_getint("nb",&nbd) || nbd<nop)  nbd=nop;
    if (dabc && hybrid && nbd<=nop) nbd = 2*nop;

    /* expand domain for FD operators and ABC */
    fdm = fdutil3d_init(verb,fsrf,az,ax,ay,nbd,1);

    sf_setn(az,fdm->nzpad); sf_seto(az,fdm->ozpad); if (verb) sf_raxa(az);
    sf_setn(ax,fdm->nxpad); sf_seto(ax,fdm->oxpad); if (verb) sf_raxa(ax);
    sf_setn(ay,fdm->nypad); sf_seto(ay,fdm->oypad); if (verb) sf_raxa(ay);

    /* Precompute coefficients */
    dt2 = dt*dt;
    nzpad = nz+2*nbd;  nxpad = nx+2*nbd;  nypad = ny+2*nbd;

    fdcoef_d2 = compute_fdcoef(nop,dz,dx,dy,optfd,SECOND_DERIV);
    fdcoef_d1 = compute_fdcoef(nop,dz,dx,dy,optfd,FIRST_DERIV);

    /* Allocate memories */
    if (expl) ws = sf_floatalloc(1);
    else      ws = sf_floatalloc(ns);
    vel = sf_floatalloc3(nzpad,nxpad,nypad);
    if (!cden) rho = sf_floatalloc3(nzpad,nxpad,nypad);
    u_dat = sf_floatalloc(nr);
    src3d = pt3dalloc1(ns);
    rec3d = pt3dalloc1(nr);
    if (snap) oslice = sf_floatalloc2(sf_n(acz),sf_n(acx));

    /* source and receiver position */
    pt3dread1(file_src,src3d,ns,3);  /* read format: (x,y,z) */
    if (sinc) cssinc = sinc3d_make(ns,src3d,fdm);
    else      cslint = lint3d_make(ns,src3d,fdm);

    pt3dread1(file_rec,rec3d,nr,3);  /* read format: (x,y,z) */
    if (sinc) crsinc = sinc3d_make(nr,rec3d,fdm);
    else      crlint = lint3d_make(nr,rec3d,fdm);

    if (!sinc) fdbell3d_init(nbell);

    /* temperary array */
    tmp_array = sf_floatalloc3(nz,nx,ny);

    /* read velocity and pad */
    sf_floatread(tmp_array[0][0],nz*nx*ny,file_vel);
    expand3d(tmp_array,vel,fdm);
    /* read density and pad */
    if (!cden) {
	sf_floatread(tmp_array[0][0],nz*nx*ny,file_den);
	expand3d(tmp_array,rho,fdm);
    }

    free(**tmp_array);  free(*tmp_array);  free(tmp_array);

    /* A1 one-way ABC implicit scheme coefficients  */
    if (dabc) {
	abc = abcone3d_make(nbd,dt,vel,fsrf,fdm);
	if (hybrid)
	    damp = damp_make(nbd-nop); /* compute damping profiles for hybrid bc */
	else
	    spo = sponge_make(fdm->nb);
    }

    /* allocate memory for wavefield variables */
    u0 = sf_floatalloc3(nzpad,nxpad,nypad);
    u1 = sf_floatalloc3(nzpad,nxpad,nypad);

    /* initialize variables */
    memset(u0[0][0],0,sizeof(float)*nzpad*nxpad*nypad);
    memset(u1[0][0],0,sizeof(float)*nzpad*nxpad*nypad);
    memset(u_dat,0,sizeof(float)*nr);

    /* v = (v*dt)^2 */
    for (ix=0;ix<nzpad*nxpad*nypad;ix++)
	*(vel[0][0]+ix) *= *(vel[0][0]+ix)*dt2;
    if (fsrf && !hybrid) {
	for (iy=0; iy<nypad; iy++)
	    for (ix=0; ix<nxpad; ix++)
		memset(vel[iy][ix],0,sizeof(float)*fdm->nb);
    }

    for (it=0; it<nt; it++) {
	if (verb)  sf_warning("it=%d;",it+1);
#if defined _OPENMP && _DEBUG
	tic=omp_get_wtime();
#endif
    
	step_forward(u0,u1,vel,rho,fdcoef_d2,fdcoef_d1,nop,nzpad,nxpad,nypad);
    
	if (adj) { /* backward inject source wavelet */
	    if (expl) {
		sf_seek(file_wav,(off_t)(nt-it-1)*sizeof(float),SEEK_SET);
		sf_floatread(ws,1,file_wav);
		ws[0] *= dt2;
		if (sinc) sinc3d_inject1(u0,ws[0],cssinc);
		else      lint3d_inject1(u0,ws[0],cslint);
	    } else { 
		sf_seek(file_wav,(off_t)(nt-it-1)*ns*sizeof(float),SEEK_SET);
		sf_floatread(ws,ns,file_wav);
		for (is=0; is<ns; is++) ws[is] *= dt2;
		if (sinc) sinc3d_inject(u0,ws,cssinc);
		else      lint3d_inject(u0,ws,cslint);
	    }
	} else { /* forward inject source wavelet */
	    if (expl) {
		sf_floatread(ws,1,file_wav);
		ws[0] *= dt2;
		if (sinc) sinc3d_inject1(u0,ws[0],cssinc);
		else      lint3d_inject1(u0,ws[0],cslint);
	    } else {
		sf_floatread(ws,ns,file_wav);
		for (is=0; is<ns; is++) ws[is] *= dt2;
		if (sinc) sinc3d_inject(u0,ws,cssinc);
		else      lint3d_inject(u0,ws,cslint);
	    }
	}

	/* apply abc */
	if (dabc) {
	    if (hybrid) apply_abc(u0,u1,nz,nx,ny,nbd,abc,nop,damp);
	    else {
		abcone3d_apply(u0,u1,nop,abc,fdm);
		sponge3d_apply(u0,spo,fdm);
		sponge3d_apply(u1,spo,fdm);
	    }
	}

	/* loop over pointers */
	ptr_tmp = u0;  u0 = u1;  u1 = ptr_tmp;

	/* extract snapshot */
	if (snap && it%jsnap==0) {
	    int fy = (floor)((sf_o(acy)-fdm->oypad)/fdm->dy);
	    int jy = floor(sf_d(acy)/fdm->dy);
	    float **ptr_slice;
	    for (iy=0; iy<sf_n(acy); iy++) {
		ptr_slice = u0[fy+iy*jy];
		cut3d_slice(ptr_slice,oslice,fdm,acz,acx);
		sf_floatwrite(oslice[0],sf_n(acz)*sf_n(acx),file_wfl);
	    }
	}

	/* extract receiver data */
	if (sinc) sinc3d_extract(u0,u_dat,crsinc);
	else      lint3d_extract(u0,u_dat,crlint);

	sf_floatwrite(u_dat,nr,file_dat);

#if defined _OPENMP && _DEBUG
	toc=omp_get_wtime(); 
	fprintf(stderr,"%5.2gs",(float)(toc-tic));
#endif
    }
#ifdef _OPENMP
    wall_clock_time_e = omp_get_wtime();
#else
    wall_clock_time_e = (double) clock() / CLOCKS_PER_SEC;
#endif
    if (verb)
	fprintf(stderr,"\nElapsed time: %lf s\n",wall_clock_time_e-wall_clock_time_s);

    free(**u0); free(*u0); free(u0);
    free(**u1); free(*u1); free(u1);
    free(**vel); free(*vel); free(vel);
    free(u_dat);
    free(ws);
    free(fdcoef_d2); free(fdcoef_d1);
    if (snap) { free(*oslice); free(oslice); }
    if(!cden) { free(**rho); free(*rho); free(rho); }
    if (hybrid) free(damp);
    free(src3d); free(rec3d);

    return 0;
}
Example #2
0
int main(int argc, char* argv[])
{
    bool verb,fsrf,snap,dabc;
    int  jsnap,ntsnap;
    int  jdata;

    /* I/O files */
    sf_file Fwav=NULL; /* wavelet   */
    sf_file Fsou=NULL; /* sources   */
    sf_file Frec=NULL; /* receivers */

    sf_file Fvel=NULL; /* velocity  */
    sf_file Fref=NULL; /* reflectivity */
    sf_file Fden=NULL; /* density   */

    sf_file Fdat=NULL; /* data (background)      */
    sf_file Fwfl=NULL; /* wavefield (background) */

    sf_file Flid=NULL; /* data (scattered)      */
    sf_file Fliw=NULL; /* wavefield (scattered) */

    /* I/O arrays */
    float  *ww=NULL;           /* wavelet   */
    pt3d   *ss=NULL;           /* sources   */
    pt3d   *rr=NULL;           /* receivers */

    float ***vpin=NULL;         /* velocity  */
    float ***roin=NULL;         /* density   */
    float ***rfin=NULL;         /* reflectivity */

    float ***vp=NULL;           /* velocity     in expanded domain */
    float ***ro=NULL;           /* density      in expanded domain */
    float ***iro=NULL;          /* buoyancy     in the expanded domain */

    float ***rf=NULL;           /* reflectivity in expanded domain */

    float  *bdd=NULL;          /* data (background) */
    float  *sdd=NULL;          /* data (scattered)  */

    float ***vt=NULL;           /* temporary vp*vp * dt*dt */

    float ***fsrfbck=NULL;		/* ghost cells for free surface BC */
    float ***fsrfsct=NULL;		/* ghost cells for free surface BC */

    float ***bum,***buo,***bup,***bua,***buat,***but; /* wavefield: um = U @ t-1; uo = U @ t; up = U @ t+1 */
    float ***sum,***suo,***sup,***sua,***suat,***sut; /* wavefield: um = U @ t-1; uo = U @ t; up = U @ t+1 */

    /* cube axes */
    sf_axis at,a1,a2,a3,as,ar;
    int     nt,n1,n2,n3,ns,nr,nb;
    int     it,i1,i2,i3;
    float   dt,d1,d2,d3,id1,id2,id3,dt2;

    /* linear interpolation weights/indices */
    lint3d cs,cr;

    fdm3d    fdm;
    abcone3d abc;     /* abc */
    sponge spo;

    /* FD coefficients */
    float c1x,c1y,c1z,
          c2x,c2y,c2z,
          c3x,c3y,c3z;

    int ompchunk;
#ifdef _OPENMP
    int ompnth,ompath;
#endif

    sf_axis   ac1=NULL,ac2=NULL,ac3=NULL;
    int       nqz,nqx,nqy;
    float     oqz,oqx,oqy;
    float     dqz,dqx,dqy;
    float     ***uc=NULL;

    /* for benchmarking */
    clock_t start_t, end_t;
    float total_t;

    /*------------------------------------------------------------*/
    /* init RSF */
    sf_init(argc,argv);
    if(! sf_getint("ompchunk",&ompchunk)) ompchunk=1;

    /* OpenMP data chunk size */
#ifdef _OPENMP
    if(! sf_getint("ompnth",  &ompnth))     ompnth=0;
    /* OpenMP available threads */
    #pragma omp parallel
    ompath=omp_get_num_threads();
    if(ompnth<1) ompnth=ompath;
    omp_set_num_threads(ompnth);
    sf_warning("using %d threads of a total of %d",ompnth,ompath);
#endif

    if(! sf_getbool("verb",&verb)) verb=false; /* verbosity flag */
    if(! sf_getbool("snap",&snap)) snap=false; /* wavefield snapshots flag */
    if(! sf_getbool("dabc",&dabc)) dabc=false; /* Absorbing BC */
    if(! sf_getbool("free",&fsrf)) fsrf=false; /* free surface flag */

    Fwav = sf_input ("in" ); /* wavelet   */
    Fsou = sf_input ("sou"); /* sources   */
    Frec = sf_input ("rec"); /* receivers */

    Fvel = sf_input ("vel"); /* velocity  */
    Fden = sf_input ("den"); /* density   */
    Fref = sf_input ("ref"); /* reflectivity */

    Fwfl = sf_output("wfl"); /* wavefield */
    Fdat = sf_output("out"); /* data      */

    Fliw = sf_output("liw"); /* wavefield (scattered) */
    Flid = sf_output("lid"); /* data (scattered) */

    /* axes */
    at = sf_iaxa(Fwav,2);
    sf_setlabel(at,"t");
    if(verb) sf_raxa(at); /* time */
    as = sf_iaxa(Fsou,2);
    sf_setlabel(as,"s");
    if(verb) sf_raxa(as); /* sources */
    ar = sf_iaxa(Frec,2);
    sf_setlabel(ar,"r");
    if(verb) sf_raxa(ar); /* receivers */
    a1 = sf_iaxa(Fvel,1);
    sf_setlabel(a1,"z");
    if(verb) sf_raxa(a1); /* z */
    a2 = sf_iaxa(Fvel,2);
    sf_setlabel(a2,"x");
    if(verb) sf_raxa(a2); /* x */
    a3 = sf_iaxa(Fvel,3);
    sf_setlabel(a3,"y");
    if(verb) sf_raxa(a3); /* y */

    nt = sf_n(at);
    dt = sf_d(at);
    ns = sf_n(as);
    nr = sf_n(ar);
    n1 = sf_n(a1);
    d1 = sf_d(a1);
    n2 = sf_n(a2);
    d2 = sf_d(a2);
    n3 = sf_n(a3);
    d3 = sf_d(a3);

    if(! sf_getint("jdata",&jdata)) jdata=1;
    if(snap) {  /* save wavefield every *jsnap* time steps */
        if(! sf_getint("jsnap",&jsnap)) jsnap=nt;
    }

    /*------------------------------------------------------------*/
    /* expand domain for FD operators and ABC */
    if( !sf_getint("nb",&nb) || nb<NOP) nb=NOP;

    fdm=fdutil3d_init(verb,fsrf,a1,a2,a3,nb,ompchunk);

    sf_setn(a1,fdm->nzpad);
    sf_seto(a1,fdm->ozpad);
    if(verb) sf_raxa(a1);
    sf_setn(a2,fdm->nxpad);
    sf_seto(a2,fdm->oxpad);
    if(verb) sf_raxa(a2);
    sf_setn(a3,fdm->nypad);
    sf_seto(a3,fdm->oypad);
    if(verb) sf_raxa(a3);
    /*------------------------------------------------------------*/

    /* setup output data header */
    sf_oaxa(Fdat,ar,1);
    sf_oaxa(Flid,ar,1);

    sf_setn(at,nt/jdata);
    sf_setd(at,dt*jdata);
    sf_oaxa(Fdat,at,2);
    sf_oaxa(Flid,at,2);

    /* setup output wavefield header */
    if(snap) {
        if(!sf_getint  ("nqz",&nqz)) nqz=sf_n(a1);
        if(!sf_getint  ("nqx",&nqx)) nqx=sf_n(a2);
        if(!sf_getint  ("nqy",&nqy)) nqy=sf_n(a3);

        if(!sf_getfloat("oqz",&oqz)) oqz=sf_o(a1);
        if(!sf_getfloat("oqx",&oqx)) oqx=sf_o(a2);
        if(!sf_getfloat("oqy",&oqy)) oqy=sf_o(a3);

        dqz=sf_d(a1);
        dqx=sf_d(a2);
        dqy=sf_d(a3);

        ac1 = sf_maxa(nqz,oqz,dqz);
        ac2 = sf_maxa(nqx,oqx,dqx);
        ac3 = sf_maxa(nqy,oqy,dqy);

        /* check if the imaging window fits in the wavefield domain */

        uc=sf_floatalloc3(sf_n(ac1),sf_n(ac2),sf_n(ac3));

        ntsnap=0;
        for(it=0; it<nt; it++) {
            if(it%jsnap==0) ntsnap++;
        }
        sf_setn(at,  ntsnap);
        sf_setd(at,dt*jsnap);
        if(verb) sf_raxa(at);

        /*	sf_setn(at,nt/jsnap);
        sf_setd(at,dt*jsnap); */

        sf_oaxa(Fwfl,ac1,1);
        sf_oaxa(Fwfl,ac2,2);
        sf_oaxa(Fwfl,ac3,3);
        sf_oaxa(Fwfl,at, 4);

        sf_oaxa(Fliw,ac1,1);
        sf_oaxa(Fliw,ac2,2);
        sf_oaxa(Fliw,ac3,3);
        sf_oaxa(Fliw,at, 4);
    }


    /* source wavelet array allocation */
    ww = sf_floatalloc(ns);

    /* data array allocation*/
    bdd = sf_floatalloc(nr);
    sdd = sf_floatalloc(nr);

    /*------------------------------------------------------------*/
    /* setup source/receiver coordinates */
    ss = (pt3d*) sf_alloc(ns,sizeof(*ss));
    rr = (pt3d*) sf_alloc(nr,sizeof(*rr));

    pt3dread1(Fsou,ss,ns,3); /* read (x,y,z) coordinates */
    pt3dread1(Frec,rr,nr,3); /* read (x,y,z) coordinates */

    cs = lint3d_make(ns,ss,fdm);
    cr = lint3d_make(nr,rr,fdm);

    fdbell3d_init(1);
    /*------------------------------------------------------------*/
    /* setup FD coefficients */
    dt2 = dt*dt;
    id1 = 1/d1;
    id2 = 1/d2;
    id3 = 1/d3;

    c1x = C1*id2;
    c1y = C1*id3;
    c1z = C1*id1;

    c2x = C2*id2;
    c2y = C2*id3;
    c2z = C2*id1;

    c3x = C3*id2;
    c3y = C3*id3;
    c3z = C3*id1;

    /*------------------------------------------------------------*/
    /* input density */
    roin = sf_floatalloc3(n1, n2, n3);
    ro   = sf_floatalloc3(fdm->nzpad, fdm->nxpad, fdm->nypad);
    iro  = sf_floatalloc3(fdm->nzpad, fdm->nxpad, fdm->nypad);

    sf_floatread(roin[0][0],n1*n2*n3,Fden);
    expand3d(roin,ro,fdm);

    /* inverse density to avoid computation on the fly */
    /*
    there is 1 shell for i1=0 || i2=0 || i3=0 that is zero,
    no big deal but better to fix it
    */
    for 		(i3=1; i3<fdm->nypad; i3++) {
        for 	(i2=1; i2<fdm->nxpad; i2++) {
            for (i1=1; i1<fdm->nzpad; i1++) {
                iro[i3][i2][i1] = 6./(  3*ro[i3  ][i2  ][i1  ] +
                                        ro[i3  ][i2  ][i1-1] +
                                        ro[i3  ][i2-1][i1  ] +
                                        ro[i3-1][i2  ][i1  ] );
            }
        }
    }

    free(**roin);
    free(*roin);
    free(roin);

    /*------------------------------------------------------------*/
    /* input velocity */
    vpin = sf_floatalloc3(n1, n2, n3);
    vp   = sf_floatalloc3(fdm->nzpad, fdm->nxpad, fdm->nypad);
    vt   = sf_floatalloc3(fdm->nzpad, fdm->nxpad, fdm->nypad);
    sf_floatread(vpin[0][0],n1*n2*n3,Fvel);
    expand3d(vpin,vp,fdm);
    free(**vpin);
    free(*vpin);
    free(vpin);

    /*------------------------------------------------------------*/
    /* input reflectivity */
    rfin = sf_floatalloc3(n1, n2, n3);
    rf   = sf_floatalloc3(fdm->nzpad, fdm->nxpad, fdm->nypad);
    sf_floatread(rfin[0][0],n1*n2*n3,Fref);
    expand3d(rfin,rf,fdm);
    free(**rfin);
    free(*rfin);
    free(rfin);

    for 		(i3=0; i3<fdm->nypad; i3++) {
        for 	(i2=0; i2<fdm->nxpad; i2++) {
            for (i1=0; i1<fdm->nzpad; i1++) {
                vt[i3][i2][i1] = vp[i3][i2][i1] * vp[i3][i2][i1] * dt2;
            }
        }
    }

    /* free surface */
    if(fsrf) {
        fsrfbck = sf_floatalloc3(4*NOP, fdm->nxpad, fdm->nypad);
        fsrfsct = sf_floatalloc3(4*NOP, fdm->nxpad, fdm->nypad);
    }
    /*------------------------------------------------------------*/
    /* allocate wavefield arrays */
    bum  = sf_floatalloc3(fdm->nzpad, fdm->nxpad, fdm->nypad);
    buo  = sf_floatalloc3(fdm->nzpad, fdm->nxpad, fdm->nypad);
    bup  = sf_floatalloc3(fdm->nzpad, fdm->nxpad, fdm->nypad);
    bua  = sf_floatalloc3(fdm->nzpad, fdm->nxpad, fdm->nypad);
    buat = sf_floatalloc3(fdm->nzpad, fdm->nxpad, fdm->nypad);

    sum  = sf_floatalloc3(fdm->nzpad, fdm->nxpad, fdm->nypad);
    suo  = sf_floatalloc3(fdm->nzpad, fdm->nxpad, fdm->nypad);
    sup  = sf_floatalloc3(fdm->nzpad, fdm->nxpad, fdm->nypad);
    sua  = sf_floatalloc3(fdm->nzpad, fdm->nxpad, fdm->nypad);
    suat = sf_floatalloc3(fdm->nzpad, fdm->nxpad, fdm->nypad);

    for 		(i3=0; i3<fdm->nypad; i3++) {
        for 	(i2=0; i2<fdm->nxpad; i2++) {
            for (i1=0; i1<fdm->nzpad; i1++) {
                bum[i3][i2][i1]=0;
                buo[i3][i2][i1]=0;
                bup[i3][i2][i1]=0;
                bua[i3][i2][i1]=0;

                sum[i3][i2][i1]=0;
                suo[i3][i2][i1]=0;
                sup[i3][i2][i1]=0;
                sua[i3][i2][i1]=0;
            }
        }
    }

    /*------------------------------------------------------------*/
    /* one-way abc setup */
    abc = abcone3d_make(NOP,dt,vp,fsrf,fdm);
    /* sponge abc setup */
    spo = sponge_make(fdm->nb);

    free(**vp);
    free(*vp);
    free(vp);
    /*--------------------------------------------------------------*/
    /* 																*/
    /*						MAIN LOOP								*/
    /*																*/
    /*--------------------------------------------------------------*/
    if(verb) fprintf(stderr,"\nFORWARD BORN ACOUSTIC VARIABLE-DENSITY WAVE EXTRAPOLATION \n");
    /* extrapolation */
    start_t = clock();
    for (it=0; it<nt; it++) {
        if(verb) fprintf(stderr,"%d/%d  \r",it,nt);

#ifdef _OPENMP
        #pragma omp parallel private(i3,i2,i1)
#endif
        {

            if (fsrf) {
                /* free surface */
#ifdef _OPENMP
                #pragma omp for schedule(dynamic,fdm->ompchunk)
#endif
                for 		(i3=0; i3<fdm->nypad; i3++) {
                    for 	(i2=0; i2<fdm->nxpad; i2++) {
                        for (i1=nb; i1<nb+2*NOP; i1++) {
                            fsrfbck[i3][i2][2*NOP+(i1-nb)  ] =  buo[i3][i2][i1];
                            fsrfbck[i3][i2][2*NOP-(i1-nb)-1] = -buo[i3][i2][i1];

                            fsrfsct[i3][i2][2*NOP+(i1-nb)  ] =  suo[i3][i2][i1];
                            fsrfsct[i3][i2][2*NOP-(i1-nb)-1] = -suo[i3][i2][i1];
                        }
                    }
                }
            }


            // spatial derivatives z
#ifdef _OPENMP
            #pragma omp for schedule(dynamic,fdm->ompchunk)
#endif
            for 		(i3=NOP; i3<fdm->nypad-NOP; i3++) {
                for 	(i2=NOP; i2<fdm->nxpad-NOP; i2++) {
                    for (i1=NOP; i1<fdm->nzpad-NOP; i1++) {

                        // gather
                        buat[i3][i2][i1]  = iro[i3][i2][i1]*(
                                                c3z*(buo[i3][i2][i1+2] - buo[i3][i2][i1-3]) +
                                                c2z*(buo[i3][i2][i1+1] - buo[i3][i2][i1-2]) +
                                                c1z*(buo[i3][i2][i1  ] - buo[i3][i2][i1-1])
                                            );

                        suat[i3][i2][i1]  = iro[i3][i2][i1]*(
                                                c3z*(suo[i3][i2][i1+2] - suo[i3][i2][i1-3]) +
                                                c2z*(suo[i3][i2][i1+1] - suo[i3][i2][i1-2]) +
                                                c1z*(suo[i3][i2][i1  ] - suo[i3][i2][i1-1])
                                            );
                    }
                }
            }

            if (fsrf) {
                // free surface
#ifdef _OPENMP
                #pragma omp for schedule(dynamic,fdm->ompchunk)
#endif
                for 		(i3=NOP; i3<fdm->nypad-NOP; i3++) {
                    for 	(i2=NOP; i2<fdm->nxpad-NOP; i2++) {
                        for (i1=nb-NOP; i1<nb+NOP; i1++) {

                            buat[i3][i2][i1]  = iro[i3][i2][i1]*(
                                                    c3z*(fsrfbck[i3][i2][2*NOP+(i1-nb)+2] - fsrfbck[i3][i2][2*NOP+(i1-nb)-3]) +
                                                    c2z*(fsrfbck[i3][i2][2*NOP+(i1-nb)+1] - fsrfbck[i3][i2][2*NOP+(i1-nb)-2]) +
                                                    c1z*(fsrfbck[i3][i2][2*NOP+(i1-nb)  ] - fsrfbck[i3][i2][2*NOP+(i1-nb)-1])
                                                );

                            suat[i3][i2][i1]  = iro[i3][i2][i1]*(
                                                    c3z*(fsrfsct[i3][i2][2*NOP+(i1-nb)+2] - fsrfsct[i3][i2][2*NOP+(i1-nb)-3]) +
                                                    c2z*(fsrfsct[i3][i2][2*NOP+(i1-nb)+1] - fsrfsct[i3][i2][2*NOP+(i1-nb)-2]) +
                                                    c1z*(fsrfsct[i3][i2][2*NOP+(i1-nb)  ] - fsrfsct[i3][i2][2*NOP+(i1-nb)-1])
                                                );
                        }
                    }
                }
            }


#ifdef _OPENMP
            #pragma omp for schedule(dynamic,fdm->ompchunk)
#endif
            for 		(i3=NOP; i3<fdm->nypad-NOP; i3++) {
                for 	(i2=NOP; i2<fdm->nxpad-NOP; i2++) {
                    for (i1=NOP; i1<fdm->nzpad-NOP; i1++) {
                        // scatter
                        bua[i3][i2][i1] = c1z*(	buat[i3][i2][i1  ] -
                                                buat[i3][i2][i1+1]) +
                                          c2z*(	buat[i3][i2][i1-1] -
                                                  buat[i3][i2][i1+2]) +
                                          c3z*(	buat[i3][i2][i1-2] -
                                                  buat[i3][i2][i1+3]);

                        sua[i3][i2][i1] = c1z*(	suat[i3][i2][i1  ] -
                                                suat[i3][i2][i1+1]) +
                                          c2z*(	suat[i3][i2][i1-1] -
                                                  suat[i3][i2][i1+2]) +
                                          c3z*(	suat[i3][i2][i1-2] -
                                                  suat[i3][i2][i1+3]);
                    }
                }
            }

            // spatial derivatives x
#ifdef _OPENMP
            #pragma omp for schedule(dynamic,fdm->ompchunk)
#endif
            for 		(i3=NOP; i3<fdm->nypad-NOP; i3++) {
                for 	(i2=NOP; i2<fdm->nxpad-NOP; i2++) {
                    for (i1=NOP; i1<fdm->nzpad-NOP; i1++) {
                        // gather
                        buat[i3][i2][i1]  = iro[i3][i2][i1]*(
                                                c3x*(buo[i3][i2+2][i1] - buo[i3][i2-3][i1]) +
                                                c2x*(buo[i3][i2+1][i1] - buo[i3][i2-2][i1]) +
                                                c1x*(buo[i3][i2  ][i1] - buo[i3][i2-1][i1])
                                            );

                        suat[i3][i2][i1]  = iro[i3][i2][i1]*(
                                                c3x*(suo[i3][i2+2][i1] - suo[i3][i2-3][i1]) +
                                                c2x*(suo[i3][i2+1][i1] - suo[i3][i2-2][i1]) +
                                                c1x*(suo[i3][i2  ][i1] - suo[i3][i2-1][i1])
                                            );
                    }
                }
            }

#ifdef _OPENMP
            #pragma omp for schedule(dynamic,fdm->ompchunk)
#endif
            for 		(i3=NOP; i3<fdm->nypad-NOP; i3++) {
                for 	(i2=NOP; i2<fdm->nxpad-NOP; i2++) {
                    for (i1=NOP; i1<fdm->nzpad-NOP; i1++) {
                        // scatter
                        bua[i3][i2  ][i1] += c1x*(buat[i3][i2  ][i1] -
                                                  buat[i3][i2+1][i1]) +
                                             c2x*(buat[i3][i2-1][i1] -
                                                  buat[i3][i2+2][i1]) +
                                             c3x*(buat[i3][i2-2][i1] -
                                                  buat[i3][i2+3][i1]);

                        sua[i3][i2  ][i1] += c1x*(suat[i3][i2  ][i1] -
                                                  suat[i3][i2+1][i1]) +
                                             c2x*(suat[i3][i2-1][i1] -
                                                  suat[i3][i2+2][i1]) +
                                             c3x*(suat[i3][i2-2][i1] -
                                                  suat[i3][i2+3][i1]);
                    }
                }
            }

            // spatial derivatives y
#ifdef _OPENMP
            #pragma omp for schedule(dynamic,fdm->ompchunk)
#endif
            for 		(i3=NOP; i3<fdm->nypad-NOP; i3++) {
                for 	(i2=NOP; i2<fdm->nxpad-NOP; i2++) {
                    for (i1=NOP; i1<fdm->nzpad-NOP; i1++) {
                        // gather
                        buat[i3][i2][i1]  = iro[i3][i2][i1]*(
                                                c3x*(buo[i3+2][i2][i1] - buo[i3-3][i2][i1]) +
                                                c2x*(buo[i3+1][i2][i1] - buo[i3-2][i2][i1]) +
                                                c1x*(buo[i3  ][i2][i1] - buo[i3-1][i2][i1])
                                            );

                        suat[i3][i2][i1]  = iro[i3][i2][i1]*(
                                                c3x*(suo[i3+2][i2][i1] - suo[i3-3][i2][i1]) +
                                                c2x*(suo[i3+1][i2][i1] - suo[i3-2][i2][i1]) +
                                                c1x*(suo[i3  ][i2][i1] - suo[i3-1][i2][i1])
                                            );
                    }
                }
            }

#ifdef _OPENMP
            #pragma omp for schedule(dynamic,fdm->ompchunk)
#endif
            for 		(i3=NOP; i3<fdm->nypad-NOP; i3++) {
                for 	(i2=NOP; i2<fdm->nxpad-NOP; i2++) {
                    for (i1=NOP; i1<fdm->nzpad-NOP; i1++) {
                        // scatter
                        bua[i3][i2][i1] += c1y*(buat[i3  ][i2][i1] -
                                                buat[i3+1][i2][i1]) +
                                           c2y*(	buat[i3-1][i2][i1] -
                                                   buat[i3+2][i2][i1]) +
                                           c3y*(	buat[i3-2][i2][i1] -
                                                   buat[i3+3][i2][i1]);

                        sua[i3][i2][i1] += c1y*(suat[i3  ][i2][i1] -
                                                suat[i3+1][i2][i1]) +
                                           c2y*(	suat[i3-1][i2][i1] -
                                                   suat[i3+2][i2][i1]) +
                                           c3y*(	suat[i3-2][i2][i1] -
                                                   suat[i3+3][i2][i1]);
                    }
                }
            }

            /* step forward in time */
#ifdef _OPENMP
            #pragma omp for schedule(dynamic,fdm->ompchunk)
#endif
            for 		(i3=NOP; i3<fdm->nypad-NOP; i3++) {
                for 	(i2=NOP; i2<fdm->nxpad-NOP; i2++) {
                    for (i1=NOP; i1<fdm->nzpad-NOP; i1++) {
                        bup[i3][i2][i1] = 2*buo[i3][i2][i1]
                                          -					bum[i3][i2][i1]
                                          -					ro[i3][i2][i1]*vt[i3][i2][i1]*bua[i3][i2][i1];

                        sup[i3][i2][i1] = 2*suo[i3][i2][i1]
                                          -					sum[i3][i2][i1]
                                          -					ro[i3][i2][i1]*vt[i3][i2][i1]*sua[i3][i2][i1];

                    }
                }
            }

            /* single scattering */
#ifdef _OPENMP
            #pragma omp for schedule(dynamic,ompchunk)
#endif
            for 		(i3=NOP; i3<fdm->nypad-NOP; i3++) {
                for 	(i2=NOP; i2<fdm->nxpad-NOP; i2++) {
                    for (i1=NOP; i1<fdm->nzpad-NOP; i1++) {
                        sup[i3][i2][i1] -= 2*rf[i3][i2][i1]*ro[i3][i2][i1]*bua[i3][i2][i1]*dt2;
                    }
                }
            }



        }	/* end of the parallel section */

        /* inject acceleration source */
        sf_floatread(ww,ns,Fwav);
        lint3d_bell(bup,ww,cs);

        /* extract data */
        lint3d_extract(bup,bdd,cr);
        lint3d_extract(sup,sdd,cr);

        if(snap && it%jsnap==0) {
            cut3d(bup,uc,fdm,ac1,ac2,ac3);
            sf_floatwrite(uc[0][0],sf_n(ac1)*sf_n(ac2)*sf_n(ac3),Fwfl);

            cut3d(sup,uc,fdm,ac1,ac2,ac3);
            sf_floatwrite(uc[0][0],sf_n(ac1)*sf_n(ac2)*sf_n(ac3),Fliw);
        }
        if(        it%jdata==0) {
            sf_floatwrite(bdd,nr,Fdat);
            sf_floatwrite(sdd,nr,Flid);
        }

        /* one-way abc apply*/
        if (dabc) {
            abcone3d_apply(bup,buo,NOP,abc,fdm);
            sponge3d_apply(bup,        spo,fdm);
            sponge3d_apply(buo,        spo,fdm);

            abcone3d_apply(sup,suo,NOP,abc,fdm);
            sponge3d_apply(sup,        spo,fdm);
            sponge3d_apply(suo,        spo,fdm);
        }

        /* circulate wavefield arrays */
        but=bum;
        bum=buo;
        buo=bup;
        bup=but;

        sut=sum;
        sum=suo;
        suo=sup;
        sup=sut;

    } /* end time loop */
    end_t = clock();
    if(verb) fprintf(stderr,"\n");

    if (verb) {
        total_t = (float)(end_t - start_t) / CLOCKS_PER_SEC;
        fprintf(stderr,"Total time taken by CPU: %g\n", total_t  );
        fprintf(stderr,"Exiting of the program...\n");
    }


    /*------------------------------------------------------------*/
    /* deallocate arrays */
    free(**bum);
    free(*bum);
    free(bum);
    free(**buo);
    free(*buo);
    free(buo);
    free(**bup);
    free(*bup);
    free(bup);
    free(**bua);
    free(*bua);
    free(bua);
    free(**buat);
    free(*buat);
    free(buat);

    free(**sum);
    free(*sum);
    free(sum);
    free(**suo);
    free(*suo);
    free(suo);
    free(**sup);
    free(*sup);
    free(sup);
    free(**sua);
    free(*sua);
    free(sua);
    free(**suat);
    free(*suat);
    free(suat);

    if(snap) {
        free(**uc);
        free(*uc);
        free(uc);
    }

    if (fsrf) {
        free(**fsrfbck);
        free(*fsrfbck);
        free(fsrfbck);
        free(**fsrfsct);
        free(*fsrfsct);
        free(fsrfsct);
    }

    free(**vt);
    free(*vt);
    free(vt);

    free(**ro);
    free(*ro);
    free(ro);
    free(**iro);
    free(*iro);
    free(iro);

    free(**rf);
    free(*rf);
    free(rf);

    free(ww);
    free(ss);
    free(rr);

    free(bdd);
    free(sdd);

    if (dabc) {
        free(spo);
        free(abc);
    }
    free(fdm);
    /* ------------------------------------------------------------------------------------------ */
    /* CLOSE FILES AND EXIT */
    if (Fwav!=NULL) sf_fileclose(Fwav);

    if (Fsou!=NULL) sf_fileclose(Fsou);
    if (Frec!=NULL) sf_fileclose(Frec);

    if (Fvel!=NULL) sf_fileclose(Fvel);
    if (Fden!=NULL) sf_fileclose(Fden);

    if (Fref!=NULL) sf_fileclose(Fref);

    if (Fdat!=NULL) sf_fileclose(Fdat);

    if (Fwfl!=NULL) sf_fileclose(Fwfl);

    if (Fliw!=NULL) sf_fileclose(Fliw);
    if (Flid!=NULL) sf_fileclose(Flid);

    exit (0);
}
Example #3
0
int main(int argc, char* argv[])
{
    bool verb,fsrf,snap,ssou,dabc,opot;
    int  jsnap,ntsnap,jdata;

    /* I/O files */
    sf_file Fwav=NULL; /* wavelet   */
    sf_file Fsou=NULL; /* sources   */
    sf_file Frec=NULL; /* receivers */
    sf_file Fccc=NULL; /* velocity  */
    sf_file Fden=NULL; /* density   */
    sf_file Fdat=NULL; /* data      */
    sf_file Fwfl=NULL; /* wavefield */

    /* cube axes */
    sf_axis at,ax,ay,az;
    sf_axis as,ar,ac;

    int     nt,nz,nx,ny,ns,nr,nc,nb;
    int     it,iz,ix,iy;
    float   dt,dz,dx,dy,idz,idx,idy;

    /* FDM structure */
    fdm3d    fdm=NULL;
    abcone3d /* abcp=NULL, */ abcs=NULL;
    sponge   spo=NULL;

    /* I/O arrays */
    float***ww=NULL;           /* wavelet   */
    pt3d   *ss=NULL;           /* sources   */
    pt3d   *rr=NULL;           /* receivers */
    float **dd=NULL;           /* data      */

    /*------------------------------------------------------------*/
    float ***tt=NULL;
    float ***ro=NULL;           /* density */

    /* orthorombic footprint - 9 coefficients */
    /* c11 c12 c13 
       .   c22 c23 
       .   .   c33 
                  c44
                     c55
                        c66 */
    float ***c11=NULL;
    float ***c22=NULL;
    float ***c33=NULL;
    float ***c44=NULL;
    float ***c55=NULL;
    float ***c66=NULL;
    float ***c12=NULL;
    float ***c13=NULL;
    float ***c23=NULL;
    float ***vp,***vs;
    float ***qp=NULL,***qsx=NULL,***qsy=NULL,***qsz=NULL;

    /*------------------------------------------------------------*/
    /* displacement: um = U @ t-1; uo = U @ t; up = U @ t+1 */
    float ***umz,***uoz,***upz,***uaz,***utz; 
    float ***umx,***uox,***upx,***uax,***utx;
    float ***umy,***uoy,***upy,***uay,***uty;

    /* stress/strain tensor */ 
    float ***tzz,***txx,***tyy,***txy,***tyz,***tzx;       
    float    szz,   sxx,   syy,   sxy,   syz,   szx;

    /*------------------------------------------------------------*/
    /* linear interpolation weights/indices */
    lint3d cs,cr;

    /* Gaussian bell */
    int nbell;
    
    /* wavefield cut params */
    sf_axis   acz=NULL,acx=NULL,acy=NULL;
    int       nqz,nqx,nqy;
    float     oqz,oqx,oqy;
    float     dqz,dqx,dqy;
    float     ***uc=NULL;

    /*------------------------------------------------------------*/
    /* init RSF */
    sf_init(argc,argv);

    /*------------------------------------------------------------*/
    /* OMP parameters */
#ifdef _OPENMP
    omp_init();
#endif
    /*------------------------------------------------------------*/

    /*------------------------------------------------------------*/
    /* execution flags */
    if(! sf_getbool("verb",&verb)) verb=false; /* verbosity flag */
    if(! sf_getbool("snap",&snap)) snap=false; /* wavefield snapshots flag */
    if(! sf_getbool("free",&fsrf)) fsrf=false; /* free surface flag */
    if(! sf_getbool("ssou",&ssou)) ssou=false; /* stress source */
    if(! sf_getbool("dabc",&dabc)) dabc=false; /* absorbing BC */
    if(! sf_getbool("opot",&opot)) opot=false; /* output potentials */
    /*------------------------------------------------------------*/

    /*------------------------------------------------------------*/
    /* I/O files */
    Fwav = sf_input ("in" ); /* wavelet   */
    Fccc = sf_input ("ccc"); /* stiffness */
    Fden = sf_input ("den"); /* density   */
    Fsou = sf_input ("sou"); /* sources   */
    Frec = sf_input ("rec"); /* receivers */
    Fwfl = sf_output("wfl"); /* wavefield */
    Fdat = sf_output("out"); /* data      */
    /*------------------------------------------------------------*/

    /*------------------------------------------------------------*/
    /* axes */
    at = sf_iaxa(Fwav,3); sf_setlabel(at,"t"); if(verb) sf_raxa(at); /* time */
    az = sf_iaxa(Fccc,1); sf_setlabel(az,"z"); if(verb) sf_raxa(az); /* depth */
    ax = sf_iaxa(Fccc,2); sf_setlabel(ax,"x"); if(verb) sf_raxa(ax); /* space x */
    ay = sf_iaxa(Fccc,3); sf_setlabel(ay,"y"); if(verb) sf_raxa(ay); /* space y */

    as = sf_iaxa(Fsou,2); sf_setlabel(as,"s"); if(verb) sf_raxa(as); /* sources */
    ar = sf_iaxa(Frec,2); sf_setlabel(ar,"r"); if(verb) sf_raxa(ar); /* receivers */

    nt = sf_n(at); dt = sf_d(at);
    nz = sf_n(az); dz = sf_d(az);
    nx = sf_n(ax); dx = sf_d(ax);
    ny = sf_n(ay); dy = sf_d(ay);

    ns = sf_n(as);
    nr = sf_n(ar);
    /*------------------------------------------------------------*/

    /*------------------------------------------------------------*/
    /* other execution parameters */
    if(! sf_getint("nbell",&nbell)) nbell=5;  /* bell size */
    if(verb) sf_warning("nbell=%d",nbell);
    if(! sf_getint("jdata",&jdata)) jdata=1;
    if(snap) {  /* save wavefield every *jsnap* time steps */
	if(! sf_getint("jsnap",&jsnap)) jsnap=nt;
    }
    /*------------------------------------------------------------*/

    /*------------------------------------------------------------*/
    /* expand domain for FD operators and ABC */
    if( !sf_getint("nb",&nb) || nb<NOP) nb=NOP;

    fdm=fdutil3d_init(verb,fsrf,az,ax,ay,nb,1);
    fdbell3d_init(nbell);

    sf_setn(az,fdm->nzpad); sf_seto(az,fdm->ozpad); if(verb) sf_raxa(az);
    sf_setn(ax,fdm->nxpad); sf_seto(ax,fdm->oxpad); if(verb) sf_raxa(ax);
    sf_setn(ay,fdm->nypad); sf_seto(ay,fdm->oypad); if(verb) sf_raxa(ay);
    /*------------------------------------------------------------*/

    /* 3D vector components */
    nc=3;
    if(opot) {
	ac=sf_maxa(nc+1,0,1);
    } else {
	ac=sf_maxa(nc  ,0,1);
    }

    /*------------------------------------------------------------*/
    /* setup output data header */
    sf_oaxa(Fdat,ar,1);
    sf_oaxa(Fdat,ac,2);

    sf_setn(at,nt/jdata);
    sf_setd(at,dt*jdata);
    sf_oaxa(Fdat,at,3);

    /* setup output wavefield header */
    if(snap) {
	if(!sf_getint  ("nqz",&nqz)) nqz=sf_n(az);
	if(!sf_getint  ("nqx",&nqx)) nqx=sf_n(ax);
	if(!sf_getint  ("nqy",&nqy)) nqy=sf_n(ay);

	if(!sf_getfloat("oqz",&oqz)) oqz=sf_o(az);
	if(!sf_getfloat("oqx",&oqx)) oqx=sf_o(ax);
	if(!sf_getfloat("oqy",&oqy)) oqy=sf_o(ay);

	dqz=sf_d(az);
	dqx=sf_d(ax);
	dqy=sf_d(ay);

	acz = sf_maxa(nqz,oqz,dqz); sf_raxa(acz);
	acx = sf_maxa(nqx,oqx,dqx); sf_raxa(acx);
	acy = sf_maxa(nqy,oqy,dqy); sf_raxa(acy);
	/* TODO: check if the imaging window fits in the wavefield domain */

	uc=sf_floatalloc3(sf_n(acz),sf_n(acx),sf_n(acy));

	ntsnap=0;
	for(it=0; it<nt; it++) {
	    if(it%jsnap==0) ntsnap++;
	}
	sf_setn(at,  ntsnap);
	sf_setd(at,dt*jsnap);
	if(verb) sf_raxa(at);

	sf_oaxa(Fwfl,acz,1);
	sf_oaxa(Fwfl,acx,2);
	sf_oaxa(Fwfl,acy,3);
	sf_oaxa(Fwfl,ac, 4);
	sf_oaxa(Fwfl,at, 5);
    }

    /*------------------------------------------------------------*/
    /* source array */
    ww=sf_floatalloc3(ns,nc,nt); 
    sf_floatread(ww[0][0],nt*nc*ns,Fwav);

    /* data array */
    if(opot) {
	dd=sf_floatalloc2(nr,nc+1);
    } else {
	dd=sf_floatalloc2(nr,nc  );
    }

    /*------------------------------------------------------------*/
    /* setup source/receiver coordinates */
    ss = (pt3d*) sf_alloc(ns,sizeof(*ss)); 
    rr = (pt3d*) sf_alloc(nr,sizeof(*rr)); 

    pt3dread1(Fsou,ss,ns,3); /* read (x,y,z) coordinates */
    pt3dread1(Frec,rr,nr,3); /* read (x,y,z) coordinates */
    
    cs = lint3d_make(ns,ss,fdm);
    cr = lint3d_make(nr,rr,fdm);

    /*------------------------------------------------------------*/
    /* setup FD coefficients */
/*    idz = 2/dz;*/
/*    idx = 2/dx;*/
/*    idy = 2/dy;*/

    idz = 1/dz;
    idx = 1/dx;
    idy = 1/dy;

    /*------------------------------------------------------------*/ 
    tt = sf_floatalloc3(nz,nx,ny); 
    
    ro =sf_floatalloc3(fdm->nzpad,fdm->nxpad,fdm->nypad);
    c11=sf_floatalloc3(fdm->nzpad,fdm->nxpad,fdm->nypad); 
    c22=sf_floatalloc3(fdm->nzpad,fdm->nxpad,fdm->nypad); 
    c33=sf_floatalloc3(fdm->nzpad,fdm->nxpad,fdm->nypad); 
    c44=sf_floatalloc3(fdm->nzpad,fdm->nxpad,fdm->nypad); 
    c55=sf_floatalloc3(fdm->nzpad,fdm->nxpad,fdm->nypad); 
    c66=sf_floatalloc3(fdm->nzpad,fdm->nxpad,fdm->nypad); 
    c12=sf_floatalloc3(fdm->nzpad,fdm->nxpad,fdm->nypad); 
    c13=sf_floatalloc3(fdm->nzpad,fdm->nxpad,fdm->nypad); 
    c23=sf_floatalloc3(fdm->nzpad,fdm->nxpad,fdm->nypad);     

    /* input density */
    sf_floatread(tt[0][0],nz*nx*ny,Fden);     expand3d(tt,ro ,fdm);

    /* input stiffness */
    sf_floatread(tt[0][0],nz*nx*ny,Fccc );    expand3d(tt,c11,fdm);
    sf_floatread(tt[0][0],nz*nx*ny,Fccc );    expand3d(tt,c22,fdm);    
    sf_floatread(tt[0][0],nz*nx*ny,Fccc );    expand3d(tt,c33,fdm);    
    sf_floatread(tt[0][0],nz*nx*ny,Fccc );    expand3d(tt,c44,fdm);
    sf_floatread(tt[0][0],nz*nx*ny,Fccc );    expand3d(tt,c55,fdm);    
    sf_floatread(tt[0][0],nz*nx*ny,Fccc );    expand3d(tt,c66,fdm);
    sf_floatread(tt[0][0],nz*nx*ny,Fccc );    expand3d(tt,c12,fdm);
    sf_floatread(tt[0][0],nz*nx*ny,Fccc );    expand3d(tt,c13,fdm);
    sf_floatread(tt[0][0],nz*nx*ny,Fccc );    expand3d(tt,c23,fdm);

    free(**tt); free(*tt); free(tt);

    /*------------------------------------------------------------*/
    if(dabc) {
	/* one-way abc setup   */
	vp = sf_floatalloc3(fdm->nzpad,fdm->nxpad,fdm->nypad); 
	vs = sf_floatalloc3(fdm->nzpad,fdm->nxpad,fdm->nypad); 
	for        (iy=0; iy<fdm->nypad; iy++) {
	    for    (ix=0; ix<fdm->nxpad; ix++) {
		for(iz=0; iz<fdm->nzpad; iz++) {
		    vp[iy][ix][iz] = sqrt( c11[iy][ix][iz]/ro[iy][ix][iz] );
		    vs[iy][ix][iz] = sqrt( c55[iy][ix][iz]/ro[iy][ix][iz] );
		}
	    }
	}
/*	abcp = abcone3d_make(NOP,dt,vp,fsrf,fdm); */
	abcs = abcone3d_make(NOP,dt,vs,fsrf,fdm);
	free(**vp); free(*vp); free(vp);
	free(**vs); free(*vs); free(vs);

	/* sponge abc setup */
	spo = sponge_make(fdm->nb);
    }

    /*------------------------------------------------------------*/
    /* precompute 1/ro * dt^2 */
    for        (iy=0; iy<fdm->nypad; iy++) {
	for    (ix=0; ix<fdm->nxpad; ix++) {
	    for(iz=0; iz<fdm->nzpad; iz++) {
		ro[iy][ix][iz] = dt*dt/ro[iy][ix][iz];
	    }
	}
     }

    /*------------------------------------------------------------*/
    /* allocate wavefield arrays */
    umz=sf_floatalloc3(fdm->nzpad,fdm->nxpad,fdm->nypad);
    uoz=sf_floatalloc3(fdm->nzpad,fdm->nxpad,fdm->nypad);
    upz=sf_floatalloc3(fdm->nzpad,fdm->nxpad,fdm->nypad);
    uaz=sf_floatalloc3(fdm->nzpad,fdm->nxpad,fdm->nypad);

    umx=sf_floatalloc3(fdm->nzpad,fdm->nxpad,fdm->nypad);
    uox=sf_floatalloc3(fdm->nzpad,fdm->nxpad,fdm->nypad);
    upx=sf_floatalloc3(fdm->nzpad,fdm->nxpad,fdm->nypad);
    uax=sf_floatalloc3(fdm->nzpad,fdm->nxpad,fdm->nypad);

    umy=sf_floatalloc3(fdm->nzpad,fdm->nxpad,fdm->nypad);
    uoy=sf_floatalloc3(fdm->nzpad,fdm->nxpad,fdm->nypad);
    upy=sf_floatalloc3(fdm->nzpad,fdm->nxpad,fdm->nypad);
    uay=sf_floatalloc3(fdm->nzpad,fdm->nxpad,fdm->nypad);

    tzz=sf_floatalloc3(fdm->nzpad,fdm->nxpad,fdm->nypad);
    tyy=sf_floatalloc3(fdm->nzpad,fdm->nxpad,fdm->nypad);
    txx=sf_floatalloc3(fdm->nzpad,fdm->nxpad,fdm->nypad);
    txy=sf_floatalloc3(fdm->nzpad,fdm->nxpad,fdm->nypad);
    tyz=sf_floatalloc3(fdm->nzpad,fdm->nxpad,fdm->nypad);
    tzx=sf_floatalloc3(fdm->nzpad,fdm->nxpad,fdm->nypad);

    for        (iy=0; iy<fdm->nypad; iy++) {
	for    (ix=0; ix<fdm->nxpad; ix++) {
	    for(iz=0; iz<fdm->nzpad; iz++) {
		umz[iy][ix][iz]=0; umx[iy][ix][iz]=0; umy[iy][ix][iz]=0;
		uoz[iy][ix][iz]=0; uox[iy][ix][iz]=0; uoy[iy][ix][iz]=0;
		upz[iy][ix][iz]=0; upx[iy][ix][iz]=0; upy[iy][ix][iz]=0;
		uaz[iy][ix][iz]=0; uax[iy][ix][iz]=0; uay[iy][ix][iz]=0;
	    }
	}
    }

    if(opot) {
	qp =sf_floatalloc3(fdm->nzpad,fdm->nxpad,fdm->nypad);
	qsx=sf_floatalloc3(fdm->nzpad,fdm->nxpad,fdm->nypad);
	qsy=sf_floatalloc3(fdm->nzpad,fdm->nxpad,fdm->nypad);
	qsz=sf_floatalloc3(fdm->nzpad,fdm->nxpad,fdm->nypad);
    }

    /*------------------------------------------------------------*/
    /* 
     *  MAIN LOOP
     */
    /*------------------------------------------------------------*/
    if(verb) fprintf(stderr,"\n");
    for (it=0; it<nt; it++) {
	if(verb) fprintf(stderr,"\b\b\b\b\b%d",it);

	/*------------------------------------------------------------*/
	/* from displacement to strain                                */
	/*------------------------------------------------------------*/	
	/* 
	 * exx = Fx(ux)
	 * eyy = Fy(uy)
	 * ezz = Fz(uz)
	 * exy = By(ux) + Bx(uy)
	 * eyz = Bz(uy) + By(uz)
	 * ezx = Bx(uz) + Bz(ux)
	 */
#ifdef _OPENMP
#pragma omp parallel for					\
    schedule(dynamic,fdm->ompchunk)				\
    private(ix,iy,iz)						\
    shared(fdm,txx,tyy,tzz,txy,tyz,tzx,uox,uoy,uoz,idx,idy,idz)
#endif
	for        (iy=NOP; iy<fdm->nypad-NOP; iy++) {
	    for    (ix=NOP; ix<fdm->nxpad-NOP; ix++) {
		for(iz=NOP; iz<fdm->nzpad-NOP; iz++) {
		    
		    txx[iy][ix][iz] = Dx(uox,ix,iy,iz,idx);
		    tyy[iy][ix][iz] = Dy(uoy,ix,iy,iz,idy);
		    tzz[iy][ix][iz] = Dz(uoz,ix,iy,iz,idz);
		    
		    txy[iy][ix][iz] = Dy(uox,ix,iy,iz,idy) + Dx(uoy,ix,iy,iz,idx);
		    tyz[iy][ix][iz] = Dz(uoy,ix,iy,iz,idz) + Dy(uoz,ix,iy,iz,idy);
		    tzx[iy][ix][iz] = Dx(uoz,ix,iy,iz,idx) + Dz(uox,ix,iy,iz,idz);
		}
	    }
	}
	
	/*------------------------------------------------------------*/
	/* from strain to stress                                      */
	/*------------------------------------------------------------*/
#ifdef _OPENMP
#pragma omp parallel for						\
    schedule(dynamic,fdm->ompchunk)					\
    private(ix,iy,iz,sxx,syy,szz,sxy,syz,szx)				\
    shared(fdm,txx,tyy,tzz,txy,tyz,tzx,c11,c22,c33,c44,c55,c66,c12,c13,c23)
#endif
	for        (iy=0; iy<fdm->nypad; iy++) {
	    for    (ix=0; ix<fdm->nxpad; ix++) {
		for(iz=0; iz<fdm->nzpad; iz++) {
		    
		    sxx = c11[iy][ix][iz] * txx[iy][ix][iz]
			+ c12[iy][ix][iz] * tyy[iy][ix][iz]
			+ c13[iy][ix][iz] * tzz[iy][ix][iz];
		    syy = c12[iy][ix][iz] * txx[iy][ix][iz]
			+ c22[iy][ix][iz] * tyy[iy][ix][iz]
			+ c23[iy][ix][iz] * tzz[iy][ix][iz];
		    szz = c13[iy][ix][iz] * txx[iy][ix][iz]
			+ c23[iy][ix][iz] * tyy[iy][ix][iz]
			+ c33[iy][ix][iz] * tzz[iy][ix][iz];
		    
		    sxy = c66[iy][ix][iz] * txy[iy][ix][iz];
		    syz = c44[iy][ix][iz] * tyz[iy][ix][iz];
		    szx = c55[iy][ix][iz] * tzx[iy][ix][iz];
		    
		    txx[iy][ix][iz] = sxx;
		    tyy[iy][ix][iz] = syy;
		    tzz[iy][ix][iz] = szz;

		    txy[iy][ix][iz] = sxy;
		    tyz[iy][ix][iz] = syz;
		    tzx[iy][ix][iz] = szx;
		}
	    }
	}

	/*------------------------------------------------------------*/
	/* free surface */
	/*------------------------------------------------------------*/
	if(fsrf) {
#ifdef _OPENMP
#pragma omp parallel for						\
    schedule(dynamic,fdm->ompchunk)					\
    private(ix,iy,iz)							\
    shared(fdm,txx,tyy,tzz,txy,tyz,tzx)
#endif
	    for        (iy=0; iy<fdm->nypad; iy++) {
		for    (ix=0; ix<fdm->nxpad; ix++) {
		    for(iz=0; iz<fdm->nb;    iz++) {
			txx[iy][ix][iz]=0;
			tyy[iy][ix][iz]=0;
			tzz[iy][ix][iz]=0;

			txy[iy][ix][iz]=0;
			tyz[iy][ix][iz]=0;
			tzx[iy][ix][iz]=0;
		    }
		}
	    }
	}

	/*------------------------------------------------------------*/
	/* inject stress source                                       */
	/*------------------------------------------------------------*/
	if(ssou) {
	    lint3d_bell(tzz,ww[it][0],cs);
	    lint3d_bell(txx,ww[it][1],cs);
	    lint3d_bell(tyy,ww[it][2],cs);
	}
	
	/*------------------------------------------------------------*/
	/* from stress to acceleration                                */
	/*------------------------------------------------------------*/
	/* 
	 * ax = Bx(txx) + Fy(txy) + Fz(txz)
	 * ay = Fx(txy) + By(tyy) + Fz(tyz)
	 * az = Fx(txz) + Fy(tyz) + Bz(tzz)
	 */	
#ifdef _OPENMP
#pragma omp parallel for					\
    schedule(dynamic,fdm->ompchunk)				\
    private(ix,iy,iz)						\
    shared(fdm,txx,tyy,tzz,txy,tyz,tzx,uax,uay,uaz,idx,idy,idz)
#endif
	for        (iy=NOP; iy<fdm->nypad-NOP; iy++) {
	    for    (ix=NOP; ix<fdm->nxpad-NOP; ix++) {
		for(iz=NOP; iz<fdm->nzpad-NOP; iz++) {		    
		    uax[iy][ix][iz] = Dx( txx,ix,iy,iz,idx ) + Dy( txy,ix,iy,iz,idy ) + Dz( tzx,ix,iy,iz,idz ) ;
		    uay[iy][ix][iz] = Dx( txy,ix,iy,iz,idx ) + Dy( tyy,ix,iy,iz,idy ) + Dz( tyz,ix,iy,iz,idz ) ;
		    uaz[iy][ix][iz] = Dx( tzx,ix,iy,iz,idx ) + Dy( tyz,ix,iy,iz,idy ) + Dz( tzz,ix,iy,iz,idz ) ;		    
		}
	    }
	}

	/*------------------------------------------------------------*/
	/* inject acceleration source                                 */
	/*------------------------------------------------------------*/
	if(!ssou) {
	    lint3d_bell(uaz,ww[it][0],cs);
	    lint3d_bell(uax,ww[it][1],cs);
	    lint3d_bell(uay,ww[it][2],cs);
	}

	/*------------------------------------------------------------*/
	/* step forward in time                                       */
	/*------------------------------------------------------------*/
#ifdef _OPENMP
#pragma omp parallel for						\
    schedule(dynamic,fdm->ompchunk)					\
    private(ix,iy,iz)							\
    shared(fdm,uox,uoy,uoz,umx,umy,umz,upx,upy,upz,uax,uay,uaz,ro)
#endif
	for        (iy=0; iy<fdm->nypad; iy++) {
	    for    (ix=0; ix<fdm->nxpad; ix++) {
		for(iz=0; iz<fdm->nzpad; iz++) {
		    upx[iy][ix][iz] = 2*uox[iy][ix][iz] 
			-               umx[iy][ix][iz] 
			+               uax[iy][ix][iz] * ro[iy][ix][iz]; 

		    upy[iy][ix][iz] = 2*uoy[iy][ix][iz] 
			-               umy[iy][ix][iz] 
			+               uay[iy][ix][iz] * ro[iy][ix][iz]; 

		    upz[iy][ix][iz] = 2*uoz[iy][ix][iz] 
			-               umz[iy][ix][iz] 
			+               uaz[iy][ix][iz] * ro[iy][ix][iz]; 
		    
		}
	    }
	}
	/* circulate wavefield arrays */
	utz=umz; uty=umy; utx=umx;
	umz=uoz; umy=uoy; umx=uox;
	uoz=upz; uoy=upy; uox=upx;
	upz=utz; upy=uty; upx=utx;
	
	if(dabc) {
	    /* one-way ABC */
	    /* abcone3d_apply(uoz,umz,NOP,abcp,fdm); */
	    /* abcone3d_apply(uox,umx,NOP,abcp,fdm); */
	    /* abcone3d_apply(uoy,umy,NOP,abcp,fdm); */
	    
	    abcone3d_apply(uoz,umz,NOP,abcs,fdm);
	    abcone3d_apply(uox,umx,NOP,abcs,fdm);
	    abcone3d_apply(uoy,umy,NOP,abcs,fdm);

	    /* sponge ABC */
	    sponge3d_apply(umz,spo,fdm);
	    sponge3d_apply(uoz,spo,fdm);
	    
	    sponge3d_apply(umx,spo,fdm);
	    sponge3d_apply(uox,spo,fdm);

	    sponge3d_apply(umy,spo,fdm);
	    sponge3d_apply(uoy,spo,fdm);
	}	    

	/*------------------------------------------------------------*/
	/* cut wavefield and save */
	/*------------------------------------------------------------*/
	if(opot) {
		
#ifdef _OPENMP
#pragma omp parallel for			\
    schedule(dynamic,fdm->ompchunk)		\
    private(ix,iy,iz)				\
    shared(fdm,uox,uoy,uoz,idx,idy,idz)
#endif
	    for        (iy=NOP; iy<fdm->nypad-NOP; iy++) {
		for    (ix=NOP; ix<fdm->nxpad-NOP; ix++) {
		    for(iz=NOP; iz<fdm->nzpad-NOP; iz++) {	
			
			qp [iy][ix][iz] = Dx( uox,ix,iy,iz,idx )
			    +             Dy( uoy,ix,iy,iz,idy )
			    +             Dz( uoz,ix,iy,iz,idz );
			
			qsx[iy][ix][iz] = Dy( uoz,ix,iy,iz,idy ) - Dz( uoy,ix,iy,iz,idz );
			qsy[iy][ix][iz] = Dz( uox,ix,iy,iz,idz ) - Dx( uoz,ix,iy,iz,idx );
			qsz[iy][ix][iz] = Dx( uoy,ix,iy,iz,idx ) - Dy( uox,ix,iy,iz,idy );
		    }
		}
	    }

	    if(snap && it%jsnap==0) {
		cut3d(qp ,uc,fdm,acz,acx,acy);
		sf_floatwrite(uc[0][0],sf_n(acx)*sf_n(acy)*sf_n(acz),Fwfl);

		cut3d(qsz,uc,fdm,acz,acx,acy);
		sf_floatwrite(uc[0][0],sf_n(acx)*sf_n(acy)*sf_n(acz),Fwfl);

		cut3d(qsx,uc,fdm,acz,acx,acy);
		sf_floatwrite(uc[0][0],sf_n(acx)*sf_n(acy)*sf_n(acz),Fwfl);

		cut3d(qsy,uc,fdm,acz,acx,acy);
		sf_floatwrite(uc[0][0],sf_n(acx)*sf_n(acy)*sf_n(acz),Fwfl);
	    }
	    
	    lint3d_extract(qp , dd[0],cr);
	    lint3d_extract(qsx, dd[1],cr);
	    lint3d_extract(qsy, dd[2],cr);
	    lint3d_extract(qsz, dd[3],cr);
	    if(it%jdata==0) sf_floatwrite(dd[0],nr*(nc+1),Fdat);

	} else {

	    if(snap && it%jsnap==0) {
		cut3d(uoz,uc,fdm,acz,acx,acy);
		sf_floatwrite(uc[0][0],sf_n(acx)*sf_n(acy)*sf_n(acz),Fwfl);
		
		cut3d(uox,uc,fdm,acz,acx,acy);
		sf_floatwrite(uc[0][0],sf_n(acx)*sf_n(acy)*sf_n(acz),Fwfl);
		
		cut3d(uoy,uc,fdm,acz,acx,acy);
		sf_floatwrite(uc[0][0],sf_n(acx)*sf_n(acy)*sf_n(acz),Fwfl);
	    }
	    
	    lint3d_extract(uoz,dd[0],cr);
	    lint3d_extract(uox,dd[1],cr);
	    lint3d_extract(uoy,dd[2],cr);
	    if(it%jdata==0) sf_floatwrite(dd[0],nr*nc,Fdat);
	}

    }
    if(verb) fprintf(stderr,"\n");    
    
    /*------------------------------------------------------------*/
    /* deallocate arrays */
    
    free(**ww); free(*ww); free(ww);
    free(ss);
    free(rr);
    free(*dd);  free(dd);

    free(**ro);  free(*ro);  free(ro);
    free(**c11); free(*c11); free(c11);
    free(**c22); free(*c22); free(c22);
    free(**c33); free(*c33); free(c33);
    free(**c44); free(*c44); free(c44);
    free(**c55); free(*c55); free(c55);
    free(**c66); free(*c66); free(c66);
    free(**c12); free(*c12); free(c12);
    free(**c13); free(*c13); free(c13);
    free(**c23); free(*c23); free(c23);

    free(**umz); free(*umz); free(umz);
    free(**uoz); free(*uoz); free(uoz);
    free(**upz); free(*upz); free(upz);
    free(**uaz); free(*uaz); free(uaz);

    free(**umx); free(*umx); free(umx);
    free(**uox); free(*uox); free(uox);
    free(**upx); free(*upx); free(upx);
    free(**uax); free(*uax); free(uax);

    free(**umy); free(*umy); free(umy);
    free(**uoy); free(*uoy); free(uoy);
    free(**upy); free(*upy); free(upy);
    free(**uay); free(*uay); free(uay);

    free(**tzz); free(*tzz); free(tzz);
    free(**txx); free(*txx); free(txx);
    free(**tyy); free(*tyy); free(tyy);
    free(**txy); free(*txy); free(txy);
    free(**tyz); free(*tyz); free(tyz);
    free(**tzx); free(*tzx); free(tzx);

    if (snap) {
       free(**uc);  free(*uc);  free(uc);    
    }

    if(opot) {
	free(**qp);  free(*qp);  free(qp);    
	free(**qsx); free(*qsx); free(qsx);
	free(**qsy); free(*qsy); free(qsy);
	free(**qsz); free(*qsz); free(qsz);
    }
    /*------------------------------------------------------------*/


    exit (0);
}
Example #4
0
int main(int argc, char* argv[])
{
    bool verb,fsrf,snap,expl,dabc,abcone,is2D,cfl; 
    bool ignore_interpolation = false; /* ignore interpolation for receivers - makes code faster, but only works when receivers are on grid points */
    int  jsnap,ntsnap,jdata;
    float fmax, safety;
    enum SourceType srctype;
    /* I/O files */
    sf_file Fwav=NULL; /* wavelet   */
    sf_file Fsou=NULL; /* sources   */
    sf_file Frec=NULL; /* receivers */
    sf_file Fvel=NULL; /* velocity  */
    sf_file Fden=NULL; /* density   */
    sf_file Fdat=NULL; /* data      */
    sf_file Fwfl=NULL; /* wavefield */
/*set all y variables to be either zero or null to avoid compiler warnings
about being uninitialized */
    /* cube axes */
    sf_axis at,az,ax,ay=NULL; 
    sf_axis as,ar;

    int     nt,nz,nx,ny=0,ns,nr,nb;
    int     it,iz,ix,iy=0;
    float   dt,dz,dx,dy=0,idz,idx,idy=0;

    
    /* I/O arrays */
    float  *ww=NULL;           /* wavelet   */
    float  *dd=NULL;           /* data      */

    
    /* FD operator size */
    float co,cax,cbx,cay,cby,caz,cbz;

    /* wavefield cut params */
    sf_axis   acz=NULL,acx=NULL,acy=NULL;
    int       nqz,nqx,nqy;
    float     oqz,oqx,oqy;
    float     dqz,dqx,dqy;

    /*------------------------------------------------------------*/
    /* init RSF */
    sf_init(argc,argv);

    /*------------------------------------------------------------*/
    /* OMP parameters */

    if( !sf_getbool("ignint",&ignore_interpolation)) ignore_interpolation = false;
    if(! sf_getbool("verb",&verb)) verb=false; /* verbosity flag */
    if(! sf_getbool("snap",&snap)) snap=false; /* wavefield snapshots flag */
    if(! sf_getbool("free",&fsrf)) fsrf=false; /* free surface flag */
    if(! sf_getbool("expl",&expl)) expl=false; /* "exploding reflector" */
    if(! sf_getbool("dabc",&dabc)) dabc=false; /* absorbing BC */
    if(! sf_getbool("cfl",&cfl)) cfl=false; /* Use CFL check */ 
    if(! sf_getbool("abcone",&abcone)) abcone=false; /* Use Zero-incident boundary condition*/ 
   
    int ttype = 0;
    if(! sf_getint("srctype",&ttype)) ttype = 0; /* source type, see comments */
    if(ttype < 0 || ttype > 1) sf_error("Invalid source type specified");
           srctype = ttype;
    if (cfl) {
        if(! sf_getfloat("fmax",&fmax)) { /* max frequency for cfl check */
            sf_error("CFL: Must specify fmax for CFL check");
        }
        if(! sf_getfloat("safety",&safety) || safety < 0.0) safety= 0.8; /*safety factor for cfl check*/
    }
    /*------------------------------------------------------------*/

    /*------------------------------------------------------------*/
    /* I/O files */
    Fwav = sf_input ("in" ); /* wavelet   */
    Fvel = sf_input ("vel"); /* velocity  */
    Fsou = sf_input ("sou"); /* sources   */
    Frec = sf_input ("rec"); /* receivers */
    Fwfl = sf_output("wfl"); /* wavefield */
    Fdat = sf_output("out"); /* data      */
    Fden = sf_input ("den"); /* density   */

	/* Determine dimensionality, if 2D then axis 3 has n size of 1 */
	sf_axis test = sf_iaxa(Fvel,3);
	if(sf_n(test) == 1) is2D = true;
	else is2D = false;

    /*------------------------------------------------------------*/
    /* axes */
    at = sf_iaxa(Fwav,2); sf_setlabel(at,"t"); if(verb) sf_raxa(at); /* time */
    az = sf_iaxa(Fvel,1); sf_setlabel(az,"z"); if(verb) sf_raxa(az); /* depth */
    ax = sf_iaxa(Fvel,2); sf_setlabel(ax,"x"); if(verb) sf_raxa(ax); /* space */

    as = sf_iaxa(Fsou,2); sf_setlabel(as,"s"); if(verb) sf_raxa(as); /* sources */
    ar = sf_iaxa(Frec,2); sf_setlabel(ar,"r"); if(verb) sf_raxa(ar); /* receivers */

    nt = sf_n(at); dt = sf_d(at);
    nz = sf_n(az); dz = sf_d(az);
    nx = sf_n(ax); dx = sf_d(ax);

    ns = sf_n(as);
    nr = sf_n(ar);

    if(!is2D){ /*If 3D*/
		ay=sf_iaxa(Fvel,3); sf_setlabel(ay,"y"); if(verb) sf_raxa(ay); /*space*/
		ny=sf_n(ay); dy=sf_d(ay);
	}
    /*------------------------------------------------------------*/

    /*------------------------------------------------------------*/
    /* other execution parameters */
    if(! sf_getint("jdata",&jdata)) jdata=1;
    if(snap) {  /* save wavefield every *jsnap* time steps */
    	if(! sf_getint("jsnap",&jsnap)) jsnap=nt;        
    }
    /*------------------------------------------------------------*/
if(is2D){
/* Begin 2d code */
    /* FDM structure */
    fdm2d    fdm=NULL;
    abcone2d abc=NULL;
    sponge   spo=NULL;
    pt2d   *ss=NULL;           /* sources   */
    pt2d   *rr=NULL;           /* receivers */
   
    float **tt=NULL;
    float **ro=NULL;           /* density */
    float **roz=NULL;          /* normalized 1st derivative of density on axis 1 */
    float **rox=NULL;          /* normalized 1st derivative of density on axis 2 */
    float **vp=NULL;           /* velocity */
    float **vt=NULL;           /* temporary vp*vp * dt*dt */

    float **um,**uo,**up,**ua,**ut; /* wavefield: um = U @ t-1; uo = U @ t; up = U @ t+1 */

    /* linear interpolation weights/indices */
    lint2d cs,cr;
    float     **uc=NULL;

    /*------------------------------------------------------------*/
    /* expand domain for FD operators and ABC */
    if( !sf_getint("nb",&nb) || nb<NOP) nb=NOP;

    fdm=fdutil_init(verb,fsrf,az,ax,nb,1);

    /*------------------------------------------------------------*/

    /*------------------------------------------------------------*/
    /* setup output data header */
    sf_oaxa(Fdat,ar,1);

    sf_setn(at,nt/jdata);
    sf_setd(at,dt*jdata);
    sf_oaxa(Fdat,at,2);

    /* setup output wavefield header */
    if(snap) {
	if(!sf_getint  ("nqz",&nqz)) nqz=sf_n(az);
	if(!sf_getint  ("nqx",&nqx)) nqx=sf_n(ax);

	if(!sf_getfloat("oqz",&oqz)) oqz=sf_o(az);
	if(!sf_getfloat("oqx",&oqx)) oqx=sf_o(ax);

    sf_setn(az,fdm->nzpad); sf_seto(az,fdm->ozpad); if(verb) sf_raxa(az);
    sf_setn(ax,fdm->nxpad); sf_seto(ax,fdm->oxpad); if(verb) sf_raxa(ax);
	dqz=sf_d(az);
	dqx=sf_d(ax);

	acz = sf_maxa(nqz,oqz,dqz); sf_raxa(acz);
	acx = sf_maxa(nqx,oqx,dqx); sf_raxa(acx);
	/* check if the imaging window fits in the wavefield domain */

	uc=sf_floatalloc2(sf_n(acz),sf_n(acx));

	ntsnap=0;
	for(it=0; it<nt; it++) {
	    if(it%jsnap==0) ntsnap++;
	}
	sf_setn(at,  ntsnap);
	sf_setd(at,dt*jsnap);
	if(verb) sf_raxa(at);

	sf_oaxa(Fwfl,acz,1);
	sf_oaxa(Fwfl,acx,2);
	sf_oaxa(Fwfl,at, 3);
    }

    if(expl) {
    	ww = sf_floatalloc( 1);
    } else {
    	ww = sf_floatalloc(ns);
    }
    dd = sf_floatalloc(nr);

    /*------------------------------------------------------------*/
    /* setup source/receiver coordinates */
    ss = (pt2d*) sf_alloc(ns,sizeof(*ss)); 
    rr = (pt2d*) sf_alloc(nr,sizeof(*rr)); 

    pt2dread1(Fsou,ss,ns,2); /* read (x,z) coordinates */
    pt2dread1(Frec,rr,nr,2); /* read (x,z) coordinates */

    cs = lint2d_make(ns,ss,fdm);
    cr = lint2d_make(nr,rr,fdm);

    /*------------------------------------------------------------*/
    /* setup FD coefficients */
    idz = 1/dz;
    idx = 1/dx;

    co = C0 * (idx*idx+idz*idz);
    cax= CA *  idx*idx;
    cbx= CB *  idx*idx;
    caz= CA *  idz*idz;
    cbz= CB *  idz*idz;

    /*------------------------------------------------------------*/ 
    tt = sf_floatalloc2(nz,nx); 

    ro  =sf_floatalloc2(fdm->nzpad,fdm->nxpad);
    roz =sf_floatalloc2(fdm->nzpad,fdm->nxpad);
    rox =sf_floatalloc2(fdm->nzpad,fdm->nxpad);
    vp  =sf_floatalloc2(fdm->nzpad,fdm->nxpad); 
    vt  =sf_floatalloc2(fdm->nzpad,fdm->nxpad); 

    /* input density */
    sf_floatread(tt[0],nz*nx,Fden);     expand(tt,ro ,fdm);
    /* normalized density derivatives */
    for    (ix=NOP; ix<fdm->nxpad-NOP; ix++) {
	for(iz=NOP; iz<fdm->nzpad-NOP; iz++) {
	    roz[ix][iz] = DZ(ro,ix,iz,idz) / ro[ix][iz];
	    rox[ix][iz] = DX(ro,ix,iz,idx) / ro[ix][iz];
	}
    }   
    free(*ro); free(ro);

    /* input velocity */
    sf_floatread(tt[0],nz*nx,Fvel );    expand(tt,vp,fdm);
    float vpmax = 0.0; float vpmin = 10000000000000000;
    /* precompute vp^2 * dt^2 */
    for    (ix=0; ix<fdm->nxpad; ix++) {
        for(iz=0; iz<fdm->nzpad; iz++) {
            vt[ix][iz] = vp[ix][iz] * vp[ix][iz] * dt*dt;
            if (vp[ix][iz] < vpmin) vpmin = vp[ix][iz];
            else if (vp[ix][iz] > vpmax) vpmax = vp[ix][iz];
        }
    }
    if (cfl) cfl_acoustic(vpmin,vpmax,dx,-1.0f,dz,dt,fmax,safety,NUM_INTERVALS);
    if(fsrf) { /* free surface */
        for    (ix=0; ix<fdm->nxpad; ix++) {
            for(iz=0; iz<fdm->nb; iz++) {
                vt[ix][iz]=0;
            }
        }
    }

    free(*tt); free(tt);    
    /*------------------------------------------------------------*/

    /*------------------------------------------------------------*/
    /* allocate wavefield arrays */
    um=sf_floatalloc2(fdm->nzpad,fdm->nxpad);
    uo=sf_floatalloc2(fdm->nzpad,fdm->nxpad);
    up=sf_floatalloc2(fdm->nzpad,fdm->nxpad);
    ua=sf_floatalloc2(fdm->nzpad,fdm->nxpad);

    for    (ix=0; ix<fdm->nxpad; ix++) {
	for(iz=0; iz<fdm->nzpad; iz++) {
	    um[ix][iz]=0;
	    uo[ix][iz]=0;
	    up[ix][iz]=0;
	    ua[ix][iz]=0;
	}
    }

    /*------------------------------------------------------------*/
	if (abcone) abc = abcone2d_make(NOP,dt,vp,fsrf,fdm);
    if(dabc) {
	/* one-way abc setup */
	/* sponge abc setup */
	spo = sponge_make(fdm->nb);
    }

    /*------------------------------------------------------------*/
    /* 
     *  MAIN LOOP
     */
    /*------------------------------------------------------------*/
    if(verb) fprintf(stderr,"\n");
    for (it=0; it<nt; it++) {
	if(verb) fprintf(stderr,"%d/%d \r",it,nt);

#pragma omp parallel for				\
    schedule(dynamic) \
    private(ix,iz)					\
    shared(fdm,ua,uo,co,caz,cbz)
	for    (ix=NOP; ix<fdm->nxpad-NOP; ix++) {
	    for(iz=NOP; iz<fdm->nzpad-NOP; iz++) {
		
		/* 4th order Laplacian operator */
		ua[ix][iz] = 
		    co * uo[ix  ][iz  ] + 
		    caz*(uo[ix  ][iz-1] + uo[ix  ][iz+1]) +
		    cbz*(uo[ix  ][iz-2] + uo[ix  ][iz+2]) ; 
		/* density term */
        /*ua[ix][iz] -= (
		    DZ(uo,ix,iz,idz) * roz[ix][iz] +
		    DX(uo,ix,iz,idx) * rox[ix][iz] );
        */
	    }
	}   

#pragma omp parallel for				\
    schedule(dynamic)			\
    private(ix,iz)					\
    shared(fdm,ua,uo,co,cax,cbx)
	for    (ix=NOP; ix<fdm->nxpad-NOP; ix++) {
	    for(iz=NOP; iz<fdm->nzpad-NOP; iz++) {
        ua[ix][iz] =  ua[ix][iz] + 
		    cax*(uo[ix-1][iz  ] + uo[ix+1][iz  ]) +
		    cbx*(uo[ix-2][iz  ] + uo[ix+2][iz  ]);
            }
    }

	/* inject acceleration source */
    if (srctype == ACCELERATION){
            if(expl) {
                sf_floatread(ww, 1,Fwav);
                lint2d_inject1(ua,ww[0],cs);
            } else {
                  sf_floatread(ww,ns,Fwav);
                  lint2d_inject(ua,ww,cs);
            }
    }

	/* step forward in time */
#pragma omp parallel for	    \
    schedule(dynamic) \
    private(ix,iz)		    \
    shared(fdm,ua,uo,um,up,vt)
	for    (ix=0; ix<fdm->nxpad; ix++) {
	    for(iz=0; iz<fdm->nzpad; iz++) {
		up[ix][iz] = 2*uo[ix][iz] 
		    -          um[ix][iz] 
		    +          ua[ix][iz] * vt[ix][iz];
	    }
	}

    if(srctype == DISPLACEMENT){
            if(expl) {
                sf_floatread(ww, 1,Fwav);
                lint2d_inject1(up,ww[0],cs);
            } else {
                  sf_floatread(ww,ns,Fwav);
                  lint2d_inject(up,ww,cs);
            }
    }

    
	/* circulate wavefield arrays */
	ut=um;
	um=uo;
	uo=up;
	up=ut;
    
    if (abcone) abcone2d_apply(uo,um,NOP,abc,fdm);
	if(dabc) {
	    /* one-way abc apply */
	    sponge2d_apply(um,spo,fdm);
	    sponge2d_apply(uo,spo,fdm);
	    sponge2d_apply(up,spo,fdm);
	}

	/* extract data */
    if(ignore_interpolation){
        cut2d_extract(uo,dd,cr);
    } else {
	    lint2d_extract(uo,dd,cr);
    }

	if(snap && it%jsnap==0) {
	    cut2d(uo,uc,fdm,acz,acx);
	    sf_floatwrite(uc[0],sf_n(acz)*sf_n(acx),Fwfl);
	}
	if(        it%jdata==0) 
	    sf_floatwrite(dd,nr,Fdat);
    }
    if(verb) fprintf(stderr,"\n");    

    /*------------------------------------------------------------*/
    /* deallocate arrays */
    free(*um); free(um);
    free(*up); free(up);
    free(*uo); free(uo);
    free(*ua); free(ua);
    if(snap) { free(*uc); free(uc); }

    free(*rox); free(rox);
    free(*roz); free(roz);
    free(*vp);  free(vp);
    free(*vt);  free(vt);

    free(ww);
    free(ss);
    free(rr);
    free(dd);


    exit (0);
} else {
    /* FDM structure */
    fdm3d    fdm=NULL;
    abcone3d abc=NULL;
    sponge   spo=NULL;

    /* I/O arrays */
    pt3d   *ss=NULL;           /* sources   */
    pt3d   *rr=NULL;           /* receivers */
	/* Non-universal arrays */
    float***tt=NULL;
    float***ro=NULL;           /* density */
    float***roz=NULL;          /* normalized 1st derivative of density on axis 1 */
    float***rox=NULL;          /* normalized 1st derivative of density on axis 2 */
    float***roy=NULL;          /* normalized 1st derivative of density on axis 3 */
    float***vp=NULL;           /* velocity */
    float***vt=NULL;           /* temporary vp*vp * dt*dt */

    float***um,***uo,***up,***ua,***ut; /* wavefield: um = U @ t-1; uo = U @ t; up = U @ t+1 */

    /* linear interpolation weights/indices */
    lint3d cs,cr;

	/* Wavefield cut params that are not universal */
    float     ***uc=NULL;


    /*------------------------------------------------------------*/
    /* expand domain for FD operators and ABC */
    if( !sf_getint("nb",&nb) || nb<NOP) nb=NOP;

    fdm=fdutil3d_init(verb,fsrf,az,ax,ay,nb,1);

    sf_setn(az,fdm->nzpad); sf_seto(az,fdm->ozpad); if(verb) sf_raxa(az);
    sf_setn(ax,fdm->nxpad); sf_seto(ax,fdm->oxpad); if(verb) sf_raxa(ax);
    sf_setn(ay,fdm->nypad); sf_seto(ay,fdm->oypad); if(verb) sf_raxa(ay);
    /*------------------------------------------------------------*/

    /*------------------------------------------------------------*/
    /* setup output data header */
    sf_oaxa(Fdat,ar,1);

    sf_setn(at,nt/jdata);
    sf_setd(at,dt*jdata);
    sf_oaxa(Fdat,at,2);

    /* setup output wavefield header */
    if(snap) {
	if(!sf_getint  ("nqz",&nqz)) nqz=sf_n(az);
	if(!sf_getint  ("nqx",&nqx)) nqx=sf_n(ax);
	if(!sf_getint  ("nqy",&nqy)) nqy=sf_n(ay);

	if(!sf_getfloat("oqz",&oqz)) oqz=sf_o(az);
	if(!sf_getfloat("oqx",&oqx)) oqx=sf_o(ax);
	if(!sf_getfloat("oqy",&oqy)) oqy=sf_o(ay);

	dqz=sf_d(az);
	dqx=sf_d(ax);
	dqy=sf_d(ay);

	acz = sf_maxa(nqz,oqz,dqz); sf_raxa(acz);
	acx = sf_maxa(nqx,oqx,dqx); sf_raxa(acx);
	acy = sf_maxa(nqy,oqy,dqy); sf_raxa(acy);
	/* check if the imaging window fits in the wavefield domain */

	uc=sf_floatalloc3(sf_n(acz),sf_n(acx),sf_n(acy));

	ntsnap=0;
	for(it=0; it<nt; it++) {
	    if(it%jsnap==0) ntsnap++;
	}
	sf_setn(at,  ntsnap);
	sf_setd(at,dt*jsnap);
	if(verb) sf_raxa(at);

	sf_oaxa(Fwfl,acz,1);
	sf_oaxa(Fwfl,acx,2);
	sf_oaxa(Fwfl,acy,3);
	sf_oaxa(Fwfl,at, 4);
    }

    if(expl) {
	ww = sf_floatalloc( 1);
    } else {
	ww = sf_floatalloc(ns);
    }
    dd = sf_floatalloc(nr);

    /*------------------------------------------------------------*/
    /* setup source/receiver coordinates */
    ss = (pt3d*) sf_alloc(ns,sizeof(*ss)); 
    rr = (pt3d*) sf_alloc(nr,sizeof(*rr)); 

    pt3dread1(Fsou,ss,ns,3); /* read (x,y,z) coordinates */
    pt3dread1(Frec,rr,nr,3); /* read (x,y,z) coordinates */

    cs = lint3d_make(ns,ss,fdm);
    cr = lint3d_make(nr,rr,fdm);

    /*------------------------------------------------------------*/
    /* setup FD coefficients */
    idz = 1/dz;
    idx = 1/dx;
    idy = 1/dy;

    co = C0 * (idx*idx+idy*idy+idz*idz);
    cax= CA *  idx*idx;
    cbx= CB *  idx*idx;
    cay= CA *  idy*idy;
    cby= CB *  idy*idy;
    caz= CA *  idz*idz;
    cbz= CB *  idz*idz;

    /*------------------------------------------------------------*/ 
    tt = sf_floatalloc3(nz,nx,ny); 

    ro  =sf_floatalloc3(fdm->nzpad,fdm->nxpad,fdm->nypad);
    roz =sf_floatalloc3(fdm->nzpad,fdm->nxpad,fdm->nypad);
    rox =sf_floatalloc3(fdm->nzpad,fdm->nxpad,fdm->nypad);
    roy =sf_floatalloc3(fdm->nzpad,fdm->nxpad,fdm->nypad);
    vp  =sf_floatalloc3(fdm->nzpad,fdm->nxpad,fdm->nypad); 
    vt  =sf_floatalloc3(fdm->nzpad,fdm->nxpad,fdm->nypad); 

    /* input density */
    sf_floatread(tt[0][0],nz*nx*ny,Fden);     expand3d(tt,ro ,fdm);

    /* normalized density derivatives */
    for        (iy=NOP; iy<fdm->nypad-NOP; iy++) {
	for    (ix=NOP; ix<fdm->nxpad-NOP; ix++) {
	    for(iz=NOP; iz<fdm->nzpad-NOP; iz++) {
		roz[iy][ix][iz] = DZ3(ro,ix,iy,iz,idz) / ro[iy][ix][iz];
		rox[iy][ix][iz] = DX3(ro,ix,iy,iz,idx) / ro[iy][ix][iz];
		roy[iy][ix][iz] = DY3(ro,ix,iy,iz,idy) / ro[iy][ix][iz];
	    }
	}   
    }
    free(**ro);  free(*ro); free(ro);  

    /* input velocity */
    sf_floatread(tt[0][0],nz*nx*ny,Fvel );    expand3d(tt,vp,fdm);
    /* precompute vp^2 * dt^2 */
    float vpmin = 1000000000000; float vpmax = 0.0;
    for        (iy=0; iy<fdm->nypad; iy++) {
        for    (ix=0; ix<fdm->nxpad; ix++) {
            for(iz=0; iz<fdm->nzpad; iz++) {
                float vpt = vp[iy][ix][iz];
                vt[iy][ix][iz] = vp[iy][ix][iz] * vp[iy][ix][iz] * dt*dt;
                if (vpt > vpmax) vpmax = vpt;
                else if (vpt < vpmin) vpmin = vpt;
            }
        }
    }

    if (cfl) cfl_acoustic(vpmin,vpmax,dx,dy,dz,dt,fmax,safety,NUM_INTERVALS);

    if(fsrf) { /* free surface */
	for        (iy=0; iy<fdm->nypad; iy++) {
	    for    (ix=0; ix<fdm->nxpad; ix++) {
		for(iz=0; iz<fdm->nb; iz++) {
		    vt[iy][ix][iz]=0;
		}
	    }
	}
    }

    free(**tt);  free(*tt); free(tt);    
    /*------------------------------------------------------------*/

    /*------------------------------------------------------------*/
    /* allocate wavefield arrays */
    um=sf_floatalloc3(fdm->nzpad,fdm->nxpad,fdm->nypad);
    uo=sf_floatalloc3(fdm->nzpad,fdm->nxpad,fdm->nypad);
    up=sf_floatalloc3(fdm->nzpad,fdm->nxpad,fdm->nypad);
    ua=sf_floatalloc3(fdm->nzpad,fdm->nxpad,fdm->nypad);

    for        (iy=0; iy<fdm->nypad; iy++) {
	for    (ix=0; ix<fdm->nxpad; ix++) {
	    for(iz=0; iz<fdm->nzpad; iz++) {
		um[iy][ix][iz]=0;
		uo[iy][ix][iz]=0;
		up[iy][ix][iz]=0;
		ua[iy][ix][iz]=0;
	    }
	}
    }

    /*------------------------------------------------------------*/
	if (abcone) abc = abcone3d_make(NOP,dt,vp,fsrf,fdm);
    if(dabc) {
	/* one-way abc setup */
	/* sponge abc setup */
	spo = sponge_make(fdm->nb);
    }

    /*------------------------------------------------------------*/
    /* 
     *  MAIN LOOP
     */
    /*------------------------------------------------------------*/
    if(verb) fprintf(stderr,"\n");
    for (it=0; it<nt; it++) {
	if(verb) fprintf(stderr,"%d/%d \r",it,nt);

#pragma omp parallel for					\
    schedule(dynamic) \
    private(ix,iy,iz)						\
    shared(fdm,ua,uo,co,cax,cay,caz,cbx,cby,cbz,idx,idy,idz)
	for        (iy=NOP; iy<fdm->nypad-NOP; iy++) {
	    for    (ix=NOP; ix<fdm->nxpad-NOP; ix++) {
		for(iz=NOP; iz<fdm->nzpad-NOP; iz++) {
		    
		    /* 4th order Laplacian operator */
		    ua[iy][ix][iz] = 
			co * uo[iy  ][ix  ][iz  ] + 
			caz*(uo[iy  ][ix  ][iz-1] + uo[iy  ][ix  ][iz+1]) +
			cbz*(uo[iy  ][ix  ][iz-2] + uo[iy  ][ix  ][iz+2]);
		    
		    /* density term */
		    /*ua[iy][ix][iz] -= (
			DZ3(uo,ix,iy,iz,idz) * roz[iy][ix][iz] +
			DX3(uo,ix,iy,iz,idx) * rox[iy][ix][iz] +
			DY3(uo,ix,iy,iz,idy) * roy[iy][ix][iz] );
            */
		 }
	    }   
	}

#pragma omp parallel for					\
    schedule(dynamic) \
    private(ix,iy,iz)						\
    shared(fdm,ua,uo,co,cax,cay,caz,cbx,cby,cbz,idx,idy,idz)
	for        (iy=NOP; iy<fdm->nypad-NOP; iy++) {
	    for    (ix=NOP; ix<fdm->nxpad-NOP; ix++) {
		    for(iz=NOP; iz<fdm->nzpad-NOP; iz++) {
		    ua[iy][ix][iz] = ua[iy][ix][iz] + 
			cax*(uo[iy  ][ix-1][iz  ] + uo[iy  ][ix+1][iz  ]) +
			cbx*(uo[iy  ][ix-2][iz  ] + uo[iy  ][ix+2][iz  ]) ;
            }
        }
    }

#pragma omp parallel for					\
    schedule(dynamic) \
    private(ix,iy,iz)						\
    shared(fdm,ua,uo,co,cax,cay,caz,cbx,cby,cbz,idx,idy,idz)
	for        (iy=NOP; iy<fdm->nypad-NOP; iy++) {
	    for    (ix=NOP; ix<fdm->nxpad-NOP; ix++) {
		    for(iz=NOP; iz<fdm->nzpad-NOP; iz++) {
		    ua[iy][ix][iz] = ua[iy][ix][iz] + 
			cay*(uo[iy-1][ix  ][iz  ] + uo[iy+1][ix  ][iz  ]) +
			cby*(uo[iy-2][ix  ][iz  ] + uo[iy+2][ix  ][iz  ]);
            }
        }
    }

	/* inject acceleration source */
    if (srctype == ACCELERATION){
        if(expl) {
            sf_floatread(ww, 1,Fwav);
            lint3d_inject1(ua,ww[0],cs);
        } else {
            sf_floatread(ww,ns,Fwav);	
            lint3d_inject(ua,ww,cs);
        }
   }

	/* step forward in time */
#pragma omp parallel for	    \
    schedule(static) \
    private(ix,iy,iz)		    \
    shared(fdm,ua,uo,um,up,vt)
	for        (iy=0; iy<fdm->nypad; iy++) {
	    for    (ix=0; ix<fdm->nxpad; ix++) {
		for(iz=0; iz<fdm->nzpad; iz++) {
		    up[iy][ix][iz] = 2*uo[iy][ix][iz] 
			-              um[iy][ix][iz] 
			+              ua[iy][ix][iz] * vt[iy][ix][iz];
		}
	    }
	}

    if (srctype == DISPLACEMENT) {
        if(expl) {
            sf_floatread(ww, 1,Fwav);
            lint3d_inject1(up,ww[0],cs);
        } else {
            sf_floatread(ww,ns,Fwav);	
            lint3d_inject(up,ww,cs);
        }
    }
	/* circulate wavefield arrays */
	ut=um;
	um=uo;
	uo=up;
	up=ut;

    if(abcone) abcone3d_apply(uo,um,NOP,abc,fdm);
	if(dabc) {
	    /* one-way abc apply */
	    sponge3d_apply(um,spo,fdm);
	    sponge3d_apply(uo,spo,fdm);
	    sponge3d_apply(up,spo,fdm);
	}

	/* extract data */
    if (ignore_interpolation) {
	    cut3d_extract(uo,dd,cr);
    } else {
	    lint3d_extract(uo,dd,cr);
    }

	if(snap && it%jsnap==0) {
	    cut3d(uo,uc,fdm,acz,acx,acy);
	    sf_floatwrite(uc[0][0],sf_n(acz)*sf_n(acx)*sf_n(acy),Fwfl);
	}
	if(it%jdata==0) 
	    sf_floatwrite(dd,nr,Fdat);
    }
    if(verb) fprintf(stderr,"\n");    

    /*------------------------------------------------------------*/
    /* deallocate arrays */
    free(**um); free(*um); free(um);
    free(**up); free(*up); free(up);
    free(**uo); free(*uo); free(uo);
    free(**ua); free(*ua); free(ua);
    if (snap) { free(**uc); free(*uc); free(uc); }

    free(**rox); free(*rox); free(rox);
    free(**roy); free(*roy); free(roy);
    free(**roz); free(*roz); free(roz);

    free(**vp); free(*vp); free(vp);
    free(**vt); free(*vt); free(vt);

    free(ss);
    free(rr);
    free(dd);
    free(ww);

    exit (0);
    }
}