Exemplo n.º 1
0
int main(int argc, char* argv[])
{
    bool verb,fsrf,snap,expl; 
    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   */
    pt2d   *ss=NULL;           /* sources   */
    pt2d   *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 **ro1=NULL;          /* normalized 1st derivative of density on axis 1 */
    float **ro2=NULL;          /* normalized 1st derivative of density on axis 2 */

    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 **bum,**buo,**bup,**bua,**but; /* wavefield: um = U @ t-1; uo = U @ t; up = U @ t+1 */
    float **sum,**suo,**sup,**sua,**sut; /* wavefield: um = U @ t-1; uo = U @ t; up = U @ t+1 */

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

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

    fdm2d    fdm;
    abcone2d abc;     /* abc */
    sponge spo;

    /* FD operator size */
    float co,ca2,cb2,ca1,cb1;

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

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

    /*------------------------------------------------------------*/
    /* 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("free",&fsrf)) fsrf=false; /* free surface flag */
    if(! sf_getbool("expl",&expl)) expl=false; /* "exploding reflector" */

    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); /* depth */
    a2 = sf_iaxa(Fvel,2); sf_setlabel(a2,"x"); if(verb) sf_raxa(a2); /* space */

    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);

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


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

    /* 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_getfloat("oqz",&oqz)) oqz=sf_o(a1);
	if(!sf_getfloat("oqx",&oqx)) oqx=sf_o(a2);
	dqz=sf_d(a1);
	dqx=sf_d(a2);

	ac1 = sf_maxa(nqz,oqz,dqz);
	ac2 = sf_maxa(nqx,oqx,dqx);

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

	uc=sf_floatalloc2(sf_n(ac1),sf_n(ac2));

	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,at, 3);

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

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

    fdm=fdutil_init(verb,fsrf,a1,a2,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);

    /*------------------------------------------------------------*/
    if(expl) ww = sf_floatalloc( 1);
    else     ww = sf_floatalloc(ns);
    bdd =sf_floatalloc(nr);
    sdd =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 */
    dt2 =    dt*dt;
    id1 = 1/d1;
    id2 = 1/d2;

    co = C0 * (id2*id2+id1*id1);
    ca2= CA *  id2*id2;
    cb2= CB *  id2*id2;
    ca1= CA *          id1*id1;
    cb1= CB *          id1*id1;

    /*------------------------------------------------------------*/ 
    /* input density */
    roin=sf_floatalloc2(n1,   n2   ); 
    ro  =sf_floatalloc2(fdm->nzpad,fdm->nxpad); 
    ro1 =sf_floatalloc2(fdm->nzpad,fdm->nxpad);
    ro2 =sf_floatalloc2(fdm->nzpad,fdm->nxpad);

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

    /* normalized density derivatives */
    for    (i2=NOP; i2<fdm->nxpad-NOP; i2++) {
	for(i1=NOP; i1<fdm->nzpad-NOP; i1++) {
	    ro1[i2][i1] = D1(ro,i2,i1,id1) / ro[i2][i1];
	    ro2[i2][i1] = D2(ro,i2,i1,id2) / ro[i2][i1];
	}
    }

    free(*roin); free(roin);

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

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

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

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

    /*------------------------------------------------------------*/
    /* allocate wavefield arrays */
    bum=sf_floatalloc2(fdm->nzpad,fdm->nxpad);
    buo=sf_floatalloc2(fdm->nzpad,fdm->nxpad);
    bup=sf_floatalloc2(fdm->nzpad,fdm->nxpad);
    bua=sf_floatalloc2(fdm->nzpad,fdm->nxpad);

    sum=sf_floatalloc2(fdm->nzpad,fdm->nxpad);
    suo=sf_floatalloc2(fdm->nzpad,fdm->nxpad);
    sup=sf_floatalloc2(fdm->nzpad,fdm->nxpad);
    sua=sf_floatalloc2(fdm->nzpad,fdm->nxpad);

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

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

    /*------------------------------------------------------------*/
    /* one-way abc setup */
    abc = abcone2d_make(NOP,dt,vp,fsrf,fdm);
    /* 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,"\b\b\b\b\b%d",it);
	
#ifdef _OPENMP
#pragma omp parallel for schedule(dynamic,fdm->ompchunk) private(i2,i1) shared(fdm,bua,buo,sua,suo,co,ca2,ca1,cb2,cb1,id2,id1)
#endif
	for    (i2=NOP; i2<fdm->nxpad-NOP; i2++) {
	    for(i1=NOP; i1<fdm->nzpad-NOP; i1++) {
		
		/* 4th order Laplacian operator */
		bua[i2][i1] = 
		    co * buo[i2  ][i1  ] + 
		    ca2*(buo[i2-1][i1  ] + buo[i2+1][i1  ]) +
		    cb2*(buo[i2-2][i1  ] + buo[i2+2][i1  ]) +
		    ca1*(buo[i2  ][i1-1] + buo[i2  ][i1+1]) +
		    cb1*(buo[i2  ][i1-2] + buo[i2  ][i1+2]);
		sua[i2][i1] = 
		    co * suo[i2  ][i1  ] + 
		    ca2*(suo[i2-1][i1  ] + suo[i2+1][i1  ]) +
		    cb2*(suo[i2-2][i1  ] + suo[i2+2][i1  ]) +
		    ca1*(suo[i2  ][i1-1] + suo[i2  ][i1+1]) +
		    cb1*(suo[i2  ][i1-2] + suo[i2  ][i1+2]);
		
		/* density term */
		bua[i2][i1] -= (
		    D1(buo,i2,i1,id1) * ro1[i2][i1] +
		    D2(buo,i2,i1,id2) * ro2[i2][i1] );
		sua[i2][i1] -= (
		    D1(suo,i2,i1,id1) * ro1[i2][i1] +
		    D2(suo,i2,i1,id2) * ro2[i2][i1] );
	    }
	}   
	
	/* inject acceleration source */
	if(expl) {
	    sf_floatread(ww, 1,Fwav);
	    lint2d_inject1(bua,ww[0],cs);
	} else {
	    sf_floatread(ww,ns,Fwav);	
	    lint2d_inject(bua,ww,cs);
	}

	/* single scattering */
