From 8133dee18f825e29f8986cf99294dde4a7f0265f Mon Sep 17 00:00:00 2001
From: "joeri.brackenhoff" <joeri.brackenhoff@login0.ogun.local>
Date: Thu, 21 Feb 2019 08:42:03 -0300
Subject: [PATCH] 3D
---
fdelmodc3D/3dfd.c | 1221 ++++++++++++
fdelmodc3D/CMWC4096.c | 50 +
fdelmodc3D/FiguresPaper/Figure10.scr | 162 ++
fdelmodc3D/FiguresPaper/Figure10Hom.scr | 141 ++
fdelmodc3D/FiguresPaper/Figure11.scr | 55 +
fdelmodc3D/FiguresPaper/Figure12.scr | 46 +
fdelmodc3D/FiguresPaper/Figure13.scr | 163 ++
fdelmodc3D/FiguresPaper/Figure13Amp.scr | 130 ++
fdelmodc3D/FiguresPaper/Figure14-15.scr | 172 ++
.../FiguresPaper/Figure17_19AppendixA.scr | 92 +
fdelmodc3D/FiguresPaper/Figure2.scr | 104 +
fdelmodc3D/FiguresPaper/Figure20AppendixA.scr | 148 ++
fdelmodc3D/FiguresPaper/Figure3.scr | 106 ++
fdelmodc3D/FiguresPaper/Figure3_nofree.scr | 58 +
fdelmodc3D/FiguresPaper/Figure3_ref.scr | 55 +
fdelmodc3D/FiguresPaper/Figure4.scr | 75 +
fdelmodc3D/FiguresPaper/Figure5.scr | 66 +
fdelmodc3D/FiguresPaper/Figure6.scr | 102 +
fdelmodc3D/FiguresPaper/Figure6f.scr | 59 +
fdelmodc3D/FiguresPaper/Figure6length.scr | 100 +
fdelmodc3D/FiguresPaper/Figure6long.scr | 126 ++
fdelmodc3D/FiguresPaper/Figure7.scr | 98 +
fdelmodc3D/FiguresPaper/Figure7fmax.scr | 76 +
fdelmodc3D/FiguresPaper/Figure7length.scr | 100 +
fdelmodc3D/FiguresPaper/Figure7plane.scr | 95 +
fdelmodc3D/FiguresPaper/Figure8-9.scr | 147 ++
fdelmodc3D/FiguresPaper/Figure8-9Hom.scr | 142 ++
fdelmodc3D/FiguresPaper/FigureCCsources.scr | 69 +
fdelmodc3D/FiguresPaper/FigureDxAppendixA.scr | 138 ++
.../FiguresPaper/FigureGreenAppendixA.scr | 149 ++
.../FiguresPaper/FigureGreenDxAppendixA.scr | 146 ++
fdelmodc3D/FiguresPaper/FigurePres.scr | 128 ++
.../FiguresPaper/FigureSourcesAppendixA.scr | 92 +
fdelmodc3D/FiguresPaper/MakeGifMovie.scr | 48 +
fdelmodc3D/FiguresPaper/README | 140 ++
fdelmodc3D/FiguresPaper/SIrand.scr | 82 +
fdelmodc3D/FiguresPaper/Simple_model_base.scr | 61 +
.../FiguresPaper/Simple_model_sides.scr | 101 +
fdelmodc3D/FiguresPaper/clean | 4 +
fdelmodc3D/FiguresPaper/cross.scr | 33 +
.../FiguresPaper/fdelmodc_amplitude.scr | 72 +
fdelmodc3D/FiguresPaper/fdelmodc_long.scr | 65 +
fdelmodc3D/FiguresPaper/fdelmodc_real.scr | 136 ++
fdelmodc3D/FiguresPaper/normalorg.gnp | 44 +
fdelmodc3D/FiguresPaper/plot.py | 19 +
fdelmodc3D/FiguresPaper/plot3d.gnu | 13 +
fdelmodc3D/Makefile | 88 +
fdelmodc3D/SUsegy.h | 391 ++++
fdelmodc3D/ToDo/acoustic4Block.c | 232 +++
fdelmodc3D/ToDo/acousticPML.c | 225 +++
fdelmodc3D/acoustic2.c | 136 ++
fdelmodc3D/acoustic4.c | 156 ++
fdelmodc3D/acoustic4_qr.c | 281 +++
fdelmodc3D/acoustic6.c | 148 ++
fdelmodc3D/acousticSH4.c | 143 ++
fdelmodc3D/acousticSH4_routine.c | 347 ++++
fdelmodc3D/applySource.c | 343 ++++
fdelmodc3D/atopkge.c | 444 +++++
fdelmodc3D/boundaries.c | 1682 +++++++++++++++++
fdelmodc3D/decomposition.c | 414 ++++
fdelmodc3D/defineSource.c | 373 ++++
fdelmodc3D/defineSource3D.c | 373 ++++
fdelmodc3D/demo/FD_elastic.scr | 167 ++
fdelmodc3D/demo/README | 32 +
fdelmodc3D/demo/RcvTextInput.scr | 16 +
fdelmodc3D/demo/back_injrate_planes.scr | 170 ++
fdelmodc3D/demo/back_injrate_planes_1D.scr | 129 ++
.../demo/back_injrate_planes_1Dlong.scr | 131 ++
fdelmodc3D/demo/benchmark.scr | 40 +
fdelmodc3D/demo/boundaries.scr | 58 +
fdelmodc3D/demo/clean | 4 +
.../demo/compare_green_dtxd_invariant.scr | 204 ++
fdelmodc3D/demo/compare_green_inmanual.scr | 216 +++
fdelmodc3D/demo/decompfree.scr | 66 +
fdelmodc3D/demo/decomposition.scr | 95 +
fdelmodc3D/demo/demoStaircase.scr | 85 +
fdelmodc3D/demo/demo_dissipative.scr | 42 +
fdelmodc3D/demo/demo_multiwave.scr | 64 +
fdelmodc3D/demo/demo_reciprocity.scr | 257 +++
fdelmodc3D/demo/demo_snapshots.scr | 40 +
fdelmodc3D/demo/eps_for_manual.scr | 52 +
.../demo/fdelmodc_acoustic_slanted_cable.sh | 168 ++
fdelmodc3D/demo/fdelmodc_circ.scr | 78 +
fdelmodc3D/demo/fdelmodc_circ_medium.scr | 93 +
fdelmodc3D/demo/fdelmodc_doublecouple.scr | 59 +
.../demo/fdelmodc_elastic_potentialS.scr | 63 +
fdelmodc3D/demo/fdelmodc_fault.scr | 48 +
fdelmodc3D/demo/fdelmodc_glacier.scr | 69 +
fdelmodc3D/demo/fdelmodc_jurg.scr | 55 +
fdelmodc3D/demo/fdelmodc_multishot.scr | 66 +
fdelmodc3D/demo/fdelmodc_obc.scr | 84 +
fdelmodc3D/demo/fdelmodc_obc_deltares.scr | 65 +
fdelmodc3D/demo/fdelmodc_plane.scr | 95 +
fdelmodc3D/demo/fdelmodc_plane_txt.scr | 98 +
fdelmodc3D/demo/fdelmodc_pml.scr | 54 +
fdelmodc3D/demo/fdelmodc_pmltest.scr | 52 +
fdelmodc3D/demo/fdelmodc_rand.scr | 56 +
fdelmodc3D/demo/fdelmodc_sourcepos.scr | 172 ++
fdelmodc3D/demo/fdelmodc_srcrec.scr | 120 ++
fdelmodc3D/demo/fdelmodc_stab.scr | 145 ++
fdelmodc3D/demo/fdelmodc_taper.scr | 119 ++
fdelmodc3D/demo/fdelmodc_topography.scr | 80 +
fdelmodc3D/demo/fdelmodc_visco.scr | 109 ++
fdelmodc3D/demo/freesurfaceP.scr | 88 +
fdelmodc3D/demo/freesurfaceVz.scr | 88 +
fdelmodc3D/demo/green_multiwave.scr | 42 +
fdelmodc3D/demo/interpolate_wave.scr | 38 +
fdelmodc3D/demo/matlab/FD_matlab_interface.m | 97 +
fdelmodc3D/demo/matlab/FD_mod_grid.m | 138 ++
fdelmodc3D/demo/matlab/ForwardCircle.m | 152 ++
fdelmodc3D/demo/matlab/comparison.m | 83 +
.../demo/matlab/test_matlab_interface.m | 47 +
fdelmodc3D/demo/migrFundamentals.scr | 165 ++
fdelmodc3D/demo/migrFundamentalsl2.scr | 165 ++
fdelmodc3D/demo/model.scr | 52 +
fdelmodc3D/demo/modelOilGas.scr | 97 +
fdelmodc3D/demo/modelOilGas.scr.ok | 95 +
fdelmodc3D/demo/model_flank.scr | 22 +
fdelmodc3D/demo/modelall.scr | 74 +
fdelmodc3D/demo/modelfast1d.scr | 46 +
fdelmodc3D/demo/modelhom.scr | 205 ++
fdelmodc3D/demo/modelling | 213 +++
fdelmodc3D/demo/staal.scr | 20 +
fdelmodc3D/demo/test2.scr | 49 +
fdelmodc3D/demo/testFreeSurface.scr | 48 +
fdelmodc3D/demo/test_free_elastic.scr | 95 +
fdelmodc3D/demo/virtualshot.scr | 53 +
fdelmodc3D/demo/vsp.scr | 82 +
fdelmodc3D/depthDiff.c | 307 +++
fdelmodc3D/docpkge.c | 188 ++
fdelmodc3D/elastic4.c | 158 ++
fdelmodc3D/elastic4dc.c | 160 ++
fdelmodc3D/elastic6.c | 182 ++
fdelmodc3D/fdelmodc.c | 743 ++++++++
fdelmodc3D/fdelmodc.h | 190 ++
fdelmodc3D/fdelmodc3D.c | 766 ++++++++
fdelmodc3D/fdelmodc3D.h | 226 +++
fdelmodc3D/fileOpen.c | 48 +
fdelmodc3D/gaussGen.c | 45 +
fdelmodc3D/getBeamTimes.c | 196 ++
fdelmodc3D/getModelInfo.c | 109 ++
fdelmodc3D/getModelInfo3D.c | 127 ++
fdelmodc3D/getParameters.c | 1247 ++++++++++++
fdelmodc3D/getParameters3D.c | 1275 +++++++++++++
fdelmodc3D/getRecTimes.c | 307 +++
fdelmodc3D/getWaveletHeaders.c | 52 +
fdelmodc3D/getWaveletHeaders3D.c | 53 +
fdelmodc3D/getWaveletInfo.c | 138 ++
fdelmodc3D/getWaveletInfo3D.c | 138 ++
fdelmodc3D/getpars.c | 732 +++++++
fdelmodc3D/name_ext.c | 44 +
fdelmodc3D/par.h | 217 +++
fdelmodc3D/readModel.c | 792 ++++++++
fdelmodc3D/readModel3D.c | 1283 +++++++++++++
fdelmodc3D/recvPar.c | 519 +++++
fdelmodc3D/recvPar3D.c | 626 ++++++
fdelmodc3D/replacetab.scr | 3 +
fdelmodc3D/segy.h | 849 +++++++++
fdelmodc3D/sourceOnSurface.c | 498 +++++
fdelmodc3D/sourceOnSurface3D.c | 565 ++++++
fdelmodc3D/spline3.c | 34 +
fdelmodc3D/threadAffinity.c | 109 ++
fdelmodc3D/verbosepkg.c | 77 +
fdelmodc3D/viscoacoustic4.c | 175 ++
fdelmodc3D/viscoelastic4.c | 244 +++
fdelmodc3D/wallclock_time.c | 33 +
fdelmodc3D/writeRec.c | 226 +++
fdelmodc3D/writeSnapTimes.c | 211 +++
fdelmodc3D/writeSrcRecPos.c | 141 ++
fdelmodc3D/writesufile.c | 169 ++
marchenko3D/ampest3D.c | 308 +++
marchenko3D/ampest3D2.c | 94 +
marchenko3D/synthesis3Dotavia.c | 319 ++++
marchenko3D/writeData3D.c | 28 +
174 files changed, 32226 insertions(+)
create mode 100644 fdelmodc3D/3dfd.c
create mode 100644 fdelmodc3D/CMWC4096.c
create mode 100755 fdelmodc3D/FiguresPaper/Figure10.scr
create mode 100755 fdelmodc3D/FiguresPaper/Figure10Hom.scr
create mode 100755 fdelmodc3D/FiguresPaper/Figure11.scr
create mode 100755 fdelmodc3D/FiguresPaper/Figure12.scr
create mode 100755 fdelmodc3D/FiguresPaper/Figure13.scr
create mode 100755 fdelmodc3D/FiguresPaper/Figure13Amp.scr
create mode 100755 fdelmodc3D/FiguresPaper/Figure14-15.scr
create mode 100755 fdelmodc3D/FiguresPaper/Figure17_19AppendixA.scr
create mode 100755 fdelmodc3D/FiguresPaper/Figure2.scr
create mode 100755 fdelmodc3D/FiguresPaper/Figure20AppendixA.scr
create mode 100755 fdelmodc3D/FiguresPaper/Figure3.scr
create mode 100755 fdelmodc3D/FiguresPaper/Figure3_nofree.scr
create mode 100755 fdelmodc3D/FiguresPaper/Figure3_ref.scr
create mode 100755 fdelmodc3D/FiguresPaper/Figure4.scr
create mode 100755 fdelmodc3D/FiguresPaper/Figure5.scr
create mode 100755 fdelmodc3D/FiguresPaper/Figure6.scr
create mode 100755 fdelmodc3D/FiguresPaper/Figure6f.scr
create mode 100755 fdelmodc3D/FiguresPaper/Figure6length.scr
create mode 100755 fdelmodc3D/FiguresPaper/Figure6long.scr
create mode 100755 fdelmodc3D/FiguresPaper/Figure7.scr
create mode 100755 fdelmodc3D/FiguresPaper/Figure7fmax.scr
create mode 100755 fdelmodc3D/FiguresPaper/Figure7length.scr
create mode 100755 fdelmodc3D/FiguresPaper/Figure7plane.scr
create mode 100755 fdelmodc3D/FiguresPaper/Figure8-9.scr
create mode 100755 fdelmodc3D/FiguresPaper/Figure8-9Hom.scr
create mode 100755 fdelmodc3D/FiguresPaper/FigureCCsources.scr
create mode 100755 fdelmodc3D/FiguresPaper/FigureDxAppendixA.scr
create mode 100755 fdelmodc3D/FiguresPaper/FigureGreenAppendixA.scr
create mode 100755 fdelmodc3D/FiguresPaper/FigureGreenDxAppendixA.scr
create mode 100755 fdelmodc3D/FiguresPaper/FigurePres.scr
create mode 100755 fdelmodc3D/FiguresPaper/FigureSourcesAppendixA.scr
create mode 100755 fdelmodc3D/FiguresPaper/MakeGifMovie.scr
create mode 100644 fdelmodc3D/FiguresPaper/README
create mode 100755 fdelmodc3D/FiguresPaper/SIrand.scr
create mode 100755 fdelmodc3D/FiguresPaper/Simple_model_base.scr
create mode 100755 fdelmodc3D/FiguresPaper/Simple_model_sides.scr
create mode 100755 fdelmodc3D/FiguresPaper/clean
create mode 100755 fdelmodc3D/FiguresPaper/cross.scr
create mode 100755 fdelmodc3D/FiguresPaper/fdelmodc_amplitude.scr
create mode 100755 fdelmodc3D/FiguresPaper/fdelmodc_long.scr
create mode 100755 fdelmodc3D/FiguresPaper/fdelmodc_real.scr
create mode 100644 fdelmodc3D/FiguresPaper/normalorg.gnp
create mode 100644 fdelmodc3D/FiguresPaper/plot.py
create mode 100644 fdelmodc3D/FiguresPaper/plot3d.gnu
create mode 100644 fdelmodc3D/Makefile
create mode 100644 fdelmodc3D/SUsegy.h
create mode 100644 fdelmodc3D/ToDo/acoustic4Block.c
create mode 100644 fdelmodc3D/ToDo/acousticPML.c
create mode 100644 fdelmodc3D/acoustic2.c
create mode 100644 fdelmodc3D/acoustic4.c
create mode 100644 fdelmodc3D/acoustic4_qr.c
create mode 100644 fdelmodc3D/acoustic6.c
create mode 100644 fdelmodc3D/acousticSH4.c
create mode 100644 fdelmodc3D/acousticSH4_routine.c
create mode 100644 fdelmodc3D/applySource.c
create mode 100644 fdelmodc3D/atopkge.c
create mode 100644 fdelmodc3D/boundaries.c
create mode 100644 fdelmodc3D/decomposition.c
create mode 100644 fdelmodc3D/defineSource.c
create mode 100644 fdelmodc3D/defineSource3D.c
create mode 100755 fdelmodc3D/demo/FD_elastic.scr
create mode 100644 fdelmodc3D/demo/README
create mode 100755 fdelmodc3D/demo/RcvTextInput.scr
create mode 100755 fdelmodc3D/demo/back_injrate_planes.scr
create mode 100755 fdelmodc3D/demo/back_injrate_planes_1D.scr
create mode 100755 fdelmodc3D/demo/back_injrate_planes_1Dlong.scr
create mode 100755 fdelmodc3D/demo/benchmark.scr
create mode 100755 fdelmodc3D/demo/boundaries.scr
create mode 100755 fdelmodc3D/demo/clean
create mode 100755 fdelmodc3D/demo/compare_green_dtxd_invariant.scr
create mode 100755 fdelmodc3D/demo/compare_green_inmanual.scr
create mode 100755 fdelmodc3D/demo/decompfree.scr
create mode 100755 fdelmodc3D/demo/decomposition.scr
create mode 100755 fdelmodc3D/demo/demoStaircase.scr
create mode 100755 fdelmodc3D/demo/demo_dissipative.scr
create mode 100755 fdelmodc3D/demo/demo_multiwave.scr
create mode 100755 fdelmodc3D/demo/demo_reciprocity.scr
create mode 100755 fdelmodc3D/demo/demo_snapshots.scr
create mode 100755 fdelmodc3D/demo/eps_for_manual.scr
create mode 100755 fdelmodc3D/demo/fdelmodc_acoustic_slanted_cable.sh
create mode 100755 fdelmodc3D/demo/fdelmodc_circ.scr
create mode 100755 fdelmodc3D/demo/fdelmodc_circ_medium.scr
create mode 100755 fdelmodc3D/demo/fdelmodc_doublecouple.scr
create mode 100755 fdelmodc3D/demo/fdelmodc_elastic_potentialS.scr
create mode 100755 fdelmodc3D/demo/fdelmodc_fault.scr
create mode 100755 fdelmodc3D/demo/fdelmodc_glacier.scr
create mode 100755 fdelmodc3D/demo/fdelmodc_jurg.scr
create mode 100755 fdelmodc3D/demo/fdelmodc_multishot.scr
create mode 100755 fdelmodc3D/demo/fdelmodc_obc.scr
create mode 100755 fdelmodc3D/demo/fdelmodc_obc_deltares.scr
create mode 100755 fdelmodc3D/demo/fdelmodc_plane.scr
create mode 100755 fdelmodc3D/demo/fdelmodc_plane_txt.scr
create mode 100755 fdelmodc3D/demo/fdelmodc_pml.scr
create mode 100755 fdelmodc3D/demo/fdelmodc_pmltest.scr
create mode 100755 fdelmodc3D/demo/fdelmodc_rand.scr
create mode 100755 fdelmodc3D/demo/fdelmodc_sourcepos.scr
create mode 100755 fdelmodc3D/demo/fdelmodc_srcrec.scr
create mode 100755 fdelmodc3D/demo/fdelmodc_stab.scr
create mode 100755 fdelmodc3D/demo/fdelmodc_taper.scr
create mode 100755 fdelmodc3D/demo/fdelmodc_topography.scr
create mode 100755 fdelmodc3D/demo/fdelmodc_visco.scr
create mode 100755 fdelmodc3D/demo/freesurfaceP.scr
create mode 100755 fdelmodc3D/demo/freesurfaceVz.scr
create mode 100755 fdelmodc3D/demo/green_multiwave.scr
create mode 100755 fdelmodc3D/demo/interpolate_wave.scr
create mode 100644 fdelmodc3D/demo/matlab/FD_matlab_interface.m
create mode 100644 fdelmodc3D/demo/matlab/FD_mod_grid.m
create mode 100644 fdelmodc3D/demo/matlab/ForwardCircle.m
create mode 100644 fdelmodc3D/demo/matlab/comparison.m
create mode 100644 fdelmodc3D/demo/matlab/test_matlab_interface.m
create mode 100755 fdelmodc3D/demo/migrFundamentals.scr
create mode 100755 fdelmodc3D/demo/migrFundamentalsl2.scr
create mode 100755 fdelmodc3D/demo/model.scr
create mode 100755 fdelmodc3D/demo/modelOilGas.scr
create mode 100755 fdelmodc3D/demo/modelOilGas.scr.ok
create mode 100755 fdelmodc3D/demo/model_flank.scr
create mode 100755 fdelmodc3D/demo/modelall.scr
create mode 100755 fdelmodc3D/demo/modelfast1d.scr
create mode 100755 fdelmodc3D/demo/modelhom.scr
create mode 100755 fdelmodc3D/demo/modelling
create mode 100755 fdelmodc3D/demo/staal.scr
create mode 100755 fdelmodc3D/demo/test2.scr
create mode 100755 fdelmodc3D/demo/testFreeSurface.scr
create mode 100755 fdelmodc3D/demo/test_free_elastic.scr
create mode 100755 fdelmodc3D/demo/virtualshot.scr
create mode 100755 fdelmodc3D/demo/vsp.scr
create mode 100644 fdelmodc3D/depthDiff.c
create mode 100644 fdelmodc3D/docpkge.c
create mode 100644 fdelmodc3D/elastic4.c
create mode 100644 fdelmodc3D/elastic4dc.c
create mode 100644 fdelmodc3D/elastic6.c
create mode 100644 fdelmodc3D/fdelmodc.c
create mode 100644 fdelmodc3D/fdelmodc.h
create mode 100644 fdelmodc3D/fdelmodc3D.c
create mode 100644 fdelmodc3D/fdelmodc3D.h
create mode 100644 fdelmodc3D/fileOpen.c
create mode 100644 fdelmodc3D/gaussGen.c
create mode 100644 fdelmodc3D/getBeamTimes.c
create mode 100644 fdelmodc3D/getModelInfo.c
create mode 100644 fdelmodc3D/getModelInfo3D.c
create mode 100644 fdelmodc3D/getParameters.c
create mode 100644 fdelmodc3D/getParameters3D.c
create mode 100644 fdelmodc3D/getRecTimes.c
create mode 100644 fdelmodc3D/getWaveletHeaders.c
create mode 100644 fdelmodc3D/getWaveletHeaders3D.c
create mode 100644 fdelmodc3D/getWaveletInfo.c
create mode 100644 fdelmodc3D/getWaveletInfo3D.c
create mode 100644 fdelmodc3D/getpars.c
create mode 100644 fdelmodc3D/name_ext.c
create mode 100644 fdelmodc3D/par.h
create mode 100644 fdelmodc3D/readModel.c
create mode 100644 fdelmodc3D/readModel3D.c
create mode 100644 fdelmodc3D/recvPar.c
create mode 100644 fdelmodc3D/recvPar3D.c
create mode 100755 fdelmodc3D/replacetab.scr
create mode 100644 fdelmodc3D/segy.h
create mode 100644 fdelmodc3D/sourceOnSurface.c
create mode 100644 fdelmodc3D/sourceOnSurface3D.c
create mode 100644 fdelmodc3D/spline3.c
create mode 100644 fdelmodc3D/threadAffinity.c
create mode 100644 fdelmodc3D/verbosepkg.c
create mode 100644 fdelmodc3D/viscoacoustic4.c
create mode 100644 fdelmodc3D/viscoelastic4.c
create mode 100644 fdelmodc3D/wallclock_time.c
create mode 100644 fdelmodc3D/writeRec.c
create mode 100644 fdelmodc3D/writeSnapTimes.c
create mode 100644 fdelmodc3D/writeSrcRecPos.c
create mode 100644 fdelmodc3D/writesufile.c
create mode 100644 marchenko3D/ampest3D.c
create mode 100644 marchenko3D/ampest3D2.c
create mode 100644 marchenko3D/synthesis3Dotavia.c
create mode 100644 marchenko3D/writeData3D.c
diff --git a/fdelmodc3D/3dfd.c b/fdelmodc3D/3dfd.c
new file mode 100644
index 0000000..bfda4b5
--- /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 0000000..69ab1fe
--- /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 0000000..e668e4b
--- /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 0000000..0946199
--- /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 0000000..73bb58c
--- /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 0000000..8b74e13
--- /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 0000000..e7a7d10
--- /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 0000000..717233b
--- /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 0000000..74d1f37
--- /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 0000000..5a3207c
--- /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 0000000..c05fc2c
--- /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 0000000..bf5e23a
--- /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 0000000..1845fe6
--- /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 0000000..51083b3
--- /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 0000000..442210c
--- /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 0000000..991f075
--- /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 0000000..414a6d4
--- /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 0000000..0f241a7
--- /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 0000000..0953973
--- /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 0000000..20d299b
--- /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 0000000..a51cc1f
--- /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 0000000..f4214fd
--- /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 0000000..141d497
--- /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 0000000..b0da0c4
--- /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 0000000..fe52b82
--- /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 0000000..db6b97a
--- /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 0000000..fb3a419
--- /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 0000000..8bfccfa
--- /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 0000000..e6c9e71
--- /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 0000000..45b1d89
--- /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 0000000..4c416c7
--- /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 0000000..f58d727
--- /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 0000000..a415f89
--- /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 0000000..886b985
--- /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 0000000..f2d2aa5
--- /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 0000000..ec7f7d5
--- /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 0000000..22bb354
--- /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 0000000..1e1fa4a
--- /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 0000000..085f055
--- /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 0000000..37473bf
--- /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 0000000..e77369d
--- /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 0000000..db6a321
--- /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 0000000..2106b98
--- /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 0000000..04843f3
--- /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 0000000..61ebf31
--- /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 0000000..ce37661
--- /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 0000000..c1820c9
--- /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 0000000..a9133b9
--- /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 0000000..0ba6ed9
--- /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 0000000..40ca117
--- /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 0000000..32fa4b2
--- /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 0000000..9e5d95f
--- /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 0000000..53da61c
--- /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 0000000..b1204fd
--- /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 0000000..481de47
--- /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 0000000..11513f4
--- /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 0000000..bf0d38e
--- /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 0000000..ef0b218
--- /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 0000000..ffda5cf
--- /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 0000000..130d52f
--- /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 0000000..bc9059c
--- /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 0000000..01cc29b
--- /dev/null
+++ b/fdelmodc3D/defineSource3D.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 "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 */
+
+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/demo/FD_elastic.scr b/fdelmodc3D/demo/FD_elastic.scr
new file mode 100755
index 0000000..31ab0ca
--- /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 0000000..99732f8
--- /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 0000000..84a66f2
--- /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 0000000..a6411e8
--- /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 0000000..8b27f35
--- /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 0000000..a0d7341
--- /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 0000000..e176dfc
--- /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 0000000..e478661
--- /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 0000000..085f055
--- /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 0000000..2433c40
--- /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 0000000..aeb0d2d
--- /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 0000000..070c3fe
--- /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 0000000..384422d
--- /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 0000000..4fd328a
--- /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 0000000..f26bca9
--- /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 0000000..ca04548
--- /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 0000000..071fe4f
--- /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 0000000..5045197
--- /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 0000000..7dde0dc
--- /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 0000000..57e02bd
--- /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 0000000..8cecff0
--- /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 0000000..390e4d5
--- /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 0000000..ffea7d4
--- /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 0000000..4c7bb8a
--- /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 0000000..e2d0641
--- /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 0000000..04e3158
--- /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 0000000..5373537
--- /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 0000000..f569c47
--- /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 0000000..057d5b9
--- /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 0000000..ef67ce4
--- /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 0000000..cf4f133
--- /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 0000000..d2d687b
--- /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 0000000..50c3d96
--- /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 0000000..3e42882
--- /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 0000000..97df961
--- /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 0000000..37b6a90
--- /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 0000000..9412842
--- /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 0000000..d43c57e
--- /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 0000000..cdb8aed
--- /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 0000000..55d289e
--- /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 0000000..ecdcbb7
--- /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 0000000..bbe902a
--- /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 0000000..41e8ab4
--- /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 0000000..52b21ed
--- /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 0000000..6112429
--- /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 0000000..da2ff4e
--- /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 0000000..fcc86b9
--- /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 0000000..dd67cc7
--- /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 0000000..796e681
--- /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 0000000..7046233
--- /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 0000000..8d3d377
--- /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 0000000..77493c4
--- /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 0000000..e7702dc
--- /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 0000000..5fa2690
--- /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 0000000..89907c0
--- /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 0000000..82ebafc
--- /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 0000000..b8678a8
--- /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 0000000..29ffc91
--- /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 0000000..4d6585f
--- /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 0000000..ec8e999
--- /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 0000000..a99d0a5
--- /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 0000000..6694fae
--- /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 0000000..d459131
--- /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 0000000..6e72ed5
--- /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 0000000..1e89a56
--- /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 0000000..4e4c793
--- /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 0000000..e9c181c
--- /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 0000000..a74b4c3
--- /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 0000000..bfaee6e
--- /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 0000000..d119cfb
--- /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 0000000..00aaf56
--- /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 0000000..17fcb9f
--- /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 0000000..ed07c68
--- /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 0000000..5598498
--- /dev/null
+++ b/fdelmodc3D/fdelmodc3D.c
@@ -0,0 +1,766 @@
+#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 defineSource(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",
+//" 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 ",
+" 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)",
+//" max_nrec=15000 .... maximum number of receivers", not needed anymore
+" 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",
+//" 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_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, 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;
+ 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);
+ }
+ }
+
+ 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/fdelmodc3D.h b/fdelmodc3D/fdelmodc3D.h
new file mode 100644
index 0000000..76b0501
--- /dev/null
+++ b/fdelmodc3D/fdelmodc3D.h
@@ -0,0 +1,226 @@
+#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;
+ 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 0000000..b0ff806
--- /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 0000000..3082202
--- /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 0000000..ae5cff4
--- /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 0000000..378a1b5
--- /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 0000000..894223c
--- /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 0000000..5cec11b
--- /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 0000000..701269b
--- /dev/null
+++ b/fdelmodc3D/getParameters3D.c
@@ -0,0 +1,1275 @@
+#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;
+ 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));
+ 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));
+ }
+ }
+ }
+
+ /* 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 0000000..13947e4
--- /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 0000000..5bff375
--- /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 0000000..3e62faa
--- /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 0000000..2f3734a
--- /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 0000000..17e66d9
--- /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 0000000..5099c58
--- /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 0000000..8fa1e09
--- /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 0000000..fce76ed
--- /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 0000000..a3975ef
--- /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 0000000..cd3ce58
--- /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 0000000..7509bf6
--- /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 0000000..7f4e91a
--- /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 0000000..48fc0b5
--- /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 0000000..d0a0d76
--- /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 0000000..a2062dc
--- /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 0000000..7ddefd7
--- /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 0000000..2457bf1
--- /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 0000000..bd9913c
--- /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 0000000..483e5f9
--- /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 0000000..63207c7
--- /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 0000000..865aa12
--- /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 0000000..1e75530
--- /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 0000000..982cc6b
--- /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 0000000..dc05bea
--- /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 0000000..c9cec66
--- /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 0000000..71f7f3f
--- /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/marchenko3D/ampest3D.c b/marchenko3D/ampest3D.c
new file mode 100644
index 0000000..820c720
--- /dev/null
+++ b/marchenko3D/ampest3D.c
@@ -0,0 +1,308 @@
+#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 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, *wavelet, *scaled, *conv, *f1dsamp;
+ float dtm, dxm, cpm, rom, *trace;
+ FILE *fp_wav;
+ segy *hdrs_wav;
+
+ scl = dx*dy;
+ sclt = 1.0*dt/((float)ntfft);
+
+ conv = (float *)calloc(nys*nxs*ntfft,sizeof(float));
+ wavelet = (float *)calloc(ntfft,sizeof(float));
+ scaled = (float *)calloc(ntfft,sizeof(float));
+ f1dsamp = (float *)calloc(nys*nxs*ntfft,sizeof(float));
+
+ for (i=0; i<npos; i++) {
+ ix = ixpos[i];
+ for (iw=0; iw<ntfft; iw++) {
+ f1dsamp[i*ntfft+iw] = f1d[l*nxs*nys*ntfft+ix*ntfft+iw];
+ }
+ }
+
+ if (file_wav==NULL){
+ corr(f1dsamp, f1dsamp, conv, nxs*nys, ntfft, dt, 0);
+ for (i=0; i<nxs*nys; i++) {
+ for (iw=0; iw<ntfft; iw++) {
+ wavelet[iw] += scl*conv[i*ntfft+iw];
+ }
+ }
+ }
+ else {
+ trace = (float *)calloc(ntfft,sizeof(float));
+ hdrs_wav = (segy *)calloc(1, sizeof(segy));
+ fp_wav = fopen(file_wav, "r");
+ readData3D(fp_wav, trace, hdrs_wav, 0);
+ fclose(fp_wav);
+ corr(trace, trace, wavelet, 1, ntfft, dt, 0);
+ free(hdrs_wav); free(trace);
+
+ if (!getparfloat("dtm", &dtm)) dtm = 0.004;
+ if (!getparfloat("dxm", &dxm)) dxm = 1.0;
+ if (!getparfloat("cpm", &cpm)) cpm = 1000.0;
+ if (!getparfloat("rom", &rom)) rom = 1000.0;
+
+ vmess("dtm:%f dxm:%f cpm:%f rom:%f",dtm,dxm,cpm,rom);
+
+ /* For a monopole source the scaling is (2.0*dt*cp*cp*rho)/(dx*dx) */
+ for (iw=0; iw<ntfft; iw++){
+ wavelet[iw] *= dt*(2.0*dtm*cpm*cpm*rom)/(dx*dx);
+ }
+ }
+
+ for (l=0; l<Nfoc; l++) {
+ memset(&conv[0],0.0, sizeof(float)*ntfft*nxs*nys);
+ convol(f1dsamp, &Gd[l*nxs*nys*ntfft], conv, nxs*nys, ntfft, dt, 0);
+ for (i=0; i<nxs*nys; i++) {
+ for (iw=0; iw<ntfft; iw++) {
+ scaled[iw] += dt*scl*conv[i*ntfft+iw];
+ }
+ }
+ ampest[l] = (wavelet[0]/scaled[0]);
+ vmess("wavelet[0]=%f scaled[0]=%f",wavelet[0],scaled[0]);
+ memset(&conv[0],0.0, sizeof(float)*ntfft*nxs*nys);
+ memset(&wavelet[0],0.0, sizeof(float)*ntfft);
+ memset(&scaled[0],0.0, sizeof(float)*ntfft);
+ }
+ free(wavelet);free(scaled);free(conv);free(f1dsamp);
+
+ return;
+}
+
+long maxest3D(float *data, long nt)
+{
+ float maxt;
+ long it;
+
+ maxt = data[0];
+ for (it = 0; it < nt; it++) {
+ if (fabs(data[it]) > fabs(maxt)) maxt=data[it];
+ }
+
+ return maxt;
+}
+
+/**
+* Calculates the time convolution of two arrays by
+* transforming the arrayis to frequency domain,
+* 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];
+ }
+}
\ No newline at end of file
diff --git a/marchenko3D/ampest3D2.c b/marchenko3D/ampest3D2.c
new file mode 100644
index 0000000..db7dbac
--- /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/synthesis3Dotavia.c b/marchenko3D/synthesis3Dotavia.c
new file mode 100644
index 0000000..4e4812e
--- /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/writeData3D.c b/marchenko3D/writeData3D.c
new file mode 100644
index 0000000..d8c3e47
--- /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;
+}
+
--
GitLab