[cig-commits] r15926 - in seismo/3D/CPML/tags: . v1.1.1
dkomati1 at geodynamics.org
dkomati1 at geodynamics.org
Tue Nov 3 13:35:51 PST 2009
Author: dkomati1
Date: 2009-11-03 13:35:50 -0800 (Tue, 03 Nov 2009)
New Revision: 15926
Added:
seismo/3D/CPML/tags/v1.1.1/
seismo/3D/CPML/tags/v1.1.1/Makefile
seismo/3D/CPML/tags/v1.1.1/README_seismic_cpml.html
seismo/3D/CPML/tags/v1.1.1/letter_CeCILL_SEISMIC_CPML.pdf
seismo/3D/CPML/tags/v1.1.1/seismic_CPML_2D_anisotropic.f90
seismo/3D/CPML/tags/v1.1.1/seismic_CPML_2D_isotropic_fourth_order.f90
seismo/3D/CPML/tags/v1.1.1/seismic_CPML_2D_isotropic_second_order.f90
seismo/3D/CPML/tags/v1.1.1/seismic_CPML_2D_poroelastic_fourth_order.f90
seismo/3D/CPML/tags/v1.1.1/seismic_CPML_3D_isotropic_MPI_OpenMP.f90
seismo/3D/CPML/tags/v1.1.1/seismic_CPML_3D_viscoelastic_MPI.f90
seismo/3D/CPML/tags/v1.1.1/seismic_PML_Collino_2D_isotropic.f90
seismo/3D/CPML/tags/v1.1.1/seismic_PML_Collino_3D_isotropic_OpenMP.f90
Log:
created tags/v1.1.1
Added: seismo/3D/CPML/tags/v1.1.1/Makefile
===================================================================
--- seismo/3D/CPML/tags/v1.1.1/Makefile (rev 0)
+++ seismo/3D/CPML/tags/v1.1.1/Makefile 2009-11-03 21:35:50 UTC (rev 15926)
@@ -0,0 +1,70 @@
+#
+# Makefile for SEISMIC_CPML Version 1.1.1, November 2009.
+# Dimitri Komatitsch
+# Universite de Pau et des Pays de l'Adour, CNRS and INRIA, France
+#
+SHELL=/bin/sh
+
+O = obj
+
+# the MEDIUM_MEMORY flag is for large 3D runs, which need more than 2 GB of memory
+
+# Portland
+#F90 = pgf90
+#MPIF90 = mpif90
+#FLAGS = -fast -Mnobounds -Minline -Mneginfo -Mdclchk -Knoieee -Minform=warn -fastsse -tp amd64e -Msmart
+#MEDIUM_MEMORY = -mcmodel=medium
+#OPEN_MP = -mp
+
+# Intel (leave option -ftz, which is *critical* for performance)
+#F90 = ifort
+#MPIF90 = mpif90
+#FLAGS = -O3 -xP -vec-report0 -implicitnone -warn truncated_source -warn argument_checking -warn unused -warn declarations -warn alignments -warn ignore_loc -warn usage -check nobounds -fpe3 -ftz
+#MEDIUM_MEMORY = -mcmodel=medium
+#OPEN_MP = -openmp -openmp-report1
+
+# IBM xlf
+#F90 = xlf_r
+#MPIF90 = mpxlf_r
+#FLAGS = -O3 -qfree=f90 -qhalt=w -qsave
+#MEDIUM_MEMORY =
+#OPEN_MP = -qsmp=omp
+
+# GNU gfortran
+F90 = gfortran
+MPIF90 = mpif90
+FLAGS = -std=f2003 -fimplicit-none -frange-check -O3 -fmax-errors=10 -pedantic -pedantic-errors -Waliasing -Wampersand -Wcharacter-truncation -Wline-truncation -Wsurprising -Wno-tabs -Wunderflow -fno-trapping-math
+MEDIUM_MEMORY = -mcmodel=medium
+OPEN_MP = -fopenmp
+
+default: clean seismic_CPML_2D_isotropic_second_order seismic_CPML_2D_isotropic_fourth_order seismic_CPML_2D_anisotropic seismic_PML_Collino_2D_isotropic seismic_PML_Collino_3D_isotropic_OpenMP seismic_CPML_3D_isotropic_MPI_OpenMP seismic_CPML_2D_poroelastic_fourth_order seismic_CPML_3D_viscoelastic_MPI
+
+all: default
+
+clean:
+ /bin/rm -f *.o xseismic_CPML_2D_isotropic_second_order xseismic_CPML_2D_isotropic_fourth_order xseismic_CPML_2D_anisotropic xseismic_PML_Collino_2D_isotropic xseismic_CPML_3D_isotropic_MPI_OpenMP xseismic_PML_Collino_3D_isotropic_OpenMP xseismic_CPML_2D_poroelastic_fourth_order xseismic_CPML_3D_viscoelastic_MPI
+
+seismic_CPML_2D_poroelastic_fourth_order:
+ $(F90) $(FLAGS) -o xseismic_CPML_2D_poroelastic_fourth_order seismic_CPML_2D_poroelastic_fourth_order.f90
+
+seismic_CPML_2D_isotropic_second_order:
+ $(F90) $(FLAGS) -o xseismic_CPML_2D_isotropic_second_order seismic_CPML_2D_isotropic_second_order.f90
+
+seismic_CPML_2D_isotropic_fourth_order:
+ $(F90) $(FLAGS) -o xseismic_CPML_2D_isotropic_fourth_order seismic_CPML_2D_isotropic_fourth_order.f90
+
+seismic_CPML_2D_anisotropic:
+ $(F90) $(FLAGS) -o xseismic_CPML_2D_anisotropic seismic_CPML_2D_anisotropic.f90
+
+seismic_PML_Collino_2D_isotropic:
+ $(F90) $(FLAGS) -o xseismic_PML_Collino_2D_isotropic seismic_PML_Collino_2D_isotropic.f90
+
+seismic_PML_Collino_3D_isotropic_OpenMP:
+ $(F90) $(FLAGS) $(MEDIUM_MEMORY) $(OPEN_MP) -o xseismic_PML_Collino_3D_isotropic_OpenMP seismic_PML_Collino_3D_isotropic_OpenMP.f90
+
+seismic_CPML_3D_isotropic_MPI_OpenMP:
+ $(MPIF90) $(FLAGS) $(MEDIUM_MEMORY) $(OPEN_MP) -o xseismic_CPML_3D_isotropic_MPI_OpenMP seismic_CPML_3D_isotropic_MPI_OpenMP.f90
+
+seismic_CPML_3D_viscoelastic_MPI:
+ $(MPIF90) $(FLAGS) $(MEDIUM_MEMORY) $(OPEN_MP) -o xseismic_CPML_3D_viscoelastic_MPI seismic_CPML_3D_viscoelastic_MPI.f90
+
Added: seismo/3D/CPML/tags/v1.1.1/README_seismic_cpml.html
===================================================================
--- seismo/3D/CPML/tags/v1.1.1/README_seismic_cpml.html (rev 0)
+++ seismo/3D/CPML/tags/v1.1.1/README_seismic_cpml.html 2009-11-03 21:35:50 UTC (rev 15926)
@@ -0,0 +1,191 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
+<HTML>
+<HEAD>
+ <META HTTP-EQUIV="CONTENT-TYPE" CONTENT="text/html; charset=utf-8">
+ <TITLE>The SEISMIC_CPML software package</TITLE>
+ <META NAME="GENERATOR" CONTENT="OpenOffice.org 3.0 (Linux)">
+ <META NAME="CREATED" CONTENT="0;0">
+ <META NAME="CHANGEDBY" CONTENT="Dimitri Komatitsch">
+ <META NAME="CHANGED" CONTENT="20091103;22190500">
+ <STYLE TYPE="text/css">
+ <!--
+ P { color: #000000; font-family: "Times New Roman"; font-size: 12pt }
+ A:link { color: #0000ff }
+ A:visited { color: #0000ff }
+ -->
+ </STYLE>
+</HEAD>
+<BODY LANG="en-US" LINK="#0000ff" VLINK="#0000ff" BGCOLOR="#ffffff" BACKGROUND="http://www.univ-pau.fr/~dkomati1/grayback.gif" DIR="LTR">
+<P><A HREF="http://www.univ-pau.fr/~dkomati1">Home page of Dimitri
+Komatitsch</A></P>
+<P ALIGN=CENTER><A NAME="_x0000_i1025"></A><IMG SRC="http://www.univ-pau.fr/~dkomati1/seismic_cpml.gif" NAME="graphics1" ALIGN=BOTTOM WIDTH=158 HEIGHT=30 BORDER=0></P>
+<P> </P>
+<P ALIGN=CENTER><A NAME="download_map"></A><IMG SRC="http://www.geodynamics.org/~buildbot/maps/Seismic_CPML.gif" NAME="download_map2" ALIGN=BOTTOM BORDER=0></P>
+<P><FONT COLOR="#000000"><FONT FACE="Liberation Serif, serif"><FONT SIZE=3 STYLE="font-size: 13pt"><center><u><b>Current SEISMIC_CPML download map since its first release</b></u></center></FONT></FONT></FONT></P>
+<P> </P>
+<P><FONT COLOR="#ff0000"><FONT SIZE=3 STYLE="font-size: 13pt">SEISMIC_CPML
+is a set of eight open-source Fortran90 programs</FONT></FONT> <FONT SIZE=3 STYLE="font-size: 13pt">to
+solve the two-dimensional or three-dimensional isotropic or
+anisotropic elastic, viscoelastic or poroelastic wave equation using
+a finite-difference method with Convolutional Perfectly Matched Layer
+(C-PML) conditions, developed by Dimitri Komatitsch and Roland Martin
+from University of Pau, France. </FONT>
+</P>
+<P STYLE="margin-bottom: 0in"><FONT COLOR="#000000"><FONT FACE="Liberation Serif, serif"><FONT SIZE=3 STYLE="font-size: 13pt">You
+can get the full source code of the programs at the official Web
+site:
+</FONT></FONT></FONT><A HREF="http://www.geodynamics.org/cig/software/packages/seismo/seismic_cpml"><FONT COLOR="#000000"><FONT FACE="Liberation Serif, serif"><FONT SIZE=3 STYLE="font-size: 13pt"><B>http://www.geodynamics.org/cig/software/packages/seismo/seismic_cpml</B></FONT></FONT></FONT></A></P>
+<P><FONT SIZE=3 STYLE="font-size: 13pt">The unsplit <B>Convolutional
+Perfectly Matched Layer (C-PML) for the 3D elastic wave equation</B>
+was introduced and is described in detail in: </FONT>
+</P>
+<P><FONT SIZE=3 STYLE="font-size: 13pt"><B>Dimitri Komatitsch and
+Roland Martin,</B></FONT> <FONT SIZE=3 STYLE="font-size: 13pt"><SPAN STYLE="font-style: normal">An
+unsplit convolutional Perfectly Matched Layer improved at grazing
+incidence for the seismic wave equation</SPAN></FONT><FONT SIZE=3 STYLE="font-size: 13pt"><I>,
+Geophysics</I></FONT><FONT SIZE=3 STYLE="font-size: 13pt">, vol.
+72(5), p SM155-SM167, doi: 10.1190/1.2757586 (2007). <A HREF="http://www.univ-pau.fr/~dkomati1/published_papers/geophysics_CPML_2007_elastic_typos_fixed.pdf">PDF
+reprint</A> <A HREF="http://www.univ-pau.fr/~dkomati1/bibtex_komatitsch.bib">BibTeX</A></FONT></P>
+<P><FONT SIZE=3 STYLE="font-size: 13pt">It was originally developed
+for Maxwell's equations by Roden and Gedney (2000) (see reference
+below).</FONT></P>
+<P><FONT SIZE=3 STYLE="font-size: 13pt">An extension to viscoelastic
+media is developed in:</FONT></P>
+<P><SPAN STYLE="text-decoration: none"><FONT SIZE=3 STYLE="font-size: 13pt"><B>Roland
+Martin and Dimitri Komatitsch, </B></FONT></SPAN><SPAN STYLE="text-decoration: none"><FONT SIZE=3 STYLE="font-size: 13pt"><SPAN STYLE="font-weight: normal">An
+unsplit convolutional perfectly matched layer technique improved at
+grazing incidence for the viscoelastic wave equation, </SPAN></FONT></SPAN><SPAN STYLE="text-decoration: none"><FONT SIZE=3 STYLE="font-size: 13pt"><I><SPAN STYLE="font-weight: normal">Geophysical
+Journal International</SPAN></I></FONT></SPAN><SPAN STYLE="text-decoration: none"><FONT SIZE=3 STYLE="font-size: 13pt"><SPAN STYLE="font-weight: normal">,
+</SPAN></FONT></SPAN><SPAN STYLE="text-decoration: none"><FONT SIZE=3 STYLE="font-size: 13pt"><SPAN LANG="fr-FR"><SPAN STYLE="font-weight: normal">vol.
+179(1), p. 333-344, </SPAN></SPAN></FONT></SPAN><FONT COLOR="#000000"><SPAN STYLE="text-decoration: none"><FONT FACE="Times New Roman, serif"><FONT SIZE=3 STYLE="font-size: 13pt"><SPAN LANG="fr-FR"><SPAN STYLE="font-style: normal"><SPAN STYLE="font-weight: normal">doi:
+10.1111/j.1365-246X.2009.04278.x </SPAN></SPAN></SPAN></FONT></FONT></SPAN></FONT><SPAN STYLE="text-decoration: none"><FONT SIZE=3 STYLE="font-size: 13pt"><SPAN STYLE="font-weight: normal">(2009).</SPAN></FONT></SPAN><FONT COLOR="#000000"><SPAN STYLE="text-decoration: none">
+</SPAN></FONT><FONT COLOR="#000000"><SPAN STYLE="text-decoration: none"><FONT FACE="Times New Roman, serif"><FONT SIZE=3 STYLE="font-size: 13pt"><SPAN LANG="fr-FR"><SPAN STYLE="font-weight: normal"><A HREF="http://www.univ-pau.fr/~dkomati1/published_papers/GJI_CPML_2009_viscoelastic.pdf">PDF
+reprint</A> <A HREF="http://www.univ-pau.fr/~dkomati1/bibtex_komatitsch.bib">BibTeX</A></SPAN></SPAN></FONT></FONT></SPAN></FONT></P>
+<P><FONT SIZE=3 STYLE="font-size: 13pt">An extension to poroelastic
+media is developed in:</FONT></P>
+<P><SPAN STYLE="text-decoration: none"><FONT SIZE=3 STYLE="font-size: 13pt"><B>Roland
+Martin, Dimitri Komatitsch and Abdelaâziz Ezziani</B></FONT></SPAN><FONT SIZE=3 STYLE="font-size: 13pt">,
+</FONT><FONT SIZE=3 STYLE="font-size: 13pt"><SPAN STYLE="font-style: normal">An
+unsplit convolutional Perfectly Matched Layer improved at grazing
+incidence for seismic wave propagation in poroelastic media</SPAN></FONT><FONT SIZE=3 STYLE="font-size: 13pt"><I>,
+Geophysics</I></FONT><FONT SIZE=3 STYLE="font-size: 13pt">, vol.
+73(4), p T51-T61, doi: 10.1190/1.2939484 (2008). <A HREF="http://www.univ-pau.fr/~dkomati1/published_papers/geophysics_CPML_2008_poroelastic_typos_fixed.pdf">PDF
+reprint</A> <A HREF="http://www.univ-pau.fr/~dkomati1/bibtex_komatitsch.bib">BibTeX</A></FONT></P>
+<P><FONT SIZE=3 STYLE="font-size: 13pt">and a variational formulation
+is developed in:</FONT></P>
+<P><SPAN STYLE="text-decoration: none"><FONT SIZE=3 STYLE="font-size: 13pt"><B>Roland
+Martin, </B></FONT></SPAN><SPAN STYLE="text-decoration: none"><FONT FACE="Times New Roman, serif"><FONT SIZE=3 STYLE="font-size: 13pt"><B>Dimitri
+Komatitsch</B></FONT></FONT></SPAN><SPAN STYLE="text-decoration: none">
+</SPAN><SPAN STYLE="text-decoration: none"><FONT SIZE=3 STYLE="font-size: 13pt"><B>and
+Stephen D. Gedney</B></FONT></SPAN><FONT SIZE=3 STYLE="font-size: 13pt">,
+A variational formulation of a stabilized unsplit convolutional
+perfectly matched layer for the isotropic or anisotropic seismic wave
+equation, </FONT><FONT SIZE=3 STYLE="font-size: 13pt"><I>Computer
+Modeling in Engineering and Sciences</I></FONT><FONT SIZE=3 STYLE="font-size: 13pt">,
+vol. 37(3), p. 274-304 (2008). </FONT><FONT COLOR="#000000"><SPAN STYLE="text-decoration: none"><FONT FACE="Times New Roman, serif"><FONT SIZE=3 STYLE="font-size: 13pt"><SPAN STYLE="font-weight: normal"><A HREF="http://www.univ-pau.fr/~dkomati1/published_papers/CMES_cpml_2008.pdf">PDF
+reprint</A> <A HREF="http://www.univ-pau.fr/~dkomati1/bibtex_komatitsch.bib">BibTeX</A></SPAN></FONT></FONT></SPAN></FONT></P>
+<P><FONT SIZE=3 STYLE="font-size: 13pt">Note that in the case of an
+anisotropic medium the modification made is not strictly speaking
+perfectly matched any more, i.e., not a PML, but rather </FONT><FONT COLOR="#000000"><FONT FACE="Liberation Serif, serif"><FONT SIZE=3 STYLE="font-size: 13pt">a
+“Modified PML / M-PML” based on Meza-Fajardo and Papageorgiou,
+</FONT></FONT></FONT><FONT COLOR="#000000"><FONT FACE="Liberation Serif, serif"><FONT SIZE=3 STYLE="font-size: 13pt"><I>Bulletin
+of the Seismological Society of America</I></FONT></FONT></FONT><FONT COLOR="#000000"><FONT FACE="Liberation Serif, serif"><FONT SIZE=3 STYLE="font-size: 13pt">,
+vol. 98(4), p. 1811-1836 (2008). H</FONT></FONT></FONT><FONT SIZE=3 STYLE="font-size: 13pt">owever,
+it works very well in practice even if it is not perfectly matched
+any more from a mathematical point of view.</FONT></P>
+<P><FONT SIZE=3 STYLE="font-size: 13pt">This software is governed by
+the <A HREF="http://www.cecill.info/licences/Licence_CeCILL_V2-en.html">CeCILL
+license (version 2)</A> (a French license very similar to GNU GPL
+version 2) under French law and abiding by the rules of distribution
+of free software. You can use, modify and/or redistribute the
+software under the terms of the CeCILL license as circulated by CEA,
+CNRS and INRIA at the following URL "<A HREF="http://www.cecill.info/index.en.html">http://www.cecill.info</A>".</FONT></P>
+<P><FONT SIZE=3 STYLE="font-size: 13pt">If you use this code for your
+own research, please cite some (or all) of these articles:</FONT></P>
+<P STYLE="margin-bottom: 0in"><FONT FACE="Courier New, monospace"><FONT SIZE=3 STYLE="font-size: 13pt">@ARTICLE{KoMa07,<BR>author
+= {Dimitri Komatitsch and Roland Martin},<BR>title = {An unsplit
+convolutional {P}erfectly {M}atched {L}ayer improved at grazing
+incidence for the seismic wave equation},<BR>journal =
+{Geophysics},<BR>year = {2007},<BR>volume = {72},<BR>number =
+{5},<BR>pages = {SM155-SM167},<BR>doi =
+{10.1190/1.2757586}}<BR><BR>@ARTICLE{MaKo09,<BR>author = {Roland
+Martin and Dimitri Komatitsch},<BR>title = {An unsplit convolutional
+perfectly matched layer technique improved at grazing incidence for
+the viscoelastic wave equation},<BR>journal = {Geophysical Journal
+International},<BR>year = {2009},<BR>volume = {179},<BR>number =
+{1},<BR>pages = {333-344},<BR>doi =
+{10.1111/j.1365-246X.2009.04278.x}}<BR><BR>@ARTICLE{MaKoEz08,<BR>author
+= {Roland Martin and Dimitri Komatitsch and Abdelaaziz
+Ezziani},<BR>title = {An unsplit convolutional perfectly matched
+layer improved at grazing incidence for seismic wave equation in
+poroelastic media},<BR>journal = {Geophysics},<BR>year =
+{2008},<BR>volume = {73},<BR>pages = {T51-T61},<BR>number = {4},<BR>doi
+= {10.1190/1.2939484}}<BR><BR>@ARTICLE{MaKoGe08,<BR>author = {Roland
+Martin and Dimitri Komatitsch and Stephen D. Gedney},<BR>title = {A
+variational formulation of a stabilized unsplit convolutional
+perfectly matched layer for the isotropic or anisotropic seismic wave
+equation},<BR>journal = {Computer Modeling in Engineering and
+Sciences},<BR>year = {2008},<BR>volume = {37},<BR>pages =
+{274-304},<BR>number = {3}}<BR><BR></FONT></FONT><FONT COLOR="#000000"><FONT FACE="Liberation Serif, serif"><FONT SIZE=3 STYLE="font-size: 13pt">Roden
+and Gedney's original article for Maxwell's equations
+is:</FONT></FONT></FONT><FONT COLOR="#000000"><FONT FACE="Liberation Serif, serif"><FONT SIZE=1 STYLE="font-size: 6pt"><BR><BR><BR></FONT></FONT></FONT><FONT FACE="Courier New, monospace"><FONT SIZE=3 STYLE="font-size: 13pt">@ARTICLE{RoGe00,<BR>author
+= {J. A. Roden and S. D. Gedney},<BR>title = {Convolution {PML}
+({CPML}): {A}n Efficient {FDTD} Implementation of the {CFS}-{PML} for
+Arbitrary Media},<BR>journal = {Microwave and Optical Technology
+Letters},<BR>year = {2000},<BR>volume = {27},<BR>number = {5},<BR>pages
+= {334-339},<BR>doi =
+{10.1002/1098-2760(20001205)27:5<334::AID-MOP14>3.0.CO;2-A}}<BR></FONT></FONT><A HREF="http://www.geodynamics.org/cig/software/packages/seismo/seismic_cpml"><FONT COLOR="#000000"><FONT FACE="Liberation Serif, serif"><FONT SIZE=1 STYLE="font-size: 6pt"><B><BR><BR></B></FONT></FONT></FONT></A><FONT SIZE=3 STYLE="font-size: 13pt"><SPAN STYLE="font-weight: normal">The
+package is composed of the following eight programs:</SPAN></FONT></P>
+<P STYLE="margin-bottom: 0in"><BR>
+</P>
+<P><FONT COLOR="#ff0000"><FONT FACE="Liberation Serif, serif"><FONT SIZE=3 STYLE="font-size: 13pt"><B>seismic_CPML_2D_isotropic_second_order.f90</B></FONT></FONT></FONT><FONT COLOR="#000000"><FONT FACE="Liberation Serif, serif"><FONT SIZE=3 STYLE="font-size: 13pt">:
+2D C-PML program for an isotropic medium using a second-order
+finite-difference spatial operator.</FONT></FONT></FONT></P>
+<P><FONT COLOR="#ff0000"><FONT FACE="Liberation Serif, serif"><FONT SIZE=3 STYLE="font-size: 13pt"><B>seismic_CPML_2D_isotropic_fourth_order.f90</B></FONT></FONT></FONT><FONT COLOR="#000000"><FONT FACE="Liberation Serif, serif"><FONT SIZE=3 STYLE="font-size: 13pt">:
+2D C-PML program for an isotropic medium using a fourth-order
+finite-difference spatial operator.</FONT></FONT></FONT></P>
+<P><FONT COLOR="#ff0000"><FONT FACE="Liberation Serif, serif"><FONT SIZE=3 STYLE="font-size: 13pt"><B>seismic_CPML_2D_anisotropic.f90</B></FONT></FONT></FONT><FONT COLOR="#000000"><FONT FACE="Liberation Serif, serif"><FONT SIZE=3 STYLE="font-size: 13pt">:
+2D C-PML program for an anisotropic medium using a second-order
+finite-difference spatial operator. More precisely we implement a
+“Modified PML / M-PML” based on Meza-Fajardo and Papageorgiou,
+</FONT></FONT></FONT><FONT COLOR="#000000"><FONT FACE="Liberation Serif, serif"><FONT SIZE=3 STYLE="font-size: 13pt"><I>Bulletin
+of the Seismological Society of America</I></FONT></FONT></FONT><FONT COLOR="#000000"><FONT FACE="Liberation Serif, serif"><FONT SIZE=3 STYLE="font-size: 13pt">,
+vol. 98(4), p. 1811-1836 (2008). Strictly speaking the layers are not
+perfectly matched any more from a mathematical point of view, but the
+code works very well in practice.</FONT></FONT></FONT></P>
+<P><FONT COLOR="#ff0000"><FONT FACE="Liberation Serif, serif"><FONT SIZE=3 STYLE="font-size: 13pt"><B>seismic_CPML_2D_poroelastic_fourth_order.f90</B></FONT></FONT></FONT><FONT COLOR="#000000"><FONT FACE="Liberation Serif, serif"><FONT SIZE=3 STYLE="font-size: 13pt">:
+2D C-PML program for a poroelastic medium using a fourth-order
+finite-difference spatial operator.</FONT></FONT></FONT></P>
+<P><FONT COLOR="#ff0000"><FONT FACE="Liberation Serif, serif"><FONT SIZE=3 STYLE="font-size: 13pt"><B>seismic_PML_Collino_2D_isotropic.f90</B></FONT></FONT></FONT><FONT COLOR="#000000"><FONT FACE="Liberation Serif, serif"><FONT SIZE=3 STYLE="font-size: 13pt">:
+2D classical split PML program for an isotropic medium using a
+second-order finite-difference spatial operator, for comparison.</FONT></FONT></FONT></P>
+<P><FONT COLOR="#ff0000"><FONT FACE="Liberation Serif, serif"><FONT SIZE=3 STYLE="font-size: 13pt"><B>seismic_CPML_3D_isotropic_MPI_OpenMP.f90</B></FONT></FONT></FONT><FONT COLOR="#000000"><FONT FACE="Liberation Serif, serif"><FONT SIZE=3 STYLE="font-size: 13pt">:
+3D C-PML program for an isotropic medium using a second-order
+finite-difference spatial operator. Parallel implementation based on
+both MPI and OpenMP.</FONT></FONT></FONT></P>
+<P><FONT COLOR="#ff0000"><FONT FACE="Liberation Serif, serif"><FONT SIZE=3 STYLE="font-size: 13pt"><B>seismic_PML_Collino_3D_isotropic_OpenMP.f90</B></FONT></FONT></FONT><FONT COLOR="#000000"><FONT FACE="Liberation Serif, serif"><FONT SIZE=3 STYLE="font-size: 13pt">:
+3D classical split PML program for an isotropic medium using a
+second-order finite-difference spatial operator, for comparison.
+Parallel implementation based on OpenMP.</FONT></FONT></FONT></P>
+<P><FONT COLOR="#ff0000"><FONT FACE="Liberation Serif, serif"><FONT SIZE=3 STYLE="font-size: 13pt"><B>seismic_CPML_3D_viscoelastic_MPI.f90</B></FONT></FONT></FONT><FONT COLOR="#000000"><FONT FACE="Liberation Serif, serif"><FONT SIZE=3 STYLE="font-size: 13pt">:
+3D C-PML program for a viscoelastic medium using a fourth-order
+finite-difference spatial operator. Parallel implementation based on
+MPI.</FONT></FONT></FONT></P>
+<P><FONT COLOR="#ff0000"><FONT FACE="Liberation Serif, serif"><FONT SIZE=3 STYLE="font-size: 13pt"><B>Makefile</B></FONT></FONT></FONT><FONT COLOR="#000000"><FONT FACE="Liberation Serif, serif"><FONT SIZE=3 STYLE="font-size: 13pt">:
+a standard Makefile. You can type “make all” to compile all the
+codes.</FONT></FONT></FONT></P>
+<P><FONT COLOR="#000000"><FONT FACE="Liberation Serif, serif"><FONT SIZE=3 STYLE="font-size: 13pt">For
+more details about PML and C-PML, see for instance <A HREF="http://en.wikipedia.org/wiki/Perfectly_Matched_Layer">Wikipedia
+about PML</A>.</FONT></FONT></FONT></P>
+<P><FONT COLOR="#000000"><FONT FACE="Liberation Serif, serif"><FONT SIZE=3 STYLE="font-size: 13pt">For
+more details about finite differences in the time domain (FDTD), see
+for instance <A HREF="http://en.wikipedia.org/wiki/Finite-difference_time-domain_method">Wikipedia
+about FDTD</A>.</FONT></FONT></FONT></P>
+<P><A HREF="http://www.cecill.info/licences/Licence_CeCILL_V2-en.html"><FONT SIZE=3 STYLE="font-size: 13pt">Full
+text of the CeCILL licence (version 2)</FONT></A></P>
+<P><A HREF="http://www.cecill.info/index.en.html"><FONT SIZE=3 STYLE="font-size: 13pt">Official
+web site of the CeCILL licence</FONT></A></P>
+<P><A HREF="http://www.univ-pau.fr/~dkomati1"><FONT SIZE=3 STYLE="font-size: 13pt">Home
+page of Dimitri Komatitsch</FONT></A></P>
+</BODY>
+</HTML>
Added: seismo/3D/CPML/tags/v1.1.1/letter_CeCILL_SEISMIC_CPML.pdf
===================================================================
(Binary files differ)
Property changes on: seismo/3D/CPML/tags/v1.1.1/letter_CeCILL_SEISMIC_CPML.pdf
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: seismo/3D/CPML/tags/v1.1.1/seismic_CPML_2D_anisotropic.f90
===================================================================
--- seismo/3D/CPML/tags/v1.1.1/seismic_CPML_2D_anisotropic.f90 (rev 0)
+++ seismo/3D/CPML/tags/v1.1.1/seismic_CPML_2D_anisotropic.f90 2009-11-03 21:35:50 UTC (rev 15926)
@@ -0,0 +1,1344 @@
+!
+! SEISMIC_CPML Version 1.1.1, November 2009.
+!
+! Copyright Universite de Pau et des Pays de l'Adour, CNRS and INRIA, France.
+! Contributors: Dimitri Komatitsch, dimitri DOT komatitsch aT univ-pau DOT fr
+! and Roland Martin, roland DOT martin aT univ-pau DOT fr
+!
+! This software is a computer program whose purpose is to solve
+! the two-dimensional anisotropic elastic wave equation
+! using a finite-difference method with Convolutional Perfectly Matched
+! Layer (C-PML) conditions.
+!
+! This software is governed by the CeCILL license under French law and
+! abiding by the rules of distribution of free software. You can use,
+! modify and/or redistribute the software under the terms of the CeCILL
+! license as circulated by CEA, CNRS and INRIA at the following URL
+! "http://www.cecill.info".
+!
+! As a counterpart to the access to the source code and rights to copy,
+! modify and redistribute granted by the license, users are provided only
+! with a limited warranty and the software's author, the holder of the
+! economic rights, and the successive licensors have only limited
+! liability.
+!
+! In this respect, the user's attention is drawn to the risks associated
+! with loading, using, modifying and/or developing or reproducing the
+! software by the user in light of its specific status of free software,
+! that may mean that it is complicated to manipulate, and that also
+! therefore means that it is reserved for developers and experienced
+! professionals having in-depth computer knowledge. Users are therefore
+! encouraged to load and test the software's suitability as regards their
+! requirements in conditions enabling the security of their systems and/or
+! data to be ensured and, more generally, to use and operate it in the
+! same conditions as regards security.
+!
+! The full text of the license is available at the end of this program
+! and in file "LICENSE".
+
+ program seismic_CPML_2D_aniso
+
+! 2D elastic finite-difference code in velocity and stress formulation
+! with Convolutional-PML (C-PML) absorbing conditions for an anisotropic medium
+
+! Dimitri Komatitsch, University of Pau, France, April 2007.
+! Anisotropic implementation by Roland Martin and Dimitri Komatitsch, University of Pau, France, April 2007.
+
+! The second-order staggered-grid formulation of Madariaga (1976) and Virieux (1986) is used:
+!
+! ^ y
+! |
+! |
+!
+! +-------------------+
+! | |
+! | |
+! | |
+! | |
+! | v_y |
+! sigma_xy +---------+ |
+! | | |
+! | | |
+! | | |
+! | | |
+! | | |
+! +---------+---------+ ---> x
+! v_x sigma_xx
+! sigma_yy
+!
+
+! The C-PML implementation is based in part on formulas given in Roden and Gedney (2000).
+! If you use this code for your own research, please cite some (or all) of these
+! articles:
+!
+! @ARTICLE{KoMa07,
+! author = {Dimitri Komatitsch and Roland Martin},
+! title = {An unsplit convolutional {P}erfectly {M}atched {L}ayer improved
+! at grazing incidence for the seismic wave equation},
+! journal = {Geophysics},
+! year = {2007},
+! volume = {72},
+! number = {5},
+! pages = {SM155-SM167},
+! doi = {10.1190/1.2757586}}
+!
+! @ARTICLE{MaKoGe08,
+! author = {Roland Martin and Dimitri Komatitsch and Stephen D. Gedney},
+! title = {A variational formulation of a stabilized unsplit convolutional perfectly
+! matched layer for the isotropic or anisotropic seismic wave equation},
+! journal = {Computer Modeling in Engineering and Sciences},
+! year = {2008},
+! volume = {37},
+! pages = {274-304},
+! number = {3}}
+!
+! @ARTICLE{MaKoEz08,
+! author = {Roland Martin and Dimitri Komatitsch and Abdela\^aziz Ezziani},
+! title = {An unsplit convolutional perfectly matched layer improved at grazing
+! incidence for seismic wave equation in poroelastic media},
+! journal = {Geophysics},
+! year = {2008},
+! volume = {73},
+! pages = {T51-T61},
+! number = {4},
+! doi = {10.1190/1.2939484}}
+!
+! @ARTICLE{MaKo09,
+! author = {Roland Martin and Dimitri Komatitsch},
+! title = {An unsplit convolutional perfectly matched layer technique improved
+! at grazing incidence for the viscoelastic wave equation},
+! journal = {Geophysical Journal International},
+! year = {2009},
+! volume = {179},
+! pages = {333-344},
+! number = {1},
+! doi = {10.1111/j.1365-246X.2009.04278.x}}
+!
+! If you use the anisotropic implementation, please cite this article,
+! in which the anisotropic parameters are described, as well:
+!
+! @ARTICLE{KoBaTr00,
+! author = {D. Komatitsch and C. Barnes and J. Tromp},
+! title = {Simulation of anisotropic wave propagation based upon a spectral element method},
+! journal = {Geophysics},
+! year = {2000},
+! volume = {65},
+! number = {4},
+! pages = {1251-1260},
+! doi = {10.1190/1.1444816}}
+!
+! The original CPML technique for Maxwell's equations is described in:
+!
+! @ARTICLE{RoGe00,
+! author = {J. A. Roden and S. D. Gedney},
+! title = {Convolution {PML} ({CPML}): {A}n Efficient {FDTD} Implementation
+! of the {CFS}-{PML} for Arbitrary Media},
+! journal = {Microwave and Optical Technology Letters},
+! year = {2000},
+! volume = {27},
+! number = {5},
+! pages = {334-339},
+! doi = {10.1002/1098-2760(20001205)27:5<334::AID-MOP14>3.0.CO;2-A}}
+!
+! To display the 2D results as color images, use:
+!
+! " display image*.gif " or " gimp image*.gif "
+!
+! or
+!
+! " montage -geometry +0+3 -rotate 90 -tile 1x21 image*Vx*.gif allfiles_Vx.gif "
+! " montage -geometry +0+3 -rotate 90 -tile 1x21 image*Vy*.gif allfiles_Vy.gif "
+! then " display allfiles_Vx.gif " or " gimp allfiles_Vx.gif "
+! then " display allfiles_Vy.gif " or " gimp allfiles_Vy.gif "
+!
+
+ implicit none
+
+! total number of grid points in each direction of the grid
+ integer, parameter :: NX = 401
+ integer, parameter :: NY = 401
+
+! size of a grid cell
+ double precision, parameter :: DELTAX = 0.0625d-2
+ double precision, parameter :: DELTAY = DELTAX
+
+! flags to add PML layers to the edges of the grid
+ logical, parameter :: USE_PML_XMIN = .true.
+ logical, parameter :: USE_PML_XMAX = .true.
+ logical, parameter :: USE_PML_YMIN = .true.
+ logical, parameter :: USE_PML_YMAX = .true.
+
+! thickness of the PML layer in grid points
+ integer, parameter :: NPOINTS_PML = 10
+
+! Velocity of qP along horizontal axis = sqrt(c11/rho)
+! Velocity of qP along vertical axis = sqrt(c22/rho)
+! Velocity of qSV along horizontal axis = sqrt(c33/rho)
+! Velocity of qSV along vertical axis = sqrt(c33/rho), same as along horizontal axis
+
+! zinc, from Komatitsch et al. (2000)
+! double precision, parameter :: c11 = 16.5d10
+! double precision, parameter :: c12 = 5.d10
+! double precision, parameter :: c22 = 6.2d10
+! double precision, parameter :: c33 = 3.96d10
+! double precision, parameter :: rho = 7100.d0
+! double precision, parameter :: f0 = 170.d3
+
+! apatite, from Komatitsch et al. (2000)
+! double precision, parameter :: c11 = 16.7d10
+! double precision, parameter :: c12 = 6.6d10
+! double precision, parameter :: c22 = 14.d10
+! double precision, parameter :: c33 = 6.63d10
+! double precision, parameter :: rho = 3200.d0
+! double precision, parameter :: f0 = 300.d3
+
+! isotropic material a bit similar to apatite
+! double precision, parameter :: c11 = 16.7d10
+! double precision, parameter :: c12 = c11/3.d0
+! double precision, parameter :: c22 = c11
+! double precision, parameter :: c33 = (c11-c12)/2.d0 ! = c11/3.d0
+! double precision, parameter :: rho = 3200.d0
+! double precision, parameter :: f0 = 300.d3
+
+! model I from Becache, Fauqueux and Joly, which is stable
+ double precision, parameter :: scale_aniso = 1.d10
+ double precision, parameter :: c11 = 4.d0 * scale_aniso
+ double precision, parameter :: c12 = 3.8d0 * scale_aniso
+ double precision, parameter :: c22 = 20.d0 * scale_aniso
+ double precision, parameter :: c33 = 2.d0 * scale_aniso
+ double precision, parameter :: rho = 4000.d0 ! used to be 1.
+ double precision, parameter :: f0 = 200.d3
+
+! model II from Becache, Fauqueux and Joly, which is stable
+! double precision, parameter :: scale_aniso = 1.d10
+! double precision, parameter :: c11 = 20.d0 * scale_aniso
+! double precision, parameter :: c12 = 3.8d0 * scale_aniso
+! double precision, parameter :: c22 = c11
+! double precision, parameter :: c33 = 2.d0 * scale_aniso
+! double precision, parameter :: rho = 4000.d0 ! used to be 1.
+! double precision, parameter :: f0 = 200.d3
+
+! model III from Becache, Fauqueux and Joly, which is unstable
+! double precision, parameter :: scale_aniso = 1.d10
+! double precision, parameter :: c11 = 4.d0 * scale_aniso
+! double precision, parameter :: c12 = 4.9d0 * scale_aniso
+! double precision, parameter :: c22 = 20.d0 * scale_aniso
+! double precision, parameter :: c33 = 2.d0 * scale_aniso
+! double precision, parameter :: rho = 4000.d0 ! used to be 1.
+! double precision, parameter :: f0 = 250.d3
+
+! model IV from Becache, Fauqueux and Joly, which is unstable
+! double precision, parameter :: scale_aniso = 1.d10
+! double precision, parameter :: c11 = 4.d0 * scale_aniso
+! double precision, parameter :: c12 = 7.5d0 * scale_aniso
+! double precision, parameter :: c22 = 20.d0 * scale_aniso
+! double precision, parameter :: c33 = 2.d0 * scale_aniso
+! double precision, parameter :: rho = 4000.d0 ! used to be 1.
+! double precision, parameter :: f0 = 170.d3
+
+! total number of time steps
+ integer, parameter :: NSTEP = 3000
+
+! time step in seconds
+ double precision, parameter :: DELTAT = 50.d-9
+
+! parameters for the source
+ double precision, parameter :: t0 = 1.20d0 / f0
+ double precision, parameter :: factor = 1.d7
+
+! source
+ integer, parameter :: ISOURCE = NX / 2
+ integer, parameter :: JSOURCE = NY / 2
+ double precision, parameter :: xsource = (ISOURCE - 1) * DELTAX
+ double precision, parameter :: ysource = (JSOURCE - 1) * DELTAY
+! angle of source force clockwise with respect to vertical (Y) axis
+ double precision, parameter :: ANGLE_FORCE = 0.d0
+
+! display information on the screen from time to time
+ integer, parameter :: IT_DISPLAY = 100
+
+! value of PI
+ double precision, parameter :: PI = 3.141592653589793238462643d0
+
+! conversion from degrees to radians
+ double precision, parameter :: DEGREES_TO_RADIANS = PI / 180.d0
+
+! zero
+ double precision, parameter :: ZERO = 0.d0
+
+! large value for maximum
+ double precision, parameter :: HUGEVAL = 1.d+30
+
+! velocity threshold above which we consider that the code became unstable
+ double precision, parameter :: STABILITY_THRESHOLD = 1.d+25
+
+! main arrays
+ double precision, dimension(NX,NY) :: vx,vy,sigmaxx,sigmayy,sigmaxy
+
+! power to compute d0 profile
+ double precision, parameter :: NPOWER = 2.d0
+
+ double precision, parameter :: K_MAX_PML = 1.d0 ! from Gedney page 8.11
+ double precision, parameter :: ALPHA_MAX_PML = 2.d0*PI*(f0/2.d0) ! from festa and Vilotte
+
+! arrays for the memory variables
+! could declare these arrays in PML only to save a lot of memory, but proof of concept only here
+ double precision, dimension(NX,NY) :: &
+ memory_dvx_dx, &
+ memory_dvx_dy, &
+ memory_dvy_dx, &
+ memory_dvy_dy, &
+ memory_dsigmaxx_dx, &
+ memory_dsigmayy_dy, &
+ memory_dsigmaxy_dx, &
+ memory_dsigmaxy_dy
+
+ double precision :: &
+ value_dvx_dx, &
+ value_dvx_dy, &
+ value_dvy_dx, &
+ value_dvy_dy, &
+ value_dsigmaxx_dx, &
+ value_dsigmayy_dy, &
+ value_dsigmaxy_dx, &
+ value_dsigmaxy_dy
+
+! 1D arrays for the damping profiles
+ double precision, dimension(NX) :: d_x,K_x,alpha_prime_x,a_x,b_x,d_x_half,K_x_half,alpha_prime_x_half,a_x_half,b_x_half
+ double precision, dimension(NY) :: d_y,K_y,alpha_prime_y,a_y,b_y,d_y_half,K_y_half,alpha_prime_y_half,a_y_half,b_y_half
+
+ double precision :: thickness_PML_x,thickness_PML_y,xoriginleft,xoriginright,yoriginbottom,yorigintop
+ double precision :: Rcoef,d0_x,d0_y,xval,yval,abscissa_in_PML,abscissa_normalized
+
+! for the source
+ double precision :: a,t,force_x,force_y,source_term
+
+ integer :: i,j,it
+
+ double precision :: Courant_number,velocnorm
+
+! for stability estimate
+ double precision :: quasi_cp_max,aniso_stability_criterion,aniso2,aniso3
+
+!---
+!--- program starts here
+!---
+
+ print *
+ print *,'2D elastic finite-difference code in velocity and stress formulation with C-PML'
+ print *
+
+! display size of the model
+ print *
+ print *,'NX = ',NX
+ print *,'NY = ',NY
+ print *
+ print *,'size of the model along X = ',(NX - 1) * DELTAX
+ print *,'size of the model along Y = ',(NY - 1) * DELTAY
+ print *
+ print *,'Total number of grid points = ',NX * NY
+ print *
+
+ print *,'Velocity of qP along vertical axis. . . . =',sqrt(c22/rho)
+ print *,'Velocity of qP along horizontal axis. . . =',sqrt(c11/rho)
+ print *
+ print *,'Velocity of qSV along vertical axis . . . =',sqrt(c33/rho)
+ print *,'Velocity of qSV along horizontal axis . . =',sqrt(c33/rho)
+ print *
+
+! from Becache et al., INRIA report, equation 7 page 5
+ if(c11*c22 - c12*c12 <= 0.d0) stop 'problem in definition of orthotropic material'
+
+! check intrinsic mathematical stability of PML model for an anisotropic material
+! from E. B\'ecache, S. Fauqueux and P. Joly, Stability of Perfectly Matched Layers, group
+! velocities and anisotropic waves, Journal of Computational Physics, 188(2), p. 399-433 (2003)
+ aniso_stability_criterion = ((c12+c33)**2 - c11*(c22-c33)) * ((c12+c33)**2 + c33*(c22-c33))
+ print *,'PML anisotropy stability criterion from Becache et al. 2003 = ',aniso_stability_criterion
+ if(aniso_stability_criterion > 0.d0 .and. (USE_PML_XMIN .or. USE_PML_XMAX .or. USE_PML_YMIN .or. USE_PML_YMAX)) &
+ print *,'WARNING: PML model mathematically intrinsically unstable for this anisotropic material for condition 1'
+ print *
+
+ aniso2 = (c12 + 2*c33)**2 - c11*c22
+ print *,'PML aniso2 stability criterion from Becache et al. 2003 = ',aniso2
+ if(aniso2 > 0.d0 .and. (USE_PML_XMIN .or. USE_PML_XMAX .or. USE_PML_YMIN .or. USE_PML_YMAX)) &
+ print *,'WARNING: PML model mathematically intrinsically unstable for this anisotropic material for condition 2'
+ print *
+
+ aniso3 = (c12 + c33)**2 - c11*c22 - c33**2
+ print *,'PML aniso3 stability criterion from Becache et al. 2003 = ',aniso3
+ if(aniso3 > 0.d0 .and. (USE_PML_XMIN .or. USE_PML_XMAX .or. USE_PML_YMIN .or. USE_PML_YMAX)) &
+ print *,'WARNING: PML model mathematically intrinsically unstable for this anisotropic material for condition 3'
+ print *
+
+! to compute d0 below, and for stability estimate
+ quasi_cp_max = max(sqrt(c22/rho),sqrt(c11/rho))
+
+!--- define profile of absorption in PML region
+
+! thickness of the PML layer in meters
+ thickness_PML_x = NPOINTS_PML * DELTAX
+ thickness_PML_y = NPOINTS_PML * DELTAY
+
+! reflection coefficient (INRIA report section 6.1)
+ Rcoef = 0.001d0
+
+! check that NPOWER is okay
+ if(NPOWER < 1) stop 'NPOWER must be greater than 1'
+
+! compute d0 from INRIA report section 6.1
+ d0_x = - (NPOWER + 1) * quasi_cp_max * log(Rcoef) / (2.d0 * thickness_PML_x)
+ d0_y = - (NPOWER + 1) * quasi_cp_max * log(Rcoef) / (2.d0 * thickness_PML_y)
+
+ print *,'d0_x = ',d0_x
+ print *,'d0_y = ',d0_y
+ print *
+
+ d_x(:) = ZERO
+ d_x_half(:) = ZERO
+ K_x(:) = 1.d0
+ K_x_half(:) = 1.d0
+ alpha_prime_x(:) = ZERO
+ alpha_prime_x_half(:) = ZERO
+ a_x(:) = ZERO
+ a_x_half(:) = ZERO
+
+ d_y(:) = ZERO
+ d_y_half(:) = ZERO
+ K_y(:) = 1.d0
+ K_y_half(:) = 1.d0
+ alpha_prime_y(:) = ZERO
+ alpha_prime_y_half(:) = ZERO
+ a_y(:) = ZERO
+ a_y_half(:) = ZERO
+
+! damping in the X direction
+
+! origin of the PML layer (position of right edge minus thickness, in meters)
+ xoriginleft = thickness_PML_x
+ xoriginright = (NX-1)*DELTAX - thickness_PML_x
+
+ do i = 1,NX
+
+! abscissa of current grid point along the damping profile
+ xval = DELTAX * dble(i-1)
+
+!---------- left edge
+ if(USE_PML_XMIN) then
+
+! define damping profile at the grid points
+ abscissa_in_PML = xoriginleft - xval
+ if(abscissa_in_PML >= ZERO) then
+ abscissa_normalized = abscissa_in_PML / thickness_PML_x
+ d_x(i) = d0_x * abscissa_normalized**NPOWER
+! this taken from Gedney page 8.2
+ K_x(i) = 1.d0 + (K_MAX_PML - 1.d0) * abscissa_normalized**NPOWER
+ alpha_prime_x(i) = ALPHA_MAX_PML * (1.d0 - abscissa_normalized)
+ endif
+
+! define damping profile at half the grid points
+ abscissa_in_PML = xoriginleft - (xval + DELTAX/2.d0)
+ if(abscissa_in_PML >= ZERO) then
+ abscissa_normalized = abscissa_in_PML / thickness_PML_x
+ d_x_half(i) = d0_x * abscissa_normalized**NPOWER
+! this taken from Gedney page 8.2
+ K_x_half(i) = 1.d0 + (K_MAX_PML - 1.d0) * abscissa_normalized**NPOWER
+ alpha_prime_x_half(i) = ALPHA_MAX_PML * (1.d0 - abscissa_normalized)
+ endif
+
+ endif
+
+!---------- right edge
+ if(USE_PML_XMAX) then
+
+! define damping profile at the grid points
+ abscissa_in_PML = xval - xoriginright
+ if(abscissa_in_PML >= ZERO) then
+ abscissa_normalized = abscissa_in_PML / thickness_PML_x
+ d_x(i) = d0_x * abscissa_normalized**NPOWER
+! this taken from Gedney page 8.2
+ K_x(i) = 1.d0 + (K_MAX_PML - 1.d0) * abscissa_normalized**NPOWER
+ alpha_prime_x(i) = ALPHA_MAX_PML * (1.d0 - abscissa_normalized)
+ endif
+
+! define damping profile at half the grid points
+ abscissa_in_PML = xval + DELTAX/2.d0 - xoriginright
+ if(abscissa_in_PML >= ZERO) then
+ abscissa_normalized = abscissa_in_PML / thickness_PML_x
+ d_x_half(i) = d0_x * abscissa_normalized**NPOWER
+! this taken from Gedney page 8.2
+ K_x_half(i) = 1.d0 + (K_MAX_PML - 1.d0) * abscissa_normalized**NPOWER
+ alpha_prime_x_half(i) = ALPHA_MAX_PML * (1.d0 - abscissa_normalized)
+ endif
+
+ endif
+
+! just in case, for -5 at the end
+ if(alpha_prime_x(i) < ZERO) alpha_prime_x(i) = ZERO
+ if(alpha_prime_x_half(i) < ZERO) alpha_prime_x_half(i) = ZERO
+
+ b_x(i) = exp(- (d_x(i) / K_x(i) + alpha_prime_x(i)) * DELTAT)
+ b_x_half(i) = exp(- (d_x_half(i) / K_x_half(i) + alpha_prime_x_half(i)) * DELTAT)
+
+! this to avoid division by zero outside the PML
+ if(abs(d_x(i)) > 1.d-6) a_x(i) = d_x(i) * (b_x(i) - 1.d0) / (K_x(i) * (d_x(i) + K_x(i) * alpha_prime_x(i)))
+ if(abs(d_x_half(i)) > 1.d-6) a_x_half(i) = d_x_half(i) * &
+ (b_x_half(i) - 1.d0) / (K_x_half(i) * (d_x_half(i) + K_x_half(i) * alpha_prime_x_half(i)))
+
+ enddo
+
+! damping in the Y direction
+
+! origin of the PML layer (position of right edge minus thickness, in meters)
+ yoriginbottom = thickness_PML_y
+ yorigintop = (NY-1)*DELTAY - thickness_PML_y
+
+ do j = 1,NY
+
+! abscissa of current grid point along the damping profile
+ yval = DELTAY * dble(j-1)
+
+!---------- bottom edge
+ if(USE_PML_YMIN) then
+
+! define damping profile at the grid points
+ abscissa_in_PML = yoriginbottom - yval
+ if(abscissa_in_PML >= ZERO) then
+ abscissa_normalized = abscissa_in_PML / thickness_PML_y
+ d_y(j) = d0_y * abscissa_normalized**NPOWER
+! this taken from Gedney page 8.2
+ K_y(j) = 1.d0 + (K_MAX_PML - 1.d0) * abscissa_normalized**NPOWER
+ alpha_prime_y(j) = ALPHA_MAX_PML * (1.d0 - abscissa_normalized)
+ endif
+
+! define damping profile at half the grid points
+ abscissa_in_PML = yoriginbottom - (yval + DELTAY/2.d0)
+ if(abscissa_in_PML >= ZERO) then
+ abscissa_normalized = abscissa_in_PML / thickness_PML_y
+ d_y_half(j) = d0_y * abscissa_normalized**NPOWER
+! this taken from Gedney page 8.2
+ K_y_half(j) = 1.d0 + (K_MAX_PML - 1.d0) * abscissa_normalized**NPOWER
+ alpha_prime_y_half(j) = ALPHA_MAX_PML * (1.d0 - abscissa_normalized)
+ endif
+
+ endif
+
+!---------- top edge
+ if(USE_PML_YMAX) then
+
+! define damping profile at the grid points
+ abscissa_in_PML = yval - yorigintop
+ if(abscissa_in_PML >= ZERO) then
+ abscissa_normalized = abscissa_in_PML / thickness_PML_y
+ d_y(j) = d0_y * abscissa_normalized**NPOWER
+! this taken from Gedney page 8.2
+ K_y(j) = 1.d0 + (K_MAX_PML - 1.d0) * abscissa_normalized**NPOWER
+ alpha_prime_y(j) = ALPHA_MAX_PML * (1.d0 - abscissa_normalized)
+ endif
+
+! define damping profile at half the grid points
+ abscissa_in_PML = yval + DELTAY/2.d0 - yorigintop
+ if(abscissa_in_PML >= ZERO) then
+ abscissa_normalized = abscissa_in_PML / thickness_PML_y
+ d_y_half(j) = d0_y * abscissa_normalized**NPOWER
+! this taken from Gedney page 8.2
+ K_y_half(j) = 1.d0 + (K_MAX_PML - 1.d0) * abscissa_normalized**NPOWER
+ alpha_prime_y_half(j) = ALPHA_MAX_PML * (1.d0 - abscissa_normalized)
+ endif
+
+ endif
+
+ b_y(j) = exp(- (d_y(j) / K_y(j) + alpha_prime_y(j)) * DELTAT)
+ b_y_half(j) = exp(- (d_y_half(j) / K_y_half(j) + alpha_prime_y_half(j)) * DELTAT)
+
+! this to avoid division by zero outside the PML
+ if(abs(d_y(j)) > 1.d-6) a_y(j) = d_y(j) * (b_y(j) - 1.d0) / (K_y(j) * (d_y(j) + K_y(j) * alpha_prime_y(j)))
+ if(abs(d_y_half(j)) > 1.d-6) a_y_half(j) = d_y_half(j) * &
+ (b_y_half(j) - 1.d0) / (K_y_half(j) * (d_y_half(j) + K_y_half(j) * alpha_prime_y_half(j)))
+
+ enddo
+
+! print position of the source
+ print *,'Position of the source:'
+ print *
+ print *,'x = ',xsource
+ print *,'y = ',ysource
+ print *
+
+! check the Courant stability condition for the explicit time scheme
+! R. Courant et K. O. Friedrichs et H. Lewy (1928)
+ Courant_number = quasi_cp_max * DELTAT * sqrt(1.d0/DELTAX**2 + 1.d0/DELTAY**2)
+ print *,'Courant number is ',Courant_number
+ print *
+ if(Courant_number > 1.d0) stop 'time step is too large, simulation will be unstable'
+
+! suppress old files (can be commented out if "call system" is missing in your compiler)
+! call system('rm -f Vx_*.dat Vy_*.dat image*.pnm image*.gif')
+
+! initialize arrays
+ vx(:,:) = ZERO
+ vy(:,:) = ZERO
+ sigmaxx(:,:) = ZERO
+ sigmayy(:,:) = ZERO
+ sigmaxy(:,:) = ZERO
+
+! PML
+ memory_dvx_dx(:,:) = ZERO
+ memory_dvx_dy(:,:) = ZERO
+ memory_dvy_dx(:,:) = ZERO
+ memory_dvy_dy(:,:) = ZERO
+ memory_dsigmaxx_dx(:,:) = ZERO
+ memory_dsigmayy_dy(:,:) = ZERO
+ memory_dsigmaxy_dx(:,:) = ZERO
+ memory_dsigmaxy_dy(:,:) = ZERO
+
+!---
+!--- beginning of time loop
+!---
+
+ do it = 1,NSTEP
+
+!------------------------------------------------------------
+! compute stress sigma and update memory variables for C-PML
+!------------------------------------------------------------
+
+ do j = 2,NY
+ do i = 1,NX-1
+
+ value_dvx_dx = (vx(i+1,j) - vx(i,j)) / DELTAX
+ value_dvy_dy = (vy(i,j) - vy(i,j-1)) / DELTAY
+
+ memory_dvx_dx(i,j) = b_x_half(i) * memory_dvx_dx(i,j) + a_x_half(i) * value_dvx_dx
+ memory_dvy_dy(i,j) = b_y(j) * memory_dvy_dy(i,j) + a_y(j) * value_dvy_dy
+
+ value_dvx_dx = value_dvx_dx / K_x_half(i) + memory_dvx_dx(i,j)
+ value_dvy_dy = value_dvy_dy / K_y(j) + memory_dvy_dy(i,j)
+
+ sigmaxx(i,j) = sigmaxx(i,j) + (c11 * value_dvx_dx + c12 * value_dvy_dy) * DELTAT
+ sigmayy(i,j) = sigmayy(i,j) + (c12 * value_dvx_dx + c22 * value_dvy_dy) * DELTAT
+
+ enddo
+ enddo
+
+ do j = 1,NY-1
+ do i = 2,NX
+
+ value_dvy_dx = (vy(i,j) - vy(i-1,j)) / DELTAX
+ value_dvx_dy = (vx(i,j+1) - vx(i,j)) / DELTAY
+
+ memory_dvy_dx(i,j) = b_x(i) * memory_dvy_dx(i,j) + a_x(i) * value_dvy_dx
+ memory_dvx_dy(i,j) = b_y_half(j) * memory_dvx_dy(i,j) + a_y_half(j) * value_dvx_dy
+
+ value_dvy_dx = value_dvy_dx / K_x(i) + memory_dvy_dx(i,j)
+ value_dvx_dy = value_dvx_dy / K_y_half(j) + memory_dvx_dy(i,j)
+
+ sigmaxy(i,j) = sigmaxy(i,j) + c33 * (value_dvy_dx + value_dvx_dy) * DELTAT
+
+ enddo
+ enddo
+
+!--------------------------------------------------------
+! compute velocity and update memory variables for C-PML
+!--------------------------------------------------------
+
+ do j = 2,NY
+ do i = 2,NX
+
+ value_dsigmaxx_dx = (sigmaxx(i,j) - sigmaxx(i-1,j)) / DELTAX
+ value_dsigmaxy_dy = (sigmaxy(i,j) - sigmaxy(i,j-1)) / DELTAY
+
+ memory_dsigmaxx_dx(i,j) = b_x(i) * memory_dsigmaxx_dx(i,j) + a_x(i) * value_dsigmaxx_dx
+ memory_dsigmaxy_dy(i,j) = b_y(j) * memory_dsigmaxy_dy(i,j) + a_y(j) * value_dsigmaxy_dy
+
+ value_dsigmaxx_dx = value_dsigmaxx_dx / K_x(i) + memory_dsigmaxx_dx(i,j)
+ value_dsigmaxy_dy = value_dsigmaxy_dy / K_y(j) + memory_dsigmaxy_dy(i,j)
+
+ vx(i,j) = vx(i,j) + (value_dsigmaxx_dx + value_dsigmaxy_dy) * DELTAT / rho
+
+ enddo
+ enddo
+
+ do j = 1,NY-1
+ do i = 1,NX-1
+
+ value_dsigmaxy_dx = (sigmaxy(i+1,j) - sigmaxy(i,j)) / DELTAX
+ value_dsigmayy_dy = (sigmayy(i,j+1) - sigmayy(i,j)) / DELTAY
+
+ memory_dsigmaxy_dx(i,j) = b_x_half(i) * memory_dsigmaxy_dx(i,j) + a_x_half(i) * value_dsigmaxy_dx
+ memory_dsigmayy_dy(i,j) = b_y_half(j) * memory_dsigmayy_dy(i,j) + a_y_half(j) * value_dsigmayy_dy
+
+ value_dsigmaxy_dx = value_dsigmaxy_dx / K_x_half(i) + memory_dsigmaxy_dx(i,j)
+ value_dsigmayy_dy = value_dsigmayy_dy / K_y_half(j) + memory_dsigmayy_dy(i,j)
+
+ vy(i,j) = vy(i,j) + (value_dsigmaxy_dx + value_dsigmayy_dy) * DELTAT / rho
+
+ enddo
+ enddo
+
+! add the source (force vector located at a given grid point)
+ a = pi*pi*f0*f0
+ t = dble(it-1)*DELTAT
+
+! Gaussian
+! source_term = factor * exp(-a*(t-t0)**2)
+
+! first derivative of a Gaussian
+ source_term = - factor * 2.d0*a*(t-t0)*exp(-a*(t-t0)**2)
+
+! Ricker source time function (second derivative of a Gaussian)
+! source_term = factor * (1.d0 - 2.d0*a*(t-t0)**2)*exp(-a*(t-t0)**2)
+
+ force_x = sin(ANGLE_FORCE * DEGREES_TO_RADIANS) * source_term
+ force_y = cos(ANGLE_FORCE * DEGREES_TO_RADIANS) * source_term
+
+! define location of the source
+ i = ISOURCE
+ j = JSOURCE
+
+ vx(i,j) = vx(i,j) + force_x * DELTAT / rho
+ vy(i,j) = vy(i,j) + force_y * DELTAT / rho
+
+! Dirichlet conditions (rigid boundaries) on the edges or at the bottom of the PML layers
+ vx(1,:) = ZERO
+ vx(NX,:) = ZERO
+
+ vx(:,1) = ZERO
+ vx(:,NY) = ZERO
+
+ vy(1,:) = ZERO
+ vy(NX,:) = ZERO
+
+ vy(:,1) = ZERO
+ vy(:,NY) = ZERO
+
+! output information
+ if(mod(it,IT_DISPLAY) == 0 .or. it == 5) then
+
+! print maximum of norm of velocity
+ velocnorm = maxval(sqrt(vx**2 + vy**2))
+ print *,'Time step # ',it
+ print *,'Time: ',sngl((it-1)*DELTAT),' seconds'
+ print *,'Max norm velocity vector V (m/s) = ',velocnorm
+ print *
+! check stability of the code, exit if unstable
+ if(velocnorm > STABILITY_THRESHOLD) stop 'code became unstable and blew up'
+
+ call create_2D_image(vx,NX,NY,it,ISOURCE,JSOURCE, &
+ NPOINTS_PML,USE_PML_XMIN,USE_PML_XMAX,USE_PML_YMIN,USE_PML_YMAX,1)
+ call create_2D_image(vy,NX,NY,it,ISOURCE,JSOURCE, &
+ NPOINTS_PML,USE_PML_XMIN,USE_PML_XMAX,USE_PML_YMIN,USE_PML_YMAX,2)
+
+ endif
+
+ enddo ! end of time loop
+
+ print *
+ print *,'End of the simulation'
+ print *
+
+ end program seismic_CPML_2D_aniso
+
+!----
+!---- routine to create a color image of a given vector component
+!---- the image is created in PNM format and then converted to GIF
+!----
+
+ subroutine create_2D_image(image_data_2D,NX,NY,it,ISOURCE,JSOURCE, &
+ NPOINTS_PML,USE_PML_XMIN,USE_PML_XMAX,USE_PML_YMIN,USE_PML_YMAX,field_number)
+
+ implicit none
+
+! non linear display to enhance small amplitudes for graphics
+ double precision, parameter :: POWER_DISPLAY = 0.30d0
+
+! amplitude threshold above which we draw the color point
+ double precision, parameter :: cutvect = 0.01d0
+
+! use black or white background for points that are below the threshold
+ logical, parameter :: WHITE_BACKGROUND = .true.
+
+! size of cross and square in pixels drawn to represent the source and the receivers
+ integer, parameter :: width_cross = 5, thickness_cross = 1, size_square = 3
+
+ integer NX,NY,it,field_number,ISOURCE,JSOURCE,NPOINTS_PML
+ logical USE_PML_XMIN,USE_PML_XMAX,USE_PML_YMIN,USE_PML_YMAX
+
+ double precision, dimension(NX,NY) :: image_data_2D
+
+ integer :: ix,iy
+
+ character(len=100) :: file_name,system_command
+
+ integer :: R, G, B
+
+ double precision :: normalized_value,max_amplitude
+
+! open image file and create system command to convert image to more convenient format
+ if(field_number == 1) then
+ write(file_name,"('image',i6.6,'_Vx.pnm')") it
+ write(system_command,"('convert image',i6.6,'_Vx.pnm image',i6.6,'_Vx.gif ; rm image',i6.6,'_Vx.pnm')") it,it,it
+ else if(field_number == 2) then
+ write(file_name,"('image',i6.6,'_Vy.pnm')") it
+ write(system_command,"('convert image',i6.6,'_Vy.pnm image',i6.6,'_Vy.gif ; rm image',i6.6,'_Vy.pnm')") it,it,it
+ endif
+
+ open(unit=27, file=file_name, status='unknown')
+
+ write(27,"('P3')") ! write image in PNM P3 format
+
+ write(27,*) NX,NY ! write image size
+ write(27,*) '255' ! maximum value of each pixel color
+
+! compute maximum amplitude
+ max_amplitude = maxval(abs(image_data_2D))
+
+! image starts in upper-left corner in PNM format
+ do iy=NY,1,-1
+ do ix=1,NX
+
+! define data as vector component normalized to [-1:1] and rounded to nearest integer
+! keeping in mind that amplitude can be negative
+ normalized_value = image_data_2D(ix,iy) / max_amplitude
+
+! suppress values that are outside [-1:+1] to avoid small edge effects
+ if(normalized_value < -1.d0) normalized_value = -1.d0
+ if(normalized_value > 1.d0) normalized_value = 1.d0
+
+! draw an orange cross to represent the source
+ if((ix >= ISOURCE - width_cross .and. ix <= ISOURCE + width_cross .and. &
+ iy >= JSOURCE - thickness_cross .and. iy <= JSOURCE + thickness_cross) .or. &
+ (ix >= ISOURCE - thickness_cross .and. ix <= ISOURCE + thickness_cross .and. &
+ iy >= JSOURCE - width_cross .and. iy <= JSOURCE + width_cross)) then
+ R = 255
+ G = 157
+ B = 0
+
+! display two-pixel-thick black frame around the image
+ else if(ix <= 2 .or. ix >= NX-1 .or. iy <= 2 .or. iy >= NY-1) then
+ R = 0
+ G = 0
+ B = 0
+
+! display edges of the PML layers
+ else if((USE_PML_XMIN .and. ix == NPOINTS_PML) .or. &
+ (USE_PML_XMAX .and. ix == NX - NPOINTS_PML) .or. &
+ (USE_PML_YMIN .and. iy == NPOINTS_PML) .or. &
+ (USE_PML_YMAX .and. iy == NY - NPOINTS_PML)) then
+ R = 255
+ G = 150
+ B = 0
+
+! suppress all the values that are below the threshold
+ else if(abs(image_data_2D(ix,iy)) <= max_amplitude * cutvect) then
+
+! use a black or white background for points that are below the threshold
+ if(WHITE_BACKGROUND) then
+ R = 255
+ G = 255
+ B = 255
+ else
+ R = 0
+ G = 0
+ B = 0
+ endif
+
+! represent regular image points using red if value is positive, blue if negative
+ else if(normalized_value >= 0.d0) then
+ R = nint(255.d0*normalized_value**POWER_DISPLAY)
+ G = 0
+ B = 0
+ else
+ R = 0
+ G = 0
+ B = nint(255.d0*abs(normalized_value)**POWER_DISPLAY)
+ endif
+
+! write color pixel
+ write(27,"(i3,' ',i3,' ',i3)") R,G,B
+
+ enddo
+ enddo
+
+! close file
+ close(27)
+
+! call the system to convert image to GIF (can be commented out if "call system" is missing in your compiler)
+! call system(system_command)
+
+ end subroutine create_2D_image
+
+!
+! CeCILL FREE SOFTWARE LICENSE AGREEMENT
+!
+! Notice
+!
+! This Agreement is a Free Software license agreement that is the result
+! of discussions between its authors in order to ensure compliance with
+! the two main principles guiding its drafting:
+!
+! * firstly, compliance with the principles governing the distribution
+! of Free Software: access to source code, broad rights granted to
+! users,
+! * secondly, the election of a governing law, French law, with which
+! it is conformant, both as regards the law of torts and
+! intellectual property law, and the protection that it offers to
+! both authors and holders of the economic rights over software.
+!
+! The authors of the CeCILL (for Ce[a] C[nrs] I[nria] L[ogiciel] L[ibre])
+! license are:
+!
+! Commissariat a l'Energie Atomique - CEA, a public scientific, technical
+! and industrial research establishment, having its principal place of
+! business at 25 rue Leblanc, immeuble Le Ponant D, 75015 Paris, France.
+!
+! Centre National de la Recherche Scientifique - CNRS, a public scientific
+! and technological establishment, having its principal place of business
+! at 3 rue Michel-Ange, 75794 Paris cedex 16, France.
+!
+! Institut National de Recherche en Informatique et en Automatique -
+! INRIA, a public scientific and technological establishment, having its
+! principal place of business at Domaine de Voluceau, Rocquencourt, BP
+! 105, 78153 Le Chesnay cedex, France.
+!
+! Preamble
+!
+! The purpose of this Free Software license agreement is to grant users
+! the right to modify and redistribute the software governed by this
+! license within the framework of an open source distribution model.
+!
+! The exercising of these rights is conditional upon certain obligations
+! for users so as to preserve this status for all subsequent redistributions.
+!
+! In consideration of access to the source code and the rights to copy,
+! modify and redistribute granted by the license, users are provided only
+! with a limited warranty and the software's author, the holder of the
+! economic rights, and the successive licensors only have limited liability.
+!
+! In this respect, the risks associated with loading, using, modifying
+! and/or developing or reproducing the software by the user are brought to
+! the user's attention, given its Free Software status, which may make it
+! complicated to use, with the result that its use is reserved for
+! developers and experienced professionals having in-depth computer
+! knowledge. Users are therefore encouraged to load and test the
+! suitability of the software as regards their requirements in conditions
+! enabling the security of their systems and/or data to be ensured and,
+! more generally, to use and operate it in the same conditions of
+! security. This Agreement may be freely reproduced and published,
+! provided it is not altered, and that no provisions are either added or
+! removed herefrom.
+!
+! This Agreement may apply to any or all software for which the holder of
+! the economic rights decides to submit the use thereof to its provisions.
+!
+! Article 1 - DEFINITIONS
+!
+! For the purpose of this Agreement, when the following expressions
+! commence with a capital letter, they shall have the following meaning:
+!
+! Agreement: means this license agreement, and its possible subsequent
+! versions and annexes.
+!
+! Software: means the software in its Object Code and/or Source Code form
+! and, where applicable, its documentation, "as is" when the Licensee
+! accepts the Agreement.
+!
+! Initial Software: means the Software in its Source Code and possibly its
+! Object Code form and, where applicable, its documentation, "as is" when
+! it is first distributed under the terms and conditions of the Agreement.
+!
+! Modified Software: means the Software modified by at least one
+! Contribution.
+!
+! Source Code: means all the Software's instructions and program lines to
+! which access is required so as to modify the Software.
+!
+! Object Code: means the binary files originating from the compilation of
+! the Source Code.
+!
+! Holder: means the holder(s) of the economic rights over the Initial
+! Software.
+!
+! Licensee: means the Software user(s) having accepted the Agreement.
+!
+! Contributor: means a Licensee having made at least one Contribution.
+!
+! Licensor: means the Holder, or any other individual or legal entity, who
+! distributes the Software under the Agreement.
+!
+! Contribution: means any or all modifications, corrections, translations,
+! adaptations and/or new functions integrated into the Software by any or
+! all Contributors, as well as any or all Internal Modules.
+!
+! Module: means a set of sources files including their documentation that
+! enables supplementary functions or services in addition to those offered
+! by the Software.
+!
+! External Module: means any or all Modules, not derived from the
+! Software, so that this Module and the Software run in separate address
+! spaces, with one calling the other when they are run.
+!
+! Internal Module: means any or all Module, connected to the Software so
+! that they both execute in the same address space.
+!
+! GNU GPL: means the GNU General Public License version 2 or any
+! subsequent version, as published by the Free Software Foundation Inc.
+!
+! Parties: mean both the Licensee and the Licensor.
+!
+! These expressions may be used both in singular and plural form.
+!
+! Article 2 - PURPOSE
+!
+! The purpose of the Agreement is the grant by the Licensor to the
+! Licensee of a non-exclusive, transferable and worldwide license for the
+! Software as set forth in Article 5 hereinafter for the whole term of the
+! protection granted by the rights over said Software.
+!
+! Article 3 - ACCEPTANCE
+!
+! 3.1 The Licensee shall be deemed as having accepted the terms and
+! conditions of this Agreement upon the occurrence of the first of the
+! following events:
+!
+! * (i) loading the Software by any or all means, notably, by
+! downloading from a remote server, or by loading from a physical
+! medium;
+! * (ii) the first time the Licensee exercises any of the rights
+! granted hereunder.
+!
+! 3.2 One copy of the Agreement, containing a notice relating to the
+! characteristics of the Software, to the limited warranty, and to the
+! fact that its use is restricted to experienced users has been provided
+! to the Licensee prior to its acceptance as set forth in Article 3.1
+! hereinabove, and the Licensee hereby acknowledges that it has read and
+! understood it.
+!
+! Article 4 - EFFECTIVE DATE AND TERM
+!
+! 4.1 EFFECTIVE DATE
+!
+! The Agreement shall become effective on the date when it is accepted by
+! the Licensee as set forth in Article 3.1.
+!
+! 4.2 TERM
+!
+! The Agreement shall remain in force for the entire legal term of
+! protection of the economic rights over the Software.
+!
+! Article 5 - SCOPE OF RIGHTS GRANTED
+!
+! The Licensor hereby grants to the Licensee, who accepts, the following
+! rights over the Software for any or all use, and for the term of the
+! Agreement, on the basis of the terms and conditions set forth hereinafter.
+!
+! Besides, if the Licensor owns or comes to own one or more patents
+! protecting all or part of the functions of the Software or of its
+! components, the Licensor undertakes not to enforce the rights granted by
+! these patents against successive Licensees using, exploiting or
+! modifying the Software. If these patents are transferred, the Licensor
+! undertakes to have the transferees subscribe to the obligations set
+! forth in this paragraph.
+!
+! 5.1 RIGHT OF USE
+!
+! The Licensee is authorized to use the Software, without any limitation
+! as to its fields of application, with it being hereinafter specified
+! that this comprises:
+!
+! 1. permanent or temporary reproduction of all or part of the Software
+! by any or all means and in any or all form.
+!
+! 2. loading, displaying, running, or storing the Software on any or
+! all medium.
+!
+! 3. entitlement to observe, study or test its operation so as to
+! determine the ideas and principles behind any or all constituent
+! elements of said Software. This shall apply when the Licensee
+! carries out any or all loading, displaying, running, transmission
+! or storage operation as regards the Software, that it is entitled
+! to carry out hereunder.
+!
+! 5.2 ENTITLEMENT TO MAKE CONTRIBUTIONS
+!
+! The right to make Contributions includes the right to translate, adapt,
+! arrange, or make any or all modifications to the Software, and the right
+! to reproduce the resulting software.
+!
+! The Licensee is authorized to make any or all Contributions to the
+! Software provided that it includes an explicit notice that it is the
+! author of said Contribution and indicates the date of the creation thereof.
+!
+! 5.3 RIGHT OF DISTRIBUTION
+!
+! In particular, the right of distribution includes the right to publish,
+! transmit and communicate the Software to the general public on any or
+! all medium, and by any or all means, and the right to market, either in
+! consideration of a fee, or free of charge, one or more copies of the
+! Software by any means.
+!
+! The Licensee is further authorized to distribute copies of the modified
+! or unmodified Software to third parties according to the terms and
+! conditions set forth hereinafter.
+!
+! 5.3.1 DISTRIBUTION OF SOFTWARE WITHOUT MODIFICATION
+!
+! The Licensee is authorized to distribute true copies of the Software in
+! Source Code or Object Code form, provided that said distribution
+! complies with all the provisions of the Agreement and is accompanied by:
+!
+! 1. a copy of the Agreement,
+!
+! 2. a notice relating to the limitation of both the Licensor's
+! warranty and liability as set forth in Articles 8 and 9,
+!
+! and that, in the event that only the Object Code of the Software is
+! redistributed, the Licensee allows future Licensees unhindered access to
+! the full Source Code of the Software by indicating how to access it, it
+! being understood that the additional cost of acquiring the Source Code
+! shall not exceed the cost of transferring the data.
+!
+! 5.3.2 DISTRIBUTION OF MODIFIED SOFTWARE
+!
+! When the Licensee makes a Contribution to the Software, the terms and
+! conditions for the distribution of the resulting Modified Software
+! become subject to all the provisions of this Agreement.
+!
+! The Licensee is authorized to distribute the Modified Software, in
+! source code or object code form, provided that said distribution
+! complies with all the provisions of the Agreement and is accompanied by:
+!
+! 1. a copy of the Agreement,
+!
+! 2. a notice relating to the limitation of both the Licensor's
+! warranty and liability as set forth in Articles 8 and 9,
+!
+! and that, in the event that only the object code of the Modified
+! Software is redistributed, the Licensee allows future Licensees
+! unhindered access to the full source code of the Modified Software by
+! indicating how to access it, it being understood that the additional
+! cost of acquiring the source code shall not exceed the cost of
+! transferring the data.
+!
+! 5.3.3 DISTRIBUTION OF EXTERNAL MODULES
+!
+! When the Licensee has developed an External Module, the terms and
+! conditions of this Agreement do not apply to said External Module, that
+! may be distributed under a separate license agreement.
+!
+! 5.3.4 COMPATIBILITY WITH THE GNU GPL
+!
+! The Licensee can include a code that is subject to the provisions of one
+! of the versions of the GNU GPL in the Modified or unmodified Software,
+! and distribute that entire code under the terms of the same version of
+! the GNU GPL.
+!
+! The Licensee can include the Modified or unmodified Software in a code
+! that is subject to the provisions of one of the versions of the GNU GPL,
+! and distribute that entire code under the terms of the same version of
+! the GNU GPL.
+!
+! Article 6 - INTELLECTUAL PROPERTY
+!
+! 6.1 OVER THE INITIAL SOFTWARE
+!
+! The Holder owns the economic rights over the Initial Software. Any or
+! all use of the Initial Software is subject to compliance with the terms
+! and conditions under which the Holder has elected to distribute its work
+! and no one shall be entitled to modify the terms and conditions for the
+! distribution of said Initial Software.
+!
+! The Holder undertakes that the Initial Software will remain ruled at
+! least by this Agreement, for the duration set forth in Article 4.2.
+!
+! 6.2 OVER THE CONTRIBUTIONS
+!
+! The Licensee who develops a Contribution is the owner of the
+! intellectual property rights over this Contribution as defined by
+! applicable law.
+!
+! 6.3 OVER THE EXTERNAL MODULES
+!
+! The Licensee who develops an External Module is the owner of the
+! intellectual property rights over this External Module as defined by
+! applicable law and is free to choose the type of agreement that shall
+! govern its distribution.
+!
+! 6.4 JOINT PROVISIONS
+!
+! The Licensee expressly undertakes:
+!
+! 1. not to remove, or modify, in any manner, the intellectual property
+! notices attached to the Software;
+!
+! 2. to reproduce said notices, in an identical manner, in the copies
+! of the Software modified or not.
+!
+! The Licensee undertakes not to directly or indirectly infringe the
+! intellectual property rights of the Holder and/or Contributors on the
+! Software and to take, where applicable, vis-a-vis its staff, any and all
+! measures required to ensure respect of said intellectual property rights
+! of the Holder and/or Contributors.
+!
+! Article 7 - RELATED SERVICES
+!
+! 7.1 Under no circumstances shall the Agreement oblige the Licensor to
+! provide technical assistance or maintenance services for the Software.
+!
+! However, the Licensor is entitled to offer this type of services. The
+! terms and conditions of such technical assistance, and/or such
+! maintenance, shall be set forth in a separate instrument. Only the
+! Licensor offering said maintenance and/or technical assistance services
+! shall incur liability therefor.
+!
+! 7.2 Similarly, any Licensor is entitled to offer to its licensees, under
+! its sole responsibility, a warranty, that shall only be binding upon
+! itself, for the redistribution of the Software and/or the Modified
+! Software, under terms and conditions that it is free to decide. Said
+! warranty, and the financial terms and conditions of its application,
+! shall be subject of a separate instrument executed between the Licensor
+! and the Licensee.
+!
+! Article 8 - LIABILITY
+!
+! 8.1 Subject to the provisions of Article 8.2, the Licensee shall be
+! entitled to claim compensation for any direct loss it may have suffered
+! from the Software as a result of a fault on the part of the relevant
+! Licensor, subject to providing evidence thereof.
+!
+! 8.2 The Licensor's liability is limited to the commitments made under
+! this Agreement and shall not be incurred as a result of in particular:
+! (i) loss due the Licensee's total or partial failure to fulfill its
+! obligations, (ii) direct or consequential loss that is suffered by the
+! Licensee due to the use or performance of the Software, and (iii) more
+! generally, any consequential loss. In particular the Parties expressly
+! agree that any or all pecuniary or business loss (i.e. loss of data,
+! loss of profits, operating loss, loss of customers or orders,
+! opportunity cost, any disturbance to business activities) or any or all
+! legal proceedings instituted against the Licensee by a third party,
+! shall constitute consequential loss and shall not provide entitlement to
+! any or all compensation from the Licensor.
+!
+! Article 9 - WARRANTY
+!
+! 9.1 The Licensee acknowledges that the scientific and technical
+! state-of-the-art when the Software was distributed did not enable all
+! possible uses to be tested and verified, nor for the presence of
+! possible defects to be detected. In this respect, the Licensee's
+! attention has been drawn to the risks associated with loading, using,
+! modifying and/or developing and reproducing the Software which are
+! reserved for experienced users.
+!
+! The Licensee shall be responsible for verifying, by any or all means,
+! the suitability of the product for its requirements, its good working
+! order, and for ensuring that it shall not cause damage to either persons
+! or properties.
+!
+! 9.2 The Licensor hereby represents, in good faith, that it is entitled
+! to grant all the rights over the Software (including in particular the
+! rights set forth in Article 5).
+!
+! 9.3 The Licensee acknowledges that the Software is supplied "as is" by
+! the Licensor without any other express or tacit warranty, other than
+! that provided for in Article 9.2 and, in particular, without any warranty
+! as to its commercial value, its secured, safe, innovative or relevant
+! nature.
+!
+! Specifically, the Licensor does not warrant that the Software is free
+! from any error, that it will operate without interruption, that it will
+! be compatible with the Licensee's own equipment and software
+! configuration, nor that it will meet the Licensee's requirements.
+!
+! 9.4 The Licensor does not either expressly or tacitly warrant that the
+! Software does not infringe any third party intellectual property right
+! relating to a patent, software or any other property right. Therefore,
+! the Licensor disclaims any and all liability towards the Licensee
+! arising out of any or all proceedings for infringement that may be
+! instituted in respect of the use, modification and redistribution of the
+! Software. Nevertheless, should such proceedings be instituted against
+! the Licensee, the Licensor shall provide it with technical and legal
+! assistance for its defense. Such technical and legal assistance shall be
+! decided on a case-by-case basis between the relevant Licensor and the
+! Licensee pursuant to a memorandum of understanding. The Licensor
+! disclaims any and all liability as regards the Licensee's use of the
+! name of the Software. No warranty is given as regards the existence of
+! prior rights over the name of the Software or as regards the existence
+! of a trademark.
+!
+! Article 10 - TERMINATION
+!
+! 10.1 In the event of a breach by the Licensee of its obligations
+! hereunder, the Licensor may automatically terminate this Agreement
+! thirty (30) days after notice has been sent to the Licensee and has
+! remained ineffective.
+!
+! 10.2 A Licensee whose Agreement is terminated shall no longer be
+! authorized to use, modify or distribute the Software. However, any
+! licenses that it may have granted prior to termination of the Agreement
+! shall remain valid subject to their having been granted in compliance
+! with the terms and conditions hereof.
+!
+! Article 11 - MISCELLANEOUS
+!
+! 11.1 EXCUSABLE EVENTS
+!
+! Neither Party shall be liable for any or all delay, or failure to
+! perform the Agreement, that may be attributable to an event of force
+! majeure, an act of God or an outside cause, such as defective
+! functioning or interruptions of the electricity or telecommunications
+! networks, network paralysis following a virus attack, intervention by
+! government authorities, natural disasters, water damage, earthquakes,
+! fire, explosions, strikes and labor unrest, war, etc.
+!
+! 11.2 Any failure by either Party, on one or more occasions, to invoke
+! one or more of the provisions hereof, shall under no circumstances be
+! interpreted as being a waiver by the interested Party of its right to
+! invoke said provision(s) subsequently.
+!
+! 11.3 The Agreement cancels and replaces any or all previous agreements,
+! whether written or oral, between the Parties and having the same
+! purpose, and constitutes the entirety of the agreement between said
+! Parties concerning said purpose. No supplement or modification to the
+! terms and conditions hereof shall be effective as between the Parties
+! unless it is made in writing and signed by their duly authorized
+! representatives.
+!
+! 11.4 In the event that one or more of the provisions hereof were to
+! conflict with a current or future applicable act or legislative text,
+! said act or legislative text shall prevail, and the Parties shall make
+! the necessary amendments so as to comply with said act or legislative
+! text. All other provisions shall remain effective. Similarly, invalidity
+! of a provision of the Agreement, for any reason whatsoever, shall not
+! cause the Agreement as a whole to be invalid.
+!
+! 11.5 LANGUAGE
+!
+! The Agreement is drafted in both French and English and both versions
+! are deemed authentic.
+!
+! Article 12 - NEW VERSIONS OF THE AGREEMENT
+!
+! 12.1 Any person is authorized to duplicate and distribute copies of this
+! Agreement.
+!
+! 12.2 So as to ensure coherence, the wording of this Agreement is
+! protected and may only be modified by the authors of the License, who
+! reserve the right to periodically publish updates or new versions of the
+! Agreement, each with a separate number. These subsequent versions may
+! address new issues encountered by Free Software.
+!
+! 12.3 Any Software distributed under a given version of the Agreement may
+! only be subsequently distributed under the same version of the Agreement
+! or a subsequent version, subject to the provisions of Article 5.3.4.
+!
+! Article 13 - GOVERNING LAW AND JURISDICTION
+!
+! 13.1 The Agreement is governed by French law. The Parties agree to
+! endeavor to seek an amicable solution to any disagreements or disputes
+! that may arise during the performance of the Agreement.
+!
+! 13.2 Failing an amicable solution within two (2) months as from their
+! occurrence, and unless emergency proceedings are necessary, the
+! disagreements or disputes shall be referred to the Paris Courts having
+! jurisdiction, by the more diligent Party.
+!
+! Version 2.0 dated 2006-09-05.
+!
Added: seismo/3D/CPML/tags/v1.1.1/seismic_CPML_2D_isotropic_fourth_order.f90
===================================================================
--- seismo/3D/CPML/tags/v1.1.1/seismic_CPML_2D_isotropic_fourth_order.f90 (rev 0)
+++ seismo/3D/CPML/tags/v1.1.1/seismic_CPML_2D_isotropic_fourth_order.f90 2009-11-03 21:35:50 UTC (rev 15926)
@@ -0,0 +1,1481 @@
+!
+! SEISMIC_CPML Version 1.1.1, November 2009.
+!
+! Copyright Universite de Pau et des Pays de l'Adour, CNRS and INRIA, France.
+! Contributors: Dimitri Komatitsch, dimitri DOT komatitsch aT univ-pau DOT fr
+! and Roland Martin, roland DOT martin aT univ-pau DOT fr
+!
+! This software is a computer program whose purpose is to solve
+! the two-dimensional isotropic elastic wave equation
+! using a finite-difference method with Convolutional Perfectly Matched
+! Layer (C-PML) conditions.
+!
+! This software is governed by the CeCILL license under French law and
+! abiding by the rules of distribution of free software. You can use,
+! modify and/or redistribute the software under the terms of the CeCILL
+! license as circulated by CEA, CNRS and INRIA at the following URL
+! "http://www.cecill.info".
+!
+! As a counterpart to the access to the source code and rights to copy,
+! modify and redistribute granted by the license, users are provided only
+! with a limited warranty and the software's author, the holder of the
+! economic rights, and the successive licensors have only limited
+! liability.
+!
+! In this respect, the user's attention is drawn to the risks associated
+! with loading, using, modifying and/or developing or reproducing the
+! software by the user in light of its specific status of free software,
+! that may mean that it is complicated to manipulate, and that also
+! therefore means that it is reserved for developers and experienced
+! professionals having in-depth computer knowledge. Users are therefore
+! encouraged to load and test the software's suitability as regards their
+! requirements in conditions enabling the security of their systems and/or
+! data to be ensured and, more generally, to use and operate it in the
+! same conditions as regards security.
+!
+! The full text of the license is available at the end of this program
+! and in file "LICENSE".
+
+ program seismic_CPML_2D_iso_fourth
+
+! 2D elastic finite-difference code in velocity and stress formulation
+! with Convolutional-PML (C-PML) absorbing conditions for an isotropic medium
+
+! Dimitri Komatitsch, University of Pau, France, April 2007.
+! Fourth-order implementation by Dimitri Komatitsch and Roland Martin, University of Pau, France, August 2007.
+
+! The staggered-grid formulation of Madariaga (1976) and Virieux (1986) is used:
+!
+! ^ y
+! |
+! |
+!
+! +-------------------+
+! | |
+! | |
+! | |
+! | |
+! | v_y |
+! sigma_xy +---------+ |
+! | | |
+! | | |
+! | | |
+! | | |
+! | | |
+! +---------+---------+ ---> x
+! v_x sigma_xx
+! sigma_yy
+!
+! but a fourth-order spatial operator is used instead of a second-order operator
+! as in program seismic_CPML_2D_iso_second.f90 . You can type the following command
+! to see the changes that have been made to switch from the second-order operator
+! to the fourth-order operator:
+!
+! diff seismic_CPML_2D_isotropic_second_order.f90 seismic_CPML_2D_isotropic_fourth_order.f90
+
+! The C-PML implementation is based in part on formulas given in Roden and Gedney (2000)
+!
+! If you use this code for your own research, please cite some (or all) of these articles:
+!
+! @ARTICLE{KoMa07,
+! author = {Dimitri Komatitsch and Roland Martin},
+! title = {An unsplit convolutional {P}erfectly {M}atched {L}ayer improved
+! at grazing incidence for the seismic wave equation},
+! journal = {Geophysics},
+! year = {2007},
+! volume = {72},
+! number = {5},
+! pages = {SM155-SM167},
+! doi = {10.1190/1.2757586}}
+!
+! @ARTICLE{MaKoEz08,
+! author = {Roland Martin and Dimitri Komatitsch and Abdelaaziz Ezziani},
+! title = {An unsplit convolutional perfectly matched layer improved at grazing
+! incidence for seismic wave equation in poroelastic media},
+! journal = {Geophysics},
+! year = {2008},
+! volume = {73},
+! pages = {T51-T61},
+! number = {4},
+! doi = {10.1190/1.2939484}}
+!
+! @ARTICLE{MaKoGe08,
+! author = {Roland Martin and Dimitri Komatitsch and Stephen D. Gedney},
+! title = {A variational formulation of a stabilized unsplit convolutional perfectly
+! matched layer for the isotropic or anisotropic seismic wave equation},
+! journal = {Computer Modeling in Engineering and Sciences},
+! year = {2008},
+! volume = {37},
+! pages = {274-304},
+! number = {3}}
+!
+! @ARTICLE{RoGe00,
+! author = {J. A. Roden and S. D. Gedney},
+! title = {Convolution {PML} ({CPML}): {A}n Efficient {FDTD} Implementation
+! of the {CFS}-{PML} for Arbitrary Media},
+! journal = {Microwave and Optical Technology Letters},
+! year = {2000},
+! volume = {27},
+! number = {5},
+! pages = {334-339},
+! doi = {10.1002/1098-2760(20001205)27:5<334::AID-MOP14>3.0.CO;2-A}}
+!
+! To display the 2D results as color images, use:
+!
+! " display image*.gif " or " gimp image*.gif "
+!
+! or
+!
+! " montage -geometry +0+3 -rotate 90 -tile 1x21 image*Vx*.gif allfiles_Vx.gif "
+! " montage -geometry +0+3 -rotate 90 -tile 1x21 image*Vy*.gif allfiles_Vy.gif "
+! then " display allfiles_Vx.gif " or " gimp allfiles_Vx.gif "
+! then " display allfiles_Vy.gif " or " gimp allfiles_Vy.gif "
+!
+
+ implicit none
+
+! total number of grid points in each direction of the grid
+ integer, parameter :: NX = 101
+ integer, parameter :: NY = 641
+
+! size of a grid cell
+ double precision, parameter :: DELTAX = 10.d0
+ double precision, parameter :: DELTAY = DELTAX
+
+! flags to add PML layers to the edges of the grid
+ logical, parameter :: USE_PML_XMIN = .true.
+ logical, parameter :: USE_PML_XMAX = .true.
+ logical, parameter :: USE_PML_YMIN = .true.
+ logical, parameter :: USE_PML_YMAX = .true.
+
+! thickness of the PML layer in grid points
+ integer, parameter :: NPOINTS_PML = 10
+
+! P-velocity, S-velocity and density
+ double precision, parameter :: cp = 3300.d0
+ double precision, parameter :: cs = cp / 1.732d0
+ double precision, parameter :: density = 2800.d0
+
+! total number of time steps
+! the time step is twice smaller for this fourth-order simulation,
+! therefore let us double the number of time steps to keep the same total duration
+ integer, parameter :: NSTEP = 2000 * 2
+
+! time step in seconds
+! fourth-order in space and second-order in time finite-difference schemes
+! are less stable than second-order in space and second-order in time,
+! therefore let us divide the time step by 2
+ double precision, parameter :: DELTAT = 2.d-3 / 2
+
+! parameters for the source
+ double precision, parameter :: f0 = 7.d0
+ double precision, parameter :: t0 = 1.20d0 / f0
+ double precision, parameter :: factor = 1.d7
+
+! source
+ integer, parameter :: ISOURCE = NX - 2*NPOINTS_PML - 1
+ integer, parameter :: JSOURCE = 2 * NY / 3 + 1
+ double precision, parameter :: xsource = (ISOURCE - 1) * DELTAX
+ double precision, parameter :: ysource = (JSOURCE - 1) * DELTAY
+! angle of source force clockwise with respect to vertical (Y) axis
+ double precision, parameter :: ANGLE_FORCE = 135.d0
+
+! receivers
+ integer, parameter :: NREC = 2
+ double precision, parameter :: xdeb = xsource - 100.d0 ! first receiver x in meters
+ double precision, parameter :: ydeb = 2300.d0 ! first receiver y in meters
+ double precision, parameter :: xfin = xsource ! last receiver x in meters
+ double precision, parameter :: yfin = 300.d0 ! last receiver y in meters
+
+! display information on the screen from time to time
+! the time step is twice smaller for this fourth-order simulation,
+! therefore let us double the interval in time steps at which we display information
+ integer, parameter :: IT_DISPLAY = 100 * 2
+
+! value of PI
+ double precision, parameter :: PI = 3.141592653589793238462643d0
+
+! conversion from degrees to radians
+ double precision, parameter :: DEGREES_TO_RADIANS = PI / 180.d0
+
+! zero
+ double precision, parameter :: ZERO = 0.d0
+
+! large value for maximum
+ double precision, parameter :: HUGEVAL = 1.d+30
+
+! velocity threshold above which we consider that the code became unstable
+ double precision, parameter :: STABILITY_THRESHOLD = 1.d+25
+
+! main arrays
+ double precision, dimension(0:NX+1,0:NY+1) :: vx,vy,sigmaxx,sigmayy,sigmaxy,lambda,mu,rho
+
+! to interpolate material parameters at the right location in the staggered grid cell
+ double precision lambda_half_x,mu_half_x,lambda_plus_two_mu_half_x,mu_half_y,rho_half_x_half_y
+
+! for evolution of total energy in the medium
+ double precision epsilon_xx,epsilon_yy,epsilon_xy
+ double precision, dimension(NSTEP) :: total_energy_kinetic,total_energy_potential
+
+! power to compute d0 profile
+ double precision, parameter :: NPOWER = 2.d0
+
+ double precision, parameter :: K_MAX_PML = 1.d0 ! from Gedney page 8.11
+ double precision, parameter :: ALPHA_MAX_PML = 2.d0*PI*(f0/2.d0) ! from festa and Vilotte
+
+! arrays for the memory variables
+! could declare these arrays in PML only to save a lot of memory, but proof of concept only here
+ double precision, dimension(0:NX+1,0:NY+1) :: &
+ memory_dvx_dx, &
+ memory_dvx_dy, &
+ memory_dvy_dx, &
+ memory_dvy_dy, &
+ memory_dsigmaxx_dx, &
+ memory_dsigmayy_dy, &
+ memory_dsigmaxy_dx, &
+ memory_dsigmaxy_dy
+
+ double precision :: &
+ value_dvx_dx, &
+ value_dvx_dy, &
+ value_dvy_dx, &
+ value_dvy_dy, &
+ value_dsigmaxx_dx, &
+ value_dsigmayy_dy, &
+ value_dsigmaxy_dx, &
+ value_dsigmaxy_dy
+
+! 1D arrays for the damping profiles
+ double precision, dimension(NX) :: d_x,K_x,alpha_prime_x,a_x,b_x,d_x_half,K_x_half,alpha_prime_x_half,a_x_half,b_x_half
+ double precision, dimension(NY) :: d_y,K_y,alpha_prime_y,a_y,b_y,d_y_half,K_y_half,alpha_prime_y_half,a_y_half,b_y_half
+
+ double precision :: thickness_PML_x,thickness_PML_y,xoriginleft,xoriginright,yoriginbottom,yorigintop
+ double precision :: Rcoef,d0_x,d0_y,xval,yval,abscissa_in_PML,abscissa_normalized
+
+! for the source
+ double precision :: a,t,force_x,force_y,source_term
+
+! for receivers
+ double precision xspacerec,yspacerec,distval,dist
+ integer, dimension(NREC) :: ix_rec,iy_rec
+ double precision, dimension(NREC) :: xrec,yrec
+
+! for seismograms
+ double precision, dimension(NSTEP,NREC) :: sisvx,sisvy
+
+ integer :: i,j,it,irec
+
+ double precision :: Courant_number,velocnorm
+
+!---
+!--- program starts here
+!---
+
+ print *
+ print *,'2D elastic finite-difference code in velocity and stress formulation with C-PML'
+ print *
+
+! display size of the model
+ print *
+ print *,'NX = ',NX
+ print *,'NY = ',NY
+ print *
+ print *,'size of the model along X = ',(NX - 1) * DELTAX
+ print *,'size of the model along Y = ',(NY - 1) * DELTAY
+ print *
+ print *,'Total number of grid points = ',NX * NY
+ print *
+
+!--- define profile of absorption in PML region
+
+! thickness of the PML layer in meters
+ thickness_PML_x = NPOINTS_PML * DELTAX
+ thickness_PML_y = NPOINTS_PML * DELTAY
+
+! reflection coefficient (INRIA report section 6.1)
+ Rcoef = 0.001d0
+
+! check that NPOWER is okay
+ if(NPOWER < 1) stop 'NPOWER must be greater than 1'
+
+! compute d0 from INRIA report section 6.1
+ d0_x = - (NPOWER + 1) * cp * log(Rcoef) / (2.d0 * thickness_PML_x)
+ d0_y = - (NPOWER + 1) * cp * log(Rcoef) / (2.d0 * thickness_PML_y)
+
+ print *,'d0_x = ',d0_x
+ print *,'d0_y = ',d0_y
+ print *
+
+ d_x(:) = ZERO
+ d_x_half(:) = ZERO
+ K_x(:) = 1.d0
+ K_x_half(:) = 1.d0
+ alpha_prime_x(:) = ZERO
+ alpha_prime_x_half(:) = ZERO
+ a_x(:) = ZERO
+ a_x_half(:) = ZERO
+
+ d_y(:) = ZERO
+ d_y_half(:) = ZERO
+ K_y(:) = 1.d0
+ K_y_half(:) = 1.d0
+ alpha_prime_y(:) = ZERO
+ alpha_prime_y_half(:) = ZERO
+ a_y(:) = ZERO
+ a_y_half(:) = ZERO
+
+! damping in the X direction
+
+! origin of the PML layer (position of right edge minus thickness, in meters)
+ xoriginleft = thickness_PML_x
+ xoriginright = (NX-1)*DELTAX - thickness_PML_x
+
+ do i = 1,NX
+
+! abscissa of current grid point along the damping profile
+ xval = DELTAX * dble(i-1)
+
+!---------- left edge
+ if(USE_PML_XMIN) then
+
+! define damping profile at the grid points
+ abscissa_in_PML = xoriginleft - xval
+ if(abscissa_in_PML >= ZERO) then
+ abscissa_normalized = abscissa_in_PML / thickness_PML_x
+ d_x(i) = d0_x * abscissa_normalized**NPOWER
+! this taken from Gedney page 8.2
+ K_x(i) = 1.d0 + (K_MAX_PML - 1.d0) * abscissa_normalized**NPOWER
+ alpha_prime_x(i) = ALPHA_MAX_PML * (1.d0 - abscissa_normalized)
+ endif
+
+! define damping profile at half the grid points
+ abscissa_in_PML = xoriginleft - (xval + DELTAX/2.d0)
+ if(abscissa_in_PML >= ZERO) then
+ abscissa_normalized = abscissa_in_PML / thickness_PML_x
+ d_x_half(i) = d0_x * abscissa_normalized**NPOWER
+! this taken from Gedney page 8.2
+ K_x_half(i) = 1.d0 + (K_MAX_PML - 1.d0) * abscissa_normalized**NPOWER
+ alpha_prime_x_half(i) = ALPHA_MAX_PML * (1.d0 - abscissa_normalized)
+ endif
+
+ endif
+
+!---------- right edge
+ if(USE_PML_XMAX) then
+
+! define damping profile at the grid points
+ abscissa_in_PML = xval - xoriginright
+ if(abscissa_in_PML >= ZERO) then
+ abscissa_normalized = abscissa_in_PML / thickness_PML_x
+ d_x(i) = d0_x * abscissa_normalized**NPOWER
+! this taken from Gedney page 8.2
+ K_x(i) = 1.d0 + (K_MAX_PML - 1.d0) * abscissa_normalized**NPOWER
+ alpha_prime_x(i) = ALPHA_MAX_PML * (1.d0 - abscissa_normalized)
+ endif
+
+! define damping profile at half the grid points
+ abscissa_in_PML = xval + DELTAX/2.d0 - xoriginright
+ if(abscissa_in_PML >= ZERO) then
+ abscissa_normalized = abscissa_in_PML / thickness_PML_x
+ d_x_half(i) = d0_x * abscissa_normalized**NPOWER
+! this taken from Gedney page 8.2
+ K_x_half(i) = 1.d0 + (K_MAX_PML - 1.d0) * abscissa_normalized**NPOWER
+ alpha_prime_x_half(i) = ALPHA_MAX_PML * (1.d0 - abscissa_normalized)
+ endif
+
+ endif
+
+! just in case, for -5 at the end
+ if(alpha_prime_x(i) < ZERO) alpha_prime_x(i) = ZERO
+ if(alpha_prime_x_half(i) < ZERO) alpha_prime_x_half(i) = ZERO
+
+ b_x(i) = exp(- (d_x(i) / K_x(i) + alpha_prime_x(i)) * DELTAT)
+ b_x_half(i) = exp(- (d_x_half(i) / K_x_half(i) + alpha_prime_x_half(i)) * DELTAT)
+
+! this to avoid division by zero outside the PML
+ if(abs(d_x(i)) > 1.d-6) a_x(i) = d_x(i) * (b_x(i) - 1.d0) / (K_x(i) * (d_x(i) + K_x(i) * alpha_prime_x(i)))
+ if(abs(d_x_half(i)) > 1.d-6) a_x_half(i) = d_x_half(i) * &
+ (b_x_half(i) - 1.d0) / (K_x_half(i) * (d_x_half(i) + K_x_half(i) * alpha_prime_x_half(i)))
+
+ enddo
+
+! damping in the Y direction
+
+! origin of the PML layer (position of right edge minus thickness, in meters)
+ yoriginbottom = thickness_PML_y
+ yorigintop = NY*DELTAY - thickness_PML_y
+
+ do j = 1,NY
+
+! abscissa of current grid point along the damping profile
+ yval = DELTAY * dble(j-1)
+
+!---------- bottom edge
+ if(USE_PML_YMIN) then
+
+! define damping profile at the grid points
+ abscissa_in_PML = yoriginbottom - yval
+ if(abscissa_in_PML >= ZERO) then
+ abscissa_normalized = abscissa_in_PML / thickness_PML_y
+ d_y(j) = d0_y * abscissa_normalized**NPOWER
+! this taken from Gedney page 8.2
+ K_y(j) = 1.d0 + (K_MAX_PML - 1.d0) * abscissa_normalized**NPOWER
+ alpha_prime_y(j) = ALPHA_MAX_PML * (1.d0 - abscissa_normalized)
+ endif
+
+! define damping profile at half the grid points
+ abscissa_in_PML = yoriginbottom - (yval + DELTAY/2.d0)
+ if(abscissa_in_PML >= ZERO) then
+ abscissa_normalized = abscissa_in_PML / thickness_PML_y
+ d_y_half(j) = d0_y * abscissa_normalized**NPOWER
+! this taken from Gedney page 8.2
+ K_y_half(j) = 1.d0 + (K_MAX_PML - 1.d0) * abscissa_normalized**NPOWER
+ alpha_prime_y_half(j) = ALPHA_MAX_PML * (1.d0 - abscissa_normalized)
+ endif
+
+ endif
+
+!---------- top edge
+ if(USE_PML_YMAX) then
+
+! define damping profile at the grid points
+ abscissa_in_PML = yval - yorigintop
+ if(abscissa_in_PML >= ZERO) then
+ abscissa_normalized = abscissa_in_PML / thickness_PML_y
+ d_y(j) = d0_y * abscissa_normalized**NPOWER
+! this taken from Gedney page 8.2
+ K_y(j) = 1.d0 + (K_MAX_PML - 1.d0) * abscissa_normalized**NPOWER
+ alpha_prime_y(j) = ALPHA_MAX_PML * (1.d0 - abscissa_normalized)
+ endif
+
+! define damping profile at half the grid points
+ abscissa_in_PML = yval + DELTAY/2.d0 - yorigintop
+ if(abscissa_in_PML >= ZERO) then
+ abscissa_normalized = abscissa_in_PML / thickness_PML_y
+ d_y_half(j) = d0_y * abscissa_normalized**NPOWER
+! this taken from Gedney page 8.2
+ K_y_half(j) = 1.d0 + (K_MAX_PML - 1.d0) * abscissa_normalized**NPOWER
+ alpha_prime_y_half(j) = ALPHA_MAX_PML * (1.d0 - abscissa_normalized)
+ endif
+
+ endif
+
+ b_y(j) = exp(- (d_y(j) / K_y(j) + alpha_prime_y(j)) * DELTAT)
+ b_y_half(j) = exp(- (d_y_half(j) / K_y_half(j) + alpha_prime_y_half(j)) * DELTAT)
+
+! this to avoid division by zero outside the PML
+ if(abs(d_y(j)) > 1.d-6) a_y(j) = d_y(j) * (b_y(j) - 1.d0) / (K_y(j) * (d_y(j) + K_y(j) * alpha_prime_y(j)))
+ if(abs(d_y_half(j)) > 1.d-6) a_y_half(j) = d_y_half(j) * &
+ (b_y_half(j) - 1.d0) / (K_y_half(j) * (d_y_half(j) + K_y_half(j) * alpha_prime_y_half(j)))
+
+ enddo
+
+! compute the Lame parameters and density
+ do j = 1,NY
+ do i = 1,NX
+ rho(i,j) = density
+ mu(i,j) = density*cs*cs
+ lambda(i,j) = density*(cp*cp - 2.d0*cs*cs)
+ enddo
+ enddo
+
+! print position of the source
+ print *,'Position of the source:'
+ print *
+ print *,'x = ',xsource
+ print *,'y = ',ysource
+ print *
+
+! define location of receivers
+ print *,'There are ',nrec,' receivers'
+ print *
+ xspacerec = (xfin-xdeb) / dble(NREC-1)
+ yspacerec = (yfin-ydeb) / dble(NREC-1)
+ do irec=1,nrec
+ xrec(irec) = xdeb + dble(irec-1)*xspacerec
+ yrec(irec) = ydeb + dble(irec-1)*yspacerec
+ enddo
+
+! find closest grid point for each receiver
+ do irec=1,nrec
+ dist = HUGEVAL
+ do j = 1,NY
+ do i = 1,NX
+ distval = sqrt((DELTAX*dble(i-1) - xrec(irec))**2 + (DELTAY*dble(j-1) - yrec(irec))**2)
+ if(distval < dist) then
+ dist = distval
+ ix_rec(irec) = i
+ iy_rec(irec) = j
+ endif
+ enddo
+ enddo
+ print *,'receiver ',irec,' x_target,y_target = ',xrec(irec),yrec(irec)
+ print *,'closest grid point found at distance ',dist,' in i,j = ',ix_rec(irec),iy_rec(irec)
+ print *
+ enddo
+
+! check the Courant stability condition for the explicit time scheme
+! R. Courant et K. O. Friedrichs et H. Lewy (1928)
+ Courant_number = cp * DELTAT * sqrt(1.d0/DELTAX**2 + 1.d0/DELTAY**2)
+ print *,'Courant number is ',Courant_number
+ print *
+ if(Courant_number > 1.d0) stop 'time step is too large, simulation will be unstable'
+
+! suppress old files (can be commented out if "call system" is missing in your compiler)
+! call system('rm -f Vx_*.dat Vy_*.dat image*.pnm image*.gif')
+
+! initialize arrays
+ vx(:,:) = ZERO
+ vy(:,:) = ZERO
+ sigmaxx(:,:) = ZERO
+ sigmayy(:,:) = ZERO
+ sigmaxy(:,:) = ZERO
+
+! PML
+ memory_dvx_dx(:,:) = ZERO
+ memory_dvx_dy(:,:) = ZERO
+ memory_dvy_dx(:,:) = ZERO
+ memory_dvy_dy(:,:) = ZERO
+ memory_dsigmaxx_dx(:,:) = ZERO
+ memory_dsigmayy_dy(:,:) = ZERO
+ memory_dsigmaxy_dx(:,:) = ZERO
+ memory_dsigmaxy_dy(:,:) = ZERO
+
+! initialize seismograms
+ sisvx(:,:) = ZERO
+ sisvy(:,:) = ZERO
+
+! initialize total energy
+ total_energy_kinetic(:) = ZERO
+ total_energy_potential(:) = ZERO
+
+!---
+!--- beginning of time loop
+!---
+
+ do it = 1,NSTEP
+
+!------------------------------------------------------------
+! compute stress sigma and update memory variables for C-PML
+!------------------------------------------------------------
+
+ do j = 2,NY
+ do i = 1,NX-1
+
+! interpolate material parameters at the right location in the staggered grid cell
+ lambda_half_x = 0.5d0 * (lambda(i+1,j) + lambda(i,j))
+ mu_half_x = 0.5d0 * (mu(i+1,j) + mu(i,j))
+ lambda_plus_two_mu_half_x = lambda_half_x + 2.d0 * mu_half_x
+
+ value_dvx_dx = (27.d0*vx(i+1,j)-27.d0*vx(i,j)-vx(i+2,j)+vx(i-1,j)) / (24.d0*DELTAX)
+ value_dvy_dy = (27.d0*vy(i,j)-27.d0*vy(i,j-1)-vy(i,j+1)+vy(i,j-2)) / (24.d0*DELTAY)
+
+ memory_dvx_dx(i,j) = b_x_half(i) * memory_dvx_dx(i,j) + a_x_half(i) * value_dvx_dx
+ memory_dvy_dy(i,j) = b_y(j) * memory_dvy_dy(i,j) + a_y(j) * value_dvy_dy
+
+ value_dvx_dx = value_dvx_dx / K_x_half(i) + memory_dvx_dx(i,j)
+ value_dvy_dy = value_dvy_dy / K_y(j) + memory_dvy_dy(i,j)
+
+ sigmaxx(i,j) = sigmaxx(i,j) + &
+ (lambda_plus_two_mu_half_x * value_dvx_dx + lambda_half_x * value_dvy_dy) * DELTAT
+
+ sigmayy(i,j) = sigmayy(i,j) + &
+ (lambda_half_x * value_dvx_dx + lambda_plus_two_mu_half_x * value_dvy_dy) * DELTAT
+
+ enddo
+ enddo
+
+ do j = 1,NY-1
+ do i = 2,NX
+
+! interpolate material parameters at the right location in the staggered grid cell
+ mu_half_y = 0.5d0 * (mu(i,j+1) + mu(i,j))
+
+ value_dvy_dx = (27.d0*vy(i,j)-27.d0*vy(i-1,j)-vy(i+1,j)+vy(i-2,j)) / (24.d0*DELTAX)
+ value_dvx_dy = (27.d0*vx(i,j+1)-27.d0*vx(i,j)-vx(i,j+2)+vx(i,j-1)) / (24.d0*DELTAY)
+
+ memory_dvy_dx(i,j) = b_x(i) * memory_dvy_dx(i,j) + a_x(i) * value_dvy_dx
+ memory_dvx_dy(i,j) = b_y_half(j) * memory_dvx_dy(i,j) + a_y_half(j) * value_dvx_dy
+
+ value_dvy_dx = value_dvy_dx / K_x(i) + memory_dvy_dx(i,j)
+ value_dvx_dy = value_dvx_dy / K_y(j) + memory_dvx_dy(i,j)
+
+ sigmaxy(i,j) = sigmaxy(i,j) + mu_half_y * (value_dvy_dx + value_dvx_dy) * DELTAT
+
+ enddo
+ enddo
+
+!--------------------------------------------------------
+! compute velocity and update memory variables for C-PML
+!--------------------------------------------------------
+
+ do j = 2,NY
+ do i = 2,NX
+
+ value_dsigmaxx_dx = (27.d0*sigmaxx(i,j)-27.d0*sigmaxx(i-1,j)-sigmaxx(i+1,j)+sigmaxx(i-2,j)) / (24.d0*DELTAX)
+ value_dsigmaxy_dy = (27.d0*sigmaxy(i,j)-27.d0*sigmaxy(i,j-1)-sigmaxy(i,j+1)+sigmaxy(i,j-2)) / (24.d0*DELTAY)
+
+ memory_dsigmaxx_dx(i,j) = b_x(i) * memory_dsigmaxx_dx(i,j) + a_x(i) * value_dsigmaxx_dx
+ memory_dsigmaxy_dy(i,j) = b_y(j) * memory_dsigmaxy_dy(i,j) + a_y(j) * value_dsigmaxy_dy
+
+ value_dsigmaxx_dx = value_dsigmaxx_dx / K_x(i) + memory_dsigmaxx_dx(i,j)
+ value_dsigmaxy_dy = value_dsigmaxy_dy / K_y(j) + memory_dsigmaxy_dy(i,j)
+
+ vx(i,j) = vx(i,j) + (value_dsigmaxx_dx + value_dsigmaxy_dy) * DELTAT / rho(i,j)
+
+ enddo
+ enddo
+
+ do j = 1,NY-1
+ do i = 1,NX-1
+
+! interpolate density at the right location in the staggered grid cell
+ rho_half_x_half_y = 0.25d0 * (rho(i,j) + rho(i+1,j) + rho(i+1,j+1) + rho(i,j+1))
+
+ value_dsigmaxy_dx = (27.d0*sigmaxy(i+1,j)-27.d0*sigmaxy(i,j)-sigmaxy(i+2,j)+sigmaxy(i-1,j)) / (24.d0*DELTAX)
+ value_dsigmayy_dy = (27.d0*sigmayy(i,j+1)-27.d0*sigmayy(i,j)-sigmayy(i,j+2)+sigmayy(i,j-1)) / (24.d0*DELTAY)
+
+ memory_dsigmaxy_dx(i,j) = b_x_half(i) * memory_dsigmaxy_dx(i,j) + a_x_half(i) * value_dsigmaxy_dx
+ memory_dsigmayy_dy(i,j) = b_y_half(j) * memory_dsigmayy_dy(i,j) + a_y_half(j) * value_dsigmayy_dy
+
+ value_dsigmaxy_dx = value_dsigmaxy_dx / K_x_half(i) + memory_dsigmaxy_dx(i,j)
+ value_dsigmayy_dy = value_dsigmayy_dy / K_y_half(j) + memory_dsigmayy_dy(i,j)
+
+ vy(i,j) = vy(i,j) + (value_dsigmaxy_dx + value_dsigmayy_dy) * DELTAT / rho_half_x_half_y
+
+ enddo
+ enddo
+
+! add the source (force vector located at a given grid point)
+ a = pi*pi*f0*f0
+ t = dble(it-1)*DELTAT
+
+! Gaussian
+! source_term = factor * exp(-a*(t-t0)**2)
+
+! first derivative of a Gaussian
+ source_term = - factor * 2.d0*a*(t-t0)*exp(-a*(t-t0)**2)
+
+! Ricker source time function (second derivative of a Gaussian)
+! source_term = factor * (1.d0 - 2.d0*a*(t-t0)**2)*exp(-a*(t-t0)**2)
+
+ force_x = sin(ANGLE_FORCE * DEGREES_TO_RADIANS) * source_term
+ force_y = cos(ANGLE_FORCE * DEGREES_TO_RADIANS) * source_term
+
+! define location of the source
+ i = ISOURCE
+ j = JSOURCE
+
+! interpolate density at the right location in the staggered grid cell
+ rho_half_x_half_y = 0.25d0 * (rho(i,j) + rho(i+1,j) + rho(i+1,j+1) + rho(i,j+1))
+
+ vx(i,j) = vx(i,j) + force_x * DELTAT / rho(i,j)
+ vy(i,j) = vy(i,j) + force_y * DELTAT / rho_half_x_half_y
+
+! Dirichlet conditions (rigid boundaries) on the edges or at the bottom of the PML layers
+ vx(1,:) = ZERO
+ vx(NX,:) = ZERO
+
+ vx(:,1) = ZERO
+ vx(:,NY) = ZERO
+
+ vy(1,:) = ZERO
+ vy(NX,:) = ZERO
+
+ vy(:,1) = ZERO
+ vy(:,NY) = ZERO
+
+! store seismograms
+ do irec = 1,NREC
+ sisvx(it,irec) = vx(ix_rec(irec),iy_rec(irec))
+ sisvy(it,irec) = vy(ix_rec(irec),iy_rec(irec))
+ enddo
+
+! compute total energy in the medium (without the PML layers)
+
+! compute kinetic energy first, defined as 1/2 rho ||v||^2
+! in principle we should use rho_half_x_half_y instead of rho for vy
+! in order to interpolate density at the right location in the staggered grid cell
+! but in a homogeneous medium we can safely ignore it
+ total_energy_kinetic(it) = 0.5d0 * sum( &
+ rho(NPOINTS_PML:NX-NPOINTS_PML+1,NPOINTS_PML:NY-NPOINTS_PML+1)*( &
+ vx(NPOINTS_PML:NX-NPOINTS_PML+1,NPOINTS_PML:NY-NPOINTS_PML+1)**2 + &
+ vy(NPOINTS_PML:NX-NPOINTS_PML+1,NPOINTS_PML:NY-NPOINTS_PML+1)**2))
+
+! add potential energy, defined as 1/2 epsilon_ij sigma_ij
+! in principle we should interpolate the medium parameters at the right location
+! in the staggered grid cell but in a homogeneous medium we can safely ignore it
+ total_energy_potential(it) = ZERO
+ do j = NPOINTS_PML, NY-NPOINTS_PML+1
+ do i = NPOINTS_PML, NX-NPOINTS_PML+1
+ epsilon_xx = ((lambda(i,j) + 2.d0*mu(i,j)) * sigmaxx(i,j) - lambda(i,j) * &
+ sigmayy(i,j)) / (4.d0 * mu(i,j) * (lambda(i,j) + mu(i,j)))
+ epsilon_yy = ((lambda(i,j) + 2.d0*mu(i,j)) * sigmayy(i,j) - lambda(i,j) * &
+ sigmaxx(i,j)) / (4.d0 * mu(i,j) * (lambda(i,j) + mu(i,j)))
+ epsilon_xy = sigmaxy(i,j) / (2.d0 * mu(i,j))
+ total_energy_potential(it) = total_energy_potential(it) + &
+ 0.5d0 * (epsilon_xx * sigmaxx(i,j) + epsilon_yy * sigmayy(i,j) + 2.d0 * epsilon_xy * sigmaxy(i,j))
+ enddo
+ enddo
+
+! output information
+ if(mod(it,IT_DISPLAY) == 0 .or. it == 5) then
+
+! print maximum of norm of velocity
+ velocnorm = maxval(sqrt(vx**2 + vy**2))
+ print *,'Time step # ',it
+ print *,'Time: ',sngl((it-1)*DELTAT),' seconds'
+ print *,'Max norm velocity vector V (m/s) = ',velocnorm
+ print *,'total energy = ',total_energy_kinetic(it) + total_energy_potential(it)
+ print *
+! check stability of the code, exit if unstable
+ if(velocnorm > STABILITY_THRESHOLD) stop 'code became unstable and blew up'
+
+ call create_2D_image(vx,NX+2,NY+2,it,ISOURCE,JSOURCE,ix_rec,iy_rec,nrec, &
+ NPOINTS_PML,USE_PML_XMIN,USE_PML_XMAX,USE_PML_YMIN,USE_PML_YMAX,1)
+ call create_2D_image(vy,NX+2,NY+2,it,ISOURCE,JSOURCE,ix_rec,iy_rec,nrec, &
+ NPOINTS_PML,USE_PML_XMIN,USE_PML_XMAX,USE_PML_YMIN,USE_PML_YMAX,2)
+
+ endif
+
+ enddo ! end of time loop
+
+! save seismograms
+ call write_seismograms(sisvx,sisvy,NSTEP,NREC,DELTAT)
+
+! save total energy
+ open(unit=20,file='energy.dat',status='unknown')
+ do it = 1,NSTEP
+ write(20,*) sngl(dble(it-1)*DELTAT),total_energy_kinetic(it), &
+ total_energy_potential(it),total_energy_kinetic(it) + total_energy_potential(it)
+ enddo
+ close(20)
+
+! create script for Gnuplot for total energy
+ open(unit=20,file='plot_energy',status='unknown')
+ write(20,*) '# set term x11'
+ write(20,*) 'set term postscript landscape monochrome dashed "Helvetica" 22'
+ write(20,*)
+ write(20,*) 'set xlabel "Time (s)"'
+ write(20,*) 'set ylabel "Total energy"'
+ write(20,*)
+ write(20,*) 'set output "cpml_total_energy_semilog.eps"'
+ write(20,*) 'set logscale y'
+ write(20,*) 'plot "energy.dat" us 1:2 t ''Ec'' w l 1, "energy.dat" us 1:3 &
+ & t ''Ep'' w l 3, "energy.dat" us 1:4 t ''Total energy'' w l 4'
+ write(20,*) 'pause -1 "Hit any key..."'
+ write(20,*)
+ close(20)
+
+ open(unit=20,file='plot_comparison',status='unknown')
+ write(20,*) '# set term x11'
+ write(20,*) 'set term postscript landscape monochrome dashed "Helvetica" 22'
+ write(20,*)
+ write(20,*) 'set xlabel "Time (s)"'
+ write(20,*) 'set ylabel "Total energy"'
+ write(20,*)
+ write(20,*) 'set output "compare_total_energy_semilog.eps"'
+ write(20,*) 'set logscale y'
+ write(20,*) 'plot "energy.dat" us 1:4 t ''Total energy CPML'' w l 1, &
+ & "../collino/energy.dat" us 1:4 t ''Total energy Collino'' w l 2'
+ write(20,*) 'pause -1 "Hit any key..."'
+ write(20,*)
+ close(20)
+
+! create script for Gnuplot
+ open(unit=20,file='plotgnu',status='unknown')
+ write(20,*) 'set term x11'
+ write(20,*) '# set term postscript landscape monochrome dashed "Helvetica" 22'
+ write(20,*)
+ write(20,*) 'set xlabel "Time (s)"'
+ write(20,*) 'set ylabel "Amplitude (m / s)"'
+ write(20,*)
+
+ write(20,*) 'set output "v_sigma_Vx_receiver_001.eps"'
+ write(20,*) 'plot "Vx_file_001.dat" t ''Vx C-PML'' w l 1'
+ write(20,*) 'pause -1 "Hit any key..."'
+ write(20,*)
+
+ write(20,*) 'set output "v_sigma_Vy_receiver_001.eps"'
+ write(20,*) 'plot "Vy_file_001.dat" t ''Vy C-PML'' w l 1'
+ write(20,*) 'pause -1 "Hit any key..."'
+ write(20,*)
+
+ write(20,*) 'set output "v_sigma_Vx_receiver_002.eps"'
+ write(20,*) 'plot "Vx_file_002.dat" t ''Vx C-PML'' w l 1'
+ write(20,*) 'pause -1 "Hit any key..."'
+ write(20,*)
+
+ write(20,*) 'set output "v_sigma_Vy_receiver_002.eps"'
+ write(20,*) 'plot "Vy_file_002.dat" t ''Vy C-PML'' w l 1'
+ write(20,*) 'pause -1 "Hit any key..."'
+ write(20,*)
+
+ close(20)
+
+ print *
+ print *,'End of the simulation'
+ print *
+
+ end program seismic_CPML_2D_iso_fourth
+
+!----
+!---- save the seismograms in ASCII text format
+!----
+
+ subroutine write_seismograms(sisvx,sisvy,nt,nrec,DELTAT)
+
+ implicit none
+
+ integer nt,nrec
+ double precision DELTAT
+
+ double precision sisvx(nt,nrec)
+ double precision sisvy(nt,nrec)
+
+ integer irec,it
+
+ character(len=100) file_name
+
+! X component
+ do irec=1,nrec
+ write(file_name,"('Vx_file_',i3.3,'.dat')") irec
+ open(unit=11,file=file_name,status='unknown')
+ do it=1,nt
+ write(11,*) sngl(dble(it-1)*DELTAT),' ',sngl(sisvx(it,irec))
+ enddo
+ close(11)
+ enddo
+
+! Y component
+ do irec=1,nrec
+ write(file_name,"('Vy_file_',i3.3,'.dat')") irec
+ open(unit=11,file=file_name,status='unknown')
+ do it=1,nt
+ write(11,*) sngl(dble(it-1)*DELTAT),' ',sngl(sisvy(it,irec))
+ enddo
+ close(11)
+ enddo
+
+ end subroutine write_seismograms
+
+!----
+!---- routine to create a color image of a given vector component
+!---- the image is created in PNM format and then converted to GIF
+!----
+
+ subroutine create_2D_image(image_data_2D,NX,NY,it,ISOURCE,JSOURCE,ix_rec,iy_rec,nrec, &
+ NPOINTS_PML,USE_PML_XMIN,USE_PML_XMAX,USE_PML_YMIN,USE_PML_YMAX,field_number)
+
+ implicit none
+
+! non linear display to enhance small amplitudes for graphics
+ double precision, parameter :: POWER_DISPLAY = 0.30d0
+
+! amplitude threshold above which we draw the color point
+ double precision, parameter :: cutvect = 0.01d0
+
+! use black or white background for points that are below the threshold
+ logical, parameter :: WHITE_BACKGROUND = .true.
+
+! size of cross and square in pixels drawn to represent the source and the receivers
+ integer, parameter :: width_cross = 5, thickness_cross = 1, size_square = 3
+
+ integer NX,NY,it,field_number,ISOURCE,JSOURCE,NPOINTS_PML,nrec
+ logical USE_PML_XMIN,USE_PML_XMAX,USE_PML_YMIN,USE_PML_YMAX
+
+ double precision, dimension(NX,NY) :: image_data_2D
+
+ integer, dimension(nrec) :: ix_rec,iy_rec
+
+ integer :: ix,iy,irec
+
+ character(len=100) :: file_name,system_command
+
+ integer :: R, G, B
+
+ double precision :: normalized_value,max_amplitude
+
+! open image file and create system command to convert image to more convenient format
+ if(field_number == 1) then
+ write(file_name,"('image',i6.6,'_Vx.pnm')") it
+ write(system_command,"('convert image',i6.6,'_Vx.pnm image',i6.6,'_Vx.gif ; rm image',i6.6,'_Vx.pnm')") it,it,it
+ else if(field_number == 2) then
+ write(file_name,"('image',i6.6,'_Vy.pnm')") it
+ write(system_command,"('convert image',i6.6,'_Vy.pnm image',i6.6,'_Vy.gif ; rm image',i6.6,'_Vy.pnm')") it,it,it
+ endif
+
+ open(unit=27, file=file_name, status='unknown')
+
+ write(27,"('P3')") ! write image in PNM P3 format
+
+ write(27,*) NX,NY ! write image size
+ write(27,*) '255' ! maximum value of each pixel color
+
+! compute maximum amplitude
+ max_amplitude = maxval(abs(image_data_2D))
+
+! image starts in upper-left corner in PNM format
+ do iy=NY,1,-1
+ do ix=1,NX
+
+! define data as vector component normalized to [-1:1] and rounded to nearest integer
+! keeping in mind that amplitude can be negative
+ normalized_value = image_data_2D(ix,iy) / max_amplitude
+
+! suppress values that are outside [-1:+1] to avoid small edge effects
+ if(normalized_value < -1.d0) normalized_value = -1.d0
+ if(normalized_value > 1.d0) normalized_value = 1.d0
+
+! draw an orange cross to represent the source
+ if((ix >= ISOURCE - width_cross .and. ix <= ISOURCE + width_cross .and. &
+ iy >= JSOURCE - thickness_cross .and. iy <= JSOURCE + thickness_cross) .or. &
+ (ix >= ISOURCE - thickness_cross .and. ix <= ISOURCE + thickness_cross .and. &
+ iy >= JSOURCE - width_cross .and. iy <= JSOURCE + width_cross)) then
+ R = 255
+ G = 157
+ B = 0
+
+! display two-pixel-thick black frame around the image
+ else if(ix <= 2 .or. ix >= NX-1 .or. iy <= 2 .or. iy >= NY-1) then
+ R = 0
+ G = 0
+ B = 0
+
+! display edges of the PML layers
+ else if((USE_PML_XMIN .and. ix == NPOINTS_PML) .or. &
+ (USE_PML_XMAX .and. ix == NX - NPOINTS_PML) .or. &
+ (USE_PML_YMIN .and. iy == NPOINTS_PML) .or. &
+ (USE_PML_YMAX .and. iy == NY - NPOINTS_PML)) then
+ R = 255
+ G = 150
+ B = 0
+
+! suppress all the values that are below the threshold
+ else if(abs(image_data_2D(ix,iy)) <= max_amplitude * cutvect) then
+
+! use a black or white background for points that are below the threshold
+ if(WHITE_BACKGROUND) then
+ R = 255
+ G = 255
+ B = 255
+ else
+ R = 0
+ G = 0
+ B = 0
+ endif
+
+! represent regular image points using red if value is positive, blue if negative
+ else if(normalized_value >= 0.d0) then
+ R = nint(255.d0*normalized_value**POWER_DISPLAY)
+ G = 0
+ B = 0
+ else
+ R = 0
+ G = 0
+ B = nint(255.d0*abs(normalized_value)**POWER_DISPLAY)
+ endif
+
+! draw a green square to represent the receivers
+ do irec = 1,nrec
+ if((ix >= ix_rec(irec) - size_square .and. ix <= ix_rec(irec) + size_square .and. &
+ iy >= iy_rec(irec) - size_square .and. iy <= iy_rec(irec) + size_square) .or. &
+ (ix >= ix_rec(irec) - size_square .and. ix <= ix_rec(irec) + size_square .and. &
+ iy >= iy_rec(irec) - size_square .and. iy <= iy_rec(irec) + size_square)) then
+! use dark green color
+ R = 30
+ G = 180
+ B = 60
+ endif
+ enddo
+
+! write color pixel
+ write(27,"(i3,' ',i3,' ',i3)") R,G,B
+
+ enddo
+ enddo
+
+! close file
+ close(27)
+
+! call the system to convert image to GIF (can be commented out if "call system" is missing in your compiler)
+! call system(system_command)
+
+ end subroutine create_2D_image
+
+!
+! CeCILL FREE SOFTWARE LICENSE AGREEMENT
+!
+! Notice
+!
+! This Agreement is a Free Software license agreement that is the result
+! of discussions between its authors in order to ensure compliance with
+! the two main principles guiding its drafting:
+!
+! * firstly, compliance with the principles governing the distribution
+! of Free Software: access to source code, broad rights granted to
+! users,
+! * secondly, the election of a governing law, French law, with which
+! it is conformant, both as regards the law of torts and
+! intellectual property law, and the protection that it offers to
+! both authors and holders of the economic rights over software.
+!
+! The authors of the CeCILL (for Ce[a] C[nrs] I[nria] L[ogiciel] L[ibre])
+! license are:
+!
+! Commissariat a l'Energie Atomique - CEA, a public scientific, technical
+! and industrial research establishment, having its principal place of
+! business at 25 rue Leblanc, immeuble Le Ponant D, 75015 Paris, France.
+!
+! Centre National de la Recherche Scientifique - CNRS, a public scientific
+! and technological establishment, having its principal place of business
+! at 3 rue Michel-Ange, 75794 Paris cedex 16, France.
+!
+! Institut National de Recherche en Informatique et en Automatique -
+! INRIA, a public scientific and technological establishment, having its
+! principal place of business at Domaine de Voluceau, Rocquencourt, BP
+! 105, 78153 Le Chesnay cedex, France.
+!
+! Preamble
+!
+! The purpose of this Free Software license agreement is to grant users
+! the right to modify and redistribute the software governed by this
+! license within the framework of an open source distribution model.
+!
+! The exercising of these rights is conditional upon certain obligations
+! for users so as to preserve this status for all subsequent redistributions.
+!
+! In consideration of access to the source code and the rights to copy,
+! modify and redistribute granted by the license, users are provided only
+! with a limited warranty and the software's author, the holder of the
+! economic rights, and the successive licensors only have limited liability.
+!
+! In this respect, the risks associated with loading, using, modifying
+! and/or developing or reproducing the software by the user are brought to
+! the user's attention, given its Free Software status, which may make it
+! complicated to use, with the result that its use is reserved for
+! developers and experienced professionals having in-depth computer
+! knowledge. Users are therefore encouraged to load and test the
+! suitability of the software as regards their requirements in conditions
+! enabling the security of their systems and/or data to be ensured and,
+! more generally, to use and operate it in the same conditions of
+! security. This Agreement may be freely reproduced and published,
+! provided it is not altered, and that no provisions are either added or
+! removed herefrom.
+!
+! This Agreement may apply to any or all software for which the holder of
+! the economic rights decides to submit the use thereof to its provisions.
+!
+! Article 1 - DEFINITIONS
+!
+! For the purpose of this Agreement, when the following expressions
+! commence with a capital letter, they shall have the following meaning:
+!
+! Agreement: means this license agreement, and its possible subsequent
+! versions and annexes.
+!
+! Software: means the software in its Object Code and/or Source Code form
+! and, where applicable, its documentation, "as is" when the Licensee
+! accepts the Agreement.
+!
+! Initial Software: means the Software in its Source Code and possibly its
+! Object Code form and, where applicable, its documentation, "as is" when
+! it is first distributed under the terms and conditions of the Agreement.
+!
+! Modified Software: means the Software modified by at least one
+! Contribution.
+!
+! Source Code: means all the Software's instructions and program lines to
+! which access is required so as to modify the Software.
+!
+! Object Code: means the binary files originating from the compilation of
+! the Source Code.
+!
+! Holder: means the holder(s) of the economic rights over the Initial
+! Software.
+!
+! Licensee: means the Software user(s) having accepted the Agreement.
+!
+! Contributor: means a Licensee having made at least one Contribution.
+!
+! Licensor: means the Holder, or any other individual or legal entity, who
+! distributes the Software under the Agreement.
+!
+! Contribution: means any or all modifications, corrections, translations,
+! adaptations and/or new functions integrated into the Software by any or
+! all Contributors, as well as any or all Internal Modules.
+!
+! Module: means a set of sources files including their documentation that
+! enables supplementary functions or services in addition to those offered
+! by the Software.
+!
+! External Module: means any or all Modules, not derived from the
+! Software, so that this Module and the Software run in separate address
+! spaces, with one calling the other when they are run.
+!
+! Internal Module: means any or all Module, connected to the Software so
+! that they both execute in the same address space.
+!
+! GNU GPL: means the GNU General Public License version 2 or any
+! subsequent version, as published by the Free Software Foundation Inc.
+!
+! Parties: mean both the Licensee and the Licensor.
+!
+! These expressions may be used both in singular and plural form.
+!
+! Article 2 - PURPOSE
+!
+! The purpose of the Agreement is the grant by the Licensor to the
+! Licensee of a non-exclusive, transferable and worldwide license for the
+! Software as set forth in Article 5 hereinafter for the whole term of the
+! protection granted by the rights over said Software.
+!
+! Article 3 - ACCEPTANCE
+!
+! 3.1 The Licensee shall be deemed as having accepted the terms and
+! conditions of this Agreement upon the occurrence of the first of the
+! following events:
+!
+! * (i) loading the Software by any or all means, notably, by
+! downloading from a remote server, or by loading from a physical
+! medium;
+! * (ii) the first time the Licensee exercises any of the rights
+! granted hereunder.
+!
+! 3.2 One copy of the Agreement, containing a notice relating to the
+! characteristics of the Software, to the limited warranty, and to the
+! fact that its use is restricted to experienced users has been provided
+! to the Licensee prior to its acceptance as set forth in Article 3.1
+! hereinabove, and the Licensee hereby acknowledges that it has read and
+! understood it.
+!
+! Article 4 - EFFECTIVE DATE AND TERM
+!
+! 4.1 EFFECTIVE DATE
+!
+! The Agreement shall become effective on the date when it is accepted by
+! the Licensee as set forth in Article 3.1.
+!
+! 4.2 TERM
+!
+! The Agreement shall remain in force for the entire legal term of
+! protection of the economic rights over the Software.
+!
+! Article 5 - SCOPE OF RIGHTS GRANTED
+!
+! The Licensor hereby grants to the Licensee, who accepts, the following
+! rights over the Software for any or all use, and for the term of the
+! Agreement, on the basis of the terms and conditions set forth hereinafter.
+!
+! Besides, if the Licensor owns or comes to own one or more patents
+! protecting all or part of the functions of the Software or of its
+! components, the Licensor undertakes not to enforce the rights granted by
+! these patents against successive Licensees using, exploiting or
+! modifying the Software. If these patents are transferred, the Licensor
+! undertakes to have the transferees subscribe to the obligations set
+! forth in this paragraph.
+!
+! 5.1 RIGHT OF USE
+!
+! The Licensee is authorized to use the Software, without any limitation
+! as to its fields of application, with it being hereinafter specified
+! that this comprises:
+!
+! 1. permanent or temporary reproduction of all or part of the Software
+! by any or all means and in any or all form.
+!
+! 2. loading, displaying, running, or storing the Software on any or
+! all medium.
+!
+! 3. entitlement to observe, study or test its operation so as to
+! determine the ideas and principles behind any or all constituent
+! elements of said Software. This shall apply when the Licensee
+! carries out any or all loading, displaying, running, transmission
+! or storage operation as regards the Software, that it is entitled
+! to carry out hereunder.
+!
+! 5.2 ENTITLEMENT TO MAKE CONTRIBUTIONS
+!
+! The right to make Contributions includes the right to translate, adapt,
+! arrange, or make any or all modifications to the Software, and the right
+! to reproduce the resulting software.
+!
+! The Licensee is authorized to make any or all Contributions to the
+! Software provided that it includes an explicit notice that it is the
+! author of said Contribution and indicates the date of the creation thereof.
+!
+! 5.3 RIGHT OF DISTRIBUTION
+!
+! In particular, the right of distribution includes the right to publish,
+! transmit and communicate the Software to the general public on any or
+! all medium, and by any or all means, and the right to market, either in
+! consideration of a fee, or free of charge, one or more copies of the
+! Software by any means.
+!
+! The Licensee is further authorized to distribute copies of the modified
+! or unmodified Software to third parties according to the terms and
+! conditions set forth hereinafter.
+!
+! 5.3.1 DISTRIBUTION OF SOFTWARE WITHOUT MODIFICATION
+!
+! The Licensee is authorized to distribute true copies of the Software in
+! Source Code or Object Code form, provided that said distribution
+! complies with all the provisions of the Agreement and is accompanied by:
+!
+! 1. a copy of the Agreement,
+!
+! 2. a notice relating to the limitation of both the Licensor's
+! warranty and liability as set forth in Articles 8 and 9,
+!
+! and that, in the event that only the Object Code of the Software is
+! redistributed, the Licensee allows future Licensees unhindered access to
+! the full Source Code of the Software by indicating how to access it, it
+! being understood that the additional cost of acquiring the Source Code
+! shall not exceed the cost of transferring the data.
+!
+! 5.3.2 DISTRIBUTION OF MODIFIED SOFTWARE
+!
+! When the Licensee makes a Contribution to the Software, the terms and
+! conditions for the distribution of the resulting Modified Software
+! become subject to all the provisions of this Agreement.
+!
+! The Licensee is authorized to distribute the Modified Software, in
+! source code or object code form, provided that said distribution
+! complies with all the provisions of the Agreement and is accompanied by:
+!
+! 1. a copy of the Agreement,
+!
+! 2. a notice relating to the limitation of both the Licensor's
+! warranty and liability as set forth in Articles 8 and 9,
+!
+! and that, in the event that only the object code of the Modified
+! Software is redistributed, the Licensee allows future Licensees
+! unhindered access to the full source code of the Modified Software by
+! indicating how to access it, it being understood that the additional
+! cost of acquiring the source code shall not exceed the cost of
+! transferring the data.
+!
+! 5.3.3 DISTRIBUTION OF EXTERNAL MODULES
+!
+! When the Licensee has developed an External Module, the terms and
+! conditions of this Agreement do not apply to said External Module, that
+! may be distributed under a separate license agreement.
+!
+! 5.3.4 COMPATIBILITY WITH THE GNU GPL
+!
+! The Licensee can include a code that is subject to the provisions of one
+! of the versions of the GNU GPL in the Modified or unmodified Software,
+! and distribute that entire code under the terms of the same version of
+! the GNU GPL.
+!
+! The Licensee can include the Modified or unmodified Software in a code
+! that is subject to the provisions of one of the versions of the GNU GPL,
+! and distribute that entire code under the terms of the same version of
+! the GNU GPL.
+!
+! Article 6 - INTELLECTUAL PROPERTY
+!
+! 6.1 OVER THE INITIAL SOFTWARE
+!
+! The Holder owns the economic rights over the Initial Software. Any or
+! all use of the Initial Software is subject to compliance with the terms
+! and conditions under which the Holder has elected to distribute its work
+! and no one shall be entitled to modify the terms and conditions for the
+! distribution of said Initial Software.
+!
+! The Holder undertakes that the Initial Software will remain ruled at
+! least by this Agreement, for the duration set forth in Article 4.2.
+!
+! 6.2 OVER THE CONTRIBUTIONS
+!
+! The Licensee who develops a Contribution is the owner of the
+! intellectual property rights over this Contribution as defined by
+! applicable law.
+!
+! 6.3 OVER THE EXTERNAL MODULES
+!
+! The Licensee who develops an External Module is the owner of the
+! intellectual property rights over this External Module as defined by
+! applicable law and is free to choose the type of agreement that shall
+! govern its distribution.
+!
+! 6.4 JOINT PROVISIONS
+!
+! The Licensee expressly undertakes:
+!
+! 1. not to remove, or modify, in any manner, the intellectual property
+! notices attached to the Software;
+!
+! 2. to reproduce said notices, in an identical manner, in the copies
+! of the Software modified or not.
+!
+! The Licensee undertakes not to directly or indirectly infringe the
+! intellectual property rights of the Holder and/or Contributors on the
+! Software and to take, where applicable, vis-a-vis its staff, any and all
+! measures required to ensure respect of said intellectual property rights
+! of the Holder and/or Contributors.
+!
+! Article 7 - RELATED SERVICES
+!
+! 7.1 Under no circumstances shall the Agreement oblige the Licensor to
+! provide technical assistance or maintenance services for the Software.
+!
+! However, the Licensor is entitled to offer this type of services. The
+! terms and conditions of such technical assistance, and/or such
+! maintenance, shall be set forth in a separate instrument. Only the
+! Licensor offering said maintenance and/or technical assistance services
+! shall incur liability therefor.
+!
+! 7.2 Similarly, any Licensor is entitled to offer to its licensees, under
+! its sole responsibility, a warranty, that shall only be binding upon
+! itself, for the redistribution of the Software and/or the Modified
+! Software, under terms and conditions that it is free to decide. Said
+! warranty, and the financial terms and conditions of its application,
+! shall be subject of a separate instrument executed between the Licensor
+! and the Licensee.
+!
+! Article 8 - LIABILITY
+!
+! 8.1 Subject to the provisions of Article 8.2, the Licensee shall be
+! entitled to claim compensation for any direct loss it may have suffered
+! from the Software as a result of a fault on the part of the relevant
+! Licensor, subject to providing evidence thereof.
+!
+! 8.2 The Licensor's liability is limited to the commitments made under
+! this Agreement and shall not be incurred as a result of in particular:
+! (i) loss due the Licensee's total or partial failure to fulfill its
+! obligations, (ii) direct or consequential loss that is suffered by the
+! Licensee due to the use or performance of the Software, and (iii) more
+! generally, any consequential loss. In particular the Parties expressly
+! agree that any or all pecuniary or business loss (i.e. loss of data,
+! loss of profits, operating loss, loss of customers or orders,
+! opportunity cost, any disturbance to business activities) or any or all
+! legal proceedings instituted against the Licensee by a third party,
+! shall constitute consequential loss and shall not provide entitlement to
+! any or all compensation from the Licensor.
+!
+! Article 9 - WARRANTY
+!
+! 9.1 The Licensee acknowledges that the scientific and technical
+! state-of-the-art when the Software was distributed did not enable all
+! possible uses to be tested and verified, nor for the presence of
+! possible defects to be detected. In this respect, the Licensee's
+! attention has been drawn to the risks associated with loading, using,
+! modifying and/or developing and reproducing the Software which are
+! reserved for experienced users.
+!
+! The Licensee shall be responsible for verifying, by any or all means,
+! the suitability of the product for its requirements, its good working
+! order, and for ensuring that it shall not cause damage to either persons
+! or properties.
+!
+! 9.2 The Licensor hereby represents, in good faith, that it is entitled
+! to grant all the rights over the Software (including in particular the
+! rights set forth in Article 5).
+!
+! 9.3 The Licensee acknowledges that the Software is supplied "as is" by
+! the Licensor without any other express or tacit warranty, other than
+! that provided for in Article 9.2 and, in particular, without any warranty
+! as to its commercial value, its secured, safe, innovative or relevant
+! nature.
+!
+! Specifically, the Licensor does not warrant that the Software is free
+! from any error, that it will operate without interruption, that it will
+! be compatible with the Licensee's own equipment and software
+! configuration, nor that it will meet the Licensee's requirements.
+!
+! 9.4 The Licensor does not either expressly or tacitly warrant that the
+! Software does not infringe any third party intellectual property right
+! relating to a patent, software or any other property right. Therefore,
+! the Licensor disclaims any and all liability towards the Licensee
+! arising out of any or all proceedings for infringement that may be
+! instituted in respect of the use, modification and redistribution of the
+! Software. Nevertheless, should such proceedings be instituted against
+! the Licensee, the Licensor shall provide it with technical and legal
+! assistance for its defense. Such technical and legal assistance shall be
+! decided on a case-by-case basis between the relevant Licensor and the
+! Licensee pursuant to a memorandum of understanding. The Licensor
+! disclaims any and all liability as regards the Licensee's use of the
+! name of the Software. No warranty is given as regards the existence of
+! prior rights over the name of the Software or as regards the existence
+! of a trademark.
+!
+! Article 10 - TERMINATION
+!
+! 10.1 In the event of a breach by the Licensee of its obligations
+! hereunder, the Licensor may automatically terminate this Agreement
+! thirty (30) days after notice has been sent to the Licensee and has
+! remained ineffective.
+!
+! 10.2 A Licensee whose Agreement is terminated shall no longer be
+! authorized to use, modify or distribute the Software. However, any
+! licenses that it may have granted prior to termination of the Agreement
+! shall remain valid subject to their having been granted in compliance
+! with the terms and conditions hereof.
+!
+! Article 11 - MISCELLANEOUS
+!
+! 11.1 EXCUSABLE EVENTS
+!
+! Neither Party shall be liable for any or all delay, or failure to
+! perform the Agreement, that may be attributable to an event of force
+! majeure, an act of God or an outside cause, such as defective
+! functioning or interruptions of the electricity or telecommunications
+! networks, network paralysis following a virus attack, intervention by
+! government authorities, natural disasters, water damage, earthquakes,
+! fire, explosions, strikes and labor unrest, war, etc.
+!
+! 11.2 Any failure by either Party, on one or more occasions, to invoke
+! one or more of the provisions hereof, shall under no circumstances be
+! interpreted as being a waiver by the interested Party of its right to
+! invoke said provision(s) subsequently.
+!
+! 11.3 The Agreement cancels and replaces any or all previous agreements,
+! whether written or oral, between the Parties and having the same
+! purpose, and constitutes the entirety of the agreement between said
+! Parties concerning said purpose. No supplement or modification to the
+! terms and conditions hereof shall be effective as between the Parties
+! unless it is made in writing and signed by their duly authorized
+! representatives.
+!
+! 11.4 In the event that one or more of the provisions hereof were to
+! conflict with a current or future applicable act or legislative text,
+! said act or legislative text shall prevail, and the Parties shall make
+! the necessary amendments so as to comply with said act or legislative
+! text. All other provisions shall remain effective. Similarly, invalidity
+! of a provision of the Agreement, for any reason whatsoever, shall not
+! cause the Agreement as a whole to be invalid.
+!
+! 11.5 LANGUAGE
+!
+! The Agreement is drafted in both French and English and both versions
+! are deemed authentic.
+!
+! Article 12 - NEW VERSIONS OF THE AGREEMENT
+!
+! 12.1 Any person is authorized to duplicate and distribute copies of this
+! Agreement.
+!
+! 12.2 So as to ensure coherence, the wording of this Agreement is
+! protected and may only be modified by the authors of the License, who
+! reserve the right to periodically publish updates or new versions of the
+! Agreement, each with a separate number. These subsequent versions may
+! address new issues encountered by Free Software.
+!
+! 12.3 Any Software distributed under a given version of the Agreement may
+! only be subsequently distributed under the same version of the Agreement
+! or a subsequent version, subject to the provisions of Article 5.3.4.
+!
+! Article 13 - GOVERNING LAW AND JURISDICTION
+!
+! 13.1 The Agreement is governed by French law. The Parties agree to
+! endeavor to seek an amicable solution to any disagreements or disputes
+! that may arise during the performance of the Agreement.
+!
+! 13.2 Failing an amicable solution within two (2) months as from their
+! occurrence, and unless emergency proceedings are necessary, the
+! disagreements or disputes shall be referred to the Paris Courts having
+! jurisdiction, by the more diligent Party.
+!
+! Version 2.0 dated 2006-09-05.
+!
Added: seismo/3D/CPML/tags/v1.1.1/seismic_CPML_2D_isotropic_second_order.f90
===================================================================
--- seismo/3D/CPML/tags/v1.1.1/seismic_CPML_2D_isotropic_second_order.f90 (rev 0)
+++ seismo/3D/CPML/tags/v1.1.1/seismic_CPML_2D_isotropic_second_order.f90 2009-11-03 21:35:50 UTC (rev 15926)
@@ -0,0 +1,1480 @@
+!
+! SEISMIC_CPML Version 1.1.1, November 2009.
+!
+! Copyright Universite de Pau et des Pays de l'Adour, CNRS and INRIA, France.
+! Contributor: Dimitri Komatitsch, dimitri DOT komatitsch aT univ-pau DOT fr
+!
+! This software is a computer program whose purpose is to solve
+! the two-dimensional isotropic elastic wave equation
+! using a finite-difference method with Convolutional Perfectly Matched
+! Layer (C-PML) conditions.
+!
+! This software is governed by the CeCILL license under French law and
+! abiding by the rules of distribution of free software. You can use,
+! modify and/or redistribute the software under the terms of the CeCILL
+! license as circulated by CEA, CNRS and INRIA at the following URL
+! "http://www.cecill.info".
+!
+! As a counterpart to the access to the source code and rights to copy,
+! modify and redistribute granted by the license, users are provided only
+! with a limited warranty and the software's author, the holder of the
+! economic rights, and the successive licensors have only limited
+! liability.
+!
+! In this respect, the user's attention is drawn to the risks associated
+! with loading, using, modifying and/or developing or reproducing the
+! software by the user in light of its specific status of free software,
+! that may mean that it is complicated to manipulate, and that also
+! therefore means that it is reserved for developers and experienced
+! professionals having in-depth computer knowledge. Users are therefore
+! encouraged to load and test the software's suitability as regards their
+! requirements in conditions enabling the security of their systems and/or
+! data to be ensured and, more generally, to use and operate it in the
+! same conditions as regards security.
+!
+! The full text of the license is available at the end of this program
+! and in file "LICENSE".
+
+ program seismic_CPML_2D_iso_second
+
+! 2D elastic finite-difference code in velocity and stress formulation
+! with Convolutional-PML (C-PML) absorbing conditions for an isotropic medium
+
+! Dimitri Komatitsch, University of Pau, France, April 2007.
+
+! The second-order staggered-grid formulation of Madariaga (1976) and Virieux (1986) is used:
+!
+! ^ y
+! |
+! |
+!
+! +-------------------+
+! | |
+! | |
+! | |
+! | |
+! | v_y |
+! sigma_xy +---------+ |
+! | | |
+! | | |
+! | | |
+! | | |
+! | | |
+! +---------+---------+ ---> x
+! v_x sigma_xx
+! sigma_yy
+!
+
+! The C-PML implementation is based in part on formulas given in Roden and Gedney (2000).
+! If you use this code for your own research, please cite some (or all) of these
+! articles:
+!
+! @ARTICLE{KoMa07,
+! author = {Dimitri Komatitsch and Roland Martin},
+! title = {An unsplit convolutional {P}erfectly {M}atched {L}ayer improved
+! at grazing incidence for the seismic wave equation},
+! journal = {Geophysics},
+! year = {2007},
+! volume = {72},
+! number = {5},
+! pages = {SM155-SM167},
+! doi = {10.1190/1.2757586}}
+!
+! @ARTICLE{MaKoEz08,
+! author = {Roland Martin and Dimitri Komatitsch and Abdela\^aziz Ezziani},
+! title = {An unsplit convolutional perfectly matched layer improved at grazing
+! incidence for seismic wave equation in poroelastic media},
+! journal = {Geophysics},
+! year = {2008},
+! volume = {73},
+! pages = {T51-T61},
+! number = {4},
+! doi = {10.1190/1.2939484}}
+!
+! @ARTICLE{MaKo09,
+! author = {Roland Martin and Dimitri Komatitsch},
+! title = {An unsplit convolutional perfectly matched layer technique improved
+! at grazing incidence for the viscoelastic wave equation},
+! journal = {Geophysical Journal International},
+! year = {2009},
+! volume = {179},
+! pages = {333-344},
+! number = {1},
+! doi = {10.1111/j.1365-246X.2009.04278.x}}
+!
+! @ARTICLE{MaKoGe08,
+! author = {Roland Martin and Dimitri Komatitsch and Stephen D. Gedney},
+! title = {A variational formulation of a stabilized unsplit convolutional perfectly
+! matched layer for the isotropic or anisotropic seismic wave equation},
+! journal = {Computer Modeling in Engineering and Sciences},
+! year = {2008},
+! volume = {37},
+! pages = {274-304},
+! number = {3}}
+!
+! The original CPML technique for Maxwell's equations is described in:
+!
+! @ARTICLE{RoGe00,
+! author = {J. A. Roden and S. D. Gedney},
+! title = {Convolution {PML} ({CPML}): {A}n Efficient {FDTD} Implementation
+! of the {CFS}-{PML} for Arbitrary Media},
+! journal = {Microwave and Optical Technology Letters},
+! year = {2000},
+! volume = {27},
+! number = {5},
+! pages = {334-339},
+! doi = {10.1002/1098-2760(20001205)27:5<334::AID-MOP14>3.0.CO;2-A}}
+
+!
+! To display the 2D results as color images, use:
+!
+! " display image*.gif " or " gimp image*.gif "
+!
+! or
+!
+! " montage -geometry +0+3 -rotate 90 -tile 1x21 image*Vx*.gif allfiles_Vx.gif "
+! " montage -geometry +0+3 -rotate 90 -tile 1x21 image*Vy*.gif allfiles_Vy.gif "
+! then " display allfiles_Vx.gif " or " gimp allfiles_Vx.gif "
+! then " display allfiles_Vy.gif " or " gimp allfiles_Vy.gif "
+!
+
+ implicit none
+
+! total number of grid points in each direction of the grid
+ integer, parameter :: NX = 101
+ integer, parameter :: NY = 641
+
+! size of a grid cell
+ double precision, parameter :: DELTAX = 10.d0
+ double precision, parameter :: DELTAY = DELTAX
+
+! flags to add PML layers to the edges of the grid
+ logical, parameter :: USE_PML_XMIN = .true.
+ logical, parameter :: USE_PML_XMAX = .true.
+ logical, parameter :: USE_PML_YMIN = .true.
+ logical, parameter :: USE_PML_YMAX = .true.
+
+! thickness of the PML layer in grid points
+ integer, parameter :: NPOINTS_PML = 10
+
+! P-velocity, S-velocity and density
+ double precision, parameter :: cp = 3300.d0
+ double precision, parameter :: cs = cp / 1.732d0
+ double precision, parameter :: density = 2800.d0
+
+! total number of time steps
+ integer, parameter :: NSTEP = 2000
+
+! time step in seconds
+ double precision, parameter :: DELTAT = 2.d-3
+
+! parameters for the source
+ double precision, parameter :: f0 = 7.d0
+ double precision, parameter :: t0 = 1.20d0 / f0
+ double precision, parameter :: factor = 1.d7
+
+! source
+ integer, parameter :: ISOURCE = NX - 2*NPOINTS_PML - 1
+ integer, parameter :: JSOURCE = 2 * NY / 3 + 1
+ double precision, parameter :: xsource = (ISOURCE - 1) * DELTAX
+ double precision, parameter :: ysource = (JSOURCE - 1) * DELTAY
+! angle of source force clockwise with respect to vertical (Y) axis
+ double precision, parameter :: ANGLE_FORCE = 135.d0
+
+! receivers
+ integer, parameter :: NREC = 2
+ double precision, parameter :: xdeb = xsource - 100.d0 ! first receiver x in meters
+ double precision, parameter :: ydeb = 2300.d0 ! first receiver y in meters
+ double precision, parameter :: xfin = xsource ! last receiver x in meters
+ double precision, parameter :: yfin = 300.d0 ! last receiver y in meters
+
+! display information on the screen from time to time
+ integer, parameter :: IT_DISPLAY = 100
+
+! value of PI
+ double precision, parameter :: PI = 3.141592653589793238462643d0
+
+! conversion from degrees to radians
+ double precision, parameter :: DEGREES_TO_RADIANS = PI / 180.d0
+
+! zero
+ double precision, parameter :: ZERO = 0.d0
+
+! large value for maximum
+ double precision, parameter :: HUGEVAL = 1.d+30
+
+! velocity threshold above which we consider that the code became unstable
+ double precision, parameter :: STABILITY_THRESHOLD = 1.d+25
+
+! main arrays
+ double precision, dimension(NX,NY) :: vx,vy,sigmaxx,sigmayy,sigmaxy,lambda,mu,rho
+
+! to interpolate material parameters at the right location in the staggered grid cell
+ double precision lambda_half_x,mu_half_x,lambda_plus_two_mu_half_x,mu_half_y,rho_half_x_half_y
+
+! for evolution of total energy in the medium
+ double precision epsilon_xx,epsilon_yy,epsilon_xy
+ double precision, dimension(NSTEP) :: total_energy_kinetic,total_energy_potential
+
+! power to compute d0 profile
+ double precision, parameter :: NPOWER = 2.d0
+
+ double precision, parameter :: K_MAX_PML = 1.d0 ! from Gedney page 8.11
+ double precision, parameter :: ALPHA_MAX_PML = 2.d0*PI*(f0/2.d0) ! from festa and Vilotte
+
+! arrays for the memory variables
+! could declare these arrays in PML only to save a lot of memory, but proof of concept only here
+ double precision, dimension(NX,NY) :: &
+ memory_dvx_dx, &
+ memory_dvx_dy, &
+ memory_dvy_dx, &
+ memory_dvy_dy, &
+ memory_dsigmaxx_dx, &
+ memory_dsigmayy_dy, &
+ memory_dsigmaxy_dx, &
+ memory_dsigmaxy_dy
+
+ double precision :: &
+ value_dvx_dx, &
+ value_dvx_dy, &
+ value_dvy_dx, &
+ value_dvy_dy, &
+ value_dsigmaxx_dx, &
+ value_dsigmayy_dy, &
+ value_dsigmaxy_dx, &
+ value_dsigmaxy_dy
+
+! 1D arrays for the damping profiles
+ double precision, dimension(NX) :: d_x,K_x,alpha_prime_x,a_x,b_x,d_x_half,K_x_half,alpha_prime_x_half,a_x_half,b_x_half
+ double precision, dimension(NY) :: d_y,K_y,alpha_prime_y,a_y,b_y,d_y_half,K_y_half,alpha_prime_y_half,a_y_half,b_y_half
+
+ double precision :: thickness_PML_x,thickness_PML_y,xoriginleft,xoriginright,yoriginbottom,yorigintop
+ double precision :: Rcoef,d0_x,d0_y,xval,yval,abscissa_in_PML,abscissa_normalized
+
+! for the source
+ double precision :: a,t,force_x,force_y,source_term
+
+! for receivers
+ double precision xspacerec,yspacerec,distval,dist
+ integer, dimension(NREC) :: ix_rec,iy_rec
+ double precision, dimension(NREC) :: xrec,yrec
+
+! for seismograms
+ double precision, dimension(NSTEP,NREC) :: sisvx,sisvy
+
+ integer :: i,j,it,irec
+
+ double precision :: Courant_number,velocnorm
+
+!---
+!--- program starts here
+!---
+
+ print *
+ print *,'2D elastic finite-difference code in velocity and stress formulation with C-PML'
+ print *
+
+! display size of the model
+ print *
+ print *,'NX = ',NX
+ print *,'NY = ',NY
+ print *
+ print *,'size of the model along X = ',(NX - 1) * DELTAX
+ print *,'size of the model along Y = ',(NY - 1) * DELTAY
+ print *
+ print *,'Total number of grid points = ',NX * NY
+ print *
+
+!--- define profile of absorption in PML region
+
+! thickness of the PML layer in meters
+ thickness_PML_x = NPOINTS_PML * DELTAX
+ thickness_PML_y = NPOINTS_PML * DELTAY
+
+! reflection coefficient (INRIA report section 6.1)
+ Rcoef = 0.001d0
+
+! check that NPOWER is okay
+ if(NPOWER < 1) stop 'NPOWER must be greater than 1'
+
+! compute d0 from INRIA report section 6.1
+ d0_x = - (NPOWER + 1) * cp * log(Rcoef) / (2.d0 * thickness_PML_x)
+ d0_y = - (NPOWER + 1) * cp * log(Rcoef) / (2.d0 * thickness_PML_y)
+
+ print *,'d0_x = ',d0_x
+ print *,'d0_y = ',d0_y
+ print *
+
+ d_x(:) = ZERO
+ d_x_half(:) = ZERO
+ K_x(:) = 1.d0
+ K_x_half(:) = 1.d0
+ alpha_prime_x(:) = ZERO
+ alpha_prime_x_half(:) = ZERO
+ a_x(:) = ZERO
+ a_x_half(:) = ZERO
+
+ d_y(:) = ZERO
+ d_y_half(:) = ZERO
+ K_y(:) = 1.d0
+ K_y_half(:) = 1.d0
+ alpha_prime_y(:) = ZERO
+ alpha_prime_y_half(:) = ZERO
+ a_y(:) = ZERO
+ a_y_half(:) = ZERO
+
+! damping in the X direction
+
+! origin of the PML layer (position of right edge minus thickness, in meters)
+ xoriginleft = thickness_PML_x
+ xoriginright = (NX-1)*DELTAX - thickness_PML_x
+
+ do i = 1,NX
+
+! abscissa of current grid point along the damping profile
+ xval = DELTAX * dble(i-1)
+
+!---------- left edge
+ if(USE_PML_XMIN) then
+
+! define damping profile at the grid points
+ abscissa_in_PML = xoriginleft - xval
+ if(abscissa_in_PML >= ZERO) then
+ abscissa_normalized = abscissa_in_PML / thickness_PML_x
+ d_x(i) = d0_x * abscissa_normalized**NPOWER
+! this taken from Gedney page 8.2
+ K_x(i) = 1.d0 + (K_MAX_PML - 1.d0) * abscissa_normalized**NPOWER
+ alpha_prime_x(i) = ALPHA_MAX_PML * (1.d0 - abscissa_normalized)
+ endif
+
+! define damping profile at half the grid points
+ abscissa_in_PML = xoriginleft - (xval + DELTAX/2.d0)
+ if(abscissa_in_PML >= ZERO) then
+ abscissa_normalized = abscissa_in_PML / thickness_PML_x
+ d_x_half(i) = d0_x * abscissa_normalized**NPOWER
+! this taken from Gedney page 8.2
+ K_x_half(i) = 1.d0 + (K_MAX_PML - 1.d0) * abscissa_normalized**NPOWER
+ alpha_prime_x_half(i) = ALPHA_MAX_PML * (1.d0 - abscissa_normalized)
+ endif
+
+ endif
+
+!---------- right edge
+ if(USE_PML_XMAX) then
+
+! define damping profile at the grid points
+ abscissa_in_PML = xval - xoriginright
+ if(abscissa_in_PML >= ZERO) then
+ abscissa_normalized = abscissa_in_PML / thickness_PML_x
+ d_x(i) = d0_x * abscissa_normalized**NPOWER
+! this taken from Gedney page 8.2
+ K_x(i) = 1.d0 + (K_MAX_PML - 1.d0) * abscissa_normalized**NPOWER
+ alpha_prime_x(i) = ALPHA_MAX_PML * (1.d0 - abscissa_normalized)
+ endif
+
+! define damping profile at half the grid points
+ abscissa_in_PML = xval + DELTAX/2.d0 - xoriginright
+ if(abscissa_in_PML >= ZERO) then
+ abscissa_normalized = abscissa_in_PML / thickness_PML_x
+ d_x_half(i) = d0_x * abscissa_normalized**NPOWER
+! this taken from Gedney page 8.2
+ K_x_half(i) = 1.d0 + (K_MAX_PML - 1.d0) * abscissa_normalized**NPOWER
+ alpha_prime_x_half(i) = ALPHA_MAX_PML * (1.d0 - abscissa_normalized)
+ endif
+
+ endif
+
+! just in case, for -5 at the end
+ if(alpha_prime_x(i) < ZERO) alpha_prime_x(i) = ZERO
+ if(alpha_prime_x_half(i) < ZERO) alpha_prime_x_half(i) = ZERO
+
+ b_x(i) = exp(- (d_x(i) / K_x(i) + alpha_prime_x(i)) * DELTAT)
+ b_x_half(i) = exp(- (d_x_half(i) / K_x_half(i) + alpha_prime_x_half(i)) * DELTAT)
+
+! this to avoid division by zero outside the PML
+ if(abs(d_x(i)) > 1.d-6) a_x(i) = d_x(i) * (b_x(i) - 1.d0) / (K_x(i) * (d_x(i) + K_x(i) * alpha_prime_x(i)))
+ if(abs(d_x_half(i)) > 1.d-6) a_x_half(i) = d_x_half(i) * &
+ (b_x_half(i) - 1.d0) / (K_x_half(i) * (d_x_half(i) + K_x_half(i) * alpha_prime_x_half(i)))
+
+ enddo
+
+! damping in the Y direction
+
+! origin of the PML layer (position of right edge minus thickness, in meters)
+ yoriginbottom = thickness_PML_y
+ yorigintop = (NY-1)*DELTAY - thickness_PML_y
+
+ do j = 1,NY
+
+! abscissa of current grid point along the damping profile
+ yval = DELTAY * dble(j-1)
+
+!---------- bottom edge
+ if(USE_PML_YMIN) then
+
+! define damping profile at the grid points
+ abscissa_in_PML = yoriginbottom - yval
+ if(abscissa_in_PML >= ZERO) then
+ abscissa_normalized = abscissa_in_PML / thickness_PML_y
+ d_y(j) = d0_y * abscissa_normalized**NPOWER
+! this taken from Gedney page 8.2
+ K_y(j) = 1.d0 + (K_MAX_PML - 1.d0) * abscissa_normalized**NPOWER
+ alpha_prime_y(j) = ALPHA_MAX_PML * (1.d0 - abscissa_normalized)
+ endif
+
+! define damping profile at half the grid points
+ abscissa_in_PML = yoriginbottom - (yval + DELTAY/2.d0)
+ if(abscissa_in_PML >= ZERO) then
+ abscissa_normalized = abscissa_in_PML / thickness_PML_y
+ d_y_half(j) = d0_y * abscissa_normalized**NPOWER
+! this taken from Gedney page 8.2
+ K_y_half(j) = 1.d0 + (K_MAX_PML - 1.d0) * abscissa_normalized**NPOWER
+ alpha_prime_y_half(j) = ALPHA_MAX_PML * (1.d0 - abscissa_normalized)
+ endif
+
+ endif
+
+!---------- top edge
+ if(USE_PML_YMAX) then
+
+! define damping profile at the grid points
+ abscissa_in_PML = yval - yorigintop
+ if(abscissa_in_PML >= ZERO) then
+ abscissa_normalized = abscissa_in_PML / thickness_PML_y
+ d_y(j) = d0_y * abscissa_normalized**NPOWER
+! this taken from Gedney page 8.2
+ K_y(j) = 1.d0 + (K_MAX_PML - 1.d0) * abscissa_normalized**NPOWER
+ alpha_prime_y(j) = ALPHA_MAX_PML * (1.d0 - abscissa_normalized)
+ endif
+
+! define damping profile at half the grid points
+ abscissa_in_PML = yval + DELTAY/2.d0 - yorigintop
+ if(abscissa_in_PML >= ZERO) then
+ abscissa_normalized = abscissa_in_PML / thickness_PML_y
+ d_y_half(j) = d0_y * abscissa_normalized**NPOWER
+! this taken from Gedney page 8.2
+ K_y_half(j) = 1.d0 + (K_MAX_PML - 1.d0) * abscissa_normalized**NPOWER
+ alpha_prime_y_half(j) = ALPHA_MAX_PML * (1.d0 - abscissa_normalized)
+ endif
+
+ endif
+
+ b_y(j) = exp(- (d_y(j) / K_y(j) + alpha_prime_y(j)) * DELTAT)
+ b_y_half(j) = exp(- (d_y_half(j) / K_y_half(j) + alpha_prime_y_half(j)) * DELTAT)
+
+! this to avoid division by zero outside the PML
+ if(abs(d_y(j)) > 1.d-6) a_y(j) = d_y(j) * (b_y(j) - 1.d0) / (K_y(j) * (d_y(j) + K_y(j) * alpha_prime_y(j)))
+ if(abs(d_y_half(j)) > 1.d-6) a_y_half(j) = d_y_half(j) * &
+ (b_y_half(j) - 1.d0) / (K_y_half(j) * (d_y_half(j) + K_y_half(j) * alpha_prime_y_half(j)))
+
+ enddo
+
+! compute the Lame parameters and density
+ do j = 1,NY
+ do i = 1,NX
+ rho(i,j) = density
+ mu(i,j) = density*cs*cs
+ lambda(i,j) = density*(cp*cp - 2.d0*cs*cs)
+ enddo
+ enddo
+
+! print position of the source
+ print *,'Position of the source:'
+ print *
+ print *,'x = ',xsource
+ print *,'y = ',ysource
+ print *
+
+! define location of receivers
+ print *,'There are ',nrec,' receivers'
+ print *
+ xspacerec = (xfin-xdeb) / dble(NREC-1)
+ yspacerec = (yfin-ydeb) / dble(NREC-1)
+ do irec=1,nrec
+ xrec(irec) = xdeb + dble(irec-1)*xspacerec
+ yrec(irec) = ydeb + dble(irec-1)*yspacerec
+ enddo
+
+! find closest grid point for each receiver
+ do irec=1,nrec
+ dist = HUGEVAL
+ do j = 1,NY
+ do i = 1,NX
+ distval = sqrt((DELTAX*dble(i-1) - xrec(irec))**2 + (DELTAY*dble(j-1) - yrec(irec))**2)
+ if(distval < dist) then
+ dist = distval
+ ix_rec(irec) = i
+ iy_rec(irec) = j
+ endif
+ enddo
+ enddo
+ print *,'receiver ',irec,' x_target,y_target = ',xrec(irec),yrec(irec)
+ print *,'closest grid point found at distance ',dist,' in i,j = ',ix_rec(irec),iy_rec(irec)
+ print *
+ enddo
+
+! check the Courant stability condition for the explicit time scheme
+! R. Courant et K. O. Friedrichs et H. Lewy (1928)
+ Courant_number = cp * DELTAT * sqrt(1.d0/DELTAX**2 + 1.d0/DELTAY**2)
+ print *,'Courant number is ',Courant_number
+ print *
+ if(Courant_number > 1.d0) stop 'time step is too large, simulation will be unstable'
+
+! suppress old files (can be commented out if "call system" is missing in your compiler)
+! call system('rm -f Vx_*.dat Vy_*.dat image*.pnm image*.gif')
+
+! initialize arrays
+ vx(:,:) = ZERO
+ vy(:,:) = ZERO
+ sigmaxx(:,:) = ZERO
+ sigmayy(:,:) = ZERO
+ sigmaxy(:,:) = ZERO
+
+! PML
+ memory_dvx_dx(:,:) = ZERO
+ memory_dvx_dy(:,:) = ZERO
+ memory_dvy_dx(:,:) = ZERO
+ memory_dvy_dy(:,:) = ZERO
+ memory_dsigmaxx_dx(:,:) = ZERO
+ memory_dsigmayy_dy(:,:) = ZERO
+ memory_dsigmaxy_dx(:,:) = ZERO
+ memory_dsigmaxy_dy(:,:) = ZERO
+
+! initialize seismograms
+ sisvx(:,:) = ZERO
+ sisvy(:,:) = ZERO
+
+! initialize total energy
+ total_energy_kinetic(:) = ZERO
+ total_energy_potential(:) = ZERO
+
+!---
+!--- beginning of time loop
+!---
+
+ do it = 1,NSTEP
+
+!------------------------------------------------------------
+! compute stress sigma and update memory variables for C-PML
+!------------------------------------------------------------
+
+ do j = 2,NY
+ do i = 1,NX-1
+
+! interpolate material parameters at the right location in the staggered grid cell
+ lambda_half_x = 0.5d0 * (lambda(i+1,j) + lambda(i,j))
+ mu_half_x = 0.5d0 * (mu(i+1,j) + mu(i,j))
+ lambda_plus_two_mu_half_x = lambda_half_x + 2.d0 * mu_half_x
+
+ value_dvx_dx = (vx(i+1,j) - vx(i,j)) / DELTAX
+ value_dvy_dy = (vy(i,j) - vy(i,j-1)) / DELTAY
+
+ memory_dvx_dx(i,j) = b_x_half(i) * memory_dvx_dx(i,j) + a_x_half(i) * value_dvx_dx
+ memory_dvy_dy(i,j) = b_y(j) * memory_dvy_dy(i,j) + a_y(j) * value_dvy_dy
+
+ value_dvx_dx = value_dvx_dx / K_x_half(i) + memory_dvx_dx(i,j)
+ value_dvy_dy = value_dvy_dy / K_y(j) + memory_dvy_dy(i,j)
+
+ sigmaxx(i,j) = sigmaxx(i,j) + &
+ (lambda_plus_two_mu_half_x * value_dvx_dx + lambda_half_x * value_dvy_dy) * DELTAT
+
+ sigmayy(i,j) = sigmayy(i,j) + &
+ (lambda_half_x * value_dvx_dx + lambda_plus_two_mu_half_x * value_dvy_dy) * DELTAT
+
+ enddo
+ enddo
+
+ do j = 1,NY-1
+ do i = 2,NX
+
+! interpolate material parameters at the right location in the staggered grid cell
+ mu_half_y = 0.5d0 * (mu(i,j+1) + mu(i,j))
+
+ value_dvy_dx = (vy(i,j) - vy(i-1,j)) / DELTAX
+ value_dvx_dy = (vx(i,j+1) - vx(i,j)) / DELTAY
+
+ memory_dvy_dx(i,j) = b_x(i) * memory_dvy_dx(i,j) + a_x(i) * value_dvy_dx
+ memory_dvx_dy(i,j) = b_y_half(j) * memory_dvx_dy(i,j) + a_y_half(j) * value_dvx_dy
+
+ value_dvy_dx = value_dvy_dx / K_x(i) + memory_dvy_dx(i,j)
+ value_dvx_dy = value_dvx_dy / K_y_half(j) + memory_dvx_dy(i,j)
+
+ sigmaxy(i,j) = sigmaxy(i,j) + mu_half_y * (value_dvy_dx + value_dvx_dy) * DELTAT
+
+ enddo
+ enddo
+
+!--------------------------------------------------------
+! compute velocity and update memory variables for C-PML
+!--------------------------------------------------------
+
+ do j = 2,NY
+ do i = 2,NX
+
+ value_dsigmaxx_dx = (sigmaxx(i,j) - sigmaxx(i-1,j)) / DELTAX
+ value_dsigmaxy_dy = (sigmaxy(i,j) - sigmaxy(i,j-1)) / DELTAY
+
+ memory_dsigmaxx_dx(i,j) = b_x(i) * memory_dsigmaxx_dx(i,j) + a_x(i) * value_dsigmaxx_dx
+ memory_dsigmaxy_dy(i,j) = b_y(j) * memory_dsigmaxy_dy(i,j) + a_y(j) * value_dsigmaxy_dy
+
+ value_dsigmaxx_dx = value_dsigmaxx_dx / K_x(i) + memory_dsigmaxx_dx(i,j)
+ value_dsigmaxy_dy = value_dsigmaxy_dy / K_y(j) + memory_dsigmaxy_dy(i,j)
+
+ vx(i,j) = vx(i,j) + (value_dsigmaxx_dx + value_dsigmaxy_dy) * DELTAT / rho(i,j)
+
+ enddo
+ enddo
+
+ do j = 1,NY-1
+ do i = 1,NX-1
+
+! interpolate density at the right location in the staggered grid cell
+ rho_half_x_half_y = 0.25d0 * (rho(i,j) + rho(i+1,j) + rho(i+1,j+1) + rho(i,j+1))
+
+ value_dsigmaxy_dx = (sigmaxy(i+1,j) - sigmaxy(i,j)) / DELTAX
+ value_dsigmayy_dy = (sigmayy(i,j+1) - sigmayy(i,j)) / DELTAY
+
+ memory_dsigmaxy_dx(i,j) = b_x_half(i) * memory_dsigmaxy_dx(i,j) + a_x_half(i) * value_dsigmaxy_dx
+ memory_dsigmayy_dy(i,j) = b_y_half(j) * memory_dsigmayy_dy(i,j) + a_y_half(j) * value_dsigmayy_dy
+
+ value_dsigmaxy_dx = value_dsigmaxy_dx / K_x_half(i) + memory_dsigmaxy_dx(i,j)
+ value_dsigmayy_dy = value_dsigmayy_dy / K_y_half(j) + memory_dsigmayy_dy(i,j)
+
+ vy(i,j) = vy(i,j) + (value_dsigmaxy_dx + value_dsigmayy_dy) * DELTAT / rho_half_x_half_y
+
+ enddo
+ enddo
+
+! add the source (force vector located at a given grid point)
+ a = pi*pi*f0*f0
+ t = dble(it-1)*DELTAT
+
+! Gaussian
+! source_term = factor * exp(-a*(t-t0)**2)
+
+! first derivative of a Gaussian
+ source_term = - factor * 2.d0*a*(t-t0)*exp(-a*(t-t0)**2)
+
+! Ricker source time function (second derivative of a Gaussian)
+! source_term = factor * (1.d0 - 2.d0*a*(t-t0)**2)*exp(-a*(t-t0)**2)
+
+ force_x = sin(ANGLE_FORCE * DEGREES_TO_RADIANS) * source_term
+ force_y = cos(ANGLE_FORCE * DEGREES_TO_RADIANS) * source_term
+
+! define location of the source
+ i = ISOURCE
+ j = JSOURCE
+
+! interpolate density at the right location in the staggered grid cell
+ rho_half_x_half_y = 0.25d0 * (rho(i,j) + rho(i+1,j) + rho(i+1,j+1) + rho(i,j+1))
+
+ vx(i,j) = vx(i,j) + force_x * DELTAT / rho(i,j)
+ vy(i,j) = vy(i,j) + force_y * DELTAT / rho_half_x_half_y
+
+! Dirichlet conditions (rigid boundaries) on the edges or at the bottom of the PML layers
+ vx(1,:) = ZERO
+ vx(NX,:) = ZERO
+
+ vx(:,1) = ZERO
+ vx(:,NY) = ZERO
+
+ vy(1,:) = ZERO
+ vy(NX,:) = ZERO
+
+ vy(:,1) = ZERO
+ vy(:,NY) = ZERO
+
+! store seismograms
+ do irec = 1,NREC
+ sisvx(it,irec) = vx(ix_rec(irec),iy_rec(irec))
+ sisvy(it,irec) = vy(ix_rec(irec),iy_rec(irec))
+ enddo
+
+! compute total energy in the medium (without the PML layers)
+
+! compute kinetic energy first, defined as 1/2 rho ||v||^2
+! in principle we should use rho_half_x_half_y instead of rho for vy
+! in order to interpolate density at the right location in the staggered grid cell
+! but in a homogeneous medium we can safely ignore it
+ total_energy_kinetic(it) = 0.5d0 * sum( &
+ rho(NPOINTS_PML+1:NX-NPOINTS_PML,NPOINTS_PML+1:NY-NPOINTS_PML)*( &
+ vx(NPOINTS_PML+1:NX-NPOINTS_PML,NPOINTS_PML+1:NY-NPOINTS_PML)**2 + &
+ vy(NPOINTS_PML+1:NX-NPOINTS_PML,NPOINTS_PML+1:NY-NPOINTS_PML)**2))
+
+! add potential energy, defined as 1/2 epsilon_ij sigma_ij
+! in principle we should interpolate the medium parameters at the right location
+! in the staggered grid cell but in a homogeneous medium we can safely ignore it
+ total_energy_potential(it) = ZERO
+ do j = NPOINTS_PML+1, NY-NPOINTS_PML
+ do i = NPOINTS_PML+1, NX-NPOINTS_PML
+ epsilon_xx = ((lambda(i,j) + 2.d0*mu(i,j)) * sigmaxx(i,j) - lambda(i,j) * &
+ sigmayy(i,j)) / (4.d0 * mu(i,j) * (lambda(i,j) + mu(i,j)))
+ epsilon_yy = ((lambda(i,j) + 2.d0*mu(i,j)) * sigmayy(i,j) - lambda(i,j) * &
+ sigmaxx(i,j)) / (4.d0 * mu(i,j) * (lambda(i,j) + mu(i,j)))
+ epsilon_xy = sigmaxy(i,j) / (2.d0 * mu(i,j))
+ total_energy_potential(it) = total_energy_potential(it) + &
+ 0.5d0 * (epsilon_xx * sigmaxx(i,j) + epsilon_yy * sigmayy(i,j) + 2.d0 * epsilon_xy * sigmaxy(i,j))
+ enddo
+ enddo
+
+! output information
+ if(mod(it,IT_DISPLAY) == 0 .or. it == 5) then
+
+! print maximum of norm of velocity
+ velocnorm = maxval(sqrt(vx**2 + vy**2))
+ print *,'Time step # ',it
+ print *,'Time: ',sngl((it-1)*DELTAT),' seconds'
+ print *,'Max norm velocity vector V (m/s) = ',velocnorm
+ print *,'total energy = ',total_energy_kinetic(it) + total_energy_potential(it)
+ print *
+! check stability of the code, exit if unstable
+ if(velocnorm > STABILITY_THRESHOLD) stop 'code became unstable and blew up'
+
+ call create_2D_image(vx,NX,NY,it,ISOURCE,JSOURCE,ix_rec,iy_rec,nrec, &
+ NPOINTS_PML,USE_PML_XMIN,USE_PML_XMAX,USE_PML_YMIN,USE_PML_YMAX,1)
+ call create_2D_image(vy,NX,NY,it,ISOURCE,JSOURCE,ix_rec,iy_rec,nrec, &
+ NPOINTS_PML,USE_PML_XMIN,USE_PML_XMAX,USE_PML_YMIN,USE_PML_YMAX,2)
+
+ endif
+
+ enddo ! end of time loop
+
+! save seismograms
+ call write_seismograms(sisvx,sisvy,NSTEP,NREC,DELTAT)
+
+! save total energy
+ open(unit=20,file='energy.dat',status='unknown')
+ do it = 1,NSTEP
+ write(20,*) sngl(dble(it-1)*DELTAT),total_energy_kinetic(it), &
+ total_energy_potential(it),total_energy_kinetic(it) + total_energy_potential(it)
+ enddo
+ close(20)
+
+! create script for Gnuplot for total energy
+ open(unit=20,file='plot_energy',status='unknown')
+ write(20,*) '# set term x11'
+ write(20,*) 'set term postscript landscape monochrome dashed "Helvetica" 22'
+ write(20,*)
+ write(20,*) 'set xlabel "Time (s)"'
+ write(20,*) 'set ylabel "Total energy"'
+ write(20,*)
+ write(20,*) 'set output "cpml_total_energy_semilog.eps"'
+ write(20,*) 'set logscale y'
+ write(20,*) 'plot "energy.dat" us 1:2 t ''Ec'' w l 1, "energy.dat" us 1:3 &
+ & t ''Ep'' w l 3, "energy.dat" us 1:4 t ''Total energy'' w l 4'
+ write(20,*) 'pause -1 "Hit any key..."'
+ write(20,*)
+ close(20)
+
+ open(unit=20,file='plot_comparison',status='unknown')
+ write(20,*) '# set term x11'
+ write(20,*) 'set term postscript landscape monochrome dashed "Helvetica" 22'
+ write(20,*)
+ write(20,*) 'set xlabel "Time (s)"'
+ write(20,*) 'set ylabel "Total energy"'
+ write(20,*)
+ write(20,*) 'set output "compare_total_energy_semilog.eps"'
+ write(20,*) 'set logscale y'
+ write(20,*) 'plot "energy.dat" us 1:4 t ''Total energy CPML'' w l 1, &
+ & "../collino/energy.dat" us 1:4 t ''Total energy Collino'' w l 2'
+ write(20,*) 'pause -1 "Hit any key..."'
+ write(20,*)
+ close(20)
+
+! create script for Gnuplot
+ open(unit=20,file='plotgnu',status='unknown')
+ write(20,*) 'set term x11'
+ write(20,*) '# set term postscript landscape monochrome dashed "Helvetica" 22'
+ write(20,*)
+ write(20,*) 'set xlabel "Time (s)"'
+ write(20,*) 'set ylabel "Amplitude (m / s)"'
+ write(20,*)
+
+ write(20,*) 'set output "v_sigma_Vx_receiver_001.eps"'
+ write(20,*) 'plot "Vx_file_001.dat" t ''Vx C-PML'' w l 1'
+ write(20,*) 'pause -1 "Hit any key..."'
+ write(20,*)
+
+ write(20,*) 'set output "v_sigma_Vy_receiver_001.eps"'
+ write(20,*) 'plot "Vy_file_001.dat" t ''Vy C-PML'' w l 1'
+ write(20,*) 'pause -1 "Hit any key..."'
+ write(20,*)
+
+ write(20,*) 'set output "v_sigma_Vx_receiver_002.eps"'
+ write(20,*) 'plot "Vx_file_002.dat" t ''Vx C-PML'' w l 1'
+ write(20,*) 'pause -1 "Hit any key..."'
+ write(20,*)
+
+ write(20,*) 'set output "v_sigma_Vy_receiver_002.eps"'
+ write(20,*) 'plot "Vy_file_002.dat" t ''Vy C-PML'' w l 1'
+ write(20,*) 'pause -1 "Hit any key..."'
+ write(20,*)
+
+ close(20)
+
+ print *
+ print *,'End of the simulation'
+ print *
+
+ end program seismic_CPML_2D_iso_second
+
+!----
+!---- save the seismograms in ASCII text format
+!----
+
+ subroutine write_seismograms(sisvx,sisvy,nt,nrec,DELTAT)
+
+ implicit none
+
+ integer nt,nrec
+ double precision DELTAT
+
+ double precision sisvx(nt,nrec)
+ double precision sisvy(nt,nrec)
+
+ integer irec,it
+
+ character(len=100) file_name
+
+! X component
+ do irec=1,nrec
+ write(file_name,"('Vx_file_',i3.3,'.dat')") irec
+ open(unit=11,file=file_name,status='unknown')
+ do it=1,nt
+ write(11,*) sngl(dble(it-1)*DELTAT),' ',sngl(sisvx(it,irec))
+ enddo
+ close(11)
+ enddo
+
+! Y component
+ do irec=1,nrec
+ write(file_name,"('Vy_file_',i3.3,'.dat')") irec
+ open(unit=11,file=file_name,status='unknown')
+ do it=1,nt
+ write(11,*) sngl(dble(it-1)*DELTAT),' ',sngl(sisvy(it,irec))
+ enddo
+ close(11)
+ enddo
+
+ end subroutine write_seismograms
+
+!----
+!---- routine to create a color image of a given vector component
+!---- the image is created in PNM format and then converted to GIF
+!----
+
+ subroutine create_2D_image(image_data_2D,NX,NY,it,ISOURCE,JSOURCE,ix_rec,iy_rec,nrec, &
+ NPOINTS_PML,USE_PML_XMIN,USE_PML_XMAX,USE_PML_YMIN,USE_PML_YMAX,field_number)
+
+ implicit none
+
+! non linear display to enhance small amplitudes for graphics
+ double precision, parameter :: POWER_DISPLAY = 0.30d0
+
+! amplitude threshold above which we draw the color point
+ double precision, parameter :: cutvect = 0.01d0
+
+! use black or white background for points that are below the threshold
+ logical, parameter :: WHITE_BACKGROUND = .true.
+
+! size of cross and square in pixels drawn to represent the source and the receivers
+ integer, parameter :: width_cross = 5, thickness_cross = 1, size_square = 3
+
+ integer NX,NY,it,field_number,ISOURCE,JSOURCE,NPOINTS_PML,nrec
+ logical USE_PML_XMIN,USE_PML_XMAX,USE_PML_YMIN,USE_PML_YMAX
+
+ double precision, dimension(NX,NY) :: image_data_2D
+
+ integer, dimension(nrec) :: ix_rec,iy_rec
+
+ integer :: ix,iy,irec
+
+ character(len=100) :: file_name,system_command
+
+ integer :: R, G, B
+
+ double precision :: normalized_value,max_amplitude
+
+! open image file and create system command to convert image to more convenient format
+ if(field_number == 1) then
+ write(file_name,"('image',i6.6,'_Vx.pnm')") it
+ write(system_command,"('convert image',i6.6,'_Vx.pnm image',i6.6,'_Vx.gif ; rm image',i6.6,'_Vx.pnm')") it,it,it
+ else if(field_number == 2) then
+ write(file_name,"('image',i6.6,'_Vy.pnm')") it
+ write(system_command,"('convert image',i6.6,'_Vy.pnm image',i6.6,'_Vy.gif ; rm image',i6.6,'_Vy.pnm')") it,it,it
+ endif
+
+ open(unit=27, file=file_name, status='unknown')
+
+ write(27,"('P3')") ! write image in PNM P3 format
+
+ write(27,*) NX,NY ! write image size
+ write(27,*) '255' ! maximum value of each pixel color
+
+! compute maximum amplitude
+ max_amplitude = maxval(abs(image_data_2D))
+
+! image starts in upper-left corner in PNM format
+ do iy=NY,1,-1
+ do ix=1,NX
+
+! define data as vector component normalized to [-1:1] and rounded to nearest integer
+! keeping in mind that amplitude can be negative
+ normalized_value = image_data_2D(ix,iy) / max_amplitude
+
+! suppress values that are outside [-1:+1] to avoid small edge effects
+ if(normalized_value < -1.d0) normalized_value = -1.d0
+ if(normalized_value > 1.d0) normalized_value = 1.d0
+
+! draw an orange cross to represent the source
+ if((ix >= ISOURCE - width_cross .and. ix <= ISOURCE + width_cross .and. &
+ iy >= JSOURCE - thickness_cross .and. iy <= JSOURCE + thickness_cross) .or. &
+ (ix >= ISOURCE - thickness_cross .and. ix <= ISOURCE + thickness_cross .and. &
+ iy >= JSOURCE - width_cross .and. iy <= JSOURCE + width_cross)) then
+ R = 255
+ G = 157
+ B = 0
+
+! display two-pixel-thick black frame around the image
+ else if(ix <= 2 .or. ix >= NX-1 .or. iy <= 2 .or. iy >= NY-1) then
+ R = 0
+ G = 0
+ B = 0
+
+! display edges of the PML layers
+ else if((USE_PML_XMIN .and. ix == NPOINTS_PML) .or. &
+ (USE_PML_XMAX .and. ix == NX - NPOINTS_PML) .or. &
+ (USE_PML_YMIN .and. iy == NPOINTS_PML) .or. &
+ (USE_PML_YMAX .and. iy == NY - NPOINTS_PML)) then
+ R = 255
+ G = 150
+ B = 0
+
+! suppress all the values that are below the threshold
+ else if(abs(image_data_2D(ix,iy)) <= max_amplitude * cutvect) then
+
+! use a black or white background for points that are below the threshold
+ if(WHITE_BACKGROUND) then
+ R = 255
+ G = 255
+ B = 255
+ else
+ R = 0
+ G = 0
+ B = 0
+ endif
+
+! represent regular image points using red if value is positive, blue if negative
+ else if(normalized_value >= 0.d0) then
+ R = nint(255.d0*normalized_value**POWER_DISPLAY)
+ G = 0
+ B = 0
+ else
+ R = 0
+ G = 0
+ B = nint(255.d0*abs(normalized_value)**POWER_DISPLAY)
+ endif
+
+! draw a green square to represent the receivers
+ do irec = 1,nrec
+ if((ix >= ix_rec(irec) - size_square .and. ix <= ix_rec(irec) + size_square .and. &
+ iy >= iy_rec(irec) - size_square .and. iy <= iy_rec(irec) + size_square) .or. &
+ (ix >= ix_rec(irec) - size_square .and. ix <= ix_rec(irec) + size_square .and. &
+ iy >= iy_rec(irec) - size_square .and. iy <= iy_rec(irec) + size_square)) then
+! use dark green color
+ R = 30
+ G = 180
+ B = 60
+ endif
+ enddo
+
+! write color pixel
+ write(27,"(i3,' ',i3,' ',i3)") R,G,B
+
+ enddo
+ enddo
+
+! close file
+ close(27)
+
+! call the system to convert image to GIF (can be commented out if "call system" is missing in your compiler)
+! call system(system_command)
+
+ end subroutine create_2D_image
+
+!
+! CeCILL FREE SOFTWARE LICENSE AGREEMENT
+!
+! Notice
+!
+! This Agreement is a Free Software license agreement that is the result
+! of discussions between its authors in order to ensure compliance with
+! the two main principles guiding its drafting:
+!
+! * firstly, compliance with the principles governing the distribution
+! of Free Software: access to source code, broad rights granted to
+! users,
+! * secondly, the election of a governing law, French law, with which
+! it is conformant, both as regards the law of torts and
+! intellectual property law, and the protection that it offers to
+! both authors and holders of the economic rights over software.
+!
+! The authors of the CeCILL (for Ce[a] C[nrs] I[nria] L[ogiciel] L[ibre])
+! license are:
+!
+! Commissariat a l'Energie Atomique - CEA, a public scientific, technical
+! and industrial research establishment, having its principal place of
+! business at 25 rue Leblanc, immeuble Le Ponant D, 75015 Paris, France.
+!
+! Centre National de la Recherche Scientifique - CNRS, a public scientific
+! and technological establishment, having its principal place of business
+! at 3 rue Michel-Ange, 75794 Paris cedex 16, France.
+!
+! Institut National de Recherche en Informatique et en Automatique -
+! INRIA, a public scientific and technological establishment, having its
+! principal place of business at Domaine de Voluceau, Rocquencourt, BP
+! 105, 78153 Le Chesnay cedex, France.
+!
+! Preamble
+!
+! The purpose of this Free Software license agreement is to grant users
+! the right to modify and redistribute the software governed by this
+! license within the framework of an open source distribution model.
+!
+! The exercising of these rights is conditional upon certain obligations
+! for users so as to preserve this status for all subsequent redistributions.
+!
+! In consideration of access to the source code and the rights to copy,
+! modify and redistribute granted by the license, users are provided only
+! with a limited warranty and the software's author, the holder of the
+! economic rights, and the successive licensors only have limited liability.
+!
+! In this respect, the risks associated with loading, using, modifying
+! and/or developing or reproducing the software by the user are brought to
+! the user's attention, given its Free Software status, which may make it
+! complicated to use, with the result that its use is reserved for
+! developers and experienced professionals having in-depth computer
+! knowledge. Users are therefore encouraged to load and test the
+! suitability of the software as regards their requirements in conditions
+! enabling the security of their systems and/or data to be ensured and,
+! more generally, to use and operate it in the same conditions of
+! security. This Agreement may be freely reproduced and published,
+! provided it is not altered, and that no provisions are either added or
+! removed herefrom.
+!
+! This Agreement may apply to any or all software for which the holder of
+! the economic rights decides to submit the use thereof to its provisions.
+!
+! Article 1 - DEFINITIONS
+!
+! For the purpose of this Agreement, when the following expressions
+! commence with a capital letter, they shall have the following meaning:
+!
+! Agreement: means this license agreement, and its possible subsequent
+! versions and annexes.
+!
+! Software: means the software in its Object Code and/or Source Code form
+! and, where applicable, its documentation, "as is" when the Licensee
+! accepts the Agreement.
+!
+! Initial Software: means the Software in its Source Code and possibly its
+! Object Code form and, where applicable, its documentation, "as is" when
+! it is first distributed under the terms and conditions of the Agreement.
+!
+! Modified Software: means the Software modified by at least one
+! Contribution.
+!
+! Source Code: means all the Software's instructions and program lines to
+! which access is required so as to modify the Software.
+!
+! Object Code: means the binary files originating from the compilation of
+! the Source Code.
+!
+! Holder: means the holder(s) of the economic rights over the Initial
+! Software.
+!
+! Licensee: means the Software user(s) having accepted the Agreement.
+!
+! Contributor: means a Licensee having made at least one Contribution.
+!
+! Licensor: means the Holder, or any other individual or legal entity, who
+! distributes the Software under the Agreement.
+!
+! Contribution: means any or all modifications, corrections, translations,
+! adaptations and/or new functions integrated into the Software by any or
+! all Contributors, as well as any or all Internal Modules.
+!
+! Module: means a set of sources files including their documentation that
+! enables supplementary functions or services in addition to those offered
+! by the Software.
+!
+! External Module: means any or all Modules, not derived from the
+! Software, so that this Module and the Software run in separate address
+! spaces, with one calling the other when they are run.
+!
+! Internal Module: means any or all Module, connected to the Software so
+! that they both execute in the same address space.
+!
+! GNU GPL: means the GNU General Public License version 2 or any
+! subsequent version, as published by the Free Software Foundation Inc.
+!
+! Parties: mean both the Licensee and the Licensor.
+!
+! These expressions may be used both in singular and plural form.
+!
+! Article 2 - PURPOSE
+!
+! The purpose of the Agreement is the grant by the Licensor to the
+! Licensee of a non-exclusive, transferable and worldwide license for the
+! Software as set forth in Article 5 hereinafter for the whole term of the
+! protection granted by the rights over said Software.
+!
+! Article 3 - ACCEPTANCE
+!
+! 3.1 The Licensee shall be deemed as having accepted the terms and
+! conditions of this Agreement upon the occurrence of the first of the
+! following events:
+!
+! * (i) loading the Software by any or all means, notably, by
+! downloading from a remote server, or by loading from a physical
+! medium;
+! * (ii) the first time the Licensee exercises any of the rights
+! granted hereunder.
+!
+! 3.2 One copy of the Agreement, containing a notice relating to the
+! characteristics of the Software, to the limited warranty, and to the
+! fact that its use is restricted to experienced users has been provided
+! to the Licensee prior to its acceptance as set forth in Article 3.1
+! hereinabove, and the Licensee hereby acknowledges that it has read and
+! understood it.
+!
+! Article 4 - EFFECTIVE DATE AND TERM
+!
+! 4.1 EFFECTIVE DATE
+!
+! The Agreement shall become effective on the date when it is accepted by
+! the Licensee as set forth in Article 3.1.
+!
+! 4.2 TERM
+!
+! The Agreement shall remain in force for the entire legal term of
+! protection of the economic rights over the Software.
+!
+! Article 5 - SCOPE OF RIGHTS GRANTED
+!
+! The Licensor hereby grants to the Licensee, who accepts, the following
+! rights over the Software for any or all use, and for the term of the
+! Agreement, on the basis of the terms and conditions set forth hereinafter.
+!
+! Besides, if the Licensor owns or comes to own one or more patents
+! protecting all or part of the functions of the Software or of its
+! components, the Licensor undertakes not to enforce the rights granted by
+! these patents against successive Licensees using, exploiting or
+! modifying the Software. If these patents are transferred, the Licensor
+! undertakes to have the transferees subscribe to the obligations set
+! forth in this paragraph.
+!
+! 5.1 RIGHT OF USE
+!
+! The Licensee is authorized to use the Software, without any limitation
+! as to its fields of application, with it being hereinafter specified
+! that this comprises:
+!
+! 1. permanent or temporary reproduction of all or part of the Software
+! by any or all means and in any or all form.
+!
+! 2. loading, displaying, running, or storing the Software on any or
+! all medium.
+!
+! 3. entitlement to observe, study or test its operation so as to
+! determine the ideas and principles behind any or all constituent
+! elements of said Software. This shall apply when the Licensee
+! carries out any or all loading, displaying, running, transmission
+! or storage operation as regards the Software, that it is entitled
+! to carry out hereunder.
+!
+! 5.2 ENTITLEMENT TO MAKE CONTRIBUTIONS
+!
+! The right to make Contributions includes the right to translate, adapt,
+! arrange, or make any or all modifications to the Software, and the right
+! to reproduce the resulting software.
+!
+! The Licensee is authorized to make any or all Contributions to the
+! Software provided that it includes an explicit notice that it is the
+! author of said Contribution and indicates the date of the creation thereof.
+!
+! 5.3 RIGHT OF DISTRIBUTION
+!
+! In particular, the right of distribution includes the right to publish,
+! transmit and communicate the Software to the general public on any or
+! all medium, and by any or all means, and the right to market, either in
+! consideration of a fee, or free of charge, one or more copies of the
+! Software by any means.
+!
+! The Licensee is further authorized to distribute copies of the modified
+! or unmodified Software to third parties according to the terms and
+! conditions set forth hereinafter.
+!
+! 5.3.1 DISTRIBUTION OF SOFTWARE WITHOUT MODIFICATION
+!
+! The Licensee is authorized to distribute true copies of the Software in
+! Source Code or Object Code form, provided that said distribution
+! complies with all the provisions of the Agreement and is accompanied by:
+!
+! 1. a copy of the Agreement,
+!
+! 2. a notice relating to the limitation of both the Licensor's
+! warranty and liability as set forth in Articles 8 and 9,
+!
+! and that, in the event that only the Object Code of the Software is
+! redistributed, the Licensee allows future Licensees unhindered access to
+! the full Source Code of the Software by indicating how to access it, it
+! being understood that the additional cost of acquiring the Source Code
+! shall not exceed the cost of transferring the data.
+!
+! 5.3.2 DISTRIBUTION OF MODIFIED SOFTWARE
+!
+! When the Licensee makes a Contribution to the Software, the terms and
+! conditions for the distribution of the resulting Modified Software
+! become subject to all the provisions of this Agreement.
+!
+! The Licensee is authorized to distribute the Modified Software, in
+! source code or object code form, provided that said distribution
+! complies with all the provisions of the Agreement and is accompanied by:
+!
+! 1. a copy of the Agreement,
+!
+! 2. a notice relating to the limitation of both the Licensor's
+! warranty and liability as set forth in Articles 8 and 9,
+!
+! and that, in the event that only the object code of the Modified
+! Software is redistributed, the Licensee allows future Licensees
+! unhindered access to the full source code of the Modified Software by
+! indicating how to access it, it being understood that the additional
+! cost of acquiring the source code shall not exceed the cost of
+! transferring the data.
+!
+! 5.3.3 DISTRIBUTION OF EXTERNAL MODULES
+!
+! When the Licensee has developed an External Module, the terms and
+! conditions of this Agreement do not apply to said External Module, that
+! may be distributed under a separate license agreement.
+!
+! 5.3.4 COMPATIBILITY WITH THE GNU GPL
+!
+! The Licensee can include a code that is subject to the provisions of one
+! of the versions of the GNU GPL in the Modified or unmodified Software,
+! and distribute that entire code under the terms of the same version of
+! the GNU GPL.
+!
+! The Licensee can include the Modified or unmodified Software in a code
+! that is subject to the provisions of one of the versions of the GNU GPL,
+! and distribute that entire code under the terms of the same version of
+! the GNU GPL.
+!
+! Article 6 - INTELLECTUAL PROPERTY
+!
+! 6.1 OVER THE INITIAL SOFTWARE
+!
+! The Holder owns the economic rights over the Initial Software. Any or
+! all use of the Initial Software is subject to compliance with the terms
+! and conditions under which the Holder has elected to distribute its work
+! and no one shall be entitled to modify the terms and conditions for the
+! distribution of said Initial Software.
+!
+! The Holder undertakes that the Initial Software will remain ruled at
+! least by this Agreement, for the duration set forth in Article 4.2.
+!
+! 6.2 OVER THE CONTRIBUTIONS
+!
+! The Licensee who develops a Contribution is the owner of the
+! intellectual property rights over this Contribution as defined by
+! applicable law.
+!
+! 6.3 OVER THE EXTERNAL MODULES
+!
+! The Licensee who develops an External Module is the owner of the
+! intellectual property rights over this External Module as defined by
+! applicable law and is free to choose the type of agreement that shall
+! govern its distribution.
+!
+! 6.4 JOINT PROVISIONS
+!
+! The Licensee expressly undertakes:
+!
+! 1. not to remove, or modify, in any manner, the intellectual property
+! notices attached to the Software;
+!
+! 2. to reproduce said notices, in an identical manner, in the copies
+! of the Software modified or not.
+!
+! The Licensee undertakes not to directly or indirectly infringe the
+! intellectual property rights of the Holder and/or Contributors on the
+! Software and to take, where applicable, vis-a-vis its staff, any and all
+! measures required to ensure respect of said intellectual property rights
+! of the Holder and/or Contributors.
+!
+! Article 7 - RELATED SERVICES
+!
+! 7.1 Under no circumstances shall the Agreement oblige the Licensor to
+! provide technical assistance or maintenance services for the Software.
+!
+! However, the Licensor is entitled to offer this type of services. The
+! terms and conditions of such technical assistance, and/or such
+! maintenance, shall be set forth in a separate instrument. Only the
+! Licensor offering said maintenance and/or technical assistance services
+! shall incur liability therefor.
+!
+! 7.2 Similarly, any Licensor is entitled to offer to its licensees, under
+! its sole responsibility, a warranty, that shall only be binding upon
+! itself, for the redistribution of the Software and/or the Modified
+! Software, under terms and conditions that it is free to decide. Said
+! warranty, and the financial terms and conditions of its application,
+! shall be subject of a separate instrument executed between the Licensor
+! and the Licensee.
+!
+! Article 8 - LIABILITY
+!
+! 8.1 Subject to the provisions of Article 8.2, the Licensee shall be
+! entitled to claim compensation for any direct loss it may have suffered
+! from the Software as a result of a fault on the part of the relevant
+! Licensor, subject to providing evidence thereof.
+!
+! 8.2 The Licensor's liability is limited to the commitments made under
+! this Agreement and shall not be incurred as a result of in particular:
+! (i) loss due the Licensee's total or partial failure to fulfill its
+! obligations, (ii) direct or consequential loss that is suffered by the
+! Licensee due to the use or performance of the Software, and (iii) more
+! generally, any consequential loss. In particular the Parties expressly
+! agree that any or all pecuniary or business loss (i.e. loss of data,
+! loss of profits, operating loss, loss of customers or orders,
+! opportunity cost, any disturbance to business activities) or any or all
+! legal proceedings instituted against the Licensee by a third party,
+! shall constitute consequential loss and shall not provide entitlement to
+! any or all compensation from the Licensor.
+!
+! Article 9 - WARRANTY
+!
+! 9.1 The Licensee acknowledges that the scientific and technical
+! state-of-the-art when the Software was distributed did not enable all
+! possible uses to be tested and verified, nor for the presence of
+! possible defects to be detected. In this respect, the Licensee's
+! attention has been drawn to the risks associated with loading, using,
+! modifying and/or developing and reproducing the Software which are
+! reserved for experienced users.
+!
+! The Licensee shall be responsible for verifying, by any or all means,
+! the suitability of the product for its requirements, its good working
+! order, and for ensuring that it shall not cause damage to either persons
+! or properties.
+!
+! 9.2 The Licensor hereby represents, in good faith, that it is entitled
+! to grant all the rights over the Software (including in particular the
+! rights set forth in Article 5).
+!
+! 9.3 The Licensee acknowledges that the Software is supplied "as is" by
+! the Licensor without any other express or tacit warranty, other than
+! that provided for in Article 9.2 and, in particular, without any warranty
+! as to its commercial value, its secured, safe, innovative or relevant
+! nature.
+!
+! Specifically, the Licensor does not warrant that the Software is free
+! from any error, that it will operate without interruption, that it will
+! be compatible with the Licensee's own equipment and software
+! configuration, nor that it will meet the Licensee's requirements.
+!
+! 9.4 The Licensor does not either expressly or tacitly warrant that the
+! Software does not infringe any third party intellectual property right
+! relating to a patent, software or any other property right. Therefore,
+! the Licensor disclaims any and all liability towards the Licensee
+! arising out of any or all proceedings for infringement that may be
+! instituted in respect of the use, modification and redistribution of the
+! Software. Nevertheless, should such proceedings be instituted against
+! the Licensee, the Licensor shall provide it with technical and legal
+! assistance for its defense. Such technical and legal assistance shall be
+! decided on a case-by-case basis between the relevant Licensor and the
+! Licensee pursuant to a memorandum of understanding. The Licensor
+! disclaims any and all liability as regards the Licensee's use of the
+! name of the Software. No warranty is given as regards the existence of
+! prior rights over the name of the Software or as regards the existence
+! of a trademark.
+!
+! Article 10 - TERMINATION
+!
+! 10.1 In the event of a breach by the Licensee of its obligations
+! hereunder, the Licensor may automatically terminate this Agreement
+! thirty (30) days after notice has been sent to the Licensee and has
+! remained ineffective.
+!
+! 10.2 A Licensee whose Agreement is terminated shall no longer be
+! authorized to use, modify or distribute the Software. However, any
+! licenses that it may have granted prior to termination of the Agreement
+! shall remain valid subject to their having been granted in compliance
+! with the terms and conditions hereof.
+!
+! Article 11 - MISCELLANEOUS
+!
+! 11.1 EXCUSABLE EVENTS
+!
+! Neither Party shall be liable for any or all delay, or failure to
+! perform the Agreement, that may be attributable to an event of force
+! majeure, an act of God or an outside cause, such as defective
+! functioning or interruptions of the electricity or telecommunications
+! networks, network paralysis following a virus attack, intervention by
+! government authorities, natural disasters, water damage, earthquakes,
+! fire, explosions, strikes and labor unrest, war, etc.
+!
+! 11.2 Any failure by either Party, on one or more occasions, to invoke
+! one or more of the provisions hereof, shall under no circumstances be
+! interpreted as being a waiver by the interested Party of its right to
+! invoke said provision(s) subsequently.
+!
+! 11.3 The Agreement cancels and replaces any or all previous agreements,
+! whether written or oral, between the Parties and having the same
+! purpose, and constitutes the entirety of the agreement between said
+! Parties concerning said purpose. No supplement or modification to the
+! terms and conditions hereof shall be effective as between the Parties
+! unless it is made in writing and signed by their duly authorized
+! representatives.
+!
+! 11.4 In the event that one or more of the provisions hereof were to
+! conflict with a current or future applicable act or legislative text,
+! said act or legislative text shall prevail, and the Parties shall make
+! the necessary amendments so as to comply with said act or legislative
+! text. All other provisions shall remain effective. Similarly, invalidity
+! of a provision of the Agreement, for any reason whatsoever, shall not
+! cause the Agreement as a whole to be invalid.
+!
+! 11.5 LANGUAGE
+!
+! The Agreement is drafted in both French and English and both versions
+! are deemed authentic.
+!
+! Article 12 - NEW VERSIONS OF THE AGREEMENT
+!
+! 12.1 Any person is authorized to duplicate and distribute copies of this
+! Agreement.
+!
+! 12.2 So as to ensure coherence, the wording of this Agreement is
+! protected and may only be modified by the authors of the License, who
+! reserve the right to periodically publish updates or new versions of the
+! Agreement, each with a separate number. These subsequent versions may
+! address new issues encountered by Free Software.
+!
+! 12.3 Any Software distributed under a given version of the Agreement may
+! only be subsequently distributed under the same version of the Agreement
+! or a subsequent version, subject to the provisions of Article 5.3.4.
+!
+! Article 13 - GOVERNING LAW AND JURISDICTION
+!
+! 13.1 The Agreement is governed by French law. The Parties agree to
+! endeavor to seek an amicable solution to any disagreements or disputes
+! that may arise during the performance of the Agreement.
+!
+! 13.2 Failing an amicable solution within two (2) months as from their
+! occurrence, and unless emergency proceedings are necessary, the
+! disagreements or disputes shall be referred to the Paris Courts having
+! jurisdiction, by the more diligent Party.
+!
+! Version 2.0 dated 2006-09-05.
+!
Added: seismo/3D/CPML/tags/v1.1.1/seismic_CPML_2D_poroelastic_fourth_order.f90
===================================================================
--- seismo/3D/CPML/tags/v1.1.1/seismic_CPML_2D_poroelastic_fourth_order.f90 (rev 0)
+++ seismo/3D/CPML/tags/v1.1.1/seismic_CPML_2D_poroelastic_fourth_order.f90 2009-11-03 21:35:50 UTC (rev 15926)
@@ -0,0 +1,1739 @@
+!
+! SEISMIC_CPML Version 1.1.1, November 2009.
+!
+! Copyright Universite de Pau et des Pays de l'Adour, CNRS and INRIA, France.
+! Contributors: Roland Martin, roland DOT martin aT univ-pau DOT fr
+! and Dimitri Komatitsch, dimitri DOT komatitsch aT univ-pau DOT fr
+!
+! This software is a computer program whose purpose is to solve
+! the poroelastic elastic wave equation
+! using a finite-difference method with Convolutional Perfectly Matched
+! Layer (C-PML) conditions and Biot model with and without viscous dissipation.
+!
+! This software is governed by the CeCILL license under French law and
+! abiding by the rules of distribution of free software. You can use,
+! modify and/or redistribute the software under the terms of the CeCILL
+! license as circulated by CEA, CNRS and INRIA at the following URL
+! "http://www.cecill.info".
+!
+! As a counterpart to the access to the source code and rights to copy,
+! modify and redistribute granted by the license, users are provided only
+! with a limited warranty and the software's author, the holder of the
+! economic rights, and the successive licensors have only limited
+! liability.
+!
+! In this respect, the user's attention is drawn to the risks associated
+! with loading, using, modifying and/or developing or reproducing the
+! software by the user in light of its specific status of free software,
+! that may mean that it is complicated to manipulate, and that also
+! therefore means that it is reserved for developers and experienced
+! professionals having in-depth computer knowledge. Users are therefore
+! encouraged to load and test the software's suitability as regards their
+! requirements in conditions enabling the security of their systems and/or
+! data to be ensured and, more generally, to use and operate it in the
+! same conditions as regards security.
+!
+! The full text of the license is available at the end of this program
+! and in file "LICENSE".
+ program seismic_CPML_2D_poroelastic_fourth
+
+! 2D poroelastic finite-difference code in velocity and stress formulation
+! with Convolution-PML (C-PML) absorbing conditions
+! with and without viscous dissipation
+
+! Roland Martin, University of Pau, France, October 2009.
+! based on the elastic code of Komatitsch and Martin, 2007.
+
+! The fourth-order staggered-grid formulation of Madariaga (1976) and Virieux (1986) is used:
+!
+! ^ y
+! |
+! |
+!
+! +-------------------+
+! | |
+! | |
+! | |
+! | |
+! | v_y |
+! sigma_xy +---------+ |
+! | | |
+! | | |
+! | | |
+! | | |
+! | | |
+! +---------+---------+ ---> x
+! v_x sigma_xx
+! sigma_yy
+!
+
+! The C-PML implementation is based in part on formulas given in Roden and Gedney (2000).
+! If you use this code for your own research, please cite some (or all) of these
+! articles:
+!
+! @ARTICLE{MaKoEz08,
+! author = {Roland Martin and Dimitri Komatitsch and Abdela\^aziz Ezziani},
+! title = {An unsplit convolutional perfectly matched layer improved at grazing
+! incidence for seismic wave equation in poroelastic media},
+! journal = {Geophysics},
+! year = {2008},
+! volume = {73},
+! pages = {T51-T61},
+! number = {4},
+! doi = {10.1190/1.2939484}}
+!
+! @ARTICLE{KoMa07,
+! author = {Dimitri Komatitsch and Roland Martin},
+! title = {An unsplit convolutional {P}erfectly {M}atched {L}ayer improved
+! at grazing incidence for the seismic wave equation},
+! journal = {Geophysics},
+! year = {2007},
+! volume = {72},
+! number = {5},
+! pages = {SM155-SM167},
+! doi = {10.1190/1.2757586}}
+!
+! @ARTICLE{MaKo09,
+! author = {Roland Martin and Dimitri Komatitsch},
+! title = {An unsplit convolutional perfectly matched layer technique improved
+! at grazing incidence for the viscoelastic wave equation},
+! journal = {Geophysical Journal International},
+! year = {2009},
+! volume = {179},
+! pages = {333-344},
+! number = {1},
+! doi = {10.1111/j.1365-246X.2009.04278.x}}
+!
+! @ARTICLE{MaKoGe08,
+! author = {Roland Martin and Dimitri Komatitsch and Stephen D. Gedney},
+! title = {A variational formulation of a stabilized unsplit convolutional perfectly
+! matched layer for the isotropic or anisotropic seismic wave equation},
+! journal = {Computer Modeling in Engineering and Sciences},
+! year = {2008},
+! volume = {37},
+! pages = {274-304},
+! number = {3}}
+!
+! The original CPML technique for Maxwell's equations is described in:
+!
+! @ARTICLE{RoGe00,
+! author = {J. A. Roden and S. D. Gedney},
+! title = {Convolution {PML} ({CPML}): {A}n Efficient {FDTD} Implementation
+! of the {CFS}-{PML} for Arbitrary Media},
+! journal = {Microwave and Optical Technology Letters},
+! year = {2000},
+! volume = {27},
+! number = {5},
+! pages = {334-339},
+! doi = {10.1002/1098-2760(20001205)27:5<334::AID-MOP14>3.0.CO;2-A}}
+
+! To display the results as color images in the selected 2D cut plane, use:
+!
+! " display image*.gif " or " gimp image*.gif "
+!
+! or
+!
+! " montage -geometry +0+3 -rotate 90 -tile 1x21 image*Vx*.gif allfiles_Vx.gif
+! "
+! " montage -geometry +0+3 -rotate 90 -tile 1x21 image*Vy*.gif allfiles_Vy.gif
+! "
+! then " display allfiles_Vx.gif " or " gimp allfiles_Vx.gif "
+! then " display allfiles_Vy.gif " or " gimp allfiles_Vy.gif "
+
+! To display the 2D results as PostScript vector plots with small arrows, use:
+!
+! " gs vect*.ps "
+!
+
+ implicit none
+
+! total number of grid points in each direction of the grid
+ integer, parameter :: NX = 140
+ integer, parameter :: NY = 620
+
+! size of a grid cell
+ double precision, parameter :: DELTAX = 0.5D0
+ double precision, parameter :: DELTAY = DELTAX
+
+! flags to add PML layers to the edges of the grid
+ logical, parameter :: USE_PML_LEFT = .true.
+ logical, parameter :: USE_PML_RIGHT = .true.
+ logical, parameter :: USE_PML_BOTTOM = .true.
+ logical, parameter :: USE_PML_TOP = .true.
+
+! thickness of the PML layer in grid points
+ integer, parameter :: NPOINTS_PML = 10
+
+! heterogeneous model and height of the interface
+ logical, parameter :: HETEROGENEOUS_MODEL = .true.
+ double precision, parameter :: INTERFACE_HEIGHT =105.D0+NPOINTS_PML*DELTAY
+ integer, parameter:: JINTERFACE=INT(INTERFACE_HEIGHT/DELTAY)+1
+ double precision :: co,c1,c2,vtemp
+
+! model mud saturated with water, see article by Martin and Komatitsch
+ double precision, parameter :: etaokappa_bottom=0.d0
+ double precision, parameter :: rmu_bottom = 5.25D09
+ double precision, parameter :: phi_bottom =0.25d0
+ double precision, parameter :: a_bottom = 2.49d0
+ double precision, parameter :: rhos_bottom = 2588.d0
+ double precision, parameter :: rhof_bottom = 952.4d0
+ double precision, parameter :: rho_bottom =2179.1d0
+ double precision, parameter :: rsm_bottom =9486.d0
+ double precision, parameter :: alpha_bottom=0.89d0
+ double precision, parameter :: rbM_bottom =7.71d09
+ double precision, parameter :: rlambdao_bottom = 6.2D08
+ double precision, parameter :: rlambdac_bottom =rlambdao_bottom+alpha_bottom**2*rbM_bottom
+ double precision, parameter :: ro11_b=rho_bottom+phi_bottom*rhof_bottom*(a_bottom-2.d0)
+ double precision, parameter :: ro12_b=phi_bottom*rhof_bottom*(1.d0-a_bottom)
+ double precision, parameter :: ro22_b=a_bottom*phi_bottom*rhof_bottom
+ double precision, parameter :: lambda_b=rlambdao_bottom+rbM_bottom*(alpha_bottom-phi_bottom)**2
+ double precision, parameter :: R_b=rbM_bottom*phi_bottom**2
+ double precision, parameter :: ga_b=rbM_bottom*phi_bottom*(alpha_bottom-phi_bottom)
+ double precision, parameter :: S_b=lambda_b+2*rmu_bottom
+ double precision, parameter :: c1_b=S_b*R_b-ga_b**2
+ double precision, parameter :: b1_b=-S_b*ro22_b-R_b*ro11_b+2*ga_b*ro12_b
+ double precision, parameter :: a1_b=ro11_b*ro22_b-ro12_b**2
+ double precision, parameter :: delta_b=b1_b**2-4.d0*a1_b*c1_b
+
+ double precision:: cp_bottom
+ double precision:: cps_bottom
+ double precision:: cs_bottom
+
+ double precision, parameter :: etaokappa_top=3.33D06
+ double precision, parameter :: rmu_top = 2.4D09
+ double precision, parameter :: phi_top =0.1d0
+ double precision, parameter :: a_top = 2.42d0
+ double precision, parameter :: rhos_top = 2250.d0
+ double precision, parameter :: rhof_top = 1040.d0
+ double precision, parameter :: rho_top = 2129.d0
+ double precision, parameter :: rsm_top =25168.d0
+ double precision, parameter :: alpha_top=0.58d0
+ double precision, parameter :: rbM_top = 7.34d09
+ double precision, parameter :: rlambdao_top =6.D08
+ double precision, parameter :: rlambdac_top =rlambdao_top+alpha_top**2*rbM_top
+ double precision, parameter :: ro11_t=rho_top+phi_top*rhof_top*(a_top-2.d0)
+ double precision, parameter :: ro12_t=phi_top*rhof_top*(1.d0-a_top)
+ double precision, parameter :: ro22_t=a_top*phi_top*rhof_top
+ double precision, parameter :: lambda_t=rlambdao_top+rbM_top*(alpha_top-phi_top)**2
+ double precision, parameter :: R_t=rbM_top*phi_top**2
+ double precision, parameter :: ga_t=rbM_top*phi_top*(alpha_top-phi_top)
+ double precision, parameter :: S_t=lambda_t+2*rmu_top
+ double precision, parameter :: c1_t=S_t*R_t-ga_t**2
+ double precision, parameter :: b1_t=-S_t*ro22_t-R_t*ro11_t+2*ga_t*ro12_t
+ double precision, parameter :: a1_t=ro11_t*ro22_t-ro12_t**2
+ double precision, parameter :: delta_t=b1_t**2-4.d0*a1_t*c1_t
+
+ double precision:: cp_top
+ double precision:: cps_top
+ double precision:: cs_top
+
+! total number of time steps
+ integer, parameter :: NSTEP = 100000
+
+! time step in seconds
+ double precision, parameter :: DELTAT = 1.d-04
+
+! parameters for the source
+ double precision, parameter :: f0 = 80.d0
+ double precision, parameter :: t0 = 1.d0/f0
+ double precision, parameter :: factor =1.d02
+
+! source
+ integer, parameter :: ISOURCE = NX/2+1
+ integer, parameter :: JSOURCE = NY/2 +1
+ integer, parameter :: IDEB = NX / 2 + 1
+ integer, parameter :: JDEB = NY / 2 + 1
+ double precision, parameter :: xsource = DELTAX * ISOURCE
+ double precision, parameter :: ysource = DELTAY * JSOURCE
+! angle of source force clockwise with respect to vertical (Y) axis
+ double precision, parameter :: ANGLE_FORCE = 0.d0
+
+! receivers
+ integer, parameter :: NREC = 2
+ double precision, parameter :: ydeb = NPOINTS_PML*DELTAY+10.D0 ! first receiver x in meters
+ double precision, parameter :: yfin = NY*DELTAY-NPOINTS_PML*DELTAY-10.d0 ! first receiver x in meters
+ double precision, parameter :: xdeb =xsource ! first receiver y in meters
+ double precision, parameter :: xfin =xdeb ! first receiver y in meters
+
+! display information on the screen from time to time
+ integer, parameter :: IT_DISPLAY = 200
+
+! value of PI
+ double precision, parameter :: PI = 3.141592653589793238462643d0
+
+! conversion from degrees to radians
+ double precision, parameter :: DEGREES_TO_RADIANS = PI / 180.d0
+
+! zero
+ double precision, parameter :: ZERO = 0.d0
+
+! large value for maximum
+ double precision, parameter :: HUGEVAL = 1.d+30
+
+! velocity threshold above which we consider that the code became unstable
+ double precision, parameter :: STABILITY_THRESHOLD = 1.d+25
+
+! main arrays
+ double precision, dimension(0:NX+1,0:NY+1) :: vx,vy,sigmaxx,sigma2,alp_sigma2,sigmayy,sigmaxy,vnorm
+ double precision, dimension(0:NX+1,0:NY+1) :: vxf,vyf
+ double precision, dimension(0:NX+1,0:NY+1) :: rho,rhof,rsm,rmu,rlambdac,rbM,alpha,etaokappa,rlambdao
+
+! to interpolate material parameters at the right location in the staggered grid cell
+ double precision rho_half_x_half_y,rhof_half_x_half_y,rsm_half_x_half_y,etaokappa_half_x_half_y
+
+! for evolution of total energy in the medium
+ double precision epsilon_xx,epsilon_yy,epsilon_xy
+ double precision, dimension(NSTEP) :: total_energy_kinetic,total_energy_potential
+ double precision c33_half_y
+
+! power to compute d0 profile
+ double precision, parameter :: NPOWER = 2.d0
+
+! double precision, parameter :: K_MAX_PML = 7.d0 ! from Gedney page 8.11
+ double precision, parameter :: K_MAX_PML = 1.d0 ! from Gedney page 8.11
+! double precision, parameter :: ALPHA_MAX_PML = 0.05d0 ! from Gedney page 8.22
+ double precision, parameter :: ALPHA_MAX_PML = 2.d0*PI*(f0/2.d0) ! from festa and Vilotte
+
+! 2D arrays for the memory variables
+ double precision, dimension(0:NX+1,0:NY+1) :: gamma11,gamma22
+ double precision, dimension(0:NX+1,0:NY+1) :: gamma12_1
+ double precision, dimension(0:NX+1,0:NY+1) :: xi_1,xi_2
+
+ double precision, dimension(0:NX+1,0:NY+1) :: &
+ memory_dx_vx1,memory_dx_vx2,memory_dy_vx,memory_dx_vy,memory_dy_vy1,memory_dy_vy2,&
+ memory_dx_sigmaxx,memory_dx_sigmayy,memory_dx_sigmaxy,&
+ memory_dx_sigma2vx,memory_dx_sigma2vxf,memory_dy_sigma2vy,memory_dy_sigma2vyf, &
+ memory_dy_sigmaxx,memory_dy_sigmayy,memory_dy_sigmaxy
+
+! 1D arrays for the damping profiles
+ double precision, dimension(NX) :: d_x,K_x,alpha_prime_x,a_x,b_x,d_x_half_x,K_x_half_x,alpha_prime_x_half_x,a_x_half_x,b_x_half_x
+ double precision, dimension(NY) :: d_y,K_y,alpha_prime_y,a_y,b_y,d_y_half_y,K_y_half_y,alpha_prime_y_half_y,a_y_half_y,b_y_half_y
+
+ double precision thickness_PML_x,thickness_PML_y,xoriginleft,xoriginright,yoriginbottom,yorigintop
+ double precision Rcoef,d0_x,d0_y,xval,yval,abscissa_in_PML,abscissa_normalized
+ double precision value_dx_vx1,value_dx_vx2,value_dx_vy,value_dx_sigmaxx,value_dx_sigmaxy
+ double precision value_dy_vy1,value_dy_vy2,value_dy_vx,value_dy_sigmaxx,value_dy_sigmaxy
+ double precision value_dx_sigma2vxf,value_dy_sigma2vyf
+
+! for the source
+ double precision a,t,source_term
+
+! for receivers
+ double precision xspacerec,yspacerec,distval,dist
+ integer, dimension(NREC) :: ix_rec,iy_rec
+ double precision, dimension(NREC) :: xrec,yrec
+
+! for seismograms
+ double precision, dimension(NSTEP,NREC) :: sisvx,sisvy,sisp
+
+ integer i,j,it,irec
+
+ double precision Courant_number_bottom,Courant_number_top,velocnorm_all,max_amplitude
+ double precision Dispersion_number_bottom,Dispersion_number_top
+
+!---
+!--- program starts here
+!---
+ cp_bottom=(-b1_b+sqrt(delta_b))/(2.d0*a1_b);
+ cps_bottom=(-b1_b-sqrt(delta_b))/(2.d0*a1_b);
+ cp_bottom=sqrt(cp_bottom)
+ cps_bottom=sqrt(cps_bottom)
+ cs_bottom=sqrt(rmu_bottom/(ro11_b-ro12_b**2/ro22_b))
+
+ cp_top=(-b1_t+sqrt(delta_t))/(2.d0*a1_t);
+ cps_top=(-b1_t-sqrt(delta_t))/(2.d0*a1_t);
+ cp_top=sqrt(cp_top)
+ cps_top=sqrt(cps_top)
+ cs_top=sqrt(rmu_top/(ro11_t-ro12_t**2/ro22_t))
+
+ print *,'cp_bottom= ',cp_bottom
+ print *,'cps_bottom=',cps_bottom
+ print *,'cs_bottom= ',cs_bottom
+ print *,'cp_top= ',cp_top
+ print *,'cps_top=',cps_top
+ print *,'cs_top= ',cs_top
+
+ print *,'rho_bottom= ',rho_bottom
+ print *,'rsm_bottom= ',rsm_bottom
+ print *,'rho_top= ',rho_top
+ print *,'rsm_top= ',rsm_top
+ print *,'rmu_bottom= ',rmu_bottom
+ print *,'rlambdac_bottom= ',rlambdac_bottom
+ print *,'rlambdao_bottom= ',rlambdao_bottom
+ print *,'alpha_bottom= ',alpha_bottom
+ print *,'rbM_bottom= ',rbM_bottom
+ print *,'etaokappa_bottom= ',etaokappa_bottom
+ print *,'rmu_top= ',rmu_top
+ print *,'rlambdac_top= ',rlambdac_top
+ print *,'rlambdao_top= ',rlambdao_top
+ print *,'alpha_top= ',alpha_top
+ print *,'rbM_top= ',rbM_top
+ print *,'etaokappa_top= ',etaokappa_top
+
+ print *, 'DELTAT CPML=', DELTAT
+ print *,'2D poroelastic finite-difference code in velocity and stress formulation with C-PML'
+ print *
+
+! display size of the model
+ print *
+ print *,'NX = ',NX
+ print *,'NY = ',NY
+ print *
+ print *,'size of the model along X = ',(NX - 1) * DELTAX
+ print *,'size of the model along Y = ',(NY - 1) * DELTAY
+ print *
+ print *,'Total number of grid points = ',NX * NY
+ print *
+
+!--- define profile of absorption in PML region
+
+! thickness of the PML layer in meters
+ thickness_PML_x = NPOINTS_PML * DELTAX
+ thickness_PML_y = NPOINTS_PML * DELTAY
+
+! reflection coefficient (INRIA report section 6.1)
+ Rcoef = 0.001d0
+
+! check that NPOWER is okay
+ if(NPOWER < 1) stop 'NPOWER must be greater than 1'
+
+! compute d0 from INRIA report section 6.1
+ if(HETEROGENEOUS_MODEL) then
+ d0_x = - (NPOWER + 1) * max(cp_bottom,cp_top) * log(Rcoef) / (2.d0 * thickness_PML_x)
+ d0_y = - (NPOWER + 1) * max(cp_bottom,cp_top) * log(Rcoef) / (2.d0 * thickness_PML_y)
+ else
+ d0_x = - (NPOWER + 1) * cp_bottom * log(Rcoef) / (2.d0 * thickness_PML_x)
+ d0_y = - (NPOWER + 1) * cp_bottom * log(Rcoef) / (2.d0 * thickness_PML_y)
+ endif
+
+ print *,'d0_x = ',d0_x
+ print *,'d0_y = ',d0_y
+
+ d_x(:) = ZERO
+ d_x_half_x(:) = ZERO
+
+ d_y(:) = ZERO
+ d_y_half_y(:) = ZERO
+
+ K_x(:) = 1.d0
+ K_x_half_x(:) = 1.d0
+
+ K_y(:) = 1.d0
+ K_y_half_y(:) = 1.d0
+
+ alpha_prime_x(:) = ZERO
+ alpha_prime_x_half_x(:) = ZERO
+
+ alpha_prime_y(:) = ZERO
+ alpha_prime_y_half_y(:) = ZERO
+
+ a_x(:) = ZERO
+ a_x_half_x(:) = ZERO
+
+ a_y(:) = ZERO
+ a_y_half_y(:) = ZERO
+
+! origin of the PML layer (position of right edge minus thickness, in meters)
+ xoriginleft = thickness_PML_x
+ xoriginright = (NX-1)*DELTAX - thickness_PML_x
+
+ do i = 1,NX
+
+! abscissa of current grid point along the damping profile
+ xval = DELTAX * dble(i-1)
+
+!!!! ---------- left edge
+ if(USE_PML_LEFT) then
+
+! define damping profile at the grid points
+ abscissa_in_PML = xoriginleft - xval
+ if(abscissa_in_PML >= ZERO) then
+ abscissa_normalized = abscissa_in_PML / thickness_PML_x
+ d_x(i) = d0_x * abscissa_normalized**NPOWER
+! this taken from Gedney page 8.2
+ K_x(i) = 1.d0 + (K_MAX_PML - 1.d0) * abscissa_normalized**NPOWER
+ alpha_prime_x(i) = ALPHA_MAX_PML * (1.d0 - abscissa_normalized)
+ endif
+
+! define damping profile at half the grid points
+ abscissa_in_PML = xoriginleft - (xval + DELTAX/2.d0)
+ if(abscissa_in_PML >= ZERO) then
+ abscissa_normalized = abscissa_in_PML / thickness_PML_x
+ d_x_half_x(i) = d0_x * abscissa_normalized**NPOWER
+! this taken from Gedney page 8.2
+ K_x_half_x(i) = 1.d0 + (K_MAX_PML - 1.d0) * abscissa_normalized**NPOWER
+ alpha_prime_x_half_x(i) = ALPHA_MAX_PML * (1.d0 - abscissa_normalized)
+ endif
+
+ endif
+
+!!!! ---------- right edge
+ if(USE_PML_RIGHT) then
+
+! define damping profile at the grid points
+ abscissa_in_PML = xval - xoriginright
+ if(abscissa_in_PML >= ZERO) then
+ abscissa_normalized = abscissa_in_PML / thickness_PML_x
+ d_x(i) = d0_x * abscissa_normalized**NPOWER
+! this taken from Gedney page 8.2
+ K_x(i) = 1.d0 + (K_MAX_PML - 1.d0) * abscissa_normalized**NPOWER
+ alpha_prime_x(i) = ALPHA_MAX_PML * (1.d0 - abscissa_normalized)
+ endif
+
+! define damping profile at half the grid points
+ abscissa_in_PML = xval + DELTAX/2.d0 - xoriginright
+ if(abscissa_in_PML >= ZERO) then
+ abscissa_normalized = abscissa_in_PML / thickness_PML_x
+ d_x_half_x(i) = d0_x * abscissa_normalized**NPOWER
+! this taken from Gedney page 8.2
+ K_x_half_x(i) = 1.d0 + (K_MAX_PML - 1.d0) * abscissa_normalized**NPOWER
+ alpha_prime_x_half_x(i) = ALPHA_MAX_PML * (1.d0 - abscissa_normalized)
+ endif
+
+ endif
+
+! just in case, for -5 at the end
+ if(alpha_prime_x(i) < ZERO) alpha_prime_x(i) = ZERO
+ if(alpha_prime_x_half_x(i) < ZERO) alpha_prime_x_half_x(i) = ZERO
+
+ b_x(i) = exp(- (d_x(i) / K_x(i) + alpha_prime_x(i)) * DELTAT)
+ b_x_half_x(i) = exp(- (d_x_half_x(i) / K_x_half_x(i) + alpha_prime_x_half_x(i)) * DELTAT)
+
+! this to avoid division by zero outside the PML
+ if(abs(d_x(i)) > 1.d-6) a_x(i) = d_x(i) * (b_x(i) - 1.d0) /&
+ (K_x(i) * (d_x(i) + K_x(i) * alpha_prime_x(i)))
+ if(abs(d_x_half_x(i)) > 1.d-6) a_x_half_x(i) = d_x_half_x(i)&
+ * (b_x_half_x(i) - 1.d0) / (K_x_half_x(i) * (d_x_half_x(i) + K_x_half_x(i) * alpha_prime_x_half_x(i)))
+
+ enddo
+
+!!!!!!!!!!!!! added Y damping profile
+
+! origin of the PML layer (position of right edge minus thickness, in meters)
+ yoriginbottom = thickness_PML_y
+ yorigintop = NY*DELTAY - thickness_PML_y
+
+ do j = 1,NY
+
+! abscissa of current grid point along the damping profile
+ yval = DELTAY * dble(j-1)
+
+!!!! ---------- bottom edge
+ if(USE_PML_BOTTOM) then
+
+! define damping profile at the grid points
+ abscissa_in_PML = yoriginbottom - yval
+ if(abscissa_in_PML >= ZERO) then
+ abscissa_normalized = abscissa_in_PML / thickness_PML_y
+ d_y(j) = d0_y * abscissa_normalized**NPOWER
+! this taken from Gedney page 8.2
+ K_y(j) = 1.d0 + (K_MAX_PML - 1.d0) * abscissa_normalized**NPOWER
+ alpha_prime_y(j) = ALPHA_MAX_PML * (1.d0 - abscissa_normalized)
+ endif
+
+! define damping profile at half the grid points
+ abscissa_in_PML = yoriginbottom - (yval + DELTAY/2.d0)
+ if(abscissa_in_PML >= ZERO) then
+ abscissa_normalized = abscissa_in_PML / thickness_PML_y
+ d_y_half_y(j) = d0_y * abscissa_normalized**NPOWER
+! this taken from Gedney page 8.2
+ K_y_half_y(j) = 1.d0 + (K_MAX_PML - 1.d0) * abscissa_normalized**NPOWER
+ alpha_prime_y_half_y(j) = ALPHA_MAX_PML * (1.d0 - abscissa_normalized)
+ endif
+
+ endif
+
+!!!! ---------- top edge
+ if(USE_PML_TOP) then
+
+! define damping profile at the grid points
+ abscissa_in_PML = yval - yorigintop
+ if(abscissa_in_PML >= ZERO) then
+ abscissa_normalized = abscissa_in_PML / thickness_PML_y
+ d_y(j) = d0_y * abscissa_normalized**NPOWER
+! this taken from Gedney page 8.2
+ K_y(j) = 1.d0 + (K_MAX_PML - 1.d0) * abscissa_normalized**NPOWER
+ alpha_prime_y(j) = ALPHA_MAX_PML * (1.d0 - abscissa_normalized)
+ endif
+
+! define damping profile at half the grid points
+ abscissa_in_PML = yval + DELTAY/2.d0 - yorigintop
+ if(abscissa_in_PML >= ZERO) then
+ abscissa_normalized = abscissa_in_PML / thickness_PML_y
+ d_y_half_y(j) = d0_y * abscissa_normalized**NPOWER
+! this taken from Gedney page 8.2
+ K_y_half_y(j) = 1.d0 + (K_MAX_PML - 1.d0) * abscissa_normalized**NPOWER
+ alpha_prime_y_half_y(j) = ALPHA_MAX_PML * (1.d0 - abscissa_normalized)
+ endif
+
+ endif
+
+! just in case, for -5 at the end
+! if(alpha_prime_y(j) < ZERO) alpha_prime_y(j) = ZERO
+! if(alpha_prime_y_half_y(j) < ZERO) alpha_prime_y_half_y(j) = ZERO
+
+ b_y(j) = exp(- (d_y(j) / K_y(j) + alpha_prime_y(j)) * DELTAT)
+ b_y_half_y(j) = exp(- (d_y_half_y(j) / K_y_half_y(j) + alpha_prime_y_half_y(j)) * DELTAT)
+
+! this to avoid division by zero outside the PML
+ if(abs(d_y(j)) > 1.d-6) a_y(j) = d_y(j) * (b_y(j) - 1.d0) &
+ / (K_y(j) * (d_y(j) + K_y(j) * alpha_prime_y(j)))
+ if(abs(d_y_half_y(j)) > 1.d-6) a_y_half_y(j) = d_y_half_y(j)&
+ * (b_y_half_y(j) - 1.d0) / (K_y_half_y(j) * (d_y_half_y(j) + K_y_half_y(j) * alpha_prime_y_half_y(j)))
+
+ enddo
+
+! compute the Lame parameters and density
+ do j = 0,NY+1
+ do i = 0,NX+1
+ if(HETEROGENEOUS_MODEL .and. DELTAY*dble(j-1) > INTERFACE_HEIGHT) then
+ rho(i,j)= rho_top
+ rhof(i,j) = rhof_top
+ rsm(i,j) = rsm_top
+ rmu(i,j)= rmu_top
+ rlambdac(i,j) = rlambdac_top
+ rbM(i,j) = rbM_top
+ alpha(i,j)=alpha_top
+ etaokappa(i,j)=etaokappa_top
+ rlambdao(i,j) = rlambdao_top
+ else
+ rho(i,j)= rho_bottom
+ rhof(i,j) = rhof_bottom
+ rsm(i,j) = rsm_bottom
+ rmu(i,j)= rmu_bottom
+ rlambdac(i,j) = rlambdac_bottom
+ rbM(i,j) = rbM_bottom
+ alpha(i,j)=alpha_bottom
+ etaokappa(i,j)=etaokappa_bottom
+ rlambdao(i,j) = rlambdao_bottom
+ endif
+ enddo
+ enddo
+
+! print position of the source
+ print *
+ print *,'Position of the source:'
+ print *
+ print *,'x = ',xsource
+ print *,'y = ',ysource
+ print *
+
+! define location of receivers
+ print *
+ print *,'There are ',nrec,' receivers'
+ print *
+ xspacerec = (xfin-xdeb) / dble(NREC-1)
+ yspacerec = (yfin-ydeb) / dble(NREC-1)
+ do irec=1,nrec
+ xrec(irec) = xdeb + dble(irec-1)*xspacerec
+ yrec(irec) = ydeb + dble(irec-1)*yspacerec
+ enddo
+
+! find closest grid point for each receiver
+ do irec=1,nrec
+ dist = HUGEVAL
+ do j = 1,NY
+ do i = 1,NX
+ distval = sqrt((DELTAX*dble(i-1) - xrec(irec))**2 + (DELTAY*dble(j-1) - yrec(irec))**2)
+ if(distval < dist) then
+ dist = distval
+ ix_rec(irec) = i
+ iy_rec(irec) = j
+ endif
+ enddo
+ enddo
+ print *,'receiver ',irec,' x_target,y_target = ',xrec(irec),yrec(irec)
+ print *,'closest grid point found at distance ',dist,' in i,j = ',ix_rec(irec),iy_rec(irec)
+ print *
+ enddo
+
+! check the Courant stability condition for the explicit time scheme
+! R. Courant et K. O. Friedrichs et H. Lewy (1928)
+ Courant_number_bottom = cp_bottom * DELTAT / min(DELTAX,DELTAY)
+ Dispersion_number_bottom=min(cs_bottom,cps_bottom)/(2.5d0*f0*max(DELTAX,DELTAY))
+ print *,'Courant number at the bottom is ',Courant_number_bottom
+ print *,'Dispersion number at the bottom is ',Dispersion_number_bottom
+ print *
+ if(Courant_number_bottom > 1.d0/sqrt(2.d0)) stop 'time step is too large, simulation will be unstable'
+
+ if(HETEROGENEOUS_MODEL) then
+ Courant_number_top = max(cp_top,cp_bottom) * DELTAT / min(DELTAX,DELTAY)
+ Dispersion_number_top=min(cs_top,cs_bottom,cps_bottom,cps_top)/(2.5d0*f0*max(DELTAX,DELTAY))
+ print *,'Courant number at the top is ',Courant_number_top
+ print *
+ print *,'Dispersion number at the top is ',Dispersion_number_top
+ if(Courant_number_top > 6.d0/7.d0/sqrt(2.d0)) stop 'time step is too large, simulation will be unstable'
+ endif
+
+! suppress old files
+! call system('rm -f Vx_*.dat Vy_*.dat vect*.ps image*.pnm image*.gif')
+
+! initialize arrays
+ vx(:,:) = ZERO
+ vy(:,:) = ZERO
+ sigmaxx(:,:) = ZERO
+ sigmayy(:,:) = ZERO
+ sigmaxy(:,:) = ZERO
+ sigma2(:,:) = ZERO
+ alp_sigma2(:,:) = ZERO
+ gamma11(:,:)=0.d0
+ gamma22(:,:)=0.d0
+ gamma12_1(:,:)=0.d0
+ gamma12_1(:,:)=0.d0
+ xi_1(:,:)=0.d0
+ xi_2(:,:)=0.d0
+ vxf(:,:) = ZERO
+ vyf(:,:) = ZERO
+
+ memory_dx_vx1(:,:)=0.d0
+ memory_dx_vx2(:,:)=0.d0
+ memory_dy_vx(:,:)=0.d0
+ memory_dx_vy(:,:)=0.d0
+ memory_dy_vy1(:,:)=0.d0
+ memory_dy_vy2(:,:)=0.d0
+ memory_dx_sigmaxx(:,:)=0.d0
+ memory_dx_sigmayy(:,:)=0.d0
+ memory_dx_sigmaxy(:,:)=0.d0
+ memory_dx_sigma2vx(:,:)=0.d0
+ memory_dx_sigma2vxf(:,:)=0.d0
+ memory_dy_sigmaxx(:,:)=0.d0
+ memory_dy_sigmayy(:,:)=0.d0
+ memory_dy_sigmaxy(:,:)=0.d0
+ memory_dy_sigma2vy(:,:)=0.d0
+ memory_dy_sigma2vyf(:,:)=0.d0
+
+! initialize seismograms
+ sisvx(:,:) = ZERO
+ sisvy(:,:) = ZERO
+ sisp(:,:) = ZERO
+
+! initialize total energy
+ total_energy_kinetic(:) = ZERO
+ total_energy_potential(:) = ZERO
+
+!---
+!--- beginning of time loop
+!---
+
+ do it = 1,NSTEP
+
+!----------------------
+! compute stress sigma
+!----------------------
+
+!-----------------------------------
+! update memory variables for C-PML
+!-----------------------------------
+
+ do j = 2,NY
+ do i = 1,NX-1
+
+! memory of sigmaxx
+ value_dx_sigmaxx =(27.d0*vx(i+1,j)-27.d0*vx(i,j)-vx(i+2,j)+vx(i-1,j))/DELTAX/24.D0
+ value_dy_sigmaxx =(27.d0*vy(i,j)-27.d0*vy(i,j-1)-vy(i,j+1)+vy(i,j-2))/DELTAY/24.D0
+
+ memory_dx_sigmaxx(i,j) = b_x_half_x(i) * memory_dx_sigmaxx(i,j) + a_x_half_x(i) * value_dx_sigmaxx
+ memory_dy_sigmaxx(i,j) = b_y(j) * memory_dy_sigmaxx(i,j) + a_y(j) * value_dy_sigmaxx
+
+
+ gamma11(i,j) = gamma11(i,j)+DELTAT*(value_dx_sigmaxx / K_x_half_x(i) + memory_dx_sigmaxx(i,j))
+
+ gamma22(i,j) = gamma22(i,j)+DELTAT*(value_dy_sigmaxx / K_y(j) + memory_dy_sigmaxx(i,j))
+
+! sigma2
+ value_dx_sigma2vxf=(27.d0*vxf(i+1,j)-27.d0* vxf(i,j)-vxf(i+2,j)+vxf(i-1,j)) / DELTAX/24.D0
+ value_dy_sigma2vyf=(27.d0*vyf(i,j)-27.d0*vyf(i,j-1)-vyf(i,j+1)+vyf(i,j-2)) / DELTAY/24.D0
+
+ memory_dx_sigma2vxf(i,j) = b_x_half_x(i) * memory_dx_sigma2vxf(i,j) + a_x_half_x(i) * value_dx_sigma2vxf
+ memory_dy_sigma2vyf(i,j) = b_y(j) * memory_dy_sigma2vyf(i,j) + a_y(j) * value_dy_sigma2vyf
+
+ xi_1(i,j) = xi_1(i,j) -(value_dx_sigma2vxf/ K_x_half_x(i) + memory_dx_sigma2vxf(i,j))*DELTAT
+
+ xi_2(i,j) = xi_2(i,j) -(value_dy_sigma2vyf/K_y(j)+memory_dy_sigma2vyf(i,j))*DELTAT
+
+ sigma2(i,j)=-alpha(i,j)*rbM(i,j)*(gamma11(i,j)+gamma22(i,j))+rbM(i,j)*(xi_1(i,j)+xi_2(i,j))
+
+ enddo
+ enddo
+
+! add the source (point source located at a given grid point)
+ a = pi*pi*f0*f0
+ t = dble(it-1)*DELTAT
+
+! Gaussian
+ source_term = factor * exp(-a*(t-t0)**2)/(-2.d0*a)
+
+! first derivative of a Gaussian
+! source_term = factor * 2.d0*a*(t-t0)*exp(-a*(t-t0)**2)
+! source_term = factor *(t-t0)*exp(-a*(t-t0)**2)
+
+! Ricker source time function (second derivative of a Gaussian)
+! source_term = factor * (1.d0 - 2.d0*a*(t-t0)**2)*exp(-a*(t-t0)**2)
+
+! define location of the source
+ i = ISOURCE
+ j = JSOURCE
+
+! add the source term
+ sigma2(i,j) = sigma2(i,j) + source_term*rbM(i,j)
+
+ do j = 1,NY-1
+ do i = 2,NX
+
+! interpolate material parameters at the right location in the staggered grid cell
+ c33_half_y = 2.d0/(1.d0/rmu(i,j)+1.d0/rmu(i,j+1))
+ c33_half_y = rmu(i,j+1)
+
+ value_dx_sigmaxy = (27.d0*vy(i,j) - 27.d0*vy(i-1,j)-vy(i+1,j)+vy(i-2,j)) / DELTAX/24.D0
+ value_dy_sigmaxy = (27.d0*vx(i,j+1) - 27.d0*vx(i,j)-vx(i,j+2)+vx(i,j-1)) / DELTAY/24.D0
+
+ memory_dx_sigmaxy(i,j) = b_x(i) * memory_dx_sigmaxy(i,j) + a_x(i) * value_dx_sigmaxy
+ memory_dy_sigmaxy(i,j) = b_y_half_y(j) * memory_dy_sigmaxy(i,j) + a_y_half_y(j) * value_dy_sigmaxy
+
+ sigmaxy(i,j) = sigmaxy(i,j) + &
+ c33_half_y/1.d0 * (value_dx_sigmaxy / K_x(i) + memory_dx_sigmaxy(i,j) + &
+ value_dy_sigmaxy / K_y(j) + memory_dy_sigmaxy(i,j)) * DELTAT
+
+ enddo
+ enddo
+
+ do j = 2,NY
+ do i = 1,NX-1
+ sigmaxx(i,j)=(rlambdao(i,j)+2.d0*rmu(i,j))*gamma11(i,j)+rlambdao(i,j)*gamma22(i,j) -alpha(i,j)*sigma2(i,j)
+ sigmayy(i,j)=rlambdao(i,j)*gamma11(i,j)+(rlambdao(i,j)+2.d0*rmu(i,j))*gamma22(i,j) -alpha(i,j)*sigma2(i,j)
+ enddo
+ enddo
+
+!------------------
+! compute velocity
+!------------------
+
+!-----------------------------------
+! update memory variables for C-PML
+!-----------------------------------
+
+ do j = 2,NY
+ do i = 2,NX
+ co=(rho(i,j)*rsm(i,j)-rhof(i,j)*rhof(i,j))/DELTAT
+ c1=co+rho(i,j)*etaokappa(i,j)*0.5d0
+ c2=co-rho(i,j)*etaokappa(i,j)*0.5d0
+ vtemp=vxf(i,j)
+ value_dx_vx1 = (27.d0*sigmaxx(i,j) - 27.d0*sigmaxx(i-1,j)&
+ -sigmaxx(i+1,j)+sigmaxx(i-2,j)) / DELTAX/24.D0
+ value_dx_vx2 = (27.d0*sigma2(i,j) - 27.d0*sigma2(i-1,j)-sigma2(i+1,j)+sigma2(i-2,j)) / DELTAX/24.D0
+ value_dy_vx = (27.d0*sigmaxy(i,j) - 27.d0*sigmaxy(i,j-1)-sigmaxy(i,j+1)+sigmaxy(i,j-2)) / DELTAY/24.D0
+
+ memory_dx_vx1(i,j) = b_x(i) * memory_dx_vx1(i,j) + a_x(i) * value_dx_vx1
+ memory_dx_vx2(i,j) = b_x(i) * memory_dx_vx2(i,j) + a_x(i) * value_dx_vx2
+ memory_dy_vx(i,j) = b_y(j) * memory_dy_vx(i,j) + a_y(j) * value_dy_vx
+
+ vxf(i,j) = (c2*vxf(i,j) + &
+ (-rhof(i,j)*(value_dx_vx1/ K_x(i) + memory_dx_vx1(i,j) &
+ + value_dy_vx / K_y(j) + memory_dy_vx(i,j)) &
+ -rho(i,j)*(value_dx_vx2/ K_x(i) + memory_dx_vx2(i,j)) &
+ )) /c1
+
+ vtemp=(vtemp+vxf(i,j))*0.5d0
+
+ vx(i,j) = vx(i,j) + &
+ (rsm(i,j)*(value_dx_vx1/ K_x(i) + memory_dx_vx1(i,j)+ &
+ value_dy_vx / K_y(j) + memory_dy_vx(i,j))+&
+ rhof(i,j)*(value_dx_vx2/ K_x(i) + memory_dx_vx2(i,j)) + &
+ rhof(i,j)*etaokappa(i,j)*vtemp)&
+ /co
+
+ enddo
+ enddo
+
+ do j = 1,NY-1
+ do i = 1,NX-1
+
+ rho_half_x_half_y = rho(i,j+1)
+ rsm_half_x_half_y = rsm(i,j+1)
+ rhof_half_x_half_y = rhof(i,j+1)
+ etaokappa_half_x_half_y = etaokappa(i,j+1)
+
+ co=(rho_half_x_half_y*rsm_half_x_half_y-rhof_half_x_half_y**2)/DELTAT
+ c1=co+rho_half_x_half_y*etaokappa_half_x_half_y*0.5d0
+ c2=co-rho_half_x_half_y*etaokappa_half_x_half_y*0.5d0
+ vtemp=vyf(i,j)
+
+ value_dx_vy = (27.d0*sigmaxy(i+1,j) - 27.d0*sigmaxy(i,j)-sigmaxy(i+2,j)+sigmaxy(i-1,j)) / DELTAX/24.D0
+ value_dy_vy1 = (27.d0*sigmayy(i,j+1)- 27.d0*sigmayy(i,j)&
+ -sigmayy(i,j+2)+sigmayy(i,j-1)) / DELTAY/24.D0
+ value_dy_vy2 = (27.d0*sigma2(i,j+1) - 27.d0*sigma2(i,j)-sigma2(i,j+2)+sigma2(i,j-1)) / DELTAY/24.D0
+
+ memory_dx_vy(i,j) = b_x_half_x(i) * memory_dx_vy(i,j) + a_x_half_x(i) * value_dx_vy
+ memory_dy_vy1(i,j) = b_y_half_y(j) * memory_dy_vy1(i,j) + a_y_half_y(j) * value_dy_vy1
+ memory_dy_vy2(i,j) = b_y_half_y(j) * memory_dy_vy2(i,j) + a_y_half_y(j) * value_dy_vy2
+
+ vyf(i,j) = (c2*vyf(i,j) + &
+ (-rhof_half_x_half_y*(value_dx_vy / K_x_half_x(i) + memory_dx_vy(i,j) &
+ +value_dy_vy1 / K_y_half_y(j) + memory_dy_vy1(i,j))&
+ -rho_half_x_half_y*(value_dy_vy2 / K_y_half_y(j) + memory_dy_vy2(i,j)))&
+ ) /c1
+ vtemp=(vtemp+vyf(i,j))*0.5d0
+
+ vy(i,j) = vy(i,j) + &
+ (rsm_half_x_half_y*(value_dx_vy / K_x_half_x(i) + memory_dx_vy(i,j)&
++ value_dy_vy1 / K_y_half_y(j) + memory_dy_vy1(i,j))&
++ rhof_half_x_half_y*(value_dy_vy2 / K_y_half_y(j) + memory_dy_vy2(i,j))&
++ rhof_half_x_half_y*etaokappa_half_x_half_y*vtemp)&
+ /co
+
+ enddo
+ enddo
+
+! Dirichlet conditions (rigid boundaries) on the edges or at the bottom of the PML layers
+ vx(1,:) = ZERO
+ vx(NX,:) = ZERO
+
+ vx(:,1) = ZERO
+ vx(:,NY) = ZERO
+
+ vy(1,:) = ZERO
+ vy(NX,:) = ZERO
+
+ vy(:,1) = ZERO
+ vy(:,NY) = ZERO
+
+ vxf(1,:) = ZERO
+ vxf(NX,:) = ZERO
+
+ vxf(:,1) = ZERO
+ vxf(:,NY) = ZERO
+
+ vyf(1,:) = ZERO
+ vyf(NX,:) = ZERO
+
+ vyf(:,1) = ZERO
+ vyf(:,NY) = ZERO
+
+! store seismograms
+ do irec = 1,NREC
+! x component
+ sisvx(it,irec) = vx(ix_rec(irec),iy_rec(irec))
+! y component
+ sisvy(it,irec) = vy(ix_rec(irec),iy_rec(irec))
+! fluid pressure
+ sisp(it,irec) = sigma2(ix_rec(irec),iy_rec(irec))
+ enddo
+
+! compute total energy
+
+! compute kinetic energy first, defined as 1/2 rho ||v||^2
+! in principle we should use rho_half_x_half_y instead of rho for vy
+! in order to interpolate density at the right location in the staggered grid cell
+! but in a homogeneous medium we can safely ignore it
+ total_energy_kinetic(it) = 0.5d0 * &
+sum(rho(NPOINTS_PML:NX-NPOINTS_PML+1,NPOINTS_PML:NY-NPOINTS_PML+1)&
+*(vx(NPOINTS_PML:NX-NPOINTS_PML+1,NPOINTS_PML:NY-NPOINTS_PML+1)**2&
++vy(NPOINTS_PML:NX-NPOINTS_PML+1,NPOINTS_PML:NY-NPOINTS_PML+1)**2))&
+*DELTAX * DELTAY+&
+0.5d0*sum(rsm(NPOINTS_PML:NX-NPOINTS_PML+1,NPOINTS_PML:NY-NPOINTS_PML+1)&
+*(vxf(NPOINTS_PML:NX-NPOINTS_PML+1,NPOINTS_PML:NY-NPOINTS_PML+1)**2&
++vyf(NPOINTS_PML:NX-NPOINTS_PML+1,NPOINTS_PML:NY-NPOINTS_PML+1)**2))&
+*DELTAX*DELTAY
+
+! add potential energy, defined as 1/2 epsilon_ij sigma_ij
+! in principle we should interpolate the medium parameters at the right location
+! in the staggered grid cell but in a homogeneous medium we can safely ignore it
+ total_energy_potential(it) = ZERO
+
+ do j = NPOINTS_PML,NY-NPOINTS_PML+1
+ do i = NPOINTS_PML,NX-NPOINTS_PML+1
+ epsilon_xx = ((rlambdao(i,j) + 2.d0*rmu(i,j)) * sigmaxx(i,j) - rlambdao(i,j) * sigmayy(i,j)) / &
+ (4.d0 * rmu(i,j) * (rlambdao(i,j) + rmu(i,j)))
+ epsilon_yy = ((rlambdao(i,j) + 2.d0*rmu(i,j)) * sigmayy(i,j) - rlambdao(i,j) * sigmaxx(i,j)) / &
+ (4.d0 * rmu(i,j) * (rlambdao(i,j) + rmu(i,j)))
+ epsilon_xy = sigmaxy(i,j) / (2.d0 * rmu(i,j))
+ total_energy_potential(it) = total_energy_potential(it) + &
+ 0.5d0 * (epsilon_xx * sigmaxx(i,j) + epsilon_yy * sigmayy(i,j) + 2.d0 * epsilon_xy * sigmaxy(i,j)&
+ +sigma2(i,j)**2/rbM(i,j)&
+ +2.d0*rhof(i,j)*(vx(i,j)*vxf(i,j)+vy(i,j)*vyf(i,j)))*DELTAX * DELTAY
+ enddo
+ enddo
+
+! output information
+ if(mod(it,IT_DISPLAY) == 0 .or. it == 5) then
+
+! print maximum of norm of velocity
+ velocnorm_all = maxval(sqrt(vx(:,:)**2 + vy(:,:)**2))
+ print *,'time step, time = ',it,dble(it-1)*DELTAT
+ print *,'maximum of norm of velocity is ',velocnorm_all
+ print *,'total energy = ',total_energy_kinetic(it) + total_energy_potential(it)
+ print *
+
+! check stability of the code, exit if unstable
+ if(velocnorm_all > STABILITY_THRESHOLD) stop 'code became unstable and blew up'
+
+ vnorm(:,:)=sqrt(vx(:,:)**2+vy(:,:)**2)
+
+ call create_2D_image(vx,NX+2,NY+2,it,ISOURCE,JSOURCE,ix_rec,iy_rec,nrec, &
+ NPOINTS_PML,USE_PML_LEFT,USE_PML_RIGHT,USE_PML_BOTTOM,&
+ USE_PML_TOP,1,max_amplitude,JINTERFACE)
+
+ call create_2D_image(vy,NX+2,NY+2,it,ISOURCE,JSOURCE,ix_rec,iy_rec,nrec, &
+ NPOINTS_PML,USE_PML_LEFT,USE_PML_RIGHT,USE_PML_BOTTOM,&
+ USE_PML_TOP,2,max_amplitude,JINTERFACE)
+
+! save temporary partial seismograms to monitor the behavior of the simulation
+! while it is running
+ call write_seismograms(sisvx,sisvy,sisp,NSTEP,NREC,DELTAT,t0)
+
+ endif
+
+ enddo ! end of time loop
+
+! save seismograms
+ call write_seismograms(sisvx,sisvy,sisp,NSTEP,NREC,DELTAT,t0)
+
+! save total energy
+ open(unit=20,file='energy.dat',status='unknown')
+ do it = 1,NSTEP
+ write(20,*) sngl(dble(it-1)*DELTAT), sngl(total_energy_kinetic(it) + total_energy_potential(it))
+ enddo
+ close(20)
+
+! create script for Gnuplot for total energy
+ open(unit=20,file='plot_energy',status='unknown')
+ write(20,*) 'set term x11'
+ write(20,*) '# set term postscript landscape monochrome dashed "Helvetica" 22'
+ write(20,*) '# set xrange [0:7]'
+ write(20,*) '# set yrange [-4:4.5]'
+ write(20,*)
+ write(20,*) 'set xlabel "Time (s)"'
+ write(20,*) 'set ylabel "Total energy"'
+ write(20,*)
+ write(20,*) '# set output "cpml_total_energy.eps"'
+ write(20,*) 'plot "energy.dat" us 1:2 t ''Ec'' w l 1, "energy.dat" us 1:3 &
+ & t ''Ep'' w l 3, "energy.dat" us 1:4 t ''Total energy'' w l 4'
+ write(20,*) 'pause -1 "Hit any key..."'
+ write(20,*)
+ close(20)
+
+! create script for Gnuplot
+ open(unit=20,file='plotgnu',status='unknown')
+ write(20,*) 'set term x11'
+ write(20,*) '# set term postscript landscape monochrome dashed "Helvetica" 22'
+ write(20,*) '#set xrange [0:7]'
+ write(20,*)
+ write(20,*) 'set xlabel "Time (s)"'
+ write(20,*) 'set ylabel "Amplitude (m / s)"'
+ write(20,*)
+
+ write(20,*) 'set output "v_sigma_Vx_receiver_001.eps"'
+ write(20,*) '#set yrange [-4:4.5]'
+ write(20,*) 'plot "Vx_file_001.dat" t ''Vx C-PML'' w l 1'
+ write(20,*) 'pause -1 "Hit any key..."'
+ write(20,*)
+
+ write(20,*) 'set output "v_sigma_Vy_receiver_001.eps"'
+ write(20,*) '#set yrange [-15:19]'
+ write(20,*) 'plot "Vy_file_001.dat" t ''Vy C-PML'' w l 1'
+ write(20,*) 'pause -1 "Hit any key..."'
+ write(20,*)
+
+ write(20,*) 'set output "v_sigma_Vx_receiver_002.eps"'
+ write(20,*) '#set yrange [-12:16]'
+ write(20,*) 'plot "Vx_file_002.dat" t ''Vx C-PML'' w l 1'
+ write(20,*) 'pause -1 "Hit any key..."'
+ write(20,*)
+
+ write(20,*) 'set output "v_sigma_Vy_receiver_002.eps"'
+ write(20,*) '#set yrange [-7:10]'
+ write(20,*) 'plot "Vy_file_002.dat" t ''Vy C-PML'' w l 1'
+ write(20,*) 'pause -1 "Hit any key..."'
+ write(20,*)
+
+ close(20)
+
+ print *
+ print *,'End of the simulation'
+ print *
+
+ end program seismic_CPML_2D_poroelastic_fourth
+
+
+!----
+!---- save the seismograms in ASCII text format
+!----
+
+ subroutine write_seismograms(sisvx,sisvy,sisp,nt,nrec,DELTAT,t0)
+
+ implicit none
+
+ integer nt,nrec
+ double precision DELTAT,t0
+
+ double precision sisvx(nt,nrec)
+ double precision sisvy(nt,nrec)
+ double precision sisp(nt,nrec)
+
+ integer irec,it
+
+ character(len=100) file_name
+
+! X component
+ do irec=1,nrec
+ write(file_name,"('Vx_file_',i3.3,'.dat')") irec
+ open(unit=11,file=file_name,status='unknown')
+ do it=1,nt
+ write(11,*) sngl(dble(it-1)*DELTAT - t0),' ',sngl(sisvx(it,irec))
+ enddo
+ close(11)
+ enddo
+
+! Z component
+ do irec=1,nrec
+ write(file_name,"('Vy_file_',i3.3,'.dat')") irec
+ open(unit=11,file=file_name,status='unknown')
+ do it=1,nt
+ write(11,*) sngl(dble(it-1)*DELTAT - t0),' ',sngl(sisvy(it,irec))
+ enddo
+ close(11)
+ enddo
+
+! fluid pressure
+ do irec=1,nrec
+ write(file_name,"('Pf_file_',i3.3,'.dat')") irec
+ open(unit=11,file=file_name,status='unknown')
+ do it=1,nt
+ write(11,*) sngl(dble(it-1)*DELTAT - t0),' ',sngl(sisp(it,irec))
+ enddo
+ close(11)
+ enddo
+
+ end subroutine write_seismograms
+
+!----
+!---- routine to create a color image of a given vector component
+!---- the image is created in PNM format and then converted to GIF
+!----
+
+ subroutine create_2D_image(image_data_2D,NX,NY,it,ISOURCE,JSOURCE,ix_rec,iy_rec,nrec, &
+ NPOINTS_PML,USE_PML_LEFT,USE_PML_RIGHT,USE_PML_BOTTOM,USE_PML_TOP,field_number,max_amplitude,JINTERFACE)
+
+
+ implicit none
+
+! non linear display to enhance small amplitudes for graphics
+ double precision, parameter :: POWER_DISPLAY = 0.25d0
+
+! amplitude threshold above which we draw the color point
+ double precision, parameter :: cutvect = 0.01d0
+
+! use black or white background for points that are below the threshold
+ logical, parameter :: WHITE_BACKGROUND = .true.
+
+! size of cross and square in pixels drawn to represent the source and the receivers
+ integer, parameter :: width_cross = 5, thickness_cross = 1, size_square = 3
+
+ integer NX,NY,it,field_number,ISOURCE,JSOURCE,NPOINTS_PML,nrec
+ logical USE_PML_LEFT,USE_PML_RIGHT,USE_PML_BOTTOM,USE_PML_TOP
+
+ double precision, dimension(NX,NY) :: image_data_2D
+
+ integer, dimension(nrec) :: ix_rec,iy_rec
+
+ integer ix,iy,irec,JINTERFACE
+
+ double precision max_amplitude
+
+ character(len=100) file_name,system_command
+
+ double precision normalized_value
+ integer :: R, G, B
+
+! open image file and create system command to convert image to more convenient format
+ if(field_number == 1) then
+ write(file_name,"('image',i5.5,'_Vx.pnm')") it
+ write(system_command,"('convert image',i5.5,'_Vx.pnm image',i5.5,'_Vx.gif ; rm image',i5.5,'_Vx.pnm')") it,it,it
+ endif
+ if(field_number == 2) then
+ write(file_name,"('image',i5.5,'_Vy.pnm')") it
+ write(system_command,"('convert image',i5.5,'_Vy.pnm image',i5.5,'_Vy.gif ; rm image',i5.5,'_Vy.pnm')") it,it,it
+ endif
+ if(field_number == 3) then
+ write(file_name,"('image',i5.5,'_Vnorm.pnm')") it
+ write(system_command,"('convert image',i5.5,'_Vnorm.pnm image',i5.5,'_Vnorm.gif ; rm image',i5.5,'_Vnorm.pnm')") it,it,it
+ endif
+
+ open(unit=27, file=file_name, status='unknown')
+
+ write(27,"('P3')") ! write image in PNM P3 format
+
+ write(27,*) NX,NY ! write image size
+ write(27,*) '255' ! maximum value of each pixel color
+
+! compute maximum amplitude
+ max_amplitude = maxval(abs(image_data_2D))
+
+! image starts in upper-left corner in PNM format
+ do iy=NY,1,-1
+ do ix=1,NX
+
+! define data as vector component normalized to [-1:1] and rounded to nearest integer
+! keeping in mind that amplitude can be negative
+ normalized_value = image_data_2D(ix,iy) / max_amplitude
+
+! suppress values that are outside [-1:+1] to avoid small edge effects
+ if(normalized_value < -1.d0) normalized_value = -1.d0
+ if(normalized_value > 1.d0) normalized_value = 1.d0
+
+! draw an orange cross to represent the source
+ if((ix >= ISOURCE - width_cross .and. ix <= ISOURCE + width_cross .and. &
+ iy >= JSOURCE - thickness_cross .and. iy <= JSOURCE + thickness_cross) .or. &
+ (ix >= ISOURCE - thickness_cross .and. ix <= ISOURCE + thickness_cross .and. &
+ iy >= JSOURCE - width_cross .and. iy <= JSOURCE + width_cross)) then
+ R = 255
+ G = 157
+ B = 0
+
+! display two-pixel-thick black frame around the image
+ else if(ix <= 2 .or. ix >= NX-1 .or. iy <= 2 .or. iy >= NY-1) then
+ R = 0
+ G = 0
+ B = 0
+
+! display edges of the PML layers
+ else if((USE_PML_LEFT .and. ix == NPOINTS_PML) .or. &
+ (USE_PML_RIGHT .and. ix == NX - NPOINTS_PML) .or. &
+ (USE_PML_BOTTOM .and. iy == NPOINTS_PML) .or. &
+ (USE_PML_TOP .and. iy == NY - NPOINTS_PML)) then
+ R = 255
+ G = 150
+ B = 0
+ else if(iy==JINTERFACE) then
+ R = 0
+ G = 0
+ B = 0
+! suppress all the values that are below the threshold
+ else if(abs(image_data_2D(ix,iy)) <= max_amplitude * cutvect) then
+
+! use a black or white background for points that are below the threshold
+ if(WHITE_BACKGROUND) then
+ R = 255
+ G = 255
+ B = 255
+ else
+ R = 0
+ G = 0
+ B = 0
+ endif
+
+! represent regular image points using red if value is positive, blue if negative
+ else if(normalized_value >= 0.d0) then
+ R = nint(255.d0*normalized_value**POWER_DISPLAY)
+ G = 0
+ B = 0
+ else
+ R = 0
+ G = 0
+ B = nint(255.d0*abs(normalized_value)**POWER_DISPLAY)
+ endif
+
+! draw a green square to represent the receivers
+ do irec = 1,nrec
+ if((ix >= ix_rec(irec) - size_square .and. ix <= ix_rec(irec) + size_square .and. &
+ iy >= iy_rec(irec) - size_square .and. iy <= iy_rec(irec) + size_square) .or. &
+ (ix >= ix_rec(irec) - size_square .and. ix <= ix_rec(irec) + size_square .and. &
+ iy >= iy_rec(irec) - size_square .and. iy <= iy_rec(irec) + size_square)) then
+! use dark green color
+ R = 30
+ G = 180
+ B = 60
+ endif
+ enddo
+
+! write color pixel
+ write(27,"(i3,' ',i3,' ',i3)") R,G,B
+
+ enddo
+ enddo
+
+! close file
+ close(27)
+
+! call the system to convert image to JPEG
+! call system(system_command)
+
+ end subroutine create_2D_image
+
+!
+! CeCILL FREE SOFTWARE LICENSE AGREEMENT
+!
+! Notice
+!
+! This Agreement is a Free Software license agreement that is the result
+! of discussions between its authors in order to ensure compliance with
+! the two main principles guiding its drafting:
+!
+! * firstly, compliance with the principles governing the distribution
+! of Free Software: access to source code, broad rights granted to
+! users,
+! * secondly, the election of a governing law, French law, with which
+! it is conformant, both as regards the law of torts and
+! intellectual property law, and the protection that it offers to
+! both authors and holders of the economic rights over software.
+!
+! The authors of the CeCILL (for Ce[a] C[nrs] I[nria] L[ogiciel] L[ibre])
+! license are:
+!
+! Commissariat a l'Energie Atomique - CEA, a public scientific, technical
+! and industrial research establishment, having its principal place of
+! business at 25 rue Leblanc, immeuble Le Ponant D, 75015 Paris, France.
+!
+! Centre National de la Recherche Scientifique - CNRS, a public scientific
+! and technological establishment, having its principal place of business
+! at 3 rue Michel-Ange, 75794 Paris cedex 16, France.
+!
+! Institut National de Recherche en Informatique et en Automatique -
+! INRIA, a public scientific and technological establishment, having its
+! principal place of business at Domaine de Voluceau, Rocquencourt, BP
+! 105, 78153 Le Chesnay cedex, France.
+!
+! Preamble
+!
+! The purpose of this Free Software license agreement is to grant users
+! the right to modify and redistribute the software governed by this
+! license within the framework of an open source distribution model.
+!
+! The exercising of these rights is conditional upon certain obligations
+! for users so as to preserve this status for all subsequent redistributions.
+!
+! In consideration of access to the source code and the rights to copy,
+! modify and redistribute granted by the license, users are provided only
+! with a limited warranty and the software's author, the holder of the
+! economic rights, and the successive licensors only have limited liability.
+!
+! In this respect, the risks associated with loading, using, modifying
+! and/or developing or reproducing the software by the user are brought to
+! the user's attention, given its Free Software status, which may make it
+! complicated to use, with the result that its use is reserved for
+! developers and experienced professionals having in-depth computer
+! knowledge. Users are therefore encouraged to load and test the
+! suitability of the software as regards their requirements in conditions
+! enabling the security of their systems and/or data to be ensured and,
+! more generally, to use and operate it in the same conditions of
+! security. This Agreement may be freely reproduced and published,
+! provided it is not altered, and that no provisions are either added or
+! removed herefrom.
+!
+! This Agreement may apply to any or all software for which the holder of
+! the economic rights decides to submit the use thereof to its provisions.
+!
+! Article 1 - DEFINITIONS
+!
+! For the purpose of this Agreement, when the following expressions
+! commence with a capital letter, they shall have the following meaning:
+!
+! Agreement: means this license agreement, and its possible subsequent
+! versions and annexes.
+!
+! Software: means the software in its Object Code and/or Source Code form
+! and, where applicable, its documentation, "as is" when the Licensee
+! accepts the Agreement.
+!
+! Initial Software: means the Software in its Source Code and possibly its
+! Object Code form and, where applicable, its documentation, "as is" when
+! it is first distributed under the terms and conditions of the Agreement.
+!
+! Modified Software: means the Software modified by at least one
+! Contribution.
+!
+! Source Code: means all the Software's instructions and program lines to
+! which access is required so as to modify the Software.
+!
+! Object Code: means the binary files originating from the compilation of
+! the Source Code.
+!
+! Holder: means the holder(s) of the economic rights over the Initial
+! Software.
+!
+! Licensee: means the Software user(s) having accepted the Agreement.
+!
+! Contributor: means a Licensee having made at least one Contribution.
+!
+! Licensor: means the Holder, or any other individual or legal entity, who
+! distributes the Software under the Agreement.
+!
+! Contribution: means any or all modifications, corrections, translations,
+! adaptations and/or new functions integrated into the Software by any or
+! all Contributors, as well as any or all Internal Modules.
+!
+! Module: means a set of sources files including their documentation that
+! enables supplementary functions or services in addition to those offered
+! by the Software.
+!
+! External Module: means any or all Modules, not derived from the
+! Software, so that this Module and the Software run in separate address
+! spaces, with one calling the other when they are run.
+!
+! Internal Module: means any or all Module, connected to the Software so
+! that they both execute in the same address space.
+!
+! GNU GPL: means the GNU General Public License version 2 or any
+! subsequent version, as published by the Free Software Foundation Inc.
+!
+! Parties: mean both the Licensee and the Licensor.
+!
+! These expressions may be used both in singular and plural form.
+!
+! Article 2 - PURPOSE
+!
+! The purpose of the Agreement is the grant by the Licensor to the
+! Licensee of a non-exclusive, transferable and worldwide license for the
+! Software as set forth in Article 5 hereinafter for the whole term of the
+! protection granted by the rights over said Software.
+!
+! Article 3 - ACCEPTANCE
+!
+! 3.1 The Licensee shall be deemed as having accepted the terms and
+! conditions of this Agreement upon the occurrence of the first of the
+! following events:
+!
+! * (i) loading the Software by any or all means, notably, by
+! downloading from a remote server, or by loading from a physical
+! medium;
+! * (ii) the first time the Licensee exercises any of the rights
+! granted hereunder.
+!
+! 3.2 One copy of the Agreement, containing a notice relating to the
+! characteristics of the Software, to the limited warranty, and to the
+! fact that its use is restricted to experienced users has been provided
+! to the Licensee prior to its acceptance as set forth in Article 3.1
+! hereinabove, and the Licensee hereby acknowledges that it has read and
+! understood it.
+!
+! Article 4 - EFFECTIVE DATE AND TERM
+!
+! 4.1 EFFECTIVE DATE
+!
+! The Agreement shall become effective on the date when it is accepted by
+! the Licensee as set forth in Article 3.1.
+!
+! 4.2 TERM
+!
+! The Agreement shall remain in force for the entire legal term of
+! protection of the economic rights over the Software.
+!
+! Article 5 - SCOPE OF RIGHTS GRANTED
+!
+! The Licensor hereby grants to the Licensee, who accepts, the following
+! rights over the Software for any or all use, and for the term of the
+! Agreement, on the basis of the terms and conditions set forth hereinafter.
+!
+! Besides, if the Licensor owns or comes to own one or more patents
+! protecting all or part of the functions of the Software or of its
+! components, the Licensor undertakes not to enforce the rights granted by
+! these patents against successive Licensees using, exploiting or
+! modifying the Software. If these patents are transferred, the Licensor
+! undertakes to have the transferees subscribe to the obligations set
+! forth in this paragraph.
+!
+! 5.1 RIGHT OF USE
+!
+! The Licensee is authorized to use the Software, without any limitation
+! as to its fields of application, with it being hereinafter specified
+! that this comprises:
+!
+! 1. permanent or temporary reproduction of all or part of the Software
+! by any or all means and in any or all form.
+!
+! 2. loading, displaying, running, or storing the Software on any or
+! all medium.
+!
+! 3. entitlement to observe, study or test its operation so as to
+! determine the ideas and principles behind any or all constituent
+! elements of said Software. This shall apply when the Licensee
+! carries out any or all loading, displaying, running, transmission
+! or storage operation as regards the Software, that it is entitled
+! to carry out hereunder.
+!
+! 5.2 ENTITLEMENT TO MAKE CONTRIBUTIONS
+!
+! The right to make Contributions includes the right to translate, adapt,
+! arrange, or make any or all modifications to the Software, and the right
+! to reproduce the resulting software.
+!
+! The Licensee is authorized to make any or all Contributions to the
+! Software provided that it includes an explicit notice that it is the
+! author of said Contribution and indicates the date of the creation thereof.
+!
+! 5.3 RIGHT OF DISTRIBUTION
+!
+! In particular, the right of distribution includes the right to publish,
+! transmit and communicate the Software to the general public on any or
+! all medium, and by any or all means, and the right to market, either in
+! consideration of a fee, or free of charge, one or more copies of the
+! Software by any means.
+!
+! The Licensee is further authorized to distribute copies of the modified
+! or unmodified Software to third parties according to the terms and
+! conditions set forth hereinafter.
+!
+! 5.3.1 DISTRIBUTION OF SOFTWARE WITHOUT MODIFICATION
+!
+! The Licensee is authorized to distribute true copies of the Software in
+! Source Code or Object Code form, provided that said distribution
+! complies with all the provisions of the Agreement and is accompanied by:
+!
+! 1. a copy of the Agreement,
+!
+! 2. a notice relating to the limitation of both the Licensor's
+! warranty and liability as set forth in Articles 8 and 9,
+!
+! and that, in the event that only the Object Code of the Software is
+! redistributed, the Licensee allows future Licensees unhindered access to
+! the full Source Code of the Software by indicating how to access it, it
+! being understood that the additional cost of acquiring the Source Code
+! shall not exceed the cost of transferring the data.
+!
+! 5.3.2 DISTRIBUTION OF MODIFIED SOFTWARE
+!
+! When the Licensee makes a Contribution to the Software, the terms and
+! conditions for the distribution of the resulting Modified Software
+! become subject to all the provisions of this Agreement.
+!
+! The Licensee is authorized to distribute the Modified Software, in
+! source code or object code form, provided that said distribution
+! complies with all the provisions of the Agreement and is accompanied by:
+!
+! 1. a copy of the Agreement,
+!
+! 2. a notice relating to the limitation of both the Licensor's
+! warranty and liability as set forth in Articles 8 and 9,
+!
+! and that, in the event that only the object code of the Modified
+! Software is redistributed, the Licensee allows future Licensees
+! unhindered access to the full source code of the Modified Software by
+! indicating how to access it, it being understood that the additional
+! cost of acquiring the source code shall not exceed the cost of
+! transferring the data.
+!
+! 5.3.3 DISTRIBUTION OF EXTERNAL MODULES
+!
+! When the Licensee has developed an External Module, the terms and
+! conditions of this Agreement do not apply to said External Module, that
+! may be distributed under a separate license agreement.
+!
+! 5.3.4 COMPATIBILITY WITH THE GNU GPL
+!
+! The Licensee can include a code that is subject to the provisions of one
+! of the versions of the GNU GPL in the Modified or unmodified Software,
+! and distribute that entire code under the terms of the same version of
+! the GNU GPL.
+!
+! The Licensee can include the Modified or unmodified Software in a code
+! that is subject to the provisions of one of the versions of the GNU GPL,
+! and distribute that entire code under the terms of the same version of
+! the GNU GPL.
+!
+! Article 6 - INTELLECTUAL PROPERTY
+!
+! 6.1 OVER THE INITIAL SOFTWARE
+!
+! The Holder owns the economic rights over the Initial Software. Any or
+! all use of the Initial Software is subject to compliance with the terms
+! and conditions under which the Holder has elected to distribute its work
+! and no one shall be entitled to modify the terms and conditions for the
+! distribution of said Initial Software.
+!
+! The Holder undertakes that the Initial Software will remain ruled at
+! least by this Agreement, for the duration set forth in Article 4.2.
+!
+! 6.2 OVER THE CONTRIBUTIONS
+!
+! The Licensee who develops a Contribution is the owner of the
+! intellectual property rights over this Contribution as defined by
+! applicable law.
+!
+! 6.3 OVER THE EXTERNAL MODULES
+!
+! The Licensee who develops an External Module is the owner of the
+! intellectual property rights over this External Module as defined by
+! applicable law and is free to choose the type of agreement that shall
+! govern its distribution.
+!
+! 6.4 JOINT PROVISIONS
+!
+! The Licensee expressly undertakes:
+!
+! 1. not to remove, or modify, in any manner, the intellectual property
+! notices attached to the Software;
+!
+! 2. to reproduce said notices, in an identical manner, in the copies
+! of the Software modified or not.
+!
+! The Licensee undertakes not to directly or indirectly infringe the
+! intellectual property rights of the Holder and/or Contributors on the
+! Software and to take, where applicable, vis-a-vis its staff, any and all
+! measures required to ensure respect of said intellectual property rights
+! of the Holder and/or Contributors.
+!
+! Article 7 - RELATED SERVICES
+!
+! 7.1 Under no circumstances shall the Agreement oblige the Licensor to
+! provide technical assistance or maintenance services for the Software.
+!
+! However, the Licensor is entitled to offer this type of services. The
+! terms and conditions of such technical assistance, and/or such
+! maintenance, shall be set forth in a separate instrument. Only the
+! Licensor offering said maintenance and/or technical assistance services
+! shall incur liability therefor.
+!
+! 7.2 Similarly, any Licensor is entitled to offer to its licensees, under
+! its sole responsibility, a warranty, that shall only be binding upon
+! itself, for the redistribution of the Software and/or the Modified
+! Software, under terms and conditions that it is free to decide. Said
+! warranty, and the financial terms and conditions of its application,
+! shall be subject of a separate instrument executed between the Licensor
+! and the Licensee.
+!
+! Article 8 - LIABILITY
+!
+! 8.1 Subject to the provisions of Article 8.2, the Licensee shall be
+! entitled to claim compensation for any direct loss it may have suffered
+! from the Software as a result of a fault on the part of the relevant
+! Licensor, subject to providing evidence thereof.
+!
+! 8.2 The Licensor's liability is limited to the commitments made under
+! this Agreement and shall not be incurred as a result of in particular:
+! (i) loss due the Licensee's total or partial failure to fulfill its
+! obligations, (ii) direct or consequential loss that is suffered by the
+! Licensee due to the use or performance of the Software, and (iii) more
+! generally, any consequential loss. In particular the Parties expressly
+! agree that any or all pecuniary or business loss (i.e. loss of data,
+! loss of profits, operating loss, loss of customers or orders,
+! opportunity cost, any disturbance to business activities) or any or all
+! legal proceedings instituted against the Licensee by a third party,
+! shall constitute consequential loss and shall not provide entitlement to
+! any or all compensation from the Licensor.
+!
+! Article 9 - WARRANTY
+!
+! 9.1 The Licensee acknowledges that the scientific and technical
+! state-of-the-art when the Software was distributed did not enable all
+! possible uses to be tested and verified, nor for the presence of
+! possible defects to be detected. In this respect, the Licensee's
+! attention has been drawn to the risks associated with loading, using,
+! modifying and/or developing and reproducing the Software which are
+! reserved for experienced users.
+!
+! The Licensee shall be responsible for verifying, by any or all means,
+! the suitability of the product for its requirements, its good working
+! order, and for ensuring that it shall not cause damage to either persons
+! or properties.
+!
+! 9.2 The Licensor hereby represents, in good faith, that it is entitled
+! to grant all the rights over the Software (including in particular the
+! rights set forth in Article 5).
+!
+! 9.3 The Licensee acknowledges that the Software is supplied "as is" by
+! the Licensor without any other express or tacit warranty, other than
+! that provided for in Article 9.2 and, in particular, without any warranty
+! as to its commercial value, its secured, safe, innovative or relevant
+! nature.
+!
+! Specifically, the Licensor does not warrant that the Software is free
+! from any error, that it will operate without interruption, that it will
+! be compatible with the Licensee's own equipment and software
+! configuration, nor that it will meet the Licensee's requirements.
+!
+! 9.4 The Licensor does not either expressly or tacitly warrant that the
+! Software does not infringe any third party intellectual property right
+! relating to a patent, software or any other property right. Therefore,
+! the Licensor disclaims any and all liability towards the Licensee
+! arising out of any or all proceedings for infringement that may be
+! instituted in respect of the use, modification and redistribution of the
+! Software. Nevertheless, should such proceedings be instituted against
+! the Licensee, the Licensor shall provide it with technical and legal
+! assistance for its defense. Such technical and legal assistance shall be
+! decided on a case-by-case basis between the relevant Licensor and the
+! Licensee pursuant to a memorandum of understanding. The Licensor
+! disclaims any and all liability as regards the Licensee's use of the
+! name of the Software. No warranty is given as regards the existence of
+! prior rights over the name of the Software or as regards the existence
+! of a trademark.
+!
+! Article 10 - TERMINATION
+!
+! 10.1 In the event of a breach by the Licensee of its obligations
+! hereunder, the Licensor may automatically terminate this Agreement
+! thirty (30) days after notice has been sent to the Licensee and has
+! remained ineffective.
+!
+! 10.2 A Licensee whose Agreement is terminated shall no longer be
+! authorized to use, modify or distribute the Software. However, any
+! licenses that it may have granted prior to termination of the Agreement
+! shall remain valid subject to their having been granted in compliance
+! with the terms and conditions hereof.
+!
+! Article 11 - MISCELLANEOUS
+!
+! 11.1 EXCUSABLE EVENTS
+!
+! Neither Party shall be liable for any or all delay, or failure to
+! perform the Agreement, that may be attributable to an event of force
+! majeure, an act of God or an outside cause, such as defective
+! functioning or interruptions of the electricity or telecommunications
+! networks, network paralysis following a virus attack, intervention by
+! government authorities, natural disasters, water damage, earthquakes,
+! fire, explosions, strikes and labor unrest, war, etc.
+!
+! 11.2 Any failure by either Party, on one or more occasions, to invoke
+! one or more of the provisions hereof, shall under no circumstances be
+! interpreted as being a waiver by the interested Party of its right to
+! invoke said provision(s) subsequently.
+!
+! 11.3 The Agreement cancels and replaces any or all previous agreements,
+! whether written or oral, between the Parties and having the same
+! purpose, and constitutes the entirety of the agreement between said
+! Parties concerning said purpose. No supplement or modification to the
+! terms and conditions hereof shall be effective as between the Parties
+! unless it is made in writing and signed by their duly authorized
+! representatives.
+!
+! 11.4 In the event that one or more of the provisions hereof were to
+! conflict with a current or future applicable act or legislative text,
+! said act or legislative text shall prevail, and the Parties shall make
+! the necessary amendments so as to comply with said act or legislative
+! text. All other provisions shall remain effective. Similarly, invalidity
+! of a provision of the Agreement, for any reason whatsoever, shall not
+! cause the Agreement as a whole to be invalid.
+!
+! 11.5 LANGUAGE
+!
+! The Agreement is drafted in both French and English and both versions
+! are deemed authentic.
+!
+! Article 12 - NEW VERSIONS OF THE AGREEMENT
+!
+! 12.1 Any person is authorized to duplicate and distribute copies of this
+! Agreement.
+!
+! 12.2 So as to ensure coherence, the wording of this Agreement is
+! protected and may only be modified by the authors of the License, who
+! reserve the right to periodically publish updates or new versions of the
+! Agreement, each with a separate number. These subsequent versions may
+! address new issues encountered by Free Software.
+!
+! 12.3 Any Software distributed under a given version of the Agreement may
+! only be subsequently distributed under the same version of the Agreement
+! or a subsequent version, subject to the provisions of Article 5.3.4.
+!
+! Article 13 - GOVERNING LAW AND JURISDICTION
+!
+! 13.1 The Agreement is governed by French law. The Parties agree to
+! endeavor to seek an amicable solution to any disagreements or disputes
+! that may arise during the performance of the Agreement.
+!
+! 13.2 Failing an amicable solution within two (2) months as from their
+! occurrence, and unless emergency proceedings are necessary, the
+! disagreements or disputes shall be referred to the Paris Courts having
+! jurisdiction, by the more diligent Party.
+!
+! Version 2.0 dated 2006-09-05.
+!
+
Added: seismo/3D/CPML/tags/v1.1.1/seismic_CPML_3D_isotropic_MPI_OpenMP.f90
===================================================================
--- seismo/3D/CPML/tags/v1.1.1/seismic_CPML_3D_isotropic_MPI_OpenMP.f90 (rev 0)
+++ seismo/3D/CPML/tags/v1.1.1/seismic_CPML_3D_isotropic_MPI_OpenMP.f90 2009-11-03 21:35:50 UTC (rev 15926)
@@ -0,0 +1,1975 @@
+!
+! SEISMIC_CPML Version 1.1.1, November 2009.
+!
+! Copyright Universite de Pau et des Pays de l'Adour, CNRS and INRIA, France.
+! Contributor: Dimitri Komatitsch, dimitri DOT komatitsch aT univ-pau DOT fr
+!
+! This software is a computer program whose purpose is to solve
+! the three-dimensional isotropic elastic wave equation
+! using a finite-difference method with Convolutional Perfectly Matched
+! Layer (C-PML) conditions.
+!
+! This software is governed by the CeCILL license under French law and
+! abiding by the rules of distribution of free software. You can use,
+! modify and/or redistribute the software under the terms of the CeCILL
+! license as circulated by CEA, CNRS and INRIA at the following URL
+! "http://www.cecill.info".
+!
+! As a counterpart to the access to the source code and rights to copy,
+! modify and redistribute granted by the license, users are provided only
+! with a limited warranty and the software's author, the holder of the
+! economic rights, and the successive licensors have only limited
+! liability.
+!
+! In this respect, the user's attention is drawn to the risks associated
+! with loading, using, modifying and/or developing or reproducing the
+! software by the user in light of its specific status of free software,
+! that may mean that it is complicated to manipulate, and that also
+! therefore means that it is reserved for developers and experienced
+! professionals having in-depth computer knowledge. Users are therefore
+! encouraged to load and test the software's suitability as regards their
+! requirements in conditions enabling the security of their systems and/or
+! data to be ensured and, more generally, to use and operate it in the
+! same conditions as regards security.
+!
+! The full text of the license is available at the end of this program
+! and in file "LICENSE".
+
+ program seismic_CPML_3D_iso_MPI_OpenMP
+
+! 3D elastic finite-difference code in velocity and stress formulation
+! with Convolutional-PML (C-PML) absorbing conditions.
+
+! Dimitri Komatitsch, University of Pau, France, April 2007.
+
+! The second-order staggered-grid formulation of Madariaga (1976) and Virieux (1986) is used.
+
+! The C-PML implementation is based in part on formulas given in Roden and Gedney (2000).
+!
+! Parallel implementation based on both MPI and OpenMP.
+! Type for instance "setenv OMP_NUM_THREADS 4" before running in OpenMP if you want 4 tasks.
+
+! The C-PML implementation is based in part on formulas given in Roden and Gedney (2000).
+! If you use this code for your own research, please cite some (or all) of these
+! articles:
+!
+! @ARTICLE{KoMa07,
+! author = {Dimitri Komatitsch and Roland Martin},
+! title = {An unsplit convolutional {P}erfectly {M}atched {L}ayer improved
+! at grazing incidence for the seismic wave equation},
+! journal = {Geophysics},
+! year = {2007},
+! volume = {72},
+! number = {5},
+! pages = {SM155-SM167},
+! doi = {10.1190/1.2757586}}
+!
+! @ARTICLE{MaKoEz08,
+! author = {Roland Martin and Dimitri Komatitsch and Abdela\^aziz Ezziani},
+! title = {An unsplit convolutional perfectly matched layer improved at grazing
+! incidence for seismic wave equation in poroelastic media},
+! journal = {Geophysics},
+! year = {2008},
+! volume = {73},
+! pages = {T51-T61},
+! number = {4},
+! doi = {10.1190/1.2939484}}
+!
+! @ARTICLE{MaKo09,
+! author = {Roland Martin and Dimitri Komatitsch},
+! title = {An unsplit convolutional perfectly matched layer technique improved
+! at grazing incidence for the viscoelastic wave equation},
+! journal = {Geophysical Journal International},
+! year = {2009},
+! volume = {179},
+! pages = {333-344},
+! number = {1},
+! doi = {10.1111/j.1365-246X.2009.04278.x}}
+!
+! @ARTICLE{MaKoGe08,
+! author = {Roland Martin and Dimitri Komatitsch and Stephen D. Gedney},
+! title = {A variational formulation of a stabilized unsplit convolutional perfectly
+! matched layer for the isotropic or anisotropic seismic wave equation},
+! journal = {Computer Modeling in Engineering and Sciences},
+! year = {2008},
+! volume = {37},
+! pages = {274-304},
+! number = {3}}
+!
+! The original CPML technique for Maxwell's equations is described in:
+!
+! @ARTICLE{RoGe00,
+! author = {J. A. Roden and S. D. Gedney},
+! title = {Convolution {PML} ({CPML}): {A}n Efficient {FDTD} Implementation
+! of the {CFS}-{PML} for Arbitrary Media},
+! journal = {Microwave and Optical Technology Letters},
+! year = {2000},
+! volume = {27},
+! number = {5},
+! pages = {334-339},
+! doi = {10.1002/1098-2760(20001205)27:5<334::AID-MOP14>3.0.CO;2-A}}
+
+! To display the results as color images in the selected 2D cut plane, use:
+!
+! " display image*.gif " or " gimp image*.gif "
+!
+! or
+!
+! " montage -geometry +0+3 -rotate 90 -tile 1x21 image*Vx*.gif allfiles_Vx.gif "
+! " montage -geometry +0+3 -rotate 90 -tile 1x21 image*Vy*.gif allfiles_Vy.gif "
+! then " display allfiles_Vx.gif " or " gimp allfiles_Vx.gif "
+! then " display allfiles_Vy.gif " or " gimp allfiles_Vy.gif "
+!
+
+ implicit none
+
+! header which contains standard MPI declarations
+ include 'mpif.h'
+
+! total number of grid points in each direction of the grid
+ integer, parameter :: NX = 101
+ integer, parameter :: NY = 641
+ integer, parameter :: NZ = 640 ! even number in order to cut along Z axis
+
+! number of processes used in the MPI run
+! and local number of points (for simplicity we cut the mesh along Z only)
+ integer, parameter :: NPROC = 64
+ integer, parameter :: NZ_LOCAL = NZ / NPROC
+
+! size of a grid cell
+ double precision, parameter :: DELTAX = 10.d0, ONE_OVER_DELTAX = 1.d0 / DELTAX
+ double precision, parameter :: DELTAY = DELTAX, DELTAZ = DELTAX
+ double precision, parameter :: ONE_OVER_DELTAY = ONE_OVER_DELTAX, ONE_OVER_DELTAZ = ONE_OVER_DELTAX
+
+! P-velocity, S-velocity and density
+ double precision, parameter :: cp = 3300.d0
+ double precision, parameter :: cs = cp / 1.732d0
+ double precision, parameter :: rho = 2800.d0
+ double precision, parameter :: mu = rho*cs*cs
+ double precision, parameter :: lambda = rho*(cp*cp - 2.d0*cs*cs)
+ double precision, parameter :: lambdaplustwomu = rho*cp*cp
+
+! total number of time steps
+ integer, parameter :: NSTEP = 2500
+
+! time step in seconds
+ double precision, parameter :: DELTAT = 1.6d-3
+
+! parameters for the source
+ double precision, parameter :: f0 = 7.d0
+ double precision, parameter :: t0 = 1.20d0 / f0
+ double precision, parameter :: factor = 1.d7
+
+! flags to add PML layers to the edges of the grid
+ logical, parameter :: USE_PML_XMIN = .true.
+ logical, parameter :: USE_PML_XMAX = .true.
+ logical, parameter :: USE_PML_YMIN = .true.
+ logical, parameter :: USE_PML_YMAX = .true.
+ logical, parameter :: USE_PML_ZMIN = .true.
+ logical, parameter :: USE_PML_ZMAX = .true.
+
+! thickness of the PML layer in grid points
+ integer, parameter :: NPOINTS_PML = 10
+
+! source
+ integer, parameter :: ISOURCE = NX - 2*NPOINTS_PML - 1
+ integer, parameter :: JSOURCE = 2 * NY / 3 + 1
+ double precision, parameter :: xsource = (ISOURCE - 1) * DELTAX
+ double precision, parameter :: ysource = (JSOURCE - 1) * DELTAY
+! angle of source force clockwise with respect to vertical (Y) axis
+ double precision, parameter :: ANGLE_FORCE = 135.d0
+
+! receivers
+ integer, parameter :: NREC = 2
+ double precision, parameter :: xdeb = xsource - 100.d0 ! first receiver x in meters
+ double precision, parameter :: ydeb = 2300.d0 ! first receiver y in meters
+ double precision, parameter :: xfin = xsource ! last receiver x in meters
+ double precision, parameter :: yfin = 300.d0 ! last receiver y in meters
+
+! display information on the screen from time to time
+ integer, parameter :: IT_DISPLAY = 100
+
+! value of PI
+ double precision, parameter :: PI = 3.141592653589793238462643d0
+
+! conversion from degrees to radians
+ double precision, parameter :: DEGREES_TO_RADIANS = PI / 180.d0
+
+! zero
+ double precision, parameter :: ZERO = 0.d0
+
+! large value for maximum
+ double precision, parameter :: HUGEVAL = 1.d+30
+
+! velocity threshold above which we consider that the code became unstable
+ double precision, parameter :: STABILITY_THRESHOLD = 1.d+25
+
+! power to compute d0 profile
+ double precision, parameter :: NPOWER = 2.d0
+
+ double precision, parameter :: K_MAX_PML = 1.d0 ! from Gedney page 8.11
+ double precision, parameter :: ALPHA_MAX_PML = 2.d0*PI*(f0/2.d0) ! from festa and Vilotte
+
+! arrays for the memory variables
+! could declare these arrays in PML only to save a lot of memory, but proof of concept only here
+ double precision, dimension(NX,NY,NZ_LOCAL) :: &
+ memory_dvx_dx, &
+ memory_dvx_dy, &
+ memory_dvx_dz, &
+ memory_dvy_dx, &
+ memory_dvy_dy, &
+ memory_dvy_dz, &
+ memory_dvz_dx, &
+ memory_dvz_dy, &
+ memory_dvz_dz, &
+ memory_dsigmaxx_dx, &
+ memory_dsigmayy_dy, &
+ memory_dsigmazz_dz, &
+ memory_dsigmaxy_dx, &
+ memory_dsigmaxy_dy, &
+ memory_dsigmaxz_dx, &
+ memory_dsigmaxz_dz, &
+ memory_dsigmayz_dy, &
+ memory_dsigmayz_dz
+
+ double precision :: &
+ value_dvx_dx, &
+ value_dvx_dy, &
+ value_dvx_dz, &
+ value_dvy_dx, &
+ value_dvy_dy, &
+ value_dvy_dz, &
+ value_dvz_dx, &
+ value_dvz_dy, &
+ value_dvz_dz, &
+ value_dsigmaxx_dx, &
+ value_dsigmayy_dy, &
+ value_dsigmazz_dz, &
+ value_dsigmaxy_dx, &
+ value_dsigmaxy_dy, &
+ value_dsigmaxz_dx, &
+ value_dsigmaxz_dz, &
+ value_dsigmayz_dy, &
+ value_dsigmayz_dz
+
+! 1D arrays for the damping profiles
+ double precision, dimension(NX) :: d_x,K_x,alpha_prime_x,a_x,b_x,d_x_half,K_x_half,alpha_prime_x_half,a_x_half,b_x_half
+ double precision, dimension(NY) :: d_y,K_y,alpha_prime_y,a_y,b_y,d_y_half,K_y_half,alpha_prime_y_half,a_y_half,b_y_half
+ double precision, dimension(NZ) :: d_z,K_z,alpha_prime_z,a_z,b_z,d_z_half,K_z_half,alpha_prime_z_half,a_z_half,b_z_half
+
+! PML
+ double precision thickness_PML_x,thickness_PML_y,thickness_PML_z
+ double precision xoriginleft,xoriginright,yoriginbottom,yorigintop,zoriginbottom,zorigintop
+ double precision Rcoef,d0_x,d0_y,d0_z,xval,yval,zval,abscissa_in_PML,abscissa_normalized
+
+! change dimension of Z axis to add two planes for MPI
+ double precision, dimension(NX,NY,0:NZ_LOCAL+1) :: vx,vy,vz,sigmaxx,sigmayy,sigmazz,sigmaxy,sigmaxz,sigmayz
+
+ integer, parameter :: number_of_arrays = 9 + 2*9
+
+! for the source
+ double precision a,t,force_x,force_y,source_term
+
+! for receivers
+ double precision xspacerec,yspacerec,distval,dist
+ integer, dimension(NREC) :: ix_rec,iy_rec
+ double precision, dimension(NREC) :: xrec,yrec
+
+! for seismograms
+ double precision, dimension(NSTEP,NREC) :: sisvx,sisvy
+
+! for evolution of total energy in the medium
+ double precision :: epsilon_xx,epsilon_yy,epsilon_zz,epsilon_xy,epsilon_xz,epsilon_yz
+ double precision :: total_energy_kinetic,total_energy_potential
+ double precision, dimension(NSTEP) :: total_energy
+
+ integer :: irec
+
+! precompute some parameters once and for all
+ double precision, parameter :: DELTAT_lambda = DELTAT*lambda
+ double precision, parameter :: DELTAT_mu = DELTAT*mu
+ double precision, parameter :: DELTAT_lambdaplus2mu = DELTAT*lambdaplustwomu
+
+ double precision, parameter :: DELTAT_over_rho = DELTAT/rho
+
+ integer :: i,j,k,it
+
+ double precision :: Vsolidnorm,Courant_number
+
+! timer to count elapsed time
+ character(len=8) datein
+ character(len=10) timein
+ character(len=5) :: zone
+ integer, dimension(8) :: time_values
+ integer ihours,iminutes,iseconds,int_tCPU
+ double precision :: time_start,time_end,tCPU
+
+! names of the time stamp files
+ character(len=150) outputname
+
+! main I/O file
+ integer, parameter :: IOUT = 41
+
+! array needed for MPI_RECV
+ integer, dimension(MPI_STATUS_SIZE) :: message_status
+
+! tag of the message to send
+ integer, parameter :: message_tag = 0
+
+! number of values to send or receive
+ integer, parameter :: number_of_values = NX*NY
+
+ integer :: nb_procs,rank,code,rank_cut_plane,kmin,kmax,kglobal,offset_k,k2begin,kminus1end
+ integer :: sender_right_shift,receiver_right_shift,sender_left_shift,receiver_left_shift
+
+!---
+!--- program starts here
+!---
+
+! start MPI processes
+ call MPI_INIT(code)
+
+! get total number of MPI processes in variable nb_procs
+ call MPI_COMM_SIZE(MPI_COMM_WORLD, nb_procs, code)
+
+! get the rank of our process from 0 (master) to nb_procs-1 (workers)
+ call MPI_COMM_RANK(MPI_COMM_WORLD, rank, code)
+
+! slice number for the cut plane in the middle of the mesh
+ rank_cut_plane = nb_procs/2 - 1
+
+ if(rank == rank_cut_plane) then
+
+ print *
+ print *,'3D elastic finite-difference code in velocity and stress formulation with C-PML'
+ print *
+
+! display size of the model
+ print *
+ print *,'NX = ',NX
+ print *,'NY = ',NY
+ print *,'NZ = ',NZ
+ print *
+ print *,'NZ_LOCAL = ',NZ_LOCAL
+ print *,'NPROC = ',NPROC
+ print *
+ print *,'size of the model along X = ',(NX - 1) * DELTAX
+ print *,'size of the model along Y = ',(NY - 1) * DELTAY
+ print *,'size of the model along Y = ',(NZ - 1) * DELTAZ
+ print *
+ print *,'Total number of grid points = ',NX * NY * NZ
+ print *,'Number of points of all the arrays = ',dble(NX)*dble(NY)*dble(NZ)*number_of_arrays
+ print *,'Size in GB of all the arrays = ',dble(NX)*dble(NY)*dble(NZ)*number_of_arrays*8.d0/(1024.d0*1024.d0*1024.d0)
+ print *
+ print *,'In each slice:'
+ print *
+ print *,'Total number of grid points = ',NX * NY * NZ_LOCAL
+ print *,'Number of points of the arrays = ',dble(NX)*dble(NY)*dble(NZ_LOCAL)*number_of_arrays
+ print *,'Size in GB of the arrays = ',dble(NX)*dble(NY)*dble(NZ_LOCAL)*number_of_arrays*8.d0/(1024.d0*1024.d0*1024.d0)
+ print *
+
+ endif
+
+! check that code was compiled with the right number of slices
+ if(nb_procs /= NPROC) then
+ print *,'nb_procs,NPROC = ',nb_procs,NPROC
+ stop 'nb_procs must be equal to NPROC'
+ endif
+
+! we restrict ourselves to an even number of slices
+! in order to have a cut plane in the middle of the mesh for visualization purposes
+ if(mod(nb_procs,2) /= 0) stop 'nb_procs must be even'
+
+! check that we can cut along Z in an exact number of slices
+ if(mod(NZ,nb_procs) /= 0) stop 'NZ must be a multiple of nb_procs'
+
+! check that a slice is at least as thick as a PML layer
+ if(NZ_LOCAL < NPOINTS_PML) stop 'NZ_LOCAL must be greater than NPOINTS_PML'
+
+! offset of this slice when we cut along Z
+ offset_k = rank * NZ_LOCAL
+
+!--- define profile of absorption in PML region
+
+! thickness of the PML layer in meters
+ thickness_PML_x = NPOINTS_PML * DELTAX
+ thickness_PML_y = NPOINTS_PML * DELTAY
+ thickness_PML_z = NPOINTS_PML * DELTAZ
+
+! reflection coefficient (INRIA report section 6.1)
+ Rcoef = 0.001d0
+
+! check that NPOWER is okay
+ if(NPOWER < 1) stop 'NPOWER must be greater than 1'
+
+! compute d0 from INRIA report section 6.1
+ d0_x = - (NPOWER + 1) * cp * log(Rcoef) / (2.d0 * thickness_PML_x)
+ d0_y = - (NPOWER + 1) * cp * log(Rcoef) / (2.d0 * thickness_PML_y)
+ d0_z = - (NPOWER + 1) * cp * log(Rcoef) / (2.d0 * thickness_PML_z)
+
+ if(rank == rank_cut_plane) then
+ print *
+ print *,'d0_x = ',d0_x
+ print *,'d0_y = ',d0_y
+ print *,'d0_z = ',d0_z
+ endif
+
+! PML
+ d_x(:) = ZERO
+ d_x_half(:) = ZERO
+ K_x(:) = 1.d0
+ K_x_half(:) = 1.d0
+ alpha_prime_x(:) = ZERO
+ alpha_prime_x_half(:) = ZERO
+ a_x(:) = ZERO
+ a_x_half(:) = ZERO
+
+ d_y(:) = ZERO
+ d_y_half(:) = ZERO
+ K_y(:) = 1.d0
+ K_y_half(:) = 1.d0
+ alpha_prime_y(:) = ZERO
+ alpha_prime_y_half(:) = ZERO
+ a_y(:) = ZERO
+ a_y_half(:) = ZERO
+
+ d_z(:) = ZERO
+ d_z_half(:) = ZERO
+ K_z(:) = 1.d0
+ K_z_half(:) = 1.d0
+ alpha_prime_z(:) = ZERO
+ alpha_prime_z_half(:) = ZERO
+ a_z(:) = ZERO
+ a_z_half(:) = ZERO
+
+! damping in the X direction
+
+! origin of the PML layer (position of right edge minus thickness, in meters)
+ xoriginleft = thickness_PML_x
+ xoriginright = (NX-1)*DELTAX - thickness_PML_x
+
+ do i = 1,NX
+
+! abscissa of current grid point along the damping profile
+ xval = DELTAX * dble(i-1)
+
+!---------- xmin edge
+ if(USE_PML_XMIN) then
+
+! define damping profile at the grid points
+ abscissa_in_PML = xoriginleft - xval
+ if(abscissa_in_PML >= ZERO) then
+ abscissa_normalized = abscissa_in_PML / thickness_PML_x
+ d_x(i) = d0_x * abscissa_normalized**NPOWER
+! this taken from Gedney page 8.2
+ K_x(i) = 1.d0 + (K_MAX_PML - 1.d0) * abscissa_normalized**NPOWER
+ alpha_prime_x(i) = ALPHA_MAX_PML * (1.d0 - abscissa_normalized)
+ endif
+
+! define damping profile at half the grid points
+ abscissa_in_PML = xoriginleft - (xval + DELTAX/2.d0)
+ if(abscissa_in_PML >= ZERO) then
+ abscissa_normalized = abscissa_in_PML / thickness_PML_x
+ d_x_half(i) = d0_x * abscissa_normalized**NPOWER
+! this taken from Gedney page 8.2
+ K_x_half(i) = 1.d0 + (K_MAX_PML - 1.d0) * abscissa_normalized**NPOWER
+ alpha_prime_x_half(i) = ALPHA_MAX_PML * (1.d0 - abscissa_normalized)
+ endif
+
+ endif
+
+!---------- xmax edge
+ if(USE_PML_XMAX) then
+
+! define damping profile at the grid points
+ abscissa_in_PML = xval - xoriginright
+ if(abscissa_in_PML >= ZERO) then
+ abscissa_normalized = abscissa_in_PML / thickness_PML_x
+ d_x(i) = d0_x * abscissa_normalized**NPOWER
+! this taken from Gedney page 8.2
+ K_x(i) = 1.d0 + (K_MAX_PML - 1.d0) * abscissa_normalized**NPOWER
+ alpha_prime_x(i) = ALPHA_MAX_PML * (1.d0 - abscissa_normalized)
+ endif
+
+! define damping profile at half the grid points
+ abscissa_in_PML = xval + DELTAX/2.d0 - xoriginright
+ if(abscissa_in_PML >= ZERO) then
+ abscissa_normalized = abscissa_in_PML / thickness_PML_x
+ d_x_half(i) = d0_x * abscissa_normalized**NPOWER
+! this taken from Gedney page 8.2
+ K_x_half(i) = 1.d0 + (K_MAX_PML - 1.d0) * abscissa_normalized**NPOWER
+ alpha_prime_x_half(i) = ALPHA_MAX_PML * (1.d0 - abscissa_normalized)
+ endif
+
+ endif
+
+! just in case, for -5 at the end
+ if(alpha_prime_x(i) < ZERO) alpha_prime_x(i) = ZERO
+ if(alpha_prime_x_half(i) < ZERO) alpha_prime_x_half(i) = ZERO
+
+ b_x(i) = exp(- (d_x(i) / K_x(i) + alpha_prime_x(i)) * DELTAT)
+ b_x_half(i) = exp(- (d_x_half(i) / K_x_half(i) + alpha_prime_x_half(i)) * DELTAT)
+
+! this to avoid division by zero outside the PML
+ if(abs(d_x(i)) > 1.d-6) a_x(i) = d_x(i) * (b_x(i) - 1.d0) / (K_x(i) * (d_x(i) + K_x(i) * alpha_prime_x(i)))
+ if(abs(d_x_half(i)) > 1.d-6) a_x_half(i) = d_x_half(i) * &
+ (b_x_half(i) - 1.d0) / (K_x_half(i) * (d_x_half(i) + K_x_half(i) * alpha_prime_x_half(i)))
+
+ enddo
+
+! damping in the Y direction
+
+! origin of the PML layer (position of right edge minus thickness, in meters)
+ yoriginbottom = thickness_PML_y
+ yorigintop = (NY-1)*DELTAY - thickness_PML_y
+
+ do j = 1,NY
+
+! abscissa of current grid point along the damping profile
+ yval = DELTAY * dble(j-1)
+
+!---------- ymin edge
+ if(USE_PML_YMIN) then
+
+! define damping profile at the grid points
+ abscissa_in_PML = yoriginbottom - yval
+ if(abscissa_in_PML >= ZERO) then
+ abscissa_normalized = abscissa_in_PML / thickness_PML_y
+ d_y(j) = d0_y * abscissa_normalized**NPOWER
+! this taken from Gedney page 8.2
+ K_y(j) = 1.d0 + (K_MAX_PML - 1.d0) * abscissa_normalized**NPOWER
+ alpha_prime_y(j) = ALPHA_MAX_PML * (1.d0 - abscissa_normalized)
+ endif
+
+! define damping profile at half the grid points
+ abscissa_in_PML = yoriginbottom - (yval + DELTAY/2.d0)
+ if(abscissa_in_PML >= ZERO) then
+ abscissa_normalized = abscissa_in_PML / thickness_PML_y
+ d_y_half(j) = d0_y * abscissa_normalized**NPOWER
+! this taken from Gedney page 8.2
+ K_y_half(j) = 1.d0 + (K_MAX_PML - 1.d0) * abscissa_normalized**NPOWER
+ alpha_prime_y_half(j) = ALPHA_MAX_PML * (1.d0 - abscissa_normalized)
+ endif
+
+ endif
+
+!---------- ymax edge
+ if(USE_PML_YMAX) then
+
+! define damping profile at the grid points
+ abscissa_in_PML = yval - yorigintop
+ if(abscissa_in_PML >= ZERO) then
+ abscissa_normalized = abscissa_in_PML / thickness_PML_y
+ d_y(j) = d0_y * abscissa_normalized**NPOWER
+! this taken from Gedney page 8.2
+ K_y(j) = 1.d0 + (K_MAX_PML - 1.d0) * abscissa_normalized**NPOWER
+ alpha_prime_y(j) = ALPHA_MAX_PML * (1.d0 - abscissa_normalized)
+ endif
+
+! define damping profile at half the grid points
+ abscissa_in_PML = yval + DELTAY/2.d0 - yorigintop
+ if(abscissa_in_PML >= ZERO) then
+ abscissa_normalized = abscissa_in_PML / thickness_PML_y
+ d_y_half(j) = d0_y * abscissa_normalized**NPOWER
+! this taken from Gedney page 8.2
+ K_y_half(j) = 1.d0 + (K_MAX_PML - 1.d0) * abscissa_normalized**NPOWER
+ alpha_prime_y_half(j) = ALPHA_MAX_PML * (1.d0 - abscissa_normalized)
+ endif
+
+ endif
+
+ b_y(j) = exp(- (d_y(j) / K_y(j) + alpha_prime_y(j)) * DELTAT)
+ b_y_half(j) = exp(- (d_y_half(j) / K_y_half(j) + alpha_prime_y_half(j)) * DELTAT)
+
+! this to avoid division by zero outside the PML
+ if(abs(d_y(j)) > 1.d-6) a_y(j) = d_y(j) * (b_y(j) - 1.d0) / (K_y(j) * (d_y(j) + K_y(j) * alpha_prime_y(j)))
+ if(abs(d_y_half(j)) > 1.d-6) a_y_half(j) = d_y_half(j) * &
+ (b_y_half(j) - 1.d0) / (K_y_half(j) * (d_y_half(j) + K_y_half(j) * alpha_prime_y_half(j)))
+
+ enddo
+
+! damping in the Z direction
+
+! origin of the PML layer (position of right edge minus thickness, in meters)
+ zoriginbottom = thickness_PML_z
+ zorigintop = (NZ-1)*DELTAZ - thickness_PML_z
+
+ do k = 1,NZ
+
+! abscissa of current grid point along the damping profile
+ zval = DELTAZ * dble(k-1)
+
+!---------- zmin edge
+ if(USE_PML_ZMIN) then
+
+! define damping profile at the grid points
+ abscissa_in_PML = zoriginbottom - zval
+ if(abscissa_in_PML >= ZERO) then
+ abscissa_normalized = abscissa_in_PML / thickness_PML_z
+ d_z(k) = d0_z * abscissa_normalized**NPOWER
+! this taken from Gedney page 8.2
+ K_z(k) = 1.d0 + (K_MAX_PML - 1.d0) * abscissa_normalized**NPOWER
+ alpha_prime_z(k) = ALPHA_MAX_PML * (1.d0 - abscissa_normalized)
+ endif
+
+! define damping profile at half the grid points
+ abscissa_in_PML = zoriginbottom - (zval + DELTAZ/2.d0)
+ if(abscissa_in_PML >= ZERO) then
+ abscissa_normalized = abscissa_in_PML / thickness_PML_z
+ d_z_half(k) = d0_z * abscissa_normalized**NPOWER
+! this taken from Gedney page 8.2
+ K_z_half(k) = 1.d0 + (K_MAX_PML - 1.d0) * abscissa_normalized**NPOWER
+ alpha_prime_z_half(k) = ALPHA_MAX_PML * (1.d0 - abscissa_normalized)
+ endif
+
+ endif
+
+!---------- zmax edge
+ if(USE_PML_ZMAX) then
+
+! define damping profile at the grid points
+ abscissa_in_PML = zval - zorigintop
+ if(abscissa_in_PML >= ZERO) then
+ abscissa_normalized = abscissa_in_PML / thickness_PML_z
+ d_z(k) = d0_z * abscissa_normalized**NPOWER
+! this taken from Gedney page 8.2
+ K_z(k) = 1.d0 + (K_MAX_PML - 1.d0) * abscissa_normalized**NPOWER
+ alpha_prime_z(k) = ALPHA_MAX_PML * (1.d0 - abscissa_normalized)
+ endif
+
+! define damping profile at half the grid points
+ abscissa_in_PML = zval + DELTAZ/2.d0 - zorigintop
+ if(abscissa_in_PML >= ZERO) then
+ abscissa_normalized = abscissa_in_PML / thickness_PML_z
+ d_z_half(k) = d0_z * abscissa_normalized**NPOWER
+! this taken from Gedney page 8.2
+ K_z_half(k) = 1.d0 + (K_MAX_PML - 1.d0) * abscissa_normalized**NPOWER
+ alpha_prime_z_half(k) = ALPHA_MAX_PML * (1.d0 - abscissa_normalized)
+ endif
+
+ endif
+
+ b_z(k) = exp(- (d_z(k) / K_z(k) + alpha_prime_z(k)) * DELTAT)
+ b_z_half(k) = exp(- (d_z_half(k) / K_z_half(k) + alpha_prime_z_half(k)) * DELTAT)
+
+! this to avoid division by zero outside the PML
+ if(abs(d_z(k)) > 1.d-6) a_z(k) = d_z(k) * (b_z(k) - 1.d0) / (K_z(k) * (d_z(k) + K_z(k) * alpha_prime_z(k)))
+ if(abs(d_z_half(k)) > 1.d-6) a_z_half(k) = d_z_half(k) * &
+ (b_z_half(k) - 1.d0) / (K_z_half(k) * (d_z_half(k) + K_z_half(k) * alpha_prime_z_half(k)))
+
+ enddo
+
+ if(rank == rank_cut_plane) then
+
+! print position of the source
+ print *
+ print *,'Position of the source:'
+ print *
+ print *,'x = ',xsource
+ print *,'y = ',ysource
+ print *
+
+! define location of receivers
+ print *
+ print *,'There are ',nrec,' receivers'
+ print *
+ xspacerec = (xfin-xdeb) / dble(NREC-1)
+ yspacerec = (yfin-ydeb) / dble(NREC-1)
+ do irec=1,nrec
+ xrec(irec) = xdeb + dble(irec-1)*xspacerec
+ yrec(irec) = ydeb + dble(irec-1)*yspacerec
+ enddo
+
+! find closest grid point for each receiver
+ do irec=1,nrec
+ dist = HUGEVAL
+ do j = 1,NY
+ do i = 1,NX
+ distval = sqrt((DELTAX*dble(i-1) - xrec(irec))**2 + (DELTAY*dble(j-1) - yrec(irec))**2)
+ if(distval < dist) then
+ dist = distval
+ ix_rec(irec) = i
+ iy_rec(irec) = j
+ endif
+ enddo
+ enddo
+ print *,'receiver ',irec,' x_target,y_target = ',xrec(irec),yrec(irec)
+ print *,'closest grid point found at distance ',dist,' in i,j = ',ix_rec(irec),iy_rec(irec)
+ print *
+ enddo
+
+ endif
+
+! check the Courant stability condition for the explicit time scheme
+! R. Courant et K. O. Friedrichs et H. Lewy (1928)
+ Courant_number = cp * DELTAT * sqrt(1.d0/DELTAX**2 + 1.d0/DELTAY**2 + 1.d0/DELTAZ**2)
+ if(rank == rank_cut_plane) then
+ print *,'Courant number is ',Courant_number
+ print *
+ endif
+ if(Courant_number > 1.d0) stop 'time step is too large, simulation will be unstable'
+
+! erase main arrays
+ vx(:,:,:) = ZERO
+ vy(:,:,:) = ZERO
+ vz(:,:,:) = ZERO
+
+ sigmaxy(:,:,:) = ZERO
+ sigmayy(:,:,:) = ZERO
+ sigmazz(:,:,:) = ZERO
+ sigmaxz(:,:,:) = ZERO
+ sigmazz(:,:,:) = ZERO
+ sigmayz(:,:,:) = ZERO
+
+! PML
+ memory_dvx_dx(:,:,:) = ZERO
+ memory_dvx_dy(:,:,:) = ZERO
+ memory_dvx_dz(:,:,:) = ZERO
+ memory_dvy_dx(:,:,:) = ZERO
+ memory_dvy_dy(:,:,:) = ZERO
+ memory_dvy_dz(:,:,:) = ZERO
+ memory_dvz_dx(:,:,:) = ZERO
+ memory_dvz_dy(:,:,:) = ZERO
+ memory_dvz_dz(:,:,:) = ZERO
+ memory_dsigmaxx_dx(:,:,:) = ZERO
+ memory_dsigmayy_dy(:,:,:) = ZERO
+ memory_dsigmazz_dz(:,:,:) = ZERO
+ memory_dsigmaxy_dx(:,:,:) = ZERO
+ memory_dsigmaxy_dy(:,:,:) = ZERO
+ memory_dsigmaxz_dx(:,:,:) = ZERO
+ memory_dsigmaxz_dz(:,:,:) = ZERO
+ memory_dsigmayz_dy(:,:,:) = ZERO
+ memory_dsigmayz_dz(:,:,:) = ZERO
+
+! erase seismograms
+ sisvx(:,:) = ZERO
+ sisvy(:,:) = ZERO
+
+! initialize total energy
+ total_energy(:) = ZERO
+
+ call date_and_time(datein,timein,zone,time_values)
+! time_values(3): day of the month
+! time_values(5): hour of the day
+! time_values(6): minutes of the hour
+! time_values(7): seconds of the minute
+! time_values(8): milliseconds of the second
+! this fails if we cross the end of the month
+ time_start = 86400.d0*time_values(3) + 3600.d0*time_values(5) + &
+ 60.d0*time_values(6) + time_values(7) + time_values(8) / 1000.d0
+
+!---
+
+! we receive from the process on the left, and send to the process on the right
+ sender_right_shift = rank - 1
+ receiver_right_shift = rank + 1
+
+! if we are the first process, there is no neighbor on the left
+ if(rank == 0) sender_right_shift = MPI_PROC_NULL
+
+! if we are the last process, there is no neighbor on the right
+ if(rank == nb_procs - 1) receiver_right_shift = MPI_PROC_NULL
+
+!---
+
+! we receive from the process on the right, and send to the process on the left
+ sender_left_shift = rank + 1
+ receiver_left_shift = rank - 1
+
+! if we are the first process, there is no neighbor on the left
+ if(rank == 0) receiver_left_shift = MPI_PROC_NULL
+
+! if we are the last process, there is no neighbor on the right
+ if(rank == nb_procs - 1) sender_left_shift = MPI_PROC_NULL
+
+ k2begin = 1
+ if(rank == 0) k2begin = 2
+
+ kminus1end = NZ_LOCAL
+ if(rank == nb_procs - 1) kminus1end = NZ_LOCAL - 1
+
+!---
+!--- beginning of time loop
+!---
+
+ do it = 1,NSTEP
+
+ if(rank == rank_cut_plane) print *,'it = ',it
+
+!----------------------
+! compute stress sigma
+!----------------------
+
+! vx(k+1), left shift
+ call MPI_SENDRECV(vx(:,:,1),number_of_values,MPI_DOUBLE_PRECISION, &
+ receiver_left_shift,message_tag,vx(:,:,NZ_LOCAL+1),number_of_values, &
+ MPI_DOUBLE_PRECISION,sender_left_shift,message_tag,MPI_COMM_WORLD,message_status,code)
+
+! vy(k+1), left shift
+ call MPI_SENDRECV(vy(:,:,1),number_of_values,MPI_DOUBLE_PRECISION, &
+ receiver_left_shift,message_tag,vy(:,:,NZ_LOCAL+1),number_of_values, &
+ MPI_DOUBLE_PRECISION,sender_left_shift,message_tag,MPI_COMM_WORLD,message_status,code)
+
+! vz(k-1), right shift
+ call MPI_SENDRECV(vz(:,:,NZ_LOCAL),number_of_values,MPI_DOUBLE_PRECISION, &
+ receiver_right_shift,message_tag,vz(:,:,0),number_of_values, &
+ MPI_DOUBLE_PRECISION,sender_right_shift,message_tag,MPI_COMM_WORLD,message_status,code)
+
+!$OMP PARALLEL DO DEFAULT(NONE) PRIVATE(kglobal,i,j,k,value_dvx_dx,value_dvx_dy, &
+!$OMP value_dvx_dz,value_dvy_dx,value_dvy_dy,value_dvy_dz,value_dvz_dx,value_dvz_dy, &
+!$OMP value_dvz_dz,value_dsigmaxx_dx,value_dsigmayy_dy,value_dsigmazz_dz, &
+!$OMP value_dsigmaxy_dx,value_dsigmaxy_dy,value_dsigmaxz_dx,value_dsigmaxz_dz, &
+!$OMP value_dsigmayz_dy,value_dsigmayz_dz) SHARED(vx,vy,vz,sigmaxx,sigmayy,sigmazz, &
+!$OMP sigmaxy,sigmaxz,sigmayz,memory_dvx_dx,memory_dvx_dy,memory_dvx_dz, &
+!$OMP memory_dvy_dx,memory_dvy_dy,memory_dvy_dz,memory_dvz_dx,memory_dvz_dy, &
+!$OMP memory_dvz_dz,memory_dsigmaxx_dx,memory_dsigmayy_dy,memory_dsigmazz_dz, &
+!$OMP memory_dsigmaxy_dx,memory_dsigmaxy_dy,memory_dsigmaxz_dx,memory_dsigmaxz_dz, &
+!$OMP memory_dsigmayz_dy,memory_dsigmayz_dz,a_x,b_x,K_x,a_x_half,b_x_half,K_x_half, &
+!$OMP a_y,b_y,K_y,a_y_half,b_y_half,K_y_half,a_z,b_z,K_z,a_z_half,b_z_half,K_z_half,k2begin,offset_k)
+ do k=k2begin,NZ_LOCAL
+ kglobal = k + offset_k
+ do j=2,NY
+ do i=1,NX-1
+
+ value_dvx_dx = (vx(i+1,j,k)-vx(i,j,k)) * ONE_OVER_DELTAX
+ value_dvy_dy = (vy(i,j,k)-vy(i,j-1,k)) * ONE_OVER_DELTAY
+ value_dvz_dz = (vz(i,j,k)-vz(i,j,k-1)) * ONE_OVER_DELTAZ
+
+ memory_dvx_dx(i,j,k) = b_x_half(i) * memory_dvx_dx(i,j,k) + a_x_half(i) * value_dvx_dx
+ memory_dvy_dy(i,j,k) = b_y(j) * memory_dvy_dy(i,j,k) + a_y(j) * value_dvy_dy
+ memory_dvz_dz(i,j,k) = b_z(kglobal) * memory_dvz_dz(i,j,k) + a_z(kglobal) * value_dvz_dz
+
+ value_dvx_dx = value_dvx_dx / K_x_half(i) + memory_dvx_dx(i,j,k)
+ value_dvy_dy = value_dvy_dy / K_y(j) + memory_dvy_dy(i,j,k)
+ value_dvz_dz = value_dvz_dz / K_z(kglobal) + memory_dvz_dz(i,j,k)
+
+ sigmaxx(i,j,k) = DELTAT_lambdaplus2mu*value_dvx_dx + &
+ DELTAT_lambda*(value_dvy_dy + value_dvz_dz) + sigmaxx(i,j,k)
+
+ sigmayy(i,j,k) = DELTAT_lambda*(value_dvx_dx + value_dvz_dz) + &
+ DELTAT_lambdaplus2mu*value_dvy_dy + sigmayy(i,j,k)
+
+ sigmazz(i,j,k) = DELTAT_lambda*(value_dvx_dx + value_dvy_dy) + DELTAT_lambdaplus2mu*value_dvz_dz + sigmazz(i,j,k)
+
+ enddo
+ enddo
+ enddo
+!$OMP END PARALLEL DO
+
+!$OMP PARALLEL DO DEFAULT(NONE) PRIVATE(kglobal,i,j,k,value_dvx_dx,value_dvx_dy, &
+!$OMP value_dvx_dz,value_dvy_dx,value_dvy_dy,value_dvy_dz,value_dvz_dx,value_dvz_dy, &
+!$OMP value_dvz_dz,value_dsigmaxx_dx,value_dsigmayy_dy,value_dsigmazz_dz, &
+!$OMP value_dsigmaxy_dx,value_dsigmaxy_dy,value_dsigmaxz_dx,value_dsigmaxz_dz, &
+!$OMP value_dsigmayz_dy,value_dsigmayz_dz) SHARED(vx,vy,vz,sigmaxx,sigmayy,sigmazz, &
+!$OMP sigmaxy,sigmaxz,sigmayz,memory_dvx_dx,memory_dvx_dy,memory_dvx_dz, &
+!$OMP memory_dvy_dx,memory_dvy_dy,memory_dvy_dz,memory_dvz_dx,memory_dvz_dy, &
+!$OMP memory_dvz_dz,memory_dsigmaxx_dx,memory_dsigmayy_dy,memory_dsigmazz_dz, &
+!$OMP memory_dsigmaxy_dx,memory_dsigmaxy_dy,memory_dsigmaxz_dx,memory_dsigmaxz_dz, &
+!$OMP memory_dsigmayz_dy,memory_dsigmayz_dz,a_x,b_x,K_x,a_x_half,b_x_half,K_x_half, &
+!$OMP a_y,b_y,K_y,a_y_half,b_y_half,K_y_half,a_z,b_z,K_z,a_z_half,b_z_half,K_z_half)
+ do k=1,NZ_LOCAL
+ do j=1,NY-1
+ do i=2,NX
+
+ value_dvy_dx = (vy(i,j,k)-vy(i-1,j,k)) * ONE_OVER_DELTAX
+ value_dvx_dy = (vx(i,j+1,k)-vx(i,j,k)) * ONE_OVER_DELTAY
+
+ memory_dvy_dx(i,j,k) = b_x(i) * memory_dvy_dx(i,j,k) + a_x(i) * value_dvy_dx
+ memory_dvx_dy(i,j,k) = b_y_half(j) * memory_dvx_dy(i,j,k) + a_y_half(j) * value_dvx_dy
+
+ value_dvy_dx = value_dvy_dx / K_x(i) + memory_dvy_dx(i,j,k)
+ value_dvx_dy = value_dvx_dy / K_y_half(j) + memory_dvx_dy(i,j,k)
+
+ sigmaxy(i,j,k) = DELTAT_mu*(value_dvy_dx + value_dvx_dy) + sigmaxy(i,j,k)
+
+ enddo
+ enddo
+ enddo
+!$OMP END PARALLEL DO
+
+!$OMP PARALLEL DO DEFAULT(NONE) PRIVATE(kglobal,i,j,k,value_dvx_dx,value_dvx_dy, &
+!$OMP value_dvx_dz,value_dvy_dx,value_dvy_dy,value_dvy_dz,value_dvz_dx,value_dvz_dy, &
+!$OMP value_dvz_dz,value_dsigmaxx_dx,value_dsigmayy_dy,value_dsigmazz_dz, &
+!$OMP value_dsigmaxy_dx,value_dsigmaxy_dy,value_dsigmaxz_dx,value_dsigmaxz_dz, &
+!$OMP value_dsigmayz_dy,value_dsigmayz_dz) SHARED(vx,vy,vz,sigmaxx,sigmayy,sigmazz, &
+!$OMP sigmaxy,sigmaxz,sigmayz,memory_dvx_dx,memory_dvx_dy,memory_dvx_dz, &
+!$OMP memory_dvy_dx,memory_dvy_dy,memory_dvy_dz,memory_dvz_dx,memory_dvz_dy, &
+!$OMP memory_dvz_dz,memory_dsigmaxx_dx,memory_dsigmayy_dy,memory_dsigmazz_dz, &
+!$OMP memory_dsigmaxy_dx,memory_dsigmaxy_dy,memory_dsigmaxz_dx,memory_dsigmaxz_dz, &
+!$OMP memory_dsigmayz_dy,memory_dsigmayz_dz,a_x,b_x,K_x,a_x_half,b_x_half,K_x_half, &
+!$OMP a_y,b_y,K_y,a_y_half,b_y_half,K_y_half,a_z,b_z,K_z,a_z_half,b_z_half,K_z_half,kminus1end,offset_k)
+ do k=1,kminus1end
+ kglobal = k + offset_k
+ do j=1,NY
+ do i=2,NX
+
+ value_dvz_dx = (vz(i,j,k)-vz(i-1,j,k)) * ONE_OVER_DELTAX
+ value_dvx_dz = (vx(i,j,k+1)-vx(i,j,k)) * ONE_OVER_DELTAZ
+
+ memory_dvz_dx(i,j,k) = b_x(i) * memory_dvz_dx(i,j,k) + a_x(i) * value_dvz_dx
+ memory_dvx_dz(i,j,k) = b_z_half(kglobal) * memory_dvx_dz(i,j,k) + a_z_half(kglobal) * value_dvx_dz
+
+ value_dvz_dx = value_dvz_dx / K_x(i) + memory_dvz_dx(i,j,k)
+ value_dvx_dz = value_dvx_dz / K_z_half(kglobal) + memory_dvx_dz(i,j,k)
+
+ sigmaxz(i,j,k) = DELTAT_mu*(value_dvz_dx + value_dvx_dz) + sigmaxz(i,j,k)
+
+ enddo
+ enddo
+
+ do j=1,NY-1
+ do i=1,NX
+
+ value_dvz_dy = (vz(i,j+1,k)-vz(i,j,k)) * ONE_OVER_DELTAY
+ value_dvy_dz = (vy(i,j,k+1)-vy(i,j,k)) * ONE_OVER_DELTAZ
+
+ memory_dvz_dy(i,j,k) = b_y_half(j) * memory_dvz_dy(i,j,k) + a_y_half(j) * value_dvz_dy
+ memory_dvy_dz(i,j,k) = b_z_half(kglobal) * memory_dvy_dz(i,j,k) + a_z_half(kglobal) * value_dvy_dz
+
+ value_dvz_dy = value_dvz_dy / K_y_half(j) + memory_dvz_dy(i,j,k)
+ value_dvy_dz = value_dvy_dz / K_z_half(kglobal) + memory_dvy_dz(i,j,k)
+
+ sigmayz(i,j,k) = DELTAT_mu*(value_dvz_dy + value_dvy_dz) + sigmayz(i,j,k)
+
+ enddo
+ enddo
+ enddo
+!$OMP END PARALLEL DO
+
+!------------------
+! compute velocity
+!------------------
+
+! sigmazz(k+1), left shift
+ call MPI_SENDRECV(sigmazz(:,:,1),number_of_values,MPI_DOUBLE_PRECISION, &
+ receiver_left_shift,message_tag,sigmazz(:,:,NZ_LOCAL+1),number_of_values, &
+ MPI_DOUBLE_PRECISION,sender_left_shift,message_tag,MPI_COMM_WORLD,message_status,code)
+
+! sigmayz(k-1), right shift
+ call MPI_SENDRECV(sigmayz(:,:,NZ_LOCAL),number_of_values,MPI_DOUBLE_PRECISION, &
+ receiver_right_shift,message_tag,sigmayz(:,:,0),number_of_values, &
+ MPI_DOUBLE_PRECISION,sender_right_shift,message_tag,MPI_COMM_WORLD,message_status,code)
+
+! sigmaxz(k-1), right shift
+ call MPI_SENDRECV(sigmaxz(:,:,NZ_LOCAL),number_of_values,MPI_DOUBLE_PRECISION, &
+ receiver_right_shift,message_tag,sigmaxz(:,:,0),number_of_values, &
+ MPI_DOUBLE_PRECISION,sender_right_shift,message_tag,MPI_COMM_WORLD,message_status,code)
+
+!$OMP PARALLEL DO DEFAULT(NONE) PRIVATE(kglobal,i,j,k,value_dvx_dx,value_dvx_dy, &
+!$OMP value_dvx_dz,value_dvy_dx,value_dvy_dy,value_dvy_dz,value_dvz_dx,value_dvz_dy, &
+!$OMP value_dvz_dz,value_dsigmaxx_dx,value_dsigmayy_dy,value_dsigmazz_dz, &
+!$OMP value_dsigmaxy_dx,value_dsigmaxy_dy,value_dsigmaxz_dx,value_dsigmaxz_dz, &
+!$OMP value_dsigmayz_dy,value_dsigmayz_dz) SHARED(vx,vy,vz,sigmaxx,sigmayy,sigmazz, &
+!$OMP sigmaxy,sigmaxz,sigmayz,memory_dvx_dx,memory_dvx_dy,memory_dvx_dz, &
+!$OMP memory_dvy_dx,memory_dvy_dy,memory_dvy_dz,memory_dvz_dx,memory_dvz_dy, &
+!$OMP memory_dvz_dz,memory_dsigmaxx_dx,memory_dsigmayy_dy,memory_dsigmazz_dz, &
+!$OMP memory_dsigmaxy_dx,memory_dsigmaxy_dy,memory_dsigmaxz_dx,memory_dsigmaxz_dz, &
+!$OMP memory_dsigmayz_dy,memory_dsigmayz_dz,a_x,b_x,K_x,a_x_half,b_x_half,K_x_half, &
+!$OMP a_y,b_y,K_y,a_y_half,b_y_half,K_y_half,a_z,b_z,K_z,a_z_half,b_z_half,K_z_half,k2begin,offset_k)
+ do k=k2begin,NZ_LOCAL
+ kglobal = k + offset_k
+ do j=2,NY
+ do i=2,NX
+
+ value_dsigmaxx_dx = (sigmaxx(i,j,k)-sigmaxx(i-1,j,k)) * ONE_OVER_DELTAX
+ value_dsigmaxy_dy = (sigmaxy(i,j,k)-sigmaxy(i,j-1,k)) * ONE_OVER_DELTAY
+ value_dsigmaxz_dz = (sigmaxz(i,j,k)-sigmaxz(i,j,k-1)) * ONE_OVER_DELTAZ
+
+ memory_dsigmaxx_dx(i,j,k) = b_x(i) * memory_dsigmaxx_dx(i,j,k) + a_x(i) * value_dsigmaxx_dx
+ memory_dsigmaxy_dy(i,j,k) = b_y(j) * memory_dsigmaxy_dy(i,j,k) + a_y(j) * value_dsigmaxy_dy
+ memory_dsigmaxz_dz(i,j,k) = b_z(kglobal) * memory_dsigmaxz_dz(i,j,k) + a_z(kglobal) * value_dsigmaxz_dz
+
+ value_dsigmaxx_dx = value_dsigmaxx_dx / K_x(i) + memory_dsigmaxx_dx(i,j,k)
+ value_dsigmaxy_dy = value_dsigmaxy_dy / K_y(j) + memory_dsigmaxy_dy(i,j,k)
+ value_dsigmaxz_dz = value_dsigmaxz_dz / K_z(kglobal) + memory_dsigmaxz_dz(i,j,k)
+
+ vx(i,j,k) = DELTAT_over_rho*(value_dsigmaxx_dx + value_dsigmaxy_dy + value_dsigmaxz_dz) + vx(i,j,k)
+
+ enddo
+ enddo
+
+ do j=1,NY-1
+ do i=1,NX-1
+
+ value_dsigmaxy_dx = (sigmaxy(i+1,j,k)-sigmaxy(i,j,k)) * ONE_OVER_DELTAX
+ value_dsigmayy_dy = (sigmayy(i,j+1,k)-sigmayy(i,j,k)) * ONE_OVER_DELTAY
+ value_dsigmayz_dz = (sigmayz(i,j,k)-sigmayz(i,j,k-1)) * ONE_OVER_DELTAZ
+
+ memory_dsigmaxy_dx(i,j,k) = b_x_half(i) * memory_dsigmaxy_dx(i,j,k) + a_x_half(i) * value_dsigmaxy_dx
+ memory_dsigmayy_dy(i,j,k) = b_y_half(j) * memory_dsigmayy_dy(i,j,k) + a_y_half(j) * value_dsigmayy_dy
+ memory_dsigmayz_dz(i,j,k) = b_z(kglobal) * memory_dsigmayz_dz(i,j,k) + a_z(kglobal) * value_dsigmayz_dz
+
+ value_dsigmaxy_dx = value_dsigmaxy_dx / K_x_half(i) + memory_dsigmaxy_dx(i,j,k)
+ value_dsigmayy_dy = value_dsigmayy_dy / K_y_half(j) + memory_dsigmayy_dy(i,j,k)
+ value_dsigmayz_dz = value_dsigmayz_dz / K_z(kglobal) + memory_dsigmayz_dz(i,j,k)
+
+ vy(i,j,k) = DELTAT_over_rho*(value_dsigmaxy_dx + value_dsigmayy_dy + value_dsigmayz_dz) + vy(i,j,k)
+
+ enddo
+ enddo
+ enddo
+!$OMP END PARALLEL DO
+
+!$OMP PARALLEL DO DEFAULT(NONE) PRIVATE(kglobal,i,j,k,value_dvx_dx,value_dvx_dy, &
+!$OMP value_dvx_dz,value_dvy_dx,value_dvy_dy,value_dvy_dz,value_dvz_dx,value_dvz_dy, &
+!$OMP value_dvz_dz,value_dsigmaxx_dx,value_dsigmayy_dy,value_dsigmazz_dz, &
+!$OMP value_dsigmaxy_dx,value_dsigmaxy_dy,value_dsigmaxz_dx,value_dsigmaxz_dz, &
+!$OMP value_dsigmayz_dy,value_dsigmayz_dz) SHARED(vx,vy,vz,sigmaxx,sigmayy,sigmazz, &
+!$OMP sigmaxy,sigmaxz,sigmayz,memory_dvx_dx,memory_dvx_dy,memory_dvx_dz, &
+!$OMP memory_dvy_dx,memory_dvy_dy,memory_dvy_dz,memory_dvz_dx,memory_dvz_dy, &
+!$OMP memory_dvz_dz,memory_dsigmaxx_dx,memory_dsigmayy_dy,memory_dsigmazz_dz, &
+!$OMP memory_dsigmaxy_dx,memory_dsigmaxy_dy,memory_dsigmaxz_dx,memory_dsigmaxz_dz, &
+!$OMP memory_dsigmayz_dy,memory_dsigmayz_dz,a_x,b_x,K_x,a_x_half,b_x_half,K_x_half, &
+!$OMP a_y,b_y,K_y,a_y_half,b_y_half,K_y_half,a_z,b_z,K_z,a_z_half,b_z_half,K_z_half,kminus1end,offset_k)
+ do k=1,kminus1end
+ kglobal = k + offset_k
+ do j=2,NY
+ do i=1,NX-1
+
+ value_dsigmaxz_dx = (sigmaxz(i+1,j,k)-sigmaxz(i,j,k)) * ONE_OVER_DELTAX
+ value_dsigmayz_dy = (sigmayz(i,j,k)-sigmayz(i,j-1,k)) * ONE_OVER_DELTAY
+ value_dsigmazz_dz = (sigmazz(i,j,k+1)-sigmazz(i,j,k)) * ONE_OVER_DELTAZ
+
+ memory_dsigmaxz_dx(i,j,k) = b_x_half(i) * memory_dsigmaxz_dx(i,j,k) + a_x_half(i) * value_dsigmaxz_dx
+ memory_dsigmayz_dy(i,j,k) = b_y(j) * memory_dsigmayz_dy(i,j,k) + a_y(j) * value_dsigmayz_dy
+ memory_dsigmazz_dz(i,j,k) = b_z_half(kglobal) * memory_dsigmazz_dz(i,j,k) + a_z_half(kglobal) * value_dsigmazz_dz
+
+ value_dsigmaxz_dx = value_dsigmaxz_dx / K_x_half(i) + memory_dsigmaxz_dx(i,j,k)
+ value_dsigmayz_dy = value_dsigmayz_dy / K_y(j) + memory_dsigmayz_dy(i,j,k)
+ value_dsigmazz_dz = value_dsigmazz_dz / K_z_half(kglobal) + memory_dsigmazz_dz(i,j,k)
+
+ vz(i,j,k) = DELTAT_over_rho*(value_dsigmaxz_dx + value_dsigmayz_dy + value_dsigmazz_dz) + vz(i,j,k)
+
+ enddo
+ enddo
+ enddo
+!$OMP END PARALLEL DO
+
+ if(rank == rank_cut_plane) then
+
+! add the source (force vector located at a given grid point)
+ a = pi*pi*f0*f0
+ t = dble(it-1)*DELTAT
+
+! Gaussian
+! source_term = factor * exp(-a*(t-t0)**2)
+
+! first derivative of a Gaussian
+ source_term = - factor * 2.d0*a*(t-t0)*exp(-a*(t-t0)**2)
+
+! Ricker source time function (second derivative of a Gaussian)
+! source_term = factor * (1.d0 - 2.d0*a*(t-t0)**2)*exp(-a*(t-t0)**2)
+
+ force_x = sin(ANGLE_FORCE * DEGREES_TO_RADIANS) * source_term
+ force_y = cos(ANGLE_FORCE * DEGREES_TO_RADIANS) * source_term
+
+! define location of the source
+ i = ISOURCE
+ j = JSOURCE
+
+ vx(i,j,NZ_LOCAL) = vx(i,j,NZ_LOCAL) + force_x * DELTAT / rho
+ vy(i,j,NZ_LOCAL) = vy(i,j,NZ_LOCAL) + force_y * DELTAT / rho
+
+ endif
+
+! implement Dirichlet boundary conditions on the six edges of the grid
+
+!$OMP PARALLEL WORKSHARE
+! xmin
+ vx(1,:,:) = ZERO
+ vy(1,:,:) = ZERO
+ vz(1,:,:) = ZERO
+
+! xmax
+ vx(NX,:,:) = ZERO
+ vy(NX,:,:) = ZERO
+ vz(NX,:,:) = ZERO
+
+! ymin
+ vx(:,1,:) = ZERO
+ vy(:,1,:) = ZERO
+ vz(:,1,:) = ZERO
+
+! ymax
+ vx(:,NY,:) = ZERO
+ vy(:,NY,:) = ZERO
+ vz(:,NY,:) = ZERO
+!$OMP END PARALLEL WORKSHARE
+
+! zmin
+ if(rank == 0) then
+ vx(:,:,1) = ZERO
+ vy(:,:,1) = ZERO
+ vz(:,:,1) = ZERO
+ endif
+
+! zmax
+ if(rank == nb_procs-1) then
+ vx(:,:,NZ_LOCAL) = ZERO
+ vy(:,:,NZ_LOCAL) = ZERO
+ vz(:,:,NZ_LOCAL) = ZERO
+ endif
+
+! store seismograms
+ if(rank == rank_cut_plane) then
+ do irec = 1,NREC
+ sisvx(it,irec) = vx(ix_rec(irec),iy_rec(irec),NZ_LOCAL)
+ sisvy(it,irec) = vy(ix_rec(irec),iy_rec(irec),NZ_LOCAL)
+ enddo
+ endif
+
+! compute total energy in the medium (without the PML layers)
+ total_energy_kinetic = ZERO
+ total_energy_potential = ZERO
+
+ kmin = 1
+ kmax = NZ_LOCAL
+ if(rank == 0) kmin = NPOINTS_PML+1
+ if(rank == nb_procs-1) kmax = NZ_LOCAL-NPOINTS_PML
+
+!$OMP PARALLEL DO DEFAULT(NONE) PRIVATE(i,j,k,epsilon_xx,epsilon_yy,epsilon_zz,epsilon_xy,epsilon_xz,epsilon_yz) &
+!$OMP SHARED(kmin,kmax,vx,vy,vz,sigmaxx,sigmayy,sigmazz, &
+!$OMP sigmaxy,sigmaxz,sigmayz) REDUCTION(+:total_energy_kinetic,total_energy_potential)
+ do k = kmin,kmax
+ do j = NPOINTS_PML+1, NY-NPOINTS_PML
+ do i = NPOINTS_PML+1, NX-NPOINTS_PML
+
+! compute kinetic energy first, defined as 1/2 rho ||v||^2
+! in principle we should use rho_half_x_half_y instead of rho for vy
+! in order to interpolate density at the right location in the staggered grid cell
+! but in a homogeneous medium we can safely ignore it
+ total_energy_kinetic = total_energy_kinetic + 0.5d0 * rho*( &
+ vx(i,j,k)**2 + vy(i,j,k)**2 + vz(i,j,k)**2)
+
+! add potential energy, defined as 1/2 epsilon_ij sigma_ij
+! in principle we should interpolate the medium parameters at the right location
+! in the staggered grid cell but in a homogeneous medium we can safely ignore it
+
+! compute total field from split components
+ epsilon_xx = ((lambda + 2.d0*mu) * sigmaxx(i,j,k) - lambda * sigmayy(i,j,k) - &
+ lambda*sigmazz(i,j,k)) / (4.d0 * mu * (lambda + mu))
+ epsilon_yy = ((lambda + 2.d0*mu) * sigmayy(i,j,k) - lambda * sigmaxx(i,j,k) - &
+ lambda*sigmazz(i,j,k)) / (4.d0 * mu * (lambda + mu))
+ epsilon_zz = ((lambda + 2.d0*mu) * sigmazz(i,j,k) - lambda * sigmaxx(i,j,k) - &
+ lambda*sigmayy(i,j,k)) / (4.d0 * mu * (lambda + mu))
+ epsilon_xy = sigmaxy(i,j,k) / (2.d0 * mu)
+ epsilon_xz = sigmaxz(i,j,k) / (2.d0 * mu)
+ epsilon_yz = sigmayz(i,j,k) / (2.d0 * mu)
+
+ total_energy_potential = total_energy_potential + &
+ 0.5d0 * (epsilon_xx * sigmaxx(i,j,k) + epsilon_yy * sigmayy(i,j,k) + &
+ epsilon_yy * sigmayy(i,j,k)+ 2.d0 * epsilon_xy * sigmaxy(i,j,k) + &
+ 2.d0*epsilon_xz * sigmaxz(i,j,k)+2.d0*epsilon_yz * sigmayz(i,j,k))
+
+ enddo
+ enddo
+ enddo
+!$OMP END PARALLEL DO
+
+ call MPI_REDUCE(total_energy_kinetic + total_energy_potential,total_energy(it),1, &
+ MPI_DOUBLE_PRECISION,MPI_SUM,rank_cut_plane,MPI_COMM_WORLD,code)
+
+! output information
+ if(mod(it,IT_DISPLAY) == 0 .or. it == 5) then
+
+ call MPI_REDUCE(maxval(sqrt(vx(:,:,1:NZ_LOCAL)**2 + vy(:,:,1:NZ_LOCAL)**2 + &
+ vz(:,:,1:NZ_LOCAL)**2)),Vsolidnorm,1,MPI_DOUBLE_PRECISION,MPI_MAX,rank_cut_plane,MPI_COMM_WORLD,code)
+
+ if(rank == rank_cut_plane) then
+
+ print *,'Time step # ',it
+ print *,'Time: ',sngl((it-1)*DELTAT),' seconds'
+ print *,'Max norm velocity vector V (m/s) = ',Vsolidnorm
+ print *,'Total energy = ',total_energy(it)
+! check stability of the code, exit if unstable
+ if(Vsolidnorm > STABILITY_THRESHOLD) stop 'code became unstable and blew up in solid'
+
+! count elapsed wall-clock time
+ call date_and_time(datein,timein,zone,time_values)
+! time_values(3): day of the month
+! time_values(5): hour of the day
+! time_values(6): minutes of the hour
+! time_values(7): seconds of the minute
+! time_values(8): milliseconds of the second
+! this fails if we cross the end of the month
+ time_end = 86400.d0*time_values(3) + 3600.d0*time_values(5) + &
+ 60.d0*time_values(6) + time_values(7) + time_values(8) / 1000.d0
+
+! elapsed time since beginning of the simulation
+ tCPU = time_end - time_start
+ int_tCPU = int(tCPU)
+ ihours = int_tCPU / 3600
+ iminutes = (int_tCPU - 3600*ihours) / 60
+ iseconds = int_tCPU - 3600*ihours - 60*iminutes
+ write(*,*) 'Elapsed time in seconds = ',tCPU
+ write(*,"(' Elapsed time in hh:mm:ss = ',i4,' h ',i2.2,' m ',i2.2,' s')") ihours,iminutes,iseconds
+ write(*,*) 'Mean elapsed time per time step in seconds = ',tCPU/dble(it)
+ write(*,*)
+
+! write time stamp file to give information about progression of simulation
+ write(outputname,"('timestamp',i6.6)") it
+ open(unit=IOUT,file=outputname,status='unknown')
+ write(IOUT,*) 'Time step # ',it
+ write(IOUT,*) 'Time: ',sngl((it-1)*DELTAT),' seconds'
+ write(IOUT,*) 'Max norm velocity vector V (m/s) = ',Vsolidnorm
+ write(IOUT,*) 'Total energy = ',total_energy(it)
+ write(IOUT,*) 'Elapsed time in seconds = ',tCPU
+ write(IOUT,"(' Elapsed time in hh:mm:ss = ',i4,' h ',i2.2,' m ',i2.2,' s')") ihours,iminutes,iseconds
+ write(IOUT,*) 'Mean elapsed time per time step in seconds = ',tCPU/dble(it)
+ close(IOUT)
+
+! save seismograms
+ print *,'saving seismograms'
+ print *
+ call write_seismograms(sisvx,sisvy,NSTEP,NREC,DELTAT)
+
+ call create_2D_image(vx(:,:,NZ_LOCAL),NX,NY,it,ISOURCE,JSOURCE,ix_rec,iy_rec,nrec, &
+ NPOINTS_PML,USE_PML_XMIN,USE_PML_XMAX,USE_PML_YMIN,USE_PML_YMAX,1)
+ call create_2D_image(vy(:,:,NZ_LOCAL),NX,NY,it,ISOURCE,JSOURCE,ix_rec,iy_rec,nrec, &
+ NPOINTS_PML,USE_PML_XMIN,USE_PML_XMAX,USE_PML_YMIN,USE_PML_YMAX,2)
+
+ endif
+ endif
+
+! --- end of time loop
+ enddo
+
+ if(rank == rank_cut_plane) then
+
+! save seismograms
+ call write_seismograms(sisvx,sisvy,NSTEP,NREC,DELTAT)
+
+! save total energy
+ open(unit=20,file='energy.dat',status='unknown')
+ do it = 1,NSTEP
+ write(20,*) sngl(dble(it-1)*DELTAT),total_energy(it)
+ enddo
+ close(20)
+
+! create script for Gnuplot for total energy
+ open(unit=20,file='plot_energy',status='unknown')
+ write(20,*) '# set term x11'
+ write(20,*) 'set term postscript landscape monochrome dashed "Helvetica" 22'
+ write(20,*)
+ write(20,*) 'set xlabel "Time (s)"'
+ write(20,*) 'set ylabel "Total energy"'
+ write(20,*)
+ write(20,*) 'set output "collino3D_total_energy_semilog.eps"'
+ write(20,*) 'set logscale y'
+ write(20,*) 'plot "energy.dat" t ''Total energy'' w l 1'
+ write(20,*) 'pause -1 "Hit any key..."'
+ write(20,*)
+ close(20)
+
+! create script for Gnuplot
+ open(unit=20,file='plotgnu',status='unknown')
+ write(20,*) 'set term x11'
+ write(20,*) '# set term postscript landscape monochrome dashed "Helvetica" 22'
+ write(20,*)
+ write(20,*) 'set xlabel "Time (s)"'
+ write(20,*) 'set ylabel "Amplitude (m / s)"'
+ write(20,*)
+
+ write(20,*) 'set output "v_sigma_Vx_receiver_001.eps"'
+ write(20,*) 'plot "Vx_file_001.dat" t ''Vx C-PML'' w l 1'
+ write(20,*) 'pause -1 "Hit any key..."'
+ write(20,*)
+
+ write(20,*) 'set output "v_sigma_Vy_receiver_001.eps"'
+ write(20,*) 'plot "Vy_file_001.dat" t ''Vy C-PML'' w l 1'
+ write(20,*) 'pause -1 "Hit any key..."'
+ write(20,*)
+
+ write(20,*) 'set output "v_sigma_Vz_receiver_001.eps"'
+ write(20,*) 'plot "Vz_file_001.dat" t ''Vz C-PML'' w l 1'
+ write(20,*) 'pause -1 "Hit any key..."'
+ write(20,*)
+
+ write(20,*) 'set output "v_sigma_Vx_receiver_002.eps"'
+ write(20,*) 'plot "Vx_file_002.dat" t ''Vx C-PML'' w l 1'
+ write(20,*) 'pause -1 "Hit any key..."'
+ write(20,*)
+
+ write(20,*) 'set output "v_sigma_Vy_receiver_002.eps"'
+ write(20,*) 'plot "Vy_file_002.dat" t ''Vy C-PML'' w l 1'
+ write(20,*) 'pause -1 "Hit any key..."'
+ write(20,*)
+
+ write(20,*) 'set output "v_sigma_Vz_receiver_002.eps"'
+ write(20,*) 'plot "Vz_file_002.dat" t ''Vz C-PML'' w l 1'
+ write(20,*) 'pause -1 "Hit any key..."'
+ write(20,*)
+
+ close(20)
+
+ print *
+ print *,'End of the simulation'
+ print *
+
+ endif
+
+! close MPI program
+ call MPI_FINALIZE(code)
+
+ end program seismic_CPML_3D_iso_MPI_OpenMP
+
+!----
+!---- save the seismograms in ASCII text format
+!----
+
+ subroutine write_seismograms(sisvx,sisvy,nt,nrec,DELTAT)
+
+ implicit none
+
+ integer nt,nrec
+ double precision DELTAT
+
+ double precision sisvx(nt,nrec)
+ double precision sisvy(nt,nrec)
+
+ integer irec,it
+
+ character(len=100) file_name
+
+! X component
+ do irec=1,nrec
+ write(file_name,"('Vx_file_',i3.3,'.dat')") irec
+ open(unit=11,file=file_name,status='unknown')
+ do it=1,nt
+ write(11,*) sngl(dble(it-1)*DELTAT),' ',sngl(sisvx(it,irec))
+ enddo
+ close(11)
+ enddo
+
+! Y component
+ do irec=1,nrec
+ write(file_name,"('Vy_file_',i3.3,'.dat')") irec
+ open(unit=11,file=file_name,status='unknown')
+ do it=1,nt
+ write(11,*) sngl(dble(it-1)*DELTAT),' ',sngl(sisvy(it,irec))
+ enddo
+ close(11)
+ enddo
+
+ end subroutine write_seismograms
+
+!----
+!---- routine to create a color image of a given vector component
+!---- the image is created in PNM format and then converted to GIF
+!----
+
+ subroutine create_2D_image(image_data_2D,NX,NY,it,ISOURCE,JSOURCE,ix_rec,iy_rec,nrec, &
+ NPOINTS_PML,USE_PML_XMIN,USE_PML_XMAX,USE_PML_YMIN,USE_PML_YMAX,field_number)
+
+ implicit none
+
+! non linear display to enhance small amplitudes for graphics
+ double precision, parameter :: POWER_DISPLAY = 0.30d0
+
+! amplitude threshold above which we draw the color point
+ double precision, parameter :: cutvect = 0.01d0
+
+! use black or white background for points that are below the threshold
+ logical, parameter :: WHITE_BACKGROUND = .true.
+
+! size of cross and square in pixels drawn to represent the source and the receivers
+ integer, parameter :: width_cross = 5, thickness_cross = 1, size_square = 3
+
+ integer NX,NY,it,field_number,ISOURCE,JSOURCE,NPOINTS_PML,nrec
+ logical USE_PML_XMIN,USE_PML_XMAX,USE_PML_YMIN,USE_PML_YMAX
+
+ double precision, dimension(NX,NY) :: image_data_2D
+
+ integer, dimension(nrec) :: ix_rec,iy_rec
+
+ integer :: ix,iy,irec
+
+ character(len=100) :: file_name,system_command
+
+ integer :: R, G, B
+
+ double precision :: normalized_value,max_amplitude
+
+! open image file and create system command to convert image to more convenient format
+ if(field_number == 1) then
+ write(file_name,"('image',i6.6,'_Vx.pnm')") it
+ write(system_command,"('convert image',i6.6,'_Vx.pnm image',i6.6,'_Vx.gif ; rm image',i6.6,'_Vx.pnm')") it,it,it
+ else if(field_number == 2) then
+ write(file_name,"('image',i6.6,'_Vy.pnm')") it
+ write(system_command,"('convert image',i6.6,'_Vy.pnm image',i6.6,'_Vy.gif ; rm image',i6.6,'_Vy.pnm')") it,it,it
+ endif
+
+ open(unit=27, file=file_name, status='unknown')
+
+ write(27,"('P3')") ! write image in PNM P3 format
+
+ write(27,*) NX,NY ! write image size
+ write(27,*) '255' ! maximum value of each pixel color
+
+! compute maximum amplitude
+ max_amplitude = maxval(abs(image_data_2D))
+
+! image starts in upper-left corner in PNM format
+ do iy=NY,1,-1
+ do ix=1,NX
+
+! define data as vector component normalized to [-1:1] and rounded to nearest integer
+! keeping in mind that amplitude can be negative
+ normalized_value = image_data_2D(ix,iy) / max_amplitude
+
+! suppress values that are outside [-1:+1] to avoid small edge effects
+ if(normalized_value < -1.d0) normalized_value = -1.d0
+ if(normalized_value > 1.d0) normalized_value = 1.d0
+
+! draw an orange cross to represent the source
+ if((ix >= ISOURCE - width_cross .and. ix <= ISOURCE + width_cross .and. &
+ iy >= JSOURCE - thickness_cross .and. iy <= JSOURCE + thickness_cross) .or. &
+ (ix >= ISOURCE - thickness_cross .and. ix <= ISOURCE + thickness_cross .and. &
+ iy >= JSOURCE - width_cross .and. iy <= JSOURCE + width_cross)) then
+ R = 255
+ G = 157
+ B = 0
+
+! display two-pixel-thick black frame around the image
+ else if(ix <= 2 .or. ix >= NX-1 .or. iy <= 2 .or. iy >= NY-1) then
+ R = 0
+ G = 0
+ B = 0
+
+! display edges of the PML layers
+ else if((USE_PML_XMIN .and. ix == NPOINTS_PML) .or. &
+ (USE_PML_XMAX .and. ix == NX - NPOINTS_PML) .or. &
+ (USE_PML_YMIN .and. iy == NPOINTS_PML) .or. &
+ (USE_PML_YMAX .and. iy == NY - NPOINTS_PML)) then
+ R = 255
+ G = 150
+ B = 0
+
+! suppress all the values that are below the threshold
+ else if(abs(image_data_2D(ix,iy)) <= max_amplitude * cutvect) then
+
+! use a black or white background for points that are below the threshold
+ if(WHITE_BACKGROUND) then
+ R = 255
+ G = 255
+ B = 255
+ else
+ R = 0
+ G = 0
+ B = 0
+ endif
+
+! represent regular image points using red if value is positive, blue if negative
+ else if(normalized_value >= 0.d0) then
+ R = nint(255.d0*normalized_value**POWER_DISPLAY)
+ G = 0
+ B = 0
+ else
+ R = 0
+ G = 0
+ B = nint(255.d0*abs(normalized_value)**POWER_DISPLAY)
+ endif
+
+! draw a green square to represent the receivers
+ do irec = 1,nrec
+ if((ix >= ix_rec(irec) - size_square .and. ix <= ix_rec(irec) + size_square .and. &
+ iy >= iy_rec(irec) - size_square .and. iy <= iy_rec(irec) + size_square) .or. &
+ (ix >= ix_rec(irec) - size_square .and. ix <= ix_rec(irec) + size_square .and. &
+ iy >= iy_rec(irec) - size_square .and. iy <= iy_rec(irec) + size_square)) then
+! use dark green color
+ R = 30
+ G = 180
+ B = 60
+ endif
+ enddo
+
+! write color pixel
+ write(27,"(i3,' ',i3,' ',i3)") R,G,B
+
+ enddo
+ enddo
+
+! close file
+ close(27)
+
+! call the system to convert image to GIF (can be commented out if "call system" is missing in your compiler)
+! call system(system_command)
+
+ end subroutine create_2D_image
+
+!
+! CeCILL FREE SOFTWARE LICENSE AGREEMENT
+!
+! Notice
+!
+! This Agreement is a Free Software license agreement that is the result
+! of discussions between its authors in order to ensure compliance with
+! the two main principles guiding its drafting:
+!
+! * firstly, compliance with the principles governing the distribution
+! of Free Software: access to source code, broad rights granted to
+! users,
+! * secondly, the election of a governing law, French law, with which
+! it is conformant, both as regards the law of torts and
+! intellectual property law, and the protection that it offers to
+! both authors and holders of the economic rights over software.
+!
+! The authors of the CeCILL (for Ce[a] C[nrs] I[nria] L[ogiciel] L[ibre])
+! license are:
+!
+! Commissariat a l'Energie Atomique - CEA, a public scientific, technical
+! and industrial research establishment, having its principal place of
+! business at 25 rue Leblanc, immeuble Le Ponant D, 75015 Paris, France.
+!
+! Centre National de la Recherche Scientifique - CNRS, a public scientific
+! and technological establishment, having its principal place of business
+! at 3 rue Michel-Ange, 75794 Paris cedex 16, France.
+!
+! Institut National de Recherche en Informatique et en Automatique -
+! INRIA, a public scientific and technological establishment, having its
+! principal place of business at Domaine de Voluceau, Rocquencourt, BP
+! 105, 78153 Le Chesnay cedex, France.
+!
+! Preamble
+!
+! The purpose of this Free Software license agreement is to grant users
+! the right to modify and redistribute the software governed by this
+! license within the framework of an open source distribution model.
+!
+! The exercising of these rights is conditional upon certain obligations
+! for users so as to preserve this status for all subsequent redistributions.
+!
+! In consideration of access to the source code and the rights to copy,
+! modify and redistribute granted by the license, users are provided only
+! with a limited warranty and the software's author, the holder of the
+! economic rights, and the successive licensors only have limited liability.
+!
+! In this respect, the risks associated with loading, using, modifying
+! and/or developing or reproducing the software by the user are brought to
+! the user's attention, given its Free Software status, which may make it
+! complicated to use, with the result that its use is reserved for
+! developers and experienced professionals having in-depth computer
+! knowledge. Users are therefore encouraged to load and test the
+! suitability of the software as regards their requirements in conditions
+! enabling the security of their systems and/or data to be ensured and,
+! more generally, to use and operate it in the same conditions of
+! security. This Agreement may be freely reproduced and published,
+! provided it is not altered, and that no provisions are either added or
+! removed herefrom.
+!
+! This Agreement may apply to any or all software for which the holder of
+! the economic rights decides to submit the use thereof to its provisions.
+!
+! Article 1 - DEFINITIONS
+!
+! For the purpose of this Agreement, when the following expressions
+! commence with a capital letter, they shall have the following meaning:
+!
+! Agreement: means this license agreement, and its possible subsequent
+! versions and annexes.
+!
+! Software: means the software in its Object Code and/or Source Code form
+! and, where applicable, its documentation, "as is" when the Licensee
+! accepts the Agreement.
+!
+! Initial Software: means the Software in its Source Code and possibly its
+! Object Code form and, where applicable, its documentation, "as is" when
+! it is first distributed under the terms and conditions of the Agreement.
+!
+! Modified Software: means the Software modified by at least one
+! Contribution.
+!
+! Source Code: means all the Software's instructions and program lines to
+! which access is required so as to modify the Software.
+!
+! Object Code: means the binary files originating from the compilation of
+! the Source Code.
+!
+! Holder: means the holder(s) of the economic rights over the Initial
+! Software.
+!
+! Licensee: means the Software user(s) having accepted the Agreement.
+!
+! Contributor: means a Licensee having made at least one Contribution.
+!
+! Licensor: means the Holder, or any other individual or legal entity, who
+! distributes the Software under the Agreement.
+!
+! Contribution: means any or all modifications, corrections, translations,
+! adaptations and/or new functions integrated into the Software by any or
+! all Contributors, as well as any or all Internal Modules.
+!
+! Module: means a set of sources files including their documentation that
+! enables supplementary functions or services in addition to those offered
+! by the Software.
+!
+! External Module: means any or all Modules, not derived from the
+! Software, so that this Module and the Software run in separate address
+! spaces, with one calling the other when they are run.
+!
+! Internal Module: means any or all Module, connected to the Software so
+! that they both execute in the same address space.
+!
+! GNU GPL: means the GNU General Public License version 2 or any
+! subsequent version, as published by the Free Software Foundation Inc.
+!
+! Parties: mean both the Licensee and the Licensor.
+!
+! These expressions may be used both in singular and plural form.
+!
+! Article 2 - PURPOSE
+!
+! The purpose of the Agreement is the grant by the Licensor to the
+! Licensee of a non-exclusive, transferable and worldwide license for the
+! Software as set forth in Article 5 hereinafter for the whole term of the
+! protection granted by the rights over said Software.
+!
+! Article 3 - ACCEPTANCE
+!
+! 3.1 The Licensee shall be deemed as having accepted the terms and
+! conditions of this Agreement upon the occurrence of the first of the
+! following events:
+!
+! * (i) loading the Software by any or all means, notably, by
+! downloading from a remote server, or by loading from a physical
+! medium;
+! * (ii) the first time the Licensee exercises any of the rights
+! granted hereunder.
+!
+! 3.2 One copy of the Agreement, containing a notice relating to the
+! characteristics of the Software, to the limited warranty, and to the
+! fact that its use is restricted to experienced users has been provided
+! to the Licensee prior to its acceptance as set forth in Article 3.1
+! hereinabove, and the Licensee hereby acknowledges that it has read and
+! understood it.
+!
+! Article 4 - EFFECTIVE DATE AND TERM
+!
+! 4.1 EFFECTIVE DATE
+!
+! The Agreement shall become effective on the date when it is accepted by
+! the Licensee as set forth in Article 3.1.
+!
+! 4.2 TERM
+!
+! The Agreement shall remain in force for the entire legal term of
+! protection of the economic rights over the Software.
+!
+! Article 5 - SCOPE OF RIGHTS GRANTED
+!
+! The Licensor hereby grants to the Licensee, who accepts, the following
+! rights over the Software for any or all use, and for the term of the
+! Agreement, on the basis of the terms and conditions set forth hereinafter.
+!
+! Besides, if the Licensor owns or comes to own one or more patents
+! protecting all or part of the functions of the Software or of its
+! components, the Licensor undertakes not to enforce the rights granted by
+! these patents against successive Licensees using, exploiting or
+! modifying the Software. If these patents are transferred, the Licensor
+! undertakes to have the transferees subscribe to the obligations set
+! forth in this paragraph.
+!
+! 5.1 RIGHT OF USE
+!
+! The Licensee is authorized to use the Software, without any limitation
+! as to its fields of application, with it being hereinafter specified
+! that this comprises:
+!
+! 1. permanent or temporary reproduction of all or part of the Software
+! by any or all means and in any or all form.
+!
+! 2. loading, displaying, running, or storing the Software on any or
+! all medium.
+!
+! 3. entitlement to observe, study or test its operation so as to
+! determine the ideas and principles behind any or all constituent
+! elements of said Software. This shall apply when the Licensee
+! carries out any or all loading, displaying, running, transmission
+! or storage operation as regards the Software, that it is entitled
+! to carry out hereunder.
+!
+! 5.2 ENTITLEMENT TO MAKE CONTRIBUTIONS
+!
+! The right to make Contributions includes the right to translate, adapt,
+! arrange, or make any or all modifications to the Software, and the right
+! to reproduce the resulting software.
+!
+! The Licensee is authorized to make any or all Contributions to the
+! Software provided that it includes an explicit notice that it is the
+! author of said Contribution and indicates the date of the creation thereof.
+!
+! 5.3 RIGHT OF DISTRIBUTION
+!
+! In particular, the right of distribution includes the right to publish,
+! transmit and communicate the Software to the general public on any or
+! all medium, and by any or all means, and the right to market, either in
+! consideration of a fee, or free of charge, one or more copies of the
+! Software by any means.
+!
+! The Licensee is further authorized to distribute copies of the modified
+! or unmodified Software to third parties according to the terms and
+! conditions set forth hereinafter.
+!
+! 5.3.1 DISTRIBUTION OF SOFTWARE WITHOUT MODIFICATION
+!
+! The Licensee is authorized to distribute true copies of the Software in
+! Source Code or Object Code form, provided that said distribution
+! complies with all the provisions of the Agreement and is accompanied by:
+!
+! 1. a copy of the Agreement,
+!
+! 2. a notice relating to the limitation of both the Licensor's
+! warranty and liability as set forth in Articles 8 and 9,
+!
+! and that, in the event that only the Object Code of the Software is
+! redistributed, the Licensee allows future Licensees unhindered access to
+! the full Source Code of the Software by indicating how to access it, it
+! being understood that the additional cost of acquiring the Source Code
+! shall not exceed the cost of transferring the data.
+!
+! 5.3.2 DISTRIBUTION OF MODIFIED SOFTWARE
+!
+! When the Licensee makes a Contribution to the Software, the terms and
+! conditions for the distribution of the resulting Modified Software
+! become subject to all the provisions of this Agreement.
+!
+! The Licensee is authorized to distribute the Modified Software, in
+! source code or object code form, provided that said distribution
+! complies with all the provisions of the Agreement and is accompanied by:
+!
+! 1. a copy of the Agreement,
+!
+! 2. a notice relating to the limitation of both the Licensor's
+! warranty and liability as set forth in Articles 8 and 9,
+!
+! and that, in the event that only the object code of the Modified
+! Software is redistributed, the Licensee allows future Licensees
+! unhindered access to the full source code of the Modified Software by
+! indicating how to access it, it being understood that the additional
+! cost of acquiring the source code shall not exceed the cost of
+! transferring the data.
+!
+! 5.3.3 DISTRIBUTION OF EXTERNAL MODULES
+!
+! When the Licensee has developed an External Module, the terms and
+! conditions of this Agreement do not apply to said External Module, that
+! may be distributed under a separate license agreement.
+!
+! 5.3.4 COMPATIBILITY WITH THE GNU GPL
+!
+! The Licensee can include a code that is subject to the provisions of one
+! of the versions of the GNU GPL in the Modified or unmodified Software,
+! and distribute that entire code under the terms of the same version of
+! the GNU GPL.
+!
+! The Licensee can include the Modified or unmodified Software in a code
+! that is subject to the provisions of one of the versions of the GNU GPL,
+! and distribute that entire code under the terms of the same version of
+! the GNU GPL.
+!
+! Article 6 - INTELLECTUAL PROPERTY
+!
+! 6.1 OVER THE INITIAL SOFTWARE
+!
+! The Holder owns the economic rights over the Initial Software. Any or
+! all use of the Initial Software is subject to compliance with the terms
+! and conditions under which the Holder has elected to distribute its work
+! and no one shall be entitled to modify the terms and conditions for the
+! distribution of said Initial Software.
+!
+! The Holder undertakes that the Initial Software will remain ruled at
+! least by this Agreement, for the duration set forth in Article 4.2.
+!
+! 6.2 OVER THE CONTRIBUTIONS
+!
+! The Licensee who develops a Contribution is the owner of the
+! intellectual property rights over this Contribution as defined by
+! applicable law.
+!
+! 6.3 OVER THE EXTERNAL MODULES
+!
+! The Licensee who develops an External Module is the owner of the
+! intellectual property rights over this External Module as defined by
+! applicable law and is free to choose the type of agreement that shall
+! govern its distribution.
+!
+! 6.4 JOINT PROVISIONS
+!
+! The Licensee expressly undertakes:
+!
+! 1. not to remove, or modify, in any manner, the intellectual property
+! notices attached to the Software;
+!
+! 2. to reproduce said notices, in an identical manner, in the copies
+! of the Software modified or not.
+!
+! The Licensee undertakes not to directly or indirectly infringe the
+! intellectual property rights of the Holder and/or Contributors on the
+! Software and to take, where applicable, vis-a-vis its staff, any and all
+! measures required to ensure respect of said intellectual property rights
+! of the Holder and/or Contributors.
+!
+! Article 7 - RELATED SERVICES
+!
+! 7.1 Under no circumstances shall the Agreement oblige the Licensor to
+! provide technical assistance or maintenance services for the Software.
+!
+! However, the Licensor is entitled to offer this type of services. The
+! terms and conditions of such technical assistance, and/or such
+! maintenance, shall be set forth in a separate instrument. Only the
+! Licensor offering said maintenance and/or technical assistance services
+! shall incur liability therefor.
+!
+! 7.2 Similarly, any Licensor is entitled to offer to its licensees, under
+! its sole responsibility, a warranty, that shall only be binding upon
+! itself, for the redistribution of the Software and/or the Modified
+! Software, under terms and conditions that it is free to decide. Said
+! warranty, and the financial terms and conditions of its application,
+! shall be subject of a separate instrument executed between the Licensor
+! and the Licensee.
+!
+! Article 8 - LIABILITY
+!
+! 8.1 Subject to the provisions of Article 8.2, the Licensee shall be
+! entitled to claim compensation for any direct loss it may have suffered
+! from the Software as a result of a fault on the part of the relevant
+! Licensor, subject to providing evidence thereof.
+!
+! 8.2 The Licensor's liability is limited to the commitments made under
+! this Agreement and shall not be incurred as a result of in particular:
+! (i) loss due the Licensee's total or partial failure to fulfill its
+! obligations, (ii) direct or consequential loss that is suffered by the
+! Licensee due to the use or performance of the Software, and (iii) more
+! generally, any consequential loss. In particular the Parties expressly
+! agree that any or all pecuniary or business loss (i.e. loss of data,
+! loss of profits, operating loss, loss of customers or orders,
+! opportunity cost, any disturbance to business activities) or any or all
+! legal proceedings instituted against the Licensee by a third party,
+! shall constitute consequential loss and shall not provide entitlement to
+! any or all compensation from the Licensor.
+!
+! Article 9 - WARRANTY
+!
+! 9.1 The Licensee acknowledges that the scientific and technical
+! state-of-the-art when the Software was distributed did not enable all
+! possible uses to be tested and verified, nor for the presence of
+! possible defects to be detected. In this respect, the Licensee's
+! attention has been drawn to the risks associated with loading, using,
+! modifying and/or developing and reproducing the Software which are
+! reserved for experienced users.
+!
+! The Licensee shall be responsible for verifying, by any or all means,
+! the suitability of the product for its requirements, its good working
+! order, and for ensuring that it shall not cause damage to either persons
+! or properties.
+!
+! 9.2 The Licensor hereby represents, in good faith, that it is entitled
+! to grant all the rights over the Software (including in particular the
+! rights set forth in Article 5).
+!
+! 9.3 The Licensee acknowledges that the Software is supplied "as is" by
+! the Licensor without any other express or tacit warranty, other than
+! that provided for in Article 9.2 and, in particular, without any warranty
+! as to its commercial value, its secured, safe, innovative or relevant
+! nature.
+!
+! Specifically, the Licensor does not warrant that the Software is free
+! from any error, that it will operate without interruption, that it will
+! be compatible with the Licensee's own equipment and software
+! configuration, nor that it will meet the Licensee's requirements.
+!
+! 9.4 The Licensor does not either expressly or tacitly warrant that the
+! Software does not infringe any third party intellectual property right
+! relating to a patent, software or any other property right. Therefore,
+! the Licensor disclaims any and all liability towards the Licensee
+! arising out of any or all proceedings for infringement that may be
+! instituted in respect of the use, modification and redistribution of the
+! Software. Nevertheless, should such proceedings be instituted against
+! the Licensee, the Licensor shall provide it with technical and legal
+! assistance for its defense. Such technical and legal assistance shall be
+! decided on a case-by-case basis between the relevant Licensor and the
+! Licensee pursuant to a memorandum of understanding. The Licensor
+! disclaims any and all liability as regards the Licensee's use of the
+! name of the Software. No warranty is given as regards the existence of
+! prior rights over the name of the Software or as regards the existence
+! of a trademark.
+!
+! Article 10 - TERMINATION
+!
+! 10.1 In the event of a breach by the Licensee of its obligations
+! hereunder, the Licensor may automatically terminate this Agreement
+! thirty (30) days after notice has been sent to the Licensee and has
+! remained ineffective.
+!
+! 10.2 A Licensee whose Agreement is terminated shall no longer be
+! authorized to use, modify or distribute the Software. However, any
+! licenses that it may have granted prior to termination of the Agreement
+! shall remain valid subject to their having been granted in compliance
+! with the terms and conditions hereof.
+!
+! Article 11 - MISCELLANEOUS
+!
+! 11.1 EXCUSABLE EVENTS
+!
+! Neither Party shall be liable for any or all delay, or failure to
+! perform the Agreement, that may be attributable to an event of force
+! majeure, an act of God or an outside cause, such as defective
+! functioning or interruptions of the electricity or telecommunications
+! networks, network paralysis following a virus attack, intervention by
+! government authorities, natural disasters, water damage, earthquakes,
+! fire, explosions, strikes and labor unrest, war, etc.
+!
+! 11.2 Any failure by either Party, on one or more occasions, to invoke
+! one or more of the provisions hereof, shall under no circumstances be
+! interpreted as being a waiver by the interested Party of its right to
+! invoke said provision(s) subsequently.
+!
+! 11.3 The Agreement cancels and replaces any or all previous agreements,
+! whether written or oral, between the Parties and having the same
+! purpose, and constitutes the entirety of the agreement between said
+! Parties concerning said purpose. No supplement or modification to the
+! terms and conditions hereof shall be effective as between the Parties
+! unless it is made in writing and signed by their duly authorized
+! representatives.
+!
+! 11.4 In the event that one or more of the provisions hereof were to
+! conflict with a current or future applicable act or legislative text,
+! said act or legislative text shall prevail, and the Parties shall make
+! the necessary amendments so as to comply with said act or legislative
+! text. All other provisions shall remain effective. Similarly, invalidity
+! of a provision of the Agreement, for any reason whatsoever, shall not
+! cause the Agreement as a whole to be invalid.
+!
+! 11.5 LANGUAGE
+!
+! The Agreement is drafted in both French and English and both versions
+! are deemed authentic.
+!
+! Article 12 - NEW VERSIONS OF THE AGREEMENT
+!
+! 12.1 Any person is authorized to duplicate and distribute copies of this
+! Agreement.
+!
+! 12.2 So as to ensure coherence, the wording of this Agreement is
+! protected and may only be modified by the authors of the License, who
+! reserve the right to periodically publish updates or new versions of the
+! Agreement, each with a separate number. These subsequent versions may
+! address new issues encountered by Free Software.
+!
+! 12.3 Any Software distributed under a given version of the Agreement may
+! only be subsequently distributed under the same version of the Agreement
+! or a subsequent version, subject to the provisions of Article 5.3.4.
+!
+! Article 13 - GOVERNING LAW AND JURISDICTION
+!
+! 13.1 The Agreement is governed by French law. The Parties agree to
+! endeavor to seek an amicable solution to any disagreements or disputes
+! that may arise during the performance of the Agreement.
+!
+! 13.2 Failing an amicable solution within two (2) months as from their
+! occurrence, and unless emergency proceedings are necessary, the
+! disagreements or disputes shall be referred to the Paris Courts having
+! jurisdiction, by the more diligent Party.
+!
+! Version 2.0 dated 2006-09-05.
+!
Added: seismo/3D/CPML/tags/v1.1.1/seismic_CPML_3D_viscoelastic_MPI.f90
===================================================================
--- seismo/3D/CPML/tags/v1.1.1/seismic_CPML_3D_viscoelastic_MPI.f90 (rev 0)
+++ seismo/3D/CPML/tags/v1.1.1/seismic_CPML_3D_viscoelastic_MPI.f90 2009-11-03 21:35:50 UTC (rev 15926)
@@ -0,0 +1,2187 @@
+!
+! SEISMIC_CPML Version 1.1.1, November 2009.
+!
+! Copyright Universite de Pau et des Pays de l'Adour, CNRS and INRIA, France.
+! Contributors: Roland Martin, roland DOT martin aT univ-pau DOT fr
+! and Dimitri Komatitsch, dimitri DOT komatitsch aT univ-pau DOT fr
+!
+! This software is a computer program whose purpose is to solve
+! the three-dimensional isotropic viscoelastic wave equation
+! using a fourth order finite-difference method with Convolutional Perfectly Matched
+! Layer (C-PML) conditions.
+!
+! This software is governed by the CeCILL license under French law and
+! abiding by the rules of distribution of free software. You can use,
+! modify and/or redistribute the software under the terms of the CeCILL
+! license as circulated by CEA, CNRS and INRIA at the following URL
+! "http://www.cecill.info".
+!
+! As a counterpart to the access to the source code and rights to copy,
+! modify and redistribute granted by the license, users are provided only
+! with a limited warranty and the software's author, the holder of the
+! economic rights, and the successive licensors have only limited
+! liability.
+!
+! In this respect, the user's attention is drawn to the risks associated
+! with loading, using, modifying and/or developing or reproducing the
+! software by the user in light of its specific status of free software,
+! that may mean that it is complicated to manipulate, and that also
+! therefore means that it is reserved for developers and experienced
+! professionals having in-depth computer knowledge. Users are therefore
+! encouraged to load and test the software's suitability as regards their
+! requirements in conditions enabling the security of their systems and/or
+! data to be ensured and, more generally, to use and operate it in the
+! same conditions as regards security.
+!
+! The full text of the license is available at the end of this program
+! and in file "LICENSE".
+
+ program seismic_visco_CPML_3D_MPI_OpenMP
+
+! 3D fourth order viscoelastic finite-difference code in velocity and stress formulation
+! with Convolutional-PML (C-PML) absorbing conditions using 2 mechanisms of attenuation
+! with 6 equations per mechanism.
+
+! Roland Martin, University of Pau, France, October 2009.
+! based on the elastic code of Komatitsch and Martin, 2007.
+
+! The fourth-order staggered-grid formulation of Madariaga (1976) and Virieux (1986) is used.
+
+! The C-PML implementation is based in part on formulas given in Roden and Gedney (2000).
+!
+! Parallel implementation based on MPI.
+
+! The C-PML implementation is based in part on formulas given in Roden and Gedney (2000).
+! If you use this code for your own research, please cite some (or all) of these
+! articles:
+!
+! @ARTICLE{MaKo09,
+! author = {Roland Martin and Dimitri Komatitsch},
+! title = {An unsplit convolutional perfectly matched layer technique improved
+! at grazing incidence for the viscoelastic wave equation},
+! journal = {Geophysical Journal International},
+! year = {2009},
+! volume = {179},
+! pages = {333-344},
+! number = {1},
+! doi = {10.1111/j.1365-246X.2009.04278.x}}
+!
+! @ARTICLE{KoMa07,
+! author = {Dimitri Komatitsch and Roland Martin},
+! title = {An unsplit convolutional {P}erfectly {M}atched {L}ayer improved
+! at grazing incidence for the seismic wave equation},
+! journal = {Geophysics},
+! year = {2007},
+! volume = {72},
+! number = {5},
+! pages = {SM155-SM167},
+! doi = {10.1190/1.2757586}}
+!
+! @ARTICLE{MaKoEz08,
+! author = {Roland Martin and Dimitri Komatitsch and Abdela\^aziz Ezziani},
+! title = {An unsplit convolutional perfectly matched layer improved at grazing
+! incidence for seismic wave equation in poroelastic media},
+! journal = {Geophysics},
+! year = {2008},
+! volume = {73},
+! pages = {T51-T61},
+! number = {4},
+! doi = {10.1190/1.2939484}}
+!
+! @ARTICLE{MaKoGe08,
+! author = {Roland Martin and Dimitri Komatitsch and Stephen D. Gedney},
+! title = {A variational formulation of a stabilized unsplit convolutional perfectly
+! matched layer for the isotropic or anisotropic seismic wave equation},
+! journal = {Computer Modeling in Engineering and Sciences},
+! year = {2008},
+! volume = {37},
+! pages = {274-304},
+! number = {3}}
+!
+! The original CPML technique for Maxwell's equations is described in:
+!
+! @ARTICLE{RoGe00,
+! author = {J. A. Roden and S. D. Gedney},
+! title = {Convolution {PML} ({CPML}): {A}n Efficient {FDTD} Implementation
+! of the {CFS}-{PML} for Arbitrary Media},
+! journal = {Microwave and Optical Technology Letters},
+! year = {2000},
+! volume = {27},
+! number = {5},
+! pages = {334-339},
+! doi = {10.1002/1098-2760(20001205)27:5<334::AID-MOP14>3.0.CO;2-A}}
+
+!
+! To display the results as color images in the selected 2D cut plane, use:
+!
+! " display image*.gif " or " gimp image*.gif "
+!
+! or
+!
+! " montage -geometry +0+3 -rotate 90 -tile 1x21 image*Vx*.gif allfiles_Vx.gif "
+! " montage -geometry +0+3 -rotate 90 -tile 1x21 image*Vy*.gif allfiles_Vy.gif "
+! then " display allfiles_Vx.gif " or " gimp allfiles_Vx.gif "
+! then " display allfiles_Vy.gif " or " gimp allfiles_Vy.gif "
+!
+
+ implicit none
+
+! header which contains standard MPI declarations
+ include 'mpif.h'
+
+! total number of grid points in each direction of the grid
+ integer, parameter :: NX = 210
+ integer, parameter :: NY = 800
+ integer, parameter :: NZ = 220 ! even number in order to cut along Z axis
+
+! number of processes used in the MPI run
+! and local number of points (for simplicity we cut the mesh along Z only)
+ integer, parameter :: NPROC = 20
+ integer, parameter :: NZ_LOCAL = NZ / NPROC
+
+! size of a grid cell
+ double precision, parameter :: DELTAX = 4.d0, ONE_OVER_DELTAX = 1.d0 / DELTAX
+ double precision, parameter :: DELTAY = DELTAX, DELTAZ = DELTAX
+ double precision, parameter :: ONE_OVER_DELTAY = ONE_OVER_DELTAX, ONE_OVER_DELTAZ = ONE_OVER_DELTAX
+ double precision, parameter :: ONE=1.d0,TWO=2.d0, DIM=3.d0
+! P-velocity, S-velocity and density
+ double precision, parameter :: cp = 3000.d0
+ double precision, parameter :: cs = 2000.d0
+ double precision, parameter :: rho = 2000.d0
+ double precision, parameter :: mu = rho*cs*cs
+ double precision, parameter :: lambda = rho*(cp*cp - 2.d0*cs*cs)
+ double precision, parameter :: lambdaplustwomu = rho*cp*cp
+
+! total number of time steps
+ integer, parameter :: NSTEP = 100000
+
+! time step in seconds
+ double precision, parameter :: DELTAT = 4.d-4
+
+! parameters for the source
+ double precision, parameter :: f0 = 18.d0
+ double precision, parameter :: t0 = 1.20d0 / f0
+ double precision, parameter :: factor = 1.d7
+
+! flags to add PML layers to the edges of the grid
+ logical, parameter :: USE_PML_XMIN = .true.
+ logical, parameter :: USE_PML_XMAX = .true.
+ logical, parameter :: USE_PML_YMIN = .true.
+ logical, parameter :: USE_PML_YMAX = .true.
+ logical, parameter :: USE_PML_ZMIN = .true.
+ logical, parameter :: USE_PML_ZMAX = .true.
+
+! thickness of the PML layer in grid points
+ integer, parameter :: NPOINTS_PML = 10
+
+! source
+! integer, parameter :: ISOURCE = NX - 2*NPOINTS_PML - 1
+ integer, parameter :: ISOURCE = NPOINTS_PML+20
+ integer, parameter :: JSOURCE = NY / 5 + 1
+ double precision, parameter :: xsource = (ISOURCE) * DELTAX
+ double precision, parameter :: ysource = (JSOURCE) * DELTAY
+! angle of source force clockwise with respect to vertical (Y) axis
+ double precision, parameter :: ANGLE_FORCE = 0.d0
+
+! receivers
+ integer, parameter :: NREC = 3
+ double precision, parameter :: xdeb = xsource - 100.d0 ! first receiver x in meters
+ double precision, parameter :: ydeb = 2300.d0 ! first receiver y in meters
+ double precision, parameter :: xfin = xsource ! last receiver x in meters
+ double precision, parameter :: yfin = 300.d0 ! last receiver y in meters
+
+! display information on the screen from time to time
+ integer, parameter :: IT_DISPLAY = 10000
+
+! value of PI
+ double precision, parameter :: PI = 3.141592653589793238462643d0
+
+! conversion from degrees to radians
+ double precision, parameter :: DEGREES_TO_RADIANS = PI / 180.d0
+
+! zero
+ double precision, parameter :: ZERO = 0.d0
+
+! large value for maximum
+ double precision, parameter :: HUGEVAL = 1.d+30
+
+! velocity threshold above which we consider that the code became unstable
+ double precision, parameter :: STABILITY_THRESHOLD = 1.d+25
+
+! power to compute d0 profile
+ double precision, parameter :: NPOWER = 2.d0
+
+ double precision, parameter :: K_MAX_PML = 7.d0 ! from Gedney page 8.11
+! double precision, parameter :: ALPHA_MAX_PML = 0.d0 ! from festa and Vilotte
+ double precision, parameter :: ALPHA_MAX_PML = 2.d0*PI*(f0/2.d0) ! from festa and Vilotte
+
+! arrays for the memory variables
+! could declare these arrays in PML only to save a lot of memory, but proof of concept only here
+ double precision, dimension(0:NX+1,0:NY+1,-1:NZ_LOCAL+2) :: &
+ memory_dvx_dx, &
+ memory_dvx_dy, &
+ memory_dvx_dz, &
+ memory_dvy_dx, &
+ memory_dvy_dy, &
+ memory_dvy_dz, &
+ memory_dvz_dx, &
+ memory_dvz_dy, &
+ memory_dvz_dz, &
+ memory_dsigmaxx_dx, &
+ memory_dsigmayy_dy, &
+ memory_dsigmazz_dz, &
+ memory_dsigmaxy_dx, &
+ memory_dsigmaxy_dy, &
+ memory_dsigmaxz_dx, &
+ memory_dsigmaxz_dz, &
+ memory_dsigmayz_dy, &
+ memory_dsigmayz_dz
+
+ double precision :: &
+ value_dvx_dx, &
+ value_dvx_dy, &
+ value_dvx_dz, &
+ value_dvy_dx, &
+ value_dvy_dy, &
+ value_dvy_dz, &
+ value_dvz_dx, &
+ value_dvz_dy, &
+ value_dvz_dz, &
+ value_dsigmaxx_dx, &
+ value_dsigmayy_dy, &
+ value_dsigmazz_dz, &
+ value_dsigmaxy_dx, &
+ value_dsigmaxy_dy, &
+ value_dsigmaxz_dx, &
+ value_dsigmaxz_dz, &
+ value_dsigmayz_dy, &
+ value_dsigmayz_dz
+
+ double precision :: duxdx,duxdy,duxdz,duydx,duydy,duydz,duzdx,duzdy,duzdz,div
+! 1D arrays for the damping profiles
+ double precision, dimension(1:NX) :: d_x,K_x,alpha_prime_x,a_x,b_x,d_x_half,K_x_half,alpha_prime_x_half,a_x_half,b_x_half
+ double precision, dimension(1:NY) :: d_y,K_y,alpha_prime_y,a_y,b_y,d_y_half,K_y_half,alpha_prime_y_half,a_y_half,b_y_half
+ double precision, dimension(1:NZ) :: d_z,K_z,alpha_prime_z,a_z,b_z,d_z_half,K_z_half,alpha_prime_z_half,a_z_half,b_z_half
+
+! PML
+ double precision thickness_PML_x,thickness_PML_y,thickness_PML_z
+ double precision xoriginleft,xoriginright,yoriginbottom,yorigintop,zoriginbottom,zorigintop
+ double precision Rcoef,d0_x,d0_y,d0_z,xval,yval,zval,abscissa_in_PML,abscissa_normalized
+
+! change dimension of Z axis to add two planes for MPI
+ double precision, dimension(0:NX+1,0:NY+1,-1:NZ_LOCAL+2) :: vx,vy,vz,sigmaxx,sigmayy,sigmazz,sigmaxy,sigmaxz,sigmayz
+ double precision, dimension(0:NX+1,0:NY+1,-1:NZ_LOCAL+2) :: sigmaxx_R,sigmayy_R,sigmazz_R,sigmaxy_R,sigmaxz_R,sigmayz_R
+ double precision, dimension(0:NX+1,0:NY+1,-1:NZ_LOCAL+2) :: e1_mech1,e1_mech2,e11_mech1,e11_mech2,e22_mech1,e22_mech2
+ double precision, dimension(0:NX+1,0:NY+1,-1:NZ_LOCAL+2) :: e12_mech1,e12_mech2,e13_mech1,e13_mech2,e23_mech1,e23_mech2
+
+ integer, parameter :: number_of_arrays = 9 + 2*9 + 12
+
+! for the source
+ double precision a,t,force_x,force_y,source_term
+
+! for receivers
+ double precision distval,dist
+ integer, dimension(NREC) :: ix_rec,iy_rec
+ double precision, dimension(NREC) :: xrec,yrec
+
+! for seismograms
+ double precision, dimension(NSTEP,NREC) :: sisvx,sisvy
+
+! max amplitude for color snapshots
+ double precision max_amplitudeVx
+ double precision max_amplitudeVy
+
+! for evolution of total energy in the medium
+ double precision :: epsilon_xx,epsilon_yy,epsilon_zz,epsilon_xy,epsilon_xz,epsilon_yz
+ double precision, dimension(NSTEP) :: total_energy,total_energy_kinetic,total_energy_potential
+ double precision :: local_energy_kinetic,local_energy_potential
+
+ integer :: irec
+
+! precompute some parameters once and for all
+ double precision, parameter :: DELTAT_lambda = DELTAT*lambda
+ double precision, parameter :: DELTAT_mu = DELTAT*mu
+ double precision, parameter :: DELTAT_lambdaplus2mu = DELTAT*lambdaplustwomu
+
+ double precision, parameter :: DELTAT_over_rho = DELTAT/rho
+ double precision :: mul_relaxed,lambdal_relaxed,lambdalplus2mul_relaxed
+ double precision :: mul_unrelaxed,lambdal_unrelaxed,lambdalplus2mul_unrelaxed
+ double precision :: Un,Sn,Unp1,Mu_nu1,Mu_nu2
+ double precision :: phi_nu1_mech1,phi_nu1_mech2
+ double precision :: phi_nu2_mech1,phi_nu2_mech2
+ double precision :: tauinv,inv_tau_sigma_nu1_mech1,inv_tau_sigma_nu1_mech2
+ double precision :: taumin,taumax, tau1, tau2, tau3, tau4
+ double precision :: inv_tau_sigma_nu2_mech1,inv_tau_sigma_nu2_mech2
+ double precision :: tauinvUn
+ double precision :: tau_epsilon_nu1_mech1, tau_sigma_nu1_mech1
+ double precision:: tau_epsilon_nu2_mech1, tau_sigma_nu2_mech1
+ double precision:: tau_epsilon_nu1_mech2, tau_sigma_nu1_mech2
+ double precision:: tau_epsilon_nu2_mech2 ,tau_sigma_nu2_mech2
+
+ integer :: i,j,k,it,it2
+
+ double precision :: Vsolidnorm,Courant_number
+
+! timer to count elapsed time
+ character(len=8) datein
+ character(len=10) timein
+ character(len=5) :: zone
+ integer, dimension(8) :: time_values
+ integer ihours,iminutes,iseconds,int_tCPU
+ double precision :: time_start,time_end,tCPU
+
+! names of the time stamp files
+ character(len=150) outputname
+
+! main I/O file
+ integer, parameter :: IOUT = 41
+
+! array needed for MPI_RECV
+ integer, dimension(MPI_STATUS_SIZE) :: message_status
+
+! tag of the message to send
+ integer, parameter :: message_tag = 0
+
+! number of values to send or receive
+ integer, parameter :: number_of_values = 2*(NX+2)*(NY+2)
+
+ integer :: nb_procs,rank,code,rank_cut_plane,kmin,kmax,kglobal,offset_k,k2begin,kminus1end
+ integer :: sender_right_shift,receiver_right_shift,sender_left_shift,receiver_left_shift
+
+!---
+!--- program starts here
+!---
+
+! start MPI processes
+ call MPI_INIT(code)
+
+! get total number of MPI processes in variable nb_procs
+ call MPI_COMM_SIZE(MPI_COMM_WORLD, nb_procs, code)
+
+! get the rank of our process from 0 (master) to nb_procs-1 (workers)
+ call MPI_COMM_RANK(MPI_COMM_WORLD, rank, code)
+
+ tau_epsilon_nu1_mech1 = 0.0334d0
+ tau_sigma_nu1_mech1 = 0.0303d0
+
+! tau_epsilon_nu1_mech1 = 0.0325305d0
+! tau_sigma_nu1_mech1 = 0.0311465d0
+
+ tau1= tau_sigma_nu1_mech1/tau_epsilon_nu1_mech1
+
+ tau_epsilon_nu2_mech1 = 0.0352d0
+ tau_sigma_nu2_mech1 = 0.0287d0
+
+! tau_epsilon_nu2_mech1 = 0.0332577d0
+! tau_sigma_nu2_mech1 = 0.0304655d0
+
+ tau2= tau_sigma_nu2_mech1/tau_epsilon_nu2_mech1
+
+ tau_epsilon_nu1_mech2 = 0.0028d0
+ tau_sigma_nu1_mech2 = 0.0025d0
+
+! tau_epsilon_nu1_mech2 = 0.0032530d0
+! tau_sigma_nu1_mech2 = 0.0031146d0
+
+ tau3= tau_sigma_nu1_mech2/tau_epsilon_nu1_mech2
+
+ tau_epsilon_nu2_mech2 = 0.0029d0
+ tau_sigma_nu2_mech2 = 0.0024d0
+
+! tau_epsilon_nu2_mech2 = 0.0033257d0
+! tau_sigma_nu2_mech2 = 0.0030465d0
+
+ tau4= tau_sigma_nu2_mech2/tau_epsilon_nu2_mech2
+
+ taumax=dmax1(1.d0/tau1,1.d0/tau2,1.d0/tau3,1.d0/tau4)
+ taumin=dmin1(1.d0/tau1,1.d0/tau2,1.d0/tau3,1.d0/tau4)
+
+ inv_tau_sigma_nu1_mech1 = ONE / tau_sigma_nu1_mech1
+ inv_tau_sigma_nu2_mech1 = ONE / tau_sigma_nu2_mech1
+ inv_tau_sigma_nu1_mech2 = ONE / tau_sigma_nu1_mech2
+ inv_tau_sigma_nu2_mech2 = ONE / tau_sigma_nu2_mech2
+
+phi_nu1_mech1 = (ONE - tau_epsilon_nu1_mech1/tau_sigma_nu1_mech1)&
+ / tau_sigma_nu1_mech1
+phi_nu2_mech1 = (ONE - tau_epsilon_nu2_mech1/tau_sigma_nu2_mech1)&
+ / tau_sigma_nu2_mech1
+phi_nu1_mech2 = (ONE - tau_epsilon_nu1_mech2/tau_sigma_nu1_mech2)&
+ / tau_sigma_nu1_mech2
+phi_nu2_mech2 = (ONE - tau_epsilon_nu2_mech2/tau_sigma_nu2_mech2) &
+/ tau_sigma_nu2_mech2
+
+ Mu_nu1 = ONE - (ONE - tau_epsilon_nu1_mech1/tau_sigma_nu1_mech1) &
+- (ONE - tau_epsilon_nu1_mech2/tau_sigma_nu1_mech2)
+ Mu_nu2 = ONE - (ONE - tau_epsilon_nu2_mech1/tau_sigma_nu2_mech1) &
+- (ONE - tau_epsilon_nu2_mech2/tau_sigma_nu2_mech2)
+
+! slice number for the cut plane in the middle of the mesh
+ rank_cut_plane = nb_procs/2 - 1
+
+ if(rank == rank_cut_plane) then
+
+ print *
+ print *,'3D elastic finite-difference code in velocity and stress formulation with C-PML'
+ print *
+
+! display size of the model
+ print *
+ print *,'NX = ',NX
+ print *,'NY = ',NY
+ print *,'NZ = ',NZ
+ print *
+ print *,'NZ_LOCAL = ',NZ_LOCAL
+ print *,'NPROC = ',NPROC
+ print *
+ print *,'size of the model along X = ',(NX+1) * DELTAX
+ print *,'size of the model along Y = ',(NY+1) * DELTAY
+ print *,'size of the model along Y = ',(NZ+1) * DELTAZ
+ print *
+ print *,'Total number of grid points = ',(NX+2) * (NY+2) * (NZ+2)
+ print *,'Number of points of all the arrays = ',dble(NX+2)*dble(NY+2)*dble(NZ+2)*number_of_arrays
+ print *,'Size in GB of all the arrays = ',dble(NX+2)*dble(NY+2)*dble(NZ+2)*number_of_arrays*8.d0/(1024.d0*1024.d0*1024.d0)
+ print *
+ print *,'In each slice:'
+ print *
+ print *,'Total number of grid points = ',(NX+2) * (NY+2) * NZ_LOCAL
+ print *,'Number of points of the arrays = ',dble(NX+2)*dble(NY+2)*dble(NZ_LOCAL)*number_of_arrays
+ print *,'Size in GB of the arrays = ',dble(NX+2)*dble(NY+2)*dble(NZ_LOCAL)*number_of_arrays*8.d0/(1024.d0*1024.d0*1024.d0)
+ print *
+
+ endif
+
+! check that code was compiled with the right number of slices
+ if(nb_procs /= NPROC) then
+ print *,'nb_procs,NPROC = ',nb_procs,NPROC
+ stop 'nb_procs must be equal to NPROC'
+ endif
+
+! we restrict ourselves to an even number of slices
+! in order to have a cut plane in the middle of the mesh for visualization purposes
+ if(mod(nb_procs,2) /= 0) stop 'nb_procs must be even'
+
+! check that we can cut along Z in an exact number of slices
+ if(mod(NZ,nb_procs) /= 0) stop 'NZ must be a multiple of nb_procs'
+
+! check that a slice is at least as thick as a PML layer
+ if(NZ_LOCAL < NPOINTS_PML) stop 'NZ_LOCAL must be greater than NPOINTS_PML'
+
+! offset of this slice when we cut along Z
+ offset_k = rank * NZ_LOCAL
+
+!--- define profile of absorption in PML region
+
+! thickness of the PML layer in meters
+ thickness_PML_x = NPOINTS_PML * DELTAX
+ thickness_PML_y = NPOINTS_PML * DELTAY
+ thickness_PML_z = NPOINTS_PML * DELTAZ
+
+! reflection coefficient (INRIA report section 6.1)
+ Rcoef = 0.0001d0
+
+! check that NPOWER is okay
+ if(NPOWER < 1) stop 'NPOWER must be greater than 1'
+
+! compute d0 from INRIA report section 6.1
+ d0_x = - (NPOWER + 1) * cp *dsqrt(taumax)* log(Rcoef) / (2.d0 * thickness_PML_x)
+ d0_y = - (NPOWER + 1) * cp *dsqrt(taumax)* log(Rcoef) / (2.d0 * thickness_PML_y)
+ d0_z = - (NPOWER + 1) * cp *dsqrt(taumax)* log(Rcoef) / (2.d0 * thickness_PML_z)
+
+ if(rank == rank_cut_plane) then
+ print *
+ print *,'d0_x = ',d0_x
+ print *,'d0_y = ',d0_y
+ print *,'d0_z = ',d0_z
+ endif
+
+! PML
+ d_x(:) = ZERO
+ d_x_half(:) = ZERO
+ K_x(:) = 1.d0
+ K_x_half(:) = 1.d0
+ alpha_prime_x(:) = ZERO
+ alpha_prime_x_half(:) = ZERO
+ a_x(:) = ZERO
+ a_x_half(:) = ZERO
+
+ d_y(:) = ZERO
+ d_y_half(:) = ZERO
+ K_y(:) = 1.d0
+ K_y_half(:) = 1.d0
+ alpha_prime_y(:) = ZERO
+ alpha_prime_y_half(:) = ZERO
+ a_y(:) = ZERO
+ a_y_half(:) = ZERO
+
+ d_z(:) = ZERO
+ d_z_half(:) = ZERO
+ K_z(:) = 1.d0
+ K_z_half(:) = 1.d0
+ alpha_prime_z(:) = ZERO
+ alpha_prime_z_half(:) = ZERO
+ a_z(:) = ZERO
+ a_z_half(:) = ZERO
+
+! damping in the X direction
+
+! origin of the PML layer (position of right edge minus thickness, in meters)
+ xoriginleft = thickness_PML_x
+ xoriginright = (NX-1)*DELTAX - thickness_PML_x
+
+ do i = 1,NX
+
+! abscissa of current grid point along the damping profile
+ xval = DELTAX * dble(i-1)
+
+!---------- xmin edge
+ if(USE_PML_XMIN) then
+
+! define damping profile at the grid points
+ abscissa_in_PML = xoriginleft - xval
+ if(abscissa_in_PML >= ZERO) then
+ abscissa_normalized = abscissa_in_PML / thickness_PML_x
+ d_x(i) = d0_x * abscissa_normalized**NPOWER
+! this taken from Gedney page 8.2
+ K_x(i) = 1.d0 + (K_MAX_PML - 1.d0) * abscissa_normalized**NPOWER
+ alpha_prime_x(i) = ALPHA_MAX_PML * (1.d0 - abscissa_normalized)
+ endif
+
+! define damping profile at half the grid points
+ abscissa_in_PML = xoriginleft - (xval + DELTAX/2.d0)
+ if(abscissa_in_PML >= ZERO) then
+ abscissa_normalized = abscissa_in_PML / thickness_PML_x
+ d_x_half(i) = d0_x * abscissa_normalized**NPOWER
+! this taken from Gedney page 8.2
+ K_x_half(i) = 1.d0 + (K_MAX_PML - 1.d0) * abscissa_normalized**NPOWER
+ alpha_prime_x_half(i) = ALPHA_MAX_PML * (1.d0 - abscissa_normalized)
+ endif
+
+ endif
+
+!---------- xmax edge
+ if(USE_PML_XMAX) then
+
+! define damping profile at the grid points
+ abscissa_in_PML = xval - xoriginright
+ if(abscissa_in_PML >= ZERO) then
+ abscissa_normalized = abscissa_in_PML / thickness_PML_x
+ d_x(i) = d0_x * abscissa_normalized**NPOWER
+! this taken from Gedney page 8.2
+ K_x(i) = 1.d0 + (K_MAX_PML - 1.d0) * abscissa_normalized**NPOWER
+ alpha_prime_x(i) = ALPHA_MAX_PML * (1.d0 - abscissa_normalized)
+ endif
+
+! define damping profile at half the grid points
+ abscissa_in_PML = xval + DELTAX/2.d0 - xoriginright
+ if(abscissa_in_PML >= ZERO) then
+ abscissa_normalized = abscissa_in_PML / thickness_PML_x
+ d_x_half(i) = d0_x * abscissa_normalized**NPOWER
+! this taken from Gedney page 8.2
+ K_x_half(i) = 1.d0 + (K_MAX_PML - 1.d0) * abscissa_normalized**NPOWER
+ alpha_prime_x_half(i) = ALPHA_MAX_PML * (1.d0 - abscissa_normalized)
+ endif
+
+ endif
+
+! just in case, for -5 at the end
+ if(alpha_prime_x(i) < ZERO) alpha_prime_x(i) = ZERO
+ if(alpha_prime_x_half(i) < ZERO) alpha_prime_x_half(i) = ZERO
+
+ b_x(i) = exp(- (d_x(i) / K_x(i) + alpha_prime_x(i)) * DELTAT)
+ b_x_half(i) = exp(- (d_x_half(i) / K_x_half(i) + alpha_prime_x_half(i)) * DELTAT)
+
+! this to avoid division by zero outside the PML
+ if(abs(d_x(i)) > 1.d-6) a_x(i) = d_x(i) * (b_x(i) - 1.d0) / (K_x(i) * (d_x(i) + K_x(i) * alpha_prime_x(i)))
+ if(abs(d_x_half(i)) > 1.d-6) a_x_half(i) = d_x_half(i) * &
+ (b_x_half(i) - 1.d0) / (K_x_half(i) * (d_x_half(i) + K_x_half(i) * alpha_prime_x_half(i)))
+
+ enddo
+
+! damping in the Y direction
+
+! origin of the PML layer (position of right edge minus thickness, in meters)
+ yoriginbottom = thickness_PML_y
+ yorigintop = (NY-1)*DELTAY - thickness_PML_y
+
+ do j = 1,NY
+
+! abscissa of current grid point along the damping profile
+ yval = DELTAY * dble(j-1)
+
+!---------- ymin edge
+ if(USE_PML_YMIN) then
+
+! define damping profile at the grid points
+ abscissa_in_PML = yoriginbottom - yval
+ if(abscissa_in_PML >= ZERO) then
+ abscissa_normalized = abscissa_in_PML / thickness_PML_y
+ d_y(j) = d0_y * abscissa_normalized**NPOWER
+! this taken from Gedney page 8.2
+ K_y(j) = 1.d0 + (K_MAX_PML - 1.d0) * abscissa_normalized**NPOWER
+ alpha_prime_y(j) = ALPHA_MAX_PML * (1.d0 - abscissa_normalized)
+ endif
+
+! define damping profile at half the grid points
+ abscissa_in_PML = yoriginbottom - (yval + DELTAY/2.d0)
+ if(abscissa_in_PML >= ZERO) then
+ abscissa_normalized = abscissa_in_PML / thickness_PML_y
+ d_y_half(j) = d0_y * abscissa_normalized**NPOWER
+! this taken from Gedney page 8.2
+ K_y_half(j) = 1.d0 + (K_MAX_PML - 1.d0) * abscissa_normalized**NPOWER
+ alpha_prime_y_half(j) = ALPHA_MAX_PML * (1.d0 - abscissa_normalized)
+ endif
+
+ endif
+
+!---------- ymax edge
+ if(USE_PML_YMAX) then
+
+! define damping profile at the grid points
+ abscissa_in_PML = yval - yorigintop
+ if(abscissa_in_PML >= ZERO) then
+ abscissa_normalized = abscissa_in_PML / thickness_PML_y
+ d_y(j) = d0_y * abscissa_normalized**NPOWER
+! this taken from Gedney page 8.2
+ K_y(j) = 1.d0 + (K_MAX_PML - 1.d0) * abscissa_normalized**NPOWER
+ alpha_prime_y(j) = ALPHA_MAX_PML * (1.d0 - abscissa_normalized)
+ endif
+
+! define damping profile at half the grid points
+ abscissa_in_PML = yval + DELTAY/2.d0 - yorigintop
+ if(abscissa_in_PML >= ZERO) then
+ abscissa_normalized = abscissa_in_PML / thickness_PML_y
+ d_y_half(j) = d0_y * abscissa_normalized**NPOWER
+! this taken from Gedney page 8.2
+ K_y_half(j) = 1.d0 + (K_MAX_PML - 1.d0) * abscissa_normalized**NPOWER
+ alpha_prime_y_half(j) = ALPHA_MAX_PML * (1.d0 - abscissa_normalized)
+ endif
+
+ endif
+
+ b_y(j) = exp(- (d_y(j) / K_y(j) + alpha_prime_y(j)) * DELTAT)
+ b_y_half(j) = exp(- (d_y_half(j) / K_y_half(j) + alpha_prime_y_half(j)) * DELTAT)
+
+! this to avoid division by zero outside the PML
+ if(abs(d_y(j)) > 1.d-6) a_y(j) = d_y(j) * (b_y(j) - 1.d0) / (K_y(j) * (d_y(j) + K_y(j) * alpha_prime_y(j)))
+ if(abs(d_y_half(j)) > 1.d-6) a_y_half(j) = d_y_half(j) * &
+ (b_y_half(j) - 1.d0) / (K_y_half(j) * (d_y_half(j) + K_y_half(j) * alpha_prime_y_half(j)))
+
+ enddo
+
+! damping in the Z direction
+
+! origin of the PML layer (position of right edge minus thickness, in meters)
+ zoriginbottom = thickness_PML_z
+ zorigintop = (NZ-1)*DELTAZ - thickness_PML_z
+
+ do k = 1,NZ
+
+! abscissa of current grid point along the damping profile
+ zval = DELTAZ * dble(k-1)
+
+!---------- zmin edge
+ if(USE_PML_ZMIN) then
+
+! define damping profile at the grid points
+ abscissa_in_PML = zoriginbottom - zval
+ if(abscissa_in_PML >= ZERO) then
+ abscissa_normalized = abscissa_in_PML / thickness_PML_z
+ d_z(k) = d0_z * abscissa_normalized**NPOWER
+! this taken from Gedney page 8.2
+ K_z(k) = 1.d0 + (K_MAX_PML - 1.d0) * abscissa_normalized**NPOWER
+ alpha_prime_z(k) = ALPHA_MAX_PML * (1.d0 - abscissa_normalized)
+ endif
+
+! define damping profile at half the grid points
+ abscissa_in_PML = zoriginbottom - (zval + DELTAZ/2.d0)
+ if(abscissa_in_PML >= ZERO) then
+ abscissa_normalized = abscissa_in_PML / thickness_PML_z
+ d_z_half(k) = d0_z * abscissa_normalized**NPOWER
+! this taken from Gedney page 8.2
+ K_z_half(k) = 1.d0 + (K_MAX_PML - 1.d0) * abscissa_normalized**NPOWER
+ alpha_prime_z_half(k) = ALPHA_MAX_PML * (1.d0 - abscissa_normalized)
+ endif
+
+ endif
+
+!---------- zmax edge
+ if(USE_PML_ZMAX) then
+
+! define damping profile at the grid points
+ abscissa_in_PML = zval - zorigintop
+ if(abscissa_in_PML >= ZERO) then
+ abscissa_normalized = abscissa_in_PML / thickness_PML_z
+ d_z(k) = d0_z * abscissa_normalized**NPOWER
+! this taken from Gedney page 8.2
+ K_z(k) = 1.d0 + (K_MAX_PML - 1.d0) * abscissa_normalized**NPOWER
+ alpha_prime_z(k) = ALPHA_MAX_PML * (1.d0 - abscissa_normalized)
+ endif
+
+! define damping profile at half the grid points
+ abscissa_in_PML = zval + DELTAZ/2.d0 - zorigintop
+ if(abscissa_in_PML >= ZERO) then
+ abscissa_normalized = abscissa_in_PML / thickness_PML_z
+ d_z_half(k) = d0_z * abscissa_normalized**NPOWER
+! this taken from Gedney page 8.2
+ K_z_half(k) = 1.d0 + (K_MAX_PML - 1.d0) * abscissa_normalized**NPOWER
+ alpha_prime_z_half(k) = ALPHA_MAX_PML * (1.d0 - abscissa_normalized)
+ endif
+
+ endif
+
+ b_z(k) = exp(- (d_z(k) / K_z(k) + alpha_prime_z(k)) * DELTAT)
+ b_z_half(k) = exp(- (d_z_half(k) / K_z_half(k) + alpha_prime_z_half(k)) * DELTAT)
+
+! this to avoid division by zero outside the PML
+ if(abs(d_z(k)) > 1.d-6) a_z(k) = d_z(k) * (b_z(k) - 1.d0) / (K_z(k) * (d_z(k) + K_z(k) * alpha_prime_z(k)))
+ if(abs(d_z_half(k)) > 1.d-6) a_z_half(k) = d_z_half(k) * &
+ (b_z_half(k) - 1.d0) / (K_z_half(k) * (d_z_half(k) + K_z_half(k) * alpha_prime_z_half(k)))
+
+ enddo
+
+ if(rank == rank_cut_plane) then
+
+! print position of the source
+ print *
+ print *,'Position of the source:'
+ print *
+ print *,'x = ',xsource
+ print *,'y = ',ysource
+ print *
+
+! define location of receivers
+ print *
+ print *,'There are ',nrec,' receivers'
+ print *
+! xspacerec = (xfin-xdeb) / dble(NREC-1)
+! yspacerec = (yfin-ydeb) / dble(NREC-1)
+! do irec=1,nrec
+! xrec(irec) = xdeb + dble(irec-1)*xspacerec
+! yrec(irec) = ydeb + dble(irec-1)*yspacerec
+! enddo
+
+ xrec(1)=xsource+500.d0 ! first receiver x in meters
+ yrec(1)=ysource+500.d0 ! first receiver y in meters
+ xrec(2)=xsource ! first receiver x in meters
+ yrec(2)=ysource+2260.d0 ! first receiver y in meters
+ xrec(3)=xsource+500.d0 ! first receiver x in meters
+ yrec(3)=ysource+2260.d0 ! first receiver y in meters
+
+! find closest grid point for each receiver
+ do irec=1,nrec
+ dist = HUGEVAL
+ do j = 1,NY
+ do i = 1,NX
+ distval = sqrt((DELTAX*dble(i) - xrec(irec))**2 + (DELTAY*dble(j) - yrec(irec))**2)
+ if(distval < dist) then
+ dist = distval
+ ix_rec(irec) = i
+ iy_rec(irec) = j
+ endif
+ enddo
+ enddo
+ print *,'receiver ',irec,' x_target,y_target = ',xrec(irec),yrec(irec)
+ print *,'closest grid point found at distance ',dist,' in i,j = ',ix_rec(irec),iy_rec(irec)
+ print *
+ enddo
+
+ endif
+
+! check the Courant stability condition for the explicit time scheme
+! R. Courant et K. O. Friedrichs et H. Lewy (1928)
+ Courant_number = cp * dsqrt(taumax)* DELTAT * sqrt(1.d0/DELTAX**2 + 1.d0/DELTAY**2 + 1.d0/DELTAZ**2)
+ if(rank == rank_cut_plane) then
+ print *,'Courant number is ',Courant_number
+ print *,'Vpmax=',cp*dsqrt(taumax)
+ endif
+ if(Courant_number > 1.d0) stop 'time step is too large, simulation will be unstable'
+ print *, "Number of points per wavelength =",cs*dsqrt(taumin)/(2.5d0*f0)/DELTAX,&
+ 'Vsmin=',cs*dsqrt(taumin)
+
+! erase main arrays
+ vx(:,:,:) = ZERO
+ vy(:,:,:) = ZERO
+ vz(:,:,:) = ZERO
+
+ sigmaxy(:,:,:) = ZERO
+ sigmayy(:,:,:) = ZERO
+ sigmazz(:,:,:) = ZERO
+ sigmaxz(:,:,:) = ZERO
+ sigmazz(:,:,:) = ZERO
+ sigmayz(:,:,:) = ZERO
+
+ e1_mech1(:,:,:)=ZERO
+ e1_mech2(:,:,:)=ZERO
+ e11_mech1(:,:,:)=ZERO
+ e11_mech2(:,:,:)=ZERO
+ e12_mech1(:,:,:)=ZERO
+ e12_mech2(:,:,:)=ZERO
+ e13_mech1(:,:,:)=ZERO
+ e13_mech2(:,:,:)=ZERO
+ e23_mech1(:,:,:)=ZERO
+ e23_mech2(:,:,:)=ZERO
+ e22_mech1(:,:,:)=ZERO
+ e22_mech2(:,:,:)=ZERO
+
+! PML
+ memory_dvx_dx(:,:,:) = ZERO
+ memory_dvx_dy(:,:,:) = ZERO
+ memory_dvx_dz(:,:,:) = ZERO
+ memory_dvy_dx(:,:,:) = ZERO
+ memory_dvy_dy(:,:,:) = ZERO
+ memory_dvy_dz(:,:,:) = ZERO
+ memory_dvz_dx(:,:,:) = ZERO
+ memory_dvz_dy(:,:,:) = ZERO
+ memory_dvz_dz(:,:,:) = ZERO
+ memory_dsigmaxx_dx(:,:,:) = ZERO
+ memory_dsigmayy_dy(:,:,:) = ZERO
+ memory_dsigmazz_dz(:,:,:) = ZERO
+ memory_dsigmaxy_dx(:,:,:) = ZERO
+ memory_dsigmaxy_dy(:,:,:) = ZERO
+ memory_dsigmaxz_dx(:,:,:) = ZERO
+ memory_dsigmaxz_dz(:,:,:) = ZERO
+ memory_dsigmayz_dy(:,:,:) = ZERO
+ memory_dsigmayz_dz(:,:,:) = ZERO
+
+! erase seismograms
+ sisvx(:,:) = ZERO
+ sisvy(:,:) = ZERO
+
+! initialize total energy
+ total_energy(:) = ZERO
+ total_energy_kinetic(:) = ZERO
+ total_energy_potential(:) = ZERO
+
+ call date_and_time(datein,timein,zone,time_values)
+! time_values(3): day of the month
+! time_values(5): hour of the day
+! time_values(6): minutes of the hour
+! time_values(7): seconds of the minute
+! time_values(8): milliseconds of the second
+! this fails if we cross the end of the month
+ time_start = 86400.d0*time_values(3) + 3600.d0*time_values(5) + &
+ 60.d0*time_values(6) + time_values(7) + time_values(8) / 1000.d0
+
+!---
+
+! we receive from the process on the left, and send to the process on the right
+ sender_right_shift = rank - 1
+ receiver_right_shift = rank + 1
+
+! if we are the first process, there is no neighbor on the left
+ if(rank == 0) sender_right_shift = MPI_PROC_NULL
+
+! if we are the last process, there is no neighbor on the right
+ if(rank == nb_procs - 1) receiver_right_shift = MPI_PROC_NULL
+
+!---
+
+! we receive from the process on the right, and send to the process on the left
+ sender_left_shift = rank + 1
+ receiver_left_shift = rank - 1
+
+! if we are the first process, there is no neighbor on the left
+ if(rank == 0) receiver_left_shift = MPI_PROC_NULL
+
+! if we are the last process, there is no neighbor on the right
+ if(rank == nb_procs - 1) sender_left_shift = MPI_PROC_NULL
+
+ k2begin = 1
+ if(rank == 0) k2begin = 2
+
+ kminus1end = NZ_LOCAL
+ if(rank == nb_procs - 1) kminus1end = NZ_LOCAL - 1
+
+!---
+!--- beginning of time loop
+!---
+
+ do it = 1,NSTEP
+
+ if(rank == rank_cut_plane .AND. mod(it,20).eq.0) print *,'it = ',it
+
+!----------------------
+! compute stress sigma
+!----------------------
+
+! vx(k+1), left shift
+ call MPI_SENDRECV(vx(:,:,1:2),number_of_values,MPI_DOUBLE_PRECISION, &
+ receiver_left_shift,message_tag,vx(:,:,NZ_LOCAL+1:NZ_LOCAL+2),number_of_values, &
+ MPI_DOUBLE_PRECISION,sender_left_shift,message_tag,MPI_COMM_WORLD,message_status,code)
+
+! vy(k+1), left shift
+ call MPI_SENDRECV(vy(:,:,1:2),number_of_values,MPI_DOUBLE_PRECISION, &
+ receiver_left_shift,message_tag,vy(:,:,NZ_LOCAL+1:NZ_LOCAL+2),number_of_values, &
+ MPI_DOUBLE_PRECISION,sender_left_shift,message_tag,MPI_COMM_WORLD,message_status,code)
+
+! vz(k-1), right shift
+ call MPI_SENDRECV(vz(:,:,NZ_LOCAL-1:NZ_LOCAL),number_of_values,MPI_DOUBLE_PRECISION, &
+ receiver_right_shift,message_tag,vz(:,:,-1:0),number_of_values, &
+ MPI_DOUBLE_PRECISION,sender_right_shift,message_tag,MPI_COMM_WORLD,message_status,code)
+
+ do k=k2begin,NZ_LOCAL
+ kglobal = k + offset_k
+ do j=2,NY
+ do i=1,NX-1
+
+ mul_relaxed = mu
+ lambdal_relaxed = lambda
+ lambdalplus2mul_relaxed = lambdal_relaxed + TWO*mul_relaxed
+ lambdal_unrelaxed = (lambdal_relaxed + 2.d0/DIM*mul_relaxed) * Mu_nu1 - 2.d0/DIM*mul_relaxed * Mu_nu2
+ mul_unrelaxed = mul_relaxed * Mu_nu2
+ lambdalplus2mul_unrelaxed = lambdal_unrelaxed + TWO*mul_unrelaxed
+
+ value_dvx_dx = (27.d0*vx(i+1,j,k)-27.d0*vx(i,j,k)-vx(i+2,j,k)+vx(i-1,j,k)) * ONE_OVER_DELTAX/24.d0
+ value_dvy_dy = (27.d0*vy(i,j,k)-27.d0*vy(i,j-1,k)-vy(i,j+1,k)+vy(i,j-2,k)) * ONE_OVER_DELTAY/24.d0
+ value_dvz_dz = (27.d0*vz(i,j,k)-27.d0*vz(i,j,k-1)-vz(i,j,k+1)+vz(i,j,k-2)) * ONE_OVER_DELTAZ/24.d0
+
+ memory_dvx_dx(i,j,k) = b_x_half(i) * memory_dvx_dx(i,j,k) + a_x_half(i) * value_dvx_dx
+ memory_dvy_dy(i,j,k) = b_y(j) * memory_dvy_dy(i,j,k) + a_y(j) * value_dvy_dy
+ memory_dvz_dz(i,j,k) = b_z(kglobal) * memory_dvz_dz(i,j,k) + a_z(kglobal) * value_dvz_dz
+
+ duxdx = value_dvx_dx / K_x_half(i) + memory_dvx_dx(i,j,k)
+ duydy = value_dvy_dy / K_y(j) + memory_dvy_dy(i,j,k)
+ duzdz = value_dvz_dz / K_z(kglobal) + memory_dvz_dz(i,j,k)
+
+ div=duxdx+duydy+duzdz
+
+!evolution e1_mech1
+ tauinv = - inv_tau_sigma_nu1_mech1
+ Un = e1_mech1(i,j,k)
+ Sn = div * phi_nu1_mech1
+ tauinvUn = tauinv * Un
+ Unp1 = (Un + deltat*(Sn+0.5d0*tauinvUn))/(1.d0-deltat*0.5d0*tauinv)
+ e1_mech1(i,j,k) = Unp1
+
+!evolution e1_mech2
+ tauinv = - inv_tau_sigma_nu1_mech2
+ Un = e1_mech2(i,j,k)
+ Sn = div * phi_nu1_mech2
+ tauinvUn = tauinv * Un
+ Unp1 = (Un + deltat*(Sn+0.5d0*tauinvUn))/(1.d0-deltat*0.5d0*tauinv)
+ e1_mech2(i,j,k) = Unp1
+
+! evolution e11_mech1
+ tauinv = - inv_tau_sigma_nu2_mech1
+ Un = e11_mech1(i,j,k)
+ Sn = (duxdx - div/DIM) * phi_nu2_mech1
+ tauinvUn = tauinv * Un
+ Unp1 = (Un + deltat*(Sn+0.5d0*tauinvUn))/(1.d0-deltat*0.5d0*tauinv)
+ e11_mech1(i,j,k) = Unp1
+
+! evolution e11_mech2
+ tauinv = - inv_tau_sigma_nu2_mech2
+ Un = e11_mech2(i,j,k)
+ Sn = (duxdx - div/DIM) * phi_nu2_mech2
+ tauinvUn = tauinv * Un
+ Unp1 = (Un + deltat*(Sn+0.5d0*tauinvUn))/(1.d0-deltat*0.5d0*tauinv)
+ e11_mech2(i,j,k) = Unp1
+
+! evolution e22_mech1
+ tauinv = - inv_tau_sigma_nu2_mech1
+ Un = e22_mech1(i,j,k)
+ Sn = (duydy - div/DIM) * phi_nu2_mech1
+ tauinvUn = tauinv * Un
+ Unp1 = (Un + deltat*(Sn+0.5d0*tauinvUn))/(1.d0-deltat*0.5d0*tauinv)
+ e22_mech1(i,j,k) = Unp1
+
+! evolution e22_mech2
+ tauinv = - inv_tau_sigma_nu2_mech2
+ Un = e22_mech2(i,j,k)
+ Sn = (duydy - div/DIM) * phi_nu2_mech2
+ tauinvUn = tauinv * Un
+ Unp1 = (Un + deltat*(Sn+0.5d0*tauinvUn))/(1.d0-deltat*0.5d0*tauinv)
+ e22_mech2(i,j,k) = Unp1
+
+
+!add the memory variables using the relaxed parameters (Carcione page 111)
+! : there is a bug in Carcione's equation for sigma_zz
+ sigmaxx(i,j,k) = sigmaxx(i,j,k)+deltat*((lambdal_relaxed + 2.d0/DIM*mul_relaxed)* &
+ (e1_mech1(i,j,k) + e1_mech2(i,j,k)) + TWO * mul_relaxed * (e11_mech1(i,j,k) + e11_mech2(i,j,k)))
+ sigmayy(i,j,k) = sigmayy(i,j,k)+deltat*((lambdal_relaxed + 2.d0/DIM*mul_relaxed)* &
+ (e1_mech1(i,j,k) + e1_mech2(i,j,k)) + TWO * mul_relaxed * (e22_mech1(i,j,k) + e22_mech2(i,j,k)))
+ sigmazz(i,j,k) = sigmazz(i,j,k)+deltat*((lambdal_relaxed + 2.d0*mul_relaxed)* &
+ (e1_mech1(i,j,k) + e1_mech2(i,j,k)) - TWO/DIM * mul_relaxed * (e11_mech1(i,j,k) + e11_mech2(i,j,k)&
+ +e22_mech1(i,j,k) + e22_mech2(i,j,k)))
+
+! compute the stress using the unrelaxed Lame parameters (Carcione page 111)
+
+ sigmaxx(i,j,k) = sigmaxx(i,j,k) + &
+ (lambdalplus2mul_unrelaxed * (duxdx) + &
+ lambdal_unrelaxed* (duydy) + &
+ lambdal_unrelaxed* (duzdz) )* DELTAT
+
+ sigmayy(i,j,k) = sigmayy(i,j,k) + &
+ (lambdal_unrelaxed * (duxdx) + &
+ lambdalplus2mul_unrelaxed* (duydy) +&
+ lambdal_unrelaxed* (duzdz)) * DELTAT
+
+ sigmazz(i,j,k) = sigmazz(i,j,k) + &
+ (lambdal_unrelaxed * (duxdx) + &
+ lambdal_unrelaxed* (duydy) + &
+ lambdalplus2mul_unrelaxed* (duzdz)) * DELTAT
+
+ sigmaxx_R(i,j,k) = sigmaxx_R(i,j,k) + &
+ (lambdalplus2mul_relaxed * (duxdx) + &
+ lambdal_relaxed* (duydy) + &
+ lambdal_relaxed* (duzdz) )* DELTAT
+
+ sigmayy_R(i,j,k) = sigmayy_R(i,j,k) + &
+ (lambdal_relaxed * (duxdx) + &
+ lambdalplus2mul_relaxed* (duydy) +&
+ lambdal_relaxed* (duzdz)) * DELTAT
+
+ sigmazz_R(i,j,k) = sigmazz_R(i,j,k) + &
+ (lambdal_relaxed * (duxdx) + &
+ lambdal_relaxed* (duydy) + &
+ lambdalplus2mul_relaxed* (duzdz)) * DELTAT
+
+ enddo
+ enddo
+ enddo
+
+ do k=1,NZ_LOCAL
+ do j=1,NY-1
+ do i=2,NX
+ mul_relaxed = mu
+ mul_unrelaxed = mul_relaxed * Mu_nu2
+
+ value_dvy_dx = (27.d0*vy(i,j,k)-27.d0*vy(i-1,j,k)-vy(i+1,j,k)+vy(i-2,j,k)) * ONE_OVER_DELTAX/24.d0
+ value_dvx_dy = (27.d0*vx(i,j+1,k)-27.d0*vx(i,j,k)-vx(i,j+2,k)+vx(i,j-1,k)) * ONE_OVER_DELTAY/24.d0
+
+ memory_dvy_dx(i,j,k) = b_x(i) * memory_dvy_dx(i,j,k) + a_x(i) * value_dvy_dx
+ memory_dvx_dy(i,j,k) = b_y_half(j) * memory_dvx_dy(i,j,k) + a_y_half(j) * value_dvx_dy
+
+ duydx = value_dvy_dx / K_x(i) + memory_dvy_dx(i,j,k)
+ duxdy = value_dvx_dy / K_y_half(j) + memory_dvx_dy(i,j,k)
+
+! evolution e12_mech1
+ tauinv = - inv_tau_sigma_nu2_mech1
+ Un = e12_mech1(i,j,k)
+ Sn = (duxdy+duydx) * phi_nu2_mech1
+ tauinvUn = tauinv * Un
+ Unp1 = (Un + deltat*(Sn+0.5d0*tauinvUn))/(1.d0-deltat*0.5d0*tauinv)
+ e12_mech1(i,j,k) = Unp1
+
+! evolution e12_mech2
+ tauinv = - inv_tau_sigma_nu2_mech2
+ Un = e12_mech2(i,j,k)
+ Sn = (duxdy+duydx) * phi_nu2_mech2
+ tauinvUn = tauinv * Un
+ Unp1 = (Un + deltat*(Sn+0.5d0*tauinvUn))/(1.d0-deltat*0.5d0*tauinv)
+ e12_mech2(i,j,k) = Unp1
+
+ sigmaxy(i,j,k) = sigmaxy(i,j,k)+deltat*mul_relaxed * (e12_mech1(i,j,k) + e12_mech2(i,j,k))
+
+ sigmaxy(i,j,k) = sigmaxy(i,j,k) + &
+ mul_unrelaxed * (duxdy+duydx) * DELTAT
+
+ sigmaxy_R(i,j,k) = sigmaxy_R(i,j,k) + &
+ mul_relaxed * (duxdy+duydx) * DELTAT
+
+ enddo
+ enddo
+ enddo
+
+ do k=1,kminus1end
+ kglobal = k + offset_k
+ do j=1,NY
+ do i=2,NX
+ mul_relaxed = mu
+ mul_unrelaxed = mul_relaxed * Mu_nu2
+
+ value_dvz_dx = (27.d0*vz(i,j,k)-27.d0*vz(i-1,j,k)-vz(i+1,j,k)+vz(i-2,j,k)) * ONE_OVER_DELTAX/24.d0
+ value_dvx_dz = (27.d0*vx(i,j,k+1)-27.d0*vx(i,j,k)-vx(i,j,k+2)+vx(i,j,k-1)) * ONE_OVER_DELTAZ/24.d0
+
+ memory_dvz_dx(i,j,k) = b_x(i) * memory_dvz_dx(i,j,k) + a_x(i) * value_dvz_dx
+ memory_dvx_dz(i,j,k) = b_z_half(kglobal) * memory_dvx_dz(i,j,k) + a_z_half(kglobal) * value_dvx_dz
+
+ duzdx = value_dvz_dx / K_x(i) + memory_dvz_dx(i,j,k)
+ duxdz = value_dvx_dz / K_z_half(kglobal) + memory_dvx_dz(i,j,k)
+
+! evolution e13_mech1
+ tauinv = - inv_tau_sigma_nu2_mech1
+ Un = e13_mech1(i,j,k)
+ Sn = (duxdz+duzdx) * phi_nu2_mech1
+ tauinvUn = tauinv * Un
+ Unp1 = (Un + deltat*(Sn+0.5d0*tauinvUn))/(1.d0-deltat*0.5d0*tauinv)
+ e13_mech1(i,j,k) = Unp1
+
+! evolution e13_mech2
+ tauinv = - inv_tau_sigma_nu2_mech2
+ Un = e13_mech2(i,j,k)
+ Sn = (duxdz+duzdx) * phi_nu2_mech2
+ tauinvUn = tauinv * Un
+ Unp1 = (Un + deltat*(Sn+0.5d0*tauinvUn))/(1.d0-deltat*0.5d0*tauinv)
+ e13_mech2(i,j,k) = Unp1
+
+ sigmaxz(i,j,k) = sigmaxz(i,j,k)+deltat*mul_relaxed * (e13_mech1(i,j,k) + e13_mech2(i,j,k))
+
+ sigmaxz(i,j,k) = sigmaxz(i,j,k) + &
+ mul_unrelaxed * (duxdz+duzdx) * DELTAT
+
+ sigmaxz_R(i,j,k) = sigmaxz_R(i,j,k) + &
+ mul_relaxed * (duxdz+duzdx) * DELTAT
+ enddo
+ enddo
+
+ do j=1,NY-1
+ do i=1,NX
+ mul_relaxed = mu
+ mul_unrelaxed = mul_relaxed * Mu_nu2
+
+ value_dvz_dy = (27.d0*vz(i,j+1,k)-27.d0*vz(i,j,k)-vz(i,j+2,k)+vz(i,j-1,k)) * ONE_OVER_DELTAY/24.d0
+ value_dvy_dz = (27.d0*vy(i,j,k+1)-27.d0*vy(i,j,k)-vy(i,j,k+2)+vy(i,j,k-1)) * ONE_OVER_DELTAZ/24.d0
+
+ memory_dvz_dy(i,j,k) = b_y_half(j) * memory_dvz_dy(i,j,k) + a_y_half(j) * value_dvz_dy
+ memory_dvy_dz(i,j,k) = b_z_half(kglobal) * memory_dvy_dz(i,j,k) + a_z_half(kglobal) * value_dvy_dz
+
+ duzdy = value_dvz_dy / K_y_half(j) + memory_dvz_dy(i,j,k)
+ duydz = value_dvy_dz / K_z_half(kglobal) + memory_dvy_dz(i,j,k)
+
+! evolution e23_mech1
+ tauinv = - inv_tau_sigma_nu2_mech1
+ Un = e23_mech1(i,j,k)
+ Sn = (duydz+duzdy) * phi_nu2_mech1
+ tauinvUn = tauinv * Un
+ Unp1 = (Un + deltat*(Sn+0.5d0*tauinvUn))/(1.d0-deltat*0.5d0*tauinv)
+ e23_mech1(i,j,k) = Unp1
+
+! evolution e23_mech2
+ tauinv = - inv_tau_sigma_nu2_mech2
+ Un = e23_mech2(i,j,k)
+ Sn = (duydz+duzdy) * phi_nu2_mech2
+ tauinvUn = tauinv * Un
+ Unp1 = (Un + deltat*(Sn+0.5d0*tauinvUn))/(1.d0-deltat*0.5d0*tauinv)
+ e23_mech2(i,j,k) = Unp1
+
+ sigmayz(i,j,k) = sigmayz(i,j,k)+deltat*mul_relaxed * (e23_mech1(i,j,k) + e23_mech2(i,j,k))
+
+ sigmayz(i,j,k) = sigmayz(i,j,k) + &
+ mul_unrelaxed * (duydz+duzdy) * DELTAT
+
+ sigmayz_R(i,j,k) = sigmayz_R(i,j,k) + &
+ mul_relaxed * (duydz+duzdy) * DELTAT
+
+ enddo
+ enddo
+ enddo
+
+!------------------
+! compute velocity
+!------------------
+
+! sigmazz(k+1), left shift
+ call MPI_SENDRECV(sigmazz(:,:,1:2),number_of_values,MPI_DOUBLE_PRECISION, &
+ receiver_left_shift,message_tag,sigmazz(:,:,NZ_LOCAL+1:NZ_LOCAL+2),number_of_values, &
+ MPI_DOUBLE_PRECISION,sender_left_shift,message_tag,MPI_COMM_WORLD,message_status,code)
+
+! sigmayz(k-1), right shift
+ call MPI_SENDRECV(sigmayz(:,:,NZ_LOCAL-1:NZ_LOCAL),number_of_values,MPI_DOUBLE_PRECISION, &
+ receiver_right_shift,message_tag,sigmayz(:,:,-1:0),number_of_values, &
+ MPI_DOUBLE_PRECISION,sender_right_shift,message_tag,MPI_COMM_WORLD,message_status,code)
+
+! sigmaxz(k-1), right shift
+ call MPI_SENDRECV(sigmaxz(:,:,NZ_LOCAL-1:NZ_LOCAL),number_of_values,MPI_DOUBLE_PRECISION, &
+ receiver_right_shift,message_tag,sigmaxz(:,:,-1:0),number_of_values, &
+ MPI_DOUBLE_PRECISION,sender_right_shift,message_tag,MPI_COMM_WORLD,message_status,code)
+
+ do k=k2begin,NZ_LOCAL
+ kglobal = k + offset_k
+ do j=2,NY
+ do i=2,NX
+
+ value_dsigmaxx_dx = (27.d0*sigmaxx(i,j,k)-27.d0*sigmaxx(i-1,j,k)-sigmaxx(i+1,j,k)+sigmaxx(i-2,j,k)) * ONE_OVER_DELTAX/24.d0
+ value_dsigmaxy_dy = (27.d0*sigmaxy(i,j,k)-27.d0*sigmaxy(i,j-1,k)-sigmaxy(i,j+1,k)+sigmaxy(i,j-2,k)) * ONE_OVER_DELTAY/24.d0
+ value_dsigmaxz_dz = (27.d0*sigmaxz(i,j,k)-27.d0*sigmaxz(i,j,k-1)-sigmaxz(i,j,k+1)+sigmaxz(i,j,k-2)) * ONE_OVER_DELTAZ/24.d0
+
+ memory_dsigmaxx_dx(i,j,k) = b_x(i) * memory_dsigmaxx_dx(i,j,k) + a_x(i) * value_dsigmaxx_dx
+ memory_dsigmaxy_dy(i,j,k) = b_y(j) * memory_dsigmaxy_dy(i,j,k) + a_y(j) * value_dsigmaxy_dy
+ memory_dsigmaxz_dz(i,j,k) = b_z(kglobal) * memory_dsigmaxz_dz(i,j,k) + a_z(kglobal) * value_dsigmaxz_dz
+
+ value_dsigmaxx_dx = value_dsigmaxx_dx / K_x(i) + memory_dsigmaxx_dx(i,j,k)
+ value_dsigmaxy_dy = value_dsigmaxy_dy / K_y(j) + memory_dsigmaxy_dy(i,j,k)
+ value_dsigmaxz_dz = value_dsigmaxz_dz / K_z(kglobal) + memory_dsigmaxz_dz(i,j,k)
+
+ vx(i,j,k) = DELTAT_over_rho*(value_dsigmaxx_dx + value_dsigmaxy_dy + value_dsigmaxz_dz) + vx(i,j,k)
+
+ enddo
+ enddo
+
+ do j=1,NY-1
+ do i=1,NX-1
+
+ value_dsigmaxy_dx = (27.d0*sigmaxy(i+1,j,k)-27.d0*sigmaxy(i,j,k)-sigmaxy(i+2,j,k)+sigmaxy(i-1,j,k)) * ONE_OVER_DELTAX/24.d0
+ value_dsigmayy_dy = (27.d0*sigmayy(i,j+1,k)-27.d0*sigmayy(i,j,k)-sigmayy(i,j+2,k)+sigmayy(i,j-1,k)) * ONE_OVER_DELTAY/24.d0
+ value_dsigmayz_dz = (27.d0*sigmayz(i,j,k)-27.d0*sigmayz(i,j,k-1)-sigmayz(i,j,k+1)+sigmayz(i,j,k-2)) * ONE_OVER_DELTAZ/24.d0
+
+ memory_dsigmaxy_dx(i,j,k) = b_x_half(i) * memory_dsigmaxy_dx(i,j,k) + a_x_half(i) * value_dsigmaxy_dx
+ memory_dsigmayy_dy(i,j,k) = b_y_half(j) * memory_dsigmayy_dy(i,j,k) + a_y_half(j) * value_dsigmayy_dy
+ memory_dsigmayz_dz(i,j,k) = b_z(kglobal) * memory_dsigmayz_dz(i,j,k) + a_z(kglobal) * value_dsigmayz_dz
+
+ value_dsigmaxy_dx = value_dsigmaxy_dx / K_x_half(i) + memory_dsigmaxy_dx(i,j,k)
+ value_dsigmayy_dy = value_dsigmayy_dy / K_y_half(j) + memory_dsigmayy_dy(i,j,k)
+ value_dsigmayz_dz = value_dsigmayz_dz / K_z(kglobal) + memory_dsigmayz_dz(i,j,k)
+
+ vy(i,j,k) = DELTAT_over_rho*(value_dsigmaxy_dx + value_dsigmayy_dy + value_dsigmayz_dz) + vy(i,j,k)
+
+ enddo
+ enddo
+ enddo
+
+ do k=1,kminus1end
+ kglobal = k + offset_k
+ do j=2,NY
+ do i=1,NX-1
+
+ value_dsigmaxz_dx = (27.d0*sigmaxz(i+1,j,k)-27.d0*sigmaxz(i,j,k)-sigmaxz(i+2,j,k)+sigmaxz(i-1,j,k)) * ONE_OVER_DELTAX/24.d0
+ value_dsigmayz_dy = (27.d0*sigmayz(i,j,k)-27.d0*sigmayz(i,j-1,k)-sigmayz(i,j+1,k)+sigmayz(i,j-2,k)) * ONE_OVER_DELTAY/24.d0
+ value_dsigmazz_dz = (27.d0*sigmazz(i,j,k+1)-27.d0*sigmazz(i,j,k)-sigmazz(i,j,k+2)+sigmazz(i,j,k-1)) * ONE_OVER_DELTAZ/24.d0
+
+ memory_dsigmaxz_dx(i,j,k) = b_x_half(i) * memory_dsigmaxz_dx(i,j,k) + a_x_half(i) * value_dsigmaxz_dx
+ memory_dsigmayz_dy(i,j,k) = b_y(j) * memory_dsigmayz_dy(i,j,k) + a_y(j) * value_dsigmayz_dy
+ memory_dsigmazz_dz(i,j,k) = b_z_half(kglobal) * memory_dsigmazz_dz(i,j,k) + a_z_half(kglobal) * value_dsigmazz_dz
+
+ value_dsigmaxz_dx = value_dsigmaxz_dx / K_x_half(i) + memory_dsigmaxz_dx(i,j,k)
+ value_dsigmayz_dy = value_dsigmayz_dy / K_y(j) + memory_dsigmayz_dy(i,j,k)
+ value_dsigmazz_dz = value_dsigmazz_dz / K_z_half(kglobal) + memory_dsigmazz_dz(i,j,k)
+
+ vz(i,j,k) = DELTAT_over_rho*(value_dsigmaxz_dx + value_dsigmayz_dy + value_dsigmazz_dz) + vz(i,j,k)
+
+ enddo
+ enddo
+ enddo
+
+ if(rank == rank_cut_plane) then
+
+! add the source (force vector located at a given grid point)
+ a = pi*pi*f0*f0
+ t = dble(it-1)*DELTAT
+
+! Gaussian
+! source_term = factor * exp(-a*(t-t0)**2)
+
+! first derivative of a Gaussian
+ source_term = - factor * 2.d0*a*(t-t0)*exp(-a*(t-t0)**2)
+
+! Ricker source time function (second derivative of a Gaussian)
+! source_term = factor * (1.d0 - 2.d0*a*(t-t0)**2)*exp(-a*(t-t0)**2)
+
+ force_x = sin(ANGLE_FORCE * DEGREES_TO_RADIANS) * source_term
+ force_y = cos(ANGLE_FORCE * DEGREES_TO_RADIANS) * source_term
+
+! define location of the source
+ i = ISOURCE
+ j = JSOURCE
+
+ vx(i,j,NZ_LOCAL) = vx(i,j,NZ_LOCAL) + force_x * DELTAT / rho
+ vy(i,j,NZ_LOCAL) = vy(i,j,NZ_LOCAL) + force_y * DELTAT / rho
+
+ endif
+
+! implement Dirichlet boundary conditions on the six edges of the grid
+
+! xmin
+ vx(0:1,:,:) = ZERO
+ vy(0:1,:,:) = ZERO
+ vz(0:1,:,:) = ZERO
+
+! xmax
+ vx(NX:NX+1,:,:) = ZERO
+ vy(NX:NX+1,:,:) = ZERO
+ vz(NX:NX+1,:,:) = ZERO
+
+! ymin
+ vx(:,0:1,:) = ZERO
+ vy(:,0:1,:) = ZERO
+ vz(:,0:1,:) = ZERO
+
+! ymax
+ vx(:,NY:NY+1,:) = ZERO
+ vy(:,NY:NY+1,:) = ZERO
+ vz(:,NY:NY+1,:) = ZERO
+
+! zmin
+ if(rank == 0) then
+ vx(:,:,0:1) = ZERO
+ vy(:,:,0:1) = ZERO
+ vz(:,:,0:1) = ZERO
+ endif
+
+! zmax
+ if(rank == nb_procs-1) then
+ vx(:,:,NZ_LOCAL:NZ_LOCAL+1) = ZERO
+ vy(:,:,NZ_LOCAL:NZ_LOCAL+1) = ZERO
+ vz(:,:,NZ_LOCAL:NZ_LOCAL+1) = ZERO
+ endif
+
+! store seismograms
+ if(rank == rank_cut_plane) then
+ do irec = 1,NREC
+ sisvx(it,irec) = vx(ix_rec(irec),iy_rec(irec),NZ_LOCAL)
+ sisvy(it,irec) = vy(ix_rec(irec),iy_rec(irec),NZ_LOCAL)
+ enddo
+ endif
+
+! compute total energy in the medium (without the PML layers)
+ local_energy_kinetic = ZERO
+ local_energy_potential = ZERO
+
+ kmin = 1
+ kmax = NZ_LOCAL
+ if(rank == 0) kmin = NPOINTS_PML
+ if(rank == nb_procs-1) kmax = NZ_LOCAL-NPOINTS_PML+1
+
+ do k = kmin,kmax
+ do j = NPOINTS_PML, NY-NPOINTS_PML+1
+ do i = NPOINTS_PML, NX-NPOINTS_PML+1
+
+! compute kinetic energy first, defined as 1/2 rho ||v||^2
+! in principle we should use rho_half_x_half_y instead of rho for vy
+! in order to interpolate density at the right location in the staggered grid cell
+! but in a homogeneous medium we can safely ignore it
+ local_energy_kinetic = local_energy_kinetic + 0.5d0 * rho*( &
+ vx(i,j,k)**2 + vy(i,j,k)**2 + vz(i,j,k)**2)
+
+! add potential energy, defined as 1/2 epsilon_ij sigma_ij
+! in principle we should interpolate the medium parameters at the right location
+! in the staggered grid cell but in a homogeneous medium we can safely ignore it
+
+! compute total field from split components
+ epsilon_xx = ((lambda + 2.d0*mu) * sigmaxx_R(i,j,k) - lambda * sigmayy_R(i,j,k) - &
+ lambda*sigmazz_R(i,j,k)) / (4.d0 * mu * (lambda + mu))
+ epsilon_yy = ((lambda + 2.d0*mu) * sigmayy_R(i,j,k) - lambda * sigmaxx_R(i,j,k) - &
+ lambda*sigmazz_R(i,j,k)) / (4.d0 * mu * (lambda + mu))
+ epsilon_zz = ((lambda + 2.d0*mu) * sigmazz_R(i,j,k) - lambda * sigmaxx_R(i,j,k) - &
+ lambda*sigmayy_R(i,j,k)) / (4.d0 * mu * (lambda + mu))
+ epsilon_xy = sigmaxy_R(i,j,k) / (2.d0 * mu)
+ epsilon_xz = sigmaxz_R(i,j,k) / (2.d0 * mu)
+ epsilon_yz = sigmayz_R(i,j,k) / (2.d0 * mu)
+
+ local_energy_potential = local_energy_potential + &
+ 0.5d0 * (epsilon_xx * sigmaxx_R(i,j,k) + epsilon_yy * sigmayy_R(i,j,k) + &
+ epsilon_yy * sigmayy_R(i,j,k)+ 2.d0 * epsilon_xy * sigmaxy_R(i,j,k) + &
+ 2.d0*epsilon_xz * sigmaxz_R(i,j,k)+2.d0*epsilon_yz * sigmayz_R(i,j,k))
+
+ enddo
+ enddo
+ enddo
+
+ call MPI_REDUCE(local_energy_kinetic + local_energy_potential,total_energy(it),1, &
+ MPI_DOUBLE_PRECISION,MPI_SUM,rank_cut_plane,MPI_COMM_WORLD,code)
+ call MPI_REDUCE(local_energy_kinetic,total_energy_kinetic(it),1, &
+ MPI_DOUBLE_PRECISION,MPI_SUM,rank_cut_plane,MPI_COMM_WORLD,code)
+ call MPI_REDUCE(local_energy_potential,total_energy_potential(it),1, &
+ MPI_DOUBLE_PRECISION,MPI_SUM,rank_cut_plane,MPI_COMM_WORLD,code)
+
+! output information
+ if(mod(it,IT_DISPLAY) == 0 .or. it == 5) then
+
+ call MPI_REDUCE(maxval(sqrt(vx(:,:,1:NZ_LOCAL)**2 + vy(:,:,1:NZ_LOCAL)**2 + &
+ vz(:,:,1:NZ_LOCAL)**2)),Vsolidnorm,1,MPI_DOUBLE_PRECISION,MPI_MAX,rank_cut_plane,MPI_COMM_WORLD,code)
+
+ if(rank == rank_cut_plane) then
+
+ print *,'Time step # ',it
+ print *,'Time: ',sngl((it-1)*DELTAT),' seconds'
+ print *,'Max norm velocity vector V (m/s) = ',Vsolidnorm
+ print *,'Total energy = ',total_energy(it)
+! check stability of the code, exit if unstable
+ if(Vsolidnorm > STABILITY_THRESHOLD) stop 'code became unstable and blew up in solid'
+
+! count elapsed wall-clock time
+ call date_and_time(datein,timein,zone,time_values)
+! time_values(3): day of the month
+! time_values(5): hour of the day
+! time_values(6): minutes of the hour
+! time_values(7): seconds of the minute
+! time_values(8): milliseconds of the second
+! this fails if we cross the end of the month
+ time_end = 86400.d0*time_values(3) + 3600.d0*time_values(5) + &
+ 60.d0*time_values(6) + time_values(7) + time_values(8) / 1000.d0
+
+! elapsed time since beginning of the simulation
+ tCPU = time_end - time_start
+ int_tCPU = int(tCPU)
+ ihours = int_tCPU / 3600
+ iminutes = (int_tCPU - 3600*ihours) / 60
+ iseconds = int_tCPU - 3600*ihours - 60*iminutes
+ write(*,*) 'Elapsed time in seconds = ',tCPU
+ write(*,"(' Elapsed time in hh:mm:ss = ',i4,' h ',i2.2,' m ',i2.2,' s')") ihours,iminutes,iseconds
+ write(*,*) 'Mean elapsed time per time step in seconds = ',tCPU/dble(it)
+ write(*,*)
+
+! write time stamp file to give information about progression of simulation
+ write(outputname,"('timestamp',i6.6)") it
+ open(unit=IOUT,file=outputname,status='unknown')
+ write(IOUT,*) 'Time step # ',it
+ write(IOUT,*) 'Time: ',sngl((it-1)*DELTAT),' seconds'
+ write(IOUT,*) 'Max norm velocity vector V (m/s) = ',Vsolidnorm
+ write(IOUT,*) 'Total energy = ',total_energy(it)
+ write(IOUT,*) 'Elapsed time in seconds = ',tCPU
+ write(IOUT,"(' Elapsed time in hh:mm:ss = ',i4,' h ',i2.2,' m ',i2.2,' s')") ihours,iminutes,iseconds
+ write(IOUT,*) 'Mean elapsed time per time step in seconds = ',tCPU/dble(it)
+ close(IOUT)
+
+! save energy
+ open(unit=21,file='energy.dat',status='unknown')
+ do it2=1,NSTEP
+ write(21,*) sngl(dble(it2-1)*DELTAT),total_energy_kinetic(it2),&
+ total_energy_potential(it2),total_energy(it2)
+ enddo
+ close(21)
+
+! save seismograms
+ print *,'saving seismograms'
+ print *
+ call write_seismograms(sisvx,sisvy,NSTEP,NREC,DELTAT,t0)
+
+ call create_2D_image(vx(1:NX,1:NY,NZ_LOCAL),NX,NY,it,ISOURCE,JSOURCE,ix_rec,iy_rec,nrec, &
+ NPOINTS_PML,USE_PML_XMIN,USE_PML_XMAX,USE_PML_YMIN,USE_PML_YMAX,1,max_amplitudeVx)
+ call create_2D_image(vy(1:NX,1:NY,NZ_LOCAL),NX,NY,it,ISOURCE,JSOURCE,ix_rec,iy_rec,nrec, &
+ NPOINTS_PML,USE_PML_XMIN,USE_PML_XMAX,USE_PML_YMIN,USE_PML_YMAX,2,max_amplitudeVy)
+
+ endif
+ endif
+
+! --- end of time loop
+ enddo
+
+ if(rank == rank_cut_plane) then
+
+! save seismograms
+ call write_seismograms(sisvx,sisvy,NSTEP,NREC,DELTAT,t0)
+! open(unit=20,file='energy.dat',status='unknown')
+! do it = 1,NSTEP
+! write(20,*) sngl(dble(it-1)*DELTAT),total_energy(it)
+! enddo
+! close(20)
+
+! create script for Gnuplot for total energy
+ open(unit=20,file='plot_energy',status='unknown')
+ write(20,*) '# set term x11'
+ write(20,*) 'set term postscript landscape monochrome dashed "Helvetica" 22'
+ write(20,*)
+ write(20,*) 'set xlabel "Time (s)"'
+ write(20,*) 'set ylabel "Total energy"'
+ write(20,*)
+ write(20,*) 'set output "CPML3D_total_energy_semilog.eps"'
+ write(20,*) 'set logscale y'
+ write(20,*) 'plot "energy.dat" t ''Total energy'' w l 1'
+ write(20,*) 'pause -1 "Hit any key..."'
+ write(20,*)
+ close(20)
+
+! create script for Gnuplot
+ open(unit=20,file='plotgnu',status='unknown')
+ write(20,*) 'set term x11'
+ write(20,*) '# set term postscript landscape monochrome dashed "Helvetica" 22'
+ write(20,*)
+ write(20,*) 'set xlabel "Time (s)"'
+ write(20,*) 'set ylabel "Amplitude (m / s)"'
+ write(20,*)
+
+ write(20,*) 'set output "v_sigma_Vx_receiver_001.eps"'
+ write(20,*) 'plot "Vx_file_001.dat" t ''Vx C-PML'' w l 1'
+ write(20,*) 'pause -1 "Hit any key..."'
+ write(20,*)
+
+ write(20,*) 'set output "v_sigma_Vy_receiver_001.eps"'
+ write(20,*) 'plot "Vy_file_001.dat" t ''Vy C-PML'' w l 1'
+ write(20,*) 'pause -1 "Hit any key..."'
+ write(20,*)
+
+ write(20,*) 'set output "v_sigma_Vz_receiver_001.eps"'
+ write(20,*) 'plot "Vz_file_001.dat" t ''Vz C-PML'' w l 1'
+ write(20,*) 'pause -1 "Hit any key..."'
+ write(20,*)
+
+ write(20,*) 'set output "v_sigma_Vx_receiver_002.eps"'
+ write(20,*) 'plot "Vx_file_002.dat" t ''Vx C-PML'' w l 1'
+ write(20,*) 'pause -1 "Hit any key..."'
+ write(20,*)
+
+ write(20,*) 'set output "v_sigma_Vy_receiver_002.eps"'
+ write(20,*) 'plot "Vy_file_002.dat" t ''Vy C-PML'' w l 1'
+ write(20,*) 'pause -1 "Hit any key..."'
+ write(20,*)
+
+ write(20,*) 'set output "v_sigma_Vz_receiver_002.eps"'
+ write(20,*) 'plot "Vz_file_002.dat" t ''Vz C-PML'' w l 1'
+ write(20,*) 'pause -1 "Hit any key..."'
+ write(20,*)
+
+ close(20)
+
+ print *
+ print *,'End of the simulation'
+ print *
+
+ endif
+
+! close MPI program
+ call MPI_FINALIZE(code)
+
+ end program seismic_visco_CPML_3D_MPI_OpenMP
+
+!----
+!---- save the seismograms in ASCII text format
+!----
+
+ subroutine write_seismograms(sisvx,sisvy,nt,nrec,DELTAT,t0)
+
+ implicit none
+
+ integer nt,nrec
+ double precision DELTAT,t0
+
+ double precision sisvx(nt,nrec)
+ double precision sisvy(nt,nrec)
+
+ integer irec,it
+
+ character(len=100) file_name
+
+! X component
+ do irec=1,nrec
+ write(file_name,"('Vx_file_',i3.3,'.dat')") irec
+ open(unit=11,file=file_name,status='unknown')
+ do it=1,nt
+ write(11,*) sngl(dble(it-1)*DELTAT-t0),' ',sngl(sisvx(it,irec))
+ enddo
+ close(11)
+ enddo
+
+! Y component
+ do irec=1,nrec
+ write(file_name,"('Vy_file_',i3.3,'.dat')") irec
+ open(unit=11,file=file_name,status='unknown')
+ do it=1,nt
+ write(11,*) sngl(dble(it-1)*DELTAT-t0),' ',sngl(sisvy(it,irec))
+ enddo
+ close(11)
+ enddo
+
+ end subroutine write_seismograms
+
+!----
+!---- routine to create a color image of a given vector component
+!---- the image is created in PNM format and then converted to GIF
+!----
+
+ subroutine create_2D_image(image_data_2D,NX,NY,it,ISOURCE,JSOURCE,ix_rec,iy_rec,nrec, &
+ NPOINTS_PML,USE_PML_XMIN,USE_PML_XMAX,USE_PML_YMIN,USE_PML_YMAX,field_number,max_amplitude)
+
+ implicit none
+
+! non linear display to enhance small amplitudes for graphics
+ double precision, parameter :: POWER_DISPLAY = 0.30d0
+
+! amplitude threshold above which we draw the color point
+ double precision, parameter :: cutvect = 0.01d0
+
+! use black or white background for points that are below the threshold
+ logical, parameter :: WHITE_BACKGROUND = .true.
+
+! size of cross and square in pixels drawn to represent the source and the receivers
+ integer, parameter :: width_cross = 5, thickness_cross = 1, size_square = 3
+
+ integer NX,NY,it,field_number,ISOURCE,JSOURCE,NPOINTS_PML,nrec
+ logical USE_PML_XMIN,USE_PML_XMAX,USE_PML_YMIN,USE_PML_YMAX
+
+ double precision, dimension(NX,NY) :: image_data_2D
+
+ integer, dimension(nrec) :: ix_rec,iy_rec
+
+ integer :: ix,iy,irec
+
+ character(len=150) :: file_name
+! character(len=150) :: system_command
+
+ integer :: R, G, B
+
+ double precision :: normalized_value,max_amplitude
+
+! open image file and create system command to convert image to more convenient format
+ if(field_number == 1) then
+ write(file_name,"('image',i6.6,'_Vx.pnm')") it
+! write(system_command,"('convert image',i6.6,'_Vx.pnm image',i6.6,'_Vx.gif ; rm image',i6.6,'_Vx.pnm')") it,it,it
+ else if(field_number == 2) then
+ write(file_name,"('image',i6.6,'_Vy.pnm')") it
+! write(system_command,"('convert image',i6.6,'_Vy.pnm image',i6.6,'_Vy.gif ; rm image',i6.6,'_Vy.pnm')") it,it,it
+ endif
+
+ open(unit=27, file=file_name, status='unknown')
+
+ write(27,"('P3')") ! write image in PNM P3 format
+
+ write(27,*) NX,NY ! write image size
+ write(27,*) '255' ! maximum value of each pixel color
+
+! compute maximum amplitude
+ if(it<=2301) max_amplitude = maxval(abs(image_data_2D))
+
+! image starts in upper-left corner in PNM format
+ do iy=NY,1,-1
+ do ix=1,NX
+
+! define data as vector component normalized to [-1:1] and rounded to nearest integer
+! keeping in mind that amplitude can be negative
+ normalized_value = image_data_2D(ix,iy) / max_amplitude
+
+! suppress values that are outside [-1:+1] to avoid small edge effects
+ if(normalized_value < -1.d0) normalized_value = -1.d0
+ if(normalized_value > 1.d0) normalized_value = 1.d0
+
+! draw an orange cross to represent the source
+ if((ix >= ISOURCE - width_cross .and. ix <= ISOURCE + width_cross .and. &
+ iy >= JSOURCE - thickness_cross .and. iy <= JSOURCE + thickness_cross) .or. &
+ (ix >= ISOURCE - thickness_cross .and. ix <= ISOURCE + thickness_cross .and. &
+ iy >= JSOURCE - width_cross .and. iy <= JSOURCE + width_cross)) then
+ R = 255
+ G = 157
+ B = 0
+
+! display two-pixel-thick black frame around the image
+ else if(ix <= 2 .or. ix >= NX-1 .or. iy <= 2 .or. iy >= NY-1) then
+ R = 0
+ G = 0
+ B = 0
+
+! display edges of the PML layers
+ else if((USE_PML_XMIN .and. ix == NPOINTS_PML) .or. &
+ (USE_PML_XMAX .and. ix == NX - NPOINTS_PML) .or. &
+ (USE_PML_YMIN .and. iy == NPOINTS_PML) .or. &
+ (USE_PML_YMAX .and. iy == NY - NPOINTS_PML)) then
+ R = 255
+ G = 150
+ B = 0
+
+! suppress all the values that are below the threshold
+ else if(abs(image_data_2D(ix,iy)) <= max_amplitude * cutvect) then
+
+! use a black or white background for points that are below the threshold
+ if(WHITE_BACKGROUND) then
+ R = 255
+ G = 255
+ B = 255
+ else
+ R = 0
+ G = 0
+ B = 0
+ endif
+
+! represent regular image points using red if value is positive, blue if negative
+ else if(normalized_value >= 0.d0) then
+ R = nint(255.d0*normalized_value**POWER_DISPLAY)
+ G = 0
+ B = 0
+ else
+ R = 0
+ G = 0
+ B = nint(255.d0*abs(normalized_value)**POWER_DISPLAY)
+ endif
+
+! draw a green square to represent the receivers
+ do irec = 1,nrec
+ if((ix >= ix_rec(irec) - size_square .and. ix <= ix_rec(irec) + size_square .and. &
+ iy >= iy_rec(irec) - size_square .and. iy <= iy_rec(irec) + size_square) .or. &
+ (ix >= ix_rec(irec) - size_square .and. ix <= ix_rec(irec) + size_square .and. &
+ iy >= iy_rec(irec) - size_square .and. iy <= iy_rec(irec) + size_square)) then
+! use dark green color
+ R = 30
+ G = 180
+ B = 60
+ endif
+ enddo
+
+! write color pixel
+ write(27,"(i3,' ',i3,' ',i3)") R,G,B
+
+ enddo
+ enddo
+
+! close file
+ close(27)
+
+! call the system to convert image to GIF (can be commented out if "call system" is missing in your compiler)
+! call system(system_command)
+
+ end subroutine create_2D_image
+
+!
+! CeCILL FREE SOFTWARE LICENSE AGREEMENT
+!
+! Notice
+!
+! This Agreement is a Free Software license agreement that is the result
+! of discussions between its authors in order to ensure compliance with
+! the two main principles guiding its drafting:
+!
+! * firstly, compliance with the principles governing the distribution
+! of Free Software: access to source code, broad rights granted to
+! users,
+! * secondly, the election of a governing law, French law, with which
+! it is conformant, both as regards the law of torts and
+! intellectual property law, and the protection that it offers to
+! both authors and holders of the economic rights over software.
+!
+! The authors of the CeCILL (for Ce[a] C[nrs] I[nria] L[ogiciel] L[ibre])
+! license are:
+!
+! Commissariat a l'Energie Atomique - CEA, a public scientific, technical
+! and industrial research establishment, having its principal place of
+! business at 25 rue Leblanc, immeuble Le Ponant D, 75015 Paris, France.
+!
+! Centre National de la Recherche Scientifique - CNRS, a public scientific
+! and technological establishment, having its principal place of business
+! at 3 rue Michel-Ange, 75794 Paris cedex 16, France.
+!
+! Institut National de Recherche en Informatique et en Automatique -
+! INRIA, a public scientific and technological establishment, having its
+! principal place of business at Domaine de Voluceau, Rocquencourt, BP
+! 105, 78153 Le Chesnay cedex, France.
+!
+! Preamble
+!
+! The purpose of this Free Software license agreement is to grant users
+! the right to modify and redistribute the software governed by this
+! license within the framework of an open source distribution model.
+!
+! The exercising of these rights is conditional upon certain obligations
+! for users so as to preserve this status for all subsequent redistributions.
+!
+! In consideration of access to the source code and the rights to copy,
+! modify and redistribute granted by the license, users are provided only
+! with a limited warranty and the software's author, the holder of the
+! economic rights, and the successive licensors only have limited liability.
+!
+! In this respect, the risks associated with loading, using, modifying
+! and/or developing or reproducing the software by the user are brought to
+! the user's attention, given its Free Software status, which may make it
+! complicated to use, with the result that its use is reserved for
+! developers and experienced professionals having in-depth computer
+! knowledge. Users are therefore encouraged to load and test the
+! suitability of the software as regards their requirements in conditions
+! enabling the security of their systems and/or data to be ensured and,
+! more generally, to use and operate it in the same conditions of
+! security. This Agreement may be freely reproduced and published,
+! provided it is not altered, and that no provisions are either added or
+! removed herefrom.
+!
+! This Agreement may apply to any or all software for which the holder of
+! the economic rights decides to submit the use thereof to its provisions.
+!
+! Article 1 - DEFINITIONS
+!
+! For the purpose of this Agreement, when the following expressions
+! commence with a capital letter, they shall have the following meaning:
+!
+! Agreement: means this license agreement, and its possible subsequent
+! versions and annexes.
+!
+! Software: means the software in its Object Code and/or Source Code form
+! and, where applicable, its documentation, "as is" when the Licensee
+! accepts the Agreement.
+!
+! Initial Software: means the Software in its Source Code and possibly its
+! Object Code form and, where applicable, its documentation, "as is" when
+! it is first distributed under the terms and conditions of the Agreement.
+!
+! Modified Software: means the Software modified by at least one
+! Contribution.
+!
+! Source Code: means all the Software's instructions and program lines to
+! which access is required so as to modify the Software.
+!
+! Object Code: means the binary files originating from the compilation of
+! the Source Code.
+!
+! Holder: means the holder(s) of the economic rights over the Initial
+! Software.
+!
+! Licensee: means the Software user(s) having accepted the Agreement.
+!
+! Contributor: means a Licensee having made at least one Contribution.
+!
+! Licensor: means the Holder, or any other individual or legal entity, who
+! distributes the Software under the Agreement.
+!
+! Contribution: means any or all modifications, corrections, translations,
+! adaptations and/or new functions integrated into the Software by any or
+! all Contributors, as well as any or all Internal Modules.
+!
+! Module: means a set of sources files including their documentation that
+! enables supplementary functions or services in addition to those offered
+! by the Software.
+!
+! External Module: means any or all Modules, not derived from the
+! Software, so that this Module and the Software run in separate address
+! spaces, with one calling the other when they are run.
+!
+! Internal Module: means any or all Module, connected to the Software so
+! that they both execute in the same address space.
+!
+! GNU GPL: means the GNU General Public License version 2 or any
+! subsequent version, as published by the Free Software Foundation Inc.
+!
+! Parties: mean both the Licensee and the Licensor.
+!
+! These expressions may be used both in singular and plural form.
+!
+! Article 2 - PURPOSE
+!
+! The purpose of the Agreement is the grant by the Licensor to the
+! Licensee of a non-exclusive, transferable and worldwide license for the
+! Software as set forth in Article 5 hereinafter for the whole term of the
+! protection granted by the rights over said Software.
+!
+! Article 3 - ACCEPTANCE
+!
+! 3.1 The Licensee shall be deemed as having accepted the terms and
+! conditions of this Agreement upon the occurrence of the first of the
+! following events:
+!
+! * (i) loading the Software by any or all means, notably, by
+! downloading from a remote server, or by loading from a physical
+! medium;
+! * (ii) the first time the Licensee exercises any of the rights
+! granted hereunder.
+!
+! 3.2 One copy of the Agreement, containing a notice relating to the
+! characteristics of the Software, to the limited warranty, and to the
+! fact that its use is restricted to experienced users has been provided
+! to the Licensee prior to its acceptance as set forth in Article 3.1
+! hereinabove, and the Licensee hereby acknowledges that it has read and
+! understood it.
+!
+! Article 4 - EFFECTIVE DATE AND TERM
+!
+! 4.1 EFFECTIVE DATE
+!
+! The Agreement shall become effective on the date when it is accepted by
+! the Licensee as set forth in Article 3.1.
+!
+! 4.2 TERM
+!
+! The Agreement shall remain in force for the entire legal term of
+! protection of the economic rights over the Software.
+!
+! Article 5 - SCOPE OF RIGHTS GRANTED
+!
+! The Licensor hereby grants to the Licensee, who accepts, the following
+! rights over the Software for any or all use, and for the term of the
+! Agreement, on the basis of the terms and conditions set forth hereinafter.
+!
+! Besides, if the Licensor owns or comes to own one or more patents
+! protecting all or part of the functions of the Software or of its
+! components, the Licensor undertakes not to enforce the rights granted by
+! these patents against successive Licensees using, exploiting or
+! modifying the Software. If these patents are transferred, the Licensor
+! undertakes to have the transferees subscribe to the obligations set
+! forth in this paragraph.
+!
+! 5.1 RIGHT OF USE
+!
+! The Licensee is authorized to use the Software, without any limitation
+! as to its fields of application, with it being hereinafter specified
+! that this comprises:
+!
+! 1. permanent or temporary reproduction of all or part of the Software
+! by any or all means and in any or all form.
+!
+! 2. loading, displaying, running, or storing the Software on any or
+! all medium.
+!
+! 3. entitlement to observe, study or test its operation so as to
+! determine the ideas and principles behind any or all constituent
+! elements of said Software. This shall apply when the Licensee
+! carries out any or all loading, displaying, running, transmission
+! or storage operation as regards the Software, that it is entitled
+! to carry out hereunder.
+!
+! 5.2 ENTITLEMENT TO MAKE CONTRIBUTIONS
+!
+! The right to make Contributions includes the right to translate, adapt,
+! arrange, or make any or all modifications to the Software, and the right
+! to reproduce the resulting software.
+!
+! The Licensee is authorized to make any or all Contributions to the
+! Software provided that it includes an explicit notice that it is the
+! author of said Contribution and indicates the date of the creation thereof.
+!
+! 5.3 RIGHT OF DISTRIBUTION
+!
+! In particular, the right of distribution includes the right to publish,
+! transmit and communicate the Software to the general public on any or
+! all medium, and by any or all means, and the right to market, either in
+! consideration of a fee, or free of charge, one or more copies of the
+! Software by any means.
+!
+! The Licensee is further authorized to distribute copies of the modified
+! or unmodified Software to third parties according to the terms and
+! conditions set forth hereinafter.
+!
+! 5.3.1 DISTRIBUTION OF SOFTWARE WITHOUT MODIFICATION
+!
+! The Licensee is authorized to distribute true copies of the Software in
+! Source Code or Object Code form, provided that said distribution
+! complies with all the provisions of the Agreement and is accompanied by:
+!
+! 1. a copy of the Agreement,
+!
+! 2. a notice relating to the limitation of both the Licensor's
+! warranty and liability as set forth in Articles 8 and 9,
+!
+! and that, in the event that only the Object Code of the Software is
+! redistributed, the Licensee allows future Licensees unhindered access to
+! the full Source Code of the Software by indicating how to access it, it
+! being understood that the additional cost of acquiring the Source Code
+! shall not exceed the cost of transferring the data.
+!
+! 5.3.2 DISTRIBUTION OF MODIFIED SOFTWARE
+!
+! When the Licensee makes a Contribution to the Software, the terms and
+! conditions for the distribution of the resulting Modified Software
+! become subject to all the provisions of this Agreement.
+!
+! The Licensee is authorized to distribute the Modified Software, in
+! source code or object code form, provided that said distribution
+! complies with all the provisions of the Agreement and is accompanied by:
+!
+! 1. a copy of the Agreement,
+!
+! 2. a notice relating to the limitation of both the Licensor's
+! warranty and liability as set forth in Articles 8 and 9,
+!
+! and that, in the event that only the object code of the Modified
+! Software is redistributed, the Licensee allows future Licensees
+! unhindered access to the full source code of the Modified Software by
+! indicating how to access it, it being understood that the additional
+! cost of acquiring the source code shall not exceed the cost of
+! transferring the data.
+!
+! 5.3.3 DISTRIBUTION OF EXTERNAL MODULES
+!
+! When the Licensee has developed an External Module, the terms and
+! conditions of this Agreement do not apply to said External Module, that
+! may be distributed under a separate license agreement.
+!
+! 5.3.4 COMPATIBILITY WITH THE GNU GPL
+!
+! The Licensee can include a code that is subject to the provisions of one
+! of the versions of the GNU GPL in the Modified or unmodified Software,
+! and distribute that entire code under the terms of the same version of
+! the GNU GPL.
+!
+! The Licensee can include the Modified or unmodified Software in a code
+! that is subject to the provisions of one of the versions of the GNU GPL,
+! and distribute that entire code under the terms of the same version of
+! the GNU GPL.
+!
+! Article 6 - INTELLECTUAL PROPERTY
+!
+! 6.1 OVER THE INITIAL SOFTWARE
+!
+! The Holder owns the economic rights over the Initial Software. Any or
+! all use of the Initial Software is subject to compliance with the terms
+! and conditions under which the Holder has elected to distribute its work
+! and no one shall be entitled to modify the terms and conditions for the
+! distribution of said Initial Software.
+!
+! The Holder undertakes that the Initial Software will remain ruled at
+! least by this Agreement, for the duration set forth in Article 4.2.
+!
+! 6.2 OVER THE CONTRIBUTIONS
+!
+! The Licensee who develops a Contribution is the owner of the
+! intellectual property rights over this Contribution as defined by
+! applicable law.
+!
+! 6.3 OVER THE EXTERNAL MODULES
+!
+! The Licensee who develops an External Module is the owner of the
+! intellectual property rights over this External Module as defined by
+! applicable law and is free to choose the type of agreement that shall
+! govern its distribution.
+!
+! 6.4 JOINT PROVISIONS
+!
+! The Licensee expressly undertakes:
+!
+! 1. not to remove, or modify, in any manner, the intellectual property
+! notices attached to the Software;
+!
+! 2. to reproduce said notices, in an identical manner, in the copies
+! of the Software modified or not.
+!
+! The Licensee undertakes not to directly or indirectly infringe the
+! intellectual property rights of the Holder and/or Contributors on the
+! Software and to take, where applicable, vis-a-vis its staff, any and all
+! measures required to ensure respect of said intellectual property rights
+! of the Holder and/or Contributors.
+!
+! Article 7 - RELATED SERVICES
+!
+! 7.1 Under no circumstances shall the Agreement oblige the Licensor to
+! provide technical assistance or maintenance services for the Software.
+!
+! However, the Licensor is entitled to offer this type of services. The
+! terms and conditions of such technical assistance, and/or such
+! maintenance, shall be set forth in a separate instrument. Only the
+! Licensor offering said maintenance and/or technical assistance services
+! shall incur liability therefor.
+!
+! 7.2 Similarly, any Licensor is entitled to offer to its licensees, under
+! its sole responsibility, a warranty, that shall only be binding upon
+! itself, for the redistribution of the Software and/or the Modified
+! Software, under terms and conditions that it is free to decide. Said
+! warranty, and the financial terms and conditions of its application,
+! shall be subject of a separate instrument executed between the Licensor
+! and the Licensee.
+!
+! Article 8 - LIABILITY
+!
+! 8.1 Subject to the provisions of Article 8.2, the Licensee shall be
+! entitled to claim compensation for any direct loss it may have suffered
+! from the Software as a result of a fault on the part of the relevant
+! Licensor, subject to providing evidence thereof.
+!
+! 8.2 The Licensor's liability is limited to the commitments made under
+! this Agreement and shall not be incurred as a result of in particular:
+! (i) loss due the Licensee's total or partial failure to fulfill its
+! obligations, (ii) direct or consequential loss that is suffered by the
+! Licensee due to the use or performance of the Software, and (iii) more
+! generally, any consequential loss. In particular the Parties expressly
+! agree that any or all pecuniary or business loss (i.e. loss of data,
+! loss of profits, operating loss, loss of customers or orders,
+! opportunity cost, any disturbance to business activities) or any or all
+! legal proceedings instituted against the Licensee by a third party,
+! shall constitute consequential loss and shall not provide entitlement to
+! any or all compensation from the Licensor.
+!
+! Article 9 - WARRANTY
+!
+! 9.1 The Licensee acknowledges that the scientific and technical
+! state-of-the-art when the Software was distributed did not enable all
+! possible uses to be tested and verified, nor for the presence of
+! possible defects to be detected. In this respect, the Licensee's
+! attention has been drawn to the risks associated with loading, using,
+! modifying and/or developing and reproducing the Software which are
+! reserved for experienced users.
+!
+! The Licensee shall be responsible for verifying, by any or all means,
+! the suitability of the product for its requirements, its good working
+! order, and for ensuring that it shall not cause damage to either persons
+! or properties.
+!
+! 9.2 The Licensor hereby represents, in good faith, that it is entitled
+! to grant all the rights over the Software (including in particular the
+! rights set forth in Article 5).
+!
+! 9.3 The Licensee acknowledges that the Software is supplied "as is" by
+! the Licensor without any other express or tacit warranty, other than
+! that provided for in Article 9.2 and, in particular, without any warranty
+! as to its commercial value, its secured, safe, innovative or relevant
+! nature.
+!
+! Specifically, the Licensor does not warrant that the Software is free
+! from any error, that it will operate without interruption, that it will
+! be compatible with the Licensee's own equipment and software
+! configuration, nor that it will meet the Licensee's requirements.
+!
+! 9.4 The Licensor does not either expressly or tacitly warrant that the
+! Software does not infringe any third party intellectual property right
+! relating to a patent, software or any other property right. Therefore,
+! the Licensor disclaims any and all liability towards the Licensee
+! arising out of any or all proceedings for infringement that may be
+! instituted in respect of the use, modification and redistribution of the
+! Software. Nevertheless, should such proceedings be instituted against
+! the Licensee, the Licensor shall provide it with technical and legal
+! assistance for its defense. Such technical and legal assistance shall be
+! decided on a case-by-case basis between the relevant Licensor and the
+! Licensee pursuant to a memorandum of understanding. The Licensor
+! disclaims any and all liability as regards the Licensee's use of the
+! name of the Software. No warranty is given as regards the existence of
+! prior rights over the name of the Software or as regards the existence
+! of a trademark.
+!
+! Article 10 - TERMINATION
+!
+! 10.1 In the event of a breach by the Licensee of its obligations
+! hereunder, the Licensor may automatically terminate this Agreement
+! thirty (30) days after notice has been sent to the Licensee and has
+! remained ineffective.
+!
+! 10.2 A Licensee whose Agreement is terminated shall no longer be
+! authorized to use, modify or distribute the Software. However, any
+! licenses that it may have granted prior to termination of the Agreement
+! shall remain valid subject to their having been granted in compliance
+! with the terms and conditions hereof.
+!
+! Article 11 - MISCELLANEOUS
+!
+! 11.1 EXCUSABLE EVENTS
+!
+! Neither Party shall be liable for any or all delay, or failure to
+! perform the Agreement, that may be attributable to an event of force
+! majeure, an act of God or an outside cause, such as defective
+! functioning or interruptions of the electricity or telecommunications
+! networks, network paralysis following a virus attack, intervention by
+! government authorities, natural disasters, water damage, earthquakes,
+! fire, explosions, strikes and labor unrest, war, etc.
+!
+! 11.2 Any failure by either Party, on one or more occasions, to invoke
+! one or more of the provisions hereof, shall under no circumstances be
+! interpreted as being a waiver by the interested Party of its right to
+! invoke said provision(s) subsequently.
+!
+! 11.3 The Agreement cancels and replaces any or all previous agreements,
+! whether written or oral, between the Parties and having the same
+! purpose, and constitutes the entirety of the agreement between said
+! Parties concerning said purpose. No supplement or modification to the
+! terms and conditions hereof shall be effective as between the Parties
+! unless it is made in writing and signed by their duly authorized
+! representatives.
+!
+! 11.4 In the event that one or more of the provisions hereof were to
+! conflict with a current or future applicable act or legislative text,
+! said act or legislative text shall prevail, and the Parties shall make
+! the necessary amendments so as to comply with said act or legislative
+! text. All other provisions shall remain effective. Similarly, invalidity
+! of a provision of the Agreement, for any reason whatsoever, shall not
+! cause the Agreement as a whole to be invalid.
+!
+! 11.5 LANGUAGE
+!
+! The Agreement is drafted in both French and English and both versions
+! are deemed authentic.
+!
+! Article 12 - NEW VERSIONS OF THE AGREEMENT
+!
+! 12.1 Any person is authorized to duplicate and distribute copies of this
+! Agreement.
+!
+! 12.2 So as to ensure coherence, the wording of this Agreement is
+! protected and may only be modified by the authors of the License, who
+! reserve the right to periodically publish updates or new versions of the
+! Agreement, each with a separate number. These subsequent versions may
+! address new issues encountered by Free Software.
+!
+! 12.3 Any Software distributed under a given version of the Agreement may
+! only be subsequently distributed under the same version of the Agreement
+! or a subsequent version, subject to the provisions of Article 5.3.4.
+!
+! Article 13 - GOVERNING LAW AND JURISDICTION
+!
+! 13.1 The Agreement is governed by French law. The Parties agree to
+! endeavor to seek an amicable solution to any disagreements or disputes
+! that may arise during the performance of the Agreement.
+!
+! 13.2 Failing an amicable solution within two (2) months as from their
+! occurrence, and unless emergency proceedings are necessary, the
+! disagreements or disputes shall be referred to the Paris Courts having
+! jurisdiction, by the more diligent Party.
+!
+! Version 2.0 dated 2006-09-05.
+!
Added: seismo/3D/CPML/tags/v1.1.1/seismic_PML_Collino_2D_isotropic.f90
===================================================================
--- seismo/3D/CPML/tags/v1.1.1/seismic_PML_Collino_2D_isotropic.f90 (rev 0)
+++ seismo/3D/CPML/tags/v1.1.1/seismic_PML_Collino_2D_isotropic.f90 2009-11-03 21:35:50 UTC (rev 15926)
@@ -0,0 +1,1279 @@
+!
+! SEISMIC_CPML Version 1.1.1, November 2009.
+!
+! Copyright Universite de Pau et des Pays de l'Adour, CNRS and INRIA, France.
+! Contributor: Dimitri Komatitsch, dimitri DOT komatitsch aT univ-pau DOT fr
+!
+! This software is a computer program whose purpose is to solve
+! the two-dimensional isotropic elastic wave equation
+! using a finite-difference method with classical split Perfectly Matched
+! Layer (PML) conditions.
+!
+! This software is governed by the CeCILL license under French law and
+! abiding by the rules of distribution of free software. You can use,
+! modify and/or redistribute the software under the terms of the CeCILL
+! license as circulated by CEA, CNRS and INRIA at the following URL
+! "http://www.cecill.info".
+!
+! As a counterpart to the access to the source code and rights to copy,
+! modify and redistribute granted by the license, users are provided only
+! with a limited warranty and the software's author, the holder of the
+! economic rights, and the successive licensors have only limited
+! liability.
+!
+! In this respect, the user's attention is drawn to the risks associated
+! with loading, using, modifying and/or developing or reproducing the
+! software by the user in light of its specific status of free software,
+! that may mean that it is complicated to manipulate, and that also
+! therefore means that it is reserved for developers and experienced
+! professionals having in-depth computer knowledge. Users are therefore
+! encouraged to load and test the software's suitability as regards their
+! requirements in conditions enabling the security of their systems and/or
+! data to be ensured and, more generally, to use and operate it in the
+! same conditions as regards security.
+!
+! The full text of the license is available at the end of this program
+! and in file "LICENSE".
+
+ program seismic_PML_Collino_2D_iso
+
+ implicit none
+
+!
+! 2D explicit PML velocity-stress FD code based upon INRIA report:
+!
+! Francis Collino and Chrysoula Tsogka
+! Application of the PML Absorbing Layer Model to the Linear
+! Elastodynamic Problem in Anisotropic Heteregeneous Media
+! INRIA Research Report RR-3471, August 1998
+! http://www.inria.fr/publications
+!
+! and
+!
+! @ARTICLE{CoTs01,
+! author = {F. Collino and C. Tsogka},
+! title = {Application of the {PML} absorbing layer model to the linear elastodynamic
+! problem in anisotropic heterogeneous media},
+! journal = {Geophysics},
+! year = {2001},
+! volume = {66},
+! number = {1},
+! pages = {294-307}}
+!
+! PML implemented in the two directions (x and y directions).
+!
+! Dimitri Komatitsch, University of Pau, France, April 2007.
+!
+! The second-order staggered-grid formulation of Madariaga (1976) and Virieux (1986) is used:
+!
+! ^ y
+! |
+! |
+!
+! +-------------------+
+! | |
+! | |
+! | |
+! | |
+! | v_y |
+! sigma_xy +---------+ |
+! | | |
+! | | |
+! | | |
+! | | |
+! | | |
+! +---------+---------+ ---> x
+! v_x sigma_xx
+! sigma_yy
+!
+!
+! To display the 2D results as color images, use:
+!
+! " display image* " or " gimp image* "
+!
+! or
+!
+! " montage -geometry +0+3 -rotate 90 -tile 1x21 image*Vx*.gif allfiles_Vx.gif "
+! " montage -geometry +0+3 -rotate 90 -tile 1x21 image*Vy*.gif allfiles_Vy.gif "
+! then " display allfiles_Vx.gif " or " gimp allfiles_Vx.gif "
+! then " display allfiles_Vy.gif " or " gimp allfiles_Vy.gif "
+
+! total number of grid points in each direction of the grid
+ integer, parameter :: NX = 101
+ integer, parameter :: NY = 641
+
+! size of a grid cell
+ double precision, parameter :: h = 10.d0
+
+! thickness of the PML layer in grid points
+ integer, parameter :: NPOINTS_PML = 10
+
+! P-velocity, S-velocity and density
+ double precision, parameter :: cp = 3300.d0
+ double precision, parameter :: cs = cp / 1.732d0
+ double precision, parameter :: rho = 2800.d0
+ double precision, parameter :: mu = rho*cs*cs
+ double precision, parameter :: lambda = rho*(cp*cp - 2.d0*cs*cs)
+ double precision, parameter :: lambda_plus_two_mu = rho*cp*cp
+
+! total number of time steps
+ integer, parameter :: NSTEP = 2000
+
+! time step in seconds
+ double precision, parameter :: DELTAT = 2.d-3
+ double precision, parameter :: ONE_OVER_DELTAT = 1.d0 / DELTAT
+
+! parameters for the source
+ double precision, parameter :: f0 = 7.d0
+ double precision, parameter :: t0 = 1.20d0 / f0
+ double precision, parameter :: factor = 1.d7
+
+! source
+ integer, parameter :: ISOURCE = NX - 2*NPOINTS_PML - 1
+ integer, parameter :: JSOURCE = 2 * NY / 3 + 1
+ double precision, parameter :: xsource = (ISOURCE - 1) * h
+ double precision, parameter :: ysource = (JSOURCE - 1) * h
+! angle of source force clockwise with respect to vertical (Y) axis
+ double precision, parameter :: ANGLE_FORCE = 135.d0
+
+! receivers
+ integer, parameter :: NREC = 2
+ double precision, parameter :: xdeb = xsource - 100.d0 ! first receiver x in meters
+ double precision, parameter :: ydeb = 2300.d0 ! first receiver y in meters
+ double precision, parameter :: xfin = xsource ! last receiver x in meters
+ double precision, parameter :: yfin = 300.d0 ! last receiver y in meters
+
+! display information on the screen from time to time
+ integer, parameter :: IT_DISPLAY = 100
+
+! value of PI
+ double precision, parameter :: PI = 3.141592653589793238462643d0
+
+! conversion from degrees to radians
+ double precision, parameter :: DEGREES_TO_RADIANS = PI / 180.d0
+
+! zero
+ double precision, parameter :: ZERO = 0.d0
+
+! large value for maximum
+ double precision, parameter :: HUGEVAL = 1.d+30
+
+! velocity threshold above which we consider that the code became unstable
+ double precision, parameter :: STABILITY_THRESHOLD = 1.d+25
+
+! definition of the split velocity vector and stress tensor:
+!
+! vx(:,:) = vx_1(:,:) + vx_2(:,:)
+! vy(:,:) = vy_1(:,:) + vy_2(:,:)
+!
+! sigmaxx(:,:) = sigmaxx_1(:,:) + sigmaxx_2(:,:)
+! sigmayy(:,:) = sigmayy_1(:,:) + sigmayy_2(:,:)
+! sigmaxy(:,:) = sigmaxy_1(:,:) + sigmaxy_2(:,:)
+
+! main arrays
+ double precision, dimension(NX,NY) :: vx_1,vx_2,vy_1,vy_2, &
+ sigmaxx_1,sigmaxx_2,sigmayy_1,sigmayy_2,sigmaxy_1,sigmaxy_2
+
+! additional array used for display only
+ double precision, dimension(NX,NY) :: image_data_2D
+
+ double precision, dimension(NX) :: dx_over_two,dx_half_over_two
+ double precision, dimension(NY) :: dy_over_two,dy_half_over_two
+
+! for the source
+ double precision a,t,force_x,force_y,source_term
+
+! for receivers
+ double precision xspacerec,yspacerec,distval,dist
+ integer, dimension(NREC) :: ix_rec,iy_rec
+ double precision, dimension(NREC) :: xrec,yrec
+ double precision, dimension(NSTEP,NREC) :: sisvx,sisvy
+
+! for evolution of total energy in the medium
+ double precision :: epsilon_xx,epsilon_yy,epsilon_xy
+ double precision :: sigmaxx_total,sigmayy_total,sigmaxy_total
+ double precision, dimension(NSTEP) :: total_energy_kinetic,total_energy_potential
+
+ integer :: i,j,it,irec
+
+ double precision :: xval,delta,xoriginleft,xoriginright,rcoef,d0,velocnorm,Courant_number,value_dx,value_dy,d
+
+! *******************
+! program starts here
+! *******************
+
+!--- define profile of absorption in PML region
+
+! thickness of the layer in meters
+ delta = NPOINTS_PML * h
+
+! reflection coefficient (INRIA report section 6.1)
+ Rcoef = 0.001d0
+
+! compute d0 from INRIA report section 6.1
+ d0 = 3.d0 * cp * log(1.d0/Rcoef) / (2.d0 * delta)
+
+ print *,'d0 = ',d0
+ print *
+
+! origin of the PML layer (position of right edge minus thickness, in meters)
+ xoriginleft = delta
+ xoriginright = (NX-1)*h - delta
+
+ do i=1,NX
+
+ xval = h*dble(i-1)
+
+ if(xval < xoriginleft) then
+ dx_over_two(i) = d0 * ((xoriginleft-xval)/delta)**2
+ dx_half_over_two(i) = d0 * ((xoriginleft-xval-h/2.d0)/delta)**2
+! fix problem with dx_half_over_two() exactly on the edge
+ else if(xval >= 0.9999d0*xoriginright) then
+ dx_over_two(i) = d0 * ((xval-xoriginright)/delta)**2
+ dx_half_over_two(i) = d0 * ((xval+h/2.d0-xoriginright)/delta)**2
+ else
+ dx_over_two(i) = 0.d0
+ dx_half_over_two(i) = 0.d0
+ endif
+
+ enddo
+
+! divide the whole profile by two once and for all
+ dx_over_two(:) = dx_over_two(:) / 2.d0
+ dx_half_over_two(:) = dx_half_over_two(:) / 2.d0
+
+! origin of the PML layer (position of right edge minus thickness, in meters)
+ xoriginleft = delta
+ xoriginright = (NY-1)*h - delta
+
+ do j=1,NY
+
+ xval = h*dble(j-1)
+
+ if(xval < xoriginleft) then
+ dy_over_two(j) = d0 * ((xoriginleft-xval)/delta)**2
+ dy_half_over_two(j) = d0 * ((xoriginleft-xval-h/2.d0)/delta)**2
+! fix problem with dy_half_over_two() exactly on the edge
+ else if(xval >= 0.9999d0*xoriginright) then
+ dy_over_two(j) = d0 * ((xval-xoriginright)/delta)**2
+ dy_half_over_two(j) = d0 * ((xval+h/2.d0-xoriginright)/delta)**2
+ else
+ dy_over_two(j) = 0.d0
+ dy_half_over_two(j) = 0.d0
+ endif
+
+ enddo
+
+! divide the whole profile by two once and for all
+ dy_over_two(:) = dy_over_two(:) / 2.d0
+ dy_half_over_two(:) = dy_half_over_two(:) / 2.d0
+
+! print position of the source
+ print *
+ print *,'Position of the source:'
+ print *
+ print *,'x = ',xsource
+ print *,'y = ',ysource
+ print *
+
+! define location of receivers
+ print *
+ print *,'There are ',nrec,' receivers'
+ print *
+ xspacerec = (xfin-xdeb) / dble(NREC-1)
+ yspacerec = (yfin-ydeb) / dble(NREC-1)
+ do irec=1,nrec
+ xrec(irec) = xdeb + dble(irec-1)*xspacerec
+ yrec(irec) = ydeb + dble(irec-1)*yspacerec
+ enddo
+
+! find closest grid point for each receiver
+ do irec=1,nrec
+ dist = HUGEVAL
+ do j = 1,NY
+ do i = 1,NX
+ distval = sqrt((h*dble(i-1) - xrec(irec))**2 + (h*dble(j-1) - yrec(irec))**2)
+ if(distval < dist) then
+ dist = distval
+ ix_rec(irec) = i
+ iy_rec(irec) = j
+ endif
+ enddo
+ enddo
+ print *,'receiver ',irec,' x_target,y_target = ',xrec(irec),yrec(irec)
+ print *,'closest grid point found at distance ',dist,' in i,j = ',ix_rec(irec),iy_rec(irec)
+ print *
+ enddo
+
+! check the Courant stability condition for the explicit time scheme
+! R. Courant et K. O. Friedrichs et H. Lewy (1928)
+ Courant_number = cp * DELTAT / h
+ print *,'Courant number is ',Courant_number
+ print *
+ if(Courant_number > 1.d0/sqrt(2.d0)) stop 'time step is too large, simulation will be unstable'
+
+! suppress old files (can be commented out if "call system" is missing in your compiler)
+! call system('rm -f Vx_*.dat Vy_*.dat image*.pnm image*.gif')
+
+! initialize arrays
+ vx_1(:,:) = 0.d0
+ vy_1(:,:) = 0.d0
+
+ vx_2(:,:) = 0.d0
+ vy_2(:,:) = 0.d0
+
+ sigmaxx_1(:,:) = 0.d0
+ sigmayy_1(:,:) = 0.d0
+ sigmaxy_1(:,:) = 0.d0
+
+ sigmaxx_2(:,:) = 0.d0
+ sigmayy_2(:,:) = 0.d0
+ sigmaxy_2(:,:) = 0.d0
+
+! initialize seismograms
+ sisvx(:,:) = 0.d0
+ sisvy(:,:) = 0.d0
+
+! initialize total energy
+ total_energy_kinetic(:) = 0.d0
+ total_energy_potential(:) = 0.d0
+
+!---
+!--- beginning of time loop
+!---
+
+ do it = 1,NSTEP
+
+!----------------------
+! compute stress sigma
+!----------------------
+
+ do j = 2,NY
+ do i = 1,NX-1
+
+ value_dx = (vx_1(i+1,j) - vx_1(i,j)) / h &
+ + (vx_2(i+1,j) - vx_2(i,j)) / h
+
+ value_dy = (vy_1(i,j) - vy_1(i,j-1)) / h &
+ + (vy_2(i,j) - vy_2(i,j-1)) / h
+
+ d = dx_half_over_two(i)
+
+ sigmaxx_1(i,j) = ( sigmaxx_1(i,j)*(ONE_OVER_DELTAT - d) + lambda_plus_two_mu * value_dx ) / (ONE_OVER_DELTAT + d)
+
+ sigmayy_1(i,j) = ( sigmayy_1(i,j)*(ONE_OVER_DELTAT - d) + lambda * value_dx ) / (ONE_OVER_DELTAT + d)
+
+ d = dy_over_two(j)
+
+ sigmaxx_2(i,j) = ( sigmaxx_2(i,j)*(ONE_OVER_DELTAT - d) + lambda * value_dy ) / (ONE_OVER_DELTAT + d)
+
+ sigmayy_2(i,j) = ( sigmayy_2(i,j)*(ONE_OVER_DELTAT - d) + lambda_plus_two_mu * value_dy ) / (ONE_OVER_DELTAT + d)
+
+ enddo
+ enddo
+
+ do j = 1,NY-1
+ do i = 2,NX
+
+ value_dx = (vy_1(i,j) - vy_1(i-1,j)) / h &
+ + (vy_2(i,j) - vy_2(i-1,j)) / h
+
+ value_dy = (vx_1(i,j+1) - vx_1(i,j)) / h &
+ + (vx_2(i,j+1) - vx_2(i,j)) / h
+
+ d = dx_over_two(i)
+
+ sigmaxy_1(i,j) = ( sigmaxy_1(i,j)*(ONE_OVER_DELTAT - d) + mu * value_dx ) / (ONE_OVER_DELTAT + d)
+
+ d = dy_half_over_two(j)
+
+ sigmaxy_2(i,j) = ( sigmaxy_2(i,j)*(ONE_OVER_DELTAT - d) + mu * value_dy ) / (ONE_OVER_DELTAT + d)
+
+ enddo
+ enddo
+
+!------------------
+! compute velocity
+!------------------
+
+ do j = 2,NY
+ do i = 2,NX
+
+ value_dx = (sigmaxx_1(i,j) - sigmaxx_1(i-1,j)) / h &
+ + (sigmaxx_2(i,j) - sigmaxx_2(i-1,j)) / h
+
+ value_dy = (sigmaxy_1(i,j) - sigmaxy_1(i,j-1)) / h &
+ + (sigmaxy_2(i,j) - sigmaxy_2(i,j-1)) / h
+
+ d = dx_over_two(i)
+
+ vx_1(i,j) = ( vx_1(i,j)*(ONE_OVER_DELTAT - d) + value_dx / rho ) / (ONE_OVER_DELTAT + d)
+
+ d = dy_over_two(j)
+
+ vx_2(i,j) = ( vx_2(i,j)*(ONE_OVER_DELTAT - d) + value_dy / rho ) / (ONE_OVER_DELTAT + d)
+
+ enddo
+ enddo
+
+ do j = 1,NY-1
+ do i = 1,NX-1
+
+ value_dx = (sigmaxy_1(i+1,j) - sigmaxy_1(i,j)) / h &
+ + (sigmaxy_2(i+1,j) - sigmaxy_2(i,j)) / h
+
+ value_dy = (sigmayy_1(i,j+1) - sigmayy_1(i,j)) / h &
+ + (sigmayy_2(i,j+1) - sigmayy_2(i,j)) / h
+
+ d = dx_half_over_two(i)
+
+ vy_1(i,j) = ( vy_1(i,j)*(ONE_OVER_DELTAT - d) + value_dx / rho ) / (ONE_OVER_DELTAT + d)
+
+ d = dy_half_over_two(j)
+
+ vy_2(i,j) = ( vy_2(i,j)*(ONE_OVER_DELTAT - d) + value_dy / rho ) / (ONE_OVER_DELTAT + d)
+
+ enddo
+ enddo
+
+! add the source (force vector located at a given grid point)
+ a = pi*pi*f0*f0
+ t = dble(it-1)*DELTAT
+
+! Gaussian
+! source_term = factor * exp(-a*(t-t0)**2)
+
+! first derivative of a Gaussian
+ source_term = - factor * 2.d0*a*(t-t0)*exp(-a*(t-t0)**2)
+
+! Ricker source time function (second derivative of a Gaussian)
+! source_term = factor * (1.d0 - 2.d0*a*(t-t0)**2)*exp(-a*(t-t0)**2)
+
+ force_x = sin(ANGLE_FORCE * DEGREES_TO_RADIANS) * source_term
+ force_y = cos(ANGLE_FORCE * DEGREES_TO_RADIANS) * source_term
+
+! define location of the source
+ i = ISOURCE
+ j = JSOURCE
+
+! add the source to one of the two components of the split field
+ vx_1(i,j) = vx_1(i,j) + force_x * DELTAT / rho
+ vy_1(i,j) = vy_1(i,j) + force_y * DELTAT / rho
+
+! implement Dirichlet boundary conditions on the four edges of the grid
+
+! xmin
+ vx_1(1,:) = 0.d0
+ vy_1(1,:) = 0.d0
+
+ vx_2(1,:) = 0.d0
+ vy_2(1,:) = 0.d0
+
+! xmax
+ vx_1(NX,:) = 0.d0
+ vy_1(NX,:) = 0.d0
+
+ vx_2(NX,:) = 0.d0
+ vy_2(NX,:) = 0.d0
+
+! ymin
+ vx_1(:,1) = 0.d0
+ vy_1(:,1) = 0.d0
+
+ vx_2(:,1) = 0.d0
+ vy_2(:,1) = 0.d0
+
+! ymax
+ vx_1(:,NY) = 0.d0
+ vy_1(:,NY) = 0.d0
+
+ vx_2(:,NY) = 0.d0
+ vy_2(:,NY) = 0.d0
+
+! store seismograms
+ do irec = 1,NREC
+ sisvx(it,irec) = vx_1(ix_rec(irec),iy_rec(irec)) + vx_2(ix_rec(irec),iy_rec(irec))
+ sisvy(it,irec) = vy_1(ix_rec(irec),iy_rec(irec)) + vy_2(ix_rec(irec),iy_rec(irec))
+ enddo
+
+! compute total energy in the medium (without the PML layers)
+
+! compute kinetic energy first, defined as 1/2 rho ||v||^2
+! in principle we should use rho_half_x_half_y instead of rho for vy
+! in order to interpolate density at the right location in the staggered grid cell
+! but in a homogeneous medium we can safely ignore it
+ total_energy_kinetic(it) = 0.5d0 * sum(rho*( &
+ (vx_1(NPOINTS_PML+1:NX-NPOINTS_PML,NPOINTS_PML+1:NY-NPOINTS_PML) + &
+ vx_2(NPOINTS_PML+1:NX-NPOINTS_PML,NPOINTS_PML+1:NY-NPOINTS_PML))**2 + &
+ (vy_1(NPOINTS_PML+1:NX-NPOINTS_PML,NPOINTS_PML+1:NY-NPOINTS_PML) + &
+ vy_2(NPOINTS_PML+1:NX-NPOINTS_PML,NPOINTS_PML+1:NY-NPOINTS_PML))**2))
+
+! add potential energy, defined as 1/2 epsilon_ij sigma_ij
+! in principle we should interpolate the medium parameters at the right location
+! in the staggered grid cell but in a homogeneous medium we can safely ignore it
+ total_energy_potential(it) = ZERO
+ do j = NPOINTS_PML+1, NY-NPOINTS_PML
+ do i = NPOINTS_PML+1, NX-NPOINTS_PML
+
+! compute total field from split components
+ sigmaxx_total = sigmaxx_1(i,j) + sigmaxx_2(i,j)
+ sigmayy_total = sigmayy_1(i,j) + sigmayy_2(i,j)
+ sigmaxy_total = sigmaxy_1(i,j) + sigmaxy_2(i,j)
+
+ epsilon_xx = ((lambda + 2.d0*mu) * sigmaxx_total - lambda * sigmayy_total) / (4.d0 * mu * (lambda + mu))
+ epsilon_yy = ((lambda + 2.d0*mu) * sigmayy_total - lambda * sigmaxx_total) / (4.d0 * mu * (lambda + mu))
+ epsilon_xy = sigmaxy_total / (2.d0 * mu)
+ total_energy_potential(it) = total_energy_potential(it) + &
+ 0.5d0 * (epsilon_xx * sigmaxx_total + epsilon_yy * sigmayy_total + 2.d0 * epsilon_xy * sigmaxy_total)
+ enddo
+ enddo
+
+! output information
+ if(mod(it,IT_DISPLAY) == 0 .or. it == 5) then
+
+ velocnorm = maxval(sqrt((vx_1 + vx_2)**2 + (vy_1 + vy_2)**2))
+
+ print *,'Time step # ',it
+ print *,'Time: ',sngl((it-1)*DELTAT),' seconds'
+ print *,'Max norm velocity vector V (m/s) = ',velocnorm
+ print *,'total energy = ',total_energy_kinetic(it) + total_energy_potential(it)
+ print *
+! check stability of the code, exit if unstable
+ if(velocnorm > STABILITY_THRESHOLD) stop 'code became unstable and blew up'
+
+ image_data_2D = vx_1 + vx_2
+ call create_2D_image(image_data_2D,NX,NY,it,ISOURCE,JSOURCE,ix_rec,iy_rec,nrec, &
+ NPOINTS_PML,.true.,.true.,.true.,.true.,1)
+
+ image_data_2D = vy_1 + vy_2
+ call create_2D_image(image_data_2D,NX,NY,it,ISOURCE,JSOURCE,ix_rec,iy_rec,nrec, &
+ NPOINTS_PML,.true.,.true.,.true.,.true.,2)
+
+ endif
+
+ enddo ! end of time loop
+
+! save seismograms
+ call write_seismograms(sisvx,sisvy,NSTEP,NREC,DELTAT)
+
+! save total energy
+ open(unit=20,file='energy.dat',status='unknown')
+ do it = 1,NSTEP
+ write(20,*) sngl(dble(it-1)*DELTAT),sngl(total_energy_kinetic(it)), &
+ sngl(total_energy_potential(it)),sngl(total_energy_kinetic(it) + total_energy_potential(it))
+ enddo
+ close(20)
+
+! create script for Gnuplot for total energy
+ open(unit=20,file='plot_energy',status='unknown')
+ write(20,*) '# set term x11'
+ write(20,*) 'set term postscript landscape monochrome dashed "Helvetica" 22'
+ write(20,*)
+ write(20,*) 'set xlabel "Time (s)"'
+ write(20,*) 'set ylabel "Total energy"'
+ write(20,*)
+ write(20,*) 'set output "collino_total_energy_semilog.eps"'
+ write(20,*) 'set logscale y'
+ write(20,*) 'plot "energy.dat" us 1:2 t ''Ec'' w l 1, "energy.dat" us 1:3 &
+ & t ''Ep'' w l 3, "energy.dat" us 1:4 t ''Total energy'' w l 4'
+ write(20,*) 'pause -1 "Hit any key..."'
+ write(20,*)
+ close(20)
+
+! create script for Gnuplot
+ open(unit=20,file='plotgnu',status='unknown')
+ write(20,*) 'set term x11'
+ write(20,*) '# set term postscript landscape monochrome dashed "Helvetica" 22'
+ write(20,*)
+ write(20,*) 'set xlabel "Time (s)"'
+ write(20,*) 'set ylabel "Amplitude (m / s)"'
+ write(20,*)
+
+ write(20,*) 'set output "v_sigma_Vx_receiver_001.eps"'
+ write(20,*) 'plot "Vx_file_001.dat" t ''Vx C-PML'' w l 1'
+ write(20,*) 'pause -1 "Hit any key..."'
+ write(20,*)
+
+ write(20,*) 'set output "v_sigma_Vy_receiver_001.eps"'
+ write(20,*) 'plot "Vy_file_001.dat" t ''Vy C-PML'' w l 1'
+ write(20,*) 'pause -1 "Hit any key..."'
+ write(20,*)
+
+ write(20,*) 'set output "v_sigma_Vx_receiver_002.eps"'
+ write(20,*) 'plot "Vx_file_002.dat" t ''Vx C-PML'' w l 1'
+ write(20,*) 'pause -1 "Hit any key..."'
+ write(20,*)
+
+ write(20,*) 'set output "v_sigma_Vy_receiver_002.eps"'
+ write(20,*) 'plot "Vy_file_002.dat" t ''Vy C-PML'' w l 1'
+ write(20,*) 'pause -1 "Hit any key..."'
+ write(20,*)
+
+ close(20)
+
+ print *
+ print *,'End of the simulation'
+ print *
+
+ end program seismic_PML_Collino_2D_iso
+
+!----
+!---- save the seismograms in ASCII text format
+!----
+
+ subroutine write_seismograms(sisvx,sisvy,nt,nrec,DELTAT)
+
+ implicit none
+
+ integer nt,nrec
+ double precision DELTAT
+
+ double precision sisvx(nt,nrec)
+ double precision sisvy(nt,nrec)
+
+ integer irec,it
+
+ character(len=100) file_name
+
+! X component
+ do irec=1,nrec
+ write(file_name,"('Vx_file_',i3.3,'.dat')") irec
+ open(unit=11,file=file_name,status='unknown')
+ do it=1,nt
+ write(11,*) sngl(dble(it-1)*DELTAT),' ',sngl(sisvx(it,irec))
+ enddo
+ close(11)
+ enddo
+
+! Y component
+ do irec=1,nrec
+ write(file_name,"('Vy_file_',i3.3,'.dat')") irec
+ open(unit=11,file=file_name,status='unknown')
+ do it=1,nt
+ write(11,*) sngl(dble(it-1)*DELTAT),' ',sngl(sisvy(it,irec))
+ enddo
+ close(11)
+ enddo
+
+ end subroutine write_seismograms
+
+!----
+!---- routine to create a color image of a given vector component
+!---- the image is created in PNM format and then converted to GIF
+!----
+
+ subroutine create_2D_image(image_data_2D,NX,NY,it,ISOURCE,JSOURCE,ix_rec,iy_rec,nrec, &
+ NPOINTS_PML,USE_PML_XMIN,USE_PML_XMAX,USE_PML_YMIN,USE_PML_YMAX,field_number)
+
+ implicit none
+
+! non linear display to enhance small amplitudes for graphics
+ double precision, parameter :: POWER_DISPLAY = 0.30d0
+
+! amplitude threshold above which we draw the color point
+ double precision, parameter :: cutvect = 0.01d0
+
+! use black or white background for points that are below the threshold
+ logical, parameter :: WHITE_BACKGROUND = .true.
+
+! size of cross and square in pixels drawn to represent the source and the receivers
+ integer, parameter :: width_cross = 5, thickness_cross = 1, size_square = 3
+
+ integer NX,NY,it,field_number,ISOURCE,JSOURCE,NPOINTS_PML,nrec
+ logical USE_PML_XMIN,USE_PML_XMAX,USE_PML_YMIN,USE_PML_YMAX
+
+ double precision, dimension(NX,NY) :: image_data_2D
+
+ integer, dimension(nrec) :: ix_rec,iy_rec
+
+ integer :: ix,iy,irec
+
+ character(len=100) :: file_name,system_command
+
+ integer :: R, G, B
+
+ double precision :: normalized_value,max_amplitude
+
+! open image file and create system command to convert image to more convenient format
+ if(field_number == 1) then
+ write(file_name,"('image',i6.6,'_Vx.pnm')") it
+ write(system_command,"('convert image',i6.6,'_Vx.pnm image',i6.6,'_Vx.gif ; rm image',i6.6,'_Vx.pnm')") it,it,it
+ else if(field_number == 2) then
+ write(file_name,"('image',i6.6,'_Vy.pnm')") it
+ write(system_command,"('convert image',i6.6,'_Vy.pnm image',i6.6,'_Vy.gif ; rm image',i6.6,'_Vy.pnm')") it,it,it
+ endif
+
+ open(unit=27, file=file_name, status='unknown')
+
+ write(27,"('P3')") ! write image in PNM P3 format
+
+ write(27,*) NX,NY ! write image size
+ write(27,*) '255' ! maximum value of each pixel color
+
+! compute maximum amplitude
+ max_amplitude = maxval(abs(image_data_2D))
+
+! image starts in upper-left corner in PNM format
+ do iy=NY,1,-1
+ do ix=1,NX
+
+! define data as vector component normalized to [-1:1] and rounded to nearest integer
+! keeping in mind that amplitude can be negative
+ normalized_value = image_data_2D(ix,iy) / max_amplitude
+
+! suppress values that are outside [-1:+1] to avoid small edge effects
+ if(normalized_value < -1.d0) normalized_value = -1.d0
+ if(normalized_value > 1.d0) normalized_value = 1.d0
+
+! draw an orange cross to represent the source
+ if((ix >= ISOURCE - width_cross .and. ix <= ISOURCE + width_cross .and. &
+ iy >= JSOURCE - thickness_cross .and. iy <= JSOURCE + thickness_cross) .or. &
+ (ix >= ISOURCE - thickness_cross .and. ix <= ISOURCE + thickness_cross .and. &
+ iy >= JSOURCE - width_cross .and. iy <= JSOURCE + width_cross)) then
+ R = 255
+ G = 157
+ B = 0
+
+! display two-pixel-thick black frame around the image
+ else if(ix <= 2 .or. ix >= NX-1 .or. iy <= 2 .or. iy >= NY-1) then
+ R = 0
+ G = 0
+ B = 0
+
+! display edges of the PML layers
+ else if((USE_PML_XMIN .and. ix == NPOINTS_PML) .or. &
+ (USE_PML_XMAX .and. ix == NX - NPOINTS_PML) .or. &
+ (USE_PML_YMIN .and. iy == NPOINTS_PML) .or. &
+ (USE_PML_YMAX .and. iy == NY - NPOINTS_PML)) then
+ R = 255
+ G = 150
+ B = 0
+
+! suppress all the values that are below the threshold
+ else if(abs(image_data_2D(ix,iy)) <= max_amplitude * cutvect) then
+
+! use a black or white background for points that are below the threshold
+ if(WHITE_BACKGROUND) then
+ R = 255
+ G = 255
+ B = 255
+ else
+ R = 0
+ G = 0
+ B = 0
+ endif
+
+! represent regular image points using red if value is positive, blue if negative
+ else if(normalized_value >= 0.d0) then
+ R = nint(255.d0*normalized_value**POWER_DISPLAY)
+ G = 0
+ B = 0
+ else
+ R = 0
+ G = 0
+ B = nint(255.d0*abs(normalized_value)**POWER_DISPLAY)
+ endif
+
+! draw a green square to represent the receivers
+ do irec = 1,nrec
+ if((ix >= ix_rec(irec) - size_square .and. ix <= ix_rec(irec) + size_square .and. &
+ iy >= iy_rec(irec) - size_square .and. iy <= iy_rec(irec) + size_square) .or. &
+ (ix >= ix_rec(irec) - size_square .and. ix <= ix_rec(irec) + size_square .and. &
+ iy >= iy_rec(irec) - size_square .and. iy <= iy_rec(irec) + size_square)) then
+! use dark green color
+ R = 30
+ G = 180
+ B = 60
+ endif
+ enddo
+
+! write color pixel
+ write(27,"(i3,' ',i3,' ',i3)") R,G,B
+
+ enddo
+ enddo
+
+! close file
+ close(27)
+
+! call the system to convert image to GIF (can be commented out if "call system" is missing in your compiler)
+! call system(system_command)
+
+ end subroutine create_2D_image
+
+!
+! CeCILL FREE SOFTWARE LICENSE AGREEMENT
+!
+! Notice
+!
+! This Agreement is a Free Software license agreement that is the result
+! of discussions between its authors in order to ensure compliance with
+! the two main principles guiding its drafting:
+!
+! * firstly, compliance with the principles governing the distribution
+! of Free Software: access to source code, broad rights granted to
+! users,
+! * secondly, the election of a governing law, French law, with which
+! it is conformant, both as regards the law of torts and
+! intellectual property law, and the protection that it offers to
+! both authors and holders of the economic rights over software.
+!
+! The authors of the CeCILL (for Ce[a] C[nrs] I[nria] L[ogiciel] L[ibre])
+! license are:
+!
+! Commissariat a l'Energie Atomique - CEA, a public scientific, technical
+! and industrial research establishment, having its principal place of
+! business at 25 rue Leblanc, immeuble Le Ponant D, 75015 Paris, France.
+!
+! Centre National de la Recherche Scientifique - CNRS, a public scientific
+! and technological establishment, having its principal place of business
+! at 3 rue Michel-Ange, 75794 Paris cedex 16, France.
+!
+! Institut National de Recherche en Informatique et en Automatique -
+! INRIA, a public scientific and technological establishment, having its
+! principal place of business at Domaine de Voluceau, Rocquencourt, BP
+! 105, 78153 Le Chesnay cedex, France.
+!
+! Preamble
+!
+! The purpose of this Free Software license agreement is to grant users
+! the right to modify and redistribute the software governed by this
+! license within the framework of an open source distribution model.
+!
+! The exercising of these rights is conditional upon certain obligations
+! for users so as to preserve this status for all subsequent redistributions.
+!
+! In consideration of access to the source code and the rights to copy,
+! modify and redistribute granted by the license, users are provided only
+! with a limited warranty and the software's author, the holder of the
+! economic rights, and the successive licensors only have limited liability.
+!
+! In this respect, the risks associated with loading, using, modifying
+! and/or developing or reproducing the software by the user are brought to
+! the user's attention, given its Free Software status, which may make it
+! complicated to use, with the result that its use is reserved for
+! developers and experienced professionals having in-depth computer
+! knowledge. Users are therefore encouraged to load and test the
+! suitability of the software as regards their requirements in conditions
+! enabling the security of their systems and/or data to be ensured and,
+! more generally, to use and operate it in the same conditions of
+! security. This Agreement may be freely reproduced and published,
+! provided it is not altered, and that no provisions are either added or
+! removed herefrom.
+!
+! This Agreement may apply to any or all software for which the holder of
+! the economic rights decides to submit the use thereof to its provisions.
+!
+! Article 1 - DEFINITIONS
+!
+! For the purpose of this Agreement, when the following expressions
+! commence with a capital letter, they shall have the following meaning:
+!
+! Agreement: means this license agreement, and its possible subsequent
+! versions and annexes.
+!
+! Software: means the software in its Object Code and/or Source Code form
+! and, where applicable, its documentation, "as is" when the Licensee
+! accepts the Agreement.
+!
+! Initial Software: means the Software in its Source Code and possibly its
+! Object Code form and, where applicable, its documentation, "as is" when
+! it is first distributed under the terms and conditions of the Agreement.
+!
+! Modified Software: means the Software modified by at least one
+! Contribution.
+!
+! Source Code: means all the Software's instructions and program lines to
+! which access is required so as to modify the Software.
+!
+! Object Code: means the binary files originating from the compilation of
+! the Source Code.
+!
+! Holder: means the holder(s) of the economic rights over the Initial
+! Software.
+!
+! Licensee: means the Software user(s) having accepted the Agreement.
+!
+! Contributor: means a Licensee having made at least one Contribution.
+!
+! Licensor: means the Holder, or any other individual or legal entity, who
+! distributes the Software under the Agreement.
+!
+! Contribution: means any or all modifications, corrections, translations,
+! adaptations and/or new functions integrated into the Software by any or
+! all Contributors, as well as any or all Internal Modules.
+!
+! Module: means a set of sources files including their documentation that
+! enables supplementary functions or services in addition to those offered
+! by the Software.
+!
+! External Module: means any or all Modules, not derived from the
+! Software, so that this Module and the Software run in separate address
+! spaces, with one calling the other when they are run.
+!
+! Internal Module: means any or all Module, connected to the Software so
+! that they both execute in the same address space.
+!
+! GNU GPL: means the GNU General Public License version 2 or any
+! subsequent version, as published by the Free Software Foundation Inc.
+!
+! Parties: mean both the Licensee and the Licensor.
+!
+! These expressions may be used both in singular and plural form.
+!
+! Article 2 - PURPOSE
+!
+! The purpose of the Agreement is the grant by the Licensor to the
+! Licensee of a non-exclusive, transferable and worldwide license for the
+! Software as set forth in Article 5 hereinafter for the whole term of the
+! protection granted by the rights over said Software.
+!
+! Article 3 - ACCEPTANCE
+!
+! 3.1 The Licensee shall be deemed as having accepted the terms and
+! conditions of this Agreement upon the occurrence of the first of the
+! following events:
+!
+! * (i) loading the Software by any or all means, notably, by
+! downloading from a remote server, or by loading from a physical
+! medium;
+! * (ii) the first time the Licensee exercises any of the rights
+! granted hereunder.
+!
+! 3.2 One copy of the Agreement, containing a notice relating to the
+! characteristics of the Software, to the limited warranty, and to the
+! fact that its use is restricted to experienced users has been provided
+! to the Licensee prior to its acceptance as set forth in Article 3.1
+! hereinabove, and the Licensee hereby acknowledges that it has read and
+! understood it.
+!
+! Article 4 - EFFECTIVE DATE AND TERM
+!
+! 4.1 EFFECTIVE DATE
+!
+! The Agreement shall become effective on the date when it is accepted by
+! the Licensee as set forth in Article 3.1.
+!
+! 4.2 TERM
+!
+! The Agreement shall remain in force for the entire legal term of
+! protection of the economic rights over the Software.
+!
+! Article 5 - SCOPE OF RIGHTS GRANTED
+!
+! The Licensor hereby grants to the Licensee, who accepts, the following
+! rights over the Software for any or all use, and for the term of the
+! Agreement, on the basis of the terms and conditions set forth hereinafter.
+!
+! Besides, if the Licensor owns or comes to own one or more patents
+! protecting all or part of the functions of the Software or of its
+! components, the Licensor undertakes not to enforce the rights granted by
+! these patents against successive Licensees using, exploiting or
+! modifying the Software. If these patents are transferred, the Licensor
+! undertakes to have the transferees subscribe to the obligations set
+! forth in this paragraph.
+!
+! 5.1 RIGHT OF USE
+!
+! The Licensee is authorized to use the Software, without any limitation
+! as to its fields of application, with it being hereinafter specified
+! that this comprises:
+!
+! 1. permanent or temporary reproduction of all or part of the Software
+! by any or all means and in any or all form.
+!
+! 2. loading, displaying, running, or storing the Software on any or
+! all medium.
+!
+! 3. entitlement to observe, study or test its operation so as to
+! determine the ideas and principles behind any or all constituent
+! elements of said Software. This shall apply when the Licensee
+! carries out any or all loading, displaying, running, transmission
+! or storage operation as regards the Software, that it is entitled
+! to carry out hereunder.
+!
+! 5.2 ENTITLEMENT TO MAKE CONTRIBUTIONS
+!
+! The right to make Contributions includes the right to translate, adapt,
+! arrange, or make any or all modifications to the Software, and the right
+! to reproduce the resulting software.
+!
+! The Licensee is authorized to make any or all Contributions to the
+! Software provided that it includes an explicit notice that it is the
+! author of said Contribution and indicates the date of the creation thereof.
+!
+! 5.3 RIGHT OF DISTRIBUTION
+!
+! In particular, the right of distribution includes the right to publish,
+! transmit and communicate the Software to the general public on any or
+! all medium, and by any or all means, and the right to market, either in
+! consideration of a fee, or free of charge, one or more copies of the
+! Software by any means.
+!
+! The Licensee is further authorized to distribute copies of the modified
+! or unmodified Software to third parties according to the terms and
+! conditions set forth hereinafter.
+!
+! 5.3.1 DISTRIBUTION OF SOFTWARE WITHOUT MODIFICATION
+!
+! The Licensee is authorized to distribute true copies of the Software in
+! Source Code or Object Code form, provided that said distribution
+! complies with all the provisions of the Agreement and is accompanied by:
+!
+! 1. a copy of the Agreement,
+!
+! 2. a notice relating to the limitation of both the Licensor's
+! warranty and liability as set forth in Articles 8 and 9,
+!
+! and that, in the event that only the Object Code of the Software is
+! redistributed, the Licensee allows future Licensees unhindered access to
+! the full Source Code of the Software by indicating how to access it, it
+! being understood that the additional cost of acquiring the Source Code
+! shall not exceed the cost of transferring the data.
+!
+! 5.3.2 DISTRIBUTION OF MODIFIED SOFTWARE
+!
+! When the Licensee makes a Contribution to the Software, the terms and
+! conditions for the distribution of the resulting Modified Software
+! become subject to all the provisions of this Agreement.
+!
+! The Licensee is authorized to distribute the Modified Software, in
+! source code or object code form, provided that said distribution
+! complies with all the provisions of the Agreement and is accompanied by:
+!
+! 1. a copy of the Agreement,
+!
+! 2. a notice relating to the limitation of both the Licensor's
+! warranty and liability as set forth in Articles 8 and 9,
+!
+! and that, in the event that only the object code of the Modified
+! Software is redistributed, the Licensee allows future Licensees
+! unhindered access to the full source code of the Modified Software by
+! indicating how to access it, it being understood that the additional
+! cost of acquiring the source code shall not exceed the cost of
+! transferring the data.
+!
+! 5.3.3 DISTRIBUTION OF EXTERNAL MODULES
+!
+! When the Licensee has developed an External Module, the terms and
+! conditions of this Agreement do not apply to said External Module, that
+! may be distributed under a separate license agreement.
+!
+! 5.3.4 COMPATIBILITY WITH THE GNU GPL
+!
+! The Licensee can include a code that is subject to the provisions of one
+! of the versions of the GNU GPL in the Modified or unmodified Software,
+! and distribute that entire code under the terms of the same version of
+! the GNU GPL.
+!
+! The Licensee can include the Modified or unmodified Software in a code
+! that is subject to the provisions of one of the versions of the GNU GPL,
+! and distribute that entire code under the terms of the same version of
+! the GNU GPL.
+!
+! Article 6 - INTELLECTUAL PROPERTY
+!
+! 6.1 OVER THE INITIAL SOFTWARE
+!
+! The Holder owns the economic rights over the Initial Software. Any or
+! all use of the Initial Software is subject to compliance with the terms
+! and conditions under which the Holder has elected to distribute its work
+! and no one shall be entitled to modify the terms and conditions for the
+! distribution of said Initial Software.
+!
+! The Holder undertakes that the Initial Software will remain ruled at
+! least by this Agreement, for the duration set forth in Article 4.2.
+!
+! 6.2 OVER THE CONTRIBUTIONS
+!
+! The Licensee who develops a Contribution is the owner of the
+! intellectual property rights over this Contribution as defined by
+! applicable law.
+!
+! 6.3 OVER THE EXTERNAL MODULES
+!
+! The Licensee who develops an External Module is the owner of the
+! intellectual property rights over this External Module as defined by
+! applicable law and is free to choose the type of agreement that shall
+! govern its distribution.
+!
+! 6.4 JOINT PROVISIONS
+!
+! The Licensee expressly undertakes:
+!
+! 1. not to remove, or modify, in any manner, the intellectual property
+! notices attached to the Software;
+!
+! 2. to reproduce said notices, in an identical manner, in the copies
+! of the Software modified or not.
+!
+! The Licensee undertakes not to directly or indirectly infringe the
+! intellectual property rights of the Holder and/or Contributors on the
+! Software and to take, where applicable, vis-a-vis its staff, any and all
+! measures required to ensure respect of said intellectual property rights
+! of the Holder and/or Contributors.
+!
+! Article 7 - RELATED SERVICES
+!
+! 7.1 Under no circumstances shall the Agreement oblige the Licensor to
+! provide technical assistance or maintenance services for the Software.
+!
+! However, the Licensor is entitled to offer this type of services. The
+! terms and conditions of such technical assistance, and/or such
+! maintenance, shall be set forth in a separate instrument. Only the
+! Licensor offering said maintenance and/or technical assistance services
+! shall incur liability therefor.
+!
+! 7.2 Similarly, any Licensor is entitled to offer to its licensees, under
+! its sole responsibility, a warranty, that shall only be binding upon
+! itself, for the redistribution of the Software and/or the Modified
+! Software, under terms and conditions that it is free to decide. Said
+! warranty, and the financial terms and conditions of its application,
+! shall be subject of a separate instrument executed between the Licensor
+! and the Licensee.
+!
+! Article 8 - LIABILITY
+!
+! 8.1 Subject to the provisions of Article 8.2, the Licensee shall be
+! entitled to claim compensation for any direct loss it may have suffered
+! from the Software as a result of a fault on the part of the relevant
+! Licensor, subject to providing evidence thereof.
+!
+! 8.2 The Licensor's liability is limited to the commitments made under
+! this Agreement and shall not be incurred as a result of in particular:
+! (i) loss due the Licensee's total or partial failure to fulfill its
+! obligations, (ii) direct or consequential loss that is suffered by the
+! Licensee due to the use or performance of the Software, and (iii) more
+! generally, any consequential loss. In particular the Parties expressly
+! agree that any or all pecuniary or business loss (i.e. loss of data,
+! loss of profits, operating loss, loss of customers or orders,
+! opportunity cost, any disturbance to business activities) or any or all
+! legal proceedings instituted against the Licensee by a third party,
+! shall constitute consequential loss and shall not provide entitlement to
+! any or all compensation from the Licensor.
+!
+! Article 9 - WARRANTY
+!
+! 9.1 The Licensee acknowledges that the scientific and technical
+! state-of-the-art when the Software was distributed did not enable all
+! possible uses to be tested and verified, nor for the presence of
+! possible defects to be detected. In this respect, the Licensee's
+! attention has been drawn to the risks associated with loading, using,
+! modifying and/or developing and reproducing the Software which are
+! reserved for experienced users.
+!
+! The Licensee shall be responsible for verifying, by any or all means,
+! the suitability of the product for its requirements, its good working
+! order, and for ensuring that it shall not cause damage to either persons
+! or properties.
+!
+! 9.2 The Licensor hereby represents, in good faith, that it is entitled
+! to grant all the rights over the Software (including in particular the
+! rights set forth in Article 5).
+!
+! 9.3 The Licensee acknowledges that the Software is supplied "as is" by
+! the Licensor without any other express or tacit warranty, other than
+! that provided for in Article 9.2 and, in particular, without any warranty
+! as to its commercial value, its secured, safe, innovative or relevant
+! nature.
+!
+! Specifically, the Licensor does not warrant that the Software is free
+! from any error, that it will operate without interruption, that it will
+! be compatible with the Licensee's own equipment and software
+! configuration, nor that it will meet the Licensee's requirements.
+!
+! 9.4 The Licensor does not either expressly or tacitly warrant that the
+! Software does not infringe any third party intellectual property right
+! relating to a patent, software or any other property right. Therefore,
+! the Licensor disclaims any and all liability towards the Licensee
+! arising out of any or all proceedings for infringement that may be
+! instituted in respect of the use, modification and redistribution of the
+! Software. Nevertheless, should such proceedings be instituted against
+! the Licensee, the Licensor shall provide it with technical and legal
+! assistance for its defense. Such technical and legal assistance shall be
+! decided on a case-by-case basis between the relevant Licensor and the
+! Licensee pursuant to a memorandum of understanding. The Licensor
+! disclaims any and all liability as regards the Licensee's use of the
+! name of the Software. No warranty is given as regards the existence of
+! prior rights over the name of the Software or as regards the existence
+! of a trademark.
+!
+! Article 10 - TERMINATION
+!
+! 10.1 In the event of a breach by the Licensee of its obligations
+! hereunder, the Licensor may automatically terminate this Agreement
+! thirty (30) days after notice has been sent to the Licensee and has
+! remained ineffective.
+!
+! 10.2 A Licensee whose Agreement is terminated shall no longer be
+! authorized to use, modify or distribute the Software. However, any
+! licenses that it may have granted prior to termination of the Agreement
+! shall remain valid subject to their having been granted in compliance
+! with the terms and conditions hereof.
+!
+! Article 11 - MISCELLANEOUS
+!
+! 11.1 EXCUSABLE EVENTS
+!
+! Neither Party shall be liable for any or all delay, or failure to
+! perform the Agreement, that may be attributable to an event of force
+! majeure, an act of God or an outside cause, such as defective
+! functioning or interruptions of the electricity or telecommunications
+! networks, network paralysis following a virus attack, intervention by
+! government authorities, natural disasters, water damage, earthquakes,
+! fire, explosions, strikes and labor unrest, war, etc.
+!
+! 11.2 Any failure by either Party, on one or more occasions, to invoke
+! one or more of the provisions hereof, shall under no circumstances be
+! interpreted as being a waiver by the interested Party of its right to
+! invoke said provision(s) subsequently.
+!
+! 11.3 The Agreement cancels and replaces any or all previous agreements,
+! whether written or oral, between the Parties and having the same
+! purpose, and constitutes the entirety of the agreement between said
+! Parties concerning said purpose. No supplement or modification to the
+! terms and conditions hereof shall be effective as between the Parties
+! unless it is made in writing and signed by their duly authorized
+! representatives.
+!
+! 11.4 In the event that one or more of the provisions hereof were to
+! conflict with a current or future applicable act or legislative text,
+! said act or legislative text shall prevail, and the Parties shall make
+! the necessary amendments so as to comply with said act or legislative
+! text. All other provisions shall remain effective. Similarly, invalidity
+! of a provision of the Agreement, for any reason whatsoever, shall not
+! cause the Agreement as a whole to be invalid.
+!
+! 11.5 LANGUAGE
+!
+! The Agreement is drafted in both French and English and both versions
+! are deemed authentic.
+!
+! Article 12 - NEW VERSIONS OF THE AGREEMENT
+!
+! 12.1 Any person is authorized to duplicate and distribute copies of this
+! Agreement.
+!
+! 12.2 So as to ensure coherence, the wording of this Agreement is
+! protected and may only be modified by the authors of the License, who
+! reserve the right to periodically publish updates or new versions of the
+! Agreement, each with a separate number. These subsequent versions may
+! address new issues encountered by Free Software.
+!
+! 12.3 Any Software distributed under a given version of the Agreement may
+! only be subsequently distributed under the same version of the Agreement
+! or a subsequent version, subject to the provisions of Article 5.3.4.
+!
+! Article 13 - GOVERNING LAW AND JURISDICTION
+!
+! 13.1 The Agreement is governed by French law. The Parties agree to
+! endeavor to seek an amicable solution to any disagreements or disputes
+! that may arise during the performance of the Agreement.
+!
+! 13.2 Failing an amicable solution within two (2) months as from their
+! occurrence, and unless emergency proceedings are necessary, the
+! disagreements or disputes shall be referred to the Paris Courts having
+! jurisdiction, by the more diligent Party.
+!
+! Version 2.0 dated 2006-09-05.
+!
Added: seismo/3D/CPML/tags/v1.1.1/seismic_PML_Collino_3D_isotropic_OpenMP.f90
===================================================================
--- seismo/3D/CPML/tags/v1.1.1/seismic_PML_Collino_3D_isotropic_OpenMP.f90 (rev 0)
+++ seismo/3D/CPML/tags/v1.1.1/seismic_PML_Collino_3D_isotropic_OpenMP.f90 2009-11-03 21:35:50 UTC (rev 15926)
@@ -0,0 +1,1606 @@
+!
+! SEISMIC_CPML Version 1.1.1, November 2009.
+!
+! Copyright Universite de Pau et des Pays de l'Adour, CNRS and INRIA, France.
+! Contributors: Dimitri Komatitsch, dimitri DOT komatitsch aT univ-pau DOT fr
+! and Roland Martin, roland DOT martin aT univ-pau DOT fr
+!
+! This software is a computer program whose purpose is to solve
+! the three-dimensional isotropic elastic wave equation
+! using a finite-difference method with classical split Perfectly Matched
+! Layer (PML) conditions.
+!
+! This software is governed by the CeCILL license under French law and
+! abiding by the rules of distribution of free software. You can use,
+! modify and/or redistribute the software under the terms of the CeCILL
+! license as circulated by CEA, CNRS and INRIA at the following URL
+! "http://www.cecill.info".
+!
+! As a counterpart to the access to the source code and rights to copy,
+! modify and redistribute granted by the license, users are provided only
+! with a limited warranty and the software's author, the holder of the
+! economic rights, and the successive licensors have only limited
+! liability.
+!
+! In this respect, the user's attention is drawn to the risks associated
+! with loading, using, modifying and/or developing or reproducing the
+! software by the user in light of its specific status of free software,
+! that may mean that it is complicated to manipulate, and that also
+! therefore means that it is reserved for developers and experienced
+! professionals having in-depth computer knowledge. Users are therefore
+! encouraged to load and test the software's suitability as regards their
+! requirements in conditions enabling the security of their systems and/or
+! data to be ensured and, more generally, to use and operate it in the
+! same conditions as regards security.
+!
+! The full text of the license is available at the end of this program
+! and in file "LICENSE".
+
+ program seismic_PML_Collino_3D_iso
+
+ implicit none
+
+!
+! 3D explicit PML velocity-stress FD code based upon INRIA report for the 2D case:
+!
+! Francis Collino and Chrysoula Tsogka
+! Application of the PML Absorbing Layer Model to the Linear
+! Elastodynamic Problem in Anisotropic Heteregeneous Media
+! INRIA Research Report RR-3471, August 1998
+! http://www.inria.fr/publications
+!
+! and
+!
+! @ARTICLE{CoTs01,
+! author = {F. Collino and C. Tsogka},
+! title = {Application of the {PML} absorbing layer model to the linear elastodynamic
+! problem in anisotropic heterogeneous media},
+! journal = {Geophysics},
+! year = {2001},
+! volume = {66},
+! number = {1},
+! pages = {294-307}}
+!
+! PML implemented in the three directions (x, y and z).
+!
+! Dimitri Komatitsch and Roland Martin, University of Pau, France, April 2007.
+!
+! The second-order staggered-grid formulation of Madariaga (1976) and Virieux (1986) is used.
+!
+! Parallel implementation based on OpenMP.
+! Type for instance "setenv OMP_NUM_THREADS 4" before running in OpenMP if you want 4 tasks.
+!
+! To display the results as color images in the selected 2D cut plane, use:
+!
+! " display image*.gif " or " gimp image*.gif "
+!
+! or
+!
+! " montage -geometry +0+3 -rotate 90 -tile 1x21 image*Vx*.gif allfiles_Vx.gif "
+! " montage -geometry +0+3 -rotate 90 -tile 1x21 image*Vy*.gif allfiles_Vy.gif "
+! then " display allfiles_Vx.gif " or " gimp allfiles_Vx.gif "
+! then " display allfiles_Vy.gif " or " gimp allfiles_Vy.gif "
+!
+
+! total number of grid points in each direction of the grid
+ integer, parameter :: NX = 101
+ integer, parameter :: NY = 641
+ integer, parameter :: NZ = 640
+
+! size of a grid cell
+ double precision, parameter :: h = 10.d0
+
+! thickness of the PML layer in grid points
+ integer, parameter :: NPOINTS_PML = 10
+
+! P-velocity, S-velocity and density
+ double precision, parameter :: cp = 3300.d0
+ double precision, parameter :: cs = cp / 1.732d0
+ double precision, parameter :: rho = 2800.d0
+ double precision, parameter :: mu = rho*cs*cs
+ double precision, parameter :: lambda = rho*(cp*cp - 2.d0*cs*cs)
+ double precision, parameter :: lambda_plus_two_mu = rho*cp*cp
+
+! total number of time steps
+ integer, parameter :: NSTEP = 2500
+
+! time step in seconds
+ double precision, parameter :: DELTAT = 1.6d-3
+ double precision, parameter :: ONE_OVER_DELTAT = 1.d0 / DELTAT
+
+! parameters for the source
+ double precision, parameter :: f0 = 7.d0
+ double precision, parameter :: t0 = 1.20d0 / f0
+ double precision, parameter :: factor = 1.d7
+
+! source
+ integer, parameter :: ISOURCE = NX - 2*NPOINTS_PML - 1
+ integer, parameter :: JSOURCE = 2 * NY / 3 + 1
+ integer, parameter :: KSOURCE = NZ / 2
+ double precision, parameter :: xsource = (ISOURCE - 1) * h
+ double precision, parameter :: ysource = (JSOURCE - 1) * h
+ double precision, parameter :: zsource = (KSOURCE - 1) * h
+! angle of source force clockwise with respect to vertical (Y) axis
+ double precision, parameter :: ANGLE_FORCE = 135.d0
+
+! receivers
+ integer, parameter :: NREC = 2
+ double precision, parameter :: xdeb = xsource - 100.d0 ! first receiver x in meters
+ double precision, parameter :: ydeb = 2300.d0 ! first receiver y in meters
+ double precision, parameter :: zdeb = zsource ! first receiver y in meters
+ double precision, parameter :: xfin = xsource ! last receiver x in meters
+ double precision, parameter :: yfin = 300.d0 ! last receiver y in meters
+ double precision, parameter :: zfin = zsource ! last receiver y in meters
+
+! display information on the screen from time to time
+ integer, parameter :: IT_DISPLAY = 100
+
+! value of PI
+ double precision, parameter :: PI = 3.141592653589793238462643d0
+
+! conversion from degrees to radians
+ double precision, parameter :: DEGREES_TO_RADIANS = PI / 180.d0
+
+! zero
+ double precision, parameter :: ZERO = 0.d0
+
+! large value for maximum
+ double precision, parameter :: HUGEVAL = 1.d+30
+
+! velocity threshold above which we consider that the code became unstable
+ double precision, parameter :: STABILITY_THRESHOLD = 1.d+25
+
+! main arrays
+ double precision, dimension(NX,NY,NZ) :: vx_1,vx_2,vx_3,&
+ vy_1,vy_2,vy_3,&
+ vz_1,vz_2,vz_3,&
+ sigmaxx_1,sigmaxx_2,sigmaxx_3,&
+ sigmayy_1,sigmayy_2,sigmayy_3,&
+ sigmazz_1,sigmazz_2,sigmazz_3,&
+ sigmaxy_1,sigmaxy_2,&
+ sigmaxz_1,sigmaxz_3,&
+ sigmayz_2,sigmayz_3
+
+ double precision, dimension(NX) :: dx_over_two,dx_half_over_two
+ double precision, dimension(NY) :: dy_over_two,dy_half_over_two
+ double precision, dimension(NZ) :: dz_over_two,dz_half_over_two
+
+! for the source
+ double precision a,t,force_x,force_y,force_z,source_term
+
+! for receivers
+ double precision xspacerec,yspacerec,zspacerec,distval,dist
+ integer, dimension(NREC) :: ix_rec,iy_rec,iz_rec
+ double precision, dimension(NREC) :: xrec,yrec,zrec
+ double precision, dimension(NSTEP,NREC) :: sisvx,sisvy
+
+! for evolution of total energy in the medium
+ double precision :: epsilon_xx,epsilon_yy,epsilon_zz,epsilon_xy,epsilon_xz,epsilon_yz
+ double precision :: sigmaxx_total,sigmayy_total,sigmazz_total
+ double precision :: sigmaxy_total,sigmaxz_total,sigmayz_total
+ double precision :: total_energy_kinetic,total_energy_potential
+ double precision, dimension(NSTEP) :: total_energy
+
+ integer :: i,j,k,it,irec,iplane
+
+ double precision :: xval,delta,xoriginleft,xoriginright,rcoef,d0,Vsolidnorm,Courant_number,value_dx,value_dy,value_dz,d
+
+! timer to count elapsed time
+ character(len=8) datein
+ character(len=10) timein
+ character(len=5) :: zone
+ integer, dimension(8) :: time_values
+ integer ihours,iminutes,iseconds,int_tCPU
+ double precision :: time_start,time_end,tCPU
+
+! names of the time stamp files
+ character(len=150) outputname
+
+! main I/O file
+ integer, parameter :: IOUT = 41
+
+!---
+!--- program starts here
+!---
+
+!--- define profile of absorption in PML region
+
+! thickness of the layer in meters
+ delta = NPOINTS_PML * h
+
+! reflection coefficient (INRIA report section 6.1)
+ Rcoef = 0.001d0
+
+! compute d0 from INRIA report section 6.1
+ d0 = 3.d0 * cp * log(1.d0/Rcoef) / (2.d0 * delta)
+
+ print *,'d0 = ',d0
+ print *
+
+! origin of the PML layer (position of right edge minus thickness, in meters)
+ xoriginleft = delta
+ xoriginright = (NX-1)*h - delta
+
+ do i=1,NX
+
+ xval = h*dble(i-1)
+
+ if(xval < xoriginleft) then
+ dx_over_two(i) = d0 * ((xoriginleft-xval)/delta)**2
+ dx_half_over_two(i) = d0 * ((xoriginleft-xval-h/2.d0)/delta)**2
+! fix problem with dx_half_over_two() exactly on the edge
+ else if(xval >= 0.9999d0*xoriginright) then
+ dx_over_two(i) = d0 * ((xval-xoriginright)/delta)**2
+ dx_half_over_two(i) = d0 * ((xval+h/2.d0-xoriginright)/delta)**2
+ else
+ dx_over_two(i) = 0.d0
+ dx_half_over_two(i) = 0.d0
+ endif
+
+ enddo
+
+! divide the whole profile by two once and for all
+ dx_over_two(:) = dx_over_two(:) / 2.d0
+ dx_half_over_two(:) = dx_half_over_two(:) / 2.d0
+
+! origin of the PML layer (position of right edge minus thickness, in meters)
+ xoriginleft = delta
+ xoriginright = (NY-1)*h - delta
+
+ do j=1,NY
+
+ xval = h*dble(j-1)
+
+ if(xval < xoriginleft) then
+ dy_over_two(j) = d0 * ((xoriginleft-xval)/delta)**2
+ dy_half_over_two(j) = d0 * ((xoriginleft-xval-h/2.d0)/delta)**2
+! fix problem with dy_half_over_two() exactly on the edge
+ else if(xval >= 0.9999d0*xoriginright) then
+ dy_over_two(j) = d0 * ((xval-xoriginright)/delta)**2
+ dy_half_over_two(j) = d0 * ((xval+h/2.d0-xoriginright)/delta)**2
+ else
+ dy_over_two(j) = 0.d0
+ dy_half_over_two(j) = 0.d0
+ endif
+
+ enddo
+
+! divide the whole profile by two once and for all
+ dy_over_two(:) = dy_over_two(:) / 2.d0
+ dy_half_over_two(:) = dy_half_over_two(:) / 2.d0
+
+! origin of the PML layer (position of right edge minus thickness, in meters)
+ xoriginleft = delta
+ xoriginright = (NZ-1)*h - delta
+
+ do k=1,NZ
+
+ xval = h*dble(k-1)
+
+ if(xval < xoriginleft) then
+ dz_over_two(k) = d0 * ((xoriginleft-xval)/delta)**2
+ dz_half_over_two(k) = d0 * ((xoriginleft-xval-h/2.d0)/delta)**2
+! fix problem with dy_half_over_two() exactly on the edge
+ else if(xval >= 0.9999d0*xoriginright) then
+ dz_over_two(k) = d0 * ((xval-xoriginright)/delta)**2
+ dz_half_over_two(k) = d0 * ((xval+h/2.d0-xoriginright)/delta)**2
+ else
+ dz_over_two(k) = 0.d0
+ dz_half_over_two(k) = 0.d0
+ endif
+
+ enddo
+
+! divide the whole profile by two once and for all
+ dz_over_two(:) = dz_over_two(:) / 2.d0
+ dz_half_over_two(:) = dz_half_over_two(:) / 2.d0
+
+! print position of the source
+ print *
+ print *,'Position of the source:'
+ print *
+ print *,'x = ',xsource
+ print *,'y = ',ysource
+ print *,'z = ',zsource
+ print *
+
+! define location of receivers
+ print *
+ print *,'There are ',nrec,' receivers'
+ print *
+ xspacerec = (xfin-xdeb) / dble(NREC-1)
+ yspacerec = (yfin-ydeb) / dble(NREC-1)
+ zspacerec = (zfin-zdeb) / dble(NREC-1)
+ do irec=1,nrec
+ xrec(irec) = xdeb + dble(irec-1)*xspacerec
+ yrec(irec) = ydeb + dble(irec-1)*yspacerec
+ zrec(irec) = zdeb + dble(irec-1)*zspacerec
+ enddo
+
+! find closest grid point for each receiver
+ do irec=1,nrec
+ dist = HUGEVAL
+ do k = 1,NZ
+ do j = 1,NY
+ do i = 1,NX
+ distval = sqrt((h*dble(i-1) - xrec(irec))**2 + (h*dble(j-1) - yrec(irec))**2 + (h*dble(k-1) - zrec(irec))**2)
+ if(distval < dist) then
+ dist = distval
+ ix_rec(irec) = i
+ iy_rec(irec) = j
+ iz_rec(irec) = k
+ endif
+ enddo
+ enddo
+ enddo
+ print *,'receiver ',irec,' x_target,y_target,z_target = ',xrec(irec),yrec(irec),zrec(irec)
+ print *,'closest grid point found at distance ',dist,' in i,j,k = ',ix_rec(irec),iy_rec(irec),iz_rec(irec)
+ print *
+ enddo
+
+! check the Courant stability condition for the explicit time scheme
+! R. Courant et K. O. Friedrichs et H. Lewy (1928)
+ Courant_number = cp * DELTAT / h
+ print *,'Courant number is ',Courant_number
+ print *
+ if(Courant_number > 1.d0/sqrt(3.d0)) stop 'time step is too large, simulation will be unstable'
+
+! suppress old files (can be commented out if "call system" is missing in your compiler)
+! call system('rm -f Vx_*.dat Vy_*.dat Vz_*.dat image*.pnm image*.gif timestamp*')
+
+! initialize arrays
+ vx_1(:,:,:) = 0.d0
+ vy_1(:,:,:) = 0.d0
+ vz_1(:,:,:) = 0.d0
+
+ vx_2(:,:,:) = 0.d0
+ vy_2(:,:,:) = 0.d0
+ vz_2(:,:,:) = 0.d0
+
+ vx_3(:,:,:) = 0.d0
+ vy_3(:,:,:) = 0.d0
+ vz_3(:,:,:) = 0.d0
+
+ sigmaxx_1(:,:,:) = 0.d0
+ sigmayy_1(:,:,:) = 0.d0
+ sigmazz_1(:,:,:) = 0.d0
+ sigmaxy_1(:,:,:) = 0.d0
+ sigmaxz_1(:,:,:) = 0.d0
+
+ sigmaxx_2(:,:,:) = 0.d0
+ sigmayy_2(:,:,:) = 0.d0
+ sigmazz_2(:,:,:) = 0.d0
+ sigmaxy_2(:,:,:) = 0.d0
+ sigmayz_2(:,:,:) = 0.d0
+
+ sigmaxx_3(:,:,:) = 0.d0
+ sigmayy_3(:,:,:) = 0.d0
+ sigmazz_3(:,:,:) = 0.d0
+ sigmaxz_3(:,:,:) = 0.d0
+ sigmayz_3(:,:,:) = 0.d0
+
+! initialize seismograms
+ sisvx(:,:) = 0.d0
+ sisvy(:,:) = 0.d0
+
+! initialize total energy
+ total_energy(:) = 0.d0
+
+ call date_and_time(datein,timein,zone,time_values)
+! time_values(3): day of the month
+! time_values(5): hour of the day
+! time_values(6): minutes of the hour
+! time_values(7): seconds of the minute
+! time_values(8): milliseconds of the second
+! this fails if we cross the end of the month
+ time_start = 86400.d0*time_values(3) + 3600.d0*time_values(5) + &
+ 60.d0*time_values(6) + time_values(7) + time_values(8) / 1000.d0
+
+!---
+!--- beginning of time loop
+!---
+
+ do it = 1,NSTEP
+
+ print *,'it = ',it
+
+!----------------------
+! compute stress sigma
+!----------------------
+
+!$OMP PARALLEL DO DEFAULT(NONE) PRIVATE(i,j,k,d,value_dx,value_dy,value_dz) &
+!$OMP SHARED(vx_1,vx_2,vx_3,vy_1,vy_2,vy_3,vz_1,vz_2,vz_3,sigmaxx_1,sigmaxx_2,sigmaxx_3, &
+!$OMP sigmayy_1,sigmayy_2,sigmayy_3,sigmazz_1,sigmazz_2,sigmazz_3,dx_half_over_two,dy_over_two,dz_over_two)
+do k=2,NZ
+ do j = 2,NY
+ do i = 1,NX-1
+
+ value_dx = (vx_1(i+1,j,k) - vx_1(i,j,k)) / h &
+ + (vx_2(i+1,j,k) - vx_2(i,j,k)) / h &
+ + (vx_3(i+1,j,k) - vx_3(i,j,k)) / h
+
+ value_dy = (vy_1(i,j,k) - vy_1(i,j-1,k)) / h &
+ + (vy_2(i,j,k) - vy_2(i,j-1,k)) / h &
+ + (vy_3(i,j,k) - vy_3(i,j-1,k)) / h
+
+ value_dz = (vz_1(i,j,k) - vz_1(i,j,k-1)) / h &
+ + (vz_2(i,j,k) - vz_2(i,j,k-1)) / h &
+ + (vz_3(i,j,k) - vz_3(i,j,k-1)) / h
+
+ d = dx_half_over_two(i)
+
+ sigmaxx_1(i,j,k) = ( sigmaxx_1(i,j,k)*(ONE_OVER_DELTAT - d) + lambda_plus_two_mu * value_dx ) / (ONE_OVER_DELTAT + d)
+
+ sigmayy_1(i,j,k) = ( sigmayy_1(i,j,k)*(ONE_OVER_DELTAT - d) + lambda * value_dx ) / (ONE_OVER_DELTAT + d)
+
+ sigmazz_1(i,j,k) = ( sigmazz_1(i,j,k)*(ONE_OVER_DELTAT - d) + lambda * value_dx ) / (ONE_OVER_DELTAT + d)
+
+ d = dy_over_two(j)
+
+ sigmaxx_2(i,j,k) = ( sigmaxx_2(i,j,k)*(ONE_OVER_DELTAT - d) + lambda * value_dy ) / (ONE_OVER_DELTAT + d)
+
+ sigmayy_2(i,j,k) = ( sigmayy_2(i,j,k)*(ONE_OVER_DELTAT - d) + lambda_plus_two_mu * value_dy ) / (ONE_OVER_DELTAT + d)
+
+ sigmazz_2(i,j,k) = ( sigmazz_2(i,j,k)*(ONE_OVER_DELTAT - d) + lambda * value_dy ) / (ONE_OVER_DELTAT + d)
+
+ d = dz_over_two(k)
+
+ sigmaxx_3(i,j,k) = ( sigmaxx_3(i,j,k)*(ONE_OVER_DELTAT - d) + lambda * value_dz ) / (ONE_OVER_DELTAT + d)
+
+ sigmayy_3(i,j,k) = ( sigmayy_3(i,j,k)*(ONE_OVER_DELTAT - d) + lambda * value_dz ) / (ONE_OVER_DELTAT + d)
+
+ sigmazz_3(i,j,k) = ( sigmazz_3(i,j,k)*(ONE_OVER_DELTAT - d) + lambda_plus_two_mu * value_dz ) / (ONE_OVER_DELTAT + d)
+
+ enddo
+ enddo
+ enddo
+!$OMP END PARALLEL DO
+
+!$OMP PARALLEL DO DEFAULT(NONE) PRIVATE(i,j,k,d,value_dx,value_dy) SHARED(vx_1,vx_2,vx_3,vy_1, &
+!$OMP vy_2,vy_3,sigmaxy_1,sigmaxy_2,dy_half_over_two,dx_over_two)
+do k=1,NZ
+ do j = 1,NY-1
+ do i = 2,NX
+
+ value_dx = (vy_1(i,j,k) - vy_1(i-1,j,k)) / h &
+ + (vy_2(i,j,k) - vy_2(i-1,j,k)) / h &
+ + (vy_3(i,j,k) - vy_3(i-1,j,k)) / h
+
+ value_dy = (vx_1(i,j+1,k) - vx_1(i,j,k)) / h &
+ + (vx_2(i,j+1,k) - vx_2(i,j,k)) / h &
+ + (vx_3(i,j+1,k) - vx_3(i,j,k)) / h
+
+ d = dx_over_two(i)
+
+ sigmaxy_1(i,j,k) = ( sigmaxy_1(i,j,k)*(ONE_OVER_DELTAT - d) + mu * value_dx ) / (ONE_OVER_DELTAT + d)
+
+ d = dy_half_over_two(j)
+
+ sigmaxy_2(i,j,k) = ( sigmaxy_2(i,j,k)*(ONE_OVER_DELTAT - d) + mu * value_dy ) / (ONE_OVER_DELTAT + d)
+
+ enddo
+ enddo
+enddo
+!$OMP END PARALLEL DO
+
+!$OMP PARALLEL DO DEFAULT(NONE) PRIVATE(i,j,k,d,value_dx,value_dz) SHARED(vx_1,vx_2,vx_3, &
+!$OMP vz_1,vz_2,vz_3,sigmaxz_1,sigmaxz_3,dz_half_over_two,dx_over_two)
+do k=1,NZ-1
+ do j = 1,NY
+ do i = 2,NX
+
+ value_dx = (vz_1(i,j,k) - vz_1(i-1,j,k)) / h &
+ + (vz_2(i,j,k) - vz_2(i-1,j,k)) / h &
+ + (vz_3(i,j,k) - vz_3(i-1,j,k)) / h
+
+ value_dz = (vx_1(i,j,k+1) - vx_1(i,j,k)) / h &
+ + (vx_2(i,j,k+1) - vx_2(i,j,k)) / h &
+ + (vx_3(i,j,k+1) - vx_3(i,j,k)) / h
+
+ d = dx_over_two(i)
+
+ sigmaxz_1(i,j,k) = ( sigmaxz_1(i,j,k)*(ONE_OVER_DELTAT - d) + mu * value_dx ) / (ONE_OVER_DELTAT + d)
+
+ d = dz_half_over_two(k)
+
+ sigmaxz_3(i,j,k) = ( sigmaxz_3(i,j,k)*(ONE_OVER_DELTAT - d) + mu * value_dz ) / (ONE_OVER_DELTAT + d)
+
+ enddo
+ enddo
+enddo
+!$OMP END PARALLEL DO
+
+!$OMP PARALLEL DO DEFAULT(NONE) PRIVATE(i,j,k,d,value_dy,value_dz) SHARED(vy_1,vy_2,vy_3, &
+!$OMP vz_1,vz_2,vz_3,sigmayz_2,sigmayz_3,dy_half_over_two,dz_half_over_two)
+do k=1,NZ-1
+ do j = 1,NY-1
+ do i = 1,NX
+
+ value_dy = (vz_1(i,j+1,k) - vz_1(i,j,k)) / h &
+ + (vz_2(i,j+1,k) - vz_2(i,j,k)) / h &
+ + (vz_3(i,j+1,k) - vz_3(i,j,k)) / h
+
+ value_dz = (vy_1(i,j,k+1) - vy_1(i,j,k)) / h &
+ + (vy_2(i,j,k+1) - vy_2(i,j,k)) / h &
+ + (vy_3(i,j,k+1) - vy_3(i,j,k)) / h
+
+ d = dy_half_over_two(j)
+
+ sigmayz_2(i,j,k) = ( sigmayz_2(i,j,k)*(ONE_OVER_DELTAT - d) + mu * value_dy ) / (ONE_OVER_DELTAT + d)
+
+ d = dz_half_over_two(k)
+
+ sigmayz_3(i,j,k) = ( sigmayz_3(i,j,k)*(ONE_OVER_DELTAT - d) + mu * value_dz ) / (ONE_OVER_DELTAT + d)
+
+ enddo
+ enddo
+enddo
+!$OMP END PARALLEL DO
+
+!------------------
+! compute velocity
+!------------------
+
+!$OMP PARALLEL DO DEFAULT(NONE) PRIVATE(i,j,k,d,value_dx,value_dy,value_dz) SHARED(vx_1,vx_2, &
+!$OMP vx_3,sigmaxx_1,sigmaxx_2,sigmaxx_3,sigmaxy_1,sigmaxy_2,sigmaxz_1,sigmaxz_3,dx_over_two,dy_over_two,dz_over_two)
+do k = 2,NZ
+ do j = 2,NY
+ do i = 2,NX
+
+ value_dx = (sigmaxx_1(i,j,k) - sigmaxx_1(i-1,j,k)) / h &
+ + (sigmaxx_2(i,j,k) - sigmaxx_2(i-1,j,k)) / h &
+ + (sigmaxx_3(i,j,k) - sigmaxx_3(i-1,j,k)) / h
+
+ value_dy = (sigmaxy_1(i,j,k) - sigmaxy_1(i,j-1,k)) / h &
+ + (sigmaxy_2(i,j,k) - sigmaxy_2(i,j-1,k)) / h
+
+ value_dz = (sigmaxz_1(i,j,k) - sigmaxz_1(i,j,k-1)) / h &
+ + (sigmaxz_3(i,j,k) - sigmaxz_3(i,j,k-1)) / h
+
+ d = dx_over_two(i)
+
+ vx_1(i,j,k) = ( vx_1(i,j,k)*(ONE_OVER_DELTAT - d) + value_dx / rho ) / (ONE_OVER_DELTAT + d)
+
+ d = dy_over_two(j)
+
+ vx_2(i,j,k) = ( vx_2(i,j,k)*(ONE_OVER_DELTAT - d) + value_dy / rho ) / (ONE_OVER_DELTAT + d)
+
+ d = dz_over_two(k)
+
+ vx_3(i,j,k) = ( vx_3(i,j,k)*(ONE_OVER_DELTAT - d) + value_dz / rho ) / (ONE_OVER_DELTAT + d)
+
+ enddo
+ enddo
+enddo
+!$OMP END PARALLEL DO
+
+!$OMP PARALLEL DO DEFAULT(NONE) PRIVATE(i,j,k,d,value_dx,value_dy,value_dz) SHARED(vy_1,vy_2, &
+!$OMP vy_3,sigmayy_1,sigmayy_2,sigmayy_3,sigmaxy_1,sigmaxy_2,sigmayz_2,sigmayz_3,dx_half_over_two,dy_half_over_two,dz_over_two)
+do k = 2,NZ
+ do j = 1,NY-1
+ do i = 1,NX-1
+
+ value_dx = (sigmaxy_1(i+1,j,k) - sigmaxy_1(i,j,k)) / h &
+ + (sigmaxy_2(i+1,j,k) - sigmaxy_2(i,j,k)) / h
+
+ value_dy = (sigmayy_1(i,j+1,k) - sigmayy_1(i,j,k)) / h &
+ + (sigmayy_2(i,j+1,k) - sigmayy_2(i,j,k)) / h &
+ + (sigmayy_3(i,j+1,k) - sigmayy_3(i,j,k)) / h
+
+ value_dz = (sigmayz_2(i,j,k) - sigmayz_2(i,j,k-1)) / h &
+ + (sigmayz_3(i,j,k) - sigmayz_3(i,j,k-1)) / h
+
+ d = dx_half_over_two(i)
+
+ vy_1(i,j,k) = ( vy_1(i,j,k)*(ONE_OVER_DELTAT - d) + value_dx / rho ) / (ONE_OVER_DELTAT + d)
+
+ d = dy_half_over_two(j)
+
+ vy_2(i,j,k) = ( vy_2(i,j,k)*(ONE_OVER_DELTAT - d) + value_dy / rho ) / (ONE_OVER_DELTAT + d)
+
+ d = dz_over_two(k)
+
+ vy_3(i,j,k) = ( vy_3(i,j,k)*(ONE_OVER_DELTAT - d) + value_dz / rho ) / (ONE_OVER_DELTAT + d)
+
+ enddo
+ enddo
+ enddo
+!$OMP END PARALLEL DO
+
+!$OMP PARALLEL DO DEFAULT(NONE) PRIVATE(i,j,k,d,value_dx,value_dy,value_dz) SHARED(vz_1,vz_2, &
+!$OMP vz_3,sigmazz_1,sigmazz_2,sigmazz_3,sigmaxz_1,sigmaxz_3,sigmayz_2,sigmayz_3,dx_half_over_two,dy_over_two,dz_half_over_two)
+do k = 1,NZ-1
+ do j = 2,NY
+ do i = 1,NX-1
+
+ value_dx = (sigmaxz_1(i+1,j,k) - sigmaxz_1(i,j,k)) / h &
+ + (sigmaxz_3(i+1,j,k) - sigmaxz_3(i,j,k)) / h
+
+ value_dy = (sigmayz_2(i,j,k) - sigmayz_2(i,j-1,k)) / h &
+ + (sigmayz_3(i,j,k) - sigmayz_3(i,j-1,k)) / h
+
+ value_dz = (sigmazz_1(i,j,k+1) - sigmazz_1(i,j,k)) / h &
+ + (sigmazz_2(i,j,k+1) - sigmazz_2(i,j,k)) / h &
+ + (sigmazz_3(i,j,k+1) - sigmazz_3(i,j,k)) / h
+
+ d = dx_half_over_two(i)
+
+ vz_1(i,j,k) = ( vz_1(i,j,k)*(ONE_OVER_DELTAT - d) + value_dx / rho ) / (ONE_OVER_DELTAT + d)
+
+ d = dy_over_two(j)
+
+ vz_2(i,j,k) = ( vz_2(i,j,k)*(ONE_OVER_DELTAT - d) + value_dy / rho ) / (ONE_OVER_DELTAT + d)
+
+ d = dz_half_over_two(k)
+
+ vz_3(i,j,k) = ( vz_3(i,j,k)*(ONE_OVER_DELTAT - d) + value_dz / rho ) / (ONE_OVER_DELTAT + d)
+
+ enddo
+ enddo
+ enddo
+!$OMP END PARALLEL DO
+
+! add the source (force vector located at a given grid point)
+ a = pi*pi*f0*f0
+ t = dble(it-1)*DELTAT
+
+! Gaussian
+! source_term = factor * exp(-a*(t-t0)**2)
+
+! first derivative of a Gaussian
+ source_term = - factor * 2.d0*a*(t-t0)*exp(-a*(t-t0)**2)
+
+! Ricker source time function (second derivative of a Gaussian)
+! source_term = factor * (1.d0 - 2.d0*a*(t-t0)**2)*exp(-a*(t-t0)**2)
+
+ force_x = sin(ANGLE_FORCE * DEGREES_TO_RADIANS) * source_term
+ force_y = cos(ANGLE_FORCE * DEGREES_TO_RADIANS) * source_term
+ force_z = 0.d0
+
+! define location of the source
+ i = ISOURCE
+ j = JSOURCE
+ k = NZ / 2
+
+! add the source to one of the two components of the split field
+ vx_1(i,j,k) = vx_1(i,j,k) + force_x * DELTAT / rho
+ vy_1(i,j,k) = vy_1(i,j,k) + force_y * DELTAT / rho
+
+! implement Dirichlet boundary conditions on the six edges of the grid
+
+!$OMP PARALLEL WORKSHARE
+! xmin
+ vx_1(1,:,:) = 0.d0
+ vy_1(1,:,:) = 0.d0
+ vz_1(1,:,:) = 0.d0
+
+ vx_2(1,:,:) = 0.d0
+ vy_2(1,:,:) = 0.d0
+ vz_2(1,:,:) = 0.d0
+
+ vx_3(1,:,:) = 0.d0
+ vy_3(1,:,:) = 0.d0
+ vz_3(1,:,:) = 0.d0
+
+! xmax
+ vx_1(NX,:,:) = 0.d0
+ vy_1(NX,:,:) = 0.d0
+ vz_1(NX,:,:) = 0.d0
+
+ vx_2(NX,:,:) = 0.d0
+ vy_2(NX,:,:) = 0.d0
+ vz_2(NX,:,:) = 0.d0
+
+ vx_3(NX,:,:) = 0.d0
+ vy_3(NX,:,:) = 0.d0
+ vz_3(NX,:,:) = 0.d0
+
+! ymin
+ vx_1(:,1,:) = 0.d0
+ vy_1(:,1,:) = 0.d0
+ vz_1(:,1,:) = 0.d0
+
+ vx_2(:,1,:) = 0.d0
+ vy_2(:,1,:) = 0.d0
+ vz_2(:,1,:) = 0.d0
+
+ vx_3(:,1,:) = 0.d0
+ vy_3(:,1,:) = 0.d0
+ vz_3(:,1,:) = 0.d0
+
+! ymax
+ vx_1(:,NY,:) = 0.d0
+ vy_1(:,NY,:) = 0.d0
+ vz_1(:,NY,:) = 0.d0
+
+ vx_2(:,NY,:) = 0.d0
+ vy_2(:,NY,:) = 0.d0
+ vz_2(:,NY,:) = 0.d0
+
+ vx_3(:,NY,:) = 0.d0
+ vy_3(:,NY,:) = 0.d0
+ vz_3(:,NY,:) = 0.d0
+
+! zmin
+ vx_1(:,:,1) = 0.d0
+ vy_1(:,:,1) = 0.d0
+ vz_1(:,:,1) = 0.d0
+
+ vx_2(:,:,1) = 0.d0
+ vy_2(:,:,1) = 0.d0
+ vz_2(:,:,1) = 0.d0
+
+ vx_3(:,:,1) = 0.d0
+ vy_3(:,:,1) = 0.d0
+ vz_3(:,:,1) = 0.d0
+
+! zmax
+ vx_1(:,:,NZ) = 0.d0
+ vy_1(:,:,NZ) = 0.d0
+ vz_1(:,:,NZ) = 0.d0
+
+ vx_2(:,:,NZ) = 0.d0
+ vy_2(:,:,NZ) = 0.d0
+ vz_2(:,:,NZ) = 0.d0
+
+ vx_3(:,:,NZ) = 0.d0
+ vy_3(:,:,NZ) = 0.d0
+ vz_3(:,:,NZ) = 0.d0
+!$OMP END PARALLEL WORKSHARE
+
+! store seismograms
+ do irec = 1,NREC
+ sisvx(it,irec) = vx_1(ix_rec(irec),iy_rec(irec),iz_rec(irec)) + &
+ vx_2(ix_rec(irec),iy_rec(irec),iz_rec(irec)) + vx_3(ix_rec(irec),iy_rec(irec),iz_rec(irec))
+ sisvy(it,irec) = vy_1(ix_rec(irec),iy_rec(irec),iz_rec(irec)) + &
+ vy_2(ix_rec(irec),iy_rec(irec),iz_rec(irec)) + vy_3(ix_rec(irec),iy_rec(irec),iz_rec(irec))
+ enddo
+
+! compute total energy in the medium (without the PML layers)
+
+ total_energy_kinetic = ZERO
+ total_energy_potential = ZERO
+
+!$OMP PARALLEL DO DEFAULT(NONE) PRIVATE(i,j,k,sigmaxx_total,sigmayy_total, &
+!$OMP sigmazz_total,sigmaxy_total,sigmaxz_total,sigmayz_total,epsilon_xx,epsilon_yy,epsilon_zz,epsilon_xy,epsilon_xz,epsilon_yz) &
+!$OMP SHARED(vx_1,vx_2,vx_3,vy_1,vy_2,vy_3,vz_1,vz_2,vz_3,sigmaxx_1,sigmaxx_2, &
+!$OMP sigmaxx_3,sigmayy_1,sigmayy_2,sigmayy_3,sigmazz_1,sigmazz_2,sigmazz_3, &
+!$OMP sigmaxy_1,sigmaxy_2,sigmaxz_1,sigmaxz_3,sigmayz_2,sigmayz_3) REDUCTION(+:total_energy_kinetic,total_energy_potential)
+ do k = NPOINTS_PML+1, NZ-NPOINTS_PML
+ do j = NPOINTS_PML+1, NY-NPOINTS_PML
+ do i = NPOINTS_PML+1, NX-NPOINTS_PML
+
+! compute kinetic energy first, defined as 1/2 rho ||v||^2
+! in principle we should use rho_half_x_half_y instead of rho for vy
+! in order to interpolate density at the right location in the staggered grid cell
+! but in a homogeneous medium we can safely ignore it
+ total_energy_kinetic = total_energy_kinetic + 0.5d0 * rho*( &
+ (vx_1(i,j,k) + vx_2(i,j,k) + vx_3(i,j,k))**2 + &
+ (vy_1(i,j,k) + vy_2(i,j,k) + vy_3(i,j,k))**2 + &
+ (vz_1(i,j,k) + vz_2(i,j,k) + vz_3(i,j,k))**2)
+
+! add potential energy, defined as 1/2 epsilon_ij sigma_ij
+! in principle we should interpolate the medium parameters at the right location
+! in the staggered grid cell but in a homogeneous medium we can safely ignore it
+
+! compute total field from split components
+ sigmaxx_total = sigmaxx_1(i,j,k) + sigmaxx_2(i,j,k) + sigmaxx_3(i,j,k)
+ sigmayy_total = sigmayy_1(i,j,k) + sigmayy_2(i,j,k) + sigmayy_3(i,j,k)
+ sigmazz_total = sigmazz_1(i,j,k) + sigmazz_2(i,j,k) + sigmazz_3(i,j,k)
+ sigmaxy_total = sigmaxy_1(i,j,k) + sigmaxy_2(i,j,k)
+ sigmaxz_total = sigmaxz_1(i,j,k) + sigmaxz_3(i,j,k)
+ sigmayz_total = sigmayz_2(i,j,k) + sigmayz_3(i,j,k)
+
+ epsilon_xx = ((lambda + 2.d0*mu) * sigmaxx_total - lambda * sigmayy_total -lambda*sigmazz_total) / (4.d0 * mu * (lambda + mu))
+ epsilon_yy = ((lambda + 2.d0*mu) * sigmayy_total - lambda * sigmaxx_total -lambda*sigmazz_total) / (4.d0 * mu * (lambda + mu))
+ epsilon_zz = ((lambda + 2.d0*mu) * sigmazz_total - lambda * sigmaxx_total -lambda*sigmayy_total) / (4.d0 * mu * (lambda + mu))
+ epsilon_xy = sigmaxy_total / (2.d0 * mu)
+ epsilon_xz = sigmaxz_total / (2.d0 * mu)
+ epsilon_yz = sigmayz_total / (2.d0 * mu)
+
+ total_energy_potential = total_energy_potential + &
+ 0.5d0 * (epsilon_xx * sigmaxx_total + epsilon_yy * sigmayy_total + &
+ epsilon_yy * sigmayy_total+ 2.d0 * epsilon_xy * sigmaxy_total + &
+ 2.d0*epsilon_xz * sigmaxz_total+2.d0*epsilon_yz * sigmayz_total)
+
+ enddo
+ enddo
+ enddo
+!$OMP END PARALLEL DO
+
+ total_energy(it) = total_energy_kinetic + total_energy_potential
+
+! output information
+ if(mod(it,IT_DISPLAY) == 0 .or. it == 5) then
+
+ Vsolidnorm = maxval(sqrt((vx_1 + vx_2 + vx_3)**2 + (vy_1 + vy_2 + vy_3)**2+(vz_1 + vz_2 + vz_3)**2))
+
+ print *,'Time step # ',it
+ print *,'Time: ',sngl((it-1)*DELTAT),' seconds'
+ print *,'Max norm velocity vector V (m/s) = ',Vsolidnorm
+ print *,'Total energy = ',total_energy(it)
+! check stability of the code, exit if unstable
+ if(Vsolidnorm > STABILITY_THRESHOLD) stop 'code became unstable and blew up'
+ iplane=1
+
+! count elapsed wall-clock time
+ call date_and_time(datein,timein,zone,time_values)
+! time_values(3): day of the month
+! time_values(5): hour of the day
+! time_values(6): minutes of the hour
+! time_values(7): seconds of the minute
+! time_values(8): milliseconds of the second
+! this fails if we cross the end of the month
+ time_end = 86400.d0*time_values(3) + 3600.d0*time_values(5) + &
+ 60.d0*time_values(6) + time_values(7) + time_values(8) / 1000.d0
+
+! elapsed time since beginning of the simulation
+ tCPU = time_end - time_start
+ int_tCPU = int(tCPU)
+ ihours = int_tCPU / 3600
+ iminutes = (int_tCPU - 3600*ihours) / 60
+ iseconds = int_tCPU - 3600*ihours - 60*iminutes
+ write(*,*) 'Elapsed time in seconds = ',tCPU
+ write(*,"(' Elapsed time in hh:mm:ss = ',i4,' h ',i2.2,' m ',i2.2,' s')") ihours,iminutes,iseconds
+ write(*,*) 'Mean elapsed time per time step in seconds = ',tCPU/dble(it)
+ write(*,*)
+
+! write time stamp file to give information about progression of simulation
+ write(outputname,"('timestamp',i6.6)") it
+ open(unit=IOUT,file=outputname,status='unknown')
+ write(IOUT,*) 'Time step # ',it
+ write(IOUT,*) 'Time: ',sngl((it-1)*DELTAT),' seconds'
+ write(IOUT,*) 'Max norm velocity vector V (m/s) = ',Vsolidnorm
+ write(IOUT,*) 'Total energy = ',total_energy(it)
+ write(IOUT,*) 'Elapsed time in seconds = ',tCPU
+ write(IOUT,"(' Elapsed time in hh:mm:ss = ',i4,' h ',i2.2,' m ',i2.2,' s')") ihours,iminutes,iseconds
+ write(IOUT,*) 'Mean elapsed time per time step in seconds = ',tCPU/dble(it)
+ close(IOUT)
+
+! save seismograms
+ print *,'saving seismograms'
+ print *
+ call write_seismograms(sisvx,sisvy,NSTEP,NREC,DELTAT)
+
+ call create_2D_image(vx_1(:,:,NZ/2) + vx_2(:,:,NZ/2) + vx_3(:,:,NZ/2),NX,NY,it,ISOURCE,JSOURCE,ix_rec,iy_rec,nrec, &
+ NPOINTS_PML,.true.,.true.,.true.,.true.,1)
+
+ call create_2D_image(vy_1(:,:,NZ/2) + vy_2(:,:,NZ/2) +vy_3(:,:,NZ/2),NX,NY,it,ISOURCE,JSOURCE,ix_rec,iy_rec,nrec, &
+ NPOINTS_PML,.true.,.true.,.true.,.true.,2)
+
+ endif
+
+ enddo ! end of time loop
+
+! save seismograms
+ call write_seismograms(sisvx,sisvy,NSTEP,NREC,DELTAT)
+
+! save total energy
+ open(unit=20,file='energy.dat',status='unknown')
+ do it = 1,NSTEP
+ write(20,*) sngl(dble(it-1)*DELTAT),total_energy(it)
+ enddo
+ close(20)
+
+! create script for Gnuplot for total energy
+ open(unit=20,file='plot_energy',status='unknown')
+ write(20,*) '# set term x11'
+ write(20,*) 'set term postscript landscape monochrome dashed "Helvetica" 22'
+ write(20,*)
+ write(20,*) 'set xlabel "Time (s)"'
+ write(20,*) 'set ylabel "Total energy"'
+ write(20,*)
+ write(20,*) 'set output "collino3D_total_energy_semilog.eps"'
+ write(20,*) 'set logscale y'
+ write(20,*) 'plot "energy.dat" t ''Total energy'' w l 1'
+ write(20,*) 'pause -1 "Hit any key..."'
+ write(20,*)
+ close(20)
+
+! create script for Gnuplot
+ open(unit=20,file='plotgnu',status='unknown')
+ write(20,*) 'set term x11'
+ write(20,*) '# set term postscript landscape monochrome dashed "Helvetica" 22'
+ write(20,*)
+ write(20,*) 'set xlabel "Time (s)"'
+ write(20,*) 'set ylabel "Amplitude (m / s)"'
+ write(20,*)
+
+ write(20,*) 'set output "v_sigma_Vx_receiver_001.eps"'
+ write(20,*) 'plot "Vx_file_001.dat" t ''Vx C-PML'' w l 1'
+ write(20,*) 'pause -1 "Hit any key..."'
+ write(20,*)
+
+ write(20,*) 'set output "v_sigma_Vy_receiver_001.eps"'
+ write(20,*) 'plot "Vy_file_001.dat" t ''Vy C-PML'' w l 1'
+ write(20,*) 'pause -1 "Hit any key..."'
+ write(20,*)
+
+ write(20,*) 'set output "v_sigma_Vz_receiver_001.eps"'
+ write(20,*) 'plot "Vz_file_001.dat" t ''Vz C-PML'' w l 1'
+ write(20,*) 'pause -1 "Hit any key..."'
+ write(20,*)
+
+ write(20,*) 'set output "v_sigma_Vx_receiver_002.eps"'
+ write(20,*) 'plot "Vx_file_002.dat" t ''Vx C-PML'' w l 1'
+ write(20,*) 'pause -1 "Hit any key..."'
+ write(20,*)
+
+ write(20,*) 'set output "v_sigma_Vy_receiver_002.eps"'
+ write(20,*) 'plot "Vy_file_002.dat" t ''Vy C-PML'' w l 1'
+ write(20,*) 'pause -1 "Hit any key..."'
+ write(20,*)
+
+ write(20,*) 'set output "v_sigma_Vz_receiver_002.eps"'
+ write(20,*) 'plot "Vz_file_002.dat" t ''Vz C-PML'' w l 1'
+ write(20,*) 'pause -1 "Hit any key..."'
+ write(20,*)
+
+ close(20)
+
+ print *
+ print *,'End of the simulation'
+ print *
+
+ end program seismic_PML_Collino_3D_iso
+
+!----
+!---- save the seismograms in ASCII text format
+!----
+
+ subroutine write_seismograms(sisvx,sisvy,nt,nrec,DELTAT)
+
+ implicit none
+
+ integer nt,nrec
+ double precision DELTAT
+
+ double precision sisvx(nt,nrec)
+ double precision sisvy(nt,nrec)
+
+ integer irec,it
+
+ character(len=100) file_name
+
+! X component
+ do irec=1,nrec
+ write(file_name,"('Vx_file_',i3.3,'.dat')") irec
+ open(unit=11,file=file_name,status='unknown')
+ do it=1,nt
+ write(11,*) sngl(dble(it-1)*DELTAT),' ',sngl(sisvx(it,irec))
+ enddo
+ close(11)
+ enddo
+
+! Y component
+ do irec=1,nrec
+ write(file_name,"('Vy_file_',i3.3,'.dat')") irec
+ open(unit=11,file=file_name,status='unknown')
+ do it=1,nt
+ write(11,*) sngl(dble(it-1)*DELTAT),' ',sngl(sisvy(it,irec))
+ enddo
+ close(11)
+ enddo
+
+ end subroutine write_seismograms
+
+!----
+!---- routine to create a color image of a given vector component
+!---- the image is created in PNM format and then converted to GIF
+!----
+
+ subroutine create_2D_image(image_data_2D,NX,NY,it,ISOURCE,JSOURCE,ix_rec,iy_rec,nrec, &
+ NPOINTS_PML,USE_PML_XMIN,USE_PML_XMAX,USE_PML_YMIN,USE_PML_YMAX,field_number)
+
+ implicit none
+
+! non linear display to enhance small amplitudes for graphics
+ double precision, parameter :: POWER_DISPLAY = 0.30d0
+
+! amplitude threshold above which we draw the color point
+ double precision, parameter :: cutvect = 0.01d0
+
+! use black or white background for points that are below the threshold
+ logical, parameter :: WHITE_BACKGROUND = .true.
+
+! size of cross and square in pixels drawn to represent the source and the receivers
+ integer, parameter :: width_cross = 5, thickness_cross = 1, size_square = 3
+
+ integer NX,NY,it,field_number,ISOURCE,JSOURCE,NPOINTS_PML,nrec
+ logical USE_PML_XMIN,USE_PML_XMAX,USE_PML_YMIN,USE_PML_YMAX
+
+ double precision, dimension(NX,NY) :: image_data_2D
+
+ integer, dimension(nrec) :: ix_rec,iy_rec
+
+ integer :: ix,iy,irec
+
+ character(len=100) :: file_name,system_command
+
+ integer :: R, G, B
+
+ double precision :: normalized_value,max_amplitude
+
+! open image file and create system command to convert image to more convenient format
+ if(field_number == 1) then
+ write(file_name,"('image',i6.6,'_Vx.pnm')") it
+ write(system_command,"('convert image',i6.6,'_Vx.pnm image',i6.6,'_Vx.gif ; rm image',i6.6,'_Vx.pnm')") it,it,it
+ else if(field_number == 2) then
+ write(file_name,"('image',i6.6,'_Vy.pnm')") it
+ write(system_command,"('convert image',i6.6,'_Vy.pnm image',i6.6,'_Vy.gif ; rm image',i6.6,'_Vy.pnm')") it,it,it
+ endif
+
+ open(unit=27, file=file_name, status='unknown')
+
+ write(27,"('P3')") ! write image in PNM P3 format
+
+ write(27,*) NX,NY ! write image size
+ write(27,*) '255' ! maximum value of each pixel color
+
+! compute maximum amplitude
+ max_amplitude = maxval(abs(image_data_2D))
+
+! image starts in upper-left corner in PNM format
+ do iy=NY,1,-1
+ do ix=1,NX
+
+! define data as vector component normalized to [-1:1] and rounded to nearest integer
+! keeping in mind that amplitude can be negative
+ normalized_value = image_data_2D(ix,iy) / max_amplitude
+
+! suppress values that are outside [-1:+1] to avoid small edge effects
+ if(normalized_value < -1.d0) normalized_value = -1.d0
+ if(normalized_value > 1.d0) normalized_value = 1.d0
+
+! draw an orange cross to represent the source
+ if((ix >= ISOURCE - width_cross .and. ix <= ISOURCE + width_cross .and. &
+ iy >= JSOURCE - thickness_cross .and. iy <= JSOURCE + thickness_cross) .or. &
+ (ix >= ISOURCE - thickness_cross .and. ix <= ISOURCE + thickness_cross .and. &
+ iy >= JSOURCE - width_cross .and. iy <= JSOURCE + width_cross)) then
+ R = 255
+ G = 157
+ B = 0
+
+! display two-pixel-thick black frame around the image
+ else if(ix <= 2 .or. ix >= NX-1 .or. iy <= 2 .or. iy >= NY-1) then
+ R = 0
+ G = 0
+ B = 0
+
+! display edges of the PML layers
+ else if((USE_PML_XMIN .and. ix == NPOINTS_PML) .or. &
+ (USE_PML_XMAX .and. ix == NX - NPOINTS_PML) .or. &
+ (USE_PML_YMIN .and. iy == NPOINTS_PML) .or. &
+ (USE_PML_YMAX .and. iy == NY - NPOINTS_PML)) then
+ R = 255
+ G = 150
+ B = 0
+
+! suppress all the values that are below the threshold
+ else if(abs(image_data_2D(ix,iy)) <= max_amplitude * cutvect) then
+
+! use a black or white background for points that are below the threshold
+ if(WHITE_BACKGROUND) then
+ R = 255
+ G = 255
+ B = 255
+ else
+ R = 0
+ G = 0
+ B = 0
+ endif
+
+! represent regular image points using red if value is positive, blue if negative
+ else if(normalized_value >= 0.d0) then
+ R = nint(255.d0*normalized_value**POWER_DISPLAY)
+ G = 0
+ B = 0
+ else
+ R = 0
+ G = 0
+ B = nint(255.d0*abs(normalized_value)**POWER_DISPLAY)
+ endif
+
+! draw a green square to represent the receivers
+ do irec = 1,nrec
+ if((ix >= ix_rec(irec) - size_square .and. ix <= ix_rec(irec) + size_square .and. &
+ iy >= iy_rec(irec) - size_square .and. iy <= iy_rec(irec) + size_square) .or. &
+ (ix >= ix_rec(irec) - size_square .and. ix <= ix_rec(irec) + size_square .and. &
+ iy >= iy_rec(irec) - size_square .and. iy <= iy_rec(irec) + size_square)) then
+! use dark green color
+ R = 30
+ G = 180
+ B = 60
+ endif
+ enddo
+
+! write color pixel
+ write(27,"(i3,' ',i3,' ',i3)") R,G,B
+
+ enddo
+ enddo
+
+! close file
+ close(27)
+
+! call the system to convert image to GIF (can be commented out if "call system" is missing in your compiler)
+! call system(system_command)
+
+ end subroutine create_2D_image
+
+!
+! CeCILL FREE SOFTWARE LICENSE AGREEMENT
+!
+! Notice
+!
+! This Agreement is a Free Software license agreement that is the result
+! of discussions between its authors in order to ensure compliance with
+! the two main principles guiding its drafting:
+!
+! * firstly, compliance with the principles governing the distribution
+! of Free Software: access to source code, broad rights granted to
+! users,
+! * secondly, the election of a governing law, French law, with which
+! it is conformant, both as regards the law of torts and
+! intellectual property law, and the protection that it offers to
+! both authors and holders of the economic rights over software.
+!
+! The authors of the CeCILL (for Ce[a] C[nrs] I[nria] L[ogiciel] L[ibre])
+! license are:
+!
+! Commissariat a l'Energie Atomique - CEA, a public scientific, technical
+! and industrial research establishment, having its principal place of
+! business at 25 rue Leblanc, immeuble Le Ponant D, 75015 Paris, France.
+!
+! Centre National de la Recherche Scientifique - CNRS, a public scientific
+! and technological establishment, having its principal place of business
+! at 3 rue Michel-Ange, 75794 Paris cedex 16, France.
+!
+! Institut National de Recherche en Informatique et en Automatique -
+! INRIA, a public scientific and technological establishment, having its
+! principal place of business at Domaine de Voluceau, Rocquencourt, BP
+! 105, 78153 Le Chesnay cedex, France.
+!
+! Preamble
+!
+! The purpose of this Free Software license agreement is to grant users
+! the right to modify and redistribute the software governed by this
+! license within the framework of an open source distribution model.
+!
+! The exercising of these rights is conditional upon certain obligations
+! for users so as to preserve this status for all subsequent redistributions.
+!
+! In consideration of access to the source code and the rights to copy,
+! modify and redistribute granted by the license, users are provided only
+! with a limited warranty and the software's author, the holder of the
+! economic rights, and the successive licensors only have limited liability.
+!
+! In this respect, the risks associated with loading, using, modifying
+! and/or developing or reproducing the software by the user are brought to
+! the user's attention, given its Free Software status, which may make it
+! complicated to use, with the result that its use is reserved for
+! developers and experienced professionals having in-depth computer
+! knowledge. Users are therefore encouraged to load and test the
+! suitability of the software as regards their requirements in conditions
+! enabling the security of their systems and/or data to be ensured and,
+! more generally, to use and operate it in the same conditions of
+! security. This Agreement may be freely reproduced and published,
+! provided it is not altered, and that no provisions are either added or
+! removed herefrom.
+!
+! This Agreement may apply to any or all software for which the holder of
+! the economic rights decides to submit the use thereof to its provisions.
+!
+! Article 1 - DEFINITIONS
+!
+! For the purpose of this Agreement, when the following expressions
+! commence with a capital letter, they shall have the following meaning:
+!
+! Agreement: means this license agreement, and its possible subsequent
+! versions and annexes.
+!
+! Software: means the software in its Object Code and/or Source Code form
+! and, where applicable, its documentation, "as is" when the Licensee
+! accepts the Agreement.
+!
+! Initial Software: means the Software in its Source Code and possibly its
+! Object Code form and, where applicable, its documentation, "as is" when
+! it is first distributed under the terms and conditions of the Agreement.
+!
+! Modified Software: means the Software modified by at least one
+! Contribution.
+!
+! Source Code: means all the Software's instructions and program lines to
+! which access is required so as to modify the Software.
+!
+! Object Code: means the binary files originating from the compilation of
+! the Source Code.
+!
+! Holder: means the holder(s) of the economic rights over the Initial
+! Software.
+!
+! Licensee: means the Software user(s) having accepted the Agreement.
+!
+! Contributor: means a Licensee having made at least one Contribution.
+!
+! Licensor: means the Holder, or any other individual or legal entity, who
+! distributes the Software under the Agreement.
+!
+! Contribution: means any or all modifications, corrections, translations,
+! adaptations and/or new functions integrated into the Software by any or
+! all Contributors, as well as any or all Internal Modules.
+!
+! Module: means a set of sources files including their documentation that
+! enables supplementary functions or services in addition to those offered
+! by the Software.
+!
+! External Module: means any or all Modules, not derived from the
+! Software, so that this Module and the Software run in separate address
+! spaces, with one calling the other when they are run.
+!
+! Internal Module: means any or all Module, connected to the Software so
+! that they both execute in the same address space.
+!
+! GNU GPL: means the GNU General Public License version 2 or any
+! subsequent version, as published by the Free Software Foundation Inc.
+!
+! Parties: mean both the Licensee and the Licensor.
+!
+! These expressions may be used both in singular and plural form.
+!
+! Article 2 - PURPOSE
+!
+! The purpose of the Agreement is the grant by the Licensor to the
+! Licensee of a non-exclusive, transferable and worldwide license for the
+! Software as set forth in Article 5 hereinafter for the whole term of the
+! protection granted by the rights over said Software.
+!
+! Article 3 - ACCEPTANCE
+!
+! 3.1 The Licensee shall be deemed as having accepted the terms and
+! conditions of this Agreement upon the occurrence of the first of the
+! following events:
+!
+! * (i) loading the Software by any or all means, notably, by
+! downloading from a remote server, or by loading from a physical
+! medium;
+! * (ii) the first time the Licensee exercises any of the rights
+! granted hereunder.
+!
+! 3.2 One copy of the Agreement, containing a notice relating to the
+! characteristics of the Software, to the limited warranty, and to the
+! fact that its use is restricted to experienced users has been provided
+! to the Licensee prior to its acceptance as set forth in Article 3.1
+! hereinabove, and the Licensee hereby acknowledges that it has read and
+! understood it.
+!
+! Article 4 - EFFECTIVE DATE AND TERM
+!
+! 4.1 EFFECTIVE DATE
+!
+! The Agreement shall become effective on the date when it is accepted by
+! the Licensee as set forth in Article 3.1.
+!
+! 4.2 TERM
+!
+! The Agreement shall remain in force for the entire legal term of
+! protection of the economic rights over the Software.
+!
+! Article 5 - SCOPE OF RIGHTS GRANTED
+!
+! The Licensor hereby grants to the Licensee, who accepts, the following
+! rights over the Software for any or all use, and for the term of the
+! Agreement, on the basis of the terms and conditions set forth hereinafter.
+!
+! Besides, if the Licensor owns or comes to own one or more patents
+! protecting all or part of the functions of the Software or of its
+! components, the Licensor undertakes not to enforce the rights granted by
+! these patents against successive Licensees using, exploiting or
+! modifying the Software. If these patents are transferred, the Licensor
+! undertakes to have the transferees subscribe to the obligations set
+! forth in this paragraph.
+!
+! 5.1 RIGHT OF USE
+!
+! The Licensee is authorized to use the Software, without any limitation
+! as to its fields of application, with it being hereinafter specified
+! that this comprises:
+!
+! 1. permanent or temporary reproduction of all or part of the Software
+! by any or all means and in any or all form.
+!
+! 2. loading, displaying, running, or storing the Software on any or
+! all medium.
+!
+! 3. entitlement to observe, study or test its operation so as to
+! determine the ideas and principles behind any or all constituent
+! elements of said Software. This shall apply when the Licensee
+! carries out any or all loading, displaying, running, transmission
+! or storage operation as regards the Software, that it is entitled
+! to carry out hereunder.
+!
+! 5.2 ENTITLEMENT TO MAKE CONTRIBUTIONS
+!
+! The right to make Contributions includes the right to translate, adapt,
+! arrange, or make any or all modifications to the Software, and the right
+! to reproduce the resulting software.
+!
+! The Licensee is authorized to make any or all Contributions to the
+! Software provided that it includes an explicit notice that it is the
+! author of said Contribution and indicates the date of the creation thereof.
+!
+! 5.3 RIGHT OF DISTRIBUTION
+!
+! In particular, the right of distribution includes the right to publish,
+! transmit and communicate the Software to the general public on any or
+! all medium, and by any or all means, and the right to market, either in
+! consideration of a fee, or free of charge, one or more copies of the
+! Software by any means.
+!
+! The Licensee is further authorized to distribute copies of the modified
+! or unmodified Software to third parties according to the terms and
+! conditions set forth hereinafter.
+!
+! 5.3.1 DISTRIBUTION OF SOFTWARE WITHOUT MODIFICATION
+!
+! The Licensee is authorized to distribute true copies of the Software in
+! Source Code or Object Code form, provided that said distribution
+! complies with all the provisions of the Agreement and is accompanied by:
+!
+! 1. a copy of the Agreement,
+!
+! 2. a notice relating to the limitation of both the Licensor's
+! warranty and liability as set forth in Articles 8 and 9,
+!
+! and that, in the event that only the Object Code of the Software is
+! redistributed, the Licensee allows future Licensees unhindered access to
+! the full Source Code of the Software by indicating how to access it, it
+! being understood that the additional cost of acquiring the Source Code
+! shall not exceed the cost of transferring the data.
+!
+! 5.3.2 DISTRIBUTION OF MODIFIED SOFTWARE
+!
+! When the Licensee makes a Contribution to the Software, the terms and
+! conditions for the distribution of the resulting Modified Software
+! become subject to all the provisions of this Agreement.
+!
+! The Licensee is authorized to distribute the Modified Software, in
+! source code or object code form, provided that said distribution
+! complies with all the provisions of the Agreement and is accompanied by:
+!
+! 1. a copy of the Agreement,
+!
+! 2. a notice relating to the limitation of both the Licensor's
+! warranty and liability as set forth in Articles 8 and 9,
+!
+! and that, in the event that only the object code of the Modified
+! Software is redistributed, the Licensee allows future Licensees
+! unhindered access to the full source code of the Modified Software by
+! indicating how to access it, it being understood that the additional
+! cost of acquiring the source code shall not exceed the cost of
+! transferring the data.
+!
+! 5.3.3 DISTRIBUTION OF EXTERNAL MODULES
+!
+! When the Licensee has developed an External Module, the terms and
+! conditions of this Agreement do not apply to said External Module, that
+! may be distributed under a separate license agreement.
+!
+! 5.3.4 COMPATIBILITY WITH THE GNU GPL
+!
+! The Licensee can include a code that is subject to the provisions of one
+! of the versions of the GNU GPL in the Modified or unmodified Software,
+! and distribute that entire code under the terms of the same version of
+! the GNU GPL.
+!
+! The Licensee can include the Modified or unmodified Software in a code
+! that is subject to the provisions of one of the versions of the GNU GPL,
+! and distribute that entire code under the terms of the same version of
+! the GNU GPL.
+!
+! Article 6 - INTELLECTUAL PROPERTY
+!
+! 6.1 OVER THE INITIAL SOFTWARE
+!
+! The Holder owns the economic rights over the Initial Software. Any or
+! all use of the Initial Software is subject to compliance with the terms
+! and conditions under which the Holder has elected to distribute its work
+! and no one shall be entitled to modify the terms and conditions for the
+! distribution of said Initial Software.
+!
+! The Holder undertakes that the Initial Software will remain ruled at
+! least by this Agreement, for the duration set forth in Article 4.2.
+!
+! 6.2 OVER THE CONTRIBUTIONS
+!
+! The Licensee who develops a Contribution is the owner of the
+! intellectual property rights over this Contribution as defined by
+! applicable law.
+!
+! 6.3 OVER THE EXTERNAL MODULES
+!
+! The Licensee who develops an External Module is the owner of the
+! intellectual property rights over this External Module as defined by
+! applicable law and is free to choose the type of agreement that shall
+! govern its distribution.
+!
+! 6.4 JOINT PROVISIONS
+!
+! The Licensee expressly undertakes:
+!
+! 1. not to remove, or modify, in any manner, the intellectual property
+! notices attached to the Software;
+!
+! 2. to reproduce said notices, in an identical manner, in the copies
+! of the Software modified or not.
+!
+! The Licensee undertakes not to directly or indirectly infringe the
+! intellectual property rights of the Holder and/or Contributors on the
+! Software and to take, where applicable, vis-a-vis its staff, any and all
+! measures required to ensure respect of said intellectual property rights
+! of the Holder and/or Contributors.
+!
+! Article 7 - RELATED SERVICES
+!
+! 7.1 Under no circumstances shall the Agreement oblige the Licensor to
+! provide technical assistance or maintenance services for the Software.
+!
+! However, the Licensor is entitled to offer this type of services. The
+! terms and conditions of such technical assistance, and/or such
+! maintenance, shall be set forth in a separate instrument. Only the
+! Licensor offering said maintenance and/or technical assistance services
+! shall incur liability therefor.
+!
+! 7.2 Similarly, any Licensor is entitled to offer to its licensees, under
+! its sole responsibility, a warranty, that shall only be binding upon
+! itself, for the redistribution of the Software and/or the Modified
+! Software, under terms and conditions that it is free to decide. Said
+! warranty, and the financial terms and conditions of its application,
+! shall be subject of a separate instrument executed between the Licensor
+! and the Licensee.
+!
+! Article 8 - LIABILITY
+!
+! 8.1 Subject to the provisions of Article 8.2, the Licensee shall be
+! entitled to claim compensation for any direct loss it may have suffered
+! from the Software as a result of a fault on the part of the relevant
+! Licensor, subject to providing evidence thereof.
+!
+! 8.2 The Licensor's liability is limited to the commitments made under
+! this Agreement and shall not be incurred as a result of in particular:
+! (i) loss due the Licensee's total or partial failure to fulfill its
+! obligations, (ii) direct or consequential loss that is suffered by the
+! Licensee due to the use or performance of the Software, and (iii) more
+! generally, any consequential loss. In particular the Parties expressly
+! agree that any or all pecuniary or business loss (i.e. loss of data,
+! loss of profits, operating loss, loss of customers or orders,
+! opportunity cost, any disturbance to business activities) or any or all
+! legal proceedings instituted against the Licensee by a third party,
+! shall constitute consequential loss and shall not provide entitlement to
+! any or all compensation from the Licensor.
+!
+! Article 9 - WARRANTY
+!
+! 9.1 The Licensee acknowledges that the scientific and technical
+! state-of-the-art when the Software was distributed did not enable all
+! possible uses to be tested and verified, nor for the presence of
+! possible defects to be detected. In this respect, the Licensee's
+! attention has been drawn to the risks associated with loading, using,
+! modifying and/or developing and reproducing the Software which are
+! reserved for experienced users.
+!
+! The Licensee shall be responsible for verifying, by any or all means,
+! the suitability of the product for its requirements, its good working
+! order, and for ensuring that it shall not cause damage to either persons
+! or properties.
+!
+! 9.2 The Licensor hereby represents, in good faith, that it is entitled
+! to grant all the rights over the Software (including in particular the
+! rights set forth in Article 5).
+!
+! 9.3 The Licensee acknowledges that the Software is supplied "as is" by
+! the Licensor without any other express or tacit warranty, other than
+! that provided for in Article 9.2 and, in particular, without any warranty
+! as to its commercial value, its secured, safe, innovative or relevant
+! nature.
+!
+! Specifically, the Licensor does not warrant that the Software is free
+! from any error, that it will operate without interruption, that it will
+! be compatible with the Licensee's own equipment and software
+! configuration, nor that it will meet the Licensee's requirements.
+!
+! 9.4 The Licensor does not either expressly or tacitly warrant that the
+! Software does not infringe any third party intellectual property right
+! relating to a patent, software or any other property right. Therefore,
+! the Licensor disclaims any and all liability towards the Licensee
+! arising out of any or all proceedings for infringement that may be
+! instituted in respect of the use, modification and redistribution of the
+! Software. Nevertheless, should such proceedings be instituted against
+! the Licensee, the Licensor shall provide it with technical and legal
+! assistance for its defense. Such technical and legal assistance shall be
+! decided on a case-by-case basis between the relevant Licensor and the
+! Licensee pursuant to a memorandum of understanding. The Licensor
+! disclaims any and all liability as regards the Licensee's use of the
+! name of the Software. No warranty is given as regards the existence of
+! prior rights over the name of the Software or as regards the existence
+! of a trademark.
+!
+! Article 10 - TERMINATION
+!
+! 10.1 In the event of a breach by the Licensee of its obligations
+! hereunder, the Licensor may automatically terminate this Agreement
+! thirty (30) days after notice has been sent to the Licensee and has
+! remained ineffective.
+!
+! 10.2 A Licensee whose Agreement is terminated shall no longer be
+! authorized to use, modify or distribute the Software. However, any
+! licenses that it may have granted prior to termination of the Agreement
+! shall remain valid subject to their having been granted in compliance
+! with the terms and conditions hereof.
+!
+! Article 11 - MISCELLANEOUS
+!
+! 11.1 EXCUSABLE EVENTS
+!
+! Neither Party shall be liable for any or all delay, or failure to
+! perform the Agreement, that may be attributable to an event of force
+! majeure, an act of God or an outside cause, such as defective
+! functioning or interruptions of the electricity or telecommunications
+! networks, network paralysis following a virus attack, intervention by
+! government authorities, natural disasters, water damage, earthquakes,
+! fire, explosions, strikes and labor unrest, war, etc.
+!
+! 11.2 Any failure by either Party, on one or more occasions, to invoke
+! one or more of the provisions hereof, shall under no circumstances be
+! interpreted as being a waiver by the interested Party of its right to
+! invoke said provision(s) subsequently.
+!
+! 11.3 The Agreement cancels and replaces any or all previous agreements,
+! whether written or oral, between the Parties and having the same
+! purpose, and constitutes the entirety of the agreement between said
+! Parties concerning said purpose. No supplement or modification to the
+! terms and conditions hereof shall be effective as between the Parties
+! unless it is made in writing and signed by their duly authorized
+! representatives.
+!
+! 11.4 In the event that one or more of the provisions hereof were to
+! conflict with a current or future applicable act or legislative text,
+! said act or legislative text shall prevail, and the Parties shall make
+! the necessary amendments so as to comply with said act or legislative
+! text. All other provisions shall remain effective. Similarly, invalidity
+! of a provision of the Agreement, for any reason whatsoever, shall not
+! cause the Agreement as a whole to be invalid.
+!
+! 11.5 LANGUAGE
+!
+! The Agreement is drafted in both French and English and both versions
+! are deemed authentic.
+!
+! Article 12 - NEW VERSIONS OF THE AGREEMENT
+!
+! 12.1 Any person is authorized to duplicate and distribute copies of this
+! Agreement.
+!
+! 12.2 So as to ensure coherence, the wording of this Agreement is
+! protected and may only be modified by the authors of the License, who
+! reserve the right to periodically publish updates or new versions of the
+! Agreement, each with a separate number. These subsequent versions may
+! address new issues encountered by Free Software.
+!
+! 12.3 Any Software distributed under a given version of the Agreement may
+! only be subsequently distributed under the same version of the Agreement
+! or a subsequent version, subject to the provisions of Article 5.3.4.
+!
+! Article 13 - GOVERNING LAW AND JURISDICTION
+!
+! 13.1 The Agreement is governed by French law. The Parties agree to
+! endeavor to seek an amicable solution to any disagreements or disputes
+! that may arise during the performance of the Agreement.
+!
+! 13.2 Failing an amicable solution within two (2) months as from their
+! occurrence, and unless emergency proceedings are necessary, the
+! disagreements or disputes shall be referred to the Paris Courts having
+! jurisdiction, by the more diligent Party.
+!
+! Version 2.0 dated 2006-09-05.
+!
More information about the CIG-COMMITS
mailing list