diff --git a/.gitignore b/.gitignore
index a0caee250f5bbd368528285a1171eea3b070906c..c3ba6facbcab7a47d2251f83fbd6d0672fd6eb5a 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,4 +1,5 @@
*.[oa]
+*.eps
bin/*
*.su
*.bin
@@ -20,6 +21,7 @@ utils/makemod
utils/makewave
utils/mat2su
utils/syn2d
+utils/green3D
fdelmodc/fdelmodc
include/genfft.h
Make_include
@@ -29,3 +31,18 @@ marchenko_full/fmute
marchenko_full/marchenko
corrvir/corrvir
fdemmodc/fdemmodc
+FFTlib/test/cc1test
+FFTlib/test/cc2dtest
+FFTlib/test/ccmtest
+FFTlib/test/rc1test
+FFTlib/test/rc2dtest
+FFTlib/test/rcmtest
+marchenko_applications/HomG
+marchenko_applications/MuteSnap
+marchenko_applications/combine
+marchenko_applications/gmshift
+marchenko_applications/iba
+marchenko_applications/marchenko_app
+marchenko_applications/reshape_su
+raytime3d/raytime3d
+MDD/mdd
diff --git a/FFTlib/cc1fft.c b/FFTlib/cc1fft.c
index d4658464b5aff9d2af055655c411293f4c768ab9..5367191b0f9c0a0ea49460e9ace61f63520ee321 100644
--- a/FFTlib/cc1fft.c
+++ b/FFTlib/cc1fft.c
@@ -1,4 +1,8 @@
#include "genfft.h"
+#ifdef MKL
+#include "mkl_dfti.h"
+void dfti_status_print(MKL_LONG status);
+#endif
/**
* NAME: cc1fft
@@ -56,6 +60,10 @@ void cc1fft(complex *data, int n, int sign)
static complex *work;
REAL scl;
complex *y;
+#elif defined(MKL)
+ static DFTI_DESCRIPTOR_HANDLE handle=0;
+ static int nprev=0;
+ MKL_LONG Status;
#endif
#if defined(HAVE_LIBSCS)
@@ -90,6 +98,28 @@ void cc1fft(complex *data, int n, int sign)
nprev = n;
}
acmlcc1fft(sign, scl, inpl, n, data, 1, y, 1, work, &isys);
+#elif defined(MKL)
+ if (n != nprev) {
+ DftiFreeDescriptor(&handle);
+
+ Status = DftiCreateDescriptor(&handle, DFTI_SINGLE, DFTI_COMPLEX, 1, (MKL_LONG)n);
+ if(! DftiErrorClass(Status, DFTI_NO_ERROR)){
+ dfti_status_print(Status);
+ printf(" DftiCreateDescriptor FAIL\n");
+ }
+ Status = DftiCommitDescriptor(handle);
+ if(! DftiErrorClass(Status, DFTI_NO_ERROR)){
+ dfti_status_print(Status);
+ printf(" DftiCommitDescriptor FAIL\n");
+ }
+ nprev = n;
+ }
+ if (sign < 0) {
+ Status = DftiComputeBackward(handle, data);
+ }
+ else {
+ Status = DftiComputeForward(handle, data);
+ }
#else
cc1_fft(data, n, sign);
#endif
diff --git a/FFTlib/cc2dfft.c b/FFTlib/cc2dfft.c
index d65fc26d6ca5a3d720c68df39cf28ad632b985dd..8ccd2775793d9f5e3c2d060a81994f6560bd8040 100644
--- a/FFTlib/cc2dfft.c
+++ b/FFTlib/cc2dfft.c
@@ -1,4 +1,8 @@
#include "genfft.h"
+#ifdef MKL
+#include "mkl_dfti.h"
+void dfti_status_print(MKL_LONG status);
+#endif
/**
* NAME: cc2dfft
@@ -60,6 +64,10 @@ void cc2dfft(complex *data, int nx, int ny, int ldx, int sign)
REAL scl;
complex *y;
complex *tmp;
+#elif defined(MKL)
+ static DFTI_DESCRIPTOR_HANDLE handle=0;
+ static int nxprev=0, nyprev=0;
+ MKL_LONG Status, N[2];
#else
int i, j;
complex *tmp;
@@ -110,6 +118,30 @@ void cc2dfft(complex *data, int nx, int ny, int ldx, int sign)
else {
cc1fft(data, nx, sign);
}
+#elif defined(MKL)
+ if (nx != nxprev || ny != nyprev) {
+ DftiFreeDescriptor(&handle);
+
+ N[0] = nx; N[1] = ny;
+ Status = DftiCreateDescriptor(&handle, DFTI_SINGLE, DFTI_COMPLEX, 2, N);
+ if(! DftiErrorClass(Status, DFTI_NO_ERROR)){
+ dfti_status_print(Status);
+ printf(" DftiCreateDescriptor FAIL\n");
+ }
+ Status = DftiCommitDescriptor(handle);
+ if(! DftiErrorClass(Status, DFTI_NO_ERROR)){
+ dfti_status_print(Status);
+ printf(" DftiCommitDescriptor FAIL\n");
+ }
+ nxprev = nx;
+ nyprev = ny;
+ }
+ if (sign < 0) {
+ Status = DftiComputeBackward(handle, data);
+ }
+ else {
+ Status = DftiComputeForward(handle, data);
+ }
#else
if (ny != 1) {
ccmfft(data, nx, ny, ldx, sign);
diff --git a/FFTlib/ccmfft.c b/FFTlib/ccmfft.c
index 9c8623506304cb4bb9bb02858e1bdf52adb2717a..cca95cba96ed969a67eaa42f58ab1b359063abc8 100644
--- a/FFTlib/ccmfft.c
+++ b/FFTlib/ccmfft.c
@@ -1,4 +1,8 @@
#include "genfft.h"
+#ifdef MKL
+#include "mkl_dfti.h"
+void dfti_status_print(MKL_LONG status);
+#endif
/**
* NAME: ccmfft
@@ -59,6 +63,11 @@ void ccmfft(complex *data, int n1, int n2, int ld1, int sign)
static complex *work;
REAL scl;
complex *y;
+#elif defined(MKL)
+ static DFTI_DESCRIPTOR_HANDLE handle=0;
+ static int nprev=0;
+ MKL_LONG Status;
+ int j;
#endif
#if defined(HAVE_LIBSCS)
@@ -89,6 +98,32 @@ void ccmfft(complex *data, int n1, int n2, int ld1, int sign)
nprev = n1;
}
acmlccmfft(sign, scl, inpl, n2, n1, data, 1, ld1, y, 1, ld1, work, &isys);
+#elif defined(MKL)
+ if (n1 != nprev) {
+ DftiFreeDescriptor(&handle);
+
+ Status = DftiCreateDescriptor(&handle, DFTI_SINGLE, DFTI_COMPLEX, 1, (MKL_LONG)n1);
+ if(! DftiErrorClass(Status, DFTI_NO_ERROR)){
+ dfti_status_print(Status);
+ printf(" DftiCreateDescriptor FAIL\n");
+ }
+ Status = DftiCommitDescriptor(handle);
+ if(! DftiErrorClass(Status, DFTI_NO_ERROR)){
+ dfti_status_print(Status);
+ printf(" DftiCommitDescriptor FAIL\n");
+ }
+ nprev = n1;
+ }
+ if (sign < 0) {
+ for (j=0; j<n2; j++) {
+ Status = DftiComputeBackward(handle, &data[j*ld1]);
+ }
+ }
+ else {
+ for (j=0; j<n2; j++) {
+ Status = DftiComputeForward(handle, &data[j*ld1]);
+ }
+ }
#else
ccm_fft(data, n1, n2, ld1, sign);
#endif
diff --git a/FFTlib/cr1fft.c b/FFTlib/cr1fft.c
index 9aebffad8c00c1ff4d481005b5def42776edb5b8..67b8f67839bb4098e83c6224ed5603383a9c1b40 100644
--- a/FFTlib/cr1fft.c
+++ b/FFTlib/cr1fft.c
@@ -1,4 +1,8 @@
#include "genfft.h"
+#ifdef MKL
+#include "mkl_dfti.h"
+void dfti_status_print(MKL_LONG status);
+#endif
/**
* NAME: cr1fft
@@ -52,10 +56,12 @@ void cr1fft(complex *cdata, REAL *rdata, int n, int sign)
static int isys;
static REAL *work, *table, scale=1.0;
REAL scl;
-#elif defined(FFTW3)
- static int nprev=0;
- int iopt, ier;
- static float *work;
+#elif defined(MKL)
+ static DFTI_DESCRIPTOR_HANDLE handle=0;
+ static int nprev=0;
+ REAL *tmp;
+ MKL_LONG Status;
+ int i;
#endif
#if defined(HAVE_LIBSCS)
@@ -91,6 +97,47 @@ void cr1fft(complex *cdata, REAL *rdata, int n, int sign)
nprev = n;
}
acmlcrfft(one, n, rdata, work, &isys);
+#elif defined(MKL)
+ if (n != nprev) {
+ DftiFreeDescriptor(&handle);
+
+ Status = DftiCreateDescriptor(&handle, DFTI_SINGLE, DFTI_REAL, 1, (MKL_LONG)n);
+ if(! DftiErrorClass(Status, DFTI_NO_ERROR)){
+ dfti_status_print(Status);
+ printf(" DftiCreateDescriptor FAIL\n");
+ }
+ Status = DftiSetValue(handle, DFTI_PLACEMENT, DFTI_NOT_INPLACE);
+ if(! DftiErrorClass(Status, DFTI_NO_ERROR)){
+ dfti_status_print(Status);
+ printf(" DftiSetValue FAIL\n");
+ }
+
+ Status = DftiSetValue(handle, DFTI_CONJUGATE_EVEN_STORAGE, DFTI_COMPLEX_COMPLEX);
+ if (! DftiErrorClass(Status, DFTI_NO_ERROR)) {
+ dfti_status_print(Status);
+ printf(" DftiSetValue FAIL\n");
+ }
+ Status = DftiCommitDescriptor(handle);
+ if(! DftiErrorClass(Status, DFTI_NO_ERROR)){
+ dfti_status_print(Status);
+ printf(" DftiCommitDescriptor FAIL\n");
+ }
+ nprev = n;
+ }
+ tmp = (float *)malloc(n*sizeof(float));
+ Status = DftiComputeBackward(handle, (MKL_Complex8 *)cdata, tmp);
+ if(! DftiErrorClass(Status, DFTI_NO_ERROR)){
+ dfti_status_print(Status);
+ printf(" DftiComputeBackward FAIL\n");
+ }
+ rdata[0] = tmp[0];
+ if (sign < 0) {
+ for (i=1; i<n; i++) rdata[i] = -sign*tmp[n-i];
+ }
+ else {
+ for (i=1; i<n; i++) rdata[i] = tmp[i];
+ }
+ free(tmp);
#else
cr1_fft(cdata, rdata, n, sign);
#endif
diff --git a/FFTlib/crmfft.c b/FFTlib/crmfft.c
index b1ca8904ca966a6d40ff29020e4b10d687ae103a..a9d4d64ea3d9535cc937104f16222da65adf81e8 100644
--- a/FFTlib/crmfft.c
+++ b/FFTlib/crmfft.c
@@ -1,5 +1,9 @@
#include "genfft.h"
#include <string.h>
+#ifdef MKL
+#include "mkl_dfti.h"
+void dfti_status_print(MKL_LONG status);
+#endif
/**
* NAME: crmfft
@@ -66,6 +70,12 @@ void crmfft(complex *cdata, REAL *rdata, int n1, int n2, int ldc, int ldr, int s
static int isys;
static REAL *work;
REAL scl, *data;
+#elif defined(MKL)
+ static DFTI_DESCRIPTOR_HANDLE handle=0;
+ static int nprev=0;
+ REAL *tmp;
+ MKL_LONG Status;
+ int i, j;
#endif
#if defined(HAVE_LIBSCS)
@@ -127,6 +137,51 @@ void crmfft(complex *cdata, REAL *rdata, int n1, int n2, int ldc, int ldr, int s
for (j=0; j<n2; j++) {
memcpy(&rdata[j*ldr],&data[j*n1],n1*sizeof(REAL));
}
+#elif defined(MKL)
+ if (n1 != nprev) {
+ DftiFreeDescriptor(&handle);
+
+ Status = DftiCreateDescriptor(&handle, DFTI_SINGLE, DFTI_REAL, 1, (MKL_LONG)n1);
+ if(! DftiErrorClass(Status, DFTI_NO_ERROR)){
+ dfti_status_print(Status);
+ printf(" DftiCreateDescriptor FAIL\n");
+ }
+ Status = DftiSetValue(handle, DFTI_PLACEMENT, DFTI_NOT_INPLACE);
+ if(! DftiErrorClass(Status, DFTI_NO_ERROR)){
+ dfti_status_print(Status);
+ printf(" DftiSetValue FAIL\n");
+ }
+
+ Status = DftiSetValue(handle, DFTI_CONJUGATE_EVEN_STORAGE, DFTI_COMPLEX_COMPLEX);
+ //This options is what we would like, but is depreciated in the future
+ //Status = DftiSetValue(handle, DFTI_CONJUGATE_EVEN_STORAGE, DFTI_COMPLEX_REAL);
+ if (! DftiErrorClass(Status, DFTI_NO_ERROR)) {
+ dfti_status_print(Status);
+ printf(" DftiSetValue FAIL\n");
+ }
+ Status = DftiCommitDescriptor(handle);
+ if(! DftiErrorClass(Status, DFTI_NO_ERROR)){
+ dfti_status_print(Status);
+ printf(" DftiCommitDescriptor FAIL\n");
+ }
+ nprev = n1;
+ }
+ tmp = (float *)malloc(n1*sizeof(float));
+ for (j=0; j<n2; j++) {
+ Status = DftiComputeBackward(handle, (MKL_Complex8 *)&cdata[j*ldc], tmp);
+ rdata[j*ldr] = tmp[0];
+ if (sign < 0) {
+ for (i=1; i<n1; i++) rdata[j*ldr+i] = -sign*tmp[n1-i];
+ }
+ else {
+ for (i=1; i<n1; i++) rdata[j*ldr+i] = tmp[i];
+ }
+ }
+ free(tmp);
+ if(! DftiErrorClass(Status, DFTI_NO_ERROR)){
+ dfti_status_print(Status);
+ printf(" DftiComputeBackward FAIL\n");
+ }
#else
crm_fft(cdata, rdata, n1, n2, ldc, ldr, sign);
#endif
diff --git a/FFTlib/genfft.h b/FFTlib/genfft.h
index fbef0291f14755a9e871f03f4ed181bf3f2cd10d..4c7ccc6e9a5a5bdc2e2486e870d5a038a3bae778 100644
--- a/FFTlib/genfft.h
+++ b/FFTlib/genfft.h
@@ -79,6 +79,7 @@ extern "C" {
int optncc(int n);
int optncr(int n);
+long loptncr(long n);
void cc1fft(complex *data, int n, int sign);
void ccmfft(complex *data, int n1, int n2, int ld1, int sign);
diff --git a/FFTlib/optnumber.c b/FFTlib/optnumber.c
index bd903b695378a4c706c1a26ca593c8e2f378932e..510ae6ae031e2c30569537c9436b6ea850ed219b 100644
--- a/FFTlib/optnumber.c
+++ b/FFTlib/optnumber.c
@@ -2,6 +2,7 @@
#ifdef SGI
#include "sgintab.h"
int optnfft(int n);
+long loptnfft(long n);
#endif
#if defined(CRAY_MPP_64)
@@ -89,6 +90,45 @@ int optnfft(int n)
}
#endif
+long loptncr(long n)
+{
+
+#ifdef SGI
+ return loptnfft(n);
+#else
+ long n2, n3;
+
+ n2 = pow(2.0, 1.0*(long)(log((float)n)/log(2.0)+0.9999));
+ if (n2 != n) {
+ n3 = npfar(n);
+ if((n3-n) < (n2-n)) return npfar(n);
+ else return n2;
+ }
+ else return n;
+#endif
+}
+
+
+#ifdef SGI
+long loptnfft(long n)
+{
+ long i,j, nmax;
+
+ if (n > NTAB+3) {
+ i=13;
+ nmax=NTAB+3;
+ while (nmax < n) { nmax=(long)pow(2.0,(double)++i); }
+ return nmax;
+ }
+
+ nmax = NTAB;
+ for (i=0; i<NTAB-1 && ntab[i].n<n; ++i);
+ for (j=i+1; j<NTAB-1 && ntab[j].n<=n+nmax; ++j)
+ if (ntab[j].c<ntab[i].c) i = j;
+ return ntab[i].n;
+}
+#endif
+
#if defined(CRAY_MPP_64)
int factorized(int n)
{
diff --git a/FFTlib/rc1fft.c b/FFTlib/rc1fft.c
index efddc3a73b32cec99cd76214f0502a539e30d89e..fa7386d7936e35dbdcf2b0f08038b58e3e5be57f 100644
--- a/FFTlib/rc1fft.c
+++ b/FFTlib/rc1fft.c
@@ -1,5 +1,9 @@
#include "genfft.h"
#include <string.h>
+#ifdef MKL
+#include "mkl_dfti.h"
+void dfti_status_print(MKL_LONG status);
+#endif
/**
* NAME: rc1fft
@@ -52,6 +56,11 @@ void rc1fft(REAL *rdata, complex *cdata, int n, int sign)
static int isys;
static REAL *work, *table, scale=1.0;
REAL scl, *data;
+#elif defined(MKL)
+ static DFTI_DESCRIPTOR_HANDLE handle=0;
+ static int nprev=0;
+ MKL_LONG Status;
+ int i;
#endif
#if defined(HAVE_LIBSCS)
@@ -92,6 +101,49 @@ void rc1fft(REAL *rdata, complex *cdata, int n, int sign)
}
cdata[n/2].i=0.0;
free(data);
+#elif defined(MKL)
+ if (n != nprev) {
+ DftiFreeDescriptor(&handle);
+
+ Status = DftiCreateDescriptor(&handle, DFTI_SINGLE, DFTI_REAL, 1, (MKL_LONG)n);
+ if(! DftiErrorClass(Status, DFTI_NO_ERROR)){
+ dfti_status_print(Status);
+ printf(" DftiCreateDescriptor FAIL\n");
+ }
+ Status = DftiSetValue(handle, DFTI_PLACEMENT, DFTI_NOT_INPLACE);
+ if(! DftiErrorClass(Status, DFTI_NO_ERROR)){
+ dfti_status_print(Status);
+ printf(" DftiSetValue FAIL\n");
+ }
+/*
+ Status = DftiSetValue(handle, DFTI_FORWARD_DOMAIN, DFTI_REAL);
+ if(! DftiErrorClass(Status, DFTI_NO_ERROR)){
+ dfti_status_print(Status);
+ printf(" DftiSetValue FAIL\n");
+ }
+*/
+
+ Status = DftiSetValue(handle, DFTI_CONJUGATE_EVEN_STORAGE, DFTI_COMPLEX_COMPLEX);
+ if (! DftiErrorClass(Status, DFTI_NO_ERROR)) {
+ dfti_status_print(Status);
+ printf(" DftiSetValue FAIL\n");
+ }
+ Status = DftiCommitDescriptor(handle);
+ if(! DftiErrorClass(Status, DFTI_NO_ERROR)){
+ dfti_status_print(Status);
+ printf(" DftiCommitDescriptor FAIL\n");
+ }
+ nprev = n;
+ }
+ Status = DftiComputeForward(handle, rdata, (MKL_Complex8 *)cdata);
+ if(! DftiErrorClass(Status, DFTI_NO_ERROR)){
+ dfti_status_print(Status);
+ printf(" DftiComputeForward FAIL\n");
+ }
+ for (i=1; i<((n-1)/2)+1; i++) {
+ cdata[i].i *= -sign;
+ }
+
#else
rc1_fft(rdata, cdata, n, sign);
#endif
@@ -99,6 +151,18 @@ void rc1fft(REAL *rdata, complex *cdata, int n, int sign)
return;
}
+#ifdef MKL
+void dfti_status_print(MKL_LONG status)
+{
+ MKL_LONG class_error;
+ char* error_message;
+
+ error_message = DftiErrorMessage(status);
+ printf("error_message = %s \n", error_message);
+ return;
+}
+#endif
+
/****************** NO COMPLEX DEFINED ******************/
diff --git a/FFTlib/rcmfft.c b/FFTlib/rcmfft.c
index e336eb722736d0e5f9dafd4e2ccf2fc092633b8a..5c492faff59d28c7f69fe4d886c85e0f0b47ca6c 100644
--- a/FFTlib/rcmfft.c
+++ b/FFTlib/rcmfft.c
@@ -1,5 +1,9 @@
#include "genfft.h"
#include <string.h>
+#ifdef MKL
+#include "mkl_dfti.h"
+void dfti_status_print(MKL_LONG status);
+#endif
/**
* NAME: rcmfft
@@ -64,6 +68,11 @@ void rcmfft(REAL *rdata, complex *cdata, int n1, int n2, int ldr, int ldc, int s
static int isys;
static REAL *work;
REAL scl, *data;
+#elif defined(MKL)
+ static DFTI_DESCRIPTOR_HANDLE handle=0;
+ static int nprev=0;
+ MKL_LONG Status;
+ int i,j;
#endif
#if defined(HAVE_LIBSCS)
@@ -120,6 +129,44 @@ void rcmfft(REAL *rdata, complex *cdata, int n1, int n2, int ldr, int ldc, int s
cdata[j*ldc+n1/2].i=0.0;
}
free(data);
+#elif defined(MKL)
+ if (n1 != nprev) {
+ DftiFreeDescriptor(&handle);
+
+ Status = DftiCreateDescriptor(&handle, DFTI_SINGLE, DFTI_REAL, 1, (MKL_LONG)n1);
+ if(! DftiErrorClass(Status, DFTI_NO_ERROR)){
+ dfti_status_print(Status);
+ printf(" DftiCreateDescriptor FAIL\n");
+ }
+ Status = DftiSetValue(handle, DFTI_PLACEMENT, DFTI_NOT_INPLACE);
+ if(! DftiErrorClass(Status, DFTI_NO_ERROR)){
+ dfti_status_print(Status);
+ printf(" DftiSetValue FAIL\n");
+ }
+
+ Status = DftiSetValue(handle, DFTI_CONJUGATE_EVEN_STORAGE, DFTI_COMPLEX_COMPLEX);
+ if (! DftiErrorClass(Status, DFTI_NO_ERROR)) {
+ dfti_status_print(Status);
+ printf(" DftiSetValue FAIL\n");
+ }
+ Status = DftiCommitDescriptor(handle);
+ if(! DftiErrorClass(Status, DFTI_NO_ERROR)){
+ dfti_status_print(Status);
+ printf(" DftiCommitDescriptor FAIL\n");
+ }
+ nprev = n1;
+ }
+ Status = DftiComputeForward(handle, rdata, (MKL_Complex8 *)cdata);
+ if(! DftiErrorClass(Status, DFTI_NO_ERROR)){
+ dfti_status_print(Status);
+ printf(" DftiComputeForward FAIL\n");
+ }
+ for (j=0; j<n2; j++) {
+ Status = DftiComputeForward(handle, &rdata[j*ldr], (MKL_Complex8 *)&cdata[j*ldc]);
+ for (i=1; i<((n1-1)/2)+1; i++) {
+ cdata[j*ldc+i].i *= -sign;
+ }
+ }
#else
rcm_fft(rdata, cdata, n1, n2, ldr, ldc, sign);
#endif
diff --git a/FFTlib/test/Makefile b/FFTlib/test/Makefile
index dc1c31fda3b99b480debd4fa1b7696d8ca7051cd..bfca6f33111dea66fa64634c1a28aeff482ca5a4 100644
--- a/FFTlib/test/Makefile
+++ b/FFTlib/test/Makefile
@@ -2,7 +2,7 @@
include ../../Make_include
-LIBS += -L$L -lgenfft -lm
+LIBS += -L$L -lgenfft $(FFT) -lm
ALL: cc1test cc2dtest ccmtest rc1test rc2dtest rcmtest rc1loop cc1loop
diff --git a/FFTlib/test/cc1loop.c b/FFTlib/test/cc1loop.c
index f076afdd7da22470a39d2aed3fca3d4f728ec71c..040fa70375df1e2872911ebec4ca4bc0f74bb521 100644
--- a/FFTlib/test/cc1loop.c
+++ b/FFTlib/test/cc1loop.c
@@ -1,8 +1,7 @@
#include <genfft.h>
#include <time.h>
-#include <kiss_fft.h>
-main () {
+int main () {
int j,i,n,sign, isign;
int N, Nmax=600, Nitcc;
@@ -65,5 +64,6 @@ main () {
N += 1;
}
+ return 0;
}
diff --git a/FFTlib/test/cc1test.c b/FFTlib/test/cc1test.c
index 346f112b290af05771b8571dd94ba1e372e79282..8e076508dd5efa0d8c31245151854c01e6618725 100644
--- a/FFTlib/test/cc1test.c
+++ b/FFTlib/test/cc1test.c
@@ -1,7 +1,7 @@
#include <genfft.h>
#include <time.h>
-main () {
+int main () {
int j,i,n,sign, isign;
int N, Nmax=8192, Nitcc;
@@ -79,5 +79,6 @@ main () {
k += 1.0;
}
+ return 0;
}
diff --git a/FFTlib/test/cc2dtest.c b/FFTlib/test/cc2dtest.c
index 157a0674f20670d6db71a5de648448a3b2419fbd..f714d32c5cb2405df8b18c7803efe061df28a5c7 100644
--- a/FFTlib/test/cc2dtest.c
+++ b/FFTlib/test/cc2dtest.c
@@ -1,7 +1,7 @@
#include <genfft.h>
#include <time.h>
-main () {
+int main () {
int j,i,n,sign, isign;
int N, Nmax=1024, Nitcc, Nlot=1024, ld1;
@@ -142,5 +142,6 @@ main () {
Nlot *= 2;
}
+ return 0;
}
diff --git a/FFTlib/test/ccmtest.c b/FFTlib/test/ccmtest.c
index 39b10059f8101012a1d2e4d21f6c1345ff0acc69..5ea472e4e3d1381b0e290ed8fc148630c742a3cd 100644
--- a/FFTlib/test/ccmtest.c
+++ b/FFTlib/test/ccmtest.c
@@ -1,7 +1,7 @@
#include <genfft.h>
#include <time.h>
-main () {
+int main () {
int j,i,n,sign, isign;
int N, Nmax=4097, Nitcc, Nlot=513, ld1;
@@ -128,5 +128,6 @@ main () {
k += 1.0;
}
+ return 0;
}
diff --git a/FFTlib/test/rc1loop.c b/FFTlib/test/rc1loop.c
index a2209a191b919c8ae75b6dd590ebaab53ba09573..9018e0c46a55af8c89088883673880849f3f9b84 100644
--- a/FFTlib/test/rc1loop.c
+++ b/FFTlib/test/rc1loop.c
@@ -5,7 +5,7 @@ void crdft(complex *cdata, REAL *rdata, int n, int sign);
void rcdft(REAL *rdata, complex *cdata, int n, int sign);
-main () {
+int main () {
int j,i,n,k,sign, isign;
int N, Nmax=600, Nitcc;
@@ -94,5 +94,6 @@ main () {
N += 1;
}
+ return 0;
}
diff --git a/FFTlib/test/rc1test.c b/FFTlib/test/rc1test.c
index c375793c6f6fc181e27414338dd5e13e530c66a4..8771a371dc526006dc44dc7cf64b057412c47a9b 100644
--- a/FFTlib/test/rc1test.c
+++ b/FFTlib/test/rc1test.c
@@ -1,7 +1,7 @@
#include <genfft.h>
#include <time.h>
-main () {
+int main () {
int j,i,n,sign, isign;
int N, Nmax=8192, Nitcc;
@@ -24,25 +24,41 @@ main () {
N = 16;
k = 5.0;
- sign = 1;
- isign = -1;
+ sign = -1;
+ isign = 1;
while (N <= Nmax) {
/* Initialize the data */
for (i=0;i<N;i++) {
- c_data[i] = (float)-0.1+0.5*(N/2-i);
+ c_data[i] = (float)-0.1+0.5*(N/3-i)*sin(i*M_PI/N);
// c_data[i] = 0.0;
}
// c_data[0] = 1.0;
t = 0.0;
+/*
+N=16;
+ scl = 1.0/(float)N;
+ for (j=0;j<N;j++) data[j] = c_data[j];
+ rc1fft(data, cdata, N, sign);
+ cr1fft(cdata, data, N, isign);
+ for (i=0; i<N; i++)
+ fprintf(stderr,"%s: i = %d data = %f Ref-data = %f Complex=%f,%f\n", machine, i, data[i]*scl, c_data[i],cdata[i/2].r,cdata[i/2].i);
+ for (j=0;j<N;j++) data[j] = c_data[j];
+ rc1_fft(data, cdata, N, sign);
+ cr1_fft(cdata, data, N, isign);
+ for (i=0; i<N; i++)
+ fprintf(stderr,"%s: i = %d data = %f Ref-data = %f Complex=%f,%f\n", machine, i, data[i]*scl, c_data[i],cdata[i/2].r,cdata[i/2].i);
+ return;
+*/
/* FFT */
for (i=0; i<2500; i++) {
for (j=0;j<N;j++) data[j] = c_data[j];
t0 = wallclock_time();
rc1fft(data, cdata, N, sign);
cr1fft(cdata, data, N, isign);
+// cr1_fft(cdata, data, N, isign);
t1 = wallclock_time();
t += t1-t0;
}
@@ -51,9 +67,9 @@ main () {
scl = 1.0/(float)N;
for (i=0; i<N; i++) {
/*
- fprintf(stderr,"%s: i = %d data = %f C-data = %f\n", machine, i, data[i].r*scl, c_data[i].r);
- fprintf(stderr,"%s: i = %d data = %f C-data = %f\n", machine, i, data[i].i*scl, c_data[i].i);
+ fprintf(stderr,"%s: i = %d data = %f Ref-data = %f Complex=%f,%f\n", machine, i, data[i]*scl, c_data[i],cdata[i/2].r,cdata[i/2].i);
*/
+
if (c_data[i] != 0.0) {
diff = fabs((data[i]*scl - c_data[i]) / c_data[i]);
}
@@ -77,5 +93,6 @@ main () {
k += 1.0;
}
+ return 0;
}
diff --git a/FFTlib/test/rc2dtest.c b/FFTlib/test/rc2dtest.c
index e9965f34611a098d5593f70c3182f1675bf6106e..685b8071a78e7e190c8eca6736aae23bd8dff89d 100644
--- a/FFTlib/test/rc2dtest.c
+++ b/FFTlib/test/rc2dtest.c
@@ -1,7 +1,7 @@
#include <genfft.h>
#include <time.h>
-main () {
+int main () {
int l,j,i,n,sign, isign, ldr, ldc;
int N, Nmax=2048, Nlot=150, Nitcc;
@@ -141,6 +141,6 @@ main () {
Nlot *= 2;
}
-
+ return 0;
}
diff --git a/FFTlib/test/rcmtest.c b/FFTlib/test/rcmtest.c
index f8ef83dc5c14cf8493b30bd360c5d20f72c7eb4a..9602ceb8acf0db0f1d024a5301afeb21549dffb1 100644
--- a/FFTlib/test/rcmtest.c
+++ b/FFTlib/test/rcmtest.c
@@ -1,7 +1,7 @@
#include <genfft.h>
#include <time.h>
-main () {
+int main () {
int l,j,i,n,sign, isign, ldr, ldc;
int N, Nmax=8193, Nlot=150, Nitcc;
@@ -82,5 +82,6 @@ main () {
k += 1.0;
}
+ return 0;
}
diff --git a/MDD/Makefile b/MDD/Makefile
new file mode 100644
index 0000000000000000000000000000000000000000..561b309ee2e3272ff12013336db442c01840db4b
--- /dev/null
+++ b/MDD/Makefile
@@ -0,0 +1,61 @@
+# Makefile
+
+include ../Make_include
+
+########################################################################
+# define general include and system library
+ALLINC = -I.
+#BLAS libs with Intel compiler
+#LIBS += -mkl -L$L -lgenfft $(LIBSM)
+#General BLAS library
+#LIBS += -L$L -lgenfft $(LIBSM)
+#General BLAS library
+#LIBS += $(BLAS)
+
+#CFLAGS += -I$(MKLROOT)/include
+#LIBS += -lblas -llapack -L$L -lgenfft $(LIBSM) -lc -lm
+
+all: mdd
+
+PRG = mdd
+
+SRCC = $(PRG).c \
+ atopkge.c \
+ docpkge.c \
+ getpars.c \
+ readShotData.c \
+ writeEigen.c \
+ deconvolve.c \
+ computeMatrixInverse.c \
+ getFileInfo.c \
+ verbosepkg.c \
+ name_ext.c \
+ wallclock_time.c
+
+OBJC = $(SRCC:%.c=%.o)
+
+$(PRG): $(OBJC)
+ $(CC) $(LDFLAGS) $(CFLAGS) $(OPTC) -o $(PRG) $(OBJC) $(LIBS)
+
+install: $(PRG)
+ cp $(PRG) $B
+
+clean:
+ rm -f core $(OBJC) $(OBJM) $(PRG)
+
+realclean:
+ rm -f core $(OBJC) $(OBJM) $(PRG) $B/$(PRG)
+
+
+print: Makefile $(SRC)
+ $(PRINT) $?
+ @touch print
+
+count:
+ @wc $(SRC)
+
+tar:
+ @tar cf $(PRG).tar Makefile $(SRC) && compress $(PRG).tar
+
+
+
diff --git a/MDD/atopkge.c b/MDD/atopkge.c
new file mode 120000
index 0000000000000000000000000000000000000000..5107e2b2ccd382ede29d397838d8fad88126a516
--- /dev/null
+++ b/MDD/atopkge.c
@@ -0,0 +1 @@
+../utils/atopkge.c
\ No newline at end of file
diff --git a/MDD/computeMatrixInverse.c b/MDD/computeMatrixInverse.c
new file mode 100644
index 0000000000000000000000000000000000000000..a4ba57fd53d3d54e75e2cbf2f3e85d1dd1f88800
--- /dev/null
+++ b/MDD/computeMatrixInverse.c
@@ -0,0 +1,524 @@
+#include<math.h>
+#include<stdlib.h>
+#include<stdio.h>
+#include <assert.h>
+
+#define MAX(x,y) ((x) > (y) ? (x) : (y))
+
+/* Cholesky based inverse */
+void cpotrf_(char *uplo, int *N, float *A, int *lda, int *info);
+void cpotri_(char *uplo, int *N, float *A, int *lda, int *info);
+
+/* LU based inverse */
+void cgetrf_(int *M, int *N, float *A, int *lda, int *ipvt, int *info);
+void cgetri_(int *N, float *A, int *lda, int *ipvt, float *work, int *lwork, int *info);
+void zgetrf_(int *M, int *N, double *A, int *lda, int *ipvt, int *info);
+void zgetri_(int *N, double *A, int *lda, int *ipvt, double *work, int *lwork, int *info);
+int ilaenv_(int *ispec, char *name, char *opts, int *n1, int *n2, int *n3, int *n4);
+
+/* SVD based inverse */
+void cgesvd_(char *jobu, char *jobvt, int *M, int *N, float *A, int *lda, float *S, float *U, int *ldu, float *vt, int *ldvt, float *work, int *lwork, float *rwork, int *info);
+void zgesvd_(char *jobu, char *jobvt, int *M, int *N, double *A, int *lda, double *S, double *U, int *ldu, double *vt, int *ldvt, double *work, int *lwork, double *rwork, int *info);
+void cgesdd_(char *jobz, int *M, int *N, float *A, int *lda, float *S, float *U, int *ldu, float *vt, int *ldvt, float *work, int *lwork, float *rwork, int *iwork, int *info);
+
+/* Eigenvalues */
+void zgeev_(char *jobvl, char *jobvr, int *N, double *A, int *lda, double *S, double *vl, int *ldvl, double *vr, int *ldvr,
+ double *work, int *lwork, double *rwork, int *info);
+
+typedef struct { /* complex number */
+ float r,i;
+} complex;
+
+void computeMatrixInverse(complex *matrix, int nxm, int rthm, float eps_a, float eps_r, float numacc, int eigenvalues, float *eigen, int iw, int verbose)
+{
+ int i,j,k,N,lda,info,lwork,*ipvt;
+ float energy;
+ complex tmp, one, *work;
+ char *uplo;
+
+ uplo = "U";
+ lda = N = nxm;
+ one.r = 1.0;
+ one.i = 0.0;
+
+ if (rthm==0) {
+ energy=0.0;
+ if (eps_r != 0.0) {
+ for (i=0; i<nxm; i++) {
+ for (j=0; j<nxm; j++) {
+ tmp = matrix[i*nxm+j];
+ energy += sqrt(tmp.r*tmp.r+tmp.i*tmp.i);
+ }
+// fprintf(stderr,"i=%d energy=%e\n", i, energy);
+ }
+ }
+ if (verbose>1) fprintf(stderr,"energy=%e eps_r=%e eps_a=%e\n", energy, eps_r*energy, eps_a);
+ /* add small value at diagonal */
+#pragma ivdep
+ for (i=0; i<nxm; i++) {
+ tmp.r = eps_r*energy+eps_a;
+ matrix[i*nxm+i].r+=tmp.r;
+ }
+ /* Cholesky based matrix inversion */
+ cpotrf_(uplo, &N, &matrix[0].r, &lda, &info);
+ assert (info == 0);
+ cpotri_(uplo, &N, &matrix[0].r, &lda, &info);
+ assert (info == 0);
+ /* fill lower part of inverse matrix */
+ for (i=0; i<nxm; i++) {
+#pragma ivdep
+ for (j=i+1; j<nxm; j++) {
+ matrix[i*nxm+j].r=matrix[j*nxm+i].r;
+ matrix[i*nxm+j].i=-1.0*matrix[j*nxm+i].i;
+ }
+ }
+
+ }
+ else if (rthm==1) {
+ int ispec, n1, nb;
+ char *name , *opts;
+
+ ispec = 1;
+ name = "CGETRI";
+ n1 = nxm;
+ nb = ilaenv_(&ispec, name, opts, &n1, &n1, &n1, &n1);
+ nb = MAX(1,nb);
+ lwork = nb*nxm;
+ ipvt = (int *)malloc(nxm*sizeof(int));
+ work = (complex *)malloc(lwork*sizeof(complex));
+
+ energy=0.0;
+ if (eps_r != 0.0) {
+ for (i=0; i<nxm; i++) {
+ for (j=0; j<nxm; j++) {
+ tmp = matrix[i*nxm+j];
+ energy += sqrt(tmp.r*tmp.r+tmp.i*tmp.i);
+ }
+ }
+ }
+ if (verbose>1) fprintf(stderr,"eps_r=%e eps_a=%e\n", eps_r*energy, eps_a);
+ /* add small value at diagonal */
+ for (i=0; i<nxm; i++) {
+ tmp.r = eps_r*energy+eps_a;
+ matrix[i*nxm+i].r+=tmp.r;
+ }
+ /* LU based matrix inversion */
+ cgetrf_(&nxm, &nxm, &matrix[0].r, &nxm, ipvt, &info);
+ assert (info == 0);
+ cgetri_(&nxm, &matrix[0].r, &nxm, ipvt, &work[0].r, &lwork, &info);
+ assert (info == 0);
+
+ free(ipvt);
+ free(work);
+ }
+ else if (rthm==2) { /* SVD general algorithm most accurate */
+ float *rwork, *S;
+ double S0,Si;
+ complex *U, *VT, a, b;
+ char *jobu, *jobvt;
+ int neig;
+
+ energy=0.0;
+ if (eps_r != 0.0) {
+ for (i=0; i<nxm; i++) {
+ for (j=0; j<nxm; j++) {
+ tmp = matrix[i*nxm+j];
+ energy += sqrt(tmp.r*tmp.r+tmp.i*tmp.i);
+ }
+ }
+ fprintf(stderr,"energy = %e\n", energy);
+ }
+ if (verbose>1) fprintf(stderr,"eps_r=%e eps_a=%e\n", eps_r*energy, eps_a);
+ /* add small value at diagonal */
+ for (i=0; i<nxm; i++) {
+ tmp.r = eps_r*energy+eps_a;
+ matrix[i*nxm+i].r+=tmp.r;
+ }
+
+ jobu = "A";
+ jobvt = "A";
+ lda = N = nxm;
+ lwork = N*8;
+ S = (float *)malloc(N*sizeof(float));
+ U = (complex *)malloc(N*N*sizeof(complex));
+ VT = (complex *)malloc(N*N*sizeof(complex));
+ work = (complex *)malloc(lwork*sizeof(complex));
+ rwork = (float *)malloc(5*N*sizeof(float));
+
+ /* Compute SVD */
+ cgesvd_(jobu, jobvt, &N, &N, &matrix[0].r, &lda, S, &U[0].r, &lda, &VT[0].r,
+ &lda, &work[0].r, &lwork, rwork, &info);
+ assert (info == 0);
+
+ if (eigenvalues) {
+ for (i=0; i<N; i++) {
+ eigen[i] = S[i];
+ }
+ }
+
+ /* Compute inverse */
+ S0 = S[0];
+ neig = 0;
+ for (i=0; i<N; i++) {
+/* fprintf(stderr,"S[%d] = %e ",i,S[i]);*/
+ Si = S[i];
+ if ((Si/S0) > numacc) { S[i]=1.0/S[i]; neig++; }
+ else S[i] = 0.0;
+ /*S[i]=1.0/(S[i]+eps_r*S[0]);*/
+/* fprintf(stderr,"S^-1[%d] = %e\n",i,S[i]);*/
+ }
+ if(verbose) fprintf(stderr,"fraction of eigenvalues used = %.3f\n",(float)(neig/((float)N)));
+
+ for (j=0; j<N; j++) {
+ for (i=0; i<N; i++) {
+ U[j*N+i].r=S[j]*U[j*N+i].r;
+ U[j*N+i].i=-1.0*S[j]*U[j*N+i].i;
+ }
+ }
+ for (j=0; j<N; j++) {
+ for (i=0; i<N; i++) {
+ tmp.r = tmp.i = 0.0;
+ for (k=0; k<N; k++) {
+ a = U[k*N+j];
+ b.r = VT[i*N+k].r;
+ b.i = -1.0*VT[i*N+k].i;
+ tmp.r += (a.r*b.r-a.i*b.i);
+ tmp.i += (a.r*b.i+a.i*b.r);
+ }
+ matrix[j*nxm+i] = tmp;
+ }
+ }
+
+ free(U);
+ free(VT);
+ free(S);
+ free(work);
+ free(rwork);
+ }
+ else if (rthm==3) { /* SVD algorithm Divide and Conquerer less accurate */
+ /* CGESDD*/
+ int *iwork;
+ int neig;
+ float *rwork, *S;
+ double S0,Si;
+ complex *U, *VT, a, b;
+ char *jobz;
+
+ energy=0.0;
+ if (eps_r != 0.0) {
+ for (i=0; i<nxm; i++) {
+ for (j=0; j<nxm; j++) {
+ tmp = matrix[i*nxm+j];
+ energy += sqrt(tmp.r*tmp.r+tmp.i*tmp.i);
+ }
+ }
+ }
+ if (verbose>1) fprintf(stderr,"eps_r=%e eps_a=%e\n", eps_r*energy, eps_a);
+ /* add small value at diagonal */
+ for (i=0; i<nxm; i++) {
+ tmp.r = eps_r*energy+eps_a;
+ matrix[i*nxm+i].r+=tmp.r;
+ }
+
+ jobz = "A";
+ lda = N = nxm;
+ lwork = N*N+4*N;
+ S = (float *)malloc(N*sizeof(float));
+ U = (complex *)malloc(N*N*sizeof(complex));
+ VT = (complex *)malloc(N*N*sizeof(complex));
+ work = (complex *)malloc(lwork*sizeof(complex));
+ rwork = (float *)malloc(5*(N*N+N)*sizeof(float));
+ iwork = (int *)malloc(8*N*sizeof(int));
+
+ /* Compute SVD */
+ cgesdd_(jobz, &N, &N, &matrix[0].r, &lda, S, &U[0].r, &lda, &VT[0].r,
+ &lda, &work[0].r, &lwork, rwork, iwork, &info);
+ assert (info == 0);
+
+ if (eigenvalues) {
+ for (i=0; i<N; i++) {
+ eigen[i] = S[i];
+ }
+ }
+
+ /* Compute inverse */
+ S0 = S[0];
+ neig = 0;
+ for (i=0; i<N; i++) {
+/* fprintf(stderr,"S[%d] = %e S0 = %e\n ",i,S[i], S0);*/
+ Si = S[i];
+ if ((Si/S0) > numacc) { S[i]=1.0/S[i]; neig++; }
+ else S[i] = 0.0;
+/* fprintf(stderr,"S^-1[%d] = %e\n",i,S[i]);*/
+ }
+ if(verbose) fprintf(stderr,"fraction of eigenvalues used = %.3f\n",(float)(neig/((float)N)));
+
+ for (j=0; j<N; j++) {
+ for (i=0; i<N; i++) {
+ U[j*N+i].r=S[j]*U[j*N+i].r;
+ U[j*N+i].i=-1.0*S[j]*U[j*N+i].i;
+ }
+ }
+ for (j=0; j<N; j++) {
+ for (i=0; i<N; i++) {
+ tmp.r = tmp.i = 0.0;
+ for (k=0; k<N; k++) {
+ a = U[k*N+j];
+ b.r = VT[i*N+k].r;
+ b.i = -1.0*VT[i*N+k].i;
+ tmp.r += (a.r*b.r-a.i*b.i);
+ tmp.i += (a.r*b.i+a.i*b.r);
+ }
+ matrix[j*nxm+i] = tmp;
+ }
+ }
+
+ free(U);
+ free(VT);
+ free(S);
+ free(work);
+ free(rwork);
+ free(iwork);
+ }
+ else if (rthm==4) { /* SVD general algorithm double precission most accurate */
+ double *rwork, *S, *U, *VT, ar, ai, br, bi, tmpr, tmpi;
+ double S0,Si,*Mat,*dwork;
+ int neig;
+ char *jobu, *jobvt;
+
+ energy=0.0;
+ if (eps_r != 0.0) {
+ for (i=0; i<nxm; i++) {
+ for (j=0; j<nxm; j++) {
+ tmp = matrix[i*nxm+j];
+ energy += sqrt(tmp.r*tmp.r+tmp.i*tmp.i);
+ }
+ }
+ }
+ if (verbose>1) fprintf(stderr,"eps_r=%e eps_a=%e\n", eps_r*energy, eps_a);
+ /* add small value at diagonal */
+ for (i=0; i<nxm; i++) {
+ tmp.r = eps_r*energy+eps_a;
+ matrix[i*nxm+i].r+=tmp.r;
+ }
+
+ Mat = (double *)malloc(2*N*N*sizeof(double));
+ /* convert to doubles */
+ for (i=0; i<nxm; i++) {
+ for (j=0; j<nxm; j++) {
+ Mat[i*2*nxm+j*2] = (double)matrix[i*nxm+j].r;
+ Mat[i*2*nxm+j*2+1] = (double)matrix[i*nxm+j].i;
+ }
+ }
+ jobu = "A";
+ jobvt = "A";
+ lda = N = nxm;
+ lwork = N*8;
+ S = (double *)malloc(N*sizeof(double));
+ U = (double *)malloc(2*N*N*sizeof(double));
+ VT = (double *)malloc(2*N*N*sizeof(double));
+ dwork = (double *)malloc(2*lwork*sizeof(double));
+ rwork = (double *)malloc(5*N*sizeof(double));
+
+ /* Compute SVD */
+ zgesvd_(jobu, jobvt, &N, &N, &Mat[0], &lda, S, &U[0], &lda, &VT[0],
+ &lda, &dwork[0], &lwork, rwork, &info);
+ assert (info == 0);
+
+ if (eigenvalues) {
+ for (i=0; i<N; i++) {
+ eigen[i] = (float)S[i];
+ }
+ }
+
+ /* Compute inverse */
+ S0 = S[0];
+ neig = 0;
+ for (i=0; i<N; i++) {
+ if (verbose=4) fprintf(stderr,"S[%d] = %e ",i,S[i]);
+ Si = S[i];
+ if ((Si/S0) > numacc) { S[i]=1.0/S[i]; neig++; }
+ else S[i] = 0.0;
+ /*S[i]=1.0/(S[i]+eps_r*S[0]);*/
+/* fprintf(stderr,"S^-1[%d] = %e\n",i,S[i]);*/
+ }
+ if(verbose) fprintf(stderr,"fraction of eigenvalues used = %.3f\n",(float)(neig/((float)N)));
+
+ for (j=0; j<N; j++) {
+ for (i=0; i<N; i++) {
+ U[j*2*N+2*i]=S[j]*U[j*2*N+2*i];
+ U[j*2*N+2*i+1]=-1.0*S[j]*U[j*2*N+2*i+1];
+ }
+ }
+ for (j=0; j<N; j++) {
+ for (i=0; i<N; i++) {
+ tmpr = tmpi = 0.0;
+ for (k=0; k<N; k++) {
+ ar = U[k*2*N+2*j];
+ ai = U[k*2*N+2*j+1];
+ br = VT[i*2*N+2*k];
+ bi = -1.0*VT[i*2*N+2*k+1];
+ tmpr += (ar*br-ai*bi);
+ tmpi += (ar*bi+ai*br);
+ }
+ matrix[j*nxm+i].r = (float)tmpr;
+ matrix[j*nxm+i].i = (float)tmpi;
+ }
+ }
+
+ free(U);
+ free(VT);
+ free(S);
+ free(dwork);
+ free(rwork);
+ free(Mat);
+ }
+ else if (rthm==5) { /* double precission LU decomposition */
+ int ispec, n1, nb;
+ char *name , *opts;
+ double *Mat, *dwork;
+
+ ispec = 1;
+ name = "ZGETRI";
+ n1 = nxm;
+ nb = ilaenv_(&ispec, name, opts, &n1, &n1, &n1, &n1);
+ nb = MAX(1,nb);
+ lwork = nb*nxm;
+ ipvt = (int *)malloc(nxm*sizeof(int));
+ dwork = (double *)malloc(2*lwork*sizeof(double));
+ Mat = (double *)malloc(2*N*N*sizeof(double));
+
+ energy=0.0;
+ if (eps_r != 0.0) {
+ for (i=0; i<nxm; i++) {
+ for (j=0; j<nxm; j++) {
+ tmp = matrix[i*nxm+j];
+ energy += sqrt(tmp.r*tmp.r+tmp.i*tmp.i);
+ }
+ }
+ }
+ if (verbose>1) fprintf(stderr,"eps_r=%e eps_a=%e\n", eps_r*energy, eps_a);
+ /* convert to doubles */
+ for (i=0; i<nxm; i++) {
+ for (j=0; j<nxm; j++) {
+ Mat[i*2*nxm+j*2] = (double)matrix[i*nxm+j].r;
+ Mat[i*2*nxm+j*2+1] = (double)matrix[i*nxm+j].i;
+ }
+ }
+
+ /* add small value at diagonal */
+ for (i=0; i<nxm; i++) {
+ Mat[i*2*nxm+i*2] +=eps_r*energy+eps_a;
+// Mat[i*2*nxm+i*2+1]+=eps_r*energy+eps_a;
+ }
+
+ /* LU based matrix inversion */
+ zgetrf_(&nxm, &nxm, &Mat[0], &nxm, ipvt, &info);
+ if (info != 0) fprintf(stderr,"error in zgetrf %d at frequency %d\n", info, iw);
+ assert (info == 0);
+ zgetri_(&nxm, &Mat[0], &nxm, ipvt, &dwork[0], &lwork, &info);
+ if (info != 0) fprintf(stderr,"error in zgetri %d at frequency %d\n", info, iw);
+ assert (info == 0);
+
+ /* convert back to floats */
+ for (i=0; i<nxm; i++) {
+ for (j=0; j<nxm; j++) {
+ matrix[i*nxm+j].r = (float)Mat[i*2*nxm+j*2];
+ matrix[i*nxm+j].i = (float)Mat[i*2*nxm+j*2+1];
+ }
+ }
+
+ free(ipvt);
+ free(dwork);
+ free(Mat);
+ }
+ else if (rthm==6) { /* eigenvalue decomposition */
+ int *iwork;
+ int neig;
+ double *work, *vr, *vl;
+ double *rwork, *S, *U, *VT, ar, ai, br, bi, tmpr, tmpi;
+ double S0,Si,nxi,*Mat;
+ char *jobvl, *jobvr;
+
+ jobvl = "V";
+ jobvr = "V";
+ lwork = N*N+2*N;
+ work = (double *)malloc(2*lwork*sizeof(double));
+ rwork = (double *)malloc(N*2*sizeof(double));
+ vr = (double *)malloc(2*N*N*sizeof(double));
+ vl = (double *)malloc(2*N*N*sizeof(double));
+ S = (double *)malloc(2*N*sizeof(double));
+ U = (double *)malloc(2*N*N*sizeof(double));
+
+ Mat = (double *)malloc(2*N*N*sizeof(double));
+ /* convert to doubles */
+ for (i=0; i<nxm; i++) {
+ for (j=0; j<nxm; j++) {
+ Mat[i*2*nxm+j*2] = (double)matrix[i*nxm+j].r;
+ Mat[i*2*nxm+j*2+1] = (double)matrix[i*nxm+j].i;
+ }
+ }
+
+ zgeev_(jobvl, jobvr, &N, Mat, &N, S, vl, &N, vr, &N,
+ work, &lwork, rwork, &info);
+ assert (info == 0);
+
+ nxi = 1.0/N;
+ for (i=0; i<N; i++) {
+ S[2*i] = (float)S[2*i]*nxi;
+ S[2*i+1] = (float)S[2*i+1]*nxi;
+ }
+
+ for (i=0; i<N; i++) {
+ for (j=0; j<N; j++) {
+ U[i*2*N+2*j] = (float)vr[(j)*2*N+2*i];
+ U[i*2*N+2*j+1] = (float)vr[(i)*2*N+2*j+1];
+ }
+ }
+
+ /* Compute inverse */
+ S0 = S[0];
+ neig = 0;
+ for (i=0; i<N; i++) {
+/* fprintf(stderr,"S[%d] = %e ",i,S[i]);*/
+ Si = S[i];
+ if ((Si/S0) > numacc) { S[i]=1.0/S[i]; neig++; }
+ else S[i] = 0.0;
+/* fprintf(stderr,"S^-1[%d] = %e\n",i,S[i]);*/
+ }
+ if(verbose) fprintf(stderr,"fraction of eigenvalues used = %.3f\n",(float)(neig/((float)N)));
+
+ for (j=0; j<N; j++) {
+ for (i=0; i<N; i++) {
+ U[j*2*N+2*i]=S[j]*U[j*2*N+2*i];
+ U[j*2*N+2*i+1]=-1.0*S[j]*U[j*2*N+2*i+1];
+ }
+ }
+ for (j=0; j<N; j++) {
+ for (i=0; i<N; i++) {
+ tmpr = tmpi = 0.0;
+ for (k=0; k<N; k++) {
+ ar = U[k*2*N+2*j];
+ ai = U[k*2*N+2*j+1];
+ br = U[i*2*N+2*k];
+ bi = U[i*2*N+2*k+1];
+ tmpr += (ar*br-ai*bi);
+ tmpi += (ar*bi+ai*br);
+ }
+ matrix[j*nxm+i].r = (float)tmpr;
+ matrix[j*nxm+i].i = (float)tmpi;
+ }
+ }
+
+
+ free(work);
+ free(rwork);
+ free(vr);
+ free(Mat);
+ free(S);
+ free(U);
+ }
+
+ return;
+}
+
diff --git a/MDD/deconvolve.c b/MDD/deconvolve.c
new file mode 100644
index 0000000000000000000000000000000000000000..147fc7b6da2909c40e18485881cf0f5de472215f
--- /dev/null
+++ b/MDD/deconvolve.c
@@ -0,0 +1,194 @@
+#include <stdlib.h>
+#include <stdio.h>
+#include <assert.h>
+#include <math.h>
+#include <string.h>
+#ifdef MKL
+#include<mkl_cblas.h>
+#endif
+
+typedef struct { /* complex number */
+ float r,i;
+} complex;
+
+/*
+cblas interface
+void cgemm(const char *transa, const char *transb, const MKL_INT *m, const MKL_INT *n, const MKL_INT *k,
+ const MKL_Complex8 *alpha, const MKL_Complex8 *a, const MKL_INT *lda,
+ const MKL_Complex8 *b, const MKL_INT *ldb, const MKL_Complex8 *beta,
+ MKL_Complex8 *c, const MKL_INT *ldc);
+*/
+
+void cgemm_(char *transA, char *transb, int *M, int *N, int *K, float *alpha, float *A, int *lda, float *B, int *ldb, float *beta, float *C, int *ldc);
+/*
+CGEMM - perform one of the matrix-matrix operations C := alpha*op( A )*op( B ) + beta*C,
+
+Synopsis
+
+SUBROUTINE CGEMM ( TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC )
+
+CHARACTER*1 TRANSA, TRANSB
+
+INTEGER M, N, K, LDA, LDB, LDC
+
+COMPLEX ALPHA, BETA
+
+COMPLEX A( LDA, * ), B( LDB, * ), C( LDC, * )
+
+TRANSA - CHARACTER*1. On entry, TRANSA specifies the form of op( A ) to be used in the matrix multiplication as follows:
+
+TRANSA = 'N' or 'n', op( A ) = A.
+
+TRANSA = 'T' or 't', op( A ) = A'.
+
+TRANSA = 'C' or 'c', op( A ) = conjg( A' ).
+
+Unchanged on exit.
+
+TRANSB - CHARACTER*1. On entry, TRANSB specifies the form of op( B ) to be used in the matrix multiplication as follows:
+
+TRANSB = 'N' or 'n', op( B ) = B.
+
+TRANSB = 'T' or 't', op( B ) = B'.
+
+TRANSB = 'C' or 'c', op( B ) = conjg( B' ).
+
+Unchanged on exit.
+
+M - INTEGER.
+On entry, M specifies the number of rows of the matrix op( A ) and of the matrix C. M must be at least zero. Unchanged on exit.
+
+N - INTEGER.
+On entry, N specifies the number of columns of the matrix op( B ) and the number of columns of the matrix C. N must be at least zero. Unchanged on exit.
+
+K - INTEGER.
+On entry, K specifies the number of columns of the matrix op( A ) and the number of rows of the matrix op( B ). K must be at least zero. Unchanged on exit.
+
+ALPHA - COMPLEX .
+On entry, ALPHA specifies the scalar alpha. Unchanged on exit.
+
+A - COMPLEX array of DIMENSION ( LDA, ka ), where ka is k when TRANSA = 'N' or 'n', and is m otherwise. Before entry with TRANSA = 'N' or 'n', the leading m by k part of the array A must contain the matrix A, otherwise the leading k by m part of the array A must contain the matrix A. Unchanged on exit.
+
+LDA - INTEGER.
+On entry, LDA specifies the first dimension of A as declared in the calling (sub) program. When TRANSA = 'N' or 'n' then LDA must be at least max( 1, m ), otherwise LDA must be at least max( 1, k ). Unchanged on exit.
+
+B - COMPLEX array of DIMENSION ( LDB, kb ), where kb is n when TRANSB = 'N' or 'n', and is k otherwise. Before entry with TRANSB = 'N' or 'n', the leading k by n part of the array B must contain the matrix B, otherwise the leading n by k part of the array B must contain the matrix B. Unchanged on exit.
+
+LDB - INTEGER.
+On entry, LDB specifies the first dimension of B as declared in the calling (sub) program. When TRANSB = 'N' or 'n' then LDB must be at least max( 1, k ), otherwise LDB must be at least max( 1, n ). Unchanged on exit.
+
+BETA - COMPLEX .
+On entry, BETA specifies the scalar beta. When BETA is supplied as zero then C need not be set on input. Unchanged on exit.
+
+C - COMPLEX array of DIMENSION ( LDC, n ).
+Before entry, the leading m by n part of the array C must contain the matrix C, except when beta is zero, in which case C need not be set on entry. On exit, the array C is overwritten by the m by n matrix ( alpha*op( A )*op( B ) + beta*C ).
+
+LDC - INTEGER.
+On entry, LDC specifies the first dimension of C as declared in the calling (sub) program. LDC must be at least max( 1, m ). Unchanged on exit.
+
+*/
+
+void computeMatrixInverse(complex *matrix, int nxm, int rthm, float eps_a, float eps_r, float numacc, int eigenvalues, float *eigen, int iw, int verbose);
+
+int deconvolve(complex *cA, complex *cB, complex *cC, complex *oBB, int nfreq, int nblock, size_t nstationA, size_t nstationB, float eps_a, float eps_r, float numacc, int eigenvalues, float *eigen, int rthm, int mdd, int conjgA, int conjgB, int verbose)
+{
+ int istation, jstation, i, j, k, icc, ibb, NA, NB, NC, nshots;
+ size_t iwnA, iw, iwnB, iwAB, iwBB;
+ complex *AB, *BB;
+ char *transa, *transb,*transN;
+ complex beta, alpha, tmp, a, b;
+
+ AB = (complex *)calloc(nstationA*nstationB,sizeof(complex));
+ BB = (complex *)calloc(nstationB*nstationB,sizeof(complex));
+
+ if (conjgA == 1) transa = "C";
+ else if (conjgA == 0) transa = "N";
+ else transa = "T";
+ if (conjgB == 1) transb = "C";
+ else if(conjgB ==0) transb = "N";
+ else transb = "T";
+ transN = "N";
+ alpha.r = 1.0; alpha.i = 0.0;
+ beta.r = 0.0; beta.i = 0.0;
+ nshots = nblock;
+ NA = nstationA;
+ NB = nstationB;
+ if (conjgA) NC = nshots;
+ else NC = nstationB;
+
+// if (verbose) fprintf(stderr,"transa=%s transb=%s %d %d %d\n", transa, transb, NA, NB, nshots);
+
+#pragma omp for schedule(static) \
+private(iw, iwnA, iwnB, iwAB, iwBB)
+ for (iw=0; iw< nfreq; iw++) {
+
+ iwnA = iw*nstationA*nshots;
+ iwnB = iw*nstationB*nshots;
+ iwAB = iw*NC*NC;
+ if (mdd==0) { /* Correlation */
+ /* cblas_cgemm(CblasRowMajor,CblasNoTrans, CblasConjTrans, NA, NB, nshots, &alpha.r,
+ &cA[iwnA].r, NA,
+ &cB[iwnB].r, NB, &beta.r,
+ &cC[iwAB].r, NC); */
+ cgemm_(transa, transb, &NA, &NB, &nshots, &alpha.r,
+ &cA[iwnA].r, &NA,
+ &cB[iwnB].r, &NB, &beta.r,
+ &cC[iwAB].r, &NC);
+// memcpy(&cC[iwAB].r, &cB[iwnA].r, sizeof(float)*2*nstationA*nshots);
+ }
+ else if (mdd==1) { /* Multi Dimensional deconvolution */
+ /* compute AB^h and BB^h */
+ iwBB = iw*nstationB*nstationB;
+ cgemm_(transa, transb, &NA, &NB, &nshots, &alpha.r,
+ &cA[iwnA].r, &NA,
+ &cB[iwnB].r, &NB, &beta.r,
+ &AB[0].r, &NA);
+
+ cgemm_(transa, transb, &NB, &NB, &nshots, &alpha.r,
+ &cB[iwnB].r, &NB,
+ &cB[iwnB].r, &NB, &beta.r,
+ &BB[0].r, &NB);
+
+ if (oBB!=NULL) memcpy(&oBB[iwBB].r, &BB[0].r, nstationB*nstationB*sizeof(complex));
+
+ /* compute inverse of BB^h as [BB^h+eps]^-1 */
+ computeMatrixInverse(BB, NB, rthm, eps_a, eps_r, numacc, eigenvalues, &eigen[iw*NB], iw, verbose);
+
+ /* multiply with AB to get Least Squares inversion */
+ /* C = A/B => AB^h/(BB^h+eps) */
+ cgemm_(transa, transa, &NA, &NB, &NB, &alpha.r,
+ &AB[0].r, &NA,
+ &BB[0].r, &NB, &beta.r,
+ &cC[iwAB].r, &NA);
+ }
+ else if (mdd==2) { /* Multi Dimensional deconvolution, but AB^H en BB^H already computed */
+
+ memcpy(&BB[0].r, &cB[iwnB].r, nstationB*nshots*sizeof(complex));
+
+ computeMatrixInverse(BB, NB, rthm, eps_a, eps_r, numacc, eigenvalues, &eigen[iw*NB], iw, verbose);
+
+ transN = "N";
+ transN = "N";
+ cgemm_(transN, transN, &NA, &NB, &NB, &alpha.r,
+ &cA[iwnA].r, &NA,
+ &BB[0].r, &NB, &beta.r,
+ &cC[iwAB].r, &NA);
+ }
+ else if (mdd==3) { /* Copy matrix A or B to memory for testing purposes */
+ memcpy(&cC[iwAB].r, &cA[iwnA].r, sizeof(complex)*nstationA*nshots);
+ }
+ else if (mdd==4) {
+ memcpy(&cC[iwAB].r, &cB[iwnB].r, sizeof(complex)*nstationB*nshots);
+ }
+ else if (mdd==5) {
+ cblas_cdotu_sub(nshots, &cA[iwnA].r, NA, &cB[iwnB].r, NB, &cC[iwnA].r);
+ }
+
+ }
+
+ free(AB);
+ free(BB);
+
+ return 0;
+}
+
diff --git a/MDD/docpkge.c b/MDD/docpkge.c
new file mode 120000
index 0000000000000000000000000000000000000000..5384bb3801703c3f0db8fcc032235ca6130fa08b
--- /dev/null
+++ b/MDD/docpkge.c
@@ -0,0 +1 @@
+../utils/docpkge.c
\ No newline at end of file
diff --git a/MDD/getFileInfo.c b/MDD/getFileInfo.c
new file mode 120000
index 0000000000000000000000000000000000000000..ae38ea27f17697d65d7248c8e89038b632314182
--- /dev/null
+++ b/MDD/getFileInfo.c
@@ -0,0 +1 @@
+../utils/getFileInfo.c
\ No newline at end of file
diff --git a/MDD/getpars.c b/MDD/getpars.c
new file mode 120000
index 0000000000000000000000000000000000000000..fa7dc3355428e8ea9013fafad6e319dde3a48ebb
--- /dev/null
+++ b/MDD/getpars.c
@@ -0,0 +1 @@
+../utils/getpars.c
\ No newline at end of file
diff --git a/MDD/mdd.c b/MDD/mdd.c
new file mode 100644
index 0000000000000000000000000000000000000000..93a6e277feabffc68a1ded5e8b09d8686693f58b
--- /dev/null
+++ b/MDD/mdd.c
@@ -0,0 +1,593 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <assert.h>
+#include <math.h>
+#include "par.h"
+#include "segy.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))
+
+#ifdef _OPENMP
+int omp_get_thread_num(void);
+#endif
+double wallclock_time(void);
+void name_ext(char *filename, char *extension);
+
+typedef struct { /* complex number */
+ float r,i;
+} complex;
+
+void cr1fft(complex *cdata, float *rdata, int n, int sign);
+int optncr(int n);
+
+int getFileInfo(char *filename, int *n1, int *n2, int *ngath, float *d1, float *d2, float *f1, float *f2, float *xmin, float *xmax, float *sclsxgx, int *nxm);
+
+int readShotData(char *filename, float xmin, float dx, float *xrcv, float *xsrc, int *xnx, complex *cdata, int nw, int nw_low, int ngath, int nx, int nxm, int ntfft, float alpha, float scl, float conjg, int transpose, int verbose);
+
+int deconvolve(complex *cA, complex *cB, complex *cC, complex *oBB, int nfreq, int nblock, size_t nstationA, size_t nstationB, float eps_a, float eps_r, float numacc, int eigenvalues, float *eigen, int rthm, int mdd, int conjgA, int conjgB, int verbose);
+
+void writeEigen(char *file_out, float df, int nw_low, int nw_high, int nw, float *eigen, int nx, float dx, float xmin);
+void writeDatamatrix(char *file_out, complex *P, int ntfft, int ntc, int Nrec, int Nshot, int nfreq, int nw_low, float dt, int verbose);
+
+void gausstaper(float *taper, float dx, int n, float enddecay);
+
+/**************
+* ntc output samples of deconvolution result
+* note that nt (the number of samples read by the IO routine)
+* should be 2*ntc and a number efficient for FFT's
+*/
+
+/*********************** self documentation **********************/
+char *sdoc[] = {
+" ",
+" mdd - multi-dimensional deconvolution (OpenMP)",
+" ",
+" mdd file_A= file_B= file_out= [optional parameters]",
+" ",
+" Required parameters: ",
+" ",
+" file_A= .................. name of file(s) which store the data in location A",
+" file_B= .................. name of file(s) which store the data in location B",
+" ",
+" Optional parameters: ",
+" ",
+" ntc=nt ................... number of output time samples",
+" ntfft=nt ................. number of samples used in fft",
+" fmin=0 ................... minimum frequency",
+" fmax=70 .................. maximum frequency to use in deconvolution",
+" INPUT DEFINITION ",
+" cjA=1 .................... -1 => apply complex conjugate to A",
+" sclA=1 ................... apply scaling factor to A",
+" tranposeA=0 .............. apply transpose to A",
+" cjB=1 .................... -1 => apply complex conjugate to B",
+" sclB=1 ................... apply scaling factor to B",
+" tranposeB=0 .............. apply transpose to B",
+" MATRIX INVERSION CALCULATION ",
+" conjgA=0 ................. apply complex conjugate-transpose to A",
+" conjgB=1 ................. apply complex conjugate-transpose to B",
+" rthm=0 ................... see below for options",
+" eps_a=1e-5 ............... absolute stabilization factor for LS",
+" eps_r=1e-4 ............... relative stabilization factor for LS",
+" numacc=1e-6 .............. numerical accurary for SVD",
+" ntap=0 ................... number of taper points matrix",
+" ftap=0 ................... percentage for tapering",
+" tap=0 .................... type of taper: 0=cos 1=exp",
+" eigenvalues= ............. write SVD eigenvalues to file ",
+" mdd=1 .................... mdd=0 => computes correlation ",
+" OUTPUT DEFINITION ",
+" file_out= ................ output base name ",
+" causal=1 ................. output causal(1), non-causal(2), both(3), or summed(4)",
+" one_file=1 ............... write all shots into one file ",
+" file_dmat= ............... if defined writes matrix in frequency domain",
+" verbose=0 ................ silent option; >0 displays info",
+" ",
+" Notes: ",
+" ntc output samples of deconvolution result",
+" nt (the number of samples read by the IO routine)",
+" ",
+" Options for mdd= ",
+" 2 = A/(B + eps) ",
+" 1 = A*B^H/(B*B^H + eps) ",
+" 0 = A*B^H ",
+" ",
+" Option for rthm= ",
+" 0 = Least Squares QR based inversion",
+" 1 = Least Squares LU based inversion",
+" 2 = SVD inversion single precision",
+" 3 = SVD divide-and-conquer method",
+" 4 = SVD inversion double precision",
+" 5 = Least Squares LU based inversion double precision",
+" 6 = Eigenvalue based (not yet working)",
+" ",
+" author : Jan Thorbecke : 2008 (j.w.thorbecke@tudelft.nl)",
+" ",
+NULL};
+/**************** end self doc ***********************************/
+
+int main (int argc, char **argv)
+{
+ FILE *fpin, *fpout;
+ int i, j, k, ret, nshots, ntraces;
+ int size, n1, n2, ntfft, nf, causal;
+ int verbose, fullcorr, ncorstat, err;
+ int nt, nc, ncc, ntc, nshotA, nshotB;
+ size_t nstationA, nstationB, nfreq, istation, jstation, iw;
+ int pgsz, istep,jstep;
+ int mdd;
+ int conjgA, conjgB;
+ int ntap, nxm, ngath, nw, nw_low, nw_high, eigenvalues, rthm, combine, distance;
+ size_t nwrite, cdatainSize, datainSize, cdataoutSize, stationSize, is;
+ float dx, dt, fmin, fmax, df, eps_r, eps_a, ftap, numacc;
+ float *rC, scl, *rl, *eigen;
+ float f1, f2, d1, d2, sclsxgx, xmin, xmax, alpha, wshot, wpi, wrec;
+ float *xrcvA, *xsrcA, *xrcvB, *xsrcB;
+ float *taper;
+ int *xnx;
+ float sclA,sclB, cjA, cjB;
+ int transposeA, transposeB;
+
+
+ complex *cdataout;
+ double t0, t1, t2, t3, tinit, twrite, tread, tdec, tfft;
+ char *file_A, *file_B, *file_out, *file_dmat, filename[1024], number[128], *rthmName;
+ int pe=0, root_pe=0, npes=1, ipe, size_s, one_file;
+ complex *cA, *cB, *oBB;
+ segy *hdr;
+
+ t0 = wallclock_time();
+ initargs(argc, argv);
+ requestdoc(1);
+
+ if (!getparint("verbose", &verbose)) verbose = 0;
+ if (!getparstring("file_A", &file_A)) file_A=NULL;
+ assert(file_A != NULL);
+ if (!getparstring("file_B", &file_B)) file_B=NULL;
+ assert(file_B != NULL);
+ if (!getparstring("file_out", &file_out)) file_out=NULL;
+ if (!getparstring("file_dmat", &file_dmat)) file_dmat=NULL;
+ if (!getparint("one_file", &one_file)) one_file = 1;
+
+ if (!getparfloat("fmin", &fmin)) fmin = 0.0;
+ if (!getparint("rthm", &rthm)) rthm = 0;
+ if (!getparint("combine", &combine)) combine = 0;
+ if (!getparint("causal", &causal)) causal = 1;
+ if (!getparint("ntap", &ntap)) ntap = 0;
+ if (!getparfloat("ftap", &ftap)) ftap = 0.;
+ if (!getparfloat("eps_r", &eps_r)) eps_r = 1e-4;
+ if (!getparfloat("eps_a", &eps_a)) eps_a = 1e-5;
+ if (!getparfloat("numacc", &numacc)) numacc = 1e-6;
+ if (!getparint("eigenvalues", &eigenvalues)) eigenvalues = 0;
+ if (!getparint("mdd", &mdd)) mdd = 1;
+
+ if (!getparint("transposeA", &transposeA)) transposeA = 0;
+ if (!getparfloat("sclA", &sclA)) sclA = 1.;
+ if (!getparfloat("cjA", &cjA)) cjA = 1.;
+ if (!getparint("transposeB", &transposeB)) transposeB = 0;
+ if (!getparfloat("sclB", &sclB)) sclB = 1.;
+ if (!getparfloat("cjB", &cjB)) cjB = 1.;
+
+#ifdef _OPENMP
+ npes = atoi(getenv("OMP_NUM_THREADS"));
+ assert(npes != 0);
+ if (verbose) fprintf(stderr,"Number of OpenMP thread's is %d\n", npes);
+#else
+ npes=1;
+#endif
+
+/* get information from input files */
+
+ nshotA = 0;
+ getFileInfo(file_A, &n1, &n2, &nshotA, &d1, &d2, &f1, &f2, &xmin, &xmax, &sclsxgx, &nxm);
+ if (!getparint("nt", &nt)) nt=n1;
+ if (!getparint("ntc", &ntc)) ntc = n1;
+ if (!getparint("conjgA", &conjgA)) conjgA = 0;
+ if (!getparint("conjgB", &conjgB)) conjgB = 1;
+ if (!getparfloat("dt", &dt)) dt = d1;
+ if (!getparfloat("dx", &dx)) dx = d2;
+ if (!getparfloat("fmax", &fmax)) fmax = 1.0/(2.0*dt);
+
+ nstationA = n2;
+
+ nshotB = 0;
+ getFileInfo(file_B, &n1, &n2, &nshotB, &d1, &d2, &f1, &f2, &xmin, &xmax, &sclsxgx, &nxm);
+ assert( n1 == nt);
+ nstationB = n2;
+ assert( nshotA == nshotB);
+
+/*================ initializations ================*/
+
+ tinit = 0.0;
+ tfft = 0.0;
+ tread = 0.0;
+ tdec = 0.0;
+
+ if (!getparint("ntfft", &ntfft)) ntfft = nt;
+ ntfft = optncr(ntfft);
+ nf = ntfft/2+1;
+ df = 1.0/(ntfft*dt);
+ nw_high = MIN( (int)((fmax)/df), nf );
+ nw_low = MAX( (int)(fmin/df), 1 );
+ nw = nw_high - nw_low + 1;
+ nfreq = MIN(nf,nw);
+
+/* scaling of the results by Johno van IJsseldijk */
+ if (mdd == 0) scl = dx*dt/((float)ntfft); //correlation
+ else if (mdd==1) scl = 1/((float)ntfft)/dx/dt; // MDD
+ else if (mdd==2) scl = 1/((float)ntfft)/dx/dt; // MDD with A and B already computed (NOT TESTED)
+ else scl = 1.0/((float)ntfft); // Passing A or B through
+
+/* allocate in shared memory the in- and output data */
+
+ jstep = nfreq*nshotA;
+ cdatainSize = nfreq*nshotA*sizeof(complex);
+ cdataoutSize = nstationA*nstationB*nfreq*sizeof(complex);
+ cdataout = (complex *)malloc(cdataoutSize);
+ cA = (complex *)malloc(nstationA*cdatainSize);
+ cB = (complex *)malloc(nstationB*cdatainSize);
+ taper = (float *)malloc(2*nstationB*sizeof(float));
+ if (file_dmat!=NULL) oBB = (complex *)malloc(nstationB*nstationB*nfreq*sizeof(complex));
+ else oBB = NULL;
+ assert(cdataout != NULL);
+ assert(cA != NULL);
+ assert(cB != NULL);
+
+
+/* for first touch binding of allocated memory */
+#pragma omp parallel for schedule(static) private(jstation,is) default(shared)
+ for (jstation=0; jstation<nstationB; jstation++) {
+ stationSize=nstationA*nfreq*sizeof(complex);
+ is = jstation*nstationA*nfreq;
+ memset(&cdataout[is],0,stationSize);
+ memset(&cB[jstation*jstep],0,jstep*sizeof(complex));
+ }
+
+#pragma omp parallel for schedule(static) private(jstation) default(shared)
+ for (jstation=0; jstation<nstationA; jstation++) {
+ memset(&cA[jstation*jstep],0,jstep*sizeof(complex));
+ }
+
+ if (verbose) {
+ if (rthm==0) rthmName="Cholesky";
+ else if (rthm==1) rthmName="LU";
+ else if (rthm==2) rthmName="SVD single precision";
+ else if (rthm==3) rthmName="SVD divide-and-conquer";
+ else if (rthm==4) rthmName="SVD double precision";
+ else if (rthm==5) rthmName="LU double precision";
+ else if (rthm==6) rthmName="Eigenvalue double precision";
+ fprintf(stderr,"--- Input Information ---\n");
+ fprintf(stderr," dt nt ............ : %f : %d\n", dt, nt);
+ fprintf(stderr," dx ............... : %f\n", dx);
+ fprintf(stderr," nshotA ........... : %d\n", nshotA );
+ fprintf(stderr," nstationA ........ : %ld\n", nstationA );
+ fprintf(stderr," nshotB ........... : %d\n", nshotB );
+ fprintf(stderr," nstationB ........ : %ld\n", nstationB );
+ fprintf(stderr," number t-fft ..... : %d\n", ntfft);
+ fprintf(stderr," Input size ...... : %ld MB\n", (nstationA+nstationB)*cdatainSize/(1024*1024));
+ fprintf(stderr," Output size ...... : %ld MB\n", (cdataoutSize/((size_t)1024*1024)));
+ fprintf(stderr," taper points ..... : %d (%.2f %%)\n", ntap, ftap*100.0);
+ fprintf(stderr," process number ... : %d\n", pe);
+ fprintf(stderr," fmin ............. : %.3f (%d)\n", fmin, nw_low);
+ fprintf(stderr," fmax ............. : %.3f (%d)\n", fmax, nw_high);
+ fprintf(stderr," nfreq ........... : %ld\n", nfreq);
+ if (mdd) fprintf(stderr," Matrix inversion . : %s\n", rthmName);
+ else fprintf(stderr," Correlation ...... : \n");
+ fprintf(stderr," eps_r ............ : %e\n", eps_r);
+ fprintf(stderr," eps_a ............ : %e\n", eps_a);
+ fprintf(stderr," mdd .............. : %d\n", mdd);
+ }
+
+ t1 = wallclock_time();
+ tinit += t1-t0;
+
+/* read in first nt samples, and store in data */
+
+ xsrcA = (float *)calloc(nshotA,sizeof(float));
+ xrcvA = (float *)calloc(nshotA*nstationA,sizeof(float));
+ xnx = (int *)calloc(nshotA,sizeof(int));
+ alpha = 0.0;
+ readShotData(file_A, xmin, dx, xrcvA, xsrcA, xnx, cA, nw, nw_low, nshotA, nstationA, nstationA, ntfft, alpha, sclA, cjA, transposeA, verbose);
+
+ xsrcB = (float *)calloc(nshotB,sizeof(float));
+ xrcvB = (float *)calloc(nshotB*nstationB,sizeof(float));
+ alpha = 0.0;
+ readShotData(file_B, xmin, dx, xrcvB, xsrcB, xnx, cB, nw, nw_low, nshotB, nstationB, nstationB, ntfft, alpha, sclB, cjB, transposeB, verbose);
+
+ //cB = cA;
+
+ eigen = (float *)malloc(nfreq*nstationB*sizeof(float));
+
+ t2 = wallclock_time();
+ tread += t2-t1;
+
+#pragma omp parallel default(none) \
+ private(t1,t2,pe) \
+ shared(cA,cB,eigen,eigenvalues,numacc,eps_r,eps_a) \
+ shared(nstationA,nstationB,verbose,cdatainSize) \
+ shared(rthm,mdd,nfreq,nshotA,conjgA,conjgB) \
+ shared(cdataout,oBB)
+{ /* start of OpenMP parallel part */
+
+
+#ifdef _OPENMP
+ pe = omp_get_thread_num();
+#endif
+
+ /* compute deconvolution */
+ deconvolve(cA, cB, cdataout, oBB, nfreq, nshotA, nstationA, nstationB,
+ eps_a, eps_r, numacc, eigenvalues, eigen, rthm, mdd, conjgA, conjgB, verbose);
+
+} /*end of parallel OpenMP part */
+
+ fflush(stderr);
+ fflush(stdout);
+
+ t3 = wallclock_time();
+ tdec += t3-t2;
+ if (verbose>=1) {
+ fprintf(stderr,"************* PE %d ************* \n", pe);
+ fprintf(stderr,"CPU-time read data = %.3f\n", tread);
+ fprintf(stderr,"CPU-time deconvolution = %.3f\n", tdec);
+ }
+
+/* for writing out combined shots cA */
+ free(cA);
+ free(cB);
+
+/* Inverse FFT of deconvolution results */
+/* This is done for every deconvolution component seperately */
+
+ rC = (float *)malloc(nstationA*ntc*sizeof(float));
+ assert(rC != NULL);
+
+/*
+#pragma omp parallel default(none) \
+ private(istation,jstation,pe,j,i,t1,t2,t3,hdr,rl) \
+ private(filename, k, fpout, nwrite, cA, iw,number) \
+ shared(tfft) \
+ shared(rC,dt,ntc,file_out) \
+ shared(nt,nstationA,nstationB,verbose,err,ntfft,t0,twrite) \
+ shared(nfreq,stderr,stdout, nshotA, nshotB, nw_low, causal) \
+ shared(cdataout,istep,jstep,one_file)
+*/
+//{ /* start of OpenMP parallel part */
+//#ifdef _OPENMP
+// pe = omp_get_thread_num();
+//#else
+ pe = 0;
+//#endif
+
+ rl = (float *)calloc(ntfft,sizeof(float));
+ cA = (complex *)calloc(ntfft,sizeof(complex));
+ hdr = (segy *)calloc(1,sizeof(segy));
+
+/* for writing out combined shots cA */
+
+ tfft = 0.0;
+ twrite = 0.0;
+ if (one_file && pe==0) {
+ strcpy(filename, file_out);
+ if (verbose>2) fprintf(stderr,"writing all output shot into file %s\n", filename);
+ fpout = fopen( filename, "w+" );
+ }
+//#pragma omp for
+ for (jstation=0; jstation<nstationB; jstation++) {
+ /* FFT */
+ t1 = wallclock_time();
+ for (istation=0; istation<nstationA; istation++) {
+ memset(cA,0,ntfft*sizeof(complex));
+ for (iw=0;iw<nfreq;iw++) {
+ cA[iw+nw_low].r = cdataout[(iw*nstationB+jstation)*nstationA+istation].r*scl;
+ cA[iw+nw_low].i = cdataout[(iw*nstationB+jstation)*nstationA+istation].i*scl;
+ }
+ cr1fft(cA, rl, ntfft, 1);
+ memcpy(&rC[istation*ntc],rl,ntc*sizeof(float));
+
+ if (causal==1) {
+ memcpy(&rC[istation*ntc],rl,ntc*sizeof(float));
+ }
+ else if (causal==2) {
+ rC[istation*ntc] = rl[0];
+ for (j=1;j<ntc; j++) {
+ rC[istation*ntc+j] = rl[ntfft-j];
+ }
+ }
+ else if (causal==3) {
+ for (j=1;j<=(ntc/2); j++) {
+ rC[istation*ntc+ntc/2-j] = rl[ntfft-j];
+ }
+ for (j=ntc/2;j<ntc; j++) {
+ rC[istation*ntc+j] = rl[j-ntc/2];
+ }
+ }
+ else if (causal==4) {
+ rC[istation*ntc] = rl[0];
+ for (j=1;j<ntc; j++) {
+ rC[istation*ntc+j] = rl[ntfft-j] + rl[j];
+ }
+ }
+ }
+ t2 = wallclock_time();
+ tfft += t2-t1;
+
+ if (pe == 0) {
+ /* write data to file */
+ hdr[0].d1 = dt;
+ if (causal == 3) hdr[0].f1=-0.5*ntc*dt;
+ else hdr[0].f1=0.0;
+ hdr[0].dt = (int)(dt*1000000);
+ hdr[0].ns = ntc;
+ hdr[0].fldr = jstation+1;
+ hdr[0].scalco = -1000;
+ hdr[0].scalel = -1000;
+ hdr[0].trid = 1;
+ hdr[0].f2 = f2;
+ hdr[0].d2 = dx;
+// hdr[0].trwf = nstationA;
+ hdr[0].sx = NINT((f2+dx*jstation)*1000);
+ hdr[0].ntr = nstationA*nstationB;
+ if (!one_file) {
+ strcpy(filename, file_out);
+ sprintf(number,"Station%03d\0",jstation+1);
+ name_ext(filename, number);
+ if (verbose>3) fprintf(stderr,"writing to file %s\n", filename);
+ fpout = fopen( filename, "w+" );
+ }
+ for (istation=0; istation<nstationA; istation++) {
+ hdr[0].tracl = istation+1;
+ hdr[0].gx = NINT((f2+dx*istation)*1000);
+ hdr[0].offset = NINT((f2+dx*istation));
+ nwrite = fwrite( hdr, 1, TRCBYTES, fpout );
+ assert (nwrite == TRCBYTES);
+ nwrite = fwrite( &rC[istation*ntc], sizeof(float), ntc, fpout );
+ assert (nwrite == ntc);
+ }
+ if (!one_file) {
+ fflush(fpout);
+ fclose(fpout);
+ }
+ t3 = wallclock_time();
+ twrite += t3-t2;
+// fprintf(stderr,"write %f and fft %f for %d\n",twrite, tfft, jstation);
+ }
+ }
+ if (one_file && pe==0) {
+ fflush(fpout);
+ fclose(fpout);
+ }
+ free(cA);
+ free(rl);
+//}
+
+ free(rC);
+ free(cdataout);
+
+ if (eigenvalues) {
+ writeEigen(file_out, df, nw_low, nw_high, nfreq, eigen, nstationB, dx, f2);
+ }
+ free(eigen);
+
+ /* if file_dmat write frequency slices of matrix */
+ if (file_dmat!=NULL) {
+ t2 = wallclock_time();
+ strcpy(filename, file_dmat);
+ fpout = fopen( filename, "w+" );
+ hdr[0].d1 = df;
+ hdr[0].dt = (int)(df*1000000);
+ hdr[0].ns = nfreq;
+ hdr[0].trid = 111;
+/*
+ for (iw=0;iw<nfreq;iw++) {
+ hdr[0].fldr = iw+1;
+// sprintf(number,"Station%03d\0",jstation+1);
+// name_ext(filename, number);
+// if (verbose>3) fprintf(stderr,"writing to file %s\n", filename);
+// fpout = fopen( filename, "w+" );
+ twrite = 0.0;
+ for (istation=0; istation<nstationB; istation++) {
+ hdr[0].tracl = istation+1;
+ nwrite = fwrite( hdr, 1, TRCBYTES, fpout );
+ assert (nwrite == TRCBYTES);
+// nwrite = fwrite( &oBB[iw*nstationB*nstationB+istation].r, sizeof(complex), nfreq, fpout );
+// assert (nwrite == nfreq);
+ }
+ }
+*/
+ fflush(fpout);
+ fclose(fpout);
+ t3 = wallclock_time();
+ twrite += t3-t2;
+ free(oBB);
+ }
+ free(hdr);
+
+/*================ end ================*/
+
+ if (verbose) {
+ t3 = wallclock_time();
+ fprintf(stderr,"CPU-time inverse FFT's = %.3f\n", tfft);
+ fprintf(stderr,"CPU-time write data = %.3f\n", twrite);
+ fprintf(stderr,"CPU-time initialization = %.3f\n", tinit);
+ fprintf(stderr,"Total CPU-time = %.3f\n", t3-t0);
+ }
+
+ return 0;
+}
+
+void gausstaper(float *taper, float dx, int n, float enddecay)
+{
+ int ix, hn;
+ float dist, sigma2;
+
+ if (enddecay > 0.999) {
+ for (ix = 0; ix < n; ix++) taper[ix] = 1.0;
+ return;
+ }
+
+ hn = (n-1)/2;
+ sigma2 = (hn*dx*hn*dx)/(log(enddecay));
+
+ for (ix = 0; ix <= hn; ix++) {
+ dist = ix*dx;
+ taper[hn+ix] = exp(dist*dist/sigma2);
+ }
+
+ for (ix = 0; ix < hn; ix++)
+ taper[ix] = taper[n-1-ix];
+
+ return;
+}
+
+void writeDatamatrix(char *file_out, complex *P, int ntfft, int ntc, int Nrec, int Nshot, int nfreq, int nw_low, float dt, int verbose)
+{
+ FILE *fpout;
+ char filename[1024];
+ size_t nwrite;
+ int jstation, istation, iw;
+ float *rl, *rC;
+ complex *cA;
+ segy *hdr;
+
+ rC = (float *)malloc(Nrec*ntc*sizeof(float));
+ rl = (float *)calloc(ntfft,sizeof(float));
+ cA = (complex *)calloc(ntfft,sizeof(complex));
+ hdr = (segy *)calloc(1,sizeof(segy));
+
+/* for writing out combined shots cA */
+
+ strcpy(filename, file_out);
+ if (verbose>2) fprintf(stderr,"writing all output shot into file %s\n", filename);
+ fpout = fopen( file_out, "w+" );
+ for (jstation=0; jstation<Nshot; jstation++) {
+
+ /* FFT */
+ for (istation=0; istation<Nrec; istation++) {
+ memset(cA,0,ntfft*sizeof(complex));
+ for (iw=0;iw<nfreq;iw++) {
+ cA[iw+nw_low] = P[(iw*Nshot+jstation)*Nrec+istation];
+ }
+ cr1fft(cA, rl, ntfft, 1);
+ memcpy(&rC[istation*ntc],rl,ntc*sizeof(float));
+ }
+
+ /* write data to file */
+ hdr[0].d1 = dt;
+ hdr[0].dt = (int)(dt*1000000);
+ hdr[0].ns = ntc;
+ hdr[0].fldr = jstation+1;
+ for (istation=0; istation<Nrec; istation++) {
+ hdr[0].tracl = istation+1;
+ nwrite = fwrite( hdr, 1, TRCBYTES, fpout );
+ assert (nwrite == TRCBYTES);
+ nwrite = fwrite( &rC[istation*ntc], sizeof(float), ntc, fpout );
+ assert (nwrite == ntc);
+ }
+ }
+
+ free(cA);
+ free(rl);
+ free(rC);
+ return;
+}
+
diff --git a/MDD/name_ext.c b/MDD/name_ext.c
new file mode 120000
index 0000000000000000000000000000000000000000..83ac1f8ddf2ec6a316557877ae7db38720a5ca53
--- /dev/null
+++ b/MDD/name_ext.c
@@ -0,0 +1 @@
+../utils/name_ext.c
\ No newline at end of file
diff --git a/MDD/par.h b/MDD/par.h
new file mode 120000
index 0000000000000000000000000000000000000000..0fa273cea748f9ead16e0e231201941174a3dd46
--- /dev/null
+++ b/MDD/par.h
@@ -0,0 +1 @@
+../utils/par.h
\ No newline at end of file
diff --git a/MDD/readShotData.c b/MDD/readShotData.c
new file mode 100644
index 0000000000000000000000000000000000000000..20f953e2ac140a6032ed3c71198e482ee06bb69f
--- /dev/null
+++ b/MDD/readShotData.c
@@ -0,0 +1,139 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <math.h>
+#include "segy.h"
+#include <assert.h>
+
+typedef struct { /* complex number */
+ float r,i;
+} complex;
+
+#define NINT(x) ((int)((x)>0.0?(x)+0.5:(x)-0.5))
+
+int optncr(int n);
+void cc1fft(complex *data, int n, int sign);
+void rc1fft(float *rdata, complex *cdata, int n, int sign);
+
+int compare(const void *a, const void *b)
+{ return (*(float *)b-*(float *)a); }
+
+int readShotData(char *filename, float xmin, float dx, float *xrcv, float *xsrc, int *xnx, complex *cdata, int nw, int nw_low, int ngath, int nx, int nxm, int ntfft, float alpha, float scale, float conjg, int transpose, int verbose)
+{
+ FILE *fp;
+ segy hdr;
+ size_t nread;
+ int fldr_shot, sx_shot, itrace, one_shot, igath, iw, i, j, k;
+ int end_of_file, nt, ir, is;
+ float scl, dt, *trace;
+ complex *ctrace;
+
+ /* Reading first header */
+
+ if (filename == NULL) fp = stdin;
+ else fp = fopen( filename, "r" );
+ if ( fp == NULL ) {
+ fprintf(stderr,"input file %s has an error\n", filename);
+ perror("error in opening file: ");
+ fflush(stderr);
+ return -1;
+ }
+
+ fseek(fp, 0, SEEK_SET);
+ 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;
+ fseek(fp, 0, SEEK_SET);
+
+ nt = hdr.ns;
+
+ trace = (float *)calloc(nx*ntfft,sizeof(float));
+ ctrace = (complex *)malloc(ntfft*sizeof(complex));
+
+ end_of_file = 0;
+ one_shot = 1;
+ igath = 0;
+
+ /* Read shots in file */
+
+ while (!end_of_file) {
+
+ /* start reading data (shot records) */
+ itrace = 0;
+ nread = fread( &hdr, 1, TRCBYTES, fp );
+ if (nread != TRCBYTES) { /* no more data in file */
+ break;
+ }
+
+ sx_shot = hdr.sx;
+ fldr_shot = hdr.fldr;
+ xsrc[igath] = sx_shot*scl;
+ xnx[igath]=0;
+ /* read in all traces within a shot */
+ while (one_shot) {
+ xrcv[igath*nxm+itrace] = hdr.gx*scl;
+ nread = fread( &trace[itrace*ntfft], sizeof(float), nt, fp );
+ assert (nread == hdr.ns);
+ itrace++;
+ xnx[igath]+=1;
+
+ /* read next hdr of next trace */
+ nread = fread( &hdr, 1, TRCBYTES, fp );
+ if (nread != TRCBYTES) {
+ one_shot = 0;
+ end_of_file = 1;
+ break;
+ }
+ if ((sx_shot != hdr.sx) || (fldr_shot != hdr.fldr) ) break;
+ }
+
+ for (i=0; i<itrace; i++) {
+ /* apply alpha factor */
+ if (alpha != 0.0) {
+ for (j=0; j<nt; j++) {
+ trace[i*ntfft+j] *= exp(alpha*j*dt);
+ }
+ }
+ for (j=nt; j<ntfft; j++) {
+ trace[i*ntfft+j] = 0.0;
+ }
+
+ /* transform to frequency domain */
+ rc1fft(&trace[i*ntfft],ctrace,ntfft,-1);
+
+ if (transpose == 0) {
+ for (iw=0; iw<nw; iw++) {
+ cdata[iw*ngath*nx+igath*nx+i].r = scale*ctrace[nw_low+iw].r;
+ cdata[iw*ngath*nx+igath*nx+i].i = conjg*scale*ctrace[nw_low+iw].i;
+ }
+ }
+ else {
+ for (iw=0; iw<nw; iw++) {
+ cdata[iw*ngath*nx+i*ngath+igath].r = scale*ctrace[nw_low+iw].r;
+ cdata[iw*ngath*nx+i*ngath+igath].i = conjg*scale*ctrace[nw_low+iw].i;
+ }
+ }
+ }
+
+ if (verbose>2) {
+ fprintf(stderr,"finished reading shot %d (%d) with %d traces\n",sx_shot,igath,itrace);
+ }
+
+ if (itrace != 0) { /* end of shot record */
+ fseek( fp, -TRCBYTES, SEEK_CUR );
+ igath++;
+ }
+ else {
+ end_of_file = 1;
+ }
+ }
+
+ free(ctrace);
+ free(trace);
+
+ return 0;
+}
+
+
diff --git a/MDD/segy.h b/MDD/segy.h
new file mode 100644
index 0000000000000000000000000000000000000000..d0a0d769d1548115b04396076b4a15d5be0ee687
--- /dev/null
+++ b/MDD/segy.h
@@ -0,0 +1,849 @@
+/* Copyright (c) Colorado School of Mines, 2011.*/
+/* All rights reserved. */
+
+/* segy.h - include file for SEGY traces
+ *
+ * declarations for:
+ * typedef struct {} segy - the trace identification header
+ * typedef struct {} bhed - binary header
+ *
+ * Note:
+ * If header words are added, run the makefile in this directory
+ * to recreate hdr.h.
+ *
+ * Reference:
+ * K. M. Barry, D. A. Cavers and C. W. Kneale, "Special Report:
+ * Recommended Standards for Digital Tape Formats",
+ * Geophysics, vol. 40, no. 2 (April 1975), P. 344-352.
+ *
+ * $Author: john $
+ * $Source: /usr/local/cwp/src/su/include/RCS/segy.h,v $
+ * $Revision: 1.33 $ ; $Date: 2011/11/11 23:56:14 $
+ */
+
+#include <limits.h>
+#include "par.h"
+
+#ifndef SEGY_H
+#define SEGY_H
+#define TRCBYTES 240
+
+#define SU_NFLTS 32767 /* Arbitrary limit on data array size */
+
+
+/* TYPEDEFS */
+typedef struct { /* segy - trace identification header */
+
+ int tracl; /* Trace sequence number within line
+ --numbers continue to increase if the
+ same line continues across multiple
+ SEG Y files.
+ byte# 1-4
+ */
+
+ int tracr; /* Trace sequence number within SEG Y file
+ ---each file starts with trace sequence
+ one
+ byte# 5-8
+ */
+
+ int fldr; /* Original field record number
+ byte# 9-12
+ */
+
+ int tracf; /* Trace number within original field record
+ byte# 13-16
+ */
+
+ int ep; /* energy source point number
+ ---Used when more than one record occurs
+ at the same effective surface location.
+ byte# 17-20
+ */
+
+ int cdp; /* Ensemble number (i.e. CDP, CMP, CRP,...)
+ byte# 21-24
+ */
+
+ int cdpt; /* trace number within the ensemble
+ ---each ensemble starts with trace number one.
+ byte# 25-28
+ */
+
+ short trid; /* trace identification code:
+ -1 = Other
+ 0 = Unknown
+ 1 = Seismic data
+ 2 = Dead
+ 3 = Dummy
+ 4 = Time break
+ 5 = Uphole
+ 6 = Sweep
+ 7 = Timing
+ 8 = Water break
+ 9 = Near-field gun signature
+ 10 = Far-field gun signature
+ 11 = Seismic pressure sensor
+ 12 = Multicomponent seismic sensor
+ - Vertical component
+ 13 = Multicomponent seismic sensor
+ - Cross-line component
+ 14 = Multicomponent seismic sensor
+ - in-line component
+ 15 = Rotated multicomponent seismic sensor
+ - Vertical component
+ 16 = Rotated multicomponent seismic sensor
+ - Transverse component
+ 17 = Rotated multicomponent seismic sensor
+ - Radial component
+ 18 = Vibrator reaction mass
+ 19 = Vibrator baseplate
+ 20 = Vibrator estimated ground force
+ 21 = Vibrator reference
+ 22 = Time-velocity pairs
+ 23 ... N = optional use
+ (maximum N = 32,767)
+
+ Following are CWP id flags:
+
+ 109 = autocorrelation
+ 110 = Fourier transformed - no packing
+ xr[0],xi[0], ..., xr[N-1],xi[N-1]
+ 111 = Fourier transformed - unpacked Nyquist
+ xr[0],xi[0],...,xr[N/2],xi[N/2]
+ 112 = Fourier transformed - packed Nyquist
+ even N:
+ xr[0],xr[N/2],xr[1],xi[1], ...,
+ xr[N/2 -1],xi[N/2 -1]
+ (note the exceptional second entry)
+ odd N:
+ xr[0],xr[(N-1)/2],xr[1],xi[1], ...,
+ xr[(N-1)/2 -1],xi[(N-1)/2 -1],xi[(N-1)/2]
+ (note the exceptional second & last entries)
+ 113 = Complex signal in the time domain
+ xr[0],xi[0], ..., xr[N-1],xi[N-1]
+ 114 = Fourier transformed - amplitude/phase
+ a[0],p[0], ..., a[N-1],p[N-1]
+ 115 = Complex time signal - amplitude/phase
+ a[0],p[0], ..., a[N-1],p[N-1]
+ 116 = Real part of complex trace from 0 to Nyquist
+ 117 = Imag part of complex trace from 0 to Nyquist
+ 118 = Amplitude of complex trace from 0 to Nyquist
+ 119 = Phase of complex trace from 0 to Nyquist
+ 121 = Wavenumber time domain (k-t)
+ 122 = Wavenumber frequency (k-omega)
+ 123 = Envelope of the complex time trace
+ 124 = Phase of the complex time trace
+ 125 = Frequency of the complex time trace
+ 130 = Depth-Range (z-x) traces
+ 201 = Seismic data packed to bytes (by supack1)
+ 202 = Seismic data packed to 2 bytes (by supack2)
+ byte# 29-30
+ */
+
+ short nvs; /* Number of vertically summed traces yielding
+ this trace. (1 is one trace,
+ 2 is two summed traces, etc.)
+ byte# 31-32
+ */
+
+ short nhs; /* Number of horizontally summed traces yielding
+ this trace. (1 is one trace
+ 2 is two summed traces, etc.)
+ byte# 33-34
+ */
+
+ short duse; /* Data use:
+ 1 = Production
+ 2 = Test
+ byte# 35-36
+ */
+
+ int offset; /* Distance from the center of the source point
+ to the center of the receiver group
+ (negative if opposite to direction in which
+ the line was shot).
+ byte# 37-40
+ */
+
+ int gelev; /* Receiver group elevation from sea level
+ (all elevations above the Vertical datum are
+ positive and below are negative).
+ byte# 41-44
+ */
+
+ int selev; /* Surface elevation at source.
+ byte# 45-48
+ */
+
+ int sdepth; /* Source depth below surface (a positive number).
+ byte# 49-52
+ */
+
+ int gdel; /* Datum elevation at receiver group.
+ byte# 53-56
+ */
+
+ int sdel; /* Datum elevation at source.
+ byte# 57-60
+ */
+
+ int swdep; /* Water depth at source.
+ byte# 61-64
+ */
+
+ int gwdep; /* Water depth at receiver group.
+ byte# 65-68
+ */
+
+ short scalel; /* Scalar to be applied to the previous 7 entries
+ to give the real value.
+ Scalar = 1, +10, +100, +1000, +10000.
+ If positive, scalar is used as a multiplier,
+ if negative, scalar is used as a divisor.
+ byte# 69-70
+ */
+
+ short scalco; /* Scalar to be applied to the next 4 entries
+ to give the real value.
+ Scalar = 1, +10, +100, +1000, +10000.
+ If positive, scalar is used as a multiplier,
+ if negative, scalar is used as a divisor.
+ byte# 71-72
+ */
+
+ int sx; /* Source coordinate - X
+ byte# 73-76
+ */
+
+ int sy; /* Source coordinate - Y
+ byte# 77-80
+ */
+
+ int gx; /* Group coordinate - X
+ byte# 81-84
+ */
+
+ int gy; /* Group coordinate - Y
+ byte# 85-88
+ */
+
+ short counit; /* Coordinate units: (for previous 4 entries and
+ for the 7 entries before scalel)
+ 1 = Length (meters or feet)
+ 2 = Seconds of arc
+ 3 = Decimal degrees
+ 4 = Degrees, minutes, seconds (DMS)
+
+ In case 2, the X values are longitude and
+ the Y values are latitude, a positive value designates
+ the number of seconds east of Greenwich
+ or north of the equator
+
+ In case 4, to encode +-DDDMMSS
+ counit = +-DDD*10^4 + MM*10^2 + SS,
+ with scalco = 1. To encode +-DDDMMSS.ss
+ counit = +-DDD*10^6 + MM*10^4 + SS*10^2
+ with scalco = -100.
+ byte# 89-90
+ */
+
+ short wevel; /* Weathering velocity.
+ byte# 91-92
+ */
+
+ short swevel; /* Subweathering velocity.
+ byte# 93-94
+ */
+
+ short sut; /* Uphole time at source in milliseconds.
+ byte# 95-96
+ */
+
+ short gut; /* Uphole time at receiver group in milliseconds.
+ byte# 97-98
+ */
+
+ short sstat; /* Source static correction in milliseconds.
+ byte# 99-100
+ */
+
+ short gstat; /* Group static correction in milliseconds.
+ byte# 101-102
+ */
+
+ short tstat; /* Total static applied in milliseconds.
+ (Zero if no static has been applied.)
+ byte# 103-104
+ */
+
+ short laga; /* Lag time A, time in ms between end of 240-
+ byte trace identification header and time
+ break, positive if time break occurs after
+ end of header, time break is defined as
+ the initiation pulse which maybe recorded
+ on an auxiliary trace or as otherwise
+ specified by the recording system
+ byte# 105-106
+ */
+
+ short lagb; /* lag time B, time in ms between the time break
+ and the initiation time of the energy source,
+ may be positive or negative
+ byte# 107-108
+ */
+
+ short delrt; /* delay recording time, time in ms between
+ initiation time of energy source and time
+ when recording of data samples begins
+ (for deep water work if recording does not
+ start at zero time)
+ byte# 109-110
+ */
+
+ short muts; /* mute time--start
+ byte# 111-112
+ */
+
+ short mute; /* mute time--end
+ byte# 113-114
+ */
+
+ unsigned short ns; /* number of samples in this trace
+ byte# 115-116
+ */
+
+ unsigned short dt; /* sample interval; in micro-seconds
+ byte# 117-118
+ */
+
+ short gain; /* gain type of field instruments code:
+ 1 = fixed
+ 2 = binary
+ 3 = floating point
+ 4 ---- N = optional use
+ byte# 119-120
+ */
+
+ short igc; /* instrument gain constant
+ byte# 121-122
+ */
+
+ short igi; /* instrument early or initial gain
+ byte# 123-124
+ */
+
+ short corr; /* correlated:
+ 1 = no
+ 2 = yes
+ byte# 125-126
+ */
+
+ short sfs; /* sweep frequency at start
+ byte# 127-128
+ */
+
+ short sfe; /* sweep frequency at end
+ byte# 129-130
+ */
+
+ short slen; /* sweep length in ms
+ byte# 131-132
+ */
+
+ short styp; /* sweep type code:
+ 1 = linear
+ 2 = cos-squared
+ 3 = other
+ byte# 133-134
+ */
+
+ short stas; /* sweep trace length at start in ms
+ byte# 135-136
+ */
+
+ short stae; /* sweep trace length at end in ms
+ byte# 137-138
+ */
+
+ short tatyp; /* taper type: 1=linear, 2=cos^2, 3=other
+ byte# 139-140
+ */
+
+ short afilf; /* alias filter frequency if used
+ byte# 141-142
+ */
+
+ short afils; /* alias filter slope
+ byte# 143-144
+ */
+
+ short nofilf; /* notch filter frequency if used
+ byte# 145-146
+ */
+
+ short nofils; /* notch filter slope
+ byte# 147-148
+ */
+
+ short lcf; /* low cut frequency if used
+ byte# 149-150
+ */
+
+ short hcf; /* high cut frequncy if used
+ byte# 151-152
+ */
+
+ short lcs; /* low cut slope
+ byte# 153-154
+ */
+
+ short hcs; /* high cut slope
+ byte# 155-156
+ */
+
+ short year; /* year data recorded
+ byte# 157-158
+ */
+
+ short day; /* day of year
+ byte# 159-160
+ */
+
+ short hour; /* hour of day (24 hour clock)
+ byte# 161-162
+ */
+
+ short minute; /* minute of hour
+ byte# 163-164
+ */
+
+ short sec; /* second of minute
+ byte# 165-166
+ */
+
+ short timbas; /* time basis code:
+ 1 = local
+ 2 = GMT
+ 3 = other
+ byte# 167-168
+ */
+
+ short trwf; /* trace weighting factor, defined as 1/2^N
+ volts for the least sigificant bit
+ byte# 169-170
+ */
+
+ short grnors; /* geophone group number of roll switch
+ position one
+ byte# 171-172
+ */
+
+ short grnofr; /* geophone group number of trace one within
+ original field record
+ byte# 173-174
+ */
+
+ short grnlof; /* geophone group number of last trace within
+ original field record
+ byte# 175-176
+ */
+
+ short gaps; /* gap size (total number of groups dropped)
+ byte# 177-178
+ */
+
+ short otrav; /* overtravel taper code:
+ 1 = down (or behind)
+ 2 = up (or ahead)
+ byte# 179-180
+ */
+
+#ifdef SLTSU_SEGY_H /* begin Unocal SU segy.h differences */
+
+
+ /* cwp local assignments */
+ float d1; /* sample spacing for non-seismic data
+ byte# 181-184
+ */
+
+ float f1; /* first sample location for non-seismic data
+ byte# 185-188
+ */
+
+ float d2; /* sample spacing between traces
+ byte# 189-192
+ */
+
+ float f2; /* first trace location
+ byte# 193-196
+ */
+
+ float ungpow; /* negative of power used for dynamic
+ range compression
+ byte# 197-200
+ */
+
+ float unscale; /* reciprocal of scaling factor to normalize
+ range
+ byte# 201-204
+ */
+
+ short mark; /* mark selected traces
+ byte# 205-206
+ */
+
+ /* SLTSU local assignments */
+ short mutb; /* mute time at bottom (start time)
+ bottom mute ends at last sample
+ byte# 207-208
+ */
+ float dz; /* depth sampling interval in (m or ft)
+ if =0.0, input are time samples
+ byte# 209-212
+ */
+
+ float fz; /* depth of first sample in (m or ft)
+ byte# 213-116
+ */
+
+ short n2; /* number of traces per cdp or per shot
+ byte# 217-218
+ */
+
+ short shortpad; /* alignment padding
+ byte# 219-220
+ */
+
+ int ntr; /* number of traces
+ byte# 221-224
+ */
+
+ /* SLTSU local assignments end */
+
+ short unass[8]; /* unassigned
+ byte# 225-240
+ */
+
+#else
+
+ /* cwp local assignments */
+ float d1; /* sample spacing for non-seismic data
+ byte# 181-184
+ */
+
+ float f1; /* first sample location for non-seismic data
+ byte# 185-188
+ */
+
+ float d2; /* sample spacing between traces
+ byte# 189-192
+ */
+
+ float f2; /* first trace location
+ byte# 193-196
+ */
+
+ float ungpow; /* negative of power used for dynamic
+ range compression
+ byte# 197-200
+ */
+
+ float unscale; /* reciprocal of scaling factor to normalize
+ range
+ byte# 201-204
+ */
+
+ int ntr; /* number of traces
+ byte# 205-208
+ */
+
+ short mark; /* mark selected traces
+ byte# 209-210
+ */
+
+ short shortpad; /* alignment padding
+ byte# 211-212
+ */
+
+
+ short unass[14]; /* unassigned--NOTE: last entry causes
+ a break in the word alignment, if we REALLY
+ want to maintain 240 bytes, the following
+ entry should be an odd number of short/UINT2
+ OR do the insertion above the "mark" keyword
+ entry
+ byte# 213-240
+ */
+#endif
+
+} segy;
+
+
+typedef struct { /* bhed - binary header */
+
+ int jobid; /* job identification number */
+
+ int lino; /* line number (only one line per reel) */
+
+ int reno; /* reel number */
+
+ short ntrpr; /* number of data traces per record */
+
+ short nart; /* number of auxiliary traces per record */
+
+ unsigned short hdt; /* sample interval in micro secs for this reel */
+
+ unsigned short dto; /* same for original field recording */
+
+ unsigned short hns; /* number of samples per trace for this reel */
+
+ unsigned short nso; /* same for original field recording */
+
+ short format; /* data sample format code:
+ 1 = floating point, 4 byte (32 bits)
+ 2 = fixed point, 4 byte (32 bits)
+ 3 = fixed point, 2 byte (16 bits)
+ 4 = fixed point w/gain code, 4 byte (32 bits)
+ 5 = IEEE floating point, 4 byte (32 bits)
+ 8 = two's complement integer, 1 byte (8 bits)
+ */
+
+ short fold; /* CDP fold expected per CDP ensemble */
+
+ short tsort; /* trace sorting code:
+ 1 = as recorded (no sorting)
+ 2 = CDP ensemble
+ 3 = single fold continuous profile
+ 4 = horizontally stacked */
+
+ short vscode; /* vertical sum code:
+ 1 = no sum
+ 2 = two sum ...
+ N = N sum (N = 32,767) */
+
+ short hsfs; /* sweep frequency at start */
+
+ short hsfe; /* sweep frequency at end */
+
+ short hslen; /* sweep length (ms) */
+
+ short hstyp; /* sweep type code:
+ 1 = linear
+ 2 = parabolic
+ 3 = exponential
+ 4 = other */
+
+ short schn; /* trace number of sweep channel */
+
+ short hstas; /* sweep trace taper length at start if
+ tapered (the taper starts at zero time
+ and is effective for this length) */
+
+ short hstae; /* sweep trace taper length at end (the ending
+ taper starts at sweep length minus the taper
+ length at end) */
+
+ short htatyp; /* sweep trace taper type code:
+ 1 = linear
+ 2 = cos-squared
+ 3 = other */
+
+ short hcorr; /* correlated data traces code:
+ 1 = no
+ 2 = yes */
+
+ short bgrcv; /* binary gain recovered code:
+ 1 = yes
+ 2 = no */
+
+ short rcvm; /* amplitude recovery method code:
+ 1 = none
+ 2 = spherical divergence
+ 3 = AGC
+ 4 = other */
+
+ short mfeet; /* measurement system code:
+ 1 = meters
+ 2 = feet */
+
+ short polyt; /* impulse signal polarity code:
+ 1 = increase in pressure or upward
+ geophone case movement gives
+ negative number on tape
+ 2 = increase in pressure or upward
+ geophone case movement gives
+ positive number on tape */
+
+ short vpol; /* vibratory polarity code:
+ code seismic signal lags pilot by
+ 1 337.5 to 22.5 degrees
+ 2 22.5 to 67.5 degrees
+ 3 67.5 to 112.5 degrees
+ 4 112.5 to 157.5 degrees
+ 5 157.5 to 202.5 degrees
+ 6 202.5 to 247.5 degrees
+ 7 247.5 to 292.5 degrees
+ 8 293.5 to 337.5 degrees */
+
+ short hunass[170]; /* unassigned */
+
+} bhed;
+
+/* DEFINES */
+#define gettr(x) fgettr(stdin, (x))
+#define vgettr(x) fvgettr(stdin, (x))
+#define puttr(x) fputtr(stdout, (x))
+#define vputtr(x) fvputtr(stdout, (x))
+#define gettra(x, y) fgettra(stdin, (x), (y))
+
+
+/* TOTHER represents "other" */
+#define TOTHER -1
+/* TUNK represents time traces of an unknown type */
+#define TUNK 0
+/* TREAL represents real time traces */
+#define TREAL 1
+/* TDEAD represents dead time traces */
+#define TDEAD 2
+/* TDUMMY represents dummy time traces */
+#define TDUMMY 3
+/* TBREAK represents time break traces */
+#define TBREAK 4
+/* UPHOLE represents uphole traces */
+#define UPHOLE 5
+/* SWEEP represents sweep traces */
+#define SWEEP 6
+/* TIMING represents timing traces */
+#define TIMING 7
+/* WBREAK represents timing traces */
+#define WBREAK 8
+/* NFGUNSIG represents near field gun signature */
+#define NFGUNSIG 9
+/* FFGUNSIG represents far field gun signature */
+#define FFGUNSIG 10
+/* SPSENSOR represents seismic pressure sensor */
+#define SPSENSOR 11
+/* TVERT represents multicomponent seismic sensor
+ - vertical component */
+#define TVERT 12
+/* TXLIN represents multicomponent seismic sensor
+ - cross-line component */
+#define TXLIN 13
+/* TINLIN represents multicomponent seismic sensor
+ - in-line component */
+#define TINLIN 14
+/* ROTVERT represents rotated multicomponent seismic sensor
+ - vertical component */
+#define ROTVERT 15
+/* TTRANS represents rotated multicomponent seismic sensor
+ - transverse component */
+#define TTRANS 16
+/* TRADIAL represents rotated multicomponent seismic sensor
+ - radial component */
+#define TRADIAL 17
+/* VRMASS represents vibrator reaction mass */
+#define VRMASS 18
+/* VBASS represents vibrator baseplate */
+#define VBASS 19
+/* VEGF represents vibrator estimated ground force */
+#define VEGF 20
+/* VREF represents vibrator reference */
+#define VREF 21
+
+/*** CWP trid assignments ***/
+/* ACOR represents autocorrelation */
+#define ACOR 109
+/* FCMPLX represents fourier transformed - no packing
+ xr[0],xi[0], ..., xr[N-1],xi[N-1] */
+#define FCMPLX 110
+/* FUNPACKNYQ represents fourier transformed - unpacked Nyquist
+ xr[0],xi[0],...,xr[N/2],xi[N/2] */
+#define FUNPACKNYQ 111
+/* FTPACK represents fourier transformed - packed Nyquist
+ even N: xr[0],xr[N/2],xr[1],xi[1], ...,
+ xr[N/2 -1],xi[N/2 -1]
+ (note the exceptional second entry)
+ odd N:
+ xr[0],xr[(N-1)/2],xr[1],xi[1], ...,
+ xr[(N-1)/2 -1],xi[(N-1)/2 -1],xi[(N-1)/2]
+ (note the exceptional second & last entries)
+*/
+#define FTPACK 112
+/* TCMPLX represents complex time traces */
+#define TCMPLX 113
+/* FAMPH represents freq domain data in amplitude/phase form */
+#define FAMPH 114
+/* TAMPH represents time domain data in amplitude/phase form */
+#define TAMPH 115
+/* REALPART represents the real part of a trace to Nyquist */
+#define REALPART 116
+/* IMAGPART represents the real part of a trace to Nyquist */
+#define IMAGPART 117
+/* AMPLITUDE represents the amplitude of a trace to Nyquist */
+#define AMPLITUDE 118
+/* PHASE represents the phase of a trace to Nyquist */
+#define PHASE 119
+/* KT represents wavenumber-time domain data */
+#define KT 121
+/* KOMEGA represents wavenumber-frequency domain data */
+#define KOMEGA 122
+/* ENVELOPE represents the envelope of the complex time trace */
+#define ENVELOPE 123
+/* INSTPHASE represents the phase of the complex time trace */
+#define INSTPHASE 124
+/* INSTFREQ represents the frequency of the complex time trace */
+#define INSTFREQ 125
+/* DEPTH represents traces in depth-range (z-x) */
+#define TRID_DEPTH 130
+/* 3C data... v,h1,h2=(11,12,13)+32 so a bitmask will convert */
+/* between conventions */
+/* CHARPACK represents byte packed seismic data from supack1 */
+#define CHARPACK 201
+/* SHORTPACK represents 2 byte packed seismic data from supack2 */
+#define SHORTPACK 202
+
+
+#define ISSEISMIC(id) (( (id)==TUNK || (id)==TREAL || (id)==TDEAD || (id)==TDUMMY || (id)==TBREAK || (id)==UPHOLE || (id)==SWEEP || (id)==TIMING || (id)==WBREAK || (id)==NFGUNSIG || (id)==FFGUNSIG || (id)==SPSENSOR || (id)==TVERT || (id)==TXLIN || (id)==TINLIN || (id)==ROTVERT || (id)==TTRANS || (id)==TRADIAL || (id)==ACOR ) ? cwp_true : cwp_false )
+
+/* FUNCTION PROTOTYPES */
+#ifdef __cplusplus /* if C++, specify external linkage to C functions */
+extern "C" {
+#endif
+
+/* get trace and put trace */
+int fgettr(FILE *fp, segy *tp);
+int fvgettr(FILE *fp, segy *tp);
+void fputtr(FILE *fp, segy *tp);
+void fvputtr(FILE *fp, segy *tp);
+int fgettra(FILE *fp, segy *tp, int itr);
+
+/* get gather and put gather */
+segy **fget_gather(FILE *fp, cwp_String *key,cwp_String *type,Value *n_val,
+ int *nt,int *ntr, float *dt,int *first);
+segy **get_gather(cwp_String *key, cwp_String *type, Value *n_val,
+ int *nt, int *ntr, float *dt, int *first);
+segy **fput_gather(FILE *fp, segy **rec,int *nt, int *ntr);
+segy **put_gather(segy **rec,int *nt, int *ntr);
+
+/* hdrpkge */
+void gethval(const segy *tp, int index, Value *valp);
+void puthval(segy *tp, int index, Value *valp);
+void getbhval(const bhed *bhp, int index, Value *valp);
+void putbhval(bhed *bhp, int index, Value *valp);
+void gethdval(const segy *tp, char *key, Value *valp);
+void puthdval(segy *tp, char *key, Value *valp);
+char *hdtype(const char *key);
+char *getkey(const int index);
+int getindex(const char *key);
+void swaphval(segy *tp, int index);
+void swapbhval(bhed *bhp, int index);
+void printheader(const segy *tp);
+
+void tabplot(segy *tp, int itmin, int itmax);
+
+#ifdef __cplusplus /* if C++, end external linkage specification */
+}
+#endif
+
+#endif
diff --git a/MDD/verbosepkg.c b/MDD/verbosepkg.c
new file mode 120000
index 0000000000000000000000000000000000000000..248253edebc2c7b207e139ecf16b68b318f057df
--- /dev/null
+++ b/MDD/verbosepkg.c
@@ -0,0 +1 @@
+../utils/verbosepkg.c
\ No newline at end of file
diff --git a/MDD/wallclock_time.c b/MDD/wallclock_time.c
new file mode 120000
index 0000000000000000000000000000000000000000..0bd00b4c2878f007a8dc398f0af7c7cb44f50717
--- /dev/null
+++ b/MDD/wallclock_time.c
@@ -0,0 +1 @@
+../utils/wallclock_time.c
\ No newline at end of file
diff --git a/MDD/writeEigen.c b/MDD/writeEigen.c
new file mode 100644
index 0000000000000000000000000000000000000000..e2ede69a44b6d140fde868b3ce89f7e28331cb28
--- /dev/null
+++ b/MDD/writeEigen.c
@@ -0,0 +1,55 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "segy.h"
+#include <assert.h>
+
+
+void writeEigen(char *file_out, float df, int nw_low, int nw_high, int nw, float *eigen, int nx, float dx, float xmin)
+{
+ static FILE *out_file;
+ float *trace, scl, re, im;
+ int sign, ntfft, i, j, ie, iw, count;
+ segy *hdrs_out;
+ size_t nwrite;
+ char filename[256], ext[32];
+
+ trace = (float *)malloc(nx*sizeof(float));
+ hdrs_out = (segy *)calloc(TRCBYTES,1);
+
+ hdrs_out[0].dt=df*1000000;
+ hdrs_out[0].trid = 1;
+ hdrs_out[0].ns = nx;
+ hdrs_out[0].d1 = 1;
+ hdrs_out[0].f1 = 1;
+ hdrs_out[0].f2 = nw_low*df;
+ hdrs_out[0].d2 = df;
+ hdrs_out[0].trwf = nw;
+ hdrs_out[0].fldr = 1;
+
+ strcpy(filename, file_out);
+ sprintf(ext,"%s.su", "_eigen");
+ strcpy(strstr(filename, ".su"), ext);
+ out_file = fopen(filename, "w+"); assert( out_file );
+ fprintf(stderr,"writing eigenvalues of matrix to %s\n", filename);
+ count=1;
+
+ for (iw=0; iw<nw; iw++) {
+ hdrs_out[0].tracl = iw+1;
+ for (i = 0; i < nx; i++) {
+ trace[i] = eigen[iw*nx+i];
+ }
+ nwrite = fwrite(&hdrs_out[0], 1, TRCBYTES, out_file);
+ assert( nwrite == TRCBYTES );
+ nwrite = fwrite(trace, sizeof(float), nx, out_file);
+ assert( nwrite == nx );
+ }
+ fflush(out_file);
+ fclose(out_file);
+
+ free(hdrs_out);
+ free(trace);
+
+ return;
+}
+
diff --git a/Make_include_template b/Make_include_template
index 6d0d98175c624b2cd9899cd774f3a7b7e876d679..5c3fc502e227ad0185e74df10ef4a1fb5d57b628 100644
--- a/Make_include_template
+++ b/Make_include_template
@@ -8,6 +8,12 @@
# the current directory (in vi ":r!pwd")
ROOT=/Users/jan/src/OpenSource
+#############################################################################
+# Some convenient abbreviations
+B = $(ROOT)/bin
+I = $(ROOT)/include
+L = $(ROOT)/lib
+
########################################################################
# C compiler; change this only if you are using a different C-compiler
@@ -41,7 +47,7 @@ OPTC += -fopenmp
### Linux
##OPTC = -O3 -no-prec-div -qopt-report-phase=vec,openmp
##OPTF = -O3 -no-prec-div -qopt-report-phase=vec,openmp
-#OPTC = -O3 -no-prec-div -xCORE-AVX2
+#OPTC = -O3 -no-prec-div -xCORE-AVX2
#OPTF = -O3 -no-prec-div -xCORE-AVX2
##to include parallelisation with OpenMP
#OPTC += -qopenmp
@@ -75,19 +81,40 @@ OPTC += -fopenmp
#OPTF = -Ofast
#LDFLAGS = -static -Ofast
+#############################################################################
+# BLAS and LAPACK libraries
+MKLROOT=/opt/intel/mkl/
+MKLLIB=${MKLROOT}/lib
+#for GNU compilers
+#you might need to add intel64 to : ${MKLROOT}/lib/intel64
+BLAS = -L${MKLROOT}/lib/ -lmkl_gf_lp64 -lmkl_sequential -lmkl_core -lpthread -lm -ldl
+#on linux you want to use groups and MKL is in lib/intel64
+#MKLLIB=${MKLROOT}/lib/intel64
+#BLAS = -Wl,-rpath ${MKLLIB} -Wl,--start-group -L${MKLLIB} -lmkl_gf_lp64 -lmkl_sequential -lmkl_core -Wl,--end-group -lpthread -lm -ldl
+#for intel compilers
+#BLAS = -mkl
+
#############################################################################
# FOR FFT LIBRARIES
#AMD ACML 4.4.0
#AMDROOT = /home/thorbcke/amdsdk/v1.0/acml/open64_64
#OPTC += -DACML440 -I$(AMDROOT)/include
-#LIBSM = -L$(AMDROOT)/lib -lacml -lfortran -lffio -lrt -lm
-
-#############################################################################
-# Some convenient abbreviations
+#BLAS = -L$(AMDROOT)/lib -lacml -lfortran -lffio -lrt -lm
+#Intel MKL
+MKLROOT=/opt/intel/mkl/
+MKLLIB=${MKLROOT}/lib
+OPTC += -DMKL -I$(MKLROOT)/include
+#for GNU compilers
+FFT = -Wl,-rpath ${MKLLIB} -L${MKLLIB} -lmkl_gf_lp64 -lmkl_sequential -lmkl_core -lpthread -lm -ldl
+#on linux you want to use groups and MKL is in lib/intel64
+#MKLLIB=${MKLROOT}/lib/intel64
+#FFT = -Wl,-rpath ${MKLLIB} -Wl,--start-group -L${MKLLIB} -lmkl_gf_lp64 -lmkl_sequential -lmkl_core -Wl,--end-group -lpthread -lm -ldl
+#for Intel compilers
+#FFT = -Wl,-rpath ${MKLLIB} -Wl,--start-group -L${MKLLIB} -lmkl_intel_lp64 -lmkl_sequential -lmkl_core -Wl,--end-group -lpthread -lm -ldl
+
+#LIBARIES
+LIBS= -L$L -lgenfft $(FFT) $(BLAS)
-B = $(ROOT)/bin
-I = $(ROOT)/include
-L = $(ROOT)/lib
########################################################################
# standard CFLAGS
diff --git a/Makefile b/Makefile
index b85040fdfba64a2b9366a7c20369765ba55c5119..74e45defbad119dcd86d34c28ca92712ca38f366 100644
--- a/Makefile
+++ b/Makefile
@@ -7,6 +7,7 @@ all: mkdirs
cd marchenko ; $(MAKE) install
cd corrvir ; $(MAKE) install
cd raytime ; $(MAKE) install
+ cd MDD ; $(MAKE) install
mkdirs:
-mkdir -p lib
@@ -20,6 +21,7 @@ clean:
cd marchenko ; $(MAKE) $@
cd corrvir ; $(MAKE) $@
cd raytime ; $(MAKE) $@
+ cd MDD ; $(MAKE) $@
realclean:
cd FFTlib ; $(MAKE) $@
@@ -28,6 +30,7 @@ realclean:
cd marchenko ; $(MAKE) $@
cd corrvir ; $(MAKE) $@
cd raytime ; $(MAKE) $@
+ cd MDD ; $(MAKE) $@
rm -f lib/*
rm -f include/*
rm -f bin/*
diff --git a/README b/README
index cd9fd1be8ad0481a9664e3c57ad9de9b200732b0..16f6b372e69c416c32efe670171e40dc75afd046 100644
--- a/README
+++ b/README
@@ -88,6 +88,18 @@ To reproduce the Figures shown in the GEOPHYICS paper "Implementation of the Mar
To reproduce the Figures shown in the Scientific Reports paper "Virtual acoustics in inhomogeneous media with single-sided access" the scripts in marchenko/demo/ScientificReports directory can be used. The README in this directory gives more instructions and guidelines.
+MDD
+---
+The MDD kernels depend on BLAS and LAPACK calls. Free downloads of these libraries can be found on
+
+https://www.netlib.org/blas/index.html
+https://www.netlib.org/lapack/index.html
+
+If you are running on Intel processors you can download (for free) Intel's highly optimised MKL package:
+
+https://software.intel.com/en-us/mkl/choose-download
+
+
MISC
----
Other make commands which can be useful:
@@ -105,6 +117,7 @@ http://www.xs4all.nl/~janth/Software/Software.html
or at github:
git clone https://github.com/JanThorbecke/OpenSource.git
+git clone git://github.com/JanThorbecke/OpenSource.git
The code is used by many different people and if there is a request for a new option in the code, then I will try to implement, test and make it available.
diff --git a/corrvir/Makefile b/corrvir/Makefile
index a8866219482d7e6fc03fcd94f46b8077b8f8e1d9..de45912b8eac959ba611b109b3b240c7d13810b6 100644
--- a/corrvir/Makefile
+++ b/corrvir/Makefile
@@ -3,7 +3,7 @@
include ../Make_include
ALLINC = -I.
-LIBS += -L$L -lgenfft -lm
+#LIBS += -L$L -lgenfft -lm
#OPTC += -g -O0 -m64
#OPTC = -g -O0 -fno-omit-frame-pointer
diff --git a/fdelmodc/Makefile b/fdelmodc/Makefile
index 56b3c4db58b1edee66c9341b593d29f36afe820d..4214ad0836e2eb3fc6b8d426ffa5ec1138c22c57 100644
--- a/fdelmodc/Makefile
+++ b/fdelmodc/Makefile
@@ -5,8 +5,7 @@ include ../Make_include
########################################################################
# define general include and system library
ALLINC = -I.
-LIBS += -L$L -lgenfft -lm $(LIBSM)
-#LIBS += -L$L -lgenfft -lm -lc
+#LIBS += -L$L -lgenfft -lm $(LIBSM)
#OPTC = -g -Wall -fsignaling-nans -O0 -fopenmp
#OPTC += -fopenmp -Waddress
#OPTC := $(subst -O3 -ffast-math, -O1 -g ,$(OPTC))
diff --git a/fdelmodc/demo/fdelmodc_moving.scr b/fdelmodc/demo/fdelmodc_moving.scr
new file mode 100755
index 0000000000000000000000000000000000000000..760e0ce0c9b5f7aafa2a6d68c37653ae6527204c
--- /dev/null
+++ b/fdelmodc/demo/fdelmodc_moving.scr
@@ -0,0 +1,48 @@
+#!/bin/bash
+#PBS -N fdelmod
+#PBS -q verylong
+#PBS -l nodes=1
+#PBS -k eo
+#PBS -j eo
+#
+# illustrates source and receiver positions, used in Figure 10 of the manual
+
+export PATH=../../utils:$PATH:
+
+#OK:
+dt=0.0005
+dx=5
+ntaper=10
+
+makewave file_out=wavelet1.su dt=$dt nt=1024 fmax=10 verbose=1 t0=0.1
+makewave file_out=wavelet2.su dt=$dt nt=1024 fmax=10 verbose=1 t0=0.2
+makewave file_out=wavelet3.su dt=$dt nt=1024 fmax=10 verbose=1 t0=0.3
+
+cat wavelet1.su | sushw key=gx,gelev,scalel a=6000,-1000,1 > src.su
+cat wavelet2.su | sushw key=gx,gelev,scalel a=5000,-500,1 >> src.su
+cat wavelet3.su | sushw key=gx,gelev,scalel a=1000,-1500,1 >> src.su
+
+# build a model with a steep salt-like flank of the side
+./model_flank.scr
+
+export filecp=grad_salt.su
+export filero=salt_ro.su
+
+#model sources on an array following the edges of the flank
+
+../fdelmodc \
+ file_cp=grad_salt.su file_den=salt_ro.su \
+ ischeme=1 \
+ file_src=src.su verbose=4 \
+ file_rcv=rec.su \
+ rec_type_vz=1 rec_int_vx=1 \
+ dtrcv=0.004 \
+ xrcv1=4000 zrcv1=1000 xrcv2=4000 zrcv2=6000 dzrcv=100 dxrcv=0 \
+ src_type=1 tmod=0.001 \
+ npml=100 tmod=0.6 \
+ tsnap1=0 tsnap2=0.5 dtsnap=0.01 \
+ left=2 right=2 bottom=2 top=2 \
+ fmax=10
+
+sugain < SrcRecPositions.su scale=5000 > nep.su
+
diff --git a/fdelmodc/demo/fdelmodc_visco_acoustic.scr b/fdelmodc/demo/fdelmodc_visco_acoustic.scr
new file mode 100755
index 0000000000000000000000000000000000000000..fcb85073d9366397e61102cb1a2d193ae1851d42
--- /dev/null
+++ b/fdelmodc/demo/fdelmodc_visco_acoustic.scr
@@ -0,0 +1,110 @@
+#!/bin/bash
+#PBS -N fdelmod
+#PBS -q verylong
+#PBS -l nodes=1
+#PBS -k eo
+#PBS -j eo
+#
+# wave propagation in visco-elastic medium
+
+export PATH=.:/home/thorbcke/bin:$PATH
+
+makewave file_out=wavelet.su dt=0.001 nt=1024 fp=13 shift=1 w=g2 verbose=1
+
+makemod file_base=model.su \
+ cp0=1500 ro0=1000 cs0=600 sizex=2700 sizez=2700 orig=0,-300\
+ dx=3 dz=3 \
+ intt=def poly=0 cp=1550 ro=2000 cs=1200 \
+ x=0,2700 z=500,500 \
+ intt=def poly=0 cp=1700 ro=2500 cs=1500 \
+ x=1100,1500 z=900,900 \
+ verbose=1
+
+#viscoelastic Q-values
+makemod file_base=relax.su \
+ cp0=20 cs0=17 ro0=1 sizex=2700 sizez=2700 orig=0,-300 \
+ dx=3 dz=3 \
+ intt=def poly=0 cp=18 cs=21 ro=1 \
+ x=0,2700 z=500,500 \
+ intt=def poly=0 cp=25 cs=26 ro=1 \
+ x=1100,1500 z=900,900 \
+ verbose=1
+
+export filecp=model_cp.su
+export filecs=model_cs.su
+export filero=model_ro.su
+
+export fileqp=relax_cp.su
+export fileqs=relax_cs.su
+
+
+export OMP_NUM_THREADS=4
+../fdelmodc \
+ file_cp=$filecp file_cs=$filecs file_den=$filero \
+ ischeme=2 \
+ file_qp=$fileqp file_qs=$fileqs \
+ file_src=wavelet.su verbose=1 \
+ file_rcv=rec.su \
+ fmax=40 \
+ xrcv1=600 xrcv2=2100 dxrcv=15 \
+ rec_type_vx=1 rec_type_vz=1 rec_int_vx=0 \
+ zrcv1=300 zrcv2=300 \
+ dtrcv=0.004 xsrc=1000 zsrc=300 nshot=1 \
+ src_type=1 \
+ npml=100 \
+ left=2 right=2 bottom=2 top=2 \
+ tmod=1.5 dt=0.001
+
+# tsnap1=0 tsnap2=1.5 dtsnap=0.05 \
+
+
+#model direct field to subtract from total field
+makemod file_base=model.su \
+ cp0=1500 ro0=1000 cs0=600 sizex=2700 sizez=2700 orig=0,-300\
+ dx=3 dz=3 \
+ verbose=1
+
+#viscoelastic Q-values
+makemod file_base=relax.su \
+ cp0=20 cs0=17 ro0=1 sizex=2700 sizez=2700 orig=0,-300\
+ dx=3 dz=3 \
+ verbose=1
+
+export filecp=model_cp.su
+export filecs=model_cs.su
+export filero=model_ro.su
+
+export fileqp=relax_cp.su
+export fileqs=relax_cs.su
+
+
+../fdelmodc \
+ file_cp=$filecp file_cs=$filecs file_den=$filero \
+ ischeme=2 \
+ file_qp=$fileqp file_qs=$fileqs \
+ file_src=wavelet.su verbose=1 \
+ file_rcv=drec.su \
+ fmax=40 \
+ xrcv1=600 xrcv2=2100 dxrcv=15 \
+ rec_type_vx=1 rec_type_vz=1 rec_int_vx=0 \
+ zrcv1=300 zrcv2=300 \
+ dtrcv=0.004 xsrc=1000 zsrc=300 nshot=1 \
+ src_type=1 \
+ npml=100 \
+ left=2 right=2 bottom=2 top=2 \
+ tmod=1.5 dt=0.001
+
+# substract mean and plot in eps
+for rectype in rvx rvz ;
+do
+ file_rcv=rec_$rectype.su
+
+ sudiff $file_rcv d$file_rcv > nep.su
+
+ supsimage < nep.su hbox=4 wbox=3 titlesize=-1 labelsize=10 titlesize=-1 \
+ perc=99 label1="time [s]" f2=300 d2=15 label2="receiver position in m" > viscodemo_$rectype.eps
+
+done
+
+exit;
+
diff --git a/fdelmodc/threadAffinity.c b/fdelmodc/threadAffinity.c
index bd9913ca40cb9d42b3151b53b62810fa1cbabf50..0fcee39c331948fa03d1754f623b03c2d77641a9 100644
--- a/fdelmodc/threadAffinity.c
+++ b/fdelmodc/threadAffinity.c
@@ -10,6 +10,9 @@
#include <sched.h>
#include <sys/types.h>
#include <sys/sysctl.h>
+#ifdef _OPENMP
+#include <omp.h>
+#endif
#define CPU_SETSIZE 1024
#define SYSCTL_CORE_COUNT "machdep.cpu.core_count"
diff --git a/fdelmodc3D/3dfd.c b/fdelmodc3D/3dfd.c
new file mode 100644
index 0000000000000000000000000000000000000000..bfda4b58577fb2bce99aa84e612f5fbcfa7889ec
--- /dev/null
+++ b/fdelmodc3D/3dfd.c
@@ -0,0 +1,1221 @@
+#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/CMWC4096.c b/fdelmodc3D/CMWC4096.c
new file mode 100644
index 0000000000000000000000000000000000000000..69ab1fe169fcb1541eb3ed231df3446c4919b430
--- /dev/null
+++ b/fdelmodc3D/CMWC4096.c
@@ -0,0 +1,50 @@
+/* http://en.wikipedia.org/wiki/Multiply-with-carry */
+#include<stdlib.h>
+#include<limits.h>
+
+/* random number generator which can be used as an alternative for drand48() */
+
+/* http://school.anhb.uwa.edu.au/personalpages/kwessen/shared/Marsaglia03.html*/
+
+static unsigned long Q[4096],c=362436; /* choose random initial c<809430660 and */
+ /* 4096 random 32-bit integers for Q[] */
+void seedCMWC4096(void)
+{
+ int i;
+ for (i=0; i<4096; i++) {
+ Q[i] = lrand48();
+ }
+ return;
+}
+
+unsigned long CMWC4096(void)
+{
+ unsigned long long t, a=18782LL;
+ static unsigned long i=4095;
+ unsigned long x,r=0xfffffffe;
+
+ i=(i+1)&4095;
+ t=a*Q[i]+c;
+ c=(t>>32);
+ x=t+c;
+ if(x<c){x++;c++;}
+ return(Q[i]=r-x);
+}
+
+/* replace defaults with five random seed values in calling program */
+static unsigned long x=123456789,y=362436069,z=521288629,w=88675123,v=886756453;
+unsigned long xorshift(void)
+{unsigned long t;
+ t=(x^(x>>7)); x=y; y=z; z=w; w=v;
+ v=(v^(v<<6))^(t^(t<<13)); return (y+y+1)*v;}
+
+
+double dcmwc4096(void)
+{
+ double rd;
+
+// rd = ((double)xorshift())/((double)ULONG_MAX);
+ rd = ((double)CMWC4096())/((double)ULONG_MAX);
+ return rd;
+}
+
diff --git a/fdelmodc3D/FiguresPaper/Figure10.scr b/fdelmodc3D/FiguresPaper/Figure10.scr
new file mode 100755
index 0000000000000000000000000000000000000000..e668e4bcb93020f52d2ca35e64390c898f25b397
--- /dev/null
+++ b/fdelmodc3D/FiguresPaper/Figure10.scr
@@ -0,0 +1,162 @@
+#!/bin/bash
+#PBS -l nodes=1
+#PBS -N InterfModeling
+#PBS -q fourweeks
+#PBS -V
+#
+#reference and 2 SI results for visco-acoustic media, 2x200 s. + 2x1 hours
+
+export PATH=../../bin:$PATH
+
+makewave w=g1 fmax=30 t0=0.10 dt=0.0008 nt=4096 db=-40 file_out=G1.su verbose=1
+
+makemod sizex=10000 sizez=4100 dx=10 dz=10 cp0=1500 ro0=1000 file_base=simple.su \
+ intt=def poly=0 x=0,10000 z=400,400 cp=2000 ro=1400 \
+ intt=def poly=2 x=0,2000,3000,5000,7000,8000,10000 z=1100,1100,1100,1600,1100,1100,1100 cp=4000 ro=2000 \
+ intt=def poly=0 x=0,10000 z=2100,2100 cp=3000 ro=1500 \
+ intt=def poly=0 x=0,10000 z=2600,2600 cp=5500 ro=2200
+
+xsrc1=1000
+xsrc2=9000
+zsrc1=3300
+zsrc2=3900
+dxsrc=10
+
+base=fw5000_Q
+
+../fdelmodc \
+ file_cp=simple_cp.su ischeme=2 \
+ Qp=15 \
+ file_den=simple_ro.su \
+ file_rcv=${base}.su \
+ file_src=G1.su \
+ rec_delay=0.1 \
+ dtrcv=0.008 \
+ verbose=3 \
+ tmod=4.108 \
+ dxrcv=50.0 \
+ src_random=0 \
+ wav_random=0 \
+ fmax=30 \
+ xsrc=5000 \
+ zsrc=0.0 \
+ dipsrc=0 \
+ ntaper=45 \
+ left=4 right=4 top=1 bottom=4
+
+makemod sizex=10000 sizez=5000 dx=10 dz=10 cp0=1500 ro0=1000 file_base=hom.su
+
+../fdelmodc \
+ file_cp=hom_cp.su ischeme=2 \
+ Qp=15 \
+ file_den=hom_ro.su \
+ file_rcv=${base}_D.su \
+ file_src=G1.su \
+ rec_delay=0.1 \
+ dtrcv=0.008 \
+ verbose=3 \
+ tmod=4.108 \
+ dxrcv=50.0 \
+ src_random=0 \
+ wav_random=0 \
+ fmax=30 \
+ xsrc=5000 \
+ zsrc=0.0 \
+ dipsrc=0 \
+ ntaper=45 \
+ left=4 right=4 top=1 bottom=4
+
+
+suop2 ${base}_rvz.su ${base}_D_rvz.su > Reffw5000_Q_rvz.su
+
+suwind s=1 j=1 tmax=4 f1=0.0 < Reffw5000_Q_rvz.su | \
+ sushw key=f1,delrt,d2 a=0.0,0.0,50 | \
+ supsimage perc=99 f1=0 f2=-5000 hbox=4 wbox=3 \
+ label1='time (s)' label2='lateral position (m)' \
+ labelsize=10 f2num=-5000 d2num=2500 > shotRefQ_5000_0.eps
+
+
+tmod=120
+tsrc1=0.1
+tsrc2=120
+tlength=120
+nsrc=8000
+fmax=30
+
+file_shot=shotRQ_volume_T${tmod}_S${nsrc}_Dt${tsrc2}_F${fmax}.su
+echo $file_shot
+
+#volume
+zsrc1=500
+zsrc2=4090
+
+../fdelmodc \
+ file_cp=simple_cp.su ischeme=2 \
+ Qp=15 \
+ file_den=simple_ro.su \
+ file_rcv=$file_shot \
+ rec_type_p=0 \
+ dtrcv=0.008 \
+ rec_ntsam=16384 \
+ dt=0.0010 \
+ verbose=1 \
+ tmod=$tmod \
+ dxrcv=10.0 \
+ plane_wave=0 \
+ src_random=1 \
+ wav_random=1 \
+ fmax=$fmax \
+ xsrc1=$xsrc1 \
+ xsrc2=$xsrc2 \
+ zsrc1=$zsrc1 \
+ zsrc2=$zsrc2 \
+ tsrc1=0.0 \
+ tsrc2=$tsrc2 \
+ tlength=$tlength \
+ nsrc=$nsrc \
+ dipsrc=0 \
+ ntaper=45 \
+ left=4 right=4 top=1 bottom=4
+
+ base=`echo $file_shot | awk 'BEGIN { FS = "." } ; { print $1 }'`
+ echo $base
+ SIrand.scr ${base}_rvz.su 10
+
+#deep
+zsrc1=2700
+zsrc2=4090
+
+file_shot=shotRQ_deep_T${tmod}_S${nsrc}_Dt${tsrc2}_F${fmax}.su
+
+../fdelmodc \
+ file_cp=simple_cp.su ischeme=2 \
+ file_den=simple_ro.su \
+ Qp=15 \
+ file_rcv=$file_shot \
+ rec_type_p=0 \
+ dtrcv=0.008 \
+ rec_ntsam=16384 \
+ dt=0.0010 \
+ verbose=1 \
+ tmod=$tmod \
+ dxrcv=10.0 \
+ plane_wave=0 \
+ src_random=1 \
+ wav_random=1 \
+ fmax=$fmax \
+ xsrc1=$xsrc1 \
+ xsrc2=$xsrc2 \
+ zsrc1=$zsrc1 \
+ zsrc2=$zsrc2 \
+ tsrc1=0.0 \
+ tsrc2=$tsrc2 \
+ tlength=$tlength \
+ nsrc=$nsrc \
+ dipsrc=0 \
+ ntaper=45 \
+ left=4 right=4 top=1 bottom=4
+
+ base=`echo $file_shot | awk 'BEGIN { FS = "." } ; { print $1 }'`
+ echo $base
+ SIrand.scr ${base}_rvz.su 10
+
diff --git a/fdelmodc3D/FiguresPaper/Figure10Hom.scr b/fdelmodc3D/FiguresPaper/Figure10Hom.scr
new file mode 100755
index 0000000000000000000000000000000000000000..09461993663cf676636143c3ad9da06d25d30908
--- /dev/null
+++ b/fdelmodc3D/FiguresPaper/Figure10Hom.scr
@@ -0,0 +1,141 @@
+#!/bin/bash
+#PBS -l nodes=1:ppn=2
+#PBS -N InterfModeling
+#PBS -q long
+#PBS -V
+#
+
+export PATH=../../bin:$PATH
+
+makewave w=g2 fp=10 t0=0.15 dt=0.0010 nt=4096 file_out=G2.su verbose=1
+
+makemod sizex=10000 sizez=4100 dx=10 dz=10 cp0=1500 ro0=1000 file_base=hom.su
+
+xsrc1=100
+xsrc2=9900
+dxsrc=10
+
+tmod=120
+tsrc1=0.1
+tsrc2=120
+tlength=120
+nsrc=8000
+fmax=30
+
+for wav_random in 0 1;
+do
+
+file_shot=shotHRS${wav_random}_volume_T${tmod}_S${nsrc}_Dt${tsrc2}_F${fmax}.su
+echo $file_shot
+
+#volume
+zsrc1=500
+zsrc2=4090
+
+../fdelmodc \
+ file_cp=hom_cp.su ischeme=1 \
+ file_den=hom_ro.su \
+ file_src=G2.su \
+ file_rcv=$file_shot \
+ rec_type_p=0 \
+ dtrcv=0.008 \
+ rec_ntsam=16384 \
+ dt=0.0010 \
+ verbose=1 \
+ tmod=$tmod \
+ dxrcv=10.0 \
+ plane_wave=0 \
+ src_random=1 \
+ wav_random=${wav_random} \
+ fmax=$fmax \
+ xsrc1=$xsrc1 \
+ xsrc2=$xsrc2 \
+ zsrc1=$zsrc1 \
+ zsrc2=$zsrc2 \
+ tsrc1=0.0 \
+ tsrc2=$tsrc2 \
+ tlength=$tlength \
+ nsrc=$nsrc \
+ dipsrc=0 \
+ ntaper=45 \
+ left=4 right=4 top=1 bottom=4
+
+ base=`echo $file_shot | awk 'BEGIN { FS = "." } ; { print $1 }'`
+ echo $base
+ SIrand.scr ${base}_rvz.su 10
+
+#deep
+zsrc1=2700
+zsrc2=4090
+
+file_shot=shotHRS${wav_random}_deep_T${tmod}_S${nsrc}_Dt${tsrc2}_F${fmax}.su
+
+fdelmodc \
+ file_cp=hom_cp.su ischeme=1 \
+ file_den=hom_ro.su \
+ file_src=G2.su \
+ file_rcv=$file_shot \
+ rec_type_p=0 \
+ dtrcv=0.008 \
+ rec_ntsam=16384 \
+ dt=0.0010 \
+ verbose=1 \
+ tmod=$tmod \
+ dxrcv=10.0 \
+ plane_wave=0 \
+ src_random=1 \
+ wav_random=${wav_random} \
+ fmax=$fmax \
+ xsrc1=$xsrc1 \
+ xsrc2=$xsrc2 \
+ zsrc1=$zsrc1 \
+ zsrc2=$zsrc2 \
+ tsrc1=0.0 \
+ tsrc2=$tsrc2 \
+ tlength=$tlength \
+ nsrc=$nsrc \
+ dipsrc=0 \
+ ntaper=45 \
+ left=4 right=4 top=1 bottom=4
+
+ base=`echo $file_shot | awk 'BEGIN { FS = "." } ; { print $1 }'`
+ echo $base
+ SIrand.scr ${base}_rvz.su 10
+
+#plane
+zsrc1=2700
+zsrc2=2700
+
+file_shot=shotHRS${wav_random}_plane_T${tmod}_S${nsrc}_Dt${tsrc2}_F${fmax}.su
+
+fdelmodc \
+ file_cp=hom_cp.su ischeme=1 \
+ file_den=hom_ro.su \
+ file_src=G2.su \
+ file_rcv=$file_shot \
+ rec_type_p=0 \
+ dtrcv=0.008 \
+ rec_ntsam=16384 \
+ dt=0.0010 \
+ verbose=1 \
+ tmod=$tmod \
+ dxrcv=10.0 \
+ plane_wave=1 \
+ xsrc=5000 zsrc=2700 \
+ src_random=0 \
+ wav_random=${wav_random} \
+ fmax=$fmax \
+ tsrc1=0.0 \
+ tsrc2=$tsrc2 \
+ tlength=$tlength \
+ nsrc=$nsrc \
+ dipsrc=0 \
+ ntaper=45 \
+ left=4 right=4 top=1 bottom=4
+
+ base=`echo $file_shot | awk 'BEGIN { FS = "." } ; { print $1 }'`
+ echo $base
+ SIrand.scr ${base}_rvz.su 10
+
+done
+
diff --git a/fdelmodc3D/FiguresPaper/Figure11.scr b/fdelmodc3D/FiguresPaper/Figure11.scr
new file mode 100755
index 0000000000000000000000000000000000000000..73bb58cb7d901fc2b59410e0d4a68868e95eaa3a
--- /dev/null
+++ b/fdelmodc3D/FiguresPaper/Figure11.scr
@@ -0,0 +1,55 @@
+#!/bin/bash
+#PBS -l nodes=1:ppn=2
+#PBS -N InterfModeling
+#PBS -q long
+#PBS -V
+#
+# calls fdelmodc_long.scr, can not be reproduced; software in test phase
+
+echo " This Figure can not be reproduced completely"
+echo " The progrom corrsmp used is still in test phase"
+echo " Mail j.w.thorbecke@tudelft.nl if you want to reproduce this Figure."
+
+exit;
+./fdelmodc_long.scr
+
+export OMP_NUM_THREADS=1
+~/src/CorrSMP_FD_Files/corrsmp \
+ file_base=long/shotAcoustic_T3600_S1500_Dt500_F30_001_rvz.su \
+ nc=1 nstation=201 fullcorr=1 dt=0.008 \
+ nt=16384 verbose=1 ntc=4096 file_out=outI.su causal=1
+
+#results long recordings and using corrsmp
+suwind s=1 j=1 tmax=4 f1=0.0 key=fldr min=101 max=101 < outI_cc1.su | \
+ sushw key=f1,delrt,d2 a=0.0,0.0,50 | \
+ sufilter amps=0,0.5,1,1,0 f=0,2,3,50,60 | \
+ supsimage perc=99 f1=0 f2=-5000 hbox=4 wbox=3 \
+ label1='time (s)' label2='lateral position (m)' \
+ labelsize=10 f2num=-5000 d2num=2500 > long_Corr_I.eps
+
+~/src/CorrSMP_FD_Files/corrsmp \
+ file_base=long/shotAcoustic_T3600_S1500_Dt500_F30_001_rvz.su \
+ nc=1 nstation=201 fullcorr=1 dt=0.008 \
+ nt=16384 verbose=1 ntc=4096 file_out=outII causal=2
+
+suwind s=1 j=1 tmax=4 f1=0.0 key=fldr min=101 max=101 < outII_cc1.su | \
+ sushw key=f1,delrt,d2 a=0.0,0.0,50 | \
+ sufilter amps=0,0.5,1,1,0 f=0,2,3,50,60 | \
+ supsimage perc=99 f1=0 f2=-5000 hbox=4 wbox=3 \
+ label1='time (s)' label2='lateral position (m)' \
+ labelsize=10 f2num=-5000 d2num=2500 > long_Corr_II.eps
+
+~/src/CorrSMP_FD_Files/corrsmp \
+ file_base=long/shotAcoustic_T3600_S1500_Dt500_F30_001_rvz.su \
+ nc=1 nstation=201 fullcorr=1 dt=0.008 \
+ nt=16384 verbose=1 ntc=4096 file_out=outIII causal=4
+
+suwind s=1 j=1 tmax=4 f1=0.0 key=fldr min=101 max=101 < outIII_cc1.su | \
+ sushw key=f1,delrt,d2 a=0.0,0.0,50 | \
+ sufilter amps=0,0.5,1,1,0 f=0,2,3,50,60 | \
+ supsimage perc=99 f1=0 f2=-5000 hbox=4 wbox=3 \
+ label1='time (s)' label2='lateral position (m)' \
+ labelsize=10 f2num=-5000 d2num=2500 > long_Corr_III.eps
+
+
+
diff --git a/fdelmodc3D/FiguresPaper/Figure12.scr b/fdelmodc3D/FiguresPaper/Figure12.scr
new file mode 100755
index 0000000000000000000000000000000000000000..8b74e139b8e33a755b29c2aa4424eae0a7ab1f4f
--- /dev/null
+++ b/fdelmodc3D/FiguresPaper/Figure12.scr
@@ -0,0 +1,46 @@
+#!/bin/bash
+#PBS -l nodes=1:ppn=2
+#PBS -N InterfModeling
+#PBS -q long
+#PBS -V
+#
+# calls fdelmodc_amplitude.scr, can not be reproduced; software in test phase
+
+echo " This Figure can not be reproduced completely"
+echo " The progrom corrsmp used is still in test phase"
+echo " Mail j.w.thorbecke@tudelft.nl if you want to reproduce this Figure."
+exit;
+
+./fdelmodc_amplitude.scr
+
+#amplitude distribution of sources
+supsgraph wbox=3 hbox=4 style=seimic < src_ampl.su \
+ f1=-250 d1=5.05 linecolor=black labelsize=10 titlesize=10 \
+ label1=amplitude label2=occurence > amplitudeDistr.eps
+
+export OMP_NUM_THREADS=1
+~/src/CorrSMP_FD_Files/corrsmp \
+ file_base=long/shotAcousticA500_T3600_S1500_Dt500_F30_001_rvz.su \
+ nc=1 nstation=201 fullcorr=1 dt=0.008 \
+ nt=16384 verbose=1 ntc=4096 file_out=outA.su causal=1
+
+suwind key=fldr min=101 max=101 < outA.su_cc1.su > outA_Station101_Comp1.su
+
+
+suwind s=1 j=1 tmax=4 f1=0.0 < outA_Station101_Comp1.su | \
+ sushw key=f1,delrt,d2 a=0.0,0.0,50 | \
+ sufilter amps=0,0.5,1,1,0 f=0,2,3,50,60 | \
+ supsimage perc=99 f1=0 f2=-5000 hbox=4 wbox=3 \
+ label1='time (s)' label2='lateral position (m)' \
+ labelsize=10 f2num=-5000 d2num=2500 > longA_Corr_I.eps
+
+suwind s=1 j=1 tmax=4 f1=0.0 < outA_Station101_Comp1.su | \
+ sushw key=f1,delrt,d2 a=0.0,0.0,50 | \
+ sufilter amps=0,0.5,1,1,0 f=0,2,3,50,60 | \
+ sunormalize norm=rms | \
+ supsimage perc=99 f1=0 f2=-5000 hbox=4 wbox=3 \
+ label1='time (s)' label2='lateral position (m)' \
+ labelsize=10 f2num=-5000 d2num=2500 > longA_norm_Corr_I.eps
+
+
+
diff --git a/fdelmodc3D/FiguresPaper/Figure13.scr b/fdelmodc3D/FiguresPaper/Figure13.scr
new file mode 100755
index 0000000000000000000000000000000000000000..e7a7d107ca6bca3f196d17616b535afe2ad7e8ed
--- /dev/null
+++ b/fdelmodc3D/FiguresPaper/Figure13.scr
@@ -0,0 +1,163 @@
+#!/bin/bash
+#PBS -l nodes=1:ppn=2
+#PBS -N InterfModeling
+#PBS -q long
+#PBS -V
+#
+# amplitude variations on source strength, 3x1500 s.
+
+export PATH=../../bin:$PATH
+
+makemod sizex=10000 sizez=4100 dx=10 dz=10 cp0=1500 ro0=1000 file_base=simple.su \
+ intt=def poly=0 x=0,10000 z=400,400 cp=2000 ro=1400 \
+ intt=def poly=2 x=0,2000,3000,5000,7000,8000,10000 z=1100,1100,1100,1600,1100,1100,1100 cp=4000 ro=2000 \
+ intt=def poly=0 x=0,10000 z=2100,2100 cp=3000 ro=1500 \
+ intt=def poly=0 x=0,10000 z=2600,2600 cp=5500 ro=2200
+
+xsrc1=500
+xsrc2=9500
+
+zsrc1=500
+zsrc2=4090
+
+tmod=120
+tsrc1=0.1
+tsrc2=120
+tlength=120
+nsrc=150
+fmax=30
+
+#Gaussian amplitude distribution
+A=10000
+file_shot=shotRS_A${A}_T${tmod}_S${nsrc}_Dt${tsrc2}_F${fmax}.su
+
+fdelmodc \
+ file_cp=simple_cp.su ischeme=1 \
+ file_den=simple_ro.su \
+ file_rcv=$file_shot \
+ rec_type_p=0 \
+ dtrcv=0.008 \
+ rec_ntsam=16384 \
+ dt=0.0010 \
+ verbose=4 \
+ tmod=$tmod \
+ dxrcv=50.0 \
+ plane_wave=0 \
+ amplitude=$A \
+ distribution=1 \
+ src_random=1 \
+ wav_random=1 \
+ fmax=$fmax \
+ xsrc1=$xsrc1 \
+ xsrc2=$xsrc2 \
+ zsrc1=$zsrc1 \
+ zsrc2=$zsrc2 \
+ tsrc1=0.0 \
+ tsrc2=$tsrc2 \
+ tlength=$tlength \
+ nsrc=$nsrc \
+ dipsrc=0 \
+ ntaper=45 \
+ left=4 right=4 top=1 bottom=4
+
+ base=`echo $file_shot | awk 'BEGIN { FS = "." } ; { print $1 }'`
+ echo $base
+#use clip=500
+ SIrand.scr ${base}_rvz.su 50
+
+#amplitude distribution of sources
+f1=`surange < src_ampl.su | grep f1 | awk '{print $2 }'`
+d1=`surange < src_ampl.su | grep d1 | awk '{print $2 }'`
+
+supsgraph wbox=3 hbox=1 style=normal < src_ampl.su \
+ f1=$f1 d1=$d1 d1num=10000 x1end=50000 d2num=1 linecolor=black labelsize=10 titlesize=10 \
+ label1=amplitude label2=occurence > amplitudeDistrGauss${A}.eps
+
+#Flat amplitude distribution
+A=50000
+file_shot=shotRS_A${A}_T${tmod}_S${nsrc}_Dt${tsrc2}_F${fmax}.su
+
+fdelmodc \
+ file_cp=simple_cp.su ischeme=1 \
+ file_den=simple_ro.su \
+ file_rcv=$file_shot \
+ rec_type_p=0 \
+ dtrcv=0.008 \
+ rec_ntsam=16384 \
+ dt=0.0010 \
+ verbose=4 \
+ tmod=$tmod \
+ dxrcv=50.0 \
+ plane_wave=0 \
+ amplitude=$A \
+ distribution=0 \
+ src_random=1 \
+ wav_random=1 \
+ fmax=$fmax \
+ xsrc1=$xsrc1 \
+ xsrc2=$xsrc2 \
+ zsrc1=$zsrc1 \
+ zsrc2=$zsrc2 \
+ tsrc1=0.0 \
+ tsrc2=$tsrc2 \
+ tlength=$tlength \
+ nsrc=$nsrc \
+ dipsrc=0 \
+ ntaper=45 \
+ left=4 right=4 top=1 bottom=4
+
+ base=`echo $file_shot | awk 'BEGIN { FS = "." } ; { print $1 }'`
+ echo $base
+#use clip=900
+ SIrand.scr ${base}_rvz.su 50
+
+#amplitude distribution of sources
+#amplitude distribution of sources
+f1=$(echo "scale=3; -5*$A" | bc -l)
+d1=`surange < src_ampl.su | grep d1 | awk '{print $2 }'`
+
+supsgraph wbox=3 hbox=1 style=normal < src_ampl.su \
+ f1=$f1 d1=$d1 d1num=10000 x1end=50000 d2num=1 linecolor=black labelsize=10 titlesize=10 \
+ label1=amplitude label2=occurence > amplitudeDistrFlat${A}.eps
+
+#No amplitude distribution
+A=0
+file_shot=shotRS_A${A}_T${tmod}_S${nsrc}_Dt${tsrc2}_F${fmax}.su
+
+fdelmodc \
+ file_cp=simple_cp.su ischeme=1 \
+ file_den=simple_ro.su \
+ file_rcv=$file_shot \
+ rec_type_p=0 \
+ dtrcv=0.008 \
+ rec_ntsam=16384 \
+ dt=0.0010 \
+ verbose=3 \
+ tmod=$tmod \
+ dxrcv=50.0 \
+ plane_wave=0 \
+ src_random=1 \
+ wav_random=1 \
+ fmax=$fmax \
+ xsrc1=$xsrc1 \
+ xsrc2=$xsrc2 \
+ zsrc1=$zsrc1 \
+ zsrc2=$zsrc2 \
+ tsrc1=0.0 \
+ tsrc2=$tsrc2 \
+ tlength=$tlength \
+ nsrc=$nsrc \
+ dipsrc=0 \
+ ntaper=45 \
+ left=4 right=4 top=1 bottom=4
+
+ base=`echo $file_shot | awk 'BEGIN { FS = "." } ; { print $1 }'`
+ echo $base
+#use clip=4e-6
+ SIrand.scr ${base}_rvz.su 50
+
+suspike nt=1000 ntr=1 nspk=1 ix1=1 it1=500 | sugain scale=$nsrc | \
+supsgraph wbox=3 hbox=1 style=normal \
+ f1=-50000 d1=100.1 d1num=10000 d2num=50 x1end=50000 linecolor=black labelsize=10 titlesize=10 \
+ label1=amplitude label2=occurence > amplitude${A}.eps
+
diff --git a/fdelmodc3D/FiguresPaper/Figure13Amp.scr b/fdelmodc3D/FiguresPaper/Figure13Amp.scr
new file mode 100755
index 0000000000000000000000000000000000000000..717233b9ac0f9902ded817db60d69257b3c86d23
--- /dev/null
+++ b/fdelmodc3D/FiguresPaper/Figure13Amp.scr
@@ -0,0 +1,130 @@
+#!/bin/bash
+#PBS -l nodes=1:ppn=2
+#PBS -N InterfModeling
+#PBS -q long
+#PBS -V
+#
+# computes only the amplitude distributions pictures, 5 s.
+
+export PATH=../../bin:$PATH
+
+makemod sizex=10000 sizez=4100 dx=10 dz=10 cp0=1500 ro0=1000 file_base=simple.su \
+ intt=def poly=0 x=0,10000 z=400,400 cp=2000 ro=1400 \
+ intt=def poly=2 x=0,2000,3000,5000,7000,8000,10000 z=1100,1100,1100,1600,1100,1100,1100 cp=4000 ro=2000 \
+ intt=def poly=0 x=0,10000 z=2100,2100 cp=3000 ro=1500 \
+ intt=def poly=0 x=0,10000 z=2600,2600 cp=5500 ro=2200
+
+xsrc1=500
+xsrc2=9500
+
+zsrc1=500
+zsrc2=4090
+
+tmod=0.2
+tsrc1=0.1
+tsrc2=0.2
+tlength=0.2
+nsrc=150
+fmax=30
+
+#Gaussian amplitude distribution
+A=10000
+file_shot=shotRS_A${A}_T${tmod}_S${nsrc}_Dt${tsrc2}_F${fmax}.su
+
+../fdelmodc \
+ file_cp=simple_cp.su ischeme=1 \
+ file_den=simple_ro.su \
+ file_rcv=$file_shot \
+ rec_type_p=0 \
+ dtrcv=0.008 \
+ rec_ntsam=16384 \
+ dt=0.0010 \
+ verbose=4 \
+ tmod=$tmod \
+ dxrcv=50.0 \
+ plane_wave=0 \
+ amplitude=$A \
+ distribution=1 \
+ src_random=1 \
+ wav_random=1 \
+ fmax=$fmax \
+ xsrc1=$xsrc1 \
+ xsrc2=$xsrc2 \
+ zsrc1=$zsrc1 \
+ zsrc2=$zsrc2 \
+ tsrc1=0.0 \
+ tsrc2=$tsrc2 \
+ tlength=$tlength \
+ nsrc=$nsrc \
+ dipsrc=0 \
+ ntaper=45 \
+ left=4 right=4 top=1 bottom=4
+
+ base=`echo $file_shot | awk 'BEGIN { FS = "." } ; { print $1 }'`
+ echo $base
+
+#amplitude distribution of sources
+f1=`surange < src_ampl.su | grep f1 | awk '{print $2 }'`
+d1=`surange < src_ampl.su | grep d1 | awk '{print $2 }'`
+
+supsgraph wbox=3 hbox=1 style=normal < src_ampl.su \
+ f1=$f1 d1=$d1 d1num=10000 x1end=50000 d2num=1 linecolor=black labelsize=10 titlesize=10 \
+ label1=amplitude label2=occurence > amplitudeDistrGauss${A}.eps
+
+#Flat amplitude distribution
+A=50000
+file_shot=shotRS_A${A}_T${tmod}_S${nsrc}_Dt${tsrc2}_F${fmax}.su
+
+fdelmodc \
+ file_cp=simple_cp.su ischeme=1 \
+ file_den=simple_ro.su \
+ file_rcv=$file_shot \
+ rec_type_p=0 \
+ dtrcv=0.008 \
+ rec_ntsam=16384 \
+ dt=0.0010 \
+ verbose=4 \
+ tmod=$tmod \
+ dxrcv=50.0 \
+ plane_wave=0 \
+ amplitude=$A \
+ distribution=0 \
+ src_random=1 \
+ wav_random=1 \
+ fmax=$fmax \
+ xsrc1=$xsrc1 \
+ xsrc2=$xsrc2 \
+ zsrc1=$zsrc1 \
+ zsrc2=$zsrc2 \
+ tsrc1=0.0 \
+ tsrc2=$tsrc2 \
+ tlength=$tlength \
+ nsrc=$nsrc \
+ dipsrc=0 \
+ ntaper=45 \
+ left=4 right=4 top=1 bottom=4
+
+ base=`echo $file_shot | awk 'BEGIN { FS = "." } ; { print $1 }'`
+ echo $base
+
+#amplitude distribution of sources
+#amplitude distribution of sources
+f1=$(echo "scale=3; -5*$A" | bc -l)
+d1=`surange < src_ampl.su | grep d1 | awk '{print $2 }'`
+
+supsgraph wbox=3 hbox=1 style=normal < src_ampl.su \
+ f1=$f1 d1=$d1 d1num=10000 x1end=50000 d2num=1 linecolor=black labelsize=10 titlesize=10 \
+ label1=amplitude label2=occurence > amplitudeDistrFlat${A}.eps
+
+#No amplitude distribution
+A=0
+file_shot=shotRS_A${A}_T${tmod}_S${nsrc}_Dt${tsrc2}_F${fmax}.su
+
+base=`echo $file_shot | awk 'BEGIN { FS = "." } ; { print $1 }'`
+echo $base
+
+suspike nt=1000 ntr=1 nspk=1 ix1=1 it1=500 | sugain scale=$nsrc | \
+supsgraph wbox=3 hbox=1 style=normal \
+ f1=-50000 d1=100.1 d1num=10000 d2num=50 x1end=50000 linecolor=black labelsize=10 titlesize=10 \
+ label1=amplitude label2=occurence > amplitude${A}.eps
+
diff --git a/fdelmodc3D/FiguresPaper/Figure14-15.scr b/fdelmodc3D/FiguresPaper/Figure14-15.scr
new file mode 100755
index 0000000000000000000000000000000000000000..74d1f3713b9e66ba3967333082c71348118d4ece
--- /dev/null
+++ b/fdelmodc3D/FiguresPaper/Figure14-15.scr
@@ -0,0 +1,172 @@
+#!/bin/bash
+#PBS -l nodes=1
+#PBS -N InterfModeling
+#PBS -q fourweeks
+#PBS -V
+#
+# receivers and source placed on model with topography, 161 hours
+
+echo " !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!"
+echo " This Figure can not be reproduced completely"
+echo " The progrom corrsmp used is still in test phase"
+echo " Mail j.w.thorbecke@tudelft.nl if you want to reproduce this Figure."
+echo " Only the reference response will be modeled"
+
+export PATH=../../bin:$PATH
+
+dt=0.0004
+ntap=120
+fmax=45
+
+makemod sizex=10000 sizez=4100 dx=5 dz=5 cp0=0 ro0=1000 file_base=real2.su \
+ orig=0,-800 gradunit=0 \
+ intt=def poly=2 cp=2450 ro=1000 gradcp=14 grad=0 \
+ x=0,1000,1700,1800,2000,3000,4000,4500,6000,6800,7000,7500,8100,8800,10000 \
+ z=-100,-200,-250,-200,-200,-120,-300,-600,-650,-500,-350,-200,-200,-150,-200 \
+ intt=rough var=200,3.2,1 poly=2 x=0,3000,8000,10000 \
+ z=400,250,300,500 cp=4500,4200,4800,4500 ro=1400 gradcp=5 grad=0 \
+ intt=def poly=2 x=0,2000,3000,5000,7000,8000,10000 \
+ z=1100,1100,1100,1600,1100,1100,1100 cp=4000 ro=2000 gradcp=8 grad=0 \
+ intt=def poly=0 x=0,10000 z=1750,2050 cp=4500,5100 ro=1500 gradcp=13 grad=0 \
+ intt=def poly=0 x=0,10000 z=1850,2150 cp=6000,4200 ro=1500 gradcp=14 grad=0 \
+ intt=def poly=0 x=0,10000 z=1950,2250 cp=4800,4800 ro=1500 gradcp=5 grad=0 \
+ intt=def poly=0 x=0,10000 z=2000,2300 cp=6100,5000 ro=1500 gradcp=13 grad=0 \
+ intt=def poly=0 x=0,10000 z=2100,2400 cp=3800,5000 ro=1500 gradcp=20 grad=0 \
+ intt=def poly=0 x=0,10000 z=2150,2450 cp=5000 ro=1500 gradcp=14 grad=0 \
+ intt=def poly=0 x=0,10000 z=2350,2650 cp=5800 ro=1500 gradcp=5 grad=0 \
+ intt=def poly=0 x=0,10000 z=2600,2600 cp=5500 ro=2200 gradcp=5 grad=0
+
+sushw key=f1 a=0 < real2_cp.su | \
+ sushw key=f1 a=0 | \
+ supsimage hbox=6 wbox=8 labelsize=12 f2num=-5000 d2num=1000 \
+ wrgb=0,0,1.0 grgb=0,1.0,0 brgb=1.0,0,0 legend=1 lnice=1 lstyle=vertright \
+ bclip=7053.02 wclip=0 label1="depth [m]" label2="lateral position [m]" \
+ > model2_cp.eps
+
+
+makewave w=g2 fmax=45 t0=0.10 dt=$dt nt=4096 db=-40 file_out=G2.su verbose=1
+
+extendModel file_in=real2_ro.su nafter=$ntap nbefore=$ntap nabove=0 nbelow=$ntap > vel2_edge_ro.su
+extendModel file_in=real2_cp.su nafter=$ntap nbefore=$ntap nabove=0 nbelow=$ntap > vel2_edge_cp.su
+
+#reference
+
+fdelmodc \
+ file_cp=vel2_edge_cp.su ischeme=1 \
+ file_den=vel2_edge_ro.su \
+ file_rcv=shot_real2_x5000_topo.su \
+ file_src=G2.su \
+ dtrcv=0.004 \
+ verbose=4 \
+ tmod=3.004 \
+ dxrcv=20.0 \
+ zrcv1=-800 \
+ zrcv2=-800 \
+ xrcv1=0 \
+ xrcv2=10000 \
+ sinkdepth=1 \
+ src_random=0 \
+ wav_random=0 \
+ xsrc1=5000 \
+ xsrc2=5000 \
+ zsrc1=-800 \
+ tsrc1=0.0 \
+ dipsrc=1 \
+ ntaper=$ntap \
+ left=4 right=4 top=1 bottom=4
+
+
+sushw key=f1,delrt a=0.0,0.0 < shot_real2_x5000_topo_rvz.su | \
+ basop choice=1 shift=-0.1 | \
+ supsimage clip=2e-12 f1=0 f2=-5000 x1end=3.004 hbox=8 wbox=6 \
+ label1="time (s)" label2="lateral position (m)" \
+ labelsize=10 f2num=-5000 d2num=1000 d1num=0.5 > shot_real2_x5000_topo.eps
+
+#clip minclip=0 < SrcRecPositions.su > nep.su
+#addmul file_in1=nep.su file_in2=vel2_edge_cp.su a=8000 | \
+
+
+exit;
+
+tlength=50
+nsrc=1500
+
+xsrc1=100
+xsrc2=9900
+zsrc1=1750
+zsrc2=2600
+
+fmax=30
+tmod=3600
+tsrc1=0.1
+tsrc2=3600
+
+file_shot=shot_real2_T${tmod}_S${nsrc}_Dt${tlength}_F${fmax}.su
+
+fdelmodc \
+ file_cp=vel2_edge_cp.su ischeme=1 \
+ file_den=vel2_edge_ro.su \
+ file_rcv=$file_shot \
+ dtrcv=0.004 \
+ dt=$dt \
+ verbose=4 \
+ rec_ntsam=15000 \
+ tmod=$tmod \
+ dxrcv=20.0 \
+ zrcv1=-800 \
+ zrcv2=-800 \
+ xrcv1=0 \
+ xrcv2=10000 \
+ sinkdepth=1 \
+ src_random=1 \
+ wav_random=1 \
+ fmax=$fmax \
+ xsrc1=$xsrc1 \
+ xsrc2=$xsrc2 \
+ zsrc1=$zsrc1 \
+ zsrc2=$zsrc2 \
+ tsrc1=0.0 \
+ tsrc2=$tsrc2 \
+ tlength=$tlength \
+ nsrc=$nsrc \
+ dipsrc=0 \
+ ntaper=$ntap \
+ left=4 right=4 top=1 bottom=4
+
+suop2 SrcRecPositions.su vel2_edge_cp.su w1=8000 w2=1.0 op=sum | \
+ sugain nclip=0 | \
+ supsimage hbox=6 wbox=8 labelsize=10 \
+ f2=-5600 f2num=-5000 d2num=1000 f1num=-500 d1num=500 \
+ x2beg=-5000 x2end=5000 legend=1 \
+ bclip=8200 wclip=0 label1="depth (m)" label2="lateral position (m)" \
+ > real_sources_cp.eps
+
+supsimage < vel2_edge_cp.su hbox=6 wbox=8 labelsize=10 \
+ f2=-5600 f2num=-5000 d2num=1000 f1num=-500 d1num=500 \
+ x2beg=-5000 x2end=5000 legend=1 bps=24 lstyle=vertright \
+ bclip=6500 label1="depth (m)" label2="lateral position (m)" \
+ brgb=0.1,0.1,0.1 grgb=0.9,0.9,0.9 wrgb=1.0,1.0,1.0 \
+ curve=SrcPositions1500.txt npair=1500 curvecolor=black curvedash=-1 curvewidth=3 \
+ > real_sources_gray_cp.eps
+
+supsimage hbox=6 wbox=8 labelsize=12 < SrcRecPositions.su \
+ f2=-5600 f2num=50000 d2num=1000 f1num=5000 d1num=500 \
+ legend=1 lnice=1 \
+ label1=" " label2=" " bclip=1 wclip=0 \
+ > rec_pos_real2.eps
+
+export OMP_NUM_THREADS=4
+export MKL_SERIAL=yes
+export DFTI_NUMBER_OF_USER_THREADS=1
+
+$HOME/src/CorrSMP_FD_Files/corrsmp file_base=shot_real2_T3600_S1500_Dt50_F30_001_rvz.su ntc=2048 fmax=60 \
+ verbose=3 nstation=501 \
+ file_out=corrsmp_out.su nc=1 fullcorr=1 dt=0.004 nt=15000
+
+suwind key=fldr min=251 max=251 < corrsmp_out_cc1.su | \
+ supsimage clip=5e-13 f1=0 f2=-5000 d2=20 x1end=3.004 hbox=8 wbox=6 \
+ label1="time (s)" label2="lateral position (m)" \
+ labelsize=10 f2num=-5000 d2num=1000 d1num=0.5 > corr_real2_x5000_topo.eps
+
+
+
diff --git a/fdelmodc3D/FiguresPaper/Figure17_19AppendixA.scr b/fdelmodc3D/FiguresPaper/Figure17_19AppendixA.scr
new file mode 100755
index 0000000000000000000000000000000000000000..5a3207cb62f0bf585ace2b4c7f32c26614be8814
--- /dev/null
+++ b/fdelmodc3D/FiguresPaper/Figure17_19AppendixA.scr
@@ -0,0 +1,92 @@
+#!/bin/bash
+#PBS -l nodes=1
+#PBS -N InterfModeling
+#PBS -q fourweeks
+#PBS -V
+#
+
+export PATH=../../bin:$PATH
+which fdelmodc
+
+makemod sizex=10000 sizez=4100 dx=10 dz=10 cp0=1500 ro0=1000 file_base=simple.su \
+ intt=def poly=0 x=0,10000 z=400,400 cp=2000 ro=1400 \
+ intt=def poly=2 x=0,2000,3000,5000,7000,8000,10000 \
+ z=1100,1100,1100,1600,1100,1100,1100 cp=4000 ro=2000 \
+ intt=def poly=0 x=0,10000 z=2100,2100 cp=3000 ro=1500 \
+ intt=def poly=0 x=0,10000 z=2600,2600 cp=5500 ro=2200
+
+makewave w=g2 fmax=45 t0=0.10 dt=0.001 nt=4096 db=-40 file_out=G2.su verbose=1
+
+xsrc1=100
+xsrc2=9900
+zsrc1=2100
+zsrc2=4000
+
+file_shot=shotRandomPos${xsrc}_${zsrc1}.su
+
+fdelmodc \
+ file_cp=simple_cp.su ischeme=1 \
+ file_den=simple_ro.su \
+ file_rcv=$file_shot \
+ dtrcv=0.008 \
+ dt=0.0010 \
+ verbose=4 \
+ tmod=10.000 \
+ dxrcv=20.0 \
+ zrcv1=10 \
+ zrcv2=10 \
+ xrcv1=0 \
+ xrcv2=10000 \
+ src_random=1 \
+ wav_random=1 \
+ fmax=30 \
+ xsrc1=$xsrc1 \
+ xsrc2=$xsrc2 \
+ zsrc1=$zsrc1 \
+ zsrc2=$zsrc2 \
+ tsrc1=0.0 \
+ tsrc2=5.0 \
+ nsrc=20 \
+ dipsrc=0 \
+ ntaper=45 \
+ tsnap1=0.1 tsnap2=6.0 dtsnap=0.2 \
+ left=4 right=4 top=1 bottom=4 \
+ nxmax=2500 nzmax=1400 ntmax=10000
+
+psgraph < srcTimeLengthN\=10001.bin n1=10001 \
+ labelsize=12 d1=0.001 style=normal linecolor=blue \
+ label1="start time (s)" label2="source duration (s)" \
+ d1num=1 d2num=1 wbox=8 hbox=4 x1end=5 > srcTimeLength.eps
+
+supswigp < src_nwav.su \
+ labelsize=10 label1='time (s)' label2='source number' x1end=6 \
+ d2=1 d2num=1 hbox=4 wbox=6 fill=0 \
+ titlesize=-1 > src_nwav.eps
+
+suwind < src_nwav.su key=tracl min=11 max=11 | \
+ supsgraph hbox=2 wbox=4 style=normal \
+ labelsize=10 label2='amplitude' label1='time (s)' \
+ titlesize=-1 d1num=1.0 > src11_wiggle.eps
+
+suwind < src_nwav.su key=tracl min=11 max=11 | \
+ supsgraph hbox=2 wbox=4 style=normal \
+ labelsize=10 label2='amplitude' label1='time (s)' \
+ titlesize=-1 x1end=0.05 > src11_wiggle_zbeg.eps
+
+suwind < src_nwav.su key=tracl min=11 max=11 | \
+ supsgraph hbox=2 wbox=4 style=normal \
+ labelsize=10 label2='amplitude' label1='time (s)' \
+ titlesize=-1 x1beg=3.60 x1end=3.65 > src11_wiggle_zend.eps
+
+suwind < src_nwav.su key=tracl min=11 max=11 | \
+ sufft | suamp| supsgraph hbox=2 wbox=4 style=normal \
+ labelsize=10 label2='amplitude' label1='frequency (Hz)' \
+ titlesize=-1 x1end=100 d1num=10 > src11_ampl.eps
+
+fconv file_in1=src_nwav.su auto=1 shift=1 mode=cor1 | \
+ sugain qbal=1 | \
+ supswigp x1beg=-1 x1end=1 d2num=1 hbox=4 wbox=6 \
+ labelsize=10 label2='source number' label1='time (s)' \
+ titlesize=-1 fill=0 > src_nwav_autoCorr_Norm.eps
+
+
diff --git a/fdelmodc3D/FiguresPaper/Figure2.scr b/fdelmodc3D/FiguresPaper/Figure2.scr
new file mode 100755
index 0000000000000000000000000000000000000000..c05fc2c4f852a65d4a9616f7ad19eb07cdf0d9eb
--- /dev/null
+++ b/fdelmodc3D/FiguresPaper/Figure2.scr
@@ -0,0 +1,104 @@
+#!/bin/bash
+#PBS -l nodes=1:ppn=2
+#PBS -N InterfModeling
+#PBS -V
+#
+# starts fdelmodc only to compute the source positions, 1 s.
+
+export PATH=../../bin:$PATH
+
+makemod sizex=10000 sizez=5000 dx=5 dz=5 cp0=0 ro0=1000 file_base=simple.su \
+ intt=def poly=0 x=0,10000 z=900,900 cp=1500 ro=1000 \
+ intt=def poly=0 x=0,10000 z=1300,1300 cp=2000 ro=1400 \
+ intt=def poly=2 x=0,2000,3000,5000,7000,8000,10000 \
+ z=2000,2000,2000,2500,2000,2000,2000 cp=4000 ro=2000 \
+ intt=def poly=0 x=0,10000 z=3000,3000 cp=3000 ro=1500 \
+ intt=def poly=0 x=0,10000 z=3500,3500 cp=5500 ro=2200
+
+suwind itmin=181 < simple_cp.su | sushw key=f1 a=0 > vel_cp.su
+suwind itmin=181 < simple_ro.su | sushw key=f1 a=0 > vel_ro.su
+
+xsrc1=100
+xsrc2=9900
+dxsrc=10
+
+#volume
+zsrc1=500
+zsrc2=4090
+
+tmod=0.01
+tsrc2=0.1
+tlength=0.01
+nsrc=1000
+fmax=30
+
+#Figure 2b,c,d,e,f
+
+file_shot=shotR_T${tmod}_S${nsrc}_Dt${tlength}_F${fmax}.su
+echo $file_shot
+
+#dummy modeling just to generate the source positions to be used in the Figure
+../fdelmodc \
+ file_cp=vel_cp.su ischeme=1 \
+ file_den=vel_ro.su \
+ file_rcv=$file_shot \
+ rec_type_p=0 \
+ dtrcv=0.008 \
+ rec_ntsam=16384 \
+ dt=0.0005 \
+ verbose=4 \
+ tmod=$tmod \
+ dxrcv=50.0 \
+ plane_wave=0 \
+ amplitude=0 \
+ xsrc=5000 zsrc=2700 \
+ src_random=1 \
+ wav_random=1 \
+ fmax=$fmax \
+ xsrc1=$xsrc1 \
+ xsrc2=$xsrc2 \
+ zsrc1=$zsrc1 \
+ zsrc2=$zsrc2 \
+ tsrc1=0.0 \
+ tsrc2=$tsrc2 \
+ tlength=$tlength \
+ nsrc=$nsrc \
+ ntaper=45 \
+ left=4 right=4 top=1 bottom=4
+
+
+#Figure 2
+suop2 SrcRecPositions.su vel_cp.su w1=7000 w2=1.0 op=sum | \
+ sugain nclip=1500 | \
+ sushw key=f1,f2 a=0,-5000 | \
+ supsimage hbox=6 wbox=8 labelsize=10 \
+ f2num=-5000 d2num=1000 f1num=-500 d1num=500 \
+ x2beg=-5000 x2end=5000 x1beg=-900 x1end=4000 \
+ bclip=7000 wclip=0 label1="depth (m)" label2="lateral position (m)" \
+ x2beg=-5000 x2end=5000 \
+ > simple_sources_cp.eps
+
+# laternative color scheme for above picture
+# wrgb=0,0,1.0 grgb=0,1.0,0 brgb=1.0,0,0 x2beg=-5000 x2end=5000 \
+
+supsimage hbox=6 wbox=8 labelsize=18 < vel_cp.su \
+ f2=-5000 f2num=-5000 d2num=1000 f1num=-500 d1num=500 \
+ x2beg=-5000 x2end=5000 x1beg=-900 x1end=4000 \
+ label1="depth (m)" label2="lateral position (m)" \
+ wrgb=0,0,1.0 grgb=0,1.0,0 brgb=1.0,0,0 x2beg=-5000 x2end=5000 \
+ > simple_cp.eps
+
+# use adapted psimage from su to plot points using curve function
+supsimage hbox=6 wbox=8 labelsize=10 < simple_cp.su \
+ f1=-900 f2=-5000 f2num=-5000 d2num=1000 f1num=-500 d1num=500 \
+ x2beg=-5000 x2end=5000 x1beg=-900 x1end=4000 \
+ label1="depth (m)" label2="lateral position (m)" \
+ wrgb=0,0,1.0 grgb=0,1.0,0 brgb=1.0,0,0 x2beg=-5000 x2end=5000 \
+ curve=SrcPositions1000.txt npair=1000 curvecolor=black curvedash=-1 curvewidth=1 \
+ > simple_srcpos_cp.eps
+
+supsimage hbox=6 wbox=8 labelsize=18 < SrcRecPositions.su\
+ f2num=50000 d2num=1000 f1num=50000 d1num=500 \
+ bclip=1 wclip=0 label1=" " label2=" "\
+ > sources.eps
+
diff --git a/fdelmodc3D/FiguresPaper/Figure20AppendixA.scr b/fdelmodc3D/FiguresPaper/Figure20AppendixA.scr
new file mode 100755
index 0000000000000000000000000000000000000000..bf5e23a95d7cb16bd38c1fa46a606dd87add83f4
--- /dev/null
+++ b/fdelmodc3D/FiguresPaper/Figure20AppendixA.scr
@@ -0,0 +1,148 @@
+#!/bin/bash
+#PBS -l nodes=1:ppn=2
+#PBS -N InterfModeling
+#PBS -V
+#
+
+cp=2000
+rho=1000
+dx=2.5
+dt=0.0001
+halfdt=`perl -e "print 0.5*$dt;"`
+
+export PATH=../../bin:$PATH
+
+makemod sizex=2000 sizez=2000 dx=$dx dz=$dx cp0=$cp ro0=$rho orig=-1000,0 file_base=simple.su
+makewave fp=15 dt=$dt file_out=wave.su nt=4096 t0=0.1
+
+######### MONOPOLE #######
+
+../fdelmodc \
+ file_cp=simple_cp.su ischeme=1 iorder=4 \
+ file_den=simple_ro.su \
+ file_src=wave.su \
+ file_rcv=shot_fd.su \
+ src_type=1 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.0005 \
+ verbose=2 \
+ tmod=0.5115 \
+ dxrcv=5.0 \
+ xrcv1=-500 xrcv2=500 \
+ zrcv1=500 zrcv2=500 \
+ xsrc=0 zsrc=1000 \
+ ntaper=80 \
+ left=4 right=4 top=4 bottom=4
+
+makewave fp=15 dt=0.0005 file_out=wave.su nt=4096 t0=0.1
+
+green c=$cp rho=$rho file_src=wave.su zsrc1=500 xrcv=-500,500 dxrcv=5 nt=4096 dip=0 | suwind nt=1024 > shot_green_rp.su
+green c=$cp rho=$rho file_src=wave.su zsrc1=500 xrcv=-500,500 dxrcv=5 nt=4096 dip=0 p_vz=1 | suwind nt=1024 > shot_green_rvz.su
+
+# rp
+(suwind key=tracl min=101 max=101 < shot_fd_rp.su | basop choice=shift shift=$halfdt; suwind key=tracl min=101 max=101 < shot_green_rp.su ) | basop choice=shift shift=-0.1 | supsgraph style=normal labelsize=10 wbox=4 hbox=2 label1='time in seconds' label2="Amplitude" linewidth=0.1 d2num=0.04 x2end=0.080 f2num=-0.4 > mon_rp.eps
+
+(suwind key=tracl min=101 max=101 < shot_fd_rp.su | basop choice=shift shift=$halfdt; suwind key=tracl min=101 max=101 < shot_green_rp.su;) | basop choice=shift shift=-0.1 | supsgraph style=normal labelsize=10 wbox=2 hbox=2 label1='time in seconds' label2="Amplitude" linewidth=0.1 linecolor=red,green x1beg=0.255 x1end=0.258 x2beg=0.0785 x2end=0.0797 d2num=0.0002 f2num=0.0786 > mon_zoom_rp.eps
+
+suwind key=tracl min=101 max=101 < shot_fd_rp.su | basop choice=shift shift=$halfdt > trace_fd.su
+suwind key=tracl min=101 max=101 < shot_green_rp.su > trace_green.su
+
+sumax < trace_green.su outpar=nep
+Mmax=`cat nep | awk '{print $1}'`
+a=`perl -e "print 100.0/$Mmax;"`
+echo $a
+
+sudiff trace_green.su trace_fd.su | basop choice=shift shift=-0.1 | sugain scale=$a | suop op=abs | supsgraph style=normal labelsize=12 wbox=4 hbox=2 label1='time in seconds' label2="Relative error in percentage of peak" linewidth=0.1 linecolor=red x2beg=0.0 x2end=1.0 f2num=0.0 d2num=0.5 > mon_diff_dx${dx}_rp.eps
+
+(suwind key=tracl min=101 max=101 < shot_fd_rp.su | basop choice=shift shift=$halfdt; suwind key=tracl min=101 max=101 < shot_green_rp.su ) | basop choice=shift shift=-0.1 | suxgraph
+
+
+# rvz
+
+(suwind key=tracl min=101 max=101 < shot_fd_rvz.su ; suwind key=tracl min=101 max=101 < shot_green_rvz.su ) | basop choice=shift shift=-0.1 | supsgraph style=normal labelsize=10 wbox=4 hbox=2 label1='time in seconds' label2="Amplitude" linewidth=0.1 d2num=2e-8 f2num=-4e-8 x2end=4e-8 x2beg=-2.7e-8 > mon_rvz.eps
+
+(suwind key=tracl min=101 max=101 < shot_fd_rvz.su ; suwind key=tracl min=101 max=101 < shot_green_rvz.su ) | basop choice=shift shift=-0.1 | supsgraph style=normal labelsize=10 wbox=2 hbox=2 label1='time in seconds' label2="Amplitude" linewidth=0.1 linecolor=red,green d2num=2e-10 f2num=3.86e-8 x2end=3.96e-8 x2beg=3.86e-8 x1beg=0.255 x1end=0.258 > mon_zoom_rvz.eps
+
+suwind key=tracl min=101 max=101 < shot_fd_rvz.su > trace_fd.su
+suwind key=tracl min=101 max=101 < shot_green_rvz.su > trace_green.su
+
+sumax < trace_green.su outpar=nep
+Mmax=`cat nep | awk '{print $1}'`
+a=`perl -e "print 100.0/$Mmax;"`
+echo $a
+
+sudiff trace_green.su trace_fd.su | basop choice=shift shift=-0.1 | sugain scale=$a | suop op=abs | supsgraph style=normal labelsize=12 wbox=4 hbox=2 label1='time in seconds' label2="Relative error in percentage of peak" linewidth=0.1 linecolor=red x2beg=0.0 x2end=1.0 f2num=0.0 d2num=0.5 > mon_diff_dx${dx}_rvz.eps
+
+(suwind key=tracl min=101 max=101 < shot_fd_rvz.su ; suwind key=tracl min=101 max=101 < shot_green_rvz.su) | basop choice=shift shift=-0.1 | suxgraph
+
+
+exit;
+
+######### DIPOLE #######
+
+makewave fp=15 dt=$dt file_out=wave.su nt=4096 t0=0.1
+
+fdelmodc \
+ file_cp=simple_cp.su ischeme=1 iorder=4 \
+ file_den=simple_ro.su \
+ file_src=wave.su \
+ file_rcv=shot_fd_dip.su \
+ src_type=1 \
+ src_orient=2 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.0005 \
+ verbose=2 \
+ tmod=0.5115 \
+ dxrcv=5.0 \
+ xrcv1=-500 xrcv2=500 \
+ zrcv1=500 zrcv2=500 \
+ xsrc=0 zsrc=1000 \
+ ntaper=80 \
+ left=4 right=4 top=4 bottom=4
+
+makewave fp=15 dt=0.0005 file_out=wave.su nt=4096 t0=0.1
+
+green c=$cp rho=$rho file_src=wave.su zsrc1=500 xrcv=-500,500 dxrcv=5 nt=4096 dip=1 | suwind nt=1024 > shot_green_dip_rp.su
+green c=$cp rho=$rho file_src=wave.su zsrc1=500 xrcv=-500,500 dxrcv=5 nt=4096 p_vz=1 dip=1 | suwind nt=1024 > shot_green_dip_rvz.su
+
+shift=`perl -e "print 0.5*$dx/$cp;"`
+
+# rp
+(suwind key=tracl min=101 max=101 < shot_fd_dip_rp.su | basop choice=shift shift=-$shift; suwind key=tracl min=101 max=101 < shot_green_dip_rp.su ) | basop choice=shift shift=-0.1 | supsgraph style=normal titlesize=-1 labelsize=10 wbox=4 hbox=2 label1='time in seconds' label2="Amplitude" linewidth=0.1 linecolor=red,green d2num=0.001 x2end=0.004001 f2num=-0.03 > dip_rp.eps
+
+(suwind key=tracl min=101 max=101 < shot_fd_dip_rp.su | basop choice=shift shift=-$shift; suwind key=tracl min=101 max=101 < shot_green_dip_rp.su ) | basop choice=shift shift=-0.1 | supsgraph style=normal labelsize=10 wbox=2 hbox=2 label1='time in seconds' label2="Amplitude" linewidth=0.1 linecolor=red,green x2beg=0.00379 x2end=0.00388 d2num=0.00002 f2num=0.00380 x1beg=0.2430 x1end=0.24601 f1num=0.243 d1num=0.002 > dip_zoom_rp.eps
+
+suwind key=tracl min=101 max=101 < shot_fd_dip_rp.su | basop choice=shift shift=-$shift > trace_fd.su
+suwind key=tracl min=101 max=101 < shot_green_dip_rp.su > trace_green.su
+
+sumax < trace_green.su outpar=nep
+Mmax=`cat nep | awk '{print $1}'`
+a=`perl -e "print 100.0/$Mmax;"`
+echo $a
+
+sudiff trace_green.su trace_fd.su | basop choice=shift shift=-0.1 | sugain scale=$a | suop op=abs | supsgraph style=normal labelsize=12 wbox=4 hbox=2 label1='time in seconds' label2="Relative error in percentage of peak" linewidth=0.1 linecolor=red x2beg=0.0 x2end=1.0 f2num=0.0 d2num=0.5 > dip_diff_dx${dx}_rp.eps
+
+(suwind key=tracl min=101 max=101 < shot_fd_dip_rp.su | basop choice=shift shift=-$shift ; suwind key=tracl min=101 max=101 < shot_green_dip_rp.su ) | basop choice=shift shift=-0.1 | suxgraph
+
+
+# rvz
+
+(suwind key=tracl min=101 max=101 < shot_fd_dip_rvz.su | basop choice=shift shift=-$shift; suwind key=tracl min=101 max=101 < shot_green_dip_rvz.su ) | basop choice=shift shift=-0.1 | supsgraph style=normal labelsize=10 wbox=4 hbox=2 label1='time in seconds' label2="Amplitude" linewidth=0.1 linecolor=red,green d2num=6e-10 f2num=-1.2e-9 x2end=2e-9 x2beg=-1.3e-9 > dip_rvz.eps
+
+(suwind key=tracl min=101 max=101 < shot_fd_dip_rvz.su | basop choice=shift shift=-$shift; suwind key=tracl min=101 max=101 < shot_green_dip_rvz.su ) | basop choice=shift shift=-0.1 | supsgraph style=normal labelsize=10 wbox=2 hbox=2 label1='time in seconds' label2="Amplitude" linewidth=0.1 linecolor=red,green d2num=2e-11 f2num=1.85e-9 x2end=1.944e-9 x2beg=1.85e-9 x1beg=0.2430 x1end=0.24601 f1num=0.243 d1num=0.002 > dip_zoom_rvz.eps
+
+suwind key=tracl min=101 max=101 < shot_fd_dip_rvz.su | basop choice=shift shift=-$shift > trace_fd.su
+suwind key=tracl min=101 max=101 < shot_green_dip_rvz.su > trace_green.su
+
+sumax < trace_green.su outpar=nep
+Mmax=`cat nep | awk '{print $1}'`
+a=`perl -e "print 100.0/$Mmax;"`
+echo $a
+
+sudiff trace_green.su trace_fd.su | basop choice=shift shift=-0.1 | sugain scale=$a | suop op=abs | supsgraph style=normal labelsize=12 wbox=4 hbox=2 label1='time in seconds' label2="Relative error in percentage of peak" linewidth=0.1 linecolor=red x2beg=0.0 x2end=1.0 f2num=0.0 d2num=0.5 > dip_diff_dx${dx}_rvz.eps
+
+(suwind key=tracl min=101 max=101 < shot_fd_dip_rvz.su | basop choice=shift shift=-$shift; suwind key=tracl min=101 max=101 < shot_green_dip_rvz.su ) | basop choice=shift shift=-0.1 | suxgraph
+
+
diff --git a/fdelmodc3D/FiguresPaper/Figure3.scr b/fdelmodc3D/FiguresPaper/Figure3.scr
new file mode 100755
index 0000000000000000000000000000000000000000..1845fe61292a1e155ac9fa585d1fddd02fca5d33
--- /dev/null
+++ b/fdelmodc3D/FiguresPaper/Figure3.scr
@@ -0,0 +1,106 @@
+#!/bin/bash
+#
+#Forward model all source positions one by one (this takes a very long time)
+#
+# calls Simple_model_base, and Simple_model_sides.scr, 122 hours!
+
+export PATH=../../bin:$PATH
+
+./Simple_model_base.scr
+./Simple_model_sides.scr
+
+# Correlation horizontal layer
+export dxsrc=10
+export xsrc1=1000
+export xsrc2=9000
+export xrcv1=0
+export xrcv2=10000
+export file_out=/tmp/corr.su
+export file_in=T_simple_dxrcv50_dx10.su
+export dxrcv=50
+
+(( nshots = ($xsrc2-$xsrc1)/$dxsrc + 1 ))
+(( nrecv = ($xrcv2-$xrcv1)/$dxrcv + 1 ))
+(( middle = $xsrc1 + (($nshots-1)/2)*$dxsrc ))
+(( xa = ($nrecv+1)/2 ))
+(( xsrc_sim = $xrcv1 + ($xa-1)*$dxrcv ))
+
+echo xsrc_sim=$xsrc_sim
+echo nshot=$nshots
+echo nrec=$nrecv
+echo xa=$xa
+echo middle=$middle
+
+# first do the correlation with the middle trace of each shot
+
+rm -rf $file_out
+for (( xsrc = $xsrc1; xsrc<=$xsrc2; xsrc+=$dxsrc )) do
+ echo $xsrc $middle;
+ sxkey=${xsrc}000
+ suwind key=sx min=$sxkey max=$sxkey < $file_in > shot.su
+ suwind key=tracl min=$xa max=$xa < shot.su | \
+ fconv mode=cor2 file_in1=shot.su shift=1 >> $file_out
+done;
+
+#then sort on constant gx values and stack all traces belonging to the same gx (=sum over sx)
+
+(( f2 = -($middle-$xrcv1) ))
+susort < $file_out gx > /tmp/corr_sort.su
+sustack key=gx < /tmp/corr_sort.su | sushw key=f2 a=$f2 > corr_stack${dxrcv}_${xsrc_sim}_${dxsrc}.su
+
+
+
+#Correlation sides
+export file_in=T_simple_sides_dxrcv50_dx10.su
+
+nshots=720
+export fldr1=902
+export fldr2=1621
+echo $xsrc_sim
+echo $nshots
+echo $nrecv
+echo $xa
+echo $middle
+
+rm -rf $file_out
+for (( fldr = $fldr1; fldr<=$fldr2; fldr+=1 )) do
+ echo $fldr;
+ suwind key=fldr min=$fldr max=$fldr < $file_in > shot.su
+ suwind key=tracl min=$xa max=$xa < shot.su | \
+ fconv mode=cor2 file_in1=shot.su shift=1 >> $file_out
+done;
+
+(( f2 = -($middle-$xrcv1) ))
+susort < $file_out gx > corr_sort.su
+sustack key=gx < corr_sort.su | sushw key=f2 a=$f2 > corr_stack${dxrcv}_sides_$xsrc_sim.su
+
+
+rm $file_out /tmp/corr_sort.su shot.su
+
+
+# sources at left and right sides of the model receivers on top gray scales dxrc
+
+cat corr_stack50_sides_5000.su | \
+ suwind tmax=4 tmin=0 f1=-8.008 | \
+ sushw key=f1,delrt a=0.0,0.0 | \
+ sufilter amps=0,0.5,1,1,0 f=0,2,3,50,60 | \
+ supsimage clip=2e-15 f1=0 f2=-5000 hbox=4 wbox=3 \
+ labelsize=10 f2num=-5000 d2num=2500 \
+ label1='time (s)' label2='lateral position (m)' > SimCorr50_sides_sx5000_simple.eps
+
+cat corr_stack50_5000_10.su | \
+ suwind tmax=4 tmin=0 f1=-8.008 | \
+ sushw key=f1,delrt a=0.0,0.0 | \
+ sufilter amps=0,0.5,1,1,0 f=0,2,3,50,60 | \
+ supsimage clip=2e-15 f1=0 f2=-5000 hbox=4 wbox=3 \
+ labelsize=10 f2num=-5000 d2num=2500 \
+ label1='time (s)' label2='lateral position (m)'> SimCorr50_sx5000_simple.eps
+
+susum corr_stack50_5000_10.su corr_stack50_sides_5000.su | \
+ suwind tmax=4 tmin=0 f1=-8.008 | \
+ sushw key=f1,delrt a=0.0,0.0 | \
+ sufilter amps=0,0.5,1,1,0 f=0,2,3,50,60 | \
+ supsimage clip=2e-15 f1=0 f2=-5000 hbox=4 wbox=3 \
+ labelsize=10 f2num=-5000 d2num=2500 \
+ label1='time (s)' label2='lateral position (m)'> SimCorr50_add_sides_sx5000_simple.eps
+
diff --git a/fdelmodc3D/FiguresPaper/Figure3_nofree.scr b/fdelmodc3D/FiguresPaper/Figure3_nofree.scr
new file mode 100755
index 0000000000000000000000000000000000000000..51083b3e51d937ae04989adee8092b785a6a3b78
--- /dev/null
+++ b/fdelmodc3D/FiguresPaper/Figure3_nofree.scr
@@ -0,0 +1,58 @@
+#!/bin/bash
+#PBS -l nodes=1:ppn=2
+#PBS -N InterfModeling
+#PBS -V
+#
+# direct modeled reference result Figure 3d, 500 s.
+
+export PATH=../../bin:$PATH
+
+makewave w=g1 fmax=45 t0=0.15 dt=0.0005 nt=4096 db=-40 file_out=G1.su verbose=1
+cp G1.su G1_c.su
+
+fconv file_in1=G1.su file_in2=G1_c.su mode=cor1 verbose=1 > corrw.su
+ basop choice=shift shift=0.2 dx=1 file_in=corrw.su > G1corr.su
+
+makemod sizex=10000 sizez=5000 dx=5 dz=5 cp0=1500 ro0=1000 file_base=simple.su \
+ intt=def poly=0 x=0,10000 z=1300,1300 cp=2000 ro=1400 \
+ intt=def poly=2 x=0,2000,3000,5000,7000,8000,10000 \
+ z=2000,2000,2000,2500,2000,2000,2000 cp=4000 ro=2000 \
+ intt=def poly=0 x=0,10000 z=3000,3000 cp=3000 ro=1500 \
+ intt=def poly=0 x=0,10000 z=3500,3500 cp=5500 ro=2200
+
+sushw key=f1 a=-900 < simple_cp.su > vel_cp.su
+sushw key=f1 a=-900 < simple_ro.su > vel_ro.su
+
+xsrc=5000
+
+file_shot=shotRefNoFree_x${xsrc}.su
+
+../fdelmodc \
+ file_cp=vel_cp.su ischeme=1 \
+ file_den=vel_ro.su \
+ file_src=G1corr.su \
+ fmax=45 \
+ file_rcv=$file_shot \
+ rec_type_p=0 \
+ dtrcv=0.008 \
+ verbose=4 \
+ rec_delay=0.2 \
+ tmod=4.2 \
+ dxrcv=50.0 \
+ zrcv1=0 \
+ zrcv2=0 \
+ xrcv1=0 xrcv2=10000 \
+ plane_wave=0 \
+ amplitude=0 \
+ xsrc=${xsrc} zsrc=0 \
+ ntaper=45 \
+ left=4 right=4 top=4 bottom=4
+
+
+suwind s=1 j=1 tmax=4.008 f1=0.0 < shotRefNofree_x${xsrc}_rvz.su | \
+ sushw key=f1,delrt,d2 a=0.0,0.0,50 | \
+ sugain scale=-1 | \
+ supsimage f1=0 f2=-5000 hbox=4 wbox=3 x1end=4.0 \
+ labelsize=10 f2num=-5000 d2num=2500 verbose=1 clip=2e-7 \
+ label1='time (s)' label2='lateral position (m)' > shotRefNofree_5000_0.eps
+
diff --git a/fdelmodc3D/FiguresPaper/Figure3_ref.scr b/fdelmodc3D/FiguresPaper/Figure3_ref.scr
new file mode 100755
index 0000000000000000000000000000000000000000..442210cbf91be24acc14788e2a396ff60120f78c
--- /dev/null
+++ b/fdelmodc3D/FiguresPaper/Figure3_ref.scr
@@ -0,0 +1,55 @@
+#!/bin/bash
+#PBS -l nodes=1:ppn=2
+#PBS -N InterfModeling
+#PBS -V
+#
+# direct modeled reference result Figure 3d, 500 s.
+
+export PATH=../../bin:$PATH
+
+makewave w=g1 fmax=45 t0=0.15 dt=0.0005 nt=4096 db=-40 file_out=G1.su verbose=1
+cp G1.su G1_c.su
+
+fconv file_in1=G1.su file_in2=G1_c.su mode=cor1 verbose=1 > corrw.su
+ basop choice=shift shift=0.2 dx=1 file_in=corrw.su > G1corr.su
+
+makemod sizex=10000 sizez=5000 dx=5 dz=5 cp0=1500 ro0=1000 file_base=simple.su \
+ intt=def poly=0 x=0,10000 z=1300,1300 cp=2000 ro=1400 \
+ intt=def poly=2 x=0,2000,3000,5000,7000,8000,10000 \
+ z=2000,2000,2000,2500,2000,2000,2000 cp=4000 ro=2000 \
+ intt=def poly=0 x=0,10000 z=3000,3000 cp=3000 ro=1500 \
+ intt=def poly=0 x=0,10000 z=3500,3500 cp=5500 ro=2200
+
+suwind itmin=181 < simple_cp.su | sushw key=f1 a=0 > vel_cp.su
+suwind itmin=181 < simple_ro.su | sushw key=f1 a=0 > vel_ro.su
+
+xsrc=5000
+
+file_shot=shotRef_x${xsrc}.su
+
+../fdelmodc \
+ file_cp=vel_cp.su ischeme=1 \
+ file_den=vel_ro.su \
+ file_src=G1corr.su \
+ fmax=45 \
+ file_rcv=$file_shot \
+ rec_type_p=0 \
+ dtrcv=0.008 \
+ verbose=4 \
+ rec_delay=0.2 \
+ tmod=0.5 \
+ dxrcv=50.0 \
+ plane_wave=0 \
+ amplitude=0 \
+ xsrc=${xsrc} zsrc=5 \
+ ntaper=45 \
+ left=4 right=4 top=1 bottom=4 verbose=1
+
+
+suwind s=1 j=1 tmax=4.008 f1=0.0 < shotRef_x${xsrc}_rvz.su | \
+ sushw key=f1,delrt,d2 a=0.0,0.0,50 | \
+ sugain scale=-1 | \
+ supsimage f1=0 f2=-5000 hbox=4 wbox=3 x1end=4.0 \
+ labelsize=10 f2num=-5000 d2num=2500 verbose=1 clip=2e-7 \
+ label1='Time (s)' label2='Lateral position (m)' > shotRef_5000_0.eps
+
diff --git a/fdelmodc3D/FiguresPaper/Figure4.scr b/fdelmodc3D/FiguresPaper/Figure4.scr
new file mode 100755
index 0000000000000000000000000000000000000000..991f0753d8ab0f66604c12adeb5e6ecc9a5ac3f7
--- /dev/null
+++ b/fdelmodc3D/FiguresPaper/Figure4.scr
@@ -0,0 +1,75 @@
+#!/bin/bash
+#PBS -l nodes=1:ppn=2
+#PBS -N InterfModeling
+#PBS -V
+#
+# inside the length loop the script SIrand.scr is called to compute the retrieved response from the modeled data
+# 5 different source signature lengths, 5x3.5 hours
+
+
+export PATH=../../bin:$PATH
+
+makemod sizex=10000 sizez=5000 dx=5 dz=5 cp0=1500 ro0=1000 file_base=simple.su \
+ intt=def poly=0 x=0,10000 z=1300,1300 cp=2000 ro=1400 \
+ intt=def poly=2 x=0,2000,3000,5000,7000,8000,10000 \
+ z=2000,2000,2000,2500,2000,2000,2000 cp=4000 ro=2000 \
+ intt=def poly=0 x=0,10000 z=3000,3000 cp=3000 ro=1500 \
+ intt=def poly=0 x=0,10000 z=3500,3500 cp=5500 ro=2200
+
+suwind itmin=181 < simple_cp.su | sushw key=f1 a=0 > vel_cp.su
+suwind itmin=181 < simple_ro.su | sushw key=f1 a=0 > vel_ro.su
+
+xsrc1=100
+xsrc2=9900
+dxsrc=10
+
+#volume
+zsrc1=500
+zsrc2=4090
+
+tmod=120
+tsrc2=120
+tlength=120
+nsrc=1000
+fmax=30
+
+#Figure 7b,c,d,e,f
+for tlength in 120 60 30 10 5;
+do
+
+ file_shot=shotR_T${tmod}_S${nsrc}_Dt${tlength}_F${fmax}.su
+ echo $file_shot
+
+ fdelmodc \
+ file_cp=vel_cp.su ischeme=1 \
+ file_den=vel_ro.su \
+ file_rcv=$file_shot \
+ rec_type_p=0 \
+ dtrcv=0.008 \
+ rec_ntsam=16384 \
+ dt=0.0005 \
+ verbose=2 \
+ tmod=$tmod \
+ dxrcv=50.0 \
+ plane_wave=0 \
+ amplitude=0 \
+ xsrc=5000 zsrc=2700 \
+ src_random=1 \
+ wav_random=1 \
+ fmax=$fmax \
+ xsrc1=$xsrc1 \
+ xsrc2=$xsrc2 \
+ zsrc1=$zsrc1 \
+ zsrc2=$zsrc2 \
+ tsrc1=0.0 \
+ tsrc2=$tsrc2 \
+ tlength=$tlength \
+ nsrc=$nsrc \
+ ntaper=45 \
+ left=4 right=4 top=1 bottom=4
+
+ base=`echo $file_shot | awk 'BEGIN { FS = "." } ; { print $1 }'`
+ echo $base
+ SIrand.scr ${base}_rvz.su 50
+done
+
diff --git a/fdelmodc3D/FiguresPaper/Figure5.scr b/fdelmodc3D/FiguresPaper/Figure5.scr
new file mode 100755
index 0000000000000000000000000000000000000000..414a6d4ed18d6f36a5bd23bf0acbf60678c3ce82
--- /dev/null
+++ b/fdelmodc3D/FiguresPaper/Figure5.scr
@@ -0,0 +1,66 @@
+#!/bin/bash
+#PBS -l nodes=1:ppn=2
+#PBS -N InterfModeling
+#PBS -V
+#
+# simulates 8000 short (2.5 s) sources, 3.5 hours
+
+export PATH=../../bin:$PATH
+
+makemod sizex=10000 sizez=5000 dx=5 dz=5 cp0=1500 ro0=1000 file_base=simple.su \
+ intt=def poly=0 x=0,10000 z=1300,1300 cp=2000 ro=1400 \
+ intt=def poly=2 x=0,2000,3000,5000,7000,8000,10000 \
+ z=2000,2000,2000,2500,2000,2000,2000 cp=4000 ro=2000 \
+ intt=def poly=0 x=0,10000 z=3000,3000 cp=3000 ro=1500 \
+ intt=def poly=0 x=0,10000 z=3500,3500 cp=5500 ro=2200
+
+suwind itmin=181 < simple_cp.su | sushw key=f1 a=0 > vel_cp.su
+suwind itmin=181 < simple_ro.su | sushw key=f1 a=0 > vel_ro.su
+
+xsrc1=100
+xsrc2=9900
+
+#volume
+tmod=120
+tsrc2=120
+fmax=30
+
+zsrc1=500
+zsrc2=4090
+tlength=5
+nsrc=8000
+
+file_shot=shotR_T${tmod}_S${nsrc}_Dt${tlength}_F${fmax}.su
+
+fdelmodc \
+ file_cp=vel_cp.su ischeme=1 \
+ file_den=vel_ro.su \
+ file_rcv=$file_shot \
+ rec_type_p=0 \
+ dtrcv=0.008 \
+ rec_ntsam=16384 \
+ dt=0.0005 \
+ verbose=2 \
+ tmod=$tmod \
+ dxrcv=50.0 \
+ plane_wave=0 \
+ amplitude=0 \
+ xsrc=5000 zsrc=2700 \
+ src_random=1 \
+ wav_random=1 \
+ fmax=$fmax \
+ xsrc1=$xsrc1 \
+ xsrc2=$xsrc2 \
+ zsrc1=$zsrc1 \
+ zsrc2=$zsrc2 \
+ tsrc1=0.0 \
+ tsrc2=$tsrc2 \
+ tlength=$tlength \
+ nsrc=$nsrc \
+ ntaper=45 \
+ left=4 right=4 top=1 bottom=4
+
+ base=`echo $file_shot | awk 'BEGIN { FS = "." } ; { print $1 }'`
+ echo $base
+ SIrand.scr ${base}_rvz.su
+
diff --git a/fdelmodc3D/FiguresPaper/Figure6.scr b/fdelmodc3D/FiguresPaper/Figure6.scr
new file mode 100755
index 0000000000000000000000000000000000000000..0f241a79538cab379eee1c737f4bc9dceb263e54
--- /dev/null
+++ b/fdelmodc3D/FiguresPaper/Figure6.scr
@@ -0,0 +1,102 @@
+#!/bin/bash
+#PBS -l nodes=1:ppn=2
+#PBS -N InterfModeling
+#PBS -V
+#
+# 5 different number of random sources, 5x3.5 hours
+
+export PATH=../../bin:$PATH
+
+#makewave w=g1 fp=10 t0=0.15 dt=0.0010 nt=4096 file_out=G2.su verbose=1
+
+makemod sizex=10000 sizez=5000 dx=5 dz=5 cp0=1500 ro0=1000 file_base=simple.su \
+ intt=def poly=0 x=0,10000 z=1300,1300 cp=2000 ro=1400 \
+ intt=def poly=2 x=0,2000,3000,5000,7000,8000,10000 \
+ z=2000,2000,2000,2500,2000,2000,2000 cp=4000 ro=2000 \
+ intt=def poly=0 x=0,10000 z=3000,3000 cp=3000 ro=1500 \
+ intt=def poly=0 x=0,10000 z=3500,3500 cp=5500 ro=2200
+
+suwind itmin=181 < simple_cp.su | sushw key=f1 a=0 > vel_cp.su
+suwind itmin=181 < simple_ro.su | sushw key=f1 a=0 > vel_ro.su
+
+xsrc1=100
+xsrc2=9900
+
+#volume
+zsrc1=500
+zsrc2=4090
+
+tmod=120
+tsrc2=120
+tlength=120
+fmax=30
+
+#Figure 6a,b,c,d,e
+rm Trace.su
+for nsrc in 8000 1000 500 100 50;
+do
+
+ file_shot=shotR_T${tmod}_S${nsrc}_Dt${tsrc2}_F${fmax}.su
+ echo $file_shot
+
+ fdelmodc \
+ file_cp=vel_cp.su ischeme=1 \
+ file_den=vel_ro.su \
+ file_rcv=$file_shot \
+ rec_type_p=0 \
+ dtrcv=0.008 \
+ rec_ntsam=16384 \
+ dt=0.0005 \
+ verbose=2 \
+ tmod=$tmod \
+ dxrcv=50.0 \
+ plane_wave=0 \
+ amplitude=0 \
+ xsrc=5000 zsrc=2700 \
+ src_random=1 \
+ wav_random=1 \
+ fmax=$fmax \
+ xsrc1=$xsrc1 \
+ xsrc2=$xsrc2 \
+ zsrc1=$zsrc1 \
+ zsrc2=$zsrc2 \
+ tsrc1=0.0 \
+ tsrc2=$tsrc2 \
+ tlength=$tlength \
+ nsrc=$nsrc \
+ ntaper=45 \
+ left=4 right=4 top=1 bottom=4
+
+ base=`echo $file_shot | awk 'BEGIN { FS = "." } ; { print $1 }'`
+ echo $base
+ SIrand.scr ${base}_rvz.su
+
+ ntraces=`surange < ${base}_rvz.su | grep traces| awk '{print $1 }'`
+ echo $ntraces
+ middle=$(echo "scale=0; ($ntraces+1)/2"| bc -l)
+ echo $middle
+
+ susum causal.su noncausal.su | \
+ suwind s=1 j=1 tmax=4 f1=0.0 | \
+ sushw key=f1,delrt,d2,fldr a=0.0,0.0,50,8000 | \
+ suwind key=tracl min=$middle max=$middle >> Trace.su
+
+done
+
+#add reference trace to trace comparison
+suwind key=tracf min=101 max=101 < shotRef_x5000_rvz.su | sugain scale=-1 >> Trace.su
+
+suwind tmin=1.5 tmax=3.0 f1=0.0 < Trace.su | \
+ sunormalize norm=max | \
+ supsgraph \
+ hbox=4 wbox=3 labelsize=10 x1beg=1.5 x1end=3.0 \
+ linecolor=red,green,blue,emerald,black f1=1.5 d1num=0.5 \
+ label1='time (s)' > shotTraces_T120_S_Dt120_F30.eps
+
+suwind tmin=1.5 tmax=3.1 f1=0.0 < Trace.su | \
+ sunormalize norm=max | \
+ supswigp \
+ hbox=4 wbox=3 labelsize=10 x1beg=1.5 x1end=3.0 \
+ f1=1.5 d1num=0.5 linewidth=1 fill=0 f2=1 d2=1 d2num=1 \
+ label1='time (s)' label2='number of sources' > shotWiggles_T120_S_Dt120_F30.eps
+
diff --git a/fdelmodc3D/FiguresPaper/Figure6f.scr b/fdelmodc3D/FiguresPaper/Figure6f.scr
new file mode 100755
index 0000000000000000000000000000000000000000..095397329b266de7e3e8385c233d387faeb6beba
--- /dev/null
+++ b/fdelmodc3D/FiguresPaper/Figure6f.scr
@@ -0,0 +1,59 @@
+#!/bin/bash
+#
+# make postscript file of middle trace after Figure6.scr, 1 s.
+
+shot=shotR_T120_S8000_Dt120_F30_rvz.su
+base=`echo $shot | awk 'BEGIN { FS = "." } ; { print $1 }'`
+echo $base
+
+ntraces=`surange < $shot | grep traces| awk '{print $1 }'`
+echo $ntraces
+middle=$(echo "scale=0; ($ntraces+1)/2"| bc -l)
+echo $middle
+
+./SIrand.scr $shot
+susum causal.su noncausal.su | \
+ suwind s=1 j=1 tmax=4 f1=0.0 | \
+ sushw key=f1,delrt,d2,fldr a=0.0,0.0,50,8000 | \
+ suwind key=tracl min=$middle max=$middle > Trace.su
+
+shot=shotR_T120_S1000_Dt120_F30_rvz.su
+./SIrand.scr $shot
+susum causal.su noncausal.su | \
+ suwind s=1 j=1 tmax=4 f1=0.0 | \
+ sushw key=f1,delrt,d2,fldr a=0.0,0.0,50,1000 | \
+ suwind key=tracl min=$middle max=$middle >> Trace.su
+
+shot=shotR_T120_S500_Dt120_F30_rvz.su
+./SIrand.scr $shot
+susum causal.su noncausal.su | \
+ suwind s=1 j=1 tmax=4 f1=0.0 | \
+ sushw key=f1,delrt,d2,fldr a=0.0,0.0,50,500 | \
+ suwind key=tracl min=$middle max=$middle >> Trace.su
+
+shot=shotR_T120_S100_Dt120_F30_rvz.su
+./SIrand.scr $shot
+susum causal.su noncausal.su | \
+ suwind s=1 j=1 tmax=4 f1=0.0 | \
+ sushw key=f1,delrt,d2,fldr a=0.0,0.0,50,100 | \
+ suwind key=tracl min=$middle max=$middle >> Trace.su
+
+suwind s=1 j=1 tmax=4 f1=0.0 < shotRef_5000_0_rvz.su | \
+ sushw key=f1,delrt,d2,fldr a=0.0,0.0,50,100 | \
+ suwind key=tracl min=$middle max=$middle >> Trace.su
+
+suwind tmin=1.5 tmax=3.0 f1=0.0 < Trace.su | \
+ sunormalize norm=max | \
+ supsgraph \
+ hbox=4 wbox=3 labelsize=10 x1beg=1.5 x1end=3.0 \
+ linecolor=red,green,blue,emerald,black f1=1.5 d1num=0.5 \
+ > shotTraces_T120_S_Dt120_F30.eps
+
+suwind tmin=1.5 tmax=3.1 f1=0.0 < Trace.su | \
+ sunormalize norm=max | \
+ supswigp \
+ hbox=4 wbox=3 labelsize=10 x1beg=1.5 x1end=3.0 \
+ f1=1.5 d1num=0.5 linewidth=1 fill=0 f2=1 d2=1 \
+ label1='time (s)' label2='number of sources' > shotWiggles_T120_S_Dt120_F30.eps
+
+
diff --git a/fdelmodc3D/FiguresPaper/Figure6length.scr b/fdelmodc3D/FiguresPaper/Figure6length.scr
new file mode 100755
index 0000000000000000000000000000000000000000..20d299b80d2f17231f08ea10b3b0b46bfac58460
--- /dev/null
+++ b/fdelmodc3D/FiguresPaper/Figure6length.scr
@@ -0,0 +1,100 @@
+#!/bin/bash
+#PBS -l nodes=1:ppn=2
+#PBS -N InterfModeling
+#PBS -V
+#
+# alternative not used in paper, fixed source signature length, 5x3.5 hours
+
+export PATH=../../bin:$PATH
+
+#makewave w=g1 fp=10 t0=0.15 dt=0.0010 nt=4096 file_out=G2.su verbose=1
+
+makemod sizex=10000 sizez=5000 dx=5 dz=5 cp0=1500 ro0=1000 file_base=simple.su \
+ intt=def poly=0 x=0,10000 z=1300,1300 cp=2000 ro=1400 \
+ intt=def poly=2 x=0,2000,3000,5000,7000,8000,10000 \
+ z=2000,2000,2000,2500,2000,2000,2000 cp=4000 ro=2000 \
+ intt=def poly=0 x=0,10000 z=3000,3000 cp=3000 ro=1500 \
+ intt=def poly=0 x=0,10000 z=3500,3500 cp=5500 ro=2200
+
+suwind itmin=181 < simple_cp.su | sushw key=f1 a=0 > vel_cp.su
+suwind itmin=181 < simple_ro.su | sushw key=f1 a=0 > vel_ro.su
+
+xsrc1=100
+xsrc2=9900
+
+#volume
+zsrc1=500
+zsrc2=4090
+
+tmod=120
+tsrc2=120
+tlength=120
+fmax=30
+
+#Figure 6a,b,c,d,e
+rm Trace.su
+for nsrc in 8000 1000 500 100 50;
+do
+
+ file_shot=shotRVt_T${tmod}_S${nsrc}_Dt${tlength}_F${fmax}.su
+ echo $file_shot
+
+fdelmodc \
+ file_cp=vel_cp.su ischeme=1 \
+ file_den=vel_ro.su \
+ file_rcv=$file_shot \
+ rec_type_p=0 \
+ dtrcv=0.008 \
+ rec_ntsam=16384 \
+ dt=0.0005 \
+ verbose=4 \
+ tmod=$tmod \
+ dxrcv=50.0 \
+ plane_wave=0 \
+ amplitude=0 \
+ xsrc=5000 zsrc=2700 \
+ src_random=1 \
+ wav_random=1 \
+ length_random=0 \
+ fmax=$fmax \
+ xsrc1=$xsrc1 \
+ xsrc2=$xsrc2 \
+ zsrc1=$zsrc1 \
+ zsrc2=$zsrc2 \
+ tsrc1=0.0 \
+ tsrc2=$tsrc2 \
+ tlength=$tlength \
+ nsrc=$nsrc \
+ ntaper=45 \
+ left=4 right=4 top=1 bottom=4
+
+ base=`echo $file_shot | awk 'BEGIN { FS = "." } ; { print $1 }'`
+ echo $base
+ SIrand.scr ${base}_rvz.su
+
+ ntraces=`surange < ${base}_rvz.su | grep traces| awk '{print $1 }'`
+ echo $ntraces
+ middle=$(echo "scale=0; ($ntraces+1)/2"| bc -l)
+ echo $middle
+
+ susum causal.su noncausal.su | \
+ suwind s=1 j=1 tmax=4 f1=0.0 | \
+ sushw key=f1,delrt,d2,fldr a=0.0,0.0,50,8000 | \
+ suwind key=tracl min=$middle max=$middle >> Trace.su
+
+done
+
+suwind tmin=1.5 tmax=3.0 f1=0.0 < Trace.su | \
+ sunormalize norm=max | \
+ supsgraph \
+ hbox=4 wbox=3 labelsize=10 x1beg=1.5 x1end=3.0 \
+ linecolor=red,green,blue,emerald,black f1=1.5 d1num=0.5 \
+ label1='time (s)' > shotTracesVt_T120_S_Dt120_F30.eps
+
+suwind tmin=1.5 tmax=3.1 f1=0.0 < Trace.su | \
+ sunormalize norm=max | \
+ supswigp \
+ hbox=4 wbox=3 labelsize=10 x1beg=1.5 x1end=3.0 \
+ f1=1.5 d1num=0.5 linewidth=1 fill=0 f2=1 d2=1 \
+ label1='time (s)' label2='number of sources' > shotWigglesVt_T120_S_Dt120_F30.eps
+
diff --git a/fdelmodc3D/FiguresPaper/Figure6long.scr b/fdelmodc3D/FiguresPaper/Figure6long.scr
new file mode 100755
index 0000000000000000000000000000000000000000..a51cc1ff3a740cce9be1d749219ef84cda1c4656
--- /dev/null
+++ b/fdelmodc3D/FiguresPaper/Figure6long.scr
@@ -0,0 +1,126 @@
+#!/bin/bash
+#PBS -l nodes=1:ppn=2
+#PBS -N InterfModeling
+#PBS -V
+#
+export PATH=../../bin:$PATH
+
+#makewave w=g1 fp=10 t0=0.15 dt=0.0010 nt=4096 file_out=G2.su verbose=1
+
+makemod sizex=10000 sizez=5000 dx=5 dz=5 cp0=1500 ro0=1000 file_base=simple.su \
+ intt=def poly=0 x=0,10000 z=1300,1300 cp=2000 ro=1400 \
+ intt=def poly=2 x=0,2000,3000,5000,7000,8000,10000 \
+ z=2000,2000,2000,2500,2000,2000,2000 cp=4000 ro=2000 \
+ intt=def poly=0 x=0,10000 z=3000,3000 cp=3000 ro=1500 \
+ intt=def poly=0 x=0,10000 z=3500,3500 cp=5500 ro=2200
+
+suwind itmin=181 < simple_cp.su | sushw key=f1 a=0 > vel_cp.su
+suwind itmin=181 < simple_ro.su | sushw key=f1 a=0 > vel_ro.su
+
+xsrc1=100
+xsrc2=9900
+dxsrc=10
+
+#volume
+zsrc1=500
+zsrc2=4090
+
+tmod=3600
+tsrc2=3600
+tlength=16
+fmax=30
+
+#Figure 6a,b,c,d,e
+rm Trace.su
+for nsrc in 1000;
+do
+
+ file_shot=shotR_T${tmod}_S${nsrc}_Dt${tlength}_F${fmax}.su
+ echo $file_shot
+
+$HOME/bin64/fdelmodc \
+ file_cp=vel_cp.su ischeme=1 \
+ file_den=vel_ro.su \
+ file_rcv=$file_shot \
+ rec_type_p=0 \
+ dtrcv=0.008 \
+ rec_ntsam=16384 \
+ dt=0.0005 \
+ verbose=1 \
+ tmod=$tmod \
+ dxrcv=50.0 \
+ plane_wave=0 \
+ amplitude=0 \
+ xsrc=5000 zsrc=2700 \
+ src_random=1 \
+ wav_random=1 \
+ fmax=$fmax \
+ xsrc1=$xsrc1 \
+ xsrc2=$xsrc2 \
+ zsrc1=$zsrc1 \
+ zsrc2=$zsrc2 \
+ tsrc1=0.0 \
+ tsrc2=$tsrc2 \
+ tlength=$tlength \
+ nsrc=$nsrc \
+ ntaper=45 \
+ left=4 right=4 top=1 bottom=4
+
+# base=`echo $file_shot | awk 'BEGIN { FS = "." } ; { print $1 }'`
+# echo $base
+# SIrand.scr ${base}_rvz.su
+#
+# ntraces=`surange < ${base}_rvz.su | grep traces| awk '{print $1 }'`
+# echo $ntraces
+# middle=$(echo "scale=0; ($ntraces+1)/2"| bc -l)
+# echo $middle
+#
+# susum causal.su noncausal.su | \
+# suwind s=1 j=1 tmax=4 f1=0.0 | \
+# sushw key=f1,delrt,d2,fldr a=0.0,0.0,50,8000 | \
+# suwind key=tracl min=$middle max=$middle >> Trace.su
+
+done
+
+exit;
+
+
+#for testing correlation noise
+export OMP_NUM_THREADS=1
+$HOME/src/CorrSMP_FD_Files/corrsmp file_base=shotR_T3600_S1000_Dt3600_F30_001_rvz.su ntc=2048 fmax=60 verbose=3 nstation=201
+file_out=corrsmp_odd.su nc=1 fullcorr=1 dt=0.004 nt=16384
+
+$HOME/src/CorrSMP_FD_Files/corrsmp file_base=shotR_T3600_S1000_Dt3600_F30_001_rvz.su ntc=2048 fmax=60 verbose=3 nstation=201
+file_out=corrsmp_sum.su nc=1 fullcorr=1 dt=0.004 nt=16384
+
+suwind key=fldr min=101 max=101 < corrsmp_out.su_cc1.su | suximage perc=99 x1end=4 title=all clip=0.003
+
+suwind key=fldr min=101 max=101 < corrsmp_odd.su_cc1.su | suximage perc=99 x1end=4 title=odd clip=0.003
+
+suwind key=fldr min=101 max=101 < corrsmp_sum.su_cc1.su | suximage perc=99 x1end=4 title=sum clip=0.003
+
+
+#16 sec source length
+$HOME/src/CorrSMP_FD_Files/corrsmp file_base=shotR_T3600_S1000_Dt16_F30_001_rvz.su ntc=2048 fmax=60 \
+ verbose=3 nstation=201 file_out=corrsmp_all_Dt16.su nc=1 fullcorr=1 dt=0.004 nt=16384
+suwind key=fldr min=101 max=101 < corrsmp_all_Dt16.su_cc1.su | suximage perc=99 x1end=4 title=all clip=0.003
+
+$HOME/src/CorrSMP_FD_Files/corrsmp file_base=shotR_T3600_S1000_Dt16_F30_001_rvz.su ntc=512 fmax=60 \
+ verbose=3 nstation=201 file_out=corrsmp_sum_Dt16.su nc=1 fullcorr=1 dt=0.004 nt=16384
+suwind key=fldr min=101 max=101 < corrsmp_sum_Dt16.su_cc1.su | suximage perc=99 x1end=4 title=sum clip=0.003
+
+
+suwind tmin=1.5 tmax=3.0 f1=0.0 < Trace.su | \
+ sunormalize norm=max | \
+ supsgraph \
+ hbox=4 wbox=3 labelsize=10 x1beg=1.5 x1end=3.0 \
+ linecolor=red,green,blue,emerald,black f1=1.5 d1num=0.5 \
+ label1='time (s)' > shotTraces_T120_S_Dt120_F30.eps
+
+suwind tmin=1.5 tmax=3.1 f1=0.0 < Trace.su | \
+ sunormalize norm=max | \
+ supswigp \
+ hbox=4 wbox=3 labelsize=10 x1beg=1.5 x1end=3.0 \
+ f1=1.5 d1num=0.5 linewidth=1 fill=0 f2=1 d2=1 \
+ label1='time (s)' label2='number of sources' > shotWiggles_T120_S_Dt120_F30.eps
+
diff --git a/fdelmodc3D/FiguresPaper/Figure7.scr b/fdelmodc3D/FiguresPaper/Figure7.scr
new file mode 100755
index 0000000000000000000000000000000000000000..f4214fd17ee3669ffd4ec3bf8f49c64a40e81b37
--- /dev/null
+++ b/fdelmodc3D/FiguresPaper/Figure7.scr
@@ -0,0 +1,98 @@
+#!/bin/bash
+#PBS -l nodes=1:ppn=2
+#PBS -N InterfModeling
+#PBS -V
+#
+# as Figure 6, but with 1000 deep sources, 3.5 hours
+
+export PATH=../../bin:$PATH
+
+makemod sizex=10000 sizez=5000 dx=5 dz=5 cp0=1500 ro0=1000 file_base=simple.su \
+ intt=def poly=0 x=0,10000 z=1300,1300 cp=2000 ro=1400 \
+ intt=def poly=2 x=0,2000,3000,5000,7000,8000,10000 \
+ z=2000,2000,2000,2500,2000,2000,2000 cp=4000 ro=2000 \
+ intt=def poly=0 x=0,10000 z=3000,3000 cp=3000 ro=1500 \
+ intt=def poly=0 x=0,10000 z=3500,3500 cp=5500 ro=2200
+
+suwind itmin=181 < simple_cp.su | sushw key=f1 a=0 > vel_cp.su
+suwind itmin=181 < simple_ro.su | sushw key=f1 a=0 > vel_ro.su
+
+xsrc1=100
+xsrc2=9900
+
+#volume
+tmod=120
+tsrc2=120
+fmax=30
+
+# Figure 7 deep
+zsrc1=2700
+zsrc2=4090
+tlength=120
+nsrc=1000
+
+rm Trace.su
+#for nsrc in 8000 1000 500 100 50;
+for nsrc in 1000;
+do
+
+file_shot=shotRd_T${tmod}_S${nsrc}_Dt${tlength}_F${fmax}.su
+
+fdelmodc \
+ file_cp=vel_cp.su ischeme=1 \
+ file_den=vel_ro.su \
+ file_rcv=$file_shot \
+ rec_type_p=0 \
+ dtrcv=0.008 \
+ rec_ntsam=16384 \
+ dt=0.0005 \
+ verbose=2 \
+ tmod=$tmod \
+ dxrcv=50.0 \
+ plane_wave=0 \
+ amplitude=0 \
+ xsrc=5000 zsrc=2700 \
+ src_random=1 \
+ wav_random=1 \
+ fmax=$fmax \
+ xsrc1=$xsrc1 \
+ xsrc2=$xsrc2 \
+ zsrc1=$zsrc1 \
+ zsrc2=$zsrc2 \
+ tsrc1=0.0 \
+ tsrc2=$tsrc2 \
+ tlength=$tlength \
+ nsrc=$nsrc \
+ ntaper=45 \
+ left=4 right=4 top=1 bottom=4
+
+ base=`echo $file_shot | awk 'BEGIN { FS = "." } ; { print $1 }'`
+ echo $base
+ SIrand.scr ${base}_rvz.su
+
+ ntraces=`surange < ${base}_rvz.su | grep traces| awk '{print $1 }'`
+ echo $ntraces
+ middle=$(echo "scale=0; ($ntraces+1)/2"| bc -l)
+ echo $middle
+
+ susum causal.su noncausal.su | \
+ suwind s=1 j=1 tmax=4 f1=0.0 | \
+ sushw key=f1,delrt,d2,fldr a=0.0,0.0,50,8000 | \
+ suwind key=tracl min=$middle max=$middle >> Trace.su
+
+done
+
+suwind tmin=1.5 tmax=3.0 f1=0.0 < Trace.su | \
+ sunormalize norm=max | \
+ supsgraph \
+ hbox=4 wbox=3 labelsize=10 x1beg=1.5 x1end=3.0 \
+ linecolor=red,green,blue,emerald,black f1=1.5 d1num=0.5 \
+ label1='time (s)' > shotTracesDeep_T120_S_Dt120_F30.eps
+
+suwind tmin=1.5 tmax=3.1 f1=0.0 < Trace.su | \
+ sunormalize norm=max | \
+ supswigp \
+ hbox=4 wbox=3 labelsize=10 x1beg=1.5 x1end=3.0 \
+ f1=1.5 d1num=0.5 linewidth=1 fill=0 f2=1 d2=1 \
+ label1='time (s)' label2='number of sources' > shotWigglesDeep_T120_S_Dt120_F30.eps
+
diff --git a/fdelmodc3D/FiguresPaper/Figure7fmax.scr b/fdelmodc3D/FiguresPaper/Figure7fmax.scr
new file mode 100755
index 0000000000000000000000000000000000000000..141d497b7f09b0dba761d600af85a4c4877ab2b3
--- /dev/null
+++ b/fdelmodc3D/FiguresPaper/Figure7fmax.scr
@@ -0,0 +1,76 @@
+#!/bin/bash
+#PBS -l nodes=1:ppn=2
+#PBS -N InterfModeling
+#PBS -V
+#
+# alternative not used in paper, varying maximum frequency, 5x3.5 hours
+
+export PATH=../../bin:$PATH
+
+makemod sizex=10000 sizez=5000 dx=5 dz=5 cp0=1500 ro0=1000 file_base=simple.su \
+ intt=def poly=0 x=0,10000 z=1300,1300 cp=2000 ro=1400 \
+ intt=def poly=2 x=0,2000,3000,5000,7000,8000,10000 \
+ z=2000,2000,2000,2500,2000,2000,2000 cp=4000 ro=2000 \
+ intt=def poly=0 x=0,10000 z=3000,3000 cp=3000 ro=1500 \
+ intt=def poly=0 x=0,10000 z=3500,3500 cp=5500 ro=2200
+
+suwind itmin=181 < simple_cp.su | sushw key=f1 a=0 > vel_cp.su
+suwind itmin=181 < simple_ro.su | sushw key=f1 a=0 > vel_ro.su
+
+xsrc1=100
+xsrc2=9900
+
+#volume
+tmod=120
+tsrc2=120
+fmax=30
+
+# Figure 7 deep
+zsrc1=2700
+zsrc2=4090
+tlength=12
+nsrc=50
+
+rm Trace.su
+#for nsrc in 8000 1000 500 100 50;
+for fmax in 5 10 15 20 25 30 35 40 45 50;
+do
+
+echo fmax=$fmax
+
+file_shot=shotRt_T${tmod}_S${nsrc}_Dt${tlength}_F${fmax}.su
+
+../fdelmodc \
+ file_cp=vel_cp.su ischeme=1 \
+ file_den=vel_ro.su \
+ file_rcv=$file_shot \
+ rec_type_p=0 \
+ dtrcv=0.008 \
+ rec_ntsam=16384 \
+ dt=0.0005 \
+ verbose=2 \
+ tmod=$tmod \
+ dxrcv=50.0 \
+ plane_wave=0 \
+ amplitude=0 \
+ xsrc=5000 zsrc=2700 \
+ src_random=1 \
+ wav_random=1 \
+ seed=101 \
+ length_random=0 \
+ fmax=$fmax \
+ xsrc1=$xsrc1 \
+ xsrc2=$xsrc2 \
+ zsrc1=$zsrc1 \
+ zsrc2=$zsrc2 \
+ tsrc1=0.0 \
+ tsrc2=$tsrc2 \
+ tlength=$tlength \
+ nsrc=$nsrc \
+ ntaper=45 \
+ left=4 right=4 top=1 bottom=4
+
+ mv src_nwav.su src_nwav_$fmax.su
+
+done
+
diff --git a/fdelmodc3D/FiguresPaper/Figure7length.scr b/fdelmodc3D/FiguresPaper/Figure7length.scr
new file mode 100755
index 0000000000000000000000000000000000000000..b0da0c48c5ac83305332da4fae6109600d6f7ca4
--- /dev/null
+++ b/fdelmodc3D/FiguresPaper/Figure7length.scr
@@ -0,0 +1,100 @@
+#!/bin/bash
+#PBS -l nodes=1:ppn=2
+#PBS -N InterfModeling
+#PBS -V
+#
+# alternative not used in paper, fixed length deep sources, 3.5 hours
+
+export PATH=../../bin:$PATH
+
+makemod sizex=10000 sizez=5000 dx=5 dz=5 cp0=1500 ro0=1000 file_base=simple.su \
+ intt=def poly=0 x=0,10000 z=1300,1300 cp=2000 ro=1400 \
+ intt=def poly=2 x=0,2000,3000,5000,7000,8000,10000 \
+ z=2000,2000,2000,2500,2000,2000,2000 cp=4000 ro=2000 \
+ intt=def poly=0 x=0,10000 z=3000,3000 cp=3000 ro=1500 \
+ intt=def poly=0 x=0,10000 z=3500,3500 cp=5500 ro=2200
+
+suwind itmin=181 < simple_cp.su | sushw key=f1 a=0 > vel_cp.su
+suwind itmin=181 < simple_ro.su | sushw key=f1 a=0 > vel_ro.su
+
+xsrc1=100
+xsrc2=9900
+
+#volume
+tmod=120
+tsrc2=120
+fmax=30
+
+# Figure 7 deep
+zsrc1=2700
+zsrc2=4090
+tlength=120
+nsrc=1000
+
+rm Trace.su
+#for nsrc in 8000 1000 500 100 50;
+for nsrc in 50;
+do
+
+file_shot=shotRt_T${tmod}_S${nsrc}_Dt${tlength}_F${fmax}.su
+
+../fdelmodc \
+ file_cp=vel_cp.su ischeme=1 \
+ file_den=vel_ro.su \
+ file_rcv=$file_shot \
+ rec_type_p=0 \
+ dtrcv=0.008 \
+ rec_ntsam=16384 \
+ dt=0.0005 \
+ verbose=2 \
+ tmod=$tmod \
+ dxrcv=50.0 \
+ plane_wave=0 \
+ amplitude=0 \
+ xsrc=5000 zsrc=2700 \
+ src_random=1 \
+ wav_random=1 \
+ seed=101 \
+ length_random=0 \
+ fmax=$fmax \
+ xsrc1=$xsrc1 \
+ xsrc2=$xsrc2 \
+ zsrc1=$zsrc1 \
+ zsrc2=$zsrc2 \
+ tsrc1=0.0 \
+ tsrc2=$tsrc2 \
+ tlength=$tlength \
+ nsrc=$nsrc \
+ ntaper=45 \
+ left=4 right=4 top=1 bottom=4
+
+ base=`echo $file_shot | awk 'BEGIN { FS = "." } ; { print $1 }'`
+ echo $base
+ SIrand.scr ${base}_rvz.su
+
+ ntraces=`surange < ${base}_rvz.su | grep traces| awk '{print $1 }'`
+ echo $ntraces
+ middle=$(echo "scale=0; ($ntraces+1)/2"| bc -l)
+ echo $middle
+
+ susum causal.su noncausal.su | \
+ suwind s=1 j=1 tmax=4 f1=0.0 | \
+ sushw key=f1,delrt,d2,fldr a=0.0,0.0,50,8000 | \
+ suwind key=tracl min=$middle max=$middle >> Trace.su
+
+done
+
+suwind tmin=1.5 tmax=3.0 f1=0.0 < Trace.su | \
+ sunormalize norm=max | \
+ supsgraph \
+ hbox=4 wbox=3 labelsize=10 x1beg=1.5 x1end=3.0 \
+ linecolor=red,green,blue,emerald,black f1=1.5 d1num=0.5 \
+ label1='time (s)' > shotTracesLeng_T120_S_Dt120_F30.eps
+
+suwind tmin=1.5 tmax=3.1 f1=0.0 < Trace.su | \
+ sunormalize norm=max | \
+ supswigp \
+ hbox=4 wbox=3 labelsize=10 x1beg=1.5 x1end=3.0 \
+ f1=1.5 d1num=0.5 linewidth=1 fill=0 f2=1 d2=1 \
+ label1='time (s)' label2='number of sources' > shotWigglesLeng_T120_S_Dt120_F30.eps
+
diff --git a/fdelmodc3D/FiguresPaper/Figure7plane.scr b/fdelmodc3D/FiguresPaper/Figure7plane.scr
new file mode 100755
index 0000000000000000000000000000000000000000..fe52b82c5e991e4be96c68c5a5665c003f36cbaf
--- /dev/null
+++ b/fdelmodc3D/FiguresPaper/Figure7plane.scr
@@ -0,0 +1,95 @@
+#!/bin/bash
+#PBS -l nodes=1:ppn=2
+#PBS -N InterfModeling
+#PBS -V
+#
+
+export PATH=../../bin:$PATH
+
+makemod sizex=10000 sizez=5000 dx=5 dz=5 cp0=1500 ro0=1000 file_base=simple.su \
+ intt=def poly=0 x=0,10000 z=1300,1300 cp=2000 ro=1400 \
+ intt=def poly=2 x=0,2000,3000,5000,7000,8000,10000 \
+ z=2000,2000,2000,2500,2000,2000,2000 cp=4000 ro=2000 \
+ intt=def poly=0 x=0,10000 z=3000,3000 cp=3000 ro=1500 \
+ intt=def poly=0 x=0,10000 z=3500,3500 cp=5500 ro=2200
+
+suwind itmin=181 < simple_cp.su | sushw key=f1 a=0 > vel_cp.su
+suwind itmin=181 < simple_ro.su | sushw key=f1 a=0 > vel_ro.su
+
+xsrc1=100
+xsrc2=9900
+
+#volume
+tmod=120
+tsrc2=120
+fmax=30
+
+# Figure 7 plane
+zsrc1=2700
+zsrc2=2700
+tlength=120
+nsrc=1000
+
+rm Trace.su
+for nsrc in 8000 1000 500 100 50;
+do
+
+file_shot=shotRp_T${tmod}_S${nsrc}_Dt${tlength}_F${fmax}.su
+
+fdelmodc \
+ file_cp=vel_cp.su ischeme=1 \
+ file_den=vel_ro.su \
+ file_rcv=$file_shot \
+ rec_type_p=0 \
+ dtrcv=0.008 \
+ rec_ntsam=16384 \
+ dt=0.0005 \
+ verbose=4 \
+ tmod=$tmod \
+ dxrcv=50.0 \
+ plane_wave=0 \
+ amplitude=0 \
+ src_random=1 \
+ wav_random=1 \
+ fmax=$fmax \
+ xsrc1=$xsrc1 \
+ xsrc2=$xsrc2 \
+ zsrc1=$zsrc1 \
+ zsrc2=$zsrc2 \
+ tsrc1=0.0 \
+ tsrc2=$tsrc2 \
+ tlength=$tlength \
+ nsrc=$nsrc \
+ ntaper=45 \
+ left=4 right=4 top=1 bottom=4
+
+ base=`echo $file_shot | awk 'BEGIN { FS = "." } ; { print $1 }'`
+ echo $base
+ SIrand.scr ${base}_rvz.su
+
+ ntraces=`surange < ${base}_rvz.su | grep traces| awk '{print $1 }'`
+ echo $ntraces
+ middle=$(echo "scale=0; ($ntraces+1)/2"| bc -l)
+ echo $middle
+
+ susum causal.su noncausal.su | \
+ suwind s=1 j=1 tmax=4 f1=0.0 | \
+ sushw key=f1,delrt,d2,fldr a=0.0,0.0,50,8000 | \
+ suwind key=tracl min=$middle max=$middle >> Trace.su
+
+done
+
+suwind tmin=1.5 tmax=3.0 f1=0.0 < Trace.su | \
+ sunormalize norm=max | \
+ supsgraph \
+ hbox=4 wbox=3 labelsize=10 x1beg=1.5 x1end=3.0 \
+ linecolor=red,green,blue,emerald,black f1=1.5 d1num=0.5 \
+ label1='time (s)' > shotTracesPlan_T120_S_Dt120_F30.eps
+
+suwind tmin=1.5 tmax=3.1 f1=0.0 < Trace.su | \
+ sunormalize norm=max | \
+ supswigp \
+ hbox=4 wbox=3 labelsize=10 x1beg=1.5 x1end=3.0 \
+ f1=1.5 d1num=0.5 linewidth=1 fill=0 f2=1 d2=1 \
+ label1='time (s)' label2='number of sources' > shotWigglesPlan_T120_S_Dt120_F30.eps
+
diff --git a/fdelmodc3D/FiguresPaper/Figure8-9.scr b/fdelmodc3D/FiguresPaper/Figure8-9.scr
new file mode 100755
index 0000000000000000000000000000000000000000..db6b97a1711484b0020518058e9b478f4fb19ff1
--- /dev/null
+++ b/fdelmodc3D/FiguresPaper/Figure8-9.scr
@@ -0,0 +1,147 @@
+#!/bin/bash
+#PBS -l nodes=1:ppn=2
+#PBS -N InterfModeling
+#PBS -q long
+#PBS -V
+#
+# for random and ricker wavelet deep, volume and plane sources, 6x3.5 hours
+
+export PATH=../../bin:$PATH
+
+makewave w=g2 fp=10 t0=0.15 dt=0.0010 nt=4096 file_out=G2.su verbose=1
+
+makemod sizex=10000 sizez=4100 dx=10 dz=10 cp0=1500 ro0=1000 file_base=simple.su \
+ intt=def poly=0 x=0,10000 z=400,400 cp=2000 ro=1400 \
+ intt=def poly=2 x=0,2000,3000,5000,7000,8000,10000 z=1100,1100,1100,1600,1100,1100,1100 cp=4000 ro=2000 \
+ intt=def poly=0 x=0,10000 z=2100,2100 cp=3000 ro=1500 \
+ intt=def poly=0 x=0,10000 z=2600,2600 cp=5500 ro=2200
+
+xsrc1=100
+xsrc2=9900
+dxsrc=10
+
+
+tmod=120
+tsrc1=0.1
+tsrc2=120
+tlength=120
+nsrc=8000
+fmax=30
+
+for wav_random in 0 1;
+do
+
+file_shot=shotRS${wav_random}_volume_T${tmod}_S${nsrc}_Dt${tsrc2}_F${fmax}.su
+echo $file_shot
+
+#volume
+zsrc1=500
+zsrc2=4090
+
+fdelmodc \
+ file_cp=simple_cp.su ischeme=1 \
+ file_den=simple_ro.su \
+ file_src=G2.su \
+ file_rcv=$file_shot \
+ rec_type_p=0 \
+ dtrcv=0.008 \
+ rec_ntsam=16384 \
+ dt=0.0010 \
+ verbose=1 \
+ tmod=$tmod \
+ dxrcv=10.0 \
+ plane_wave=0 \
+ src_random=1 \
+ wav_random=${wav_random} \
+ fmax=$fmax \
+ xsrc1=$xsrc1 \
+ xsrc2=$xsrc2 \
+ zsrc1=$zsrc1 \
+ zsrc2=$zsrc2 \
+ tsrc1=0.0 \
+ tsrc2=$tsrc2 \
+ tlength=$tlength \
+ nsrc=$nsrc \
+ dipsrc=0 \
+ ntaper=45 \
+ left=4 right=4 top=1 bottom=4
+
+ base=`echo $file_shot | awk 'BEGIN { FS = "." } ; { print $1 }'`
+ echo $base
+ SIrand.scr ${base}_rvz.su 10
+
+#deep
+zsrc1=2700
+zsrc2=4090
+
+file_shot=shotRS${wav_random}_deep_T${tmod}_S${nsrc}_Dt${tsrc2}_F${fmax}.su
+
+fdelmodc \
+ file_cp=simple_cp.su ischeme=1 \
+ file_den=simple_ro.su \
+ file_src=G2.su \
+ file_rcv=$file_shot \
+ rec_type_p=0 \
+ dtrcv=0.008 \
+ rec_ntsam=16384 \
+ dt=0.0010 \
+ verbose=1 \
+ tmod=$tmod \
+ dxrcv=10.0 \
+ plane_wave=0 \
+ src_random=1 \
+ wav_random=${wav_random} \
+ fmax=$fmax \
+ xsrc1=$xsrc1 \
+ xsrc2=$xsrc2 \
+ zsrc1=$zsrc1 \
+ zsrc2=$zsrc2 \
+ tsrc1=0.0 \
+ tsrc2=$tsrc2 \
+ tlength=$tlength \
+ nsrc=$nsrc \
+ dipsrc=0 \
+ ntaper=45 \
+ left=4 right=4 top=1 bottom=4
+
+ base=`echo $file_shot | awk 'BEGIN { FS = "." } ; { print $1 }'`
+ echo $base
+ SIrand.scr ${base}_rvz.su 10
+
+#plane
+zsrc1=2700
+zsrc2=2700
+
+file_shot=shotRS${wav_random}_plane_T${tmod}_S${nsrc}_Dt${tsrc2}_F${fmax}.su
+
+fdelmodc \
+ file_cp=simple_cp.su ischeme=1 \
+ file_den=simple_ro.su \
+ file_src=G2.su \
+ file_rcv=$file_shot \
+ rec_type_p=0 \
+ dtrcv=0.008 \
+ rec_ntsam=16384 \
+ dt=0.0010 \
+ verbose=1 \
+ tmod=$tmod \
+ dxrcv=10.0 \
+ plane_wave=1 \
+ xsrc=5000 zsrc=2700 \
+ src_random=0 \
+ wav_random=${wav_random} \
+ fmax=$fmax \
+ tsrc1=0.0 \
+ tsrc2=$tsrc2 \
+ tlength=$tlength \
+ nsrc=$nsrc \
+ dipsrc=0 \
+ ntaper=45 \
+ left=4 right=4 top=1 bottom=4
+
+ base=`echo $file_shot | awk 'BEGIN { FS = "." } ; { print $1 }'`
+ echo $base
+ SIrand.scr ${base}_rvz.su 10
+
+done
+
diff --git a/fdelmodc3D/FiguresPaper/Figure8-9Hom.scr b/fdelmodc3D/FiguresPaper/Figure8-9Hom.scr
new file mode 100755
index 0000000000000000000000000000000000000000..fb3a419f8ea6ad191441c1a1a4b76183eb7dd575
--- /dev/null
+++ b/fdelmodc3D/FiguresPaper/Figure8-9Hom.scr
@@ -0,0 +1,142 @@
+#!/bin/bash
+#PBS -l nodes=1:ppn=2
+#PBS -N InterfModeling
+#PBS -q long
+#PBS -V
+#
+# for reviewer, same as Fig. 8-9 in homogeneous medium, 6x3.5 hours
+
+export PATH=../../bin:$PATH
+
+makewave w=g2 fp=10 t0=0.15 dt=0.0010 nt=4096 file_out=G2.su verbose=1
+
+makemod sizex=10000 sizez=4100 dx=10 dz=10 cp0=1500 ro0=1000 file_base=hom.su
+
+xsrc1=100
+xsrc2=9900
+dxsrc=10
+
+tmod=120
+tsrc1=0.1
+tsrc2=120
+tlength=120
+nsrc=8000
+fmax=30
+
+for wav_random in 0 1;
+do
+
+file_shot=shotHRS${wav_random}_volume_T${tmod}_S${nsrc}_Dt${tsrc2}_F${fmax}.su
+echo $file_shot
+
+#volume
+zsrc1=500
+zsrc2=4090
+
+../fdelmodc \
+ file_cp=hom_cp.su ischeme=1 \
+ file_den=hom_ro.su \
+ file_src=G2.su \
+ file_rcv=$file_shot \
+ rec_type_p=0 \
+ dtrcv=0.008 \
+ rec_ntsam=16384 \
+ dt=0.0010 \
+ verbose=1 \
+ tmod=$tmod \
+ dxrcv=10.0 \
+ plane_wave=0 \
+ src_random=1 \
+ wav_random=${wav_random} \
+ fmax=$fmax \
+ xsrc1=$xsrc1 \
+ xsrc2=$xsrc2 \
+ zsrc1=$zsrc1 \
+ zsrc2=$zsrc2 \
+ tsrc1=0.0 \
+ tsrc2=$tsrc2 \
+ tlength=$tlength \
+ nsrc=$nsrc \
+ dipsrc=0 \
+ ntaper=45 \
+ left=4 right=4 top=1 bottom=4
+
+ base=`echo $file_shot | awk 'BEGIN { FS = "." } ; { print $1 }'`
+ echo $base
+ SIrand.scr ${base}_rvz.su 10
+
+#deep
+zsrc1=2700
+zsrc2=4090
+
+file_shot=shotHRS${wav_random}_deep_T${tmod}_S${nsrc}_Dt${tsrc2}_F${fmax}.su
+
+fdelmodc \
+ file_cp=hom_cp.su ischeme=1 \
+ file_den=hom_ro.su \
+ file_src=G2.su \
+ file_rcv=$file_shot \
+ rec_type_p=0 \
+ dtrcv=0.008 \
+ rec_ntsam=16384 \
+ dt=0.0010 \
+ verbose=1 \
+ tmod=$tmod \
+ dxrcv=10.0 \
+ plane_wave=0 \
+ src_random=1 \
+ wav_random=${wav_random} \
+ fmax=$fmax \
+ xsrc1=$xsrc1 \
+ xsrc2=$xsrc2 \
+ zsrc1=$zsrc1 \
+ zsrc2=$zsrc2 \
+ tsrc1=0.0 \
+ tsrc2=$tsrc2 \
+ tlength=$tlength \
+ nsrc=$nsrc \
+ dipsrc=0 \
+ ntaper=45 \
+ left=4 right=4 top=1 bottom=4
+
+ base=`echo $file_shot | awk 'BEGIN { FS = "." } ; { print $1 }'`
+ echo $base
+ SIrand.scr ${base}_rvz.su 10
+
+#plane
+zsrc1=2700
+zsrc2=2700
+
+file_shot=shotHRS${wav_random}_plane_T${tmod}_S${nsrc}_Dt${tsrc2}_F${fmax}.su
+
+fdelmodc \
+ file_cp=hom_cp.su ischeme=1 \
+ file_den=hom_ro.su \
+ file_src=G2.su \
+ file_rcv=$file_shot \
+ rec_type_p=0 \
+ dtrcv=0.008 \
+ rec_ntsam=16384 \
+ dt=0.0010 \
+ verbose=1 \
+ tmod=$tmod \
+ dxrcv=10.0 \
+ plane_wave=1 \
+ xsrc=5000 zsrc=2700 \
+ src_random=0 \
+ wav_random=${wav_random} \
+ fmax=$fmax \
+ tsrc1=0.0 \
+ tsrc2=$tsrc2 \
+ tlength=$tlength \
+ nsrc=$nsrc \
+ dipsrc=0 \
+ ntaper=45 \
+ left=4 right=4 top=1 bottom=4
+
+ base=`echo $file_shot | awk 'BEGIN { FS = "." } ; { print $1 }'`
+ echo $base
+ SIrand.scr ${base}_rvz.su 10
+
+done
+
diff --git a/fdelmodc3D/FiguresPaper/FigureCCsources.scr b/fdelmodc3D/FiguresPaper/FigureCCsources.scr
new file mode 100755
index 0000000000000000000000000000000000000000..8bfccfafb18bf2d9ba8e09502f3c37b3d3b8e7fd
--- /dev/null
+++ b/fdelmodc3D/FiguresPaper/FigureCCsources.scr
@@ -0,0 +1,69 @@
+#!/bin/bash
+#PBS -l nodes=1:ppn=2
+#PBS -N InterfModeling
+#PBS -q long
+#PBS -V
+#
+# to compute source signature used in cross.scr, 1600 s.
+
+export PATH=../../bin:$PATH
+
+makewave w=g2 fp=10 t0=0.15 dt=0.0010 nt=4096 file_out=G2.su verbose=1
+
+makemod sizex=10000 sizez=4100 dx=10 dz=10 cp0=1500 ro0=1000 file_base=simple.su \
+ intt=def poly=0 x=0,10000 z=400,400 cp=2000 ro=1400 \
+ intt=def poly=2 x=0,2000,3000,5000,7000,8000,10000 z=1100,1100,1100,1600,1100,1100,1100 cp=4000 ro=2000 \
+ intt=def poly=0 x=0,10000 z=2100,2100 cp=3000 ro=1500 \
+ intt=def poly=0 x=0,10000 z=2600,2600 cp=5500 ro=2200
+
+xsrc1=100
+xsrc2=9900
+dxsrc=10
+
+
+tmod=120
+tsrc1=0.1
+tsrc2=120
+tlength=120
+nsrc=100
+fmax=30
+
+
+file_shot=shotRS${wav_random}_volume_T${tmod}_S${nsrc}_Dt${tsrc2}_F${fmax}.su
+echo $file_shot
+
+#volume
+zsrc1=500
+zsrc2=4090
+
+../fdelmodc \
+ file_cp=simple_cp.su ischeme=1 \
+ file_den=simple_ro.su \
+ file_src=G2.su \
+ file_rcv=$file_shot \
+ rec_type_p=0 \
+ dtrcv=0.008 \
+ rec_ntsam=16384 \
+ dt=0.0010 \
+ verbose=4 \
+ tmod=$tmod \
+ dxrcv=10.0 \
+ plane_wave=0 \
+ src_random=1 \
+ wav_random=1 \
+ fmax=$fmax \
+ xsrc1=$xsrc1 \
+ xsrc2=$xsrc2 \
+ zsrc1=$zsrc1 \
+ zsrc2=$zsrc2 \
+ tsrc1=0.0 \
+ tsrc2=$tsrc2 \
+ tlength=$tlength \
+ nsrc=$nsrc \
+ dipsrc=0 \
+ ntaper=45 \
+ left=4 right=4 top=1 bottom=4
+
+ mv src_nwaw.su source_volume_S${nsrc}_Dt${tsrc2}_F${fmax}.su
+
+
diff --git a/fdelmodc3D/FiguresPaper/FigureDxAppendixA.scr b/fdelmodc3D/FiguresPaper/FigureDxAppendixA.scr
new file mode 100755
index 0000000000000000000000000000000000000000..e6c9e712960373a33d786ed7f9121abfdfeb4416
--- /dev/null
+++ b/fdelmodc3D/FiguresPaper/FigureDxAppendixA.scr
@@ -0,0 +1,138 @@
+#!/bin/bash
+#PBS -l nodes=1:ppn=2
+#PBS -N InterfModeling
+#PBS -V
+#
+
+cp=2000
+rho=1000
+dx=2.5
+dt=0.0001
+halfdt=`perl -e "print 0.5*$dt;"`
+
+
+export PATH=../../bin:$PATH
+which basop
+
+for dx in 5 1.25 1.0
+
+do
+
+makemod sizex=2000 sizez=2000 dx=$dx dz=$dx cp0=$cp ro0=$rho orig=-1000,0 file_base=simple.su
+
+makewave fp=15 dt=$dt file_out=wave.su nt=4096 t0=0.1
+
+######### MONOPOLE #######
+
+fdelmodc \
+ file_cp=simple_cp.su ischeme=1 iorder=4 \
+ file_den=simple_ro.su \
+ file_src=wave.su \
+ file_rcv=shot_fd.su \
+ src_type=1 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.0005 \
+ verbose=2 \
+ tmod=0.5115 \
+ dxrcv=5.0 \
+ xrcv1=-500 xrcv2=500 \
+ zrcv1=500 zrcv2=500 \
+ xsrc=0 zsrc=1000 \
+ ntaper=80 \
+ left=4 right=4 top=4 bottom=4
+
+makewave fp=15 dt=0.0005 file_out=wave.su nt=4096 t0=0.1
+
+green c=$cp rho=$rho file_src=wave.su zsrc1=500 xrcv=-500,500 dxrcv=5 nt=4096 dip=0 | suwind nt=1024 > shot_green_rp.su
+green c=$cp rho=$rho file_src=wave.su zsrc1=500 xrcv=-500,500 dxrcv=5 nt=4096 dip=0 p_vz=1 | suwind nt=1024 > shot_green_rvz.su
+
+suwind key=tracl min=101 max=101 < shot_fd_rp.su | basop choice=shift shift=$halfdt > trace_fd.su
+suwind key=tracl min=101 max=101 < shot_green_rp.su > trace_green.su
+
+sumax < trace_green.su outpar=nep
+Mmax=`cat nep | awk '{print $1}'`
+a=`perl -e "print 100.0/$Mmax;"`
+echo $a
+
+sudiff trace_green.su trace_fd.su | basop choice=shift shift=-0.1 | sugain scale=$a | suop op=abs > mon_diff_dx${dx}_rp.su
+
+supsgraph < mon_diff_dx${dx}_rp.su style=normal labelsize=12 wbox=4 hbox=2 label1='time in seconds' label2="Relative error in percentage of peak" linewidth=0.1 linecolor=red x2beg=0.0 x2end=1.0 f2num=0.0 d2num=0.5 > mon_diff_dx${dx}_rp.eps
+
+
+# rvz
+
+suwind key=tracl min=101 max=101 < shot_fd_rvz.su > trace_fd.su
+suwind key=tracl min=101 max=101 < shot_green_rvz.su > trace_green.su
+
+sumax < trace_green.su outpar=nep
+Mmax=`cat nep | awk '{print $1}'`
+a=`perl -e "print 100.0/$Mmax;"`
+echo $a
+
+sudiff trace_green.su trace_fd.su | basop choice=shift shift=-0.1 | sugain scale=$a | suop op=abs >mon_diff_dx${dx}_rvz.su
+
+supsgraph < mon_diff_dx${dx}_rvz.su style=normal labelsize=12 wbox=4 hbox=2 label1='time in seconds' label2="Relative error in percentage of peak" linewidth=0.1 linecolor=red x2beg=0.0 x2end=1.0 f2num=0.0 d2num=0.5 > mon_diff_dx${dx}_rvz.eps
+
+######### DIPOLE #######
+
+makewave fp=15 dt=$dt file_out=wave.su nt=4096 t0=0.1
+
+fdelmodc \
+ file_cp=simple_cp.su ischeme=1 iorder=4 \
+ file_den=simple_ro.su \
+ file_src=wave.su \
+ file_rcv=shot_fd_dip.su \
+ src_type=1 \
+ src_orient=2 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.0005 \
+ verbose=2 \
+ tmod=0.5115 \
+ dxrcv=5.0 \
+ xrcv1=-500 xrcv2=500 \
+ zrcv1=500 zrcv2=500 \
+ xsrc=0 zsrc=1000 \
+ ntaper=80 \
+ left=4 right=4 top=4 bottom=4
+
+makewave fp=15 dt=0.0005 file_out=wave.su nt=4096 t0=0.1
+
+green c=$cp rho=$rho file_src=wave.su zsrc1=500 xrcv=-500,500 dxrcv=5 nt=4096 dip=1 | suwind nt=1024 > shot_green_dip_rp.su
+green c=$cp rho=$rho file_src=wave.su zsrc1=500 xrcv=-500,500 dxrcv=5 nt=4096 p_vz=1 dip=1 | suwind nt=1024 > shot_green_dip_rvz.su
+
+shift=`perl -e "print 0.5*$dx/$cp;"`
+
+# rp
+
+suwind key=tracl min=101 max=101 < shot_fd_dip_rp.su | basop choice=shift shift=-$shift > trace_fd.su
+suwind key=tracl min=101 max=101 < shot_green_dip_rp.su > trace_green.su
+
+sumax < trace_green.su outpar=nep
+Mmax=`cat nep | awk '{print $1}'`
+a=`perl -e "print 100.0/$Mmax;"`
+echo $a
+
+sudiff trace_green.su trace_fd.su | basop choice=shift shift=-0.1 | sugain scale=$a | suop op=abs >dip_diff_dx${dx}_rp.su
+
+supsgraph < dip_diff_dx${dx}_rp.su style=normal labelsize=12 wbox=4 hbox=2 label1='time in seconds' label2="Relative error in percentage of peak" linewidth=0.1 linecolor=red x2beg=0.0 x2end=1.0 f2num=0.0 d2num=0.5 > dip_diff_dx${dx}_rp.eps
+
+
+
+# rvz
+
+suwind key=tracl min=101 max=101 < shot_fd_dip_rvz.su | basop choice=shift shift=-$shift > trace_fd.su
+suwind key=tracl min=101 max=101 < shot_green_dip_rvz.su > trace_green.su
+
+sumax < trace_green.su outpar=nep
+Mmax=`cat nep | awk '{print $1}'`
+a=`perl -e "print 100.0/$Mmax;"`
+echo $a
+
+sudiff trace_green.su trace_fd.su | basop choice=shift shift=-0.1 | sugain scale=$a | suop op=abs > dip_diff_dx${dx}_rvz.su
+
+supsgraph < dip_diff_dx${dx}_rvz.su style=normal labelsize=12 wbox=4 hbox=2 label1='time in seconds' label2="Relative error in percentage of peak" linewidth=0.1 linecolor=red x2beg=0.0 x2end=1.0 f2num=0.0 d2num=0.5 > dip_diff_dx${dx}_rvz.eps
+
+done
+
diff --git a/fdelmodc3D/FiguresPaper/FigureGreenAppendixA.scr b/fdelmodc3D/FiguresPaper/FigureGreenAppendixA.scr
new file mode 100755
index 0000000000000000000000000000000000000000..45b1d893552897630c9e0c18064b2c15cfecebd9
--- /dev/null
+++ b/fdelmodc3D/FiguresPaper/FigureGreenAppendixA.scr
@@ -0,0 +1,149 @@
+#!/bin/bash
+#PBS -l nodes=1:ppn=2
+#PBS -N InterfModeling
+#PBS -V
+#
+# source construction shown in Figure A2-A3-A4, 150 s.
+
+cp=2000
+rho=1000
+dx=2.5
+dt=0.0001
+
+export PATH=../../bin:$PATH
+
+makemod sizex=2000 sizez=2000 dx=$dx dz=$dx cp0=$cp ro0=$rho orig=-1000,0 file_base=simple.su
+makewave fp=15 dt=$dt file_out=wave.su nt=4096 t0=0.1
+
+######### MONOPOLE #######
+
+../fdelmodc \
+ file_cp=simple_cp.su ischeme=1 iorder=4 \
+ file_den=simple_ro.su \
+ file_src=wave.su \
+ file_rcv=shot_fd.su \
+ src_type=1 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.0005 \
+ verbose=2 \
+ tmod=0.5115 \
+ dxrcv=5.0 \
+ xrcv1=-500 xrcv2=500 \
+ zrcv1=500 zrcv2=500 \
+ xsrc=0 zsrc=1000 \
+ ntaper=80 \
+ left=4 right=4 top=4 bottom=4
+
+sugain < shot_fd_rp.su scale=0.5 > nep.su; mv nep.su shot_fd_rp.su
+sugain < shot_fd_rvz.su scale=0.5 > nep.su; mv nep.su shot_fd_rvz.su
+
+makewave fp=15 dt=0.0005 file_out=wave.su nt=4096 t0=0.1
+
+green c=$cp rho=$rho file_src=wave.su zsrc1=500 xrcv=-500,500 dxrcv=5 nt=4096 dip=0 | suwind nt=1024 > shot_green_rp.su
+green c=$cp rho=$rho file_src=wave.su zsrc1=500 xrcv=-500,500 dxrcv=5 nt=4096 dip=0 p_vz=1 | suwind nt=1024 > shot_green_rvz.su
+
+# rp
+(suwind key=tracl min=101 max=101 < shot_fd_rp.su; suwind key=tracl min=101 max=101 < shot_green_rp.su ) | basop choice=shift shift=-0.1 | supsgraph style=normal labelsize=10 wbox=4 hbox=2 label1='time in seconds' label2="Amplitude" linewidth=0.1 d2num=0.04 x2end=0.080 f2num=-0.4 > mon_rp.eps
+
+(suwind key=tracl min=101 max=101 < shot_fd_rp.su; suwind key=tracl min=101 max=101 < shot_green_rp.su;) | basop choice=shift shift=-0.1 | supsgraph style=normal labelsize=10 wbox=2 hbox=2 label1='time in seconds' label2="Amplitude" linewidth=0.1 linecolor=red,green x1beg=0.255 x1end=0.258 x2beg=0.0785 x2end=0.0797 d2num=0.0002 f2num=0.0786 > mon_zoom_rp.eps
+
+suwind key=tracl min=101 max=101 < shot_fd_rp.su > trace_fd.su
+suwind key=tracl min=101 max=101 < shot_green_rp.su > trace_green.su
+
+sumax < trace_green.su outpar=nep
+Mmax=`cat nep | awk '{print $1}'`
+a=`perl -e "print 100.0/$Mmax;"`
+echo $a
+
+sudiff trace_green.su trace_fd.su | basop choice=shift shift=-0.1 | sugain scale=$a | suop op=abs | supsgraph style=normal labelsize=12 wbox=4 hbox=2 label1='time in seconds' label2="Relative error in percentage of peak" linewidth=0.1 linecolor=red x2beg=0.0 x2end=1.0 f2num=0.0 d2num=0.5 > mon_diff_dx${dx}_rp.eps
+
+(suwind key=tracl min=101 max=101 < shot_fd_rp.su; suwind key=tracl min=101 max=101 < shot_green_rp.su ) | basop choice=shift shift=-0.1 | suxgraph
+
+
+# rvz
+
+(suwind key=tracl min=101 max=101 < shot_fd_rvz.su ; suwind key=tracl min=101 max=101 < shot_green_rvz.su ) | basop choice=shift shift=-0.1 | supsgraph style=normal labelsize=10 wbox=4 hbox=2 label1='time in seconds' label2="Amplitude" linewidth=0.1 d2num=2e-8 f2num=-4e-8 x2end=4e-8 x2beg=-2.7e-8 > mon_rvz.eps
+
+(suwind key=tracl min=101 max=101 < shot_fd_rvz.su ; suwind key=tracl min=101 max=101 < shot_green_rvz.su ) | basop choice=shift shift=-0.1 | supsgraph style=normal labelsize=10 wbox=2 hbox=2 label1='time in seconds' label2="Amplitude" linewidth=0.1 linecolor=red,green d2num=2e-10 f2num=3.86e-8 x2end=3.96e-8 x2beg=3.86e-8 x1beg=0.255 x1end=0.258 > mon_zoom_rvz.eps
+
+suwind key=tracl min=101 max=101 < shot_fd_rvz.su > trace_fd.su
+suwind key=tracl min=101 max=101 < shot_green_rvz.su > trace_green.su
+
+sumax < trace_green.su outpar=nep
+Mmax=`cat nep | awk '{print $1}'`
+a=`perl -e "print 100.0/$Mmax;"`
+echo $a
+
+sudiff trace_green.su trace_fd.su | basop choice=shift shift=-0.1 | sugain scale=$a | suop op=abs | supsgraph style=normal labelsize=12 wbox=4 hbox=2 label1='time in seconds' label2="Relative error in percentage of peak" linewidth=0.1 linecolor=red x2beg=0.0 x2end=1.0 f2num=0.0 d2num=0.5 > mon_diff_dx${dx}_rvz.eps
+
+(suwind key=tracl min=101 max=101 < shot_fd_rvz.su ; suwind key=tracl min=101 max=101 < shot_green_rvz.su) | basop choice=shift shift=-0.1 | suxgraph
+
+
+######### DIPOLE #######
+
+makewave fp=15 dt=$dt file_out=wave.su nt=4096 t0=0.1
+
+fdelmodc \
+ file_cp=simple_cp.su ischeme=1 iorder=4 \
+ file_den=simple_ro.su \
+ file_src=wave.su \
+ file_rcv=shot_fd_dip.su \
+ src_type=1 \
+ src_orient=2 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.0005 \
+ verbose=2 \
+ tmod=0.5115 \
+ dxrcv=5.0 \
+ xrcv1=-500 xrcv2=500 \
+ zrcv1=500 zrcv2=500 \
+ xsrc=0 zsrc=1000 \
+ ntaper=80 \
+ left=4 right=4 top=4 bottom=4
+
+makewave fp=15 dt=0.0005 file_out=wave.su nt=4096 t0=0.1
+
+green c=$cp rho=$rho file_src=wave.su zsrc1=500 xrcv=-500,500 dxrcv=5 nt=4096 dip=1 | suwind nt=1024 > shot_green_dip_rp.su
+green c=$cp rho=$rho file_src=wave.su zsrc1=500 xrcv=-500,500 dxrcv=5 nt=4096 p_vz=1 dip=1 | suwind nt=1024 > shot_green_dip_rvz.su
+
+shift=`perl -e "print 0.5*$dx/$cp;"`
+
+# rp
+(suwind key=tracl min=101 max=101 < shot_fd_dip_rp.su | basop choice=shift shift=-$shift; suwind key=tracl min=101 max=101 < shot_green_dip_rp.su ) | basop choice=shift shift=-0.1 | supsgraph style=normal titlesize=-1 labelsize=10 wbox=4 hbox=2 label1='time in seconds' label2="Amplitude" linewidth=0.1 linecolor=red,green d2num=0.001 x2end=0.004001 f2num=-0.03 > dip_rp.eps
+
+(suwind key=tracl min=101 max=101 < shot_fd_dip_rp.su | basop choice=shift shift=-$shift; suwind key=tracl min=101 max=101 < shot_green_dip_rp.su ) | basop choice=shift shift=-0.1 | supsgraph style=normal labelsize=10 wbox=2 hbox=2 label1='time in seconds' label2="Amplitude" linewidth=0.1 linecolor=red,green x2beg=0.00379 x2end=0.00388 d2num=0.00002 f2num=0.00380 x1beg=0.2430 x1end=0.24601 f1num=0.243 d1num=0.002 > dip_zoom_rp.eps
+
+suwind key=tracl min=101 max=101 < shot_fd_dip_rp.su | basop choice=shift shift=-$shift > trace_fd.su
+suwind key=tracl min=101 max=101 < shot_green_dip_rp.su > trace_green.su
+
+sumax < trace_green.su outpar=nep
+Mmax=`cat nep | awk '{print $1}'`
+a=`perl -e "print 100.0/$Mmax;"`
+echo $a
+
+sudiff trace_green.su trace_fd.su | basop choice=shift shift=-0.1 | sugain scale=$a | suop op=abs | supsgraph style=normal labelsize=12 wbox=4 hbox=2 label1='time in seconds' label2="Relative error in percentage of peak" linewidth=0.1 linecolor=red x2beg=0.0 x2end=1.0 f2num=0.0 d2num=0.5 > dip_diff_dx${dx}_rp.eps
+
+(suwind key=tracl min=101 max=101 < shot_fd_dip_rp.su | basop choice=shift shift=-$shift ; suwind key=tracl min=101 max=101 < shot_green_dip_rp.su ) | basop choice=shift shift=-0.1 | suxgraph
+
+
+# rvz
+
+(suwind key=tracl min=101 max=101 < shot_fd_dip_rvz.su | basop choice=shift shift=-$shift; suwind key=tracl min=101 max=101 < shot_green_dip_rvz.su ) | basop choice=shift shift=-0.1 | supsgraph style=normal labelsize=10 wbox=4 hbox=2 label1='time in seconds' label2="Amplitude" linewidth=0.1 linecolor=red,green d2num=6e-10 f2num=-1.2e-9 x2end=2e-9 x2beg=-1.3e-9 > dip_rvz.eps
+
+(suwind key=tracl min=101 max=101 < shot_fd_dip_rvz.su | basop choice=shift shift=-$shift; suwind key=tracl min=101 max=101 < shot_green_dip_rvz.su ) | basop choice=shift shift=-0.1 | supsgraph style=normal labelsize=10 wbox=2 hbox=2 label1='time in seconds' label2="Amplitude" linewidth=0.1 linecolor=red,green d2num=2e-11 f2num=1.85e-9 x2end=1.944e-9 x2beg=1.85e-9 x1beg=0.2430 x1end=0.24601 f1num=0.243 d1num=0.002 > dip_zoom_rvz.eps
+
+suwind key=tracl min=101 max=101 < shot_fd_dip_rvz.su | basop choice=shift shift=-$shift > trace_fd.su
+suwind key=tracl min=101 max=101 < shot_green_dip_rvz.su > trace_green.su
+
+sumax < trace_green.su outpar=nep
+Mmax=`cat nep | awk '{print $1}'`
+a=`perl -e "print 100.0/$Mmax;"`
+echo $a
+
+sudiff trace_green.su trace_fd.su | basop choice=shift shift=-0.1 | sugain scale=$a | suop op=abs | supsgraph style=normal labelsize=12 wbox=4 hbox=2 label1='time in seconds' label2="Relative error in percentage of peak" linewidth=0.1 linecolor=red x2beg=0.0 x2end=1.0 f2num=0.0 d2num=0.5 > dip_diff_dx${dx}_rvz.eps
+
+(suwind key=tracl min=101 max=101 < shot_fd_dip_rvz.su | basop choice=shift shift=-$shift; suwind key=tracl min=101 max=101 < shot_green_dip_rvz.su ) | basop choice=shift shift=-0.1 | suxgraph
+
+
diff --git a/fdelmodc3D/FiguresPaper/FigureGreenDxAppendixA.scr b/fdelmodc3D/FiguresPaper/FigureGreenDxAppendixA.scr
new file mode 100755
index 0000000000000000000000000000000000000000..4c416c7aa0930b8eed54841cffc2756f8466be3f
--- /dev/null
+++ b/fdelmodc3D/FiguresPaper/FigureGreenDxAppendixA.scr
@@ -0,0 +1,146 @@
+#!/bin/bash
+#PBS -l nodes=1:ppn=2
+#PBS -N InterfModeling
+#PBS -V
+#
+# difference with analytical result, used in Figure 21
+
+# computes difference of FD result with analytical result
+# for three different grid spacings
+cp=2000
+rho=1000
+dx=2.5
+dt=0.0001
+
+export PATH=../../bin:$PATH
+
+export OMP_NUM_THREADS=4
+
+for dx in 5 2.5 1.0
+
+do
+
+makemod sizex=2000 sizez=2000 dx=$dx dz=$dx cp0=$cp ro0=$rho orig=-1000,0 file_base=simple.su
+
+makewave fp=15 dt=$dt file_out=wave.su nt=4096 t0=0.1
+
+######### MONOPOLE #######
+
+fdelmodc \
+ file_cp=simple_cp.su ischeme=1 iorder=4 \
+ file_den=simple_ro.su \
+ file_src=wave.su \
+ file_rcv=shot_fd.su \
+ src_type=1 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.0005 \
+ verbose=2 \
+ tmod=0.5115 \
+ dxrcv=5.0 \
+ xrcv1=-500 xrcv2=500 \
+ zrcv1=500 zrcv2=500 \
+ xsrc=0 zsrc=1000 \
+ ntaper=80 \
+ left=4 right=4 top=4 bottom=4
+
+makewave fp=15 dt=0.0005 file_out=wave.su nt=4096 t0=0.1
+
+sugain < shot_fd_rp.su scale=0.5 > nep.su; mv nep.su shot_fd_rp.su
+sugain < shot_fd_rvz.su scale=0.5 > nep.su; mv nep.su shot_fd_rvz.su
+
+# rp
+green c=$cp rho=$rho file_src=wave.su zsrc1=500 xrcv=-500,500 dxrcv=5 nt=4096 dip=0 | suwind nt=1024 > shot_green_rp.su
+green c=$cp rho=$rho file_src=wave.su zsrc1=500 xrcv=-500,500 dxrcv=5 nt=4096 dip=0 p_vz=1 | suwind nt=1024 > shot_green_rvz.su
+
+suwind key=tracl min=101 max=101 < shot_fd_rp.su > trace_fd.su
+suwind key=tracl min=101 max=101 < shot_green_rp.su > trace_green.su
+
+sumax < trace_green.su outpar=nep
+Mmax=`cat nep | awk '{print $1}'`
+a=`perl -e "print 100.0/$Mmax;"`
+echo $a
+
+sudiff trace_green.su trace_fd.su | basop choice=shift shift=-0.1 | sugain scale=$a | suop op=abs | supsgraph style=normal labelsize=12 wbox=4 hbox=2 label1='time in seconds' label2="Relative error in percentage of peak" linewidth=0.1 linecolor=red x2beg=0.0 x2end=1.0 f2num=0.0 d2num=0.5 > mon_diff_dx${dx}_rp.eps
+
+
+# rvz
+
+suwind key=tracl min=101 max=101 < shot_fd_rvz.su > trace_fd.su
+suwind key=tracl min=101 max=101 < shot_green_rvz.su > trace_green.su
+
+sumax < trace_green.su outpar=nep
+Mmax=`cat nep | awk '{print $1}'`
+a=`perl -e "print 100.0/$Mmax;"`
+echo $a
+
+sudiff trace_green.su trace_fd.su | basop choice=shift shift=-0.1 | sugain scale=$a | suop op=abs | supsgraph style=normal labelsize=12 wbox=4 hbox=2 label1='time in seconds' label2="Relative error in percentage of peak" linewidth=0.1 linecolor=red x2beg=0.0 x2end=1.0 f2num=0.0 d2num=0.5 > mon_diff_dx${dx}_rvz.eps
+
+######### DIPOLE #######
+
+makewave fp=15 dt=$dt file_out=wave.su nt=4096 t0=0.1
+
+fdelmodc \
+ file_cp=simple_cp.su ischeme=1 iorder=4 \
+ file_den=simple_ro.su \
+ file_src=wave.su \
+ file_rcv=shot_fd_dip.su \
+ src_type=1 \
+ src_orient=2 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.0005 \
+ verbose=2 \
+ tmod=0.5115 \
+ dxrcv=5.0 \
+ xrcv1=-500 xrcv2=500 \
+ zrcv1=500 zrcv2=500 \
+ xsrc=0 zsrc=1000 \
+ ntaper=80 \
+ left=4 right=4 top=4 bottom=4
+
+makewave fp=15 dt=0.0005 file_out=wave.su nt=4096 t0=0.1
+sugain < shot_fd_dip_rp.su scale=0.5 > nep.su; mv nep.su shot_fd_dip_rp.su
+sugain < shot_fd_dip_rvz.su scale=0.5 > nep.su; mv nep.su shot_fd_dip_rvz.su
+
+green c=$cp rho=$rho file_src=wave.su zsrc1=500 xrcv=-500,500 dxrcv=5 nt=4096 dip=1 | suwind nt=1024 > shot_green_dip_rp.su
+green c=$cp rho=$rho file_src=wave.su zsrc1=500 xrcv=-500,500 dxrcv=5 nt=4096 p_vz=1 dip=1 | suwind nt=1024 > shot_green_dip_rvz.su
+
+shift=`perl -e "print 0.5*$dx/$cp;"`
+
+# rp
+
+suwind key=tracl min=101 max=101 < shot_fd_dip_rp.su > shot_fd_dip_rp101.su
+basop file_in=shot_fd_dip_rp101.su dx=1 choice=shift shift=-$shift > trace_fd.su
+suwind key=tracl min=101 max=101 < shot_green_dip_rp.su > trace_green.su
+
+sumax < trace_green.su outpar=nep
+Mmax=`cat nep | awk '{print $1}'`
+a=`perl -e "print 100.0/$Mmax;"`
+echo $a
+
+sudiff trace_green.su trace_fd.su > nep.su
+basop file_in=nep.su dx=1 choice=shift shift=-0.1 | sugain scale=$a | suop op=abs >dip_diff_dx${dx}_rp.su
+
+supsgraph < dip_diff_dx${dx}_rp.su style=normal labelsize=12 wbox=4 hbox=2 label1='time in seconds' label2="Relative error in percentage of peak" linewidth=0.1 linecolor=red x2beg=0.0 x2end=1.0 f2num=0.0 d2num=0.5 > dip_diff_dx${dx}_rp.eps
+
+
+
+# rvz
+
+suwind key=tracl min=101 max=101 < shot_fd_dip_rvz.su > shot_fd_dip_rvz101.su
+basop file_in=shot_fd_dip_rvz101.su dx=1 choice=shift shift=-$shift > trace_fd.su
+suwind key=tracl min=101 max=101 < shot_green_dip_rvz.su > trace_green.su
+
+sumax < trace_green.su outpar=nep
+Mmax=`cat nep | awk '{print $1}'`
+a=`perl -e "print 100.0/$Mmax;"`
+echo $a
+
+sudiff trace_green.su trace_fd.su > nep.su
+basop file_in=nep.su dx=1 choice=shift shift=-0.1 | sugain scale=$a | suop op=abs > dip_diff_dx${dx}_rvz.su
+
+supsgraph < dip_diff_dx${dx}_rvz.su style=normal labelsize=12 wbox=4 hbox=2 label1='time in seconds' label2="Relative error in percentage of peak" linewidth=0.1 linecolor=red x2beg=0.0 x2end=1.0 f2num=0.0 d2num=0.5 > dip_diff_dx${dx}_rvz.eps
+
+done
+
diff --git a/fdelmodc3D/FiguresPaper/FigurePres.scr b/fdelmodc3D/FiguresPaper/FigurePres.scr
new file mode 100755
index 0000000000000000000000000000000000000000..f58d7278506fcd30062f17773e183ea8b07c155c
--- /dev/null
+++ b/fdelmodc3D/FiguresPaper/FigurePres.scr
@@ -0,0 +1,128 @@
+#!/bin/bash
+#PBS -l nodes=1:ppn=2
+#PBS -N InterfModeling
+#PBS -V
+#
+# snapshots for movie usage in presentation to explain SI, 2x800 s.
+
+export PATH=../../bin:$PATH
+
+makewave w=g1 fmax=30 t0=1.00 dt=0.0008 nt=4096 db=-40 file_out=G1.su verbose=1
+
+makemod sizex=10000 sizez=5000 dx=5 dz=5 cp0=1500 ro0=1000 file_base=simple.su \
+ intt=def poly=0 x=0,10000 z=1300,1300 cp=2000 ro=1400 \
+ intt=def poly=2 x=0,2000,3000,5000,7000,8000,10000 \
+ z=2000,2000,2000,2500,2000,2000,2000 cp=4000 ro=2000 \
+ intt=def poly=0 x=0,10000 z=3000,3000 cp=3000 ro=1500 \
+ intt=def poly=0 x=0,10000 z=3500,3500 cp=5500 ro=2200
+
+suwind itmin=181 < simple_cp.su | sushw key=f1 a=0 > vel_cp.su
+suwind itmin=181 < simple_ro.su | sushw key=f1 a=0 > vel_ro.su
+
+xsrc1=100
+xsrc2=9900
+dxsrc=10
+
+#volume
+zsrc1=500
+zsrc2=4090
+
+tmod=8
+tsrc2=8
+tlength=8
+nsrc=24
+fmax=30
+
+#Figure 7b,c,d,e,f
+
+
+
+ file_shot=shot_T${tmod}_S${nsrc}_Dt${tlength}_F${fmax}.su
+ echo $file_shot
+
+../fdelmodc \
+ file_cp=vel_cp.su ischeme=1 \
+ file_snap=snap.su \
+ file_den=vel_ro.su \
+ file_rcv=$file_shot \
+ rec_type_p=0 \
+ dtrcv=0.008 \
+ rec_ntsam=16384 \
+ dt=0.0005 \
+ verbose=4 \
+ tmod=$tmod \
+ dxrcv=10.0 \
+ plane_wave=0 \
+ amplitude=0 \
+ xsrc=5000 zsrc=2700 \
+ src_random=1 \
+ wav_random=1 \
+ fmax=$fmax \
+ xsrc1=$xsrc1 \
+ xsrc2=$xsrc2 \
+ zsrc1=$zsrc1 \
+ zsrc2=$zsrc2 \
+ tsrc1=0.0 \
+ tsrc2=$tsrc2 \
+ tlength=$tlength \
+ tsnap1=0.0 \
+ tsnap2=12 \
+ dxsnap=10 \
+ dzsnap=10 \
+ dtsnap=0.08 \
+ nsrc=$nsrc \
+ ntaper=45 \
+ left=4 right=4 top=1 bottom=4
+
+ file_shot=shotW_T${tmod}_S${nsrc}_Dt${tlength}_F${fmax}.su
+
+../fdelmodc \
+ file_cp=vel_cp.su ischeme=1 \
+ file_src=G1.su \
+ file_snap=snapW.su \
+ file_den=vel_ro.su \
+ file_rcv=$file_shot \
+ rec_type_p=0 \
+ dtrcv=0.008 \
+ rec_ntsam=16384 \
+ dt=0.0005 \
+ verbose=4 \
+ tmod=$tmod \
+ dxrcv=10.0 \
+ plane_wave=0 \
+ amplitude=0 \
+ xsrc=5000 zsrc=2700 \
+ src_random=1 \
+ wav_random=0 \
+ fmax=$fmax \
+ xsrc1=$xsrc1 \
+ xsrc2=$xsrc2 \
+ zsrc1=$zsrc1 \
+ zsrc2=$zsrc2 \
+ tsrc1=0.0 \
+ tsrc2=$tsrc2 \
+ tlength=$tlength \
+ tsnap1=0.0 \
+ tsnap2=12 \
+ dxsnap=10 \
+ dzsnap=10 \
+ dtsnap=0.08 \
+ nsrc=$nsrc \
+ ntaper=45 \
+ left=4 right=4 top=1 bottom=4
+
+exit;
+
+#Figure 5b
+suop2 SrcRecPositions.su vel_cp.su w1=8000 w2=1.0 op=sum |
+ sugain nclip=1500 | \
+ sushw key=f1,f2 a=-900,-5000 | \
+ supsimage hbox=4 wbox=8 labelsize=10 \
+ f2num=-5000 d2num=1000 f1num=0 d1num=500 \
+ x2beg=-5000 x2end=5000 \
+ bclip=7700 wclip=0 label1="depth (m)" label2="lateral position (m)" \
+ > simple_sources_cp.eps
+
+
+# wrgb=0,0,1.0 grgb=0,1.0,0 brgb=1.0,0,0 x2beg=-5000 x2end=5000 \
+
diff --git a/fdelmodc3D/FiguresPaper/FigureSourcesAppendixA.scr b/fdelmodc3D/FiguresPaper/FigureSourcesAppendixA.scr
new file mode 100755
index 0000000000000000000000000000000000000000..a415f894e179cecb4b025d83fd1db9baff7c6eb7
--- /dev/null
+++ b/fdelmodc3D/FiguresPaper/FigureSourcesAppendixA.scr
@@ -0,0 +1,92 @@
+#!/bin/bash
+#PBS -l nodes=1
+#PBS -N InterfModeling
+#PBS -q fourweeks
+#PBS -V
+#
+# source construction shown in Figure A2-A3-A4, 150 s.
+
+export PATH=../../bin:$PATH
+
+makewave w=g2 fmax=45 t0=0.10 dt=0.001 nt=4096 db=-40 file_out=G2.su verbose=1
+
+makemod sizex=10000 sizez=4100 dx=10 dz=10 cp0=1500 ro0=1000 file_base=simple.su \
+ intt=def poly=0 x=0,10000 z=400,400 cp=2000 ro=1400 \
+ intt=def poly=2 x=0,2000,3000,5000,7000,8000,10000 \
+ z=1100,1100,1100,1600,1100,1100,1100 cp=4000 ro=2000 \
+ intt=def poly=0 x=0,10000 z=2100,2100 cp=3000 ro=1500 \
+ intt=def poly=0 x=0,10000 z=2600,2600 cp=5500 ro=2200
+
+xsrc1=100
+xsrc2=9900
+zsrc1=2100
+zsrc2=4000
+
+file_shot=shotRandomPos${xsrc}_${zsrc1}.su
+
+fdelmodc \
+ file_cp=simple_cp.su ischeme=1 \
+ file_den=simple_ro.su \
+ file_rcv=$file_shot \
+ dtrcv=0.008 \
+ dt=0.0010 \
+ verbose=4 \
+ tmod=10.000 \
+ dxrcv=20.0 \
+ zrcv1=10 \
+ zrcv2=10 \
+ xrcv1=0 \
+ xrcv2=10000 \
+ src_random=1 \
+ wav_random=1 \
+ fmax=30 \
+ xsrc1=$xsrc1 \
+ xsrc2=$xsrc2 \
+ zsrc1=$zsrc1 \
+ zsrc2=$zsrc2 \
+ tsrc1=0.0 \
+ tsrc2=5.0 \
+ nsrc=20 \
+ dipsrc=0 \
+ ntaper=45 \
+ tsnap1=0.1 tsnap2=6.0 dtsnap=0.2 \
+ left=4 right=4 top=1 bottom=4 \
+ nxmax=2500 nzmax=1400 ntmax=10000
+
+psgraph < srcTimeLengthN\=10001.bin n1=10001 \
+ labelsize=12 d1=0.001 style=normal linecolor=blue \
+ label1="start time (s)" label2="source duration (s)" \
+ d1num=1 d2num=1 wbox=8 hbox=4 x1end=5 > srcTimeLength.eps
+
+supswigp < src_nwav.su \
+ labelsize=10 label1='time (s)' label2='source number' x1end=6 \
+ d2=1 d2num=1 hbox=4 wbox=6 fill=0 \
+ titlesize=-1 > src_nwav.eps
+
+suwind < src_nwav.su key=tracl min=11 max=11 | \
+ supsgraph hbox=2 wbox=4 style=normal \
+ labelsize=10 label2='amplitude' label1='time (s)' \
+ titlesize=-1 d1num=1.0 > src11_wiggle.eps
+
+suwind < src_nwav.su key=tracl min=11 max=11 | \
+ supsgraph hbox=2 wbox=4 style=normal \
+ labelsize=10 label2='amplitude' label1='time (s)' \
+ titlesize=-1 x1end=0.05 > src11_wiggle_zbeg.eps
+
+suwind < src_nwav.su key=tracl min=11 max=11 | \
+ supsgraph hbox=2 wbox=4 style=normal \
+ labelsize=10 label2='amplitude' label1='time (s)' \
+ titlesize=-1 x1beg=3.60 x1end=3.65 > src11_wiggle_zend.eps
+
+suwind < src_nwav.su key=tracl min=11 max=11 | \
+ sufft | suamp| supsgraph hbox=2 wbox=4 style=normal \
+ labelsize=10 label2='amplitude' label1='frequency (Hz)' \
+ titlesize=-1 x1end=100 d1num=10 > src11_ampl.eps
+
+fconv file_in1=src_nwav.su auto=1 shift=1 mode=cor1 | \
+ sugain qbal=1 | \
+ supswigp x1beg=-1 x1end=1 d2num=1 hbox=4 wbox=6 \
+ labelsize=10 label2='source number' label1='time (s)' \
+ titlesize=-1 fill=0 > src_nwav_autoCorr_Norm.eps
+
+
diff --git a/fdelmodc3D/FiguresPaper/MakeGifMovie.scr b/fdelmodc3D/FiguresPaper/MakeGifMovie.scr
new file mode 100755
index 0000000000000000000000000000000000000000..886b9851cab7895211daab4665541248d47bdefc
--- /dev/null
+++ b/fdelmodc3D/FiguresPaper/MakeGifMovie.scr
@@ -0,0 +1,48 @@
+#!/bin/bash
+
+
+# attempt to make movie from FigurePres.scr snapshots
+# the free program imageJ (http://rsbweb.nih.gov/ij/) is better to make movies.
+
+#ls snap_sP* >& Pfiles
+#sed s/".su"/".eps"/ Pfiles
+
+sbeg=0
+send=150
+file_snap=snap_sp.su
+fileshot=shot_T12_S100_Dt12_F30_rvz.su
+rm ${fileshot}_snaps.su
+
+for (( s=$sbeg; s <= $send; s+=1 )) do
+ time=$(echo "scale=4; $s*0.08"| bc -l)
+ trot=$(echo "scale=4; 12.0-$time"| bc -l)
+ timestr=$(printf %5.3f $time)
+ nump=`printf "%03d" $s`
+ echo s = $s time = $timestr
+
+ suwind < $fileshot tmax=$time | \
+ suwind itmax=1500 | rotate trot=$trot | \
+ sushw key=fldr a=$s >> ${fileshot}_snaps.su
+done
+
+exit;
+
+# supsimage labelsize=12 titlesize=14 title="time = ${timestr}" \
+# hbox=4.1 wbox=10 d1=5 d2=5 d1num=1000 d2num=2000 clip=12 > snap$nump.eps
+
+/usr/bin/convert -delay 20 PSsum*.eps PSsummovie.gif
+/usr/bin/convert -delay 20 PSsnap*.eps PSsnapmovie.gif
+/usr/bin/convert -delay 20 Psnap*.eps Psnapmovie.gif
+/usr/bin/convert -delay 20 Ssnap*.eps Ssnapmovie.gif
+
+
+basop < rcv_s_rpp.su choice=4 > rpp.su
+basop < rcv_s_rss.su choice=4 | scale a=-1 > rss.su
+
+susum rpp.su rss.su > rsspp.su
+supsimage < rpp.su brgb=0.0,0.0,1.0 grgb=1.0,1.0,1.0 wrgb=1.0,1.0,1.0 perc=99 > rpp.eps
+supsimage < rss.su brgb=1.0,1.0,1.0 grgb=1.0,1.0,1.0 wrgb=1.0,0.0,0.0 perc=99 > rss.eps
+
+supsimage < rsspp.su brgb=0.0,0.0,1.0 grgb=1.0,1.0,1.0 wrgb=1.0,0.0,0.0 perc=99 clip=3e-14 > rs
+spp.eps
+
diff --git a/fdelmodc3D/FiguresPaper/README b/fdelmodc3D/FiguresPaper/README
new file mode 100644
index 0000000000000000000000000000000000000000..f2d2aa51740c0d1394429e0cf7fad20eba6491a9
--- /dev/null
+++ b/fdelmodc3D/FiguresPaper/README
@@ -0,0 +1,140 @@
+
+The scripts in this directory reproduce the Figures shown in the paper "Finite-difference modeling experiments for seismic interferometry". Some of those scripts take a very long time to run. In this file some guidelines and runtime indications are given of the scripts to reproduce the Figures. The runtimes are given for a 2.5 Ghz Intel Core 2 Duo. OpenMP parallelization is not used.
+
+All scripts use some commands from Seismic Unix (SU) to plot results or post-process the data.
+
+==> Please make sure that SU is compiled without XDR (In $CWPROOT/Makefile.config make sure that XDRFLAG is NOT set). The SU output files of fdelmodc are base on local IEEE data.
+
+
+
+Figure2.scr
+-------------
+starts fdelmodc only to compute the source positions, 1 s.
+runtime: 5 seconds
+
+Figure3.scr
+-------------
+First the shots along the box-shaped contour are modeled for each shot separately. This takes a very long time. To model these shots two other script are called:
+
+Simple_model_base.scr, to model 900 shots at level z=3600
+Simple_model_sides.scr, to model 2x360 shots at the sides of the model at x=1000 and x=9000
+runtime one shot: 270 seconds.
+total runtime modeling: 122 hours.
+
+Figure3_ref.scr
+-------------
+direct modeled reference result Figure 3d
+runtime: 500 seconds.
+
+Figure4.scr
+-------------
+5 different source signature lengths
+Runtime: 3.5 hours per shot of 120 s. modeling
+
+Figure5.scr
+-------------
+simulates 8000 short (2.5 s) sources
+Runtime: 3.5 hours
+
+Figure6.scr
+-------------
+5 different number of random sources
+Runtime: 3.5 hours per shot of 120 s. modeling
+
+Figure6f.scr
+-------------
+make postscript file of middle trace after Figure6.scr, 1 s.
+Runtime: a few seconds to produce the figure.
+The script Figure6.scr must be run first
+
+Figure6length.scr
+-------------
+NOT used in paper: The same as script Figure6.scr, but a random source signature of a fixed length.
+
+Figure7.scr
+-------------
+as Figure 6, but with 1000 deep sources
+Runtime: 3.5 hours
+
+Figure7length.scr
+-------------
+NOT used in paper: The same as script Figure7.scr, but a random source signature of a fixed length.
+
+Figure7fmax.scr
+-------------
+NOT used in paper: The same as script Figure7.scr, but with varying maximum frequency in source signature.
+
+Figure8-9.scr
+-------------
+for random and ricker wavelet deep, volume and plane sources
+Runtime: 6 x 3.5 hours
+
+Figure8-9Hom.scr
+-------------
+for reviewer, same as Fig. 8-9 in homogeneous medium
+NOT used in paper: to answers reviewer, same as fig 8-9 in homogeneous medium,
+Runtime: 6 x 3.5 hours
+
+Figure10.scr
+-------------
+reference and 2 SI results for visco-acoustic media
+Runtime reference: 2 x 3 minutes
+Runtime deep and volume: 2 x 1.5 hours
+
+Figure11.scr
+-----------
+Uses the result of fdelmodc_long.scr and produces the postscript figures.
+
+The program to compute the correlation in a continuous way (corrsmp) is missing and the correlation result can not be reproduced. The program corrsmp is still in a development state and not yet suited for release.
+
+Figure12.scr
+-------------
+The program to compute the correlation in a continuous way (corrsmp) is missing and the correlation result can not be reproduced. The program corrsmp is still in a development state and not yet suited for release.
+
+Figure13.scr
+-------------
+amplitude variations on source strength
+Runtime: 3 x 1500 s.
+
+Figure14-15.scr
+-------------
+The reference shot can be reproduced, together with the long 3600 s modeling. The SI retrieved results can not be reproduced.
+runtime: 161 hours for the 3600 seconds passive measurement
+
+61 output files will be created each containing 65535 time samples.
+
+The program to compute the correlation in a continuous way (corrsmp) is missing and the correlation result can not be reproduced. The program corrsmp is still in a development state and not yet suited for release.
+
+
+FigureSourcesAppendixA.scr
+-------------
+source construction shown in Figure A2-A3-A4
+runtime: 150 seconds
+
+
+FigureGreenAppendixA.scr
+-------------
+compares FD result with analytical result
+runtime 80 seconds.
+
+SIrand.scr
+----------
+Script used to generate the retrieved reflection from passive measurements.
+
+fdelmodc_long.scr
+------------
+This script is used to model the passive measurements and takes ~100 hours.
+
+The program to compute the correlation in a continuous way (corrsmp) is missing and the correlation result can not be reproduced. The program corrsmp is still in a development state and not yet suited for release.
+
+cross.scr and FigureCCsources.scr
+----------
+used to answer a question of reviewer 3
+
+FigurePres.scr and MakeGifMovie.scr
+-------------
+Generates snapshots which can be used in a presentation to explain SI
+
+
+
+
diff --git a/fdelmodc3D/FiguresPaper/SIrand.scr b/fdelmodc3D/FiguresPaper/SIrand.scr
new file mode 100755
index 0000000000000000000000000000000000000000..ec7f7d557134d62a822ce938bbd1a5dc7efdb5c8
--- /dev/null
+++ b/fdelmodc3D/FiguresPaper/SIrand.scr
@@ -0,0 +1,82 @@
+#!/bin/bash
+
+# the middle trace is correlated with all the output traces to compute the SI result
+
+export PATH=../../bin:$PATH
+
+echo "SIrand.scr"
+
+if [[ $2 != "" ]]; then
+ dxrcv=$2
+else
+ dxrcv=50
+fi
+
+shot=$1
+base=`echo $shot | awk 'BEGIN { FS = ".su" } ; { print $1 }'`
+echo $base
+
+suwind s=1 j=1 tmax=4 f1=0.0 < $shot | \
+ sushw key=f1,delrt,d2 a=0.0,0.0,$dxrcv | \
+ supsimage perc=99 f1=0 f2=-5000 hbox=4 wbox=3 \
+ label1='time (s)' label2='lateral position (m)' \
+ labelsize=10 f2num=-5000 d2num=2500 > ${base}.eps
+
+ntraces=`surange < $shot | grep traces| awk '{print $1 }'`
+echo $ntraces
+middle=$(echo "scale=0; ($ntraces+1)/2"| bc -l)
+echo $middle
+suwind key=tracl min=$middle max=$middle < $shot > middleTrace.su
+
+fconv verbose=1 file_in1=$shot file_in2=middleTrace.su mode=cor1 shift=1 > corr.su
+
+#fconv ntfft=16384 file_in1=$shot file_in2=middleTrace.su mode=cor1 shift=1 | \
+# sufilter amps=0,0.5,1,1,0 f=0,2,3,50,60 > corr.su
+
+ns=`surange < corr.su | grep ns | awk '{print $2 }'`
+odd=$(( ns % 2))
+if [[ $odd == 1 ]]; then
+ ns2=$(echo "scale=0; ($ns-1)/2"| bc -l)
+ ns=$(echo "scale=0; $ns-1"| bc -l)
+else
+ ns2=$(echo "scale=0; ($ns)/2"| bc -l)
+fi
+
+echo $ns $odd
+echo $ns2
+
+suwind < corr.su itmin=0 itmax=$ns2 | suflip flip=3 > noncausal.su
+suwind < corr.su itmin=$ns2 itmax=$ns > causal.su
+
+#susum causal.su noncausal.su | \
+# suwind s=1 j=5 tmax=4 f1=0.0 | \
+# sushw key=f1,delrt,d2 a=0.0,0.0,250 | \
+# supswigp perc=99 f1=0 f2=-5000 hbox=8 wbox=6 \
+# labelsize=10 f2num=-5000 d2num=1000 > ${base}.eps
+#
+#suwind s=1 j=1 tmax=4 f1=0.0 < causal.su | \
+# sushw key=f1,delrt,d2 a=0.0,0.0,50 | \
+# supsimage perc=99 f1=0 f2=-5000 hbox=4 wbox=3 \
+# labelsize=10 f2num=-5000 d2num=2500 > ${base}_Causal.eps
+#
+#suwind s=1 j=1 tmax=4 f1=0.0 < causal.su | \
+# sushw key=f1,delrt,d2 a=0.0,0.0,50 | \
+# supsimage perc=99 f1=0 f2=-5000 hbox=4 wbox=3 \
+# labelsize=10 f2num=-5000 d2num=2500 > ${base}_NonCausal.eps
+
+susum causal.su noncausal.su | \
+ suwind s=1 j=1 tmax=4 f1=0.0 | \
+ sushw key=f1,delrt,d2 a=0.0,0.0,$dxrcv | \
+ supsimage perc=99 f1=0 f2=-5000 hbox=4 wbox=3 \
+ label1='time (s)' label2='lateral position (m)' \
+ labelsize=10 f2num=-5000 d2num=2500 > ${base}_add.eps
+
+f1=`surange < corr.su | grep f1 | awk '{print $2 }'`
+echo $f1
+
+suwind s=1 j=1 tmin=-1.0 tmax=1 f1=$f1 < corr.su | \
+ sushw key=f1,delrt,d2 a=-1.0,0.0,$dxrcv | \
+ supsimage f1=-1.0 f2=-5000 hbox=3 wbox=3 \
+ label1='time (s)' label2='lateral position (m)' \
+ labelsize=10 f2num=-5000 d2num=2500 > ${base}_corr.eps
+
diff --git a/fdelmodc3D/FiguresPaper/Simple_model_base.scr b/fdelmodc3D/FiguresPaper/Simple_model_base.scr
new file mode 100755
index 0000000000000000000000000000000000000000..22bb354d669cf6781f31b4f506f6ffddefd44515
--- /dev/null
+++ b/fdelmodc3D/FiguresPaper/Simple_model_base.scr
@@ -0,0 +1,61 @@
+#!/bin/bash
+#PBS -l nodes=1
+#PBS -N InterfModeling
+#PBS -q fourweeks
+#
+# models sequential 900 shots at level z = 3600, 70 hours
+
+export PATH=../../bin:$PATH
+
+filout='T_simple_dxrcv50_dx10.su'
+#
+#/bin/rm $filout
+#
+makewave w=g1 fmax=45 t0=1.00 dt=0.0005 nt=4096 db=-40 file_out=G1.su verbose=1
+
+makemod sizex=10000 sizez=5000 dx=5 dz=5 cp0=1500 ro0=1000 file_base=simple.su \
+ intt=def poly=0 x=0,10000 z=1300,1300 cp=2000 ro=1400 \
+ intt=def poly=2 x=0,2000,3000,5000,7000,8000,10000 \
+ z=2000,2000,2000,2500,2000,2000,2000 cp=4000 ro=2000 \
+ intt=def poly=0 x=0,10000 z=3000,3000 cp=3000 ro=1500 \
+ intt=def poly=0 x=0,10000 z=3500,3500 cp=5500 ro=2200
+
+suwind itmin=91 < simple_cp.su | sushw key=f1 a=0 > vel_cp.su
+suwind itmin=91 < simple_ro.su | sushw key=f1 a=0 > vel_ro.su
+
+xsrc1=1000
+xsrc2=9000
+dxsrc=10
+#
+xsrc=$xsrc1
+ishot=1
+while (( xsrc <= xsrc2 ))
+do
+echo ' modeling shot at x=' $xsrc
+
+fdelmodc \
+ file_cp=vel_cp.su ischeme=1 \
+ file_den=vel_ro.su \
+ file_src=G1.su \
+ file_rcv=shot.su \
+ verbose=1 \
+ fmax=45 \
+ tmod=16.000\
+ xrcv1=0. \
+ xrcv2=10000. \
+ zrcv1=0. \
+ zrcv2=0. \
+ dxrcv=50.0 \
+ xsrc=$xsrc \
+ zsrc=3600. \
+ ntaper=45 \
+ left=4 right=4 top=1 bottom=4
+
+(( ishot = $xsrc / $dxsrc ))
+echo ishot=$ishot
+(( xsrc = $xsrc + $dxsrc))
+
+sushw < shot_rvz.su key=fldr a=$ishot >> $filout
+
+done
+
diff --git a/fdelmodc3D/FiguresPaper/Simple_model_sides.scr b/fdelmodc3D/FiguresPaper/Simple_model_sides.scr
new file mode 100755
index 0000000000000000000000000000000000000000..1e1fa4adde85d23f0ee216f352867e9aaaeea30c
--- /dev/null
+++ b/fdelmodc3D/FiguresPaper/Simple_model_sides.scr
@@ -0,0 +1,101 @@
+#!/bin/bash
+#PBS -l nodes=1
+#PBS -N InterfModeling
+#PBS -q fourweeks
+#
+# models sequential 2x360 shots at the sides x=1000,9000, 50 hours
+
+export PATH=../../bin:$PATH
+
+filout='T_simple_sides_dxrcv50_dx10.su'
+#
+#/bin/rm $filout
+#
+#
+makewave w=g1 fmax=45 t0=1.00 dt=0.0005 nt=4096 db=-40 file_out=G1.su verbose=1
+
+makemod sizex=10000 sizez=5000 dx=5 dz=5 cp0=1500 ro0=1000 file_base=simple.su \
+ intt=def poly=0 x=0,10000 z=1300,1300 cp=2000 ro=1400 \
+ intt=def poly=2 x=0,2000,3000,5000,7000,8000,10000 \
+ z=2000,2000,2000,2500,2000,2000,2000 cp=4000 ro=2000 \
+ intt=def poly=0 x=0,10000 z=3000,3000 cp=3000 ro=1500 \
+ intt=def poly=0 x=0,10000 z=3500,3500 cp=5500 ro=2200
+
+suwind itmin=91 < simple_cp.su | sushw key=f1 a=0 > vel_cp.su
+suwind itmin=91 < simple_ro.su | sushw key=f1 a=0 > vel_ro.su
+
+xsrc1=1000
+xsrc2=1000
+zsrc1=0
+zsrc2=3590
+dzsrc=10
+#
+zsrc=$zsrc1
+ishot=901
+while (( zsrc <= zsrc2 ))
+do
+echo ' modeling shot at x=' $xsrc1 $zsrc
+
+fdelmodc \
+ file_cp=vel_cp.su ischeme=1 \
+ file_den=vel_ro.su \
+ file_src=G1.su \
+ file_rcv=shot2.su \
+ verbose=1 \
+ fmax=45 \
+ tmod=16.000\
+ zrcv1=0. \
+ xrcv1=0. \
+ xrcv2=10000. \
+ zrcv2=0. \
+ dxrcv=50.0 \
+ xsrc=$xsrc1 \
+ zsrc=$zsrc \
+ ntaper=45 \
+ left=4 right=4 top=1 bottom=4
+
+(( ishot = $ishot + 1))
+echo ishot=$ishot
+(( zsrc = $zsrc + $dzsrc))
+
+sushw < shot2_rvz.su key=fldr a=$ishot >> $filout
+
+done
+
+xsrc1=9000
+xsrc2=9000
+zsrc1=0
+zsrc2=3590
+dzsrc=10
+#
+zsrc=$zsrc1
+
+while (( zsrc <= zsrc2 ))
+do
+echo ' modeling shot at x=' $xsrc1 $zsrc
+
+fdelmodc \
+ file_cp=vel_cp.su ischeme=1 \
+ file_den=vel_ro.su \
+ file_src=G1.su \
+ file_rcv=shot2.su \
+ verbose=1 \
+ fmax=30 \
+ tmod=16.000\
+ xrcv1=0. \
+ xrcv2=10000. \
+ zrcv1=0. \
+ zrcv2=0. \
+ dxrcv=50.0 \
+ xsrc=$xsrc1 \
+ zsrc=$zsrc \
+ ntaper=45 \
+ left=4 right=4 top=1 bottom=4
+
+(( ishot = $ishot + 1))
+echo ishot=$ishot
+(( zsrc = $zsrc + $dzsrc))
+
+sushw < shot2_rvz.su key=fldr a=$ishot >> $filout
+
+done
diff --git a/fdelmodc3D/FiguresPaper/clean b/fdelmodc3D/FiguresPaper/clean
new file mode 100755
index 0000000000000000000000000000000000000000..085f0557f80ea4ee096c73abfa9b42a078e823bb
--- /dev/null
+++ b/fdelmodc3D/FiguresPaper/clean
@@ -0,0 +1,4 @@
+#!/bin/bash
+
+rm *.su *.bin *.txt *.eps nep
+
diff --git a/fdelmodc3D/FiguresPaper/cross.scr b/fdelmodc3D/FiguresPaper/cross.scr
new file mode 100755
index 0000000000000000000000000000000000000000..37473bfedec3c1bfb251d3b6bb9d09fff6c158a1
--- /dev/null
+++ b/fdelmodc3D/FiguresPaper/cross.scr
@@ -0,0 +1,33 @@
+#!/bin/bash
+#
+# calls FigureCCsources.scr and compute cross-correlation used in Figure 10 of manual, 1600 s.
+
+
+./FigureCCsources.scr
+
+traclrange=`surange < src_nwav.su | grep tracl`
+trace1=`echo $traclrange | cut -f2 -d" " `
+trace2=`echo $traclrange | cut -f3 -d" " `
+
+echo "tracerange = $trace1 $trace2"
+
+rm corr2d.bin
+for (( trace = $trace1; trace<=$trace2; trace+=1 )) do
+ echo $trace
+ suwind < src_nwav.su key=tracl min=$trace max=$trace > trace.su
+ fconv file_in1=src_nwav.su file_in2=trace.su file_out=cross.su mode=cor1 fmax=31 fmin=0
+ suwind < cross.su itmax=0 itmin=0 | sustrip >> corr2d.bin
+done
+
+suaddhead < corr2d.bin n1=100 | sugain pbal=1 dt=1 | suop op=abs | \
+ sugain scale=0.1005 dt=1 | \
+ supsimage legend=1 hbox=3 wbox=3 \
+ titlesize=-1 labelsize=10 label1="source number" label2="source number" \
+ d1=1 f1=1 f1num=0 d1num=20 d2num=20 > cross2d.eps
+
+ supswigb<src_nwav.su hbox=3 wbox=8 \
+ titlesize=-1 labelsize=10 label1="time in seconds" label2="source number" \
+ d2num=20 > src_before_cross.eps
+
+#suaddhead < corr2d.bin n1=100 | sugain pbal=1 dt=1 | suop op=abs | \
+# sugain scale=0.1005 dt=1 |sustrip > corr2d_scl.bin
diff --git a/fdelmodc3D/FiguresPaper/fdelmodc_amplitude.scr b/fdelmodc3D/FiguresPaper/fdelmodc_amplitude.scr
new file mode 100755
index 0000000000000000000000000000000000000000..e77369da70f14ed6d26d08278f9a80205dab5dcf
--- /dev/null
+++ b/fdelmodc3D/FiguresPaper/fdelmodc_amplitude.scr
@@ -0,0 +1,72 @@
+#!/bin/bash
+#PBS -l nodes=1:ppn=2
+#PBS -N InterfModeling
+#PBS -q oneweek
+#PBS -V
+#
+# models along recording on 3600 s. used in Fig 12, 100 hours
+
+export PATH=../../bin:$PATH
+
+#makewave w=g2 fp=10 t0=0.15 dt=0.0010 nt=4096 file_out=G2.su verbose=1
+
+makemod sizex=12000 sizez=5000 dx=10 dz=10 cs0=1500 cp0=1900 ro0=1000 file_base=simp.su \
+ intt=def poly=0 x=0,12000 z=400,400 cp=2100 ro=1400 cs=1600 \
+ intt=def poly=2 x=0,3000,4000,6000,8000,9000,12000 \
+ z=1100,1100,1100,1600,1100,1100,1100 cp=4000 ro=2000 cs=2800 \
+ intt=def poly=0 x=0,12000 z=2100,2100 cp=3000 ro=1500 cs=2000 \
+ intt=def poly=0 x=0,12000 z=2600,2600 cp=5500 ro=2200 cs=3000
+
+xsrc1=1100
+xsrc2=10900
+
+zsrc1=2700
+zsrc2=4090
+
+tmod=3600
+tsrc1=0.1
+tsrc2=3600
+tlength=500
+nsrc=1500
+fmax=30
+
+file_shot=long/shotAcousticA500_T${tmod}_S${nsrc}_Dt${tlength}_F${fmax}.su
+
+mkdir long
+
+export OMP_NUM_THREADS=2
+
+fdelmodc \
+ file_cp=simp_cp.su ischeme=1 \
+ file_den=simp_ro.su \
+ file_cs=simp_cs.su \
+ file_rcv=$file_shot \
+ rec_type_p=1 rec_type_vx=1 rec_type_vz=1 \
+ dtrcv=0.008 \
+ rec_ntsam=16384 \
+ dt=0.0010 \
+ verbose=3 \
+ tmod=$tmod \
+ dxrcv=50.0 \
+ xrcv1=1000 \
+ xrcv2=11000 \
+ zrcv1=0 \
+ zrcv2=0 \
+ amplitude=500 \
+ distribution=1 \
+ plane_wave=0 \
+ src_random=1 \
+ wav_random=1 \
+ fmax=$fmax \
+ xsrc1=$xsrc1 \
+ xsrc2=$xsrc2 \
+ zsrc1=$zsrc1 \
+ zsrc2=$zsrc2 \
+ tsrc1=0.0 \
+ tsrc2=$tsrc2 \
+ tlength=$tlength \
+ nsrc=$nsrc \
+ dipsrc=0 \
+ ntaper=100 \
+ left=4 right=4 top=1 bottom=4
+
diff --git a/fdelmodc3D/FiguresPaper/fdelmodc_long.scr b/fdelmodc3D/FiguresPaper/fdelmodc_long.scr
new file mode 100755
index 0000000000000000000000000000000000000000..db6a32126d20bbcb7ea9e4e1c0ef31b8eacfbdee
--- /dev/null
+++ b/fdelmodc3D/FiguresPaper/fdelmodc_long.scr
@@ -0,0 +1,65 @@
+#!/bin/bash
+#PBS -l nodes=1:ppn=2
+#PBS -N InterfModeling
+#PBS -q oneweek
+#PBS -V
+#
+# models along recording on 3600 s. used in Fig 11, 100 hours
+
+export PATH=../../bin:$PATH
+
+#makewave w=g2 fp=10 t0=0.15 dt=0.0010 nt=4096 file_out=G2.su verbose=1
+
+makemod sizex=10000 sizez=4100 dx=10 dz=10 cs0=1500 cp0=1900 ro0=1000 file_base=simp.su \
+ intt=def poly=0 x=0,10000 z=400,400 cp=2100 ro=1400 cs=1600 \
+ intt=def poly=2 x=0,2000,3000,5000,7000,8000,10000 \
+ z=1100,1100,1100,1600,1100,1100,1100 cp=4000 ro=2000 cs=2800 \
+ intt=def poly=0 x=0,10000 z=2100,2100 cp=3000 ro=1500 cs=2000 \
+ intt=def poly=0 x=0,10000 z=2600,2600 cp=5500 ro=2200 cs=3000
+
+xsrc1=100
+xsrc2=9900
+
+zsrc1=2700
+zsrc2=4090
+
+tmod=3600
+tsrc1=0.1
+tsrc2=3600
+tlength=500
+nsrc=1500
+fmax=30
+
+mkdir long
+
+file_shot=long/shotAcoustic_T${tmod}_S${nsrc}_Dt${tlength}_F${fmax}.su
+
+
+fdelmodc \
+ file_cp=simp_cp.su ischeme=1 \
+ file_den=simp_ro.su \
+ file_cs=simp_cs.su \
+ file_rcv=$file_shot \
+ rec_type_p=1 rec_type_vx=1 rec_type_vz=1 \
+ dtrcv=0.008 \
+ rec_ntsam=16384 \
+ dt=0.0010 \
+ verbose=3 \
+ tmod=$tmod \
+ dxrcv=50.0 \
+ plane_wave=0 \
+ src_random=1 \
+ wav_random=1 \
+ fmax=$fmax \
+ xsrc1=$xsrc1 \
+ xsrc2=$xsrc2 \
+ zsrc1=$zsrc1 \
+ zsrc2=$zsrc2 \
+ tsrc1=0.0 \
+ tsrc2=$tsrc2 \
+ tlength=$tlength \
+ nsrc=$nsrc \
+ dipsrc=0 \
+ ntaper=45 \
+ left=4 right=4 top=1 bottom=4
+
diff --git a/fdelmodc3D/FiguresPaper/fdelmodc_real.scr b/fdelmodc3D/FiguresPaper/fdelmodc_real.scr
new file mode 100755
index 0000000000000000000000000000000000000000..2106b982a86545eb1038ac768dbf931fe5089378
--- /dev/null
+++ b/fdelmodc3D/FiguresPaper/fdelmodc_real.scr
@@ -0,0 +1,136 @@
+#!/bin/bash
+#PBS -l nodes=1
+#PBS -N InterfModeling
+#PBS -q fourweeks
+#PBS -V
+#
+
+export PATH=../../bin:$PATH
+
+dt=0.0001
+ntap=360
+
+makemod sizex=10000 sizez=4100 dx=2 dz=2 cp0=0 ro0=1000 file_base=real.su \
+ orig=0,-800 gradunit=1 \
+ intt=def poly=2 cp=2450 ro=1000 gradcp=14 grad=0 \
+ x=0,1000,1700,1800,2000,3000,4000,4500,6000,6800,7000,7500,8100,8800,10000 \
+ z=-100,-200,-250,-200,-200,-120,-300,-600,-650,-500,-350,-200,-200,-150,-200 \
+ intt=rough var=200,3.2,1 poly=2 x=0,3000,8000,10000 z=400,250,300,500 cp=4500,4200,4800,4500 ro=1400 gradcp=5 grad=0 \
+ intt=def poly=2 x=0,2000,3000,5000,7000,8000,10000 \
+ z=1100,1100,1100,1600,1100,1100,1100 cp=4000 ro=2000 gradcp=8 grad=0 \
+ intt=def poly=0 x=0,10000 z=1750,2050 cp=4500,5100 ro=1500 gradcp=13 grad=0 \
+ intt=def poly=0 x=0,10000 z=1850,2150 cp=6000,4200 ro=1500 gradcp=14 grad=0 \
+ intt=def poly=0 x=0,10000 z=1950,2250 cp=4800,4800 ro=1500 gradcp=5 grad=0 \
+ intt=def poly=0 x=0,10000 z=2000,2300 cp=6100,5000 ro=1500 gradcp=13 grad=0 \
+ intt=def poly=0 x=0,10000 z=2100,2400 cp=3800,5000 ro=1500 gradcp=20 grad=0 \
+ intt=def poly=0 x=0,10000 z=2150,2450 cp=5000 ro=1500 gradcp=14 grad=0 \
+ intt=def poly=0 x=0,10000 z=2350,2650 cp=5800 ro=1500 gradcp=5 grad=0 \
+ intt=def poly=0 x=0,10000 z=2600,2600 cp=5500 ro=2200 gradcp=5 grad=0
+
+sushw key=f1 a=0 < real_cp.su | \
+ sushw key=f1 a=0 | \
+ supsimage hbox=6 wbox=8 labelsize=10 f2num=-5000 d2num=1000 \
+ wrgb=0,0,1.0 grgb=0,1.0,0 brgb=1.0,0,0 \
+ bclip=7053.02 wclip=0 label1="depth [m]" label2="lateral position [m]" \
+ > model_cp.eps
+
+
+makewave w=g2 fmax=45 t0=0.10 dt=$dt nt=4096 db=-40 file_out=G2.su verbose=1
+
+
+extendModel file_in=real_ro.su nafter=$ntap nbefore=$ntap nabove=0 nbelow=$ntap > vel_edge_ro.su
+extendModel file_in=real_cp.su nafter=$ntap nbefore=$ntap nabove=0 nbelow=$ntap > vel_edge_cp.su
+
+#reference
+
+fdelmodc \
+ file_cp=vel_edge_cp.su ischeme=1 \
+ file_den=vel_edge_ro.su \
+ file_rcv=shot_real_x5000_topo.su \
+ file_src=G2.su \
+ dtrcv=0.004 \
+ verbose=4 \
+ tmod=3.000 \
+ dxrcv=20.0 \
+ zrcv1=-800 \
+ xrcv1=0 \
+ xrcv2=10000 \
+ sinkdepth=1 \
+ src_random=0 \
+ wav_random=0 \
+ xsrc1=5000 \
+ xsrc2=5000 \
+ zsrc1=-800 \
+ tsrc1=0.0 \
+ dipsrc=1 \
+ ntaper=$ntap \
+ left=4 right=4 top=1 bottom=4
+
+
+exit;
+
+#road
+xsrc1=6000
+xsrc2=10000
+zsrc1=10
+zsrc2=50
+nsrc=150
+tlength=10
+
+xsrc1=0
+xsrc2=10000
+
+#deep
+#zsrc1=3000
+#zsrc2=4000
+
+#Volume
+zsrc1=500
+zsrc2=4000
+
+tlength=50
+nsrc=1500
+
+
+xsrc1=100
+xsrc2=9900
+zsrc1=1750
+zsrc2=2600
+
+fmax=30
+tmod=3600
+tsrc1=0.1
+tsrc2=3600
+
+file_shot=short/shot_real_T${tmod}_S${nsrc}_Dt${tlength}_F${fmax}.su
+#file_shot=short/road_T${tmod}_S${nsrc}_Dt${tlength}_F${fmax}.su
+
+fdelmodc \
+ file_cp=vel_edge_cp.su ischeme=1 \
+ file_den=vel_edge_ro.su \
+ file_rcv=$file_shot \
+ dtrcv=0.004 \
+ dt=$dt \
+ verbose=4 \
+ rec_ntsam=1500 \
+ tmod=$tmod \
+ dxrcv=20.0 \
+ zrcv1=-800 \
+ xrcv1=0 \
+ xrcv2=10000 \
+ sinkdepth=1 \
+ src_random=1 \
+ wav_random=1 \
+ fmax=$fmax \
+ xsrc1=$xsrc1 \
+ xsrc2=$xsrc2 \
+ zsrc1=$zsrc1 \
+ zsrc2=$zsrc2 \
+ tsrc1=0.0 \
+ tsrc2=$tsrc2 \
+ tlength=$tlength \
+ nsrc=$nsrc \
+ dipsrc=0 \
+ ntaper=$ntap \
+ left=4 right=4 top=1 bottom=4
+
diff --git a/fdelmodc3D/FiguresPaper/normalorg.gnp b/fdelmodc3D/FiguresPaper/normalorg.gnp
new file mode 100644
index 0000000000000000000000000000000000000000..04843f386370f0ccd6e7a9f17bd83e9a17103947
--- /dev/null
+++ b/fdelmodc3D/FiguresPaper/normalorg.gnp
@@ -0,0 +1,44 @@
+
+unset contour
+
+load "stat.inc"
+
+print ""
+print "Simple Monte Carlo simulation"
+print ""
+print "The first curve is a histogram where the binned frequency of occurence"
+print "of a pseudo random variable distributed according to the normal"
+print "(Gaussian) law is scaled such that the histogram converges to the"
+print "normal probability density function with increasing number of samples"
+print "used in the Monte Carlo simulation. The second curve is the normal"
+print "probability density function with unit variance and zero mean."
+print ""
+nsamp = 5000
+binwidth = 20
+xlow = -3.0
+xhigh = 3.0
+scale = (binwidth/(xhigh-xlow))
+# A somewhat inelegant way of generating N random data points. A future
+# non-pressing plot-command feature addition may address this issue.
+set parametric
+set samples nsamp
+set format "%8.5g"
+set table "random.tmp"
+plot invnorm(rand(0)),(1.0*scale/nsamp)
+unset table
+unset format
+#
+unset parametric
+set samples 200
+tstring(n) = sprintf("Histogram of %d random samples from a univariate\nGaussian PDF with unit variance and zero mean", n)
+set title tstring(nsamp)
+set key
+set grid
+set xrange [-3:3]
+set yrange [0:0.45]
+bin(x) = (1.0/scale)*floor(x*scale)
+plot "random.tmp" using (bin($1)):2 smooth frequency with steps \
+ title "scaled bin frequency", \
+ normal(x,0,1) with lines title "Gaussian p.d.f."
+
+
diff --git a/fdelmodc3D/FiguresPaper/plot.py b/fdelmodc3D/FiguresPaper/plot.py
new file mode 100644
index 0000000000000000000000000000000000000000..61ebf3125ba7aee22b16861f61bf7fb593bf81c2
--- /dev/null
+++ b/fdelmodc3D/FiguresPaper/plot.py
@@ -0,0 +1,19 @@
+from scitools.std import *
+
+x = y = linspace(1, 100, 100)
+
+xv, yv = ndgrid(x, y)
+
+#values = sin(sqrt(xv**2 + yv**2))
+values = fromfile("corr2d_scl.bin", dtype=single, count=-1, sep='')
+values.shape=(100,100)
+
+#mesh(xv, yv, values)
+surf(xv, yv, values,
+ shading='flat',
+ colorbar='on',
+ colormap=gray(m=1),
+ axis=[1,100,1,100,0,1],
+ view=[35,45])
+
+hardcopy('tmp0.eps')
diff --git a/fdelmodc3D/FiguresPaper/plot3d.gnu b/fdelmodc3D/FiguresPaper/plot3d.gnu
new file mode 100644
index 0000000000000000000000000000000000000000..ce376611d6f740ee305d05f7b598c33b7450130f
--- /dev/null
+++ b/fdelmodc3D/FiguresPaper/plot3d.gnu
@@ -0,0 +1,13 @@
+set terminal png transparent nocrop enhanced size 500,420
+set output 'binary.1.png'
+
+#set key inside right top vertical Right noreverse enhanced autotitles box linetype -1 linewidth 1.000
+#set hidden3d offset 1 trianglepattern 3 undefined 1 altdiagonal bentover
+set style data lines
+#set ticslevel 0
+#set title "Hidden line removal of explicit binary surfaces"
+#set xrange [ 1.00000 : 100.00000 ] noreverse nowriteback
+#set yrange [ 1.00000 : 100.00000 ] noreverse nowriteback
+set zrange [ 1.00000 : 200000000.00000 ]
+splot "corr2d.bin" binary array=100x100 format="%float32" endian=little
+
diff --git a/fdelmodc3D/Makefile b/fdelmodc3D/Makefile
new file mode 100644
index 0000000000000000000000000000000000000000..c1820c9cb751513d5c1572335183bb54c3d02ab2
--- /dev/null
+++ b/fdelmodc3D/Makefile
@@ -0,0 +1,88 @@
+# Makefile
+
+include ../Make_include
+
+########################################################################
+# define general include and system library
+ALLINC = -I.
+LIBS += -L$L -lgenfft -lm $(LIBSM)
+#LIBS += -L$L -lgenfft -lm -lc
+#OPTC = -g -Wall -fsignaling-nans -O0 -fopenmp
+#OPTC += -fopenmp -Waddress
+#OPTC := $(subst -O3 -ffast-math, -O1 -g ,$(OPTC))
+#PGI options for compiler feedback
+#OPTC += -Mprof=lines
+#OPTC += -qopt-report
+#LDFLAGS += -Mprof=lines
+
+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 \
+ decomposition.c \
+ fileOpen.c \
+ recvPar.c \
+ readModel.c \
+ sourceOnSurface.c \
+ getWaveletHeaders.c \
+ boundaries.c \
+ verbosepkg.c \
+ writesufile.c \
+ gaussGen.c \
+ spline3.c \
+ CMWC4096.c \
+ wallclock_time.c \
+ name_ext.c \
+ atopkge.c \
+ docpkge.c \
+ threadAffinity.c \
+ getpars.c
+
+OBJC = $(SRCC:%.c=%.o)
+
+$(PRG): $(OBJC) fdelmodc.h
+ $(CC) $(LDFLAGS) $(CFLAGS) $(OPTC) -o fdelmodc3D $(OBJC) $(LIBS)
+
+install: fdelmodc3D
+ cp fdelmodc3D $B
+
+clean:
+ rm -f core $(OBJC) $(OBJM) fdelmodc3D
+
+realclean:
+ rm -f core $(OBJC) $(OBJM) $(PRG) $B/fdelmodc3D
+
+
+print: Makefile $(SRC)
+ $(PRINT) $?
+ @touch print
+
+count:
+ @wc $(SRC)
+
+tar:
+ @tar cf $(PRG).tar Makefile $(SRC) && compress $(PRG).tar
+
+
+
diff --git a/fdelmodc3D/SUsegy.h b/fdelmodc3D/SUsegy.h
new file mode 100644
index 0000000000000000000000000000000000000000..a9133b999320911b29505909c2e4cd5f33b83dc5
--- /dev/null
+++ b/fdelmodc3D/SUsegy.h
@@ -0,0 +1,391 @@
+/* This file is property of the Colorado School of Mines.
+
+ Copyright © 2007, Colorado School of Mines,
+ All rights reserved.
+
+
+ Redistribution and use in source and binary forms, with or
+ without modification, are permitted provided that the following
+ conditions are met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above
+ copyright notice, this list of conditions and the following
+ disclaimer in the documentation and/or other materials provided
+ with the distribution.
+ * Neither the name of the Colorado School of Mines nor the names of
+ its contributors may be used to endorse or promote products
+ derived from this software without specific prior written permission.
+
+ Warranty Disclaimer:
+ THIS SOFTWARE IS PROVIDED BY THE COLORADO SCHOOL OF MINES AND CONTRIBUTORS
+ "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+ FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+ COLORADO SCHOOL OF MINES OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+ INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+ BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+ LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+ CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+ STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING
+ IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ POSSIBILITY OF SUCH DAMAGE.
+
+
+ Export Restriction Disclaimer:
+ We believe that CWP/SU: Seismic Un*x is a low technology product that does
+ not appear on the Department of Commerce CCL list of restricted exports.
+ Accordingly, we believe that our product meets the qualifications of
+ an ECCN (export control classification number) of EAR99 and we believe
+ it fits the qualifications of NRR (no restrictions required), and
+ is thus not subject to export restrictions of any variety.
+
+ Approved Reference Format:
+ In publications, please refer to SU as per the following example:
+ Cohen, J. K. and Stockwell, Jr. J. W., (200_), CWP/SU: Seismic Un*x
+ Release No. __: an open source software package for seismic
+ research and processing,
+ Center for Wave Phenomena, Colorado School of Mines.
+
+ Articles about SU in peer-reviewed journals:
+ Saeki, T., (1999), A guide to Seismic Un*x (SU)(2)---examples of data processing (part 1), data input and preparation of headers, Butsuri-Tansa (Geophysical Exploration), vol. 52, no. 5, 465-477.
+ Stockwell, Jr. J. W. (1999), The CWP/SU: Seismic Un*x Package, Computers and Geosciences, May 1999.
+ Stockwell, Jr. J. W. (1997), Free Software in Education: A case study of CWP/SU: Seismic Un*x, The Leading Edge, July 1997.
+ Templeton, M. E., Gough, C.A., (1998), Web Seismic Un*x: Making seismic reflection processing more accessible, Computers and Geosciences.
+
+ Acknowledgements:
+ SU stands for CWP/SU:Seismic Un*x, a processing line developed at Colorado
+ School of Mines, partially based on Stanford Exploration Project (SEP)
+ software.
+ */
+
+/* segy.h - include file for SEGY traces
+ *
+ * declarations for:
+ * typedef struct {} segy - the trace identification header
+ * typedef struct {} bhed - binary header
+ *
+ * Note:
+ * If header words are added, run the makefile in this directory
+ * to recreate hdr.h.
+ *
+ * Reference:
+ * K. M. Barry, D. A. Cavers and C. W. Kneale, "Special Report:
+ * Recommended Standards for Digital Tape Formats",
+ * Geophysics, vol. 40, no. 2 (April 1975), P. 344-352.
+ *
+ * $Author: john $
+ * $Source: /usr/local/cwp/src/su/include/RCS/segy.h,v $
+ * $Revision: 1.23 $ ; $Date: 1998/03/26 23:48:18 $
+ */
+
+/* #define SU_NFLTS 800000 Arbitrary limit on data array size */
+
+/**
+* This segyhdr has been redefined and uses an integer (32 bit) for number of samples (ns)
+* Jan Thorbecke
+**/
+
+
+/* TYPEDEFS */
+typedef struct { /* segy - trace identification header */
+
+ int tracl; /* trace sequence number within line */
+
+ int tracr; /* trace sequence number within reel */
+
+ int fldr; /* field record number */
+
+ int tracf; /* trace number within field record */
+
+ int ep; /* energy source point number */
+
+ int cdp; /* CDP ensemble number */
+
+ int cdpt; /* trace number within CDP ensemble */
+
+ short trid; /* trace identification code:
+ 1 = seismic data
+ 2 = dead
+ 3 = dummy
+ 4 = time break
+ 5 = uphole
+ 6 = sweep
+ 7 = timing
+ 8 = water break
+ 9---, N = optional use (N = 32,767)
+
+ Following are CWP id flags:
+
+ 9 = autocorrelation
+
+ 10 = Fourier transformed - no packing
+ xr[0],xi[0], ..., xr[N-1],xi[N-1]
+
+ 11 = Fourier transformed - unpacked Nyquist
+ xr[0],xi[0],...,xr[N/2],xi[N/2]
+
+ 12 = Fourier transformed - packed Nyquist
+ even N:
+ xr[0],xr[N/2],xr[1],xi[1], ...,
+ xr[N/2 -1],xi[N/2 -1]
+ (note the exceptional second entry)
+ odd N:
+ xr[0],xr[(N-1)/2],xr[1],xi[1], ...,
+ xr[(N-1)/2 -1],xi[(N-1)/2 -1],xi[(N-1)/2]
+ (note the exceptional second & last entries)
+
+ 13 = Complex signal in the time domain
+ xr[0],xi[0], ..., xr[N-1],xi[N-1]
+
+ 14 = Fourier transformed - amplitude/phase
+ a[0],p[0], ..., a[N-1],p[N-1]
+
+ 15 = Complex time signal - amplitude/phase
+ a[0],p[0], ..., a[N-1],p[N-1]
+
+ 16 = Real part of complex trace from 0 to Nyquist
+
+ 17 = Imag part of complex trace from 0 to Nyquist
+
+ 18 = Amplitude of complex trace from 0 to Nyquist
+
+ 19 = Phase of complex trace from 0 to Nyquist
+
+ 21 = Wavenumber time domain (k-t)
+
+ 22 = Wavenumber frequency (k-omega)
+
+ 23 = Envelope of the complex time trace
+
+ 24 = Phase of the complex time trace
+
+ 25 = Frequency of the complex time trace
+
+ 30 = Depth-Range (z-x) traces
+
+ 43 = Seismic Data, Vertical Component
+
+ 44 = Seismic Data, Horizontal Component 1
+
+ 45 = Seismic Data, Horizontal Component 2
+
+ 46 = Seismic Data, Radial Component
+
+ 47 = Seismic Data, Transverse Component
+
+ 101 = Seismic data packed to bytes (by supack1)
+
+ 102 = Seismic data packed to 2 bytes (by supack2)
+ */
+
+ short nvs; /* number of vertically summed traces (see vscode
+ in bhed structure) */
+
+ short nhs; /* number of horizontally summed traces (see vscode
+ in bhed structure) */
+
+ short duse; /* data use:
+ 1 = production
+ 2 = test */
+
+ int offset; /* distance from source point to receiver
+ group (negative if opposite to direction
+ in which the line was shot) */
+
+ int gelev; /* receiver group elevation from sea level
+ (above sea level is positive) */
+
+ int selev; /* source elevation from sea level
+ (above sea level is positive) */
+
+ int sdepth; /* source depth (positive) */
+
+ int gdel; /* datum elevation at receiver group */
+
+ int sdel; /* datum elevation at source */
+
+ int swdep; /* water depth at source */
+
+ int gwdep; /* water depth at receiver group */
+
+ short scalel; /* scale factor for previous 7 entries
+ with value plus or minus 10 to the
+ power 0, 1, 2, 3, or 4 (if positive,
+ multiply, if negative divide) */
+
+ short scalco; /* scale factor for next 4 entries
+ with value plus or minus 10 to the
+ power 0, 1, 2, 3, or 4 (if positive,
+ multiply, if negative divide) */
+
+ int sx; /* X source coordinate */
+
+ int sy; /* Y source coordinate */
+
+ int gx; /* X group coordinate */
+
+ int gy; /* Y group coordinate */
+
+ short counit; /* coordinate units code:
+ for previous four entries
+ 1 = length (meters or feet)
+ 2 = seconds of arc (in this case, the
+ X values are longitude and the Y values
+ are latitude, a positive value designates
+ the number of seconds east of Greenwich
+ or north of the equator */
+
+ short wevel; /* weathering velocity */
+
+ short swevel; /* subweathering velocity */
+
+ short sut; /* uphole time at source */
+
+ short gut; /* uphole time at receiver group */
+
+ short sstat; /* source static correction */
+
+ short gstat; /* group static correction */
+
+ short tstat; /* total static applied */
+
+ short laga; /* lag time A, time in ms between end of 240-
+ byte trace identification header and time
+ break, positive if time break occurs after
+ end of header, time break is defined as
+ the initiation pulse which maybe recorded
+ on an auxiliary trace or as otherwise
+ specified by the recording system */
+
+ short lagb; /* lag time B, time in ms between the time break
+ and the initiation time of the energy source,
+ may be positive or negative */
+
+ short delrt; /* delay recording time, time in ms between
+ initiation time of energy source and time
+ when recording of data samples begins
+ (for deep water work if recording does not
+ start at zero time) */
+
+ short muts; /* mute time--start */
+
+ short mute; /* mute time--end */
+
+ short igc; /* instrument gain constant */
+
+ int ns; /* number of samples in this trace */
+
+ unsigned short dt; /* sample interval; in micro-seconds */
+
+ short gain; /* gain type of field instruments code:
+ 1 = fixed
+ 2 = binary
+ 3 = floating point
+ 4 ---- N = optional use */
+
+ short igi; /* instrument early or initial gain */
+
+ short corr; /* correlated:
+ 1 = no
+ 2 = yes */
+
+ short sfs; /* sweep frequency at start */
+
+ short sfe; /* sweep frequency at end */
+
+ short slen; /* sweep length in ms */
+
+ short styp; /* sweep type code:
+ 1 = linear
+ 2 = cos-squared
+ 3 = other */
+
+ short stas; /* sweep trace length at start in ms */
+
+ short stae; /* sweep trace length at end in ms */
+
+ short tatyp; /* taper type: 1=linear, 2=cos^2, 3=other */
+
+ short afilf; /* alias filter frequency if used */
+
+ short afils; /* alias filter slope */
+
+ short nofilf; /* notch filter frequency if used */
+
+ short nofils; /* notch filter slope */
+
+ short lcf; /* low cut frequency if used */
+
+ short hcf; /* high cut frequncy if used */
+
+ short lcs; /* low cut slope */
+
+ short hcs; /* high cut slope */
+
+ short year; /* year data recorded */
+
+ short day; /* day of year */
+
+ short hour; /* hour of day (24 hour clock) */
+
+ short minute; /* minute of hour */
+
+ short sec; /* second of minute */
+
+ short timbas; /* time basis code:
+ 1 = local
+ 2 = GMT
+ 3 = other */
+
+ short trwf; /* trace weighting factor, defined as 1/2^N
+ volts for the least sigificant bit */
+
+ short grnors; /* geophone group number of roll switch
+ position one */
+
+ short grnofr; /* geophone group number of trace one within
+ original field record */
+
+ short grnlof; /* geophone group number of last trace within
+ original field record */
+
+ short gaps; /* gap size (total number of groups dropped) */
+
+ short otrav; /* overtravel taper code:
+ 1 = down (or behind)
+ 2 = up (or ahead) */
+
+ /* local assignments */
+
+ short mark; /* mark selected traces */
+
+ float d1; /* sample spacing for non-seismic data */
+
+ float f1; /* first sample location for non-seismic data */
+
+ float d2; /* sample spacing between traces */
+
+ float f2; /* first trace location */
+
+ float ungpow; /* negative of power used for dynamic
+ range compression */
+
+ float unscale; /* reciprocal of scaling factor to normalize
+ range */
+
+ int ntr; /* number of traces */
+
+/* short shortpad; alignment padding */
+
+ short unass[14]; /* unassigned--NOTE: last entry causes
+ a break in the word alignment, if we REALLY
+ want to maintain 240 bytes, the following
+ entry should be an odd number of short/UINT2
+ OR do the insertion above the "mark" keyword
+ entry */
+
+} SUsegy;
+
+
diff --git a/fdelmodc3D/ToDo/acoustic4Block.c b/fdelmodc3D/ToDo/acoustic4Block.c
new file mode 100644
index 0000000000000000000000000000000000000000..0ba6ed9b10b4693ddc64448eabd19d3c34b720b7
--- /dev/null
+++ b/fdelmodc3D/ToDo/acoustic4Block.c
@@ -0,0 +1,232 @@
+#include<stdlib.h>
+#include<stdio.h>
+#include<math.h>
+#include<assert.h>
+#include"fdelmodc.h"
+
+#define MAX(x,y) ((x) > (y) ? (x) : (y))
+#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 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)
+{
+/*********************************************************************
+ 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 |
+
+***********************************************************************/
+
+ float c1, c2;
+ float tmps;
+ int ix, iz, ibnd, store;
+ int nx, nz, n1;
+ int ioXx, ioXz, ioZz, ioZx, ioPx, ioPz;
+ int bx, bz, ibx, ibz, ixs, ixe, izs, ize;
+
+
+ c1 = 9.0/8.0;
+ c2 = -1.0/24.0;
+ nx = mod.nx;
+ nz = mod.nz;
+ n1 = mod.naz;
+ bx = 25;
+ bz = 25;
+
+ ibnd = mod.iorder/2-1;
+
+ 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*/
+ for (ibx=ioXx; ibx<nx+1; ibx+=bx) {
+ ixs = ibx;
+ ixe = MIN(nx+1,ixs+bx);
+ /* for (ibz=ioXz; ibz<nz+1; ibz+=bz) {
+ izs = ibz;
+ ize = MIN(nz+1,izs+bz);
+ */ for (ix=ixs; ix<ixe; ix++) {
+ for (iz=ioXz; iz<nz+1; 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 */
+ for (ix=ioZx; ix<nx+1; ix++) {
+ for (iz=ioZz; iz<nz+1; 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]));
+ }
+ }
+
+ /* for (ibx=ioZx; ibx<nx+1; ibx+=bx) {
+ ixs = ibx;
+ ixe = MIN(nx+1,ixs+bx);
+ for (ibz=ioZz; ibz<nz+1; ibz+=bz) {
+ izs = ibz;
+ ize = MIN(nz+1,izs+bz);
+ for (ix=ixs; ix<ixe; ix++) {
+ for (iz=izs; iz<ize; 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);
+ }
+
+ /* rigid boundary condition clears velocities on boundaries */
+ if (bnd.rig[0]) { /* rigid surface at top */
+ for (ix=ibnd; ix<=ibnd+nx-1; ix++) {
+// ToDo iz = bnd.surface[ix-ibnd];
+ vx[ix*n1+ibnd] = 0.0;
+ vz[ix*n1+ibnd] = -vz[ix*n1+ibnd+1];
+ if (mod.iorder == 4) vz[ix*n1+0] = -vz[ix*n1+3];
+ }
+ }
+ if (bnd.rig[1]) { /* rigid surface at right */
+ for (iz=ibnd; iz<=ibnd+nz-1; iz++) {
+ vx[(nx+ibnd)*n1+iz] = -vx[(nx+ibnd-1)*n1+iz];
+ vz[(nx+ibnd-1)*n1+iz] = 0.0;
+ if (mod.iorder == 4) vx[(nx+2)*n1+iz] = -vx[(nx-1)*n1+iz];
+ }
+ }
+ if (bnd.rig[2]) { /* rigid surface at bottom */
+ for (ix=ibnd; ix<=ibnd+nx-1; 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 (bnd.rig[3]) { /* rigid surface at left */
+ for (iz=ibnd; iz<=ibnd+nz-1; iz++) {
+ vx[ibnd*n1+iz] = -vx[(ibnd-1)*n1+iz];
+ vz[ibnd*n1+iz] = 0.0;
+ if (mod.iorder == 4) vx[1*n1+iz] = -vx[3*n1+iz];
+ }
+ }
+
+
+ /* calculate p/tzz for all grid points except on the virtual boundary */
+
+ for (ibx=ioPx; ibx<nx+1; ibx+=bx) {
+ ixs = ibx;
+ ixe = MIN(nx+1,ixs+bx);
+ for (ibz=ioPz; ibz<nz+1; ibz+=bz) {
+ izs = ibz;
+ ize = MIN(nz+1,izs+bz);
+ for (ix=ixs; ix<ixe; ix++) {
+ for (iz=izs; iz<ize; 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]));
+ }
+ }
+ }
+ }
+
+ /* 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 */
+ store=0;
+ if (src.type==1 || src.type==6) {
+ ixs = ixsrc + ibnd;
+ izs = izsrc + ibnd;
+ if (ixs == ibnd) store=1;
+ if (ixs == nx+ibnd-1) store=1;
+ if (izs == ibnd) store=1;
+ if (izs == nz+ibnd-1) store=1;
+ if (store) {
+ if (src.type==1) tmps = p[ixs*n1+izs];
+ else tmps = vx[ixs*n1+izs];
+ }
+ }
+
+ if (bnd.free[0]) { /* free surface at top */
+ for (ix=ibnd; ix<=ibnd+nx-1; ix++) {
+ iz = bnd.surface[ix-ibnd];
+ p[ix*n1+iz] = 0.0;
+ }
+ }
+ if (bnd.free[1]) { /* free surface at right */
+ for (iz=ibnd; iz<=ibnd+nz-1; iz++) {
+ p[(ibnd+nx-1)*n1+iz] = 0.0;
+ }
+ }
+ if (bnd.free[2]) { /* free surface at bottom */
+ for (ix=ibnd; ix<=ibnd+nx-1; ix++) {
+ p[ix*n1+nz+ibnd-1] = 0.0;
+ }
+ }
+ if (bnd.free[3]) { /* free surface at left */
+ for (iz=ibnd; iz<=ibnd+nz-1; iz++) {
+ p[ibnd*n1+iz] = 0.0;
+ }
+ }
+
+ /* restore source positions on the edge */
+ if (store) {
+ if (src.type==1) p[ixs*n1+izs] = tmps;
+ else vx[ixs*n1+izs] = tmps;
+ }
+
+ return 0;
+}
diff --git a/fdelmodc3D/ToDo/acousticPML.c b/fdelmodc3D/ToDo/acousticPML.c
new file mode 100644
index 0000000000000000000000000000000000000000..40ca1171ed1c2f6aaeb67a5a1fcc48d177e834fd
--- /dev/null
+++ b/fdelmodc3D/ToDo/acousticPML.c
@@ -0,0 +1,225 @@
+#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 acousticPML(modPar mod, srcPar src, wavPar wav, bndPar bnd, int itime, int ixsrc, int izsrc, float *src_nwav, float *vx, float
+*vz, float *p, float *px, float *pz, 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 |
+
+***********************************************************************/
+
+ float c1, c2;
+ float tmps;
+ int ix, iz, ixs, izs, ibnd, store;
+ int nx, nz, n1, n2;
+ int ioXx, ioXz, ioZz, ioZx, ioPx, ioPz;
+ int m, im;
+ float att, aMax, e1, e2, e3, e4, alpha;
+
+
+ c1 = 9.0/8.0;
+ c2 = -1.0/24.0;
+ nx = mod.nx;
+ nz = mod.nz;
+ n2 = mod.nax;
+ n1 = mod.naz;
+
+/* for PML attenuation factor */
+ att = 0.1; /* must be a variable input parameter */
+ aMax = -1.0*log(att)/(mod.dx*sqrt(rho[]*l2m[]));
+ m = 8;
+
+ ibnd = mod.iorder/2-1;
+
+ 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*/
+ for (ix=ioXx; ix<nx+1; ix++) {
+ for (iz=ioXz; iz<nz+1; 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 */
+ for (ix=ioZx; ix<nx+1; ix++) {
+ for (iz=ioZz; iz<nz+1; 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);
+ }
+
+ /* rigid boundary condition clears velocities on boundaries */
+ if (bnd.rig[0]) { /* rigid surface at top */
+ for (ix=ibnd; ix<=ibnd+nx-1; ix++) {
+ vx[ix*n1+ibnd] = 0.0;
+ vz[ix*n1+ibnd] = -vz[ix*n1+ibnd+1];
+ if (mod.iorder == 4) vz[ix*n1+0] = -vz[ix*n1+3];
+ }
+ }
+ if (bnd.rig[1]) { /* rigid surface at right */
+ for (iz=ibnd; iz<=ibnd+nz-1; iz++) {
+ vx[(nx+ibnd)*n1+iz] = -vx[(nx+ibnd-1)*n1+iz];
+ vz[(nx+ibnd-1)*n1+iz] = 0.0;
+ if (mod.iorder == 4) vx[(nx+2)*n1+iz] = -vx[(nx-1)*n1+iz];
+ }
+ }
+ if (bnd.rig[2]) { /* rigid surface at bottom */
+ for (ix=ibnd; ix<=ibnd+nx-1; 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 (bnd.rig[3]) { /* rigid surface at left */
+ for (iz=ibnd; iz<=ibnd+nz-1; iz++) {
+ vx[ibnd*n1+iz] = -vx[(ibnd-1)*n1+iz];
+ vz[ibnd*n1+iz] = 0.0;
+ if (mod.iorder == 4) vx[1*n1+iz] = -vx[3*n1+iz];
+ }
+ }
+
+
+ /* calculate p/tzz for all grid points except on the virtual boundary */
+ for (ix=ioPx; ix<nx+1; ix++) {
+ for (iz=ioPz; iz<nz+1; iz++) {
+ px[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]) );
+ pz[ix*n1+iz] += l2m[ix*n1+iz]*(
+ c1*(vz[ix*n1+iz+1] - vz[ix*n1+iz]) +
+ c2*(vz[ix*n1+iz+2] - vz[ix*n1+iz-1]));
+ }
+ }
+
+ /* Add stress source */
+ if (src.type < 6) {
+ applySource(mod, src, wav, bnd, itime, ixsrc, izsrc, vx, vz, pz, 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 */
+ store=0;
+ if (src.type==1 || src.type==6) {
+ ixs = ixsrc + ibnd;
+ izs = izsrc + ibnd;
+ if (ixs == ibnd) store=1;
+ if (ixs == nx+ibnd-1) store=1;
+ if (izs == ibnd) store=1;
+ if (izs == nz+ibnd-1) store=1;
+ if (store) {
+ if (src.type==1) tmps = pz[ixs*n1+izs];
+ else tmps = vx[ixs*n1+izs];
+ }
+ }
+
+ if (bnd.free[0]) { /* free surface at top */
+ for (ix=ibnd; ix<=ibnd+nx-1; ix++) {
+ iz = bnd.surface[ix-ibnd];
+ px[ix*n1+iz] = 0.0;
+ pz[ix*n1+iz] = 0.0;
+ }
+ }
+ if (bnd.free[1]) { /* free surface at right */
+ for (iz=ibnd; iz<=ibnd+nz-1; iz++) {
+ px[(ibnd+nx-1)*n1+iz] = 0.0;
+ pz[(ibnd+nx-1)*n1+iz] = 0.0;
+ }
+ }
+ if (bnd.free[2]) { /* free surface at bottom */
+
+/******** use to test PML */
+ aMax = -1.0*log(att)/(mod.dx*sqrt(rho[ix*n1+iz]*l2m[ix*n1+iz]));
+ for (iz=nz+1-m, im=0; iz<nz+1; iz++, im++) {
+ alpha = aMax*((m-im)*(m-im))/(m*m);
+ for (ix=ibnd; ix<=ibnd+nx-1; ix++) {
+
+ e1 = exp(-1.0*alpha*mod.dx*l2m[ix*n1+iz]);
+ e2 = (1.0-e1)/(mod.dx*alpha);
+ px[ix*n1+nz+ibnd-1] = px[ix*n1+nz+ibnd-1]*e1-e2*
+ pz[ix*n1+nz+ibnd-1] = 0.0;
+ }
+/*
+ for (ix=ibnd; ix<=ibnd+nx-1; ix++) {
+ px[ix*n1+nz+ibnd-1] = 0.0;
+ pz[ix*n1+nz+ibnd-1] = 0.0;
+ }
+*/
+ }
+ if (bnd.free[3]) { /* free surface at left */
+ for (iz=ibnd; iz<=ibnd+nz-1; iz++) {
+ px[ibnd*n1+iz] = 0.0;
+ pz[ibnd*n1+iz] = 0.0;
+ }
+ }
+
+ /* restore source positions on the edge */
+ if (store) {
+ if (src.type==1) pz[ixs*n1+izs] = tmps;
+ else vx[ixs*n1+izs] = tmps;
+ }
+
+ for (ix=0; ix<mod.nax; ix++) {
+ for (iz=0; iz<mod.naz; iz++) {
+ p[ix*n1+iz] = pz[ix*n1+iz]+px[ix*n1+iz];
+ }
+ }
+
+ return 0;
+}
diff --git a/fdelmodc3D/acoustic2.c b/fdelmodc3D/acoustic2.c
new file mode 100644
index 0000000000000000000000000000000000000000..32fa4b250d592836e6533a449ad0f1c0dc429a31
--- /dev/null
+++ b/fdelmodc3D/acoustic2.c
@@ -0,0 +1,136 @@
+#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
new file mode 100644
index 0000000000000000000000000000000000000000..9e5d95fde9acc93779ce8b24c2d6e1266baeede8
--- /dev/null
+++ b/fdelmodc3D/acoustic4.c
@@ -0,0 +1,156 @@
+#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_qr.c b/fdelmodc3D/acoustic4_qr.c
new file mode 100644
index 0000000000000000000000000000000000000000..53da61c36fb96d3f6b1131939a2851d186e0111f
--- /dev/null
+++ b/fdelmodc3D/acoustic4_qr.c
@@ -0,0 +1,281 @@
+#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
new file mode 100644
index 0000000000000000000000000000000000000000..b1204fd44512faa816ef0eac7a6983df0158c6d7
--- /dev/null
+++ b/fdelmodc3D/acoustic6.c
@@ -0,0 +1,148 @@
+#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
new file mode 100644
index 0000000000000000000000000000000000000000..481de47568533c2f94e533f18aa1efd7b36a30c8
--- /dev/null
+++ b/fdelmodc3D/acousticSH4.c
@@ -0,0 +1,143 @@
+#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
new file mode 100644
index 0000000000000000000000000000000000000000..11513f467d89a26f22e7f69f81b1009fb21c17e0
--- /dev/null
+++ b/fdelmodc3D/acousticSH4_routine.c
@@ -0,0 +1,347 @@
+#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
new file mode 100644
index 0000000000000000000000000000000000000000..bf0d38e5ec0551265d07cfa81855b570f1a80020
--- /dev/null
+++ b/fdelmodc3D/applySource.c
@@ -0,0 +1,343 @@
+#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/atopkge.c b/fdelmodc3D/atopkge.c
new file mode 100644
index 0000000000000000000000000000000000000000..ef0b21803a52fb2ee021b6d73938d44bcefb0f92
--- /dev/null
+++ b/fdelmodc3D/atopkge.c
@@ -0,0 +1,444 @@
+/*
+
+ This file is property of the Colorado School of Mines.
+
+ Copyright (C) 2007, Colorado School of Mines,
+ All rights reserved.
+
+
+ Redistribution and use in source and binary forms, with or
+ without modification, are permitted provided that the following
+ conditions are met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above
+ copyright notice, this list of conditions and the following
+ disclaimer in the documentation and/or other materials provided
+ with the distribution.
+ * Neither the name of the Colorado School of Mines nor the names of
+ its contributors may be used to endorse or promote products
+ derived from this software without specific prior written permission.
+
+ Warranty Disclaimer:
+ THIS SOFTWARE IS PROVIDED BY THE COLORADO SCHOOL OF MINES AND CONTRIBUTORS
+ "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+ FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+ COLORADO SCHOOL OF MINES OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+ INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+ BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+ LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+ CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+ STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING
+ IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ POSSIBILITY OF SUCH DAMAGE.
+
+
+ Export Restriction Disclaimer:
+ We believe that CWP/SU: Seismic Un*x is a low technology product that does
+ not appear on the Department of Commerce CCL list of restricted exports.
+ Accordingly, we believe that our product meets the qualifications of
+ an ECCN (export control classification number) of EAR99 and we believe
+ it fits the qualifications of NRR (no restrictions required), and
+ is thus not subject to export restrictions of any variety.
+
+ Approved Reference Format:
+ In publications, please refer to SU as per the following example:
+ Cohen, J. K. and Stockwell, Jr. J. W., (200_), CWP/SU: Seismic Un*x
+ Release No. __: an open source software package for seismic
+ research and processing,
+ Center for Wave Phenomena, Colorado School of Mines.
+
+ Articles about SU in peer-reviewed journals:
+ Saeki, T., (1999), A guide to Seismic Un*x (SU)(2)---examples of data processing (part 1), data input and preparation of headers, Butsuri-Tansa (Geophysical Exploration), vol. 52, no. 5, 465-477.
+ Stockwell, Jr. J. W. (1999), The CWP/SU: Seismic Un*x Package, Computers and Geosciences, May 1999.
+ Stockwell, Jr. J. W. (1997), Free Software in Education: A case study of CWP/SU: Seismic Un*x, The Leading Edge, July 1997.
+ Templeton, M. E., Gough, C.A., (1998), Web Seismic Un*x: Making seismic reflection processing more accessible, Computers and Geosciences.
+
+ Acknowledgements:
+ SU stands for CWP/SU:Seismic Un*x, a processing line developed at Colorado
+ School of Mines, partially based on Stanford Exploration Project (SEP)
+ software.
+ */
+
+/*********************** self documentation **********************/
+/***************************************************************************
+ATOPKGE - convert ascii to arithmetic and with error checking
+
+
+eatoh ascii to short
+eatou ascii to unsigned short
+eatoi ascii to int
+eatop ascii to unsigned
+eatol ascii to long
+eatov ascii to unsigned long
+eatof ascii to float
+eatod ascii to double
+
+****************************************************************************
+Function Prototypes:
+short eatoh(char *s);
+unsigned short eatou(char *s);
+int eatoi(char *s);
+unsigned int eatop(char *s);
+long eatol(char *s);
+unsigned long eatov(char *s);
+float eatof(char *s);
+double eatod(char *s);
+
+****************************************************************************
+Input:
+s string
+
+Returned: type indicated
+
+****************************************************************************
+Notes:
+Each of these routines acts like atoi, but has error checking:
+
+This is a major revision of the tedious code required before
+vendors implemented the ANSI C strtol, strtoul and strtod.
+
+In addition to the size checks for each integer type, a
+specific test on errno is required. For example, INT_MAX
+may (and probably does) equal LONG_MAX. In this case,
+if fed a number exceeding INT_MAX (and LONG_MAX), strtol
+will make a quiet return with the wrong answer and it is up
+to the user to check if errno == ERANGE.
+
+Size limits are machine dependent and are read from the
+ANSI C include files limits.h and float.h.
+
+Bug Report: With NeXT c and Gnucc, when x > DBL_MAX (x <-DBL_MAX),
+the return value from strtod was +Infinity (-Infinity), not HUGE_VAL
+and more important, errno was not set to ERANGE. To cope with this,
+I put explicit size checks in eatod (which would not be needed if
+errno were set as it should be in ANSI C. jkc 01/29/94
+
+On IBM RS6000, the return value from strtod was +-Inf on
+overflow, but errno was set correctly.
+
+****************************************************************************
+References:
+For old code:
+Plum: Reliable Data Structures in C, p. 2-17.
+Kernighan and Ritchie: The C Programming Language, p. 58.
+
+CWP: Jack K. Cohen, Brian Sumner
+
+For new code:
+ANSI C routines with a little help from Jack
+
+****************************************************************************
+Author: Jack Cohen, Center for Wave Phenomena, 1994.
+***************************************************************************/
+/**************** end self doc ********************************/
+
+#include "par.h"
+#include <float.h>
+#include <limits.h>
+#include <stdarg.h>
+#include <errno.h>
+
+/* eatoh - convert string s to short integer {SHRT_MIN:SHRT_MAX} */
+short eatoh(char *s)
+{
+ long n = strtol(s, NULL, 10);
+
+ if ( (n > SHRT_MAX) || (n < SHRT_MIN) || (errno == ERANGE) )
+ err("%s: eatoh: overflow", __FILE__);
+
+ return (short) n;
+}
+
+
+/* eatou - convert string s to unsigned short integer {0:USHRT_MAX} */
+unsigned short eatou(char *s)
+{
+ unsigned long n = strtoul(s, NULL, 10);
+
+ if ( (n > USHRT_MAX) || (errno == ERANGE) )
+ err("%s: eatou: overflow", __FILE__);
+
+ return (unsigned short) n;
+}
+
+
+/* eatoi - convert string s to integer {INT_MIN:INT_MAX} */
+int eatoi(char *s)
+{
+ long n = strtol(s, NULL, 10);
+
+ if ( (n > INT_MAX) || (n < INT_MIN) || (errno == ERANGE) )
+ err("%s: eatoi: overflow", __FILE__);
+
+ return (int) n;
+}
+
+
+/* eatop - convert string s to unsigned integer {0:UINT_MAX} */
+unsigned int eatop(char *s)
+{
+ unsigned long n = strtoul(s, NULL, 10);
+
+ if ( (n > UINT_MAX) || (errno == ERANGE) )
+ err("%s: eatop: overflow", __FILE__);
+
+ return (unsigned int) n;
+}
+
+
+/* eatol - convert string s to long integer {LONG_MIN:LONG_MAX} */
+long eatol(char *s)
+{
+ long n = strtol(s, NULL, 10);
+
+ if (errno == ERANGE)
+ err("%s: eatol: overflow", __FILE__);
+
+ return n;
+}
+
+
+/* eatov - convert string s to unsigned long {0:ULONG_MAX} */
+unsigned long eatov(char *s)
+{
+ unsigned long n = strtoul(s, NULL, 10);
+
+ if (errno == ERANGE)
+ err("%s: eatov: overflow", __FILE__);
+
+ return n;
+}
+
+
+/* eatof - convert string s to float {-FLT_MAX:FLT_MAX} */
+float eatof(char *s)
+{
+ float x = strtod(s, NULL);
+
+ if ( (x > FLT_MAX) || (x < -FLT_MAX) || (errno == ERANGE) )
+ err("%s: eatof: overflow", __FILE__);
+
+ return (float) x;
+}
+
+
+/* eatod - convert string s to double {-DBL_MAX:DBL_MAX} */
+double eatod(char *s)
+{
+ double x = strtod(s, NULL);
+
+ /* errno == ERANGE suffices if compiler sets errno on overflow */
+ if ( (errno == ERANGE) || (x > DBL_MAX) || (x < -DBL_MAX) )
+ err("%s: eatod: overflow", __FILE__);
+
+ return x;
+}
+
+
+/**************************************************************************
+ERRPKGE - routines for reporting errors
+
+err print warning on application program error and die
+warn print warning on application program error
+syserr print warning on application program error using errno and die
+
+***************************************************************************
+Function Prototypes:
+void err (char *fmt, ...);
+void warn (char *fmt, ...);
+void syserr (char *fmt, ...);
+
+***************************************************************************
+Return: void
+
+***************************************************************************
+Notes:
+fmt a printf format string ("\n" not needed)
+... the variables referenced in the format string
+
+Examples:
+ err("Cannot divide %f by %f", x, y);
+ warn("fmax = %f exceeds half nyquist= %f", fmax, 0.25/dt);
+
+ if (NULL == (fp = fopen(xargv[1], "r")))
+ err("can't open %s", xargv[1]);
+ ...
+ if (-1 == close(fd))
+ err("close failed");
+
+***************************************************************************
+References:
+Kernighan and Pike, "The UNIX Programming Environment", page 207.
+Also Rochkind, "Advanced UNIX Programming", page 13.
+
+***************************************************************************
+Authors:SEP: Jeff Thorson, Stew Levin CWP: Shuki Ronen, Jack Cohen
+**************************************************************************/
+
+
+void err(char *fmt, ...)
+{
+ va_list args;
+
+
+ if (EOF == fflush(stdout)) {
+ fprintf(stderr, "\nerr: fflush failed on stdout");
+ }
+ fprintf(stderr, "\n%s: ", xargv[0]);
+ va_start(args,fmt);
+ vfprintf(stderr, fmt, args);
+ va_end(args);
+ fprintf(stderr, "\n");
+ exit(EXIT_FAILURE);
+}
+
+
+void warn(char *fmt, ...)
+{
+ va_list args;
+
+ if (EOF == fflush(stdout)) {
+ fprintf(stderr, "\nwarn: fflush failed on stdout");
+ }
+ fprintf(stderr, "\n%s: ", xargv[0]);
+ va_start(args,fmt);
+ vfprintf(stderr, fmt, args);
+ va_end(args);
+ fprintf(stderr, "\n");
+ return;
+}
+
+
+void syserr(char *fmt, ...)
+{
+ va_list args;
+
+ if (EOF == fflush(stdout)) {
+ fprintf(stderr, "\nsyserr: fflush failed on stdout");
+ }
+ fprintf(stderr, "\n%s: ", xargv[0]);
+ va_start(args,fmt);
+ vfprintf(stderr, fmt, args);
+ va_end(args);
+ fprintf(stderr, " (%s)\n", strerror(errno));
+ exit(EXIT_FAILURE);
+}
+
+#ifdef TEST
+main(int argc, char **argv)
+{
+ char s[BUFSIZ];
+ short nh;
+ unsigned short nu;
+ int ni;
+ unsigned int np;
+ long nl;
+ unsigned long nv;
+
+ initargs(argc, argv);
+
+
+ /* Test code for eatoh */
+ if (SHRT_MAX == LONG_MAX) {
+ warn("Warning: eatoh not used on this machine.\n");
+ } else {
+ warn("\n");
+ }
+ strcpy(s, "0");
+ nh = eatoh(s);
+ warn("eatoh(%s) = %hd\n", s, nh);
+
+ strcpy(s, "32767");
+ nh = eatoh(s);
+ warn("eatoh(%s) = %hd\n", s, nh);
+
+ strcpy(s, "-32768");
+ nh = eatoh(s);
+ warn("eatoh(%s) = %hd\n", s, nh);
+
+
+ /* Test code for eatou */
+ if (USHRT_MAX == ULONG_MAX) {
+ warn("Warning: eatou not used on this machine.\n");
+ } else {
+ warn("\n");
+ }
+ strcpy(s, "0");
+ nu = eatou(s);
+ warn("eatou(%s) = %hu\n", s, nu);
+
+ strcpy(s, "65535");
+ nu = eatou(s);
+ warn("eatou(%s) = %hu\n", s, nu);
+
+
+ /* Test code for eatoi */
+ if (INT_MAX == LONG_MAX) {
+ warn("Warning: eatoi not used on this machine.\n");
+ } else {
+ warn("\n");
+ }
+ strcpy(s, "0");
+ ni = eatoi(s);
+ warn("eatoi(%s) = %d\n", s, ni);
+
+ strcpy(s, "2147483647");
+ ni = eatoi(s);
+ warn("eatoi(%s) = %d\n", s, ni);
+
+
+ strcpy(s, "-2147483648");
+ ni = eatoi(s);
+ warn("eatoi(%s) = %d\n", s, ni);
+
+
+ /* Test code for eatop */
+ if (INT_MAX == LONG_MAX) {
+ warn("Warning: eatop not used on this machine.\n");
+ } else {
+ warn("\n");
+ }
+ strcpy(s, "0");
+ np = eatop(s);
+ warn("eatop(%s) = %lu\n", s, np);
+
+ strcpy(s, "4294967295");
+ np = eatop(s);
+ warn("eatop(%s) = %lu\n", s, np);
+
+
+ /* Test code for eatol */
+ warn("\n");
+ strcpy(s, "0");
+ nl = eatol(s);
+ warn("eatol(%s) = %ld\n", s, nl);
+
+ strcpy(s, "2147483647");
+ nl = eatol(s);
+ warn("eatol(%s) = %ld\n", s, nl);
+
+ strcpy(s, "-2147483648");
+ nl = eatol(s);
+ warn("eatol(%s) = %ld\n", s, nl);
+
+
+ /* Test code for eatov */
+ strcpy(s, "0");
+ nv = eatov(s);
+ warn("eatov(%s) = %lu\n", s, nv);
+
+ strcpy(s, "4294967295");
+ nv = eatov(s);
+ warn("eatov(%s) = %lu\n", s, nv);
+
+ warn("Now we feed in 4294967296, expecting fatal error exit\n");
+ strcpy(s, "4294967296");
+ nv = eatov(s);
+ warn("eatov(%s) = %lu\n", s, nv);
+
+ return EXIT_SUCCESS;
+}
+#endif
diff --git a/fdelmodc3D/boundaries.c b/fdelmodc3D/boundaries.c
new file mode 100644
index 0000000000000000000000000000000000000000..ffda5cfa0eacda0d59f35c396390ce7de54d5286
--- /dev/null
+++ b/fdelmodc3D/boundaries.c
@@ -0,0 +1,1682 @@
+#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/decomposition.c b/fdelmodc3D/decomposition.c
new file mode 100644
index 0000000000000000000000000000000000000000..130d52f61152cbf3999b48ac8124fd3e77a904c5
--- /dev/null
+++ b/fdelmodc3D/decomposition.c
@@ -0,0 +1,414 @@
+/*
+ * decomposition.c
+ *
+ * Kees Wapenaar "Reciprocity properties of one-way propagators"
+ * GEOPHYSICS, VOL. 63, NO. 4 (JULY-AUGUST 1998); P. 1795–1798
+ *
+ * Created by Jan Thorbecke on 17/03/2014.
+ *
+ */
+
+#include <assert.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <errno.h>
+#include <math.h>
+#include <string.h>
+#include "par.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))
+
+#ifndef COMPLEX
+typedef struct _complexStruct { /* complex number */
+ float r,i;
+} complex;
+typedef struct _dcomplexStruct { /* complex number */
+ double r,i;
+} dcomplex;
+#endif/* complex */
+
+void vmess(char *fmt, ...);
+complex firoot(float x, float stab);
+complex froot(float x);
+complex ciroot(complex x, float stab);
+complex cwp_csqrt(complex z);
+
+void decudP(float om, float rho, float cp, float dx, int nkx, float kangle, float alpha, float eps, complex *pu);
+void decudVz(float om, float rho, float cp, float dx, int nkx, float kangle, float alpha, float eps, complex *pu);
+
+int writesufile(char *filename, float *data, int n1, int n2, float f1, float f2, float d1, float d2);
+
+void kxwfilter(complex *data, float k, float dx, int nkx,
+ float alfa1, float alfa2, float perc);
+
+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)
+{
+ int iom, iomin, iomax, ikx, nfreq, a, av;
+ float omin, omax, deltom, om, df, dkx;
+ float alpha, eps, *angle, avrp, avrvz, maxrp, maxrvz;
+ float fangle, pangle, vangle, kangle;
+ complex *pu;
+ complex ax, az;
+
+ df = 1.0/((float)nt*dt);
+ dkx = 2.0*M_PI/(nkx*dx);
+ deltom = 2.*M_PI*df;
+ omin = 2.*M_PI*fmin;
+ omax = 2.*M_PI*fmax;
+ nfreq = nt/2+1;
+ eps = 0.01;
+ alpha = 0.1;
+
+ iomin = (int)MIN((omin/deltom), (nfreq-1));
+ iomin = MAX(iomin, 1);
+ iomax = MIN((int)(omax/deltom), (nfreq-1));
+
+ pu = (complex *)malloc(nkx*sizeof(complex));
+ angle = (float *)calloc(2*90,sizeof(float));
+
+ /* estimate maximum propagation angle in wavefields P and Vz */
+ for (a=1; a<90; a++) {
+ for (iom = iomin; iom <= iomax; iom++) {
+ om = iom*deltom;
+ ikx = MIN(NINT( ((om/cp)*sin(a*M_PI/180.0))/dkx ), nkx/2);
+ if (ikx < nkx/2 && ikx != 0) {
+ ax.r = rp[iom*nkx+ikx].r + rp[iom*nkx+nkx-1-ikx].r;
+ ax.i = rp[iom*nkx+ikx].i + rp[iom*nkx+nkx-1-ikx].i;
+ angle[a] += sqrt(ax.r*ax.r + ax.i*ax.i);
+ ax.r = rvz[iom*nkx+ikx].r + rvz[iom*nkx+nkx-1-ikx].r;
+ ax.i = rvz[iom*nkx+ikx].i + rvz[iom*nkx+nkx-1-ikx].i;
+ angle[90+a] += sqrt(ax.r*ax.r + ax.i*ax.i);
+ }
+ }
+ }
+
+ avrp =0.0;
+ avrvz =0.0;
+ maxrp =0.0;
+ maxrvz=0.0;
+ for (a=1; a<90; a++) {
+ avrp += angle[a];
+ maxrp = MAX(angle[a], maxrp);
+ avrvz += angle[90+a];
+ maxrvz = MAX(angle[90+a], maxrvz);
+ }
+ avrp = avrp/89.0;
+ avrvz = avrvz/89.0;
+ if (verbose>=4) {
+ writesufile("anglerp.su", angle, 90, 1, 0, 0, 1, 1);
+ writesufile("anglervz.su", &angle[90], 90, 1, 0, 0, 1, 1);
+ }
+ for (av=0; av<90; av++) {
+ if (angle[89-av] <= avrp) angle[89-av] = 0.0;
+ else {
+ pangle=1.0*(90-av);
+ break;
+ }
+ }
+ for (av=0; av<90; av++) {
+ if (angle[179-av] <= avrvz) angle[179-av] = 0.0;
+ else {
+ vangle=1.0*(90-av);
+ break;
+ }
+ }
+ if (verbose>=4) {
+ writesufile("anglerp0.su", angle, 90, 1, 0, 0, 1, 1);
+ writesufile("anglervz0.su", &angle[90], 90, 1, 0, 0, 1, 1);
+ }
+ fangle=pangle;
+ if (verbose>=2) vmess("Up-down going: P max=%e average=%e => angle at average %f", maxrp, avrp, pangle);
+ if (verbose>=2) vmess("Up-down going: Vz max=%e average=%e => angle at average %f", maxrvz, avrvz, vangle);
+ if (pangle >= 90 || pangle <= 1) { /* use angle in Vz data, P might be placed on free surface */
+ fangle = vangle;
+ }
+ if(!getparfloat("kangle",&kangle)) kangle=fangle;
+ if (verbose>=2) vmess("Up-down going: maximum angle in decomposition= %f", kangle);
+
+ if (vznorm) { /* Vz normalised decompostion */
+ for (iom = iomin; iom <= iomax; iom++) {
+ om = iom*deltom;
+
+ decudVz(om, rho, cp, dx, nkx, kangle, alpha, eps, pu);
+ /*
+ kxwfilter(dpux, kp, dx, nkx, alfa1, alfa2, perc);
+ kxwfilter(dpuz, kp, dx, nkx, alfa1, alfa2, perc);
+ */
+ for (ikx = 0; ikx < nkx; ikx++) {
+ ax.r = 0.5*rvz[iom*nkx+ikx].r;
+ ax.i = 0.5*rvz[iom*nkx+ikx].i;
+ az.r = 0.5*(rp[iom*nkx+ikx].r*pu[ikx].r - rp[iom*nkx+ikx].i*pu[ikx].i);
+ az.i = 0.5*(rp[iom*nkx+ikx].i*pu[ikx].r + rp[iom*nkx+ikx].r*pu[ikx].i);
+
+ down[iom*nkx+ikx].r = ax.r + az.r;
+ down[iom*nkx+ikx].i = ax.i + az.i;
+ up[iom*nkx+ikx].r = ax.r - az.r;
+ up[iom*nkx+ikx].i = ax.i - az.i;
+ }
+ }
+
+ }
+ else { /* P normalised decompostion */
+ for (iom = iomin; iom <= iomax; iom++) {
+ om = iom*deltom;
+
+ decudP(om, rho, cp, dx, nkx, kangle, alpha, eps, pu);
+
+ for (ikx = 0; ikx < nkx; ikx++) {
+ ax.r = 0.5*rp[iom*nkx+ikx].r;
+ ax.i = 0.5*rp[iom*nkx+ikx].i;
+ az.r = 0.5*(rvz[iom*nkx+ikx].r*pu[ikx].r - rvz[iom*nkx+ikx].i*pu[ikx].i);
+ az.i = 0.5*(rvz[iom*nkx+ikx].i*pu[ikx].r + rvz[iom*nkx+ikx].r*pu[ikx].i);
+
+ down[iom*nkx+ikx].r = ax.r + az.r;
+ down[iom*nkx+ikx].i = ax.i + az.i;
+ up[iom*nkx+ikx].r = ax.r - az.r;
+ up[iom*nkx+ikx].i = ax.i - az.i;
+ }
+ }
+ }
+
+ free(pu);
+ free(angle);
+
+ return;
+}
+
+/* Pressure normalised decompostion */
+
+void decudP(float om, float rho, float cp, float dx, int nkx, float kangle, float alpha, float eps, complex *pu)
+{
+ int ikx, ikxmax1, ikxmax2, filterpoints, filterppos;
+ float kp, kp2;
+ float kx, kx2, kzp2, dkx, stab;
+ float kxfmax, kxnyq, kpos, kfilt, perc, band, *filter;
+ complex kzp, ckp, ckp2;
+
+/* with complex frequency
+ wom.r=om;
+ wom.i=alpha;
+
+ ckp.r = wom.r/cp;
+ ckp.i = wom.i/cp;
+ ckp2.r = ckp.r*ckp.r-ckp.i*ckp.i;
+ ckp2.i = 2.0*ckp.r*ckp.i;
+ stab = eps*eps*(ckp.r*ckp.r+ckp.i*ckp.i);
+*/
+
+ kp = om/cp;
+ kp2 = kp*kp;
+ dkx = 2.0*M_PI/(nkx*dx);
+ stab = eps*eps*kp*kp;
+
+ /* make kw filter at maximum angle alfa */
+ perc = 0.15; /* percentage of band to use for smooth filter */
+ filter = (float *)malloc(nkx*sizeof(float));
+ kpos = kp*sin(M_PI*kangle/180.0);
+ kxnyq = M_PI/dx;
+ if (kpos > kxnyq) kpos = kxnyq;
+ band = kpos;
+ filterpoints = (int)abs((int)(perc*band/dkx));
+ kfilt = fabsf(dkx*filterpoints);
+ if (kpos+kfilt < kxnyq) {
+ kxfmax = kpos+kfilt;
+ filterppos = filterpoints;
+ }
+ else {
+ kxfmax = kxnyq;
+ filterppos = (int)(0.15*nkx/2);
+ }
+ ikxmax1 = (int) (kxfmax/dkx);
+ ikxmax2 = ikxmax1 - filterppos;
+ // fprintf(stderr,"ikxmax1=%d ikxmax2=%d nkp=%d nkx=%d\n", ikxmax1, ikxmax2, (int)(kp/dkx), nkx);
+
+ for (ikx = 0; ikx < ikxmax2; ikx++)
+ filter[ikx]=1.0;
+ for (ikx = ikxmax2; ikx < ikxmax1; ikx++)
+ filter[ikx] =(cos(M_PI*(ikx-ikxmax2)/(ikxmax1-ikxmax2))+1)/2.0;
+ for (ikx = ikxmax1; ikx <= nkx/2; ikx++)
+ filter[ikx] = 0.0;
+ /* end of kxfilter */
+
+ for (ikx = 0; ikx <= (nkx/2); ikx++) {
+ kx = ikx*dkx;
+ kx2 = kx*kx;
+ kzp2 = kp2 - kx2;
+ kzp = firoot(kzp2, stab);
+
+/* with complex frequency
+ kzp2.r = kp2.r - kx2;
+ kzp2.i = kp2.i;
+ kzp = ciroot(kzp2, stab);
+*/
+ if (kzp2 != 0) {
+ pu[ikx].r = filter[ikx]*om*rho*kzp.r;
+ pu[ikx].i = filter[ikx]*om*rho*kzp.i;
+// pu[ikx].r = om*rho*kzp.r;
+// pu[ikx].i = om*rho*kzp.i;
+ }
+ else {
+ pu[ikx].r = 0.0;
+ pu[ikx].i = 0.0;
+ }
+ }
+
+/* operators are symmetric in kx-w domain */
+ for (ikx = (nkx/2+1); ikx < nkx; ikx++) {
+ pu[ikx] = pu[nkx-ikx];
+ }
+
+ free(filter);
+
+ return;
+}
+
+/* Particle Velocity normalised decompostion */
+
+void decudVz(float om, float rho, float cp, float dx, int nkx, float kangle, float alpha, float eps, complex *pu)
+{
+ int ikx, ikxmax1, ikxmax2, filterpoints, filterppos;
+ float kp, kp2;
+ float kx, kx2, kzp2, dkx, stab;
+ float kxfmax, kxnyq, kpos, kfilt, perc, band, *filter;
+ complex kzp, ckp, ckp2;
+
+ kp = om/cp;
+ kp2 = kp*kp;
+ dkx = 2.0*M_PI/(nkx*dx);
+ stab = eps*eps*kp*kp;
+
+ /* make kw filter at maximum angle alfa */
+ perc = 0.15; /* percentage of band to use for smooth filter */
+ filter = (float *)malloc(nkx*sizeof(float));
+ kpos = kp*sin(M_PI*kangle/180.0);
+ kxnyq = M_PI/dx;
+ if (kpos > kxnyq) kpos = kxnyq;
+ band = kpos;
+ filterpoints = (int)abs((int)(perc*band/dkx));
+ kfilt = fabsf(dkx*filterpoints);
+ if (kpos+kfilt < kxnyq) {
+ kxfmax = kpos+kfilt;
+ filterppos = filterpoints;
+ }
+ else {
+ kxfmax = kxnyq;
+ filterppos = (int)(0.15*nkx/2);
+ }
+ ikxmax1 = (int) (kxfmax/dkx);
+ ikxmax2 = ikxmax1 - filterppos;
+
+ for (ikx = 0; ikx < ikxmax2; ikx++)
+ filter[ikx]=1.0;
+ for (ikx = ikxmax2; ikx < ikxmax1; ikx++)
+ filter[ikx] =(cos(M_PI*(ikx-ikxmax2)/(ikxmax1-ikxmax2))+1)/2.0;
+ for (ikx = ikxmax1; ikx <= nkx/2; ikx++)
+ filter[ikx] = 0.0;
+ /* end of kxfilter */
+
+ for (ikx = 0; ikx <= (nkx/2); ikx++) {
+ kx = ikx*dkx;
+ kx2 = kx*kx;
+ kzp2 = kp2 - kx2;
+ kzp = froot(kzp2);
+
+ pu[ikx].r = filter[ikx]*kzp.r/(om*rho);
+ pu[ikx].i = filter[ikx]*kzp.i/(om*rho);
+ }
+
+ /* operators are symmetric in kx-w domain */
+ for (ikx = (nkx/2+1); ikx < nkx; ikx++) {
+ pu[ikx] = pu[nkx-ikx];
+ }
+ free(filter);
+
+ return;
+}
+
+
+complex froot(float x)
+{
+ complex z;
+ if (x >= 0.0) {
+ z.r = sqrt(x);
+ z.i = 0.0;
+ return z;
+ }
+ else {
+ z.r = 0.0;
+ z.i = -sqrt(-x);
+ return z;
+ }
+}
+
+
+/* compute 1/x */
+complex firoot(float x, float stab)
+{
+ complex z;
+ if (x > 0.0) {
+ z.r = 1.0/sqrt(x+stab);
+ z.i = 0.0;
+ }
+ else if (x == 0.0) {
+ z.r = 0.0;
+ z.i = 0.0;
+ }
+ else {
+ z.r = 0.0;
+ z.i = 1.0/sqrt(-x+stab);
+ }
+ return z;
+}
+
+complex ciroot(complex x, float stab)
+{
+ complex z, kz, kzz;
+ float kd;
+
+ if (x.r == 0.0) {
+ z.r = 0.0;
+ z.i = 0.0;
+ }
+ else {
+ kzz = cwp_csqrt(x);
+ kz.r = kzz.r;
+ kz.i = -fabsf(kzz.i);
+ kd = kz.r*kz.r+kz.i*kz.i+stab;
+ z.r = kz.r/kd;
+ z.i = -kz.i/kd;
+ }
+ return z;
+}
+
+complex cwp_csqrt(complex z)
+{
+ complex c;
+ float x,y,w,r;
+ if (z.r==0.0 && z.i==0.0) {
+ c.r = c.i = 0.0;
+ return c;
+ } else {
+ x = fabsf(z.r);
+ y = fabsf(z.i);
+ if (x>=y) {
+ r = y/x;
+ w = sqrt(x)*sqrt(0.5*(1.0+sqrt(1.0+r*r)));
+ } else {
+ r = x/y;
+ w = sqrt(y)*sqrt(0.5*(r+sqrt(1.0+r*r)));
+ }
+ if (z.r>=0.0) {
+ c.r = w;
+ c.i = z.i/(2.0*w);
+ } else {
+ c.i = (z.i>=0.0) ? w : -w;
+ c.r = z.i/(2.0*c.i);
+ }
+ return c;
+ }
+}
+
diff --git a/fdelmodc3D/defineSource.c b/fdelmodc3D/defineSource.c
new file mode 100644
index 0000000000000000000000000000000000000000..bc9059c73b518980d35a4b3356796ddaa879b4c4
--- /dev/null
+++ b/fdelmodc3D/defineSource.c
@@ -0,0 +1,373 @@
+#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
new file mode 100644
index 0000000000000000000000000000000000000000..3f5d89ab290db022a87a2a151c170270b0898f77
--- /dev/null
+++ b/fdelmodc3D/defineSource3D.c
@@ -0,0 +1,348 @@
+#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 "fdelmodc3D.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 */
+
+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);
+float gaussGen();
+float normal(double x,double mu,double sigma);
+long 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);
+long randomWavelet(wavPar wav, srcPar src, float *trace, float tbeg, float tend, long 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) ((long)((x)>0.0?(x)+0.5:(x)-0.5))
+
+long defineSource3D(wavPar wav, srcPar src, modPar mod, recPar rec, float **src_nwav, long reverse, long verbose)
+{
+ FILE *fp;
+ size_t nread;
+ long optn, nfreq, i, j, k, iwmax, tracesToDo;
+ long 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 = loptncr(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=%li sampling after interpolation=%li", wav.ns, wav.nt);
+ optnscale = wav.nt;
+ nfreqscale = optnscale/2 + 1;
+ }
+ else {
+ optnscale = optn;
+ nfreqscale = optnscale/2 + 1;
+ }
+// fprintf(stderr,"define S optn=%li ns=%li %e nt=%li %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 %li", 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 = (long)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 = (long)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) writesufile3D("src_ampl.su", trace, namp, 1, -5*src.amplitude, 0.0, d1, 1);
+
+ free(trace);
+ }
+
+ if (verbose>3) writesufilesrcnwav3D("src_nwav.su", src_nwav, wav, wav.nt, wav.nx, 0.0, 0.0, wav.dt, 1);
+
+ return 0;
+}
+
+
+long randomWavelet3D(wavPar wav, srcPar src, float *trace, float tbeg, float tend, long verbose)
+{
+ long optn, nfreq, j, iwmax;
+ long 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 = loptncr(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-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-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;
+
+ 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;
+ }
+
+ 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)) );
+}
+
+long 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/demo/FD_elastic.scr b/fdelmodc3D/demo/FD_elastic.scr
new file mode 100755
index 0000000000000000000000000000000000000000..31ab0ca7be8a5d1af38266c71ce1573a056a8b4c
--- /dev/null
+++ b/fdelmodc3D/demo/FD_elastic.scr
@@ -0,0 +1,167 @@
+#!/bin/bash
+# Elastic decomposition
+
+fmax=60
+z0=0
+z1=300
+z1dzu=296
+z1dzd=304
+z2=700
+z3=1000
+cp0=1500
+cp1=2000
+cp2=2500
+cs0=0
+cs0=600
+cs1=700
+cs2=800
+ro0=1000
+ro1=1400
+ro2=1800
+
+
+# Source wavelet
+makewave dt=0.0004 nt=1024 w=fw fmin=0 flef=30 frig=30 fmax=$fmax t0=0.1 > wav.su
+#suxgraph < wav.su style=normal &
+
+# Subsurface model
+
+makemod file_base=model.su \
+ cp0=$cp0 ro0=$ro0 cs0=$cs0 sizex=2000 sizez=1000 \
+ dx=2 dz=2 orig=0,0 writeint=1 \
+ intt=def poly=0 cp=$cp1,$cp1 ro=$ro1,$ro1 cs=$cs1,$cs1 x=0,2000 z=$z1,$z1 \
+ intt=def poly=0 cp=$cp2,$cp2 ro=$ro2,$ro2 cs=$cs2,$cs2 x=0,2000 z=$z2,$z2 \
+ verbose=1
+
+#FD Acoustic modeling, recording at Ocean bottom
+
+../fdelmodc \
+ file_cp=model_cp.su file_den=model_ro.su file_cs=model_cs.su file_src=wav.su \
+ ischeme=1 fmax=$fmax tmod=2 \
+ file_rcv=el_obc.su rec_delay=0.1 \
+ xrcv1=0 xrcv2=2000 dxrcv=10 zrcv1=$z1dzu zrcv2=$z1dzu \
+ rec_type_ud=1 rec_type_vz=1 rec_type_vx=1 rec_type_tzz=1 rec_type_txz=1 \
+ rec_int_vx=2 rec_int_vz=2 dtrcv=0.004 \
+ xsrc=1000 zsrc=10 src_type=1 src_orient=2 nshot=1 \
+ ntaper=200 left=4 right=4 bottom=4 top=4 \
+ verbose=1
+
+#suximage < el_obc_rtzz.su wbox=400 hbox=500 perc=99.9 windowtitle=Tzz_OBC title="Total Tzz at OBC" &
+#suximage < el_obc_rvz.su wbox=400 hbox=500 perc=99.9 windowtitle=Vz_OBC title="Total Vz at OBC" &
+#suximage < el_obc_rvx.su wbox=400 hbox=500 perc=99.9 windowtitle=Vx_OBC title="Total Vx at OBC" &
+
+#cat el_obc_rvx.su el_obc_rvz.su | \
+#suwind key=offset min=-400 max=400 tmin=0.20 tmax=2 j=60 | \
+#suxwigb xcur=1 wbox=1000 hbox=500 grid1=dash \
+# title="Zoom of vx and vz with FD. Elastic Modeling" windowtitle=VX_VZ_FD &
+
+
+# Acoustic decomposition above the ocean bottom
+
+# 1- Downgoing wave field
+# A) Pressure component
+kxdecom file_in=el_obc_rp.su step=1 mode=0 col=1 row=1 cp=$cp0 ro=$ro0 cs=$cs0 nxmax=201 ntmax=501 nxfft=2048 ntfft=2048 alpha=-1 file_out=Pd.su verbose=1
+# B) Vertical velocity component
+kxdecom file_in=el_obc_rvz.su step=1 mode=0 col=2 row=1 cp=$cp0 ro=$ro0 cs=$cs0 nxmax=201 ntmax=501 nxfft=2048 ntfft=2048 alpha=-1 file_out=Vzd.su verbose=1
+# C) Adding P and Vz to get P_Down, P+= tmp1.su + tmp2.su
+addmul file_in1=Pd.su file_in2=Vzd.su file_out=el_pp_down_obc.su
+
+# 2- Upgoing wave field
+# A) Pressure component
+kxdecom file_in=el_obc_rp.su step=1 mode=0 col=1 row=2 cp=$cp0 ro=$ro0 cs=$cs0 nxmax=201 ntmax=501 nxfft=2048 ntfft=2048 alpha=-1 file_out=Pu.su verbose=1
+# B) Vertical velocity component
+kxdecom file_in=el_obc_rvz.su step=1 mode=0 col=2 row=2 cp=$cp0 ro=$ro0 cs=$cs0 nxmax=201 ntmax=501 nxfft=2048 ntfft=2048 alpha=-1 file_out=Vzu.su verbose=1
+# C) Subtracting Vz from P to get P_up, P-= tmp1.su - tmp2.su
+addmul < Pu.su file_in2=Vzu.su > el_pp_up_obc.su verbose=1
+
+#suximage < el_pp_down_obc.su wbox=400 hbox=500 perc=99.9 windowtitle=P_Down_OBC title="Downgoing P at OBC" &
+#suximage < el_pp_up_obc.su wbox=400 hbox=500 perc=99.9 windowtitle=P_Up_OBC title="Upugoing P at OBC" &
+#
+#sleep 4
+#echo " " 1>&2
+#echo " " 1>&2
+#echo "Hit return to continue" 1>&2
+#read cont
+
+exit;
+#-----------------------------------------------------------------------
+
+#FD Elastic modeling, recording just Ocean bottom
+
+fdelmodc \
+ file_cp=model_cp.su file_den=model_ro.su file_cs=model_cs.su file_src=wav.su \
+ ischeme=3 fmax=$fmax tmod=2 \
+ file_rcv=el_obc_d.su rec_delay=0.1 \
+ xrcv1=0 xrcv2=2000 dxrcv=10 zrcv1=$z1dzd zrcv2=$z1dzd rec_type_vz=1 rec_type_vx=1 rec_type_tzz=1 rec_type_txz=1 \
+ rec_int_vx=2 rec_int_vz=2 dtrcv=0.004 \
+ xsrc=1000 zsrc=10 src_type=1 src_orient=2 nshot=1 \
+ ntaper=200 left=4 right=4 bottom=4 top=4 \
+ verbose=1
+
+# Elastic decomposition below the ocean bottom
+#|P+| |Vx| | 0|
+#|S+| = N1+ |Vz| + N2+ |-P|
+
+
+# 1- Downgoing P- wave
+# A) Pressure component
+kxdecom file_in=el_obc_d_rtzz.su step=1 mode=2 col=2 row=1 cp=$cp1 ro=$ro1 cs=$cs1 fmax=$fmax nxmax=201 ntmax=501 nxfft=2048 ntfft=2048 alpha=-1 file_out=tmp1.su verbose=1
+# B) Horizontal velocity component
+kxdecom file_in=el_obc_d_rvx.su step=1 mode=1 col=1 row=1 cp=$cp1 ro=$ro1 cs=$cs1 fmax=$fmax nxmax=201 ntmax=501 nxfft=2048 ntfft=2048 alpha=-1 file_out=tmp2.su verbose=1
+# C) Vertical velocity component
+kxdecom file_in=el_obc_d_rvz.su step=1 mode=1 col=2 row=1 cp=$cp1 ro=$ro1 cs=$cs1 fmax=$fmax nxmax=201 ntmax=501 nxfft=2048 ntfft=2048 alpha=-1 file_out=tmp3.su verbose=1
+# D) Adding -P and Vx first, then adding Vz to get Phi_Down,
+addmul < tmp1.su a=-1 file_in2=tmp2.su | addmul file_in2=tmp3.su > P_Wave_Down_obc.su verbose=1
+
+# 2- Upgoing P- wave
+# A) Pressure component
+kxdecom file_in=el_obc_d_rtzz.su step=1 mode=-2 col=2 row=1 cp=$cp1 ro=$ro1 cs=$cs1 fmax=$fmax nxmax=201 ntmax=501 nxfft=2048 ntfft=2048 alpha=-1 file_out=tmp1.su verbose=1
+# B) Horizontal velocity component
+kxdecom file_in=el_obc_d_rvx.su step=1 mode=-1 col=1 row=1 cp=$cp1 ro=$ro1 cs=$cs1 fmax=$fmax nxmax=201 ntmax=501 nxfft=2048 ntfft=2048 alpha=-1 file_out=tmp2.su verbose=1
+# C) Vertical velocity component
+kxdecom file_in=el_obc_d_rvz.su step=1 mode=-1 col=2 row=1 cp=$cp1 ro=$ro1 cs=$cs1 fmax=$fmax nxmax=201 ntmax=501 nxfft=2048 ntfft=2048 alpha=-1 file_out=tmp3.su verbose=1
+# D) Adding -P and Vx first, then adding Vz to get Phi_Up,
+addmul < tmp1.su a=-1 file_in2=tmp2.su | addmul file_in2=tmp3.su > P_Wave_Up_obc.su verbose=1
+
+suximage < P_Wave_Down_obc.su wbox=400 hbox=500 perc=99.9 windowtitle=P_Wave_Down_obc title="Downgoing P-wave at OBC" &
+suximage < P_Wave_Up_obc.su wbox=400 hbox=500 perc=99.9 windowtitle=P_Wave_Up_obc title="Upugoing P-wave at OBC" &
+
+sleep 4
+echo " " 1>&2
+echo " " 1>&2
+echo "Hit return to continue" 1>&2
+read cont
+#-----------------------------------------------------------------------
+
+#|P+| |Vx| | 0|
+#|S+| = N1+ |Vz| + N2+ |-P|
+
+# 3- Downgoing S- wave
+# A) Pressure component
+kxdecom file_in=el_obc_d_rtzz.su step=1 mode=2 col=2 row=2 cp=$cp1 ro=$ro1 cs=$cs1 fmax=$fmax nxmax=201 ntmax=501 nxfft=2048 ntfft=2048 alpha=-1 file_out=tmp1.su verbose=1
+# B) Horizontal velocity component
+kxdecom file_in=el_obc_d_rvx.su step=1 mode=1 col=1 row=2 cp=$cp1 ro=$ro1 cs=$cs1 fmax=$fmax nxmax=201 ntmax=501 nxfft=2048 ntfft=2048 alpha=-1 file_out=tmp2.su verbose=1
+# C) Vertical velocity component
+kxdecom file_in=el_obc_d_rvz.su step=1 mode=1 col=2 row=2 cp=$cp1 ro=$ro1 cs=$cs1 fmax=$fmax nxmax=201 ntmax=501 nxfft=2048 ntfft=2048 alpha=-1 file_out=tmp3.su verbose=1
+# D) Adding -P and Vx first, then adding Vz to get Psi_Down,
+addmul < tmp1.su a=-1 file_in2=tmp2.su | addmul file_in2=tmp3.su > S_Wave_Down_obc.su verbose=1
+
+# 4- Upgoing S- wave
+# A) Pressure component
+kxdecom file_in=el_obc_d_rtzz.su step=1 mode=-2 col=2 row=2 cp=$cp1 ro=$ro1 cs=$cs1 fmax=$fmax nxmax=201 ntmax=501 nxfft=2048 ntfft=2048 alpha=-1 file_out=tmp1.su verbose=1
+# B) Horizontal velocity component
+kxdecom file_in=el_obc_d_rvx.su step=1 mode=-1 col=1 row=2 cp=$cp1 ro=$ro1 cs=$cs1 fmax=$fmax nxmax=201 ntmax=501 nxfft=2048 ntfft=2048 alpha=-1 file_out=tmp2.su verbose=1
+# C) Vertical velocity component
+kxdecom file_in=el_obc_d_rvz.su step=1 mode=-1 col=2 row=2 cp=$cp1 ro=$ro1 cs=$cs1 fmax=$fmax nxmax=201 ntmax=501 nxfft=2048 ntfft=2048 alpha=-1 file_out=tmp3.su verbose=1
+# D) Adding -P and Vx first, then adding Vz to get Psi_Up,
+addmul < tmp1.su a=-1 file_in2=tmp2.su | addmul file_in2=tmp3.su > S_Wave_Up_obc.su verbose=1
+
+suximage < S_Wave_Down_obc.su wbox=400 hbox=500 perc=99.9 windowtitle=S_Wave_Down_obc title="Downgoing S-wave at OBC" &
+suximage < S_Wave_Up_obc.su wbox=400 hbox=500 perc=99.9 windowtitle=S_Wave_Up_obc title="Upugoing S-wave at OBC" &
+
+sleep 5
+echo " " 1>&2
+echo " " 1>&2
+echo "Hit return to close the program" 1>&2
+read cont
+kill 0
diff --git a/fdelmodc3D/demo/README b/fdelmodc3D/demo/README
new file mode 100644
index 0000000000000000000000000000000000000000..99732f83a35190784cceab2ee3308be28e761269
--- /dev/null
+++ b/fdelmodc3D/demo/README
@@ -0,0 +1,32 @@
+
+The scripts in this directory reproduce most of the pictures used in the manual. The Figure numbers below refer to the Figures in the manual
+
+All scripts use some commands from Seismic Unix (SU) to plot results or post-process the data.
+
+==> Please make sure that SU is compiled without XDR (In $CWPROOT/Makefile.config make sure that XDRFLAG is NOT set). The SU output files of fdelmodc are base on local IEEE data.
+
+
+clean: removes all *.su *.bin *.txt *.eps in the current directory
+
+eps_for_manual.scr: the results of fdelmodc rand.scr in eps, used in Figure 6, 7, 8
+
+fdelmodcrand.scr: generation of random source signatures placed at random positions
+
+fdelmodc_srcrec.scr illustrates source and receiver positions, used in Figure 12
+
+fdelmodc_taper.scr: the effect of (absorbing) tapering of the edges, used in Figure 5
+
+fdelmodc_visco.scr wave propagation in visco-elastic medium, used in Figure 16
+
+fdelmodc_circ.scr receivers placed on a circle, used in Figure18
+
+fdelmodc sourcepos.scr: different source distributions, used in Figure 17
+
+fdelmodc_plane.scr: plane wave at depth to receivers at the surface, including snapshots, used in Figure 14
+
+fdelmodc_stab.scr illustrates dispersion and instability in snapshots, used in Figure 2
+
+fdelmodc_topography.scr: source and receivers on topography, used in Figure19
+
+model_flank.scr: builds a steep flank model, used in fdelmodc_srcrec.scr
+
diff --git a/fdelmodc3D/demo/RcvTextInput.scr b/fdelmodc3D/demo/RcvTextInput.scr
new file mode 100755
index 0000000000000000000000000000000000000000..84a66f27b6264a73d137205925e232944169a781
--- /dev/null
+++ b/fdelmodc3D/demo/RcvTextInput.scr
@@ -0,0 +1,16 @@
+#example from Max Holicki who implemented the rcv_txt= option
+
+dt=0.001;
+# Make Wavelet & Model Files
+makewave file_out=wavelet.su verbose=2 dt=${dt} nt=1024 fp=5 shift=1 w=g2;
+makemod file_base=model.su verbose=2 cp0=100 cs0=1 ro0=1 sizex=100 sizez=100 dx=1 dz=1 orig=0,0;
+# Test File Load 1
+printf "%s %s\n%s %s\n %s %s" 25 75 35 55 12 37.5 > RcvCoord1.txt;
+../fdelmodc file_cp=model_cp.su file_cs=model_cs.su file_den=model_ro.su \
+ ischeme=1 file_src=wavelet.su file_rcv=Data1.su \
+ rcv_txt=RcvCoord1.txt rec_int_p=0 dtrcv=${dt} tmod=2.0 \
+ rec_type_pp=1 rec_type_vx=1 rec_type_vz=1 \
+ xsrc=50 zsrc=50 nshot=1 src_type=1 \
+ ntaper=50 verbose=5
+
+
diff --git a/fdelmodc3D/demo/back_injrate_planes.scr b/fdelmodc3D/demo/back_injrate_planes.scr
new file mode 100755
index 0000000000000000000000000000000000000000..a6411e8a7e10d27828c657e5a6657c1234f70fbd
--- /dev/null
+++ b/fdelmodc3D/demo/back_injrate_planes.scr
@@ -0,0 +1,170 @@
+#!/bin/bash
+
+export PATH=:$HOME/src/OpenSource/bin:$HOME/bin64:$PATH:
+
+dx=0.5
+dt=0.0001
+fast=""
+
+dx=2.5
+dt=0.00050
+fast="fast"
+
+dx=1.25
+dt=0.00025
+
+makemod sizex=6000 sizez=1250 dx=$dx dz=$dx cp0=1500 ro0=1000 \
+ orig=-3000,0 file_base=tutodel${fast}.su verbose=2 \
+ intt=def x=-3000,-2000,-1000,0,1000,2000,3000 z=240,130,250,300,350,380,320 poly=2 cp=1950 ro=4500 grad=0 \
+ intt=def x=-3000,-2200,-1500,0,1300,2100,3000 z=620,640,590,600,740,700,600 poly=2 cp=2000 ro=1400 grad=0 \
+ intt=def x=-3000,-1800,0,2200,3000 z=920,1000,900,1000,1010 poly=2 cp=2300 ro=1600 grad=0
+
+# intt=def x=-3000,-1800,0,2200,3000 z=920,1000,900,1000,1010 poly=2 cp=1500 ro=1000 grad=0
+
+export OMP_NUM_THREADS=2
+makewave fp=30 dt=$dt file_out=wave${fast}.su nt=4096 t0=0.1 scale=1
+
+file_cp=tutodel${fast}_cp.su
+file_ro=tutodel${fast}_ro.su
+
+../fdelmodc \
+ file_cp=$file_cp ischeme=1 iorder=4 \
+ file_den=$file_ro \
+ file_src=wave${fast}.su \
+ file_rcv=inj_rate_plane.su \
+ src_type=1 \
+ src_injectionrate=1 \
+ rec_type_vz=1 \
+ rec_type_vx=1 \
+ rec_type_p=0 \
+ rec_int_vz=2 \
+ rec_int_vx=2 \
+ dtrcv=$dt \
+ rec_delay=0.1 \
+ verbose=4 \
+ tmod=4.4000 \
+ xrcv1=-3000,-3000,-3000,3000 xrcv2=3000,3000,-3000,3000 zrcv1=0,1200,0,0 zrcv2=0,1200,1200,1200 \
+ dxrcv=2.5,2.5,0,0 dzrcv=0,0,2.5,2.5 \
+ xsrc=0 zsrc=800 \
+ ntaper=35 \
+ left=2 right=2 top=2 bottom=2
+
+# xrcv1=-3000,-3000,-3000,3000 xrcv2=3000,3000,-3000,3000 zrcv1=0,1200,0,0 zrcv2=0,1200,1200,1200 \
+# dxrcv=2.5,2.5,0,0 dzrcv=0,0,2.5,2.5 \
+
+# 1500/2300
+scale=0.65217391304347826086
+suwind key=tracl min=1 max=2401 < inj_rate_plane_rp.su > inj_rate_plane0_rp.su
+suwind key=tracl min=2402 max=4802 < inj_rate_plane_rp.su | sugain scale=$scale >> inj_rate_plane0_rp.su
+
+scale=-1.0
+suwind key=tracl min=1 max=2401 < inj_rate_plane_rvz.su | sutaper tr1=100 tr2=100 ntr=2401 > inj_rate_plane0_rvz.su
+suwind key=tracl min=2402 max=4802 < inj_rate_plane_rvz.su | sutaper tr1=100 tr2=100 ntr=2401 | sugain scale=$scale >> inj_rate_plane0_rvz.su
+
+suwind key=tracl min=1 max=2401 < inj_rate_plane_rvz.su > inj_rate_planevz.su
+suwind key=tracl min=2402 max=4802 < inj_rate_plane_rvz.su | sugain scale=$scale >> inj_rate_planevz.su
+
+suwind < inj_rate_plane_rvx.su key=tracl min=4803 max=5283 | sugain scale=$scale > inj_rate_planevx.su
+suwind < inj_rate_plane_rvx.su key=tracl min=5284 max=5764 >> inj_rate_planevx.su
+
+#good results with scaled Vz src_type=1 src_injectionrate=0 and Vz snapshots
+# suxmovie < snapinj_rate_plane1vzrate0_sp.su loop=1 clip=30
+#good results with scaled Vz src_type=1 src_injectionrate=1 and Vz snapshots
+# suxmovie < snapinj_rate_plane1vzrate1_sp.su loop=1 clip=4000
+
+# at 3.2000 seconds the focus is at t=0
+
+file_snap=snapinj_rate_plane0_rvzrate1
+
+../fdelmodc \
+ file_cp=$file_cp ischeme=1 iorder=4 \
+ file_den=$file_ro \
+ file_src=inj_rate_planevz.su \
+ file_snap=snapinj_rate1_planevz.su \
+ grid_dir=1 \
+ src_type=1 \
+ src_injectionrate=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_p=0 \
+ dtrcv=$dt \
+ rec_delay=0.0 \
+ verbose=4 \
+ tmod=5.0000 \
+ tsnap1=3.000 tsnap2=5.00 dtsnap=0.05 \
+ xsnap1=-1000 xsnap2=1000 \
+ ntaper=35 \
+ left=2 right=2 top=2 bottom=2
+
+# tsnap1=4.200 tsnap2=4.50 dtsnap=0.004 \
+
+../fdelmodc \
+ file_cp=$file_cp ischeme=1 iorder=4 \
+ file_den=$file_ro \
+ file_src=inj_rate_planevx.su \
+ file_snap=snapinj_rate1_planevx.su \
+ grid_dir=1 \
+ src_type=1 \
+ src_injectionrate=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_p=0 \
+ dtrcv=$dt \
+ rec_delay=0.0 \
+ verbose=4 \
+ tmod=5.0000 \
+ tsnap1=3.000 tsnap2=5.00 dtsnap=0.05 \
+ xsnap1=-1000 xsnap2=1000 \
+ ntaper=35 \
+ left=2 right=2 top=2 bottom=2
+
+# tsnap1=4.200 tsnap2=4.50 dtsnap=0.004 \
+
+suop2 snapinj_rate1_planevz_sp.su snapinj_rate1_planevx_sp.su op=sum w1=1 w2=-1 > snapinj_rate1_planevzvxsum_sp.su
+
+exit;
+
+file_snap="snapinj_rate1_planevzvxsum"
+
+# tsnap1=3.200 tsnap2=3.50 dtsnap=0.004 \
+# tsnap1=3.290 tsnap2=3.31 dtsnap=0.0005 \
+
+suop2 tutodel${fast}_cp.su SrcRecPositions.su op=sum w1=1 w2=2000 | \
+ supsimage hbox=4 wbox=6 labelsize=10 \
+ x1beg=0 x1end=1250.0 legend=0 threecolor=1 \
+ d1s=1.0 d2s=1.0 \
+ wrgb=1.0,.5,0 grgb=0,.7,1.0 brgb=0,1.0,0 \
+ bps=24 bclip=2400 wclip=1500 \
+ n1tic=5 x2beg=-3000 f2num=-3000 d2num=1000 x2end=3000 > tutodelBackacq_cp.eps
+
+#sumax < inj_rate_plane0_rvz.su mode=abs outpar=nep
+#clip=`cat nep | awk '{print $1/3}'`
+#sugain epow=1.2 < inj_rate_plane0_rvz.su | \
+# supsimage hbox=4 wbox=8 labelsize=10 linewidth=0.0 \
+# n1tic=2 d2=2.5 f1=0.0 x1beg=0 x1end=3.004 \
+# f2=0 f2num=0 d2num=1000 clip=$clip > inj_rate_rvz.eps
+
+sumax < ${file_snap}_sp.su mode=abs outpar=nep
+clip=`cat nep | awk '{print $1/10}'`
+echo $clip
+
+for fldr in 27 32 22 17 12 7
+do
+suwind key=fldr min=$fldr max=$fldr < ${file_snap}_sp.su | \
+ supsimage hbox=4 wbox=6 labelsize=10 \
+ x1beg=0 x1end=1200.0 clip=$clip \
+ n1tic=5 x2beg=-1000 f2num=-1000 d2num=500 x2end=1000 > snapinj_rate_$fldr.eps
+done
+
+suwind key=fldr min=27 max=27 < ${file_snap}_sp.su | \
+ suwind key=gx min=0 max=0 | \
+ supsgraph hbox=6 wbox=2 labelsize=10 style=seismic \
+ x1beg=0 d1=2.5 f1=0 > snapinj_rate_27_trace0_t0.eps
+
+suwind key=fldr min=27 max=27 < ${file_snap}_sp.su | \
+ suwind key=gx itmin=321 itmax=321 | sustrip > trace.bin
+ suaddhead < trace.bin n1=801 dt=25 | supsgraph hbox=2 wbox=6 labelsize=10 \
+ f1=-1000 d1=$dx f1num=-1000 d1num=500 style=normal > snapinj_rate_27_z800_t0.eps
+
+
+
diff --git a/fdelmodc3D/demo/back_injrate_planes_1D.scr b/fdelmodc3D/demo/back_injrate_planes_1D.scr
new file mode 100755
index 0000000000000000000000000000000000000000..8b27f35afad257f42d221c15b51ab8075bf5c449
--- /dev/null
+++ b/fdelmodc3D/demo/back_injrate_planes_1D.scr
@@ -0,0 +1,129 @@
+#!/bin/bash
+
+export PATH=:$HOME/src/OpenSource/bin:$HOME/bin64:$PATH:
+
+dx=1.0
+dt=0.0002
+fast=""
+
+#dx=2.5
+#dt=0.00050
+#fast="fast"
+
+makemod sizex=6000 sizez=1250 dx=$dx dz=$dx cp0=1500 ro0=1000 \
+ orig=-3000,0 file_base=tutodel${fast}.su verbose=2 \
+ intt=def x=-3000,3000 z=240,240 cp=1950 ro=4500 grad=0 \
+ intt=def x=-3000,3000 z=620,620 cp=1500 ro=1000 grad=0
+
+makewave w=fw fmin=0 flef=5 frig=80 fmax=100 dt=$dt file_out=wavefwfast.su nt=4096 t0=0.4 scale=0 scfft=1
+
+export OMP_NUM_THREADS=8
+makewave fp=30 dt=$dt file_out=wave${fast}.su nt=4096 t0=0.1 scale=1
+
+file_cp=tutodel${fast}_cp.su
+file_ro=tutodel${fast}_ro.su
+
+fdelmodc \
+ file_cp=$file_cp ischeme=1 iorder=4 \
+ file_den=$file_ro \
+ file_src=wave${fast}.su \
+ file_rcv=inj_rate_plane.su \
+ src_type=1 \
+ src_injectionrate=1 \
+ rec_type_vz=1 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ rec_int_vx=2 \
+ dtrcv=$dt \
+ rec_delay=0.0 \
+ verbose=1 \
+ tmod=4.4000 \
+ xrcv1=-3000,-3000 xrcv2=3000,3000 zrcv1=0,1200 zrcv2=0,1200 \
+ dxrcv=2.5,2.5 dzrcv=0,0 \
+ xsrc=0 zsrc=800 \
+ ntaper=400 \
+ left=4 right=4 top=4 bottom=4
+
+# xrcv1=-3000,-3000,-3000,3000 xrcv2=3000,3000,-3000,3000 zrcv1=0,1200,0,0 zrcv2=0,1200,1200,1200 \
+# dxrcv=2.5,2.5,0,0 dzrcv=0,0,2.5,2.5 \
+
+scale=1
+scale=0.40760869
+suwind key=tracl min=1 max=2401 < inj_rate_plane_rp.su > inj_rate_plane0_rp.su
+suwind key=tracl min=2402 max=4802 < inj_rate_plane_rp.su | sugain scale=$scale >> inj_rate_plane0_rp.su
+
+scale=-1.0
+suwind key=tracl min=1 max=2401 < inj_rate_plane_rvz.su > inj_rate_planez0_rvz.su
+suwind key=tracl min=2402 max=4802 < inj_rate_plane_rvz.su | sugain scale=$scale >> inj_rate_planez0_rvz.su
+#suwind key=tracl min=2402 max=4802 < inj_rate_plane_rvz.su | sugain scale=$scale > inj_rate_planez1200_rvz.su
+
+#good results with scaled Vz src_type=1 src_injectionrate=0 and Vz snapshots
+# suxmovie < snapinj_rate_plane1vzrate0_sp.su loop=1 clip=30
+#good results with scaled Vz src_type=1 src_injectionrate=1 and Vz snapshots
+# suxmovie < snapinj_rate_plane1vzrate1_sp.su loop=1 clip=4000
+
+fdelmodc \
+ file_cp=$file_cp ischeme=1 iorder=4 \
+ file_den=$file_ro \
+ file_src=inj_rate_planez0_rvz.su \
+ file_rcv=back_inj_rate_planez0.su \
+ file_snap=snapinj_rate1_planevz0.su \
+ grid_dir=1 \
+ src_type=1 \
+ src_injectionrate=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_p=0 \
+ dtrcv=$dt \
+ rec_delay=0.0 \
+ verbose=1 \
+ tmod=5.0000 \
+ tsnap1=4.200 tsnap2=4.50 dtsnap=0.004 \
+ xsnap1=-1000 xsnap2=1000 \
+ ntaper=400 \
+ left=4 right=4 top=4 bottom=4
+
+exit
+
+fdelmodc \
+ file_cp=$file_cp ischeme=1 iorder=4 \
+ file_den=$file_ro \
+ file_src=inj_rate_planez1200_rvz.su \
+ file_rcv=back_inj_rate_planez1200.su \
+ file_snap=snapinj_rate_planevz1200.su \
+ grid_dir=1 \
+ src_type=1 \
+ src_injectionrate=0 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_p=0 \
+ dtrcv=$dt \
+ rec_delay=0.0 \
+ verbose=4 \
+ tmod=4.0000 \
+ tsnap1=3.200 tsnap2=3.50 dtsnap=0.004 \
+ ntaper=400 \
+ left=4 right=4 top=4 bottom=4
+
+
+suop2 snapinj_rate_planevz0_sp.su snapinj_rate_planevz1200_sp.su op=sum w1=1 w2=1 > snapinj_rate_planevzsum_sp.su
+
+exit
+sumax < inj_rate_plane0_rvz.su mode=abs outpar=nep
+clip=`cat nep | awk '{print $1/3}'`
+echo $clip
+
+sugain epow=1.2 < inj_rate_plane0_rvz.su | \
+ supsimage hbox=4 wbox=8 labelsize=10 linewidth=0.0 \
+ n1tic=2 d2=2.5 f1=0.0 x1beg=0 x1end=3.004 \
+ f2=0 f2num=0 d2num=1000 clip=$clip > inj_rate_rvz.eps
+
+for fldr in 27 32 22 17 12 7
+do
+suwind key=fldr min=$fldr max=$fldr < snapinj_rate_plane1vzrate0_sp.su | \
+ supsimage hbox=4 wbox=6 labelsize=10 \
+ x1beg=0 x1end=1200.0 clip=30 \
+ n1tic=5 x2beg=-3000 f2num=-3000 d2num=1000 x2end=3000 > snapinj_rate_$fldr.eps
+done
+
+
diff --git a/fdelmodc3D/demo/back_injrate_planes_1Dlong.scr b/fdelmodc3D/demo/back_injrate_planes_1Dlong.scr
new file mode 100755
index 0000000000000000000000000000000000000000..a0d7341c901e997bc1bd5115725d0ea05d6309b1
--- /dev/null
+++ b/fdelmodc3D/demo/back_injrate_planes_1Dlong.scr
@@ -0,0 +1,131 @@
+#!/bin/bash
+
+export PATH=:$HOME/src/OpenSource/bin:$HOME/bin64:$PATH:
+
+dx=0.5
+dt=0.0001
+fast=""
+
+dx=2.5
+dt=0.00050
+fast="fast"
+
+makemod sizex=12000 sizez=1250 dx=$dx dz=$dx cp0=1500 ro0=1000 \
+ orig=-6000,0 file_base=tutodelfast.su verbose=2 \
+ intt=def x=-6000,6000 z=240,240 cp=1950 ro=4500 grad=0 \
+ intt=def x=-6000,6000 z=620,620 cp=1500 ro=1000 grad=0
+
+makewave w=fw fmin=0 flef=5 frig=80 fmax=100 dt=$dt file_out=wavefwfast.su nt=4096 t0=0.4 scale=0 scfft=1
+
+export OMP_NUM_THREADS=2
+makewave fp=30 dt=$dt file_out=wave${fast}.su nt=4096 t0=0.1 scale=1
+
+file_cp=tutodel${fast}_cp.su
+file_ro=tutodel${fast}_ro.su
+
+fdelmodc \
+ file_cp=$file_cp ischeme=1 iorder=4 \
+ file_den=$file_ro \
+ file_src=wave${fast}.su \
+ file_rcv=inj_rate_plane.su \
+ src_type=1 \
+ src_injectionrate=1 \
+ rec_type_vz=1 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ rec_int_vx=2 \
+ dtrcv=$dt \
+ rec_delay=0.0 \
+ verbose=4 \
+ tmod=5.4000 \
+ xrcv1=-6000,-6000 xrcv2=6000,6000 zrcv1=0,1200 zrcv2=0,1200 \
+ dxrcv=2.5,2.5 dzrcv=0,0 \
+ xsrc=0 zsrc=800 \
+ ntaper=400 \
+ left=4 right=4 top=4 bottom=4
+
+# xrcv1=-3000,-3000,-3000,3000 xrcv2=3000,3000,-3000,3000 zrcv1=0,1200,0,0 zrcv2=0,1200,1200,1200 \
+# dxrcv=2.5,2.5,0,0 dzrcv=0,0,2.5,2.5 \
+
+scale=1
+scale=0.40760869
+suwind key=tracl min=1 max=4801 < inj_rate_plane_rp.su > inj_rate_plane0_rp.su
+suwind key=tracl min=4802 max=9602 < inj_rate_plane_rp.su | sugain scale=$scale >> inj_rate_plane0_rp.su
+
+scale=-1.0
+suwind key=tracl min=1 max=4801 < inj_rate_plane_rvz.su > inj_rate_planez0_rvz.su
+suwind key=tracl min=4802 max=9602 < inj_rate_plane_rvz.su | sugain scale=$scale >> inj_rate_planez0_rvz.su
+suwind key=tracl min=4802 max=9602 < inj_rate_plane_rvz.su | sugain scale=$scale > inj_rate_planez1200_rvz.su
+
+#good results with scaled Vz src_type=1 src_injectionrate=0 and Vz snapshots
+# suxmovie < snapinj_rate_plane1vzrate0_sp.su loop=1 clip=30
+#good results with scaled Vz src_type=1 src_injectionrate=1 and Vz snapshots
+# suxmovie < snapinj_rate_plane1vzrate1_sp.su loop=1 clip=4000
+
+fdelmodc \
+ file_cp=$file_cp ischeme=1 iorder=4 \
+ file_den=$file_ro \
+ file_src=inj_rate_planez0_rvz.su \
+ file_rcv=back_inj_rate_planez0.su \
+ file_snap=snapinj_rate1_planevz0.su \
+ grid_dir=1 \
+ src_type=1 \
+ src_injectionrate=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_p=0 \
+ fmax=120 \
+ dtrcv=$dt \
+ rec_delay=0.0 \
+ verbose=4 \
+ tmod=5.5000 \
+ tsnap1=5.200 tsnap2=5.50 dtsnap=0.004 \
+ xsnap1=-1000 xsnap2=1000 \
+ ntaper=400 \
+ left=4 right=4 top=4 bottom=4
+
+
+fdelmodc \
+ file_cp=$file_cp ischeme=1 iorder=4 \
+ file_den=$file_ro \
+ file_src=inj_rate_planez1200_rvz.su \
+ file_rcv=back_inj_rate_planez1200.su \
+ file_snap=snapinj_rate1_planevz1200.su \
+ grid_dir=1 \
+ src_type=1 \
+ src_injectionrate=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_p=0 \
+ dtrcv=$dt \
+ rec_delay=0.0 \
+ verbose=4 \
+ tmod=5.5000 \
+ tsnap1=5.200 tsnap2=5.50 dtsnap=0.004 \
+ xsnap1=-1000 xsnap2=1000 \
+ ntaper=400 \
+ left=4 right=4 top=4 bottom=4
+
+# tsnap1=3.200 tsnap2=3.50 dtsnap=0.004 \
+
+suop2 snapinj_rate1_planevz0_sp.su snapinj_rate1_planevz1200_sp.su op=sum w1=1 w2=1 > snapinj_rate_planevzsum_sp.su
+
+exit
+sumax < inj_rate_plane0_rvz.su mode=abs outpar=nep
+clip=`cat nep | awk '{print $1/3}'`
+echo $clip
+
+sugain epow=1.2 < inj_rate_plane0_rvz.su | \
+ supsimage hbox=4 wbox=8 labelsize=10 linewidth=0.0 \
+ n1tic=2 d2=2.5 f1=0.0 x1beg=0 x1end=3.004 \
+ f2=0 f2num=0 d2num=1000 clip=$clip > inj_rate_rvz.eps
+
+for fldr in 27 32 22 17 12 7
+do
+suwind key=fldr min=$fldr max=$fldr < snapinj_rate_plane1vzrate0_sp.su | \
+ supsimage hbox=4 wbox=6 labelsize=10 \
+ x1beg=0 x1end=1200.0 clip=30 \
+ n1tic=5 x2beg=-3000 f2num=-3000 d2num=1000 x2end=3000 > snapinj_rate_$fldr.eps
+done
+
+
diff --git a/fdelmodc3D/demo/benchmark.scr b/fdelmodc3D/demo/benchmark.scr
new file mode 100755
index 0000000000000000000000000000000000000000..e176dfc1c9be60206dfd174dba5fd4bce911246b
--- /dev/null
+++ b/fdelmodc3D/demo/benchmark.scr
@@ -0,0 +1,40 @@
+#!/bin/bash
+
+cp=2000
+rho=1000
+dx=2.5
+dt=0.0005
+
+makemod sizex=6000 sizez=4000 dx=$dx dz=$dx cp0=$cp cs0=$cs ro0=$rho \
+ orig=-3000,-1000 file_base=syncl.su \
+ intt=def x=-3000,0,3000 z=250,250,250 poly=0 cp=2300 ro=5000 \
+ intt=def x=-3000,-2000,-1000,-800,0,800,3000 z=650,650,700,750,900,750,600 poly=2 cp=2600 ro=1000 \
+ intt=def x=-3000,0,3000 z=1390,1390,1390 poly=0 cp=2000 ro=5000
+
+makewave fp=20 dt=$dt file_out=wave.su nt=4096 t0=0.1
+
+xsrc=-200
+
+set -x
+../fdelmodc \
+ file_cp=syncl_cp.su ischeme=1 \
+ file_den=syncl_ro.su \
+ file_src=wave.su \
+ file_rcv=shot_xsrc${xsrc}.su \
+ src_type=7 \
+ src_orient=1 \
+ src_injectionrate=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.004 \
+ rec_delay=0.1 \
+ verbose=2 \
+ tmod=4.10 \
+ dxrcv=10.0 \
+ xrcv1=-2250 xrcv2=2250 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=0 zsrc=1150 \
+ ntaper=200 \
+ left=2 right=2 top=1 bottom=2
+
diff --git a/fdelmodc3D/demo/boundaries.scr b/fdelmodc3D/demo/boundaries.scr
new file mode 100755
index 0000000000000000000000000000000000000000..e4786615df77dc372b82fc70180571c5584c9bcf
--- /dev/null
+++ b/fdelmodc3D/demo/boundaries.scr
@@ -0,0 +1,58 @@
+#!/bin/bash
+#PBS -N fdelmodc
+#PBS -k eo
+#PBS -j eo
+#
+# Models plane wave at depth to receivers at the surface, including snapshots
+ set -vx
+export PATH=../../utils:$PATH:
+
+makewave file_out=wavelet.su dt=0.001 nt=1024 fp=13 t0=0.1 w=g2 verbose=1
+
+makemod file_base=model.su \
+ cp0=1500 ro0=1000 cs0=600 sizex=1200 sizez=1200 \
+ dx=3 dz=3 orig=0,0
+
+export filecp=model_cp.su
+export filecs=model_cs.su
+export filero=model_ro.su
+
+export OMP_NUM_THREADS=1
+
+../fdelmodc \
+ file_cp=$filecp file_cs=$filecs file_den=$filero \
+ ischeme=3 \
+ src_type=1 src_orient=1 tmod=2.0 \
+ file_src=wavelet.su verbose=2 \
+ file_rcv=recS.su \
+ file_snap=snapS.su \
+ xrcv1=0 xrcv2=2100 dxrcv=15 \
+ zrcv1=400 zrcv2=400 \
+ rec_type_vx=1 rec_type_pp=1 rec_type_ss=1 rec_int_vx=1 \
+ dtrcv=0.004 \
+ xsrc=600 zsrc=600 \
+ tapfact=0.20 \
+ top=1 left=1 right=1 bottom=1 \
+ tsnap1=0.1 tsnap2=3.0 dtsnap=0.1 \
+ sna_type_ss=1 sna_type_p=1 sna_type_txz=1 sna_type_tzz=1
+
+exit;
+../fdelmodc \
+ file_cp=$filecp file_cs=$filecs file_den=$filero \
+ ischeme=3 \
+ file_src=wavelet.su verbose=4 \
+ file_rcv=recP.su \
+ file_snap=snapP.su \
+ xrcv1=0 xrcv2=2100 dxrcv=15 \
+ zrcv1=400 zrcv2=400 \
+ rec_type_vx=1 rec_type_pp=1 rec_type_ss=1 rec_int_vx=1 \
+ dtrcv=0.004 \
+ xsrc=1000 zsrc=1700 \
+ src_type=8 src_orient=1 tmod=2.0 \
+ top=4 left=4 right=4 bottom=4 \
+ tsnap1=0.1 tsnap2=3.0 dtsnap=0.1 \
+ sna_type_ss=1 sna_type_pp=1
+
+
+exit;
+
diff --git a/fdelmodc3D/demo/clean b/fdelmodc3D/demo/clean
new file mode 100755
index 0000000000000000000000000000000000000000..085f0557f80ea4ee096c73abfa9b42a078e823bb
--- /dev/null
+++ b/fdelmodc3D/demo/clean
@@ -0,0 +1,4 @@
+#!/bin/bash
+
+rm *.su *.bin *.txt *.eps nep
+
diff --git a/fdelmodc3D/demo/compare_green_dtxd_invariant.scr b/fdelmodc3D/demo/compare_green_dtxd_invariant.scr
new file mode 100755
index 0000000000000000000000000000000000000000..2433c401b5abb5195aa9c2b556e68816c440cfd8
--- /dev/null
+++ b/fdelmodc3D/demo/compare_green_dtxd_invariant.scr
@@ -0,0 +1,204 @@
+#!/bin/bash
+#PBS -l nodes=1:ppn=2
+#PBS -N InterfModeling
+#PBS -V
+#
+# source construction shown in Figure A2-A3-A4, 150 s.
+
+cp=2000
+rho=1000
+dx=2.5
+dt=0.0001
+halfdt=`perl -e "print 0.5*$dt;"`
+
+export PATH=../../bin:$PATH
+
+
+######### MONOPOLE ACOUSTIC #######
+
+for dx in 2.5 5
+do
+for dt in 0.0001 0.0005
+do
+makemod sizex=2000 sizez=2000 dx=$dx dz=$dx cp0=$cp ro0=$rho orig=-1000,0 file_base=simple.su
+makewave fp=15 dt=$dt file_out=wave.su nt=4096 t0=0.1
+../fdelmodc \
+ file_cp=simple_cp.su ischeme=1 \
+ file_den=simple_ro.su \
+ file_src=wave.su \
+ file_rcv=shot_fd.su \
+ src_type=1 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.005 \
+ src_injectionrate=1 \
+ verbose=2 \
+ tmod=0.5115 \
+ dxrcv=5.0 \
+ xrcv1=-500 xrcv2=500 \
+ zrcv1=500 zrcv2=500 \
+ xsrc=0 zsrc=1000 \
+ ntaper=80 \
+ left=4 right=4 bottom=4 top=4
+suwind key=tracl min=101 max=101 < shot_fd_rp.su > trace3_fd${dx}_${dt}.su
+done
+done
+
+
+(suwind key=tracl min=101 max=101 < shot_fd_rp.su | basop choice=shift shift=$halfdt; suwind key=tracl min=101 max=101 < shot_green_rp.su ) | basop choice=shift shift=-0.1 | suxgraph
+
+
+# rvz
+
+(suwind key=tracl min=101 max=101 < shot_fd_rvz.su ; suwind key=tracl min=101 max=101 < shot_green_rvz.su ) | basop choice=shift shift=-0.1 | supsgraph style=normal labelsize=10 wbox=4 hbox=2 label1='time in seconds' label2="Amplitude" linewidth=0.1 d2num=2e-8 f2num=-4e-8 x2end=4e-8 x2beg=-2.7e-8 > mon_rvz.eps
+
+(suwind key=tracl min=101 max=101 < shot_fd_rvz.su ; suwind key=tracl min=101 max=101 < shot_green_rvz.su ) | basop choice=shift shift=-0.1 | supsgraph style=normal labelsize=10 wbox=2 hbox=2 label1='time in seconds' label2="Amplitude" linewidth=0.1 linecolor=red,green d2num=2e-10 f2num=3.86e-8 x2end=3.96e-8 x2beg=3.86e-8 x1beg=0.255 x1end=0.258 > mon_zoom_rvz.eps
+
+suwind key=tracl min=101 max=101 < shot_fd_rvz.su > trace_fd.su
+suwind key=tracl min=101 max=101 < shot_green_rvz.su > trace_green.su
+
+sumax < trace_green.su outpar=nep
+Mmax=`cat nep | awk '{print $1}'`
+a=`perl -e "print 100.0/$Mmax;"`
+echo $a
+
+sudiff trace_green.su trace_fd.su | basop choice=shift shift=-0.1 | sugain scale=$a | suop op=abs | supsgraph style=normal labelsize=12 wbox=4 hbox=2 label1='time in seconds' label2="Relative error in percentage of peak" linewidth=0.1 linecolor=red x2beg=0.0 x2end=1.0 f2num=0.0 d2num=0.5 > mon_diff_dx${dx}_rvz.eps
+
+(suwind key=tracl min=101 max=101 < shot_fd_rvz.su ; suwind key=tracl min=101 max=101 < shot_green_rvz.su) | basop choice=shift shift=-0.1 | suxgraph
+
+
+######### DIPOLE ACOUSTIC #######
+
+makewave fp=15 dt=$dt file_out=wave.su nt=4096 t0=0.1
+
+../fdelmodc \
+ file_cp=simple_cp.su ischeme=1 \
+ file_den=simple_ro.su \
+ file_src=wave.su \
+ file_rcv=shot_fd_dip.su \
+ src_type=1 \
+ src_orient=2 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.0005 \
+ verbose=2 \
+ tmod=0.5115 \
+ dxrcv=5.0 \
+ xrcv1=-500 xrcv2=500 \
+ zrcv1=500 zrcv2=500 \
+ xsrc=0 zsrc=1000 \
+ ntaper=80 \
+ left=4 right=4 bottom=4 top=4
+
+makewave fp=15 dt=0.0005 file_out=wave.su nt=4096 t0=0.1
+
+green c=$cp rho=$rho file_src=wave.su zsrc1=500 xrcv=-500,500 dxrcv=5 nt=4096 dip=1 verbose=1 | suwind nt=1024 > shot_green_dip_rp.su
+green c=$cp rho=$rho file_src=wave.su zsrc1=500 xrcv=-500,500 dxrcv=5 nt=4096 p_vz=1 dip=1 verbose=1 | suwind nt=1024 > shot_green_dip_rvz.su
+
+shift=`perl -e "print 0.5*$dx/$cp;"`
+
+# rp
+(suwind key=tracl min=101 max=101 < shot_fd_dip_rp.su | basop choice=shift shift=-$shift; suwind key=tracl min=101 max=101 < shot_green_dip_rp.su ) | basop choice=shift shift=-0.1 | supsgraph style=normal titlesize=-1 labelsize=10 wbox=4 hbox=2 label1='time in seconds' label2="Amplitude" linewidth=0.1 linecolor=red,green d2num=0.5 xend=2.0 f2num=-1.5> dip_rp.eps
+
+(suwind key=tracl min=101 max=101 < shot_fd_dip_rp.su | basop choice=shift shift=-$shift; suwind key=tracl min=101 max=101 < shot_green_dip_rp.su ) | basop choice=shift shift=-0.1 | supsgraph style=normal labelsize=10 wbox=2 hbox=2 label1='time in seconds' label2="Amplitude" linewidth=0.1 linecolor=red,green x2beg=1.8 x1beg=0.2430 x1end=0.24601 f1num=0.243 d1num=0.002 > dip_zoom_rp.eps
+
+suwind key=tracl min=101 max=101 < shot_fd_dip_rp.su | basop choice=shift shift=-$shift > trace_fd.su
+suwind key=tracl min=101 max=101 < shot_green_dip_rp.su > trace_green.su
+
+sumax < trace_green.su outpar=nep
+Mmax=`cat nep | awk '{print $1}'`
+a=`perl -e "print 100.0/$Mmax;"`
+echo $a
+
+sudiff trace_green.su trace_fd.su | basop choice=shift shift=-0.1 | sugain scale=$a | suop op=abs | supsgraph style=normal labelsize=12 wbox=4 hbox=2 label1='time in seconds' label2="Relative error in percentage of peak" linewidth=0.1 linecolor=red x2beg=0.0 x2end=1.0 f2num=0.0 d2num=0.5 > dip_diff_dx${dx}_rp.eps
+
+(suwind key=tracl min=101 max=101 < shot_fd_dip_rp.su | basop choice=shift shift=-$shift ; suwind key=tracl min=101 max=101 < shot_green_dip_rp.su ) | basop choice=shift shift=-0.1 | suxgraph
+
+
+# rvz
+
+(suwind key=tracl min=101 max=101 < shot_fd_dip_rvz.su | basop choice=shift shift=-$shift; suwind key=tracl min=101 max=101 < shot_green_dip_rvz.su ) | basop choice=shift shift=-0.1 | supsgraph style=normal labelsize=10 wbox=4 hbox=2 label1='time in seconds' label2="Amplitude" linewidth=0.1 linecolor=red,green d2num=6e-10 f2num=-1.2e-9 x2end=2e-9 x2beg=-1.3e-9 > dip_rvz.eps
+
+(suwind key=tracl min=101 max=101 < shot_fd_dip_rvz.su | basop choice=shift shift=-$shift; suwind key=tracl min=101 max=101 < shot_green_dip_rvz.su ) | basop choice=shift shift=-0.1 | supsgraph style=normal labelsize=10 wbox=2 hbox=2 label1='time in seconds' label2="Amplitude" linewidth=0.1 linecolor=red,green d2num=2e-11 f2num=1.85e-9 x2end=1.944e-9 x2beg=1.85e-9 x1beg=0.2430 x1end=0.24601 f1num=0.243 d1num=0.002 > dip_zoom_rvz.eps
+
+suwind key=tracl min=101 max=101 < shot_fd_dip_rvz.su | basop choice=shift shift=-$shift > trace_fd.su
+suwind key=tracl min=101 max=101 < shot_green_dip_rvz.su > trace_green.su
+
+sumax < trace_green.su outpar=nep
+Mmax=`cat nep | awk '{print $1}'`
+a=`perl -e "print 100.0/$Mmax;"`
+echo $a
+
+sudiff trace_green.su trace_fd.su | basop choice=shift shift=-0.1 | sugain scale=$a | suop op=abs | supsgraph style=normal labelsize=12 wbox=4 hbox=2 label1='time in seconds' label2="Relative error in percentage of peak" linewidth=0.1 linecolor=red x2beg=0.0 x2end=1.0 f2num=0.0 d2num=0.5 > dip_diff_dx${dx}_rvz.eps
+
+(suwind key=tracl min=101 max=101 < shot_fd_dip_rvz.su | basop choice=shift shift=-$shift; suwind key=tracl min=101 max=101 < shot_green_dip_rvz.su ) | basop choice=shift shift=-0.1 | suxgraph
+
+######### ELASTIC #######
+
+cp=2000
+cs=1400
+rho=1000
+dx=5
+dt=0.0005
+
+makemod sizex=2000 sizez=2000 dx=$dx dz=$dx cp0=$cp cs0=$cs ro0=$rho orig=-1000,0 file_base=simple.su
+
+makewave fp=15 dt=$dt file_out=wave.su nt=4096 t0=0.1
+
+
+../fdelmodc \
+ file_cp=simple_cp.su ischeme=3 \
+ file_cs=simple_cs.su \
+ file_den=simple_ro.su \
+ file_src=wave.su \
+ file_rcv=shot_fd.su \
+ src_type=6 \
+ rec_type_vz=1 \
+ rec_int_vz=2 \
+ dtrcv=0.0005 \
+ verbose=2 \
+ tmod=0.5115 \
+ dxrcv=5.0 \
+ xrcv1=-500 xrcv2=500 \
+ zrcv1=500 zrcv2=500 \
+ xsrc=0 zsrc=1000 \
+ ntaper=80 \
+ left=4 right=4 bottom=4 top=4
+
+makewave fp=15 dt=0.0005 file_out=waveg.su nt=4096 t0=0.1
+
+green c=$cp cs=$cs rho=$rho file_src=waveg.su zsrc1=500 xrcv=-500,500 dxrcv=5 nt=4096 Fx=1 | suwind nt=1024 > shot_green_FxRz.su
+
+ (suwind key=tracl min=51 max=51 < shot_fd_rvz.su ; suwind key=tracl min=51 max=51 < shot_green_FxRz.su) | basop choice=shift shift=-0.1 | suxgraph
+
+
+../fdelmodc \
+ file_cp=simple_cp.su ischeme=3 \
+ file_cs=simple_cs.su \
+ file_den=simple_ro.su \
+ file_src=wave.su \
+ file_rcv=shot_fd_fz.su \
+ src_type=7 \
+ rec_type_vz=1 \
+ rec_int_vz=0 \
+ dtrcv=0.0005 \
+ verbose=2 \
+ tmod=0.5115 \
+ dxrcv=5.0 \
+ xrcv1=-500 xrcv2=500 \
+ zrcv1=500 zrcv2=500 \
+ xsrc=0 zsrc=1000 \
+ ntaper=80 \
+ left=4 right=4 bottom=4 top=4
+
+green c=$cp cs=$cs rho=$rho file_src=waveg.su zsrc1=500 xrcv=-500,500 dxrcv=5 nt=4096 Fz=1 | suwind nt=1024 > shot_green_FzRz.su
+
+ (suwind key=tracl min=101 max=101 < shot_fd_fz_rvz.su ; suwind key=tracl min=101 max=101 < shot_green_FzRz.su) | basop choice=shift shift=-0.1 | suxgraph
+
+
+
+######### DIPOLE ELASTIC #######
+
+
+######### SURFACE WAVES #######
+
diff --git a/fdelmodc3D/demo/compare_green_inmanual.scr b/fdelmodc3D/demo/compare_green_inmanual.scr
new file mode 100755
index 0000000000000000000000000000000000000000..aeb0d2dc0a80d5c4f9f7ac75ed37a951e3ece16c
--- /dev/null
+++ b/fdelmodc3D/demo/compare_green_inmanual.scr
@@ -0,0 +1,216 @@
+#!/bin/bash
+#PBS -l nodes=1:ppn=2
+#PBS -N InterfModeling
+#PBS -V
+#
+# source construction shown in Figure A2-A3-A4, 150 s.
+
+cp=2000
+rho=1000
+dx=2.5
+dt=0.0001
+
+export PATH=../../bin:$PATH
+
+export OMP_NUM_THREADS=4
+
+makemod sizex=2000 sizez=2000 dx=$dx dz=$dx cp0=$cp ro0=$rho orig=-1000,0 file_base=simple.su
+makewave fp=15 dt=$dt file_out=wave.su nt=4096 t0=0.1
+
+######### MONOPOLE ACOUSTIC #######
+
+../fdelmodc \
+ file_cp=simple_cp.su ischeme=1 \
+ file_den=simple_ro.su \
+ file_src=wave.su \
+ file_rcv=shot_fd.su \
+ src_type=1 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.0005 \
+ verbose=2 \
+ tmod=0.5115 \
+ dxrcv=5.0 \
+ xrcv1=-500 xrcv2=500 \
+ zrcv1=500 zrcv2=500 \
+ xsrc=0 zsrc=1000 \
+ ntaper=80 \
+ left=4 right=4 bottom=4 top=4
+
+makewave fp=15 dt=0.0005 file_out=wave.su nt=4096 t0=0.1
+
+green c=$cp rho=$rho file_src=wave.su zsrc1=500 xrcv=-500,500 dxrcv=5 nt=4096 dip=0 verbose=1 | suwind nt=1024 > shot_green_rp.su
+green c=$cp rho=$rho file_src=wave.su zsrc1=500 xrcv=-500,500 dxrcv=5 nt=4096 dip=0 p_vz=1 verbose=1 | suwind nt=1024 > shot_green_rvz.su
+
+# rp
+(suwind key=tracl min=101 max=101 < shot_fd_rp.su ; suwind key=tracl min=101 max=101 < shot_green_rp.su ) | basop choice=shift shift=-0.1 | supsgraph style=normal labelsize=10 wbox=4 hbox=2 label1='time in seconds' label2="Amplitude" linewidth=0.1 linecolor=red,green d2num=10 x2end=40 f2num=-40 > mon_rp.eps
+
+(suwind key=tracl min=101 max=101 < shot_fd_rp.su ; suwind key=tracl min=101 max=101 < shot_green_rp.su;) | basop choice=shift shift=-0.1 | supsgraph style=normal labelsize=10 wbox=2 hbox=2 label1='time in seconds' label2="Amplitude" linewidth=0.1 linecolor=red,green x1beg=0.255 x1end=0.258 x2beg=39.5 > mon_zoom_rp.eps
+
+suwind key=tracl min=101 max=101 < shot_fd_rp.su > trace_fd.su
+suwind key=tracl min=101 max=101 < shot_green_rp.su > trace_green.su
+
+sumax < trace_green.su outpar=nep
+Mmax=`cat nep | awk '{print $1}'`
+a=`perl -e "print 100.0/$Mmax;"`
+echo $a
+
+sudiff trace_green.su trace_fd.su | basop choice=shift shift=-0.1 | sugain scale=$a | suop op=abs | supsgraph style=normal labelsize=12 wbox=4 hbox=2 label1='time in seconds' label2="Relative error in percentage of peak" linewidth=0.1 linecolor=red x2beg=0.0 x2end=1.0 f2num=0.0 d2num=0.5 > mon_diff_dx${dx}_rp.eps
+
+(suwind key=tracl min=101 max=101 < shot_fd_rp.su; suwind key=tracl min=101 max=101 < shot_green_rp.su ) | basop choice=shift shift=-0.1 | suxgraph
+
+# rvz
+
+(suwind key=tracl min=101 max=101 < shot_fd_rvz.su ; suwind key=tracl min=101 max=101 < shot_green_rvz.su ) | basop choice=shift shift=-0.1 | supsgraph style=normal labelsize=10 wbox=4 hbox=2 label1='time in seconds' label2="Amplitude" linewidth=0.1 linecolor=red,green d2num=1e-5 f2num=-2e-5 x2end=1.5e-5 x2beg=-2e-5 > mon_rvz.eps
+
+(suwind key=tracl min=101 max=101 < shot_fd_rvz.su ; suwind key=tracl min=101 max=101 < shot_green_rvz.su ) | basop choice=shift shift=-0.1 | sugain scale=-1 | supsgraph style=normal labelsize=10 wbox=2 hbox=2 label1='time in seconds' label2="Amplitude" linewidth=0.1 linecolor=red,green d2num=5e-8 f2num=1.96e-5 x2end=1.98e-5 x2beg=1.96e-5 f1=0 x1beg=0.255 x1end=0.258 > mon_zoom_rvz.eps
+
+suwind key=tracl min=101 max=101 < shot_fd_rvz.su > trace_fd.su
+suwind key=tracl min=101 max=101 < shot_green_rvz.su > trace_green.su
+
+sumax < trace_green.su outpar=nep
+Mmax=`cat nep | awk '{print $1}'`
+a=`perl -e "print 100.0/$Mmax;"`
+echo $a
+
+sudiff trace_green.su trace_fd.su | basop choice=shift shift=-0.1 | sugain scale=$a | suop op=abs | supsgraph style=normal labelsize=12 wbox=4 hbox=2 label1='time in seconds' label2="Relative error in percentage of peak" linewidth=0.1 linecolor=red x2beg=0.0 x2end=1.0 f2num=0.0 d2num=0.5 > mon_diff_dx${dx}_rvz.eps
+
+(suwind key=tracl min=101 max=101 < shot_fd_rvz.su ; suwind key=tracl min=101 max=101 < shot_green_rvz.su) | basop choice=shift shift=-0.1 | suxgraph
+
+
+######### DIPOLE ACOUSTIC #######
+
+makewave fp=15 dt=$dt file_out=wave.su nt=4096 t0=0.1
+
+../fdelmodc \
+ file_cp=simple_cp.su ischeme=1 \
+ file_den=simple_ro.su \
+ file_src=wave.su \
+ file_rcv=shot_fd_dip.su \
+ src_type=1 \
+ src_orient=2 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.0005 \
+ verbose=2 \
+ tmod=0.5115 \
+ dxrcv=5.0 \
+ xrcv1=-500 xrcv2=500 \
+ zrcv1=500 zrcv2=500 \
+ xsrc=0 zsrc=1000 \
+ ntaper=80 \
+ left=4 right=4 bottom=4 top=4
+
+makewave fp=15 dt=0.0005 file_out=wave.su nt=4096 t0=0.1
+
+green c=$cp rho=$rho file_src=wave.su zsrc1=500 xrcv=-500,500 dxrcv=5 nt=4096 dip=1 verbose=1 | suwind nt=1024 > shot_green_dip_rp.su
+green c=$cp rho=$rho file_src=wave.su zsrc1=500 xrcv=-500,500 dxrcv=5 nt=4096 p_vz=1 dip=1 verbose=1 | suwind nt=1024 > shot_green_dip_rvz.su
+
+shift=`perl -e "print 0.5*$dx/$cp;"`
+
+# rp
+(suwind key=tracl min=101 max=101 < shot_fd_dip_rp.su | basop choice=shift shift=-$shift; suwind key=tracl min=101 max=101 < shot_green_dip_rp.su ) | basop choice=shift shift=-0.1 | supsgraph style=normal titlesize=-1 labelsize=10 wbox=4 hbox=2 label1='time in seconds' label2="Amplitude" linewidth=0.1 linecolor=red,green d2num=0.5 xend=2.0 f2num=-1.5> dip_rp.eps
+
+(suwind key=tracl min=101 max=101 < shot_fd_dip_rp.su | basop choice=shift shift=-$shift; suwind key=tracl min=101 max=101 < shot_green_dip_rp.su ) | basop choice=shift shift=-0.1 | supsgraph style=normal labelsize=10 wbox=2 hbox=2 label1='time in seconds' label2="Amplitude" linewidth=0.1 linecolor=red,green x2beg=1.8 x1beg=0.2430 x1end=0.24601 f1num=0.243 d1num=0.002 > dip_zoom_rp.eps
+
+suwind key=tracl min=101 max=101 < shot_fd_dip_rp.su | basop choice=shift shift=-$shift > trace_fd.su
+suwind key=tracl min=101 max=101 < shot_green_dip_rp.su > trace_green.su
+
+sumax < trace_green.su outpar=nep
+Mmax=`cat nep | awk '{print $1}'`
+a=`perl -e "print 100.0/$Mmax;"`
+echo $a
+
+sudiff trace_green.su trace_fd.su | basop choice=shift shift=-0.1 | sugain scale=$a | suop op=abs | supsgraph style=normal labelsize=12 wbox=4 hbox=2 label1='time in seconds' label2="Relative error in percentage of peak" linewidth=0.1 linecolor=red x2beg=0.0 x2end=1.0 f2num=0.0 d2num=0.5 > dip_diff_dx${dx}_rp.eps
+
+(suwind key=tracl min=101 max=101 < shot_fd_dip_rp.su | basop choice=shift shift=-$shift ; suwind key=tracl min=101 max=101 < shot_green_dip_rp.su ) | basop choice=shift shift=-0.1 | suxgraph
+
+
+# rvz
+
+(suwind key=tracl min=101 max=101 < shot_fd_dip_rvz.su | basop choice=shift shift=-$shift; suwind key=tracl min=101 max=101 < shot_green_dip_rvz.su ) | basop choice=shift shift=-0.1 | supsgraph style=normal labelsize=10 wbox=4 hbox=2 label1='time in seconds' label2="Amplitude" linewidth=0.1 linecolor=red,green d2num=6e-10 f2num=-1.2e-9 x2end=2e-9 x2beg=-1.3e-9 > dip_rvz.eps
+
+(suwind key=tracl min=101 max=101 < shot_fd_dip_rvz.su | basop choice=shift shift=-$shift; suwind key=tracl min=101 max=101 < shot_green_dip_rvz.su ) | basop choice=shift shift=-0.1 | sugain scale=-1 | supsgraph style=normal labelsize=10 wbox=2 hbox=2 label1='time in seconds' label2="Amplitude" linewidth=0.1 linecolor=red,green d2num=5e-9 f2num=9.5e-7 x2end=9.78e-7 x2beg=9.5e-7 x1beg=0.2430 x1end=0.24601 f1=0 f1num=0.243 d1num=0.002 > dip_zoom_rvz.eps
+
+suwind key=tracl min=101 max=101 < shot_fd_dip_rvz.su | basop choice=shift shift=-$shift > trace_fd.su
+suwind key=tracl min=101 max=101 < shot_green_dip_rvz.su > trace_green.su
+
+sumax < trace_green.su outpar=nep
+Mmax=`cat nep | awk '{print $1}'`
+a=`perl -e "print 100.0/$Mmax;"`
+echo $a
+
+sudiff trace_green.su trace_fd.su | basop choice=shift shift=-0.1 | sugain scale=$a | suop op=abs | supsgraph style=normal labelsize=12 wbox=4 hbox=2 label1='time in seconds' label2="Relative error in percentage of peak" linewidth=0.1 linecolor=red x2beg=0.0 x2end=1.0 f2num=0.0 d2num=0.5 > dip_diff_dx${dx}_rvz.eps
+
+(suwind key=tracl min=101 max=101 < shot_fd_dip_rvz.su | basop choice=shift shift=-$shift; suwind key=tracl min=101 max=101 < shot_green_dip_rvz.su ) | basop choice=shift shift=-0.1 | suxgraph
+
+exit;
+######### ELASTIC #######
+
+cp=2000
+cs=1400
+rho=1000
+dx=5
+dt=0.0005
+
+makemod sizex=2000 sizez=2000 dx=$dx dz=$dx cp0=$cp cs0=$cs ro0=$rho orig=-1000,0 file_base=simple.su
+
+makewave fp=15 dt=$dt file_out=wave.su nt=4096 t0=0.1
+
+
+../fdelmodc \
+ file_cp=simple_cp.su ischeme=3 \
+ file_cs=simple_cs.su \
+ file_den=simple_ro.su \
+ file_src=wave.su \
+ file_rcv=shot_fd.su \
+ src_type=6 \
+ rec_type_vz=1 \
+ rec_int_vz=2 \
+ dtrcv=0.0005 \
+ verbose=2 \
+ tmod=0.5115 \
+ dxrcv=5.0 \
+ xrcv1=-500 xrcv2=500 \
+ zrcv1=500 zrcv2=500 \
+ xsrc=0 zsrc=1000 \
+ ntaper=80 \
+ left=4 right=4 bottom=4 top=4
+
+makewave fp=15 dt=0.0005 file_out=waveg.su nt=4096 t0=0.1
+
+green c=$cp cs=$cs rho=$rho file_src=waveg.su zsrc1=500 xrcv=-500,500 dxrcv=5 nt=4096 Fx=1 | suwind nt=1024 > shot_green_FxRz.su
+
+ (suwind key=tracl min=51 max=51 < shot_fd_rvz.su ; suwind key=tracl min=51 max=51 < shot_green_FxRz.su) | basop choice=shift shift=-0.1 | suxgraph
+
+
+../fdelmodc \
+ file_cp=simple_cp.su ischeme=3 \
+ file_cs=simple_cs.su \
+ file_den=simple_ro.su \
+ file_src=wave.su \
+ file_rcv=shot_fd_fz.su \
+ src_type=7 \
+ rec_type_vz=1 \
+ rec_int_vz=0 \
+ dtrcv=0.0005 \
+ verbose=2 \
+ tmod=0.5115 \
+ dxrcv=5.0 \
+ xrcv1=-500 xrcv2=500 \
+ zrcv1=500 zrcv2=500 \
+ xsrc=0 zsrc=1000 \
+ ntaper=80 \
+ left=4 right=4 bottom=4 top=4
+
+green c=$cp cs=$cs rho=$rho file_src=waveg.su zsrc1=500 xrcv=-500,500 dxrcv=5 nt=4096 Fz=1 | suwind nt=1024 > shot_green_FzRz.su
+
+ (suwind key=tracl min=101 max=101 < shot_fd_fz_rvz.su ; suwind key=tracl min=101 max=101 < shot_green_FzRz.su) | basop choice=shift shift=-0.1 | suxgraph
+
+
+
+######### DIPOLE ELASTIC #######
+
+
+######### SURFACE WAVES #######
+
diff --git a/fdelmodc3D/demo/decompfree.scr b/fdelmodc3D/demo/decompfree.scr
new file mode 100755
index 0000000000000000000000000000000000000000..070c3fe0ddcbbbfab87c5a99d43f4b15c943b50f
--- /dev/null
+++ b/fdelmodc3D/demo/decompfree.scr
@@ -0,0 +1,66 @@
+#!/bin/bash
+#PBS -N fdelmod
+#PBS -q verylong
+#PBS -l nodes=7
+#PBS -k eo
+#PBS -j eo
+
+which makewave
+which makemod
+
+
+cp=2000
+rho=1000
+dx=4
+dt=0.0010
+
+makemod sizex=3000 sizez=1000 dx=$dx dz=$dx cp0=$cp ro0=$rho cs0=0 \
+ orig=-1500,0 file_base=freesurf.su \
+ intt=def x=-1500,0,1500 z=200,200,200 poly=0 cp=2300 ro=2000 cs=0 \
+ intt=def x=-1500,0,1500 z=500,500,500 poly=0 cp=2100 ro=1400 cs=0
+ verbose=1
+
+makewave fp=20 dt=$dt file_out=wave.su nt=4096 t0=0.1
+
+../fdelmodc \
+ file_cp=freesurf_cp.su ischeme=1 \
+ file_cs=freesurf_cs.su \
+ file_den=freesurf_ro.su \
+ file_src=wave.su \
+ file_rcv=shot_x0.su \
+ src_type=7 \
+ verbose=4 \
+ src_orient=2 \
+ src_injectionrate=1 \
+ nshot=2 \
+ dxshot=50 \
+ rec_type_ud=1 \
+ rec_int_vz=3 \
+ dtrcv=0.0010 \
+ rec_delay=0.1 \
+ tmod=1.10 \
+ dxrcv=8.0 \
+ xrcv1=-1500 xrcv2=1500 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=100 zsrc=0 \
+ ntaper=300 \
+ left=4 right=4 top=1 bottom=4
+
+
+#sfsuread <freesurf_cp.su tfile=tfile.rsf endian=0>model.rsf
+#sfsuread <wave.su tfile=tfile.rsf endian=0>wave.rsf
+#sfsuread <shot_x0_ru.su tfile=tfile.rsf endian=0>shotu.rsf
+#sfsuread <shot_x0_rp.su tfile=tfile.rsf endian=0>shotp.rsf
+#sfsuread <shot_x0_rd.su tfile=tfile.rsf endian=0>shotd.rsf
+#sfsuread <shot_x0_rvz.su tfile=tfile.rsf endian=0>shotv.rsf
+#
+#sfgrey<shotu.rsf title="data">shots.vpl
+#sfgrey<shotp.rsf title="data">shotp.vpl
+#sfgrey<shotv.rsf title="data">shotv.vpl
+#
+#xtpen shots.vpl
+#xtpen shotp.vpl
+#xtpen shotv.vpl
+
+
+
diff --git a/fdelmodc3D/demo/decomposition.scr b/fdelmodc3D/demo/decomposition.scr
new file mode 100755
index 0000000000000000000000000000000000000000..384422de337aaa6a9f368f4c365edd56050fe288
--- /dev/null
+++ b/fdelmodc3D/demo/decomposition.scr
@@ -0,0 +1,95 @@
+#!/bin/bash
+#PBS -N fdelmod
+#PBS -q verylong
+#PBS -l nodes=1
+#PBS -k eo
+#PBS -j eo
+
+which makewave
+which makemod
+
+cd /Users/jan/src/OpenSource/fdelmodc/demo
+
+#makewave fp=20 dt=$dt file_out=wave.su nt=4096 t0=0.1
+#makewave w=fw fmin=0 flef=5 frig=80 fmax=100 dt=$dt file_out=wavefw.su nt=4096 t0=0.3
+
+cp=2000
+rho=1000
+dx=2.5
+dt=0.0005
+
+makemod sizex=6000 sizez=4000 dx=$dx dz=$dx cp0=$cp cs0=$cs ro0=$rho \
+ orig=-3000,-1000 file_base=syncl.su \
+ intt=def x=-3000,0,3000 z=250,250,250 poly=0 cp=2300 ro=5000 \
+ intt=def x=-3000,-2000,-1000,-800,0,800,3000 z=650,650,700,750,900,750,600 poly=2 cp=2600 ro=1000 \
+ intt=def x=-3000,0,3000 z=1390,1390,1390 poly=0 cp=2000 ro=5000 \
+ intt=def x=-3000,0,3000 z=1490,1490,1490 poly=0 cp=2400 ro=2000
+
+makewave fp=20 dt=$dt file_out=wave.su nt=4096 t0=0.1
+
+# pressure Normalised decompostion
+../fdelmodc \
+ file_cp=syncl_cp.su ischeme=1 \
+ file_den=syncl_ro.su \
+ file_src=wave.su \
+ file_rcv=shot_fd_Fz_zsrc1150.su \
+ nshot=1 dxshot=500 \
+ src_type=7 \
+ src_orient=1 \
+ src_injectionrate=1 \
+ rec_type_ud=1 \
+ dtrcv=0.0040 \
+ rec_delay=0.1 \
+ verbose=2 \
+ tmod=3.10 \
+ dxrcv=10 \
+ xrcv1=-2250 xrcv2=2250 \
+ zrcv1=1150 zrcv2=1150 \
+ xsrc=0 zsrc=0 \
+ ntaper=50 \
+ left=2 right=2 top=2 bottom=2
+
+
+supsgraph < anglerp.su hbox=2 wbox=4 style=normal \
+ labelsize=10 label2='energy' label1='angle in degrees' \
+ titlesize=-1 f1=0 d1=1 d1num=10.0 x1beg=1 > anglerp.eps
+
+supsimage < shot_fd_Fz_zsrc1150_rvz.su \
+ wbox=2 hbox=4 titlesize=-1 labelsize=10 verbose=1 \
+ label1="time [s]" label2="lateral position [m]" > shot_fd_Fz_zsrc1150_rvz.eps
+
+supsimage < shot_fd_Fz_zsrc1150_rp.su \
+ wbox=2 hbox=4 titlesize=-1 labelsize=10 verbose=1 \
+ label1="time [s]" label2="lateral position [m]" > shot_fd_Fz_zsrc1150_rp.eps
+
+supsimage < shot_fd_Fz_zsrc1150_ru.su \
+ wbox=2 hbox=4 titlesize=-1 labelsize=10 verbose=1 \
+ label1="time [s]" label2="lateral position [m]" > shot_fd_Fz_zsrc1150_ru.eps
+
+supsimage < shot_fd_Fz_zsrc1150_rd.su \
+ wbox=2 hbox=4 titlesize=-1 labelsize=10 verbose=1 \
+ label1="time [s]" label2="lateral position [m]" > shot_fd_Fz_zsrc1150_rd.eps
+
+# Particle Velocity Normalised decompostion
+../fdelmodc \
+ file_cp=syncl_cp.su ischeme=1 \
+ file_den=syncl_ro.su \
+ file_src=wave.su \
+ file_rcv=shot_fd_Fz_zsrc1150_vznorm.su \
+ nshot=1 dxshot=500 \
+ src_type=7 \
+ src_orient=1 \
+ src_injectionrate=1 \
+ rec_type_ud=2 \
+ dtrcv=0.0040 \
+ rec_delay=0.1 \
+ verbose=2 \
+ tmod=3.10 \
+ dxrcv=10 \
+ xrcv1=-2250 xrcv2=2250 \
+ zrcv1=1150 zrcv2=1150 \
+ xsrc=0 zsrc=0 \
+ ntaper=50 \
+ left=2 right=2 top=2 bottom=2
+
+
diff --git a/fdelmodc3D/demo/demoStaircase.scr b/fdelmodc3D/demo/demoStaircase.scr
new file mode 100755
index 0000000000000000000000000000000000000000..4fd328a3cc41f996de5639e46763e2894db0341b
--- /dev/null
+++ b/fdelmodc3D/demo/demoStaircase.scr
@@ -0,0 +1,85 @@
+#!/bin/bash
+
+#export PATH=$HOME/bin:$HOME/src/OpenSource/utils:$PATH:
+
+cp=2000
+rho=2500
+dx=2.5
+dt=0.0005
+
+#dx=5
+#dt=0.0005
+
+makemod sizex=5000 sizez=2500 dx=$dx dz=$dx cp0=$cp ro0=$rho \
+ orig=-2500,0 file_base=tilt.su \
+ intt=def x=-2500,0,2500 z=2000,1200,400 cp=2500 ro=5500
+
+makemod sizex=5000 sizez=2500 dx=$dx dz=$dx cp0=$cp ro0=$rho \
+ orig=-2500,0 file_base=hom.su
+
+makewave w=g1 fp=20 dt=$dt file_out=wave.su nt=4096 t0=0.1
+
+export OMP_NUM_THREADS=2
+
+zsrc=1100
+zsrc=0
+
+../fdelmodc \
+ file_cp=tilt_cp.su ischeme=1 iorder=4 \
+ file_den=tilt_ro.su \
+ file_src=wave.su \
+ file_rcv=shot_fd.su \
+ src_type=7 \
+ src_orient=1 \
+ src_injectionrate=0 \
+ rec_type_vz=1 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.004 \
+ rec_delay=0.1 \
+ verbose=2 \
+ tmod=2.01 \
+ dxrcv=10.0 \
+ xrcv1=-2250 xrcv2=2250 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=0 zsrc=$zsrc \
+ file_snap=snapF_$zsrc \
+ tsnap1=0.1 tsnap2=2.0 dtsnap=0.05 dxsnap=5 dzsnap=5 \
+ ntaper=101 \
+ snapwithbnd=1 \
+ left=2 right=2 top=2 bottom=2
+
+#suxmovie < snapF_${zsrc}_svz.su loop=1 clip=1e-13
+sugain scale=-1 < snapF_0_svz.su | sustrip > snapF_0_dx${dx}_svz.bin
+
+exit;
+../fdelmodc \
+ file_cp=hom_cp.su ischeme=1 iorder=4 \
+ file_den=hom_ro.su \
+ file_src=wave.su \
+ file_rcv=shoth_fd.su \
+ src_type=7 \
+ src_orient=1 \
+ src_injectionrate=0 \
+ rec_type_vz=1 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.004 \
+ rec_delay=0.1 \
+ verbose=2 \
+ tmod=2.01 \
+ dxrcv=10.0 \
+ xrcv1=-2250 xrcv2=2250 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=0 zsrc=$zsrc \
+ file_snap=snapH_$zsrc \
+ tsnap1=0.1 tsnap2=2.0 dtsnap=0.05 dxsnap=5 dzsnap=5 \
+ ntaper=101 \
+ snapwithbnd=1 \
+ left=2 right=2 top=2 bottom=2
+
+sudiff snapF_${zsrc}_svz.su snapH_${zsrc}_svz.su > snap_svz.su
+
+sugain scale=-1 < snap_svz.su | sustrip > snap_svz.bin
+
+suxmovie < snap_svz.su loop=1 clip=1e-13
diff --git a/fdelmodc3D/demo/demo_dissipative.scr b/fdelmodc3D/demo/demo_dissipative.scr
new file mode 100755
index 0000000000000000000000000000000000000000..f26bca913f02b67fd5664d4cdd4172e0c68a2d3b
--- /dev/null
+++ b/fdelmodc3D/demo/demo_dissipative.scr
@@ -0,0 +1,42 @@
+#!/bin/bash
+
+export PATH=:$HOME/src/OpenSource/bin:$HOME/bin64:$PATH:
+
+dx=2.5
+dt=0.00050
+
+makemod sizex=6000 sizez=1250 dx=$dx dz=$dx cp0=1500 ro0=1000 \
+ orig=-3000,0 file_base=tutodel.su verbose=2 \
+ intt=def x=-3000,-2000,-1000,0,1000,2000,3000 z=240,130,250,300,350,380,320 poly=2 cp=1950 ro=4500 grad=0 \
+ intt=def x=-3000,-2200,-1500,0,1300,2100,3000 z=620,640,590,600,740,700,600 poly=2 cp=2000 ro=1400 grad=0 \
+ intt=def x=-3000,-1800,0,2200,3000 z=920,1000,900,1000,1010 poly=2 cp=2300 ro=1600 grad=0
+
+
+export OMP_NUM_THREADS=2
+makewave fp=30 dt=$dt file_out=wave.su nt=4096 t0=0.1 scale=1
+
+file_cp=tutodel_cp.su
+file_ro=tutodel_ro.su
+
+../fdelmodc \
+ file_cp=$file_cp ischeme=-1 iorder=4 \
+ file_den=$file_ro \
+ file_src=wave.su \
+ file_snap=snapinj_rate1_planevz.su \
+ file_rcv=recvE.su \
+ src_type=1 \
+ src_injectionrate=1 \
+ qr=0.0010 \
+ dtrcv=$dt \
+ rec_delay=0.1 \
+ verbose=4 \
+ tmod=2.1000 \
+ xrcva=0,0,0 zrcva=100,500,900 \
+ xrcv1=-3000 xrcv2=3000 zrcv1=0 zrcv2=0 dxrcv=10 \
+ tsnap1=0.100 tsnap2=0.00 dtsnap=0.01 \
+ xsnap1=-2000 xsnap2=2000 dxsnap=5 dzsnap=5 \
+ xsrc=0 zsrc=0 \
+ ntaper=500 \
+ left=4 right=4 top=4 bottom=4
+
+
diff --git a/fdelmodc3D/demo/demo_multiwave.scr b/fdelmodc3D/demo/demo_multiwave.scr
new file mode 100755
index 0000000000000000000000000000000000000000..ca045482a1861857eabfba350dfc15101b7437f3
--- /dev/null
+++ b/fdelmodc3D/demo/demo_multiwave.scr
@@ -0,0 +1,64 @@
+#!/bin/bash
+#PBS -l nodes=1:ppn=2
+#PBS -N InterfModeling
+#PBS -V
+#
+
+#demo for sources with different wavelets for each source postions
+cp=2000
+rho=1000
+dx=2.5
+dt=0.0005
+
+export PATH=../../bin:$PATH
+
+makemod sizex=2000 sizez=2000 dx=$dx dz=$dx cp0=$cp ro0=$rho orig=-1000,0 file_base=simple.su
+
+times=(0.101 0.11 0.2 0.3)
+ampl=(1.0 2.0 3.0 4.0)
+xpos=(-500 0 700 900)
+zpos=(700 800 900 950)
+n=${#times[@]}
+
+rm traces.su
+
+for (( i=0; i < $n; i++ ));
+do
+
+(( gx = ${xpos[i]}*1000 ))
+(( gelev = ${zpos[i]}*-1000 ))
+echo $gx $gelev ${times[i]} ${ampl[i]}
+
+makewave fp=15 dt=$dt nt=4096 t0=${times[i]} | \
+ sugain scale=${ampl[i]} | \
+ sushw key=gx,gelev,scalco,scalel a=$gx,$gelev,-1000,-1000 >> traces.su
+
+done
+
+#suxgraph < traces.su
+
+######### MONOPOLE ACOUSTIC #######
+
+fdelmodc \
+ file_cp=simple_cp.su ischeme=1 \
+ file_den=simple_ro.su \
+ file_src=traces.su \
+ src_multiwav=1 \
+ file_rcv=shot_fd.su \
+ src_type=1 \
+ rec_type_p=1 \
+ rec_type_vz=0 \
+ rec_int_vz=2 \
+ dtrcv=0.004 \
+ verbose=4 \
+ tmod=4.000 \
+ dxrcv=5.0 \
+ xrcv1=-1000 xrcv2=1000 \
+ zrcv1=0 zrcv2=0 \
+ ntaper=100 \
+ tsnap1=0.0 tsnap2=0.4 dtsnap=0.05 \
+ left=4 right=4 bottom=4 top=4
+
+suximage < shot_fd_rp.su
+
+suxmovie < snap_sp.su loop=1 clip=100
diff --git a/fdelmodc3D/demo/demo_reciprocity.scr b/fdelmodc3D/demo/demo_reciprocity.scr
new file mode 100755
index 0000000000000000000000000000000000000000..071fe4f9b735ef11e81956b7a47b06df227a4865
--- /dev/null
+++ b/fdelmodc3D/demo/demo_reciprocity.scr
@@ -0,0 +1,257 @@
+#!/bin/bash
+#PBS -l nodes=1:ppn=2
+#PBS -N InterfModeling
+#PBS -V
+#
+# source construction shown in Figure A2-A3-A4, 150 s.
+
+cp=2000
+rho=1000
+dx=2.5
+dt=0.00025
+injectionrate=0
+
+set -x
+if [ $injectionrate == 1 ];
+then
+ scalep=0.02
+ scalev=0.01
+else
+ scalep=0.0004
+ scalev=0.0002
+fi
+
+export OMP_NUM_THREADS=4
+
+makemod sizex=3000 sizez=3000 dx=$dx dz=$dx cp0=$cp ro0=$rho orig=-1500,-1500 file_base=layers.su \
+ intt=def poly=0 x=-1500,1500 z=250,250 cp=2000 ro=3000
+
+makewave fp=15 dt=$dt file_out=wave.su nt=4096 t0=0.1 scale=0 scfft=1
+sumax < wave.su
+
+######### Pressure source #######
+
+../fdelmodc \
+ file_cp=layers_cp.su ischeme=1 \
+ file_den=layers_ro.su \
+ file_src=wave.su \
+ file_rcv=shot_monZ600.su \
+ src_type=1 \
+ src_orient=1 \
+ src_injectionrate=$injectionrate \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.001 \
+ verbose=2 \
+ rec_delay=0.1 \
+ tmod=0.5 \
+ dxrcv=10.0 \
+ xrcv1=-1000 xrcv2=1000 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=0 zsrc=600 \
+ ntaper=100 \
+ left=4 right=4 bottom=4 top=4
+
+../fdelmodc \
+ file_cp=layers_cp.su ischeme=1 \
+ file_den=layers_ro.su \
+ file_src=wave.su \
+ file_rcv=shot_monZ0.su \
+ src_type=1 \
+ src_orient=1 \
+ src_injectionrate=$injectionrate \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.001 \
+ verbose=2 \
+ rec_delay=0.1 \
+ tmod=0.5 \
+ dxrcv=10.0 \
+ xrcv1=-1000 xrcv2=1000 \
+ zrcv1=600 zrcv2=600 \
+ xsrc=0 zsrc=0 \
+ ntaper=100 \
+ left=4 right=4 bottom=4 top=4
+
+
+######### Force Source #######
+
+../fdelmodc \
+ file_cp=layers_cp.su ischeme=1 \
+ file_den=layers_ro.su \
+ file_src=wave.su \
+ file_rcv=shot_dipZ600.su \
+ src_type=7 \
+ src_orient=1 \
+ src_injectionrate=$injectionrate \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.001 \
+ verbose=2 \
+ rec_delay=0.1 \
+ tmod=0.5 \
+ dxrcv=10.0 \
+ xrcv1=-1000 xrcv2=1000 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=0 zsrc=600 \
+ ntaper=100 \
+ left=4 right=4 bottom=4 top=4
+
+../fdelmodc \
+ file_cp=layers_cp.su ischeme=1 \
+ file_den=layers_ro.su \
+ file_src=wave.su \
+ file_rcv=shot_dipZ0.su \
+ src_type=7 \
+ src_orient=1 \
+ src_injectionrate=$injectionrate \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.001 \
+ verbose=2 \
+ rec_delay=0.1 \
+ tmod=0.5 \
+ dxrcv=10.0 \
+ xrcv1=-1000 xrcv2=1000 \
+ zrcv1=600 zrcv2=600 \
+ xsrc=0 zsrc=0 \
+ ntaper=100 \
+ left=4 right=4 bottom=4 top=4
+
+susum shot_monZ0_rvz.su shot_dipZ600_rp.su > nep.su
+suximage < shot_monZ0_rvz.su title="shot_monZ0_rvz.su" clip=$scalev
+suximage < nep.su clip=$scalev title="difference"
+sumax < shot_monZ0_rvz.su; sumax < shot_dipZ600_rp.su
+susum shot_dipZ0_rp.su shot_monZ600_rvz.su > nep.su
+suximage < shot_dipZ0_rp.su title="shot_dipZ0_rp.su" clip=$scalep
+suximage < nep.su clip=$scalep title="difference"
+sumax < shot_dipZ0_rp.su; sumax < shot_monZ600_rvz.su
+
+
+exit
+
+# use different dx and dt to test independence of sampling on the amplitudes
+#########################
+cp=2000
+rho=1000
+dx=5
+dt=0.001
+
+export OMP_NUM_THREADS=1
+
+makemod sizex=3000 sizez=3000 dx=$dx dz=$dx cp0=$cp ro0=$rho orig=-1500,-1500 file_base=layers.su \
+ intt=def poly=0 x=-1500,1500 z=250,250 cp=2000 ro=3000
+
+makewave fp=15 dt=$dt file_out=wave.su nt=4096 t0=0.1 scale=0 scfft=1
+sumax < wave.su
+
+######### MONOPOLE #######
+
+../fdelmodc \
+ file_cp=layers_cp.su ischeme=1 \
+ file_den=layers_ro.su \
+ file_src=wave.su \
+ file_rcv=shot_dxtmonZ600.su \
+ src_type=1 \
+ src_orient=1 \
+ src_injectionrate=$injectionrate \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.001 \
+ verbose=2 \
+ rec_delay=0.1 \
+ tmod=0.5 \
+ dxrcv=10.0 \
+ xrcv1=-1000 xrcv2=1000 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=0 zsrc=600 \
+ ntaper=100 \
+ left=4 right=4 bottom=4 top=4
+
+../fdelmodc \
+ file_cp=layers_cp.su ischeme=1 \
+ file_den=layers_ro.su \
+ file_src=wave.su \
+ file_rcv=shot_dxtmonZ0.su \
+ src_type=1 \
+ src_orient=1 \
+ src_injectionrate=$injectionrate \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.001 \
+ verbose=2 \
+ rec_delay=0.1 \
+ tmod=0.5 \
+ dxrcv=10.0 \
+ xrcv1=-1000 xrcv2=1000 \
+ zrcv1=600 zrcv2=600 \
+ xsrc=0 zsrc=0 \
+ ntaper=100 \
+ left=4 right=4 bottom=4 top=4
+
+
+######### DIPOLE #######
+
+../fdelmodc \
+ file_cp=layers_cp.su ischeme=1 \
+ file_den=layers_ro.su \
+ file_src=wave.su \
+ file_rcv=shot_dxtdipZ600.su \
+ src_type=7 \
+ src_orient=1 \
+ src_injectionrate=$injectionrate \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.001 \
+ verbose=2 \
+ rec_delay=0.1 \
+ tmod=0.5 \
+ dxrcv=10.0 \
+ xrcv1=-1000 xrcv2=1000 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=0 zsrc=600 \
+ ntaper=100 \
+ left=4 right=4 bottom=4 top=4
+
+../fdelmodc \
+ file_cp=layers_cp.su ischeme=1 \
+ file_den=layers_ro.su \
+ file_src=wave.su \
+ file_rcv=shot_dxtdipZ0.su \
+ src_type=7 \
+ src_orient=1 \
+ src_injectionrate=$injectionrate \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.001 \
+ verbose=2 \
+ rec_delay=0.1 \
+ tmod=0.5 \
+ dxrcv=10.0 \
+ xrcv1=-1000 xrcv2=1000 \
+ zrcv1=600 zrcv2=600 \
+ xsrc=0 zsrc=0 \
+ ntaper=100 \
+ left=4 right=4 bottom=4 top=4
+
+set -x
+dx=5
+dt=0.001
+echo "maximum with dx=$dx dt=$dt"
+sumax < shot_dxtmonZ0_rvz.su; sumax < shot_dxtdipZ600_rp.su
+dx=2.5
+dt=0.00025
+echo "maximum with dx=$dx dt=$dt"
+sumax < shot_monZ0_rvz.su; sumax < shot_dipZ600_rp.su
+
+dx=5
+dt=0.001
+echo "maximum with dx=$dx dt=$dt"
+sumax < shot_dxtdipZ0_rp.su; sumax < shot_dxtmonZ600_rvz.su
+dx=2.5
+dt=0.00025
+echo "maximum with dx=$dx dt=$dt"
+sumax < shot_dipZ0_rp.su; sumax < shot_monZ600_rvz.su
+
+exit;
+
diff --git a/fdelmodc3D/demo/demo_snapshots.scr b/fdelmodc3D/demo/demo_snapshots.scr
new file mode 100755
index 0000000000000000000000000000000000000000..5045197d18118f2ead1315f7d8272bc5ceff86cc
--- /dev/null
+++ b/fdelmodc3D/demo/demo_snapshots.scr
@@ -0,0 +1,40 @@
+#!/bin/bash
+
+export PATH=:$HOME/src/OpenSource/bin:$HOME/bin64:$PATH:
+
+dx=1.0
+dt=0.00010
+
+makemod sizex=6000 sizez=1250 dx=$dx dz=$dx cp0=1500 ro0=1000 \
+ orig=-3000,0 file_base=tutodel.su verbose=2 \
+ intt=def x=-3000,-2000,-1000,0,1000,2000,3000 z=240,130,250,300,350,380,320 poly=2 cp=1950 ro=4500 grad=0 \
+ intt=def x=-3000,-2200,-1500,0,1300,2100,3000 z=620,640,590,600,740,700,600 poly=2 cp=2000 ro=1400 grad=0 \
+ intt=def x=-3000,-1800,0,2200,3000 z=920,1000,900,1000,1010 poly=2 cp=2300 ro=1600 grad=0
+
+
+export OMP_NUM_THREADS=2
+makewave fp=30 dt=$dt file_out=wave.su nt=4096 t0=0.1 scale=1
+
+file_cp=tutodel_cp.su
+file_ro=tutodel_ro.su
+
+fdelmodc \
+ file_cp=$file_cp ischeme=1 iorder=4 \
+ file_den=$file_ro \
+ file_src=wave.su \
+ file_snap=snapinj_rate1_planevz.su \
+ src_type=1 \
+ src_injectionrate=1 \
+ dtrcv=$dt \
+ rec_delay=0.1 \
+ verbose=2 \
+ tmod=1.1000 \
+ tsnap1=0.100 tsnap2=1.10 dtsnap=0.01 \
+ xsnap1=-2000 xsnap2=2000 dxsnap=5 dzsnap=5 \
+ xsrc=0 zsrc=800 \
+ ntaper=500 \
+ left=4 right=4 top=4 bottom=4
+
+
+suwind key=gx min=-2000000 max=2000000 < tutodel_cp.su | convert saminc=5 trinc=5 | sustrip > tutodel_cp.bin
+
diff --git a/fdelmodc3D/demo/eps_for_manual.scr b/fdelmodc3D/demo/eps_for_manual.scr
new file mode 100755
index 0000000000000000000000000000000000000000..7dde0dc45f2ddef98433171a93767bfaf8b70854
--- /dev/null
+++ b/fdelmodc3D/demo/eps_for_manual.scr
@@ -0,0 +1,52 @@
+#!/bin/bash
+
+#first run this script to generate the output which contains the source signatures
+./fdelmodc_rand.scr
+
+#generate the pictures used in the manual
+supsgraph < G2.su hbox=2 wbox=4 style=normal \
+ labelsize=10 label2='amplitude' label1='time' \
+ titlesize=-1 d1num=1 d1num=0.05 x1end=0.2 > G2_time.eps
+
+sufft < G2.su | suamp| supsgraph hbox=2 wbox=4 style=normal \
+ labelsize=10 label2='amplitude' label1='frequency' x1end=100 \
+ titlesize=-1 x2end=40 d1num=10 > G2_ampl.eps
+
+supswigp < src_nwav.su \
+ labelsize=10 label1='time' label2='source number' x1end=6 \
+ d2=1 d2num=1 hbox=4 wbox=6 fill=0 \
+ titlesize=-1 > src_nwav.eps
+
+suwind < src_nwav.su key=tracl min=11 max=11 | \
+ supsgraph hbox=2 wbox=4 style=normal \
+ labelsize=10 label2='amplitude' label1='time' \
+ titlesize=-1 d1num=1.0 > src11_wiggle.eps
+
+suwind < src_nwav.su key=tracl min=11 max=11 | \
+ supsgraph hbox=2 wbox=4 style=normal \
+ labelsize=10 label2='amplitude' label1='time' \
+ titlesize=-1 x1end=0.05 > src11_wiggle_zbeg.eps
+
+suwind < src_nwav.su key=tracl min=11 max=11 | \
+ supsgraph hbox=2 wbox=4 style=normal \
+ labelsize=10 label2='amplitude' label1='time' \
+ titlesize=-1 x1beg=3.65 x1end=3.70 > src11_wiggle_zend.eps
+
+suwind < src_nwav.su key=tracl min=11 max=11 | \
+ sufft | suamp| supsgraph hbox=2 wbox=4 style=normal \
+ labelsize=10 label2='amplitude' label1='frequency' \
+ titlesize=-1 x1end=100 d1num=10 > src11_ampl.eps
+
+fconv file_in1=src_nwav.su auto=1 shift=1 mode=cor1 | \
+ sugain qbal=1 | \
+ supswigp x1beg=-1 x1end=1 d2num=1 hbox=4 wbox=6 \
+ labelsize=10 label2='source number' label1='time (s)' \
+ titlesize=-1 fill=0 > src_nwav_autoCorr_Norm.eps
+
+#type of tapers
+supsgraph < tapx.su hbox=2 wbox=4 style=normal \
+ labelsize=10 label2='amplitude' label1='grid points' \
+ d1=1 f1=1 f1num=1 x2beg=0.0 \
+ linecolor=blue,red,green,yellow,voilet,maroon,brown,sepia,limegreen,skyblue,blueviolet,orangered,goldenrod,orchid,wildstrawberry,royalpurple,pinegreen,bluegreen,magenta,redorange > tapers_0.1.eps
+
+exit;
diff --git a/fdelmodc3D/demo/fdelmodc_acoustic_slanted_cable.sh b/fdelmodc3D/demo/fdelmodc_acoustic_slanted_cable.sh
new file mode 100755
index 0000000000000000000000000000000000000000..57e02bd0b21b5d6912639db210c74f231de4851c
--- /dev/null
+++ b/fdelmodc3D/demo/fdelmodc_acoustic_slanted_cable.sh
@@ -0,0 +1,168 @@
+#!/bin/bash
+#PBS -N fdelmod
+#PBS -q verylong
+#PBS -l nodes=1
+#PBS -k eo
+#PBS -j eo
+
+set -x
+#-----------------------------------------------------------------------------
+# Modeling of acoustic response of marine-type acquisition
+# where a horizontal and a slanted cable is modeled simultaneously
+#
+# Author: Eric Verschuur, Delft University of Technology
+# Date : July 2013
+#-----------------------------------------------------------------------------
+
+#-----------------------------------------------------------------------------
+# define the grid size of the modeling
+# based on the grid, the other parameters can be define
+#-----------------------------------------------------------------------------
+
+grid=5
+grid=10
+
+#-----------------------------------------------------------------------------
+# define the source wavelet:
+# for gridsize 10 m use fp=9.7 (such that fmax<30)
+# for gridsize 5 m use fp=22 (such that fmax<60) and
+#-----------------------------------------------------------------------------
+
+if [ $grid -eq 10 ]; then
+ dt=0.00020
+ fp=9.7
+ vmax=3000
+fi
+if [ $grid -eq 5 ]; then
+ dt=0.00010
+ fp=22
+ vmax=3000
+fi
+
+makewave file_out=wavelet.su dt=$dt nt=1024 fp=$fp shift=1 w=g2 verbose=1
+
+#-----------------------------------------------------------------------------
+# define the velocity model; in this case a flat water bottom and
+# a curved reflector below the water bottom
+#-----------------------------------------------------------------------------
+
+makemod file_base=model.su \
+ cp0=1500 ro0=1400 sizex=5000 sizez=1200 \
+ dx=$grid dz=$grid orig=0,0 \
+ \
+ x=0,5000 z=500,500 \
+ intt=def poly=2 cp=2000 ro=1800 \
+ \
+ x=0,2000,5000 z=1000,800,1000 \
+ intt=def poly=2 cp=$vmax ro=2300 \
+ \
+ verbose=1
+
+# display the models (velocity and density)
+
+filecp=model_cp.su
+filero=model_ro.su
+
+suximage < $filecp wbox=800 hbox=300 title="Vp model" xbox=0 legend=1 &
+suximage < $filero wbox=800 hbox=300 title="Rho model" xbox=800 legend=1 &
+
+sleep 1
+
+#-----------------------------------------------------------------------------
+# define the source location and make receivers dependent on the source
+# define length of cable and the vertical slant of the cable, which
+# is defined as the relative depth at the end of the cable
+# the receiver spacing is taken as twice the FD grid size
+#-----------------------------------------------------------------------------
+
+xsrc=500
+cable=4000
+slant=200
+
+xrcv1=`dadd $xsrc 103`
+xrcv2=`dadd $xrcv1 $cable`
+zrcv1=`dadd $grid 3`
+zrcv2=`dadd $zrcv1 $slant`
+zrcv2=`dnint $zrcv2`
+dxrcv=`dmul $grid 2`
+xrcv1=`dnint $xrcv1`
+xrcv2=`dnint $xrcv2`
+dxrcv=`dnint $dxrcv`
+
+#-----------------------------------------------------------------------------
+# generate a list of coorindates for the slanted cable
+# finally, these coordinates are stored in the file rcv.par
+#-----------------------------------------------------------------------------
+
+xrcv=$xrcv1
+zrcv=$zrcv1
+dzrcv=`echo $xrcv1 $xrcv2 $dxrcv $slant | awk '{nx=int(1.5+($2-$1)/$3);print ($4/(nx-1))}'`
+/bin/rm rcv.list
+while [ $xrcv -le $xrcv2 ]
+do
+ echo "$xrcv $zrcv" >> rcv.list
+ xrcv=`expr $xrcv + $dxrcv`
+ zrcv=`dadd $zrcv $dzrcv`
+done
+mkparfile < rcv.list string1=xrcva string2=zrcva > rcv.par
+/bin/rm rcv.list
+
+#-----------------------------------------------------------------------------
+# now do the actual modeling with free surface and monopole src/rcv
+# we use both the regular rcv defintions for a horizontal cable and the
+# extended option with xrcva,zrcva for the slanted cable locations
+#-----------------------------------------------------------------------------
+
+../fdelmodc \
+ file_cp=$filecp file_den=$filero \
+ ischeme=1 \
+ file_src=wavelet.su verbose=4 \
+ file_rcv=rec.su \
+ file_snap=snap.su \
+ xrcv1=$xrcv1 xrcv2=$xrcv2 dxrcv=$dxrcv \
+ zrcv1=$zrcv1 zrcv2=$zrcv1 \
+ par=rcv.par \
+ sinkdepth=0 \
+ rec_type_p=1 rec_type_vz=1 rec_int_vz=3 \
+ dtrcv=0.004 \
+ src_type=1 src_orient=1 xsrc=$xsrc zsrc=$grid nshot=1 \
+ tsnap1=0.1 tsnap2=3.0 dtsnap=0.1 \
+ sna_type_p=1 sna_type_vz=0 \
+ top=1 bottom=4 left=4 right=4 ntaper=100 tapfact=0.3 \
+ tmod=4.0 nzmax=300 nxmax=300
+
+#-----------------------------------------------------------------------------
+# show a movie of the wavefield snapshots
+#-----------------------------------------------------------------------------
+
+suxmovie < snap_sp.su clip=10 width=800 height=300 loop=1 \
+ title="Shot at x=$xsrc - P comp. - snapshot at t=%f s." sleep=200000 fframe=0.1 dframe=0.1 &
+
+#-----------------------------------------------------------------------------
+# the 1st part of the receivers is the slanted cable, the 2nd part the flat one
+#-----------------------------------------------------------------------------
+
+nxtot=`surange < rec_rp.su | head -1 | awk '{print $1}'`
+nx=`ddiv $nxtot 2`
+nx=`dnint $nx`
+
+# split into two files; on-the-fly repair dt from 3999 to 4000 us
+
+sushw key=fldr < rec_rp.su a=1 c=1 j=$nx | \
+suchw key1=dt key2=dt a=1 d=10 | \
+suchw key1=dt key2=dt b=10 | \
+sushw key=ntr a=0 | \
+file_distribute file_base=shot verbose=1
+
+suximage < shot1.su wbox=800 hbox=600 xbox=0 ybox=500 perc=99 \
+ title="Shot record xsrc=$xsrc - slanted (x1,z1)=$xrcv1,$zrcv1 (x2,z2)=$xrcv2,$zrcv2" &
+
+suximage < shot2.su wbox=800 hbox=600 xbox=800 ybox=500 perc=99 \
+ title="Shot record xsrc=$xsrc - flat cable (x1,z1)=$xrcv1,$zrcv1 (x2,z2)=$xrcv2,$zrcv1" &
+
+#-----------------------------------------------------------------------------
+# end of demo, remove some tmp files
+#-----------------------------------------------------------------------------
+
+sleep 1
+#/bin/rm rcv.par
diff --git a/fdelmodc3D/demo/fdelmodc_circ.scr b/fdelmodc3D/demo/fdelmodc_circ.scr
new file mode 100755
index 0000000000000000000000000000000000000000..8cecff0a9af7450893a2317c4378de36111b8703
--- /dev/null
+++ b/fdelmodc3D/demo/fdelmodc_circ.scr
@@ -0,0 +1,78 @@
+#!/bin/bash
+#PBS -N fdelmod
+#PBS -q verylong
+#PBS -l nodes=1
+#PBS -k eo
+#PBS -j eo
+
+# receivers are placed on a circle
+
+export PATH=../../utils:$PATH:
+
+makewave file_out=wavelet.su dt=0.0020 nt=1024 fp=13 shift=1 w=g2 verbose=1
+
+file_rcv=circle.su
+makemod file_base=model.su \
+ cp0=2500 ro0=1000 sizex=7000 sizez=7000 dx=10 dz=10 orig=-3500,-3500 \
+ intt=elipse var=50,50 x=0 z=0 cp=1955 ro=500 verbose=1
+
+
+#makemod file_base=model.su \
+# cp0=1500 ro0=1000 sizex=5000 sizez=5000 dx=2 dz=2 orig=0,0 \
+# intt=def x=2490,2494,2498,2502,2506,2510 z=2500,2498,2494,2498,2492,2500 cp=400 ro=20 \
+# intt=def x=2490,2492,2496,2500,2504,2510 z=2500,2506,2504,2508,2502,2500 cp=1500 ro=1000 \
+# verbose=1
+
+
+export filecp=model_cp.su
+export filero=model_ro.su
+
+export OMP_NUM_THREADS=1
+
+set -x
+../fdelmodc \
+ file_cp=$filecp file_den=$filero \
+ ischeme=1 \
+ file_src=wavelet.su verbose=5 \
+ file_rcv=$file_rcv \
+ file_snap=snap.su \
+ arcv=1200 rrcv=2800 oxrcv=0 ozrcv=0 dphi=2.0 \
+ rec_type_vx=1 rec_type_p=1 rec_int_vx=3 \
+ dtrcv=0.004 \
+ xsrc=-1600 zsrc=0 nshot=1 nsrc=1 \
+ src_type=1 tmod=3.0 \
+ ntaper=190 \
+ left=4 right=4 bottom=4 top=4
+
+exit
+
+#for exptype in circle square doodle ;
+for exptype in circle ;
+do
+for rectype in rvx rvz rp ;
+do
+ file_rcv=${exptype}_$rectype.su
+ echo $file_rcv
+ supsimage < ${exptype}_$rectype.su hbox=4 wbox=3 titlesize=-1 labelsize=10 titlesize=-1 \
+ perc=99 label1="time [s]" f2=0 d2=2 label2="rotation in degrees" > ${exptype}_$rectype.eps
+
+done
+done
+
+
+supsimage < model_cp.su \
+ wbox=4 hbox=4 titlesize=-1 labelsize=10 verbose=1 \
+
+
+supsimage < SrcRecPositions.su \
+ wbox=4 hbox=4 titlesize=-1 labelsize=10 verbose=1 \
+ d2=3 f2=0 wclip=-1 bclip=1 \
+ gabel1="depth [m]" label2="lateral position [m]" > SrcRecCircle.eps
+
+suop2 model_cp.su SrcRecPositions.su w1=1 w2=2000 op=sum | \
+ supsimage wclip=1400 bclip=2000 \
+ wbox=4 hbox=4 titlesize=-1 labelsize=10 verbose=1 \
+ d2=3 f2=0 wrgb=1.0,0,0 grgb=0,1.0,0 brgb=0,0,1.0 bps=24 \
+ label1="depth [m]" label2="lateral position [m]" > model_plane_src.eps
+
+
diff --git a/fdelmodc3D/demo/fdelmodc_circ_medium.scr b/fdelmodc3D/demo/fdelmodc_circ_medium.scr
new file mode 100755
index 0000000000000000000000000000000000000000..390e4d53d42324a3cf123d26423e7e573d43472b
--- /dev/null
+++ b/fdelmodc3D/demo/fdelmodc_circ_medium.scr
@@ -0,0 +1,93 @@
+#!/bin/bash
+#PBS -N fdelmod
+#PBS -q verylong
+#PBS -l nodes=1
+#PBS -k eo
+#PBS -j eo
+
+# receivers are placed on a circle
+
+export PATH=../../bin:$PATH:
+
+dt=0.0008
+makewave file_out=wave.su dt=$dt nt=1024 fp=25 shift=1 w=g2 verbose=1
+#makewave w=fw fmin=0 flef=6 frig=89 fmax=95 dt=$dt file_out=wavefw.su nt=16384 t0=0.3 scale=0 scfft=1
+#sufft < wavefw.su | suamp | sugain scale=0.0001 | suxgraph style=normal
+
+makemod file_base=model.su \
+ cp0=1500 ro0=1000 sizex=4000 sizez=4000 dx=2 dz=2 orig=-2000,-2000 \
+ intt=elipse var=1000,1000 x=0 z=0 cp=2000 ro=1000 verbose=1
+
+makemod file_base=hom.su \
+ cp0=1500 ro0=1000 sizex=4000 sizez=4000 dx=2 dz=2 orig=-2000,-2000 verbose=1
+
+export filecp=model_cp.su
+export filero=model_ro.su
+file_rcv=circle.su
+
+export OMP_NUM_THREADS=2
+
+set -x
+#../fdelmodc \
+ file_cp=$filecp file_den=$filero \
+ ischeme=1 \
+ file_src=wavefw.su verbose=2 \
+ file_rcv=$file_rcv \
+ rec_type_vz=0 rec_type_p=1 \
+ xrcv1=-2000 xrcv2=2000 zrcv1=-2000 zrcv2=-2000 \
+ dxrcv=10 \
+ dtrcv=0.004 \
+ xsrc=0 zsrc=-2000 nshot=1 nsrc=1 \
+ src_type=1 tmod=1.020 \
+ ntaper=100 \
+ left=2 right=2 bottom=2 top=2
+
+export filecp=hom_cp.su
+export filero=hom_ro.su
+file_rcv=hom.su
+
+fdelmodc \
+ file_cp=$filecp file_den=$filero \
+ ischeme=1 \
+ src_type=7 \
+ file_src=wave.su verbose=2 \
+ file_rcv=$file_rcv \
+ rec_type_vz=1 rec_type_p=1 \
+ rrcv=500 dphi=1 \
+ dtrcv=0.004 \
+ xsrc=0 zsrc=0 nshot=1 nsrc=1 \
+ tmod=1.020 \
+ ntaper=100 \
+ left=2 right=2 bottom=2 top=2
+
+exit
+
+#for exptype in circle square doodle ;
+for exptype in circle ;
+do
+for rectype in rvx rvz rp ;
+do
+ file_rcv=${exptype}_$rectype.su
+ echo $file_rcv
+ supsimage < ${exptype}_$rectype.su hbox=4 wbox=3 titlesize=-1 labelsize=10 titlesize=-1 \
+ perc=99 label1="time [s]" f2=0 d2=2 label2="rotation in degrees" > ${exptype}_$rectype.eps
+
+done
+done
+
+supsimage < model_cp.su \
+ wbox=4 hbox=4 titlesize=-1 labelsize=10 verbose=1 \
+ d2=3 f2=0 wrgb=1.0,0,0 grgb=0,1.0,0 brgb=0,0,1.0 bps=24 \
+ label1="depth [m]" label2="lateral position [m]" > model_plane.eps
+
+supsimage < SrcRecPositions.su \
+ wbox=4 hbox=4 titlesize=-1 labelsize=10 verbose=1 \
+ d2=3 f2=0 wclip=-1 bclip=1 \
+ gabel1="depth [m]" label2="lateral position [m]" > SrcRecCircle.eps
+
+suop2 model_cp.su SrcRecPositions.su w1=1 w2=2000 op=sum | \
+ supsimage wclip=1400 bclip=2000 \
+ wbox=4 hbox=4 titlesize=-1 labelsize=10 verbose=1 \
+ d2=3 f2=0 wrgb=1.0,0,0 grgb=0,1.0,0 brgb=0,0,1.0 bps=24 \
+ label1="depth [m]" label2="lateral position [m]" > model_plane_src.eps
+
diff --git a/fdelmodc3D/demo/fdelmodc_doublecouple.scr b/fdelmodc3D/demo/fdelmodc_doublecouple.scr
new file mode 100755
index 0000000000000000000000000000000000000000..ffea7d400c08043b744be9e5f73fa048f0f9d309
--- /dev/null
+++ b/fdelmodc3D/demo/fdelmodc_doublecouple.scr
@@ -0,0 +1,59 @@
+#!/bin/bash
+#PBS -N fdelmodc
+#PBS -k eo
+#PBS -j eo
+#
+# Models plane wave at depth to receivers at the surface, including snapshots
+export PATH=../../utils:$PATH:
+
+makewave file_out=wavelet.su dt=0.001 nt=1024 fp=13 shift=1 w=g2 verbose=1
+
+makemod file_base=model.su \
+ cp0=1500 ro0=1000 cs0=0 sizex=2100 sizez=2100 \
+ dx=3 dz=3 orig=0,0 \
+ verbose=4
+
+export filecp=model_cp.su
+export filecs=model_cs.su
+export filero=model_ro.su
+
+export OMP_NUM_THREADS=1
+
+../fdelmodc \
+ file_cp=$filecp file_den=$filero \
+ ischeme=5 \
+ src_type=9 dip=0 tmod=2.0 \
+ file_src=wavelet.su verbose=2 \
+ file_rcv=rec4S.su \
+ file_snap=snap4S0.su \
+ xrcv1=0 xrcv2=2100 dxrcv=15 \
+ zrcv1=400 zrcv2=400 \
+ rec_type_vx=1 rec_int_vx=1 \
+ dtrcv=0.004 \
+ xsrc=1050 zsrc=1050 \
+ ntaper=120 sna_type_pp=1 sna_type_ss=1 sna_type_p=1 sna_type_txx=1 sna_type_tzz=1 \
+ left=4 right=4 bottom=4 top=4 \
+ tsnap1=0.1 tsnap2=3.0 dtsnap=0.01
+
+
+exit;
+../fdelmodc \
+ file_cp=$filecp file_cs=$filecs file_den=$filero \
+ ischeme=3 \
+ file_src=wavelet.su verbose=4 \
+ file_rcv=recP.su \
+ file_snap=snapP.su \
+ xrcv1=0 xrcv2=2100 dxrcv=15 \
+ zrcv1=400 zrcv2=400 \
+ rec_type_vx=1 rec_type_pp=1 rec_type_ss=1 rec_int_vx=1 \
+ dtrcv=0.004 \
+ xsrc=1000 zsrc=1700 \
+ src_type=8 src_orient=1 tmod=2.0 \
+ ntaper=120 \
+ left=4 right=4 bottom=4 top=4 \
+ tsnap1=0.1 tsnap2=3.0 dtsnap=0.1 \
+ sna_type_ss=1 sna_type_pp=1
+
+
+exit;
+
diff --git a/fdelmodc3D/demo/fdelmodc_elastic_potentialS.scr b/fdelmodc3D/demo/fdelmodc_elastic_potentialS.scr
new file mode 100755
index 0000000000000000000000000000000000000000..4c7bb8a5236e88ba3b96ed3e2a3b30287284b4de
--- /dev/null
+++ b/fdelmodc3D/demo/fdelmodc_elastic_potentialS.scr
@@ -0,0 +1,63 @@
+#!/bin/bash
+#PBS -N fdelmodc
+#PBS -k eo
+#PBS -j eo
+#
+# Models plane wave at depth to receivers at the surface, including snapshots
+export PATH=../../utils:$PATH:
+
+makewave file_out=wavelet.su dt=0.001 nt=1024 fp=13 shift=1 w=g2 verbose=1
+
+makemod file_base=model.su \
+ cp0=1500 ro0=1000 cs0=600 sizex=2100 sizez=2100 \
+ dx=3 dz=3 orig=0,0 \
+ intt=def poly=0 cp=1650 ro=2000 cs=1000 \
+ x=0,2100 z=500,500 gradcp=0.5 grad=100 \
+ intt=def poly=1 cp=1800 ro=2500 cs=1200 \
+ x=0,800,1200,2100 z=900,1400,1400,1200 gradcp=0 grad=0 \
+ verbose=4
+
+export filecp=model_cp.su
+export filecs=model_cs.su
+export filero=model_ro.su
+
+export OMP_NUM_THREADS=1
+
+../fdelmodc \
+ file_cp=$filecp file_cs=$filecs file_den=$filero \
+ ischeme=1 \
+ src_type=1 src_orient=1 tmod=2.0 \
+ file_src=wavelet.su verbose=2 \
+ file_rcv=recS.su \
+ file_snap=snapS.su \
+ xrcv1=0 xrcv2=2100 dxrcv=15 \
+ zrcv1=400 zrcv2=400 \
+ rec_type_vx=1 rec_type_pp=1 rec_type_ss=1 rec_int_vx=1 \
+ dtrcv=0.004 \
+ xsrc=1000 zsrc=1700 \
+ ntaper=120 \
+ left=4 right=4 bottom=4 top=4 \
+ tsnap1=0.1 tsnap2=3.0 dtsnap=0.1 \
+ sna_type_ss=1 sna_type_pp=1
+
+exit;
+../fdelmodc \
+ file_cp=$filecp file_cs=$filecs file_den=$filero \
+ ischeme=3 \
+ file_src=wavelet.su verbose=4 \
+ file_rcv=recP.su \
+ file_snap=snapP.su \
+ xrcv1=0 xrcv2=2100 dxrcv=15 \
+ zrcv1=400 zrcv2=400 \
+ rec_type_vx=1 rec_type_pp=1 rec_type_ss=1 rec_int_vx=1 \
+ dtrcv=0.004 \
+ xsrc=1000 zsrc=1700 \
+ src_type=8 src_orient=1 tmod=2.0 \
+ ntaper=120 \
+ left=4 right=4 bottom=4 top=4 \
+ tsnap1=0.1 tsnap2=3.0 dtsnap=0.1 \
+ sna_type_ss=1 sna_type_pp=1
+
+
+exit;
+
diff --git a/fdelmodc3D/demo/fdelmodc_fault.scr b/fdelmodc3D/demo/fdelmodc_fault.scr
new file mode 100755
index 0000000000000000000000000000000000000000..e2d06417aeb42c0346951b658ce69b080d896303
--- /dev/null
+++ b/fdelmodc3D/demo/fdelmodc_fault.scr
@@ -0,0 +1,48 @@
+#!/bin/bash
+#PBS -l nodes=1
+#PBS -N InterfModeling
+#PBS -q fourweeks
+#PBS -V
+#
+export PATH=$HOME/../thorbcke/src/OpenSource/bin:$PATH
+
+dt=0.0015
+fmax=45
+cp=2000
+
+makemod sizex=6000 sizez=2000 dx=5 dz=5 cp0=$cp ro0=1000 file_base=fault.su orig=0,0 \
+ intt=def poly=2 x=0,600,1000,2000,4000,5000 \
+ z=550,550,550,300,300,500 cp=$cp ro=2000 \
+ intt=def poly=0 x=5000,6000 z=300,200 cp=$cp ro=1500 \
+ intt=def poly=0 x=0,2500 z=900,900 cp=$cp ro=2200 \
+ intt=def poly=0 x=2000,5000 z=1000,300 cp=$cp ro=1500 \
+ intt=def poly=0 x=2000,3000,6000 z=1000,770,770 cp=$cp ro=1800 \
+ intt=def poly=0 x=2000,6000 z=1000,1000 cp=$cp ro=2200 \
+ intt=def poly=0 x=0,6000 z=1400,1400 cp=$cp ro=2400 \
+
+suximage cmap=hsv4 < fault_ro.su &
+
+makewave w=g2 fmax=45 t0=0.10 dt=$dt nt=4096 db=-40 file_out=G2.su verbose=1
+
+../fdelmodc \
+ file_cp=fault_cp.su ischeme=1 \
+ file_den=fault_ro.su \
+ file_rcv=shots.su \
+ file_src=G2.su \
+ src_type=1 \
+ dtrcv=0.003 \
+ verbose=1 \
+ tmod=3.104 \
+ nshot=101 \
+ dxshot=60 \
+ rec_delay=0.1 \
+ rec_type_vz=0 \
+ dxrcv=60.0 \
+ xsrc=0 \
+ zsrc=0 \
+ ntaper=101 \
+ left=2 right=2 top=2 bottom=2
+
+suwind key=offset min=0 max=0 < shots_rp.su | suzero itmax=30 | suximage x1end=2
+
+
diff --git a/fdelmodc3D/demo/fdelmodc_glacier.scr b/fdelmodc3D/demo/fdelmodc_glacier.scr
new file mode 100755
index 0000000000000000000000000000000000000000..04e3158019c8b9733ed90c5612b4d8961d6834a9
--- /dev/null
+++ b/fdelmodc3D/demo/fdelmodc_glacier.scr
@@ -0,0 +1,69 @@
+#!/bin/bash
+#
+#OK:
+dt=0.0001
+dx=0.5
+cp=1665
+
+makewave file_out=wavelet.su dt=$dt nt=1024 fp=100 shift=1 w=g2 verbose=1
+
+makemod file_base=modelHom.su \
+ cp0=$cp ro0=1000 sizex=250 sizez=125 \
+ dx=$dx dz=$dx orig=-25,-25 \
+
+makemod file_base=model.su \
+ cp0=$cp ro0=1000 sizex=250 sizez=125 \
+ intt=def x=60,90 z=-25,-25 cp=1500 ro=1000 \
+ dx=$dx dz=$dx orig=-25,-25 \
+
+export DYLD_LIBRARY_PATH=/opt/intel/Compiler/11.1/046/Frameworks/mkl/lib/universal/:$DYLD_LIBRARY_PATH:/usr/local/cuda/lib:
+
+which smooth
+smooth nxsm=7 niter=5 < model_cp.su > nep.su
+exit
+mv nep.su model_cp.su
+
+export OMP_NUM_THREADS=2
+
+for model in _
+do
+export filecp=model${model}cp.su
+export filero=model${model}ro.su
+
+xsrc=0
+zsrc=0
+
+../fdelmodc \
+ file_cp=$filecp file_den=$filero \
+ ischeme=1 \
+ file_src=wavelet.su verbose=1 \
+ file_rcv=shot${model}x${xsrc}_z${zsrc}.su \
+ xrcv1=50,100,150 xrcv2=50,100,150 dzrcv=5,1.5,5 dxrcv=0,0,0 \
+ zrcv1=0,37,0 zrcv2=75,40,75 \
+ rec_type_vz=1 rec_type_vx=0 rec_int_vz=2 \
+ dtrcv=0.0005 \
+ xsrc=$xsrc zsrc=$zsrc nshot=76 dzshot=1 dxshot=0 \
+ src_type=1 tmod=0.3 \
+ npml=100 \
+ left=2 right=2 bottom=2 top=2 \
+
+xsrc=200
+zsrc=0
+
+../fdelmodc \
+ file_cp=$filecp file_den=$filero \
+ ischeme=1 \
+ file_src=wavelet.su verbose=1 \
+ file_rcv=shot${model}x${xsrc}_z${zsrc}.su \
+ xrcv1=50,100,150 xrcv2=50,100,150 dzrcv=5,1.5,5 dxrcv=0,0,0 \
+ zrcv1=0,37,0 zrcv2=75,40,75 \
+ rec_type_vz=1 rec_type_vx=0 rec_int_vz=2 \
+ dtrcv=0.0005 \
+ xsrc=$xsrc zsrc=$zsrc nshot=76 dzshot=1 dxshot=0 \
+ src_type=1 tmod=0.3 \
+ npml=100 \
+ left=2 right=2 bottom=2 top=2 \
+
+done
+
+
diff --git a/fdelmodc3D/demo/fdelmodc_jurg.scr b/fdelmodc3D/demo/fdelmodc_jurg.scr
new file mode 100755
index 0000000000000000000000000000000000000000..53735370fa39abc3a1c580f575652a9416241dd7
--- /dev/null
+++ b/fdelmodc3D/demo/fdelmodc_jurg.scr
@@ -0,0 +1,55 @@
+#!/bin/bash
+#PBS -l nodes=1
+#PBS -N InterfModeling
+#PBS -q fourweeks
+#PBS -V
+#
+# same as fdelmodc_topography, but with source and receivers on topography of sea-bottom
+
+export PATH=../../bin:$PATH
+
+dt=0.00005
+ntap=120
+
+makemod sizex=160 sizez=10 dx=0.1 dz=0.1 cp0=1000 ro0=1000 cs0=200 file_base=model.su \
+ orig=0,0 verbose=1 \
+ intt=def x=0,160 z=2,2 cp=1000 cs=300 ro=1000 \
+ intt=def x=0,160 z=5,5 cp=1000 cs=400 ro=1000
+
+
+makewave w=g2 fmax=230 t0=0.10 dt=$dt nt=4096 db=-40 file_out=G2.su verbose=1
+
+#extendModel file_in=model_ro.su nafter=$ntap nbefore=$ntap nabove=0 nbelow=$ntap > vel2_edge_ro.su
+#extendModel file_in=model_cp.su nafter=$ntap nbefore=$ntap nabove=0 nbelow=$ntap > vel2_edge_cp.su
+#extendModel file_in=model_cs.su nafter=$ntap nbefore=$ntap nabove=0 nbelow=$ntap > vel2_edge_cs.su
+
+../fdelmodc \
+ ischeme=3 \
+ src_type=2 \
+ file_cp=vel2_edge_cp.su \
+ file_cs=vel2_edge_cs.su \
+ file_den=vel2_edge_ro.su \
+ file_rcv=shot_xl.su \
+ file_src=G2.su \
+ dtrcv=0.0005 \
+ rec_type_vx=1 \
+ rec_type_vz=0 \
+ rec_type_tzz=0 \
+ rec_type_p=0 \
+ xsrc=80 \
+ zsrc=0 \
+ verbose=4 \
+ tmod=0.60 \
+ dxrcv=0.5 \
+ zrcv1=0 \
+ zrcv2=0 \
+ xrcv1=0 \
+ xrcv2=160 \
+ rec_delay=0.1 \
+ src_random=0 \
+ wav_random=0 \
+ dipsrc=1 \
+ ntaper=$ntap \
+ left=4 right=4 bottom=4 top=1
+
+
diff --git a/fdelmodc3D/demo/fdelmodc_multishot.scr b/fdelmodc3D/demo/fdelmodc_multishot.scr
new file mode 100755
index 0000000000000000000000000000000000000000..f569c47e601fcc0308d11d57538da7254df4c684
--- /dev/null
+++ b/fdelmodc3D/demo/fdelmodc_multishot.scr
@@ -0,0 +1,66 @@
+#!/bin/bash
+#PBS -N fdelmod
+#PBS -q verylong
+#PBS -l nodes=1
+#PBS -k eo
+#PBS -j eo
+#
+# illustrates source and receiver positions, used in Figure 10 of the manual
+
+export PATH=../../utils:$PATH:
+
+#OK:
+dt=0.0005
+dx=5
+ntaper=10
+
+makewave file_out=wavelet.su dt=$dt nt=1024 shift=1 fmax=10 verbose=1
+
+# build a model with a steep salt-like flank of the side
+./model_flank.scr
+
+export filecp=grad_salt.su
+export filero=salt_ro.su
+
+#model 50 shots for sources on a horizontal line left from the flank
+
+../fdelmodc \
+ file_cp=$filecp file_den=$filero \
+ ischeme=1 \
+ file_src=wavelet.su verbose=4 \
+ file_rcv=rec.su \
+ xrcv1=6000 xrcv2=6000 dxrcv=0 \
+ zrcv1=100 zrcv2=6000 dzrcv=100 \
+ rec_type_vz=0 rec_int_vx=1 \
+ dtrcv=0.004 \
+ xsrc=500 zsrc=100 nshot=50 dxshot=100 dzshot=0 \
+ src_type=1 tmod=0.001 \
+ ntaper=$ntaper \
+ left=4 right=4 bottom=4 top=1 \
+ fmax=10
+
+sugain < SrcRecPositions.su scale=5000 > nep.su
+
+susum nep.su grad_salt.su > sum.su
+
+supsimage < sum.su bclip=5000 wclip=0 \
+ wbox=4 hbox=4 titlesize=-1 labelsize=10 verbose=1 \
+ label1="depth [m]" label2="lateral position [m]" blockinterp=1 \
+ > salt_mod_srcrec.eps
+
+exit;
+
+#alternative ways of plotting src and receiver positions
+supsimage < SrcRecPositions.su \
+ grgb=1.0,1.0,1.0 brgb=1.0,0.0,0.0 wrgb=0.0,1.0,0.0 \
+ ghls=1.0,1.0,0.0 bhls=1.0,1.0,0.0 whls=1.0,1.0,0.0 \
+ wbox=4 hbox=4 titlesize=-1 labelsize=10 verbose=1 \
+ label1="time [s]" label2="lateral position [m]" blockinterp=1 \
+ > salt_mod_srcrec.eps
+
+supsimage < grad_salt.su \
+ wbox=4 hbox=4 titlesize=-1 labelsize=10 verbose=1 \
+ label1="time [s]" label2="lateral position [m]" > salt.eps
+
+
+
diff --git a/fdelmodc3D/demo/fdelmodc_obc.scr b/fdelmodc3D/demo/fdelmodc_obc.scr
new file mode 100755
index 0000000000000000000000000000000000000000..057d5b9407601b5c3e1ff23e717af37af7d8157c
--- /dev/null
+++ b/fdelmodc3D/demo/fdelmodc_obc.scr
@@ -0,0 +1,84 @@
+#!/bin/bash
+#PBS -l nodes=1
+#PBS -N InterfModeling
+#PBS -q fourweeks
+#PBS -V
+#
+# same as fdelmodc_topography, but with source and receivers on topography of sea-bottom
+
+export PATH=../../bin:$PATH
+
+dt=0.0004
+ntap=120
+fmax=45
+
+makemod sizex=10000 sizez=4100 dx=5 dz=5 cp0=1500 ro0=1000 cs0=0 file_base=real2.su \
+ orig=0,-800 gradunit=0 verbose=1 \
+ intt=def poly=2 cp=2450 ro=1000 cs=1600 gradcp=14 gradcs=9 grad=0 \
+ x=0,1000,1700,1800,2000,3000,4000,4500,6000,6800,7000,7500,8100,8800,10000 \
+ z=-100,-200,-250,-200,-200,-120,-300,-600,-650,-500,-350,-200,-200,-150,-200 \
+ intt=def poly=2 cp=2450 ro=1000 cs=1600 gradcp=14 gradcs=9 grad=40 \
+ x=0,1000,1700,1800,2000,3000,4000,4500,6000,6800,7000,7500,8100,8800,10000 \
+ z=-100,-200,-250,-200,-200,-120,-300,-600,-650,-500,-350,-200,-200,-150,-200 \
+ intt=rough var=200,3.2,1 poly=2 x=0,3000,8000,10000 \
+ z=400,250,300,500 cp=4500,4200,4800,4500 cs=3000,2900,3100,3000 ro=1400 gradcp=5 gradcs=2 grad=0 \
+ intt=def poly=2 x=0,2000,3000,5000,7000,8000,10000 \
+ z=1100,1100,1100,1600,1100,1100,1100 cp=4000 cs=2800 ro=2000 gradcp=8 gradcs=8 grad=0 \
+ intt=def poly=0 x=0,10000 z=1750,2050 cp=4500,5100 cs=3000,3300 ro=1500 gradcp=13 gradcs=7 grad=0 \
+ intt=def poly=0 x=0,10000 z=1850,2150 cp=6000,4200 cs=4000,2900 ro=1500 gradcp=14 gradcs=8 grad=0 \
+ intt=def poly=0 x=0,10000 z=1950,2250 cp=4800,4800 cs=3100,3100 ro=1500 gradcp=5 gradcs=4 grad=0 \
+ intt=def poly=0 x=0,10000 z=2000,2300 cp=6100,5000 cs=3100,3300 ro=1500 gradcp=13 gradcs=9 grad=0 \
+ intt=def poly=0 x=0,10000 z=2100,2400 cp=3800,5000 cs=1400,3300 ro=1500 gradcp=20 gradcs=12 grad=0 \
+ intt=def poly=0 x=0,10000 z=2150,2450 cp=5000 cs=3300 ro=1500 gradcp=14 gradcs=10 grad=0 \
+ intt=def poly=0 x=0,10000 z=2350,2650 cp=5800 cs=3300 ro=1500 gradcp=5 gradcs=5 grad=0 \
+ intt=def poly=0 x=0,10000 z=2600,2600 cp=5500 cs=3300 ro=2200 gradcp=5 gradcs=5 grad=0
+
+#sushw key=f1 a=0 < real2_cp.su | \
+# sushw key=f1 a=0 | \
+# supsimage hbox=6 wbox=8 labelsize=10 f2num=-5000 d2num=1000 \
+# wrgb=0,0,1.0 grgb=0,1.0,0 brgb=1.0,0,0 \
+# bclip=7053.02 wclip=0 label1="depth [m]" label2="lateral position [m]" \
+# > model2_cp.eps
+
+
+makewave w=g2 fmax=45 t0=0.10 dt=$dt nt=4096 db=-40 file_out=G2.su verbose=1
+
+#extendModel file_in=real2_ro.su nafter=$ntap nbefore=$ntap nabove=0 nbelow=$ntap > vel2_edge_ro.su
+#extendModel file_in=real2_cp.su nafter=$ntap nbefore=$ntap nabove=0 nbelow=$ntap > vel2_edge_cp.su
+#extendModel file_in=real2_cs.su nafter=$ntap nbefore=$ntap nabove=0 nbelow=$ntap > vel2_edge_cs.su
+
+../fdelmodc \
+ ischeme=3 \
+ file_cp=vel2_edge_cp.su \
+ file_cs=vel2_edge_cs.su \
+ file_den=vel2_edge_ro.su \
+ file_rcv=shot_obc_x5000_topo.su \
+ file_src=G2.su \
+ dtrcv=0.004 \
+ rec_type_vx=1 \
+ rec_type_vz=1 \
+ rec_type_tzz=1 \
+ xsrc=5000 \
+ zsrc=-795 \
+ verbose=4 \
+ tmod=3.004 \
+ dxrcv=20.0 \
+ zrcv1=-800 \
+ zrcv2=-800 \
+ xrcv1=0 \
+ xrcv2=10000 \
+ sinkdepth=2 \
+ sinkvel=1 \
+ src_random=0 \
+ wav_random=0 \
+ dipsrc=1 \
+ ntaper=$ntap \
+ left=4 right=4 top=1 bottom=4
+
+
+sushw key=f1,delrt a=0.0,0.0 < shot_real2_x5000_topo_rvz.su | \
+ basop choice=1 shift=-0.1 | \
+ supsimage clip=2e-12 f1=0 f2=-5000 x1end=3.004 hbox=8 wbox=6 \
+ label1="time (s)" label2="lateral position (m)" \
+ labelsize=10 f2num=-5000 d2num=1000 d1num=0.5 > shot_real2_x5000_topo.eps
+
diff --git a/fdelmodc3D/demo/fdelmodc_obc_deltares.scr b/fdelmodc3D/demo/fdelmodc_obc_deltares.scr
new file mode 100755
index 0000000000000000000000000000000000000000..ef67ce4e1032f05f314a7a1ed756dd352d3e6683
--- /dev/null
+++ b/fdelmodc3D/demo/fdelmodc_obc_deltares.scr
@@ -0,0 +1,65 @@
+#!/bin/bash
+#PBS -l nodes=1
+#PBS -N InterfModeling
+#PBS -q fourweeks
+#PBS -V
+#
+# same as fdelmodc_topography, but with source and receivers on topography of sea-bottom
+
+export PATH=../../bin:$PATH
+
+dt=0.00002
+ntap=120
+fmax=30
+
+makemod sizex=1118 sizez=50 dx=0.1 dz=0.1 cs0=0 cp0=1500 ro0=1000 file_base=dunes.su orig=0,0 \
+ verbose=1 intt=def poly=0 \
+x=0,4.989278785,9.978557567,14.96783635,19.95711513,24.94639392,29.9356727,34.92495149,39.91423027,44.90350905,49.89278784,54.88206662,59.8713454,64.86062418,69.84990297,74.83918175,79.82846053,84.81773932,89.8070181,94.79629688,99.78557567,104.7748544,109.7641332,114.753412,119.7426908,124.7319696,129.7212484,134.7105272,139.6998059,144.6890847,149.6783635,154.6676423,159.6569211,164.6461998,169.6354786,174.6247574,179.6140362,184.603315,189.5925938,194.5818725,199.5711513,204.5604301,209.5497089,214.5389877,219.5282665,224.5175452,229.506824,234.4961028,239.4853816,244.4746604,249.4639392,254.4532179,259.4424967,264.4317755,269.4210543,274.4103331,279.3996119,284.3888907,289.3781694,294.3674482,299.356727,304.3460058,309.3352846,314.3245633,319.3138421,324.3031209,329.2923997,334.2816785,339.2709573,344.260236,349.2495148,354.2387936,359.2280724,364.2173512,369.20663,374.1959087,379.1851875,384.1744663,389.1637451,394.1530239,399.1423027,404.1315814,409.1208602,414.110139,419.0994178,424.0886966,429.0779754,434.0672541,439.0565329,444.0458117,449.0350905,454.0243693,459.0136481,464.0029268,468.9922056,473.9814844,478.9707632,483.960042,488.9493208,493.9385995,498.9278783,503.9171571,508.9064359,513.8957147,518.8849935,523.8742722,528.863551,533.8528298,538.8421086,543.8313874,548.8206662,553.8099449,558.7992237,563.7885025,568.7777813,573.7670601,578.7563389,583.7456176,588.7348964,593.7241752,598.713454,603.7027328,608.6920116,613.6812903,618.6705691,623.6598479,628.6491267,633.6384055,638.6276843,643.616963,648.6062418,653.5955206,658.5847994,663.5740782,668.563357,673.5526357,678.5419145,683.5311933,688.5204721,693.5097509,698.4990297,703.4883084,708.4775872,713.466866,718.4561448,723.4454236,728.4347024,733.4239811,738.4132599,743.4025387,748.3918175,753.3810963,758.3703751,763.3596538,768.3489326,773.3382114,778.3274902,783.316769,788.3060478,793.2953265,798.2846053,803.2738841,808.2631629,813.2524417,818.2417205,823.2309992,828.220278,833.2095568,838.1988356,843.1881144,848.1773932,853.1666719,858.1559507,863.1452295,868.1345083,873.1237871,878.1130659,883.1023446,888.0916234,893.0809022,898.070181,903.0594598,908.0487386,913.0380173,918.0272961,923.0165749,928.0058537,932.9951325,937.9844113,942.97369,947.9629688,952.9522476,957.9415264,962.9308052,967.920084,972.9093627,977.8986415,982.8879203,987.8771991,992.8664779,997.8557567,1002.845035,1007.834314,1012.823593,1017.812872,1022.802151,1027.791429,1032.780708,1037.769987,1042.759266,1047.748544,1052.737823,1057.727102,1062.716381,1067.70566,1072.694938,1077.684217,1082.673496,1087.662775,1092.652054,1097.641332,1102.630611,1107.61989,1112.609169,1118 \
+z=29.3824,29.3588,29.3176,29.252,29.1942,29.1445,29.1022,29.0754,29.0633,29.024,28.9744,28.9188,28.8637,28.8216,28.7949,28.7335,28.6521,28.612,28.5514,28.5014,28.4718,28.4137,28.3281,28.252,28.1901,28.1005,28.0643,28.0058,27.8679,27.8262,27.7721,27.674,27.5649,27.4764,27.3647,27.276,27.221,27.1218,27.0147,26.9272,26.8145,26.764,26.8204,27.1333,27.586,28.0833,28.6328,29.0162,29.2111,29.4167,29.6366,29.7805,29.8626,29.9578,30.0481,30.0327,30.0169,30.0378,29.9736,29.9087,29.858,29.762,29.6985,29.5942,29.5022,29.4256,29.3452,29.2426,29.1809,29.1029,28.952,28.8904,28.7907,28.6837,28.5855,28.481,28.3696,28.2818,28.1881,28.0854,28.0425,27.9827,27.8543,27.7555,27.6597,27.5591,27.4323,27.2993,27.2294,27.1636,27.0862,27.0065,26.9591,26.8628,26.7604,26.7147,26.7983,27.2001,27.7855,28.3254,28.8055,29.1561,29.4988,29.6726,29.8463,29.9967,30.0654,30.1303,30.1931,30.2603,30.3239,30.314,30.2709,30.2152,30.1697,30.1097,30.0521,29.9975,29.9129,29.8553,29.8362,29.7413,29.6596,29.587,29.5253,29.4601,29.3847,29.3043,29.2461,29.1701,29.0959,29.0147,28.941,28.8566,28.7724,28.7032,28.6491,28.585,28.5201,28.4252,28.3344,28.2789,28.2004,28.1163,28.0728,28.0122,27.9259,27.8606,27.7929,27.7139,27.6539,27.6084,27.5292,27.4676,27.3796,27.2755,27.1434,27.0777,27.0211,26.9787,26.9362,26.8472,26.8677,27.0764,27.4351,27.8719,28.4272,28.8629,29.16,29.3875,29.5391,29.6389,29.7532,29.8745,29.9364,29.9736,30.0274,29.9687,29.9057,29.8955,29.85,29.7563,29.7003,29.6253,29.5333,29.4688,29.317,29.2253,29.1851,29.0555,28.9646,28.8427,28.7373,28.6687,28.5522,28.4677,28.3907,28.2464,28.1628,28.0732,27.9337,27.8505,27.7818,27.6664,27.5443,27.4945,27.4253,27.4398,27.5949,28.0526,28.6129,29.0875,29.4419,29.6561,29.8852,30.0617,30.2174,30.3048,30.361,30.3477,30.3687,30.3881,30.3108,30.2617,30.2483 \
+ cp=1700 ro=1000 cs=333 \
+intt=def poly=0 x=0,1118 z=32,32 cp=1800 ro=1200 cs=300 \
+intt=def poly=0 x=0,1118 z=35,35 cp=2200 ro=1200 cs=50 \
+intt=def poly=0 x=0,1118 z=36,36 cp=2500 ro=1200 cs=600 \
+intt=def poly=0 x=350,650 z=32,32 cp=2000 ro=1200 cs=700 \
+intt=def poly=1 x=350,400,450,500,550,600,650 z=32,42,43,43,43,42,32 cp=2500 ro=1200 cs=800
+
+
+#z=9.3824,9.3588,9.3176,9.252,9.1942,9.1445,9.1022,9.0754,9.0633,9.024,8.9744,8.9188,8.8637,8.8216,8.7949,8.7335,8.6521,8.612,8.5514,8.5014,8.4718,8.4137,8.3281,8.252,8.1901,8.1005,8.0643,8.0058,7.8679,7.8262,7.7721,7.674,7.5649,7.4764,7.3647,7.276,7.221,7.1218,7.0147,6.9272,6.8145,6.764,6.8204,7.1333,7.586,8.0833,8.6328,9.0162,9.2111,9.4167,9.6366,9.7805,9.8626,9.9578,10.0481,10.0327,10.0169,10.0378,9.9736,9.9087,9.858,9.762,9.6985,9.5942,9.5022,9.4256,9.3452,9.2426,9.1809,9.1029,8.952,8.8904,8.7907,8.6837,8.5855,8.481,8.3696,8.2818,8.1881,8.0854,8.0425,7.9827,7.8543,7.7555,7.6597,7.5591,7.4323,7.2993,7.2294,7.1636,7.0862,7.0065,6.9591,6.8628,6.7604,6.7147,6.7983,7.2001,7.7855,8.3254,8.8055,9.1561,9.4988,9.6726,9.8463,9.9967,10.0654,10.1303,10.1931,10.2603,10.3239,10.314,10.2709,10.2152,10.1697,10.1097,10.0521,9.9975,9.9129,9.8553,9.8362,9.7413,9.6596,9.587,9.5253,9.4601,9.3847,9.3043,9.2461,9.1701,9.0959,9.0147,8.941,8.8566,8.7724,8.7032,8.6491,8.585,8.5201,8.4252,8.3344,8.2789,8.2004,8.1163,8.0728,8.0122,7.9259,7.8606,7.7929,7.7139,7.6539,7.6084,7.5292,7.4676,7.3796,7.2755,7.1434,7.0777,7.0211,6.9787,6.9362,6.8472,6.8677,7.0764,7.4351,7.8719,8.4272,8.8629,9.16,9.3875,9.5391,9.6389,9.7532,9.8745,9.9364,9.9736,10.0274,9.9687,9.9057,9.8955,9.85,9.7563,9.7003,9.6253,9.5333,9.4688,9.317,9.2253,9.1851,9.0555,8.9646,8.8427,8.7373,8.6687,8.5522,8.4677,8.3907,8.2464,8.1628,8.0732,7.9337,7.8505,7.7818,7.6664,7.5443,7.4945,7.4253,7.4398,7.5949,8.0526,8.6129,9.0875,9.4419,9.6561,9.8852,10.0617,10.2174,10.3048,10.361,10.3477,10.3687,10.3881,10.3108,10.2617,10.2483 \
+
+
+makewave w=g2 fp=14 t0=0.10 dt=$dt nt=4096 file_out=G2.su verbose=1
+
+../fdelmodc \
+ ischeme=3 \
+ file_cp=dunes_cp.su \
+ file_cs=dunes_cs.su \
+ file_den=dunes_ro.su \
+ file_rcv=shot_obc_dunes.su \
+ file_src=G2.su \
+ dtrcv=0.001 \
+ rec_type_vx=1 \
+ rec_type_vz=1 \
+ rec_type_tzz=1 \
+ xsrc=550 \
+ zsrc=25 \
+ verbose=4 \
+ tmod=3.004 \
+ dxrcv=1.0 \
+ zrcv1=25 \
+ zrcv2=25 \
+ xrcv1=0 \
+ xrcv2=1118 \
+ tsnap1=0.1 tsnap2=3.0 dtsnap=0.2 dxsnap=10 dzsnap=10 \
+ ntaper=$ntap \
+ left=4 right=4 top=1 bottom=4
+
+exit;
+
+suxmovie < snap_svz.su loop=1 clip=1e-5
+
+sushw key=f1,delrt a=0.0,0.0 < shot_real2_x5000_topo_rvz.su | \
+ basop choice=1 shift=-0.1 | \
+ supsimage clip=2e-12 f1=0 f2=-5000 x1end=3.004 hbox=8 wbox=6 \
+ label1="time (s)" label2="lateral position (m)" \
+ labelsize=10 f2num=-5000 d2num=1000 d1num=0.5 > shot_real2_x5000_topo.eps
+
diff --git a/fdelmodc3D/demo/fdelmodc_plane.scr b/fdelmodc3D/demo/fdelmodc_plane.scr
new file mode 100755
index 0000000000000000000000000000000000000000..cf4f1335d47ca76d43e70701085d92fff276dcd6
--- /dev/null
+++ b/fdelmodc3D/demo/fdelmodc_plane.scr
@@ -0,0 +1,95 @@
+#!/bin/bash
+#PBS -N fdelmodc
+#PBS -k eo
+#PBS -j eo
+#
+# Models plane wave at depth to receivers at the surface, including snapshots
+export PATH=../../utils:$PATH:
+
+makewave file_out=wavelet.su dt=0.001 nt=1024 fp=13 shift=1 w=g2 verbose=1
+
+makemod file_base=model.su \
+ cp0=1500 ro0=1000 cs0=600 sizex=2100 sizez=2100 \
+ dx=3 dz=3 orig=0,0 \
+ intt=def poly=0 cp=1650 ro=2000 cs=1000 \
+ x=0,2100 z=500,500 gradcp=0.5 grad=100 \
+ intt=def poly=1 cp=1800 ro=2500 cs=1200 \
+ x=0,800,1200,2100 z=900,1400,1400,1200 gradcp=0 grad=0 \
+ verbose=4
+
+export filecp=model_cp.su
+export filecs=model_cs.su
+export filero=model_ro.su
+
+export OMP_NUM_THREADS=1
+
+time ../fdelmodc \
+ file_cp=$filecp file_cs=$filecs file_den=$filero \
+ ischeme=3 \
+ file_src=wavelet.su verbose=4 \
+ file_rcv=rec.su \
+ file_snap=snap.su \
+ xrcv1=0 xrcv2=2100 dxrcv=15 \
+ zrcv1=400 zrcv2=400 \
+ rec_type_vx=1 rec_type_pp=1 rec_type_ss=1 rec_int_vx=1 \
+ dtrcv=0.004 \
+ xsrc=1000 zsrc=1700 nshot=1 plane_wave=1 nsrc=301 \
+ src_type=1 tmod=3.0 src_velo=1800 src_angle=5 \
+ ntaper=21 src_window=101 \
+ left=4 right=4 bottom=4 top=4 \
+ tsnap1=0.1 tsnap2=3.0 dtsnap=0.1 \
+ sna_type_ss=1 sna_type_pp=1
+
+exit;
+
+# to show a movie of the snapshots
+#suxmovie < snap_svz.su perc=99 loop=1
+
+# to reproduce the images in the manual use:
+supsimage < model_cp.su \
+ wbox=4 hbox=4 titlesize=-1 labelsize=10 verbose=1 \
+ d2=3 f2=0 wrgb=1.0,0,0 grgb=0,1.0,0 brgb=0,0,1.0 bps=24 \
+ label1="depth [m]" label2="lateral position [m]" > model_plane.eps
+
+supsimage < SrcRecPositions.su \
+ wbox=4 hbox=4 titlesize=-1 labelsize=10 verbose=1 \
+ d2=3 f2=0 wclip=-1 bclip=1 \
+ gabel1="depth [m]" label2="lateral position [m]" > SrcRecPositions.eps
+
+suop2 model_cp.su SrcRecPositions.su w1=1 w2=2000 op=sum | \
+ supsimage wclip=1400 bclip=2000 \
+ wbox=4 hbox=4 titlesize=-1 labelsize=10 verbose=1 \
+ d2=3 f2=0 wrgb=1.0,0,0 grgb=0,1.0,0 brgb=0,0,1.0 bps=24 \
+ label1="depth [m]" label2="lateral position [m]" > model_plane_src.eps
+
+supsimage < rec_rvz.su \
+ wbox=3 hbox=4 titlesize=-1 labelsize=10 clip=1e-10 verbose=1 \
+ label1="time [s]" label2="lateral position [m]" > rec_plane_rvz.eps
+
+supsimage < rec_rpp.su \
+ wbox=3 hbox=4 titlesize=-1 labelsize=10 clip=1e-11 verbose=1 \
+ label1="time [s]" label2="lateral position [m]" > rec_plane_rpp.eps
+
+supsimage < rec_rss.su \
+ wbox=3 hbox=4 titlesize=-1 labelsize=10 clip=1e-11 verbose=1 \
+ label1="time [s]" label2="lateral position [m]" > rec_plane_rss.eps
+
+#snapshots
+for file in snap_svz snap_spp snap_sss; do
+
+suwind < $file.su key=fldr min=$ifldr max=$ifldr > nep1.su
+while (( ifldr < 12 ))
+do
+(( ifldr += 4 ))
+echo $ifldr
+suwind < $file.su key=fldr min=$ifldr max=$ifldr > nep2.su
+susum nep2.su nep1.su > snaps.su
+mv snaps.su nep1.su
+done
+
+supsimage < nep1.su \
+ wbox=4 hbox=4 titlesize=-1 labelsize=10 verbose=1 \
+ d2=3 f2=0 perc=99 \
+ label1="depth [m]" label2="lateral position [m]" > ${file}_snap.eps
+done
+
diff --git a/fdelmodc3D/demo/fdelmodc_plane_txt.scr b/fdelmodc3D/demo/fdelmodc_plane_txt.scr
new file mode 100755
index 0000000000000000000000000000000000000000..d2d687b835dd330e843903dd53c3a163ea2ffd68
--- /dev/null
+++ b/fdelmodc3D/demo/fdelmodc_plane_txt.scr
@@ -0,0 +1,98 @@
+#!/bin/bash
+#PBS -N fdelmodc
+#PBS -k eo
+#PBS -j eo
+#
+# Models plane wave at depth to receivers at the surface, including snapshots
+export PATH=../../utils:$PATH:
+
+makewave file_out=wavelet.su dt=0.001 nt=1024 fp=13 shift=1 w=g2 verbose=1
+
+makemod file_base=model.su \
+ cp0=1500 ro0=1000 sizex=2100 sizez=2100 \
+ dx=3 dz=3 orig=0,0 \
+ intt=def poly=0 cp=1650 ro=2000 \
+ x=0,2100 z=500,500 gradcp=0.5 grad=100 \
+ intt=def poly=1 cp=1800 ro=2500 \
+ x=0,800,1200,2100 z=900,1400,1400,1200 gradcp=0 grad=0 \
+ verbose=4
+
+export filecp=model_cp.su
+export filecs=model_cs.su
+export filero=model_ro.su
+
+export OMP_NUM_THREADS=1
+
+rm Src.txt
+for i in `seq 1 700 `; do (( x = i*3 )); (( z = i*3 )); echo $x $z >> Src.txt ; done
+
+time ../fdelmodc \
+ file_cp=$filecp file_den=$filero \
+ ischeme=1 \
+ file_src=wavelet.su verbose=4 \
+ file_rcv=rec.su \
+ file_snap=snap.su \
+ xrcv1=0 xrcv2=2100 dxrcv=15 \
+ zrcv1=400 zrcv2=400 \
+ rec_type_vx=1 rec_type_pp=1 rec_type_ss=1 rec_int_vx=1 \
+ dtrcv=0.004 \
+ src_txt=Src.txt \
+ src_type=1 tmod=3.0 src_velo=1800 src_angle=5 \
+ ntaper=21 src_window=11 \
+ left=4 right=4 bottom=4 top=4 \
+ tsnap1=0.1 tsnap2=3.0 dtsnap=0.1 \
+ sna_type_ss=1 sna_type_pp=1
+
+exit;
+
+# to show a movie of the snapshots
+#suxmovie < snap_svz.su perc=99 loop=1
+
+# to reproduce the images in the manual use:
+supsimage < model_cp.su \
+ wbox=4 hbox=4 titlesize=-1 labelsize=10 verbose=1 \
+ d2=3 f2=0 wrgb=1.0,0,0 grgb=0,1.0,0 brgb=0,0,1.0 bps=24 \
+ label1="depth [m]" label2="lateral position [m]" > model_plane.eps
+
+supsimage < SrcRecPositions.su \
+ wbox=4 hbox=4 titlesize=-1 labelsize=10 verbose=1 \
+ d2=3 f2=0 wclip=-1 bclip=1 \
+ gabel1="depth [m]" label2="lateral position [m]" > SrcRecPositions.eps
+
+suop2 model_cp.su SrcRecPositions.su w1=1 w2=2000 op=sum | \
+ supsimage wclip=1400 bclip=2000 \
+ wbox=4 hbox=4 titlesize=-1 labelsize=10 verbose=1 \
+ d2=3 f2=0 wrgb=1.0,0,0 grgb=0,1.0,0 brgb=0,0,1.0 bps=24 \
+ label1="depth [m]" label2="lateral position [m]" > model_plane_src.eps
+
+supsimage < rec_rvz.su \
+ wbox=3 hbox=4 titlesize=-1 labelsize=10 clip=1e-10 verbose=1 \
+ label1="time [s]" label2="lateral position [m]" > rec_plane_rvz.eps
+
+supsimage < rec_rpp.su \
+ wbox=3 hbox=4 titlesize=-1 labelsize=10 clip=1e-11 verbose=1 \
+ label1="time [s]" label2="lateral position [m]" > rec_plane_rpp.eps
+
+supsimage < rec_rss.su \
+ wbox=3 hbox=4 titlesize=-1 labelsize=10 clip=1e-11 verbose=1 \
+ label1="time [s]" label2="lateral position [m]" > rec_plane_rss.eps
+
+#snapshots
+for file in snap_svz snap_spp snap_sss; do
+
+suwind < $file.su key=fldr min=$ifldr max=$ifldr > nep1.su
+while (( ifldr < 12 ))
+do
+(( ifldr += 4 ))
+echo $ifldr
+suwind < $file.su key=fldr min=$ifldr max=$ifldr > nep2.su
+susum nep2.su nep1.su > snaps.su
+mv snaps.su nep1.su
+done
+
+supsimage < nep1.su \
+ wbox=4 hbox=4 titlesize=-1 labelsize=10 verbose=1 \
+ d2=3 f2=0 perc=99 \
+ label1="depth [m]" label2="lateral position [m]" > ${file}_snap.eps
+done
+
diff --git a/fdelmodc3D/demo/fdelmodc_pml.scr b/fdelmodc3D/demo/fdelmodc_pml.scr
new file mode 100755
index 0000000000000000000000000000000000000000..50c3d96a7838e4b4b7a2cb4d83ae38ed3a2149c9
--- /dev/null
+++ b/fdelmodc3D/demo/fdelmodc_pml.scr
@@ -0,0 +1,54 @@
+#!/bin/bash
+#PBS -N fdelmod
+#PBS -q verylong
+#PBS -l nodes=1
+#PBS -k eo
+#PBS -j eo
+#
+# Illustrates the effect of (absorbing) tapering of the edges, used in Figure 4 of the manual.
+
+#OK:
+dt=0.0002
+dx=1
+cp=1500
+
+makewave file_out=wavelet.su dt=$dt nt=1024 fp=85 shift=1 w=g2 verbose=1
+
+makemod file_base=model.su \
+ cp0=$cp ro0=1000 cs0=600 sizex=1000 sizez=1000 \
+ dx=$dx dz=$dx orig=0,0 \
+
+export filecp=model_cp.su
+export filecs=model_cs.su
+export filero=model_ro.su
+
+ntaper=0
+
+../fdelmodc \
+ file_cp=$filecp file_cs=$filecs file_den=$filero \
+ ischeme=1 \
+ file_src=wavelet.su verbose=4 \
+ file_rcv=rec.su \
+ file_snap=snap_nodisp.su \
+ xrcv1=0 xrcv2=1000 dxrcv=5 \
+ zrcv1=300 zrcv2=300 \
+ rec_type_vx=1 rec_type_pp=1 rec_type_ss=1 rec_int_vx=1 \
+ dtrcv=0.004 \
+ xsrc=500 zsrc=500 nshot=1 \
+ src_type=1 tmod=1.0 \
+ left=1 right=1 bottom=1 top=1 \
+ tsnap1=0.2 tsnap2=1.0 dtsnap=0.1 \
+ sna_type_ss=1 sna_type_pp=1 fmax=25
+
+suwind key=fldr min=3 max=3 < snap_nodisp_sp.su | \
+ supsimage \
+ wbox=4 hbox=4 titlesize=-1 labelsize=10 verbose=1 \
+ d2=$dx f2=0 clip=0.003 \
+ label1="depth [m]" label2="lateral position [m]" > snap_tap${ntaper}.eps
+
+supsimage < rec_rp.su \
+ wbox=3 hbox=4 titlesize=-1 labelsize=10 clip=0.003 verbose=1 \
+ label1="time [s]" label2="lateral position [m]" > rec_tap${ntaper}_rp.eps
+
+exit;
+
diff --git a/fdelmodc3D/demo/fdelmodc_pmltest.scr b/fdelmodc3D/demo/fdelmodc_pmltest.scr
new file mode 100755
index 0000000000000000000000000000000000000000..3e428820da9df0f802a58b719a1cca8b8e9d392f
--- /dev/null
+++ b/fdelmodc3D/demo/fdelmodc_pmltest.scr
@@ -0,0 +1,52 @@
+#!/bin/bash
+
+export PATH=:$HOME/src/OpenSource/bin:$HOME/bin:$PATH:
+
+dx=2.5
+dt=0.00050
+
+makemod sizex=6000 sizez=1250 dx=$dx dz=$dx cp0=1500 ro0=1000 \
+ orig=-3000,0 file_base=tutodel.su verbose=2 \
+ intt=def x=-3000,-2000,-1000,0,1000,2000,3000 z=240,130,250,300,350,380,320 poly=2 cp=1950 ro=4500 grad=0 \
+ intt=def x=-3000,-2200,-1500,0,1300,2100,3000 z=620,640,590,600,740,700,600 poly=2 cp=2000 ro=1400 grad=0 \
+ intt=def x=-3000,-1800,0,2200,3000 z=920,1000,900,1000,1010 poly=2 cp=2300 ro=1600 grad=0
+
+makemod sizex=600 sizez=1250 dx=$dx dz=$dx cp0=1500 ro0=1000 \
+ orig=-300,0 file_base=tutodel.su verbose=2 \
+
+
+ intt=def x=-300,-200,-100,0,100,200,300 z=240,130,250,300,350,380,320 poly=2 cp=1950 ro=4500 grad=0 \
+ intt=def x=-300,-220,-150,0,130,210,300 z=620,640,590,600,740,700,600 poly=2 cp=2000 ro=1400 grad=0 \
+ intt=def x=-300,-180,0,220,300 z=920,1000,900,1000,1010 poly=2 cp=2300 ro=1600 grad=0
+
+
+export OMP_NUM_THREADS=1
+makewave fp=30 dt=$dt file_out=wave.su nt=4096 t0=0.1 scale=1
+
+file_cp=tutodel_cp.su
+file_ro=tutodel_ro.su
+
+../fdelmodc \
+ file_cp=$file_cp ischeme=1 iorder=4 \
+ file_den=$file_ro \
+ file_src=wave.su \
+ file_snap=snapinj_rate1_planevz.su \
+ file_rcv=recvE.su \
+ src_type=1 \
+ src_injectionrate=0 \
+ dtrcv=$dt \
+ rec_delay=0.1 \
+ verbose=4 \
+ tmod=0.9000 \
+ dxrcv=15 \
+ tsnap1=0.000 tsnap2=0.9 dtsnap=0.005 \
+ xsnap1=-300 xsnap2=300 dxsnap=5 dzsnap=5 \
+ zsnap1=0 zsnap2=300 dxsnap=5 dzsnap=5 \
+ sna_type_vx=1 snapwithbnd=1 \
+ xsrc=-100 zsrc=150 \
+ npml=35 \
+ m=2 \
+ R=1e-5 \
+ left=2 right=2 top=2 bottom=2
+
+
diff --git a/fdelmodc3D/demo/fdelmodc_rand.scr b/fdelmodc3D/demo/fdelmodc_rand.scr
new file mode 100755
index 0000000000000000000000000000000000000000..97df96173ad19435a577a3c563549eaee262b33c
--- /dev/null
+++ b/fdelmodc3D/demo/fdelmodc_rand.scr
@@ -0,0 +1,56 @@
+#!/bin/bash
+#PBS -l nodes=1
+#PBS -N InterfModeling
+#PBS -q fourweeks
+#PBS -V
+#
+# demo for generation of random source signature at random positions
+
+export PATH=../../bin:$PATH
+
+makewave w=g2 fmax=45 t0=0.10 dt=0.001 nt=4096 db=-40 file_out=G2.su verbose=1
+
+makemod sizex=10000 sizez=4100 dx=10 dz=10 cp0=1500 ro0=1000 file_base=simple.su \
+ intt=def poly=0 x=0,10000 z=400,400 cp=2000 ro=1400 \
+ intt=def poly=2 x=0,2000,3000,5000,7000,8000,10000 \
+ z=1100,1100,1100,1600,1100,1100,1100 cp=4000 ro=2000 \
+ intt=def poly=0 x=0,10000 z=2100,2100 cp=3000 ro=1500 \
+ intt=def poly=0 x=0,10000 z=2600,2600 cp=5500 ro=2200
+
+xsrc1=100
+xsrc2=9900
+zsrc1=2100
+zsrc2=4000
+
+file_shot=shotRandomPos${xsrc1}_${zsrc1}.su
+
+../fdelmodc \
+ file_cp=simple_cp.su ischeme=1 \
+ file_den=simple_ro.su \
+ file_rcv=$file_shot \
+ dtrcv=0.008 \
+ dt=0.0010 \
+ verbose=4 \
+ tmod=10.000 \
+ dxrcv=20.0 \
+ zrcv1=10 \
+ zrcv2=10 \
+ xrcv1=0 \
+ xrcv2=10000 \
+ src_random=1 \
+ wav_random=1 \
+ fmax=30 \
+ xsrc1=$xsrc1 \
+ xsrc2=$xsrc2 \
+ zsrc1=$zsrc1 \
+ zsrc2=$zsrc2 \
+ tsrc1=0.0 \
+ tsrc2=5.0 \
+ nsrc=20 \
+ dipsrc=0 \
+ ntaper=45 \
+ tsnap1=0.1 tsnap2=6.0 dtsnap=0.2 \
+ left=4 right=4 bottom=4 top=1 \
+ nxmax=2500 nzmax=1400 ntmax=10000
+
+
diff --git a/fdelmodc3D/demo/fdelmodc_sourcepos.scr b/fdelmodc3D/demo/fdelmodc_sourcepos.scr
new file mode 100755
index 0000000000000000000000000000000000000000..37b6a90c2fb2279ebe62ed7093f9802f32fcdd94
--- /dev/null
+++ b/fdelmodc3D/demo/fdelmodc_sourcepos.scr
@@ -0,0 +1,172 @@
+#!/bin/bash
+#PBS -l nodes=1:ppn=2
+#PBS -N InterfModeling
+#PBS -q long
+#PBS -V
+#
+#
+# shows how different source distributions are defined
+
+set -x
+export PATH=../../bin:$PATH
+
+makewave w=g2 fp=10 t0=0.15 dt=0.0010 nt=4096 file_out=G2.su verbose=1
+
+makemod sizex=10000 sizez=4100 dx=10 dz=10 cp0=1500 ro0=1000 file_base=simple.su \
+ intt=def poly=0 x=0,10000 z=400,400 cp=2000 ro=1400 \
+ intt=def poly=2 x=0,2000,3000,5000,7000,8000,10000 z=1100,1100,1100,1600,1100,1100,1100 cp=4000 ro=2000 \
+ intt=def poly=0 x=0,10000 z=2100,2100 cp=3000 ro=1500 \
+ intt=def poly=0 x=0,10000 z=2600,2600 cp=5500 ro=2200
+
+xsrc1=100
+xsrc2=9900
+dxsrc=10
+dxrcv=10
+
+
+tmod=4
+tsrc1=0.1
+tsrc2=120
+tlength=120
+nsrc=800
+fmax=30
+
+for wav_random in 0 1;
+do
+
+file_shot=shotRS${wav_random}_volume_T${tmod}_S${nsrc}_Dt${tsrc2}_F${fmax}.su
+echo $file_shot
+
+#volume
+zsrc1=500
+zsrc2=4090
+
+fdelmodc \
+ file_cp=simple_cp.su ischeme=1 \
+ file_den=simple_ro.su \
+ file_src=G2.su \
+ file_rcv=$file_shot \
+ rec_type_p=0 \
+ dtrcv=0.008 \
+ rec_ntsam=16384 \
+ dt=0.0010 \
+ verbose=1 \
+ tmod=$tmod \
+ dxrcv=10.0 \
+ plane_wave=0 \
+ xrcv1=0 xrcv2=10000 zrcv1=0 zrcv2=0 dxrcv=50 \
+ src_random=1 \
+ wav_random=${wav_random} \
+ fmax=$fmax \
+ xsrc1=$xsrc1 \
+ xsrc2=$xsrc2 \
+ zsrc1=$zsrc1 \
+ zsrc2=$zsrc2 \
+ tsrc1=0.0 \
+ tsrc2=$tsrc2 \
+ tlength=$tlength \
+ nsrc=$nsrc \
+ dipsrc=0 \
+ ntaper=45 \
+ left=4 right=4 top=1 bottom=4
+
+ base=`echo $file_shot | awk 'BEGIN { FS = "." } ; { print $1 }'`
+ echo $base
+
+ shot=${base}_rvz.su
+ suwind s=1 j=1 tmax=4 f1=0.0 < $shot | \
+ sushw key=f1,delrt,d2 a=0.0,0.0,$dxrcv | \
+ supsimage perc=99 f1=0 f2=-5000 hbox=4 wbox=3 \
+ label1='time (s)' label2='lateral position (m)' \
+ labelsize=10 f2num=-5000 d2num=2500 > ${base}.eps
+
+
+#deep
+zsrc1=2700
+zsrc2=4090
+
+file_shot=shotRS${wav_random}_deep_T${tmod}_S${nsrc}_Dt${tsrc2}_F${fmax}.su
+
+fdelmodc \
+ file_cp=simple_cp.su ischeme=1 \
+ file_den=simple_ro.su \
+ file_src=G2.su \
+ file_rcv=$file_shot \
+ rec_type_p=0 \
+ dtrcv=0.008 \
+ rec_ntsam=16384 \
+ dt=0.0010 \
+ verbose=1 \
+ tmod=$tmod \
+ dxrcv=10.0 \
+ plane_wave=0 \
+ xrcv1=0 xrcv2=10000 zrcv1=0 zrcv2=0 dxrcv=50 \
+ src_random=1 \
+ wav_random=${wav_random} \
+ fmax=$fmax \
+ xsrc1=$xsrc1 \
+ xsrc2=$xsrc2 \
+ zsrc1=$zsrc1 \
+ zsrc2=$zsrc2 \
+ tsrc1=0.0 \
+ tsrc2=$tsrc2 \
+ tlength=$tlength \
+ nsrc=$nsrc \
+ dipsrc=0 \
+ ntaper=45 \
+ left=4 right=4 top=1 bottom=4
+
+ base=`echo $file_shot | awk 'BEGIN { FS = "." } ; { print $1 }'`
+ echo $base
+
+ shot=${base}_rvz.su
+ suwind s=1 j=1 tmax=4 f1=0.0 < $shot | \
+ sushw key=f1,delrt,d2 a=0.0,0.0,$dxrcv | \
+ supsimage perc=99 f1=0 f2=-5000 hbox=4 wbox=3 \
+ label1='time (s)' label2='lateral position (m)' \
+ labelsize=10 f2num=-5000 d2num=2500 > ${base}.eps
+
+#plane
+zsrc1=2700
+zsrc2=2700
+
+file_shot=shotRS${wav_random}_plane_T${tmod}_S${nsrc}_Dt${tsrc2}_F${fmax}.su
+
+fdelmodc \
+ file_cp=simple_cp.su ischeme=1 \
+ file_den=simple_ro.su \
+ file_src=G2.su \
+ file_rcv=$file_shot \
+ rec_type_p=0 \
+ dtrcv=0.008 \
+ rec_ntsam=16384 \
+ dt=0.0010 \
+ verbose=1 \
+ tmod=$tmod \
+ dxrcv=10.0 \
+ plane_wave=1 \
+ xrcv1=0 xrcv2=10000 zrcv1=0 zrcv2=0 dxrcv=50 \
+ xsrc=5000 zsrc=2700 \
+ src_random=0 \
+ wav_random=${wav_random} \
+ fmax=$fmax \
+ tsrc1=0.0 \
+ tsrc2=$tsrc2 \
+ tlength=$tlength \
+ nsrc=$nsrc \
+ dipsrc=0 \
+ ntaper=45 \
+ left=4 right=4 top=1 bottom=4
+
+ base=`echo $file_shot | awk 'BEGIN { FS = "." } ; { print $1 }'`
+ echo $base
+
+ shot=${base}_rvz.su
+ suwind s=1 j=1 tmax=4 f1=0.0 < $shot | \
+ sushw key=f1,delrt,d2 a=0.0,0.0,$dxrcv | \
+ supsimage perc=99 f1=0 f2=-5000 hbox=4 wbox=3 \
+ label1='time (s)' label2='lateral position (m)' \
+ labelsize=10 f2num=-5000 d2num=2500 > ${base}.eps
+
+done
+
diff --git a/fdelmodc3D/demo/fdelmodc_srcrec.scr b/fdelmodc3D/demo/fdelmodc_srcrec.scr
new file mode 100755
index 0000000000000000000000000000000000000000..9412842e8462e985776d7b07dd20ae0b8b43e6eb
--- /dev/null
+++ b/fdelmodc3D/demo/fdelmodc_srcrec.scr
@@ -0,0 +1,120 @@
+#!/bin/bash
+#PBS -N fdelmod
+#PBS -q verylong
+#PBS -l nodes=1
+#PBS -k eo
+#PBS -j eo
+#
+# illustrates source and receiver positions, used in Figure 10 of the manual
+
+export PATH=../../utils:$PATH:
+
+#OK:
+dt=0.0005
+dx=5
+ntaper=10
+
+makewave file_out=wavelet.su dt=$dt nt=1024 shift=1 fmax=10 verbose=1
+
+# build a model with a steep salt-like flank of the side
+./model_flank.scr
+
+export filecp=grad_salt.su
+export filero=salt_ro.su
+
+#model sources on an array following the edges of the flank
+
+../fdelmodc \
+ file_cp=grad_salt.su file_den=salt_ro.su \
+ ischeme=1 \
+ file_src=wavelet.su verbose=4 \
+ file_rcv=rec.su \
+ xsrca=5900,5950,6000,6100,6200,6300,6350,6300,6200,6100,6000,5950,5900 \
+ zsrca=2000,2100,2200,2300,2400,2500,2650,2800,2900,3000,3100,3200,3300 \
+ rec_type_vz=1 rec_int_vx=1 \
+ dtrcv=0.004 \
+ xrcv1=4000 zrcv1=1000 xrcv2=4000 zrcv2=6000 dzrcv=100 dxrcv=0 \
+ src_type=1 tmod=0.001 \
+ ntaper=10 \
+ left=4 right=4 bottom=4 top=1 \
+ fmax=10
+
+sugain < SrcRecPositions.su scale=5000 > nep.su
+
+susum nep.su grad_salt.su > sum.su
+
+supsimage < sum.su bclip=5000 wclip=0 \
+ wbox=4 hbox=4 titlesize=-1 labelsize=10 verbose=1 \
+ label1="depth [m]" label2="lateral position [m]" blockinterp=1 \
+ > salt_mod_srcrec3.eps
+
+
+#model sources on random positions in layers below the flank
+
+../fdelmodc \
+ file_cp=$filecp file_den=$filero \
+ ischeme=1 \
+ file_src=wavelet.su verbose=4 \
+ file_rcv=rec.su \
+ xrcv1=6000,500 xrcv2=6000,7500 dxrcv=0,500 \
+ zrcv1=100,500 zrcv2=6000,500 dzrcv=100,0 \
+ rec_type_vz=1 rec_int_vx=1 \
+ dtrcv=0.004 \
+ src_random=1 nsrc=150 \
+ xsrc1=500 xsrc2=7500 zsrc1=6000 zsrc2=7500 \
+ src_type=1 tmod=0.001 \
+ ntaper=$ntaper \
+ left=4 right=4 bottom=4 top=1 \
+ fmax=10
+
+sugain < SrcRecPositions.su scale=5000 > nep.su
+
+susum nep.su grad_salt.su > sum.su
+
+supsimage < sum.su bclip=5000 wclip=0 \
+ wbox=4 hbox=4 titlesize=-1 labelsize=10 verbose=1 \
+ label1="depth [m]" label2="lateral position [m]" blockinterp=1 \
+ > salt_mod_srcrec2.eps
+
+#model 50 shots for sources on a horizontal line left from the flank
+
+../fdelmodc \
+ file_cp=$filecp file_den=$filero \
+ ischeme=1 \
+ file_src=wavelet.su verbose=4 \
+ file_rcv=rec.su \
+ xrcv1=6000 xrcv2=6000 dxrcv=0 \
+ zrcv1=100 zrcv2=6000 dzrcv=100 \
+ rec_type_vz=0 rec_int_vx=1 \
+ dtrcv=0.004 \
+ xsrc=500 zsrc=100 nshot=50 dxshot=100 dzshot=0 \
+ src_type=1 tmod=0.001 \
+ ntaper=$ntaper \
+ left=4 right=4 bottom=4 top=1 \
+ fmax=10
+
+sugain < SrcRecPositions.su scale=5000 > nep.su
+
+susum nep.su grad_salt.su > sum.su
+
+supsimage < sum.su bclip=5000 wclip=0 \
+ wbox=4 hbox=4 titlesize=-1 labelsize=10 verbose=1 \
+ label1="depth [m]" label2="lateral position [m]" blockinterp=1 \
+ > salt_mod_srcrec.eps
+
+exit;
+
+#alternative ways of plotting src and receiver positions
+supsimage < SrcRecPositions.su \
+ grgb=1.0,1.0,1.0 brgb=1.0,0.0,0.0 wrgb=0.0,1.0,0.0 \
+ ghls=1.0,1.0,0.0 bhls=1.0,1.0,0.0 whls=1.0,1.0,0.0 \
+ wbox=4 hbox=4 titlesize=-1 labelsize=10 verbose=1 \
+ label1="time [s]" label2="lateral position [m]" blockinterp=1 \
+ > salt_mod_srcrec.eps
+
+supsimage < grad_salt.su \
+ wbox=4 hbox=4 titlesize=-1 labelsize=10 verbose=1 \
+ label1="time [s]" label2="lateral position [m]" > salt.eps
+
+
+
diff --git a/fdelmodc3D/demo/fdelmodc_stab.scr b/fdelmodc3D/demo/fdelmodc_stab.scr
new file mode 100755
index 0000000000000000000000000000000000000000..d43c57ed04561297ed686ce09d0039fa3fa14e2d
--- /dev/null
+++ b/fdelmodc3D/demo/fdelmodc_stab.scr
@@ -0,0 +1,145 @@
+#!/bin/bash
+#PBS -N fdelmod
+#PBS -q verylong
+#PBS -l nodes=1
+#PBS -k eo
+#PBS -j eo
+#
+# Illustrates how dispersion and instability is presented in snapshots, used in Figure 1 of the manual
+
+export PATH=../../bin:$PATH
+
+#OK: no taper
+ntaper=0
+
+export filecp=model_cp.su
+export filecs=model_cs.su
+export filero=model_ro.su
+
+#OK: no dispersion and stable
+dt=0.0002
+dx=1
+cp=1500
+
+makewave file_out=wavelet.su dt=$dt nt=1024 fp=85 shift=1 w=g2 verbose=1
+makemod file_base=model.su \
+ cp0=$cp ro0=1000 cs0=600 sizex=2100 sizez=2100 \
+ dx=$dx dz=$dx orig=0,0 \
+
+../fdelmodc \
+ file_cp=$filecp file_cs=$filecs file_den=$filero \
+ ischeme=1 \
+ file_src=wavelet.su verbose=2 \
+ file_rcv=rec.su \
+ file_snap=snap_nodisp.su \
+ xrcv1=0 xrcv2=2100 dxrcv=15 \
+ zrcv1=400 zrcv2=400 \
+ dtrcv=0.004 \
+ xsrc=1000 zsrc=1700 nshot=1 \
+ src_type=1 tmod=1.0 \
+ ntaper=$ntaper \
+ left=4 right=4 bottom=4 top=4 \
+ tsnap1=0.1 tsnap2=1.0 dtsnap=0.4 \
+ sna_type_ss=1 sna_type_pp=1 fmax=25
+
+suwind < snap_nodisp_sp.su key=fldr min=2 max=2 | \
+ convert trinc=3 saminc=3 | \
+ supsimage labelsize=10 hbox=4 wbox=4 clip=1e-5 \
+ label1="z [m]" label2="x [m]" f1=0 f2=0 d1=3 d2=3 > snap_nodisp_sp.eps
+
+
+#Dispersion 1:
+dt=0.001
+dx=3
+cp=1500
+
+makewave file_out=wavelet.su dt=$dt nt=1024 fp=85 shift=1 w=g2 verbose=1
+makemod file_base=model.su \
+ cp0=$cp ro0=1000 cs0=600 sizex=2100 sizez=2100 \
+ dx=$dx dz=$dx orig=0,0 \
+
+../fdelmodc \
+ file_cp=$filecp file_cs=$filecs file_den=$filero \
+ ischeme=1 \
+ file_src=wavelet.su verbose=2 \
+ file_rcv=rec.su \
+ file_snap=snap_disp1.su \
+ xrcv1=0 xrcv2=2100 dxrcv=15 \
+ zrcv1=400 zrcv2=400 \
+ dtrcv=0.004 \
+ xsrc=1000 zsrc=1700 nshot=1 \
+ src_type=1 tmod=1.0 \
+ ntaper=$ntaper \
+ left=4 right=4 bottom=4 top=4 \
+ tsnap1=0.1 tsnap2=1.0 dtsnap=0.4 \
+ sna_type_ss=1 sna_type_pp=1 fmax=25
+
+suwind < snap_disp1_sp.su key=fldr min=2 max=2 | \
+ supsimage labelsize=10 hbox=4 wbox=4 clip=1e-5 \
+ label1="z [m]" label2="x [m]" f1=0 f2=0 > snap_disp_sp.eps
+
+#Dispersion 2:
+dt=0.0002
+dx=1
+cp=300
+
+makewave file_out=wavelet.su dt=$dt nt=1024 fp=85 shift=1 w=g2 verbose=1
+makemod file_base=model.su \
+ cp0=$cp ro0=1000 cs0=600 sizex=2100 sizez=2100 \
+ dx=$dx dz=$dx orig=0,0 \
+
+../fdelmodc \
+ file_cp=$filecp file_cs=$filecs file_den=$filero \
+ ischeme=1 \
+ file_src=wavelet.su verbose=2 \
+ file_rcv=rec.su \
+ file_snap=snap_disp2.su \
+ xrcv1=0 xrcv2=2100 dxrcv=15 \
+ zrcv1=400 zrcv2=400 \
+ dtrcv=0.004 \
+ xsrc=1000 zsrc=1700 nshot=1 \
+ src_type=1 tmod=1.0 \
+ ntaper=$ntaper \
+ left=4 right=4 bottom=4 top=4 \
+ tsnap1=0.1 tsnap2=1.0 dtsnap=0.4 \
+ sna_type_ss=1 sna_type_pp=1 fmax=25
+
+suwind < snap_disp2_sp.su key=fldr min=2 max=2 | \
+ supsimage labelsize=10 hbox=4 wbox=4 clip=2e-4 \
+ x1beg=1400 x1end=2000 x2beg=700 x2end=1300 \
+ label1="z [m]" label2="x [m]" f1=0 f2=0 > snap_disp2_sp.eps
+
+#stability:
+# To run this model one has to disable the error message in ../getParameters.c
+# this can be done with an undocumented parameter disable_check=1.
+# Noramly the program checks stability and then aborts the program using verr().
+dt=0.0008
+dx=1
+cp=1500
+
+makewave file_out=wavelet.su dt=$dt nt=1024 fp=85 shift=1 w=g2 verbose=1
+makemod file_base=model.su \
+ cp0=$cp ro0=1000 cs0=600 sizex=2100 sizez=2100 \
+ dx=$dx dz=$dx orig=0,0 \
+
+../fdelmodc \
+ file_cp=$filecp file_cs=$filecs file_den=$filero \
+ ischeme=1 \
+ file_src=wavelet.su verbose=2 \
+ file_rcv=rec.su \
+ file_snap=snap_stab.su \
+ xrcv1=0 xrcv2=2100 dxrcv=15 \
+ zrcv1=400 zrcv2=400 \
+ dtrcv=0.004 \
+ xsrc=1000 zsrc=1700 nshot=1 \
+ src_type=1 tmod=1.0 \
+ ntaper=$ntaper \
+ left=4 right=4 bottom=4 top=4 \
+ tsnap1=0.1 tsnap2=1.0 dtsnap=0.4 \
+ disable_check=1 \
+ sna_type_ss=1 sna_type_pp=1 fmax=25
+
+suwind < snap_stab_sp.su key=fldr min=1 max=1 | \
+ supsimage labelsize=10 hbox=4 wbox=4 clip=2e+16 \
+ label1="z [m]" label2="x [m]" f1=0 f2=0 > snap_stab_sp.eps
+
diff --git a/fdelmodc3D/demo/fdelmodc_taper.scr b/fdelmodc3D/demo/fdelmodc_taper.scr
new file mode 100755
index 0000000000000000000000000000000000000000..cdb8aed52b6996561755ac5a171097d9becb81d4
--- /dev/null
+++ b/fdelmodc3D/demo/fdelmodc_taper.scr
@@ -0,0 +1,119 @@
+#!/bin/bash
+#PBS -N fdelmod
+#PBS -q verylong
+#PBS -l nodes=1
+#PBS -k eo
+#PBS -j eo
+#
+# Illustrates the effect of (absorbing) tapering of the edges, used in Figure 4 of the manual.
+
+#OK:
+dt=0.0002
+dx=1
+cp=1500
+clip=1
+
+makewave file_out=wavelet.su dt=$dt nt=1024 fp=85 shift=1 w=g2 verbose=1
+
+makemod file_base=model.su \
+ cp0=$cp ro0=1000 cs0=600 sizex=1000 sizez=1000 \
+ dx=$dx dz=$dx orig=0,0 \
+
+export filecp=model_cp.su
+export filecs=model_cs.su
+export filero=model_ro.su
+
+ntaper=0
+../fdelmodc \
+ file_cp=$filecp file_cs=$filecs file_den=$filero \
+ ischeme=1 \
+ file_src=wavelet.su verbose=4 \
+ file_rcv=rec.su \
+ file_snap=snap_nodisp.su \
+ xrcv1=0 xrcv2=1000 dxrcv=5 \
+ zrcv1=300 zrcv2=300 \
+ rec_type_vx=1 rec_type_pp=1 rec_type_ss=1 rec_int_vx=1 \
+ dtrcv=0.004 \
+ xsrc=500 zsrc=500 nshot=1 \
+ src_type=1 tmod=1.0 \
+ ntaper=$ntaper \
+ left=3 right=3 bottom=3 top=3 \
+ tsnap1=0.2 tsnap2=1.0 dtsnap=0.1 \
+ sna_type_ss=1 sna_type_pp=1 fmax=25
+
+suwind key=fldr min=3 max=3 < snap_nodisp_sp.su | \
+ supsimage \
+ wbox=4 hbox=4 titlesize=-1 labelsize=10 verbose=1 \
+ d2=$dx f2=0 clip=$clip \
+ label1="depth [m]" label2="lateral position [m]" > snap_tap${ntaper}.eps
+
+supsimage < rec_rp.su \
+ wbox=3 hbox=4 titlesize=-1 labelsize=10 clip=$clip verbose=1 \
+ label1="time [s]" label2="lateral position [m]" > rec_tap${ntaper}_rp.eps
+
+
+for ntaper in 50 100;
+do
+../fdelmodc \
+ file_cp=$filecp file_cs=$filecs file_den=$filero \
+ ischeme=1 \
+ file_src=wavelet.su verbose=4 \
+ file_rcv=rec.su \
+ file_snap=snap_nodisp.su \
+ xrcv1=0 xrcv2=1000 dxrcv=5 \
+ zrcv1=300 zrcv2=300 \
+ rec_type_vx=1 rec_type_pp=1 rec_type_ss=1 rec_int_vx=1 \
+ dtrcv=0.004 \
+ xsrc=500 zsrc=500 nshot=1 \
+ src_type=1 tmod=1.0 \
+ ntaper=$ntaper \
+ left=4 right=4 bottom=4 top=4 \
+ tsnap1=0.2 tsnap2=1.0 dtsnap=0.1 \
+ sna_type_ss=1 sna_type_pp=1 fmax=25
+
+suwind key=fldr min=3 max=3 < snap_nodisp_sp.su | \
+ supsimage \
+ wbox=4 hbox=4 titlesize=-1 labelsize=10 verbose=1 \
+ d2=$dx f2=0 clip=$clip \
+ label1="depth [m]" label2="lateral position [m]" > snap_tap${ntaper}.eps
+
+supsimage < rec_rp.su \
+ wbox=3 hbox=4 titlesize=-1 labelsize=10 clip=$clip verbose=1 \
+ label1="time [s]" label2="lateral position [m]" > rec_tap${ntaper}_rp.eps
+
+done
+
+
+for npml in 5 10 20;
+do
+../fdelmodc \
+ file_cp=$filecp file_cs=$filecs file_den=$filero \
+ ischeme=1 \
+ file_src=wavelet.su verbose=4 \
+ file_rcv=rec.su \
+ file_snap=snap_nodisp.su \
+ xrcv1=0 xrcv2=1000 dxrcv=5 \
+ zrcv1=300 zrcv2=300 \
+ rec_type_vx=1 rec_type_pp=1 rec_type_ss=1 rec_int_vx=1 \
+ dtrcv=0.004 \
+ xsrc=500 zsrc=500 nshot=1 \
+ src_type=1 tmod=1.0 \
+ npml=$npml \
+ left=2 right=2 bottom=2 top=2 \
+ tsnap1=0.2 tsnap2=1.0 dtsnap=0.1 \
+ sna_type_ss=1 sna_type_pp=1 fmax=25
+
+suwind key=fldr min=3 max=3 < snap_nodisp_sp.su | \
+ supsimage \
+ wbox=4 hbox=4 titlesize=-1 labelsize=10 verbose=1 \
+ d2=$dx f2=0 clip=$clip \
+ label1="depth [m]" label2="lateral position [m]" > snap_pml${npml}.eps
+
+supsimage < rec_rp.su \
+ wbox=3 hbox=4 titlesize=-1 labelsize=10 clip=$clip verbose=1 \
+ label1="time [s]" label2="lateral position [m]" > rec_pml${npml}_rp.eps
+
+done
+
+exit;
+
diff --git a/fdelmodc3D/demo/fdelmodc_topography.scr b/fdelmodc3D/demo/fdelmodc_topography.scr
new file mode 100755
index 0000000000000000000000000000000000000000..55d289e1a888b88fd7226afe8268bd22dd6b8439
--- /dev/null
+++ b/fdelmodc3D/demo/fdelmodc_topography.scr
@@ -0,0 +1,80 @@
+#!/bin/bash
+#PBS -l nodes=1
+#PBS -N InterfModeling
+#PBS -q fourweeks
+#PBS -V
+#
+# Illustrates how to place source and receivers on topography
+
+export PATH=../../bin:$PATH
+
+dt=0.0004
+ntap=120
+fmax=45
+
+makemod sizex=10000 sizez=4100 dx=5 dz=5 cp0=0 cs0=0 ro0=1000 file_base=real2.su \
+ orig=0,-800 gradunit=0 \
+ intt=def poly=2 cp=2450 ro=1000 gradcp=14 grad=0 cs=2000 \
+ x=0,1000,1700,1800,2000,3000,4000,4500,6000,6800,7000,7500,8100,8800,10000 \
+ z=-100,-200,-250,-200,-200,-120,-300,-600,-650,-500,-350,-200,-200,-150,-200 \
+ intt=rough var=200,3.2,1 poly=2 x=0,3000,8000,10000 \
+ z=400,250,300,500 cp=4500,4200,4800,4500 ro=1400 gradcp=5 grad=0 cs=3800,3200,4000,3800 \
+ intt=def poly=2 x=0,2000,3000,5000,7000,8000,10000 \
+ z=1100,1100,1100,1600,1100,1100,1100 cp=4000 cs=3000 ro=2000 gradcp=8 grad=0 \
+ intt=def poly=0 x=0,10000 z=1750,2050 cp=4500,5100 cs=3800,4200 ro=1500 gradcp=13 grad=0 \
+ intt=def poly=0 x=0,10000 z=1850,2150 cp=6000,4200 cs=5000 ro=1500 gradcp=14 grad=0 \
+ intt=def poly=0 x=0,10000 z=1950,2250 cp=4800,4800 cs=4000 ro=1500 gradcp=5 grad=0 \
+ intt=def poly=0 x=0,10000 z=2000,2300 cp=6100,5000 cs=4400 ro=1500 gradcp=13 grad=0 \
+ intt=def poly=0 x=0,10000 z=2100,2400 cp=3800,5000 cs=3000,3600 ro=1500 gradcp=20 grad=0 \
+ intt=def poly=0 x=0,10000 z=2150,2450 cp=5000 cs=4000 ro=1500 gradcp=14 grad=0 \
+ intt=def poly=0 x=0,10000 z=2350,2650 cp=5800 cs=4200 ro=1500 gradcp=5 grad=0 \
+ intt=def poly=0 x=0,10000 z=2600,2600 cp=5500 cs=4100 ro=2200 gradcp=5 grad=0
+
+sushw key=f1 a=0 < real2_cp.su | \
+ sushw key=f1 a=0 | \
+ supsimage hbox=6 wbox=8 labelsize=10 f2num=-5000 d2num=1000 \
+ wrgb=0,0,1.0 grgb=0,1.0,0 brgb=1.0,0,0 \
+ bclip=7053.02 wclip=0 label1="depth [m]" label2="lateral position [m]" \
+ > model2_cp.eps
+
+
+makewave w=g2 fmax=45 t0=0.10 dt=$dt nt=4096 db=-40 file_out=G2.su verbose=1
+
+#in new FD code extendmodel is done in FD
+#extendModel file_in=real2_ro.su nafter=$ntap nbefore=$ntap nabove=0 nbelow=$ntap > vel2_edge_ro.su
+#extendModel file_in=real2_cp.su nafter=$ntap nbefore=$ntap nabove=0 nbelow=$ntap > vel2_edge_cp.su
+
+#reference
+
+../fdelmodc \
+ file_cp=real2_cp.su ischeme=3 \
+ file_den=real2_ro.su \
+ file_cs=real2_cs.su \
+ file_rcv=shot_real2_x5000_topo.su \
+ file_src=G2.su \
+ src_type=7 \
+ dtrcv=0.004 \
+ verbose=4 \
+ tmod=3.104 \
+ rec_delay=0.1 \
+ dxrcv=20.0 \
+ zrcv1=-800 \
+ zrcv2=-800 \
+ xrcv1=0 \
+ xrcv2=10000 \
+ sinkdepth=1 \
+ sinkdepth_src=1 \
+ src_random=0 \
+ wav_random=0 \
+ xsrc=5000 \
+ zsrc=-500 \
+ ntaper=$ntap \
+ tsnap1=0.1 tsnap2=2.0 dtsnap=0.04 dxsnap=20 dzsnap=20 \
+ sna_type_txx=1 sna_type_tzz=1 \
+ left=4 right=4 top=1 bottom=4
+
+
+ supsimage perc=99 f1=0 f2=-5000 x1end=3.004 hbox=8 wbox=6 < shot_real2_x5000_topo_rvz.su \
+ label1="time (s)" label2="lateral position (m)" \
+ labelsize=10 f2num=-5000 d2num=1000 d1num=0.5 > shot_real2_x5000_topo.eps
+
diff --git a/fdelmodc3D/demo/fdelmodc_visco.scr b/fdelmodc3D/demo/fdelmodc_visco.scr
new file mode 100755
index 0000000000000000000000000000000000000000..ecdcbb7ec691c5c3a7e99a6714c6f707f77dd234
--- /dev/null
+++ b/fdelmodc3D/demo/fdelmodc_visco.scr
@@ -0,0 +1,109 @@
+#!/bin/bash
+#PBS -N fdelmod
+#PBS -q verylong
+#PBS -l nodes=1
+#PBS -k eo
+#PBS -j eo
+#
+# wave propagation in visco-elastic medium
+
+export PATH=.:/home/thorbcke/bin:$PATH
+
+makewave file_out=wavelet.su dt=0.001 nt=1024 fp=13 shift=1 w=g2 verbose=1
+
+makemod file_base=model.su \
+ cp0=1500 ro0=1000 cs0=600 sizex=2700 sizez=2700 orig=0,-300\
+ dx=3 dz=3 \
+ intt=def poly=0 cp=1550 ro=2000 cs=1200 \
+ x=0,2700 z=500,500 \
+ intt=def poly=0 cp=1700 ro=2500 cs=1500 \
+ x=1100,1500 z=900,900 \
+ verbose=1
+
+#viscoelastic Q-values
+makemod file_base=relax.su \
+ cp0=20 cs0=17 ro0=1 sizex=2700 sizez=2700 orig=0,-300 \
+ dx=3 dz=3 \
+ intt=def poly=0 cp=18 cs=21 ro=1 \
+ x=0,2700 z=500,500 \
+ intt=def poly=0 cp=25 cs=26 ro=1 \
+ x=1100,1500 z=900,900 \
+ verbose=1
+
+export filecp=model_cp.su
+export filecs=model_cs.su
+export filero=model_ro.su
+
+export fileqp=relax_cp.su
+export fileqs=relax_cs.su
+
+export OMP_NUM_THREADS=4
+
+../fdelmodc \
+ file_cp=$filecp file_cs=$filecs file_den=$filero \
+ ischeme=4 \
+ file_qp=$fileqp file_qs=$fileqs \
+ file_src=wavelet.su verbose=1 \
+ file_rcv=rec.su \
+ fmax=40 \
+ xrcv1=600 xrcv2=2100 dxrcv=15 \
+ rec_type_vx=1 rec_type_vz=1 rec_type_ss=1 rec_type_pp=1 rec_int_vx=0 \
+ zrcv1=300 zrcv2=300 \
+ dtrcv=0.004 xsrc=1000 zsrc=300 nshot=1 \
+ src_type=1 \
+ ntaper=100 \
+ left=2 right=2 bottom=2 top=2 \
+ tmod=1.5 dt=0.001
+
+# tsnap1=0 tsnap2=1.5 dtsnap=0.05 \
+
+#model direct field to subtract from total field
+makemod file_base=model.su \
+ cp0=1500 ro0=1000 cs0=600 sizex=2700 sizez=2700 orig=0,-300\
+ dx=3 dz=3 \
+ verbose=1
+
+#viscoelastic Q-values
+makemod file_base=relax.su \
+ cp0=20 cs0=17 ro0=1 sizex=2700 sizez=2700 orig=0,-300\
+ dx=3 dz=3 \
+ verbose=1
+
+export filecp=model_cp.su
+export filecs=model_cs.su
+export filero=model_ro.su
+
+export fileqp=relax_cp.su
+export fileqs=relax_cs.su
+
+
+../fdelmodc \
+ file_cp=$filecp file_cs=$filecs file_den=$filero \
+ ischeme=4 \
+ file_qp=$fileqp file_qs=$fileqs \
+ file_src=wavelet.su verbose=1 \
+ file_rcv=drec.su \
+ fmax=40 \
+ xrcv1=600 xrcv2=2100 dxrcv=15 \
+ rec_type_vx=1 rec_type_vz=1 rec_type_ss=1 rec_type_pp=1 rec_int_vx=0 \
+ zrcv1=300 zrcv2=300 \
+ dtrcv=0.004 xsrc=1000 zsrc=300 nshot=1 ntaper=100 \
+ src_type=1 \
+ ntaper=100 \
+ left=2 right=2 bottom=2 top=2 \
+ tmod=1.5 dt=0.001
+
+# substract mean and plot in eps
+for rectype in rvx rvz rpp rss ;
+do
+ file_rcv=rec_$rectype.su
+
+ sudiff $file_rcv d$file_rcv > nep.su
+
+ supsimage < nep.su hbox=4 wbox=3 titlesize=-1 labelsize=10 titlesize=-1 \
+ perc=99 label1="time [s]" f2=300 d2=15 label2="receiver position in m" > viscodemo_$rectype.eps
+
+done
+
+exit;
+
diff --git a/fdelmodc3D/demo/freesurfaceP.scr b/fdelmodc3D/demo/freesurfaceP.scr
new file mode 100755
index 0000000000000000000000000000000000000000..bbe902a512d40954ec8c134b090750401816a4eb
--- /dev/null
+++ b/fdelmodc3D/demo/freesurfaceP.scr
@@ -0,0 +1,88 @@
+#!/bin/bash
+
+cp=2000
+rho=1000
+dx=5
+dt=0.0010
+
+makemod sizex=500 sizez=600 dx=$dx dz=$dx cp0=$cp ro0=$rho \
+ orig=-250,0 file_base=freesurf.su \
+ intt=def x=-250,250 z=200,200 poly=0 cp=2300 ro=2000 \
+ verbose=1
+
+makewave fp=20 dt=$dt file_out=wave.su nt=4096 t0=0.1
+
+../fdelmodc \
+ file_cp=freesurf_cp.su ischeme=1 \
+ file_den=freesurf_ro.su \
+ file_src=wave.su \
+ file_rcv=shotP_x0z0.su \
+ src_type=1 \
+ verbose=2 \
+ src_injectionrate=1 \
+ rec_int_vz=0 \
+ dtrcv=$dt \
+ rec_delay=0.1 \
+ tmod=1.10 \
+ dxrcv=$dx \
+ xrcv1=-250 xrcv2=250 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=0 zsrc=0 \
+ npml=51 \
+ left=2 right=2 top=1 bottom=2
+
+fdacmod file_vel=freesurf_cp.su file_den=freesurf_ro.su \
+ file_src=wave.su file_rcv=fdac_shotP_x0z0.su tmod=1.10 tapleft=1 tapright=1 tapbottom=1 \
+ xsrc=0 zsrc=0
+
+exit
+makemod sizex=500 sizez=600 dx=$dx dz=$dx cp0=$cp ro0=$rho \
+ orig=-250,-100 file_base=surf.su \
+ intt=def x=-250,250 z=200,200 poly=0 cp=2300 ro=2000 \
+ verbose=1
+
+../fdelmodc \
+ file_cp=surf_cp.su ischeme=1 \
+ file_den=surf_ro.su \
+ file_src=wave.su \
+ file_rcv=shot_x0zdx.su \
+ src_type=1 \
+ verbose=2 \
+ src_injectionrate=1 \
+ rec_int_vz=0 \
+ dtrcv=$dt \
+ rec_delay=0.1 \
+ tmod=1.10 \
+ dxrcv=$dx \
+ xrcv1=-250 xrcv2=250 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=0 zsrc=$dx \
+ npml=51 \
+ left=2 right=2 top=2 bottom=2
+
+../fdelmodc \
+ file_cp=surf_cp.su ischeme=1 \
+ file_den=surf_ro.su \
+ file_src=wave.su \
+ file_rcv=shot_x0z-dx.su \
+ src_type=1 \
+ verbose=2 \
+ src_injectionrate=1 \
+ rec_int_vz=0 \
+ dtrcv=$dt \
+ rec_delay=0.1 \
+ tmod=1.10 \
+ dxrcv=$dx \
+ xrcv1=-250 xrcv2=250 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=0 zsrc=-$dx \
+ npml=51 \
+ left=2 right=2 top=2 bottom=2
+
+suop2 shot_x0zdx_rvz.su shot_x0z-dx_rvz.su op=diff > shot_x0diff_rvz.su
+
+suop2 shot_x0diff_rvz.su shotF_x0zdx_rvz.su op=diff w1=1 w2=2 > shotF_x0diff_rvz.su
+
+(suwind key=gx min=0 max=0 < shot_x0zdx_rvz.su | sugain scale=2; suwind key=gx min=0 max=0 < shotF_x0zdx_rvz.su) | suxgraph title "with and without Free-surface "
+
+(suwind key=gx min=0 max=0 < shot_x0diff_rvz.su | sugain scale=2 ; suwind key=gx min=0 max=0 < shotF_x0zdx_rvz.su) | suxgraph
diff --git a/fdelmodc3D/demo/freesurfaceVz.scr b/fdelmodc3D/demo/freesurfaceVz.scr
new file mode 100755
index 0000000000000000000000000000000000000000..41e8ab46a7a98bbc82d03d42ac2c7d24ef05d15c
--- /dev/null
+++ b/fdelmodc3D/demo/freesurfaceVz.scr
@@ -0,0 +1,88 @@
+#!/bin/bash
+#PBS -N fdelmod
+#PBS -q verylong
+#PBS -l nodes=7
+#PBS -k eo
+#PBS -j eo
+
+cp=2000
+rho=1000
+dx=5
+dt=0.0010
+
+makemod sizex=500 sizez=600 dx=$dx dz=$dx cp0=$cp ro0=$rho \
+ orig=-250,0 file_base=freesurf.su \
+ intt=def x=-250,250 z=200,200 poly=0 cp=2300 ro=2000 \
+ verbose=1
+
+makewave fp=20 dt=$dt file_out=wave.su nt=4096 t0=0.1
+
+../fdelmodc \
+ file_cp=freesurf_cp.su ischeme=1 \
+ file_den=freesurf_ro.su \
+ file_src=wave.su \
+ file_rcv=shotF_x0zdx.su \
+ src_type=1 \
+ verbose=2 \
+ src_injectionrate=1 \
+ rec_int_vz=0 \
+ dtrcv=$dt \
+ rec_delay=0.1 \
+ tmod=1.10 \
+ dxrcv=$dx \
+ xrcv1=-250 xrcv2=250 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=0 zsrc=$dx \
+ npml=51 \
+ left=2 right=2 top=1 bottom=2
+
+makemod sizex=500 sizez=600 dx=$dx dz=$dx cp0=$cp ro0=$rho \
+ orig=-250,-100 file_base=surf.su \
+ intt=def x=-250,250 z=200,200 poly=0 cp=2300 ro=2000 \
+ verbose=1
+
+../fdelmodc \
+ file_cp=surf_cp.su ischeme=1 \
+ file_den=surf_ro.su \
+ file_src=wave.su \
+ file_rcv=shot_x0zdx.su \
+ src_type=1 \
+ verbose=2 \
+ src_injectionrate=1 \
+ rec_int_vz=0 \
+ dtrcv=$dt \
+ rec_delay=0.1 \
+ tmod=1.10 \
+ dxrcv=$dx \
+ xrcv1=-250 xrcv2=250 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=0 zsrc=$dx \
+ npml=51 \
+ left=2 right=2 top=2 bottom=2
+
+../fdelmodc \
+ file_cp=surf_cp.su ischeme=1 \
+ file_den=surf_ro.su \
+ file_src=wave.su \
+ file_rcv=shot_x0z-dx.su \
+ src_type=1 \
+ verbose=2 \
+ src_injectionrate=1 \
+ rec_int_vz=0 \
+ dtrcv=$dt \
+ rec_delay=0.1 \
+ tmod=1.10 \
+ dxrcv=$dx \
+ xrcv1=-250 xrcv2=250 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=0 zsrc=-$dx \
+ npml=51 \
+ left=2 right=2 top=2 bottom=2
+
+suop2 shot_x0zdx_rvz.su shot_x0z-dx_rvz.su op=diff > shot_x0diff_rvz.su
+
+suop2 shot_x0diff_rvz.su shotF_x0zdx_rvz.su op=diff w1=1 w2=2 > shotF_x0diff_rvz.su
+
+(suwind key=gx min=0 max=0 < shot_x0zdx_rvz.su | sugain scale=2; suwind key=gx min=0 max=0 < shotF_x0zdx_rvz.su) | suxgraph title "with and without Free-surface "
+
+(suwind key=gx min=0 max=0 < shot_x0diff_rvz.su | sugain scale=2 ; suwind key=gx min=0 max=0 < shotF_x0zdx_rvz.su) | suxgraph
diff --git a/fdelmodc3D/demo/green_multiwave.scr b/fdelmodc3D/demo/green_multiwave.scr
new file mode 100755
index 0000000000000000000000000000000000000000..52b21edf847303ea22ef6d6217f18ed77c6ec47c
--- /dev/null
+++ b/fdelmodc3D/demo/green_multiwave.scr
@@ -0,0 +1,42 @@
+#!/bin/bash
+#PBS -l nodes=1:ppn=2
+#PBS -N InterfModeling
+#PBS -V
+#
+
+cp=2000
+rho=1000
+dx=2.5
+dt=0.0005
+
+export PATH=../../bin:$PATH
+
+makemod sizex=2000 sizez=2000 dx=$dx dz=$dx cp0=$cp ro0=$rho orig=-1000,0 file_base=simple.su
+makewave fp=15 dt=$dt file_out=wave.su nt=4096 t0=0.1
+
+green c=$cp rho=$rho file_src=wave.su zsrc1=500 xrcv=-1000,1000 dxrcv=$dx nt=4096 dip=0 > shot_green_rp.su
+basop choice=5 file_in=shot_green_rp.su file_out=shot_green_cj.su
+
+######### MONOPOLE ACOUSTIC #######
+
+../fdelmodc \
+ file_cp=simple_cp.su ischeme=1 \
+ file_den=simple_ro.su \
+ file_src=shot_green_cj.su \
+ file_rcv=shot_fd.su \
+ grid_dir=0 \
+ src_type=1 \
+ rec_type_p=1 \
+ rec_type_vz=0 \
+ rec_int_vz=2 \
+ dtrcv=0.004 \
+ verbose=2 \
+ tmod=4.000 \
+ dxrcv=5.0 \
+ xrcv1=-100 xrcv2=1000 \
+ zrcv1=500 zrcv2=500 \
+ ntaper=100 \
+ sna_type_vz=0 \
+ file_snap=back0.su tsnap1=0 dtsnap=0.05 tsnap2=4.0 dxsnap=5 dzsnap=5 zsnap1=0 zsnap2=2000 xsnap1=-1000 xsnap2=1000 \
+ left=4 right=4 bottom=4 top=4
+
diff --git a/fdelmodc3D/demo/interpolate_wave.scr b/fdelmodc3D/demo/interpolate_wave.scr
new file mode 100755
index 0000000000000000000000000000000000000000..6112429743b247d5d491278bb06ce05bdfe890fc
--- /dev/null
+++ b/fdelmodc3D/demo/interpolate_wave.scr
@@ -0,0 +1,38 @@
+#!/bin/bash
+
+cp=1500
+rho=1000
+dx=2.5
+dt=0.0001
+
+makemod sizex=6000 sizez=2000 dx=$dx dz=$dx cp0=$cp cs0=$cs ro0=$rho \
+ orig=-3000,0 file_base=syncl.su \
+ intt=def x=-3000,0,3000 z=400,400,400 poly=0 cp=1500 ro=1500 \
+ intt=def x=-3000,-2000,-1000,-800,0,800,3000 z=650,650,700,750,900,750,600 poly=2 cp=1500 ro=2000 \
+ intt=def x=-3000,3000 z=1250,1250 poly=0 cp=1500 ro=1800 \
+
+export OMP_NUM_THREADS=1
+makewave fp=20 dt=0.004 file_out=wave.su nt=4096 t0=0.1
+
+../fdelmodc \
+ file_cp=syncl_cp.su ischeme=1 \
+ file_den=syncl_ro.su \
+ file_src=wave.su \
+ file_rcv=shot_fd.su \
+ src_type=7 \
+ src_orient=1 \
+ src_injectionrate=1 \
+ rec_type_vz=1 \
+ rec_type_p=1 \
+ dtrcv=0.0010 \
+ rec_delay=0.1 \
+ verbose=4 \
+ tmod=4.10 \
+ dt=$dt \
+ dxrcv=10.0 \
+ xrcv1=-2500 xrcv2=2500 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=0 zsrc=0 \
+ ntaper=101 \
+ left=2 right=2 bottom=2 top=1
+
diff --git a/fdelmodc3D/demo/matlab/FD_matlab_interface.m b/fdelmodc3D/demo/matlab/FD_matlab_interface.m
new file mode 100644
index 0000000000000000000000000000000000000000..da2ff4e44e454de8bacadfaa831d2ef226d61507
--- /dev/null
+++ b/fdelmodc3D/demo/matlab/FD_matlab_interface.m
@@ -0,0 +1,97 @@
+function [ P, Vz] = FD_mod( xS, xR, tmod, dtrcv, dx, cgrid, rhogrid, orig)
+%Summary of this function goes here
+% Detailed explanation goes here
+
+% save Velocity and density grid
+dims = size(cgrid);
+fileID =fopen('mod_cp.bin','w+','l');
+fwrite(fileID,cgrid,'float32');
+fclose(fileID);
+fileID =fopen('mod_ro.bin','w+','l');
+fwrite(fileID,rhogrid,'float32');
+fclose(fileID);
+
+% Compute sizes for makemod
+sizez=(dims(1)-1)*dx;
+sizex=(dims(2)-1)*dx;
+origz=orig(1);
+origx=orig(2);
+zsrc=xS(2);
+xsrc=xS(1);
+
+%write receiver arrays to file
+dlmwrite('rcv.txt',xR, ' ');
+
+%compute dt for modeling dt < 0.606*dx/Cmax
+Cmax=max(cgrid(:));
+dxmod=dx;
+dtmax=0.606*dxmod/Cmax;
+Sdt=ceil(dtrcv/dtmax);
+dtmod=dtrcv/(Sdt);
+ntwave=16384;
+fmax=0.8/(2*dtrcv); % fmax is 80% of Nyquist frequency
+frig=0.75/(2*dtrcv);
+flef=0.05/(2*dtrcv);
+%tmod=(ntrcv-Sdt+1)*dtrcv;
+
+fileID = fopen('run.scr','w+');
+fprintf(fileID,'#!/bin/bash\n');
+fprintf(fileID,'export PATH=$HOME/src/OpenSource/bin:/opt/CWP/bin/:.:$PATH\n');
+fprintf(fileID,'which fdelmodc\n');
+%fprintf(fileID,'set -x\n');
+fprintf(fileID,'dt=%e\n',dtmod);
+fprintf(fileID,'suaddhead < mod_ro.bin ntrpr=%d ns=%d | \\\n',dims(2), dims(1));
+fprintf(fileID,'sushw key=f1,f2,d1,d2,gx,scalco a=%f,%f,%f,%f,%d,-1000 b=0,0,0,0,%d,0 > mod_ro.su\n',origz, origx, dx, dx, int32(origx*1000), int32(dx*1000));
+fprintf(fileID,'suaddhead < mod_cp.bin ntrpr=%d ns=%d | \\\n',dims(2), dims(1));
+fprintf(fileID,'sushw key=f1,f2,d1,d2,gx,scalco a=%f,%f,%f,%f,%d,-1000 b=0,0,0,0,%d,0 > mod_cp.su\n',origz, origx, dx, dx, int32(origx*1000), int32(dx*1000));
+fprintf(fileID,'makewave w=fw fmin=0 flef=%f frig=%f fmax=%f dt=$dt file_out=wavefw.su nt=%d shift=1 scale=0 scfft=1 verbose=1 >& nep\n', flef, frig, fmax, ntwave);
+fprintf(fileID,'t0=`grep shift nep | awk ''{print $6}''`\n');
+fprintf(fileID,'echo rec_delay for shift in wavelet: t0=$t0\n');
+fprintf(fileID,'tmod=$(echo "scale=4; %f+${t0}" | bc -l)\n',tmod);
+fprintf(fileID,'export filecp=mod_cp.su\n');
+fprintf(fileID,'export filero=mod_ro.su\n');
+fprintf(fileID,'export OMP_NUM_THREADS=4\n');
+fprintf(fileID,'fdelmodc \\\n');
+fprintf(fileID,'file_cp=$filecp file_den=$filero \\\n');
+fprintf(fileID,'ischeme=1 \\\n');
+fprintf(fileID,'file_src=wavefw.su verbose=1 \\\n');
+fprintf(fileID,'dt=$dt \\\n');
+fprintf(fileID,'file_rcv=recv.su \\\n');
+fprintf(fileID,'rec_type_vz=1 rec_type_p=1 rec_int_vz=2 \\\n');
+fprintf(fileID,'rcv_txt=rcv.txt \\\n');
+fprintf(fileID,'dtrcv=%e \\\n', dtrcv);
+fprintf(fileID,'xsrc=%f zsrc=%f \\\n', xsrc, zsrc);
+fprintf(fileID,'src_type=1 tmod=$tmod rec_delay=$t0 \\\n');
+fprintf(fileID,'ntaper=100 \\\n');
+fprintf(fileID,'left=2 right=2 bottom=2 top=2 \n\n');
+fprintf(fileID,'\n');
+fprintf(fileID,'sustrip < recv_rp.su > recv_rp.bin\n');
+fprintf(fileID,'sustrip < recv_rvz.su > recv_rvz.bin\n');
+fprintf(fileID,'surange < recv_rp.su | grep ns | awk ''{print $2}'' > samples\n');
+fprintf(fileID,'surange < recv_rp.su | grep traces | awk ''{print $1}'' > traces\n');
+fclose(fileID);
+!chmod +x run.scr
+system('./run.scr');
+
+path = getenv('PATH');
+path = [path ':$HOME/src/OpenSource/bin:/opt/CWP/bin/:.:'];
+setenv('PATH', path);
+
+% get number of samples and traces
+ns=dlmread('samples');
+ntr=dlmread('traces');
+
+% Pressure field
+file='recv_rp.bin';
+fid=fopen(file,'r');
+P=fread(fid,[ns,ntr],'float32');
+fclose(fid);
+
+% Particle velocity field
+file='recv_rvz.bin';
+fid=fopen(file,'r');
+Vz=fread(fid,[ns,ntr],'float32');
+fclose(fid);
+
+end
+
diff --git a/fdelmodc3D/demo/matlab/FD_mod_grid.m b/fdelmodc3D/demo/matlab/FD_mod_grid.m
new file mode 100644
index 0000000000000000000000000000000000000000..fcc86b9cc11f109aa05c9c5a5ae4f0c63a378c45
--- /dev/null
+++ b/fdelmodc3D/demo/matlab/FD_mod_grid.m
@@ -0,0 +1,138 @@
+function [ Ptsct, Pfinc, Pfsct, f_out] = FD_mod_grid( xS, xR, ntrcv, dtrcv, dx, cgrid, rhogrid, f )
+%Summary of this function goes here
+% Detailed explanation goes here
+
+% save Velocity and density grid
+dims = size(cgrid);
+fileID =fopen('mod_cp.bin','w+','l');
+fwrite(fileID,cgrid,'float32');
+fclose(fileID);
+fileID =fopen('mod_ro.bin','w+','l');
+fwrite(fileID,rhogrid,'float32');
+fclose(fileID);
+
+% Compute sizes for makemod
+sizez=(dims(1)-1)*dx;
+sizex=(dims(2)-1)*dx;
+origz=-(dims(1)-1)*dx/2
+origx=-(dims(2)-1)*dx/2
+zrcv1=xR(1)-origz;
+zrcv2=xR(1)-origz;
+xrcv1=0.0;
+xrcv2=xrcv1+(dims(2)-1)*dx;
+zsrc=xS(1)-origz;
+xsrc=xS(2)-origx;
+tmod=(ntrcv-1)*dtrcv;
+
+%compute dt for modeling dt < 0.606*dx/Cmax
+Cmax=max(cgrid(:));
+dxmod=dx;
+dtmax=0.606*dxmod/Cmax;
+dtmod=dtrcv/(ceil(dtrcv/dtmax));
+ntwave=16384;
+ntfft=4*ntrcv;
+
+fileID = fopen('run.scr','w+');
+fprintf(fileID,'#!/bin/bash\n');
+fprintf(fileID,'export PATH=$HOME/src/OpenSource/bin:/opt/CWP/bin/:.:$PATH\n');
+fprintf(fileID,'which fdelmodc\n');
+fprintf(fileID,'which surange\n');
+fprintf(fileID,'set -x\n');
+
+fprintf(fileID,'df=0.25\n');
+fprintf(fileID,'dt=%e\n',dtmod);
+fprintf(fileID,'suaddhead < mod_ro.bin ntrpr=%d ns=%d | \\\n',dims(2), dims(1));
+fprintf(fileID,'sushw key=d1,d2,gx,scalco a=%f,%f,%d,-1000 b=0,0,%d,0 > mod_ro.su\n',dx, dx, int32(xrcv1*1000), int32(dx*1000));
+fprintf(fileID,'suaddhead < mod_cp.bin ntrpr=%d ns=%d | \\\n',dims(2), dims(1));
+fprintf(fileID,'sushw key=d1,d2,gx,scalco a=%f,%f,%d,-1000 b=0,0,%d,0 > mod_cp.su\n',dx, dx, int32(xrcv1*1000), int32(dx*1000));
+fprintf(fileID,'makewave w=fw fmin=0 flef=6 frig=94 fmax=100 dt=$dt file_out=wavefw.su nt=%d t0=0.4 scale=0 scfft=1 verbose=1\n', ntwave);
+fprintf(fileID,'makewave w=fw fmin=0 flef=6 frig=94 fmax=100 dt=%f file_out=wavefwdt.su nt=%d t0=0.4 scale=0 scfft=1 verbose=1\n', dtrcv, ntfft);
+fprintf(fileID,'export filecp=mod_cp.su\n');
+fprintf(fileID,'export filero=mod_ro.su\n');
+fprintf(fileID,'export OMP_NUM_THREADS=2\n');
+fprintf(fileID,'fdelmodc \\\n');
+fprintf(fileID,'file_cp=$filecp file_den=$filero \\\n');
+fprintf(fileID,'ischeme=1 \\\n');
+fprintf(fileID,'file_src=wavefw.su verbose=1 \\\n');
+fprintf(fileID,'file_rcv=recvgrid.su \\\n');
+fprintf(fileID,'rec_type_vz=0 rec_type_p=1 rec_int_vz=2 \\\n');
+fprintf(fileID,'xrcv1=%d xrcv2=%d zrcv1=%d zrcv2=%d \\\n',xrcv1,xrcv2,zrcv1,zrcv2);
+fprintf(fileID,'dxrcv=%d \\\n', dx);
+fprintf(fileID,'dtrcv=%e \\\n', dtrcv);
+fprintf(fileID,'xsrc=%d zsrc=%d\\\n', xsrc, zsrc);
+fprintf(fileID,'src_type=1 tmod=%e \\\n', tmod);
+fprintf(fileID,'ntaper=100 \\\n');
+fprintf(fileID,'left=2 right=2 bottom=2 top=2\n\n');
+fprintf(fileID,'\n');
+fprintf(fileID,'makemod file_base=hom.su \\\n');
+fprintf(fileID,'cp0=1500 ro0=3000 sizex=%d sizez=%d dx=%.1f dz=%.1f orig=0,0 verbose=1\n', sizex,sizez, dxmod,dxmod);
+fprintf(fileID,'export filecp=hom_cp.su\n');
+fprintf(fileID,'export filero=hom_ro.su\n');
+fprintf(fileID,'fdelmodc \\\n');
+fprintf(fileID,'file_cp=$filecp file_den=$filero \\\n');
+fprintf(fileID,'ischeme=1 \\\n');
+fprintf(fileID,'file_src=wavefw.su verbose=1 \\\n');
+fprintf(fileID,'file_rcv=recvhom.su \\\n');
+fprintf(fileID,'rec_type_vz=0 rec_type_p=1 \\\n');
+fprintf(fileID,'xrcv1=%d xrcv2=%d zrcv1=%d zrcv2=%d \\\n',xrcv1,xrcv2,zrcv1,zrcv2);
+fprintf(fileID,'dxrcv=%d \\\n', dx);
+fprintf(fileID,'dtrcv=%e \\\n', dtrcv);
+fprintf(fileID,'xsrc=%d zsrc=%d\\\n', xsrc, zsrc);
+fprintf(fileID,'src_type=1 tmod=%e \\\n', tmod);
+fprintf(fileID,'ntaper=100 \\\n');
+fprintf(fileID,'left=2 right=2 bottom=2 top=2\n\n');
+fprintf(fileID,'suop2 recvgrid_rp.su recvhom_rp.su op=diff > recv_rp.su\n');
+fprintf(fileID,'sustrip < recv_rp.su > recv_rp.bin\n');
+fprintf(fileID,'sustrip < recvhom_rp.su > recvhom_rp.bin\n');
+fprintf(fileID,'sustrip < wavefwdt.su > wavefwdt.bin\n');
+fclose(fileID);
+!chmod +x run.scr
+system('./run.scr');
+
+path = getenv('PATH');
+path = [path ':$HOME/src/OpenSource/bin:/opt/CWP/bin/:.:'];
+setenv('PATH', path);
+
+% Scattered field
+ns=ntrcv;
+ntr=dims(2);
+file='recv_rp.bin';
+fid=fopen(file,'r');
+Ptsct=fread(fid,[ns,ntr],'float32');
+fclose(fid);
+
+% Direct field
+file='recvhom_rp.bin';
+fid=fopen(file,'r');
+Ptinc=fread(fid,[ns,ntr],'float32');
+fclose(fid);
+
+df=double(1.0/(ntfft*dtrcv));
+a=round(f/df)+1;
+f_out=(a-1)*df
+fprintf('selected discrete frequency P %f\n', (a-1)*df)
+% f2=a*df %these are the selected discrete frequencies
+Pfft=fft(Ptsct,ntfft);
+Pfsct=Pfft(a,:);
+%
+Pfft=fft(Ptinc,ntfft);
+Pfinc=Pfft(a,:);
+
+ns=ntfft;
+ntr=1;
+file='wavefwdt.bin';
+fid=fopen(file,'r');
+Wt=fread(fid,[ns,ntr],'float32');
+fclose(fid);
+
+df=double(1.0/(ntfft*dtrcv));
+c=round(f/df)+1; % select frequencies as close as the one's in Pf
+fprintf('selected discrete frequency W %f\n', (c-1)*df)
+Wfft=fft(Wt,ntfft);
+Wf=Wfft(c,1);
+
+Pfsct = (Pfsct)./(1.0*Wf); % deconvolve for the wavelet
+Pfinc = (Pfinc)./(1.0*Wf); % deconvolve for the wavelet
+
+end
+
diff --git a/fdelmodc3D/demo/matlab/ForwardCircle.m b/fdelmodc3D/demo/matlab/ForwardCircle.m
new file mode 100644
index 0000000000000000000000000000000000000000..dd67cc7d51751acbcfebbc2e76f102e621a2a4c4
--- /dev/null
+++ b/fdelmodc3D/demo/matlab/ForwardCircle.m
@@ -0,0 +1,152 @@
+function [P_inc,P_sct,xR] = ForwardCircle( xS, xR, gsize, dxR, c_0, c_s, rho_0, rho_s, f )
+
+% xS = source position
+% dxR = receiver grid size
+% c_0 = wave speed in embedding
+% c_s = wave speed of scattering object
+% rho_0 = mass density in embedding
+% rho_s = mass density of scattering object
+% f = temporal frequency;
+
+wavelength = c_0 / f; % wavelength
+s = 1e-16 + 1i*2*pi*f; % LaPlace parameter
+gam_0 = s/c_0; % propagation coefficient 0
+gam_s = s/c_s; % propagation coefficient s
+a = 40; % radius circle cylinder
+depth = 20; % distance betwen circle and origin
+
+disp(['wavelength = ' num2str(wavelength)]);
+
+% Thorbecke coordinates
+ xSource1 = xS(1); % source position
+ xSource2 = xS(2);
+ xReceiver1 = xR(1); % receiver positions
+ nr=(gsize(2)-1)/2;
+ xReceiver2 = (-nr:nr) * dxR;
+ NR = size(xReceiver2,2);
+
+% Van den Berg coordinates
+ xS(1) = xSource1;
+ xS(2) = xSource2;
+
+ xR(1,1:NR) = xReceiver1;
+ xR(2,1:NR) = xReceiver2(1:NR);
+
+% Compute 2D incident field ---------------------------------------------
+ DIS = sqrt( (xR(1,:)-xS(1)).^2 + (xR(2,:)-xS(2)).^2 );
+ p_inc = 1/(2*pi).* besselk(0,gam_0*DIS);
+
+ % multiply by rho_0 and plot
+ P_inc = rho_0 * p_inc ; % Take care of factor \rho
+
+ % Make grid
+ N1 = gsize(1); % number of samples in x_1
+ N2 = gsize(2); % number of samples in x_2
+ dx = dxR; % with meshsize dx
+ x1 = -(N1+1)*dx/2 + (1:N1)*dx;
+ x2 = -(N2+1)*dx/2 + (1:N2)*dx;
+ [X1,X2] = ndgrid(x1,x2);
+ % Now array subscripts are equivalent with Cartesian coordinates
+ % x1 axis points downwards and x2 axis is in horizontal direction
+ % x1 = X1(:,1) is a column vector in vertical direction
+ % x2 = X2(1,:) is a row vector in horizontal direction
+ R = sqrt(X1.^2 + X2.^2);
+ cgrid = c_s * (R < a) + c_0 * (R >= a);
+ rhogrid = rho_s * (R < a) + rho_0 * (R >= a);
+
+ x1 = X1(:,1); x2 = X2(1,:);
+ set(figure(8),'Units','centimeters','Position',[5 5 18 12]);
+ subplot(1,2,1)
+ imagesc(x2,x1,cgrid);
+ title('\fontsize{13} c-grid');
+ xlabel('x_1 \rightarrow');
+ ylabel('\leftarrow x_3');
+ axis('equal','tight');
+ colorbar('hor'); colormap jet;
+ subplot(1,2,2)
+ imagesc(x2,x1,rhogrid);
+ title('\fontsize{13} \rho-grid');
+ xlabel('x_1 \rightarrow');
+ ylabel('\leftarrow x_3');
+ axis('equal','tight');
+ colorbar('hor'); colormap jet;
+
+
+
+
+
+%-------------------------------------------------------------------------
+% CHECK EXACT INCIDENT FIELD AND BESSEL FUNCTION REPRESENTATION for r = a
+%-------------------------------------------------------------------------
+
+% Transform Cartesian coordinates to polar ccordinates
+ rS = sqrt(xS(1)^2+xS(2)^2); phiS = atan2(xS(2),xS(1));
+ r = a; phi = 0:.01:2*pi;
+
+% (1) Compute incident wave in closed form --------------------------------
+ DIS = sqrt(rS^2 + r.^2 - 2*rS*r.*cos(phiS-phi));
+ p_inc_exact = 1/(2*pi) .* besselk(0,gam_0*DIS);
+ dp_inc_exact = - gam_0 *(r-rS*cos(phiS-phi))./DIS ...
+ .* 1/(2*pi) .* besselk(1,gam_0*DIS);
+
+% (2) Compute incident wave as Bessel series with M+1terms --------------
+ M = 100; % increase M for more accuracy
+
+ p_inc = besselk(0,gam_0*rS) .* besseli(0,gam_0*r);
+ dp_inc = gam_0 * besselk(0,gam_0*rS) .* besseli(1,gam_0*r);
+ for m = 1 : M;
+ Ib0 = besseli(m,gam_0*r);
+ dIb0 = gam_0 * (besseli(m+1,gam_0*r) + m/(gam_0*r) * Ib0);
+ p_inc = p_inc + 2 * besselk(m,gam_0*rS) * Ib0 .* cos(m*(phiS-phi));
+ dp_inc = dp_inc + 2 * besselk(m,gam_0*rS) .* dIb0 .* cos(m*(phiS-phi));
+ end % m_loop
+ p_inc = 1/(2*pi) * p_inc;
+ dp_inc = 1/(2*pi) * dp_inc;
+
+% (3) Determine mean error and plot error in domain -----------------------
+ Error_p = p_inc - p_inc_exact;
+ disp(['normalized norm of error = ' ...
+ num2str(norm(Error_p(:),1)/norm(p_inc_exact(:),1))]);
+ Error_dp = dp_inc - dp_inc_exact;
+ disp(['normalized norm of error = ' ...
+ num2str(norm(Error_dp(:),1)/norm(dp_inc_exact(:),1))]);
+
+ set(figure(9),'Units','centimeters','Position',[5 5 18 14]);
+ subplot(2,1,1)
+ angle = phi * 180 / pi;
+ semilogy(angle,abs(Error_p)./abs(p_inc_exact)); axis tight;
+ xlabel('observation angle in degrees \rightarrow');
+ ylabel('abs(p_{inc}-p_{inc}^{exact}) / abs(p_{inc}^{exact}) \rightarrow');
+ subplot(2,1,2)
+ semilogy(angle,abs(Error_dp)./abs(dp_inc_exact)); axis tight;
+ title('\fontsize{12} relative error on circle boundary');
+ xlabel('observation angle in degrees \rightarrow');
+ ylabel('abs(dp_{inc}-dp_{inc}^{exact}) / abs(dp_{inc}^{exact}) \rightarrow');
+
+%--------------------------------------------------------------------------
+% COMPUTE SCATTERED FIELD WITH BESSEL FUNCTION REPRESENTATION for r > a
+%--------------------------------------------------------------------------
+
+% (4) Compute coefficients of series expansion ----------------------------
+ Z_0 = c_0 * rho_0; Z_s = c_s * rho_s;
+ arg0 = gam_0 * a; args = gam_s *a;
+ A = zeros(1,M+1);
+ for m = 0 : M;
+ Ib0 = besseli(m,arg0); dIb0 = besseli(m+1,arg0) + m/arg0 * Ib0;
+ Ibs = besseli(m,args); dIbs = besseli(m+1,args) + m/args * Ibs;
+ Kb0 = besselk(m,arg0); dKb0 = -besselk(m+1,arg0) + m/arg0 * Kb0;
+ A(m+1) = - ((1/Z_s) * dIbs*Ib0 - (1/Z_0) * dIb0*Ibs) ...
+ /((1/Z_s) * dIbs*Kb0 - (1/Z_0) * dKb0*Ibs);
+ end
+
+% (5) Compute scattered field at receivers (data) -------------------------
+ rR = sqrt(xR(1,:).^2 + xR(2,:).^2); phiR = atan2(xR(2,:),xR(1,:));
+ rS = sqrt(xS(1)^2 + xS(2)^2); phiS = atan2(xS(2),xS(1));
+ p_sct = A(1) * besselk(0,gam_0*rS).* besselk(0,gam_0*rR);
+ for m = 1 : M;
+ factor = 2 * besselk(m,gam_0*rS) .* cos(m*(phiS-phiR));
+ p_sct = p_sct + A(m+1) * factor .* besselk(m,gam_0*rR);
+ end % m_loop
+ p_sct = 1/(2*pi) * p_sct;
+ P_sct = rho_0 * p_sct; % Take care of factor \rho
+end
\ No newline at end of file
diff --git a/fdelmodc3D/demo/matlab/comparison.m b/fdelmodc3D/demo/matlab/comparison.m
new file mode 100644
index 0000000000000000000000000000000000000000..796e68149c957dade92e5c00dc3dce0f20e6e361
--- /dev/null
+++ b/fdelmodc3D/demo/matlab/comparison.m
@@ -0,0 +1,83 @@
+clear all; close all; clc;
+
+display('Running test');
+
+xS = [-100,0]; % source position: 100 m above center
+xR = [-60,0]; % central point of receiver array (-50*dxR:50*dxR)
+c_0 = 1500; % wave speed in embedding
+c_s = 3000; % wave speed in scattering object
+rho_0 = 3000; % mass density of enbedding
+rho_s = 1500; % mass density of scattering object
+
+dxR = 0.5; % receiver grid size
+gsize = [1+240/dxR,1+200/dxR]; % gridsize in [z,x], center of model at coordinate (0,0)
+f_in = 50; % selected frequency to compare, returned in Pf
+ntrcv = 256; % number of time samples in FD modeling
+dtrcv = 0.004; % dt in receivers
+
+
+% Make grid
+a = 40; % radius circle cylinder
+N1 = gsize(1); % number of samples in x_1
+N2 = gsize(2); % number of samples in x_2
+dx = dxR; % with meshsize dx
+x1 = -(N1+1)*dx/2 + (1:N1)*dx;
+x2 = -(N2+1)*dx/2 + (1:N2)*dx;
+[X1,X2] = ndgrid(x1,x2);
+% Now array subscripts are equivalent with Cartesian coordinates
+% x1 axis points downwards and x2 axis is in horizontal direction
+% x1 = X1(:,1) is a column vector in vertical direction
+% x2 = X2(1,:) is a row vector in horizontal direction
+R = sqrt(X1.^2 + X2.^2);
+cgrid = c_s * (R < a) + c_0 * (R >= a);
+rhogrid = rho_s * (R < a) + rho_0 * (R >= a);
+
+% DATA from Thorbecke's finite difference code
+[Ptsct, Pfinc, Pfsct, f_out]=FD_mod_grid( xS, xR, ntrcv, dtrcv, dxR, cgrid, rhogrid, f_in );
+
+f=f_out % nearest computed discrete frequency
+
+% Compare with analytical solution ---------------------------------------
+[P_inc,P_sct,xR] = ForwardCircle( xS, xR, gsize, dxR, c_0, c_s, rho_0, rho_s, f );
+
+set(figure(1),'Units','centimeters','Position',[1 1 30 10]);
+subplot(1,3,1)
+ plot(xR(2,:),real(Pfinc),'LineWidth',1.2);
+ title('Real part of P^{inc}'); axis tight; hold on;
+ plot(xR(2,:),real(P_inc),'--r','LineWidth',1.2);
+ axis tight; hold off;
+subplot(1,3,2)
+ plot(xR(2,:),imag(Pfinc),'LineWidth',1.2);
+ title('Imaginary part of P^{inc}'); axis tight; hold on;
+ plot(xR(2,:),imag(P_inc),'--r','LineWidth',1.2);
+ axis tight; hold off;
+subplot(1,3,3)
+ plot(xR(2,:), abs(Pfinc),'LineWidth',1.2);
+ title('Absolute value of P^{inc}'); axis tight; hold on;
+ plot(xR(2,:), abs(P_inc),'--r','LineWidth',1.2);
+ axis tight; hold off
+legendtitle1 = sprintf('f=%.2fHz FiniteDiff', f);
+legendtitle2 = sprintf('f=%.2fHz Analytic ', f);
+legend(legendtitle1,legendtitle2,'Location','Best');
+
+set(figure(2),'Units','centimeters','Position',[9 12 10 10]);
+error = abs(P_sct(:)-Pfsct(:))./abs(Pfsct(:));
+plot(error,'LineWidth',1.2); title('Relative error'); axis tight;
+
+set(figure(3),'Units','centimeters','Position',[1 1 30 10]);
+subplot(1,3,1)
+ plot(xR(2,:),real(Pfsct),'LineWidth',1.2);
+ title('Real part of P_{sct}'); axis tight; hold on;
+ plot(xR(2,:),real(P_sct),'LineWidth',1.2);
+subplot(1,3,2)
+ plot(xR(2,:),imag(Pfsct),'LineWidth',1.2);
+ title('Imaginary part of P^{sct}'); axis tight; hold on;
+ plot(xR(2,:),imag(P_sct),'LineWidth',1.2);
+subplot(1,3,3)
+ plot(xR(2,:), abs(Pfsct),'LineWidth',1.2);
+ title('Absolute value of P^{sct}'); axis tight; hold on;
+ plot(xR(2,:), abs(P_sct),'LineWidth',1.2);
+ axis tight; hold off
+legendtitle1 = sprintf('f=%.2fHz FiniteDiff', f);
+legendtitle2 = sprintf('f=%.2fHz Analytic ', f);
+legend(legendtitle1,legendtitle2,'Location','Best');
diff --git a/fdelmodc3D/demo/matlab/test_matlab_interface.m b/fdelmodc3D/demo/matlab/test_matlab_interface.m
new file mode 100644
index 0000000000000000000000000000000000000000..7046233db61ebecbfc62ce21a53c48a73fd9ca79
--- /dev/null
+++ b/fdelmodc3D/demo/matlab/test_matlab_interface.m
@@ -0,0 +1,47 @@
+clear all; clc; close all; clear workspace
+
+% set number of dimensions
+global nDIM; nDIM = 2; % set dimension of space
+
+ % set up spatial grid
+ N1fd = 1280; N2fd = 1280; dxfd =2.13313822/5;
+ x1fd = -(N1fd+1)*dxfd/2 + (1:N1fd)*dxfd;
+ x2fd = -(N2fd+1)*dxfd/2 + (1:N2fd)*dxfd;
+ orig = [-(N1fd+1)*dxfd/2,-(N2fd+1)*dxfd/2];
+ [X1fd,X2fd] = ndgrid(x1fd,x2fd);
+
+ % load model
+% filn=sprintf('sos_fidmod.bin'); fid = fopen(filn,'r'); sos_fd = fread(fid,[N1fd*N2fd],'float32'); fclose('all');
+% filn=sprintf('rho_fidmod.bin'); fid = fopen(filn,'r'); rho_fd = fread(fid,[N1fd*N2fd],'float32'); fclose('all');
+% sos_fd = reshape(sos_fd,[N1fd,N2fd]);
+% rho_fd = reshape(rho_fd,[N1fd,N2fd]);
+ sos_fd = ones(N1fd,N2fd)*1500; % speed of sound
+ rho_fd = ones(N1fd,N2fd)*1500; % density
+
+
+ % time parameters
+ Ntdf = 1024; dtdf = 10^(-3);
+
+ % set up acquisition grid
+ r_rec = 200; % radius of circle
+ Nr = 250; % number of receivers
+ rcvr_phi(1:Nr) = (1:Nr) * 2*pi/Nr; % angles
+ xR = zeros(2,Nr);
+ xR(1,1:Nr) = r_rec * cos(rcvr_phi);
+ xR(2,1:Nr) = r_rec * sin(rcvr_phi);
+ xS = xR(:,1) % choose source at first position
+
+ % plot the impedance and acquisition geometry
+ figure; imagesc(x1fd,x2fd,sos_fd.*rho_fd);
+ hold on; scatter(xR(1,:),xR(2,:),'*b');
+ hold on; scatter(xS(1,:),xS(2,:),'*r');
+ xlabel('x (m)');
+ ylabel('y (m)');
+
+ % Call finite difference code
+ [P, Vz]=FD_mod( xS.', xR.', 0.5, dtdf, dxfd, sos_fd, rho_fd, orig);
+
+ % make a plot
+ figure;imagesc(P);
+ xlabel('angle (degrees)');
+ ylabel('time (t)');
diff --git a/fdelmodc3D/demo/migrFundamentals.scr b/fdelmodc3D/demo/migrFundamentals.scr
new file mode 100755
index 0000000000000000000000000000000000000000..8d3d37787451a15cedd69ee5bc379148fea9fe99
--- /dev/null
+++ b/fdelmodc3D/demo/migrFundamentals.scr
@@ -0,0 +1,165 @@
+#!/bin/bash
+#PBS -N fdelmod
+#PBS -q verylong
+#PBS -l nodes=1
+#PBS -k eo
+#PBS -j eo
+
+which makewave
+which makemod
+
+cd /Users/jan/src/OpenSource/fdelmodc/demo
+
+cp=2000
+rho=1000
+dx=5
+dt=0.0010
+
+makemod sizex=6000 sizez=4000 dx=$dx dz=$dx cp0=$cp cs0=$cs ro0=$rho \
+ orig=-3000,-1000 file_base=syncl.su \
+ intt=def x=-3000,0,3000 z=250,250,250 poly=0 cp=2300 ro=5000 \
+ intt=def x=-3000,-2000,-1000,-800,0,800,3000 z=650,650,700,750,900,750,600 poly=2 cp=2600 ro=1000 \
+ intt=def x=-3000,0,3000 z=1390,1390,1390 poly=0 cp=2000 ro=5000
+
+makemod sizex=5000 sizez=2500 dx=$dx dz=$dx cp0=$cp cs0=$cs ro0=$rho \
+ orig=-2500,-500 file_base=model.su \
+ intt=def x=-2500,0,2500 z=1000,1000,1000 poly=0 cp=2000 ro=5000 cs=1200
+
+# intt=def x=-2500,0,2500 z=500,500,500 poly=0 cp=2300 ro=5000
+
+makewave fp=20 dt=$dt file_out=wave.su nt=4096 t0=0.1
+
+../fdelmodc \
+ file_cp=model_cp.su ischeme=1 \
+ file_den=model_ro.su \
+ file_src=wave.su \
+ file_rcv=shot_x1150.su \
+ src_type=1 \
+ src_orient=1 \
+ src_injectionrate=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.0010 \
+ rec_delay=0.1 \
+ verbose=2 \
+ tmod=2.10 \
+ dxrcv=5.0 \
+ xrcv1=-2250 xrcv2=2250 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=0 zsrc=0 \
+ ntaper=100 \
+ sna_type_p=0 \
+ sna_type_vz=1 \
+ xsnap1=-2250 xsnap2=2250 zsnap1=0 zsnap2=2000 \
+ dxsnap=10 dzsnap=10 tsnap1=0.1 tsnap2=2.1 dtsnap=0.005 \
+ left=4 right=4 top=4 bottom=4
+
+
+makemod sizex=5000 sizez=2500 dx=$dx dz=$dx cp0=$cp cs0=$cs ro0=$rho \
+ orig=-2500,-500 file_base=hom.su
+
+../fdelmodc \
+ file_cp=hom_cp.su ischeme=1 \
+ file_den=hom_ro.su \
+ file_src=wave.su \
+ file_rcv=shothom_x1150.su \
+ file_snap=snaphom.su \
+ src_type=1 \
+ src_orient=1 \
+ src_injectionrate=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.0010 \
+ rec_delay=0.1 \
+ verbose=2 \
+ tmod=2.10 \
+ dxrcv=5.0 \
+ xrcv1=-2250 xrcv2=2250 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=0 zsrc=0 \
+ ntaper=100 \
+ sna_type_p=0 \
+ sna_type_vz=1 \
+ xsnap1=-2250 xsnap2=2250 zsnap1=0 zsnap2=2000 \
+ dxsnap=10 dzsnap=10 tsnap1=0.1 tsnap2=2.1 dtsnap=0.005 \
+ left=4 right=4 top=4 bottom=4
+
+
+sudiff shot_x1150_rp.su shothom_x1150_rp.su > shot_refl_rp.su
+sudiff shot_x1150_rvz.su shothom_x1150_rvz.su > shot_refl_rvz.su
+#sudiff snap_svz.su snaphom_svz.su > snap_refl_rp.su
+
+../fdelmodc \
+ file_cp=hom_cp.su ischeme=1 \
+ file_den=hom_ro.su \
+ file_src=shot_refl_rp.su \
+ file_rcv=shot_reverse_x1150.su \
+ file_snap=snap_reverse.su \
+ grid_dir=1 \
+ src_type=1 \
+ src_orient=1 \
+ src_injectionrate=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.0010 \
+ rec_delay=0.0 \
+ verbose=2 \
+ tmod=2.0 \
+ dxrcv=5.0 \
+ xrcv1=-2250 xrcv2=2250 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=0 zsrc=0 \
+ ntaper=100 \
+ sna_type_p=0 \
+ sna_type_vz=1 \
+ xsnap1=-2250 xsnap2=2250 zsnap1=0 zsnap2=2000 \
+ dxsnap=10 dzsnap=10 tsnap1=0.0 tsnap2=2.0 dtsnap=0.005 \
+ left=4 right=4 top=4 bottom=4
+
+susort < snap_reverse_svz.su -fldr +tracf > snap_reverse_svz_swap.su
+
+#suxmovie < snap_reverse_svz.su n2=451 loop=1 n3=401 clip=100 title=%g
+
+
+#fconv file_in1=snap_reverse_svz_swap.su file_in2=snap_svz.su mode=cor2 shift=0 > image_snap.su verbose=1
+#fconv file_in1=snap_reverse_svz_swap.su file_in2=snaphom_svz.su mode=cor2 shift=0 > image_snap.su verbose=1
+
+sustrip < snap_svz.su > snap_svz.bin
+sustrip < snaphom_svz.su > snaphom_svz.bin
+sustrip < snap_reverse_svz.su > snap_reverse_svz.bin
+sustrip < snap_reverse_svz_swap.su > snap_reverse_svz_swap.bin
+
+transp3d < snap_reverse_svz_swap.bin > snap_reverse_svz_swap_321.bin n1=201 n2=451 n3=401 verbose=1 nbpe=4 scratchdir="/tmp" perm=321
+transp3d < snaphom_svz.bin > snaphom_321.bin n1=201 n2=451 n3=401 verbose=1 nbpe=4 scratchdir="/tmp" perm=321
+
+
+suaddhead ns=401 ntrpr=451 < snap_reverse_svz_swap_321.bin | sushw key=fldr a=1 j=451 c=1 | \
+ sushw key=dt a=1 > snap_reverse_svz_swap_321.su
+#transpose verbose=3 < snap_reverse_svz_swap_231.su > snap_reverse_svz_swap_231_tr.su
+
+suaddhead ns=401 ntrpr=451 < snaphom_321.bin | sushw key=fldr a=1 j=451 c=1 | \
+ sushw key=dt a=1 > snaphom_321.su
+#transpose verbose=3 < snaphom_231.su > snaphom_231_tr.su
+
+fconv file_in1=snap_reverse_svz_swap_321.su file_in2=snaphom_321.su mode=cor2 shift=0 > image_snap.su verbose=1
+
+#suxmovie < image_snap.su n2=451 loop=1 n3=201 clip=1 title=%g
+
+sustrip < image_snap.su > image_snap.bin
+transp3d < image_snap.bin > image_snap_123.bin n3=201 n2=451 n1=401 verbose=1 nbpe=4 scratchdir="/tmp" perm=321
+
+
+i=0
+rm build_image.su
+suaddhead < image_snap_123.bin ns=201 ntrpr=451 | suwind key=tracl min=1 max=451 dt=1 > imagetmp.su
+while (( i <= 200 ))
+do
+suwind dt=1 itmin=0 itmax=$i < imagetmp.su| \
+suwind itmax=200 dt=1 >> build_image.su
+ (( i = $i + 1 ))
+done
+
+sustrip < build_image.su > build_image.bin
diff --git a/fdelmodc3D/demo/migrFundamentalsl2.scr b/fdelmodc3D/demo/migrFundamentalsl2.scr
new file mode 100755
index 0000000000000000000000000000000000000000..77493c44bc2df3f7c032c691c51bee483cd3caf5
--- /dev/null
+++ b/fdelmodc3D/demo/migrFundamentalsl2.scr
@@ -0,0 +1,165 @@
+#!/bin/bash
+#PBS -N fdelmod
+#PBS -q verylong
+#PBS -l nodes=1
+#PBS -k eo
+#PBS -j eo
+
+which makewave
+which makemod
+
+cd /Users/jan/src/OpenSource/fdelmodc/demo
+
+cp=2000
+rho=1000
+dx=5
+dt=0.0010
+
+makemod sizex=6000 sizez=4000 dx=$dx dz=$dx cp0=$cp cs0=$cs ro0=$rho \
+ orig=-3000,-1000 file_base=syncl.su \
+ intt=def x=-3000,0,3000 z=250,250,250 poly=0 cp=2300 ro=5000 \
+ intt=def x=-3000,-2000,-1000,-800,0,800,3000 z=650,650,700,750,900,750,600 poly=2 cp=2600 ro=1000 \
+ intt=def x=-3000,0,3000 z=1390,1390,1390 poly=0 cp=2000 ro=5000
+
+makemod sizex=5000 sizez=2500 dx=$dx dz=$dx cp0=$cp cs0=$cs ro0=$rho \
+ orig=-2500,-500 file_base=model.su \
+ intt=def x=-2500,0,2500 z=750,750,750 poly=0 cp=2000 ro=5000 cs=1200 \
+ intt=def x=-2500,0,2500 z=1000,1000,1000 poly=0 cp=2000 ro=1000 cs=1200
+
+# intt=def x=-2500,0,2500 z=500,500,500 poly=0 cp=2300 ro=5000
+
+makewave fp=20 dt=$dt file_out=wave.su nt=4096 t0=0.1
+
+../fdelmodc \
+ file_cp=model_cp.su ischeme=1 \
+ file_den=model_ro.su \
+ file_src=wave.su \
+ file_rcv=shot_x1150_l2.su \
+ file_snap=snap_l2.su \
+ src_type=1 \
+ src_orient=1 \
+ src_injectionrate=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.0010 \
+ rec_delay=0.1 \
+ verbose=2 \
+ tmod=2.10 \
+ dxrcv=5.0 \
+ xrcv1=-2250 xrcv2=2250 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=0 zsrc=0 \
+ ntaper=100 \
+ sna_type_p=0 \
+ sna_type_vz=1 \
+ xsnap1=-2250 xsnap2=2250 zsnap1=0 zsnap2=2000 \
+ dxsnap=10 dzsnap=10 tsnap1=0.1 tsnap2=2.1 dtsnap=0.005 \
+ left=4 right=4 top=4 bottom=4
+
+
+makemod sizex=5000 sizez=2500 dx=$dx dz=$dx cp0=$cp cs0=$cs ro0=$rho \
+ orig=-2500,-500 file_base=hom.su
+
+../fdelmodc \
+ file_cp=hom_cp.su ischeme=1 \
+ file_den=hom_ro.su \
+ file_src=wave.su \
+ file_rcv=shothom_x1150_l2.su \
+ file_snap=snaphom_l2.su \
+ src_type=1 \
+ src_orient=1 \
+ src_injectionrate=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.0010 \
+ rec_delay=0.1 \
+ verbose=2 \
+ tmod=2.10 \
+ dxrcv=5.0 \
+ xrcv1=-2250 xrcv2=2250 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=0 zsrc=0 \
+ ntaper=100 \
+ sna_type_p=0 \
+ sna_type_vz=1 \
+ xsnap1=-2250 xsnap2=2250 zsnap1=0 zsnap2=2000 \
+ dxsnap=10 dzsnap=10 tsnap1=0.1 tsnap2=2.1 dtsnap=0.005 \
+ left=4 right=4 top=4 bottom=4
+
+
+sudiff shot_x1150_l2_rp.su shothom_x1150_l2_rp.su > shot_refl_l2_rp.su
+
+../fdelmodc \
+ file_cp=hom_cp.su ischeme=1 \
+ file_den=hom_ro.su \
+ file_src=shot_refl_l2_rp.su \
+ file_rcv=shot_reverse_x1150_l2.su \
+ file_snap=snap_reverse_l2.su \
+ grid_dir=1 \
+ src_type=1 \
+ src_orient=1 \
+ src_injectionrate=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.0010 \
+ rec_delay=0.0 \
+ verbose=2 \
+ tmod=2.0 \
+ dxrcv=5.0 \
+ xrcv1=-2250 xrcv2=2250 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=0 zsrc=0 \
+ ntaper=100 \
+ sna_type_p=0 \
+ sna_type_vz=1 \
+ xsnap1=-2250 xsnap2=2250 zsnap1=0 zsnap2=2000 \
+ dxsnap=10 dzsnap=10 tsnap1=0.0 tsnap2=2.0 dtsnap=0.005 \
+ left=4 right=4 top=4 bottom=4
+
+susort < snap_reverse_l2_svz.su -fldr +tracf > snap_reverse_l2_svz_swap.su
+
+#suxmovie < snap_reverse_svz.su n2=451 loop=1 n3=401 clip=100 title=%g
+
+
+#fconv file_in1=snap_reverse_svz_swap.su file_in2=snap_svz.su mode=cor2 shift=0 > image_snap.su verbose=1
+#fconv file_in1=snap_reverse_svz_swap.su file_in2=snaphom_svz.su mode=cor2 shift=0 > image_snap.su verbose=1
+
+#sustrip < snap_l2_svz.su > snap_l2_svz.bin
+sustrip < snaphom_l2_svz.su > snaphom_l2_svz.bin
+#sustrip < snap_reverse_l2_svz.su > snap_reverse_l2_svz.bin
+sustrip < snap_reverse_l2_svz_swap.su > snap_reverse_l2_svz_swap.bin
+
+transp3d < snap_reverse_l2_svz_swap.bin > snap_reverse_l2_svz_swap_321.bin n1=201 n2=451 n3=401 verbose=1 nbpe=4 scratchdir="/tmp" perm=321
+transp3d < snaphom_l2_svz.bin > snaphom_l2_321.bin n1=201 n2=451 n3=401 verbose=1 nbpe=4 scratchdir="/tmp" perm=321
+
+suaddhead ns=401 ntrpr=451 < snap_reverse_l2_svz_swap_321.bin | sushw key=fldr a=1 j=451 c=1 | \
+ sushw key=dt a=1 > snap_reverse_l2_svz_swap_321.su
+
+suaddhead ns=401 ntrpr=451 < snaphom_l2_321.bin | sushw key=fldr a=1 j=451 c=1 | \
+ sushw key=dt a=1 > snaphom_l2_321.su
+
+fconv file_in1=snap_reverse_l2_svz_swap_321.su file_in2=snaphom_l2_321.su mode=cor2 shift=1 > image_l2_snap.su verbose=1
+sustrip < image_l2_snap.su > image_l2_snap.bin
+
+
+fconv file_in1=snap_reverse_l2_svz_swap_321.su file_in2=snaphom_l2_321.su mode=cor2 shift=0 > image_l2_snap.su verbose=1
+transp3d < image_l2_snap.bin > image_l2_snap_123.bin n3=201 n2=451 n1=401 verbose=1 nbpe=4 scratchdir="/tmp" perm=321
+
+suaddhead < image_l2_snap_123.bin ns=201 ntrpr=451 | suwind key=tracl min=1 max=451 dt=1 > imagetmp.su
+
+i=0
+rm build_l2_image.su
+while (( i <= 200 ))
+do
+suwind dt=1 itmin=0 itmax=$i < imagetmp.su| \
+suwind itmax=200 dt=1 >> build_l2_image.su
+ (( i = $i + 1 ))
+done
+
+sustrip < build_l2_image.su > build_l2_image.bin
+
+
+
diff --git a/fdelmodc3D/demo/model.scr b/fdelmodc3D/demo/model.scr
new file mode 100755
index 0000000000000000000000000000000000000000..e7702dc877498bea890a1f5fe6908763009152a2
--- /dev/null
+++ b/fdelmodc3D/demo/model.scr
@@ -0,0 +1,52 @@
+#!/bin/bash
+#SBATCH -J OpenMP-test
+#SBATCH --nodes=1
+#SBATCH --ntasks-per-node=40
+#SBATCH --time=0:15:00
+
+cd $SLURM_SUBMIT_DIR
+
+cp=2000
+rho=1000
+dx=2.5
+dt=0.0005
+
+makemod sizex=6000 sizez=2000 dx=$dx dz=$dx cp0=$cp cs0=$cs ro0=$rho \
+ orig=-3000,0 file_base=syncl.su \
+ intt=def x=-3000,0,3000 z=400,400,400 poly=0 cp=2050 ro=1500 \
+ intt=def x=-3000,-2000,-1000,-800,0,800,3000 z=650,650,700,750,900,750,600 poly=2 cp=2100 ro=2000 \
+ intt=def x=-3000,3000 z=1250,1250 poly=0 cp=2400 ro=1800 \
+
+makewave fp=20 dt=$dt file_out=wave.su nt=4096 t0=0.1
+
+#
+export KMP_AFFINITY=verbose,granularity=fine,compact,1,0
+
+for threads in 2 4 8 12 16 20 24
+do
+
+export OMP_NUM_THREADS=$threads
+echo "number of threads=$threads"
+
+time ../fdelmodc \
+ file_cp=syncl_cp.su ischeme=1 \
+ file_den=syncl_ro.su \
+ file_src=wave.su \
+ file_rcv=shot_fd.su \
+ src_type=7 \
+ src_orient=1 \
+ src_injectionrate=1 \
+ rec_type_vz=1 \
+ rec_type_p=1 \
+ dtrcv=0.0010 \
+ rec_delay=0.1 \
+ verbose=2 \
+ tmod=4.10 \
+ dxrcv=10.0 \
+ xrcv1=-2500 xrcv2=2500 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=0 zsrc=0 \
+ ntaper=101 \
+ left=2 right=2 bottom=2 top=1
+
+done
diff --git a/fdelmodc3D/demo/modelOilGas.scr b/fdelmodc3D/demo/modelOilGas.scr
new file mode 100755
index 0000000000000000000000000000000000000000..5fa26904388a3d67e07cc72a6bc7861d1b5bec16
--- /dev/null
+++ b/fdelmodc3D/demo/modelOilGas.scr
@@ -0,0 +1,97 @@
+#!/bin/bash
+
+export PATH=$HOME/bin:$HOME/src/OpenSource/utils:$PATH:
+
+cp=2000
+rho=2500
+dx=2.5
+dt=0.0005
+
+
+makemod sizex=5000 sizez=2500 dx=$dx dz=$dx cp0=$cp ro0=$rho \
+ orig=-2500,0 file_base=syncl.su \
+ intt=def x=-2500,0,2500 z=250,250,250 poly=0 cp=2300 ro=2000 \
+ intt=def x=-2500,-2000,-1000,-800,0,800,2500 z=650,650,700,750,900,750,600 poly=2 cp=2600 ro=2500 \
+ intt=def x=-2500,0,2500 z=1390,1390,1390 poly=0 cp=2000 ro=2000
+
+makewave w=g1 fp=20 dt=$dt file_out=wave.su nt=4096 t0=0.1
+
+export OMP_NUM_THREADS=1
+
+zsrc=1100
+zsrc=0
+
+which fdelmodc
+
+fdelmodc \
+ file_cp=syncl_cp.su ischeme=1 iorder=4 \
+ file_den=syncl_ro.su \
+ file_src=wave.su \
+ file_rcv=shot_fd.su \
+ src_type=7 \
+ src_orient=1 \
+ src_injectionrate=0 \
+ rec_type_vz=1 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.004 \
+ rec_delay=0.1 \
+ verbose=2 \
+ tmod=2.01 \
+ dxrcv=10.0 \
+ xrcv1=-2250 xrcv2=2250 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=0 zsrc=$zsrc \
+ file_snap=snapF_$zsrc \
+ tsnap1=0.1 tsnap2=2.0 dtsnap=0.05 dxsnap=$dx dzsnap=$dx \
+ ntaper=101 \
+ snapwithbnd=1 \
+ left=2 right=2 top=2 bottom=2
+
+#suxmovie < snapF_${zsrc}_svz.su loop=1 clip=1e-13
+
+exit
+
+makemod sizex=5000 sizez=2500 dx=$dx dz=$dx cp0=$cp ro0=$rho \
+ orig=-2500,0 file_base=hom.su
+
+fdelmodc \
+ file_cp=hom_cp.su ischeme=1 iorder=4 \
+ file_den=hom_ro.su \
+ file_src=wave.su \
+ file_rcv=shot_hom_fd.su \
+ src_type=7 \
+ src_orient=1 \
+ src_injectionrate=1 \
+ rec_type_vz=1 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.004 \
+ rec_delay=0.1 \
+ verbose=2 \
+ tmod=4.195 \
+ dxrcv=10.0 \
+ xrcv1=-2250 xrcv2=2250 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=0 zsrc=0 \
+ ntaper=250 \
+ left=4 right=4 top=1 bottom=4
+
+cp=2000
+rho=1000
+dx=10
+
+makemod sizex=5000 sizez=2500 dx=$dx dz=2.5 cp0=$cp ro0=$rho \
+ orig=-2500,0 file_base=syncl_migr.su \
+ intt=def x=-2500,0,2500 z=250,250,250 poly=0 cp=2300 ro=5000 \
+ intt=def x=-2500,-2000,-1000,-800,0,800,2500 z=650,650,700,750,900,750,600 poly=2 cp=2600 ro=1000 \
+ intt=def x=-2500,0,2500 z=1390,1390,1390 poly=0 cp=2000 ro=5000
+
+sudiff shot_fd_rvz.su shot_hom_fd_rvz.su > diff_rvz.su
+
+makewave fp=20 dt=0.004 file_out=wavedt.su nt=1024 t0=0.0
+
+migr file_shot=diff_rvz.su file_src=wavedt.su file_vel=syncl_migr_cp.su nshots=1 \
+ file_image=migr0.su verbose=3 imc=0
+
+
diff --git a/fdelmodc3D/demo/modelOilGas.scr.ok b/fdelmodc3D/demo/modelOilGas.scr.ok
new file mode 100755
index 0000000000000000000000000000000000000000..89907c0d5c8891a821c3b06d27cdbd1f25b94fdf
--- /dev/null
+++ b/fdelmodc3D/demo/modelOilGas.scr.ok
@@ -0,0 +1,95 @@
+#!/bin/bash
+
+#export PATH=$HOME/bin:$HOME/src/OpenSource/utils:$PATH:
+
+cp=2000
+rho=2500
+dx=2.5
+dt=0.0005
+
+
+makemod sizex=5000 sizez=2500 dx=$dx dz=$dx cp0=$cp ro0=$rho \
+ orig=-2500,0 file_base=syncl.su \
+ intt=def x=-2500,0,2500 z=250,250,250 poly=0 cp=2300 ro=2000 \
+ intt=def x=-2500,-2000,-1000,-800,0,800,2500 z=650,650,700,750,900,750,600 poly=2 cp=2600 ro=2500 \
+ intt=def x=-2500,0,2500 z=1390,1390,1390 poly=0 cp=2000 ro=2000
+
+makewave w=g1 fp=20 dt=$dt file_out=wave.su nt=4096 t0=0.1
+
+export OMP_NUM_THREADS=8
+
+zsrc=1100
+zsrc=0
+
+../fdelmodc \
+ file_cp=syncl_cp.su ischeme=1 iorder=4 \
+ file_den=syncl_ro.su \
+ file_src=wave.su \
+ file_rcv=shot_fd.su \
+ src_type=7 \
+ src_orient=1 \
+ src_injectionrate=0 \
+ rec_type_vz=1 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.004 \
+ rec_delay=0.1 \
+ verbose=2 \
+ tmod=2.01 \
+ dxrcv=10.0 \
+ xrcv1=-2250 xrcv2=2250 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=0 zsrc=$zsrc \
+ file_snap=snapF_$zsrc \
+ tsnap1=0.1 tsnap2=2.0 dtsnap=0.05 dxsnap=$dx dzsnap=$dx \
+ ntaper=101 \
+ snapwithbnd=1 \
+ left=2 right=2 top=2 bottom=2
+
+suxmovie < snapF_${zsrc}_svz.su loop=1 clip=1e-13
+
+exit
+
+makemod sizex=5000 sizez=2500 dx=$dx dz=$dx cp0=$cp ro0=$rho \
+ orig=-2500,0 file_base=hom.su
+
+fdelmodc \
+ file_cp=hom_cp.su ischeme=1 iorder=4 \
+ file_den=hom_ro.su \
+ file_src=wave.su \
+ file_rcv=shot_hom_fd.su \
+ src_type=7 \
+ src_orient=1 \
+ src_injectionrate=1 \
+ rec_type_vz=1 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.004 \
+ rec_delay=0.1 \
+ verbose=2 \
+ tmod=4.195 \
+ dxrcv=10.0 \
+ xrcv1=-2250 xrcv2=2250 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=0 zsrc=0 \
+ ntaper=250 \
+ left=4 right=4 top=1 bottom=4
+
+cp=2000
+rho=1000
+dx=10
+
+makemod sizex=5000 sizez=2500 dx=$dx dz=2.5 cp0=$cp ro0=$rho \
+ orig=-2500,0 file_base=syncl_migr.su \
+ intt=def x=-2500,0,2500 z=250,250,250 poly=0 cp=2300 ro=5000 \
+ intt=def x=-2500,-2000,-1000,-800,0,800,2500 z=650,650,700,750,900,750,600 poly=2 cp=2600 ro=1000 \
+ intt=def x=-2500,0,2500 z=1390,1390,1390 poly=0 cp=2000 ro=5000
+
+sudiff shot_fd_rvz.su shot_hom_fd_rvz.su > diff_rvz.su
+
+makewave fp=20 dt=0.004 file_out=wavedt.su nt=1024 t0=0.0
+
+migr file_shot=diff_rvz.su file_src=wavedt.su file_vel=syncl_migr_cp.su nshots=1 \
+ file_image=migr0.su verbose=3 imc=0
+
+
diff --git a/fdelmodc3D/demo/model_flank.scr b/fdelmodc3D/demo/model_flank.scr
new file mode 100755
index 0000000000000000000000000000000000000000..82ebafc7ec3dfaf625779735af83f36bb4aca5eb
--- /dev/null
+++ b/fdelmodc3D/demo/model_flank.scr
@@ -0,0 +1,22 @@
+#!/bin/bash
+#
+# builds a model which has a steep flank on the side, used in fdelmodc_srcrec.scr
+#
+
+sizex=8000
+dx=5
+dz=5
+
+makemod sizex=$sizex sizez=8000 dx=$dx dz=$dz cp0=1500 ro0=1500 \
+ intt=def grad=6000 cp=3900,3900 ro=1500,1500 x=0,$sizex z=0,0\
+ file_base=flank.su
+
+makemod file_base=salt.su makemod sizex=8000 sizez=8000 dx=$dx dz=$dz cp0=0 ro0=1500 intt=def poly=1 cp=4500,4500 ro=1500 x=1000,1500,2000,5000 z=6500,7200,7500,7000 intt=def poly=1 cp=4500 ro=1500 x=750,1000,1250 z=8000,6500,8000
+suflip flip=0 < salt_cp.su > saltT.su
+
+suop2 saltT.su flank_cp.su op=diff > nep.su
+suop op=posonly < nep.su > nep2.su
+suop2 nep2.su flank_cp.su op=sum > grad_salt.su
+rm nep.su nep2.su
+
+
diff --git a/fdelmodc3D/demo/modelall.scr b/fdelmodc3D/demo/modelall.scr
new file mode 100755
index 0000000000000000000000000000000000000000..b8678a8d9d2c7c32e219f75cbf3868f1e440aa50
--- /dev/null
+++ b/fdelmodc3D/demo/modelall.scr
@@ -0,0 +1,74 @@
+#!/bin/bash
+
+cd $PBS_O_WORKDIR
+
+./model_flank.scr
+
+
+cp=2000
+rho=1000
+dx=2.5
+dt=0.0005
+
+makemod sizex=6000 sizez=4000 dx=$dx dz=$dx cp0=$cp cs0=$cs ro0=$rho \
+ orig=-3000,-1000 file_base=syncl.su \
+ intt=def x=-3000,0,3000 z=250,250,250 poly=0 cp=2300 ro=5000 \
+ intt=def x=-3000,-2000,-1000,-800,0,800,3000 z=650,650,700,750,900,750,600 poly=2 cp=2600 ro=1000 \
+ intt=def x=-3000,0,3000 z=1390,1390,1390 poly=0 cp=2000 ro=5000
+
+makewave fp=20 dt=$dt file_out=wave.su nt=4096 t0=0.1
+
+
+
+mkdir jobs
+mkdir shots
+
+xsrc=-200
+fldr=0
+
+while (( fldr < 5 ))
+do
+echo $fldr $xsrc
+
+cat << EOF > jobs/pbs_$fldr.job
+#!/bin/bash
+#
+#PBS -N model
+#PBS -j eo
+#PBS -l nodes=1
+#PBS -V
+
+cd $PBS_O_WORKDIR
+
+../fdelmodc \
+ file_cp=syncl_cp.su ischeme=1 \
+ file_den=syncl_ro.su \
+ file_src=wave.su \
+ file_rcv=shots/shot_fd_xsrc${xsrc}.su \
+ src_type=7 \
+ src_orient=1 \
+ src_injectionrate=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.0040 \
+ rec_delay=0.1 \
+ verbose=2 \
+ tmod=3.10 \
+ dxrcv=10.0 \
+ xrcv1=-2250 xrcv2=2250 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=0 zsrc=1150 \
+ ntaper=200 \
+ left=4 right=4 top=4 bottom=4
+exit 0
+EOF
+
+(( xsrc += 100 ))
+
+qsub pbs_$fldr.job
+
+(( fldr += 1 ))
+done
+
+
diff --git a/fdelmodc3D/demo/modelfast1d.scr b/fdelmodc3D/demo/modelfast1d.scr
new file mode 100755
index 0000000000000000000000000000000000000000..29ffc91df5268d6457bf46019a7c47bd6231c2b0
--- /dev/null
+++ b/fdelmodc3D/demo/modelfast1d.scr
@@ -0,0 +1,46 @@
+#!/bin/bash
+
+export PATH=$HOME/bin:$HOME/src/OpenSource/utils:$PATH:
+
+export PATH=$HOME/src/OpenSource/bin:$PATH:
+which fdelmodc
+
+dx=2.5
+dt=0.00050
+fast="fast"
+
+makemod sizex=12000 sizez=1250 dx=$dx dz=$dx cp0=1500 ro0=1000 \
+ orig=-6000,0 file_base=tutodelfast1d.su verbose=2 \
+ intt=def x=-6000,6000 z=300,300 poly=0 cp=1950 ro=4500 grad=0 \
+ intt=def x=-6000,6000 z=600,600 poly=0 cp=2000 ro=1400 grad=0 \
+ intt=def x=-6000,6000 z=900,900 poly=0 cp=2300 ro=1600 grad=0
+
+#suwind key=gx min=0 max=0 < tutodel_cp.su > tracemodel.su
+
+export OMP_NUM_THREADS=1
+makewave w=fw fmin=0 flef=5 frig=80 fmax=100 dt=$dt file_out=wavefw${fast}.su nt=8192 t0=0.4 scale=0 scfft=1
+
+../fdelmodc \
+ file_cp=tutodelfast1d_cp.su ischeme=-1 iorder=4 \
+ file_den=tutodelfast1d_ro.su \
+ file_src=wavefw${fast}.su \
+ file_rcv=shot1dE${fast}.su \
+ src_type=7 \
+ qr=0.0005 \
+ src_orient=1 \
+ src_injectionrate=1 \
+ rec_type_vz=1 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ rec_delay=0.4 \
+ dtrcv=0.004 \
+ verbose=2 \
+ tmod=4.494 \
+ dxrcv=10.0 \
+ xrcv1=-6000 xrcv2=6000 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=0 zsrc=0 \
+ tsnap2=4.4 dtsnap=0.1 dxsnap=10 dzsnap=10 \
+ ntaper=400 \
+ left=4 right=4 top=4 bottom=4
+
diff --git a/fdelmodc3D/demo/modelhom.scr b/fdelmodc3D/demo/modelhom.scr
new file mode 100755
index 0000000000000000000000000000000000000000..4d6585fb283384c173703b162dfa741ae0c36f26
--- /dev/null
+++ b/fdelmodc3D/demo/modelhom.scr
@@ -0,0 +1,205 @@
+#!/bin/bash
+#PBS -q medium
+#PBS -N mod_hom
+#PBS -j eo
+#PBS -m n
+#PBS -l nodes=1
+#PBS -V
+
+export PATH=:$HOME/src/OpenSource/bin:$HOME/bin64:$PATH:
+
+cd /vardim/home/thorbcke/src/OpenSource/fdelmodc/demo
+
+dx=2.5
+dt=0.0005
+
+#shots3=var=3000,5
+#shots=var=6000,5
+
+makemod sizex=6000 sizez=900 dx=$dx dz=$dx cp0=1900 ro0=1200 \
+ orig=-3000,-50 file_base=hom.su verbose=2 \
+
+
+makewave w=fw fmin=0 flef=5 frig=80 fmax=100 dt=$dt file_out=wavefw.su nt=4096 t0=0.3 scale=0 scfft=1
+
+export OMP_NUM_THREADS=4
+
+makewave fp=20 dt=$dt file_out=wave.su nt=4096 t0=0.1 scale=1
+
+../fdelmodc \
+ file_cp=hom_cp.su ischeme=1 iorder=4 \
+ file_den=hom_ro.su \
+ file_src=wavefw.su \
+ file_rcv=shot_hom.su \
+ src_type=7 \
+ src_orient=1 \
+ src_injectionrate=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.004 \
+ rec_delay=0.3 \
+ verbose=3 \
+ tmod=4.394 \
+ dxrcv=10.0 \
+ xrcv1=-3000 xrcv2=3000 \
+ zrcv1=800 zrcv2=800 \
+ xsrc=0 zsrc=0 \
+ ntaper=400 \
+ tsnap1=0.1 tsnap2=4.0 dtsnap=0.5 \
+ left=4 right=4 top=4 bottom=4
+
+
+ftr2d file_in=shot_hom_rp.su n2=901 key=dt file_out=kxw_rp.su verbose=1
+#sushw key=trid a=111 < kxw_rp.su | sugain scale=1 | suamp > H_kxw.su
+#multiply with dx*dt of receivers
+sushw key=trid a=111 < kxw_rp.su | sugain scale=0.04 | suamp > H_kxw.su
+
+suwind key=tracl s=10 j=25 itmax=227 < H_kxw.su | \
+ supsgraph d1=1 f1=1 x1beg=1 linecolor=red label1="wave number" \
+ wbox=6 hbox=4 style=normal labelsize=10 n2tic=2 > Hkxw_traces.eps
+
+exit
+
+makemod sizex=6000 sizez=2000 dx=$dx dz=$dx cp0=1900 ro0=1200 \
+ orig=-3000,-1000 file_base=hom.su
+
+#~/bin64/fdelmodc \
+ file_cp=hom_cp.su ischeme=1 iorder=4 \
+ file_den=hom_ro.su \
+ file_src=wave.su \
+ file_rcv=shot_hom_fd.su \
+ src_type=1 \
+ src_orient=1 \
+ src_injectionrate=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.0010 \
+ rec_delay=0.1 \
+ verbose=2 \
+ tmod=4.195 \
+ dxrcv=10.0 \
+ xrcv1=-2250 xrcv2=2250 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=0 zsrc=0 \
+ ntaper=400 \
+ left=4 right=4 top=4 bottom=4
+
+sudiff shot_fd_rp.su shot_hom_fd_rp.su > shot_rp.su
+
+migr file_shot=shot_rp.su file_vel=scatter_migr_cp.su imc=0 file_image=image.su verbose=1
+
+exit
+
+makemod sizex=6000 sizez=4000 dx=$dx dz=$dx cp0=$cp cs0=$cs ro0=$rho \
+ orig=-3000,-1000 file_base=synclTop.su \
+ intt=def x=-3000,0,3000 z=200,200,200 poly=0 cp=1800 ro=5000 \
+ intt=def x=-3000,-2000,-1000,-400,0,200,900,1800,3000 z=520,520,560,670,950,790,600,520,500 poly=2 cp=2300 ro=1800 \
+
+~/bin64/fdelmodc \
+ file_cp=synclTop_cp.su ischeme=1 iorder=4 \
+ file_den=synclTop_ro.su \
+ file_src=wave.su \
+ file_rcv=p0.su \
+ src_type=7 \
+ src_orient=1 \
+ src_injectionrate=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.0010 \
+ rec_delay=0.1 \
+ verbose=2 \
+ tmod=2.100 \
+ dxrcv=10.0 \
+ xrcv1=-2250 xrcv2=2250 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=0 zsrc=1100 \
+ ntaper=300 \
+ left=4 right=4 top=4 bottom=4 &
+
+~/bin64/fdelmodc \
+ file_cp=synclTop_cp.su ischeme=1 iorder=4 \
+ file_den=synclTop_ro.su \
+ file_src=wave.su \
+ file_rcv=shot_top.su \
+ src_type=7 \
+ src_orient=1 \
+ src_injectionrate=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.0010 \
+ rec_delay=0.1 \
+ verbose=2 \
+ tmod=4.195 \
+ dxrcv=10.0 \
+ xrcv1=-2250 xrcv2=2250 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=0 zsrc=0 \
+ ntaper=300 \
+ left=4 right=4 top=4 bottom=4 &
+
+makemod sizex=6000 sizez=4000 dx=$dx dz=$dx cp0=2300 ro0=1800 \
+ orig=-3000,-1000 file_base=synclBot.su \
+ intt=def x=-3000,0,3000 z=1310,1310,1310 poly=0 cp=2450 ro=1950 \
+ intt=def x=-3000,3000 z=1380,1380 poly=0 cp=2460 ro=1820 \
+ intt=def x=-3000,0,3000 z=1490,1490,1570 poly=0 cp=2470 ro=2100 \
+ intt=def x=-3000,3000 z=1580,1580 poly=0 cp=2480 ro=2000 \
+ intt=def x=-3000,3000 z=1680,1680 poly=0 cp=2490 ro=1850
+
+~/bin64/fdelmodc \
+ file_cp=synclBot_cp.su ischeme=1 iorder=4 \
+ file_den=synclBot_ro.su \
+ file_src=wave.su \
+ file_rcv=pRef.su \
+ src_type=7 \
+ src_orient=1 \
+ src_injectionrate=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.0010 \
+ rec_delay=0.1 \
+ verbose=2 \
+ tmod=2.100 \
+ dxrcv=10.0 \
+ xrcv1=-2250 xrcv2=2250 \
+ zrcv1=1100 zrcv2=1100 \
+ xsrc=0 zsrc=1100 \
+ ntaper=300 \
+ left=4 right=4 top=4 bottom=4 &
+
+makemod sizex=6000 sizez=4000 dx=$dx dz=$dx cp0=2300 ro0=1800 \
+ orig=-3000,-1000 file_base=synclBotHom.su
+
+~/bin64/fdelmodc \
+ file_cp=synclBotHom_cp.su ischeme=1 iorder=4 \
+ file_den=synclBotHom_ro.su \
+ file_src=wave.su \
+ file_rcv=pRefHom.su \
+ src_type=7 \
+ src_orient=1 \
+ src_injectionrate=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.0010 \
+ rec_delay=0.1 \
+ verbose=2 \
+ tmod=2.100 \
+ dxrcv=10.0 \
+ xrcv1=-2250 xrcv2=2250 \
+ zrcv1=1100 zrcv2=1100 \
+ xsrc=0 zsrc=1100 \
+ ntaper=300 \
+ left=4 right=4 top=4 bottom=4 &
+
+wait
+
+
+sudiff shot_fd_rp.su shot_hom_fd_rp.su > shot_rp.su
+sudiff shot_top_rp.su shot_hom_fd_rp.su > shotTop_rp.su
+sudiff pRef_rp.su pRefHom_rp.su > pref_rp.su
+
diff --git a/fdelmodc3D/demo/modelling b/fdelmodc3D/demo/modelling
new file mode 100755
index 0000000000000000000000000000000000000000..ec8e9996686123c5e179859233d6cfffcc6c6941
--- /dev/null
+++ b/fdelmodc3D/demo/modelling
@@ -0,0 +1,213 @@
+#!/bin/bash
+#PBS -l nodes=1
+#PBS -N InterfModeling
+#PBS -q fourweeks
+#PBS -V
+#
+# demo for generation of random source signature at random positions
+#export PATH=../../bin:$PATH
+
+#========================================================================================
+# My COMMENTS
+#========================================================================================
+
+
+#define the parameters
+#------------------------------------------------------------------------------------
+# the wavelet paremeters
+t0=0.1
+nt=10000
+db=-40
+fp=60
+dt=0.0001
+file_src=wavelet.su
+verbose=4
+ntap=400
+
+# the model parameters
+dx=1
+dz=1
+sizex=2000
+sizez=1200
+modelname=model
+
+# plot parameters
+perc=96
+WIDTH=800
+HEIGHT=600
+WIDTHOFF1=80
+HEIGHTOFF1=60
+labelsize=10
+titlesize=12
+label11="time [s]"
+label12="amplitude"
+label13="frequency [hz]"
+label21="depth [m]"
+label22="lateral position [m]"
+label31="time [s]"
+label32="lateral position [m]"
+blockinterp=1
+legend=1
+units1="m/s"
+units2="kg/m3"
+scale=3200
+clip=1e-10
+wclip=0
+bclip=${scale}
+loop=1
+n1=1201
+n2=2001
+n3=10
+f1=0.0
+f2=0.0
+
+#make the wavelet
+#--------------------------------------------------------------------------------------------
+makewave w=g2 fp=$fp t0=$t0 dt=$dt nt=$nt db=$db file_out=${file_src} verbose=${verbose} \
+
+# plot the source wavelet and it's amplitude
+supsgraph < wavelet.su style=normal \
+ labelsize=${labelsize} label2="${label12}" label1="${label11}" \
+ titlesize=${titlesize} d1num=0.05 x1end=0.2 > wavelet.eps
+
+sufft < wavelet.su | suamp | supsgraph style=normal \
+ labelsize=${labelsize} label2="${label12}" label1="${label13}" \
+ titlesize=${titlesize} d2num=20 x2end=100 d1num=10 x1end=200 > wavelet_ampl.eps
+
+
+#make the velocity and desity model
+#--------------------------------------------------------------------------------------------
+makemod file_base=$modelname.su verbose=${verbose} \
+ cp0=2500 ro0=1900 cs0=1700 sizex=$sizex sizez=$sizez \
+ dx=$dx dz=$dz orig=0,0 \
+ intt=def poly=0 cp=2900 ro=2400 cs=2000 \
+ x=0,2000 z=600,600 gradcp=0 gradcs=0 grad=0 \
+
+
+# extend model for absorbing boundaries
+extendModel file_in=${modelname}_ro.su nafter=$ntap nbefore=$ntap nbelow=$ntap > ${modelname}_edge_ro.su
+extendModel file_in=${modelname}_cp.su nafter=$ntap nbefore=$ntap nbelow=$ntap > ${modelname}_edge_cp.su
+extendModel file_in=${modelname}_cs.su nafter=$ntap nbefore=$ntap nbelow=$ntap > ${modelname}_edge_cs.su
+
+# plot the velocity and desity model
+supsimage < ${modelname}_cp.su \
+ labelsize=${labelsize} titlesize=${titlesize} verbose=${verbose} \
+ label1="${label21}" label2="${label22}" blockinterp=${blockinterp} legend=${legend} units="${units1}" \
+ > ${modelname}_cp.eps
+
+supsimage < ${modelname}_ro.su \
+ labelsize=${labelsize} titlesize=${titlesize} verbose=${verbose} \
+ label1="${label21}" label2="${label22}" blockinterp=${blockinterp} legend=${legend} units="${units2}" \
+ > ${modelname}_ro.eps
+
+supsimage < ${modelname}_cs.su \
+ labelsize=${labelsize} titlesize=${titlesize} verbose=${verbose} \
+ label1="${label21}" label2="${label22}" blockinterp=${blockinterp} legend=${legend} units="${units1}" \
+ > ${modelname}_cs.eps
+
+
+
+#---------------------------------------------------------------------------------------------------
+# Do the forword modeling
+fdelmodc \
+ ischeme=3 \
+ file_cp=model_edge_cp.su \
+ file_cs=model_edge_cs.su \
+ file_den=model_edge_ro.su \
+ file_rcv=recv.su \
+ file_snap=snap.su \
+ file_src=wavelet.su \
+ src_type=1 \
+ src_orient=1 \
+ xsrc=1000 \
+ zsrc=0 \
+ nshot=1 \
+ dxshot=40 \
+ wav_random=0 \
+ xrcv1=0 \
+ xrcv2=2000 \
+ dxrcv=20 \
+ zrcv1=0 \
+ zrcv2=0 \
+ dzrcv=0 \
+ dtrcv=0.002 \
+ rec_type_tzz=1 \
+ rec_type_vz=1 \
+ rec_type_vx=1 \
+ rec_int_vz=2 \
+ rec_int_vx=2 \
+ tsnap1=0.1 \
+ tsnap2=1.0 \
+ dtsnap=0.1 \
+ xsnap1=0\
+ xsnap2=2000 \
+ zsnap1=0 \
+ zsnap2=1200 \
+ sna_type_tzz=1 \
+ sna_type_vz=1 \
+ sna_type_vx=1 \
+ tmod=1 \
+ cfree=1 \
+ boundary=2 \
+ ntaper=400 \
+ taptop=0 \
+ tapleft=1 \
+ tapright=1 \
+ tapbottom=1 \
+ verbose=${verbose}
+
+
+exit
+
+
+# Plot the src_rec positions, seismograms and snapshots
+#--------------------------------------------------------------------------------------------
+# Seismograms of P/Tzz, vz, vx.
+supsimage < recv_rtzz.su perc=${perc} \
+ labelsize=${labelsize} titlesize=${titlesize} verbose=${verbose} \
+ label1="${label31}" label2="${label32}" > recv_rtzz.eps
+
+supsimage < recv_rvz.su perc=${perc} \
+ labelsize=${labelsize} titlesize=${titlesize} verbose=${verbose} \
+ label1="${label31}" label2="${label32}" > recv_rvz.eps
+
+supsimage < recv_rvx.su perc=${perc} \
+ labelsize=${labelsize} titlesize=${titlesize} verbose=${verbose} \
+ label1="${label31}" label2="${label32}" > recv_rvx.eps
+
+# Make the image of snapshots of P/Tzz, vz, vx
+supsmovie < snap_stzz.su perc=${perc} labelsize=${labelsize} titlesize=${titlesize} verbose=${verbose} \
+ title="Wavefield of P (dt=${dtsnap} s; source at x=${xsrc} m, z=${zsrc} m)" \
+ label1="${label21}" label2="${label22}" title2="Frame" \
+ n1=${n1} n2=${n2} n3=${n3} f1=${f1} f2=${f2} \
+ > snap_stzz.eps
+#ps2pdf snap_sp.ps
+
+supsmovie < snap_svz.su perc=${perc} labelsize=${labelsize} titlesize=${titlesize} verbose=${verbose} \
+ title="Wavefield of Svz (dt=${dtsnap} s; source at x=${xsrc} m, z=${zsrc} m)" \
+ label1="${label21}" label2="${label22}" title2="Frame" \
+ n1=${n1} n2=${n2} n3=${n3} f1=${f1} f2=${f2} \
+ > snap_svz.eps
+#ps2pdf snap_svz.ps
+
+supsmovie < snap_svx.su perc=${perc} labelsize=${labelsize} titlesize=${titlesize} verbose=${verbose} \
+ title="Wavefield of Svx (dt=${dtsnap} s; source at x=${xsrc} m, z=${zsrc} m)" \
+ label1="${label21}" label2="${label22}" title2="Frame" \
+ n1=${n1} n2=${n2} n3=${n3} f1=${f1} f2=${f2} \
+ > snap_svx.eps
+#ps2pdf snap_svx.ps
+
+# Shift the record wavefield by wavelet delay "-${t0}"
+basop file_in=recv_rtzz.su choice=shift shift=-${t0} nxmax=${nxmax} ntmax=${ntmax} dx=${dxrcv} > recv_rtzzs.su
+basop file_in=recv_rvx.su choice=shift shift=-${t0} nxmax=${nxmax} ntmax=${ntmax} dx=${dxrcv} > recv_rvxs.su
+basop file_in=recv_rvz.su choice=shift shift=-${t0} nxmax=${nxmax} ntmax=${ntmax} dx=${dxrcv} > recv_rvzs.su
+
+# To show a movie of the P snapshots
+suxmovie < snap_stzz.su clip=${clip} loop=${loop} \
+ -geometry ${WIDTH}x${HEIGHT}+${WIDTHOFF1}+${HEIGHTOFF1}
+
+
+exit
+
+
+
diff --git a/fdelmodc3D/demo/staal.scr b/fdelmodc3D/demo/staal.scr
new file mode 100755
index 0000000000000000000000000000000000000000..a99d0a59fa1444de173a8c3dca12d149049d9712
--- /dev/null
+++ b/fdelmodc3D/demo/staal.scr
@@ -0,0 +1,20 @@
+#!/bin/bash
+
+makemod file_base=betonplaat3.su cp0=3700 ro0=2400 cs0=3400 verbose=1 sizex=5000 sizez=300 dx=5.0 dz=5.0
+
+makewave file_out=betonplaatwave.su dt=1.0e-4 nt=10000 w=g2 shift=1 fp=6 verbose=1
+
+../fdelmodc file_cp=betonplaat3_cp.su file_cs=betonplaat3_cs.su \
+file_den=betonplaat3_ro.su file_src=betonplaatwave.su \
+file_rcv=betonplaat2recv.su file_snap=betonplaat2snap.su \
+ischeme=3 tmod=5 \
+top=1 left=4 right=1 bottom=1 \
+src_type=3 xsrc=2500 zsrc=0.0 \
+tsnap1=1.0e-2 tsnap2=5 dtsnap=1.0e-2 dxsnap=5.0 dzsnap=5.0 \
+dtrcv=1.0e-2 verbose=1
+
+!sufrac power=1 < betonplaat3recv_rvz.su > sufracbetonplaat3.su
+!sustrip < sufracbetonplaat3.su | b2a n1=2051 > Sufrac_betonplaat3_Tzz.txt
+!suximage<sufracbetonplaat3.su title="FDM shot record Concrete Slab Sourcetype=Tzz [Left=4 Right=1]" label2="Lateral Position [mm]"
+label1="Time [ms]" wbox=2500 hbox=500 cmap=hsv2 legend=1
+
diff --git a/fdelmodc3D/demo/test2.scr b/fdelmodc3D/demo/test2.scr
new file mode 100755
index 0000000000000000000000000000000000000000..6694fae2966e32d49e4be0f73e4aeb8b0ae48c2e
--- /dev/null
+++ b/fdelmodc3D/demo/test2.scr
@@ -0,0 +1,49 @@
+#!/bin/bash
+
+#-----------------------------------------------------------------------------
+# Modeling of acoustic response of multiple source acquisition
+# Horizontal model
+#
+# Author: Abdulmohsen AlAli, Delft University of Technology
+# Date : March 2014
+#-----------------------------------------------------------------------------
+dx=4 #max(dx,dz)<v_min/(5*f_max)
+dt=0.0005 #dt<(0.606*min(dx,dz))/v_max
+tmod=1.5
+nt=1024
+script=5
+w_z=wave_${script}.su
+file_in_ro=model_3lay_base_${script}_ro.su
+file_in_cp=model_3lay_base_${script}_cp.su
+#-----------------------------------------------------------------------------
+# Making a wavelet
+#-----------------------------------------------------------------------------
+makewave w=g2 t0=0.05 fp=20 dt=$dt nt=$nt file_out=$w_z
+### end of making of wavelet ###
+#-----------------------------------------------------------------------------
+# Making a model
+#-----------------------------------------------------------------------------
+makemod file_base=model_3lay_base_${script}.su sizex=8000 sizez=2000 \
+dx=$dx dz=$dx cp0=1850 ro0=2000 \
+intt=def poly=0 x=0,8000 z=1000,1000 cp=2800 ro=2200 \
+intt=def poly=0 x=0,8000 z=1600,1600 cp=3600 ro=2600 \
+### end of making of model ###
+#-----------------------------------------------------------------------------
+# fdelmodc a model
+#-----------------------------------------------------------------------------
+### the fdacmod loop for creating the transmission panels ###
+ xsrc=4000
+ file_out=5_refl_3lay_base_active_multSRC_${xsrc}.su
+ echo $xsrc
+ ../fdelmodc file_cp=$file_in_cp file_den=$file_in_ro file_src=$w_z \
+ ischeme=1 tmod=$tmod ntaper=200 left=4 right=4 \
+ bottom=4 top=1 src_type=7 xsrc=$xsrc zsrc=0 \
+ xrcv1=3232 xrcv2=4756 dxrcv=12 zrcv1=90 zrcv2=90 rec_type_p=1 \
+ rec_type_vz=1 file_rcv=$file_out dtrcv=0.004 verbose=4 \
+ src_injectionrate=0
+
+ #tsnap1=0.1 tsnap2=1.1 dtsnap=0.25 sna_type_vz=0 verbose=1
+
+exit
+
+
diff --git a/fdelmodc3D/demo/testFreeSurface.scr b/fdelmodc3D/demo/testFreeSurface.scr
new file mode 100755
index 0000000000000000000000000000000000000000..d4591319a6c5cf0453ab6937488bc7787e3e9cad
--- /dev/null
+++ b/fdelmodc3D/demo/testFreeSurface.scr
@@ -0,0 +1,48 @@
+#!/bin/bash
+#PBS -N fdelmod
+#PBS -q verylong
+#PBS -l nodes=1
+#PBS -k eo
+#PBS -j eo
+
+which makewave
+which makemod
+
+cd /Users/jan/src/OpenSource/fdelmodc/demo
+
+cp=2000
+rho=1000
+dx=4
+dt=0.0010
+
+makemod sizex=3000 sizez=1000 dx=$dx dz=$dx cp0=$cp ro0=$rho cs0=1500 \
+ orig=-1500,0 file_base=freesurf.su \
+ intt=def x=-1500,0,1500 z=20,20,20 poly=0 cp=2300 ro=2000 cs=1600 \
+ intt=def x=-1500,0,1500 z=50,50,50 poly=0 cp=2100 ro=1400 cs=1300
+
+makewave fp=20 dt=$dt file_out=wave.su nt=4096 t0=0.1
+
+../fdelmodc \
+ file_cp=freesurf_cp.su ischeme=3 \
+ file_cs=freesurf_cs.su \
+ file_den=freesurf_ro.su \
+ file_src=wave.su \
+ file_rcv=shot_x0.su \
+ src_type=7 \
+ src_orient=1 \
+ src_injectionrate=1 \
+ rec_type_vz=1 \
+ rec_type_p=1 \
+ rec_type_tzz=0 \
+ rec_int_vz=2 \
+ dtrcv=0.0010 \
+ rec_delay=0.1 \
+ verbose=1 \
+ tmod=1.10 \
+ dxrcv=8.0 \
+ xrcv1=-1500 xrcv2=1500 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=0 zsrc=0 \
+ ntaper=300 \
+ left=4 right=4 top=1 bottom=4
+
diff --git a/fdelmodc3D/demo/test_free_elastic.scr b/fdelmodc3D/demo/test_free_elastic.scr
new file mode 100755
index 0000000000000000000000000000000000000000..6e72ed58c6289af4aeab7db86f4f672e04037c1e
--- /dev/null
+++ b/fdelmodc3D/demo/test_free_elastic.scr
@@ -0,0 +1,95 @@
+#!/bin/bash
+#PBS -N fdelmodc
+#PBS -k eo
+#PBS -j eo
+#
+# Models plane wave at depth to receivers at the surface, including snapshots
+export PATH=../../utils:$PATH:
+
+makewave file_out=wavelet.su dt=0.001 nt=1024 fp=13 shift=1 w=g2 verbose=1
+
+makemod file_base=model.su \
+ cp0=1500 ro0=1000 cs0=600 sizex=2100 sizez=2100 \
+ dx=3 dz=3 orig=0,0 \
+ intt=def poly=0 cp=1650 ro=2000 cs=1000 \
+ x=0,2100 z=500,500 gradcp=0.5 grad=100 \
+ intt=def poly=1 cp=1800 ro=2500 cs=1200 \
+ x=0,800,1200,2100 z=900,1400,1400,1200 gradcp=0 grad=0 \
+ verbose=4
+
+export filecp=model_cp.su
+export filecs=model_cs.su
+export filero=model_ro.su
+
+export OMP_NUM_THREADS=1
+
+../fdelmodc \
+ file_cp=$filecp file_cs=$filecs file_den=$filero \
+ ischeme=1 \
+ file_src=wavelet.su verbose=4 \
+ file_rcv=rec.su \
+ file_snap=snap.su \
+ xrcv1=0 xrcv2=2100 dxrcv=15 \
+ zrcv1=400 zrcv2=400 \
+ rec_type_vx=1 rec_type_pp=1 rec_type_ss=1 rec_int_vx=1 \
+ dtrcv=0.004 \
+ xsrc=1000 zsrc=1700 nshot=1 plane_wave=1 nsrc=301 \
+ src_type=1 tmod=3.0 src_velo=1800 src_angle=5 \
+ ntaper=120 \
+ left=4 right=4 bottom=4 top=4 \
+ tsnap1=0.1 tsnap2=3.0 dtsnap=0.1 \
+ sna_type_ss=1 sna_type_pp=1
+
+exit;
+
+# to show a movie of the snapshots
+#suxmovie < snap_svz.su perc=99 loop=1
+
+# to reproduce the images in the manual use:
+supsimage < model_cp.su \
+ wbox=4 hbox=4 titlesize=-1 labelsize=10 verbose=1 \
+ d2=3 f2=0 wrgb=1.0,0,0 grgb=0,1.0,0 brgb=0,0,1.0 bps=24 \
+ label1="depth [m]" label2="lateral position [m]" > model_plane.eps
+
+supsimage < SrcRecPositions.su \
+ wbox=4 hbox=4 titlesize=-1 labelsize=10 verbose=1 \
+ d2=3 f2=0 wclip=-1 bclip=1 \
+ gabel1="depth [m]" label2="lateral position [m]" > SrcRecPositions.eps
+
+suop2 model_cp.su SrcRecPositions.su w1=1 w2=2000 op=sum | \
+ supsimage wclip=1400 bclip=2000 \
+ wbox=4 hbox=4 titlesize=-1 labelsize=10 verbose=1 \
+ d2=3 f2=0 wrgb=1.0,0,0 grgb=0,1.0,0 brgb=0,0,1.0 bps=24 \
+ label1="depth [m]" label2="lateral position [m]" > model_plane_src.eps
+
+supsimage < rec_rvz.su \
+ wbox=3 hbox=4 titlesize=-1 labelsize=10 clip=1e-10 verbose=1 \
+ label1="time [s]" label2="lateral position [m]" > rec_plane_rvz.eps
+
+supsimage < rec_rpp.su \
+ wbox=3 hbox=4 titlesize=-1 labelsize=10 clip=1e-11 verbose=1 \
+ label1="time [s]" label2="lateral position [m]" > rec_plane_rpp.eps
+
+supsimage < rec_rss.su \
+ wbox=3 hbox=4 titlesize=-1 labelsize=10 clip=1e-11 verbose=1 \
+ label1="time [s]" label2="lateral position [m]" > rec_plane_rss.eps
+
+#snapshots
+for file in snap_svz snap_spp snap_sss; do
+
+suwind < $file.su key=fldr min=$ifldr max=$ifldr > nep1.su
+while (( ifldr < 12 ))
+do
+(( ifldr += 4 ))
+echo $ifldr
+suwind < $file.su key=fldr min=$ifldr max=$ifldr > nep2.su
+susum nep2.su nep1.su > snaps.su
+mv snaps.su nep1.su
+done
+
+supsimage < nep1.su \
+ wbox=4 hbox=4 titlesize=-1 labelsize=10 verbose=1 \
+ d2=3 f2=0 perc=99 \
+ label1="depth [m]" label2="lateral position [m]" > ${file}_snap.eps
+done
+
diff --git a/fdelmodc3D/demo/virtualshot.scr b/fdelmodc3D/demo/virtualshot.scr
new file mode 100755
index 0000000000000000000000000000000000000000..1e89a565bd37d21e504377237da3d50f0908b426
--- /dev/null
+++ b/fdelmodc3D/demo/virtualshot.scr
@@ -0,0 +1,53 @@
+#!/bin/bash
+#PBS -N fdelmod
+#PBS -q verylong
+#PBS -l nodes=1
+#PBS -k eo
+#PBS -j eo
+
+which makewave
+which makemod
+
+cd /Users/jan/src/OpenSource/fdelmodc/demo
+
+#makewave fp=20 dt=$dt file_out=wave.su nt=4096 t0=0.1
+#makewave w=fw fmin=0 flef=5 frig=80 fmax=100 dt=$dt file_out=wavefw.su nt=4096 t0=0.3
+
+cp=2000
+rho=1000
+dx=2.5
+dt=0.0005
+
+makemod sizex=6000 sizez=4000 dx=$dx dz=$dx cp0=$cp cs0=$cs ro0=$rho \
+ orig=-3000,-1000 file_base=syncl.su \
+ intt=def x=-3000,0,3000 z=250,250,250 poly=0 cp=2300 ro=5000 \
+ intt=def x=-3000,-2000,-1000,-800,0,800,3000 z=650,650,700,750,900,750,600 poly=2 cp=2600 ro=1000 \
+ intt=def x=-3000,0,3000 z=1390,1390,1390 poly=0 cp=2000 ro=5000
+
+makewave fp=20 dt=$dt file_out=wave.su nt=4096 t0=0.1
+
+export OMP_NUM_THREADS=1
+
+../fdelmodc \
+ file_cp=syncl_cp.su ischeme=1 \
+ file_den=syncl_ro.su \
+ file_src=wave.su \
+ file_rcv=shot_fd_Fz_zsrc1150.su \
+ src_type=7 \
+ src_orient=1 \
+ src_injectionrate=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.0040 \
+ rec_delay=0.1 \
+ verbose=2 \
+ tmod=0.30 \
+ dxrcv=10.0 \
+ xrcv1=-2250 xrcv2=2250 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=0 zsrc=1150 \
+ ntaper=200 \
+ left=4 right=4 top=4 bottom=4
+
+
diff --git a/fdelmodc3D/demo/vsp.scr b/fdelmodc3D/demo/vsp.scr
new file mode 100755
index 0000000000000000000000000000000000000000..4e4c79308ceff757c6fe54bd37ae8ff1221c52b9
--- /dev/null
+++ b/fdelmodc3D/demo/vsp.scr
@@ -0,0 +1,82 @@
+#!/bin/bash
+#PBS -N fdelmod
+#PBS -q verylong
+#PBS -l nodes=1
+#PBS -k eo
+#PBS -j eo
+
+which makewave
+which makemod
+
+cd /Users/jan/src/OpenSource/fdelmodc/demo
+
+#makewave fp=20 dt=$dt file_out=wave.su nt=4096 t0=0.1
+#makewave w=fw fmin=0 flef=5 frig=80 fmax=100 dt=$dt file_out=wavefw.su nt=4096 t0=0.3
+
+cp=2000
+rho=1000
+dx=5
+dt=0.0005
+
+makemod sizex=6000 sizez=4000 dx=$dx dz=$dx cp0=$cp cs0=$cs ro0=$rho \
+ orig=-3000,-1000 file_base=syncl.su \
+ intt=def x=-3000,0,3000 z=250,250,250 poly=0 cp=2300 ro=5000 \
+ intt=def x=-3000,-2000,-1000,-800,0,800,3000 z=650,650,700,750,900,750,600 poly=2 cp=2600 ro=1000 \
+ intt=def x=-3000,0,3000 z=1390,1390,1390 poly=0 cp=2000 ro=5000
+
+makewave fp=20 dt=$dt file_out=wave.su nt=4096 t0=0.1
+
+
+#receivers in a vertical line
+#../fdelmodc \
+ file_cp=syncl_cp.su ischeme=1 \
+ file_den=syncl_ro.su \
+ file_src=wave.su \
+ file_rcv=shot.su \
+ src_type=1 \
+ src_orient=1 \
+ src_injectionrate=1 \
+ rec_type_vx=1 \
+ rec_type_vz=1 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.0040 \
+ rec_delay=0.1 \
+ verbose=2 \
+ tmod=3.10 \
+ dxrcv=0.0 \
+ dzrcv=5.0 \
+ xrcv1=0 xrcv2=0 \
+ zrcv1=0 zrcv2=2000 \
+ xsrc=150 zsrc=10 \
+ ntaper=200 \
+ left=4 right=4 top=4 bottom=4
+
+#shots in a vertical line
+../fdelmodc \
+ file_cp=syncl_cp.su ischeme=1 \
+ file_den=syncl_ro.su \
+ file_src=wave.su \
+ file_rcv=shotv.su \
+ src_type=1 \
+ src_orient=1 \
+ src_injectionrate=1 \
+ rec_type_vx=1 \
+ rec_type_vz=1 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.0040 \
+ rec_delay=0.1 \
+ verbose=2 \
+ tmod=1.10 \
+ dxrcv=10.0 \
+ dzrcv=0.0 \
+ xrcv1=-3000 xrcv2=3000 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=0 zsrc=0 \
+ dzshot=10 dxshot=0 nshot=10 \
+ ntaper=200 \
+ left=4 right=4 top=4 bottom=4
+
+
+
diff --git a/fdelmodc3D/depthDiff.c b/fdelmodc3D/depthDiff.c
new file mode 100644
index 0000000000000000000000000000000000000000..e9c181cee3f13e89e5eeb3ec1676ae8e7830ce58
--- /dev/null
+++ b/fdelmodc3D/depthDiff.c
@@ -0,0 +1,307 @@
+#include "par.h"
+#include "segy.h"
+#include <time.h>
+#include <stdlib.h>
+#include <stdio.h>
+#include <math.h>
+#include <assert.h>
+#include <genfft.h>
+
+#ifndef MAX
+#define MAX(x,y) ((x) > (y) ? (x) : (y))
+#endif
+#ifndef MIN
+#define MIN(x,y) ((x) < (y) ? (x) : (y))
+#endif
+#define NINT(x) ((int)((x)>0.0?(x)+0.5:(x)-0.5))
+
+#ifndef COMPLEX
+typedef struct _complexStruct { /* complex number */
+ float r,i;
+} complex;
+#endif/* complex */
+
+double wallclock_time(void);
+void pad_data(float *data, int nsam, int nrec, int nsamout, float *datout);
+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);
+float rcabs(complex z);
+complex froot(float x);
+
+void depthDiff(float *data, int nsam, int nrec, float dt, float dx, float fmin, float fmax, float c, int opt)
+{
+ int optn, iom, iomin, iomax, nfreq, j, ix, ikx, diff, nkx, ikxmax;
+ float omin, omax, deltom, df, dkx, *rdata, kx, scl;
+ float kx2, kz2, kp2, kp;
+ complex *cdata, *cdatascl, kz, kzinv;
+
+ optn = optncr(nsam);
+ nfreq = optncr(nsam)/2+1;
+ df = 1.0/(optn*dt);
+ nkx = optncc(nrec);
+ dkx = 2.0*PI/(nkx*dx);
+ diff = (nkx-nrec)/2;
+ cdata = (complex *)malloc(nfreq*nkx*sizeof(complex));
+ if (cdata == NULL) verr("memory allocation error for cdata");
+
+ rdata = (float *)malloc(optn*nkx*sizeof(float));
+ if (rdata == NULL) verr("memory allocation error for rdata");
+
+ /* pad zeroes in 2 directions to reach FFT lengths */
+ pad2d_data(data,nsam,nrec,optn,nkx,rdata);
+
+ /* double forward FFT */
+ xt2wkx(&rdata[0], &cdata[0], optn, nkx, optn, nkx, 0);
+
+ deltom = 2.*PI*df;
+ omin = 2.*PI*fmin;
+ omax = 2.*PI*fmax;
+
+ iomin = (int)MIN((omin/deltom), nfreq);
+ iomin = MAX(iomin, 0);
+ iomax = MIN((int)(omax/deltom), nfreq);
+
+ cdatascl = (complex *)malloc(nfreq*nkx*sizeof(complex));
+ if (cdatascl == NULL) verr("memory allocation error for cdatascl");
+
+ for (iom = 0; iom < iomin; iom++) {
+ for (ix = 0; ix < nkx; ix++) {
+ cdatascl[iom*nkx+ix].r = 0.0;
+ cdatascl[iom*nkx+ix].i = 0.0;
+ }
+ }
+ for (iom = iomax; iom < nfreq; iom++) {
+ for (ix = 0; ix < nkx; ix++) {
+ cdatascl[iom*nkx+ix].r = 0.0;
+ cdatascl[iom*nkx+ix].i = 0.0;
+ }
+ }
+ if (opt > 0) {
+ for (iom = iomin ; iom <= iomax ; iom++) {
+ kp = (iom*deltom)/c;
+ kp2 = kp*kp;
+
+ ikxmax = MIN((int)(kp/dkx), nkx/2);
+
+ for (ikx = 0; ikx < ikxmax; ikx++) {
+ kx = ikx*dkx;
+ kx2 = kx*kx;
+ kz2 = kp2 - kx2;
+ kz.r = 0.0;
+ kz.i = sqrt(kz2);
+ cdatascl[iom*nkx+ikx].r = cdata[iom*nkx+ikx].r*kz.r-cdata[iom*nkx+ikx].i*kz.i;
+ cdatascl[iom*nkx+ikx].i = cdata[iom*nkx+ikx].i*kz.r+cdata[iom*nkx+ikx].r*kz.i;
+
+ }
+ for (ikx = ikxmax; ikx <= nkx-ikxmax+1; ikx++) {
+ cdatascl[iom*nkx+ikx].r = 0.0;
+ cdatascl[iom*nkx+ikx].i = 0.0;
+ }
+ for (ikx = nkx-ikxmax+1; ikx < nkx; ikx++) {
+ kx = (ikx-nkx)*dkx;
+ kx2 = kx*kx;
+ kz2 = kp2 - kx2;
+ kz.r = 0.0;
+ kz.i = sqrt(kz2);
+ cdatascl[iom*nkx+ikx].r = cdata[iom*nkx+ikx].r*kz.r-cdata[iom*nkx+ikx].i*kz.i;
+ cdatascl[iom*nkx+ikx].i = cdata[iom*nkx+ikx].i*kz.r+cdata[iom*nkx+ikx].r*kz.i;
+ }
+ }
+ }
+ else if (opt < 0) {
+ for (iom = iomin ; iom < iomax ; iom++) {
+ kp = iom*deltom/c;
+ kp2 = kp*kp;
+ ikxmax = MIN((int)(kp/dkx), nkx/2);
+ for (ikx = 0; ikx < ikxmax; ikx++) {
+ kx = ikx*dkx;
+ kx2 = kx*kx;
+ kz2 = kp2 - kx2;
+ kzinv.r = 0.0;
+ kzinv.i = -sqrt(kz2)/kz2;
+ cdatascl[iom*nkx+ikx].r = cdata[iom*nkx+ikx].r*kzinv.r-cdata[iom*nkx+ikx].i*kzinv.i;
+ cdatascl[iom*nkx+ikx].i = cdata[iom*nkx+ikx].i*kzinv.r+cdata[iom*nkx+ikx].r*kzinv.i;
+ }
+ for (ikx = ikxmax; ikx <= nkx-ikxmax+1; ikx++) {
+ cdatascl[iom*nkx+ikx].r = 0.0;
+ cdatascl[iom*nkx+ikx].i = 0.0;
+ }
+ for (ikx = nkx-ikxmax+1; ikx < nkx; ikx++) {
+ kx = (ikx-nkx)*dkx;
+ kx2 = kx*kx;
+ kz2 = kp2 - kx2;
+ kzinv.r = 0.0;
+ kzinv.i = -sqrt(kz2)/kz2;
+ cdatascl[iom*nkx+ikx].r = cdata[iom*nkx+ikx].r*kzinv.r-cdata[iom*nkx+ikx].i*kzinv.i;
+ cdatascl[iom*nkx+ikx].i = cdata[iom*nkx+ikx].i*kzinv.r+cdata[iom*nkx+ikx].r*kzinv.i;
+ }
+ }
+ }
+ free(cdata);
+
+ /* inverse double FFT */
+ wkx2xt(&cdatascl[0], &rdata[0], optn, nkx, nkx, optn, 0);
+ /* select original samples and traces */
+ scl = 1.0;
+ scl_data(rdata,optn,nrec,scl,data,nsam);
+
+ free(cdatascl);
+ free(rdata);
+
+ return;
+}
+
+
+void decompAcoustic(float *data, int nsam, int nrec, float dt, float dx, float fmin, float fmax, float c, float rho, int opt)
+{
+ int optn, iom, iomin, iomax, nfreq, j, ix, ikx, diff, nkx, ikxmax;
+ float omin, omax, deltom, df, dkx, *rdata, kx, scl, om;
+ float kx2, kz2, kp2, kp;
+ complex *cdata, *cdatascl, kz, kzinv, deca;
+
+ optn = optncr(nsam);
+ nfreq = optncr(nsam)/2+1;
+ df = 1.0/(optn*dt);
+ nkx = optncc(nrec);
+ dkx = 2.0*PI/(nkx*dx);
+ diff = (nkx-nrec)/2;
+ cdata = (complex *)malloc(nfreq*nkx*sizeof(complex));
+ if (cdata == NULL) verr("memory allocation error for cdata");
+
+ rdata = (float *)malloc(optn*nkx*sizeof(float));
+ if (rdata == NULL) verr("memory allocation error for rdata");
+
+ /* pad zeroes in 2 directions to reach FFT lengths */
+ pad2d_data(data,nsam,nrec,optn,nkx,rdata);
+
+ /* double forward FFT */
+ xt2wkx(&rdata[0], &cdata[0], optn, nkx, optn, nkx, 0);
+
+ deltom = 2.*PI*df;
+ omin = 2.*PI*fmin;
+ omax = 2.*PI*fmax;
+
+ iomin = (int)MIN((omin/deltom), nfreq);
+ iomin = MAX(iomin, 0);
+ iomax = MIN((int)(omax/deltom), nfreq);
+
+ cdatascl = (complex *)malloc(nfreq*nkx*sizeof(complex));
+ if (cdatascl == NULL) verr("memory allocation error for cdatascl");
+
+ for (iom = 0; iom < iomin; iom++) {
+ for (ix = 0; ix < nkx; ix++) {
+ cdatascl[iom*nkx+ix].r = 0.0;
+ cdatascl[iom*nkx+ix].i = 0.0;
+ }
+ }
+ for (iom = iomax; iom < nfreq; iom++) {
+ for (ix = 0; ix < nkx; ix++) {
+ cdatascl[iom*nkx+ix].r = 0.0;
+ cdatascl[iom*nkx+ix].i = 0.0;
+ }
+ }
+ if (opt==1) {
+ for (iom = iomin ; iom <= iomax ; iom++) {
+ om = iom*deltom;
+ kp = om/c;
+ kp2 = kp*kp;
+
+ ikxmax = MIN((int)(kp/dkx), nkx/2);
+
+ for (ikx = 0; ikx < nkx/2+1; ikx++) {
+ kx = ikx*dkx;
+ kx2 = kx*kx;
+ kz2 = 2*(kp2 - kx2)/(om*rho);
+ deca = froot(kz2);
+ cdatascl[iom*nkx+ikx].r = cdata[iom*nkx+ikx].r*deca.r-cdata[iom*nkx+ikx].i*deca.i;
+ cdatascl[iom*nkx+ikx].i = cdata[iom*nkx+ikx].i*deca.r+cdata[iom*nkx+ikx].r*deca.i;
+ }
+ for (ikx = nkx-1; ikx < nkx/2+2; ikx++) {
+ cdatascl[iom*nkx+ikx] = cdatascl[iom*nkx+(nkx-ikx)];
+ }
+ }
+ }
+ else if (opt==2) {
+ for (iom = iomin ; iom < iomax ; iom++) {
+ kp = iom*deltom/c;
+ kp2 = kp*kp;
+ ikxmax = MIN((int)(kp/dkx), nkx/2);
+ for (ikx = 0; ikx < ikxmax; ikx++) {
+ kx = ikx*dkx;
+ kx2 = kx*kx;
+ kz = froot(kp2 - kx2);
+ if (kz.r>0.0) {
+ deca.r = sqrt(2*om*rho)/(kz.r);
+ deca.i = 0.0;
+ }
+ else if (kz.i<0.0) {
+ deca.i = sqrt(2*om*rho)/(kz.i);
+ deca.r = 0.0;
+ }
+ else { /* small values */
+ deca.r = 1.0;
+ deca.i = 0.0;
+ }
+ kz2 = (2*om*rho)/(kp2 - kx2);
+ cdatascl[iom*nkx+ikx].r = cdata[iom*nkx+ikx].r*deca.r-cdata[iom*nkx+ikx].i*deca.i;
+ cdatascl[iom*nkx+ikx].i = cdata[iom*nkx+ikx].i*deca.r+cdata[iom*nkx+ikx].r*deca.i;
+ }
+ for (ikx = nkx-1; ikx < nkx/2+2; ikx++) {
+ cdatascl[iom*nkx+ikx] = cdatascl[iom*nkx+(nkx-ikx)];
+ }
+ }
+ }
+ free(cdata);
+
+ /* inverse double FFT */
+ wkx2xt(&cdatascl[0], &rdata[0], optn, nkx, nkx, optn, 0);
+ /* select original samples and traces */
+ scl = 1.0;
+ scl_data(rdata,optn,nrec,scl,data,nsam);
+
+ free(cdatascl);
+ free(rdata);
+
+ return;
+}
+
+
+complex froot(float x)
+{
+ complex z;
+ if (x >= 0.0) {
+ z.r = sqrt(x);
+ z.i = 0.0;
+ return z;
+ }
+ else {
+ z.r = 0.0;
+ z.i = -sqrt(-x);
+ return z;
+ }
+}
+
+void scl_data(float *data, int nsam, int nrec, float scl, float *datout, int nsamout)
+{
+ int it,ix;
+ for (ix = 0; ix < nrec; ix++) {
+ for (it = 0 ; it < nsamout ; it++)
+ datout[ix*nsamout+it] = scl*data[ix*nsam+it];
+ }
+}
+
+void pad2d_data(float *data, int nsam, int nrec, int nsamout, int nrecout, float *datout)
+{
+ int it,ix;
+ for (ix=0;ix<nrec;ix++) {
+ for (it=0;it<nsam;it++)
+ datout[ix*nsam+it]=data[ix*nsam+it];
+ for (it=nsam;it<nsamout;it++)
+ datout[ix*nsam+it]=0.0;
+ }
+ for (ix=nrec;ix<nrecout;ix++) {
+ for (it=0;it<nsamout;it++)
+ datout[ix*nsam+it]=0.0;
+ }
+}
+
diff --git a/fdelmodc3D/docpkge.c b/fdelmodc3D/docpkge.c
new file mode 100644
index 0000000000000000000000000000000000000000..a74b4c331cbb3c882fd311ef5dacbda776c14e04
--- /dev/null
+++ b/fdelmodc3D/docpkge.c
@@ -0,0 +1,188 @@
+/*
+ This file is property of the Colorado School of Mines.
+
+ Copyright (C) 2007, Colorado School of Mines,
+ All rights reserved.
+
+
+ Redistribution and use in source and binary forms, with or
+ without modification, are permitted provided that the following
+ conditions are met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above
+ copyright notice, this list of conditions and the following
+ disclaimer in the documentation and/or other materials provided
+ with the distribution.
+ * Neither the name of the Colorado School of Mines nor the names of
+ its contributors may be used to endorse or promote products
+ derived from this software without specific prior written permission.
+
+ Warranty Disclaimer:
+ THIS SOFTWARE IS PROVIDED BY THE COLORADO SCHOOL OF MINES AND CONTRIBUTORS
+ "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+ FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+ COLORADO SCHOOL OF MINES OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+ INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+ BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+ LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+ CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+ STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING
+ IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ POSSIBILITY OF SUCH DAMAGE.
+
+
+ Export Restriction Disclaimer:
+ We believe that CWP/SU: Seismic Un*x is a low technology product that does
+ not appear on the Department of Commerce CCL list of restricted exports.
+ Accordingly, we believe that our product meets the qualifications of
+ an ECCN (export control classification number) of EAR99 and we believe
+ it fits the qualifications of NRR (no restrictions required), and
+ is thus not subject to export restrictions of any variety.
+
+ Approved Reference Format:
+ In publications, please refer to SU as per the following example:
+ Cohen, J. K. and Stockwell, Jr. J. W., (200_), CWP/SU: Seismic Un*x
+ Release No. __: an open source software package for seismic
+ research and processing,
+ Center for Wave Phenomena, Colorado School of Mines.
+
+ Articles about SU in peer-reviewed journals:
+ Saeki, T., (1999), A guide to Seismic Un*x (SU)(2)---examples of data processing (part 1), data input and preparation of headers, Butsuri-Tansa (Geophysical Exploration), vol. 52, no. 5, 465-477.
+ Stockwell, Jr. J. W. (1999), The CWP/SU: Seismic Un*x Package, Computers and Geosciences, May 1999.
+ Stockwell, Jr. J. W. (1997), Free Software in Education: A case study of CWP/SU: Seismic Un*x, The Leading Edge, July 1997.
+ Templeton, M. E., Gough, C.A., (1998), Web Seismic Un*x: Making seismic reflection processing more accessible, Computers and Geosciences.
+
+ Acknowledgements:
+ SU stands for CWP/SU:Seismic Un*x, a processing line developed at Colorado
+ School of Mines, partially based on Stanford Exploration Project (SEP)
+ software.
+ */
+
+/*********************** self documentation **********************/
+/***************************************************************************
+DOCPKGE - Function to implement the CWP self-documentation facility
+
+requestdoc give selfdoc on user request (i.e. when name of main is typed)
+pagedoc print self documentation string
+
+****************************************************************************
+Function Prototypes:
+void requestdoc(flag);
+void pagedoc();
+
+****************************************************************************
+requestoc:
+Input:
+flag integer specifying i.o. cases
+
+pagedoc():
+Returns: the self-documentation, an array of strings
+
+****************************************************************************
+Notes:
+requestdoc:
+In the usual case, stdin is used to pass in data. However,
+some programs (eg. synthetic data generators) don't use stdin
+to pass in data and some programs require two or more arguments
+besides the command itself (eg. sudiff) and don't use stdin.
+In this last case, we give selfdoc whenever too few arguments
+are given, since these usages violate the usual SU syntax.
+In all cases, selfdoc can be requested by giving only the
+program name.
+
+The flag argument distinguishes these cases:
+ flag = 0; fully defaulted, no stdin
+ flag = 1; usual case
+ flag = n > 1; no stdin and n extra args required
+
+pagedoc:
+Intended to be called by requesdoc(), but conceivably could be
+used directly as in:
+ if (xargc != 3) selfdoc();
+
+Based on earlier versions by:
+SEP: Einar Kjartansson, Stew Levin CWP: Jack Cohen, Shuki Ronen
+HRC: Lyle
+
+****************************************************************************
+Author: Jack K. Cohen, Center for Wave Phenomena
+****************************************************************************/
+/**************** end self doc ********************************/
+
+#include "par.h"
+
+#ifndef EXIT_FAILURE
+#define EXIT_FAILURE (1)
+#endif
+#ifndef EXIT_SUCCESS
+#define EXIT_SUCCESS (0)
+#endif
+
+
+/* definitions of global variables */
+int xargc; char **xargv;
+
+
+void requestdoc(int flag)
+/***************************************************************************
+print selfdocumentation as directed by the user-specified flag
+****************************************************************************
+Notes:
+In the usual case, stdin is used to pass in data. However,
+some programs (eg. synthetic data generators) don't use stdin
+to pass in data and some programs require two or more arguments
+besides the command itself (eg. sudiff) and don't use stdin.
+In this last case, we give selfdoc whenever too few arguments
+are given, since these usages violate the usual SU syntax.
+In all cases, selfdoc can be requested by giving only the
+program name.
+
+The flag argument distinguishes these cases:
+ flag = 0; fully defaulted, no stdin
+ flag = 1; usual case
+ flag = n > 1; no stdin and n extra args required
+
+pagedoc:
+Intended to be called by pagedoc(), but conceivably could be
+used directly as in:
+ if (xargc != 3) selfdoc();
+
+****************************************************************************
+Authors: Jack Cohen, Center for Wave Phenomena, 1993, based on on earlier
+versions by:
+SEP: Einar Kjartansson, Stew Levin CWP: Jack Cohen, Shuki Ronen
+HRC: Lyle
+****************************************************************************/
+{
+ switch(flag) {
+ case 1:
+ if (xargc == 1 && isatty(STDIN)) pagedoc();
+ break;
+ case 0:
+ if (xargc == 1 && isatty(STDIN) && isatty(STDOUT)) pagedoc();
+ break;
+ default:
+ if (xargc <= flag) pagedoc();
+ break;
+ }
+ return;
+}
+
+
+void pagedoc(void)
+{
+ extern char *sdoc[];
+ char **p = sdoc;
+ FILE *fp;
+
+ fflush(stdout);
+ fp = popen("more -22 1>&2", "w");
+ while(*p) (void)fprintf(fp, "%s\n", *p++);
+ pclose(fp);
+
+ exit(EXIT_FAILURE);
+}
+/*----------------------End of Package--------------------------------*/
diff --git a/fdelmodc3D/elastic4.c b/fdelmodc3D/elastic4.c
new file mode 100644
index 0000000000000000000000000000000000000000..bfaee6e6780cff467a1a910ffb5c8524e0845485
--- /dev/null
+++ b/fdelmodc3D/elastic4.c
@@ -0,0 +1,158 @@
+#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
new file mode 100644
index 0000000000000000000000000000000000000000..d119cfb3db178a7f3d5ade881188634191b1c686
--- /dev/null
+++ b/fdelmodc3D/elastic4dc.c
@@ -0,0 +1,160 @@
+#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
new file mode 100644
index 0000000000000000000000000000000000000000..00aaf5660a413521604c102fe8915f895caf1606
--- /dev/null
+++ b/fdelmodc3D/elastic6.c
@@ -0,0 +1,182 @@
+#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
new file mode 100644
index 0000000000000000000000000000000000000000..17fcb9f9bff0864098b02dc9f63bb33429429a80
--- /dev/null
+++ b/fdelmodc3D/fdelmodc.c
@@ -0,0 +1,743 @@
+#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
new file mode 100644
index 0000000000000000000000000000000000000000..ed07c68da00636d4e080b9b7baf0393f8218dc62
--- /dev/null
+++ b/fdelmodc3D/fdelmodc.h
@@ -0,0 +1,190 @@
+#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
new file mode 100644
index 0000000000000000000000000000000000000000..a79ede1973ad96f941f5eeb096f8486954c7a5d2
--- /dev/null
+++ b/fdelmodc3D/fdelmodc3D.c
@@ -0,0 +1,790 @@
+#include<stdlib.h>
+#include<stdio.h>
+#include<math.h>
+#include<assert.h>
+#include<string.h>
+#include"par.h"
+#include"fdelmodc3D.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) ((long)((x)>0.0?(x)+0.5:(x)-0.5))
+
+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 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 writeSrcRecPos(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(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,
+ 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 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 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 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 allocStoreSourceOnSurface(srcPar src);
+
+long freeStoreSourceOnSurface(void);
+
+/* Self documentation */
+char *sdoc[] = {
+" ",
+" fdelmodc - elastic acoustic finite difference wavefield modeling in 3D",
+" ",
+" 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",
+" dy= ............... read from model file: if dy==0 then dy= 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",
+" front=4 ........... type of boundary on front edge of model",
+" back=4 ............ type of boundary on back edge of model",
+" 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",
+" dip=0 ............. dip for double-couple source",
+" strike=0 .......... strike for double-couple source",
+" xsrc=middle ....... x-position of (first) shot ",
+" ysrc=middle ....... y-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",
+" dyshot=0 .......... if nshot > 1: y-shift in shot locations",
+" dzshot=0 .......... if nshot > 1: z-shift in shot locations",
+" xsrca= ............ defines source array x-positions",
+" ysrca= ............ defines source array y-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",
+" ysrc1=0 ........... left bound for y-position of sources",
+" ysrc2=0 ........... right bound for y-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",
+" dysnap=dy ......... sampling in snapshot in y-direction",
+" ysnap1=0 .......... first y-position for snapshots area",
+" ysnap2=0 .......... last y-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_vy=0 ..... Vy registration _svy",
+" 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)",
+" yrcv1=ymin ........ first y-position of linear receiver array(s)",
+" yrcv2=ymax ........ last y-position of linear receiver array(s)",
+" dyrcv=dy .......... y-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)",
+" xrcva= ............ defines receiver array x-positions",
+" yrcva= ............ defines receiver array y-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",
+" 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",
+" rec_type_p=1 ...... p registration _rp",
+" rec_type_vz=1 ..... Vz registration _rvz",
+" rec_type_vy=0 ..... Vy registration _rvy",
+" 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_vy=0 ..... interpolation of Vy receivers",
+" - 0=Vy->Vy (no interpolation)",
+" - 1=Vy->Vz",
+" - 2=Vy->Tyy/Tzz(P)",
+" - 3=Vy->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, *roy, *roz, *l2m, *lam, *mul;
+ float *tss, *tes, *tep, *p, *q, *r;
+ float *vx, *vy, *vz, *tzz, *tyy, *txz, *txy, *tyz, *txx;
+ float *rec_vx, *rec_vy, *rec_vz, *rec_p;
+ float *rec_txx, *rec_tyy, *rec_tzz, *rec_txz, *rec_txy, *rec_tyz;
+ float *rec_pp, *rec_ss;
+ float *rec_udp, *rec_udvz;
+ float *beam_vx, *beam_vy, *beam_vz, *beam_p;
+ float *beam_txx, *beam_tyy, *beam_tzz, *beam_txz, *beam_txy, *beam_tyz;
+ float *beam_pp, *beam_ss;
+ float sinkvel, npeshot;
+ double t0, t1, t2, t3, tt, tinit;
+ size_t size, sizem, nsamp;
+ long n1, n2, ix, iy, iz, ir, ishot, i;
+ long ioPx, ioPy, ioPz;
+ long it0, it1, its, it, fileno, isam;
+ long ixsrc, iysrc, izsrc, is0, is1;
+ long verbose;
+#ifdef MPI
+ long npes, pe;
+
+ MPI_Init( &argc, &argv );
+ MPI_Comm_size( MPI_COMM_WORLD, &npes );
+ MPI_Comm_rank( MPI_COMM_WORLD, &pe );
+#else
+ long npes, pe;
+ npes = 1;
+ pe = 0;
+#endif
+
+
+ t0= wallclock_time();
+ initargs(argc,argv);
+ requestdoc(0);
+
+ if (!getparlong("verbose",&verbose)) verbose=0;
+ getParameters3D(&mod, &rec, &sna, &wav, &src, &shot, &bnd, verbose);
+
+ /* allocate arrays for model parameters: the different schemes use different arrays */
+
+ n1 = mod.naz;
+ n2 = mod.nax;
+ sizem=mod.nax*mod.naz*mod.nay;
+
+ rox = (float *)calloc(sizem,sizeof(float));
+ roy = (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));
+ }
+ allocStoreSourceOnSurface3D(src);
+
+ /* read velocity and density files */
+
+ readModel3D(mod, bnd, rox, roy, 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);
+ }
+ }
+
+ defineSource3D(wav, src, mod, rec, src_nwav, mod.grid_dir, verbose);
+
+ /* allocate arrays for wavefield and receiver arrays */
+
+ vx = (float *)calloc(sizem,sizeof(float));
+ vy = (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));
+ txy = (float *)calloc(sizem,sizeof(float));
+ tyz = (float *)calloc(sizem,sizeof(float));
+ txx = (float *)calloc(sizem,sizeof(float));
+ tyy = (float *)calloc(sizem,sizeof(float));
+ }
+
+ size = rec.n*rec.nt;
+ if (rec.type.vz) rec_vz = (float *)calloc(size,sizeof(float));
+ if (rec.type.vy) rec_vy = (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.tyy) rec_tyy = (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.txy) rec_txy = (float *)calloc(size,sizeof(float));
+ if (rec.type.tyz) rec_tyz = (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 velocity and density at first receiver location */
+ ir = mod.ioZz + rec.z[0]+(rec.x[0]+mod.ioZx)*n1+(rec.y[0]+mod.ioZy)*n1*n2;
+ 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.vy) beam_vy = (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.tyy) beam_tyy = (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.txy) beam_txy = (float *)calloc(size,sizeof(float));
+ if (sna.type.tyz) beam_tyz = (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;
+ ioPy=mod.ioPy;
+ ioPz=mod.ioPz;
+ if (bnd.lef==4 || bnd.lef==2) ioPx += bnd.ntap;
+ if (bnd.fro==4 || bnd.fro==2) ioPy += bnd.ntap;
+ if (bnd.top==4 || bnd.top==2) ioPz += bnd.ntap;
+ if (rec.sinkvel) sinkvel=l2m[(rec.y[0]+ioPy)*n1*n2+(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];
+ iy = rec.y[ir];
+ ix = rec.x[ir];
+ while(l2m[(iy+ioPy)*n1*n2+(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;
+ if (verbose>3) vmess("receiver position %li at grid[ix=%li, iy=%li iz=%li] = (x=%f y=%f z=%f)", ir, ix+ioPx, iy+ioPy, rec.z[ir]+ioPz, rec.xr[ir]+mod.x0, rec.yr[ir]+mod.y0, rec.zr[ir]+mod.z0);
+ }
+
+/* sink sources to value different than zero */
+ for (ishot=0; ishot<shot.n; ishot++) {
+ iz = shot.z[ishot];
+ iy = shot.y[ishot];
+ ix = shot.x[ishot];
+ while(l2m[(iy+ioPy)*n1*n2+(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 (iy=0; iy<mod.ny; iy++) {
+ for (ix=0; ix<mod.nx; ix++) {
+ iz = ioPz;
+ while(l2m[(iy+ioPy)*n1*n2+(ix+ioPx)*n1+iz] == 0.0) iz++;
+ bnd.surface[(iy+ioPy)*n2+ix+ioPx] = iz;
+ if ((verbose>3) && (iz != ioPz)) vmess("Topgraphy surface x=%.2f y=%.2f z=%.2f", mod.x0+mod.dx*ix, mod.y0+mod.dy*iy, mod.z0+mod.dz*(iz-ioPz));
+ }
+ }
+ for (iy=0; iy<ioPy; iy++) {
+ for (ix=0; ix<ioPx; ix++) {
+ bnd.surface[iy*n2+ix] = bnd.surface[ioPy*n2+ioPx];
+ }
+ for (ix=ioPx+mod.nx; ix<mod.iePx; ix++) {
+ bnd.surface[iy*n2+ix] = bnd.surface[ioPy*n2+mod.iePx-1];
+ }
+ }
+ for (iy=ioPy+mod.ny; iy<mod.iePy; iy++) {
+ for (ix=0; ix<ioPx; ix++) {
+ bnd.surface[iy*n2+ix] = bnd.surface[(mod.iePy-1)*n2+ioPx];
+ }
+ for (ix=ioPx+mod.nx; ix<mod.iePx; ix++) {
+ bnd.surface[iy*n2+ix] = bnd.surface[(mod.iePy-1)*n2+mod.iePx-1];
+ }
+ }
+ if (verbose>3) writeSrcRecPos3D(&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=%li does shots is0 %li - is1 %li\n", pe, is0, is1);
+#else
+ is0=0;
+ is1=shot.n;
+#endif
+
+ for (ishot=is0; ishot<is1; ishot++) {
+
+ izsrc = shot.z[ishot];
+ iysrc = shot.y[ishot];
+ ixsrc = shot.x[ishot];
+ fileno= 0;
+
+ memset(vx,0,sizem*sizeof(float));
+ memset(vy,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(txy,0,sizem*sizeof(float));
+ memset(tyz,0,sizem*sizeof(float));
+ memset(txx,0,sizem*sizeof(float));
+ memset(tyy,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 %li at gridpoints ix=%li iy=%li iz=%li", ishot, shot.x[ishot], shot.y[ishot], shot.z[ishot]);
+ vmess(" which are actual positions x=%.2f y=%.2f z=%.2f", mod.x0+mod.dx*shot.x[ishot], mod.y0+mod.dy*shot.y[ishot], mod.z0+mod.dz*shot.z[ishot]);
+ }
+ vmess("Receivers at gridpoint x-range ix=%li - %li", 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 y-range iy=%li - %li", rec.y[0], rec.y[rec.n-1]);
+ vmess(" which are actual positions y=%.2f - %.2f", mod.y0+rec.yr[0], mod.y0+rec.yr[rec.n-1]);
+ vmess("Receivers at gridpoint z-range iz=%li - %li", 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, roy, roz, l2m, lam, mul, txx, tyy, tzz, txz, tyz, txy, vx, vy, vz) \
+shared (tss, tep, tes, r, q, p) \
+shared (tinit, it0, it1, its) \
+shared(beam_vx, beam_vy, beam_vz, beam_txx, beam_tyy, beam_tzz, beam_txz, beam_tyz, beam_txy, beam_p, beam_pp, beam_ss) \
+shared(rec_vx, rec_vy, rec_vz, rec_txx, rec_tyy, rec_tzz, rec_txz, rec_tyz, rec_txy, rec_p, rec_pp, rec_ss) \
+shared (tt, t2, t3) \
+shared (shot, bnd, mod, src, wav, rec, ixsrc, iysrc, 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) ) {
+ long 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;
+ long 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 %li 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/fdelmodc3D.h b/fdelmodc3D/fdelmodc3D.h
new file mode 100644
index 0000000000000000000000000000000000000000..158899df6305898453f54fc4344e21bd645b7fe8
--- /dev/null
+++ b/fdelmodc3D/fdelmodc3D.h
@@ -0,0 +1,227 @@
+#include<stdlib.h>
+#include<stdio.h>
+#include<math.h>
+
+typedef struct _compType { /* Receiver Type */
+ long vz;
+ long vx;
+ long vy;
+ long p;
+ long txx;
+ long tyy;
+ long tzz;
+ long txz;
+ long tyz;
+ long txy;
+ long pp;
+ long ss;
+ long ud;
+} compType;
+
+typedef struct _receiverPar { /* Receiver Parameters */
+ char *file_rcv;
+ compType type;
+ long n;
+ long nt;
+ long delay;
+ long skipdt;
+ long max_nrec;
+ long *z;
+ long *y;
+ long *x;
+ float *zr;
+ float *yr;
+ float *xr;
+ long int_p;
+ long int_vx;
+ long int_vy;
+ long int_vz;
+ long scale;
+ long sinkdepth;
+ long sinkvel;
+ float cp;
+ float rho;
+} recPar;
+
+typedef struct _snapshotPar { /* Snapshot Parameters */
+ char *file_snap;
+ char *file_beam;
+ compType type;
+ long nsnap;
+ long delay;
+ long skipdt;
+ long skipdz;
+ long skipdy;
+ long skipdx;
+ long nz;
+ long ny;
+ long nx;
+ long z1;
+ long z2;
+ long x1;
+ long x2;
+ long y1;
+ long y2;
+ long vxvztime;
+ long beam;
+ long withbnd;
+} snaPar;
+
+typedef struct _modelPar { /* Model Parameters */
+ long iorder;
+ long ischeme;
+ long grid_dir;
+ long sh;
+ char *file_cp;
+ char *file_ro;
+ char *file_cs;
+ char *file_qp;
+ char *file_qs;
+ float dz;
+ float dy;
+ float dx;
+ float dt;
+ float tmod;
+ long nt;
+ float z0;
+ float y0;
+ float x0;
+ /* medium max/min values */
+ float cp_min;
+ float cp_max;
+ float cs_min;
+ float cs_max;
+ float ro_min;
+ float ro_max;
+ long nz;
+ long ny;
+ long nx;
+ long naz;
+ long nay;
+ long nax;
+ /* Vx: rox */
+ long ioXx;
+ long ioXy;
+ long ioXz;
+ long ieXx;
+ long ieXy;
+ long ieXz;
+ /* Vy: roy */
+ long ioYx;
+ long ioYy;
+ long ioYz;
+ long ieYx;
+ long ieYy;
+ long ieYz;
+ /* Vz: roz */
+ long ioZx;
+ long ioZy;
+ long ioZz;
+ long ieZx;
+ long ieZy;
+ long ieZz;
+ /* P, Txx, Tyy, Tzz: lam, l2m */
+ long ioPx;
+ long ioPy;
+ long ioPz;
+ long iePx;
+ long iePy;
+ long iePz;
+ /* Txz, Txy, Tyz: muu */
+ long ioTx;
+ long ioTy;
+ long ioTz;
+ long ieTx;
+ long ieTy;
+ long ieTz;
+ /* attenuation / dissipative medium */
+ float Qp;
+ float Qs;
+ float fw;
+ float qr;
+} modPar;
+
+typedef struct _waveletPar { /* Wavelet Parameters */
+ char *file_src; /* general source */
+ long nsrcf;
+ long nt;
+ long ns;
+ long nx;
+ float dt;
+ float ds;
+ float fmax;
+ long random;
+ long seed;
+ long nst;
+ size_t *nsamp;
+} wavPar;
+
+typedef struct _sourcePar { /* Source Array Parameters */
+ long n;
+ long type;
+ long orient;
+ long *z;
+ long *y;
+ long *x;
+ long single;
+ long plane;
+ long circle;
+ long array;
+ long random;
+ float *tbeg;
+ float *tend;
+ long multiwav;
+ float angle;
+ float velo;
+ float amplitude;
+ float dip;
+ float strike;
+ long distribution;
+ long window;
+ long injectionrate;
+ long sinkdepth;
+ long src_at_rcv; /* Indicates that wavefield should be injected at receivers */
+} srcPar;
+
+typedef struct _shotPar { /* Shot Parameters */
+ long n;
+ long *z;
+ long *y;
+ long *x;
+} shotPar;
+
+typedef struct _boundPar { /* Boundary Parameters */
+ long top;
+ long bot;
+ long lef;
+ long rig;
+ long fro;
+ long bac;
+ float *tapz;
+ float *tapy;
+ float *tapx;
+ float *tapxz;
+ float *tapxyz;
+ long cfree;
+ long ntap;
+ long *surface;
+ long npml;
+ float R; /* reflection at side of model */
+ float m; /* scaling order */
+ float *pml_Vx;
+ float *pml_Vy;
+ 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/fileOpen.c b/fdelmodc3D/fileOpen.c
new file mode 100644
index 0000000000000000000000000000000000000000..b0ff8066052b3c6952c00d963927e62e6b896fc4
--- /dev/null
+++ b/fdelmodc3D/fileOpen.c
@@ -0,0 +1,48 @@
+#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"
+
+/**
+* File handling routines
+*
+* AUTHOR:
+* Jan Thorbecke (janth@xs4all.nl)
+* The Netherlands
+**/
+
+void name_ext(char *filename, char *extension);
+
+FILE *fileOpen(char *file, char *ext, int append)
+{
+ FILE *fp;
+ char filename[1024];
+
+ strcpy(filename, file);
+ name_ext(filename, ext);
+ if (append) fp = fopen(filename, "a");
+ else fp = fopen(filename, "w");
+ assert(fp != NULL);
+
+ return fp;
+}
+
+int traceWrite(segy *hdr, float *data, int n, FILE *fp)
+{
+ size_t nwrite;
+
+ nwrite = fwrite( hdr, 1, TRCBYTES, fp);
+ assert(nwrite == TRCBYTES);
+ nwrite = fwrite( data, sizeof(float), n, fp);
+ assert(nwrite == n);
+
+ return 0;
+}
+
diff --git a/fdelmodc3D/gaussGen.c b/fdelmodc3D/gaussGen.c
new file mode 100644
index 0000000000000000000000000000000000000000..3082202b13f61fe6a8a9c3eeabb20c6c62231927
--- /dev/null
+++ b/fdelmodc3D/gaussGen.c
@@ -0,0 +1,45 @@
+#include<math.h>
+#include<stdlib.h>
+
+/**
+* generate a Gaussian distribution of random numbers
+*
+* AUTHOR:
+* Jan Thorbecke (janth@xs4all.nl)
+* The Netherlands
+**/
+
+
+float gaussGen()
+{
+ double x1, x2, w, y1;
+
+ do {
+ x1 = 2.0 * drand48() - 1.0;
+ x2 = 2.0 * drand48() - 1.0;
+ w = x1 * x1 + x2 * x2;
+ } while ( w >= 1.0 );
+
+ w = sqrt( (-2.0 * log( w ) ) / w );
+ y1 = x1 * w;
+
+ return (float) y1;
+}
+
+/* using sigma != 1 (standard deviation) */
+
+float gaussian(const float sigma)
+{
+ double x, y, r2;
+
+ do
+ {
+ x = -1.0 + 2.0 * drand48();
+ y = -1.0 + 2.0 * drand48();
+ r2 = x * x + y * y;
+ }
+ while (r2 > 1.0 || r2 == 0);
+
+ return (float) (sigma * y * sqrt (-2.0 * log (r2) / r2));
+}
+
diff --git a/fdelmodc3D/getBeamTimes.c b/fdelmodc3D/getBeamTimes.c
new file mode 100644
index 0000000000000000000000000000000000000000..ae5cff4cad0080810e920a2397d2f4c0df28ac3c
--- /dev/null
+++ b/fdelmodc3D/getBeamTimes.c
@@ -0,0 +1,196 @@
+#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/getModelInfo.c b/fdelmodc3D/getModelInfo.c
new file mode 100644
index 0000000000000000000000000000000000000000..378a1b50ebac46e5b7b8a8bef4b5365ac15bef9d
--- /dev/null
+++ b/fdelmodc3D/getModelInfo.c
@@ -0,0 +1,109 @@
+#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
new file mode 100644
index 0000000000000000000000000000000000000000..894223c895e4d9d7fda4b6bbe1b26c2ec017d63e
--- /dev/null
+++ b/fdelmodc3D/getModelInfo3D.c
@@ -0,0 +1,127 @@
+#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) ((long)((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
+**/
+
+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;
+ off_t bytes;
+ long ret, i, one_shot, ntraces, gy, gy0, ny;
+ 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;
+ *d3 = 0.0;
+ *f1 = hdr.f1;
+ *f2 = hdr.f2;
+
+ gy0 = hdr.gy;
+ *f3 = gy0;
+ ny = 1;
+ gy = hdr.gy;
+
+ 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 = (long) (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;
+ if (hdr.gy != gy) {
+ gy = hdr.gy;
+ ny++;
+ }
+ }
+ fclose(fp);
+ free(trace);
+
+ *n3 = ny;
+ *n2 = ntraces/ny;
+ *d3 = ((float)(gy-gy0))/((float)ny);
+
+ if ( NINT(100.0*((*d1)/(*d3)))!=100 ) {
+ verr("dx and dy are different in the model !");
+ }
+
+ if (verbose>2) {
+ vmess("For file %s", file_name);
+ vmess("nz=%li nx=%li ny=%li", *n1, *n2, *n3);
+ vmess("dz=%f dx=%f dy=%li", *d1, *d2, *d3);
+ vmess("min=%f max=%f", *min, *max);
+ vmess("zstart=%f xstart=%f ystart=%f", *f1, *f2, *f3);
+ if (*axis) vmess("sample represent z-axis\n");
+ else vmess("sample represent x-axis\n");
+ }
+ return 0;
+}
+
diff --git a/fdelmodc3D/getParameters.c b/fdelmodc3D/getParameters.c
new file mode 100644
index 0000000000000000000000000000000000000000..5cec11bcb0b5db4b6d78a9832114dd9738cb83a9
--- /dev/null
+++ b/fdelmodc3D/getParameters.c
@@ -0,0 +1,1247 @@
+#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
new file mode 100644
index 0000000000000000000000000000000000000000..df33bf7fd992374c828f96af4ad166ac0fd6c483
--- /dev/null
+++ b/fdelmodc3D/getParameters3D.c
@@ -0,0 +1,1284 @@
+#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);
+
+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 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;
+ long idzshot, idxshot, idyshot, nsrctext;
+ long src_ix0, src_iy0, src_iz0, src_ix1, src_iy1, src_iz1;
+ long 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, ystart, d1, d2, d3, f1, f2, f3, sub_x0, sub_y0, sub_z0;
+ float srcendx, srcendy, srcendz, dx, dy, dz;
+ float xsrc, ysrc, zsrc, dxshot, dyshot, dzshot, dtshot;
+ float dxrcv, dyrcv, dzrcv, dxspread, dyspread, dzspread;
+ float tsnap1, tsnap2, dtsnap, dxsnap, dysnap, dzsnap, dtrcv;
+ float xsnap1, xsnap2, ysnap1, ysnap2, zsnap1, zsnap2, xmax, ymax, zmax;
+ float xsrc1, xsrc2, ysrc1, ysrc2, zsrc1, zsrc2, tsrc1, tsrc2, tlength, tactive;
+ float src_angle, src_velo, p, grad2rad, rdelay, scaledt;
+ float *xsrca, *ysrca, *zsrca, rrcv;
+ float rsrc, oxsrc, oysrc, ozsrc, dphisrc, ncsrc;
+ size_t nsamp;
+ long i, j, l;
+ long cfree;
+ long tapleft,tapright,taptop,tapbottom,tapfront, tapback;
+ long nxsrc, nysrc, nzsrc;
+ long largeSUfile;
+ long is,ntraces,length_random;
+ float rand;
+ char *src_positions, tmpname[1024];
+ char* src_txt;
+ FILE *fp;
+
+ if (!getparlong("verbose",&verbose)) verbose=0;
+ if (!getparlong("disable_check",&disable_check)) disable_check=0;
+ if (!getparlong("iorder",&mod->iorder)) mod->iorder=4;
+ if (!getparlong("ischeme",&mod->ischeme)) mod->ischeme=1;
+ if (!getparlong("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_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 (!getparlong("grid_dir",&mod->grid_dir)) mod->grid_dir=0;
+ if (!getparlong("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 */
+
+ getModelInfo3D(mod->file_cp, &nz, &nx, &ny, &dz, &dx, &dy, &sub_z0, &sub_x0, &sub_y0, &cp_min, &cp_max, &axis, 1, verbose);
+ getModelInfo3D(mod->file_ro, &n1, &n2, &n3, &d1, &d2, &d3, &zstart, &xstart, &ystart, &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*(dy/d3)) != 100)
+ vwarn("dy 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 (ny != n3)
+ 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) {
+ getModelInfo3D(mod->file_cs, &n1, &n2, &n3, &d1, &d2, &d3, &zstart, &xstart, &ystart, &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*(dy/d3)) != 100)
+ vwarn("dy 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 (ny != n3)
+ vwarn("ny 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->dy = dy;
+ mod->nz = nz;
+ mod->nx = nx;
+ mod->ny = ny;
+
+ /* define wavelet(s), modeling time and wavelet maximum frequency */
+
+ if (wav->file_src!=NULL) {
+ getWaveletInfo3D(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 = loptncr(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->nt = NINT(mod->tmod/mod->dt);
+ dt = mod->dt;
+
+ if (!getparlong("src_type",&src->type)) src->type=1;
+ if (!getparlong("src_orient",&src->orient)) {
+ src->orient=1;
+ if (getparlong("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->y0 = sub_y0;
+ mod->z0 = sub_z0;
+ xmax = sub_x0+(nx-1)*dx;
+ ymax = sub_y0+(ny-1)*dy;
+ zmax = sub_z0+(nz-1)*dz;
+
+ if (verbose) {
+ vmess("*******************************************");
+ vmess("************** general info ***************");
+ vmess("*******************************************");
+ vmess("tmod = %f",mod->tmod);
+ vmess("ntsam = %li 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 = %li ny = %li nx = %li", nz, ny, nx);
+ vmess("dz = %8.4f dy = %li dx = %8.4f", dz, dy, dx);
+ vmess("zmin = %8.4f zmax = %8.4f", sub_z0, zmax);
+ vmess("ymin = %8.4f ymax = %8.4f", sub_y0, ymax);
+ 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 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);
+ 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 (!getparlong("cfree",&cfree)) taptop=1;
+ if (!getparlong("tapleft",&tapleft)) tapleft=0;
+ if (!getparlong("tapright",&tapright)) tapright=0;
+ if (!getparlong("taptop",&taptop)) taptop=0;
+ if (!getparlong("tapbottom",&tapbottom)) tapbottom=0;
+ if (!getparlong("tapfront",&tapfront)) tapfront=0;
+ if (!getparlong("tapback",&tapback)) tapback=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;
+ if (tapfront) bnd->fro=4;
+ else bnd->fro=1;
+ if (tapback) bnd->bac=4;
+ else bnd->bac=1;
+
+ /* define the type of boundaries */
+ /* 1=free 2=pml 3=rigid 4=taper */
+ if (!getparlong("left",&bnd->lef) && !tapleft) bnd->lef=4;
+ if (!getparlong("right",&bnd->rig)&& !tapright) bnd->rig=4;
+ if (!getparlong("top",&bnd->top) && !taptop) bnd->top=1;
+ if (!getparlong("bottom",&bnd->bot) && !tapbottom) bnd->bot=4;
+ if (!getparlong("front",&bnd->fro) && !tapfront) bnd->fro=4;
+ if (!getparlong("back",&bnd->bac) && !tapback) bnd->bac=4;
+
+ /* calculate default taper length to be three wavelenghts */
+ if (!getparlong("ntaper",&bnd->ntap)) bnd->ntap=0; // bnd->ntap=3*NINT((cp_max/wav->fmax)/dx);
+ if (!bnd->ntap) if (!getparlong("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 (bnd->ntap) {
+ bnd->tapx = (float *)malloc(bnd->ntap*sizeof(float));
+ bnd->tapy = (float *)malloc(bnd->ntap*sizeof(float));
+ bnd->tapz = (float *)malloc(bnd->ntap*sizeof(float));
+ bnd->tapxz = (float *)malloc(bnd->ntap*bnd->ntap*sizeof(float));
+ bnd->tapxyz = (float *)malloc(bnd->ntap*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));
+
+ bnd->tapy[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));
+ }
+ }
+ for (j=0; j<bnd->ntap; j++) {
+ for (i=0; i<bnd->ntap; i++) {
+ for (l=0; l<bnd->ntap; i++) {
+ wfct = (scl*sqrt(i*i+j*j+l*l));
+ bnd->tapxyz[l*bnd->ntap*bnd->ntap+j*bnd->ntap+i] = exp(-(wfct*wfct));
+ }
+ }
+ }
+ }
+
+ /* Vx: rox */
+ mod->ioXx=mod->iorder/2;
+ mod->ioXy=mod->iorder/2-1;
+ mod->ioXz=mod->iorder/2-1;
+ /* Vy: roy */
+ mod->ioYx=mod->iorder/2-1;
+ mod->ioYy=mod->iorder/2;
+ mod->ioYz=mod->iorder/2-1;
+ /* Vz: roz */
+ mod->ioZx=mod->iorder/2-1;
+ mod->ioZy=mod->iorder/2-1;
+ mod->ioZz=mod->iorder/2;
+ /* P, Txx, Tzz: lam, l2m */
+ mod->ioPx=mod->iorder/2-1;
+ mod->ioPy=mod->ioPx;
+ mod->ioPz=mod->ioPx;
+ /* Txz: mul */
+ mod->ioTx=mod->iorder/2;
+ mod->ioTy=mod->ioTx;
+ mod->ioTz=mod->ioTx;
+
+ /* end loop iteration in FD kernels */
+ /* Vx: rox */
+ mod->ieXx=nx+mod->ioXx;
+ mod->ieXy=ny+mod->ioXy;
+ mod->ieXz=nz+mod->ioXz;
+ /* Vy: roy */
+ mod->ieYx=nx+mod->ioYx;
+ mod->ieYy=ny+mod->ioYy;
+ mod->ieYz=nz+mod->ioYz;
+ /* Vz: roz */
+ mod->ieZx=nx+mod->ioZx;
+ mod->ieZy=ny+mod->ioZy;
+ mod->ieZz=nz+mod->ioZz;
+ /* P, Txx, Tzz: lam, l2m */
+ mod->iePx=nx+mod->ioPx;
+ mod->iePy=ny+mod->ioPy;
+ mod->iePz=nz+mod->ioPz;
+ /* Txz: muu */
+ mod->ieTx=nx+mod->ioTx;
+ mod->ieTy=ny+mod->ioTy;
+ mod->ieTz=nz+mod->ioTz;
+
+ mod->naz = mod->nz+mod->iorder;
+ mod->nay = mod->ny+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->ioYz += bnd->ntap;
+ mod->ioZz += bnd->ntap;
+ mod->ieXz += bnd->ntap;
+ mod->ieYz += bnd->ntap;
+ mod->ieZz += 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->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->ioYx += bnd->ntap;
+ mod->ioZx += bnd->ntap;
+ mod->ieXx += bnd->ntap;
+ mod->ieYx += bnd->ntap;
+ mod->ieZx += bnd->ntap;
+ /* For Tzz, Txx and Txz fields the tapered boundaries are calculated in the main kernels */
+ 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;
+ }
+ if (bnd->fro==4 || bnd->fro==2) {
+ mod->nay += bnd->ntap;
+ mod->ioXy += bnd->ntap;
+ mod->ioYy += bnd->ntap;
+ mod->ioZy += bnd->ntap;
+ mod->ieXy += bnd->ntap;
+ mod->ieYy += bnd->ntap;
+ mod->ieZy += bnd->ntap;
+ /* For Tzz, Txx and Txz fields the tapered boundaries are calculated in the main kernels */
+ mod->iePy += bnd->ntap;
+ mod->ieTy += bnd->ntap;
+ }
+ if (bnd->bac==4 || bnd->bac==2) {
+ mod->nay += bnd->ntap;
+ /* For P/Tzz, Txx and Txz fields the tapered boundaries are calculated in the main kernels */
+ mod->iePy += bnd->ntap;
+ mod->ieTy += bnd->ntap;
+ }
+
+ /* 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 = (long *)malloc((mod->nax+mod->nay+mod->naz)*sizeof(long));
+ for (ix=0; ix<mod->nax+mod->nay+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 : %li",bnd->top);
+ vmess("Left boundary : %li",bnd->lef);
+ vmess("Right boundary : %li",bnd->rig);
+ vmess("Bottom boundary : %li",bnd->bot);
+ vmess("Front boundary : %li",bnd->fro);
+ vmess("Back boundary : %li",bnd->bac);
+ vmess("taper lenght = %li 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("ysrc",&xsrc)) ysrc=sub_y0+((ny-1)*dy)/2.0;
+ if (!getparfloat("zsrc",&zsrc)) zsrc=sub_z0;
+
+ if (!getparlong("nshot",&shot->n)) shot->n=1;
+ if (!getparfloat("dxshot",&dxshot)) dxshot=dx;
+ if (!getparfloat("dyshot",&dyshot)) dyshot=dy;
+ 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));
+ idyshot=MAX(0,NINT(dyshot/dy));
+ idzshot=MAX(0,NINT(dzshot/dz));
+ }
+ else {
+ idxshot=0.0;
+ idyshot=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_iy0=MAX(0,NINT((ysrc-sub_y0)/dy));
+ src_iy0=MIN(src_iy0,ny);
+ src_iz0=MAX(0,NINT((zsrc-sub_z0)/dz));
+ src_iz0=MIN(src_iz0,nz);
+ srcendx=(shot->n-1)*dxshot+xsrc;
+ srcendy=(shot->n-1)*dyshot+ysrc;
+ srcendz=(shot->n-1)*dzshot+zsrc;
+ src_ix1=MAX(0,NINT((srcendx-sub_x0)/dx));
+ src_ix1=MIN(src_ix1,nx);
+ src_iy1=MAX(0,NINT((srcendy-sub_y0)/dy));
+ src_iy1=MIN(src_iy1,ny);
+ src_iz1=MAX(0,NINT((srcendz-sub_z0)/dz));
+ src_iz1=MIN(src_iz1,nz);
+
+ shot->x = (long *)calloc(shot->n,sizeof(long));
+ shot->y = (long *)calloc(shot->n,sizeof(long));
+ shot->z = (long *)calloc(shot->n,sizeof(long));
+ for (is=0; is<shot->n; is++) {
+ shot->x[is] = src_ix0+is*idxshot;
+ shot->y[is] = src_iy0+is*idyshot;
+ shot->z[is] = src_iz0+is*idzshot;
+ if (shot->x[is] > nx-1) shot->n = is-1;
+ if (shot->y[is] > nz-1) shot->n = is-1;
+ if (shot->z[is] > nz-1) shot->n = is-1;
+ }
+
+ /* check if source array is defined */
+ nxsrc = countparval("xsrca");
+ nysrc = countparval("ysrca");
+ nzsrc = countparval("zsrca");
+ if (nxsrc != nzsrc) {
+ verr("Number of sources in array xsrca (%li), ysrca (%li), zsrca (%li) are not equal",nxsrc, nysrc, 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("oysrc",&oysrc)) oysrc=0.0;
+ if (!getparfloat("ozsrc",&ozsrc)) ozsrc=0.0;
+ ncsrc = NINT(360.0/dphisrc);
+ src->n = nsrc;
+
+ src->x = (long *)malloc(ncsrc*sizeof(long));
+ src->y = (long *)malloc(ncsrc*sizeof(long));
+ src->z = (long *)malloc(ncsrc*sizeof(long));
+
+ 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->y[ix] = NINT((oysrc-sub_y0+rsrc*sin(((ix*dphisrc)/360.0)*(2.0*M_PI)))/dy);
+ 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[%li]=%li ysrc=%li zsrc=%li\n", ix, src->x[ix], src->y[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 (!getparlong("src_random",&src->random)) src->random=0;
+ if (!getparlong("plane_wave",&src->plane)) src->plane=0;
+
+ if (src->random) {
+ if (!getparlong("wav_random",&wav->random)) wav->random=1;
+ src->plane=0;
+ src->array=0;
+ src->single=0;
+ }
+ else {
+ if (!getparlong("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 (!getparlong("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 (!getparlong("distribution",&src->distribution)) src->distribution=0;
+ if (!getparlong("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 (!getparlong("src_injectionrate", &src->injectionrate)) src->injectionrate=0;
+ if (src->random && nxsrc==0) {
+ if (!getparlong("nsrc",&nsrc)) nsrc=1;
+ if (!getparlong("seed",&wav->seed)) wav->seed=10;
+ if (!getparfloat("xsrc1", &xsrc1)) xsrc1=sub_x0;
+ if (!getparfloat("xsrc2", &xsrc2)) xsrc2=xmax;
+ if (!getparfloat("ysrc1", &ysrc1)) ysrc1=sub_y0;
+ if (!getparfloat("ysrc2", &ysrc2)) ysrc2=ymax;
+ 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 (!getparlong("length_random", &length_random)) length_random=1;
+ dxshot = xsrc2-xsrc1;
+ dyshot = ysrc2-ysrc1;
+ dzshot = zsrc2-zsrc1;
+ dtshot = tsrc2-tsrc1;
+ if (wav->random) {
+ if (!getparlong("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 = (long *)malloc(nsrc*sizeof(long));
+ src->y = (long *)malloc(nsrc*sizeof(long));
+ src->z = (long *)malloc(nsrc*sizeof(long));
+ 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->y[is] = NINT((ysrc1+rand*dyshot-sub_y0)/dy);
+ 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 ysrc=%f zsrc=%f src_tbeg=%f src_tend=%f nsamp=%ld",src->x[is]*dx, src->y[is]*dy, 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[(long)floor(src->tbeg[is]/mod->dt)] = src->tend[is]-src->tbeg[is];
+ }
+ FILE *fp;
+ sprintf(tmpname,"srcTimeLengthN=%li.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: %li",nsrctext);
+ rewind(fp);
+ nsrc=nsrctext;
+ }
+ else {
+ nsrc=nxsrc;
+ }
+ /* Allocate arrays */
+ src->x = (long *)malloc(nsrc*sizeof(long));
+ src->y = (long *)malloc(nsrc*sizeof(long));
+ src->z = (long *)malloc(nsrc*sizeof(long));
+ src->tbeg = (float *)malloc(nsrc*sizeof(float));
+ src->tend = (float *)malloc(nsrc*sizeof(float));
+ xsrca = (float *)malloc(nsrc*sizeof(float));
+ ysrca = (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 %e\n",&xsrca[i],&ysrca[i],&zsrca[i])!=3) vmess("Source Text File: Can not parse coordinates on line %li.",i);
+ }
+ /* Close file */
+ fclose(fp);
+ }
+ else {
+ getparfloat("xsrca", xsrca);
+ getparfloat("ysrca", ysrca);
+ getparfloat("zsrca", zsrca);
+ }
+ /* Process coordinates */
+ for (is=0; is<nsrc; is++) {
+ src->x[is] = NINT((xsrca[is]-sub_x0)/dx);
+ src->y[is] = NINT((ysrca[is]-sub_y0)/dy);
+ 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[%li]=%f ysrc=%f zsrc=%f\n", is, xsrca[is], ysrca[is], zsrca[is]);
+ }
+
+ src->random = 1;
+ wav->nsamp = (size_t *)malloc((nsrc+1)*sizeof(size_t));
+ if (wav->random) {
+ if (!getparlong("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(ysrca);
+ free(zsrca);
+ }
+ else if (wav->nx > 1) {
+ /* read file_src for number of sources and receiver positions */
+ if (!getparlong("src_multiwav",&src->multiwav)) src->multiwav=1;
+ float *gx, *sx, *gy, *sy, *gelev, *selev;
+ gx = (float *)malloc(wav->nx*sizeof(float));
+ sx = (float *)malloc(wav->nx*sizeof(float));
+ gy = (float *)malloc(wav->nx*sizeof(float));
+ sy = (float *)malloc(wav->nx*sizeof(float));
+ gelev = (float *)malloc(wav->nx*sizeof(float));
+ selev = (float *)malloc(wav->nx*sizeof(float));
+ getWaveletHeaders3D(wav->file_src, wav->ns, wav->nx, gx, sx, gy, sy, gelev, selev, verbose);
+ nsrc = wav->nx;
+ src->x = (long *)malloc(nsrc*sizeof(long));
+ src->y = (long *)malloc(nsrc*sizeof(long));
+ src->z = (long *)malloc(nsrc*sizeof(long));
+ 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->y[is] = NINT((gy[is]-sub_y0)/dy);
+ src->z[is] = NINT((gelev[is]-sub_z0)/dz);
+ if (verbose>3) fprintf(stderr,"Source Array: xsrc[%li]=%f %li ysrc=%f %li zsrc=%f %li\n", is, gx[is], src->x[is], gy[is], src->y[is], gelev[is], src->z[is]);
+ }
+ else {
+ src->x[is]=NINT((sx[is]-sub_x0)/dx);
+ src->y[is]=NINT((sy[is]-sub_y0)/dy);
+ src->z[is]=NINT((selev[is]-sub_z0)/dz);
+ if (verbose>3) fprintf(stderr,"Source Array: xsrc[%li]=%f %li ysrc=%f %li zsrc=%f %li\n", is, sx[is], src->x[is], sy[is], src->y[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(gy);
+ free(sy);
+ free(gelev);
+ free(selev);
+ }
+ else {
+ if (src->plane) { if (!getparlong("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 = (long *)malloc(nsrc*sizeof(long));
+ src->y = (long *)malloc(nsrc*sizeof(long));
+ src->z = (long *)malloc(nsrc*sizeof(long));
+ 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->y[is] = 0;
+ src->z[is] = 0;
+ }
+
+ if (wav->random) {
+ if (!getparlong("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 = %li is not equal to nsrc = %li", 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 a real shot");
+ }
+ }
+ src->n=nsrc;
+
+
+ if (verbose) {
+ vmess("*******************************************");
+ vmess("************* wavelet info ****************");
+ vmess("*******************************************");
+ vmess("wav_nt = %6li wav_nx = %li", wav->ns, wav->nx);
+ vmess("src_type = %6li src_orient = %li", 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 %li sources.",nsrc);
+ 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] y[%.2f : %.2f] z[%.2f : %.2f] ", xsrc1, xsrc2, ysrc1, ysrc2, 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("dysnap", &dysnap)) dysnap=dy;
+ if (!getparfloat("dzsnap", &dzsnap)) dzsnap=dz;
+ if (!getparfloat("xsnap1", &xsnap1)) xsnap1=sub_x0;
+ if (!getparfloat("xsnap2", &xsnap2)) xsnap2=xmax;
+ if (!getparfloat("ysnap1", &ysnap1)) ysnap1=sub_y0;
+ if (!getparfloat("ysnap2", &ysnap2)) ysnap2=ymax;
+ if (!getparfloat("zsnap1", &zsnap1)) zsnap1=sub_z0;
+ if (!getparfloat("zsnap2", &zsnap2)) zsnap2=zmax;
+ if (!getparlong("sna_vxvztime", &sna->vxvztime)) sna->vxvztime=0;
+ if (!getparlong("beam", &sna->beam)) sna->beam=0;
+ if (!getparlong("snapwithbnd", &sna->withbnd)) sna->withbnd=0;
+
+ if (!getparlong("sna_type_vz", &sna->type.vz)) sna->type.vz=1;
+ if (!getparlong("sna_type_vy", &sna->type.vy)) sna->type.vy=0;
+ if (!getparlong("sna_type_vx", &sna->type.vx)) sna->type.vx=0;
+ if (mod->ischeme>2) {
+ sna->type.p=0;
+ if (!getparlong("sna_type_txx", &sna->type.txx)) sna->type.txx=0;
+ if (!getparlong("sna_type_tyy", &sna->type.tyy)) sna->type.tyy=0;
+ if (!getparlong("sna_type_tzz", &sna->type.tzz)) sna->type.tzz=0;
+ if (!getparlong("sna_type_txz", &sna->type.txz)) sna->type.txz=0;
+ if (!getparlong("sna_type_txy", &sna->type.txy)) sna->type.txy=0;
+ if (!getparlong("sna_type_tyz", &sna->type.tyz)) sna->type.tyz=0;
+ if (!getparlong("sna_type_pp", &sna->type.pp)) sna->type.pp=0;
+ if (!getparlong("sna_type_ss", &sna->type.ss)) sna->type.ss=0;
+ }
+ else {
+ if (!getparlong("sna_type_p", &sna->type.p)) sna->type.p=1;
+ sna->type.txx=0;
+ sna->type.tyy=0;
+ sna->type.tzz=0;
+ sna->type.txz=0;
+ sna->type.txy=0;
+ sna->type.tyz=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->skipdy = MAX(1,NINT(dysnap/dy));
+ 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->y1=NINT((MIN(MAX(sub_y0,ysnap1),ymax)-sub_y0)/dy);
+ sna->y2=NINT((MIN(MAX(sub_y0,ysnap2),ymax)-sub_y0)/dy);
+ 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;
+ dysnap=dy*sna->skipdy;
+ dzsnap=dz*sna->skipdz;
+ sna->nx=1+(((sna->x2-sna->x1))/sna->skipdx);
+ sna->ny=1+(((sna->y2-sna->y1))/sna->skipdy);
+ 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 = %li ", dtsnap, sna->nsnap);
+ vmess("nzsnap = %li nysnap = %li nxsnap = %li ", sna->nz, sna->nz, sna->nx);
+ vmess("dzsnap = %f dysnap = %f dxsnap = %f ", dzsnap, dysnap, dxsnap);
+ vmess("zmin = %f zmax = %f ", sub_z0+dz*sna->z1, sub_z0+dz*sna->z2);
+ vmess("ymin = %f ymax = %f ", sub_y0+dy*sna->y1, sub_y0+dy*sna->y2);
+ vmess("xmin = %f xmax = %f ", sub_x0+dx*sna->x1, sub_x0+dx*sna->x2);
+ if (sna->vxvztime) vmess("vx/vy/vz snapshot time : t+0.5*dt ");
+ else vmess("vx/vy/vz snapshot time : t-0.5*dt ");
+ fprintf(stderr," %s: Snapshot types : ",xargv[0]);
+ if (sna->type.vz) fprintf(stderr,"Vz ");
+ if (sna->type.vy) fprintf(stderr,"Vy ");
+ 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.tyy) fprintf(stderr,"Tyy ");
+ if (sna->type.tzz) fprintf(stderr,"Tzz ");
+ if (sna->type.txz) fprintf(stderr,"Txz ");
+ if (sna->type.txy) fprintf(stderr,"Txy ");
+ if (sna->type.tyz) fprintf(stderr,"Tyz ");
+ 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->skipdy = MAX(1,NINT(dysnap/dy));
+ 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->y1=NINT((MIN(MAX(sub_y0,ysnap1),ymax)-sub_y0)/dy);
+ sna->y2=NINT((MIN(MAX(sub_y0,ysnap2),ymax)-sub_y0)/dy);
+ 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;
+ dysnap=dy*sna->skipdy;
+ dzsnap=dz*sna->skipdz;
+ sna->nx=1+(((sna->x2-sna->x1))/sna->skipdx);
+ sna->ny=1+(((sna->y2-sna->y1))/sna->skipdy);
+ sna->nz=1+(((sna->z2-sna->z1))/sna->skipdz);
+
+ if (verbose) {
+ vmess("*******************************************");
+ vmess("**************** beam info ****************");
+ vmess("*******************************************");
+ vmess("nzsnap = %li nysnap =%li nxsnap = %li ", sna->nz, sna->ny, sna->nx);
+ vmess("dzsnap = %f dysnap = %f dxsnap = %f ", dzsnap, dysnap, dxsnap);
+ vmess("zmin = %f zmax = %f ", sub_z0+dz*sna->z1, sub_z0+dz*sna->z2);
+ vmess("ymin = %f ymax = %f ", sub_y0+dy*sna->y1, sub_y0+dy*sna->y2);
+ 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.vy) fprintf(stderr,"Vy ");
+ 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.tyy) fprintf(stderr,"Tyy ");
+ if (sna->type.tzz) fprintf(stderr,"Tzz ");
+ if (sna->type.txz) fprintf(stderr,"Txz ");
+ if (sna->type.txy) fprintf(stderr,"Txy ");
+ if (sna->type.tyz) fprintf(stderr,"Tyz ");
+ 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 (!getparlong("largeSUfile",&largeSUfile)) largeSUfile=0;
+ if (!getparlong("sinkdepth",&rec->sinkdepth)) rec->sinkdepth=0;
+ if (!getparlong("sinkdepth_src",&src->sinkdepth)) src->sinkdepth=0;
+ if (!getparlong("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 (!getparlong("rec_ntsam",&rec->nt)) rec->nt=NINT((mod->tmod-rdelay)/dtrcv)+1;
+ if (!getparlong("rec_int_p",&rec->int_p)) rec->int_p=0;
+ if (!getparlong("rec_int_vx",&rec->int_vx)) rec->int_vx=0;
+ if (!getparlong("rec_int_vy",&rec->int_vy)) rec->int_vy=0;
+ if (!getparlong("rec_int_vz",&rec->int_vz)) rec->int_vz=0;
+ if (!getparlong("max_nrec",&rec->max_nrec)) rec->max_nrec=15000;
+ if (!getparlong("scale",&rec->scale)) rec->scale=0;
+ if (!getparfloat("dxspread",&dxspread)) dxspread=0;
+ if (!getparfloat("dyspread",&dyspread)) dyspread=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 */
+
+ /* calculates the receiver coordinates */
+
+ recvPar(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;
+ if (!getparlong("rec_type_vx", &rec->type.vx)) rec->type.vx=0;
+ if (!getparlong("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 (!getparlong("rec_type_txx", &rec->type.txx)) rec->type.txx=0;
+ if (!getparlong("rec_type_tyy", &rec->type.tyy)) rec->type.tyy=0;
+ if (!getparlong("rec_type_tzz", &rec->type.tzz)) rec->type.tzz=0;
+ if (!getparlong("rec_type_txz", &rec->type.txz)) rec->type.txz=0;
+ if (!getparlong("rec_type_txy", &rec->type.txy)) rec->type.txy=0;
+ if (!getparlong("rec_type_tyz", &rec->type.tyz)) rec->type.tyz=0;
+ if (!getparlong("rec_type_pp", &rec->type.pp)) rec->type.pp=0;
+ if (!getparlong("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 (!getparlong("rec_type_p", &rec->type.p)) rec->type.p=1;
+ rec->type.txx=0;
+ rec->type.tyy=0;
+ rec->type.tzz=0;
+ rec->type.txz=0;
+ rec->type.txy=0;
+ rec->type.tyz=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 (!getparlong("rec_int_p",&rec->int_p)) rec->int_p=3;
+ if (!getparlong("rec_int_vx",&rec->int_vx)) rec->int_vx=3;
+ if (!getparlong("rec_int_vy",&rec->int_vy)) rec->int_vy=3;
+ if (!getparlong("rec_int_vz",&rec->int_vz)) rec->int_vz=3;
+ }
+ if (rec->int_p==3) {
+ rec->int_vx=3;
+ rec->int_vy=3;
+ rec->int_vz=3;
+ }
+
+ if (verbose) {
+ if (rec->n) {
+ dxrcv = rec->xr[MIN(1,rec->n-1)]-rec->xr[0];
+ dyrcv = rec->yr[MIN(1,rec->n-1)]-rec->yr[0];
+ dzrcv = rec->zr[MIN(1,rec->n-1)]-rec->zr[0];
+ vmess("*******************************************");
+ vmess("************* receiver info ***************");
+ vmess("*******************************************");
+ vmess("ntrcv = %li nrcv = %li ", rec->nt, rec->n);
+ vmess("dtrcv = %f ", dtrcv );
+ vmess("dzrcv = %f dyrcv = %f dxrcv = %f ", dzrcv, dyrcv, dxrcv);
+ vmess("time-delay = %f = points = %li", 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("ymin = %f ymax = %f ", rec->yr[0]+sub_y0, rec->yr[rec->n-1]+sub_y0);
+ vmess("xmin = %f xmax = %f ", rec->xr[0]+sub_x0, rec->xr[rec->n-1]+sub_x0);
+ vmess("which are gridpoints: ");
+ vmess("izmin = %li izmax = %li ", rec->z[0], rec->z[rec->n-1]);
+ vmess("iymin = %li iymax = %li ", rec->y[0], rec->y[rec->n-1]);
+ vmess("ixmin = %li ixmax = %li ", 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.vy) {
+ fprintf(stderr," %s: Receiver interpolation for Vx: ",xargv[0]);
+ if(rec->int_vy==0) fprintf(stderr,"vy->vy\n");
+ if(rec->int_vy==1) fprintf(stderr,"vy->vz\n");
+ if(rec->int_vy==2) fprintf(stderr,"vy->tyy/tzz\n");
+ if(rec->int_vy==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.vy) fprintf(stderr,"Vy ");
+ 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.tyy) fprintf(stderr,"Tyy ");
+ if (rec->type.tzz) fprintf(stderr,"Tzz ");
+ if (rec->type.txz) fprintf(stderr,"Txz ");
+ if (rec->type.txy) fprintf(stderr,"Txy ");
+ if (rec->type.tyz) fprintf(stderr,"Tyz ");
+ 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) {
+ long nfiles = ceil((mod->nt*mod->dt)/(rec->nt*dtrcv));
+ long lastn = floor((mod->nt)%(rec->nt*rec->skipdt)/rec->skipdt)+1;
+ vmess("Receiver recordings will be written to %li files",nfiles);
+ vmess("Last file will contain %li samples",lastn);
+
+ }
+ }
+ else {
+ vmess("*************** no receivers **************");
+ }
+ }
+
+ return 0;
+}
+
diff --git a/fdelmodc3D/getRecTimes.c b/fdelmodc3D/getRecTimes.c
new file mode 100644
index 0000000000000000000000000000000000000000..13947e414ca119b0d733795e6a9b8c9966d79ad2
--- /dev/null
+++ b/fdelmodc3D/getRecTimes.c
@@ -0,0 +1,307 @@
+#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/getWaveletHeaders.c b/fdelmodc3D/getWaveletHeaders.c
new file mode 100644
index 0000000000000000000000000000000000000000..5bff37528015722251741fcdb434db218e06ed90
--- /dev/null
+++ b/fdelmodc3D/getWaveletHeaders.c
@@ -0,0 +1,52 @@
+#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
new file mode 100644
index 0000000000000000000000000000000000000000..3e62faa5208a9e93951b84a0fab8a9e0d734fb49
--- /dev/null
+++ b/fdelmodc3D/getWaveletHeaders3D.c
@@ -0,0 +1,53 @@
+#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
+**/
+
+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;
+ long 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;
+ gy[ix] = hdr.gy*scl;
+ sy[ix] = hdr.sy*scl;
+ gelev[ix] = -1.0*hdr.gelev*scll;
+ selev[ix] = -1.0*hdr.selev*scll;
+ }
+ fclose(fp);
+ return 0;
+}
\ No newline at end of file
diff --git a/fdelmodc3D/getWaveletInfo.c b/fdelmodc3D/getWaveletInfo.c
new file mode 100644
index 0000000000000000000000000000000000000000..2f3734aae6c38e54653fab909ec5e936a157d8ce
--- /dev/null
+++ b/fdelmodc3D/getWaveletInfo.c
@@ -0,0 +1,138 @@
+#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
new file mode 100644
index 0000000000000000000000000000000000000000..17e66d9dd04c723e590803e0505a61d7e09cc8ec
--- /dev/null
+++ b/fdelmodc3D/getWaveletInfo3D.c
@@ -0,0 +1,138 @@
+#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 */
+
+long loptncr(long 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) ((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)
+{
+ FILE *fp;
+ size_t nread, trace_sz;
+ off_t bytes;
+ long ret, one_shot, ntraces;
+ long 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 = (long) (bytes/trace_sz);
+ *n2 = ntraces;
+
+ /* check to find out number of traces in shot gather */
+
+ optn = loptncr(*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,(int)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 = (long)ntraces;
+
+ if (verbose>2) {
+ vmess("For file %s", file_src);
+ vmess("nt=%li nx=%li", *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/getpars.c b/fdelmodc3D/getpars.c
new file mode 100644
index 0000000000000000000000000000000000000000..5099c5801bef214253daf07667c1b3c55b1008b1
--- /dev/null
+++ b/fdelmodc3D/getpars.c
@@ -0,0 +1,732 @@
+/* This file is property of the Colorado School of Mines.
+
+ Copyright (C) 2007, Colorado School of Mines,
+ All rights reserved.
+
+
+ Redistribution and use in source and binary forms, with or
+ without modification, are permitted provided that the following
+ conditions are met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above
+ copyright notice, this list of conditions and the following
+ disclaimer in the documentation and/or other materials provided
+ with the distribution.
+ * Neither the name of the Colorado School of Mines nor the names of
+ its contributors may be used to endorse or promote products
+ derived from this software without specific prior written permission.
+
+ Warranty Disclaimer:
+ THIS SOFTWARE IS PROVIDED BY THE COLORADO SCHOOL OF MINES AND CONTRIBUTORS
+ "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+ FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+ COLORADO SCHOOL OF MINES OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+ INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+ BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+ LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+ CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+ STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING
+ IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ POSSIBILITY OF SUCH DAMAGE.
+
+
+ Export Restriction Disclaimer:
+ We believe that CWP/SU: Seismic Un*x is a low technology product that does
+ not appear on the Department of Commerce CCL list of restricted exports.
+ Accordingly, we believe that our product meets the qualifications of
+ an ECCN (export control classification number) of EAR99 and we believe
+ it fits the qualifications of NRR (no restrictions required), and
+ is thus not subject to export restrictions of any variety.
+
+ Approved Reference Format:
+ In publications, please refer to SU as per the following example:
+ Cohen, J. K. and Stockwell, Jr. J. W., (200_), CWP/SU: Seismic Un*x
+ Release No. __: an open source software package for seismic
+ research and processing,
+ Center for Wave Phenomena, Colorado School of Mines.
+
+ Articles about SU in peer-reviewed journals:
+ Saeki, T., (1999), A guide to Seismic Un*x (SU)(2)---examples of data processing (part 1), data input and preparation of headers, Butsuri-Tansa (Geophysical Exploration), vol. 52, no. 5, 465-477.
+ Stockwell, Jr. J. W. (1999), The CWP/SU: Seismic Un*x Package, Computers and Geosciences, May 1999.
+ Stockwell, Jr. J. W. (1997), Free Software in Education: A case study of CWP/SU: Seismic Un*x, The Leading Edge, July 1997.
+ Templeton, M. E., Gough, C.A., (1998), Web Seismic Un*x: Making seismic reflection processing more accessible, Computers and Geosciences.
+
+ Acknowledgements:
+ SU stands for CWP/SU:Seismic Un*x, a processing line developed at Colorado
+ School of Mines, partially based on Stanford Exploration Project (SEP)
+ software.
+ */
+
+/*********************** self documentation **********************/
+/*****************************************************************************
+GETPARS - Functions to GET PARameterS from the command line. Numeric
+ parameters may be single values or arrays of int, uint,
+ short, ushort, long, ulong, float, or double. Single character
+ strings (type string or char *) may also be gotten.
+ Arrays of strings, delimited by, but not containing
+ commas are permitted.
+
+The functions are:
+
+initargs Makes command line args available to subroutines (re-entrant).
+ Every par program starts with this call!
+getparint get integers
+getparuint get unsigned integers
+getparshort get short integers
+getparushort get unsigned short integers
+getparlong get long integers
+getparulong get unsigned long integers
+getparfloat get float
+getpardouble get double
+getparstring get a single string
+getparstringarray get string array (fields delimited by commas)
+getpar get parameter by type
+getnparint get n'th occurrence of integer
+getnparuint get n'th occurrence of unsigned int
+getnparshort get n'th occurrence of short integer
+getnparushort get n'th occurrence of unsigned short int
+getnparlong get n'th occurrence of long integer
+getnparulong get n'th occurrence of unsigned long int
+getnparfloat get n'th occurrence of float integer
+getnpardouble get n'th occurrence of double integer
+getnparstring get n'th occurrence of string integer
+getnparstringarray get n'th occurrence of string integer array
+getnpar get n'th occurrence by type
+countparname return the number of times a parameter names is used
+countparval return the number of values in the last occurrence
+ of a parameter
+countnparval return the number of values in the n'th occurrence
+ of a parameter
+getPar Promax compatible version of getpar
+
+******************************************************************************
+Function Prototypes:
+void initargs (int argc, char **argv);
+int getparint (char *name, int *p);
+int getparuint (char *name, unsigned int *p);
+int getparshort (char *name, short *p);
+int getparushort (char *name, unsigned short *p);
+int getparlong (char *name, long *p);
+int getparulong (char *name, unsigned long *p);
+int getparfloat (char *name, float *p);
+int getpardouble (char *name, double *p);
+int getparstring (char *name, char **p);
+int getparstringarray (char *name, char **p);
+int getnparint (int n, char *name, int *p);
+int getnparuint (int n, char *name, unsigned int *p);
+int getnparshort (int n, char *name, short *p);
+int getnparushort (int n, char *name, unsigned short *p);
+int getnparlong (int n, char *name, long *p);
+int getnparulong (int n, char *name, unsigned long *p);
+int getnparfloat (int n, char *name, float *p);
+int getnpardouble (int n, char *name, double *p);
+int getnparstring (int n, char *name, char **p);
+int getnparstringarray (int n, char *name, char **p);
+int getnpar (int n, char *name, char *type, void *ptr);
+int countparname (char *name);
+int countparval (char *name);
+int countnparval (int n, char *name);
+void getPar(char *name, char *type, void *ptr);
+
+******************************************************************************
+Notes:
+Here are some usage examples:
+
+ ... if integer n not specified, then default to zero.
+ if (!getparint("n", &n)) n = 0;
+
+ ... if array of floats vx is specified, then
+ if (nx=countparval("vx")) {
+ ... allocate space for array
+ vx = (float *)malloc(nx*sizeof(float));
+ ... and get the floats
+ getparfloat("vx",vx);
+ }
+
+The command line for the above examples might look like:
+ progname n=35 vx=3.21,4,9.5
+ Every par program starts with this call!
+
+More examples are provided in the DTEST code at the end of this file.
+
+The functions: eatoh, eatou, eatol, eatov, eatoi, eatop used
+below are versions of atoi that check for overflow. The source
+file for these functions is atopkge.c.
+
+******************************************************************************
+Authors:
+Rob Clayton & Jon Claerbout, Stanford University, 1979-1985
+Shuki Ronen & Jack Cohen, Colorado School of Mines, 1985-1990
+Dave Hale, Colorado School of Mines, 05/29/90
+Credit to John E. Anderson for re-entrant initargs 03/03/94
+*****************************************************************************/
+/**************** end self doc ********************************/
+
+#include "par.h"
+
+#ifndef TRUE
+#define TRUE (1)
+#endif
+#ifndef FALSE
+#define FALSE (0)
+#endif
+
+/* parameter table */
+typedef struct {
+ char *name; /* external name of parameter */
+ char *asciival; /* ascii value of parameter */
+} pointer_table;
+
+/* global variables declared and used internally */
+static pointer_table *argtbl; /* parameter table */
+static int nargs; /* number of args that parse */
+static int tabled = FALSE; /* true when parameters tabled */
+static int targc; /* total number of args */
+static char **targv; /* pointer to arg strings */
+static char *argstr; /* storage for command line */
+
+/* functions declared and used internally */
+static int getparindex (int n, char *name);
+static void getparinit(void);
+static void tabulate (int argc, char **argv);
+static char *getpfname (void);
+static int white2null (char *str, int len);
+static int ccount (char c, char *s);
+static void strchop(char *s, char *t);
+
+/* make command line args available to subroutines -- re-entrant version */
+void initargs(int argc, char **argv)
+{
+ xargc = argc; xargv = argv;
+ if(tabled==TRUE){
+ free(argstr);
+ free(targv);
+ free(argtbl);
+ }
+ tabled = FALSE;
+ return;
+}
+
+/* functions to get values for the last occurrence of a parameter name */
+int getparint (char *name, int *ptr)
+{
+ return getnpar(0,name,"i",ptr);
+}
+int getparuint (char *name, unsigned int *ptr)
+{
+ return getnpar(0,name,"p",ptr);
+}
+int getparshort (char *name, short *ptr)
+{
+ return getnpar(0,name,"h",ptr);
+}
+int getparushort (char *name, unsigned short *ptr)
+{
+ return getnpar(0,name,"u",ptr);
+}
+int getparlong (char *name, long *ptr)
+{
+ return getnpar(0,name,"l",ptr);
+}
+int getparulong (char *name, unsigned long *ptr)
+{
+ return getnpar(0,name,"v",ptr);
+}
+int getparfloat (char *name, float *ptr)
+{
+ return getnpar(0,name,"f",ptr);
+}
+int getpardouble (char *name, double *ptr)
+{
+ return getnpar(0,name,"d",ptr);
+}
+int getparstring (char *name, char **ptr)
+{
+ return getnpar(0,name,"s",ptr);
+}
+int getparstringarray (char *name, char **ptr)
+{
+ return getnpar(0,name,"a",ptr);
+}
+int getpar (char *name, char *type, void *ptr)
+{
+ return getnpar(0,name,type,ptr);
+}
+
+/* functions to get values for the n'th occurrence of a parameter name */
+int getnparint (int n, char *name, int *ptr)
+{
+ return getnpar(n,name,"i",ptr);
+}
+int getnparuint (int n, char *name, unsigned int *ptr)
+{
+ return getnpar(n,name,"p",ptr);
+}
+int getnparshort (int n, char *name, short *ptr)
+{
+ return getnpar(n,name,"h",ptr);
+}
+int getnparushort (int n, char *name, unsigned short *ptr)
+{
+ return getnpar(n,name,"u",ptr);
+}
+int getnparlong (int n, char *name, long *ptr)
+{
+ return getnpar(n,name,"l",ptr);
+}
+int getnparulong (int n, char *name, unsigned long *ptr)
+{
+ return getnpar(n,name,"v",ptr);
+}
+int getnparfloat (int n, char *name, float *ptr)
+{
+ return getnpar(n,name,"f",ptr);
+}
+int getnpardouble (int n, char *name, double *ptr)
+{
+ return getnpar(n,name,"d",ptr);
+}
+int getnparstring (int n, char *name, char **ptr)
+{
+ return getnpar(n,name,"s",ptr);
+}
+int getnparstringarray (int n, char *name, char **ptr)
+{
+ return getnpar(n,name,"a",ptr);
+}
+int getnpar (int n, char *name, char *type, void *ptr)
+{
+ int i; /* index of name in symbol table */
+ int nval; /* number of parameter values found */
+ char *aval; /* ascii field of symbol */
+
+ if (xargc == 1) return 0;
+ if (!tabled) getparinit();/* Tabulate command line and parfile */
+ i = getparindex(n,name);/* Get parameter index */
+ if (i < 0) return 0; /* Not there */
+
+ /*
+ * handle string type as a special case, since a string
+ * may contain commas.
+ */
+ if (type[0]=='s') {
+ *((char**)ptr) = argtbl[i].asciival;
+ return 1;
+ }
+
+ /* convert vector of ascii values to numeric values */
+ for (nval=0,aval=argtbl[i].asciival; *aval; nval++) {
+ switch (type[0]) {
+ case 'i':
+ *(int*)ptr = eatoi(aval);
+ ptr = (int*)ptr+1;
+ break;
+ case 'p':
+ *(unsigned int*)ptr = eatop(aval);
+ ptr = (unsigned int*)ptr+1;
+ break;
+ case 'h':
+ *(short*)ptr = eatoh(aval);
+ ptr = (short*)ptr+1;
+ break;
+ case 'u':
+ *(unsigned short*)ptr = eatou(aval);
+ ptr = (unsigned short*)ptr+1;
+ break;
+ case 'l':
+ *(long*)ptr = eatol(aval);
+ ptr = (long*)ptr+1;
+ break;
+ case 'v':
+ *(unsigned long*)ptr = eatov(aval);
+ ptr = (unsigned long*)ptr+1;
+ break;
+ case 'f':
+ *(float*)ptr = eatof(aval);
+ ptr = (float*)ptr+1;
+ break;
+ case 'd':
+ *(double*)ptr = eatod(aval);
+ ptr = (double*)ptr+1;
+ break;
+ case 'a':
+ { char *tmpstr="";
+ tmpstr = (char *)calloc(strlen(aval)+1,1);
+
+ strchop(aval,tmpstr);
+ *(char**)ptr = tmpstr;
+ ptr=(char **)ptr + 1;
+ }
+ break;
+ default:
+ err("%s: invalid parameter type = %s",
+ __FILE__,type);
+ }
+ while (*aval++ != ',') {
+ if (!*aval) break;
+ }
+ }
+ return nval;
+}
+/* Promax compatible version of getnpar */
+void getPar(char *name, char *type, void *ptr)
+{
+ (void) getnpar(0,name,type,ptr);
+ return;
+}
+
+/* return number of occurrences of parameter name */
+int countparname (char *name)
+{
+ int i,nname;
+
+ if (xargc == 1) return 0;
+ if (!tabled) getparinit();
+ for (i=0,nname=0; i<nargs; ++i)
+ if (!strcmp(name,argtbl[i].name)) ++nname;
+ return nname;
+}
+
+/* return number of values in n'th occurrence of parameter name */
+int countnparval (int n, char *name)
+{
+ int i;
+
+ if (xargc == 1) return 0;
+ if (!tabled) getparinit();
+ i = getparindex(n,name);
+ if (i>=0)
+ return ccount(',',argtbl[i].asciival) + 1;
+ else
+ return 0;
+}
+
+/* return number of values in last occurrence of parameter name */
+int countparval (char *name)
+{
+ return countnparval(0,name);
+}
+
+
+
+/*
+ * Return the index of the n'th occurrence of a parameter name,
+ * except if n==0, return the index of the last occurrence.
+ * Return -1 if the specified occurrence does not exist.
+ */
+static int getparindex (int n, char *name)
+{
+ int i;
+ if (n==0) {
+ for (i=nargs-1; i>=0; --i)
+ if (!strcmp(name,argtbl[i].name)) break;
+ return i;
+ } else {
+ for (i=0; i<nargs; ++i)
+ if (!strcmp(name,argtbl[i].name))
+ if (--n==0) break;
+ if (i<nargs)
+ return i;
+ else
+ return -1;
+ }
+}
+
+/* Initialize getpar */
+static void getparinit (void)
+{
+ static char *pfname; /* name of parameter file */
+ FILE *pffd=NULL; /* file id of parameter file */
+ int pflen; /* length of parameter file in bytes */
+ static int pfargc; /* arg count from parameter file */
+ int parfile; /* parfile existence flag */
+ int argstrlen;
+ char *pargstr; /* storage for parameter file args */
+ int nread; /* bytes fread */
+ int i, j; /* counters */
+
+
+ tabled = TRUE; /* remember table is built */
+
+ /* Check if xargc was initiated */
+ if(!xargc)
+ err("%s: xargc=%d -- not initiated in main", __FILE__, xargc);
+
+ /* Space needed for command lines */
+ for (i = 1, argstrlen = 0; i < xargc; i++) {
+ argstrlen += strlen(xargv[i]) + 1;
+ }
+
+ /* Get parfile name if there is one */
+ /* parfile = (pfname = getpfname()) ? TRUE : FALSE; */
+ if ((pfname = getpfname())) {
+ parfile = TRUE;
+ } else {
+ parfile = FALSE;
+ }
+
+ if (parfile) {
+ pffd = fopen(pfname, "r");
+
+ /* Get the length */
+ fseek(pffd, 0, SEEK_END);
+ pflen = ftell(pffd);
+ rewind(pffd);
+ argstrlen += pflen;
+ } else {
+ pflen = 0;
+ }
+
+ /* Allocate space for command line and parameter file
+ plus nulls at the ends to help with parsing. */
+ /* argstr = (char *) calloc((size_t) (1+argstrlen+1), 1); */
+ /*argstr = (char *) ealloc1(1+argstrlen+1, 1);*/
+ argstr = (char *) calloc((size_t) (1+argstrlen+1), 1);
+
+ if (parfile) {
+ /* Read the parfile */
+ nread = fread(argstr + 1, 1, pflen, pffd);
+ if (nread != pflen) {
+ err("%s: fread only %d bytes out of %d from %s",
+ __FILE__, nread, pflen, pfname);
+ }
+ fclose(pffd);
+
+ /* Zap whites in parfile to help in parsing */
+ pfargc = white2null(argstr, pflen);
+
+ } else {
+ pfargc = 0;
+ }
+
+ /* Total arg count */
+ targc = pfargc + xargc - 1;
+
+ /* Allocate space for total arg pointers */
+ targv = (char **) calloc(targc, sizeof(char*));
+
+ if (parfile) {
+ /* Parse the parfile. Skip over multiple NULLs */
+ for (j = 1, i = 0; j < pflen; j++) {
+ if (argstr[j] && !argstr[j-1]) {
+ targv[i++] = argstr + j;
+ }
+ }
+ } else {
+ i = 0;
+ }
+
+ /* Copy command line arguments */
+ for (j = 1, pargstr = argstr + pflen + 2; j < xargc; j++) {
+ strcpy(pargstr,xargv[j]);
+ targv[i++] = pargstr;
+ pargstr += strlen(xargv[j]) + 1;
+ }
+
+ /* Allocate space for the pointer table */
+ argtbl = (pointer_table*) calloc(targc, sizeof(pointer_table));
+
+ /* Tabulate targv */
+ tabulate(targc, targv);
+
+ return;
+}
+
+#define PFNAME "par="
+/* Get name of parameter file */
+static char *getpfname (void)
+{
+ int i;
+ int pfnamelen;
+
+ pfnamelen = strlen(PFNAME);
+ for (i = xargc-1 ; i > 0 ; i--) {
+ if(!strncmp(PFNAME, xargv[i], pfnamelen)
+ && strlen(xargv[i]) != pfnamelen) {
+ return xargv[i] + pfnamelen;
+ }
+ }
+ return NULL;
+}
+
+#define iswhite(c) ((c) == ' ' || (c) == '\t' || (c) == '\n')
+
+/*
+ * Replace the whites by (possibly multiple) nulls. If we see a non-white
+ * and the previous char is a null, this signals the start of a string
+ * and we bump the count. This routine returns a count of the strings.
+ */
+static int white2null (char *str, int len)
+{
+ int i;
+ int count;
+ int inquote = FALSE;
+
+ str[0] = '\0'; /* This line added by Dave Hale, 1/30/96. */
+ for (i = 1, count = 0; i < len; i++) {
+ if (str[i]=='"') inquote=(inquote==TRUE)?FALSE:TRUE;
+ if (!inquote) {
+ if (iswhite(str[i])) { /* Is this a new word ? */
+ str[i] = '\0';
+ } else if (!str[i-1]) { /* multiple whites */
+ count++;
+ }
+ }
+ }
+ for (i = 1, inquote=FALSE; i < len; i++) {
+ if (str[i]=='"') inquote=(inquote==TRUE)?FALSE:TRUE;
+ if (inquote) {
+ if (str[i+1]!='"') {
+ str[i] = str[i+1];
+ } else {
+ str[i] = '\0';
+ str[i+1] = '\0';
+ inquote = FALSE;
+ }
+ }
+ }
+ str[len] = '\0';
+ return count;
+}
+
+/* Install symbol table */
+static void tabulate (int argc, char **argv)
+{
+ int i;
+ char *eqptr;
+
+ for (i = 0, nargs = 0 ; i < argc; i++) {
+ eqptr = (char *)strchr(argv[i], '=');
+ if (eqptr) {
+ argtbl[nargs].name = argv[i];
+ argtbl[nargs].asciival = eqptr + 1;
+ *eqptr = (char)0;
+
+ /* Debugging dump */
+/* fprintf(stderr, */
+/* "argtbl[%d]: name=%s asciival=%s\n", */
+/* nargs,argtbl[nargs].name,argtbl[nargs].asciival); */
+
+ nargs++;
+ }
+ }
+ return;
+}
+
+/* Count characters in a string */
+static int ccount (char c, char *s)
+{
+ int i, count;
+ for (i = 0, count = 0; s[i] != 0; i++)
+ if(s[i] == c) count++;
+ return count;
+}
+
+static void strchop(char *s, char *t)
+/***********************************************************************
+strchop - chop off the tail end of a string "s" after a "," returning
+ the front part of "s" as "t".
+************************************************************************
+Notes:
+Based on strcpy in Kernighan and Ritchie's C [ANSI C] book, p. 106.
+************************************************************************
+Author: CWP: John Stockwell and Jack K. Cohen, July 1995
+***********************************************************************/
+{
+
+ while ( (*s != ',') && (*s != '\0') ) {
+ *t++ = *s++;
+ }
+ *t='\0';
+}
+
+
+#ifdef TEST
+#define N 100
+main(int argc, char **argv)
+{
+ char *s;
+ short h, vh[N];
+ unsigned short u, vu[N];
+ long l, vl[N];
+ unsigned long v, vv[N];
+ int i, vi[N], ipar, npar, nval;
+ unsigned int p, vp[N];
+ float f, vf[N];
+ double d, vd[N];
+
+ initargs(argc, argv);
+
+ /* int parameters */
+ npar = countparname("i");
+ printf("\nnumber of i pars = %d\n",npar);
+ for (ipar=1; ipar<=npar; ++ipar) {
+ getnparint(ipar,"i",&i);
+ printf("occurrence %d of i=%d\n",ipar,i);
+ }
+ if (getparint("i", &i))
+ printf("last occurrence of i=%d\n",i);
+ npar = countparname("vi");
+ printf("number of vi pars = %d\n",npar);
+ for (ipar=1; ipar<=npar; ++ipar) {
+ nval = countnparval(ipar,"vi");
+ printf("occurrence %d has %d values\n",ipar,nval);
+ nval = getnparint(ipar,"vi",vi);
+ printf("vi=");
+ for (i=0; i<nval; i++)
+ printf("%d%c",vi[i],i==nval-1?'\n':',');
+ }
+ if (npar>0) {
+ nval = countparval("vi");
+ printf("last occurrence has %d values\n",nval);
+ getparint("vi",vi);
+ printf("vi=");
+ for (i=0; i<nval; i++)
+ printf("%d%c",vi[i],i==nval-1?'\n':',');
+ }
+
+ /* float parameters */
+ npar = countparname("f");
+ printf("\nnumber of f pars = %d\n",npar);
+ for (ipar=1; ipar<=npar; ++ipar) {
+ getnparfloat(ipar,"f",&f);
+ printf("occurrence %d of f=%g\n",ipar,f);
+ }
+ if (getparfloat("f", &f))
+ printf("last occurrence of f=%g\n",f);
+ npar = countparname("vf");
+ printf("number of vf pars = %d\n",npar);
+ for (ipar=1; ipar<=npar; ++ipar) {
+ nval = countnparval(ipar,"vf");
+ printf("occurrence %d has %d values\n",ipar,nval);
+ nval = getnparfloat(ipar,"vf",vf);
+ printf("vf=");
+ for (i=0; i<nval; i++)
+ printf("%g%c",vf[i],i==nval-1?'\n':',');
+ }
+ if (npar>0) {
+ nval = countparval("vf");
+ printf("last occurrence has %d values\n",nval);
+ getparfloat("vf",vf);
+ printf("vf=");
+ for (i=0; i<nval; i++)
+ printf("%g%c",vf[i],i==nval-1?'\n':',');
+ }
+
+ /* string parameters */
+ npar = countparname("s");
+ printf("\nnumber of s pars = %d\n",npar);
+ for (ipar=1; ipar<=npar; ++ipar) {
+ getnparstring(ipar,"s",&s);
+ printf("occurrence %d of s=%s\n",ipar,s);
+ }
+ if (getparstring("s", &s))
+ printf("last occurrence of s=%s\n",s);
+
+ return EXIT_SUCCESS;
+}
+#endif
+
diff --git a/fdelmodc3D/name_ext.c b/fdelmodc3D/name_ext.c
new file mode 100644
index 0000000000000000000000000000000000000000..8fa1e09d254153d4d783ab040cebfada4d82d3b7
--- /dev/null
+++ b/fdelmodc3D/name_ext.c
@@ -0,0 +1,44 @@
+#include<stdlib.h>
+#include<string.h>
+#include<stdio.h>
+
+/**
+* inserts a character string after the filename, before the extension
+*
+* AUTHOR:
+* Jan Thorbecke (janth@xs4all.nl)
+* The Netherlands
+**/
+
+
+void name_ext(char *filename, char *extension)
+{
+ char ext[100];
+
+ if (strstr(filename, ".su") != NULL) {
+ sprintf(ext,"%s.su", extension);
+ strcpy(strstr(filename, ".su"), ext);
+ }
+ else if (strstr(filename, ".segy") != NULL) {
+ sprintf(ext,"%s.segy", extension);
+ strcpy(strstr(filename, ".segy"), ext);
+ }
+ else if (strstr(filename, ".mat") != NULL) {
+ sprintf(ext,"%s.mat", extension);
+ strcpy(strstr(filename, ".mat"), ext);
+ }
+ else if (strstr(filename, ".hdf") != NULL) {
+ sprintf(ext,"%s.hdf", extension);
+ strcpy(strstr(filename, ".hdf"), ext);
+ }
+ else if (strrchr(filename, '.') != NULL) {
+ sprintf(ext,"%s.su", extension);
+ strcpy(strrchr(filename, '.'), ext);
+ }
+ else {
+ sprintf(ext,"%s.su", extension);
+ strcat(filename, ext);
+ }
+
+ return;
+}
diff --git a/fdelmodc3D/par.h b/fdelmodc3D/par.h
new file mode 100644
index 0000000000000000000000000000000000000000..fce76ed344382c6d5719737e5395fd8fb3ad0a5b
--- /dev/null
+++ b/fdelmodc3D/par.h
@@ -0,0 +1,217 @@
+/* This file is property of the Colorado School of Mines.
+
+ Copyright © 2007, Colorado School of Mines,
+ All rights reserved.
+
+
+ Redistribution and use in source and binary forms, with or
+ without modification, are permitted provided that the following
+ conditions are met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above
+ copyright notice, this list of conditions and the following
+ disclaimer in the documentation and/or other materials provided
+ with the distribution.
+ * Neither the name of the Colorado School of Mines nor the names of
+ its contributors may be used to endorse or promote products
+ derived from this software without specific prior written permission.
+
+ Warranty Disclaimer:
+ THIS SOFTWARE IS PROVIDED BY THE COLORADO SCHOOL OF MINES AND CONTRIBUTORS
+ "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+ FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+ COLORADO SCHOOL OF MINES OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+ INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+ BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+ LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+ CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+ STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING
+ IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ POSSIBILITY OF SUCH DAMAGE.
+
+
+ Export Restriction Disclaimer:
+ We believe that CWP/SU: Seismic Un*x is a low technology product that does
+ not appear on the Department of Commerce CCL list of restricted exports.
+ Accordingly, we believe that our product meets the qualifications of
+ an ECCN (export control classification number) of EAR99 and we believe
+ it fits the qualifications of NRR (no restrictions required), and
+ is thus not subject to export restrictions of any variety.
+
+ Approved Reference Format:
+ In publications, please refer to SU as per the following example:
+ Cohen, J. K. and Stockwell, Jr. J. W., (200_), CWP/SU: Seismic Un*x
+ Release No. __: an open source software package for seismic
+ research and processing,
+ Center for Wave Phenomena, Colorado School of Mines.
+
+ Articles about SU in peer-reviewed journals:
+ Saeki, T., (1999), A guide to Seismic Un*x (SU)(2)---examples of data processing (part 1), data input and preparation of headers, Butsuri-Tansa (Geophysical Exploration), vol. 52, no. 5, 465-477.
+ Stockwell, Jr. J. W. (1999), The CWP/SU: Seismic Un*x Package, Computers and Geosciences, May 1999.
+ Stockwell, Jr. J. W. (1997), Free Software in Education: A case study of CWP/SU: Seismic Un*x, The Leading Edge, July 1997.
+ Templeton, M. E., Gough, C.A., (1998), Web Seismic Un*x: Making seismic reflection processing more accessible, Computers and Geosciences.
+
+ Acknowledgements:
+ SU stands for CWP/SU:Seismic Un*x, a processing line developed at Colorado
+ School of Mines, partially based on Stanford Exploration Project (SEP)
+ software.
+ . */
+/* par.h - include file for getpar, selfdoc, and error handling functions */
+
+#ifndef PAR_H
+#define PAR_H
+void verr(char *fmt, ...);
+void vmess(char *fmt, ...);
+void vwarn(char *fmt, ...);
+void vsyserr(char *fmt, ...);
+
+/* TYPEDEFS */
+typedef union { /* storage for arbitrary type */
+ char s[8];
+ short h;
+ unsigned short u;
+ long l;
+ unsigned long v;
+ int i;
+ unsigned int p;
+ float f;
+ double d;
+ unsigned int U:16;
+ unsigned int P:32;
+} Value;
+
+/* INCLUDES */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <fcntl.h> /* non-ANSI */
+#include <unistd.h> /* non-ANSI */
+#include <sys/types.h> /* non-ANSI */
+#include<string.h>
+
+
+/* GLOBAL DECLARATIONS */
+extern int xargc; extern char **xargv;
+
+
+/* TYPEDEFS */
+typedef char *cwp_String;
+
+typedef enum {BADFILETYPE = -1,
+ TTY, DISK, DIRECTORY, TAPE, PIPE, FIFO, SOCKET, SYMLINK} FileType;
+
+/* DEFINES */
+
+/* getpar macros */
+#define MUSTGETPARINT(x,y) if(!getparint(x,y)) err("must specify %s=",x)
+#define MUSTGETPARFLOAT(x,y) if(!getparfloat(x,y)) err("must specify %s=",x)
+#define MUSTGETPARSTRING(x,y) if(!getparstring(x,y)) err("must specify %s=",x)
+
+#define STDIN (0)
+#define STDOUT (1)
+#define STDERR (2)
+
+/* FUNCTION PROTOTYPES */
+
+#ifdef __cplusplus /* if C++, specify external C linkage */
+extern "C" {
+#endif
+
+/* getpar parameter parsing */
+void initargs (int argc, char **argv);
+int getparint (char *name, int *p);
+int getparuint (char *name, unsigned int *p);
+int getparshort (char *name, short *p);
+int getparushort (char *name, unsigned short *p);
+int getparlong (char *name, long *p);
+int getparulong (char *name, unsigned long *p);
+int getparfloat (char *name, float *p);
+int getpardouble (char *name, double *p);
+int getparstring (char *name, char **p);
+int getparstringarray (char *name, char **p);
+int getnparint (int n, char *name, int *p);
+int getnparuint (int n, char *name, unsigned int *p);
+int getnparshort (int n, char *name, short *p);
+int getnparushort (int n, char *name, unsigned short *p);
+int getnparlong (int n, char *name, long *p);
+int getnparulong (int n, char *name, unsigned long *p);
+int getnparfloat (int n, char *name, float *p);
+int getnpardouble (int n, char *name, double *p);
+int getnparstring (int n, char *name, char **p);
+int getnparstringarray (int n, char *name, char **p);
+int getnpar (int n, char *name, char *type, void *ptr);
+int countparname (char *name);
+int countparval (char *name);
+int countnparval (int n, char *name);
+
+/* For ProMAX */
+void getPar(char *name, char *type, void *ptr);
+
+/* errors and warnings */
+void err (char *fmt, ...);
+void syserr (char *fmt, ...);
+void warn (char *fmt, ...);
+
+/* self documentation */
+void pagedoc (void);
+void requestdoc (int i);
+
+/* system calls with error trapping */
+int ecreat(char *path, int perms);
+int efork(void);
+int eopen(char *path, int flags, int perms);
+int eclose(int fd);
+int eunlink(char *path);
+long elseek(int fd, long offset, int origin);
+int epipe(int fd[2]);
+int eread(int fd, char *buf, int nbytes);
+int ewrite(int fd, char *buf, int nbytes);
+
+/* system subroutine calls with error trapping */
+FILE *efopen(const char *file, const char *mode);
+FILE *efreopen(const char *file, const char *mode, FILE *stream1);
+FILE *efdopen(int fd, const char *mode);
+FILE *epopen(char *command, char *type);
+int efclose(FILE *stream);
+int epclose(FILE *stream);
+int efflush(FILE *stream);
+int eremove(const char *file);
+int erename(const char *oldfile, const char* newfile);
+int efseek(FILE *stream, long offset, int origin);
+void erewind(FILE *stream);
+long eftell(FILE *stream);
+FILE *etmpfile(void);
+char *etmpnam(char *namebuffer);
+void *emalloc(size_t size);
+void *erealloc(void *memptr, size_t size);
+void *ecalloc(size_t count, size_t size);
+size_t efread(void *bufptr, size_t size, size_t count, FILE *stream);
+size_t efwrite(void *bufptr, size_t size, size_t count, FILE *stream);
+
+#ifndef SUN_A
+int efgetpos(FILE *stream, fpos_t *position);
+int efsetpos(FILE *stream, const fpos_t *position);
+#endif
+
+/* string to numeric conversion with error checking */
+short eatoh(char *s);
+unsigned short eatou(char *s);
+int eatoi(char *s);
+unsigned int eatop(char *s);
+long eatol(char *s);
+unsigned long eatov(char *s);
+float eatof(char *s);
+double eatod(char *s);
+
+/* file type checking */
+FileType filestat(int fd);
+char *printstat(int fd);
+
+#ifdef __cplusplus /* if C++ (external C linkage is being specified) */
+}
+#endif
+
+#endif /* PAR_H */
diff --git a/fdelmodc3D/readModel.c b/fdelmodc3D/readModel.c
new file mode 100644
index 0000000000000000000000000000000000000000..a3975ef3cb657a813aeaf0b6b91054b321c94c38
--- /dev/null
+++ b/fdelmodc3D/readModel.c
@@ -0,0 +1,792 @@
+#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
new file mode 100644
index 0000000000000000000000000000000000000000..cd3ce5832fd6353cc887bb9497ccec75a2bad1e9
--- /dev/null
+++ b/fdelmodc3D/readModel3D.c
@@ -0,0 +1,1283 @@
+#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 "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))
+
+/**
+* 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
+**/
+
+
+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;
+ size_t nread;
+ long i, j, l, tracesToDo;
+ long n1, n2, n3, ix, iy, iz, nz, ny, nx;
+ long ixo, iyo, izo, ixe, iye, ize;
+ long ioXx, ioXy, ioXz, ioYx, ioYy, ioYz, ioZz, ioZy, ioZx, ioPx, ioPy, ioPz, ioTx, ioTy, ioTz;
+ float cp2, cs2, cs11, cs12, cs21, cs22, mul, mu, lamda2mu, lamda;
+ float cs2c, cs2b, cs2a, cpx, cpy, cpz, bx, by, bz, fac;
+ float *cp, *cs, *ro, *qp, *qs;
+ float a, b;
+ segy hdr;
+
+
+ /* grid size and start positions for the components */
+ nz = mod.nz;
+ ny = mod.ny;
+ nx = mod.nx;
+ n1 = mod.naz;
+ n2 = mod.nax;
+ n3 = mod.nay;
+ fac = mod.dt/mod.dx;
+
+ /* Vx: rox */
+ ioXx=mod.ioXx;
+ ioXy=mod.ioXy;
+ ioXz=mod.ioXz;
+ /* Vy: roy */
+ ioYx=mod.ioYx;
+ ioYy=mod.ioYy;
+ ioYz=mod.ioYz;
+ /* Vz: roz */
+ ioZz=mod.ioZz;
+ ioZy=mod.ioZy;
+ ioZx=mod.ioZx;
+ /* P, Txx, Tyy, Tzz: lam, l2m */
+ ioPx=mod.ioPx;
+ ioPy=mod.ioPy;
+ ioPz=mod.ioPz;
+ /* Txz, Txy, Tyz,: muu */
+ ioTx=mod.ioTx;
+ ioTy=mod.ioTy;
+ ioTz=mod.ioTz;
+ if (bnd.lef==4 || bnd.lef==2) {
+ ioPx += bnd.ntap;
+ ioTx += bnd.ntap;
+ }
+ if (bnd.fro==4 || bnd.fro==2) {
+ ioPy += bnd.ntap;
+ ioTy += 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*ny*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*ny*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*ny*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*mod.ny;
+ for (iy=0; iy<ny; iy++) {
+ for (ix=0; ix<nx; ix++ ) {
+ i = iy*nx+ix;
+ 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;
+ b = 1.0/(mod.fw*mod.fw*a);
+ tss[(iy+ioPy)*n1*n2+(ix+ioPx)*n1+iz+ioPz] = 1.0/a;
+ tep[(iy+ioPy)*n1*n2+(ix+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;
+ b = 1.0/(mod.fw*mod.fw*a);
+ tss[(iy+ioPy)*n1*n2+(ix+ioPx)*n1+iz+ioPz] = 1.0/a;
+ tep[(iy+ioPy)*n1*n2+(ix+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[(iy+ioPy)*n1*n2+(ix+ioPx)*n1+iz+ioPz];
+ tes[(iy+ioPy)*n1*n2+(ix+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[(iy+ioPy)*n1*n2+(ix+ioPx)*n1+iz+ioPz];
+ tes[(iy+ioPy)*n1*n2+(ix+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;
+ }
+ }
+ }
+ 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*ny;i++) {
+ if (ro[i]==0.0) {
+ vwarn("Zero density for trace=%li sample=%li", 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;
+ iy = ny-1;
+ for (ix=0;ix<nx-1;ix++) {
+ cp2 = cp[iy*nx*nz+ix*nz+iz]*cp[iy*nx*nz+ix*nz+iz];
+ cs2 = cs[iy*nx*nz+ix*nz+iz]*cs[iy*nx*nz+ix*nz+iz];
+ cs2a = cs[iy*nx*nz+(ix+1)*nz+iz]*cs[iy*nx*nz+(ix+1)*nz+iz];
+ cs11 = cs2*ro[iy*nx*nz+ix*nz+iz];
+ cs12 = cs2*ro[iy*nx*nz+ix*nz+iz];
+ cs21 = cs2a*ro[iy*nx*nz+(ix+1)*nz+iz];
+ cs22 = cs2a*ro[iy*nx*nz+(ix+1)*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[iy*nx*nz+ix*nz+iz];
+ lamda2mu = cp2*ro[iy*nx*nz+ix*nz+iz];
+ lamda = lamda2mu - 2*mu;
+
+ bx = 0.5*(ro[iy*nx*nz+ix*nz+iz]+ro[iy*nx*nz+(ix+1)*nz+iz]);
+ by = ro[iy*nx*nz+ix*nz+iz];
+ bz = ro[iy*nx*nz+ix*nz+iz];
+ rox[(iy+ioXy)*n2*n1+(ix+ioXx)*n1+iz+ioXz]=fac/bx;
+ roy[(iy+ioYy)*n2*n1+(ix+ioYx)*n1+iz+ioYz]=fac/by;
+ roz[(iy+ioZy)*n2*n1+(ix+ioZx)*n1+iz+ioZz]=fac/bz;
+ l2m[(iy+ioPy)*n2*n1+(ix+ioPx)*n1+iz+ioPz]=fac*lamda2mu;
+ lam[(iy+ioPy)*n2*n1+(ix+ioPx)*n1+iz+ioPz]=fac*lamda;
+ muu[(iy+ioTy)*n2*n1+(ix+ioTx)*n1+iz+ioTz]=fac*mul;
+ }
+
+ ix = nx-1;
+ iz = nz-1;
+ for (iy=0;iy<ny-1;iy++) {
+ cp2 = cp[iy*nx*nz+ix*nz+iz]*cp[iy*nx*nz+ix*nz+iz];
+ cs2 = cs[iy*nx*nz+ix*nz+iz]*cs[iy*nx*nz+ix*nz+iz];
+ cs2b = cs[(iy+1)*nx*nz+ix*nz+iz]*cs[(iy+1)*nx*nz+ix*nz+iz];
+ cs11 = cs2*ro[iy*nx*nz+ix*nz+iz];
+ cs12 = cs2b*ro[iy*nx*nz+ix*nz+iz];
+ cs21 = cs2*ro[iy*nx*nz+ix*nz+iz];
+ cs22 = cs2b*ro[iy*nx*nz+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[iy*nx*nz+ix*nz+iz];
+ lamda2mu = cp2*ro[iy*nx*nz+ix*nz+iz];
+ lamda = lamda2mu - 2*mu;
+
+ bx = ro[iy*nx*nz+ix*nz+iz];
+ by = ro[iy*nx*nz+ix*nz+iz];
+ bz = 0.5*(ro[iy*nx*nz+ix*nz+iz]+ro[iy*nx*nz+ix*nz+iz+1]);
+ rox[(iy+ioXy)*n2*n1+(ix+ioXx)*n1+iz+ioXz]=fac/bx;
+ roy[(iy+ioYy)*n2*n1+(ix+ioYx)*n1+iz+ioYz]=fac/bx;
+ roz[(iy+ioZy)*n2*n1+(ix+ioZx)*n1+iz+ioZz]=fac/bz;
+ l2m[(iy+ioPy)*n2*n1+(ix+ioPx)*n1+iz+ioPz]=fac*lamda2mu;
+ lam[(iy+ioPy)*n2*n1+(ix+ioPx)*n1+iz+ioPz]=fac*lamda;
+ muu[(iy+ioTy)*n2*n1+(ix+ioTx)*n1+iz+ioTz]=fac*mul;
+ }
+
+ ix = nx-1;
+ iy = ny-1;
+ for (iz=0;iz<nz-1;iz++) {
+ cp2 = cp[iy*nx*nz+ix*nz+iz]*cp[iy*nx*nz+ix*nz+iz];
+ cs2 = cs[iy*nx*nz+ix*nz+iz]*cs[iy*nx*nz+ix*nz+iz];
+ cs2b = cs[iy*nx*nz+ix*nz+iz+1]*cs[iy*nx*nz+ix*nz+iz+1];
+ cs11 = cs2*ro[iy*nx*nz+ix*nz+iz];
+ cs12 = cs2b*ro[iy*nx*nz+ix*nz+iz+1];
+ cs21 = cs2*ro[iy*nx*nz+ix*nz+iz];
+ cs22 = cs2b*ro[iy*nx*nz+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[iy*nx*nz+ix*nz+iz];
+ lamda2mu = cp2*ro[iy*nx*nz+ix*nz+iz];
+ lamda = lamda2mu - 2*mu;
+
+ bx = ro[iy*nx*nz+ix*nz+iz];
+ by = ro[iy*nx*nz+ix*nz+iz];
+ bz = 0.5*(ro[iy*nx*nz+ix*nz+iz]+ro[iy*nx*nz+ix*nz+iz+1]);
+ rox[(iy+ioXy)*n2*n1+(ix+ioXx)*n1+iz+ioXz]=fac/bx;
+ roy[(iy+ioYy)*n2*n1+(ix+ioYx)*n1+iz+ioYz]=fac/bx;
+ roz[(iy+ioZy)*n2*n1+(ix+ioZx)*n1+iz+ioZz]=fac/bz;
+ l2m[(iy+ioPy)*n2*n1+(ix+ioPx)*n1+iz+ioPz]=fac*lamda2mu;
+ lam[(iy+ioPy)*n2*n1+(ix+ioPx)*n1+iz+ioPz]=fac*lamda;
+ muu[(iy+ioTy)*n2*n1+(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;
+ }
+ }
+
+ }
+ else { /* Acoustic Scheme */
+ iz = nz-1;
+ iy = ny-1;
+ for (ix=0;ix<nx-1;ix++) {
+ cp2 = cp[iy*nx*nz+ix*nz+iz]*cp[iy*nx*nz+ix*nz+iz];
+ lamda2mu = cp2*ro[iy*nx*nz+ix*nz+iz];
+
+ bx = 0.5*(ro[iy*nx*nz+ix*nz+iz]+ro[iy*nx*nz+(ix+1)*nz+iz]);
+ by = ro[iy*nx*nz+ix*nz+iz];
+ bz = ro[iy*nx*nz+ix*nz+iz];
+ rox[(iy+ioXy)*n2*n1+(ix+ioXx)*n1+iz+ioXz]=fac/bx;
+ roy[(iy+ioYy)*n2*n1+(ix+ioYx)*n1+iz+ioYz]=fac/by;
+ roz[(iy+ioZy)*n2*n1+(ix+ioZx)*n1+iz+ioZz]=fac/bz;
+ l2m[(iy+ioPy)*n2*n1+(ix+ioPx)*n1+iz+ioPz]=fac*lamda2mu;
+ }
+
+ iz = nz-1;
+ ix = nx-1;
+ for (iy=0;iy<ny-1;iy++) {
+ cp2 = cp[iy*nx*nz+ix*nz+iz]*cp[iy*nx*nz+ix*nz+iz];
+ lamda2mu = cp2*ro[iy*nx*nz+ix*nz+iz];
+
+ bx = ro[iy*nx*nz+ix*nz+iz];
+ by = 0.5*(ro[iy*nx*nz+ix*nz+iz]+ro[(iy+1)*nx*nz+ix*nz+iz]);
+ bz = ro[iy*nx*nz+ix*nz+iz];
+ rox[(iy+ioXy)*n2*n1+(ix+ioXx)*n1+iz+ioXz]=fac/bx;
+ roy[(iy+ioYy)*n2*n1+(ix+ioYx)*n1+iz+ioYz]=fac/by;
+ roz[(iy+ioZy)*n2*n1+(ix+ioZx)*n1+iz+ioZz]=fac/bz;
+ l2m[(iy+ioPy)*n2*n1+(ix+ioPx)*n1+iz+ioPz]=fac*lamda2mu;
+ }
+
+ ix = nx-1;
+ iy = ny-1;
+ for (iz=0;iz<nz-1;iz++) {
+ cp2 = cp[iy*nx*nz+ix*nz+iz]*cp[iy*nx*nz+ix*nz+iz];
+ lamda2mu = cp2*ro[iy*nx*nz+ix*nz+iz];
+
+ bx = ro[iy*nx*nz+ix*nz+iz];
+ by = ro[iy*nx*nz+ix*nz+iz];
+ bz = 0.5*(ro[iy*nx*nz+ix*nz+iz]+ro[iy*nx*nz+ix*nz+iz+1]);
+ rox[(iy+ioXy)*n2*n1+(ix+ioXx)*n1+iz+ioXz]=fac/bx;
+ roy[(iy+ioYy)*n2*n1+(ix+ioYx)*n1+iz+ioYz]=fac/by;
+ roz[(iy+ioZy)*n2*n1+(ix+ioZx)*n1+iz+ioZz]=fac/bz;
+ l2m[(iy+ioPy)*n2*n1+(ix+ioPx)*n1+iz+ioPz]=fac*lamda2mu;
+ }
+ ix=nx-1;
+ iy=ny-1;
+ iz=nz-1;
+ cp2 = cp[iy*nx*nz+ix*nz+iz]*cp[iy*nx*nz+ix*nz+iz];
+ lamda2mu = cp2*ro[iy*nx*nz+ix*nz+iz];
+ bx = ro[iy*nx*nz+ix*nz+iz];
+ bz = ro[iy*nx*nz+ix*nz+iz];
+ rox[(iy+ioXy)*n2*n1+(ix+ioXx)*n1+iz+ioXz]=fac/bx;
+ roy[(iy+ioYy)*n2*n1+(ix+ioYx)*n1+iz+ioYz]=fac/by;
+ roz[(iy+ioZy)*n2*n1+(ix+ioZx)*n1+iz+ioZz]=fac/bz;
+ l2m[(iy+ioPy)*n2*n1+(ix+ioPx)*n1+iz+ioPz]=fac*lamda2mu;
+
+ for (iy=0; iy<ny-1; iy++) {
+ for (ix=0; ix<nx-1; ix++) {
+ for (iz=0; iz<nz-1; iz++) {
+ cp2 = cp[iy*nx*nz+ix*nz+iz]*cp[iy*nx*nz+ix*nz+iz];
+ lamda2mu = cp2*ro[iy*nx*nz+ix*nz+iz];
+
+ bx = 0.5*(ro[iy*nx*nz+ix*nz+iz]+ro[iy*nx*nz+(ix+1)*nz+iz]);
+ by = 0.5*(ro[iy*nx*nz+ix*nz+iz]+ro[(iy+1)*nx*nz+ix*nz+iz]);
+ bz = 0.5*(ro[iy*nx*nz+ix*nz+iz]+ro[iy*nx*nz+ix*nz+iz+1]);
+ rox[(iy+ioXy)*n2*n1+(ix+ioXx)*n1+iz+ioXz]=fac/bx;
+ roy[(iy+ioYy)*n2*n1+(ix+ioYx)*n1+iz+ioYz]=fac/by;
+ roz[(iy+ioZy)*n2*n1+(ix+ioZx)*n1+iz+ioZz]=fac/bz;
+ l2m[(iy+ioPy)*n2*n1+(ix+ioPx)*n1+iz+ioPz]=fac*lamda2mu;
+ }
+ }
+ }
+ }
+
+ /* For topography free surface check for zero-velocity and set rox and roz also to zero */
+ for (iy=0; iy<ny; iy++) {
+ for (ix=0; ix<nx; ix++) {
+ for (iz=0; iz<nz; iz++) {
+ if (l2m[(ix+ioPy)*n2*n1+(ix+ioPx)*n1+iz+ioPz]==0.0) {
+ rox[(ix+ioXy)*n2*n1+(ix+ioXx)*n1+iz+ioXz]=0.0;
+ roz[(ix+ioYy)*n2*n1+(ix+ioYx)*n1+iz+ioYz]=0.0;
+ roz[(ix+ioZy)*n2*n1+(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;
+ iyo = mod.ioXy;
+ iye = mod.ieXy;
+ izo = mod.ioXz;
+ ize = mod.ieXz;
+ for (iy=iyo; iy<iye; iy++) {
+ for (ix=ixo; ix<ixe; ix++) {
+ for (iz=izo; iz<ize; iz++) {
+ rox[iy*n2*n1+ix*n1+iz] = rox[iy*n2*n1+ixe*n1+iz];
+ }
+ }
+ }
+
+ /* roy field */
+ ixo = mod.ioYx-bnd.ntap;
+ ixe = mod.ioYx;
+ iyo = mod.ioYy;
+ iye = mod.ieYy;
+ izo = mod.ioYz;
+ ize = mod.ieYz;
+ for (iy=iyo; iy<iye; iy++) {
+ for (ix=ixo; ix<ixe; ix++) {
+ for (iz=izo; iz<ize; iz++) {
+ roy[iy*n2*n1+ix*n1+iz] = rox[iy*n2*n1+ixe*n1+iz];
+ }
+ }
+ }
+
+ /* roz field */
+ ixo = mod.ioZx-bnd.ntap;
+ ixe = mod.ioZx;
+ iyo = mod.ioZy;
+ iye = mod.ieZy;
+ izo = mod.ioZz;
+ ize = mod.ieZz;
+ for (iy=iyo; iy<iye; iy++) {
+ for (ix=ixo; ix<ixe; ix++) {
+ for (iz=izo; iz<ize; iz++) {
+ roz[iy*n2*n1+ix*n1+iz] = roz[iy*n2*n1+ixe*n1+iz];
+ }
+ }
+ }
+
+ /* l2m field */
+ ixo = mod.ioPx;
+ ixe = mod.ioPx+bnd.ntap;
+ iyo = mod.ioPy;
+ iye = mod.iePy;
+ izo = mod.ioPz;
+ ize = mod.iePz;
+ for (iy=iyo; iy<iye; iy++) {
+ for (ix=ixo; ix<ixe; ix++) {
+ for (iz=izo; iz<ize; iz++) {
+ l2m[iy*n2*n1+ix*n1+iz] = l2m[iy*n2*n1+ixe*n1+iz];
+ }
+ }
+ }
+
+ if (mod.ischeme>2) { /* Elastic Scheme */
+ /* lam field */
+ ixo = mod.ioPx;
+ ixe = mod.ioPx+bnd.ntap;
+ iyo = mod.ioPy;
+ iye = mod.iePy;
+ izo = mod.ioPz;
+ ize = mod.iePz;
+ for (iy=iyo; iy<iye; iy++) {
+ for (ix=ixo; ix<ixe; ix++) {
+ for (iz=izo; iz<ize; iz++) {
+ lam[iy*n2*n1+ix*n1+iz] = lam[iy*n2*n1+ixe*n1+iz];
+ }
+ }
+ }
+ /* muu field */
+ ixo = mod.ioTx;
+ ixe = mod.ioTx+bnd.ntap;
+ iyo = mod.ioTy;
+ iye = mod.ieTy;
+ izo = mod.ioTz;
+ ize = mod.ieTz;
+ for (iy=iyo; iy<iye; iy++) {
+ for (ix=ixo; ix<ixe; ix++) {
+ for (iz=izo; iz<ize; iz++) {
+ muu[iy*n2*n1+ix*n1+iz] = muu[iy*n2*n1+ixe*n1+iz];
+ }
+ }
+ }
+ }
+ if (mod.ischeme==2 || mod.ischeme==4) {
+ /* tss and tep field */
+ ixo = mod.ioPx;
+ ixe = mod.ioPx+bnd.ntap;
+ iyo = mod.ioPy;
+ iye = mod.iePy;
+ izo = mod.ioPz;
+ ize = mod.iePz;
+ for (iy=iyo; iy<iye; iy++) {
+ for (ix=ixo; ix<ixe; ix++) {
+ for (iz=izo; iz<ize; iz++) {
+ tss[iy*n2*n1+ix*n1+iz] = tss[iy*n2*n1+ixe*n1+iz];
+ tep[iy*n2*n1+ix*n1+iz] = tep[iy*n2*n1+ixe*n1+iz];
+ }
+ }
+ }
+ }
+ if (mod.ischeme==4) {
+ /* tes field */
+ ixo = mod.ioPx;
+ ixe = mod.ioPx+bnd.ntap;
+ iyo = mod.ioPy;
+ iye = mod.iePy;
+ izo = mod.ioPz;
+ ize = mod.iePz;
+ for (iy=iyo; iy<iye; iy++) {
+ for (ix=ixo; ix<ixe; ix++) {
+ for (iz=izo; iz<ize; iz++) {
+ tes[iy*n2*n1+ix*n1+iz] = tes[iy*n2*n1+ixe*n1+iz];
+ }
+ }
+ }
+ }
+
+ }
+
+ /* Right */
+ if (bnd.rig==4 || bnd.rig==2) {
+
+ /* rox field */
+ ixo = mod.ieXx;
+ ixe = mod.ieXx+bnd.ntap;
+ iyo = mod.ioXy;
+ iye = mod.ieXy;
+ izo = mod.ioXz;
+ ize = mod.ieXz;
+ for (iy=iyo; iy<iye; iy++) {
+ for (ix=ixo; ix<ixe; ix++) {
+ for (iz=izo; iz<ize; iz++) {
+ rox[iy*n2*n1+ix*n1+iz] = rox[iy*n2*n1+(ixo-1)*n1+iz];
+ }
+ }
+ }
+
+ /* roy field */
+ ixo = mod.ieYx;
+ ixe = mod.ieYx+bnd.ntap;
+ iyo = mod.ioYy;
+ iye = mod.ieYy;
+ izo = mod.ioYz;
+ ize = mod.ieYz;
+ for (iy=iyo; iy<iye; iy++) {
+ for (ix=ixo; ix<ixe; ix++) {
+ for (iz=izo; iz<ize; iz++) {
+ roy[iy*n2*n1+ix*n1+iz] = roy[iy*n2*n1+(ixo-1)*n1+iz];
+ }
+ }
+ }
+
+ /* roz field */
+ ixo = mod.ieZx;
+ ixe = mod.ieZx+bnd.ntap;
+ iyo = mod.ioZy;
+ iye = mod.ieZy;
+ izo = mod.ioZz;
+ ize = mod.ieZz;
+ for (iy=iyo; iy<iye; iy++) {
+ for (ix=ixo; ix<ixe; ix++) {
+ for (iz=izo; iz<ize; iz++) {
+ roz[iy*n2*n1+ix*n1+iz] = roz[iy*n2*n1+(ixo-1)*n1+iz];
+ }
+ }
+ }
+
+ /* l2m field */
+ ixo = mod.iePx-bnd.ntap;
+ ixe = mod.iePx;
+ iyo = mod.ioPy;
+ iye = mod.iePy;
+ izo = mod.ioPz;
+ ize = mod.iePz;
+ for (iy=iyo; iy<iye; iy++) {
+ for (ix=ixo; ix<ixe; ix++) {
+ for (iz=izo; iz<ize; iz++) {
+ l2m[iy*n2*n1+ix*n1+iz] = l2m[iy*n2*n1+(ixo-1)*n1+iz];
+ }
+ }
+ }
+
+ if (mod.ischeme>2) { /* Elastic Scheme */
+ /* lam field */
+ ixo = mod.iePx-bnd.ntap;
+ ixe = mod.iePx;
+ iyo = mod.ioPy;
+ iye = mod.iePy;
+ izo = mod.ioPz;
+ ize = mod.iePz;
+ for (iy=iyo; iy<iye; iy++) {
+ for (ix=ixo; ix<ixe; ix++) {
+ for (iz=izo; iz<ize; iz++) {
+ lam[iy*n2*n1+ix*n1+iz] = lam[iy*n2*n1+(ixo-1)*n1+iz];
+ }
+ }
+ }
+
+ /* muu field */
+ ixo = mod.ieTx-bnd.ntap;
+ ixe = mod.ieTx;
+ iyo = mod.ioTy;
+ iye = mod.ieTy;
+ izo = mod.ioTz;
+ ize = mod.ieTz;
+ for (iy=iyo; iy<iye; iy++) {
+ for (ix=ixo; ix<ixe; ix++) {
+ for (iz=izo; iz<ize; iz++) {
+ muu[iy*n2*n1+ix*n1+iz] = muu[iy*n2*n1+(ixo-1)*n1+iz];
+ }
+ }
+ }
+ }
+ if (mod.ischeme==2 || mod.ischeme==4) {
+ /* tss and tep field */
+ ixo = mod.iePx-bnd.ntap;
+ ixe = mod.iePx;
+ iyo = mod.ioPy;
+ iye = mod.iePy;
+ izo = mod.ioPz;
+ ize = mod.iePz;
+ for (iy=iyo; iy<iye; iy++) {
+ for (ix=ixo; ix<ixe; ix++) {
+ for (iz=izo; iz<ize; iz++) {
+ tss[iy*n2*n1+ix*n1+iz] = tss[iy*n2*n1+(ixo-1)*n1+iz];
+ tep[iy*n2*n1+ix*n1+iz] = tep[iy*n2*n1+(ixo-1)*n1+iz];
+ }
+ }
+ }
+ }
+ if (mod.ischeme==4) {
+ /* tes field */
+ ixo = mod.iePx-bnd.ntap;
+ ixe = mod.iePx;
+ iyo = mod.ioPy;
+ iye = mod.iePy;
+ izo = mod.ioPz;
+ ize = mod.iePz;
+ for (iy=iyo; iy<iye; iy++) {
+ for (ix=ixo; ix<ixe; ix++) {
+ for (iz=izo; iz<ize; iz++) {
+ tes[iy*n2*n1+ix*n1+iz] = tes[iy*n2*n1+(ixo-1)*n1+iz];
+ }
+ }
+ }
+ }
+
+ }
+
+ /* Front */
+ if (bnd.lef==4 || bnd.lef==2) {
+
+ /* rox field */
+ ixo = mod.ioXx;
+ ixe = mod.ioXx;
+ iyo = mod.ioXy-bnd.ntap;
+ iye = mod.ieXy;
+ izo = mod.ioXz;
+ ize = mod.ieXz;
+ for (iy=iyo; iy<iye; iy++) {
+ for (ix=ixo; ix<ixe; ix++) {
+ for (iz=izo; iz<ize; iz++) {
+ rox[iy*n2*n1+ix*n1+iz] = rox[iye*n2*n1+ix*n1+iz];
+ }
+ }
+ }
+
+ /* roy field */
+ ixo = mod.ioYx;
+ ixe = mod.ioYx;
+ iyo = mod.ioYy-bnd.ntap;
+ iye = mod.ieYy;
+ izo = mod.ioYz;
+ ize = mod.ieYz;
+ for (iy=iyo; iy<iye; iy++) {
+ for (ix=ixo; ix<ixe; ix++) {
+ for (iz=izo; iz<ize; iz++) {
+ roy[iy*n2*n1+ix*n1+iz] = rox[iye*n2*n1+ix*n1+iz];
+ }
+ }
+ }
+
+ /* roz field */
+ ixo = mod.ioZx;
+ ixe = mod.ioZx;
+ iyo = mod.ioZy-bnd.ntap;
+ iye = mod.ieZy;
+ izo = mod.ioZz;
+ ize = mod.ieZz;
+ for (iy=iyo; iy<iye; iy++) {
+ for (ix=ixo; ix<ixe; ix++) {
+ for (iz=izo; iz<ize; iz++) {
+ roz[iy*n2*n1+ix*n1+iz] = roz[iye*n2*n1+ix*n1+iz];
+ }
+ }
+ }
+
+ /* l2m field */
+ ixo = mod.ioPx;
+ ixe = mod.ioPx;
+ iyo = mod.ioPy;
+ iye = mod.iePy+bnd.ntap;
+ izo = mod.ioPz;
+ ize = mod.iePz;
+ for (iy=iyo; iy<iye; iy++) {
+ for (ix=ixo; ix<ixe; ix++) {
+ for (iz=izo; iz<ize; iz++) {
+ l2m[iy*n2*n1+ix*n1+iz] = l2m[iye*n2*n1+ix*n1+iz];
+ }
+ }
+ }
+
+ if (mod.ischeme>2) { /* Elastic Scheme */
+ /* lam field */
+ ixo = mod.ioPx;
+ ixe = mod.ioPx;
+ iyo = mod.ioPy;
+ iye = mod.iePy+bnd.ntap;
+ izo = mod.ioPz;
+ ize = mod.iePz;
+ for (iy=iyo; iy<iye; iy++) {
+ for (ix=ixo; ix<ixe; ix++) {
+ for (iz=izo; iz<ize; iz++) {
+ lam[iy*n2*n1+ix*n1+iz] = lam[iye*n2*n1+ix*n1+iz];
+ }
+ }
+ }
+ /* muu field */
+ ixo = mod.ioTx;
+ ixe = mod.ioTx;
+ iyo = mod.ioTy;
+ iye = mod.ieTy+bnd.ntap;
+ izo = mod.ioTz;
+ ize = mod.ieTz;
+ for (iy=iyo; iy<iye; iy++) {
+ for (ix=ixo; ix<ixe; ix++) {
+ for (iz=izo; iz<ize; iz++) {
+ muu[iy*n2*n1+ix*n1+iz] = muu[iye*n2*n1+ix*n1+iz];
+ }
+ }
+ }
+ }
+ if (mod.ischeme==2 || mod.ischeme==4) {
+ /* tss and tep field */
+ ixo = mod.ioPx;
+ ixe = mod.ioPx;
+ iyo = mod.ioPy;
+ iye = mod.iePy+bnd.ntap;
+ izo = mod.ioPz;
+ ize = mod.iePz;
+ for (iy=iyo; iy<iye; iy++) {
+ for (ix=ixo; ix<ixe; ix++) {
+ for (iz=izo; iz<ize; iz++) {
+ tss[iy*n2*n1+ix*n1+iz] = tss[iye*n2*n1+ix*n1+iz];
+ tep[iy*n2*n1+ix*n1+iz] = tep[iye*n2*n1+ix*n1+iz];
+ }
+ }
+ }
+ }
+ if (mod.ischeme==4) {
+ /* tes field */
+ ixo = mod.ioPx;
+ ixe = mod.ioPx;
+ iyo = mod.ioPy;
+ iye = mod.iePy+bnd.ntap;
+ izo = mod.ioPz;
+ ize = mod.iePz;
+ for (iy=iyo; iy<iye; iy++) {
+ for (ix=ixo; ix<ixe; ix++) {
+ for (iz=izo; iz<ize; iz++) {
+ tes[iy*n2*n1+ix*n1+iz] = tes[iye*n2*n1+ix*n1+iz];
+ }
+ }
+ }
+ }
+
+ }
+
+ /* Back */
+ if (bnd.rig==4 || bnd.rig==2) {
+
+ /* rox field */
+ ixo = mod.ieXx;
+ ixe = mod.ieXx;
+ iyo = mod.ioXy;
+ iye = mod.ieXy+bnd.ntap;
+ izo = mod.ioXz;
+ ize = mod.ieXz;
+ for (iy=iyo; iy<iye; iy++) {
+ for (ix=ixo; ix<ixe; ix++) {
+ for (iz=izo; iz<ize; iz++) {
+ rox[iy*n2*n1+ix*n1+iz] = rox[(iyo-1)*n2*n1+ix*n1+iz];
+ }
+ }
+ }
+
+ /* roy field */
+ ixo = mod.ieYx;
+ ixe = mod.ieYx;
+ iyo = mod.ioYy;
+ iye = mod.ieYy+bnd.ntap;
+ izo = mod.ioYz;
+ ize = mod.ieYz;
+ for (iy=iyo; iy<iye; iy++) {
+ for (ix=ixo; ix<ixe; ix++) {
+ for (iz=izo; iz<ize; iz++) {
+ roy[iy*n2*n1+ix*n1+iz] = roy[(iyo-1)*n2*n1+ix*n1+iz];
+ }
+ }
+ }
+
+ /* roz field */
+ ixo = mod.ieZx;
+ ixe = mod.ieZx;
+ iyo = mod.ioZy;
+ iye = mod.ieZy+bnd.ntap;
+ izo = mod.ioZz;
+ ize = mod.ieZz;
+ for (iy=iyo; iy<iye; iy++) {
+ for (ix=ixo; ix<ixe; ix++) {
+ for (iz=izo; iz<ize; iz++) {
+ roz[iy*n2*n1+ix*n1+iz] = roz[(iyo-1)*n2*n1+ix*n1+iz];
+ }
+ }
+ }
+
+ /* l2m field */
+ ixo = mod.iePx;
+ ixe = mod.iePx;
+ iyo = mod.ioPy-bnd.ntap;
+ iye = mod.iePy;
+ izo = mod.ioPz;
+ ize = mod.iePz;
+ for (iy=iyo; iy<iye; iy++) {
+ for (ix=ixo; ix<ixe; ix++) {
+ for (iz=izo; iz<ize; iz++) {
+ l2m[iy*n2*n1+ix*n1+iz] = l2m[(iyo-1)*n2*n1+ix*n1+iz];
+ }
+ }
+ }
+
+ if (mod.ischeme>2) { /* Elastic Scheme */
+ /* lam field */
+ ixo = mod.iePx;
+ ixe = mod.iePx;
+ iyo = mod.ioPy-bnd.ntap;
+ iye = mod.iePy;
+ izo = mod.ioPz;
+ ize = mod.iePz;
+ for (iy=iyo; iy<iye; iy++) {
+ for (ix=ixo; ix<ixe; ix++) {
+ for (iz=izo; iz<ize; iz++) {
+ lam[iy*n2*n1+ix*n1+iz] = lam[(iyo-1)*n2*n1+ix*n1+iz];
+ }
+ }
+ }
+
+ /* muu field */
+ ixo = mod.ieTx;
+ ixe = mod.ieTx;
+ iyo = mod.ioTy-bnd.ntap;
+ iye = mod.ieTy;
+ izo = mod.ioTz;
+ ize = mod.ieTz;
+ for (iy=iyo; iy<iye; iy++) {
+ for (ix=ixo; ix<ixe; ix++) {
+ for (iz=izo; iz<ize; iz++) {
+ muu[iy*n2*n1+ix*n1+iz] = muu[(iyo-1)*n2*n1+ix*n1+iz];
+ }
+ }
+ }
+ }
+ if (mod.ischeme==2 || mod.ischeme==4) {
+ /* tss and tep field */
+ ixo = mod.iePx;
+ ixe = mod.iePx;
+ iyo = mod.ioPy-bnd.ntap;
+ iye = mod.iePy;
+ izo = mod.ioPz;
+ ize = mod.iePz;
+ for (iy=iyo; iy<iye; iy++) {
+ for (ix=ixo; ix<ixe; ix++) {
+ for (iz=izo; iz<ize; iz++) {
+ tss[iy*n2*n1+ix*n1+iz] = tss[(iyo-1)*n2*n1+ix*n1+iz];
+ tep[iy*n2*n1+ix*n1+iz] = tep[(iyo-1)*n2*n1+ix*n1+iz];
+ }
+ }
+ }
+ }
+ if (mod.ischeme==4) {
+ /* tes field */
+ ixo = mod.iePx;
+ ixe = mod.iePx;
+ iyo = mod.ioPy-bnd.ntap;
+ iye = mod.iePy;
+ izo = mod.ioPz;
+ ize = mod.iePz;
+ for (iy=iyo; iy<iye; iy++) {
+ for (ix=ixo; ix<ixe; ix++) {
+ for (iz=izo; iz<ize; iz++) {
+ tes[iy*n2*n1+ix*n1+iz] = tes[(iyo-1)*n2*n1+ix*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;
+ iyo = mod.ioXy;
+ iye = mod.ieXy;
+ if (bnd.fro==4 || bnd.fro==2) iyo -= bnd.ntap;
+ if (bnd.bac==4 || bnd.bac==2) iye += bnd.ntap;
+ izo = mod.ioXz-bnd.ntap;
+ ize = mod.ioXz;
+ for (iy=iyo; iy<iye; iy++) {
+ for (ix=ixo; ix<ixe; ix++) {
+ for (iz=izo; iz<ize; iz++) {
+ rox[iy*n2*n1+ix*n1+iz] = rox[iy*n2*n1+ix*n1+ize];
+ }
+ }
+ }
+
+ /* roy field */
+ ixo = mod.ioYx;
+ ixe = mod.ieYx;
+ if (bnd.lef==4 || bnd.lef==2) ixo -= bnd.ntap;
+ if (bnd.rig==4 || bnd.rig==2) ixe += bnd.ntap;
+ iyo = mod.ioYy;
+ iye = mod.ieYy;
+ if (bnd.fro==4 || bnd.fro==2) iyo -= bnd.ntap;
+ if (bnd.bac==4 || bnd.bac==2) iye += bnd.ntap;
+ izo = mod.ioYz-bnd.ntap;
+ ize = mod.ioYz;
+ for (iy=iyo; iy<iye; iy++) {
+ for (ix=ixo; ix<ixe; ix++) {
+ for (iz=izo; iz<ize; iz++) {
+ roy[iy*n2*n1+ix*n1+iz] = roy[iy*n2*n1+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;
+ iyo = mod.ioZy;
+ iye = mod.ieZy;
+ if (bnd.fro==4 || bnd.fro==2) iyo -= bnd.ntap;
+ if (bnd.bac==4 || bnd.bac==2) iye += bnd.ntap;
+ izo = mod.ioZz-bnd.ntap;
+ ize = mod.ioZz;
+ for (iy=iyo; iy<iye; iy++) {
+ for (ix=ixo; ix<ixe; ix++) {
+ for (iz=izo; iz<ize; iz++) {
+ roz[iy*n2*n1+ix*n1+iz] = roz[iy*n2*n1+ix*n1+ize];
+ }
+ }
+ }
+
+ /* l2m field */
+ ixo = mod.ioPx;
+ ixe = mod.iePx;
+ iyo = mod.ioPy;
+ iye = mod.iePy;
+ izo = mod.ioPz;
+ ize = mod.ioPz+bnd.ntap;
+ for (iy=iyo; iy<iye; iy++) {
+ for (ix=ixo; ix<ixe; ix++) {
+ for (iz=izo; iz<ize; iz++) {
+ l2m[iy*n2*n1+ix*n1+iz] = l2m[iy*n2*n1+ix*n1+ize];
+ }
+ }
+ }
+
+ if (mod.ischeme>2) { /* Elastic Scheme */
+ /* lam field */
+ ixo = mod.ioPx;
+ ixe = mod.iePx;
+ iyo = mod.ioPy;
+ iye = mod.iePy;
+ izo = mod.ioPz;
+ ize = mod.ioPz+bnd.ntap;
+ for (iy=iyo; iy<iye; iy++) {
+ for (ix=ixo; ix<ixe; ix++) {
+ for (iz=izo; iz<ize; iz++) {
+ lam[iy*n2*n1+ix*n1+iz] = lam[iy*n2*n1+ix*n1+ize];
+ }
+ }
+ }
+
+ /* muu field */
+ ixo = mod.ioTx;
+ ixe = mod.ieTx;
+ iyo = mod.ioTy;
+ iye = mod.ieTy;
+ izo = mod.ioTz;
+ ize = mod.ioTz+bnd.ntap;
+ for (iy=iyo; iy<iye; iy++) {
+ for (ix=ixo; ix<ixe; ix++) {
+ for (iz=izo; iz<ize; iz++) {
+ muu[iy*n2*n1+ix*n1+iz] = muu[iy*n2*n1+ix*n1+ize];
+ }
+ }
+ }
+ }
+ if (mod.ischeme==2 || mod.ischeme==4) {
+ /* tss and tep field */
+ ixo = mod.ioPx;
+ ixe = mod.iePx;
+ iyo = mod.ioPy;
+ iye = mod.iePy;
+ izo = mod.ioPz;
+ ize = mod.ioPz+bnd.ntap;
+ for (iy=iyo; iy<iye; iy++) {
+ for (ix=ixo; ix<ixe; ix++) {
+ for (iz=izo; iz<ize; iz++) {
+ tss[iy*n2*n1+ix*n1+iz] = tss[iy*n2*n1+ix*n1+ize];
+ tep[iy*n2*n1+ix*n1+iz] = tep[iy*n2*n1+ix*n1+ize];
+ }
+ }
+ }
+ }
+ if (mod.ischeme==4) {
+ /* tes field */
+ ixo = mod.ioPx;
+ ixe = mod.iePx;
+ iyo = mod.ioPy;
+ iye = mod.iePy;
+ izo = mod.ioPz;
+ ize = mod.ioPz+bnd.ntap;
+ for (iy=iyo; iy<iye; iy++) {
+ for (ix=ixo; ix<ixe; ix++) {
+ for (iz=izo; iz<ize; iz++) {
+ tes[iy*n2*n1+ix*n1+iz] = tes[iy*n2*n1+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;
+ iyo = mod.ioXy;
+ iye = mod.ieXy;
+ if (bnd.fro==4 || bnd.fro==2) iyo -= bnd.ntap;
+ if (bnd.bac==4 || bnd.bac==2) iye += bnd.ntap;
+ izo = mod.ieXz;
+ ize = mod.ieXz+bnd.ntap;
+ for (iy=iyo; iy<iye; iy++) {
+ for (ix=ixo; ix<ixe; ix++) {
+ for (iz=izo; iz<ize; iz++) {
+ rox[iy*n2*n1+ix*n1+iz] = rox[iy*n2*n1+ix*n1+izo-1];
+ }
+ }
+ }
+
+ /* roy field */
+ ixo = mod.ioYx;
+ ixe = mod.ieYx;
+ if (bnd.lef==4 || bnd.lef==2) ixo -= bnd.ntap;
+ if (bnd.rig==4 || bnd.rig==2) ixe += bnd.ntap;
+ iyo = mod.ioYy;
+ iye = mod.ieYy;
+ if (bnd.fro==4 || bnd.fro==2) iyo -= bnd.ntap;
+ if (bnd.bac==4 || bnd.bac==2) iye += bnd.ntap;
+ izo = mod.ieYz;
+ ize = mod.ieYz+bnd.ntap;
+ for (iy=iyo; iy<iye; iy++) {
+ for (ix=ixo; ix<ixe; ix++) {
+ for (iz=izo; iz<ize; iz++) {
+ roy[iy*n2*n1+ix*n1+iz] = roy[iy*n2*n1+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;
+ iyo = mod.ioXy;
+ iye = mod.ieXy;
+ if (bnd.fro==4 || bnd.fro==2) iyo -= bnd.ntap;
+ if (bnd.bac==4 || bnd.bac==2) iye += bnd.ntap;
+ izo = mod.ieZz;
+ ize = mod.ieZz+bnd.ntap;
+ for (iy=iyo; iy<iye; iy++) {
+ for (ix=ixo; ix<ixe; ix++) {
+ for (iz=izo; iz<ize; iz++) {
+ roz[iy*n2*n1+ix*n1+iz] = roz[iy*n2*n1+ix*n1+izo-1];
+ }
+ }
+ }
+ /* l2m field */
+ ixo = mod.ioPx;
+ ixe = mod.iePx;
+ iyo = mod.ioPy;
+ iye = mod.iePy;
+ izo = mod.iePz-bnd.ntap;
+ ize = mod.iePz;
+ for (iy=iyo; iy<iye; iy++) {
+ for (ix=ixo; ix<ixe; ix++) {
+ for (iz=izo; iz<ize; iz++) {
+ l2m[iy*n2*n1+ix*n1+iz] = l2m[iy*n2*n1+ix*n1+izo-1];
+ }
+ }
+ }
+
+ if (mod.ischeme>2) { /* Elastic Scheme */
+ /* lam field */
+ ixo = mod.ioPx;
+ ixe = mod.iePx;
+ iyo = mod.ioPy;
+ iye = mod.iePy;
+ izo = mod.iePz-bnd.ntap;
+ ize = mod.iePz;
+ for (iy=iyo; iy<iye; iy++) {
+ for (ix=ixo; ix<ixe; ix++) {
+ for (iz=izo; iz<ize; iz++) {
+ lam[iy*n2*n1+ix*n1+iz] = lam[iy*n2*n1+ix*n1+izo-1];
+ }
+ }
+ }
+
+ /* muu */
+ ixo = mod.ioTx;
+ ixe = mod.ieTx;
+ iyo = mod.ioTy;
+ iye = mod.ieTy;
+ izo = mod.ieTz-bnd.ntap;
+ ize = mod.ieTz;
+ for (iy=iyo; iy<iye; iy++) {
+ for (ix=ixo; ix<ixe; ix++) {
+ for (iz=izo; iz<ize; iz++) {
+ muu[iy*n2*n1+ix*n1+iz] = muu[iy*n2*n1+ix*n1+izo-1];
+ }
+ }
+ }
+ }
+ if (mod.ischeme==2 || mod.ischeme==4) {
+ /* tss and tep field */
+ ixo = mod.ioPx;
+ ixe = mod.iePx;
+ iyo = mod.ioPy;
+ iye = mod.iePy;
+ izo = mod.iePz-bnd.ntap;
+ ize = mod.iePz;
+ for (iy=iyo; iy<iye; iy++) {
+ for (ix=ixo; ix<ixe; ix++) {
+ for (iz=izo; iz<ize; iz++) {
+ tss[iy*n2*n1+ix*n1+iz] = tss[iy*n2*n1+ix*n1+izo-1];
+ tep[iy*n2*n1+ix*n1+iz] = tep[iy*n2*n1+ix*n1+izo-1];
+ }
+ }
+ }
+ }
+ if (mod.ischeme==4) {
+ /* tes field */
+ ixo = mod.ioPx;
+ ixe = mod.iePx;
+ iyo = mod.ioPy;
+ iye = mod.iePy;
+ izo = mod.iePz-bnd.ntap;
+ ize = mod.iePz;
+ for (iy=iyo; iy<iye; iy++) {
+ for (ix=ixo; ix<ixe; ix++) {
+ for (iz=izo; iz<ize; iz++) {
+ tes[iy*n2*n1+ix*n1+iz] = tes[iy*n2*n1+ix*n1+izo-1];
+ }
+ }
+ }
+ }
+
+ }
+
+ free(cp);
+ free(ro);
+ free(cs);
+
+ return 0;
+}
+
+
diff --git a/fdelmodc3D/recvPar.c b/fdelmodc3D/recvPar.c
new file mode 100644
index 0000000000000000000000000000000000000000..7509bf68d57b31e920459b5c3f4f4d90de079c61
--- /dev/null
+++ b/fdelmodc3D/recvPar.c
@@ -0,0 +1,519 @@
+#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
new file mode 100644
index 0000000000000000000000000000000000000000..7f4e91a665a5923438e7aa4a0ce80f87dd81583a
--- /dev/null
+++ b/fdelmodc3D/recvPar3D.c
@@ -0,0 +1,626 @@
+#include <stdio.h>
+#include <assert.h>
+#include <math.h>
+
+#include "fdelmodc3D.h"
+#include "par.h"
+
+#define MIN(x,y) ((x) < (y) ? (x) : (y))
+#define MAX(x,y) ((x) > (y) ? (x) : (y))
+#define NINT(x) ((long)((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)
+* Joeri Brackenhoff adding the 3D extension
+* The Netherlands
+**/
+
+
+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)
+{
+ float *xrcv1, *xrcv2, *yrcv1, *yrcv2, *zrcv1, *zrcv2;
+ long i, ix, ir, verbose;
+ float dxrcv, dyrcv, dzrcv, *dxr, *dyr, *dzr;
+ float rrcv, dphi, oxrcv, oyrcv, ozrcv, arcv;
+ double circ, h, a, b, e, s, xr, yr, zr, dr, srun, phase;
+ float xrange, yrange, zrange, sub_x1, sub_y1, sub_z1;
+ long Nx1, Nx2, Ny1, Ny2, Nz1, Nz2, Ndx, Ndy, Ndz, iarray, nrec, nh;
+ long nxrcv, nyrcv, nzrcv, ncrcv, nrcv, ntrcv, *nlrcv;
+ float *xrcva, *yrcva, *zrcva;
+ char* rcv_txt;
+ FILE *fp;
+
+ if (!getparlong("verbose", &verbose)) verbose = 0;
+
+ /* Calculate Model Dimensions */
+ sub_x1=sub_x0+(nx-1)*dx;
+ sub_y1=sub_y0+(ny-1)*dy;
+ 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: %li",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: %li",ntrcv);
+ rewind(fp);
+ }
+
+ /* Receiver Array */
+ nxrcv=countparval("xrcva");
+ nyrcv=countparval("yrcva");
+ nzrcv=countparval("zrcva");
+ if (nxrcv!=nzrcv) verr("Number of receivers in array xrcva (%li), yrcva (%li), zrcva(%li) are not equal",nxrcv,nyrcv,nzrcv);
+ if (verbose&&nxrcv) vmess("Total number of array receivers: %li",nxrcv);
+
+ /* Linear Receiver Arrays */
+ Nx1 = countparval("xrcv1");
+ Nx2 = countparval("xrcv2");
+ Ny1 = countparval("yrcv1");
+ Ny2 = countparval("yrcv2");
+ Nz1 = countparval("zrcv1");
+ Nz2 = countparval("zrcv2");
+ if (Nx1!=Nx2) verr("Number of receivers starting points in 'xrcv1' (%li) and number of endpoint in 'xrcv2' (%li) are not equal",Nx1,Nx2);
+ if (Ny1!=Ny2) verr("Number of receivers starting points in 'yrcv1' (%li) and number of endpoint in 'yrcv2' (%li) are not equal",Ny1,Ny2);
+ if (Nz1!=Nz2) verr("Number of receivers starting points in 'zrcv1' (%li) and number of endpoint in 'zrcv2' (%li) are not equal",Nz1,Nz2);
+ if (Nx1!=Ny2) verr("Number of receivers starting points in 'xrcv1' (%li) and number of endpoint in 'yrcv2' (%li) are not equal",Nx1,Ny2);
+ if (Nx1!=Nz2) verr("Number of receivers starting points in 'xrcv1' (%li) and number of endpoint in 'zrcv2' (%li) 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));
+ yrcv1=(float *)malloc(Nx1*sizeof(float));
+ yrcv2=(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("yrcv1",yrcv1)) yrcv1[0]=sub_y0;
+ if (!getparfloat("yrcv2",yrcv2)) yrcv2[0]=sub_y1;
+ 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]);
+
+ yrcv1[iarray] = MAX(sub_y0, yrcv1[iarray]);
+ yrcv1[iarray] = MIN(sub_y0+ny*dy,yrcv1[iarray]);
+ yrcv2[iarray] = MAX(sub_y0, yrcv2[iarray]);
+ yrcv2[iarray] = MIN(sub_y0+ny*dy,yrcv2[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 %li outside model bounds",iarray);
+ }
+ else {
+ vwarn("Cropping element %li 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 %li outside model bounds",iarray);
+ }
+ if ( (xrcv2[iarray] < xrcv1[iarray]) ) {
+ verr("Ill defined linear array %li, 'xrcv1' (%f) greater than 'xrcv2' (%f)",iarray,xrcv1[iarray],xrcv2[iarray]);
+ }
+ else if (xrcv2[iarray]>sub_x1) {
+ vwarn("Cropping element %li of 'xrcv2' (%f) to model bounds (%f)",iarray,xrcv2[iarray],sub_x1);
+ xrcv2[iarray]=sub_x1;
+ }
+
+ if (yrcv1[iarray]<sub_y0) {
+ if (yrcv2[iarray]<sub_y0) {
+ verr("Linear array %li outside model bounds",iarray);
+ }
+ else {
+ vwarn("Cropping element %li of 'yrcv1' (%f) to model bounds (%f)",iarray,yrcv1[iarray],sub_y0);
+ yrcv1[iarray]=sub_y0;
+ }
+ }
+ else if (yrcv1[iarray] > sub_y1) {
+ verr("Linear array %li outside model bounds",iarray);
+ }
+ if ( (yrcv2[iarray] < yrcv1[iarray]) ) {
+ verr("Ill defined linear array %li, 'yrcv1' (%f) greater than 'yrcv2' (%f)",iarray,yrcv1[iarray],yrcv2[iarray]);
+ }
+ else if (yrcv2[iarray]>sub_y1) {
+ vwarn("Cropping element %li of 'yrcv2' (%f) to model bounds (%f)",iarray,yrcv2[iarray],sub_y1);
+ yrcv2[iarray]=sub_y1;
+ }
+
+ if (zrcv1[iarray] < sub_z0) {
+ if (zrcv2[iarray] < sub_z0) {
+ verr("Linear array %li outside model bounds",iarray);
+ }
+ else {
+ vwarn("Cropping element %li 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 %li outside model bounds",iarray);
+ }
+ if ( (zrcv2[iarray] < zrcv1[iarray]) ) {
+ verr("Ill defined linear array %li, 'zrcv1' (%f) greater than 'zrcv2' (%f)",iarray,zrcv1[iarray],zrcv2[iarray]);
+ }
+ else if (zrcv2[iarray]>sub_z1) {
+ vwarn("Cropping element %li of 'xrcv2' (%f) to model bounds (%f)",iarray,zrcv2[iarray],sub_z1);
+ zrcv2[iarray]=sub_z1;
+ }
+ }
+
+ /* Get Sampling Rates */
+ Ndx = countparval("dxrcv");
+ Ndy = countparval("dyrcv");
+ Ndz = countparval("dzrcv");
+
+ dxr = (float *)malloc(Nx1*sizeof(float));
+ dyr = (float *)malloc(Nx1*sizeof(float));
+ dzr = (float *)malloc(Nx1*sizeof(float));
+ if(!getparfloat("dxrcv", dxr)) dxr[0]=dx;
+ if(!getparfloat("dyrcv", dyr)) dyr[0]=dy;
+ if(!getparfloat("dzrcv", dzr)) dzr[0]=0.0;
+ if ( (Ndx<=1) && (Ndy<=1) && (Ndz==0) ){ /* default values are set */
+ for (i=1; i<Nx1; i++) {
+ dxr[i] = dxr[0];
+ dyr[i] = dyr[0];
+ dzr[i] = dzr[0];
+ }
+ Ndx=1;
+ Ndy=1;
+ Ndz=1;
+ }
+ else if ( (Ndz==1) && (Ndx==0) && (Ndy==0) ){ /* default values are set */
+ for (i=1; i<Nx1; i++) {
+ dxr[i] = dxr[0];
+ dyr[i] = dyr[0];
+ dzr[i] = dzr[0];
+ }
+ Ndz=1;
+ Ndy=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' (%li) is not equal to number of 'dzrcv' (%li) or 1",Ndx,Ndz);
+ }
+ if (Ndx!=Ndy) {
+ verr("Number of 'dxrcv' (%li) is not equal to number of 'dyrcv' (%li) or 1",Ndx,Ndy);
+ }
+ if (Ndx!=Nx1 && Ndx!=1) {
+ verr("Number of 'dxrcv' (%li) is not equal to number of starting points in 'xrcv1' (%li) or 1",Ndx,Nx1);
+ }
+ if (Ndy!=Ny1 && Ndy!=1) {
+ verr("Number of 'dyrcv' (%li) is not equal to number of starting points in 'yrcv1' (%li) or 1",Ndy,Ny1);
+ }
+ }
+
+ /* check consistency of receiver steps */
+ for (iarray=0; iarray<Ndx; iarray++) {
+ if (dxr[iarray]<0) {
+ dxr[i]=dx;
+ vwarn("'dxrcv' element %li (%f) is less than zero, changing it to %f'",iarray,dxr[iarray],dx);
+ }
+ }
+ for (iarray=0; iarray<Ndy; iarray++) {
+ if (dyr[iarray]<0) {
+ dyr[i]=dx;
+ vwarn("'dyrcv' element %li (%f) is less than zero, changing it to %f'",iarray,dyr[iarray],dy);
+ }
+ }
+ for (iarray=0;iarray<Ndz;iarray++) {
+ if (dzr[iarray]<0) {
+ dzr[iarray]=dz;
+ vwarn("'dzrcv' element %li (%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 %li & 'dzrcv' element 1 are both 0.",iarray+1);
+ vmess("Placing 1 receiver at (%li,%li)",xrcv1[iarray],zrcv1[iarray]);
+ }
+ }
+ for (iarray=0;iarray<Ndx;iarray++){
+ if (xrcv1[iarray]==xrcv2[iarray] && dxr[iarray]!=0) {
+ dxr[iarray]=0.;
+ vwarn("Linear array %li: 'xrcv1'='xrcv2' and 'dxrcv' is not 0. Setting 'dxrcv'=0",iarray+1);
+ }
+ }
+ for (iarray=0;iarray<Ndx;iarray++){
+ if (yrcv1[iarray]==yrcv2[iarray] && dyr[iarray]!=0) {
+ dyr[iarray]=0.;
+ vwarn("Linear array %li: 'yrcv1'='yrcv2' and 'dyrcv' is not 0. Setting 'dyrcv'=0",iarray+1);
+ }
+ }
+ for (iarray=0;iarray<Ndx;iarray++){
+ if (zrcv1[iarray]==zrcv2[iarray] && dzr[iarray]!=0.){
+ dzr[iarray]=0.;
+ vwarn("Linear array %li: 'zrcv1'='zrcv2' and 'dzrcv' is not 0. Setting 'dzrcv'=0",iarray+1);
+ }
+ }
+
+ /* Calculate Number of Receivers */
+ nrcv = 0;
+ nlrcv=(long *)malloc(Nx1*sizeof(long));
+ for (iarray=0; iarray<Nx1; iarray++) {
+ xrange = (xrcv2[iarray]-xrcv1[iarray]);
+ yrange = (yrcv2[iarray]-yrcv1[iarray]);
+ zrange = (zrcv2[iarray]-zrcv1[iarray]);
+ if (dxr[iarray] != 0.0) {
+ nlrcv[iarray] = NINT(fabs(xrange/dxr[iarray]))+1;
+ }
+ else if (dyr[iarray] != 0.0) {
+ nlrcv[iarray] = NINT(fabs(yrange/dyr[iarray]))+1;
+ }
+ else {
+ if (dzr[iarray] == 0) {
+ verr("For receiver array %li: receiver distance dzrcv is not given", iarray);
+ }
+ nlrcv[iarray] = NINT(fabs(zrange/dzr[iarray]))+1;
+ }
+ nrcv+=nlrcv[iarray];
+ }
+
+ /* Calculate Number of Receivers */
+ if (verbose) vmess("Total number of linear array receivers: %li",nrcv);
+ if (!nrcv) {
+ free(xrcv1);
+ free(xrcv2);
+ free(yrcv1);
+ free(yrcv2);
+ free(zrcv1);
+ free(zrcv2);
+ free(dxr);
+ free(dyr);
+ 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: %li",rec->max_nrec);
+
+ /* Allocate Arrays */
+ rec->x = (long *)calloc(rec->max_nrec,sizeof(long));
+ rec->y = (long *)calloc(rec->max_nrec,sizeof(long));
+ rec->z = (long *)calloc(rec->max_nrec,sizeof(long));
+ rec->xr = (float *)calloc(rec->max_nrec,sizeof(float));
+ rec->yr = (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("oyrcv",&oyrcv)) oyrcv=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->yr[ix] = oyrcv-sub_y0+arcv*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->y[ix] = NINT(rec->yr[ix]/dy);
+ rec->z[ix] = NINT(rec->zr[ix]/dz);
+ if (verbose>4) fprintf(stderr,"Receiver Circle: xrcv[%li]=%f yrcv=%f zrcv=%f\n", ix, rec->xr[ix]+sub_x0, rec->yr[ix]+sub_y0, 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;
+ 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;
+ /* 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);
+ yr = rrcv*cos(ir*h+phase);
+ zr = arcv*sin(ir*h+phase);
+ rec->xr[ix] = oxrcv-sub_x0+xr;
+ rec->yr[ix] = oyrcv-sub_y0+yr;
+ rec->zr[ix] = ozrcv-sub_z0+zr;
+ rec->x[ix] = NINT(rec->xr[ix]/dx);
+ rec->y[ix] = NINT(rec->yr[ix]/dy);
+ rec->z[ix] = NINT(rec->zr[ix]/dz);
+ if (verbose>4) fprintf(stderr,"Receiver Ellipse: xrcv[%li]=%f yrcv=%f zrcv=%f\n", ix, rec->xr[ix]+sub_x0, rec->yr[ix]+sub_y0, 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->y[ix] = MIN(ny-1, MAX(rec->y[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));
+ yrcva = (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 %e\n",&xrcva[i],&yrcva[i],&zrcva[i])!=3) vmess("Receiver Text File: Can not parse coordinates on line %li.",i);
+ }
+ /* Close file */
+ fclose(fp);
+ /* Process coordinates */
+ for (ix=0; ix<ntrcv; ix++) {
+ rec->xr[nrec+ix] = xrcva[ix]-sub_x0;
+ rec->yr[nrec+ix] = yrcva[ix]-sub_y0;
+ rec->zr[nrec+ix] = zrcva[ix]-sub_z0;
+ rec->x[nrec+ix] = NINT((xrcva[ix]-sub_x0)/dx);
+ rec->y[nrec+ix] = NINT((yrcva[ix]-sub_y0)/dy);
+ rec->z[nrec+ix] = NINT((zrcva[ix]-sub_z0)/dz);
+ if (verbose>4) vmess("Receiver Text Array: xrcv[%li]=%f yrcv=%f zrcv=%f", ix, rec->xr[nrec+ix]+sub_x0, rec->yr[nrec+ix]+sub_y0, rec->zr[nrec+ix]+sub_z0);
+ }
+ free(xrcva);
+ free(yrcva);
+ free(zrcva);
+ nrec += ntrcv;
+ }
+
+ /* Receiver Array */
+ if (nxrcv != 0) {
+ /* receiver array is defined */
+ xrcva = (float *)malloc(nxrcv*sizeof(float));
+ yrcva = (float *)malloc(nxrcv*sizeof(float));
+ zrcva = (float *)malloc(nxrcv*sizeof(float));
+ getparfloat("xrcva", xrcva);
+ getparfloat("yrcva", yrcva);
+ getparfloat("zrcva", zrcva);
+ for (ix=0; ix<nxrcv; ix++) {
+ rec->xr[nrec+ix] = xrcva[ix]-sub_x0;
+ rec->yr[nrec+ix] = yrcva[ix]-sub_y0;
+ rec->zr[nrec+ix] = zrcva[ix]-sub_z0;
+ rec->x[nrec+ix] = NINT((xrcva[ix]-sub_x0)/dx);
+ rec->y[nrec+ix] = NINT((yrcva[ix]-sub_y0)/dy);
+ rec->z[nrec+ix] = NINT((zrcva[ix]-sub_z0)/dz);
+ if (verbose>4) fprintf(stderr,"Receiver Array: xrcv[%li]=%f yrcv=%f zrcv=%f\n", ix, rec->xr[nrec+ix]+sub_x0, rec->yr[nrec+ix]+sub_y0, rec->zr[nrec+ix]+sub_z0);
+ }
+ free(xrcva);
+ free(yrcva);
+ free(zrcva);
+ nrec += nxrcv;
+ }
+
+ /* Linear Receiver Arrays */
+ if (nrcv!=0) {
+ xrcv1 = (float *)malloc(Nx1*sizeof(float));
+ xrcv2 = (float *)malloc(Nx1*sizeof(float));
+ yrcv1 = (float *)malloc(Nx1*sizeof(float));
+ yrcv2 = (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("yrcv1", yrcv1)) yrcv1[0]=sub_y0;
+ if(!getparfloat("yrcv2", yrcv2)) yrcv2[0]=(ny-1)*dy+sub_y0;
+ if(!getparfloat("zrcv1", zrcv1)) zrcv1[0]=sub_z0;
+ if(!getparfloat("zrcv2", zrcv2)) zrcv2[0]=zrcv1[0];
+
+ Ndx = countparval("dxrcv");
+ Ndy = countparval("dyrcv");
+ Ndz = countparval("dzrcv");
+
+ dxr = (float *)malloc(Nx1*sizeof(float));
+ dyr = (float *)malloc(Nx1*sizeof(float));
+ dzr = (float *)malloc(Nx1*sizeof(float));
+ if(!getparfloat("dxrcv", dxr)) dxr[0]=dx;
+ if(!getparfloat("dyrcv", dyr)) dyr[0]=dy;
+ if(!getparfloat("dzrcv", dzr)) dzr[0]=0.0;
+ if ( (Ndx<=1) && (Ndy<=1) && (Ndz==0) ){ /* default values are set */
+ for (i=1; i<Nx1; i++) {
+ dxr[i] = dxr[0];
+ dyr[i] = dyr[0];
+ dzr[i] = dzr[0];
+ }
+ Ndx=1;
+ Ndy=1;
+ }
+ else if ( (Ndx<=1) && (Ndy==0) && (Ndz==0) ){ /* default values are set */
+ for (i=1; i<Nx1; i++) {
+ dxr[i] = dxr[0];
+ dyr[i] = dyr[0];
+ dzr[i] = dzr[0];
+ }
+ Ndx=1;
+ }
+ else if ( (Ndy<=1) && (Ndx==0) && (Ndz==0) ){ /* default values are set */
+ for (i=1; i<Nx1; i++) {
+ dxr[i] = dxr[0];
+ dyr[i] = dyr[0];
+ dzr[i] = dzr[0];
+ }
+ Ndy=1;
+ }
+ else if ( (Ndz==1) && (Ndy==0) && (Ndx==0) ){ /* default values are set */
+ for (i=1; i<Nx1; i++) {
+ dxr[i] = dxr[0];
+ dyr[i] = dyr[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 (Ndy>1) assert(Ndy==Ny1);
+ if (Ndz>1) assert(Ndz==Nx1);
+ }
+
+ /* 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]);
+
+ yrcv1[iarray] = MAX(sub_y0, yrcv1[iarray]);
+ yrcv1[iarray] = MIN(sub_y0+ny*dy,yrcv1[iarray]);
+ yrcv2[iarray] = MAX(sub_y0, yrcv2[iarray]);
+ yrcv2[iarray] = MIN(sub_y0+ny*dy,yrcv2[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,y,z */
+
+ for (iarray=0; iarray<Nx1; iarray++) {
+ xrange = (xrcv2[iarray]-xrcv1[iarray]);
+ yrange = (yrcv2[iarray]-yrcv1[iarray]);
+ zrange = (zrcv2[iarray]-zrcv1[iarray]);
+ if (dxr[iarray] != 0.0) {
+ nrcv = nlrcv[iarray];
+ dxrcv = dxr[iarray];
+ dyrcv = yrange/(nrcv-1);
+ dzrcv = zrange/(nrcv-1);
+ if (dyrcv != dyr[iarray]) {
+ vwarn("For receiver array %li: calculated dyrcv=%f given=%f", iarray, dyrcv, dyr[iarray]);
+ vwarn("The calculated receiver distance %f is used", dyrcv);
+ }
+ if (dzrcv != dzr[iarray]) {
+ vwarn("For receiver array %li: calculated dzrcv=%f given=%f", iarray, dzrcv, dzr[iarray]);
+ vwarn("The calculated receiver distance %f is used", dzrcv);
+ }
+ }
+ else if (dyr[iarray] != 0.0) {
+ nrcv = nlrcv[iarray];
+ dxrcv = xrange/(nrcv-1);
+ dyrcv = dyr[iarray];
+ dzrcv = zrange/(nrcv-1);
+ if (dxrcv != dxr[iarray]) {
+ vwarn("For receiver array %li: calculated dxrcv=%f given=%f", iarray, dxrcv, dxr[iarray]);
+ vwarn("The calculated receiver distance %f is used", dxrcv);
+ }
+ if (dzrcv != dzr[iarray]) {
+ vwarn("For receiver array %li: 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 %li: receiver distance dzrcv is not given", iarray);
+ }
+ nrcv = nlrcv[iarray];
+ dxrcv = xrange/(nrcv-1);
+ dyrcv = yrange/(nrcv-1);
+ dzrcv = dzr[iarray];
+ if (dxrcv != dxr[iarray]) {
+ vwarn("For receiver array %li: calculated dxrcv=%f given=%f", iarray, dxrcv, dxr[iarray]);
+ vwarn("The calculated receiver distance %f is used", dxrcv);
+ }
+ if (dyrcv != dyr[iarray]) {
+ vwarn("For receiver array %li: calculated dyrcv=%f given=%f", iarray, dyrcv, dyr[iarray]);
+ vwarn("The calculated receiver distance %f is used", dyrcv);
+ }
+ }
+
+ // calculate coordinates
+ for (ir=0; ir<nrcv; ir++) {
+ rec->xr[nrec]=xrcv1[iarray]-sub_x0+ir*dxrcv;
+ rec->yr[nrec]=yrcv1[iarray]-sub_y0+ir*dyrcv;
+ rec->zr[nrec]=zrcv1[iarray]-sub_z0+ir*dzrcv;
+
+ rec->x[nrec]=NINT((rec->xr[nrec])/dx);
+ rec->y[nrec]=NINT((rec->yr[nrec])/dy);
+ rec->z[nrec]=NINT((rec->zr[nrec])/dz);
+ nrec++;
+ }
+ }
+ free(xrcv1);
+ free(xrcv2);
+ free(yrcv1);
+ free(yrcv2);
+ free(zrcv1);
+ free(zrcv2);
+ free(dxr);
+ free(dyr);
+ free(dzr);
+ free(nlrcv);
+ }
+
+ rec->n=rec->max_nrec;
+ return 0;
+}
diff --git a/fdelmodc3D/replacetab.scr b/fdelmodc3D/replacetab.scr
new file mode 100755
index 0000000000000000000000000000000000000000..48fc0b595d317782f9d9577f4749b21eeac941f6
--- /dev/null
+++ b/fdelmodc3D/replacetab.scr
@@ -0,0 +1,3 @@
+#!/bin/bash
+sed 's/ / /g' $1 > nep
+mv nep $1
diff --git a/fdelmodc3D/segy.h b/fdelmodc3D/segy.h
new file mode 100644
index 0000000000000000000000000000000000000000..d0a0d769d1548115b04396076b4a15d5be0ee687
--- /dev/null
+++ b/fdelmodc3D/segy.h
@@ -0,0 +1,849 @@
+/* Copyright (c) Colorado School of Mines, 2011.*/
+/* All rights reserved. */
+
+/* segy.h - include file for SEGY traces
+ *
+ * declarations for:
+ * typedef struct {} segy - the trace identification header
+ * typedef struct {} bhed - binary header
+ *
+ * Note:
+ * If header words are added, run the makefile in this directory
+ * to recreate hdr.h.
+ *
+ * Reference:
+ * K. M. Barry, D. A. Cavers and C. W. Kneale, "Special Report:
+ * Recommended Standards for Digital Tape Formats",
+ * Geophysics, vol. 40, no. 2 (April 1975), P. 344-352.
+ *
+ * $Author: john $
+ * $Source: /usr/local/cwp/src/su/include/RCS/segy.h,v $
+ * $Revision: 1.33 $ ; $Date: 2011/11/11 23:56:14 $
+ */
+
+#include <limits.h>
+#include "par.h"
+
+#ifndef SEGY_H
+#define SEGY_H
+#define TRCBYTES 240
+
+#define SU_NFLTS 32767 /* Arbitrary limit on data array size */
+
+
+/* TYPEDEFS */
+typedef struct { /* segy - trace identification header */
+
+ int tracl; /* Trace sequence number within line
+ --numbers continue to increase if the
+ same line continues across multiple
+ SEG Y files.
+ byte# 1-4
+ */
+
+ int tracr; /* Trace sequence number within SEG Y file
+ ---each file starts with trace sequence
+ one
+ byte# 5-8
+ */
+
+ int fldr; /* Original field record number
+ byte# 9-12
+ */
+
+ int tracf; /* Trace number within original field record
+ byte# 13-16
+ */
+
+ int ep; /* energy source point number
+ ---Used when more than one record occurs
+ at the same effective surface location.
+ byte# 17-20
+ */
+
+ int cdp; /* Ensemble number (i.e. CDP, CMP, CRP,...)
+ byte# 21-24
+ */
+
+ int cdpt; /* trace number within the ensemble
+ ---each ensemble starts with trace number one.
+ byte# 25-28
+ */
+
+ short trid; /* trace identification code:
+ -1 = Other
+ 0 = Unknown
+ 1 = Seismic data
+ 2 = Dead
+ 3 = Dummy
+ 4 = Time break
+ 5 = Uphole
+ 6 = Sweep
+ 7 = Timing
+ 8 = Water break
+ 9 = Near-field gun signature
+ 10 = Far-field gun signature
+ 11 = Seismic pressure sensor
+ 12 = Multicomponent seismic sensor
+ - Vertical component
+ 13 = Multicomponent seismic sensor
+ - Cross-line component
+ 14 = Multicomponent seismic sensor
+ - in-line component
+ 15 = Rotated multicomponent seismic sensor
+ - Vertical component
+ 16 = Rotated multicomponent seismic sensor
+ - Transverse component
+ 17 = Rotated multicomponent seismic sensor
+ - Radial component
+ 18 = Vibrator reaction mass
+ 19 = Vibrator baseplate
+ 20 = Vibrator estimated ground force
+ 21 = Vibrator reference
+ 22 = Time-velocity pairs
+ 23 ... N = optional use
+ (maximum N = 32,767)
+
+ Following are CWP id flags:
+
+ 109 = autocorrelation
+ 110 = Fourier transformed - no packing
+ xr[0],xi[0], ..., xr[N-1],xi[N-1]
+ 111 = Fourier transformed - unpacked Nyquist
+ xr[0],xi[0],...,xr[N/2],xi[N/2]
+ 112 = Fourier transformed - packed Nyquist
+ even N:
+ xr[0],xr[N/2],xr[1],xi[1], ...,
+ xr[N/2 -1],xi[N/2 -1]
+ (note the exceptional second entry)
+ odd N:
+ xr[0],xr[(N-1)/2],xr[1],xi[1], ...,
+ xr[(N-1)/2 -1],xi[(N-1)/2 -1],xi[(N-1)/2]
+ (note the exceptional second & last entries)
+ 113 = Complex signal in the time domain
+ xr[0],xi[0], ..., xr[N-1],xi[N-1]
+ 114 = Fourier transformed - amplitude/phase
+ a[0],p[0], ..., a[N-1],p[N-1]
+ 115 = Complex time signal - amplitude/phase
+ a[0],p[0], ..., a[N-1],p[N-1]
+ 116 = Real part of complex trace from 0 to Nyquist
+ 117 = Imag part of complex trace from 0 to Nyquist
+ 118 = Amplitude of complex trace from 0 to Nyquist
+ 119 = Phase of complex trace from 0 to Nyquist
+ 121 = Wavenumber time domain (k-t)
+ 122 = Wavenumber frequency (k-omega)
+ 123 = Envelope of the complex time trace
+ 124 = Phase of the complex time trace
+ 125 = Frequency of the complex time trace
+ 130 = Depth-Range (z-x) traces
+ 201 = Seismic data packed to bytes (by supack1)
+ 202 = Seismic data packed to 2 bytes (by supack2)
+ byte# 29-30
+ */
+
+ short nvs; /* Number of vertically summed traces yielding
+ this trace. (1 is one trace,
+ 2 is two summed traces, etc.)
+ byte# 31-32
+ */
+
+ short nhs; /* Number of horizontally summed traces yielding
+ this trace. (1 is one trace
+ 2 is two summed traces, etc.)
+ byte# 33-34
+ */
+
+ short duse; /* Data use:
+ 1 = Production
+ 2 = Test
+ byte# 35-36
+ */
+
+ int offset; /* Distance from the center of the source point
+ to the center of the receiver group
+ (negative if opposite to direction in which
+ the line was shot).
+ byte# 37-40
+ */
+
+ int gelev; /* Receiver group elevation from sea level
+ (all elevations above the Vertical datum are
+ positive and below are negative).
+ byte# 41-44
+ */
+
+ int selev; /* Surface elevation at source.
+ byte# 45-48
+ */
+
+ int sdepth; /* Source depth below surface (a positive number).
+ byte# 49-52
+ */
+
+ int gdel; /* Datum elevation at receiver group.
+ byte# 53-56
+ */
+
+ int sdel; /* Datum elevation at source.
+ byte# 57-60
+ */
+
+ int swdep; /* Water depth at source.
+ byte# 61-64
+ */
+
+ int gwdep; /* Water depth at receiver group.
+ byte# 65-68
+ */
+
+ short scalel; /* Scalar to be applied to the previous 7 entries
+ to give the real value.
+ Scalar = 1, +10, +100, +1000, +10000.
+ If positive, scalar is used as a multiplier,
+ if negative, scalar is used as a divisor.
+ byte# 69-70
+ */
+
+ short scalco; /* Scalar to be applied to the next 4 entries
+ to give the real value.
+ Scalar = 1, +10, +100, +1000, +10000.
+ If positive, scalar is used as a multiplier,
+ if negative, scalar is used as a divisor.
+ byte# 71-72
+ */
+
+ int sx; /* Source coordinate - X
+ byte# 73-76
+ */
+
+ int sy; /* Source coordinate - Y
+ byte# 77-80
+ */
+
+ int gx; /* Group coordinate - X
+ byte# 81-84
+ */
+
+ int gy; /* Group coordinate - Y
+ byte# 85-88
+ */
+
+ short counit; /* Coordinate units: (for previous 4 entries and
+ for the 7 entries before scalel)
+ 1 = Length (meters or feet)
+ 2 = Seconds of arc
+ 3 = Decimal degrees
+ 4 = Degrees, minutes, seconds (DMS)
+
+ In case 2, the X values are longitude and
+ the Y values are latitude, a positive value designates
+ the number of seconds east of Greenwich
+ or north of the equator
+
+ In case 4, to encode +-DDDMMSS
+ counit = +-DDD*10^4 + MM*10^2 + SS,
+ with scalco = 1. To encode +-DDDMMSS.ss
+ counit = +-DDD*10^6 + MM*10^4 + SS*10^2
+ with scalco = -100.
+ byte# 89-90
+ */
+
+ short wevel; /* Weathering velocity.
+ byte# 91-92
+ */
+
+ short swevel; /* Subweathering velocity.
+ byte# 93-94
+ */
+
+ short sut; /* Uphole time at source in milliseconds.
+ byte# 95-96
+ */
+
+ short gut; /* Uphole time at receiver group in milliseconds.
+ byte# 97-98
+ */
+
+ short sstat; /* Source static correction in milliseconds.
+ byte# 99-100
+ */
+
+ short gstat; /* Group static correction in milliseconds.
+ byte# 101-102
+ */
+
+ short tstat; /* Total static applied in milliseconds.
+ (Zero if no static has been applied.)
+ byte# 103-104
+ */
+
+ short laga; /* Lag time A, time in ms between end of 240-
+ byte trace identification header and time
+ break, positive if time break occurs after
+ end of header, time break is defined as
+ the initiation pulse which maybe recorded
+ on an auxiliary trace or as otherwise
+ specified by the recording system
+ byte# 105-106
+ */
+
+ short lagb; /* lag time B, time in ms between the time break
+ and the initiation time of the energy source,
+ may be positive or negative
+ byte# 107-108
+ */
+
+ short delrt; /* delay recording time, time in ms between
+ initiation time of energy source and time
+ when recording of data samples begins
+ (for deep water work if recording does not
+ start at zero time)
+ byte# 109-110
+ */
+
+ short muts; /* mute time--start
+ byte# 111-112
+ */
+
+ short mute; /* mute time--end
+ byte# 113-114
+ */
+
+ unsigned short ns; /* number of samples in this trace
+ byte# 115-116
+ */
+
+ unsigned short dt; /* sample interval; in micro-seconds
+ byte# 117-118
+ */
+
+ short gain; /* gain type of field instruments code:
+ 1 = fixed
+ 2 = binary
+ 3 = floating point
+ 4 ---- N = optional use
+ byte# 119-120
+ */
+
+ short igc; /* instrument gain constant
+ byte# 121-122
+ */
+
+ short igi; /* instrument early or initial gain
+ byte# 123-124
+ */
+
+ short corr; /* correlated:
+ 1 = no
+ 2 = yes
+ byte# 125-126
+ */
+
+ short sfs; /* sweep frequency at start
+ byte# 127-128
+ */
+
+ short sfe; /* sweep frequency at end
+ byte# 129-130
+ */
+
+ short slen; /* sweep length in ms
+ byte# 131-132
+ */
+
+ short styp; /* sweep type code:
+ 1 = linear
+ 2 = cos-squared
+ 3 = other
+ byte# 133-134
+ */
+
+ short stas; /* sweep trace length at start in ms
+ byte# 135-136
+ */
+
+ short stae; /* sweep trace length at end in ms
+ byte# 137-138
+ */
+
+ short tatyp; /* taper type: 1=linear, 2=cos^2, 3=other
+ byte# 139-140
+ */
+
+ short afilf; /* alias filter frequency if used
+ byte# 141-142
+ */
+
+ short afils; /* alias filter slope
+ byte# 143-144
+ */
+
+ short nofilf; /* notch filter frequency if used
+ byte# 145-146
+ */
+
+ short nofils; /* notch filter slope
+ byte# 147-148
+ */
+
+ short lcf; /* low cut frequency if used
+ byte# 149-150
+ */
+
+ short hcf; /* high cut frequncy if used
+ byte# 151-152
+ */
+
+ short lcs; /* low cut slope
+ byte# 153-154
+ */
+
+ short hcs; /* high cut slope
+ byte# 155-156
+ */
+
+ short year; /* year data recorded
+ byte# 157-158
+ */
+
+ short day; /* day of year
+ byte# 159-160
+ */
+
+ short hour; /* hour of day (24 hour clock)
+ byte# 161-162
+ */
+
+ short minute; /* minute of hour
+ byte# 163-164
+ */
+
+ short sec; /* second of minute
+ byte# 165-166
+ */
+
+ short timbas; /* time basis code:
+ 1 = local
+ 2 = GMT
+ 3 = other
+ byte# 167-168
+ */
+
+ short trwf; /* trace weighting factor, defined as 1/2^N
+ volts for the least sigificant bit
+ byte# 169-170
+ */
+
+ short grnors; /* geophone group number of roll switch
+ position one
+ byte# 171-172
+ */
+
+ short grnofr; /* geophone group number of trace one within
+ original field record
+ byte# 173-174
+ */
+
+ short grnlof; /* geophone group number of last trace within
+ original field record
+ byte# 175-176
+ */
+
+ short gaps; /* gap size (total number of groups dropped)
+ byte# 177-178
+ */
+
+ short otrav; /* overtravel taper code:
+ 1 = down (or behind)
+ 2 = up (or ahead)
+ byte# 179-180
+ */
+
+#ifdef SLTSU_SEGY_H /* begin Unocal SU segy.h differences */
+
+
+ /* cwp local assignments */
+ float d1; /* sample spacing for non-seismic data
+ byte# 181-184
+ */
+
+ float f1; /* first sample location for non-seismic data
+ byte# 185-188
+ */
+
+ float d2; /* sample spacing between traces
+ byte# 189-192
+ */
+
+ float f2; /* first trace location
+ byte# 193-196
+ */
+
+ float ungpow; /* negative of power used for dynamic
+ range compression
+ byte# 197-200
+ */
+
+ float unscale; /* reciprocal of scaling factor to normalize
+ range
+ byte# 201-204
+ */
+
+ short mark; /* mark selected traces
+ byte# 205-206
+ */
+
+ /* SLTSU local assignments */
+ short mutb; /* mute time at bottom (start time)
+ bottom mute ends at last sample
+ byte# 207-208
+ */
+ float dz; /* depth sampling interval in (m or ft)
+ if =0.0, input are time samples
+ byte# 209-212
+ */
+
+ float fz; /* depth of first sample in (m or ft)
+ byte# 213-116
+ */
+
+ short n2; /* number of traces per cdp or per shot
+ byte# 217-218
+ */
+
+ short shortpad; /* alignment padding
+ byte# 219-220
+ */
+
+ int ntr; /* number of traces
+ byte# 221-224
+ */
+
+ /* SLTSU local assignments end */
+
+ short unass[8]; /* unassigned
+ byte# 225-240
+ */
+
+#else
+
+ /* cwp local assignments */
+ float d1; /* sample spacing for non-seismic data
+ byte# 181-184
+ */
+
+ float f1; /* first sample location for non-seismic data
+ byte# 185-188
+ */
+
+ float d2; /* sample spacing between traces
+ byte# 189-192
+ */
+
+ float f2; /* first trace location
+ byte# 193-196
+ */
+
+ float ungpow; /* negative of power used for dynamic
+ range compression
+ byte# 197-200
+ */
+
+ float unscale; /* reciprocal of scaling factor to normalize
+ range
+ byte# 201-204
+ */
+
+ int ntr; /* number of traces
+ byte# 205-208
+ */
+
+ short mark; /* mark selected traces
+ byte# 209-210
+ */
+
+ short shortpad; /* alignment padding
+ byte# 211-212
+ */
+
+
+ short unass[14]; /* unassigned--NOTE: last entry causes
+ a break in the word alignment, if we REALLY
+ want to maintain 240 bytes, the following
+ entry should be an odd number of short/UINT2
+ OR do the insertion above the "mark" keyword
+ entry
+ byte# 213-240
+ */
+#endif
+
+} segy;
+
+
+typedef struct { /* bhed - binary header */
+
+ int jobid; /* job identification number */
+
+ int lino; /* line number (only one line per reel) */
+
+ int reno; /* reel number */
+
+ short ntrpr; /* number of data traces per record */
+
+ short nart; /* number of auxiliary traces per record */
+
+ unsigned short hdt; /* sample interval in micro secs for this reel */
+
+ unsigned short dto; /* same for original field recording */
+
+ unsigned short hns; /* number of samples per trace for this reel */
+
+ unsigned short nso; /* same for original field recording */
+
+ short format; /* data sample format code:
+ 1 = floating point, 4 byte (32 bits)
+ 2 = fixed point, 4 byte (32 bits)
+ 3 = fixed point, 2 byte (16 bits)
+ 4 = fixed point w/gain code, 4 byte (32 bits)
+ 5 = IEEE floating point, 4 byte (32 bits)
+ 8 = two's complement integer, 1 byte (8 bits)
+ */
+
+ short fold; /* CDP fold expected per CDP ensemble */
+
+ short tsort; /* trace sorting code:
+ 1 = as recorded (no sorting)
+ 2 = CDP ensemble
+ 3 = single fold continuous profile
+ 4 = horizontally stacked */
+
+ short vscode; /* vertical sum code:
+ 1 = no sum
+ 2 = two sum ...
+ N = N sum (N = 32,767) */
+
+ short hsfs; /* sweep frequency at start */
+
+ short hsfe; /* sweep frequency at end */
+
+ short hslen; /* sweep length (ms) */
+
+ short hstyp; /* sweep type code:
+ 1 = linear
+ 2 = parabolic
+ 3 = exponential
+ 4 = other */
+
+ short schn; /* trace number of sweep channel */
+
+ short hstas; /* sweep trace taper length at start if
+ tapered (the taper starts at zero time
+ and is effective for this length) */
+
+ short hstae; /* sweep trace taper length at end (the ending
+ taper starts at sweep length minus the taper
+ length at end) */
+
+ short htatyp; /* sweep trace taper type code:
+ 1 = linear
+ 2 = cos-squared
+ 3 = other */
+
+ short hcorr; /* correlated data traces code:
+ 1 = no
+ 2 = yes */
+
+ short bgrcv; /* binary gain recovered code:
+ 1 = yes
+ 2 = no */
+
+ short rcvm; /* amplitude recovery method code:
+ 1 = none
+ 2 = spherical divergence
+ 3 = AGC
+ 4 = other */
+
+ short mfeet; /* measurement system code:
+ 1 = meters
+ 2 = feet */
+
+ short polyt; /* impulse signal polarity code:
+ 1 = increase in pressure or upward
+ geophone case movement gives
+ negative number on tape
+ 2 = increase in pressure or upward
+ geophone case movement gives
+ positive number on tape */
+
+ short vpol; /* vibratory polarity code:
+ code seismic signal lags pilot by
+ 1 337.5 to 22.5 degrees
+ 2 22.5 to 67.5 degrees
+ 3 67.5 to 112.5 degrees
+ 4 112.5 to 157.5 degrees
+ 5 157.5 to 202.5 degrees
+ 6 202.5 to 247.5 degrees
+ 7 247.5 to 292.5 degrees
+ 8 293.5 to 337.5 degrees */
+
+ short hunass[170]; /* unassigned */
+
+} bhed;
+
+/* DEFINES */
+#define gettr(x) fgettr(stdin, (x))
+#define vgettr(x) fvgettr(stdin, (x))
+#define puttr(x) fputtr(stdout, (x))
+#define vputtr(x) fvputtr(stdout, (x))
+#define gettra(x, y) fgettra(stdin, (x), (y))
+
+
+/* TOTHER represents "other" */
+#define TOTHER -1
+/* TUNK represents time traces of an unknown type */
+#define TUNK 0
+/* TREAL represents real time traces */
+#define TREAL 1
+/* TDEAD represents dead time traces */
+#define TDEAD 2
+/* TDUMMY represents dummy time traces */
+#define TDUMMY 3
+/* TBREAK represents time break traces */
+#define TBREAK 4
+/* UPHOLE represents uphole traces */
+#define UPHOLE 5
+/* SWEEP represents sweep traces */
+#define SWEEP 6
+/* TIMING represents timing traces */
+#define TIMING 7
+/* WBREAK represents timing traces */
+#define WBREAK 8
+/* NFGUNSIG represents near field gun signature */
+#define NFGUNSIG 9
+/* FFGUNSIG represents far field gun signature */
+#define FFGUNSIG 10
+/* SPSENSOR represents seismic pressure sensor */
+#define SPSENSOR 11
+/* TVERT represents multicomponent seismic sensor
+ - vertical component */
+#define TVERT 12
+/* TXLIN represents multicomponent seismic sensor
+ - cross-line component */
+#define TXLIN 13
+/* TINLIN represents multicomponent seismic sensor
+ - in-line component */
+#define TINLIN 14
+/* ROTVERT represents rotated multicomponent seismic sensor
+ - vertical component */
+#define ROTVERT 15
+/* TTRANS represents rotated multicomponent seismic sensor
+ - transverse component */
+#define TTRANS 16
+/* TRADIAL represents rotated multicomponent seismic sensor
+ - radial component */
+#define TRADIAL 17
+/* VRMASS represents vibrator reaction mass */
+#define VRMASS 18
+/* VBASS represents vibrator baseplate */
+#define VBASS 19
+/* VEGF represents vibrator estimated ground force */
+#define VEGF 20
+/* VREF represents vibrator reference */
+#define VREF 21
+
+/*** CWP trid assignments ***/
+/* ACOR represents autocorrelation */
+#define ACOR 109
+/* FCMPLX represents fourier transformed - no packing
+ xr[0],xi[0], ..., xr[N-1],xi[N-1] */
+#define FCMPLX 110
+/* FUNPACKNYQ represents fourier transformed - unpacked Nyquist
+ xr[0],xi[0],...,xr[N/2],xi[N/2] */
+#define FUNPACKNYQ 111
+/* FTPACK represents fourier transformed - packed Nyquist
+ even N: xr[0],xr[N/2],xr[1],xi[1], ...,
+ xr[N/2 -1],xi[N/2 -1]
+ (note the exceptional second entry)
+ odd N:
+ xr[0],xr[(N-1)/2],xr[1],xi[1], ...,
+ xr[(N-1)/2 -1],xi[(N-1)/2 -1],xi[(N-1)/2]
+ (note the exceptional second & last entries)
+*/
+#define FTPACK 112
+/* TCMPLX represents complex time traces */
+#define TCMPLX 113
+/* FAMPH represents freq domain data in amplitude/phase form */
+#define FAMPH 114
+/* TAMPH represents time domain data in amplitude/phase form */
+#define TAMPH 115
+/* REALPART represents the real part of a trace to Nyquist */
+#define REALPART 116
+/* IMAGPART represents the real part of a trace to Nyquist */
+#define IMAGPART 117
+/* AMPLITUDE represents the amplitude of a trace to Nyquist */
+#define AMPLITUDE 118
+/* PHASE represents the phase of a trace to Nyquist */
+#define PHASE 119
+/* KT represents wavenumber-time domain data */
+#define KT 121
+/* KOMEGA represents wavenumber-frequency domain data */
+#define KOMEGA 122
+/* ENVELOPE represents the envelope of the complex time trace */
+#define ENVELOPE 123
+/* INSTPHASE represents the phase of the complex time trace */
+#define INSTPHASE 124
+/* INSTFREQ represents the frequency of the complex time trace */
+#define INSTFREQ 125
+/* DEPTH represents traces in depth-range (z-x) */
+#define TRID_DEPTH 130
+/* 3C data... v,h1,h2=(11,12,13)+32 so a bitmask will convert */
+/* between conventions */
+/* CHARPACK represents byte packed seismic data from supack1 */
+#define CHARPACK 201
+/* SHORTPACK represents 2 byte packed seismic data from supack2 */
+#define SHORTPACK 202
+
+
+#define ISSEISMIC(id) (( (id)==TUNK || (id)==TREAL || (id)==TDEAD || (id)==TDUMMY || (id)==TBREAK || (id)==UPHOLE || (id)==SWEEP || (id)==TIMING || (id)==WBREAK || (id)==NFGUNSIG || (id)==FFGUNSIG || (id)==SPSENSOR || (id)==TVERT || (id)==TXLIN || (id)==TINLIN || (id)==ROTVERT || (id)==TTRANS || (id)==TRADIAL || (id)==ACOR ) ? cwp_true : cwp_false )
+
+/* FUNCTION PROTOTYPES */
+#ifdef __cplusplus /* if C++, specify external linkage to C functions */
+extern "C" {
+#endif
+
+/* get trace and put trace */
+int fgettr(FILE *fp, segy *tp);
+int fvgettr(FILE *fp, segy *tp);
+void fputtr(FILE *fp, segy *tp);
+void fvputtr(FILE *fp, segy *tp);
+int fgettra(FILE *fp, segy *tp, int itr);
+
+/* get gather and put gather */
+segy **fget_gather(FILE *fp, cwp_String *key,cwp_String *type,Value *n_val,
+ int *nt,int *ntr, float *dt,int *first);
+segy **get_gather(cwp_String *key, cwp_String *type, Value *n_val,
+ int *nt, int *ntr, float *dt, int *first);
+segy **fput_gather(FILE *fp, segy **rec,int *nt, int *ntr);
+segy **put_gather(segy **rec,int *nt, int *ntr);
+
+/* hdrpkge */
+void gethval(const segy *tp, int index, Value *valp);
+void puthval(segy *tp, int index, Value *valp);
+void getbhval(const bhed *bhp, int index, Value *valp);
+void putbhval(bhed *bhp, int index, Value *valp);
+void gethdval(const segy *tp, char *key, Value *valp);
+void puthdval(segy *tp, char *key, Value *valp);
+char *hdtype(const char *key);
+char *getkey(const int index);
+int getindex(const char *key);
+void swaphval(segy *tp, int index);
+void swapbhval(bhed *bhp, int index);
+void printheader(const segy *tp);
+
+void tabplot(segy *tp, int itmin, int itmax);
+
+#ifdef __cplusplus /* if C++, end external linkage specification */
+}
+#endif
+
+#endif
diff --git a/fdelmodc3D/sourceOnSurface.c b/fdelmodc3D/sourceOnSurface.c
new file mode 100644
index 0000000000000000000000000000000000000000..a2062dc3f89f95a8f2ac6998b5fbc62768f4de07
--- /dev/null
+++ b/fdelmodc3D/sourceOnSurface.c
@@ -0,0 +1,498 @@
+#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
new file mode 100644
index 0000000000000000000000000000000000000000..7ddefd7034f2458e923f29cead5b441aa901d88b
--- /dev/null
+++ b/fdelmodc3D/sourceOnSurface3D.c
@@ -0,0 +1,565 @@
+#include<stdlib.h>
+#include<stdio.h>
+#include<math.h>
+#include<assert.h>
+#include"fdelmodc3D.h"
+#define ISODD(n) ((n) & 01)
+static float *src1x, *src1y, *src1z, *src2x, *src2y, *src2z;
+static long first=1;
+void vmess(char *fmt, ...);
+
+long allocStoreSourceOnSurface3D(srcPar src)
+{
+ /* allocated 2x size for dipole Potential sources */
+ src1x = (float *)calloc(2*src.n, sizeof(float));
+ src1y = (float *)calloc(2*src.n, sizeof(float));
+ src1z = (float *)calloc(2*src.n, sizeof(float));
+ src2x = (float *)calloc(2*src.n, sizeof(float));
+ src2y = (float *)calloc(2*src.n, sizeof(float));
+ src2z = (float *)calloc(2*src.n, sizeof(float));
+ first = 0;
+ return 0;
+}
+
+long freeStoreSourceOnSurface3D(void)
+{
+ free(src1x);
+ free(src1y);
+ free(src1z);
+ free(src2x);
+ free(src2y);
+ free(src2z);
+ first = 1;
+ 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)
+{
+/**********************************************************************
+
+ AUTHOR:
+ Jan Thorbecke (janth@xs4all.nl)
+ The Netherlands
+
+***********************************************************************/
+
+ long ixs, iys, izs, isrc, is0;
+ long ibndz, ibndy, ibndx, store;
+ long nx, ny, nz, n1, n2;
+
+ nx = mod.nx;
+ ny = mod.ny;
+ nz = mod.nz;
+ n1 = mod.naz;
+ n2 = mod.nax;
+
+ if (src.type==6) {
+ ibndz = mod.ioXz;
+ ibndy = mod.ioXy;
+ ibndx = mod.ioXx;
+ }
+ else if (src.type==7) {
+ ibndz = mod.ioZz;
+ ibndy = mod.ioZy;
+ ibndx = mod.ioZx;
+ }
+ else if (src.type==2) {
+ ibndz = mod.ioTz;
+ ibndy = mod.ioTy;
+ ibndx = mod.ioTx;
+ if (bnd.lef==4 || bnd.lef==2) ibndx += bnd.ntap;
+ if (bnd.fro==4 || bnd.fro==2) ibndy += bnd.ntap;
+ }
+ else {
+ ibndz = mod.ioPz;
+ ibndy = mod.ioPy;
+ ibndx = mod.ioPx;
+ if (bnd.lef==4 || bnd.lef==2) ibndx += bnd.ntap;
+ if (bnd.fro==4 || bnd.fro==2) ibndy += bnd.ntap;
+ }
+
+/* check if there are sources placed on the boundaries */
+ is0 = -1*floor((src.n-1)/2);
+#pragma omp for private (isrc, ixs, iys, izs, store)
+ for (isrc=0; isrc<src.n; isrc++) {
+ /* calculate the source position */
+ if (src.random || src.multiwav) {
+ ixs = src.x[isrc] + ibndx;
+ iys = src.y[isrc] + ibndy;
+ izs = src.z[isrc] + ibndz;
+ }
+ else { /* plane wave and point sources */
+ ixs = ixsrc + ibndx + is0 + isrc;
+ iys = iysrc + ibndy + is0 + isrc;
+ izs = izsrc + ibndz;
+ }
+
+/* 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 ( (iys <= ibndy+1) && ISODD(bnd.fro)) store=1;
+ if ( (iys >= ny+ibndy) && ISODD(bnd.bac)) 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=%li y=%li z=%li stored before free surface", ixs, iys, izs);
+
+ /* Compressional source */
+ if (src.type == 1) {
+
+ if (src.orient==1) { /* monopole */
+ src1z[isrc] = tzz[iys*n1*n2+ixs*n1+izs];
+ }
+ else if (src.orient==2) { /* dipole +/- */
+ src1z[isrc] = tzz[iys*n1*n2+ixs*n1+izs];
+ src2z[isrc] = tzz[iys*n1*n2+ixs*n1+izs+1];
+ }
+ else if (src.orient==3) { /* dipole - + */
+ src1z[isrc] = tzz[iys*n1*n2+ixs*n1+izs];
+ src2z[isrc] = tzz[iys*n1*n2+(ixs-1)*n1+izs];
+ }
+ else if (src.orient==4) { /* dipole +/0/- */
+ if (izs > ibndz)
+ src1z[isrc] = tzz[iys*n1*n2+ixs*n1+izs-1];
+ if (izs < mod.nz+ibndz-1)
+ src2z[isrc] = tzz[iys*n1*n2+ixs*n1+izs+1];
+ }
+ else if (src.orient==5) { /* dipole + - */
+ src1z[isrc] = tzz[iys*n1*n2+ixs*n1+izs];
+ src2z[isrc] = tzz[iys*n1*n2+(ixs+1)*n1+izs];
+ }
+ }
+ else if (src.type==6) {
+ src1x[isrc] = vx[iys*n1*n2+ixs*n1+izs];
+ }
+ else if (src.type==7) {
+ src1z[isrc] = vz[iys*n1*n2+ixs*n1+izs];
+ }
+
+ }
+ }
+ else { /* Elastic scheme */
+
+ if (store) {
+ if (verbose>=5) vmess("source at x=%li y=%li z=%li stored before free surface", ixs, iys, izs);
+
+ if (src.type==1) {
+ if (src.orient==1) { /* monopole */
+ src1x[isrc] = txx[iys*n1*n2+ixs*n1+izs];
+ src1y[isrc] = tyy[iys*n1*n2+ixs*n1+izs];
+ src1z[isrc] = tzz[iys*n1*n2+ixs*n1+izs];
+ }
+ else if (src.orient==2) { /* dipole +/- */
+ src1x[isrc] = txx[iys*n1*n2+ixs*n1+izs];
+ src1y[isrc] = tyy[iys*n1*n2+ixs*n1+izs];
+ src1z[isrc] = tzz[iys*n1*n2+ixs*n1+izs];
+ src2x[isrc] = txx[iys*n1*n2+ixs*n1+izs+1];
+ src2y[isrc] = tyy[iys*n1*n2+ixs*n1+izs+1];
+ src2z[isrc] = tzz[iys*n1*n2+ixs*n1+izs+1];
+ }
+ else if (src.orient==3) { /* dipole - + */
+ src1x[isrc] = txx[iys*n1*n2+ixs*n1+izs];
+ src1y[isrc] = tyy[iys*n1*n2+ixs*n1+izs];
+ src1z[isrc] = tzz[iys*n1*n2+ixs*n1+izs];
+ src2x[isrc] = txx[iys*n1*n2+(ixs-1)*n1+izs];
+ src2y[isrc] = tyy[iys*n1*n2+(ixs-1)*n1+izs];
+ src2z[isrc] = tzz[iys*n1*n2+(ixs-1)*n1+izs];
+ }
+ else if (src.orient==4) { /* dipole +/0/- */
+ if (izs > ibndz) {
+ src1x[isrc] = txx[iys*n1*n2+ixs*n1+izs-1];
+ src1y[isrc] = tyy[iys*n1*n2+ixs*n1+izs-1];
+ src1z[isrc] = tzz[iys*n1*n2+ixs*n1+izs-1];
+ }
+ if (izs < mod.nz+ibndz-1) {
+ src1x[isrc] = txx[iys*n1*n2+ixs*n1+izs+1];
+ src1y[isrc] = tyy[iys*n1*n2+ixs*n1+izs+1];
+ src1z[isrc] = tzz[iys*n1*n2+ixs*n1+izs+1];
+ }
+ }
+ else if (src.orient==5) { /* dipole + - */
+ src1x[isrc] = txx[iys*n1*n2+ixs*n1+izs];
+ src1y[isrc] = tyy[iys*n1*n2+ixs*n1+izs];
+ src1z[isrc] = tzz[iys*n1*n2+ixs*n1+izs];
+ src2x[isrc] = txx[iys*n1*n2+(ixs+1)*n1+izs];
+ src2y[isrc] = tyy[iys*n1*n2+(ixs+1)*n1+izs];
+ src2z[isrc] = tzz[iys*n1*n2+(ixs+1)*n1+izs];
+ }
+ }
+ else if (src.type==2) {
+
+ /* Txz source */
+ if ((izs == ibndz) && bnd.top==1) {
+ src1x[isrc] = txz[iys*n1*n2+(ixs-1)*n1+izs-1];
+ src2x[isrc] = txz[iys*n1*n2+ixs*n1+izs-1];
+ }
+ else {
+ src1x[isrc] = txz[iys*n1*n2+ixs*n1+izs];
+ }
+ /* possible dipole orientations for a txz source */
+ if (src.orient == 2) { /* dipole +/- */
+ src2x[isrc] = txz[iys*n1*n2+ixs*n1+izs+1];
+ }
+ else if (src.orient == 3) { /* dipole - + */
+ src2x[isrc] = txz[iys*n1*n2+(ixs-1)*n1+izs];
+ }
+ else if (src.orient == 4) { /* dipole +/O/- */
+ /* correction: subtrace previous value to prevent z-1 values. */
+ src1x[isrc] = txz[iys*n1*n2+ixs*n1+izs];
+ src2x[isrc] = txz[iys*n1*n2+ixs*n1+izs+1];
+ }
+ else if (src.orient == 5) { /* dipole + - */
+ src2x[isrc] = txz[iys*n1*n2+(ixs+1)*n1+izs];
+ }
+
+ }
+ else if (src.type==3) {
+ src1z[isrc] = tzz[iys*n1*n2+ixs*n1+izs];
+ }
+ else if (src.type==4) {
+ src1x[isrc] = txx[iys*n1*n2+ixs*n1+izs];
+ }
+ else if (src.type==5) {
+
+ src1x[isrc] = vx[iys*n1*n2+ixs*n1+izs];
+ src1y[isrc] = vy[iys*n1*n2+ixs*n1+izs];
+ src1z[isrc] = vz[iys*n1*n2+ixs*n1+izs];
+ src2x[isrc] = vx[iys*n1*n2+ixs*n1+izs-1];
+ src2y[isrc] = vy[(iys-1)*n1*n2+ixs*n1+izs];
+ src2z[isrc] = vz[iys*n1*n2+(ixs-1)*n1+izs];
+
+ /* determine second position of dipole */
+ if (src.orient == 2) { /* dipole +/- vertical */
+ izs += 1;
+ src1x[isrc+src.n] = vx[iys*n1*n2+ixs*n1+izs];
+ src1y[isrc+src.n] = vy[iys*n1*n2+ixs*n1+izs];
+ src1z[isrc+src.n] = vz[iys*n1*n2+ixs*n1+izs];
+ src2x[isrc+src.n] = vx[iys*n1*n2+ixs*n1+izs-1];
+ src2y[isrc+src.n] = vz[(iys-1)*n1*n2+ixs*n1+izs];
+ src2z[isrc+src.n] = vz[iys*n1*n2+(ixs-1)*n1+izs];
+ }
+ else if (src.orient == 3) { /* dipole - + horizontal */
+ ixs += 1;
+ src1x[isrc+src.n] = vx[iys*n1*n2+ixs*n1+izs];
+ src1y[isrc+src.n] = vy[iys*n1*n2+ixs*n1+izs];
+ src1z[isrc+src.n] = vz[iys*n1*n2+ixs*n1+izs];
+ src2x[isrc+src.n] = vx[iys*n1*n2+ixs*n1+izs-1];
+ src2y[isrc+src.n] = vz[(iys-1)*n1*n2+ixs*n1+izs];
+ src2z[isrc+src.n] = vz[iys*n1*n2+(ixs-1)*n1+izs];
+ }
+
+ }
+ else if (src.type==6) {
+ src1x[isrc] = vx[iys*n1*n2+ixs*n1+izs];
+ }
+ else if (src.type==7) {
+ src1z[isrc] = vz[iys*n1*n2+ixs*n1+izs];
+ }
+ else if (src.type==8) {
+
+ src1x[isrc] = vx[iys*n1*n2+(ixs+1)*n1+izs];
+ src1y[isrc] = vy[(iys+1)*n1*n2+ixs*n1+izs];
+ src1z[isrc] = vz[iys*n1*n2+ixs*n1+izs+1];
+ src2x[isrc] = vx[iys*n1*n2+ixs*n1+izs];
+ src2y[isrc] = vy[iys*n1*n2+ixs*n1+izs];
+ src2z[isrc] = vz[iys*n1*n2+ixs*n1+izs];
+
+ /* determine second position of dipole */
+ if (src.orient == 2) { /* dipole +/- vertical */
+ izs += 1;
+ src1x[isrc+src.n] = vx[iys*n1*n2+(ixs+1)*n1+izs];
+ src1y[isrc] = vy[(iys+1)*n1*n2+ixs*n1+izs];
+ src1z[isrc+src.n] = vz[iys*n1*n2+ixs*n1+izs+1];
+ src2x[isrc+src.n] = vx[iys*n1*n2+ixs*n1+izs];
+ src2y[isrc] = vy[iys*n1*n2+ixs*n1+izs];
+ src2z[isrc+src.n] = vz[iys*n1*n2+ixs*n1+izs];
+ }
+ else if (src.orient == 3) { /* dipole - + horizontal */
+ ixs += 1;
+ src1x[isrc+src.n] = vx[iys*n1*n2+(ixs+1)*n1+izs];
+ src1y[isrc] = vy[(iys+1)*n1*n2+ixs*n1+izs];
+ src1z[isrc+src.n] = vz[iys*n1*n2+ixs*n1+izs+1];
+ src2x[isrc+src.n] = vx[iys*n1*n2+ixs*n1+izs];
+ src2y[isrc] = vy[iys*n1*n2+ixs*n1+izs];
+ src2z[isrc+src.n] = vz[iys*n1*n2+ixs*n1+izs];
+ }
+
+ } /* end of source.type */
+ }
+ }
+ }
+
+ return 0;
+}
+
+
+
+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)
+{
+ /**********************************************************************
+
+ AUTHOR:
+ Jan Thorbecke (janth@xs4all.nl)
+ The Netherlands
+
+ ***********************************************************************/
+
+ long ixs, iys, izs, isrc, is0;
+ long ibndz, ibndy, ibndx, store;
+ long nx, ny, nz, n1, n2;
+
+ nx = mod.nx;
+ ny = mod.ny;
+ nz = mod.nz;
+ n1 = mod.naz;
+ n2 = mod.nax;
+
+ if (src.type==6) {
+ ibndz = mod.ioXz;
+ ibndy = mod.ioXy;
+ ibndx = mod.ioXx;
+ }
+ else if (src.type==7) {
+ ibndz = mod.ioZz;
+ ibndy = mod.ioZy;
+ ibndx = mod.ioZx;
+ }
+ else if (src.type==2) {
+ ibndz = mod.ioTz;
+ ibndy = mod.ioTy;
+ ibndx = mod.ioTx;
+ if (bnd.lef==4 || bnd.lef==2) ibndx += bnd.ntap;
+ if (bnd.fro==4 || bnd.fro==2) ibndy += bnd.ntap;
+ }
+ else {
+ ibndz = mod.ioPz;
+ ibndy = mod.ioPy;
+ ibndx = mod.ioPx;
+ if (bnd.lef==4 || bnd.lef==2) ibndx += bnd.ntap;
+ if (bnd.fro==4 || bnd.fro==2) ibndy += bnd.ntap;
+ }
+
+ /* restore source positions on the edge */
+ is0 = -1*floor((src.n-1)/2);
+#pragma omp for private (isrc, ixs, iys, izs, store)
+ for (isrc=0; isrc<src.n; isrc++) {
+ /* calculate the source position */
+ if (src.random || src.multiwav) {
+ ixs = src.x[isrc] + ibndx;
+ iys = src.y[isrc] + ibndy;
+ izs = src.z[isrc] + ibndz;
+ }
+ else { /* plane wave and point sources */
+ ixs = ixsrc + ibndx + is0 + isrc;
+ iys = iysrc + ibndy + 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 ( (iys <= ibndy+1) && ISODD(bnd.fro)) store=1;
+ if ( (iys >= ny+ibndy) && ISODD(bnd.bac)) 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=%li y=%li z=%li restored at free surface", ixs, iys, izs);
+
+ /* Compressional source */
+ if (src.type == 1) {
+
+ if (src.orient==1) { /* monopole */
+ tzz[iys*n1*n2+ixs*n1+izs]= src1z[isrc];
+ }
+ else if (src.orient==2) { /* dipole +/- */
+ tzz[iys*n1*n2+ixs*n1+izs] = src1z[isrc];
+ tzz[iys*n1*n2+ixs*n1+izs+1] = src2z[isrc];
+ }
+ else if (src.orient==3) { /* dipole - + */
+ tzz[iys*n1*n2+ixs*n1+izs] = src1z[isrc];
+ tzz[iys*n1*n2+(ixs-1)*n1+izs] = src2z[isrc];
+ }
+ else if (src.orient==4) { /* dipole +/0/- */
+ if (izs > ibndz)
+ tzz[iys*n1*n2+ixs*n1+izs-1] = src1z[isrc];
+ if (izs < mod.nz+ibndz-1)
+ tzz[iys*n1*n2+ixs*n1+izs+1] = src2z[isrc];
+ }
+ else if (src.orient==5) { /* dipole + - */
+ tzz[iys*n1*n2+ixs*n1+izs] = src1z[isrc];
+ tzz[iys*n1*n2+(ixs+1)*n1+izs] = src2z[isrc];
+ }
+ }
+ else if (src.type==6) {
+ vx[iys*n1*n2+ixs*n1+izs] = src1x[isrc];
+ }
+ else if (src.type==7) {
+ vz[iys*n1*n2+ixs*n1+izs] = src1z[isrc];
+ }
+
+ }
+
+ }
+ else { /* Elastic scheme */
+
+ if (store) {
+ if (verbose>=5) vmess("source at x=%li y=%li z=%li restored at free surface", ixs, iys, izs);
+
+ if (src.type==1) {
+ if (src.orient==1) { /* monopole */
+ txx[iys*n1*n2+ixs*n1+izs] = src1x[isrc];
+ tyy[iys*n1*n2+ixs*n1+izs] = src1y[isrc];
+ tzz[iys*n1*n2+ixs*n1+izs] = src1z[isrc];
+ }
+ else if (src.orient==2) { /* dipole +/- */
+ txx[iys*n1*n2+ixs*n1+izs] = src1x[isrc];
+ tyy[iys*n1*n2+ixs*n1+izs] = src1y[isrc];
+ tzz[iys*n1*n2+ixs*n1+izs] = src1z[isrc];
+ txx[iys*n1*n2+ixs*n1+izs+1] = src2x[isrc];
+ tyy[iys*n1*n2+ixs*n1+izs+1] = src2y[isrc];
+ tzz[iys*n1*n2+ixs*n1+izs+1] = src2z[isrc];
+ }
+ else if (src.orient==3) { /* dipole - + */
+ txx[iys*n1*n2+ixs*n1+izs] = src1x[isrc];
+ tyy[iys*n1*n2+ixs*n1+izs] = src1y[isrc];
+ tzz[iys*n1*n2+ixs*n1+izs] = src1z[isrc];
+ txx[iys*n1*n2+(ixs-1)*n1+izs] = src2x[isrc];
+ tyy[iys*n1*n2+(ixs-1)*n1+izs] = src2y[isrc];
+ tzz[iys*n1*n2+(ixs-1)*n1+izs] = src2z[isrc];
+ }
+ else if (src.orient==4) { /* dipole +/0/- */
+ if (izs > ibndz) {
+ txx[iys*n1*n2+ixs*n1+izs-1] = src1x[isrc];
+ tyy[iys*n1*n2+ixs*n1+izs-1] = src1y[isrc];
+ tzz[iys*n1*n2+ixs*n1+izs-1] = src1z[isrc];
+ }
+ if (izs < mod.nz+ibndz-1) {
+ txx[iys*n1*n2+ixs*n1+izs+1] = src1x[isrc];
+ tyy[iys*n1*n2+ixs*n1+izs+1] = src1y[isrc];
+ tzz[iys*n1*n2+ixs*n1+izs+1] = src1z[isrc];
+ }
+ }
+ else if (src.orient==5) { /* dipole + - */
+ txx[iys*n1*n2+ixs*n1+izs] = src1x[isrc];
+ tyy[iys*n1*n2+ixs*n1+izs] = src1y[isrc];
+ tzz[iys*n1*n2+ixs*n1+izs] = src1z[isrc];
+ txx[iys*n1*n2+(ixs+1)*n1+izs] = src2x[isrc];
+ tyy[iys*n1*n2+(ixs+1)*n1+izs] = src2y[isrc];
+ tzz[iys*n1*n2+(ixs+1)*n1+izs] = src2z[isrc];
+ }
+ }
+ else if (src.type==2) {
+
+ /* Txz source */
+ if ((izs == ibndz) && bnd.top==1) {
+ txz[iys*n1*n2+(ixs-1)*n1+izs-1] = src1x[isrc];
+ txz[iys*n1*n2+ixs*n1+izs-1] = src2x[isrc];
+ }
+ else {
+ txz[iys*n1*n2+ixs*n1+izs] = src1x[isrc];
+ }
+ /* possible dipole orientations for a txz source */
+ if (src.orient == 2) { /* dipole +/- */
+ txz[iys*n1*n2+ixs*n1+izs+1] = src2x[isrc];
+ }
+ else if (src.orient == 3) { /* dipole - + */
+ txz[iys*n1*n2+(ixs-1)*n1+izs] = src2x[isrc];
+ }
+ else if (src.orient == 4) { /* dipole +/O/- */
+ /* correction: subtrace previous value to prevent z-1 values. */
+ txz[iys*n1*n2+ixs*n1+izs] = src1x[isrc];
+ txz[iys*n1*n2+ixs*n1+izs+1] = src2x[isrc];
+ }
+ else if (src.orient == 5) { /* dipole + - */
+ txz[iys*n1*n2+(ixs+1)*n1+izs] = src2x[isrc];
+ }
+
+ }
+ else if (src.type==3) {
+ tzz[iys*n1*n2+ixs*n1+izs] = src1z[isrc];
+ }
+ else if (src.type==4) {
+ txx[iys*n1*n2+ixs*n1+izs] = src1x[isrc];
+ }
+ else if (src.type==5) {
+
+ vx[iys*n1*n2+ixs*n1+izs]= src1x[isrc];
+ vy[iys*n1*n2+ixs*n1+izs] = src1y[isrc];
+ vz[iys*n1*n2+ixs*n1+izs] = src1z[isrc];
+ vx[iys*n1*n2+ixs*n1+izs-1] = src2x[isrc];
+ vy[(iys-1)*n1*n2+ixs*n1+izs] = src2y[isrc];
+ vz[iys*n1*n2+(ixs-1)*n1+izs] = src2z[isrc];
+
+ /* determine second position of dipole */
+ if (src.orient == 2) { /* dipole +/- vertical */
+ izs += 1;
+ vx[iys*n1*n2+ixs*n1+izs] = src1x[isrc+src.n];
+ vy[iys*n1*n2+ixs*n1+izs] = src1y[isrc+src.n];
+ vz[iys*n1*n2+ixs*n1+izs] = src1z[isrc+src.n];
+ vx[iys*n1*n2+ixs*n1+izs-1] = src2x[isrc+src.n];
+ vy[(iys-1)*n1*n2+ixs*n1+izs] = src2y[isrc+src.n];
+ vz[iys*n1*n2+(ixs-1)*n1+izs] = src2z[isrc+src.n];
+ }
+ else if (src.orient == 3) { /* dipole - + horizontal */
+ ixs += 1;
+ vx[iys*n1*n2+ixs*n1+izs] = src1x[isrc+src.n];
+ vy[iys*n1*n2+ixs*n1+izs] = src1y[isrc+src.n];
+ vz[iys*n1*n2+ixs*n1+izs] = src1z[isrc+src.n];
+ vx[iys*n1*n2+ixs*n1+izs-1] = src2x[isrc+src.n];
+ vy[(iys-1)*n1*n2+ixs*n1+izs] = src2y[isrc+src.n];
+ vz[iys*n1*n2+(ixs-1)*n1+izs] = src2z[isrc+src.n];
+ }
+
+ }
+ else if (src.type==6) {
+ vx[iys*n1*n2+ixs*n1+izs] = src1x[isrc];
+ }
+ else if (src.type==7) {
+ vz[iys*n1*n2+ixs*n1+izs] = src1z[isrc];
+ }
+ else if (src.type==8) {
+
+ vx[iys*n1*n2+(ixs+1)*n1+izs] = src1x[isrc];
+ vy[(iys+1)*n1*n2+ixs*n1+izs] = src1z[isrc];
+ vz[iys*n1*n2+ixs*n1+izs+1] = src1z[isrc];
+ vx[iys*n1*n2+ixs*n1+izs] = src2x[isrc];
+ vy[iys*n1*n2+ixs*n1+izs] = src2y[isrc];
+ vz[iys*n1*n2+ixs*n1+izs] = src2z[isrc];
+
+ /* determine second position of dipole */
+ if (src.orient == 2) { /* dipole +/- vertical */
+ izs += 1;
+ vx[iys*n1*n2+(ixs+1)*n1+izs] = src1x[isrc+src.n];
+ vy[(iys+1)*n1*n2+ixs*n1+izs] = src1y[isrc+src.n];
+ vz[iys*n1*n2+ixs*n1+izs+1] = src1z[isrc+src.n];
+ vx[iys*n1*n2+ixs*n1+izs] = src2x[isrc+src.n];
+ vy[iys*n1*n2+ixs*n1+izs] = src2y[isrc+src.n];
+ vz[iys*n1*n2+ixs*n1+izs] = src2z[isrc+src.n];
+ }
+ else if (src.orient == 3) { /* dipole - + horizontal */
+ ixs += 1;
+ vx[iys*n1*n2+(ixs+1)*n1+izs] = src1x[isrc+src.n];
+ vy[(iys+1)*n1*n2+ixs*n1+izs] = src1y[isrc+src.n];
+ vz[iys*n1*n2+ixs*n1+izs+1] = src1z[isrc+src.n];
+ vx[iys*n1*n2+ixs*n1+izs] = src2x[isrc+src.n];
+ vy[iys*n1*n2+ixs*n1+izs] = src2y[isrc+src.n];
+ vz[iys*n1*n2+ixs*n1+izs] = src2z[isrc+src.n];
+ }
+
+ }
+ }
+ }
+ }
+
+ return 0;
+}
diff --git a/fdelmodc3D/spline3.c b/fdelmodc3D/spline3.c
new file mode 100644
index 0000000000000000000000000000000000000000..2457bf1b49028bbf3766ea7904961352cfb2237a
--- /dev/null
+++ b/fdelmodc3D/spline3.c
@@ -0,0 +1,34 @@
+#include <math.h>
+
+/**
+* Computes interpolation based on third order splines
+*
+* AUTHOR:
+* Jan Thorbecke (janth@xs4all.nl)
+* The Netherlands
+**/
+
+
+void spline3(float x1, float x2, float z1, float z2, float dzdx1,
+ float dzdx2, float *a, float *b, float *c, float *d)
+{
+ if (x1 == x2 ) {
+ if ((z1 == z2) && (dzdx1 == dzdx2)) {
+ *a = 0.0;
+ *b = 0.0;
+ *c = dzdx1;
+ *d = (z1 - *c*x1);
+ }
+ else {
+ return;
+ }
+ return;
+ }
+
+ *a = (dzdx1 + dzdx2 - 2.0*(z1-z2)/(x1-x2))/((x1-x2)*(x1-x2));
+ *b = 0.5*(dzdx1 - dzdx2)/(x1-x2) - 1.5**a*(x1+x2);
+ *c = (z1 - z2 - *a*(x1*x1*x1-x2*x2*x2) - *b*(x1*x1-x2*x2))/(x1-x2);
+ *d = z1 - *a*x1*x1*x1 - *b*x1*x1 - *c*x1;
+
+ return;
+}
diff --git a/fdelmodc3D/threadAffinity.c b/fdelmodc3D/threadAffinity.c
new file mode 100644
index 0000000000000000000000000000000000000000..bd9913ca40cb9d42b3151b53b62810fa1cbabf50
--- /dev/null
+++ b/fdelmodc3D/threadAffinity.c
@@ -0,0 +1,109 @@
+#define _GNU_SOURCE
+
+#include <stdio.h>
+#include <unistd.h>
+#include <string.h>
+#ifdef __USE_GNU
+#include <omp.h>
+#include <sched.h>
+#else /* for OSX */
+#include <sched.h>
+#include <sys/types.h>
+#include <sys/sysctl.h>
+
+#define CPU_SETSIZE 1024
+#define SYSCTL_CORE_COUNT "machdep.cpu.core_count"
+void vmess(char *fmt, ...);
+
+typedef struct cpu_set {
+ uint32_t count;
+} cpu_set_t;
+
+static inline void
+CPU_ZERO(cpu_set_t *cs) { cs->count = 0; }
+
+static inline void
+CPU_SET(int num, cpu_set_t *cs) { cs->count |= (1 << num); }
+
+static inline int
+CPU_ISSET(int num, cpu_set_t *cs) { return (cs->count & (1 << num)); }
+
+int sched_getaffinity(pid_t pid, size_t cpu_size, cpu_set_t *cpu_set)
+{
+ int32_t core_count = 0;
+ size_t len = sizeof(core_count);
+ int ret = sysctlbyname(SYSCTL_CORE_COUNT, &core_count, &len, 0, 0);
+ if (ret) {
+ printf("error while get core count %d\n", ret);
+ return -1;
+ }
+ cpu_set->count = 0;
+ for (int i = 0; i < core_count; i++) {
+ cpu_set->count |= (1 << i);
+ }
+
+ return 0;
+}
+#endif
+
+/* Borrowed from util-linux-2.13-pre7/schedutils/taskset.c */
+
+static char *cpuset_to_cstr(cpu_set_t *mask, char *str)
+{
+ char *ptr = str;
+ int i, j, entry_made = 0;
+ for (i = 0; i < CPU_SETSIZE; i++) {
+ if (CPU_ISSET(i, mask)) {
+ int run = 0;
+ entry_made = 1;
+ for (j = i + 1; j < CPU_SETSIZE; j++) {
+ if (CPU_ISSET(j, mask)) run++;
+ else break;
+ }
+ if (!run)
+ sprintf(ptr, "%d,", i);
+ else if (run == 1) {
+ sprintf(ptr, "%d,%d,", i, i + 1);
+ i++;
+ } else {
+ sprintf(ptr, "%d-%d,", i, i + run);
+ i += run;
+ }
+ while (*ptr != 0) ptr++;
+ }
+ }
+ ptr -= entry_made;
+ *ptr = 0;
+ return(str);
+}
+
+void threadAffinity(void)
+{
+ int thread;
+ cpu_set_t coremask;
+ char clbuf[7 * CPU_SETSIZE], hnbuf[64];
+ char prefix[200];
+
+ memset(clbuf, 0, sizeof(clbuf));
+ memset(hnbuf, 0, sizeof(hnbuf));
+ (void)gethostname(hnbuf, sizeof(hnbuf));
+
+ strcpy(prefix,"Hello world from");
+
+// #pragma omp parallel private(thread, coremask, clbuf)
+/* for use inside parallel region */
+ #pragma omp critical
+ {
+#ifdef _OPENMP
+ thread = omp_get_thread_num();
+#else
+ thread = 1;
+#endif
+ (void)sched_getaffinity(0, sizeof(coremask), &coremask);
+ cpuset_to_cstr(&coremask, clbuf);
+ vmess("%s thread %d, on %s. (core affinity = %s)", prefix, thread, hnbuf, clbuf);
+
+ }
+ return;
+}
+
diff --git a/fdelmodc3D/verbosepkg.c b/fdelmodc3D/verbosepkg.c
new file mode 100644
index 0000000000000000000000000000000000000000..483e5f92bd5e1c1a495c66b7a63b9e8113943897
--- /dev/null
+++ b/fdelmodc3D/verbosepkg.c
@@ -0,0 +1,77 @@
+#include <stdio.h>
+#include <stdarg.h>
+#include "par.h"
+#include <string.h>
+#ifdef _CRAYMPP
+#include <intrinsics.h>
+#endif
+
+/**
+* functions to print out verbose, error and warning messages to stderr.
+*
+* AUTHOR:
+* Jan Thorbecke (janth@xs4all.nl)
+* The Netherlands
+**/
+
+
+void verr(char *fmt, ...)
+{
+ va_list args;
+
+ if (EOF == fflush(stderr)) {
+ fprintf(stderr, "\nverr: fflush failed on stderr");
+ }
+ fprintf(stderr, " Error in %s: ", xargv[0]);
+#ifdef _CRAYMPP
+ fprintf(stderr, "PE %d: ", _my_pe());
+#elif defined(SGI)
+ fprintf(stderr, "PE %d: ", mp_my_threadnum());
+#endif
+ va_start(args,fmt);
+ vfprintf(stderr, fmt, args);
+ va_end(args);
+ fprintf(stderr, "\n");
+
+ exit(EXIT_FAILURE);
+}
+
+void vwarn(char *fmt, ...)
+{
+ va_list args;
+
+ if (EOF == fflush(stderr)) {
+ fprintf(stderr, "\nvwarn: fflush failed on stderr");
+ }
+ fprintf(stderr, " Warning in %s: ", xargv[0]);
+#ifdef _CRAYMPP
+ fprintf(stderr, "PE %d: ", _my_pe());
+#elif defined(SGI)
+ fprintf(stderr, "PE %d: ", mp_my_threadnum());
+#endif
+ va_start(args,fmt);
+ vfprintf(stderr, fmt, args);
+ va_end(args);
+ fprintf(stderr, "\n");
+ return;
+}
+
+void vmess(char *fmt, ...)
+{
+ va_list args;
+
+ if (EOF == fflush(stderr)) {
+ fprintf(stderr, "\nvmess: fflush failed on stderr");
+ }
+ fprintf(stderr, " %s: ", xargv[0]);
+#ifdef _CRAYMPP
+ fprintf(stderr, "PE %d: ", _my_pe());
+#elif defined(SGI)
+ fprintf(stderr, "PE %d: ", mp_my_threadnum());
+#endif
+ va_start(args,fmt);
+ vfprintf(stderr, fmt, args);
+ va_end(args);
+ fprintf(stderr, "\n");
+ return;
+}
diff --git a/fdelmodc3D/viscoacoustic4.c b/fdelmodc3D/viscoacoustic4.c
new file mode 100644
index 0000000000000000000000000000000000000000..63207c7da09c060fccf4b3625a86e6437d744d91
--- /dev/null
+++ b/fdelmodc3D/viscoacoustic4.c
@@ -0,0 +1,175 @@
+#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
new file mode 100644
index 0000000000000000000000000000000000000000..865aa123eae8e88e73131934527af6b88da9cce7
--- /dev/null
+++ b/fdelmodc3D/viscoelastic4.c
@@ -0,0 +1,244 @@
+#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/wallclock_time.c b/fdelmodc3D/wallclock_time.c
new file mode 100644
index 0000000000000000000000000000000000000000..1e75530ccee3215724badefdd6144c2c59246dbc
--- /dev/null
+++ b/fdelmodc3D/wallclock_time.c
@@ -0,0 +1,33 @@
+#include <time.h>
+#include <sys/time.h>
+#include <stdio.h>
+
+/**
+* function used to calculate wallclock times
+*
+* AUTHOR:
+* Jan Thorbecke (janth@xs4all.nl)
+* The Netherlands
+**/
+
+double wallclock_time(void)
+{
+ struct timeval s_val;
+ static struct timeval b_val;
+ double time;
+ static int base=0;
+
+ gettimeofday(&s_val,0);
+
+ if (!base) {
+ b_val = s_val;
+ base = 1;
+ return 0.0;
+ }
+
+ time = (double)(s_val.tv_sec-b_val.tv_sec) +
+ (double)(1e-6*((double)s_val.tv_usec-(double)b_val.tv_usec));
+
+ return (double)time;
+}
+
diff --git a/fdelmodc3D/writeRec.c b/fdelmodc3D/writeRec.c
new file mode 100644
index 0000000000000000000000000000000000000000..982cc6bcdcaadd3eb0e515087ddef39f955d58d4
--- /dev/null
+++ b/fdelmodc3D/writeRec.c
@@ -0,0 +1,226 @@
+#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/writeSnapTimes.c b/fdelmodc3D/writeSnapTimes.c
new file mode 100644
index 0000000000000000000000000000000000000000..dc05beae1f0fa8780899d6b06b0afbe20d9ec362
--- /dev/null
+++ b/fdelmodc3D/writeSnapTimes.c
@@ -0,0 +1,211 @@
+#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/writeSrcRecPos.c b/fdelmodc3D/writeSrcRecPos.c
new file mode 100644
index 0000000000000000000000000000000000000000..c9cec66adc9437f94da6ac05e36d672a14555b5f
--- /dev/null
+++ b/fdelmodc3D/writeSrcRecPos.c
@@ -0,0 +1,141 @@
+#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/writesufile.c b/fdelmodc3D/writesufile.c
new file mode 100644
index 0000000000000000000000000000000000000000..71f7f3f7a5f2089c3990851bb19d60d7080c6d2f
--- /dev/null
+++ b/fdelmodc3D/writesufile.c
@@ -0,0 +1,169 @@
+#include <stdlib.h>
+#include <stdio.h>
+#include <assert.h>
+#include <string.h>
+#include "par.h"
+#include "fdelmodc.h"
+#include "SUsegy.h"
+#include "segy.h"
+
+/**
+* Writes an 2D array to a SU file
+*
+* AUTHOR:
+* Jan Thorbecke (janth@xs4all.nl)
+* The Netherlands
+**/
+
+#define TRCBYTES 240
+
+#define MAX(x,y) ((x) > (y) ? (x) : (y))
+#define MIN(x,y) ((x) < (y) ? (x) : (y))
+#define ISODD(n) ((n) & 01)
+#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)
+{
+ FILE *file_out;
+ size_t nwrite, itrace;
+ int ns;
+ segy *hdr;
+// char *ptr;
+
+/* Read in parameters */
+
+// ptr = strstr(filename, " ");
+// *ptr = '\0';
+
+
+ if (n1 > USHRT_MAX) {
+ vwarn("Output file %s: number of samples is truncated from %d to USHRT_MAX.", filename, n1);
+ }
+ ns = MIN(n1,USHRT_MAX);
+
+ file_out = fopen( filename, "w+" );
+ assert( file_out );
+
+ hdr = (segy *)calloc(1,TRCBYTES);
+ hdr->ns = ns;
+ hdr->dt = NINT(1000000*(d1));
+ hdr->d1 = d1;
+ hdr->d2 = d2;
+ hdr->f1 = f1;
+ hdr->f2 = f2;
+ hdr->fldr = 1;
+ hdr->trwf = n2;
+
+ for (itrace=0; itrace<n2; itrace++) {
+ hdr->tracl = itrace+1;
+ nwrite = fwrite( hdr, 1, TRCBYTES, file_out );
+ assert (nwrite == TRCBYTES);
+ nwrite = fwrite( &data[itrace*n1], sizeof(float), ns, file_out );
+ assert (nwrite == ns);
+ }
+ fclose(file_out);
+ free(hdr);
+
+ return 0;
+}
+
+/**
+* Writes an 2D array to a SU file
+* special routine for src_nwav array which has a different number of samples for each shot
+*
+**/
+
+int writesufilesrcnwav(char *filename, float **src_nwav, wavPar wav, int n1, int n2, float f1, float f2, float d1, float d2)
+{
+ FILE *file_out;
+ size_t nwrite, itrace;
+ float *trace;
+ int ns;
+ segy *hdr;
+// char *ptr;
+
+/* Read in parameters */
+
+// ptr = strstr(filename, " ");
+// *ptr = '\0';
+
+ if (n1 > USHRT_MAX) {
+ vwarn("Output file %s: number of samples is truncated from %d to USHRT_MAX.", filename, n1);
+ }
+ ns = MIN(n1,USHRT_MAX);
+
+ file_out = fopen( filename, "w+" );
+ assert( file_out );
+
+ trace = (float *)malloc(n1*sizeof(float));
+ hdr = (segy *)calloc(1,TRCBYTES);
+ hdr->ns = ns;
+ hdr->dt = NINT(1000000*(d1));
+ hdr->d1 = d1;
+ hdr->d2 = d2;
+ hdr->f1 = f1;
+ hdr->f2 = f2;
+ hdr->fldr = 1;
+ hdr->trwf = n2;
+
+ for (itrace=0; itrace<n2; itrace++) {
+ hdr->tracl = itrace+1;
+ nwrite = fwrite( hdr, 1, TRCBYTES, file_out );
+ assert (nwrite == TRCBYTES);
+ memset(trace, 0, n1*sizeof(float));
+ memcpy(trace, &src_nwav[itrace][0], wav.nsamp[itrace]*sizeof(float));
+ nwrite = fwrite( &trace[0], sizeof(float), ns, file_out );
+ assert (nwrite == ns);
+ }
+ fclose(file_out);
+ free(hdr);
+ free(trace);
+
+ return 0;
+}
+
+/**
+* Writes an 2D array to a SU file
+* special routine which used segyhdrs which have ns defined as integer (32 bit)
+* to handle more than 2^16 samples per trace.
+*
+**/
+
+int writeSUfile(char *filename, float *data, int n1, int n2, float f1, float f2, float d1, float d2)
+{
+ FILE *file_out;
+ size_t nwrite, itrace;
+ SUsegy *SUhdr;
+ char *ptr;
+
+/* Read in parameters */
+
+ ptr = strstr(filename, " ");
+ *ptr = '\0';
+
+ file_out = fopen( filename, "w+" );
+ assert( file_out );
+
+ SUhdr = (SUsegy *)calloc(1,TRCBYTES);
+ SUhdr->ns = n1;
+ SUhdr->dt = NINT(1000000*(d1));
+ SUhdr->d1 = d1;
+ SUhdr->d2 = d2;
+ SUhdr->f1 = f1;
+ SUhdr->f2 = f2;
+ SUhdr->fldr = 1;
+ SUhdr->trwf = n2;
+
+ for (itrace=0; itrace<n2; itrace++) {
+ SUhdr->tracl = itrace+1;
+ nwrite = fwrite( SUhdr, 1, TRCBYTES, file_out );
+ assert (nwrite == TRCBYTES);
+ nwrite = fwrite( &data[itrace*n1], sizeof(float), n1, file_out );
+ assert (nwrite == n1);
+ }
+ fclose(file_out);
+ free(SUhdr);
+
+ return 0;
+}
+
diff --git a/fdemmodc/Makefile b/fdemmodc/Makefile
index 762538283e1353e719731c662a3e473e22dd4ddb..60fc989b6bdea945895eb84ca3598b7c360b48ea 100644
--- a/fdemmodc/Makefile
+++ b/fdemmodc/Makefile
@@ -5,7 +5,7 @@ include ../Make_include
########################################################################
# define general include and system library
ALLINC = -I.
-LIBS += -L$L -lgenfft -lm $(LIBSM)
+#LIBS += -L$L -lgenfft -lm $(LIBSM)
#LIBS += -L$L -lgenfft -lm -lc
#OPTC = -g -Wall -fsignaling-nans -O0
#OPTC += -fopenmp -Waddress
diff --git a/include/genfft.h b/include/genfft.h
index fbef0291f14755a9e871f03f4ed181bf3f2cd10d..4c7ccc6e9a5a5bdc2e2486e870d5a038a3bae778 100644
--- a/include/genfft.h
+++ b/include/genfft.h
@@ -79,6 +79,7 @@ extern "C" {
int optncc(int n);
int optncr(int n);
+long loptncr(long n);
void cc1fft(complex *data, int n, int sign);
void ccmfft(complex *data, int n1, int n2, int ld1, int sign);
diff --git a/index.html b/index.html
new file mode 100644
index 0000000000000000000000000000000000000000..7f1b66e8c5edeea520527b9380e5659ad3fa8231
--- /dev/null
+++ b/index.html
@@ -0,0 +1,18 @@
+
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">
+<HTML>
+<HEAD>
+
+<!-- Global site tag (gtag.js) - Google Analytics -->
+<script async src="https://www.googletagmanager.com/gtag/js?id=UA-133845553-1"></script>
+<script>
+ window.dataLayer = window.dataLayer || [];
+ function gtag(){dataLayer.push(arguments);}
+ gtag('js', new Date());
+
+ gtag('config', 'UA-133845553-1');
+</script>
+
+</HEAD>
+<BODY BGCOLOR="#ffffff">
+<P>
diff --git a/marchenko/Makefile b/marchenko/Makefile
index 237c134e904d7c4b7311e63065c4c09282ace67f..260e2c02845925df6222452cf89035f50faf8704 100644
--- a/marchenko/Makefile
+++ b/marchenko/Makefile
@@ -2,7 +2,7 @@
include ../Make_include
-LIBS += -L$L -lgenfft -lm $(LIBSM)
+#LIBS += -L$L -lgenfft -lm $(LIBSM)
#OPTC += -g -O0 -Wall
#ALL: fmute marchenko marchenko2
diff --git a/marchenko/applyMute.c b/marchenko/applyMute.c
index df98e8bc39f8b132c10b237f7e3e01f3167cdf7d..acbbeea27dece52a24b5f0ad366f2b2a1351f06d 100644
--- a/marchenko/applyMute.c
+++ b/marchenko/applyMute.c
@@ -12,11 +12,11 @@
#endif
#define NINT(x) ((int)((x)>0.0?(x)+0.5:(x)-0.5))
-void applyMute( float *data, int *mute, int smooth, int above, int Nfoc, int nxs, int nt, int *ixpos, int npos, int shift)
+void applyMute( float *data, int *mute, int smooth, int above, int Nfoc, int nxs, int nt, int *ixpos, int npos, int shift, int *tsynW)
{
int i, j, l, isyn;
float *costaper, scl;
- int imute, tmute;
+ int imute, tmute, ts;
if (smooth) {
costaper = (float *)malloc(smooth*sizeof(float));
@@ -31,10 +31,11 @@ void applyMute( float *data, int *mute, int smooth, int above, int Nfoc, int nxs
for (i = 0; i < npos; i++) {
imute = ixpos[i];
tmute = mute[isyn*nxs+imute];
- for (j = 0; j < MAX(0,tmute-shift-smooth); j++) {
+ ts = tsynW[isyn*nxs+imute];
+ for (j = 0; j < MAX(0,-2*ts+tmute-shift-smooth); j++) {
data[isyn*nxs*nt+i*nt+j] = 0.0;
}
- for (j = MAX(0,tmute-shift-smooth),l=0; j < MAX(0,tmute-shift); j++,l++) {
+ for (j = MAX(0,-2*ts+tmute-shift-smooth),l=0; j < MAX(0,-2*ts+tmute-shift); j++,l++) {
data[isyn*nxs*nt+i*nt+j] *= costaper[smooth-l-1];
}
}
@@ -43,14 +44,15 @@ void applyMute( float *data, int *mute, int smooth, int above, int Nfoc, int nxs
for (i = 0; i < npos; i++) {
imute = ixpos[i];
tmute = mute[isyn*nxs+imute];
+ ts = tsynW[isyn*nxs+imute];
if (tmute >= nt/2) {
memset(&data[isyn*nxs*nt+i*nt],0, sizeof(float)*nt);
continue;
}
- for (j = MAX(0,tmute-shift),l=0; j < MAX(0,tmute-shift+smooth); j++,l++) {
+ for (j = MAX(0,-2*ts+tmute-shift),l=0; j < MAX(0,-2*ts+tmute-shift+smooth); j++,l++) {
data[isyn*nxs*nt+i*nt+j] *= costaper[l];
}
- for (j = MAX(0,tmute-shift+smooth)+1; j < MIN(nt,nt+1-tmute+shift-smooth); j++) {
+ for (j = MAX(0,-2*ts+tmute-shift+smooth)+1; j < MIN(nt,nt+1-tmute+shift-smooth); j++) {
data[isyn*nxs*nt+i*nt+j] = 0.0;
}
for (j = MIN(nt,nt-tmute+shift-smooth),l=0; j < MIN(nt,nt-tmute+shift); j++,l++) {
@@ -62,10 +64,11 @@ void applyMute( float *data, int *mute, int smooth, int above, int Nfoc, int nxs
for (i = 0; i < npos; i++) {
imute = ixpos[i];
tmute = mute[isyn*nxs+imute];
- for (j = MAX(0,tmute-shift),l=0; j < MAX(0,tmute-shift+smooth); j++,l++) {
+ ts = tsynW[isyn*nxs+imute];
+ for (j = MAX(0,ts+tmute-shift),l=0; j < MAX(0,ts+tmute-shift+smooth); j++,l++) {
data[isyn*nxs*nt+i*nt+j] *= costaper[l];
}
- for (j = MAX(0,tmute-shift+smooth); j < nt; j++) {
+ for (j = MAX(0,ts+tmute-shift+smooth); j < nt; j++) {
data[isyn*nxs*nt+i*nt+j] = 0.0;
}
}
diff --git a/marchenko/fmute.c b/marchenko/fmute.c
index ba4f39acb407d3dacf414096dafc0b3ab67a2c8d..f5c7668a16dc382b586c2981427888c6fa256f66 100644
--- a/marchenko/fmute.c
+++ b/marchenko/fmute.c
@@ -25,7 +25,7 @@ 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);
int disp_fileinfo(char *file, int n1, int n2, float f1, float f2, float d1, float d2, segy *hdrs);
-void applyMute( float *data, int *mute, int smooth, int above, int Nfoc, int nxs, int nt, int *ixpos, int npos, int shift);
+void applyMute(float *data, int *mute, int smooth, int above, int Nfoc, int nxs, int nt, int *xrcvsyn, int npos, int shift, int *muteW);
double wallclock_time(void);
/*********************** self documentation **********************/
@@ -43,7 +43,7 @@ char *sdoc[] = {
" Optional parameters: ",
" ",
" file_out= ................ output file",
-" above=0 .................. mute after(0), before(1) or around(2) the maximum times of file_mute",
+" above=0 .................. mute above(1), around(0) or below(-1) the first travel times of file_tinv",
" .......................... options 4 is the inverse of 0 and -1 the inverse of 1",
" shift=0 .................. number of points above(positive) / below(negative) maximum time for mute",
" check=0 .................. plots muting window on top of file_mute: output file check.su",
@@ -64,7 +64,7 @@ int main (int argc, char **argv)
FILE *fp_in1, *fp_in2, *fp_out, *fp_chk, *fp_psline1, *fp_psline2;
int verbose, shift, k, nx1, nt1, nx2, nt2;
int ntmax, nxmax, ret, i, j, jmax, imax, above, check;
- int size, ntraces, ngath, *maxval, hw, smooth;
+ int size, ntraces, ngath, *maxval, *tsynW, hw, smooth;
int tstart, tend, scale, *xrcv;
float dt, d2, f1, f2, t0, t1, f1b, f2b, d1, d1b, d2b;
float w1, w2, dxrcv;
@@ -169,6 +169,7 @@ int main (int argc, char **argv)
/*================ initializations ================*/
maxval = (int *)calloc(nx1,sizeof(int));
+ tsynW = (int *)calloc(nx1,sizeof(int));
xrcv = (int *)calloc(nx1,sizeof(int));
if (file_out==NULL) fp_out = stdout;
@@ -227,6 +228,8 @@ int main (int argc, char **argv)
/* alternative find maximum at source position */
dxrcv = (hdrs_in1[nx1-1].gx - hdrs_in1[0].gx)*sclsxgx/(float)(nx1-1);
imax = NINT(((hdrs_in1[0].sx-hdrs_in1[0].gx)*sclsxgx)/dxrcv);
+ /* make sure that the position fits into the receiver array */
+ imax = MIN(MAX(0,imax),nx1-1);
tmax=0.0;
jmax = 0;
xmax=0.0;
@@ -289,7 +292,7 @@ int main (int argc, char **argv)
/*================ apply mute window ================*/
- applyMute(tmpdata2, maxval, smooth, above, 1, nx2, nt2, xrcv, nx2, shift);
+ applyMute(tmpdata2, maxval, smooth, above, 1, nx2, nt2, xrcv, nx2, shift, tsynW);
/*================ write result to output file ================*/
diff --git a/marchenko/marchenko.c b/marchenko/marchenko.c
index a0fc3e328ed27de41706943c00a31f3831e75dd7..2d16e436f83b026b592fdf28a5bc416497bbb7a4 100644
--- a/marchenko/marchenko.c
+++ b/marchenko/marchenko.c
@@ -43,7 +43,7 @@ float *zsyn, int *ixpos, int npos, int iter);
void name_ext(char *filename, char *extension);
-void applyMute(float *data, int *mute, int smooth, int above, int Nfoc, int nxs, int nt, int *xrcvsyn, int npos, int shift);
+void applyMute(float *data, int *mute, int smooth, int above, int Nfoc, int nxs, int nt, int *xrcvsyn, int npos, int shift, int *muteW);
int getFileInfo(char *filename, int *n1, int *n2, int *ngath, float *d1, float *d2, float *f1, float *f2, float *xmin, float *xmax, float *sclsxgx, int *ntraces);
int readData(FILE *fp, float *data, segy *hdrs, int n1);
@@ -87,6 +87,9 @@ char *sdoc[] = {
" shift=12 ................. number of points above(positive) / below(negative) travel time for mute",
" hw=8 ..................... window in time samples to look for maximum in next trace",
" smooth=5 ................. number of points to smooth mute with cosine window",
+" plane_wave=0 ............. enable plane-wave illumination function"
+" src_angle=0 .............. angle of plane source array",
+" src_velo=1500 ............ velocity to use in src_angle definition",
" REFLECTION RESPONSE CORRECTION ",
" tsq=0.0 .................. scale factor n for t^n for true amplitude recovery",
" Q=0.0 .......,............ Q correction factor",
@@ -121,16 +124,17 @@ int main (int argc, char **argv)
int size, n1, n2, ntap, tap, di, ntraces, pad;
int nw, nw_low, nw_high, nfreq, *xnx, *xnxsyn;
int reci, countmin, mode, n2out, verbose, ntfft;
- int iter, niter, tracf, *muteW;
- int hw, smooth, above, shift, *ixpos, npos, ix;
+ int iter, niter, tracf, *muteW, *tsynW;
+ int hw, smooth, above, shift, *ixpos, npos, ix, plane_wave;
int nshots_r, *isxcount, *reci_xsrc, *reci_xrcv;
float fmin, fmax, *tapersh, *tapersy, fxf, dxf, *xsrc, *xrcv, *zsyn, *zsrc, *xrcvsyn;
double t0, t1, t2, t3, tsyn, tread, tfft, tcopy, energyNi, energyN0;
float d1, d2, f1, f2, fxsb, fxse, ft, fx, *xsyn, dxsrc;
float *green, *f2p, *pmin, *G_d, dt, dx, dxs, scl, mem;
- float *f1plus, *f1min, *iRN, *Ni, *trace, *Gmin, *Gplus;
+ float *f1plus, *f1min, *iRN, *Ni, *Nig, *trace, *Gmin, *Gplus;
float xmin, xmax, scale, tsq, Q, f0;
float *ixmask;
+ float grad2rad, p, src_angle, src_velo;
complex *Refl, *Fop;
char *file_tinv, *file_shot, *file_green, *file_iter;
char *file_f1plus, *file_f1min, *file_gmin, *file_gplus, *file_f2, *file_pmin;
@@ -176,6 +180,10 @@ int main (int argc, char **argv)
if(!getparint("above", &above)) above = 0;
if(!getparint("shift", &shift)) shift=12;
+ if (!getparint("plane_wave", &plane_wave)) plane_wave = 0;
+ if (!getparfloat("src_angle",&src_angle)) src_angle=0.;
+ if (!getparfloat("src_velo",&src_velo)) src_velo=1500.;
+
if (reci && ntap) vwarn("tapering influences the reciprocal result");
/*================ Reading info about shot and initial operator sizes ================*/
@@ -214,8 +222,10 @@ int main (int argc, char **argv)
f1min = (float *)calloc(Nfoc*nxs*ntfft,sizeof(float));
iRN = (float *)calloc(Nfoc*nxs*ntfft,sizeof(float));
Ni = (float *)calloc(Nfoc*nxs*ntfft,sizeof(float));
+ Nig = (float *)calloc(Nfoc*nxs*ntfft,sizeof(float));
G_d = (float *)calloc(Nfoc*nxs*ntfft,sizeof(float));
muteW = (int *)calloc(Nfoc*nxs,sizeof(int));
+ tsynW = (int *)malloc(Nfoc*nxs*sizeof(int)); // time-shift for Giovanni's plane-wave on non-zero times
trace = (float *)malloc(ntfft*sizeof(float));
tapersy = (float *)malloc(nxs*sizeof(float));
xrcvsyn = (float *)calloc(Nfoc*nxs,sizeof(float)); // x-rcv postions of focal points
@@ -247,6 +257,28 @@ int main (int argc, char **argv)
/* reading data added zero's to the number of time samples to be the same as ntfft */
nts = ntfft;
+ /* compute time shift for tilted plane waves */
+ if (plane_wave != 0) {
+ grad2rad = 17.453292e-3;
+ p = sin(src_angle*grad2rad)/src_velo;
+ if (p < 0.0) {
+ for (i=0; i<nxs; i++) {
+ tsynW[i] = NINT(fabsf((nxs-1-i)*dxs*p)/dt);
+ }
+ }
+ else {
+ for (i=0; i<nxs; i++) {
+ tsynW[i] = NINT(i*dxs*p/dt);
+ }
+ }
+ if (Nfoc!=1) verr("For plave-wave focusing only one function can be computed at the same time");
+ }
+ else { /* just fill with zero's */
+ for (i=0; i<nxs*Nfoc; i++) {
+ tsynW[i] = 0;
+ }
+ }
+
/* define tapers to taper edges of acquisition */
if (tap == 1 || tap == 3) {
for (j = 0; j < ntap; j++)
@@ -461,6 +493,12 @@ int main (int argc, char **argv)
pmin[l*nxs*nts+i*nts+j] += iRN[l*nxs*nts+ix*nts+j];
energyNi += iRN[l*nxs*nts+ix*nts+j]*iRN[l*nxs*nts+ix*nts+j];
}
+ if (plane_wave!=0) { /* don't reverse in time */
+ Nig[l*nxs*nts+i*nts+j] = -iRN[l*nxs*nts+ix*nts+j];
+ for (j = 1; j < nts; j++) {
+ Nig[l*nxs*nts+i*nts+j] = -iRN[l*nxs*nts+ix*nts+j];
+ }
+ }
}
if (iter==0) energyN0 = energyNi;
if (verbose >=2) vmess(" - iSyn %d: Ni at iteration %d has energy %e; relative to N0 %e", l, iter, sqrt(energyNi),
@@ -468,29 +506,34 @@ sqrt(energyNi/energyN0));
}
/* apply mute window based on times of direct arrival (in muteW) */
- applyMute(Ni, muteW, smooth, above, Nfoc, nxs, nts, ixpos, npos, shift);
-
- /* update f2 */
- for (l = 0; l < Nfoc; l++) {
- for (i = 0; i < npos; i++) {
- j = 0;
- f2p[l*nxs*nts+i*nts+j] += Ni[l*nxs*nts+i*nts+j];
- for (j = 1; j < nts; j++) {
- f2p[l*nxs*nts+i*nts+j] += Ni[l*nxs*nts+i*nts+j];
- }
- }
- }
+ applyMute(Ni, muteW, smooth, above, Nfoc, nxs, nts, ixpos, npos, shift, tsynW);
+ if (plane_wave!=0) applyMute(Nig, muteW, smooth, above, Nfoc, nxs, nts, ixpos, npos, shift, tsynW);
if (iter % 2 == 0) { /* even iterations update: => f_1^-(t) */
- for (l = 0; l < Nfoc; l++) {
- for (i = 0; i < npos; i++) {
- j = 0;
- f1min[l*nxs*nts+i*nts+j] -= Ni[l*nxs*nts+i*nts+j];
- for (j = 1; j < nts; j++) {
- f1min[l*nxs*nts+i*nts+j] -= Ni[l*nxs*nts+i*nts+nts-j];
+ if (plane_wave==0) { /* follow the standard focal point scheme */
+ for (l = 0; l < Nfoc; l++) {
+ for (i = 0; i < npos; i++) {
+ j = 0;
+ f1min[l*nxs*nts+i*nts+j] -= Ni[l*nxs*nts+i*nts+j];
+ for (j = 1; j < nts; j++) {
+ f1min[l*nxs*nts+i*nts+j] -= Ni[l*nxs*nts+i*nts+nts-j];
+ }
}
}
- }
+ }
+ else { /* plane wave scheme */
+ for (l = 0; l < Nfoc; l++) {
+ for (i = 0; i < npos; i++) {
+ j = 0;
+ f1min[l*nxs*nts+i*nts+j] -= Nig[l*nxs*nts+i*nts+j];
+ Ni[l*nxs*nts+i*nts+j] = Nig[l*nxs*nts+i*nts+j];
+ for (j = 1; j < nts; j++) {
+ f1min[l*nxs*nts+i*nts+j] -= Nig[l*nxs*nts+i*nts+j];
+ Ni[l*nxs*nts+i*nts+j] = Nig[l*nxs*nts+i*nts+nts-j];
+ }
+ }
+ }
+ }
}
else {/* odd iterations update: => f_1^+(t) */
for (l = 0; l < Nfoc; l++) {
@@ -504,6 +547,17 @@ sqrt(energyNi/energyN0));
}
}
+ /* update f2 */
+ for (l = 0; l < Nfoc; l++) {
+ for (i = 0; i < npos; i++) {
+ j = 0;
+ f2p[l*nxs*nts+i*nts+j] += Ni[l*nxs*nts+i*nts+j];
+ for (j = 1; j < nts; j++) {
+ f2p[l*nxs*nts+i*nts+j] += Ni[l*nxs*nts+i*nts+j];
+ }
+ }
+ }
+
t2 = wallclock_time();
tcopy += t2 - t3;
@@ -512,6 +566,7 @@ sqrt(energyNi/energyN0));
} /* end of iterations */
free(Ni);
+ free(Nig);
free(G_d);
/* compute full Green's function G = int R * f2(t) + f2(-t) = Pplus + Pmin */
@@ -552,7 +607,7 @@ sqrt(energyNi/energyN0));
}
}
/* Apply mute with window for Gmin */
- applyMute(Gmin, muteW, smooth, 1, Nfoc, nxs, nts, ixpos, npos, shift);
+ applyMute(Gmin, muteW, smooth, 1, Nfoc, nxs, nts, ixpos, npos, shift, tsynW);
} /* end if Gmin */
/* compute downgoing Green's function G^+,+ */
@@ -578,6 +633,9 @@ sqrt(energyNi/energyN0));
}
} /* end if Gplus */
+ free(muteW);
+ free(tsynW);
+
t2 = wallclock_time();
if (verbose) {
vmess("Total CPU-time marchenko = %.3f", t2-t0);
@@ -788,7 +846,7 @@ nw, int nw_low, int nw_high, int mode, int reci, int nshots, int *ixpos, int np
/* Loop over total number of shots */
if (reci == 0 || reci == 1) {
for (k=0; k<nshots; k++) {
- if ((xsrc[k] < fxsb) || (xsrc[k] > fxse)) continue;
+ if ((xsrc[k] < 0.999*fxsb) || (xsrc[k] > 1.001*fxse)) continue;
ixsrc = NINT((xsrc[k] - fxsb)/dxs);
inx = xnx[k]; /* number of traces per shot */
@@ -936,7 +994,7 @@ float fxse, float fxsb, float dxs, float dxsrc, float dx, int nshots, int *ixpos
vmess("focal point positions: %.2f <--> %.2f", fxsb, fxse);
}
- if ( (xsrc[k] >= fxsb) && (xsrc[k] <= fxse) ) {
+ if ( (xsrc[k] >= 0.999*fxsb) && (xsrc[k] <= 1.001*fxse) ) {
j = linearsearch(ixpos, *npos, ixsrc);
if (j < *npos) { /* the position (at j) is already included */
count[j] += xnx[k];
diff --git a/marchenko3D/Makefile b/marchenko3D/Makefile
new file mode 100644
index 0000000000000000000000000000000000000000..691bfc1ff3a2456edec0b0b0480d989e8853b4ea
--- /dev/null
+++ b/marchenko3D/Makefile
@@ -0,0 +1,61 @@
+# Makefile
+
+include ../Make_include
+
+LIBS += -L$L -lgenfft -lm $(LIBSM)
+#OPTC += -g -O0 -Wall
+
+#ALL: fmute marchenko marchenko2
+
+ALL: marchenko3D fmute3D
+
+SRCT = marchenko3D.c \
+ getFileInfo3D.c \
+ readData3D.c \
+ readShotData3D.c \
+ readTinvData3D.c \
+ synthesis3D.c \
+ applyMute3D.c \
+ writeData3D.c \
+ makeWindow3D.c \
+ ampest3D.c \
+ imaging3D.c \
+ readSnapData3D.c \
+ writeDataIter.c \
+ wallclock_time.c \
+ name_ext.c \
+ verbosepkg.c \
+ atopkge.c \
+ docpkge.c \
+ getpars.c
+
+SRCJ3 = fmute3D.c \
+ getFileInfo3D.c \
+ readData3D.c \
+ applyMute3D.c \
+ writeData3D.c \
+ wallclock_time.c \
+ verbosepkg.c \
+ atopkge.c \
+ docpkge.c \
+ getpars.c
+
+OBJT = $(SRCT:%.c=%.o)
+
+marchenko3D: $(OBJT)
+ $(CC) $(LDFLAGS) $(OPTC) $(CFLAGS) -o marchenko3D $(OBJT) $(LIBS)
+
+OBJJ3 = $(SRCJ3:%.c=%.o)
+
+fmute3D: $(OBJJ3)
+ $(CC) $(LDFLAGS) $(OPTC) $(CFLAGS) -o fmute3D $(OBJJ3) $(LIBS)
+
+install: marchenko3D fmute3D
+ cp marchenko3D $B
+ cp fmute3D $B
+
+clean:
+ rm -f core marchenko3D $(OBJT) fmute3D $(OBJJ3)
+
+realclean: clean
+ rm -f $B/marchenko2 $B/marchenko3D $B/fmute3D
diff --git a/marchenko3D/ampest3D.c b/marchenko3D/ampest3D.c
new file mode 100644
index 0000000000000000000000000000000000000000..d6c6984e8af602880f8234bd2ca60282c0d7a344
--- /dev/null
+++ b/marchenko3D/ampest3D.c
@@ -0,0 +1,365 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <math.h>
+#include "segy.h"
+#include <assert.h>
+#include "par.h"
+#include <genfft.h>
+
+#ifndef COMPLEX
+typedef struct _complexStruct { /* complex number */
+ float r,i;
+} complex;
+#endif/* complex */
+
+#define NINT(x) ((long)((x)>0.0?(x)+0.5:(x)-0.5))
+
+long loptncr(long n);
+long maxest3D(float *data, long nt);
+long readData3D(FILE *fp, float *data, segy *hdrs, long n1);
+void scl_data(float *data, long nsam, long nrec, float scl, float *datout, long nsamout);
+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;
+ 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);
+
+ f1dsamp = (float *)calloc(nys*nxs*ntfft,sizeof(float));
+
+ 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];
+ }
+ }
+ deconv(&f1dsamp[0], &Gd[l*nxs*nys*ntfft], &est[l*nxs*nys*ntfft], nxs*nys, ntfft, dt, eps, reps, 0);
+ }
+ free(f1dsamp);
+
+ return;
+}
+
+/**
+* Calculates the time convolution of two arrays by
+* transforming the arrayis to frequency domain,
+* multiplies the arrays and transform back to time.
+*
+**/
+
+void convol(float *data1, float *data2, float *con, long nrec, long nsam, float dt, long shift)
+{
+ long i, j, n, optn, nfreq, sign;
+ float df, dw, om, tau, scl;
+ float *qr, *qi, *p1r, *p1i, *p2r, *p2i, *rdata1, *rdata2;
+ complex *cdata1, *cdata2, *ccon, 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");
+ ccon = (complex *)malloc(nfreq*nrec*sizeof(complex));
+ if (ccon == 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");
+
+ /* 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], (int)optn, (int)nrec, (int)optn, (int)nfreq, (int)sign);
+ rcmfft(&rdata2[0], &cdata2[0], (int)optn, (int)nrec, (int)optn, (int)nfreq, (int)sign);
+
+ /* apply convolution */
+ p1r = (float *) &cdata1[0];
+ p2r = (float *) &cdata2[0];
+ qr = (float *) &ccon[0].r;
+ p1i = p1r + 1;
+ p2i = p2r + 1;
+ qi = qr + 1;
+ n = nrec*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;
+ }
+ free(cdata1);
+ free(cdata2);
+
+ if (shift) {
+ df = 1.0/(dt*optn);
+ dw = 2*PI*df;
+// tau = 1.0/(2.0*df);
+ tau = dt*(nsam/2);
+ for (j = 0; j < nrec; j++) {
+ om = 0.0;
+ for (i = 0; i < nfreq; i++) {
+ tmp.r = ccon[j*nfreq+i].r*cos(om*tau) + ccon[j*nfreq+i].i*sin(om*tau);
+ tmp.i = ccon[j*nfreq+i].i*cos(om*tau) - ccon[j*nfreq+i].r*sin(om*tau);
+ ccon[j*nfreq+i] = tmp;
+ om += dw;
+ }
+ }
+ }
+
+ /* inverse frequency-time FFT and scale result */
+ sign = 1;
+ scl = 1.0/((float)(optn));
+ crmfft(&ccon[0], &rdata1[0], (int)optn, (int)nrec, (int)nfreq, (int)optn, (int)sign);
+ scl_data(rdata1,optn,nrec,scl,con,nsam);
+
+ free(ccon);
+ free(rdata1);
+ free(rdata2);
+ return;
+}
+
+/**
+* Calculates the time correlation of two arrays by
+* transforming the arrayis to frequency domain,
+* multiply the arrays and transform back to time.
+*
+**/
+
+
+void corr(float *data1, float *data2, float *cov, long nrec, long nsam, float dt, long shift)
+{
+ long i, j, n, optn, nfreq, sign;
+ float df, dw, om, tau, scl;
+ float *qr, *qi, *p1r, *p1i, *p2r, *p2i, *rdata1, *rdata2;
+ complex *cdata1, *cdata2, *ccov, 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");
+ ccov = (complex *)malloc(nfreq*nrec*sizeof(complex));
+ if (ccov == 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");
+
+ /* 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], (int)optn, (int)nrec, (int)optn, (int)nfreq, (int)sign);
+ rcmfft(&rdata2[0], &cdata2[0], (int)optn, (int)nrec, (int)optn, (int)nfreq, (int)sign);
+
+ /* apply correlation */
+ p1r = (float *) &cdata1[0];
+ p2r = (float *) &cdata2[0];
+ qr = (float *) &ccov[0].r;
+ p1i = p1r + 1;
+ p2i = p2r + 1;
+ qi = qr + 1;
+ n = nrec*nfreq;
+ for (j = 0; j < n; j++) {
+ *qr = (*p1r * *p2r + *p1i * *p2i);
+ *qi = (*p1i * *p2r - *p1r * *p2i);
+ qr += 2;
+ qi += 2;
+ p1r += 2;
+ p1i += 2;
+ p2r += 2;
+ p2i += 2;
+ }
+ free(cdata1);
+ free(cdata2);
+
+ /* shift t=0 to middle of time window (nsam/2)*/
+ 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 = ccov[j*nfreq+i].r*cos(om*tau) + ccov[j*nfreq+i].i*sin(om*tau);
+ tmp.i = ccov[j*nfreq+i].i*cos(om*tau) - ccov[j*nfreq+i].r*sin(om*tau);
+ ccov[j*nfreq+i] = tmp;
+ om += dw;
+ }
+ }
+ }
+
+ /* inverse frequency-time FFT and scale result */
+ sign = 1;
+ scl = 1.0/(float)optn;
+ crmfft(&ccov[0], &rdata1[0], (int)optn, (int)nrec, (int)nfreq, (int)optn, (int)sign);
+ scl_data(rdata1,optn,nrec,scl,cov,nsam);
+
+ free(ccov);
+ free(rdata1);
+ free(rdata2);
+ return;
+}
+
+void pad_data(float *data, long nsam, long nrec, long nsamout, float *datout)
+{
+ long it,ix;
+ for (ix=0;ix<nrec;ix++) {
+ for (it=0;it<nsam;it++)
+ datout[ix*nsamout+it]=data[ix*nsam+it];
+ for (it=nsam;it<nsamout;it++)
+ datout[ix*nsamout+it]=0.0;
+ }
+}
+
+void scl_data(float *data, long nsam, long nrec, float scl, float *datout, long nsamout)
+{
+ long it,ix;
+ for (ix = 0; ix < nrec; ix++) {
+ 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/ampest3D2.c b/marchenko3D/ampest3D2.c
new file mode 100644
index 0000000000000000000000000000000000000000..db7dbac8bb8bef709c135f56adc273a9de250aee
--- /dev/null
+++ b/marchenko3D/ampest3D2.c
@@ -0,0 +1,94 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <math.h>
+#include "segy.h"
+#include <assert.h>
+#include "par.h"
+#include <genfft.h>
+
+#ifndef COMPLEX
+typedef struct _complexStruct { /* complex number */
+ float r,i;
+} complex;
+#endif/* complex */
+
+#define NINT(x) ((long)((x)>0.0?(x)+0.5:(x)-0.5))
+
+long loptncr(long n);
+long maxest3D(float *data, long nt);
+long readData3D(FILE *fp, float *data, segy *hdrs, long n1);
+
+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 Wmax, Amax, *wavelet, *At, scl, sclt;
+ FILE *fp_wav;
+ complex *Gdf, *f1df, *Af, *cwav, tmp;
+ segy *hdrs_wav;
+
+ nfreq = ntfft/2+1;
+ scl = dx*dy;
+ sclt = 1.0*dt/((float)ntfft);
+
+ Gdf = (complex *)malloc(nfreq*sizeof(complex));
+ f1df = (complex *)malloc(nfreq*sizeof(complex));
+ Af = (complex *)calloc(nfreq,sizeof(complex));
+ At = (float *)malloc(ntfft*sizeof(complex));
+ wavelet = (float *)calloc(ntfft,sizeof(complex));
+
+ if (file_wav == NULL) {
+ Wmax = 1.0;
+ }
+ else {
+ hdrs_wav = (segy *)calloc(1, sizeof(segy));
+ fp_wav = fopen(file_wav, "r");
+ readData3D(fp_wav, wavelet, hdrs_wav, 0);
+ fclose(fp_wav);
+ cwav = (complex *)calloc(nfreq,sizeof(complex));
+ rc1fft(wavelet,cwav,(int)ntfft,-1);
+ for (i=0; i<nfreq; i++) {
+ tmp.r = cwav[i].r*cwav[i].r - cwav[i].i*cwav[i].i;
+ tmp.i = 2*cwav[i].r*cwav[i].i;
+ cwav[i].r = tmp.r*sclt;
+ cwav[i].i = tmp.i*sclt;
+ }
+ cr1fft(cwav,wavelet,(int)ntfft,1);
+ Wmax = maxest3D(wavelet,ntfft);
+ vmess("Wmax: %.3e",Wmax);
+ }
+
+ for (l = 0; l < Nfoc; l++) {
+ for (i = 0; i < npos; i++) {
+ ix = ixpos[i];
+ rc1fft(&Gd[l*nxs*nys*ntfft+i*ntfft],Gdf,(int)ntfft,-1);
+ rc1fft(&f1d[l*nxs*nys*ntfft+ix*ntfft],f1df,(int)ntfft,-1);
+ for (iw=0; iw<nfreq; iw++) {
+ Af[iw].r += scl*sclt*(f1df[iw].r*Gdf[iw].r-f1df[iw].i*Gdf[iw].i);
+ Af[iw].i += scl*sclt*(f1df[iw].r*Gdf[iw].i+f1df[iw].i*Gdf[iw].r);
+ }
+ }
+ cr1fft(&Af[0],At,(int)ntfft,1);
+ Amax = maxest3D(At,ntfft);
+ ampest[l] = sqrtf(Wmax/Amax);
+ memset(&Af[0],0.0, sizeof(float)*2*nfreq);
+ }
+ free(Gdf);free(f1df);free(Af);free(At);free(cwav); free(wavelet);
+
+ 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;
+}
diff --git a/marchenko3D/applyMute.c b/marchenko3D/applyMute.c
new file mode 100644
index 0000000000000000000000000000000000000000..df98e8bc39f8b132c10b237f7e3e01f3167cdf7d
--- /dev/null
+++ b/marchenko3D/applyMute.c
@@ -0,0 +1,115 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <math.h>
+#include <assert.h>
+
+#ifndef MAX
+#define MAX(x,y) ((x) > (y) ? (x) : (y))
+#endif
+#ifndef MIN
+#define MIN(x,y) ((x) < (y) ? (x) : (y))
+#endif
+#define NINT(x) ((int)((x)>0.0?(x)+0.5:(x)-0.5))
+
+void applyMute( float *data, int *mute, int smooth, int above, int Nfoc, int nxs, int nt, int *ixpos, int npos, int shift)
+{
+ int i, j, l, isyn;
+ float *costaper, scl;
+ int imute, tmute;
+
+ if (smooth) {
+ costaper = (float *)malloc(smooth*sizeof(float));
+ scl = M_PI/((float)smooth);
+ for (i=0; i<smooth; i++) {
+ costaper[i] = 0.5*(1.0+cos((i+1)*scl));
+ }
+ }
+
+ for (isyn = 0; isyn < Nfoc; isyn++) {
+ if (above==1) {
+ for (i = 0; i < npos; i++) {
+ imute = ixpos[i];
+ tmute = mute[isyn*nxs+imute];
+ for (j = 0; j < MAX(0,tmute-shift-smooth); j++) {
+ data[isyn*nxs*nt+i*nt+j] = 0.0;
+ }
+ for (j = MAX(0,tmute-shift-smooth),l=0; j < MAX(0,tmute-shift); j++,l++) {
+ data[isyn*nxs*nt+i*nt+j] *= costaper[smooth-l-1];
+ }
+ }
+ }
+ else if (above==0){
+ for (i = 0; i < npos; i++) {
+ imute = ixpos[i];
+ tmute = mute[isyn*nxs+imute];
+ if (tmute >= nt/2) {
+ memset(&data[isyn*nxs*nt+i*nt],0, sizeof(float)*nt);
+ continue;
+ }
+ for (j = MAX(0,tmute-shift),l=0; j < MAX(0,tmute-shift+smooth); j++,l++) {
+ data[isyn*nxs*nt+i*nt+j] *= costaper[l];
+ }
+ for (j = MAX(0,tmute-shift+smooth)+1; j < MIN(nt,nt+1-tmute+shift-smooth); j++) {
+ data[isyn*nxs*nt+i*nt+j] = 0.0;
+ }
+ for (j = MIN(nt,nt-tmute+shift-smooth),l=0; j < MIN(nt,nt-tmute+shift); j++,l++) {
+ data[isyn*nxs*nt+i*nt+j] *= costaper[smooth-l-1];
+ }
+ }
+ }
+ else if (above==-1){
+ for (i = 0; i < npos; i++) {
+ imute = ixpos[i];
+ tmute = mute[isyn*nxs+imute];
+ for (j = MAX(0,tmute-shift),l=0; j < MAX(0,tmute-shift+smooth); j++,l++) {
+ data[isyn*nxs*nt+i*nt+j] *= costaper[l];
+ }
+ for (j = MAX(0,tmute-shift+smooth); j < nt; j++) {
+ data[isyn*nxs*nt+i*nt+j] = 0.0;
+ }
+ }
+ }
+ else if (above==4) { //Psi gate which is the inverse of the Theta gate (above=0)
+ for (i = 0; i < npos; i++) {
+ imute = ixpos[i];
+ tmute = mute[isyn*nxs+imute];
+ for (j = MAX(0,tmute-shift-smooth),l=0; j < MAX(0,tmute-shift); j++,l++) {
+ data[isyn*nxs*nt+i*nt+j] *= costaper[smooth-l-1];
+ }
+ for (j = 0; j < MAX(0,tmute-shift-smooth-1); j++) {
+ data[isyn*nxs*nt+i*nt+j] = 0.0;
+ }
+ for (j = MIN(nt,nt+1-tmute+shift+smooth); j < nt; j++) {
+ data[isyn*nxs*nt+i*nt+j] = 0.0;
+ }
+ for (j = MIN(nt,nt-tmute+shift),l=0; j < MIN(nt,nt-tmute+shift+smooth); j++,l++) {
+ data[isyn*nxs*nt+i*nt+j] *= costaper[l];
+ }
+ }
+ }
+ else if (above==2){//Separates the direct part of the wavefield from the coda
+ for (i = 0; i < npos; i++) {
+ imute = ixpos[i];
+ tmute = mute[isyn*nxs+imute];
+ for (j = 0; j < MAX(0,tmute-shift-smooth); j++) {
+ data[isyn*nxs*nt+i*nt+j] = 0.0;
+ }
+ for (j = MAX(0,tmute-shift-smooth),l=0; j < MAX(0,tmute-shift); j++,l++) {
+ data[isyn*nxs*nt+i*nt+j] *= costaper[smooth-l-1];
+ }
+ for (j = MAX(0,tmute+shift),l=0; j < MAX(0,tmute+shift+smooth); j++,l++) {
+ data[isyn*nxs*nt+i*nt+j] *= costaper[l];
+ }
+ for (j = MAX(0,tmute+shift+smooth); j < nt; j++) {
+ data[isyn*nxs*nt+i*nt+j] = 0.0;
+ }
+ }
+ }
+ }
+
+ if (smooth) free(costaper);
+
+ return;
+}
+
diff --git a/marchenko3D/applyMute3D.c b/marchenko3D/applyMute3D.c
new file mode 100644
index 0000000000000000000000000000000000000000..82adead728e57f820e49dbf3ea14b337ae6f64dd
--- /dev/null
+++ b/marchenko3D/applyMute3D.c
@@ -0,0 +1,115 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <math.h>
+#include <assert.h>
+
+#ifndef MAX
+#define MAX(x,y) ((x) > (y) ? (x) : (y))
+#endif
+#ifndef MIN
+#define MIN(x,y) ((x) < (y) ? (x) : (y))
+#endif
+#define NINT(x) ((long)((x)>0.0?(x)+0.5:(x)-0.5))
+
+void applyMute3D( float *data, long *mute, long smooth, long above, long Nfoc, long nxs, long nt, long *ixpos, long npos, long shift)
+{
+ long ix, iy, i, j, l, isyn;
+ float *costaper, scl;
+ long imute, tmute;
+
+ if (smooth) {
+ costaper = (float *)malloc(smooth*sizeof(float));
+ scl = M_PI/((float)smooth);
+ for (ix=0; ix<smooth; ix++) {
+ costaper[ix] = 0.5*(1.0+cos((ix+1)*scl));
+ }
+ }
+
+ for (isyn = 0; isyn < Nfoc; isyn++) {
+ if (above==1) {
+ for (i = 0; i < npos; i++) {
+ imute = ixpos[i];
+ tmute = mute[isyn*nxs+imute];
+ for (j = 0; j < MAX(0,tmute-shift-smooth); j++) {
+ data[isyn*nxs*nt+i*nt+j] = 0.0;
+ }
+ for (j = MAX(0,tmute-shift-smooth),l=0; j < MAX(0,tmute-shift); j++,l++) {
+ data[isyn*nxs*nt+i*nt+j] *= costaper[smooth-l-1];
+ }
+ }
+ }
+ else if (above==0){
+ for (i = 0; i < npos; i++) {
+ imute = ixpos[i];
+ tmute = mute[isyn*nxs+imute];
+ if (tmute >= nt/2) {
+ memset(&data[isyn*nxs*nt+i*nt],0, sizeof(float)*nt);
+ continue;
+ }
+ for (j = MAX(0,tmute-shift),l=0; j < MAX(0,tmute-shift+smooth); j++,l++) {
+ data[isyn*nxs*nt+i*nt+j] *= costaper[l];
+ }
+ for (j = MAX(0,tmute-shift+smooth)+1; j < MIN(nt,nt+1-tmute+shift-smooth); j++) {
+ data[isyn*nxs*nt+i*nt+j] = 0.0;
+ }
+ for (j = MIN(nt,nt-tmute+shift-smooth),l=0; j < MIN(nt,nt-tmute+shift); j++,l++) {
+ data[isyn*nxs*nt+i*nt+j] *= costaper[smooth-l-1];
+ }
+ }
+ }
+ else if (above==-1){
+ for (i = 0; i < npos; i++) {
+ imute = ixpos[i];
+ tmute = mute[isyn*nxs+imute];
+ for (j = MAX(0,tmute-shift),l=0; j < MAX(0,tmute-shift+smooth); j++,l++) {
+ data[isyn*nxs*nt+i*nt+j] *= costaper[l];
+ }
+ for (j = MAX(0,tmute-shift+smooth); j < nt; j++) {
+ data[isyn*nxs*nt+i*nt+j] = 0.0;
+ }
+ }
+ }
+ else if (above==4) { //Psi gate which is the inverse of the Theta gate (above=0)
+ for (i = 0; i < npos; i++) {
+ imute = ixpos[i];
+ tmute = mute[isyn*nxs+imute];
+ for (j = MAX(0,tmute-shift-smooth),l=0; j < MAX(0,tmute-shift); j++,l++) {
+ data[isyn*nxs*nt+i*nt+j] *= costaper[smooth-l-1];
+ }
+ for (j = 0; j < MAX(0,tmute-shift-smooth-1); j++) {
+ data[isyn*nxs*nt+i*nt+j] = 0.0;
+ }
+ for (j = MIN(nt,nt+1-tmute+shift+smooth); j < nt; j++) {
+ data[isyn*nxs*nt+i*nt+j] = 0.0;
+ }
+ for (j = MIN(nt,nt-tmute+shift),l=0; j < MIN(nt,nt-tmute+shift+smooth); j++,l++) {
+ data[isyn*nxs*nt+i*nt+j] *= costaper[l];
+ }
+ }
+ }
+ else if (above==2){//Separates the direct part of the wavefield from the coda
+ for (i = 0; i < npos; i++) {
+ imute = ixpos[i];
+ tmute = mute[isyn*nxs+imute];
+ for (j = 0; j < MAX(0,tmute-shift-smooth); j++) {
+ data[isyn*nxs*nt+i*nt+j] = 0.0;
+ }
+ for (j = MAX(0,tmute-shift-smooth),l=0; j < MAX(0,tmute-shift); j++,l++) {
+ data[isyn*nxs*nt+i*nt+j] *= costaper[smooth-l-1];
+ }
+ for (j = MAX(0,tmute+shift),l=0; j < MAX(0,tmute+shift+smooth); j++,l++) {
+ data[isyn*nxs*nt+i*nt+j] *= costaper[l];
+ }
+ for (j = MAX(0,tmute+shift+smooth); j < nt; j++) {
+ data[isyn*nxs*nt+i*nt+j] = 0.0;
+ }
+ }
+ }
+ }
+
+ if (smooth) free(costaper);
+
+ return;
+}
+
diff --git a/marchenko3D/atopkge.c b/marchenko3D/atopkge.c
new file mode 120000
index 0000000000000000000000000000000000000000..5107e2b2ccd382ede29d397838d8fad88126a516
--- /dev/null
+++ b/marchenko3D/atopkge.c
@@ -0,0 +1 @@
+../utils/atopkge.c
\ No newline at end of file
diff --git a/marchenko3D/demo/README b/marchenko3D/demo/README
new file mode 100644
index 0000000000000000000000000000000000000000..f5a7c129e2a168d2325d162c9f886a2cc27ae43b
--- /dev/null
+++ b/marchenko3D/demo/README
@@ -0,0 +1,4 @@
+The scripts to reproduce the Figures in the manuscript can be found in the directory oneD. The oneD/README explains how to run the scripts.
+
+A more complicated model can be found in the directory twoD and will takes several hours to model the reflection data.
+
diff --git a/marchenko3D/demo/ScientificReports/NatureSnapshots.tex b/marchenko3D/demo/ScientificReports/NatureSnapshots.tex
new file mode 100644
index 0000000000000000000000000000000000000000..dc80d8cbb6bf25a0446c6f1be7e2cb4eeec777dd
--- /dev/null
+++ b/marchenko3D/demo/ScientificReports/NatureSnapshots.tex
@@ -0,0 +1,194 @@
+\documentclass[10pt]{article}
+\usepackage{graphpap, epsfig, amssymb, rotating, graphpap, pifont}
+\usepackage{amsmath}
+\usepackage{pstricks,placeins,pstricks-add}
+\usepackage{hyperref}
+%\usepackage{pst-node, pst-plot}
+\usepackage{afterpage}
+\usepackage{psfrag}
+\usepackage[text={16cm,24cm},centering]{geometry}
+
+\pagenumbering{gobble}% Remove page numbers (and reset to 1)
+
+% don't complain about overfull vboxes less than 5 points
+\vfuzz = 5pt
+\sloppy
+
+% now define realbold and undertilde
+\def\realbold#1{{\mbox{\boldmath $\bf #1$}}}
+\def\realboldcal#1{{\mbox{\boldmath $\bf \cal #1$}}}
+\def\@undertilde#1{\oalign{{\realbold{#1}}\crcr\hidewidth
+\vbox to .2ex{\hbox{\bf\char126}\vss}\hidewidth}}
+
+%Define helvetica bold for discrete vectors and matrices
+\DeclareMathAlphabet{\mathhelb}{OT1}{phv}{b}{n}
+\DeclareMathAlphabet{\mathhelbo}{OT1}{phv}{b}{sl}
+
+\def\vector#1{{\mbox{\boldmath $#1$}}}%
+\def\tensor#1{\realbold{#1}}%
+\def\op#1{\mathcal{#1}}%
+
+\def\dvector#1{\mathhelbo{#1}}%
+\def\dtensor#1{\mathhelb{#1}}%
+\def\dop#1{\mathhelb{#1}}%
+
+\let\BM\realbold
+
+\definecolor{LightBlue}{rgb}{0.10,0.55,1.0}
+\definecolor{LightBlue}{rgb}{0.0,1.0,1.0}
+
+% set unitlength to 1cm for picture environments
+\setlength{\unitlength}{1cm}
+
+% spacing between lines
+\renewcommand{\baselinestretch}{1.08}
+
+%Jan's definitions
+\newcommand{\dd}{\mathrm{d}}
+\newcommand{\x}{\vector x}
+\newcommand{\dA}{\dd^2\x}
+\newcommand{\dV}{\dd^3\x}
+\newcommand{\pD}{\partial D}
+\newcommand{\bx}{\mathbf{x}}
+
+
+\begin{document}
+
+\title{Note: Snapshots for article}
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%% Figure with different time axis annotation
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\begin{figure}[ht]
+\begin{pspicture}(16,22)(0,0)
+%time axis top row
+%\put(-1.2, 17.5){$+t$}
+%\put(-1.2, 16.1){$-t$}
+\put(-1.5, 16.88){$t=0$}
+\psline{->}(-1.7,15.8)(-1.7,17.8) \rput{L}(-1.9, 16.6){ time}
+% time axis gray-scales
+\put(-1.2, 14.0){$-t_2$}
+\put(-1.2, 11.5){$-t_1$}
+\put(-1.5, 9.0){$t=0$}
+\put(-1.2, 6.5){$+t_1$}
+\put(-1.2, 4.0){$+t_2$}
+\psline{->}(-1.7,14.5)(-1.7,3.5) \rput{L}(-1.9, 8.8){ time}
+%
+%frame wiggle traces
+\psframe(-0.5,15.60)(3.45,18.2)
+\psframe(3.6,15.60)(7.55,18.2)
+\psframe(7.7,15.60)(11.65,18.2)
+%\psframe(11.8,15.60)(15.75,18.2)
+%
+% blue background on wiggles
+\pscurve[linecolor=LightBlue,linewidth=4pt]{c-c}(-0.4,16.3)(1.5,16.55)(3.4,16.3)
+\pscurve[linecolor=LightBlue,linewidth=4pt]{c-c}(3.7,16.3)(5.6,16.55)(7.5,16.3)
+\pscurve[linecolor=LightBlue,linewidth=4pt]{c-c}(7.8,16.3)(9.7,16.55)(11.6,16.3)
+%\pscurve[linecolor=LightBlue,linewidth=4pt]{c-c}(11.9,16.3)(13.8,16.55)(15.7,16.3)
+%
+\put(-0.57, 14.8){\epsfig{file={inj_rate_surf_dx0.5_rvz_wiggle}.eps, width=4.09cm }}
+\put(3.53, 14.8){\epsfig{file={inj_rate_surf_dx0.5_rvz_wiggle}.eps, width=4.09cm }}
+\put(7.63, 14.8){\epsfig{file={pplus_wiggle}.eps, width=4.09cm }}
+%\put(11.73, 14.8){\epsfig{file={pplus_wiggle}.eps, width=4.09cm }}
+%
+\put(-0.5, 12.0){\epsfig{file={snapinj_planevzvxsum_-0.60}.eps, width=3.9cm }}
+\put(3.6, 12.0){\epsfig{file={snapinj_surf_-0.60}.eps, width=3.9cm }}
+\put(7.7, 12.0){\epsfig{file={snapinj_f2_-0.60}.eps, width=3.9cm }}
+\put(11.8, 12.0){\epsfig{file={snapinj_f2sum_0.60}.eps, width=3.9cm }}
+%
+\put(-0.5, 9.5){\epsfig{file={snapinj_planevzvxsum_-0.30}.eps, width=3.9cm }}
+\put(3.6, 9.5){\epsfig{file={snapinj_surf_-0.30}.eps, width=3.9cm }}
+\put(7.7, 9.5){\epsfig{file={snapinj_f2_-0.30}.eps, width=3.9cm }}
+\put(11.8, 9.5){\epsfig{file={snapinj_f2sum_0.30}.eps, width=3.9cm }}
+%
+\put(-0.5, 7.0){\epsfig{file={snapinj_planevzvxsum_0.00}.eps, width=3.9cm }}
+\put(3.6, 7.0){\epsfig{file={snapinj_surf_0.00}.eps, width=3.9cm }}
+\put(7.7, 7.0){\epsfig{file={snapinj_f2_0.00}.eps, width=3.9cm }}
+\put(11.8, 7.0){\epsfig{file={snapinj_f2_0.00}.eps, width=3.9cm }}
+%
+\put(-0.5, 4.5){\epsfig{file={snapinj_planevzvxsum_0.30}.eps, width=3.9cm }}
+\put(3.6, 4.5){\epsfig{file={snapinj_surf_0.30}.eps, width=3.9cm }}
+\put(7.7, 4.5){\epsfig{file={snapinj_f2_0.30}.eps, width=3.9cm }}
+\put(11.8, 4.5){\epsfig{file={snapinj_f2sum_0.30}.eps, width=3.9cm }}
+%
+\put(-0.5, 2.0){\epsfig{file={snapinj_planevzvxsum_0.60}.eps, width=3.9cm }}
+\put(3.6, 2.0){\epsfig{file={snapinj_surf_0.60}.eps, width=3.9cm }}
+\put(7.7, 2.0){\epsfig{file={snapinj_f2_0.60}.eps, width=3.9cm }}
+\put(11.8, 2.0){\epsfig{file={snapinj_f2sum_0.60}.eps, width=3.9cm }}
+%
+% source position
+\multirput(1.44,13.75)(4.1,0){4}{\psdot[linecolor=yellow,fillcolor=yellow,dotstyle=o,dotsize=4pt](0,0)\put(0.1,0.0){${\bf s}$}}
+\multirput(1.44,11.25)(4.1,0){4}{\psdot[linecolor=yellow,fillcolor=yellow,dotstyle=o,dotsize=4pt](0,0)\put(0.1,0.0){${\bf s}$}}
+\multirput(1.44,8.75)(4.1,0){4}{\put(0.1,0.0){${\bf s}$}}
+\multirput(1.44,6.25)(4.1,0){4}{\psdot[linecolor=yellow,fillcolor=yellow,dotstyle=o,dotsize=4pt](0,0)\put(0.1,0.0){${\bf s}$}}
+\multirput(1.44,3.75)(4.1,0){4}{\psdot[linecolor=yellow,fillcolor=yellow,dotstyle=o,dotsize=4pt](0,0)\put(0.1,0.0){${\bf s}$}}
+%
+%source function
+\rput(1.44, 17.9){\psframebox[fillstyle=solid]{$V({\bf x},{\bf s},-t)$}}
+\rput(5.54, 17.9){\psframebox[fillstyle=solid]{$V({\bf x},{\bf s},-t)$}}
+\rput(9.64, 17.9){\psframebox[fillstyle=solid]{$F({\bf x},{\bf s},t)$}}
+%\rput(13.74, 17.9){\psframebox[fillstyle=solid]{$F({\bf x},{\bf s},t)$}}
+%
+%times in snapshots
+%\multirput(2.78,13.03)(4.1,0){4}{\put(0.0,0.0){$-t_2$}}
+%\multirput(2.78,10.53)(4.1,0){4}{\put(0.0,0.0){$-t_1$}}
+%\multirput(2.78,8.03)(4.1,0){4}{\put(-0.3,0.0){$t=0$}}
+%\multirput(2.78,5.53)(4.1,0){4}{\put(0.2,0.0){$t_1$}}
+%\multirput(2.78,3.03)(4.1,0){4}{\put(0.2,0.0){$t_2$}}
+%
+% Source postions (red dots) at top snapshots
+\psset{arrowscale=1.1,ArrowFill=true,linecolor=red,linestyle=none}
+\psline[ArrowInside=-*,ArrowInsidePos=0.0,ArrowInsideNo=13]{-}(3.4,15.4)(3.4,12.7)
+\psline[ArrowInside=-*,ArrowInsidePos=0.0,ArrowInsideNo=13]{-}(-0.5,15.4)(-0.5,12.7)
+\psline[ArrowInside=-*,ArrowInsidePos=0.0,ArrowInsideNo=21]{-}(-0.67,15.22)(3.5,15.22)
+\psline[ArrowInside=-*,ArrowInsidePos=0.0,ArrowInsideNo=21]{-}(-0.67,12.80)(3.5,12.80)
+%
+\psline[ArrowInside=-*,ArrowInsidePos=0.0,ArrowInsideNo=21]{-}(3.43,15.22)(7.6,15.22)
+\psline[ArrowInside=-*,ArrowInsidePos=0.0,ArrowInsideNo=21]{-}(7.53,15.22)(11.7,15.22)
+%\psline[ArrowInside=-*,ArrowInsidePos=0.0,ArrowInsideNo=21]{-}(11.63,15.22)(15.8,15.22)
+%
+% source arrows
+\psset{arrowscale=1.0,ArrowFill=true,linecolor=black,linestyle=solid}
+\multirput(-0.37,15.6)(0.184,0){21}{\psline{->}(0.0,0.0)(0.0,-0.36)}
+\multirput(3.73,15.6)(0.184,0){21}{\psline{->}(0.0,0.0)(0.0,-0.36)}
+\multirput(7.83,15.6)(0.184,0){21}{\psline{->}(0.0,0.0)(0.0,-0.36)}
+%\multirput(11.93,15.6)(0.184,0){21}{\psline{->}(0.0,0.0)(0.0,-0.36)}
+%
+%bottom labels
+\put(0.3, 2.0){omnidirectional}
+\put(0.4, 1.6){time reversal}
+\put(1.3, 0.8){(a)}
+\put(4.6, 2.0){single-sided}
+\put(4.5, 1.6){time reversal}
+\put(5.4, 0.8){(b)}
+\put(8.6, 2.0){single-sided}
+\put(8.8, 1.6){focusing}
+\put(9.5, 0.8){(c)}
+\put(12.8, 2.0){symmetrized}
+\put(12.9, 1.6){single-sided}
+\put(13.1, 1.2){focusing}
+\put(13.6, 0.8){(d)}
+%
+% x-axis top row
+\multirput(2.6,18.35)(4.1,0.0){3}{\psline{->}(0.0,0.0)(0.5,0.0) \put(0.5,-0.05){$x$}}
+% x-axis snapshots
+\multirput(2.6,15.05)(0,-2.5){5}{\psline{->}(0.0,0.0)(0.5,0.0) \put(0.5,-0.05){$x$}}
+\multirput(6.7,15.05)(0,-2.5){5}{\psline{->}(0.0,0.0)(0.5,0.0) \put(0.5,-0.05){$x$}}
+\multirput(10.8,15.05)(0,-2.5){5}{\psline{->}(0.0,0.0)(0.5,0.0) \put(0.5,-0.05){$x$}}
+\multirput(14.9,15.05)(0,-2.5){5}{\psline{->}(0.0,0.0)(0.5,0.0) \put(0.5,-0.05){$x$}}
+%
+% z-axis snapshots
+\multirput(-0.3,13.2)(0,-2.5){5}{\psline{->}(0.0,0.0)(0.0,-0.5) \put(-0.1,-0.7){$z$}}
+\multirput(3.8,13.2)(0,-2.5){5}{\psline{->}(0.0,0.0)(0.0,-0.5) \put(-0.1,-0.7){$z$}}
+\multirput(7.9,13.2)(0,-2.5){5}{\psline{->}(0.0,0.0)(0.0,-0.5) \put(-0.1,-0.7){$z$}}
+\multirput(12.0,13.2)(0,-2.5){5}{\psline{->}(0.0,0.0)(0.0,-0.5) \put(-0.1,-0.7){$z$}}
+%
+%\psgrid
+\end{pspicture}
+%\caption{Different... }\label{model}
+\end{figure}
+
+
+
+\end{document}
+
diff --git a/marchenko3D/demo/ScientificReports/README b/marchenko3D/demo/ScientificReports/README
new file mode 100644
index 0000000000000000000000000000000000000000..cbecad73b225273369f72c33d01774720013e790
--- /dev/null
+++ b/marchenko3D/demo/ScientificReports/README
@@ -0,0 +1,61 @@
+The scripts in this directory create Figure 1 of the paper in Scientific Reports
+
+Forward model the data
+1a) model.scr computes the gridded model
+ => tutodel_dx0.5_ro.su, tutodel_dx0.5_cp.su
+1b) shots_slurm.scr creates jobs to model the shots and submit jobs to slurm workload manager
+ => shotsnew/shots_x*_rp.su : ranging from -3000 to 3000 with dxshot=10
+ => to model one shots takes ~25 minutes, 601 shots are modeled
+1c) check.scr after the jobs on shots_*.scr are finished checks if all shots are there
+2) direct.scr creates the direct arrival to be removed from the shots
+ => direct_rp.su
+3) remove_direct.scr remove the direct wave from the shots
+ => shotsnew/refl_rp.su
+4) initialFocus.scr model G_d the intitial focusing function
+ => iniFocusz800x0_rp.su
+
+Apply the marchenko method to compute f2
+5) marchenko.scr perform the Marchenko scheme
+ => f2.su, f1plus.su, f1min.su, Gmin.su, Gplus.su, pgreen.su
+
+Backpropagation of the recorded data from one side and all-sides: snaphots of the wavefield are recorded
+6) back_injrate_planes.scr
+ => snapinj_planevzvxsum_sp.su : backpropagated from all 4 sides of the model
+ => snapinj_surf_sp.su : backpropagated from surface only
+
+Backpropagation of the Marchenko computed result
+7) backpropf2.scr
+ => snapinj_f2_sp.su : backpropagated f2
+
+Generate the postscript files of Figure 1
+8) epsBack.scr
+ => results of backpropagation from all 4 sides: first column of Figure 1
+snapinj_planevzvxsum_-0.60.eps
+snapinj_planevzvxsum_-0.30.eps
+snapinj_planevzvxsum_-0.03.eps
+snapinj_planevzvxsum_0.00.eps
+snapinj_planevzvxsum_0.03.eps
+snapinj_planevzvxsum_0.30.eps
+snapinj_planevzvxsum_0.60.eps
+ => results of backpropagation from surface only: second column of Figure 1
+snapinj_surf_-0.60.eps
+snapinj_surf_-0.30.eps
+snapinj_surf_-0.03.eps
+snapinj_surf_0.00.eps
+snapinj_surf_0.03.eps
+snapinj_surf_0.30.eps
+snapinj_surf_0.60.eps
+ => results of backpropagation of f2 from surface only: third column of Figure 1
+snapinj_f2_-0.60.eps
+snapinj_f2_-0.30.eps
+snapinj_f2_-0.03.eps
+snapinj_f2_0.00.eps
+snapinj_f2_0.03.eps
+snapinj_f2_0.30.eps
+snapinj_f2_0.60.eps
+ => results of symmetrized backpropagation of f2 from surface only: fourth column of Figure 1
+snapinj_f2sum_0.00.eps
+snapinj_f2sum_0.03.eps
+snapinj_f2sum_0.30.eps
+snapinj_f2sum_0.60.eps
+
diff --git a/marchenko3D/demo/ScientificReports/back_injrate_planes.scr b/marchenko3D/demo/ScientificReports/back_injrate_planes.scr
new file mode 100755
index 0000000000000000000000000000000000000000..e5e0ebdb86d52a9334a3f9f36e886aa3caa9e106
--- /dev/null
+++ b/marchenko3D/demo/ScientificReports/back_injrate_planes.scr
@@ -0,0 +1,141 @@
+#!/bin/bash
+
+export PATH=:$HOME/src/OpenSource/bin:$HOME/bin:$PATH:
+
+export OMP_NUM_THREADS=8
+dt=0.00050
+dx=2.5
+
+dt=0.00010
+dx=0.5
+
+makewave fp=30 dt=$dt file_out=wave.su nt=4096 t0=0.1 scale=1
+./model.scr $dx
+ntr=$(echo "scale=0; 1+6000/${dx}" | bc -l)
+echo $ntr
+
+ix1a=1
+ix1b=$(echo "scale=0; ${ix1a}+6000/${dx}" | bc -l)
+ix2a=$(echo "scale=0; ${ix1b}+1" | bc -l)
+ix2b=$(echo "scale=0; ${ix2a}+6000/${dx}" | bc -l)
+ix3a=$(echo "scale=0; ${ix2b}+1" | bc -l)
+ix3b=$(echo "scale=0; ${ix3a}+1200/${dx}" | bc -l)
+ix4a=$(echo "scale=0; ${ix3b}+1" | bc -l)
+ix4b=$(echo "scale=0; ${ix4a}+1200/${dx}" | bc -l)
+
+file_cp=tutodel_dx${dx}_cp.su
+file_ro=tutodel_dx${dx}_ro.su
+
+#model data to be propagated back into medium
+fdelmodc \
+ file_cp=$file_cp ischeme=1 iorder=4 \
+ file_den=$file_ro \
+ file_src=wave.su \
+ file_rcv=inj_rate_plane_dx${dx}.su \
+ src_type=1 \
+ src_injectionrate=1 \
+ rec_type_vz=1 \
+ rec_type_vx=1 \
+ rec_type_p=0 \
+ rec_int_vz=2 \
+ rec_int_vx=2 \
+ dtrcv=$dt \
+ rec_delay=0.1 \
+ verbose=1 \
+ tmod=4.4000 \
+ xrcv1=-3000,-3000,-3000,3000 xrcv2=3000,3000,-3000,3000 zrcv1=0,1200,0,0 zrcv2=0,1200,1200,1200 \
+ dxrcv=$dx,$dx,0,0 dzrcv=0,0,$dx,$dx \
+ xsrc=0 zsrc=800 \
+ ntaper=400 \
+ left=2 right=2 top=2 bottom=2
+
+
+##################################
+# back propagate from all sides
+# scale with -1 for outward pointing vector
+scale=-1.0
+suwind key=tracl min=$ix1a max=$ix1b < inj_rate_plane_dx${dx}_rvz.su | sugain scale=$scale > inj_rate_plane_dx${dx}vz.su
+suwind key=tracl min=$ix2a max=$ix2b < inj_rate_plane_dx${dx}_rvz.su >> inj_rate_plane_dx${dx}vz.su
+
+suwind < inj_rate_plane_dx${dx}_rvx.su key=tracl min=$ix3a max=$ix3b | sugain scale=$scale > inj_rate_plane_dx${dx}vx.su
+suwind < inj_rate_plane_dx${dx}_rvx.su key=tracl min=$ix4a max=$ix4b >> inj_rate_plane_dx${dx}vx.su
+
+# at 4.3000 seconds (tmod - rec_delay) the focus is at t=0
+fdelmodc \
+ file_cp=$file_cp ischeme=1 iorder=4 \
+ file_den=$file_ro \
+ file_src=inj_rate_plane_dx${dx}vz.su \
+ file_snap=snapinj_planevz.su \
+ grid_dir=1 \
+ src_type=1 \
+ src_injectionrate=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_p=0 \
+ dtrcv=$dt \
+ rec_delay=0.0 \
+ verbose=3 \
+ tmod=5.004 \
+ tsnap1=3.000 tsnap2=5.00 dtsnap=0.01 \
+ xsnap1=-1000 xsnap2=1000 dxsnap=2.5 dzsnap=2.5 \
+ sna_type_vz=0 \
+ sna_type_p=1 \
+ ntaper=400 \
+ left=2 right=2 top=2 bottom=2
+
+# tsnap1=4.200 tsnap2=4.50 dtsnap=0.004 \
+
+fdelmodc \
+ file_cp=$file_cp ischeme=1 iorder=4 \
+ file_den=$file_ro \
+ file_src=inj_rate_plane_dx${dx}vx.su \
+ file_snap=snapinj_planevx.su \
+ grid_dir=1 \
+ src_type=1 \
+ src_injectionrate=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_p=0 \
+ dtrcv=$dt \
+ rec_delay=0.0 \
+ verbose=1 \
+ tmod=5.004 \
+ tsnap1=3.000 tsnap2=5.00 dtsnap=0.01 \
+ xsnap1=-1000 xsnap2=1000 dxsnap=2.5 dzsnap=2.5 \
+ sna_type_vz=0 \
+ sna_type_p=1 \
+ ntaper=400 \
+ left=2 right=2 top=2 bottom=2
+
+# tsnap1=4.200 tsnap2=4.50 dtsnap=0.004 \
+
+suop2 snapinj_planevz_sp.su snapinj_planevx_sp.su op=sum w1=1 w2=1 > snapinj_planevzvxsum_sp.su
+
+##################################
+# back propagate from surface only
+scale=-1.0
+suwind key=tracl min=1 max=$ntr < inj_rate_plane_dx${dx}_rvz.su | sutaper tr1=100 tr2=100 ntr=$ntr | sugain scale=$scale > inj_rate_surf_dx${dx}_rvz.su
+
+# at 4.3000 seconds the focus is at t=0
+fdelmodc \
+ file_cp=$file_cp ischeme=1 iorder=4 \
+ file_den=$file_ro \
+ file_src=inj_rate_surf_dx${dx}_rvz.su \
+ file_snap=snapinj_surf.su \
+ grid_dir=1 \
+ src_type=1 \
+ src_injectionrate=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_p=0 \
+ dtrcv=$dt \
+ rec_delay=0.0 \
+ verbose=1 \
+ tmod=5.004 \
+ tsnap1=3.000 tsnap2=5.00 dtsnap=0.01 \
+ xsnap1=-1000 xsnap2=1000 dxsnap=2.5 dzsnap=2.5 \
+ sna_type_vz=0 \
+ sna_type_p=1 \
+ ntaper=400 \
+ left=2 right=2 top=2 bottom=2
+
diff --git a/marchenko3D/demo/ScientificReports/backpropf2.scr b/marchenko3D/demo/ScientificReports/backpropf2.scr
new file mode 100755
index 0000000000000000000000000000000000000000..a19fca25cc61b0157ecdaf86b0cc9c52d3ce726e
--- /dev/null
+++ b/marchenko3D/demo/ScientificReports/backpropf2.scr
@@ -0,0 +1,57 @@
+#!/bin/bash
+
+export PATH=:$HOME/src/OpenSource/bin:$HOME/bin:$PATH:
+
+export OMP_NUM_THREADS=8
+dx=2.5
+dt=0.00050
+dx=0.5
+dt=0.000125
+
+ns=`surange < f2.su | grep ns | awk '{print $2}'`
+dtrcv=`surange < f2.su | grep dt | awk '{print $2/1000000.0}'`
+#suwind key=gx min=-2250000 max=2250000 itmax=1023 < f2.su | sushw key=f2 a=-2250 > nep.su
+#shift=$(echo "scale=6; ($dtrcv*($ns/2.0-1)+0.5*$dt-0.000250)" | bc -l)
+shift=$(echo "scale=6; ($dtrcv*($ns/2.0-1))" | bc -l)
+echo $shift
+basop choice=shift shift=$shift file_in=f2.su verbose=1 > pplus.su
+
+# the f2.su is sampled with 4ms the FD program need 0.5ms
+# time axis is interpolated by making use of FFT's: sinc interpolation
+# this is now done in fdelmodc
+
+#ftr1d file_in=pplus.su file_out=freq.su
+#sushw < freq.su key=nhs,dt a=8192,500 > fr.su
+#ftr1d file_in=fr.su n1=8194 file_out=pplusdt.su verbose=1
+
+file_cp=tutodel_dx${dx}_cp.su
+file_ro=tutodel_dx${dx}_ro.su
+
+# back propagate with f2 from marchenko.scr
+
+set -x
+fdelmodc \
+ file_cp=$file_cp ischeme=1 iorder=4 \
+ file_den=$file_ro \
+ file_src=pplus.su \
+ file_snap=snapinj_f2.su \
+ grid_dir=0 \
+ src_type=1 \
+ src_injectionrate=1 \
+ rec_type_vz=0 \
+ rec_type_p=0 \
+ rec_int_p=0 \
+ verbose=4 \
+ dt=$dt \
+ tmod=3.0000 \
+ tsnap1=0.744125 tsnap2=2.744125 dtsnap=0.01 \
+ xsnap1=-1000 xsnap2=1000 dxsnap=2.5 dzsnap=2.5 \
+ sna_type_vz=0 \
+ sna_type_p=1 \
+ fmax=120 \
+ ntaper=400 \
+ left=2 right=2 top=2 bottom=2
+
+#2.044125
+# tmod=2.1000 \
+# tsnap1=2.0400 tsnap2=2.0500 dtsnap=0.000125 \
diff --git a/marchenko3D/demo/ScientificReports/check.scr b/marchenko3D/demo/ScientificReports/check.scr
new file mode 100755
index 0000000000000000000000000000000000000000..b369721f40779a714ff6a020a404bacfc846e21c
--- /dev/null
+++ b/marchenko3D/demo/ScientificReports/check.scr
@@ -0,0 +1,29 @@
+#!/bin/bash
+#PBS -N fdelmod
+#PBS -q long
+#PBS -l nodes=1
+#PBS -k eo
+#PBS -j eo
+
+dxshot=10
+ishot=0
+nshots=601
+zsrc=0
+
+while (( ishot < nshots ))
+do
+
+ (( xsrc = -3000 + ${ishot}*${dxshot} ))
+
+ file_rcv=shotsnew/shots_${xsrc}_rp.su
+
+ if [ ! -e "$file_rcv" ]
+ then
+ echo $xsrc is missing
+ sbatch jobs/slurm_$ishot.job
+ fi
+
+ (( ishot = $ishot + 1))
+
+done
+
diff --git a/marchenko3D/demo/ScientificReports/clean b/marchenko3D/demo/ScientificReports/clean
new file mode 100755
index 0000000000000000000000000000000000000000..26987b43f2604488b03655488d6daaad171eb7ad
--- /dev/null
+++ b/marchenko3D/demo/ScientificReports/clean
@@ -0,0 +1,4 @@
+#!/bin/bash
+
+rm *.su *.bin *.eps nep line* *.asci curve* *.mod
+
diff --git a/marchenko3D/demo/ScientificReports/direct.scr b/marchenko3D/demo/ScientificReports/direct.scr
new file mode 100755
index 0000000000000000000000000000000000000000..fa06b4215d8a8908a7bcbe37ff16177f265d146a
--- /dev/null
+++ b/marchenko3D/demo/ScientificReports/direct.scr
@@ -0,0 +1,40 @@
+#!/bin/bash
+
+cd /vardim/home/thorbcke/data/Kees/Marchenko/Tutorial
+
+dx=2.5
+dt=0.00050
+fast="fast"
+
+dx=0.5
+dt=0.0001
+fast=""
+
+makemod sizex=12000 sizez=250 dx=$dx dz=$dx cp0=1500 ro0=1000 \
+ orig=-6000,0 file_base=noContrast.su
+
+export OMP_NUM_THREADS=8
+makewave w=fw fmin=0 flef=5 frig=80 fmax=100 dt=$dt file_out=wavefw${fast}.su nt=8192 t0=0.4 scale=0 scfft=1
+
+fdelmodc \
+ file_cp=noContrast_cp.su ischeme=1 iorder=4 \
+ file_den=noContrast_ro.su \
+ file_src=wavefw${fast}.su \
+ file_rcv=direct${fast}.su \
+ src_type=7 \
+ src_orient=1 \
+ src_injectionrate=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ rec_delay=0.4 \
+ dtrcv=0.004 \
+ verbose=2 \
+ tmod=4.492 \
+ dxrcv=10.0 \
+ xrcv1=-6000 xrcv2=6000 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=0 zsrc=0 \
+ ntaper=200 \
+ left=2 right=2 top=2 bottom=2
+
diff --git a/marchenko3D/demo/ScientificReports/epsBack.scr b/marchenko3D/demo/ScientificReports/epsBack.scr
new file mode 100755
index 0000000000000000000000000000000000000000..fad63523dfa74f535cbaf7dd71847af4d4b3349c
--- /dev/null
+++ b/marchenko3D/demo/ScientificReports/epsBack.scr
@@ -0,0 +1,131 @@
+#!/bin/bash
+
+export PATH=:$HOME/src/OpenSource/bin:$HOME/bin:$PATH:
+
+dx=0.5
+file_snap_all=snapinj_planevzvxsum_sp.su
+file_snap_surf=snapinj_surf_sp.su
+file_snap_f2=snapinj_f2_sp.su
+
+
+sumax < ${file_snap_all} mode=abs outpar=nep
+clip_all=`cat nep | awk '{print $1/25}'`
+clip_t0all=`cat nep | awk '{print $1/10}'`
+sumax < ${file_snap_surf} mode=abs outpar=nep
+clip_surf=`cat nep | awk '{print $1/10}'`
+clip_t0surf=`cat nep | awk '{print $1/4}'`
+sumax < ${file_snap_f2} mode=abs outpar=nep
+clip_f2=`cat nep | awk '{print $1/10}'`
+clip_t0f2=`cat nep | awk '{print $1/4}'`
+echo $clip_all $clip_surf $clip_f2
+
+#131 => t=0
+for file_snap in $file_snap_all $file_snap_surf $file_snap_f2
+do
+ if [ $file_snap == $file_snap_all ]; then clip=$clip_all; fi;
+ if [ $file_snap == $file_snap_surf ]; then clip=$clip_surf; fi;
+ if [ $file_snap == $file_snap_f2 ]; then clip=$clip_f2; fi;
+ echo $clip
+ file_base=${file_snap%_sp.su}
+ suwind key=fldr min=61 max=201 < $file_snap | sugain scale=-1 | sustrip > $file_base.bin
+ for fldr in 71 101 128 131 134 161 191;
+ do
+ if [ $fldr == 131 ];
+ then
+ clipt=$(echo "scale=2; ${clip}*4.0" | bc -l);
+ else
+ clipt=$clip;
+ fi;
+ echo clip=$clip clipt=$clipt
+ times=$(echo "scale=2; 0.01*(${fldr}-131)" | bc -l)
+ atime=`printf "%4.2f" $times`
+ suwind key=fldr min=$fldr max=$fldr < ${file_snap} | \
+ supsimage hbox=2.5 wbox=4 labelsize=-1 \
+ x1beg=0 x1end=1250.0 clip=$clipt \
+ curve=curve1,curve2,curve3 npair=25,25,25 curvecolor=black,black,black curvedash=3,3,3 \
+ n1tic=5 x2beg=-1000 f2num=-1000 d2num=500 x2end=1000 > ${file_base}_$atime.eps
+ done
+done
+
+file_base=${file_snap_f2%_sp.su}
+rm ${file_base}sum.su
+for shot in `seq 61 1 131`;
+do
+ suwind key=fldr min=$shot max=$shot < ${file_snap_f2} > neg.su
+ (( a = 131+(131-$shot) ))
+ echo $shot $a
+ suwind key=fldr min=$a max=$a < ${file_snap_f2} > pos.su
+ susum neg.su pos.su | sushw key=fldr a=$shot >> ${file_base}sum.su
+done
+
+for shot in `seq 132 1 201`;
+do
+ suwind key=fldr min=$shot max=$shot < ${file_snap_f2}> pos.su
+ (( a = 131+(131-$shot) ))
+ echo $shot $a
+ suwind key=fldr min=$a max=$a < ${file_snap_f2} > neg.su
+ susum neg.su pos.su | sushw key=fldr a=$fldr >> ${file_base}sum.su
+done
+
+sugain scale=-1 < ${file_base}sum.su | sustrip > ${file_base}sum.bin
+
+exit
+
+#select files for snapshot between -0.7 => 0 <= +0.07 (fldr 31-101-171)
+#add pos and negative times to get response of homogenoeus Green's function
+
+file_base=${file_snap%_sp.su}
+for fldr in 71 101 128 131;
+do
+ times=$(echo "scale=2; 0.01*(131-${fldr})" | bc -l)
+ atime=`printf "%4.2f" $times`
+ suwind key=fldr min=$fldr max=$fldr < ${file_snap_f2} > neg.su
+ (( fldr = 131+(131-$fldr) ))
+ suwind key=fldr min=$fldr max=$fldr < ${file_snap_f2}> pos.su
+ susum neg.su pos.su | \
+ supsimage hbox=2.5 wbox=4 labelsize=-1 \
+ x1beg=0 x1end=1250.0 clip=$clip_f2 \
+ curve=curve1,curve2,curve3 npair=25,25,25 curvecolor=black,black,black curvedash=3,3,3 \
+ n1tic=5 x2beg=-1000 f2num=-1000 d2num=500 x2end=1000 > ${file_base}sum_$atime.eps
+done
+
+#supsgraph < wave.su hbox=6 wbox=2 labelsize=10 f1=0 x1end=0.4 > wave.eps
+#basop file_in=wave.su choice=15 | supsgraph hbox=6 wbox=2 labelsize=10 f1=0 x1end=0.4 > wavesjom.eps
+
+file=inj_rate_surf_dx${dx}_rvz.su
+file_base=${file%.su}
+sumax < ${file} mode=abs outpar=nep
+clip=`cat nep | awk '{print $1/5}'`
+
+ns=`surange < $file | grep ns | awk '{print $2}'`
+dtrcv=`surange < $file | grep dt | awk '{print $2/1000000.0}'`
+shift=$(echo "scale=6; ($dtrcv*($ns/2.0-1))" | bc -l)
+skip=$(echo "scale=0; (10/${dx})" | bc -l)
+echo $shift $skip
+basop choice=shift shift=$shift file_in=$file verbose=1 | suwind s=1 j=$skip | sushw key=d2,tracl a=10,1 b=0,1 > nep.su
+supsimage hbox=2.5 wbox=4 labelsize=-1 < nep.su \
+ x1beg=-0.6 x1end=1.5 clip=$clip grid1=dot \
+ n1tic=5 x2beg=-1000 f2num=-1000 d2num=500 x2end=1000 > ${file_base}.eps
+
+suwind s=1 j=10 < nep.su | \
+ supswigp hbox=2.5 wbox=4 labelsize=-1 d2=100 \
+ x1beg=-1.5 x1end=1.5 xcur=1.5 grid1=dot n1tic=1 d1num=2.145 \
+ f2=-3000 x2beg=-1000 f2num=-1000 d2num=500 x2end=1000 > ${file_base}_wiggle.eps
+
+file=pplus.su
+file_base=${file%.su}
+sumax < ${file} mode=abs outpar=nep
+clip=`cat nep | awk '{print $1/5}'`
+
+suflip flip=3 < $file | \
+ supsimage hbox=2.5 wbox=4 labelsize=-1 x2beg=-1000 x2end=1000 \
+ x1beg=-0.6 x1end=1.5 clip=$clip grid1=dot \
+ n1tic=5 x2beg=-1000 f2num=-1000 d2num=500 x2end=1000 > ${file_base}.eps
+
+suflip flip=3 < $file | suwind s=1 j=10 | \
+ supswigp hbox=2.5 wbox=4 labelsize=-1 d2=100 \
+ x1beg=-1.5 x1end=1.5 xcur=1.5 grid1=dot n1tic=1 d1num=2.044 \
+ f2=-3000 x2beg=-1000 f2num=-1000 d2num=500 x2end=1000 > ${file_base}_wiggle.eps
+
+
+
diff --git a/marchenko3D/demo/ScientificReports/initialFocus.scr b/marchenko3D/demo/ScientificReports/initialFocus.scr
new file mode 100755
index 0000000000000000000000000000000000000000..4353514c42aafbaaa8a4799b4a31c68a43d3be36
--- /dev/null
+++ b/marchenko3D/demo/ScientificReports/initialFocus.scr
@@ -0,0 +1,86 @@
+#!/bin/bash
+#PBS -N fdelmod
+#PBS -q verylong
+#PBS -l nodes=1
+#PBS -k eo
+#PBS -j eo
+
+export PATH=$HOME/bin64:$HOME/src/OpenSource/utils:$PATH:
+which makewave
+which makemod
+
+dx=2.5
+dt=0.0005
+dx=0.5
+dt=0.0001
+
+makemod sizex=6000 sizez=810 dx=$dx dz=$dx cp0=1500 ro0=1000 \
+ orig=-3000,0 file_base=tutodeldown.su verbose=2 \
+ intt=def x=-3000,-2000,-1000,0,1000,2000,3000 z=240,130,250,300,350,380,320 poly=2 cp=1950 ro=4500 grad=0 \
+ intt=def x=-3000,-2200,-1500,0,1300,2100,3000 z=620,640,590,600,740,700,600 poly=2 cp=2000 ro=1400 grad=0
+
+file_cp=tutodeldown_cp.su
+file_ro=tutodeldown_cp.su
+
+makewave fp=30 dt=$dt file_out=wave.su nt=4096 t0=0.1 scale=1
+
+dxshot=10
+ishot=300
+nshots=301
+
+export OMP_NUM_THREADS=1
+mkdir -p shots${fast}
+mkdir -p jobs
+
+while (( ishot < nshots ))
+do
+
+ (( xsrc = -3000 + ${ishot}*${dxshot} ))
+ echo xsrc=$xsrc
+ file_rcv=iniFocusz800x${xsrc}.su
+
+ cat << EOF > jobs/job_$ishot.slurm
+#!/bin/bash
+#
+#SBATCH -J marchenko46
+#SBATCH --cpus-per-task=8
+#SBATCH --ntasks=1
+#SBATCH --time=0:45:00
+#SBATCH -o iniFocus-%A.out
+
+cd \$SLURM_SUBMIT_DIR
+
+export OMP_NUM_THREADS=8
+
+ fdelmodc \
+ file_cp=$file_cp ischeme=1 iorder=4 \
+ file_den=$file_ro \
+ file_src=wave.su \
+ file_rcv=$file_rcv \
+ src_type=1 \
+ src_orient=1 \
+ src_injectionrate=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ rec_delay=0.1 \
+ dtrcv=0.004 \
+ verbose=2 \
+ tmod=4.192 \
+ dxrcv=10.0 \
+ xrcv1=-3000 xrcv2=3000 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=$xsrc zsrc=800 \
+ ntaper=200 \
+ left=2 right=2 top=2 bottom=2
+EOF
+
+ chmod +x jobs/job_$ishot.slurm
+ jobs/job_$ishot.slurm
+ #sbatch jobs/job_$ishot.slurm
+
+ (( ishot = $ishot + 1))
+done
+
+
+
diff --git a/marchenko3D/demo/ScientificReports/marchenko.scr b/marchenko3D/demo/ScientificReports/marchenko.scr
new file mode 100755
index 0000000000000000000000000000000000000000..427f2c096b3da9633d1f0a4bee3c86007f2d17a4
--- /dev/null
+++ b/marchenko3D/demo/ScientificReports/marchenko.scr
@@ -0,0 +1,22 @@
+#!/bin/bash -x
+#PBS -N fdelmod
+#PBS -q verylong
+#PBS -l nodes=1
+#PBS -k eo
+#PBS -j eo
+
+export PATH=$HOME/src/OpenSource/bin:$PATH:
+export OMP_NUM_THREADS=8
+
+#for backprop.scr use fast model (with stair-case interfaces)
+#for backprop.scr use pml model (with 0.5 fine-grids)
+
+smooth=3
+
+fmute file_shot=iniFocusz800x0_rp.su file_out=p0plus.su above=-1 shift=-10 verbose=1 check=1 hw=4
+
+marchenko file_shot=shotsnew/refl_rp.su file_tinv=p0plus.su nshots=601 \
+ file_green=pgreen.su verbose=1 tap=0 ntap=10 niter=15 hw=4 shift=10 smooth=$smooth \
+ file_gplus=Gplus.su file_gmin=Gmin.su file_f1plus=f1plus.su file_f1min=f1min.su \
+ file_f2=f2.su fmax=90 file_f1plus=f1plus.su
+
diff --git a/marchenko3D/demo/ScientificReports/model.scr b/marchenko3D/demo/ScientificReports/model.scr
new file mode 100755
index 0000000000000000000000000000000000000000..7a37739be2a78183a3f2582b7f7409d7d8001327
--- /dev/null
+++ b/marchenko3D/demo/ScientificReports/model.scr
@@ -0,0 +1,98 @@
+#!/bin/bash -x
+
+#cd /vardim/home/thorbcke/data/Kees/Marchenko/Nature_SAGA
+
+if [ -n "$1" ]
+then
+ dx=$1
+else
+ dx=2.5
+fi
+
+makemod sizex=6000 sizez=1250 dx=$dx dz=$dx cp0=1500 ro0=1000 \
+ orig=-3000,0 file_base=tutodel_dx$dx.su rayfile=1 skip=100 verbose=2 \
+ intt=def x=-3000,-2000,-1000,0,1000,2000,3000 z=240,130,250,300,350,380,320 poly=2 cp=1950 ro=4500 \
+ intt=def x=-3000,-2200,-1500,0,1300,2100,3000 z=620,640,590,600,740,700,600 poly=2 cp=2000 ro=1400 \
+ intt=def x=-3000,-1800,0,2200,3000 z=920,1000,900,1000,1010 poly=2 cp=2300 ro=1600
+
+suwind key=gx min=0 max=0 < tutodel_dx${dx}_cp.su > tracemodel.su
+
+supsgraph < tracemodel.su hbox=6 wbox=3 labelsize=10 style=seismic \
+ x1beg=0 d1=$dx f1=0 d2num=100 label1="depth (m)" label2="velocity (m/s)"> tracemodel_x_0.eps
+
+supsimage hbox=4 wbox=6 labelsize=10 < tutodel_dx2.5_cp.su \
+ x1beg=0 x1end=1200.0 legend=1 threecolor=1 \
+ d1s=1.0 d2s=1.0 \
+ wrgb=1.0,.5,0 grgb=0,.7,1.0 brgb=0,1.0,0 \
+ bps=24 bclip=2300 wclip=1800 \
+ curve=curve1,curve2,curve3 npair=25,25,25 curvecolor=black,black,black curvedash=3,3,3 \
+ n1tic=5 x2beg=-3000 f2num=-3000 d2num=1000 x2end=3000 > tutodel_cp.eps
+
+#itmax=$(echo "scale=0; (1250/${dx}+1)" | bc -l)
+suwind key=gx min=-1000000 max=1000000 < tutodel_dx${dx}_cp.su | sugain scale=-1 dt=1 | sustrip > tutodelsnap_cp.bin
+
+exit;
+#model reference for SI results
+makewave fp=30 dt=$dt file_out=wave${dx}.su nt=4096 t0=0.1 scale=1
+
+dx=0.5
+file_cp=tutodelbelow_dx${dx}_cp.su
+file_ro=tutodelbelow_dx${dx}_ro.su
+
+fdelmodc \
+ file_cp=$file_cp ischeme=1 iorder=4 \
+ file_den=$file_ro \
+ file_src=wave${dx}.su \
+ file_rcv=reference_${dx}Z800.su \
+ src_type=1 \
+ src_injectionrate=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_p=0 \
+ dtrcv=0.004 \
+ dxrcv=2.5 \
+ rec_delay=0.1 \
+ verbose=1 \
+ tmod=1.104 \
+ xrcv1=-3000 xrcv2=3000 zrcv1=800 zrcv2=800 \
+ xsrc=0 zsrc=800 \
+ ntaper=400 \
+ left=4 right=4 top=4 bottom=4
+
+sumax < reference_${dx}Z800_rp.su mode=abs outpar=nep
+clip=`cat nep | awk '{print $1/30}'`
+sugain epow=0.8 < reference_${dx}Z800_rp.su | \
+ supsimage hbox=4 wbox=8 labelsize=10 linewidth=0.0 \
+ n1tic=2 d2=2.5 f1=0.0 x1beg=0.0 x1end=1.004 \
+ f2=-3000 f2num=-3000 d2num=1000 clip=$clip > reference_${dx}Z800_rp.eps
+
+file_cp=tutodel_dx${dx}_cp.su
+file_ro=tutodel_dx${dx}_ro.su
+
+fdelmodc \
+ file_cp=$file_cp ischeme=1 iorder=4 \
+ file_den=$file_ro \
+ file_src=wave${dx}.su \
+ file_rcv=green_${dx}Z800.su \
+ src_type=1 \
+ src_injectionrate=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_p=0 \
+ dtrcv=0.004 \
+ dxrcv=2.5 \
+ rec_delay=0.1 \
+ verbose=1 \
+ tmod=1.104 \
+ xrcv1=-3000 xrcv2=3000 zrcv1=800 zrcv2=800 \
+ xsrc=0 zsrc=800 \
+ ntaper=400 \
+ left=4 right=4 top=4 bottom=4
+
+sumax < green_${dx}Z800_rp.su mode=abs outpar=nep
+clip=`cat nep | awk '{print $1/30}'`
+sugain epow=0.8 < green_${dx}Z800_rp.su | \
+ supsimage hbox=4 wbox=8 labelsize=10 linewidth=0.0 \
+ n1tic=2 d2=2.5 f1=0.0 x1beg=0.0 x1end=1.004 \
+ f2=-3000 f2num=-3000 d2num=1000 clip=$clip > green_${dx}Z800_rp.eps
+
diff --git a/marchenko3D/demo/ScientificReports/remove_direct.scr b/marchenko3D/demo/ScientificReports/remove_direct.scr
new file mode 100755
index 0000000000000000000000000000000000000000..71a99c127a193cd2d9c3cc79ef4e72b7ee95f368
--- /dev/null
+++ b/marchenko3D/demo/ScientificReports/remove_direct.scr
@@ -0,0 +1,42 @@
+#!/bin/bash
+#PBS -N fdelmod
+#PBS -q verylong
+#PBS -l nodes=1
+#PBS -k eo
+#PBS -j eo
+
+export PATH=$HOME/bin:$HOME/src/OpenSource/bin:$PATH:
+
+dxshot=10
+ishot=0
+nshots=601
+
+file_R=shotsnew/refl_rp.su
+rm $file_R
+
+while (( ishot < nshots ))
+do
+
+ (( xsrc = -3000 + ${ishot}*${dxshot} ))
+ (( sx = ${xsrc}*1000 ))
+ (( iishot = ${ishot}*${dxshot}/10 ))
+ (( tr1 = 601 - ${iishot} ))
+ (( tr2 = ${tr1} + 600 ))
+ echo xsrc=$xsrc tr1=$tr1 tr2=$tr2
+
+# direct wave
+ suwind < direct_rp.su key=tracl min=$tr1 max=$tr2 > direct.su
+
+# 2D shot
+ file_rcv=shotsnew/shots_${xsrc}_rp.su
+ #suwind key=tracl min=1 max=601 < $file_rcv > shotz0.su
+ sudiff $file_rcv direct.su > refl.su
+
+ (( ishot = $ishot + 1))
+
+ sushw < refl.su key=fldr a=$ishot | sugain scale=0.5 >> $file_R
+
+done
+
+rm direct.su refl.su
+
diff --git a/marchenko3D/demo/ScientificReports/shotslurm.scr b/marchenko3D/demo/ScientificReports/shotslurm.scr
new file mode 100755
index 0000000000000000000000000000000000000000..fb5feee5c5172108e37479485121bc23c6a9c2ba
--- /dev/null
+++ b/marchenko3D/demo/ScientificReports/shotslurm.scr
@@ -0,0 +1,67 @@
+#!/bin/bash
+
+export PATH=:$HOME/src/OpenSource/bin:$PATH:
+
+dt=0.0001
+makewave w=fw fmin=0 flef=5 frig=80 fmax=100 dt=$dt file_out=wavefw.su nt=8192 t0=0.4 scale=0 scfft=1
+
+./model.scr 0.5
+
+mkdir -p shotsnew
+mkdir -p jobs
+
+dxshot=10
+ishot=0
+nshots=601
+zsrc=0
+
+while (( ishot < nshots ))
+do
+
+ (( xsrc = -3000 + ${ishot}*${dxshot} ))
+
+ echo ishot=$ishot xsrc=$xsrc zsrc=$zsrc
+
+ cat << EOF > jobs/slurm_$ishot.job
+#!/bin/bash
+#SBATCH -J shot_${xsrc}
+#SBATCH --cpus-per-task=6
+#SBATCH --ntasks=1
+#SBATCH --time=03:00:00
+#SBATCH -o shot_${xsrc}.out
+
+cd \$SLURM_SUBMIT_DIR
+
+ export PATH=:\$HOME/src/OpenSource/bin:\$PATH:
+ export OMP_NUM_THREADS=6
+ file_rcv=shotsnew/shots_${xsrc}.su
+
+ fdelmodc \
+ file_cp=tutodel_cp.su ischeme=1 iorder=4 \
+ file_den=tutodel_ro.su \
+ file_src=wavefw.su \
+ file_rcv=\$file_rcv \
+ src_type=7 \
+ src_orient=1 \
+ src_injectionrate=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ rec_delay=0.4 \
+ dtrcv=0.004 \
+ verbose=2 \
+ tmod=4.492 \
+ dxrcv=10.0 \
+ xrcv1=-3000 xrcv2=3000 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=$xsrc zsrc=$zsrc \
+ ntaper=200 \
+ left=2 right=2 top=2 bottom=2
+EOF
+
+ sbatch jobs/slurm_$ishot.job
+
+ (( ishot = $ishot + 1))
+
+done
+
diff --git a/marchenko3D/demo/old/README b/marchenko3D/demo/old/README
new file mode 100644
index 0000000000000000000000000000000000000000..5fc50362f6ee58da1104668356b8ac28380d6013
--- /dev/null
+++ b/marchenko3D/demo/old/README
@@ -0,0 +1,9 @@
+Description of files:
+1) shots.scr create the shots
+2) model.scr computes the model
+3) direct_wave.scr crate the direct wave to be removed from the shots
+4) remove_direct.scr remove the direct wave from the shots and scale them
+5) first_arrival.scr computes the first arrival
+6) marchenko.scr perform the Marchenko scheme
+7) referenceShot.scr creates the reference Green's function
+
diff --git a/marchenko3D/demo/old/direct.scr b/marchenko3D/demo/old/direct.scr
new file mode 100755
index 0000000000000000000000000000000000000000..a27121e6f21e354e0d16670ffee3e40e321b7bf9
--- /dev/null
+++ b/marchenko3D/demo/old/direct.scr
@@ -0,0 +1,37 @@
+#!/bin/bash
+
+export PATH=$HOME/bin:$HOME/src/OpenSource/bin:$PATH:
+
+cd /home/thorbcke/data/Kees/MultElim/ModelImageBackprop
+
+dx=2.5
+dt=0.0005
+
+makemod sizex=12000 sizez=4000 dx=$dx dz=$dx cp0=1900 ro0=1200 \
+ orig=-6000,-1000 file_base=noContrast.su
+
+export OMP_NUM_THREADS=8
+makewave w=fw fmin=0 flef=5 frig=80 fmax=100 dt=$dt file_out=wavefw.su nt=4096 t0=0.3 scale=0
+
+$HOME/bin/fdelmodc \
+ file_cp=noContrast_cp.su ischeme=1 iorder=4 \
+ file_den=noContrast_ro.su \
+ file_src=wavefw.su \
+ file_rcv=direct.su \
+ src_type=7 \
+ src_orient=1 \
+ src_injectionrate=1 \
+ rec_type_vz=1 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ rec_delay=0.3 \
+ dtrcv=0.004 \
+ verbose=2 \
+ tmod=4.394 \
+ dxrcv=10.0 \
+ xrcv1=-6000 xrcv2=6000 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=0 zsrc=0 \
+ ntaper=400 \
+ left=4 right=4 top=4 bottom=4
+
diff --git a/marchenko3D/demo/old/first_arrival.scr b/marchenko3D/demo/old/first_arrival.scr
new file mode 100755
index 0000000000000000000000000000000000000000..721721ddfae96deb0f734c57e6d10eb55e37dc04
--- /dev/null
+++ b/marchenko3D/demo/old/first_arrival.scr
@@ -0,0 +1,92 @@
+#!/bin/bash
+#PBS -N fdelmod
+#PBS -q verylong
+#PBS -l nodes=1
+#PBS -k eo
+#PBS -j eo
+
+export PATH=$HOME/bin:$HOME/src/OpenSource/bin:$PATH:
+
+cd /home/thorbcke/data/Kees/MultElim/ModelImageBackprop/Redatum
+
+dx=2.5
+dt=0.0005
+
+makemod sizex=6000 sizez=2000 dx=$dx dz=$dx cp0=1900 ro0=1200 \
+ orig=-3000,0 file_base=synclDown.su verbose=2 \
+ intt=def x=-3000,500,3000 z=195,195,195 poly=1 cp=1950 ro=3700 \
+ intt=def x=-3000,3000 z=600,600 poly=0 cp=2050 ro=1750 \
+ intt=def x=-3000,3000 z=680,680 poly=0 cp=2150 ro=2220 \
+ intt=def x=-3000,3000 z=780,780 poly=0 cp=2230 ro=1700 \
+ intt=def x=-3000,-2200,-1500,0,1300,2100,3000 z=520,580,680,840,680,600,500 poly=2 cp=2400 ro=2800 \
+
+# intt=def x=-3000,0,3000 z=1110,1110,1110 poly=0 cp=2300 ro=1950 \
+# intt=def x=-3000,3000 z=1180,1180 poly=0 cp=2480 ro=1820 \
+# intt=def x=-3000,0,3000 z=1290,1290,1370 poly=0 cp=2600 ro=2000 \
+# intt=def x=-3000,3000 z=1380,1380 poly=0 cp=2720 ro=2050 \
+# intt=def x=-3000,3000 z=1480,1480 poly=0 cp=2800 ro=1850
+
+makewave fp=20 dt=$dt file_out=wave.su nt=4096 t0=0.1 scale=1
+
+#smooth file_in=synclDown_cp.su power=-1.0 ntsm=29 nxsm=29 niter=15 file_out=syncls_cp.su
+#smooth file_in=synclDown_ro.su power=-1.0 ntsm=29 nxsm=29 niter=15 file_out=syncls_ro.su
+
+dxshot=10
+ishot=300
+nshots=301
+
+export OMP_NUM_THREADS=1
+mkdir -p shots
+mkdir -p jobs
+
+while (( ishot < nshots ))
+do
+
+ (( xsrc = -3000 + ${ishot}*${dxshot} ))
+# (( xsrc = -1100 + ${ishot}*${dxshot} ))
+ echo xsrc=$xsrc
+ file_rcv=shots/shotsmonPz1100_${xsrc}.su
+
+ cat << EOF > jobs/pbs_$ishot.job
+#!/bin/bash
+#
+#PBS -q medium
+#PBS -N mod_${xsrc}
+#PBS -j eo
+#PBS -m n
+#PBS -l nodes=1
+#PBS -V
+
+cd /home/thorbcke/data/Kees/MultElim/ModelImageBackprop/Redatum
+export OMP_NUM_THREADS=1
+
+ $HOME/bin64/fdelmodc \
+ file_cp=synclDown_cp.su ischeme=1 iorder=4 \
+ file_den=synclDown_ro.su \
+ file_src=wave.su \
+ file_rcv=$file_rcv \
+ src_type=1 \
+ src_orient=1 \
+ src_injectionrate=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ rec_delay=0.1 \
+ dtrcv=0.004 \
+ verbose=2 \
+ tmod=2.100 \
+ dxrcv=10.0 \
+ xrcv1=-3000 xrcv2=3000 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=$xsrc zsrc=1100 \
+ ntaper=300 \
+ left=4 right=4 top=4 bottom=4
+EOF
+
+ qsub jobs/pbs_$ishot.job
+
+ (( ishot = $ishot + 1))
+done
+
+
+
diff --git a/marchenko3D/demo/old/marchenko.scr b/marchenko3D/demo/old/marchenko.scr
new file mode 100755
index 0000000000000000000000000000000000000000..bee3690f0b9482997ab64f4a652c3244cdda6c9a
--- /dev/null
+++ b/marchenko3D/demo/old/marchenko.scr
@@ -0,0 +1,39 @@
+#!/bin/bash -x
+#PBS -N fdelmod
+#PBS -q verylong
+#PBS -l nodes=1
+#PBS -k eo
+#PBS -j eo
+
+export PATH=$HOME/bin:$HOME/src/OpenSource/bin:$PATH:
+which makewave
+which makemod
+which fmute
+which syn2d
+export OMP_NUM_THREADS=8
+
+cd /home/thorbcke/data/Kees/MultElim/ModelImageBackprop/Redatum
+
+tmpdir=/tmp/shotI
+mkdir -p $tmpdir
+#for dt=0.004 with modeling at 0.0005
+scale=1.0
+w1=1
+smooth=3
+#smooth=0
+
+fmute file_shot=shots/shotsmonPz1100_0_rp.su file_out=p0plus.su above=-1 shift=-10 verbose=1 check=1 hw=4
+
+suwind itmax=1023 < p0plus.su | \
+suwind key=gx min=-3000000 max=3000000 | \
+sushw key=fldr a=1 > p0plussx.su
+
+#~/bin/marchenko file_shot=../shots/refl_rp.su file_tinv=p0plussx.su nshots=601 file_green=pgreen_1.su verbose=1 tap=0 ntap=0 reci=0 niter=1 hw=8 shift=7 smooth=$smooth w=1 file_gplus=Gplus0.su file_gmin=Gmin0.su file_f1plus=f1plus0_1.su file_f1min=f1min0_1.su file_pplus=Pplus0_1.su
+#
+#~/bin/marchenko file_shot=../shots/refl_rp.su file_tinv=p0plussx.su nshots=601 file_green=pgreen_4.su verbose=1 tap=0 ntap=0 reci=0 niter=4 hw=8 shift=7 smooth=$smooth w=1 file_gplus=Gplus0.su file_gmin=Gmin0.su file_f1plus=f1plus0_4.su file_f1min=f1min0_4.su file_pplus=Pplus0_4.su
+
+#for backpropagating pplus in marchenko scheme must be written to file
+~/bin/marchenko file_shot=../shots/refl_rp.su file_tinv=p0plussx.su nshots=601 file_green=pgreen.su verbose=1 tap=0 ntap=10 niter=15 hw=8 shift=7 smooth=$smooth file_gplus=Gplus0.su file_gmin=Gmin0.su file_f1plus=f1plus0.su file_f1min=f1min0.su file_pplus=Pplus0.su
+
+exit;
+
diff --git a/marchenko3D/demo/old/model.scr b/marchenko3D/demo/old/model.scr
new file mode 100755
index 0000000000000000000000000000000000000000..777a556cff71898882ebca61466f17fb7c09aaba
--- /dev/null
+++ b/marchenko3D/demo/old/model.scr
@@ -0,0 +1,212 @@
+#!/bin/bash
+
+export PATH=$HOME/bin:$HOME/src/OpenSource/bin:$PATH:
+
+dx=2.5
+dt=0.0005
+
+makemod sizex=6000 sizez=2000 dx=$dx dz=$dx cp0=1900 ro0=1200 \
+ orig=-3000,0 file_base=syncl.su verbose=2 \
+ intt=def x=-3000,500,3000 z=195,195,195 poly=1 cp=1950 ro=3700 \
+ intt=def x=-3000,3000 z=600,600 poly=0 cp=2050 ro=1750 \
+ intt=def x=-3000,3000 z=680,680 poly=0 cp=2150 ro=2220 \
+ intt=def x=-3000,3000 z=780,780 poly=0 cp=2230 ro=1700 \
+ intt=def x=-3000,-2200,-1500,0,1300,2100,3000 z=520,580,680,840,680,600,500 poly=2 cp=2400 ro=2800 \
+ intt=def x=-3000,0,3000 z=1110,1110,1110 poly=0 cp=2300 ro=1950 \
+ intt=def x=-3000,3000 z=1180,1180 poly=0 cp=2480 ro=1820 \
+ intt=def x=-3000,0,3000 z=1290,1290,1370 poly=0 cp=2600 ro=2000 \
+ intt=def x=-3000,3000 z=1380,1380 poly=0 cp=2720 ro=2050 \
+ intt=def x=-3000,3000 z=1480,1480 poly=0 cp=2800 ro=1850
+
+ #intt=diffr x=-2000,-1000,0,1000,2000 z=1800,1800,1800,1800,1800 cp=0,0,0,0,0 ro=5000,5000,5000,5000,5000
+
+
+makemod sizex=6000 sizez=2000 dx=10 dz=5 cp0=1900 ro0=1200 \
+ orig=-3000,0 file_base=syncl_migr.su verbose=2 \
+ intt=def x=-3000,500,3000 z=195,195,195 poly=1 cp=1950 ro=3700 \
+ intt=def x=-3000,3000 z=600,600 poly=0 cp=2050 ro=1750 \
+ intt=def x=-3000,3000 z=680,680 poly=0 cp=2150 ro=2220 \
+ intt=def x=-3000,3000 z=780,780 poly=0 cp=2230 ro=1700 \
+ intt=def x=-3000,-2200,-1500,0,1300,2100,3000 z=520,580,680,840,680,600,500 poly=2 cp=2400 ro=2800 \
+ intt=def x=-3000,0,3000 z=1110,1110,1110 poly=0 cp=2300 ro=1950 \
+ intt=def x=-3000,3000 z=1180,1180 poly=0 cp=2480 ro=1820 \
+ intt=def x=-3000,0,3000 z=1290,1290,1370 poly=0 cp=2600 ro=2000 \
+ intt=def x=-3000,3000 z=1380,1380 poly=0 cp=2720 ro=2050 \
+ intt=def x=-3000,3000 z=1480,1480 poly=0 cp=2800 ro=1850
+
+exit
+
+#example FD modeling with model defined above
+makewave w=fw fmin=0 flef=5 frig=80 fmax=100 dt=$dt file_out=wavefw.su nt=4096 t0=0.3 scale=0
+
+export OMP_NUM_THREADS=1
+
+makewave fp=20 dt=$dt file_out=wave.su nt=4096 t0=0.1 scale=1
+
+~/bin/fdelmodc \
+ file_cp=syncl_cp.su ischeme=1 iorder=4 \
+ file_den=syncl_ro.su \
+ file_src=wave.su \
+ file_rcv=shot_fd.su \
+ src_type=1 \
+ src_orient=1 \
+ src_injectionrate=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.0010 \
+ rec_delay=0.1 \
+ verbose=2 \
+ tmod=4.195 \
+ dxrcv=10.0 \
+ xrcv1=-2250 xrcv2=2250 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=0 zsrc=0 \
+ ntaper=400 \
+ tsnap1=3.1 tsnap2=2.5 dtsnap=0.1 \
+ left=4 right=4 top=4 bottom=4
+
+
+exit
+
+makemod sizex=6000 sizez=2000 dx=$dx dz=$dx cp0=1900 ro0=1200 \
+ orig=-3000,-1000 file_base=hom.su
+
+~/bin/fdelmodc \
+ file_cp=hom_cp.su ischeme=1 iorder=4 \
+ file_den=hom_ro.su \
+ file_src=wave.su \
+ file_rcv=shot_hom_fd.su \
+ src_type=1 \
+ src_orient=1 \
+ src_injectionrate=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.0010 \
+ rec_delay=0.1 \
+ verbose=2 \
+ tmod=4.195 \
+ dxrcv=10.0 \
+ xrcv1=-2250 xrcv2=2250 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=0 zsrc=0 \
+ ntaper=400 \
+ left=4 right=4 top=4 bottom=4
+
+sudiff shot_fd_rp.su shot_hom_fd_rp.su > shot_rp.su
+
+migr file_shot=shot_rp.su file_vel=syncl_migr_cp.su imc=0 file_image=image.su verbose=1
+
+exit
+
+makemod sizex=6000 sizez=4000 dx=$dx dz=$dx cp0=$cp cs0=$cs ro0=$rho \
+ orig=-3000,-1000 file_base=synclTop.su \
+ intt=def x=-3000,0,3000 z=200,200,200 poly=0 cp=1800 ro=5000 \
+ intt=def x=-3000,-2000,-1000,-400,0,200,900,1800,3000 z=520,520,560,670,950,790,600,520,500 poly=2 cp=2300 ro=1800 \
+
+~/bin/fdelmodc \
+ file_cp=synclTop_cp.su ischeme=1 iorder=4 \
+ file_den=synclTop_ro.su \
+ file_src=wave.su \
+ file_rcv=p0.su \
+ src_type=7 \
+ src_orient=1 \
+ src_injectionrate=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.0010 \
+ rec_delay=0.1 \
+ verbose=2 \
+ tmod=2.100 \
+ dxrcv=10.0 \
+ xrcv1=-2250 xrcv2=2250 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=0 zsrc=1100 \
+ ntaper=300 \
+ left=4 right=4 top=4 bottom=4 &
+
+~/bin/fdelmodc \
+ file_cp=synclTop_cp.su ischeme=1 iorder=4 \
+ file_den=synclTop_ro.su \
+ file_src=wave.su \
+ file_rcv=shot_top.su \
+ src_type=7 \
+ src_orient=1 \
+ src_injectionrate=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.0010 \
+ rec_delay=0.1 \
+ verbose=2 \
+ tmod=4.195 \
+ dxrcv=10.0 \
+ xrcv1=-2250 xrcv2=2250 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=0 zsrc=0 \
+ ntaper=300 \
+ left=4 right=4 top=4 bottom=4 &
+
+makemod sizex=6000 sizez=4000 dx=$dx dz=$dx cp0=2300 ro0=1800 \
+ orig=-3000,-1000 file_base=synclBot.su \
+ intt=def x=-3000,0,3000 z=1310,1310,1310 poly=0 cp=2450 ro=1950 \
+ intt=def x=-3000,3000 z=1380,1380 poly=0 cp=2460 ro=1820 \
+ intt=def x=-3000,0,3000 z=1490,1490,1570 poly=0 cp=2470 ro=2100 \
+ intt=def x=-3000,3000 z=1580,1580 poly=0 cp=2480 ro=2000 \
+ intt=def x=-3000,3000 z=1680,1680 poly=0 cp=2490 ro=1850
+
+~/bin/fdelmodc \
+ file_cp=synclBot_cp.su ischeme=1 iorder=4 \
+ file_den=synclBot_ro.su \
+ file_src=wave.su \
+ file_rcv=pRef.su \
+ src_type=7 \
+ src_orient=1 \
+ src_injectionrate=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.0010 \
+ rec_delay=0.1 \
+ verbose=2 \
+ tmod=2.100 \
+ dxrcv=10.0 \
+ xrcv1=-2250 xrcv2=2250 \
+ zrcv1=1100 zrcv2=1100 \
+ xsrc=0 zsrc=1100 \
+ ntaper=300 \
+ left=4 right=4 top=4 bottom=4 &
+
+makemod sizex=6000 sizez=4000 dx=$dx dz=$dx cp0=2300 ro0=1800 \
+ orig=-3000,-1000 file_base=synclBotHom.su
+
+~/bin/fdelmodc \
+ file_cp=synclBotHom_cp.su ischeme=1 iorder=4 \
+ file_den=synclBotHom_ro.su \
+ file_src=wave.su \
+ file_rcv=pRefHom.su \
+ src_type=7 \
+ src_orient=1 \
+ src_injectionrate=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.0010 \
+ rec_delay=0.1 \
+ verbose=2 \
+ tmod=2.100 \
+ dxrcv=10.0 \
+ xrcv1=-2250 xrcv2=2250 \
+ zrcv1=1100 zrcv2=1100 \
+ xsrc=0 zsrc=1100 \
+ ntaper=300 \
+ left=4 right=4 top=4 bottom=4 &
+
+wait
+
+sudiff shot_fd_rp.su shot_hom_fd_rp.su > shot_rp.su
+sudiff shot_top_rp.su shot_hom_fd_rp.su > shotTop_rp.su
+sudiff pRef_rp.su pRefHom_rp.su > pref_rp.su
+
diff --git a/marchenko3D/demo/old/referenceShot.scr b/marchenko3D/demo/old/referenceShot.scr
new file mode 100755
index 0000000000000000000000000000000000000000..b1ea70e1a0824cc1e60be117ff15110469f57942
--- /dev/null
+++ b/marchenko3D/demo/old/referenceShot.scr
@@ -0,0 +1,44 @@
+#!/bin/bash
+#PBS -N fdelmod
+#PBS -q verylong
+#PBS -l nodes=1
+#PBS -k eo
+#PBS -j eo
+
+export PATH=$HOME/bin:$HOME/src/OpenSource/bin:$PATH:
+
+cd /home/thorbcke/data/Kees/MultElim/ModelImageBackprop/Redatum
+
+#makewave w=fw fmin=0 flef=5 frig=80 fmax=100 dt=$dt file_out=wavefw.su nt=4096 t0=0.3
+
+dx=2.5
+dt=0.0005
+
+makewave fp=20 dt=$dt file_out=wave.su nt=4096 t0=0.1 scale=1
+
+export OMP_NUM_THREADS=8
+
+$HOME/bin/fdelmodc \
+ file_cp=../syncl_cp.su ischeme=1 iorder=4 \
+ file_den=../syncl_ro.su \
+ file_src=wave.su \
+ file_rcv=virtual_shot_fd_P_zsrc1100.su \
+ src_type=1 \
+ src_orient=1 \
+ src_injectionrate=1 \
+ rec_type_ud=1 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.004 \
+ rec_delay=0.1 \
+ verbose=2 \
+ tmod=2.144 \
+ dxrcv=10.0 \
+ xrcv1=-3000 xrcv2=3000 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=0 zsrc=1100 \
+ file_snap=backpropref.su tsnap1=0.1 dtsnap=0.010 tsnap2=2.100 dxsnap=10 dzsnap=10 zsnap1=0 zsnap2=2000 xsnap1=-2250 xsnap2=2250 \
+ ntaper=400 \
+ left=4 right=4 top=4 bottom=4
+
+
diff --git a/marchenko3D/demo/old/remove_direct.scr b/marchenko3D/demo/old/remove_direct.scr
new file mode 100755
index 0000000000000000000000000000000000000000..24a3f41e2c686f981ab12a38ed6ba4fc9eca4a1e
--- /dev/null
+++ b/marchenko3D/demo/old/remove_direct.scr
@@ -0,0 +1,38 @@
+#!/bin/bash
+#PBS -N fdelmod
+#PBS -q verylong
+#PBS -l nodes=1
+#PBS -k eo
+#PBS -j eo
+
+export PATH=$HOME/bin:$HOME/src/OpenSource/bin:$PATH:
+
+cd /home/thorbcke/data/Kees/MultElim/ModelImageBackprop
+
+dxshot=10
+ishot=0
+nshots=601
+
+rm shots/refl_rp.su
+
+while (( ishot < nshots ))
+do
+ (( xsrc = -3000 + ${ishot}*${dxshot} ))
+ (( iishot = ${ishot}*${dxshot}/10 ))
+ (( tr1 = 601 - ${iishot} ))
+ (( tr2 = ${tr1} + 600 ))
+ echo xsrc=$xsrc tr1=$tr1 tr2=$tr2
+ suwind < direct_rp.su key=tracl min=$tr1 max=$tr2 > direct.su
+
+ file_rcv=shots/shots_${xsrc}_rp.su
+ suwind key=tracl min=1 max=601 < $file_rcv > shotz0.su
+
+ sudiff shotz0.su direct.su > refl.su
+
+ (( ishot = $ishot + 1))
+
+ sushw < refl.su key=fldr a=$ishot | \
+ suwind itmax=1023 >> shots/refl_rp.su
+
+done
+
diff --git a/marchenko3D/demo/old/shots.scr b/marchenko3D/demo/old/shots.scr
new file mode 100755
index 0000000000000000000000000000000000000000..907744a972c55c118a56b15237c55a028f269ad4
--- /dev/null
+++ b/marchenko3D/demo/old/shots.scr
@@ -0,0 +1,77 @@
+#!/bin/bash
+#PBS -N fdelmod
+#PBS -q long
+#PBS -l nodes=1
+#PBS -k eo
+#PBS -j eo
+
+export PATH=$HOME/bin:$HOME/src/OpenSource/bin:$PATH:
+which makewave
+which makemod
+
+cd /home/thorbcke/data/Kees/MultElim/ModelImageBackprop
+
+dt=0.0005
+makewave w=fw fmin=0 flef=5 frig=80 fmax=100 dt=$dt file_out=wavefw.su nt=4096 t0=0.3 scale=0 scfft=1
+
+./model.scr
+
+mkdir -p shots
+mkdir -p jobs
+
+dxshot=10
+ishot=0
+nshots=601
+zsrc=0
+
+while (( ishot < nshots ))
+do
+
+ (( xsrc = -3000 + ${ishot}*${dxshot} ))
+
+ echo ishot=$ishot xsrc=$xsrc zsrc=$zsrc
+
+ cat << EOF > jobs/pbs_$ishot.job
+#!/bin/bash
+#
+#PBS -q medium
+#PBS -N mod_${xsrc}
+#PBS -j eo
+#PBS -m n
+#PBS -l nodes=1
+#PBS -V
+
+cd /home/thorbcke/data/Kees/MultElim/ModelImageBackprop
+
+ export OMP_NUM_THREADS=1
+ file_rcv=shots/shots_${xsrc}.su
+
+ $HOME/bin/fdelmodc \
+ file_cp=syncl_cp.su ischeme=1 iorder=4 \
+ file_den=syncl_ro.su \
+ file_src=wavefw.su \
+ file_rcv=\$file_rcv \
+ src_type=7 \
+ src_orient=1 \
+ src_injectionrate=1 \
+ rec_type_vz=1 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ rec_delay=0.3 \
+ dtrcv=0.004 \
+ verbose=2 \
+ tmod=4.394 \
+ dxrcv=10.0 \
+ xrcv1=-3000,-3000,-3000 xrcv2=3000,3000,3000 \
+ zrcv1=0,1000,1600 zrcv2=0,1000,1600 \
+ xsrc=$xsrc zsrc=$zsrc \
+ ntaper=400 \
+ left=4 right=4 top=4 bottom=4
+EOF
+
+qsub jobs/pbs_$ishot.job
+
+ (( ishot = $ishot + 1))
+
+done
+
diff --git a/marchenko3D/demo/oneD/README b/marchenko3D/demo/oneD/README
new file mode 100644
index 0000000000000000000000000000000000000000..fdc4653ad6e4c112a1c9c8d54806480859efa139
--- /dev/null
+++ b/marchenko3D/demo/oneD/README
@@ -0,0 +1,199 @@
+Description of files:
+1) model.scr computes the model and the 'basis' shot of R => shot5_rp.su
+2) p5all.scr create from basis shot full Reflection response matrix => shotsdx5_rp.su (3.3 GB)
+3) initialFocus.scr model G_d the initial focusing function => iniFocus_rp.su
+4) referenceShot.scr creates the reference Green's function at focal point => referenceP_rp.su
+5) marchenko.scr perform the Marchenko scheme => pgreen.su, f1plus0.su, f1min0.su, f2.su
+
+extra scripts
++) marchenkoIter.scr : to make the figure with "Four iterations of the Marchenko method."
++) backpropf2.scr : to make Figure "Snapshots of back-propagation of f_2."
++) eps*.scr : reproduce the postscript files of the manuscript using SU postscript plotting programs.
++) backProp_f2sum_movie.scr : produces a snapshot move of f2(-t) + f2(t) ; Figure 10 3'rd column
++) clean : remove all produced files and start with a clean directory
+
+
+To reproduce the Figures in the Manuscript:
+
+--------------------------
+* Figure 2: Wavelet
+* Figure 3: Model + Initial wavefield
+
+==> run model.scr to generate the data .su files: this will take 3-4 minutes. The files generate are:
+ - hom_cp.su, hom_ro.su
+ - model10_cp.su, model10_ro.su
+ - shot5_fd_rp.su
+ - shot5_hom_fd_rp.su
+ - shot5_rp.su
+ - wave.su
+ - wavefw.su
+
+==> run initialFocus.scr to compute the direct arrival of the transmission response G_d. This will take 1-2 minutes.
+ - modelup_cp.su
+ - modelup_ro.su
+ - iniFocus_rp.su
+Note if you model the initial Focusing operator also with a w=fw wavelet the length of the wavelet becomes very long. The
+mute-windows applied in Marchenko will then also mute a big part of this very long fw wavelet and will not converge anymore.
+
+
+==> run epsModel.scr to generate the postscript files of Figure 2 and 3
+
+wavefw.eps => Figure 2a
+wavefw_freq.eps => Figure 2b
+
+model_cp_line.eps => Figure 3a
+model_ro_line.eps => Figure 3b
+shotx0_rp.eps => Figure 3c
+iniFocus_rp.eps => Figure 3d
+
+
+--------------------------
+* Figure 4: Initialisation
+* Figure 5: first update
+* Figure 6: first 4 iterations
+
+The full R matrix is build up from the the shot record computed with model.scr
+
+==> run p5all.scr to generate the full R matrix for a fixed spread geometry. This will take less than one minute. The file generated is
+ - shotsdx5_rp.su this file has a size of 3.3 GB
+
+This R, together with iniFocus_rp.su, is the input of the Marchenko algorithm
+
+==> run marchenkoIter.scr to compute the first 4 iteration of the Marchenko algorithm. This will take 1-2 minutes. The generated files are:
+ - p0plus.su
+ - pgreen_001.su
+ - f1plus_001.su
+ - f1min_001.su
+ - Gplus_001.su
+ - Gmin_001.su
+ - pgreen_002.su
+ - f1plus_002.su
+ - f1min_002.su
+ - Gplus_002.su
+ - Gmin_002.su
+ - pgreen_003.su
+ - f1plus_003.su
+ - f1min_003.su
+ - Gplus_003.su
+ - Gmin_003.su
+ - pgreen_004.su
+ - f1plus_004.su
+ - f1min_004.su
+ - Gplus_004.su
+ - Gmin_004.su
+
+To Compute the reference Green's function at x=0 z=900 m in the actual model
+==> run referenceShot.scr This will take 1 minute and generates the file;
+ - referenceP_rp.su
+
+To generate all postscript files for Figure 4, 5 and 6
+
+==> run epsMarchenkoIter.scr
+
+shotx0_rp.eps => Figure 4 R == Figure 3c
+p0plus.eps => Figure 4 G_d
+iter_001.eps => Figure 4 N_0
+
+shotx0_rp.eps => Figure 5 R == Figure 3c
+f1min_001.eps => Figure 5 f^-_1,0
+iter_002.eps => Figure 5 -N_1
+f1plus_002.eps => Figure 5 f^+_1,0
+
+-- Figure 6 column 1
+iter_001.eps
+iter_002.eps
+iter_003.eps
+iter_004.eps
+-- Figure 6 column 2
+f1min_001.eps
+f1min_002.eps
+f1min_003.eps
+f1min_004.eps
+-- Figure 6 column 3
+p0plus_flip.eps
+f1plus_002.eps
+f1plus_003.eps
+f1plus_004.eps
+-- Figure 6 column 4
+pgreen_001.eps
+pgreen_002.eps
+pgreen_003.eps
+pgreen_004.eps
+-- Figure 6 column 5
+compare_001.eps
+compare_002.eps
+compare_003.eps
+compare_004.eps
+
+
+Note that the script epsIterwithLabels.scr produces the same figures, but with axis-labels.
+
+--------------------------
+* Figure 7: Comparison of Marchenko result with reference
+
+To compute the marchenko results for 8 iterations.
+
+==> run marchenko.scr This will take less than 1 minute. The generated files are:
+ - pgreen.su, pgreen512.su
+ - diffref.su
+ - Gplus0.su
+ - Gmin0.su
+ - f1plus0.su
+ - f1min0.su
+ - f2.su
+
+
+At the end of the run the script will display in X11 a comparison of the middle trace.
+
+To make the postscript figure
+
+==> run epsCompare.scr
+
+mergeGreenRef.eps => Figure 7
+
+--------------------------
+* Figure 8: snapshots of back propagating f2 in actual medium
+
+To compute the snapshots
+
+==> run backpropf2.scr This will take about 1 minute. The generated output file is
+ - backpropf2_sp.su
+
+The postscript files of Figure 8 are generated with
+
+==> run epsBackprop.scr
+
+-- Figure 8 column 1
+backpropf2_-0.30.eps
+backpropf2_-0.15.eps
+backpropf2_-0.03.eps
+backpropf2_-0.02.eps
+backpropf2_0.00.eps
+-- Figure 8 column 2
+backpropf2_0.30.eps
+backpropf2_0.15.eps
+backpropf2_0.03.eps
+backpropf2_0.02.eps
+backpropf2_0.00.eps
+-- Figure 8 column 3
+backpropf2sum_0.30.eps
+backpropf2sum_0.15.eps
+backpropf2sum_0.03.eps
+backpropf2sum_0.02.eps
+backpropf2_0.00.eps
+
+
+The figures in the appendix, to explain the different options in the programs, are reproduced by
+
+==> run figAppendi.scr
+
+-- Figure A-1
+noise_above0.eps
+noise_above1.eps
+noise_above-1.eps
+noise_above2.eps
+noise_above4.eps
+
+-- Figure A-2
+iniFocus_shifts.eps
+
diff --git a/marchenko3D/demo/oneD/backProp_f2sum_movie.scr b/marchenko3D/demo/oneD/backProp_f2sum_movie.scr
new file mode 100755
index 0000000000000000000000000000000000000000..1c5168b5c82d5fa6d7d100588a102858861619aa
--- /dev/null
+++ b/marchenko3D/demo/oneD/backProp_f2sum_movie.scr
@@ -0,0 +1,34 @@
+#!/bin/bash
+
+# $1 input-file of backpropf2_sp.su format
+
+export PATH=$HOME/OpenSource/bin/:$PATH:
+
+#rm prop_movie.su
+
+for fldr in $(seq 1 101);
+do
+ times=$(echo "scale=2; -0.01*(${fldr}-101)" | bc -l)
+ echo " Adding ${fldr}-th frame"
+ suwind key=fldr min=$fldr max=$fldr < backpropf2_sp.su > neg.su
+ (( fldr = 101+(101-$fldr) ))
+ suwind key=fldr min=$fldr max=$fldr < backpropf2_sp.su > pos.su
+ susum neg.su pos.su >prop_frame.su
+
+ if [ "$fldr" != "201" ]; then
+ cat prop_movie.su prop_frame.su >temp_movie.su
+ mv temp_movie.su prop_movie.su
+ else
+ cp prop_frame.su prop_movie.su
+ fi
+done
+
+suchw <prop_movie.su key1=ntr key2=fldr b=1001 >temp_movie.su
+
+susort <temp_movie.su -fldr tracf >prop_movie.su
+
+rm neg.su pos.su temp_movie.su
+
+n2=`surange <backpropf2_sp.su | grep tracf | awk '{print $3}'`
+
+suxmovie <prop_movie.su loop=1 height=500 width=1000 title=%g n2=$n2
diff --git a/marchenko3D/demo/oneD/backpropf2.scr b/marchenko3D/demo/oneD/backpropf2.scr
new file mode 100755
index 0000000000000000000000000000000000000000..2041570cce37829889067b1a50a72277402c7c5f
--- /dev/null
+++ b/marchenko3D/demo/oneD/backpropf2.scr
@@ -0,0 +1,59 @@
+#!/bin/bash
+
+export PATH=$HOME/src/OpenSource/bin/:$PATH:
+
+dx=2.5
+dt=0.0005
+
+file_cp=model10_cp.su
+file_ro=model10_ro.su
+
+export OMP_NUM_THREADS=4
+
+# t=0 focal time is at 2.0445 seconds back=propagating
+# shift f2.su such that t=0 is positioned in the middle of the time axis
+# the extra shift of 0.000250 is needed because of the staggered time implementation of the Finite Difference program.
+ns=1024
+dtrcv=`surange < f2.su | grep dt | awk '{print $2/1000000.0}'`
+suwind key=gx min=-2250000 max=2250000 itmax=1023 < f2.su > nep.su
+shift=$(echo "scale=6; ($dtrcv*($ns/2.0-1)+$dt)" | bc -l)
+echo $shift
+basop choice=shift shift=$shift file_in=nep.su verbose=1 > pplus.su
+
+
+# the f2.su is sampled with 4ms the FD program need 0.5ms
+# time axis is interpolated by making use of FFT's: sinc interpolation
+#ftr1d file_in=pplus.su file_out=freq.su
+#sushw < freq.su key=nhs,dt a=8192,500 > fr.su
+#ftr1d file_in=fr.su n1=8194 file_out=pplusdt.su verbose=1
+#this is now done within the fdelmodc code:
+
+#backpropagate f2.su and collect snapshots
+fdelmodc \
+ file_cp=$file_cp ischeme=1 iorder=4 \
+ file_den=$file_ro \
+ file_src=pplus.su \
+ dt=$dt \
+ file_rcv=backprop_f2_z900.su \
+ grid_dir=0 \
+ src_type=1 \
+ src_injectionrate=1 \
+ src_orient=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.004 \
+ rec_delay=0.0 \
+ verbose=2 \
+ tmod=3.10 \
+ dxrcv=5.0 \
+ xrcv1=-2250 xrcv2=2250 \
+ zrcv1=900 zrcv2=900 \
+ zsrc=0 xsrc=0 \
+ npml=101 \
+ file_snap=backpropf2.su tsnap1=1.040 dtsnap=0.01 tsnap2=3.040 dxsnap=5 dzsnap=5 zsnap1=0 zsnap2=1250 xsnap1=-1000 xsnap2=1000 \
+ sna_type_vz=0 \
+ sna_type_p=1 \
+ left=2 right=2 top=2 bottom=2
+
+
diff --git a/marchenko3D/demo/oneD/clean b/marchenko3D/demo/oneD/clean
new file mode 100755
index 0000000000000000000000000000000000000000..3890128152ba3f4b11471dfdb5ddd1399840bc08
--- /dev/null
+++ b/marchenko3D/demo/oneD/clean
@@ -0,0 +1,4 @@
+#!/bin/bash
+
+rm *.su *.bin *.eps nep line* *.asci
+
diff --git a/marchenko3D/demo/oneD/conv.gnp b/marchenko3D/demo/oneD/conv.gnp
new file mode 100644
index 0000000000000000000000000000000000000000..119341bef971d8e8dc3e7e4123c32a64f674f5d3
--- /dev/null
+++ b/marchenko3D/demo/oneD/conv.gnp
@@ -0,0 +1,15 @@
+set style data linespoints
+set mytics 10
+set xlabel 'number of iterations'
+set ylabel 'convergence rate'
+set size 2.0,2.0
+set size ratio 0.6
+set grid
+
+set log y
+set nolog x
+
+set term postscript eps font 'Helvetica,12' linewidth 4 fontscale 3
+set output 'convergence.eps'
+plot 'conv.txt' using 1:($2) lw 3 notitle
+
diff --git a/marchenko3D/demo/oneD/conv.txt b/marchenko3D/demo/oneD/conv.txt
new file mode 100644
index 0000000000000000000000000000000000000000..f2e99f36e05c42e47cbbae161bfad8327bae2530
--- /dev/null
+++ b/marchenko3D/demo/oneD/conv.txt
@@ -0,0 +1,16 @@
+0 1.000000e+00
+1 8.104102e-01
+2 2.776407e-01
+3 1.775258e-01
+4 1.278046e-01
+5 8.376110e-02
+6 6.221900e-02
+7 4.089906e-02
+8 3.275844e-02
+9 2.070254e-02
+10 1.920658e-02
+11 1.091778e-02
+12 1.282995e-02
+13 6.060715e-03
+14 9.706275e-03
+15 3.603180e-03
diff --git a/marchenko3D/demo/oneD/epsBackprop.scr b/marchenko3D/demo/oneD/epsBackprop.scr
new file mode 100755
index 0000000000000000000000000000000000000000..5c2ecbcc92358b2cb0fe58a5914f54aabf1b4dc6
--- /dev/null
+++ b/marchenko3D/demo/oneD/epsBackprop.scr
@@ -0,0 +1,68 @@
+#!/bin/bash
+
+export PATH=$HOME/src/OpenSource/bin/:$PATH:
+
+# Add interface line to postscript file of model
+cat << EOF1 > line1
+400 -2500
+400 2500
+EOF1
+
+cat << EOF2 > line2
+700 -2500
+700 2500
+EOF2
+
+cat << EOF3 > line3
+1100 -2500
+1100 2500
+EOF3
+
+dx=5
+file_snap="backpropf2"
+dtsnap=0.01
+nsnap=101
+
+sumax < ${file_snap}_sp.su mode=abs outpar=nep
+clip=`cat nep | awk '{print $1/2}'`
+
+#first snap-shot with labels
+# fldr=71
+# times=$(echo "scale=2; $dtsnap*(${fldr}-$nsnap)" | bc -l)
+# atime=`printf "%4.2f" $times`
+# suwind key=fldr min=$fldr max=$fldr < ${file_snap}_sp.su | \
+# supsimage hbox=4 wbox=6 labelsize=10 \
+# label1="depth (m)" label2="lateral distance (m)" \
+# x1beg=0 x1end=1250.0 clip=${clip} \
+# curve=line1,line2,line3 npair=2,2,2 curvecolor=black,black,black curvedash=3,3,3 \
+# n1tic=4 f2=-1000 d2=$dx x2beg=-1000 f2num=-1000 d2num=500 x2end=1000 > ${file_snap}_${atime}_labels.eps
+
+for fldr in 71 86 98 99 101 103 104 116 131;
+do
+ times=$(echo "scale=2; $dtsnap*(${fldr}-$nsnap)" | bc -l)
+ atime=`printf "%4.2f" $times`
+ suwind key=fldr min=$fldr max=$fldr < ${file_snap}_sp.su | \
+ supsimage hbox=4 wbox=6 labelsize=10 \
+ x1beg=0 x1end=1250.0 clip=${clip} \
+ curve=line1,line2,line3 npair=2,2,2 curvecolor=black,black,black curvedash=3,3,3 \
+ n1tic=4 f2=-1000 d2=$dx x2beg=-1000 f2num=-1000 d2num=500 x2end=1000 > ${file_snap}_$atime.eps
+done
+
+#select files for snapshot between -0.7 => 0 <= +0.07 (fldr 31-101-171)
+#add pos and negative times to get response of homogenoeus Green's function
+
+file_snap="backpropf2"
+for fldr in 71 86 98 99 101;
+do
+ times=$(echo "scale=2; -0.01*(${fldr}-101)" | bc -l)
+ atime=`printf "%4.2f" $times`
+ suwind key=fldr min=$fldr max=$fldr < ${file_snap}_sp.su > neg.su
+ (( fldr = 101+(101-$fldr) ))
+ suwind key=fldr min=$fldr max=$fldr < ${file_snap}_sp.su > pos.su
+ susum neg.su pos.su | \
+ supsimage hbox=4 wbox=6 labelsize=10 \
+ x1beg=0 x1end=1250.0 clip=${clip} \
+ curve=line1,line2,line3 npair=2,2,2 curvecolor=black,black,black curvedash=3,3,3 \
+ n1tic=4 x2beg=-1000 d2=$dx f2num=-1000 d2num=500 x2end=1000 > ${file_snap}sum_$atime.eps
+done
+
diff --git a/marchenko3D/demo/oneD/epsCompare.scr b/marchenko3D/demo/oneD/epsCompare.scr
new file mode 100755
index 0000000000000000000000000000000000000000..e9dae68ee730f2cceb5b36018040ceca5b1f49fa
--- /dev/null
+++ b/marchenko3D/demo/oneD/epsCompare.scr
@@ -0,0 +1,37 @@
+#!/bin/bash
+
+export PATH=$HOME/src/OpenSource/bin/:$PATH:
+
+#mke figures for reference and Marchenko result an merge into one file
+
+file=diffref.su
+file_base=${file%.su}
+sumax < referenceP_rp.su mode=abs outpar=nep
+clipref=`cat nep | awk '{print $1}'`
+suwind key=gx min=-2250000 max=2250000 < $file | \
+ supsimage hbox=6 wbox=4 labelsize=10 linewidth=0.0 \
+ n1tic=2 d2=5 f1=0.0 x1beg=0 x1end=2.004 d1num=0.4 \
+ f2=-2250 f2num=-2000 d2num=1000 clip=$clipref > $file_base.eps
+suwind key=gx min=-2250000 max=2250000 < referenceP_rp.su | \
+ supsimage hbox=6 wbox=4 labelsize=10 linewidth=0.0 \
+ n1tic=2 d2=5 f1=0.0 x1beg=0 x1end=2.004 d1num=0.4 \
+ f2=-2250 f2num=-2000 d2num=1000 clip=$clipref > referenceP_rp.eps
+
+suwind < pgreen512.su j=50 s=1 | \
+ supswigp n2=19 fill=0 \
+ hbox=4 wbox=8 labelsize=10 linewidth=1.0 \
+ label1="time (s)" label2="lateral distance (m)" \
+ n1tic=2 d2=250 f1=0.0 x1beg=0 x1end=2.004 d1num=0.4 \
+ f2=-2250 f2num=-2000 d2num=500 > green.eps
+suwind < referenceP_rp.su j=50 s=1 | \
+ supswigp n2=19 fill=0 tracecolor=#F \
+ hbox=4 wbox=8 labelsize=10 linewidth=2.0 \
+ label1="time (s)" label2="lateral distance (m)" \
+ n1tic=2 d2=250 f1=0.0 x1beg=0 x1end=2.004 d1num=0.4 \
+ f2=-2250 f2num=-2000 d2num=500 > ref.eps
+
+sed -i.old -e "s/%%EndProlog/[ 1 1 ] 0 setdash %%EndProlog/" green.eps
+sed -i.old -e "s/0.5 0.5 0.5 setrgbcolor/0.65 0.65 0.65 setrgbcolor /" ref.eps
+
+psmerge in=ref.eps in=green.eps > mergeGreenRef.eps
+
diff --git a/marchenko3D/demo/oneD/epsIterwithLabels.scr b/marchenko3D/demo/oneD/epsIterwithLabels.scr
new file mode 100755
index 0000000000000000000000000000000000000000..cfb5a6a0e6e0a2515986007b94d8ee53faa4a74d
--- /dev/null
+++ b/marchenko3D/demo/oneD/epsIterwithLabels.scr
@@ -0,0 +1,76 @@
+#!/bin/bash
+
+export PATH=$HOME/src/OpenSource/bin/:$PATH:
+
+#mute to get pslinepos.asci files used in plotting only
+fmute file_shot=iniFocus_rp.su file_out=nep.su above=0 shift=8 verbose=1 check=1 hw=4
+
+#set same clip factor for iteration updates
+file=iter_001.su
+sumax < $file mode=abs outpar=nep
+clipiter=`cat nep | awk '{print $1/8}'`
+
+#set same clip factor for Green;s function updates
+file=pgreen_004.su
+file_base=${file%.su}
+sumax < $file mode=abs outpar=nep
+clipgreen=`cat nep | awk '{print $1/4}'`
+
+#iterations
+for (( iter=1; iter<=4; iter+=1 ))
+do
+piter=$(printf %03d $iter)
+echo $piter
+
+file=iter_$piter.su
+#ns=`surange < iter_001.su | grep ns | awk '{print $2}'`
+#dtrcv=`surange < iter_001.su | grep dt | awk '{print $2/1000000.0}'`
+#shift=$(echo "scale=4; ($dtrcv*($ns/2.0-1))" | bc -l)
+#basop choice=shift shift=$shift file_in=$file | \
+file_base=${file%.su}
+clipref=$clipiter
+supsimage hbox=6 wbox=4 labelsize=10 linewidth=0.0 < $file \
+ label1="time (s)" label2="lateral distance (m)" \
+ n1tic=2 d2=5 x1beg=-1.504 x1end=1.5 d1num=0.4 \
+ curve=pslinepos.asci,pslineneg.asci npair=901,901 curvewidth=2,2 curvecolor=black,black curvedash=3,3 \
+ f2=-2250 f2num=-2000 d2num=1000 clip=$clipref > ${file_base}_labels.eps
+
+file=f1min_$piter.su
+file_base=${file%.su}
+sumax < $file mode=abs outpar=nep
+clipref=`cat nep | awk '{print $1/5}'`
+supsimage hbox=6 wbox=4 labelsize=10 linewidth=0.0 < $file\
+ label1="time (s)" label2="lateral distance (m)" \
+ n1tic=2 d2=5 x1beg=-1.504 x1end=1.5 d1num=0.4 \
+ f2=-2250 f2num=-2000 d2num=1000 clip=$clipref > ${file_base}_labels.eps
+
+file=f1plus_$piter.su
+file_base=${file%.su}
+sumax < $file mode=abs outpar=nep
+clipref=`cat nep | awk '{print $1/5}'`
+supsimage hbox=6 wbox=4 labelsize=10 linewidth=0.0 < $file\
+ label1="time (s)" label2="lateral distance (m)" \
+ n1tic=2 d2=5 x1beg=-1.504 x1end=1.5 d1num=0.4 \
+ f2=-2250 f2num=-2000 d2num=1000 clip=$clipref > ${file_base}_labels.eps
+
+file=pgreen_$piter.su
+file_base=${file%.su}
+sumax < $file mode=abs outpar=nep
+clipref=`cat nep | awk '{print $1/4}'`
+suwind key=gx min=-2250000 max=2250000 < $file | \
+ supsimage hbox=6 wbox=4 labelsize=10 linewidth=0.0 \
+ label1="time (s)" label2="lateral distance (m)" \
+ n1tic=2 d2=5 f1=0.0 x1beg=0 x1end=2.004 d1num=0.4 \
+ f2=-2250 f2num=-2000 d2num=1000 clip=$clipgreen > ${file_base}_labels.eps
+
+done
+
+
+#special treatment of f1+ zero-iteration: which is zero, to make a nice gray plot (and not black)
+file=f1plus_001.su
+file_base=${file%.su}
+supsimage hbox=6 wbox=4 labelsize=10 linewidth=0.0 < $file\
+ label1="time (s)" label2="lateral distance (m)" \
+ n1tic=2 d2=5 x1beg=-1.504 x1end=1.5 d1num=0.4 \
+ f2=-2250 f2num=-2000 d2num=1000 bclip=1 wclip=-1> ${file_base}_labels.eps
+
diff --git a/marchenko3D/demo/oneD/epsMarchenkoIter.scr b/marchenko3D/demo/oneD/epsMarchenkoIter.scr
new file mode 100755
index 0000000000000000000000000000000000000000..b2a417474810933105a76d01eb2c37168367ffda
--- /dev/null
+++ b/marchenko3D/demo/oneD/epsMarchenkoIter.scr
@@ -0,0 +1,121 @@
+#!/bin/bash
+
+export PATH=$HOME/src/OpenSource/bin/:$PATH:
+
+
+#Direct field of transmission repsponse
+file=p0plus.su
+file_base=${file%.su}
+sumax < $file mode=abs outpar=nep
+clipref=`cat nep | awk '{print $1/2}'`
+
+ns=1024
+dtrcv=`surange < p0plus.su | grep dt | awk '{print $2/1000000.0}'`
+suwind key=gx min=-2250000 max=2250000 itmax=1023 < $file > nep.su
+shift=$(echo "scale=4; ($dtrcv*($ns/2.0-1))" | bc -l)
+basop choice=shift shift=$shift file_in=nep.su | \
+ suflip flip=3 | \
+ supsimage hbox=6 wbox=4 labelsize=10 linewidth=0.0 \
+ label1="time (s)" label2="lateral distance (m)" \
+ n1tic=2 d2=5 x1beg=-1.504 x1end=1.5 d1num=0.4 \
+ f2=-2250 f2num=-2000 d2num=1000 clip=$clipref > ${file_base}_flip.eps
+rm nep.su
+
+file=p0plus.su
+file_base=${file%.su}
+suwind key=gx min=-2250000 max=2250000 < $file | \
+ suflip flip=3 | \
+ supsimage hbox=6 wbox=4 labelsize=10 linewidth=0.0 \
+ label1="time (s)" label2="lateral distance (m)" \
+ n1tic=2 d2=5 f1=-2.044 f1num=-2.000 x1beg=-2.004 x1end=0.0 d1num=0.4 \
+ f2=-2250 f2num=-2000 d2num=1000 clip=$clipref > $file_base.eps
+
+#convolution of G_d with middle shot from R - not used -
+#suwind key=gx min=-2250000 max=2250000 < shot5_rp.su > shot0.su
+#fconv file_in1=iniFocus_rp.su file_in2=shot0.su file_out=GdRconv.su
+
+#mute to get pslinepos.asci files used in plotting only
+fmute file_shot=iniFocus_rp.su file_out=nep.su above=0 shift=8 verbose=1 check=1 hw=4
+
+#set same clip factor for iteration updates
+file=iter_001.su
+sumax < $file mode=abs outpar=nep
+clipiter=`cat nep | awk '{print $1/8}'`
+
+#set same clip factor for Green;s function updates
+file=pgreen_004.su
+file_base=${file%.su}
+sumax < $file mode=abs outpar=nep
+clipgreen=`cat nep | awk '{print $1/4}'`
+
+#iterations
+for (( iter=1; iter<=4; iter+=1 ))
+do
+piter=$(printf %03d $iter)
+echo $piter
+
+file=iter_$piter.su
+#ns=`surange < iter_001.su | grep ns | awk '{print $2}'`
+#dtrcv=`surange < iter_001.su | grep dt | awk '{print $2/1000000.0}'`
+#shift=$(echo "scale=4; ($dtrcv*($ns/2.0-1))" | bc -l)
+#basop choice=shift shift=$shift file_in=$file | \
+file_base=${file%.su}
+clipref=$clipiter
+supsimage hbox=6 wbox=4 labelsize=10 linewidth=0.0 < $file \
+ n1tic=2 d2=5 x1beg=-1.504 x1end=1.5 d1num=0.4 \
+ curve=pslinepos.asci,pslineneg.asci npair=901,901 curvewidth=2,2 curvecolor=black,black curvedash=3,3 \
+ f2=-2250 f2num=-2000 d2num=1000 clip=$clipref > $file_base.eps
+
+file=f1min_$piter.su
+file_base=${file%.su}
+sumax < $file mode=abs outpar=nep
+clipref=`cat nep | awk '{print $1/5}'`
+supsimage hbox=6 wbox=4 labelsize=10 linewidth=0.0 < $file\
+ n1tic=2 d2=5 x1beg=-1.504 x1end=1.5 d1num=0.4 \
+ f2=-2250 f2num=-2000 d2num=1000 clip=$clipref > $file_base.eps
+
+file=f1plus_$piter.su
+file_base=${file%.su}
+sumax < $file mode=abs outpar=nep
+clipref=`cat nep | awk '{print $1/5}'`
+supsimage hbox=6 wbox=4 labelsize=10 linewidth=0.0 < $file\
+ n1tic=2 d2=5 x1beg=-1.504 x1end=1.5 d1num=0.4 \
+ f2=-2250 f2num=-2000 d2num=1000 clip=$clipref > $file_base.eps
+
+file=pgreen_$piter.su
+file_base=${file%.su}
+sumax < $file mode=abs outpar=nep
+clipref=`cat nep | awk '{print $1/4}'`
+suwind key=gx min=-2250000 max=2250000 < $file | \
+ supsimage hbox=6 wbox=4 labelsize=10 linewidth=0.0 \
+ n1tic=2 d2=5 f1=0.0 x1beg=0 x1end=2.004 d1num=0.4 \
+ f2=-2250 f2num=-2000 d2num=1000 clip=$clipgreen > $file_base.eps
+
+#compare Green's funtions on Marhcenko and reference result
+suwind key=gx min=0 max=0 itmax=511 < pgreen_$piter.su | sumax mode=abs outpar=nepmg
+suwind key=gx min=0 max=0 itmax=511 < referenceP_rp.su | sumax mode=abs outpar=neprf
+mg1=`cat nepmg | awk '{print $1}'`
+rf1=`cat neprf | awk '{print $1}'`
+value=${value/[eE][+][0]/*10^}
+mg=${mg1/[eE][+][0]/*10^}
+rf=${rf1/[eE][+][0]/*10^}
+rm nep*
+scale=$(echo "scale=3; ($rf)/($mg)" | bc -l)
+scale=2.0
+echo $scale
+
+(suwind key=gx min=0 max=0 < referenceP_rp.su; \
+ suwind key=gx min=0 max=0 itmax=511 < pgreen_$piter.su | sugain scale=$scale ) | \
+ supsgraph hbox=6 wbox=2 labelsize=10 linegray=0.5,0.0 style=seismic \
+ lineon=1.0,1.0 lineoff=0.0,1.0 linewidth=1.0,1.0 x2beg=-$rf1 x2end=$rf1 > compare_$piter.eps
+
+done
+
+
+#special treatment of f1+ zero-iteration: which is zero, to make a nice gray plot (and not black)
+file=f1plus_001.su
+file_base=${file%.su}
+supsimage hbox=6 wbox=4 labelsize=10 linewidth=0.0 < $file\
+ n1tic=2 d2=5 x1beg=-1.504 x1end=1.5 d1num=0.4 \
+ f2=-2250 f2num=-2000 d2num=1000 bclip=1 wclip=-1> $file_base.eps
+
diff --git a/marchenko3D/demo/oneD/epsModel.scr b/marchenko3D/demo/oneD/epsModel.scr
new file mode 100755
index 0000000000000000000000000000000000000000..5ae0b460f468bf00cb8804d8882d6fa35a4f7885
--- /dev/null
+++ b/marchenko3D/demo/oneD/epsModel.scr
@@ -0,0 +1,68 @@
+#!/bin/bash
+
+export PATH=$HOME/src/OpenSource/bin/:$PATH:
+
+# Add interface line to postscript file of model
+cat << EOF1 > line1
+400 -2500
+400 2500
+EOF1
+
+cat << EOF2 > line2
+700 -2500
+700 2500
+EOF2
+
+cat << EOF3 > line3
+1100 -2500
+1100 2500
+EOF3
+
+#model
+supsimage hbox=4 wbox=6 labelsize=12 < model10_cp.su \
+ x1beg=0 x1end=1400.0 d1num=200 lstyle=vertright legend=1 threecolor=0 \
+ label1="depth (m)" label2="lateral distance (m)" \
+ curve=line1,line2,line3 npair=2,2,2 curvecolor=black,black,black \
+ n1tic=5 x2beg=-2250 f2num=-2000 d2num=1000 x2end=2250 > model_cp_line.eps
+
+supsimage hbox=4 wbox=6 labelsize=12 < model10_ro.su \
+ x1beg=0 x1end=1400.0 d1num=200 lstyle=vertright legend=1 threecolor=0 \
+ label1="depth (m)" label2="lateral distance (m)" \
+ curve=line1,line2,line3 npair=2,2,2 curvecolor=black,black,black \
+ n1tic=5 x2beg=-2250 f2num=-2000 d2num=1000 x2end=2250 > model_ro_line.eps
+
+#wavelet
+dt=0.0005
+supsgraph < wavefw.su \
+ labelsize=12 d1=$dt style=normal \
+ label1="time (s)" label2="amplitude" \
+ d1num=0.15 wbox=6 hbox=3 x1end=0.9 > wavefw.eps
+
+sufft < wavefw.su | suamp | sugain scale=$dt | supsgraph \
+ labelsize=12 style=normal \
+ label1="frequency (1/s)" label2="amplitude" \
+ d1num=10 wbox=6 hbox=3 x1end=125 x2end=1.1 > wavefw_freq.eps
+
+
+#shot record
+file=shot5_rp.su
+sumax < $file mode=abs outpar=nep
+clipref=`cat nep | awk '{print $1/3}'`
+suwind key=gx min=-2250000 max=2250000 < $file | \
+ supsimage hbox=6 wbox=4 labelsize=10 linewidth=0.0 \
+ label1="time (s)" label2="lateral distance (m)" \
+ n1tic=2 d2=5 f1=0.0 x1beg=0 x1end=2.004 d1num=0.4 \
+ f2=-2250 f2num=-2000 d2num=1000 clip=$clipref > shotx0_rp.eps
+
+#Initial focusing operator
+file=iniFocus_rp.su
+file_base=${file%.su}
+sumax < $file mode=abs outpar=nep
+clipref=`cat nep | awk '{print $1/3}'`
+suwind key=gx min=-2250000 max=2250000 < $file | \
+ supsimage hbox=6 wbox=4 labelsize=10 linewidth=0.0 \
+ label1="time (s)" label2="lateral distance (m)" \
+ n1tic=2 d2=5 f1=0.0 x1beg=0 x1end=2.004 d1num=0.4 \
+ f2=-2250 f2num=-2000 d2num=1000 clip=$clipref > $file_base.eps
+
+rm nep
diff --git a/marchenko3D/demo/oneD/figAppendix.scr b/marchenko3D/demo/oneD/figAppendix.scr
new file mode 100755
index 0000000000000000000000000000000000000000..295d2cf53c10926bd222f8bc05b310763bf2f7d1
--- /dev/null
+++ b/marchenko3D/demo/oneD/figAppendix.scr
@@ -0,0 +1,47 @@
+#!/bin/bash
+
+export PATH=$HOME/src/OpenSource/bin/:$PATH:
+
+file=iter_002.su
+file_base=${file%.su}
+
+ns=`surange < $file | grep ns | awk '{print $2}'`
+dtrcv=`surange < $file | grep dt | awk '{print $2/1000000.0}'`
+shift=$(echo "scale=4; ($dtrcv*($ns/2.0-1))" | bc -l)
+suzero < $file itmax=$ns | suaddnoise | sushw key=f1 a=0 > noise.su
+file_base=noise
+sumax < ${file_base}.su mode=abs outpar=nep
+clipiter=`cat nep | awk '{print $1/6}'`
+clipref=$clipiter
+
+#basop choice=shift shift=$shift file_in=$file file_out=${file_base}_t0.su
+
+for above in 0 1 -1 2 4
+do
+fmute file_mute=iniFocus_rp.su file_shot=${file_base}.su file_out=nep.su above=${above} shift=8 verbose=1 check=1 hw=4
+
+basop choice=shift shift=-$shift file_in=nep.su file_out=nep_t0.su
+supsimage hbox=6 wbox=4 labelsize=10 linewidth=0.0 < nep.su \
+ label1="time (s)" label2="lateral distance (m)" \
+ n1tic=2 d2=5 x1beg=0 d1num=0.5 \
+ curve=pslinepos.asci,pslineneg.asci npair=901,901 curvewidth=2,2 curvecolor=black,black curvedash=3,3 \
+ f2=-2250 f2num=-2000 d2num=1000 clip=$clipref > ${file_base}_above${above}.eps
+done
+
+for shift in 0 20 -20
+do
+fmute file_mute=iniFocus_rp.su file_shot=${file_base}.su file_out=nep.su above=${above} shift=$shift verbose=1 check=1 hw=4
+mv pslinepos.asci pslinepos${shift}.asci
+done
+
+suzero < $file itmax=$ns | sushw key=f1 a=0 > zero.su
+sumax < iniFocus_rp.su mode=abs outpar=nep
+clipiter=`cat nep | awk '{print $1/6}'`
+clipref=$clipiter
+supsimage hbox=6 wbox=4 labelsize=10 linewidth=0.0 < iniFocus_rp.su \
+ label1="time (s)" label2="lateral distance (m)" \
+ n1tic=2 d2=5 x1beg=0 d1num=0.5 \
+ curve=pslinepos0.asci,pslinepos20.asci,pslinepos-20.asci npair=901,901,901 \
+ curvewidth=1,1,1 curvecolor=white,black,black curvedash=3,3,3 \
+ f2=-2250 f2num=-2000 d2num=1000 clip=$clipref > iniFocus_shifts.eps
+
diff --git a/marchenko3D/demo/oneD/initialFocus.scr b/marchenko3D/demo/oneD/initialFocus.scr
new file mode 100755
index 0000000000000000000000000000000000000000..4d4fd68aee89b203d0976c9bfa2a4ac18d2f4731
--- /dev/null
+++ b/marchenko3D/demo/oneD/initialFocus.scr
@@ -0,0 +1,39 @@
+#!/bin/bash
+
+export PATH=$HOME/src/OpenSource/bin:$PATH:
+
+dx=2.5
+dt=0.0005
+
+#the model upto 900 m depth, deeper reflections are not needed to model the direct transmission response
+makemod sizex=10000 sizez=1400 dx=$dx dz=$dx cp0=1800 ro0=1000 \
+ orig=-5000,0 file_base=modelup.su verbose=2 \
+ intt=def x=-5000,5000 z=400,400 poly=0 cp=2300 ro=3000 \
+ intt=def x=-5000,5000 z=700,700 poly=0 cp=2000 ro=1100
+
+makewave fp=25 dt=$dt file_out=wave.su nt=4096 t0=0.1 scale=1
+
+export OMP_NUM_THREADS=1
+
+fdelmodc \
+ file_cp=modelup_cp.su ischeme=1 iorder=4 \
+ file_den=modelup_ro.su \
+ file_src=wave.su \
+ file_rcv=iniFocus.su \
+ src_type=1 \
+ src_orient=1 \
+ src_injectionrate=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.004 \
+ rec_delay=0.1 \
+ verbose=2 \
+ tmod=2.144 \
+ dxrcv=5 \
+ xrcv1=-2250 xrcv2=2250 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=0 zsrc=900 \
+ ntaper=101 \
+ left=2 right=2 top=2 bottom=2
+
diff --git a/marchenko3D/demo/oneD/marchenko.scr b/marchenko3D/demo/oneD/marchenko.scr
new file mode 100755
index 0000000000000000000000000000000000000000..0c48a3c1379499e239eaa03debb8ffa5d937e3d7
--- /dev/null
+++ b/marchenko3D/demo/oneD/marchenko.scr
@@ -0,0 +1,43 @@
+#!/bin/bash -x
+
+export PATH=$HOME/src/OpenSource/bin:$PATH:
+export OMP_NUM_THREADS=1
+
+#mute all events below the first arrival to get the intial focusing field
+fmute file_shot=iniFocus_rp.su file_out=p0plus.su above=-1 shift=-8 verbose=1 check=0 hw=8
+suwind < p0plus.su itmax=1024 > p0plus2.su
+
+#apply the Marchenko algorithm
+marchenko file_shot=shotsdx5_rp.su file_tinv=p0plus2.su nshots=901 verbose=2 \
+ tap=0 niter=8 hw=8 shift=12 smooth=3 scale=2 \
+ file_green=pgreen.su file_gplus=Gp.su file_gmin=Gm.su \
+ file_f1plus=f1p.su file_f1min=f1m.su file_f2=f2.su
+
+exit
+
+#compare Green's funtions on Marhcenko and reference result
+suwind key=gx min=0 max=0 itmax=511 < pgreen.su | sumax mode=abs outpar=nepmg
+suwind key=gx min=0 max=0 itmax=511 < referenceP_rp.su | sumax mode=abs outpar=neprf
+mg=`cat nepmg | awk '{print $1}'`
+rf=`cat neprf | awk '{print $1}'`
+value=${value/[eE][+][0]/*10^}
+mg=${mg/[eE][+][0]/*10^}
+rf=${rf/[eE][+][0]/*10^}
+rm nep*
+scale=$(echo "scale=3; ($rf)/($mg)" | bc -l)
+echo $scale
+
+(suwind key=gx min=0 max=0 itmax=511 < pgreen.su | sugain scale=$scale; \
+ suwind key=gx min=0 max=0 < referenceP_rp.su) | suxgraph
+
+#suwind itmax=511 < pgreen.su > pgreen512.su
+#suop2 pgreen512.su referenceP_rp.su op=diff w2=1 w1=$scale > diffref.su
+
+# plot for convergence rate, the values in conv.txt are collected from the output of the marhenko program with verbose=2
+# marchenko: - iSyn 0: Ni at iteration 0 has energy 6.234892e+02; relative to N0 1.000000e+00
+#a2b < conv.txt | \
+#psgraph n=16 style=normal hbox=2 wbox=6 labelsize=10 \
+#label2='convergence rate' label1='iteration number' > convergence.eps
+
+# If guplot is installed: the same plot can also be produced by gnuplot this figure is used in the paper
+#gnuplot conv.gnp
diff --git a/marchenko3D/demo/oneD/marchenkoIter.scr b/marchenko3D/demo/oneD/marchenkoIter.scr
new file mode 100755
index 0000000000000000000000000000000000000000..401f97f7c2108e92e0ff5ca813d9fdfd2b4d183a
--- /dev/null
+++ b/marchenko3D/demo/oneD/marchenkoIter.scr
@@ -0,0 +1,21 @@
+#!/bin/bash -x
+
+export PATH=$HOME/src/OpenSource/bin:$PATH:
+export OMP_NUM_THREADS=1
+
+#mute all events below the first arrival to get the intial focusing field
+fmute file_shot=iniFocus_rp.su file_out=p0plus.su above=-1 shift=-8 verbose=1 check=0 hw=4
+
+for (( iter=1; iter<=4; iter+=1 ))
+do
+echo "doing iteration $iter"
+piter=$(printf %03d $iter)
+
+#apply the Marchenko algorithm
+marchenko file_shot=shotsdx5_rp.su file_tinv=p0plus.su nshots=901 verbose=1 \
+ tap=0 ntap=41 niter=$iter hw=12 shift=8 smooth=5 \
+ file_green=pgreen_$piter.su file_iter=iter.su \
+ file_f1plus=f1plus_$piter.su file_f1min=f1min_$piter.su
+
+done
+
diff --git a/marchenko3D/demo/oneD/model.scr b/marchenko3D/demo/oneD/model.scr
new file mode 100755
index 0000000000000000000000000000000000000000..9165e8758862d4cef0b497ca585bea46336e9d13
--- /dev/null
+++ b/marchenko3D/demo/oneD/model.scr
@@ -0,0 +1,77 @@
+#!/bin/bash
+
+#adjust this PATH to where the code is installed
+export PATH=$HOME/src/OpenSource/bin:$PATH:
+
+dx=2.5
+dt=0.0005
+
+#define gridded model for FD computations
+makemod sizex=10000 sizez=1400 dx=$dx dz=$dx cp0=1800 ro0=1000 \
+ orig=-5000,0 file_base=model10.su verbose=2 \
+ intt=def x=-5000,5000 z=400,400 poly=0 cp=2300 ro=3000 \
+ intt=def x=-5000,5000 z=700,700 poly=0 cp=2000 ro=1100 \
+ intt=def x=-5000,5000 z=1100,1100 poly=0 cp=2500 ro=4000
+
+#define wavelet for modeling R
+makewave w=fw fmin=0 flef=5 frig=80 fmax=100 dt=$dt file_out=wavefw.su nt=4096 t0=0.3 scale=0 scfft=1
+
+#define wavelet for reference and intial focusing field.
+makewave fp=25 dt=$dt file_out=wave.su nt=4096 t0=0.1 scale=1
+
+export OMP_NUM_THREADS=4
+
+#Model shot record in middle of model
+fdelmodc \
+ file_cp=model10_cp.su ischeme=1 iorder=4 \
+ file_den=model10_ro.su \
+ file_src=wavefw.su \
+ file_rcv=shot5_fd.su \
+ src_type=7 \
+ src_orient=1 \
+ src_injectionrate=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.004 \
+ rec_delay=0.3 \
+ verbose=2 \
+ tmod=4.392 \
+ dxrcv=5.0 \
+ xrcv1=-4500 xrcv2=4500 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=0 zsrc=0 \
+ npml=101 \
+ left=2 right=2 top=2 bottom=2
+
+#define homogenoeus model to compute direct wave only
+makemod sizex=10000 sizez=1200 dx=$dx dz=$dx cp0=1800 ro0=1000 \
+ orig=-5000,0 file_base=hom.su verbose=2
+
+#Model direct wave only in middle of model
+fdelmodc \
+ file_cp=hom_cp.su ischeme=1 iorder=4 \
+ file_den=hom_ro.su \
+ file_src=wavefw.su \
+ file_rcv=shot5_hom_fd.su \
+ src_type=7 \
+ src_orient=1 \
+ src_injectionrate=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.004 \
+ rec_delay=0.3 \
+ verbose=2 \
+ tmod=4.392 \
+ dxrcv=5.0 \
+ xrcv1=-4500 xrcv2=4500 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=0 zsrc=0 \
+ npml=101 \
+ left=2 right=2 top=2 bottom=2
+
+#subtract direct wave from full model shot record: this defines R
+sudiff shot5_fd_rp.su shot5_hom_fd_rp.su > shot5_rp.su
+
+
diff --git a/marchenko3D/demo/oneD/p5all.scr b/marchenko3D/demo/oneD/p5all.scr
new file mode 100755
index 0000000000000000000000000000000000000000..ca9877f16937fcf714309842e7a713a31c6d003c
--- /dev/null
+++ b/marchenko3D/demo/oneD/p5all.scr
@@ -0,0 +1,30 @@
+#!/bin/bash -x
+
+export PATH=$HOME/src/OpenSource/bin:$PATH:
+
+# Generate the full R matrix for a fixed spread geometry.
+
+dxshot=5000 # with scalco factor of 1000
+ishot=0
+nshots=901
+
+echo $1
+
+rm shotsdx5_rp.su
+
+while (( ishot < nshots ))
+do
+
+ (( xsrc = -2250000 + ${ishot}*${dxshot} ))
+ (( tr1 = $nshots - ${ishot} ))
+ (( tr2 = ${tr1} + $nshots - 1 ))
+ echo xsrc=$xsrc tr1=$tr1 tr2=$tr2
+
+ (( ishot = $ishot + 1))
+
+ suwind < shot5_rp.su key=tracl min=$tr1 max=$tr2 | \
+ sushw key=sx,gx,fldr,trwf \
+ a=$xsrc,-2250000,$ishot,$nshots b=0,$dxshot,0,0 j=0,$nshots,0,0 | \
+ suchw key1=offset key2=gx key3=sx c=-1 d=1000 >> shotsdx5_rp.su
+
+done
diff --git a/marchenko3D/demo/oneD/referenceShot.scr b/marchenko3D/demo/oneD/referenceShot.scr
new file mode 100755
index 0000000000000000000000000000000000000000..b7a2b771341b3115d71bfebe2ec06e308846cbc6
--- /dev/null
+++ b/marchenko3D/demo/oneD/referenceShot.scr
@@ -0,0 +1,34 @@
+#!/bin/bash
+
+export PATH=$HOME/src/OpenSource/bin:$PATH:
+
+#Compute the reference Green's fucntion at x=0 z=900 m in the actual model
+dx=2.5
+dt=0.0005
+
+makewave fp=25 dt=$dt file_out=wave.su nt=4096 t0=0.1 scale=1
+
+export OMP_NUM_THREADS=2
+
+fdelmodc \
+ file_cp=model10_cp.su ischeme=1 iorder=4 \
+ file_den=model10_ro.su \
+ file_src=wave.su \
+ file_rcv=referenceP.su \
+ src_type=1 \
+ src_orient=1 \
+ src_injectionrate=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.004 \
+ rec_delay=0.1 \
+ verbose=2 \
+ tmod=2.144 \
+ dxrcv=5.0 \
+ xrcv1=-2250 xrcv2=2250 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=0 zsrc=900 \
+ ntaper=101 \
+ left=2 right=2 top=2 bottom=2
+
diff --git a/marchenko3D/demo/test/test.scr b/marchenko3D/demo/test/test.scr
new file mode 100755
index 0000000000000000000000000000000000000000..af4ff97379d801e03f38fd63eefcf28235ff5e3a
--- /dev/null
+++ b/marchenko3D/demo/test/test.scr
@@ -0,0 +1,5 @@
+#!/bin/bash
+
+./../../test file_shot=shot_gy.su
+./../../test file_shot=shot_sxgy.su
+./../../test file_shot=shot_sxsygy.su
diff --git a/marchenko3D/demo/twoD/README b/marchenko3D/demo/twoD/README
new file mode 100644
index 0000000000000000000000000000000000000000..a4c7852f088a25f6f53418e9043f5cf5565d6bb4
--- /dev/null
+++ b/marchenko3D/demo/twoD/README
@@ -0,0 +1,10 @@
+Description of files:
+1a) model.scr computes the model
+1b) shots_slurm/pbs.scr creates the shots and submit jobs to slurm or PBS
+1c) check.scr after the jobs on shots_*.scr are finished checks if all shots are there
+2) direct.scr creates the direct arrival to be removed from the shots
+3) remove_direct.scr remove the direct wave from the shots
+4) initialFocus.scr model G_d the intitial focusing function => iniFocus_z1100_x0_rp.su
+5) referenceShot.scr creates the reference Green's function at focal point => referenceP_rp.su
+6) marchenko.scr perform the Marchenko scheme
+
diff --git a/marchenko3D/demo/twoD/backProp_makemovie.scr b/marchenko3D/demo/twoD/backProp_makemovie.scr
new file mode 100755
index 0000000000000000000000000000000000000000..d039c054b2c7fc73c3694c6e075bbbb495005b01
--- /dev/null
+++ b/marchenko3D/demo/twoD/backProp_makemovie.scr
@@ -0,0 +1,34 @@
+#!/bin/bash
+
+# $1 input-file of backpropf2_sp.su format
+
+export PATH=$HOME/OpenSource/bin/:$PATH:
+
+#rm prop_movie.su
+
+for fldr in $(seq 1 101);
+do
+ times=$(echo "scale=2; -0.01*(${fldr}-101)" | bc -l)
+ echo " Adding ${fldr}-th frame"
+ suwind key=fldr min=$fldr max=$fldr < backpropmar_sp.su > neg.su
+ (( fldr = 101+(101-$fldr) ))
+ suwind key=fldr min=$fldr max=$fldr < backpropmar_sp.su > pos.su
+ susum neg.su pos.su >prop_frame.su
+
+ if [ "$fldr" != "201" ]; then
+ cat prop_movie.su prop_frame.su >temp_movie.su
+ mv temp_movie.su prop_movie.su
+ else
+ cp prop_frame.su prop_movie.su
+ fi
+done
+
+suchw <prop_movie.su key1=ntr key2=fldr b=1001 >temp_movie.su
+
+susort <temp_movie.su -fldr tracf >prop_movie.su
+
+rm neg.su pos.su temp_movie.su
+
+n2=`surange <backpropmar_sp.su | grep tracf | awk '{print $3}'`
+
+suxmovie <prop_movie.su loop=1 height=500 width=1000 title=%g n2=$n2
diff --git a/marchenko3D/demo/twoD/backpropf2.scr b/marchenko3D/demo/twoD/backpropf2.scr
new file mode 100755
index 0000000000000000000000000000000000000000..0b7c281ba11e4fdfb8059547c0bdd3d15bc80861
--- /dev/null
+++ b/marchenko3D/demo/twoD/backpropf2.scr
@@ -0,0 +1,59 @@
+#!/bin/bash
+
+export PATH=$HOME/OpenSource/bin/:$PATH:
+
+dx=2.5
+dt=0.0005
+
+file_cp=syncl_cp.su
+file_ro=syncl_ro.su
+
+export OMP_NUM_THREADS=8
+
+# t=0 focal time is at 2.0445 seconds back=propagating (dtrcv*(ns/2-1)+dt)
+# shift f2.su such that t=0 is positioned in the middle of the time axis
+# the extra shift of 0.000250 is needed because of the staggered time implementation of the Finite Difference program.
+ns=`surange <f2.su | grep ns | awk '{print $2}'`
+dtrcv=`surange < f2.su | grep dt | awk '{print $2/1000000.0}'`
+suwind key=gx min=-2250000 max=2250000 itmax=1023 < f2.su > nep.su
+shift=$(echo "scale=6; ($dtrcv*(($ns)/2.0-1)+$dt)" | bc -l)
+echo $shift
+basop choice=shift shift=$shift file_in=nep.su verbose=1 > pplus.su
+
+# the f2.su is sampled with 4ms the FD program needs 0.5ms
+# time axis is interpolated by making use of FFT's: sinc interpolation
+#ftr1d file_in=pplus.su file_out=freq.su
+#sushw <freq.su key=nhs,dt a=8192,500 >fr.su
+#ftr1d file_in=fr.su n1=8194 file_out=pplusdt.su verbose=1
+
+midsnap=2.04
+
+#backpropagate f2.su and collect snapshots
+fdelmodc \
+ file_cp=$file_cp ischeme=1 iorder=4 \
+ file_den=$file_ro \
+ file_src=pplus.su \
+ file_rcv=backprop_f2_z1100.su \
+ dt=$dt \
+ grid_dir=0 \
+ src_type=1 \
+ src_injectionrate=1 \
+ src_orient=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.004 \
+ rec_delay=0.0 \
+ verbose=2 \
+ tmod=3.10 \
+ dxrcv=10.0 \
+ xrcv1=-3000 xrcv2=3000 \
+ zrcv1=1100 zrcv2=1100 \
+ zsrc=0 xsrc=0 \
+ npml=101 \
+ file_snap=backpropmar.su tsnap1=`echo "$midsnap-1" | bc -l` dtsnap=0.01 tsnap2=`echo "$midsnap+1" | bc -l` dxsnap=5 dzsnap=5 zsnap1=0 zsnap2=2000 xsnap1=-2250 xsnap2=2250 \
+ sna_type_vz=0 \
+ sna_type_p=1 \
+ left=2 right=2 top=2 bottom=2
+
+
diff --git a/marchenko3D/demo/twoD/check.scr b/marchenko3D/demo/twoD/check.scr
new file mode 100755
index 0000000000000000000000000000000000000000..f1a40feb5fd574e1f48f5c7a4acd5981e03e8aca
--- /dev/null
+++ b/marchenko3D/demo/twoD/check.scr
@@ -0,0 +1,24 @@
+#!/bin/bash
+
+dxshot=10
+ishot=0
+nshots=601
+zsrc=0
+
+while (( ishot < nshots ))
+do
+
+ (( xsrc = -3000 + ${ishot}*${dxshot} ))
+
+ file_rcv=shots/shots_${xsrc}_rp.su
+
+ if [ ! -e "$file_rcv" ]
+ then
+ echo $xsrc is missing
+ sbatch jobs/slurm_$ishot.job
+ fi
+
+ (( ishot = $ishot + 1))
+
+done
+
diff --git a/marchenko3D/demo/twoD/clean b/marchenko3D/demo/twoD/clean
new file mode 100755
index 0000000000000000000000000000000000000000..0d2611c04c3751b3c7d36314cb089b3fcdc6b864
--- /dev/null
+++ b/marchenko3D/demo/twoD/clean
@@ -0,0 +1,4 @@
+#!/bin/bash
+
+rm *.su *.bin *.txt *.eps nep *.asci
+
diff --git a/marchenko3D/demo/twoD/direct.scr b/marchenko3D/demo/twoD/direct.scr
new file mode 100755
index 0000000000000000000000000000000000000000..48ef53e850d9ee80f8b91027b36fbcbd7d825037
--- /dev/null
+++ b/marchenko3D/demo/twoD/direct.scr
@@ -0,0 +1,35 @@
+#!/bin/bash
+
+export PATH=$HOME/src/OpenSource/bin:$PATH:
+
+dx=2.5
+dt=0.0005
+
+makemod sizex=12000 sizez=4000 dx=$dx dz=$dx cp0=1900 ro0=1200 \
+ orig=-6000,-1000 file_base=noContrast.su
+
+export OMP_NUM_THREADS=8
+makewave w=fw fmin=0 flef=5 frig=80 fmax=100 dt=$dt file_out=wavefw.su nt=4096 t0=0.3 scale=0
+
+fdelmodc \
+ file_cp=noContrast_cp.su ischeme=1 iorder=4 \
+ file_den=noContrast_ro.su \
+ file_src=wavefw.su \
+ file_rcv=direct.su \
+ src_type=7 \
+ src_orient=1 \
+ src_injectionrate=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ rec_delay=0.3 \
+ dtrcv=0.004 \
+ verbose=2 \
+ tmod=4.392 \
+ dxrcv=10.0 \
+ xrcv1=-6000 xrcv2=6000 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=0 zsrc=0 \
+ ntaper=200 \
+ left=2 right=2 top=2 bottom=2
+
diff --git a/marchenko3D/demo/twoD/initialFocus_pbs.scr b/marchenko3D/demo/twoD/initialFocus_pbs.scr
new file mode 100755
index 0000000000000000000000000000000000000000..eb4e0c1d48c1a8533905a0ba3a0f6092dc48897d
--- /dev/null
+++ b/marchenko3D/demo/twoD/initialFocus_pbs.scr
@@ -0,0 +1,77 @@
+#!/bin/bash
+
+export PATH=$HOME/src/OpenSource/bin:$PATH:
+
+dx=2.5
+dt=0.0005
+
+makemod sizex=6000 sizez=2000 dx=$dx dz=$dx cp0=1900 ro0=1200 \
+ orig=-3000,0 file_base=synclDown.su verbose=2 \
+ intt=def x=-3000,500,3000 z=195,195,195 poly=1 cp=1950 ro=3700 \
+ intt=def x=-3000,3000 z=600,600 poly=0 cp=2050 ro=1750 \
+ intt=def x=-3000,3000 z=680,680 poly=0 cp=2150 ro=2220 \
+ intt=def x=-3000,3000 z=780,780 poly=0 cp=2230 ro=1700 \
+ intt=def x=-3000,-2200,-1500,0,1300,2100,3000 z=520,580,680,840,680,600,500 poly=2 cp=2400 ro=2800 \
+
+makewave fp=20 dt=$dt file_out=wave.su nt=4096 t0=0.1 scale=1
+
+dxshot=10
+ishot=300
+nshots=301
+
+export OMP_NUM_THREADS=1
+mkdir -p shots
+mkdir -p jobs
+
+while (( ishot < nshots ))
+do
+
+ (( xsrc = -3000 + ${ishot}*${dxshot} ))
+ echo xsrc=$xsrc
+ file_rcv=shots/iniFocus_z1100_x${xsrc}.su
+
+cat << EOF > jobs/pbs_$ishot.job
+#!/bin/bash
+#
+#PBS -q medium
+#PBS -N mod_${xsrc}
+#PBS -j eo
+#PBS -m n
+#PBS -l nodes=1
+#PBS -V
+
+export PATH=\$HOME/src/OpenSource/bin:\$PATH:
+cd \$PBS_O_WORKDIR
+
+export OMP_NUM_THREADS=4
+
+fdelmodc \
+ file_cp=synclDown_cp.su ischeme=1 iorder=4 \
+ file_den=synclDown_ro.su \
+ file_src=wave.su \
+ file_rcv=$file_rcv \
+ src_type=1 \
+ src_orient=1 \
+ src_injectionrate=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ rec_delay=0.1 \
+ dtrcv=0.004 \
+ verbose=2 \
+ tmod=2.100 \
+ dxrcv=10.0 \
+ xrcv1=-3000 xrcv2=3000 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=$xsrc zsrc=1100 \
+ ntaper=200 \
+ left=2 right=2 top=2 bottom=2
+EOF
+
+ qsub jobs/pbs_$ishot.job
+
+ (( ishot = $ishot + 1))
+done
+
+
+
diff --git a/marchenko3D/demo/twoD/initialFocus_slurm.scr b/marchenko3D/demo/twoD/initialFocus_slurm.scr
new file mode 100755
index 0000000000000000000000000000000000000000..a94a11d1a159d2f739a004a7ce3c86b627088223
--- /dev/null
+++ b/marchenko3D/demo/twoD/initialFocus_slurm.scr
@@ -0,0 +1,75 @@
+#!/bin/bash
+
+export PATH=$HOME/src/OpenSource/bin:$PATH:
+
+dx=2.5
+dt=0.0005
+
+makemod sizex=6000 sizez=2000 dx=$dx dz=$dx cp0=1900 ro0=1200 \
+ orig=-3000,0 file_base=synclDown.su verbose=2 \
+ intt=def x=-3000,500,3000 z=195,195,195 poly=1 cp=1950 ro=3700 \
+ intt=def x=-3000,3000 z=600,600 poly=0 cp=2050 ro=1750 \
+ intt=def x=-3000,3000 z=680,680 poly=0 cp=2150 ro=2220 \
+ intt=def x=-3000,3000 z=780,780 poly=0 cp=2230 ro=1700 \
+ intt=def x=-3000,-2200,-1500,0,1300,2100,3000 z=520,580,680,840,680,600,500 poly=2 cp=2400 ro=2800 \
+
+makewave fp=20 dt=$dt file_out=wave.su nt=4096 t0=0.1 scale=1
+
+dxshot=10
+ishot=300
+nshots=301
+
+export OMP_NUM_THREADS=1
+mkdir -p shots
+mkdir -p jobs
+
+while (( ishot < nshots ))
+do
+
+ (( xsrc = -3000 + ${ishot}*${dxshot} ))
+ echo xsrc=$xsrc
+ file_rcv=shots/iniFocus_z1100_x${xsrc}.su
+
+cat << EOF > jobs/slurm_$ishot.job
+#!/bin/bash
+#
+#SBATCH -J mod_${xsrc}
+#SBATCH --cpus-per-task=4
+#SBATCH --ntasks=1
+#SBATCH --time=0:20:00
+
+export PATH=\$HOME/src/OpenSource/bin:\$PATH:
+cd \$SLURM_SUBMIT_DIR
+
+export OMP_NUM_THREADS=4
+
+fdelmodc \
+ file_cp=synclDown_cp.su ischeme=1 iorder=4 \
+ file_den=synclDown_ro.su \
+ file_src=wave.su \
+ file_rcv=$file_rcv \
+ src_type=1 \
+ src_orient=1 \
+ src_injectionrate=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ rec_delay=0.1 \
+ dtrcv=0.004 \
+ verbose=2 \
+ tmod=2.100 \
+ dxrcv=10.0 \
+ xrcv1=-3000 xrcv2=3000 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=$xsrc zsrc=1100 \
+ ntaper=200 \
+ left=2 right=2 top=2 bottom=2
+EOF
+
+ sbatch jobs/slurm_$ishot.job
+
+ (( ishot = $ishot + 1))
+done
+
+
+
diff --git a/marchenko3D/demo/twoD/marchenko.scr b/marchenko3D/demo/twoD/marchenko.scr
new file mode 100755
index 0000000000000000000000000000000000000000..fcbb45ccb77f50f142d07a4824e889363e309a95
--- /dev/null
+++ b/marchenko3D/demo/twoD/marchenko.scr
@@ -0,0 +1,30 @@
+#!/bin/bash -x
+
+export PATH=$HOME/src/OpenSource/bin:$PATH:
+
+export OMP_NUM_THREADS=1
+
+#mute all events below the first arrival to get the intial focusing field
+fmute file_shot=shots/iniFocus_z1100_x0_rp.su file_out=p0plus.su above=-1 shift=-10 verbose=1 check=1 hw=4
+
+#apply the Marchenko algorithm
+marchenko file_shot=shots/refl_rp.su file_tinv=p0plus.su nshots=601 verbose=1 \
+ tap=0 niter=15 hw=8 shift=7 smooth=3 \
+ file_green=pgreen.su file_gplus=Gplus0.su file_gmin=Gmin0.su \
+ file_f1plus=f1plus0.su file_f1min=f1min0.su file_f2=f2.su
+
+#compare Green's funtions on Marhcenko and reference result
+suwind key=gx min=0 max=0 itmax=511 < pgreen.su | sumax mode=abs outpar=nepmg
+suwind key=gx min=0 max=0 itmax=511 < referenceP_rp.su | sumax mode=abs outpar=neprf
+mg=`cat nepmg | awk '{print $1}'`
+rf=`cat neprf | awk '{print $1}'`
+value=${value/[eE][+][0]/*10^}
+mg=${mg/[eE][+][0]/*10^}
+rf=${rf/[eE][+][0]/*10^}
+rm nep*
+scale=$(echo "scale=3; ($rf)/($mg)" | bc -l)
+echo $scale
+
+(suwind key=gx min=0 max=0 itmax=511 < pgreen.su | sugain scale=$scale; \
+ suwind key=gx min=0 max=0 < referenceP_rp.su) | suxgraph
+
diff --git a/marchenko3D/demo/twoD/model.scr b/marchenko3D/demo/twoD/model.scr
new file mode 100755
index 0000000000000000000000000000000000000000..f41606ab0cddeb19ab11c3f5af5c5c16ec8d9e93
--- /dev/null
+++ b/marchenko3D/demo/twoD/model.scr
@@ -0,0 +1,82 @@
+#!/bin/bash
+
+export PATH=$HOME/src/OpenSource/bin:$PATH:
+
+dx=2.5
+dt=0.0005
+
+makemod sizex=6000 sizez=2000 dx=$dx dz=$dx cp0=1900 ro0=1200 \
+ orig=-3000,0 file_base=syncl.su verbose=2 \
+ intt=def x=-3000,500,3000 z=195,195,195 poly=1 cp=1950 ro=3700 \
+ intt=def x=-3000,3000 z=600,600 poly=0 cp=2050 ro=1750 \
+ intt=def x=-3000,3000 z=680,680 poly=0 cp=2150 ro=2220 \
+ intt=def x=-3000,3000 z=780,780 poly=0 cp=2230 ro=1700 \
+ intt=def x=-3000,-2200,-1500,0,1300,2100,3000 z=520,580,680,840,680,600,500 poly=2 cp=2400 ro=2800 \
+ intt=def x=-3000,0,3000 z=1110,1110,1110 poly=0 cp=2300 ro=1950 \
+ intt=def x=-3000,3000 z=1180,1180 poly=0 cp=2480 ro=1820 \
+ intt=def x=-3000,0,3000 z=1290,1290,1370 poly=0 cp=2600 ro=2000 \
+ intt=def x=-3000,3000 z=1380,1380 poly=0 cp=2720 ro=2050 \
+ intt=def x=-3000,3000 z=1480,1480 poly=0 cp=2800 ro=1850
+
+exit
+
+#example FD modeling with model defined above
+makewave w=fw fmin=0 flef=5 frig=80 fmax=100 dt=$dt file_out=wavefw.su nt=4096 t0=0.3 scale=0
+
+export OMP_NUM_THREADS=4
+
+makewave fp=20 dt=$dt file_out=wave.su nt=4096 t0=0.1 scale=1
+
+fdelmodc \
+ file_cp=syncl_cp.su ischeme=1 iorder=4 \
+ file_den=syncl_ro.su \
+ file_src=wave.su \
+ file_rcv=shot_fd.su \
+ src_type=1 \
+ src_orient=1 \
+ src_injectionrate=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.0010 \
+ rec_delay=0.1 \
+ verbose=2 \
+ tmod=4.195 \
+ dxrcv=10.0 \
+ xrcv1=-2250 xrcv2=2250 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=0 zsrc=0 \
+ ntaper=200 \
+ tsnap1=3.1 tsnap2=2.5 dtsnap=0.1 \
+ left=2 right=2 top=2 bottom=2
+
+
+
+makemod sizex=6000 sizez=2000 dx=$dx dz=$dx cp0=1900 ro0=1200 \
+ orig=-3000,-1000 file_base=hom.su
+
+fdelmodc \
+ file_cp=hom_cp.su ischeme=1 iorder=4 \
+ file_den=hom_ro.su \
+ file_src=wave.su \
+ file_rcv=shot_hom_fd.su \
+ src_type=1 \
+ src_orient=1 \
+ src_injectionrate=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.0010 \
+ rec_delay=0.1 \
+ verbose=2 \
+ tmod=4.195 \
+ dxrcv=10.0 \
+ xrcv1=-2250 xrcv2=2250 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=0 zsrc=0 \
+ ntaper=400 \
+ left=4 right=4 top=4 bottom=4
+
+sudiff shot_fd_rp.su shot_hom_fd_rp.su > shot_rp.su
+
+
diff --git a/marchenko3D/demo/twoD/referenceShot.scr b/marchenko3D/demo/twoD/referenceShot.scr
new file mode 100755
index 0000000000000000000000000000000000000000..4c015f6baa98c092e3210801e3a6caff68fd34ad
--- /dev/null
+++ b/marchenko3D/demo/twoD/referenceShot.scr
@@ -0,0 +1,38 @@
+#!/bin/bash
+
+export PATH=$HOME/src/OpenSource/bin:$PATH:
+
+#makewave w=fw fmin=0 flef=5 frig=80 fmax=100 dt=$dt file_out=wavefw.su nt=4096 t0=0.3
+
+dx=2.5
+dt=0.0005
+
+makewave fp=20 dt=$dt file_out=wave.su nt=4096 t0=0.1 scale=1
+
+export OMP_NUM_THREADS=8
+
+fdelmodc \
+ file_cp=syncl_cp.su ischeme=1 iorder=4 \
+ file_den=syncl_ro.su \
+ file_src=wave.su \
+ file_rcv=referenceP.su \
+ src_type=1 \
+ src_orient=1 \
+ src_injectionrate=1 \
+ rec_type_ud=1 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.004 \
+ rec_delay=0.1 \
+ verbose=2 \
+ tmod=2.144 \
+ dxrcv=10.0 \
+ xrcv1=-3000 xrcv2=3000 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=0 zsrc=1100 \
+ file_snap=backpropref.su tsnap1=0.1 dtsnap=0.010 tsnap2=2.100 \
+ dxsnap=10 dzsnap=10 zsnap1=0 zsnap2=2000 xsnap1=-2250 xsnap2=2250 sna_type_vz=0 \
+ ntaper=200 \
+ left=2 right=2 top=2 bottom=2
+
+
diff --git a/marchenko3D/demo/twoD/remove_direct.scr b/marchenko3D/demo/twoD/remove_direct.scr
new file mode 100755
index 0000000000000000000000000000000000000000..0881615c381aba1f42314c7cc226ba18edb05496
--- /dev/null
+++ b/marchenko3D/demo/twoD/remove_direct.scr
@@ -0,0 +1,33 @@
+#!/bin/bash
+
+export PATH=$HOME/src/OpenSource/bin:$PATH:
+
+dxshot=10
+ishot=0
+nshots=601
+
+rm shots/refl_rp.su
+
+while (( ishot < nshots ))
+do
+ (( xsrc = -3000 + ${ishot}*${dxshot} ))
+ (( iishot = ${ishot}*${dxshot}/10 ))
+ (( tr1 = 601 - ${iishot} ))
+ (( tr2 = ${tr1} + 600 ))
+ echo xsrc=$xsrc tr1=$tr1 tr2=$tr2
+ suwind < direct_rp.su key=tracl min=$tr1 max=$tr2 > direct.su
+
+ file_rcv=shots/shots_${xsrc}_rp.su
+ suwind key=tracl min=1 max=601 < $file_rcv > shotz0.su
+
+ sudiff shotz0.su direct.su > refl.su
+
+ (( ishot = $ishot + 1))
+
+ sushw < refl.su key=fldr a=$ishot | \
+ suwind itmax=1023 >> shots/refl_rp.su
+
+done
+
+rm refl.su shotz0.su direct.su
+
diff --git a/marchenko3D/demo/twoD/shots_pbs.scr b/marchenko3D/demo/twoD/shots_pbs.scr
new file mode 100755
index 0000000000000000000000000000000000000000..4d1f22967a9946331f9ad903af522d324e9f956d
--- /dev/null
+++ b/marchenko3D/demo/twoD/shots_pbs.scr
@@ -0,0 +1,69 @@
+#!/bin/bash
+
+export PATH=$HOME/src/OpenSource/bin:$PATH:
+
+dt=0.0005
+makewave w=fw fmin=0 flef=5 frig=80 fmax=100 dt=$dt file_out=wavefw.su nt=4096 t0=0.3 scale=0 scfft=1
+
+./model.scr
+
+mkdir -p shots
+mkdir -p jobs
+
+dxshot=10
+ishot=0
+nshots=601
+zsrc=0
+
+while (( ishot < nshots ))
+do
+
+ (( xsrc = -3000 + ${ishot}*${dxshot} ))
+
+ echo ishot=$ishot xsrc=$xsrc zsrc=$zsrc
+
+cat << EOF > jobs/pbs_$ishot.job
+#!/bin/bash
+#
+#PBS -q medium
+#PBS -N mod_${xsrc}
+#PBS -j eo
+#PBS -m n
+#PBS -l nodes=1
+#PBS -V
+
+export PATH=\$HOME/src/OpenSource/bin:\$PATH:
+cd \$PBS_O_WORKDIR
+
+export OMP_NUM_THREADS=4
+file_rcv=shots/shots_${xsrc}.su
+
+fdelmodc \
+ file_cp=syncl_cp.su ischeme=1 iorder=4 \
+ file_den=syncl_ro.su \
+ file_src=wavefw.su \
+ file_rcv=\$file_rcv \
+ src_type=7 \
+ src_orient=1 \
+ src_injectionrate=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ rec_delay=0.3 \
+ dtrcv=0.004 \
+ verbose=2 \
+ tmod=4.392 \
+ dxrcv=10.0 \
+ xrcv1=-3000 xrcv2=3000 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=$xsrc zsrc=$zsrc \
+ ntaper=200 \
+ left=2 right=2 top=2 bottom=2
+EOF
+
+qsub jobs/pbs_$ishot.job
+
+ (( ishot = $ishot + 1))
+
+done
+
diff --git a/marchenko3D/demo/twoD/shots_slurm.scr b/marchenko3D/demo/twoD/shots_slurm.scr
new file mode 100755
index 0000000000000000000000000000000000000000..0aac6ca0c021699f37216c5af8d08e7028cffc4a
--- /dev/null
+++ b/marchenko3D/demo/twoD/shots_slurm.scr
@@ -0,0 +1,67 @@
+#!/bin/bash
+
+export PATH=$HOME/src/OpenSource/bin:$PATH:
+
+dt=0.0005
+makewave w=fw fmin=0 flef=5 frig=80 fmax=100 dt=$dt file_out=wavefw.su nt=4096 t0=0.3 scale=0 scfft=1
+
+./model.scr
+
+mkdir -p shots
+mkdir -p jobs
+
+dxshot=10
+ishot=0
+nshots=601
+zsrc=0
+
+while (( ishot < nshots ))
+do
+
+ (( xsrc = -3000 + ${ishot}*${dxshot} ))
+
+ echo ishot=$ishot xsrc=$xsrc zsrc=$zsrc
+
+cat << EOF > jobs/slurm_$ishot.job
+#!/bin/bash
+#
+#SBATCH -J mod_${xsrc}
+#SBATCH --cpus-per-task=4
+#SBATCH --ntasks=1
+#SBATCH --time=0:20:00
+
+export PATH=\$HOME/src/OpenSource/bin:\$PATH:
+cd \$SLURM_SUBMIT_DIR
+
+export OMP_NUM_THREADS=4
+file_rcv=shots/shots_${xsrc}.su
+
+fdelmodc \
+ file_cp=syncl_cp.su ischeme=1 iorder=4 \
+ file_den=syncl_ro.su \
+ file_src=wavefw.su \
+ file_rcv=\$file_rcv \
+ src_type=7 \
+ src_orient=1 \
+ src_injectionrate=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ rec_delay=0.3 \
+ dtrcv=0.004 \
+ verbose=2 \
+ tmod=4.392 \
+ dxrcv=10.0 \
+ xrcv1=-3000 xrcv2=3000 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=$xsrc zsrc=$zsrc \
+ ntaper=200 \
+ left=2 right=2 top=2 bottom=2
+EOF
+
+ sbatch jobs/slurm_$ishot.job
+
+ (( ishot = $ishot + 1))
+
+done
+
diff --git a/marchenko3D/docpkge.c b/marchenko3D/docpkge.c
new file mode 120000
index 0000000000000000000000000000000000000000..5384bb3801703c3f0db8fcc032235ca6130fa08b
--- /dev/null
+++ b/marchenko3D/docpkge.c
@@ -0,0 +1 @@
+../utils/docpkge.c
\ No newline at end of file
diff --git a/marchenko3D/fmute.c b/marchenko3D/fmute.c
new file mode 100644
index 0000000000000000000000000000000000000000..ba4f39acb407d3dacf414096dafc0b3ab67a2c8d
--- /dev/null
+++ b/marchenko3D/fmute.c
@@ -0,0 +1,370 @@
+#include "par.h"
+#include "segy.h"
+#include <time.h>
+#include <stdlib.h>
+#include <stdio.h>
+#include <math.h>
+#include <assert.h>
+#include <genfft.h>
+
+#ifndef MAX
+#define MAX(x,y) ((x) > (y) ? (x) : (y))
+#endif
+#ifndef MIN
+#define MIN(x,y) ((x) < (y) ? (x) : (y))
+#endif
+#define NINT(x) ((int)((x)>0.0?(x)+0.5:(x)-0.5))
+
+#ifndef COMPLEX
+typedef struct _complexStruct { /* complex number */
+ float r,i;
+} complex;
+#endif/* complex */
+
+int getFileInfo(char *filename, int *n1, int *n2, int *ngath, float *d1, float *d2, float *f1, float *f2, float *xmin, float *xmax, float *sclsxgx, int *nxm);
+int readData(FILE *fp, float *data, segy *hdrs, int n1);
+int writeData(FILE *fp, float *data, segy *hdrs, int n1, int n2);
+int disp_fileinfo(char *file, int n1, int n2, float f1, float f2, float d1, float d2, segy *hdrs);
+void applyMute( float *data, int *mute, int smooth, int above, int Nfoc, int nxs, int nt, int *ixpos, int npos, int shift);
+double wallclock_time(void);
+
+/*********************** self documentation **********************/
+char *sdoc[] = {
+" ",
+" fmute - mute in time domain file_shot along curve of maximum amplitude in file_mute ",
+" ",
+" fmute file_shot= {file_mute=} [optional parameters]",
+" ",
+" Required parameters: ",
+" ",
+" file_mute= ................ input file with event that defines the mute line",
+" file_shot= ................ input data that is muted",
+" ",
+" Optional parameters: ",
+" ",
+" file_out= ................ output file",
+" above=0 .................. mute after(0), before(1) or around(2) the maximum times of file_mute",
+" .......................... options 4 is the inverse of 0 and -1 the inverse of 1",
+" shift=0 .................. number of points above(positive) / below(negative) maximum time for mute",
+" check=0 .................. plots muting window on top of file_mute: output file check.su",
+" scale=0 .................. scale data by dividing through maximum",
+" hw=15 .................... number of time samples to look up and down in next trace for maximum",
+" smooth=0 ................. number of points to smooth mute with cosine window",
+//" nxmax=512 ................ maximum number of traces in input file",
+//" ntmax=1024 ............... maximum number of samples/trace in input file",
+" verbose=0 ................ silent option; >0 display info",
+" ",
+" author : Jan Thorbecke : 2012 (janth@xs4all.nl)",
+" ",
+NULL};
+/**************** end self doc ***********************************/
+
+int main (int argc, char **argv)
+{
+ FILE *fp_in1, *fp_in2, *fp_out, *fp_chk, *fp_psline1, *fp_psline2;
+ int verbose, shift, k, nx1, nt1, nx2, nt2;
+ int ntmax, nxmax, ret, i, j, jmax, imax, above, check;
+ int size, ntraces, ngath, *maxval, hw, smooth;
+ int tstart, tend, scale, *xrcv;
+ float dt, d2, f1, f2, t0, t1, f1b, f2b, d1, d1b, d2b;
+ float w1, w2, dxrcv;
+ float *tmpdata, *tmpdata2, *costaper;
+ char *file_mute, *file_shot, *file_out;
+ float scl, sclsxgx, sclshot, xmin, xmax, tmax, lmax;
+ segy *hdrs_in1, *hdrs_in2;
+
+ t0 = wallclock_time();
+ initargs(argc, argv);
+ requestdoc(1);
+
+ if(!getparstring("file_mute", &file_mute)) file_mute=NULL;
+ if(!getparstring("file_shot", &file_shot)) file_shot=NULL;
+ if(!getparstring("file_out", &file_out)) file_out=NULL;
+ if(!getparint("ntmax", &ntmax)) ntmax = 1024;
+ if(!getparint("nxmax", &nxmax)) nxmax = 512;
+ if(!getparint("above", &above)) above = 0;
+ if(!getparint("check", &check)) check = 0;
+ if(!getparint("scale", &scale)) scale = 0;
+ if(!getparint("hw", &hw)) hw = 15;
+ if(!getparint("smooth", &smooth)) smooth = 0;
+ if(!getparfloat("w1", &w1)) w1=1.0;
+ if(!getparfloat("w2", &w2)) w2=1.0;
+ if(!getparint("shift", &shift)) shift=0;
+ if(!getparint("verbose", &verbose)) verbose=0;
+
+/* Reading input data for file_mute */
+
+ if (file_mute != NULL) {
+ ngath = 1;
+ getFileInfo(file_mute, &nt1, &nx1, &ngath, &d1, &d2, &f1, &f2, &xmin, &xmax, &sclsxgx, &ntraces);
+
+ if (!getparint("ntmax", &ntmax)) ntmax = nt1;
+ if (!getparint("nxmax", &nxmax)) nxmax = nx1;
+ if (verbose>=2 && (ntmax!=nt1 || nxmax!=nx1))
+ vmess("dimensions overruled: %d x %d",ntmax,nxmax);
+ if(!getparfloat("dt", &dt)) dt=d1;
+
+ fp_in1 = fopen(file_mute, "r");
+ if (fp_in1 == NULL) verr("error on opening input file_mute=%s", file_mute);
+
+ size = ntmax * nxmax;
+ tmpdata = (float *)malloc(size*sizeof(float));
+ hdrs_in1 = (segy *) calloc(nxmax,sizeof(segy));
+
+ nx1 = readData(fp_in1, tmpdata, hdrs_in1, nt1);
+ if (nx1 == 0) {
+ fclose(fp_in1);
+ if (verbose) vmess("end of file_mute data reached");
+ }
+
+ if (verbose) {
+ disp_fileinfo(file_mute, nt1, nx1, f1, f2, dt, d2, hdrs_in1);
+ }
+ }
+
+/* Reading input data for file_shot */
+
+ ngath = 1;
+ getFileInfo(file_shot, &nt2, &nx2, &ngath, &d1b, &d2b, &f1b, &f2b, &xmin, &xmax, &sclshot, &ntraces);
+
+ if (!getparint("ntmax", &ntmax)) ntmax = nt2;
+ if (!getparint("nxmax", &nxmax)) nxmax = nx2;
+
+ size = ntmax * nxmax;
+ tmpdata2 = (float *)malloc(size*sizeof(float));
+ hdrs_in2 = (segy *) calloc(nxmax,sizeof(segy));
+
+ if (file_shot != NULL) fp_in2 = fopen(file_shot, "r");
+ else fp_in2=stdin;
+ if (fp_in2 == NULL) verr("error on opening input file_shot=%s", file_shot);
+
+ nx2 = readData(fp_in2, tmpdata2, hdrs_in2, nt2);
+ if (nx2 == 0) {
+ fclose(fp_in2);
+ if (verbose) vmess("end of file_shot data reached");
+ }
+ nt2 = hdrs_in2[0].ns;
+ f1b = hdrs_in2[0].f1;
+ f2b = hdrs_in2[0].f2;
+ d1b = (float)hdrs_in2[0].dt*1e-6;
+
+ if (verbose) {
+ disp_fileinfo(file_shot, nt2, nx2, f1b, f2b, d1b, d2b, hdrs_in2);
+ }
+
+ /* file_shot will be used as well to define the mute window */
+ if (file_mute == NULL) {
+ nx1=nx2;
+ nt1=nt2;
+ dt=d1b;
+ f1=f1b;
+ f2=f2b;
+ tmpdata = tmpdata2;
+ hdrs_in1 = hdrs_in2;
+ sclsxgx = sclshot;
+ }
+
+ if (verbose) vmess("sampling file_mute=%d, file_shot=%d", nt1, nt2);
+
+/*================ initializations ================*/
+
+ maxval = (int *)calloc(nx1,sizeof(int));
+ xrcv = (int *)calloc(nx1,sizeof(int));
+
+ if (file_out==NULL) fp_out = stdout;
+ else {
+ fp_out = fopen(file_out, "w+");
+ if (fp_out==NULL) verr("error on ceating output file");
+ }
+ if (check!=0){
+ fp_chk = fopen("check.su", "w+");
+ if (fp_chk==NULL) verr("error on ceating output file");
+ fp_psline1 = fopen("pslinepos.asci", "w+");
+ if (fp_psline1==NULL) verr("error on ceating output file");
+ fp_psline2 = fopen("pslineneg.asci", "w+");
+ if (fp_psline2==NULL) verr("error on ceating output file");
+
+ }
+ if (smooth) {
+ costaper = (float *)malloc(smooth*sizeof(float));
+ scl = M_PI/((float)smooth);
+ for (i=0; i<smooth; i++) {
+ costaper[i] = 0.5*(1.0+cos((i+1)*scl));
+/* fprintf(stderr,"costaper[%d]=%f\n",i,costaper[i]);*/
+ }
+ }
+
+/*================ loop over all shot records ================*/
+
+ k=1;
+ while (nx1 > 0) {
+ if (verbose) vmess("processing input gather %d", k);
+
+/*================ loop over all shot records ================*/
+
+ /* find consistent (one event) maximum related to maximum value */
+
+ /* find global maximum
+ xmax=0.0;
+ for (i = 0; i < nx1; i++) {
+ tmax=0.0;
+ jmax = 0;
+ for (j = 0; j < nt1; j++) {
+ lmax = fabs(tmpdata[i*nt1+j]);
+ if (lmax > tmax) {
+ jmax = j;
+ tmax = lmax;
+ if (lmax > xmax) {
+ imax = i;
+ xmax=lmax;
+ }
+ }
+ }
+ maxval[i] = jmax;
+ }
+ */
+
+ /* alternative find maximum at source position */
+ dxrcv = (hdrs_in1[nx1-1].gx - hdrs_in1[0].gx)*sclsxgx/(float)(nx1-1);
+ imax = NINT(((hdrs_in1[0].sx-hdrs_in1[0].gx)*sclsxgx)/dxrcv);
+ tmax=0.0;
+ jmax = 0;
+ xmax=0.0;
+ for (j = 0; j < nt1; j++) {
+ lmax = fabs(tmpdata[imax*nt1+j]);
+ if (lmax > tmax) {
+ jmax = j;
+ tmax = lmax;
+ if (lmax > xmax) {
+ xmax=lmax;
+ }
+ }
+ }
+ maxval[imax] = jmax;
+ if (verbose >= 3) vmess("Mute max at src-trace %d is sample %d", imax, maxval[imax]);
+
+ /* search forward */
+ for (i = imax+1; i < nx1; i++) {
+ tstart = MAX(0, (maxval[i-1]-hw));
+ tend = MIN(nt1-1, (maxval[i-1]+hw));
+ jmax=tstart;
+ tmax=0.0;
+ for(j = tstart; j <= tend; j++) {
+ lmax = fabs(tmpdata[i*nt1+j]);
+ if (lmax > tmax) {
+ jmax = j;
+ tmax = lmax;
+ }
+ }
+ maxval[i] = jmax;
+ }
+ /* search backward */
+ for (i = imax-1; i >=0; i--) {
+ tstart = MAX(0, (maxval[i+1]-hw));
+ tend = MIN(nt1-1, (maxval[i+1]+hw));
+ jmax=tstart;
+ tmax=0.0;
+ for(j = tstart; j <= tend; j++) {
+ lmax = fabs(tmpdata[i*nt1+j]);
+ if (lmax > tmax) {
+ jmax = j;
+ tmax = lmax;
+ }
+ }
+ maxval[i] = jmax;
+ }
+
+/* scale with maximum ampltiude */
+
+ if (scale==1) {
+ for (i = 0; i < nx2; i++) {
+ lmax = fabs(tmpdata2[i*nt2+maxval[i]]);
+ for (j = 0; j < nt2; j++) {
+ tmpdata2[i*nt2+j] = tmpdata2[i*nt2+j]/lmax;
+ }
+ }
+ }
+
+ for (i = 0; i < nx2; i++) xrcv[i] = i;
+
+/*================ apply mute window ================*/
+
+ applyMute(tmpdata2, maxval, smooth, above, 1, nx2, nt2, xrcv, nx2, shift);
+
+/*================ write result to output file ================*/
+
+ ret = writeData(fp_out, tmpdata2, hdrs_in2, nt2, nx2);
+ if (ret < 0 ) verr("error on writing output file.");
+
+ /* put mute window in file to check correctness of mute */
+ if (check !=0) {
+ for (i = 0; i < nx1; i++) {
+ jmax = maxval[i]-shift;
+ tmpdata[i*nt1+jmax] = 2*xmax;
+ }
+ if (above==0){
+ for (i = 0; i < nx1; i++) {
+ jmax = nt2-maxval[i]+shift;
+ tmpdata[i*nt1+jmax] = 2*xmax;
+ }
+ }
+ ret = writeData(fp_chk, tmpdata, hdrs_in1, nt1, nx1);
+ if (ret < 0 ) verr("error on writing check file.");
+ for (i=0; i<nx1; i++) {
+ jmax = maxval[i]-shift;
+ ret = fprintf(fp_psline1, "%.5f %.5f \n",jmax*dt,hdrs_in1[i].gx*sclshot);
+ jmax =-maxval[i]+shift;
+ ret = fprintf(fp_psline2, "%.5f %.5f \n",jmax*dt,hdrs_in1[i].gx*sclshot);
+ }
+ }
+
+/*================ Read next record for muting ================*/
+
+ if (file_mute != NULL) {
+ nx1 = readData(fp_in1, tmpdata, hdrs_in1, nt1);
+ if (nx1 == 0) {
+ fclose(fp_in1);
+ if (verbose) vmess("end of file_mute data reached");
+ fclose(fp_in2);
+ if (fp_out!=stdout) fclose(fp_out);
+ if (check!=0) fclose(fp_chk);
+ if (check!=0) {
+ fclose(fp_psline1);
+ fclose(fp_psline2);
+ }
+ break;
+ }
+ nt1 = (int)hdrs_in1[0].ns;
+ if (nt1 > ntmax) verr("n_samples (%d) greater than ntmax", nt1);
+ if (nx1 > nxmax) verr("n_traces (%d) greater than nxmax", nx1);
+ }
+
+/*================ Read next shot record(s) ================*/
+
+ nx2 = readData(fp_in2, tmpdata2, hdrs_in2, nt2);
+ if (nx2 == 0) {
+ if (verbose) vmess("end of file_shot data reached");
+ fclose(fp_in2);
+ break;
+ }
+ nt2 = (int)hdrs_in2[0].ns;
+ if (nt2 > ntmax) verr("n_samples (%d) greater than ntmax", nt2);
+ if (nx2 > nxmax) verr("n_traces (%d) greater than nxmax", nx2);
+
+ if (file_mute == NULL) {
+ nx1=nx2;
+ nt1=nt2;
+ hdrs_in1 = hdrs_in2;
+ tmpdata = tmpdata2;
+ }
+
+ k++;
+ }
+
+ t1 = wallclock_time();
+ if (verbose) vmess("Total CPU-time = %f",t1-t0);
+
+
+ return 0;
+}
+
diff --git a/marchenko3D/fmute3D.c b/marchenko3D/fmute3D.c
new file mode 100644
index 0000000000000000000000000000000000000000..fa03b817592628cb532ae04bc489f758ac704fbb
--- /dev/null
+++ b/marchenko3D/fmute3D.c
@@ -0,0 +1,509 @@
+#include "par.h"
+#include "segy.h"
+#include <time.h>
+#include <stdlib.h>
+#include <stdio.h>
+#include <math.h>
+#include <assert.h>
+#include <genfft.h>
+
+#ifndef MAX
+#define MAX(x,y) ((x) > (y) ? (x) : (y))
+#endif
+#ifndef MIN
+#define MIN(x,y) ((x) < (y) ? (x) : (y))
+#endif
+#define NINT(x) ((long)((x)>0.0?(x)+0.5:(x)-0.5))
+
+#ifndef COMPLEX
+typedef struct _complexStruct { /* complex number */
+ float r,i;
+} complex;
+#endif/* complex */
+
+long getFileInfo3D(char *filename, long *n1, long *n2, long *n3, long *ngath, float *d1, float *d2, float *d3, float *f1, float *f2, float *f3,
+ float *sclsxgxsygy, long *nxm);
+long readData3D(FILE *fp, float *data, segy *hdrs, long n1);
+long writeData3D(FILE *fp, float *data, segy *hdrs, long n1, long n2);
+long disp_fileinfo3D(char *file, long n1, long n2, long n3, float f1, float f2, float f3, float d1, float d2, float d3, segy *hdrs);
+void applyMute3D( float *data, long *mute, long smooth, long above, long Nfoc, long nxs, long nt, long *ixpos, long npos, long shift);
+double wallclock_time(void);
+
+/*********************** self documentation **********************/
+char *sdoc[] = {
+" ",
+" fmute3D - mute in time domain file_shot along 3D curves of maximum amplitude in file_mute ",
+" ",
+" fmute3D file_shot= {file_mute=} [optional parameters]",
+" ",
+" Required parameters: ",
+" ",
+" file_mute= ................ input file with event that defines the mute line",
+" file_shot= ................ input data that is muted",
+" ",
+" Optional parameters: ",
+" ",
+" file_out= ................ output file",
+" above=0 .................. mute after(0), before(1) or around(2) the maximum times of file_mute",
+" .......................... options 4 is the inverse of 0 and -1 the inverse of 1",
+" shift=0 .................. number of points above(positive) / below(negative) maximum time for mute",
+" check=0 .................. plots muting window on top of file_mute: output file check.su",
+" scale=0 .................. scale data by dividing through maximum",
+" hw=15 .................... number of time samples to look up and down in next trace for maximum",
+" smooth=0 ................. number of points to smooth mute with cosine window",
+//" nxmax=512 ................ maximum number of traces in input file",
+//" ntmax=1024 ............... maximum number of samples/trace in input file",
+" verbose=0 ................ silent option; >0 display info",
+" ",
+" author : Jan Thorbecke : 2012 (janth@xs4all.nl)",
+" author 3D: Joeri Brackenhoff : 2019 (j.a.brackenhoff@tudelft.nl)"
+" ",
+NULL};
+/**************** end self doc ***********************************/
+
+long main (int argc, char **argv)
+{
+ FILE *fp_in1, *fp_in2, *fp_out, *fp_chk, *fp_psline1, *fp_psline2;
+ long verbose, shift, k, nx1, ny1, nt1, nx2, ny2, nt2, nxy;
+ long ntmax, nxmax, nymax, ret, i, j, l, jmax, ixmax, iymax, above, check;
+ long size, ntraces, ngath, *maxval, hw, smooth;
+ long tstart, tend, scale, *xrcv;
+ float dt, dt1, dx1, dy1, ft1, fx1, fy1, t0, t1, dt2, dx2, dy2, ft2, fx2, fy2;
+ float w1, w2, dxrcv, dyrcv;
+ float *tmpdata, *tmpdata2, *costaper;
+ char *file_mute, *file_shot, *file_out;
+ float scl, sclsxgx, sclshot, xmin, xmax, tmax, lmax;
+ segy *hdrs_in1, *hdrs_in2;
+
+ t0 = wallclock_time();
+ initargs(argc, argv);
+ requestdoc(1);
+
+ if(!getparstring("file_mute", &file_mute)) file_mute=NULL;
+ if(!getparstring("file_shot", &file_shot)) file_shot=NULL;
+ if(!getparstring("file_out", &file_out)) file_out=NULL;
+ if(!getparlong("ntmax", &ntmax)) ntmax = 1024;
+ if(!getparlong("nxmax", &nxmax)) nxmax = 512;
+ if(!getparlong("above", &above)) above = 0;
+ if(!getparlong("check", &check)) check = 0;
+ if(!getparlong("scale", &scale)) scale = 0;
+ if(!getparlong("hw", &hw)) hw = 15;
+ if(!getparlong("smooth", &smooth)) smooth = 0;
+ if(!getparfloat("w1", &w1)) w1=1.0;
+ if(!getparfloat("w2", &w2)) w2=1.0;
+ if(!getparlong("shift", &shift)) shift=0;
+ if(!getparlong("verbose", &verbose)) verbose=0;
+
+/* Reading input data for file_mute */
+
+ if (file_mute != NULL) {
+ ngath = 1;
+ ret = getFileInfo3D(file_mute, &nt1, &nx1, &ny1, &ngath, &dt1, &dx1, &dy1, &ft1, &fx1, &fy1, &sclsxgx, &ntraces);
+
+ if (!getparlong("ntmax", &ntmax)) ntmax = nt1;
+ if (!getparlong("nxmax", &nxmax)) nxmax = nx1;
+ if (!getparlong("nymax", &nymax)) nymax = ny1;
+ if (verbose>=2 && (ntmax!=nt1 || nxmax!=nx1 || nymax!= ny1))
+ vmess("dimensions overruled: %li x %li y %li",ntmax,nxmax,nymax);
+ if(!getparfloat("dt", &dt)) dt=dt1;
+
+ fp_in1 = fopen(file_mute, "r");
+ if (fp_in1 == NULL) verr("error on opening input file_mute=%s", file_mute);
+
+ size = ntmax * nxmax *nymax;
+ tmpdata = (float *)malloc(size*sizeof(float));
+ hdrs_in1 = (segy *)calloc(nxmax*nymax,sizeof(segy));
+
+ nx1,ny1 = readData3D(fp_in1, tmpdata, hdrs_in1, nt1);
+ nxy = nx1*ny1;
+ if (nxy == 0) {
+ fclose(fp_in1);
+ if (verbose) vmess("end of file_mute data reached");
+ }
+
+ if (verbose) {
+ disp_fileinfo3D(file_mute, nt1, nx1, ny1, ft1, fx1, fy1, dt, dx1, dy1, hdrs_in1);
+ }
+ }
+
+/* Reading input data for file_shot */
+
+ ngath = 1;
+ ret = getFileInfo3D(file_shot, &nt2, &nx2, &ny2, &ngath, &dt2, &dx2, &dy2, &ft2, &fx2, &fy2, &sclshot, &ntraces);
+
+ if (!getparlong("ntmax", &ntmax)) ntmax = nt2;
+ if (!getparlong("nxmax", &nxmax)) nxmax = nx2;
+ if (!getparlong("nymax", &nymax)) nymax = ny2;
+
+ size = ntmax * nxmax * nymax;
+ tmpdata2 = (float *)malloc(size*sizeof(float));
+ hdrs_in2 = (segy *)calloc(nxmax*nymax,sizeof(segy));
+
+ if (file_shot != NULL) fp_in2 = fopen(file_shot, "r");
+ else fp_in2=stdin;
+ if (fp_in2 == NULL) verr("error on opening input file_shot=%s", file_shot);
+
+ nx2,ny2 = readData3D(fp_in2, tmpdata2, hdrs_in2, nt2);
+ nxy = nx2*ny2;
+ if (nxy == 0) {
+ fclose(fp_in2);
+ if (verbose) vmess("end of file_shot data reached");
+ }
+ nt2 = hdrs_in2[0].ns;
+ ft2 = hdrs_in2[0].f1;
+ fx2 = hdrs_in2[0].f2;
+ dt2 = (float)hdrs_in2[0].dt*1e-6;
+
+ if (verbose) {
+ disp_fileinfo3D(file_shot, nt2, nx2, ny2, ft2, fx2, fy2, dt2, dx2, dy2, hdrs_in2);
+ }
+
+ /* file_shot will be used as well to define the mute window */
+ if (file_mute == NULL) {
+ nx1=nx2;
+ nt1=nt2;
+ ny1=ny2;
+ dt=dt2;
+ ft1=ft2;
+ fx1=fx2;
+ fy1=fy2;
+ tmpdata = tmpdata2;
+ hdrs_in1 = hdrs_in2;
+ sclsxgx = sclshot;
+ }
+
+ if (verbose) vmess("sampling file_mute=%li, file_shot=%li", nt1, nt2);
+
+/*================ initializations ================*/
+
+ nxy = nx1*ny1;
+ maxval = (long *)calloc(nxy,sizeof(long));
+ xrcv = (long *)calloc(nxy,sizeof(long));
+
+ if (file_out==NULL) fp_out = stdout;
+ else {
+ fp_out = fopen(file_out, "w+");
+ if (fp_out==NULL) verr("error on ceating output file");
+ }
+ if (check!=0){
+ fp_chk = fopen("check.su", "w+");
+ if (fp_chk==NULL) verr("error on ceating output file");
+ fp_psline1 = fopen("pslinepos.asci", "w+");
+ if (fp_psline1==NULL) verr("error on ceating output file");
+ fp_psline2 = fopen("pslineneg.asci", "w+");
+ if (fp_psline2==NULL) verr("error on ceating output file");
+
+ }
+ if (smooth) {
+ costaper = (float *)malloc(smooth*sizeof(float));
+ scl = M_PI/((float)smooth);
+ for (i=0; i<smooth; i++) {
+ costaper[i] = 0.5*(1.0+cos((i+1)*scl));
+/* fprintf(stderr,"costaper[%d]=%f\n",i,costaper[i]);*/
+ }
+ }
+
+/*================ loop over all shot records ================*/
+
+ k=1;
+ while (nxy > 0) {
+ if (verbose) vmess("processing input gather %li", k);
+
+/*================ loop over all shot records ================*/
+
+ /* find consistent (one event) maximum related to maximum value */
+
+ /* find global maximum
+ xmax=0.0;
+ for (i = 0; i < nx1; i++) {
+ tmax=0.0;
+ jmax = 0;
+ for (j = 0; j < nt1; j++) {
+ lmax = fabs(tmpdata[i*nt1+j]);
+ if (lmax > tmax) {
+ jmax = j;
+ tmax = lmax;
+ if (lmax > xmax) {
+ imax = i;
+ xmax=lmax;
+ }
+ }
+ }
+ maxval[i] = jmax;
+ }
+ */
+
+ /* alternative find maximum at source position */
+ dxrcv = (hdrs_in1[nxy-1].gx - hdrs_in1[0].gx)*sclsxgx/(float)(nx1-1);
+ dyrcv = (hdrs_in1[nxy-1].gy - hdrs_in1[0].gy)*sclsxgx/(float)(ny1-1);
+ ixmax = NINT(((hdrs_in1[0].sx-hdrs_in1[0].gx)*sclsxgx)/dxrcv);
+ iymax = NINT(((hdrs_in1[0].sy-hdrs_in1[0].gy)*sclsxgx)/dxrcv);
+ if (iymax > ny1-1) {
+ vmess("source of y is past array, snapping to nearest y");
+ iymax = ny1-1;
+ }
+ if (iymax < 0) {
+ vmess("source of y is before array, snapping to nearest y");
+ iymax = 0;
+ }
+ if (ixmax > nx1-1) {
+ vmess("source of x is past array, snapping to nearest x");
+ ixmax = nx1-1;
+ }
+ if (ixmax < 0) {
+ vmess("source of x is before array, snapping to nearest x");
+ ixmax = 0;
+ }
+ tmax=0.0;
+ jmax = 0;
+ xmax=0.0;
+ for (j = 0; j < nt1; j++) {
+ lmax = fabs(tmpdata[iymax*nx1*nt1+ixmax*nt1+j]);
+ if (lmax > tmax) {
+ jmax = j;
+ tmax = lmax;
+ if (lmax > xmax) {
+ xmax=lmax;
+ }
+ }
+ }
+ maxval[iymax*nx1+ixmax] = jmax;
+ if (verbose >= 3) vmess("Mute max at src-trace x=%li y=%li is sample %li", ixmax, iymax, maxval[iymax*nx1+ixmax]);
+
+ /* search forward in x-trace direction from maximum in file */
+ for (i = ixmax+1; i < nx1; i++) {
+ tstart = MAX(0, (maxval[iymax*nx1+i-1]-hw));
+ tend = MIN(nt1-1, (maxval[iymax*nx1+i-1]+hw));
+ jmax=tstart;
+ tmax=0.0;
+ for(j = tstart; j <= tend; j++) {
+ lmax = fabs(tmpdata[iymax*nx1*nt1+i*nt1+j]);
+ if (lmax > tmax) {
+ jmax = j;
+ tmax = lmax;
+ }
+ }
+ maxval[iymax*nx1+i] = jmax;
+ }
+ /* search backward in x-trace direction from maximum in file */
+ for (i = ixmax-1; i >=0; i--) {
+ tstart = MAX(0, (maxval[iymax*nx1+i+1]-hw));
+ tend = MIN(nt1-1, (maxval[iymax*nx1+i+1]+hw));
+ jmax=tstart;
+ tmax=0.0;
+ for(j = tstart; j <= tend; j++) {
+ lmax = fabs(tmpdata[iymax*nx1*nt1+i*nt1+j]);
+ if (lmax > tmax) {
+ jmax = j;
+ tmax = lmax;
+ }
+ }
+ maxval[iymax*nx1+i] = jmax;
+ }
+
+ /* search forward in y-trace direction from maximum in file */
+ for (i = iymax+1; i < ny1; i++) {
+ tmax=0.0;
+ jmax = 0;
+ for (j = 0; j < nt1; j++) {
+ lmax = fabs(tmpdata[i*nx1*nt1+ixmax*nt1+j]);
+ if (lmax > tmax) {
+ jmax = j;
+ tmax = lmax;
+ }
+ }
+ maxval[i*nx1+ixmax] = jmax;
+ if (verbose >= 8) vmess("Mute max at src-trace x=%li y=%li is sample %li", ixmax, i, maxval[i*nx1+ixmax]);
+ /* search forward in x-trace direction from maximum in file */
+ for (l = ixmax+1; l < nx1; l++) {
+ tstart = MAX(0, (maxval[i*nx1+l-1]-hw));
+ tend = MIN(nt1-1, (maxval[i*nx1+l-1]+hw));
+ jmax=tstart;
+ tmax=0.0;
+ for(j = tstart; j <= tend; j++) {
+ lmax = fabs(tmpdata[i*nx1*nt1+l*nt1+j]);
+ if (lmax > tmax) {
+ jmax = j;
+ tmax = lmax;
+ }
+ }
+ maxval[i*nx1+l] = jmax;
+ }
+ /* search backward in x-trace direction from maximum in file */
+ for (l = ixmax-1; l >=0; l--) {
+ tstart = MAX(0, (maxval[i*nx1+l+1]-hw));
+ tend = MIN(nt1-1, (maxval[i*nx1+l+1]+hw));
+ jmax=tstart;
+ tmax=0.0;
+ for(j = tstart; j <= tend; j++) {
+ lmax = fabs(tmpdata[i*nx1*nt1+l*nt1+j]);
+ if (lmax > tmax) {
+ jmax = j;
+ tmax = lmax;
+ }
+ }
+ maxval[i*nx1+l] = jmax;
+ }
+ }
+
+ /* search backward in y-trace direction from maximum in file */
+ for (i = iymax-1; i >= 0; i--) {
+ tmax=0.0;
+ jmax = 0;
+ for (j = 0; j < nt1; j++) {
+ lmax = fabs(tmpdata[i*nx1*nt1+ixmax*nt1+j]);
+ if (lmax > tmax) {
+ jmax = j;
+ tmax = lmax;
+ }
+ }
+ maxval[i*nx1+ixmax] = jmax;
+ if (verbose >= 8) vmess("Mute max at src-trace x=%li y=%li is sample %li", ixmax, i, maxval[i*nx1+ixmax]);
+ /* search forward in x-trace direction from maximum in file */
+ for (l = ixmax+1; l < nx1; l++) {
+ tstart = MAX(0, (maxval[i*nx1+l-1]-hw));
+ tend = MIN(nt1-1, (maxval[i*nx1+l-1]+hw));
+ jmax=tstart;
+ tmax=0.0;
+ for(j = tstart; j <= tend; j++) {
+ lmax = fabs(tmpdata[i*nx1*nt1+l*nt1+j]);
+ if (lmax > tmax) {
+ jmax = j;
+ tmax = lmax;
+ }
+ }
+ maxval[i*nx1+l] = jmax;
+ }
+ /* search backward in x-trace direction from maximum in file */
+ for (l = ixmax-1; l >=0; l--) {
+ tstart = MAX(0, (maxval[i*nx1+l+1]-hw));
+ tend = MIN(nt1-1, (maxval[i*nx1+l+1]+hw));
+ jmax=tstart;
+ tmax=0.0;
+ for(j = tstart; j <= tend; j++) {
+ lmax = fabs(tmpdata[i*nx1*nt1+l*nt1+j]);
+ if (lmax > tmax) {
+ jmax = j;
+ tmax = lmax;
+ }
+ }
+ maxval[i*nx1+l] = jmax;
+ }
+ }
+
+/* scale with maximum ampltiude */
+
+ if (scale==1) {
+ for (l = 0; l < ny2; l++) {
+ for (i = 0; i < nx2; i++) {
+ lmax = fabs(tmpdata2[l*nx2*nt2+i*nt2+maxval[i]]);
+ for (j = 0; j < nt2; j++) {
+ tmpdata2[l*nx2*nt2+i*nt2+j] = tmpdata2[l*nx2*nt2+i*nt2+j]/lmax;
+ }
+ }
+ }
+ }
+
+ for (l = 0; l < ny2; l++) {
+ for (i = 0; i < nx2; i++) {
+ xrcv[l*nx2+i] = l*nx2+i;
+ }
+ }
+
+/*================ apply mute window ================*/
+
+ applyMute3D(tmpdata2, maxval, smooth, above, 1, nx2*ny2, nt2, xrcv, nx2*ny2, shift);
+
+/*================ write result to output file ================*/
+
+ ret = writeData3D(fp_out, tmpdata2, hdrs_in2, nt2, nx2*ny2);
+ if (ret < 0 ) verr("error on writing output file.");
+
+ /* put mute window in file to check correctness of mute */
+ if (check !=0) {
+ for (l=0; l<ny1; l++) {
+ for (i = 0; i < nx1; i++) {
+ jmax = maxval[l*nx1+i]-shift;
+ tmpdata[l*nx1*nt1+i*nt1+jmax] = 2*xmax;
+ }
+ }
+ if (above==0){
+ for (l=0; l<ny1; l++) {
+ for (i = 0; i < nx1; i++) {
+ jmax = nt2-maxval[l*nx1+i]+shift;
+ tmpdata[l*nx1*nt1+i*nt1+jmax] = 2*xmax;
+ }
+ }
+ }
+ ret = writeData3D(fp_chk, tmpdata, hdrs_in1, nt1, nx1*ny1);
+ if (ret < 0 ) verr("error on writing check file.");
+ for (l=0; l<ny1; l++) {
+ for (i=0; i<nx1; i++) {
+ jmax = maxval[l*nx1+i]-shift;
+ ret = fprintf(fp_psline1, "%.5f %.5f \n",jmax*dt,hdrs_in1[l*nx1+i].gx*sclshot,hdrs_in1[l*nx1+i].gy*sclshot);
+ jmax =-maxval[l*nx1+i]+shift;
+ ret = fprintf(fp_psline2, "%.5f %.5f \n",jmax*dt,hdrs_in1[l*nx1+i].gx*sclshot,hdrs_in1[l*nx1+i].gy*sclshot);
+ }
+ }
+ }
+
+/*================ Read next record for muting ================*/
+
+ if (file_mute != NULL) {
+ nx1, ny1 = readData3D(fp_in1, tmpdata, hdrs_in1, nt1);
+ nxy = nx1*ny1;
+ if (nxy == 0) {
+ fclose(fp_in1);
+ if (verbose) vmess("end of file_mute data reached");
+ fclose(fp_in2);
+ if (fp_out!=stdout) fclose(fp_out);
+ if (check!=0) fclose(fp_chk);
+ if (check!=0) {
+ fclose(fp_psline1);
+ fclose(fp_psline2);
+ }
+ break;
+ }
+ nt1 = (long)hdrs_in1[0].ns;
+ if (nt1 > ntmax) verr("n_samples (%li) greater than ntmax", nt1);
+ if (nx1 > nxmax) verr("n_traces (%li) greater than nxmax", nx1);
+ if (ny1 > nymax) verr("n_traces (%li) greater than nymax", ny1);
+ if (verbose) {
+ disp_fileinfo3D(file_mute, nt1, nx1, ny1, ft1, fx1, fy1, dt, dx1, dy1, hdrs_in1);
+ }
+ }
+
+/*================ Read next shot record(s) ================*/
+
+ nx2,ny2 = readData3D(fp_in2, tmpdata2, hdrs_in2, nt2);
+ nxy = nx2*ny2;
+ if (nxy == 0) {
+ if (verbose) vmess("end of file_shot data reached");
+ fclose(fp_in2);
+ break;
+ }
+ nt2 = (long)hdrs_in2[0].ns;
+ if (nt2 > ntmax) verr("n_samples (%li) greater than ntmax", nt2);
+ if (nx2 > nxmax) verr("n_traces (%li) greater than nxmax", nx2);
+ if (ny2 > nymax) verr("n_traces (%li) greater than nymax", ny2);
+ if (verbose) {
+ disp_fileinfo3D(file_shot, nt2, nx2, ny2, ft2, fx2, fy2, dt, dx2, dy2, hdrs_in2);
+ }
+
+ if (file_mute == NULL) {
+ nx1=nx2;
+ ny1=ny2;
+ nt1=nt2;
+ hdrs_in1 = hdrs_in2;
+ tmpdata = tmpdata2;
+ }
+
+ k++;
+ }
+
+ t1 = wallclock_time();
+ if (verbose) vmess("Total CPU-time = %f",t1-t0);
+
+
+ return 0;
+}
\ No newline at end of file
diff --git a/marchenko3D/getFileInfo.c b/marchenko3D/getFileInfo.c
new file mode 120000
index 0000000000000000000000000000000000000000..ae38ea27f17697d65d7248c8e89038b632314182
--- /dev/null
+++ b/marchenko3D/getFileInfo.c
@@ -0,0 +1 @@
+../utils/getFileInfo.c
\ No newline at end of file
diff --git a/marchenko3D/getFileInfo3D.c b/marchenko3D/getFileInfo3D.c
new file mode 100644
index 0000000000000000000000000000000000000000..cdf000077ef7ab7bb5fac24fe6b72c8ea0e28104
--- /dev/null
+++ b/marchenko3D/getFileInfo3D.c
@@ -0,0 +1,244 @@
+#define _FILE_OFFSET_BITS 64
+#define _LARGEFILE_SOURCE
+
+#include <assert.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <errno.h>
+#include <math.h>
+#include "segy.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))
+
+/**
+* gets sizes, sampling and min/max values of a SU file
+*
+* AUTHOR:
+* Jan Thorbecke (janth@xs4all.nl)
+* The Netherlands
+**/
+
+void vmess(char *fmt, ...);
+void verr(char *fmt, ...);
+int optncr(int n);
+
+long getFileInfo3D(char *filename, long *n1, long *n2, long *n3, long *ngath, float *d1, float *d2, float *d3, float *f1, float *f2, float *f3, float *sclsxgxsygy, long *nxm)
+{
+ FILE *fp;
+ size_t nread, data_sz;
+ off_t bytes, ret, trace_sz, ntraces;
+ long sx_shot, sy_shot, gx_start, gx_end, gy_start, gy_end, itrace, one_shot, igath, end_of_file, fldr_shot;
+ long verbose=1, igy, nsx, nsy;
+ float scl, *trace, dxsrc, dxrcv, dysrc, dyrcv;
+ segy hdr;
+
+ if (filename == NULL) { /* read from input pipe */
+ *n1=0;
+ *n2=0;
+ *n3=0;
+ return -1; /* Input pipe */
+ }
+ else fp = fopen( filename, "r" );
+ if (fp == NULL) verr("File %s does not exist or cannot be opened", filename);
+ 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.;
+ }
+ else {
+ *d1 = hdr.d1;
+ *f1 = hdr.f1;
+ }
+ *f2 = hdr.f2;
+ *f3 = hdr.gy;
+
+ data_sz = sizeof(float)*(*n1);
+ trace_sz = sizeof(float)*(*n1)+TRCBYTES;
+ ntraces = (long) (bytes/trace_sz);
+
+ if (hdr.scalco < 0) scl = 1.0/fabs(hdr.scalco);
+ else if (hdr.scalco == 0) scl = 1.0;
+ else scl = hdr.scalco;
+
+ *sclsxgxsygy = scl;
+ /* check to find out number of traces in shot gather */
+
+ one_shot = 1;
+ itrace = 1;
+ igy = 1;
+ fldr_shot = hdr.fldr;
+ sx_shot = hdr.sx;
+ sy_shot = hdr.sy;
+ gx_start = hdr.gx;
+ gy_start = hdr.gy;
+ gy_end = gy_start;
+ trace = (float *)malloc(hdr.ns*sizeof(float));
+ fseeko( fp, TRCBYTES, SEEK_SET );
+
+ while (one_shot) {
+ nread = fread( trace, sizeof(float), hdr.ns, fp );
+ assert (nread == hdr.ns);
+ if (hdr.gy != gy_end) {
+ gy_end = hdr.gy;
+ igy++;
+ }
+ gx_end = hdr.gx;
+ nread = fread( &hdr, 1, TRCBYTES, fp );
+ if (nread==0) break;
+ if ((sx_shot != hdr.sx) || (sy_shot != hdr.sy) || (fldr_shot != hdr.fldr) ) break;
+ itrace++;
+ }
+
+ if (itrace>1) {
+ *n2 = itrace/igy;
+ *n3 = igy;
+ if (*n2>1) {
+ dxrcv = (float)(gx_end - gx_start)/(float)(*n2-1);
+ }
+ else {
+ dxrcv = 1.0/scl;
+ }
+ if (*n3>1) {
+ dyrcv = (float)(gy_end - gy_start)/(float)(*n3-1);
+ }
+ else {
+ dyrcv = 1.0/scl;
+ }
+ *d2 = fabs(dxrcv)*scl;
+ *d3 = fabs(dyrcv)*scl;
+ if (NINT(dxrcv*1e3) != NINT(fabs(hdr.d2)*1e3)) {
+ if (dxrcv != 0) *d2 = fabs(dxrcv)*scl;
+ else *d2 = hdr.d2;
+ }
+ }
+ else {
+ *n2 = MAX(hdr.trwf, 1);
+ *n3 = 1;
+ *d2 = hdr.d2;
+ *d3 = 1.0;
+ dxrcv = hdr.d2;
+ dyrcv = 0.0;
+ }
+
+/* check if the total number of traces (ntraces) is correct */
+
+/* expensive way to find out how many gathers there are */
+
+// fprintf(stderr, "ngath = %li dxrcv=%f d2=%f scl=%f \n", *ngath, dxrcv, *d2, scl);
+ if (*ngath == 0) {
+ *n2 = 0;
+ *n3 = 0;
+
+ end_of_file = 0;
+ one_shot = 1;
+ igath = 0;
+ fseeko( fp, 0, SEEK_SET );
+ dxrcv = *d2;
+ dyrcv = *d3;
+
+ while (!end_of_file) {
+ nread = fread( &hdr, 1, TRCBYTES, fp );
+ if (nread != TRCBYTES) { break; }
+ fldr_shot = hdr.fldr;
+ sx_shot = hdr.sx;
+ gx_start = hdr.gx;
+ gx_end = hdr.gx;
+ sy_shot = hdr.sy;
+ gy_start = hdr.gy;
+ gy_end = hdr.gy;
+
+ itrace = 1;
+ igy = 1;
+ while (one_shot) {
+ fseeko( fp, data_sz, SEEK_CUR );
+ if (hdr.gx != gx_end) dxrcv = MIN(dxrcv,abs(hdr.gx-gx_end));
+ if (hdr.gy != gy_end) {
+ igy++;
+ gy_end = hdr.gy;
+ dyrcv = MIN(dyrcv,abs(hdr.gy-gy_end));
+ }
+ gx_end = hdr.gx;
+ nread = fread( &hdr, 1, TRCBYTES, fp );
+ if (nread != TRCBYTES) {
+ one_shot = 0;
+ end_of_file = 1;
+ break;
+ }
+ if ((sx_shot != hdr.sx) || (sy_shot != hdr.sy) || (fldr_shot != hdr.fldr)) break;
+ itrace++;
+ }
+ if (itrace>1) {
+ *n2 = itrace/igy;
+ *n3 = igy;
+ if (*n2>1) {
+ dxrcv = (float)(gx_end - gx_start)/(float)(*n2-1);
+ }
+ else {
+ dxrcv = 1.0/scl;
+ }
+ if (*n3>1) {
+ dyrcv = (float)(gy_end - gy_start)/(float)(*n3-1);
+ }
+ else {
+ dyrcv = 1.0/scl;
+ }
+ dxsrc = (float)(hdr.sx - sx_shot)*scl;
+ dysrc = (float)(hdr.sy - sy_shot)*scl;
+ }
+ else {
+ *n2 = MAX(hdr.trwf, 1);
+ *n3 = 1;
+ *d2 = hdr.d2;
+ *d3 = 1.0;
+ dxrcv = hdr.d2/scl;
+ dyrcv = 1.0/scl;
+ }
+ if (verbose>1) {
+ fprintf(stderr," . Scanning shot %li (%li) with %li traces dxrcv=%.2f dxsrc=%.2f %li %li dyrcv=%.2f dysrc=%.2f %li %li\n",sx_shot,igath,itrace,dxrcv*scl,dxsrc,gx_end,gx_start,dyrcv*scl,dysrc,gy_end,gy_start);
+ }
+ if (itrace != 0) { /* end of shot record */
+ fseeko( fp, -TRCBYTES, SEEK_CUR );
+ igath++;
+ }
+ else {
+ end_of_file = 1;
+ }
+ }
+ *ngath = igath;
+ *d2 = dxrcv*scl;
+ *d3 = dyrcv*scl;
+ }
+ else {
+ /* read last trace header */
+
+ fseeko( fp, -trace_sz, SEEK_END );
+ nread = fread( &hdr, 1, TRCBYTES, fp );
+ *ngath = ntraces/((*n2)*(*n3));
+ }
+// *nxm = NINT((*xmax-*xmin)/dxrcv)+1;
+ *nxm = (long)ntraces;
+
+ fclose( fp );
+ free(trace);
+
+ return 0;
+}
+
+long disp_fileinfo3D(char *file, long n1, long n2, long n3, float f1, float f2, float f3, float d1, float d2, float d3, segy *hdrs)
+{
+ vmess("file %s contains", file);
+ vmess("*** n1 = %li n2 = %li n3 = %li ntftt=%li", n1, n2, n3, (long)optncr((int)n1));
+ vmess("*** d1 = %.5f d2 = %.5f d3 = %.5f", d1, d2, d3);
+ vmess("*** f1 = %.5f f2 = %.5f f3 = %.5f", f1, f2, f3);
+ vmess("*** fldr = %li sx = %li sy = %li", hdrs[0].fldr, hdrs[0].sx, hdrs[0].sy);
+
+ return 0;
+}
diff --git a/marchenko3D/getpars.c b/marchenko3D/getpars.c
new file mode 120000
index 0000000000000000000000000000000000000000..fa7dc3355428e8ea9013fafad6e319dde3a48ebb
--- /dev/null
+++ b/marchenko3D/getpars.c
@@ -0,0 +1 @@
+../utils/getpars.c
\ No newline at end of file
diff --git a/marchenko3D/marchenko.c b/marchenko3D/marchenko.c
new file mode 100644
index 0000000000000000000000000000000000000000..9812335d5eeca1883de2be2810350e053687f58b
--- /dev/null
+++ b/marchenko3D/marchenko.c
@@ -0,0 +1,1030 @@
+/*
+ * Copyright (c) 2017 by the Society of Exploration Geophysicists.
+ * For more information, go to http://software.seg.org/2017/00XX .
+ * You must read and accept usage terms at:
+ * http://software.seg.org/disclaimer.txt before use.
+ */
+
+#include "par.h"
+#include "segy.h"
+#include <time.h>
+#include <stdlib.h>
+#include <stdio.h>
+#include <math.h>
+#include <assert.h>
+#include <genfft.h>
+
+int omp_get_max_threads(void);
+int omp_get_num_threads(void);
+void omp_set_num_threads(int num_threads);
+
+#ifndef MAX
+#define MAX(x,y) ((x) > (y) ? (x) : (y))
+#endif
+#ifndef MIN
+#define MIN(x,y) ((x) < (y) ? (x) : (y))
+#endif
+#define NINT(x) ((int)((x)>0.0?(x)+0.5:(x)-0.5))
+int compareInt(const void *a, const void *b)
+{ return (*(int *)a-*(int *)b); }
+
+
+#ifndef COMPLEX
+typedef struct _complexStruct { /* complex number */
+ float r,i;
+} complex;
+#endif/* complex */
+
+int readShotData(char *filename, float *xrcv, float *xsrc, float *zsrc, int *xnx, complex *cdata, int nw, int nw_low, int nshots,
+int nx, int nxs, float fxsb, float dxs, int ntfft, int mode, float scale, float tsq, float Q, float f0, int reci, int *nshots_r, int *isxcount, int *reci_xsrc, int *reci_xrcv, float *ixmask, int verbose);
+int readTinvData(char *filename, float *xrcv, float *xsrc, float *zsrc, int *xnx, int Nfoc, int nx, int ntfft, int mode, int *maxval, float *tinv, int hw, int verbose);
+int writeDataIter(char *file_iter, float *data, segy *hdrs, int n1, int n2, float d2, float f2, int n2out, int Nfoc, float *xsyn,
+float *zsyn, int *ixpos, int npos, int iter);
+
+void name_ext(char *filename, char *extension);
+
+void applyMute(float *data, int *mute, int smooth, int above, int Nfoc, int nxs, int nt, int *xrcvsyn, int npos, int shift);
+
+int getFileInfo(char *filename, int *n1, int *n2, int *ngath, float *d1, float *d2, float *f1, float *f2, float *xmin, float *xmax, float *sclsxgx, int *ntraces);
+int readData(FILE *fp, float *data, segy *hdrs, int n1);
+int writeData(FILE *fp, float *data, segy *hdrs, int n1, int n2);
+int disp_fileinfo(char *file, int n1, int n2, float f1, float f2, float d1, float d2, segy *hdrs);
+double wallclock_time(void);
+
+void synthesis(complex *Refl, complex *Fop, float *Top, float *iRN, int nx, int nt, int nxs, int nts, float dt, float *xsyn, int
+Nfoc, float *xrcv, float *xsrc, int *xnx, float fxse, float fxsb, float dxs, float dxsrc, float dx, int ntfft, int
+nw, int nw_low, int nw_high, int mode, int reci, int nshots, int *ixpos, int npos, double *tfft, int *isxcount, int
+*reci_xsrc, int *reci_xrcv, float *ixmask, int verbose);
+
+void synthesisPosistions(int nx, int nt, int nxs, int nts, float dt, float *xsyn, int Nfoc, float *xrcv, float *xsrc, int *xnx,
+float fxse, float fxsb, float dxs, float dxsrc, float dx, int nshots, int *ixpos, int *npos, int *isxcount, int countmin, int reci, int verbose);
+
+int linearsearch(int *array, size_t N, int value);
+
+/*********************** self documentation **********************/
+char *sdoc[] = {
+" ",
+" MARCHENKO - Iterative Green's function and focusing functions retrieval",
+" ",
+" marchenko file_tinv= file_shot= [optional parameters]",
+" ",
+" Required parameters: ",
+" ",
+" file_tinv= ............... direct arrival from focal point: G_d",
+" file_shot= ............... Reflection response: R",
+" ",
+" Optional parameters: ",
+" ",
+" INTEGRATION ",
+" tap=0 .................... lateral taper focusing(1), shot(2) or both(3)",
+" ntap=0 ................... number of taper points at boundaries",
+" fmin=0 ................... minimum frequency in the Fourier transform",
+" fmax=70 .................. maximum frequency in the Fourier transform",
+" MARCHENKO ITERATIONS ",
+" niter=10 ................. number of iterations",
+" MUTE-WINDOW ",
+" above=0 .................. mute above(1), around(0) or below(-1) the first travel times of file_tinv",
+" shift=12 ................. number of points above(positive) / below(negative) travel time for mute",
+" hw=8 ..................... window in time samples to look for maximum in next trace",
+" smooth=5 ................. number of points to smooth mute with cosine window",
+" REFLECTION RESPONSE CORRECTION ",
+" tsq=0.0 .................. scale factor n for t^n for true amplitude recovery",
+" Q=0.0 .......,............ Q correction factor",
+" f0=0.0 ................... ... for Q correction factor",
+" scale=2 .................. scale factor of R for summation of Ni with G_d",
+" pad=0 .................... amount of samples to pad the reflection series",
+" reci=0 ................... 1; add receivers as shots 2; only use receivers as shot positions",
+" countmin=0 ............... 0.3*nxrcv; minumum number of reciprocal traces for a contribution",
+" OUTPUT DEFINITION ",
+" file_green= .............. output file with full Green function(s)",
+" file_gplus= .............. output file with G+ ",
+" file_gmin= ............... output file with G- ",
+" file_f1plus= ............. output file with f1+ ",
+" file_f1min= .............. output file with f1- ",
+" file_f2= ................. output file with f2 (=p+) ",
+" file_pplus= .............. output file with p+ ",
+" file_pmin= ............... output file with p- ",
+" file_iter= ............... output file with -Ni(-t) for each iteration",
+" verbose=0 ................ silent option; >0 displays info",
+" ",
+" ",
+" author : Jan Thorbecke : 2016 (j.w.thorbecke@tudelft.nl)",
+" ",
+NULL};
+/**************** end self doc ***********************************/
+
+int main (int argc, char **argv)
+{
+ FILE *fp_out, *fp_f1plus, *fp_f1min;
+ FILE *fp_gmin, *fp_gplus, *fp_f2, *fp_pmin;
+ int i, j, l, ret, nshots, Nfoc, nt, nx, nts, nxs, ngath;
+ int size, n1, n2, ntap, tap, di, ntraces, pad;
+ int nw, nw_low, nw_high, nfreq, *xnx, *xnxsyn;
+ int reci, countmin, mode, n2out, verbose, ntfft;
+ int iter, niter, tracf, *muteW;
+ int hw, smooth, above, shift, *ixpos, npos, ix;
+ int nshots_r, *isxcount, *reci_xsrc, *reci_xrcv;
+ float fmin, fmax, *tapersh, *tapersy, fxf, dxf, *xsrc, *xrcv, *zsyn, *zsrc, *xrcvsyn;
+ double t0, t1, t2, t3, tsyn, tread, tfft, tcopy, energyNi, energyN0;
+ float d1, d2, f1, f2, fxsb, fxse, ft, fx, *xsyn, dxsrc;
+ float *green, *f2p, *pmin, *G_d, dt, dx, dxs, scl, mem;
+ float *f1plus, *f1min, *iRN, *Ni, *trace, *Gmin, *Gplus;
+ float xmin, xmax, scale, tsq, Q, f0;
+ float *ixmask;
+ complex *Refl, *Fop;
+ char *file_tinv, *file_shot, *file_green, *file_iter;
+ char *file_f1plus, *file_f1min, *file_gmin, *file_gplus, *file_f2, *file_pmin;
+ segy *hdrs_out;
+
+ initargs(argc, argv);
+ requestdoc(1);
+
+ tsyn = tread = tfft = tcopy = 0.0;
+ t0 = wallclock_time();
+
+ if (!getparstring("file_shot", &file_shot)) file_shot = NULL;
+ if (!getparstring("file_tinv", &file_tinv)) file_tinv = NULL;
+ if (!getparstring("file_f1plus", &file_f1plus)) file_f1plus = NULL;
+ if (!getparstring("file_f1min", &file_f1min)) file_f1min = NULL;
+ if (!getparstring("file_gplus", &file_gplus)) file_gplus = NULL;
+ if (!getparstring("file_gmin", &file_gmin)) file_gmin = NULL;
+ if (!getparstring("file_pplus", &file_f2)) file_f2 = NULL;
+ if (!getparstring("file_f2", &file_f2)) file_f2 = NULL;
+ if (!getparstring("file_pmin", &file_pmin)) file_pmin = NULL;
+ if (!getparstring("file_iter", &file_iter)) file_iter = NULL;
+ if (!getparint("verbose", &verbose)) verbose = 0;
+ if (file_tinv == NULL && file_shot == NULL)
+ verr("file_tinv and file_shot cannot be both input pipe");
+ if (!getparstring("file_green", &file_green)) {
+ if (verbose) vwarn("parameter file_green not found, assume pipe");
+ file_green = NULL;
+ }
+ if (!getparfloat("fmin", &fmin)) fmin = 0.0;
+ if (!getparfloat("fmax", &fmax)) fmax = 70.0;
+ if (!getparint("reci", &reci)) reci = 0;
+ if (!getparfloat("scale", &scale)) scale = 2.0;
+ if (!getparfloat("tsq", &tsq)) tsq = 0.0;
+ if (!getparfloat("Q", &Q)) Q = 0.0;
+ if (!getparfloat("f0", &f0)) f0 = 0.0;
+ if (!getparint("tap", &tap)) tap = 0;
+ if (!getparint("ntap", &ntap)) ntap = 0;
+ if (!getparint("pad", &pad)) pad = 0;
+
+ if(!getparint("niter", &niter)) niter = 10;
+ if(!getparint("hw", &hw)) hw = 15;
+ if(!getparint("smooth", &smooth)) smooth = 5;
+ if(!getparint("above", &above)) above = 0;
+ if(!getparint("shift", &shift)) shift=12;
+
+ if (reci && ntap) vwarn("tapering influences the reciprocal result");
+
+/*================ Reading info about shot and initial operator sizes ================*/
+
+ ngath = 0; /* setting ngath=0 scans all traces; n2 contains maximum traces/gather */
+ ret = getFileInfo(file_tinv, &n1, &n2, &ngath, &d1, &d2, &f1, &f2, &xmin, &xmax, &scl, &ntraces);
+ Nfoc = ngath;
+ nxs = n2;
+ nts = n1;
+ dxs = d2;
+ fxsb = f2;
+
+ ngath = 0; /* setting ngath=0 scans all traces; nx contains maximum traces/gather */
+ ret = getFileInfo(file_shot, &nt, &nx, &ngath, &d1, &dx, &ft, &fx, &xmin, &xmax, &scl, &ntraces);
+ nshots = ngath;
+ assert (nxs >= nshots);
+
+ if (!getparfloat("dt", &dt)) dt = d1;
+
+ ntfft = optncr(MAX(nt+pad, nts+pad));
+ nfreq = ntfft/2+1;
+ nw_low = (int)MIN((fmin*ntfft*dt), nfreq-1);
+ nw_low = MAX(nw_low, 1);
+ nw_high = MIN((int)(fmax*ntfft*dt), nfreq-1);
+ nw = nw_high - nw_low + 1;
+ scl = 1.0/((float)ntfft);
+ if (!getparint("countmin", &countmin)) countmin = 0.3*nx;
+
+/*================ Allocating all data arrays ================*/
+
+ Fop = (complex *)calloc(nxs*nw*Nfoc,sizeof(complex));
+ green = (float *)calloc(Nfoc*nxs*ntfft,sizeof(float));
+ f2p = (float *)calloc(Nfoc*nxs*ntfft,sizeof(float));
+ pmin = (float *)calloc(Nfoc*nxs*ntfft,sizeof(float));
+ f1plus = (float *)calloc(Nfoc*nxs*ntfft,sizeof(float));
+ f1min = (float *)calloc(Nfoc*nxs*ntfft,sizeof(float));
+ iRN = (float *)calloc(Nfoc*nxs*ntfft,sizeof(float));
+ Ni = (float *)calloc(Nfoc*nxs*ntfft,sizeof(float));
+ G_d = (float *)calloc(Nfoc*nxs*ntfft,sizeof(float));
+ muteW = (int *)calloc(Nfoc*nxs,sizeof(int));
+ trace = (float *)malloc(ntfft*sizeof(float));
+ tapersy = (float *)malloc(nxs*sizeof(float));
+ xrcvsyn = (float *)calloc(Nfoc*nxs,sizeof(float)); // x-rcv postions of focal points
+ xsyn = (float *)malloc(Nfoc*sizeof(float)); // x-src position of focal points
+ zsyn = (float *)malloc(Nfoc*sizeof(float)); // z-src position of focal points
+ xnxsyn = (int *)calloc(Nfoc,sizeof(int)); // number of traces per focal point
+ ixpos = (int *)calloc(nxs,sizeof(int)); // x-position of source of shot in G_d domain (nxs with dxs)
+
+ Refl = (complex *)malloc(nw*nx*nshots*sizeof(complex));
+ tapersh = (float *)malloc(nx*sizeof(float));
+ xrcv = (float *)calloc(nshots*nx,sizeof(float)); // x-rcv postions of shots
+ xsrc = (float *)calloc(nshots,sizeof(float)); //x-src position of shots
+ zsrc = (float *)calloc(nshots,sizeof(float)); // z-src position of shots
+ xnx = (int *)calloc(nshots,sizeof(int)); // number of traces per shot
+
+ if (reci!=0) {
+ reci_xsrc = (int *)malloc((nxs*nxs)*sizeof(int));
+ reci_xrcv = (int *)malloc((nxs*nxs)*sizeof(int));
+ isxcount = (int *)calloc(nxs,sizeof(int));
+ ixmask = (float *)calloc(nxs,sizeof(float));
+ }
+
+/*================ Read and define mute window based on focusing operator(s) ================*/
+/* G_d = p_0^+ = G_d (-t) ~ Tinv */
+
+ mode=-1; /* apply complex conjugate to read in data */
+ readTinvData(file_tinv, xrcvsyn, xsyn, zsyn, xnxsyn, Nfoc, nxs, ntfft,
+ mode, muteW, G_d, hw, verbose);
+ /* reading data added zero's to the number of time samples to be the same as ntfft */
+ nts = ntfft;
+
+ /* define tapers to taper edges of acquisition */
+ if (tap == 1 || tap == 3) {
+ for (j = 0; j < ntap; j++)
+ tapersy[j] = (cos(PI*(j-ntap)/ntap)+1)/2.0;
+ for (j = ntap; j < nxs-ntap; j++)
+ tapersy[j] = 1.0;
+ for (j = nxs-ntap; j < nxs; j++)
+ tapersy[j] =(cos(PI*(j-(nxs-ntap))/ntap)+1)/2.0;
+ }
+ else {
+ for (j = 0; j < nxs; j++) tapersy[j] = 1.0;
+ }
+ if (tap == 1 || tap == 3) {
+ if (verbose) vmess("Taper for operator applied ntap=%d", ntap);
+ for (l = 0; l < Nfoc; l++) {
+ for (i = 0; i < nxs; i++) {
+ for (j = 0; j < nts; j++) {
+ G_d[l*nxs*nts+i*nts+j] *= tapersy[i];
+ }
+ }
+ }
+ }
+
+ /* check consistency of header values */
+ if (xrcvsyn[0] != 0 || xrcvsyn[1] != 0 ) fxsb = xrcvsyn[0];
+ fxse = fxsb + (float)(nxs-1)*dxs;
+ dxf = (xrcvsyn[nxs-1] - xrcvsyn[0])/(float)(nxs-1);
+ if (NINT(dxs*1e3) != NINT(fabs(dxf)*1e3)) {
+ vmess("dx in hdr.d1 (%.3f) and hdr.gx (%.3f) not equal",d2, dxf);
+ if (dxf != 0) dxs = fabs(dxf);
+ vmess("dx in operator => %f", dxs);
+ }
+
+/*================ Reading shot records ================*/
+
+ mode=1;
+ readShotData(file_shot, xrcv, xsrc, zsrc, xnx, Refl, nw, nw_low, nshots, nx, nxs, fxsb, dxs, ntfft,
+ mode, scale, tsq, Q, f0, reci, &nshots_r, isxcount, reci_xsrc, reci_xrcv, ixmask, verbose);
+
+ tapersh = (float *)malloc(nx*sizeof(float));
+ if (tap == 2 || tap == 3) {
+ for (j = 0; j < ntap; j++)
+ tapersh[j] = (cos(PI*(j-ntap)/ntap)+1)/2.0;
+ for (j = ntap; j < nx-ntap; j++)
+ tapersh[j] = 1.0;
+ for (j = nx-ntap; j < nx; j++)
+ tapersh[j] =(cos(PI*(j-(nx-ntap))/ntap)+1)/2.0;
+ }
+ else {
+ for (j = 0; j < nx; j++) tapersh[j] = 1.0;
+ }
+ if (tap == 2 || tap == 3) {
+ if (verbose) vmess("Taper for shots applied ntap=%d", ntap);
+ for (l = 0; l < nshots; l++) {
+ for (j = 1; j < nw; j++) {
+ for (i = 0; i < nx; i++) {
+ Refl[l*nx*nw+j*nx+i].r *= tapersh[i];
+ Refl[l*nx*nw+j*nx+i].i *= tapersh[i];
+ }
+ }
+ }
+ }
+ free(tapersh);
+
+ /* check consistency of header values */
+ fxf = xsrc[0];
+ if (nx > 1) dxf = (xrcv[nx-1] - xrcv[0])/(float)(nx-1);
+ else dxf = d2;
+ if (NINT(dx*1e3) != NINT(fabs(dxf)*1e3)) {
+ vmess("dx in hdr.d1 (%.3f) and hdr.gx (%.3f) not equal",dx, dxf);
+ if (dxf != 0) dx = fabs(dxf);
+ else verr("gx hdrs not set");
+ vmess("dx used => %f", dx);
+ }
+
+ dxsrc = (float)xsrc[1] - xsrc[0];
+ if (dxsrc == 0) {
+ vwarn("sx hdrs are not filled in!!");
+ dxsrc = dx;
+ }
+
+/*================ Check the size of the files ================*/
+
+ if (NINT(dxsrc/dx)*dx != NINT(dxsrc)) {
+ vwarn("source (%.2f) and receiver step (%.2f) don't match",dxsrc,dx);
+ if (reci == 2) vwarn("step used from operator (%.2f) ",dxs);
+ }
+ di = NINT(dxf/dxs);
+ if ((NINT(di*dxs) != NINT(dxf)) && verbose)
+ vwarn("dx in receiver (%.2f) and operator (%.2f) don't match",dx,dxs);
+ if (nt != nts)
+ vmess("Time samples in shot (%d) and focusing operator (%d) are not equal",nt, nts);
+ if (verbose) {
+ vmess("Number of focusing operators = %d", Nfoc);
+ vmess("Number of receivers in focusop = %d", nxs);
+ vmess("number of shots = %d", nshots);
+ vmess("number of receiver/shot = %d", nx);
+ vmess("first model position = %.2f", fxsb);
+ vmess("last model position = %.2f", fxse);
+ vmess("first source position fxf = %.2f", fxf);
+ vmess("source distance dxsrc = %.2f", dxsrc);
+ vmess("last source position = %.2f", fxf+(nshots-1)*dxsrc);
+ vmess("receiver distance dxf = %.2f", dxf);
+ vmess("direction of increasing traces = %d", di);
+ vmess("number of time samples (nt,nts) = %d (%d,%d)", ntfft, nt, nts);
+ vmess("time sampling = %e ", dt);
+ if (file_green != NULL) vmess("Green output file = %s ", file_green);
+ if (file_gmin != NULL) vmess("Gmin output file = %s ", file_gmin);
+ if (file_gplus != NULL) vmess("Gplus output file = %s ", file_gplus);
+ if (file_pmin != NULL) vmess("Pmin output file = %s ", file_pmin);
+ if (file_f2 != NULL) vmess("f2 (=pplus) output file = %s ", file_f2);
+ if (file_f1min != NULL) vmess("f1min output file = %s ", file_f1min);
+ if (file_f1plus != NULL)vmess("f1plus output file = %s ", file_f1plus);
+ if (file_iter != NULL) vmess("Iterations output file = %s ", file_iter);
+ }
+
+/*================ initializations ================*/
+
+ if (reci) n2out = nxs;
+ else n2out = nshots;
+ mem = Nfoc*n2out*ntfft*sizeof(float)/1048576.0;
+ if (verbose) {
+ vmess("number of output traces = %d", n2out);
+ vmess("number of output samples = %d", ntfft);
+ vmess("Size of output data/file = %.1f MB", mem);
+ }
+
+
+ /* dry-run of synthesis to get all x-positions calcalated by the integration */
+ synthesisPosistions(nx, nt, nxs, nts, dt, xsyn, Nfoc, xrcv, xsrc, xnx, fxse, fxsb,
+ dxs, dxsrc, dx, nshots, ixpos, &npos, isxcount, countmin, reci, verbose);
+ if (verbose) {
+ vmess("synthesisPosistions: nshots=%d npos=%d", nshots, npos);
+ }
+
+/*================ set variables for output data ================*/
+
+ n1 = nts; n2 = n2out;
+ f1 = ft; f2 = fxsb+dxs*ixpos[0];
+ d1 = dt;
+ if (reci == 0) d2 = dxsrc; // distance between sources in R
+ else if (reci == 1) d2 = dxs; // distance between traces in G_d
+ else if (reci == 2) d2 = dx; // distance between receivers in R
+
+ hdrs_out = (segy *) calloc(n2,sizeof(segy));
+ if (hdrs_out == NULL) verr("allocation for hdrs_out");
+ size = nxs*nts;
+
+ for (i = 0; i < n2; i++) {
+ hdrs_out[i].ns = n1;
+ hdrs_out[i].trid = 1;
+ hdrs_out[i].dt = dt*1000000;
+ hdrs_out[i].f1 = f1;
+ hdrs_out[i].f2 = f2;
+ hdrs_out[i].d1 = d1;
+ hdrs_out[i].d2 = d2;
+ hdrs_out[i].trwf = n2out;
+ hdrs_out[i].scalco = -1000;
+ hdrs_out[i].gx = NINT(1000*(f2+i*d2));
+ hdrs_out[i].scalel = -1000;
+ hdrs_out[i].tracl = i+1;
+ }
+ t1 = wallclock_time();
+ tread = t1-t0;
+
+/*================ initialization ================*/
+
+ memcpy(Ni, G_d, Nfoc*nxs*ntfft*sizeof(float));
+ for (l = 0; l < Nfoc; l++) {
+ for (i = 0; i < npos; i++) {
+ j = 0;
+ ix = ixpos[i]; /* select the traces that have an output trace after integration */
+ f2p[l*nxs*nts+i*nts+j] = G_d[l*nxs*nts+ix*nts+j];
+ f1plus[l*nxs*nts+i*nts+j] = G_d[l*nxs*nts+ix*nts+j];
+ for (j = 1; j < nts; j++) {
+ f2p[l*nxs*nts+i*nts+j] = G_d[l*nxs*nts+ix*nts+j];
+ f1plus[l*nxs*nts+i*nts+j] = G_d[l*nxs*nts+ix*nts+j];
+ }
+ }
+ }
+
+/*================ start Marchenko iterations ================*/
+
+ for (iter=0; iter<niter; iter++) {
+
+ t2 = wallclock_time();
+
+/*================ construction of Ni(-t) = - \int R(x,t) Ni(t) ================*/
+
+ synthesis(Refl, Fop, Ni, iRN, nx, nt, nxs, nts, dt, xsyn, Nfoc,
+ xrcv, xsrc, xnx, fxse, fxsb, dxs, dxsrc, dx, ntfft, nw, nw_low, nw_high, mode,
+ reci, nshots, ixpos, npos, &tfft, isxcount, reci_xsrc, reci_xrcv, ixmask, verbose);
+
+ t3 = wallclock_time();
+ tsyn += t3 - t2;
+
+ if (file_iter != NULL) {
+ writeDataIter(file_iter, iRN, hdrs_out, ntfft, nxs, d2, f2, n2out, Nfoc, xsyn, zsyn, ixpos, npos, iter);
+ }
+ /* N_k(x,t) = -N_(k-1)(x,-t) */
+ /* p0^-(x,t) += iRN = (R * T_d^inv)(t) */
+ for (l = 0; l < Nfoc; l++) {
+ energyNi = 0.0;
+ for (i = 0; i < npos; i++) {
+ j = 0;
+ ix = ixpos[i];
+ Ni[l*nxs*nts+i*nts+j] = -iRN[l*nxs*nts+ix*nts+j];
+ pmin[l*nxs*nts+i*nts+j] += iRN[l*nxs*nts+ix*nts+j];
+ energyNi += iRN[l*nxs*nts+ix*nts+j]*iRN[l*nxs*nts+ix*nts+j];
+ for (j = 1; j < nts; j++) {
+ Ni[l*nxs*nts+i*nts+j] = -iRN[l*nxs*nts+ix*nts+nts-j];
+ pmin[l*nxs*nts+i*nts+j] += iRN[l*nxs*nts+ix*nts+j];
+ energyNi += iRN[l*nxs*nts+ix*nts+j]*iRN[l*nxs*nts+ix*nts+j];
+ }
+ }
+ if (iter==0) energyN0 = energyNi;
+ if (verbose >=2) vmess(" - iSyn %d: Ni at iteration %d has energy %e; relative to N0 %e", l, iter, sqrt(energyNi),
+sqrt(energyNi/energyN0));
+ }
+
+ /* apply mute window based on times of direct arrival (in muteW) */
+ applyMute(Ni, muteW, smooth, above, Nfoc, nxs, nts, ixpos, npos, shift);
+
+ /* update f2 */
+ for (l = 0; l < Nfoc; l++) {
+ for (i = 0; i < npos; i++) {
+ j = 0;
+ f2p[l*nxs*nts+i*nts+j] += Ni[l*nxs*nts+i*nts+j];
+ for (j = 1; j < nts; j++) {
+ f2p[l*nxs*nts+i*nts+j] += Ni[l*nxs*nts+i*nts+j];
+ }
+ }
+ }
+
+ if (iter % 2 == 0) { /* even iterations update: => f_1^-(t) */
+ for (l = 0; l < Nfoc; l++) {
+ for (i = 0; i < npos; i++) {
+ j = 0;
+ f1min[l*nxs*nts+i*nts+j] -= Ni[l*nxs*nts+i*nts+j];
+ for (j = 1; j < nts; j++) {
+ f1min[l*nxs*nts+i*nts+j] -= Ni[l*nxs*nts+i*nts+nts-j];
+ }
+ }
+ }
+ }
+ else {/* odd iterations update: => f_1^+(t) */
+ for (l = 0; l < Nfoc; l++) {
+ for (i = 0; i < npos; i++) {
+ j = 0;
+ f1plus[l*nxs*nts+i*nts+j] += Ni[l*nxs*nts+i*nts+j];
+ for (j = 1; j < nts; j++) {
+ f1plus[l*nxs*nts+i*nts+j] += Ni[l*nxs*nts+i*nts+j];
+ }
+ }
+ }
+ }
+
+ t2 = wallclock_time();
+ tcopy += t2 - t3;
+
+ if (verbose) vmess("*** Iteration %d finished ***", iter);
+
+ } /* end of iterations */
+
+ free(Ni);
+ free(G_d);
+
+ /* compute full Green's function G = int R * f2(t) + f2(-t) = Pplus + Pmin */
+ for (l = 0; l < Nfoc; l++) {
+ for (i = 0; i < npos; i++) {
+ j = 0;
+ /* set green to zero if mute-window exceeds nt/2 */
+ if (muteW[l*nxs+ixpos[i]] >= nts/2) {
+ memset(&green[l*nxs*nts+i*nts],0, sizeof(float)*nt);
+ continue;
+ }
+ green[l*nxs*nts+i*nts+j] = f2p[l*nxs*nts+i*nts+j] + pmin[l*nxs*nts+i*nts+j];
+ for (j = 1; j < nts; j++) {
+ green[l*nxs*nts+i*nts+j] = f2p[l*nxs*nts+i*nts+nts-j] + pmin[l*nxs*nts+i*nts+j];
+ }
+ }
+ }
+
+ /* compute upgoing Green's function G^+,- */
+ if (file_gmin != NULL) {
+ Gmin = (float *)calloc(Nfoc*nxs*ntfft,sizeof(float));
+
+ /* use f1+ as operator on R in frequency domain */
+ mode=1;
+ synthesis(Refl, Fop, f1plus, iRN, nx, nt, nxs, nts, dt, xsyn, Nfoc,
+ xrcv, xsrc, xnx, fxse, fxsb, dxs, dxsrc, dx, ntfft, nw, nw_low, nw_high, mode,
+ reci, nshots, ixpos, npos, &tfft, isxcount, reci_xsrc, reci_xrcv, ixmask, verbose);
+
+ /* compute upgoing Green's G^-,+ */
+ for (l = 0; l < Nfoc; l++) {
+ for (i = 0; i < npos; i++) {
+ j=0;
+ ix = ixpos[i];
+ Gmin[l*nxs*nts+i*nts+j] = iRN[l*nxs*nts+ix*nts+j] - f1min[l*nxs*nts+i*nts+j];
+ for (j = 1; j < nts; j++) {
+ Gmin[l*nxs*nts+i*nts+j] = iRN[l*nxs*nts+ix*nts+j] - f1min[l*nxs*nts+i*nts+j];
+ }
+ }
+ }
+ /* Apply mute with window for Gmin */
+ applyMute(Gmin, muteW, smooth, 1, Nfoc, nxs, nts, ixpos, npos, shift);
+ } /* end if Gmin */
+
+ /* compute downgoing Green's function G^+,+ */
+ if (file_gplus != NULL) {
+ Gplus = (float *)calloc(Nfoc*nxs*ntfft,sizeof(float));
+
+ /* use f1-(*) as operator on R in frequency domain */
+ mode=-1;
+ synthesis(Refl, Fop, f1min, iRN, nx, nt, nxs, nts, dt, xsyn, Nfoc,
+ xrcv, xsrc, xnx, fxse, fxsb, dxs, dxsrc, dx, ntfft, nw, nw_low, nw_high, mode,
+ reci, nshots, ixpos, npos, &tfft, isxcount, reci_xsrc, reci_xrcv, ixmask, verbose);
+
+ /* compute downgoing Green's G^+,+ */
+ for (l = 0; l < Nfoc; l++) {
+ for (i = 0; i < npos; i++) {
+ j=0;
+ ix = ixpos[i];
+ Gplus[l*nxs*nts+i*nts+j] = -iRN[l*nxs*nts+ix*nts+j] + f1plus[l*nxs*nts+i*nts+j];
+ for (j = 1; j < nts; j++) {
+ Gplus[l*nxs*nts+i*nts+j] = -iRN[l*nxs*nts+ix*nts+j] + f1plus[l*nxs*nts+i*nts+nts-j];
+ }
+ }
+ }
+ } /* end if Gplus */
+
+ t2 = wallclock_time();
+ if (verbose) {
+ vmess("Total CPU-time marchenko = %.3f", t2-t0);
+ vmess("with CPU-time synthesis = %.3f", tsyn);
+ vmess("with CPU-time copy array = %.3f", tcopy);
+ vmess(" CPU-time fft data = %.3f", tfft);
+ vmess("and CPU-time read data = %.3f", tread);
+ }
+
+/*================ write output files ================*/
+
+
+ fp_out = fopen(file_green, "w+");
+ if (fp_out==NULL) verr("error on creating output file %s", file_green);
+ if (file_gmin != NULL) {
+ fp_gmin = fopen(file_gmin, "w+");
+ if (fp_gmin==NULL) verr("error on creating output file %s", file_gmin);
+ }
+ if (file_gplus != NULL) {
+ fp_gplus = fopen(file_gplus, "w+");
+ if (fp_gplus==NULL) verr("error on creating output file %s", file_gplus);
+ }
+ if (file_f2 != NULL) {
+ fp_f2 = fopen(file_f2, "w+");
+ if (fp_f2==NULL) verr("error on creating output file %s", file_f2);
+ }
+ if (file_pmin != NULL) {
+ fp_pmin = fopen(file_pmin, "w+");
+ if (fp_pmin==NULL) verr("error on creating output file %s", file_pmin);
+ }
+ if (file_f1plus != NULL) {
+ fp_f1plus = fopen(file_f1plus, "w+");
+ if (fp_f1plus==NULL) verr("error on creating output file %s", file_f1plus);
+ }
+ if (file_f1min != NULL) {
+ fp_f1min = fopen(file_f1min, "w+");
+ if (fp_f1min==NULL) verr("error on creating output file %s", file_f1min);
+ }
+
+
+ tracf = 1;
+ for (l = 0; l < Nfoc; l++) {
+ if (reci) f2 = fxsb;
+ else f2 = fxf;
+
+ for (i = 0; i < n2; i++) {
+ hdrs_out[i].fldr = l+1;
+ hdrs_out[i].sx = NINT(xsyn[l]*1000);
+ hdrs_out[i].offset = (long)NINT((f2+i*d2) - xsyn[l]);
+ hdrs_out[i].tracf = tracf++;
+ hdrs_out[i].selev = NINT(zsyn[l]*1000);
+ hdrs_out[i].sdepth = NINT(-zsyn[l]*1000);
+ hdrs_out[i].f1 = f1;
+ }
+
+ ret = writeData(fp_out, (float *)&green[l*size], hdrs_out, n1, n2);
+ if (ret < 0 ) verr("error on writing output file.");
+
+ if (file_gmin != NULL) {
+ ret = writeData(fp_gmin, (float *)&Gmin[l*size], hdrs_out, n1, n2);
+ if (ret < 0 ) verr("error on writing output file.");
+ }
+ if (file_gplus != NULL) {
+ ret = writeData(fp_gplus, (float *)&Gplus[l*size], hdrs_out, n1, n2);
+ if (ret < 0 ) verr("error on writing output file.");
+ }
+ if (file_f2 != NULL) {
+ ret = writeData(fp_f2, (float *)&f2p[l*size], hdrs_out, n1, n2);
+ if (ret < 0 ) verr("error on writing output file.");
+ }
+ if (file_pmin != NULL) {
+ ret = writeData(fp_pmin, (float *)&pmin[l*size], hdrs_out, n1, n2);
+ if (ret < 0 ) verr("error on writing output file.");
+ }
+ if (file_f1plus != NULL) {
+ /* rotate to get t=0 in the middle */
+ for (i = 0; i < n2; i++) {
+ hdrs_out[i].f1 = -n1*0.5*dt;
+ memcpy(&trace[0],&f1plus[l*size+i*nts],nts*sizeof(float));
+ for (j = 0; j < n1/2; j++) {
+ f1plus[l*size+i*nts+n1/2+j] = trace[j];
+ }
+ for (j = n1/2; j < n1; j++) {
+ f1plus[l*size+i*nts+j-n1/2] = trace[j];
+ }
+ }
+ ret = writeData(fp_f1plus, (float *)&f1plus[l*size], hdrs_out, n1, n2);
+ if (ret < 0 ) verr("error on writing output file.");
+ }
+ if (file_f1min != NULL) {
+ /* rotate to get t=0 in the middle */
+ for (i = 0; i < n2; i++) {
+ hdrs_out[i].f1 = -n1*0.5*dt;
+ memcpy(&trace[0],&f1min[l*size+i*nts],nts*sizeof(float));
+ for (j = 0; j < n1/2; j++) {
+ f1min[l*size+i*nts+n1/2+j] = trace[j];
+ }
+ for (j = n1/2; j < n1; j++) {
+ f1min[l*size+i*nts+j-n1/2] = trace[j];
+ }
+ }
+ ret = writeData(fp_f1min, (float *)&f1min[l*size], hdrs_out, n1, n2);
+ if (ret < 0 ) verr("error on writing output file.");
+ }
+ }
+ ret = fclose(fp_out);
+ if (file_gplus != NULL) {ret += fclose(fp_gplus);}
+ if (file_gmin != NULL) {ret += fclose(fp_gmin);}
+ if (file_f2 != NULL) {ret += fclose(fp_f2);}
+ if (file_pmin != NULL) {ret += fclose(fp_pmin);}
+ if (file_f1plus != NULL) {ret += fclose(fp_f1plus);}
+ if (file_f1min != NULL) {ret += fclose(fp_f1min);}
+ if (ret < 0) verr("err %d on closing output file",ret);
+
+ if (verbose) {
+ t1 = wallclock_time();
+ vmess("and CPU-time write data = %.3f", t1-t2);
+ }
+
+/*================ free memory ================*/
+
+ free(hdrs_out);
+ free(tapersy);
+
+ exit(0);
+}
+
+
+/*================ Convolution and Integration ================*/
+
+void synthesis(complex *Refl, complex *Fop, float *Top, float *iRN, int nx, int nt, int nxs, int nts, float dt, float *xsyn, int
+Nfoc, float *xrcv, float *xsrc, int *xnx, float fxse, float fxsb, float dxs, float dxsrc, float dx, int ntfft, int
+nw, int nw_low, int nw_high, int mode, int reci, int nshots, int *ixpos, int npos, double *tfft, int *isxcount, int
+*reci_xsrc, int *reci_xrcv, float *ixmask, int verbose)
+{
+ int nfreq, size, inx;
+ float scl;
+ int i, j, l, m, iw, ix, k, ixsrc, il, ik;
+ float *rtrace, idxs;
+ complex *sum, *ctrace;
+ int npe;
+ static int first=1, *ixrcv;
+ static double t0, t1, t;
+
+ size = nxs*nts;
+ nfreq = ntfft/2+1;
+ /* scale factor 1/N for backward FFT,
+ * scale dt for correlation/convolution along time,
+ * scale dx (or dxsrc) for integration over receiver (or shot) coordinates */
+ scl = 1.0*dt/((float)ntfft);
+
+#ifdef _OPENMP
+ npe = omp_get_max_threads();
+ /* parallelisation is over number of virtual source positions (Nfoc) */
+ if (npe > Nfoc) {
+ vmess("Number of OpenMP threads set to %d (was %d)", Nfoc, npe);
+ omp_set_num_threads(Nfoc);
+ }
+#endif
+
+ t0 = wallclock_time();
+
+ /* reset output data to zero */
+ memset(&iRN[0], 0, Nfoc*nxs*nts*sizeof(float));
+ ctrace = (complex *)calloc(ntfft,sizeof(complex));
+
+ if (!first) {
+ /* transform muted Ni (Top) to frequency domain, input for next iteration */
+ for (l = 0; l < Nfoc; l++) {
+ /* set Fop to zero, so new operator can be defined within ixpos points */
+ memset(&Fop[l*nxs*nw].r, 0, nxs*nw*2*sizeof(float));
+ for (i = 0; i < npos; i++) {
+ rc1fft(&Top[l*size+i*nts],ctrace,ntfft,-1);
+ ix = ixpos[i];
+ for (iw=0; iw<nw; iw++) {
+ Fop[l*nxs*nw+iw*nxs+ix].r = ctrace[nw_low+iw].r;
+ Fop[l*nxs*nw+iw*nxs+ix].i = mode*ctrace[nw_low+iw].i;
+ }
+ }
+ }
+ }
+ else { /* only for first call to synthesis using all nxs traces in G_d */
+ /* transform G_d to frequency domain, over all nxs traces */
+ first=0;
+ for (l = 0; l < Nfoc; l++) {
+ /* set Fop to zero, so new operator can be defined within all ix points */
+ memset(&Fop[l*nxs*nw].r, 0, nxs*nw*2*sizeof(float));
+ for (i = 0; i < nxs; i++) {
+ rc1fft(&Top[l*size+i*nts],ctrace,ntfft,-1);
+ for (iw=0; iw<nw; iw++) {
+ Fop[l*nxs*nw+iw*nxs+i].r = ctrace[nw_low+iw].r;
+ Fop[l*nxs*nw+iw*nxs+i].i = mode*ctrace[nw_low+iw].i;
+ }
+ }
+ }
+ idxs = 1.0/dxs;
+ ixrcv = (int *)malloc(nshots*nx*sizeof(int));
+ for (k=0; k<nshots; k++) {
+ for (i = 0; i < nx; i++) {
+ ixrcv[k*nx+i] = NINT((xrcv[k*nx+i]-fxsb)*idxs);
+ }
+ }
+ }
+ free(ctrace);
+ t1 = wallclock_time();
+ *tfft += t1 - t0;
+
+/* Loop over total number of shots */
+ if (reci == 0 || reci == 1) {
+ for (k=0; k<nshots; k++) {
+ if ((xsrc[k] < 0.999*fxsb) || (xsrc[k] > 1.001*fxse)) continue;
+ ixsrc = NINT((xsrc[k] - fxsb)/dxs);
+ inx = xnx[k]; /* number of traces per shot */
+
+/*================ SYNTHESIS ================*/
+
+#pragma omp parallel default(none) \
+ shared(iRN, dx, npe, nw, verbose) \
+ shared(Refl, Nfoc, reci, xrcv, xsrc, xsyn, fxsb, fxse, nxs, dxs) \
+ shared(nx, dxsrc, inx, k, nfreq, nw_low, nw_high) \
+ shared(Fop, size, nts, ntfft, scl, ixrcv, ixsrc) \
+ private(l, ix, j, m, i, sum, rtrace)
+{ /* start of parallel region */
+ sum = (complex *)malloc(nfreq*sizeof(complex));
+ rtrace = (float *)calloc(ntfft,sizeof(float));
+
+#pragma omp for schedule(guided,1)
+ for (l = 0; l < Nfoc; l++) {
+ /* compute integral over receiver positions */
+ /* multiply R with Fop and sum over nx */
+ memset(&sum[0].r,0,nfreq*2*sizeof(float));
+ for (j = nw_low, m = 0; j <= nw_high; j++, m++) {
+ for (i = 0; i < inx; i++) {
+ ix = ixrcv[k*nx+i];
+ sum[j].r += Refl[k*nw*nx+m*nx+i].r*Fop[l*nw*nxs+m*nxs+ix].r -
+ Refl[k*nw*nx+m*nx+i].i*Fop[l*nw*nxs+m*nxs+ix].i;
+ sum[j].i += Refl[k*nw*nx+m*nx+i].i*Fop[l*nw*nxs+m*nxs+ix].r +
+ Refl[k*nw*nx+m*nx+i].r*Fop[l*nw*nxs+m*nxs+ix].i;
+ }
+ }
+
+ /* transfrom result back to time domain */
+ cr1fft(sum, rtrace, ntfft, 1);
+
+ /* place result at source position ixsrc; dx = receiver distance */
+ for (j = 0; j < nts; j++)
+ iRN[l*size+ixsrc*nts+j] += rtrace[j]*scl*dx;
+
+ } /* end of parallel Nfoc loop */
+ free(sum);
+ free(rtrace);
+
+#ifdef _OPENMP
+#pragma omp single
+ npe = omp_get_num_threads();
+#endif
+} /* end of parallel region */
+
+ if (verbose>4) vmess("*** Shot gather %d processed ***", k);
+
+ } /* end of nshots (k) loop */
+ } /* end of if reci */
+
+/* if reciprocal traces are enabled start a new loop over reciprocal shot positions */
+ if (reci != 0) {
+ for (k=0; k<nxs; k++) {
+ if (isxcount[k] == 0) continue;
+ ixsrc = k;
+ inx = isxcount[ixsrc]; /* number of traces per reciprocal shot */
+
+#pragma omp parallel default(none) \
+ shared(iRN, dx, nw, verbose) \
+ shared(Refl, Nfoc, reci, xrcv, xsrc, xsyn, fxsb, fxse, nxs, dxs) \
+ shared(nx, dxsrc, inx, k, nfreq, nw_low, nw_high) \
+ shared(reci_xrcv, reci_xsrc, ixmask) \
+ shared(Fop, size, nts, ntfft, scl, ixrcv, ixsrc) \
+ private(l, ix, j, m, i, sum, rtrace, ik, il)
+{ /* start of parallel region */
+ sum = (complex *)malloc(nfreq*sizeof(complex));
+ rtrace = (float *)calloc(ntfft,sizeof(float));
+
+#pragma omp for schedule(guided,1)
+ for (l = 0; l < Nfoc; l++) {
+
+ /* compute integral over (reciprocal) source positions */
+ /* multiply R with Fop and sum over nx */
+ memset(&sum[0].r,0,nfreq*2*sizeof(float));
+ for (j = nw_low, m = 0; j <= nw_high; j++, m++) {
+ for (i = 0; i < inx; i++) {
+ il = reci_xrcv[ixsrc*nxs+i];
+ ik = reci_xsrc[ixsrc*nxs+i];
+ ix = NINT((xsrc[il] - fxsb)/dxs);
+ sum[j].r += Refl[il*nw*nx+m*nx+ik].r*Fop[l*nw*nxs+m*nxs+ix].r -
+ Refl[il*nw*nx+m*nx+ik].i*Fop[l*nw*nxs+m*nxs+ix].i;
+ sum[j].i += Refl[il*nw*nx+m*nx+ik].i*Fop[l*nw*nxs+m*nxs+ix].r +
+ Refl[il*nw*nx+m*nx+ik].r*Fop[l*nw*nxs+m*nxs+ix].i;
+ }
+ }
+
+ /* transfrom result back to time domain */
+ cr1fft(sum, rtrace, ntfft, 1);
+
+ /* place result at source position ixsrc; dxsrc = shot distance */
+ for (j = 0; j < nts; j++)
+ iRN[l*size+ixsrc*nts+j] = ixmask[ixsrc]*(iRN[l*size+ixsrc*nts+j]+rtrace[j]*scl*dxsrc);
+
+ } /* end of parallel Nfoc loop */
+
+ free(sum);
+ free(rtrace);
+
+ } /* end of parallel region */
+
+ } /* end of reciprocal shots (k) loop */
+ } /* end of if reci */
+
+ t = wallclock_time() - t0;
+ if (verbose) {
+ vmess("OMP: parallel region = %f seconds (%d threads)", t, npe);
+ }
+
+ return;
+}
+
+void synthesisPosistions(int nx, int nt, int nxs, int nts, float dt, float *xsyn, int Nfoc, float *xrcv, float *xsrc, int *xnx,
+float fxse, float fxsb, float dxs, float dxsrc, float dx, int nshots, int *ixpos, int *npos, int *isxcount, int countmin, int reci, int verbose)
+{
+ int i, j, l, ixsrc, ixrcv, dosrc, k, *count;
+ float x0, x1;
+
+ count = (int *)calloc(nxs,sizeof(int)); // number of traces that contribute to the integration over x
+
+/*================ SYNTHESIS ================*/
+
+ for (l = 0; l < 1; l++) { /* assuming all focal operators cover the same lateral area */
+// for (l = 0; l < Nfoc; l++) {
+ *npos=0;
+
+ if (reci == 0 || reci == 1) {
+ for (k=0; k<nshots; k++) {
+
+ ixsrc = NINT((xsrc[k] - fxsb)/dxs);
+ if (verbose>=3) {
+ vmess("source position: %.2f in operator %d", xsrc[k], ixsrc);
+ vmess("receiver positions: %.2f <--> %.2f", xrcv[k*nx+0], xrcv[k*nx+nx-1]);
+ vmess("focal point positions: %.2f <--> %.2f", fxsb, fxse);
+ }
+
+ if ((NINT(xsrc[k]-fxse) > 0) || (NINT(xrcv[k*nx+nx-1]-fxse) > 0) ||
+ (NINT(xrcv[k*nx+nx-1]-fxsb) < 0) || (NINT(xsrc[k]-fxsb) < 0) ||
+ (NINT(xrcv[k*nx+0]-fxsb) < 0) || (NINT(xrcv[k*nx+0]-fxse) > 0) ) {
+ vwarn("source/receiver positions are outside synthesis aperture");
+ vmess("xsrc = %.2f xrcv_1 = %.2f xrvc_N = %.2f", xsrc[k], xrcv[k*nx+0], xrcv[k*nx+nx-1]);
+ vmess("source position: %.2f in operator %d", xsrc[k], ixsrc);
+ vmess("receiver positions: %.2f <--> %.2f", xrcv[k*nx+0], xrcv[k*nx+nx-1]);
+ vmess("focal point positions: %.2f <--> %.2f", fxsb, fxse);
+ }
+
+ if ( (xsrc[k] >= 0.999*fxsb) && (xsrc[k] <= 1.001*fxse) ) {
+ j = linearsearch(ixpos, *npos, ixsrc);
+ if (j < *npos) { /* the position (at j) is already included */
+ count[j] += xnx[k];
+ }
+ else { /* add new postion */
+ ixpos[*npos]=ixsrc;
+ count[*npos] += xnx[k];
+ *npos += 1;
+ }
+ // vmess("source position %d is inside synthesis model %f *npos=%d count=%d", k, xsrc[k], *npos, count[*npos]);
+ }
+
+ } /* end of nshots (k) loop */
+ } /* end of reci branch */
+
+ /* if reci=1 or reci=2 source-receive reciprocity is used and new (reciprocal-)sources are added */
+ if (reci != 0) {
+ for (k=0; k<nxs; k++) { /* check count in total number of shots added by reciprocity */
+ if (isxcount[k] >= countmin) {
+ j = linearsearch(ixpos, *npos, k);
+ if (j < *npos) { /* the position (at j) is already included */
+ count[j] += isxcount[k];
+ }
+ else { /* add new postion */
+ ixpos[*npos]=k;
+ count[*npos] += isxcount[k];
+ *npos += 1;
+ }
+ }
+ else {
+ isxcount[k] = 0;
+ }
+ }
+ } /* end of reci branch */
+ } /* end of Nfoc loop */
+
+ if (verbose>=4) {
+ for (j=0; j < *npos; j++) {
+ vmess("ixpos[%d] = %d count=%d", j, ixpos[j], count[j]);
+ }
+ }
+ free(count);
+
+/* sort ixpos into increasing values */
+ qsort(ixpos, *npos, sizeof(int), compareInt);
+
+
+ return;
+}
+
+int linearsearch(int *array, size_t N, int value)
+{
+ int j;
+/* Check is position is already in array */
+ j = 0;
+ while (j < N && value != array[j]) {
+ j++;
+ }
+ return j;
+}
+
+/*
+void update(float *field, float *term, int Nfoc, int nx, int nt, int reverse, int ixpos)
+{
+ int i, j, l, ix;
+
+ if (reverse) {
+ for (l = 0; l < Nfoc; l++) {
+ for (i = 0; i < npos; i++) {
+ j = 0;
+ Ni[l*nxs*nts+i*nts+j] = -iRN[l*nxs*nts+i*nts+j];
+ for (j = 1; j < nts; j++) {
+ Ni[l*nxs*nts+i*nts+j] = -iRN[l*nxs*nts+i*nts+nts-j];
+ }
+ }
+ }
+ }
+ else {
+ for (l = 0; l < Nfoc; l++) {
+ for (i = 0; i < npos; i++) {
+ j = 0;
+ Ni[l*nxs*nts+i*nts+j] = -iRN[l*nxs*nts+i*nts+j];
+ for (j = 1; j < nts; j++) {
+ Ni[l*nxs*nts+i*nts+j] = -iRN[l*nxs*nts+i*nts+nts-j];
+ }
+ }
+ }
+ }
+ return;
+}
+*/
diff --git a/marchenko3D/marchenko3D.c b/marchenko3D/marchenko3D.c
new file mode 100644
index 0000000000000000000000000000000000000000..f1b615a9cbdc5d1429c53364ffe77e6761c0af9a
--- /dev/null
+++ b/marchenko3D/marchenko3D.c
@@ -0,0 +1,952 @@
+/*
+ * Copyright (c) 2017 by the Society of Exploration Geophysicists.
+ * For more information, go to http://software.seg.org/2017/00XX .
+ * You must read and accept usage terms at:
+ * http://software.seg.org/disclaimer.txt before use.
+ */
+
+#include "par.h"
+#include "segy.h"
+#include <time.h>
+#include <stdlib.h>
+#include <stdio.h>
+#include <math.h>
+#include <assert.h>
+#include <genfft.h>
+
+int omp_get_max_threads(void);
+int omp_get_num_threads(void);
+void omp_set_num_threads(int num_threads);
+
+#ifndef MAX
+#define MAX(x,y) ((x) > (y) ? (x) : (y))
+#endif
+#ifndef MIN
+#define MIN(x,y) ((x) < (y) ? (x) : (y))
+#endif
+#define NINT(x) ((long)((x)>0.0?(x)+0.5:(x)-0.5))
+
+
+
+#ifndef COMPLEX
+typedef struct _complexStruct { /* complex number */
+ float r,i;
+} complex;
+#endif/* complex */
+
+long readShotData3D(char *filename, float *xrcv, float *yrcv, float *xsrc, float *ysrc, float *zsrc, long *xnx, complex *cdata,
+ long nw, long nw_low, long nshots, long nx, long ny, long ntfft, long mode, float scale, long verbose);
+long readTinvData3D(char *filename, float *xrcv, float *yrcv, float *xsrc, float *ysrc, float *zsrc,
+ long *xnx, long Nfoc, long nx, long ny, long ntfft, long mode, long *maxval, float *tinv, long hw, long verbose);
+long unique_elements(float *arr, long len);
+
+void name_ext(char *filename, char *extension);
+
+void convol(float *data1, float *data2, float *con, long nrec, long nsam, float dt, long shift);
+
+void applyMute3D(float *data, long *mute, long smooth, long above, long Nfoc, long nxs, long nt, long *xrcvsyn, long npos, long shift);
+
+long getFileInfo3D(char *filename, long *n1, long *n2, long *n3, long *ngath, float *d1, float *d2, float *d3, float *f1, float *f2, float *f3,
+ float *sclsxgxsygy, long *nxm);
+long readData3D(FILE *fp, float *data, segy *hdrs, long n1);
+long writeData3D(FILE *fp, float *data, segy *hdrs, long n1, long n2);
+long disp_fileinfo3D(char *file, long n1, long n2, long n3, float f1, float f2, float f3, float d1, float d2, float d3, segy *hdrs);
+double wallclock_time(void);
+
+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);
+
+void makeWindow3D(char *file_ray, char *file_amp, char *file_wav, float dt, float *xrcv, float *yrcv, float *xsrc, float *ysrc, float *zsrc,
+ long *xnx, long Nfoc, long nx, long ny, long ntfft, long *maxval, float *tinv, long verbose);
+
+void synthesisPositions3D(long nx, long ny, long nxs, long nys, long Nfoc, float *xrcv, float *yrcv, float *xsrc, float *ysrc,
+ long *xnx, float fxse, float fyse, float fxsb, float fysb, float dxs, float dys, long nshots, long nxsrc, long nysrc,
+ long *ixpos, long *npos, long reci, long verbose);
+void synthesis3D(complex *Refl, complex *Fop, float *Top, float *iRN, long nx, long ny, long nt, long nxs, long nys, long nts, float dt,
+ float *xsyn, float *ysyn, long Nfoc, float *xrcv, float *yrcv, float *xsrc, float *ysrc, long *xnx,
+ float fxse, float fxsb, float fyse, float fysb, float dxs, float dys, float dxsrc, float dysrc,
+ float dx, float dy, long ntfft, long nw, long nw_low, long nw_high, long mode, long reci, long nshots, long nxsrc, long nysrc,
+ long *ixpos, long npos, double *tfft, long *isxcount, long *reci_xsrc, long *reci_xrcv, float *ixmask, long verbose);
+
+void imaging3D(float *Image, float *Gmin, float *f1plus, long nx, long ny, long nt, float dx, float dy, float dt, long Nfoc, long verbose);
+
+long linearsearch(long *array, size_t N, long value);
+
+/*********************** self documentation **********************/
+char *sdoc[] = {
+" ",
+" MARCHENKO3D - Iterative Green's function and focusing functions retrieval in 3D",
+" ",
+" marchenko3D file_tinv= file_shot= [optional parameters]",
+" ",
+" Required parameters: ",
+" ",
+" file_tinv= ............... direct arrival from focal point: G_d",
+" file_shot= ............... Reflection response: R",
+" ",
+" Optional parameters: ",
+" ",
+" INTEGRATION ",
+" tap=0 .................... lateral taper focusing(1), shot(2) or both(3)",
+" ntap=0 ................... number of taper points at boundaries",
+" fmin=0 ................... minimum frequency in the Fourier transform",
+" fmax=70 .................. maximum frequency in the Fourier transform",
+" MARCHENKO ITERATIONS ",
+" niter=10 ................. number of iterations",
+" MUTE-WINDOW ",
+" above=0 .................. mute above(1), around(0) or below(-1) the first travel times of file_tinv",
+" shift=12 ................. number of points above(positive) / below(negative) travel time for mute",
+" hw=8 ..................... window in time samples to look for maximum in next trace",
+" smooth=5 ................. number of points to smooth mute with cosine window",
+" REFLECTION RESPONSE CORRECTION ",
+" scale=2 .................. scale factor of R for summation of Ni with G_d",
+" pad=0 .................... amount of samples to pad the reflection series",
+" reci=0 ................... 1; add receivers as shots 2; only use receivers as shot positions",
+" countmin=0 ............... 0.3*nxrcv; minumum number of reciprocal traces for a contribution",
+" OUTPUT DEFINITION ",
+" file_green= .............. output file with full Green function(s)",
+" file_gplus= .............. output file with G+ ",
+" file_gmin= ............... output file with G- ",
+" file_f1plus= ............. output file with f1+ ",
+" file_f1min= .............. output file with f1- ",
+" file_f2= ................. output file with f2 (=p+) ",
+" file_pplus= .............. output file with p+ ",
+" file_pmin= ............... output file with p- ",
+" file_iter= ............... output file with -Ni(-t) for each iteration",
+" verbose=0 ................ silent option; >0 displays info",
+" ",
+" ",
+" author : Jan Thorbecke : 2016 (j.w.thorbecke@tudelft.nl)",
+" author : Joeri Brackenhoff : 2019 (j.a.brackenhoff@tudelft.nl)",
+" ",
+NULL};
+/**************** end self doc ***********************************/
+
+int main (int argc, char **argv)
+{
+ FILE *fp_out, *fp_f1plus, *fp_f1min, *fp_imag;
+ FILE *fp_gmin, *fp_gplus, *fp_f2, *fp_pmin, *fp_amp;
+ long i, j, l, k, ret, nshots, nxshot, nyshot, Nfoc, nt, nx, ny, nts, nxs, nys, ngath;
+ long size, n1, n2, n3, ntap, tap, dxi, dyi, ntraces, pad;
+ long nw, nw_low, nw_high, nfreq, *xnx, *xnxsyn;
+ long reci, countmin, mode, n2out, n3out, verbose, ntfft;
+ long iter, niter, tracf, *muteW, ampest;
+ long hw, smooth, above, shift, *ixpos, npos, ix, nzim, nxim, nyim;
+ long nshots_r, *isxcount, *reci_xsrc, *reci_xrcv;
+ float fmin, fmax, *tapersh, *tapersy, fxf, fyf, dxf, dyf, *xsrc, *ysrc, *xrcv, *yrcv, *zsyn, *zsrc, *xrcvsyn, *yrcvsyn;
+ double t0, t1, t2, t3, tsyn, tread, tfft, tcopy, energyNi, energyN0;
+ float d1, d2, d3, f1, f2, f3, fxsb, fxse, fysb, fyse, ft, fx, fy, *xsyn, *ysyn, dxsrc, dysrc;
+ float *green, *f2p, *pmin, *G_d, dt, dx, dy, dxs, dys, scl, mem;
+ float *f1plus, *f1min, *iRN, *Ni, *trace, *Gmin, *Gplus;
+ float xmin, xmax, ymin, ymax, scale, tsq, Q, f0, *tmpdata;
+ float *ixmask, *iymask, *ampscl, *Gd, *Image, dzim, dyim, dxim;
+ complex *Refl, *Fop;
+ char *file_tinv, *file_shot, *file_green, *file_iter, *file_imag, *file_ampscl;
+ char *file_f1plus, *file_f1min, *file_gmin, *file_gplus, *file_f2, *file_pmin;
+ char *file_ray, *file_amp, *file_wav;
+ segy *hdrs_out, *hdrs_Nfoc;
+
+ initargs(argc, argv);
+ requestdoc(1);
+
+ tsyn = tread = tfft = tcopy = 0.0;
+ t0 = wallclock_time();
+
+ if (!getparstring("file_shot", &file_shot)) file_shot = NULL;
+ if (!getparstring("file_tinv", &file_tinv)) file_tinv = NULL;
+ if (!getparstring("file_ray", &file_ray)) file_ray = NULL;
+ if (!getparstring("file_amp", &file_amp)) file_amp = NULL;
+ if (!getparstring("file_f1plus", &file_f1plus)) file_f1plus = NULL;
+ if (!getparstring("file_f1min", &file_f1min)) file_f1min = NULL;
+ if (!getparstring("file_gplus", &file_gplus)) file_gplus = NULL;
+ if (!getparstring("file_gmin", &file_gmin)) file_gmin = NULL;
+ if (!getparstring("file_pplus", &file_f2)) file_f2 = NULL;
+ if (!getparstring("file_f2", &file_f2)) file_f2 = NULL;
+ if (!getparstring("file_pmin", &file_pmin)) file_pmin = NULL;
+ if (!getparstring("file_iter", &file_iter)) file_iter = NULL;
+ if (!getparstring("file_wav", &file_wav)) file_wav = NULL;
+ if (!getparstring("file_imag", &file_imag)) file_imag = NULL;
+ if (!getparstring("file_ampscl", &file_ampscl)) file_ampscl = NULL;
+ if (!getparlong("verbose", &verbose)) verbose = 0;
+ if (file_tinv == NULL && file_shot == NULL)
+ verr("file_tinv and file_shot cannot be both input pipe");
+ if (!getparstring("file_green", &file_green)) {
+ if (verbose) vwarn("parameter file_green not found, assume pipe");
+ file_green = NULL;
+ }
+ if (!getparfloat("fmin", &fmin)) fmin = 0.0;
+ if (!getparfloat("fmax", &fmax)) fmax = 70.0;
+ if (!getparlong("reci", &reci)) reci = 0;
+ if (!getparfloat("scale", &scale)) scale = 2.0;
+ if (!getparfloat("tsq", &tsq)) tsq = 0.0;
+ if (!getparfloat("Q", &Q)) Q = 0.0;
+ if (!getparfloat("f0", &f0)) f0 = 0.0;
+ if (!getparlong("tap", &tap)) tap = 0;
+ if (!getparlong("ntap", &ntap)) ntap = 0;
+ if (!getparlong("pad", &pad)) pad = 0;
+ if (!getparlong("ampest", &est)) ampest = 0;
+
+ if(!getparlong("niter", &niter)) niter = 10;
+ if(!getparlong("hw", &hw)) hw = 15;
+ if(!getparlong("smooth", &smooth)) smooth = 5;
+ if(!getparlong("above", &above)) above = 0;
+ if(!getparlong("shift", &shift)) shift=12;
+
+ if (reci && ntap) vwarn("tapering influences the reciprocal result");
+
+/*================ Reading info about shot and initial operator sizes ================*/
+
+ ngath = 0; /* setting ngath=0 scans all traces; n2 contains maximum traces/gather */
+ if (file_ray!=NULL) {
+ ret = getFileInfo3D(file_ray, &n2, &n1, &n3, &ngath, &d2, &d1, &d3, &f2, &f1, &f3, &scl, &ntraces);
+ Nfoc = ngath;
+ nxs = n2;
+ nys = n3;
+ nts = n1;
+ dxs = d2;
+ dys = d3;
+ fxsb = f2;
+ fysb = f3;
+ }
+ else {
+ ret = getFileInfo3D(file_tinv, &n1, &n2, &n3, &ngath, &d1, &d2, &d3, &f1, &f2, &f3, &scl, &ntraces);
+ Nfoc = ngath;
+ nxs = n2;
+ nys = n3;
+ nts = n1;
+ dxs = d2;
+ dys = d3;
+ fxsb = f2;
+ fysb = f3;
+ }
+
+ ngath = 0; /* setting ngath=0 scans all traces; nx contains maximum traces/gather */
+ ret = getFileInfo3D(file_shot, &nt, &nx, &ny, &ngath, &d1, &dx, &dy, &ft, &fx, &fy, &scl, &ntraces);
+ nshots = ngath;
+ assert (nxs*nys >= nshots);
+
+ if (!getparfloat("dt", &dt)) dt = d1;
+
+ ntfft = loptncr(MAX(nt+pad, nts+pad));
+ nfreq = ntfft/2+1;
+ nw_low = (long)MIN((fmin*ntfft*dt), nfreq-1);
+ nw_low = MAX(nw_low, 1);
+ nw_high = MIN((long)(fmax*ntfft*dt), nfreq-1);
+ nw = nw_high - nw_low + 1;
+ scl = 1.0/((float)ntfft);
+ if (!getparlong("countmin", &countmin)) countmin = 0.3*nx*ny;
+
+/*================ Allocating all data arrays ================*/
+
+ Fop = (complex *)calloc(nys*nxs*nw*Nfoc,sizeof(complex));
+ green = (float *)calloc(Nfoc*nys*nxs*ntfft,sizeof(float));
+ f2p = (float *)calloc(Nfoc*nys*nxs*ntfft,sizeof(float));
+ pmin = (float *)calloc(Nfoc*nys*nxs*ntfft,sizeof(float));
+ f1plus = (float *)calloc(Nfoc*nys*nxs*ntfft,sizeof(float));
+ f1min = (float *)calloc(Nfoc*nys*nxs*ntfft,sizeof(float));
+ iRN = (float *)calloc(Nfoc*nys*nxs*ntfft,sizeof(float));
+ Ni = (float *)calloc(Nfoc*nys*nxs*ntfft,sizeof(float));
+ G_d = (float *)calloc(Nfoc*nys*nxs*ntfft,sizeof(float));
+ muteW = (long *)calloc(Nfoc*nys*nxs,sizeof(long));
+ trace = (float *)malloc(ntfft*sizeof(float));
+ tapersy = (float *)malloc(nxs*sizeof(float));
+ xrcvsyn = (float *)calloc(Nfoc*nys*nxs,sizeof(float)); // x-rcv postions of focal points
+ yrcvsyn = (float *)calloc(Nfoc*nys*nxs,sizeof(float)); // x-rcv postions of focal points
+ xsyn = (float *)malloc(Nfoc*sizeof(float)); // x-src position of focal points
+ ysyn = (float *)malloc(Nfoc*sizeof(float)); // x-src position of focal points
+ zsyn = (float *)malloc(Nfoc*sizeof(float)); // z-src position of focal points
+ xnxsyn = (long *)calloc(Nfoc,sizeof(long)); // number of traces per focal point
+ ixpos = (long *)calloc(nys*nxs,sizeof(long)); // x-position of source of shot in G_d domain (nxs*nys with dxs, dys)
+
+ Refl = (complex *)malloc(nw*ny*nx*nshots*sizeof(complex));
+ tapersh = (float *)malloc(nx*sizeof(float));
+ xrcv = (float *)calloc(nshots*ny*nx,sizeof(float)); // x-rcv postions of shots
+ yrcv = (float *)calloc(nshots*ny*nx,sizeof(float)); // x-rcv postions of shots
+ xsrc = (float *)calloc(nshots,sizeof(float)); //x-src position of shots
+ ysrc = (float *)calloc(nshots,sizeof(float)); //x-src position of shots
+ zsrc = (float *)calloc(nshots,sizeof(float)); //z-src position of shots
+ xnx = (long *)calloc(nshots,sizeof(long)); // number of traces per shot
+
+ if (reci!=0) {
+ reci_xsrc = (long *)malloc((nxs*nxs*nys*nys)*sizeof(long));
+ reci_xrcv = (long *)malloc((nxs*nxs*nys*nys)*sizeof(long));
+ isxcount = (long *)calloc(nxs*nys,sizeof(long));
+ ixmask = (float *)calloc(nxs*nys,sizeof(float));
+ }
+
+/*================ Read and define mute window based on focusing operator(s) ================*/
+/* G_d = p_0^+ = G_d (-t) ~ Tinv */
+ if (file_ray!=NULL) {
+ makeWindow3D(file_ray, file_amp, file_wav, dt, xrcvsyn, yrcvsyn, xsyn, ysyn, zsyn,
+ xnxsyn, Nfoc, nx, ny, ntfft, muteW, G_d, verbose);
+ }
+ else {
+ mode=-1; /* apply complex conjugate to read in data */
+ readTinvData3D(file_tinv, xrcvsyn, yrcvsyn, xsyn, ysyn, zsyn, xnxsyn, Nfoc,
+ nxs, nys, ntfft, mode, muteW, G_d, hw, verbose);
+ }
+ /* reading data added zero's to the number of time samples to be the same as ntfft */
+ nts = ntfft;
+
+ /*Determine the shape of the focal positions*/
+ nzim = unique_elements(zsyn,Nfoc);
+ if (nzim>1) dzim = zsyn[1]-zsyn[0];
+ else dzim = 1.0;
+ nyim = unique_elements(ysyn,Nfoc);
+ nxim = unique_elements(xsyn,Nfoc);
+
+
+ /* define tapers to taper edges of acquisition */
+ if (tap == 1 || tap == 3) {
+ for (j = 0; j < ntap; j++)
+ tapersy[j] = (cos(PI*(j-ntap)/ntap)+1)/2.0;
+ for (j = ntap; j < nxs-ntap; j++)
+ tapersy[j] = 1.0;
+ for (j = nxs-ntap; j < nxs; j++)
+ tapersy[j] =(cos(PI*(j-(nxs-ntap))/ntap)+1)/2.0;
+ }
+ else {
+ for (j = 0; j < nxs; j++) tapersy[j] = 1.0;
+ }
+ if (tap == 1 || tap == 3) {
+ if (verbose) vmess("Taper for operator applied ntap=%li", ntap);
+ for (l = 0; l < Nfoc; l++) {
+ for (k = 0; k < nys; k++) {
+ for (i = 0; i < nxs; i++) {
+ for (j = 0; j < nts; j++) {
+ G_d[l*nys*nxs*nts+k*nxs*nts+i*nts+j] *= tapersy[i];
+ }
+ }
+ }
+ }
+ }
+
+ /* check consistency of header values */
+ if (xrcvsyn[0] != 0 || xrcvsyn[1] != 0 ) fxsb = xrcvsyn[0];
+ if (yrcvsyn[0] != 0 || yrcvsyn[nys*nxs-1] != 0 ) fysb = yrcvsyn[0];
+ if (nxs>1) {
+ fxse = fxsb + (float)(nxs-1)*dxs;
+ dxf = (xrcvsyn[nys*nxs-1] - xrcvsyn[0])/(float)(nxs-1);
+ }
+ else {
+ fxse = fxsb;
+ dxs = 1.0;
+ dx = 1.0;
+ d2 = 1.0;
+ dxf = 1.0;
+ }
+ if (nys>1) {
+ fyse = fysb + (float)(nys-1)*dys;
+ dyf = (yrcvsyn[nys*nxs-1] - yrcvsyn[0])/(float)(nys-1);
+ }
+ else {
+ fyse = fysb;
+ dys = 1.0;
+ d3 = 1.0;
+ dy = 1.0;
+ dyf = 1.0;
+ }
+ if (NINT(dxs*1e3) != NINT(fabs(dxf)*1e3)) {
+ vmess("dx in hdr.d2 (%.3f) and hdr.gx (%.3f) not equal",d2, dxf);
+ if (dxf != 0) dxs = fabs(dxf);
+ vmess("dx in operator => %f", dxs);
+ }
+ if (NINT(dys*1e3) != NINT(fabs(dyf)*1e3)) {
+ vmess("dy in hdr.d3 (%.3f) and hdr.gy (%.3f) not equal",d3, dyf);
+ if (dyf != 0) dys = fabs(dyf);
+ vmess("dy in operator => %f", dys);
+ }
+
+/*================ Reading shot records ================*/
+
+ mode=1;
+ readShotData3D(file_shot, xrcv, yrcv, xsrc, ysrc, zsrc, xnx, Refl, nw,
+ nw_low, nshots, nx, ny, ntfft, mode, scale, verbose);
+
+ tapersh = (float *)malloc(nx*sizeof(float));
+ if (tap == 2 || tap == 3) {
+ for (j = 0; j < ntap; j++)
+ tapersh[j] = (cos(PI*(j-ntap)/ntap)+1)/2.0;
+ for (j = ntap; j < nx-ntap; j++)
+ tapersh[j] = 1.0;
+ for (j = nx-ntap; j < nx; j++)
+ tapersh[j] =(cos(PI*(j-(nx-ntap))/ntap)+1)/2.0;
+ }
+ else {
+ for (j = 0; j < nx; j++) tapersh[j] = 1.0;
+ }
+ if (tap == 2 || tap == 3) {
+ if (verbose) vmess("Taper for shots applied ntap=%li", ntap);
+ for (l = 0; l < nshots; l++) {
+ for (j = 1; j < nw; j++) {
+ for (k = 0; k < ny; k++) {
+ for (i = 0; i < nx; i++) {
+ Refl[l*nx*ny*nw+j*nx*ny+k*nx+i].r *= tapersh[i];
+ Refl[l*nx*ny*nw+j*nx*ny+k*nx+i].i *= tapersh[i];
+ }
+ }
+ }
+ }
+ }
+ free(tapersh);
+
+ /* check consistency of header values */
+ nxshot = unique_elements(xsrc,nshots);
+ nyshot = nshots/nxshot;
+
+ fxf = xsrc[0];
+ if (nx > 1) dxf = (xrcv[ny*nx-1] - xrcv[0])/(float)(nx-1);
+ else dxf = d2;
+ if (NINT(dx*1e3) != NINT(fabs(dxf)*1e3)) {
+ vmess("dx in hdr.d2 (%.3f) and hdr.gx (%.3f) not equal",dx, dxf);
+ if (dxf != 0) dx = fabs(dxf);
+ else verr("gx hdrs not set");
+ vmess("dx used => %f", dx);
+ }
+ fyf = ysrc[0];
+ if (ny > 1) dyf = (yrcv[ny*nx-1] - yrcv[0])/(float)(ny-1);
+ else dyf = d3;
+ if (NINT(dy*1e3) != NINT(fabs(dyf)*1e3)) {
+ vmess("dy in hdr.d3 (%.3f) and hdr.gy (%.3f) not equal",dy, dyf);
+ if (dyf != 0) dy = fabs(dyf);
+ else verr("gy hdrs not set");
+ vmess("dy used => %f", dy);
+ }
+
+ dxsrc = (float)xsrc[1] - xsrc[0];
+ if (dxsrc == 0) {
+ vwarn("sx hdrs are not filled in!!");
+ dxsrc = dx;
+ }
+ dysrc = (float)ysrc[nxshot-1] - ysrc[0];
+ if (dysrc == 0) {
+ vwarn("sy hdrs are not filled in!!");
+ dysrc = dy;
+ }
+
+/*================ Check the size of the files ================*/
+
+ if (NINT(dxsrc/dx)*dx != NINT(dxsrc)) {
+ vwarn("x: source (%.2f) and receiver step (%.2f) don't match",dxsrc,dx);
+ if (reci == 2) vwarn("x: step used from operator (%.2f) ",dxs);
+ }
+ if (NINT(dysrc/dy)*dy != NINT(dysrc)) {
+ vwarn("y: source (%.2f) and receiver step (%.2f) don't match",dysrc,dy);
+ if (reci == 2) vwarn("y: step used from operator (%.2f) ",dys);
+ }
+ dxi = NINT(dxf/dxs);
+ if ((NINT(dxi*dxs) != NINT(dxf)) && verbose)
+ vwarn("dx in receiver (%.2f) and operator (%.2f) don't match",dx,dxs);
+ dyi = NINT(dyf/dys);
+ if ((NINT(dyi*dys) != NINT(dyf)) && verbose)
+ vwarn("dy in receiver (%.2f) and operator (%.2f) don't match",dy,dys);
+ if (nt != nts)
+ vmess("Time samples in shot (%li) and focusing operator (%li) are not equal",nt, nts);
+ if (verbose) {
+ vmess("Number of focusing operators = %li", Nfoc);
+ vmess("Number of receivers in focusop = x:%li y:%li total:%li", nxs, nys, nxs*nys);
+ vmess("number of shots = %li", nshots);
+ vmess("number of receiver/shot = x:%li y:%li total:%li", nx, ny, nx*ny);
+ vmess("first model position = x:%.2f y:%.2f", fxsb, fysb);
+ vmess("last model position = x:%.2f y:%.2f", fxse, fyse);
+ vmess("first source position = x:%.2f y:%.2f", fxf, fyf);
+ vmess("source distance = x:%.2f y:%.2f", dxsrc, dysrc);
+ vmess("last source position = x:%.2f y:%.2f", fxf+(nxshot-1)*dxsrc, fyf+(nyshot-1)*dysrc);
+ vmess("receiver distance = x:%.2f y:%.2f", dxf, dyf);
+ vmess("direction of increasing traces = x:%li y:%li", dxi, dyi);
+ vmess("number of time samples (nt,nts) = %li (%li,%li)", ntfft, nt, nts);
+ vmess("time sampling = %e ", dt);
+ if (file_green != NULL) vmess("Green output file = %s ", file_green);
+ if (file_gmin != NULL) vmess("Gmin output file = %s ", file_gmin);
+ if (file_gplus != NULL) vmess("Gplus output file = %s ", file_gplus);
+ if (file_pmin != NULL) vmess("Pmin output file = %s ", file_pmin);
+ if (file_f2 != NULL) vmess("f2 (=pplus) output file = %s ", file_f2);
+ if (file_f1min != NULL) vmess("f1min output file = %s ", file_f1min);
+ if (file_f1plus != NULL)vmess("f1plus output file = %s ", file_f1plus);
+ if (file_iter != NULL) vmess("Iterations output file = %s ", file_iter);
+ }
+
+/*================ initializations ================*/
+
+ if (reci) {
+ n2out = nxs;
+ n3out = nys;
+ }
+ else {
+ n2out = nxshot;
+ n3out = nyshot;
+ }
+ mem = Nfoc*n2out*n3out*ntfft*sizeof(float)/1048576.0;
+ if (verbose) {
+ vmess("number of output traces = x:%li y:%li total:%li", n2out, n3out, n2out*n3out);
+ vmess("number of output samples = %li", ntfft);
+ vmess("Size of output data/file = %.1f MB", mem);
+ }
+
+
+ /* dry-run of synthesis to get all x-positions calcalated by the integration */
+ synthesisPositions3D(nx, ny, nxs, nys, Nfoc, xrcv, yrcv, xsrc, ysrc, xnx,
+ fxse, fyse, fxsb, fysb, dxs, dys, nshots, nxshot, nyshot, ixpos, &npos, reci, verbose);
+ if (verbose) {
+ vmess("synthesisPosistions: nxshot=%li nyshot=%li nshots=%li npos=%li", nxshot, nyshot, nshots, npos);
+ }
+
+/*================ set variables for output data ================*/
+
+ n1 = nts; n2 = n2out; n3 = n3out;
+ f1 = ft; f2 = xrcvsyn[ixpos[0]]; f3 = yrcvsyn[ixpos[0]];
+ d1 = dt;
+ if (reci == 0) { // distance between sources in R
+ d2 = dxsrc;
+ d3 = dysrc;
+ }
+ else if (reci == 1) { // distance between traces in G_d
+ d2 = dxs;
+ d3 = dys;
+ }
+ else if (reci == 2) { // distance between receivers in R
+ d2 = dx;
+ d3 = dy;
+ }
+
+ hdrs_out = (segy *) calloc(n2*n3,sizeof(segy));
+ if (hdrs_out == NULL) verr("allocation for hdrs_out");
+ size = nys*nxs*nts;
+
+ for (k = 0; k < n3; k++) {
+ for (i = 0; i < n2; i++) {
+ hdrs_out[k*n2+i].ns = n1;
+ hdrs_out[k*n2+i].trid = 1;
+ hdrs_out[k*n2+i].dt = dt*1000000;
+ hdrs_out[k*n2+i].f1 = f1;
+ hdrs_out[k*n2+i].f2 = f2;
+ hdrs_out[k*n2+i].d1 = d1;
+ hdrs_out[k*n2+i].d2 = d2;
+ hdrs_out[k*n2+i].trwf = n2out*n3out;
+ hdrs_out[k*n2+i].scalco = -1000;
+ hdrs_out[k*n2+i].gx = NINT(1000*(f2+i*d2));
+ hdrs_out[k*n2+i].gy = NINT(1000*(f3+k*d3));
+ hdrs_out[k*n2+i].scalel = -1000;
+ hdrs_out[k*n2+i].tracl = k*n2+i+1;
+ }
+ }
+ t1 = wallclock_time();
+ tread = t1-t0;
+
+/*================ initialization ================*/
+
+ memcpy(Ni, G_d, Nfoc*nys*nxs*ntfft*sizeof(float));
+ for (l = 0; l < Nfoc; l++) {
+ for (i = 0; i < npos; i++) {
+ j = 0;
+ ix = ixpos[i]; /* select the traces that have an output trace after integration */
+ f2p[l*nys*nxs*nts+i*nts+j] = G_d[l*nys*nxs*nts+ix*nts+j];
+ f1plus[l*nys*nxs*nts+i*nts+j] = G_d[l*nys*nxs*nts+ix*nts+j];
+ for (j = 1; j < nts; j++) {
+ f2p[l*nys*nxs*nts+i*nts+j] = G_d[l*nys*nxs*nts+ix*nts+j];
+ f1plus[l*nys*nxs*nts+i*nts+j] = G_d[l*nys*nxs*nts+ix*nts+j];
+ }
+ }
+ }
+
+/*================ start Marchenko iterations ================*/
+
+ for (iter=0; iter<niter; iter++) {
+
+ t2 = wallclock_time();
+
+/*================ construction of Ni(-t) = - \int R(x,t) Ni(t) ================*/
+
+ synthesis3D(Refl, Fop, Ni, iRN, nx, ny, nt, nxs, nys, nts, dt, xsyn, ysyn,
+ Nfoc, xrcv, yrcv, xsrc, ysrc, xnx, fxse, fxsb, fyse, fysb, dxs, dys,
+ dxsrc, dysrc, dx, dy, ntfft, nw, nw_low, nw_high, mode, reci, nshots,
+ nxshot, nyshot, ixpos, npos, &tfft, isxcount, reci_xsrc, reci_xrcv,
+ ixmask, verbose);
+
+ t3 = wallclock_time();
+ tsyn += t3 - t2;
+
+ // if (file_iter != NULL) {
+ // writeDataIter(file_iter, iRN, hdrs_out, ntfft, nxs*nys, d2, f2, n2out*n3out, Nfoc, xsyn, zsyn, ixpos, npos, iter);
+ // }
+ /* N_k(x,t) = -N_(k-1)(x,-t) */
+ /* p0^-(x,t) += iRN = (R * T_d^inv)(t) */
+ for (l = 0; l < Nfoc; l++) {
+ energyNi = 0.0;
+ for (i = 0; i < npos; i++) {
+ j = 0;
+ ix = ixpos[i];
+ Ni[l*nys*nxs*nts+i*nts+j] = -iRN[l*nys*nxs*nts+ix*nts+j];
+ pmin[l*nys*nxs*nts+i*nts+j] += iRN[l*nys*nxs*nts+ix*nts+j];
+ energyNi += iRN[l*nys*nxs*nts+ix*nts+j]*iRN[l*nys*nxs*nts+ix*nts+j];
+ for (j = 1; j < nts; j++) {
+ Ni[l*nys*nxs*nts+i*nts+j] = -iRN[l*nys*nxs*nts+ix*nts+nts-j];
+ pmin[l*nys*nxs*nts+i*nts+j] += iRN[l*nys*nxs*nts+ix*nts+j];
+ energyNi += iRN[l*nys*nxs*nts+ix*nts+j]*iRN[l*nys*nxs*nts+ix*nts+j];
+ }
+ }
+ if (iter==0) energyN0 = energyNi;
+ if (verbose >=2) vmess(" - iSyn %li: Ni at iteration %li has energy %e; relative to N0 %e",
+ l, iter, sqrt(energyNi), sqrt(energyNi/energyN0));
+ }
+
+ /* apply mute window based on times of direct arrival (in muteW) */
+ applyMute3D(Ni, muteW, smooth, above, Nfoc, nxs*nys, nts, ixpos, npos, shift);
+
+ /* update f2 */
+ for (l = 0; l < Nfoc; l++) {
+ for (i = 0; i < npos; i++) {
+ j = 0;
+ f2p[l*nys*nxs*nts+i*nts+j] += Ni[l*nys*nxs*nts+i*nts+j];
+ for (j = 1; j < nts; j++) {
+ f2p[l*nys*nxs*nts+i*nts+j] += Ni[l*nys*nxs*nts+i*nts+j];
+ }
+ }
+ }
+
+ if (iter % 2 == 0) { /* even iterations update: => f_1^-(t) */
+ for (l = 0; l < Nfoc; l++) {
+ for (i = 0; i < npos; i++) {
+ j = 0;
+ f1min[l*nys*nxs*nts+i*nts+j] -= Ni[l*nys*nxs*nts+i*nts+j];
+ for (j = 1; j < nts; j++) {
+ f1min[l*nys*nxs*nts+i*nts+j] -= Ni[l*nys*nxs*nts+i*nts+nts-j];
+ }
+ }
+ }
+ }
+ else {/* odd iterations update: => f_1^+(t) */
+ for (l = 0; l < Nfoc; l++) {
+ for (i = 0; i < npos; i++) {
+ j = 0;
+ f1plus[l*nys*nxs*nts+i*nts+j] += Ni[l*nys*nxs*nts+i*nts+j];
+ for (j = 1; j < nts; j++) {
+ f1plus[l*nys*nxs*nts+i*nts+j] += Ni[l*nys*nxs*nts+i*nts+j];
+ }
+ }
+ }
+ }
+
+ t2 = wallclock_time();
+ tcopy += t2 - t3;
+
+ if (verbose) vmess("*** Iteration %li finished ***", iter);
+
+ } /* end of iterations */
+
+ free(Ni);
+ if (ampest < 1) free(G_d);
+
+ /* compute full Green's function G = int R * f2(t) + f2(-t) = Pplus + Pmin */
+ for (l = 0; l < Nfoc; l++) {
+ for (i = 0; i < npos; i++) {
+ j = 0;
+ /* set green to zero if mute-window exceeds nt/2 */
+ if (muteW[l*nys*nxs+ixpos[i]] >= nts/2) {
+ memset(&green[l*nys*nxs*nts+i*nts],0, sizeof(float)*nt);
+ continue;
+ }
+ green[l*nys*nxs*nts+i*nts+j] = f2p[l*nys*nxs*nts+i*nts+j] + pmin[l*nys*nxs*nts+i*nts+j];
+ for (j = 1; j < nts; j++) {
+ green[l*nys*nxs*nts+i*nts+j] = f2p[l*nys*nxs*nts+i*nts+nts-j] + pmin[l*nys*nxs*nts+i*nts+j];
+ }
+ }
+ }
+ applyMute3D(green, muteW, smooth, 4, Nfoc, nxs*nys, nts, ixpos, npos, shift);
+
+ /* compute upgoing Green's function G^+,- */
+ if (file_gmin != NULL || file_imag!= NULL) {
+ Gmin = (float *)calloc(Nfoc*nys*nxs*ntfft,sizeof(float));
+
+ /* use f1+ as operator on R in frequency domain */
+ mode=1;
+ synthesis3D(Refl, Fop, f1plus, iRN, nx, ny, nt, nxs, nys, nts, dt, xsyn, ysyn,
+ Nfoc, xrcv, yrcv, xsrc, ysrc, xnx, fxse, fxsb, fyse, fysb, dxs, dys,
+ dxsrc, dysrc, dx, dy, ntfft, nw, nw_low, nw_high, mode, reci, nshots,
+ nxshot, nyshot, ixpos, npos, &tfft, isxcount, reci_xsrc, reci_xrcv,
+ ixmask, verbose);
+
+ /* compute upgoing Green's G^-,+ */
+ for (l = 0; l < Nfoc; l++) {
+ for (i = 0; i < npos; i++) {
+ j=0;
+ ix = ixpos[i];
+ Gmin[l*nys*nxs*nts+i*nts+j] = iRN[l*nys*nxs*nts+ix*nts+j] - f1min[l*nys*nxs*nts+i*nts+j];
+ for (j = 1; j < nts; j++) {
+ Gmin[l*nys*nxs*nts+i*nts+j] = iRN[l*nys*nxs*nts+ix*nts+j] - f1min[l*nys*nxs*nts+i*nts+j];
+ }
+ }
+ }
+ /* Apply mute with window for Gmin */
+ applyMute3D(Gmin, muteW, smooth, 4, Nfoc, nxs*nys, nts, ixpos, npos, shift);
+ } /* end if Gmin */
+
+ /* compute downgoing Green's function G^+,+ */
+ if (file_gplus != NULL || ampest > 0) {
+ Gplus = (float *)calloc(Nfoc*nys*nxs*ntfft,sizeof(float));
+
+ /* use f1-(*) as operator on R in frequency domain */
+ mode=-1;
+ synthesis3D(Refl, Fop, f1min, iRN, nx, ny, nt, nxs, nys, nts, dt, xsyn, ysyn,
+ Nfoc, xrcv, yrcv, xsrc, ysrc, xnx, fxse, fxsb, fyse, fysb, dxs, dys,
+ dxsrc, dysrc, dx, dy, ntfft, nw, nw_low, nw_high, mode, reci, nshots,
+ nxshot, nyshot, ixpos, npos, &tfft, isxcount, reci_xsrc, reci_xrcv,
+ ixmask, verbose);
+
+ /* compute downgoing Green's G^+,+ */
+ for (l = 0; l < Nfoc; l++) {
+ for (i = 0; i < npos; i++) {
+ j=0;
+ ix = ixpos[i];
+ Gplus[l*nys*nxs*nts+i*nts+j] = -iRN[l*nys*nxs*nts+ix*nts+j] + f1plus[l*nys*nxs*nts+i*nts+j];
+ for (j = 1; j < nts; j++) {
+ Gplus[l*nys*nxs*nts+i*nts+j] = -iRN[l*nys*nxs*nts+ix*nts+j] + f1plus[l*nys*nxs*nts+i*nts+nts-j];
+ }
+ }
+ }
+ /* Apply mute with window for Gplus */
+ applyMute3D(Gplus, muteW, smooth, 4, Nfoc, nxs*nys, nts, ixpos, npos, shift);
+ } /* end if Gplus */
+
+ /* Estimate the amplitude of the Marchenko Redatuming */
+ if (ampest>0) {
+ if (verbose>0) vmess("Estimating amplitude scaling");
+ // Create the first arrival data
+ 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
+ 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];
+ }
+ 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);
+ // }
+ free(Gd);
+ if (file_gplus == NULL) free(Gplus);
+ }
+
+ /* Apply imaging*/
+ if (file_imag!=NULL) {
+ // Determine Image
+ Image = (float *)calloc(Nfoc,sizeof(float));
+ imaging3D(Image, Gmin, f1plus, nxs, nys, ntfft, dxs, dys, dt, Nfoc, verbose);
+ if (file_gmin==NULL) free(Gmin);
+ // Set headers
+ 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 out image
+ fp_imag = fopen(file_imag, "w+");
+ if (fp_imag==NULL) verr("error on creating output file %s", file_imag);
+ ret = writeData3D(fp_imag, (float *)&Image[0], hdrs_Nfoc, nzim, nxim*nyim);
+ if (ret < 0 ) verr("error on writing output file.");
+ fclose(fp_imag);
+ free(hdrs_Nfoc);
+ free(Image);
+ }
+
+ t2 = wallclock_time();
+ if (verbose) {
+ vmess("Total CPU-time marchenko = %.3f", t2-t0);
+ vmess("with CPU-time synthesis = %.3f", tsyn);
+ vmess("with CPU-time copy array = %.3f", tcopy);
+ vmess(" CPU-time fft data = %.3f", tfft);
+ vmess("and CPU-time read data = %.3f", tread);
+ }
+
+/*================ write output files ================*/
+
+
+ fp_out = fopen(file_green, "w+");
+ if (fp_out==NULL) verr("error on creating output file %s", file_green);
+ if (file_gmin != NULL) {
+ fp_gmin = fopen(file_gmin, "w+");
+ if (fp_gmin==NULL) verr("error on creating output file %s", file_gmin);
+ }
+ if (file_gplus != NULL) {
+ fp_gplus = fopen(file_gplus, "w+");
+ if (fp_gplus==NULL) verr("error on creating output file %s", file_gplus);
+ }
+ if (file_f2 != NULL) {
+ fp_f2 = fopen(file_f2, "w+");
+ if (fp_f2==NULL) verr("error on creating output file %s", file_f2);
+ }
+ if (file_pmin != NULL) {
+ fp_pmin = fopen(file_pmin, "w+");
+ if (fp_pmin==NULL) verr("error on creating output file %s", file_pmin);
+ }
+ if (file_f1plus != NULL) {
+ fp_f1plus = fopen(file_f1plus, "w+");
+ if (fp_f1plus==NULL) verr("error on creating output file %s", file_f1plus);
+ }
+ if (file_f1min != NULL) {
+ fp_f1min = fopen(file_f1min, "w+");
+ if (fp_f1min==NULL) verr("error on creating output file %s", file_f1min);
+ }
+
+
+ tracf = 1;
+ for (l = 0; l < Nfoc; l++) {
+ if (reci) {
+ f2 = fxsb;
+ f3 = fysb;
+ }
+ else {
+ f2 = fxf;
+ f3 = fyf;
+ }
+
+ for (k = 0; k < n3; k++) {
+ for (i = 0; i < n2; i++) {
+ hdrs_out[k*n2+i].fldr = l+1;
+ hdrs_out[k*n2+i].sx = NINT(xsyn[l]*1000);
+ hdrs_out[k*n2+i].sy = NINT(ysyn[l]*1000);
+ hdrs_out[k*n2+i].offset = (long)NINT((f2+i*d2) - xsyn[l]);
+ hdrs_out[k*n2+i].tracf = tracf++;
+ hdrs_out[k*n2+i].selev = NINT(zsyn[l]*1000);
+ hdrs_out[k*n2+i].sdepth = NINT(-zsyn[l]*1000);
+ hdrs_out[k*n2+i].f1 = f1;
+ }
+ }
+
+ ret = writeData3D(fp_out, (float *)&green[l*size], hdrs_out, n1, n2*n3);
+ if (ret < 0 ) verr("error on writing output file.");
+
+ if (file_gmin != NULL) {
+ ret = writeData3D(fp_gmin, (float *)&Gmin[l*size], hdrs_out, n1, n2*n3);
+ if (ret < 0 ) verr("error on writing output file.");
+ }
+ if (file_gplus != NULL) {
+ ret = writeData3D(fp_gplus, (float *)&Gplus[l*size], hdrs_out, n1, n2*n3);
+ if (ret < 0 ) verr("error on writing output file.");
+ }
+ if (file_f2 != NULL) {
+ ret = writeData3D(fp_f2, (float *)&f2p[l*size], hdrs_out, n1, n2*n3);
+ if (ret < 0 ) verr("error on writing output file.");
+ }
+ if (file_pmin != NULL) {
+ ret = writeData3D(fp_pmin, (float *)&pmin[l*size], hdrs_out, n1, n2*n3);
+ if (ret < 0 ) verr("error on writing output file.");
+ }
+ if (file_f1plus != NULL) {
+ /* rotate to get t=0 in the middle */
+ for (i = 0; i < n2*n3; i++) {
+ hdrs_out[i].f1 = -n1*0.5*dt;
+ memcpy(&trace[0],&f1plus[l*size+i*nts],nts*sizeof(float));
+ for (j = 0; j < n1/2; j++) {
+ f1plus[l*size+i*nts+n1/2+j] = trace[j];
+ }
+ for (j = n1/2; j < n1; j++) {
+ f1plus[l*size+i*nts+j-n1/2] = trace[j];
+ }
+ }
+ ret = writeData3D(fp_f1plus, (float *)&f1plus[l*size], hdrs_out, n1, n2*n3);
+ if (ret < 0 ) verr("error on writing output file.");
+ }
+ if (file_f1min != NULL) {
+ /* rotate to get t=0 in the middle */
+ for (i = 0; i < n2*n3; i++) {
+ hdrs_out[i].f1 = -n1*0.5*dt;
+ memcpy(&trace[0],&f1min[l*size+i*nts],nts*sizeof(float));
+ for (j = 0; j < n1/2; j++) {
+ f1min[l*size+i*nts+n1/2+j] = trace[j];
+ }
+ for (j = n1/2; j < n1; j++) {
+ f1min[l*size+i*nts+j-n1/2] = trace[j];
+ }
+ }
+ ret = writeData3D(fp_f1min, (float *)&f1min[l*size], hdrs_out, n1, n2*n3);
+ if (ret < 0 ) verr("error on writing output file.");
+ }
+ }
+ ret = fclose(fp_out);
+ if (file_gplus != NULL) {ret += fclose(fp_gplus);}
+ if (file_gmin != NULL) {ret += fclose(fp_gmin);}
+ if (file_f2 != NULL) {ret += fclose(fp_f2);}
+ if (file_pmin != NULL) {ret += fclose(fp_pmin);}
+ if (file_f1plus != NULL) {ret += fclose(fp_f1plus);}
+ if (file_f1min != NULL) {ret += fclose(fp_f1min);}
+ if (ret < 0) verr("err %li on closing output file",ret);
+
+ if (verbose) {
+ t1 = wallclock_time();
+ vmess("and CPU-time write data = %.3f", t1-t2);
+ }
+
+/*================ free memory ================*/
+
+ free(hdrs_out);
+ free(tapersy);
+
+ exit(0);
+}
+
+long unique_elements(float *arr, long len)
+{
+ if (len <= 0) return 0;
+ long unique = 1;
+ long outer, inner, is_unique;
+
+ for (outer = 1; outer < len; ++outer)
+ {
+ is_unique = 1;
+ for (inner = 0; is_unique && inner < outer; ++inner)
+ {
+ if ((arr[inner] >= arr[outer]-1.0) && (arr[inner] <= arr[outer]+1.0)) is_unique = 0;
+ }
+ if (is_unique) ++unique;
+ }
+ return unique;
+}
\ No newline at end of file
diff --git a/marchenko3D/name_ext.c b/marchenko3D/name_ext.c
new file mode 120000
index 0000000000000000000000000000000000000000..83ac1f8ddf2ec6a316557877ae7db38720a5ca53
--- /dev/null
+++ b/marchenko3D/name_ext.c
@@ -0,0 +1 @@
+../utils/name_ext.c
\ No newline at end of file
diff --git a/marchenko3D/par.h b/marchenko3D/par.h
new file mode 120000
index 0000000000000000000000000000000000000000..0fa273cea748f9ead16e0e231201941174a3dd46
--- /dev/null
+++ b/marchenko3D/par.h
@@ -0,0 +1 @@
+../utils/par.h
\ No newline at end of file
diff --git a/marchenko3D/readData.c b/marchenko3D/readData.c
new file mode 120000
index 0000000000000000000000000000000000000000..af43798573495d45a669aacf2dfe5d1094834bf8
--- /dev/null
+++ b/marchenko3D/readData.c
@@ -0,0 +1 @@
+../utils/readData.c
\ No newline at end of file
diff --git a/marchenko3D/readData3D.c b/marchenko3D/readData3D.c
new file mode 100644
index 0000000000000000000000000000000000000000..8cef449aa345e68cc85413f822885e530d4a5f04
--- /dev/null
+++ b/marchenko3D/readData3D.c
@@ -0,0 +1,54 @@
+#include <assert.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "segy.h"
+
+/**
+* reads SU file and returns header and 2D array
+*
+* AUTHOR:
+* Jan Thorbecke (janth@xs4all.nl)
+* The Netherlands
+**/
+
+
+int readData3D(FILE *fp, float *data, segy *hdrs, long n1)
+{
+ size_t nread;
+ long oneshot, itrace, sx, sy, fldr, gy, nx, ny;
+ segy hdr;
+
+ oneshot = 1;
+ itrace = 0;
+ ny = 1;
+
+ nread = fread(&hdrs[0], 1, TRCBYTES, fp);
+ if (nread == 0) return 0; /* end of file reached */
+
+ if (n1==0) n1 = hdrs[0].ns;
+ sx = hdrs[0].sx;
+ sy = hdrs[0].sy;
+ fldr = hdrs[0].fldr;
+ gy = hdrs[0].gy;
+ while (oneshot) {
+ nread = fread(&data[itrace*n1], sizeof(float), n1, fp);
+ assert (nread == n1);
+ itrace++;
+ nread = fread(&hdr, 1, TRCBYTES, fp);
+ if (nread == 0) break;
+ assert(nread == TRCBYTES);
+ if ( (sx != hdr.sx) || (sy != hdr.sy) || (fldr != hdr.fldr)) { /* end of shot record */
+ fseek( fp, -TRCBYTES, SEEK_CUR );
+ break;
+ }
+ if ( (gy != hdr.gy)) {
+ ny++;
+ gy = hdr.gy;
+ }
+ memcpy(&hdrs[itrace], &hdr, TRCBYTES);
+ }
+ nx = itrace/ny;
+
+ return nx, ny;
+}
diff --git a/marchenko3D/readShotData.c b/marchenko3D/readShotData.c
new file mode 100644
index 0000000000000000000000000000000000000000..a619799113de01c77af1a667cb060e3de055731b
--- /dev/null
+++ b/marchenko3D/readShotData.c
@@ -0,0 +1,207 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <math.h>
+#include "segy.h"
+#include <assert.h>
+
+typedef struct { /* complex number */
+ float r,i;
+} complex;
+
+#define NINT(x) ((int)((x)>0.0?(x)+0.5:(x)-0.5))
+#define MAX(x,y) ((x) > (y) ? (x) : (y))
+
+int optncr(int n);
+void cc1fft(complex *data, int n, int sign);
+void rc1fft(float *rdata, complex *cdata, int n, int sign);
+
+int readShotData(char *filename, float *xrcv, float *xsrc, float *zsrc, int *xnx, complex *cdata, int nw, int nw_low, int nshots,
+int nx, int nxs, float fxsb, float dxs, int ntfft, int mode, float scale, float tsq, float Q, float f0, int reci, int *nshots_r, int *isxcount, int *reci_xsrc, int *reci_xrcv, float *ixmask, int verbose)
+{
+ FILE *fp;
+ segy hdr;
+ size_t nread;
+ int fldr_shot, sx_shot, itrace, one_shot, igath, iw;
+ int end_of_file, nt;
+ int *isx, *igx, k, l, m, j, nreci;
+ int samercv, samesrc, nxrk, nxrm, maxtraces, ixsrc;
+ float scl, scel, *trace, dt;
+ complex *ctrace;
+
+ /* Reading first header */
+
+ if (filename == NULL) fp = stdin;
+ else fp = fopen( filename, "r" );
+ if ( fp == NULL ) {
+ fprintf(stderr,"input file %s has an error\n", filename);
+ perror("error in opening file: ");
+ fflush(stderr);
+ return -1;
+ }
+
+ fseek(fp, 0, SEEK_SET);
+ 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) scel = 1.0/fabs(hdr.scalel);
+ else if (hdr.scalel == 0) scel = 1.0;
+ else scel = hdr.scalel;
+
+ fseek(fp, 0, SEEK_SET);
+
+ nt = hdr.ns;
+ dt = hdr.dt/(1E6);
+
+ trace = (float *)calloc(ntfft,sizeof(float));
+ ctrace = (complex *)malloc(ntfft*sizeof(complex));
+ isx = (int *)malloc((nx*nshots)*sizeof(int));
+ igx = (int *)malloc((nx*nshots)*sizeof(int));
+
+ end_of_file = 0;
+ one_shot = 1;
+ igath = 0;
+
+ /* Read shots in file */
+
+ while (!end_of_file) {
+
+ /* start reading data (shot records) */
+ itrace = 0;
+ nread = fread( &hdr, 1, TRCBYTES, fp );
+ if (nread != TRCBYTES) { /* no more data in file */
+ break;
+ }
+
+/* ToDo Don't store the traces that are not in the aperture */
+/*
+ if ( (NINT(sx_shot*scl-fxse) > 0) || (NINT(-fxsb) > 0) ) {
+ vwarn("source positions are outside synthesis aperture");
+ vmess("xsrc = %.2f", xsrc[k], xrcv[k*nx+0], xrcv[k*nx+nx-1]);
+ }
+*/
+
+ sx_shot = hdr.sx;
+ fldr_shot = hdr.fldr;
+ isx[igath] = sx_shot;
+ xsrc[igath] = sx_shot*scl;
+ zsrc[igath] = hdr.selev*scel;
+ xnx[igath]=0;
+ while (one_shot) {
+ igx[igath*nx+itrace] = hdr.gx;
+ xrcv[igath*nx+itrace] = hdr.gx*scl;
+
+ nread = fread( trace, sizeof(float), nt, fp );
+ assert (nread == hdr.ns);
+
+ /* True Amplitude Recovery */
+ if (tsq != 0.0) {
+ for (iw=0; iw<nt; iw++) {
+ trace[iw] *= powf(dt*iw,tsq);
+ }
+ }
+
+ /* Q-correction */
+ if (Q != 0.0 && f0 != 0.0) {
+ for (iw=0; iw<nt; iw++) {
+ trace[iw] *= expf(((dt*iw)*M_PI*f0)/Q);
+ }
+ }
+
+ /* transform to frequency domain */
+ if (ntfft > hdr.ns)
+ memset( &trace[nt-1], 0, sizeof(float)*(ntfft-nt) );
+
+ rc1fft(trace,ctrace,ntfft,-1);
+ for (iw=0; iw<nw; iw++) {
+ cdata[igath*nx*nw+iw*nx+itrace].r = scale*ctrace[nw_low+iw].r;
+ cdata[igath*nx*nw+iw*nx+itrace].i = scale*mode*ctrace[nw_low+iw].i;
+ }
+ itrace++;
+ xnx[igath]+=1;
+
+ /* read next hdr of next trace */
+ nread = fread( &hdr, 1, TRCBYTES, fp );
+ if (nread != TRCBYTES) {
+ one_shot = 0;
+ end_of_file = 1;
+ break;
+ }
+ if ((sx_shot != hdr.sx) || (fldr_shot != hdr.fldr) ) break;
+ }
+ if (verbose>2) {
+ vmess("finished reading shot %d (%d) with %d traces",sx_shot,igath,itrace);
+ }
+
+ if (itrace != 0) { /* end of shot record */
+ fseek( fp, -TRCBYTES, SEEK_CUR );
+ igath++;
+ }
+ else {
+ end_of_file = 1;
+ }
+ }
+
+ free(ctrace);
+ free(trace);
+
+/* if reci=1 or reci=2 source-receive reciprocity is used and traces are added */
+
+ if (reci != 0) {
+ for (k=0; k<nxs; k++) ixmask[k] = 1.0;
+ for (k=0; k<nshots; k++) {
+ ixsrc = NINT((xsrc[k] - fxsb)/dxs);
+ nxrk = xnx[k];
+ for (l=0; l<nxrk; l++) {
+ samercv = 0;
+ samesrc = 0;
+ for (m=0; m<nshots; m++) {
+ if (igx[k*nx+l] == isx[m] && reci == 1) { // receiver position already present as source position m
+ nxrm = xnx[m];
+ for (j=0; j<nxrm; j++) { // check if receiver l with source k is also present in shot m
+ if (isx[k] == igx[m*nx+j]) { // shot k with receiver l already known as receiver j in shot m: same data
+ samercv = 1;
+ break;
+ }
+ }
+ if (samercv == 0) { // source k of receiver l -> accept trace as new receiver position for source l
+ ixsrc = NINT((xrcv[k*nx+l] - fxsb)/dxs);
+ if ((ixsrc >= 0) && (ixsrc < nxs)) {
+ reci_xrcv[ixsrc*nxs+isxcount[ixsrc]] = k;
+ reci_xsrc[ixsrc*nxs+isxcount[ixsrc]] = l;
+ isxcount[ixsrc] += 1;
+ if (reci==1) ixmask[ixsrc] = 0.5; // traces are added to already existing traces and must be scaled
+ }
+ }
+ samesrc = 1;
+ break;
+ }
+ }
+ if (samesrc == 0) { // receiver l with source k -> accept trace as new source position l with receiver k
+ //fprintf(stderr,"not a samesrc for receiver l=%d for source k=%d\n", l,k);
+ ixsrc = NINT((xrcv[k*nx+l] - fxsb)/dxs);
+ if ((ixsrc >= 0) && (ixsrc < nxs)) { // is this correct or should k and l be reversed: rcv=l src=k
+ reci_xrcv[ixsrc*nxs+isxcount[ixsrc]] = k;
+ reci_xsrc[ixsrc*nxs+isxcount[ixsrc]] = l;
+ isxcount[ixsrc] += 1;
+ }
+ }
+ }
+ }
+ nreci = 0;
+ for (k=0; k<nxs; k++) { // count total number of shots added by reciprocity
+ if (isxcount[k] != 0) {
+ maxtraces = MAX(maxtraces,isxcount[k]);
+ nreci++;
+ if (verbose>1) vmess("reciprocal receiver at %f (%d) has %d sources contributing", k, k*dxs+fxsb, isxcount[k]);
+ }
+ }
+ *nshots_r = nreci;
+ }
+
+ return 0;
+}
+
+
diff --git a/marchenko3D/readShotData3D.c b/marchenko3D/readShotData3D.c
new file mode 100644
index 0000000000000000000000000000000000000000..c25327fd9a2b7be3e4683a19a6c5d7b61651a1d5
--- /dev/null
+++ b/marchenko3D/readShotData3D.c
@@ -0,0 +1,138 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <math.h>
+#include "segy.h"
+#include <assert.h>
+
+typedef struct { /* complex number */
+ float r,i;
+} complex;
+
+#define NINT(x) ((long)((x)>0.0?(x)+0.5:(x)-0.5))
+#define MAX(x,y) ((x) > (y) ? (x) : (y))
+
+int optncr(int n);
+void cc1fft(complex *data, int n, int sign);
+void rc1fft(float *rdata, complex *cdata, int n, int sign);
+
+long readShotData3D(char *filename, float *xrcv, float *yrcv, float *xsrc, float *ysrc, float *zsrc, long *xnx, complex *cdata, long nw, long nw_low, long nshots, long nx, long ny, long ntfft, long mode, float scale, long verbose)
+{
+ FILE *fp;
+ segy hdr;
+ size_t nread;
+ long fldr_shot, sx_shot, sy_shot, itrace, one_shot, igath, iw;
+ long end_of_file, nt, nxy;
+ long *isx, *igx, *isy, *igy, k, l, m, j;
+ long samercv, samesrc, nxrk, nxrm, maxtraces, ixsrc;
+ float scl, scel, *trace, dt;
+ complex *ctrace;
+
+ nxy = nx*ny;
+
+ /* Reading first header */
+
+ if (filename == NULL) fp = stdin;
+ else fp = fopen( filename, "r" );
+ if ( fp == NULL ) {
+ fprintf(stderr,"input file %s has an error\n", filename);
+ perror("error in opening file: ");
+ fflush(stderr);
+ return -1;
+ }
+
+ fseek(fp, 0, SEEK_SET);
+ 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) scel = 1.0/fabs(hdr.scalel);
+ else if (hdr.scalel == 0) scel = 1.0;
+ else scel = hdr.scalel;
+
+ fseek(fp, 0, SEEK_SET);
+
+ nt = hdr.ns;
+ dt = hdr.dt/(1E6);
+
+ trace = (float *)calloc(ntfft,sizeof(float));
+ ctrace = (complex *)malloc(ntfft*sizeof(complex));
+ isx = (long *)malloc((nxy*nshots)*sizeof(long));
+ igx = (long *)malloc((nxy*nshots)*sizeof(long));
+ isy = (long *)malloc((nxy*nshots)*sizeof(long));
+ igy = (long *)malloc((nxy*nshots)*sizeof(long));
+
+
+ end_of_file = 0;
+ one_shot = 1;
+ igath = 0;
+
+ /* Read shots in file */
+
+ while (!end_of_file) {
+
+ /* start reading data (shot records) */
+ itrace = 0;
+ nread = fread( &hdr, 1, TRCBYTES, fp );
+ if (nread != TRCBYTES) { /* no more data in file */
+ break;
+ }
+
+ sx_shot = hdr.sx;
+ sy_shot = hdr.sy;
+ fldr_shot = hdr.fldr;
+ isx[igath] = sx_shot;
+ isy[igath] = sy_shot;
+ xsrc[igath] = sx_shot*scl;
+ ysrc[igath] = sy_shot*scl;
+ zsrc[igath] = hdr.selev*scel;
+ xnx[igath]=0;
+ while (one_shot) {
+ igx[igath*nxy+itrace] = hdr.gx;
+ igy[igath*nxy+itrace] = hdr.gy;
+ xrcv[igath*nxy+itrace] = hdr.gx*scl;
+ yrcv[igath*nxy+itrace] = hdr.gy*scl;
+
+ nread = fread( trace, sizeof(float), nt, fp );
+ assert (nread == hdr.ns);
+
+ /* transform to frequency domain */
+ if (ntfft > hdr.ns)
+ memset( &trace[nt-1], 0, sizeof(float)*(ntfft-nt) );
+
+ rc1fft(trace,ctrace,(int)ntfft,-1);
+ for (iw=0; iw<nw; iw++) {
+ cdata[igath*nxy*nw+iw*nxy+itrace].r = scale*ctrace[nw_low+iw].r;
+ cdata[igath*nxy*nw+iw*nxy+itrace].i = scale*mode*ctrace[nw_low+iw].i;
+ }
+ itrace++;
+ xnx[igath]+=1;
+
+ /* read next hdr of next trace */
+ nread = fread( &hdr, 1, TRCBYTES, fp );
+ if (nread != TRCBYTES) {
+ one_shot = 0;
+ end_of_file = 1;
+ break;
+ }
+ if ((sx_shot != hdr.sx) || (sy_shot != hdr.sy) || (fldr_shot != hdr.fldr)) break;
+ }
+ if (verbose>2) {
+ vmess("finished reading shot x=%li y=%li (%li) with %li traces",sx_shot,sy_shot,igath,itrace);
+ }
+
+ if (itrace != 0) { /* end of shot record */
+ fseek( fp, -TRCBYTES, SEEK_CUR );
+ igath++;
+ }
+ else {
+ end_of_file = 1;
+ }
+ }
+
+ free(ctrace);
+ free(trace);
+
+ return 0;
+}
\ No newline at end of file
diff --git a/marchenko3D/readTinvData.c b/marchenko3D/readTinvData.c
new file mode 100644
index 0000000000000000000000000000000000000000..028d4c21b4ddef73fe08edc7fcec0f1400b6d518
--- /dev/null
+++ b/marchenko3D/readTinvData.c
@@ -0,0 +1,240 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <math.h>
+#include "segy.h"
+#include <assert.h>
+
+typedef struct { /* complex number */
+ float r,i;
+} complex;
+
+#ifndef MAX
+#define MAX(x,y) ((x) > (y) ? (x) : (y))
+#endif
+#ifndef MIN
+#define MIN(x,y) ((x) < (y) ? (x) : (y))
+#endif
+#define NINT(x) ((int)((x)>0.0?(x)+0.5:(x)-0.5))
+
+void findShotInMute(float *xrcvMute, float xrcvShot, int nxs, int *imute);
+
+int readTinvData(char *filename, float *xrcv, float *xsrc, float *zsrc, int *xnx, int Nfoc, int nx, int ntfft, int mode, int *maxval, float *tinv, int hw, int verbose)
+{
+ FILE *fp;
+ segy hdr;
+ size_t nread;
+ int fldr_shot, sx_shot, itrace, one_shot, ig, isyn, i, j;
+ int end_of_file, nt, gx0, gx1;
+ int nx1, jmax, imax, tstart, tend;
+ float xmax, tmax, lmax;
+ float scl, scel, *trace, dxrcv;
+ complex *ctrace;
+
+ /* Reading first header */
+
+ if (filename == NULL) fp = stdin;
+ else fp = fopen( filename, "r" );
+ if ( fp == NULL ) {
+ fprintf(stderr,"input file %s has an error\n", filename);
+ perror("error in opening file: ");
+ fflush(stderr);
+ return -1;
+ }
+
+ fseek(fp, 0, SEEK_SET);
+ 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) scel = 1.0/fabs(hdr.scalel);
+ else if (hdr.scalel == 0) scel = 1.0;
+ else scel = hdr.scalel;
+ fseek(fp, 0, SEEK_SET);
+
+ nt = hdr.ns;
+ trace = (float *)calloc(ntfft,sizeof(float));
+ ctrace = (complex *)malloc(ntfft*sizeof(complex));
+
+ end_of_file = 0;
+ one_shot = 1;
+ isyn = 0;
+
+ /* Read shots in file */
+
+ while (!end_of_file) {
+
+ /* start reading data (shot records) */
+ itrace = 0;
+ nread = fread( &hdr, 1, TRCBYTES, fp );
+ if (nread != TRCBYTES) { /* no more data in file */
+ break;
+ }
+
+ sx_shot = hdr.sx;
+ fldr_shot = hdr.fldr;
+ gx0 = hdr.gx;
+ xsrc[isyn] = sx_shot*scl;
+ zsrc[isyn] = hdr.selev*scel;
+ xnx[isyn] = 0;
+ ig = isyn*nx*ntfft;
+ while (one_shot) {
+ xrcv[isyn*nx+itrace] = hdr.gx*scl;
+ nread = fread( trace, sizeof(float), nt, fp );
+ assert (nread == hdr.ns);
+
+ /* copy trace to data array */
+ memcpy( &tinv[ig+itrace*ntfft], trace, nt*sizeof(float));
+
+ gx1 = hdr.gx;
+ itrace++;
+
+ /* read next hdr of next trace */
+ nread = fread( &hdr, 1, TRCBYTES, fp );
+ if (nread != TRCBYTES) {
+ one_shot = 0;
+ end_of_file = 1;
+ break;
+ }
+ if ((sx_shot != hdr.sx) || (fldr_shot != hdr.fldr) ) break;
+ }
+ if (verbose>2) {
+ fprintf(stderr,"finished reading shot %d (%d) with %d traces\n",sx_shot,isyn,itrace);
+ //disp_fileinfo(filename, nt, xnx[isyn], hdr.f1, xrcv[isyn*nxm], d1, d2, &hdr);
+ }
+
+ /* look for maximum in shot record to define mute window */
+ /* find consistent (one event) maximum related to maximum value */
+ nx1 = itrace;
+ xnx[isyn]=nx1;
+ /* find global maximum
+ xmax=0.0;
+ for (i = 0; i < nx1; i++) {
+ tmax=0.0;
+ jmax = 0;
+ for (j = 0; j < nt; j++) {
+ lmax = fabs(tinv[ig+i*ntfft+j]);
+ if (lmax > tmax) {
+ jmax = j;
+ tmax = lmax;
+ if (lmax > xmax) {
+ imax = i;
+ xmax=lmax;
+ }
+ }
+ }
+ maxval[isyn*nx+i] = jmax;
+ }
+ */
+
+ /* alternative find maximum at source position */
+ dxrcv = (gx1 - gx0)*scl/(float)(nx1-1);
+ imax = NINT(((sx_shot-gx0)*scl)/dxrcv);
+ tmax=0.0;
+ jmax = 0;
+ for (j = 0; j < nt; j++) {
+ lmax = fabs(tinv[ig+imax*ntfft+j]);
+ if (lmax > tmax) {
+ jmax = j;
+ tmax = lmax;
+ if (lmax > xmax) {
+ xmax=lmax;
+ }
+ }
+ }
+ maxval[isyn*nx+imax] = jmax;
+ if (verbose >= 3) vmess("Mute max at src-trace %d is sample %d", imax, maxval[imax]);
+
+ /* search forward in trace direction from maximum in file */
+ for (i = imax+1; i < nx1; i++) {
+ tstart = MAX(0, (maxval[isyn*nx+i-1]-hw));
+ tend = MIN(nt-1, (maxval[isyn*nx+i-1]+hw));
+ jmax=tstart;
+ tmax=0.0;
+ for(j = tstart; j <= tend; j++) {
+ lmax = fabs(tinv[ig+i*ntfft+j]);
+ if (lmax > tmax) {
+ jmax = j;
+ tmax = lmax;
+ }
+ }
+ maxval[isyn*nx+i] = jmax;
+ }
+ /* search backward in trace direction from maximum in file */
+ for (i = imax-1; i >=0; i--) {
+ tstart = MAX(0, (maxval[isyn*nx+i+1]-hw));
+ tend = MIN(nt-1, (maxval[isyn*nx+i+1]+hw));
+ jmax=tstart;
+ tmax=0.0;
+ for(j = tstart; j <= tend; j++) {
+ lmax = fabs(tinv[ig+i*ntfft+j]);
+ if (lmax > tmax) {
+ jmax = j;
+ tmax = lmax;
+ }
+ }
+ maxval[isyn*nx+i] = jmax;
+ }
+
+ if (itrace != 0) { /* end of shot record, but not end-of-file */
+ fseek( fp, -TRCBYTES, SEEK_CUR );
+ isyn++;
+ }
+ else {
+ end_of_file = 1;
+ }
+
+ /* copy trace to data array for mode=-1 */
+ /* time reverse trace */
+ if (mode==-1) {
+ for (i = 0; i < nx1; i++) {
+ memcpy( trace, &tinv[ig+i*ntfft], ntfft*sizeof(float));
+ j=0;
+ tinv[ig+i*ntfft+j] = trace[j];
+ for (j=1; j<ntfft; j++) tinv[ig+i*ntfft+ntfft-j] = trace[j];
+ }
+ }
+ }
+
+ free(ctrace);
+ free(trace);
+
+ return 0;
+}
+
+
+/* simple sort algorithm */
+void findShotInMute(float *xrcvMute, float xrcvShot, int nxs, int *imute)
+{
+ int i, sign;
+ float diff1, diff2;
+
+ *imute=0;
+
+ if (xrcvMute[0] < xrcvMute[1]) sign = 1;
+ else sign = -1;
+
+ if (sign == 1) {
+ i = 0;
+ while (xrcvMute[i] < xrcvShot && i < nxs) {
+ i++;
+ }
+ /* i is now position larger than xrcvShot */
+ }
+ else {
+ i = 0;
+ while (xrcvMute[i] > xrcvShot && i < nxs) {
+ i++;
+ }
+ /* i is now position smaller than xrcvShot */
+ }
+
+ diff1 = fabsf(xrcvMute[i]-xrcvShot);
+ diff2 = fabsf(xrcvMute[i-1]-xrcvShot);
+ if (diff1 < diff2) *imute = i;
+ else *imute = i-1;
+
+ return;
+}
+
diff --git a/marchenko3D/readTinvData3D.c b/marchenko3D/readTinvData3D.c
new file mode 100644
index 0000000000000000000000000000000000000000..203585d84f2a4584ad774d9dd499f6c22241d05d
--- /dev/null
+++ b/marchenko3D/readTinvData3D.c
@@ -0,0 +1,347 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <math.h>
+#include "segy.h"
+#include <assert.h>
+
+typedef struct { /* complex number */
+ float r,i;
+} complex;
+
+#ifndef MAX
+#define MAX(x,y) ((x) > (y) ? (x) : (y))
+#endif
+#ifndef MIN
+#define MIN(x,y) ((x) < (y) ? (x) : (y))
+#endif
+#define NINT(x) ((long)((x)>0.0?(x)+0.5:(x)-0.5))
+
+void findShotInMute(float *xrcvMute, float xrcvShot, long nxs, long *imute);
+
+long readTinvData3D(char *filename, float *xrcv, float *yrcv, float *xsrc, float *ysrc, float *zsrc, long *xnx, long Nfoc, long nx, long ny, long ntfft, long mode, long *maxval, float *tinv, long hw, long verbose)
+{
+ FILE *fp;
+ segy hdr;
+ size_t nread;
+ long fldr_shot, sx_shot, sy_shot, itrace, one_shot, ig, isyn, i, j, l;
+ long end_of_file, nt, gx0, gx1, gy0, gy1;
+ long nx1, ny1, jmax, imax, tstart, tend, nxy, ixmax, iymax;
+ float xmax, tmax, lmax;
+ float scl, scel, *trace, dxrcv, dyrcv;
+ complex *ctrace;
+
+ nxy = nx*ny;
+
+ /* Reading first header */
+
+ if (filename == NULL) fp = stdin;
+ else fp = fopen( filename, "r" );
+ if ( fp == NULL ) {
+ fprintf(stderr,"input file %s has an error\n", filename);
+ perror("error in opening file: ");
+ fflush(stderr);
+ return -1;
+ }
+
+ fseek(fp, 0, SEEK_SET);
+ 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) scel = 1.0/fabs(hdr.scalel);
+ else if (hdr.scalel == 0) scel = 1.0;
+ else scel = hdr.scalel;
+ fseek(fp, 0, SEEK_SET);
+
+ nt = hdr.ns;
+ trace = (float *)calloc(ntfft,sizeof(float));
+ ctrace = (complex *)malloc(ntfft*sizeof(complex));
+
+ end_of_file = 0;
+ one_shot = 1;
+ isyn = 0;
+
+ /* Read shots in file */
+
+ while (!end_of_file) {
+
+ /* start reading data (shot records) */
+ itrace = 0;
+ nread = fread( &hdr, 1, TRCBYTES, fp );
+ if (nread != TRCBYTES) { /* no more data in file */
+ break;
+ }
+
+ sx_shot = hdr.sx;
+ sy_shot = hdr.sy;
+ fldr_shot = hdr.fldr;
+ gx0 = hdr.gx;
+ gy0 = hdr.gy;
+ gy1 = gy0;
+ xsrc[isyn] = sx_shot*scl;
+ ysrc[isyn] = sy_shot*scl;
+ zsrc[isyn] = hdr.selev*scel;
+ xnx[isyn] = 0;
+ ig = isyn*nxy*ntfft;
+ ny1 = 1;
+ while (one_shot) {
+ xrcv[isyn*nxy+itrace] = hdr.gx*scl;
+ yrcv[isyn*nxy+itrace] = hdr.gy*scl;
+ nread = fread( trace, sizeof(float), nt, fp );
+ assert (nread == hdr.ns);
+
+ /* copy trace to data array */
+ memcpy( &tinv[ig+itrace*ntfft], trace, nt*sizeof(float));
+
+ itrace++;
+
+ /* read next hdr of next trace */
+ nread = fread( &hdr, 1, TRCBYTES, fp );
+ if (nread != TRCBYTES) {
+ one_shot = 0;
+ end_of_file = 1;
+ break;
+ }
+ if ((sx_shot != hdr.sx) || (sy_shot != hdr.sy) || (fldr_shot != hdr.fldr)) break;
+
+ gx1 = hdr.gx;
+ if (gy1 != hdr.gy) {
+ gy1 = hdr.gy;
+ ny1++;
+ }
+ }
+ if (verbose>2) {
+ fprintf(stderr,"finished reading shot x=%li y=%li (%li) with %li traces\n",sx_shot,sy_shot,isyn,itrace);
+ }
+
+ /* look for maximum in shot record to define mute window */
+ /* find consistent (one event) maximum related to maximum value */
+ nx1 = itrace/ny1;
+ xnx[isyn]=itrace;
+
+ /* alternative find maximum at source position */
+ if (nx1>1) dxrcv = (gx1 - gx0)*scl/(float)(nx1-1);
+ else dxrcv = (gx1 - gx0)*scl/(float)(1);
+ if (dxrcv==0.0) dxrcv=1.0;
+ ixmax = NINT(((sx_shot-gx0)*scl)/dxrcv);
+ if (ny1>1) dyrcv = (gy1 - gy0)*scl/(float)(ny1-1);
+ else dyrcv = (gy1 - gy0)*scl/(float)(1);
+ if (dyrcv==0.0) dyrcv=1.0;
+ iymax = NINT(((sy_shot-gy0)*scl)/dyrcv);
+ if (iymax > ny1-1) {
+ vmess("source of y (%li) is past array, snapping to nearest y (%li)",iymax,ny1-1);
+ iymax = ny1-1;
+ }
+ if (iymax < 0) {
+ vmess("source of y (%li) is before array, snapping to nearest y (%li)",iymax,0);
+ iymax = 0;
+ }
+ if (ixmax > nx1-1) {
+ vmess("source of x (%li) is past array, snapping to nearest x (%li)",ixmax,nx1-1);
+ ixmax = nx1-1;
+ }
+ if (ixmax < 0) {
+ vmess("source of x (%li) is before array, snapping to nearest x (%li)",ixmax,nx1-1);
+ ixmax = 0;
+ }
+ tmax=0.0;
+ jmax = 0;
+ for (j = 0; j < nt; j++) {
+ lmax = fabs(tinv[ig+iymax*nx*ntfft+ixmax*ntfft+j]);
+ if (lmax > tmax) {
+ jmax = j;
+ tmax = lmax;
+ if (lmax > xmax) {
+ xmax=lmax;
+ }
+ }
+ }
+ maxval[isyn*nxy+iymax*nx+ixmax] = jmax;
+ if (verbose >= 3) vmess("Mute max at src-trace x=%li y=%li is sample %li", ixmax, iymax, maxval[isyn*nxy+iymax*nx+ixmax]);
+
+ /* search forward in x-trace direction from maximum in file */
+ for (i = ixmax+1; i < nx1; i++) {
+ tstart = MAX(0, (maxval[isyn*nxy+iymax*nx+(i-1)]-hw));
+ tend = MIN(nt-1, (maxval[isyn*nxy+iymax*nx+(i-1)]+hw));
+ jmax=tstart;
+ tmax=0.0;
+ for(j = tstart; j <= tend; j++) {
+ lmax = fabs(tinv[ig+iymax*nx*ntfft+i*ntfft+j]);
+ if (lmax > tmax) {
+ jmax = j;
+ tmax = lmax;
+ }
+ }
+ maxval[isyn*nxy+iymax*nx+i] = jmax;
+ }
+ /* search backward in x-trace direction from maximum in file */
+ for (i = ixmax-1; i >=0; i--) {
+ tstart = MAX(0, (maxval[isyn*nxy+iymax*nx+i+1]-hw));
+ tend = MIN(nt-1, (maxval[isyn*nxy+iymax*nx+i+1]+hw));
+ jmax=tstart;
+ tmax=0.0;
+ for(j = tstart; j <= tend; j++) {
+ lmax = fabs(tinv[ig+iymax*nx*ntfft+i*ntfft+j]);
+ if (lmax > tmax) {
+ jmax = j;
+ tmax = lmax;
+ }
+ }
+ maxval[isyn*nxy+iymax*nx+i] = jmax;
+ }
+
+ /* search forward in y-trace direction from maximum in file */
+ for (i = iymax+1; i < ny1; i++) {
+ tmax=0.0;
+ jmax = 0;
+ for(j = 0; j <= nt; j++) {
+ lmax = fabs(tinv[ig+i*nx*ntfft+ixmax*ntfft+j]);
+ if (lmax > tmax) {
+ jmax = j;
+ tmax = lmax;
+ }
+ }
+ maxval[isyn*nxy+i*nx+ixmax] = jmax;
+ if (verbose >= 8) vmess("Mute max at src-trace x=%li y=%li is sample %li", ixmax, i, maxval[isyn*nxy+i*nx+ixmax]);
+ /* search forward in x-trace direction from maximum in file */
+ for (l = ixmax+1; l < nx1; l++) {
+ tstart = MAX(0, (maxval[isyn*nxy+i*nx+(l-1)]-hw));
+ tend = MIN(nt-1, (maxval[isyn*nxy+i*nx+(l-1)]+hw));
+ jmax=tstart;
+ tmax=0.0;
+ for(j = tstart; j <= tend; j++) {
+ lmax = fabs(tinv[ig+i*nx*ntfft+l*ntfft+j]);
+ if (lmax > tmax) {
+ jmax = j;
+ tmax = lmax;
+ }
+ }
+ maxval[isyn*nxy+i*nx+l] = jmax;
+ }
+ /* search backward in x-trace direction from maximum in file */
+ for (l = ixmax-1; l >=0; l--) {
+ tstart = MAX(0, (maxval[isyn*nxy+i*nx+l+1]-hw));
+ tend = MIN(nt-1, (maxval[isyn*nxy+i*nx+l+1]+hw));
+ jmax=tstart;
+ tmax=0.0;
+ for(j = tstart; j <= tend; j++) {
+ lmax = fabs(tinv[ig+i*nx*ntfft+l*ntfft+j]);
+ if (lmax > tmax) {
+ jmax = j;
+ tmax = lmax;
+ }
+ }
+ maxval[isyn*nxy+i*nx+l] = jmax;
+ }
+ }
+
+ /* search backward in y-trace direction from maximum in file */
+ for (i = iymax-1; i >= 0; i--) {
+ tmax=0.0;
+ jmax = 0;
+ for(j = 0; j <= nt; j++) {
+ lmax = fabs(tinv[ig+i*nx*ntfft+ixmax*ntfft+j]);
+ if (lmax > tmax) {
+ jmax = j;
+ tmax = lmax;
+ }
+ }
+ maxval[isyn*nxy+i*nx+ixmax] = jmax;
+ if (verbose >= 8) vmess("Mute max at src-trace x=%li y=%li is sample %li", ixmax, i, maxval[isyn*nxy+i*nx+ixmax]);
+ /* search forward in x-trace direction from maximum in file */
+ for (l = ixmax+1; l < nx1; l++) {
+ tstart = MAX(0, (maxval[isyn*nxy+i*nx+(l-1)]-hw));
+ tend = MIN(nt-1, (maxval[isyn*nxy+i*nx+(l-1)]+hw));
+ jmax=tstart;
+ tmax=0.0;
+ for(j = tstart; j <= tend; j++) {
+ lmax = fabs(tinv[ig+i*nx*ntfft+l*ntfft+j]);
+ if (lmax > tmax) {
+ jmax = j;
+ tmax = lmax;
+ }
+ }
+ maxval[isyn*nxy+i*nx+l] = jmax;
+ }
+ /* search backward in x-trace direction from maximum in file */
+ for (l = ixmax-1; l >=0; l--) {
+ tstart = MAX(0, (maxval[isyn*nxy+i*nx+l+1]-hw));
+ tend = MIN(nt-1, (maxval[isyn*nxy+i*nx+l+1]+hw));
+ jmax=tstart;
+ tmax=0.0;
+ for(j = tstart; j <= tend; j++) {
+ lmax = fabs(tinv[ig+i*nx*ntfft+l*ntfft+j]);
+ if (lmax > tmax) {
+ jmax = j;
+ tmax = lmax;
+ }
+ }
+ maxval[isyn*nxy+i*nx+l] = jmax;
+ }
+ }
+
+ if (itrace != 0) { /* end of shot record, but not end-of-file */
+ fseek( fp, -TRCBYTES, SEEK_CUR );
+ isyn++;
+ }
+ else {
+ end_of_file = 1;
+ }
+
+ /* copy trace to data array for mode=-1 */
+ /* time reverse trace */
+ if (mode==-1) {
+ for (i = 0; i < ny1; i++) {
+ for (l = 0; l < nx1; l++) {
+ memcpy( trace, &tinv[ig+i*nx*ntfft+l*ntfft], ntfft*sizeof(float));
+ j=0;
+ tinv[ig+i*nx*ntfft+l*ntfft+j] = trace[j];
+ for (j=1; j<ntfft; j++) tinv[ig+i*nx*ntfft+l*ntfft+ntfft-j] = trace[j];
+ }
+ }
+ }
+ }
+
+ free(ctrace);
+ free(trace);
+
+ return 0;
+}
+
+
+/* simple sort algorithm */
+void findShotInMute(float *xrcvMute, float xrcvShot, long nxs, long *imute)
+{
+ long i, sign;
+ float diff1, diff2;
+
+ *imute=0;
+
+ if (xrcvMute[0] < xrcvMute[1]) sign = 1;
+ else sign = -1;
+
+ if (sign == 1) {
+ i = 0;
+ while (xrcvMute[i] < xrcvShot && i < nxs) {
+ i++;
+ }
+ /* i is now position larger than xrcvShot */
+ }
+ else {
+ i = 0;
+ while (xrcvMute[i] > xrcvShot && i < nxs) {
+ i++;
+ }
+ /* i is now position smaller than xrcvShot */
+ }
+
+ diff1 = fabsf(xrcvMute[i]-xrcvShot);
+ diff2 = fabsf(xrcvMute[i-1]-xrcvShot);
+ if (diff1 < diff2) *imute = i;
+ else *imute = i-1;
+
+ return;
+}
+
diff --git a/marchenko3D/segy.h b/marchenko3D/segy.h
new file mode 120000
index 0000000000000000000000000000000000000000..8eaebbdccb4f6c015d1ed7d5d3d227bb22ca55c8
--- /dev/null
+++ b/marchenko3D/segy.h
@@ -0,0 +1 @@
+../utils/segy.h
\ No newline at end of file
diff --git a/marchenko3D/synthesis3D.c b/marchenko3D/synthesis3D.c
new file mode 100644
index 0000000000000000000000000000000000000000..d93200daee1113418bafc9dc823d8c253eca1879
--- /dev/null
+++ b/marchenko3D/synthesis3D.c
@@ -0,0 +1,286 @@
+#include "par.h"
+#include "segy.h"
+#include <time.h>
+#include <stdlib.h>
+#include <stdio.h>
+#include <math.h>
+#include <assert.h>
+#include <genfft.h>
+
+int omp_get_max_threads(void);
+int omp_get_num_threads(void);
+void omp_set_num_threads(int num_threads);
+
+#ifndef MAX
+#define MAX(x,y) ((x) > (y) ? (x) : (y))
+#endif
+#ifndef MIN
+#define MIN(x,y) ((x) < (y) ? (x) : (y))
+#endif
+#define NINT(x) ((long)((x)>0.0?(x)+0.5:(x)-0.5))
+int compareInt(const void *a, const void *b)
+{ return (*(long *)a-*(long *)b); }
+
+#ifndef COMPLEX
+typedef struct _complexStruct { /* complex number */
+ float r,i;
+} complex;
+#endif/* complex */
+
+long linearsearch(long *array, size_t N, long value);
+
+void synthesisPositions3D(long nx, long ny, long nxs, long nys, long Nfoc, float *xrcv, float *yrcv,
+float *xsrc, float *ysrc, long *xnx, float fxse, float fyse, float fxsb, float fysb, float dxs, float dys,
+long nshots, long nxsrc, long nysrc, long *ixpos, long *npos, long reci, long verbose)
+{
+ long j, l, ixsrc, iysrc, isrc, k, *count, nxy;
+ float fxb, fxe, fyb, fye;
+
+ if (fxsb < 0) fxb = 1.001*fxsb;
+ else fxb = 0.999*fxsb;
+ if (fysb < 0) fyb = 1.001*fysb;
+ else fyb = 0.999*fysb;
+ if (fxse > 0) fxe = 1.001*fxse;
+ else fxe = 0.999*fxse;
+ if (fyse > 0) fye = 1.001*fyse;
+ else fye = 0.999*fyse;
+
+ nxy = nx*ny;
+
+ count = (long *)calloc(nxs*nys,sizeof(long)); // number of traces that contribute to the integration over x
+
+/*================ SYNTHESIS ================*/
+
+ for (l = 0; l < 1; l++) { /* assuming all focal operators cover the same lateral area */
+// for (l = 0; l < Nfoc; l++) {
+ *npos=0;
+
+ if (reci == 0 || reci == 1) {
+ for (k=0; k<nshots; k++) {
+
+ ixsrc = NINT((xsrc[k] - fxsb)/dxs);
+ iysrc = NINT((ysrc[k] - fysb)/dys);
+ isrc = iysrc*nxs + ixsrc;
+ if (verbose>=3) {
+ vmess("source position: x=%.2f y=%.2f in operator x=%li y=%li pos=%li", xsrc[k], ysrc[k], ixsrc, iysrc, isrc);
+ vmess("receiver positions: x:%.2f <--> %.2f y:%.2f <--> %.2f", xrcv[k*nxy+0], xrcv[k*nxy+nxy-1], yrcv[k*nxy+0], yrcv[k*nxy+nxy-1]);
+ vmess("focal point positions: x:%.2f <--> %.2f y:%.2f <--> %.2f", fxsb, fxse, fysb, fyse);
+ }
+
+ if ((NINT(xsrc[k]-fxse) > 0) || (NINT(xrcv[k*nxy+nxy-1]-fxse) > 0) ||
+ (NINT(xrcv[k*nxy+nxy-1]-fxsb) < 0) || (NINT(xsrc[k]-fxsb) < 0) ||
+ (NINT(xrcv[k*nxy+0]-fxsb) < 0) || (NINT(xrcv[k*nxy+0]-fxse) > 0) ||
+ (NINT(ysrc[k]-fyse) > 0) || (NINT(yrcv[k*nxy+nxy-1]-fyse) > 0) ||
+ (NINT(yrcv[k*nxy+nxy-1]-fysb) < 0) || (NINT(ysrc[k]-fysb) < 0) ||
+ (NINT(yrcv[k*nxy+0]-fysb) < 0) || (NINT(yrcv[k*nxy+0]-fyse) > 0) ) {
+ vwarn("source/receiver positions are outside synthesis aperture");
+ vmess("xsrc = %.2f xrcv_1 = %.2f xrvc_N = %.2f", xsrc[k], xrcv[k*nxy+0], xrcv[k*nxy+nxy-1]);
+ vmess("ysrc = %.2f yrcv_1 = %.2f yrvc_N = %.2f", ysrc[k], yrcv[k*nxy+0], yrcv[k*nxy+nxy-1]);
+ vmess("source position x: %.2f in operator %li", xsrc[k], ixsrc);
+ vmess("source position y: %.2f in operator %li", ysrc[k], iysrc);
+ vmess("receiver positions x: %.2f <--> %.2f", xrcv[k*nxy+0], xrcv[k*nxy+nxy-1]);
+ vmess("receiver positions y: %.2f <--> %.2f", yrcv[k*nxy+0], yrcv[k*nxy+nxy-1]);
+ vmess("focal point positions x: %.2f <--> %.2f", fxsb, fxse);
+ vmess("focal point positions y: %.2f <--> %.2f", fysb, fyse);
+ }
+
+ if ( (xsrc[k] >= fxb) && (xsrc[k] <= fxe) &&
+ (ysrc[k] >= fyb) && (ysrc[k] <= fye) ) {
+
+ j = linearsearch(ixpos, *npos, isrc);
+ if (j < *npos) { /* the position (at j) is already included */
+ count[j] += xnx[k];
+ }
+ else { /* add new postion */
+ ixpos[*npos] = isrc;
+ count[*npos] += xnx[k];
+ *npos += 1;
+ }
+ // vmess("source position %li is inside synthesis model %f *npos=%li count=%li", k, xsrc[k], *npos, count[*npos]);
+ }
+
+ } /* end of nshots (k) loop */
+ } /* end of reci branch */
+ } /* end of Nfoc loop */
+
+ if (verbose>=4) {
+ for (j=0; j < *npos; j++) {
+ vmess("ixpos[%li] = %li count=%li", j, ixpos[j], count[j]);
+ }
+ }
+ free(count);
+
+/* sort ixpos into increasing values */
+ qsort(ixpos, *npos, sizeof(long), compareInt);
+
+
+ return;
+}
+
+long linearsearch(long *array, size_t N, long value)
+{
+ long j;
+/* Check is position is already in array */
+ j = 0;
+ while (j < N && value != array[j]) {
+ j++;
+ }
+ return j;
+}
+
+/*================ Convolution and Integration ================*/
+
+void synthesis3D(complex *Refl, complex *Fop, float *Top, float *iRN, long nx, long ny, long nt, long nxs, long nys, long nts, float dt, float *xsyn, float *ysyn,
+long Nfoc, float *xrcv, float *yrcv, float *xsrc, float *ysrc, long *xnx, float fxse, float fxsb, float fyse, float fysb, float dxs, float dys, float dxsrc,
+float dysrc, float dx, float dy, long ntfft, long nw, long nw_low, long nw_high, long mode, long reci, long nshots, long nxsrc, long nysrc,
+long *ixpos, long npos, double *tfft, long *isxcount, long *reci_xsrc, long *reci_xrcv, float *ixmask, long verbose)
+{
+ long nfreq, size, inx;
+ float scl;
+ long i, j, l, m, iw, ix, k, isrc, il, ik, nxy, nxys;
+ float *rtrace, idxs, idys, fxb, fyb, fxe, fye;
+ complex *sum, *ctrace;
+ long npe;
+ static long first=1, *ircv;
+ static double t0, t1, t;
+
+ if (fxsb < 0) fxb = 1.001*fxsb;
+ else fxb = 0.999*fxsb;
+ if (fysb < 0) fyb = 1.001*fysb;
+ else fyb = 0.999*fysb;
+ if (fxse > 0) fxe = 1.001*fxse;
+ else fxe = 0.999*fxse;
+ if (fyse > 0) fye = 1.001*fyse;
+ else fye = 0.999*fyse;
+
+ nxy = nx*ny;
+ nxys = nxs*nys;
+
+ size = nxys*nts;
+ nfreq = ntfft/2+1;
+ /* scale factor 1/N for backward FFT,
+ * scale dt for correlation/convolution along time,
+ * scale dx*dy (or dxsrc*dysrc) for integration over receiver (or shot) coordinates */
+ scl = 1.0*dt/((float)ntfft);
+
+#ifdef _OPENMP
+ npe = (long)omp_get_max_threads();
+ /* parallelisation is over number of virtual source positions (Nfoc) */
+ if (npe > Nfoc) {
+ vmess("Number of OpenMP threads set to %li (was %li)", Nfoc, npe);
+ omp_set_num_threads((int)Nfoc);
+ }
+#endif
+
+ t0 = wallclock_time();
+
+ /* reset output data to zero */
+ memset(&iRN[0], 0, Nfoc*nxys*nts*sizeof(float));
+ ctrace = (complex *)calloc(ntfft,sizeof(complex));
+
+ if (!first) {
+ /* transform muted Ni (Top) to frequency domain, input for next iteration */
+ for (l = 0; l < Nfoc; l++) {
+ /* set Fop to zero, so new operator can be defined within ixpos points */
+ memset(&Fop[l*nxys*nw].r, 0, nxys*nw*2*sizeof(float));
+ for (i = 0; i < npos; i++) {
+ rc1fft(&Top[l*size+i*nts],ctrace,ntfft,-1);
+ ix = ixpos[i];
+ for (iw=0; iw<nw; iw++) {
+ Fop[l*nxys*nw+iw*nxys+ix].r = ctrace[nw_low+iw].r;
+ Fop[l*nxys*nw+iw*nxys+ix].i = mode*ctrace[nw_low+iw].i;
+ }
+ }
+ }
+ }
+ else { /* only for first call to synthesis using all nxs traces in G_d */
+ /* transform G_d to frequency domain, over all nxs traces */
+ first=0;
+ for (l = 0; l < Nfoc; l++) {
+ /* set Fop to zero, so new operator can be defined within all ix points */
+ memset(&Fop[l*nxys*nw].r, 0, nxys*nw*2*sizeof(float));
+ for (i = 0; i < nxys; i++) {
+ rc1fft(&Top[l*size+i*nts],ctrace,ntfft,-1);
+ for (iw=0; iw<nw; iw++) {
+ Fop[l*nxys*nw+iw*nxys+i].r = ctrace[nw_low+iw].r;
+ Fop[l*nxys*nw+iw*nxys+i].i = mode*ctrace[nw_low+iw].i;
+ }
+ }
+ }
+ idxs = 1.0/dxs;
+ idys = 1.0/dys;
+ ircv = (long *)malloc(nshots*nxy*sizeof(long));
+ for (k=0; k<nshots; k++) {
+ for (i = 0; i < nxy; i++) {
+ ircv[k*nxy+i] = NINT((yrcv[k*nxy+i]-fysb)*idys)*nx+NINT((xrcv[k*nxy+i]-fxsb)*idxs);
+ }
+ }
+ }
+ free(ctrace);
+ t1 = wallclock_time();
+ *tfft += t1 - t0;
+
+/* Loop over total number of shots */
+ if (reci == 0 || reci == 1) {
+ for (k=0; k<nshots; k++) {
+ if ((xsrc[k] < fxb) || (xsrc[k] > fxe) || (ysrc[k] < fyb) || (ysrc[k] > fye)) continue;
+ isrc = NINT((ysrc[k] - fysb)/dys)*nxs+NINT((xsrc[k] - fxsb)/dxs);
+ inx = xnx[k]; /* number of traces per shot */
+
+/*================ SYNTHESIS ================*/
+
+#pragma omp parallel default(none) \
+ shared(iRN, dx, dy, npe, nw, verbose) \
+ shared(Refl, Nfoc, reci, xrcv, xsrc, yrcv, ysrc, xsyn, ysyn) \
+ shared(fxsb, fxse, fysb, fyse, nxs, nys, nxys, dxs, dys) \
+ shared(nx, ny, nxy, dysrc, dxsrc, inx, k, nfreq, nw_low, nw_high) \
+ shared(Fop, size, nts, ntfft, scl, ircv, isrc) \
+ private(l, ix, j, m, i, sum, rtrace)
+{ /* start of parallel region */
+ sum = (complex *)malloc(nfreq*sizeof(complex));
+ rtrace = (float *)calloc(ntfft,sizeof(float));
+
+#pragma omp for schedule(guided,1)
+ for (l = 0; l < Nfoc; l++) {
+ /* compute integral over receiver positions */
+ /* multiply R with Fop and sum over nx */
+ memset(&sum[0].r,0,nfreq*2*sizeof(float));
+ for (i = 0; i < inx; i++) {
+ for (j = nw_low, m = 0; j <= nw_high; j++, m++) {
+ ix = ircv[k*nxy+i];
+ sum[j].r += Refl[k*nw*nxy+m*nxy+i].r*Fop[l*nw*nxys+m*nxys+ix].r -
+ Refl[k*nw*nxy+m*nxy+i].i*Fop[l*nw*nxys+m*nxys+ix].i;
+ sum[j].i += Refl[k*nw*nxy+m*nxy+i].i*Fop[l*nw*nxys+m*nxys+ix].r +
+ Refl[k*nw*nxy+m*nxy+i].r*Fop[l*nw*nxys+m*nxys+ix].i;
+ }
+ }
+
+ /* transfrom result back to time domain */
+ cr1fft(sum, rtrace, ntfft, 1);
+
+ /* place result at source position ixsrc; dx = receiver distance */
+ for (j = 0; j < nts; j++)
+ iRN[l*size+isrc*nts+j] += rtrace[j]*scl*dx*dy;
+
+ } /* end of parallel Nfoc loop */
+ free(sum);
+ free(rtrace);
+
+#ifdef _OPENMP
+#pragma omp single
+ npe = (long)omp_get_num_threads();
+#endif
+} /* end of parallel region */
+
+ if (verbose>4) vmess("*** Shot gather %li processed ***", k);
+
+ } /* end of nshots (k) loop */
+ } /* end of if reci */
+
+ t = wallclock_time() - t0;
+ if (verbose) {
+ vmess("OMP: parallel region = %f seconds (%li threads)", t, npe);
+ }
+
+ return;
+}
\ No newline at end of file
diff --git a/marchenko3D/synthesis3Dotavia.c b/marchenko3D/synthesis3Dotavia.c
new file mode 100644
index 0000000000000000000000000000000000000000..4e4812ee82b9c69330dfabe25fb37f9339f592b0
--- /dev/null
+++ b/marchenko3D/synthesis3Dotavia.c
@@ -0,0 +1,319 @@
+#include "par.h"
+#include "segy.h"
+#include <time.h>
+#include <stdlib.h>
+#include <stdio.h>
+#include <math.h>
+#include <assert.h>
+#include <genfft.h>
+
+//External functions
+int omp_get_max_threads(void);
+int omp_get_num_threads(void);
+void omp_set_num_threads(int num_threads);
+
+//Kernels
+void setup_fops();
+
+
+#ifndef MAX
+#define MAX(x,y) ((x) > (y) ? (x) : (y))
+#endif
+#ifndef MIN
+#define MIN(x,y) ((x) < (y) ? (x) : (y))
+#endif
+#define NINT(x) ((int)((x)>0.0?(x)+0.5:(x)-0.5))
+int compareInt(const void *a, const void *b)
+{ return (*(int *)a-*(int *)b); }
+
+#ifndef COMPLEX
+typedef struct _complexStruct { /* complex number */
+ float r,i;
+} complex;
+#endif/* complex */
+
+void synthesisPositions3D(int nx, int ny, int nxs, int nys, int Nfoc, float *xrcv, float *yrcv,
+float *xsrc, float *ysrc, int *xnx, float fxse, float fyse, float fxsb, float fysb, float dxs, float dys,
+int nshots, int nxsrc, int nysrc, int *ixpos, int *npos, int reci, int verbose)
+{
+ int j, l, ixsrc, iysrc, isrc, k, *count, nxy;
+ float fxb, fxe, fyb, fye;
+
+ if (fxsb < 0) fxb = 1.001*fxsb;
+ else fxb = 0.999*fxsb;
+ if (fysb < 0) fyb = 1.001*fysb;
+ else fyb = 0.999*fysb;
+ if (fxse > 0) fxe = 1.001*fxse;
+ else fxe = 0.999*fxse;
+ if (fyse > 0) fye = 1.001*fyse;
+ else fye = 0.999*fyse;
+
+ nxy = nx*ny;
+
+ count = (int *)calloc(nxs*nys,sizeof(int)); // number of traces that contribute to the integration over x
+
+/*================ SYNTHESIS ================*/
+
+ for (l = 0; l < 1; l++) { /* assuming all focal operators cover the same lateral area */
+// for (l = 0; l < Nfoc; l++) {
+ *npos=0;
+
+ if (reci == 0 || reci == 1) {
+ for (k=0; k<nshots; k++) {
+
+ ixsrc = NINT((xsrc[k] - fxsb)/dxs);
+ iysrc = NINT((ysrc[k] - fysb)/dys);
+ isrc = iysrc*nxs + ixsrc;
+ if (verbose>=3) {
+ vmess("source position: x=%.2f y=%.2f in operator x=%d y=%d pos=%d", xsrc[k], ysrc[k], ixsrc, iysrc, isrc);
+ vmess("receiver positions: x:%.2f <--> %.2f y:%.2f <--> %.2f", xrcv[k*nxy+0], xrcv[k*nxy+nxy-1], yrcv[k*nxy+0], yrcv[k*nxy+nxy-1]);
+ vmess("focal point positions: x:%.2f <--> %.2f y:%.2f <--> %.2f", fxsb, fxse, fysb, fyse);
+ }
+
+ if ((NINT(xsrc[k]-fxse) > 0) || (NINT(xrcv[k*nxy+nxy-1]-fxse) > 0) ||
+ (NINT(xrcv[k*nxy+nxy-1]-fxsb) < 0) || (NINT(xsrc[k]-fxsb) < 0) ||
+ (NINT(xrcv[k*nxy+0]-fxsb) < 0) || (NINT(xrcv[k*nxy+0]-fxse) > 0) ||
+ (NINT(ysrc[k]-fyse) > 0) || (NINT(yrcv[k*nxy+nxy-1]-fyse) > 0) ||
+ (NINT(yrcv[k*nxy+nxy-1]-fysb) < 0) || (NINT(ysrc[k]-fysb) < 0) ||
+ (NINT(yrcv[k*nxy+0]-fysb) < 0) || (NINT(yrcv[k*nxy+0]-fyse) > 0) ) {
+ vwarn("source/receiver positions are outside synthesis aperture");
+ vmess("xsrc = %.2f xrcv_1 = %.2f xrvc_N = %.2f", xsrc[k], xrcv[k*nxy+0], xrcv[k*nxy+nxy-1]);
+ vmess("ysrc = %.2f yrcv_1 = %.2f yrvc_N = %.2f", ysrc[k], yrcv[k*nxy+0], yrcv[k*nxy+nxy-1]);
+ vmess("source position x: %.2f in operator %d", xsrc[k], ixsrc);
+ vmess("source position y: %.2f in operator %d", ysrc[k], iysrc);
+ vmess("receiver positions x: %.2f <--> %.2f", xrcv[k*nxy+0], xrcv[k*nxy+nxy-1]);
+ vmess("receiver positions y: %.2f <--> %.2f", yrcv[k*nxy+0], yrcv[k*nxy+nxy-1]);
+ vmess("focal point positions x: %.2f <--> %.2f", fxsb, fxse);
+ vmess("focal point positions y: %.2f <--> %.2f", fysb, fyse);
+ }
+
+ if ( (xsrc[k] >= fxb) && (xsrc[k] <= fxe) &&
+ (ysrc[k] >= fyb) && (ysrc[k] <= fye) ) {
+
+ j = linearsearch(ixpos, *npos, isrc);
+ if (j < *npos) { /* the position (at j) is already included */
+ count[j] += xnx[k];
+ }
+ else { /* add new postion */
+ ixpos[*npos] = isrc;
+ count[*npos] += xnx[k];
+ *npos += 1;
+ }
+ // vmess("source position %d is inside synthesis model %f *npos=%d count=%d", k, xsrc[k], *npos, count[*npos]);
+ }
+
+ } /* end of nshots (k) loop */
+ } /* end of reci branch */
+ } /* end of Nfoc loop */
+
+ if (verbose>=4) {
+ for (j=0; j < *npos; j++) {
+ vmess("ixpos[%d] = %d count=%d", j, ixpos[j], count[j]);
+ }
+ }
+ free(count);
+
+/* sort ixpos into increasing values */
+ qsort(ixpos, *npos, sizeof(int), compareInt);
+
+
+ return;
+}
+
+int linearsearch(int *array, size_t N, int value)
+{
+ int j;
+/* Check is position is already in array */
+ j = 0;
+ while (j < N && value != array[j]) {
+ j++;
+ }
+ return j;
+}
+
+/*================ Convolution and Integration ================*/
+
+void synthesis3D(complex *Refl, complex *Fop, float *Top, float *iRN, int nx, int ny, int nt, int nxs, int nys, int nts, float dt, float *xsyn, float *ysyn,
+int Nfoc, float *xrcv, float *yrcv, float *xsrc, float *ysrc, int *xnx, float fxse, float fxsb, float fyse, float fysb, float dxs, float dys, float dxsrc,
+float dysrc, float dx, float dy, int ntfft, int nw, int nw_low, int nw_high, int mode, int reci, int nshots, int nxsrc, int nysrc,
+int *ixpos, int npos, double *tfft, int *isxcount, int *reci_xsrc, int *reci_xrcv, float *ixmask, int verbose)
+{
+ int nfreq, size, inx;
+ float scl;
+ int i, j, l, m, iw, ix, k, isrc, il, ik, nxy, nxys;
+ float *rtrace, idxs, idys;
+ complex *sum, *ctrace;
+ int npe;
+ static int first=1, *ircv;
+ static double t0, t1, t;
+
+ nxy = nx*ny;
+ nxys = nxs*nys;
+
+ size = nxys*nts;
+ nfreq = ntfft/2+1;
+ /* scale factor 1/N for backward FFT,
+ * scale dt for correlation/convolution along time,
+ * scale dx (or dxsrc) for integration over receiver (or shot) coordinates */
+ scl = 1.0*dt/((float)ntfft);
+
+#ifdef _OPENMP
+ npe = omp_get_max_threads();
+ /* parallelisation is over number of virtual source positions (Nfoc) */
+ if (npe > Nfoc) {
+ vmess("Number of OpenMP threads set to %d (was %d)", Nfoc, npe);
+ omp_set_num_threads(Nfoc);
+ }
+#endif
+
+ t0 = wallclock_time();
+
+ /* reset output data to zero */
+ memset(&iRN[0], 0, Nfoc*nxys*nts*sizeof(float));
+ ctrace = (complex *)calloc(ntfft,sizeof(complex));
+
+ if (!first) {
+ /* transform muted Ni (Top) to frequency domain, input for next iteration */
+ //TODO: create a FFT kernel
+ for (l = 0; l < Nfoc; l++) {
+ /* set Fop to zero, so new operator can be defined within ixpos points */
+ memset(&Fop[l*nxys*nw].r, 0, nxys*nw*2*sizeof(float));
+ for (i = 0; i < npos; i++) {
+ rc1fft(&Top[l*size+i*nts],ctrace,ntfft,-1);
+ ix = ixpos[i];
+ for (iw=0; iw<nw; iw++) {
+ Fop[l*nxys*nw+iw*nxys+ix].r = ctrace[nw_low+iw].r;
+ Fop[l*nxys*nw+iw*nxys+ix].i = mode*ctrace[nw_low+iw].i;
+ }
+ }
+ }
+ }
+ else { /* only for first call to synthesis using all nxs traces in G_d */
+ /* transform G_d to frequency domain, over all nxs traces */
+ first=0;
+ for (l = 0; l < Nfoc; l++) {
+ /* set Fop to zero, so new operator can be defined within all ix points */
+ memset(&Fop[l*nxys*nw].r, 0, nxys*nw*2*sizeof(float));
+ for (i = 0; i < nxys; i++) {
+ rc1fft(&Top[l*size+i*nts],ctrace,ntfft,-1);
+ for (iw=0; iw<nw; iw++) {
+ Fop[l*nxys*nw+iw*nxys+i].r = ctrace[nw_low+iw].r;
+ Fop[l*nxys*nw+iw*nxys+i].i = mode*ctrace[nw_low+iw].i;
+ }
+ }
+ }
+ idxs = 1.0/dxs;
+ idys = 1.0/dys;
+ ircv = (int *)malloc(nshots*nxy*sizeof(int));
+ for (k=0; k<nshots; k++) {
+ for (i = 0; i < nxy; i++) {
+ ircv[k*nxy+i] = NINT((yrcv[k*nxy+i]-fysb)*idys)*nx+NINT((xrcv[k*nxy+i]-fxsb)*idxs);
+ }
+ }
+ }
+ free(ctrace);
+ t1 = wallclock_time();
+ *tfft += t1 - t0;
+
+/* Loop over total number of shots */
+ if (reci == 0 || reci == 1) {
+ for (k=0; k<nshots; k++) {
+ if ((xsrc[k] < 0.999*fxsb) || (xsrc[k] > 1.001*fxse) || (ysrc[k] < 0.999*fysb) || (ysrc[k] > 1.001*fyse)) continue;
+ isrc = NINT((ysrc[k] - fysb)/dys)*nxs+NINT((xsrc[k] - fxsb)/dxs);
+ inx = xnx[k]; /* number of traces per shot */
+
+/*================ SYNTHESIS ================*/
+
+#pragma omp parallel default(none) \
+ shared(iRN, dx, dy, npe, nw, verbose) \
+ shared(Refl, Nfoc, reci, xrcv, xsrc, yrcv, ysrc, xsyn, ysyn) \
+ shared(fxsb, fxse, fysb, fyse, nxs, nys, nxys, dxs, dys) \
+ shared(nx, ny, nxy, dysrc, dxsrc, inx, k, nfreq, nw_low, nw_high) \
+ shared(Fop, size, nts, ntfft, scl, ircv, isrc) \
+ private(l, ix, j, m, i, sum, rtrace)
+{ /* start of parallel region */
+ sum = (complex *)malloc(nfreq*sizeof(complex));
+ rtrace = (float *)calloc(ntfft,sizeof(float));
+
+#pragma omp for schedule(guided,1)
+ for (l = 0; l < Nfoc; l++) {
+ /* compute integral over receiver positions */
+ /* multiply R with Fop and sum over nx */
+ memset(&sum[0].r,0,nfreq*2*sizeof(float));
+ for (i = 0; i < inx; i++) {
+ for (j = nw_low, m = 0; j <= nw_high; j++, m++) {
+ ix = ircv[k*nxy+i];
+ sum[j].r += Refl[k*nw*nxy+m*nxy+i].r*Fop[l*nw*nxys+m*nxys+ix].r -
+ Refl[k*nw*nxy+m*nxy+i].i*Fop[l*nw*nxys+m*nxys+ix].i;
+ sum[j].i += Refl[k*nw*nxy+m*nxy+i].i*Fop[l*nw*nxys+m*nxys+ix].r +
+ Refl[k*nw*nxy+m*nxy+i].r*Fop[l*nw*nxys+m*nxys+ix].i;
+ }
+ }
+
+ /* transfrom result back to time domain */
+ cr1fft(sum, rtrace, ntfft, 1);
+
+ /* place result at source position ixsrc; dx = receiver distance */
+ for (j = 0; j < nts; j++)
+ iRN[l*size+isrc*nts+j] += rtrace[j]*scl*dx*dy;
+
+ } /* end of parallel Nfoc loop */
+ free(sum);
+ free(rtrace);
+
+#ifdef _OPENMP
+#pragma omp single
+ npe = omp_get_num_threads();
+#endif
+} /* end of parallel region */
+
+ if (verbose>4) vmess("*** Shot gather %d processed ***", k);
+
+ } /* end of nshots (k) loop */
+ } /* end of if reci */
+
+ t = wallclock_time() - t0;
+ if (verbose) {
+ vmess("OMP: parallel region = %f seconds (%d threads)", t, npe);
+ }
+
+ return;
+}
+
+void setup_fops(complex *Fop, float *Top, int nxys, int Nfoc, int nw, int npos, int ntfft, int *ixpos, int *first, float dxs, float dys, int nshots, int nxy, int nw_low, int *ircv, float *yrcv, float *xrcv, float fxsb, float fysb){
+ int ix, idxs, idys, iloop, iw, k, i, l;
+ complex *ctrace;
+
+ ctrace = (complex *)calloc(ntfft,sizeof(complex));
+
+ iloop = (*first ? npos : nxys)
+
+ memset(&Fop[Nfoc*nxys*nw].r, 0, nxys*nw*2*sizeof(float));
+
+ /* transform muted Ni (Top) to frequency domain, input for next iteration */
+ //TODO: create a FFT kernel
+ for (i = 0; i < iloop; i++) {
+ /* set Fop to zero, so new operator can be defined within ixpos points */
+ for (l = 0; l < Nfoc; l++) {
+ rc1fft(&Top[l*size+i*nts],ctrace,ntfft,-1);
+ ix = (*first ? i : ixpos[i]);
+ for (iw=0; iw<nw; iw++) {
+ Fop[l*nxys*nw+iw*nxys+ix].r = ctrace[nw_low+iw].r;
+ Fop[l*nxys*nw+iw*nxys+ix].i = mode*ctrace[nw_low+iw].i;
+ }
+ }
+ }
+ if (*first) {
+ idxs = 1.0/dxs;
+ idys = 1.0/dys;
+ ircv = (int *)malloc(nshots*nxy*sizeof(int));
+ for (i = 0; i < nxy; i++) {
+ for (k=0; k<nshots; k++) {
+ ircv[k*nxy+i] = NINT((yrcv[k*nxy+i]-fysb)*idys)*nx+NINT((xrcv[k*nxy+i]-fxsb)*idxs);
+ }
+ }
+ *first = 0;
+ }
+
+ free(ctrace);
+}
\ No newline at end of file
diff --git a/marchenko3D/verbosepkg.c b/marchenko3D/verbosepkg.c
new file mode 120000
index 0000000000000000000000000000000000000000..248253edebc2c7b207e139ecf16b68b318f057df
--- /dev/null
+++ b/marchenko3D/verbosepkg.c
@@ -0,0 +1 @@
+../utils/verbosepkg.c
\ No newline at end of file
diff --git a/marchenko3D/wallclock_time.c b/marchenko3D/wallclock_time.c
new file mode 120000
index 0000000000000000000000000000000000000000..0bd00b4c2878f007a8dc398f0af7c7cb44f50717
--- /dev/null
+++ b/marchenko3D/wallclock_time.c
@@ -0,0 +1 @@
+../utils/wallclock_time.c
\ No newline at end of file
diff --git a/marchenko3D/writeData.c b/marchenko3D/writeData.c
new file mode 120000
index 0000000000000000000000000000000000000000..b761f28f24545fb2e550406a85b67afe0410db7e
--- /dev/null
+++ b/marchenko3D/writeData.c
@@ -0,0 +1 @@
+../utils/writeData.c
\ No newline at end of file
diff --git a/marchenko3D/writeData3D.c b/marchenko3D/writeData3D.c
new file mode 100644
index 0000000000000000000000000000000000000000..d8c3e4775ecdf7ca462abfaa7b303681da102d20
--- /dev/null
+++ b/marchenko3D/writeData3D.c
@@ -0,0 +1,28 @@
+#include <assert.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include "segy.h"
+
+/**
+* writes an 2D array to a SU file
+*
+* AUTHOR:
+* Jan Thorbecke (janth@xs4all.nl)
+* The Netherlands
+**/
+
+int writeData3D(FILE *fp, float *data, segy *hdrs, long n1, long n2)
+{
+ size_t nwrite;
+ long i;
+
+ for (i=0; i<n2; i++) {
+ nwrite = fwrite(&hdrs[i], 1, TRCBYTES, fp);
+ assert(nwrite == TRCBYTES);
+ nwrite = fwrite(&data[i*n1], sizeof(float), n1, fp);
+ assert (nwrite == n1);
+ }
+
+ return 0;
+}
+
diff --git a/marchenko3D/writeDataIter.c b/marchenko3D/writeDataIter.c
new file mode 100644
index 0000000000000000000000000000000000000000..e705736dba0adfb711d2b542d8c6ab224618b09e
--- /dev/null
+++ b/marchenko3D/writeDataIter.c
@@ -0,0 +1,65 @@
+#include <assert.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include "segy.h"
+#include "par.h"
+
+#define NINT(x) ((int)((x)>0.0?(x)+0.5:(x)-0.5))
+
+/**
+* writes an 2D array to a SU file
+*
+* AUTHOR:
+* Jan Thorbecke (janth@xs4all.nl)
+* The Netherlands
+**/
+
+void name_ext(char *filename, char *extension);
+int writeData(FILE *fp, float *data, segy *hdrs, int n1, int n2);
+
+int writeDataIter(char *file_iter, float *data, segy *hdrs, int n1, int n2, float d2, float f2, int n2out, int Nfoc, float *xsyn, float *zsyn, int *ixpos, int npos, int iter)
+{
+ FILE *fp_iter;
+ size_t nwrite;
+ int i, l, j, ret, tracf, size, ix;
+ char number[16], filename[1024];
+ float *trace;
+
+ trace = (float *)malloc(n1*sizeof(float));
+ strcpy(filename, file_iter);
+ sprintf(number,"_%03d",(iter+1));
+ name_ext(filename, number);
+ fp_iter = fopen(filename, "w+");
+ if (fp_iter==NULL) verr("error on creating output file %s", filename);
+ tracf=1;
+ size=n1*n2;
+ for (l = 0; l < Nfoc; l++) {
+ for (i = 0; i < npos; i++) {
+ ix = ixpos[i]; /* select proper position */
+ hdrs[i].fldr = l+1;
+ hdrs[i].sx = NINT(xsyn[l]*1000);
+ hdrs[i].offset = (long)NINT((f2+i*d2) - xsyn[l]);
+ hdrs[i].tracf = tracf++;
+ hdrs[i].selev = NINT(zsyn[l]*1000);
+ hdrs[i].sdepth = NINT(-zsyn[l]*1000);
+ /* rotate to get t=0 in the middle */
+ hdrs[i].f1 = -n1*0.5*hdrs[i].d1;
+ memcpy(&trace[0],&data[l*size+ix*n1],n1*sizeof(float));
+ for (j = 0; j < n1/2; j++) {
+ trace[n1/2+j] = data[l*size+ix*n1+j];
+ }
+ for (j = n1/2; j < n1; j++) {
+ trace[j-n1/2] = data[l*size+ix*n1+j];
+ }
+ nwrite = fwrite(&hdrs[i], 1, TRCBYTES, fp_iter);
+ assert(nwrite == TRCBYTES);
+ nwrite = fwrite(trace, sizeof(float), n1, fp_iter);
+ assert (nwrite == n1);
+ }
+ }
+ ret = fclose(fp_iter);
+ if (ret < 0 ) verr("error on writing output file.");
+ free(trace);
+
+ return 0;
+}
diff --git a/raytime/Makefile b/raytime/Makefile
index 192a17315ed0dc71f494646357315a4ffcc2dc82..398bd1fedc4198afb9c050c4acdfc0423f76a15e 100644
--- a/raytime/Makefile
+++ b/raytime/Makefile
@@ -5,7 +5,7 @@ include ../Make_include
########################################################################
# define general include and system library
ALLINC = -I.
-LIBS += -L$L -lgenfft -lm $(LIBSM)
+#LIBS += -L$L -lgenfft -lm $(LIBSM)
#LIBS += -L$L -lgenfft -lm -lc
#OPTC = -g -Wall -fsignaling-nans -O0
#OPTC += -fopenmp -Waddress
@@ -47,16 +47,16 @@ SRCC = $(PRG).c \
OBJC = $(SRCC:%.c=%.o)
$(PRG): $(OBJC) raytime.h
- $(CC) $(LDFLAGS) $(CFLAGS) $(OPTC) -o Raytime $(OBJC) $(LIBS)
+ $(CC) $(LDFLAGS) $(CFLAGS) $(OPTC) -o raytime $(OBJC) $(LIBS)
install: raytime
- cp Raytime $B
+ cp raytime $B
clean:
- rm -f core $(OBJC) $(OBJM) Raytime
+ rm -f core $(OBJC) $(OBJM) raytime
realclean:
- rm -f core $(OBJC) $(OBJM) $(PRG) $B/Raytime
+ rm -f core $(OBJC) $(OBJM) $(PRG) $B/raytime
print: Makefile $(SRC)
diff --git a/raytime/raytime.c b/raytime/raytime.c
index 11dac3eb17c16ffdef0d44c22819d7138858153d..414673e43627ba094f6f70bd2b34f64c08907ec1 100644
--- a/raytime/raytime.c
+++ b/raytime/raytime.c
@@ -68,6 +68,7 @@ char *sdoc[] = {
" xsrca= ............ defines source array x-positions",
" zsrca= ............ defines source array z-positions",
"" ,
+/*
" PLANE WAVE SOURCE DEFINITION:",
" plane_wave=0 ...... model plane wave with nsrc= sources",
" nsrc=1 ............ number of sources per (plane-wave) shot ",
@@ -83,6 +84,7 @@ char *sdoc[] = {
" distribution=0 .... random function for amplitude and tlength 0=flat 1=Gaussian ",
" seed=10 ........... seed for start of random sequence ",
"" ,
+*/
" RECEIVER SELECTION:",
" xrcv1=xmin ........ first x-position of linear receiver array(s)",
" xrcv2=xmax ........ last x-position of linear receiver array(s)",
@@ -260,7 +262,7 @@ int main(int argc, char **argv)
memset(&hdr,0,sizeof(hdr));
hdr.scalco = -1000;
hdr.scalel = -1000;
- hdr.trid = 1;
+ hdr.trid = 0;
t1=wallclock_time();
tinit = t1-t0;
diff --git a/raytime/raytime.c.veryold b/raytime/raytime.c.veryold
deleted file mode 100644
index e5e01b50b514111a8d45a27deb3421131244f40c..0000000000000000000000000000000000000000
--- a/raytime/raytime.c.veryold
+++ /dev/null
@@ -1,704 +0,0 @@
-#include <DELPHI_IOc.h>
-#include <errno.h>
-#include <memory.h>
-#include <time.h>
-#include <raytime.h>
-
-/* Plane-wave modeling externals */
-void plane_wave(float *tfinal,float *slowness, char *candidate, struct i_xyz *ndim, float scale, int order);
-
-/* Vidale modeling externals */
-extern void vidale(float *ttime, float *slow, struct i_xyz *nm, struct i_xyz *isrc, struct f_xyz *scale, int order);
-
-/* Graph_Theory modeling externals */
-extern void dijkstra(float *tfinal, float *slowness, char *candidate, int *raypath, XYZIndex *ndim, int order, int big, struct s_stencil *template);
-
-extern struct s_stencil *make_stencil(int order, XYZIndex *nm, XYZPosition *scale);
-
-extern void getrecpos(int *xi, int *zi, int *nrec, int nx, float h, float ox, float oz, int verbose);
-
-extern float setzsrc(int nb, int *boundary, float **inter, float *slow, int ni, float zsrc1, float dzsrc, float dz, float oz, int nx, int nz, float xsrc, float dx, float ox, int id, int verbose);
-
-void rm_head(float *slow, struct i_xyz *ndim, struct i_xyz *isrc, int mzrcv, struct f_xyz *scale, float **inter, int ni, int *nzm);
-
-extern void draw_rays(char *file_eps, int *raypath, struct i_xyz *ircv, int nx, int nz, float *slow, float dx, float dz, int nrec, float **inter, int ni, int hom, int verbose);
-
-extern void opint(float **data, int nrec, int Ns, int ix, float **dataT, float Tmin, float Tmax, float dT, int nT);
-
-/*********************** self documentation **********************/
-char *sdoc[] = {
-" ",
-" raytime - modeling of one-way traveltime for CFP operators",
-" ",
-" raytime file_vel= xsrc1= zsrc1= [optional parameters]",
-" ",
-" Required parameters:",
-" ",
-" file_vel= ................ gridded velocity file (DELPHI format)",
-" file_svel= ............... gridded velocity file (DELPHI format)",
-" xsrc1= ................... x-position of the source (m)",
-" zsrc1= ................... z-position of the source (m)",
-" ",
-" Optional parameters:",
-" ",
-" INPUT AND OUTPUT ",
-" file_out= ................ output file with traveltimes",
-" file_amp= ................ output file with approximate amplitudes",
-" file_int= ................ input file describing the interfaces (makemod)",
-" file_ray= ................ postscript file with rays (only method=graph)",
-" onegath=0 ................ 1; writes operators in one gather",
-" RAY TRACING ",
-" method=fd ................ calculation method (fd, plane or graph) ",
-" sbox=1 ................... radius of inner straight ray (fd method)",
-" order= ................... accuracy plane(=2)[0-2] and graph(=8)[1-10]",
-" radius=0 ................. radius in plane method",
-" dT=0 ..................... put traces on one-way time grid with step dT",
-" Tmin=0 ................... minimum time of one-way time grid (0 not used)",
-" Tmax=Tmin ................ maximum time of one-way time grid",
-" hom=1 .................... 1: draw straight rays in homogeneous layers",
-" SOURCE POSITIONS ",
-" xsrc2=xsrc1 .............. x-position of last source",
-" dxsrc=0 .................. step in source x-direction",
-" zsrc2=zsrc1 .............. z-position of last source",
-" dzsrc=0 .................. step in source z-direction",
-" boundary=0 ............... boundary to place the sources (overrules zsrc)",
-" add=0 .................... 1: adds all defined sources",
-" head=0 ................... 1: calculate head waves near source position",
-" RECEIVER POSITIONS ",
-" xrcv=0,(nx-1)*dx ......... x-position's of receivers (array)",
-" zrcv=0,0 ................. z-position's of receivers (array)",
-" Rboundary=0 .............. boundary to place the receivers (overrules zrcv)",
-" dxrcv=dx ................. step in receiver x-direction",
-" dzrcv=0 .................. step in receiver z-direction",
-" dxspr=0 .................. step of receiver spread in x-direction",
-" lint=1 ................... linear interpolate between the rcv points",
-" verbose=0 ................ verbose option",
-" ",
-" raytime calculates the first arrival time at the defined receiver array ",
-" for the defined shots at different depth and lateral positions.",
-" Note that one output gather consists of shots which are defined at the",
-" same lateral position but with different depth positions.",
-" Every new lateral position (with dxsrc) gives a new output gather.",
-" The parameter dT defines the one-way time between two shot records. The",
-" defined shot records (at depth) are used to get the interpolated values ",
-" at time steps of dT. ",
-" ",
-" PROGRAM TO CALCULATE TRAVEL TIMES IN 2D MEDIA ",
-" AUTHOR: Joseph R. Matarese ",
-" Copyright (c) 1993: Joseph R. Matarese and ",
-" Massachusetts Institute of Technology ",
-" ",
-" Translated to DELPHI environment: Jan Thorbecke 16-02-1996",
-" ",
-NULL};
-/**************** end self doc ***********************************/
-
-int main(int argc, char *argv[])
-{
- float32 *slowness, *slowness_S;
- uint8 *candidate;
- float32 *ttime, *ttime_p, slow_src;
- struct i_xyz *ndim, *isrc, *ircv;
- struct f_xyz scale;
- int id, nd, iz, ix, is, ir, ie, i;
- int iz_min, iz_max, ix_min, ix_max;
- int node_src, idz, idx, idp, sign;
- int *raypath;
- struct s_stencil *stencil;
-
- intn seqnr[MAX_KEYS];
- int32 type, dom1, dom2;
- int error, n1, n2, ret, size, verbose, nkeys, a;
- int k, nx, nz, sbox, Ns, nrec, ni, add, hom, ib, Nb;
- int *xi, *zi, j, ispr, ik, nzm, head, nT, mzrcv;
- int Nd, nb, *boundary, onegath, order, radius, Rboundary;
- float xsrc1, xsrc2, dxsrc, zsrc1=0, zsrc2, dzsrc, sx, sz, sl;
- float d1, d2, f1, f2, *tmpdata, dx, dz, dxspr, **data;
- float xsrc, *zsrc, drcv, dxrcv, dzrcv, t0, t1, t2, x, z, r, signz;
- float ox, oz, **inter, dT, Tmin, Tmax, **dataT, *trueslow;
- char *file_vel, *file_out, *file_int, *file_amp, *file_svel;
- char *keys[MAX_KEYS], *method, *file_ray, file_base[256], *pf;
- segyhdr *hdrs, *hdrsT;
-
- t0 = cputime();
- initargs(argc, argv);
- requestdoc(1);
-
-/*---------------------------------------------------------------------------*
- * Read input parameters and query for any that are needed but missing.
- *---------------------------------------------------------------------------*/
-
- if(!getparint("verbose", &verbose)) verbose = 0;
- if(!getparstring("file_vel", &file_vel)) saerr("file_vel not defined");
- if(!getparstring("file_svel", &file_svel)) file_svel=NULL;
- if(!getparstring("file_out", &file_out)) file_out=NULL;
- if(!getparstring("file_int", &file_int)) file_int=NULL;
- if(!getparstring("file_ray", &file_ray)) file_ray=NULL;
- if(!getparstring("file_amp", &file_amp)) file_amp=NULL;
- if(!getparstring("method", &method)) method="fd";
- if(!getparfloat("xsrc1", &xsrc1)) saerr("xsrc1 not defined");
- if(!getparfloat("xsrc2", &xsrc2)) xsrc2=xsrc1;
- if(!getparfloat("dxsrc", &dxsrc)) dxsrc=0;
- if(!getparfloat("Tmin", &Tmin)) Tmin=0;
- if(!getparint("Rboundary", &Rboundary)) Rboundary=0;
- if (Rboundary) {
- if(file_int == NULL) saerr("file_int must be specified for Rboundary");
- }
- nb = countparval("boundary");
- if(nb == 0 && Tmin == 0) {
- if(!getparfloat("zsrc1", &zsrc1))
- saerr("zsrc1 and boundary not defined, one must be defined");
- }
- else if (Tmin == 0) {
- if(file_int == NULL) saerr("file_int must be specified for boundary");
- boundary = alloc1int(nb);
- getparint("boundary", boundary);
- if (verbose) samess("source definition on boundary");
- }
- if(!getparfloat("zsrc2", &zsrc2)) zsrc2=zsrc1;
- if(!getparfloat("dzsrc", &dzsrc)) dzsrc=0;
- if(!getparint("head", &head)) head = 0;
- if(!getparint("sbox", &sbox)) sbox = 1;
- if(!getparint("onegath", &onegath)) onegath = 0;
- if(!getparint("add", &add)) add = 0;
- if(!getparint("hom", &hom)) hom = 1;
-
- if(equal(method,"fd")) {
- if (verbose)
- samess("finite_difference (Vidale, 1988, BSSA V. 78 #6, p. 2062)");
- }
- else if(equal(method,"graph")) {
- if (verbose)
- samess("graph_theory (Moser, 1991, Geophysics V. 56 #1, p. 59)");
- }
- else if(equal(method,"plane")) {
- if (verbose)
- samess("plane_wave (Matarese, 1993, Ph.D. Thesis, MIT)");
- }
- else {
- samess("unknown method: %s",method);
- samess("Possible choices include:\n\n");
- samess("\tfd based on Vidale's finite difference method\n");
- samess("\t (Vidale, 1988, BSSA V. 78 #6, p. 2062)\n");
- samess("\tgraph based on Moser's graph theoretical method\n");
- samess("\t (Moser, 1991, Geophysics V. 56 #1, p. 59)\n");
- samess("\tplane based on Matarese's plane wave extrapolation\n");
- samess("\t (Matarese, 1993, Ph.D. Thesis, MIT)\n");
- return(0);
- }
-
- if (file_ray != NULL) {
- pf = strrchr(file_ray, '.');
- *pf = '\0';
- if(!equal(method,"graph")) {
- sawarn("If file_ray is defined then method=graph");
- sawarn("So, method is set to graph");
- method = "graph";
- }
- }
-
- if(equal(method,"plane")) {
- if(!getparint("order", &order)) order = 2;
- if(order < 0 || order > 2) {
- sawarn("order must be within [0-2]");
- sawarn("order set to 2");
- order = 2;
- }
- if(!getparint("radius", &radius)) radius = 0;
- }
- else if(equal(method,"graph")) {
- if(!getparint("order", &order)) order = 8;
- if(order < 1) saerr("order must be within [1-10]");
- if(order > 10) sawarn("Attempting an order > 10. Good luck!");
- }
-
- if(equal(method,"plane") && add) {
- if (radius) {
- sawarn("Plane wave method with non-zero radius requires one source.");
- samess("Continuing with radius = 0.");
- }
- radius = 0;
- }
-
- if(add && equal(method,"fd"))
- saerr("Finite difference methods don't support extended source.");
-
-/*---------------------------------------------------------------------------*
- * Input the slowness grid.
- * It's gotta be 2-D and the variable is named "slowness".
- *---------------------------------------------------------------------------*
- * Open velocity file
- *---------------------------------------------------------------------------*/
-
- error = open_file(file_vel, GUESS_TYPE, DELPHI_READ);
- if (error < 0 ) saerr("error in opening file %s", file_vel);
- error = get_dims(file_vel, &n1, &n2, &type);
- size = n1 * n2;
- tmpdata = alloc1float(size);
- hdrs = (segyhdr *) malloc(n2*sizeof(segyhdr));
- read_data(file_vel,tmpdata,size,&n1,&n2,&f1,&f2,&d1,&d2,&type,hdrs);
- get_axis(&dom1, &dom2);
- if (verbose) disp_info(file_vel,n1,n2,f1,f2,d1,d2,type);
- ret = close_file(file_vel);
- if (ret < 0) sawarn("err %d on closing input file",ret);
- slowness = alloc1float(n1*n2);
-
- if (dom2 == SA_AXIS_X) {
- nx = n2; nz = n1;
- dx = d2; dz = d1;
- ox = f2; oz = f1;
- /* look at the coordinates of gx is the f2-axis is not defined */
- if (dx < 1e-9) {
- sawarn("f2 and d2 axis not defined, use the gx values");
- if (hdrs[0].scalco < 0) sl = 1.0/fabs(hdrs[0].scalco);
- else if (hdrs[0].scalco == 0) sl = 1.0;
- else sl = hdrs[0].scalco;
- ox = hdrs[0].gx*sl;
- dx = (hdrs[1].gx-hdrs[0].gx)*sl;
- }
-
- if (verbose) samess("Input model is transposed");
- for(ix=0; ix<nx; ix++) {
- for(iz=0; iz<nz; iz++) slowness[iz*nx+ix] = 1.0/tmpdata[ix*nz+iz];
- }
- }
- else {
- nx = n1; nz = n2;
- dx = d1; dz = d2;
- ox = f1; oz = f2;
- for(iz=0; iz<nz; iz++) {
- for(ix=0; ix<nx; ix++) slowness[iz*nx+ix] = 1.0/tmpdata[iz*nx+ix];
- }
- }
- free1float(tmpdata);
- free(hdrs);
-
-/*---------------------------------------------------------------------------*
- * Open S-wave velocity file
- *---------------------------------------------------------------------------*/
- if (file_svel!= NULL) {
- error = open_file(file_svel, GUESS_TYPE, DELPHI_READ);
- if (error < 0 ) saerr("error in opening file %s", file_svel);
- error = get_dims(file_svel, &n1, &n2, &type);
- size = n1 * n2;
- tmpdata = alloc1float(size);
- hdrs = (segyhdr *) malloc(n2*sizeof(segyhdr));
- read_data(file_svel,tmpdata,size,&n1,&n2,&f1,&f2,&d1,&d2,&type,hdrs);
- get_axis(&dom1, &dom2);
- if (verbose) disp_info(file_svel,n1,n2,f1,f2,d1,d2,type);
- ret = close_file(file_svel);
- if (ret < 0) sawarn("err %d on closing input file",ret);
- slowness_S = alloc1float(n1*n2);
-
- if (dom2 == SA_AXIS_X) {
- if (n2 != nx) saerr("nx of file %s (%d) != nx of file %s (%d)", file_vel, nx, file_svel, n2);
- if (n1 != nz) saerr("nz of file %s (%d) != nz of file %s (%d)", file_vel, nz, file_svel, n1);
-
- if (verbose) samess("Input S-model is transposed");
- for(ix=0; ix<nx; ix++) {
- for(iz=0; iz<nz; iz++) slowness_S[iz*nx+ix] = 1.0/tmpdata[ix*nz+iz];
- }
- }
- else {
- if (n1 != nx) saerr("nx of file %s (%d) != nx of file %s (%d)", file_vel, nx, file_svel, n1);
- if (n2 != nz) saerr("nz of file %s (%d) != nz of file %s (%d)", file_vel, nz, file_svel, n2);
- for(iz=0; iz<nz; iz++) {
- for(ix=0; ix<nx; ix++) slowness_S[iz*nx+ix] = 1.0/tmpdata[iz*nx+ix];
- }
- }
- free1float(tmpdata);
- free(hdrs);
- }
- else {
- slowness_S = alloc1float(nx*nz);
- for(iz=0; iz<nz; iz++) {
- for(ix=0; ix<nx; ix++)
- slowness_S[iz*nx+ix] = slowness[iz*nx+ix];
- }
- }
-
- if (NINT(dx*1000) != NINT(dz*1000)) saerr("dx must be equal to dz");
-
-/*---------------------------------------------------------------------------*
- * Open interface file (if available)
- *---------------------------------------------------------------------------*/
-
- if (file_int != NULL) {
- error = open_file(file_int, GUESS_TYPE, DELPHI_READ);
- if (error < 0 ) saerr("error in opening file %s", file_int);
- error = get_dims(file_int, &n1, &n2, &type);
- size = n1 * n2;
- tmpdata = alloc1float(size);
- hdrs = (segyhdr *) malloc(n2*sizeof(segyhdr));
- read_data(file_int,tmpdata,size,&n1,&n2,&f1,&f2,&d1,&d2,&type,hdrs);
- if (verbose>=2) disp_info(file_int,n1,n2,f1,f2,d1,d2,type);
- ret = close_file(file_int);
- free(hdrs);
- if (ret < 0) sawarn("err %d on closing input file",ret);
- ni = n2;
- if (n1 != nx) saerr("n1 != nx; wrong interface file");
-
- inter = alloc2float(nx, ni);
- for(i=0; i<ni; i++) {
- for(j=0; j<nx; j++) inter[i][j] = tmpdata[i*nx+j];
- }
- free1float(tmpdata);
- }
- else ni = 0;
-
-/*================ Read in receiver positions ================*/
-
- zi = alloc1int(nx+nz);
- xi = alloc1int(nx+nz);
- if(Rboundary<=0) {
- getrecpos(xi, zi, &nrec, nx, dz, ox, oz, verbose);
- }
- else {
- if (verbose) samess("Placing receivers on boundary %d.",Rboundary);
- if (verbose>=3) samess("receiver positions are:");
- if(!getparfloat("dxrcv",&dxrcv)) dxrcv = dx;
- nrec = NINT((nx-1)*dx/dxrcv)+1;
- for (ir = 0; ir < nrec; ir++) {
- xi[ir] = NINT(ir*dxrcv/dx);
- zi[ir] = NINT(inter[Rboundary-1][xi[ir]]/dz);
- if (verbose>=3) fprintf(stderr,"x=%f z=%f\n",(ox+xi[ir]*dx),(oz+zi[ir]*dz));
- }
- }
- if(!getparfloat("dxspr",&dxspr)) dxspr= 0;
- if(verbose) samess("nrec = %d", nrec);
-
-/* ============ Check and set parameters =============== */
-
- ispr = NINT(dxspr/dx);
- if (NINT(ispr*dx) != NINT(dxspr))
- saerr("dxspr is not a multiple of dx; this is not allowed");
-
- mzrcv = 0;
- for (ir = 0; ir < nrec; ir++) mzrcv = MAX(zi[ir], mzrcv);
- if (mzrcv > (nz-1)) saerr("deepest receiver outside model");
-
- if (nb) {dzsrc = 0.0; zsrc1 = inter[boundary[0]-1][0]; Nd = nb;}
- else if (dzsrc == 0) Nd = 1;
- else if (dzsrc != 0) Nd = NINT((zsrc2 - zsrc1)/dzsrc) + 1;
- if (dxsrc == 0) Ns = 1;
- else if (dxsrc != 0) Ns = NINT((xsrc2 - xsrc1)/dxsrc) + 1;
-
- if ((zsrc1+(Nd-1)*dzsrc-oz) > nz*dz) {
- sawarn("Deepest source outside model; last shot(s) not calculated");
- Nd -= 1;
- while( (zsrc1+(Nd-1)*dzsrc-oz ) > nz*dz) Nd--;
- }
- if (xi[nrec-1]*dx + (Ns-1)*dxspr > nx*dx)
- saerr("Moving spread moves outside model");
-
- if(!getparfloat("Tmin", &Tmin)) Tmin=0;
- if(!getparfloat("Tmax", &Tmax)) Tmax=Tmin;
- if(!getparfloat("dT", &dT)) dT=0;
- if (NINT(1000*dT) != 0) Nd = NINT((Tmax - Tmin)/dT) + 1;
- else if (Tmin) Nd = 1;
-
- if (verbose) {
- samess("Number of shot positions to generate = %d", Ns);
- samess("For every shot postion %d depth positions", Nd);
- samess("orig of model (x, z) = %.2f, %.2f", ox, oz);
- }
-
- ndim = (struct i_xyz *)jm_alloc(1,sizeof(struct i_xyz),1);
- ndim->z = nz; ndim->y = 1; ndim->x = nx;
- scale.x = dx; scale.y = 0.; scale.z = dz;
- nd = nz*nx;
-
-/*---------------------------------------------------------------------------*
- * If not finite difference method, allocate traveltime mask array(candidate).
- *---------------------------------------------------------------------------
- * Allocate the traveltime asrray.
- * If graph method, allocate the raypath and stencil arrays.
- *---------------------------------------------------------------------------*/
-
- candidate = (uint8 *)NULL;
- ttime = (float32 *)jm_alloc(nd, sizeof(float32), 0);
-
- if(equal(method,"graph")) {
- candidate = (uint8 *)jm_alloc(nd, sizeof(uint8), 0);
- raypath = (int *)jm_alloc(nd, sizeof(int), 0);
- stencil = make_stencil(order, ndim, &scale);
- }
-
-/* ============ Initializations =============== */
-
-/*---------------------------------------------------------------------------*
- * Input the source locations.
- * and
- * Initialize the traveltime array. Place t=0 @ source position.
- *---------------------------------------------------------------------------*/
-
- if (add) {
- data = alloc2float(nrec, 1);
- isrc = (struct i_xyz *)jm_alloc(Ns*Nd+1,sizeof(struct i_xyz),1);
- zsrc = alloc1float(Nd);
- for(id=0, ttime_p=ttime; id<nd; id++, ttime_p++)
- *ttime_p = Infinity;
-
- ie = 0;
- for (is = 0; is < Ns; is++) {
- xsrc = xsrc1 + is*dxsrc - ox;
- for (id = 0; id < Nd; id++) {
- zsrc[id] = setzsrc(nb,boundary,inter,slowness_S,ni,zsrc1,dzsrc,
- dz,oz,nx,nz,xsrc,dx,ox,id,verbose);
-
- isrc[ie].x = NINT(xsrc/dx);
- isrc[ie].y = 0;
- isrc[ie].z = NINT(zsrc[id]/dz);
- node_src = isrc[ie].z*nx + isrc[ie].x;
- sx = isrc[ie].x*dx-xsrc;
- sz = isrc[ie].z*dz-zsrc[id];
- sign = -1;
- if (sz < 0) sign = 1;
- ttime[node_src] = sign*sqrt(sx*sx+sz*sz)*slowness[node_src];
- if((isrc[ie].x > nx-1) || (isrc[ie].x < 0) ||
- (isrc[ie].z > nz-1) || (isrc[ie].z < 0))
- { saerr("source %d out of bounds ix=%d iz=%d", ie, isrc[ie].x, isrc[ie].z); }
- ie++;
- }
- }
- Ns = 1;
- Nd = 1;
- }
- else {
- data = alloc2float(nrec, Nd);
- isrc = (struct i_xyz *)jm_alloc(2,sizeof(struct i_xyz),1);
- zsrc = alloc1float(Nd);
- }
-
-/* ============ Initializations (2) =============== */
-
- if(!getparfloat("dxrcv",&dxrcv)) dxrcv = dx;
- if(!getparfloat("dzrcv",&dzrcv)) dzrcv = 0;
- drcv = sqrt(dxrcv*dxrcv+dzrcv*dzrcv);
- keys[0] = (char *) malloc(MAX_KEY_LENGTH);
- nkeys = 1;
- keys[0] = SA_OPER;
- seqnr[0] = 1;
- type = SA_TYPE_REAL;
- dom1 = SA_AXIS_X;
- if (dT > 0) dom2 = SA_AXIS_TIME;
- else dom2 = SA_AXIS_Z;
- if (file_ray != NULL) {
- ircv = (struct i_xyz *)jm_alloc(nrec+1,sizeof(struct i_xyz),1);
- }
- if (head == 0) {
- trueslow = alloc1float(nd);
- for (k = 0; k < nd; k++) trueslow[k] = slowness[k];
- }
-
- if (file_amp != NULL) {
- ret = open_file(file_amp, GUESS_TYPE, DELPHI_CREATE);
- if (ret < 0 ) saerr("error in creating output file %s", file_amp);
- }
- ret = open_file(file_out, GUESS_TYPE, DELPHI_CREATE);
- if (ret < 0 ) saerr("error in creating output file %s", file_out);
-
-/*---------------------------------------------------------------------------*
- * Compute traveltimes and (if applicable) raypaths.
- *---------------------------------------------------------------------------*/
-
- for (is = 0; is < Ns; is++) {
- xsrc = xsrc1 + is*dxsrc - ox;
- if (verbose) samess("**** gather %d ****", is+1);
-
- for (id = 0, ib=0; id < Nd; id++) {
- if (nb) {
- if (inter[boundary[id]-1][NINT(xsrc/dx)] == 0) continue;
- }
- zsrc[ib] = setzsrc(nb,boundary,inter,slowness_S,ni,zsrc1,dzsrc,dz,
- oz,nx,nz,xsrc,dx,ox,id,verbose);
- if (verbose) samess("xsrc = %f zsrc = %f", xsrc+ox, zsrc[ib]+oz);
-
- if (!add) {
- for(i=0, ttime_p=ttime; i<nd; i++, ttime_p++)
- *ttime_p = Infinity;
-
- isrc[0].x = NINT(xsrc/dx);
- isrc[0].y = 0;
- isrc[0].z = NINT(zsrc[ib]/dz);
- if((isrc[0].x > nx-1) || (isrc[0].x < 0) ||
- (isrc[0].z > nz-1) || (isrc[0].z < 0)) {
- { saerr("source %d out of bounds ix=%d iz=%d", is, isrc[is].x, isrc[is].z); }
- }
- node_src = isrc[0].z*nx + isrc[0].x;
- sx = isrc[0].x*dx-xsrc;
- sz = isrc[0].z*dz-zsrc[ib];
- sign = -1;
- if (sz < 0) sign = 1;
- ttime[node_src] = sign*sqrt(sx*sx+sz*sz)*slowness[node_src];
-
- if(equal(method,"plane")) {
- iz_min = max2(0,isrc[0].z-radius);
- iz_max = min2(ndim->z-1,isrc[0].z+radius);
- ix_min = max2(0,isrc[0].x-radius);
- ix_max = min2(ndim->x-1,isrc[0].x+radius);
-
- node_src = isrc[0].z*ndim->x + isrc[0].x;
- slow_src = slowness[node_src];
- for(iz=iz_min;iz<=iz_max;iz++) {
- idz = iz - isrc[0].z;
- for(ix=ix_min;ix<=ix_max;ix++) {
- idx = ix - isrc[0].x;
- idp = iz*ndim->x + ix;
- ttime[idp] = 0.5 * scale.x * sqrt(1.*idx*idx +
- idz*idz) * (slow_src + slowness[idp]);
- }
- }
- }
-
- /*=== avoid calculation of head waves from below zsrc ===*/
- if (head == 0) {
- ndim->z = nz;
- for (k = 0; k < nd; k++) slowness[k] = trueslow[k];
- rm_head(slowness,ndim,isrc,mzrcv,&scale,inter,ni,&nzm);
- ndim->z = MAX(nzm,2);
- }
-
- }
-
- t1 = cputime();
-
- if(equal(method,"plane")) {
- plane_wave(ttime,slowness,(char *)candidate,ndim,
- scale.x,order);
- }
- else if(equal(method,"fd")) {
- vidale(ttime,slowness,ndim,isrc,&scale,sbox);
- }
- else if(equal(method,"graph")) {
- dijkstra(ttime,slowness,(char *)candidate,raypath,ndim,
- order,0,stencil);
- }
-
- t2 = cputime();
- if (verbose>=3)
- samess("CPU-time computing traveltimes = %.2f s",t2-t1);
-
- for (ir = 0; ir < nrec; ir++) {
- ik = xi[ir] + is*ispr;
- data[ib][ir] = ttime[zi[ir]*nx+ik];
- }
-
- if(equal(method,"graph") && (file_ray != NULL)) {
- sprintf(file_base, "%s_s%02dd%02d.eps", file_ray, is+1, id+1);
-
- for(ir=0;ir<nrec;ir++) {
- ircv[ir].x = xi[ir];
- ircv[ir].y = 0;
- ircv[ir].z = zi[ir];
- }
- draw_rays(file_base,raypath,ircv,nx,nz,slowness,dx,dz,nrec,
- inter,ni,hom,verbose);
- if(verbose>=2)
- samess("finished plotting raypaths in postscript file %s", file_base);
- }
- ib++;
- }
- Nb = ib;
-
-/* ================ write to output file ================*/
-
- hdrs = (segyhdr *) malloc(Nd*sizeof(segyhdr));
- f1 = xi[0]*dx + ox;
- f2 = zsrc1;
- d2 = dxsrc;
- if (nb) f2 = 1.0;
- if (onegath) seqnr[0] = 1;
- else seqnr[0] = is+1;
-
- gen_hdrs(hdrs,nrec,Nd,f1,f2,drcv,dzsrc,TRID_ZX);
- for (i = 0; i < Nb; i++) {
- hdrs[i].scalco = -1000;
- hdrs[i].scalel = -1000;
- hdrs[i].offset = NINT(xi[0]*dx + is*ispr*dx - xsrc);
- hdrs[i].sx = NINT((xsrc+ox)*1000.0);
- hdrs[i].sdepth = NINT((zsrc[i]+oz)*1000.0);
- if (onegath) {
- hdrs[i].fldr = 1;
- hdrs[i].trwf = Ns*Nd;
- }
- else {
- hdrs[i].fldr = is+1;
- hdrs[i].trwf = Nd;
- }
- }
-
- ret = set_keys(keys, seqnr, nkeys);
- if (ret < 0 ) sawarn("error on writing keys.");
- ret = set_axis(dom1, dom2);
- if (ret < 0 ) saerr("error on writing axis.");
-
- if (verbose>1) disp_info(file_out,nrec,Nb,f1,f2,drcv,dzsrc,type);
- ret = write_data(file_out,*data,nrec,Nb,f1,f2,
- drcv,dzsrc,type,hdrs);
- if (ret < 0 ) saerr("error on writing output file.");
-
- free(hdrs);
-
- if (file_amp != NULL) {
- hdrs = (segyhdr *) malloc(Nd*sizeof(segyhdr));
- f1 = xi[0]*dx + ox;
- f2 = zsrc1;
- d2 = dxsrc;
- if (nb) f2 = 1.0;
- if (onegath) seqnr[0] = 1;
- else seqnr[0] = is+1;
-
- gen_hdrs(hdrs,nrec,Nd,f1,f2,drcv,dzsrc,TRID_ZX);
- for (i = 0; i < Nb; i++) {
- hdrs[i].scalco = -1000;
- hdrs[i].scalel = -1000;
- hdrs[i].offset = NINT(xi[0]*dx + is*ispr*dx - xsrc);
- hdrs[i].sx = NINT((xsrc+ox)*1000.0);
- hdrs[i].sdepth = NINT((zsrc[i]+oz)*1000.0);
- if (onegath) {
- hdrs[i].fldr = 1;
- hdrs[i].trwf = Ns*Nd;
- }
- else {
- hdrs[i].fldr = is+1;
- hdrs[i].trwf = Nd;
- }
- for (ir = 0; ir < nrec; ir++) {
- x = xsrc - (xi[ir] + is*ispr)*dx;
- z = zsrc[i] - (zi[ir] + is*ispr)*dzrcv;
- r = sqrt(x*x+z*z); /* cos(phi) = z/r */
- if (r != 0) data[i][ir] = fabs(z)/(r*sqrt(r));
- else data[i][ir] = 1.0;
- }
-
- }
-
- ret = set_keys(keys, seqnr, nkeys);
- if (ret < 0 ) sawarn("error on writing keys.");
- ret = set_axis(dom1, dom2);
- if (ret < 0 ) saerr("error on writing axis.");
- ret = write_data(file_amp,*data,nrec,Nb,f1,f2,
- drcv,dzsrc,type,hdrs);
- if (ret < 0 ) saerr("error on writing output file.");
-
- free(hdrs);
- }
- }
-
-/*---------------------------------------------------------------------------*
- * Output traveltime array to a file.
- *---------------------------------------------------------------------------*/
-
- ret = close_file(file_out);
- if (ret < 0) saerr("err %d on closing output file",ret);
- if (file_amp != NULL) {
- ret = close_file(file_amp);
- if (ret < 0) saerr("err %d on closing output file",ret);
- }
-
- t1 = cputime();
- if (verbose) samess("Total CPU-time = %f",t1-t0);
-
- return(0);
-}
diff --git a/raytime3d/Makefile b/raytime3d/Makefile
new file mode 100644
index 0000000000000000000000000000000000000000..a71b7a36a1a2cd6c4cf0927efaad5e231d10e9e3
--- /dev/null
+++ b/raytime3d/Makefile
@@ -0,0 +1,72 @@
+# Makefile
+
+include ../Make_include
+
+########################################################################
+# define general include and system library
+ALLINC = -I.
+#LIBS += -L$L -lgenfft -lm $(LIBSM)
+#LIBS += -L$L -lgenfft -lm -lc
+#OPTC = -g -Wall -fsignaling-nans -O0
+#OPTC += -fopenmp -Waddress
+#OPTC += -g -O0
+#OPTC := $(subst -O3 -ffast-math, -O1 -g ,$(OPTC))
+#PGI options for compiler feedback
+#OPTC += -Mprof=lines
+#LDFLAGS += -Mprof=lines
+
+# side.c \
+# corner.c \
+# near_source.c \
+# Grid2Time1.c \
+
+all: raytime3d
+
+PRG = raytime3d
+
+SRCC = $(PRG).c \
+ vidale3d.c \
+ src3d.c \
+ getParameters3d.c \
+ getWaveletInfo.c \
+ writeSrcRecPos.c \
+ readModel3d.c \
+ getWaveletHeaders.c \
+ verbosepkg.c \
+ getModelInfo3d.c \
+ wallclock_time.c \
+ recvPar3d.c \
+ writesufile.c \
+ name_ext.c \
+ atopkge.c \
+ docpkge.c \
+ threadAffinity.c \
+ getpars.c
+
+OBJC = $(SRCC:%.c=%.o)
+
+$(PRG): $(OBJC) raytime3d.h
+ $(CC) $(LDFLAGS) $(CFLAGS) $(OPTC) -o raytime3d $(OBJC) $(LIBS)
+
+install: raytime3d
+ cp raytime3d $B
+
+clean:
+ rm -f core $(OBJC) $(OBJM) raytime3d
+
+realclean:
+ rm -f core $(OBJC) $(OBJM) $(PRG) $B/raytime3d
+
+
+print: Makefile $(SRC)
+ $(PRINT) $?
+ @touch print
+
+count:
+ @wc $(SRC)
+
+tar:
+ @tar cf $(PRG).tar Makefile $(SRC) && compress $(PRG).tar
+
+
+
diff --git a/raytime3d/SUsegy.h b/raytime3d/SUsegy.h
new file mode 100644
index 0000000000000000000000000000000000000000..a9133b999320911b29505909c2e4cd5f33b83dc5
--- /dev/null
+++ b/raytime3d/SUsegy.h
@@ -0,0 +1,391 @@
+/* This file is property of the Colorado School of Mines.
+
+ Copyright © 2007, Colorado School of Mines,
+ All rights reserved.
+
+
+ Redistribution and use in source and binary forms, with or
+ without modification, are permitted provided that the following
+ conditions are met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above
+ copyright notice, this list of conditions and the following
+ disclaimer in the documentation and/or other materials provided
+ with the distribution.
+ * Neither the name of the Colorado School of Mines nor the names of
+ its contributors may be used to endorse or promote products
+ derived from this software without specific prior written permission.
+
+ Warranty Disclaimer:
+ THIS SOFTWARE IS PROVIDED BY THE COLORADO SCHOOL OF MINES AND CONTRIBUTORS
+ "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+ FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+ COLORADO SCHOOL OF MINES OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+ INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+ BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+ LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+ CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+ STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING
+ IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ POSSIBILITY OF SUCH DAMAGE.
+
+
+ Export Restriction Disclaimer:
+ We believe that CWP/SU: Seismic Un*x is a low technology product that does
+ not appear on the Department of Commerce CCL list of restricted exports.
+ Accordingly, we believe that our product meets the qualifications of
+ an ECCN (export control classification number) of EAR99 and we believe
+ it fits the qualifications of NRR (no restrictions required), and
+ is thus not subject to export restrictions of any variety.
+
+ Approved Reference Format:
+ In publications, please refer to SU as per the following example:
+ Cohen, J. K. and Stockwell, Jr. J. W., (200_), CWP/SU: Seismic Un*x
+ Release No. __: an open source software package for seismic
+ research and processing,
+ Center for Wave Phenomena, Colorado School of Mines.
+
+ Articles about SU in peer-reviewed journals:
+ Saeki, T., (1999), A guide to Seismic Un*x (SU)(2)---examples of data processing (part 1), data input and preparation of headers, Butsuri-Tansa (Geophysical Exploration), vol. 52, no. 5, 465-477.
+ Stockwell, Jr. J. W. (1999), The CWP/SU: Seismic Un*x Package, Computers and Geosciences, May 1999.
+ Stockwell, Jr. J. W. (1997), Free Software in Education: A case study of CWP/SU: Seismic Un*x, The Leading Edge, July 1997.
+ Templeton, M. E., Gough, C.A., (1998), Web Seismic Un*x: Making seismic reflection processing more accessible, Computers and Geosciences.
+
+ Acknowledgements:
+ SU stands for CWP/SU:Seismic Un*x, a processing line developed at Colorado
+ School of Mines, partially based on Stanford Exploration Project (SEP)
+ software.
+ */
+
+/* segy.h - include file for SEGY traces
+ *
+ * declarations for:
+ * typedef struct {} segy - the trace identification header
+ * typedef struct {} bhed - binary header
+ *
+ * Note:
+ * If header words are added, run the makefile in this directory
+ * to recreate hdr.h.
+ *
+ * Reference:
+ * K. M. Barry, D. A. Cavers and C. W. Kneale, "Special Report:
+ * Recommended Standards for Digital Tape Formats",
+ * Geophysics, vol. 40, no. 2 (April 1975), P. 344-352.
+ *
+ * $Author: john $
+ * $Source: /usr/local/cwp/src/su/include/RCS/segy.h,v $
+ * $Revision: 1.23 $ ; $Date: 1998/03/26 23:48:18 $
+ */
+
+/* #define SU_NFLTS 800000 Arbitrary limit on data array size */
+
+/**
+* This segyhdr has been redefined and uses an integer (32 bit) for number of samples (ns)
+* Jan Thorbecke
+**/
+
+
+/* TYPEDEFS */
+typedef struct { /* segy - trace identification header */
+
+ int tracl; /* trace sequence number within line */
+
+ int tracr; /* trace sequence number within reel */
+
+ int fldr; /* field record number */
+
+ int tracf; /* trace number within field record */
+
+ int ep; /* energy source point number */
+
+ int cdp; /* CDP ensemble number */
+
+ int cdpt; /* trace number within CDP ensemble */
+
+ short trid; /* trace identification code:
+ 1 = seismic data
+ 2 = dead
+ 3 = dummy
+ 4 = time break
+ 5 = uphole
+ 6 = sweep
+ 7 = timing
+ 8 = water break
+ 9---, N = optional use (N = 32,767)
+
+ Following are CWP id flags:
+
+ 9 = autocorrelation
+
+ 10 = Fourier transformed - no packing
+ xr[0],xi[0], ..., xr[N-1],xi[N-1]
+
+ 11 = Fourier transformed - unpacked Nyquist
+ xr[0],xi[0],...,xr[N/2],xi[N/2]
+
+ 12 = Fourier transformed - packed Nyquist
+ even N:
+ xr[0],xr[N/2],xr[1],xi[1], ...,
+ xr[N/2 -1],xi[N/2 -1]
+ (note the exceptional second entry)
+ odd N:
+ xr[0],xr[(N-1)/2],xr[1],xi[1], ...,
+ xr[(N-1)/2 -1],xi[(N-1)/2 -1],xi[(N-1)/2]
+ (note the exceptional second & last entries)
+
+ 13 = Complex signal in the time domain
+ xr[0],xi[0], ..., xr[N-1],xi[N-1]
+
+ 14 = Fourier transformed - amplitude/phase
+ a[0],p[0], ..., a[N-1],p[N-1]
+
+ 15 = Complex time signal - amplitude/phase
+ a[0],p[0], ..., a[N-1],p[N-1]
+
+ 16 = Real part of complex trace from 0 to Nyquist
+
+ 17 = Imag part of complex trace from 0 to Nyquist
+
+ 18 = Amplitude of complex trace from 0 to Nyquist
+
+ 19 = Phase of complex trace from 0 to Nyquist
+
+ 21 = Wavenumber time domain (k-t)
+
+ 22 = Wavenumber frequency (k-omega)
+
+ 23 = Envelope of the complex time trace
+
+ 24 = Phase of the complex time trace
+
+ 25 = Frequency of the complex time trace
+
+ 30 = Depth-Range (z-x) traces
+
+ 43 = Seismic Data, Vertical Component
+
+ 44 = Seismic Data, Horizontal Component 1
+
+ 45 = Seismic Data, Horizontal Component 2
+
+ 46 = Seismic Data, Radial Component
+
+ 47 = Seismic Data, Transverse Component
+
+ 101 = Seismic data packed to bytes (by supack1)
+
+ 102 = Seismic data packed to 2 bytes (by supack2)
+ */
+
+ short nvs; /* number of vertically summed traces (see vscode
+ in bhed structure) */
+
+ short nhs; /* number of horizontally summed traces (see vscode
+ in bhed structure) */
+
+ short duse; /* data use:
+ 1 = production
+ 2 = test */
+
+ int offset; /* distance from source point to receiver
+ group (negative if opposite to direction
+ in which the line was shot) */
+
+ int gelev; /* receiver group elevation from sea level
+ (above sea level is positive) */
+
+ int selev; /* source elevation from sea level
+ (above sea level is positive) */
+
+ int sdepth; /* source depth (positive) */
+
+ int gdel; /* datum elevation at receiver group */
+
+ int sdel; /* datum elevation at source */
+
+ int swdep; /* water depth at source */
+
+ int gwdep; /* water depth at receiver group */
+
+ short scalel; /* scale factor for previous 7 entries
+ with value plus or minus 10 to the
+ power 0, 1, 2, 3, or 4 (if positive,
+ multiply, if negative divide) */
+
+ short scalco; /* scale factor for next 4 entries
+ with value plus or minus 10 to the
+ power 0, 1, 2, 3, or 4 (if positive,
+ multiply, if negative divide) */
+
+ int sx; /* X source coordinate */
+
+ int sy; /* Y source coordinate */
+
+ int gx; /* X group coordinate */
+
+ int gy; /* Y group coordinate */
+
+ short counit; /* coordinate units code:
+ for previous four entries
+ 1 = length (meters or feet)
+ 2 = seconds of arc (in this case, the
+ X values are longitude and the Y values
+ are latitude, a positive value designates
+ the number of seconds east of Greenwich
+ or north of the equator */
+
+ short wevel; /* weathering velocity */
+
+ short swevel; /* subweathering velocity */
+
+ short sut; /* uphole time at source */
+
+ short gut; /* uphole time at receiver group */
+
+ short sstat; /* source static correction */
+
+ short gstat; /* group static correction */
+
+ short tstat; /* total static applied */
+
+ short laga; /* lag time A, time in ms between end of 240-
+ byte trace identification header and time
+ break, positive if time break occurs after
+ end of header, time break is defined as
+ the initiation pulse which maybe recorded
+ on an auxiliary trace or as otherwise
+ specified by the recording system */
+
+ short lagb; /* lag time B, time in ms between the time break
+ and the initiation time of the energy source,
+ may be positive or negative */
+
+ short delrt; /* delay recording time, time in ms between
+ initiation time of energy source and time
+ when recording of data samples begins
+ (for deep water work if recording does not
+ start at zero time) */
+
+ short muts; /* mute time--start */
+
+ short mute; /* mute time--end */
+
+ short igc; /* instrument gain constant */
+
+ int ns; /* number of samples in this trace */
+
+ unsigned short dt; /* sample interval; in micro-seconds */
+
+ short gain; /* gain type of field instruments code:
+ 1 = fixed
+ 2 = binary
+ 3 = floating point
+ 4 ---- N = optional use */
+
+ short igi; /* instrument early or initial gain */
+
+ short corr; /* correlated:
+ 1 = no
+ 2 = yes */
+
+ short sfs; /* sweep frequency at start */
+
+ short sfe; /* sweep frequency at end */
+
+ short slen; /* sweep length in ms */
+
+ short styp; /* sweep type code:
+ 1 = linear
+ 2 = cos-squared
+ 3 = other */
+
+ short stas; /* sweep trace length at start in ms */
+
+ short stae; /* sweep trace length at end in ms */
+
+ short tatyp; /* taper type: 1=linear, 2=cos^2, 3=other */
+
+ short afilf; /* alias filter frequency if used */
+
+ short afils; /* alias filter slope */
+
+ short nofilf; /* notch filter frequency if used */
+
+ short nofils; /* notch filter slope */
+
+ short lcf; /* low cut frequency if used */
+
+ short hcf; /* high cut frequncy if used */
+
+ short lcs; /* low cut slope */
+
+ short hcs; /* high cut slope */
+
+ short year; /* year data recorded */
+
+ short day; /* day of year */
+
+ short hour; /* hour of day (24 hour clock) */
+
+ short minute; /* minute of hour */
+
+ short sec; /* second of minute */
+
+ short timbas; /* time basis code:
+ 1 = local
+ 2 = GMT
+ 3 = other */
+
+ short trwf; /* trace weighting factor, defined as 1/2^N
+ volts for the least sigificant bit */
+
+ short grnors; /* geophone group number of roll switch
+ position one */
+
+ short grnofr; /* geophone group number of trace one within
+ original field record */
+
+ short grnlof; /* geophone group number of last trace within
+ original field record */
+
+ short gaps; /* gap size (total number of groups dropped) */
+
+ short otrav; /* overtravel taper code:
+ 1 = down (or behind)
+ 2 = up (or ahead) */
+
+ /* local assignments */
+
+ short mark; /* mark selected traces */
+
+ float d1; /* sample spacing for non-seismic data */
+
+ float f1; /* first sample location for non-seismic data */
+
+ float d2; /* sample spacing between traces */
+
+ float f2; /* first trace location */
+
+ float ungpow; /* negative of power used for dynamic
+ range compression */
+
+ float unscale; /* reciprocal of scaling factor to normalize
+ range */
+
+ int ntr; /* number of traces */
+
+/* short shortpad; alignment padding */
+
+ short unass[14]; /* unassigned--NOTE: last entry causes
+ a break in the word alignment, if we REALLY
+ want to maintain 240 bytes, the following
+ entry should be an odd number of short/UINT2
+ OR do the insertion above the "mark" keyword
+ entry */
+
+} SUsegy;
+
+
diff --git a/raytime3d/atopkge.c b/raytime3d/atopkge.c
new file mode 100644
index 0000000000000000000000000000000000000000..ef0b21803a52fb2ee021b6d73938d44bcefb0f92
--- /dev/null
+++ b/raytime3d/atopkge.c
@@ -0,0 +1,444 @@
+/*
+
+ This file is property of the Colorado School of Mines.
+
+ Copyright (C) 2007, Colorado School of Mines,
+ All rights reserved.
+
+
+ Redistribution and use in source and binary forms, with or
+ without modification, are permitted provided that the following
+ conditions are met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above
+ copyright notice, this list of conditions and the following
+ disclaimer in the documentation and/or other materials provided
+ with the distribution.
+ * Neither the name of the Colorado School of Mines nor the names of
+ its contributors may be used to endorse or promote products
+ derived from this software without specific prior written permission.
+
+ Warranty Disclaimer:
+ THIS SOFTWARE IS PROVIDED BY THE COLORADO SCHOOL OF MINES AND CONTRIBUTORS
+ "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+ FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+ COLORADO SCHOOL OF MINES OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+ INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+ BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+ LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+ CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+ STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING
+ IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ POSSIBILITY OF SUCH DAMAGE.
+
+
+ Export Restriction Disclaimer:
+ We believe that CWP/SU: Seismic Un*x is a low technology product that does
+ not appear on the Department of Commerce CCL list of restricted exports.
+ Accordingly, we believe that our product meets the qualifications of
+ an ECCN (export control classification number) of EAR99 and we believe
+ it fits the qualifications of NRR (no restrictions required), and
+ is thus not subject to export restrictions of any variety.
+
+ Approved Reference Format:
+ In publications, please refer to SU as per the following example:
+ Cohen, J. K. and Stockwell, Jr. J. W., (200_), CWP/SU: Seismic Un*x
+ Release No. __: an open source software package for seismic
+ research and processing,
+ Center for Wave Phenomena, Colorado School of Mines.
+
+ Articles about SU in peer-reviewed journals:
+ Saeki, T., (1999), A guide to Seismic Un*x (SU)(2)---examples of data processing (part 1), data input and preparation of headers, Butsuri-Tansa (Geophysical Exploration), vol. 52, no. 5, 465-477.
+ Stockwell, Jr. J. W. (1999), The CWP/SU: Seismic Un*x Package, Computers and Geosciences, May 1999.
+ Stockwell, Jr. J. W. (1997), Free Software in Education: A case study of CWP/SU: Seismic Un*x, The Leading Edge, July 1997.
+ Templeton, M. E., Gough, C.A., (1998), Web Seismic Un*x: Making seismic reflection processing more accessible, Computers and Geosciences.
+
+ Acknowledgements:
+ SU stands for CWP/SU:Seismic Un*x, a processing line developed at Colorado
+ School of Mines, partially based on Stanford Exploration Project (SEP)
+ software.
+ */
+
+/*********************** self documentation **********************/
+/***************************************************************************
+ATOPKGE - convert ascii to arithmetic and with error checking
+
+
+eatoh ascii to short
+eatou ascii to unsigned short
+eatoi ascii to int
+eatop ascii to unsigned
+eatol ascii to long
+eatov ascii to unsigned long
+eatof ascii to float
+eatod ascii to double
+
+****************************************************************************
+Function Prototypes:
+short eatoh(char *s);
+unsigned short eatou(char *s);
+int eatoi(char *s);
+unsigned int eatop(char *s);
+long eatol(char *s);
+unsigned long eatov(char *s);
+float eatof(char *s);
+double eatod(char *s);
+
+****************************************************************************
+Input:
+s string
+
+Returned: type indicated
+
+****************************************************************************
+Notes:
+Each of these routines acts like atoi, but has error checking:
+
+This is a major revision of the tedious code required before
+vendors implemented the ANSI C strtol, strtoul and strtod.
+
+In addition to the size checks for each integer type, a
+specific test on errno is required. For example, INT_MAX
+may (and probably does) equal LONG_MAX. In this case,
+if fed a number exceeding INT_MAX (and LONG_MAX), strtol
+will make a quiet return with the wrong answer and it is up
+to the user to check if errno == ERANGE.
+
+Size limits are machine dependent and are read from the
+ANSI C include files limits.h and float.h.
+
+Bug Report: With NeXT c and Gnucc, when x > DBL_MAX (x <-DBL_MAX),
+the return value from strtod was +Infinity (-Infinity), not HUGE_VAL
+and more important, errno was not set to ERANGE. To cope with this,
+I put explicit size checks in eatod (which would not be needed if
+errno were set as it should be in ANSI C. jkc 01/29/94
+
+On IBM RS6000, the return value from strtod was +-Inf on
+overflow, but errno was set correctly.
+
+****************************************************************************
+References:
+For old code:
+Plum: Reliable Data Structures in C, p. 2-17.
+Kernighan and Ritchie: The C Programming Language, p. 58.
+
+CWP: Jack K. Cohen, Brian Sumner
+
+For new code:
+ANSI C routines with a little help from Jack
+
+****************************************************************************
+Author: Jack Cohen, Center for Wave Phenomena, 1994.
+***************************************************************************/
+/**************** end self doc ********************************/
+
+#include "par.h"
+#include <float.h>
+#include <limits.h>
+#include <stdarg.h>
+#include <errno.h>
+
+/* eatoh - convert string s to short integer {SHRT_MIN:SHRT_MAX} */
+short eatoh(char *s)
+{
+ long n = strtol(s, NULL, 10);
+
+ if ( (n > SHRT_MAX) || (n < SHRT_MIN) || (errno == ERANGE) )
+ err("%s: eatoh: overflow", __FILE__);
+
+ return (short) n;
+}
+
+
+/* eatou - convert string s to unsigned short integer {0:USHRT_MAX} */
+unsigned short eatou(char *s)
+{
+ unsigned long n = strtoul(s, NULL, 10);
+
+ if ( (n > USHRT_MAX) || (errno == ERANGE) )
+ err("%s: eatou: overflow", __FILE__);
+
+ return (unsigned short) n;
+}
+
+
+/* eatoi - convert string s to integer {INT_MIN:INT_MAX} */
+int eatoi(char *s)
+{
+ long n = strtol(s, NULL, 10);
+
+ if ( (n > INT_MAX) || (n < INT_MIN) || (errno == ERANGE) )
+ err("%s: eatoi: overflow", __FILE__);
+
+ return (int) n;
+}
+
+
+/* eatop - convert string s to unsigned integer {0:UINT_MAX} */
+unsigned int eatop(char *s)
+{
+ unsigned long n = strtoul(s, NULL, 10);
+
+ if ( (n > UINT_MAX) || (errno == ERANGE) )
+ err("%s: eatop: overflow", __FILE__);
+
+ return (unsigned int) n;
+}
+
+
+/* eatol - convert string s to long integer {LONG_MIN:LONG_MAX} */
+long eatol(char *s)
+{
+ long n = strtol(s, NULL, 10);
+
+ if (errno == ERANGE)
+ err("%s: eatol: overflow", __FILE__);
+
+ return n;
+}
+
+
+/* eatov - convert string s to unsigned long {0:ULONG_MAX} */
+unsigned long eatov(char *s)
+{
+ unsigned long n = strtoul(s, NULL, 10);
+
+ if (errno == ERANGE)
+ err("%s: eatov: overflow", __FILE__);
+
+ return n;
+}
+
+
+/* eatof - convert string s to float {-FLT_MAX:FLT_MAX} */
+float eatof(char *s)
+{
+ float x = strtod(s, NULL);
+
+ if ( (x > FLT_MAX) || (x < -FLT_MAX) || (errno == ERANGE) )
+ err("%s: eatof: overflow", __FILE__);
+
+ return (float) x;
+}
+
+
+/* eatod - convert string s to double {-DBL_MAX:DBL_MAX} */
+double eatod(char *s)
+{
+ double x = strtod(s, NULL);
+
+ /* errno == ERANGE suffices if compiler sets errno on overflow */
+ if ( (errno == ERANGE) || (x > DBL_MAX) || (x < -DBL_MAX) )
+ err("%s: eatod: overflow", __FILE__);
+
+ return x;
+}
+
+
+/**************************************************************************
+ERRPKGE - routines for reporting errors
+
+err print warning on application program error and die
+warn print warning on application program error
+syserr print warning on application program error using errno and die
+
+***************************************************************************
+Function Prototypes:
+void err (char *fmt, ...);
+void warn (char *fmt, ...);
+void syserr (char *fmt, ...);
+
+***************************************************************************
+Return: void
+
+***************************************************************************
+Notes:
+fmt a printf format string ("\n" not needed)
+... the variables referenced in the format string
+
+Examples:
+ err("Cannot divide %f by %f", x, y);
+ warn("fmax = %f exceeds half nyquist= %f", fmax, 0.25/dt);
+
+ if (NULL == (fp = fopen(xargv[1], "r")))
+ err("can't open %s", xargv[1]);
+ ...
+ if (-1 == close(fd))
+ err("close failed");
+
+***************************************************************************
+References:
+Kernighan and Pike, "The UNIX Programming Environment", page 207.
+Also Rochkind, "Advanced UNIX Programming", page 13.
+
+***************************************************************************
+Authors:SEP: Jeff Thorson, Stew Levin CWP: Shuki Ronen, Jack Cohen
+**************************************************************************/
+
+
+void err(char *fmt, ...)
+{
+ va_list args;
+
+
+ if (EOF == fflush(stdout)) {
+ fprintf(stderr, "\nerr: fflush failed on stdout");
+ }
+ fprintf(stderr, "\n%s: ", xargv[0]);
+ va_start(args,fmt);
+ vfprintf(stderr, fmt, args);
+ va_end(args);
+ fprintf(stderr, "\n");
+ exit(EXIT_FAILURE);
+}
+
+
+void warn(char *fmt, ...)
+{
+ va_list args;
+
+ if (EOF == fflush(stdout)) {
+ fprintf(stderr, "\nwarn: fflush failed on stdout");
+ }
+ fprintf(stderr, "\n%s: ", xargv[0]);
+ va_start(args,fmt);
+ vfprintf(stderr, fmt, args);
+ va_end(args);
+ fprintf(stderr, "\n");
+ return;
+}
+
+
+void syserr(char *fmt, ...)
+{
+ va_list args;
+
+ if (EOF == fflush(stdout)) {
+ fprintf(stderr, "\nsyserr: fflush failed on stdout");
+ }
+ fprintf(stderr, "\n%s: ", xargv[0]);
+ va_start(args,fmt);
+ vfprintf(stderr, fmt, args);
+ va_end(args);
+ fprintf(stderr, " (%s)\n", strerror(errno));
+ exit(EXIT_FAILURE);
+}
+
+#ifdef TEST
+main(int argc, char **argv)
+{
+ char s[BUFSIZ];
+ short nh;
+ unsigned short nu;
+ int ni;
+ unsigned int np;
+ long nl;
+ unsigned long nv;
+
+ initargs(argc, argv);
+
+
+ /* Test code for eatoh */
+ if (SHRT_MAX == LONG_MAX) {
+ warn("Warning: eatoh not used on this machine.\n");
+ } else {
+ warn("\n");
+ }
+ strcpy(s, "0");
+ nh = eatoh(s);
+ warn("eatoh(%s) = %hd\n", s, nh);
+
+ strcpy(s, "32767");
+ nh = eatoh(s);
+ warn("eatoh(%s) = %hd\n", s, nh);
+
+ strcpy(s, "-32768");
+ nh = eatoh(s);
+ warn("eatoh(%s) = %hd\n", s, nh);
+
+
+ /* Test code for eatou */
+ if (USHRT_MAX == ULONG_MAX) {
+ warn("Warning: eatou not used on this machine.\n");
+ } else {
+ warn("\n");
+ }
+ strcpy(s, "0");
+ nu = eatou(s);
+ warn("eatou(%s) = %hu\n", s, nu);
+
+ strcpy(s, "65535");
+ nu = eatou(s);
+ warn("eatou(%s) = %hu\n", s, nu);
+
+
+ /* Test code for eatoi */
+ if (INT_MAX == LONG_MAX) {
+ warn("Warning: eatoi not used on this machine.\n");
+ } else {
+ warn("\n");
+ }
+ strcpy(s, "0");
+ ni = eatoi(s);
+ warn("eatoi(%s) = %d\n", s, ni);
+
+ strcpy(s, "2147483647");
+ ni = eatoi(s);
+ warn("eatoi(%s) = %d\n", s, ni);
+
+
+ strcpy(s, "-2147483648");
+ ni = eatoi(s);
+ warn("eatoi(%s) = %d\n", s, ni);
+
+
+ /* Test code for eatop */
+ if (INT_MAX == LONG_MAX) {
+ warn("Warning: eatop not used on this machine.\n");
+ } else {
+ warn("\n");
+ }
+ strcpy(s, "0");
+ np = eatop(s);
+ warn("eatop(%s) = %lu\n", s, np);
+
+ strcpy(s, "4294967295");
+ np = eatop(s);
+ warn("eatop(%s) = %lu\n", s, np);
+
+
+ /* Test code for eatol */
+ warn("\n");
+ strcpy(s, "0");
+ nl = eatol(s);
+ warn("eatol(%s) = %ld\n", s, nl);
+
+ strcpy(s, "2147483647");
+ nl = eatol(s);
+ warn("eatol(%s) = %ld\n", s, nl);
+
+ strcpy(s, "-2147483648");
+ nl = eatol(s);
+ warn("eatol(%s) = %ld\n", s, nl);
+
+
+ /* Test code for eatov */
+ strcpy(s, "0");
+ nv = eatov(s);
+ warn("eatov(%s) = %lu\n", s, nv);
+
+ strcpy(s, "4294967295");
+ nv = eatov(s);
+ warn("eatov(%s) = %lu\n", s, nv);
+
+ warn("Now we feed in 4294967296, expecting fatal error exit\n");
+ strcpy(s, "4294967296");
+ nv = eatov(s);
+ warn("eatov(%s) = %lu\n", s, nv);
+
+ return EXIT_SUCCESS;
+}
+#endif
diff --git a/raytime3d/docpkge.c b/raytime3d/docpkge.c
new file mode 100644
index 0000000000000000000000000000000000000000..a74b4c331cbb3c882fd311ef5dacbda776c14e04
--- /dev/null
+++ b/raytime3d/docpkge.c
@@ -0,0 +1,188 @@
+/*
+ This file is property of the Colorado School of Mines.
+
+ Copyright (C) 2007, Colorado School of Mines,
+ All rights reserved.
+
+
+ Redistribution and use in source and binary forms, with or
+ without modification, are permitted provided that the following
+ conditions are met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above
+ copyright notice, this list of conditions and the following
+ disclaimer in the documentation and/or other materials provided
+ with the distribution.
+ * Neither the name of the Colorado School of Mines nor the names of
+ its contributors may be used to endorse or promote products
+ derived from this software without specific prior written permission.
+
+ Warranty Disclaimer:
+ THIS SOFTWARE IS PROVIDED BY THE COLORADO SCHOOL OF MINES AND CONTRIBUTORS
+ "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+ FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+ COLORADO SCHOOL OF MINES OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+ INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+ BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+ LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+ CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+ STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING
+ IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ POSSIBILITY OF SUCH DAMAGE.
+
+
+ Export Restriction Disclaimer:
+ We believe that CWP/SU: Seismic Un*x is a low technology product that does
+ not appear on the Department of Commerce CCL list of restricted exports.
+ Accordingly, we believe that our product meets the qualifications of
+ an ECCN (export control classification number) of EAR99 and we believe
+ it fits the qualifications of NRR (no restrictions required), and
+ is thus not subject to export restrictions of any variety.
+
+ Approved Reference Format:
+ In publications, please refer to SU as per the following example:
+ Cohen, J. K. and Stockwell, Jr. J. W., (200_), CWP/SU: Seismic Un*x
+ Release No. __: an open source software package for seismic
+ research and processing,
+ Center for Wave Phenomena, Colorado School of Mines.
+
+ Articles about SU in peer-reviewed journals:
+ Saeki, T., (1999), A guide to Seismic Un*x (SU)(2)---examples of data processing (part 1), data input and preparation of headers, Butsuri-Tansa (Geophysical Exploration), vol. 52, no. 5, 465-477.
+ Stockwell, Jr. J. W. (1999), The CWP/SU: Seismic Un*x Package, Computers and Geosciences, May 1999.
+ Stockwell, Jr. J. W. (1997), Free Software in Education: A case study of CWP/SU: Seismic Un*x, The Leading Edge, July 1997.
+ Templeton, M. E., Gough, C.A., (1998), Web Seismic Un*x: Making seismic reflection processing more accessible, Computers and Geosciences.
+
+ Acknowledgements:
+ SU stands for CWP/SU:Seismic Un*x, a processing line developed at Colorado
+ School of Mines, partially based on Stanford Exploration Project (SEP)
+ software.
+ */
+
+/*********************** self documentation **********************/
+/***************************************************************************
+DOCPKGE - Function to implement the CWP self-documentation facility
+
+requestdoc give selfdoc on user request (i.e. when name of main is typed)
+pagedoc print self documentation string
+
+****************************************************************************
+Function Prototypes:
+void requestdoc(flag);
+void pagedoc();
+
+****************************************************************************
+requestoc:
+Input:
+flag integer specifying i.o. cases
+
+pagedoc():
+Returns: the self-documentation, an array of strings
+
+****************************************************************************
+Notes:
+requestdoc:
+In the usual case, stdin is used to pass in data. However,
+some programs (eg. synthetic data generators) don't use stdin
+to pass in data and some programs require two or more arguments
+besides the command itself (eg. sudiff) and don't use stdin.
+In this last case, we give selfdoc whenever too few arguments
+are given, since these usages violate the usual SU syntax.
+In all cases, selfdoc can be requested by giving only the
+program name.
+
+The flag argument distinguishes these cases:
+ flag = 0; fully defaulted, no stdin
+ flag = 1; usual case
+ flag = n > 1; no stdin and n extra args required
+
+pagedoc:
+Intended to be called by requesdoc(), but conceivably could be
+used directly as in:
+ if (xargc != 3) selfdoc();
+
+Based on earlier versions by:
+SEP: Einar Kjartansson, Stew Levin CWP: Jack Cohen, Shuki Ronen
+HRC: Lyle
+
+****************************************************************************
+Author: Jack K. Cohen, Center for Wave Phenomena
+****************************************************************************/
+/**************** end self doc ********************************/
+
+#include "par.h"
+
+#ifndef EXIT_FAILURE
+#define EXIT_FAILURE (1)
+#endif
+#ifndef EXIT_SUCCESS
+#define EXIT_SUCCESS (0)
+#endif
+
+
+/* definitions of global variables */
+int xargc; char **xargv;
+
+
+void requestdoc(int flag)
+/***************************************************************************
+print selfdocumentation as directed by the user-specified flag
+****************************************************************************
+Notes:
+In the usual case, stdin is used to pass in data. However,
+some programs (eg. synthetic data generators) don't use stdin
+to pass in data and some programs require two or more arguments
+besides the command itself (eg. sudiff) and don't use stdin.
+In this last case, we give selfdoc whenever too few arguments
+are given, since these usages violate the usual SU syntax.
+In all cases, selfdoc can be requested by giving only the
+program name.
+
+The flag argument distinguishes these cases:
+ flag = 0; fully defaulted, no stdin
+ flag = 1; usual case
+ flag = n > 1; no stdin and n extra args required
+
+pagedoc:
+Intended to be called by pagedoc(), but conceivably could be
+used directly as in:
+ if (xargc != 3) selfdoc();
+
+****************************************************************************
+Authors: Jack Cohen, Center for Wave Phenomena, 1993, based on on earlier
+versions by:
+SEP: Einar Kjartansson, Stew Levin CWP: Jack Cohen, Shuki Ronen
+HRC: Lyle
+****************************************************************************/
+{
+ switch(flag) {
+ case 1:
+ if (xargc == 1 && isatty(STDIN)) pagedoc();
+ break;
+ case 0:
+ if (xargc == 1 && isatty(STDIN) && isatty(STDOUT)) pagedoc();
+ break;
+ default:
+ if (xargc <= flag) pagedoc();
+ break;
+ }
+ return;
+}
+
+
+void pagedoc(void)
+{
+ extern char *sdoc[];
+ char **p = sdoc;
+ FILE *fp;
+
+ fflush(stdout);
+ fp = popen("more -22 1>&2", "w");
+ while(*p) (void)fprintf(fp, "%s\n", *p++);
+ pclose(fp);
+
+ exit(EXIT_FAILURE);
+}
+/*----------------------End of Package--------------------------------*/
diff --git a/raytime3d/getModelInfo3d.c b/raytime3d/getModelInfo3d.c
new file mode 100644
index 0000000000000000000000000000000000000000..000200c5cf3bf2d917cfa892b07618aacc6d0d96
--- /dev/null
+++ b/raytime3d/getModelInfo3d.c
@@ -0,0 +1,125 @@
+#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 getModelInfo3d(char *file_name, int *n1, int *n2, int *n3, float *d1, float *d2, float *d3, float *f1, float *f2, float *f3, int *axis, int verbose)
+{
+ FILE *fp;
+ size_t nread, trace_sz;
+ off_t bytes, pos;
+ int ret, i, one_shot, ntraces, model, i2, i3;
+ float *trace, scl;
+ segy hdr, lasthdr;
+
+ if (file_name == NULL) return;
+
+ 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 );
+ rewind(fp);
+ pos = bytes-hdr.ns*sizeof(float)-TRCBYTES;
+ ret = fseeko( fp, pos, SEEK_SET );
+ if (ret<0) perror("fseeko");
+ nread = fread( &lasthdr, 1, TRCBYTES, fp );
+ assert(nread == TRCBYTES);
+
+ if (hdr.trid == TRID_DEPTH) *axis = 1; /* samples are z-axis */
+ else *axis = 0; /* sample direction respresents the x-axis */
+
+ if (hdr.scalco < 0) scl = 1.0/fabs(hdr.scalco);
+ else if (hdr.scalco == 0) scl = 1.0;
+ else scl = hdr.scalco;
+
+ *n1 = hdr.ns;
+ *d1 = hdr.d1;
+ *d2 = hdr.d2;
+ *f1 = hdr.f1;
+ *f2 = hdr.gx*scl;
+ *f3 = hdr.gy*scl;
+
+ 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 h= to set value");
+ }
+ *d2 = *d1;
+ }
+ trace_sz = sizeof(float)*(*n1)+TRCBYTES;
+ ntraces = (int) (bytes/trace_sz);
+
+ if (ntraces == 1) { /* 1D medium */
+ model = 1;
+ *n2 = 1;
+ *n3 = 1;
+ *d2 = *d1;
+ *d3 = *d1;
+ }
+ else { /* find out if this is a 2D or 3D model */
+ if (hdr.gy == lasthdr.gy) { /* assume 2D model */
+ *n3 = 1;
+ *n2 = ntraces;
+ *d3 = *d1;
+ }
+ else { /* 3D model */
+ /* find the number of traces in the x-direction */
+ rewind(fp);
+ one_shot = 1;
+ i3=0;
+ while (one_shot) {
+ i2=0;
+ lasthdr.gy = hdr.gy;
+ while (hdr.gy == lasthdr.gy) { /* number of samples in x */
+ pos = i2*trace_sz;
+ ret = fseeko( fp, pos, SEEK_SET );
+ nread = fread( &hdr, 1, TRCBYTES, fp );
+ if (nread==0) break;
+ i2++;
+ }
+ fprintf(stderr,"3D model gy=%d %d traces in x = %d\n", lasthdr.gy, i3, i2-1);
+ if (nread==0) break;
+ i3++;
+ }
+ *n3=i3;
+ *n2=ntraces/i3;
+ }
+ }
+
+ if (verbose>2) {
+ vmess("For file %s", file_name);
+ vmess("nz=%d nx=%d ny=%d ", *n1, *n2, *n3);
+ vmess("dz=%f dx=%f *dy=%f", *d1, *d2, *d3);
+ vmess("zstart=%f xstart=%f ystart=%f", *f1, *f2, *f3);
+ if (*axis) vmess("sample represent z-axis\n");
+ else vmess("sample represent x-axis\n");
+ }
+
+
+ return 0;
+}
+
diff --git a/raytime3d/getParameters3d.c b/raytime3d/getParameters3d.c
new file mode 100644
index 0000000000000000000000000000000000000000..10522518777dc64deee8ade8ca0e0f0009936949
--- /dev/null
+++ b/raytime3d/getParameters3d.c
@@ -0,0 +1,347 @@
+#include<stdlib.h>
+#include<stdio.h>
+#include<math.h>
+#include<assert.h>
+#include"par.h"
+#include"raytime3d.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))
+
+/**
+*
+* 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
+**/
+
+int getModelInfo3d(char *file_name, int *n1, int *n2, int *n3, float *d1, float *d2, float *d3, float *f1, float *f2, float *f3, int *axis, int verbose);
+
+int recvPar3d(recPar *rec, float sub_x0, float sub_z0, float sub_y0, float dx, float dz, float dy, int nx, int nz, int ny);
+
+int getParameters3d(modPar *mod, recPar *rec, srcPar *src, shotPar *shot, rayPar *ray, int verbose)
+{
+ int nx, nz, ny, nsrc, ix, iy, axis, is0;
+ int n1, n2, n3;
+ int idzshot, idxshot, idyshot;
+ int src_ix0, src_iz0, src_iy0, src_ix1, src_iz1, src_iy1;
+ float cp_min, cp_max;
+ float sub_x0,sub_z0,sub_y0;
+ float srcendx, srcendz, srcendy, dy, dx, dz;
+ float xsrc, zsrc, ysrc, dxshot, dzshot, dyshot;
+ float dxrcv,dzrcv,dyrcv,dxspread,dzspread,dyspread;
+ float xmax, zmax, ymax;
+ float xsrc1, xsrc2, zsrc1, zsrc2, ysrc1, ysrc2;
+ float *xsrca, *zsrca, *ysrca;
+ float rsrc, oxsrc, ozsrc, oysrc, dphisrc, ncsrc;
+ size_t nsamp;
+ int nxsrc, nzsrc, nysrc;
+ int is;
+ char *src_positions, *file_cp=NULL;
+
+ if (!getparint("verbose",&verbose)) verbose=0;
+
+ if (!getparstring("file_cp", &file_cp)) {
+ vwarn("file_cp not defined, assuming homogeneous model");
+ }
+
+ if (!getparstring("file_rcv",&rec->file_rcv)) rec->file_rcv="recv.su";
+ 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 */
+
+ getModelInfo3d(mod->file_cp, &n1, &n2, &n3, &dz, &dx, &dy, &sub_z0, &sub_x0, &sub_y0, &axis, verbose);
+ mod->dz = dz;
+ mod->dx = dx;
+ mod->dy = dx;
+ mod->nz = nz;
+ mod->nx = nx;
+ mod->ny = nx;
+
+ /* origin of model in real (non-grid) coordinates */
+ mod->x0 = sub_x0;
+ mod->z0 = sub_z0;
+ mod->y0 = sub_y0;
+ xmax = sub_x0+(nx-1)*dx;
+ zmax = sub_z0+(nz-1)*dz;
+ ymax = sub_y0+(ny-1)*dy;
+
+ if (verbose) {
+ vmess("*******************************************");
+ vmess("*************** model info ****************");
+ vmess("*******************************************");
+ vmess("nz = %8d nx = %8d ny = %8d", nz, nx, ny);
+ vmess("dz = %8.4f dx = %8.4f dy = %8.4f", dz, dx, dy);
+ vmess("zmin = %8.4f zmax = %8.4f", sub_z0, zmax);
+ vmess("xmin = %8.4f xmax = %8.4f", sub_x0, xmax);
+ vmess("ymin = %8.4f ymax = %8.4f", sub_y0, ymax);
+ }
+
+ /* define the number and type of shots to model */
+ /* each shot can have multiple sources arranged in different ways */
+
+ if (!getparfloat("ysrc",&ysrc)) ysrc=sub_y0+((ny-1)*dy)/2.0;
+ if (!getparfloat("xsrc",&xsrc)) xsrc=sub_x0+((nx-1)*dx)/2.0;
+ if (!getparfloat("zsrc",&zsrc)) zsrc=sub_z0;
+ if (!getparint("nyshot",&shot->ny)) shot->ny=1;
+ if (!getparint("nxshot",&shot->nx)) shot->nx=1;
+ if (!getparint("nzshot",&shot->nz)) shot->nz=1;
+ if (!getparfloat("dyshot",&dyshot)) dyshot=dy;
+ if (!getparfloat("dxshot",&dxshot)) dxshot=dx;
+ if (!getparfloat("dzshot",&dzshot)) dzshot=dz;
+
+ shot->n = (shot->nx)*(shot->nz)*(shot->ny);
+
+ if (shot->nx>1) {
+ idxshot=MAX(0,NINT(dxshot/dx));
+ }
+ else {
+ idxshot=0.0;
+ }
+ if (shot->nz>1) {
+ idzshot=MAX(0,NINT(dzshot/dz));
+ }
+ else {
+ idzshot=0.0;
+ }
+ if (shot->ny>1) {
+ idyshot=MAX(0,NINT(dyshot/dy));
+ }
+ else {
+ idyshot=0.0;
+ }
+
+ /* calculate the shot positions */
+
+ src_iy0=MAX(0,NINT((ysrc-sub_y0)/dy));
+ src_iy0=MIN(src_iy0,ny);
+ 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);
+ srcendy=(shot->ny-1)*dyshot+ysrc;
+ srcendx=(shot->nx-1)*dxshot+xsrc;
+ srcendz=(shot->nz-1)*dzshot+zsrc;
+ src_iy1=MAX(0,NINT((srcendy-sub_y0)/dy));
+ src_iy1=MIN(src_iy1,ny);
+ 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->y = (int *)calloc(shot->ny,sizeof(int));
+ shot->x = (int *)calloc(shot->nx,sizeof(int));
+ shot->z = (int *)calloc(shot->nz,sizeof(int));
+ for (is=0; is<shot->ny; is++) {
+ shot->y[is] = src_iy0+is*idyshot;
+ if (shot->y[is] > ny-1) shot->ny = is-1;
+ }
+ for (is=0; is<shot->nx; is++) {
+ shot->x[is] = src_ix0+is*idxshot;
+ if (shot->x[is] > nx-1) shot->nx = is-1;
+ }
+ for (is=0; is<shot->nz; is++) {
+ shot->z[is] = src_iz0+is*idzshot;
+ if (shot->z[is] > nz-1) shot->nz = is-1;
+ }
+
+ /* check if source array is defined */
+
+ nysrc = countparval("xyrca");
+ nxsrc = countparval("xsrca");
+ nzsrc = countparval("zsrca");
+ if (nxsrc != nzsrc || nxsrc != nysrc) {
+ verr("Number of sources in array xsrca (%d), zsrca(%d) are not equal",nxsrc, nzsrc);
+ }
+
+ /* check if sources on a circle are defined */
+
+ if (getparfloat("rsrc", &rsrc)) {
+ if (!getparfloat("dphisrc",&dphisrc)) dphisrc=2.0;
+ if (!getparfloat("oysrc",&oysrc)) oysrc=0.0;
+ if (!getparfloat("oxsrc",&oxsrc)) oxsrc=0.0;
+ if (!getparfloat("ozsrc",&ozsrc)) ozsrc=0.0;
+ ncsrc = NINT(360.0/dphisrc);
+ src->n = nsrc;
+
+ src->y = (int *)malloc(ncsrc*sizeof(int));
+ src->x = (int *)malloc(ncsrc*sizeof(int));
+ src->z = (int *)malloc(ncsrc*sizeof(int));
+
+ for (ix=0; ix<ncsrc; ix++) {
+ src->y[ix] = NINT((oysrc-sub_y0+rsrc*cos(((iy*dphisrc)/360.0)*(2.0*M_PI)))/dy);
+ 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: ysrc[%d]=%d xsrc[%d]=%d zsrc=%d\n", iy, src->y[iy], 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";
+ 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) {
+ src->plane=0;
+ src->array=0;
+ src->single=0;
+ }
+ if (src->plane) {
+ src->random=0;
+ src->array=0;
+ src->single=0;
+ }
+
+
+ /* number of sources per shot modeling */
+
+ if (!getparint("src_window",&src->window)) src->window=0;
+ if (!getparint("distribution",&src->distribution)) src->distribution=0;
+ if (!getparfloat("amplitude", &src->amplitude)) src->amplitude=0.0;
+ if (src->random && nxsrc==0) {
+ if (!getparint("nsrc",&nsrc)) nsrc=1;
+ if (!getparfloat("ysrc1", &ysrc1)) ysrc1=sub_y0;
+ if (!getparfloat("ysrc2", &ysrc2)) ysrc2=ymax;
+ 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;
+ dyshot = ysrc2-ysrc1;
+ dxshot = xsrc2-xsrc1;
+ dzshot = zsrc2-zsrc1;
+ src->y = (int *)malloc(nsrc*sizeof(int));
+ src->x = (int *)malloc(nsrc*sizeof(int));
+ src->z = (int *)malloc(nsrc*sizeof(int));
+ nsamp = 0;
+
+ }
+ else if (nxsrc != 0) {
+ /* source array is defined */
+ nsrc=nxsrc;
+ src->y = (int *)malloc(nsrc*sizeof(int));
+ src->x = (int *)malloc(nsrc*sizeof(int));
+ src->z = (int *)malloc(nsrc*sizeof(int));
+ ysrca = (float *)malloc(nsrc*sizeof(float));
+ xsrca = (float *)malloc(nsrc*sizeof(float));
+ zsrca = (float *)malloc(nsrc*sizeof(float));
+ getparfloat("ysrca", ysrca);
+ getparfloat("xsrca", xsrca);
+ getparfloat("zsrca", zsrca);
+ for (is=0; is<nsrc; is++) {
+ src->y[is] = NINT((ysrca[is]-sub_y0)/dy);
+ src->x[is] = NINT((xsrca[is]-sub_x0)/dx);
+ src->z[is] = NINT((zsrca[is]-sub_z0)/dz);
+ if (verbose>3) fprintf(stderr,"Source Array: ysrc[%d]=%f xsrc=%f zsrc=%f\n", is, ysrca[is], xsrca[is], zsrca[is]);
+ }
+ src->random = 1;
+ free(ysrca);
+ free(xsrca);
+ free(zsrca);
+ }
+ 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->y = (int *)malloc(nsrc*sizeof(int));
+ src->x = (int *)malloc(nsrc*sizeof(int));
+ src->z = (int *)malloc(nsrc*sizeof(int));
+ is0 = -1*floor((nsrc-1)/2);
+ for (is=0; is<nsrc; is++) {
+ src->y[is] = is0 + is;
+ src->x[is] = is0 + is;
+ src->z[is] = 0;
+ }
+
+ }
+
+ src->n=nsrc;
+
+ if (verbose) {
+ 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)*(nsamp/(1024.0*1024.0)));
+ }
+ if (src->random) {
+ vmess("Sources are placed at random locations in domain: ");
+ vmess(" x[%.2f : %.2f] z[%.2f : %.2f] ", xsrc1, xsrc2, zsrc1, zsrc2);
+ }
+ }
+
+ /* define receivers */
+
+ 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 (!getparint("max_nrec",&rec->max_nrec)) rec->max_nrec=15000;
+ if (!getparfloat("dyspread",&dyspread)) dyspread=0;
+ if (!getparfloat("dxspread",&dxspread)) dxspread=0;
+ if (!getparfloat("dzspread",&dzspread)) dzspread=0;
+ if (!getparint("nt",&rec->nt)) rec->nt=1024;
+
+ /* calculates the receiver coordinates */
+
+ recvPar3d(rec, sub_x0, sub_z0, sub_y0, dx, dz, dy, nx, nz, ny);
+
+ if (verbose) {
+ if (rec->n) {
+ dyrcv = rec->yr[MIN(1,rec->n-1)]-rec->yr[0];
+ 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("dzrcv = %f dxrcv = %f dyrcv = %f ", dzrcv, dxrcv, dyrcv);
+ 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("ymin = %f ymax = %f ", rec->yr[0]+sub_y0, rec->yr[rec->n-1]+sub_y0);
+ 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]);
+ vmess("iymin = %d iymax = %d ", rec->y[0], rec->y[rec->n-1]);
+ fprintf(stderr,"\n");
+ }
+ else {
+ vmess("*************** no receivers **************");
+ }
+ }
+
+ /* Ray tracing parameters */
+ if (!getparint("smoothwindow",&ray->smoothwindow)) ray->smoothwindow=0;
+ if (!getparint("useT2",&ray->useT2)) ray->useT2=0;
+ if (!getparint("geomspread",&ray->geomspread)) ray->geomspread=1;
+ if (!getparint("nraystep",&ray->nray)) ray->nray=5;
+
+ return 0;
+}
+
diff --git a/raytime3d/getWaveletHeaders.c b/raytime3d/getWaveletHeaders.c
new file mode 100644
index 0000000000000000000000000000000000000000..5bff37528015722251741fcdb434db218e06ed90
--- /dev/null
+++ b/raytime3d/getWaveletHeaders.c
@@ -0,0 +1,52 @@
+#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/raytime3d/getWaveletInfo.c b/raytime3d/getWaveletInfo.c
new file mode 100644
index 0000000000000000000000000000000000000000..2f3734aae6c38e54653fab909ec5e936a157d8ce
--- /dev/null
+++ b/raytime3d/getWaveletInfo.c
@@ -0,0 +1,138 @@
+#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/raytime3d/getpars.c b/raytime3d/getpars.c
new file mode 100644
index 0000000000000000000000000000000000000000..5099c5801bef214253daf07667c1b3c55b1008b1
--- /dev/null
+++ b/raytime3d/getpars.c
@@ -0,0 +1,732 @@
+/* This file is property of the Colorado School of Mines.
+
+ Copyright (C) 2007, Colorado School of Mines,
+ All rights reserved.
+
+
+ Redistribution and use in source and binary forms, with or
+ without modification, are permitted provided that the following
+ conditions are met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above
+ copyright notice, this list of conditions and the following
+ disclaimer in the documentation and/or other materials provided
+ with the distribution.
+ * Neither the name of the Colorado School of Mines nor the names of
+ its contributors may be used to endorse or promote products
+ derived from this software without specific prior written permission.
+
+ Warranty Disclaimer:
+ THIS SOFTWARE IS PROVIDED BY THE COLORADO SCHOOL OF MINES AND CONTRIBUTORS
+ "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+ FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+ COLORADO SCHOOL OF MINES OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+ INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+ BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+ LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+ CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+ STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING
+ IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ POSSIBILITY OF SUCH DAMAGE.
+
+
+ Export Restriction Disclaimer:
+ We believe that CWP/SU: Seismic Un*x is a low technology product that does
+ not appear on the Department of Commerce CCL list of restricted exports.
+ Accordingly, we believe that our product meets the qualifications of
+ an ECCN (export control classification number) of EAR99 and we believe
+ it fits the qualifications of NRR (no restrictions required), and
+ is thus not subject to export restrictions of any variety.
+
+ Approved Reference Format:
+ In publications, please refer to SU as per the following example:
+ Cohen, J. K. and Stockwell, Jr. J. W., (200_), CWP/SU: Seismic Un*x
+ Release No. __: an open source software package for seismic
+ research and processing,
+ Center for Wave Phenomena, Colorado School of Mines.
+
+ Articles about SU in peer-reviewed journals:
+ Saeki, T., (1999), A guide to Seismic Un*x (SU)(2)---examples of data processing (part 1), data input and preparation of headers, Butsuri-Tansa (Geophysical Exploration), vol. 52, no. 5, 465-477.
+ Stockwell, Jr. J. W. (1999), The CWP/SU: Seismic Un*x Package, Computers and Geosciences, May 1999.
+ Stockwell, Jr. J. W. (1997), Free Software in Education: A case study of CWP/SU: Seismic Un*x, The Leading Edge, July 1997.
+ Templeton, M. E., Gough, C.A., (1998), Web Seismic Un*x: Making seismic reflection processing more accessible, Computers and Geosciences.
+
+ Acknowledgements:
+ SU stands for CWP/SU:Seismic Un*x, a processing line developed at Colorado
+ School of Mines, partially based on Stanford Exploration Project (SEP)
+ software.
+ */
+
+/*********************** self documentation **********************/
+/*****************************************************************************
+GETPARS - Functions to GET PARameterS from the command line. Numeric
+ parameters may be single values or arrays of int, uint,
+ short, ushort, long, ulong, float, or double. Single character
+ strings (type string or char *) may also be gotten.
+ Arrays of strings, delimited by, but not containing
+ commas are permitted.
+
+The functions are:
+
+initargs Makes command line args available to subroutines (re-entrant).
+ Every par program starts with this call!
+getparint get integers
+getparuint get unsigned integers
+getparshort get short integers
+getparushort get unsigned short integers
+getparlong get long integers
+getparulong get unsigned long integers
+getparfloat get float
+getpardouble get double
+getparstring get a single string
+getparstringarray get string array (fields delimited by commas)
+getpar get parameter by type
+getnparint get n'th occurrence of integer
+getnparuint get n'th occurrence of unsigned int
+getnparshort get n'th occurrence of short integer
+getnparushort get n'th occurrence of unsigned short int
+getnparlong get n'th occurrence of long integer
+getnparulong get n'th occurrence of unsigned long int
+getnparfloat get n'th occurrence of float integer
+getnpardouble get n'th occurrence of double integer
+getnparstring get n'th occurrence of string integer
+getnparstringarray get n'th occurrence of string integer array
+getnpar get n'th occurrence by type
+countparname return the number of times a parameter names is used
+countparval return the number of values in the last occurrence
+ of a parameter
+countnparval return the number of values in the n'th occurrence
+ of a parameter
+getPar Promax compatible version of getpar
+
+******************************************************************************
+Function Prototypes:
+void initargs (int argc, char **argv);
+int getparint (char *name, int *p);
+int getparuint (char *name, unsigned int *p);
+int getparshort (char *name, short *p);
+int getparushort (char *name, unsigned short *p);
+int getparlong (char *name, long *p);
+int getparulong (char *name, unsigned long *p);
+int getparfloat (char *name, float *p);
+int getpardouble (char *name, double *p);
+int getparstring (char *name, char **p);
+int getparstringarray (char *name, char **p);
+int getnparint (int n, char *name, int *p);
+int getnparuint (int n, char *name, unsigned int *p);
+int getnparshort (int n, char *name, short *p);
+int getnparushort (int n, char *name, unsigned short *p);
+int getnparlong (int n, char *name, long *p);
+int getnparulong (int n, char *name, unsigned long *p);
+int getnparfloat (int n, char *name, float *p);
+int getnpardouble (int n, char *name, double *p);
+int getnparstring (int n, char *name, char **p);
+int getnparstringarray (int n, char *name, char **p);
+int getnpar (int n, char *name, char *type, void *ptr);
+int countparname (char *name);
+int countparval (char *name);
+int countnparval (int n, char *name);
+void getPar(char *name, char *type, void *ptr);
+
+******************************************************************************
+Notes:
+Here are some usage examples:
+
+ ... if integer n not specified, then default to zero.
+ if (!getparint("n", &n)) n = 0;
+
+ ... if array of floats vx is specified, then
+ if (nx=countparval("vx")) {
+ ... allocate space for array
+ vx = (float *)malloc(nx*sizeof(float));
+ ... and get the floats
+ getparfloat("vx",vx);
+ }
+
+The command line for the above examples might look like:
+ progname n=35 vx=3.21,4,9.5
+ Every par program starts with this call!
+
+More examples are provided in the DTEST code at the end of this file.
+
+The functions: eatoh, eatou, eatol, eatov, eatoi, eatop used
+below are versions of atoi that check for overflow. The source
+file for these functions is atopkge.c.
+
+******************************************************************************
+Authors:
+Rob Clayton & Jon Claerbout, Stanford University, 1979-1985
+Shuki Ronen & Jack Cohen, Colorado School of Mines, 1985-1990
+Dave Hale, Colorado School of Mines, 05/29/90
+Credit to John E. Anderson for re-entrant initargs 03/03/94
+*****************************************************************************/
+/**************** end self doc ********************************/
+
+#include "par.h"
+
+#ifndef TRUE
+#define TRUE (1)
+#endif
+#ifndef FALSE
+#define FALSE (0)
+#endif
+
+/* parameter table */
+typedef struct {
+ char *name; /* external name of parameter */
+ char *asciival; /* ascii value of parameter */
+} pointer_table;
+
+/* global variables declared and used internally */
+static pointer_table *argtbl; /* parameter table */
+static int nargs; /* number of args that parse */
+static int tabled = FALSE; /* true when parameters tabled */
+static int targc; /* total number of args */
+static char **targv; /* pointer to arg strings */
+static char *argstr; /* storage for command line */
+
+/* functions declared and used internally */
+static int getparindex (int n, char *name);
+static void getparinit(void);
+static void tabulate (int argc, char **argv);
+static char *getpfname (void);
+static int white2null (char *str, int len);
+static int ccount (char c, char *s);
+static void strchop(char *s, char *t);
+
+/* make command line args available to subroutines -- re-entrant version */
+void initargs(int argc, char **argv)
+{
+ xargc = argc; xargv = argv;
+ if(tabled==TRUE){
+ free(argstr);
+ free(targv);
+ free(argtbl);
+ }
+ tabled = FALSE;
+ return;
+}
+
+/* functions to get values for the last occurrence of a parameter name */
+int getparint (char *name, int *ptr)
+{
+ return getnpar(0,name,"i",ptr);
+}
+int getparuint (char *name, unsigned int *ptr)
+{
+ return getnpar(0,name,"p",ptr);
+}
+int getparshort (char *name, short *ptr)
+{
+ return getnpar(0,name,"h",ptr);
+}
+int getparushort (char *name, unsigned short *ptr)
+{
+ return getnpar(0,name,"u",ptr);
+}
+int getparlong (char *name, long *ptr)
+{
+ return getnpar(0,name,"l",ptr);
+}
+int getparulong (char *name, unsigned long *ptr)
+{
+ return getnpar(0,name,"v",ptr);
+}
+int getparfloat (char *name, float *ptr)
+{
+ return getnpar(0,name,"f",ptr);
+}
+int getpardouble (char *name, double *ptr)
+{
+ return getnpar(0,name,"d",ptr);
+}
+int getparstring (char *name, char **ptr)
+{
+ return getnpar(0,name,"s",ptr);
+}
+int getparstringarray (char *name, char **ptr)
+{
+ return getnpar(0,name,"a",ptr);
+}
+int getpar (char *name, char *type, void *ptr)
+{
+ return getnpar(0,name,type,ptr);
+}
+
+/* functions to get values for the n'th occurrence of a parameter name */
+int getnparint (int n, char *name, int *ptr)
+{
+ return getnpar(n,name,"i",ptr);
+}
+int getnparuint (int n, char *name, unsigned int *ptr)
+{
+ return getnpar(n,name,"p",ptr);
+}
+int getnparshort (int n, char *name, short *ptr)
+{
+ return getnpar(n,name,"h",ptr);
+}
+int getnparushort (int n, char *name, unsigned short *ptr)
+{
+ return getnpar(n,name,"u",ptr);
+}
+int getnparlong (int n, char *name, long *ptr)
+{
+ return getnpar(n,name,"l",ptr);
+}
+int getnparulong (int n, char *name, unsigned long *ptr)
+{
+ return getnpar(n,name,"v",ptr);
+}
+int getnparfloat (int n, char *name, float *ptr)
+{
+ return getnpar(n,name,"f",ptr);
+}
+int getnpardouble (int n, char *name, double *ptr)
+{
+ return getnpar(n,name,"d",ptr);
+}
+int getnparstring (int n, char *name, char **ptr)
+{
+ return getnpar(n,name,"s",ptr);
+}
+int getnparstringarray (int n, char *name, char **ptr)
+{
+ return getnpar(n,name,"a",ptr);
+}
+int getnpar (int n, char *name, char *type, void *ptr)
+{
+ int i; /* index of name in symbol table */
+ int nval; /* number of parameter values found */
+ char *aval; /* ascii field of symbol */
+
+ if (xargc == 1) return 0;
+ if (!tabled) getparinit();/* Tabulate command line and parfile */
+ i = getparindex(n,name);/* Get parameter index */
+ if (i < 0) return 0; /* Not there */
+
+ /*
+ * handle string type as a special case, since a string
+ * may contain commas.
+ */
+ if (type[0]=='s') {
+ *((char**)ptr) = argtbl[i].asciival;
+ return 1;
+ }
+
+ /* convert vector of ascii values to numeric values */
+ for (nval=0,aval=argtbl[i].asciival; *aval; nval++) {
+ switch (type[0]) {
+ case 'i':
+ *(int*)ptr = eatoi(aval);
+ ptr = (int*)ptr+1;
+ break;
+ case 'p':
+ *(unsigned int*)ptr = eatop(aval);
+ ptr = (unsigned int*)ptr+1;
+ break;
+ case 'h':
+ *(short*)ptr = eatoh(aval);
+ ptr = (short*)ptr+1;
+ break;
+ case 'u':
+ *(unsigned short*)ptr = eatou(aval);
+ ptr = (unsigned short*)ptr+1;
+ break;
+ case 'l':
+ *(long*)ptr = eatol(aval);
+ ptr = (long*)ptr+1;
+ break;
+ case 'v':
+ *(unsigned long*)ptr = eatov(aval);
+ ptr = (unsigned long*)ptr+1;
+ break;
+ case 'f':
+ *(float*)ptr = eatof(aval);
+ ptr = (float*)ptr+1;
+ break;
+ case 'd':
+ *(double*)ptr = eatod(aval);
+ ptr = (double*)ptr+1;
+ break;
+ case 'a':
+ { char *tmpstr="";
+ tmpstr = (char *)calloc(strlen(aval)+1,1);
+
+ strchop(aval,tmpstr);
+ *(char**)ptr = tmpstr;
+ ptr=(char **)ptr + 1;
+ }
+ break;
+ default:
+ err("%s: invalid parameter type = %s",
+ __FILE__,type);
+ }
+ while (*aval++ != ',') {
+ if (!*aval) break;
+ }
+ }
+ return nval;
+}
+/* Promax compatible version of getnpar */
+void getPar(char *name, char *type, void *ptr)
+{
+ (void) getnpar(0,name,type,ptr);
+ return;
+}
+
+/* return number of occurrences of parameter name */
+int countparname (char *name)
+{
+ int i,nname;
+
+ if (xargc == 1) return 0;
+ if (!tabled) getparinit();
+ for (i=0,nname=0; i<nargs; ++i)
+ if (!strcmp(name,argtbl[i].name)) ++nname;
+ return nname;
+}
+
+/* return number of values in n'th occurrence of parameter name */
+int countnparval (int n, char *name)
+{
+ int i;
+
+ if (xargc == 1) return 0;
+ if (!tabled) getparinit();
+ i = getparindex(n,name);
+ if (i>=0)
+ return ccount(',',argtbl[i].asciival) + 1;
+ else
+ return 0;
+}
+
+/* return number of values in last occurrence of parameter name */
+int countparval (char *name)
+{
+ return countnparval(0,name);
+}
+
+
+
+/*
+ * Return the index of the n'th occurrence of a parameter name,
+ * except if n==0, return the index of the last occurrence.
+ * Return -1 if the specified occurrence does not exist.
+ */
+static int getparindex (int n, char *name)
+{
+ int i;
+ if (n==0) {
+ for (i=nargs-1; i>=0; --i)
+ if (!strcmp(name,argtbl[i].name)) break;
+ return i;
+ } else {
+ for (i=0; i<nargs; ++i)
+ if (!strcmp(name,argtbl[i].name))
+ if (--n==0) break;
+ if (i<nargs)
+ return i;
+ else
+ return -1;
+ }
+}
+
+/* Initialize getpar */
+static void getparinit (void)
+{
+ static char *pfname; /* name of parameter file */
+ FILE *pffd=NULL; /* file id of parameter file */
+ int pflen; /* length of parameter file in bytes */
+ static int pfargc; /* arg count from parameter file */
+ int parfile; /* parfile existence flag */
+ int argstrlen;
+ char *pargstr; /* storage for parameter file args */
+ int nread; /* bytes fread */
+ int i, j; /* counters */
+
+
+ tabled = TRUE; /* remember table is built */
+
+ /* Check if xargc was initiated */
+ if(!xargc)
+ err("%s: xargc=%d -- not initiated in main", __FILE__, xargc);
+
+ /* Space needed for command lines */
+ for (i = 1, argstrlen = 0; i < xargc; i++) {
+ argstrlen += strlen(xargv[i]) + 1;
+ }
+
+ /* Get parfile name if there is one */
+ /* parfile = (pfname = getpfname()) ? TRUE : FALSE; */
+ if ((pfname = getpfname())) {
+ parfile = TRUE;
+ } else {
+ parfile = FALSE;
+ }
+
+ if (parfile) {
+ pffd = fopen(pfname, "r");
+
+ /* Get the length */
+ fseek(pffd, 0, SEEK_END);
+ pflen = ftell(pffd);
+ rewind(pffd);
+ argstrlen += pflen;
+ } else {
+ pflen = 0;
+ }
+
+ /* Allocate space for command line and parameter file
+ plus nulls at the ends to help with parsing. */
+ /* argstr = (char *) calloc((size_t) (1+argstrlen+1), 1); */
+ /*argstr = (char *) ealloc1(1+argstrlen+1, 1);*/
+ argstr = (char *) calloc((size_t) (1+argstrlen+1), 1);
+
+ if (parfile) {
+ /* Read the parfile */
+ nread = fread(argstr + 1, 1, pflen, pffd);
+ if (nread != pflen) {
+ err("%s: fread only %d bytes out of %d from %s",
+ __FILE__, nread, pflen, pfname);
+ }
+ fclose(pffd);
+
+ /* Zap whites in parfile to help in parsing */
+ pfargc = white2null(argstr, pflen);
+
+ } else {
+ pfargc = 0;
+ }
+
+ /* Total arg count */
+ targc = pfargc + xargc - 1;
+
+ /* Allocate space for total arg pointers */
+ targv = (char **) calloc(targc, sizeof(char*));
+
+ if (parfile) {
+ /* Parse the parfile. Skip over multiple NULLs */
+ for (j = 1, i = 0; j < pflen; j++) {
+ if (argstr[j] && !argstr[j-1]) {
+ targv[i++] = argstr + j;
+ }
+ }
+ } else {
+ i = 0;
+ }
+
+ /* Copy command line arguments */
+ for (j = 1, pargstr = argstr + pflen + 2; j < xargc; j++) {
+ strcpy(pargstr,xargv[j]);
+ targv[i++] = pargstr;
+ pargstr += strlen(xargv[j]) + 1;
+ }
+
+ /* Allocate space for the pointer table */
+ argtbl = (pointer_table*) calloc(targc, sizeof(pointer_table));
+
+ /* Tabulate targv */
+ tabulate(targc, targv);
+
+ return;
+}
+
+#define PFNAME "par="
+/* Get name of parameter file */
+static char *getpfname (void)
+{
+ int i;
+ int pfnamelen;
+
+ pfnamelen = strlen(PFNAME);
+ for (i = xargc-1 ; i > 0 ; i--) {
+ if(!strncmp(PFNAME, xargv[i], pfnamelen)
+ && strlen(xargv[i]) != pfnamelen) {
+ return xargv[i] + pfnamelen;
+ }
+ }
+ return NULL;
+}
+
+#define iswhite(c) ((c) == ' ' || (c) == '\t' || (c) == '\n')
+
+/*
+ * Replace the whites by (possibly multiple) nulls. If we see a non-white
+ * and the previous char is a null, this signals the start of a string
+ * and we bump the count. This routine returns a count of the strings.
+ */
+static int white2null (char *str, int len)
+{
+ int i;
+ int count;
+ int inquote = FALSE;
+
+ str[0] = '\0'; /* This line added by Dave Hale, 1/30/96. */
+ for (i = 1, count = 0; i < len; i++) {
+ if (str[i]=='"') inquote=(inquote==TRUE)?FALSE:TRUE;
+ if (!inquote) {
+ if (iswhite(str[i])) { /* Is this a new word ? */
+ str[i] = '\0';
+ } else if (!str[i-1]) { /* multiple whites */
+ count++;
+ }
+ }
+ }
+ for (i = 1, inquote=FALSE; i < len; i++) {
+ if (str[i]=='"') inquote=(inquote==TRUE)?FALSE:TRUE;
+ if (inquote) {
+ if (str[i+1]!='"') {
+ str[i] = str[i+1];
+ } else {
+ str[i] = '\0';
+ str[i+1] = '\0';
+ inquote = FALSE;
+ }
+ }
+ }
+ str[len] = '\0';
+ return count;
+}
+
+/* Install symbol table */
+static void tabulate (int argc, char **argv)
+{
+ int i;
+ char *eqptr;
+
+ for (i = 0, nargs = 0 ; i < argc; i++) {
+ eqptr = (char *)strchr(argv[i], '=');
+ if (eqptr) {
+ argtbl[nargs].name = argv[i];
+ argtbl[nargs].asciival = eqptr + 1;
+ *eqptr = (char)0;
+
+ /* Debugging dump */
+/* fprintf(stderr, */
+/* "argtbl[%d]: name=%s asciival=%s\n", */
+/* nargs,argtbl[nargs].name,argtbl[nargs].asciival); */
+
+ nargs++;
+ }
+ }
+ return;
+}
+
+/* Count characters in a string */
+static int ccount (char c, char *s)
+{
+ int i, count;
+ for (i = 0, count = 0; s[i] != 0; i++)
+ if(s[i] == c) count++;
+ return count;
+}
+
+static void strchop(char *s, char *t)
+/***********************************************************************
+strchop - chop off the tail end of a string "s" after a "," returning
+ the front part of "s" as "t".
+************************************************************************
+Notes:
+Based on strcpy in Kernighan and Ritchie's C [ANSI C] book, p. 106.
+************************************************************************
+Author: CWP: John Stockwell and Jack K. Cohen, July 1995
+***********************************************************************/
+{
+
+ while ( (*s != ',') && (*s != '\0') ) {
+ *t++ = *s++;
+ }
+ *t='\0';
+}
+
+
+#ifdef TEST
+#define N 100
+main(int argc, char **argv)
+{
+ char *s;
+ short h, vh[N];
+ unsigned short u, vu[N];
+ long l, vl[N];
+ unsigned long v, vv[N];
+ int i, vi[N], ipar, npar, nval;
+ unsigned int p, vp[N];
+ float f, vf[N];
+ double d, vd[N];
+
+ initargs(argc, argv);
+
+ /* int parameters */
+ npar = countparname("i");
+ printf("\nnumber of i pars = %d\n",npar);
+ for (ipar=1; ipar<=npar; ++ipar) {
+ getnparint(ipar,"i",&i);
+ printf("occurrence %d of i=%d\n",ipar,i);
+ }
+ if (getparint("i", &i))
+ printf("last occurrence of i=%d\n",i);
+ npar = countparname("vi");
+ printf("number of vi pars = %d\n",npar);
+ for (ipar=1; ipar<=npar; ++ipar) {
+ nval = countnparval(ipar,"vi");
+ printf("occurrence %d has %d values\n",ipar,nval);
+ nval = getnparint(ipar,"vi",vi);
+ printf("vi=");
+ for (i=0; i<nval; i++)
+ printf("%d%c",vi[i],i==nval-1?'\n':',');
+ }
+ if (npar>0) {
+ nval = countparval("vi");
+ printf("last occurrence has %d values\n",nval);
+ getparint("vi",vi);
+ printf("vi=");
+ for (i=0; i<nval; i++)
+ printf("%d%c",vi[i],i==nval-1?'\n':',');
+ }
+
+ /* float parameters */
+ npar = countparname("f");
+ printf("\nnumber of f pars = %d\n",npar);
+ for (ipar=1; ipar<=npar; ++ipar) {
+ getnparfloat(ipar,"f",&f);
+ printf("occurrence %d of f=%g\n",ipar,f);
+ }
+ if (getparfloat("f", &f))
+ printf("last occurrence of f=%g\n",f);
+ npar = countparname("vf");
+ printf("number of vf pars = %d\n",npar);
+ for (ipar=1; ipar<=npar; ++ipar) {
+ nval = countnparval(ipar,"vf");
+ printf("occurrence %d has %d values\n",ipar,nval);
+ nval = getnparfloat(ipar,"vf",vf);
+ printf("vf=");
+ for (i=0; i<nval; i++)
+ printf("%g%c",vf[i],i==nval-1?'\n':',');
+ }
+ if (npar>0) {
+ nval = countparval("vf");
+ printf("last occurrence has %d values\n",nval);
+ getparfloat("vf",vf);
+ printf("vf=");
+ for (i=0; i<nval; i++)
+ printf("%g%c",vf[i],i==nval-1?'\n':',');
+ }
+
+ /* string parameters */
+ npar = countparname("s");
+ printf("\nnumber of s pars = %d\n",npar);
+ for (ipar=1; ipar<=npar; ++ipar) {
+ getnparstring(ipar,"s",&s);
+ printf("occurrence %d of s=%s\n",ipar,s);
+ }
+ if (getparstring("s", &s))
+ printf("last occurrence of s=%s\n",s);
+
+ return EXIT_SUCCESS;
+}
+#endif
+
diff --git a/raytime3d/name_ext.c b/raytime3d/name_ext.c
new file mode 100644
index 0000000000000000000000000000000000000000..8fa1e09d254153d4d783ab040cebfada4d82d3b7
--- /dev/null
+++ b/raytime3d/name_ext.c
@@ -0,0 +1,44 @@
+#include<stdlib.h>
+#include<string.h>
+#include<stdio.h>
+
+/**
+* inserts a character string after the filename, before the extension
+*
+* AUTHOR:
+* Jan Thorbecke (janth@xs4all.nl)
+* The Netherlands
+**/
+
+
+void name_ext(char *filename, char *extension)
+{
+ char ext[100];
+
+ if (strstr(filename, ".su") != NULL) {
+ sprintf(ext,"%s.su", extension);
+ strcpy(strstr(filename, ".su"), ext);
+ }
+ else if (strstr(filename, ".segy") != NULL) {
+ sprintf(ext,"%s.segy", extension);
+ strcpy(strstr(filename, ".segy"), ext);
+ }
+ else if (strstr(filename, ".mat") != NULL) {
+ sprintf(ext,"%s.mat", extension);
+ strcpy(strstr(filename, ".mat"), ext);
+ }
+ else if (strstr(filename, ".hdf") != NULL) {
+ sprintf(ext,"%s.hdf", extension);
+ strcpy(strstr(filename, ".hdf"), ext);
+ }
+ else if (strrchr(filename, '.') != NULL) {
+ sprintf(ext,"%s.su", extension);
+ strcpy(strrchr(filename, '.'), ext);
+ }
+ else {
+ sprintf(ext,"%s.su", extension);
+ strcat(filename, ext);
+ }
+
+ return;
+}
diff --git a/raytime3d/par.h b/raytime3d/par.h
new file mode 100644
index 0000000000000000000000000000000000000000..fce76ed344382c6d5719737e5395fd8fb3ad0a5b
--- /dev/null
+++ b/raytime3d/par.h
@@ -0,0 +1,217 @@
+/* This file is property of the Colorado School of Mines.
+
+ Copyright © 2007, Colorado School of Mines,
+ All rights reserved.
+
+
+ Redistribution and use in source and binary forms, with or
+ without modification, are permitted provided that the following
+ conditions are met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above
+ copyright notice, this list of conditions and the following
+ disclaimer in the documentation and/or other materials provided
+ with the distribution.
+ * Neither the name of the Colorado School of Mines nor the names of
+ its contributors may be used to endorse or promote products
+ derived from this software without specific prior written permission.
+
+ Warranty Disclaimer:
+ THIS SOFTWARE IS PROVIDED BY THE COLORADO SCHOOL OF MINES AND CONTRIBUTORS
+ "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+ FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+ COLORADO SCHOOL OF MINES OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+ INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+ BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+ LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+ CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+ STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING
+ IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ POSSIBILITY OF SUCH DAMAGE.
+
+
+ Export Restriction Disclaimer:
+ We believe that CWP/SU: Seismic Un*x is a low technology product that does
+ not appear on the Department of Commerce CCL list of restricted exports.
+ Accordingly, we believe that our product meets the qualifications of
+ an ECCN (export control classification number) of EAR99 and we believe
+ it fits the qualifications of NRR (no restrictions required), and
+ is thus not subject to export restrictions of any variety.
+
+ Approved Reference Format:
+ In publications, please refer to SU as per the following example:
+ Cohen, J. K. and Stockwell, Jr. J. W., (200_), CWP/SU: Seismic Un*x
+ Release No. __: an open source software package for seismic
+ research and processing,
+ Center for Wave Phenomena, Colorado School of Mines.
+
+ Articles about SU in peer-reviewed journals:
+ Saeki, T., (1999), A guide to Seismic Un*x (SU)(2)---examples of data processing (part 1), data input and preparation of headers, Butsuri-Tansa (Geophysical Exploration), vol. 52, no. 5, 465-477.
+ Stockwell, Jr. J. W. (1999), The CWP/SU: Seismic Un*x Package, Computers and Geosciences, May 1999.
+ Stockwell, Jr. J. W. (1997), Free Software in Education: A case study of CWP/SU: Seismic Un*x, The Leading Edge, July 1997.
+ Templeton, M. E., Gough, C.A., (1998), Web Seismic Un*x: Making seismic reflection processing more accessible, Computers and Geosciences.
+
+ Acknowledgements:
+ SU stands for CWP/SU:Seismic Un*x, a processing line developed at Colorado
+ School of Mines, partially based on Stanford Exploration Project (SEP)
+ software.
+ . */
+/* par.h - include file for getpar, selfdoc, and error handling functions */
+
+#ifndef PAR_H
+#define PAR_H
+void verr(char *fmt, ...);
+void vmess(char *fmt, ...);
+void vwarn(char *fmt, ...);
+void vsyserr(char *fmt, ...);
+
+/* TYPEDEFS */
+typedef union { /* storage for arbitrary type */
+ char s[8];
+ short h;
+ unsigned short u;
+ long l;
+ unsigned long v;
+ int i;
+ unsigned int p;
+ float f;
+ double d;
+ unsigned int U:16;
+ unsigned int P:32;
+} Value;
+
+/* INCLUDES */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <fcntl.h> /* non-ANSI */
+#include <unistd.h> /* non-ANSI */
+#include <sys/types.h> /* non-ANSI */
+#include<string.h>
+
+
+/* GLOBAL DECLARATIONS */
+extern int xargc; extern char **xargv;
+
+
+/* TYPEDEFS */
+typedef char *cwp_String;
+
+typedef enum {BADFILETYPE = -1,
+ TTY, DISK, DIRECTORY, TAPE, PIPE, FIFO, SOCKET, SYMLINK} FileType;
+
+/* DEFINES */
+
+/* getpar macros */
+#define MUSTGETPARINT(x,y) if(!getparint(x,y)) err("must specify %s=",x)
+#define MUSTGETPARFLOAT(x,y) if(!getparfloat(x,y)) err("must specify %s=",x)
+#define MUSTGETPARSTRING(x,y) if(!getparstring(x,y)) err("must specify %s=",x)
+
+#define STDIN (0)
+#define STDOUT (1)
+#define STDERR (2)
+
+/* FUNCTION PROTOTYPES */
+
+#ifdef __cplusplus /* if C++, specify external C linkage */
+extern "C" {
+#endif
+
+/* getpar parameter parsing */
+void initargs (int argc, char **argv);
+int getparint (char *name, int *p);
+int getparuint (char *name, unsigned int *p);
+int getparshort (char *name, short *p);
+int getparushort (char *name, unsigned short *p);
+int getparlong (char *name, long *p);
+int getparulong (char *name, unsigned long *p);
+int getparfloat (char *name, float *p);
+int getpardouble (char *name, double *p);
+int getparstring (char *name, char **p);
+int getparstringarray (char *name, char **p);
+int getnparint (int n, char *name, int *p);
+int getnparuint (int n, char *name, unsigned int *p);
+int getnparshort (int n, char *name, short *p);
+int getnparushort (int n, char *name, unsigned short *p);
+int getnparlong (int n, char *name, long *p);
+int getnparulong (int n, char *name, unsigned long *p);
+int getnparfloat (int n, char *name, float *p);
+int getnpardouble (int n, char *name, double *p);
+int getnparstring (int n, char *name, char **p);
+int getnparstringarray (int n, char *name, char **p);
+int getnpar (int n, char *name, char *type, void *ptr);
+int countparname (char *name);
+int countparval (char *name);
+int countnparval (int n, char *name);
+
+/* For ProMAX */
+void getPar(char *name, char *type, void *ptr);
+
+/* errors and warnings */
+void err (char *fmt, ...);
+void syserr (char *fmt, ...);
+void warn (char *fmt, ...);
+
+/* self documentation */
+void pagedoc (void);
+void requestdoc (int i);
+
+/* system calls with error trapping */
+int ecreat(char *path, int perms);
+int efork(void);
+int eopen(char *path, int flags, int perms);
+int eclose(int fd);
+int eunlink(char *path);
+long elseek(int fd, long offset, int origin);
+int epipe(int fd[2]);
+int eread(int fd, char *buf, int nbytes);
+int ewrite(int fd, char *buf, int nbytes);
+
+/* system subroutine calls with error trapping */
+FILE *efopen(const char *file, const char *mode);
+FILE *efreopen(const char *file, const char *mode, FILE *stream1);
+FILE *efdopen(int fd, const char *mode);
+FILE *epopen(char *command, char *type);
+int efclose(FILE *stream);
+int epclose(FILE *stream);
+int efflush(FILE *stream);
+int eremove(const char *file);
+int erename(const char *oldfile, const char* newfile);
+int efseek(FILE *stream, long offset, int origin);
+void erewind(FILE *stream);
+long eftell(FILE *stream);
+FILE *etmpfile(void);
+char *etmpnam(char *namebuffer);
+void *emalloc(size_t size);
+void *erealloc(void *memptr, size_t size);
+void *ecalloc(size_t count, size_t size);
+size_t efread(void *bufptr, size_t size, size_t count, FILE *stream);
+size_t efwrite(void *bufptr, size_t size, size_t count, FILE *stream);
+
+#ifndef SUN_A
+int efgetpos(FILE *stream, fpos_t *position);
+int efsetpos(FILE *stream, const fpos_t *position);
+#endif
+
+/* string to numeric conversion with error checking */
+short eatoh(char *s);
+unsigned short eatou(char *s);
+int eatoi(char *s);
+unsigned int eatop(char *s);
+long eatol(char *s);
+unsigned long eatov(char *s);
+float eatof(char *s);
+double eatod(char *s);
+
+/* file type checking */
+FileType filestat(int fd);
+char *printstat(int fd);
+
+#ifdef __cplusplus /* if C++ (external C linkage is being specified) */
+}
+#endif
+
+#endif /* PAR_H */
diff --git a/raytime3d/raytime3d.c b/raytime3d/raytime3d.c
new file mode 100644
index 0000000000000000000000000000000000000000..b1735d85dc72268229f9e5d3e9c0a93329e7b8c2
--- /dev/null
+++ b/raytime3d/raytime3d.c
@@ -0,0 +1,290 @@
+#include<stdlib.h>
+#include<stdio.h>
+#include<math.h>
+#include<assert.h>
+#include<string.h>
+#include <genfft.h>
+#include"par.h"
+#include"raytime3d.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))
+
+double wallclock_time(void);
+
+void name_ext(char *filename, char *extension);
+
+void threadAffinity(void);
+
+
+int getParameters3d(modPar *mod, recPar *rec, srcPar *src, shotPar *shot, rayPar *ray, int verbose);
+
+int getWaveParameter(float *slowness, icoord size, float dgrid, fcoord s, fcoord r, rayPar ray, fcoord *T, float *Jr);
+
+void applyMovingAverageFilter(float *slowness, icoord size, int window, int dim, float *averageModel);
+
+int readModel3d(char *file_name, float *slowness, int n1, int n2, int n3, int nz, int nx, int ny, float h, int verbose);
+
+int defineSource(wavPar wav, srcPar src, modPar mod, float **src_nwav, int reverse, int verbose);
+
+int writeSrcRecPos(modPar *mod, recPar *rec, srcPar *src, shotPar *shot);
+
+void vidale3d(float *slow0, float *time0, int nz, int nx, int ny, float h, int xs, int ys, int zs, int NCUBE);
+
+void src3d(float *time0, float *slow0, int nz, int nx, int ny, float h, float ox, float oy, float oz, int *pxs, int *pys, int *pzs, int *cube);
+
+
+/*********************** self documentation **********************/
+char *sdoc[] = {
+" ",
+" RAYTIME3D - modeling of one-way traveltime for operators in 3D media",
+" ",
+" raytime3d file_cp= xsrc1= zsrc1= ysrc1= [optional parameters]",
+" ",
+" Required parameters:",
+" ",
+" file_cp= ................ gridded velocity file ",
+" file_src= ......... file with source signature",
+" file_rcv=recv.su .. base name for receiver files",
+" file_rcvtime= ..... receiver file in x-t",
+" h= ................ read from model file: if d1==0 then h= can be used to set it",
+" nt=1024 ........... number of time-samples in file_rcvtime",
+" xsrc1= ................... x-position of the source (m)",
+" ysrc1= ................... y-position of the source (m)",
+" zsrc1= ................... z-position of the source (m)",
+" ",
+" Optional parameters:",
+" ",
+" INPUT AND OUTPUT ",
+" key=gy ................... input data sorting key",
+" nx=1 ..................... if 1D file number of points in x ",
+" ny=1 ..................... if 2D file number of points in y ",
+" file_out= ................ output file with traveltime cube",
+" file_amp= ................ output file with approximate amplitudes",
+" ",
+//" RAY TRACING PARAMETERS:",
+//" dT=0 ..................... put traces on one-way time grid with step dT",
+//" Tmin=first shot........... minimum time of one-way time grid",
+//" Tmax=last shot ........... maximum time of one-way time grid",
+//" hom=1 .................... 1: draw straight rays in homogeneous layers",
+//" ",
+" SOURCE POSITIONS ",
+" xsrc2=xsrc1 .............. x-position of last source",
+" dxsrc=0 .................. step in source x-direction",
+" ysrc2=ysrc1 .............. y-position of last source",
+" dysrc=0 .................. step in source y-direction",
+" zsrc2=zsrc1 .............. z-position of last source",
+" dzsrc=0 .................. step in source z-direction",
+" RECEIVER POSITIONS ",
+" xrcv=-(nx-1/2)*h,(nx-1/2)*h .. x-position's of receivers (array)",
+" yrcv=-(ny-1)/2*h,(ny-1/2)*h .. y-position's of receivers (array)",
+" zrcv=0,0 ................. z-position's of receivers (array)",
+" dxrcv=h ................. step in receiver x-direction",
+" dyrcv=h ................. step in receiver y-direction",
+" dzrcv=0 .................. step in receiver z-direction",
+" dxspr=0 .................. step of receiver spread in x-direction",
+" dyspr=0 .................. step of receiver spread in y-direction",
+" lint=1 ................... linear interpolate between the rcv points",
+" verbose=0 ................ verbose option",
+" ",
+" raytime3d calculates the first arrival time at the defined receiver array ",
+" for the defined shots at different depth and lateral positions.",
+" Every new lateral position (with dxsrc) gives a new output gather.",
+" ",
+" PROGRAM TO CALCULATE TRAVEL TIMES IN 3D MEDIA ",
+" AUTHORS: John E. Vidale(1986-1989), J. Hole(1990-1995) ",
+" ",
+" Translated to DELPHI environment: Jan Thorbecke 17-04-1996",
+" ",
+NULL};
+/**************** end self doc ***********************************/
+
+#define SQR2 1.414213562
+#define SQR3 1.732050808
+#define SQR6 2.449489743
+#define t0(x,y,z) time0[nxy*(z) + nx*(y) + (x)]
+#define s0(x,y,z) slow0[nxy*(z) + nx*(y) + (x)]
+
+void main(int argc, char *argv[])
+{
+ modPar mod;
+ recPar rec;
+ srcPar src;
+ shotPar shot;
+ rayPar ray;
+ int
+ nx, /* x-dimension of mesh (LEFT-TO-RIGHT) */
+ ny, /* y-dimension of mesh (FRONT-TO-BACK) */
+ nz, /* z-dimension of mesh (TOP-TO-BOTTOM) */
+ nxy, nxyz, xs, ys, zs, cube,
+ xx, yy, zz, i, j;
+ float
+ h, /* spatial mesh interval (units consistant with vel) */
+ *slow0, *time0;
+
+/* to read the velocity file */
+ int error, n1, n2, n3, ret, size, nkeys, verbose;
+ float d1, d2, d3, f1, f2, f3, *tmpdata, c, scl, ox, oz, oy;
+ char *file_cp, *file_out;
+ segy *hdrs;
+
+/*---------------------------------------------------------------------------*
+ * Read input parameters and query for any that are needed but missing.
+ *---------------------------------------------------------------------------*/
+
+ initargs(argc, argv);
+ requestdoc(1);
+
+ if (!getparint("verbose",&verbose)) verbose=0;
+ if (verbose) {
+ vmess("Hole, J.A., and B.C. Zelt, 1995. \"3-D finite-difference");
+ vmess("reflection traveltimes\". Geophys. J. Int., 121, 427-434");
+ }
+ if(!getparstring("file_out",&file_out)) verr("file_out not given");
+
+ getParameters3d(&mod, &rec, &src, &shot, &ray, verbose);
+
+/*---------------------------------------------------------------------------*
+ * Open velocity file
+ *---------------------------------------------------------------------------*/
+
+ if (mod.file_cp != NULL) {
+
+ if (n2==1) { /* 1D model */
+ if(!getparint("nx",&nx)) verr("for 1D medium nx not defined");
+ if(!getparint("ny",&nx)) verr("for 1D medium ny not defined");
+ nz = n1;
+ oz = f1; ox = ((nx-1)/2)*d1; oy = ((ny-1)/2)*d1;
+ }
+ else if (n3==1) { /* 2D model */
+ if(!getparint("ny",&nx)) verr("for 2D medium ny not defined");
+ nz = n1; nx = n2;
+ oz = f1; ox = f2; oy = ((ny-1)/2)*d1;
+ }
+ else { /* Full 3D model */
+ nz = n1; nx = n2; nz = n3;
+ oz = f1; ox = f2; oy = f3;
+ }
+
+ h = mod.dx;
+ slow0 = (float *)malloc(nz*nx*ny*sizeof(float));
+ if (slow0 == NULL) verr("Out of memory for slow0 array!");
+
+ readModel3d(mod.file_cp, slow0, n1, n2, n3, nz, nx, ny, h, verbose);
+
+ if (verbose) vmess("h = %.2f nx = %d nz = %d ny = %d", h, nx, nz, ny);
+
+ }
+ else {
+ if(!getparfloat("c",&c)) verr("c not defined");
+ if(!getparfloat("h",&h)) verr("h not defined");
+ if(!getparint("nx",&nx)) verr("for homogenoeus medium nx not defined");
+ if(!getparint("ny",&nx)) verr("for homogenoeus medium ny not defined");
+ if(!getparint("nz",&nx)) verr("for homogenoeus medium nz not defined");
+ nxy = nx * ny;
+ oz = 0; ox = ((nx-1)/2)*d1; oy = ((ny-1)/2)*d1;
+
+ slow0 = (float *)malloc(nx*nz*ny*sizeof(float));
+ if (slow0 == NULL) verr("Out of memory for slow0 array!");
+ scl = h/c;
+ ox = 0; oy = 0; oz = 0;
+ for (zz = 0; zz < nz; zz++) {
+ for (yy = 0; yy < ny; yy++) {
+ for (xx = 0; xx < nx; xx++)
+ slow0[zz*nxy+yy*nx+xx] = scl;
+ }
+ }
+ }
+
+ nxy = nx * ny;
+ nxyz = nx * ny * nz;
+
+ /* ALLOCATE MAIN GRID FOR TIMES */
+ time0 = (float *) malloc(sizeof(float)*nxyz);
+ if(time0 == NULL) verr("error in allocation of array time0");
+
+/*---------------------------------------------------------------------------*
+ * Input the source locations.
+ * and
+ * Initialize the traveltime array. Place t=0 at source position.
+ *---------------------------------------------------------------------------*/
+
+ src3d(time0, slow0, nz, nx, ny, h, ox, oy, oz, &xs, &ys, &zs, &cube);
+ if (verbose) vmess("source positions xs = %d ys = %d zs = %d", xs,ys,zs);
+
+/* for (zz = 0; zz < nz; zz++) {
+ for (yy = 0; yy < ny; yy++) {
+ for (xx = 0; xx < nx; xx++)
+ if (time0[zz*nxy+yy*nx+xx] != 1e10) fprintf(stderr,"slow[%d,%d,%d] = %f\n", xx,yy,zz, time0[zz*nxy+yy*nx+xx]);
+ }
+ }
+*/
+
+/*---------------------------------------------------------------------------*
+ * Read in receiver positions
+ *---------------------------------------------------------------------------*/
+
+/*---------------------------------------------------------------------------*
+ * Check and set parameters
+ *---------------------------------------------------------------------------*/
+
+/*---------------------------------------------------------------------------*
+ * Compute traveltimes.
+ *---------------------------------------------------------------------------*/
+
+ vidale3d(slow0, time0, nz, nx, ny, h, xs, ys, zs, cube);
+
+/*---------------------------------------------------------------------------*
+ * Write output
+ *---------------------------------------------------------------------------*/
+
+/*
+ for (zz = 0; zz < nz; zz++) {
+ for (yy = 0; yy < ny; yy++) {
+ for (xx = 0; xx < nx; xx++)
+ if (time0[zz*nxy+yy*nx+xx] != 1e10) fprintf(stderr,"slow[%d,%d,%d] = %f\n", xx,yy,zz, time0[zz*nxy+yy*nx+xx]);
+ }
+ }
+*/
+// ret = open_file(file_out, GUESS_TYPE, DELPHI_CREATE);
+// if (ret < 0 ) verr("error in creating output file %s", file_out);
+
+ hdrs = (segy *) malloc(ny*sizeof(segy));
+ tmpdata = (float *)malloc(nxy*sizeof(float));
+ f1 = ox;
+ f2 = oy;
+ d1 = h;
+ d2 = h;
+
+// gen_hdrs(hdrs,nx,ny,f1,f2,d1,d2,TRID_ZX);
+ for (i = 0; i < ny; i++) {
+ hdrs[i].scalco = -1000;
+ hdrs[i].scalel = -1000;
+ hdrs[i].sx = (int)(ox+xs*h)*1000;
+ hdrs[i].sy = (int)(oy+ys*h)*1000;
+ hdrs[i].gy = (int)(oy+i*d2)*1000;
+ hdrs[i].sdepth = (int)(oz+zs*h)*1000;
+ hdrs[i].fldr = 1;
+ hdrs[i].trwf = ny;
+ for (j = 0; j < nx; j++) {
+ tmpdata[i*nx+j] = time0[i*nx+j];
+ }
+ }
+
+/*
+ ret = write_data(file_out,tmpdata,nx,ny,f1,f2,d1,d2,type,hdrs);
+ if (ret < 0 ) verr("error on writing output file.");
+ ret = close_file(file_out);
+ if (ret < 0) verr("err %d on closing output file",ret);
+*/
+
+ free(time0);
+ free(slow0);
+ free(hdrs);
+ free(tmpdata);
+
+ exit(0);
+
+}
diff --git a/raytime3d/raytime3d.h b/raytime3d/raytime3d.h
new file mode 100644
index 0000000000000000000000000000000000000000..9900d8b13315c9b5ec7662a053d8eb25973e7915
--- /dev/null
+++ b/raytime3d/raytime3d.h
@@ -0,0 +1,144 @@
+#include<stdlib.h>
+#include<stdio.h>
+#include<limits.h>
+#include<float.h>
+#include<math.h>
+
+#ifndef COMPLEX
+typedef struct _complexStruct { /* complex number */
+ float r,i;
+} complex;
+typedef struct _dcomplexStruct { /* complex number */
+ double r,i;
+} dcomplex;
+#endif/* complex */
+
+
+typedef struct _icoord { /* 3D coordinate integer */
+ int z;
+ int x;
+ int y;
+} icoord;
+
+typedef struct _fcoord { /* 3D coordinate float */
+ float z;
+ float x;
+ float y;
+} fcoord;
+
+struct s_ecount {
+ int corner,corner_min,side;
+};
+
+typedef struct _receiverPar { /* Receiver Parameters */
+ char *file_rcv;
+ int n;
+ int nt;
+ int max_nrec;
+ int *z;
+ int *x;
+ int *y;
+ float *zr;
+ float *xr;
+ float *yr;
+ int scale;
+ int sinkdepth;
+ int sinkvel;
+ float cp;
+ float rho;
+} recPar;
+
+typedef struct _modelPar { /* Model Parameters */
+ int sh;
+ char *file_cp;
+ float dz;
+ float dx;
+ float dy;
+ float dt;
+ float z0;
+ float x0;
+ float y0;
+ /* medium max/min values */
+ float cp_min;
+ float cp_max;
+ int nz;
+ int nx;
+ int ny;
+} modPar;
+
+typedef struct _waveletPar { /* Wavelet Parameters */
+ char *file_src; /* general source */
+ int nsrcf;
+ int nt;
+ int ns;
+ int nx;
+ int ny;
+ 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 *y;
+ int single;
+ int plane;
+ int circle;
+ int array;
+ int random;
+ int multiwav;
+ float angle;
+ float velo;
+ float amplitude;
+ 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 ny;
+ int nx;
+ int nz;
+ int *z;
+ int *x;
+ int *y;
+} shotPar;
+
+typedef struct _raypar { /* ray-tracing parameters */
+ int smoothwindow;
+ int useT2;
+ int geomspread;
+ int nray;
+} rayPar;
+
+#ifndef TRUE
+# define TRUE 1
+#endif
+
+#ifndef FALSE
+# define FALSE 0
+#endif
+
+#define equal(x,y) !strcmp(x,y)
+#define min2(a,b) (((a) < (b)) ? (a) : (b))
+#define max2(a,b) (((a) > (b)) ? (a) : (b))
+
+#define Infinity FLT_MAX
+
+#if __STDC_VERSION__ >= 199901L
+ /* "restrict" is a keyword */
+#else
+#define restrict
+#endif
+
diff --git a/raytime3d/readModel3d.c b/raytime3d/readModel3d.c
new file mode 100644
index 0000000000000000000000000000000000000000..e8f4f9a98148717742210409df1f2d6358982f77
--- /dev/null
+++ b/raytime3d/readModel3d.c
@@ -0,0 +1,87 @@
+#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 "raytime3d.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 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 readModel3d(char *file_name, float *slowness, int n1, int n2, int n3, int nz, int nx, int ny, float h, int verbose)
+{
+ FILE *fpcp;
+ size_t nread;
+ int i, j, k, tracesToDo;
+ int nxy, nxz;
+ float *tmp;
+ segy hdr;
+
+ nxy = nx * ny;
+ tmp = (float *)malloc(n1*sizeof(float));
+
+/* open files and read first header */
+
+ fpcp = fopen( file_name, "r" );
+ assert( fpcp != NULL);
+ nread = fread(&hdr, 1, TRCBYTES, fpcp);
+ assert(nread == TRCBYTES);
+ assert(hdr.ns == n1);
+
+ if (n2==1) { /* 1D model */
+ nread = fread(&tmp[0], sizeof(float), hdr.ns, fpcp);
+ for (j = 0; j < nz; j++) {
+ for (k = 0; k < ny; k++) {
+ for (i = 0; i < nx; i++) {
+ slowness[j*nxy+k*nx+i] = h/tmp[j];
+ }
+ }
+ }
+ }
+ else if (n3==1) { /* 2D model */
+ for (i = 0; i < nx; i++) {
+ nread = fread(&tmp[0], sizeof(float), hdr.ns, fpcp);
+ for (j = 0; j < nz; j++) {
+ for (k = 0; k < ny; k++) {
+ slowness[j*nxy+k*nx+i] = h/tmp[j];
+ }
+ }
+ nread = fread(&hdr, 1, TRCBYTES, fpcp);
+ }
+ }
+ else { /* Full 3D model */
+ /* read all traces */
+ for (k = 0; k < ny; k++) {
+ for (i = 0; i < nx; i++) {
+ nread = fread(&tmp[0], sizeof(float), hdr.ns, fpcp);
+ for (j = 0; j < nz; j++) {
+ slowness[j*nxy+k*nx+i] = h/tmp[j];
+ }
+ nread = fread(&hdr, 1, TRCBYTES, fpcp);
+ }
+ }
+ }
+
+ fclose(fpcp);
+
+ return 0;
+}
+
+
diff --git a/raytime3d/recvPar3d.c b/raytime3d/recvPar3d.c
new file mode 100644
index 0000000000000000000000000000000000000000..65dd258e5c95c0086fbdbf247ecfd084b22647c8
--- /dev/null
+++ b/raytime3d/recvPar3d.c
@@ -0,0 +1,616 @@
+#include <stdio.h>
+#include <assert.h>
+#include <math.h>
+
+#include "raytime3d.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 recvPar3d(recPar *rec, float sub_x0, float sub_z0, float sub_y0, float dx, float dz, float dy, int nx, int nz, int ny)
+{
+ float *yrcv1, *yrcv2, *xrcv1, *xrcv2, *zrcv1, *zrcv2;
+ int i, ix, iy, ir, verbose;
+ float dxrcv, dzrcv, dyrcv, *dxr, *dzr, *dyr;
+ float rrcv, dphi, oxrcv, ozrcv, oyrcv, arcv;
+ double circ, h, a, b, e, s, xr, zr, yr, dr, srun, phase;
+ float xrange, zrange, yrange, sub_x1, sub_z1, sub_y1;
+ int Nx1, Nx2, Nz1, Nz2, Ny1, Ny2, Ndx, Ndz, Ndy, iarray, nrec, nh;
+ int nxrcv, nzrcv, nyrcv, ncrcv, nrcv, ntrcv, *nlrcv;
+ float *xrcva, *zrcva, *yrcva;
+ 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;
+ sub_y1=sub_y0+(ny-1)*dy;
+
+/* 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 */
+ nyrcv=countparval("yrcva");
+ 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 (nxrcv!=nyrcv) verr("Number of receivers in array xrcva (%d), yrcva(%d) are not equal",nxrcv,nyrcv);
+ if (verbose&&nxrcv) vmess("Total number of array receivers: %d",nxrcv);
+
+ /* Linear Receiver Arrays */
+ Ny1 = countparval("yrcv1");
+ Ny2 = countparval("yrcv2");
+ Nx1 = countparval("xrcv1");
+ Nx2 = countparval("xrcv2");
+ Nz1 = countparval("zrcv1");
+ Nz2 = countparval("zrcv2");
+ if (Ny1!=Ny2) verr("Number of receivers starting points in 'yrcv1' (%d) and number of endpoint in 'yrcv2' (%d) are not equal",Ny1,Ny2);
+ 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);
+ if (Nx1!=Ny2) verr("Number of receivers starting points in 'xrcv1' (%d) and number of endpoint in 'yrcv2' (%d) are not equal",Nx1,Ny2);
+
+ 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 */
+ yrcv1=(float *)malloc(Nx1*sizeof(float));
+ yrcv2=(float *)malloc(Nx1*sizeof(float));
+ 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("yrcv1",yrcv1)) yrcv1[0]=sub_y0;
+ if (!getparfloat("yrcv2",yrcv2)) yrcv2[0]=sub_y1;
+ 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++) {
+ yrcv1[iarray] = MAX(sub_y0, yrcv1[iarray]);
+ yrcv1[iarray] = MIN(sub_y0+ny*dy,yrcv1[iarray]);
+ yrcv2[iarray] = MAX(sub_y0, yrcv2[iarray]);
+ yrcv2[iarray] = MIN(sub_y0+ny*dy,yrcv2[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 (yrcv1[iarray]<sub_y0) {
+ if (yrcv2[iarray]<sub_y0) {
+ verr("Linear array %d outside model bounds",iarray);
+ }
+ else {
+ vwarn("Cropping element %d of 'yrcv1' (%f) to model bounds (%f)",iarray,yrcv1[iarray],sub_y0);
+ yrcv1[iarray]=sub_y0;
+ }
+ }
+ else if (yrcv1[iarray] > sub_y1) {
+ verr("Linear array %d outside model bounds",iarray);
+ }
+ if ( (yrcv2[iarray] < yrcv1[iarray]) ) {
+ verr("Ill defined linear array %d, 'yrcv1' (%f) greater than 'yrcv2' (%f)",iarray,yrcv1[iarray],yrcv2[iarray]);
+ }
+ else if (yrcv2[iarray]>sub_y1) {
+ vwarn("Cropping element %d of 'yrcv2' (%f) to model bounds (%f)",iarray,yrcv2[iarray],sub_y1);
+ yrcv2[iarray]=sub_y1;
+ }
+
+ 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 */
+ Ndy = countparval("dyrcv");
+ Ndx = countparval("dxrcv");
+ Ndz = countparval("dzrcv");
+
+ dyr = (float *)malloc(Nx1*sizeof(float));
+ dxr = (float *)malloc(Nx1*sizeof(float));
+ dzr = (float *)malloc(Nx1*sizeof(float));
+ if(!getparfloat("dyrcv", dyr)) dyr[0]=dy;
+ if(!getparfloat("dxrcv", dxr)) dxr[0]=dx;
+ if(!getparfloat("dzrcv", dzr)) dzr[0]=0.0;
+/* TODO logic extended to 3D */
+ 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;
+ }
+/* end TODO */
+ 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);
+ }
+ if (Ndy!=Ndz) {
+ verr("Number of 'dyrcv' (%d) is not equal to number of 'dzrcv' (%d) or 1",Ndy,Ndz);
+ }
+ }
+
+ /* check consistency of receiver steps */
+ for (iarray=0; iarray<Ndy; iarray++) {
+ if (dyr[iarray]<0) {
+ dyr[i]=dy;
+ vwarn("'dyrcv' element %d (%f) is less than zero, changing it to %f'",iarray,dyr[iarray],dy);
+ }
+ }
+ 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++) {
+ yrange = (yrcv2[iarray]-yrcv1[iarray]);
+ xrange = (xrcv2[iarray]-xrcv1[iarray]);
+ zrange = (zrcv2[iarray]-zrcv1[iarray]);
+ if (dyr[iarray] != 0.0) {
+ nlrcv[iarray] = NINT(fabs(yrange/dyr[iarray]))+1;
+ }
+ 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(yrcv1);
+ free(yrcv2);
+ free(xrcv1);
+ free(xrcv2);
+ free(zrcv1);
+ free(zrcv2);
+ free(dyr);
+ 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->y = (int *)calloc(rec->max_nrec,sizeof(int));
+ rec->x = (int *)calloc(rec->max_nrec,sizeof(int));
+ rec->z = (int *)calloc(rec->max_nrec,sizeof(int));
+ rec->yr = (float *)calloc(rec->max_nrec,sizeof(float));
+ 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("oyrcv",&oxrcv)) oyrcv=0.0;
+ 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->yr[ix] = oyrcv-sub_y0+rrcv*cos(((iy*dphi)/360.0)*(2.0*M_PI));
+ 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->y[ix] = NINT(rec->yr[ix]/dy);
+ 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: yrcv[%d]=%f xrcv=%f zrcv=%f\n", ix, rec->yr[ix]+sub_y0, rec->xr[ix]+sub_x0, rec->zr[ix]+sub_z0);
+ }
+ }
+ else { /* an ellipse */
+/*TODO fix for 3D */
+ /* 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 ) {
+ yr = rrcv*cos(ir*h+phase);
+ xr = rrcv*cos(ir*h+phase);
+ zr = arcv*sin(ir*h+phase);
+ rec->yr[ix] = oyrcv-sub_y0+xr;
+ rec->xr[ix] = oxrcv-sub_x0+xr;
+ rec->zr[ix] = ozrcv-sub_z0+zr;
+ rec->y[ix] = NINT(rec->yr[ix]/dy);
+ 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->y[ix] = MIN(ny-1, MAX(rec->y[ix], 0));
+ 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 */
+ yrcva = (float *)malloc(nrcv*sizeof(float));
+ xrcva = (float *)malloc(nrcv*sizeof(float));
+ zrcva = (float *)malloc(nrcv*sizeof(float));
+ /* Read in receiver coordinates */
+ for (i=0;i<nrcv;i++) {
+ if (fscanf(fp,"%e %e %e\n",&yrcva[i],&xrcva[i],&zrcva[i])!=3) vmess("Receiver Text File: Can not parse coordinates on line %d.",i);
+ }
+ /* Close file */
+ fclose(fp);
+ /* Process coordinates */
+ for (ix=0; ix<nrcv; ix++) {
+ rec->yr[nrec+ix] = yrcva[ix]-sub_y0;
+ rec->xr[nrec+ix] = xrcva[ix]-sub_x0;
+ rec->zr[nrec+ix] = zrcva[ix]-sub_z0;
+ rec->y[nrec+ix] = NINT((yrcva[ix]-sub_y0)/dy);
+ 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 Text Array: yrcv[%d]=%f xrcv=%f zrcv=%f\n", ix, rec->yr[ix]+sub_y0, rec->xr[ix]+sub_x0, rec->zr[ix]+sub_z0);
+ }
+ free(yrcva);
+ free(xrcva);
+ free(zrcva);
+ nrec += ntrcv;
+ }
+
+ /* Receiver Array */
+ if (nxrcv != 0) {
+ /* receiver array is defined */
+ yrcva = (float *)malloc(nxrcv*sizeof(float));
+ xrcva = (float *)malloc(nxrcv*sizeof(float));
+ zrcva = (float *)malloc(nxrcv*sizeof(float));
+ getparfloat("yrcva", yrcva);
+ getparfloat("xrcva", xrcva);
+ getparfloat("zrcva", zrcva);
+ for (ix=0; ix<nxrcv; ix++) {
+ rec->yr[nrec+ix] = yrcva[ix]-sub_y0;
+ rec->xr[nrec+ix] = xrcva[ix]-sub_x0;
+ rec->zr[nrec+ix] = zrcva[ix]-sub_z0;
+ rec->y[nrec+ix] = NINT((yrcva[ix]-sub_y0)/dy);
+ 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: yrcv[%d]=%f xrcv=%f zrcv=%f\n", ix, rec->yr[ix]+sub_y0, rec->xr[ix]+sub_x0, rec->zr[ix]+sub_z0);
+ }
+ free(yrcva);
+ free(xrcva);
+ free(zrcva);
+ nrec += nxrcv;
+ }
+
+ /* Linear Receiver Arrays */
+ if (nrcv!=0) {
+ yrcv1 = (float *)malloc(Nx1*sizeof(float));
+ yrcv2 = (float *)malloc(Nx1*sizeof(float));
+ 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("yrcv1", yrcv1)) yrcv1[0]=sub_y0;
+ if(!getparfloat("yrcv2", yrcv2)) yrcv2[0]=(ny-1)*dy+sub_y0;
+ 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];
+
+ Ndy = countparval("dyrcv");
+ Ndx = countparval("dxrcv");
+ Ndz = countparval("dzrcv");
+
+ dyr = (float *)malloc(Nx1*sizeof(float));
+ dxr = (float *)malloc(Nx1*sizeof(float));
+ dzr = (float *)malloc(Nx1*sizeof(float));
+ if(!getparfloat("dyrcv", dyr)) dyr[0]=dy;
+ 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++) {
+ dyr[i] = dyr[0];
+ 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++) {
+ dyr[i] = dyr[0];
+ 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 (Ndy>1) assert(Ndy==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++) {
+ yrcv1[iarray] = MAX(sub_y0, yrcv1[iarray]);
+ yrcv1[iarray] = MIN(sub_y0+ny*dy,yrcv1[iarray]);
+ yrcv2[iarray] = MAX(sub_y0, yrcv2[iarray]);
+ yrcv2[iarray] = MIN(sub_y0+ny*dy,yrcv2[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++) {
+ yrange = (yrcv2[iarray]-yrcv1[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->yr[nrec]=yrcv1[iarray]-sub_y0+ir*dyrcv;
+ rec->xr[nrec]=xrcv1[iarray]-sub_x0+ir*dxrcv;
+ rec->zr[nrec]=zrcv1[iarray]-sub_z0+ir*dzrcv;
+
+ rec->y[nrec]=NINT((rec->yr[nrec])/dy);
+ rec->x[nrec]=NINT((rec->xr[nrec])/dx);
+ rec->z[nrec]=NINT((rec->zr[nrec])/dz);
+ nrec++;
+ }
+ }
+ free(yrcv1);
+ free(yrcv2);
+ free(xrcv1);
+ free(xrcv2);
+ free(zrcv1);
+ free(zrcv2);
+ free(dyr);
+ free(dxr);
+ free(dzr);
+ free(nlrcv);
+ }
+
+ rec->n=rec->max_nrec;
+ return 0;
+}
diff --git a/raytime3d/segy.h b/raytime3d/segy.h
new file mode 100644
index 0000000000000000000000000000000000000000..d0a0d769d1548115b04396076b4a15d5be0ee687
--- /dev/null
+++ b/raytime3d/segy.h
@@ -0,0 +1,849 @@
+/* Copyright (c) Colorado School of Mines, 2011.*/
+/* All rights reserved. */
+
+/* segy.h - include file for SEGY traces
+ *
+ * declarations for:
+ * typedef struct {} segy - the trace identification header
+ * typedef struct {} bhed - binary header
+ *
+ * Note:
+ * If header words are added, run the makefile in this directory
+ * to recreate hdr.h.
+ *
+ * Reference:
+ * K. M. Barry, D. A. Cavers and C. W. Kneale, "Special Report:
+ * Recommended Standards for Digital Tape Formats",
+ * Geophysics, vol. 40, no. 2 (April 1975), P. 344-352.
+ *
+ * $Author: john $
+ * $Source: /usr/local/cwp/src/su/include/RCS/segy.h,v $
+ * $Revision: 1.33 $ ; $Date: 2011/11/11 23:56:14 $
+ */
+
+#include <limits.h>
+#include "par.h"
+
+#ifndef SEGY_H
+#define SEGY_H
+#define TRCBYTES 240
+
+#define SU_NFLTS 32767 /* Arbitrary limit on data array size */
+
+
+/* TYPEDEFS */
+typedef struct { /* segy - trace identification header */
+
+ int tracl; /* Trace sequence number within line
+ --numbers continue to increase if the
+ same line continues across multiple
+ SEG Y files.
+ byte# 1-4
+ */
+
+ int tracr; /* Trace sequence number within SEG Y file
+ ---each file starts with trace sequence
+ one
+ byte# 5-8
+ */
+
+ int fldr; /* Original field record number
+ byte# 9-12
+ */
+
+ int tracf; /* Trace number within original field record
+ byte# 13-16
+ */
+
+ int ep; /* energy source point number
+ ---Used when more than one record occurs
+ at the same effective surface location.
+ byte# 17-20
+ */
+
+ int cdp; /* Ensemble number (i.e. CDP, CMP, CRP,...)
+ byte# 21-24
+ */
+
+ int cdpt; /* trace number within the ensemble
+ ---each ensemble starts with trace number one.
+ byte# 25-28
+ */
+
+ short trid; /* trace identification code:
+ -1 = Other
+ 0 = Unknown
+ 1 = Seismic data
+ 2 = Dead
+ 3 = Dummy
+ 4 = Time break
+ 5 = Uphole
+ 6 = Sweep
+ 7 = Timing
+ 8 = Water break
+ 9 = Near-field gun signature
+ 10 = Far-field gun signature
+ 11 = Seismic pressure sensor
+ 12 = Multicomponent seismic sensor
+ - Vertical component
+ 13 = Multicomponent seismic sensor
+ - Cross-line component
+ 14 = Multicomponent seismic sensor
+ - in-line component
+ 15 = Rotated multicomponent seismic sensor
+ - Vertical component
+ 16 = Rotated multicomponent seismic sensor
+ - Transverse component
+ 17 = Rotated multicomponent seismic sensor
+ - Radial component
+ 18 = Vibrator reaction mass
+ 19 = Vibrator baseplate
+ 20 = Vibrator estimated ground force
+ 21 = Vibrator reference
+ 22 = Time-velocity pairs
+ 23 ... N = optional use
+ (maximum N = 32,767)
+
+ Following are CWP id flags:
+
+ 109 = autocorrelation
+ 110 = Fourier transformed - no packing
+ xr[0],xi[0], ..., xr[N-1],xi[N-1]
+ 111 = Fourier transformed - unpacked Nyquist
+ xr[0],xi[0],...,xr[N/2],xi[N/2]
+ 112 = Fourier transformed - packed Nyquist
+ even N:
+ xr[0],xr[N/2],xr[1],xi[1], ...,
+ xr[N/2 -1],xi[N/2 -1]
+ (note the exceptional second entry)
+ odd N:
+ xr[0],xr[(N-1)/2],xr[1],xi[1], ...,
+ xr[(N-1)/2 -1],xi[(N-1)/2 -1],xi[(N-1)/2]
+ (note the exceptional second & last entries)
+ 113 = Complex signal in the time domain
+ xr[0],xi[0], ..., xr[N-1],xi[N-1]
+ 114 = Fourier transformed - amplitude/phase
+ a[0],p[0], ..., a[N-1],p[N-1]
+ 115 = Complex time signal - amplitude/phase
+ a[0],p[0], ..., a[N-1],p[N-1]
+ 116 = Real part of complex trace from 0 to Nyquist
+ 117 = Imag part of complex trace from 0 to Nyquist
+ 118 = Amplitude of complex trace from 0 to Nyquist
+ 119 = Phase of complex trace from 0 to Nyquist
+ 121 = Wavenumber time domain (k-t)
+ 122 = Wavenumber frequency (k-omega)
+ 123 = Envelope of the complex time trace
+ 124 = Phase of the complex time trace
+ 125 = Frequency of the complex time trace
+ 130 = Depth-Range (z-x) traces
+ 201 = Seismic data packed to bytes (by supack1)
+ 202 = Seismic data packed to 2 bytes (by supack2)
+ byte# 29-30
+ */
+
+ short nvs; /* Number of vertically summed traces yielding
+ this trace. (1 is one trace,
+ 2 is two summed traces, etc.)
+ byte# 31-32
+ */
+
+ short nhs; /* Number of horizontally summed traces yielding
+ this trace. (1 is one trace
+ 2 is two summed traces, etc.)
+ byte# 33-34
+ */
+
+ short duse; /* Data use:
+ 1 = Production
+ 2 = Test
+ byte# 35-36
+ */
+
+ int offset; /* Distance from the center of the source point
+ to the center of the receiver group
+ (negative if opposite to direction in which
+ the line was shot).
+ byte# 37-40
+ */
+
+ int gelev; /* Receiver group elevation from sea level
+ (all elevations above the Vertical datum are
+ positive and below are negative).
+ byte# 41-44
+ */
+
+ int selev; /* Surface elevation at source.
+ byte# 45-48
+ */
+
+ int sdepth; /* Source depth below surface (a positive number).
+ byte# 49-52
+ */
+
+ int gdel; /* Datum elevation at receiver group.
+ byte# 53-56
+ */
+
+ int sdel; /* Datum elevation at source.
+ byte# 57-60
+ */
+
+ int swdep; /* Water depth at source.
+ byte# 61-64
+ */
+
+ int gwdep; /* Water depth at receiver group.
+ byte# 65-68
+ */
+
+ short scalel; /* Scalar to be applied to the previous 7 entries
+ to give the real value.
+ Scalar = 1, +10, +100, +1000, +10000.
+ If positive, scalar is used as a multiplier,
+ if negative, scalar is used as a divisor.
+ byte# 69-70
+ */
+
+ short scalco; /* Scalar to be applied to the next 4 entries
+ to give the real value.
+ Scalar = 1, +10, +100, +1000, +10000.
+ If positive, scalar is used as a multiplier,
+ if negative, scalar is used as a divisor.
+ byte# 71-72
+ */
+
+ int sx; /* Source coordinate - X
+ byte# 73-76
+ */
+
+ int sy; /* Source coordinate - Y
+ byte# 77-80
+ */
+
+ int gx; /* Group coordinate - X
+ byte# 81-84
+ */
+
+ int gy; /* Group coordinate - Y
+ byte# 85-88
+ */
+
+ short counit; /* Coordinate units: (for previous 4 entries and
+ for the 7 entries before scalel)
+ 1 = Length (meters or feet)
+ 2 = Seconds of arc
+ 3 = Decimal degrees
+ 4 = Degrees, minutes, seconds (DMS)
+
+ In case 2, the X values are longitude and
+ the Y values are latitude, a positive value designates
+ the number of seconds east of Greenwich
+ or north of the equator
+
+ In case 4, to encode +-DDDMMSS
+ counit = +-DDD*10^4 + MM*10^2 + SS,
+ with scalco = 1. To encode +-DDDMMSS.ss
+ counit = +-DDD*10^6 + MM*10^4 + SS*10^2
+ with scalco = -100.
+ byte# 89-90
+ */
+
+ short wevel; /* Weathering velocity.
+ byte# 91-92
+ */
+
+ short swevel; /* Subweathering velocity.
+ byte# 93-94
+ */
+
+ short sut; /* Uphole time at source in milliseconds.
+ byte# 95-96
+ */
+
+ short gut; /* Uphole time at receiver group in milliseconds.
+ byte# 97-98
+ */
+
+ short sstat; /* Source static correction in milliseconds.
+ byte# 99-100
+ */
+
+ short gstat; /* Group static correction in milliseconds.
+ byte# 101-102
+ */
+
+ short tstat; /* Total static applied in milliseconds.
+ (Zero if no static has been applied.)
+ byte# 103-104
+ */
+
+ short laga; /* Lag time A, time in ms between end of 240-
+ byte trace identification header and time
+ break, positive if time break occurs after
+ end of header, time break is defined as
+ the initiation pulse which maybe recorded
+ on an auxiliary trace or as otherwise
+ specified by the recording system
+ byte# 105-106
+ */
+
+ short lagb; /* lag time B, time in ms between the time break
+ and the initiation time of the energy source,
+ may be positive or negative
+ byte# 107-108
+ */
+
+ short delrt; /* delay recording time, time in ms between
+ initiation time of energy source and time
+ when recording of data samples begins
+ (for deep water work if recording does not
+ start at zero time)
+ byte# 109-110
+ */
+
+ short muts; /* mute time--start
+ byte# 111-112
+ */
+
+ short mute; /* mute time--end
+ byte# 113-114
+ */
+
+ unsigned short ns; /* number of samples in this trace
+ byte# 115-116
+ */
+
+ unsigned short dt; /* sample interval; in micro-seconds
+ byte# 117-118
+ */
+
+ short gain; /* gain type of field instruments code:
+ 1 = fixed
+ 2 = binary
+ 3 = floating point
+ 4 ---- N = optional use
+ byte# 119-120
+ */
+
+ short igc; /* instrument gain constant
+ byte# 121-122
+ */
+
+ short igi; /* instrument early or initial gain
+ byte# 123-124
+ */
+
+ short corr; /* correlated:
+ 1 = no
+ 2 = yes
+ byte# 125-126
+ */
+
+ short sfs; /* sweep frequency at start
+ byte# 127-128
+ */
+
+ short sfe; /* sweep frequency at end
+ byte# 129-130
+ */
+
+ short slen; /* sweep length in ms
+ byte# 131-132
+ */
+
+ short styp; /* sweep type code:
+ 1 = linear
+ 2 = cos-squared
+ 3 = other
+ byte# 133-134
+ */
+
+ short stas; /* sweep trace length at start in ms
+ byte# 135-136
+ */
+
+ short stae; /* sweep trace length at end in ms
+ byte# 137-138
+ */
+
+ short tatyp; /* taper type: 1=linear, 2=cos^2, 3=other
+ byte# 139-140
+ */
+
+ short afilf; /* alias filter frequency if used
+ byte# 141-142
+ */
+
+ short afils; /* alias filter slope
+ byte# 143-144
+ */
+
+ short nofilf; /* notch filter frequency if used
+ byte# 145-146
+ */
+
+ short nofils; /* notch filter slope
+ byte# 147-148
+ */
+
+ short lcf; /* low cut frequency if used
+ byte# 149-150
+ */
+
+ short hcf; /* high cut frequncy if used
+ byte# 151-152
+ */
+
+ short lcs; /* low cut slope
+ byte# 153-154
+ */
+
+ short hcs; /* high cut slope
+ byte# 155-156
+ */
+
+ short year; /* year data recorded
+ byte# 157-158
+ */
+
+ short day; /* day of year
+ byte# 159-160
+ */
+
+ short hour; /* hour of day (24 hour clock)
+ byte# 161-162
+ */
+
+ short minute; /* minute of hour
+ byte# 163-164
+ */
+
+ short sec; /* second of minute
+ byte# 165-166
+ */
+
+ short timbas; /* time basis code:
+ 1 = local
+ 2 = GMT
+ 3 = other
+ byte# 167-168
+ */
+
+ short trwf; /* trace weighting factor, defined as 1/2^N
+ volts for the least sigificant bit
+ byte# 169-170
+ */
+
+ short grnors; /* geophone group number of roll switch
+ position one
+ byte# 171-172
+ */
+
+ short grnofr; /* geophone group number of trace one within
+ original field record
+ byte# 173-174
+ */
+
+ short grnlof; /* geophone group number of last trace within
+ original field record
+ byte# 175-176
+ */
+
+ short gaps; /* gap size (total number of groups dropped)
+ byte# 177-178
+ */
+
+ short otrav; /* overtravel taper code:
+ 1 = down (or behind)
+ 2 = up (or ahead)
+ byte# 179-180
+ */
+
+#ifdef SLTSU_SEGY_H /* begin Unocal SU segy.h differences */
+
+
+ /* cwp local assignments */
+ float d1; /* sample spacing for non-seismic data
+ byte# 181-184
+ */
+
+ float f1; /* first sample location for non-seismic data
+ byte# 185-188
+ */
+
+ float d2; /* sample spacing between traces
+ byte# 189-192
+ */
+
+ float f2; /* first trace location
+ byte# 193-196
+ */
+
+ float ungpow; /* negative of power used for dynamic
+ range compression
+ byte# 197-200
+ */
+
+ float unscale; /* reciprocal of scaling factor to normalize
+ range
+ byte# 201-204
+ */
+
+ short mark; /* mark selected traces
+ byte# 205-206
+ */
+
+ /* SLTSU local assignments */
+ short mutb; /* mute time at bottom (start time)
+ bottom mute ends at last sample
+ byte# 207-208
+ */
+ float dz; /* depth sampling interval in (m or ft)
+ if =0.0, input are time samples
+ byte# 209-212
+ */
+
+ float fz; /* depth of first sample in (m or ft)
+ byte# 213-116
+ */
+
+ short n2; /* number of traces per cdp or per shot
+ byte# 217-218
+ */
+
+ short shortpad; /* alignment padding
+ byte# 219-220
+ */
+
+ int ntr; /* number of traces
+ byte# 221-224
+ */
+
+ /* SLTSU local assignments end */
+
+ short unass[8]; /* unassigned
+ byte# 225-240
+ */
+
+#else
+
+ /* cwp local assignments */
+ float d1; /* sample spacing for non-seismic data
+ byte# 181-184
+ */
+
+ float f1; /* first sample location for non-seismic data
+ byte# 185-188
+ */
+
+ float d2; /* sample spacing between traces
+ byte# 189-192
+ */
+
+ float f2; /* first trace location
+ byte# 193-196
+ */
+
+ float ungpow; /* negative of power used for dynamic
+ range compression
+ byte# 197-200
+ */
+
+ float unscale; /* reciprocal of scaling factor to normalize
+ range
+ byte# 201-204
+ */
+
+ int ntr; /* number of traces
+ byte# 205-208
+ */
+
+ short mark; /* mark selected traces
+ byte# 209-210
+ */
+
+ short shortpad; /* alignment padding
+ byte# 211-212
+ */
+
+
+ short unass[14]; /* unassigned--NOTE: last entry causes
+ a break in the word alignment, if we REALLY
+ want to maintain 240 bytes, the following
+ entry should be an odd number of short/UINT2
+ OR do the insertion above the "mark" keyword
+ entry
+ byte# 213-240
+ */
+#endif
+
+} segy;
+
+
+typedef struct { /* bhed - binary header */
+
+ int jobid; /* job identification number */
+
+ int lino; /* line number (only one line per reel) */
+
+ int reno; /* reel number */
+
+ short ntrpr; /* number of data traces per record */
+
+ short nart; /* number of auxiliary traces per record */
+
+ unsigned short hdt; /* sample interval in micro secs for this reel */
+
+ unsigned short dto; /* same for original field recording */
+
+ unsigned short hns; /* number of samples per trace for this reel */
+
+ unsigned short nso; /* same for original field recording */
+
+ short format; /* data sample format code:
+ 1 = floating point, 4 byte (32 bits)
+ 2 = fixed point, 4 byte (32 bits)
+ 3 = fixed point, 2 byte (16 bits)
+ 4 = fixed point w/gain code, 4 byte (32 bits)
+ 5 = IEEE floating point, 4 byte (32 bits)
+ 8 = two's complement integer, 1 byte (8 bits)
+ */
+
+ short fold; /* CDP fold expected per CDP ensemble */
+
+ short tsort; /* trace sorting code:
+ 1 = as recorded (no sorting)
+ 2 = CDP ensemble
+ 3 = single fold continuous profile
+ 4 = horizontally stacked */
+
+ short vscode; /* vertical sum code:
+ 1 = no sum
+ 2 = two sum ...
+ N = N sum (N = 32,767) */
+
+ short hsfs; /* sweep frequency at start */
+
+ short hsfe; /* sweep frequency at end */
+
+ short hslen; /* sweep length (ms) */
+
+ short hstyp; /* sweep type code:
+ 1 = linear
+ 2 = parabolic
+ 3 = exponential
+ 4 = other */
+
+ short schn; /* trace number of sweep channel */
+
+ short hstas; /* sweep trace taper length at start if
+ tapered (the taper starts at zero time
+ and is effective for this length) */
+
+ short hstae; /* sweep trace taper length at end (the ending
+ taper starts at sweep length minus the taper
+ length at end) */
+
+ short htatyp; /* sweep trace taper type code:
+ 1 = linear
+ 2 = cos-squared
+ 3 = other */
+
+ short hcorr; /* correlated data traces code:
+ 1 = no
+ 2 = yes */
+
+ short bgrcv; /* binary gain recovered code:
+ 1 = yes
+ 2 = no */
+
+ short rcvm; /* amplitude recovery method code:
+ 1 = none
+ 2 = spherical divergence
+ 3 = AGC
+ 4 = other */
+
+ short mfeet; /* measurement system code:
+ 1 = meters
+ 2 = feet */
+
+ short polyt; /* impulse signal polarity code:
+ 1 = increase in pressure or upward
+ geophone case movement gives
+ negative number on tape
+ 2 = increase in pressure or upward
+ geophone case movement gives
+ positive number on tape */
+
+ short vpol; /* vibratory polarity code:
+ code seismic signal lags pilot by
+ 1 337.5 to 22.5 degrees
+ 2 22.5 to 67.5 degrees
+ 3 67.5 to 112.5 degrees
+ 4 112.5 to 157.5 degrees
+ 5 157.5 to 202.5 degrees
+ 6 202.5 to 247.5 degrees
+ 7 247.5 to 292.5 degrees
+ 8 293.5 to 337.5 degrees */
+
+ short hunass[170]; /* unassigned */
+
+} bhed;
+
+/* DEFINES */
+#define gettr(x) fgettr(stdin, (x))
+#define vgettr(x) fvgettr(stdin, (x))
+#define puttr(x) fputtr(stdout, (x))
+#define vputtr(x) fvputtr(stdout, (x))
+#define gettra(x, y) fgettra(stdin, (x), (y))
+
+
+/* TOTHER represents "other" */
+#define TOTHER -1
+/* TUNK represents time traces of an unknown type */
+#define TUNK 0
+/* TREAL represents real time traces */
+#define TREAL 1
+/* TDEAD represents dead time traces */
+#define TDEAD 2
+/* TDUMMY represents dummy time traces */
+#define TDUMMY 3
+/* TBREAK represents time break traces */
+#define TBREAK 4
+/* UPHOLE represents uphole traces */
+#define UPHOLE 5
+/* SWEEP represents sweep traces */
+#define SWEEP 6
+/* TIMING represents timing traces */
+#define TIMING 7
+/* WBREAK represents timing traces */
+#define WBREAK 8
+/* NFGUNSIG represents near field gun signature */
+#define NFGUNSIG 9
+/* FFGUNSIG represents far field gun signature */
+#define FFGUNSIG 10
+/* SPSENSOR represents seismic pressure sensor */
+#define SPSENSOR 11
+/* TVERT represents multicomponent seismic sensor
+ - vertical component */
+#define TVERT 12
+/* TXLIN represents multicomponent seismic sensor
+ - cross-line component */
+#define TXLIN 13
+/* TINLIN represents multicomponent seismic sensor
+ - in-line component */
+#define TINLIN 14
+/* ROTVERT represents rotated multicomponent seismic sensor
+ - vertical component */
+#define ROTVERT 15
+/* TTRANS represents rotated multicomponent seismic sensor
+ - transverse component */
+#define TTRANS 16
+/* TRADIAL represents rotated multicomponent seismic sensor
+ - radial component */
+#define TRADIAL 17
+/* VRMASS represents vibrator reaction mass */
+#define VRMASS 18
+/* VBASS represents vibrator baseplate */
+#define VBASS 19
+/* VEGF represents vibrator estimated ground force */
+#define VEGF 20
+/* VREF represents vibrator reference */
+#define VREF 21
+
+/*** CWP trid assignments ***/
+/* ACOR represents autocorrelation */
+#define ACOR 109
+/* FCMPLX represents fourier transformed - no packing
+ xr[0],xi[0], ..., xr[N-1],xi[N-1] */
+#define FCMPLX 110
+/* FUNPACKNYQ represents fourier transformed - unpacked Nyquist
+ xr[0],xi[0],...,xr[N/2],xi[N/2] */
+#define FUNPACKNYQ 111
+/* FTPACK represents fourier transformed - packed Nyquist
+ even N: xr[0],xr[N/2],xr[1],xi[1], ...,
+ xr[N/2 -1],xi[N/2 -1]
+ (note the exceptional second entry)
+ odd N:
+ xr[0],xr[(N-1)/2],xr[1],xi[1], ...,
+ xr[(N-1)/2 -1],xi[(N-1)/2 -1],xi[(N-1)/2]
+ (note the exceptional second & last entries)
+*/
+#define FTPACK 112
+/* TCMPLX represents complex time traces */
+#define TCMPLX 113
+/* FAMPH represents freq domain data in amplitude/phase form */
+#define FAMPH 114
+/* TAMPH represents time domain data in amplitude/phase form */
+#define TAMPH 115
+/* REALPART represents the real part of a trace to Nyquist */
+#define REALPART 116
+/* IMAGPART represents the real part of a trace to Nyquist */
+#define IMAGPART 117
+/* AMPLITUDE represents the amplitude of a trace to Nyquist */
+#define AMPLITUDE 118
+/* PHASE represents the phase of a trace to Nyquist */
+#define PHASE 119
+/* KT represents wavenumber-time domain data */
+#define KT 121
+/* KOMEGA represents wavenumber-frequency domain data */
+#define KOMEGA 122
+/* ENVELOPE represents the envelope of the complex time trace */
+#define ENVELOPE 123
+/* INSTPHASE represents the phase of the complex time trace */
+#define INSTPHASE 124
+/* INSTFREQ represents the frequency of the complex time trace */
+#define INSTFREQ 125
+/* DEPTH represents traces in depth-range (z-x) */
+#define TRID_DEPTH 130
+/* 3C data... v,h1,h2=(11,12,13)+32 so a bitmask will convert */
+/* between conventions */
+/* CHARPACK represents byte packed seismic data from supack1 */
+#define CHARPACK 201
+/* SHORTPACK represents 2 byte packed seismic data from supack2 */
+#define SHORTPACK 202
+
+
+#define ISSEISMIC(id) (( (id)==TUNK || (id)==TREAL || (id)==TDEAD || (id)==TDUMMY || (id)==TBREAK || (id)==UPHOLE || (id)==SWEEP || (id)==TIMING || (id)==WBREAK || (id)==NFGUNSIG || (id)==FFGUNSIG || (id)==SPSENSOR || (id)==TVERT || (id)==TXLIN || (id)==TINLIN || (id)==ROTVERT || (id)==TTRANS || (id)==TRADIAL || (id)==ACOR ) ? cwp_true : cwp_false )
+
+/* FUNCTION PROTOTYPES */
+#ifdef __cplusplus /* if C++, specify external linkage to C functions */
+extern "C" {
+#endif
+
+/* get trace and put trace */
+int fgettr(FILE *fp, segy *tp);
+int fvgettr(FILE *fp, segy *tp);
+void fputtr(FILE *fp, segy *tp);
+void fvputtr(FILE *fp, segy *tp);
+int fgettra(FILE *fp, segy *tp, int itr);
+
+/* get gather and put gather */
+segy **fget_gather(FILE *fp, cwp_String *key,cwp_String *type,Value *n_val,
+ int *nt,int *ntr, float *dt,int *first);
+segy **get_gather(cwp_String *key, cwp_String *type, Value *n_val,
+ int *nt, int *ntr, float *dt, int *first);
+segy **fput_gather(FILE *fp, segy **rec,int *nt, int *ntr);
+segy **put_gather(segy **rec,int *nt, int *ntr);
+
+/* hdrpkge */
+void gethval(const segy *tp, int index, Value *valp);
+void puthval(segy *tp, int index, Value *valp);
+void getbhval(const bhed *bhp, int index, Value *valp);
+void putbhval(bhed *bhp, int index, Value *valp);
+void gethdval(const segy *tp, char *key, Value *valp);
+void puthdval(segy *tp, char *key, Value *valp);
+char *hdtype(const char *key);
+char *getkey(const int index);
+int getindex(const char *key);
+void swaphval(segy *tp, int index);
+void swapbhval(bhed *bhp, int index);
+void printheader(const segy *tp);
+
+void tabplot(segy *tp, int itmin, int itmax);
+
+#ifdef __cplusplus /* if C++, end external linkage specification */
+}
+#endif
+
+#endif
diff --git a/raytime3d/src3d.c b/raytime3d/src3d.c
new file mode 100644
index 0000000000000000000000000000000000000000..545c1974d14ab60f4bd28b259e68d2d4b4ee0e21
--- /dev/null
+++ b/raytime3d/src3d.c
@@ -0,0 +1,211 @@
+#include<stdlib.h>
+#include<stdio.h>
+#include<math.h>
+#include<assert.h>
+#include<string.h>
+#include <fcntl.h>
+
+#define t0(x,y,z) time0[nxy*(z) + nx*(y) + (x)]
+#define s0(x,y,z) slow0[nxy*(z) + nx*(y) + (x)]
+#define SQR(x) ((x) * (x))
+#define DIST(x,y,z,x1,y1,z1) sqrt(SQR(x-(x1))+SQR(y-(y1)) + SQR(z-(z1)))
+
+/* definitions from verbose.c */
+extern void verr(char *fmt, ...);
+extern void vwarn(char *fmt, ...);
+extern void vmess(char *fmt, ...);
+
+void src3d(float *time0, float *slow0, int nz, int nx, int ny, float h, float ox, float oy, float oz, int *pxs, int *pys, int *pzs, int *cube)
+{
+ int
+ srctype=1, /* if 1, source is a point;
+ 2, source is on the walls of the data volume;
+ 3, source on wall, time field known; */
+ srcwall, /* if 1, source on x=0 wall, if 2, on x=nx-1 wall
+ if 3, source on y=0 wall, if 4, on y=ny-1 wall
+ if 5, source on z=0 wall, if 6, on z=nz-1 wall */
+ xs, /* shot x position (in grid points) */
+ ys, /* shot y position */
+ zs, /* shot depth */
+ xx, yy, zz, /* Used to loop around xs, ys, zs coordinates */
+ ii, i, j, k,
+ wfint, ofint,
+ nxy, nyz, nxz, nxyz, nwall,
+ NCUBE=2;
+ float
+ fxs, /* shot position in X (in real units)*/
+ fys, /* shot position in Y (in real units)*/
+ fzs, /* shot position in Z (in real units)*/
+ *wall,
+ /* maximum offset (real units) to compute */
+ /* used in linear velocity gradient cube source */
+ rx, ry, rz, dvz, dv, v0,
+ rzc, rxyc, rz1, rxy1, rho, theta1, theta2,
+ xsrc1, ysrc1, zsrc1;
+ char
+ *oldtfile, /* file through which old travel times are input */
+ *wallfile; /* file containing input wall values of traveltimes */
+
+
+ if(!getparint("NCUBE",&NCUBE)) NCUBE=2;
+
+ if(!getparint("srctype",&srctype)) srctype=1;
+ if(srctype==1) {
+ if(!getparfloat("xsrc1",&xsrc1)) verr("xsrc1 not given");
+ if(!getparfloat("ysrc1",&ysrc1)) verr("ysrc1 not given");
+ if(!getparfloat("zsrc1",&zsrc1)) verr("zsrc1 not given");
+ fxs = (xsrc1-ox)/h;
+ fys = (ysrc1-oy)/h;
+ fzs = (zsrc1-oz)/h;
+ xs = (int)(fxs + 0.5);
+ ys = (int)(fys + 0.5);
+ zs = (int)(fzs + 0.5);
+ if(xs<2 || ys<2 || zs<2 || xs>nx-3 || ys>ny-3 || zs>nz-3){
+ vwarn("Source near an edge, beware of traveltime errors");
+ vwarn("for raypaths that travel parallel to edge ");
+ vwarn("while wavefronts are strongly curved, (JV, 8/17/88)\n");
+ }
+ *pxs = xs; *pys = ys, *pzs = zs, *cube = NCUBE;
+ }
+ else if (srctype==2) {
+ if (!getparint("srcwall",&srcwall)) verr("srcwall not given");
+ if (!getparstring("wallfile",&wallfile)) verr("wallfile not given");
+ if((wfint=open(wallfile,O_RDONLY,0664))<=1) {
+ fprintf(stderr,"cannot open %s\n",wallfile);
+ exit(-1);
+ }
+ }
+ else if (srctype==3) {
+ if (!getparint("srcwall",&srcwall)) verr("srcwall not given");
+ if (!getparstring("oldtfile",&oldtfile)) verr("oldtfile not given");
+ if((ofint=open(oldtfile,O_RDONLY,0664))<=1) {
+ fprintf(stderr,"cannot open %s\n",oldtfile);
+ exit(-1);
+ }
+ }
+ else {
+ verr("ERROR: incorrect value of srctype");
+ }
+
+ nxy = nx * ny;
+ nyz = ny * nz;
+ nxz = nx * nz;
+ nxyz = nx * ny * nz;
+
+
+ /* SET TIMES TO DUMMY VALUE */
+ for(i=0;i<nxyz;i++) time0[i] = 1.0e10;
+
+ if (srctype == 1) { /* VIDALE'S POINT SOURCE */
+ /* FILL IN CUBE AROUND SOURCE POINT */
+ /* HOLE'S NEW LINEAR VELOCITY GRADIENT CUBE (APRIL 1991)*/
+ v0 = h/s0(xs,ys,zs);
+ for (xx = xs-NCUBE; xx <= xs+NCUBE; xx++) {
+ if (xx < 0 || xx >= nx) continue;
+ for (yy = ys-NCUBE; yy <= ys+NCUBE; yy++) {
+ if (yy < 0 || yy >= ny) continue;
+ for (zz = zs-NCUBE; zz <= zs+NCUBE; zz++) {
+ if (zz < 0 || zz >= nz) continue;
+ if (zz == zs)
+ dvz = 1/s0(xx,yy,zz+1)-1/s0(xs,ys,zs);
+ else
+ dvz = (1/s0(xx,yy,zz)-1/s0(xs,ys,zs))/(zz-zs);
+ dv = fabs(dvz);
+ if (dv == 0.) {
+ t0(xx,yy,zz) = s0(xs,ys,zs)*DIST(fxs,fys,fzs,xx,yy,zz);
+ continue;
+ }
+ rzc = -v0/dv;
+ rx = h*(xx - fxs);
+ ry = h*(yy - fys);
+ rz = h*(zz - fzs);
+ rz1 = rz*dvz/dv;
+ rxy1 = sqrt(rx*rx+ry*ry+rz*rz-rz1*rz1);
+ if (rxy1<=h/1.e6)
+ t0(xx,yy,zz) = fabs(log((v0+dv*rz1)/v0)/dv);
+ else {
+ rxyc = (rz1*rz1+rxy1*rxy1-2*rz1*rzc)/(2*rxy1);
+ rho = sqrt(rzc*rzc+rxyc*rxyc);
+ theta1 = asin(-rzc/rho);
+ /* can't handle asin(1.) ! */
+ if (fabs(rz1-rzc)>=rho) rho=1.0000001*fabs(rz1-rzc);
+ theta2 = asin((rz1-rzc)/rho);
+ if (rxyc<0) theta1=M_PI-theta1;
+ if (rxyc<rxy1) theta2=M_PI-theta2;
+ t0(xx,yy,zz) = log(tan(theta2/2)/tan(theta1/2)) / dv;
+ }
+ }
+ }
+ }
+ }
+ else if (srctype == 2) { /* HOLE'S EXTERNAL SOURCE */
+
+ /* FILL IN WALLS' TIMES FROM EXTERNAL DATAFILE */
+ read (wfint,wall,4*nwall); /* READ X=0 WALL */
+ if (wall[0]>-1.e-20) {
+ ii = 0;
+ for (k=0; k<nz; k++) {
+ for (j=0; j<ny; j++) {
+ t0(0,j,k) = wall[ii];
+ ii++;
+ }
+ }
+ }
+ read (wfint,wall,4*nwall); /* READ X=NX-1 WALL */
+ if (wall[0]>-1.e-20) {
+ ii = 0;
+ for (k=0; k<nz; k++) {
+ for (j=0; j<ny; j++) {
+ t0(nx-1,j,k) = wall[ii];
+ ii++;
+ }
+ }
+ }
+ read (wfint,wall,4*nwall); /* READ Y=0 WALL */
+ if (wall[0]>-1.e-20) {
+ ii = 0;
+ for (k=0; k<nz; k++) {
+ for (i=0; i<nx; i++) {
+ t0(i,0,k) = wall[ii];
+ ii++;
+ }
+ }
+ }
+ read (wfint,wall,4*nwall); /* READ Y=NY-1 WALL */
+ if (wall[0]>-1.e-20) {
+ ii = 0;
+ for (k=0; k<nz; k++) {
+ for (i=0; i<nx; i++) {
+ t0(i,ny-1,k) = wall[ii];
+ ii++;
+ }
+ }
+ }
+ read (wfint,wall,4*nwall); /* READ Z=0 WALL */
+ if (wall[0]>-1.e-20) {
+ ii = 0;
+ for (j=0; j<ny; j++) {
+ for (i=0; i<nx; i++) {
+ t0(i,j,0) = wall[ii];
+ ii++;
+ }
+ }
+ }
+ read (wfint,wall,4*nwall); /* READ Z=NZ-1 WALL */
+ if (wall[0]>-1.e-20) {
+ ii = 0;
+ for (j=0; j<ny; j++) {
+ for (i=0; i<nx; i++) {
+ t0(i,j,nz-1) = wall[ii];
+ ii++;
+ }
+ }
+ }
+ }
+ else if (srctype == 3) { /* HOLE'S REDO OLD TIMES */
+ /* READ IN OLD TIME FILE */
+ if (srctype == 3) read(ofint,time0,nxyz*4);
+ }
+
+ return;
+}
diff --git a/raytime3d/threadAffinity.c b/raytime3d/threadAffinity.c
new file mode 100644
index 0000000000000000000000000000000000000000..49ca7e9d45bb953c9e63601c217d2deef69afcd1
--- /dev/null
+++ b/raytime3d/threadAffinity.c
@@ -0,0 +1,109 @@
+#define _GNU_SOURCE
+
+#include <stdio.h>
+#include <unistd.h>
+#include <string.h>
+#ifdef __USE_GNU
+#include <omp.h>
+#include <sched.h>
+#else /* for OSX */
+#include <sched.h>
+#include <sys/types.h>
+#include <sys/sysctl.h>
+
+#define CPU_SETSIZE 1024
+#define SYSCTL_CORE_COUNT "machdep.cpu.core_count"
+void vmess(char *fmt, ...);
+
+typedef struct cpu_set {
+ uint32_t count;
+} cpu_set_t;
+
+static inline void
+CPU_ZERO(cpu_set_t *cs) { cs->count = 0; }
+
+static inline void
+CPU_SET(int num, cpu_set_t *cs) { cs->count |= (1 << num); }
+
+static inline int
+CPU_ISSET(int num, cpu_set_t *cs) { return (cs->count & (1 << num)); }
+
+int sched_getaffinity(pid_t pid, size_t cpu_size, cpu_set_t *cpu_set)
+{
+ int32_t core_count = 0;
+ size_t len = sizeof(core_count);
+ int ret = sysctlbyname(SYSCTL_CORE_COUNT, &core_count, &len, 0, 0);
+ if (ret) {
+ printf("error while get core count %d\n", ret);
+ return -1;
+ }
+ cpu_set->count = 0;
+ for (int i = 0; i < core_count; i++) {
+ cpu_set->count |= (1 << i);
+ }
+
+ return 0;
+}
+#endif
+
+/* Borrowed from util-linux-2.13-pre7/schedutils/taskset.c */
+
+static char *cpuset_to_cstr(cpu_set_t *mask, char *str)
+{
+ char *ptr = str;
+ int i, j, entry_made = 0;
+ for (i = 0; i < CPU_SETSIZE; i++) {
+ if (CPU_ISSET(i, mask)) {
+ int run = 0;
+ entry_made = 1;
+ for (j = i + 1; j < CPU_SETSIZE; j++) {
+ if (CPU_ISSET(j, mask)) run++;
+ else break;
+ }
+ if (!run)
+ sprintf(ptr, "%d,", i);
+ else if (run == 1) {
+ sprintf(ptr, "%d,%d,", i, i + 1);
+ i++;
+ } else {
+ sprintf(ptr, "%d-%d,", i, i + run);
+ i += run;
+ }
+ while (*ptr != 0) ptr++;
+ }
+ }
+ ptr -= entry_made;
+ *ptr = 0;
+ return(str);
+}
+
+void threadAffinity(void)
+{
+ int thread;
+ cpu_set_t coremask;
+ char clbuf[7 * CPU_SETSIZE], hnbuf[64];
+ char prefix[200];
+
+ memset(clbuf, 0, sizeof(clbuf));
+ memset(hnbuf, 0, sizeof(hnbuf));
+ (void)gethostname(hnbuf, sizeof(hnbuf));
+
+ strcpy(prefix,"Hello world from");
+
+// #pragma omp parallel private(thread, coremask, clbuf)
+/* for use inside parallel region */
+ #pragma omp critical
+ {
+#ifdef __USE_GNU
+ thread = omp_get_thread_num();
+#else
+ thread = 1;
+#endif
+ (void)sched_getaffinity(0, sizeof(coremask), &coremask);
+ cpuset_to_cstr(&coremask, clbuf);
+ vmess("%s thread %d, on %s. (core affinity = %s)", prefix, thread, hnbuf, clbuf);
+
+ }
+ return;
+}
+
diff --git a/raytime3d/verbosepkg.c b/raytime3d/verbosepkg.c
new file mode 100644
index 0000000000000000000000000000000000000000..483e5f92bd5e1c1a495c66b7a63b9e8113943897
--- /dev/null
+++ b/raytime3d/verbosepkg.c
@@ -0,0 +1,77 @@
+#include <stdio.h>
+#include <stdarg.h>
+#include "par.h"
+#include <string.h>
+#ifdef _CRAYMPP
+#include <intrinsics.h>
+#endif
+
+/**
+* functions to print out verbose, error and warning messages to stderr.
+*
+* AUTHOR:
+* Jan Thorbecke (janth@xs4all.nl)
+* The Netherlands
+**/
+
+
+void verr(char *fmt, ...)
+{
+ va_list args;
+
+ if (EOF == fflush(stderr)) {
+ fprintf(stderr, "\nverr: fflush failed on stderr");
+ }
+ fprintf(stderr, " Error in %s: ", xargv[0]);
+#ifdef _CRAYMPP
+ fprintf(stderr, "PE %d: ", _my_pe());
+#elif defined(SGI)
+ fprintf(stderr, "PE %d: ", mp_my_threadnum());
+#endif
+ va_start(args,fmt);
+ vfprintf(stderr, fmt, args);
+ va_end(args);
+ fprintf(stderr, "\n");
+
+ exit(EXIT_FAILURE);
+}
+
+void vwarn(char *fmt, ...)
+{
+ va_list args;
+
+ if (EOF == fflush(stderr)) {
+ fprintf(stderr, "\nvwarn: fflush failed on stderr");
+ }
+ fprintf(stderr, " Warning in %s: ", xargv[0]);
+#ifdef _CRAYMPP
+ fprintf(stderr, "PE %d: ", _my_pe());
+#elif defined(SGI)
+ fprintf(stderr, "PE %d: ", mp_my_threadnum());
+#endif
+ va_start(args,fmt);
+ vfprintf(stderr, fmt, args);
+ va_end(args);
+ fprintf(stderr, "\n");
+ return;
+}
+
+void vmess(char *fmt, ...)
+{
+ va_list args;
+
+ if (EOF == fflush(stderr)) {
+ fprintf(stderr, "\nvmess: fflush failed on stderr");
+ }
+ fprintf(stderr, " %s: ", xargv[0]);
+#ifdef _CRAYMPP
+ fprintf(stderr, "PE %d: ", _my_pe());
+#elif defined(SGI)
+ fprintf(stderr, "PE %d: ", mp_my_threadnum());
+#endif
+ va_start(args,fmt);
+ vfprintf(stderr, fmt, args);
+ va_end(args);
+ fprintf(stderr, "\n");
+ return;
+}
diff --git a/raytime3d/vidale3d.c b/raytime3d/vidale3d.c
new file mode 100644
index 0000000000000000000000000000000000000000..ff8a74c1c4f75f4179ce168c514b6ee1949ab837
--- /dev/null
+++ b/raytime3d/vidale3d.c
@@ -0,0 +1,1444 @@
+#include<stdlib.h>
+#include<stdio.h>
+#include<math.h>
+#include<assert.h>
+#include<string.h>
+#include"par.h"
+
+#define SQR2 1.414213562
+#define SQR3 1.732050808
+#define SQR6 2.449489743
+#define t0(x,y,z) time0[nxy*(z) + nx*(y) + (x)]
+#define s0(x,y,z) slow0[nxy*(z) + nx*(y) + (x)]
+
+/* definitions from verbose.c */
+extern void verr(char *fmt, ...);
+extern void vwarn(char *fmt, ...);
+extern void vmess(char *fmt, ...);
+
+struct sorted
+ { float time; int i1, i2;};
+
+int compar(struct sorted *a,struct sorted *b);
+
+float fdhne(float t1,float t2,float t3,float t4,float t5,float ss0,float s1,float s2,float s3);
+float fdh3d(float t1,float t2,float t3,float t4,float t5,float t6,float t7,float ss0,float s1,float s2,float s3,float s4,float s5,float s6,float s7);
+float fdh2d(float t1,float t2,float t3,float ss0,float s1,float s2,float s3);
+float fdhnf(float t1,float t2,float t3,float t4,float t5,float ss0,float s1);
+
+void vidale3d(float *slow0, float *time0, int nz, int nx, int ny, float h, int xs, int ys, int zs, int NCUBE)
+{
+ int
+ srctype=1, /* if 1, source is a point;
+ 2, source is on the walls of the data volume;
+ 3, source on wall, time field known; */
+ srcwall, /* if 1, source on x=0 wall, if 2, on x=nx-1 wall
+ if 3, source on y=0 wall, if 4, on y=ny-1 wall
+ if 5, source on z=0 wall, if 6, on z=nz-1 wall */
+ iplus=1, /* rate of expansion of "cube" in the */
+ iminus=1, /* plus/minus x/y/z direction */
+ jplus=1,
+ jminus=1,
+ kplus=1,
+ kminus=1,
+ igrow, /* counter for "cube" growth */
+ X1, X2, lasti, index, ii, i, j, k, radius,
+ nxy, nyz, nxz, nxyz, nwall,
+ /* counters for the position of the sides of current cube */
+ x1, x2, y1, y2, z1, z2,
+ /* flags set to 1 until a side has been reached */
+ dx1=1, dx2=1, dy1=1, dy2=1, dz1=1, dz2=1, rad0=1,
+ maxrad, /* maximum radius to compute */
+ reverse=1, /* will automatically do up to this number of
+ reverse propagation steps to fix waves that travel
+ back into expanding cube */
+ headpref=6, /* if headpref starts > 0, will determine
+ model wall closest to source and will prefer to start
+ reverse calculations on opposite wall */
+ /* counters for detecting head waves on sides of current cube */
+ head,headw[7], verbose;
+ float
+ *wall,
+ guess, try,
+ /* maximum offset (real units) to compute */
+ maxoff = -1.,
+ /* used to detect head waves: if headwave operator decreases
+ the previously-computed traveltime by at least
+ headtest*<~time_across_cell> then the headwave counter is
+ triggered */
+ fhead,headtest=1.e-3;
+
+ /* ARRAY TO ORDER SIDE FOR SOLUTION IN THE RIGHT ORDER */
+ struct sorted *sort;
+
+ if (!getparint("verbose",&verbose)) verbose=0;
+ if(!getparfloat("maxoff",&maxoff)) maxoff = -1.;
+ if(!getparint("iminus",&iminus)) iminus=1;
+ if(!getparint("iplus",&iplus)) iplus=1;
+ if(!getparint("jminus",&jminus)) jminus=1;
+ if(!getparint("jplus",&jplus)) jplus=1;
+ if(!getparint("kminus",&kminus)) kminus=1;
+ if(!getparint("kplus",&kplus)) kplus=1;
+ if(!getparint("reverse",&reverse)) reverse=0;
+ if(!getparint("headpref",&headpref)) headpref=6;
+ if(!getparint("NCUBE",&NCUBE)) NCUBE=2;
+
+ /* SET MAXIMUM RADIUS TO COMPUTE */
+ if (maxoff > 0.) {
+ maxrad = maxoff/h + 1;
+ vwarn("WARNING: Computing only to max radius = %d",maxrad);
+ }
+ else maxrad = 99999999;
+
+ nxy = nx * ny;
+ nyz = ny * nz;
+ nxz = nx * nz;
+ nxyz = nx * ny * nz;
+
+ /* MAKE ARRAY SORT LARGE ENOUGH FOR ANY SIDE */
+ if(nx <= ny && nx <= nz) {
+ sort = (struct sorted *) malloc(sizeof(struct sorted)*ny*nz);
+ nwall = nyz;
+ }
+ else if(ny <= nx && ny <= nz) {
+ sort = (struct sorted *) malloc(sizeof(struct sorted)*nx*nz);
+ nwall = nxz;
+ }
+ else {
+ sort = (struct sorted *) malloc(sizeof(struct sorted)*nx*ny);
+ nwall = nxy;
+ }
+ wall = (float *) malloc(4*nwall);
+ if(sort == NULL || wall == NULL)
+ verr("error in allocation of arrays sort and wall");
+
+ if(!getparint("srctype",&srctype)) srctype=1;
+ if(srctype==1) {
+ /* SETS LOCATION OF THE SIDES OF THE CUBE */
+ radius = NCUBE;
+ if(xs > NCUBE) x1 = xs - (NCUBE + 1);
+ else{ x1 = -1; dx1 = 0;}
+ if(xs < nx-(NCUBE + 1)) x2 = xs + (NCUBE + 1);
+ else{ x2 = nx; dx2 = 0;}
+ if(ys > NCUBE) y1 = ys - (NCUBE + 1);
+ else{ y1 = -1; dy1 = 0;}
+ if(ys < ny-(NCUBE + 1)) y2 = ys + (NCUBE + 1);
+ else{ y2 = ny; dy2 = 0;}
+ if(zs > NCUBE) z1 = zs - (NCUBE + 1);
+ else{ z1 = -1; dz1 = 0;}
+ if(zs < nz-(NCUBE + 1)) z2 = zs + (NCUBE + 1);
+ else{ z2 = nz; dz2 = 0;}
+ }
+ else {
+ if (!getparint("srcwall",&srcwall)) verr("srcwall not given");
+ /* SET LOCATIONS OF SIDES OF THE CUBE SO THAT CUBE IS A FACE */
+ radius = 1;
+ if (srcwall == 1) x2=1;
+ else { x2=nx; dx2=0; }
+ if (srcwall == 2) x1=nx-2;
+ else { x1= -1; dx1=0; }
+ if (srcwall == 3) y2=1;
+ else { y2=ny; dy2=0; }
+ if (srcwall == 4) y1=ny-2;
+ else { y1= -1; dy1=0; }
+ if (srcwall == 5) z2=1;
+ else { z2=nz; dz2=0; }
+ if (srcwall == 6) z1=nz-2;
+ else { z1= -1; dz1=0; }
+ }
+
+
+ if (headpref>0) { /* HOLE - PREFERRED REVERSE DIRECTION */
+ head = nx*ny*nz;
+ if (nx>5 && x2<=head) {headpref=2; head=x2;}
+ if (nx>5 && (nx-1-x1)<=head) {headpref=1; head=nx-1-x1;}
+ if (ny>5 && y2<=head) {headpref=4; head=y2;}
+ if (ny>5 && (ny-1-y1)<=head) {headpref=3; head=ny-1-y1;}
+ if (nz>5 && z2<=head) {headpref=6; head=z2;}
+ if (nz>5 && (nz-1-z1)<=head) {headpref=5; head=nz-1-z1;}
+ }
+
+ /* BIGGER LOOP - HOLE - ALLOWS AUTOMATIC REVERSE PROPAGATION IF
+ HEAD WAVES ARE ENCOUNTERED ON FACES OF EXPANDING CUBE,
+ ALLOWING WAVES TO TRAVEL BACK INTO THE CUBE */
+
+ while ( reverse > -1 ) {
+
+ headw[1]=0; headw[2]=0; headw[3]=0; headw[4]=0;
+ headw[5]=0; headw[6]=0;
+
+ /* BIG LOOP */
+ while(rad0 && (dx1 || dx2 || dy1 || dy2 || dz1 || dz2)) {
+
+ /* CALCULATE ON PRIMARY (time0) GRID */
+
+ /* TOP SIDE */
+ for (igrow=1;igrow<=kminus;igrow++) {
+ if(dz1){
+ ii = 0;
+ for(j=y1+1; j<=y2-1; j++){
+ for(i=x1+1; i<=x2-1; i++){
+ sort[ii].time = t0(i,j,z1+1);
+ sort[ii].i1 = i;
+ sort[ii].i2 = j;
+ ii++;
+ }
+ }
+ qsort((char *)sort,ii,sizeof(struct sorted),compar);
+ for(i=0;i<ii;i++){
+ X1 = sort[i].i1;
+ X2 = sort[i].i2;
+ index = z1*nxy + X2*nx + X1;
+ lasti = (z1+1)*nxy + X2*nx + X1;
+ fhead = 0.;
+ guess = time0[index];
+ if(time0[index+1] < 1.e9 && time0[index+nx+1] < 1.e9
+ && time0[index+nx] < 1.e9 && X2<ny-1 && X1<nx-1 ) {
+ try = fdh3d( t0(X1,X2,z1+1),
+ t0(X1+1,X2,z1+1),t0(X1+1,X2+1,z1+1),t0(X1,X2+1,z1+1),
+ t0(X1+1,X2,z1 ),t0(X1+1,X2+1,z1 ),t0(X1,X2+1,z1 ),
+ s0(X1,X2,z1), s0(X1,X2,z1+1),
+ s0(X1+1,X2,z1+1),s0(X1+1,X2+1,z1+1),s0(X1,X2+1,z1+1),
+ s0(X1+1,X2,z1 ),s0(X1+1,X2+1,z1 ),s0(X1,X2+1,z1 ));
+ if (try<guess) guess = try;
+ }
+ if(time0[index-1] < 1.e9 && time0[index+nx-1] < 1.e9
+ && time0[index+nx] < 1.e9 && X2<ny-1 && X1>0 ) {
+ try = fdh3d( t0(X1,X2,z1+1),
+ t0(X1-1,X2,z1+1),t0(X1-1,X2+1,z1+1),t0(X1,X2+1,z1+1),
+ t0(X1-1,X2,z1 ),t0(X1-1,X2+1,z1 ),t0(X1,X2+1,z1 ),
+ s0(X1,X2,z1), s0(X1,X2,z1+1),
+ s0(X1-1,X2,z1+1),s0(X1-1,X2+1,z1+1),s0(X1,X2+1,z1+1),
+ s0(X1-1,X2,z1 ),s0(X1-1,X2+1,z1 ),s0(X1,X2+1,z1 ));
+ if (try<guess) guess = try;
+ }
+ if(time0[index+1] < 1.e9 && time0[index-nx+1] < 1.e9
+ && time0[index-nx] < 1.e9 && X2>0 && X1<nx-1 ) {
+ try = fdh3d( t0(X1,X2,z1+1),
+ t0(X1+1,X2,z1+1),t0(X1+1,X2-1,z1+1),t0(X1,X2-1,z1+1),
+ t0(X1+1,X2,z1 ),t0(X1+1,X2-1,z1 ),t0(X1,X2-1,z1 ),
+ s0(X1,X2,z1), s0(X1,X2,z1+1),
+ s0(X1+1,X2,z1+1),s0(X1+1,X2-1,z1+1),s0(X1,X2-1,z1+1),
+ s0(X1+1,X2,z1 ),s0(X1+1,X2-1,z1 ),s0(X1,X2-1,z1 ));
+ if (try<guess) guess = try;
+ }
+ if(time0[index-1] < 1.e9 && time0[index-nx-1] < 1.e9
+ && time0[index-nx] < 1.e9 && X2>0 && X1>0 ) {
+ try = fdh3d( t0(X1,X2,z1+1),
+ t0(X1-1,X2,z1+1),t0(X1-1,X2-1,z1+1),t0(X1,X2-1,z1+1),
+ t0(X1-1,X2,z1 ),t0(X1-1,X2-1,z1 ),t0(X1,X2-1,z1 ),
+ s0(X1,X2,z1), s0(X1,X2,z1+1),
+ s0(X1-1,X2,z1+1),s0(X1-1,X2-1,z1+1),s0(X1,X2-1,z1+1),
+ s0(X1-1,X2,z1 ),s0(X1-1,X2-1,z1 ),s0(X1,X2-1,z1 ));
+ if (try<guess) guess = try;
+ }
+ if(guess > 1.0e9){
+ if(time0[index+1] < 1.e9 && X1<nx-1 && X2>y1+1 && X2<y2-1 ) {
+ try = fdhne(t0(X1,X2,z1+1),t0(X1+1,X2,z1+1),t0(X1+1,X2,z1),
+ t0(X1+1,X2-1,z1+1),t0(X1+1,X2+1,z1+1),
+ s0(X1,X2,z1),
+ s0(X1,X2,z1+1),s0(X1+1,X2,z1+1),s0(X1+1,X2,z1) );
+ if (try<guess) guess = try;
+ }
+ if(time0[index-1] < 1.e9 && X1>0 && X2>y1+1 && X2<y2-1 ) {
+ try = fdhne(t0(X1,X2,z1+1),t0(X1-1,X2,z1+1),t0(X1-1,X2,z1),
+ t0(X1-1,X2-1,z1+1),t0(X1-1,X2+1,z1+1),
+ s0(X1,X2,z1),
+ s0(X1,X2,z1+1),s0(X1-1,X2,z1+1),s0(X1-1,X2,z1) );
+ if (try<guess) guess = try;
+ }
+ if(time0[index+nx] < 1.e9 && X2<ny-1 && X1>x1+1 && X1<x2-1 ) {
+ try = fdhne(t0(X1,X2,z1+1),t0(X1,X2+1,z1+1),t0(X1,X2+1,z1),
+ t0(X1-1,X2+1,z1+1),t0(X1+1,X2+1,z1+1),
+ s0(X1,X2,z1),
+ s0(X1,X2,z1+1),s0(X1,X2+1,z1+1),s0(X1,X2+1,z1) );
+ if (try<guess) guess = try;
+ }
+ if(time0[index-nx] < 1.e9 && X2>0 && X1>x1+1 && X1<x2-1 ) {
+ try = fdhne(t0(X1,X2,z1+1),t0(X1,X2-1,z1+1),t0(X1,X2-1,z1),
+ t0(X1-1,X2-1,z1+1),t0(X1+1,X2-1,z1+1),
+ s0(X1,X2,z1),
+ s0(X1,X2,z1+1),s0(X1,X2-1,z1+1),s0(X1,X2-1,z1) );
+ if (try<guess) guess = try;
+ }
+ }
+ if(time0[index+1] < 1.e9 && X1<nx-1 ) {
+ try = fdh2d(t0(X1,X2,z1+1),t0(X1+1,X2,z1+1),t0(X1+1,X2,z1),
+ s0(X1,X2,z1),
+ s0(X1,X2,z1+1),s0(X1+1,X2,z1+1),s0(X1+1,X2,z1) );
+ if (try<guess) guess = try;
+ }
+ if(time0[index-1] < 1.e9 && X1>0 ) {
+ try = fdh2d(t0(X1,X2,z1+1),t0(X1-1,X2,z1+1),t0(X1-1,X2,z1),
+ s0(X1,X2,z1),
+ s0(X1,X2,z1+1),s0(X1-1,X2,z1+1),s0(X1-1,X2,z1) );
+ if (try<guess) guess = try;
+ }
+ if(time0[index+nx] < 1.e9 && X2<ny-1 ) {
+ try = fdh2d(t0(X1,X2,z1+1),t0(X1,X2+1,z1+1),t0(X1,X2+1,z1),
+ s0(X1,X2,z1),
+ s0(X1,X2,z1+1),s0(X1,X2+1,z1+1),s0(X1,X2+1,z1) );
+ if (try<guess) guess = try;
+ }
+ if(time0[index-nx] < 1.e9 && X2>0 ) {
+ try = fdh2d(t0(X1,X2,z1+1),t0(X1,X2-1,z1+1),t0(X1,X2-1,z1),
+ s0(X1,X2,z1),
+ s0(X1,X2,z1+1),s0(X1,X2-1,z1+1),s0(X1,X2-1,z1) );
+ if (try<guess) guess = try;
+ }
+ if(time0[index+1] < 1.e9 && time0[index+nx+1] < 1.e9
+ && time0[index+nx] < 1.e9 && X2<ny-1 && X1<nx-1 ) {
+ try = fdh2d(t0(X1+1,X2,z1),t0(X1+1,X2+1,z1),t0(X1,X2+1,z1),
+ s0(X1,X2,z1),
+ s0(X1+1,X2,z1),s0(X1+1,X2+1,z1),s0(X1,X2+1,z1) );
+ if (try<guess) {fhead=(guess-try)/slow0[index]; guess=try;}
+ }
+ if(time0[index+1] < 1.e9 && time0[index-nx+1] < 1.e9
+ && time0[index-nx] < 1.e9 && X2>0 && X1<nx-1 ) {
+ try = fdh2d(t0(X1+1,X2,z1),t0(X1+1,X2-1,z1),t0(X1,X2-1,z1),
+ s0(X1,X2,z1),
+ s0(X1+1,X2,z1),s0(X1+1,X2-1,z1),s0(X1,X2-1,z1) );
+ if (try<guess) {fhead=(guess-try)/slow0[index]; guess=try;}
+ }
+ if(time0[index-1] < 1.e9 && time0[index+nx-1] < 1.e9
+ && time0[index+nx] < 1.e9 && X2<ny-1 && X1>0 ) {
+ try = fdh2d(t0(X1-1,X2,z1),t0(X1-1,X2+1,z1),t0(X1,X2+1,z1),
+ s0(X1,X2,z1),
+ s0(X1-1,X2,z1),s0(X1-1,X2+1,z1),s0(X1,X2+1,z1) );
+ if (try<guess) {fhead=(guess-try)/slow0[index]; guess=try;}
+ }
+ if(time0[index-1] < 1.e9 && time0[index-nx-1] < 1.e9
+ && time0[index-nx] < 1.e9 && X2>0 && X1>0 ) {
+ try = fdh2d(t0(X1-1,X2,z1),t0(X1-1,X2-1,z1),t0(X1,X2-1,z1),
+ s0(X1,X2,z1),
+ s0(X1-1,X2,z1),s0(X1-1,X2-1,z1),s0(X1,X2-1,z1) );
+ if (try<guess) {fhead=(guess-try)/slow0[index]; guess=try;}
+ }
+ if(guess > 1.0e9){
+ if ( X1>x1+1 && X1<x2-1 && X2>y1+1 && X2<y2-1 ) {
+ try = fdhnf(t0(X1,X2,z1+1),
+ t0(X1+1,X2,z1+1),t0(X1,X2+1,z1+1),
+ t0(X1-1,X2,z1+1),t0(X1,X2-1,z1+1),
+ s0(X1,X2,z1),
+ s0(X1,X2,z1+1) );
+ if (try<guess) guess = try;
+ }
+ }
+ try = t0(X1,X2,z1+1) + .5*(s0(X1,X2,z1)+s0(X1,X2,z1+1));
+ if (try<guess) guess = try;
+ if ( time0[index+1]<1.e9 && X1<nx-1 ) {
+ try = t0(X1+1,X2,z1) + .5*(s0(X1,X2,z1)+s0(X1+1,X2,z1));
+ if (try<guess) {fhead=(guess-try)/slow0[index]; guess=try;}
+ }
+ if ( time0[index-1]<1.e9 && X1>0 ) {
+ try = t0(X1-1,X2,z1) + .5*(s0(X1,X2,z1)+s0(X1-1,X2,z1));
+ if (try<guess) {fhead=(guess-try)/slow0[index]; guess=try;}
+ }
+ if ( time0[index+nx]<1.e9 && X2<ny-1 ) {
+ try = t0(X1,X2+1,z1) + .5*(s0(X1,X2,z1)+s0(X1,X2+1,z1));
+ if (try<guess) {fhead=(guess-try)/slow0[index]; guess=try;}
+ }
+ if ( time0[index-nx]<1.e9 && X2>0 ) {
+ try = t0(X1,X2-1,z1) + .5*(s0(X1,X2,z1)+s0(X1,X2-1,z1));
+ if (try<guess) {fhead=(guess-try)/slow0[index]; guess=try;}
+ }
+ if (guess<time0[index]) {
+ time0[index] = guess;
+ if (fhead>headtest) headw[5]++;
+ }
+ }
+ if(z1 == 0) dz1 = 0;
+ z1--;
+ }
+ }
+ /* BOTTOM SIDE */
+ for (igrow=1;igrow<=kplus;igrow++) {
+ if(dz2){
+ ii = 0;
+ for(j=y1+1; j<=y2-1; j++){
+ for(i=x1+1; i<=x2-1; i++){
+ sort[ii].time = t0(i,j,z2-1);
+ sort[ii].i1 = i;
+ sort[ii].i2 = j;
+ ii++;
+ }
+ }
+ qsort((char *)sort,ii,sizeof(struct sorted),compar);
+ for(i=0;i<ii;i++){
+ X1 = sort[i].i1;
+ X2 = sort[i].i2;
+ index = z2*nxy + X2*nx + X1;
+ lasti = (z2-1)*nxy + X2*nx + X1;
+ fhead = 0.;
+ guess = time0[index];
+ if(time0[index+1] < 1.e9 && time0[index+nx+1] < 1.e9
+ && time0[index+nx] < 1.e9 && X2<ny-1 && X1<nx-1 ) {
+ try = fdh3d( t0(X1,X2,z2-1),
+ t0(X1+1,X2,z2-1),t0(X1+1,X2+1,z2-1),t0(X1,X2+1,z2-1),
+ t0(X1+1,X2,z2 ),t0(X1+1,X2+1,z2 ),t0(X1,X2+1,z2 ),
+ s0(X1,X2,z2), s0(X1,X2,z2-1),
+ s0(X1+1,X2,z2-1),s0(X1+1,X2+1,z2-1),s0(X1,X2+1,z2-1),
+ s0(X1+1,X2,z2 ),s0(X1+1,X2+1,z2 ),s0(X1,X2+1,z2 ));
+ if (try<guess) guess = try;
+ }
+ if(time0[index-1] < 1.e9 && time0[index+nx-1] < 1.e9
+ && time0[index+nx] < 1.e9 && X2<ny-1 && X1>0 ) {
+ try = fdh3d( t0(X1,X2,z2-1),
+ t0(X1-1,X2,z2-1),t0(X1-1,X2+1,z2-1),t0(X1,X2+1,z2-1),
+ t0(X1-1,X2,z2 ),t0(X1-1,X2+1,z2 ),t0(X1,X2+1,z2 ),
+ s0(X1,X2,z2), s0(X1,X2,z2-1),
+ s0(X1-1,X2,z2-1),s0(X1-1,X2+1,z2-1),s0(X1,X2+1,z2-1),
+ s0(X1-1,X2,z2 ),s0(X1-1,X2+1,z2 ),s0(X1,X2+1,z2 ));
+ if (try<guess) guess = try;
+ }
+ if(time0[index+1] < 1.e9 && time0[index-nx+1] < 1.e9
+ && time0[index-nx] < 1.e9 && X2>0 && X1<nx-1 ) {
+ try = fdh3d( t0(X1,X2,z2-1),
+ t0(X1+1,X2,z2-1),t0(X1+1,X2-1,z2-1),t0(X1,X2-1,z2-1),
+ t0(X1+1,X2,z2 ),t0(X1+1,X2-1,z2 ),t0(X1,X2-1,z2 ),
+ s0(X1,X2,z2), s0(X1,X2,z2-1),
+ s0(X1+1,X2,z2-1),s0(X1+1,X2-1,z2-1),s0(X1,X2-1,z2-1),
+ s0(X1+1,X2,z2 ),s0(X1+1,X2-1,z2 ),s0(X1,X2-1,z2 ));
+ if (try<guess) guess = try;
+ }
+ if(time0[index-1] < 1.e9 && time0[index-nx-1] < 1.e9
+ && time0[index-nx] < 1.e9 && X2>0 && X1>0 ) {
+ try = fdh3d( t0(X1,X2,z2-1),
+ t0(X1-1,X2,z2-1),t0(X1-1,X2-1,z2-1),t0(X1,X2-1,z2-1),
+ t0(X1-1,X2,z2 ),t0(X1-1,X2-1,z2 ),t0(X1,X2-1,z2 ),
+ s0(X1,X2,z2), s0(X1,X2,z2-1),
+ s0(X1-1,X2,z2-1),s0(X1-1,X2-1,z2-1),s0(X1,X2-1,z2-1),
+ s0(X1-1,X2,z2 ),s0(X1-1,X2-1,z2 ),s0(X1,X2-1,z2 ));
+ if (try<guess) guess = try;
+ }
+ if(guess > 1.0e9){
+ if(time0[index+1] < 1.e9 && X1<nx-1 && X2>y1+1 && X2<y2-1 ) {
+ try = fdhne(t0(X1,X2,z2-1),t0(X1+1,X2,z2-1),t0(X1+1,X2,z2),
+ t0(X1+1,X2-1,z2-1),t0(X1+1,X2+1,z2-1),
+ s0(X1,X2,z2),
+ s0(X1,X2,z2-1),s0(X1+1,X2,z2-1),s0(X1+1,X2,z2) );
+ if (try<guess) guess = try;
+ }
+ if(time0[index-1] < 1.e9 && X1>0 && X2>y1+1 && X2<y2-1 ) {
+ try = fdhne(t0(X1,X2,z2-1),t0(X1-1,X2,z2-1),t0(X1-1,X2,z2),
+ t0(X1-1,X2-1,z2-1),t0(X1-1,X2+1,z2-1),
+ s0(X1,X2,z2),
+ s0(X1,X2,z2-1),s0(X1-1,X2,z2-1),s0(X1-1,X2,z2) );
+ if (try<guess) guess = try;
+ }
+ if(time0[index+nx] < 1.e9 && X2<ny-1 && X1>x1+1 && X1<x2-1 ) {
+ try = fdhne(t0(X1,X2,z2-1),t0(X1,X2+1,z2-1),t0(X1,X2+1,z2),
+ t0(X1-1,X2+1,z2-1),t0(X1+1,X2+1,z2-1),
+ s0(X1,X2,z2),
+ s0(X1,X2,z2-1),s0(X1,X2+1,z2-1),s0(X1,X2+1,z2) );
+ if (try<guess) guess = try;
+ }
+ if(time0[index-nx] < 1.e9 && X2>0 && X1>x1+1 && X1<x2-1 ) {
+ try = fdhne(t0(X1,X2,z2-1),t0(X1,X2-1,z2-1),t0(X1,X2-1,z2),
+ t0(X1-1,X2-1,z2-1),t0(X1+1,X2-1,z2-1),
+ s0(X1,X2,z2),
+ s0(X1,X2,z2-1),s0(X1,X2-1,z2-1),s0(X1,X2-1,z2) );
+ if (try<guess) guess = try;
+ }
+ }
+ if(time0[index+1] < 1.e9 && X1<nx-1 ) {
+ try = fdh2d(t0(X1,X2,z2-1),t0(X1+1,X2,z2-1),t0(X1+1,X2,z2),
+ s0(X1,X2,z2),
+ s0(X1,X2,z2-1),s0(X1+1,X2,z2-1),s0(X1+1,X2,z2) );
+ if (try<guess) guess = try;
+ }
+ if(time0[index-1] < 1.e9 && X1>0 ) {
+ try = fdh2d(t0(X1,X2,z2-1),t0(X1-1,X2,z2-1),t0(X1-1,X2,z2),
+ s0(X1,X2,z2),
+ s0(X1,X2,z2-1),s0(X1-1,X2,z2-1),s0(X1-1,X2,z2) );
+ if (try<guess) guess = try;
+ }
+ if(time0[index+nx] < 1.e9 && X2<ny-1 ) {
+ try = fdh2d(t0(X1,X2,z2-1),t0(X1,X2+1,z2-1),t0(X1,X2+1,z2),
+ s0(X1,X2,z2),
+ s0(X1,X2,z2-1),s0(X1,X2+1,z2-1),s0(X1,X2+1,z2) );
+ if (try<guess) guess = try;
+ }
+ if(time0[index-nx] < 1.e9 && X2>0 ) {
+ try = fdh2d(t0(X1,X2,z2-1),t0(X1,X2-1,z2-1),t0(X1,X2-1,z2),
+ s0(X1,X2,z2),
+ s0(X1,X2,z2-1),s0(X1,X2-1,z2-1),s0(X1,X2-1,z2) );
+ if (try<guess) guess = try;
+ }
+ if(time0[index+1] < 1.e9 && time0[index+nx+1] < 1.e9
+ && time0[index+nx] < 1.e9 && X2<ny-1 && X1<nx-1 ) {
+ try = fdh2d(t0(X1+1,X2,z2),t0(X1+1,X2+1,z2),t0(X1,X2+1,z2),
+ s0(X1,X2,z2),
+ s0(X1+1,X2,z2),s0(X1+1,X2+1,z2),s0(X1,X2+1,z2) );
+ if (try<guess) {fhead=(guess-try)/slow0[index]; guess=try;}
+ }
+ if(time0[index+1] < 1.e9 && time0[index-nx+1] < 1.e9
+ && time0[index-nx] < 1.e9 && X2>0 && X1<nx-1 ) {
+ try = fdh2d(t0(X1+1,X2,z2),t0(X1+1,X2-1,z2),t0(X1,X2-1,z2),
+ s0(X1,X2,z2),
+ s0(X1+1,X2,z2),s0(X1+1,X2-1,z2),s0(X1,X2-1,z2) );
+ if (try<guess) {fhead=(guess-try)/slow0[index]; guess=try;}
+ }
+ if(time0[index-1] < 1.e9 && time0[index+nx-1] < 1.e9
+ && time0[index+nx] < 1.e9 && X2<ny-1 && X1>0 ) {
+ try = fdh2d(t0(X1-1,X2,z2),t0(X1-1,X2+1,z2),t0(X1,X2+1,z2),
+ s0(X1,X2,z2),
+ s0(X1-1,X2,z2),s0(X1-1,X2+1,z2),s0(X1,X2+1,z2) );
+ if (try<guess) {fhead=(guess-try)/slow0[index]; guess=try;}
+ }
+ if(time0[index-1] < 1.e9 && time0[index-nx-1] < 1.e9
+ && time0[index-nx] < 1.e9 && X2>0 && X1>0 ) {
+ try = fdh2d(t0(X1-1,X2,z2),t0(X1-1,X2-1,z2),t0(X1,X2-1,z2),
+ s0(X1,X2,z2),
+ s0(X1-1,X2,z2),s0(X1-1,X2-1,z2),s0(X1,X2-1,z2) );
+ if (try<guess) {fhead=(guess-try)/slow0[index]; guess=try;}
+ }
+ if(guess > 1.0e9){
+ if ( X1>x1+1 && X1<x2-1 && X2>y1+1 && X2<y2-1 ) {
+ try = fdhnf(t0(X1,X2,z2-1),
+ t0(X1+1,X2,z2-1),t0(X1,X2+1,z2-1),
+ t0(X1-1,X2,z2-1),t0(X1,X2-1,z2-1),
+ s0(X1,X2,z2),
+ s0(X1,X2,z2-1) );
+ if (try<guess) guess = try;
+ }
+ }
+ try = t0(X1,X2,z2-1) + .5*(s0(X1,X2,z2)+s0(X1,X2,z2-1));
+ if (try<guess) guess = try;
+ if ( time0[index+1]<1.e9 && X1<nx-1 ) {
+ try = t0(X1+1,X2,z2) + .5*(s0(X1,X2,z2)+s0(X1+1,X2,z2));
+ if (try<guess) {fhead=(guess-try)/slow0[index]; guess=try;}
+ }
+ if ( time0[index-1]<1.e9 && X1>0 ) {
+ try = t0(X1-1,X2,z2) + .5*(s0(X1,X2,z2)+s0(X1-1,X2,z2));
+ if (try<guess) {fhead=(guess-try)/slow0[index]; guess=try;}
+ }
+ if ( time0[index+nx]<1.e9 && X2<ny-1 ) {
+ try = t0(X1,X2+1,z2) + .5*(s0(X1,X2,z2)+s0(X1,X2+1,z2));
+ if (try<guess) {fhead=(guess-try)/slow0[index]; guess=try;}
+ }
+ if ( time0[index-nx]<1.e9 && X2>0 ) {
+ try = t0(X1,X2-1,z2) + .5*(s0(X1,X2,z2)+s0(X1,X2-1,z2));
+ if (try<guess) {fhead=(guess-try)/slow0[index]; guess=try;}
+ }
+ if (guess<time0[index]) {
+ time0[index] = guess;
+ if (fhead>headtest) headw[6]++;
+ }
+ }
+ if(z2 == nz-1) dz2 = 0;
+ z2++;
+ }
+ }
+ /* FRONT SIDE */
+ for (igrow=1;igrow<=jminus;igrow++) {
+ if(dy1){
+ ii = 0;
+ for(k=z1+1; k<=z2-1; k++){
+ for(i=x1+1; i<=x2-1; i++){
+ sort[ii].time = t0(i,y1+1,k);
+ sort[ii].i1 = i;
+ sort[ii].i2 = k;
+ ii++;
+ }
+ }
+ qsort((char *)sort,ii,sizeof(struct sorted),compar);
+ for(i=0;i<ii;i++){
+ X1 = sort[i].i1;
+ X2 = sort[i].i2;
+ index = X2*nxy + y1*nx + X1;
+ lasti = X2*nxy + (y1+1)*nx + X1;
+ fhead = 0.;
+ guess = time0[index];
+ if(time0[index+1] < 1.e9 && time0[index+nxy+1] < 1.e9
+ && time0[index+nxy] < 1.e9 && X2<nz-1 && X1<nx-1 ) {
+ try = fdh3d( t0(X1,y1+1,X2),
+ t0(X1+1,y1+1,X2),t0(X1+1,y1+1,X2+1),t0(X1,y1+1,X2+1),
+ t0(X1+1,y1 ,X2),t0(X1+1,y1 ,X2+1),t0(X1,y1 ,X2+1),
+ s0(X1,y1,X2), s0(X1,y1+1,X2),
+ s0(X1+1,y1+1,X2),s0(X1+1,y1+1,X2+1),s0(X1,y1+1,X2+1),
+ s0(X1+1,y1 ,X2),s0(X1+1,y1 ,X2+1),s0(X1,y1 ,X2+1));
+ if (try<guess) guess = try;
+ }
+ if(time0[index-1] < 1.e9 && time0[index+nxy-1] < 1.e9
+ && time0[index+nxy] < 1.e9 && X2<nz-1 && X1>0 ) {
+ try = fdh3d( t0(X1,y1+1,X2),
+ t0(X1-1,y1+1,X2),t0(X1-1,y1+1,X2+1),t0(X1,y1+1,X2+1),
+ t0(X1-1,y1 ,X2),t0(X1-1,y1 ,X2+1),t0(X1,y1 ,X2+1),
+ s0(X1,y1,X2), s0(X1,y1+1,X2),
+ s0(X1-1,y1+1,X2),s0(X1-1,y1+1,X2+1),s0(X1,y1+1,X2+1),
+ s0(X1-1,y1 ,X2),s0(X1-1,y1 ,X2+1),s0(X1,y1 ,X2+1));
+ if (try<guess) guess = try;
+ }
+ if(time0[index+1] < 1.e9 && time0[index-nxy+1] < 1.e9
+ && time0[index-nxy] < 1.e9 && X2>0 && X1<nx-1 ) {
+ try = fdh3d( t0(X1,y1+1,X2),
+ t0(X1+1,y1+1,X2),t0(X1+1,y1+1,X2-1),t0(X1,y1+1,X2-1),
+ t0(X1+1,y1 ,X2),t0(X1+1,y1 ,X2-1),t0(X1,y1 ,X2-1),
+ s0(X1,y1,X2), s0(X1,y1+1,X2),
+ s0(X1+1,y1+1,X2),s0(X1+1,y1+1,X2-1),s0(X1,y1+1,X2-1),
+ s0(X1+1,y1 ,X2),s0(X1+1,y1 ,X2-1),s0(X1,y1 ,X2-1));
+ if (try<guess) guess = try;
+ }
+ if(time0[index-1] < 1.e9 && time0[index-nxy-1] < 1.e9
+ && time0[index-nxy] < 1.e9 && X2>0 && X1>0 ) {
+ try = fdh3d( t0(X1,y1+1,X2),
+ t0(X1-1,y1+1,X2),t0(X1-1,y1+1,X2-1),t0(X1,y1+1,X2-1),
+ t0(X1-1,y1 ,X2),t0(X1-1,y1 ,X2-1),t0(X1,y1 ,X2-1),
+ s0(X1,y1,X2), s0(X1,y1+1,X2),
+ s0(X1-1,y1+1,X2),s0(X1-1,y1+1,X2-1),s0(X1,y1+1,X2-1),
+ s0(X1-1,y1 ,X2),s0(X1-1,y1 ,X2-1),s0(X1,y1 ,X2-1));
+ if (try<guess) guess = try;
+ }
+ if(guess > 1.0e9){
+ if(time0[index+1] < 1.e9 && X1<nx-1 && X2>z1+1 && X2<z2-1 ) {
+ try = fdhne(t0(X1,y1+1,X2),t0(X1+1,y1+1,X2),t0(X1+1,y1,X2),
+ t0(X1+1,y1+1,X2-1),t0(X1+1,y1+1,X2+1),
+ s0(X1,y1,X2),
+ s0(X1,y1+1,X2),s0(X1+1,y1+1,X2),s0(X1+1,y1,X2) );
+ if (try<guess) guess = try;
+ }
+ if(time0[index-1] < 1.e9 && X1>0 && X2>z1+1 && X2<z2-1 ) {
+ try = fdhne(t0(X1,y1+1,X2),t0(X1-1,y1+1,X2),t0(X1-1,y1,X2),
+ t0(X1-1,y1+1,X2-1),t0(X1-1,y1+1,X2+1),
+ s0(X1,y1,X2),
+ s0(X1,y1+1,X2),s0(X1-1,y1+1,X2),s0(X1-1,y1,X2) );
+ if (try<guess) guess = try;
+ }
+ if(time0[index+nxy] < 1.e9 && X2<nz-1 && X1>x1+1 && X1<x2-1 ) {
+ try = fdhne(t0(X1,y1+1,X2),t0(X1,y1+1,X2+1),t0(X1,y1,X2+1),
+ t0(X1-1,y1+1,X2+1),t0(X1+1,y1+1,X2+1),
+ s0(X1,y1,X2),
+ s0(X1,y1+1,X2),s0(X1,y1+1,X2+1),s0(X1,y1,X2+1) );
+ if (try<guess) guess = try;
+ }
+ if(time0[index-nxy] < 1.e9 && X2>0 && X1>x1+1 && X1<x2-1 ) {
+ try = fdhne(t0(X1,y1+1,X2),t0(X1,y1+1,X2-1),t0(X1,y1,X2-1),
+ t0(X1-1,y1+1,X2-1),t0(X1+1,y1+1,X2-1),
+ s0(X1,y1,X2),
+ s0(X1,y1+1,X2),s0(X1,y1+1,X2-1),s0(X1,y1,X2-1) );
+ if (try<guess) guess = try;
+ }
+ }
+ if(time0[index+1] < 1.e9 && X1<nx-1 ) {
+ try = fdh2d(t0(X1,y1+1,X2),t0(X1+1,y1+1,X2),t0(X1+1,y1,X2),
+ s0(X1,y1,X2),
+ s0(X1,y1+1,X2),s0(X1+1,y1+1,X2),s0(X1+1,y1,X2) );
+ if (try<guess) guess = try;
+ }
+ if(time0[index-1] < 1.e9 && X1>0 ) {
+ try = fdh2d(t0(X1,y1+1,X2),t0(X1-1,y1+1,X2),t0(X1-1,y1,X2),
+ s0(X1,y1,X2),
+ s0(X1,y1+1,X2),s0(X1-1,y1+1,X2),s0(X1-1,y1,X2) );
+ if (try<guess) guess = try;
+ }
+ if(time0[index+nxy] < 1.e9 && X2<nz-1 ) {
+ try = fdh2d(t0(X1,y1+1,X2),t0(X1,y1+1,X2+1),t0(X1,y1,X2+1),
+ s0(X1,y1,X2),
+ s0(X1,y1+1,X2),s0(X1,y1+1,X2+1),s0(X1,y1,X2+1) );
+ if (try<guess) guess = try;
+ }
+ if(time0[index-nxy] < 1.e9 && X2>0 ) {
+ try = fdh2d(t0(X1,y1+1,X2),t0(X1,y1+1,X2-1),t0(X1,y1,X2-1),
+ s0(X1,y1,X2),
+ s0(X1,y1+1,X2),s0(X1,y1+1,X2-1),s0(X1,y1,X2-1) );
+ if (try<guess) guess = try;
+ }
+ if(time0[index+1] < 1.e9 && time0[index+nxy+1] < 1.e9
+ && time0[index+nxy] < 1.e9 && X2<nz-1 && X1<nx-1 ) {
+ try = fdh2d(t0(X1+1,y1,X2),t0(X1+1,y1,X2+1),t0(X1,y1,X2+1),
+ s0(X1,y1,X2),
+ s0(X1+1,y1,X2),s0(X1+1,y1,X2+1),s0(X1,y1,X2+1) );
+ if (try<guess) {fhead=(guess-try)/slow0[index]; guess=try;}
+ }
+ if(time0[index+1] < 1.e9 && time0[index-nxy+1] < 1.e9
+ && time0[index-nxy] < 1.e9 && X2>0 && X1<nx-1 ) {
+ try = fdh2d(t0(X1+1,y1,X2),t0(X1+1,y1,X2-1),t0(X1,y1,X2-1),
+ s0(X1,y1,X2),
+ s0(X1+1,y1,X2),s0(X1+1,y1,X2-1),s0(X1,y1,X2-1) );
+ if (try<guess) {fhead=(guess-try)/slow0[index]; guess=try;}
+ }
+ if(time0[index-1] < 1.e9 && time0[index+nxy-1] < 1.e9
+ && time0[index+nxy] < 1.e9 && X2<nz-1 && X1>0 ) {
+ try = fdh2d(t0(X1-1,y1,X2),t0(X1-1,y1,X2+1),t0(X1,y1,X2+1),
+ s0(X1,y1,X2),
+ s0(X1-1,y1,X2),s0(X1-1,y1,X2+1),s0(X1,y1,X2+1) );
+ if (try<guess) {fhead=(guess-try)/slow0[index]; guess=try;}
+ }
+ if(time0[index-1] < 1.e9 && time0[index-nxy-1] < 1.e9
+ && time0[index-nxy] < 1.e9 && X2>0 && X1>0 ) {
+ try = fdh2d(t0(X1-1,y1,X2),t0(X1-1,y1,X2-1),t0(X1,y1,X2-1),
+ s0(X1,y1,X2),
+ s0(X1-1,y1,X2),s0(X1-1,y1,X2-1),s0(X1,y1,X2-1) );
+ if (try<guess) {fhead=(guess-try)/slow0[index]; guess=try;}
+ }
+ if(guess > 1.0e9){
+ if ( X1>x1+1 && X1<x2-1 && X2>z1+1 && X2<z2-1 ) {
+ try = fdhnf(t0(X1,y1+1,X2),
+ t0(X1+1,y1+1,X2),t0(X1,y1+1,X2+1),
+ t0(X1-1,y1+1,X2),t0(X1,y1+1,X2-1),
+ s0(X1,y1,X2),
+ s0(X1,y1+1,X2) );
+ if (try<guess) guess = try;
+ }
+ }
+ try = t0(X1,y1+1,X2) + .5*(s0(X1,y1,X2)+s0(X1,y1+1,X2));
+ if (try<guess) guess = try;
+ if ( time0[index+1]<1.e9 && X1<nx-1 ) {
+ try = t0(X1+1,y1,X2) + .5*(s0(X1,y1,X2)+s0(X1+1,y1,X2));
+ if (try<guess) {fhead=(guess-try)/slow0[index]; guess=try;}
+ }
+ if ( time0[index-1]<1.e9 && X1>0 ) {
+ try = t0(X1-1,y1,X2) + .5*(s0(X1,y1,X2)+s0(X1-1,y1,X2));
+ if (try<guess) {fhead=(guess-try)/slow0[index]; guess=try;}
+ }
+ if ( time0[index+nxy]<1.e9 && X2<nz-1 ) {
+ try = t0(X1,y1,X2+1) + .5*(s0(X1,y1,X2)+s0(X1,y1,X2+1));
+ if (try<guess) {fhead=(guess-try)/slow0[index]; guess=try;}
+ }
+ if ( time0[index-nxy]<1.e9 && X2>0 ) {
+ try = t0(X1,y1,X2-1) + .5*(s0(X1,y1,X2)+s0(X1,y1,X2-1));
+ if (try<guess) {fhead=(guess-try)/slow0[index]; guess=try;}
+ }
+ if (guess<time0[index]) {
+ time0[index] = guess;
+ if (fhead>headtest) headw[3]++;
+ }
+ }
+ if(y1 == 0) dy1 = 0;
+ y1--;
+ }
+ }
+ /* BACK SIDE */
+ for (igrow=1;igrow<=jplus;igrow++) {
+ if(dy2){
+ ii = 0;
+ for(k=z1+1; k<=z2-1; k++){
+ for(i=x1+1; i<=x2-1; i++){
+ sort[ii].time = t0(i,y2-1,k);
+ sort[ii].i1 = i;
+ sort[ii].i2 = k;
+ ii++;
+ }
+ }
+ qsort((char *)sort,ii,sizeof(struct sorted),compar);
+ for(i=0;i<ii;i++){
+ X1 = sort[i].i1;
+ X2 = sort[i].i2;
+ index = X2*nxy + y2*nx + X1;
+ lasti = X2*nxy + (y2-1)*nx + X1;
+ fhead = 0.;
+ guess = time0[index];
+ if(time0[index+1] < 1.e9 && time0[index+nxy+1] < 1.e9
+ && time0[index+nxy] < 1.e9 && X2<nz-1 && X1<nx-1 ) {
+ try = fdh3d( t0(X1,y2-1,X2),
+ t0(X1+1,y2-1,X2),t0(X1+1,y2-1,X2+1),t0(X1,y2-1,X2+1),
+ t0(X1+1,y2 ,X2),t0(X1+1,y2 ,X2+1),t0(X1,y2 ,X2+1),
+ s0(X1,y2,X2), s0(X1,y2-1,X2),
+ s0(X1+1,y2-1,X2),s0(X1+1,y2-1,X2+1),s0(X1,y2-1,X2+1),
+ s0(X1+1,y2 ,X2),s0(X1+1,y2 ,X2+1),s0(X1,y2 ,X2+1));
+ if (try<guess) guess = try;
+ }
+ if(time0[index-1] < 1.e9 && time0[index+nxy-1] < 1.e9
+ && time0[index+nxy] < 1.e9 && X2<nz-1 && X1>0 ) {
+ try = fdh3d( t0(X1,y2-1,X2),
+ t0(X1-1,y2-1,X2),t0(X1-1,y2-1,X2+1),t0(X1,y2-1,X2+1),
+ t0(X1-1,y2 ,X2),t0(X1-1,y2 ,X2+1),t0(X1,y2 ,X2+1),
+ s0(X1,y2,X2), s0(X1,y2-1,X2),
+ s0(X1-1,y2-1,X2),s0(X1-1,y2-1,X2+1),s0(X1,y2-1,X2+1),
+ s0(X1-1,y2 ,X2),s0(X1-1,y2 ,X2+1),s0(X1,y2 ,X2+1));
+ if (try<guess) guess = try;
+ }
+ if(time0[index+1] < 1.e9 && time0[index-nxy+1] < 1.e9
+ && time0[index-nxy] < 1.e9 && X2>0 && X1<nx-1 ) {
+ try = fdh3d( t0(X1,y2-1,X2),
+ t0(X1+1,y2-1,X2),t0(X1+1,y2-1,X2-1),t0(X1,y2-1,X2-1),
+ t0(X1+1,y2 ,X2),t0(X1+1,y2 ,X2-1),t0(X1,y2 ,X2-1),
+ s0(X1,y2,X2), s0(X1,y2-1,X2),
+ s0(X1+1,y2-1,X2),s0(X1+1,y2-1,X2-1),s0(X1,y2-1,X2-1),
+ s0(X1+1,y2 ,X2),s0(X1+1,y2 ,X2-1),s0(X1,y2 ,X2-1));
+ if (try<guess) guess = try;
+ }
+ if(time0[index-1] < 1.e9 && time0[index-nxy-1] < 1.e9
+ && time0[index-nxy] < 1.e9 && X2>0 && X1>0 ) {
+ try = fdh3d( t0(X1,y2-1,X2),
+ t0(X1-1,y2-1,X2),t0(X1-1,y2-1,X2-1),t0(X1,y2-1,X2-1),
+ t0(X1-1,y2 ,X2),t0(X1-1,y2 ,X2-1),t0(X1,y2 ,X2-1),
+ s0(X1,y2,X2), s0(X1,y2-1,X2),
+ s0(X1-1,y2-1,X2),s0(X1-1,y2-1,X2-1),s0(X1,y2-1,X2-1),
+ s0(X1-1,y2 ,X2),s0(X1-1,y2 ,X2-1),s0(X1,y2 ,X2-1));
+ if (try<guess) guess = try;
+ }
+ if(guess > 1.0e9){
+ if(time0[index+1] < 1.e9 && X1<nx-1 && X2>z1+1 && X2<z2-1 ) {
+ try = fdhne(t0(X1,y2-1,X2),t0(X1+1,y2-1,X2),t0(X1+1,y2,X2),
+ t0(X1+1,y2-1,X2-1),t0(X1+1,y2-1,X2+1),
+ s0(X1,y2,X2),
+ s0(X1,y2-1,X2),s0(X1+1,y2-1,X2),s0(X1+1,y2,X2) );
+ if (try<guess) guess = try;
+ }
+ if(time0[index-1] < 1.e9 && X1>0 && X2>z1+1 && X2<z2-1 ) {
+ try = fdhne(t0(X1,y2-1,X2),t0(X1-1,y2-1,X2),t0(X1-1,y2,X2),
+ t0(X1-1,y2-1,X2-1),t0(X1-1,y2-1,X2+1),
+ s0(X1,y2,X2),
+ s0(X1,y2-1,X2),s0(X1-1,y2-1,X2),s0(X1-1,y2,X2) );
+ if (try<guess) guess = try;
+ }
+ if(time0[index+nxy] < 1.e9 && X2<nz-1 && X1>x1+1 && X1<x2-1 ) {
+ try = fdhne(t0(X1,y2-1,X2),t0(X1,y2-1,X2+1),t0(X1,y2,X2+1),
+ t0(X1-1,y2-1,X2+1),t0(X1+1,y2-1,X2+1),
+ s0(X1,y2,X2),
+ s0(X1,y2-1,X2),s0(X1,y2-1,X2+1),s0(X1,y2,X2+1) );
+ if (try<guess) guess = try;
+ }
+ if(time0[index-nxy] < 1.e9 && X2>0 && X1>x1+1 && X1<x2-1 ) {
+ try = fdhne(t0(X1,y2-1,X2),t0(X1,y2-1,X2-1),t0(X1,y2,X2-1),
+ t0(X1-1,y2-1,X2-1),t0(X1+1,y2-1,X2-1),
+ s0(X1,y2,X2),
+ s0(X1,y2-1,X2),s0(X1,y2-1,X2-1),s0(X1,y2,X2-1) );
+ if (try<guess) guess = try;
+ }
+ }
+ if(time0[index+1] < 1.e9 && X1<nx-1 ) {
+ try = fdh2d(t0(X1,y2-1,X2),t0(X1+1,y2-1,X2),t0(X1+1,y2,X2),
+ s0(X1,y2,X2),
+ s0(X1,y2-1,X2),s0(X1+1,y2-1,X2),s0(X1+1,y2,X2) );
+ if (try<guess) guess = try;
+ }
+ if(time0[index-1] < 1.e9 && X1>0 ) {
+ try = fdh2d(t0(X1,y2-1,X2),t0(X1-1,y2-1,X2),t0(X1-1,y2,X2),
+ s0(X1,y2,X2),
+ s0(X1,y2-1,X2),s0(X1-1,y2-1,X2),s0(X1-1,y2,X2) );
+ if (try<guess) guess = try;
+ }
+ if(time0[index+nxy] < 1.e9 && X2<nz-1 ) {
+ try = fdh2d(t0(X1,y2-1,X2),t0(X1,y2-1,X2+1),t0(X1,y2,X2+1),
+ s0(X1,y2,X2),
+ s0(X1,y2-1,X2),s0(X1,y2-1,X2+1),s0(X1,y2,X2+1) );
+ if (try<guess) guess = try;
+ }
+ if(time0[index-nxy] < 1.e9 && X2>0 ) {
+ try = fdh2d(t0(X1,y2-1,X2),t0(X1,y2-1,X2-1),t0(X1,y2,X2-1),
+ s0(X1,y2,X2),
+ s0(X1,y2-1,X2),s0(X1,y2-1,X2-1),s0(X1,y2,X2-1) );
+ if (try<guess) guess = try;
+ }
+ if(time0[index+1] < 1.e9 && time0[index+nxy+1] < 1.e9
+ && time0[index+nxy] < 1.e9 && X2<nz-1 && X1<nx-1 ) {
+ try = fdh2d(t0(X1+1,y2,X2),t0(X1+1,y2,X2+1),t0(X1,y2,X2+1),
+ s0(X1,y2,X2),
+ s0(X1+1,y2,X2),s0(X1+1,y2,X2+1),s0(X1,y2,X2+1) );
+ if (try<guess) {fhead=(guess-try)/slow0[index]; guess=try;}
+ }
+ if(time0[index+1] < 1.e9 && time0[index-nxy+1] < 1.e9
+ && time0[index-nxy] < 1.e9 && X2>0 && X1<nx-1 ) {
+ try = fdh2d(t0(X1+1,y2,X2),t0(X1+1,y2,X2-1),t0(X1,y2,X2-1),
+ s0(X1,y2,X2),
+ s0(X1+1,y2,X2),s0(X1+1,y2,X2-1),s0(X1,y2,X2-1) );
+ if (try<guess) {fhead=(guess-try)/slow0[index]; guess=try;}
+ }
+ if(time0[index-1] < 1.e9 && time0[index+nxy-1] < 1.e9
+ && time0[index+nxy] < 1.e9 && X2<nz-1 && X1>0 ) {
+ try = fdh2d(t0(X1-1,y2,X2),t0(X1-1,y2,X2+1),t0(X1,y2,X2+1),
+ s0(X1,y2,X2),
+ s0(X1-1,y2,X2),s0(X1-1,y2,X2+1),s0(X1,y2,X2+1) );
+ if (try<guess) {fhead=(guess-try)/slow0[index]; guess=try;}
+ }
+ if(time0[index-1] < 1.e9 && time0[index-nxy-1] < 1.e9
+ && time0[index-nxy] < 1.e9 && X2>0 && X1>0 ) {
+ try = fdh2d(t0(X1-1,y2,X2),t0(X1-1,y2,X2-1),t0(X1,y2,X2-1),
+ s0(X1,y2,X2),
+ s0(X1-1,y2,X2),s0(X1-1,y2,X2-1),s0(X1,y2,X2-1) );
+ if (try<guess) {fhead=(guess-try)/slow0[index]; guess=try;}
+ }
+ if(guess > 1.0e9){
+ if ( X1>x1+1 && X1<x2-1 && X2>z1+1 && X2<z2-1 ) {
+ try = fdhnf(t0(X1,y2-1,X2),
+ t0(X1+1,y2-1,X2),t0(X1,y2-1,X2+1),
+ t0(X1-1,y2-1,X2),t0(X1,y2-1,X2-1),
+ s0(X1,y2,X2),
+ s0(X1,y2-1,X2) );
+ if (try<guess) guess = try;
+ }
+ }
+ try = t0(X1,y2-1,X2) + .5*(s0(X1,y2,X2)+s0(X1,y2-1,X2));
+ if (try<guess) guess = try;
+ if ( time0[index+1]<1.e9 && X1<nx-1 ) {
+ try = t0(X1+1,y2,X2) + .5*(s0(X1,y2,X2)+s0(X1+1,y2,X2));
+ if (try<guess) {fhead=(guess-try)/slow0[index]; guess=try;}
+ }
+ if ( time0[index-1]<1.e9 && X1>0 ) {
+ try = t0(X1-1,y2,X2) + .5*(s0(X1,y2,X2)+s0(X1-1,y2,X2));
+ if (try<guess) {fhead=(guess-try)/slow0[index]; guess=try;}
+ }
+ if ( time0[index+nxy]<1.e9 && X2<nz-1 ) {
+ try = t0(X1,y2,X2+1) + .5*(s0(X1,y2,X2)+s0(X1,y2,X2+1));
+ if (try<guess) {fhead=(guess-try)/slow0[index]; guess=try;}
+ }
+ if ( time0[index-nxy]<1.e9 && X2>0 ) {
+ try = t0(X1,y2,X2-1) + .5*(s0(X1,y2,X2)+s0(X1,y2,X2-1));
+ if (try<guess) {fhead=(guess-try)/slow0[index]; guess=try;}
+ }
+ if (guess<time0[index]) {
+ time0[index] = guess;
+ if (fhead>headtest) headw[4]++;
+ }
+ }
+ if(y2 == ny-1) dy2 = 0;
+ y2++;
+ }
+ }
+ /* LEFT SIDE */
+ for (igrow=1;igrow<=iminus;igrow++) {
+ if(dx1){
+ ii = 0;
+ for(k=z1+1; k<=z2-1; k++){
+ for(j=y1+1; j<=y2-1; j++){
+ sort[ii].time = t0(x1+1,j,k);
+ sort[ii].i1 = j;
+ sort[ii].i2 = k;
+ ii++;
+ }
+ }
+ qsort((char *)sort,ii,sizeof(struct sorted),compar);
+ for(i=0;i<ii;i++){
+ X1 = sort[i].i1;
+ X2 = sort[i].i2;
+ index = X2*nxy + X1*nx + x1;
+ lasti = X2*nxy + X1*nx + (x1+1);
+ fhead = 0.;
+ guess = time0[index];
+ if(time0[index+nx] < 1.e9 && time0[index+nxy+nx] < 1.e9
+ && time0[index+nxy] < 1.e9 && X2<nz-1 && X1<ny-1 ) {
+ try = fdh3d( t0(x1+1,X1,X2),
+ t0(x1+1,X1+1,X2),t0(x1+1,X1+1,X2+1),t0(x1+1,X1,X2+1),
+ t0(x1 ,X1+1,X2),t0(x1 ,X1+1,X2+1),t0(x1 ,X1,X2+1),
+ s0(x1,X1,X2), s0(x1+1,X1,X2),
+ s0(x1+1,X1+1,X2),s0(x1+1,X1+1,X2+1),s0(x1+1,X1,X2+1),
+ s0(x1 ,X1+1,X2),s0(x1 ,X1+1,X2+1),s0(x1 ,X1,X2+1));
+ if (try<guess) guess = try;
+ }
+ if(time0[index-nx] < 1.e9 && time0[index+nxy-nx] < 1.e9
+ && time0[index+nxy] < 1.e9 && X2<nz-1 && X1>0 ) {
+ try = fdh3d( t0(x1+1,X1,X2),
+ t0(x1+1,X1-1,X2),t0(x1+1,X1-1,X2+1),t0(x1+1,X1,X2+1),
+ t0(x1 ,X1-1,X2),t0(x1 ,X1-1,X2+1),t0(x1 ,X1,X2+1),
+ s0(x1,X1,X2), s0(x1+1,X1,X2),
+ s0(x1+1,X1-1,X2),s0(x1+1,X1-1,X2+1),s0(x1+1,X1,X2+1),
+ s0(x1 ,X1-1,X2),s0(x1 ,X1-1,X2+1),s0(x1 ,X1,X2+1));
+ if (try<guess) guess = try;
+ }
+ if(time0[index+nx] < 1.e9 && time0[index-nxy+nx] < 1.e9
+ && time0[index-nxy] < 1.e9 && X2>0 && X1<ny-1 ) {
+ try = fdh3d( t0(x1+1,X1,X2),
+ t0(x1+1,X1+1,X2),t0(x1+1,X1+1,X2-1),t0(x1+1,X1,X2-1),
+ t0(x1 ,X1+1,X2),t0(x1 ,X1+1,X2-1),t0(x1 ,X1,X2-1),
+ s0(x1,X1,X2), s0(x1+1,X1,X2),
+ s0(x1+1,X1+1,X2),s0(x1+1,X1+1,X2-1),s0(x1+1,X1,X2-1),
+ s0(x1 ,X1+1,X2),s0(x1 ,X1+1,X2-1),s0(x1 ,X1,X2-1));
+ if (try<guess) guess = try;
+ }
+ if(time0[index-nx] < 1.e9 && time0[index-nxy-nx] < 1.e9
+ && time0[index-nxy] < 1.e9 && X2>0 && X1>0 ) {
+ try = fdh3d( t0(x1+1,X1,X2),
+ t0(x1+1,X1-1,X2),t0(x1+1,X1-1,X2-1),t0(x1+1,X1,X2-1),
+ t0(x1 ,X1-1,X2),t0(x1 ,X1-1,X2-1),t0(x1 ,X1,X2-1),
+ s0(x1,X1,X2), s0(x1+1,X1,X2),
+ s0(x1+1,X1-1,X2),s0(x1+1,X1-1,X2-1),s0(x1+1,X1,X2-1),
+ s0(x1 ,X1-1,X2),s0(x1 ,X1-1,X2-1),s0(x1 ,X1,X2-1));
+ if (try<guess) guess = try;
+ }
+ if(guess > 1.0e9){
+ if(time0[index+nx] < 1.e9 && X1<ny-1 && X2>z1+1 && X2<z2-1 ) {
+ try = fdhne(t0(x1+1,X1,X2),t0(x1+1,X1+1,X2),t0(x1,X1+1,X2),
+ t0(x1+1,X1+1,X2-1),t0(x1+1,X1+1,X2+1),
+ s0(x1,X1,X2),
+ s0(x1+1,X1,X2),s0(x1+1,X1+1,X2),s0(x1,X1+1,X2) );
+ if (try<guess) guess = try;
+ }
+ if(time0[index-nx] < 1.e9 && X1>0 && X2>z1+1 && X2<z2-1 ) {
+ try = fdhne(t0(x1+1,X1,X2),t0(x1+1,X1-1,X2),t0(x1,X1-1,X2),
+ t0(x1+1,X1-1,X2-1),t0(x1+1,X1-1,X2+1),
+ s0(x1,X1,X2),
+ s0(x1+1,X1,X2),s0(x1+1,X1-1,X2),s0(x1,X1-1,X2) );
+ if (try<guess) guess = try;
+ }
+ if(time0[index+nxy] < 1.e9 && X2<nz-1 && X1>y1+1 && X1<y2-1 ) {
+ try = fdhne(t0(x1+1,X1,X2),t0(x1+1,X1,X2+1),t0(x1,X1,X2+1),
+ t0(x1+1,X1-1,X2+1),t0(x1+1,X1+1,X2+1),
+ s0(x1,X1,X2),
+ s0(x1+1,X1,X2),s0(x1+1,X1,X2+1),s0(x1,X1,X2+1) );
+ if (try<guess) guess = try;
+ }
+ if(time0[index-nxy] < 1.e9 && X2>0 && X1>y1+1 && X1<y2-1 ) {
+ try = fdhne(t0(x1+1,X1,X2),t0(x1+1,X1,X2-1),t0(x1,X1,X2-1),
+ t0(x1+1,X1-1,X2-1),t0(x1+1,X1+1,X2-1),
+ s0(x1,X1,X2),
+ s0(x1+1,X1,X2),s0(x1+1,X1,X2-1),s0(x1,X1,X2-1) );
+ if (try<guess) guess = try;
+ }
+ }
+ if(time0[index+nx] < 1.e9 && X1<ny-1 ) {
+ try = fdh2d(t0(x1+1,X1,X2),t0(x1+1,X1+1,X2),t0(x1,X1+1,X2),
+ s0(x1,X1,X2),
+ s0(x1+1,X1,X2),s0(x1+1,X1+1,X2),s0(x1,X1+1,X2) );
+ if (try<guess) guess = try;
+ }
+ if(time0[index-nx] < 1.e9 && X1>0 ) {
+ try = fdh2d(t0(x1+1,X1,X2),t0(x1+1,X1-1,X2),t0(x1,X1-1,X2),
+ s0(x1,X1,X2),
+ s0(x1+1,X1,X2),s0(x1+1,X1-1,X2),s0(x1,X1-1,X2) );
+ if (try<guess) guess = try;
+ }
+ if(time0[index+nxy] < 1.e9 && X2<nz-1 ) {
+ try = fdh2d(t0(x1+1,X1,X2),t0(x1+1,X1,X2+1),t0(x1,X1,X2+1),
+ s0(x1,X1,X2),
+ s0(x1+1,X1,X2),s0(x1+1,X1,X2+1),s0(x1,X1,X2+1) );
+ if (try<guess) guess = try;
+ }
+ if(time0[index-nxy] < 1.e9 && X2>0 ) {
+ try = fdh2d(t0(x1+1,X1,X2),t0(x1+1,X1,X2-1),t0(x1,X1,X2-1),
+ s0(x1,X1,X2),
+ s0(x1+1,X1,X2),s0(x1+1,X1,X2-1),s0(x1,X1,X2-1) );
+ if (try<guess) guess = try;
+ }
+ if(time0[index+nx] < 1.e9 && time0[index+nxy+nx] < 1.e9
+ && time0[index+nxy] < 1.e9 && X2<nz-1 && X1<ny-1 ) {
+ try = fdh2d(t0(x1,X1+1,X2),t0(x1,X1+1,X2+1),t0(x1,X1,X2+1),
+ s0(x1,X1,X2),
+ s0(x1,X1+1,X2),s0(x1,X1+1,X2+1),s0(x1,X1,X2+1) );
+ if (try<guess) {fhead=(guess-try)/slow0[index]; guess=try;}
+ }
+ if(time0[index+nx] < 1.e9 && time0[index-nxy+nx] < 1.e9
+ && time0[index-nxy] < 1.e9 && X2>0 && X1<ny-1 ) {
+ try = fdh2d(t0(x1,X1+1,X2),t0(x1,X1+1,X2-1),t0(x1,X1,X2-1),
+ s0(x1,X1,X2),
+ s0(x1,X1+1,X2),s0(x1,X1+1,X2-1),s0(x1,X1,X2-1) );
+ if (try<guess) {fhead=(guess-try)/slow0[index]; guess=try;}
+ }
+ if(time0[index-nx] < 1.e9 && time0[index+nxy-nx] < 1.e9
+ && time0[index+nxy] < 1.e9 && X2<nz-1 && X1>0 ) {
+ try = fdh2d(t0(x1,X1-1,X2),t0(x1,X1-1,X2+1),t0(x1,X1,X2+1),
+ s0(x1,X1,X2),
+ s0(x1,X1-1,X2),s0(x1,X1-1,X2+1),s0(x1,X1,X2+1) );
+ if (try<guess) {fhead=(guess-try)/slow0[index]; guess=try;}
+ }
+ if(time0[index-nx] < 1.e9 && time0[index-nxy-nx] < 1.e9
+ && time0[index-nxy] < 1.e9 && X2>0 && X1>0 ) {
+ try = fdh2d(t0(x1,X1-1,X2),t0(x1,X1-1,X2-1),t0(x1,X1,X2-1),
+ s0(x1,X1,X2),
+ s0(x1,X1-1,X2),s0(x1,X1-1,X2-1),s0(x1,X1,X2-1) );
+ if (try<guess) {fhead=(guess-try)/slow0[index]; guess=try;}
+ }
+ if(guess > 1.0e9){
+ if ( X1>y1+1 && X1<y2-1 && X2>z1+1 && X2<z2-1 ) {
+ try = fdhnf(t0(x1+1,X1,X2),
+ t0(x1+1,X1+1,X2),t0(x1+1,X1,X2+1),
+ t0(x1+1,X1-1,X2),t0(x1+1,X1,X2-1),
+ s0(x1,X1,X2),
+ s0(x1+1,X1,X2) );
+ if (try<guess) guess = try;
+ }
+ }
+ try = t0(x1+1,X1,X2) + .5*(s0(x1,X1,X2)+s0(x1+1,X1,X2));
+ if (try<guess) guess = try;
+ if ( time0[index+nx]<1.e9 && X1<ny-1 ) {
+ try = t0(x1,X1+1,X2) + .5*(s0(x1,X1,X2)+s0(x1,X1+1,X2));
+ if (try<guess) {fhead=(guess-try)/slow0[index]; guess=try;}
+ }
+ if ( time0[index-nx]<1.e9 && X1>0 ) {
+ try = t0(x1,X1-1,X2) + .5*(s0(x1,X1,X2)+s0(x1,X1-1,X2));
+ if (try<guess) {fhead=(guess-try)/slow0[index]; guess=try;}
+ }
+ if ( time0[index+nxy]<1.e9 && X2<nz-1 ) {
+ try = t0(x1,X1,X2+1) + .5*(s0(x1,X1,X2)+s0(x1,X1,X2+1));
+ if (try<guess) {fhead=(guess-try)/slow0[index]; guess=try;}
+ }
+ if ( time0[index-nxy]<1.e9 && X2>0 ) {
+ try = t0(x1,X1,X2-1) + .5*(s0(x1,X1,X2)+s0(x1,X1,X2-1));
+ if (try<guess) {fhead=(guess-try)/slow0[index]; guess=try;}
+ }
+ if (guess<time0[index]) {
+ time0[index] = guess;
+ if (fhead>headtest) headw[1]++;
+ }
+ }
+ if(x1 == 0) dx1 = 0;
+ x1--;
+ }
+ }
+ /* RIGHT SIDE */
+ for (igrow=1;igrow<=iplus;igrow++) {
+ if(dx2){
+ ii = 0;
+ for(k=z1+1; k<=z2-1; k++){
+ for(j=y1+1; j<=y2-1; j++){
+ sort[ii].time = t0(x2-1,j,k);
+ sort[ii].i1 = j;
+ sort[ii].i2 = k;
+ ii++;
+ }
+ }
+ qsort((char *)sort,ii,sizeof(struct sorted),compar);
+ for(i=0;i<ii;i++){
+ X1 = sort[i].i1;
+ X2 = sort[i].i2;
+ index = X2*nxy + X1*nx + x2;
+ lasti = X2*nxy + X1*nx + (x2-1);
+ fhead = 0.;
+ guess = time0[index];
+ if(time0[index+nx] < 1.e9 && time0[index+nxy+nx] < 1.e9
+ && time0[index+nxy] < 1.e9 && X2<nz-1 && X1<ny-1 ) {
+ try = fdh3d( t0(x2-1,X1,X2),
+ t0(x2-1,X1+1,X2),t0(x2-1,X1+1,X2+1),t0(x2-1,X1,X2+1),
+ t0(x2 ,X1+1,X2),t0(x2 ,X1+1,X2+1),t0(x2 ,X1,X2+1),
+ s0(x2,X1,X2), s0(x2-1,X1,X2),
+ s0(x2-1,X1+1,X2),s0(x2-1,X1+1,X2+1),s0(x2-1,X1,X2+1),
+ s0(x2 ,X1+1,X2),s0(x2 ,X1+1,X2+1),s0(x2 ,X1,X2+1));
+ if (try<guess) guess = try;
+ }
+ if(time0[index-nx] < 1.e9 && time0[index+nxy-nx] < 1.e9
+ && time0[index+nxy] < 1.e9 && X2<nz-1 && X1>0 ) {
+ try = fdh3d( t0(x2-1,X1,X2),
+ t0(x2-1,X1-1,X2),t0(x2-1,X1-1,X2+1),t0(x2-1,X1,X2+1),
+ t0(x2 ,X1-1,X2),t0(x2 ,X1-1,X2+1),t0(x2 ,X1,X2+1),
+ s0(x2,X1,X2), s0(x2-1,X1,X2),
+ s0(x2-1,X1-1,X2),s0(x2-1,X1-1,X2+1),s0(x2-1,X1,X2+1),
+ s0(x2 ,X1-1,X2),s0(x2 ,X1-1,X2+1),s0(x2 ,X1,X2+1));
+ if (try<guess) guess = try;
+ }
+ if(time0[index+nx] < 1.e9 && time0[index-nxy+nx] < 1.e9
+ && time0[index-nxy] < 1.e9 && X2>0 && X1<ny-1 ) {
+ try = fdh3d( t0(x2-1,X1,X2),
+ t0(x2-1,X1+1,X2),t0(x2-1,X1+1,X2-1),t0(x2-1,X1,X2-1),
+ t0(x2 ,X1+1,X2),t0(x2 ,X1+1,X2-1),t0(x2 ,X1,X2-1),
+ s0(x2,X1,X2), s0(x2-1,X1,X2),
+ s0(x2-1,X1+1,X2),s0(x2-1,X1+1,X2-1),s0(x2-1,X1,X2-1),
+ s0(x2 ,X1+1,X2),s0(x2 ,X1+1,X2-1),s0(x2 ,X1,X2-1));
+ if (try<guess) guess = try;
+ }
+ if(time0[index-nx] < 1.e9 && time0[index-nxy-nx] < 1.e9
+ && time0[index-nxy] < 1.e9 && X2>0 && X1>0 ) {
+ try = fdh3d( t0(x2-1,X1,X2),
+ t0(x2-1,X1-1,X2),t0(x2-1,X1-1,X2-1),t0(x2-1,X1,X2-1),
+ t0(x2 ,X1-1,X2),t0(x2 ,X1-1,X2-1),t0(x2 ,X1,X2-1),
+ s0(x2,X1,X2), s0(x2-1,X1,X2),
+ s0(x2-1,X1-1,X2),s0(x2-1,X1-1,X2-1),s0(x2-1,X1,X2-1),
+ s0(x2 ,X1-1,X2),s0(x2 ,X1-1,X2-1),s0(x2 ,X1,X2-1));
+ if (try<guess) guess = try;
+ }
+ if(guess > 1.0e9){
+ if(time0[index+nx] < 1.e9 && X1<ny-1 && X2>z1+1 && X2<z2-1 ) {
+ try = fdhne(t0(x2-1,X1,X2),t0(x2-1,X1+1,X2),t0(x2,X1+1,X2),
+ t0(x2-1,X1+1,X2-1),t0(x2-1,X1+1,X2+1),
+ s0(x2,X1,X2),
+ s0(x2-1,X1,X2),s0(x2-1,X1+1,X2),s0(x2,X1+1,X2) );
+ if (try<guess) guess = try;
+ }
+ if(time0[index-nx] < 1.e9 && X1>0 && X2>z1+1 && X2<z2-1 ) {
+ try = fdhne(t0(x2-1,X1,X2),t0(x2-1,X1-1,X2),t0(x2,X1-1,X2),
+ t0(x2-1,X1-1,X2-1),t0(x2-1,X1-1,X2+1),
+ s0(x2,X1,X2),
+ s0(x2-1,X1,X2),s0(x2-1,X1-1,X2),s0(x2,X1-1,X2) );
+ if (try<guess) guess = try;
+ }
+ if(time0[index+nxy] < 1.e9 && X2<nz-1 && X1>y1+1 && X1<y2-1 ) {
+ try = fdhne(t0(x2-1,X1,X2),t0(x2-1,X1,X2+1),t0(x2,X1,X2+1),
+ t0(x2-1,X1-1,X2+1),t0(x2-1,X1+1,X2+1),
+ s0(x2,X1,X2),
+ s0(x2-1,X1,X2),s0(x2-1,X1,X2+1),s0(x2,X1,X2+1) );
+ if (try<guess) guess = try;
+ }
+ if(time0[index-nxy] < 1.e9 && X2>0 && X1>y1+1 && X1<y2-1 ) {
+ try = fdhne(t0(x2-1,X1,X2),t0(x2-1,X1,X2-1),t0(x2,X1,X2-1),
+ t0(x2-1,X1-1,X2-1),t0(x2-1,X1+1,X2-1),
+ s0(x2,X1,X2),
+ s0(x2-1,X1,X2),s0(x2-1,X1,X2-1),s0(x2,X1,X2-1) );
+ if (try<guess) guess = try;
+ }
+ }
+ if(time0[index+nx] < 1.e9 && X1<ny-1 ) {
+ try = fdh2d(t0(x2-1,X1,X2),t0(x2-1,X1+1,X2),t0(x2,X1+1,X2),
+ s0(x2,X1,X2),
+ s0(x2-1,X1,X2),s0(x2-1,X1+1,X2),s0(x2,X1+1,X2) );
+ if (try<guess) guess = try;
+ }
+ if(time0[index-nx] < 1.e9 && X1>0 ) {
+ try = fdh2d(t0(x2-1,X1,X2),t0(x2-1,X1-1,X2),t0(x2,X1-1,X2),
+ s0(x2,X1,X2),
+ s0(x2-1,X1,X2),s0(x2-1,X1-1,X2),s0(x2,X1-1,X2) );
+ if (try<guess) guess = try;
+ }
+ if(time0[index+nxy] < 1.e9 && X2<nz-1 ) {
+ try = fdh2d(t0(x2-1,X1,X2),t0(x2-1,X1,X2+1),t0(x2,X1,X2+1),
+ s0(x2,X1,X2),
+ s0(x2-1,X1,X2),s0(x2-1,X1,X2+1),s0(x2,X1,X2+1) );
+ if (try<guess) guess = try;
+ }
+ if(time0[index-nxy] < 1.e9 && X2>0 ) {
+ try = fdh2d(t0(x2-1,X1,X2),t0(x2-1,X1,X2-1),t0(x2,X1,X2-1),
+ s0(x2,X1,X2),
+ s0(x2-1,X1,X2),s0(x2-1,X1,X2-1),s0(x2,X1,X2-1) );
+ if (try<guess) guess = try;
+ }
+ if(time0[index+nx] < 1.e9 && time0[index+nxy+nx] < 1.e9
+ && time0[index+nxy] < 1.e9 && X2<nz-1 && X1<ny-1 ) {
+ try = fdh2d(t0(x2,X1+1,X2),t0(x2,X1+1,X2+1),t0(x2,X1,X2+1),
+ s0(x2,X1,X2),
+ s0(x2,X1+1,X2),s0(x2,X1+1,X2+1),s0(x2,X1,X2+1) );
+ if (try<guess) {fhead=(guess-try)/slow0[index]; guess=try;}
+ }
+ if(time0[index+nx] < 1.e9 && time0[index-nxy+nx] < 1.e9
+ && time0[index-nxy] < 1.e9 && X2>0 && X1<ny-1 ) {
+ try = fdh2d(t0(x2,X1+1,X2),t0(x2,X1+1,X2-1),t0(x2,X1,X2-1),
+ s0(x2,X1,X2),
+ s0(x2,X1+1,X2),s0(x2,X1+1,X2-1),s0(x2,X1,X2-1) );
+ if (try<guess) {fhead=(guess-try)/slow0[index]; guess=try;}
+ }
+ if(time0[index-nx] < 1.e9 && time0[index+nxy-nx] < 1.e9
+ && time0[index+nxy] < 1.e9 && X2<nz-1 && X1>0 ) {
+ try = fdh2d(t0(x2,X1-1,X2),t0(x2,X1-1,X2+1),t0(x2,X1,X2+1),
+ s0(x2,X1,X2),
+ s0(x2,X1-1,X2),s0(x2,X1-1,X2+1),s0(x2,X1,X2+1) );
+ if (try<guess) {fhead=(guess-try)/slow0[index]; guess=try;}
+ }
+ if(time0[index-nx] < 1.e9 && time0[index-nxy-nx] < 1.e9
+ && time0[index-nxy] < 1.e9 && X2>0 && X1>0 ) {
+ try = fdh2d(t0(x2,X1-1,X2),t0(x2,X1-1,X2-1),t0(x2,X1,X2-1),
+ s0(x2,X1,X2),
+ s0(x2,X1-1,X2),s0(x2,X1-1,X2-1),s0(x2,X1,X2-1) );
+ if (try<guess) {fhead=(guess-try)/slow0[index]; guess=try;}
+ }
+ if(guess > 1.0e9){
+ if ( X1>y1+1 && X1<y2-1 && X2>z1+1 && X2<z2-1 ) {
+ try = fdhnf(t0(x2-1,X1,X2),
+ t0(x2-1,X1+1,X2),t0(x2-1,X1,X2+1),
+ t0(x2-1,X1-1,X2),t0(x2-1,X1,X2-1),
+ s0(x2,X1,X2),
+ s0(x2-1,X1,X2) );
+ if (try<guess) guess = try;
+ }
+ }
+ try = t0(x2-1,X1,X2) + .5*(s0(x2,X1,X2)+s0(x2-1,X1,X2));
+ if (try<guess) guess = try;
+ if ( time0[index+nx]<1.e9 && X1<ny-1 ) {
+ try = t0(x2,X1+1,X2) + .5*(s0(x2,X1,X2)+s0(x2,X1+1,X2));
+ if (try<guess) {fhead=(guess-try)/slow0[index]; guess=try;}
+ }
+ if ( time0[index-nx]<1.e9 && X1>0 ) {
+ try = t0(x2,X1-1,X2) + .5*(s0(x2,X1,X2)+s0(x2,X1-1,X2));
+ if (try<guess) {fhead=(guess-try)/slow0[index]; guess=try;}
+ }
+ if ( time0[index+nxy]<1.e9 && X2<nz-1 ) {
+ try = t0(x2,X1,X2+1) + .5*(s0(x2,X1,X2)+s0(x2,X1,X2+1));
+ if (try<guess) {fhead=(guess-try)/slow0[index]; guess=try;}
+ }
+ if ( time0[index-nxy]<1.e9 && X2>0 ) {
+ try = t0(x2,X1,X2-1) + .5*(s0(x2,X1,X2)+s0(x2,X1,X2-1));
+ if (try<guess) {fhead=(guess-try)/slow0[index]; guess=try;}
+ }
+ if (guess<time0[index]) {
+ time0[index] = guess;
+ if (fhead>headtest) headw[2]++;
+ }
+ }
+ if(x2 == nx-1) dx2 = 0;
+ x2++;
+ }
+ }
+
+ /* UPDATE RADIUS */
+ radius++;
+ if(radius%10 == 0 && verbose) vmess("Completed radius = %d",radius);
+ if(radius == maxrad) rad0 = 0;
+
+ } /* END BIG LOOP */
+
+
+ /* TEST IF REVERSE PROPAGATION IS NEEDED */
+
+ if (headw[1]==0 && headw[2]==0 && headw[3]==0 && headw[4]==0
+ && headw[5]==0 && headw[6]==0)
+ reverse=0;
+ else {
+ head=0;
+ if (headw[1]>0) {
+ if(verbose) vmess("Head waves found on left: %d",headw[1]);
+ if (headw[1]>head) {
+ head = headw[1];
+ srcwall = 1;
+ }
+ }
+ if (headw[2]>0) {
+ if(verbose) vmess("Head waves found on right: %d",headw[2]);
+ if (headw[2]>head) {
+ head = headw[2];
+ srcwall = 2;
+ }
+ }
+ if (headw[3]>0) {
+ if(verbose) vmess("Head waves found on front: %d",headw[3]);
+ if (headw[3]>head) {
+ head = headw[3];
+ srcwall = 3;
+ }
+ }
+ if (headw[4]>0) {
+ if(verbose) vmess("Head waves found on back: %d",headw[4]);
+ if (headw[4]>head) {
+ head = headw[4];
+ srcwall = 4;
+ }
+ }
+ if (headw[5]>0) {
+ if(verbose) vmess("Head waves found on top: %d",headw[5]);
+ if (headw[5]>head) {
+ head = headw[5];
+ srcwall = 5;
+ }
+ }
+ if (headw[6]>0) {
+ if(verbose) vmess("Head waves found on bottom: %d",headw[6]);
+ if (headw[6]>head) {
+ head = headw[6];
+ srcwall = 6;
+ }
+ }
+ if (headpref>0 && headw[headpref]>0) {
+ if(verbose)
+ vmess("Preference to restart on wall opposite source");
+ srcwall = headpref;
+ }
+ /* SET LOCATIONS OF SIDES OF THE CUBE SO THAT CUBE IS A FACE */
+ dx1=1; dx2=1; dy1=1; dy2=1; dz1=1; dz2=1; rad0=1;
+ radius = 1;
+ if (srcwall == 1) { x2=1;
+ vmess("RESTART at left side of model"); }
+ else { x2=nx; dx2=0; }
+ if (srcwall == 2) { x1=nx-2;
+ vmess("RESTART at right side of model"); }
+ else { x1= -1; dx1=0; }
+ if (srcwall == 3) { y2=1;
+ vmess("RESTART at front side of model"); }
+ else { y2=ny; dy2=0; }
+ if (srcwall == 4) { y1=ny-2;
+ vmess("RESTART at back side of model"); }
+ else { y1= -1; dy1=0; }
+ if (srcwall == 5) { z2=1;
+ vmess("RESTART at top side of model"); }
+ else { z2=nz; dz2=0; }
+ if (srcwall == 6) { z1=nz-2;
+ vmess("RESTART at bottom side of model"); }
+ else { z1= -1; dz1=0; }
+ if (reverse == 0)
+ vwarn("RESTART CANCELLED by choice of input parameter `reverse`");
+ }
+ reverse--;
+
+ } /* END BIGGER LOOP - HOLE */
+
+ free(sort);
+ free(wall);
+}
+
+int compar(struct sorted *a,struct sorted *b)
+{
+ if(a->time > b->time) return(1);
+ if(b->time > a->time) return(-1);
+ else return(0);
+}
+
+
+/* 3D TRANSMISSION STENCIL
+ STENCIL FROM VIDALE; CONDITIONS AND OTHER OPTIONS FROM HOLE
+ JAH 11/91 */
+float fdh3d(t1,t2,t3,t4,t5,t6,t7,ss0,s1,s2,s3,s4,s5,s6,s7)
+ float t1,t2,t3,t4,t5,t6,t7,ss0,s1,s2,s3,s4,s5,s6,s7;
+ /* ss0 at newpoint; s1,t1 adjacent on oldface;
+ s2,t2 and s4,t4 on oldface adjacent to s1;
+ s3,t3 on oldface diametrically opposite newpoint;
+ s5,t5 on newface adjacent to newpoint AND to s2;
+ s6,t6 on newface diagonal to newpoint (adjacent to s3);
+ s7,t7 on newface adjacent to newpoint AND to s4
+ */
+{
+ float x,slo;
+ double sqrt();
+ slo = .125*(ss0+s1+s2+s3+s4+s5+s6+s7);
+ x = 6.*slo*slo - (t4-t2)*(t4-t2) - (t2-t6)*(t2-t6) - (t6-t4)*(t6-t4)
+ - (t7-t5)*(t7-t5) - (t5-t1)*(t5-t1) - (t1-t7)*(t1-t7);
+ if (x>=0.) {
+ x = t3 + sqrt(.5*x);
+ if ( (x<t1) || (x<t2) || (x<t4) || (x<t5) || (x<t6) || (x<t7) )
+ x = 1.e11; /* ACAUSAL; ABORT */
+ }
+ else x = 1.e11; /* SQRT IMAGINARY; ABORT */
+ return(x);
+}
+
+/* 3D STENCIL FOR NEW EDGE
+ STENCIL FROM VIDALE; CONDITIONS AND OTHER OPTIONS FROM HOLE
+ JAH 11/91 */
+float fdhne(t1,t2,t3,t4,t5,ss0,s1,s2,s3)
+ float t1,t2,t3,t4,t5,ss0,s1,s2,s3;
+ /* ss0 at newpoint; s1,t1 adjacent on oldface;
+ s2,t2 diagonal on oldface; s3,t3 adjacent on newface;
+ t4,t5 beside t2 on old face opposite each other */
+{
+ float x,slo;
+ double sqrt();
+ slo = .25*(ss0+s1+s2+s3);
+ x = 2.*slo*slo - (t3-t1)*(t3-t1) - .5*(t5-t4)*(t5-t4);
+ if (x>=0.) {
+ x = t2 + sqrt(x);
+ if ( (x<t1) || (x<t3) || (x<t4) || (x<t5) ) /* ACAUSAL; ABORT */
+ x = 1.e11;
+ }
+ else x = 1.e11; /* SQRT IMAGINARY; ABORT */
+ return(x);
+}
+
+/* 2D TRANSMISSION STENCIL (FOR HEAD WAVES ON FACES OF GRID CELLS)
+ STENCIL FROM VIDALE (1988 2D PAPER); CONDITIONS AND OTHER OPTIONS FROM HOLE
+ JAH 11/91 */
+float fdh2d(t1,t2,t3,ss0,s1,s2,s3)
+ float t1,t2,t3,ss0,s1,s2,s3;
+ /* ss0 at newpoint; s1,t1 & s3,t3 adjacent; s2,t2 diagonal
+ */
+{
+ float x,slo;
+ double sqrt();
+ slo = .25*(ss0+s1+s2+s3);
+ x = 2.*slo*slo - (t3-t1)*(t3-t1);
+ if (x>=0.) {
+ x = t2 + sqrt(x);
+ if ( (x<t1) || (x<t3) ) x = 1.e11; /* ACAUSAL; ABORT */
+ }
+ else x = 1.e11; /* SQRT IMAGINARY; ABORT */
+ return(x);
+}
+
+/* 3D STENCIL FOR NEW FACE
+ STENCIL FROM VIDALE; CONDITIONS AND OTHER OPTIONS FROM HOLE
+ JAH 11/91 */
+float fdhnf(t1,t2,t3,t4,t5,ss0,s1)
+ float t1,t2,t3,t4,t5,ss0,s1;
+ /* ss0 at newpoint; s1,t1 adjacent on old face;
+ t2,t4 beside t1 on old face and opposite each other;
+ t3,t5 beside t1 on old face and opposite each other
+ */
+{
+ float x,slo;
+ double sqrt();
+ slo = .5*(ss0+s1);
+ x = slo*slo - .25*( (t4-t2)*(t4-t2) + (t5-t3)*(t5-t3) );
+ if (x>=0.) {
+ x = t1 + sqrt(x);
+ if ( (x<t2) || (x<t3) || (x<t4) || (x<t5) ) /* ACAUSAL; ABORT */
+ x = 1.e11;
+ }
+ else x = 1.e11; /* SQRT IMAGINARY; ABORT */
+ return(x);
+}
+
+
diff --git a/raytime3d/wallclock_time.c b/raytime3d/wallclock_time.c
new file mode 100644
index 0000000000000000000000000000000000000000..1e75530ccee3215724badefdd6144c2c59246dbc
--- /dev/null
+++ b/raytime3d/wallclock_time.c
@@ -0,0 +1,33 @@
+#include <time.h>
+#include <sys/time.h>
+#include <stdio.h>
+
+/**
+* function used to calculate wallclock times
+*
+* AUTHOR:
+* Jan Thorbecke (janth@xs4all.nl)
+* The Netherlands
+**/
+
+double wallclock_time(void)
+{
+ struct timeval s_val;
+ static struct timeval b_val;
+ double time;
+ static int base=0;
+
+ gettimeofday(&s_val,0);
+
+ if (!base) {
+ b_val = s_val;
+ base = 1;
+ return 0.0;
+ }
+
+ time = (double)(s_val.tv_sec-b_val.tv_sec) +
+ (double)(1e-6*((double)s_val.tv_usec-(double)b_val.tv_usec));
+
+ return (double)time;
+}
+
diff --git a/raytime3d/writeSrcRecPos.c b/raytime3d/writeSrcRecPos.c
new file mode 100644
index 0000000000000000000000000000000000000000..d9d03da16dae329b7628e3420224bda8d9a6cce4
--- /dev/null
+++ b/raytime3d/writeSrcRecPos.c
@@ -0,0 +1,136 @@
+#include<stdlib.h>
+#include<stdio.h>
+#include<math.h>
+#include<assert.h>
+#include"par.h"
+#include"raytime3d.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);
+ 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/raytime3d/writesufile.c b/raytime3d/writesufile.c
new file mode 100644
index 0000000000000000000000000000000000000000..7ebcbbd198858193b67a2b9c2fbb5670feb8b5d8
--- /dev/null
+++ b/raytime3d/writesufile.c
@@ -0,0 +1,169 @@
+#include <stdlib.h>
+#include <stdio.h>
+#include <assert.h>
+#include <string.h>
+#include "par.h"
+#include "raytime3d.h"
+#include "SUsegy.h"
+#include "segy.h"
+
+/**
+* Writes an 2D array to a SU file
+*
+* AUTHOR:
+* Jan Thorbecke (janth@xs4all.nl)
+* The Netherlands
+**/
+
+#define TRCBYTES 240
+
+#define MAX(x,y) ((x) > (y) ? (x) : (y))
+#define MIN(x,y) ((x) < (y) ? (x) : (y))
+#define ISODD(n) ((n) & 01)
+#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)
+{
+ FILE *file_out;
+ size_t nwrite, itrace;
+ int ns;
+ segy *hdr;
+// char *ptr;
+
+/* Read in parameters */
+
+// ptr = strstr(filename, " ");
+// *ptr = '\0';
+
+
+ if (n1 > USHRT_MAX) {
+ vwarn("Output file %s: number of samples is truncated from %d to USHRT_MAX.", filename, n1);
+ }
+ ns = MIN(n1,USHRT_MAX);
+
+ file_out = fopen( filename, "w+" );
+ assert( file_out );
+
+ hdr = (segy *)calloc(1,TRCBYTES);
+ hdr->ns = ns;
+ hdr->dt = NINT(1000000*(d1));
+ hdr->d1 = d1;
+ hdr->d2 = d2;
+ hdr->f1 = f1;
+ hdr->f2 = f2;
+ hdr->fldr = 1;
+ hdr->trwf = n2;
+
+ for (itrace=0; itrace<n2; itrace++) {
+ hdr->tracl = itrace+1;
+ nwrite = fwrite( hdr, 1, TRCBYTES, file_out );
+ assert (nwrite == TRCBYTES);
+ nwrite = fwrite( &data[itrace*n1], sizeof(float), ns, file_out );
+ assert (nwrite == ns);
+ }
+ fclose(file_out);
+ free(hdr);
+
+ return 0;
+}
+
+/**
+* Writes an 2D array to a SU file
+* special routine for src_nwav array which has a different number of samples for each shot
+*
+**/
+
+int writesufilesrcnwav(char *filename, float **src_nwav, wavPar wav, int n1, int n2, float f1, float f2, float d1, float d2)
+{
+ FILE *file_out;
+ size_t nwrite, itrace;
+ float *trace;
+ int ns;
+ segy *hdr;
+// char *ptr;
+
+/* Read in parameters */
+
+// ptr = strstr(filename, " ");
+// *ptr = '\0';
+
+ if (n1 > USHRT_MAX) {
+ vwarn("Output file %s: number of samples is truncated from %d to USHRT_MAX.", filename, n1);
+ }
+ ns = MIN(n1,USHRT_MAX);
+
+ file_out = fopen( filename, "w+" );
+ assert( file_out );
+
+ trace = (float *)malloc(n1*sizeof(float));
+ hdr = (segy *)calloc(1,TRCBYTES);
+ hdr->ns = ns;
+ hdr->dt = NINT(1000000*(d1));
+ hdr->d1 = d1;
+ hdr->d2 = d2;
+ hdr->f1 = f1;
+ hdr->f2 = f2;
+ hdr->fldr = 1;
+ hdr->trwf = n2;
+
+ for (itrace=0; itrace<n2; itrace++) {
+ hdr->tracl = itrace+1;
+ nwrite = fwrite( hdr, 1, TRCBYTES, file_out );
+ assert (nwrite == TRCBYTES);
+ memset(trace, 0, n1*sizeof(float));
+ memcpy(trace, &src_nwav[itrace][0], wav.nsamp[itrace]*sizeof(float));
+ nwrite = fwrite( &trace[0], sizeof(float), ns, file_out );
+ assert (nwrite == ns);
+ }
+ fclose(file_out);
+ free(hdr);
+ free(trace);
+
+ return 0;
+}
+
+/**
+* Writes an 2D array to a SU file
+* special routine which used segyhdrs which have ns defined as integer (32 bit)
+* to handle more than 2^16 samples per trace.
+*
+**/
+
+int writeSUfile(char *filename, float *data, int n1, int n2, float f1, float f2, float d1, float d2)
+{
+ FILE *file_out;
+ size_t nwrite, itrace;
+ SUsegy *SUhdr;
+ char *ptr;
+
+/* Read in parameters */
+
+ ptr = strstr(filename, " ");
+ *ptr = '\0';
+
+ file_out = fopen( filename, "w+" );
+ assert( file_out );
+
+ SUhdr = (SUsegy *)calloc(1,TRCBYTES);
+ SUhdr->ns = n1;
+ SUhdr->dt = NINT(1000000*(d1));
+ SUhdr->d1 = d1;
+ SUhdr->d2 = d2;
+ SUhdr->f1 = f1;
+ SUhdr->f2 = f2;
+ SUhdr->fldr = 1;
+ SUhdr->trwf = n2;
+
+ for (itrace=0; itrace<n2; itrace++) {
+ SUhdr->tracl = itrace+1;
+ nwrite = fwrite( SUhdr, 1, TRCBYTES, file_out );
+ assert (nwrite == TRCBYTES);
+ nwrite = fwrite( &data[itrace*n1], sizeof(float), n1, file_out );
+ assert (nwrite == n1);
+ }
+ fclose(file_out);
+ free(SUhdr);
+
+ return 0;
+}
+
diff --git a/scripts/SolidEarth2018/ScatterModel/ClassicBacpProp.scr b/scripts/SolidEarth2018/ScatterModel/ClassicBacpProp.scr
new file mode 100755
index 0000000000000000000000000000000000000000..7272fd1f3d92dcbf979cc6ed00aa555712ca1879
--- /dev/null
+++ b/scripts/SolidEarth2018/ScatterModel/ClassicBacpProp.scr
@@ -0,0 +1,92 @@
+#!/bin/bash
+#
+#SBATCH -J ClassicTimeReverse
+#SBATCH --cpus-per-task=8
+#SBATCH --ntasks=1
+#SBATCH --time=1:00:00
+
+export PATH=:$HOME/src/OpenSource/bin:$HOME/bin:$PATH:
+which makewave
+which makemod
+which fdelmodc
+
+cd /vardim/home/thorbcke/data/Kees/Marchenko/SolidEarth/ScatterModel
+
+#makewave fp=20 dt=$dt file_out=wave.su nt=4096 t0=0.1
+#makewave w=fw fmin=0 flef=5 frig=80 fmax=100 dt=$dt file_out=wavefw.su nt=4096 t0=0.3
+
+dx=2.5
+dt=0.0005
+depth=700
+
+ix1a=1
+ix1b=$(echo "scale=0; ${ix1a}+6000/${dx}" | bc -l)
+base=$(echo "scale=0; ${depth}/${dx}" | bc -l)
+
+makewave fp=25 dt=$dt file_out=wave.su nt=1024 t0=0.1 scale=1
+
+file_mod=scat
+
+export OMP_NUM_THREADS=8
+
+app=2250
+fileshom=shom_${app}.su
+suwind < shom_rp.su key=gx min=-${app}000 max=${app}000 > $fileshom
+
+fdelmodc \
+ file_cp=hom_cp.su ischeme=1 iorder=4 \
+ file_den=scatter_ro.su \
+ file_src=$fileshom \
+ grid_dir=1 \
+ src_type=1 \
+ src_injectionrate=1 \
+ src_orient=1 \
+ rec_delay=0.0 \
+ verbose=2 \
+ tmod=4.51 \
+ file_snap=${file_mod}_BackProp.su \
+ tsnap1=3.4950 dtsnap=0.05 tsnap2=4.5005 sna_type_vz=0 \
+ dxsnap=$dx dzsnap=$dx zsnap1=0 zsnap2=1200 xsnap1=-2250 xsnap2=2250 \
+ npml=250 \
+ left=2 right=2 top=2 bottom=2
+
+# tsnap1=4.0905 dtsnap=0.0005 tsnap2=4.1005 sna_type_vz=0 \
+# dxsnap=$dx dzsnap=$dx zsnap1=0 zsnap2=1000 xsnap1=-500 xsnap2=500 \
+
+
+# curve=curve1,curve2,curve3 npair=25,25,25 curvecolor=black,black,black curvedash=3,3,3 \
+
+for file in ${file_mod}_BackProp
+do
+ sumax < ${file}_sp.su mode=abs outpar=nep
+ clip=`cat nep | awk '{print $1/10}'`
+ echo $clip
+
+ for fldr in 10 13 16
+ do
+ times=$(echo "scale=2; 0.05*(13-${fldr})" | bc -l)
+ atime=`printf "%4.2f" $times`
+ suwind key=fldr min=$fldr max=$fldr < ${file}_sp.su | \
+ supsimage hbox=4 wbox=4.7 labelsize=10 \
+ x1beg=0 x1end=1200 clip=$clip \
+ n1tic=4 x2beg=-1000 f2num=-1000 d2num=500 x2end=1000 > ${file}_$atime.eps
+ done
+
+ suwind itmin=$base itmax=$base key=fldr min=13 max=13 < ${file}_sp.su | sumax mode=abs outpar=nep
+ scl=`cat nep | awk '{print 1.0/$1}'`
+ echo scale for trace = $scl
+ suwind itmin=$base itmax=$base key=fldr min=13 max=13 < ${file}_sp.su | sugain scale=$scl | sustrip > trace.bin
+ suaddhead < trace.bin n1=1801 dt=$dx | supsgraph hbox=2 wbox=6 labelsize=10 \
+ f1=-2250 d1=$dx x1beg=-500 x1end=500 f1num=-500 d1num=500 style=normal > ${file}_z${depth}_t0.eps
+
+ (( imin = base - 50 ))
+ (( imax = base + 50 ))
+ echo $base $imin $imax
+ suwind key=fldr min=13 max=13 < ${file}_sp.su | \
+ suwind itmin=$imin itmax=$imax key=gx min=-125000 max=125000 | \
+ sustrip > ${file}_t0.bin
+
+ python3 readbin.py ${file}_t0.bin
+done
+
+rm nep trace.bin
diff --git a/scripts/SolidEarth2018/ScatterModel/ClassicTimeReverse.scr b/scripts/SolidEarth2018/ScatterModel/ClassicTimeReverse.scr
new file mode 100755
index 0000000000000000000000000000000000000000..5bd28b190de0754f11bc18a8a941fab2acd8fffb
--- /dev/null
+++ b/scripts/SolidEarth2018/ScatterModel/ClassicTimeReverse.scr
@@ -0,0 +1,223 @@
+#!/bin/bash
+#
+#SBATCH -J ClassicTimeReverse
+#SBATCH --cpus-per-task=12
+#SBATCH --ntasks=1
+#SBATCH --time=1:00:00
+#SBATCH --hint=nomultithread
+
+export PATH=:$HOME/src/OpenSource/bin:$HOME/bin:$PATH:
+which makewave
+which makemod
+which fdelmodc
+
+cd /vardim/home/thorbcke/data/Kees/Marchenko/SolidEarth/ScatterModel
+
+#makewave fp=20 dt=$dt file_out=wave.su nt=4096 t0=0.1
+#makewave w=fw fmin=0 flef=5 frig=80 fmax=100 dt=$dt file_out=wavefw.su nt=4096 t0=0.3
+
+dx=2.5
+dt=0.0005
+depth=850
+
+ix1a=1
+ix1b=$(echo "scale=0; ${ix1a}+6000/${dx}" | bc -l)
+base=$(echo "scale=0; ${depth}/${dx}" | bc -l)
+
+makewave fp=25 dt=$dt file_out=wave.su nt=1024 t0=0.1 scale=1
+
+file_mod=scat
+
+export OMP_NUM_THREADS=12
+
+#forward model of scattered response of source at depth
+fdelmodc \
+ file_cp=hom_cp.su ischeme=1 iorder=4 \
+ file_den=scatter_ro.su \
+ file_src=wave.su \
+ file_rcv=ctr.su \
+ src_type=1 \
+ src_injectionrate=1 \
+ src_orient=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=$dt \
+ rec_delay=0.1 \
+ verbose=2 \
+ tmod=4.1955 \
+ dxrcv=$dx \
+ xrcv1=-2250 xrcv2=2250 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=0 zsrc=$depth \
+ npml=250 \
+ left=2 right=2 top=2 bottom=2
+
+#impulse response through scattered medium
+fdelmodc \
+ file_cp=hom_cp.su ischeme=1 iorder=4 \
+ file_den=scatter_ro.su \
+ file_src=wave.su \
+ file_rcv=ctr_impulse_response.su \
+ src_type=1 \
+ src_injectionrate=1 \
+ src_orient=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ rec_delay=0.1 \
+ tmod=4.1940 \
+ dtrcv=0.004 \
+ verbose=2 \
+ dxrcv=10.0 \
+ xrcv1=-2250 xrcv2=2250 \
+ zrcv1=$depth zrcv2=$depth \
+ xsrc=$xsrc zsrc=0 \
+ ntaper=250 \
+ left=2 right=2 top=2 bottom=2
+
+for offset in -1000 -500 0 500 1000
+do
+suwind key=offset min=$offset max=$offset < ctr_impulse_response_rp.su | \
+ supswigp wbox=1 hbox=5 titlesize=-1 labelsize=-1 axescolor=white > impulse_response_off${offset}.eps
+done
+
+
+#Forward model of homogenoeus response of source at depth
+fdelmodc \
+ file_cp=hom_cp.su ischeme=1 iorder=4 \
+ file_den=hom_ro.su \
+ file_src=wave.su \
+ file_rcv=shom.su \
+ src_type=1 \
+ src_injectionrate=1 \
+ src_orient=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=$dt \
+ rec_delay=0.1 \
+ verbose=2 \
+ tmod=4.1955 \
+ dxrcv=$dx \
+ xrcv1=-2250 xrcv2=2250 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=0 zsrc=$depth \
+ npml=250 \
+ left=2 right=2 top=2 bottom=2
+
+app=300
+filectr=ctr_${app}.su
+fileshom=shom_${app}.su
+suwind < ctr_rp.su key=gx min=-${app}000 max=${app}000 > $filectr
+suwind < shom_rp.su key=gx min=-${app}000 max=${app}000 > $fileshom
+
+#Time reverse of scattered field through scattered medium
+fdelmodc \
+ file_cp=hom_cp.su ischeme=1 iorder=4 \
+ file_den=scatter_ro.su \
+ file_src=$filectr \
+ grid_dir=1 \
+ src_type=1 \
+ src_injectionrate=1 \
+ src_orient=1 \
+ rec_delay=0.0 \
+ verbose=2 \
+ tmod=4.51 \
+ file_snap=${file_mod}_timerev_scat_scat${app}.su \
+ tsnap1=3.4950 dtsnap=0.05 tsnap2=4.5005 sna_type_vz=0 \
+ dxsnap=$dx dzsnap=$dx zsnap1=0 zsnap2=1200 xsnap1=-2250 xsnap2=2250 \
+ npml=250 \
+ left=2 right=2 top=2 bottom=2
+
+#Time reverse of homogenoeus field through homogenoeus medium
+fdelmodc \
+ file_cp=hom_cp.su ischeme=1 iorder=4 \
+ file_den=hom_ro.su \
+ file_src=$fileshom \
+ grid_dir=1 \
+ src_type=1 \
+ src_injectionrate=1 \
+ src_orient=1 \
+ rec_delay=0.0 \
+ verbose=2 \
+ tmod=4.51 \
+ file_snap=${file_mod}_timerev_hom_hom${app}.su \
+ tsnap1=3.4950 dtsnap=0.05 tsnap2=4.5005 sna_type_vz=0 \
+ dxsnap=$dx dzsnap=$dx zsnap1=0 zsnap2=1200 xsnap1=-2250 xsnap2=2250 \
+ npml=250 \
+ left=2 right=2 top=2 bottom=2
+
+#Time reverse of scattered field through homogenoeus medium
+fdelmodc \
+ file_cp=hom_cp.su ischeme=1 iorder=4 \
+ file_den=hom_ro.su \
+ file_src=$filectr \
+ grid_dir=1 \
+ src_type=1 \
+ src_injectionrate=1 \
+ src_orient=1 \
+ rec_delay=0.0 \
+ verbose=2 \
+ tmod=4.51 \
+ file_snap=${file_mod}_timerev_hom_scat${app}.su \
+ tsnap1=3.4950 dtsnap=0.05 tsnap2=4.5005 sna_type_vz=0 \
+ dxsnap=$dx dzsnap=$dx zsnap1=0 zsnap2=1200 xsnap1=-2250 xsnap2=2250 \
+ npml=250 \
+ left=2 right=2 top=2 bottom=2
+
+# curve=curve1,curve2,curve3 npair=25,25,25 curvecolor=black,black,black curvedash=3,3,3 \
+
+#sumax < ${file_mod}_back_hom_ctr${app}_sp.su mode=abs outpar=nep
+#x2end=`cat nep | awk '{print $1}'`
+#echo $x2end
+
+for file in ${file_mod}_timerev_hom_scat${app} ${file_mod}_timerev_hom_hom${app} ${file_mod}_timerev_scat_scat${app}
+do
+ sumax < ${file}_sp.su mode=abs outpar=nep
+ clip=`cat nep | awk '{print $1/10}'`
+ echo $file has clip $clip
+
+ for fldr in 10 13 16
+ do
+ times=$(echo "scale=2; 0.05*(13-${fldr})" | bc -l)
+ atime=`printf "%4.2f" $times`
+ suwind key=fldr min=$fldr max=$fldr < ${file}_sp.su | \
+ supsimage hbox=4 wbox=4.7 labelsize=10 \
+ x1beg=0 x1end=1200 clip=$clip \
+ n1tic=4 x2beg=-1000 f2num=-1000 d2num=500 x2end=1000 > ${file}_$atime.eps
+ done
+
+ suwind itmin=$base itmax=$base key=fldr min=13 max=13 < ${file}_sp.su | sumax mode=abs outpar=nep
+ scl=`cat nep | awk '{print 1.0/$1}'`
+ echo scale for trace = $scl
+ suwind itmin=$base itmax=$base key=fldr min=13 max=13 < ${file}_sp.su | sugain scale=$scl | sustrip > trace.bin
+ suaddhead < trace.bin n1=1801 dt=$dx | supsgraph hbox=2 wbox=6 labelsize=10 \
+ f1=-2250 d1=$dx x1beg=-500 x1end=500 f1num=-500 d1num=500 style=normal > ${file}_z${depth}_t0.eps
+
+ suaddhead < trace.bin n1=1801 dt=$dx > ${file}_z${depth}_t0.su
+
+ (( imin = base - 50 ))
+ (( imax = base + 50 ))
+ echo $base $imin $imax
+ suwind key=fldr min=13 max=13 < ${file}_sp.su | \
+ suwind itmin=$imin itmax=$imax key=gx min=-125000 max=125000 | \
+ sustrip > ${file}_t0.bin
+
+ python3 readbin.py ${file}_t0.bin
+done
+
+
+(cat ${file_mod}_timerev_hom_hom${app}_z${depth}_t0.su; cat ${file_mod}_timerev_scat_scat${app}_z${depth}_t0.su;cat ${file_mod}_timerev_hom_scat${app}_z${depth}_t0.su ) | \
+ supsgraph hbox=2 wbox=6 labelsize=10 \
+ f1=-2250 d1=$dx x1beg=-500 x1end=500 f1num=-500 d1num=500 x2beg=-0.1 \
+ style=normal linecolor=red,blue,green > ${file_mod}_timerev_z${depth}_t0.eps
+
+
+rm nep trace.bin
+
+exit;
+
+xgraph < trace.bin n=451 pairs=2 d1=10 title=hom
+suwind itmin=75 itmax=75 key=fldr min=13 max=13 < snap_back_ctr_sp.su | sustrip > trace.bin
+xgraph < trace.bin n=451 pairs=2 d1=10 title=scatter
diff --git a/scripts/SolidEarth2018/ScatterModel/addNoiseShots.scr b/scripts/SolidEarth2018/ScatterModel/addNoiseShots.scr
new file mode 100755
index 0000000000000000000000000000000000000000..d88b2430e7bf9de0fc238a089a4634f7cb065f80
--- /dev/null
+++ b/scripts/SolidEarth2018/ScatterModel/addNoiseShots.scr
@@ -0,0 +1,36 @@
+#!/bin/bash
+
+itmax=16383
+suwind < shotsNoise/shots_0_rp.su key=tracl min=452 max=902 itmax=$itmax | \
+ suzero itmax=$itmax | \
+ suaddnoise f=0,5,80,100 amps=0,1,1,0 | \
+ sushw key=fldr a=1 c=1 j=1 > noiseTraces.su
+
+zsrc=0
+dxshot=10
+ishot=0
+nshots=451
+
+rm /tmp/all*.su
+
+while (( ishot < nshots ))
+do
+ (( xsrc = -2250 + ${ishot}*${dxshot} ))
+ (( ishot = $ishot + 1))
+
+ file_rcv=shotsNoise/shots_${xsrc}_rp.su
+ suwind < $file_rcv key=tracl min=452 max=902 > /tmp/sh.su
+ suwind < noiseTraces.su key=fldr min=$ishot max=$ishot > /tmp/tr.su
+ fconv file_in1=/tmp/sh.su file_in2=/tmp/tr.su ntfft=$itmax >> /tmp/allA.su
+
+ suwind < $file_rcv key=tracl min=903 max=1353 > /tmp/sh.su
+ suwind < noiseTraces.su key=fldr min=$ishot max=$ishot > /tmp/tr.su
+ fconv file_in1=/tmp/sh.su file_in2=/tmp/tr.su ntfft=$itmax >> /tmp/allB.su
+
+done
+
+susort gx fldr < /tmp/allA.su | sustack key=gx > NoiseSourcesA.su
+susort gx fldr < /tmp/allB.su | sustack key=gx > NoiseSourcesB.su
+
+rm /tmp/sh.su /tmp/tr.su /tmp/all*.su
+
diff --git a/scripts/SolidEarth2018/ScatterModel/corr.scr b/scripts/SolidEarth2018/ScatterModel/corr.scr
new file mode 100755
index 0000000000000000000000000000000000000000..dbb30f00c1fe5a13fbaccef164ad57abc9cbf989
--- /dev/null
+++ b/scripts/SolidEarth2018/ScatterModel/corr.scr
@@ -0,0 +1,69 @@
+#!/bin/bash
+
+suwind key=gx min=0 max=0 < NoiseSourcesA.su > traceA.su
+
+fconv mode=cor1 file_in1=NoiseSourcesB.su file_in2=traceA.su file_out=BwithTraceA.su
+
+#correlate with wavelet
+makewave fp=25 dt=0.004 file_out=wavedt4.su nt=4096 t0=0.0 scale=1
+cp BwithTraceA.su nep.su
+fconv mode=cor1 file_in1=nep.su file_in2=wavedt4.su file_out=BwithTraceA.su
+
+sumax < BwithTraceA.su mode=abs outpar=nep
+clip=`cat nep | awk '{print $1/3}'`
+
+supsimage hbox=2 wbox=4 labelsize=10 < BwithTraceA.su \
+ x1beg=0 x1end=1.0 clip=$clip f1=0 \
+ x2beg=-1000 f2num=-1000 d2num=500 x2end=1000 > SI_BwithTraceA.eps
+
+sudipfilt < BwithTraceA.su slopes=-0.0007,-0.0001,0,0.0001,0.0007 amps=0,1,1,1,0 | \
+ supsimage hbox=2 wbox=4 labelsize=10 \
+ x1beg=0 x1end=1.0 clip=$clip f1=0 \
+ x2beg=-1000 f2num=-1000 d2num=500 x2end=1000 > SI_BwithTraceA_dipfilt.eps
+
+sudipfilt < BwithTraceA.su slopes=-0.0007,-0.0001,0,0.0001,0.0007 amps=0,1,1,1,0 | \
+ suwind j=5 s=1 | \
+ supswigp hbox=2 wbox=4.0 labelsize=10 linewidth=0.0 \
+ x1beg=0 x1end=1.0 clip=$clip f1=0 n1tic=2 \
+ x2beg=-1000 f2num=-1000 d2=50 d2num=500 x2end=1000 > SI_BwithTraceA_dipfilt_wiggle.eps
+
+
+#optimal results obtained by placing recievers at level of TraceA (virtual shot position) in time-reversal computation
+#fdelmodc \
+ file_cp=hom_cp.su ischeme=1 iorder=4 \
+ file_den=scatter_ro.su \
+ file_src=ctr_rp.su \
+ file_rcv=SI_reference_timerev.su \
+ grid_dir=1 \
+ src_type=1 \
+ src_injectionrate=1 \
+ src_orient=1 \
+ rec_type_vz=1 \
+ rec_delay=4.0955 \
+ verbose=2 \
+ tmod=5.1 \
+ xrcv1=-2250 xrcv2=2250 zrcv1=1000 zrcv2=1000 \
+ npml=250 \
+ left=2 right=2 top=2 bottom=2
+
+sumax < SI_reference_timerev_rp.su mode=abs outpar=nep
+clip=`cat nep | awk '{print $1/5}'`
+
+supsimage hbox=2 wbox=4 labelsize=10 < SI_reference_timerev_rp.su \
+ x1beg=0 x1end=1.0 clip=$clip f1=0 \
+ x2beg=-1000 f2num=-1000 d2num=500 x2end=1000 > SI_reference_timerev_rp.eps
+
+sudipfilt < SI_reference_timerev_rp.su slopes=-0.0007,-0.0001,0,0.0001,0.0007 amps=0,1,1,1,0 | \
+ supsimage hbox=2 wbox=4 labelsize=10 \
+ x1beg=0 x1end=1.0 clip=$clip f1=0 \
+ x2beg=-1000 f2num=-1000 d2num=500 x2end=1000 > SI_reference_timerev_rp_dipfilt.eps
+
+#plot noisetraces
+
+for offset in -1000 -500 0 500 1000
+do
+suwind key=offset min=$offset max=$offset < noiseTraces.su | \
+ supswigp wbox=1 hbox=5 titlesize=-1 labelsize=-1 axescolor=white > noiseTraces_off${offset}.eps
+done
+
+
diff --git a/scripts/SolidEarth2018/ScatterModel/model.scr b/scripts/SolidEarth2018/ScatterModel/model.scr
new file mode 100755
index 0000000000000000000000000000000000000000..be8f960678b032600689c682a9b2cb1d6d082d89
--- /dev/null
+++ b/scripts/SolidEarth2018/ScatterModel/model.scr
@@ -0,0 +1,101 @@
+#!/bin/bash
+#
+#SBATCH -J model
+#SBATCH --cpus-per-task=8
+#SBATCH --ntasks=1
+#SBATCH --time=1:00:00
+
+export PATH=:$HOME/src/OpenSource/utils:$HOME/bin:$PATH:
+
+cd /vardim/home/thorbcke/data/Kees/Marchenko/SolidEarth/ScatterModel
+
+dx=2.5
+dt=0.0005
+
+#shots3=var=3000,5
+#shots=var=6000,5
+
+#high contrast model
+makemod sizex=5000 sizez=1200 dx=$dx dz=$dx cp0=1900 ro0=1200 \
+ orig=-2500,0 file_base=scatter.su \
+ intt=randdf x=-2500 z=200 cp=1900 ro=4700 var=4001,11 \
+ intt=def x=-2500,0,2500 z=700,700,700 cp=1900 ro=1200 \
+ verbose=4
+
+#low contrast model
+#makemod sizex=5000 sizez=1200 dx=$dx dz=$dx cp0=1900 ro0=1200 \
+# orig=-2500,0 file_base=scatter.su \
+# intt=randdf x=-2500 z=200 cp=1900 ro=2400 var=4001,11 \
+# intt=def x=-2500,0,2500 z=700,700,700 cp=1900 ro=1200 \
+# verbose=4
+
+makemod sizex=5000 sizez=1200 dx=$dx dz=$dx cp0=1900 ro0=1200 \
+ orig=-2500,0 file_base=hom verbose=2
+
+makewave w=fw fmin=0 flef=5 frig=80 fmax=100 dt=$dt file_out=wavefw.su nt=4096 t0=0.3 scale=0
+
+supsimage hbox=4 wbox=6 labelsize=10 < scatter_ro.su\
+ x1beg=0 x1end=1000.0 legend=0 threecolor=1 \
+ d1s=1.0 d2s=1.0 \
+ wrgb=1.0,.5,0 grgb=0,.7,1.0 brgb=0,1.0,0 \
+ bps=24 bclip=2400 wclip=1500 blockinterp=1 legend=1 \
+ n1tic=5 x2beg=-2500 f2num=-2000 d2num=1000 x2end=2500 > modelscatter_ro.eps
+
+exit;
+
+export OMP_NUM_THREADS=8
+
+makewave fp=20 dt=$dt file_out=wave.su nt=4096 t0=0.1 scale=1
+
+~/src/OpenSource/bin/fdelmodc \
+ file_cp=scatter_cp.su ischeme=1 iorder=4 \
+ file_den=scatter_ro.su \
+ file_src=wave.su \
+ file_rcv=shot_fd.su \
+ src_type=1 \
+ src_orient=1 \
+ src_injectionrate=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.0010 \
+ rec_delay=0.1 \
+ verbose=2 \
+ tmod=4.195 \
+ dxrcv=2.5 \
+ xrcv1=-2250 xrcv2=2250 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=0 zsrc=0 \
+ ntaper=200 \
+ left=2 right=2 top=2 bottom=2
+
+
+# tsnap1=3.1 tsnap2=2.5 dtsnap=0.1 \
+
+makemod sizex=5000 sizez=1000 dx=$dx dz=$dx cp0=1900 ro0=1200 \
+ orig=-2500,0 file_base=hom.su
+
+~/src/OpenSource/bin/fdelmodc \
+ file_cp=hom_cp.su ischeme=1 iorder=4 \
+ file_den=hom_ro.su \
+ file_src=wave.su \
+ file_rcv=shot_hom_fd.su \
+ src_type=1 \
+ src_orient=1 \
+ src_injectionrate=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.0010 \
+ rec_delay=0.1 \
+ verbose=2 \
+ tmod=4.195 \
+ dxrcv=10.0 \
+ xrcv1=-2250 xrcv2=2250 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=0 zsrc=0 \
+ ntaper=200 \
+ left=2 right=2 top=2 bottom=2
+
+sudiff shot_fd_rp.su shot_hom_fd_rp.su > shot_rp.su
+
diff --git a/scripts/SolidEarth2018/ScatterModel/shotsNoise.scr b/scripts/SolidEarth2018/ScatterModel/shotsNoise.scr
new file mode 100755
index 0000000000000000000000000000000000000000..580562ce878b222b4255f7c8516a0d943e736329
--- /dev/null
+++ b/scripts/SolidEarth2018/ScatterModel/shotsNoise.scr
@@ -0,0 +1,69 @@
+#!/bin/bash
+#
+
+export PATH=:$HOME/src/OpenSource/bin:$HOME/bin:$PATH:
+
+cd /vardim/home/thorbcke/data/Kees/Marchenko/SolidEarth/ScatterModel
+
+dt=0.0005
+makewave w=fw fmin=0 flef=5 frig=80 fmax=100 dt=$dt file_out=wavefw.su nt=4096 t0=0.3 scale=0
+
+mkdir -p shotsNoise
+mkdir -p jobs
+
+zsrc=0
+dxshot=10
+ishot=0
+nshots=451
+
+while (( ishot < nshots ))
+do
+
+ (( xsrc = -2250 + ${ishot}*${dxshot} ))
+
+ echo ishot=$ishot xsrc=$xsrc zsrc=$zsrc
+
+ cat << EOF > jobs/job_$ishot.job
+#!/bin/bash
+#
+#SBATCH -J scat_${xsrc}
+#SBATCH --cpus-per-task=8
+#SBATCH --ntasks=1
+#SBATCH --time=0:10:00
+
+cd \$SLURM_SUBMIT_DIR
+
+export PATH=:\$HOME/src/OpenSource/bin:\$HOME/bin:\$PATH:
+
+export OMP_NUM_THREADS=8
+file_rcv=shotsNoise/shots_${xsrc}.su
+
+fdelmodc \
+ file_cp=scatter_cp.su ischeme=1 iorder=4 \
+ file_den=scatter_ro.su \
+ file_src=wavefw.su \
+ file_rcv=\$file_rcv \
+ src_type=1 \
+ src_orient=1 \
+ src_injectionrate=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ rec_delay=0.3 \
+ dtrcv=0.004 \
+ verbose=2 \
+ tmod=4.394 \
+ dxrcv=10.0 \
+ xrcv1=-2250,-2250,-2250 xrcv2=2250,2250,2250 \
+ zrcv1=0,850,1000 zrcv2=0,850,1000 \
+ xsrc=$xsrc zsrc=0 \
+ ntaper=250 \
+ left=2 right=2 top=2 bottom=2
+EOF
+
+sbatch jobs/job_$ishot.job
+
+ (( ishot = $ishot + 1))
+
+done
+
diff --git a/scripts/SolidEarth2018/noFault/ClassicTimeReverse.scr b/scripts/SolidEarth2018/noFault/ClassicTimeReverse.scr
new file mode 100755
index 0000000000000000000000000000000000000000..d91f180c0bfccae217495c7fe6dead4332a70f40
--- /dev/null
+++ b/scripts/SolidEarth2018/noFault/ClassicTimeReverse.scr
@@ -0,0 +1,175 @@
+#!/bin/bash
+#
+#SBATCH -J ClassicTimeReverse
+#SBATCH --cpus-per-task=12
+#SBATCH --ntasks=1
+#SBATCH --time=2:00:00
+
+export PATH=:$HOME/src/OpenSource/bin:$HOME/bin:$PATH:
+which makewave
+which makemod
+which fdelmodc
+
+cd /vardim/home/thorbcke/data/Kees/Marchenko/SolidEarth/noFault
+
+#makewave fp=20 dt=$dt file_out=wave.su nt=4096 t0=0.1
+#makewave w=fw fmin=0 flef=5 frig=80 fmax=100 dt=$dt file_out=wavefw.su nt=4096 t0=0.3
+
+dx=1.0
+dt=0.0002
+depth=1450
+
+base=$(echo "scale=0; ${depth}/${dx}" | bc -l)
+
+makewave fp=25 dt=$dt file_out=wave.su nt=1024 t0=0.1 scale=1
+
+file_mod=nofault
+
+export OMP_NUM_THREADS=12
+
+#fdelmodc \
+ file_cp=${file_mod}_cp.su ischeme=1 iorder=4 \
+ file_den=${file_mod}_ro.su \
+ file_src=wave.su \
+ file_rcv=ctr.su \
+ src_type=1 \
+ src_injectionrate=1 \
+ src_orient=1 \
+ rec_type_vz=1 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=$dt \
+ rec_delay=0.1 \
+ verbose=2 \
+ tmod=4.1958 \
+ dxrcv=$dx \
+ xrcv1=-5000 xrcv2=5000 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=0 zsrc=$depth \
+ npml=250 \
+ left=2 right=2 top=2 bottom=2
+
+
+scale=-1
+filectr=ctr_dn.su
+sugain scale=$scale < ctr_rvz.su > $filectr
+
+#fdelmodc \
+ file_cp=${file_mod}_cp.su ischeme=1 iorder=4 \
+ file_den=${file_mod}_ro.su \
+ file_src=$filectr \
+ grid_dir=1 \
+ src_type=1 \
+ src_injectionrate=1 \
+ src_orient=1 \
+ rec_delay=0.0 \
+ verbose=2 \
+ tmod=4.51 \
+ file_snap=${file_mod}_timerev.su \
+ tsnap1=3.4956 dtsnap=0.05 tsnap2=4.5005 sna_type_vz=0 \
+ dxsnap=$dx dzsnap=$dx zsnap1=0 zsnap2=2750 xsnap1=-1650 xsnap2=1650 \
+ npml=250 \
+ left=2 right=2 top=2 bottom=2
+
+# curve=curve1,curve2,curve3 npair=25,25,25 curvecolor=black,black,black curvedash=3,3,3 \
+
+filectr=ctr_rp.su
+skip=250
+sumax < $filectr mode=abs outpar=nep
+clip=`cat nep | awk '{print $1/2}'`
+echo $clip
+suwind j=$skip s=1 < $filectr | \
+ supswigp hbox=4 wbox=6.6 d2=$skip labelsize=10 \
+ x1end=2.5 clip=$clip > ${file_mod}_P_wiggle.eps
+
+suwind j=$skip s=1 < $filectr tmax=2.5 | \
+ supswigp hbox=4 wbox=6.6 d2=$skip labelsize=10 \
+ f1=2.5 x1beg=2.5 x1end=0 d1=-0.0002 clip=$clip > ${file_mod}_P_wiggle_flip.eps
+
+filectr=ctr_dn.su
+sumax < $filectr mode=abs outpar=nep
+clip=`cat nep | awk '{print $1/2}'`
+echo $clip
+suwind j=$skip s=1 < $filectr | \
+ supswigp hbox=4 wbox=6.6 d2=$skip labelsize=10 \
+ x1end=2.5 clip=$clip > ${file_mod}_Vn_wiggle.eps
+
+suwind j=$skip s=1 < $filectr tmax=2.5 | \
+ supswigp hbox=4 wbox=6.6 d2=$skip labelsize=10 \
+ f1=2.5 x1beg=2.5 x1end=0 d1=-0.0002 clip=$clip > ${file_mod}_Vn_wiggle_flip.eps
+
+
+for file in ${file_mod}_timerev
+do
+ sumax < ${file}_sp.su mode=abs outpar=nep
+ clip=`cat nep | awk '{print $1/10}'`
+ echo $clip
+
+ for fldr in 10 13 16
+ do
+ times=$(echo "scale=2; -0.05*(13-${fldr})" | bc -l)
+ atime=`printf "%4.2f" $times`
+ suwind key=fldr min=$fldr max=$fldr < ${file}_sp.su | \
+ supsimage hbox=4.9 wbox=6.6 labelsize=10 \
+ x1beg=300 x1end=2750 clip=$clip \
+ x2beg=-1650 f2num=-1500 d2num=500 x2end=1650 > ${file}_$atime.eps
+ done
+
+ suwind itmin=$base itmax=$base key=fldr min=13 max=13 < ${file}_sp.su | sumax mode=abs outpar=nep
+ scl=`cat nep | awk '{print 1.0/$1}'`
+ echo scale for trace = $scl
+
+ suwind itmin=$base itmax=$base key=fldr min=13 max=13 < ${file}_sp.su | sugain scale=$scl | sustrip > trace.bin
+ suaddhead < trace.bin n1=3001 dt=$dx | supsgraph hbox=2 wbox=6 labelsize=10 \
+ f1=-1650 d1=$dx x1beg=-500 x1end=500 f1num=-500 d1num=500 style=normal > ${file}_z${depth}_t0.eps
+
+ (( imin = base - 125 ))
+ (( imax = base + 125 ))
+ echo $base $imin $imax
+ suwind key=fldr min=13 max=13 < ${file}_sp.su | \
+ suwind itmin=$imin itmax=$imax key=gx min=-125000 max=125000 | \
+ sustrip > ${file}_t0.bin
+
+ python3 readbin.py ${file}_t0.bin
+
+done
+
+# model slightly above depth to get Gd(x,xB,t)
+
+(( depth = depth - 400 ))
+echo $depth
+#fdelmodc \
+ file_cp=${file_mod}_cp.su ischeme=1 iorder=4 \
+ file_den=${file_mod}_ro.su \
+ file_src=wave.su \
+ file_rcv=T${depth}.su \
+ src_type=1 \
+ src_injectionrate=1 \
+ src_orient=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.004 \
+ rec_delay=0.1 \
+ verbose=2 \
+ tmod=4.1920 \
+ dxrcv=10 \
+ xrcv1=-5000 xrcv2=5000 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=0 zsrc=$depth \
+ npml=250 \
+ left=2 right=2 top=2 bottom=2
+
+fmute file_shot=T${depth}_rp.su file_out=Gd${depth}.su above=-1 shift=-10 verbose=1 check=1 hw=4
+
+sumax < T${depth}_rp.su mode=abs outpar=nep
+clip=`cat nep | awk '{print $1/2}'`
+skip=25
+suwind j=$skip s=1 < Gd${depth}.su tmax=2.5 | \
+ supswigp hbox=4 wbox=6.6 d2=250 labelsize=10 \
+ f1=2.5 x1beg=2.5 x1end=0 d1=-0.0002 clip=$clip > ${file_mod}_Gd${depth}_flip.eps
+
+suwind j=$skip s=1 < Gd${depth}.su | \
+ supswigp hbox=4 wbox=6.6 d2=250 labelsize=10 \
+ x1beg=0 x1end=2.5 d1=0.0002 clip=$clip > ${file_mod}_Gd${depth}.eps
+
diff --git a/scripts/SolidEarth2018/noFault/addNoiseShots.scr b/scripts/SolidEarth2018/noFault/addNoiseShots.scr
new file mode 100755
index 0000000000000000000000000000000000000000..91c897519709a3561b35f82fa92e98fb3eaf36fc
--- /dev/null
+++ b/scripts/SolidEarth2018/noFault/addNoiseShots.scr
@@ -0,0 +1,32 @@
+#!/bin/bash
+
+itmax=64530
+suwind < shotsNoise/shots_0_rp.su key=tracl min=1 max=901 itmax=$itmax | \
+ suzero itmax=$itmax | \
+ suaddnoise f=0,5,80,100 amps=0,1,1,0 | \
+ sushw key=fldr a=1 c=1 j=1 > noiseTraces.su
+
+zsrc=0
+dxshot=10
+ishot=0
+nshots=901
+
+rm /tmp/all*.su
+
+while (( ishot < nshots ))
+do
+ (( xsrc = -4500 + ${ishot}*${dxshot} ))
+ (( ishot = $ishot + 1))
+
+ file_rcv=shotsNoise/shots_${xsrc}_rp.su
+ echo $file_rcv
+ suwind < $file_rcv key=tracl min=1 max=901 > /tmp/sh.su
+ suwind < noiseTraces.su key=fldr min=$ishot max=$ishot > /tmp/tr.su
+ fconv file_in1=/tmp/sh.su file_in2=/tmp/tr.su ntfft=$itmax >> /tmp/allA.su
+
+done
+
+susort gx fldr < /tmp/allA.su | sustack key=gx > NoiseSources.su
+
+rm /tmp/sh.su /tmp/tr.su /tmp/all*.su
+
diff --git a/scripts/SolidEarth2018/noFault/backpropf1plus.scr b/scripts/SolidEarth2018/noFault/backpropf1plus.scr
new file mode 100755
index 0000000000000000000000000000000000000000..a59593cde7c4cf38ca2ec52fa76cf2870f517af9
--- /dev/null
+++ b/scripts/SolidEarth2018/noFault/backpropf1plus.scr
@@ -0,0 +1,111 @@
+#!/bin/bash
+#SBATCH -J nofault_${xsrc}
+#SBATCH --cpus-per-task=12
+#SBATCH --ntasks=1
+#SBATCH --time=0:55:00
+#SBATCH --hint=nomultithread
+
+export PATH=:$HOME/src/OpenSource/bin:$PATH:
+which makewave
+which makemod
+
+cd /vardim/home/thorbcke/data/Kees/Marchenko/SolidEarth/noFault
+
+#makewave fp=20 dt=$dt file_out=wave.su nt=4096 t0=0.1
+#makewave w=fw fmin=0 flef=5 frig=80 fmax=100 dt=$dt file_out=wavefw.su nt=4096 t0=0.3
+
+dx=1.0
+dt=0.0002
+#dt=0.000125
+depth=1450
+
+#model in truncated medium: homogeneous below focal point
+makemod sizex=10000 sizez=2000 dx=$dx dz=$dx cp0=1500 ro0=1000 \
+ orig=-5000,0 file_base=nofaultTL.su verbose=2 \
+ intt=def x=-5000,-2000,-1000,0,1000,2000,5000 z=220,170,190,210,200,240,220 poly=2 cp=1950 ro=1800 grad=0 \
+ intt=def x=-5000,-2200,-1500,0,1300,2100,5000 z=520,540,590,600,540,600,630 poly=2 cp=2000 ro=1000 grad=0 \
+ intt=def x=-5000,-1800,0,2200,5000 z=1020,1000,900,1000,1010 poly=2 cp=2300 ro=1600 grad=0 \
+ intt=def x=-5000,-1900,-1300,-800,-200,300,500,1000,1800,5000 z=1500,1450,1400,1350,1340,1350,1370,1390,1400,1450 poly=2 cp=2400 ro=2700 grad=0
+
+#make model a bit smaller
+suwind key=gx min=-2500000 max=2500000 < nofaultTL_cp.su | sushw key=f2 a=-2500 > nofaultT_cp.su
+suwind key=gx min=-2500000 max=2500000 < nofaultTL_ro.su | sushw key=f2 a=-2500 > nofaultT_ro.su
+suwind key=gx min=-2500000 max=2500000 < f1plus.su | sushw key=f2 a=-2500 > f1plusS.su
+
+file_mod=nofaultT
+
+export OMP_NUM_THREADS=12
+
+#fdelmodc \
+ file_cp=${file_mod}_cp.su ischeme=1 iorder=4 \
+ file_den=${file_mod}_ro.su \
+ file_src=f1plusS.su \
+ dt=$dt \
+ file_rcv=backprop_f1plusz${depth}.su \
+ grid_dir=0 \
+ src_type=1 \
+ src_injectionrate=1 \
+ src_orient=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.002 \
+ rec_delay=0.0 \
+ verbose=2 \
+ tmod=8.004 \
+ dxrcv=10.0 \
+ tsnap1=3.0 tsnap2=4.0 dtsnap=0.05 sna_type_vz=0 \
+ xrcv1=-2250 xrcv2=2250 \
+ zrcv1=$depth zrcv2=$depth \
+ xsrc=0 zsrc=0 \
+ ntaper=250 \
+ left=2 right=2 top=2 bottom=2
+
+
+file_mod=nofault
+
+suwind < backprop_f1plusz${depth}_rp.su itmax=4095 > nep.su
+basop choice=8 file_in=nep.su file_out=backprop_f1plusz${depth}_kz.su c=2400 verbose=1 fmax=120
+
+sumax < backprop_f1plusz${depth}_kz.su mode=abs outpar=nep
+clip=`cat nep | awk '{print $1/5}'`
+echo $clip
+skip=12
+(( d2 = skip*10 ))
+
+suwind s=1 j=$skip < backprop_f1plusz${depth}_kz.su | \
+ supswigp hbox=4 wbox=6.6 labelsize=10 linewidth=0.0 \
+ n1tic=2 d2=$d2 f1=-4.004 x1beg=-1.5 x1end=1.5 \
+ f2=-2250 f2num=-2000 d2num=1000 clip=$clip > ${file_mod}_f1plusz${depth}_kz.eps
+
+sumax < backprop_f1plusz${depth}_rp.su mode=abs outpar=nep
+clip=`cat nep | awk '{print $1/5}'`
+echo $clip
+suwind s=1 j=$skip < backprop_f1plusz${depth}_rp.su | \
+ supswigp hbox=4 wbox=6.6 labelsize=10 linewidth=0.0 \
+ n1tic=2 d2=$d2 f1=-4.004 x1beg=-1.5 x1end=1.5 \
+ f2=-2250 f2num=-2000 d2num=1000 clip=$clip > ${file_mod}_f1plusz${depth}_rp.eps
+
+#use same clip as in f2
+sumax < f2.su mode=abs outpar=nep
+clip=`cat nep | awk '{print $1/5}'`
+#sumax < f1plus.su mode=abs outpar=nep
+#clip=`cat nep | awk '{print $1/10}'`
+echo $clip
+skip=12
+(( d2 = skip*10 ))
+suwind s=1 j=$skip < f1plus.su | \
+ suwind key=gx min=-4500000 max=4500000 | \
+ supswigp hbox=4 wbox=6.6 labelsize=10 linewidth=0.0 \
+ n1tic=2 d2=$d2 f1=-4.004 x1beg=-2.2 x1end=2.2 \
+ f2=-2500 f2num=-2000 d2num=1000 clip=$clip > ${file_mod}_f1plus.eps
+
+#sumax < f1min.su mode=abs outpar=nep
+#clip=`cat nep | awk '{print $1/6}'`
+echo $clip
+suwind s=1 j=$skip < f1min.su | \
+ suwind key=gx min=-4500000 max=4500000 | \
+ supswigp hbox=4 wbox=6.6 labelsize=10 linewidth=0.0 \
+ n1tic=2 d2=$d2 f1=-4.004 x1beg=-2.2 x1end=2.2 \
+ f2=-2500 f2num=-2000 d2num=1000 clip=$clip > ${file_mod}_f1min.eps
+
diff --git a/scripts/SolidEarth2018/noFault/backpropf2.scr b/scripts/SolidEarth2018/noFault/backpropf2.scr
new file mode 100755
index 0000000000000000000000000000000000000000..d5dc987a68b644db1747aed444b5f2e4e9dac550
--- /dev/null
+++ b/scripts/SolidEarth2018/noFault/backpropf2.scr
@@ -0,0 +1,132 @@
+#!/bin/bash
+#SBATCH -J nofault_${xsrc}
+#SBATCH --cpus-per-task=12
+#SBATCH --ntasks=1
+#SBATCH --time=0:55:00
+#SBATCH --hint=nomultithread
+
+export PATH=$HOME/OpenSource/bin/:$PATH:
+
+dx=1.0
+dt=0.0002
+#dt=0.000125
+
+file_cp=nofaultS_cp.su
+file_ro=nofaultS_ro.su
+depth=1450
+
+export OMP_NUM_THREADS=12
+
+# t=0 focal time is at 2.0445 seconds back=propagating (dtrcv*(ns/2-1)+dt)
+# shift f2.su such that t=0 is positioned in the middle of the time axis
+# the extra shift of 0.000250 is needed because of the staggered time implementation of the Finite Difference program.
+ns=`surange <f2.su | grep ns | awk '{print $2}'`
+dtrcv=`surange < f2.su | grep dt | awk '{print $2/1000000.0}'`
+shift=$(echo "scale=6; ($dtrcv*(($ns)/2.0-1)+$dt)" | bc -l)
+echo $shift
+suwind key=gx min=-2250000 max=2250000 < f2.su > nep.su
+basop choice=shift shift=$shift file_in=nep.su verbose=1 > pplus.su
+
+# the f2.su is sampled with 4ms the FD program needs 0.5ms
+# time axis is interpolated by making use of FFT's: sinc interpolation
+#ftr1d file_in=pplus.su file_out=freq.su
+#sushw <freq.su key=nhs,dt a=8192,500 >fr.su
+#ftr1d file_in=fr.su n1=8194 file_out=pplusdt.su verbose=1
+
+midsnap=4.004
+
+#backpropagate f2.su and collect snapshots
+#fdelmodc \
+ file_cp=$file_cp ischeme=1 iorder=4 \
+ file_den=$file_ro \
+ file_src=pplus.su \
+ dt=$dt \
+ grid_dir=0 \
+ src_type=1 \
+ src_injectionrate=1 \
+ src_orient=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.004 \
+ rec_delay=0.0 \
+ verbose=2 \
+ tmod=4.10 \
+ dxrcv=10.0 \
+ npml=250 \
+ sna_type_vz=0 \
+ dxsnap=$dx dzsnap=$dx zsnap1=0 zsnap2=2750 xsnap1=-1650 xsnap2=1650 \
+ file_snap=backpropf2.su tsnap1=3.992 dtsnap=0.0002 tsnap2=4.040 \
+ sna_type_vz=0 \
+ sna_type_p=1 \
+ left=2 right=2 top=2 bottom=2
+
+file_mod=nofault
+
+sumax < f2.su mode=abs outpar=nep
+clip=`cat nep | awk '{print $1/5}'`
+echo $clip
+skip=12
+(( d2 = skip*10 ))
+
+suwind s=1 j=$skip < f2.su > nep.su
+ns=`surange <f2.su | grep ns | awk '{print $2}'`
+dtrcv=`surange < f2.su | grep dt | awk '{print $2/1000000.0}'`
+shift=$(echo "scale=6; ($dtrcv*(($ns)/2.0-1))" | bc -l)
+echo $shift
+basop choice=shift shift=$shift file_in=nep.su verbose=1 > nep2.su
+
+supswigp hbox=4 wbox=6.6 labelsize=10 linewidth=0.0 < nep2.su \
+ n1tic=2 d2=$d2 f1=-4.004 x1beg=-1.5 x1end=1.5 \
+ f2=-2500 f2num=-2000 d2num=1000 clip=$clip > ${file_mod}_f2_d${depth}.eps
+
+sumax < Td_rp.su mode=abs outpar=nep
+clip=`cat nep | awk '{print $1/3}'`
+echo $clip
+skip=12
+(( d2 = skip*10 ))
+ns=1024
+dtrcv=0.004
+suwind j=$skip s=1 < Td_rp.su | \
+suwind itmax=2048 | suwind key=gx min=-2500000 max=2500000 > nep.su
+shift=$(echo "scale=6; ($dtrcv*(($ns)/2.0-1))" | bc -l)
+echo $shift
+basop choice=shift shift=$shift file_in=nep.su verbose=1 > nep2.su
+
+supswigp hbox=4 wbox=6.6 labelsize=10 linewidth=0.0 < nep2.su\
+ n1tic=2 d2=$d2 f1=-$shift x1beg=-1.5 x1end=1.5 \
+ f2=-2500 f2num=-2000 d2num=1000 clip=$clip > ${file_mod}_P_cent0.eps
+
+#select snapshots at t=0
+suwind key=fldr min=30 max=30 < backpropf2_sp.su > snapt0.su
+
+sumax < snapt0.su mode=abs outpar=nep
+clip=`cat nep | awk '{print $1/4}'`
+echo $clip
+
+supsimage hbox=4.9 wbox=6.6 labelsize=10 < snapt0.su \
+ x1beg=300 x1end=2750 clip=$clip \
+ x2beg=-1650 f2num=-1500 d2num=500 x2end=1650 > ${file_mod}_f2snapt0.eps
+
+
+
+#f2 at 1050
+depth=1050
+sumax < f2$depth.su mode=abs outpar=nep
+
+clip=`cat nep | awk '{print $1/5}'`
+echo $clip
+skip=12
+(( d2 = skip*10 ))
+
+suwind s=1 j=$skip < f2$depth.su > nep.su
+ns=`surange <f2.su | grep ns | awk '{print $2}'`
+dtrcv=`surange < f2.su | grep dt | awk '{print $2/1000000.0}'`
+shift=$(echo "scale=6; ($dtrcv*(($ns)/2.0-1))" | bc -l)
+echo $shift
+basop choice=shift shift=$shift file_in=nep.su verbose=1 > nep2.su
+
+supswigp hbox=4 wbox=6.6 labelsize=10 linewidth=0.0 < nep2.su \
+ n1tic=2 d2=$d2 f1=-4.004 x1beg=-1.5 x1end=1.5 \
+ f2=-2500 f2num=-2000 d2num=1000 clip=$clip > ${file_mod}_f2_d${depth}.eps
+
diff --git a/scripts/SolidEarth2018/noFault/corr.scr b/scripts/SolidEarth2018/noFault/corr.scr
new file mode 100755
index 0000000000000000000000000000000000000000..3b344772cce646b35767cef8162e1c3d188613a6
--- /dev/null
+++ b/scripts/SolidEarth2018/noFault/corr.scr
@@ -0,0 +1,82 @@
+#!/bin/bash
+
+suwind key=gx min=0 max=0 < NoiseSources.su > traceA.su
+
+fconv mode=cor1 file_in1=NoiseSources.su file_in2=traceA.su file_out=BwithTraceA.su
+
+sumax < NoiseSources.su mode=abs outpar=nep
+clip=`cat nep | awk '{print $1/1}'`
+
+suwind j=5 s=1 < NoiseSources.su | \
+ supswigp hbox=2 wbox=4.0 labelsize=10 linewidth=0.0 \
+ x1beg=0 x1end=5.0 clip=$clip f1=0 n1tic=2 \
+ x2beg=-1000 f2num=-1000 d2=50 d2num=500 x2end=1000 > nofault_SI_noiseSources.eps
+
+#convolve with wavelet
+dt=0.004
+makewave fp=25 dt=$dt file_out=wavedt.su nt=1024 t0=0.0 scale=1
+suwind < BwithTraceA.su itmax=1023 > nep1.su
+fconv mode=cor1 file_in1=nep1.su file_in2=wavedt.su file_out=nep.su
+mv nep.su BwithTraceA.su
+rm nep1.su
+
+sumax < BwithTraceA.su mode=abs outpar=nep
+clip=`cat nep | awk '{print $1/5}'`
+
+supsimage hbox=2 wbox=4 labelsize=10 < BwithTraceA.su \
+ x1beg=0 x1end=1.0 clip=$clip f1=0 \
+ x2beg=-1000 f2num=-1000 d2num=500 x2end=1000 > nofault_SI_BwithTraceA.eps
+
+sudipfilt < BwithTraceA.su slopes=-0.0007,-0.0001,0,0.0001,0.0007 amps=0,1,1,1,0 | \
+ supsimage hbox=2 wbox=4 labelsize=10 \
+ x1beg=0 x1end=1.0 clip=$clip f1=0 \
+ x2beg=-1000 f2num=-1000 d2num=500 x2end=1000 > nofault_SI_BwithTraceA_dipfilt.eps
+
+sudipfilt < BwithTraceA.su slopes=-0.0007,-0.0001,0,0.0001,0.0007 amps=0,1,1,1,0 | \
+ suwind j=5 s=1 | \
+ supswigp hbox=2 wbox=4.0 labelsize=10 linewidth=0.0 \
+ x1beg=0 x1end=1.0 clip=$clip f1=0 n1tic=2 \
+ x2beg=-1000 f2num=-1000 d2=50 d2num=500 x2end=1000 > nofault_SI_BwithTraceA_dipfilt_wiggle.eps
+
+suwind j=5 s=1 < BwithTraceA.su | \
+ supswigp hbox=2 wbox=4.0 labelsize=10 linewidth=0.0 \
+ x1beg=0 x1end=1.0 clip=$clip f1=0 n1tic=2 \
+ x2beg=-1000 f2num=-1000 d2=50 d2num=500 x2end=1000 > nofault_SI_BwithTraceA_dipfilt_wiggle.eps
+
+export OMP_NUM_THREADS=8
+file_rcv=shots_SIref.su
+
+#fdelmodc \
+ file_cp=nofaultS_cp.su ischeme=1 iorder=4 \
+ file_den=nofaultS_ro.su \
+ file_src=wave.su \
+ file_rcv=$file_rcv \
+ src_type=1 \
+ src_orient=1 \
+ src_injectionrate=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ rec_delay=0.1 \
+ dtrcv=0.004 \
+ verbose=2 \
+ tmod=1.320 \
+ dxrcv=10.0 \
+ xrcv1=-2500 xrcv2=2500 \
+ zrcv1=100 zrcv2=100 \
+ xsrc=0 zsrc=100 \
+ ntaper=250 \
+ left=2 right=2 top=1 bottom=2
+
+sumax < shots_SIref_rp.su mode=abs outpar=nep
+clip=`cat nep | awk '{print $1/5}'`
+
+suwind j=5 s=1 < shots_SIref_rp.su | \
+ supswigp hbox=2 wbox=4.0 labelsize=10 linewidth=0.0 \
+ x1beg=0 x1end=1.0 clip=$clip f1=0 n1tic=2 \
+ x2beg=-1000 f2num=-1000 d2=50 d2num=500 x2end=1000 > nofault_SI_reference_wiggle.eps
+
+supsimage hbox=2 wbox=4 labelsize=10 < shots_SIref_rp.su \
+ x1beg=0 x1end=1.0 clip=$clip f1=0 \
+ x2beg=-1000 f2num=-1000 d2num=500 x2end=1000 > nofault_SI_reference.eps
+
diff --git a/scripts/SolidEarth2018/noFault/marchenko.scr b/scripts/SolidEarth2018/noFault/marchenko.scr
new file mode 100755
index 0000000000000000000000000000000000000000..333dd10b2dbcd2134288cedcf64fed54b3ca1ce8
--- /dev/null
+++ b/scripts/SolidEarth2018/noFault/marchenko.scr
@@ -0,0 +1,63 @@
+#!/bin/bash
+#SBATCH -J nofault_${xsrc}
+#SBATCH --cpus-per-task=12
+#SBATCH --ntasks=1
+#SBATCH --time=0:55:00
+
+export PATH=$HOME/src/OpenSource/bin:$PATH:
+
+export OMP_NUM_THREADS=1
+
+cd /vardim/home/thorbcke/data/Kees/Marchenko/SolidEarth/noFault
+
+#compute Td
+dx=1.0
+dt=0.0002
+depth=1450
+
+makewave fp=25 dt=$dt file_out=wave.su nt=1024 t0=0.1 scale=1
+
+file_mod=nofault
+
+export OMP_NUM_THREADS=12
+
+#fdelmodc \
+ file_cp=${file_mod}_cp.su ischeme=1 iorder=4 \
+ file_den=${file_mod}_ro.su \
+ file_src=wave.su \
+ file_rcv=Td.su \
+ src_type=1 \
+ src_injectionrate=1 \
+ src_orient=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ dtrcv=0.004 \
+ rec_delay=0.1 \
+ verbose=2 \
+ tmod=4.1920 \
+ dxrcv=10 \
+ xrcv1=-5000 xrcv2=5000 \
+ zrcv1=0 zrcv2=0 \
+ xsrc=0 zsrc=$depth \
+ npml=250 \
+ left=2 right=2 top=2 bottom=2
+
+fmute file_shot=Td_rp.su file_out=p0plus.su above=-1 shift=-10 verbose=1 check=1 hw=4
+
+#apply the Marchenko algorithm
+marchenko file_shot=shotsRefl/refl_rp.su file_tinv=p0plus.su nshots=901 verbose=2 \
+ tap=0 niter=15 hw=8 shift=10 smooth=3 pad=0 \
+ file_green=pgreen.su file_gplus=Gplus.su file_gmin=Gmin.su \
+ file_f1plus=f1plus.su file_f1min=f1min.su file_f2=f2.su
+
+#apply the Marchenko algorithm for depth -= 400 => 1050
+(( depth = depth - 400 ))
+set -x
+marchenko file_shot=shotsRefl/refl_rp.su file_tinv=Gd${depth}.su nshots=901 verbose=2 \
+ tap=0 niter=15 hw=4 shift=10 smooth=3 pad=46 \
+ file_green=pgreen${depth}.su \
+ file_f1plus=f1plus${depth}.su file_f1min=f1min${depth}.su file_f2=f2${depth}.su
+
+
+
diff --git a/scripts/SolidEarth2018/noFault/model_nofault.scr b/scripts/SolidEarth2018/noFault/model_nofault.scr
new file mode 100755
index 0000000000000000000000000000000000000000..00d530dc61e7d308393d1f6a80756ae81c809bb4
--- /dev/null
+++ b/scripts/SolidEarth2018/noFault/model_nofault.scr
@@ -0,0 +1,29 @@
+#!/bin/bash
+
+dx=1
+
+makemod sizex=10000 sizez=3000 dx=$dx dz=$dx cp0=1500 ro0=1000 supersmooth=1 \
+ orig=-5000,0 file_base=nofault.su verbose=2 \
+ intt=def x=-5000,-2000,-1000,0,1000,2000,5000 z=220,170,190,210,200,240,220 poly=2 cp=1950 ro=1800 grad=0 \
+ intt=def x=-5000,-2200,-1500,0,1300,2100,5000 z=520,540,590,600,540,600,630 poly=2 cp=2000 ro=1000 grad=0 \
+ intt=def x=-5000,-1800,0,2200,5000 z=1020,1000,900,1000,1010 poly=2 cp=2300 ro=1600 grad=0 \
+ intt=def x=-5000,-1900,-1300,-800,-200,300,500,1000,1800,5000 z=1500,1450,1400,1350,1340,1350,1370,1390,1400,1450 poly=2 cp=2400 ro=2700 grad=0 \
+ intt=def x=-5000,-2350,-1750,-1250,-650,-150,150,650,1450,5000 z=1850,1800,1750,1700,1690,1700,1720,1740,1750,1800 poly=2 cp=2600 ro=4400 grad=0 \
+ intt=def x=-5000,-2450,-1850,-1350,-750,-250,50,550,1350,5000 z=1950,1900,1850,1800,1790,1800,1820,1840,1850,1900 poly=2 cp=2700 ro=2200 grad=0 \
+ intt=def x=-5000,-2000,-500,0,500,1000,2000,5000 z=2650,2400,2520,2420,2540,2530,2720,2550 poly=2 cp=2800 ro=3000 grad=0 \
+
+
+supsimage hbox=4 wbox=6 labelsize=10 < nofault_ro.su \
+ x1beg=0 x1end=2750.0 legend=0 threecolor=1 \
+ d1s=1.0 d2s=1.0 \
+ wrgb=1.0,.5,0 grgb=0,.7,1.0 brgb=0,1.0,0 \
+ bps=24 legend=1 \
+ n1tic=5 x2beg=-5000 f2num=-5000 d2num=1000 x2end=5000 > nofault_ro.eps
+
+supsimage hbox=4 wbox=6 labelsize=10 < nofault_cp.su \
+ x1beg=0 x1end=2750.0 legend=0 threecolor=1 \
+ d1s=1.0 d2s=1.0 \
+ wrgb=1.0,.5,0 grgb=0,.7,1.0 brgb=0,1.0,0 \
+ bps=24 legend=1 \
+ n1tic=5 x2beg=-5000 f2num=-5000 d2num=1000 x2end=5000 > nofault_cp.eps
+
diff --git a/scripts/SolidEarth2018/noFault/model_nofault2.scr b/scripts/SolidEarth2018/noFault/model_nofault2.scr
new file mode 100755
index 0000000000000000000000000000000000000000..00d530dc61e7d308393d1f6a80756ae81c809bb4
--- /dev/null
+++ b/scripts/SolidEarth2018/noFault/model_nofault2.scr
@@ -0,0 +1,29 @@
+#!/bin/bash
+
+dx=1
+
+makemod sizex=10000 sizez=3000 dx=$dx dz=$dx cp0=1500 ro0=1000 supersmooth=1 \
+ orig=-5000,0 file_base=nofault.su verbose=2 \
+ intt=def x=-5000,-2000,-1000,0,1000,2000,5000 z=220,170,190,210,200,240,220 poly=2 cp=1950 ro=1800 grad=0 \
+ intt=def x=-5000,-2200,-1500,0,1300,2100,5000 z=520,540,590,600,540,600,630 poly=2 cp=2000 ro=1000 grad=0 \
+ intt=def x=-5000,-1800,0,2200,5000 z=1020,1000,900,1000,1010 poly=2 cp=2300 ro=1600 grad=0 \
+ intt=def x=-5000,-1900,-1300,-800,-200,300,500,1000,1800,5000 z=1500,1450,1400,1350,1340,1350,1370,1390,1400,1450 poly=2 cp=2400 ro=2700 grad=0 \
+ intt=def x=-5000,-2350,-1750,-1250,-650,-150,150,650,1450,5000 z=1850,1800,1750,1700,1690,1700,1720,1740,1750,1800 poly=2 cp=2600 ro=4400 grad=0 \
+ intt=def x=-5000,-2450,-1850,-1350,-750,-250,50,550,1350,5000 z=1950,1900,1850,1800,1790,1800,1820,1840,1850,1900 poly=2 cp=2700 ro=2200 grad=0 \
+ intt=def x=-5000,-2000,-500,0,500,1000,2000,5000 z=2650,2400,2520,2420,2540,2530,2720,2550 poly=2 cp=2800 ro=3000 grad=0 \
+
+
+supsimage hbox=4 wbox=6 labelsize=10 < nofault_ro.su \
+ x1beg=0 x1end=2750.0 legend=0 threecolor=1 \
+ d1s=1.0 d2s=1.0 \
+ wrgb=1.0,.5,0 grgb=0,.7,1.0 brgb=0,1.0,0 \
+ bps=24 legend=1 \
+ n1tic=5 x2beg=-5000 f2num=-5000 d2num=1000 x2end=5000 > nofault_ro.eps
+
+supsimage hbox=4 wbox=6 labelsize=10 < nofault_cp.su \
+ x1beg=0 x1end=2750.0 legend=0 threecolor=1 \
+ d1s=1.0 d2s=1.0 \
+ wrgb=1.0,.5,0 grgb=0,.7,1.0 brgb=0,1.0,0 \
+ bps=24 legend=1 \
+ n1tic=5 x2beg=-5000 f2num=-5000 d2num=1000 x2end=5000 > nofault_cp.eps
+
diff --git a/scripts/SolidEarth2018/noFault/shotsQueue.scr b/scripts/SolidEarth2018/noFault/shotsQueue.scr
new file mode 100755
index 0000000000000000000000000000000000000000..38cc7273bc484b129a66a89db64877a953671442
--- /dev/null
+++ b/scripts/SolidEarth2018/noFault/shotsQueue.scr
@@ -0,0 +1,73 @@
+#!/bin/bash
+#
+
+export PATH=:$HOME/src/OpenSource/bin:$HOME/bin:$PATH:
+
+cd /vardim/home/thorbcke/data/Kees/Marchenko/SolidEarth/noFault
+#make model a bit smaller
+suwind key=gx min=-2500000 max=2500000 < nofault_cp.su | sushw key=f2 a=-2500 > nofaultS_cp.su
+suwind key=gx min=-2500000 max=2500000 < nofault_ro.su | sushw key=f2 a=-2500 > nofaultS_ro.su
+
+dt=0.0002
+makewave w=fw fmin=0 flef=5 frig=80 fmax=100 dt=$dt file_out=wavefw.su nt=4096 t0=0.3 scale=0
+
+mkdir -p shotsNoise
+mkdir -p jobs
+
+zsrc=2100
+dxshot=10
+ishot=0
+nshots=901
+
+while (( ishot < nshots ))
+do
+
+ (( xsrc = -4500 + ${ishot}*${dxshot} ))
+
+ echo ishot=$ishot xsrc=$xsrc zsrc=$zsrc
+
+ cat << EOF > jobs/job_$ishot.job
+#!/bin/bash
+#
+#SBATCH -J nofault_${xsrc}
+#SBATCH --cpus-per-task=8
+#SBATCH --ntasks=1
+#SBATCH --time=1:50:00
+#SBATCH --hint=nomultithread
+
+cd \$SLURM_SUBMIT_DIR
+
+export PATH=:\$HOME/src/OpenSource/bin:\$HOME/bin:\$PATH:
+
+export OMP_NUM_THREADS=8
+file_rcv=shotsNoise/shots_${xsrc}.su
+
+fdelmodc \
+ file_cp=nofault_cp.su ischeme=1 iorder=4 \
+ file_den=nofault_ro.su \
+ file_src=wavefw.su \
+ file_rcv=\$file_rcv \
+ src_type=1 \
+ src_orient=1 \
+ src_injectionrate=1 \
+ rec_type_vz=0 \
+ rec_type_p=1 \
+ rec_int_vz=2 \
+ rec_delay=0.3 \
+ dtrcv=0.004 \
+ verbose=2 \
+ tmod=4.392 \
+ dxrcv=10.0 \
+ xrcv1=-4500 xrcv2=4500 \
+ zrcv1=100 zrcv2=100 \
+ xsrc=$xsrc zsrc=$zsrc \
+ ntaper=250 \
+ left=2 right=2 top=1 bottom=2
+EOF
+
+sbatch jobs/job_$ishot.job
+
+ (( ishot = $ishot + 1))
+
+done
+
diff --git a/utils/Makefile b/utils/Makefile
index 3b59b4f71f844acc56c9b9851deba24861d82e5b..7b056b16b5e646d7af1ae0f0101b8f2c1ead0027 100644
--- a/utils/Makefile
+++ b/utils/Makefile
@@ -2,11 +2,11 @@
include ../Make_include
-LIBS += -L$L -lgenfft -lm $(LIBSM)
+#LIBS += -L$L -lgenfft -lm $(LIBSM)
#OPTC += -openmp
#OPTC += -g -O0
-ALL: makemod makewave extendModel fconv correigen green basop syn2d mat2su ftr1d
+ALL: makemod makewave extendModel fconv correigen green green3D basop syn2d mat2su ftr1d
SRCM = \
makemod.c \
@@ -84,6 +84,17 @@ SRCG = green.c \
docpkge.c \
getpars.c
+SRCG3 = green3D.c \
+ getFileInfo.c \
+ getrecpos3D.c \
+ readData.c \
+ writeData.c \
+ wallclock_time.c \
+ verbosepkg.c \
+ atopkge.c \
+ docpkge.c \
+ getpars.c
+
SRCB = basop.c \
getFileInfo.c \
kxwfilter.c \
@@ -152,6 +163,11 @@ OBJG = $(SRCG:%.c=%.o)
green: $(OBJG)
$(CC) $(LDFLAGS) $(OPTC) $(CFLAGS) -o green $(OBJG) $(LIBS)
+OBJG3 = $(SRCG3:%.c=%.o)
+
+green3D: $(OBJG3)
+ $(CC) $(LDFLAGS) $(OPTC) $(CFLAGS) -o green3D $(OBJG3) $(LIBS)
+
OBJB = $(SRCB:%.c=%.o)
basop: $(OBJB)
@@ -172,23 +188,24 @@ OBJT = $(SRCT:%.c=%.o)
ftr1d: $(OBJT)
$(CC) $(LDFLAGS) $(OPTC) $(CFLAGS) -o ftr1d $(OBJT) $(LIBS)
-install: makemod makewave extendModel fconv correigen green basop syn2d mat2su ftr1d
+install: makemod makewave extendModel fconv correigen green green3D basop syn2d mat2su ftr1d
cp makemod $B
cp makewave $B
cp extendModel $B
cp fconv $B
cp correigen $B
cp green $B
+ cp green3D $B
cp basop $B
cp syn2d $B
cp mat2su $B
cp ftr1d $B
clean:
- rm -f core $(OBJM) makemod $(OBJW) makewave $(OBJE) extendModel $(OBJF) fconv $(OBJG) $(OBJC) correigen green $(OBJB) basop $(OBJJ) syn2d $(OBJS) mat2su $(OBJA) ftr1d $(OBJT)
+ rm -f core $(OBJM) makemod $(OBJW) makewave $(OBJE) extendModel $(OBJF) fconv $(OBJG) $(OBJC) correigen green $(OBJG3) green3D $(OBJB) basop $(OBJJ) syn2d $(OBJS) mat2su $(OBJA) ftr1d $(OBJT)
realclean: clean
- rm -f $B/makemod $B/makewave $B/extendModel $B/fconv $B/correigen $B/green $B/basop $B/syn2d $B/mat2su $B/ftr1d
+ rm -f $B/makemod $B/makewave $B/extendModel $B/fconv $B/correigen $B/green $B/green3D $B/basop $B/syn2d $B/mat2su $B/ftr1d
diff --git a/utils/freqwave.c b/utils/freqwave.c
index d5c894c7481eeee668e0959ebe7bdfb0f971ebd2..591537747f614f86337fb3c25144ad32cbf1b318 100644
--- a/utils/freqwave.c
+++ b/utils/freqwave.c
@@ -31,7 +31,7 @@ float gauss1freq(float f, float freq);
float gauss0freq(float f, float freq);
void hilbertTrans(float *data, int nsam);
-void freqwave(float *wave, int nt, float dt, float fp, float fmin, float flef, float frig, float fmax, float t0, float db, int shift, int cm, int cn, char *w, float scale, int scfft, int inverse, float eps, int verbose)
+void freqwave(float *wave, int nt, float dt, float fp, float fmin, float flef, float frig, float fmax, float t0, float db, int shift, int cm, int cn, char *w, float scale, int scfft, int inverse, float eps, float alpha, int verbose)
{
int it, iof, nfreq, nf, i, j, sign, optn, stored;
int ifmin1, ifmin2, ifmax1, ifmax2;
@@ -395,7 +395,10 @@ void freqwave(float *wave, int nt, float dt, float fp, float fmin, float flef, f
else max = df;
}
//fprintf(stderr,"scaling factor back FFT=%e\n", max);
- for (i = 0; i < nt; i++) wave[i]= rwave[i]*max;
+ for (i = 0; i < nt; i++) {
+ tt=(float)i*dt;
+ wave[i]= rwave[i]*max*exp(-alpha*tt);
+ }
free(cwave);
free(rwave);
diff --git a/utils/getFileInfo.c b/utils/getFileInfo.c
index 490ba4ad7e382117ca7612b6f28b039cc4f4b7f1..61ff7bae8cff39ed8251ba37d335a42cdfba3395 100644
--- a/utils/getFileInfo.c
+++ b/utils/getFileInfo.c
@@ -1,6 +1,3 @@
-#define _FILE_OFFSET_BITS 64
-#define _LARGEFILE_SOURCE
-
#include <assert.h>
#include <stdio.h>
#include <stdlib.h>
diff --git a/utils/getrecpos3D.c b/utils/getrecpos3D.c
new file mode 100644
index 0000000000000000000000000000000000000000..85e9623fbc57864eb7be454d66520faf5e88c28b
--- /dev/null
+++ b/utils/getrecpos3D.c
@@ -0,0 +1,135 @@
+#include "par.h"
+#include <time.h>
+#include <stdlib.h>
+#include <stdio.h>
+#include <math.h>
+#include <assert.h>
+
+/**
+* read receiver positions used in green
+*
+* AUTHOR:
+* Jan Thorbecke (janth@xs4all.nl)
+* The Netherlands
+**/
+
+#define NINT(x) ((int)((x)>0.0?(x)+0.5:(x)-0.5))
+#ifndef MAX
+#define MAX(x,y) ((x) > (y) ? (x) : (y))
+#endif
+#ifndef MIN
+#define MIN(x,y) ((x) < (y) ? (x) : (y))
+#endif
+#define SGN(x) ((x) < 0 ? -1.0 : 1.0)
+#ifndef ABS
+#define ABS(x) ((x) < 0 ? -(x) : (x))
+#endif
+
+void getrecpos3D(float *xi, float *yi, float *zi, int nx, int ny, float *xrcv, float *yrcv, float *zrcv, int verbose)
+{
+ int nrx, nry, i, j, l, ndeltx, ndelty, np, lint, seed;
+ long idum;
+ float xprev, yprev, zprev, deltx, delty, deltz, dxrcv, dyrcv, dzrcv, var, irr, maxirr;
+ float rrcv, dphi, oxrcv, oyrcv, ozrcv;
+
+ nrx = countparval("xrcv");
+ nry = countparval("yrcv");
+ if(!getparfloat("dxrcv",&dxrcv)) dxrcv = 15;
+ if(!getparfloat("dyrcv",&dyrcv)) dyrcv = 15;
+ if(!getparfloat("var", &var)) var=0;
+ if(!getparint("lint", &lint)) lint=1;
+ if(!getparint("seed", &seed)) seed=0;
+
+ /* check if receiver positions on a circle are defined */
+ if (getparfloat("rrcv", &rrcv)) {
+ if (!getparfloat("dphi",&dphi)) dphi=2.0;
+ if (!getparfloat("oxrcv",&oxrcv)) oxrcv=0.0;
+ if (!getparfloat("oyrcv",&oyrcv)) oyrcv=0.0;
+ if (!getparfloat("ozrcv",&ozrcv)) ozrcv=0.0;
+
+ np = 0;
+ for (i=0; i<ny; i++) {
+ for (j=0; j<ny; j++) {
+ xi[np] = oxrcv+rrcv*cos(((i*dphi)/360.0)*(2.0*M_PI));
+ yi[np] = oyrcv+rrcv*cos(((i*dphi)/360.0)*(2.0*M_PI));
+ zi[np++] = ozrcv+rrcv*sin(((i*dphi)/360.0)*(2.0*M_PI));
+ if (verbose>4) fprintf(stderr,"Receiver Circle: xrcv[%d]=%f yrcv=%f zrcv=%f\n", i, xi[i], yi[i], zi[i]);
+ }
+ }
+ return;
+ }
+
+
+ if (var <= 0) {
+ if (lint == 1) {
+ xprev = xrcv[0];
+ yprev = yrcv[0];
+ zprev = zrcv[0];
+ np = 0;
+ for (i = 1; i < nry; i++) {
+ for (l = 1; l < nrx; l++) {
+ deltx = xrcv[i] - xprev;
+ delty = yrcv[i] - yprev;
+ deltz = zrcv[i] - zprev;
+ ndeltx = NINT(ABS(deltx/dxrcv));
+ ndelty = NINT(ABS(delty/dyrcv));
+ dzrcv = deltz/ndeltx;
+ for (j = 0; j < ndeltx; j++) {
+ zi[np] = zprev + j*dzrcv;
+ yi[np] = yprev + i*dyrcv;
+ xi[np++] = xprev + j*dxrcv;
+ }
+ xprev = xrcv[i*nx+l];
+ yprev = yrcv[i*nx+l];
+ zprev = zrcv[i*nx+l];
+ }
+ xi[i*nx+nx-1] = xrcv[nrx-1];
+ yi[i*nx+nx-1] = yrcv[nrx-1];
+ zi[i*nx+nx-1] = zrcv[nrx-1];
+ }
+ }
+ else {
+ for (i = 0; i < nry; i++) {
+ for (l = 0; l < nrx; l++) {
+ xi[i*nx+l] = xrcv[l];
+ yi[i*nx+l] = yrcv[i];
+ zi[i*nx+l] = zrcv[l];
+ }
+ }
+ }
+ }
+ else {
+ xprev = xrcv[0];
+ yprev = yrcv[0];
+ zprev = zrcv[0];
+ np = 0;
+ maxirr = 0;
+ idum = (long) seed;
+ srand48(idum);
+ for (i = 1; i < nrx; i++) {
+ deltx = xrcv[i] - xprev;
+ deltz = zrcv[i] - zprev;
+ ndeltx = NINT(ABS(deltx/dxrcv));
+ dzrcv = deltz/ndeltx;
+ for (j = 0; j < ndeltx; j++) {
+ irr = var*((float)drand48());
+ if (fabs(irr) > maxirr) maxirr = fabs(irr);
+ zi[np] = zprev + j*dzrcv;
+ xi[np++] = xprev + j*dxrcv + irr;
+ if (verbose==13)vmess("xrcv %d = %f (%f)",np-1,xi[np-1], irr);
+ }
+ xprev = xrcv[i];
+ zprev = zrcv[i];
+ }
+ irr = var*((float)drand48());
+ if (fabs(irr) > maxirr) maxirr = fabs(irr);
+ xi[nx-1] = xrcv[nrx-1] + irr;
+ zi[nx-1] = zrcv[nrx-1];
+ if (verbose) vmess("maximum error in receiver position %f", maxirr);
+ if (verbose==13) vmess("xrcv %d = %f (%f)", nx-1, xi[nx-1], irr);
+ }
+
+ if (verbose) vmess("getrecpos number of receivers = %d", np+1);
+
+ return;
+}
diff --git a/utils/green3D b/utils/green3D
new file mode 100755
index 0000000000000000000000000000000000000000..c2f71642dbc9a737f12146aaac155419fe32ad9c
Binary files /dev/null and b/utils/green3D differ
diff --git a/utils/green3D.c b/utils/green3D.c
new file mode 100644
index 0000000000000000000000000000000000000000..b31d0c3ee81250acba4d2b471d6a795390f729e5
--- /dev/null
+++ b/utils/green3D.c
@@ -0,0 +1,733 @@
+#include <genfft.h>
+#include "par.h"
+#include "segy.h"
+#include <time.h>
+#include <stdlib.h>
+#include <stdio.h>
+#include <math.h>
+#include <assert.h>
+
+#define NINT(x) ((int)((x)>0.0?(x)+0.5:(x)-0.5))
+#ifndef MAX
+#define MAX(x,y) ((x) > (y) ? (x) : (y))
+#endif
+#ifndef MIN
+#define MIN(x,y) ((x) < (y) ? (x) : (y))
+#endif
+#define SGN(x) ((x) < 0 ? -1.0 : 1.0)
+
+
+#ifndef COMPLEX
+typedef struct _complexStruct { /* complex number */
+ float r,i;
+} complex;
+#endif/* complex */
+
+int disp_fileinfo(char *file, int n1, int n2, float f1, float f2, float d1, float d2, segy *hdrs);
+int getFileInfo(char *filename, int *n1, int *n2, int *ngath, float *d1, float *d2, float *f1, float *f2, float *xmin, float *xmax, float *sclsxgx, int *nxm);
+int readData(FILE *fp, float *data, segy *hdrs, int n1);
+
+void xwgreen3D(float *data, int nt, int nx, int ny, float dt, float fmin, float fmax, float *xi, float xsrc,
+ float dx, float *yi, float ysrc, float dy, float *zi, float zsrc, float c, float cs, float rho,
+ float *wavelet, float dipx, float maxdip, int far, int p_vz, int dip, int verbose);
+
+
+/*********************** self documentation **********************/
+char *sdoc[] = {
+" ",
+" green - calculation of 2D Greens function in homogenoeus medium based one exact expressions",
+" ",
+" green c= zsrc1= [optional parameters]",
+" ",
+" Required parameters:",
+" ",
+" c= ....................... P-wave velocity",
+" cs=0.7*c ................. S-wave velocity",
+" zsrc1= ................... depth of source",
+" ",
+" Optional parameters:",
+" ",
+" file_out= ................ output file (default SU-pipe)",
+" RECEIVER POSITIONS ",
+" xrcv=-1500,1500 .......... x-position's of receivers (array)",
+" yrcv=-1500,1500 .......... y-position's of receivers (array)",
+" zrcv=0,0 ................. z-position's of receivers (array)",
+" dxrcv=15 ................. step in receiver x-direction",
+" dyrcv=15 ................. step in receiver y-direction",
+" var=0 .................... variance for irregular sampling (dxrcv +- var)",
+" seed=0 ................... seed for random generator",
+" lint=1 ................... linear interpolate between the rcv points",
+" rrcv= .................... radius for receivers on a circle ",
+" oxrcv=0.0 ................ x-center position of circle",
+" oyrcv=0.0 ................ y-center position of circle",
+" ozrcv=0.0 ................ z-center position of circle",
+" dphi=2 ................... angle between receivers on circle ",
+" SOURCE POSITIONS ",
+" xsrc1=0.0 ................ x-position of first source",
+" xsrc2=xsrc1 .............. x-position of last source",
+" dxsrc=0.0 ................ step in source x-direction",
+" ysrc1=0.0 ................ y-position of first source",
+" ysrc2=ysrc1 .............. y-position of last source",
+" dysrc=0.0 ................ step in source y-direction",
+" zsrc2=zsrc1 .............. depth position (z) of last source",
+" dzsrc=0.0 ................ step in source z-direction",
+" SAMPLING AND SOURCE DEFINITION ",
+" file_src=spike ........... source wavelet (overrules dt)",
+" nt=256 ................... number of samples",
+" dt=0.004 ................. stepsize in time-direction ",
+" fmin=0 ................... minimum frequency",
+" fmax=70 .................. maximum frequency",
+" dipx=0 ................... local dip of the dipole in x-direction",
+" dipy=0 ................... local dip of the dipole in y-direction",
+" dip=1 .................... 1; dipole 0; monopole source",
+" rho=1000 ................. density",
+" FIELD DEFINITION ",
+" far=0 .................... farfield approximation 0=off)",
+" p_vz=0 .................. P or Vz field (0 = P field, 1 = Vz field)",
+" Fz=0 .................... Force source in z with Vz receivers",
+" Fx=0 .................... Force source in x with Vz receivers",
+" maxdip=90 ................ maximum angle (degrees) to be computed ",
+" sum=0 .................... sum all sources",
+" verbose=0 ................ silent option; >0 display info",
+"",
+" The P or Vz field of a dipole source at depth z below the receivers",
+" in a homogeneous 2-D medium is calculated.",
+" ",
+" author : Jan Thorbecke : 23-03-1995 (janth@xs4all.nl)",
+" : revision 2010",
+" ",
+NULL};
+/**************** end self doc ***********************************/
+
+int main(int argc, char **argv)
+{
+ FILE *fp_in, *fp_out;
+ int n1, n2, n3, i, j, l, nrx, nry, nrz, dip;
+ int far, p_vz, nt, nx, ny, Nsx, Nsy, is, isy, sum, lint, verbose;
+ int size, ntraces, ngath, Fz, Fx;
+ float scl, xmin, xmax, ymin, ymax;
+ float dx, dy, dt, d1, d2, d3, fmin, fmax, f1, f2, f3, c, cs, rho;
+ float *data, *wavelet, *tmpdata, dipx, dipy, xsrc1, xsrc2, ysrc1, ysrc2;
+ float *xrcv, *yrcv, *zrcv, *xi, *yi, *zi, x0, y0, maxdip;
+ float rrcv, dphi, oxrcv, ozrcv;
+ float zsrc1, zsrc2, dxsrc, dysrc, dzsrc, xsrc, ysrc, zsrc, dxrcv, dyrcv;
+ char *file_src, *file_out;
+ size_t nwrite;
+ segy *hdrs;
+
+/* ========================= Reading parameters ====================== */
+
+ initargs(argc, argv);
+ requestdoc(1);
+
+ if(!getparint("verbose", &verbose)) verbose = 0;
+ if(!getparstring("file_out", &file_out)){
+ if (verbose) vwarn("parameter file_out not found, assume pipe");
+ file_out = NULL;
+ }
+ if(!getparstring("file_src", &file_src)) file_src = NULL;
+ if(!getparfloat("c", &c)) verr("velocity must be specified.");
+ if(!getparfloat("cs", &cs)) cs=0.7*c;
+ if(!getparfloat("zsrc1", &zsrc1)) verr("zsrc1(depth) must be specified.");
+ if(!getparint("lint", &lint)) lint=1;
+ if(!getparfloat("maxdip", &maxdip)) maxdip=90.0;
+
+ nrx = countparval("xrcv");
+ nry = countparval("yrcv");
+ // nrz = countparval("zrcv");
+ nrz = 0;
+ if(!getparfloat("dxrcv",&dxrcv)) dxrcv = 15;
+ if(!getparfloat("dyrcv",&dyrcv)) dyrcv = 15;
+
+ if (nrx != 0 && nry != 0 && nrz == 0) {
+ if (nrx != 2) verr("xrcv should have only two values");
+ if (nry != 2) verr("yrcv should have only two values");
+ xrcv = (float *)malloc(nrx*sizeof(float));
+ yrcv = (float *)malloc(nry*sizeof(float));
+ getparfloat("xrcv",xrcv);
+ getparfloat("yrcv",yrcv);
+ nx = NINT((xrcv[1] - xrcv[0])/dxrcv) + 1;
+ ny = NINT((yrcv[1] - yrcv[0])/dyrcv) + 1;
+ xi = (float *)malloc(nx*ny*sizeof(float));
+ yi = (float *)malloc(nx*ny*sizeof(float));
+ zi = (float *)malloc(nx*ny*sizeof(float));
+ x0 = xrcv[0];
+ y0 = yrcv[0];
+ for (i = 0; i < ny; i++) {
+ for (j = 0; j < nx; j++) {
+ xi[i*nx+j] = x0 + j*dxrcv;
+ yi[i*nx+j] = y0 + i*dyrcv;
+ zi[i*nx+j] = 0;
+ }
+ }
+ }
+ else if (nrx == 0 && nry == 0 && nrz == 0) {
+ nx = NINT((3000)/dxrcv) + 1;
+ ny = NINT((3000)/dyrcv) + 1;
+ xi = (float *)malloc(nx*ny*sizeof(float));
+ yi = (float *)malloc(nx*ny*sizeof(float));
+ zi = (float *)malloc(nx*ny*sizeof(float));
+ x0 = -1500;
+ y0 = -1500;
+ for (i = 0; i < ny; i++) {
+ for (j = 0; j < nx; j++) {
+ xi[i*nx+j] = x0 + j*dxrcv;
+ yi[i*nx+j] = y0 + i*dyrcv;
+ zi[i*nx+j] = 0;
+ }
+ }
+ }
+ else verr("Number of xrcv and yrcv values are not equal");
+
+ if (verbose) vmess("number of receivers nx = %d, ny = %d total = %d", nx, ny, nx*ny);
+ if (verbose == 13) {
+ for (j = 0; j < ny; j++) {
+ for (i = 0; i < nx; i++) {
+ vmess("xi = %d yi = %d x = %f y=%f z = %f", i, j, xi[j*nx+i], yi[j*nx+i], zi[j*nx+i]);
+ }
+ }
+ }
+
+ if(!getparfloat("xsrc1", &xsrc1)) xsrc1=0;
+ if(!getparfloat("xsrc2", &xsrc2)) xsrc2=xsrc1;
+ if(!getparfloat("dxsrc", &dxsrc)) dxsrc=0.0;
+ if(!getparfloat("ysrc1", &ysrc1)) ysrc1=0;
+ if(!getparfloat("ysrc2", &ysrc2)) ysrc2=ysrc1;
+ if(!getparfloat("dysrc", &dysrc)) dysrc=0.0;
+ if(!getparfloat("zsrc2", &zsrc2)) zsrc2=zsrc1;
+ if(!getparfloat("dzsrc", &dzsrc)) dzsrc=0;
+ if(!getparint("nt", &nt)) nt = 256;
+ if(!getparfloat("fmin", &fmin)) fmin = 0.0;
+ if(!getparfloat("fmax", &fmax)) fmax = 70.0;
+ if(!getparfloat("dipx", &dipx)) dipx = 0.0;
+ if(!getparfloat("dipy", &dipy)) dipy = 0.0;
+ if(!getparfloat("rho", &rho)) rho = 1000.0;
+ if(!getparint("far", &far)) far = 0;
+ if(!getparint("p_vz", &p_vz)) p_vz = 0;
+ if(!getparint("Fz", &Fz)) Fz = 0;
+ if(!getparint("Fx", &Fx)) Fx = 0;
+ if(!getparint("dip", &dip)) dip = 1;
+ if(!getparint("sum", &sum)) sum = 0;
+ if(Fz) p_vz=2;
+ if(Fx) p_vz=3;
+
+/* ========================= Opening wavelet file ====================== */
+
+ if (file_src == NULL){
+ if(!getparfloat("dt", &dt)) dt = 0.004;
+ wavelet = (float *)calloc(nt,sizeof(float));
+ wavelet[0] = 1.0;
+ }
+ else {
+ if (verbose) vmess("Reading wavelet from file %s.", file_src);
+ ngath = 1;
+ getFileInfo(file_src, &n1, &n2, &ngath, &d1, &d2, &f1, &f2, &xmin, &xmax, &scl, &ntraces);
+
+ fp_in = fopen(file_src, "r");
+ if (fp_in == NULL) verr("error on opening input file_src=%s", file_src);
+
+ tmpdata = (float *)calloc(n1*n2,sizeof(float));
+ hdrs = (segy *) calloc(n2,sizeof(segy));
+
+ n2 = readData(fp_in, tmpdata, hdrs, n1);
+ fclose(fp_in);
+ if (verbose) {
+ disp_fileinfo(file_src, n1, n2, f1, f2, d1, d2, hdrs);
+ }
+ dt = d1;
+ wavelet = (float *)calloc(nt,sizeof(float));
+
+ if (n1 <= nt) {
+ for (i = 0; i < n1; i++) wavelet[i] = tmpdata[i];
+ for (i = n1; i < nt; i++) wavelet[i] = 0.0;
+ }
+ else {
+ vwarn("file_src has more samples than output");
+ for (i = 0; i < nt; i++) wavelet[i] = tmpdata[i];
+ }
+ if( tmpdata ) free(tmpdata);
+ if( hdrs ) free( (void *) hdrs);
+ }
+
+/* ============ INITIALIZE AND CHECK PARAMETERS =============== */
+
+ if (xsrc2==xsrc1) Nsx = 1;
+ else Nsx = NINT((xsrc2 - xsrc1)/dxsrc) + 1;
+ if (ysrc2==ysrc1) Nsy = 1;
+ else Nsy = NINT((ysrc2 - ysrc1)/dysrc) + 1;
+
+ if (verbose) vmess("Number of shot records to generate x = %d y = %d", Nsx, Nsy);
+ if (Nsx > 1 && Nsy > 1) {
+ dxsrc = (xsrc2-xsrc1)/(Nsx-1);
+ dysrc = (ysrc2-ysrc1)/(Nsy-1);
+ dzsrc = (zsrc2-zsrc1)/(Nsx-1);
+ if (verbose) {
+ vmess("dxsrc = %f", dxsrc);
+ vmess("dysrc = %f", dysrc);
+ vmess("dzsrc = %f", dzsrc);
+ }
+ }
+
+ size = nt * nx *ny;
+ dx = dxrcv;
+ dy = dyrcv;
+ tmpdata = (float *)calloc(size,sizeof(float));
+ data = (float *)calloc(size,sizeof(float));
+ hdrs = (segy *) calloc(nx*ny,sizeof(segy));
+ for (i = 0; i < ny; i++) {
+ for(j = 0; j < nx; j++) {
+ hdrs[i*nx+j].f1= 0.0;
+ hdrs[i*nx+j].f2= x0;
+ hdrs[i*nx+j].d1= dt;
+ hdrs[i*nx+j].d2= dx;
+ hdrs[i*nx+j].ns= nt;
+ hdrs[i*nx+j].dt= (int)1000000*dt;
+ hdrs[i*nx+j].trwf= nx*ny;
+ hdrs[i*nx+j].tracl= i*nx+j+1;
+ hdrs[i*nx+j].tracf= i*nx+j+1;
+ hdrs[i*nx+j].gx = (x0 + j*dx)*1000;
+ hdrs[i*nx+j].gy = (y0 + i*dy)*1000;
+ hdrs[i*nx+j].scalco = -1000;
+ hdrs[i*nx+j].trid = TREAL;
+ }
+ }
+ if (file_out==NULL) fp_out=stdout;
+ else fp_out = fopen(file_out,"w");
+ if (fp_out == NULL) verr("error in creating output file");
+
+ for (isy = 0; isy < Nsy; isy++) {
+ for (is = 0; is < Nsx; is++) {
+ xsrc = xsrc1 + is*dxsrc;
+ ysrc = ysrc1 + isy*dysrc;
+ zsrc = zsrc1 + is*dzsrc;
+ if (verbose) vmess("xsrc = %f ysrc=%f zsrc = %f", xsrc, ysrc, zsrc);
+
+ xwgreen3D(data,nt,nx,ny,dt,fmin,fmax,xi,xsrc,dx,yi,ysrc,dy,zi,zsrc,c,cs,rho,wavelet,
+ dipx, maxdip, far, p_vz, dip, verbose);
+
+ for (l = 0; l < ny; l++) {
+ for (i = 0; i < nx; i++) {
+ for (j = 0; j < nt; j++) tmpdata[l*nx*nt+i*nt+j] = data[l*nx*nt+i*nt+j];
+ hdrs[l*nx+i].sx = NINT(xsrc*1000);
+ hdrs[l*nx+i].sy = NINT(ysrc*1000);
+ hdrs[l*nx+i].scalco = -1000;
+ hdrs[l*nx+i].offset = xi[l*nx+i]-xsrc;
+ hdrs[l*nx+i].gx = NINT(xi[l*nx+i]*1000);
+ hdrs[l*nx+i].gy = NINT(yi[l*nx+i]*1000);
+ hdrs[l*nx+i].fldr = isy*Nsx+is+1;
+ hdrs[l*nx+i].trwf = nx*ny;
+ nwrite = fwrite( &hdrs[l*nx+i], 1, TRCBYTES, fp_out);
+ assert(nwrite == TRCBYTES);
+ nwrite = fwrite( &tmpdata[l*nx*nt+i*nt], sizeof(float), nt, fp_out);
+ assert(nwrite == nt);
+ }
+ }
+ }
+ }
+
+ if( xi ) free(xi);
+ if( yi ) free(yi);
+ if( zi ) free(zi);
+ if( wavelet ) free( wavelet );
+
+ fclose(fp_out);
+
+ if( data ) free(data);
+ if( tmpdata ) free(tmpdata);
+ if( hdrs ) free( hdrs);
+
+ exit ( 0 );
+}
+
+/***************************************************************************
+*
+* Calculation of pulse response in homogeneous medium
+*
+*
+***************************************************************************/
+
+void xwgreen3D(float *data, int nt, int nx, int ny, float dt, float fmin, float fmax, float *xi, float xsrc, float dx, float *yi, float ysrc, float dy, float *zi, float zsrc, float c, float cs, float rho, float *wavelet, float dipx, float maxdip, int far, int p_vz, int dip, int verbose)
+{
+ int iomin, iomax, iom, ix, iy, nfreq, i, sign, optn;
+ float df, deltom, om, k, r, x, y, invr, phi, phi2, cosphi;
+ float *rwave, *rdata, cos2, scl, z, kp, ks, sclr;
+ complex *cwave, *cdata, tmp, tmp2, ekr, sum;
+ complex H02p, H12p, H02s, H12s, Gp, Gs;
+
+ optn = optncr(nt);
+ nfreq = 1+(optn/2);
+ df = 1.0/(dt*optn);
+ deltom = 2.*M_PI*df;
+ iomin = (int)MIN((fmin*dt*optn), (nfreq-1));
+ iomin = MAX(iomin, 1);
+ iomax = MIN((int)(fmax*dt*optn), (nfreq-1));
+
+ rdata = (float *)calloc(optn*nx*ny,sizeof(float));
+ cdata = (complex *)calloc(nfreq*nx*ny,sizeof(complex));
+ rwave = (float *)calloc(optn,sizeof(float));
+ cwave = (complex *)calloc(nfreq,sizeof(complex));
+
+ for (i = 0; i < nt; i++) rwave[i] = wavelet[i]*dt;
+ for (i = nt; i < optn; i++) rwave[i] = 0.0;
+
+ sign = -1;
+ rc1fft(rwave, cwave, optn, sign);
+
+ for (iy = 0; iy < ny; iy++) {
+ for (ix = 0; ix < nx; ix++) {
+ for (iom = 0; iom < iomin; iom++) {
+ cdata[iy*nx*nfreq+ix*nfreq+iom].r = 0.0;
+ cdata[iy*nx*nfreq+ix*nfreq+iom].i = 0.0;
+ }
+ }
+ }
+ for (iy = 0; iy < ny; iy++) {
+ for (ix = 0; ix < nx; ix++) {
+ for (iom = iomax; iom < nfreq; iom++) {
+ cdata[iy*nx*nfreq+ix*nfreq+iom].r = 0.0;
+ cdata[iy*nx*nfreq+ix*nfreq+iom].i = 0.0;
+ }
+ }
+ }
+
+ if (p_vz == 0) {
+ if (dip == 1) {
+ if (verbose) vmess("P field of dipole");
+ for (iy = 0; iy < ny; iy++) {
+ for (ix = 0; ix < nx; ix++) {
+ x = xi[iy*nx+ix] - xsrc;
+ y = yi[iy*nx+ix] - ysrc;
+ z = fabs(zi[iy*nx+ix] - zsrc);
+ r = sqrt(x*x + y*y + z*z);
+ if (r != 0) phi = acos(z/r);
+ else phi = M_PI/2;
+ phi2 = SGN(x)*phi - (dipx*M_PI/180.0);
+ cosphi = 0.25*cos(phi2)*rho;
+ if (fabs(phi) < maxdip*M_PI/180.0) {
+ /* exp(-jkr) = cos(kr) - j*sin(kr) */
+ for (iom = iomin; iom <= iomax; iom++) {
+ om = iom*deltom;
+ k = om/c;
+ ekr.r = cos(k*r)/(r*r);
+ ekr.i = sin(-k*r)/(r*r);
+ tmp.r = cosphi*(ekr.r - k*r*ekr.i);
+ tmp.i = cosphi*(ekr.i + k*r*ekr.r);
+ cdata[iy*nx*nfreq+ix*nfreq+iom].r = tmp.r*cwave[iom].r -
+ tmp.i*cwave[iom].i;
+ cdata[iy*nx*nfreq+ix*nfreq+iom].i = tmp.r*cwave[iom].i +
+ tmp.i*cwave[iom].r;
+ }
+ }
+ else {
+ for (iom = iomin; iom <= iomax; iom++) {
+ cdata[iy*nx*nfreq+ix*nfreq+iom].r = 0.0;
+ cdata[iy*nx*nfreq+ix*nfreq+iom].i = 0.0;
+ }
+ }
+ }
+ }
+ }
+/* There is no far-field definition 'needed' in 3D
+ else if (far == 1 && dip == 1){
+ if (verbose) vmess("far P field of dipole");
+ for (iy = 0; iy < ny; iy++) {
+ for (ix = 0; ix < nx; ix++) {
+ x = xi[ix] - xsrc;
+ y = yi[iy*nx+ix] - ysrc;
+ z = fabs(zi[iy*nx+ix] - zsrc);
+ r = sqrt(x*x + y*y + z*z);
+ if (r != 0) phi = acos(z/r);
+ else phi = M_PI/2;
+ phi2 = SGN(x)*phi - (dipx*M_PI/180.0);
+ cosphi = 0.5*cos(phi2)*rho/sqrt(r);
+ if (fabs(phi) < maxdip*M_PI/180.0) {
+ for (iom = iomin; iom <= iomax; iom++) {
+ om = iom*deltom;
+ k = om/c;
+ tmp.r = sqrt(k/(2.0*M_PI))*cosphi*cos(k*r-M_PI/4.0);
+ tmp.i = -sqrt(k/(2.0*M_PI))*cosphi*sin(k*r-M_PI/4.0);
+
+ cdata[iy*nx*nfreq+ix*nfreq+iom].r = tmp.r*cwave[iom].r -
+ tmp.i*cwave[iom].i;
+ cdata[iy*nx*nfreq+ix*nfreq+iom].i = tmp.r*cwave[iom].i +
+ tmp.i*cwave[iom].r;
+ }
+ }
+ else {
+ for (iom = iomin; iom <= iomax; iom++) {
+ cdata[iy*nx*nfreq+ix*nfreq+iom].r = 0.0;
+ cdata[iy*nx*nfreq+ix*nfreq+iom].i = 0.0;
+ }
+ }
+ }
+ }
+ }
+*/
+ else if (dip == 0){
+ if (verbose) vmess("P field of monopole");
+ for (iy = 0; iy < ny; iy++) {
+ for (ix = 0; ix < nx; ix++) {
+ x = xi[iy*nx+ix] - xsrc;
+ y = yi[iy*nx+ix] - ysrc;
+ z = fabs(zi[iy*nx+ix] - zsrc);
+ r = sqrt(x*x + y*y + z*z);
+ if (r != 0) phi = acos(z/r);
+ else phi = M_PI/2;
+ scl = 0.25*rho;
+ if (fabs(phi) < maxdip*M_PI/180.0) {
+ for (iom = iomin; iom <= iomax; iom++) {
+ om = iom*deltom;
+ k = om/c;
+ tmp.r = scl*cos(k*r)/(r);
+ tmp.i = scl*sin(-k*r)/(r);
+
+ cdata[iy*nx*nfreq+ix*nfreq+iom].r = tmp.r*cwave[iom].r -
+ tmp.i*cwave[iom].i;
+ cdata[iy*nx*nfreq+ix*nfreq+iom].i = tmp.r*cwave[iom].i +
+ tmp.i*cwave[iom].r;
+ }
+ }
+ else {
+ for (iom = iomin; iom <= iomax; iom++) {
+ cdata[iy*nx*nfreq+ix*nfreq+iom].r = 0.0;
+ cdata[iy*nx*nfreq+ix*nfreq+iom].i = 0.0;
+ }
+ }
+ }
+ }
+ }
+/* There is no far-field definition 'needed' in 3D
+ else if (far == 1 && dip == 0){
+ if (verbose) vmess("far P field of monopole");
+ for (iy = 0; iy < ny; iy++) {
+ for (ix = 0; ix < nx; ix++) {
+ x = xi[iy*nx+ix] - xsrc;
+ y = yi[iy*nx+ix] - ysrc;
+ z = fabs(zi[iy*nx+ix] - zsrc);
+ r = sqrt(x*x + y*y + z*z);
+ if (r != 0) phi = acos(z/r);
+ else phi = M_PI*0.5;
+ scl = 0.5*rho/sqrt(r);
+ if (fabs(phi) <= M_PI*(maxdip/180.0)) {
+ for (iom = iomin; iom <= iomax; iom++) {
+ om = iom*deltom;
+ k = om/c;
+ tmp.r = -sqrt(1.0/(2.0*M_PI*k))*scl*sin(k*r-M_PI/4.0);
+ tmp.i = -sqrt(1.0/(2.0*M_PI*k))*scl*cos(k*r-M_PI/4.0);
+
+ cdata[iy*nx*nfreq+ix*nfreq+iom].r = tmp.r*cwave[iom].r -
+ tmp.i*cwave[iom].i;
+ cdata[iy*nx*nfreq+ix*nfreq+iom].i = tmp.r*cwave[iom].i +
+ tmp.i*cwave[iom].r;
+ }
+ }
+ else {
+ for (iom = iomin; iom <= iomax; iom++) {
+ cdata[iy*nx*nfreq+ix*nfreq+iom].r = 0.0;
+ cdata[iy*nx*nfreq+ix*nfreq+iom].i = 0.0;
+ }
+ }
+ }
+ }
+ }
+*/
+ }
+ else if (p_vz == 1) {
+ if (dip == 1) {
+ if (verbose) vmess("Vz field of dipole, this is not yet implemented");
+ for (iy = 0; iy < ny; iy++) {
+ for (ix = 0; ix < nx; ix++) {
+ x = xi[iy*nx+ix] - xsrc;
+ y = yi[iy*nx+ix] - ysrc;
+ z = fabs(zi[iy*nx+ix] - zsrc);
+ r = sqrt(x*x + y*y + z*z);
+ invr = -0.25/(c);
+ if (r != 0) phi = acos(z/r);
+ else phi = M_PI/2;
+ phi2 = SGN(x)*phi - (dipx*M_PI/180.0);
+ cosphi = cos(phi2);
+ cos2 = cosphi*cosphi;
+ if (fabs(phi) < maxdip*M_PI/180.0) {
+ for (iom = iomin; iom <= iomax; iom++) {
+ om = iom*deltom;
+ k = om/c;
+ tmp.r = k*cos2*invr*j0(k*r);
+ tmp.i = -k*cos2*invr*y0(k*r);
+ tmp2.r = k*(1-2*cos2)*invr*j1(k*r)/(k*r);
+ tmp2.i = -k*(1-2*cos2)*invr*y1(k*r)/(k*r);
+ sum.r = tmp.r + tmp2.r;
+ sum.i = tmp.i + tmp2.i;
+
+ cdata[iy*nx*nfreq+ix*nfreq+iom].r = sum.r*cwave[iom].r -
+ sum.i*cwave[iom].i;
+ cdata[iy*nx*nfreq+ix*nfreq+iom].i = sum.r*cwave[iom].i +
+ sum.i*cwave[iom].r;
+ }
+ }
+ else {
+ for (iom = iomin; iom <= iomax; iom++) {
+ cdata[iy*nx*nfreq+ix*nfreq+iom].r = 0.0;
+ cdata[iy*nx*nfreq+ix*nfreq+iom].i = 0.0;
+ }
+ }
+ }
+ }
+ }
+ else {
+ if (verbose) vmess("Vz field of monopole");
+
+ for (iy = 0; iy < ny; iy++) {
+ for (ix = 0; ix < nx; ix++) {
+ x = xi[iy*nx+ix] - xsrc;
+ y = yi[iy*nx+ix] - ysrc;
+ z = fabs(zi[iy*nx+ix] - zsrc);
+ r = sqrt(x*x + y*y + z*z);
+ if (r != 0) phi = acos(z/r);
+ else phi = M_PI/2;
+ phi2 = SGN(x)*phi - (dipx*M_PI/180.0);
+ cosphi = 0.25*cos(phi2)/c;
+ if (fabs(phi) < maxdip*M_PI/180.0) {
+ /* exp(-jkr) = cos(kr) - j*sin(kr) */
+ for (iom = iomin; iom <= iomax; iom++) {
+ om = iom*deltom;
+ k = om/c;
+ ekr.r = cos(k*r)/(r*r);
+ ekr.i = sin(-k*r)/(r*r);
+ tmp.r = cosphi*(ekr.r - k*r*ekr.i);
+ tmp.i = cosphi*(ekr.i + k*r*ekr.r);
+ cdata[iy*nx*nfreq+ix*nfreq+iom].r = tmp.r*cwave[iom].r -
+ tmp.i*cwave[iom].i;
+ cdata[iy*nx*nfreq+ix*nfreq+iom].i = tmp.r*cwave[iom].i +
+ tmp.i*cwave[iom].r;
+ }
+ }
+ else {
+ for (iom = iomin; iom <= iomax; iom++) {
+ cdata[iy*nx*nfreq+ix*nfreq+iom].r = 0.0;
+ cdata[iy*nx*nfreq+ix*nfreq+iom].i = 0.0;
+ }
+ }
+ }
+ }
+ }
+ }
+ else if (p_vz == 2) { /* Fz source with Vz receivers Fz=1 == p_vz=2 */
+ for (iy = 0; iy < ny; iy++) {
+ for (ix = 0; ix < nx; ix++) {
+ x = xi[iy*nx+ix] - xsrc;
+ y = yi[iy*nx+ix] - ysrc;
+ z = fabs(zi[iy*nx+ix] - zsrc);
+ r = sqrt(x*x + y*y + z*z);
+
+ if (r != 0) phi = acos(z/r);
+ else phi = M_PI/2;
+ phi2 = SGN(x)*phi - (dipx*M_PI/180.0);
+ cosphi = cos(phi2);
+ sclr = (z*z-x*x-y*y)/(r);
+ if (fabs(phi) < maxdip*M_PI/180.0) {
+ for (iom = iomin; iom <= iomax; iom++) {
+ om = iom*deltom;
+ kp = om/c;
+ ks = om/cs;
+ H02p.r = j0(kp*r);
+ H02p.i = -y0(kp*r);
+ H12p.r = j1(kp*r);
+ H12p.i = -y1(kp*r);
+
+ H02s.r = j0(ks*r);
+ H02s.i = -y0(ks*r);
+ H12s.r = j1(ks*r);
+ H12s.i = -y1(ks*r);
+
+ Gp.r = kp/(4*om*rho*r*r)*(-z*z*kp*H02p.r + sclr*H12p.r);
+ Gp.i = kp/(4*om*rho*r*r)*(-z*z*kp*H02p.i + sclr*H12p.i);
+
+ Gs.r = ks/(4*om*rho*r*r)*(-z*z*ks*H02s.r + sclr*H12s.r);
+ Gs.i = ks/(4*om*rho*r*r)*(-z*z*ks*H02s.i + sclr*H12s.i);
+
+ tmp.i = (-1.0/om)*((om/(4*rho*cs*cs))*(H02s.r) - Gp.r + Gs.r);
+ tmp.r = ( 1.0/om)*((om/(4*rho*cs*cs))*(H02s.i) - Gp.i + Gs.i);
+
+ cdata[iy*nx*nfreq+ix*nfreq+iom].r = tmp.r*cwave[iom].r -
+ tmp.i*cwave[iom].i;
+ cdata[iy*nx*nfreq+ix*nfreq+iom].i = tmp.r*cwave[iom].i +
+ tmp.i*cwave[iom].r;
+ }
+ }
+ else {
+ for (iom = iomin; iom <= iomax; iom++) {
+ cdata[iy*nx*nfreq+ix*nfreq+iom].r = 0.0;
+ cdata[iy*nx*nfreq+ix*nfreq+iom].i = 0.0;
+ }
+ }
+ }
+ }
+
+ }
+ else if (p_vz == 3) { /* Fx source with Vz receivers Fx=1 == p_vz=3 */
+ for (iy = 0; iy < ny; iy++) {
+ for (ix = 0; ix < nx; ix++) {
+ x = xi[iy*nx+ix] - xsrc;
+ y = yi[iy*nx+ix] - ysrc;
+ z = fabs(zi[iy*nx+ix] - zsrc);
+ r = sqrt(x*x + y*y + z*z);
+
+ if (r != 0) phi = acos(z/r);
+ else phi = M_PI/2;
+ phi2 = SGN(x)*phi - (dipx*M_PI/180.0);
+ cosphi = cos(phi2);
+ scl = (z*x*y)/(4.0*r*r*rho);
+ if (fabs(phi) < maxdip*M_PI/180.0) {
+ for (iom = iomin; iom <= iomax; iom++) {
+ om = iom*deltom;
+ kp = om/c;
+ ks = om/cs;
+ H02p.r = kp*kp*j0(kp*r);
+ H02p.i = -kp*kp*y0(kp*r);
+ H12p.r = 2.0*kp*j1(kp*r)/r;
+ H12p.i = -2.0*kp*y1(kp*r)/r;
+
+ H02s.r = ks*ks*j0(ks*r);
+ H02s.i = -ks*ks*y0(ks*r);
+ H12s.r = 2.0*ks*j1(ks*r)/r;
+ H12s.i = -2.0*ks*y1(ks*r)/r;
+
+ tmp.i = (scl/(om*om))*((H02p.r-H12p.r) - (H02s.r-H12s.r));
+ tmp.r = -(scl/(om*om))*((H02p.i-H12p.i) - (H02s.i-H12s.i));
+
+ cdata[iy*nx*nfreq+ix*nfreq+iom].r = tmp.r*cwave[iom].r -
+ tmp.i*cwave[iom].i;
+ cdata[iy*nx*nfreq+ix*nfreq+iom].i = tmp.r*cwave[iom].i +
+ tmp.i*cwave[iom].r;
+ }
+ }
+ else {
+ for (iom = iomin; iom <= iomax; iom++) {
+ cdata[iy*nx*nfreq+ix*nfreq+iom].r = 0.0;
+ cdata[iy*nx*nfreq+ix*nfreq+iom].i = 0.0;
+ }
+ }
+ }
+ }
+
+ }
+
+
+ scl = df;
+ sign = 1;
+ crmfft(&cdata[0], &rdata[0], optn, nx*ny, nfreq, optn, sign);
+ for (iy = 0; iy < ny; iy++) {
+ for (ix = 0; ix < nx; ix++) {
+ for (i = 0; i < nt; i++) {
+ data[iy*nx*nt+ix*nt+i] = scl*rdata[iy*nx*optn+ix*optn+i];
+ }
+ }
+ }
+
+ free(cdata);
+ free(cwave);
+ free(rdata);
+ free(rwave);
+
+ return;
+}
diff --git a/utils/makemod.c b/utils/makemod.c
index d6bfb9782ed83dfbe77ab2b04740e5c539907e85..574c1355e646a5e06b536f5e07ef3174914ca88b 100644
--- a/utils/makemod.c
+++ b/utils/makemod.c
@@ -646,6 +646,7 @@ int main(int argc, char **argv)
float Wsmooth[5][5], C, iC, xx, xz, *dataS, smooth;
int ixi, izi, nxout, nzout;
+ C=0;
sigma = -1.0*log(sigma)/(dx*(powf(0.25*2.0,2.0)));
for(ixi = -2; ixi < 3; ixi++) {
for(izi = -2; izi < 3; izi++) {
diff --git a/utils/makewave.c b/utils/makewave.c
index 286d0a925e2c0c3552f523563e27335796e0abba..329bd46448d2afaf43c7220d6261e610dc8e7518 100644
--- a/utils/makewave.c
+++ b/utils/makewave.c
@@ -17,7 +17,7 @@
#endif
#define NINT(x) ((int)((x)>0.0?(x)+0.5:(x)-0.5))
-void freqwave(float *wave, int nt, float dt, float fp, float fmin, float flef, float frig, float fmax, float t0, float db, int shift, int cm, int cn, char *w, float scale, int scfft, int inverse, float eps, int verbose);
+void freqwave(float *wave, int nt, float dt, float fp, float fmin, float flef, float frig, float fmax, float t0, float db, int shift, int cm, int cn, char *w, float scale, int scfft, int inverse, float eps, float alpha, int verbose);
/*********************** self documentation **********************/
char *sdoc[] = {
@@ -49,6 +49,7 @@ char *sdoc[] = {
" w=g2 ..................... type of wavelet (g2 gives a Ricker Wavelet)",
" inverse=0 ................ compute 1.0/(S(w)+eps)",
" eps=1.0 .................. stabilization in inverse",
+" alpha=0.0 ................ exponential damping factor (alpha<0) for laplace transform",
" verbose=0 ................ silent option; >0 display info",
" ",
" Options for w :",
@@ -82,7 +83,7 @@ int main(int argc, char **argv)
int scfft, inverse;
float dt, fp, fmin, flef, frig, fmax, t0, db;
double ddt;
- float *wavelet, scale, eps;
+ float *wavelet, scale, eps, alpha;
segy *hdrs;
char w[10], *file, *file_out;
@@ -107,6 +108,7 @@ int main(int argc, char **argv)
if(!getparint("shift", &shift)) shift = 0;
if(!getparint("inverse", &inverse)) inverse = 0;
if(!getparfloat("eps", &eps)) eps = 1.0;
+ if(!getparfloat("alpha", &alpha)) alpha = 0.0;
if(!getparfloat("scale", &scale)) scale = 1.0;
if(!getparint("scfft", &scfft)) scfft = 1;
if(!getparint("cm", &cm)) cm = 10;
@@ -121,7 +123,7 @@ int main(int argc, char **argv)
wavelet = (float *)malloc(nt*sizeof(float));
freqwave(wavelet, nt, dt, fp, fmin, flef, frig, fmax,
- t0, db, shift, cm, cn, w, scale, scfft, inverse, eps, verbose);
+ t0, db, shift, cm, cn, w, scale, scfft, inverse, eps, alpha, verbose);
if (file_out==NULL) fpw=stdout;
else fpw = fopen(file_out,"w");
diff --git a/utils/randdf.c b/utils/randdf.c
index dd7cfa01585f76f60a66b44dcf2db4ae69404736..8bf68ea036dfa44b079c51407f6988ce48005299 100644
--- a/utils/randdf.c
+++ b/utils/randdf.c
@@ -18,7 +18,7 @@ void diffraction(float *x, float *z, int nxp, float dx, float dz, float **gridcp
void randdf(float *x, float *z, int nxp, float dx, float dz, float **gridcp, float **gridcs, float **gridro, float **cp, float **cs, float **ro, float *interface, int *zp, int nx, float sizex, float sizez, int ndiff, int diffrwidth, int type)
{
float x0, z0, dsx, dsz;
- int i, rtype;
+ int i, rtype, width;
long lseed;
rtype=type;
@@ -38,10 +38,12 @@ void randdf(float *x, float *z, int nxp, float dx, float dz, float **gridcp, flo
nxp=1;
if (rtype<0) type=NINT(2*drand48());
else type = rtype;
- x[0] = x0 + diffrwidth*dx+drand48()*(dsx-2*diffrwidth*dx);
- z[0] = z0 + diffrwidth*dz+drand48()*(dsz-2*diffrwidth*dz);
+ //width = drand48()*diffrwidth;
+ width = diffrwidth;
+ x[0] = x0 + width*dx+drand48()*(dsx-2*width*dx);
+ z[0] = z0 + width*dz+drand48()*(dsz-2*width*dz);
diffraction(x, z, nxp, dx, dz, gridcp, gridcs, gridro,
- cp, cs, ro, interface, zp, nx, diffrwidth, type);
+ cp, cs, ro, interface, zp, nx, width, type);
}
return;