#ifdef _OPENMP
#pragma omp parallel for schedule(dynamic,ompchunk) private(i2,i1) shared(fdm,buo,sua,rf)
#endif
	for     (i2=0; i2<fdm->nxpad; i2++) {
	    for (i1=0; i1<fdm->nzpad; i1++) {
		sua[i2][i1] -= bua[i2][i1] * 2*rf[i2][i1];
	    }
	}

	/* step forward in time */
#ifdef _OPENMP
#pragma omp parallel for schedule(dynamic,fdm->ompchunk) private(i2,i1) shared(fdm,bua,buo,bum,bup,sua,suo,sum,sup,vt,dt2)
#endif
	for    (i2=0; i2<fdm->nxpad; i2++) {
	    for(i1=0; i1<fdm->nzpad; i1++) {
		bup[i2][i1] = 2*buo[i2][i1] 
		    -           bum[i2][i1] 
		    +           bua[i2][i1] * vt[i2][i1];

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

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

	sut=sum;
	sum=suo;
	suo=sup;
	sup=sut;
	
	/* one-way abc apply*/
	abcone2d_apply(buo,bum,NOP,abc,fdm);
	sponge2d_apply(bum,        spo,fdm);
	sponge2d_apply(buo,        spo,fdm);

	abcone2d_apply(suo,sum,NOP,abc,fdm);
	sponge2d_apply(sum,        spo,fdm);
	sponge2d_apply(suo,        spo,fdm);

	/* extract data at receivers */
	lint2d_extract(buo,bdd,cr);
	lint2d_extract(suo,sdd,cr);
	if(        it%jdata==0) {
	    sf_floatwrite(bdd,nr,Fdat);
	    sf_floatwrite(sdd,nr,Flid);
	}

	/* extract wavefield in the "box" */
	if(snap && it%jsnap==0) {
	    cut2d(buo,uc,fdm,ac1,ac2);
	    sf_floatwrite(uc[0],sf_n(ac1)*sf_n(ac2),Fwfl);

	    cut2d(suo,uc,fdm,ac1,ac2);
	    sf_floatwrite(uc[0],sf_n(ac1)*sf_n(ac2),Fliw);
	}

    }
    if(verb) fprintf(stderr,"\n");    

    exit (0);
}
Exemplo n.º 2
0
int main(int argc, char* argv[])
{
    bool verb,fsrf,snap,expl,dabc; 
    int  jsnap,ntsnap,jdata;

    /* OMP parameters */
#ifdef _OPENMP
    int ompnth;
#endif 

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

    sf_file Fmag=NULL; /* magnetic permitivity */
    sf_file Fele=NULL; /* electric susceptibility */
    sf_file Fcdt=NULL; /* conductivity */

    sf_file Fdat=NULL; /* data      */
    sf_file Fwfl=NULL; /* wavefield */
    /*------------------------------------------------------------*/ 	
    /*------------------------------------------------------------*/
    /* cube axes */
    sf_axis at,az,ax;
    sf_axis as,ar;

    int     nt,nz,nx,ns,nr,nb;
    int     it,iz,ix;
    float   dt,dz,dx,idz,idx;

    /* FDM structure */
    fdm2d    fdm=NULL;
    abcone2d abc=NULL;
    sponge   spo=NULL;

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

    float **tt=NULL;

    float **vel=NULL;           /* velocity */
    float **mag=NULL;
    float **ele=NULL;
    float **cdt=NULL;

    float **cdtele=NULL;        /* temporary cdt*dt/2*ele */
    float **magele=NULL;	/* temporary dt*dt/mag*ele */
    /*------------------------------------------------------------*/

    /*------------------------------------------------------------*/
    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;

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

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

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

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

    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 */
    /*------------------------------------------------------------*/

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

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

    /*------------------------------------------------------------*/
    Fmag = sf_input ("mag"); /* magnetic permitivity */
    Fele = sf_input ("ele"); /* electric susceptibility */
    Fcdt = sf_input ("cdt"); /* conductivity */
    /*------------------------------------------------------------*/
	    
    /*------------------------------------------------------------*/
    /* axes */
    at = sf_iaxa(Fwav,2); sf_setlabel(at,"t"); if(verb) sf_raxa(at); /* time */
    az = sf_iaxa(Fmag,1); sf_setlabel(az,"z"); if(verb) sf_raxa(az); /* depth */
    ax = sf_iaxa(Fmag,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);
    /*------------------------------------------------------------*/

    /*------------------------------------------------------------*/
    /* 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;        
    }
    /*------------------------------------------------------------*/

    /*------------------------------------------------------------*/
    /* expand domain for FD operators and ABC 
       we exclude some of the code to maintain the same size of velocity model*/
    if( !sf_getint("nb",&nb) || nb<NOP) nb=NOP;

    fdm=fdutil_init(verb,fsrf,az,ax,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);*/
    /*------------------------------------------------------------*/

    /*------------------------------------------------------------*/
    /* 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);

	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); 

    vel = sf_floatalloc2(fdm->nzpad,fdm->nxpad); 
    mag = sf_floatalloc2(fdm->nzpad,fdm->nxpad);
    ele = sf_floatalloc2(fdm->nzpad,fdm->nxpad);
    cdt = sf_floatalloc2(fdm->nzpad,fdm->nxpad); 

    cdtele =sf_floatalloc2(fdm->nzpad,fdm->nxpad);
    magele =sf_floatalloc2(fdm->nzpad,fdm->nxpad);
    /*------------------------------------------------------------*/

    /*------------------------------------------------------------*/
    /* input magnetic susceptibility*/
    sf_floatread(tt[0],nz*nx,Fmag );    expand(tt,mag,fdm);

    /* input electric susceptibility*/
    sf_floatread(tt[0],nz*nx,Fele );    expand(tt,ele,fdm);
    
    /* input conductivity*/
    sf_floatread(tt[0],nz*nx,Fcdt );    expand(tt,cdt,fdm);

    /*------------------------------------------------------------*/
    /* cdtele = sigma*dt/2*epsilon */
    /* magele = dt*dt/mu*epsilon */
    for    (ix=0; ix<fdm->nxpad; ix++) {
	for(iz=0; iz<fdm->nzpad; iz++) {
	    cdtele[ix][iz] = cdt[ix][iz]*dt/(2*(ele[ix][iz]));
	    magele[ix][iz]  = dt*dt/(mag[ix][iz]*ele[ix][iz]);
	    vel[ix][iz] = 1./(sqrt(mag[ix][iz]*ele[ix][iz]));
	}
    }
    if(fsrf) { /* free surface */
	for    (ix=0; ix<fdm->nxpad; ix++) {
	    for(iz=0; iz<fdm->nb; iz++) {
		cdtele[ix][iz]=0;
		magele[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(dabc) {
	/* one-way abc setup */
	abc = abcone2d_make(NOP,dt,vel,fsrf,fdm);
	/* 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,"\b\b\b\b\b%d",it);

#ifdef _OPENMP
#pragma omp parallel for				\
    schedule(dynamic,fdm->ompchunk)			\
    private(ix,iz)					\
    shared(fdm,ua,uo,co,cax,caz,cbx,cbz,idx,idz)
#endif
	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  ] + 
		    cax*(uo[ix-1][iz  ] + uo[ix+1][iz  ]) +
		    cbx*(uo[ix-2][iz  ] + uo[ix+2][iz  ]) +
		    caz*(uo[ix  ][iz-1] + uo[ix  ][iz+1]) +
		    cbz*(uo[ix  ][iz-2] + uo[ix  ][iz+2]);
		
	    }
	}   

	/* inject acceleration source */
	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 */
#ifdef _OPENMP
#pragma omp parallel for	    \
    schedule(dynamic,fdm->ompchunk) \
    private(ix,iz)		    \
    shared(fdm,ua,uo,um,up,cdtele,magele)
#endif
	for    (ix=0; ix<fdm->nxpad; ix++) {
	    for(iz=0; iz<fdm->nzpad; iz++) {
	   	up[ix][iz] = (2*uo[ix][iz] 
			   - (1-cdtele[ix][iz])*um[ix][iz] 
			   + ua[ix][iz]*(magele[ix][iz]))/(1+cdtele[ix][iz]);
	    }
	}
	/* circulate wavefield arrays */
	ut=um;
	um=uo;
	uo=up;
	up=ut;
	
	if(dabc) {
	    /* one-way abc apply */
	    abcone2d_apply(uo,um,NOP,abc,fdm);
	    sponge2d_apply(um,spo,fdm);
	    sponge2d_apply(uo,spo,fdm);
	    sponge2d_apply(up,spo,fdm);
	}

	/* extract data */
	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);
    free(*uc); free(uc);

    free(*mag); free(mag);
    free(*ele); free(ele);
    free(*cdt); free(cdt);
    free(*vel); free(vel);  
    free(*cdtele); free(cdtele);
    free(*magele);  free(magele);

    /*------------------------------------------------------------*/
    free(ww);
    free(ss);
    free(rr);
    free(dd);
    /*------------------------------------------------------------*/

    sf_close();
    exit (0);
}
Exemplo n.º 3
0
int main(int argc, char* argv[])
{
    bool verb,fsrf,snap,expl,dabc,sout,uses;
    int  jsnap,ntsnap,jdata;
    char *atype;
#ifdef _OPENMP
    int ompnth=1;
#endif

    /* 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 Fang=NULL; /* angles    */
    sf_file Fdat=NULL; /* data      */
    sf_file Fwfl=NULL; /* wavefield */

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

    int     nt,nz,nx,ns,nr,nb;
    int     it,iz,ix;
    float   dt,dz,dx,dt2;

    /* FDM structure */
    fdm2d    fdm=NULL;
    abcone2d abc=NULL;
    sponge   spo=NULL;

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

    float **tt=NULL;
    float **vp=NULL;           /* velocity */

    float **vpn=NULL;
    float **vpz=NULL;
    float **vpx=NULL;
    float **vsz=NULL;

    float **tht=NULL,**sit=NULL,**cot=NULL;
    float st,ct;

    float **pm=NULL,**po=NULL,**pp=NULL,**pa=NULL,**pt=NULL; /*      main wavefield */
    float **qm=NULL,**qo=NULL,**qp=NULL,**qa=NULL,**qt=NULL; /* auxiliary wavefield */
    float **sf=NULL; /* "stress" field */

    /* linear inteppolation weights/indices */
    lint2d cs,cr;

    /* FD operator size */
    float cox,cax,cbx,c1x,c2x;
    float coz,caz,cbz,c1z,c2z;

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

    float H1p,H2p,H1q,H2q;

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

    /* select anisotropy model */
    if (NULL == (atype = sf_getstring("atype"))) atype = "i";
    switch(atype[0]) {
	case 't':
	    sf_warning("TTI model");
	    break;

	case 'v':
	    sf_warning("VTI model");
	    break;

	case 'i':
	default:
	    sf_warning("ISO model");
	    break;
    }

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

    /*------------------------------------------------------------*/
    if(! sf_getbool("verb",&verb)) verb=false; /* verbosity */
    if(! sf_getbool("snap",&snap)) snap=false; /* wavefield snapshots */
    if(! sf_getbool("free",&fsrf)) fsrf=false; /* free surface */
    if(! sf_getbool("expl",&expl)) expl=false; /* "exploding reflector" */
    if(! sf_getbool("dabc",&dabc)) dabc=false; /* absorbing BC */
    if(! sf_getbool("sout",&sout)) sout=false; /* stress output */
    if(! sf_getbool("uses",&uses)) uses=false; /* use vsz */
    /*------------------------------------------------------------*/

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

    /*------------------------------------------------------------*/
    /* 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);
    /*------------------------------------------------------------*/

    /*------------------------------------------------------------*/
    /* 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;        
    }
    /*------------------------------------------------------------*/

    /*------------------------------------------------------------*/
    /* 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);

	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 */

	pc=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);
    }

    /*------------------------------------------------------------*/
    /* 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);

    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);
    /*------------------------------------------------------------*/

    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 */
    cox = C0 / (dx*dx);
    cax = CA / (dx*dx);
    cbx = CB / (dx*dx);
    c1x = C1 / dx;
    c2x = C2 / dx;

    coz = C0 / (dz*dz);
    caz = CA / (dz*dz);
    cbz = CB / (dz*dz);
    c1z = C1 / dz;
    c2z = C2 / dz;

    /* precompute dt^2*/
    dt2 = dt*dt;

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

    /* input velocity */
    vp  =sf_floatalloc2(fdm->nzpad,fdm->nxpad); 

    vpz =sf_floatalloc2(fdm->nzpad,fdm->nxpad); 
    sf_floatread(tt[0],nz*nx,Fvel ); 
    expand(tt,vpz,fdm); /* VPz */

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

    if(atype[0] != 'i') {
	vpn =sf_floatalloc2(fdm->nzpad,fdm->nxpad);     
	sf_floatread(tt[0],nz*nx,Fvel );    
	expand(tt,vpn,fdm); /* VPn */

	vpx =sf_floatalloc2(fdm->nzpad,fdm->nxpad); 
	sf_floatread(tt[0],nz*nx,Fvel );    
	expand(tt,vpx,fdm); /* VPx */

	for    (ix=0; ix<fdm->nxpad; ix++) {
	    for(iz=0; iz<fdm->nzpad; iz++) {	    
		vpn[ix][iz] = vpn[ix][iz] * vpn[ix][iz];
		vpx[ix][iz] = vpx[ix][iz] * vpx[ix][iz];
	    }
	}

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

	if(uses) {
	    vsz =sf_floatalloc2(fdm->nzpad,fdm->nxpad);
	    sf_floatread(tt[0],nz*nx,Fvel );    
	    expand(tt,vsz,fdm); /* VSz */
	    for    (ix=0; ix<fdm->nxpad; ix++) {
		for(iz=0; iz<fdm->nzpad; iz++) {
		    vsz[ix][iz] = vsz[ix][iz] * vsz[ix][iz];
		}
	    }
	}
    }

    /*------------------------------------------------------------*/
    if( atype[0]=='t') {
	/* input tilt angle */
	tht =sf_floatalloc2(fdm->nzpad,fdm->nxpad); 

	sit =sf_floatalloc2(fdm->nzpad,fdm->nxpad); 
	cot =sf_floatalloc2(fdm->nzpad,fdm->nxpad); 

	sf_floatread(tt[0],nz*nx,Fang); 
	expand(tt,tht,fdm);
	
	for    (ix=0; ix<fdm->nxpad; ix++) {
	    for(iz=0; iz<fdm->nzpad; iz++) {	    
		tht[ix][iz] *= SF_PI/180.;
		sit[ix][iz] =   sinf(tht[ix][iz]);
		cot[ix][iz] =   cosf(tht[ix][iz]);
	    }
	}

	free(*tht); free(tht);
    }

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

    /*------------------------------------------------------------*/
    /* allocate wavefield arrays */
    pm=sf_floatalloc2(fdm->nzpad,fdm->nxpad);
    po=sf_floatalloc2(fdm->nzpad,fdm->nxpad);
    pp=sf_floatalloc2(fdm->nzpad,fdm->nxpad);
    pa=sf_floatalloc2(fdm->nzpad,fdm->nxpad);
    for    (ix=0; ix<fdm->nxpad; ix++) {
	for(iz=0; iz<fdm->nzpad; iz++) {
	    pm[ix][iz]=0;
	    po[ix][iz]=0;
	    pp[ix][iz]=0;
	    pa[ix][iz]=0;
	}
    }
    
    if(atype[0] != 'i') {
	qm=sf_floatalloc2(fdm->nzpad,fdm->nxpad);
	qo=sf_floatalloc2(fdm->nzpad,fdm->nxpad);
	qp=sf_floatalloc2(fdm->nzpad,fdm->nxpad);
	qa=sf_floatalloc2(fdm->nzpad,fdm->nxpad);
	for    (ix=0; ix<fdm->nxpad; ix++) {
	    for(iz=0; iz<fdm->nzpad; iz++) {
		qm[ix][iz]=0;
		qo[ix][iz]=0;
		qp[ix][iz]=0;
		qa[ix][iz]=0;
	    }
	}

	if(sout) sf=sf_floatalloc2(fdm->nzpad,fdm->nxpad);
    }

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

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

	/* compute acceleration */
	switch(atype[0]) {
	    case 't':

		if(uses) {
#ifdef _OPENMP
#pragma omp parallel for						\
    schedule(dynamic,fdm->ompchunk)					\
    private(ix,iz,H1p,H2p,H1q,H2q,st,ct)				\
    shared(fdm,pa,po,qa,qo,						\
	   cox,cax,cbx,c1x,c2x,						\
	   coz,caz,cbz,c1z,c2z,						\
	   vpn,vpz,vpx,vsz,						\
	   sit,cot)
#endif
		    for    (ix=NOP; ix<fdm->nxpad-NOP; ix++) {
			for(iz=NOP; iz<fdm->nzpad-NOP; iz++) {
			    
			    st=sit[ix][iz];
			    ct=cot[ix][iz];
			    
			    H1p = H1(po,ix,iz,				\
				     st,ct,				\
				     cox,cax,cbx,c1x,c2x,		\
				     coz,caz,cbz,c1z,c2z);
			    
			    H2p = H2(po,ix,iz,				\
				     st,ct,				\
				     cox,cax,cbx,c1x,c2x,		\
				     coz,caz,cbz,c1z,c2z);
			    
			    H1q = H1(qo,ix,iz,				\
				     st,ct,				\
				     cox,cax,cbx,c1x,c2x,		\
				     coz,caz,cbz,c1z,c2z);
			    
			    H2q = H2(qo,ix,iz,				\
				     st,ct,				\
				     cox,cax,cbx,c1x,c2x,		\
				     coz,caz,cbz,c1z,c2z);
			    
			    /* p - main field */
			    pa[ix][iz] = 
				H1p * vsz[ix][iz] +
				H2p * vpx[ix][iz] + 
				H1q * vpz[ix][iz] -
				H1q * vsz[ix][iz];
			    
			    /* q - auxiliary field */
			    qa[ix][iz] = 
				H2p * vpn[ix][iz] -
				H2p * vsz[ix][iz] +
				H1q * vpz[ix][iz] +
				H2q * vsz[ix][iz];
			    
			}
		    }
		} else {
#ifdef _OPENMP
#pragma omp parallel for						\
    schedule(dynamic,fdm->ompchunk)					\
    private(ix,iz,H2p,H1q,st,ct)					\
    shared(fdm,pa,po,qa,qo,						\
	   cox,cax,cbx,c1x,c2x,						\
	   coz,caz,cbz,c1z,c2z,						\
	   vpn,vpz,vpx,							\
	   sit,cot)
#endif
		    for    (ix=NOP; ix<fdm->nxpad-NOP; ix++) {
			for(iz=NOP; iz<fdm->nzpad-NOP; iz++) {
			    
			    st=sit[ix][iz];
			    ct=cot[ix][iz];
			    
			    H2p = H2(po,ix,iz,				\
				     st,ct,				\
				     cox,cax,cbx,c1x,c2x,		\
				     coz,caz,cbz,c1z,c2z);
			    
			    H1q = H1(qo,ix,iz,				\
				     st,ct,				\
				     cox,cax,cbx,c1x,c2x,		\
				     coz,caz,cbz,c1z,c2z);
			    
			    /* p - main field */
			    pa[ix][iz] = 
				H2p * vpx[ix][iz] + 
				H1q * vpz[ix][iz];
			    
			    /* q - auxiliary field */
			    qa[ix][iz] = 
				H2p * vpn[ix][iz] +
				H1q * vpz[ix][iz];
			}
		    }

		}
		break;
		    
	    case 'v':

		if(uses) {
#ifdef _OPENMP
#pragma omp parallel for						\
    schedule(dynamic,fdm->ompchunk)					\
    private(ix,iz,H1p,H2p,H1q,H2q)					\
    shared(fdm,pa,po,qa,qo,						\
	   cox,cax,cbx,							\
	   coz,caz,cbz,							\
	   vpn,vpz,vpx,vsz)
#endif
		    for    (ix=NOP; ix<fdm->nxpad-NOP; ix++) {
			for(iz=NOP; iz<fdm->nzpad-NOP; iz++) {
			    
			    H1p = Dzz(po,ix,iz,coz,caz,cbz);
			    H1q = Dzz(qo,ix,iz,coz,caz,cbz);
			    
			    H2p = Dxx(po,ix,iz,cox,cax,cbx);
			    H2q = Dxx(qo,ix,iz,cox,cax,cbx);
			    
			    /* p - main field */
			    pa[ix][iz] = 
				H1p * vsz[ix][iz] +
				H2p * vpx[ix][iz] + 
				H1q * vpz[ix][iz] -
				H1q * vsz[ix][iz];
			    
			    /* q - auxiliary field */
			    qa[ix][iz] = 
				H2p * vpn[ix][iz] -
				H2p * vsz[ix][iz] +
				H1q * vpz[ix][iz] +
				H2q * vsz[ix][iz];
			}
		    } 
		} else {
#ifdef _OPENMP
#pragma omp parallel for					\
    schedule(dynamic,fdm->ompchunk)				\
    private(ix,iz,H2p,H1q)					\
    shared(fdm,pa,po,qa,qo,					\
	   cox,cax,cbx,						\
	   coz,caz,cbz,						\
	   vpn,vpx,vpz)
#endif
		    for    (ix=NOP; ix<fdm->nxpad-NOP; ix++) {
			for(iz=NOP; iz<fdm->nzpad-NOP; iz++) {
			    
			    H1q = Dzz(qo,ix,iz,coz,caz,cbz);			    
			    H2p = Dxx(po,ix,iz,cox,cax,cbx);
			    
			    /* p - main field */
			    pa[ix][iz] = 
				H2p * vpx[ix][iz] + 
				H1q * vpz[ix][iz];
			    
			    /* q - auxiliary field */
			    qa[ix][iz] = 
				H2p * vpn[ix][iz] +
				H1q * vpz[ix][iz];
			}
		    } 
		}
		break;
		
	    case 'i':
	    default:
#ifdef _OPENMP
#pragma omp parallel for					\
    schedule(dynamic,fdm->ompchunk)				\
    private(ix,iz)						\
    shared(fdm,pa,po,						\
	   cox,cax,cbx,						\
	   coz,caz,cbz,						\
	   vpz)
#endif
		for    (ix=NOP; ix<fdm->nxpad-NOP; ix++) {
		    for(iz=NOP; iz<fdm->nzpad-NOP; iz++) {
			
			pa[ix][iz] = ( Dxx(po,ix,iz,cox,cax,cbx) + 
				       Dzz(po,ix,iz,coz,caz,cbz) ) * vpz[ix][iz];
			
		    }
		}   
		break;
	}

	/* inject acceleration source */
	if(expl) {
	    sf_floatread(ww, 1,Fwav);
	    ;                   lint2d_inject1(pa,ww[0],cs);
	    if(atype[0] != 'i') lint2d_inject1(qa,ww[0],cs);
	} else {
	    sf_floatread(ww,ns,Fwav);	
	    ;                   lint2d_inject(pa,ww,cs);
	    if(atype[0] != 'i') lint2d_inject(qa,ww,cs);
	}

	/* step forward in time */
#ifdef _OPENMP
#pragma omp parallel for	    \
    schedule(dynamic,fdm->ompchunk) \
    private(ix,iz)		    \
    shared(fdm,pa,po,pm,pp,dt2)
#endif
	for    (ix=0; ix<fdm->nxpad; ix++) {
	    for(iz=0; iz<fdm->nzpad; iz++) {
		pp[ix][iz] = 2*po[ix][iz] 
		    -          pm[ix][iz] 
		    +          pa[ix][iz] * dt2;
	    }
	}
	/* circulate wavefield arrays */
	pt=pm;
	pm=po;
	po=pp;
	pp=pt;
	
	if(atype[0] != 'i') {
	    
#ifdef _OPENMP
#pragma omp parallel for			\
    schedule(dynamic,fdm->ompchunk)		\
    private(ix,iz)				\
    shared(fdm,qa,qo,qm,qp,dt2)
#endif
	    for    (ix=0; ix<fdm->nxpad; ix++) {
		for(iz=0; iz<fdm->nzpad; iz++) {
		    qp[ix][iz] = 2*qo[ix][iz] 
			-          qm[ix][iz] 
			+          qa[ix][iz] * dt2;
		}
	    }
	    /* circulate wavefield arrays */
	    qt=qm;
	    qm=qo;
	    qo=qp;
	    qp=qt;
	}

	/* one-way abc apply */
	if(dabc) {
	    abcone2d_apply(po,pm,NOP,abc,fdm);
	    sponge2d_apply(pm,spo,fdm);
	    sponge2d_apply(po,spo,fdm);
	    
	    if(atype[0] != 'i') {
		abcone2d_apply(qo,qm,NOP,abc,fdm);
		sponge2d_apply(qm,spo,fdm);
		sponge2d_apply(qo,spo,fdm);
	    }
	}
	
	/* compute stress */
	if(sout && (atype[0] != 'i')) {
#ifdef _OPENMP
#pragma omp parallel for			\
    schedule(dynamic,fdm->ompchunk)		\
    private(ix,iz)				\
    shared(fdm,po,qo,sf)
#endif
	    for    (ix=0; ix<fdm->nxpad; ix++) {
		for(iz=0; iz<fdm->nzpad; iz++) {
		    sf[ix][iz] = po[ix][iz] + qo[ix][iz];
		}
	    }
	}

	/* extract data at receivers */
	if(sout && (atype[0] != 'i')) {lint2d_extract(sf,dd,cr);
	} else {                       lint2d_extract(po,dd,cr);}
	if(it%jdata==0) sf_floatwrite(dd,nr,Fdat);

	/* extract wavefield in the "box" */
	if(snap && it%jsnap==0) {
	    if(sout && (atype[0] != 'i')) {cut2d(sf,pc,fdm,acz,acx);
	    } else {                       cut2d(po,pc,fdm,acz,acx);}
	    sf_floatwrite(pc[0],sf_n(acz)*sf_n(acx),Fwfl);
	}

    }
    if(verb) fprintf(stderr,"\n");    

    /*------------------------------------------------------------*/
    /* deallocate arrays */

    free(*pm); free(pm);
    free(*pp); free(pp);
    free(*po); free(po);
    free(*pa); free(pa);
    free(*pc); free(pc);

    free(*vp);  free(vp);
    free(*vpz); free(vpz);

    if(atype[0] != 'i') {
	free(*qm); free(qm);
	free(*qp); free(qp);
	free(*qo); free(qo);
	free(*qa); free(qa);

	free(*vpn); free(vpn);
	free(*vpx); free(vpx);

	if(uses){ free(*vsz); free(vsz); }
	if(sout){ free(*sf);  free(sf);  }
    }

    if(atype[0] == 't') {
	free(*sit); free(sit);
	free(*cot); free(cot);
    }

    free(ww);
    free(ss);
    free(rr);
    free(dd);
    /*------------------------------------------------------------*/

    exit (0);
}
Exemplo n.º 4
0
int main(int argc, char* argv[])
{
    bool verb,fsrf,snap,expl,dabc; 
    int  jsnap,ntsnap,jdata;

    /* OMP parameters */
#ifdef _OPENMP
    int ompnth;
#endif 

    /* 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 Fdat=NULL; /* data      */
    sf_file Fwfl=NULL; /* wavefield */

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

    int     nt,nz,nx,ns,nr,nb;
    int     it,iz,ix;
    float   dt,dz,dx,idz,idx,dt2;

    /* FDM structure */
    fdm2d    fdm=NULL;
    abcone2d abc=NULL;
    sponge   spo=NULL;

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

    float **tt=NULL;
    float **vp=NULL;           /* velocity */

    float **vp2=NULL;
    float **vv2=NULL;
    float **vh2=NULL;

    float **rm,**ro,**rp,**ra,**rt; /*      main wavefield */
    float **qm,**qo,**qp,**qa,**qt; /* auxiliary wavefield */

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

    /* FD operator size */
    float cox,coz,cax,cbx,caz,cbz;

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

    float H2q,H1r;

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

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

    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 */
    /*------------------------------------------------------------*/

    /*------------------------------------------------------------*/
    /* 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      */

    /*------------------------------------------------------------*/
    /* 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);
    /*------------------------------------------------------------*/

    /*------------------------------------------------------------*/
    /* 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;        
    }
    /*------------------------------------------------------------*/

    /*------------------------------------------------------------*/
    /* 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);

    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);
    /*------------------------------------------------------------*/

    /*------------------------------------------------------------*/
    /* 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);

	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 */

	qc=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;

    cox= C0 * (idx*idx);
    cax= CA *  idx*idx;
    cbx= CB *  idx*idx;

    coz= C0 * (idz*idz);
    caz= CA *  idz*idz;
    cbz= CB *  idz*idz;

    /* precompute dt^2*/
    dt2 = dt*dt;

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

    /* input velocity */

    vp  =sf_floatalloc2(fdm->nzpad,fdm->nxpad); 
    vp2 =sf_floatalloc2(fdm->nzpad,fdm->nxpad); 
    vv2 =sf_floatalloc2(fdm->nzpad,fdm->nxpad);     
    vh2 =sf_floatalloc2(fdm->nzpad,fdm->nxpad); 

    sf_floatread(tt[0],nz*nx,Fvel );    expand(tt,vv2,fdm); /* vertical v */
    sf_floatread(tt[0],nz*nx,Fvel );    expand(tt,vp2,fdm); /* NMO v */
    sf_floatread(tt[0],nz*nx,Fvel );    expand(tt,vh2,fdm); /* horizontal v */

    for    (ix=0; ix<fdm->nxpad; ix++) {
	for(iz=0; iz<fdm->nzpad; iz++) {	    
	    vp2[ix][iz] = vp2[ix][iz] * vp2[ix][iz];
	    vv2[ix][iz] = vv2[ix][iz] * vv2[ix][iz];
	    vh2[ix][iz] = vh2[ix][iz] * vh2[ix][iz];
	}
    }    
    if(fsrf) { /* free surface */
	for    (ix=0; ix<fdm->nxpad; ix++) {
	    for(iz=0; iz<fdm->nb; iz++) {
		vp2[ix][iz]=0;
		vv2[ix][iz]=0;
		vh2[ix][iz]=0;
	    }
	}
    }

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

    /*------------------------------------------------------------*/
    /* allocate wavefield arrays */
    qm=sf_floatalloc2(fdm->nzpad,fdm->nxpad);
    qo=sf_floatalloc2(fdm->nzpad,fdm->nxpad);
    qp=sf_floatalloc2(fdm->nzpad,fdm->nxpad);
    qa=sf_floatalloc2(fdm->nzpad,fdm->nxpad);

    rm=sf_floatalloc2(fdm->nzpad,fdm->nxpad);
    ro=sf_floatalloc2(fdm->nzpad,fdm->nxpad);
    rp=sf_floatalloc2(fdm->nzpad,fdm->nxpad);
    ra=sf_floatalloc2(fdm->nzpad,fdm->nxpad);

    for    (ix=0; ix<fdm->nxpad; ix++) {
	for(iz=0; iz<fdm->nzpad; iz++) {
	    qm[ix][iz]=0;
	    qo[ix][iz]=0;
	    qp[ix][iz]=0;
	    qa[ix][iz]=0;

	    rm[ix][iz]=0;
	    ro[ix][iz]=0;
	    rp[ix][iz]=0;
	    ra[ix][iz]=0;
	}
    }

    /*------------------------------------------------------------*/
    if(dabc) {
	/* one-way abc setup */
	abc = abcone2d_make(NOP,dt,vp,fsrf,fdm);
	/* 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,"\b\b\b\b\b%d",it);

#ifdef _OPENMP
#pragma omp parallel for				\
    schedule(dynamic,fdm->ompchunk)			\
    private(ix,iz,H2q,H1r)					\
    shared(fdm,ra,ro,qa,qo,cox,coz,cax,caz,cbx,cbz,idx,idz,vp2)
#endif
	for    (ix=NOP; ix<fdm->nxpad-NOP; ix++) {
	    for(iz=NOP; iz<fdm->nzpad-NOP; iz++) {

		H2q = Dxx(qo,ix,iz,cox,cax,cbx);

		H1r = Dzz(ro,ix,iz,coz,caz,cbz);
		
		/* main field - q */
		qa[ix][iz] = H2q * vh2[ix][iz] + H1r * vv2[ix][iz] ;

		/* auxiliary field - r */
		ra[ix][iz] = H2q * vp2[ix][iz] + H1r * vv2[ix][iz] ;
		
	    }
	}   

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

	/* step forward in time */
#ifdef _OPENMP
#pragma omp parallel for	    \
    schedule(dynamic,fdm->ompchunk) \
    private(ix,iz)		    \
    shared(fdm,ra,ro,rm,rp,qa,qo,qm,qp,dt2)
#endif
	for    (ix=0; ix<fdm->nxpad; ix++) {
	    for(iz=0; iz<fdm->nzpad; iz++) {
		qp[ix][iz] = 2*qo[ix][iz] 
		    -          qm[ix][iz] 
		    +          qa[ix][iz] * dt2;

		rp[ix][iz] = 2*ro[ix][iz] 
		    -          rm[ix][iz] 
		    +          ra[ix][iz] * dt2;
	    }
	}
	/* circulate wavefield arrays */
	qt=qm;
	qm=qo;
	qo=qp;
	qp=qt;

	rt=rm;
	rm=ro;
	ro=rp;
	rp=rt;
	
	if(dabc) {
	    /* one-way abc apply */
	    abcone2d_apply(qo,qm,NOP,abc,fdm);
	    sponge2d_apply(qm,spo,fdm);
	    sponge2d_apply(qo,spo,fdm);
	    sponge2d_apply(qp,spo,fdm);

	    /* one-way abc apply */
	    abcone2d_apply(ro,rm,NOP,abc,fdm);
	    sponge2d_apply(rm,spo,fdm);
	    sponge2d_apply(ro,spo,fdm);
	    sponge2d_apply(rp,spo,fdm);
	}

	/* extract data */
	lint2d_extract(qo,dd,cr);

	if(snap && it%jsnap==0) {
	    cut2d(qo,qc,fdm,acz,acx);
	    sf_floatwrite(qc[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(*rm); free(rm);
    free(*rp); free(rp);
    free(*ro); free(ro);
    free(*ra); free(ra);

    free(*qm); free(qm);
    free(*qp); free(qp);
    free(*qo); free(qo);
    free(*qa); free(qa);
    free(*qc); free(qc);

    free(*vp);  free(vp);
    free(*vp2); free(vp2);
    free(*vh2); free(vh2);
    free(*vv2); free(vv2);

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

    exit (0);
}
Exemplo n.º 5
0
int main(int argc, char* argv[])
{
    bool verb,adj; 

    /* I/O files */
    sf_file Ftrc=NULL; /* traces       */
    sf_file Fcoo=NULL; /* coordinates  */
    sf_file Fwfl=NULL; /* wavefield    */

    /* cube axes */
    sf_axis at,az,ax,aa,ac;

    /* I/O arrays */
    float  *wco=NULL;  /* traces   */
    pt2d   *coo=NULL;  /* coordinates   */
    lint2d  cow;       /* weights/indices */
    float **wfl=NULL;  /* wavefield   */

    fdm2d fdm=NULL;
    int   iz,ix,it;
    int   nz,nx;
    float dz,dx;
    float oz,ox;

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

    /*------------------------------------------------------------*/
    if(! sf_getbool("verb",&verb)) verb=false; /* verbosity flag */
    if(! sf_getbool("adj", &adj))   adj=false; /* adjoint flag */

    /*------------------------------------------------------------*/
    /* setup I/O */
    Fcoo = sf_input("coo"); /* coordinates */
    ac = sf_iaxa(Fcoo,2); sf_setlabel(ac,"c"); sf_setunit(ac,"");
    coo = (pt2d*) sf_alloc(sf_n(ac),sizeof(*coo)); 
    pt2dread1(Fcoo,coo,sf_n(ac),2); /* read (x,z) coordinates */

    if(adj) {
	Fwfl = sf_input ("in");  /* wavefield */
	Ftrc = sf_output("out"); /* traces   */

	az = sf_iaxa(Fwfl,1); sf_setlabel(az,"z");
	ax = sf_iaxa(Fwfl,2); sf_setlabel(ax,"x");
	at = sf_iaxa(Fwfl,3); sf_setlabel(at,"t");

	aa = sf_maxa(1,0,1);
	sf_oaxa(Ftrc,ac,1);
	sf_oaxa(Ftrc,at,2);
	sf_oaxa(Ftrc,aa,3);
    } else {
	Ftrc = sf_input ("in" ); /* traces   */
	Fwfl = sf_output("out"); /* wavefield */

	at = sf_iaxa(Ftrc,2); sf_setlabel(at,"t");

	if(!sf_getint  ("nz",&nz)) nz=1;
	if(!sf_getfloat("oz",&oz)) oz=0.0;
	if(!sf_getfloat("dz",&dz)) dz=1.0;
	az = sf_maxa(nz,oz,dz);
	sf_setlabel(az,"z");

	if(!sf_getint  ("nx",&nx)) nx=1; 
	if(!sf_getfloat("ox",&ox)) ox=0.0;
	if(!sf_getfloat("dx",&dx)) dx=1.0;
	ax = sf_maxa(nx,ox,dx);
	sf_setlabel(ax,"x");

	sf_oaxa(Fwfl,az,1);
	sf_oaxa(Fwfl,ax,2);
	sf_oaxa(Fwfl,at,3);
    }
    
    if(verb) {
	sf_raxa(az);
	sf_raxa(ax);
	sf_raxa(at);
	sf_raxa(ac);	
    }

    /* allocate wavefield arrays */
    wco = sf_floatalloc (sf_n(ac));
    wfl = sf_floatalloc2(sf_n(az),sf_n(ax));

    /* interpolation coefficients */
    fdm = fdutil_init(verb,'n',az,ax,0,1);
    cow = lint2d_make(sf_n(ac),coo,fdm);

    /*------------------------------------------------------------*/
    /* 
     *  MAIN LOOP
     */
    /*------------------------------------------------------------*/
    if(verb) fprintf(stderr,"\n");
    for (it=0; it<sf_n(at); it++) {
	if(verb) fprintf(stderr,"\b\b\b\b\b%d",it);
	
	if(adj) {
	    sf_floatread(wfl[0],sf_n(az)*sf_n(ax),Fwfl);

	    lint2d_extract(wfl,wco,cow);

	    sf_floatwrite(wco,sf_n(ac),Ftrc);
	} else {
	    sf_floatread(wco,sf_n(ac),Ftrc);

	    for    (ix=0; ix<sf_n(ax); ix++)
		for(iz=0; iz<sf_n(az); iz++)
		    wfl[ix][iz]=0;
	    lint2d_inject(wfl,wco,cow);

	    sf_floatwrite(wfl[0],sf_n(az)*sf_n(ax),Fwfl);
	}

    }	/* end time loop */
    if(verb) fprintf(stderr,"\n");
	
    /*------------------------------------------------------------*/
    /* deallocate arrays */
    free(*wfl); free(wfl);
    free(wco);
    free(coo);
    
    /*------------------------------------------------------------*/ 
    /* close files */
    if (Ftrc!=NULL) sf_fileclose(Ftrc); 
    if (Fwfl!=NULL) sf_fileclose(Fwfl);
    if (Fcoo!=NULL) sf_fileclose(Fcoo);

    exit (0);
}
Exemplo n.º 6
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);
    }
}