Beispiel #1
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);
    }
}
Beispiel #2
0
/*------------------------------------------------------------*/
int main(int argc, char* argv[])
{
    bool verb;     /* verbosity flag */
    bool pos; /* direction of spraying */
    bool adj;      /* adjoint operator flag */
    bool wflcausal, oprcausal; /* causal wfl?, opr? */

    sf_file    Fopr,        Fwfl,         Fimg,     Fcip; /* I/O files */
    float   ****opr=NULL,****wfl=NULL,*****img=NULL; 
    int     itO,itW;
    
    sf_axis az,ax,ay,at,ac,aa; /* wfld axes */
    int     nz,nx,ny,nt,nc;
    int     iz,ix,iy,it,ic;

    sf_axis ahx, ahy, ahz, aht; /* EIC axes */
    int     nhx, nhy, nhz, nht;
    int     ihx, ihy, ihz, iht;
    float   dhx, dhy, dhz, dht;

    pt3d *cc=NULL;
    bool *ccin=NULL;
    float cxmin,czmin,cymin;
    float cxmax,czmax,cymax;
    int  icx, icz, icy;
    int  mcx, mcz, mcy, mct;
    int  pcx, pcz, pcy, pct;
    int **mcxall, **pcxall;
    int **mcyall, **pcyall;
    int **mczall, **pczall;
    int  *mctall,  *pctall;
    int lht,fht; /* last buffer index */

    float scale; /* time summation scaling */
    int nslice;  /* wavefield slice size */

    bool gaus;         /* gaussian taper */
    float gsx,gsy,gsz,gst; /* std dev */

    /*------------------------------------------------------------*/
    sf_init(argc,argv);
#ifdef _OPENMP
    omp_init();
#endif

    if(! sf_getbool(    "verb",&verb    ))        verb=false; /* verbosity flag */
    if(! sf_getbool(    "positive",&pos ))        pos=true; /* if positive sprays opr to positive shits, else, sprays to negative shifts */
    if(! sf_getbool(     "adj",&adj     ))         adj=false; /* adjoint flag */
    if(! sf_getbool("wflcausal",&wflcausal)) wflcausal=false; /* causal wfl? */
    if(! sf_getbool("oprcausal",&oprcausal)) oprcausal=false; /* causal opr? */

    /*------------------------------------------------------------*/
    Fopr = sf_input ("opr" ); /* operator */
    az=sf_iaxa(Fopr,1); if(verb) sf_raxa(az); nz = sf_n(az);
    ax=sf_iaxa(Fopr,2); if(verb) sf_raxa(ax); nx = sf_n(ax);
    ay=sf_iaxa(Fopr,3); if(verb) sf_raxa(ay); ny = sf_n(ay);
    at=sf_iaxa(Fopr,4); if(verb) sf_raxa(at); nt = sf_n(at);

    scale = 1./nt;                /* time summation scaling */
    nslice = nz*nx*ny*sizeof(float); /* wavefield slice */

    Fcip = sf_input ("cip" ); /* CIP coordinates    */
    ac = sf_iaxa(Fcip,2); 
    sf_setlabel(ac,"c"); sf_setunit(ac,""); if(verb) sf_raxa(ac); nc = sf_n(ac); 
    
    /*------------------------------------------------------------*/
    /* setup output */
    if(adj) {
	Fimg = sf_input ("in");  /*  read img */
	ahz=sf_iaxa(Fimg,1); nhz=(sf_n(ahz)-1)/2; if(verb) sf_raxa(ahz); 
	ahx=sf_iaxa(Fimg,2); nhx=(sf_n(ahx)-1)/2; if(verb) sf_raxa(ahx);
	ahy=sf_iaxa(Fimg,3); nhy=(sf_n(ahy)-1)/2; if(verb) sf_raxa(ahy);
	aht=sf_iaxa(Fimg,4); nht=(sf_n(aht)-1)/2; if(verb) sf_raxa(aht); 

	aa=sf_maxa(1,0,1); sf_setlabel(aa,""); sf_setunit(aa,""); 

	/* set output axes */
	Fwfl = sf_output("out"); /* write wfl */
	sf_oaxa(Fwfl,az,1);
	sf_oaxa(Fwfl,ax,2);
	sf_oaxa(Fwfl,ay,3);
	sf_oaxa(Fwfl,at,4);
	sf_oaxa(Fwfl,aa,5);

    } else {
	Fwfl = sf_input ( "in"); /*  read wfl */
	
	if(! sf_getint("nhz",&nhz)) nhz=0; /* z lags */
	dhz=2*sf_d(az);
	ahz=sf_maxa(2*nhz+1,-nhz*dhz,dhz); sf_setlabel(ahz,"hz"); sf_setunit(ahz,""); 
	if(verb) sf_raxa(ahz);
	
	if(! sf_getint("nhx",&nhx)) nhx=0; /* x lags */
	dhx=2*sf_d(ax);
	ahx=sf_maxa(2*nhx+1,-nhx*dhx,dhx); sf_setlabel(ahx,"hx"); sf_setunit(ahx,""); 
	if(verb) sf_raxa(ahx);

	if(! sf_getint("nhy",&nhy)) nhy=0; /* y lags */
	dhy=2*sf_d(ay);
	ahy=sf_maxa(2*nhy+1,-nhy*dhy,dhy); sf_setlabel(ahy,"hy"); sf_setunit(ahy,""); 
	if(verb) sf_raxa(ahy);

	if(! sf_getint("nht",&nht)) nht=0; /* t lags */
	dht=2*sf_d(at);
	aht=sf_maxa(2*nht+1,-nht*dht,dht); sf_setlabel(aht,"ht"); sf_setunit(aht,""); 
	if(verb) sf_raxa(aht);

	Fimg = sf_output("out"); /* write img */
	sf_oaxa(Fimg,ahz,1);
	sf_oaxa(Fimg,ahx,2);
	sf_oaxa(Fimg,ahy,3);
	sf_oaxa(Fimg,aht,4);
	sf_oaxa(Fimg, ac,5);
    }

    /*------------------------------------------------------------*/
    if(! sf_getbool("gaus",&gaus)) gaus=false; /* Gaussian taper */
    if(gaus) {
	if(! sf_getfloat("gsx",&gsx)) gsx=0.25*sf_n(ahx)*sf_d(ahx); gsx=(nhx==0)?1:1./(2*gsx*gsx);
	if(! sf_getfloat("gsy",&gsy)) gsy=0.25*sf_n(ahy)*sf_d(ahy); gsy=(nhy==0)?1:1./(2*gsy*gsy);
        if(! sf_getfloat("gsz",&gsz)) gsz=0.25*sf_n(ahz)*sf_d(ahz); gsz=(nhz==0)?1:1./(2*gsz*gsz);
        if(! sf_getfloat("gst",&gst)) gst=0.25*sf_n(aht)*sf_d(aht); gst=(nht==0)?1:1./(2*gst*gst);
    }
    
    /*------------------------------------------------------------*/
    /* allocate arrays */
    opr=sf_floatalloc4(nz,nx,ny,sf_n(aht));
    wfl=sf_floatalloc4(nz,nx,ny,sf_n(aht));
    img=sf_floatalloc5(sf_n(ahz),sf_n(ahx),sf_n(ahy),sf_n(aht),sf_n(ac));

    /*------------------------------------------------------------*/
    /* CIP coordinates */
    cc= (pt3d*) sf_alloc(nc,sizeof(*cc));
    pt3dread1(Fcip,cc,nc,3);

    mcxall=sf_intalloc2(sf_n(ahx),sf_n(ac));
    pcxall=sf_intalloc2(sf_n(ahx),sf_n(ac));
    mcyall=sf_intalloc2(sf_n(ahy),sf_n(ac));
    pcyall=sf_intalloc2(sf_n(ahy),sf_n(ac));
    mczall=sf_intalloc2(sf_n(ahz),sf_n(ac));
    pczall=sf_intalloc2(sf_n(ahz),sf_n(ac));
    ccin=sf_boolalloc(sf_n(ac));

    cxmin = sf_o(ax) +             nhx *sf_d(ax);
    cxmax = sf_o(ax) + (sf_n(ax)-1-nhx)*sf_d(ax);
    cymin = sf_o(ay) +             nhy *sf_d(ay);
    cymax = sf_o(ay) + (sf_n(ay)-1-nhy)*sf_d(ay);
    czmin = sf_o(az) +             nhz *sf_d(az);
    czmax = sf_o(az) + (sf_n(az)-1-nhz)*sf_d(az);

    for(ic=0;ic<nc;ic++) {
	ccin[ic]=(cc[ic].x>=cxmin && cc[ic].x<=cxmax &&
		  cc[ic].y>=cymin && cc[ic].y<=cymax &&
		  cc[ic].z>=czmin && cc[ic].z<=czmax)?true:false;
	
	if(ccin[ic]) {

	    icx = 0.5+(cc[ic].x-sf_o(ax))/sf_d(ax);
	    for(ihx=-nhx; ihx<nhx+1; ihx++) {
		mcxall[ic][nhx+ihx] = icx-ihx;
		pcxall[ic][nhx+ihx] = icx+ihx;
	    }

	    icy = 0.5+(cc[ic].y-sf_o(ay))/sf_d(ay);
	    for(ihy=-nhy; ihy<nhy+1; ihy++) {
		mcyall[ic][nhy+ihy] = icy-ihy;
		pcyall[ic][nhy+ihy] = icy+ihy;
	    }

	    icz = 0.5+(cc[ic].z-sf_o(az))/sf_d(az);
	    for(ihz=-nhz; ihz<nhz+1; ihz++) {
		mczall[ic][nhz+ihz] = icz-ihz;
		pczall[ic][nhz+ihz] = icz+ihz;
	    }

	}
    }
       
    mctall=sf_intalloc(sf_n(aht));
    pctall=sf_intalloc(sf_n(aht));
    for (iht=0; iht<sf_n(aht); iht++) { 
	mctall[iht]=            iht;
	pctall[iht]=sf_n(aht)-1-iht;
    }
    
    if(adj) { /* ADJIONT OPERATOR */

	for(iht=0;iht<sf_n(aht);iht++)
	    CICLOOP( wfl[iht][iy][ix][iz]=0; );                         /* zero wfl */
	for(it=0;it<nt;it++) sf_floatwrite(wfl[0][0][0],nz*nx*ny,Fwfl); /* reserve wfl */ 
	sf_seek(Fwfl,0,SEEK_SET);                                       /* seek back */

	sf_floatread(img[0][0][0][0],sf_n(ac)*sf_n(ahy)*sf_n(ahx)*sf_n(ahz)*sf_n(aht),Fimg); /* read img */
	;        applyScaling (img,ac,aht,ahx,ahy,ahz,scale);                       /* scaling  */
	if(gaus) applyGaussian(img,ac,aht,ahx,ahy,ahz,gst,gsx,gsy,gsz);             /* Gaussian */

	lht=0; itO=-999999; itW=-999999;
	for(it=-nht;it<nt+nht;it++) { if(verb) fprintf(stderr,"\b\b\b\b\b\b%04d",it);
	    fht=(lht+1) % sf_n(aht);

	    if(it<nt-nht) {
		itO = it + nht;
		if( !oprcausal ) sf_seek(Fopr,(off_t)(nt-1-itO)*nslice,SEEK_SET);
		else             sf_seek(Fopr,(off_t)      itO *nslice,SEEK_SET);
		sf_floatread(opr[ lht ][0][0],nz*nx*ny,Fopr);
	    }
            for(iht=0;iht<sf_n(aht);iht++) {
                mctall[iht] = (mctall[iht]+1) % sf_n(aht); /* cycle iht index */
                pctall[iht] = (pctall[iht]+1) % sf_n(aht);
            }


	    if(it>=0+nht && 
	       it<nt-nht) { 

#ifdef _OPENMP
#pragma omp parallel for schedule(dynamic)				\
    private(ic,     ihx,ihy,ihz,iht,mcx,   mcy,   mcz,   mct,   pcx,   pcy,   pcz,   pct) \
    shared (nc,ccin,ahx,ahy,ahz,aht,mcxall,mcyall,mczall,mctall,pcxall,pcyall,pczall,pctall)
#endif
		for(ic=0;ic<nc;ic++){ if(ccin[ic]) { /* sum over c only! */
      if(pos){

			EICLOOP( wfl    [mct][mcy][mcx][mcz] +=
				 opr    [pct][pcy][pcx][pcz] *
				 img[ic][iht][ihy][ihx][ihz]; );
      }else{
			EICLOOP( wfl    [pct][pcy][pcx][pcz] +=
				 opr    [mct][mcy][mcx][mcz] *
				 img[ic][iht][ihy][ihx][ihz]; );


      }
		    }
		}
Beispiel #3
0
/* main function */
int main(int argc, char* argv[]) 
{
    clock_t tstart,tend;
    double duration;

    /*flags*/
    bool verb, adj; /* migration(adjoint) flag */
    bool wantwf; /* outputs wavefield snapshots */
    bool wantrecord; /* actually means "need record" */
    bool illum; /* source illumination flag*/
    bool roll; /* survey strategy */
    
    /*I/O*/
    sf_file Fvel;
    sf_file left, right, leftb, rightb;
    sf_file Fsrc, Frcd/*source and record*/;
    sf_file Ftmpwf;
    sf_file Fimg;

    /*axis*/
    sf_axis at, ax, az, as;

    /*grid index variables*/
    int nx, nz, nt, wfnt;
    int nzx, nx2, nz2, n2, m2, m2b, pad1, nk;
    int ix, iz, it, is;
    int nxb, nzb;
    int snpint;
    float dt, dx, dz, wfdt;
    float ox, oz;

    /*source/geophone location*/
    int   spx, spz;
    int   gpz,gpx,gpl; /*geophone depth/x-crd/length*/

    /*Model*/
    sf_complex **lt, **rt;
    sf_complex **ltb, **rtb;

    /*Data*/
    sf_complex ***wavefld;
    sf_complex ***record, **tmprec, **img, **imgsum;
    float **sill;

    /*source*/
    sf_complex *ww;
    float *rr;
    int rectz,rectx,repeat; /*smoothing parameters*/
    float trunc;
    int sht0,shtbgn,shtend,shtnum,shtnum0,shtint,shtcur;

    /*abc boundary*/
    int top,bot,lft,rht;

    /*tmp*/
    int tmpint;

    /*parameter structs*/
    geopar geop;
    mpipar mpip;

    /*MPI*/
    int rank, nodes;
    sf_complex *sendbuf, *recvbuf;

    MPI_Init(&argc, &argv);
    MPI_Comm_rank(MPI_COMM_WORLD, &rank);
    MPI_Comm_size(MPI_COMM_WORLD, &nodes);

    sf_init(argc, argv);

    if(rank==0) sf_warning("nodes=%d",nodes);

    if (!sf_getbool("verb", &verb)) verb=false; /*verbosity*/
    if (!sf_getbool("adj", &adj)) adj=true; /*migration*/
    if (!sf_getbool("wantwf", &wantwf)) wantwf=false; /*output forward and backward wavefield*/
    if (!sf_getbool("wantrecord", &wantrecord)) wantrecord=true; /*if n, using record data generated by this program */
    if (!sf_getbool("illum", &illum)) illum=false; /*if n, no source illumination applied */
    if (!sf_getbool("roll", &roll)) roll=false; /*if n, receiver is independent of source location and gpl=nx*/
    /* source/receiver info */
    if (!sf_getint("shtbgn", &shtbgn)) sf_error("Need shot starting location on grid!");
    if (!sf_getint("sht0", &sht0)) sht0=shtbgn; /*actual shot origin on grid*/
    if (!sf_getint("shtend", &shtend)) sf_error("Need shot ending location on grid!");
    if (!sf_getint("shtint", &shtint)) sf_error("Need shot interval on grid!");
    shtnum = (int)((shtend-shtbgn)/shtint) + 1;
    shtnum0 = shtnum;
    if (!sf_getint("spz", &spz)) sf_error("Need source depth!");
    if (!sf_getint("gpz", &gpz)) sf_error("Need receiver depth!");
    if (roll) if (!sf_getint("gpl", &gpl)) sf_error("Need receiver length");
    if (!sf_getint("snapinter", &snpint)) snpint=1;     /* snap interval */
    /*--- parameters of source ---*/
    if (!sf_getfloat("srctrunc", &trunc)) trunc=0.4;
    if (!sf_getint("rectz", &rectz)) rectz=1;
    if (!sf_getint("rectx", &rectx)) rectx=1;
    if (!sf_getint("repeat", &repeat)) repeat=0;
    /* abc parameters */
    if (!sf_getint("top", &top)) top=40;
    if (!sf_getint("bot", &bot)) bot=40;
    if (!sf_getint("lft", &lft)) lft=40;
    if (!sf_getint("rht", &rht)) rht=40;

    /*Set I/O file*/
    if (adj) { /* migration */
      if (wantrecord) {
	Frcd = sf_input("input"); /*record from elsewhere*/
	Fsrc  = sf_input("src");   /*source wavelet*/      
      } else {
	Frcd = sf_output("rec"); /*record produced by forward modeling*/
	Fsrc = sf_input("input");   /*source wavelet*/
      }
      Fimg  = sf_output("output");
    } else { /* modeling */
      Fimg = sf_input("input");
      Frcd = sf_output("output");
      Fsrc  = sf_input("src");   /*source wavelet*/      
    }
    left  = sf_input("left");
    right = sf_input("right");
    leftb  = sf_input("leftb");
    rightb = sf_input("rightb");
    Fvel  = sf_input("vel");  /*velocity - just for model dimension*/
    if (wantwf) {
	Ftmpwf  = sf_output("tmpwf");/*wavefield snap*/
    } else {
	Ftmpwf  = NULL;
    }

    /*--- Axes parameters ---*/
    at = sf_iaxa(Fsrc, 1); nt = sf_n(at);  dt = sf_d(at);      
    az = sf_iaxa(Fvel, 1); nzb = sf_n(az); dz = sf_d(az); oz = sf_o(az);
    ax = sf_iaxa(Fvel, 2); nxb = sf_n(ax); dx = sf_d(ax); ox = sf_o(ax);
    nzx = nzb*nxb;
    nz = nzb - top - bot;
    nx = nxb - lft - rht;
    if (!roll) gpl = nx; /* global survey setting */
    /* wavefield axis */
    wfnt = (int)(nt-1)/snpint+1;
    wfdt = dt*snpint;

    /* propagator matrices */
    if (!sf_getint("pad1",&pad1)) pad1=1; /* padding factor on the first axis */
    nz2 = kiss_fft_next_fast_size(nzb*pad1);
    nx2 = kiss_fft_next_fast_size(nxb);
    nk = nz2*nx2; /*wavenumber*/
    if (!sf_histint(left,"n1",&n2) || n2 != nzx) sf_error("Need n1=%d in left",nzx);
    if (!sf_histint(left,"n2",&m2))  sf_error("Need n2= in left");
    if (!sf_histint(right,"n1",&n2) || n2 != m2) sf_error("Need n1=%d in right",m2);
    if (!sf_histint(right,"n2",&n2) || n2 != nk) sf_error("Need n2=%d in right",nk);

    if (!sf_histint(leftb,"n1",&n2) || n2 != nzx) sf_error("Need n1=%d in left",nzx);
    if (!sf_histint(leftb,"n2",&m2b))  sf_error("Need n2= in left");
    if (!sf_histint(rightb,"n1",&n2) || n2 != m2b) sf_error("Need n1=%d in right",m2b);
    if (!sf_histint(rightb,"n2",&n2) || n2 != nk) sf_error("Need n2=%d in right",nk);

    /*check record data*/
    if (adj && wantrecord){
	sf_histint(Frcd,"n1", &tmpint);
	if (tmpint != nt ) sf_error("Error parameter n1 in record!");
	sf_histint(Frcd,"n2", &tmpint);
	if (tmpint != gpl ) sf_error("Error parameter n2 in record!");
	sf_histint(Frcd,"n3", &tmpint);
	if (tmpint != shtnum0 ) sf_error("Error parameter n3 in record!");
    }

    /*allocate memory*/
    ww=sf_complexalloc(nt);
    rr=sf_floatalloc(nzx);
    lt = sf_complexalloc2(nzx,m2);
    rt = sf_complexalloc2(m2,nk);
    ltb = sf_complexalloc2(nzx,m2b);
    rtb = sf_complexalloc2(m2b,nk);
    geop = (geopar) sf_alloc(1, sizeof(*geop));
    mpip = (mpipar) sf_alloc(1, sizeof(*mpip));
    tmprec = sf_complexalloc2(nt, gpl);
    if (shtnum%nodes!=0) {
      shtnum += nodes-shtnum%nodes;
      if (verb) sf_warning("Total shot number is not divisible by total number of nodes! shunum padded to %d.", shtnum);
    }
    if (rank==0) {
      record = sf_complexalloc3(nt, gpl, shtnum);
    } else record = NULL;
    wavefld = sf_complexalloc3(nz, nx, wfnt);
    if (illum) sill = sf_floatalloc2(nz, nx);
    else sill = NULL;
    img = sf_complexalloc2(nz, nx);
    if (adj) {
      imgsum = sf_complexalloc2(nz, nx);
#ifdef _OPENMP
#pragma omp parallel for private(ix,iz)
#endif
	for (ix=0; ix<nx; ix++)
	  for (iz=0; iz<nz; iz++)
	    imgsum[ix][iz] = sf_cmplx(0.,0.);
    }
    /*read from files*/
    sf_complexread(ww,nt,Fsrc);
    sf_complexread(lt[0],nzx*m2,left);
    sf_complexread(rt[0],m2*nk,right);
    sf_complexread(ltb[0],nzx*m2b,leftb);
    sf_complexread(rtb[0],m2b*nk,rightb);
    if(!adj) sf_complexread(img[0],nx*nz,Fimg);
    if (rank==0) {
      if(adj && wantrecord) {
	sf_complexread(record[0][0], shtnum0*gpl*nt, Frcd);
	if (shtnum0%nodes!=0) {
#ifdef _OPENMP
#pragma omp parallel for private(is,ix,it)
#endif
	  for (is=shtnum0; is<shtnum; is++)
	    for (ix=0; ix<gpl; ix++)
	      for (it=0; it<nt; it++)
		record[is][ix][it] = sf_cmplx(0.,0.);
	}
      } else {
#ifdef _OPENMP
#pragma omp parallel for private(is,ix,it)
#endif
	for (is=0; is<shtnum; is++)
	  for (ix=0; ix<gpl; ix++)
	    for (it=0; it<nt; it++)
	      record[is][ix][it] = sf_cmplx(0.,0.);
      }
    }
    
    /*close RSF files*/
    sf_fileclose(Fsrc);
    sf_fileclose(left);
    sf_fileclose(right);
    sf_fileclose(leftb);
    sf_fileclose(rightb);

    /*load constant geopar elements*/
    mpip->cpuid=rank;
    mpip->numprocs=nodes;
    /*load constant geopar elements*/
    geop->nx  = nx;
    geop->nz  = nz;
    geop->nxb = nxb;
    geop->nzb = nzb;
    geop->dx  = dx;
    geop->dz  = dz;
    geop->ox  = ox;
    geop->oz  = oz;
    geop->snpint = snpint;
    geop->spz = spz;
    geop->gpz = gpz;
    geop->gpl = gpl;
    geop->top = top;
    geop->bot = bot;
    geop->lft = lft;
    geop->rht = rht;
    geop->nt = nt;
    geop->dt = dt;
    geop->trunc = trunc;
    geop->shtnum = shtnum;

    /* output RSF files */

    if (rank==0) {
      sf_setn(ax, gpl);
      sf_setn(az, nz);
      as = sf_iaxa(Fvel, 2);
      sf_setn(as,shtnum0);
      sf_setd(as,shtint*dx);
      sf_seto(as,shtbgn*dx+ox);
      
      if (adj) { /* migration */
	if(!wantrecord) {
	  sf_oaxa(Frcd, at, 1);
	  sf_oaxa(Frcd, ax, 2);
	  sf_oaxa(Frcd, as, 3);
	  sf_settype(Frcd,SF_COMPLEX);	
	}
	sf_setn(ax, nx);
	/*write image*/
	sf_oaxa(Fimg, az, 1);
	sf_oaxa(Fimg, ax, 2);
	sf_settype(Fimg,SF_COMPLEX);
      } else { /* modeling */
	sf_oaxa(Frcd, at, 1);
	sf_oaxa(Frcd, ax, 2);
	sf_oaxa(Frcd, as ,3);
	sf_settype(Frcd,SF_COMPLEX);
      }
      
      if (wantwf) {
	sf_setn(ax, nx);
	/*write temp wavefield */
	sf_setn(at, wfnt);
	sf_setd(at, wfdt);
	
	sf_oaxa(Ftmpwf, az, 1);
	sf_oaxa(Ftmpwf, ax, 2);
	sf_oaxa(Ftmpwf, at, 3);
	sf_settype(Ftmpwf,SF_COMPLEX);
      }
    }
    
    tstart = clock();

    for (is=0; is*nodes<shtnum; is++){

      shtcur = is*nodes+rank; // current shot index

      if (shtcur<shtnum0) {
	spx = shtbgn + shtint*(shtcur);
	if (roll)
	  gpx = spx - (int)(gpl/2);
	else
	  gpx = 0;
	geop->spx = spx;
	geop->gpx = gpx;
	
	if (verb) {
	  sf_warning("============================");
	  sf_warning("processing shot #%d", shtcur);
	  sf_warning("nx=%d nz=%d nt=%d", geop->nx, geop->nz, geop->nt);
	  sf_warning("nxb=%d nzb=%d ", geop->nxb, geop->nzb);
	  sf_warning("dx=%f dz=%f dt=%f", geop->dx, geop->dz, geop->dt);
	  sf_warning("top=%d bot=%d lft=%d rht=%d", geop->top, geop->bot, geop->lft, geop->rht);
	  sf_warning("rectz=%d rectx=%d repeat=%d srctrunc=%f",rectz,rectx,repeat,geop->trunc);
	  sf_warning("spz=%d spx=%d gpz=%d gpx=%d gpl=%d", spz, spx, gpz, gpx, gpl);
	  sf_warning("snpint=%d wfdt=%f wfnt=%d ", snpint, wfdt, wfnt);
	  sf_warning("sht0=%d shtbgn=%d shtend=%d shtnum0=%d shtnum=%d", sht0, shtbgn, shtend, shtnum0, shtnum);
	  if (roll) sf_warning("Rolling survey!");
	  else sf_warning("Global survey (gpl=nx)!");
	  if (illum) sf_warning("Using source illumination!");
	  else sf_warning("No source illumination!");
	  sf_warning("============================");
	}
	
	/*generate reflectivity map*/
	reflgen(nzb, nxb, spz+top, spx+lft, rectz, rectx, repeat, rr);
	
	lrosfor2(wavefld, sill, tmprec, verb, lt, rt, m2, geop, ww, rr, pad1, illum);
      }

      if(adj && wantrecord) {
	if (rank==0) sendbuf = record[is*nodes][0];
	else sendbuf = NULL;
	recvbuf = tmprec[0];
	MPI_Scatter(sendbuf, gpl*nt, MPI_COMPLEX, recvbuf, gpl*nt, MPI_COMPLEX, 0, MPI_COMM_WORLD); // tmprec[ix][it] = record[is][ix][it];
      }
      
      if (shtcur<shtnum0) {
	lrosback2(img, wavefld, sill, tmprec, adj, verb, wantwf, ltb, rtb, m2b, geop, pad1, illum);
	if (adj) { /*local image reduction*/
#ifdef _OPENMP
#pragma omp parallel for private(ix,iz)
#endif
	  for (ix=0; ix<nx; ix++) {
	    for (iz=0; iz<nz; iz++) {
#ifdef SF_HAS_COMPLEX_H
	      imgsum[ix][iz] += img[ix][iz];
#else
	      imgsum[ix][iz] = sf_cadd(imgsum[ix][iz],img[ix][iz]);
#endif      
	    }
	  }
	}
      }

      if (!adj || !wantrecord) {
	//	MPI_Barrier(MPI_COMM_WORLD);
	if (rank==0) recvbuf = record[is*nodes][0];
	else recvbuf = NULL;
	sendbuf = tmprec[0];
	MPI_Gather(sendbuf, gpl*nt, MPI_COMPLEX, recvbuf, gpl*nt, MPI_COMPLEX, 0, MPI_COMM_WORLD); // record[is][ix][it] = tmprec[ix][it];
      }

      if (wantwf && shtcur==0)
	sf_complexwrite(wavefld[0][0], wfnt*nx*nz, Ftmpwf);
    } /*shot iteration*/

    MPI_Barrier(MPI_COMM_WORLD);
    /*write record/image*/
    if (adj) {
      if (rank==0) {
#if MPI_VERSION >= 2
	sendbuf = (sf_complex *) MPI_IN_PLACE;
#else /* will fail */
	sendbuf = NULL;
#endif 
	recvbuf = imgsum[0];
      } else {
	sendbuf = imgsum[0];
      	recvbuf = NULL;
      }
      MPI_Reduce(sendbuf, recvbuf, nx*nz, MPI_COMPLEX, MPI_SUM, 0, MPI_COMM_WORLD); 
      if (rank==0)
	sf_complexwrite(imgsum[0], nx*nz, Fimg);
    }

    if (!adj || !wantrecord) {
      if (rank==0)
	sf_complexwrite(record[0][0], shtnum0*gpl*nt, Frcd);
    }

    /*free memory*/
    free(ww); free(rr);
    free(*lt); free(lt);
    free(*rt); free(rt);
    free(*ltb);free(ltb);
    free(*rtb);free(rtb);
    free(geop);free(mpip);
    free(*tmprec); free(tmprec);
    if (rank==0) {free(**record); free(*record); free(record);}
    free(**wavefld); free(*wavefld); free(wavefld);
    if (illum) {
      free(*sill); free(sill);
    }
    free(*img); free(img);
    if (adj) {
      free(*imgsum); free(imgsum);
    }

    tend = clock();
    duration=(double)(tend-tstart)/CLOCKS_PER_SEC;
    sf_warning(">> The CPU time of single shot migration is: %f seconds << ", duration);

    MPI_Finalize();
    exit(0);
}