Exemplo n.º 1
0
void vp_color_init (void)
{
    if (!sf_getfloats ("backcol",backcol,3))
	backcol[0] = backcol[1] = backcol[2] = 0.;
    if (!sf_getfloats ("fillcol",fillcol,3))
	fillcol[0] = fillcol[1] = fillcol[2] = 0.;
    vp_coltab (0, backcol[0], backcol[1], backcol[2]);
}
Exemplo n.º 2
0
int main(int argc, char* argv[])
{
    int nt, nd;
    float dist;
    float **points, *point;
    kd_node tree, near;
    sf_file inp, out;

    sf_init(argc,argv);
    inp = sf_input("in");
    out = sf_output("out");

    if (SF_FLOAT != sf_gettype(inp)) sf_error("Need float input");
    if (!sf_histint(inp,"n1",&nd)) sf_error("No n1= in input");
    if (!sf_histint(inp,"n2",&nt)) sf_error("No n2= in input");
    sf_putint(out,"n2",1);

    points = sf_floatalloc2(nd,nt);
    sf_floatread(points[0],nd*nt,inp);

    tree = kd_tree(points,nt,nd);

    point = sf_floatalloc(nd);
    if (!sf_getfloats("point",point,nd)) sf_error("Need point=");
    
    dist = SF_HUGE;
    kd_nearest(tree, point, 0, nd, &near, &dist);

    sf_floatwrite(kd_coord(near),nd,out);

    exit(0);
}
Exemplo n.º 3
0
void vp_plot_init(int n2)
{
    int  i, len;

    dashtype = sf_floatalloc(n2);
    if (!sf_getfloats ("dash",dashtype,n2)) {
	/*  line dash type	
	    0 continuos (default)
	    1 fine dash
	    2 fine dot
	    3 dash
	    4 large dash
	    5 dot dash
	    6 large dash small dash
	    7 double dot
	    8 double dash
	    9 loose dash  The part after the decimal point determines the pattern repetition interval */	   
	for (i = 0; i < n2; i++) 
	    dashtype[i] = 0.;
    }

    fat = sf_intalloc(n2);
    if (!sf_getints("plotfat",fat,n2)) {
	/* line fatness */
	for (i = 0; i < n2; i++)
	    fat[i] = 0;
    }
    
    col = sf_intalloc(n2);
    if (!sf_getints("plotcol",col,n2)) {
	/* line color 
	   7 white
	   6 yellow (default)
	   5 cyan
	   4 green
	   3 magenta
	   2 red
	   1 blue
	   0 black */
	for (i = 0; i < n2; i++)
	    col[i] = 6 - (i % 6);
    }
}
Exemplo n.º 4
0
int main(int argc, char **argv)
{
    int n1, n2, ninf, i1, i2, i, *inter2;
    char *label, *unit;
    float o1, d1, o2, d2, x, z;
    float *v0, *dvdx, *dvdz, *x0, *z0, *trace, **inter;
    sf_file model, surface;

    sf_init(argc, argv);
    surface = sf_input("in");
    model = sf_output("out");

    if (SF_FLOAT != sf_gettype(surface)) sf_error("Need float input");

    if (!sf_histint(surface,"n1",&n2))   sf_error("No n1= in input");
    if (!sf_histfloat(surface,"d1",&d2)) sf_error("No d1= in input");
    if (!sf_histfloat(surface,"o1",&o2)) o2=0.;

    sf_shiftdim(surface, model, 1);
    sf_putint(model,"n3",1);

    if (!sf_histint(surface,"n2",&ninf)) ninf=1; 

    if (!sf_getint("n1",&n1)) sf_error("Need n1=");
    /* Number of samples on the depth axis */
    if (!sf_getfloat("d1",&d1)) sf_error("Need d1=");
    /* Sampling of the depth axis */
    if (!sf_getfloat("o1",&o1)) o1=0.;
    /* Origin of the depth axis */

    sf_putint(model,"n1",n1);
    sf_putfloat(model,"d1",d1);
    sf_putfloat(model,"o1",o1);

    if (NULL == (label = sf_getstring("label1"))) label="Depth";
    /* depth axis label */
    sf_putstring(model,"label1",label);

    if (NULL != (unit = sf_getstring("unit1"))) /* depth axis unit */
	sf_putstring(model,"unit1",unit);

    inter = sf_floatalloc2(n2,ninf);
    inter2 = sf_intalloc(ninf);
    sf_floatread(inter[0],n2*ninf,surface);

    ninf++; /* more layers than interfaces */
    v0 = sf_floatalloc(ninf);
    x0 = sf_floatalloc(ninf);
    z0 = sf_floatalloc(ninf);
    dvdx = sf_floatalloc(ninf);
    dvdz = sf_floatalloc(ninf);

    /* Input layer velocities and velocity derivatives */
    if (!sf_getfloats("x0",x0,ninf)) 
	for(i=0;i< ninf;i++) x0[i] = 0.;
    if (!sf_getfloats("z0",z0,ninf))
	for(i=0;i< ninf;i++) z0[i] = 0.;
    if (!sf_getfloats("v00",v0,ninf))
	for(i=0;i< ninf;i++) v0[i] = 1500.+ 500*i;
    if (!sf_getfloats("dvdx",dvdx,ninf)) 
	for(i=0;i< ninf;i++) dvdx[i] = 0.;
    if (!sf_getfloats("dvdz",dvdz,ninf)) 
	for(i=0;i< ninf;i++) dvdz[i] = 0.;

    trace = sf_floatalloc(n1);

    /* compute linear velocity */
    for(i2=0; i2 < n2; i2++) { 
	x = o2+i2*d2;
	for (i=0; i < ninf-1; i++) {
	    inter2[i] = floorf(0.5+(inter[i][i2]-o1)/d1);
	}
	for(i1=0; i1 < n1; i1++) {
	    z = o1+i1*d1;
	    for (i=0; i < ninf-1; i++) {
		if (i1 < inter2[i]) break;
	    }
	    trace[i1] = v0[i] + (x-x0[i])*dvdx[i] + (z-z0[i])*dvdz[i];
	}
	sf_floatwrite(trace,n1,model);
    }

    exit(0);
}
Exemplo n.º 5
0
int main(int argc, char* argv[])
{ 
    int i, j, is, ip, dim, n[SF_MAX_DIM], ii[SF_MAX_DIM];
    int nsp, **k=NULL, **l=NULL, n1, n2, i1, i2, kk, ll;
    char key[7];
    const char *label, *unit;
    float f, *trace, *mag=NULL, **p=NULL, pp;
    sf_file in, spike;

    sf_init (argc,argv);

    if (!sf_stdin()) { /* no input file in stdin */
	in = NULL;
    } else {
	in = sf_input("in");
    }

    spike = sf_output("out");
    
    if (NULL == in) {
	sf_setformat(spike,"native_float");
    } else if (SF_FLOAT != sf_gettype(in)) {
	sf_error("Need float input");
    }
    
    /* dimensions */
    for (i=0; i < SF_MAX_DIM; i++) {
	snprintf(key,3,"n%d",i+1);
	if (!sf_getint(key,n+i) && 
	    (NULL == in || !sf_histint(in,key,n+i))) break;
	/*( n# size of #-th axis )*/  
	sf_putint(spike,key,n[i]);
    }

    if (0==i) sf_error("Need n1=");
    dim=i;
    
    /* basic parameters */
    for (i=0; i < dim; i++) {
	snprintf(key,3,"o%d",i+1);
	if (!sf_getfloat(key,&f) && 
	    (NULL == in || !sf_histfloat(in,key,&f))) f=0.;
	/*( o#=[0,0,...] origin on #-th axis )*/  
	sf_putfloat(spike,key,f);

	snprintf(key,3,"d%d",i+1);
	if (!sf_getfloat(key,&f) &&
	    (NULL == in || !sf_histfloat(in,key,&f))) f = (i==0)? 0.004: 0.1;
	/*( d#=[0.004,0.1,0.1,...] sampling on #-th axis )*/  
	sf_putfloat(spike,key,f);

	snprintf(key,7,"label%d",i+1);
	if (NULL == (label = sf_getstring(key)) &&
	    (NULL == in || NULL == (label = sf_histstring(in,key))))
	    label = (i==0)? "Time":"Distance";
	/*( label#=[Time,Distance,Distance,...] label on #-th axis )*/  
	if (*label != '\0' && (*label != ' ' || *(label+1) != '\0')) 	
	    sf_putstring(spike,key,label);

	snprintf(key,6,"unit%d",i+1);
	if (NULL == (unit = sf_getstring(key)) &&
	    (NULL == in || NULL == (unit = sf_histstring(in,key))))
	    unit = (i==0)? "s":"km";
        /*( unit#=[s,km,km,...] unit on #-th axis )*/  
	if (*unit != '\0' && (*unit != ' ' || *(unit+1) != '\0')) 	
	    sf_putstring(spike,key,unit);
    }
	
    if (NULL != (label = sf_getstring("title")))
	sf_putstring(spike,"title",label);
    /* title for plots */

    if (!sf_getint("nsp",&nsp)) nsp=1;
    /* Number of spikes */

    if (nsp >= 1) { 
	mag = sf_floatalloc (nsp);
	k = sf_intalloc2 (nsp,dim);
	l = sf_intalloc2 (nsp,dim);
	p = sf_floatalloc2 (nsp,dim);
    
	for (i=0; i < dim; i++) {
	    snprintf(key,3,"k%d",i+1);
	    if ( !sf_getints(key,k[i],nsp)) {
		/*( k#=[0,...] spike starting position )*/
		for (is=0; is < nsp; is++) {
		    k[i][is]=-1;
		}
	    } else {
		for (is=0; is < nsp; is++) {
		    if (k[i][is] > n[i]) 
			sf_error("Invalid k%d[%d]=%d > n%d=%d",
				 i+1,is+1,k[i][is],i+1,n[i]);
		    k[i][is]--; /* C notation */
		}
	    }
	    snprintf(key,3,"l%d",i+1);
	    if (!sf_getints(key,l[i],nsp)) {
		/*( l#=[k1,k2,...] spike ending position )*/
		for (is=0; is < nsp; is++) {
		    l[i][is]=k[i][is];
		}
	    } else {
		for (is=0; is < nsp; is++) {
		    if (l[i][is] > n[i]) 
			sf_error("Invalid l%d[%d]=%d > n%d=%d",
				 i+1,is+1,l[i][is],i+1,n[i]);
		    l[i][is]--; /* C notation */
		}
	    }	
	    snprintf(key,3,"p%d",i+1);
	    if (!sf_getfloats(key,p[i],nsp)) {
		/*( p#=[0,...] spike inclination (in samples) )*/
		for (is=0; is < nsp; is++) {
		    p[i][is]=0.;
		}
	    }
	}
	
	if (!sf_getfloats("mag",mag,nsp)) {
	    /* spike magnitudes */
	    for (is=0; is < nsp; is++) {
		mag[is]=1.;
	    }
	}
    }

    n1 = n[0];
    n2 = sf_leftsize(spike,1);

    trace = sf_floatalloc (n[0]);

    for (i2=0; i2 < n2; i2++) { /* loop over traces */
	sf_line2cart(dim-1, n+1, i2, ii+1);
	/* zero trace */
	for (i1=0; i1 < n1; i1++) trace[i1]=0.;
	/* put spikes in it */
	for (is=0; is < nsp; is++) { /* loop over spikes */
	    pp = 0.;
	    for (i=1; i < dim; i++) {
		kk = k[i][is];
		ll = l[i][is];
		if ((kk < -1 && ll < -1) || 
		    (kk >= 0 && ll >= 0 && 
		     (kk > ii[i] || ll < ii[i]))) break;
		pp += p[i][is]*(ii[i]-k[i][is]-1);
	    }
	    if (i < dim) continue; /* skip this spike */

	    /* linear interpolation */
	    ip = floorf(pp);
	    pp = 1.-(pp-ip);

	    kk = k[0][is];
	    ll = l[0][is];
	    if (kk >= 0) { /* one segment per trace */
		kk = SF_MAX(kk+ip,0);
		ll = SF_MIN(ll+ip,n1-1);
	    } else {
		kk = SF_MAX(ip,0);
		ll = SF_MIN(n1-1+ip,n1-1);
	    }

	    for (j=kk; j <= ll; j++) {
		trace[j] += pp*mag[is];
		if (j+1 < n1) trace[j+1] += (1.-pp)*mag[is];
	    }
	}
	sf_floatwrite(trace,n1,spike);
    }

    exit (0);
}
Exemplo n.º 6
0
Arquivo: Mpsp.c Projeto: filippo82/src
int main(int argc, char* argv[])
{

    /*survey parameters*/
    int   nx, nz;
    float dx, dz;
    int   n_srcs;
    int   *spx, *spz;
    int   gpz, gpx, gpl;
    int   gpz_v, gpx_v, gpl_v;
    int   snap;
    /*fft related*/
    bool  cmplx;
    int   pad1;
    /*absorbing boundary*/
    bool abc;
    int nbt, nbb, nbl, nbr;
    float ct,cb,cl,cr;
    /*source parameters*/
    int src; /*source type*/
    int nt,ntsnap;
    float dt,*f0,*t0,*A;
    /*misc*/
    bool verb, ps, mig;
    float vref;

    pspar par;
    int nx1, nz1; /*domain of interest*/
    int it;
    float *vel,**dat,**dat_v,**wvfld,*img; /*velocity profile*/
    sf_file Fi,Fo,Fd,Fd_v,snaps; /* I/O files */
    sf_axis az,ax; /* cube axes */

    sf_init(argc,argv);

    if (!sf_getint("snap",&snap)) snap=0; /* interval for snapshots */
    if (!sf_getbool("cmplx",&cmplx)) cmplx=true; /* use complex fft */
    if (!sf_getint("pad1",&pad1)) pad1=1; /* padding factor on the first axis */
    if(!sf_getbool("abc",&abc)) abc=false; /* absorbing flag */
    if (abc) {
      if(!sf_getint("nbt",&nbt)) sf_error("Need nbt!");
      if(!sf_getint("nbb",&nbb)) nbb = nbt;
      if(!sf_getint("nbl",&nbl)) nbl = nbt;
      if(!sf_getint("nbr",&nbr)) nbr = nbt;
      if(!sf_getfloat("ct",&ct)) sf_error("Need ct!");
      if(!sf_getfloat("cb",&cb)) cb = ct;
      if(!sf_getfloat("cl",&cl)) cl = ct;
      if(!sf_getfloat("cr",&cr)) cr = ct;
    } else {
      nbt = 0; nbb = 0; nbl = 0; nbr = 0;
      ct = 0; cb = 0; cl = 0; cr = 0;
    }
    if (!sf_getbool("verb",&verb)) verb=false; /* verbosity */
    if (!sf_getbool("ps",&ps)) ps=false; /* use pseudo-spectral */
    if (ps) sf_warning("Using pseudo-spectral...");
    else sf_warning("Using pseudo-analytical...");
    if (!sf_getbool("mig",&mig)) mig=false; /* use pseudo-spectral */
    if (mig) sf_warning("Time-reversal propagation");
    else sf_warning("Forward modeling");
    if (!sf_getfloat("vref",&vref)) vref=1500; /* reference velocity (default using water) */

    /* setup I/O files */
    Fi = sf_input ("in");
    Fo = sf_output("out");
    if (mig) {
      gpl = -1;
      gpl_v = -1;
      if (NULL==sf_getstring("dat") && NULL==sf_getstring("dat_v"))
	sf_error("Need Data!");
      if (NULL!=sf_getstring("dat")) {
	Fd = sf_input("dat");
	sf_histint(Fd,"n1",&nt);
	sf_histfloat(Fd,"d1",&dt);
	sf_histint(Fd,"n2",&gpl);
      } else Fd = NULL;
      if (NULL!=sf_getstring("dat_v")) {
	Fd_v = sf_input("dat_v");
	sf_histint(Fd_v,"n1",&nt);
	sf_histfloat(Fd_v,"d1",&dt);
	sf_histint(Fd_v,"n2",&gpl_v);
      } else Fd_v = NULL;
      src = -1; n_srcs = -1;
      spx = NULL; spz = NULL;
      f0 = NULL; t0 = NULL; A = NULL;
    } else {
      Fd = NULL;
      if (!sf_getint("nt",&nt)) sf_error("Need nt!");
      if (!sf_getfloat("dt",&dt)) sf_error("Need dt!");
      if (!sf_getint("gpl",&gpl)) gpl = -1; /* geophone length */
      if (!sf_getint("gpl_v",&gpl_v)) gpl_v = -1; /* geophone height */
      if (!sf_getint("src",&src)) src=0; /* source type */
      if (!sf_getint("n_srcs",&n_srcs)) n_srcs=1; /* source type */
      spx = sf_intalloc(n_srcs);
      spz = sf_intalloc(n_srcs);
      f0  = sf_floatalloc(n_srcs);
      t0  = sf_floatalloc(n_srcs);
      A   = sf_floatalloc(n_srcs);
      if (!sf_getints("spx",spx,n_srcs)) sf_error("Need spx!"); /* shot position x */
      if (!sf_getints("spz",spz,n_srcs)) sf_error("Need spz!"); /* shot position z */
      if (!sf_getfloats("f0",f0,n_srcs)) sf_error("Need f0! (e.g. 30Hz)");   /*  wavelet peak freq */
      if (!sf_getfloats("t0",t0,n_srcs)) sf_error("Need t0! (e.g. 0.04s)");  /*  wavelet time lag */
      if (!sf_getfloats("A",A,n_srcs)) sf_error("Need A! (e.g. 1)");     /*  wavelet amplitude */
    }
    if (!sf_getint("gpx",&gpx)) gpx = -1; /* geophone position x */
    if (!sf_getint("gpz",&gpz)) gpz = -1; /* geophone position z */
    if (!sf_getint("gpx_v",&gpx_v)) gpx_v = -1; /* geophone position x */
    if (!sf_getint("gpz_v",&gpz_v)) gpz_v = -1; /* geophone position z */

    if (SF_FLOAT != sf_gettype(Fi)) sf_error("Need float input");

    /* Read/Write axes */
    az = sf_iaxa(Fi,1); nz = sf_n(az); dz = sf_d(az);
    ax = sf_iaxa(Fi,2); nx = sf_n(ax); dx = sf_d(ax);
    nz1 = nz-nbt-nbb;
    nx1 = nx-nbl-nbr;
    if (gpx==-1) gpx = nbl;
    if (gpz==-1) gpz = nbt;
    if (gpl==-1) gpl = nx1;
    if (gpx_v==-1) gpx_v = nbl;
    if (gpz_v==-1) gpz_v = nbt;
    if (gpl_v==-1) gpl_v = nz1;
    ntsnap=0;
    if (snap)
        for (it=0;it<nt;it++)
            if (it%snap==0) ntsnap++;

    if (mig) { /*output final wavefield*/
      sf_setn(az,nz1);
      sf_setn(ax,nx1);
      sf_oaxa(Fo,az,1);
      sf_oaxa(Fo,ax,2);
      sf_settype(Fo,SF_FLOAT);
    } else { /*output data*/
      sf_setn(ax,gpl);
      /*output horizontal data is mandatory*/
      sf_putint(Fo,"n1",nt);
      sf_putfloat(Fo,"d1",dt);
      sf_putfloat(Fo,"o1",0.);
      sf_putstring(Fo,"label1","Time");
      sf_putstring(Fo,"unit1","s");
      sf_oaxa(Fo,ax,2);
      sf_settype(Fo,SF_FLOAT);
      /*output vertical data is optional*/
      if (NULL!=sf_getstring("dat_v")) {
	Fd_v = sf_output("dat_v");
	sf_setn(az,gpl_v);
	sf_putint(Fd_v,"n1",nt);
	sf_putfloat(Fd_v,"d1",dt);
	sf_putfloat(Fd_v,"o1",0.);
	sf_putstring(Fd_v,"label1","Time");
	sf_putstring(Fd_v,"unit1","s");
	sf_oaxa(Fd_v,az,2);
	sf_settype(Fd_v,SF_FLOAT);	
      } else Fd_v = NULL;
    }

    if (snap > 0) {
	snaps = sf_output("snaps");
	/* (optional) snapshot file */
	sf_setn(az,nz1);
	sf_setn(ax,nx1);
	sf_oaxa(snaps,az,1);
	sf_oaxa(snaps,ax,2);
	sf_putint(snaps,"n3",ntsnap);
	sf_putfloat(snaps,"d3",dt*snap);
	sf_putfloat(snaps,"o3",0.);
	sf_putstring(snaps,"label3","Time");
	sf_putstring(snaps,"unit3","s");
    } else snaps = NULL;
    
    par = (pspar) sf_alloc(1,sizeof(*par));
    vel = sf_floatalloc(nz*nx);
    if (mig && NULL==Fd) dat = NULL;
    else dat = sf_floatalloc2(nt,gpl);
    if (NULL!=Fd_v) dat_v = sf_floatalloc2(nt,gpl_v);
    else dat_v = NULL;
    if (mig) img = sf_floatalloc(nz1*nx1);
    else img = NULL;
    if (snap>0) wvfld = sf_floatalloc2(nx1*nz1,ntsnap);
    else wvfld = NULL;

    sf_floatread(vel,nz*nx,Fi);
    if (mig) {
      if (NULL!=Fd)   sf_floatread(dat[0],gpl*nt,Fd);
      if (NULL!=Fd_v) sf_floatread(dat_v[0],gpl_v*nt,Fd_v);
    }

    /*passing the parameters*/
    par->nx    = nx;  
    par->nz    = nz;
    par->dx    = dx;
    par->dz    = dz;
    par->n_srcs= n_srcs;
    par->spx   = spx;
    par->spz   = spz;
    par->gpz   = gpz;
    par->gpx   = gpx;
    par->gpl   = gpl;
    par->gpz_v = gpz_v;
    par->gpx_v = gpx_v;
    par->gpl_v = gpl_v;
    par->snap  = snap;
    par->cmplx = cmplx;
    par->pad1  = pad1;
    par->abc   = abc;
    par->nbt   = nbt;
    par->nbb   = nbb;
    par->nbl   = nbl;
    par->nbr   = nbr;
    par->ct    = ct;
    par->cb    = cb;
    par->cl    = cl;
    par->cr    = cr;
    par->src   = src;
    par->nt    = nt;
    par->dt    = dt;
    par->f0    = f0;
    par->t0    = t0;
    par->A     = A;
    par->verb  = verb;
    par->ps    = ps;
    par->vref  = vref;

    /*do the work*/
    psp(wvfld, dat, dat_v, img, vel, par, mig);

    if (mig) {
      sf_floatwrite(img,nz1*nx1,Fo);
    } else {
      sf_floatwrite(dat[0],gpl*nt,Fo);
      if (NULL!=Fd_v)
	sf_floatwrite(dat_v[0],gpl_v*nt,Fd_v);
    }

    if (snap>0)
      sf_floatwrite(wvfld[0],nz1*nx1*ntsnap,snaps);
    
    exit (0);
}
Exemplo n.º 7
0
int main(int argc, char* argv[])
{
  int verbose;
  sf_file in=NULL, out=NULL;
  int n1_traces;
  int n1_headers;

  char* header_format=NULL;
  sf_datatype typehead;
  /* kls do I need to add this?  sf_datatype typein; */
  float* fheader=NULL;
  float* intrace=NULL;
  int numkeys;
  int ikey;
  char** list_of_keys;
  int *indx_of_keys;
  int indx_time;
  bool pkeychanged;
  float* stktrace=NULL;
  float* stkheader=NULL;
  float* time_variant_fold=NULL;
  int eof_get_tah;
  int fold;
  int itrace=0;
  int ntaper;
  int numxmute;
  int numtmute;
  float* taper;
  char **list_of_floats;
  float* xmute;
  float* tmute;
  int indx_of_offset;
  float offset;
  float d1;
  float o1;
  float mute_start;
  int imute_start;
  int indx_taper;


  /*****************************/
  /* initialize verbose switch */
  /*****************************/
  sf_init (argc,argv);

  if(!sf_getint("verbose",&verbose))verbose=1;
    /* \n
     flag to control amount of print
     0 terse, 1 informative, 2 chatty, 3 debug
  */
  sf_warning("verbose=%d",verbose);
 
  /******************************************/
  /* input and output data are stdin/stdout */
  /******************************************/

  if(verbose>0)fprintf(stderr,"read in file name\n");  
  in = sf_input ("in");

  if(verbose>0)fprintf(stderr,"read out file name\n");
  out = sf_output ("out");

  if (!sf_histint(in,"n1_traces",&n1_traces))
    sf_error("input data not define n1_traces");
  if (!sf_histint(in,"n1_headers",&n1_headers)) 
    sf_error("input data does not define n1_headers");

  header_format=sf_histstring(in,"header_format");
  if(strcmp (header_format,"native_int")==0) typehead=SF_INT;
  else                                       typehead=SF_FLOAT;

  if(verbose>0)fprintf(stderr,"allocate headers.  n1_headers=%d\n",n1_headers);
  fheader = sf_floatalloc(n1_headers);
 
  if(verbose>0)fprintf(stderr,"allocate intrace.  n1_traces=%d\n",n1_traces);
  intrace= sf_floatalloc(n1_traces);

  if(verbose>0)fprintf(stderr,"call list of keys\n");
 
  if(!(list_of_keys=sf_getnstring("key",&numkeys)))
    fprintf(stderr,"key not input\n");
  /*  List of header keys to monitor to determine when to break between 
      gathers.  A gather is a sequence of traces with the same value for
      all the header keys.  Stack summs traces in the gather, divides
      by the fold, and outputs the stack trace. */

  if(verbose>0)fprintf(stderr,"after sf_getnstring\n");

  if(list_of_keys==NULL)
    sf_error("The required parameter \"key\" was not found.");
  /* I wanted to use sf_getstrings, but it seems to want a colon seperated
     list of keys (eg key=offset:ep:fldr:cdp) and I wanted a comma seperated
     list of keys (eg key=offset:ep:fldr:cdp).
  numkeys=sf_getnumpars("key");
  if(numkeys==0)
    sf_error("The required parameter \"key\" was not found.");
  fprintf(stderr,"alloc list_of_keys numkeys=%d\n",numkeys);
  list_of_keys=(char**)sf_alloc(numkeys,sizeof(char*)); 
  sf_getstrings("key",list_of_keys,numkeys);
  */
  /* print the list of keys */
  if(verbose>1){
    fprintf(stderr,"numkeys=%d\n",numkeys);
    for(ikey=0; ikey<numkeys; ikey++){
      fprintf(stderr,"list_of_keys[%d]=%s\n",ikey,list_of_keys[ikey]);
    }
  }
  
  /* maybe I should add some validation that n1== n1_traces+n1_headers+2
     and the record length read in the second word is consistent with 
     n1.  */

  /**********************************************************/
  /* end code block for standard tah Trace And Header setup */
  /* continue with any sf_puthist this tah program calls to */
  /* add to the history file                                */
  /**********************************************************/

  /* put the history from the input file to the output */
  sf_fileflush(out,in);

  /********************************************************/
  /* continue initialization specific to this tah program */
  /********************************************************/

  /* segy_init gets the list header keys required by segykey function  */
  segy_init(n1_headers,in);
  indx_of_keys=sf_intalloc(numkeys);
  for (ikey=0; ikey<numkeys; ikey++){
    /* kls need to check each of these key names are in the segy header and
       make error message for invalid keys.  Of does segykey do this? NO, just
       segmentation fault. */
    indx_of_keys[ikey]=segykey(list_of_keys[ikey]);
  }
  /* get the mute parameters */
  if(NULL==(list_of_floats=sf_getnstring("xmute",&numxmute))){
    xmute=NULL;
    numxmute=0;
  } else {
    xmute=sf_floatalloc(numxmute);
    if(!sf_getfloats("xmute",xmute,numxmute))sf_error("unable to read xmute");
  }
  if(NULL==(list_of_floats=sf_getnstring("tmute",&numtmute))){
    tmute=NULL;
    numtmute=0;
  } else {
    tmute=sf_floatalloc(numtmute);
    if(!sf_getfloats("tmute",tmute,numtmute))sf_error("unable to read tmute");
  }
  if(numxmute!=numtmute)sf_error("bad mute parameters: numxmute!=numtmute");
  if(numxmute<=0) {
      ntaper=0;
      indx_of_offset=0;
      taper=NULL;
  } else {
    if(!sf_getint("ntaper",&ntaper))ntaper=12;
    /* \n
       length of the taper on the stack mute
    */
    taper=sf_floatalloc(ntaper);
    for(indx_time=0; indx_time<ntaper; indx_time++){
      float val_sin=sin((indx_time+1)*SF_PI/(2*ntaper));
      taper[indx_time]=val_sin*val_sin;
    }
    indx_of_offset=segykey("offset");
  }

  if (!sf_histfloat(in,"d1",&d1))
    sf_error("input data does not define d1");
  if (!sf_histfloat(in,"o1",&o1))
    sf_error("input data does not define o1");

  stktrace          = sf_floatalloc(n1_traces);
  stkheader         = sf_floatalloc(n1_headers);
  time_variant_fold = sf_floatalloc(n1_traces);

  /***************************/
  /* start trace loop        */
  /***************************/
  if(verbose>0)fprintf(stderr,"start trace loop\n");
 
  itrace=0;
  eof_get_tah=get_tah(intrace, fheader, n1_traces, n1_headers, in);
  fold=0;
  while (!eof_get_tah){
    if(verbose>1 && itrace<5)fprintf(stderr,"process the tah in sftahstack\n");
    /********************/
    /* process the tah. */
    /********************/
    /* this program stacks sequential traces with matching pkey.  If one of the 
       headers in pkey changes, the summed trace is divided by the time 
       variant fold and output.
    */
    if(fold==0){
      memcpy(stkheader,fheader,n1_headers*sizeof(int));
      for(indx_time=0; indx_time<n1_traces; indx_time++){
	time_variant_fold[indx_time]=0.0;
	stktrace[indx_time]=0.0;
      }
    }
    if(xmute==NULL)mute_start=o1;
    else{
      if(typehead == SF_INT)offset=((int  *)fheader)[indx_of_offset];
      else                  offset=((float*)fheader)[indx_of_offset];
      intlin(numxmute,xmute,tmute,
	     tmute[0],tmute[numxmute-1],1,
	     &offset,&mute_start);
      if(mute_start<o1)mute_start=o1;
    }
    imute_start=(int)(((mute_start-o1)/d1)+.5);
    if(0)fprintf(stderr,"imute_start=%d\n",imute_start);
    for(; imute_start<n1_traces && intrace[imute_start]==0;
	  imute_start++); /* increate imute_start to first non-zero sample */
    if(0)fprintf(stderr,"updated imute_start=%d\n",imute_start);
    for(indx_time=imute_start, indx_taper=0; 
	indx_time<imute_start+ntaper && indx_time<n1_traces; 
	indx_time++, indx_taper++){
      stktrace[indx_time]+=taper[indx_taper]*intrace[indx_time];
      time_variant_fold[indx_time]+=taper[indx_taper];
    }
    for(; indx_time<n1_traces; indx_time++){
      stktrace[indx_time]+=intrace[indx_time];
      time_variant_fold[indx_time]++;
    }

    fold++;
    eof_get_tah=get_tah(intrace, fheader, n1_traces, n1_headers, in);

    /* did any of the header keys in indx_of_keys change? */
    pkeychanged=false;
    if(itrace>0){
      for(ikey=0; ikey<numkeys; ikey++){
	if(typehead == SF_INT){
	  if(((int*)fheader  )[indx_of_keys[ikey]]!=
	     ((int*)stkheader)[indx_of_keys[ikey]]){
	    pkeychanged=true;
	    break;
	  }
	} else {
	  if(fheader[indx_of_keys[ikey]]!=stkheader[indx_of_keys[ikey]]){
	    pkeychanged=true;
	    break;
	  }
	}
      }
    }
    /* if one of the headers changes, apply fold recovery, output trace, and 
       set fold=0.  Fold=0 will initialize the stktrace to zero at top f loop*/
    if(pkeychanged){
      /***********************************/
      /* divide by the time variant fold */
      /***********************************/
      if(verbose>1)fprintf(stderr,"pkeychanged.  divide by fold\n");
      for(indx_time=0; indx_time<n1_traces; indx_time++){
	if(time_variant_fold[indx_time]<1.0)time_variant_fold[indx_time]=1.0;
	stktrace[indx_time]/=time_variant_fold[indx_time];
      }   
      /* kls set any headers? Maybe fold? offset? */
      /***************************/
      /* write trace and headers */
      /***************************/
      if(verbose>1)fprintf(stderr,"put_tah\n");
      put_tah(stktrace, stkheader, n1_traces, n1_headers, out);
      fold=0;
    }
    itrace++;
  }

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

	sf_file  out;
	int i1, n1;
	float o1, d1, *u1, par[4];
	char *waveform;
	sf_init(argc, argv);

	out = sf_output("out");

	if ((waveform=sf_getstring("waveform"))==NULL) waveform="ricker";
	/* waveform: ricker,sinc,harmonic,randn,rand */
	if (!sf_getfloats("para", par, 4)) {par[0] = 25.0; par[1] = 0.0;}
/* parameters of waveform\n
  ricker(freq)
  sinc(freq)
  harmonic(freq,phase)
  randn(seed)
  rand(seed)
*/
	if (!sf_getint("n", &n1)) n1 = 100;
	/* length */
	if (!sf_getfloat("o", &o1)) o1 = 0.0;
	/* original */
	if (!sf_getfloat("d", &d1)) d1 = 0.004;
	/* interval */

	sf_putint(out, "n1", n1);
	sf_putfloat(out, "o1", o1);
	sf_putfloat(out, "d1", d1);

	u1 = sf_floatalloc(n1);

	if(strcmp(waveform, "ricker")==0)
	{
		for(i1=0; i1<n1; i1++)	u1[i1] = o1+d1*i1;
		sf_wvlt_rck(n1, u1, par);
	}else if(strcmp(waveform, "harmonic")==0)
	{
		for(i1=0; i1<n1; i1++)	u1[i1] = o1+d1*i1;
		sf_wvlt_harmonic(n1, u1, par);
	}else if(strcmp(waveform, "sinc")==0)
	{
		for(i1=0; i1<n1; i1++)	u1[i1] = o1+d1*i1;
		sf_wvlt_sinc(n1, u1, par);
	}else if(strcmp(waveform, "randn")==0)
	{
		init_genrand(par[0]);
		sf_randn(n1, u1);
	}else if(strcmp(waveform, "rand")==0)
	{
		init_genrand(par[0]);
		sf_random(n1, u1);
	}else sf_error("waveform %s not implemented", waveform);

	sf_floatwrite(u1, n1, out);

	free(u1);
	return 0;

}
Exemplo n.º 9
0
int main(int argc, char* argv[])
{
    int verbose;
    sf_file in=NULL, out=NULL;
    int n1_traces;
    int n1_headers;

    char* header_format=NULL;
    sf_datatype typehead;
    /* kls do I need to add this?  sf_datatype typein; */
    float* fheader=NULL;
    float* intrace=NULL;
    float* outtrace=NULL;
    float* bandlimittrace=NULL;
    float* rmsall=NULL;
    float* rmsband=NULL;
    float* scalars=NULL;
    float* sum_of_scalars=NULL;
    int indx_time;
    int itrace=0;
    int ntaper;
    int numxstart;
    int numtstart;
    float* taper;
    char **list_of_floats;
    float* xstart;
    float* tstart;
    int indx_of_offset;
    float offset;
    float d1;
    float o1;
    float time_start;
    int itime_start;
    int itime_stop;
    int indx_taper;
    float wagc;
    int lenagc;

    float fmin=5;
    float fmax=95;
    float finc=5;
    int num_centerfreq;
    int firstlive;
    int lastlive;
    float pnoise;

    kiss_fftr_cfg cfg,icfg;
    sf_complex *fft1;
    sf_complex *fft2;
    int nfft;
    int nf;
    float df;
    float scale;
    int ifreq;
    float cntrfreq;
    
    /*****************************/
    /* initialize verbose switch */
    /*****************************/
    sf_init (argc,argv);

    if(!sf_getint("verbose",&verbose))verbose=1;
    /* \n
       flag to control amount of print
       0 terse, 1 informative, 2 chatty, 3 debug
    */
    sf_warning("verbose=%d",verbose);
 
    /******************************************/
    /* input and output data are stdin/stdout */
    /******************************************/

    if(verbose>0)fprintf(stderr,"read in file name\n");  
    in = sf_input ("in");

    if(verbose>0)fprintf(stderr,"read out file name\n");
    out = sf_output ("out");

    if (!sf_histint(in,"n1_traces",&n1_traces))
	sf_error("input data not define n1_traces");
    if (!sf_histint(in,"n1_headers",&n1_headers)) 
	sf_error("input data does not define n1_headers");

    header_format=sf_histstring(in,"header_format");
    if(strcmp (header_format,"native_int")==0) typehead=SF_INT;
    else                                       typehead=SF_FLOAT;

    if(verbose>0)fprintf(stderr,"allocate headers.  n1_headers=%d\n",n1_headers);
    fheader = sf_floatalloc(n1_headers);
 
    /*  allocate intrace and outtrace after initialize fft and 
	make them padded */
  
    /* maybe I should add some validation that n1== n1_traces+n1_headers+2
       and the record length read in the second word is consistent with 
       n1.  */

    /**********************************************************/
    /* end code block for standard tah Trace And Header setup */
    /* continue with any sf_puthist this tah program calls to */
    /* add to the history file                                */
    /**********************************************************/

    /* put the history from the input file to the output */
    sf_fileflush(out,in);

    /********************************************************/
    /* continue initialization specific to this tah program */
    /********************************************************/





    /* segy_init gets the list header keys required by segykey function  */
    segy_init(n1_headers,in);

    if(0==1) {  
      /* infuture may want to have offset dependent agc design start time */
      /* get the mute parameters */
      if(NULL==(list_of_floats=sf_getnstring("xstart",&numxstart))){
	xstart=NULL;
	sf_error("xstart is a required parameter in sftahagc");
      } else {
	xstart=sf_floatalloc(numxstart);
	if(!sf_getfloats("xstart",xstart,numxstart))sf_error("unable to read xstart");
      }
      if(NULL==(list_of_floats=sf_getnstring("tstart",&numtstart))){
	tstart=NULL;
	sf_error("xstart is a required parameter in sftahagc");
      } else {
	tstart=sf_floatalloc(numtstart);
	if(!sf_getfloats("tstart",tstart,numtstart))sf_error("unable to read tstart");
      }
      if(numxstart!=numtstart)sf_error("bad mute parameters: numxstart!=numtstart");
      if(!sf_getint("ntaper",&ntaper))ntaper=12;
    }
    /* \n
       length of the taper on the stack mute
    */
    /* is this of use for agc?
    taper=sf_floatalloc(ntaper);
    for(indx_time=0; indx_time<ntaper; indx_time++){
	float val_sin=sin((indx_time+1)*SF_PI/(2*ntaper));
	taper[indx_time]=val_sin*val_sin;
    }
    */
    indx_of_offset=segykey("offset");
    
    if (!sf_histfloat(in,"d1",&d1))
      sf_error("input data does not define d1");
    if (!sf_histfloat(in,"o1",&o1))
      sf_error("input data does not define o1");

    /* check wagc for reasonableness.  I input 250 (not .25 and ,250) */  
    if(!sf_getfloat("wagc",&wagc))wagc=-1;
    /* \n
       length of the agc window in seconds
    */
    if(wagc<0)sf_error("wagc is a required parameter in sftahagc");

    lenagc=wagc/d1+1.5; /* length of the agc window in samples */
 
    if (!sf_getfloat("pnoise",  &pnoise)) pnoise = 0.01;
    /* relative additive noise level */
    
    if (!sf_getfloat("fmin",&fmin))fmin=5;
    /* minimum frequency band */
    if (!sf_getfloat("fmax",&fmax))fmax=95;
    /* maximum frequency band */
    if (!sf_getfloat("finc",&finc))finc=5;
    /* frequency band increment */

    /* initialize kiss_fft kls */

    nfft  = kiss_fft_next_fast_size(n1_traces+200);
    nf    = nfft/2+1;
    df    = 1./(nfft*d1);
    scale = 1./nfft;
    cfg   = kiss_fftr_alloc(nfft,0,NULL,NULL);
    icfg  = kiss_fftr_alloc(nfft,1,NULL,NULL);
    fft1  = sf_complexalloc(nf);
    fft2  = sf_complexalloc(nf);
    if(verbose>0)fprintf(stderr,"fmax=%f\n",(nf-1)*df);

    /* allocate input and output traces with enough padding for
       ffts */
    if(verbose>0)
      fprintf(stderr,"allocate padded intrace.  n1_traces=%d nfft=%d\n",
	                                        n1_traces,   nfft);
    intrace       =sf_floatalloc(nfft); /* must be padded for input to fft */
    bandlimittrace=sf_floatalloc(nfft); /* must be padded for input to fft */
    outtrace= sf_floatalloc(n1_traces);
    rmsall        =sf_floatalloc(n1_traces);
    rmsband        =sf_floatalloc(n1_traces);
    scalars       =sf_floatalloc(n1_traces);
    sum_of_scalars=sf_floatalloc(n1_traces);
    num_centerfreq=(fmax-fmin)/finc+1.95;
    if(fabs(fmax-(fmin+(num_centerfreq-1)*finc))>.01){
      fprintf(stderr,"*************************************\n");
      fprintf(stderr,"*************************************\n");
      fprintf(stderr,"*************************************\n");
      fprintf(stderr,"fmin-fmax is not a multiple of finc\n");
      fprintf(stderr,"fmin=%f, fmax=%f, finc=%f\n",fmin,fmax,finc);
      fprintf(stderr,"*************************************\n");
      fprintf(stderr,"*************************************\n");
      sf_error("illegal combination of fmin,fmax,fminc");
    }

    /***************************/
    /* start trace loop        */
    /***************************/
    if(verbose>0)fprintf(stderr,"start trace loop\n");
 
    itrace=0;
    while (!(get_tah(intrace, fheader, n1_traces, n1_headers, in))){
	if(verbose>1 || (verbose==1 && itrace<5)){
	    fprintf(stderr,"process tah %d in sftahagc\n",itrace);
	}
	/********************/
	/* process the tah. */
	/********************/

	if(typehead == SF_INT)offset=((int  *)fheader)[indx_of_offset];
	else                  offset=((float*)fheader)[indx_of_offset];
	/* maybe latter add agc design start time
	intlin(numxstart,xstart,tstart,
	       tstart[0],tstart[numxstart-1],1,
	       &offset,&time_start);
	if(time_start<o1)time_start=o1;

	itime_start=(int)(((time_start-o1)/d1)+.5);
	*/
	/* find firstlive and lastlive */
        if(verbose>2)fprintf(stderr,"find firstlive and lastlive\n");
	for (firstlive=0; firstlive<n1_traces; firstlive++){
	  if(intrace[firstlive] != 0) break;
	}
	for (lastlive=n1_traces-1;lastlive>=0; lastlive--){
	  if(intrace[lastlive] != 0) break;
	}
	/* kls need to catch a zero trace */
        if(verbose>2)
	  fprintf(stderr,"firstlive=%d, lastlive=%d\n",firstlive,lastlive);
	/* zero the padded area on the input trace */
	for (indx_time=n1_traces; indx_time<nfft; indx_time++){
	  intrace[indx_time]=0;
	}
	
	/********************************************************/
	/* apply the SPECtral BALancing:                        */
	/* 1 compute the input trace rms in agclen gates        */
	/* 2 fft to frequency domain                            */
	/* 3 for each frequency band                            */
	/*   3.1 extract (ramp) the frequency band              */
	/*   3.2 convert freqency band to time,                 */
	/*   3.3 compute the rms of the frequency band          */
	/*   3.4 agc scalars 1/(freq_band_rms + whitenoise*rms) */ 
	/*   3.3 agc the frequency band                         */
	/*   3.4 sum to output                                  */
        /*   3.5 sum scalars to sum of scalars                  */
	/* 4 divide by the sum of scalars                       */
	/********************************************************/
	compute_rms(intrace, rmsall,
		    lenagc, n1_traces,
                    firstlive, lastlive);
	/* scale rms by whitenoise factor */
	if(verbose>2)fprintf(stderr,"put_tah rmsall\n");
	if(0) put_tah(intrace, fheader, n1_traces, n1_headers, out);
        if(0) put_tah(rmsall, fheader, n1_traces, n1_headers, out);
	for (indx_time=0; indx_time<n1_traces; indx_time++){
	  rmsall[indx_time]*=(1.0/num_centerfreq);
	}

	if(verbose>2)fprintf(stderr,"fftr\n");
	kiss_fftr(cfg, intrace, (kiss_fft_cpx*) fft1);

	/* zero the output trace and the sum_of_scalars */
	for (indx_time=0; indx_time<n1_traces; indx_time++){
	  outtrace[indx_time]=0.0;
	  sum_of_scalars[indx_time]=0.0;
	}
	for (cntrfreq=fmin; cntrfreq<=fmax; cntrfreq+=finc){
	  if(verbose>2)fprintf(stderr,"cntrfreq=%f\n",cntrfreq);
          /* zero frequencies before the band */
	  for (ifreq=0; ifreq<(int)((cntrfreq-finc)/df); ifreq++){
	    fft2[ifreq]=0.0;
	  }
	  /* triangular weight the selected  frequency band */
	  for (ifreq=(int)((cntrfreq-finc)/df); 
	       ifreq<(int)((cntrfreq+finc)/df) && ifreq<nf;
	       ifreq++){
            float weight;
	    if(ifreq>0){
	      weight=(1.0-fabs(ifreq*df-cntrfreq)/finc)/nfft;
	      fft2[ifreq]=weight*fft1[ifreq];
	    }
	  }
          /* zero frequencies larger than the band */
	  for (ifreq=(int)((cntrfreq+finc)/df); ifreq<nf; ifreq++){
	    fft2[ifreq]=0.0;
	  } 
	  /* inverse fft back to time domain */
          if(verbose>2)fprintf(stderr,"fftri\n");
	  kiss_fftri(icfg,(kiss_fft_cpx*) fft2, bandlimittrace);
          /* apply agc to the bandlimittrace and sum scalars to 
             sum_of_scalars */
	  if(verbose>2)fprintf(stderr,"agc_apply\n");
	  compute_rms(bandlimittrace, rmsband,
		    lenagc, n1_traces,
                    firstlive, lastlive);
	  if(verbose>2)fprintf(stderr,"sum to ouput\n");
	  for (indx_time=0; indx_time<n1_traces; indx_time++){
	    /* old poor 
	       scalars[indx_time]=1.0/
                   (rmsband[indx_time]+pnoise*rmsall[indx_time]);
	    */
	    if(1)scalars[indx_time]=rmsband[indx_time]/
                     (rmsband[indx_time]*rmsband[indx_time]+
		      pnoise*rmsall[indx_time]*rmsall[indx_time]);
	    else scalars[indx_time]=1.0;
	  }
	  for (indx_time=0; indx_time<n1_traces; indx_time++){
	    bandlimittrace[indx_time]*=scalars[indx_time];
	    outtrace[indx_time]+=bandlimittrace[indx_time];
	  }
	  for (indx_time=0; indx_time<n1_traces; indx_time++){
	    sum_of_scalars[indx_time]+=scalars[indx_time];
	  }
          if(0)
	    put_tah(bandlimittrace, fheader, n1_traces, n1_headers, out);
	  if(0)
	    put_tah(rmsband, fheader, n1_traces, n1_headers, out);
	  if(0)
	    put_tah(scalars, fheader, n1_traces, n1_headers, out);
	}
        if(0)put_tah(sum_of_scalars, fheader, n1_traces, n1_headers, out);
        if(1){	
	   /* divide output by sum of scalars */
	  for (indx_time=0; indx_time<n1_traces; indx_time++){
	    outtrace[indx_time]/=sum_of_scalars[indx_time];
	  }
	} 
	if (1)
	  put_tah(outtrace, fheader, n1_traces, n1_headers, out);
	itrace++;
    }

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

    /*survey parameters*/
    int   nx, nz;
    float dx, dz;
    int   n_srcs=1;
    int   *spx, *spz;
    int   gpz, gpx, gpl;
    int   gpz_v, gpx_v, gpl_v;
    int   snap;
    /*fft related*/
    bool  cmplx;
    int   pad1;
    /*absorbing boundary*/
    bool abc;
    int nbt, nbb, nbl, nbr;
    float ct,cb,cl,cr;
    /*source parameters*/
    int src; /*source type*/
    int nt;
    float dt,*f0,*t0,*A;
    /*misc*/
    bool verb, ps, adj;
    float vref;

    bool born;
    pspar par;
    int nx1, nz1; /*domain of interest*/
    float *vel,***dat,***dat_v,**wvfld1,**wvfld,*img,*imgs; /*velocity profile*/
    sf_file Fi,Fo,Fv,Fd_v,snaps; /* I/O files */
    sf_axis az,ax; /* cube axes */
    int shtbgn,shtend,shtnum,shtint;
    int ix,iz,is,which;
    bool justrec;

    bool diff;
    sf_file Fi1;
    float ***dat1;

    sf_init(argc,argv);

    if (!sf_getint("snap",&snap)) snap=0; /* interval for snapshots */
    if (!sf_getbool("cmplx",&cmplx)) cmplx=true; /* use complex fft */
    if (!sf_getint("pad1",&pad1)) pad1=1; /* padding factor on the first axis */
    if(!sf_getbool("abc",&abc)) abc=false; /* absorbing flag */
    if(!sf_getbool("born",&born)) born=false; /* born modeling flag */
    if(!sf_getbool("diff",&diff)) diff=false; /* diffraction imaging flag */
    if(!sf_getbool("justrec",&justrec)) justrec=false; /* just need full waveform record (no born or rtdm) */
    if (abc) {
      if(!sf_getint("nbt",&nbt)) sf_error("Need nbt!");
      if(!sf_getint("nbb",&nbb)) nbb = nbt;
      if(!sf_getint("nbl",&nbl)) nbl = nbt;
      if(!sf_getint("nbr",&nbr)) nbr = nbt;
      if(!sf_getfloat("ct",&ct)) sf_error("Need ct!");
      if(!sf_getfloat("cb",&cb)) cb = ct;
      if(!sf_getfloat("cl",&cl)) cl = ct;
      if(!sf_getfloat("cr",&cr)) cr = ct;
    } else {
      nbt = 0; nbb = 0; nbl = 0; nbr = 0;
      ct = 0; cb = 0; cl = 0; cr = 0;
    }
    if (!sf_getbool("verb",&verb)) verb=false; /* verbosity */
    if (!sf_getbool("ps",&ps)) ps=false; /* use pseudo-spectral */
    if (ps) sf_warning("Using pseudo-spectral...");
    else sf_warning("Using pseudo-analytical...");
    if (!sf_getbool("adj",&adj)) adj=false; /* use pseudo-spectral */
    if (justrec && adj) sf_error("No migration in justrec mode!");
    if (adj) sf_warning("RTM");
    else sf_warning("RTDM");
    if (!sf_getfloat("vref",&vref)) vref=1500; /* reference velocity (default using water) */

    /* setup I/O files */
    Fi = sf_input ("in");
    Fo = sf_output("out");
    Fv = sf_input("vel");
    if (adj) {
      gpl = -1;
      gpl_v = -1;
      sf_histint(Fi,"n1",&nt);
      sf_histfloat(Fi,"d1",&dt);
      sf_histint(Fi,"n2",&gpl);
      if (NULL!=sf_getstring("dat_v")) {
	Fd_v = sf_input("dat_v");
	sf_histint(Fd_v,"n2",&gpl_v);
      } else Fd_v = NULL;
      if (diff) Fi1 = sf_input("dat_2"); 
      else Fi1 = NULL;  
    } else {
      if (!sf_getint("nt",&nt)) sf_error("Need nt!");
      if (!sf_getfloat("dt",&dt)) sf_error("Need dt!");
      if (!sf_getint("gpl",&gpl)) gpl = -1; /* geophone length */
      if (!sf_getint("gpl_v",&gpl_v)) gpl_v = -1; /* geophone height */
    }
    if (!sf_getint("src",&src)) src=0; /* source type */
    //if (!sf_getint("n_srcs",&n_srcs)) n_srcs=1; /* source type */
    spx = sf_intalloc(n_srcs);
    spz = sf_intalloc(n_srcs);
    f0  = sf_floatalloc(n_srcs);
    t0  = sf_floatalloc(n_srcs);
    A   = sf_floatalloc(n_srcs);
    //if (!sf_getints("spx",spx,n_srcs)) sf_error("Need spx!"); /* shot position x */
    if (!sf_getints("spz",spz,n_srcs)) sf_error("Need spz!"); /* shot position z */
    if (!sf_getfloats("f0",f0,n_srcs)) sf_error("Need f0! (e.g. 30Hz)");   /*  wavelet peak freq */
    if (!sf_getfloats("t0",t0,n_srcs)) sf_error("Need t0! (e.g. 0.04s)");  /*  wavelet time lag */
    if (!sf_getfloats("A",A,n_srcs)) sf_error("Need A! (e.g. 1)");     /*  wavelet amplitude */
    if (!sf_getint("shtbgn", &shtbgn)) sf_error("Need shot starting location 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;
    if (!sf_getint("which", &which)) which = 0;

    if (!sf_getint("gpx",&gpx)) gpx = -1; /* geophone position x */
    if (!sf_getint("gpz",&gpz)) gpz = -1; /* geophone position z */
    if (!sf_getint("gpx_v",&gpx_v)) gpx_v = -1; /* geophone position x */
    if (!sf_getint("gpz_v",&gpz_v)) gpz_v = -1; /* geophone position z */

    if (SF_FLOAT != sf_gettype(Fv)) sf_error("Need float input");

    /* Read/Write axes */
    az = sf_iaxa(Fv,1); nz = sf_n(az); dz = sf_d(az);
    ax = sf_iaxa(Fv,2); nx = sf_n(ax); dx = sf_d(ax);
    nz1 = nz-nbt-nbb;
    nx1 = nx-nbl-nbr;
    if (gpx==-1) gpx = nbl;
    if (gpz==-1) gpz = nbt;
    if (gpl==-1) gpl = nx1;
    if (gpx_v==-1) gpx_v = nbl;
    if (gpz_v==-1) gpz_v = nbt;
    if (gpl_v==-1) gpl_v = nz1;

    if (adj) { /*output image*/
      sf_setn(az,nz1);
      sf_setn(ax,nx1);
      sf_oaxa(Fo,az,1);
      sf_oaxa(Fo,ax,2);
      sf_putint(Fo,"n3",1);
      sf_putfloat(Fo,"d3",shtint*dx);
      sf_putfloat(Fo,"o3",0.);
      sf_settype(Fo,SF_FLOAT);
    } else { /*output data*/
      sf_setn(ax,gpl);
      /*output horizontal data is mandatory*/
      sf_putint(Fo,"n1",nt);
      sf_putfloat(Fo,"d1",dt);
      sf_putfloat(Fo,"o1",0.);
      sf_putstring(Fo,"label1","Time");
      sf_putstring(Fo,"unit1","s");
      sf_oaxa(Fo,ax,2);
      sf_putint(Fo,"n3",shtnum);
      sf_putfloat(Fo,"d3",shtint*dx);
      sf_putfloat(Fo,"o3",0.);
      sf_putstring(Fo,"label3","Shot");
      sf_settype(Fo,SF_FLOAT);
      /*output vertical data is optional*/
      if (NULL!=sf_getstring("dat_v")) {
	Fd_v = sf_output("dat_v");
	sf_setn(ax,gpl_v);
	/*output horizontal data is mandatory*/
	sf_putint(Fd_v,"n1",nt);
	sf_putfloat(Fd_v,"d1",dt);
	sf_putfloat(Fd_v,"o1",0.);
	sf_putstring(Fd_v,"label1","Time");
	sf_putstring(Fd_v,"unit1","s");
	sf_oaxa(Fd_v,ax,2);
        sf_putint(Fd_v,"n3",shtnum);
        sf_putfloat(Fd_v,"d3",shtint*dx);
        sf_putfloat(Fd_v,"o3",0.);
        sf_putstring(Fd_v,"label3","Shot");
	sf_settype(Fd_v,SF_FLOAT);	
      } else Fd_v = NULL;
    }

    if (snap > 0) {
	snaps = sf_output("snaps");
	/* (optional) snapshot file */
	sf_setn(az,nz1);
	sf_setn(ax,nx1);
	sf_oaxa(snaps,az,1);
	sf_oaxa(snaps,ax,2);
	sf_putint(snaps,"n3",nt/snap);
	sf_putfloat(snaps,"d3",dt*snap);
	sf_putfloat(snaps,"o3",0.);
	sf_putstring(snaps,"label3","Time");
	sf_putstring(snaps,"unit3","s");
    } else snaps = NULL;
    
    par = (pspar) sf_alloc(1,sizeof(*par));
    vel = sf_floatalloc(nz*nx);
    dat = sf_floatalloc3(nt,gpl,shtnum);
    img = sf_floatalloc(nz1*nx1);
    if (adj) {
      imgs= sf_floatalloc(nz1*nx1);
      if (adj) {
        for (ix=0; ix<nx1; ix++)
          for (iz=0; iz<nz1; iz++)
            imgs[ix*nz1+iz] = 0.;
      }
    } else imgs = NULL;
    if (NULL!=Fd_v) dat_v = sf_floatalloc3(nt,gpl_v,shtnum);
    else dat_v = NULL;
    if (snap>0) {
      wvfld1 = sf_floatalloc2(nx1*nz1,nt/snap);
      wvfld  = sf_floatalloc2(nx1*nz1,nt/snap);
    }
    else { wvfld1 = NULL; wvfld = NULL; }
    if (adj && diff) dat1 = sf_floatalloc3(nt,gpl,shtnum);
    else dat1 = NULL;

    sf_floatread(vel,nz*nx,Fv);
    if (adj) {
      sf_floatread(dat[0][0],gpl*nt*shtnum,Fi);
      if (NULL!=Fd_v) sf_floatread(dat_v[0][0],gpl_v*nt*shtnum,Fd_v);
      if (diff) sf_floatread(dat1[0][0],gpl_v*nt*shtnum,Fi1);
    } else {
      sf_floatread(img,nz1*nx1,Fi);
    }

    /*passing the parameters*/
    par->nx    = nx;  
    par->nz    = nz;
    par->dx    = dx;
    par->dz    = dz;
    par->n_srcs= n_srcs;
    par->spx   = spx;
    par->spz   = spz;
    par->gpz   = gpz;
    par->gpx   = gpx;
    par->gpl   = gpl;
    par->gpz_v = gpz_v;
    par->gpx_v = gpx_v;
    par->gpl_v = gpl_v;
    par->snap  = snap;
    par->cmplx = cmplx;
    par->pad1  = pad1;
    par->abc   = abc;
    par->nbt   = nbt;
    par->nbb   = nbb;
    par->nbl   = nbl;
    par->nbr   = nbr;
    par->ct    = ct;
    par->cb    = cb;
    par->cl    = cl;
    par->cr    = cr;
    par->src   = src;
    par->nt    = nt;
    par->dt    = dt;
    par->f0    = f0;
    par->t0    = t0;
    par->A     = A;
    par->verb  = verb;
    par->ps    = ps;
    par->vref  = vref;

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

      *spx = shtbgn + shtint*is;
      //par->spx = spx; //pointer

      sf_warning("Processing shot # %d/%d",is,shtnum-1);

      if (adj && diff) {

      sf_warning("Simultaneously propagating two receiver wavefields...");
      psp3(wvfld, wvfld1, dat[is], dat1[is], img, vel, par);


      for (ix=0; ix<nx1; ix++)
        for (iz=0; iz<nz1; iz++)
          imgs[ix*nz1+iz] += img[ix*nz1+iz];

      } else {

      if (justrec) {

        if (NULL == dat_v)
          psp(wvfld, dat[is], NULL, NULL, vel, par, false);
        else
          psp(wvfld, dat[is], dat_v[is], NULL, vel, par, false);

      } else {

        sf_warning("Computing source wavefield ...");
	psp(wvfld1, NULL, NULL, NULL, vel, par, false);
	if (born) dt2v2(wvfld1, vel, par);
	sf_warning("Computing receiver wavefield ...");
	if (NULL == dat_v)
	  psp2(wvfld1, wvfld, dat[is], NULL, img, vel, par, adj);
	else
	  psp2(wvfld1, wvfld, dat[is], dat_v[is], img, vel, par, adj);

        if (adj) {
          for (ix=0; ix<nx1; ix++)
            for (iz=0; iz<nz1; iz++)
              imgs[ix*nz1+iz] += img[ix*nz1+iz];
        }

      }

      }

      if (snap>0 && is==which)
        sf_floatwrite(wvfld[0],nz1*nx1*nt/snap,snaps);
    }
    
    if (adj) {
      sf_floatwrite(imgs,nz1*nx1,Fo);
    } else {
      sf_floatwrite(dat[0][0],gpl*nt*shtnum,Fo);
      if (NULL!=Fd_v) sf_floatwrite(dat_v[0][0],gpl_v*nt*shtnum,Fd_v);
    }

    exit (0);
}
Exemplo n.º 11
0
int main(int argc, char* argv[])
{
  int verbose;
  sf_file in=NULL, out=NULL;
  int n1_traces;
  int n1_headers;

  char* header_format=NULL;
  sf_datatype typehead;
  /* kls do I need to add this?  sf_datatype typein; */
  float* fheader=NULL;
  float* intrace=NULL;
  float o1;
  float d1;
  int indx_offset;
  float* local_sloth=NULL;
  float v0;
  int indx_time;
  float offset;
  float offset2;
  float* r_index_tx_of_it0=NULL;
  float* r_index_t0_of_itx=NULL;
  int start_indx_nmo;
  int start_indx_nmo_tx;
  float* outtrace=NULL;
  float itrace=0;
  float nmostretch;
  char* offsetname;
  float lmute;
  bool inv;
  /******************************************************/
  /* code block for standard tah Trace And Header setup */
  /******************************************************/

  sf_init (argc,argv);

  /*****************************/
  /* initialize verbose switch */
  /*****************************/
  if(!sf_getint("verbose",&verbose))verbose=1;
  /* \n
     flag to control amount of print
     0 terse, 1 informative, 2 chatty, 3 debug
  */
  sf_warning("verbose=%d",verbose);
 
  /******************************************/
  /* input and output data are stdin/stdout */
  /******************************************/

  if(verbose>0)fprintf(stderr,"read in file name\n");  
  in = sf_input ("in");

  if(verbose>0)fprintf(stderr,"read out file name\n");
  out = sf_output ("out");

  if (!sf_histint(in,"n1_traces",&n1_traces))
    sf_error("input data not define n1_traces");
  if (!sf_histint(in,"n1_headers",&n1_headers)) 
    sf_error("input data does not define n1_headers");

  header_format=sf_histstring(in,"header_format");
  if(strcmp (header_format,"native_int")==0) typehead=SF_INT;
  else                                       typehead=SF_FLOAT;

  if(verbose>0)fprintf(stderr,"allocate headers.  n1_headers=%d\n",n1_headers);
  fheader = sf_floatalloc(n1_headers);
 
  if(verbose>0)fprintf(stderr,"allocate intrace.  n1_traces=%d\n",n1_traces);
  intrace= sf_floatalloc(n1_traces);

  /* maybe I should add some validation that n1== n1_traces+n1_headers+2
     and the record length read in the second word is consistent with 
     n1.  */
  /**********************************************************/
  /* end code block for standard tah Trace And Header setup */
  /* continue with any sf_puthist this tah program calls to */
  /* add to the history file                                */
  /**********************************************************/

  /* put the history from the input file to the output */
  sf_fileflush(out,in);


  /********************************************************/
  /* continue initialization specific to this tah program */
  /********************************************************/
  if (!sf_histfloat(in,"d1",&d1))
    sf_error("input data does not define d1");
  if (!sf_histfloat(in,"o1",&o1))
    sf_error("input data does not define o1");
  /* Kls should read label1 and verify it is time  
  if (!sf_histstring(in,"label1",&label1))
    sf_error("input data not define label1");
  */

  /* segy_init gets the list header keys required by segykey function  */
  segy_init(n1_headers,in);
  /* get index to keys I will be using */
  if(NULL==(offsetname=sf_getstring("offset")))offsetname="offset";
  /* name of the header key to use for offset (usually just offset) */
  indx_offset=segykey(offsetname);
  /* kls what other header keys do I use?  inline? xline? cdp? */

  /* get the parameter for the maximum nmo stretch. */
  if (!sf_getfloat("str",&nmostretch)) nmostretch=0.5;
  /* maximum stretch allowed */

  if (!sf_getfloat("lmute",&lmute)) lmute=12.*d1; 
  /* length of the mute zone in seconds */
  if(verbose>0)  fprintf(stderr,"lmute=%f seconds.\n",lmute);
  lmute/=d1;
  if(!sf_getbool("inv",&inv)) inv=false;
  /* if y, do inverse nmo.  Otherwise forward nmo */ 
   
  if(verbose>0){
    if(inv)fprintf(stderr,"inv=true\n");
    else fprintf(stderr,"inv=false\n");
  }
   
  /* set up velocity function ( really (1/v)**2, sloth */
  local_sloth=sf_floatalloc(n1_traces);
  /* just constant velocity today */
  if(1==1){
    char** list_of_floats;
    float* vnmo;
    float* tnmo;
    int numvnmo;
    int numtnmo;
    float t0;

    if(verbose>1)fprintf(stderr,"read vnmo/tnmo\n");
    /* use this fundtion to find out number of velocities and time 
       input in vnmo and tnmo */
    list_of_floats=sf_getnstring("vnmo",&numvnmo);
    /* list of NMO velocities for the time in tnmo */
    if(verbose>1){
      int i;
      fprintf(stderr,"numvnmo=%d\n",numvnmo);
      for (i=0; i<numvnmo; i++){
	fprintf(stderr,"velocities=%s\n",list_of_floats[i]);
      }
    }
    /* should free this list of strings, but that is only a little memory */\
    list_of_floats=sf_getnstring("tnmo",&numtnmo);
    /* NMO times for the vnmo velocities. */
    if(verbose>1){
      int i;
      for (i=0; i<numtnmo; i++){
	fprintf(stderr,"times=%s\n",list_of_floats[i]);
      }
    }
    if(numvnmo!=numtnmo){
      sf_error("number vnmo floats=%d != number tnmo floats=%d",
	       numvnmo,numtnmo);
    }
    if(numvnmo==0)sf_error("vnmo parameter is required");
    vnmo=sf_floatalloc(numvnmo);
    tnmo=sf_floatalloc(numtnmo);
    if(verbose>1)fprintf(stderr,"sf_getfloats(vnmo)");
    if (!sf_getfloats("vnmo",vnmo,numvnmo))
      sf_error("unable to read vnmo");
    /* list of NMO velocities for the tnmo times. */
    if(verbose>1)fprintf(stderr,"sf_getfloats(tnmo)");
    if (!sf_getfloats("tnmo",tnmo,numtnmo))
      sf_error("unable to read tnmo");
    /* list of NMO times for the vnmo velocities. */
    if(verbose>1){
      for(indx_time=0; indx_time<numvnmo; indx_time++){
	fprintf(stderr,"indx=%d, vnmo=%f, tnmo=%f\n",
		indx_time,vnmo[indx_time],tnmo[indx_time]);
      }
    }
    if(verbose>1)fprintf(stderr,"interpolate the velocity\n");
    for(indx_time=0; indx_time<n1_traces; indx_time++){
      t0=indx_time*d1+o1;
      intlin(numtnmo,tnmo,vnmo,vnmo[0],vnmo[numvnmo-1],1,&t0,&v0);
      local_sloth[indx_time]=1.0/(v0*v0);
    }    
  } 
  /* kls
     previous if(1==1) clause if for it no input velocity file
     need to add else { set up the input velocity file (ie open the file(
     inside the trace loop need to get iline and xline form trace heder
     and use that to read the velocity at (iline,xline) into local_sloth
     then compute local_sloth as 1/(v*v)

     will need to get input velocity shape:
       if (!sf_histint(invelocity,"n1",&n1_velocity))
          sf_error("input velocity file does not define n1");
     test n1_velocity!=n1_trace error
     and do the same for d1, o2, d2, etc 
   */

  if(verbose>0)fprintf(stderr,"allocate arrays for the trace loop\n");
  r_index_tx_of_it0=sf_floatalloc(n1_traces);
  r_index_t0_of_itx=sf_floatalloc(n1_traces);
  outtrace         =sf_floatalloc(n1_traces);
  

  /***************************/
  /* start trace loop        */
  /***************************/
  if(verbose>0)fprintf(stderr,"start trace loop\n");
  while (0==get_tah(intrace, fheader, n1_traces, n1_headers, in)){
    if(verbose>1)fprintf(stderr,"process the tah in sftahnmo\n");
    /********************/
    /* process the tah. */
    /********************/
    /* this program applies moveout */
    /* kls this should be only be done when velocity (local_sloth) 
       or offset changes */
    if(typehead == SF_INT){   
      /* just cast the header to int so the print works */
      offset=((int*)fheader)[indx_offset];
    } else {
      offset=       fheader [indx_offset];
    }
    offset2=offset*offset;
    for(indx_time=0; indx_time<n1_traces; indx_time++){
      float tx, t0;
      t0=indx_time*d1+o1;
      tx=sqrt(t0*t0+offset2*local_sloth[indx_time]);
      r_index_tx_of_it0[indx_time]=(tx-o1)/d1;
      if(itrace==0 && verbose>4){
	fprintf(stderr,"indx_time=%d, tx=%f, sloth=%g, offset=%f, t0=%f\n",
		        indx_time   , tx   , local_sloth[indx_time]  ,
                                                       offset   , t0);
      }
    }
    /* kls nmo start time should depend on the nmo stretch limit.
       Find the excessive stretch closest to the bottom of the trace.  This 
       is the last time nmstrewtch is violated.  It is OK to apply nmo
       to the rest of the trace. */
    for (start_indx_nmo=n1_traces-1; start_indx_nmo>1; start_indx_nmo--){
      /* pfrintf(stderr,"r_indx[it]=%f, rindx */
      if((r_index_tx_of_it0[start_indx_nmo  ]-
	  r_index_tx_of_it0[start_indx_nmo-1])  <nmostretch) break;
    }
    if(inv){
      start_indx_nmo_tx = 1.0+r_index_tx_of_it0[start_indx_nmo];
      if(start_indx_nmo_tx>n1_traces-2)start_indx_nmo_tx = n1_traces-2;
      /* compute r_index_t0_of_itx from r_index_tx_of_it0 */
      yxtoxy(n1_traces-start_indx_nmo,1.0, start_indx_nmo,
	     &r_index_tx_of_it0[start_indx_nmo],
 
	     n1_traces-start_indx_nmo_tx,1.0, start_indx_nmo_tx,
	     -1,n1_traces,&r_index_t0_of_itx[start_indx_nmo_tx]);
    }
    /* kls inverse nmo? will need more code */
    /* do nmo via 8-point sinc interpolation */
    /* void ints8r (int nxin, float dxin, float fxin,      
                    float yin[], float yinl, float yinr, 
		    int nxout, float xout[], 
		    float yout[]) */
    if(!inv){
      ints8r(n1_traces,1.0,0,
	     intrace,0.0,0.0,
	     n1_traces-start_indx_nmo,&r_index_tx_of_it0[start_indx_nmo],
	     &outtrace[start_indx_nmo]);
      /* zero above the start time */
      for(indx_time=0; indx_time<start_indx_nmo; indx_time++){
	outtrace[indx_time]=0.0;
      }
      /* apply linear ramp kls */
      for (indx_time=start_indx_nmo; 
	   indx_time<start_indx_nmo+lmute && indx_time<n1_traces;
	   indx_time++){
	outtrace[indx_time] *= (float)(indx_time-start_indx_nmo+1)/(float)lmute;
      }
    }else{
      ints8r(n1_traces,1.0,0,
	     intrace,0.0,0.0,
	     n1_traces-start_indx_nmo_tx,&r_index_t0_of_itx[start_indx_nmo_tx],
	     &outtrace[start_indx_nmo_tx]);      
      /* zero above the start time */
      for(indx_time=0; indx_time<start_indx_nmo_tx; indx_time++){
	outtrace[indx_time]=0.0;
      }
    }
    /***************************/
    /* write trace and headers */
    /***************************/
    put_tah(outtrace, fheader, n1_traces, n1_headers, out);
    itrace++;
  }
  
  exit(0);
}
Exemplo n.º 12
0
int main(int argc, char* argv[])
{
    bool transp, start, scalebar, nomin=true, nomax=true, barreverse, framenum;
    int n1, n2, n3, i1, i2, i3, len, nreserve;
    float min1, max1, min2, max2, o3, d3, o1, d1, xi, yi, tt;
    float **x, **y, **tmp, *symbolsz=NULL, symsize, xc, yc;    
    float ***data=NULL, barmin, barmax, minmax[2];
    char *symbol, sym[2]=" ", *color=NULL, *barfile;
    unsigned char **z=NULL, *barbuf[1];
    sf_datatype type;
    sf_file in, depth, bar=NULL;

    sf_init(argc,argv);
    in = sf_input("in");
    vp_init();

    if (NULL != sf_getstring("depth")) {
	depth = sf_input("depth"); /* values for colored plots */
	if (SF_UCHAR != sf_gettype(depth)) 
	    sf_error("Need uchar in depth");
    } else {
	depth = NULL;
    }

    if (!sf_histint(in,"n1",&n1)) sf_error("No n1= in input");
    if (!sf_histint(in,"n2",&n2)) n2=1;
    n = n1*n2;
    n3 = sf_leftsize(in,2);
    if (n3 > 1) {
	if (!sf_histfloat(in,"o3",&o3)) o3=0.;
	if (!sf_histfloat(in,"d3",&d3)) d3=1.;
    }

    x = sf_floatalloc2(n1,n2);
    y = sf_floatalloc2(n1,n2);
    t = sf_floatalloc(n);

    if (!sf_getbool("scalebar",&scalebar)) scalebar=false;
    /* if y, draw scalebar */

    if (!sf_getbool("wantframenum",&framenum)) framenum = (bool) (n3 > 1);
    /* if y, display third axis position in the corner */
    
    if (NULL != depth) {
	z = sf_ucharalloc2(n1,n2);
	/* initialize color table */
	if (NULL == (color = sf_getstring("color"))) color="j";
	/* color scheme (default is j) */
	if (!sf_getint ("nreserve",&nreserve)) nreserve = 8;
	/* reserved colors */
	vp_rascoltab(nreserve,color);

	if (scalebar) {
	    barfile = sf_getstring("bar");
	    /* file for scalebar data */
	    if (NULL == barfile) {
		barfile=sf_histstring(depth,"bar");
		if (NULL == barfile) sf_error("Need bar=");
	    }

	    nomin = (bool) (!sf_getfloat("minval",&barmin));
	    /* minimum value for scalebar (default is the data minimum) */
	    nomax = (bool) (!sf_getfloat("maxval",&barmax));
	    /* maximum value for scalebar (default is the data maximum) */
	
	    bar = sf_input(barfile);
	    if (SF_UCHAR != sf_gettype(bar)) sf_error("Need uchar in bar");

	    if (nomin) nomin = (bool) (!sf_histfloat(bar,"minval",&barmin));
	    if (nomax) nomax = (bool) (!sf_histfloat(bar,"maxval",&barmax));

	    barbuf[0] = (unsigned char*) sf_alloc(VP_BSIZE,sizeof(unsigned char));

	    if (!sf_getbool("barreverse",&barreverse)) barreverse=false;
	    /* if y, go from small to large on the bar scale */
	}
    } 

    if (!sf_getfloat("pclip",&pclip)) pclip=100.; /* clip percentile */

    type = sf_gettype(in);
    switch (type) {
	case SF_FLOAT:
	    if (!sf_histfloat(in,"o1",&o1)) o1=0.;
	    if (!sf_histfloat(in,"d1",&d1)) d1=1.;
	    
	    for (i2=0; i2 < n2; i2++) {
		for (i1=0; i1 < n1; i1++) {
		    x[i2][i1] = o1 + i1*d1;
		}
	    }
	    break;
	case SF_COMPLEX:
	    data = sf_floatalloc3(2,n1,n2);
	    break;
	default:
	    sf_error("Wrong data type (need float or complex)");
    }

    vp_plot_init(n2);

    symbol = sf_getstring("symbol");
    /* if set, plot with symbols instead of lines */
    if (NULL != symbol) {
	len = strlen(symbol);
	if (len < n2) {
	    symbol = (char*) sf_realloc(symbol,n2,sizeof(char));
	    for (i2=len; i2 < n2; i2++) {
		symbol[i2] = symbol[i2 % len];
	    }
	}

	symbolsz = sf_floatalloc(n2);
	if (!sf_getfloats("symbolsz",symbolsz,n2)) {
	    /* symbol size (default is 2) */
	    for (i2 = 0; i2 < n2; i2++)
		symbolsz[i2] = 2./33.;
	} else {
	    for (i2 = 0; i2 < n2; i2++)
		symbolsz[i2] /= 33.;
	}
    }

    if (!sf_getbool ("transp",&transp)) transp=false;
    /* if y, transpose the axes */
 
    for (i3 = 0; i3 < n3; i3++) {
	if (SF_COMPLEX == type) {
	    sf_floatread(data[0][0],2*n,in);
	    for (i2=0; i2 < n2; i2++) {
		for (i1=0; i1 < n1; i1++) {
		    x[i2][i1] = data[i2][i1][0];
		    y[i2][i1] = data[i2][i1][1];
		}
	    }
	    getminmax(x[0],&min1,&max1);
	} else {
	    sf_floatread(y[0],n,in);
	    min1=o1;
	    max1=o1+(n1-1)*d1;
	}
	getminmax(y[0],&min2,&max2);

	if (NULL != depth) sf_ucharread(z[0],n,depth);
	
	vp_stdplot_init (min1, max1, min2, max2,
			 transp,false,false,true);
	vp_frame_init(in,"blt",false);

	if (transp) {
	    tmp=x; x=y; y=tmp;
	    tt=max1; max1=max2; max2=tt;
	    tt=min1; min1=min2; min2=tt;
	}

	if (i3 > 0) vp_erase();

	if (framenum) vp_framenum(o3+i3*d3);
	vp_frame();

	for (i2=0; i2 < n2; i2++) {
	    vp_plot_set (i2);
	    
	    symsize = 2./33.;
	    if (NULL != symbol) {
		sym[0] = symbol[i2];
		symsize = symbolsz[i2];
	    } 

	    start = true;

	    for (i1=0; i1 < n1; i1++) {
		xi = x[i2][i1];
		yi = y[i2][i1];
		if (NULL != depth) vp_color(z[i2][i1]+256);

		if (isfinite(xi) && 
		    isfinite(yi)) {
		    if (NULL != symbol) {
			vp_umove(xi,yi);
			vp_where (&xc, &yc);
			vp_tjust (TH_SYMBOL, TV_SYMBOL);
			vp_gtext (xc,yc,symsize,0.,0.,symsize,sym);
		    } else if (start) {
			vp_umove(xi,yi);
			start=false;
		    } else {
			vp_udraw(xi,yi);
		    }
		} else {
		    start=true;
		}
	    }
	}

	if (depth && scalebar) {
	    sf_floatread(minmax,2,bar);
	    sf_ucharread(barbuf[0],VP_BSIZE,bar);

	    if (nomin) barmin=minmax[0];
	    if (nomax) barmax=minmax[1];

	    if (barreverse) {
		vp_barframe_init (depth,barmax,barmin);
	    } else {
		vp_barframe_init (depth,barmin,barmax);
	    }
	    vp_barraster(VP_BSIZE, barbuf);
	}
	
	if (transp) {
	    tmp=x; x=y; y=tmp;
	    tt=max1; max1=max2; max2=tt;
	    tt=min1; min1=min2; min2=tt;
	}
    } 
   

    exit(0);
}