diff --git a/fdelmodc3D/3dfd.c b/fdelmodc3D/3dfd.c
deleted file mode 100644
index bfda4b58577fb2bce99aa84e612f5fbcfa7889ec..0000000000000000000000000000000000000000
--- a/fdelmodc3D/3dfd.c
+++ /dev/null
@@ -1,1221 +0,0 @@
-#include<mpi.h>
-#include<stdlib.h>
-#include<stdio.h>
-#include<math.h>
-#include<time.h>
-#include<assert.h>
-#include<sys/time.h>
-#include"par.h"
-#include<stdlib.h>
-#include<stdio.h>
-#include<math.h>
-#include"fdelmodc3D.h"
-
-#define MAX(x,y) ((x) > (y) ? (x) : (y))
-#define MIN(x,y) ((x) < (y) ? (x) : (y))
-#define NINT(x) ((int)((x)>0.0?(x)+0.5:(x)-0.5))
-
-
-#define STRIPE_COUNT "4" /* must be an ascii string */
-#define STRIPE_SIZE "1048576" /* 1 MB must be an ascii string */
-//#define STRIPE_SIZE "268435456" /* 256 MB must be an ascii string */
-#define C1 (9.0/8.0)
-#define C2 (1.0/24.0)
-#define Dx(f,ix,iy,iz,nz) C1*(f[iy+ix*nz+iz] - f[iy+(ix-1)*nz+iz]) - C2*(f[iy+(ix+1)*nz+iz] - f[iy+(ix-2)*nz+iz])
-#define Dy(f,ix,iy,iz,nxz) C1*(f[iy*nxz+ix+iz] - f[(iy-1)*nxz+ix+iz]) - C2*(f[(iy+1)*nxz+ix+iz] - f[(iy-2)*nxz+ix+iz])
-#define Dz(f,ix,iy,iz) C1*(f[iy+ix+iz] - f[iy+ix+iz-1]) - C2*(f[iy+ix+iz+1] - f[iy+ix+iz-2])
-
-#define Dv(vx,vz,ix,iy,iz,nz,nxz) C1*((vx[iy*nxz+(ix+1)*nz+iz] - vx[iy*nxz+ix*nz+iz]) + \
- (vy[(iy+1)*nxz+ix*nz+iz] - vy[iy*nxz+ix*nz+iz]) + \
- (vz[iy*nxz+ix*nz+iz+1] - vz[iy*nxz+ix*nz+iz])) - \
- C2*((vx[iy*nxz+(ix+2)*nz+iz] - vx[iy*nxz+(ix-1)*nz+iz]) + \
- (vy[(iy+2)*nxz+ix*nz+iz] - vy[(iy-1)*nxz+ix*nz+iz]) + \
- (vz[iy*nxz+ix*nz+iz+2] - vz[iy*nxz+ix*nz+iz-1]))
-
-int getParameters3D(modPar *mod, recPar *rec, snaPar *sna, wavPar *wav, srcPar *src, shotPar *shot, bndPar *bnd, int verbose);
-int readModel3D(modPar mod, bndPar bnd, float *rox, float *roz, float *l2m);
-
-void vinit();
-int updateVelocitiesHalo(float *vx, float *vy, float *vz, float *p, float *ro, int halo, int npx, int npy, int npz);
-int updateVelocities(float *vx, float *vy, float *vz, float *p, float *ro, int halo, int npx, int npy, int npz);
-int updatePressureHalo(float *vx, float *vy, float *vz, float *p, float *l2m, int halo, int npx, int npy, int npz);
-int updatePressure(float *vx, float *vy, float *vz, float *p, float *l2m, int halo, int npx, int npy, int npz);
-int exchangeHalo(float *leftRecv, float *leftSend, float *rightRecv, float *rightSend, int size, int leftrank, int rightrank, MPI_Request *reqRecv, MPI_Request *reqSend, int tag);
-int newHaloVxVz(float *vx, float *vz, int npx, int npy, int npz, int halo, float *leftRecv, float *rightRecv, float *frontRecv, float *backRecv, float *topRecv, float *bottomRecv);
-int newHaloP(float *p, int npx, int npy, int npz, int halo, float *leftRecv, float *rightRecv, float *frontRecv, float *backRecv, float *topRecv, float *bottomRecv);
-int copyHaloVxVz(float *vx, float *vz, int npx, int npy, int npz, int halo, float *leftSend, float *rightSend, float *frontSend, float *backSend, float *topSend, float *bottomSend);
-int copyHaloP(float *p, int npx, int npy, int npz, int halo, float *leftSend, float *rightSend, float *frontSend, float *backSend, float *topSend, float *bottomSend);
-int waitForHalo(MPI_Request *reqRecv, MPI_Request *reqSend);
-float gauss2time(float t, float f, float t0);
-double wallclock_time(void);
-void name_ext(char *filename, char *extension);
-
-
-/* Self documentation */
-char *sdoc[] = {
-" ",
-" file_rcv=recv.su .. base name for receiver files",
-" file_snap=snap.su . base name for snapshot files",
-" nx=256 ............ number of samples in x-direction",
-" ny=nx ............. number of samples in y-direction",
-" nz=nx ............. number of samples in z-direction",
-" dx=5 .............. spatial sampling in x-direction",
-" dy=5 .............. spatial sampling in y-direction",
-" dz=5 .............. spatial sampling in z-direction",
-"" ,
-" verbose=0 ......... silent mode; =1: display info",
-" ",
-" Jan Thorbecke 2016",
-" Cray / TU Delft",
-" E-mail: janth@xs4all.nl ",
-"",
-NULL};
-
-int main (int argc, char *argv[])
-{
- modPar mod;
- recPar rec;
- snaPar sna;
- wavPar wav;
- srcPar src;
- bndPar bnd;
- shotPar shot;
- float *wavelet;
- int nx, ny, nz, dims[3], period[3], reorder, coord[3], ndims=3;
- int npx, npy, npz, halo, nt;
- int my_rank, size, source, dest, snapwritten;
- int left, right, front, back, top, bottom;
- int direction, displ, halosizex, halosizey, halosizez;
- int ioXx, ioXz, ioYx, ioYz, ioZz, ioZx, ioPx, ioPz;
- int it, ix, iy, iz, iyp, ixp, izp, isrc, ixsrc, iysrc, izsrc, c1, c2;
- int sizes[3], subsizes[3], starts[3];
- int gsizes[3], gsubsizes[3], gstarts[3];
- int error, rc, verbose;
- float fx, fy, fz, dx, dy, dz, flx, fly, flz;
- float *p, *vx, *vy, *vz, *rox, *roz, *roy, *l2m, hcp, hro, fac;
- float *leftRecv, *leftSend, *rightRecv, *rightSend;
- float *frontRecv, *frontSend, *backRecv, *backSend;
- float *topRecv, *topSend, *bottomRecv, *bottomSend;
- float dt, src_ampl, fmax, fpeaksrc, t0src, time, snaptime;
- double t00, t0, t1, t2, tcomm, tcomp, thcomp, tcopy, ttot, tio;
- char err_buffer[MPI_MAX_ERROR_STRING];
- int resultlen;
- MPI_Comm COMM_CART;
- MPI_Request reqSend[6], reqRecv[6];
- MPI_Status status[12];
- MPI_Datatype local_array, global_array;
- MPI_Offset disp;
- MPI_Info fileinfo;
- MPI_File fh;
- char filename[1000], *file_snap, *file_rcv;
-
- MPI_Init(&argc, &argv);
- MPI_Comm_rank(MPI_COMM_WORLD, &my_rank);
- MPI_Comm_size(MPI_COMM_WORLD, &size);
- vinit();
-
- t0= wallclock_time();
- initargs(argc,argv);
- requestdoc(0);
-
- if (!getparint("verbose",&verbose)) verbose=0;
- if (!getparstring("file_snap",&file_snap)) file_snap="snap.su";
- if (!getparstring("file_rcv",&file_rcv)) file_rcv="recv.su";
-
- getParameters3D(&mod, &rec, &sna, &wav, &src, &shot, &bnd, verbose);
-
- /* divide 3D cube among available processors */
- dims[0]=0;
- dims[1]=0;
- dims[2]=0;
- MPI_Dims_create(size, ndims, dims);
-
- /* dims contains the number of MPI-tasks in each direction */
- /* set number of grid points based on number of procs in dims */
- if (!getparint("nx",&nx)) nx=256;
- if (!getparint("ny",&ny)) ny=nx;
- if (!getparint("nz",&nz)) nz=nx;
-
- if (!getparfloat("dx",&dx)) dx=5.;
- if (!getparfloat("dy",&dy)) dy=5.;
- if (!getparfloat("dz",&dz)) dz=5.;
-
- halo = 2;
-
- /* new larger dimensions to fit with the domain-decomposition */
- nz=dims[0]*ceil(mod.naz/dims[0]);
- nx=dims[1]*ceil(mod.nax/dims[1]);
- ny=dims[2]*ceil(mod.nay/dims[2]);
-
-// dt=0.001;
- nt=4096;
- t0src=0.50;
- hcp=2000.0;
- hro=1800.0;
- tcomm=tcomp=thcomp=tcopy=tio=0.0;
-
- /* for stability 10 points per wavelenght */
- fmax=hcp/(mod.dx*8);
- dt=0.295*mod.dx/hcp;
- fpeaksrc=0.2*fmax; /* Ricker wavelet has peak at 1/3 of fmax */
- fac = mod.dt/mod.dx;
-
- fx=-mod.dx*nx/2; fy=-mod.dy*ny/2; fz=0;
- npz = 2*halo+nz/dims[0];
- npx = 2*halo+nx/dims[1];
- npy = 2*halo+ny/dims[2];
- wavelet = (float *)calloc(nt,sizeof(float));
-
- /* find which MPI-task has the source position */
-
-
- snaptime = t0src+1.80*npx*dx*0.5/hcp;
- snapwritten=0;
- nt = (int) 1.1*(t0src+snaptime)/dt;
- nt = (int) (t0src+1.5)/dt;
-
- if (verbose && my_rank==0) {
- fprintf(stderr,"fmax=%f fpeak=%f dt=%e\n", fmax, fpeaksrc, dt);
- fprintf(stderr,"nx=%d nprocx=%d ny=%d nprocy=%d nz=%d nprocz=%d\n", nx, dims[1], ny, dims[2], nz, dims[0]);
- fprintf(stderr,"npx=%d npy=%d npz=%d nt=%d time=%f\n", npx, npy, npz, nt, nt*dt);
- fprintf(stderr,"source expected at local boundary at %f seconds\n", npx*dx*0.5/hcp);
- fflush(stderr);
- }
-
- if (my_rank==0) fprintf(stderr,"memory per MPI task is %ld MB\n", (6*npx*npy*npz*4/(1024*1024)));
-
- /* allocate wavefields and medium properties for local grid domains */
- p = (float *)calloc(npx*npy*npz,sizeof(float));
- vx = (float *)calloc(npx*npy*npz,sizeof(float));
- vy = (float *)calloc(npx*npy*npz,sizeof(float));
- vz = (float *)calloc(npx*npy*npz,sizeof(float));
-
- /* read velocity and density files */
-
- readModel3D(mod, bnd, rox, roz, l2m);
-
-/* for 2.5 D model npy=1 */
- rox = (float *)calloc(npx*npy*npz,sizeof(float));
- roy= (float *)calloc(npx*npy*npz,sizeof(float));
- roz= (float *)calloc(npx*npy*npz,sizeof(float));
- l2m = (float *)calloc(npx*npy*npz,sizeof(float));
-
- /* define homogeneus model */
- for (ix=0; ix<npx*1*npz; ix++) {
- rox[ix] = fac/hro;
- roy[ix] = fac/hro;
- roz[ix] = fac/hro;
- l2m[ix] = fac*hcp*hcp*hro;
- }
-
- /* create cartesian domain decomposition */
- period[0]=0;
- period[1]=0;
- period[2]=0;
- reorder=0;
- MPI_Cart_create(MPI_COMM_WORLD, 3, dims, period, reorder, &COMM_CART);
-
- /* find out coordinates of the rank */
- MPI_Cart_coords(COMM_CART, my_rank, 3, coord);
- flz = fz+(dz*nz/dims[0])*coord[0];
- flx = fx+(dx*nx/dims[1])*coord[1];
- fly = fy+(dy*ny/dims[2])*coord[2];
- if (verbose>=2) fprintf(stderr,"Rank %d coordinates are %d %d %d orig=(%5.2F, %5.2f, %5.2f) \n", my_rank, coord[0], coord[1], coord[2], flx, fly, flz);
- fflush(stderr);
-
- /* find out neighbours of the rank, MPI_PROC_NULL is a hard boundary of the model */
- displ=1;
- MPI_Cart_shift(COMM_CART, 1, 1, &left, &right);
- MPI_Cart_shift(COMM_CART, 2, 1, &top, &bottom);
- MPI_Cart_shift(COMM_CART, 0, 1, &front, &back);
- if (verbose>=2) fprintf(stderr, "Rank %d in direction 0 has LR neighbours %d %d FB %d %d TB %d %d\n", my_rank, left, right, front, back, top, bottom);
- fflush(stderr);
-
- /* allocate of halo areas */
- halosizex = npy*npz*halo;
- leftRecv = (float *)calloc(3*halosizex,sizeof(float));
- rightRecv = (float *)calloc(3*halosizex,sizeof(float));
- leftSend = (float *)calloc(3*halosizex,sizeof(float));
- rightSend = (float *)calloc(3*halosizex,sizeof(float));
-
- halosizey = npx*npz*halo;
- frontRecv = (float *)calloc(3*halosizey,sizeof(float));
- backRecv = (float *)calloc(3*halosizey,sizeof(float));
- frontSend = (float *)calloc(3*halosizey,sizeof(float));
- backSend = (float *)calloc(3*halosizey,sizeof(float));
-
- halosizez = npy*npx*halo;
- topRecv = (float *)calloc(3*halosizez,sizeof(float));
- bottomRecv = (float *)calloc(3*halosizez,sizeof(float));
- topSend = (float *)calloc(3*halosizez,sizeof(float));
- bottomSend = (float *)calloc(3*halosizez,sizeof(float));
-
- if (my_rank==0) fprintf(stderr,"memory per MPI task for halo exchange is %ld MB\n", ((12*(halosizex+halosizey+halosizez))*4/(1024*1024)));
-
- /* create subarrays(excluding halo areas) to write to file with MPI-IO */
- /* data in the local array */
- sizes[0]=npz;
- sizes[1]=npx;
- sizes[2]=npy;
- subsizes[0]=sizes[0]-2*halo;
- subsizes[1]=sizes[1]-2*halo;
- subsizes[2]=sizes[2]-2*halo;
- starts[0]=halo;
- starts[1]=halo;
- starts[2]=halo;
- MPI_Type_create_subarray(3, sizes, subsizes, starts, MPI_ORDER_C,
- MPI_FLOAT, &local_array);
- MPI_Type_commit(&local_array);
-
- /* data in the global array */
- gsizes[0]=nz;
- gsizes[1]=nx;
- gsizes[2]=ny;
- gsubsizes[0]=subsizes[0];
- gsubsizes[1]=subsizes[1];
- gsubsizes[2]=subsizes[2];
- gstarts[0]=subsizes[0]*coord[0];
- gstarts[1]=subsizes[1]*coord[1];
- gstarts[2]=subsizes[2]*coord[2];
- MPI_Type_create_subarray(3, gsizes, gsubsizes, gstarts, MPI_ORDER_C,
- MPI_FLOAT, &global_array);
- MPI_Type_commit(&global_array);
-
-
- /* compute field of the inner grid excluding halo areas */
- ioXx=2;
- ioXz=ioXx-1;
- ioYx=2;
- ioYz=ioYx-1;
- ioZz=2;
- ioZx=ioZz-1;
- ioPx=1;
- ioPz=ioPx;
-
- t00 = wallclock_time();
- for (it=0; it<nt; it++) {
- time = it*dt;
- wavelet[it] = gauss2time(time,fpeaksrc,t0src);
- }
- if (my_rank==0) {
- FILE *fp;
- fp = fopen("src.bin", "w+");
- fwrite( wavelet, sizeof(float), nt, fp);
- fflush(fp);
- fclose(fp);
- }
-
-/*
- nt =1;
- sprintf(filename,"snap_nz%d_nx%d_ny%d.bin",nz, nx, ny);
-
- for (ix=0; ix<npx*npy*npz; ix++) {
- p[ix] = my_rank;
- }
- MPI_Info_create(&fileinfo);
- MPI_Info_set(fileinfo, "striping_factor", STRIPE_COUNT);
- MPI_Info_set(fileinfo, "striping_unit", STRIPE_SIZE);
- MPI_File_delete(filename, MPI_INFO_NULL);
- rc = MPI_File_open(MPI_COMM_WORLD, filename, MPI_MODE_RDWR|MPI_MODE_CREATE, fileinfo, &fh);
- if (rc != MPI_SUCCESS) {
- fprintf(stderr, "could not open input file\n");
- MPI_Abort(MPI_COMM_WORLD, 2);
- }
- disp = 0;
- rc = MPI_File_set_view(fh, disp, MPI_FLOAT, global_array, "native", fileinfo);
- if (rc != MPI_SUCCESS) {
- fprintf(stderr, "error setting view on results file\n");
- MPI_Abort(MPI_COMM_WORLD, 4);
- }
- rc = MPI_File_write_all(fh, p, 1, local_array, status);
- if (rc != MPI_SUCCESS) {
- MPI_Error_string(rc,err_buffer,&resultlen);
- fprintf(stderr,err_buffer);
- MPI_Abort(MPI_COMM_WORLD, 5);
- }
- MPI_File_close(&fh);
-*/
-
-
- /* Main loop over the number of time steps */
- for (it=0; it<nt; it++) {
- t0 = wallclock_time();
- time = it*dt;
- //fprintf(stderr,"modeling time step %d for time %f\n", it, time);
-
- /* define source wavelet */
- wavelet[it] = gauss2time(time,fpeaksrc,t0src);
-
- /* update of grid values on halo areas */
- updateVelocitiesHalo(vx, vy, vz, p, rox, halo, npx, npy, npz);
- t1 = wallclock_time();
- thcomp += t1-t0;
-
- /* copy of halo areas */
- copyHaloVxVz(vx, vz, npx, npy, npz, halo, leftSend, rightSend, frontSend, backSend, topSend, bottomSend);
- t2 = wallclock_time();
- tcopy += t2-t1;
-
- /* start a-synchronous communication of halo areas to neighbours */
- /* this is done first for Vx,Vz fields only */
- exchangeHalo(leftRecv, leftSend, rightRecv, rightSend, 2*halosizex, left, right, &reqRecv[0], &reqSend[0], 0);
- exchangeHalo(frontRecv, frontSend, backRecv, backSend, 2*halosizey, front, back, &reqRecv[2], &reqSend[2], 4);
- exchangeHalo(topRecv, topSend, bottomRecv, bottomSend, 2*halosizez, top, bottom, &reqRecv[4], &reqSend[4], 8);
- t1 = wallclock_time();
- tcomm += t1-t2;
-
- /* compute update on grid values excluding halo areas */
- updateVelocities(vx, vy, vz, p, rox, halo, npx, npy, npz);
- t2 = wallclock_time();
- tcomp += t2-t1;
-
- /* wait for Vx.Vz halo exchange */
- waitForHalo(&reqRecv[0], &reqSend[0]);
- t1 = wallclock_time();
- tcomm += t1-t2;
-
- /* copy of halo areas back to arrays */
- newHaloVxVz(vx, vz, npx, npy, npz, halo, leftRecv, rightRecv, frontRecv, backRecv, topRecv, bottomRecv);
- t2 = wallclock_time();
- tcopy += t2-t1;
-
- /* add Force source on the Vz grid */
- src_ampl = wavelet[it];
-
- /* check if source position is in local domain */
- /* for the moment place a source in the middle of each domain */
- ixsrc = npx/2;
- iysrc = npy/2;
- izsrc = npz/2;
- isrc = iysrc*npx*npz+ixsrc*npz+izsrc;
-// fprintf(stderr,"npz=%d npx=%d npy=%d isrc=%d\n", npz, npx, npy, isrc);
-
- /* source scaling factor to compensate for discretisation */
- src_ampl *= rox[isrc]*l2m[isrc]/(dt);
-
- /* Force source */
- //if (my_rank == 0) vz[isrc] += 0.25*src_ampl*ro[isrc]*dz;
- vz[isrc] += 0.25*src_ampl*rox[isrc]*dz;
-
- /* compute field on the grid of the halo areas */
- updatePressureHalo(vx, vy, vz, p, l2m, halo, npx, npy, npz);
- t1 = wallclock_time();
- thcomp += t1-t2;
-
- /* copy p-field and sent to neighbours */
- copyHaloP(p, npx, npy, npz, halo, leftSend, rightSend, frontSend, backSend, topSend, bottomSend);
- exchangeHalo(leftRecv, leftSend, rightRecv, rightSend, halosizex, left, right, &reqRecv[0], &reqSend[0], 0);
- exchangeHalo(frontRecv, frontSend, backRecv, backSend, halosizey, front, back, &reqRecv[2], &reqSend[2], 4);
- exchangeHalo(topRecv, topSend, bottomRecv, bottomSend, halosizez, top, bottom, &reqRecv[4], &reqSend[4], 8);
- t2 = wallclock_time();
- tcomm += t2-t1;
-
- /* compute update on grid values excluding halo areas */
- updatePressure(vx, vy, vz, p, l2m, halo, npx, npy, npz);
- t1 = wallclock_time();
- tcomp += t1-t2;
-
- /* wait for P halo exchange */
- waitForHalo(&reqRecv[0], &reqSend[0]);
- t2 = wallclock_time();
- tcomm += t2-t1;
-
- newHaloP(p, npx, npy, npz, halo, leftRecv, rightRecv, frontRecv, backRecv, topRecv, bottomRecv);
- t1 = wallclock_time();
- tcopy += t1-t2;
-
-// fprintf(stderr,"rank %d did time step %d in %f seconds\n", my_rank, it, t1-t0);
-// fflush(stderr);
-
- /* write snapshots to file */
-// if (time >= snaptime && !snapwritten) {
- if ((it+1)%100==0 ) {
-
- t1 = wallclock_time();
- sprintf(filename,"snap_nz%d_nx%d_ny%d_it%4d.bin",nz, nx, ny, it);
-
- MPI_Info_create(&fileinfo);
- MPI_Info_set(fileinfo, "striping_factor", STRIPE_COUNT);
- MPI_Info_set(fileinfo, "striping_unit", STRIPE_SIZE);
- MPI_File_delete(filename, MPI_INFO_NULL);
- rc = MPI_File_open(MPI_COMM_WORLD, filename, MPI_MODE_RDWR|MPI_MODE_CREATE, fileinfo, &fh);
- if (rc != MPI_SUCCESS) {
- fprintf(stderr, "could not open input file\n");
- MPI_Abort(MPI_COMM_WORLD, 2);
- }
- disp = 0;
- rc = MPI_File_set_view(fh, disp, MPI_FLOAT, global_array, "native", fileinfo);
- if (rc != MPI_SUCCESS) {
- fprintf(stderr, "error setting view on results file\n");
- MPI_Abort(MPI_COMM_WORLD, 4);
- }
- rc = MPI_File_write_all(fh, p, 1, local_array, status);
- if (rc != MPI_SUCCESS) {
- MPI_Error_string(rc,err_buffer,&resultlen);
- fprintf(stderr,err_buffer);
- MPI_Abort(MPI_COMM_WORLD, 5);
- }
- MPI_File_close(&fh);
-
-
-/* MPI_Info_create(&fileinfo);
- MPI_File_delete(filename, MPI_INFO_NULL);
- MPI_File_open(MPI_COMM_WORLD, filename, MPI_MODE_RDWR|MPI_MODE_CREATE, MPI_INFO_NULL, &fh);
- MPI_File_set_view(fh, 0, MPI_FLOAT, global_array, "native", MPI_INFO_NULL);
- MPI_File_write_all(fh, p, npz*npx*npy, local_array, status);
- MPI_File_close(&fh);
-*/
- snapwritten+=1;
- t2 = wallclock_time();
- tio += t2-t1;
- }
-
- }
- ttot = wallclock_time() - t00;
-
- if (my_rank == 0) {
- fprintf(stderr,"rank %d total time in %f seconds\n", my_rank, ttot);
- fprintf(stderr,"rank %d comm time in %f seconds\n", my_rank, tcomm);
- fprintf(stderr,"rank %d comp time in %f seconds\n", my_rank, tcomp);
- fprintf(stderr,"rank %d hcomp time in %f seconds\n", my_rank, thcomp);
- fprintf(stderr,"rank %d copy time in %f seconds\n", my_rank, tcopy);
- fprintf(stderr,"rank %d io time in %f seconds\n", my_rank, tio);
- fprintf(stderr,"rank %d snaphsots written to file\n", snapwritten);
- }
-
-
- MPI_Finalize();
- return 0;
-}
-
-
-
-int updateVelocities(float *vx, float *vy, float *vz, float *p, float *ro, int halo, int npx, int npy, int npz)
-{
- int ix, iy, iz, iyp, ixp, izp, c1, c2, nxz;
- int ixs, ixe, iys, iye, izs, ize;
- float DpDx, DpDy, DpDz;
-
- nxz=npx*npz;
- c1 = 9.0/8.0;
- c2 = -1.0/24.0;
-
- ixs=2*halo; ixe=npx-2*halo;
- iys=2*halo; iye=npy-2*halo;
- izs=2*halo; ize=npz-2*halo;
-
- /* calculate vx,vy,vz for all grid points except on the virtual boundary*/
-#pragma omp for private (iy, ix, iz) nowait
-#pragma ivdep
- for (iy=iys; iy<iye; iy++) {
- iyp=iy*nxz;
- for (ix=ixs; ix<ixe; ix++) {
- ixp=ix*npz;
-#pragma ivdep
- for (iz=izs; iz<ize; iz++) {
- DpDx = Dx(p,ix,iyp,iz,npz);
- DpDy = Dy(p,ixp,iy,iz,nxz);
- DpDz = Dz(p,ixp,iyp,iz);
-
- vz[iyp+ixp+iz] += ro[iyp+ixp+iz]*DpDz;
- vx[iyp+ixp+iz] += ro[iyp+ixp+iz]*DpDx;
- vy[iyp+ixp+iz] += ro[iyp+ixp+iz]*DpDy;
- }
- }
- }
-
- return 0;
-}
-
-int updateVelocitiesHalo(float *vx, float *vy, float *vz, float *p, float *ro, int halo, int npx, int npy, int npz)
-{
- int ix, iy, iz, iyp, ixp, izp, c1, c2, nxz;
- float DpDx, DpDy, DpDz;
-
- nxz=npx*npz;
- c1 = 9.0/8.0;
- c2 = -1.0/24.0;
-
- /* calculate vx,vy,vz for all halo grid points */
-
- /* compute halo areas at left side */
-#pragma omp for private (iy, ix, iz) nowait
- for (iy=halo; iy<npy-halo; iy++) {
- iyp=iy*nxz;
- for (ix=halo; ix<2*halo; ix++) {
- ixp=ix*npz;
-#pragma ivdep
- for (iz=halo; iz<npz-halo; iz++) {
- DpDx = Dx(p,ix,iyp,iz,npz);
- DpDy = Dy(p,ixp,iy,iz,nxz);
- DpDz = Dz(p,ixp,iyp,iz);
-
- vz[iyp+ixp+iz] += ro[iyp+ixp+iz]*DpDz;
- vx[iyp+ixp+iz] += ro[iyp+ixp+iz]*DpDx;
- vy[iyp+ixp+iz] += ro[iyp+ixp+iz]*DpDy;
- }
- }
- }
-
- /* compute halo areas at right side */
- for (iy=halo; iy<npy-halo; iy++) {
- iyp=iy*nxz;
- for (ix=npx-2*halo; ix<npx-halo; ix++) {
- ixp=ix*npz;
-#pragma ivdep
- for (iz=halo; iz<npz-halo; iz++) {
- DpDx = Dx(p,ix,iyp,iz,npz);
- DpDy = Dy(p,ixp,iy,iz,nxz);
- DpDz = Dz(p,ixp,iyp,iz);
-
- vz[iyp+ixp+iz] += ro[iyp+ixp+iz]*DpDz;
- vx[iyp+ixp+iz] += ro[iyp+ixp+iz]*DpDx;
- vy[iyp+ixp+iz] += ro[iyp+ixp+iz]*DpDy;
- }
- }
- }
-
-
- /* compute halo areas at front side */
- for (iy=halo; iy<2*halo; iy++) {
- iyp=iy*nxz;
- for (ix=2*halo; ix<npx-2*halo; ix++) {
- ixp=ix*npz;
-#pragma ivdep
- for (iz=halo; iz<npz-halo; iz++) {
- DpDx = Dx(p,ix,iyp,iz,npz);
- DpDy = Dy(p,ixp,iy,iz,nxz);
- DpDz = Dz(p,ixp,iyp,iz);
-
- vz[iyp+ixp+iz] += ro[iyp+ixp+iz]*DpDz;
- vx[iyp+ixp+iz] += ro[iyp+ixp+iz]*DpDx;
- vy[iyp+ixp+iz] += ro[iyp+ixp+iz]*DpDy;
- }
- }
- }
-
- /* compute halo areas at back side */
- for (iy=npy-2*halo; iy<npy-halo; iy++) {
- iyp=iy*nxz;
- for (ix=2*halo; ix<npx-2*halo; ix++) {
- ixp=ix*npz;
-#pragma ivdep
- for (iz=halo; iz<npz-halo; iz++) {
- DpDx = Dx(p,ix,iyp,iz,npz);
- DpDy = Dy(p,ixp,iy,iz,nxz);
- DpDz = Dz(p,ixp,iyp,iz);
-
- vz[iyp+ixp+iz] += ro[iyp+ixp+iz]*DpDz;
- vx[iyp+ixp+iz] += ro[iyp+ixp+iz]*DpDx;
- vy[iyp+ixp+iz] += ro[iyp+ixp+iz]*DpDy;
- }
- }
- }
-
- /* compute halo areas at top side */
- for (iy=2*halo; iy<npy-2*halo; iy++) {
- iyp=iy*nxz;
- for (ix=2*halo; ix<npx-2*halo; ix++) {
- ixp=ix*npz;
-#pragma ivdep
- for (iz=halo; iz<2*halo; iz++) {
- DpDx = Dx(p,ix,iyp,iz,npz);
- DpDy = Dy(p,ixp,iy,iz,nxz);
- DpDz = Dz(p,ixp,iyp,iz);
-
- vz[iyp+ixp+iz] += ro[iyp+ixp+iz]*DpDz;
- vx[iyp+ixp+iz] += ro[iyp+ixp+iz]*DpDx;
- vy[iyp+ixp+iz] += ro[iyp+ixp+iz]*DpDy;
- }
- }
- }
-
- /* compute halo areas at bottom side */
- for (iy=2*halo; iy<npy-2*halo; iy++) {
- iyp=iy*nxz;
- for (ix=2*halo; ix<npx-2*halo; ix++) {
- ixp=ix*npz;
-#pragma ivdep
- for (iz=npz-2*halo; iz<npz-halo; iz++) {
- DpDx = Dx(p,ix,iyp,iz,npz);
- DpDy = Dy(p,ixp,iy,iz,nxz);
- DpDz = Dz(p,ixp,iyp,iz);
-
- vz[iyp+ixp+iz] += ro[iyp+ixp+iz]*DpDz;
- vx[iyp+ixp+iz] += ro[iyp+ixp+iz]*DpDx;
- vy[iyp+ixp+iz] += ro[iyp+ixp+iz]*DpDy;
- }
- }
- }
-
- return 0;
-}
-
-int updatePressure(float *vx, float *vy, float *vz, float *p, float *l2m, int halo, int npx, int npy, int npz)
-{
- int ix, iy, iz, iyp, ixp, izp, c1, c2, nxz;
- int ixs, ixe, iys, iye, izs, ize;
-
- nxz=npx*npz;
- c1 = 9.0/8.0;
- c2 = -1.0/24.0;
-
- ixs=2*halo; ixe=npx-2*halo;
- iys=2*halo; iye=npy-2*halo;
- izs=2*halo; ize=npz-2*halo;
-
-/* calculate p/tzz for all grid points except on the virtual boundary */
-#pragma omp for private (ix, iz)
-#pragma ivdep
- for (iy=iys; iy<iye; iy++) {
- iyp=iy*nxz;
- for (ix=ixs; ix<ixe; ix++) {
- ixp=ix*npz;
-#pragma ivdep
- for (iz=izs; iz<ize; iz++) {
- p[iyp+ixp+iz] += l2m[iyp+ixp+iz]*(Dv(vx,vz,ix,iy,iz,npz,nxz));
- }
- }
- }
-
- return 0;
-}
-
-int updatePressureHalo(float *vx, float *vy, float *vz, float *p, float *l2m, int halo, int npx, int npy, int npz)
-{
- int ix, iy, iz, iyp, ixp, izp, c1, c2, nxz;
-
- nxz=npx*npz;
- c1 = 9.0/8.0;
- c2 = -1.0/24.0;
-
- /* calculate p/tzz for all grid points except on the virtual boundary */
-
- /* compute halo areas at left side */
-#pragma omp for private (iy, ix, iz) nowait
- for (iy=halo; iy<npy-halo; iy++) {
- iyp=iy*nxz;
- for (ix=halo; ix<2*halo; ix++) {
- ixp=ix*npz;
-#pragma ivdep
- for (iz=halo; iz<npz-halo; iz++) {
- p[iyp+ixp+iz] += l2m[iyp+ixp+iz]*(Dv(vx,vz,ix,iy,iz,npz,nxz));
- }
- }
- }
-
- /* compute halo areas at right side */
- for (iy=halo; iy<npy-halo; iy++) {
- iyp=iy*nxz;
- for (ix=npx-2*halo; ix<npx-halo; ix++) {
- ixp=ix*npz;
-#pragma ivdep
- for (iz=halo; iz<npz-halo; iz++) {
- p[iyp+ixp+iz] += l2m[iyp+ixp+iz]*(Dv(vx,vz,ix,iy,iz,npz,nxz));
- }
- }
- }
-
-
- /* compute halo areas at front side */
- for (iy=halo; iy<2*halo; iy++) {
- iyp=iy*nxz;
- for (ix=2*halo; ix<npx-2*halo; ix++) {
- ixp=ix*npz;
-#pragma ivdep
- for (iz=halo; iz<npz-halo; iz++) {
- p[iyp+ixp+iz] += l2m[iyp+ixp+iz]*(Dv(vx,vz,ix,iy,iz,npz,nxz));
- }
- }
- }
-
- /* compute halo areas at back side */
- for (iy=npy-2*halo; iy<npy-halo; iy++) {
- iyp=iy*nxz;
- for (ix=2*halo; ix<npx-2*halo; ix++) {
- ixp=ix*npz;
-#pragma ivdep
- for (iz=halo; iz<npz-halo; iz++) {
- p[iyp+ixp+iz] += l2m[iyp+ixp+iz]*(Dv(vx,vz,ix,iy,iz,npz,nxz));
- }
- }
- }
-
- /* compute halo areas at top side */
- for (iy=2*halo; iy<npy-2*halo; iy++) {
- iyp=iy*nxz;
- for (ix=2*halo; ix<npx-2*halo; ix++) {
- ixp=ix*npz;
-#pragma ivdep
- for (iz=halo; iz<2*halo; iz++) {
- p[iyp+ixp+iz] += l2m[iyp+ixp+iz]*(Dv(vx,vz,ix,iy,iz,npz,nxz));
- }
- }
- }
-
- /* compute halo areas at bottom side */
- for (iy=2*halo; iy<npy-2*halo; iy++) {
- iyp=iy*nxz;
- for (ix=2*halo; ix<npx-2*halo; ix++) {
- ixp=ix*npz;
-#pragma ivdep
- for (iz=npz-2*halo; iz<npz-halo; iz++) {
- p[iyp+ixp+iz] += l2m[iyp+ixp+iz]*(Dv(vx,vz,ix,iy,iz,npz,nxz));
- }
- }
- }
-
- return 0;
-}
-
-int exchangeHalo(float *leftRecv, float *leftSend, float *rightRecv, float *rightSend, int size, int leftrank, int rightrank, MPI_Request *reqRecv, MPI_Request *reqSend, int tag)
-{
- int error, my_rank, ltag;
- MPI_Status status;
-
- MPI_Comm_rank(MPI_COMM_WORLD, &my_rank);
-
- if (leftrank != MPI_PROC_NULL) {
- ltag = tag;
- error = MPI_Irecv(leftRecv, size, MPI_FLOAT, leftrank, ltag, MPI_COMM_WORLD, &reqRecv[0]);
- assert (error == MPI_SUCCESS);
-// fprintf(stderr,"rank %d recv data from %d left\n", my_rank, leftrank);
- ltag = tag+1;
- error = MPI_Isend(leftSend, size, MPI_FLOAT, leftrank, ltag, MPI_COMM_WORLD, &reqSend[0]);
- assert (error == MPI_SUCCESS);
-// fprintf(stderr,"rank %d send data to %d left\n", my_rank, leftrank);
- }
- else {
- reqRecv[0] = MPI_REQUEST_NULL;
- reqSend[0] = MPI_REQUEST_NULL;
- }
-
- if (rightrank != MPI_PROC_NULL) {
- ltag = tag+1;
- error = MPI_Irecv(rightRecv, size, MPI_FLOAT, rightrank, ltag, MPI_COMM_WORLD, &reqRecv[1]);
-// fprintf(stderr,"rank %d recv data from %d right\n", my_rank, rightrank);
- assert (error == MPI_SUCCESS);
- ltag = tag;
- error = MPI_Isend(rightSend, size, MPI_FLOAT, rightrank, ltag, MPI_COMM_WORLD, &reqSend[1]);
- assert (error == MPI_SUCCESS);
-// fprintf(stderr,"rank %d send data to %d right\n", my_rank, rightrank);
- }
- else {
- reqRecv[1] = MPI_REQUEST_NULL;
- reqSend[1] = MPI_REQUEST_NULL;
- }
-
- return 0;
-}
-
-int waitForHalo(MPI_Request *reqRecv, MPI_Request *reqSend)
-{
- int i;
- MPI_Status status;
- int error;
-
- for (i=0; i<6; i++) {
- error = MPI_Wait(&reqSend[i], &status);
- assert (error == MPI_SUCCESS);
- }
-
-// MPI_Barrier(MPI_COMM_WORLD);
-
- for (i=0; i<6; i++) {
- error = MPI_Wait(&reqRecv[i], &status);
- assert (error == MPI_SUCCESS);
- }
-
- return 0;
-}
-
-int copyHaloVxVz(float *vx, float *vz, int npx, int npy, int npz, int halo, float *leftSend, float *rightSend, float *frontSend, float *backSend, float *topSend, float *bottomSend)
-{
- int ix, iy, iz, ih, iyp, ixp, halosizex, halosizey, halosizez, nxz;
-
- nxz = npx*npz;
-
- /* copy halo areas at left side */
- halosizex = npy*npz*halo;
- for (iy=halo; iy<npy-halo; iy++) {
- iyp=iy*nxz;
- for (ix=halo; ix<2*halo; ix++) {
- ixp=ix*npz;
- ih=(ix-halo)*npz;
-#pragma ivdep
- for (iz=halo; iz<npz-halo; iz++) {
- leftSend[iy*npz*halo+ih+iz] = vx[iyp+ixp+iz];
- leftSend[halosizex+iy*npz*halo+ih+iz] = vz[iyp+ixp+iz];
- }
- }
- }
-
- /* copy halo areas at right side */
- halosizex = npy*npz*halo;
- for (iy=halo; iy<npy-halo; iy++) {
- iyp=iy*nxz;
- for (ix=npx-2*halo; ix<npx-halo; ix++) {
- ixp=ix*npz;
- ih=(ix-(npx-2*halo))*npz;
-#pragma ivdep
- for (iz=halo; iz<npz-halo; iz++) {
- rightSend[iy*npz*halo+ih+iz] = vx[iyp+ixp+iz];
- rightSend[halosizex+iy*npz*halo+ih+iz] = vz[iyp+ixp+iz];
- }
- }
- }
-
-
- /* copy halo areas at front side */
- halosizey = npx*npz*halo;
- for (iy=halo; iy<2*halo; iy++) {
- iyp=iy*nxz;
- ih=(iy-halo)*nxz;
- for (ix=0; ix<npx; ix++) {
- ixp=ix*npz;
-#pragma ivdep
- for (iz=halo; iz<npz-halo; iz++) {
- frontSend[ih+ixp+iz] = vx[iyp+ixp+iz];
- frontSend[halosizey+ih+ixp+iz] = vz[iyp+ixp+iz];
- }
- }
- }
-
- /* copy halo areas at back side */
- for (iy=npy-2*halo; iy<npy-halo; iy++) {
- iyp=iy*nxz;
- ih=(iy-(npy-2*halo))*nxz;
- for (ix=0; ix<npx; ix++) {
- ixp=ix*npz;
-#pragma ivdep
- for (iz=halo; iz<npz-halo; iz++) {
- backSend[ih+ixp+iz] = vx[iyp+ixp+iz];
- backSend[halosizey+ih+ixp+iz] = vz[iyp+ixp+iz];
- }
- }
- }
-
- /* copy halo areas at top side */
- halosizez = npy*npx*halo;
- for (iy=0; iy<npy; iy++) {
- iyp=iy*nxz;
- for (ix=0; ix<npx; ix++) {
- ixp=ix*npz;
-#pragma ivdep
- for (iz=halo; iz<2*halo; iz++) {
- ih=iz-halo;
- topSend[iy*npx*halo+ix*halo+ih] = vx[iyp+ixp+iz];
- topSend[halosizez+iy*npx*halo+ix*halo+ih] = vz[iyp+ixp+iz];
- }
- }
- }
-
- /* copy halo areas at bottom side */
- for (iy=0; iy<npy; iy++) {
- iyp=iy*nxz;
- for (ix=0; ix<npx; ix++) {
- ixp=ix*npz;
-#pragma ivdep
- for (iz=npz-2*halo; iz<npz-halo; iz++) {
- ih=(iz-(npz-2*halo));
- bottomSend[iy*npx*halo+ix*halo+ih] = vx[iyp+ixp+iz];
- bottomSend[halosizez+iy*npx*halo+ix*halo+ih] = vz[iyp+ixp+iz];
- }
- }
- }
-
- return 0;
-}
-
-int copyHaloP(float *p, int npx, int npy, int npz, int halo, float *leftSend, float *rightSend, float *frontSend, float *backSend, float *topSend, float *bottomSend)
-{
- int ix, iy, iz, ih, iyp, ixp, halosizex, halosizey, halosizez, nxz;
-
- nxz = npx*npz;
-
- /* copy halo areas at left side */
- halosizex = npy*npz*halo;
- for (iy=halo; iy<npy-halo; iy++) {
- iyp=iy*nxz;
- for (ix=halo; ix<2*halo; ix++) {
- ixp=ix*npz;
- ih=(ix-halo)*npz;
-#pragma ivdep
- for (iz=halo; iz<npz-halo; iz++) {
- leftSend[iy*npz*halo+ih+iz] = p[iyp+ixp+iz];
- }
- }
- }
-
- /* copy halo areas at right side */
- halosizex = npy*npz*halo;
- for (iy=halo; iy<npy-halo; iy++) {
- iyp=iy*nxz;
- for (ix=npx-2*halo; ix<npx-halo; ix++) {
- ixp=ix*npz;
- ih=(ix-(npx-2*halo))*npz;
-#pragma ivdep
- for (iz=halo; iz<npz-halo; iz++) {
- rightSend[iy*npz*halo+ih+iz] = p[iyp+ixp+iz];
- }
- }
- }
-
-
- /* copy halo areas at front side */
- halosizey = npx*npz*halo;
- for (iy=halo; iy<2*halo; iy++) {
- iyp=iy*nxz;
- ih=(iy-halo)*nxz;
- for (ix=0; ix<npx; ix++) {
- ixp=ix*npz;
-#pragma ivdep
- for (iz=halo; iz<npz-halo; iz++) {
- frontSend[ih+ixp+iz] = p[iyp+ixp+iz];
- }
- }
- }
-
- /* copy halo areas at back side */
- for (iy=npy-2*halo; iy<npy-halo; iy++) {
- iyp=iy*nxz;
- ih=(iy-(npy-2*halo))*nxz;
- for (ix=0; ix<npx; ix++) {
- ixp=ix*npz;
-#pragma ivdep
- for (iz=halo; iz<npz-halo; iz++) {
- backSend[ih+ixp+iz] = p[iyp+ixp+iz];
- }
- }
- }
-
- /* copy halo areas at top side */
- halosizez = npy*npx*halo;
- for (iy=0; iy<npy; iy++) {
- iyp=iy*nxz;
- for (ix=0; ix<npx; ix++) {
- ixp=ix*npz;
-#pragma ivdep
- for (iz=halo; iz<2*halo; iz++) {
- ih=iz-halo;
- topSend[iy*npx*halo+ix*halo+ih] = p[iyp+ixp+iz];
- }
- }
- }
-
- /* copy halo areas at bottom side */
- for (iy=0; iy<npy; iy++) {
- iyp=iy*nxz;
- for (ix=0; ix<npx; ix++) {
- ixp=ix*npz;
-#pragma ivdep
- for (iz=npz-2*halo; iz<npz-halo; iz++) {
- ih=(iz-(npz-2*halo));
- bottomSend[iy*npx*halo+ix*halo+ih] = p[iyp+ixp+iz];
- }
- }
- }
-
- return 0;
-}
-
-/* copy communicated halo areas back to compute grids */
-int newHaloVxVz(float *vx, float *vz, int npx, int npy, int npz, int halo, float *leftRecv, float *rightRecv, float *frontRecv, float *backRecv, float *topRecv, float *bottomRecv)
-{
- int ix, iy, iz, ih, iyp, ixp, halosizex, halosizey, halosizez, nxz;
-
- nxz = npx*npz;
-
- /* copy halo areas at left side */
- halosizex = npy*npz*halo;
- for (iy=halo; iy<npy-halo; iy++) {
- iyp=iy*nxz;
- for (ix=0; ix<halo; ix++) {
- ixp=ix*npz;
- ih=ixp;
-#pragma ivdep
- for (iz=halo; iz<npz-halo; iz++) {
- vx[iyp+ixp+iz] = leftRecv[iy*npz*halo+ih+iz];
- vz[iyp+ixp+iz] = leftRecv[halosizex+iy*npz*halo+ih+iz];
- }
- }
- }
-
- /* copy halo areas at right side */
- halosizex = npy*npz*halo;
- for (iy=halo; iy<npy-halo; iy++) {
- iyp=iy*nxz;
- for (ix=npx-halo; ix<npx; ix++) {
- ixp=ix*npz;
- ih=(ix-(npx-halo))*npz;
-#pragma ivdep
- for (iz=halo; iz<npz-halo; iz++) {
- vx[iyp+ixp+iz] = rightRecv[iy*npz*halo+ih+iz];
- vz[iyp+ixp+iz] = rightRecv[halosizex+iy*npz*halo+ih+iz];
- }
- }
- }
-
-
- /* copy halo areas at front side */
- halosizey = npx*npz*halo;
- for (iy=0; iy<halo; iy++) {
- iyp=iy*nxz;
- ih=iyp;
- for (ix=0; ix<npx; ix++) {
- ixp=ix*npz;
-#pragma ivdep
- for (iz=halo; iz<npz-halo; iz++) {
- vx[iyp+ixp+iz] = frontRecv[ih+ixp+iz];
- vz[iyp+ixp+iz] = frontRecv[halosizey+ih+ixp+iz];
- }
- }
- }
-
- /* copy halo areas at back side */
- for (iy=npy-halo; iy<npy; iy++) {
- iyp=iy*nxz;
- ih=(iy-(npy-halo))*nxz;
- for (ix=0; ix<npx; ix++) {
- ixp=ix*npz;
-#pragma ivdep
- for (iz=halo; iz<npz-halo; iz++) {
- vx[iyp+ixp+iz] = backRecv[ih+ixp+iz];
- vz[iyp+ixp+iz] = backRecv[halosizey+ih+ixp+iz];
- }
- }
- }
-
- /* copy halo areas at top side */
- halosizez = npy*npx*halo;
- for (iy=0; iy<npy; iy++) {
- iyp=iy*nxz;
- for (ix=0; ix<npx; ix++) {
- ixp=ix*npz;
-#pragma ivdep
- for (iz=0; iz<halo; iz++) {
- ih=iz;
- vx[iyp+ixp+iz] = topRecv[iy*npx*halo+ix*halo+ih];
- vz[iyp+ixp+iz] = topRecv[halosizez+iy*npx*halo+ix*halo+ih];
- }
- }
- }
-
- /* copy halo areas at bottom side */
- for (iy=0; iy<npy; iy++) {
- iyp=iy*nxz;
- for (ix=0; ix<npx; ix++) {
- ixp=ix*npz;
-#pragma ivdep
- for (iz=npz-halo; iz<npz; iz++) {
- ih=(iz-(npz-halo));
- vx[iyp+ixp+iz] = bottomRecv[iy*npx*halo+ix*halo+ih];
- vz[iyp+ixp+iz] = bottomRecv[halosizez+iy*npx*halo+ix*halo+ih];
- }
- }
- }
-
- return 0;
-}
-
-/* copy communicated halo areas back to compute grids */
-int newHaloP(float *p, int npx, int npy, int npz, int halo, float *leftRecv, float *rightRecv, float *frontRecv, float *backRecv, float *topRecv, float *bottomRecv)
-{
- int ix, iy, iz, ih, iyp, ixp, halosizex, halosizey, halosizez, nxz;
-
- nxz = npx*npz;
-
- /* copy halo areas at left side */
- halosizex = npy*npz*halo;
- for (iy=halo; iy<npy-halo; iy++) {
- iyp=iy*nxz;
- for (ix=0; ix<halo; ix++) {
- ixp=ix*npz;
- ih=ixp;
-#pragma ivdep
- for (iz=halo; iz<npz-halo; iz++) {
- p[iyp+ixp+iz] = leftRecv[iy*npz*halo+ih+iz];
- }
- }
- }
-
- /* copy halo areas at right side */
- halosizex = npy*npz*halo;
- for (iy=halo; iy<npy-halo; iy++) {
- iyp=iy*nxz;
- for (ix=npx-halo; ix<npx; ix++) {
- ixp=ix*npz;
- ih=(ix-(npx-halo))*npz;
-#pragma ivdep
- for (iz=halo; iz<npz-halo; iz++) {
- p[iyp+ixp+iz] = rightRecv[iy*npz*halo+ih+iz];
- }
- }
- }
-
-
- /* copy halo areas at front side */
- halosizey = npx*npz*halo;
- for (iy=0; iy<halo; iy++) {
- iyp=iy*nxz;
- ih=iyp;
- for (ix=0; ix<npx; ix++) {
- ixp=ix*npz;
-#pragma ivdep
- for (iz=halo; iz<npz-halo; iz++) {
- p[iyp+ixp+iz] = frontRecv[ih+ixp+iz];
- }
- }
- }
-
- /* copy halo areas at back side */
- for (iy=npy-halo; iy<npy; iy++) {
- iyp=iy*nxz;
- ih=(iy-(npy-halo))*nxz;
- for (ix=0; ix<npx; ix++) {
- ixp=ix*npz;
-#pragma ivdep
- for (iz=halo; iz<npz-halo; iz++) {
- p[iyp+ixp+iz] = backRecv[ih+ixp+iz];
- }
- }
- }
-
- /* copy halo areas at top side */
- halosizez = npy*npx*halo;
- for (iy=0; iy<npy; iy++) {
- iyp=iy*nxz;
- for (ix=0; ix<npx; ix++) {
- ixp=ix*npz;
-#pragma ivdep
- for (iz=0; iz<halo; iz++) {
- ih=iz;
- p[iyp+ixp+iz] = topRecv[iy*npx*halo+ix*halo+ih];
- }
- }
- }
-
- /* copy halo areas at bottom side */
- for (iy=0; iy<npy; iy++) {
- iyp=iy*nxz;
- for (ix=0; ix<npx; ix++) {
- ixp=ix*npz;
-#pragma ivdep
- for (iz=npz-halo; iz<npz; iz++) {
- ih=(iz-(npz-halo));
- p[iyp+ixp+iz] = bottomRecv[iy*npx*halo+ix*halo+ih];
- }
- }
- }
-
- return 0;
-}
-float gauss2time(float t, float f, float t0)
-{
- float value, time;
-
- time = t-t0;
- value = ((1.0-2.0*M_PI*M_PI*f*f*time*time)*exp(-M_PI*M_PI*f*f*time*time));
- return value;
-}
-
diff --git a/fdelmodc3D/Makefile b/fdelmodc3D/Makefile
index c1820c9cb751513d5c1572335183bb54c3d02ab2..113490ac7ee23f7a5bdc045116630c21e2d926dc 100644
--- a/fdelmodc3D/Makefile
+++ b/fdelmodc3D/Makefile
@@ -20,34 +20,26 @@ all: fdelmodc3D
PRG = fdelmodc3D
SRCC = $(PRG).c \
- acoustic2.c \
- acoustic4.c \
- acousticSH4.c \
- acoustic4_qr.c \
- acoustic6.c \
- viscoacoustic4.c \
- elastic4.c \
- elastic4dc.c \
- elastic6.c \
- viscoelastic4.c \
- defineSource.c \
- getParameters.c \
- getWaveletInfo.c \
- getModelInfo.c \
- applySource.c \
- getRecTimes.c \
- getBeamTimes.c \
- writeSnapTimes.c \
- writeRec.c \
- writeSrcRecPos.c \
+ acoustic4_3D.c \
+ defineSource3D.c \
+ getParameters3D.c \
+ getWaveletInfo3D.c \
+ getModelInfo3D.c \
+ applySource3D.c \
+ getRecTimes3D.c \
+ getBeamTimes3D.c \
+ writeSnapTimes3D.c \
+ writeRec3D.c \
+ writeSrcRecPos3D.c \
decomposition.c \
fileOpen.c \
- recvPar.c \
- readModel.c \
- sourceOnSurface.c \
- getWaveletHeaders.c \
- boundaries.c \
+ recvPar3D.c \
+ readModel3D.c \
+ sourceOnSurface3D.c \
+ getWaveletHeaders3D.c \
+ boundaries3D.c \
verbosepkg.c \
+ writesufile3D.c \
writesufile.c \
gaussGen.c \
spline3.c \
@@ -61,7 +53,7 @@ SRCC = $(PRG).c \
OBJC = $(SRCC:%.c=%.o)
-$(PRG): $(OBJC) fdelmodc.h
+$(PRG): $(OBJC) fdelmodc3D.h
$(CC) $(LDFLAGS) $(CFLAGS) $(OPTC) -o fdelmodc3D $(OBJC) $(LIBS)
install: fdelmodc3D
diff --git a/fdelmodc3D/acoustic2.c b/fdelmodc3D/acoustic2.c
deleted file mode 100644
index 32fa4b250d592836e6533a449ad0f1c0dc429a31..0000000000000000000000000000000000000000
--- a/fdelmodc3D/acoustic2.c
+++ /dev/null
@@ -1,136 +0,0 @@
-#include<stdlib.h>
-#include<stdio.h>
-#include<math.h>
-#include<assert.h>
-#include"fdelmodc.h"
-
-int applySource(modPar mod, srcPar src, wavPar wav, bndPar bnd, int itime, int ixsrc, int izsrc, float *vx, float *vz, float *tzz, float *txx, float *txz, float *rox, float *roz, float *l2m, float **src_nwav, int verbose);
-
-int storeSourceOnSurface(modPar mod, srcPar src, bndPar bnd, int ixsrc, int izsrc, float *vx, float *vz, float *tzz, float *txx, float *txz, int verbose);
-
-int reStoreSourceOnSurface(modPar mod, srcPar src, bndPar bnd, int ixsrc, int izsrc, float *vx, float *vz, float *tzz, float *txx, float *txz, int verbose);
-
-int boundariesP(modPar mod, bndPar bnd, float *vx, float *vz, float *tzz, float *txx, float *txz, float *rox, float *roz, float *l2m, float *lam, float *mul, int itime, int verbose);
-
-int boundariesV(modPar mod, bndPar bnd, float *vx, float *vz, float *tzz, float *txx, float *txz, float *rox, float *roz, float *l2m, float *lam, float *mul, int itime, int verbose);
-
-int acoustic2(modPar mod, srcPar src, wavPar wav, bndPar bnd, int itime, int ixsrc, int izsrc, float **src_nwav, float *vx, float *vz, float *p, float *rox, float *roz, float *l2m, int verbose)
-{
-
-/*********************************************************************
- COMPUTATIONAL OVERVIEW OF THE 4th ORDER STAGGERED GRID:
-
- The captial symbols T (=Txx,Tzz) Txz,Vx,Vz represent the actual grid
- The indices ix,iz are related to the T grid, so the capital T
- symbols represent the actual modelled grid.
-
- one cel (iz,ix)
- |
- V extra column of vx,txz
- |
- ------- V
- | txz vz| txz vz txz vz txz vz txz vz txz vz txz
- | |
- | vx t | vx t vx t vx t vx t vx t vx
- -------
- txz vz txz vz txz vz txz vz txz vz txz vz txz
-
- vx t vx T---Vx--T---Vx--T---Vx--T vx t vx
- | | | | | | |
- txz vz txz Vz--Txz-Vz--Txz-Vz Txz-Vz txz vz txz
- | | | | | | |
- vx t vx T---Vx--T---Vx--T---Vx--T vx t vx
- | | | | | | |
- txz vz txz Vz Txz-Vz Txz-Vz Txz-Vz txz vz txz
- | | | | | | |
- vx t vx T---Vx--T---Vx--T---Vx--T vx t vx
- | | | | | | |
- txz vz txz Vz Txz-Vz Txz-Vz Txz-Vz txz vz txz
- | | | | | | |
- vx t vx T---Vx--T---Vx--T---Vx--T vx t vx
-
- txz vz txz vz txz vz txz vz txz vz txz vz txz
-
- vx t vx t vx t vx t vx t vx t vx
-
- txz vz txz vz txz vz txz vz txz vz txz vz txz <--|
- |
- extra row of txz/vz |
-
-
- AUTHOR:
- Jan Thorbecke (janth@xs4all.nl)
- The Netherlands
-
-***********************************************************************/
-
- int ix, iz;
- int n1;
- int ioXx, ioXz, ioZz, ioZx, ioPx, ioPz;
- int ieXx, ieXz, ieZz, ieZx, iePx, iePz;
-
- n1 = mod.naz;
-
- /* Vx: rox */
- ioXx=mod.ioXx;
- ioXz=mod.ioXz;
- ieXx=mod.ieXx;
- ieXz=mod.ieXz;
- /* Vz: roz */
- ioZz=mod.ioZz;
- ioZx=mod.ioZz;
- ieZz=mod.ieZz;
- ieZx=mod.ieZz;
- /* P, Txx, Tzz: lam, l2m */
- ioPx=mod.ioPx;
- ioPz=mod.ioPz;
- iePx=mod.iePx;
- iePz=mod.iePz;
-
- /* calculate vx for all grid points except on the virtual boundary*/
- for (ix=ioXx; ix<ieXx; ix++) {
- for (iz=ioXz; iz<ieXz; iz++) {
- vx[ix*n1+iz] -= rox[ix*n1+iz]*(p[ix*n1+iz] - p[(ix-1)*n1+iz]);
- }
- }
-
- /* calculate vz for all grid points except on the virtual boundary */
- for (ix=ioZx; ix<ieZx; ix++) {
- for (iz=ioZz; iz<ieZz; iz++) {
- vz[ix*n1+iz] -= roz[ix*n1+iz]*(p[ix*n1+iz] - p[ix*n1+iz-1]);
- }
- }
-
- /* Add force source */
- if (src.type > 5) {
- applySource(mod, src, wav, bnd, itime, ixsrc, izsrc, vx, vz, p, NULL, NULL, rox, roz, l2m, src_nwav, verbose);
- }
-
- /* boundary condition clears velocities on boundaries */
- boundariesP(mod, bnd, vx, vz, p, NULL, NULL, rox, roz, l2m, NULL, NULL, itime, verbose);
-
- /* calculate p/tzz for all grid points except on the virtual boundary */
- for (ix=ioPx; ix<iePx; ix++) {
- for (iz=ioPz; iz<iePz; iz++) {
- p[ix*n1+iz] -= l2m[ix*n1+iz]*(
- (vx[(ix+1)*n1+iz] - vx[ix*n1+iz]) +
- (vz[ix*n1+iz+1] - vz[ix*n1+iz]));
- }
- }
-
- /* Add stress source */
- if (src.type < 6) {
- applySource(mod, src, wav, bnd, itime, ixsrc, izsrc, vx, vz, p, NULL, NULL, rox, roz, l2m, src_nwav, verbose);
- }
-
- /* check if there are sources placed on the free surface */
- storeSourceOnSurface(mod, src, bnd, ixsrc, izsrc, vx, vz, p, NULL, NULL, verbose);
-
- /* Free surface: calculate free surface conditions for stresses */
- boundariesV(mod, bnd, vx, vz, p, NULL, NULL, rox, roz, l2m, NULL, NULL, itime, verbose);
-
- /* restore source positions on the edge */
- reStoreSourceOnSurface(mod, src, bnd, ixsrc, izsrc, vx, vz, p, NULL, NULL, verbose);
-
- return 0;
-}
diff --git a/fdelmodc3D/acoustic4.c b/fdelmodc3D/acoustic4.c
deleted file mode 100644
index 9e5d95fde9acc93779ce8b24c2d6e1266baeede8..0000000000000000000000000000000000000000
--- a/fdelmodc3D/acoustic4.c
+++ /dev/null
@@ -1,156 +0,0 @@
-#include<stdlib.h>
-#include<stdio.h>
-#include<math.h>
-#include<assert.h>
-#include"fdelmodc.h"
-
-#define MIN(x,y) ((x) < (y) ? (x) : (y))
-
-int applySource(modPar mod, srcPar src, wavPar wav, bndPar bnd, int itime, int ixsrc, int izsrc, float *vx, float *vz, float *tzz, float *txx, float *txz, float *rox, float *roz, float *l2m, float **src_nwav, int verbose);
-
-int storeSourceOnSurface(modPar mod, srcPar src, bndPar bnd, int ixsrc, int izsrc, float *vx, float *vz, float *tzz, float *txx, float *txz, int verbose);
-
-int reStoreSourceOnSurface(modPar mod, srcPar src, bndPar bnd, int ixsrc, int izsrc, float *vx, float *vz, float *tzz, float *txx, float *txz, int verbose);
-
-int boundariesP(modPar mod, bndPar bnd, float *vx, float *vz, float *tzz, float *txx, float *txz, float *rox, float *roz, float *l2m, float *lam, float *mul, int itime, int verbose);
-
-int boundariesV(modPar mod, bndPar bnd, float *vx, float *vz, float *tzz, float *txx, float *txz, float *rox, float *roz, float *l2m, float *lam, float *mul, int itime, int verbose);
-
-int acoustic4(modPar mod, srcPar src, wavPar wav, bndPar bnd, int itime, int ixsrc, int izsrc, float **src_nwav, float *vx, float *vz, float *p, float *rox, float *roz, float *l2m, int verbose)
-{
-/*********************************************************************
- COMPUTATIONAL OVERVIEW OF THE 4th ORDER STAGGERED GRID:
-
- The captial symbols T (=P) Txz,Vx,Vz represent the actual grid
- The indices ix,iz are related to the T grid, so the capital T
- symbols represent the actual modelled grid.
-
- one cel (iz,ix)
- |
- V extra column of vx,txz
- |
- ------- V
- | txz vz| txz vz txz vz txz vz txz vz txz vz txz
- | |
- | vx t | vx t vx t vx t vx t vx t vx
- -------
- txz vz txz vz txz vz txz vz txz vz txz vz txz
-
- vx t vx T---Vx--T---Vx--T---Vx--T vx t vx
- | | | | | | |
- txz vz txz Vz--Txz-Vz--Txz-Vz Txz-Vz txz vz txz
- | | | | | | |
- vx t vx T---Vx--T---Vx--T---Vx--T vx t vx
- | | | | | | |
- txz vz txz Vz Txz-Vz Txz-Vz Txz-Vz txz vz txz
- | | | | | | |
- vx t vx T---Vx--T---Vx--T---Vx--T vx t vx
- | | | | | | |
- txz vz txz Vz Txz-Vz Txz-Vz Txz-Vz txz vz txz
- | | | | | | |
- vx t vx T---Vx--T---Vx--T---Vx--T vx t vx
-
- txz vz txz vz txz vz txz vz txz vz txz vz txz
-
- vx t vx t vx t vx t vx t vx t vx
-
- txz vz txz vz txz vz txz vz txz vz txz vz txz <--|
- |
- extra row of txz/vz |
-
- AUTHOR:
- Jan Thorbecke (janth@xs4all.nl)
- The Netherlands
-
-***********************************************************************/
-
- float c1, c2;
- int ix, iz;
- int n1;
- int ioXx, ioXz, ioZz, ioZx, ioPx, ioPz;
-
- c1 = 9.0/8.0;
- c2 = -1.0/24.0;
- n1 = mod.naz;
-
-/*
- ioXx=mod.iorder/2;
- ioXz=ioXx-1;
- ioZz=mod.iorder/2;
- ioZx=ioZz-1;
- ioPx=mod.iorder/2-1;
- ioPz=ioPx;
-*/
- /* calculate vx for all grid points except on the virtual boundary*/
-#pragma omp for private (ix, iz) nowait schedule(guided,1)
- for (ix=mod.ioXx; ix<mod.ieXx; ix++) {
-#pragma ivdep
- for (iz=mod.ioXz; iz<mod.ieXz; iz++) {
- vx[ix*n1+iz] -= rox[ix*n1+iz]*(
- c1*(p[ix*n1+iz] - p[(ix-1)*n1+iz]) +
- c2*(p[(ix+1)*n1+iz] - p[(ix-2)*n1+iz]));
- }
- }
-
- /* calculate vz for all grid points except on the virtual boundary */
-#pragma omp for private (ix, iz) schedule(guided,1)
- for (ix=mod.ioZx; ix<mod.ieZx; ix++) {
-#pragma ivdep
- for (iz=mod.ioZz; iz<mod.ieZz; iz++) {
- vz[ix*n1+iz] -= roz[ix*n1+iz]*(
- c1*(p[ix*n1+iz] - p[ix*n1+iz-1]) +
- c2*(p[ix*n1+iz+1] - p[ix*n1+iz-2]));
- }
- }
-
- /* boundary condition clears velocities on boundaries */
- boundariesP(mod, bnd, vx, vz, p, NULL, NULL, rox, roz, l2m, NULL, NULL, itime, verbose);
-
- /* Add force source */
- if (src.type > 5) {
- applySource(mod, src, wav, bnd, itime, ixsrc, izsrc, vx, vz, p, NULL, NULL, rox, roz, l2m, src_nwav, verbose);
- }
-
- /* this is needed because the P fields are not using tapered boundaries (bnd....=4) */
- if (bnd.top==2) mod.ioPz += bnd.npml;
- if (bnd.bot==2) mod.iePz -= bnd.npml;
- if (bnd.lef==2) mod.ioPx += bnd.npml;
- if (bnd.rig==2) mod.iePx -= bnd.npml;
-
- /* calculate p/tzz for all grid points except on the virtual boundary */
-#pragma omp for private (ix, iz) schedule(guided,1)
-//#pragma omp for private (ix, iz) schedule(dynamic)
-#pragma ivdep
- for (ix=mod.ioPx; ix<mod.iePx; ix++) {
-#pragma ivdep
- for (iz=mod.ioPz; iz<mod.iePz; iz++) {
- p[ix*n1+iz] -= l2m[ix*n1+iz]*(
- c1*(vx[(ix+1)*n1+iz] - vx[ix*n1+iz]) +
- c2*(vx[(ix+2)*n1+iz] - vx[(ix-1)*n1+iz]) +
- c1*(vz[ix*n1+iz+1] - vz[ix*n1+iz]) +
- c2*(vz[ix*n1+iz+2] - vz[ix*n1+iz-1]));
- }
- }
- if (bnd.top==2) mod.ioPz -= bnd.npml;
- if (bnd.bot==2) mod.iePz += bnd.npml;
- if (bnd.lef==2) mod.ioPx -= bnd.npml;
- if (bnd.rig==2) mod.iePx += bnd.npml;
-
- /* Add stress source */
- if (src.type < 6) {
- applySource(mod, src, wav, bnd, itime, ixsrc, izsrc, vx, vz, p, NULL, NULL, rox, roz, l2m, src_nwav, verbose);
- }
-
-/* Free surface: calculate free surface conditions for stresses */
-
- /* check if there are sources placed on the free surface */
- storeSourceOnSurface(mod, src, bnd, ixsrc, izsrc, vx, vz, p, NULL, NULL, verbose);
-
- /* Free surface: calculate free surface conditions for stresses */
- boundariesV(mod, bnd, vx, vz, p, NULL, NULL, rox, roz, l2m, NULL, NULL, itime, verbose);
-
- /* restore source positions on the edge */
- reStoreSourceOnSurface(mod, src, bnd, ixsrc, izsrc, vx, vz, p, NULL, NULL, verbose);
-
- return 0;
-}
diff --git a/fdelmodc3D/acoustic4_3D.c b/fdelmodc3D/acoustic4_3D.c
index 453d59f0267d9ae4321129ee7b807a8750b95171..d64c7bdd36d884fe81c43724805f186267209eaa 100644
--- a/fdelmodc3D/acoustic4_3D.c
+++ b/fdelmodc3D/acoustic4_3D.c
@@ -6,17 +6,32 @@
#define MIN(x,y) ((x) < (y) ? (x) : (y))
-long applySource(modPar mod, srcPar src, wavPar wav, bndPar bnd, long itime, long ixsrc, long izsrc, float *vx, float *vz, float *tzz, float *txx, float *txz, float *rox, float *roz, float *l2m, float **src_nwav, long verbose);
-
-long storeSourceOnSurface(modPar mod, srcPar src, bndPar bnd, long ixsrc, long izsrc, float *vx, float *vz, float *tzz, float *txx, float *txz, long verbose);
-
-long reStoreSourceOnSurface(modPar mod, srcPar src, bndPar bnd, long ixsrc, long izsrc, float *vx, float *vz, float *tzz, float *txx, float *txz, long verbose);
-
-long boundariesP(modPar mod, bndPar bnd, float *vx, float *vz, float *tzz, float *txx, float *txz, float *rox, float *roz, float *l2m, float *lam, float *mul, long itime, long verbose);
-
-long boundariesV(modPar mod, bndPar bnd, float *vx, float *vz, float *tzz, float *txx, float *txz, float *rox, float *roz, float *l2m, float *lam, float *mul, long itime, long verbose);
-
-long acoustic4_3D(modPar mod, srcPar src, wavPar wav, bndPar bnd, long itime, long ixsrc, long iysrc, long izsrc, float **src_nwav, float *vx, float *vy, float *vz, float *p, float *rox, float *roy, float *roz, float *l2m, long verbose)
+long applySource3D(modPar mod, srcPar src, wavPar wav, bndPar bnd, long itime,
+ long ixsrc, long iysrc, long izsrc, float *vx, float *vy, float *vz,
+ float *tzz, float *tyy, float *txx, float *txz, float *txy, float *tyz,
+ float *rox, float *roy, float *roz, float *l2m, float **src_nwav, long verbose);
+
+long storeSourceOnSurface3D(modPar mod, srcPar src, bndPar bnd,
+ long ixsrc, long iysrc, long izsrc, float *vx, float *vy, float *vz,
+ float *tzz, float *tyy, float *txx, float *txz, float *txy, float *tyz, long verbose);
+
+long reStoreSourceOnSurface3D(modPar mod, srcPar src, bndPar bnd,
+ long ixsrc, long iysrc, long izsrc, float *vx, float *vy, float *vz,
+ float *tzz, float *tyy, float *txx, float *txz, float *txy, float *tyz, long verbose);
+
+long boundariesP3D(modPar mod, bndPar bnd, float *vx, float *vy, float *vz,
+ float *tzz, float *tyy, float *txx, float *txz, float *txy, float *tyz,
+ float *rox, float *roy, float *roz, float *l2m, float *lam, float *mul,
+ long itime, long verbose);
+
+long boundariesV3D(modPar mod, bndPar bnd, float *vx, float *vy, float *vz,
+ float *tzz, float *tyy, float *txx, float *txz, float *txy, float *tyz,
+ float *rox, float *roy, float *roz, float *l2m, float *lam, float *mul,
+ long itime, long verbose);
+
+long acoustic4_3D(modPar mod, srcPar src, wavPar wav, bndPar bnd, long itime,
+ long ixsrc, long iysrc, long izsrc, float **src_nwav, float *vx, float *vy, float *vz,
+ float *p, float *rox, float *roy, float *roz, float *l2m, long verbose)
{
/*********************************************************************
COMPUTATIONAL OVERVIEW OF THE 4th ORDER STAGGERED GRID:
diff --git a/fdelmodc3D/acoustic4_qr.c b/fdelmodc3D/acoustic4_qr.c
deleted file mode 100644
index 53da61c36fb96d3f6b1131939a2851d186e0111f..0000000000000000000000000000000000000000
--- a/fdelmodc3D/acoustic4_qr.c
+++ /dev/null
@@ -1,281 +0,0 @@
-#include<stdlib.h>
-#include<stdio.h>
-#include<math.h>
-#include<assert.h>
-#include"fdelmodc.h"
-
-#define MIN(x,y) ((x) < (y) ? (x) : (y))
-
-int applySource(modPar mod, srcPar src, wavPar wav, bndPar bnd, int itime, int ixsrc, int izsrc, float *vx, float *vz, float *tzz, float *txx, float *txz, float *rox, float *roz, float *l2m, float **src_nwav, int verbose);
-
-int storeSourceOnSurface(modPar mod, srcPar src, bndPar bnd, int ixsrc, int izsrc, float *vx, float *vz, float *tzz, float *txx, float *txz, int verbose);
-
-int reStoreSourceOnSurface(modPar mod, srcPar src, bndPar bnd, int ixsrc, int izsrc, float *vx, float *vz, float *tzz, float *txx, float *txz, int verbose);
-
-int boundariesP(modPar mod, bndPar bnd, float *vx, float *vz, float *tzz, float *txx, float *txz, float *rox, float *roz, float *l2m, float *lam, float *mul, int itime, int verbose);
-
-int boundariesV(modPar mod, bndPar bnd, float *vx, float *vz, float *tzz, float *txx, float *txz, float *rox, float *roz, float *l2m, float *lam, float *mul, int itime, int verbose);
-
-int acoustic4_qr(modPar mod, srcPar src, wavPar wav, bndPar bnd, int itime, int ixsrc, int izsrc, float **src_nwav, float *vx, float *vz, float *p, float *rox, float *roz, float *l2m, int verbose)
-{
-/*********************************************************************
- COMPUTATIONAL OVERVIEW OF THE 4th ORDER STAGGERED GRID:
-
- The captial symbols T (=P) Txz,Vx,Vz represent the actual grid
- The indices ix,iz are related to the T grid, so the capital T
- symbols represent the actual modelled grid.
-
- one cel (iz,ix)
- |
- V extra column of vx,txz
- |
- ------- V
- | txz vz| txz vz txz vz txz vz txz vz txz vz txz
- | |
- | vx t | vx t vx t vx t vx t vx t vx
- -------
- txz vz txz vz txz vz txz vz txz vz txz vz txz
-
- vx t vx T---Vx--T---Vx--T---Vx--T vx t vx
- | | | | | | |
- txz vz txz Vz--Txz-Vz--Txz-Vz Txz-Vz txz vz txz
- | | | | | | |
- vx t vx T---Vx--T---Vx--T---Vx--T vx t vx
- | | | | | | |
- txz vz txz Vz Txz-Vz Txz-Vz Txz-Vz txz vz txz
- | | | | | | |
- vx t vx T---Vx--T---Vx--T---Vx--T vx t vx
- | | | | | | |
- txz vz txz Vz Txz-Vz Txz-Vz Txz-Vz txz vz txz
- | | | | | | |
- vx t vx T---Vx--T---Vx--T---Vx--T vx t vx
-
- txz vz txz vz txz vz txz vz txz vz txz vz txz
-
- vx t vx t vx t vx t vx t vx t vx
-
- txz vz txz vz txz vz txz vz txz vz txz vz txz <--|
- |
- extra row of txz/vz |
-
- AUTHOR:
- Jan Thorbecke (janth@xs4all.nl)
- The Netherlands
-
-***********************************************************************/
-
- float c1, c2, *timep;
- int ix, iz, ib;
- int nx, nz, n1;
- int ioXx, ioXz, ioZz, ioZx, ioPx, ioPz, ioTx, ioTz;
- int ieXx, ieXz, ieZz, ieZx, iePx, iePz, ieTx, ieTz;
-
- c1 = 9.0/8.0;
- c2 = -1.0/24.0;
- nx = mod.nx;
- nz = mod.nz;
- n1 = mod.naz;
-
- timep=(float *) malloc(n1*sizeof(float));
-
- /* Vx: rox */
- ioXx=mod.iorder/2;
- ioXz=mod.iorder/2-1;
- /* Vz: roz */
- ioZx=mod.iorder/2-1;
- ioZz=mod.iorder/2;
- /* P, Txx, Tzz: lam, l2m */
- ioPx=mod.iorder/2-1;
- ioPz=ioPx;
- /* Txz: mul */
- ioTx=mod.iorder/2;
- ioTz=ioTx;
-
- /* Vx: rox */
- ieXx=nx+ioXx;
- ieXz=nz+ioXz;
- /* Vz: roz */
- ieZx=nx+ioZx;
- ieZz=nz+ioZz;
- /* P, Txx, Tzz: lam, l2m */
- iePx=nx+ioPx;
- iePz=nz+ioPz;
- /* Txz: muu */
- ieTx=nx+ioTx;
- ieTz=nz+ioTz;
-
- if (bnd.top==4 || bnd.top==2) {
- ieXz += bnd.ntap;
- ieZz += bnd.ntap;
- iePz += bnd.ntap;
- ieTz += bnd.ntap;
- }
- if (bnd.bot==4 || bnd.bot==2) {
- ieXz += bnd.ntap;
- ieZz += bnd.ntap;
- iePz += bnd.ntap;
- ieTz += bnd.ntap;
- }
- if (bnd.lef==4 || bnd.lef==2) {
- ieXx += bnd.ntap;
- ieZx += bnd.ntap;
- iePx += bnd.ntap;
- ieTx += bnd.ntap;
- }
- if (bnd.rig==4 || bnd.rig==2) {
- ieXx += bnd.ntap;
- ieZx += bnd.ntap;
- iePx += bnd.ntap;
- ieTx += bnd.ntap;
- }
-
-
- if (itime == 0) {
- fprintf(stderr,"ioXx=%d ieXx=%d\n", ioXx, ieXx);
- fprintf(stderr,"ioZx=%d ieZx=%d\n", ioZx, ieZx);
- fprintf(stderr,"ioPx=%d iePx=%d\n", ioPx, iePx);
- fprintf(stderr,"ioTx=%d ieTx=%d\n", ioTx, ieTx);
-
- fprintf(stderr,"ioXz=%d ieXz=%d\n", ioXz, ieXz);
- fprintf(stderr,"ioZz=%d ieZz=%d\n", ioZz, ieZz);
- fprintf(stderr,"ioPz=%d iePz=%d\n", ioPz, iePz);
- fprintf(stderr,"ioTz=%d ieTz=%d\n", ioTz, ieTz);
- }
-
- /* calculate vx for all grid points except on the virtual boundary*/
-#pragma omp for private (ix, iz) nowait
- for (ix=ioXx; ix<ieXx; ix++) {
- for (iz=ioXz; iz<ieXz; iz++) {
- timep[iz] = vx[ix*n1+iz];
- }
-#pragma ivdep
- for (iz=ioXz; iz<ieXz; iz++) {
- vx[ix*n1+iz] -= rox[ix*n1+iz]*(
- c1*(p[ix*n1+iz] - p[(ix-1)*n1+iz]) +
- c2*(p[(ix+1)*n1+iz] - p[(ix-2)*n1+iz]));
- }
- for (iz=ioXz; iz<ieXz; iz++) {
- vx[ix*n1+iz] += 0.5*(vx[ix*n1+iz]+timep[iz])*mod.qr;
- }
- }
-
- /* calculate vz for all grid points except on the virtual boundary */
-#pragma omp for private (ix, iz)
- for (ix=ioZx; ix<ieZx; ix++) {
- for (iz=ioZz; iz<ieZz; iz++) {
- timep[iz] = vz[ix*n1+iz];
- }
-#pragma ivdep
- for (iz=ioZz; iz<ieZz; iz++) {
- //timep = vz[ix*n1+iz];
- vz[ix*n1+iz] -= roz[ix*n1+iz]*(
- c1*(p[ix*n1+iz] - p[ix*n1+iz-1]) +
- c2*(p[ix*n1+iz+1] - p[ix*n1+iz-2]));
- //vz[ix*n1+iz] += 0.5*(vz[ix*n1+iz]+timep)*mod.qr;
- }
- for (iz=ioZz; iz<ieZz; iz++) {
- vz[ix*n1+iz] += 0.5*(vz[ix*n1+iz]+timep[iz])*mod.qr;
- }
- }
-
- /* Add force source */
- if (src.type > 5) {
- applySource(mod, src, wav, bnd, itime, ixsrc, izsrc, vx, vz, p, NULL, NULL, rox, roz, l2m, src_nwav, verbose);
- }
-
- /* boundary condition clears velocities on boundaries */
- //boundariesP(mod, bnd, vx, vz, p, NULL, NULL, rox, roz, l2m, NULL, NULL, itime, verbose);
-
-//Tapering top bottom
-#pragma omp for private(ix,iz)
- for (ix=ioXx; ix<ieXx; ix++) {
- ib = (bnd.ntap+ioXz-1);
- for (iz=ioXz; iz<ioXz+bnd.ntap; iz++) {
- vx[ix*n1+iz] *= bnd.tapx[ib-iz];
- }
- ib = (ieXz-bnd.ntap);
- for (iz=ib; iz<ieXz; iz++) {
- vx[ix*n1+iz] *= bnd.tapx[iz-ib];
- }
- }
-#pragma omp for private(ix,iz)
- for (ix=ioZx; ix<ieZx; ix++) {
- ib = (bnd.ntap+ioZz-1);
- for (iz=ioZz; iz<ioZz+bnd.ntap; iz++) {
- vz[ix*n1+iz] *= bnd.tapz[ib-iz];
- }
- ib = (ieZz-bnd.ntap);
- for (iz=ib; iz<ieZz; iz++) {
- vz[ix*n1+iz] *= bnd.tapz[iz-ib];
- }
- }
-
-//Tapering left
- ib = (bnd.ntap+ioXx-1);
- for (ix=ioXx; ix<ioXx+bnd.ntap; ix++) {
- for (iz=ioXz; iz<ieXz; iz++) {
- vx[ix*n1+iz] *= bnd.tapx[ib-ix];
- }
- }
- ib = (bnd.ntap+ioZx-1);
- for (ix=ioZx; ix<ioZx+bnd.ntap; ix++) {
- for (iz=ioZz; iz<ieZz; iz++) {
- vz[ix*n1+iz] *= bnd.tapz[ib-ix];
- }
- }
-
-//Tapering right
- ib = (ieXx-bnd.ntap);
- for (ix=ib; ix<ieXx; ix++) {
- for (iz=ioXz; iz<ieXz; iz++) {
- vx[ix*n1+iz] *= bnd.tapx[ix-ib];
- }
- }
- ib = (ieZx-bnd.ntap);
- for (ix=ib; ix<ieZx; ix++) {
- for (iz=ioZz; iz<ieZz; iz++) {
- vz[ix*n1+iz] *= bnd.tapz[ix-ib];
- }
- }
-
- /* calculate p/tzz for all grid points except on the virtual boundary */
-#pragma omp for private (ix, iz)
-#pragma ivdep
- for (ix=ioPx; ix<iePx; ix++) {
- for (iz=ioXz; iz<ieXz; iz++) {
- timep[iz] = p[ix*n1+iz];
- }
-#pragma ivdep
- for (iz=ioPz; iz<iePz; iz++) {
- p[ix*n1+iz] -= l2m[ix*n1+iz]*(
- c1*(vx[(ix+1)*n1+iz] - vx[ix*n1+iz]) +
- c2*(vx[(ix+2)*n1+iz] - vx[(ix-1)*n1+iz]) +
- c1*(vz[ix*n1+iz+1] - vz[ix*n1+iz]) +
- c2*(vz[ix*n1+iz+2] - vz[ix*n1+iz-1]));
- //p[ix*n1+iz] += 0.5*(p[ix*n1+iz]+timep)*mod.qr;
- }
- for (iz=ioXz; iz<ieXz; iz++) {
- p[ix*n1+iz] += 0.5*(p[ix*n1+iz]+timep[iz])*mod.qr;
- }
- }
-
- /* Add stress source */
- if (src.type < 6) {
- applySource(mod, src, wav, bnd, itime, ixsrc, izsrc, vx, vz, p, NULL, NULL, rox, roz, l2m, src_nwav, verbose);
- }
-
-/* Free surface: calculate free surface conditions for stresses */
-
- /* check if there are sources placed on the free surface */
- storeSourceOnSurface(mod, src, bnd, ixsrc, izsrc, vx, vz, p, NULL, NULL, verbose);
-
- /* Free surface: calculate free surface conditions for stresses */
- //boundariesV(mod, bnd, vx, vz, p, NULL, NULL, rox, roz, l2m, NULL, NULL, itime, verbose);
-
- /* restore source positions on the edge */
- reStoreSourceOnSurface(mod, src, bnd, ixsrc, izsrc, vx, vz, p, NULL, NULL, verbose);
-
- free(timep);
-
- return 0;
-}
diff --git a/fdelmodc3D/acoustic6.c b/fdelmodc3D/acoustic6.c
deleted file mode 100644
index b1204fd44512faa816ef0eac7a6983df0158c6d7..0000000000000000000000000000000000000000
--- a/fdelmodc3D/acoustic6.c
+++ /dev/null
@@ -1,148 +0,0 @@
-#include<stdlib.h>
-#include<stdio.h>
-#include<math.h>
-#include<assert.h>
-#include"fdelmodc.h"
-
-int applySource(modPar mod, srcPar src, wavPar wav, bndPar bnd, int itime, int ixsrc, int izsrc, float *vx, float *vz, float *tzz, float *txx, float *txz, float *rox, float *roz, float *l2m, float **src_nwav, int verbose);
-
-int storeSourceOnSurface(modPar mod, srcPar src, bndPar bnd, int ixsrc, int izsrc, float *vx, float *vz, float *tzz, float *txx, float *txz, int verbose);
-
-int reStoreSourceOnSurface(modPar mod, srcPar src, bndPar bnd, int ixsrc, int izsrc, float *vx, float *vz, float *tzz, float *txx, float *txz, int verbose);
-
-int boundariesP(modPar mod, bndPar bnd, float *vx, float *vz, float *tzz, float *txx, float *txz, float *rox, float *roz, float *l2m, float *lam, float *mul, int itime, int verbose);
-
-int boundariesV(modPar mod, bndPar bnd, float *vx, float *vz, float *tzz, float *txx, float *txz, float *rox, float *roz, float *l2m, float *lam, float *mul, int itime, int verbose);
-
-int acoustic6(modPar mod, srcPar src, wavPar wav, bndPar bnd, int itime, int ixsrc, int izsrc, float **src_nwav, float *vx, float *vz, float *p, float *rox, float *roz, float *l2m, int verbose)
-{
-/*********************************************************************
- COMPUTATIONAL OVERVIEW OF THE 4th ORDER STAGGERED GRID:
-
- The captial symbols T (=Txx,Tzz) Txz,Vx,Vz represent the actual grid
- The indices ix,iz are related to the T grid, so the capital T
- symbols represent the actual modelled grid.
-
- one cel (iz,ix)
- |
- V extra column of vx,txz
- |
- ------- V
- | txz vz| txz vz txz vz txz vz txz vz txz vz txz
- | |
- | vx t | vx t vx t vx t vx t vx t vx
- -------
- txz vz txz vz txz vz txz vz txz vz txz vz txz
-
- vx t vx T---Vx--T---Vx--T---Vx--T vx t vx
- | | | | | | |
- txz vz txz Vz--Txz-Vz--Txz-Vz Txz-Vz txz vz txz
- | | | | | | |
- vx t vx T---Vx--T---Vx--T---Vx--T vx t vx
- | | | | | | |
- txz vz txz Vz Txz-Vz Txz-Vz Txz-Vz txz vz txz
- | | | | | | |
- vx t vx T---Vx--T---Vx--T---Vx--T vx t vx
- | | | | | | |
- txz vz txz Vz Txz-Vz Txz-Vz Txz-Vz txz vz txz
- | | | | | | |
- vx t vx T---Vx--T---Vx--T---Vx--T vx t vx
-
- txz vz txz vz txz vz txz vz txz vz txz vz txz
-
- vx t vx t vx t vx t vx t vx t vx
-
- txz vz txz vz txz vz txz vz txz vz txz vz txz <--|
- |
- extra row of txz/vz |
-
- AUTHOR:
- Jan Thorbecke (janth@xs4all.nl)
- The Netherlands
-
-***********************************************************************/
-
- float c1, c2, c3;
- int ix, iz;
- int n1;
- int ioXx, ioXz, ioZz, ioZx, ioPx, ioPz;
-
-
- c1 = 75.0/64.0;
- c2 = -25.0/384.0;
- c3 = 3.0/640.0;
- n1 = mod.naz;
-
- /* Vx: rox */
- ioXx=mod.iorder/2;
- ioXz=ioXx-1;
- /* Vz: roz */
- ioZz=mod.iorder/2;
- ioZx=ioZz-1;
- /* P, l2m */
- ioPx=mod.iorder/2-1;
- ioPz=ioPx;
-
- /* calculate vx for all grid points except on the virtual boundary*/
-#pragma omp for private (ix, iz) nowait
- for (ix=mod.ioXx; ix<mod.ieXx; ix++) {
-#pragma ivdep
- for (iz=mod.ioXz; iz<mod.ieXz; iz++) {
- vx[ix*n1+iz] -= rox[ix*n1+iz]*(
- c1*(p[ix*n1+iz] - p[(ix-1)*n1+iz]) +
- c2*(p[(ix+1)*n1+iz] - p[(ix-2)*n1+iz]) +
- c3*(p[(ix+2)*n1+iz] - p[(ix-3)*n1+iz]));
- }
- }
-
- /* calculate vz for all grid points except on the virtual boundary */
-#pragma omp for private (ix, iz)
- for (ix=mod.ioZx; ix<mod.ieZx; ix++) {
-#pragma ivdep
- for (iz=mod.ioZz; iz<mod.ieZz; iz++) {
- vz[ix*n1+iz] -= roz[ix*n1+iz]*(
- c1*(p[ix*n1+iz] - p[ix*n1+iz-1]) +
- c2*(p[ix*n1+iz+1] - p[ix*n1+iz-2]) +
- c3*(p[ix*n1+iz+2] - p[ix*n1+iz-3]));
- }
- }
-
- /* Add force source */
- if (src.type > 5) {
- applySource(mod, src, wav, bnd, itime, ixsrc, izsrc, vx, vz, p, NULL, NULL, rox, roz, l2m, src_nwav, verbose);
- }
-
- /* boundary condition clears velocities on boundaries */
- boundariesP(mod, bnd, vx, vz, p, NULL, NULL, rox, roz, l2m, NULL, NULL, itime, verbose);
-
- /* calculate p/tzz for all grid points except on the virtual boundary */
-#pragma omp for private (ix, iz)
- for (ix=mod.ioPx; ix<mod.iePx; ix++) {
-#pragma ivdep
- for (iz=mod.ioPz; iz<mod.iePz; iz++) {
- p[ix*n1+iz] -= l2m[ix*n1+iz]*(
- c1*(vx[(ix+1)*n1+iz] - vx[ix*n1+iz]) +
- c2*(vx[(ix+2)*n1+iz] - vx[(ix-1)*n1+iz]) +
- c3*(vx[(ix+3)*n1+iz] - vx[(ix-2)*n1+iz]) +
- c1*(vz[ix*n1+iz+1] - vz[ix*n1+iz]) +
- c2*(vz[ix*n1+iz+2] - vz[ix*n1+iz-1]) +
- c3*(vz[ix*n1+iz+3] - vz[ix*n1+iz-2]));
- }
- }
-
- /* Add stress source */
- if (src.type < 6) {
- applySource(mod, src, wav, bnd, itime, ixsrc, izsrc, vx, vz, p, NULL, NULL, rox, roz, l2m, src_nwav, verbose);
- }
-
- /* check if there are sources placed on the free surface */
- storeSourceOnSurface(mod, src, bnd, ixsrc, izsrc, vx, vz, p, NULL, NULL, verbose);
-
- /* Free surface: calculate free surface conditions for stresses */
- boundariesV(mod, bnd, vx, vz, p, NULL, NULL, rox, roz, l2m, NULL, NULL, itime, verbose);
-
- /* restore source positions on the edge */
- reStoreSourceOnSurface(mod, src, bnd, ixsrc, izsrc, vx, vz, p, NULL, NULL, verbose);
-
- return 0;
-}
diff --git a/fdelmodc3D/acousticSH4.c b/fdelmodc3D/acousticSH4.c
deleted file mode 100644
index 481de47568533c2f94e533f18aa1efd7b36a30c8..0000000000000000000000000000000000000000
--- a/fdelmodc3D/acousticSH4.c
+++ /dev/null
@@ -1,143 +0,0 @@
-#include<stdlib.h>
-#include<stdio.h>
-#include<math.h>
-#include<assert.h>
-#include"fdelmodc.h"
-
-int applySource(modPar mod, srcPar src, wavPar wav, bndPar bnd, int itime, int ixsrc, int izsrc, float *vx, float *vz, float *tzz, float *txx, float *txz, float *rox, float *roz, float *l2m, float **src_nwav, int verbose);
-
-int storeSourceOnSurface(modPar mod, srcPar src, bndPar bnd, int ixsrc, int izsrc, float *vx, float *vz, float *tzz, float *txx, float *txz, int verbose);
-
-int reStoreSourceOnSurface(modPar mod, srcPar src, bndPar bnd, int ixsrc, int izsrc, float *vx, float *vz, float *tzz, float *txx, float *txz, int verbose);
-
-int boundariesP(modPar mod, bndPar bnd, float *vx, float *vz, float *tzz, float *txx, float *txz, float *rox, float *roz, float *l2m, float *lam, float *mul, int itime, int verbose);
-
-int boundariesV(modPar mod, bndPar bnd, float *vx, float *vz, float *tzz, float *txx, float *txz, float *rox, float *roz, float *l2m, float *lam, float *mul, int itime, int verbose);
-
-int acousticSH4(modPar mod, srcPar src, wavPar wav, bndPar bnd, int itime, int ixsrc, int izsrc, float **src_nwav, float *tx, float *tz, float *vz, float *rox, float *roz, float *mul, int verbose)
-{
-/*********************************************************************
- COMPUTATIONAL OVERVIEW OF THE 4th ORDER STAGGERED GRID:
-
- The captial symbols T (=Txx,Tzz) Txz,Vx,Vz represent the actual grid
- The indices ix,iz are related to the T grid, so the capital T
- symbols represent the actual modelled grid.
-
- one cel (iz,ix)
- |
- V extra column of vx,txz
- |
- ------- V
- | txz vz| txz vz txz vz txz vz txz vz txz vz txz
- | |
- | vx t | vx t vx t vx t vx t vx t vx
- -------
- txz vz txz vz txz vz txz vz txz vz txz vz txz
-
- vx t vx T---Vx--T---Vx--T---Vx--T vx t vx
- | | | | | | |
- txz vz txz Vz--Txz-Vz--Txz-Vz Txz-Vz txz vz txz
- | | | | | | |
- vx t vx T---Vx--T---Vx--T---Vx--T vx t vx
- | | | | | | |
- txz vz txz Vz Txz-Vz Txz-Vz Txz-Vz txz vz txz
- | | | | | | |
- vx t vx T---Vx--T---Vx--T---Vx--T vx t vx
- | | | | | | |
- txz vz txz Vz Txz-Vz Txz-Vz Txz-Vz txz vz txz
- | | | | | | |
- vx t vx T---Vx--T---Vx--T---Vx--T vx t vx
-
- txz vz txz vz txz vz txz vz txz vz txz vz txz
-
- vx t vx t vx t vx t vx t vx t vx
-
- txz vz txz vz txz vz txz vz txz vz txz vz txz <--|
- |
- extra row of txz/vz |
-
- AUTHOR:
- Jan Thorbecke (janth@xs4all.nl)
- The Netherlands
-
-***********************************************************************/
-
- float c1, c2;
- int ix, iz;
- int n1;
- int ioXx, ioXz, ioZz, ioZx, ioPx, ioPz;
-
-
- c1 = 9.0/8.0;
- c2 = -1.0/24.0;
- n1 = mod.naz;
-
- ioXx=mod.iorder/2;
- ioXz=ioXx-1;
- ioZz=mod.iorder/2;
- ioZx=ioZz-1;
- ioPx=mod.iorder/2-1;
- ioPz=ioPx;
-
- /* calculate vx for all grid points except on the virtual boundary*/
-#pragma omp for private (ix, iz) nowait
- for (ix=mod.ioXx; ix<mod.ieXx; ix++) {
-#pragma ivdep
- for (iz=mod.ioXz; iz<mod.ieXz; iz++) {
- tx[ix*n1+iz] -= mul[ix*n1+iz]*(
- c1*(vz[ix*n1+iz] - vz[(ix-1)*n1+iz]) +
- c2*(vz[(ix+1)*n1+iz] - vz[(ix-2)*n1+iz]));
- }
- }
-
- /* calculate vz for all grid points except on the virtual boundary */
-#pragma omp for private (ix, iz)
- for (ix=mod.ioZx; ix<mod.ieZx; ix++) {
-#pragma ivdep
- for (iz=mod.ioZz; iz<mod.ieZz; iz++) {
- tz[ix*n1+iz] -= mul[ix*n1+iz]*(
- c1*(vz[ix*n1+iz] - vz[ix*n1+iz-1]) +
- c2*(vz[ix*n1+iz+1] - vz[ix*n1+iz-2]));
- }
- }
-
- /* Add force source */
- if (src.type > 5) {
- applySource(mod, src, wav, bnd, itime, ixsrc, izsrc, tx, tz, vz, NULL, NULL, rox, roz, mul, src_nwav, verbose);
- }
-
- /* boundary condition clears velocities on boundaries */
- boundariesP(mod, bnd, tx, tz, vz, NULL, NULL, rox, roz, mul, NULL, NULL, itime, verbose);
-
- /* calculate p/tzz for all grid points except on the virtual boundary */
-#pragma omp for private (ix, iz)
-#pragma ivdep
- for (ix=mod.ioPx; ix<mod.iePx; ix++) {
-#pragma ivdep
- for (iz=mod.ioPz; iz<mod.iePz; iz++) {
- vz[ix*n1+iz] -= rox[ix*n1+iz]*(
- c1*(tx[(ix+1)*n1+iz] - tx[ix*n1+iz]) +
- c2*(tx[(ix+2)*n1+iz] - tx[(ix-1)*n1+iz]) +
- c1*(tz[ix*n1+iz+1] - tz[ix*n1+iz]) +
- c2*(tz[ix*n1+iz+2] - tz[ix*n1+iz-1]));
- }
- }
-
- /* Add stress source */
- if (src.type < 6) {
- applySource(mod, src, wav, bnd, itime, ixsrc, izsrc, tx, tz, vz, NULL, NULL, rox, roz, mul, src_nwav, verbose);
- }
-
-/* Free surface: calculate free surface conditions for stresses */
-
- /* check if there are sources placed on the free surface */
- storeSourceOnSurface(mod, src, bnd, ixsrc, izsrc, tx, tz, vz, NULL, NULL, verbose);
-
- /* Free surface: calculate free surface conditions for stresses */
- boundariesV(mod, bnd, tx, tz, vz, NULL, NULL, rox, roz, mul, NULL, NULL, itime, verbose);
-
- /* restore source positions on the edge */
- reStoreSourceOnSurface(mod, src, bnd, ixsrc, izsrc, tx, tz, vz, NULL, NULL, verbose);
-
- return 0;
-}
diff --git a/fdelmodc3D/acousticSH4_routine.c b/fdelmodc3D/acousticSH4_routine.c
deleted file mode 100644
index 11513f467d89a26f22e7f69f81b1009fb21c17e0..0000000000000000000000000000000000000000
--- a/fdelmodc3D/acousticSH4_routine.c
+++ /dev/null
@@ -1,347 +0,0 @@
-#include<stdlib.h>
-#include<stdio.h>
-#include<math.h>
-#include<assert.h>
-
-int taperEdges(modPar mod, bndPar bnd, float *vx, float *vz, int verbose);
-
-int applySource(modPar mod, srcPar src, wavPar wav, bndPar bnd, int itime, int ixsrc, int izsrc, float *vx, float *vz, float *tzz, float *txx, float *txz, float *rox, float *l2m, float **src_nwav, int verbose);
-
-int acousticSH4_routine_(int *nxf, int *nzf, int *ldz, int *it0, int *it1, int *src_type, wavPar wav, bndPar bnd, int *ixsrc, int *izsrc, float **src_nwav, float *tx, float *tz, float *vz, float *ro, float *mul, int verbose);
-
-
-/*********************************************************************
- COMPUTATIONAL OVERVIEW OF THE 4th ORDER STAGGERED GRID:
-
- The captial symbols T (=Txx,Tzz) Txz,Vx,Vz represent the actual grid
- The indices ix,iz are related to the T grid, so the capital T
- symbols represent the actual modelled grid.
-
- one cel (iz,ix)
- |
- V extra column of vx,txz
- |
- ------- V
- | txz vz| txz vz txz vz txz vz txz vz txz vz txz
- | |
- | vx t | vx t vx t vx t vx t vx t vx
- -------
- txz vz txz vz txz vz txz vz txz vz txz vz txz
-
- vx t vx T---Vx--T---Vx--T---Vx--T vx t vx
- | | | | | | |
- txz vz txz Vz--Txz-Vz--Txz-Vz Txz-Vz txz vz txz
- | | | | | | |
- vx t vx T---Vx--T---Vx--T---Vx--T vx t vx
- | | | | | | |
- txz vz txz Vz Txz-Vz Txz-Vz Txz-Vz txz vz txz
- | | | | | | |
- vx t vx T---Vx--T---Vx--T---Vx--T vx t vx
- | | | | | | |
- txz vz txz Vz Txz-Vz Txz-Vz Txz-Vz txz vz txz
- | | | | | | |
- vx t vx T---Vx--T---Vx--T---Vx--T vx t vx
-
- txz vz txz vz txz vz txz vz txz vz txz vz txz
-
- vx t vx t vx t vx t vx t vx t vx
-
- txz vz txz vz txz vz txz vz txz vz txz vz txz <--|
- |
- extra row of txz/vz |
-
- AUTHOR:
- Jan Thorbecke (janth@xs4all.nl)
- The Netherlands
-
- ***********************************************************************/
-
-int main(int argc, char **argv)
-{
-
-}
-
-int acousticSH4_routine_(int *nxf, int *nzf, int *ldz, int *it0, int *it1, int *src_type, wavPar wav, bndPar bnd, int *ixsrc, int *izsrc, float **src_nwav, float *tx, float *tz, float *vz, float *ro, float *mul, int verbose)
-{
-
- float c1, c2;
- float *tmps;
- int ix, iz, ixs, izs, ibnd, store;
- int nx, nz, n1;
- int is0, isrc, ioXx, ioXz, ioZz, ioZx, ioPx, ioPz;
-
-
- c1 = 9.0/8.0;
- c2 = -1.0/24.0;
- nx = *nxf;
- nz = *nzf;
- n1 = *ldz;
-
- ibnd = 1;
-
- ioXx=2;
- ioXz=ioXx-1;
- ioZz=2;
- ioZx=ioZz-1;
- ioPx=1;
- ioPz=ioPx;
-
-#pragma omp parallel default (shared) \
-shared (ro, mul, tx, tz, vz) \
-shared (*it0, *it1, c1, c2) \
-shared (shot, bnd, mod, src, wav, rec, ixsrc, izsrc, it, src_nwav, verbose)
-{
- /* Main loop over the number of time steps */
- for (it=*it0; it<*it1; it++) {
-
-
-
- /* calculate vx for all grid points except on the virtual boundary*/
-#pragma omp for private (ix, iz) nowait
- for (ix=ioXx; ix<nx+1; ix++) {
-#pragma ivdep
- for (iz=ioXz; iz<nz+1; iz++) {
- tx[ix*n1+iz] -= mul[ix*n1+iz]*(
- c1*(vz[ix*n1+iz] - vz[(ix-1)*n1+iz]) +
- c2*(vz[(ix+1)*n1+iz] - vz[(ix-2)*n1+iz]));
- }
- }
-
- /* calculate vz for all grid points except on the virtual boundary */
-#pragma omp for private (ix, iz)
- for (ix=ioZx; ix<nx+1; ix++) {
-#pragma ivdep
- for (iz=ioZz; iz<nz+1; iz++) {
- tz[ix*n1+iz] -= mul[ix*n1+iz]*(
- c1*(vz[ix*n1+iz] - vz[ix*n1+iz-1]) +
- c2*(vz[ix*n1+iz+1] - vz[ix*n1+iz-2]));
- }
- }
-
- /* Add force source */
- if (src.type > 5) {
- applySource(mod, src, wav, bnd, itime, ixsrc, izsrc, tx, tz, vz, NULL, NULL, ro, mul, src_nwav, verbose);
- }
-
-
- /* calculate p/tzz for all grid points except on the virtual boundary */
-#pragma omp for private (ix, iz)
-#pragma ivdep
- for (ix=ioPx; ix<nx+1; ix++) {
-#pragma ivdep
- for (iz=ioPz; iz<nz+1; iz++) {
- vz[ix*n1+iz] -= ro[ix*n1+iz]*(
- c1*(tx[(ix+1)*n1+iz] - tx[ix*n1+iz]) +
- c2*(tx[(ix+2)*n1+iz] - tx[(ix-1)*n1+iz]) +
- c1*(tz[ix*n1+iz+1] - tz[ix*n1+iz]) +
- c2*(tz[ix*n1+iz+2] - tz[ix*n1+iz-1]));
- }
- }
-
- /* Add stress source */
- if (src.type < 6) {
- applySource(mod, src, wav, bnd, itime, *ixsrc, *izsrc, tx, tz, vz, NULL, NULL, ro, mul, src_nwav, verbose);
- }
-
-/* Free surface: calculate free surface conditions for stresses */
-
- /* check if there are sources placed on the free surface */
- store=0;
- if (src.type==1 || src.type==6) {
- tmps = (float *)calloc(1, sizeof(float));
- is0 = -1*floor((src.n-1)/2);
- isrc=0;
- /* calculate the source position */
- ixs = *ixsrc + ibnd + is0 + isrc;
- izs = *izsrc + ibnd;
- if (ixs == 1) store=1;
- if (ixs == nx) store=1;
- if (izs == 1) store=1;
- if (izs == nz) store=1;
- if (store) {
- if (src.type==1) tmps[isrc] = vz[ixs*n1+izs];
- else tmps[isrc] = tx[ixs*n1+izs];
- }
-
- }
-
- if (bnd.free[0]) { /* free surface at top */
-#pragma omp for private (ix) nowait
- for (ix=1; ix<=nx; ix++) {
- iz = bnd.surface[ix-1];
- vz[ix*n1+iz] = 0.0;
- }
- }
- if (bnd.free[1]) { /* free surface at right */
-#pragma omp for private (iz) nowait
- for (iz=1; iz<=nz; iz++) {
- vz[nx*n1+iz] = 0.0;
- }
- }
- if (bnd.free[2]) { /* free surface at bottom */
-#pragma omp for private (ix) nowait
- for (ix=1; ix<=nx; ix++) {
- vz[ix*n1+nz] = 0.0;
- }
- }
- if (bnd.free[3]) { /* free surface at left */
-#pragma omp for private (iz) nowait
- for (iz=1; iz<=nz; iz++) {
- vz[n1+iz] = 0.0;
- }
- }
-
- /* restore source positions on the edge */
- if (src.type==1 || src.type==6) {
- if (store) {
-#pragma omp for private (isrc)
- for (isrc=0; isrc<src.n; isrc++) {
- /* calculate the source position */
- ixs = *ixsrc + ibnd + is0 + isrc;
- izs = *izsrc + ibnd;
- if (src.type==1) vz[ixs*n1+izs] += tmps[isrc];
- else tx[ixs*n1+izs] += tmps[isrc];
- }
- }
- free(tmps);
- }
-
- /* taper the edges of the model */
- taperEdges(mod, bnd, vx, vz, verbose);
-
- } /*end of time loop */
-} /* end of OMP parallel */
-
- return 0;
-}
-
-
-
-int applySource(modPar mod, srcPar src, wavPar wav, bndPar bnd, int itime, int ixsrc, int izsrc, float *vx, float *vz, float *tzz, float *txx, float *txz, float *ro, float *l2m, float **src_nwav, int verbose)
-{
- int is0, ibndz, ibndx;
- int isrc, ix, iz, n1;
- int id1, id2;
- float src_ampl, time, scl, dt;
- static int first=1;
-
- else if (src_type==7) {
- ibndz = mod.iorder/2;
- ibndx = mod.iorder/2-1;
- }
- else {
- ibndz = mod.iorder/2-1;
- ibndx = mod.iorder/2-1;
- }
-
- n1 = mod.naz;
- dt = mod.dt;
-
-#pragma omp for private (isrc, src_ampl, ix, iz, time, id1, id2, scl)
- src_ampl=0.0;
- ix = ixsrc + ibndx;
- iz = izsrc + ibndz;
- time = itime*dt - src.tbeg[isrc];
- id1 = floor(time/dt);
- id2 = id1+1;
-
- /* delay not reached or no samples left in source wavelet? */
- if ( (time < 0.0) || ( (itime*dt) >= src.tend[isrc]) ) continue;
-
- src_ampl = src_nwav[0][id1]*(id2-time/dt) + src_nwav[0][id2]*(time/dt-id1);
-
- if (src_ampl==0.0) continue;
-
- if ( ((ix-ibndx)<0) || ((ix-ibndx)>mod.nx) ) continue; /* source outside grid */
-
- /* source scaling factor to compensate for discretisation */
-
- src_ampl *= (1.0/mod.dx)*l2m[ix*n1+iz];
-
- /* Force source */
-
- if (src.type == 7) {
- vz[ix*n1+iz] += src_ampl*ro[ix*n1+iz]/(l2m[ix*n1+iz]);
- }
- else if (src.type == 2) {
- txz[ix*n1+iz] += src_ampl;
- }
- /* Tzz source */
- else if(src.type == 3) {
- tzz[ix*n1+iz] += src_ampl;
- }
-
- return 0;
-}
-
-
-
-int taperEdges(modPar mod, bndPar bnd, float *vx, float *vz, int verbose)
-{
- int ix, iz, ibnd, ib, ntaper;
- int nx, nz, n1;
-
- nx = mod.nx;
- nz = mod.nz;
- n1 = mod.naz;
- ibnd = mod.iorder/2-1;
-
- /* top */
- if (bnd.tap[0] > 0) {
- ntaper = bnd.tap[0];
- ib = (ntaper+ibnd-1);
-#pragma omp for private(ix,iz)
- for (ix=ibnd; ix<nx+ibnd; ix++) {
-#pragma ivdep
- for (iz=ibnd; iz<ibnd+ntaper; iz++) {
- vx[ix*n1+iz] *= bnd.tapx[ib-iz];
- vz[ix*n1+iz+1] *= bnd.tapz[ib-iz];
- }
- }
- }
- /* right */
- if (bnd.tap[1] > 0) {
- ntaper = bnd.tap[1];
- ib = (nx+ibnd-ntaper);
-#pragma omp for private(ix,iz)
- for (ix=nx+ibnd-ntaper; ix<nx+ibnd; ix++) {
-#pragma ivdep
- for (iz=ibnd; iz<nz+ibnd; iz++) {
- vx[ix*n1+iz] *= bnd.tapx[ix-ib];
- vz[ix*n1+iz] *= bnd.tapz[ix-ib];
- }
- }
- }
- /* bottom */
- if (bnd.tap[2] > 0) {
- ntaper = bnd.tap[2];
- ib = (nz+ibnd-ntaper);
-#pragma omp for private(ix,iz)
- for (ix=ibnd; ix<nx+ibnd; ix++) {
-#pragma ivdep
- for (iz=nz+ibnd-ntaper; iz<nz+ibnd; iz++) {
- vx[ix*n1+iz] *= bnd.tapx[iz-ib];
- vz[ix*n1+iz+1] *= bnd.tapz[iz-ib];
- }
- }
- }
- /* left */
- if (bnd.tap[3] > 0) {
- ntaper = bnd.tap[3];
- ib = (ntaper+ibnd-1);
-#pragma omp for private(ix,iz)
- for (ix=ibnd; ix<ntaper+ibnd; ix++) {
-#pragma ivdep
- for (iz=ibnd; iz<nz+ibnd; iz++) {
- vx[ix*n1+iz] *= bnd.tapx[ib-ix];
- vz[ix*n1+iz] *= bnd.tapz[ib-ix];
- }
- }
- }
-
- return 0;
-}
-
-
-
-
diff --git a/fdelmodc3D/applySource.c b/fdelmodc3D/applySource.c
deleted file mode 100644
index bf0d38e5ec0551265d07cfa81855b570f1a80020..0000000000000000000000000000000000000000
--- a/fdelmodc3D/applySource.c
+++ /dev/null
@@ -1,343 +0,0 @@
-#include<stdlib.h>
-#include<stdio.h>
-#include<math.h>
-#include<assert.h>
-#include"fdelmodc.h"
-
-void vmess(char *fmt, ...);
-
-#define c1 (9.0/8.0)
-#define c2 (-1.0/24.0)
-
-/*********************************************************************
- *
- * Add's the source amplitude(s) to the grid.
- *
- * For the acoustic schemes, the source-type must not be txx tzz or txz.
- *
- * AUTHOR:
- * Jan Thorbecke (janth@xs4all.nl)
- * The Netherlands
- *
- **********************************************************************/
-
-int applySource(modPar mod, srcPar src, wavPar wav, bndPar bnd, int itime, int ixsrc, int izsrc, float *vx, float *vz, float *tzz, float *txx, float *txz, float *rox, float *roz, float *l2m, float **src_nwav, int verbose)
-{
- int is0, ibndz, ibndx;
- int isrc, ix, iz, n1;
- int id1, id2;
- float src_ampl, time, scl, dt, sdx;
- float Mxx, Mzz, Mxz, rake;
- static int first=1;
-
- if (src.type==6) {
- ibndz = mod.ioXz;
- ibndx = mod.ioXx;
- }
- else if (src.type==7) {
- ibndz = mod.ioZz;
- ibndx = mod.ioZx;
- }
- else if (src.type==2) {
- ibndz = mod.ioTz;
- ibndx = mod.ioTx;
- if (bnd.lef==4 || bnd.lef==2) ibndx += bnd.ntap;
- if (bnd.top==4 || bnd.top==2) ibndz += bnd.ntap;
- }
- else {
- ibndz = mod.ioPz;
- ibndx = mod.ioPx;
- if (bnd.lef==4 || bnd.lef==2) ibndx += bnd.ntap;
- if (bnd.top==4 || bnd.top==2) ibndz += bnd.ntap;
- }
-
- n1 = mod.naz;
- dt = mod.dt;
- sdx = 1.0/mod.dx;
-
- /* special txz source activated? */
-
- if ((bnd.top==1) && (src.type==2)) {
- iz = izsrc + ibndz;
- if (iz==ibndz) {
- if (src.orient != 1) {
- if (first) {
- vmess("Only monopole Txz source allowed at surface. Reset to monopole");
- first = 0;
- }
- src.orient=1;
- }
- }
- }
-
-/*
-* for plane wave sources the sources are placed
-* around the central shot position
-* the first source position has an offset in x of is0
-*
-* itime = 0 corresponds with time=0
-* itime = 1 corresponds with time=dt
-* src[0] (the first sample) corresponds with time = 0
-*/
-
- is0 = -1*floor((src.n-1)/2);
-#pragma omp for private (isrc, src_ampl, ix, iz, time, id1, id2, scl)
- for (isrc=0; isrc<src.n; isrc++) {
- src_ampl=0.0;
- /* calculate the source position */
- if (src.random || src.multiwav) {
- ix = src.x[isrc] + ibndx;
- iz = src.z[isrc] + ibndz;
- }
- else { /* plane wave and point sources */
- ix = ixsrc + ibndx + is0 + isrc;
- iz = izsrc + ibndz;
- }
- time = itime*dt - src.tbeg[isrc];
- id1 = floor(time/dt);
- id2 = id1+1;
-
- /* delay not reached or no samples left in source wavelet? */
- if ( (time < 0.0) || ( (itime*dt) >= src.tend[isrc]) ) continue;
-
-// fprintf(stderr,"isrc=%d ix=%d iz=%d src.x=%d src.z=%d\n", isrc, ix, iz, src.x[isrc], src.z[isrc]);
-
- if (!src.multiwav) { /* only one wavelet for all sources */
- src_ampl = src_nwav[0][id1]*(id2-time/dt) + src_nwav[0][id2]*(time/dt-id1);
- }
- else { /* multi-wavelet sources */
- src_ampl = src_nwav[isrc][id1]*(id2-time/dt) + src_nwav[isrc][id2]*(time/dt-id1);
- }
-
- if (src_ampl==0.0) continue;
- if ( ((ix-ibndx)<0) || ((ix-ibndx)>mod.nx) ) continue; /* source outside grid */
-
- if (verbose>=4 && itime==0) {
- vmess("Source %d positioned at grid ix=%d iz=%d",isrc, ix, iz);
- }
-
- /* cosine squared windowing to reduce edge effects on shot arrays */
- if ( (src.n>1) && src.window) {
- scl = 1.0;
- if (isrc < src.window) {
- scl = cos(0.5*M_PI*(src.window - isrc)/src.window);
- }
- else if (isrc > src.n-src.window+1) {
- scl = cos(0.5*M_PI*(src.window - (src.n-isrc+1))/src.window);
- }
- src_ampl *= scl*scl;
- }
-
- /* source scaling factor to compensate for discretisation */
-
- /* old amplitude setting does not obey reciprocity */
- // src_ampl *= rox[ix*n1+iz]*l2m[ix*n1+iz]/(dt);
-
-/* in older version added factor 2.0 to be compliant with defined Green's functions in Marchenko algorithm */
-/* this is now set to 1.0 */
- src_ampl *= (1.0/mod.dx)*l2m[ix*n1+iz];
-
- if (verbose>5) {
- vmess("Source %d at grid [ix=%d,iz=%d] at itime %d has value %e",isrc, ix,iz, itime, src_ampl);
- }
-
- /* Force source */
-
- if (src.type == 6) {
- vx[ix*n1+iz] += src_ampl*rox[ix*n1+iz]/(l2m[ix*n1+iz]);
- /* stable implementation from "Numerical Techniques for Conservation Laws with Source Terms" by Justin Hudson */
- //vx[ix*n1+iz] = 0.5*(vx[(ix+1)*n1+iz]+vx[(ix-1)*n1+iz])+src_ampl*rox[ix*n1+iz]/(l2m[ix*n1+iz]);
- }
- else if (src.type == 7) {
- vz[ix*n1+iz] += src_ampl*roz[ix*n1+iz]/(l2m[ix*n1+iz]);
- /* stable implementation from "Numerical Techniques for Conservation Laws with Source Terms" by Justin Hudson */
- /* stable implementation changes amplitude and more work is needed */
- //vz[ix*n1+iz] = 0.5*(vz[ix*n1+iz-1]+vz[ix*n1+iz+1])+src_ampl*roz[ix*n1+iz]/(l2m[ix*n1+iz]);
- //vz[ix*n1+iz] = 0.25*(vz[ix*n1+iz-2]+vz[ix*n1+iz-1]+vz[ix*n1+iz]+vz[ix*n1+iz+1])+src_ampl*roz[ix*n1+iz]/(l2m[ix*n1+iz]);
- } /* src.type */
-
-
- /* Stress source */
-
- if (mod.ischeme <= 2) { /* Acoustic scheme */
- /* Compressional source */
- if (src.type == 1) {
- if (src.orient != 1) src_ampl=src_ampl/mod.dx;
-
- if (src.orient==1) { /* monopole */
- tzz[ix*n1+iz] += src_ampl;
- }
- else if (src.orient==2) { /* dipole +/- */
- tzz[ix*n1+iz] += src_ampl;
- tzz[ix*n1+iz+1] -= src_ampl;
- }
- else if (src.orient==3) { /* dipole - + */
- tzz[ix*n1+iz] += src_ampl;
- tzz[(ix-1)*n1+iz] -= src_ampl;
- }
- else if (src.orient==4) { /* dipole +/0/- */
- if (iz > ibndz)
- tzz[ix*n1+iz-1]+= 0.5*src_ampl;
- if (iz < mod.nz+ibndz-1)
- tzz[ix*n1+iz+1] -= 0.5*src_ampl;
- }
- else if (src.orient==5) { /* dipole + - */
- tzz[ix*n1+iz] += src_ampl;
- tzz[(ix+1)*n1+iz] -= src_ampl;
- }
- }
- }
- else { /* Elastic scheme */
- /* Compressional source */
- if (src.type == 1) {
- if (src.orient==1) { /* monopole */
- txx[ix*n1+iz] += src_ampl;
- tzz[ix*n1+iz] += src_ampl;
- }
- else if (src.orient==2) { /* dipole +/- */
- txx[ix*n1+iz] += src_ampl;
- tzz[ix*n1+iz] += src_ampl;
- txx[ix*n1+iz+1] -= src_ampl;
- tzz[ix*n1+iz+1] -= src_ampl;
- }
- else if (src.orient==3) { /* dipole - + */
- txx[ix*n1+iz] += src_ampl;
- tzz[ix*n1+iz] += src_ampl;
- txx[(ix-1)*n1+iz] -= src_ampl;
- tzz[(ix-1)*n1+iz] -= src_ampl;
- }
- else if (src.orient==4) { /* dipole +/0/- */
- if (iz > ibndz) {
- txx[ix*n1+iz-1]+= 0.5*src_ampl;
- tzz[ix*n1+iz-1]+= 0.5*src_ampl;
- }
- if (iz < mod.nz+ibndz-1) {
- txx[ix*n1+iz+1] -= 0.5*src_ampl;
- tzz[ix*n1+iz+1] -= 0.5*src_ampl;
- }
- }
- else if (src.orient==5) { /* dipole + - */
- txx[ix*n1+iz] += src_ampl;
- tzz[ix*n1+iz] += src_ampl;
- txx[(ix+1)*n1+iz] -= src_ampl;
- tzz[(ix+1)*n1+iz] -= src_ampl;
- }
- }
- else if (src.type == 2) {
- /* Txz source */
- if ((iz == ibndz) && bnd.top==1) {
- txz[(ix-1)*n1+iz-1] += src_ampl;
- txz[ix*n1+iz-1] += src_ampl;
- }
- else {
- txz[ix*n1+iz] += src_ampl;
- }
- /* possible dipole orientations for a txz source */
- if (src.orient == 2) { /* dipole +/- */
- txz[ix*n1+iz+1] -= src_ampl;
- }
- else if (src.orient == 3) { /* dipole - + */
- txz[(ix-1)*n1+iz] -= src_ampl;
- }
- else if (src.orient == 4) { /* dipole +/O/- */
- /* correction: subtrace previous value to prevent z-1 values. */
- txz[ix*n1+iz] -= 2.0*src_ampl;
- txz[ix*n1+iz+1] += src_ampl;
- }
- else if (src.orient == 5) { /* dipole + - */
- txz[(ix+1)*n1+iz] -= src_ampl;
- }
- }
- /* Tzz source */
- else if(src.type == 3) {
- tzz[ix*n1+iz] += src_ampl;
- }
- /* Txx source */
- else if(src.type == 4) {
- txx[ix*n1+iz] += src_ampl;
- }
-
-/***********************************************************************
-* pure potential shear S source (experimental)
-* Curl S-pot = CURL(F) = dF_x/dz - dF_z/dx
-***********************************************************************/
- else if(src.type == 5) {
- src_ampl = src_ampl*rox[ix*n1+iz]/(l2m[ix*n1+iz]);
- if (src.orient == 3) src_ampl = -src_ampl;
- /* first order derivatives */
- vx[ix*n1+iz] += src_ampl*sdx;
- vx[ix*n1+iz-1] -= src_ampl*sdx;
- vz[ix*n1+iz] -= src_ampl*sdx;
- vz[(ix-1)*n1+iz] += src_ampl*sdx;
-
- /* second order derivatives */
- /*
- vx[ix*n1+iz] += c1*src_ampl*sdx;
- vx[ix*n1+iz-1] -= c1*src_ampl*sdx;
- vx[ix*n1+iz+1] += c2*src_ampl*sdx;
- vx[ix*n1+iz-2] -= c2*src_ampl*sdx;
-
- vz[ix*n1+iz] -= c1*src_ampl*sdx;
- vz[(ix-1)*n1+iz] += c1*src_ampl*sdx;
- vz[(ix+1)*n1+iz] -= c2*src_ampl*sdx;
- vz[(ix-2)*n1+iz] += c2*src_ampl*sdx;
- */
-
- /* determine second position of dipole */
- if (src.orient == 2) { /* dipole +/- vertical */
- iz += 1;
- vx[ix*n1+iz] -= src_ampl*sdx;
- vx[ix*n1+iz-1] += src_ampl*sdx;
- vz[ix*n1+iz] += src_ampl*sdx;
- vz[(ix-1)*n1+iz] -= src_ampl*sdx;
- }
- else if (src.orient == 3) { /* dipole - + horizontal */
- ix += 1;
- vx[ix*n1+iz] -= src_ampl*sdx;
- vx[ix*n1+iz-1] += src_ampl*sdx;
- vz[ix*n1+iz] += src_ampl*sdx;
- vz[(ix-1)*n1+iz] -= src_ampl*sdx;
- }
- }
-/***********************************************************************
-* pure potential pressure P source (experimental)
-* Divergence P-pot = DIV(F) = dF_x/dx + dF_z/dz
-***********************************************************************/
- else if(src.type == 8) {
- src_ampl = src_ampl*rox[ix*n1+iz]/(l2m[ix*n1+iz]);
- if (src.orient == 3) src_ampl = -src_ampl;
- vx[(ix+1)*n1+iz] += src_ampl*sdx;
- vx[ix*n1+iz] -= src_ampl*sdx;
- vz[ix*n1+iz+1] += src_ampl*sdx;
- vz[ix*n1+iz] -= src_ampl*sdx;
- /* determine second position of dipole */
- if (src.orient == 2) { /* dipole +/- */
- iz += 1;
- vx[(ix+1)*n1+iz] -= src_ampl*sdx;
- vx[ix*n1+iz] += src_ampl*sdx;
- vz[ix*n1+iz+1] -= src_ampl*sdx;
- vz[ix*n1+iz] += src_ampl*sdx;
- }
- else if (src.orient == 3) { /* dipole - + */
- ix += 1;
- vx[(ix+1)*n1+iz] -= src_ampl*sdx;
- vx[ix*n1+iz] += src_ampl*sdx;
- vz[ix*n1+iz+1] -= src_ampl*sdx;
- vz[ix*n1+iz] += src_ampl*sdx;
- }
- }
- else if(src.type == 9) {
- rake = 0.5*M_PI;
- Mxx = -1.0*(sin(src.dip)*cos(rake)*sin(2.0*src.strike)+sin(src.dip*2.0)*sin(rake)*sin(src.strike)*sin(src.strike));
- Mxz = -1.0*(cos(src.dip)*cos(rake)*cos(src.strike)+cos(src.dip*2.0)*sin(rake)*sin(src.strike));
- Mzz = sin(src.dip*2.0)*sin(rake);
-
- txx[ix*n1+iz] -= Mxx*src_ampl;
- tzz[ix*n1+iz] -= Mzz*src_ampl;
- txz[ix*n1+iz] -= Mxz*src_ampl;
- } /* src.type */
- } /* ischeme */
- } /* loop over isrc */
-
- return 0;
-}
diff --git a/fdelmodc3D/applySource3D.c b/fdelmodc3D/applySource3D.c
index 80298b31c9b5a1281a30a69ab044c35b25df9c88..cc53a43e104f21f125c20ecd587eaadd696fdc85 100644
--- a/fdelmodc3D/applySource3D.c
+++ b/fdelmodc3D/applySource3D.c
@@ -21,7 +21,10 @@ void vmess(char *fmt, ...);
*
**********************************************************************/
-long applySource3D(modPar mod, srcPar src, wavPar wav, bndPar bnd, long itime, long ixsrc, long iysrc, long izsrc, float *vx, float *vy, float *vz, float *tzz, float *tyy, float *txx, float *txz, float *txy, float *tyz, float *rox, float *roy, float *roz, float *l2m, float **src_nwav, long verbose)
+long applySource3D(modPar mod, srcPar src, wavPar wav, bndPar bnd, long itime,
+ long ixsrc, long iysrc, long izsrc, float *vx, float *vy, float *vz,
+ float *tzz, float *tyy, float *txx, float *txz, float *txy, float *tyz,
+ float *rox, float *roy, float *roz, float *l2m, float **src_nwav, long verbose)
{
long is0, ibndz, ibndy, ibndx;
long isrc, ix, iy, iz, n1, n2;
diff --git a/fdelmodc3D/boundaries.c b/fdelmodc3D/boundaries.c
deleted file mode 100644
index ffda5cfa0eacda0d59f35c396390ce7de54d5286..0000000000000000000000000000000000000000
--- a/fdelmodc3D/boundaries.c
+++ /dev/null
@@ -1,1682 +0,0 @@
-#include<stdlib.h>
-#include<stdio.h>
-#include<math.h>
-#include<assert.h>
-#include"fdelmodc.h"
-
-void vmess(char *fmt, ...);
-
-int boundariesP(modPar mod, bndPar bnd, float *vx, float *vz, float *tzz, float *txx, float *txz, float *rox, float *roz, float *l2m, float *lam, float *mul, int itime, int verbose)
-{
-/*********************************************************************
-
- AUTHOR:
- Jan Thorbecke (janth@xs4all.nl)
- The Netherlands
-
-***********************************************************************/
-
- float c1, c2;
- float dp, dvx, dvz;
- int ix, iz, ixs, izs, ibnd, ib, ibx, ibz;
- int nx, nz, n1, n2;
- int is0, isrc;
- int ixo, ixe, izo, ize;
- int npml, ipml, pml;
- float kappu, alphu, sigmax, R, a, m, fac, dx, dt;
- float dpx, dpz, *p;
- static float *Vxpml, *Vzpml, *sigmu, *RA;
- static int allocated=0;
- float Jx, Jz, rho, d;
-
- c1 = 9.0/8.0;
- c2 = -1.0/24.0;
- nx = mod.nx;
- nz = mod.nz;
- n1 = mod.naz;
- n2 = mod.nax;
- dx = mod.dx;
- dt = mod.dt;
- fac = dt/dx;
- if ( (bnd.top==2) || (bnd.bot==2) || (bnd.lef==2) || (bnd.rig==2) ) pml=1;
- else pml=0;
-
- ibnd = mod.iorder/2-1;
-
- if (mod.ischeme <= 2) { /* Acoustic scheme */
- if (bnd.top==1) { /* free surface at top */
-#pragma omp for private (ix) nowait
- for (ix=mod.ioPx; ix<mod.iePx; ix++) {
- iz = bnd.surface[ix];
- //fprintf(stderr,"free iz=%d\n", iz);
- vz[ix*n1+iz] = vz[ix*n1+iz+1];
- vz[ix*n1+iz-1] = vz[ix*n1+iz+2];
- }
- }
-// if (bnd.rig==1) { /* free surface at right */
-//#pragma omp for private (iz) nowait
-// for (iz=mod.ioPz; iz<mod.iePz; iz++) {
-// tzz[(mod.iePx-1)*n1+iz] = 0.0;
-// }
-// }
-// if (bnd.bot==1) { /* free surface at bottom */
-//#pragma omp for private (ix) nowait
-// for (ix=mod.ioPx; ix<mod.iePx; ix++) {
-// tzz[ix*n1+mod.iePz-1] = 0.0;
-// }
-// }
-// if (bnd.lef==1) { /* free surface at left */
-//#pragma omp for private (iz) nowait
-// for (iz=mod.ioPz; iz<mod.iePz; iz++) {
-// tzz[(mod.ioPx-1)*n1+iz] = 0.0;
-// }
-// }
- }
-
-/************************************************************/
-/* rigid boundary condition clears velocities on boundaries */
-/************************************************************/
-
- if (bnd.top==3) { /* rigid surface at top */
-#pragma omp for private (ix, iz) nowait
-#pragma ivdep
- for (ix=1; ix<=nx; ix++) {
- vx[ix*n1+ibnd] = 0.0;
- vz[ix*n1+ibnd] = -vz[ix*n1+ibnd+1];
- if (mod.iorder >= 4) vz[ix*n1+ibnd-1] = -vz[ix*n1+ibnd+2];
- if (mod.iorder >= 6) vz[ix*n1+ibnd-2] = -vz[ix*n1+ibnd+3];
- }
- }
- if (bnd.rig==3) { /* rigid surface at right */
-#pragma omp for private (ix, iz) nowait
-#pragma ivdep
- for (iz=1; iz<=nz; iz++) {
- vz[(nx+ibnd-1)*n1+iz] = 0.0;
- vx[(nx+ibnd)*n1+iz] = -vx[(nx+ibnd-1)*n1+iz];
- if (mod.iorder == 4) vx[(nx+2)*n1+iz] = -vx[(nx-1)*n1+iz];
- if (mod.iorder == 6) {
- vx[(nx+1)*n1+iz] = -vx[(nx)*n1+iz];
- vx[(nx+3)*n1+iz] = -vx[(nx-2)*n1+iz];
- }
- }
- }
- if (bnd.bot==3) { /* rigid surface at bottom */
-#pragma omp for private (ix, iz) nowait
-#pragma ivdep
- for (ix=1; ix<=nx; ix++) {
- vx[ix*n1+nz+ibnd-1] = 0.0;
- vz[ix*n1+nz+ibnd] = -vz[ix*n1+nz+ibnd-1];
- if (mod.iorder == 4) vz[ix*n1+nz+2] = -vz[ix*n1+nz-1];
- if (mod.iorder == 6) {
- vz[ix*n1+nz+1] = -vz[ix*n1+nz];
- vz[ix*n1+nz+3] = -vz[ix*n1+nz-2];
- }
- }
- }
- if (bnd.lef==3) { /* rigid surface at left */
-#pragma omp for private (ix, iz) nowait
-#pragma ivdep
- for (iz=1; iz<=nz; iz++) {
- vz[ibnd*n1+iz] = 0.0;
- vx[ibnd*n1+iz] = -vx[(ibnd+1)*n1+iz];
- if (mod.iorder == 4) vx[0*n1+iz] = -vx[3*n1+iz];
- if (mod.iorder == 6) {
- vx[1*n1+iz] = -vx[4*n1+iz];
- vx[0*n1+iz] = -vx[5*n1+iz];
- }
- }
- }
-
-
-
-/************************************************************/
-/* PML boundaries : only for acoustic 4th order scheme */
-/************************************************************/
-
- npml=bnd.npml; /* lenght of pml in grid-points */
- if ( (npml != 0) && (itime==0) && pml) {
-#pragma omp master
-{
- if (allocated) {
- free(Vxpml);
- free(Vzpml);
- free(sigmu);
- free(RA);
- }
- Vxpml = (float *)calloc(2*n1*npml,sizeof(float));
- Vzpml = (float *)calloc(2*n2*npml,sizeof(float));
- sigmu = (float *)calloc(npml,sizeof(float));
- RA = (float *)calloc(npml,sizeof(float));
- allocated = 1;
-
- /* calculate sigmu and RA only once with fixed velocity Cp */
- m=bnd.m; /* scaling order */
- R=bnd.R; /* the theoretical reflection coefficient after discretization */
- kappu=1.0; /* auxiliary attenuation coefficient for small angles */
- alphu=0.0; /* auxiliary attenuation coefficient for low frequencies */
- d = (npml-1)*dx; /* depth of pml */
- /* sigmu attenuation factor representing the loss in the PML depends on the grid position in the PML */
-
- sigmax = ((3.0*mod.cp_min)/(2.0*d))*log(1.0/R);
- for (ib=0; ib<npml; ib++) { /* ib=0 interface between PML and interior */
- a = (float) (ib/(npml-1.0));
- sigmu[ib] = sigmax*pow(a,m);
- RA[ib] = (1.0)/(1.0+0.5*dt*sigmu[ib]);
- if (verbose>=3) vmess("PML: sigmax=%e cp=%e sigmu[%d]=%e %e", sigmax, mod.cp_min, ib, sigmu[ib], a);
- }
-}
- }
-#pragma omp barrier
-
- if (mod.ischeme == 1 && pml) { /* Acoustic scheme PML */
- p = tzz; /* Tzz array pointer points to P-field */
-
- /* PML left Vx */
- if (bnd.lef == 2) {
- /* PML left Vx-component */
-#pragma omp for private (ix, iz, dpx, Jx, ipml, rho)
- for (iz=mod.ioXz; iz<mod.ieXz; iz++) {
- ipml = npml-1;
- for (ix=mod.ioXx-npml; ix<mod.ioXx; ix++) {
- rho = (fac/rox[ix*n1+iz]);
- dpx = c1*(p[ix*n1+iz] - p[(ix-1)*n1+iz]) +
- c2*(p[(ix+1)*n1+iz] - p[(ix-2)*n1+iz]);
- Jx = RA[ipml]*(dpx - dt*Vxpml[iz*npml+ipml]);
- Vxpml[iz*npml+ipml] += sigmu[ipml]*Jx;
- vx[ix*n1+iz] -= rox[ix*n1+iz]*Jx;
- ipml--;
- }
- }
- /* PML Vz-component same as default kernel */
-#pragma omp for private (ix, iz)
- for (ix=mod.ioZx-npml; ix<mod.ioZx; ix++) {
-#pragma ivdep
- for (iz=mod.ioZz; iz<mod.ieZz; iz++) {
- vz[ix*n1+iz] -= roz[ix*n1+iz]*(
- c1*(p[ix*n1+iz] - p[ix*n1+iz-1]) +
- c2*(p[ix*n1+iz+1] - p[ix*n1+iz-2]));
- }
- }
- }
-
- /* PML corner left-top V */
- if (bnd.lef == 2 && bnd.top == 2) {
- /* PML left Vx-component */
-#pragma omp for private (ix, iz, dpx, Jx, ipml, rho)
- for (iz=mod.ioXz-npml; iz<mod.ioXz; iz++) {
- ipml = npml-1;
- for (ix=mod.ioXx-npml; ix<mod.ioXx; ix++) {
- rho = (fac/rox[ix*n1+iz]);
- dpx = c1*(p[ix*n1+iz] - p[(ix-1)*n1+iz]) +
- c2*(p[(ix+1)*n1+iz] - p[(ix-2)*n1+iz]);
- Jx = RA[ipml]*(dpx - dt*Vxpml[iz*npml+ipml]);
- Vxpml[iz*npml+ipml] += sigmu[ipml]*Jx;
- vx[ix*n1+iz] -= rox[ix*n1+iz]*Jx;
- ipml--;
- }
- }
- /* PML top Vz-component */
-#pragma omp for private (ix, iz, dpz, Jz, ipml, rho)
- for (ix=mod.ioZx-npml; ix<mod.ioZx; ix++) {
- ipml = npml-1;
- for (iz=mod.ioZz-npml; iz<mod.ioZz; iz++) {
- rho = (fac/roz[ix*n1+iz]);
- dpz = (c1*(p[ix*n1+iz] - p[ix*n1+iz-1]) +
- c2*(p[ix*n1+iz+1] - p[ix*n1+iz-2]));
- Jz = RA[ipml]*(dpz - dt*Vzpml[ix*npml+ipml]);
- Vzpml[ix*npml+ipml] += sigmu[ipml]*Jz;
- vz[ix*n1+iz] -= roz[ix*n1+iz]*Jz;
- ipml--;
- }
- }
- }
-
- /* PML right V */
- if (bnd.rig == 2) {
- /* PML right Vx-component */
-#pragma omp for private (ix, iz, dpx, Jx, ipml, rho)
- for (iz=mod.ioXz; iz<mod.ieXz; iz++) {
- ipml = 0;
- for (ix=mod.ieXx; ix<mod.ieXx+npml; ix++) {
- rho = (fac/rox[ix*n1+iz]);
- dpx = c1*(p[ix*n1+iz] - p[(ix-1)*n1+iz]) +
- c2*(p[(ix+1)*n1+iz] - p[(ix-2)*n1+iz]);
- Jx = RA[ipml]*(dpx - dt*Vxpml[n1*npml+iz*npml+ipml]);
- Vxpml[n1*npml+iz*npml+ipml] += sigmu[ipml]*Jx;
- vx[ix*n1+iz] -= rox[ix*n1+iz]*Jx;
- ipml++;
- }
- }
- /* PML Vz-component same as default kernel */
-#pragma omp for private (ix, iz)
- for (ix=mod.ieZx; ix<mod.ieZx+npml; ix++) {
-#pragma ivdep
- for (iz=mod.ioZz; iz<mod.ieZz; iz++) {
- vz[ix*n1+iz] -= roz[ix*n1+iz]*(
- c1*(p[ix*n1+iz] - p[ix*n1+iz-1]) +
- c2*(p[ix*n1+iz+1] - p[ix*n1+iz-2]));
- }
- }
- }
-
- /* PML corner right-top V */
- if (bnd.rig == 2 && bnd.top == 2) {
- /* PML right Vx-component */
-#pragma omp for private (ix, iz, dpx, Jx, ipml, rho)
- for (iz=mod.ioXz-npml; iz<mod.ioXz; iz++) {
- ipml = 0;
- for (ix=mod.ieXx; ix<mod.ieXx+npml; ix++) {
- rho = (fac/rox[ix*n1+iz]);
- dpx = c1*(p[ix*n1+iz] - p[(ix-1)*n1+iz]) +
- c2*(p[(ix+1)*n1+iz] - p[(ix-2)*n1+iz]);
- Jx = RA[ipml]*(dpx - dt*Vxpml[n1*npml+iz*npml+ipml]);
- Vxpml[n1*npml+iz*npml+ipml] += sigmu[ipml]*Jx;
- vx[ix*n1+iz] -= rox[ix*n1+iz]*Jx;
- ipml++;
- }
- }
- /* PML top Vz-component */
-#pragma omp for private (ix, iz, dpz, Jz, ipml, rho)
- for (ix=mod.ieZx; ix<mod.ieZx+npml; ix++) {
- ipml = npml-1;
- for (iz=mod.ioZz-npml; iz<mod.ioZz; iz++) {
- rho = (fac/roz[ix*n1+iz]);
- dpz = (c1*(p[ix*n1+iz] - p[ix*n1+iz-1]) +
- c2*(p[ix*n1+iz+1] - p[ix*n1+iz-2]));
- Jz = RA[ipml]*(dpz - dt*Vzpml[ix*npml+ipml]);
- Vzpml[ix*npml+ipml] += sigmu[ipml]*Jz;
- vz[ix*n1+iz] -= roz[ix*n1+iz]*Jz;
- ipml--;
- }
- }
- }
-
- /* PML top V */
- if (bnd.top == 2) {
- /* PML top Vz-component */
-#pragma omp for private (ix, iz, dpz, Jz, ipml, rho)
- for (ix=mod.ioZx; ix<mod.ieZx; ix++) {
- ipml = npml-1;
- for (iz=mod.ioZz-npml; iz<mod.ioZz; iz++) {
- rho = (fac/roz[ix*n1+iz]);
- dpz = (c1*(p[ix*n1+iz] - p[ix*n1+iz-1]) +
- c2*(p[ix*n1+iz+1] - p[ix*n1+iz-2]));
- Jz = RA[ipml]*(dpz - dt*Vzpml[ix*npml+ipml]);
- Vzpml[ix*npml+ipml] += sigmu[ipml]*Jz;
- vz[ix*n1+iz] -= roz[ix*n1+iz]*Jz;
- ipml--;
- }
- }
- /* PML top Vx-component same as default kernel */
-#pragma omp for private (ix, iz)
- for (ix=mod.ioXx; ix<mod.ieXx; ix++) {
-#pragma ivdep
- for (iz=mod.ioXz-npml; iz<mod.ioXz; iz++) {
- vx[ix*n1+iz] -= rox[ix*n1+iz]*(
- c1*(p[ix*n1+iz] - p[(ix-1)*n1+iz]) +
- c2*(p[(ix+1)*n1+iz] - p[(ix-2)*n1+iz]));
- }
- }
- }
-
- /* PML bottom V */
- if (bnd.bot == 2) {
- /* PML bottom Vz-component */
-#pragma omp for private (ix, iz, dpz, Jz, ipml, rho)
- for (ix=mod.ioZx; ix<mod.ieZx; ix++) {
- ipml = 0;
- for (iz=mod.ieZz; iz<mod.ieZz+npml; iz++) {
- rho = (fac/roz[ix*n1+iz]);
- dpz = (c1*(p[ix*n1+iz] - p[ix*n1+iz-1]) +
- c2*(p[ix*n1+iz+1] - p[ix*n1+iz-2]));
- Jz = RA[ipml]*(dpz - dt*Vzpml[n2*npml+ix*npml+ipml]);
- Vzpml[n2*npml+ix*npml+ipml] += sigmu[ipml]*Jz;
- vz[ix*n1+iz] -= roz[ix*n1+iz]*Jz;
- ipml++;
- }
- }
- /* PML bottom Vx-component same as default kernel */
-#pragma omp for private (ix, iz)
- for (ix=mod.ioXx; ix<mod.ieXx; ix++) {
-#pragma ivdep
- for (iz=mod.ieXz; iz<mod.ieXz+npml; iz++) {
- vx[ix*n1+iz] -= rox[ix*n1+iz]*(
- c1*(p[ix*n1+iz] - p[(ix-1)*n1+iz]) +
- c2*(p[(ix+1)*n1+iz] - p[(ix-2)*n1+iz]));
- }
- }
- }
-
- /* PML corner left-bottom */
- if (bnd.bot == 2 && bnd.lef == 2) {
- /* PML bottom Vz-component */
-#pragma omp for private (ix, iz, dpz, Jz, ipml, rho)
- for (ix=mod.ioZx-npml; ix<mod.ioZx; ix++) {
- ipml = 0;
- for (iz=mod.ieZz; iz<mod.ieZz+npml; iz++) {
- rho = (fac/roz[ix*n1+iz]);
- dpz = (c1*(p[ix*n1+iz] - p[ix*n1+iz-1]) +
- c2*(p[ix*n1+iz+1] - p[ix*n1+iz-2]));
- Jz = RA[ipml]*(dpz - dt*Vzpml[n2*npml+ix*npml+ipml]);
- Vzpml[n2*npml+ix*npml+ipml] += sigmu[ipml]*Jz;
- vz[ix*n1+iz] -= roz[ix*n1+iz]*Jz;
- ipml++;
- }
- }
- /* PML left Vx-component */
-#pragma omp for private (ix, iz, dpx, Jx, ipml, rho)
- for (iz=mod.ieXz; iz<mod.ieXz+npml; iz++) {
- ipml = npml-1;
- for (ix=mod.ioXx-npml; ix<mod.ioXx; ix++) {
- rho = (fac/rox[ix*n1+iz]);
- dpx = c1*(p[ix*n1+iz] - p[(ix-1)*n1+iz]) +
- c2*(p[(ix+1)*n1+iz] - p[(ix-2)*n1+iz]);
- Jx = RA[ipml]*(dpx - dt*Vxpml[iz*npml+ipml]);
- Vxpml[iz*npml+ipml] += sigmu[ipml]*Jx;
- vx[ix*n1+iz] -= rox[ix*n1+iz]*Jx;
- ipml--;
- }
- }
- }
-
- /* PML corner right-bottom */
- if (bnd.bot == 2 && bnd.rig == 2) {
- /* PML bottom Vz-component */
-#pragma omp for private (ix, iz, dpz, Jz, ipml, rho)
- for (ix=mod.ieZx; ix<mod.ieZx+npml; ix++) {
- ipml = 0;
- for (iz=mod.ieZz; iz<mod.ieZz+npml; iz++) {
- rho = (fac/roz[ix*n1+iz]);
- dpz = (c1*(p[ix*n1+iz] - p[ix*n1+iz-1]) +
- c2*(p[ix*n1+iz+1] - p[ix*n1+iz-2]));
- Jz = RA[ipml]*(dpz - dt*Vzpml[n2*npml+ix*npml+ipml]);
- Vzpml[n2*npml+ix*npml+ipml] += sigmu[ipml]*Jz;
- vz[ix*n1+iz] -= roz[ix*n1+iz]*Jz;
- ipml++;
- }
- }
- /* PML right Vx-component */
-#pragma omp for private (ix, iz, dpx, Jx, ipml, rho)
- for (iz=mod.ieXz; iz<mod.ieXz+npml; iz++) {
- ipml = 0;
- for (ix=mod.ieXx; ix<mod.ieXx+npml; ix++) {
- rho = (fac/rox[ix*n1+iz]);
- dpx = c1*(p[ix*n1+iz] - p[(ix-1)*n1+iz]) +
- c2*(p[(ix+1)*n1+iz] - p[(ix-2)*n1+iz]);
- Jx = RA[ipml]*(dpx - dt*Vxpml[n1*npml+iz*npml+ipml]);
- Vxpml[n1*npml+iz*npml+ipml] += sigmu[ipml]*Jx;
- vx[ix*n1+iz] -= rox[ix*n1+iz]*Jx;
- ipml++;
- }
- }
- }
-
- } /* end acoustic PML */
-
-
-
-
-/************************************************************/
-/* Tapered boundaries for both elastic and acoustic schemes */
-/* compute all field values in tapered areas */
-/************************************************************/
-
- /*********/
- /* Top */
- /*********/
- if (bnd.top==4) {
-
- if (mod.ischeme <= 2) { /* Acoustic scheme */
-
- /* Vx field */
- ixo = mod.ioXx;
- ixe = mod.ieXx;
- izo = mod.ioXz-bnd.ntap;
- ize = mod.ioXz;
-
- ib = (bnd.ntap+izo-1);
-#pragma omp for private(ix,iz)
- for (ix=ixo; ix<ixe; ix++) {
-#pragma ivdep
- for (iz=izo; iz<ize; iz++) {
- vx[ix*n1+iz] -= rox[ix*n1+iz]*(
- c1*(tzz[ix*n1+iz] - tzz[(ix-1)*n1+iz]) +
- c2*(tzz[(ix+1)*n1+iz] - tzz[(ix-2)*n1+iz]));
-
- vx[ix*n1+iz] *= bnd.tapx[ib-iz];
- }
- }
- /* right top corner */
- if (bnd.rig==4) {
- ixo = mod.ieXx;
- ixe = ixo+bnd.ntap;
- ibz = (bnd.ntap+izo-1);
- ibx = (ixo);
-#pragma omp for private(ix,iz)
- for (ix=ixo; ix<ixe; ix++) {
-#pragma ivdep
- for (iz=izo; iz<ize; iz++) {
- vx[ix*n1+iz] -= rox[ix*n1+iz]*(
- c1*(tzz[ix*n1+iz] - tzz[(ix-1)*n1+iz]) +
- c2*(tzz[(ix+1)*n1+iz] - tzz[(ix-2)*n1+iz]));
-
- vx[ix*n1+iz] *= bnd.tapxz[(ix-ibx)*bnd.ntap+(ibz-iz)];
- }
- }
- }
- /* left top corner */
- if (bnd.lef==4) {
- ixo = mod.ioXx-bnd.ntap;
- ixe = mod.ioXx;
- ibz = (bnd.ntap+izo-1);
- ibx = (bnd.ntap+ixo-1);
-#pragma omp for private(ix,iz)
- for (ix=ixo; ix<ixe; ix++) {
-#pragma ivdep
- for (iz=izo; iz<ize; iz++) {
- vx[ix*n1+iz] -= rox[ix*n1+iz]*(
- c1*(tzz[ix*n1+iz] - tzz[(ix-1)*n1+iz]) +
- c2*(tzz[(ix+1)*n1+iz] - tzz[(ix-2)*n1+iz]));
-
- vx[ix*n1+iz] *= bnd.tapxz[(ibx-ix)*bnd.ntap+(ibz-iz)];
- }
- }
- }
-
-
- /* Vz field */
- ixo = mod.ioZx;
- ixe = mod.ieZx;
- izo = mod.ioZz-bnd.ntap;
- ize = mod.ioZz;
-
- ib = (bnd.ntap+izo-1);
-#pragma omp for private (ix, iz)
- for (ix=ixo; ix<ixe; ix++) {
-#pragma ivdep
- for (iz=izo; iz<ize; iz++) {
- vz[ix*n1+iz] -= roz[ix*n1+iz]*(
- c1*(tzz[ix*n1+iz] - tzz[ix*n1+iz-1]) +
- c2*(tzz[ix*n1+iz+1] - tzz[ix*n1+iz-2]));
-
- vz[ix*n1+iz] *= bnd.tapz[ib-iz];
- }
- }
- /* right top corner */
- if (bnd.rig==4) {
- ixo = mod.ieZx;
- ixe = ixo+bnd.ntap;
- ibz = (bnd.ntap+izo-1);
- ibx = (ixo);
-#pragma omp for private(ix,iz)
- for (ix=ixo; ix<ixe; ix++) {
-#pragma ivdep
- for (iz=izo; iz<ize; iz++) {
- vz[ix*n1+iz] -= roz[ix*n1+iz]*(
- c1*(tzz[ix*n1+iz] - tzz[ix*n1+iz-1]) +
- c2*(tzz[ix*n1+iz+1] - tzz[ix*n1+iz-2]));
-
- vz[ix*n1+iz] *= bnd.tapxz[(ix-ibx)*bnd.ntap+(ibz-iz)];
- }
- }
- }
- /* left top corner */
- if (bnd.lef==4) {
- ixo = mod.ioZx-bnd.ntap;
- ixe = mod.ioZx;
- ibz = (bnd.ntap+izo-1);
- ibx = (bnd.ntap+ixo-1);
-#pragma omp for private(ix,iz)
- for (ix=ixo; ix<ixe; ix++) {
-#pragma ivdep
- for (iz=izo; iz<ize; iz++) {
- vz[ix*n1+iz] -= roz[ix*n1+iz]*(
- c1*(tzz[ix*n1+iz] - tzz[ix*n1+iz-1]) +
- c2*(tzz[ix*n1+iz+1] - tzz[ix*n1+iz-2]));
-
- vz[ix*n1+iz] *= bnd.tapxz[(ibx-ix)*bnd.ntap+(ibz-iz)];
- }
- }
- }
-
- }
- else { /* Elastic scheme */
-
- /* Vx field */
- ixo = mod.ioXx;
- ixe = mod.ieXx;
- izo = mod.ioXz-bnd.ntap;
- ize = mod.ioXz;
-
- ib = (bnd.ntap+izo-1);
-#pragma omp for private(ix,iz)
- for (ix=ixo; ix<ixe; ix++) {
-#pragma ivdep
- for (iz=izo; iz<ize; iz++) {
- vx[ix*n1+iz] -= rox[ix*n1+iz]*(
- c1*(txx[ix*n1+iz] - txx[(ix-1)*n1+iz] +
- txz[ix*n1+iz+1] - txz[ix*n1+iz]) +
- c2*(txx[(ix+1)*n1+iz] - txx[(ix-2)*n1+iz] +
- txz[ix*n1+iz+2] - txz[ix*n1+iz-1]) );
-
- vx[ix*n1+iz] *= bnd.tapx[ib-iz];
- }
- }
- /* right top corner */
- if (bnd.rig==4) {
- ixo = mod.ieXx;
- ixe = ixo+bnd.ntap;
- ibz = (bnd.ntap+izo-1);
- ibx = (ixo);
-#pragma omp for private(ix,iz)
- for (ix=ixo; ix<ixe; ix++) {
-#pragma ivdep
- for (iz=izo; iz<ize; iz++) {
- vx[ix*n1+iz] -= rox[ix*n1+iz]*(
- c1*(txx[ix*n1+iz] - txx[(ix-1)*n1+iz] +
- txz[ix*n1+iz+1] - txz[ix*n1+iz]) +
- c2*(txx[(ix+1)*n1+iz] - txx[(ix-2)*n1+iz] +
- txz[ix*n1+iz+2] - txz[ix*n1+iz-1]) );
-
- vx[ix*n1+iz] *= bnd.tapxz[(ix-ibx)*bnd.ntap+(ibz-iz)];
- }
- }
- }
- /* left top corner */
- if (bnd.lef==4) {
- ixo = mod.ioXx-bnd.ntap;
- ixe = mod.ioXx;
- ibz = (bnd.ntap+izo-1);
- ibx = (bnd.ntap+ixo-1);
-#pragma omp for private(ix,iz)
- for (ix=ixo; ix<ixe; ix++) {
-#pragma ivdep
- for (iz=izo; iz<ize; iz++) {
- vx[ix*n1+iz] -= rox[ix*n1+iz]*(
- c1*(txx[ix*n1+iz] - txx[(ix-1)*n1+iz] +
- txz[ix*n1+iz+1] - txz[ix*n1+iz]) +
- c2*(txx[(ix+1)*n1+iz] - txx[(ix-2)*n1+iz] +
- txz[ix*n1+iz+2] - txz[ix*n1+iz-1]) );
-
- vx[ix*n1+iz] *= bnd.tapxz[(ibx-ix)*bnd.ntap+(ibz-iz)];
- }
- }
- }
-
- /* Vz field */
- ixo = mod.ioZx;
- ixe = mod.ieZx;
- izo = mod.ioZz-bnd.ntap;
- ize = mod.ioZz;
-
- ib = (bnd.ntap+izo-1);
-#pragma omp for private (ix, iz)
- for (ix=ixo; ix<ixe; ix++) {
-#pragma ivdep
- for (iz=izo; iz<ize; iz++) {
- vz[ix*n1+iz] -= roz[ix*n1+iz]*(
- c1*(tzz[ix*n1+iz] - tzz[ix*n1+iz-1] +
- txz[(ix+1)*n1+iz] - txz[ix*n1+iz]) +
- c2*(tzz[ix*n1+iz+1] - tzz[ix*n1+iz-2] +
- txz[(ix+2)*n1+iz] - txz[(ix-1)*n1+iz]) );
-
- vz[ix*n1+iz] *= bnd.tapz[ib-iz];
- }
- }
- /* right top corner */
- if (bnd.rig==4) {
- ixo = mod.ieZx;
- ixe = ixo+bnd.ntap;
- ibz = (bnd.ntap+izo-1);
- ibx = (ixo);
-#pragma omp for private(ix,iz)
- for (ix=ixo; ix<ixe; ix++) {
-#pragma ivdep
- for (iz=izo; iz<ize; iz++) {
- vz[ix*n1+iz] -= roz[ix*n1+iz]*(
- c1*(tzz[ix*n1+iz] - tzz[ix*n1+iz-1] +
- txz[(ix+1)*n1+iz] - txz[ix*n1+iz]) +
- c2*(tzz[ix*n1+iz+1] - tzz[ix*n1+iz-2] +
- txz[(ix+2)*n1+iz] - txz[(ix-1)*n1+iz]) );
-
- vz[ix*n1+iz] *= bnd.tapxz[(ix-ibx)*bnd.ntap+(ibz-iz)];
- }
- }
- }
- /* left top corner */
- if (bnd.lef==4) {
- ixo = mod.ioZx-bnd.ntap;
- ixe = mod.ioZx;
- ibz = (bnd.ntap+izo-1);
- ibx = (bnd.ntap+ixo-1);
-#pragma omp for private(ix,iz)
- for (ix=ixo; ix<ixe; ix++) {
-#pragma ivdep
- for (iz=izo; iz<ize; iz++) {
- vz[ix*n1+iz] -= roz[ix*n1+iz]*(
- c1*(tzz[ix*n1+iz] - tzz[ix*n1+iz-1] +
- txz[(ix+1)*n1+iz] - txz[ix*n1+iz]) +
- c2*(tzz[ix*n1+iz+1] - tzz[ix*n1+iz-2] +
- txz[(ix+2)*n1+iz] - txz[(ix-1)*n1+iz]) );
-
- vz[ix*n1+iz] *= bnd.tapxz[(ibx-ix)*bnd.ntap+(ibz-iz)];
- }
- }
- }
-
-
- } /* end elastic scheme */
- }
-
- /*********/
- /* Bottom */
- /*********/
- if (bnd.bot==4) {
-
- if (mod.ischeme <= 2) { /* Acoustic scheme */
-
- /* Vx field */
- ixo = mod.ioXx;
- ixe = mod.ieXx;
- izo = mod.ieXz;
- ize = mod.ieXz+bnd.ntap;
-
- ib = (ize-bnd.ntap);
-#pragma omp for private(ix,iz)
- for (ix=ixo; ix<ixe; ix++) {
-#pragma ivdep
- for (iz=izo; iz<ize; iz++) {
- vx[ix*n1+iz] -= rox[ix*n1+iz]*(
- c1*(tzz[ix*n1+iz] - tzz[(ix-1)*n1+iz]) +
- c2*(tzz[(ix+1)*n1+iz] - tzz[(ix-2)*n1+iz]));
- vx[ix*n1+iz] *= bnd.tapx[iz-ib];
- }
- }
- /* right bottom corner */
- if (bnd.rig==4) {
- ixo = mod.ieXx;
- ixe = ixo+bnd.ntap;
- ibz = (izo);
- ibx = (ixo);
-#pragma omp for private(ix,iz)
- for (ix=ixo; ix<ixe; ix++) {
-#pragma ivdep
- for (iz=izo; iz<ize; iz++) {
- vx[ix*n1+iz] -= rox[ix*n1+iz]*(
- c1*(tzz[ix*n1+iz] - tzz[(ix-1)*n1+iz]) +
- c2*(tzz[(ix+1)*n1+iz] - tzz[(ix-2)*n1+iz]));
-
- vx[ix*n1+iz] *= bnd.tapxz[(ix-ibx)*bnd.ntap+(iz-ibz)];
- }
- }
- }
- /* left bottom corner */
- if (bnd.lef==4) {
- ixo = mod.ioXx-bnd.ntap;
- ixe = mod.ioXx;
- ibz = (izo);
- ibx = (bnd.ntap+ixo-1);
-#pragma omp for private(ix,iz)
- for (ix=ixo; ix<ixe; ix++) {
-#pragma ivdep
- for (iz=izo; iz<ize; iz++) {
- vx[ix*n1+iz] -= rox[ix*n1+iz]*(
- c1*(tzz[ix*n1+iz] - tzz[(ix-1)*n1+iz]) +
- c2*(tzz[(ix+1)*n1+iz] - tzz[(ix-2)*n1+iz]));
-
- vx[ix*n1+iz] *= bnd.tapxz[(ibx-ix)*bnd.ntap+(iz-ibz)];
- }
- }
- }
-
-
- /* Vz field */
- ixo = mod.ioZx;
- ixe = mod.ieZx;
- izo = mod.ieZz;
- ize = mod.ieZz+bnd.ntap;
-
- ib = (ize-bnd.ntap);
-#pragma omp for private (ix, iz)
- for (ix=ixo; ix<ixe; ix++) {
-#pragma ivdep
- for (iz=izo; iz<ize; iz++) {
- vz[ix*n1+iz] -= roz[ix*n1+iz]*(
- c1*(tzz[ix*n1+iz] - tzz[ix*n1+iz-1]) +
- c2*(tzz[ix*n1+iz+1] - tzz[ix*n1+iz-2]));
- vz[ix*n1+iz] *= bnd.tapz[iz-ib];
- }
- }
- /* right bottom corner */
- if (bnd.rig==4) {
- ixo = mod.ieZx;
- ixe = ixo+bnd.ntap;
- ibz = (izo);
- ibx = (ixo);
-#pragma omp for private(ix,iz)
- for (ix=ixo; ix<ixe; ix++) {
-#pragma ivdep
- for (iz=izo; iz<ize; iz++) {
- vz[ix*n1+iz] -= roz[ix*n1+iz]*(
- c1*(tzz[ix*n1+iz] - tzz[ix*n1+iz-1]) +
- c2*(tzz[ix*n1+iz+1] - tzz[ix*n1+iz-2]));
-
- vz[ix*n1+iz] *= bnd.tapxz[(ix-ibx)*bnd.ntap+(iz-ibz)];
- }
- }
- }
- /* left bottom corner */
- if (bnd.lef==4) {
- ixo = mod.ioZx-bnd.ntap;
- ixe = mod.ioZx;
- ibz = (izo);
- ibx = (bnd.ntap+ixo-1);
-#pragma omp for private(ix,iz)
- for (ix=ixo; ix<ixe; ix++) {
-#pragma ivdep
- for (iz=izo; iz<ize; iz++) {
- vz[ix*n1+iz] -= roz[ix*n1+iz]*(
- c1*(tzz[ix*n1+iz] - tzz[ix*n1+iz-1]) +
- c2*(tzz[ix*n1+iz+1] - tzz[ix*n1+iz-2]));
-
- vz[ix*n1+iz] *= bnd.tapxz[(ibx-ix)*bnd.ntap+(iz-ibz)];
- }
- }
- }
-
-
- }
- else { /* Elastic scheme */
-
- /* Vx field */
- ixo = mod.ioXx;
- ixe = mod.ieXx;
- izo = mod.ieXz;
- ize = mod.ieXz+bnd.ntap;
-
- ib = (ize-bnd.ntap);
-#pragma omp for private(ix,iz)
- for (ix=ixo; ix<ixe; ix++) {
-#pragma ivdep
- for (iz=izo; iz<ize; iz++) {
- vx[ix*n1+iz] -= rox[ix*n1+iz]*(
- c1*(txx[ix*n1+iz] - txx[(ix-1)*n1+iz] +
- txz[ix*n1+iz+1] - txz[ix*n1+iz]) +
- c2*(txx[(ix+1)*n1+iz] - txx[(ix-2)*n1+iz] +
- txz[ix*n1+iz+2] - txz[ix*n1+iz-1]) );
-
- vx[ix*n1+iz] *= bnd.tapx[iz-ib];
- }
- }
- /* right bottom corner */
- if (bnd.rig==4) {
- ixo = mod.ieXx;
- ixe = ixo+bnd.ntap;
- ibz = (izo);
- ibx = (ixo);
-#pragma omp for private(ix,iz)
- for (ix=ixo; ix<ixe; ix++) {
-#pragma ivdep
- for (iz=izo; iz<ize; iz++) {
- vx[ix*n1+iz] -= rox[ix*n1+iz]*(
- c1*(txx[ix*n1+iz] - txx[(ix-1)*n1+iz] +
- txz[ix*n1+iz+1] - txz[ix*n1+iz]) +
- c2*(txx[(ix+1)*n1+iz] - txx[(ix-2)*n1+iz] +
- txz[ix*n1+iz+2] - txz[ix*n1+iz-1]) );
-
- vx[ix*n1+iz] *= bnd.tapxz[(ix-ibx)*bnd.ntap+(iz-ibz)];
- }
- }
- }
- /* left bottom corner */
- if (bnd.lef==4) {
-
-
- ixo = mod.ioXx-bnd.ntap;
- ixe = mod.ioXx;
- ibz = (izo);
- ibx = (bnd.ntap+ixo-1);
-
-
-#pragma omp for private(ix,iz)
- for (ix=ixo; ix<ixe; ix++) {
-#pragma ivdep
- for (iz=izo; iz<ize; iz++) {
- vx[ix*n1+iz] -= rox[ix*n1+iz]*(
- c1*(txx[ix*n1+iz] - txx[(ix-1)*n1+iz] +
- txz[ix*n1+iz+1] - txz[ix*n1+iz]) +
- c2*(txx[(ix+1)*n1+iz] - txx[(ix-2)*n1+iz] +
- txz[ix*n1+iz+2] - txz[ix*n1+iz-1]) );
-
- vx[ix*n1+iz] *= bnd.tapxz[(ibx-ix)*bnd.ntap+(iz-ibz)];
- }
- }
- }
-
- /* Vz field */
- ixo = mod.ioZx;
- ixe = mod.ieZx;
- izo = mod.ieZz;
- ize = mod.ieZz+bnd.ntap;
-
- ib = (ize-bnd.ntap);
-#pragma omp for private (ix, iz)
- for (ix=ixo; ix<ixe; ix++) {
-#pragma ivdep
- for (iz=izo; iz<ize; iz++) {
- vz[ix*n1+iz] -= roz[ix*n1+iz]*(
- c1*(tzz[ix*n1+iz] - tzz[ix*n1+iz-1] +
- txz[(ix+1)*n1+iz] - txz[ix*n1+iz]) +
- c2*(tzz[ix*n1+iz+1] - tzz[ix*n1+iz-2] +
- txz[(ix+2)*n1+iz] - txz[(ix-1)*n1+iz]) );
-
- vz[ix*n1+iz] *= bnd.tapz[iz-ib];
- }
- }
- /* right bottom corner */
- if (bnd.rig==4) {
- ixo = mod.ieZx;
- ixe = ixo+bnd.ntap;
- ibz = (izo);
- ibx = (ixo);
-#pragma omp for private(ix,iz)
- for (ix=ixo; ix<ixe; ix++) {
-#pragma ivdep
- for (iz=izo; iz<ize; iz++) {
- vz[ix*n1+iz] -= roz[ix*n1+iz]*(
- c1*(tzz[ix*n1+iz] - tzz[ix*n1+iz-1] +
- txz[(ix+1)*n1+iz] - txz[ix*n1+iz]) +
- c2*(tzz[ix*n1+iz+1] - tzz[ix*n1+iz-2] +
- txz[(ix+2)*n1+iz] - txz[(ix-1)*n1+iz]) );
-
- vz[ix*n1+iz] *= bnd.tapxz[(ix-ibx)*bnd.ntap+(iz-ibz)];
- }
- }
- }
- /* left bottom corner */
- if (bnd.lef==4) {
- ixo = mod.ioZx-bnd.ntap;
- ixe = mod.ioZx;
- ibz = (izo);
- ibx = (bnd.ntap+ixo-1);
-#pragma omp for private(ix,iz)
- for (ix=ixo; ix<ixe; ix++) {
-#pragma ivdep
- for (iz=izo; iz<ize; iz++) {
- vz[ix*n1+iz] -= roz[ix*n1+iz]*(
- c1*(tzz[ix*n1+iz] - tzz[ix*n1+iz-1] +
- txz[(ix+1)*n1+iz] - txz[ix*n1+iz]) +
- c2*(tzz[ix*n1+iz+1] - tzz[ix*n1+iz-2] +
- txz[(ix+2)*n1+iz] - txz[(ix-1)*n1+iz]) );
-
- vz[ix*n1+iz] *= bnd.tapxz[(ibx-ix)*bnd.ntap+(iz-ibz)];
- }
- }
- }
-
-
- } /* end elastic scheme */
-
- }
-
- /*********/
- /* Left */
- /*********/
- if (bnd.lef==4) {
-
- if (mod.ischeme <= 2) { /* Acoustic scheme */
-
- /* Vx field */
- ixo = mod.ioXx-bnd.ntap;
- ixe = mod.ioXx;
- izo = mod.ioXz;
- ize = mod.ieXz;
-
- ib = (bnd.ntap+ixo-1);
-#pragma omp for private(ix,iz)
- for (ix=ixo; ix<ixe; ix++) {
-#pragma ivdep
- for (iz=izo; iz<ize; iz++) {
- vx[ix*n1+iz] -= rox[ix*n1+iz]*(
- c1*(tzz[ix*n1+iz] - tzz[(ix-1)*n1+iz]) +
- c2*(tzz[(ix+1)*n1+iz] - tzz[(ix-2)*n1+iz]));
-
- vx[ix*n1+iz] *= bnd.tapx[ib-ix];
- }
- }
-
- /* Vz field */
- ixo = mod.ioZx-bnd.ntap;
- ixe = mod.ioZx;
- izo = mod.ioZz;
- ize = mod.ieZz;
-
- ib = (bnd.ntap+ixo-1);
-#pragma omp for private (ix, iz)
- for (ix=ixo; ix<ixe; ix++) {
-#pragma ivdep
- for (iz=izo; iz<ize; iz++) {
- vz[ix*n1+iz] -= roz[ix*n1+iz]*(
- c1*(tzz[ix*n1+iz] - tzz[ix*n1+iz-1]) +
- c2*(tzz[ix*n1+iz+1] - tzz[ix*n1+iz-2]));
-
- vz[ix*n1+iz] *= bnd.tapz[ib-ix];
- }
- }
-
- }
- else { /* Elastic scheme */
-
- /* Vx field */
- ixo = mod.ioXx-bnd.ntap;
- ixe = mod.ioXx;
- izo = mod.ioXz;
- ize = mod.ieXz;
-
- ib = (bnd.ntap+ixo-1);
-#pragma omp for private(ix,iz)
- for (ix=ixo; ix<ixe; ix++) {
-#pragma ivdep
- for (iz=izo; iz<ize; iz++) {
- vx[ix*n1+iz] -= rox[ix*n1+iz]*(
- c1*(txx[ix*n1+iz] - txx[(ix-1)*n1+iz] +
- txz[ix*n1+iz+1] - txz[ix*n1+iz]) +
- c2*(txx[(ix+1)*n1+iz] - txx[(ix-2)*n1+iz] +
- txz[ix*n1+iz+2] - txz[ix*n1+iz-1]) );
-
- vx[ix*n1+iz] *= bnd.tapx[ib-ix];
- }
- }
-
- /* Vz field */
- ixo = mod.ioZx-bnd.ntap;
- ixe = mod.ioZx;
- izo = mod.ioZz;
- ize = mod.ieZz;
-
- ib = (bnd.ntap+ixo-1);
-#pragma omp for private (ix, iz)
- for (ix=ixo; ix<ixe; ix++) {
-#pragma ivdep
- for (iz=izo; iz<ize; iz++) {
- vz[ix*n1+iz] -= roz[ix*n1+iz]*(
- c1*(tzz[ix*n1+iz] - tzz[ix*n1+iz-1] +
- txz[(ix+1)*n1+iz] - txz[ix*n1+iz]) +
- c2*(tzz[ix*n1+iz+1] - tzz[ix*n1+iz-2] +
- txz[(ix+2)*n1+iz] - txz[(ix-1)*n1+iz]) );
-
- vz[ix*n1+iz] *= bnd.tapz[ib-ix];
- }
- }
- } /* end elastic scheme */
-
- }
-
- /*********/
- /* Right */
- /*********/
- if (bnd.rig==4) {
-
- if (mod.ischeme <= 2) { /* Acoustic scheme */
-
- /* Vx field */
- ixo = mod.ieXx;
- ixe = mod.ieXx+bnd.ntap;
- izo = mod.ioXz;
- ize = mod.ieXz;
-
- ib = (ixe-bnd.ntap);
-#pragma omp for private(ix,iz)
- for (ix=ixo; ix<ixe; ix++) {
-#pragma ivdep
- for (iz=izo; iz<ize; iz++) {
- vx[ix*n1+iz] -= rox[ix*n1+iz]*(
- c1*(tzz[ix*n1+iz] - tzz[(ix-1)*n1+iz]) +
- c2*(tzz[(ix+1)*n1+iz] - tzz[(ix-2)*n1+iz]));
-
- vx[ix*n1+iz] *= bnd.tapx[ix-ib];
- }
- }
-
- /* Vz field */
- ixo = mod.ieZx;
- ixe = mod.ieZx+bnd.ntap;
- izo = mod.ioZz;
- ize = mod.ieZz;
-
- ib = (ixe-bnd.ntap);
-#pragma omp for private (ix, iz)
- for (ix=ixo; ix<ixe; ix++) {
-#pragma ivdep
- for (iz=izo; iz<ize; iz++) {
- vz[ix*n1+iz] -= roz[ix*n1+iz]*(
- c1*(tzz[ix*n1+iz] - tzz[ix*n1+iz-1]) +
- c2*(tzz[ix*n1+iz+1] - tzz[ix*n1+iz-2]));
-
- vz[ix*n1+iz] *= bnd.tapz[ix-ib];
- }
- }
-
- }
- else { /* Elastic scheme */
-
- /* Vx field */
- ixo = mod.ieXx;
- ixe = mod.ieXx+bnd.ntap;
- izo = mod.ioXz;
- ize = mod.ieXz;
-
- ib = (ixe-bnd.ntap);
-#pragma omp for private(ix,iz)
- for (ix=ixo; ix<ixe; ix++) {
-#pragma ivdep
- for (iz=izo; iz<ize; iz++) {
- vx[ix*n1+iz] -= rox[ix*n1+iz]*(
- c1*(txx[ix*n1+iz] - txx[(ix-1)*n1+iz] +
- txz[ix*n1+iz+1] - txz[ix*n1+iz]) +
- c2*(txx[(ix+1)*n1+iz] - txx[(ix-2)*n1+iz] +
- txz[ix*n1+iz+2] - txz[ix*n1+iz-1]) );
-
- vx[ix*n1+iz] *= bnd.tapx[ix-ib];
- }
- }
-
- /* Vz field */
- ixo = mod.ieZx;
- ixe = mod.ieZx+bnd.ntap;
- izo = mod.ioZz;
- ize = mod.ieZz;
- ib = (ixe-bnd.ntap);
-#pragma omp for private (ix, iz)
- for (ix=ixo; ix<ixe; ix++) {
-#pragma ivdep
- for (iz=izo; iz<ize; iz++) {
- vz[ix*n1+iz] -= roz[ix*n1+iz]*(
- c1*(tzz[ix*n1+iz] - tzz[ix*n1+iz-1] +
- txz[(ix+1)*n1+iz] - txz[ix*n1+iz]) +
- c2*(tzz[ix*n1+iz+1] - tzz[ix*n1+iz-2] +
- txz[(ix+2)*n1+iz] - txz[(ix-1)*n1+iz]) );
-
- vz[ix*n1+iz] *= bnd.tapz[ix-ib];
- }
- }
-/*
- for (ix=ixo-5; ix<ixo+5; ix++) {
- for (iz=0; iz<5; iz++) {
- fprintf(stderr,"edge ix=%d iz=%d vz=%e roz=%e tzz=%e txz=%e txx=%e lam=%e l2m=%e\n", ix, iz, vz[ix*n1+iz], roz[ix*n1+iz],
-tzz[ix*n1+iz], txz[ix*n1+iz], txx[ix*n1+iz], lam[ix*n1+iz], l2m[ix*n1+iz]);
- }
- }
-*/
-
- } /* end elastic scheme */
-
- }
-
- if ( (npml != 0) && (itime==mod.nt-1) && pml) {
-#pragma omp master
-{
- if (allocated) {
- free(Vxpml);
- free(Vzpml);
- free(sigmu);
- free(RA);
- allocated=0;
- }
-}
- }
-
- return 0;
-}
-
-int boundariesV(modPar mod, bndPar bnd, float *vx, float *vz, float *tzz, float *txx, float *txz, float *rox, float *roz, float *l2m, float *lam, float *mul, int itime, int verbose)
-{
-/*********************************************************************
-
- AUTHOR:
- Jan Thorbecke (janth@xs4all.nl)
- The Netherlands
-
-***********************************************************************/
-
- float c1, c2;
- float dp, dvx, dvz;
- int ix, iz, ixs, izs, izp, ib;
- int nx, nz, n1, n2;
- int is0, isrc;
- int ixo, ixe, izo, ize;
- int npml, ipml, pml;
- float kappu, alphu, sigmax, R, a, m, fac, dx, dt;
- float *p;
- static float *Pxpml, *Pzpml, *sigmu, *RA;
- static int allocated=0;
- float Jx, Jz, rho, d;
-
- c1 = 9.0/8.0;
- c2 = -1.0/24.0;
- nx = mod.nx;
- nz = mod.nz;
- n1 = mod.naz;
- n2 = mod.nax;
- dx = mod.dx;
- dt = mod.dt;
- fac = dt/dx;
- if ( (bnd.top==2) || (bnd.bot==2) || (bnd.lef==2) || (bnd.rig==2) ) pml=1;
- else pml=0;
-
-/************************************************************/
-/* PML boundaries for acoustic schemes */
-/* compute all field values in tapered areas */
-/************************************************************/
-
- npml=bnd.npml; /* lenght of pml in grid-points */
- if ( (npml != 0) && (itime==0) && pml) {
-#pragma omp master
-{
- if (allocated) {
- free(Pxpml);
- free(Pzpml);
- free(sigmu);
- free(RA);
- }
- Pxpml = (float *)calloc(2*n1*npml,sizeof(float));
- Pzpml = (float *)calloc(2*n2*npml,sizeof(float));
- sigmu = (float *)calloc(npml,sizeof(float));
- RA = (float *)calloc(npml,sizeof(float));
- allocated = 1;
-
- /* calculate sigmu and RA only once with fixed velocity Cp */
- m=bnd.m; /* scaling order */
- R=bnd.R; /* the theoretical reflection coefficient after discretization */
- kappu = 1.0; /* auxiliary attenuation coefficient for small angles */
- alphu=0.0; /* auxiliary attenuation coefficient for low frequencies */
- d = (npml-1)*dx; /* depth of pml */
- /* sigmu attenuation factor representing the loss in the PML depends on the grid position in the PML */
-
- sigmax = ((3.0*mod.cp_min)/(2.0*d))*log(1.0/R);
- for (ib=0; ib<npml; ib++) { /* ib=0 interface between PML and interior */
- a = (float) (ib/(npml-1.0));
- sigmu[ib] = sigmax*pow(a,m);
- RA[ib] = (1.0)/(1.0+0.5*dt*sigmu[ib]);
-// if (verbose>=3) vmess("PML: sigmax=%e cp=%e sigmu[%d]=%e %e\n", sigmax, mod.cp_min, ib, sigmu[ib], a);
- }
-}
- }
-
-#pragma omp barrier
- if (mod.ischeme == 1 && pml) { /* Acoustic scheme PML's */
- p = tzz; /* Tzz array pointer points to P-field */
-
- if (bnd.top==2) mod.ioPz += bnd.npml;
- if (bnd.bot==2) mod.iePz -= bnd.npml;
- if (bnd.lef==2) mod.ioPx += bnd.npml;
- if (bnd.rig==2) mod.iePx -= bnd.npml;
-
- /* PML top P */
- if (bnd.top == 2) {
- /* PML top P-Vz-component */
-#pragma omp for private (ix, iz, dvx, dvz, Jz, ipml)
- for (ix=mod.ioPx; ix<mod.iePx; ix++) {
- ipml = npml-1;
- for (iz=mod.ioPz-npml; iz<mod.ioPz; iz++) {
- dvx = c1*(vx[(ix+1)*n1+iz] - vx[ix*n1+iz]) +
- c2*(vx[(ix+2)*n1+iz] - vx[(ix-1)*n1+iz]);
- dvz = c1*(vz[ix*n1+iz+1] - vz[ix*n1+iz]) +
- c2*(vz[ix*n1+iz+2] - vz[ix*n1+iz-1]);
- Jz = RA[ipml]*dvz - RA[ipml]*dt*Pzpml[ix*npml+ipml];
- Pzpml[ix*npml+ipml] += sigmu[ipml]*Jz;
- p[ix*n1+iz] -= l2m[ix*n1+iz]*(Jz+dvx);
- ipml--;
- }
- }
- }
-
- /* PML left P */
- if (bnd.lef == 2) {
- /* PML left P-Vx-component */
-#pragma omp for private (ix, iz, dvx, dvz, Jx, ipml)
- for (iz=mod.ioPz; iz<mod.iePz; iz++) {
- ipml = npml-1;
- for (ix=mod.ioPx-npml; ix<mod.ioPx; ix++) {
- dvx = c1*(vx[(ix+1)*n1+iz] - vx[ix*n1+iz]) +
- c2*(vx[(ix+2)*n1+iz] - vx[(ix-1)*n1+iz]);
- dvz = c1*(vz[ix*n1+iz+1] - vz[ix*n1+iz]) +
- c2*(vz[ix*n1+iz+2] - vz[ix*n1+iz-1]);
- Jx = RA[ipml]*dvx - RA[ipml]*dt*Pxpml[iz*npml+ipml];
- Pxpml[iz*npml+ipml] += sigmu[ipml]*Jx;
- p[ix*n1+iz] -= l2m[ix*n1+iz]*(Jx+dvz);
- ipml--;
- }
- }
- }
-
- /* PML corner left-top P */
- if (bnd.lef == 2 && bnd.top == 2) {
- /* PML left P-Vx-component */
-#pragma omp for private (ix, iz, dvx, Jx, ipml)
- for (iz=mod.ioPz-npml; iz<mod.ioPz; iz++) {
- ipml = npml-1;
- for (ix=mod.ioPx-npml; ix<mod.ioPx; ix++) {
- dvx = c1*(vx[(ix+1)*n1+iz] - vx[ix*n1+iz]) +
- c2*(vx[(ix+2)*n1+iz] - vx[(ix-1)*n1+iz]);
- Jx = RA[ipml]*dvx - RA[ipml]*dt*Pxpml[iz*npml+ipml];
- Pxpml[iz*npml+ipml] += sigmu[ipml]*Jx;
- p[ix*n1+iz] -= l2m[ix*n1+iz]*(Jx);
- ipml--;
- }
- }
- /* PML top P-Vz-component */
-#pragma omp for private (ix, iz, dvz, Jz, ipml)
- for (ix=mod.ioPx-npml; ix<mod.ioPx; ix++) {
- ipml = npml-1;
- for (iz=mod.ioPz-npml; iz<mod.ioPz; iz++) {
- dvz = c1*(vz[ix*n1+iz+1] - vz[ix*n1+iz]) +
- c2*(vz[ix*n1+iz+2] - vz[ix*n1+iz-1]);
- Jz = RA[ipml]*dvz - RA[ipml]*dt*Pzpml[ix*npml+ipml];
- Pzpml[ix*npml+ipml] += sigmu[ipml]*Jz;
- p[ix*n1+iz] -= l2m[ix*n1+iz]*(Jz);
- ipml--;
- }
- }
- }
-
- /* PML right P */
- if (bnd.rig == 2) {
- /* PML right P Vx-component */
-#pragma omp for private (ix, iz, dvx, dvz, Jx, ipml)
- for (iz=mod.ioPz; iz<mod.iePz; iz++) {
- ipml = 0;
- for (ix=mod.iePx; ix<mod.iePx+npml; ix++) {
- dvx = c1*(vx[(ix+1)*n1+iz] - vx[ix*n1+iz]) +
- c2*(vx[(ix+2)*n1+iz] - vx[(ix-1)*n1+iz]);
- dvz = c1*(vz[ix*n1+iz+1] - vz[ix*n1+iz]) +
- c2*(vz[ix*n1+iz+2] - vz[ix*n1+iz-1]);
- Jx = RA[ipml]*dvx - RA[ipml]*dt*Pxpml[n1*npml+iz*npml+ipml];
- Pxpml[n1*npml+iz*npml+ipml] += sigmu[ipml]*Jx;
- p[ix*n1+iz] -= l2m[ix*n1+iz]*(Jx+dvz);
- ipml++;
- }
- }
- }
-
- /* PML corner right-top P */
- if (bnd.rig == 2 && bnd.top == 2) {
- /* PML right P Vx-component */
-#pragma omp for private (ix, iz, dvx, Jx, ipml)
- for (iz=mod.ioPz-npml; iz<mod.ioPz; iz++) {
- ipml = 0;
- for (ix=mod.iePx; ix<mod.iePx+npml; ix++) {
- dvx = c1*(vx[(ix+1)*n1+iz] - vx[ix*n1+iz]) +
- c2*(vx[(ix+2)*n1+iz] - vx[(ix-1)*n1+iz]);
- Jx = RA[ipml]*dvx - RA[ipml]*dt*Pxpml[n1*npml+iz*npml+ipml];
- Pxpml[n1*npml+iz*npml+ipml] += sigmu[ipml]*Jx;
- p[ix*n1+iz] -= l2m[ix*n1+iz]*(Jx);
- ipml++;
- }
- }
- /* PML top P-Vz-component */
-#pragma omp for private (ix, iz, dvz, Jz, ipml)
- for (ix=mod.iePx; ix<mod.iePx+npml; ix++) {
- ipml = npml-1;
- for (iz=mod.ioPz-npml; iz<mod.ioPz; iz++) {
- dvz = c1*(vz[ix*n1+iz+1] - vz[ix*n1+iz]) +
- c2*(vz[ix*n1+iz+2] - vz[ix*n1+iz-1]);
- Jz = RA[ipml]*dvz - RA[ipml]*dt*Pzpml[ix*npml+ipml];
- Pzpml[ix*npml+ipml] += sigmu[ipml]*Jz;
- p[ix*n1+iz] -= l2m[ix*n1+iz]*(Jz);
- ipml--;
- }
- }
- }
-
- /* PML bottom P */
- if (bnd.bot == 2) {
- /* PML bottom P Vz-component */
-#pragma omp for private (ix, iz, dvx, dvz, Jz, ipml)
- for (ix=mod.ioPx; ix<mod.iePx; ix++) {
- ipml = 0;
- for (iz=mod.iePz; iz<mod.iePz+npml; iz++) {
- dvx = c1*(vx[(ix+1)*n1+iz] - vx[ix*n1+iz]) +
- c2*(vx[(ix+2)*n1+iz] - vx[(ix-1)*n1+iz]);
- dvz = c1*(vz[ix*n1+iz+1] - vz[ix*n1+iz]) +
- c2*(vz[ix*n1+iz+2] - vz[ix*n1+iz-1]);
- Jz = RA[ipml]*dvz - RA[ipml]*dt*Pzpml[n2*npml+ix*npml+ipml];
- Pzpml[n2*npml+ix*npml+ipml] += sigmu[ipml]*Jz;
- p[ix*n1+iz] -= l2m[ix*n1+iz]*(Jz+dvx);
- ipml++;
- }
- }
- }
-
- /* PML corner bottom-right P */
- if (bnd.bot == 2 && bnd.rig == 2) {
- /* PML bottom P Vz-component */
-#pragma omp for private (ix, iz, dvz, Jz, ipml)
- for (ix=mod.iePx; ix<mod.iePx+npml; ix++) {
- ipml = 0;
- for (iz=mod.iePz; iz<mod.iePz+npml; iz++) {
- dvz = c1*(vz[ix*n1+iz+1] - vz[ix*n1+iz]) +
- c2*(vz[ix*n1+iz+2] - vz[ix*n1+iz-1]);
- Jz = RA[ipml]*dvz - RA[ipml]*dt*Pzpml[n2*npml+ix*npml+ipml];
- Pzpml[n2*npml+ix*npml+ipml] += sigmu[ipml]*Jz;
- p[ix*n1+iz] -= l2m[ix*n1+iz]*(Jz);
- ipml++;
- }
- }
- /* PML right P Vx-component */
-#pragma omp for private (ix, iz, dvx, Jx, ipml)
- for (iz=mod.iePz; iz<mod.iePz+npml; iz++) {
- ipml = 0;
- for (ix=mod.iePx; ix<mod.iePx+npml; ix++) {
- dvx = c1*(vx[(ix+1)*n1+iz] - vx[ix*n1+iz]) +
- c2*(vx[(ix+2)*n1+iz] - vx[(ix-1)*n1+iz]);
- Jx = RA[ipml]*dvx - RA[ipml]*dt*Pxpml[n1*npml+iz*npml+ipml];
- Pxpml[n1*npml+iz*npml+ipml] += sigmu[ipml]*Jx;
- p[ix*n1+iz] -= l2m[ix*n1+iz]*(Jx);
- //p[ix*n1+iz] -= l2m[ix*n1+iz]*(dvx);
- ipml++;
- }
- }
- }
-
- /* PML corner left-bottom P */
- if (bnd.bot == 2 && bnd.lef == 2) {
- /* PML bottom P Vz-component */
-#pragma omp for private (ix, iz, dvz, Jz, ipml)
- for (ix=mod.ioPx-npml; ix<mod.ioPx; ix++) {
- ipml = 0;
- for (iz=mod.iePz; iz<mod.iePz+npml; iz++) {
- dvz = c1*(vz[ix*n1+iz+1] - vz[ix*n1+iz]) +
- c2*(vz[ix*n1+iz+2] - vz[ix*n1+iz-1]);
- Jz = RA[ipml]*dvz - RA[ipml]*dt*Pzpml[n2*npml+ix*npml+ipml];
- Pzpml[n2*npml+ix*npml+ipml] += sigmu[ipml]*Jz;
- p[ix*n1+iz] -= l2m[ix*n1+iz]*(Jz);
- ipml++;
- }
- }
- /* PML left P Vx-component */
-#pragma omp for private (ix, iz, dvx, Jx, ipml)
- for (iz=mod.iePz; iz<mod.iePz+npml; iz++) {
- ipml = npml-1;
- for (ix=mod.ioPx-npml; ix<mod.ioPx; ix++) {
- dvx = c1*(vx[(ix+1)*n1+iz] - vx[ix*n1+iz]) +
- c2*(vx[(ix+2)*n1+iz] - vx[(ix-1)*n1+iz]);
- Jx = RA[ipml]*dvx - RA[ipml]*dt*Pxpml[iz*npml+ipml];
- Pxpml[iz*npml+ipml] += sigmu[ipml]*Jx;
- p[ix*n1+iz] -= l2m[ix*n1+iz]*(Jx);
- ipml--;
- }
- }
- }
- if (bnd.top==2) mod.ioPz -= bnd.npml;
- if (bnd.bot==2) mod.iePz += bnd.npml;
- if (bnd.lef==2) mod.ioPx -= bnd.npml;
- if (bnd.rig==2) mod.iePx += bnd.npml;
-
- } /* end acoustic PML */
-
-
-
-/****************************************************************/
-/* Free surface: calculate free surface conditions for stresses */
-/****************************************************************/
-
-
- ixo = mod.ioPx;
- ixe = mod.iePx;
- izo = mod.ioPz;
- ize = mod.iePz;
-
- if (mod.ischeme <= 2) { /* Acoustic scheme */
- if (bnd.top==1) { /* free surface at top */
-#pragma omp for private (ix) nowait
- for (ix=mod.ioPx; ix<mod.iePx; ix++) {
- iz = bnd.surface[ix];
- tzz[ix*n1+iz] = 0.0;
- //vz[ix*n1+iz] = -vz[ix*n1+iz+1];
- //vz[ix*n1+iz-1] = -vz[ix*n1+iz+2];
-
- }
- }
- if (bnd.rig==1) { /* free surface at right */
-#pragma omp for private (iz) nowait
- for (iz=mod.ioPz; iz<mod.iePz; iz++) {
- tzz[(mod.iePx-1)*n1+iz] = 0.0;
- }
- }
- if (bnd.bot==1) { /* free surface at bottom */
-#pragma omp for private (ix) nowait
- for (ix=mod.ioPx; ix<mod.iePx; ix++) {
- tzz[ix*n1+mod.iePz-1] = 0.0;
- }
- }
- if (bnd.lef==1) { /* free surface at left */
-#pragma omp for private (iz) nowait
- for (iz=mod.ioPz; iz<mod.iePz; iz++) {
- tzz[(mod.ioPx-1)*n1+iz] = 0.0;
- }
- }
- }
- else { /* Elastic scheme */
-/* The implementation for a topgraphy surface is not yet correct */
-
- /* Free surface: calculate free surface conditions for stresses
- * Conditions (for upper boundary):
- * 1. Tzz = 0
- * 2. Txz = 0
- * 3. Txx: remove term with dVz/dz, computed in e2/e4 routines
- * and add extra term with dVx/dx,
- * corresponding to free-surface condition for Txx.
- * In this way, dVz/dz is not needed in computing Txx
- * on the upper stress free boundary. Other boundaries
- * are treated similar.
- * For the 4th order schemes, the whole virtual boundary
- * must be taken into account in the removal terms,
- * because the algorithm sets
- * velocities on this boundary!
- *
- * Compute the velocities on the virtual boundary to make interpolation
- * possible for receivers.
- */
-
- if (bnd.top==1) { /* free surface at top */
- izp = bnd.surface[ixo];
-#pragma omp for private (ix, iz)
- for (ix=mod.ioPx; ix<mod.iePx; ix++) {
- iz = bnd.surface[ix];
- if ( izp==iz ) {
- /* clear normal pressure */
- tzz[ix*n1+iz] = 0.0;
-
- /* This update to Vz might become unstable (2nd order scheme) */
-// vz[ix*n1+iz] = vz[ix*n1+iz+1] - (vx[(ix+1)*n1+iz]-vx[ix*n1+iz])*
-// lam[ix*n1+iz]/l2m[ix*n1+iz];
- }
- izp=iz;
- }
-
- izp = bnd.surface[ixo];
-#pragma omp for private (ix, iz)
- for (ix=mod.ioTx; ix<mod.ieTx; ix++) {
- iz = bnd.surface[ix];
- if ( izp==iz ) {
- /* assure that txz=0 on boundary by filling virtual boundary */
- txz[ix*n1+iz] = -txz[ix*n1+iz+1];
- /* extra line of txz has to be copied */
- txz[ix*n1+iz-1] = -txz[ix*n1+iz+2];
- }
- izp=iz;
- }
-
- /* calculate txx on top stress-free boundary */
- izp = bnd.surface[ixo];
-#pragma omp for private (ix, iz, dp, dvx)
- for (ix=mod.ioPx; ix<mod.iePx; ix++) {
- iz = bnd.surface[ix];
- if ( izp==iz ) {
- if (l2m[ix*n1+iz]!=0.0) {
- dp = l2m[ix*n1+iz]-lam[ix*n1+iz]*lam[ix*n1+iz]/l2m[ix*n1+iz];
- dvx = c1*(vx[(ix+1)*n1+iz] - vx[(ix)*n1+iz]) +
- c2*(vx[(ix+2)*n1+iz] - vx[(ix-1)*n1+iz]);
- txx[ix*n1+iz] = -dvx*dp;
- }
- }
- izp=iz;
- }
-
- /* if surface has also left or right edges */
- izp = bnd.surface[ixo];
-#pragma omp for private (ix, iz, dp, dvz)
- for (ix=mod.ioPx+1; ix<mod.iePx; ix++) {
- iz = bnd.surface[ix-1];
- if ( izp < iz ) { /* right boundary */
- /* clear normal pressure */
- txx[ix*n1+iz] = 0.0;
- if ( (iz-izp) >= 2 ) { /* VR point */
- /* assure that txz=0 on boundary */
- txz[(ix+1)*n1+iz] = -txz[ix*n1+iz];
- txz[(ix+2)*n1+iz] = -txz[(ix-1)*n1+iz] ;
- /* calculate tzz on right stress-free boundary */
- if (l2m[ix*n1+iz]!=0.0) {
- dvz = c1*(vz[ix*n1+iz+1] - vz[ix*n1+iz]) +
- c2*(vz[ix*n1+iz+2] - vz[ix*n1+iz-1]);
- dp = l2m[ix*n1+iz]-lam[ix*n1+iz]*lam[ix*n1+iz]/l2m[ix*n1+iz];
- tzz[ix*n1+iz] = -dvz*dp;
- }
- }
- else {
- if (izp) { /* IR point */
-// txz[ix*n1+iz] = -txz[ix*n1+iz+1] ;
-// txz[ix*n1+iz-1] = -txz[ix*n1+iz+2];
-// txz[(ix+1)*n1+iz] = -txz[ix*n1+iz];
-// txz[(ix+2)*n1+iz] = -txz[(ix-1)*n1+iz] ;
-// tzz[ix*n1+iz] = 0.0;
- }
- else { /* OR point */
-// txz[(ix-1)*n1+iz] = 0.0;
-// txz[(ix+1)*n1+iz] = -txz[ix*n1+iz];
-// txz[(ix+2)*n1+iz] = -txz[(ix-1)*n1+iz] ;
-// if (l2m[ix*n1+iz]!=0.0) {
-// vz[ix*n1+iz] = vz[ix*n1+iz+1] - (vx[(ix+1)*n1+iz]-vx[ix*n1+iz])*
-// lam[ix*n1+iz]/l2m[ix*n1+iz];
-// }
- }
- }
- } /* end if right */
- if ( izp > iz ) { /* left boundary */
- /* clear normal pressure */
- txx[ix*n1+iz] = 0.0;
- /* assure that txz=0 on boundary */
- txz[(ix-1)*n1+iz] = -txz[ix*n1+iz];
- /* extra line of txz has to be copied */
- txz[(ix-2)*n1+iz] = -txz[(ix+1)*n1+iz] ;
- /* calculate tzz on left stress-free boundary */
- dvz = c1*(vz[ix*n1+iz+1] - vz[ix*n1+iz]) +
- c2*(vz[ix*n1+iz+2] - vz[ix*n1+iz-1]);
- if (l2m[ix*n1+iz]!=0.0) {
- dp = l2m[ix*n1+iz]-lam[ix*n1+iz]*lam[ix*n1+iz]/l2m[ix*n1+iz];
- tzz[ix*n1+iz] = -dvz*dp;
- }
- } /* end if left */
- izp=iz;
-// fprintf(stderr,"V4 ix=2123 iz=1 tzz=%e\n", tzz[2123*n1+1]);
- // izp=bnd.surface[MAX(ix-2,0)];;
- } /* end ix loop */
- }
-
-
- if (bnd.rig==1) { /* free surface at right */
- ix = mod.iePx;
-#pragma omp for private (iz)
- for (iz=mod.ioPz; iz<mod.iePz; iz++) {
- /* clear normal pressure */
- txx[ix*n1+iz] = 0.0;
- }
-#pragma omp for private (iz)
- for (iz=mod.ioTz; iz<mod.ieTz; iz++) {
- /* assure that txz=0 on boundary by filling virtual boundary */
- txz[(ix+1)*n1+iz] = -txz[(ix)*n1+iz];
- /* extra line of txz has to be copied */
- txz[(ix+2)*n1+iz] = -txz[(ix-1)*n1+iz] ;
- }
- /* calculate tzz on right stress-free boundary */
-#pragma omp for private (iz)
- for (iz=mod.ioPz; iz<mod.iePz; iz++) {
- dvz = c1*(vz[(ix)*n1+iz+1] - vz[(ix)*n1+iz]) +
- c2*(vz[(ix)*n1+iz+2] - vz[(ix)*n1+iz-1]);
- if (l2m[ix*n1+iz]!=0.0) {
- dp = l2m[(ix)*n1+iz]-lam[(ix)*n1+iz]*lam[(ix)*n1+iz]/l2m[(ix)*n1+iz];
- tzz[(ix)*n1+iz] = -dvz*dp;
- }
- }
- }
-
-
- if (bnd.bot==1) { /* free surface at bottom */
- iz = mod.iePz;
-#pragma omp for private (ix)
- for (ix=mod.ioPx; ix<mod.iePx; ix++) {
- /* clear normal pressure */
- tzz[ix*n1+iz] = 0.0;
- }
-#pragma omp for private (ix)
- for (ix=mod.ioTx; ix<mod.ieTx; ix++) {
- /* assure that txz=0 on boundary by filling virtual boundary */
- txz[ix*n1+iz+1] = -txz[ix*n1+iz];
- /* extra line of txz has to be copied */
- txz[ix*n1+iz+2] = -txz[ix*n1+iz-1];
- }
- /* calculate txx on bottom stress-free boundary */
-#pragma omp for private (ix)
- for (ix=mod.ioPx; ix<mod.iePx; ix++) {
- dvx = c1*(vx[(ix+1)*n1+iz] - vx[ix*n1+iz]) +
- c2*(vx[(ix+2)*n1+iz] - vx[(ix-1)*n1+iz]);
- if (l2m[ix*n1+iz]!=0.0) {
- dp = l2m[ix*n1+iz]-lam[ix*n1+iz]*lam[ix*n1+iz]/l2m[ix*n1+iz];
- txx[ix*n1+iz] = -dvx*dp;
- }
- }
- }
-
- if (bnd.lef==1) { /* free surface at left */
- ix = mod.ioPx;
-#pragma omp for private (iz)
- for (iz=mod.ioPz; iz<mod.iePz; iz++) {
- /* clear normal pressure */
- txx[ix*n1+iz] = 0.0;
- }
-#pragma omp for private (iz)
- for (iz=mod.ioTz; iz<mod.ieTz; iz++) {
- /* assure that txz=0 on boundary by filling virtual boundary */
- txz[(ix)*n1+iz] = -txz[(ix+1)*n1+iz];
- /* extra line of txz has to be copied */
- txz[(ix-1)*n1+iz] = -txz[(ix+2)*n1+iz] ;
- }
- /* calculate tzz on left stress-free boundary */
-#pragma omp for private (iz)
- for (iz=mod.ioPz; iz<mod.iePz; iz++) {
- dvz = c1*(vz[ix*n1+iz+1] - vz[ix*n1+iz]) +
- c2*(vz[ix*n1+iz+2] - vz[ix*n1+iz-1]);
- if (l2m[ix*n1+iz]!=0.0) {
- dp = l2m[ix*n1+iz]-lam[ix*n1+iz]*lam[ix*n1+iz]/l2m[ix*n1+iz];
- tzz[ix*n1+iz] = -dvz*dp;
- }
- }
- }
- }
-
- if ( (npml != 0) && (itime==mod.nt-1) && pml) {
-#pragma omp master
-{
- if (allocated) {
- free(Pxpml);
- free(Pzpml);
- free(sigmu);
- free(RA);
- allocated=0;
- }
-}
- }
-
- return 0;
-}
diff --git a/fdelmodc3D/boundaries3D.c b/fdelmodc3D/boundaries3D.c
index 3f4f55549582762f00f308d9728eb1dc6a7b3410..01c428fe24898d29d029436c873e41f1b5cba9d3 100644
--- a/fdelmodc3D/boundaries3D.c
+++ b/fdelmodc3D/boundaries3D.c
@@ -6,7 +6,10 @@
void vmess(char *fmt, ...);
-long boundariesP3D(modPar mod, bndPar bnd, float *vx, float *vy, float *vz, float *tzz, float *tyy, float *txx, float *txz, float *txy, float *tyz, float *rox, float *roy, float *roz, float *l2m, float *lam, float *mul, long itime, long verbose)
+long boundariesP3D(modPar mod, bndPar bnd, float *vx, float *vy, float *vz,
+ float *tzz, float *tyy, float *txx, float *txz, float *txy, float *tyz,
+ float *rox, float *roy, float *roz, float *l2m, float *lam, float *mul,
+ long itime, long verbose)
{
/*********************************************************************
@@ -1870,7 +1873,10 @@ long boundariesP3D(modPar mod, bndPar bnd, float *vx, float *vy, float *vz, floa
return 0;
}
-long boundariesV3D(modPar mod, bndPar bnd, float *vx, float *vy, float *vz, float *tzz, float *tyy, float *txx, float *txz, float *txy, float *tyz, float *rox, float *roy, float *roz, float *l2m, float *lam, float *mul, long itime, long verbose)
+long boundariesV3D(modPar mod, bndPar bnd, float *vx, float *vy, float *vz,
+ float *tzz, float *tyy, float *txx, float *txz, float *txy, float *tyz,
+ float *rox, float *roy, float *roz, float *l2m, float *lam, float *mul,
+ long itime, long verbose)
{
/*********************************************************************
diff --git a/fdelmodc3D/defineSource.c b/fdelmodc3D/defineSource.c
deleted file mode 100644
index bc9059c73b518980d35a4b3356796ddaa879b4c4..0000000000000000000000000000000000000000
--- a/fdelmodc3D/defineSource.c
+++ /dev/null
@@ -1,373 +0,0 @@
-#define _FILE_OFFSET_BITS 64
-#define _LARGEFILE_SOURCE
-#define _LARGEFILE64_SOURCE
-
-#include <assert.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <errno.h>
-#include <math.h>
-#include <string.h>
-#include "fdelmodc.h"
-#include "segy.h"
-
-/**
-* Computes, or read from file, the source signature
-*
-* AUTHOR:
-* Jan Thorbecke (janth@xs4all.nl)
-* The Netherlands
-**/
-
-#ifndef COMPLEX
-typedef struct _complexStruct { /* complex number */
- float r,i;
-} complex;
-typedef struct _dcomplexStruct { /* complex number */
- double r,i;
-} dcomplex;
-#endif/* complex */
-
-int optncr(int n);
-void rc1fft(float *rdata, complex *cdata, int n, int sign);
-void cr1fft(complex *cdata, float *rdata, int n, int sign);
-
-int writesufile(char *filename, float *data, int n1, int n2, float f1, float f2, float d1, float d2);
-int writesufilesrcnwav(char *filename, float **src_nwav, wavPar wav, int n1, int n2, float f1, float f2, float d1, float d2);
-float gaussGen();
-float normal(double x,double mu,double sigma);
-int comp (const float *a, const float *b);
-void spline3(float x1, float x2, float z1, float z2, float dzdx1, float dzdx2, float *a, float *b, float *c, float *d);
-int randomWavelet(wavPar wav, srcPar src, float *trace, float tbeg, float tend, int verbose);
-
-/* random number generators */
-double dcmwc4096();
-unsigned long CMWC4096(void);
-unsigned long xorshift(void);
-void seedCMWC4096(void);
-/* #define drand48 dcmwc4096 use for different random number generator */
-
-
-#define MAX(x,y) ((x) > (y) ? (x) : (y))
-#define MIN(x,y) ((x) < (y) ? (x) : (y))
-#define NINT(x) ((int)((x)>0.0?(x)+0.5:(x)-0.5))
-
-int defineSource(wavPar wav, srcPar src, modPar mod, recPar rec, float **src_nwav, int reverse, int verbose)
-{
- FILE *fp;
- size_t nread;
- int optn, nfreq, i, j, k, iwmax, tracesToDo;
- int iw, n1, namp, optnscale, nfreqscale;
- float scl, d1, df, deltom, om, tshift;
- float amp1, amp2, amp3;
- float *trace, maxampl, scale;
- complex *ctrace, tmp;
- segy hdr;
-
- scale = 1.0;
- n1 = wav.ns;
- if (wav.random) { /* initialize random sequence */
- srand48(wav.seed+1);
- seedCMWC4096();
- for (i=0; i<8192; i++) {
- amp1 = dcmwc4096();
- }
-
- }
- else {
-
-/* read first header and last byte to get file size */
-
- fp = fopen( wav.file_src, "r" );
- assert( fp != NULL);
- nread = fread( &hdr, 1, TRCBYTES, fp );
- assert(nread == TRCBYTES);
-
-/* read all traces */
-
- tracesToDo = wav.nx;
- i = 0;
- while (tracesToDo) {
- memset(&src_nwav[i][0],0,wav.nt*sizeof(float));
- nread = fread(&src_nwav[i][0], sizeof(float), hdr.ns, fp);
- assert (nread == hdr.ns);
-
- nread = fread( &hdr, 1, TRCBYTES, fp );
- if (nread==0) break;
- tracesToDo--;
- i++;
- }
- fclose(fp);
- }
-
- optn = optncr(n1);
- nfreq = optn/2 + 1;
- if (wav.nt != wav.ns) {
- vmess("Sampling in wavelet is %e while for modeling is set to %e", wav.ds, mod.dt);
- vmess("Wavelet sampling will be FFT-interpolated to sampling of modeling");
- vmess("file_src Nt=%d sampling after interpolation=%d", wav.ns, wav.nt);
- optnscale = wav.nt;
- nfreqscale = optnscale/2 + 1;
- }
- else {
- optnscale = optn;
- nfreqscale = optnscale/2 + 1;
- }
-// fprintf(stderr,"define S optn=%d ns=%d %e nt=%d %e\n", optn, wav.ns, wav.ds, optnscale, wav.dt);
-
- ctrace = (complex *)calloc(nfreqscale,sizeof(complex));
- trace = (float *)calloc(optnscale,sizeof(float));
-
- df = 1.0/(optn*wav.ds);
- deltom = 2.*M_PI*df;
- scl = 1.0/optn;
- iwmax = nfreq;
-
- for (i=0; i<wav.nx; i++) {
- if (wav.random) {
- randomWavelet(wav, src, &src_nwav[i][0], src.tbeg[i], src.tend[i], verbose);
- }
- else {
- memset(&ctrace[0].r,0,nfreqscale*sizeof(complex));
- memset(&trace[0],0,optnscale*sizeof(float));
- memcpy(&trace[0],&src_nwav[i][0],n1*sizeof(float));
- rc1fft(trace,ctrace,optn,-1);
- /* Scale source from file with -j/w (=1/(jw)) for volume source injections
- no scaling is applied for volume source injection rates */
- if (src.injectionrate==0) {
- for (iw=1;iw<iwmax;iw++) {
- om = 1.0/(deltom*iw);
- tmp.r = om*ctrace[iw].i;
- tmp.i = -om*ctrace[iw].r;
- ctrace[iw].r = tmp.r;
- ctrace[iw].i = tmp.i;
- }
- }
-
- if (src.type < 6) { // shift wavelet with +1/2 DeltaT due to staggered in time
- tshift=-(0.5*rec.skipdt+1.5)*wav.dt;
- for (iw=1;iw<iwmax;iw++) {
- om = deltom*iw*tshift;
- tmp.r = ctrace[iw].r*cos(-om) - ctrace[iw].i*sin(-om);
- tmp.i = ctrace[iw].i*cos(-om) + ctrace[iw].r*sin(-om);
- ctrace[iw].r = tmp.r;
- ctrace[iw].i = tmp.i;
- }
- }
-
- /* zero frequency iw=0 set to 0 if the next sample has amplitude==0*/
- amp1 = sqrt(ctrace[1].r*ctrace[1].r+ctrace[1].i*ctrace[1].i);
- if (amp1 == 0.0) {
- ctrace[0].r = ctrace[0].i = 0.0;
- }
- else { /* stabilization for w=0: extrapolate amplitudes to 0 */
- amp2 = sqrt(ctrace[2].r*ctrace[2].r+ctrace[2].i*ctrace[2].i);
- amp3 = sqrt(ctrace[3].r*ctrace[3].r+ctrace[3].i*ctrace[3].i);
- ctrace[0].r = amp1+(2.0*(amp1-amp2)-(amp2-amp3));
- ctrace[0].i = 0.0;
- if (ctrace[1].r < 0.0) {
- ctrace[0].r *= -1.0;
- }
- }
- for (iw=iwmax;iw<nfreqscale;iw++) {
- ctrace[iw].r = 0.0;
- ctrace[iw].i = 0.0;
- }
-
- memset(&trace[0],0,optnscale*sizeof(float));
- cr1fft(ctrace,trace,optnscale,1);
- /* avoid a (small) spike in the last sample
- this is done to avoid diffraction from last wavelet sample
- which will act as a pulse */
- maxampl=0.0;
- if (reverse) {
- for (j=0; j<wav.nt; j++) {
- src_nwav[i][j] = scl*(trace[wav.nt-j-1]-trace[0]);
- maxampl = MAX(maxampl,fabs(src_nwav[i][j]));
- }
- }
- else {
- for (j=0; j<wav.nt; j++) {
- src_nwav[i][j] = scl*(trace[j]-trace[wav.nt-1]);
- maxampl = MAX(maxampl,fabs(src_nwav[i][j]));
- }
- }
- if (verbose > 3) vmess("Wavelet sampling (FFT-interpolated) done for trace %d", i);
- }
- }
- /* set values smaller than 1e-5 maxampl to zero */
- maxampl *= 1e-5;
- for (i=0; i<wav.nx; i++) {
- for (j=0; j<wav.nt; j++) {
- if (fabs(src_nwav[i][j]) < maxampl) src_nwav[i][j] = 0.0;
- }
- }
- free(ctrace);
- free(trace);
-
-/* use random amplitude gain factor for each source */
- if (src.amplitude > 0.0) {
- namp=wav.nx*10;
- trace = (float *)calloc(2*namp,sizeof(float));
- for (i=0; i<wav.nx; i++) {
- if (src.distribution) {
- scl = gaussGen()*src.amplitude;
- k = (int)MAX(MIN(namp*(scl+5*src.amplitude)/(10*src.amplitude),namp-1),0);
- d1 = 10.0*src.amplitude/(namp-1);
- }
- else {
- scl = (float)(drand48()-0.5)*src.amplitude;
- k = (int)MAX(MIN(namp*(scl+1*src.amplitude)/(2*src.amplitude),namp-1),0);
- d1 = 2.0*src.amplitude/(namp-1);
- }
-
- trace[k] += 1.0;
-/* trace[i] = scl; */
- if (wav.random) n1 = wav.nsamp[i];
- else n1 = wav.nt;
- for (j=0; j<n1; j++) {
- src_nwav[i][j] *= scl;
- }
- }
- if (verbose>2) writesufile("src_ampl.su", trace, namp, 1, -5*src.amplitude, 0.0, d1, 1);
-/*
- qsort(trace,wav.nx,sizeof(float), comp);
- for (i=0; i<wav.nx; i++) {
- scl = trace[i];
- trace[i] = normal(scl, 0.0, src.amplitude);
- }
- if (verbose>2) writesufile("src_ampl.su", trace, wav.nx, 1, -5*src.amplitude, 0.0, d1, 1);
-*/
-
- free(trace);
- }
-
- if (verbose>3) writesufilesrcnwav("src_nwav.su", src_nwav, wav, wav.nt, wav.nx, 0.0, 0.0, wav.dt, 1);
-
-/* set maximum amplitude in source file to 1.0 */
-/*
- assert(maxampl != 0.0);
- scl = wav.dt/(maxampl);
- scl = 1.0/(maxampl);
- for (i=0; i<wav.nx; i++) {
- for (j=0; j<n1; j++) {
- src_nwav[i*n1+j] *= scl;
- }
- }
-*/
-
- return 0;
-}
-
-
-int randomWavelet(wavPar wav, srcPar src, float *trace, float tbeg, float tend, int verbose)
-{
- int optn, nfreq, j, iwmax;
- int iw, n1, itbeg, itmax, nsmth;
- float df, amp1;
- float *rtrace;
- float x1, x2, z1, z2, dzdx1, dzdx2, a, b, c, d, t;
- complex *ctrace;
-
- n1 = wav.nt; /* this is set to the maximum length (tlength/dt) */
-
- optn = optncr(2*n1);
- nfreq = optn/2 + 1;
- ctrace = (complex *)calloc(nfreq,sizeof(complex));
- rtrace = (float *)calloc(optn,sizeof(float));
-
- df = 1.0/(optn*wav.dt);
-
- iwmax = MIN(NINT(wav.fmax/df),nfreq);
-
- for (iw=1;iw<iwmax;iw++) {
- ctrace[iw].r = (float)(drand48()-0.5);
- ctrace[iw].i = (float)(drand48()-0.5);
- }
- for (iw=iwmax;iw<nfreq;iw++) {
- ctrace[iw].r = 0.0;
- ctrace[iw].i = 0.0;
- }
- cr1fft(ctrace,rtrace,optn,1);
-
- /* find first zero crossing in wavelet */
- amp1 = rtrace[0];
- j = 1;
- if (amp1 < 0.0) {
- while (rtrace[j] < 0.0) j++;
- }
- else {
- while (rtrace[j] > 0.0) j++;
- }
- itbeg = j;
-
- /* find last zero crossing in wavelet */
-// itmax = itbeg+MIN(NINT((tend-tbeg)/wav.dt),n1);
- itmax = MIN(NINT(itbeg+(tend-tbeg)/wav.dt),n1);
-
- amp1 = rtrace[itmax-1];
- j = itmax;
- if (amp1 < 0.0) {
- while (rtrace[j] < 0.0 && j>itbeg) j--;
- }
- else {
- while (rtrace[j] > 0.0 && j>itbeg) j--;
- }
- itmax = j;
-
- /* make smooth transitions to zero aamplitude */
- nsmth=MIN(10,itmax);
- x1 = 0.0;
- z1 = 0.0;
- dzdx1 = 0.0;
- x2 = nsmth;
- z2 = rtrace[itbeg+nsmth];
-// dzdx2 = (rtrace[itbeg+(nsmth+1)]-rtrace[itbeg+(nsmth-1)])/(2.0);
- dzdx2 = (rtrace[itbeg+nsmth-2]-8.0*rtrace[itbeg+nsmth-1]+
- 8.0*rtrace[itbeg+nsmth+1]-rtrace[itbeg+nsmth+2])/(12.0);
- spline3(x1, x2, z1, z2, dzdx1, dzdx2, &a, &b, &c, &d);
- for (j=0; j<nsmth; j++) {
- t = j;
- rtrace[itbeg+j] = a*t*t*t+b*t*t+c*t+d;
- }
-
- x1 = 0.0;
- z1 = rtrace[itmax-nsmth];
-// dzdx1 = (rtrace[itmax-(nsmth-1)]-rtrace[itmax-(nsmth+1)])/(2.0);
- dzdx1 = (rtrace[itmax-nsmth-2]-8.0*rtrace[itmax-nsmth-1]+
- 8.0*rtrace[itmax-nsmth+1]-rtrace[itmax-nsmth+2])/(12.0);
- x2 = nsmth;
- z2 = 0.0;
- dzdx2 = 0.0;
-
-// fprintf(stderr,"x1=%f z1=%f d=%f x2=%f, z2=%f d=%f\n",x1,z1,dzdx1,x2,z2,dzdx2);
- spline3(x1, x2, z1, z2, dzdx1, dzdx2, &a, &b, &c, &d);
- for (j=0; j<nsmth; j++) {
- t = j;
- rtrace[itmax-nsmth+j] = a*t*t*t+b*t*t+c*t+d;
-// fprintf(stderr,"a=%f b=%f c=%f d=%f rtrace%d=%f \n",a,b,c,d,j,rtrace[itmax-nsmth+j]);
- }
-
- for (j=itbeg; j<itmax; j++) trace[j-itbeg] = rtrace[j];
-
- free(ctrace);
- free(rtrace);
-
- return 0;
-}
-
-float normal(double x,double mu,double sigma)
-{
- return (float)(1.0/(2.0*M_PI*sigma*sigma))*exp(-1.0*(((x-mu)*(x-mu))/(2.0*sigma*sigma)) );
-}
-
-int comp (const float *a, const float *b)
-{
- if (*a==*b)
- return 0;
- else
- if (*a < *b)
- return -1;
- else
- return 1;
-}
diff --git a/fdelmodc3D/defineSource3D.c b/fdelmodc3D/defineSource3D.c
index 3f5d89ab290db022a87a2a151c170270b0898f77..4caccfa6a765d85073418b2270d7987d15e50377 100644
--- a/fdelmodc3D/defineSource3D.c
+++ b/fdelmodc3D/defineSource3D.c
@@ -32,8 +32,10 @@ long loptncr(long n);
void rc1fft(float *rdata, complex *cdata, int n, int sign);
void cr1fft(complex *cdata, float *rdata, int n, int sign);
-long writesufile3D(char *filename, float *data, long n1, long n2, float f1, float f2, float d1, float d2);
-long writesufilesrcnwav3D(char *filename, float **src_nwav, wavPar wav, long n1, long n2, float f1, float f2, float d1, float d2);
+long writesufile3D(char *filename, float *data, long n1, long n2,
+ float f1, float f2, float d1, float d2);
+long writesufilesrcnwav3D(char *filename, float **src_nwav, wavPar wav, long n1, long n2,
+ float f1, float f2, float d1, float d2);
float gaussGen();
float normal(double x,double mu,double sigma);
long comp (const float *a, const float *b);
@@ -239,7 +241,7 @@ long defineSource3D(wavPar wav, srcPar src, modPar mod, recPar rec, float **src_
}
-long randomWavelet3D(wavPar wav, srcPar src, float *trace, float tbeg, float tend, long verbose)
+long randomWavelet(wavPar wav, srcPar src, float *trace, float tbeg, float tend, long verbose)
{
long optn, nfreq, j, iwmax;
long iw, n1, itbeg, itmax, nsmth;
diff --git a/fdelmodc3D/elastic4.c b/fdelmodc3D/elastic4.c
deleted file mode 100644
index bfaee6e6780cff467a1a910ffb5c8524e0845485..0000000000000000000000000000000000000000
--- a/fdelmodc3D/elastic4.c
+++ /dev/null
@@ -1,158 +0,0 @@
-#include<stdlib.h>
-#include<stdio.h>
-#include<math.h>
-#include<assert.h>
-#include"fdelmodc.h"
-
-#define MAX(x,y) ((x) > (y) ? (x) : (y))
-
-int applySource(modPar mod, srcPar src, wavPar wav, bndPar bnd, int itime, int ixsrc, int izsrc, float *vx, float *vz, float *tzz,
-float *txx, float *txz, float *rox, float *roz, float *l2m, float **src_nwav, int verbose);
-
-int storeSourceOnSurface(modPar mod, srcPar src, bndPar bnd, int ixsrc, int izsrc, float *vx, float *vz, float *tzz, float *txx, float *txz, int verbose);
-
-int reStoreSourceOnSurface(modPar mod, srcPar src, bndPar bnd, int ixsrc, int izsrc, float *vx, float *vz, float *tzz, float *txx, float *txz, int verbose);
-
-int boundariesP(modPar mod, bndPar bnd, float *vx, float *vz, float *tzz, float *txx, float *txz, float *rox, float *roz, float *l2m, float *lam, float *mul, int itime, int verbose);
-
-int boundariesV(modPar mod, bndPar bnd, float *vx, float *vz, float *tzz, float *txx, float *txz, float *rox, float *roz, float *l2m, float *lam, float *mul, int itime, int verbose);
-
-int elastic4(modPar mod, srcPar src, wavPar wav, bndPar bnd, int itime, int ixsrc, int izsrc, float **src_nwav, float *vx,
-float *vz, float *tzz, float *txx, float *txz, float *rox, float *roz, float
-*l2m, float *lam, float *mul, int verbose)
-{
-/*********************************************************************
- COMPUTATIONAL OVERVIEW OF THE 4th ORDER STAGGERED GRID:
-
- The captial symbols T (=Txx,Tzz) Txz,Vx,Vz represent the actual grid
- The indices ix,iz are related to the T grid, so the capital T
- symbols represent the actual modelled grid.
-
- one cel (iz,ix)
- |
- V extra column of vx,txz
- |
- ------- V
- | txz vz| txz vz txz vz txz vz txz vz txz vz txz
- | |
- | vx t | vx t vx t vx t vx t vx t vx
- -------
- txz vz txz vz txz vz txz vz txz vz txz vz txz
-
- vx t vx T---Vx--T---Vx--T---Vx--T vx t vx
- | | | | | | |
- txz vz txz Vz--Txz-Vz--Txz-Vz Txz-Vz txz vz txz
- | | | | | | |
- vx t vx T---Vx--T---Vx--T---Vx--T vx t vx
- | | | | | | |
- txz vz txz Vz Txz-Vz Txz-Vz Txz-Vz txz vz txz
- | | | | | | |
- vx t vx T---Vx--T---Vx--T---Vx--T vx t vx
- | | | | | | |
- txz vz txz Vz Txz-Vz Txz-Vz Txz-Vz txz vz txz
- | | | | | | |
- vx t vx T---Vx--T---Vx--T---Vx--T vx t vx
-
- txz vz txz vz txz vz txz vz txz vz txz vz txz
-
- vx t vx t vx t vx t vx t vx t vx
-
- txz vz txz vz txz vz txz vz txz vz txz vz txz <--|
- |
- extra row of txz/vz |
-
- AUTHOR:
- Jan Thorbecke (janth@xs4all.nl)
- The Netherlands
-
-***********************************************************************/
-
- float c1, c2;
- float dvx, dvz;
- int ix, iz;
- int n1;
-
- c1 = 9.0/8.0;
- c2 = -1.0/24.0;
- n1 = mod.naz;
-
- /* calculate vx for all grid points except on the virtual boundary*/
-#pragma omp for private (ix, iz) nowait schedule(guided,1)
- for (ix=mod.ioXx; ix<mod.ieXx; ix++) {
-#pragma ivdep
- for (iz=mod.ioXz; iz<mod.ieXz; iz++) {
- vx[ix*n1+iz] -= rox[ix*n1+iz]*(
- c1*(txx[ix*n1+iz] - txx[(ix-1)*n1+iz] +
- txz[ix*n1+iz+1] - txz[ix*n1+iz]) +
- c2*(txx[(ix+1)*n1+iz] - txx[(ix-2)*n1+iz] +
- txz[ix*n1+iz+2] - txz[ix*n1+iz-1]) );
- }
- }
-
- /* calculate vz for all grid points except on the virtual boundary */
-#pragma omp for private (ix, iz) schedule(guided,1)
- for (ix=mod.ioZx; ix<mod.ieZx; ix++) {
-#pragma ivdep
- for (iz=mod.ioZz; iz<mod.ieZz; iz++) {
- vz[ix*n1+iz] -= roz[ix*n1+iz]*(
- c1*(tzz[ix*n1+iz] - tzz[ix*n1+iz-1] +
- txz[(ix+1)*n1+iz] - txz[ix*n1+iz]) +
- c2*(tzz[ix*n1+iz+1] - tzz[ix*n1+iz-2] +
- txz[(ix+2)*n1+iz] - txz[(ix-1)*n1+iz]) );
- }
- }
-
- /* Add force source */
- if (src.type > 5) {
- applySource(mod, src, wav, bnd, itime, ixsrc, izsrc, vx, vz, tzz, txx, txz, rox, roz, l2m, src_nwav, verbose);
- }
-
-
- /* boundary condition clears velocities on boundaries */
- boundariesP(mod, bnd, vx, vz, tzz, txx, txz, rox, roz, l2m, lam, mul, itime, verbose);
-
- /* calculate Txx/tzz for all grid points except on the virtual boundary */
-#pragma omp for private (ix, iz, dvx, dvz) nowait schedule(guided,1)
- for (ix=mod.ioPx; ix<mod.iePx; ix++) {
-#pragma ivdep
- for (iz=mod.ioPz; iz<mod.iePz; iz++) {
- dvx = c1*(vx[(ix+1)*n1+iz] - vx[ix*n1+iz]) +
- c2*(vx[(ix+2)*n1+iz] - vx[(ix-1)*n1+iz]);
- dvz = c1*(vz[ix*n1+iz+1] - vz[ix*n1+iz]) +
- c2*(vz[ix*n1+iz+2] - vz[ix*n1+iz-1]);
- txx[ix*n1+iz] -= l2m[ix*n1+iz]*dvx + lam[ix*n1+iz]*dvz;
- tzz[ix*n1+iz] -= l2m[ix*n1+iz]*dvz + lam[ix*n1+iz]*dvx;
- }
- }
-
-
-
- /* calculate Txz for all grid points except on the virtual boundary */
-#pragma omp for private (ix, iz) schedule(guided,1)
- for (ix=mod.ioTx; ix<mod.ieTx; ix++) {
-#pragma ivdep
- for (iz=mod.ioTz; iz<mod.ieTz; iz++) {
- txz[ix*n1+iz] -= mul[ix*n1+iz]*(
- c1*(vx[ix*n1+iz] - vx[ix*n1+iz-1] +
- vz[ix*n1+iz] - vz[(ix-1)*n1+iz]) +
- c2*(vx[ix*n1+iz+1] - vx[ix*n1+iz-2] +
- vz[(ix+1)*n1+iz] - vz[(ix-2)*n1+iz]) );
- }
- }
-
- /* Add stress source */
- if (src.type < 6) {
- applySource(mod, src, wav, bnd, itime, ixsrc, izsrc, vx, vz, tzz, txx, txz, rox, roz, l2m, src_nwav, verbose);
- }
-
- /* check if there are sources placed on the boundaries */
- storeSourceOnSurface(mod, src, bnd, ixsrc, izsrc, vx, vz, tzz, txx, txz, verbose);
-
- /* Free surface: calculate free surface conditions for stresses */
- boundariesV(mod, bnd, vx, vz, tzz, txx, txz, rox, roz, l2m, lam, mul, itime, verbose);
-
- /* restore source positions on the edge */
- reStoreSourceOnSurface(mod, src, bnd, ixsrc, izsrc, vx, vz, tzz, txx, txz, verbose);
-
- return 0;
-}
diff --git a/fdelmodc3D/elastic4dc.c b/fdelmodc3D/elastic4dc.c
deleted file mode 100644
index d119cfb3db178a7f3d5ade881188634191b1c686..0000000000000000000000000000000000000000
--- a/fdelmodc3D/elastic4dc.c
+++ /dev/null
@@ -1,160 +0,0 @@
-#include<stdlib.h>
-#include<stdio.h>
-#include<math.h>
-#include<assert.h>
-#include"fdelmodc.h"
-
-#define MAX(x,y) ((x) > (y) ? (x) : (y))
-
-int applySource(modPar mod, srcPar src, wavPar wav, bndPar bnd, int itime, int ixsrc, int izsrc, float *vx, float *vz, float *tzz,
-float *txx, float *txz, float *rox, float *roz, float *l2m, float **src_nwav, int verbose);
-
-int storeSourceOnSurface(modPar mod, srcPar src, bndPar bnd, int ixsrc, int izsrc, float *vx, float *vz, float *tzz, float *txx, float *txz, int verbose);
-
-int reStoreSourceOnSurface(modPar mod, srcPar src, bndPar bnd, int ixsrc, int izsrc, float *vx, float *vz, float *tzz, float *txx, float *txz, int verbose);
-
-int boundariesP(modPar mod, bndPar bnd, float *vx, float *vz, float *tzz, float *txx, float *txz, float *rox, float *roz, float *l2m, float *lam, float *mul, int itime, int verbose);
-
-int boundariesV(modPar mod, bndPar bnd, float *vx, float *vz, float *tzz, float *txx, float *txz, float *rox, float *roz, float *l2m, float *lam, float *mul, int itime, int verbose);
-
-int elastic4dc(modPar mod, srcPar src, wavPar wav, bndPar bnd, int itime, int ixsrc, int izsrc, float **src_nwav, float *vx,
-float *vz, float *tzz, float *txx, float *txz, float *rox, float *roz, float
-*l2m, float *lam, float *mul, int verbose)
-{
-/*********************************************************************
- COMPUTATIONAL OVERVIEW OF THE 4th ORDER STAGGERED GRID:
-
- The captial symbols T (=Txx,Tzz) Txz,Vx,Vz represent the actual grid
- The indices ix,iz are related to the T grid, so the capital T
- symbols represent the actual modelled grid.
-
- one cel (iz,ix)
- |
- V extra column of vx,txz
- |
- ------- V
- | txz vz| txz vz txz vz txz vz txz vz txz vz txz
- | |
- | vx t | vx t vx t vx t vx t vx t vx
- -------
- txz vz txz vz txz vz txz vz txz vz txz vz txz
-
- vx t vx T---Vx--T---Vx--T---Vx--T vx t vx
- | | | | | | |
- txz vz txz Vz--Txz-Vz--Txz-Vz Txz-Vz txz vz txz
- | | | | | | |
- vx t vx T---Vx--T---Vx--T---Vx--T vx t vx
- | | | | | | |
- txz vz txz Vz Txz-Vz Txz-Vz Txz-Vz txz vz txz
- | | | | | | |
- vx t vx T---Vx--T---Vx--T---Vx--T vx t vx
- | | | | | | |
- txz vz txz Vz Txz-Vz Txz-Vz Txz-Vz txz vz txz
- | | | | | | |
- vx t vx T---Vx--T---Vx--T---Vx--T vx t vx
-
- txz vz txz vz txz vz txz vz txz vz txz vz txz
-
- vx t vx t vx t vx t vx t vx t vx
-
- txz vz txz vz txz vz txz vz txz vz txz vz txz <--|
- |
- extra row of txz/vz |
-
- AUTHOR:
- Jan Thorbecke (janth@xs4all.nl)
- The Netherlands
-
-***********************************************************************/
-
- float c1, c2;
- float dvx, dvz;
- int ix, iz;
- int n1;
-
- c1 = 9.0/8.0;
- c2 = -1.0/24.0;
- n1 = mod.naz;
-
- /* calculate vx for all grid points except on the virtual boundary*/
-#pragma omp for private (ix, iz) nowait schedule(guided,1)
- for (ix=mod.ioXx; ix<mod.ieXx; ix++) {
-#pragma ivdep
- for (iz=mod.ioXz; iz<mod.ieXz; iz++) {
- vx[ix*n1+iz] -= rox[ix*n1+iz]*(
- c1*(txx[ix*n1+iz] - txx[(ix-1)*n1+iz] +
- txz[ix*n1+iz+1] - txz[ix*n1+iz]) +
- c2*(txx[(ix+1)*n1+iz] - txx[(ix-2)*n1+iz] +
- txz[ix*n1+iz+2] - txz[ix*n1+iz-1]) );
- }
- }
-
- /* calculate vz for all grid points except on the virtual boundary */
-#pragma omp for private (ix, iz) schedule(guided,1)
- for (ix=mod.ioZx; ix<mod.ieZx; ix++) {
-#pragma ivdep
- for (iz=mod.ioZz; iz<mod.ieZz; iz++) {
- vz[ix*n1+iz] -= roz[ix*n1+iz]*(
- c1*(tzz[ix*n1+iz] - tzz[ix*n1+iz-1] +
- txz[(ix+1)*n1+iz] - txz[ix*n1+iz]) +
- c2*(tzz[ix*n1+iz+1] - tzz[ix*n1+iz-2] +
- txz[(ix+2)*n1+iz] - txz[(ix-1)*n1+iz]) );
- }
- }
-
- /* Add force source */
- if (src.type > 5) {
- applySource(mod, src, wav, bnd, itime, ixsrc, izsrc, vx, vz, tzz, txx, txz, rox, roz, l2m, src_nwav, verbose);
- }
-
-
- /* boundary condition clears velocities on boundaries */
- boundariesP(mod, bnd, vx, vz, tzz, txx, txz, rox, roz, l2m, lam, mul, itime, verbose);
-
- /* calculate Txx/tzz for all grid points except on the virtual boundary */
-#pragma omp for private (ix, iz, dvx, dvz) nowait schedule(guided,1)
- for (ix=mod.ioPx; ix<mod.iePx; ix++) {
-#pragma ivdep
- for (iz=mod.ioPz; iz<mod.iePz; iz++) {
- dvx = c1*(vx[(ix+1)*n1+iz] - vx[ix*n1+iz]) +
- c2*(vx[(ix+2)*n1+iz] - vx[(ix-1)*n1+iz]);
- dvz = c1*(vz[ix*n1+iz+1] - vz[ix*n1+iz]) +
- c2*(vz[ix*n1+iz+2] - vz[ix*n1+iz-1]);
- txx[ix*n1+iz] -= l2m[ix*n1+iz]*dvx + l2m[ix*n1+iz]*dvz;
- tzz[ix*n1+iz] -= l2m[ix*n1+iz]*dvz + l2m[ix*n1+iz]*dvx;
- }
- }
-
-
-
- /* calculate Txz for all grid points except on the virtual boundary */
-/*
-#pragma omp for private (ix, iz) schedule(guided,1)
- for (ix=mod.ioTx; ix<mod.ieTx; ix++) {
-#pragma ivdep
- for (iz=mod.ioTz; iz<mod.ieTz; iz++) {
- txz[ix*n1+iz] -= mul[ix*n1+iz]*(
- c1*(vx[ix*n1+iz] - vx[ix*n1+iz-1] +
- vz[ix*n1+iz] - vz[(ix-1)*n1+iz]) +
- c2*(vx[ix*n1+iz+1] - vx[ix*n1+iz-2] +
- vz[(ix+1)*n1+iz] - vz[(ix-2)*n1+iz]) );
- }
- }
-*/
-
- /* Add stress source */
- if (src.type < 6) {
- applySource(mod, src, wav, bnd, itime, ixsrc, izsrc, vx, vz, tzz, txx, txz, rox, roz, l2m, src_nwav, verbose);
- }
-
- /* check if there are sources placed on the boundaries */
- storeSourceOnSurface(mod, src, bnd, ixsrc, izsrc, vx, vz, tzz, txx, txz, verbose);
-
- /* Free surface: calculate free surface conditions for stresses */
- boundariesV(mod, bnd, vx, vz, tzz, txx, txz, rox, roz, l2m, lam, mul, itime, verbose);
-
- /* restore source positions on the edge */
- reStoreSourceOnSurface(mod, src, bnd, ixsrc, izsrc, vx, vz, tzz, txx, txz, verbose);
-
- return 0;
-}
diff --git a/fdelmodc3D/elastic6.c b/fdelmodc3D/elastic6.c
deleted file mode 100644
index 00aaf5660a413521604c102fe8915f895caf1606..0000000000000000000000000000000000000000
--- a/fdelmodc3D/elastic6.c
+++ /dev/null
@@ -1,182 +0,0 @@
-#include<stdlib.h>
-#include<stdio.h>
-#include<math.h>
-#include<assert.h>
-#include"fdelmodc.h"
-
-#define MAX(x,y) ((x) > (y) ? (x) : (y))
-
-int applySource(modPar mod, srcPar src, wavPar wav, bndPar bnd, int itime, int ixsrc, int izsrc, float *vx, float *vz, float *tzz,
-float *txx, float *txz, float *rox, float *roz, float *l2m, float **src_nwav, int verbose);
-
-int storeSourceOnSurface(modPar mod, srcPar src, bndPar bnd, int ixsrc, int izsrc, float *vx, float *vz, float *tzz, float *txx, float *txz, int verbose);
-
-int reStoreSourceOnSurface(modPar mod, srcPar src, bndPar bnd, int ixsrc, int izsrc, float *vx, float *vz, float *tzz, float *txx, float *txz, int verbose);
-
-int boundariesP(modPar mod, bndPar bnd, float *vx, float *vz, float *tzz, float *txx, float *txz, float *rox, float *roz, float *l2m, float *lam, float *mul, int itime, int verbose);
-
-int boundariesV(modPar mod, bndPar bnd, float *vx, float *vz, float *tzz, float *txx, float *txz, float *rox, float *roz, float *l2m, float *lam, float *mul, int itime, int verbose);
-
-int elastic6(modPar mod, srcPar src, wavPar wav, bndPar bnd, int itime, int ixsrc, int izsrc, float **src_nwav, float *vx,
-float *vz, float *tzz, float *txx, float *txz, float *rox, float *roz, float
-*l2m, float *lam, float *mul, int verbose)
-{
-/*********************************************************************
- COMPUTATIONAL OVERVIEW OF THE 4th ORDER STAGGERED GRID:
-
- The captial symbols T (=Txx,Tzz) Txz,Vx,Vz represent the actual grid
- The indices ix,iz are related to the T grid, so the capital T
- symbols represent the actual modelled grid.
-
- one cel (iz,ix)
- |
- V extra column of vx,txz
- |
- ------- V
- | txz vz| txz vz txz vz txz vz txz vz txz vz txz
- | |
- | vx t | vx t vx t vx t vx t vx t vx
- -------
- txz vz txz vz txz vz txz vz txz vz txz vz txz
-
- vx t vx T---Vx--T---Vx--T---Vx--T vx t vx
- | | | | | | |
- txz vz txz Vz--Txz-Vz--Txz-Vz Txz-Vz txz vz txz
- | | | | | | |
- vx t vx T---Vx--T---Vx--T---Vx--T vx t vx
- | | | | | | |
- txz vz txz Vz Txz-Vz Txz-Vz Txz-Vz txz vz txz
- | | | | | | |
- vx t vx T---Vx--T---Vx--T---Vx--T vx t vx
- | | | | | | |
- txz vz txz Vz Txz-Vz Txz-Vz Txz-Vz txz vz txz
- | | | | | | |
- vx t vx T---Vx--T---Vx--T---Vx--T vx t vx
-
- txz vz txz vz txz vz txz vz txz vz txz vz txz
-
- vx t vx t vx t vx t vx t vx t vx
-
- txz vz txz vz txz vz txz vz txz vz txz vz txz <--|
- |
- extra row of txz/vz |
-
- AUTHOR:
- Jan Thorbecke (janth@xs4all.nl)
- The Netherlands
-
-***********************************************************************/
-
- float c1, c2, c3;
- float dvx, dvz;
- int ix, iz;
- int n1;
- int ioXx, ioXz, ioZz, ioZx, ioPx, ioPz, ioTx, ioTz;
-
- c1 = 75.0/64.0;
- c2 = -25.0/384.0;
- c3 = 3.0/640.0;
- n1 = mod.naz;
-
- /* Vx: rox */
- ioXx=mod.iorder/2;
- ioXz=ioXx-1;
- /* Vz: roz */
- ioZz=mod.iorder/2;
- ioZx=ioZz-1;
- /* P, Txx, Tzz: lam, l2m */
- ioPx=mod.iorder/2-1;
- ioPz=ioPx;
- /* Txz: muu */
- ioTx=mod.iorder/2;
- ioTz=ioTx;
-
- /* calculate vx for all grid points except on the virtual boundary*/
-#pragma omp for private (ix, iz) nowait
- for (ix=mod.ioXx; ix<mod.ieXx; ix++) {
-#pragma ivdep
- for (iz=mod.ioXz; iz<mod.ieXz; iz++) {
- vx[ix*n1+iz] -= rox[ix*n1+iz]*(
- c1*(txx[ix*n1+iz] - txx[(ix-1)*n1+iz] +
- txz[ix*n1+iz+1] - txz[ix*n1+iz]) +
- c2*(txx[(ix+1)*n1+iz] - txx[(ix-2)*n1+iz] +
- txz[ix*n1+iz+2] - txz[ix*n1+iz-1]) +
- c3*(txx[(ix+2)*n1+iz] - txx[(ix-3)*n1+iz] +
- txz[ix*n1+iz+3] - txz[ix*n1+iz-2]) );
- }
- }
-
- /* calculate vz for all grid points except on the virtual boundary */
-#pragma omp for private (ix, iz)
- for (ix=mod.ioZx; ix<mod.ieZx; ix++) {
-#pragma ivdep
- for (iz=mod.ioZz; iz<mod.ieZz; iz++) {
- vz[ix*n1+iz] -= roz[ix*n1+iz]*(
- c1*(tzz[ix*n1+iz] - tzz[ix*n1+iz-1] +
- txz[(ix+1)*n1+iz] - txz[ix*n1+iz]) +
- c2*(tzz[ix*n1+iz+1] - tzz[ix*n1+iz-2] +
- txz[(ix+2)*n1+iz] - txz[(ix-1)*n1+iz]) +
- c3*(tzz[ix*n1+iz+2] - tzz[ix*n1+iz-3] +
- txz[(ix+3)*n1+iz] - txz[(ix-2)*n1+iz]) );
-
-
- }
- }
-
- /* Add force source */
- if (src.type > 5) {
- applySource(mod, src, wav, bnd, itime, ixsrc, izsrc, vx, vz, tzz, txx, txz, rox, roz, l2m, src_nwav, verbose);
- }
-
- /* boundary condition clears velocities on boundaries */
- boundariesP(mod, bnd, vx, vz, tzz, txx, txz, rox, roz, l2m, lam, mul, itime, verbose);
-
- /* calculate Txx/tzz for all grid points except on the virtual boundary */
-#pragma omp for private (ix, iz, dvx, dvz) nowait
- for (ix=mod.ioPx; ix<mod.iePx; ix++) {
-#pragma ivdep
- for (iz=mod.ioPz; iz<mod.iePz; iz++) {
- dvx = c1*(vx[(ix+1)*n1+iz] - vx[ix*n1+iz]) +
- c2*(vx[(ix+2)*n1+iz] - vx[(ix-1)*n1+iz]) +
- c3*(vx[(ix+3)*n1+iz] - vx[(ix-2)*n1+iz]);
- dvz = c1*(vz[ix*n1+iz+1] - vz[ix*n1+iz]) +
- c2*(vz[ix*n1+iz+2] - vz[ix*n1+iz-1]) +
- c3*(vz[ix*n1+iz+3] - vz[ix*n1+iz-2]);
- txx[ix*n1+iz] -= l2m[ix*n1+iz]*dvx + lam[ix*n1+iz]*dvz;
- tzz[ix*n1+iz] -= l2m[ix*n1+iz]*dvz + lam[ix*n1+iz]*dvx;
- }
- }
-
- /* calculate Txz for all grid points except on the virtual boundary */
-#pragma omp for private (ix, iz)
- for (ix=mod.ioTx; ix<mod.ieTx; ix++) {
-#pragma ivdep
- for (iz=mod.ioTz; iz<mod.ieTz; iz++) {
- txz[ix*n1+iz] -= mul[ix*n1+iz]*(
- c1*(vx[ix*n1+iz] - vx[ix*n1+iz-1] +
- vz[ix*n1+iz] - vz[(ix-1)*n1+iz]) +
- c2*(vx[ix*n1+iz+1] - vx[ix*n1+iz-2] +
- vz[(ix+1)*n1+iz] - vz[(ix-2)*n1+iz]) +
- c3*(vx[ix*n1+iz+2] - vx[ix*n1+iz-3] +
- vz[(ix+2)*n1+iz] - vz[(ix-3)*n1+iz]) );
-
- }
- }
-
- /* Add stress source */
- if (src.type < 6) {
- applySource(mod, src, wav, bnd, itime, ixsrc, izsrc, vx, vz, tzz, txx, txz, rox, roz, l2m, src_nwav, verbose);
- }
-
-
- /* check if there are sources placed on the free surface */
- storeSourceOnSurface(mod, src, bnd, ixsrc, izsrc, vx, vz, tzz, txx, txz, verbose);
-
- /* Free surface: calculate free surface conditions for stresses */
- boundariesV(mod, bnd, vx, vz, tzz, txx, txz, rox, roz, l2m, lam, mul, itime, verbose);
-
- /* restore source positions on the edge */
- reStoreSourceOnSurface(mod, src, bnd, ixsrc, izsrc, vx, vz, tzz, txx, txz, verbose);
-
- return 0;
-}
diff --git a/fdelmodc3D/fdelmodc.c b/fdelmodc3D/fdelmodc.c
deleted file mode 100644
index 17fcb9f9bff0864098b02dc9f63bb33429429a80..0000000000000000000000000000000000000000
--- a/fdelmodc3D/fdelmodc.c
+++ /dev/null
@@ -1,743 +0,0 @@
-#include<stdlib.h>
-#include<stdio.h>
-#include<math.h>
-#include<assert.h>
-#include<string.h>
-#include"par.h"
-#include"fdelmodc.h"
-#ifdef MPI
-#include <mpi.h>
-#endif
-
-#define MAX(x,y) ((x) > (y) ? (x) : (y))
-#define MIN(x,y) ((x) < (y) ? (x) : (y))
-#define NINT(x) ((int)((x)>0.0?(x)+0.5:(x)-0.5))
-
-double wallclock_time(void);
-
-void threadAffinity(void);
-
-int getParameters(modPar *mod, recPar *rec, snaPar *sna, wavPar *wav, srcPar *src, shotPar *shot, bndPar *bnd, int verbose);
-
-int readModel(modPar mod, bndPar bnd, float *rox, float *roz, float *l2m, float *lam, float *muu, float *tss, float *tes, float *tep);
-
-int defineSource(wavPar wav, srcPar src, modPar mod, recPar rec, float **src_nwav, int reverse, int verbose);
-
-int writeSrcRecPos(modPar *mod, recPar *rec, srcPar *src, shotPar *shot);
-
-int acoustic6(modPar mod, srcPar src, wavPar wav, bndPar bnd, int itime, int ixsrc, int izsrc, float **src_nwav, float *vx, float *vz, float *p, float *rox, float *roz, float *l2m, int verbose);
-
-int acoustic4(modPar mod, srcPar src, wavPar wav, bndPar bnd, int itime, int ixsrc, int izsrc, float **src_nwav, float *vx, float *vz, float *p, float *rox, float *roz, float *l2m, int verbose);
-
-int acoustic4pml(modPar mod, srcPar src, wavPar wav, bndPar bnd, int itime, int ixsrc, int izsrc, float **src_nwav, float *vx, float *vz, float *p, float *rox, float *roz, float *l2m, int verbose);
-
-int acousticSH4(modPar mod, srcPar src, wavPar wav, bndPar bnd, int itime, int ixsrc, int izsrc, float **src_nwav, float *tx, float *tz, float *vz, float *rox, float *roz, float *mul, int verbose);
-
-int acoustic4_qr(modPar mod, srcPar src, wavPar wav, bndPar bnd, int itime, int ixsrc, int izsrc, float **src_nwav, float *vx, float *vz, float *p, float *rox, float *roz, float *l2m, int verbose);
-
-int acoustic2(modPar mod, srcPar src, wavPar wav, bndPar bnd, int itime, int ixsrc, int izsrc, float **src_nwav, float *vx, float *vz, float *p, float *rox, float *roz, float *l2m, int verbose);
-
-int acoustic4Block(modPar mod, srcPar src, wavPar wav, bndPar bnd, int itime, int ixsrc, int izsrc, float **src_nwav, float *vx,
-float *vz, float *p, float *rox, float *roz, float *l2m, int verbose);
-
-int viscoacoustic4(modPar mod, srcPar src, wavPar wav, bndPar bnd, int itime, int ixsrc, int izsrc, float **src_nwav, float *vx, float *vz, float *p, float *rox, float *roz, float *l2m, float *tss, float *tep, float *q, int verbose);
-
-int elastic4(modPar mod, srcPar src, wavPar wav, bndPar bnd, int itime, int ixsrc, int izsrc, float **src_nwav, float *vx, float *vz, float *tzz, float *txx, float *txz, float *rox, float *roz, float *l2m, float *lam, float *mul, int verbose);
-
-int elastic4dc(modPar mod, srcPar src, wavPar wav, bndPar bnd, int itime, int ixsrc, int izsrc, float **src_nwav, float *vx, float *vz, float *tzz, float *txx, float *txz, float *rox, float *roz, float *l2m, float *lam, float *mul, int verbose);
-
-int viscoelastic4(modPar mod, srcPar src, wavPar wav, bndPar bnd, int itime, int ixsrc, int izsrc, float **src_nwav, float *vx, float
-*vz, float *tzz, float *txx, float *txz, float *rox, float *roz, float *l2m, float *lam, float *mul, float *ts, float *tep, float
-*tes, float *r, float *q, float *p, int verbose);
-
-int elastic6(modPar mod, srcPar src, wavPar wav, bndPar bnd, int itime, int ixsrc, int izsrc,
- float **src_nwav, float *vx, float *vz, float *tzz, float *txx, float *txz, float *rox,
- float *roz, float *l2m, float *lam, float *mul, int verbose);
-
-int getRecTimes(modPar mod, recPar rec, bndPar bnd, int itime, int isam, float *vx, float *vz, float *tzz, float *txx,
- float *txz, float *l2m, float *rox, float *roz,
- float *rec_vx, float *rec_vz, float *rec_txx, float *rec_tzz, float *rec_txz,
- float *rec_p, float *rec_pp, float *rec_ss, float *rec_udp, float *rec_udvz, int verbose);
-
-int writeRec(recPar rec, modPar mod, bndPar bnd, wavPar wav, int ixsrc, int izsrc, int nsam, int ishot, int fileno,
- float *rec_vx, float *rec_vz, float *rec_txx, float *rec_tzz, float *rec_txz,
- float *rec_p, float *rec_pp, float *rec_ss, float *rec_udp, float *rec_udvz, int verbose);
-
-int writeSnapTimes(modPar mod, snaPar sna, bndPar bnd, wavPar wav,int ixsrc, int izsrc, int itime,
- float *vx, float *vz, float *tzz, float *txx, float *txz, int verbose);
-
-int getBeamTimes(modPar mod, snaPar sna, float *vx, float *vz, float *tzz, float *txx, float *txz,
- float *beam_vx, float *beam_vz, float *beam_txx, float *beam_tzz, float *beam_txz,
- float *beam_p, float *beam_pp, float *beam_ss, int verbose);
-
-int writeBeams(modPar mod, snaPar sna, int ixsrc, int izsrc, int ishot, int fileno,
- float *beam_vx, float *beam_vz, float *beam_txx, float *beam_tzz, float *beam_txz,
- float *beam_p, float *beam_pp, float *beam_ss, int verbose);
-
-int allocStoreSourceOnSurface(srcPar src);
-
-int freeStoreSourceOnSurface(void);
-
-/* Self documentation */
-char *sdoc[] = {
-" ",
-" fdelmodc - elastic acoustic finite difference wavefield modeling ",
-" ",
-" IO PARAMETERS:",
-" file_cp= .......... P (cp) velocity file",
-" file_cs= .......... S (cs) velocity file",
-" file_den= ......... density (ro) file",
-" file_src= ......... file with source signature",
-" file_rcv=recv.su .. base name for receiver files",
-" file_snap=snap.su . base name for snapshot files",
-" file_beam=beam.su . base name for beam fields ",
-" dx= ............... read from model file: if dx==0 then dx= can be used to set it",
-" dz= ............... read from model file: if dz==0 then dz= can be used to set it",
-" dt= ............... read from file_src: if dt is set it will interpolate file_src to dt sampling",
-"" ,
-" OPTIONAL PARAMETERS:",
-" ischeme=3 ......... 1=acoustic, 2=visco-acoustic 3=elastic, 4=visco-elastic, 5=double-couple",
-" tmod=(nt-1)*dt .... total modeling time (nt from file_src)",
-" ntaper=0 .......... length of taper in points at edges of model",
-" npml=35 ........... length of PML layer in points at edges of model",
-" R=1e-4 ............ the theoretical reflection coefficient at PML boundary",
-" m=2.0 ............. scaling order of the PML sigma function ",
-" tapfact=0.30 ...... taper strength: larger value gets stronger taper",
-" For the 4 boundaries the options are: 1=free 2=pml 3=rigid 4=taper",
-" top=1 ............. type of boundary on top edge of model",
-" left=4 ............ type of boundary on left edge of model",
-" right=4 ........... type of boundary on right edge of model",
-" bottom=4 .......... type of boundary on bottom edge of model",
-//" tapleft=0 ......... =1: taper left edge of model",
-//" tapright=0 ........ =1: taper right edge of model",
-//" taptop=0 .......... =1: taper top edge of model",
-//" tapbottom=0 ....... =1: taper bottom edge of model",
-//" cfree=0 ........... 1=free surface",
-" grid_dir=0 ........ direction of time modeling (1=reverse time)",
-" Qp=15 ............. global Q-value for P-waves in visco-elastic (ischeme=2,4)",
-" file_qp= .......... model file Qp values as function of depth",
-" Qs=Qp ............. global Q-value for S-waves in visco-elastic (ischeme=4)",
-" file_qs= .......... model file Qs values as function of depth",
-" fw=0.5*fmax ....... central frequency for which the Q's are used",
-" sinkdepth=0 ....... receiver grid points below topography (defined bij cp=0.0)",
-" sinkdepth_src=0 ... source grid points below topography (defined bij cp=0.0)",
-" sinkvel=0 ......... use velocity of first receiver to sink through to next layer",
-" beam=0 ............ calculate energy beam of wavefield in model",
-" disable_check=0 ... disable stabilty and dispersion check and continue modeling",
-" verbose=0 ......... silent mode; =1: display info",
-" ",
-" SHOT AND GENERAL SOURCE DEFINITION:",
-" src_type=1 ........ 1=P 2=Txz 3=Tzz 4=Txx 5=S-pot 6=Fx 7=Fz 8=P-pot 9=double-couple",
-" src_orient=1 ...... orientation of the source",
-" - 1=monopole",
-" - 2=dipole +/- vertical oriented",
-" - 3=dipole - + horizontal oriented",
-//" - 4=dipole +/0/-",
-//" - 5=dipole + -",
-" dip=0 ............. dip for double-couple source",
-" strike=0 .......... strike for double-couple source",
-" xsrc=middle ....... x-position of (first) shot ",
-" zsrc=zmin ......... z-position of (first) shot ",
-" nshot=1 ........... number of shots to model",
-" dxshot=dx ......... if nshot > 1: x-shift in shot locations",
-" dzshot=0 .......... if nshot > 1: z-shift in shot locations",
-" xsrca= ............ defines source array x-positions",
-" zsrca= ............ defines source array z-positions",
-" src_txt=........... text file with source coordinates. Col 1: x, Col. 2: z",
-" wav_random=1 ...... 1 generates (band limited by fmax) noise signatures ",
-" fmax=from_src ..... maximum frequency in wavelet",
-" src_multiwav=0 .... use traces in file_src as areal source",
-" src_at_rcv=1 ...... inject wavefield at receiver coordinates (1), inject at source (0)",
-" src_injectionrate=0 set to 1 to use injection rate source",
-"" ,
-" PLANE WAVE SOURCE DEFINITION:",
-" plane_wave=0 ...... model plane wave with nsrc= sources",
-" nsrc=1 ............ number of sources per (plane-wave) shot ",
-" src_angle=0 ....... angle of plane source array",
-" src_velo=1500 ..... velocity to use in src_angle definition",
-" src_window=0 ...... length of taper at edges of source array",
-"",
-" RANDOM SOURCE DEFINITION FOR SEISMIC INTERFEROMTERY:",
-" src_random=0 ...... 1 enables nsrc random sources positions in one modeling",
-" nsrc=1 ............ number of sources to use for one shot",
-" xsrc1=0 ........... left bound for x-position of sources",
-" xsrc2=0 ........... right bound for x-position of sources",
-" zsrc1=0 ........... left bound for z-position of sources",
-" zsrc2=0 ........... right bound for z-position of sources",
-" tsrc1=0.0 ......... begin time interval for random sources being triggered",
-" tsrc2=tmod ........ end time interval for random sources being triggered",
-" tactive=tsrc2 ..... end time for random sources being active",
-" tlength=tsrc2-tsrc1 average duration of random source signal",
-" length_random=1 ... duration of source is rand*tlength",
-" amplitude=0 ....... distribution of source amplitudes",
-" distribution=0 .... random function for amplitude and tlength 0=flat 1=Gaussian ",
-" seed=10 ........... seed for start of random sequence ",
-"" ,
-" SNAP SHOT SELECTION:",
-" tsnap1=0.1 ........ first snapshot time (s)",
-" tsnap2=0.0 ........ last snapshot time (s)",
-" dtsnap=0.1 ........ snapshot time interval (s)",
-" dxsnap=dx ......... sampling in snapshot in x-direction",
-" xsnap1=0 .......... first x-position for snapshots area",
-" xsnap2=0 .......... last x-position for snapshot area",
-" dzsnap=dz ......... sampling in snapshot in z-direction",
-" zsnap1=0 .......... first z-position for snapshots area",
-" zsnap2=0 .......... last z-position for snapshot area",
-" snapwithbnd=0 ..... write snapshots with absorbing boundaries",
-" sna_type_p=1 ...... p registration _sp",
-" sna_type_vz=1 ..... Vz registration _svz",
-" sna_type_vx=0 ..... Vx registration _svx",
-" sna_type_txx=0 .... Txx registration _stxx",
-" sna_type_tzz=0 .... Tzz registration _stzz",
-" sna_type_txz=0 .... Txz registration _stxz",
-" sna_type_pp=0 ..... P (divergence) registration _sP",
-" sna_type_ss=0 ..... S (curl) registration _sS",
-" sna_vxvztime=0 .... registration of vx/vx times",
-" The fd scheme is also staggered in time.",
-" Time at which vx/vz snapshots are written:",
-" - 0=previous vx/vz relative to txx/tzz/txz at time t",
-" - 1=next vx/vz relative to txx/tzz/txz at time t",
-"" ,
-" RECEIVER SELECTION:",
-" xrcv1=xmin ........ first x-position of linear receiver array(s)",
-" xrcv2=xmax ........ last x-position of linear receiver array(s)",
-" dxrcv=dx .......... x-position increment of receivers in linear array(s)",
-" zrcv1=zmin ........ first z-position of linear receiver array(s)",
-" zrcv2=zrcv1 ....... last z-position of linear receiver array(s)",
-" dzrcv=0.0 ......... z-position increment of receivers in linear array(s)",
-" dtrcv=.004 ........ desired sampling in receiver data (seconds)",
-//" max_nrec=15000 .... maximum number of receivers", not needed anymore
-" xrcva= ............ defines receiver array x-positions",
-" zrcva= ............ defines receiver array z-positions",
-" rrcv= ............. radius for receivers on a circle ",
-" arcv= ............. vertical arc-lenght for receivers on a ellipse (rrcv=horizontal)",
-" oxrcv=0.0 ......... x-center position of circle",
-" ozrcv=0.0 ......... z-center position of circle",
-" dphi=2 ............ angle between receivers on circle ",
-" rcv_txt=........... text file with receiver coordinates. Col 1: x, Col. 2: z",
-//" largeSUfile=0 ..... writing large SU file (nt > 64000)",
-" rec_ntsam=nt ...... maximum number of time samples in file_rcv files",
-" rec_delay=0 ....... time in seconds to start recording: recorded time = tmod - rec_delay",
-//" dxspread=0 ........ if nshot > 1: x-shift of rcv spread",
-//" dzspread=0 ........ if nshot > 1: z-shift of rcv spread",
-" rec_type_p=1 ...... p registration _rp",
-" rec_type_vz=1 ..... Vz registration _rvz",
-" rec_type_vx=0 ..... Vx registration _rvx",
-" rec_type_txx=0 .... Txx registration _rtxx",
-" rec_type_tzz=0 .... Tzz registration _rtzz",
-" rec_type_txz=0 .... Txz registration _rtxz",
-" rec_type_pp=0 ..... P (divergence) registration _rP",
-" rec_type_ss=0 ..... S (curl) registration _rS",
-" rec_type_ud=0 ..... 1:pressure normalized decomposition in up and downgoing waves _ru, _rd",
-" ................... 2:particle velocity normalized decomposition in up and downgoing waves _ru, _rd",
-" kangle= ........... maximum wavenumber angle for decomposition",
-" rec_int_vx=0 ..... interpolation of Vx receivers",
-" - 0=Vx->Vx (no interpolation)",
-" - 1=Vx->Vz",
-" - 2=Vx->Txx/Tzz(P)",
-" - 3=Vx->receiver position",
-" rec_int_vz=0 ...... interpolation of Vz receivers",
-" - 0=Vz->Vz (no interpolation)",
-" - 1=Vz->Vx",
-" - 2=Vz->Txx/Tzz(P)",
-" - 3=Vz->receiver position",
-" rec_int_p=0 ...... interpolation of P/Tzz receivers",
-" - 0=P->P (no interpolation)",
-" - 1=P->Vz",
-" - 2=P->Vx",
-" - 3=P->receiver position",
-"" ,
-" NOTES: For viscoelastic media dispersion and stability are not always",
-" guaranteed by the calculated criteria, especially for Q values smaller than 13",
-"",
-" Jan Thorbecke 2011",
-" TU Delft",
-" E-mail: janth@xs4all.nl ",
-" 2015 Contributions from Max Holicki",
-"",
-NULL};
-
-
-int main(int argc, char **argv)
-{
- modPar mod;
- recPar rec;
- snaPar sna;
- wavPar wav;
- srcPar src;
- bndPar bnd;
- shotPar shot;
- float **src_nwav;
- float *rox, *roz, *l2m, *lam, *mul;
- float *tss, *tes, *tep, *p, *q, *r;
- float *vx, *vz, *tzz, *txz, *txx;
- float *rec_vx, *rec_vz, *rec_p;
- float *rec_txx, *rec_tzz, *rec_txz;
- float *rec_pp, *rec_ss;
- float *rec_udp, *rec_udvz;
- float *beam_vx, *beam_vz, *beam_p;
- float *beam_txx, *beam_tzz, *beam_txz;
- float *beam_pp, *beam_ss;
- float sinkvel, npeshot;
- double t0, t1, t2, t3, tt, tinit;
- size_t size, sizem, nsamp;
- int n1, ix, iz, ir, ishot, i;
- int ioPx, ioPz;
- int it0, it1, its, it, fileno, isam;
- int ixsrc, izsrc, is0, is1;
- int verbose;
-#ifdef MPI
- int npes, pe;
-
- MPI_Init( &argc, &argv );
- MPI_Comm_size( MPI_COMM_WORLD, &npes );
- MPI_Comm_rank( MPI_COMM_WORLD, &pe );
-#else
- int npes, pe;
- npes = 1;
- pe = 0;
-#endif
-
-
- t0= wallclock_time();
- initargs(argc,argv);
- requestdoc(0);
-
- if (!getparint("verbose",&verbose)) verbose=0;
- getParameters(&mod, &rec, &sna, &wav, &src, &shot, &bnd, verbose);
-
- /* allocate arrays for model parameters: the different schemes use different arrays */
-
- n1 = mod.naz;
- sizem=mod.nax*mod.naz;
-
- rox = (float *)calloc(sizem,sizeof(float));
- roz = (float *)calloc(sizem,sizeof(float));
- l2m = (float *)calloc(sizem,sizeof(float));
- if (mod.ischeme==2) {
- tss = (float *)calloc(sizem,sizeof(float));
- tep = (float *)calloc(sizem,sizeof(float));
- q = (float *)calloc(sizem,sizeof(float));
- }
- if (mod.ischeme>2) {
- lam = (float *)calloc(sizem,sizeof(float));
- mul = (float *)calloc(sizem,sizeof(float));
- }
- if (mod.ischeme==4) {
- tss = (float *)calloc(sizem,sizeof(float));
- tes = (float *)calloc(sizem,sizeof(float));
- tep = (float *)calloc(sizem,sizeof(float));
- r = (float *)calloc(sizem,sizeof(float));
- p = (float *)calloc(sizem,sizeof(float));
- q = (float *)calloc(sizem,sizeof(float));
- }
- allocStoreSourceOnSurface(src);
-
- /* read velocity and density files */
-
- readModel(mod, bnd, rox, roz, l2m, lam, mul, tss, tes, tep);
-
- /* read and/or define source wavelet(s) */
-
- /* Using a random source, which can have a random length
- for each source position, a pointer array with variable
- length (wav.nsamp[i]) is used.
- The total length of all the source lengths together is wav.nst */
-
- if (wav.random) {
- src_nwav = (float **)calloc(wav.nx,sizeof(float *));
- src_nwav[0] = (float *)calloc(wav.nst,sizeof(float));
- assert(src_nwav[0] != NULL);
- nsamp = 0;
- for (i=0; i<wav.nx; i++) {
- src_nwav[i] = (float *)(src_nwav[0] + nsamp);
- nsamp += wav.nsamp[i];
- }
- }
- else {
- src_nwav = (float **)calloc(wav.nx,sizeof(float *));
- src_nwav[0] = (float *)calloc(wav.nt*wav.nx,sizeof(float));
- assert(src_nwav[0] != NULL);
- for (i=0; i<wav.nx; i++) {
- src_nwav[i] = (float *)(src_nwav[0] + wav.nt*i);
- }
- }
-
- defineSource(wav, src, mod, rec, src_nwav, mod.grid_dir, verbose);
-
- /* allocate arrays for wavefield and receiver arrays */
-
- vx = (float *)calloc(sizem,sizeof(float));
- vz = (float *)calloc(sizem,sizeof(float));
- tzz = (float *)calloc(sizem,sizeof(float)); /* =P field for acoustic */
- if (mod.ischeme>2) {
- txz = (float *)calloc(sizem,sizeof(float));
- txx = (float *)calloc(sizem,sizeof(float));
- }
-
- size = rec.n*rec.nt;
- if (rec.type.vz) rec_vz = (float *)calloc(size,sizeof(float));
- if (rec.type.vx) rec_vx = (float *)calloc(size,sizeof(float));
- if (rec.type.p) rec_p = (float *)calloc(size,sizeof(float));
- if (rec.type.txx) rec_txx = (float *)calloc(size,sizeof(float));
- if (rec.type.tzz) rec_tzz = (float *)calloc(size,sizeof(float));
- if (rec.type.txz) rec_txz = (float *)calloc(size,sizeof(float));
- if (rec.type.pp) rec_pp = (float *)calloc(size,sizeof(float));
- if (rec.type.ss) rec_ss = (float *)calloc(size,sizeof(float));
- if (rec.type.ud) {
- rec_udvz = (float *)calloc(mod.nax*rec.nt,sizeof(float));
- rec_udp = (float *)calloc(mod.nax*rec.nt,sizeof(float));
- }
- /* get velcity and density at first receiver location */
- ir = mod.ioZz + rec.z[0]+(rec.x[0]+mod.ioZx)*n1;
- rec.rho = mod.dt/(mod.dx*roz[ir]);
- rec.cp = sqrt(l2m[ir]*(roz[ir]))*mod.dx/mod.dt;
-
- if(sna.beam) {
- size = sna.nz*sna.nx;
- if (sna.type.vz) beam_vz = (float *)calloc(size,sizeof(float));
- if (sna.type.vx) beam_vx = (float *)calloc(size,sizeof(float));
- if (sna.type.p) beam_p = (float *)calloc(size,sizeof(float));
- if (sna.type.txx) beam_txx = (float *)calloc(size,sizeof(float));
- if (sna.type.tzz) beam_tzz = (float *)calloc(size,sizeof(float));
- if (sna.type.txz) beam_txz = (float *)calloc(size,sizeof(float));
- if (sna.type.pp) beam_pp = (float *)calloc(size,sizeof(float));
- if (sna.type.ss) beam_ss = (float *)calloc(size,sizeof(float));
- }
-
- t1= wallclock_time();
- if (verbose) {
- tinit = t1-t0;
- vmess("*******************************************");
- vmess("************* runtime info ****************");
- vmess("*******************************************");
- vmess("CPU time for intializing arrays and model = %f", tinit);
- }
-
- /* Sinking source and receiver arrays:
- If P-velocity==0 the source and receiver
- postions are placed deeper until the P-velocity changes.
- The free-surface position is stored in bnd.surface[ix].
- Setting the option rec.sinkvel only sinks the receiver position
- (not the source) and uses the velocity
- of the first receiver to sink through to the next layer. */
-
- ioPx=mod.ioPx;
- ioPz=mod.ioPz;
- if (bnd.lef==4 || bnd.lef==2) ioPx += bnd.ntap;
- if (bnd.top==4 || bnd.top==2) ioPz += bnd.ntap;
- if (rec.sinkvel) sinkvel=l2m[(rec.x[0]+ioPx)*n1+rec.z[0]+ioPz];
- else sinkvel = 0.0;
-
-/* sink receivers to value different than sinkvel */
- for (ir=0; ir<rec.n; ir++) {
- iz = rec.z[ir];
- ix = rec.x[ir];
- while(l2m[(ix+ioPx)*n1+iz+ioPz] == sinkvel) iz++;
- rec.z[ir]=iz+rec.sinkdepth;
- rec.zr[ir]=rec.zr[ir]+(rec.z[ir]-iz)*mod.dz;
-// rec.zr[ir]=rec.z[ir]*mod.dz;
- if (verbose>3) vmess("receiver position %d at grid[ix=%d, iz=%d] = (x=%f z=%f)", ir, ix+ioPx, rec.z[ir]+ioPz, rec.xr[ir]+mod.x0, rec.zr[ir]+mod.z0);
- }
-
-/* sink sources to value different than zero */
- for (ishot=0; ishot<shot.n; ishot++) {
- iz = shot.z[ishot];
- ix = shot.x[ishot];
- while(l2m[(ix+ioPx)*n1+iz+ioPz] == 0.0) iz++;
- shot.z[ishot]=iz+src.sinkdepth;
- }
-
- /* scan for free surface boundary in case it has a topography */
- for (ix=0; ix<mod.nx; ix++) {
- iz = ioPz;
- while(l2m[(ix+ioPx)*n1+iz] == 0.0) iz++;
- bnd.surface[ix+ioPx] = iz;
- if ((verbose>3) && (iz != ioPz)) vmess("Topgraphy surface x=%.2f z=%.2f", mod.x0+mod.dx*ix, mod.z0+mod.dz*(iz-ioPz));
- }
- for (ix=0; ix<ioPx; ix++) {
- bnd.surface[ix] = bnd.surface[ioPx];
- }
- for (ix=ioPx+mod.nx; ix<mod.iePx; ix++) {
- bnd.surface[ix] = bnd.surface[mod.iePx-1];
- }
- if (verbose>3) writeSrcRecPos(&mod, &rec, &src, &shot);
-
- /* Outer loop over number of shots */
-#ifdef MPI
- npeshot = MAX((((float)shot.n)/((float)npes)), 1.0);
- is0=ceil(pe*npeshot);
- is1=MIN(ceil((pe+1)*npeshot), shot.n);
- if (verbose>1) vmess("MPI: pe=%d does shots is0 %d - is1 %d\n", pe, is0, is1);
-#else
- is0=0;
- is1=shot.n;
-#endif
-
- for (ishot=is0; ishot<is1; ishot++) {
-
- izsrc = shot.z[ishot];
- ixsrc = shot.x[ishot];
- fileno= 0;
-
- memset(vx,0,sizem*sizeof(float));
- memset(vz,0,sizem*sizeof(float));
- memset(tzz,0,sizem*sizeof(float));
- if (mod.ischeme==2) {
- memset(q,0,sizem*sizeof(float));
- }
- if (mod.ischeme>2) {
- memset(txz,0,sizem*sizeof(float));
- memset(txx,0,sizem*sizeof(float));
- }
- if (mod.ischeme==4) {
- memset(r,0,sizem*sizeof(float));
- memset(p,0,sizem*sizeof(float));
- memset(q,0,sizem*sizeof(float));
- }
- if (verbose) {
- if (!src.random) {
- vmess("Modeling source %d at gridpoints ix=%d iz=%d", ishot, shot.x[ishot], shot.z[ishot]);
- vmess(" which are actual positions x=%.2f z=%.2f", mod.x0+mod.dx*shot.x[ishot], mod.z0+mod.dz*shot.z[ishot]);
- }
- vmess("Receivers at gridpoint x-range ix=%d - %d", rec.x[0], rec.x[rec.n-1]);
- vmess(" which are actual positions x=%.2f - %.2f", mod.x0+rec.xr[0], mod.x0+rec.xr[rec.n-1]);
- vmess("Receivers at gridpoint z-range iz=%d - %d", rec.z[0], rec.z[rec.n-1]);
- vmess(" which are actual positions z=%.2f - %.2f", mod.z0+rec.zr[0], mod.z0+rec.zr[rec.n-1]);
- }
-
- if (mod.grid_dir) { /* reverse time modeling */
- it0=-mod.nt+1;
- it1=0;
- its=-1;
-
- it0=0;
- it1=mod.nt;
- its=1;
- }
- else {
- it0=0;
- it1=mod.nt;
- its=1;
- }
-
- /* Main loop over the number of time steps */
- for (it=it0; it<it1; it++) {
-
-#pragma omp parallel default (shared) \
-shared (rox, roz, l2m, lam, mul, txx, txz, tzz, vx, vz) \
-shared (tss, tep, tes, r, q, p) \
-shared (tinit, it0, it1, its) \
-shared(beam_vx, beam_vz, beam_txx, beam_tzz, beam_txz, beam_p, beam_pp, beam_ss) \
-shared(rec_vx, rec_vz, rec_txx, rec_tzz, rec_txz, rec_p, rec_pp, rec_ss) \
-shared (tt, t2, t3) \
-shared (shot, bnd, mod, src, wav, rec, ixsrc, izsrc, it, src_nwav, verbose)
-{
- if (it==it0) {
- threadAffinity();
- }
- switch ( mod.ischeme ) {
-// case -2 : /* test code for PML */
-// acoustic4_test(mod, src, wav, bnd, it, ixsrc, izsrc, src_nwav,
-// vx, vz, tzz, rox, roz, l2m, verbose);
-// break;
- case -1 : /* Acoustic dissipative media FD kernel */
- acoustic4_qr(mod, src, wav, bnd, it, ixsrc, izsrc, src_nwav,
- vx, vz, tzz, rox, roz, l2m, verbose);
- break;
- case 1 : /* Acoustic FD kernel */
- if (mod.iorder==2) {
- acoustic2(mod, src, wav, bnd, it, ixsrc, izsrc, src_nwav,
- vx, vz, tzz, rox, roz, l2m, verbose);
- }
- else if (mod.iorder==4) {
- if (mod.sh) {
- acousticSH4(mod, src, wav, bnd, it, ixsrc, izsrc, src_nwav,
- vx, vz, tzz, rox, roz, l2m, verbose);
- }
- else {
- acoustic4(mod, src, wav, bnd, it, ixsrc, izsrc, src_nwav,
- vx, vz, tzz, rox, roz, l2m, verbose);
- }
- }
- else if (mod.iorder==6) {
- acoustic6(mod, src, wav, bnd, it, ixsrc, izsrc, src_nwav,
- vx, vz, tzz, rox, roz, l2m, verbose);
- }
- break;
- case 2 : /* Visco-Acoustic FD kernel */
- viscoacoustic4(mod, src, wav, bnd, it, ixsrc, izsrc, src_nwav,
- vx, vz, tzz, rox, roz, l2m, tss, tep, q, verbose);
- break;
- case 3 : /* Elastic FD kernel */
- if (mod.iorder==4) {
- elastic4(mod, src, wav, bnd, it, ixsrc, izsrc, src_nwav,
- vx, vz, tzz, txx, txz, rox, roz, l2m, lam, mul, verbose);
- }
- else if (mod.iorder==6) {
- elastic6(mod, src, wav, bnd, it, ixsrc, izsrc, src_nwav,
- vx, vz, tzz, txx, txz, rox, roz, l2m, lam, mul, verbose);
- }
- break;
- case 4 : /* Visco-Elastic FD kernel */
- viscoelastic4(mod, src, wav, bnd, it, ixsrc, izsrc, src_nwav,
- vx, vz, tzz, txx, txz, rox, roz, l2m, lam, mul,
- tss, tep, tes, r, q, p, verbose);
- break;
- case 5 : /* Elastic FD kernel with S-velocity set to zero*/
- elastic4dc(mod, src, wav, bnd, it, ixsrc, izsrc, src_nwav,
- vx, vz, tzz, txx, txz, rox, roz, l2m, lam, mul, verbose);
- break;
- }
-
- /* write samples to file if rec.nt samples are calculated */
-
-#pragma omp master
-{
- if ( (((it-rec.delay) % rec.skipdt)==0) && (it >= rec.delay) ) {
- int writeToFile, itwritten;
-
- writeToFile = ! ( (((it-rec.delay)/rec.skipdt)+1)%rec.nt );
- itwritten = fileno*(rec.nt)*rec.skipdt;
- /* Note that time step it=0 (t=0 for t**-fields t=-1/2 dt for v*-field) is not recorded */
- isam = (it-rec.delay-itwritten)/rec.skipdt+1;
- /* store time at receiver positions */
- getRecTimes(mod, rec, bnd, it, isam, vx, vz, tzz, txx, txz,
- l2m, rox, roz,
- rec_vx, rec_vz, rec_txx, rec_tzz, rec_txz,
- rec_p, rec_pp, rec_ss, rec_udp, rec_udvz, verbose);
-
- /* at the end of modeling a shot, write receiver array to output file(s) */
- if (writeToFile && (it+rec.skipdt <= it1-1) ) {
- fileno = ( ((it-rec.delay)/rec.skipdt)+1)/rec.nt;
- writeRec(rec, mod, bnd, wav, ixsrc, izsrc, isam+1, ishot, fileno,
- rec_vx, rec_vz, rec_txx, rec_tzz, rec_txz,
- rec_p, rec_pp, rec_ss, rec_udp, rec_udvz, verbose);
- }
- }
-
- /* write snapshots to output file(s) */
- if (sna.nsnap) {
- writeSnapTimes(mod, sna, bnd, wav, ixsrc, izsrc, it, vx, vz, tzz, txx, txz, verbose);
- }
-
- /* calculate beams */
- if(sna.beam) {
- getBeamTimes(mod, sna, vx, vz, tzz, txx, txz,
- beam_vx, beam_vz, beam_txx, beam_tzz, beam_txz,
- beam_p, beam_pp, beam_ss, verbose);
- }
-}
-
-#pragma omp master
-{
- if (verbose) {
- if (it==(it0+100*its)) t2=wallclock_time();
- if (it==(it0+500*its)) {
- t3=wallclock_time();
- tt=(t3-t2)*(((it1-it0)*its)/400.0);
- vmess("Estimated compute time = %.2f s. per shot.",tt);
- vmess("Estimated total compute time = %.2f s.",tinit+shot.n*tt);
- }
- }
-}
-} /* end of OpenMP parallel section */
-
- } /* end of loop over time steps it */
-
- /* write output files: receivers and or beams */
- if (fileno) fileno++;
-
- if (rec.scale==1) { /* scale receiver with distance src-rcv */
- float xsrc, zsrc, Rrec, rdx, rdz;
- int irec;
- xsrc=mod.x0+mod.dx*ixsrc;
- zsrc=mod.z0+mod.dz*izsrc;
- for (irec=0; irec<rec.n; irec++) {
- rdx=mod.x0+rec.xr[irec]-xsrc;
- rdz=mod.z0+rec.zr[irec]-zsrc;
- Rrec = sqrt(rdx*rdx+rdz*rdz);
- fprintf(stderr,"Rec %d is scaled with distance %f R=%.2f,%.2f S=%.2f,%.2f\n", irec, Rrec,rdx,rdz,xsrc,zsrc);
- for (it=0; it<rec.nt; it++) {
- rec_p[irec*rec.nt+it] *= sqrt(Rrec);
- }
- }
- }
- writeRec(rec, mod, bnd, wav, ixsrc, izsrc, isam+1, ishot, fileno,
- rec_vx, rec_vz, rec_txx, rec_tzz, rec_txz,
- rec_p, rec_pp, rec_ss, rec_udp, rec_udvz, verbose);
-
- writeBeams(mod, sna, ixsrc, izsrc, ishot, fileno,
- beam_vx, beam_vz, beam_txx, beam_tzz, beam_txz,
- beam_p, beam_pp, beam_ss, verbose);
-
-
- } /* end of loop over number of shots */
-
-
- t1= wallclock_time();
- if (verbose) {
- vmess("Total compute time FD modelling = %.2f s.", t1-t0);
- }
-
- /* free arrays */
-
- initargs(argc,argv); /* this will free the arg arrays declared */
- free(rox);
- free(roz);
- free(l2m);
- free(src_nwav[0]);
- free(src_nwav);
- free(vx);
- free(vz);
- free(tzz);
- freeStoreSourceOnSurface();
- if (rec.type.vz) free(rec_vz);
- if (rec.type.vx) free(rec_vx);
- if (rec.type.p) free(rec_p);
- if (rec.type.txx) free(rec_txx);
- if (rec.type.tzz) free(rec_tzz);
- if (rec.type.txz) free(rec_txz);
- if (rec.type.pp) free(rec_pp);
- if (rec.type.ss) free(rec_ss);
- if (rec.type.ud) {
- free(rec_udvz);
- free(rec_udp);
- }
- if(sna.beam) {
- if (sna.type.vz) free(beam_vz);
- if (sna.type.vx) free(beam_vx);
- if (sna.type.p) free(beam_p);
- if (sna.type.txx) free(beam_txx);
- if (sna.type.tzz) free(beam_tzz);
- if (sna.type.txz) free(beam_txz);
- if (sna.type.pp) free(beam_pp);
- if (sna.type.ss) free(beam_ss);
- }
-
- if (mod.ischeme==2) {
- free(tss);
- free(tep);
- free(q);
- }
- if (mod.ischeme>2) {
- free(lam);
- free(mul);
- free(txz);
- free(txx);
- }
- if (mod.ischeme==4) {
- free(tss);
- free(tes);
- free(tep);
- free(r);
- free(p);
- free(q);
- }
-
-#ifdef MPI
- MPI_Finalize();
-#endif
-
- return 0;
-}
diff --git a/fdelmodc3D/fdelmodc.h b/fdelmodc3D/fdelmodc.h
deleted file mode 100644
index ed07c68da00636d4e080b9b7baf0393f8218dc62..0000000000000000000000000000000000000000
--- a/fdelmodc3D/fdelmodc.h
+++ /dev/null
@@ -1,190 +0,0 @@
-#include<stdlib.h>
-#include<stdio.h>
-#include<math.h>
-
-typedef struct _compType { /* Receiver Type */
- int vz;
- int vx;
- int p;
- int txx;
- int tzz;
- int txz;
- int pp;
- int ss;
- int ud;
-} compType;
-
-typedef struct _receiverPar { /* Receiver Parameters */
- char *file_rcv;
- compType type;
- int n;
- int nt;
- int delay;
- int skipdt;
- int max_nrec;
- int *z;
- int *x;
- float *zr;
- float *xr;
- int int_p;
- int int_vx;
- int int_vz;
- int scale;
- int sinkdepth;
- int sinkvel;
- float cp;
- float rho;
-} recPar;
-
-typedef struct _snapshotPar { /* Snapshot Parameters */
- char *file_snap;
- char *file_beam;
- compType type;
- int nsnap;
- int delay;
- int skipdt;
- int skipdz;
- int skipdx;
- int nz;
- int nx;
- int z1;
- int z2;
- int x1;
- int x2;
- int vxvztime;
- int beam;
- int withbnd;
-} snaPar;
-
-typedef struct _modelPar { /* Model Parameters */
- int iorder;
- int ischeme;
- int grid_dir;
- int sh;
- char *file_cp;
- char *file_ro;
- char *file_cs;
- char *file_qp;
- char *file_qs;
- float dz;
- float dx;
- float dt;
- float tmod;
- int nt;
- float z0;
- float x0;
- /* medium max/min values */
- float cp_min;
- float cp_max;
- float cs_min;
- float cs_max;
- float ro_min;
- float ro_max;
- int nz;
- int nx;
- int naz;
- int nax;
- /* Vx: rox */
- int ioXx;
- int ioXz;
- int ieXx;
- int ieXz;
- /* Vz: roz */
- int ioZx;
- int ioZz;
- int ieZx;
- int ieZz;
- /* P, Txx, Tzz: lam, l2m */
- int ioPx;
- int ioPz;
- int iePx;
- int iePz;
- /* Txz: muu */
- int ioTx;
- int ioTz;
- int ieTx;
- int ieTz;
- /* attenuation / dissipative medium */
- float Qp;
- float Qs;
- float fw;
- float qr;
-} modPar;
-
-typedef struct _waveletPar { /* Wavelet Parameters */
- char *file_src; /* general source */
- int nsrcf;
- int nt;
- int ns;
- int nx;
- float dt;
- float ds;
- float fmax;
- int random;
- int seed;
- int nst;
- size_t *nsamp;
-} wavPar;
-
-typedef struct _sourcePar { /* Source Array Parameters */
- int n;
- int type;
- int orient;
- int *z;
- int *x;
- int single;
- int plane;
- int circle;
- int array;
- int random;
- float *tbeg;
- float *tend;
- int multiwav;
- float angle;
- float velo;
- float amplitude;
- float dip;
- float strike;
- int distribution;
- int window;
- int injectionrate;
- int sinkdepth;
- int src_at_rcv; /* Indicates that wavefield should be injected at receivers */
-} srcPar;
-
-typedef struct _shotPar { /* Shot Parameters */
- int n;
- int *z;
- int *x;
-} shotPar;
-
-typedef struct _boundPar { /* Boundary Parameters */
- int top;
- int bot;
- int lef;
- int rig;
- float *tapz;
- float *tapx;
- float *tapxz;
- int cfree;
- int ntap;
- int *surface;
- int npml;
- float R; /* reflection at side of model */
- float m; /* scaling order */
- float *pml_Vx;
- float *pml_nzVx;
- float *pml_nxVz;
- float *pml_nzVz;
- float *pml_nxP;
- float *pml_nzP;
-
-} bndPar;
-
-
-#if __STDC_VERSION__ >= 199901L
- /* "restrict" is a keyword */
-#else
-#define restrict
-#endif
-
diff --git a/fdelmodc3D/fdelmodc3D.c b/fdelmodc3D/fdelmodc3D.c
index 1bb3ed3fc890c62e4548ad1867f72114d52647a4..35d1d7bc7b44189e08594698f3d6a5f380b986ec 100644
--- a/fdelmodc3D/fdelmodc3D.c
+++ b/fdelmodc3D/fdelmodc3D.c
@@ -17,66 +17,54 @@ double wallclock_time(void);
void threadAffinity(void);
-long getParameters3D(modPar *mod, recPar *rec, snaPar *sna, wavPar *wav, srcPar *src, shotPar *shot, bndPar *bnd, long verbose);
+long getParameters3D(modPar *mod, recPar *rec, snaPar *sna, wavPar *wav, srcPar *src,
+ shotPar *shot, bndPar *bnd, long verbose);
-long readModel3D(modPar mod, bndPar bnd, float *rox, float *roy, float *roz, float *l2m, float *lam, float *muu, float *tss, float *tes, float *tep);
+long readModel3D(modPar mod, bndPar bnd, float *rox, float *roy, float *roz,
+ float *l2m, float *lam, float *muu, float *tss, float *tes, float *tep);
-long defineSource3D(wavPar wav, srcPar src, modPar mod, recPar rec, float **src_nwav, long reverse, long verbose);
+long defineSource3D(wavPar wav, srcPar src, modPar mod, recPar rec,
+ float **src_nwav, long reverse, long verbose);
-long writeSrcRecPos(modPar *mod, recPar *rec, srcPar *src, shotPar *shot);
+long writeSrcRecPos3D(modPar *mod, recPar *rec, srcPar *src, shotPar *shot);
-long acoustic6(modPar mod, srcPar src, wavPar wav, bndPar bnd, long itime, long ixsrc, long izsrc, float **src_nwav, float *vx, float *vz, float *p, float *rox, float *roz, float *l2m, long verbose);
+long acoustic4_3D(modPar mod, srcPar src, wavPar wav, bndPar bnd, long itime,
+ long ixsrc, long iysrc, long izsrc, float **src_nwav, float *vx, float *vy, float *vz,
+ float *p, float *rox, float *roy, float *roz, float *l2m, long verbose);
-long acoustic4(modPar mod, srcPar src, wavPar wav, bndPar bnd, long itime, long ixsrc, long izsrc, float **src_nwav, float *vx, float *vz, float *p, float *rox, float *roz, float *l2m, long verbose);
-
-long acoustic4pml(modPar mod, srcPar src, wavPar wav, bndPar bnd, long itime, long ixsrc, long izsrc, float **src_nwav, float *vx, float *vz, float *p, float *rox, float *roz, float *l2m, long verbose);
-
-long acousticSH4(modPar mod, srcPar src, wavPar wav, bndPar bnd, long itime, long ixsrc, long izsrc, float **src_nwav, float *tx, float *tz, float *vz, float *rox, float *roz, float *mul, long verbose);
-
-long acoustic4_qr(modPar mod, srcPar src, wavPar wav, bndPar bnd, long itime, long ixsrc, long izsrc, float **src_nwav, float *vx, float *vz, float *p, float *rox, float *roz, float *l2m, long verbose);
-
-long acoustic2(modPar mod, srcPar src, wavPar wav, bndPar bnd, long itime, long ixsrc, long izsrc, float **src_nwav, float *vx, float *vz, float *p, float *rox, float *roz, float *l2m, long verbose);
-
-long acoustic4Block(modPar mod, srcPar src, wavPar wav, bndPar bnd, long itime, long ixsrc, long izsrc, float **src_nwav, float *vx,
-float *vz, float *p, float *rox, float *roz, float *l2m, long verbose);
-
-long viscoacoustic4(modPar mod, srcPar src, wavPar wav, bndPar bnd, long itime, long ixsrc, long izsrc, float **src_nwav, float *vx, float *vz, float *p, float *rox, float *roz, float *l2m, float *tss, float *tep, float *q, long verbose);
-
-long elastic4(modPar mod, srcPar src, wavPar wav, bndPar bnd, long itime, long ixsrc, long izsrc, float **src_nwav, float *vx, float *vz, float *tzz, float *txx, float *txz, float *rox, float *roz, float *l2m, float *lam, float *mul, long verbose);
-
-long elastic4dc(modPar mod, srcPar src, wavPar wav, bndPar bnd, long itime, long ixsrc, long izsrc, float **src_nwav, float *vx, float *vz, float *tzz, float *txx, float *txz, float *rox, float *roz, float *l2m, float *lam, float *mul, long verbose);
-
-long viscoelastic4(modPar mod, srcPar src, wavPar wav, bndPar bnd, long itime, long ixsrc, long izsrc, float **src_nwav, float *vx, float
-*vz, float *tzz, float *txx, float *txz, float *rox, float *roz, float *l2m, float *lam, float *mul, float *ts, float *tep, float
-*tes, float *r, float *q, float *p, long verbose);
-
-long elastic6(modPar mod, srcPar src, wavPar wav, bndPar bnd, long itime, long ixsrc, long izsrc,
- float **src_nwav, float *vx, float *vz, float *tzz, float *txx, float *txz, float *rox,
- float *roz, float *l2m, float *lam, float *mul, long verbose);
-
-long getRecTimes(modPar mod, recPar rec, bndPar bnd, long itime, long isam, float *vx, float *vz, float *tzz, float *txx,
- float *txz, float *l2m, float *rox, float *roz,
- float *rec_vx, float *rec_vz, float *rec_txx, float *rec_tzz, float *rec_txz,
+long getRecTimes3D(modPar mod, recPar rec, bndPar bnd, long itime, long isam,
+ float *vx, float *vy, float *vz, float *tzz, float *tyy, float *txx,
+ float *txz, float *txy, float *tyz, float *l2m,
+ float *rox, float *roy, float *roz, float *rec_vx, float *rec_vy, float *rec_vz,
+ float *rec_txx, float *rec_tyy, float *rec_tzz, float *rec_txz, float *rec_txy, float *rec_tyz,
float *rec_p, float *rec_pp, float *rec_ss, float *rec_udp, float *rec_udvz, long verbose);
-long writeRec(recPar rec, modPar mod, bndPar bnd, wavPar wav, long ixsrc, long izsrc, long nsam, long ishot, long fileno,
- float *rec_vx, float *rec_vz, float *rec_txx, float *rec_tzz, float *rec_txz,
- float *rec_p, float *rec_pp, float *rec_ss, float *rec_udp, float *rec_udvz, long verbose);
+long writeRec3D(recPar rec, modPar mod, bndPar bnd, wavPar wav,
+ long ixsrc, long iysrc, long izsrc, long nsam, long ishot, long fileno,
+ float *rec_vx, float *rec_vy, float *rec_vz, float *rec_txx, float *rec_tyy, float *rec_tzz,
+ float *rec_txz, float *rec_tyz, float *rec_txy,
+ float *rec_p, float *rec_pp, float *rec_ss, float *rec_udp, float *rec_udvz, long verbose);
-long writeSnapTimes(modPar mod, snaPar sna, bndPar bnd, wavPar wav,long ixsrc, long izsrc, long itime,
- float *vx, float *vz, float *tzz, float *txx, float *txz, long verbose);
+long writeSnapTimes3D(modPar mod, snaPar sna, bndPar bnd, wavPar wav,
+ long ixsrc, long iysrc, long izsrc, long itime, float *vx, float *vy, float *vz,
+ float *tzz, float *tyy, float *txx, float *txz, float *tyz, float *txy, long verbose);
-long getBeamTimes(modPar mod, snaPar sna, float *vx, float *vz, float *tzz, float *txx, float *txz,
- float *beam_vx, float *beam_vz, float *beam_txx, float *beam_tzz, float *beam_txz,
- float *beam_p, float *beam_pp, float *beam_ss, long verbose);
+long getBeamTimes3D(modPar mod, snaPar sna, float *vx, float *vy, float *vz,
+ float *tzz, float *tyy, float *txx, float *txz, float *tyz, float *txy,
+ float *beam_vx, float *beam_vy, float *beam_vz,
+ float *beam_txx, float *beam_tyy, float *beam_tzz,
+ float *beam_txz, float *beam_tyz, float *beam_txy,
+ float *beam_p, float *beam_pp, float *beam_ss, long verbose);
-long writeBeams(modPar mod, snaPar sna, long ixsrc, long izsrc, long ishot, long fileno,
- float *beam_vx, float *beam_vz, float *beam_txx, float *beam_tzz, float *beam_txz,
- float *beam_p, float *beam_pp, float *beam_ss, long verbose);
+long writeBeams3D(modPar mod, snaPar sna, long ixsrc, long iysrc, long izsrc, long ishot,
+ long fileno, float *beam_vx, float *beam_vy, float *beam_vz,
+ float *beam_txx, float *beam_tyy, float *beam_tzz,
+ float *beam_txz, float *beam_tyz, float *beam_txy,
+ float *beam_p, float *beam_pp, float *beam_ss, long verbose);
-long allocStoreSourceOnSurface(srcPar src);
+long allocStoreSourceOnSurface3D(srcPar src);
-long freeStoreSourceOnSurface(void);
+long freeStoreSourceOnSurface3D(void);
/* Self documentation */
char *sdoc[] = {
@@ -736,7 +724,7 @@ shared (shot, bnd, mod, src, wav, rec, ixsrc, iysrc, izsrc, it, src_nwav, verbos
free(vy);
free(vz);
free(tzz);
- freeStoreSourceOnSurface();
+ freeStoreSourceOnSurface3D();
if (rec.type.vz) free(rec_vz);
if (rec.type.vy) free(rec_vy);
if (rec.type.vx) free(rec_vx);
diff --git a/fdelmodc3D/getBeamTimes.c b/fdelmodc3D/getBeamTimes.c
deleted file mode 100644
index ae5cff4cad0080810e920a2397d2f4c0df28ac3c..0000000000000000000000000000000000000000
--- a/fdelmodc3D/getBeamTimes.c
+++ /dev/null
@@ -1,196 +0,0 @@
-#define _FILE_OFFSET_BITS 64
-#define _LARGEFILE_SOURCE
-#define _LARGEFILE64_SOURCE
-
-#include <assert.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <errno.h>
-#include <math.h>
-#include <string.h>
-#include "segy.h"
-#include "fdelmodc.h"
-
-/**
-* getBeamTimes: stores energy fields (beams) in arrays at certain time steps
-* writeBeams: writes the stored fields to output file(s)
-*
-* AUTHOR:
-* Jan Thorbecke (janth@xs4all.nl)
-* The Netherlands
-**/
-
-
-FILE *fileOpen(char *file, char *ext, int append);
-int traceWrite(segy *hdr, float *data, int n, FILE *fp);
-void name_ext(char *filename, char *extension);
-void vmess(char *fmt, ...);
-
-#define MAX(x,y) ((x) > (y) ? (x) : (y))
-#define MIN(x,y) ((x) < (y) ? (x) : (y))
-#define NINT(x) ((int)((x)>0.0?(x)+0.5:(x)-0.5))
-
-int getBeamTimes(modPar mod, snaPar sna, float *vx, float *vz, float *tzz, float *txx, float *txz,
- float *beam_vx, float *beam_vz, float *beam_txx, float *beam_tzz, float *beam_txz,
- float *beam_p, float *beam_pp, float *beam_ss, int verbose)
-{
- int n1, ibndx, ibndz, ixs, izs, ize, i, j;
- int ix, iz, ix2, iz2;
- float sdx, s, p;
-
- ibndx = mod.ioPx;
- ibndz = mod.ioPz;
- n1 = mod.naz;
- sdx = 1.0/mod.dx;
- izs = sna.z1+ibndx;
- ize = sna.z2+ibndz;
-
- for (ixs=sna.x1, i=0; ixs<=sna.x2; ixs+=sna.skipdx, i++) {
- ix = ixs+ibndx;
- ix2 = ix+1;
-
- if (sna.type.vx) {
- for (iz=izs, j=0; iz<=ize; iz+=sna.skipdz, j++) {
- beam_vx[i*sna.nz+j] += sqrt(vx[ix2*n1+iz]*vx[ix2*n1+iz]);
- }
- }
- if (sna.type.vz) {
- for (iz=izs, j=0; iz<=ize; iz+=sna.skipdz, j++) {
- beam_vz[i*sna.nz+j] += sqrt(vz[ix*n1+iz+1]*vz[ix*n1+iz+1]);
- }
- }
- if (sna.type.p) {
- for (iz=izs, j=0; iz<=ize; iz+=sna.skipdz, j++) {
- beam_p[i*sna.nz+j] += sqrt(tzz[ix*n1+iz]*tzz[ix*n1+iz]);
- }
- }
- if (sna.type.tzz) {
- for (iz=izs, j=0; iz<=ize; iz+=sna.skipdz, j++) {
- beam_tzz[i*sna.nz+j] += sqrt(tzz[ix*n1+iz]*tzz[ix*n1+iz]);
- }
- }
- if (sna.type.txx) {
- for (iz=izs, j=0; iz<=ize; iz+=sna.skipdz, j++) {
- beam_txx[i*sna.nz+j] += sqrt(txx[ix*n1+iz]*txx[ix*n1+iz]);
- }
- }
- if (sna.type.txz) {
- for (iz=izs, j=0; iz<=ize; iz+=sna.skipdz, j++) {
- beam_txz[i*sna.nz+j] += sqrt(txz[ix2*n1+iz+1]*txz[ix2*n1+iz+1]);
- }
- }
- /* calculate divergence of velocity field */
- if (sna.type.pp) {
- for (iz=izs, j=0; iz<=ize; iz+=sna.skipdz, j++) {
- iz2 = iz+1;
- p = sdx*((vx[ix2*n1+iz]-vx[ix*n1+iz])+
- (vz[ix*n1+iz2]-vz[ix*n1+iz]));
- beam_pp[i*sna.nz+j] += sqrt(p*p);
- }
- }
- /* calculate rotation of velocity field */
- if (sna.type.ss) {
- for (iz=izs, j=0; iz<=ize; iz+=sna.skipdz, j++) {
- iz2 = iz+1;
- s = sdx*((vx[ix2*n1+iz2]-vx[ix2*n1+iz])-
- (vz[ix2*n1+iz2]-vz[ix*n1+iz2]));
- beam_ss[i*sna.nz+j] += sqrt(s*s);
- }
- }
- }
- return 0;
-}
-
-
-int writeBeams(modPar mod, snaPar sna, int ixsrc, int izsrc, int ishot, int fileno,
- float *beam_vx, float *beam_vz, float *beam_txx, float *beam_tzz, float *beam_txz,
- float *beam_p, float *beam_pp, float *beam_ss, int verbose)
-{
- FILE *fpvx, *fpvz, *fptxx, *fptzz, *fptxz, *fpp, *fppp, *fpss;
- int append;
- int ix;
- char number[16], filename[1024];
- segy hdr;
-
- if (sna.beam==0) return 0;
- /* all beam snapshots are written to the same output file(s) */
- if (ishot) append=1;
- else append=0;
-
- strcpy(filename, sna.file_beam);
- if (fileno) {
- sprintf(number,"_%03d",fileno);
- name_ext(filename, number);
- }
- if (verbose>2) vmess("Writing beam data to file %s", filename);
-
-
- if (sna.type.vx) fpvx = fileOpen(filename, "_bvx", append);
- if (sna.type.vz) fpvz = fileOpen(filename, "_bvz", append);
- if (sna.type.p) fpp = fileOpen(filename, "_bp", append);
- if (sna.type.txx) fptxx = fileOpen(filename, "_btxx", append);
- if (sna.type.tzz) fptzz = fileOpen(filename, "_btzz", append);
- if (sna.type.txz) fptxz = fileOpen(filename, "_btxz", append);
- if (sna.type.pp) fppp = fileOpen(filename, "_bpp", append);
- if (sna.type.ss) fpss = fileOpen(filename, "_bss", append);
-
- memset(&hdr,0,TRCBYTES);
- hdr.dt = 1000000*(mod.dt);
- hdr.scalco = -1000;
- hdr.scalel = -1000;
- hdr.sx = 1000*(mod.x0+ixsrc*mod.dx);
- hdr.sdepth = 1000*(mod.z0+izsrc*mod.dz);
- hdr.fldr = ishot+1;
- hdr.trid = 1;
- hdr.ns = sna.nz;
- hdr.trwf = sna.nx;
- hdr.ntr = sna.nx;
- hdr.f1 = sna.z1*mod.dz+mod.z0;
- hdr.f2 = sna.x1*mod.dx+mod.x0;
- hdr.d1 = mod.dz*sna.skipdz;
- hdr.d2 = mod.dx*sna.skipdx;
-
- for (ix=0; ix<sna.nx; ix++) {
- hdr.tracf = ix+1;
- hdr.tracl = ix+1;
- hdr.gx = 1000*(mod.x0+(sna.x1+ix)*mod.dx);
-
- if (sna.type.vx) {
- traceWrite( &hdr, &beam_vx[ix*sna.nz], sna.nz, fpvx) ;
- }
- if (sna.type.vz) {
- traceWrite( &hdr, &beam_vz[ix*sna.nz], sna.nz, fpvz) ;
- }
- if (sna.type.p) {
- traceWrite( &hdr, &beam_p[ix*sna.nz], sna.nz, fpp) ;
- }
- if (sna.type.tzz) {
- traceWrite( &hdr, &beam_tzz[ix*sna.nz], sna.nz, fptzz) ;
- }
- if (sna.type.txx) {
- traceWrite( &hdr, &beam_txx[ix*sna.nz], sna.nz, fptxx) ;
- }
- if (sna.type.txz) {
- traceWrite( &hdr, &beam_txz[ix*sna.nz], sna.nz, fptxz) ;
- }
- if (sna.type.pp) {
- traceWrite( &hdr, &beam_pp[ix*sna.nz], sna.nz, fppp) ;
- }
- if (sna.type.ss) {
- traceWrite( &hdr, &beam_ss[ix*sna.nz], sna.nz, fpss) ;
- }
-
- }
-
- if (sna.type.vx) fclose(fpvx);
- if (sna.type.vz) fclose(fpvz);
- if (sna.type.p) fclose(fpp);
- if (sna.type.txx) fclose(fptxx);
- if (sna.type.tzz) fclose(fptzz);
- if (sna.type.txz) fclose(fptxz);
- if (sna.type.pp) fclose(fppp);
- if (sna.type.ss) fclose(fpss);
-
- return 0;
-}
-
diff --git a/fdelmodc3D/getBeamTimes3D.c b/fdelmodc3D/getBeamTimes3D.c
index f23ef7b7a4e4f163cdef3dc4b8d367b06e910743..de370df45e1b6c5d81b2ca76037040db83421983 100644
--- a/fdelmodc3D/getBeamTimes3D.c
+++ b/fdelmodc3D/getBeamTimes3D.c
@@ -30,9 +30,12 @@ void vmess(char *fmt, ...);
#define MIN(x,y) ((x) < (y) ? (x) : (y))
#define NINT(x) ((long)((x)>0.0?(x)+0.5:(x)-0.5))
-long getBeamTimes3D(modPar mod, snaPar sna, float *vx, float *vy, float *vz, float *tzz, float *tyy, float *txx, float *txz, float *tyz, float *txy,
- float *beam_vx, float *beam_vy, float *beam_vz, float *beam_txx, float *beam_tyy, float *beam_tzz, float *beam_txz, float *beam_tyz, float *beam_txy,
- float *beam_p, float *beam_pp, float *beam_ss, long verbose)
+long getBeamTimes3D(modPar mod, snaPar sna, float *vx, float *vy, float *vz,
+ float *tzz, float *tyy, float *txx, float *txz, float *tyz, float *txy,
+ float *beam_vx, float *beam_vy, float *beam_vz,
+ float *beam_txx, float *beam_tyy, float *beam_tzz,
+ float *beam_txz, float *beam_tyz, float *beam_txy,
+ float *beam_p, float *beam_pp, float *beam_ss, long verbose)
{
long n1, n2, ibndx, ibndy, ibndz, ixs, iys, izs, ize, i, j, l;
long ix, iy, iz, ix2, iy2, iz2;
@@ -130,9 +133,11 @@ long getBeamTimes3D(modPar mod, snaPar sna, float *vx, float *vy, float *vz, flo
}
-long writeBeams3D(modPar mod, snaPar sna, long ixsrc, long iysrc, long izsrc, long ishot, long fileno,
- float *beam_vx, float *beam_vy, float *beam_vz, float *beam_txx, float *beam_tyy, float *beam_tzz, float *beam_txz, float *beam_tyz, float *beam_txy,
- float *beam_p, float *beam_pp, float *beam_ss, long verbose)
+long writeBeams3D(modPar mod, snaPar sna, long ixsrc, long iysrc, long izsrc, long ishot,
+ long fileno, float *beam_vx, float *beam_vy, float *beam_vz,
+ float *beam_txx, float *beam_tyy, float *beam_tzz,
+ float *beam_txz, float *beam_tyz, float *beam_txy,
+ float *beam_p, float *beam_pp, float *beam_ss, long verbose)
{
FILE *fpvx, *fpvy, *fpvz, *fptxx, *fptyy, *fptzz, *fptxz, *fptyz, *fptxy, *fpp, *fppp, *fpss;
long append;
diff --git a/fdelmodc3D/getModelInfo.c b/fdelmodc3D/getModelInfo.c
deleted file mode 100644
index 378a1b50ebac46e5b7b8a8bef4b5365ac15bef9d..0000000000000000000000000000000000000000
--- a/fdelmodc3D/getModelInfo.c
+++ /dev/null
@@ -1,109 +0,0 @@
-#define _FILE_OFFSET_BITS 64
-#define _LARGEFILE_SOURCE
-#define _LARGEFILE64_SOURCE
-
-#include <assert.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <errno.h>
-#include <math.h>
-#include "par.h"
-#include "segy.h"
-
-#define MAX(x,y) ((x) > (y) ? (x) : (y))
-#define MIN(x,y) ((x) < (y) ? (x) : (y))
-#define NINT(x) ((int)((x)>0.0?(x)+0.5:(x)-0.5))
-
-/**
-* reads gridded model file to compute minimum and maximum values and sampling intervals
-*
-* AUTHOR:
-* Jan Thorbecke (janth@xs4all.nl)
-* The Netherlands
-**/
-
-int getModelInfo(char *file_name, int *n1, int *n2, float *d1, float *d2, float *f1, float *f2, float *min, float *max, int *axis, int zeroch, int verbose)
-{
- FILE *fp;
- size_t nread, trace_sz;
- off_t bytes;
- int ret, i, one_shot, ntraces;
- float *trace, cmin;
- segy hdr;
-
- fp = fopen( file_name, "r" );
- assert( fp != NULL);
- nread = fread( &hdr, 1, TRCBYTES, fp );
- assert(nread == TRCBYTES);
- ret = fseeko( fp, 0, SEEK_END );
- if (ret<0) perror("fseeko");
- bytes = ftello( fp );
-
- *n1 = hdr.ns;
- *d1 = hdr.d1;
- *d2 = hdr.d2;
- *f1 = hdr.f1;
- *f2 = hdr.f2;
-
- if ( NINT(100.0*((*d1)/(*d2)))!=100 ) {
- verr("dx and dz are different in the model !");
- }
- if ( NINT(1000.0*(*d1))==0 ) {
- if(!getparfloat("dx",d1)) {
- verr("dx is equal to zero use parameter dx= to set value");
- }
- *d2 = *d1;
- }
- trace_sz = sizeof(float)*(*n1)+TRCBYTES;
- ntraces = (int) (bytes/trace_sz);
- *n2 = ntraces;
-
- /* check to find out min and max values gather */
-
- one_shot = 1;
- trace = (float *)malloc(trace_sz);
- fseeko( fp, TRCBYTES, SEEK_SET );
- nread = fread( trace, sizeof(float), hdr.ns, fp );
- assert (nread == hdr.ns);
- fseeko( fp, TRCBYTES, SEEK_SET );
-
- if (hdr.trid == TRID_DEPTH) *axis = 1; /* samples are z-axis */
- else *axis = 0; /* sample direction respresents the x-axis */
-
- i=0; cmin=trace[0];
- while ( ( (cmin==0.0) && zeroch) && (i<hdr.ns) ) cmin=trace[i++];
-
- *max = cmin;
- *min = cmin;
- /* keep on reading traces until there are no more traces (nread==0) */
- while (one_shot) {
- nread = fread( trace, sizeof(float), hdr.ns, fp );
- assert (nread == hdr.ns);
- for (i=0;i<(*n1);i++) {
- *max = MAX(trace[i],*max);
- cmin = MIN(trace[i],*min);
- if (zeroch) {
- if (cmin!=0.0) *min = MIN(*min, cmin);
- }
- else {
- *min = cmin;
- }
- }
- nread = fread( &hdr, 1, TRCBYTES, fp );
- if (nread==0) break;
- }
- fclose(fp);
- free(trace);
-
- if (verbose>2) {
- vmess("For file %s", file_name);
- vmess("nz=%d nx=%d", *n1, *n2);
- vmess("dz=%f dx=%f", *d1, *d2);
- vmess("min=%f max=%f", *min, *max);
- vmess("zstart=%f xstart=%f", *f1, *f2);
- if (*axis) vmess("sample represent z-axis\n");
- else vmess("sample represent x-axis\n");
- }
- return 0;
-}
-
diff --git a/fdelmodc3D/getModelInfo3D.c b/fdelmodc3D/getModelInfo3D.c
index 894223c895e4d9d7fda4b6bbe1b26c2ec017d63e..0ce9f4951a3a05f11ab8edab9f595d3788741d46 100644
--- a/fdelmodc3D/getModelInfo3D.c
+++ b/fdelmodc3D/getModelInfo3D.c
@@ -22,7 +22,9 @@
* The Netherlands
**/
-long getModelInfo3D(char *file_name, long *n1, long *n2, long *n3, float *d1, float *d2, float *d3, float *f1, float *f2, float *f3, float *min, float *max, long *axis, long zeroch, long verbose)
+long getModelInfo3D(char *file_name, long *n1, long *n2, long *n3,
+ float *d1, float *d2, float *d3, float *f1, float *f2, float *f3,
+ float *min, float *max, long *axis, long zeroch, long verbose)
{
FILE *fp;
size_t nread, trace_sz;
diff --git a/fdelmodc3D/getParameters.c b/fdelmodc3D/getParameters.c
deleted file mode 100644
index 5cec11bcb0b5db4b6d78a9832114dd9738cb83a9..0000000000000000000000000000000000000000
--- a/fdelmodc3D/getParameters.c
+++ /dev/null
@@ -1,1247 +0,0 @@
-#include<stdlib.h>
-#include<stdio.h>
-#include<math.h>
-#include<assert.h>
-#include"par.h"
-#include"fdelmodc3D.h"
-
-#define MAX(x,y) ((x) > (y) ? (x) : (y))
-#define MIN(x,y) ((x) < (y) ? (x) : (y))
-#define NINT(x) ((long)((x)>0.0?(x)+0.5:(x)-0.5))
-
-/**
-*
-* The routine getParameters reads in all parameters to set up a FD modeling.
-* Model and source parameters are used to calculate stability and dispersion relations
-* Source and receiver positions are calculated and checked if they fit into the model.
-*
-* AUTHOR:
-* Jan Thorbecke (janth@xs4all.nl)
-* The Netherlands
-**/
-
-float gaussGen();
-
-long loptncr(long n);
-
-int getModelInfo(char *file_name, int *n1, int *n2, float *d1, float *d2, float *f1, float *f2, float *min, float *max, int *axis, int zeroch, int verbose);
-
-int getWaveletInfo(char *file_src, int *n1, int *n2, float *d1, float *d2, float *f1, float *f2, float *fmax, int *nxm, int verbose);
-
-int getWaveletHeaders(char *file_src, int n1, int n2, float *gx, float *sx, float *gelev, float *selev, int verbose);
-
-
-int recvPar(recPar *rec, float sub_x0, float sub_z0, float dx, float dz, int nx, int nz);
-
-int writesufile(char *filename, float *data, int n1, int n2, float f1, float f2, float d1, float d2);
-
-int getParameters(modPar *mod, recPar *rec, snaPar *sna, wavPar *wav, srcPar *src, shotPar *shot, bndPar *bnd, int verbose)
-{
- int isnapmax1, isnapmax2, isnapmax, sna_nrsna;
- int n1, n2, nx, nz, nsrc, ix, axis, ioPz, is0, optn;
- int idzshot, idxshot, nsrctext;
- int src_ix0, src_iz0, src_ix1, src_iz1;
- int disable_check;
- float cp_min, cp_max, cs_min, cs_max, ro_min, ro_max;
- float stabfactor,dispfactor, cmin, dt, fmax, scl, wfct, tapfact;
- float zstart, xstart,d1,d2,f1,f2,sub_x0,sub_z0;
- float srcendx, srcendz, dx, dz;
- float xsrc, zsrc, dxshot, dzshot, dtshot;
- float dxrcv,dzrcv,dxspread,dzspread;
- float tsnap1, tsnap2, dtsnap, dxsnap, dzsnap, dtrcv;
- float xsnap1, xsnap2, zsnap1, zsnap2, xmax, zmax;
- float xsrc1, xsrc2, zsrc1, zsrc2, tsrc1, tsrc2, tlength, tactive;
- float src_angle, src_velo, p, grad2rad, rdelay, scaledt;
- float *xsrca, *zsrca, rrcv;
- float rsrc, oxsrc, ozsrc, dphisrc, ncsrc;
- size_t nsamp;
- int i, j;
- int cfree;
- int tapleft,tapright,taptop,tapbottom;
- int nxsrc, nzsrc;
- int largeSUfile;
- int is,ntraces,length_random;
- float rand;
- char *src_positions, tmpname[1024];
- char* src_txt;
- FILE *fp;
-
- if (!getparint("verbose",&verbose)) verbose=0;
- if (!getparint("disable_check",&disable_check)) disable_check=0;
- if (!getparint("iorder",&mod->iorder)) mod->iorder=4;
- if (!getparint("ischeme",&mod->ischeme)) mod->ischeme=3;
- if (!getparint("sh",&mod->sh)) mod->sh=0;
-
- if (!getparstring("file_cp",&mod->file_cp)) {
- verr("parameter file_cp required!");
- }
- if (!getparstring("file_den",&mod->file_ro)) {
- verr("parameter file_den required!");
- }
- if (mod->ischeme>2 && mod->ischeme!=5) {
- if (!getparstring("file_cs",&mod->file_cs)) {
- verr("parameter file_cs required!");
- }
- }
- if (!getparstring("file_src",&wav->file_src)) wav->file_src=NULL;
-// if (!getparstring("file_Fx",&wav->file_Fx)) wav->file_Fx=NULL;
-// if (!getparstring("file_Fz",&wav->file_Fz)) wav->file_Fz=NULL;
- if (!getparstring("file_snap",&sna->file_snap)) sna->file_snap="snap.su";
- if (!getparstring("file_beam",&sna->file_beam)) sna->file_beam="beam.su";
- if (!getparstring("file_rcv",&rec->file_rcv)) rec->file_rcv="recv.su";
- if (!getparint("grid_dir",&mod->grid_dir)) mod->grid_dir=0;
- if (!getparint("src_at_rcv",&src->src_at_rcv)) src->src_at_rcv=1;
-
- /* read model parameters, which are used to set up source and receivers and check stability */
-
- getModelInfo(mod->file_cp, &nz, &nx, &dz, &dx, &sub_z0, &sub_x0, &cp_min, &cp_max, &axis, 1, verbose);
- getModelInfo(mod->file_ro, &n1, &n2, &d1, &d2, &zstart, &xstart, &ro_min, &ro_max, &axis, 0, verbose);
- mod->cp_max = cp_max;
- mod->cp_min = cp_min;
- mod->ro_max = ro_max;
- mod->ro_min = ro_min;
- assert( (ro_min != 0.0) );
- if (NINT(100*(dx/d2)) != 100)
- vwarn("dx differs for file_cp and file_den!");
- if (NINT(100*(dz/d1)) != 100)
- vwarn("dz differs for file_cp and file_den!");
- if (nx != n2)
- vwarn("nx differs for file_cp and file_den!");
- if (nz != n1)
- vwarn("nz differs for file_cp and file_den!");
-
- if (mod->ischeme>2 && mod->ischeme!=5) {
- getModelInfo(mod->file_cs, &n1, &n2, &d1, &d2, &zstart, &xstart, &cs_min, &cs_max, &axis, 1, verbose);
- mod->cs_max = cs_max;
- mod->cs_min = cs_min;
- if (NINT(100*(dx/d2)) != 100)
- vwarn("dx differs for file_cp and file_cs!");
- if (NINT(100*(dz/d1)) != 100)
- vwarn("dz differs for file_cp and file_cs!");
- if (nx != n2)
- vwarn("nx differs for file_cp and file_cs!");
- if (nz != n1)
- vwarn("nz differs for file_cp and file_cs!");
- }
- if (mod->ischeme==5) {
- cs_max=0.0; cs_min=0.0;
- mod->cs_max = cs_max;
- mod->cs_min = cs_min;
- }
-
- mod->dz = dz;
- mod->dx = dx;
- mod->nz = nz;
- mod->nx = nx;
-
- /* define wavelet(s), modeling time and wavelet maximum frequency */
-
- if (wav->file_src!=NULL) {
- getWaveletInfo(wav->file_src, &wav->ns, &wav->nx, &wav->ds, &d2, &f1, &f2, &fmax, &ntraces, verbose);
- if (wav->ds <= 0.0) {
- vwarn("dt in wavelet (file_src) equal to 0.0 or negative.");
- vwarn("Use parameter dt= to overule dt from file_src.");
- }
- wav->nt = wav->ns;
- wav->dt = wav->ds;
- if(!getparfloat("tmod",&mod->tmod)) mod->tmod = (wav->nt-1)*wav->dt;
- if(!getparfloat("dt",&mod->dt)) mod->dt=wav->dt;
- if (NINT(wav->ds*1000000) != NINT(mod->dt*1000000)) {
- if (wav->dt > mod->dt) {
- scaledt = wav->dt/mod->dt;
- scaledt = floorf(wav->dt/mod->dt);
- optn = optncr(wav->ns);
- wav->nt = floorf(scaledt*optn);
- vmess("file_src dt-scalefactor=%f : wav.dt=%e ==interpolated==> mod.dt=%e", scaledt, wav->dt, mod->dt);
- wav->dt = mod->dt;
- }
- else {
- wav->dt = mod->dt; /* in case if wav.dt is smaller than 1e-7 and can not be read by SU-getpar */
- }
- }
- if(!getparfloat("fmax",&wav->fmax)) wav->fmax=fmax;
- }
- else {
- fmax = 50;
- if(!getparfloat("dt",&mod->dt)) verr("dt must be given or use file_src=");
- if(!getparfloat("tmod",&mod->tmod)) verr("tmod must be given");
- if(!getparfloat("fmax",&wav->fmax)) wav->fmax=fmax;
- fmax = wav->fmax;
- wav->dt=mod->dt;
- }
- assert(mod->dt!=0.0);
- /* check if receiver delays is defined; option inactive: add delay time to total modeling time */
- if (!getparfloat("rec_delay",&rdelay)) rdelay=0.0;
- rec->delay=NINT(rdelay/mod->dt);
-// mod->tmod += rdelay;
- mod->nt = NINT(mod->tmod/mod->dt);
- dt = mod->dt;
-
- if (!getparint("src_type",&src->type)) src->type=1;
- if (!getparint("src_orient",&src->orient)) {
- src->orient=1;
- if (getparint("dipsrc",&src->orient)) src->orient=2; // for compatability with DELPHI's fdacmod
- }
- if (mod->ischeme<=2) {
- if (src->type>1 && src->type<6)
- verr("Invalid src_type for acoustic scheme!");
- }
- if (mod->ischeme==2 || mod->ischeme==4) {
- if (!getparstring("file_qp",&mod->file_qp)) mod->file_qp=NULL;
- if (!getparstring("file_qs",&mod->file_qs)) mod->file_qs=NULL;
- if (!getparfloat("Qp",&mod->Qp)) mod->Qp=1;
- if (!getparfloat("Qs",&mod->Qs)) mod->Qs=mod->Qp;
- if (!getparfloat("fw",&mod->fw)) mod->fw=0.5*wav->fmax;
- }
-
- /* dissipative medium option for Evert */
- if (mod->ischeme==-1) {
- if (!getparfloat("qr",&mod->qr)) mod->qr=0.1;
- }
- assert(src->type > 0);
-
-/* dispersion factor to 10 points per wavelength (2nd order)
- or 5 points per wavelength (4th order) */
-
- if (mod->iorder == 2) {
- dispfactor=10;
- stabfactor = 1.0/sqrt(2.0);
- }
- else {
- dispfactor = 5;
- stabfactor = 0.606; /* courant number */
- }
-
-
- /* origin of model in real (non-grid) coordinates */
- mod->x0 = sub_x0;
- mod->z0 = sub_z0;
- xmax = sub_x0+(nx-1)*dx;
- zmax = sub_z0+(nz-1)*dz;
-
- if (verbose) {
- vmess("*******************************************");
- vmess("************** general info ***************");
- vmess("*******************************************");
- vmess("tmod = %f",mod->tmod);
- vmess("ntsam = %d dt = %f(%e)",mod->nt, mod->dt, mod->dt);
- if (mod->ischeme == 1) vmess("Acoustic staggered grid, pressure/velocity");
- if (mod->ischeme == 2) vmess("Visco-Acoustic staggered grid, pressure/velocity");
- if (mod->ischeme == 3) vmess("Elastic staggered grid, stress/velocity");
- if (mod->ischeme == 4) vmess("Visco-Elastic staggered grid, stress/velocity");
- if (mod->ischeme == 5) vmess("Acoustic staggered grid, Txx/Tzz/velocity");
- if (mod->grid_dir) vmess("Time reversed modelling");
- else vmess("Forward modelling");
- vmess("*******************************************");
- vmess("*************** model info ****************");
- vmess("*******************************************");
- vmess("nz = %8d nx = %8d", nz, nx);
- vmess("dz = %8.4f dx = %8.4f", dz, dx);
- vmess("zmin = %8.4f zmax = %8.4f", sub_z0, zmax);
- vmess("xmin = %8.4f xmax = %8.4f", sub_x0, xmax);
- vmess("min(cp) = %9.3f max(cp) = %9.3f", cp_min, cp_max);
- if (mod->ischeme>2 && mod->ischeme!=5) vmess("min(cs) = %9.3f max(cs) = %9.3f", cs_min, cs_max);
- vmess("min(ro) = %9.3f max(ro) = %9.3f", ro_min, ro_max);
- if (mod->ischeme==2 || mod->ischeme==4) {
- if (mod->file_qp!=NULL) vmess("Qp from file %s ", mod->file_qp);
- else vmess("Qp = %9.3f ", mod->Qp);
- vmess("at freq = %5.3f", mod->fw);
- }
- if (mod->ischeme==4) {
- if (mod->file_qs!=NULL) vmess("Qs from file %s ", mod->file_qs);
- else vmess("Qs = %9.3f ", mod->Qs);
- vmess("at freq = %5.3f", mod->fw);
- }
- }
-
- if (mod->ischeme <= 2) {
- cmin = cp_min;
- }
- else {
- cmin = cs_min;
- if ( (cmin<1e-20) || (cp_min<cs_min) ) cmin=cp_min;
- }
-
- if (verbose) {
- vmess("*******************************************");
- vmess("******** dispersion and stability *********");
- vmess("*******************************************");
- vmess("Dispersion criterion is %3d points per wavelength: ", NINT(dispfactor));
- vmess(" ====> wavelength > %f m [dx*disp]", dx*dispfactor);
-// vmess("The minimum velocity in the model is %f",cmin);
-// vmess("Hence, for acceptable grid-dispersion the maximum");
- vmess("The maximum frequency in source wavelet must be:");
- vmess(" ====> frequency < %f Hz. [Cmin/dx*disp]", cmin/(dx*dispfactor));
- vmess("Stability criterion for current settings: ");
- vmess(" ====> Cp < %f m/s [dx*disp/dt]", dx*stabfactor/dt);
-// vmess("With dt = %f maximum velocity = %f",dt, dx*stabfactor/dt);
- if (wav->file_src != NULL) vmess(" For wavelet(s) in file_src fmax = %f", fmax);
- vmess("Optimal discretisation for current model:");
- vmess(" With maximum velocity = %f dt <= %e", cp_max,dx*stabfactor/cp_max);
- vmess(" With maximum frequency = %f dx <= %e", wav->fmax, cmin/(wav->fmax*dispfactor));
- }
-
- /* Check stability and dispersion setting */
-
- if (cp_max > dx*stabfactor/dt) {
- vwarn("************ ! Stability ! ****************");
- vwarn("From the input file maximum P-wave velocity");
- vwarn("in the current model is %f !!", cp_max);
- vwarn("Hence, adjust dx >= %.4f,",cp_max*dt/stabfactor);
- vwarn(" or adjust dt <= %f,",dx*stabfactor/cp_max);
- vwarn(" or lower the maximum velocity below %.3f m/s.",dx*stabfactor/dt);
- vwarn("***************** !!! *********************");
- if (!disable_check) verr("********* leaving program *********");
- }
- if (wav->fmax > cmin/(dx*dispfactor)) {
- vwarn("*********** ! Dispersion ! ****************");
- vwarn("The maximum frequency in the source wavelet is");
- vwarn("%.3f for stable modeling fmax < %.3f ", wav->fmax, cmin/(dx*dispfactor));
- vwarn("Hence, adjust dx <= %.4f",cmin/(wav->fmax*dispfactor));
- vwarn(" or adjust fmax <= %f (overruled with parameter fmax=),",cmin/(dx*dispfactor));
- vwarn(" or increase the minimum velocity above %.3f m/s.",dx*dispfactor*wav->fmax);
- vwarn("***************** !!! *********************");
- if (!disable_check) verr("********* leaving program *********");
- }
-
- /* to support old parameter interface */
- if (!getparint("cfree",&cfree)) taptop=1;
- if (!getparint("tapleft",&tapleft)) tapleft=0;
- if (!getparint("tapright",&tapright)) tapright=0;
- if (!getparint("taptop",&taptop)) taptop=0;
- if (!getparint("tapbottom",&tapbottom)) tapbottom=0;
-
- if (tapleft) bnd->lef=4;
- else bnd->lef=1;
- if (tapright) bnd->rig=4;
- else bnd->rig=1;
- if (taptop) bnd->top=4;
- else bnd->top=1;
- if (tapbottom) bnd->bot=4;
- else bnd->bot=1;
-
- /* define the type of boundaries */
- /* 1=free 2=pml 3=rigid 4=taper */
- if (!getparint("left",&bnd->lef) && !tapleft) bnd->lef=4;
- if (!getparint("right",&bnd->rig)&& !tapright) bnd->rig=4;
- if (!getparint("top",&bnd->top) && !taptop) bnd->top=1;
- if (!getparint("bottom",&bnd->bot) && !tapbottom) bnd->bot=4;
-
- /* calculate default taper length to be three wavelenghts */
- if (!getparint("ntaper",&bnd->ntap)) bnd->ntap=0; // bnd->ntap=3*NINT((cp_max/wav->fmax)/dx);
- if (!bnd->ntap) if (!getparint("npml",&bnd->ntap)) bnd->ntap=3*NINT((cp_max/wav->fmax)/dx);
- if (!getparfloat("R",&bnd->R)) bnd->R=1e-5;
- if (!getparfloat("m",&bnd->m)) bnd->m=2.0;
- bnd->npml=bnd->ntap;
-
-/*
- if (!getparint("boundary",&boundary)) boundary=1;
- for (ibnd=0;ibnd<4;ibnd++) {
- if (boundary == 1) {
- bnd->free[ibnd]=1;
- bnd->rig[ibnd]=0;
- bnd->tap[ibnd]=0;
- }
- else if (boundary == 3) {
- bnd->free[ibnd]=0;
- bnd->rig[ibnd]=1;
- bnd->tap[ibnd]=0;
- }
- else if (boundary == 4) {
- bnd->free[ibnd]=0;
- bnd->rig[ibnd]=0;
- bnd->tap[ibnd]=bnd->ntap;
- }
- }
- if (!getparint("tapleft",&tapleft)) tapleft=0;
- if (!getparint("tapright",&tapright)) tapright=0;
- if (!getparint("taptop",&taptop)) taptop=0;
- if (!getparint("tapbottom",&tapbottom)) tapbottom=0;
-
- if (tapleft) {
- bnd->free[3]=0;
- bnd->rig[3]=0;
- bnd->tap[3]=bnd->ntap;
- }
- else {
- bnd->tap[3]=0;
- bnd->free[3]=1;
- }
- if (tapright) {
- bnd->free[1]=0;
- bnd->rig[1]=0;
- bnd->tap[1]=bnd->ntap;
- }
- else {
- bnd->tap[1]=0;
- bnd->free[1]=1;
- }
-
- if (taptop) {
- bnd->free[0]=0;
- bnd->rig[0]=0;
- bnd->tap[0]=bnd->ntap;
- }
- else {
- bnd->tap[0]=0;
- bnd->free[0]=1;
- }
- if (tapbottom) {
- bnd->free[2]=0;
- bnd->rig[2]=0;
- bnd->tap[2]=bnd->ntap;
- }
- else {
- bnd->tap[2]=0;
- bnd->free[2]=1;
- }
-
- if (cfree) {
- bnd->free[0]=1;
- bnd->rig[0]=0;
- bnd->tap[0]=0;
- }
-*/
-
- if (bnd->ntap) {
- bnd->tapx = (float *)malloc(bnd->ntap*sizeof(float));
- bnd->tapz = (float *)malloc(bnd->ntap*sizeof(float));
- bnd->tapxz = (float *)malloc(bnd->ntap*bnd->ntap*sizeof(float));
- if(!getparfloat("tapfact",&tapfact)) tapfact=0.30;
- scl = tapfact/((float)bnd->ntap);
- for (i=0; i<bnd->ntap; i++) {
- wfct = (scl*i);
- bnd->tapx[i] = exp(-(wfct*wfct));
-
- wfct = (scl*(i+0.5));
- bnd->tapz[i] = exp(-(wfct*wfct));
- }
- for (j=0; j<bnd->ntap; j++) {
- for (i=0; i<bnd->ntap; i++) {
- wfct = (scl*sqrt(i*i+j*j));
- bnd->tapxz[j*bnd->ntap+i] = exp(-(wfct*wfct));
- }
- }
- }
-
-/* To write tapers for in manual
- free(bnd->tapx);
- bnd->tapx = (float *)malloc(20*bnd->ntap*sizeof(float));
- for (j=0; j<20; j++) {
- tapfact = j*0.1;
- scl = tapfact/((float)bnd->ntap);
- for (i=0; i<bnd->ntap; i++) {
- wfct = (scl*i);
- bnd->tapx[j*bnd->ntap+i] = exp(-(wfct*wfct));
- }
- }
- writesufile("tapx.su", bnd->tapx, bnd->ntap, 20, 0.0, 0.0, 1, 1);
-*/
-
- /* Vx: rox */
- mod->ioXx=mod->iorder/2;
- mod->ioXz=mod->iorder/2-1;
- /* Vz: roz */
- mod->ioZx=mod->iorder/2-1;
- mod->ioZz=mod->iorder/2;
- /* P, Txx, Tzz: lam, l2m */
- mod->ioPx=mod->iorder/2-1;
- mod->ioPz=mod->ioPx;
- /* Txz: mul */
- mod->ioTx=mod->iorder/2;
- mod->ioTz=mod->ioTx;
-
- /* end loop iteration in FD kernels */
- /* Vx: rox */
- mod->ieXx=nx+mod->ioXx;
- mod->ieXz=nz+mod->ioXz;
- /* Vz: roz */
- mod->ieZx=nx+mod->ioZx;
- mod->ieZz=nz+mod->ioZz;
- /* P, Txx, Tzz: lam, l2m */
- mod->iePx=nx+mod->ioPx;
- mod->iePz=nz+mod->ioPz;
- /* Txz: muu */
- mod->ieTx=nx+mod->ioTx;
- mod->ieTz=nz+mod->ioTz;
-
- mod->naz = mod->nz+mod->iorder;
- mod->nax = mod->nx+mod->iorder;
-
- /* for tapered and PML extra points are needed at the boundaries of the model */
-
- if (bnd->top==4 || bnd->top==2) {
- mod->naz += bnd->ntap;
- mod->ioXz += bnd->ntap;
- mod->ioZz += bnd->ntap;
- mod->ieXz += bnd->ntap;
- mod->ieZz += bnd->ntap;
-
- /* For P/Tzz, Txx and Txz fields the tapered boundaries are calculated in the main kernels */
- //mod->ioPz += bnd->ntap;
-// mod->ioTz += bnd->ntap;
- mod->iePz += bnd->ntap;
- mod->ieTz += bnd->ntap;
-
- }
- if (bnd->bot==4 || bnd->bot==2) {
- mod->naz += bnd->ntap;
- /* For P/Tzz, Txx and Txz fields the tapered boundaries are calculated in the main kernels */
- mod->iePz += bnd->ntap;
- mod->ieTz += bnd->ntap;
- }
- if (bnd->lef==4 || bnd->lef==2) {
- mod->nax += bnd->ntap;
- mod->ioXx += bnd->ntap;
- mod->ioZx += bnd->ntap;
- mod->ieXx += bnd->ntap;
- mod->ieZx += bnd->ntap;
-
- /* For Tzz, Txx and Txz fields the tapered boundaries are calculated in the main kernels */
-// mod->ioPx += bnd->ntap;
-// mod->ioTx += bnd->ntap;
- mod->iePx += bnd->ntap;
- mod->ieTx += bnd->ntap;
- }
- if (bnd->rig==4 || bnd->rig==2) {
- mod->nax += bnd->ntap;
- /* For P/Tzz, Txx and Txz fields the tapered boundaries are calculated in the main kernels */
- mod->iePx += bnd->ntap;
- mod->ieTx += bnd->ntap;
- }
-
-/*
- fprintf(stderr,"ioXx=%d ieXx=%d\n", mod->ioXx, mod->ieXx);
- fprintf(stderr,"ioZx=%d ieZx=%d\n", mod->ioZx, mod->ieZx);
- fprintf(stderr,"ioPx=%d iePx=%d\n", mod->ioPx, mod->iePx);
- fprintf(stderr,"ioTx=%d ieTx=%d\n", mod->ioTx, mod->ieTx);
-
- fprintf(stderr,"ioXz=%d ieXz=%d\n", mod->ioXz, mod->ieXz);
- fprintf(stderr,"ioZz=%d ieZz=%d\n", mod->ioZz, mod->ieZz);
- fprintf(stderr,"ioPz=%d iePz=%d\n", mod->ioPz, mod->iePz);
- fprintf(stderr,"ioTz=%d ieTz=%d\n", mod->ioTz, mod->ieTz);
-*/
-
- /* Intialize the array which contains the topography surface */
- if (bnd->top==4 || bnd->top==2) ioPz=mod->ioPz - bnd->ntap;
- else ioPz=mod->ioPz;
- ioPz=mod->ioPz;
- bnd->surface = (int *)malloc((mod->nax+mod->naz)*sizeof(int));
- for (ix=0; ix<mod->nax+mod->naz; ix++) {
- bnd->surface[ix] = ioPz;
- }
-
- if (verbose) {
- vmess("*******************************************");
- vmess("************* boundary info ***************");
- vmess("*******************************************");
- vmess("*** 1=free 2=pml 3=rigid 4=tapered ***");
- vmess("Top boundary : %d",bnd->top);
- vmess("Left boundary : %d",bnd->lef);
- vmess("Right boundary : %d",bnd->rig);
- vmess("Bottom boundary : %d",bnd->bot);
- vmess("taper lenght = %d points",bnd->ntap);
- }
-
- /* define the number and type of shots to model */
- /* each shot can have multiple sources arranged in different ways */
-
- if (!getparfloat("xsrc",&xsrc)) xsrc=sub_x0+((nx-1)*dx)/2.0;
- if (!getparfloat("zsrc",&zsrc)) zsrc=sub_z0;
-// if (!getparint("nsrc",&nsrc)) nsrc=1;
-
- if (!getparint("nshot",&shot->n)) shot->n=1;
- if (!getparfloat("dxshot",&dxshot)) dxshot=dx;
- if (!getparfloat("dzshot",&dzshot)) dzshot=0.0;
- if (!getparfloat("dip",&src->dip)) src->dip=0.0;
- if (!getparfloat("strike",&src->strike)) src->strike=1.0;
- if (src->strike>=0) src->strike=0.5*M_PI;
- else src->strike = -0.5*M_PI;
- src->dip = M_PI*(src->dip/180.0);
-
- if (shot->n>1) {
- idxshot=MAX(0,NINT(dxshot/dx));
- idzshot=MAX(0,NINT(dzshot/dz));
- }
- else {
- idxshot=0.0;
- idzshot=0.0;
- }
-
- /* calculate the shot positions */
-
- src_ix0=MAX(0,NINT((xsrc-sub_x0)/dx));
- src_ix0=MIN(src_ix0,nx);
- src_iz0=MAX(0,NINT((zsrc-sub_z0)/dz));
- src_iz0=MIN(src_iz0,nz);
- srcendx=(shot->n-1)*dxshot+xsrc;
- srcendz=(shot->n-1)*dzshot+zsrc;
- src_ix1=MAX(0,NINT((srcendx-sub_x0)/dx));
- src_ix1=MIN(src_ix1,nx);
- src_iz1=MAX(0,NINT((srcendz-sub_z0)/dz));
- src_iz1=MIN(src_iz1,nz);
-
- shot->x = (int *)calloc(shot->n,sizeof(int));
- shot->z = (int *)calloc(shot->n,sizeof(int));
- for (is=0; is<shot->n; is++) {
- shot->x[is] = src_ix0+is*idxshot;
- shot->z[is] = src_iz0+is*idzshot;
- if (shot->x[is] > nx-1) shot->n = is-1;
- if (shot->z[is] > nz-1) shot->n = is-1;
- }
-
- /* check if source array is defined */
-
- nxsrc = countparval("xsrca");
- nzsrc = countparval("zsrca");
- if (nxsrc != nzsrc) {
- verr("Number of sources in array xsrca (%d), zsrca(%d) are not equal",nxsrc, nzsrc);
- }
-
- /* source positions defined through txt file */
- if (!getparstring("src_txt",&src_txt)) src_txt=NULL;
-
- /* check if sources on a circle are defined */
-
- if (getparfloat("rsrc", &rsrc)) {
- if (!getparfloat("dphisrc",&dphisrc)) dphisrc=2.0;
- if (!getparfloat("oxsrc",&oxsrc)) oxsrc=0.0;
- if (!getparfloat("ozsrc",&ozsrc)) ozsrc=0.0;
- ncsrc = NINT(360.0/dphisrc);
- src->n = nsrc;
-
- src->x = (int *)malloc(ncsrc*sizeof(int));
- src->z = (int *)malloc(ncsrc*sizeof(int));
-
- for (ix=0; ix<ncsrc; ix++) {
- src->x[ix] = NINT((oxsrc-sub_x0+rsrc*cos(((ix*dphisrc)/360.0)*(2.0*M_PI)))/dx);
- src->z[ix] = NINT((ozsrc-sub_z0+rsrc*sin(((ix*dphisrc)/360.0)*(2.0*M_PI)))/dz);
- if (verbose>4) fprintf(stderr,"Source on Circle: xsrc[%d]=%d zsrc=%d\n", ix, src->x[ix], src->z[ix]);
- }
-
- }
-
-
- /* TO DO propagate src_positions parameter and structure through code */
-
- if (!getparstring("src_positions",&src_positions)) src_positions="single";
- wav->random=0;
- src->random=0;
- src->plane=0;
- src->array=0;
- src->single=0;
- if (strstr(src_positions, "single")) src->single=1;
- else if (strstr(src_positions, "array")) src->array=1;
- else if (strstr(src_positions, "random")) src->random=1;
- else if (strstr(src_positions, "plane")) src->plane=1;
- else src->single=1;
-
- /* to maintain functionality of older parameters usage */
- if (!getparint("src_random",&src->random)) src->random=0;
- if (!getparint("plane_wave",&src->plane)) src->plane=0;
-
- if (src->random) {
- if (!getparint("wav_random",&wav->random)) wav->random=1;
- src->plane=0;
- src->array=0;
- src->single=0;
- }
- else {
- if (!getparint("wav_random",&wav->random)) wav->random=0;
- }
- if (src->plane) {
- src->random=0;
- src->array=0;
- src->single=0;
- }
-
- if (!wav->random) assert (wav->file_src != NULL);
- if (wav->random) {
- wav->nt=mod->nt;
- wav->dt=mod->dt;
- wav->nx=1;
- }
-
-
- /* number of sources per shot modeling */
-
- if (!getparint("src_window",&src->window)) src->window=0;
- if (!getparfloat("src_angle",&src_angle)) src_angle=0.;
- if (!getparfloat("src_velo",&src_velo)) src_velo=1500.;
- if (!getparint("distribution",&src->distribution)) src->distribution=0;
- if (!getparint("src_multiwav",&src->multiwav)) src->multiwav=0;
- if (!getparfloat("amplitude", &src->amplitude)) src->amplitude=0.0;
- if (!getparfloat("tlength", &tlength)) tlength=mod->dt*(mod->nt-1);
- if (!getparint("src_injectionrate", &src->injectionrate)) src->injectionrate=0;
- if (src->random && nxsrc==0) {
- if (!getparint("nsrc",&nsrc)) nsrc=1;
- if (!getparint("seed",&wav->seed)) wav->seed=10;
- if (!getparfloat("xsrc1", &xsrc1)) xsrc1=sub_x0;
- if (!getparfloat("xsrc2", &xsrc2)) xsrc2=xmax;
- if (!getparfloat("zsrc1", &zsrc1)) zsrc1=sub_z0;
- if (!getparfloat("zsrc2", &zsrc2)) zsrc2=zmax;
- if (!getparfloat("tsrc1", &tsrc1)) tsrc1=0.0;
- if (!getparfloat("tsrc2", &tsrc2)) tsrc2=mod->tmod;
- if (!getparfloat("tactive", &tactive)) tactive=tsrc2;
- tsrc2 = MIN(tsrc2, mod->tmod);
- if (!getparfloat("tlength", &tlength)) tlength=tsrc2-tsrc1;
- if (!getparint("length_random", &length_random)) length_random=1;
- dxshot = xsrc2-xsrc1;
- dzshot = zsrc2-zsrc1;
- dtshot = tsrc2-tsrc1;
- if (wav->random) {
- if (!getparint("src_multiwav",&src->multiwav)) src->multiwav=1;
- if (src->multiwav) wav->nx = nsrc;
- else wav->nx = 1;
- }
- if (wav->random) wav->nt = NINT(tlength/mod->dt)+1;
- src->tbeg = (float *)malloc(nsrc*sizeof(float));
- src->tend = (float *)malloc(nsrc*sizeof(float));
- wav->nsamp = (size_t *)malloc((nsrc+1)*sizeof(size_t));
- src->x = (int *)malloc(nsrc*sizeof(int));
- src->z = (int *)malloc(nsrc*sizeof(int));
- nsamp = 0;
- srand48(wav->seed);
- for (is=0; is<nsrc; is++) {
- rand = (float)drand48();
- src->x[is] = NINT((xsrc1+rand*dxshot-sub_x0)/dx);
- rand = (float)drand48();
- src->z[is] = NINT((zsrc1+rand*dzshot-sub_z0)/dz);
- if (length_random) rand = (float)drand48();
- else rand = 0.0;
- src->tbeg[is] = tsrc1+rand*(dtshot);
- if (wav->random) {
- if (src->distribution) rand = fabsf(tlength+gaussGen()*tlength);
- else rand = (float)drand48()*tlength;
- if (length_random!=1) rand = tlength;
- src->tend[is] = MIN(src->tbeg[is]+rand, tactive);
- wav->nsamp[is] = (size_t)(NINT((src->tend[is]-src->tbeg[is])/mod->dt)+1);
- }
- else {
- src->tend[is] = MIN(src->tbeg[is]+(wav->nt-1)*wav->dt,mod->tmod);
- wav->nsamp[is] = wav->nt;
- }
- nsamp += wav->nsamp[is];
- if (verbose>3) {
- vmess("Random xsrc=%f zsrc=%f src_tbeg=%f src_tend=%f nsamp=%ld",src->x[is]*dx, src->z[is]*dz, src->tbeg[is], src->tend[is], wav->nsamp[is]);
- }
- }
- wav->nsamp[nsrc] = nsamp; /* put total number of samples in last position */
- wav->nst = nsamp; /* put total number of samples in nst part */
-
-/* write time and length of source signals */
-
- if (verbose>3) {
- float *dum;
- dum = (float *)calloc(mod->nt, sizeof(float));
- for (is=0; is<nsrc; is++) {
- dum[(int)floor(src->tbeg[is]/mod->dt)] = src->tend[is]-src->tbeg[is];
- }
- FILE *fp;
- sprintf(tmpname,"srcTimeLengthN=%d.bin",mod->nt);
- fp = fopen(tmpname, "w+");
- fwrite(dum, sizeof(float), mod->nt, fp);
- fclose(fp);
- free(dum);
- }
-
- }
- else if ( (nxsrc != 0) || (src_txt != NULL) ) {
- /* source array is defined */
- if (src_txt!=NULL) {
- /* Sources from a Text File */
- /* Open text file */
- nsrctext=0;
- fp=fopen(src_txt,"r");
- assert(fp!=NULL);
- /* Get number of lines */
- while (!feof(fp)) if (fgetc(fp)=='\n') nsrctext++;
- fseek(fp,-1,SEEK_CUR);
- if (fgetc(fp)!='\n') nsrctext++; /* Checks if last line terminated by /n */
- if (verbose) vmess("Number of sources in src_txt file: %d",nsrctext);
- rewind(fp);
- nsrc=nsrctext;
- }
- else {
- nsrc=nxsrc;
- }
- /* Allocate arrays */
- src->x = (int *)malloc(nsrc*sizeof(int));
- src->z = (int *)malloc(nsrc*sizeof(int));
- src->tbeg = (float *)malloc(nsrc*sizeof(float));
- src->tend = (float *)malloc(nsrc*sizeof(float));
- xsrca = (float *)malloc(nsrc*sizeof(float));
- zsrca = (float *)malloc(nsrc*sizeof(float));
- if (src_txt!=NULL) {
- /* Read in source coordinates */
- for (i=0;i<nsrc;i++) {
- if (fscanf(fp,"%e %e\n",&xsrca[i],&zsrca[i])!=2) vmess("Source Text File: Can not parse coordinates on line %d.",i);
- }
- /* Close file */
- fclose(fp);
- }
- else {
- getparfloat("xsrca", xsrca);
- getparfloat("zsrca", zsrca);
- }
- /* Process coordinates */
- for (is=0; is<nsrc; is++) {
- src->x[is] = NINT((xsrca[is]-sub_x0)/dx);
- src->z[is] = NINT((zsrca[is]-sub_z0)/dz);
- src->tbeg[is] = 0.0;
- src->tend[is] = (wav->nt-1)*wav->dt;
- if (verbose>3) fprintf(stderr,"Source Array: xsrc[%d]=%f zsrc=%f\n", is, xsrca[is], zsrca[is]);
- }
-
- src->random = 1;
- wav->nsamp = (size_t *)malloc((nsrc+1)*sizeof(size_t));
- if (wav->random) {
- if (!getparint("src_multiwav",&src->multiwav)) src->multiwav=1;
- if (src->multiwav) wav->nx = nsrc;
- else wav->nx = 1;
- wav->nt = NINT(tlength/mod->dt)+1;
- nsamp=0;
- for (is=0; is<nsrc; is++) {
- rand = (float)drand48()*tlength;
- src->tend[is] = MIN(src->tbeg[is]+rand, mod->tmod);
- wav->nsamp[is] = (size_t)(NINT((src->tend[is]-src->tbeg[is])/mod->dt)+1);
- nsamp += wav->nsamp[is];
- }
- wav->nsamp[nsrc] = nsamp; /* put total number of samples in last position */
- wav->nst = nsamp; /* put total number of samples in nst part */
- }
- else {
- nsamp=0;
- for (is=0; is<nsrc; is++) {
- wav->nsamp[is] = wav->nt;
- nsamp += wav->nsamp[is];
- }
- wav->nsamp[nsrc] = nsamp; /* put total number of samples in last position */
- wav->nst = nsamp; /* put total number of samples in nst part */
- }
- free(xsrca);
- free(zsrca);
- }
- else if (wav->nx > 1) {
- /* read file_src for number of sources and receiver positions */
- if (!getparint("src_multiwav",&src->multiwav)) src->multiwav=1;
- float *gx, *sx, *gelev, *selev;
- gx = (float *)malloc(wav->nx*sizeof(float));
- sx = (float *)malloc(wav->nx*sizeof(float));
- gelev = (float *)malloc(wav->nx*sizeof(float));
- selev = (float *)malloc(wav->nx*sizeof(float));
- getWaveletHeaders(wav->file_src, wav->ns, wav->nx, gx, sx, gelev, selev, verbose);
- nsrc = wav->nx;
- src->x = (int *)malloc(nsrc*sizeof(int));
- src->z = (int *)malloc(nsrc*sizeof(int));
- src->tbeg = (float *)malloc(nsrc*sizeof(float));
- src->tend = (float *)malloc(nsrc*sizeof(float));
- wav->nsamp = (size_t *)malloc((nsrc+1)*sizeof(size_t));
- nsamp=0;
- for (is=0; is<nsrc; is++) {
- if (src->src_at_rcv>0){
- src->x[is] = NINT((gx[is]-sub_x0)/dx);
- src->z[is] = NINT((gelev[is]-sub_z0)/dz);
- if (verbose>3) fprintf(stderr,"Source Array: xsrc[%d]=%f %d zsrc=%f %d\n", is, gx[is], src->x[is], gelev[is], src->z[is]);
- }
- else {
- src->x[is]=NINT((sx[is]-sub_x0)/dx);
- src->z[is]=NINT((selev[is]-sub_z0)/dz);
- if (verbose>3) fprintf(stderr,"Source Array: xsrc[%d]=%f %d zsrc=%f %d\n", is, sx[is], src->x[is], selev[is], src->z[is]);
- }
- src->tbeg[is] = 0.0;
- src->tend[is] = (wav->nt-1)*wav->dt;
- wav->nsamp[is] = (size_t)(NINT((src->tend[is]-src->tbeg[is])/mod->dt)+1);
- nsamp += wav->nsamp[is];
- }
- wav->nsamp[nsrc] = nsamp; /* put total number of samples in last position */
- free(gx);
- free(sx);
- free(gelev);
- free(selev);
- }
- else {
- if (src->plane) { if (!getparint("nsrc",&nsrc)) nsrc=1;}
- else nsrc=1;
-
- if (nsrc > nx) {
- vwarn("Number of sources used in plane wave is larger than ");
- vwarn("number of gridpoints in X. Plane wave will be clipped to the edges of the model");
- nsrc = mod->nx;
- }
-
- /* for a source defined on mutliple gridpoint calculate p delay factor */
-
- src->x = (int *)malloc(nsrc*sizeof(int));
- src->z = (int *)malloc(nsrc*sizeof(int));
- src->tbeg = (float *)malloc(nsrc*sizeof(float));
- src->tend = (float *)malloc(nsrc*sizeof(float));
- grad2rad = 17.453292e-3;
- p = sin(src_angle*grad2rad)/src_velo;
- if (p < 0.0) {
- for (is=0; is<nsrc; is++) {
- src->tbeg[is] = fabsf((nsrc-is-1)*dx*p);
- }
- }
- else {
- for (is=0; is<nsrc; is++) {
- src->tbeg[is] = is*dx*p;
- }
- }
- for (is=0; is<nsrc; is++) {
- src->tend[is] = src->tbeg[is] + (wav->nt-1)*wav->dt;
- }
-
- is0 = -1*floor((nsrc-1)/2);
- for (is=0; is<nsrc; is++) {
- src->x[is] = is0 + is;
- src->z[is] = 0;
- }
-
- if (wav->random) {
- if (!getparint("src_multiwav",&src->multiwav)) src->multiwav=1;
- if (src->multiwav) wav->nx = nsrc;
- else wav->nx = 1;
- wav->nt = NINT(tlength/mod->dt)+1;
- wav->nsamp = (size_t *)malloc((wav->nx+1)*sizeof(size_t));
- nsamp=0;
- for (is=0; is<wav->nx; is++) {
- rand = (float)drand48()*tlength;
- src->tend[is] = MIN(src->tbeg[is]+rand, mod->tmod);
- wav->nsamp[is] = (size_t)(NINT((src->tend[is]-src->tbeg[is])/mod->dt)+1);
- nsamp += wav->nsamp[is];
- }
- wav->nsamp[nsrc] = nsamp; /* put total number of samples in last position */
- wav->nst = nsamp; /* put total number of samples in nst part */
- }
- else {
- wav->nsamp = (size_t *)malloc((nsrc+1)*sizeof(size_t));
- nsamp=0;
- for (is=0; is<nsrc; is++) {
- wav->nsamp[is] = wav->nt;
- nsamp += wav->nsamp[is];
- }
- wav->nsamp[nsrc] = nsamp; /* put total number of samples in last position */
- wav->nst = nsamp; /* put total number of samples in nst part */
- }
- }
-
- if (src->multiwav) {
- if (wav->nx != nsrc) {
- vwarn("src_multiwav has been defined but number of traces in");
- vwarn("file_src = %d is not equal to nsrc = %d", wav->nx, nsrc);
- vwarn("last trace in file_src will be repeated.");
- }
- else {
- if (wav->file_src != NULL) vmess("Using all traces in file_src for areal shot");
- }
- }
- src->n=nsrc;
-
-
- if (verbose) {
- vmess("*******************************************");
- vmess("************* wavelet info ****************");
- vmess("*******************************************");
- vmess("wav_nt = %6d wav_nx = %d", wav->ns, wav->nx);
- vmess("src_type = %6d src_orient = %d", src->type, src->orient);
- vmess("fmax = %8.2f", fmax);
- fprintf(stderr," %s: Source type : ",xargv[0]);
- switch ( src->type ) {
- case 1 : fprintf(stderr,"P "); break;
- case 2 : fprintf(stderr,"Txz "); break;
- case 3 : fprintf(stderr,"Tzz "); break;
- case 4 : fprintf(stderr,"Txx "); break;
- case 5 : fprintf(stderr,"S-potential"); break;
- case 6 : fprintf(stderr,"Fx "); break;
- case 7 : fprintf(stderr,"Fz "); break;
- case 8 : fprintf(stderr,"P-potential"); break;
- }
- fprintf(stderr,"\n");
- if (wav->random) vmess("Wavelet has a random signature with fmax=%.2f", wav->fmax);
- if (src->n>1) {
- vmess("*******************************************");
- vmess("*********** source array info *************");
- vmess("*******************************************");
- vmess("Areal source array is defined with %d sources.",nsrc);
-/* vmess("Memory requirement for sources = %.2f MB.",sizeof(float)*(wav->nx*(wav->nt/(1024.0*1024.0))));*/
- vmess("Memory requirement for sources = %.2f MB.",sizeof(float)*(nsamp/(1024.0*1024.0)));
- if (src->plane) vmess("Computed p-value = %f.",p);
- }
- if (src->random) {
- vmess("Sources are placed at random locations in domain: ");
- vmess(" x[%.2f : %.2f] z[%.2f : %.2f] ", xsrc1, xsrc2, zsrc1, zsrc2);
- vmess(" and all start in time window t[%.3f : %.3f].", tsrc1, tsrc2);
- vmess(" after time %.3f the sources will not be active anymore.", tactive);
- }
- }
-
- /* define snapshots and beams */
-
- if (!getparfloat("tsnap1", &tsnap1)) tsnap1=0.1;
- if (!getparfloat("tsnap2", &tsnap2)) tsnap2=0.0;
- if (!getparfloat("dtsnap", &dtsnap)) dtsnap=0.1;
- if (!getparfloat("dxsnap", &dxsnap)) dxsnap=dx;
- if (!getparfloat("dzsnap", &dzsnap)) dzsnap=dz;
- if (!getparfloat("xsnap1", &xsnap1)) xsnap1=sub_x0;
- if (!getparfloat("xsnap2", &xsnap2)) xsnap2=xmax;
- if (!getparfloat("zsnap1", &zsnap1)) zsnap1=sub_z0;
- if (!getparfloat("zsnap2", &zsnap2)) zsnap2=zmax;
- if (!getparint("sna_vxvztime", &sna->vxvztime)) sna->vxvztime=0;
- if (!getparint("beam", &sna->beam)) sna->beam=0;
- if (!getparint("snapwithbnd", &sna->withbnd)) sna->withbnd=0;
-
- if (!getparint("sna_type_vz", &sna->type.vz)) sna->type.vz=1;
- if (!getparint("sna_type_vx", &sna->type.vx)) sna->type.vx=0;
- if (mod->ischeme>2) {
- sna->type.p=0;
- if (!getparint("sna_type_txx", &sna->type.txx)) sna->type.txx=0;
- if (!getparint("sna_type_tzz", &sna->type.tzz)) sna->type.tzz=0;
- if (!getparint("sna_type_txz", &sna->type.txz)) sna->type.txz=0;
- if (!getparint("sna_type_pp", &sna->type.pp)) sna->type.pp=0;
- if (!getparint("sna_type_ss", &sna->type.ss)) sna->type.ss=0;
- }
- else {
- if (!getparint("sna_type_p", &sna->type.p)) sna->type.p=1;
- sna->type.txx=0;
- sna->type.tzz=0;
- sna->type.txz=0;
- sna->type.pp=0;
- sna->type.ss=0;
- }
-
- sna->nsnap = 0;
- if (tsnap2 >= tsnap1) {
- sna_nrsna = 1+NINT((tsnap2-tsnap1)/dtsnap);
- sna->skipdt = MAX(1,NINT(dtsnap/dt));
- sna->skipdx = MAX(1,NINT(dxsnap/dx));
- sna->skipdz = MAX(1,NINT(dzsnap/dz));
- sna->delay = NINT(tsnap1/dt);
- isnapmax1 = (sna_nrsna-1)*sna->skipdt;
- isnapmax2 = floor( (mod->nt-(sna->delay + 1))/sna->skipdt) * sna->skipdt;
- isnapmax = (sna->delay + 1) + MIN(isnapmax1,isnapmax2);
- sna->nsnap = floor((isnapmax-(sna->delay + 1))/sna->skipdt) + 1;
-
- sna->x1=NINT((MIN(MAX(sub_x0,xsnap1),xmax)-sub_x0)/dx);
- sna->x2=NINT((MIN(MAX(sub_x0,xsnap2),xmax)-sub_x0)/dx);
- sna->z1=NINT((MIN(MAX(sub_z0,zsnap1),zmax)-sub_z0)/dz);
- sna->z2=NINT((MIN(MAX(sub_z0,zsnap2),zmax)-sub_z0)/dz);
- dxsnap=dx*sna->skipdx;
- dzsnap=dz*sna->skipdz;
- sna->nx=1+(((sna->x2-sna->x1))/sna->skipdx);
- sna->nz=1+(((sna->z2-sna->z1))/sna->skipdz);
-
- if (verbose) {
- vmess("*******************************************");
- vmess("************* snap shot info **************");
- vmess("*******************************************");
- vmess("tsnap1 = %f tsnap2 = %f ", tsnap1, tsnap2);
- vmess("dtsnap = %f Nsnap = %d ", dtsnap, sna->nsnap);
- vmess("nzsnap = %d nxsnap = %d ", sna->nz, sna->nx);
- vmess("dzsnap = %f dxsnap = %f ", dzsnap, dxsnap);
- vmess("zmin = %f zmax = %f ", sub_z0+dz*sna->z1, sub_z0+dz*sna->z2);
- vmess("xmin = %f xmax = %f ", sub_x0+dx*sna->x1, sub_x0+dx*sna->x2);
- if (sna->vxvztime) vmess("vx/vz snapshot time : t+0.5*dt ");
- else vmess("vx/vz snapshot time : t-0.5*dt ");
- fprintf(stderr," %s: Snapshot types : ",xargv[0]);
- if (sna->type.vz) fprintf(stderr,"Vz ");
- if (sna->type.vx) fprintf(stderr,"Vx ");
- if (sna->type.p) fprintf(stderr,"p ");
- if (mod->ischeme>2) {
- if (sna->type.txx) fprintf(stderr,"Txx ");
- if (sna->type.tzz) fprintf(stderr,"Tzz ");
- if (sna->type.txz) fprintf(stderr,"Txz ");
- if (sna->type.pp) fprintf(stderr,"P ");
- if (sna->type.ss) fprintf(stderr,"S ");
- }
- fprintf(stderr,"\n");
- }
- }
- else {
- sna->nsnap = 0;
- if (verbose) vmess("*************** no snapshots **************");
- }
- if (sna->beam) {
- sna->skipdx = MAX(1,NINT(dxsnap/dx));
- sna->skipdz = MAX(1,NINT(dzsnap/dz));
- sna->x1=NINT((MIN(MAX(sub_x0,xsnap1),xmax)-sub_x0)/dx);
- sna->x2=NINT((MIN(MAX(sub_x0,xsnap2),xmax)-sub_x0)/dx);
- sna->z1=NINT((MIN(MAX(sub_z0,zsnap1),zmax)-sub_z0)/dz);
- sna->z2=NINT((MIN(MAX(sub_z0,zsnap2),zmax)-sub_z0)/dz);
- dxsnap=dx*sna->skipdx;
- dzsnap=dz*sna->skipdz;
- sna->nx=1+(((sna->x2-sna->x1))/sna->skipdx);
- sna->nz=1+(((sna->z2-sna->z1))/sna->skipdz);
-
- if (verbose) {
- vmess("*******************************************");
- vmess("**************** beam info ****************");
- vmess("*******************************************");
- vmess("nzsnap = %d nxsnap = %d ", sna->nz, sna->nx);
- vmess("dzsnap = %f dxsnap = %f ", dzsnap, dxsnap);
- vmess("zmin = %f zmax = %f ", sub_z0+dz*sna->z1, sub_z0+dz*sna->z2);
- vmess("xmin = %f xmax = %f ", sub_x0+dx*sna->x1, sub_x0+dx*sna->x2);
- fprintf(stderr," %s: Beam types : ",xargv[0]);
- if (sna->type.vz) fprintf(stderr,"Vz ");
- if (sna->type.vx) fprintf(stderr,"Vx ");
- if (sna->type.p) fprintf(stderr,"p ");
- if (mod->ischeme>2) {
- if (sna->type.txx) fprintf(stderr,"Txx ");
- if (sna->type.tzz) fprintf(stderr,"Tzz ");
- if (sna->type.txz) fprintf(stderr,"Txz ");
- if (sna->type.pp) fprintf(stderr,"P ");
- if (sna->type.ss) fprintf(stderr,"S ");
- }
- fprintf(stderr,"\n");
- }
- }
- else {
- if (verbose) vmess("**************** no beams *****************");
- }
-
- /* define receivers */
-
- if (!getparint("largeSUfile",&largeSUfile)) largeSUfile=0;
- if (!getparint("sinkdepth",&rec->sinkdepth)) rec->sinkdepth=0;
- if (!getparint("sinkdepth_src",&src->sinkdepth)) src->sinkdepth=0;
- if (!getparint("sinkvel",&rec->sinkvel)) rec->sinkvel=0;
- if (!getparfloat("dtrcv",&dtrcv)) dtrcv=0.004;
- /* TODO check if dtrcv is integer multiple of dt */
- rec->skipdt=NINT(dtrcv/dt);
- dtrcv = mod->dt*rec->skipdt;
- if (!getparfloat("rec_delay",&rdelay)) rdelay=0.0;
- if (!getparint("rec_ntsam",&rec->nt)) rec->nt=NINT((mod->tmod-rdelay)/dtrcv)+1;
- if (!getparint("rec_int_p",&rec->int_p)) rec->int_p=0;
- if (!getparint("rec_int_vx",&rec->int_vx)) rec->int_vx=0;
- if (!getparint("rec_int_vz",&rec->int_vz)) rec->int_vz=0;
- if (!getparint("max_nrec",&rec->max_nrec)) rec->max_nrec=15000;
- if (!getparint("scale",&rec->scale)) rec->scale=0;
- if (!getparfloat("dxspread",&dxspread)) dxspread=0;
- if (!getparfloat("dzspread",&dzspread)) dzspread=0;
- rec->nt=MIN(rec->nt, NINT((mod->tmod-rdelay)/dtrcv)+1);
-
-/* allocation of receiver arrays is done in recvPar */
-/*
- rec->max_nrec += rec->max_nrec+1;
- rec->x = (int *)calloc(rec->max_nrec,sizeof(int));
- rec->z = (int *)calloc(rec->max_nrec,sizeof(int));
- rec->xr = (float *)calloc(rec->max_nrec,sizeof(float));
- rec->zr = (float *)calloc(rec->max_nrec,sizeof(float));
-*/
-
- /* calculates the receiver coordinates */
-
- recvPar(rec, sub_x0, sub_z0, dx, dz, nx, nz);
-
- if (!getparint("rec_type_vz", &rec->type.vz)) rec->type.vz=1;
- if (!getparint("rec_type_vx", &rec->type.vx)) rec->type.vx=0;
- if (!getparint("rec_type_ud", &rec->type.ud)) rec->type.ud=0;
- if (mod->ischeme!=1 && rec->type.ud==1) {
- warn("Receiver decomposition only implemented for acoustis scheme (1)");
- }
- if (mod->ischeme>2) {
- rec->type.p=0;
- if (!getparint("rec_type_txx", &rec->type.txx)) rec->type.txx=0;
- if (!getparint("rec_type_tzz", &rec->type.tzz)) rec->type.tzz=0;
- if (!getparint("rec_type_txz", &rec->type.txz)) rec->type.txz=0;
- if (!getparint("rec_type_pp", &rec->type.pp)) rec->type.pp=0;
- if (!getparint("rec_type_ss", &rec->type.ss)) rec->type.ss=0;
- /* for up and downgoing waves store all x-positons for Vz, Vx, Txz, Tzz into an array */
- }
- else {
- if (!getparint("rec_type_p", &rec->type.p)) rec->type.p=1;
- rec->type.txx=0;
- rec->type.tzz=0;
- rec->type.txz=0;
- rec->type.pp=0;
- rec->type.ss=0;
- /* for up and downgoing waves store all x-positons for P and Vz into an array */
- }
-
- /* receivers are on a circle, use default interpolation to real (not on a grid-point) receiver position */
- if (getparfloat("rrcv", &rrcv)) {
- if (!getparint("rec_int_p",&rec->int_p)) rec->int_p=3;
- if (!getparint("rec_int_vx",&rec->int_vx)) rec->int_vx=3;
- if (!getparint("rec_int_vz",&rec->int_vz)) rec->int_vz=3;
- }
- if (rec->int_p==3) {
- rec->int_vx=3;
- rec->int_vz=3;
- }
-
- if (verbose) {
- if (rec->n) {
- dxrcv = rec->xr[MIN(1,rec->n-1)]-rec->xr[0];
- dzrcv = rec->zr[MIN(1,rec->n-1)]-rec->zr[0];
- vmess("*******************************************");
- vmess("************* receiver info ***************");
- vmess("*******************************************");
- vmess("ntrcv = %d nrcv = %d ", rec->nt, rec->n);
- vmess("dtrcv = %f ", dtrcv );
- vmess("dzrcv = %f dxrcv = %f ", dzrcv, dxrcv);
- vmess("time-delay = %f = points = %d", rdelay, rec->delay);
- if ( fmax > (1.0/(2.0*dtrcv)) ) {
- vwarn("Receiver time sampling (dtrcv) is aliased.");
- vwarn("time sampling should be < %.6f", 1.0/(2.0*fmax) );
- }
- vmess("Receiver sampling can be => %.6e", 1.0/(2.0*fmax));
- vmess("Receiver array at coordinates: ");
- vmess("zmin = %f zmax = %f ", rec->zr[0]+sub_z0, rec->zr[rec->n-1]+sub_z0);
- vmess("xmin = %f xmax = %f ", rec->xr[0]+sub_x0, rec->xr[rec->n-1]+sub_x0);
- vmess("which are gridpoints: ");
- vmess("izmin = %d izmax = %d ", rec->z[0], rec->z[rec->n-1]);
- vmess("ixmin = %d ixmax = %d ", rec->x[0], rec->x[rec->n-1]);
- if (rec->type.p) {
- fprintf(stderr," %s: Receiver interpolation for P: ",xargv[0]);
- if(rec->int_p==0) fprintf(stderr,"p->p\n");
- if(rec->int_p==1) fprintf(stderr,"p->vz\n");
- if(rec->int_p==2) fprintf(stderr,"p->vx\n");
- if(rec->int_p==3) fprintf(stderr,"interpolate to actual (no-grid) position of receiver\n");
- }
- if (rec->type.vx) {
- fprintf(stderr," %s: Receiver interpolation for Vx: ",xargv[0]);
- if(rec->int_vx==0) fprintf(stderr,"vx->vx\n");
- if(rec->int_vx==1) fprintf(stderr,"vx->vz\n");
- if(rec->int_vx==2) fprintf(stderr,"vx->txx/tzz\n");
- if(rec->int_vx==3) fprintf(stderr,"interpolate to real(no-grid) position of receiver\n");
- }
- if (rec->type.vz) {
- fprintf(stderr," %s: Receiver interpolation for Vz: ",xargv[0]);
- if(rec->int_vz==0) fprintf(stderr,"vz->vz\n");
- if(rec->int_vz==1) fprintf(stderr,"vz->vx\n");
- if(rec->int_vz==2) fprintf(stderr,"vz->txx/tzz(P)\n");
- if(rec->int_vz==3) fprintf(stderr,"interpolate to real(no-grid) position of receiver\n");
- }
- fprintf(stderr," %s: Receiver types : ",xargv[0]);
- if (rec->type.vz) fprintf(stderr,"Vz ");
- if (rec->type.vx) fprintf(stderr,"Vx ");
- if (rec->type.p) fprintf(stderr,"p ");
- if (rec->type.ud) fprintf(stderr,"P+ P- ");
- if (mod->ischeme>2) {
- if (rec->type.txx) fprintf(stderr,"Txx ");
- if (rec->type.tzz) fprintf(stderr,"Tzz ");
- if (rec->type.txz) fprintf(stderr,"Txz ");
- if (rec->type.pp) fprintf(stderr,"P ");
- if (rec->type.ss) fprintf(stderr,"S ");
- }
- fprintf(stderr,"\n");
- if ( ( ((mod->nt*mod->dt-rec->delay)/rec->skipdt)+1) > 16384) {
- vwarn("Number of samples in receiver file is larger that SU can handle ");
- vwarn("use the paramater rec_ntsam=nt (with nt < 16384) to avoid this");
- }
- if ((mod->nt-rec->delay)*mod->dt > rec->nt*dtrcv) {
- int nfiles = ceil((mod->nt*mod->dt)/(rec->nt*dtrcv));
- int lastn = floor((mod->nt)%(rec->nt*rec->skipdt)/rec->skipdt)+1;
- vmess("Receiver recordings will be written to %d files",nfiles);
- vmess("Last file will contain %d samples",lastn);
-
- }
- }
- else {
- vmess("*************** no receivers **************");
- }
- }
-
- return 0;
-}
-
diff --git a/fdelmodc3D/getParameters3D.c b/fdelmodc3D/getParameters3D.c
index df33bf7fd992374c828f96af4ad166ac0fd6c483..47f5db555402542d73ab0d03b239ec1ca52e7fd8 100644
--- a/fdelmodc3D/getParameters3D.c
+++ b/fdelmodc3D/getParameters3D.c
@@ -24,15 +24,21 @@ float gaussGen();
long loptncr(long n);
-long getModelInfo3D(char *file_name, long *n1, long *n2, long *n3, float *d1, float *d2, float *d3, float *f1, float *f2, float *f3, float *min, float *max, long *axis, long zeroch, long verbose);
+long getModelInfo3D(char *file_name, long *n1, long *n2, long *n3,
+ float *d1, float *d2, float *d3, float *f1, float *f2, float *f3,
+ float *min, float *max, long *axis, long zeroch, long verbose);
-long getWaveletInfo3D(char *file_src, long *n1, long *n2, float *d1, float *d2, float *f1, float *f2, float *fmax, long *nxm, long verbose);
-
-long getWaveletHeaders3D(char *file_src, long n1, long n2, float *gx, float *sx, float *gy, float *sy, float *gelev, float *selev, long verbose);
+long getWaveletInfo3D(char *file_src, long *n1, long *n2, float *d1, float *d2,
+ float *f1, float *f2, float *fmax, long *nxm, long verbose);
-long recvPar3D(recPar *rec, float sub_x0, float sub_y0, float sub_z0, float dx, float dy, float dz, long nx, long ny, long nz);
+long getWaveletHeaders3D(char *file_src, long n1, long n2, float *gx, float *sx,
+ float *gy, float *sy, float *gelev, float *selev, long verbose);
-long getParameters3D(modPar *mod, recPar *rec, snaPar *sna, wavPar *wav, srcPar *src, shotPar *shot, bndPar *bnd, long verbose)
+long recvPar3D(recPar *rec, float sub_x0, float sub_y0, float sub_z0,
+ float dx, float dy, float dz, long nx, long ny, long nz);
+
+long getParameters3D(modPar *mod, recPar *rec, snaPar *sna, wavPar *wav, srcPar *src,
+ shotPar *shot, bndPar *bnd, long verbose)
{
long isnapmax1, isnapmax2, isnapmax, sna_nrsna;
long n1, n2, n3, nx, ny, nz, nsrc, ix, axis, ioPz, is0, optn;
@@ -1145,7 +1151,7 @@ long getParameters3D(modPar *mod, recPar *rec, snaPar *sna, wavPar *wav, srcPar
/* calculates the receiver coordinates */
- recvPar(rec, sub_x0, sub_y0, sub_z0, dx, dy, dz, nx, ny, nz);
+ recvPar3D(rec, sub_x0, sub_y0, sub_z0, dx, dy, dz, nx, ny, nz);
if (!getparlong("rec_type_vz", &rec->type.vz)) rec->type.vz=1;
if (!getparlong("rec_type_vy", &rec->type.vy)) rec->type.vy=0;
diff --git a/fdelmodc3D/getRecTimes.c b/fdelmodc3D/getRecTimes.c
deleted file mode 100644
index 13947e414ca119b0d733795e6a9b8c9966d79ad2..0000000000000000000000000000000000000000
--- a/fdelmodc3D/getRecTimes.c
+++ /dev/null
@@ -1,307 +0,0 @@
-#include<stdlib.h>
-#include<stdio.h>
-#include<math.h>
-#include<assert.h>
-#include"fdelmodc.h"
-#include"par.h"
-
-/**
-* Stores the wavefield at the receiver positions.
-*
-* On a staggered grid the fields are all on different positions,
-* to compensate for that the rec.int_vx and rec.int_vz options
-* can be set.
-*
-* AUTHOR:
-* Jan Thorbecke (janth@xs4all.nl)
-* The Netherlands
-**/
-
-int getRecTimes(modPar mod, recPar rec, bndPar bnd, int itime, int isam, float *vx, float *vz, float *tzz, float *txx, float *txz, float *l2m, float *rox, float *roz, float *rec_vx, float *rec_vz, float *rec_txx, float *rec_tzz, float *rec_txz, float *rec_p, float *rec_pp, float *rec_ss, float *rec_udp, float *rec_udvz, int verbose)
-{
- int n1, ibndx, ibndz;
- int irec, ix, iz, ix2, iz2, ix1, iz1;
- float dvx, dvz, rdz, rdx, C00, C10, C01, C11;
- float *vz_t, c1, c2, lroz, field;
-
- ibndx = mod.ioPx;
- ibndz = mod.ioPz;
- if (bnd.lef==4 || bnd.lef==2) ibndx += bnd.ntap;
- if (bnd.top==4 || bnd.top==2) ibndz += bnd.ntap;
- n1 = mod.naz;
- c1 = 9.0/8.0;
- c2 = -1.0/24.0;
-
- if (!rec.n) return 0;
-
-/***********************************************************************
-* velocity or txz or potential registrations issues:
-* rec_x and rec_z are related to actual txx/tzz/p positions.
-* offsets from virtual boundaries must be taken into account.
-*
-* vx velocities have one sample less in x-direction
-* vz velocities have one sample less in z-direction
-* txz stresses have one sample less in z-direction and x-direction
-*
-* Note, in the acoustic scheme P is stored in the Tzz array.
-***********************************************************************/
-
- for (irec=0; irec<rec.n; irec++) {
- iz = rec.z[irec]+ibndz;
- ix = rec.x[irec]+ibndx;
- iz1 = iz-1;
- ix1 = ix-1;
- iz2 = iz+1;
- ix2 = ix+1;
- /* interpolation to precise (not necessary on a grid point) position */
- if ( rec.int_p==3 ) {
-
- iz = (int)floorf(rec.zr[irec]/mod.dz)+ibndz;
- ix = (int)floorf(rec.xr[irec]/mod.dx)+ibndx;
- rdz = (rec.zr[irec] - (iz-ibndz)*mod.dz)/mod.dz;
- rdx = (rec.xr[irec] - (ix-ibndx)*mod.dx)/mod.dx;
- iz1 = iz-1;
- ix1 = ix-1;
- iz2 = iz+1;
- ix2 = ix+1;
-
- /*
- // Interpolate according to Dirk Kraaijpool's scheme
- // Reference: "Seismic ray fields and ray field maps : theory and algorithms" ,
- // PhD thesis Utrecht University,Faculty of Geosciences, 2003)
-
- C00 = tzz[ix*n1+iz] + 0.5*((tzz[(ix+1)*n1+iz] +tzz[(ix-1)*n1+iz]+
- tzz[(ix )*n1+iz+1] +tzz[(ix )*n1+iz-1])/(2.0*mod.dx));
- C10 = tzz[(ix+1)*n1+iz] + 0.5*((tzz[(ix+2)*n1+iz] +tzz[(ix )*n1+iz]+
- tzz[(ix+1)*n1+iz+1] +tzz[(ix+1)*n1+iz-1])/(2.0*mod.dz));
- C01 = tzz[ix*n1+iz+1] + 0.5*((tzz[(ix+1)*n1+iz+1] +tzz[(ix-1)*n1+iz+1]+
- tzz[(ix)*n1+iz+2] +tzz[(ix )*n1+iz])/(2.0*mod.dx));
- C11 = tzz[(ix+1)*n1+iz+1]+ 0.5*((tzz[(ix+2)*n1+iz+1] +tzz[(ix )*n1+iz+1]+
- tzz[(ix+1)*n1+iz+2] +tzz[(ix+1)*n1+iz])/(2.0*mod.dz));
- */
-
- if (rec.type.p){
- /* bi-linear interpolation */
- C00 = tzz[ix*n1+iz];
- C10 = tzz[(ix+1)*n1+iz];
- C01 = tzz[ix*n1+iz+1];
- C11 = tzz[(ix+1)*n1+iz+1];
- rec_p[irec*rec.nt+isam] = C00*(1.0-rdx)*(1.0-rdz) + C10*rdx*(1.0-rdz) +
- C01*(1.0-rdx)*rdz + C11*rdx*rdz;
- }
- if (rec.type.txx) {
- C00 = txx[ix*n1+iz];
- C10 = txx[(ix+1)*n1+iz];
- C01 = txx[ix*n1+iz+1];
- C11 = txx[(ix+1)*n1+iz+1];
- rec_txx[irec*rec.nt+isam] = C00*(1.0-rdx)*(1.0-rdz) + C10*rdx*(1.0-rdz) +
- C01*(1.0-rdx)*rdz + C11*rdx*rdz;
- }
- if (rec.type.tzz) {
- C00 = tzz[ix*n1+iz];
- C10 = tzz[(ix+1)*n1+iz];
- C01 = tzz[ix*n1+iz+1];
- C11 = tzz[(ix+1)*n1+iz+1];
- rec_tzz[irec*rec.nt+isam] = C00*(1.0-rdx)*(1.0-rdz) + C10*rdx*(1.0-rdz) +
- C01*(1.0-rdx)*rdz + C11*rdx*rdz;
- }
- if (rec.type.txz) {
- C00 = txz[ix2*n1+iz2];
- C10 = txz[(ix2+1)*n1+iz2];
- C01 = txz[ix2*n1+iz2+1];
- C11 = txz[(ix2+1)*n1+iz2+1];
- rec_txz[irec*rec.nt+isam] = C00*(1.0-rdx)*(1.0-rdz) + C10*rdx*(1.0-rdz) +
- C01*(1.0-rdx)*rdz + C11*rdx*rdz;
- }
- if (rec.type.pp) {
- C00 = (vx[ix2*n1+iz]-vx[ix*n1+iz] +
- vz[ix*n1+iz2]-vz[ix*n1+iz])/mod.dx;
- C10 = (vx[(ix2+1)*n1+iz]-vx[(ix+1)*n1+iz] +
- vz[(ix+1)*n1+iz2]-vz[(ix+1)*n1+iz])/mod.dx;
- C01 = (vx[ix2*n1+iz+1]-vx[ix*n1+iz+1] +
- vz[ix*n1+iz2+1]-vz[ix*n1+iz+1])/mod.dx;
- C11 = (vx[(ix2+1)*n1+iz+1]-vx[(ix+1)*n1+iz+1] +
- vz[(ix+1)*n1+iz2+1]-vz[(ix+1)*n1+iz+1])/mod.dx;
- rec_pp[irec*rec.nt+isam] = C00*(1.0-rdx)*(1.0-rdz) + C10*rdx*(1.0-rdz) +
- C01*(1.0-rdx)*rdz + C11*rdx*rdz;
- }
- if (rec.type.ss) {
- C00 = (vx[ix2*n1+iz2]-vx[ix2*n1+iz] -
- (vz[ix2*n1+iz2]-vz[ix*n1+iz2]))/mod.dx;
- C10 = (vx[(ix2+1)*n1+iz2]-vx[(ix2+1)*n1+iz] -
- (vz[(ix2+1)*n1+iz2]-vz[(ix+1)*n1+iz2]))/mod.dx;
- C01 = (vx[ix2*n1+iz2+1]-vx[ix2*n1+iz+1] -
- (vz[ix2*n1+iz2+1]-vz[ix*n1+iz2+1]))/mod.dx;;
- C11 = (vx[(ix2+1)*n1+iz2+1]-vx[(ix2+1)*n1+iz+1] -
- (vz[(ix2+1)*n1+iz2+1]-vz[(ix+1)*n1+iz2+1]))/mod.dx;
- rec_ss[irec*rec.nt+isam] = C00*(1.0-rdx)*(1.0-rdz) + C10*rdx*(1.0-rdz) +
- C01*(1.0-rdx)*rdz + C11*rdx*rdz;
- }
- if (rec.type.vz) {
- C00 = vz[ix*n1+iz2];
- C10 = vz[(ix+1)*n1+iz2];
- C01 = vz[ix*n1+iz2+1];
- C11 = vz[(ix+1)*n1+iz2+1];
- rec_vz[irec*rec.nt+isam] = C00*(1.0-rdx)*(1.0-rdz) + C10*rdx*(1.0-rdz) +
- C01*(1.0-rdx)*rdz + C11*rdx*rdz;
- }
- if (rec.type.vx) {
- C00 = vx[ix2*n1+iz];
- C10 = vx[(ix2+1)*n1+iz];
- C01 = vx[ix2*n1+iz+1];
- C11 = vx[(ix2+1)*n1+iz+1];
- rec_vx[irec*rec.nt+isam] = C00*(1.0-rdx)*(1.0-rdz) + C10*rdx*(1.0-rdz) +
- C01*(1.0-rdx)*rdz + C11*rdx*rdz;
- }
-
- }
- else { /* read values directly from the grid points */
- if (verbose>=4 && isam==0) {
- vmess("Receiver %d read at gridpoint ix=%d iz=%d",irec, ix, iz);
- }
- /* interpolation of receivers to same time step is only done for acoustic scheme */
- if (rec.type.p) {
- if (rec.int_p == 1) {
- if (mod.ischeme == 1) { /* interpolate Tzz times -1/2 Dt backward to Vz times */
- dvx = c1*(vx[(ix+1)*n1+iz] - vx[ix*n1+iz]) +
- c2*(vx[(ix+2)*n1+iz] - vx[(ix-1)*n1+iz]);
- dvz = c1*(vz[ix*n1+iz+1] - vz[ix*n1+iz]) +
- c2*(vz[ix*n1+iz+2] - vz[ix*n1+iz-1]);
- field = tzz[ix*n1+iz] + 0.5*l2m[ix*n1+iz]*(dvx+dvz);
- dvx = c1*(vx[(ix+1)*n1+iz1] - vx[ix*n1+iz1]) +
- c2*(vx[(ix+2)*n1+iz1] - vx[(ix-1)*n1+iz1]);
- dvz = c1*(vz[ix*n1+iz1+1] - vz[ix*n1+iz1]) +
- c2*(vz[ix*n1+iz1+2] - vz[ix*n1+iz1-1]);
- field += tzz[ix*n1+iz1] + 0.5*l2m[ix*n1+iz1]*(dvx+dvz);
- rec_p[irec*rec.nt+isam] = 0.5*field;
- }
- else {
- rec_p[irec*rec.nt+isam] = 0.5*(tzz[ix*n1+iz1]+tzz[ix*n1+iz]);
- }
- }
- else if (rec.int_p == 2) {
- if (mod.ischeme == 1) { /* interpolate Tzz times -1/2 Dt backward to Vx times */
- dvx = c1*(vx[(ix+1)*n1+iz] - vx[ix*n1+iz]) +
- c2*(vx[(ix+2)*n1+iz] - vx[(ix-1)*n1+iz]);
- dvz = c1*(vz[ix*n1+iz+1] - vz[ix*n1+iz]) +
- c2*(vz[ix*n1+iz+2] - vz[ix*n1+iz-1]);
- field = tzz[ix*n1+iz] + 0.5*l2m[ix*n1+iz]*(dvx+dvz);
- dvx = c1*(vx[(ix1+1)*n1+iz] - vx[ix1*n1+iz]) +
- c2*(vx[(ix+2)*n1+iz] - vx[(ix1-1)*n1+iz]);
- dvz = c1*(vz[ix1*n1+iz+1] - vz[ix1*n1+iz]) +
- c2*(vz[ix1*n1+iz+2] - vz[ix1*n1+iz-1]);
- field += tzz[ix1*n1+iz] + 0.5*l2m[ix1*n1+iz]*(dvx+dvz);
- rec_p[irec*rec.nt+isam] = 0.5*field;
- }
- else {
- rec_p[irec*rec.nt+isam] = 0.5*(tzz[ix1*n1+iz]+tzz[ix*n1+iz]);
- }
- }
- else {
- rec_p[irec*rec.nt+isam] = tzz[ix*n1+iz];
- }
- }
- if (rec.type.txx) rec_txx[irec*rec.nt+isam] = txx[ix*n1+iz];
- if (rec.type.tzz) rec_tzz[irec*rec.nt+isam] = tzz[ix*n1+iz];
- if (rec.type.txz) { /* time interpolation to be done */
- if (rec.int_vz == 2 || rec.int_vx == 2) {
- rec_txz[irec*rec.nt+isam] = 0.25*(
- txz[ix*n1+iz2]+txz[ix2*n1+iz2]+
- txz[ix*n1+iz]+txz[ix2*n1+iz]);
- }
- else {
- rec_txz[irec*rec.nt+isam] = txz[ix2*n1+iz2];
- }
- }
- if (rec.type.pp) {
- rec_pp[irec*rec.nt+isam] = (vx[ix2*n1+iz]-vx[ix*n1+iz] +
- vz[ix*n1+iz2]-vz[ix*n1+iz])/mod.dx;
- }
- if (rec.type.ss) {
- rec_ss[irec*rec.nt+isam] = (vx[ix2*n1+iz2]-vx[ix2*n1+iz] -
- (vz[ix2*n1+iz2]-vz[ix*n1+iz2]))/mod.dx;
- }
- if (rec.type.vz) {
-/* interpolate vz to vx position to the right and above of vz */
- if (rec.int_vz == 1) {
- rec_vz[irec*rec.nt+isam] = 0.25*(
- vz[ix*n1+iz2]+vz[ix1*n1+iz2]+
- vz[ix*n1+iz] +vz[ix1*n1+iz]);
- }
-/* interpolate vz to Txx/Tzz position by taking the mean of 2 values */
- else if (rec.int_vz == 2) {
- if (mod.ischeme == 1) { /* interpolate Vz times +1/2 Dt forward to P times */
- field = vz[ix*n1+iz] - 0.5*roz[ix*n1+iz]*(
- c1*(tzz[ix*n1+iz] - tzz[ix*n1+iz-1]) +
- c2*(tzz[ix*n1+iz+1] - tzz[ix*n1+iz-2]));
- field += vz[ix*n1+iz2] - 0.5*roz[ix*n1+iz2]*(
- c1*(tzz[ix*n1+iz2] - tzz[ix*n1+iz2-1]) +
- c2*(tzz[ix*n1+iz2+1] - tzz[ix*n1+iz2-2]));
- rec_vz[irec*rec.nt+isam] = 0.5*field;
- }
- else {
- rec_vz[irec*rec.nt+isam] = 0.5*(vz[ix*n1+iz2]+vz[ix*n1+iz]);
- }
- }
- else {
- rec_vz[irec*rec.nt+isam] = vz[ix*n1+iz2];
- //rec_vz[irec*rec.nt+isam] = vz[ix*n1+iz];
- //fprintf(stderr,"isam=%d vz[%d]=%e vz[%d]=%e vz[%d]=%e \n",isam, iz-1,vz[ix*n1+iz-1],iz,vz[ix*n1+iz], iz+1, vz[ix*n1+iz+1]);
- }
- }
- if (rec.type.vx) {
-/* interpolate vx to vz position to the left and below of vx */
- if (rec.int_vx == 1) {
- rec_vx[irec*rec.nt+isam] = 0.25*(
- vx[ix2*n1+iz]+vx[ix2*n1+iz1]+
- vx[ix*n1+iz]+vx[ix*n1+iz1]);
- }
-/* interpolate vx to Txx/Tzz position by taking the mean of 2 values */
- else if (rec.int_vx == 2) {
- if (mod.ischeme == 1) { /* interpolate Vx times +1/2 Dt forward to P times */
- field = vx[ix*n1+iz] - 0.5*rox[ix*n1+iz]*(
- c1*(tzz[ix*n1+iz] - tzz[(ix-1)*n1+iz]) +
- c2*(tzz[(ix+1)*n1+iz] - tzz[(ix-2)*n1+iz]));
- field += vx[ix2*n1+iz] - 0.5*rox[ix2*n1+iz]*(
- c1*(tzz[ix2*n1+iz] - tzz[(ix2-1)*n1+iz]) +
- c2*(tzz[(ix2+1)*n1+iz] - tzz[(ix2-2)*n1+iz]));
- rec_vx[irec*rec.nt+isam] = 0.5*field;
- }
- else {
- rec_vx[irec*rec.nt+isam] = 0.5*(vx[ix2*n1+iz]+vx[ix*n1+iz]);
- }
- }
- else {
- rec_vx[irec*rec.nt+isam] = vx[ix2*n1+iz];
- }
- }
- }
-
- } /* end of irec loop */
-
- /* store all x-values on z-level for P Vz for up-down decomposition */
- if (rec.type.ud) {
- iz = rec.z[0]+ibndz;
- iz2 = iz+1;
- vz_t = (float *)calloc(2*mod.nax,sizeof(float));
- /* P and Vz are staggered in time and need to correct for this */
- /* -1- compute Vz at next time step and average with current time step */
- lroz = mod.dt/(mod.dx*rec.rho);
- for (ix=mod.ioZx; ix<mod.ieZx; ix++) {
- vz_t[ix] = vz[ix*n1+iz] - lroz*(
- c1*(tzz[ix*n1+iz] - tzz[ix*n1+iz-1]) +
- c2*(tzz[ix*n1+iz+1] - tzz[ix*n1+iz-2]));
- vz_t[mod.nax+ix] = vz[ix*n1+iz2] - lroz*(
- c1*(tzz[ix*n1+iz2] - tzz[ix*n1+iz2-1]) +
- c2*(tzz[ix*n1+iz2+1] - tzz[ix*n1+iz2-2]));
- }
- for (ix=0; ix<mod.nax; ix++) {
- /* -2- compute average in time and depth to get Vz at same depth and time as P */
- rec_udvz[ix*rec.nt+isam] = 0.25*(vz[ix*n1+iz2]+vz[ix*n1+iz]+vz_t[mod.nax+ix]+vz_t[ix]);
- rec_udp[ix*rec.nt+isam] = tzz[ix*n1+iz];
- }
- free(vz_t);
- }
-
- return 0;
-}
diff --git a/fdelmodc3D/getRecTimes3D.c b/fdelmodc3D/getRecTimes3D.c
index 33f5578732303b8951f70b416b89e703fdd1ccbc..3ffe06ce012598799997805f55f7c7f67b711a08 100644
--- a/fdelmodc3D/getRecTimes3D.c
+++ b/fdelmodc3D/getRecTimes3D.c
@@ -17,7 +17,12 @@
* The Netherlands
**/
-long getRecTimes3D(modPar mod, recPar rec, bndPar bnd, long itime, long isam, float *vx, float *vy, float *vz, float *tzz, float *tyy, float *txx, float *txz, float *txy, float *tyz, float *l2m, float *rox, float *roy, float *roz, float *rec_vx, float *rec_vy, float *rec_vz, float *rec_txx, float *rec_tyy, float *rec_tzz, float *rec_txz, float *rec_txy, float *rec_tyz, float *rec_p, float *rec_pp, float *rec_ss, float *rec_udp, float *rec_udvz, long verbose)
+long getRecTimes3D(modPar mod, recPar rec, bndPar bnd, long itime, long isam,
+ float *vx, float *vy, float *vz, float *tzz, float *tyy, float *txx,
+ float *txz, float *txy, float *tyz, float *l2m,
+ float *rox, float *roy, float *roz, float *rec_vx, float *rec_vy, float *rec_vz,
+ float *rec_txx, float *rec_tyy, float *rec_tzz, float *rec_txz, float *rec_txy, float *rec_tyz,
+ float *rec_p, float *rec_pp, float *rec_ss, float *rec_udp, float *rec_udvz, long verbose)
{
long n1, n2, ibndx, ibndy, ibndz;
long irec, ix, iy, iz, ix2, iy2, iz2, ix1, iy1, iz1;
diff --git a/fdelmodc3D/getWaveletHeaders.c b/fdelmodc3D/getWaveletHeaders.c
deleted file mode 100644
index 5bff37528015722251741fcdb434db218e06ed90..0000000000000000000000000000000000000000
--- a/fdelmodc3D/getWaveletHeaders.c
+++ /dev/null
@@ -1,52 +0,0 @@
-#include <assert.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <errno.h>
-#include <math.h>
-#include "segy.h"
-
-/**
-* reads file which contain the source wavelets and reads receiver positions
-*
-* AUTHOR:
-* Jan Thorbecke (janth@xs4all.nl)
-* The Netherlands
-**/
-
-int getWaveletHeaders(char *file_src, int n1, int n2, float *gx, float *sx, float *gelev, float *selev, int verbose)
-{
- FILE *fp;
- size_t nread;
- int ix;
- size_t trace_sz;
- off_t offset;
- float scl, scll;
- segy hdr;
-
- if (file_src == NULL) return 0; /* Input pipe can not be handled */
- else fp = fopen( file_src, "r" );
- assert( fp != NULL);
- nread = fread( &hdr, 1, TRCBYTES, fp );
- assert(nread == TRCBYTES);
- if (hdr.scalco < 0) scl = 1.0/fabs(hdr.scalco);
- else if (hdr.scalco == 0) scl = 1.0;
- else scl = hdr.scalco;
- if (hdr.scalel < 0) scll = 1.0/fabs(hdr.scalel);
- else if (hdr.scalel == 0) scll = 1.0;
- else scll = hdr.scalel;
- trace_sz = (size_t)sizeof(float)*(n1)+TRCBYTES;
-
- for (ix=0; ix<n2; ix++) {
- offset = ix*trace_sz;
- fseeko( fp, offset, SEEK_SET );
- nread = fread( &hdr, 1, TRCBYTES, fp );
- assert(nread == TRCBYTES);
- gx[ix] = hdr.gx*scl;
- sx[ix] = hdr.sx*scl;
- gelev[ix] = -1.0*hdr.gelev*scll;
- selev[ix] = -1.0*hdr.selev*scll;
- }
- fclose(fp);
- return 0;
-}
-
diff --git a/fdelmodc3D/getWaveletHeaders3D.c b/fdelmodc3D/getWaveletHeaders3D.c
index 3e62faa5208a9e93951b84a0fab8a9e0d734fb49..a56ddb565002c3ac291d53ec3ab3a3b833a925fe 100644
--- a/fdelmodc3D/getWaveletHeaders3D.c
+++ b/fdelmodc3D/getWaveletHeaders3D.c
@@ -13,7 +13,8 @@
* The Netherlands
**/
-long getWaveletHeaders3D(char *file_src, long n1, long n2, float *gx, float *sx, float *gy, float *sy, float *gelev, float *selev, long verbose)
+long getWaveletHeaders3D(char *file_src, long n1, long n2, float *gx, float *sx,
+ float *gy, float *sy, float *gelev, float *selev, long verbose)
{
FILE *fp;
size_t nread;
diff --git a/fdelmodc3D/getWaveletInfo.c b/fdelmodc3D/getWaveletInfo.c
deleted file mode 100644
index 2f3734aae6c38e54653fab909ec5e936a157d8ce..0000000000000000000000000000000000000000
--- a/fdelmodc3D/getWaveletInfo.c
+++ /dev/null
@@ -1,138 +0,0 @@
-#define _FILE_OFFSET_BITS 64
-#define _LARGEFILE_SOURCE
-#define _LARGEFILE64_SOURCE
-
-#include <assert.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <errno.h>
-#include <math.h>
-#include "segy.h"
-
-/**
-* reads file which contain the source wavelets and computes sampling interval
-* and tries to estimate the maximum frequency content.
-*
-* AUTHOR:
-* Jan Thorbecke (janth@xs4all.nl)
-* The Netherlands
-**/
-
-#ifndef COMPLEX
-typedef struct _complexStruct { /* complex number */
- float r,i;
-} complex;
-typedef struct _dcomplexStruct { /* complex number */
- double r,i;
-} dcomplex;
-#endif/* complex */
-
-int optncr(int n);
-void rc1fft(float *rdata, complex *cdata, int n, int sign);
-
-#define MAX(x,y) ((x) > (y) ? (x) : (y))
-#define MIN(x,y) ((x) < (y) ? (x) : (y))
-#define NINT(x) ((int)((x)>0.0?(x)+0.5:(x)-0.5))
-
-int getWaveletInfo(char *file_src, int *n1, int *n2, float *d1, float *d2, float *f1, float *f2, float *fmax, int *nxm, int verbose)
-{
- FILE *fp;
- size_t nread, trace_sz;
- off_t bytes;
- int ret, one_shot, ntraces;
- int optn, nfreq, i, iwmax;
- float *trace;
- float ampl, amplmax, tampl, tamplmax;
- complex *ctrace;
- segy hdr;
-
- if (file_src == NULL) return 0; /* Input pipe can not be handled */
- else fp = fopen( file_src, "r" );
- assert( fp != NULL);
- nread = fread( &hdr, 1, TRCBYTES, fp );
- assert(nread == TRCBYTES);
- ret = fseeko( fp, 0, SEEK_END );
- if (ret<0) perror("fseeko");
- bytes = ftello( fp );
-
- *n1 = hdr.ns;
- if (hdr.trid == 1 || hdr.dt != 0) {
- *d1 = ((float) hdr.dt)*1.e-6;
- *f1 = ((float) hdr.delrt)/1000.;
- if (*d1 == 0.0) *d1 = hdr.d1;
- }
- else {
- *d1 = hdr.d1;
- *f1 = hdr.f1;
- }
- *f2 = hdr.f2;
-
- trace_sz = (size_t)(sizeof(float)*(*n1)+TRCBYTES);
- ntraces = (int) (bytes/trace_sz);
- *n2 = ntraces;
-
- /* check to find out number of traces in shot gather */
-
- optn = optncr(*n1);
- nfreq = optn/2 + 1;
- ctrace = (complex *)malloc(nfreq*sizeof(complex));
- one_shot = 1;
- trace = (float *)malloc(optn*sizeof(float));
- fseeko( fp, TRCBYTES, SEEK_SET );
-
- while (one_shot) {
- memset(trace,0,optn*sizeof(float));
- nread = fread( trace, sizeof(float), *n1, fp );
- assert (nread == *n1);
- tamplmax = 0.0;
- for (i=0;i<(*n1);i++) {
- tampl = fabsf(trace[i]);
- if (tampl > tamplmax) tamplmax = tampl;
- }
- if (trace[0]*1e-3 > tamplmax) {
- fprintf(stderr,"WARNING: file_src has a large amplitude %f at t=0\n", trace[0]);
- fprintf(stderr,"This will introduce high frequencies and can cause dispersion.\n");
- }
-
- /* estimate maximum frequency assuming amplitude spectrum is smooth */
- rc1fft(trace,ctrace,optn,1);
-
- /* find maximum amplitude */
- amplmax = 0.0;
- iwmax = 0;
- for (i=0;i<nfreq;i++) {
- ampl = sqrt(ctrace[i].r*ctrace[i].r+ctrace[i].i*ctrace[i].i);
- if (ampl > amplmax) {
- amplmax = ampl;
- iwmax = i;
- }
- }
- /* from the maximum amplitude position look for the largest frequency
- * which has an amplitude 400 times weaker than the maximum amplitude */
- for (i=iwmax;i<nfreq;i++) {
- ampl = sqrt(ctrace[i].r*ctrace[i].r+ctrace[i].i*ctrace[i].i);
- if (400*ampl < amplmax) {
- *fmax = (i-1)*(1.0/(optn*(*d1)));
- break;
- }
- }
-
- nread = fread( &hdr, 1, TRCBYTES, fp );
- if (nread==0) break;
- }
- *nxm = (int)ntraces;
-
- if (verbose>2) {
- vmess("For file %s", file_src);
- vmess("nt=%d nx=%d", *n1, *n2);
- vmess("dt=%f dx=%f", *d1, *d2);
- vmess("fmax=%f", *fmax);
- vmess("tstart=%f", *f1);
- }
-
- fclose(fp);
- free(trace);
- free(ctrace);
-
- return 0;
-}
diff --git a/fdelmodc3D/getWaveletInfo3D.c b/fdelmodc3D/getWaveletInfo3D.c
index 17e66d9dd04c723e590803e0505a61d7e09cc8ec..d24b7cc93d776959c582cb397d83ca58327d47d1 100644
--- a/fdelmodc3D/getWaveletInfo3D.c
+++ b/fdelmodc3D/getWaveletInfo3D.c
@@ -34,7 +34,8 @@ void rc1fft(float *rdata, complex *cdata, int n, int sign);
#define MIN(x,y) ((x) < (y) ? (x) : (y))
#define NINT(x) ((long)((x)>0.0?(x)+0.5:(x)-0.5))
-long getWaveletInfo3D(char *file_src, long *n1, long *n2, float *d1, float *d2, float *f1, float *f2, float *fmax, long *nxm, long verbose)
+long getWaveletInfo3D(char *file_src, long *n1, long *n2, float *d1, float *d2,
+ float *f1, float *f2, float *fmax, long *nxm, long verbose)
{
FILE *fp;
size_t nread, trace_sz;
diff --git a/fdelmodc3D/readModel.c b/fdelmodc3D/readModel.c
deleted file mode 100644
index a3975ef3cb657a813aeaf0b6b91054b321c94c38..0000000000000000000000000000000000000000
--- a/fdelmodc3D/readModel.c
+++ /dev/null
@@ -1,792 +0,0 @@
-#define _FILE_OFFSET_BITS 64
-#define _LARGEFILE_SOURCE
-#define _LARGEFILE64_SOURCE
-
-#include <assert.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <errno.h>
-#include <math.h>
-#include "segy.h"
-#include "par.h"
-#include "fdelmodc.h"
-
-#define MAX(x,y) ((x) > (y) ? (x) : (y))
-#define MIN(x,y) ((x) < (y) ? (x) : (y))
-#define NINT(x) ((int)((x)>0.0?(x)+0.5:(x)-0.5))
-
-int writesufile(char *filename, float *data, int n1, int n2, float f1, float f2, float d1, float d2);
-
-/**
-* Reads gridded model files and compute from them medium parameters used in the FD kernels.
-* The files read in contain the P (and S) wave velocity and density.
-* The medium parameters calculated are lambda, mu, lambda+2mu, and 1/ro.
-*
-* AUTHOR:
-* Jan Thorbecke (janth@xs4all.nl)
-* The Netherlands
-**/
-
-
-int readModel(modPar mod, bndPar bnd, float *rox, float *roz, float *l2m, float *lam, float *muu, float *tss, float *tes, float *tep)
-{
- FILE *fpcp, *fpcs, *fpro;
- FILE *fpqp=NULL, *fpqs=NULL;
- size_t nread;
- int i, tracesToDo;
- int n1, ix, iz, nz, nx;
- int ixo, izo, ixe, ize;
- int ioXx, ioXz, ioZz, ioZx, ioPx, ioPz, ioTx, ioTz;
- float cp2, cs2, cs11, cs12, cs21, cs22, mul, mu, lamda2mu, lamda;
- float cs2c, cs2b, cs2a, cpx, cpz, bx, bz, fac;
- float *cp, *cs, *ro, *qp, *qs;
- float a, b;
- segy hdr;
-
-
- /* grid size and start positions for the components */
- nz = mod.nz;
- nx = mod.nx;
- n1 = mod.naz;
- fac = mod.dt/mod.dx;
-
- /* Vx: rox */
- ioXx=mod.ioXx;
- ioXz=mod.ioXz;
- /* Vz: roz */
- ioZz=mod.ioZz;
- ioZx=mod.ioZx;
- /* P, Txx, Tzz: lam, l2m */
- ioPx=mod.ioPx;
- ioPz=mod.ioPz;
- /* Txz: muu */
- ioTx=mod.ioTx;
- ioTz=mod.ioTz;
- if (bnd.lef==4 || bnd.lef==2) {
- ioPx += bnd.ntap;
- ioTx += bnd.ntap;
- }
- if (bnd.top==4 || bnd.top==2) {
- ioPz += bnd.ntap;
- ioTz += bnd.ntap;
- }
-
-/* open files and read first header */
-
- cp = (float *)malloc(nz*nx*sizeof(float));
- fpcp = fopen( mod.file_cp, "r" );
- assert( fpcp != NULL);
- nread = fread(&hdr, 1, TRCBYTES, fpcp);
- assert(nread == TRCBYTES);
-
- ro = (float *)malloc(nz*nx*sizeof(float));
- fpro = fopen( mod.file_ro, "r" );
- assert( fpro != NULL);
- nread = fread(&hdr, 1, TRCBYTES, fpro);
- assert(nread == TRCBYTES);
-
- cs = (float *)calloc(nz*nx,sizeof(float));
- if (mod.ischeme>2 && mod.ischeme!=5) {
- fpcs = fopen( mod.file_cs, "r" );
- assert( fpcs != NULL);
- nread = fread(&hdr, 1, TRCBYTES, fpcs);
- assert(nread == TRCBYTES);
- }
-
-/* for visco acoustic/elastic media open Q file(s) if given as parameter */
-
- if (mod.file_qp != NULL && (mod.ischeme==2 || mod.ischeme==4)) {
- qp = (float *)malloc(nz*sizeof(float));
- fpqp = fopen( mod.file_qp, "r" );
- assert( fpqp != NULL);
- nread = fread(&hdr, 1, TRCBYTES, fpqp);
- assert(nread == TRCBYTES);
- }
- if (mod.file_qs != NULL && mod.ischeme==4) {
- qs = (float *)malloc(nz*sizeof(float));
- fpqs = fopen( mod.file_qs, "r" );
- assert( fpqs != NULL);
- nread = fread(&hdr, 1, TRCBYTES, fpqs);
- assert(nread == TRCBYTES);
- }
-
-
-/* read all traces */
-
- tracesToDo = mod.nx;
- i = 0;
- while (tracesToDo) {
- nread = fread(&cp[i*nz], sizeof(float), hdr.ns, fpcp);
- assert (nread == hdr.ns);
- nread = fread(&ro[i*nz], sizeof(float), hdr.ns, fpro);
- assert (nread == hdr.ns);
- if (mod.ischeme>2 && mod.ischeme!=5) {
- nread = fread(&cs[i*nz], sizeof(float), hdr.ns, fpcs);
- assert (nread == hdr.ns);
- }
-
-/*************************************************************
-
- Converts the Qp,Qs-value to tau-epsilon and tau-sigma
-
- tau-sigma = (sqrt(1.0+(1.0/Qp**2))-(1.0/Qp))/w
- tau-epsilonP = 1.0/(w*w*tau-sigma)
- tau-epsilonS = (1.0+(w*Qs*tau-sigma))/(w*Qs-(w*w*tau-sigma));
-
-*************************************************************/
-
- /* visco-acoustic */
- if (mod.ischeme==2 || mod.ischeme==4) {
- if (mod.file_qp != NULL) {
- nread = fread(&qp[0], sizeof(float), nz, fpqp);
- assert (nread == hdr.ns);
- for (iz=0; iz<nz; iz++) {
-// a = sqrt(1.0+(1.0/(qp[iz]*qp[iz]))-(1.0/qp[iz]))/mod.fw;
- a = (sqrt(1.0+(1.0/(qp[iz]*qp[iz])))-(1.0/qp[iz]))/mod.fw;
- b = 1.0/(mod.fw*mod.fw*a);
- tss[(i+ioPx)*n1+iz+ioPz] = 1.0/a;
- tep[(i+ioPx)*n1+iz+ioPz] = b;
- }
- }
- else {
- for (iz=0; iz<nz; iz++) {
-// a = sqrt(1.0+(1.0/(mod.Qp*mod.Qp))-(1.0/mod.Qp))/mod.fw;
- a = (sqrt(1.0+(1.0/(mod.Qp*mod.Qp)))-(1.0/mod.Qp))/mod.fw;
- b = 1.0/(mod.fw*mod.fw*a);
- tss[(i+ioPx)*n1+iz+ioPz] = 1.0/a;
- tep[(i+ioPx)*n1+iz+ioPz] = b;
- }
- }
- }
-
- /* visco-elastic */
- if (mod.ischeme==4) {
- if (mod.file_qs != NULL) {
- nread = fread(&qs[0], sizeof(float), hdr.ns, fpqs);
- assert (nread == hdr.ns);
- for (iz=0; iz<nz; iz++) {
- a = 1.0/tss[(i+ioPx)*n1+iz+ioPz];
- tes[(i+ioPx)*n1+iz+ioPz] = (1.0+(mod.fw*qs[iz]*a))/(mod.fw*qs[iz]-(mod.fw*mod.fw*a));
- }
- }
- else {
- for (iz=0; iz<nz; iz++) {
- a = 1.0/tss[(i+ioPx)*n1+iz+ioPz];
- tes[(i+ioPx)*n1+iz+ioPz] = (1.0+(mod.fw*mod.Qs*a))/(mod.fw*mod.Qs-(mod.fw*mod.fw*a));
- }
- }
- }
-
- nread = fread(&hdr, 1, TRCBYTES, fpcp);
- if (nread==0) break;
- nread = fread(&hdr, 1, TRCBYTES, fpro);
- if (nread==0) break;
- if (mod.ischeme>2 && mod.ischeme!=5) {
- nread = fread(&hdr, 1, TRCBYTES, fpcs);
- if (nread==0) break;
- }
- if (mod.file_qp != NULL && (mod.ischeme==2 || mod.ischeme==4)) {
- nread = fread(&hdr, 1, TRCBYTES, fpqp);
- if (nread==0) break;
- }
- if (mod.file_qs != NULL && mod.ischeme==4) {
- nread = fread(&hdr, 1, TRCBYTES, fpqs);
- if (nread==0) break;
- }
- i++;
- }
- fclose(fpcp);
- fclose(fpro);
- if (mod.ischeme>2 && mod.ischeme!=5) fclose(fpcs);
- if (fpqp != NULL) fclose(fpqp);
- if (fpqs != NULL) fclose(fpqs);
-
-/* check for zero densities */
-
- for (i=0;i<nz*nx;i++) {
- if (ro[i]==0.0) {
- vwarn("Zero density for trace=%d sample=%d", i/nz, i%nz);
- verr("ERROR zero density is not a valid value, program exit");
- }
- }
-
-/* calculate the medium parameter grids needed for the FD scheme */
-
-/* the edges of the model */
-
- if (mod.ischeme>2) { /* Elastic Scheme */
- iz = nz-1;
- for (ix=0;ix<nx-1;ix++) {
- cp2 = cp[ix*nz+iz]*cp[ix*nz+iz];
- cs2 = cs[ix*nz+iz]*cs[ix*nz+iz];
- cs2a = cs[(ix+1)*nz+iz]*cs[(ix+1)*nz+iz];
- cs11 = cs2*ro[ix*nz+iz];
- cs12 = cs2*ro[ix*nz+iz];
- cs21 = cs2a*ro[(ix+1)*nz+iz];
- cs22 = cs2a*ro[(ix+1)*nz+iz];
-// cpx = 0.5*(cp[ix*nz+iz]+cp[(ix+1)*nz+iz])
-// cpz = cp[ix*nz+iz];
-
- if (cs11 > 0.0) {
- mul = 4.0/(1.0/cs11+1.0/cs12+1.0/cs21+1.0/cs22);
- }
- else {
- mul = 0.0;
- }
- mu = cs2*ro[ix*nz+iz];
- lamda2mu = cp2*ro[ix*nz+iz];
- lamda = lamda2mu - 2*mu;
-
- bx = 0.5*(ro[ix*nz+iz]+ro[(ix+1)*nz+iz]);
- bz = ro[ix*nz+iz];
- rox[(ix+ioXx)*n1+iz+ioXz]=fac/bx;
- roz[(ix+ioZx)*n1+iz+ioZz]=fac/bz;
- l2m[(ix+ioPx)*n1+iz+ioPz]=fac*lamda2mu;
- lam[(ix+ioPx)*n1+iz+ioPz]=fac*lamda;
- muu[(ix+ioTx)*n1+iz+ioTz]=fac*mul;
- }
-
- ix = nx-1;
- for (iz=0;iz<nz-1;iz++) {
- cp2 = cp[ix*nz+iz]*cp[ix*nz+iz];
- cs2 = cs[ix*nz+iz]*cs[ix*nz+iz];
- cs2b = cs[ix*nz+iz+1]*cs[ix*nz+iz+1];
- cs11 = cs2*ro[ix*nz+iz];
- cs12 = cs2b*ro[ix*nz+iz+1];
- cs21 = cs2*ro[ix*nz+iz];
- cs22 = cs2b*ro[ix*nz+iz+1];
-// cpx = cp[ix*nz+iz];
-// cpz = 0.5*(cp[ix*nz+iz]+cp[ix*nz+iz+1]);
-
- if (cs11 > 0.0) {
- mul = 4.0/(1.0/cs11+1.0/cs12+1.0/cs21+1.0/cs22);
- }
- else {
- mul = 0.0;
- }
- mu = cs2*ro[ix*nz+iz];
- lamda2mu = cp2*ro[ix*nz+iz];
- lamda = lamda2mu - 2*mu;
-
- bx = ro[ix*nz+iz];
- bz = 0.5*(ro[ix*nz+iz]+ro[ix*nz+iz+1]);
- rox[(ix+ioXx)*n1+iz+ioXz]=fac/bx;
- roz[(ix+ioZx)*n1+iz+ioZz]=fac/bz;
- l2m[(ix+ioPx)*n1+iz+ioPz]=fac*lamda2mu;
- lam[(ix+ioPx)*n1+iz+ioPz]=fac*lamda;
- muu[(ix+ioTx)*n1+iz+ioTz]=fac*mul;
- }
- ix=nx-1;
- iz=nz-1;
- cp2 = cp[ix*nz+iz]*cp[ix*nz+iz];
- cs2 = cs[ix*nz+iz]*cs[ix*nz+iz];
- mu = cs2*ro[ix*nz+iz];
- lamda2mu = cp2*ro[ix*nz+iz];
- lamda = lamda2mu - 2*mu;
- bx = ro[ix*nz+iz];
- bz = ro[ix*nz+iz];
- rox[(ix+ioXx)*n1+iz+ioXz]=fac/bx;
- roz[(ix+ioZx)*n1+iz+ioZz]=fac/bz;
- l2m[(ix+ioPx)*n1+iz+ioPz]=fac*lamda2mu;
- lam[(ix+ioPx)*n1+iz+ioPz]=fac*lamda;
- muu[(ix+ioTx)*n1+iz+ioTz]=fac*mu;
-
- for (ix=0;ix<nx-1;ix++) {
- for (iz=0;iz<nz-1;iz++) {
- cp2 = cp[ix*nz+iz]*cp[ix*nz+iz];
- cs2 = cs[ix*nz+iz]*cs[ix*nz+iz];
- cs2a = cs[(ix+1)*nz+iz]*cs[(ix+1)*nz+iz];
- cs2b = cs[ix*nz+iz+1]*cs[ix*nz+iz+1];
- cs2c = cs[(ix+1)*nz+iz+1]*cs[(ix+1)*nz+iz+1];
-
-/*
-Compute harmonic average of mul for accurate and stable fluid-solid interface
-see Finite-difference modeling of wave propagation in a fluid-solid configuration
-Robbert van Vossen, Johan O. A. Robertsson, and Chris H. Chapman
-*/
-
- cs11 = cs2*ro[ix*nz+iz];
- cs12 = cs2b*ro[ix*nz+iz+1];
- cs21 = cs2a*ro[ix*nz+iz];
- cs22 = cs2c*ro[ix*nz+iz+1];
-// cpx = 0.5*(cp[ix*nz+iz]+cp[(ix+1)*nz+iz])
-// cpz = 0.5*(cp[ix*nz+iz]+cp[ix*nz+iz+1])
-
- if (cs11 > 0.0) {
- mul = 4.0/(1.0/cs11+1.0/cs12+1.0/cs21+1.0/cs22);
- }
- else {
- mul = 0.0;
- }
- mu = cs2*ro[ix*nz+iz];
- lamda2mu = cp2*ro[ix*nz+iz];
- lamda = lamda2mu - 2*mu; /* could also use mul to calculate lambda, but that might not be correct: question from Chaoshun Hu. Note use mu or mul as well on boundaries */
-
- bx = 0.5*(ro[ix*nz+iz]+ro[(ix+1)*nz+iz]);
- bz = 0.5*(ro[ix*nz+iz]+ro[ix*nz+iz+1]);
- rox[(ix+ioXx)*n1+iz+ioXz]=fac/bx;
- roz[(ix+ioZx)*n1+iz+ioZz]=fac/bz;
- l2m[(ix+ioPx)*n1+iz+ioPz]=fac*lamda2mu;
- lam[(ix+ioPx)*n1+iz+ioPz]=fac*lamda;
- muu[(ix+ioTx)*n1+iz+ioTz]=fac*mul;
- }
- }
-
- /* for the tapered/PML boundaries */
-/*
- for (ix=mod.ioXx-bnd.ntap;ix<mod.ioXx;ix++) {
- for (iz=mod.ioXz-bnd.ntap;ix<mod.naz;ix++) {
- rox[ix*n1+iz]=rox[ioXx*n1+ioXz]
- }
- }
-*/
-
- }
- else { /* Acoustic Scheme */
- iz = nz-1;
- for (ix=0;ix<nx-1;ix++) {
- cp2 = cp[ix*nz+iz]*cp[ix*nz+iz];
-// cpx = 0.5*(cp[ix*nz+iz]+cp[(ix+1)*nz+iz])
-// cpz = cp[ix*nz+iz];
-
- lamda2mu = cp2*ro[ix*nz+iz];
-
- bx = 0.5*(ro[ix*nz+iz]+ro[(ix+1)*nz+iz]);
- bz = ro[ix*nz+iz];
- rox[(ix+ioXx)*n1+iz+ioXz]=fac/bx;
- roz[(ix+ioZx)*n1+iz+ioZz]=fac/bz;
- l2m[(ix+ioPx)*n1+iz+ioPz]=fac*lamda2mu;
- }
-
- ix = nx-1;
- for (iz=0;iz<nz-1;iz++) {
- cp2 = cp[ix*nz+iz]*cp[ix*nz+iz];
-// cpx = cp[ix*nz+iz];
-// cpz = 0.5*(cp[ix*nz+iz]+cp[ix*nz+iz+1])
-
- lamda2mu = cp2*ro[ix*nz+iz];
-
- bx = ro[ix*nz+iz];
- bz = 0.5*(ro[ix*nz+iz]+ro[ix*nz+iz+1]);
- rox[(ix+ioXx)*n1+iz+ioXz]=fac/bx;
- roz[(ix+ioZx)*n1+iz+ioZz]=fac/bz;
- l2m[(ix+ioPx)*n1+iz+ioPz]=fac*lamda2mu;
- }
- ix=nx-1;
- iz=nz-1;
- cp2 = cp[ix*nz+iz]*cp[ix*nz+iz];
- lamda2mu = cp2*ro[ix*nz+iz];
- bx = ro[ix*nz+iz];
- bz = ro[ix*nz+iz];
- rox[(ix+ioXx)*n1+iz+ioXz]=fac/bx;
- roz[(ix+ioZx)*n1+iz+ioZz]=fac/bz;
- l2m[(ix+ioPx)*n1+iz+ioPz]=fac*lamda2mu;
-
- for (ix=0;ix<nx-1;ix++) {
- for (iz=0;iz<nz-1;iz++) {
- cp2 = cp[ix*nz+iz]*cp[ix*nz+iz];
-// cpx = 0.5*(cp[ix*nz+iz]+cp[(ix+1)*nz+iz])
-// cpz = 0.5*(cp[ix*nz+iz]+cp[ix*nz+iz+1])
-
- lamda2mu = cp2*ro[ix*nz+iz];
-
- bx = 0.5*(ro[ix*nz+iz]+ro[(ix+1)*nz+iz]);
- bz = 0.5*(ro[ix*nz+iz]+ro[ix*nz+iz+1]);
- rox[(ix+ioXx)*n1+iz+ioXz]=fac/bx;
- roz[(ix+ioZx)*n1+iz+ioZz]=fac/bz;
- l2m[(ix+ioPx)*n1+iz+ioPz]=fac*lamda2mu;
- }
- }
- }
-
- /* For topography free surface check for zero-velocity and set rox and roz also to zero */
- for (ix=0;ix<nx;ix++) {
- for (iz=0;iz<nz;iz++) {
- if (l2m[(ix+ioPx)*n1+iz+ioPz]==0.0) {
- rox[(ix+ioXx)*n1+iz+ioXz]=0.0;
- roz[(ix+ioZx)*n1+iz+ioZz]=0.0;
- }
- }
- }
-
- /*****************************************************/
- /* In case of tapered or PML boundaries extend model */
- /*****************************************************/
-
- /* Left */
- if (bnd.lef==4 || bnd.lef==2) {
-
- /* rox field */
- ixo = mod.ioXx-bnd.ntap;
- ixe = mod.ioXx;
- izo = mod.ioXz;
- ize = mod.ieXz;
- for (ix=ixo; ix<ixe; ix++) {
- for (iz=izo; iz<ize; iz++) {
- rox[ix*n1+iz] = rox[ixe*n1+iz];
- }
- }
-
- /* roz field */
- ixo = mod.ioZx-bnd.ntap;
- ixe = mod.ioZx;
- izo = mod.ioZz;
- ize = mod.ieZz;
- for (ix=ixo; ix<ixe; ix++) {
- for (iz=izo; iz<ize; iz++) {
- roz[ix*n1+iz] = roz[ixe*n1+iz];
- }
- }
- /* l2m field */
- ixo = mod.ioPx;
- ixe = mod.ioPx+bnd.ntap;
- izo = mod.ioPz;
- ize = mod.iePz;
- for (ix=ixo; ix<ixe; ix++) {
- for (iz=izo; iz<ize; iz++) {
- l2m[ix*n1+iz] = l2m[ixe*n1+iz];
- }
- }
-
- if (mod.ischeme>2) { /* Elastic Scheme */
- /* lam field */
- ixo = mod.ioPx;
- ixe = mod.ioPx+bnd.ntap;
- izo = mod.ioPz;
- ize = mod.iePz;
- for (ix=ixo; ix<ixe; ix++) {
- for (iz=izo; iz<ize; iz++) {
- lam[ix*n1+iz] = lam[ixe*n1+iz];
- }
- }
- /* muu field */
- ixo = mod.ioTx;
- ixe = mod.ioTx+bnd.ntap;
- izo = mod.ioTz;
- ize = mod.ieTz;
- for (ix=ixo; ix<ixe; ix++) {
- for (iz=izo; iz<ize; iz++) {
- muu[ix*n1+iz] = muu[ixe*n1+iz];
- }
- }
- }
- if (mod.ischeme==2 || mod.ischeme==4) {
- /* tss and tep field */
- ixo = mod.ioPx;
- ixe = mod.ioPx+bnd.ntap;
- izo = mod.ioPz;
- ize = mod.iePz;
- for (ix=ixo; ix<ixe; ix++) {
- for (iz=izo; iz<ize; iz++) {
- tss[ix*n1+iz] = tss[ixe*n1+iz];
- tep[ix*n1+iz] = tep[ixe*n1+iz];
- }
- }
- }
- if (mod.ischeme==4) {
- /* tes field */
- ixo = mod.ioPx;
- ixe = mod.ioPx+bnd.ntap;
- izo = mod.ioPz;
- ize = mod.iePz;
- for (ix=ixo; ix<ixe; ix++) {
- for (iz=izo; iz<ize; iz++) {
- tes[ix*n1+iz] = tes[ixe*n1+iz];
- }
- }
- }
-
- }
-
- /* Right */
- if (bnd.rig==4 || bnd.rig==2) {
-
- /* rox field */
- ixo = mod.ieXx;
- ixe = mod.ieXx+bnd.ntap;
- izo = mod.ioXz;
- ize = mod.ieXz;
- for (ix=ixo; ix<ixe; ix++) {
- for (iz=izo; iz<ize; iz++) {
- rox[ix*n1+iz] = rox[(ixo-1)*n1+iz];
- }
- }
-
- /* roz field */
- ixo = mod.ieZx;
- ixe = mod.ieZx+bnd.ntap;
- izo = mod.ioZz;
- ize = mod.ieZz;
- for (ix=ixo; ix<ixe; ix++) {
- for (iz=izo; iz<ize; iz++) {
- roz[ix*n1+iz] = roz[(ixo-1)*n1+iz];
- }
- }
- /* l2m field */
- ixo = mod.iePx-bnd.ntap;
- ixe = mod.iePx;
- izo = mod.ioPz;
- ize = mod.iePz;
- for (ix=ixo; ix<ixe; ix++) {
- for (iz=izo; iz<ize; iz++) {
- l2m[ix*n1+iz] = l2m[(ixo-1)*n1+iz];
- }
- }
-
- if (mod.ischeme>2) { /* Elastic Scheme */
- /* lam field */
- ixo = mod.iePx-bnd.ntap;
- ixe = mod.iePx;
- izo = mod.ioPz;
- ize = mod.iePz;
- for (ix=ixo; ix<ixe; ix++) {
- for (iz=izo; iz<ize; iz++) {
- lam[ix*n1+iz] = lam[(ixo-1)*n1+iz];
- }
- }
- /* muu field */
- ixo = mod.ieTx-bnd.ntap;
- ixe = mod.ieTx;
- izo = mod.ioTz;
- ize = mod.ieTz;
- for (ix=ixo; ix<ixe; ix++) {
- for (iz=izo; iz<ize; iz++) {
- muu[ix*n1+iz] = muu[(ixo-1)*n1+iz];
- }
- }
- }
- if (mod.ischeme==2 || mod.ischeme==4) {
- /* tss and tep field */
- ixo = mod.iePx-bnd.ntap;
- ixe = mod.iePx;
- izo = mod.ioPz;
- ize = mod.iePz;
- for (ix=ixo; ix<ixe; ix++) {
- for (iz=izo; iz<ize; iz++) {
- tss[ix*n1+iz] = tss[(ixo-1)*n1+iz];
- tep[ix*n1+iz] = tep[(ixo-1)*n1+iz];
- }
- }
- }
- if (mod.ischeme==4) {
- /* tes field */
- ixo = mod.iePx-bnd.ntap;
- ixe = mod.iePx;
- izo = mod.ioPz;
- ize = mod.iePz;
- for (ix=ixo; ix<ixe; ix++) {
- for (iz=izo; iz<ize; iz++) {
- tes[ix*n1+iz] = tes[(ixo-1)*n1+iz];
- }
- }
- }
-
- }
-
- /* Top */
- if (bnd.top==4 || bnd.top==2) {
-
- /* Rox field */
- ixo = mod.ioXx;
- ixe = mod.ieXx;
- if (bnd.lef==4 || bnd.lef==2) ixo -= bnd.ntap;
- if (bnd.rig==4 || bnd.rig==2) ixe += bnd.ntap;
- izo = mod.ioXz-bnd.ntap;
- ize = mod.ioXz;
-
- for (ix=ixo; ix<ixe; ix++) {
- for (iz=izo; iz<ize; iz++) {
- rox[ix*n1+iz] = rox[ix*n1+ize];
- }
- }
-
- /* roz field */
- ixo = mod.ioZx;
- ixe = mod.ieZx;
- if (bnd.lef==4 || bnd.lef==2) ixo -= bnd.ntap;
- if (bnd.rig==4 || bnd.rig==2) ixe += bnd.ntap;
- izo = mod.ioZz-bnd.ntap;
- ize = mod.ioZz;
- for (ix=ixo; ix<ixe; ix++) {
- for (iz=izo; iz<ize; iz++) {
- roz[ix*n1+iz] = roz[ix*n1+ize];
- }
- }
- /* l2m field */
- ixo = mod.ioPx;
- ixe = mod.iePx;
- izo = mod.ioPz;
- ize = mod.ioPz+bnd.ntap;
- for (ix=ixo; ix<ixe; ix++) {
- for (iz=izo; iz<ize; iz++) {
- l2m[ix*n1+iz] = l2m[ix*n1+ize];
- }
- }
-
- if (mod.ischeme>2) { /* Elastic Scheme */
- /* lam field */
- ixo = mod.ioPx;
- ixe = mod.iePx;
- izo = mod.ioPz;
- ize = mod.ioPz+bnd.ntap;
- for (ix=ixo; ix<ixe; ix++) {
- for (iz=izo; iz<ize; iz++) {
- lam[ix*n1+iz] = lam[ix*n1+ize];
- }
- }
- /* muu field */
- ixo = mod.ioTx;
- ixe = mod.ieTx;
- izo = mod.ioTz;
- ize = mod.ioTz+bnd.ntap;
- for (ix=ixo; ix<ixe; ix++) {
- for (iz=izo; iz<ize; iz++) {
- muu[ix*n1+iz] = muu[ix*n1+ize];
- }
- }
- }
- if (mod.ischeme==2 || mod.ischeme==4) {
- /* tss and tep field */
- ixo = mod.ioPx;
- ixe = mod.iePx;
- izo = mod.ioPz;
- ize = mod.ioPz+bnd.ntap;
- for (ix=ixo; ix<ixe; ix++) {
- for (iz=izo; iz<ize; iz++) {
- tss[ix*n1+iz] = tss[ix*n1+ize];
- tep[ix*n1+iz] = tep[ix*n1+ize];
- }
- }
- }
- if (mod.ischeme==4) {
- /* tes field */
- ixo = mod.ioPx;
- ixe = mod.iePx;
- izo = mod.ioPz;
- ize = mod.ioPz+bnd.ntap;
- for (ix=ixo; ix<ixe; ix++) {
- for (iz=izo; iz<ize; iz++) {
- tes[ix*n1+iz] = tes[ix*n1+ize];
- }
- }
- }
-
- }
-
- /* Bottom */
- if (bnd.bot==4 || bnd.bot==2) {
-
- /* Rox field */
- ixo = mod.ioXx;
- ixe = mod.ieXx;
- if (bnd.lef==4 || bnd.lef==2) ixo -= bnd.ntap;
- if (bnd.rig==4 || bnd.rig==2) ixe += bnd.ntap;
- izo = mod.ieXz;
- ize = mod.ieXz+bnd.ntap;
- for (ix=ixo; ix<ixe; ix++) {
- for (iz=izo; iz<ize; iz++) {
- rox[ix*n1+iz] = rox[ix*n1+izo-1];
- }
- }
-
- /* roz field */
- ixo = mod.ioZx;
- ixe = mod.ieZx;
- if (bnd.lef==4 || bnd.lef==2) ixo -= bnd.ntap;
- if (bnd.rig==4 || bnd.rig==2) ixe += bnd.ntap;
- izo = mod.ieZz;
- ize = mod.ieZz+bnd.ntap;
- for (ix=ixo; ix<ixe; ix++) {
- for (iz=izo; iz<ize; iz++) {
- roz[ix*n1+iz] = roz[ix*n1+izo-1];
- }
- }
- /* l2m field */
- ixo = mod.ioPx;
- ixe = mod.iePx;
- izo = mod.iePz-bnd.ntap;
- ize = mod.iePz;
- for (ix=ixo; ix<ixe; ix++) {
- for (iz=izo; iz<ize; iz++) {
- l2m[ix*n1+iz] = l2m[ix*n1+izo-1];
- }
- }
-
- if (mod.ischeme>2) { /* Elastic Scheme */
- /* lam field */
- ixo = mod.ioPx;
- ixe = mod.iePx;
- izo = mod.iePz-bnd.ntap;
- ize = mod.iePz;
- for (ix=ixo; ix<ixe; ix++) {
- for (iz=izo; iz<ize; iz++) {
- lam[ix*n1+iz] = lam[ix*n1+izo-1];
- }
- }
-
- /* muu */
- ixo = mod.ioTx;
- ixe = mod.ieTx;
- izo = mod.ieTz-bnd.ntap;
- ize = mod.ieTz;
- for (ix=ixo; ix<ixe; ix++) {
- for (iz=izo; iz<ize; iz++) {
- muu[ix*n1+iz] = muu[ix*n1+izo-1];
- }
- }
- }
- if (mod.ischeme==2 || mod.ischeme==4) {
- /* tss and tep field */
- ixo = mod.ioPx;
- ixe = mod.iePx;
- izo = mod.iePz-bnd.ntap;
- ize = mod.iePz;
- for (ix=ixo; ix<ixe; ix++) {
- for (iz=izo; iz<ize; iz++) {
- tss[ix*n1+iz] = tss[ix*n1+izo-1];
- tep[ix*n1+iz] = tep[ix*n1+izo-1];
- }
- }
- }
- if (mod.ischeme==4) {
- /* tes field */
- ixo = mod.ioPx;
- ixe = mod.iePx;
- izo = mod.iePz-bnd.ntap;
- ize = mod.iePz;
- for (ix=ixo; ix<ixe; ix++) {
- for (iz=izo; iz<ize; iz++) {
- tes[ix*n1+iz] = tes[ix*n1+izo-1];
- }
- }
- }
-
- }
-
-/*
- writesufile("rox.su", rox, mod.naz, mod.nax, 0.0, 0.0, 1, 1);
- writesufile("roz.su", roz, mod.naz, mod.nax, 0.0, 0.0, 1, 1);
- writesufile("l2m.su", l2m, mod.naz, mod.nax, 0.0, 0.0, 1, 1);
- writesufile("lam.su", lam, mod.naz, mod.nax, 0.0, 0.0, 1, 1);
- writesufile("muu.su", muu, mod.naz, mod.nax, 0.0, 0.0, 1, 1);
-*/
-/*
- for (ix=0; ix<mod.nax; ix++) {
- for (iz=0; iz<mod.naz; iz++) {
- rox[ix*n1+iz] = rox[10*n1+10];
- roz[ix*n1+iz] = roz[10*n1+10];
- l2m[ix*n1+iz] = l2m[10*n1+10];
- muu[ix*n1+iz] = muu[10*n1+10];
- lam[ix*n1+iz] = lam[10*n1+10];
- }
- }
-*/
-
- free(cp);
- free(ro);
- free(cs);
-
- return 0;
-}
-
-
diff --git a/fdelmodc3D/readModel3D.c b/fdelmodc3D/readModel3D.c
index cd3ce5832fd6353cc887bb9497ccec75a2bad1e9..a634383f593556139a47880cc7bdb6b52b80dfa7 100644
--- a/fdelmodc3D/readModel3D.c
+++ b/fdelmodc3D/readModel3D.c
@@ -26,7 +26,8 @@
**/
-long readModel3D(modPar mod, bndPar bnd, float *rox, float *roy, float *roz, float *l2m, float *lam, float *muu, float *tss, float *tes, float *tep)
+long readModel3D(modPar mod, bndPar bnd, float *rox, float *roy, float *roz,
+ float *l2m, float *lam, float *muu, float *tss, float *tes, float *tep)
{
FILE *fpcp, *fpcs, *fpro;
FILE *fpqp=NULL, *fpqs=NULL;
diff --git a/fdelmodc3D/recvPar.c b/fdelmodc3D/recvPar.c
deleted file mode 100644
index 7509bf68d57b31e920459b5c3f4f4d90de079c61..0000000000000000000000000000000000000000
--- a/fdelmodc3D/recvPar.c
+++ /dev/null
@@ -1,519 +0,0 @@
-#include <stdio.h>
-#include <assert.h>
-#include <math.h>
-
-#include "fdelmodc.h"
-#include "par.h"
-
-#define MIN(x,y) ((x) < (y) ? (x) : (y))
-#define MAX(x,y) ((x) > (y) ? (x) : (y))
-#define NINT(x) ((int)((x)>0.0?(x)+0.5:(x)-0.5))
-
-/**
-* Calculates the receiver positions based on the input parameters
-*
-* AUTHOR:
-* Jan Thorbecke (janth@xs4all.nl)
-*
-* Ammendments:
-* Max Holicki changing the allocation receiver array (2-2016)
-* The Netherlands
-**/
-
-
-void name_ext(char *filename, char *extension);
-
-int recvPar(recPar *rec, float sub_x0, float sub_z0, float dx, float dz, int nx, int nz)
-{
- float *xrcv1, *xrcv2, *zrcv1, *zrcv2;
- int i, ix, ir, verbose;
- float dxrcv, dzrcv, *dxr, *dzr;
- float rrcv, dphi, oxrcv, ozrcv, arcv;
- double circ, h, a, b, e, s, xr, zr, dr, srun, phase;
- float xrange, zrange, sub_x1, sub_z1;
- int Nx1, Nx2, Nz1, Nz2, Ndx, Ndz, iarray, nrec, nh;
- int nxrcv, nzrcv, ncrcv, nrcv, ntrcv, *nlrcv;
- float *xrcva, *zrcva;
- char* rcv_txt;
- FILE *fp;
-
- if (!getparint("verbose", &verbose)) verbose = 0;
-
- /* Calculate Model Dimensions */
- sub_x1=sub_x0+(nx-1)*dx;
- sub_z1=sub_z0+(nz-1)*dz;
-
-/* Compute how many receivers are defined and then allocate the receiver arrays */
-
- /* Receivers on a Circle */
- if (getparfloat("rrcv",&rrcv)) {
- if (!getparfloat("dphi",&dphi)) dphi=2.0;
- ncrcv=NINT(360.0/dphi);
- if (verbose) vmess("Total number of receivers on a circle: %d",ncrcv);
- }
- else {
- ncrcv=0;
- }
-
- /* Receivers from a File */
- ntrcv=0;
- if (!getparstring("rcv_txt",&rcv_txt)) rcv_txt=NULL;
- if (rcv_txt!=NULL) {
- /* Open text file */
- fp=fopen(rcv_txt,"r");
- assert(fp!=NULL);
- /* Get number of lines */
- while (!feof(fp)) if (fgetc(fp)=='\n') ntrcv++;
- fseek(fp,-1,SEEK_CUR);
- if (fgetc(fp)!='\n') ntrcv++; /* Checks if last line terminated by /n */
- if (verbose) vmess("Number of receivers in rcv_txt file: %d",ntrcv);
- rewind(fp);
- }
-
- /* Receiver Array */
- nxrcv=countparval("xrcva");
- nzrcv=countparval("zrcva");
- if (nxrcv!=nzrcv) verr("Number of receivers in array xrcva (%d), zrcva(%d) are not equal",nxrcv,nzrcv);
- if (verbose&&nxrcv) vmess("Total number of array receivers: %d",nxrcv);
-
- /* Linear Receiver Arrays */
- Nx1 = countparval("xrcv1");
- Nx2 = countparval("xrcv2");
- Nz1 = countparval("zrcv1");
- Nz2 = countparval("zrcv2");
- if (Nx1!=Nx2) verr("Number of receivers starting points in 'xrcv1' (%d) and number of endpoint in 'xrcv2' (%d) are not equal",Nx1,Nx2);
- if (Nz1!=Nz2) verr("Number of receivers starting points in 'zrcv1' (%d) and number of endpoint in 'zrcv2' (%d) are not equal",Nz1,Nz2);
- if (Nx1!=Nz2) verr("Number of receivers starting points in 'xrcv1' (%d) and number of endpoint in 'zrcv2' (%d) are not equal",Nx1,Nz2);
-
- rec->max_nrec=ncrcv+ntrcv+nxrcv;
-
- /* no receivers are defined use default linear array of receivers on top of model */
- if (!rec->max_nrec && Nx1==0) Nx1=1; // Default is to use top of model to record data
-
- if (Nx1) {
- /* Allocate Start & End Points of Linear Arrays */
- xrcv1=(float *)malloc(Nx1*sizeof(float));
- xrcv2=(float *)malloc(Nx1*sizeof(float));
- zrcv1=(float *)malloc(Nx1*sizeof(float));
- zrcv2=(float *)malloc(Nx1*sizeof(float));
- if (!getparfloat("xrcv1",xrcv1)) xrcv1[0]=sub_x0;
- if (!getparfloat("xrcv2",xrcv2)) xrcv2[0]=sub_x1;
- if (!getparfloat("zrcv1",zrcv1)) zrcv1[0]=sub_z0;
- if (!getparfloat("zrcv2",zrcv2)) zrcv2[0]=zrcv1[0];
-
- /* check if receiver arrays fit into model */
- for (iarray=0; iarray<Nx1; iarray++) {
- xrcv1[iarray] = MAX(sub_x0, xrcv1[iarray]);
- xrcv1[iarray] = MIN(sub_x0+nx*dx,xrcv1[iarray]);
- xrcv2[iarray] = MAX(sub_x0, xrcv2[iarray]);
- xrcv2[iarray] = MIN(sub_x0+nx*dx,xrcv2[iarray]);
-
- zrcv1[iarray] = MAX(sub_z0, zrcv1[iarray]);
- zrcv1[iarray] = MIN(sub_z0+nz*dz,zrcv1[iarray]);
- zrcv2[iarray] = MAX(sub_z0, zrcv2[iarray]);
- zrcv2[iarray] = MIN(sub_z0+nz*dz,zrcv2[iarray]);
- }
-
- /* Crop to Fit Model */
-/* Max's addtion still have to check if it has the same fucntionality */
- for (iarray=0;iarray<Nx1;iarray++) {
- if (xrcv1[iarray]<sub_x0) {
- if (xrcv2[iarray]<sub_x0) {
- verr("Linear array %d outside model bounds",iarray);
- }
- else {
- vwarn("Cropping element %d of 'xrcv1' (%f) to model bounds (%f)",iarray,xrcv1[iarray],sub_x0);
- xrcv1[iarray]=sub_x0;
- }
- }
- else if (xrcv1[iarray] > sub_x1) {
- verr("Linear array %d outside model bounds",iarray);
- }
- if ( (xrcv2[iarray] < xrcv1[iarray]) ) {
- verr("Ill defined linear array %d, 'xrcv1' (%f) greater than 'xrcv2' (%f)",iarray,xrcv1[iarray],xrcv2[iarray]);
- }
- else if (xrcv2[iarray]>sub_x1) {
- vwarn("Cropping element %d of 'xrcv2' (%f) to model bounds (%f)",iarray,xrcv2[iarray],sub_x1);
- xrcv2[iarray]=sub_x1;
- }
-
- if (zrcv1[iarray] < sub_z0) {
- if (zrcv2[iarray] < sub_z0) {
- verr("Linear array %d outside model bounds",iarray);
- }
- else {
- vwarn("Cropping element %d of 'zrcv1' (%f) to model bounds (%f)",iarray,zrcv1[iarray],sub_z0);
- zrcv1[iarray]=sub_z0;
- }
- }
- else if (zrcv1[iarray] > sub_z1) {
- verr("Linear array %d outside model bounds",iarray);
- }
- if ( (zrcv2[iarray] < zrcv1[iarray]) ) {
- verr("Ill defined linear array %d, 'zrcv1' (%f) greater than 'zrcv2' (%f)",iarray,zrcv1[iarray],zrcv2[iarray]);
- }
- else if (zrcv2[iarray]>sub_z1) {
- vwarn("Cropping element %d of 'xrcv2' (%f) to model bounds (%f)",iarray,zrcv2[iarray],sub_z1);
- zrcv2[iarray]=sub_z1;
- }
- }
-
- /* Get Sampling Rates */
- Ndx = countparval("dxrcv");
- Ndz = countparval("dzrcv");
-
- dxr = (float *)malloc(Nx1*sizeof(float));
- dzr = (float *)malloc(Nx1*sizeof(float));
- if(!getparfloat("dxrcv", dxr)) dxr[0]=dx;
- if(!getparfloat("dzrcv", dzr)) dzr[0]=0.0;
- if ( (Ndx<=1) && (Ndz==0) ){ /* default values are set */
- for (i=1; i<Nx1; i++) {
- dxr[i] = dxr[0];
- dzr[i] = dzr[0];
- }
- Ndx=1;
- Ndz=1;
- }
- else if ( (Ndz==1) && (Ndx==0) ){ /* default values are set */
- for (i=1; i<Nx1; i++) {
- dxr[i] = dxr[0];
- dzr[i] = dzr[0];
- }
- Ndz=1;
- Ndx=1;
- }
- else { /* make sure that each array has dzrcv or dxrcv defined for each line or receivers */
- if (Ndx!=Ndz) {
- verr("Number of 'dxrcv' (%d) is not equal to number of 'dzrcv' (%d) or 1",Ndx,Ndz);
- }
- if (Ndx!=Nx1 && Ndx!=1) {
- verr("Number of 'dxrcv' (%d) is not equal to number of starting points in 'xrcv1' (%d) or 1",Ndx,Nx1);
- }
- }
-
- /* check consistency of receiver steps */
- for (iarray=0; iarray<Ndx; iarray++) {
- if (dxr[iarray]<0) {
- dxr[i]=dx;
- vwarn("'dxrcv' element %d (%f) is less than zero, changing it to %f'",iarray,dxr[iarray],dx);
- }
- }
- for (iarray=0;iarray<Ndz;iarray++) {
- if (dzr[iarray]<0) {
- dzr[iarray]=dz;
- vwarn("'dzrcv' element %d (%f) is less than zero, changing it to %f'",iarray,dzr[iarray],dz);
- }
- }
- for (iarray=0;iarray<Ndx;iarray++){
- if (dxr[iarray]==0 && dzr[iarray]==0) {
- xrcv2[iarray]=xrcv1[iarray];
- dxr[iarray]=1.;
- vwarn("'dxrcv' element %d & 'dzrcv' element 1 are both 0.",iarray+1);
- vmess("Placing 1 receiver at (%d,%d)",xrcv1[iarray],zrcv1[iarray]);
- }
- }
- for (iarray=0;iarray<Ndx;iarray++){
- if (xrcv1[iarray]==xrcv2[iarray] && dxr[iarray]!=0) {
- dxr[iarray]=0.;
- vwarn("Linear array %d: 'xrcv1'='xrcv2' and 'dxrcv' is not 0. Setting 'dxrcv'=0",iarray+1);
- }
- }
- for (iarray=0;iarray<Ndx;iarray++){
- if (zrcv1[iarray]==zrcv2[iarray] && dzr[iarray]!=0.){
- dzr[iarray]=0.;
- vwarn("Linear array %d: 'zrcv1'='zrcv2' and 'dzrcv' is not 0. Setting 'dzrcv'=0",iarray+1);
- }
- }
-
- /* Calculate Number of Receivers */
- nrcv = 0;
- nlrcv=(int *)malloc(Nx1*sizeof(int));
- for (iarray=0; iarray<Nx1; iarray++) {
- xrange = (xrcv2[iarray]-xrcv1[iarray]);
- zrange = (zrcv2[iarray]-zrcv1[iarray]);
- if (dxr[iarray] != 0.0) {
- nlrcv[iarray] = NINT(fabs(xrange/dxr[iarray]))+1;
- }
- else {
- if (dzr[iarray] == 0) {
- verr("For receiver array %d: receiver distance dzrcv is not given", iarray);
- }
- nlrcv[iarray] = NINT(fabs(zrange/dzr[iarray]))+1;
- }
- nrcv+=nlrcv[iarray];
- }
-
- /* Calculate Number of Receivers */
-/*
- nlrcv=(int *)malloc(Nx1*sizeof(int));
- if (!isnan(*xrcv1)) *nlrcv=MIN(NINT((*xrcv2-*xrcv1)/(*dxr)),NINT((*zrcv2-*zrcv1)/(*dzr)))+1;
- else *nlrcv=0;
- nrcv=*nlrcv;
- if (verbose>4 && nlrcv[iarray]!=0) vmess("Linear receiver array 1 has final bounds: (X: %f -> %f,Z: %f ->
-%f)",xrcv1[iarray],xrcv1[iarray]+nlrcv[iarray]*(*dxr),zrcv1[iarray],zrcv1[iarray]+nlrcv[iarray]*(*dzr));
- if (Ndx>1) {
- for (iarray=1;iarray<Nx1;iarray++) {
- if (!isnan(xrcv1[iarray])) {
- nlrcv[iarray]=MIN(NINT((xrcv2[iarray]-xrcv1[iarray])/dxr[iarray]),NINT((zrcv2[iarray]-zrcv1[iarray])/dzr[iarray]))+1;
- }
- else {
- nlrcv[iarray]=0;
- }
- nrcv+=nlrcv[iarray];
- if (verbose>4&&nlrcv[iarray]!=0) vmess("Linear receiver array %d has final bounds: (X: %f -> %f,Z: %f ->
-%f)",iarray,xrcv1[iarray],xrcv1[iarray]+nlrcv[iarray]*dxr[iarray],zrcv1[iarray],zrcv1[iarray]+nlrcv[iarray]*dzr[iarray]);
- }
- }
- else {
- for (iarray=1;iarray<Nx1;iarray++) {
- if (!isnan(xrcv1[iarray])) nlrcv[iarray]=MIN(NINT((xrcv2[iarray]-xrcv1[iarray])/(*dxr)),NINT((zrcv2[iarray]-zrcv1[iarray])/(*dzr)))+1;
- else nlrcv[iarray]=0;
- nrcv+=nlrcv[iarray];
- if (verbose>4&&nlrcv[iarray]!=0) vmess("Linear receiver array %d has final bounds: (X: %f -> %f,Z: %f ->
-%f)",iarray,xrcv1[iarray],xrcv1[iarray]+nlrcv[iarray]**dxr,zrcv1[iarray],zrcv1[iarray]+nlrcv[iarray]**dzr);
- }
- }
-*/
- if (verbose) vmess("Total number of linear array receivers: %d",nrcv);
- if (!nrcv) {
- free(xrcv1);
- free(xrcv2);
- free(zrcv1);
- free(zrcv2);
- free(dxr);
- free(dzr);
- free(nlrcv);
- }
- rec->max_nrec+=nrcv;
- }
- else {
- nrcv=0;
- }
-
-/* allocate the receiver arrays */
-
- /* Total Number of Receivers */
- if (verbose) vmess("Total number of receivers: %d",rec->max_nrec);
-
- /* Allocate Arrays */
- rec->x = (int *)calloc(rec->max_nrec,sizeof(int));
- rec->z = (int *)calloc(rec->max_nrec,sizeof(int));
- rec->xr = (float *)calloc(rec->max_nrec,sizeof(float));
- rec->zr = (float *)calloc(rec->max_nrec,sizeof(float));
-
-/* read in the receiver postions */
-
- nrec=0;
- /* Receivers on a Circle */
- if (ncrcv) {
- if (!getparfloat("oxrcv",&oxrcv)) oxrcv=0.0;
- if (!getparfloat("ozrcv",&ozrcv)) ozrcv=0.0;
- if (!getparfloat("arcv",&arcv)) {
- arcv=rrcv;
- for (ix=0; ix<ncrcv; ix++) {
- rec->xr[ix] = oxrcv-sub_x0+rrcv*cos(((ix*dphi)/360.0)*(2.0*M_PI));
- rec->zr[ix] = ozrcv-sub_z0+arcv*sin(((ix*dphi)/360.0)*(2.0*M_PI));
- rec->x[ix] = NINT(rec->xr[ix]/dx);
- rec->z[ix] = NINT(rec->zr[ix]/dz);
- //rec->x[ix] = NINT((oxrcv-sub_x0+rrcv*cos(((ix*dphi)/360.0)*(2.0*M_PI)))/dx);
- //rec->z[ix] = NINT((ozrcv-sub_z0+arcv*sin(((ix*dphi)/360.0)*(2.0*M_PI)))/dz);
- if (verbose>4) fprintf(stderr,"Receiver Circle: xrcv[%d]=%f zrcv=%f\n", ix, rec->xr[ix]+sub_x0, rec->zr[ix]+sub_z0);
- }
- }
- else { /* an ellipse */
- /* simple numerical solution to find equidistant points on an ellipse */
- nh = (ncrcv)*1000; /* should be fine enough for most configurations */
- h = 2.0*M_PI/nh;
- a = MAX(rrcv, arcv);
- b = MIN(rrcv, arcv);
- e = sqrt(a*a-b*b)/a;
- //fprintf(stderr,"a=%f b=%f e=%f\n", a, b, e);
- circ = 0.0;
- for (ir=0; ir<nh; ir++) {
- s = sin(ir*h);
- circ += sqrt(1.0-e*e*s*s);
- }
- circ = a*h*circ;
- //fprintf(stderr,"circ = %f circle=%f\n", circ, 2.0*M_PI*rrcv);
- /* define distance between receivers on ellipse */
- dr = circ/ncrcv;
- ix = 0;
- srun = 0.0;
- if (arcv >= rrcv) phase=0.0;
- else phase=0.5*M_PI;
- for (ir=0; ir<nh; ir++) {
- s = sin(ir*h);
- srun += sqrt(1.0-e*e*s*s);
- if (a*h*srun >= ix*dr ) {
- xr = rrcv*cos(ir*h+phase);
- zr = arcv*sin(ir*h+phase);
- rec->xr[ix] = oxrcv-sub_x0+xr;
- rec->zr[ix] = ozrcv-sub_z0+zr;
- rec->x[ix] = NINT(rec->xr[ix]/dx);
- rec->z[ix] = NINT(rec->zr[ix]/dz);
- if (verbose>4) fprintf(stderr,"Receiver Ellipse: xrcv[%d]=%f zrcv=%f\n", ix, rec->xr[ix]+sub_x0, rec->zr[ix]+sub_z0);
- ix++;
- }
- if (ix == ncrcv) break;
- }
- }
-
- /* check if receivers fit into the model otherwise clip to edges */
- for (ix=0; ix<ncrcv; ix++) {
- rec->x[ix] = MIN(nx-1, MAX(rec->x[ix], 0));
- rec->z[ix] = MIN(nz-1, MAX(rec->z[ix], 0));
- }
- nrec += ncrcv;
- }
-
- /* Receiver Text File */
-
- if (ntrcv) {
- /* Allocate arrays */
- xrcva = (float *)malloc(ntrcv*sizeof(float));
- zrcva = (float *)malloc(ntrcv*sizeof(float));
- /* Read in receiver coordinates */
- for (i=0;i<ntrcv;i++) {
- if (fscanf(fp,"%e %e\n",&xrcva[i],&zrcva[i])!=2) vmess("Receiver Text File: Can not parse coordinates on line %d.",i);
- }
- /* Close file */
- fclose(fp);
- /* Process coordinates */
- for (ix=0; ix<ntrcv; ix++) {
- rec->xr[nrec+ix] = xrcva[ix]-sub_x0;
- rec->zr[nrec+ix] = zrcva[ix]-sub_z0;
- rec->x[nrec+ix] = NINT((xrcva[ix]-sub_x0)/dx);
- rec->z[nrec+ix] = NINT((zrcva[ix]-sub_z0)/dz);
- if (verbose>4) vmess("Receiver Text Array: xrcv[%d]=%f zrcv=%f", ix, rec->xr[nrec+ix]+sub_x0, rec->zr[nrec+ix]+sub_z0);
- }
- free(xrcva);
- free(zrcva);
- nrec += ntrcv;
- }
-
- /* Receiver Array */
- if (nxrcv != 0) {
- /* receiver array is defined */
- xrcva = (float *)malloc(nxrcv*sizeof(float));
- zrcva = (float *)malloc(nxrcv*sizeof(float));
- getparfloat("xrcva", xrcva);
- getparfloat("zrcva", zrcva);
- for (ix=0; ix<nxrcv; ix++) {
- rec->xr[nrec+ix] = xrcva[ix]-sub_x0;
- rec->zr[nrec+ix] = zrcva[ix]-sub_z0;
- rec->x[nrec+ix] = NINT((xrcva[ix]-sub_x0)/dx);
- rec->z[nrec+ix] = NINT((zrcva[ix]-sub_z0)/dz);
- if (verbose>4) fprintf(stderr,"Receiver Array: xrcv[%d]=%f zrcv=%f\n", ix, rec->xr[nrec+ix]+sub_x0, rec->zr[nrec+ix]+sub_z0);
- }
- free(xrcva);
- free(zrcva);
- nrec += nxrcv;
- }
-
- /* Linear Receiver Arrays */
- if (nrcv!=0) {
- xrcv1 = (float *)malloc(Nx1*sizeof(float));
- xrcv2 = (float *)malloc(Nx1*sizeof(float));
- zrcv1 = (float *)malloc(Nx1*sizeof(float));
- zrcv2 = (float *)malloc(Nx1*sizeof(float));
-
- if(!getparfloat("xrcv1", xrcv1)) xrcv1[0]=sub_x0;
- if(!getparfloat("xrcv2", xrcv2)) xrcv2[0]=(nx-1)*dx+sub_x0;
- if(!getparfloat("zrcv1", zrcv1)) zrcv1[0]=sub_z0;
- if(!getparfloat("zrcv2", zrcv2)) zrcv2[0]=zrcv1[0];
-
- Ndx = countparval("dxrcv");
- Ndz = countparval("dzrcv");
-
- dxr = (float *)malloc(Nx1*sizeof(float));
- dzr = (float *)malloc(Nx1*sizeof(float));
- if(!getparfloat("dxrcv", dxr)) dxr[0]=dx;
- if(!getparfloat("dzrcv", dzr)) dzr[0]=0.0;
- if ( (Ndx<=1) && (Ndz==0) ){ /* default values are set */
- for (i=1; i<Nx1; i++) {
- dxr[i] = dxr[0];
- dzr[i] = dzr[0];
- }
- Ndx=1;
- }
- else if ( (Ndz==1) && (Ndx==0) ){ /* default values are set */
- for (i=1; i<Nx1; i++) {
- dxr[i] = dxr[0];
- dzr[i] = dzr[0];
- }
- Ndz=1;
- }
- else { /* make sure that each array has dzrcv or dxrcv defined for each line or receivers */
- if (Ndx>1) assert(Ndx==Nx1);
- if (Ndz>1) assert(Ndz==Nx1);
- }
-
-/*
- if ( (Ndx!=0) && (Ndz!=0) ) {
- vwarn("Both dzrcv and dxrcv are set: dxrcv value is used");
- Ndz=0;
- for (i=0; i<Nx1; i++) dzr[i] = 0.0;
- }
-*/
- /* check if receiver arrays fit into model */
- for (iarray=0; iarray<Nx1; iarray++) {
- xrcv1[iarray] = MAX(sub_x0, xrcv1[iarray]);
- xrcv1[iarray] = MIN(sub_x0+nx*dx,xrcv1[iarray]);
- xrcv2[iarray] = MAX(sub_x0, xrcv2[iarray]);
- xrcv2[iarray] = MIN(sub_x0+nx*dx,xrcv2[iarray]);
-
- zrcv1[iarray] = MAX(sub_z0, zrcv1[iarray]);
- zrcv1[iarray] = MIN(sub_z0+nz*dz,zrcv1[iarray]);
- zrcv2[iarray] = MAX(sub_z0, zrcv2[iarray]);
- zrcv2[iarray] = MIN(sub_z0+nz*dz,zrcv2[iarray]);
- }
-
- /* calculate receiver array and store into rec->x,z */
-
- for (iarray=0; iarray<Nx1; iarray++) {
- xrange = (xrcv2[iarray]-xrcv1[iarray]);
- zrange = (zrcv2[iarray]-zrcv1[iarray]);
- if (dxr[iarray] != 0.0) {
- nrcv = nlrcv[iarray];
- dxrcv=dxr[iarray];
- dzrcv = zrange/(nrcv-1);
- if (dzrcv != dzr[iarray]) {
- vwarn("For receiver array %d: calculated dzrcv=%f given=%f", iarray, dzrcv, dzr[iarray]);
- vwarn("The calculated receiver distance %f is used", dzrcv);
- }
- }
- else {
- if (dzr[iarray] == 0) {
- verr("For receiver array %d: receiver distance dzrcv is not given", iarray);
- }
- nrcv = nlrcv[iarray];
- dxrcv = xrange/(nrcv-1);
- dzrcv = dzr[iarray];
- if (dxrcv != dxr[iarray]) {
- vwarn("For receiver array %d: calculated dxrcv=%f given=%f", iarray, dxrcv, dxr[iarray]);
- vwarn("The calculated receiver distance %f is used", dxrcv);
- }
- }
-
- // calculate coordinates
- for (ir=0; ir<nrcv; ir++) {
- rec->xr[nrec]=xrcv1[iarray]-sub_x0+ir*dxrcv;
- rec->zr[nrec]=zrcv1[iarray]-sub_z0+ir*dzrcv;
-
- rec->x[nrec]=NINT((rec->xr[nrec])/dx);
- rec->z[nrec]=NINT((rec->zr[nrec])/dz);
- nrec++;
- }
- }
- free(xrcv1);
- free(xrcv2);
- free(zrcv1);
- free(zrcv2);
- free(dxr);
- free(dzr);
- free(nlrcv);
- }
-
- rec->n=rec->max_nrec;
- return 0;
-}
diff --git a/fdelmodc3D/recvPar3D.c b/fdelmodc3D/recvPar3D.c
index 7f4e91a665a5923438e7aa4a0ce80f87dd81583a..551c68a4e273bf912df765a6ec2d93070510617b 100644
--- a/fdelmodc3D/recvPar3D.c
+++ b/fdelmodc3D/recvPar3D.c
@@ -24,7 +24,8 @@
void name_ext(char *filename, char *extension);
-long recvPar3D(recPar *rec, float sub_x0, float sub_y0, float sub_z0, float dx, float dy, float dz, long nx, long ny, long nz)
+long recvPar3D(recPar *rec, float sub_x0, float sub_y0, float sub_z0,
+ float dx, float dy, float dz, long nx, long ny, long nz)
{
float *xrcv1, *xrcv2, *yrcv1, *yrcv2, *zrcv1, *zrcv2;
long i, ix, ir, verbose;
diff --git a/fdelmodc3D/sourceOnSurface.c b/fdelmodc3D/sourceOnSurface.c
deleted file mode 100644
index a2062dc3f89f95a8f2ac6998b5fbc62768f4de07..0000000000000000000000000000000000000000
--- a/fdelmodc3D/sourceOnSurface.c
+++ /dev/null
@@ -1,498 +0,0 @@
-#include<stdlib.h>
-#include<stdio.h>
-#include<math.h>
-#include<assert.h>
-#include"fdelmodc.h"
-#define ISODD(n) ((n) & 01)
-static float *src1x, *src1z, *src2x, *src2z;
-static int first=1;
-void vmess(char *fmt, ...);
-
-int allocStoreSourceOnSurface(srcPar src)
-{
- /* allocated 2x size for dipole Potential sources */
- src1x = (float *)calloc(2*src.n, sizeof(float));
- src1z = (float *)calloc(2*src.n, sizeof(float));
- src2x = (float *)calloc(2*src.n, sizeof(float));
- src2z = (float *)calloc(2*src.n, sizeof(float));
- first = 0;
- return 0;
-}
-
-int freeStoreSourceOnSurface(void)
-{
- free(src1x);
- free(src1z);
- free(src2x);
- free(src2z);
- first = 1;
- return 0;
-}
-
-int storeSourceOnSurface(modPar mod, srcPar src, bndPar bnd, int ixsrc, int izsrc, float *vx, float *vz, float *tzz, float *txx, float *txz, int verbose)
-{
-/**********************************************************************
-
- AUTHOR:
- Jan Thorbecke (janth@xs4all.nl)
- The Netherlands
-
-***********************************************************************/
-
- int ixs, izs, isrc, is0;
- int ibndz, ibndx, store;
- int nx, nz, n1;
-
- nx = mod.nx;
- nz = mod.nz;
- n1 = mod.naz;
-
- if (src.type==6) {
- ibndz = mod.ioXz;
- ibndx = mod.ioXx;
- }
- else if (src.type==7) {
- ibndz = mod.ioZz;
- ibndx = mod.ioZx;
- }
- else if (src.type==2) {
- ibndz = mod.ioTz;
- ibndx = mod.ioTx;
- if (bnd.lef==4 || bnd.lef==2) ibndx += bnd.ntap;
- }
- else {
- ibndz = mod.ioPz;
- ibndx = mod.ioPx;
- if (bnd.lef==4 || bnd.lef==2) ibndx += bnd.ntap;
- }
-
-/* check if there are sources placed on the boundaries */
- is0 = -1*floor((src.n-1)/2);
-#pragma omp for private (isrc, ixs, izs, store)
- for (isrc=0; isrc<src.n; isrc++) {
- /* calculate the source position */
- if (src.random || src.multiwav) {
- ixs = src.x[isrc] + ibndx;
- izs = src.z[isrc] + ibndz;
- }
- else { /* plane wave and point sources */
- ixs = ixsrc + ibndx + is0 + isrc;
- izs = izsrc + ibndz;
- }
-
-// vmess("source at x=%d bounds at %d %d : %d %d ", ixs, ibndx+1, nx+ibndx, mod.ioXz, mod.ieXz);
-// vmess("source at z=%d bounds at %d %d : %d %d ", izs, ibndz+1, nz+ibndz, mod.ioXx, mod.ieXx);
-
-/* check if there are source positions placed on the boundaries.
- * In that case store them and reapply them after the boundary
- * conditions have been set */
-
- store=0;
- if ( (ixs <= ibndx+1) && ISODD(bnd.lef)) store=1;
- if ( (ixs >= nx+ibndx) && ISODD(bnd.rig)) store=1;
- if ( (izs <= ibndz+1) && ISODD(bnd.top)) store=1;
- if ( (izs >= nz+ibndz) && ISODD(bnd.bot)) store=1;
-
- if (mod.ischeme <= 2) { /* Acoustic scheme */
-
- if (store) {
- if (verbose>=5) vmess("source at x=%d z=%d stored before free surface", ixs, izs);
-
- /* Compressional source */
- if (src.type == 1) {
-
- if (src.orient==1) { /* monopole */
- src1z[isrc] = tzz[ixs*n1+izs];
- }
- else if (src.orient==2) { /* dipole +/- */
- src1z[isrc] = tzz[ixs*n1+izs];
- src2z[isrc] = tzz[ixs*n1+izs+1];
- }
- else if (src.orient==3) { /* dipole - + */
- src1z[isrc] = tzz[ixs*n1+izs];
- src2z[isrc] = tzz[(ixs-1)*n1+izs];
- }
- else if (src.orient==4) { /* dipole +/0/- */
- if (izs > ibndz)
- src1z[isrc] = tzz[ixs*n1+izs-1];
- if (izs < mod.nz+ibndz-1)
- src2z[isrc] = tzz[ixs*n1+izs+1];
- }
- else if (src.orient==5) { /* dipole + - */
- src1z[isrc] = tzz[ixs*n1+izs];
- src2z[isrc] = tzz[(ixs+1)*n1+izs];
- }
- }
- else if (src.type==6) {
- src1x[isrc] = vx[ixs*n1+izs];
- }
- else if (src.type==7) {
- src1z[isrc] = vz[ixs*n1+izs];
- }
-
- }
- }
- else { /* Elastic scheme */
-
- if (store) {
- if (verbose>=5) vmess("source at x=%d z=%d stored before free surface", ixs, izs);
-
- if (src.type==1) {
- if (src.orient==1) { /* monopole */
- src1x[isrc] = txx[ixs*n1+izs];
- src1z[isrc] = tzz[ixs*n1+izs];
- }
- else if (src.orient==2) { /* dipole +/- */
- src1x[isrc] = txx[ixs*n1+izs];
- src1z[isrc] = tzz[ixs*n1+izs];
- src2x[isrc] = txx[ixs*n1+izs+1];
- src2z[isrc] = tzz[ixs*n1+izs+1];
- }
- else if (src.orient==3) { /* dipole - + */
- src1x[isrc] = txx[ixs*n1+izs];
- src1z[isrc] = tzz[ixs*n1+izs];
- src2x[isrc] = txx[(ixs-1)*n1+izs];
- src2z[isrc] = tzz[(ixs-1)*n1+izs];
- }
- else if (src.orient==4) { /* dipole +/0/- */
- if (izs > ibndz) {
- src1x[isrc] = txx[ixs*n1+izs-1];
- src1z[isrc] = tzz[ixs*n1+izs-1];
- }
- if (izs < mod.nz+ibndz-1) {
- src1x[isrc] = txx[ixs*n1+izs+1];
- src1z[isrc] = tzz[ixs*n1+izs+1];
- }
- }
- else if (src.orient==5) { /* dipole + - */
- src1x[isrc] = txx[ixs*n1+izs];
- src1z[isrc] = tzz[ixs*n1+izs];
- src2x[isrc] = txx[(ixs+1)*n1+izs];
- src2z[isrc] = tzz[(ixs+1)*n1+izs];
- }
- }
- else if (src.type==2) {
-
- /* Txz source */
- if ((izs == ibndz) && bnd.top==1) {
- src1x[isrc] = txz[(ixs-1)*n1+izs-1];
- src2x[isrc] = txz[ixs*n1+izs-1];
- }
- else {
- src1x[isrc] = txz[ixs*n1+izs];
- }
- /* possible dipole orientations for a txz source */
- if (src.orient == 2) { /* dipole +/- */
- src2x[isrc] = txz[ixs*n1+izs+1];
- }
- else if (src.orient == 3) { /* dipole - + */
- src2x[isrc] = txz[(ixs-1)*n1+izs];
- }
- else if (src.orient == 4) { /* dipole +/O/- */
- /* correction: subtrace previous value to prevent z-1 values. */
- src1x[isrc] = txz[ixs*n1+izs];
- src2x[isrc] = txz[ixs*n1+izs+1];
- }
- else if (src.orient == 5) { /* dipole + - */
- src2x[isrc] = txz[(ixs+1)*n1+izs];
- }
-
- }
- else if (src.type==3) {
- src1z[isrc] = tzz[ixs*n1+izs];
- }
- else if (src.type==4) {
- src1x[isrc] = txx[ixs*n1+izs];
- }
- else if (src.type==5) {
-
- src1x[isrc] = vx[ixs*n1+izs];
- src1z[isrc] = vz[ixs*n1+izs];
- src2x[isrc] = vx[ixs*n1+izs-1];
- src2z[isrc] = vz[(ixs-1)*n1+izs];
-
- /* determine second position of dipole */
- if (src.orient == 2) { /* dipole +/- vertical */
- izs += 1;
- src1x[isrc+src.n] = vx[ixs*n1+izs];
- src1z[isrc+src.n] = vz[ixs*n1+izs];
- src2x[isrc+src.n] = vx[ixs*n1+izs-1];
- src2z[isrc+src.n] = vz[(ixs-1)*n1+izs];
- }
- else if (src.orient == 3) { /* dipole - + horizontal */
- ixs += 1;
- src1x[isrc+src.n] = vx[ixs*n1+izs];
- src1z[isrc+src.n] = vz[ixs*n1+izs];
- src2x[isrc+src.n] = vx[ixs*n1+izs-1];
- src2z[isrc+src.n] = vz[(ixs-1)*n1+izs];
- }
-
- }
- else if (src.type==6) {
- src1x[isrc] = vx[ixs*n1+izs];
- }
- else if (src.type==7) {
- src1z[isrc] = vz[ixs*n1+izs];
- }
- else if (src.type==8) {
-
- src1x[isrc] = vx[(ixs+1)*n1+izs];
- src1z[isrc] = vz[ixs*n1+izs+1];
- src2x[isrc] = vx[ixs*n1+izs];
- src2z[isrc] = vz[ixs*n1+izs];
-
- /* determine second position of dipole */
- if (src.orient == 2) { /* dipole +/- vertical */
- izs += 1;
- src1x[isrc+src.n] = vx[(ixs+1)*n1+izs];
- src1z[isrc+src.n] = vz[ixs*n1+izs+1];
- src2x[isrc+src.n] = vx[ixs*n1+izs];
- src2z[isrc+src.n] = vz[ixs*n1+izs];
- }
- else if (src.orient == 3) { /* dipole - + horizontal */
- ixs += 1;
- src1x[isrc+src.n] = vx[(ixs+1)*n1+izs];
- src1z[isrc+src.n] = vz[ixs*n1+izs+1];
- src2x[isrc+src.n] = vx[ixs*n1+izs];
- src2z[isrc+src.n] = vz[ixs*n1+izs];
- }
-
- } /* end of source.type */
- }
- }
- }
-
- return 0;
-}
-
-
-
-int reStoreSourceOnSurface(modPar mod, srcPar src, bndPar bnd, int ixsrc, int izsrc, float *vx, float *vz, float *tzz, float *txx, float *txz, int verbose)
-{
- /**********************************************************************
-
- AUTHOR:
- Jan Thorbecke (janth@xs4all.nl)
- The Netherlands
-
- ***********************************************************************/
-
- int ixs, izs, isrc, is0;
- int ibndz, ibndx, store;
- int nx, nz, n1;
-
- nx = mod.nx;
- nz = mod.nz;
- n1 = mod.naz;
-
- if (src.type==6) {
- ibndz = mod.ioXz;
- ibndx = mod.ioXx;
- }
- else if (src.type==7) {
- ibndz = mod.ioZz;
- ibndx = mod.ioZx;
- }
- else if (src.type==2) {
- ibndz = mod.ioTz;
- ibndx = mod.ioTx;
- if (bnd.lef==4 || bnd.lef==2) ibndx += bnd.ntap;
- }
- else {
- ibndz = mod.ioPz;
- ibndx = mod.ioPx;
- if (bnd.lef==4 || bnd.lef==2) ibndx += bnd.ntap;
- }
-
- /* restore source positions on the edge */
- is0 = -1*floor((src.n-1)/2);
-#pragma omp for private (isrc, ixs, izs, store)
- for (isrc=0; isrc<src.n; isrc++) {
- /* calculate the source position */
- if (src.random || src.multiwav) {
- ixs = src.x[isrc] + ibndx;
- izs = src.z[isrc] + ibndz;
- }
- else { /* plane wave and point sources */
- ixs = ixsrc + ibndx + is0 + isrc;
- izs = izsrc + ibndz;
- }
-
- store=0;
- if ( (ixs <= ibndx+1) && ISODD(bnd.lef)) store=1;
- if ( (ixs >= nx+ibndx) && ISODD(bnd.rig)) store=1;
- if ( (izs <= ibndz+1) && ISODD(bnd.top)) store=1;
- if ( (izs >= nz+ibndz) && ISODD(bnd.bot)) store=1;
-
- if (mod.ischeme <= 2) { /* Acoustic scheme */
-
- if (store) {
- if (verbose>=5) vmess("source at x=%d z=%d restored at free surface", ixs, izs);
-
- /* Compressional source */
- if (src.type == 1) {
-
- if (src.orient==1) { /* monopole */
- tzz[ixs*n1+izs]= src1z[isrc];
- }
- else if (src.orient==2) { /* dipole +/- */
- tzz[ixs*n1+izs] = src1z[isrc];
- tzz[ixs*n1+izs+1] = src2z[isrc];
- }
- else if (src.orient==3) { /* dipole - + */
- tzz[ixs*n1+izs] = src1z[isrc];
- tzz[(ixs-1)*n1+izs] = src2z[isrc];
- }
- else if (src.orient==4) { /* dipole +/0/- */
- if (izs > ibndz)
- tzz[ixs*n1+izs-1] = src1z[isrc];
- if (izs < mod.nz+ibndz-1)
- tzz[ixs*n1+izs+1] = src2z[isrc];
- }
- else if (src.orient==5) { /* dipole + - */
- tzz[ixs*n1+izs] = src1z[isrc];
- tzz[(ixs+1)*n1+izs] = src2z[isrc];
- }
- }
- else if (src.type==6) {
- vx[ixs*n1+izs] = src1x[isrc];
- }
- else if (src.type==7) {
- vz[ixs*n1+izs] = src1z[isrc];
- }
-
- }
-
- }
- else { /* Elastic scheme */
-
- if (store) {
- if (verbose>=5) vmess("source at x=%d z=%d restored at free surface", ixs, izs);
-
- if (src.type==1) {
- if (src.orient==1) { /* monopole */
- txx[ixs*n1+izs] = src1x[isrc];
- tzz[ixs*n1+izs] = src1z[isrc];
- }
- else if (src.orient==2) { /* dipole +/- */
- txx[ixs*n1+izs] = src1x[isrc];
- tzz[ixs*n1+izs] = src1z[isrc];
- txx[ixs*n1+izs+1] = src2x[isrc];
- tzz[ixs*n1+izs+1] = src2z[isrc];
- }
- else if (src.orient==3) { /* dipole - + */
- txx[ixs*n1+izs] = src1x[isrc];
- tzz[ixs*n1+izs] = src1z[isrc];
- txx[(ixs-1)*n1+izs] = src2x[isrc];
- tzz[(ixs-1)*n1+izs] = src2z[isrc];
- }
- else if (src.orient==4) { /* dipole +/0/- */
- if (izs > ibndz) {
- txx[ixs*n1+izs-1] = src1x[isrc];
- tzz[ixs*n1+izs-1] = src1z[isrc];
- }
- if (izs < mod.nz+ibndz-1) {
- txx[ixs*n1+izs+1] = src1x[isrc];
- tzz[ixs*n1+izs+1] = src1z[isrc];
- }
- }
- else if (src.orient==5) { /* dipole + - */
- txx[ixs*n1+izs] = src1x[isrc];
- tzz[ixs*n1+izs] = src1z[isrc];
- txx[(ixs+1)*n1+izs] = src2x[isrc];
- tzz[(ixs+1)*n1+izs] = src2z[isrc];
- }
- }
- else if (src.type==2) {
-
- /* Txz source */
- if ((izs == ibndz) && bnd.top==1) {
- txz[(ixs-1)*n1+izs-1] = src1x[isrc];
- txz[ixs*n1+izs-1] = src2x[isrc];
- }
- else {
- txz[ixs*n1+izs] = src1x[isrc];
- }
- /* possible dipole orientations for a txz source */
- if (src.orient == 2) { /* dipole +/- */
- txz[ixs*n1+izs+1] = src2x[isrc];
- }
- else if (src.orient == 3) { /* dipole - + */
- txz[(ixs-1)*n1+izs] = src2x[isrc];
- }
- else if (src.orient == 4) { /* dipole +/O/- */
- /* correction: subtrace previous value to prevent z-1 values. */
- txz[ixs*n1+izs] = src1x[isrc];
- txz[ixs*n1+izs+1] = src2x[isrc];
- }
- else if (src.orient == 5) { /* dipole + - */
- txz[(ixs+1)*n1+izs] = src2x[isrc];
- }
-
- }
- else if (src.type==3) {
- tzz[ixs*n1+izs] = src1z[isrc];
- }
- else if (src.type==4) {
- txx[ixs*n1+izs] = src1x[isrc];
- }
- else if (src.type==5) {
-
- vx[ixs*n1+izs]= src1x[isrc];
- vz[ixs*n1+izs] = src1z[isrc];
- vx[ixs*n1+izs-1] = src2x[isrc];
- vz[(ixs-1)*n1+izs] = src2z[isrc];
-
- /* determine second position of dipole */
- if (src.orient == 2) { /* dipole +/- vertical */
- izs += 1;
- vx[ixs*n1+izs] = src1x[isrc+src.n];
- vz[ixs*n1+izs] = src1z[isrc+src.n];
- vx[ixs*n1+izs-1] = src2x[isrc+src.n];
- vz[(ixs-1)*n1+izs] = src2z[isrc+src.n];
- }
- else if (src.orient == 3) { /* dipole - + horizontal */
- ixs += 1;
- vx[ixs*n1+izs] = src1x[isrc+src.n];
- vz[ixs*n1+izs] = src1z[isrc+src.n];
- vx[ixs*n1+izs-1] = src2x[isrc+src.n];
- vz[(ixs-1)*n1+izs] = src2z[isrc+src.n];
- }
-
- }
- else if (src.type==6) {
- vx[ixs*n1+izs] = src1x[isrc];
- }
- else if (src.type==7) {
- vz[ixs*n1+izs] = src1z[isrc];
- }
- else if (src.type==8) {
-
- vx[(ixs+1)*n1+izs] = src1x[isrc];
- vz[ixs*n1+izs+1] = src1z[isrc];
- vx[ixs*n1+izs] = src2x[isrc];
- vz[ixs*n1+izs] = src2z[isrc];
-
- /* determine second position of dipole */
- if (src.orient == 2) { /* dipole +/- vertical */
- izs += 1;
- vx[(ixs+1)*n1+izs] = src1x[isrc+src.n];
- vz[ixs*n1+izs+1] = src1z[isrc+src.n];
- vx[ixs*n1+izs] = src2x[isrc+src.n];
- vz[ixs*n1+izs] = src2z[isrc+src.n];
- }
- else if (src.orient == 3) { /* dipole - + horizontal */
- ixs += 1;
- vx[(ixs+1)*n1+izs] = src1x[isrc+src.n];
- vz[ixs*n1+izs+1] = src1z[isrc+src.n];
- vx[ixs*n1+izs] = src2x[isrc+src.n];
- vz[ixs*n1+izs] = src2z[isrc+src.n];
- }
-
- }
- }
- }
- }
-
- return 0;
-}
diff --git a/fdelmodc3D/sourceOnSurface3D.c b/fdelmodc3D/sourceOnSurface3D.c
index 7ddefd7034f2458e923f29cead5b441aa901d88b..d49c2364a5d435fb0c7c302addf55b63ba4846ea 100644
--- a/fdelmodc3D/sourceOnSurface3D.c
+++ b/fdelmodc3D/sourceOnSurface3D.c
@@ -33,7 +33,9 @@ long freeStoreSourceOnSurface3D(void)
return 0;
}
-long storeSourceOnSurface3D(modPar mod, srcPar src, bndPar bnd, long ixsrc, long iysrc, long izsrc, float *vx, float *vy, float *vz, float *tzz, float *tyy, float *txx, float *txz, float *txy, float *tyz, long verbose)
+long storeSourceOnSurface3D(modPar mod, srcPar src, bndPar bnd,
+ long ixsrc, long iysrc, long izsrc, float *vx, float *vy, float *vz,
+ float *tzz, float *tyy, float *txx, float *txz, float *txy, float *tyz, long verbose)
{
/**********************************************************************
@@ -301,7 +303,9 @@ long storeSourceOnSurface3D(modPar mod, srcPar src, bndPar bnd, long ixsrc, long
-long reStoreSourceOnSurface3D(modPar mod, srcPar src, bndPar bnd, long ixsrc, long iysrc, long izsrc, float *vx, float *vy, float *vz, float *tzz, float *tyy, float *txx, float *txz, float *txy, float *tyz, long verbose)
+long reStoreSourceOnSurface3D(modPar mod, srcPar src, bndPar bnd,
+ long ixsrc, long iysrc, long izsrc, float *vx, float *vy, float *vz,
+ float *tzz, float *tyy, float *txx, float *txz, float *txy, float *tyz, long verbose)
{
/**********************************************************************
diff --git a/fdelmodc3D/viscoacoustic4.c b/fdelmodc3D/viscoacoustic4.c
deleted file mode 100644
index 63207c7da09c060fccf4b3625a86e6437d744d91..0000000000000000000000000000000000000000
--- a/fdelmodc3D/viscoacoustic4.c
+++ /dev/null
@@ -1,175 +0,0 @@
-#include<stdlib.h>
-#include<stdio.h>
-#include<math.h>
-#include<assert.h>
-#include"fdelmodc.h"
-
-int applySource(modPar mod, srcPar src, wavPar wav, bndPar bnd, int itime, int ixsrc, int izsrc, float *vx, float *vz, float *tzz,
-float *txx, float *txz, float *rox, float *roz, float *l2m, float **src_nwav, int verbose);
-
-int storeSourceOnSurface(modPar mod, srcPar src, bndPar bnd, int ixsrc, int izsrc, float *vx, float *vz, float *tzz, float *txx, float *txz, int verbose);
-
-int reStoreSourceOnSurface(modPar mod, srcPar src, bndPar bnd, int ixsrc, int izsrc, float *vx, float *vz, float *tzz, float *txx, float *txz, int verbose);
-
-int boundariesP(modPar mod, bndPar bnd, float *vx, float *vz, float *tzz, float *txx, float *txz, float *rox, float *roz, float *l2m, float *lam, float *mul, int itime, int verbose);
-
-int boundariesV(modPar mod, bndPar bnd, float *vx, float *vz, float *tzz, float *txx, float *txz, float *rox, float *roz, float *l2m, float *lam, float *mul, int itime, int verbose);
-
-int viscoacoustic4(modPar mod, srcPar src, wavPar wav, bndPar bnd, int itime, int ixsrc, int izsrc, float **src_nwav, float *vx, float *vz, float *p, float *rox, float *roz, float *l2m, float *tss, float *tep, float *q, int verbose)
-{
-/*********************************************************************
- COMPUTATIONAL OVERVIEW OF THE 4th ORDER STAGGERED GRID:
-
- The captial symbols T (=Txx,Tzz) Txz,Vx,Vz represent the actual grid
- The indices ix,iz are related to the T grid, so the capital T
- symbols represent the actual modelled grid.
-
- one cel (iz,ix)
- |
- V extra column of vx,txz
- |
- ------- V
- | txz vz| txz vz txz vz txz vz txz vz txz vz txz
- | |
- | vx t | vx t vx t vx t vx t vx t vx
- -------
- txz vz txz vz txz vz txz vz txz vz txz vz txz
-
- vx t vx T---Vx--T---Vx--T---Vx--T vx t vx
- | | | | | | |
- txz vz txz Vz--Txz-Vz--Txz-Vz Txz-Vz txz vz txz
- | | | | | | |
- vx t vx T---Vx--T---Vx--T---Vx--T vx t vx
- | | | | | | |
- txz vz txz Vz Txz-Vz Txz-Vz Txz-Vz txz vz txz
- | | | | | | |
- vx t vx T---Vx--T---Vx--T---Vx--T vx t vx
- | | | | | | |
- txz vz txz Vz Txz-Vz Txz-Vz Txz-Vz txz vz txz
- | | | | | | |
- vx t vx T---Vx--T---Vx--T---Vx--T vx t vx
-
- txz vz txz vz txz vz txz vz txz vz txz vz txz
-
- vx t vx t vx t vx t vx t vx t vx
-
- txz vz txz vz txz vz txz vz txz vz txz vz txz <--|
- |
- extra row of txz/vz |
-
- AUTHOR:
- Jan Thorbecke (janth@xs4all.nl)
- The Netherlands
-
-***********************************************************************/
-
- float c1, c2;
- int ix, iz;
- int n1;
- float ddt, Tpp, *Tlm, *Tlp, *Tt1, *Tt2, *dxvx, *dzvz;
-
-
- c1 = 9.0/8.0;
- c2 = -1.0/24.0;
- n1 = mod.naz;
- ddt = 1.0/mod.dt;
-
- dxvx = (float *)malloc(n1*sizeof(float));
- dzvz = (float *)malloc(n1*sizeof(float));
- Tlm = (float *)malloc(n1*sizeof(float));
- Tlp = (float *)malloc(n1*sizeof(float));
- Tt1 = (float *)malloc(n1*sizeof(float));
- Tt2 = (float *)malloc(n1*sizeof(float));
-
- /* calculate vx for all grid points except on the virtual boundary*/
-#pragma omp for private (ix, iz) nowait schedule(guided,1)
- for (ix=mod.ioXx; ix<mod.ieXx; ix++) {
-#pragma ivdep
- for (iz=mod.ioXz; iz<mod.ieXz; iz++) {
- vx[ix*n1+iz] -= rox[ix*n1+iz]*(
- c1*(p[ix*n1+iz] - p[(ix-1)*n1+iz]) +
- c2*(p[(ix+1)*n1+iz] - p[(ix-2)*n1+iz]));
- }
- }
-
- /* calculate vz for all grid points except on the virtual boundary */
-#pragma omp for private (ix, iz) schedule(guided,1)
- for (ix=mod.ioZx; ix<mod.ieZx; ix++) {
-#pragma ivdep
- for (iz=mod.ioZz; iz<mod.ieZz; iz++) {
- vz[ix*n1+iz] -= roz[ix*n1+iz]*(
- c1*(p[ix*n1+iz] - p[ix*n1+iz-1]) +
- c2*(p[ix*n1+iz+1] - p[ix*n1+iz-2]));
- }
- }
-
- /* Add force source */
- if (src.type > 5) {
- applySource(mod, src, wav, bnd, itime, ixsrc, izsrc, vx, vz, p, NULL, NULL, rox, roz, l2m, src_nwav, verbose);
- }
-
- /* boundary condition clears velocities on boundaries */
- boundariesP(mod, bnd, vx, vz, p, NULL, NULL, rox, roz, l2m, NULL, NULL, itime, verbose);
-
- /* calculate p/tzz for all grid points except on the virtual boundary */
-#pragma omp for private (iz,ix, Tpp) nowait schedule(guided,1)
- for (ix=mod.ioPx; ix<mod.iePx; ix++) {
-#pragma ivdep
- for (iz=mod.ioPz; iz<mod.iePz; iz++) {
- dxvx[iz] = c1*(vx[(ix+1)*n1+iz] - vx[ix*n1+iz]) +
- c2*(vx[(ix+2)*n1+iz] - vx[(ix-1)*n1+iz]);
- }
-#pragma ivdep
- for (iz=mod.ioPz; iz<mod.iePz; iz++) {
- dzvz[iz] = c1*(vz[ix*n1+iz+1] - vz[ix*n1+iz]) +
- c2*(vz[ix*n1+iz+2] - vz[ix*n1+iz-1]);
- }
-
- /* help variables to let the compiler vectorize the loops */
-#pragma ivdep
- for (iz=mod.ioPz; iz<mod.iePz; iz++) {
- Tpp = tep[ix*n1+iz]*tss[ix*n1+iz];
- Tlm[iz] = (1.0-Tpp)*tss[ix*n1+iz]*l2m[ix*n1+iz]*0.5;
- Tlp[iz] = l2m[ix*n1+iz]*Tpp;
- }
-#pragma ivdep
- for (iz=mod.ioPz; iz<mod.iePz; iz++) {
- Tt1[iz] = 1.0/(ddt+0.5*tss[ix*n1+iz]);
- Tt2[iz] = ddt-0.5*tss[ix*n1+iz];
- }
-
- /* the update with the relaxation correction */
-#pragma ivdep
- for (iz=mod.ioPz; iz<mod.iePz; iz++) {
- p[ix*n1+iz] -= Tlp[iz]*(dzvz[iz]+dxvx[iz]) + q[ix*n1+iz];
- }
-#pragma ivdep
- for (iz=mod.ioPz; iz<mod.iePz; iz++) {
- q[ix*n1+iz] = (Tt2[iz]*q[ix*n1+iz] + Tlm[iz]*(dxvx[iz]+dzvz[iz]))*Tt1[iz];
- p[ix*n1+iz] -= q[ix*n1+iz];
- }
- }
-
- /* Add stress source */
- if (src.type < 6) {
- applySource(mod, src, wav, bnd, itime, ixsrc, izsrc, vx, vz, p, NULL, NULL, rox, roz, l2m, src_nwav, verbose);
- }
-
- /* check if there are sources placed on the free surface */
- storeSourceOnSurface(mod, src, bnd, ixsrc, izsrc, vx, vz, p, NULL, NULL, verbose);
-
- /* Free surface: calculate free surface conditions for stresses */
- boundariesV(mod, bnd, vx, vz, p, NULL, NULL, rox, roz, l2m, NULL, NULL, itime, verbose);
-
- /* restore source positions on the edge */
- reStoreSourceOnSurface(mod, src, bnd, ixsrc, izsrc, vx, vz, p, NULL, NULL, verbose);
-
- free(dxvx);
- free(dzvz);
- free(Tlm);
- free(Tlp);
- free(Tt1);
- free(Tt2);
-
- return 0;
-}
diff --git a/fdelmodc3D/viscoelastic4.c b/fdelmodc3D/viscoelastic4.c
deleted file mode 100644
index 865aa123eae8e88e73131934527af6b88da9cce7..0000000000000000000000000000000000000000
--- a/fdelmodc3D/viscoelastic4.c
+++ /dev/null
@@ -1,244 +0,0 @@
-#include<stdlib.h>
-#include<stdio.h>
-#include<math.h>
-#include<assert.h>
-#include"fdelmodc.h"
-
-#define MAX(x,y) ((x) > (y) ? (x) : (y))
-
-int applySource(modPar mod, srcPar src, wavPar wav, bndPar bnd, int itime, int ixsrc, int izsrc, float *vx, float *vz, float *tzz,
-float *txx, float *txz, float *rox, float *roz, float *l2m, float **src_nwav, int verbose);
-
-int storeSourceOnSurface(modPar mod, srcPar src, bndPar bnd, int ixsrc, int izsrc, float *vx, float *vz, float *tzz, float *txx, float *txz, int verbose);
-
-int reStoreSourceOnSurface(modPar mod, srcPar src, bndPar bnd, int ixsrc, int izsrc, float *vx, float *vz, float *tzz, float *txx, float *txz, int verbose);
-
-int boundariesP(modPar mod, bndPar bnd, float *vx, float *vz, float *tzz, float *txx, float *txz, float *rox, float *roz, float *l2m, float *lam, float *mul, int itime, int verbose);
-
-int boundariesV(modPar mod, bndPar bnd, float *vx, float *vz, float *tzz, float *txx, float *txz, float *rox, float *roz, float *l2m, float *lam, float *mul, int itime, int verbose);
-
-int viscoelastic4(modPar mod, srcPar src, wavPar wav, bndPar bnd, int itime, int ixsrc, int izsrc, float **src_nwav, float *vx, float *vz, float *tzz, float *txx, float *txz, float *rox, float *roz, float *l2m, float *lam, float *mul, float *tss, float *tep, float *tes, float *r, float *q, float *p, int verbose)
-{
-/*********************************************************************
- COMPUTATIONAL OVERVIEW OF THE 4th ORDER STAGGERED GRID:
-
- The captial symbols T (=Txx,Tzz) Txz,Vx,Vz represent the actual grid
- The indices ix,iz are related to the T grid, so the capital T
- symbols represent the actual modelled grid.
-
- one cel (iz,ix)
- |
- V extra column of vx,txz
- |
- ------- V
- | txz vz| txz vz txz vz txz vz txz vz txz vz txz
- | |
- | vx t | vx t vx t vx t vx t vx t vx
- -------
- txz vz txz vz txz vz txz vz txz vz txz vz txz
-
- vx t vx T---Vx--T---Vx--T---Vx--T vx t vx
- | | | | | | |
- txz vz txz Vz--Txz-Vz--Txz-Vz Txz-Vz txz vz txz
- | | | | | | |
- vx t vx T---Vx--T---Vx--T---Vx--T vx t vx
- | | | | | | |
- txz vz txz Vz Txz-Vz Txz-Vz Txz-Vz txz vz txz
- | | | | | | |
- vx t vx T---Vx--T---Vx--T---Vx--T vx t vx
- | | | | | | |
- txz vz txz Vz Txz-Vz Txz-Vz Txz-Vz txz vz txz
- | | | | | | |
- vx t vx T---Vx--T---Vx--T---Vx--T vx t vx
-
- txz vz txz vz txz vz txz vz txz vz txz vz txz
-
- vx t vx t vx t vx t vx t vx t vx
-
- txz vz txz vz txz vz txz vz txz vz txz vz txz <--|
- |
- extra row of txz/vz |
-
- Implementation as described in:
-
-Viscoelastic finite-difference modeling
-Johan 0. A. Robertsson, Joakim 0. Blanch, and William W. Symes
-GEOPHYSICS, VOL. 59, NO. 9 (SEPTEMBER 1994); P. 1444-1456
-
- AUTHOR:
- Jan Thorbecke (janth@xs4all.nl)
- The Netherlands
-
-***********************************************************************/
-
- float c1, c2;
- float ddt;
- float *dxvx, *dzvz, *dxvz, *dzvx;
- float *Tpp, *Tss, *Tmu, *Tlm, *Tlp, *Tus, *Tt1, *Tt2;
- int ix, iz;
- int n1;
-// int ioXx, ioXz, ioZz, ioZx, ioPx, ioPz, ioTx, ioTz;
-
-
- c1 = 9.0/8.0;
- c2 = -1.0/24.0;
- n1 = mod.naz;
- ddt = 1.0/mod.dt;
-
- dxvx = (float *)malloc(n1*sizeof(float));
- dzvz = (float *)malloc(n1*sizeof(float));
- dxvz = (float *)malloc(n1*sizeof(float));
- dzvx = (float *)malloc(n1*sizeof(float));
- Tpp = (float *)malloc(n1*sizeof(float));
- Tss = (float *)malloc(n1*sizeof(float));
- Tmu = (float *)malloc(n1*sizeof(float));
- Tlm = (float *)malloc(n1*sizeof(float));
- Tlp = (float *)malloc(n1*sizeof(float));
- Tus = (float *)malloc(n1*sizeof(float));
- Tt1 = (float *)malloc(n1*sizeof(float));
- Tt2 = (float *)malloc(n1*sizeof(float));
-
- /* Vx: rox */
-// ioXx=mod.iorder/2;
-// ioXz=ioXx-1;
- /* Vz: roz */
-// ioZz=mod.iorder/2;
-// ioZx=ioZz-1;
- /* P, Txx, Tzz: lam, l2m */
-// ioPx=mod.iorder/2-1;
-// ioPz=ioPx;
- /* Txz: muu */
-// ioTx=mod.iorder/2;
-// ioTz=ioTx;
-
- /* calculate vx for all grid points except on the virtual boundary*/
-#pragma omp for private (ix, iz) nowait schedule(guided,1)
- for (ix=mod.ioXx; ix<mod.ieXx; ix++) {
-#pragma ivdep
- for (iz=mod.ioXz; iz<mod.ieXz; iz++) {
- vx[ix*n1+iz] -= rox[ix*n1+iz]*(
- c1*(txx[ix*n1+iz] - txx[(ix-1)*n1+iz] +
- txz[ix*n1+iz+1] - txz[ix*n1+iz]) +
- c2*(txx[(ix+1)*n1+iz] - txx[(ix-2)*n1+iz] +
- txz[ix*n1+iz+2] - txz[ix*n1+iz-1]) );
- }
- }
-
- /* calculate vz for all grid points except on the virtual boundary */
-#pragma omp for private (ix, iz) schedule(guided,1)
- for (ix=mod.ioZx; ix<mod.ieZx; ix++) {
-#pragma ivdep
- for (iz=mod.ioZz; iz<mod.ieZz; iz++) {
- vz[ix*n1+iz] -= roz[ix*n1+iz]*(
- c1*(tzz[ix*n1+iz] - tzz[ix*n1+iz-1] +
- txz[(ix+1)*n1+iz] - txz[ix*n1+iz]) +
- c2*(tzz[ix*n1+iz+1] - tzz[ix*n1+iz-2] +
- txz[(ix+2)*n1+iz] - txz[(ix-1)*n1+iz]) );
- }
- }
-
- /* Add force source */
- if (src.type > 5) {
- applySource(mod, src, wav, bnd, itime, ixsrc, izsrc, vx, vz, tzz, txx, txz, rox, roz, l2m, src_nwav, verbose);
- }
-
- /* boundary condition clears velocities on boundaries */
- boundariesP(mod, bnd, vx, vz, tzz, txx, txz, rox, roz, l2m, lam, mul, itime, verbose);
-
- /* calculate Txx/Tzz for all grid points except on the virtual boundary */
-#pragma omp for private (ix, iz) nowait schedule(guided,1)
- for (ix=mod.ioPx; ix<mod.iePx; ix++) {
-#pragma ivdep
- for (iz=mod.ioPz; iz<mod.iePz; iz++) {
- dxvx[iz] = c1*(vx[(ix+1)*n1+iz] - vx[ix*n1+iz]) +
- c2*(vx[(ix+2)*n1+iz] - vx[(ix-1)*n1+iz]);
- }
-#pragma ivdep
- for (iz=mod.ioPz; iz<mod.iePz; iz++) {
- dzvz[iz] = c1*(vz[ix*n1+iz+1] - vz[ix*n1+iz]) +
- c2*(vz[ix*n1+iz+2] - vz[ix*n1+iz-1]);
- }
- /* help variables to let the compiler vectorize the loops */
-#pragma ivdep
- for (iz=mod.ioPz; iz<mod.iePz; iz++) {
- Tpp[iz] = tep[ix*n1+iz]*tss[ix*n1+iz];
- Tss[iz] = tes[ix*n1+iz]*tss[ix*n1+iz];
- Tmu[iz] = (1.0-Tss[iz])*tss[ix*n1+iz]*mul[ix*n1+iz];
- Tlm[iz] = (1.0-Tpp[iz])*tss[ix*n1+iz]*l2m[ix*n1+iz]*0.5;
- Tlp[iz] = l2m[ix*n1+iz]*Tpp[iz];
- Tus[iz] = mul[ix*n1+iz]*Tss[iz];
- }
-#pragma ivdep
- for (iz=mod.ioPz; iz<mod.iePz; iz++) {
- Tt1[iz] = 1.0/(ddt+0.5*tss[ix*n1+iz]);
- Tt2[iz] = ddt-0.5*tss[ix*n1+iz];
- }
-
- /* the update with the relaxation correction */
-#pragma ivdep
- for (iz=mod.ioPz; iz<mod.iePz; iz++) {
- txx[ix*n1+iz] -= Tlp[iz]*dxvx[iz] + (Tlp[iz]-2.0*Tus[iz])*dzvz[iz] + q[ix*n1+iz];
- tzz[ix*n1+iz] -= Tlp[iz]*dzvz[iz] + (Tlp[iz]-2.0*Tus[iz])*dxvx[iz] + p[ix*n1+iz];
- }
-#pragma ivdep
- for (iz=mod.ioPz; iz<mod.iePz; iz++) {
- q[ix*n1+iz] = (Tt2[iz]*q[ix*n1+iz] - Tmu[iz]*dzvz[iz] + Tlm[iz]*(dxvx[iz]+dzvz[iz]))*Tt1[iz];
- txx[ix*n1+iz] -= q[ix*n1+iz];
- }
-#pragma ivdep
- for (iz=mod.ioPz; iz<mod.iePz; iz++) {
- p[ix*n1+iz] = (Tt2[iz]*p[ix*n1+iz] - Tmu[iz]*dxvx[iz] + Tlm[iz]*(dxvx[iz]+dzvz[iz]))*Tt1[iz];
- tzz[ix*n1+iz] -= p[ix*n1+iz];
- }
-
- /* calculate Txz for all grid points except on the virtual boundary */
- if (ix >= mod.ioTx) {
-#pragma ivdep
- for (iz=mod.ioTz; iz<mod.ieTz; iz++) {
- dzvx[iz] = c1*(vx[ix*n1+iz] - vx[ix*n1+iz-1]) +
- c2*(vx[ix*n1+iz+1] - vx[ix*n1+iz-2]);
- }
-#pragma ivdep
- for (iz=mod.ioTz; iz<mod.ieTz; iz++) {
- dxvz[iz] = c1*(vz[ix*n1+iz] - vz[(ix-1)*n1+iz]) +
- c2*(vz[(ix+1)*n1+iz] - vz[(ix-2)*n1+iz]);
- }
-#pragma ivdep
- for (iz=mod.ioTz; iz<mod.ieTz; iz++) {
- txz[ix*n1+iz] -= Tus[iz]*(dzvx[iz]+dxvz[iz]) + r[ix*n1+iz];
- r[ix*n1+iz] = (Tt2[iz]*r[ix*n1+iz] + 0.5*Tmu[iz]*(dzvx[iz]+dxvz[iz]))*Tt1[iz];
- txz[ix*n1+iz] -= r[ix*n1+iz];
- }
- }
- }
-
- /* Add stress source */
- if (src.type < 6) {
- applySource(mod, src, wav, bnd, itime, ixsrc, izsrc, vx, vz, tzz, txx, txz, rox, roz, l2m, src_nwav, verbose);
- }
-
- /* check if there are sources placed on the free surface */
- storeSourceOnSurface(mod, src, bnd, ixsrc, izsrc, vx, vz, tzz, txx, txz, verbose);
-
- /* Free surface: calculate free surface conditions for stresses */
- boundariesV(mod, bnd, vx, vz, tzz, txx, txz, rox, roz, l2m, lam, mul, itime, verbose);
-
- /* restore source positions on the edge */
- reStoreSourceOnSurface(mod, src, bnd, ixsrc, izsrc, vx, vz, tzz, txx, txz, verbose);
-
- free(dxvx);
- free(dzvz);
- free(dzvx);
- free(dxvz);
- free(Tpp);
- free(Tss);
- free(Tmu);
- free(Tlm);
- free(Tlp);
- free(Tus);
- free(Tt1);
- free(Tt2);
-
- return 0;
-}
-
diff --git a/fdelmodc3D/writeRec.c b/fdelmodc3D/writeRec.c
deleted file mode 100644
index 982cc6bcdcaadd3eb0e515087ddef39f955d58d4..0000000000000000000000000000000000000000
--- a/fdelmodc3D/writeRec.c
+++ /dev/null
@@ -1,226 +0,0 @@
-#define _FILE_OFFSET_BITS 64
-#define _LARGEFILE_SOURCE
-#define _LARGEFILE64_SOURCE
-
-#include <assert.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <errno.h>
-#include <math.h>
-#include <string.h>
-#include "segy.h"
-#include "fdelmodc.h"
-#include <genfft.h>
-
-#ifndef COMPLEX
-typedef struct _complexStruct { /* complex number */
- float r,i;
-} complex;
-typedef struct _dcomplexStruct { /* complex number */
- double r,i;
-} dcomplex;
-#endif/* complex */
-
-/**
-* Writes the receiver array(s) to output file(s)
-*
-* AUTHOR:
-* Jan Thorbecke (janth@xs4all.nl)
-* The Netherlands
-**/
-
-FILE *fileOpen(char *file, char *ext, int append);
-int traceWrite(segy *hdr, float *data, int n, FILE *fp) ;
-void name_ext(char *filename, char *extension);
-void kxwdecomp(complex *rp, complex *rvz, complex *up, complex *down,
- int nkx, float dx, int nt, float dt, float fmin, float fmax,
- float cp, float rho, int vznorm, int verbose);
-
-
-#define MAX(x,y) ((x) > (y) ? (x) : (y))
-#define MIN(x,y) ((x) < (y) ? (x) : (y))
-#define NINT(x) ((int)((x)>0.0?(x)+0.5:(x)-0.5))
-
-int writeRec(recPar rec, modPar mod, bndPar bnd, wavPar wav, int ixsrc, int izsrc, int nsam, int ishot, int fileno,
- float *rec_vx, float *rec_vz, float *rec_txx, float *rec_tzz, float *rec_txz,
- float *rec_p, float *rec_pp, float *rec_ss, float *rec_udp, float *rec_udvz, int verbose)
-{
- FILE *fpvx, *fpvz, *fptxx, *fptzz, *fptxz, *fpp, *fppp, *fpss, *fpup, *fpdown;
- float *rec_up, *rec_down, *trace, *rec_vze, *rec_pe;
- float dx, dt, cp, rho, fmin, fmax;
- complex *crec_vz, *crec_p, *crec_up, *crec_dw;
- int irec, ntfft, nfreq, nkx, xorig, ix, iz, it, ibndx;
- int append, vznorm, sx;
- double ddt;
- char number[16], filename[1024];
- segy hdr;
-
- if (!rec.n) return 0;
- if (ishot) append=1;
- else append=0;
-
- /* if the total number of samples exceeds rec_ntsam then a new (numbered) file is opened */
- /* fileno has a non-zero value (from fdelmodc.c) if the number of samples exceeds rec_ntsam. */
- strcpy(filename, rec.file_rcv);
- if (fileno) {
- sprintf(number,"_%03d",fileno);
- name_ext(filename, number);
- }
-#ifdef MPI
- sx = (int)mod.x0+ixsrc*mod.dx;
- sprintf(number,"_%06d",sx);
- name_ext(filename, number);
-#endif
-
- if (verbose>2) vmess("Writing receiver data to file %s", filename);
- if (nsam != rec.nt && verbose) vmess("Number of samples written to last file = %d",nsam);
-
- memset(&hdr,0,TRCBYTES);
- ddt = (double)mod.dt;/* to avoid rounding in 32 bit precision */
- dt = (float)ddt*rec.skipdt;
- dx = (rec.x[1]-rec.x[0])*mod.dx;
- hdr.dt = (unsigned short)lround((((double)1.0e6*ddt*rec.skipdt)));
- hdr.scalco = -1000;
- hdr.scalel = -1000;
- hdr.sx = 1000*(mod.x0+ixsrc*mod.dx);
- hdr.sdepth = 1000*(mod.z0+izsrc*mod.dz);
- hdr.selev = (int)(-1000.0*(mod.z0+izsrc*mod.dz));
- hdr.fldr = ishot+1;
- hdr.trid = 1;
- hdr.ns = nsam;
- hdr.trwf = rec.n;
- hdr.ntr = rec.n;
- if (mod.grid_dir) { /* reverse time modeling */
- hdr.f1 = (-mod.nt+1)*mod.dt;
- }
- else {
- hdr.f1 = 0.0;
- }
- hdr.d1 = mod.dt*rec.skipdt;
- hdr.d2 = (rec.x[1]-rec.x[0])*mod.dx;
- hdr.f2 = mod.x0+rec.x[0]*mod.dx;
-
- if (rec.type.vx) fpvx = fileOpen(filename, "_rvx", append);
- if (rec.type.vz) fpvz = fileOpen(filename, "_rvz", append);
- if (rec.type.p) fpp = fileOpen(filename, "_rp", append);
- if (rec.type.txx) fptxx = fileOpen(filename, "_rtxx", append);
- if (rec.type.tzz) fptzz = fileOpen(filename, "_rtzz", append);
- if (rec.type.txz) fptxz = fileOpen(filename, "_rtxz", append);
- if (rec.type.pp) fppp = fileOpen(filename, "_rpp", append);
- if (rec.type.ss) fpss = fileOpen(filename, "_rss", append);
-
- /* decomposed wavefield */
- if (rec.type.ud && (mod.ischeme==1 || mod.ischeme==2) ) {
- fpup = fileOpen(filename, "_ru", append);
- fpdown = fileOpen(filename, "_rd", append);
- ntfft = optncr(nsam);
- nfreq = ntfft/2+1;
- fmin = 0.0;
- fmax = wav.fmax;
- nkx = optncc(2*mod.nax);
- ibndx = mod.ioPx;
- if (bnd.lef==4 || bnd.lef==2) ibndx += bnd.ntap;
- cp = rec.cp;
- rho = rec.rho;
- if (rec.type.ud==2) vznorm=1;
- else vznorm=0;
- if (verbose) vmess("Decomposition array at z=%.2f with cp=%.2f rho=%.2f", rec.zr[0]+mod.z0, cp, rho);
- rec_up = (float *)calloc(ntfft*nkx,sizeof(float));
- rec_down= (float *)calloc(ntfft*nkx,sizeof(float));
- crec_vz = (complex *)malloc(nfreq*nkx*sizeof(complex));
- crec_p = (complex *)malloc(nfreq*nkx*sizeof(complex));
- crec_up = (complex *)malloc(nfreq*nkx*sizeof(complex));
- crec_dw = (complex *)malloc(nfreq*nkx*sizeof(complex));
-
- rec_vze = rec_up;
- rec_pe = rec_down;
- /* copy input data into extended arrays with padded zeroes */
- for (ix=0; ix<mod.nax; ix++) {
- memcpy(&rec_vze[ix*ntfft],&rec_udvz[ix*rec.nt],nsam*sizeof(float));
- memcpy(&rec_pe[ix*ntfft], &rec_udp[ix*rec.nt], nsam*sizeof(float));
- }
-
- /* transform from t-x to kx-w */
- xorig = ixsrc+ibndx;
- xt2wkx(rec_vze, crec_vz, ntfft, nkx, ntfft, nkx, xorig);
- xt2wkx(rec_pe, crec_p, ntfft, nkx, ntfft, nkx, xorig);
-
- /* apply decomposition operators */
- kxwdecomp(crec_p, crec_vz, crec_up, crec_dw,
- nkx, mod.dx, nsam, dt, fmin, fmax, cp, rho, vznorm, verbose);
-
- /* transform back to t-x */
- wkx2xt(crec_up, rec_up, ntfft, nkx, nkx, ntfft, xorig);
- wkx2xt(crec_dw, rec_down, ntfft, nkx, nkx, ntfft, xorig);
-
- /* reduce array to rec.nt samples rec.n traces */
- for (irec=0; irec<rec.n; irec++) {
- ix = rec.x[irec]+ibndx;
- for (it=0; it<rec.nt; it++) {
- rec_up[irec*rec.nt+it] = rec_up[ix*ntfft+it];
- rec_down[irec*rec.nt+it] = rec_down[ix*ntfft+it];
- }
- }
- free(crec_vz);
- free(crec_p);
- free(crec_up);
- free(crec_dw);
- }
- if (rec.type.ud && (mod.ischeme==3 || mod.ischeme==4) ) {
- }
-
- for (irec=0; irec<rec.n; irec++) {
- hdr.tracf = irec+1;
- hdr.tracl = ishot*rec.n+irec+1;
- hdr.gx = 1000*(mod.x0+rec.x[irec]*mod.dx);
- hdr.offset = (rec.x[irec]-ixsrc)*mod.dx;
- hdr.gelev = (int)(-1000*(mod.z0+rec.z[irec]*mod.dz));
-
- if (rec.type.vx) {
- traceWrite( &hdr, &rec_vx[irec*rec.nt], nsam, fpvx) ;
- }
- if (rec.type.vz) {
- traceWrite( &hdr, &rec_vz[irec*rec.nt], nsam, fpvz) ;
- }
- if (rec.type.p) {
- traceWrite( &hdr, &rec_p[irec*rec.nt], nsam, fpp) ;
- }
- if (rec.type.txx) {
- traceWrite( &hdr, &rec_txx[irec*rec.nt], nsam, fptxx) ;
- }
- if (rec.type.tzz) {
- traceWrite( &hdr, &rec_tzz[irec*rec.nt], nsam, fptzz) ;
- }
- if (rec.type.txz) {
- traceWrite( &hdr, &rec_txz[irec*rec.nt], nsam, fptxz) ;
- }
- if (rec.type.pp) {
- traceWrite( &hdr, &rec_pp[irec*rec.nt], nsam, fppp) ;
- }
- if (rec.type.ss) {
- traceWrite( &hdr, &rec_ss[irec*rec.nt], nsam, fpss) ;
- }
- if (rec.type.ud && mod.ischeme==1) {
- traceWrite( &hdr, &rec_up[irec*rec.nt], nsam, fpup) ;
- traceWrite( &hdr, &rec_down[irec*rec.nt], nsam, fpdown) ;
- }
- }
-
- if (rec.type.vx) fclose(fpvx);
- if (rec.type.vz) fclose(fpvz);
- if (rec.type.p) fclose(fpp);
- if (rec.type.txx) fclose(fptxx);
- if (rec.type.tzz) fclose(fptzz);
- if (rec.type.txz) fclose(fptxz);
- if (rec.type.pp) fclose(fppp);
- if (rec.type.ss) fclose(fpss);
- if (rec.type.ud) {
- fclose(fpup);
- fclose(fpdown);
- free(rec_up);
- free(rec_down);
- }
-
- return 0;
-}
-
diff --git a/fdelmodc3D/writeRec3D.c b/fdelmodc3D/writeRec3D.c
index 4dd9cb4ff5debb11049f283506aac02d57946ea4..5dd707adf4cdf092651c2ad40511bbb4a214c881 100644
--- a/fdelmodc3D/writeRec3D.c
+++ b/fdelmodc3D/writeRec3D.c
@@ -41,9 +41,11 @@ void kxwdecomp(complex *rp, complex *rvz, complex *up, complex *down,
#define MIN(x,y) ((x) < (y) ? (x) : (y))
#define NINT(x) ((long)((x)>0.0?(x)+0.5:(x)-0.5))
-long writeRec3D(recPar rec, modPar mod, bndPar bnd, wavPar wav, long ixsrc, long iysrc, long izsrc, long nsam, long ishot, long fileno,
- float *rec_vx, float *rec_vy, float *rec_vz, float *rec_txx, float *rec_tyy, float *rec_tzz, float *rec_txz, float *rec_tyz, float *rec_txy,
- float *rec_p, float *rec_pp, float *rec_ss, float *rec_udp, float *rec_udvz, long verbose)
+long writeRec3D(recPar rec, modPar mod, bndPar bnd, wavPar wav,
+ long ixsrc, long iysrc, long izsrc, long nsam, long ishot, long fileno,
+ float *rec_vx, float *rec_vy, float *rec_vz, float *rec_txx, float *rec_tyy, float *rec_tzz,
+ float *rec_txz, float *rec_tyz, float *rec_txy,
+ float *rec_p, float *rec_pp, float *rec_ss, float *rec_udp, float *rec_udvz, long verbose)
{
FILE *fpvx, *fpvy, *fpvz, *fptxx, *fptyy, *fptzz, *fptxz, *fptyz, *fptxy, *fpp, *fppp, *fpss, *fpup, *fpdown;
float *rec_up, *rec_down, *trace, *rec_vze, *rec_pe;
diff --git a/fdelmodc3D/writeSnapTimes.c b/fdelmodc3D/writeSnapTimes.c
deleted file mode 100644
index dc05beae1f0fa8780899d6b06b0afbe20d9ec362..0000000000000000000000000000000000000000
--- a/fdelmodc3D/writeSnapTimes.c
+++ /dev/null
@@ -1,211 +0,0 @@
-#define _FILE_OFFSET_BITS 64
-#define _LARGEFILE_SOURCE
-#define _LARGEFILE64_SOURCE
-
-#define ISODD(n) ((n) & 01)
-
-#include <assert.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <errno.h>
-#include <math.h>
-#include <string.h>
-#include "par.h"
-#include "segy.h"
-#include "fdelmodc.h"
-
-/**
-* Writes gridded wavefield(s) at a desired time to output file(s)
-*
-* AUTHOR:
-* Jan Thorbecke (janth@xs4all.nl)
-* The Netherlands
-**/
-
-
-FILE *fileOpen(char *file, char *ext, int append);
-int traceWrite(segy *hdr, float *data, int n, FILE *fp);
-
-#define MAX(x,y) ((x) > (y) ? (x) : (y))
-#define MIN(x,y) ((x) < (y) ? (x) : (y))
-#define NINT(x) ((int)((x)>0.0?(x)+0.5:(x)-0.5))
-
-int writeSnapTimes(modPar mod, snaPar sna, bndPar bnd, wavPar wav, int ixsrc, int izsrc, int itime, float *vx, float *vz, float *tzz, float *txx, float *txz, int verbose)
-{
- FILE *fpvx, *fpvz, *fptxx, *fptzz, *fptxz, *fpp, *fppp, *fpss;
- int append, isnap;
- static int first=1;
- int n1, ibndx, ibndz, ixs, izs, ize, i, j;
- int ix, iz, ix2;
- float *snap, sdx, stime;
- segy hdr;
-
- if (sna.nsnap==0) return 0;
-
- ibndx = mod.ioXx;
- ibndz = mod.ioXz;
- n1 = mod.naz;
- sdx = 1.0/mod.dx;
-
- if (sna.withbnd) {
- sna.nz=mod.naz;
- sna.z1=0;
- sna.z2=mod.naz-1;
- sna.skipdz=1;
-
- sna.nx=mod.nax;
- sna.x1=0;
- sna.x2=mod.nax-1;
- sna.skipdx=1;
- }
-
- /* check if this itime is a desired snapshot time */
- if ( (((itime-sna.delay) % sna.skipdt)==0) &&
- (itime >= sna.delay) &&
- (itime <= sna.delay+(sna.nsnap-1)*sna.skipdt) ) {
-
- isnap = NINT((itime-sna.delay)/sna.skipdt);
-
- if (mod.grid_dir) stime = (-wav.nt+1+itime+1)*mod.dt; /* reverse time modeling */
- else stime = itime*mod.dt;
- if (verbose) vmess("Writing snapshot(%d) at time=%.4f", isnap+1, stime);
-
- if (first) {
- append=0;
- first=0;
- }
- else {
- append=1;
- }
-
- if (sna.type.vx) fpvx = fileOpen(sna.file_snap, "_svx", append);
- if (sna.type.vz) fpvz = fileOpen(sna.file_snap, "_svz", append);
- if (sna.type.p) fpp = fileOpen(sna.file_snap, "_sp", append);
- if (sna.type.txx) fptxx = fileOpen(sna.file_snap, "_stxx", append);
- if (sna.type.tzz) fptzz = fileOpen(sna.file_snap, "_stzz", append);
- if (sna.type.txz) fptxz = fileOpen(sna.file_snap, "_stxz", append);
- if (sna.type.pp) fppp = fileOpen(sna.file_snap, "_spp", append);
- if (sna.type.ss) fpss = fileOpen(sna.file_snap, "_sss", append);
-
- memset(&hdr,0,TRCBYTES);
- hdr.dt = 1000000*(sna.skipdt*mod.dt);
- hdr.ungpow = (sna.delay*mod.dt);
- hdr.scalco = -1000;
- hdr.scalel = -1000;
- hdr.sx = 1000*(mod.x0+ixsrc*mod.dx);
- hdr.sdepth = 1000*(mod.z0+izsrc*mod.dz);
- hdr.fldr = isnap+1;
- hdr.trid = 1;
- hdr.ns = sna.nz;
- hdr.trwf = sna.nx;
- hdr.ntr = (isnap+1)*sna.nx;
- hdr.f1 = sna.z1*mod.dz+mod.z0;
- hdr.f2 = sna.x1*mod.dx+mod.x0;
- hdr.d1 = mod.dz*sna.skipdz;
- hdr.d2 = mod.dx*sna.skipdx;
- if (sna.withbnd) {
- if ( !ISODD(bnd.top)) hdr.f1 = mod.z0 - bnd.ntap*mod.dz;
- if ( !ISODD(bnd.lef)) hdr.f2 = mod.x0 - bnd.ntap*mod.dx;
- //if ( !ISODD(bnd.rig)) ;
- //if ( !ISODD(bnd.bot)) store=1;
- }
-
-/***********************************************************************
-* vx velocities have one sample less in x-direction
-* vz velocities have one sample less in z-direction
-* txz stresses have one sample less in z-direction and x-direction
-***********************************************************************/
-
- snap = (float *)malloc(sna.nz*sizeof(float));
-
- /* Decimate, with skipdx and skipdz, the number of gridpoints written to file
- and write to file. */
- for (ixs=sna.x1, i=0; ixs<=sna.x2; ixs+=sna.skipdx, i++) {
- hdr.tracf = i+1;
- hdr.tracl = isnap*sna.nx+i+1;
- hdr.gx = 1000*(mod.x0+ixs*mod.dx);
- ix = ixs+ibndx;
- ix2 = ix+1;
-
- izs = sna.z1+ibndz;
- ize = sna.z2+ibndz;
-
- if (sna.withbnd) {
- izs = 0;
- ize = sna.z2;
- ix = ixs;
- ix2 = ix;
- if (sna.type.vz || sna.type.txz) izs = -1;
- if ( !ISODD(bnd.lef)) hdr.gx = 1000*(mod.x0 - bnd.ntap*mod.dx);
- }
-
- if (sna.type.vx) {
- for (iz=izs, j=0; iz<=ize; iz+=sna.skipdz, j++) {
- snap[j] = vx[ix2*n1+iz];
- }
- traceWrite(&hdr, snap, sna.nz, fpvx);
- }
- if (sna.type.vz) {
- for (iz=izs, j=0; iz<=ize; iz+=sna.skipdz, j++) {
- snap[j] = vz[ix*n1+iz+1];
- }
- traceWrite(&hdr, snap, sna.nz, fpvz);
- }
- if (sna.type.p) {
- for (iz=izs, j=0; iz<=ize; iz+=sna.skipdz, j++) {
- snap[j] = tzz[ix*n1+iz];
- }
- traceWrite(&hdr, snap, sna.nz, fpp);
- }
- if (sna.type.tzz) {
- for (iz=izs, j=0; iz<=ize; iz+=sna.skipdz, j++) {
- snap[j] = tzz[ix*n1+iz];
- }
- traceWrite(&hdr, snap, sna.nz, fptzz);
- }
- if (sna.type.txx) {
- for (iz=izs, j=0; iz<=ize; iz+=sna.skipdz, j++) {
- snap[j] = txx[ix*n1+iz];
- }
- traceWrite(&hdr, snap, sna.nz, fptxx);
- }
- if (sna.type.txz) {
- for (iz=izs, j=0; iz<=ize; iz+=sna.skipdz, j++) {
- snap[j] = txz[ix2*n1+iz+1];
- }
- traceWrite(&hdr, snap, sna.nz, fptxz);
- }
- /* calculate divergence of velocity field */
- if (sna.type.pp) {
- for (iz=izs, j=0; iz<=ize; iz+=sna.skipdz, j++) {
- snap[j] = sdx*((vx[(ix+1)*n1+iz]-vx[ix*n1+iz])+
- (vz[ix*n1+iz+1]-vz[ix*n1+iz]));
- }
- traceWrite(&hdr, snap, sna.nz, fppp);
- }
- /* calculate rotation of velocity field */
- if (sna.type.ss) {
- for (iz=izs, j=0; iz<=ize; iz+=sna.skipdz, j++) {
- snap[j] = sdx*((vx[ix*n1+iz]-vx[ix*n1+iz-1])-
- (vz[ix*n1+iz]-vz[(ix-1)*n1+iz]));
- }
- traceWrite(&hdr, snap, sna.nz, fpss);
- }
-
- }
-
- if (sna.type.vx) fclose(fpvx);
- if (sna.type.vz) fclose(fpvz);
- if (sna.type.p) fclose(fpp);
- if (sna.type.txx) fclose(fptxx);
- if (sna.type.tzz) fclose(fptzz);
- if (sna.type.txz) fclose(fptxz);
- if (sna.type.pp) fclose(fppp);
- if (sna.type.ss) fclose(fpss);
-
- free(snap);
- }
-
- return 0;
-}
-
diff --git a/fdelmodc3D/writeSnapTimes3D.c b/fdelmodc3D/writeSnapTimes3D.c
index 56c81f5bec79781651efa9a0aaad1bf1e93f86f2..0291a7ad38486c937934e80f15b7700fbfc1b2a1 100644
--- a/fdelmodc3D/writeSnapTimes3D.c
+++ b/fdelmodc3D/writeSnapTimes3D.c
@@ -30,7 +30,9 @@ int traceWrite(segy *hdr, float *data, int n, FILE *fp);
#define MIN(x,y) ((x) < (y) ? (x) : (y))
#define NINT(x) ((long)((x)>0.0?(x)+0.5:(x)-0.5))
-long writeSnapTimes3D(modPar mod, snaPar sna, bndPar bnd, wavPar wav, long ixsrc, long iysrc, long izsrc, long itime, float *vx, float *vy, float *vz, float *tzz, float *tyy, float *txx, float *txz, float *tyz, float *txy, long verbose)
+long writeSnapTimes3D(modPar mod, snaPar sna, bndPar bnd, wavPar wav,
+ long ixsrc, long iysrc, long izsrc, long itime, float *vx, float *vy, float *vz,
+ float *tzz, float *tyy, float *txx, float *txz, float *tyz, float *txy, long verbose)
{
FILE *fpvx, *fpvy, *fpvz, *fptxx, *fptyy, *fptzz, *fptxz, *fptyz, *fptxy, *fpp, *fppp, *fpss;
long append, isnap;
diff --git a/fdelmodc3D/writeSrcRecPos.c b/fdelmodc3D/writeSrcRecPos.c
deleted file mode 100644
index c9cec66adc9437f94da6ac05e36d672a14555b5f..0000000000000000000000000000000000000000
--- a/fdelmodc3D/writeSrcRecPos.c
+++ /dev/null
@@ -1,141 +0,0 @@
-#include<stdlib.h>
-#include<stdio.h>
-#include<math.h>
-#include<assert.h>
-#include"par.h"
-#include"fdelmodc.h"
-
-#define MAX(x,y) ((x) > (y) ? (x) : (y))
-#define MIN(x,y) ((x) < (y) ? (x) : (y))
-#define NINT(x) ((int)((x)>0.0?(x)+0.5:(x)-0.5))
-
-/**
-* Writes the source and receiver positions into a gridded file,
-* which has the same size as the input gridded model files.
-* Source positions have a value +1 and receivers -1.
-*
-* AUTHOR:
-* Jan Thorbecke (janth@xs4all.nl)
-* The Netherlands
-**/
-
-int writesufile(char *filename, float *data, int n1, int n2, float f1, float f2, float d1, float d2);
-
-int writeSrcRecPos(modPar *mod, recPar *rec, srcPar *src, shotPar *shot)
-{
- FILE *fp;
- float *dum, sub_x0, sub_z0, dx, dz;
- int is, nx, nz, is0, ish, ix, iz, ndot, idx, idz;
- char tmpname[1024];
-
- ndot = 2;
- nx = mod->nx;
- nz = mod->nz;
- dx = mod->dx;
- dz = mod->dz;
- sub_x0 = mod->x0;
- sub_z0 = mod->z0;
-
-// ibndx = mod.ioPx;
-// ibndz = mod.ioPz;
-// if (bnd.lef==4 || bnd.lef==2) ibndx += bnd.ntap;
-// if (bnd.top==4 || bnd.top==2) ibndz += bnd.ntap;
-
- /* write velocity field with positions of the sources */
- dum = (float *)calloc(nx*nz, sizeof(float));
- vmess("Positions: shot=%d src=%d rec=%d", shot->n, src->n, rec->n);
- /* source positions for random shots */
- if (src->random) {
- sprintf(tmpname,"SrcPositions%d.txt",src->n);
- fp = fopen(tmpname, "w+");
- for (is=0; is<src->n; is++) {
- for (idx=0; idx<=ndot; idx++) {
- for (idz=0; idz<=ndot; idz++) {
- dum[(MAX(0,src->x[is]-idx))*nz+MAX(0,src->z[is]-idz)] = 1.0;
- dum[(MAX(0,src->x[is]-idx))*nz+MIN(nz-1,src->z[is]+idz)] = 1.0;
- dum[(MIN(nx-1,src->x[is]+idx))*nz+MIN(nz-1,src->z[is]+idz)] = 1.0;
- dum[(MIN(nx-1,src->x[is]+idx))*nz+MAX(0,src->z[is]-idz)] = 1.0;
- }
- }
- fprintf(fp, "%f %f\n", src->z[is]*dz+sub_z0, src->x[is]*dx+sub_x0);
- }
- fclose(fp);
- }
- /* source positions for single shot sources with plane waves */
- else if (src->plane) {
- is0 = -1*floor((src->n-1)/2);
- sprintf(tmpname,"SrcPositions%d.txt",shot->n);
- fp = fopen(tmpname, "w+");
- for (ish=0; ish<shot->n; ish++) {
- for (is=0; is<src->n; is++) {
- ix = shot->x[ish] + 1 + is0 + is;
- iz = shot->z[ish] + 1;
- dum[ix*nz+iz] = 1.0;
- dum[(MAX(0,ix-1))*nz+iz] = 1.0;
- dum[(MIN(nx-1,ix+1))*nz+iz] = 1.0;
- dum[ix*nz+MAX(0,iz-1)] = 1.0;
- dum[ix*nz+MIN(nz-1,iz+1)] = 1.0;
- fprintf(fp, "(%f, %f)\n", ix*dx+sub_x0, iz*dz+sub_z0);
- }
- }
- fclose(fp);
- }
- else if (src->multiwav) {
- /* source positions for single shot sources with multiple wavelets */
- sprintf(tmpname,"SrcPositions%d.txt",shot->n);
- fp = fopen(tmpname, "w+");
- for (ish=0; ish<shot->n; ish++) {
- for (is=0; is<src->n; is++) {
- ix = src->x[is];
- iz = src->z[is];
- dum[ix*nz+iz] = 1.0;
- dum[(MAX(0,ix-1))*nz+iz] = 1.0;
- dum[(MIN(nx-1,ix+1))*nz+iz] = 1.0;
- dum[ix*nz+MAX(0,iz-1)] = 1.0;
- dum[ix*nz+MIN(nz-1,iz+1)] = 1.0;
- fprintf(fp, "(%f, %f)\n", ix*dx+sub_x0, iz*dz+sub_z0);
- }
- }
- fclose(fp);
- }
- else {
- sprintf(tmpname,"SrcPositions%d.txt",shot->n);
- fp = fopen(tmpname, "w+");
- for (is=0; is<shot->n; is++) {
- for (idx=0; idx<=ndot; idx++) {
- for (idz=0; idz<=ndot; idz++) {
- dum[(MAX(0,shot->x[is]-idx))*nz+MAX(0,shot->z[is]-idz)] = 1.0;
- dum[(MAX(0,shot->x[is]-idx))*nz+MIN(nz-1,shot->z[is]+idz)] = 1.0;
- dum[(MIN(nx-1,shot->x[is]+idx))*nz+MIN(nz-1,shot->z[is]+idz)] = 1.0;
- dum[(MIN(nx-1,shot->x[is]+idx))*nz+MAX(0,shot->z[is]-idz)] = 1.0;
- }
- }
- fprintf(fp, "%f %f\n", shot->z[is]*dz+sub_z0, shot->x[is]*dx+sub_x0);
- }
- fclose(fp);
- }
-
- /* receiver positions */
- sprintf(tmpname,"RcvPositions%d.txt",rec->n);
- fp = fopen(tmpname, "w+");
- for (is=0; is<rec->n; is++) {
- dum[rec->x[is]*nz+rec->z[is]] = -1.0;
- dum[(MAX(0,rec->x[is]-1))*nz+rec->z[is]] = -1.0;
- dum[(MIN(nx-1,rec->x[is]+1))*nz+rec->z[is]] = -1.0;
- dum[rec->x[is]*nz+MAX(0,rec->z[is]-1)] = -1.0;
- dum[rec->x[is]*nz+MIN(nz-1,rec->z[is]+1)] = -1.0;
-
-// vmess("receiver position %d at grid[ix=%d, iz=%d] = (x=%f z=%f)", ir, ix+ioPx, rec.z[ir]+ioPz, rec.xr[ir]+mod.x0, rec.zr[ir]+mod.z0);
- if (rec->int_vx==3) {
- fprintf(fp, "(%f, %f)\n", rec->xr[is]*dx+sub_x0, rec->zr[is]*dz+sub_z0);
- }
- else {
- fprintf(fp, "(%f, %f)\n", rec->x[is]*dx+sub_x0, rec->z[is]*dz+sub_z0);
- }
- }
- fclose(fp);
- writesufile("SrcRecPositions.su", dum, nz, nx, sub_z0, sub_x0, dz, dx);
- free(dum);
-
- return 0;
-}
diff --git a/fdelmodc3D/writeSrcRecPos3D.c b/fdelmodc3D/writeSrcRecPos3D.c
index 92b20b60344721b1895a36c7b0a85d4b38784312..582ecaa6a5cdc5123a67f4a5ac512755b75eac2d 100644
--- a/fdelmodc3D/writeSrcRecPos3D.c
+++ b/fdelmodc3D/writeSrcRecPos3D.c
@@ -19,7 +19,8 @@
* The Netherlands
**/
-long writesufile3D(char *filename, float *data, long n1, long n2, float f1, float f2, float d1, float d2);
+long writesufile3D(char *filename, float *data, long n1, long n2,
+ float f1, float f2, float d1, float d2);
long writeSrcRecPos3D(modPar *mod, recPar *rec, srcPar *src, shotPar *shot)
{
diff --git a/fdelmodc3D/writesufile.c b/fdelmodc3D/writesufile.c
index 71f7f3f7a5f2089c3990851bb19d60d7080c6d2f..51c4f96e18ce8121454ed698ec62918617282083 100644
--- a/fdelmodc3D/writesufile.c
+++ b/fdelmodc3D/writesufile.c
@@ -3,7 +3,7 @@
#include <assert.h>
#include <string.h>
#include "par.h"
-#include "fdelmodc.h"
+#include "fdelmodc3D.h"
#include "SUsegy.h"
#include "segy.h"
diff --git a/fdelmodc3D/writesufile3D.c b/fdelmodc3D/writesufile3D.c
index 6f2af263839aa33dc179bfe6c74763209a94d445..feb55b257ffccc4c0ecbb5d05fed5669801e96ef 100644
--- a/fdelmodc3D/writesufile3D.c
+++ b/fdelmodc3D/writesufile3D.c
@@ -22,7 +22,8 @@
#define ISODD(n) ((n) & 01)
#define NINT(x) ((long)((x)>0.0?(x)+0.5:(x)-0.5))
-long writesufile3D(char *filename, float *data, long n1, long n2, float f1, float f2, float d1, float d2)
+long writesufile3D(char *filename, float *data, long n1, long n2,
+ float f1, float f2, float d1, float d2)
{
FILE *file_out;
size_t nwrite, itrace;
@@ -70,7 +71,8 @@ long writesufile3D(char *filename, float *data, long n1, long n2, float f1, floa
*
**/
-long writesufilesrcnwav3D(char *filename, float **src_nwav, wavPar wav, long n1, long n2, float f1, float f2, float d1, float d2)
+long writesufilesrcnwav3D(char *filename, float **src_nwav, wavPar wav, long n1, long n2,
+ float f1, float f2, float d1, float d2)
{
FILE *file_out;
size_t nwrite, itrace;
diff --git a/marchenko3D/ampest3D.c b/marchenko3D/ampest3D.c
index d6c6984e8af602880f8234bd2ca60282c0d7a344..08b480b642ec861b4b0d6222e5ed238c6b7a1a17 100644
--- a/marchenko3D/ampest3D.c
+++ b/marchenko3D/ampest3D.c
@@ -22,43 +22,84 @@ void scl_data(float *data, long nsam, long nrec, float scl, float *datout, long
void pad_data(float *data, long nsam, long nrec, long nsamout, float *datout);
void corr(float *data1, float *data2, float *cov, long nrec, long nsam, float dt, long shift);
void convol(float *data1, float *data2, float *con, long nrec, long nsam, float dt, long shift);
-void deconv(float *data1, float *data2, float *decon, long nrec, long nsam,
- float dt, float eps, float reps, long shift);
void AmpEst3D(float *f1d, float *Gd, float *ampest, long Nfoc, long nxs, long nys, long ntfft, long *ixpos, long npos,
char *file_wav, float dx, float dy, float dt)
{
long l, i, ix, iw, nfreq;
- float scl, sclt, *f1dsamp;
- float dtm, dxm, cpm, rom, *trace, eps, reps;
+ float scl, sclt, *wavelet, *scaled, *conv, *f1dsamp;
+ float dtm, dxm, cpm, rom, *trace;
FILE *fp_wav;
segy *hdrs_wav;
- if(!getparfloat("eps", &eps)) eps=0.01;
- if(!getparfloat("reps", &reps)) reps=0.0;
-
scl = dx*dy;
sclt = 1.0*dt/((float)ntfft);
+ conv = (float *)calloc(nys*nxs*ntfft,sizeof(float));
+ wavelet = (float *)calloc(ntfft,sizeof(float));
+ scaled = (float *)calloc(ntfft,sizeof(float));
f1dsamp = (float *)calloc(nys*nxs*ntfft,sizeof(float));
+ if (file_wav!=NULL) {
+ trace = (float *)calloc(ntfft,sizeof(float));
+ hdrs_wav = (segy *)calloc(1, sizeof(segy));
+ fp_wav = fopen(file_wav, "r");
+ if (fp_wav==NULL) verr("error on opening wavelet file %s", file_wav);
+ readData3D(fp_wav, trace, hdrs_wav, 0);
+ fclose(fp_wav);
+ corr(trace, trace, wavelet, 1, ntfft, dt, 0);
+ free(hdrs_wav); free(trace);
+ /* For a monopole source the scaling is (2.0*dt*cp*cp*rho)/(dx*dx) */
+ for (iw=0; iw<ntfft; iw++){
+ wavelet[iw] *= dt;
+ }
+ }
+
for (l=0; l<Nfoc; l++) {
for (i=0; i<npos; i++) {
ix = ixpos[i];
- iw = 0;
- f1dsamp[i*ntfft+iw] = f1d[l*nxs*nys*ntfft+ix*ntfft+iw];
- for (iw=1; iw<ntfft; iw++) {
- f1dsamp[i*ntfft+iw] = f1d[l*nxs*nys*ntfft+ix*ntfft+ntfft-iw];
+ for (iw=0; iw<ntfft; iw++) {
+ f1dsamp[i*ntfft+iw] = f1d[l*nxs*nys*ntfft+ix*ntfft+iw];
+ }
+ }
+ if (file_wav==NULL){
+ corr(f1dsamp, f1dsamp, conv, nxs*nys, ntfft, dt, 0);
+ for (i=0; i<nxs*nys; i++) {
+ for (iw=0; iw<ntfft; iw++) {
+ wavelet[iw] += dt*scl*conv[i*ntfft+iw];
+ }
}
}
- deconv(&f1dsamp[0], &Gd[l*nxs*nys*ntfft], &est[l*nxs*nys*ntfft], nxs*nys, ntfft, dt, eps, reps, 0);
+ memset(&conv[0],0.0, sizeof(float)*ntfft*nxs*nys);
+ convol(f1dsamp, &Gd[l*nxs*nys*ntfft], conv, nxs*nys, ntfft, dt, 0);
+ for (i=0; i<nxs*nys; i++) {
+ for (iw=0; iw<ntfft; iw++) {
+ scaled[iw] += dt*scl*conv[i*ntfft+iw];
+ }
+ }
+ ampest[l] = sqrtf(wavelet[0]/scaled[0]);
+ memset(&conv[0],0.0, sizeof(float)*ntfft*nxs*nys);
+ memset(&scaled[0],0.0, sizeof(float)*ntfft);
}
- free(f1dsamp);
+ free(wavelet);free(scaled);free(conv);free(f1dsamp);
return;
}
+long maxest3D(float *data, long nt)
+{
+ float maxt;
+ long it;
+
+ maxt = data[0];
+ for (it = 0; it < nt; it++) {
+ if (fabs(data[it]) > fabs(maxt)) maxt=data[it];
+ }
+
+ return maxt;
+}
+
/**
* Calculates the time convolution of two arrays by
* transforming the arrayis to frequency domain,
@@ -254,112 +295,4 @@ void scl_data(float *data, long nsam, long nrec, float scl, float *datout, long
for (it = 0 ; it < nsamout ; it++)
datout[ix*nsamout+it] = scl*data[ix*nsam+it];
}
-}
-
-/**
-* Calculates the time deconvolution of two arrays by
-* transforming the arrayis to frequency domain,
-* divides the arrays and transform back to time.
-*
-**/
-
-void deconv(float *data1, float *data2, float *decon, long nrec, long nsam,
- float dt, float eps, float reps, long shift)
-{
- long i, j, n, optn, nfreq, sign;
- float df, dw, om, tau, *den, scl;
- float *qr, *qi, *p1r, *p1i, *p2r, *p2i, *rdata1, *rdata2, maxden, leps;
- complex *cdata1, *cdata2, *cdec, tmp;
-
- optn = loptncr(nsam);
- nfreq = optn/2+1;
-
- cdata1 = (complex *)malloc(nfreq*nrec*sizeof(complex));
- if (cdata1 == NULL) verr("memory allocation error for cdata1");
- cdata2 = (complex *)malloc(nfreq*nrec*sizeof(complex));
- if (cdata2 == NULL) verr("memory allocation error for cdata2");
- cdec = (complex *)malloc(nfreq*nrec*sizeof(complex));
- if (cdec == NULL) verr("memory allocation error for ccov");
-
- rdata1 = (float *)malloc(optn*nrec*sizeof(float));
- if (rdata1 == NULL) verr("memory allocation error for rdata1");
- rdata2 = (float *)malloc(optn*nrec*sizeof(float));
- if (rdata2 == NULL) verr("memory allocation error for rdata2");
- den = (float *)malloc(nfreq*nrec*sizeof(float));
- if (den == NULL) verr("memory allocation error for rdata1");
-
- /* pad zeroes until Fourier length is reached */
- pad_data(data1, nsam, nrec, optn, rdata1);
- pad_data(data2, nsam, nrec, optn, rdata2);
-
- /* forward time-frequency FFT */
- sign = -1;
- rcmfft(&rdata1[0], &cdata1[0], optn, nrec, optn, nfreq, sign);
- rcmfft(&rdata2[0], &cdata2[0], optn, nrec, optn, nfreq, sign);
-
- /* apply deconvolution */
- p1r = (float *) &cdata1[0];
- p2r = (float *) &cdata2[0];
- p1i = p1r + 1;
- p2i = p2r + 1;
- n = nrec*nfreq;
- maxden=0.0;
- for (j = 0; j < n; j++) {
- den[j] = *p2r**p2r + *p2i**p2i;
- maxden = MAX(den[j], maxden);
- p2r += 2;
- p2i += 2;
- }
- p1r = (float *) &cdata1[0];
- p2r = (float *) &cdata2[0];
- qr = (float *) &cdec[0].r;
- p1i = p1r + 1;
- p2i = p2r + 1;
- qi = qr + 1;
- leps = reps*maxden+eps;
- for (j = 0; j < n; j++) {
-
- if (fabs(*p2r)>=fabs(*p2i)) {
- *qr = (*p2r**p1r+*p2i**p1i)/(den[j]+leps);
- *qi = (*p2r**p1i-*p2i**p1r)/(den[j]+leps);
- } else {
- *qr = (*p1r**p2r+*p1i**p2i)/(den[j]+leps);
- *qi = (*p1i**p2r-*p1r**p2i)/(den[j]+leps);
- }
- qr += 2;
- qi += 2;
- p1r += 2;
- p1i += 2;
- p2r += 2;
- p2i += 2;
- }
- free(cdata1);
- free(cdata2);
- free(den);
-
- if (shift) {
- df = 1.0/(dt*optn);
- dw = 2*PI*df;
- tau = dt*(nsam/2);
- for (j = 0; j < nrec; j++) {
- om = 0.0;
- for (i = 0; i < nfreq; i++) {
- tmp.r = cdec[j*nfreq+i].r*cos(om*tau) + cdec[j*nfreq+i].i*sin(om*tau);
- tmp.i = cdec[j*nfreq+i].i*cos(om*tau) - cdec[j*nfreq+i].r*sin(om*tau);
- cdec[j*nfreq+i] = tmp;
- om += dw;
- }
- }
- }
-
- /* inverse frequency-time FFT and scale result */
- sign = 1;
- scl = 1.0/(float)optn;
- crmfft(&cdec[0], &rdata1[0], optn, nrec, nfreq, optn, sign);
- scl_data(rdata1,optn,nrec,scl,decon,nsam);
-
- free(cdec);
- free(rdata1);
- free(rdata2);
- return;
}
\ No newline at end of file
diff --git a/marchenko3D/marchenko3D.c b/marchenko3D/marchenko3D.c
index f1b615a9cbdc5d1429c53364ffe77e6761c0af9a..9c0c7b1310b1622feec1400afd840a017067e4a5 100644
--- a/marchenko3D/marchenko3D.c
+++ b/marchenko3D/marchenko3D.c
@@ -711,58 +711,51 @@ int main (int argc, char **argv)
/* Estimate the amplitude of the Marchenko Redatuming */
if (ampest>0) {
if (verbose>0) vmess("Estimating amplitude scaling");
- // Create the first arrival data
+
+ // Allocate memory and copy data
+ ampscl = (float *)calloc(Nfoc,sizeof(float));
Gd = (float *)calloc(Nfoc*nxs*nys*ntfft,sizeof(float));
memcpy(Gd,Gplus,sizeof(float)*Nfoc*nxs*nys*ntfft);
applyMute3D(Gd, muteW, smooth, 2, Nfoc, nxs*nys, nts, ixpos, npos, shift);
- // Determine the amplitude
- ampscl = (float *)calloc(nxs*nys*ntfft,sizeof(float));
- tmpdata = (float *)calloc(nxs*nys*ntfft,sizeof(float));
- // Scale all wavefields
+
+ // Determine amplitude and apply scaling
+ AmpEst3D(G_d,Gd,ampscl,Nfoc,nxs,nys,ntfft,ixpos,npos,file_wav,dxs,dys,dt);
for (l=0; l<Nfoc; l++) {
- AmpEst3D(&G_d[l*nxs*nys*ntfft],&Gd[l*nxs*nys*ntfft],ampscl,1,nxs,nys,ntfft,ixpos,npos,file_wav,dxs,dys,dt);
- for (j=0; j<nxs*nys*nts; j++) {
- tmpdata[j] = green[l*nxs*nys*nts+j];
- }
- convol(tmpdata, ampscl, &green[l*nxs*nys*nts], nxs*nys, ntfft, dt, 0);
- if (file_gplus != NULL) {
- for (j=0; j<nxs*nys*nts; j++) {
- tmpdata[j] = Gplus[l*nxs*nys*nts+j];
- }
- convol(tmpdata, ampscl, &Gplus[l*nxs*nys*nts], nxs*nys, ntfft, dt, 0);
- }
- if (file_gmin != NULL || file_imag!=NULL) {
- for (j=0; j<nxs*nys*nts; j++) {
- tmpdata[j] = Gmin[l*nxs*nys*nts+j];
+ for (j=0; j<nxs*nys*nts; j++) {
+ green[l*nxs*nts+j] *= ampscl[l];
+ if (file_gplus != NULL) Gplus[l*nxs*nys*nts+j] *= ampscl[l];
+ if (file_gmin != NULL) Gmin[l*nxs*nys*nts+j] *= ampscl[l];
+ if (file_f2 != NULL) f2p[l*nxs*nys*nts+j] *= ampscl[l];
+ if (file_pmin != NULL) pmin[l*nxs*nys*nts+j] *= ampscl[l];
+ if (file_f1plus != NULL) f1plus[l*nxs*nys*nts+j] *= ampscl[l];
+ if (file_f1min != NULL) f1min[l*nxs*nys*nts+j] *= ampscl[l];
+ }
+ if (verbose>1) vmess("Amplitude of focal position %li is equal to %.3e",l,ampscl[l]);
+ }
+
+ if (file_ampscl!=NULL) { //Write the estimation of the amplitude to file
+ hdrs_Nfoc = (segy *)calloc(nxim*nyim,sizeof(segy));
+ for (l=0; l<nyim; l++){
+ for (j=0; j<nxim; j++){
+ hdrs_Nfoc[l*nxim+j].ns = nzim;
+ hdrs_Nfoc[l*nxim+j].sx = xsyn[j];
+ hdrs_Nfoc[l*nxim+j].sy = ysyn[l];
+ hdrs_Nfoc[l*nxim+j].sdepth = zsyn[l];
+ hdrs_Nfoc[l*nxim+j].f1 = zsyn[0];
+ hdrs_Nfoc[l*nxim+j].d1 = zsyn[1]-zsyn[0];
+ hdrs_Nfoc[l*nxim+j].dt = (int)(hdrs_Nfoc[l*nxim+j].d1*(1E6));
+ hdrs_Nfoc[l*nxim+j].trwf = nxim*nyim;
}
- convol(tmpdata, ampscl, &Gmin[l*nxs*nys*nts], nxs*nys, ntfft, dt, 0);
}
- //if (verbose>4) vmess("Amplitude of focal position %li is equal to %.3e",l,ampscl[l]);
- }
- free(tmpdata);
- // if (file_ampscl!=NULL) { //Write the estimation of the amplitude to file
- // hdrs_Nfoc = (segy *)calloc(nxim*nyim,sizeof(segy));
- // for (l=0; l<nyim; l++){
- // for (j=0; j<nxim; j++){
- // hdrs_Nfoc[l*nxim+j].ns = nzim;
- // hdrs_Nfoc[l*nxim+j].sx = xsyn[j];
- // hdrs_Nfoc[l*nxim+j].sy = ysyn[l];
- // hdrs_Nfoc[l*nxim+j].sdepth = zsyn[l];
- // hdrs_Nfoc[l*nxim+j].f1 = zsyn[0];
- // hdrs_Nfoc[l*nxim+j].d1 = zsyn[1]-zsyn[0];
- // hdrs_Nfoc[l*nxim+j].dt = (int)(hdrs_Nfoc[l*nxim+j].d1*(1E6));
- // hdrs_Nfoc[l*nxim+j].trwf = nxim*nyim;
- // }
- // }
- // // Write the data
- // fp_amp = fopen(file_ampscl, "w+");
- // if (fp_amp==NULL) verr("error on creating output file %s", file_ampscl);
- // ret = writeData3D(fp_amp, (float *)&scl[0], hdrs_Nfoc, nzim, nxim*nyim);
- // if (ret < 0 ) verr("error on writing output file.");
- // fclose(fp_amp);
- // free(hdrs_Nfoc);
- // free(ampscl);
- // }
+ // Write the data
+ fp_amp = fopen(file_ampscl, "w+");
+ if (fp_amp==NULL) verr("error on creating output file %s", file_ampscl);
+ ret = writeData3D(fp_amp, (float *)&scl[0], hdrs_Nfoc, nzim, nxim*nyim);
+ if (ret < 0 ) verr("error on writing output file.");
+ fclose(fp_amp);
+ free(hdrs_Nfoc);
+ free(ampscl);
+ }
free(Gd);
if (file_gplus == NULL) free(Gplus);
}
diff --git a/utils/ampdet.c b/utils/ampdet.c
index d00a7c4265721cdb8deab4cf9285deb80df2a73c..c264e0120e6d76cbf0c6ebfa0ef8a337af2066d1 100644
--- a/utils/ampdet.c
+++ b/utils/ampdet.c
@@ -25,9 +25,6 @@ int getFileInfo(char *filename, int *n1, int *n2, int *ngath, float *d1, float *
int readData(FILE *fp, float *data, segy *hdrs, int n1);
int writeData(FILE *fp, float *data, segy *hdrs, int n1, int n2);
void complex_sqrt(complex *z);
-void deconv_small(complex *c1, complex *c2, complex *c3, float nkx, float nfreq, float reps, float eps);
-void conv_small(complex *c1, complex *c2, complex *c3, float nkx, float nfreq);
-void corr_small(complex *c1, complex *c2, complex *c3, float nkx, float nfreq);
void scl_data(float *data, int nsam, int nrec, float scl, float *datout, int nsamout);
void pad2d_data(float *data, int nsam, int nrec, int nsamout, int nrecout, float *datout);
void pad_data(float *data, int nsam, int nrec, int nsamout, float *datout);
@@ -50,18 +47,18 @@ int main (int argc, char **argv)
char *file_gp, *file_fp, *file_wav;
int nx, nt, ngath, ntraces, ret, size, nxwav;
int ntfft, nfreq, nxfft, nkx, i, j, n;
- float dx, dt, fx, ft, xmin, xmax, scl;
- float df, dw, dkx, eps, reps;
- float *Gpd, *f1pd, *G_pad, *f_pad, *wav, *wav_pad;
+ float dx, dt, fx, ft, xmin, xmax, scl, *den, dentmp;
+ float df, dw, dkx, eps, reps, leps, sclfk;
+ float *Gpd, *f1pd, *G_pad, *f_pad, *wav, *wav_pad, *outdata;
complex *G_w, *f_w, *Gf, *amp, *wav_w, *S, *ZS, *SS;
- segy *hdr_gp, *hdr_fp, *hdr_wav;
+ segy *hdr_gp, *hdr_fp, *hdr_wav, *hdr_out;
initargs(argc, argv);
requestdoc(1);
if(!getparstring("file_gp", &file_gp)) file_gp=NULL;
if (file_gp==NULL) verr("file %s does not exist",file_gp);
- if(!getparstring("file_gp", &file_fp)) file_fp=NULL;
+ if(!getparstring("file_fp", &file_fp)) file_fp=NULL;
if (file_fp==NULL) verr("file %s does not exist",file_fp);
if(!getparstring("file_wav", &file_wav)) file_wav=NULL;
if (file_wav==NULL) verr("file %s does not exist",file_wav);
@@ -93,7 +90,6 @@ int main (int argc, char **argv)
if (fp == NULL) verr("error on opening input file_in1=%s", file_fp);
nxwav = readData(fp, wav, hdr_wav, nt);
fclose(fp);
- vmess("test:%d",nxwav);
/* Start the scaling */
ntfft = optncr(nt);
@@ -102,66 +98,102 @@ int main (int argc, char **argv)
dw = 2.0*PI*df;
nkx = optncc(nx);
dkx = 2.0*PI/(nkx*dx);
+ sclfk = dt*(dt*dx)*(dt*dx);
- vmess("ntfft:%d, nfreq:%d, nkx:%d",ntfft,nfreq,nkx);
+ vmess("ntfft:%d, nfreq:%d, nkx:%d dx:%.3f dt:%.3f",ntfft,nfreq,nkx,dx,dt);
/* Allocate the arrays */
- G_pad = (float *)malloc(ntfft*nkx*sizeof(float));
+ G_pad = (float *)calloc(ntfft*nkx,sizeof(float));
if (G_pad == NULL) verr("memory allocation error for G_pad");
- f_pad = (float *)malloc(ntfft*nkx*sizeof(float));
+ f_pad = (float *)calloc(ntfft*nkx,sizeof(float));
if (f_pad == NULL) verr("memory allocation error for f_pad");
- wav_pad = (float *)malloc(ntfft*sizeof(float));
+ wav_pad = (float *)calloc(ntfft,sizeof(float));
if (wav_pad == NULL) verr("memory allocation error for wav_pad");
- G_w = (complex *)malloc(nfreq*nkx*sizeof(complex));
+ G_w = (complex *)calloc(nfreq*nkx,sizeof(complex));
if (G_w == NULL) verr("memory allocation error for G_w");
- f_w = (complex *)malloc(nfreq*nkx*sizeof(complex));
+ f_w = (complex *)calloc(nfreq*nkx,sizeof(complex));
if (f_w == NULL) verr("memory allocation error for f_w");
- Gf = (complex *)malloc(nfreq*nkx*sizeof(complex));
+ Gf = (complex *)calloc(nfreq*nkx,sizeof(complex));
if (Gf == NULL) verr("memory allocation error for Gf");
- wav_w = (complex *)malloc(nfreq*nkx*sizeof(complex));
+ wav_w = (complex *)calloc(nfreq*nkx,sizeof(complex));
if (wav_w == NULL) verr("memory allocation error for wav_w");
- amp = (complex *)malloc(nfreq*nkx*sizeof(complex));
+ amp = (complex *)calloc(nfreq*nkx,sizeof(complex));
if (amp == NULL) verr("memory allocation error for amp");
- S = (complex *)malloc(nfreq*nkx*sizeof(complex));
+ S = (complex *)calloc(nfreq*nkx,sizeof(complex));
if (S == NULL) verr("memory allocation error for S");
- ZS = (complex *)malloc(nfreq*nkx*sizeof(complex));
+ ZS = (complex *)calloc(nfreq*nkx,sizeof(complex));
if (ZS == NULL) verr("memory allocation error for ZS");
- SS = (complex *)malloc(nfreq*nkx*sizeof(complex));
+ SS = (complex *)calloc(nfreq*nkx,sizeof(complex));
if (SS == NULL) verr("memory allocation error for SS");
+ den = (float *)calloc(nfreq*nkx,sizeof(float));
+ if (den == NULL) verr("memory allocation error for den");
/* pad zeroes in 2 directions to reach FFT lengths */
pad2d_data(Gpd, nt,nx,ntfft,nkx,G_pad);
pad2d_data(f1pd,nt,nx,ntfft,nkx,f_pad);
- pad_data(wav, nt, 1, ntfft, wav_pad);
+ pad_data( wav, nt, 1,ntfft, wav_pad);
/* double forward FFT */
xt2wkx(&G_pad[0], &G_w[0], ntfft, nkx, ntfft, nkx, 0);
xt2wkx(&f_pad[0], &f_w[0], ntfft, nkx, ntfft, nkx, 0);
- rcmfft(&wav_pad[0], &wav_w[0], ntfft, 1, ntfft, nfreq, -1);
+ rcmfft(&wav_pad[0], &Gf[0], ntfft, 1, ntfft, nfreq, -1);
- for (i=1; i<nkx; i++) {
+ for (i=0; i<nkx; i++) {
for (j=0; j<nfreq; j++) {
- wav_w[i*nfreq+j] = wav_w[j];
- }
+ wav_w[j*nkx+i].r = Gf[j].r;
+ wav_w[j*nkx+i].i = Gf[j].i;
+ }
}
- /* Create Z*(|S|*)/(|S|*(|S|*)) */
- conv_small( G_w, f_w, Gf, nkx, nfreq); // Z
- corr_small( wav_w, wav_w, S, nkx, nfreq); //|S|
- corr_small( Gf, G_w, ZS, nkx, nfreq); // Z *(|S|*)
- corr_small( G_w, G_w, SS, nkx, nfreq); //|S|*(|S|*)
- deconv_small(ZS, SS, amp, nkx, nfreq, reps, eps); // amp
+ for (i = 0; i < nkx*nfreq; i++) {
+ Gf[i].r = (G_w[i].r*f_w[i].r - G_w[i].i*f_w[i].i);
+ Gf[i].i = (G_w[i].r*f_w[i].i + G_w[i].i*f_w[i].r);
- for (i=0; i<nkx*nfreq; i++) {
- complex_sqrt(&[i]);
- }
+ S[i].r = (wav_w[i].r*wav_w[i].r + wav_w[i].i*wav_w[i].i);
+ S[i].i = (wav_w[i].r*wav_w[i].i - wav_w[i].i*wav_w[i].r);
+
+ ZS[i].r = (Gf[i].r*S[i].r + Gf[i].i*S[i].i);
+ ZS[i].i = (Gf[i].r*S[i].i - Gf[i].i*S[i].r);
+
+ SS[i].r = (S[i].r*S[i].r + S[i].i*S[i].i);
+ SS[i].i = (S[i].r*S[i].i - S[i].i*S[i].r);
+
+ if (i==0) dentmp=SS[i].r;
+ else dentmp=MAX(dentmp,SS[i].r);
+ }
+
+ leps = reps*dentmp+eps;
+ vmess("dentmp:%.4e leps:%.4e",dentmp,leps);
+
+ for (i = 0; i < nkx*nfreq; i++) {
+ S[i].r = (ZS[i].r*SS[i].r+ZS[i].i*SS[i].i)/(SS[i].r*SS[i].r+SS[i].i*SS[i].i+leps);
+ S[i].i = (ZS[i].i*SS[i].r-ZS[i].r*SS[i].i)/(SS[i].r*SS[i].r+SS[i].i*SS[i].i+leps);
+
+ amp[i].r = sqrtf(S[i].r*S[i].r+S[i].i*S[i].i);
+ amp[i].i = 0.0;
+
+ // complex_sqrt(&[i]);
+ if (isnan(amp[i].r)) amp[i].r = 0;
+ if (isnan(amp[i].i)) amp[i].i = 0;
+ if (isinf(amp[i].r)) amp[i].r = 0;
+ if (isinf(amp[i].i)) amp[i].i = 0;
+
+ Gf[i].r = (G_w[i].r*amp[i].r - G_w[i].i*amp[i].i);
+ Gf[i].i = (G_w[i].r*amp[i].i + G_w[i].i*amp[i].r);
+ }
+
+ // for (i=0; i<nfreq; i++) {
+ // for (j=0; j<nkx; j++) {
+ // Gpd[j*nfreq+i] = sqrtf(amp[i*nkx+j].r*amp[i*nkx+j].r+amp[i*nkx+j].i*amp[i*nkx+j].i);
+ // }
+ // }
- conv_small(G_w, amp, Gf, nkx, nfreq); // Scaled data
+ // conv_small(G_w, amp, Gf, nkx, nfreq); // Scaled data
/* inverse double FFT */
wkx2xt(&Gf[0], &G_pad[0], ntfft, nkx, nkx, ntfft, 0);
/* select original samples and traces */
- scl = 1.0;
+ scl = (1.0)/(nkx*ntfft);
scl_data(G_pad,ntfft,nx,scl,Gpd ,nt);
fp = fopen("out.su", "w+");
@@ -169,110 +201,19 @@ int main (int argc, char **argv)
if (ret < 0 ) verr("error on writing output file.");
fclose(fp);
+ // fp = fopen("wav.su", "w+");
+ // for (j=0; j<nkx; j++) {
+ // hdr_gp[j].ns = nfreq;
+ // }
+ // ret = writeData(fp, Gpd, hdr_gp, nfreq, nkx);
+ // if (ret < 0 ) verr("error on writing output file.");
+ // fclose(fp);
+
free(f1pd);free(Gpd);free(hdr_gp);free(hdr_fp);
return 0;
}
-void conv_small(complex *c1, complex *c2, complex *c3, float nkx, float nfreq)
-{
-
- float *qr, *qi, *p1r, *p1i, *p2r, *p2i;
- int n, j;
-
- /* apply convolution */
- p1r = (float *) &c1[0];
- p2r = (float *) &c2[0];
- qr = (float *) &c3[0].r;
- p1i = p1r + 1;
- p2i = p2r + 1;
- qi = qr + 1;
- n = nkx*nfreq;
- for (j = 0; j < n; j++) {
- *qr = (*p2r**p1r - *p2i**p1i);
- *qi = (*p2r**p1i + *p2i**p1r);
- qr += 2;
- qi += 2;
- p1r += 2;
- p1i += 2;
- p2r += 2;
- p2i += 2;
- }
-}
-
-void corr_small(complex *c1, complex *c2, complex *c3, float nkx, float nfreq)
-{
-
- float *qr, *qi, *p1r, *p1i, *p2r, *p2i;
- int n, j;
-
- /* apply convolution */
- p1r = (float *) &c1[0];
- p2r = (float *) &c2[0];
- qr = (float *) &c3[0].r;
- p1i = p1r + 1;
- p2i = p2r + 1;
- qi = qr + 1;
- n = nkx*nfreq;
- for (j = 0; j < n; j++) {
- *qr = (*p2r**p1r + *p2i**p1i);
- *qi = (*p2r**p1i - *p2i**p1r);
- qr += 2;
- qi += 2;
- p1r += 2;
- p1i += 2;
- p2r += 2;
- p2i += 2;
- }
-}
-
-void deconv_small(complex *c1, complex *c2, complex *c3, float nkx, float nfreq, float reps, float eps)
-{
-
- float *qr, *qi, *p1r, *p1i, *p2r, *p2i, maxden, *den, leps;
- int n, j;
-
- den = (float *)malloc(nfreq*nkx*sizeof(float));
- if (den == NULL) verr("memory allocation error for den");
-
- /* apply deconvolution */
- p1r = (float *) &c1[0];
- p2r = (float *) &c2[0];
- p1i = p1r + 1;
- p2i = p2r + 1;
- n = nkx*nfreq;
- maxden=0.0;
- for (j = 0; j < n; j++) {
- den[j] = *p2r**p2r + *p2i**p2i;
- maxden = MAX(den[j], maxden);
- p2r += 2;
- p2i += 2;
- }
- p1r = (float *) &c1[0];
- p2r = (float *) &c2[0];
- qr = (float *) &c3[0].r;
- p1i = p1r + 1;
- p2i = p2r + 1;
- qi = qr + 1;
- leps = reps*maxden+eps;
- for (j = 0; j < n; j++) {
-
- if (fabs(*p2r)>=fabs(*p2i)) {
- *qr = (*p2r**p1r+*p2i**p1i)/(den[j]+leps);
- *qi = (*p2r**p1i-*p2i**p1r)/(den[j]+leps);
- } else {
- *qr = (*p1r**p2r+*p1i**p2i)/(den[j]+leps);
- *qi = (*p1i**p2r-*p1r**p2i)/(den[j]+leps);
- }
- qr += 2;
- qi += 2;
- p1r += 2;
- p1i += 2;
- p2r += 2;
- p2i += 2;
- }
-}
-
void complex_sqrt(complex *z)
{
float zmod, zmodr, zzmr, zzmi, zzm;