[cig-commits] r18287 - in seismo/2D/SPECFEM2D/trunk: . EXAMPLES/Tape2007_kernel EXAMPLES/Tromp2005 EXAMPLES/Tromp2005_kernel UTILS/visualization doc/USER_MANUAL setup src/meshfem2D src/shared src/specfem2D
danielpeter at geodynamics.org
danielpeter at geodynamics.org
Sat Apr 23 21:34:10 PDT 2011
Author: danielpeter
Date: 2011-04-23 21:34:10 -0700 (Sat, 23 Apr 2011)
New Revision: 18287
Added:
seismo/2D/SPECFEM2D/trunk/setup/precision.h.in
seismo/2D/SPECFEM2D/trunk/src/shared/param_reader.c
Removed:
seismo/2D/SPECFEM2D/trunk/setup/precision_mpi.h.in
Modified:
seismo/2D/SPECFEM2D/trunk/EXAMPLES/Tape2007_kernel/adj_seismogram_Tape2007.f90
seismo/2D/SPECFEM2D/trunk/EXAMPLES/Tromp2005/README
seismo/2D/SPECFEM2D/trunk/EXAMPLES/Tromp2005_kernel/adj_seismogram_Tromp2005.f90
seismo/2D/SPECFEM2D/trunk/UTILS/visualization/plot_wavefield.pl
seismo/2D/SPECFEM2D/trunk/configure
seismo/2D/SPECFEM2D/trunk/configure.ac
seismo/2D/SPECFEM2D/trunk/doc/USER_MANUAL/manual_SPECFEM2D.tex
seismo/2D/SPECFEM2D/trunk/setup/config.h.in
seismo/2D/SPECFEM2D/trunk/setup/constants.h.in
seismo/2D/SPECFEM2D/trunk/src/meshfem2D/Makefile.in
seismo/2D/SPECFEM2D/trunk/src/meshfem2D/meshfem2D.F90
seismo/2D/SPECFEM2D/trunk/src/meshfem2D/read_materials.f90
seismo/2D/SPECFEM2D/trunk/src/meshfem2D/read_parameter_file.F90
seismo/2D/SPECFEM2D/trunk/src/meshfem2D/read_regions.f90
seismo/2D/SPECFEM2D/trunk/src/shared/adj_seismogram.f90
seismo/2D/SPECFEM2D/trunk/src/shared/check_quality_external_mesh.f90
seismo/2D/SPECFEM2D/trunk/src/shared/read_value_parameters.f90
seismo/2D/SPECFEM2D/trunk/src/specfem2D/Makefile.in
seismo/2D/SPECFEM2D/trunk/src/specfem2D/assemble_MPI.F90
seismo/2D/SPECFEM2D/trunk/src/specfem2D/compute_arrays_source.f90
seismo/2D/SPECFEM2D/trunk/src/specfem2D/specfem2D.F90
seismo/2D/SPECFEM2D/trunk/src/specfem2D/write_seismograms.F90
Log:
renames precision_mpi.h to precision.h; renames seismogram band codes from BHX/BHY/BHZ to BXX/BXY/BXZ; renames kernel file names to e.g. proc000000_rho_kappa_mu_kernel.dat; adds param_reader.c to handle more flexible parameter file formats
Modified: seismo/2D/SPECFEM2D/trunk/EXAMPLES/Tape2007_kernel/adj_seismogram_Tape2007.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/EXAMPLES/Tape2007_kernel/adj_seismogram_Tape2007.f90 2011-04-23 01:23:54 UTC (rev 18286)
+++ seismo/2D/SPECFEM2D/trunk/EXAMPLES/Tape2007_kernel/adj_seismogram_Tape2007.f90 2011-04-24 04:34:10 UTC (rev 18287)
@@ -66,13 +66,13 @@
character(len=150) :: filename
NDIM=3
- comp = (/"BHX","BHY","BHZ"/)
+ comp = (/"BXX","BXY","BXZ"/)
! number of components
!NDIMr=2 ! P-SV
NDIMr=1 ! SH (membrane)
- !compr = (/"BHX","BHZ"/) ! P-SV
- compr = (/"BHY","tmp"/) ! SH (membrane)
+ !compr = (/"BXX","BXZ"/) ! P-SV
+ compr = (/"BXY","tmp"/) ! SH (membrane)
! list of stations
station_name(1) = 'S0001'
@@ -170,7 +170,7 @@
enddo
print*,'*************************'
- print*,'The input files (S****.AA.BHX/BHY/BHZ.adj) needed to run the adjoint simulation are in SEM'
+ print*,'The input files (S****.AA.BXX/BXY/BXZ.adj) needed to run the adjoint simulation are in SEM'
print*,'*************************'
end program adj_seismogram
Modified: seismo/2D/SPECFEM2D/trunk/EXAMPLES/Tromp2005/README
===================================================================
--- seismo/2D/SPECFEM2D/trunk/EXAMPLES/Tromp2005/README 2011-04-23 01:23:54 UTC (rev 18286)
+++ seismo/2D/SPECFEM2D/trunk/EXAMPLES/Tromp2005/README 2011-04-24 04:34:10 UTC (rev 18287)
@@ -18,7 +18,7 @@
0. Read the user manual in SPECFEM2D/doc/manual_SPECFEM2D.pdf
-1. in SPECFEM2D root directory, configure, e.g.,
+1. in SPECFEM2D root directory, configure, e.g.,
./configure FC=gfortran
2. modify constants.h file, setting USER_TO = 8.0 s
@@ -33,21 +33,21 @@
6. check out the output files in the local directory OUTPUT_FILES
- The seismograms (S0001.AA.BHX.semd,S0001.AA.BHZ.semd) will be similar to those in Tromp2005, Figure 7b, but with an 8-second time shift due to the difference in origin time convention.
+ The seismograms (S0001.AA.BXX.semd,S0001.AA.BXZ.semd) will be similar to those in Tromp2005, Figure 7b, but with an 8-second time shift due to the difference in origin time convention.
optional: try plotting the wavefield using the script
SPECFEM2D/UTILS/visualization/plot_wavefield.pl
7. mv OUTPUT_FILES OUTPUT_FILES_PSV
-8. set p_sv = .false. in Par_file_Tromp2005
+8. set p_sv = .false. in Par_file_Tromp2005
9. execute script to run mesher and solver for the SH case:
./process.sh
10. check out the output files in the local directory OUTPUT_FILES
- The seismogram (S0001.AA.BHY.semd) will be similar to those in Tromp2005, Figure 2b, but with an 8-second time shift due to the difference in origin time convention.
+ The seismogram (S0001.AA.BXY.semd) will be similar to those in Tromp2005, Figure 2b, but with an 8-second time shift due to the difference in origin time convention.
optional: try plotting the wavefield using the script
SPECFEM2D/UTILS/visualization/plot_wavefield.pl
Modified: seismo/2D/SPECFEM2D/trunk/EXAMPLES/Tromp2005_kernel/adj_seismogram_Tromp2005.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/EXAMPLES/Tromp2005_kernel/adj_seismogram_Tromp2005.f90 2011-04-23 01:23:54 UTC (rev 18286)
+++ seismo/2D/SPECFEM2D/trunk/EXAMPLES/Tromp2005_kernel/adj_seismogram_Tromp2005.f90 2011-04-24 04:34:10 UTC (rev 18287)
@@ -66,13 +66,13 @@
character(len=150) :: filename
NDIM=3
- comp = (/"BHX","BHY","BHZ"/)
+ comp = (/"BXX","BXY","BXZ"/)
! number of components
NDIMr=2 ! P-SV
!NDIMr=1 ! SH (membrane)
- compr = (/"BHX","BHZ"/) ! P-SV
- !compr = (/"BHY","tmp"/) ! SH (membrane)
+ compr = (/"BXX","BXZ"/) ! P-SV
+ !compr = (/"BXY","tmp"/) ! SH (membrane)
! list of stations
station_name(1) = 'S0001'
@@ -170,7 +170,7 @@
enddo
print*,'*************************'
- print*,'The input files (S****.AA.BHX/BHY/BHZ.adj) needed to run the adjoint simulation are in SEM'
+ print*,'The input files (S****.AA.BXX/BXY/BXZ.adj) needed to run the adjoint simulation are in SEM'
print*,'*************************'
end program adj_seismogram
Modified: seismo/2D/SPECFEM2D/trunk/UTILS/visualization/plot_wavefield.pl
===================================================================
--- seismo/2D/SPECFEM2D/trunk/UTILS/visualization/plot_wavefield.pl 2011-04-23 01:23:54 UTC (rev 18286)
+++ seismo/2D/SPECFEM2D/trunk/UTILS/visualization/plot_wavefield.pl 2011-04-24 04:34:10 UTC (rev 18287)
@@ -39,7 +39,7 @@
@cmax = split("/",$ctemp); # CMAX : decrease for more contrast
($t0,$dt) = split("/",$tinc);
($ipx,$ipy,$ipz,$ipsv,$itype) = split("/",$ipar1); # itype =0 (kernel), =1 (forward wavefield), (=2) adjoint wavefield
-($xwid,$iportrait,$irecsurf) = split("/",$ipar2);
+($xwid,$iportrait,$irecsurf) = split("/",$ipar2);
($igrd,$imask,$msize,$xpix) = split("/",$ipar3);
#@frames = split("/",$ftemp);
@@ -104,7 +104,7 @@
if($iportrait==1) {$orient = "-P";} else {$orient = "";}
$ncol = $ipx + $ipy + $ipz;
- print "$ncol (ncol) to display: $ipx (X), $ipy (Y), $ipz (Z)\n";
+ print "$ncol (ncol) to display: $ipx (X), $ipy (Y), $ipz (Z)\n";
if($ncol==0) {die("Must specify at least one component to display");}
if($ncol==1 && $ipx==1) {@comps = (1);}
if($ncol==1 && $ipy==1) {@comps = (2);}
@@ -113,7 +113,7 @@
if($ncol==2 && $ipy==0) {@comps = (1,3);}
if($ncol==2 && $ipz==0) {@comps = (1,2);}
if($ncol==3) {@comps = (1,2,3);}
- print "$ncol (ncol) to display: $ipx (X), $ipy (Y), $ipz (Z)\n";
+ print "$ncol (ncol) to display: $ipx (X), $ipy (Y), $ipz (Z)\n";
print "comps: @comps\n";
#die("TESTING");
@@ -158,7 +158,7 @@
# -N or not
$rec = "-W1p $rfill -Si10p -D${rdx}p/${rdy}p";
-$rec2 = "-W1p,0/255/255 $rfill -Si10p -D${rdx}p/${rdy}p";
+$rec2 = "-W1p,0/255/255 $rfill -Si10p -D${rdx}p/${rdy}p";
$textrec = "-D${tdx}p/${tdy}p -W255 -C1p -N";
# source and receivers
@@ -275,7 +275,7 @@
$time = sprintf("%.3f",$t0 + $j1*$dt);
#$time = sprintf("%.0f",$j1); # snapshot
#print "\n--time,t0,j1,i -- $time, $t0, $j1, $i--\n";
-
+
$snapshot_f = "${idir1}/$wavefield[0]${snap1}_${stitype}_000.txt"; # 000 assumes one processor only
#if($igrd==1) {$snapshot_f = "${idir1}/$wavefield[0]${snap1}_${stitype}_pixel.txt";}
@@ -288,7 +288,7 @@
print CSH "echo $psfile\n";
print CSH "echo $snapshot_f\n";
-
+
$B0 = sprintf("-Ba${btick1x}f${btick2x}/a${btick1z}f${btick2z}:\"t = $time s\"::.\" \"");
$B = "$B0:Wsne";
$B_row1 = "$B0:WSne";
@@ -410,8 +410,8 @@
#$ztext = $zmin+0.5*$zran;
#$tstr = "t = $time s";
#print CSH "pstext -N $J $R -K -O -V >>$psfile<<EOF\n $xtext $ztext $fsize1 90 $fontno CM $tstr\nEOF\n";
-
- #$xtx = $xmin+0.5*$xran; $ztx = $zmin+1.1*$zran;
+
+ #$xtx = $xmin+0.5*$xran; $ztx = $zmin+1.1*$zran;
#if ($i == $imax) {print CSH "pstext -N $J $R -K -O -V >>$psfile<<EOF\n $xtx $ztx $fsize1 0 $fontno CM $titles[$k]\nEOF\n";}
#-------------------------
@@ -487,11 +487,11 @@
if ($iktype==1) {
@titles = ("K$sik-\@~r\@","K$sik-\@~k\@","K$sik-\@~m\@");
@ytitles = ("Krho","Kkappa","Kmu");
- $kfile1 = "${idir1}/snapshot_rho_kappa_mu_000000";
+ $kfile1 = "${idir1}/proc000000_rho_kappa_mu_kernel.dat";
} else {
@titles = ("K$sik-\@~r\@","K$sik-Vp","K$sik-Vs");
@ytitles = ("Krho","Kalpha","Kbeta");
- $kfile1 = "${idir1}/snapshot_rhop_alpha_beta_000000";
+ $kfile1 = "${idir1}/proc000000_rhop_alpha_beta_kernel.dat";
}
#@ytitles = (" "," "," ");
@wavefield = ("wavefield","wavefield","wavefield");
@@ -521,7 +521,7 @@
print CSH "echo $kfile\n";
print CSH "echo $psfile\n";
-
+
#$B0 = sprintf("-Ba${btick1x}f${btick2x}/a${btick1z}f${btick2z}:\"t = $time s\"::.\" \"");
$B1 = sprintf("-Ba${btick1x}f${btick2x}/a${btick1z}f${btick2z}:\"$ytitles[0]\"::.\" \":WSne");
$B2 = sprintf("-Ba${btick1x}f${btick2x}/a${btick1z}f${btick2z}:\"$ytitles[1]\"::.\" \":Wsne");
@@ -592,7 +592,7 @@
}
# plot title
- $xtx = $xmin+0.98*$xran; $ztx = $zmin+0.93*$zran;
+ $xtx = $xmin+0.98*$xran; $ztx = $zmin+0.93*$zran;
print "\ntitle plotting at $xtx, $ztx\n";
$textinfo = "-G0 -W255 -C2p -N";
print CSH "pstext $textinfo $J $R -K -O -V >>$psfile<<EOF\n $xtx $ztx 16 0 $fontno RT $titles[$k]\nEOF\n";
Modified: seismo/2D/SPECFEM2D/trunk/configure
===================================================================
--- seismo/2D/SPECFEM2D/trunk/configure 2011-04-23 01:23:54 UTC (rev 18286)
+++ seismo/2D/SPECFEM2D/trunk/configure 2011-04-24 04:34:10 UTC (rev 18287)
@@ -4762,7 +4762,7 @@
#daniel: scotch will be needed in directory src/meshfem2D/
builddir=`pwd`
cd src/meshfem2D/
-
+
if test -z "${ac_scotch_lib_dir}"; then
if test -n "${ac_scotch_dir}"; then
ac_scotch_lib_dir="${ac_scotch_dir}/lib";
@@ -5058,7 +5058,7 @@
# uses bundled scotch: current version 5.1.11
USE_BUNDLED_SCOTCH=1
- SCOTCH_DIR="scotch_5.1.11"
+ SCOTCH_DIR="scotch_5.1.11"
SCOTCH_LIBDIR="${SCOTCH_DIR}/lib"
SCOTCH_INCLUDEDIR="${SCOTCH_DIR}/include"
@@ -5067,7 +5067,7 @@
#
builddir=`pwd`
cd src/meshfem2D/
-
+
if test ! -f "${SCOTCH_DIR}/src/scotch/Makefile.org"; then
# no Makefile backup files yet
@@ -5549,7 +5549,7 @@
# Checks for library functions.
-ac_config_files="$ac_config_files Makefile src/specfem2D/Makefile src/meshfem2D/Makefile DATA/Par_file DATA/SOURCE setup/constants.h setup/precision_mpi.h src/meshfem2D/scotch_5.1.11/src/Makefile.inc"
+ac_config_files="$ac_config_files Makefile src/specfem2D/Makefile src/meshfem2D/Makefile DATA/Par_file DATA/SOURCE setup/constants.h setup/precision.h src/meshfem2D/scotch_5.1.11/src/Makefile.inc"
cat >confcache <<\_ACEOF
# This file is a shell script that caches the results of configure
@@ -6255,7 +6255,7 @@
"DATA/Par_file") CONFIG_FILES="$CONFIG_FILES DATA/Par_file" ;;
"DATA/SOURCE") CONFIG_FILES="$CONFIG_FILES DATA/SOURCE" ;;
"setup/constants.h") CONFIG_FILES="$CONFIG_FILES setup/constants.h" ;;
- "setup/precision_mpi.h") CONFIG_FILES="$CONFIG_FILES setup/precision_mpi.h" ;;
+ "setup/precision.h") CONFIG_FILES="$CONFIG_FILES setup/precision.h" ;;
"src/meshfem2D/scotch_5.1.11/src/Makefile.inc") CONFIG_FILES="$CONFIG_FILES src/meshfem2D/scotch_5.1.11/src/Makefile.inc" ;;
*) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5 ;;
Modified: seismo/2D/SPECFEM2D/trunk/configure.ac
===================================================================
--- seismo/2D/SPECFEM2D/trunk/configure.ac 2011-04-23 01:23:54 UTC (rev 18286)
+++ seismo/2D/SPECFEM2D/trunk/configure.ac 2011-04-24 04:34:10 UTC (rev 18287)
@@ -141,7 +141,7 @@
scotch_include=""
ac_save_cppflags=${CPPFLAGS}
- # scotch only needed for fortran code
+ # scotch only needed for fortran code
#if test -n "${ac_scotch_include_dir}"; then
# CPPFLAGS="${CPPFLAGS} -I${ac_scotch_include_dir}";
#fi
@@ -162,7 +162,7 @@
if test "x${scotch_usable}" = "xyes"; then
AC_DEFINE([HAVE_SCOTCH],[1],[defined if Scotch is installed])
USE_BUNDLED_SCOTCH=0
- SCOTCH_DIR="${ac_scotch_dir}"
+ SCOTCH_DIR="${ac_scotch_dir}"
SCOTCH_LIBDIR="${ac_scotch_lib_dir}"
SCOTCH_INCLUDEDIR="${ac_scotch_include_dir}"
AC_MSG_RESULT([yes])
@@ -435,7 +435,7 @@
# Checks for library functions.
-AC_CONFIG_FILES([Makefile DATA/Par_file DATA/SOURCE src/meshfem2D/Makefile src/specfem2D/Makefile setup/constants.h setup/precision_mpi.h src/meshfem2D/scotch_5.1.11/src/Makefile.inc])
+AC_CONFIG_FILES([Makefile DATA/Par_file DATA/SOURCE src/meshfem2D/Makefile src/specfem2D/Makefile setup/constants.h setup/precision.h src/meshfem2D/scotch_5.1.11/src/Makefile.inc])
AC_OUTPUT
Modified: seismo/2D/SPECFEM2D/trunk/doc/USER_MANUAL/manual_SPECFEM2D.tex
===================================================================
--- seismo/2D/SPECFEM2D/trunk/doc/USER_MANUAL/manual_SPECFEM2D.tex 2011-04-23 01:23:54 UTC (rev 18286)
+++ seismo/2D/SPECFEM2D/trunk/doc/USER_MANUAL/manual_SPECFEM2D.tex 2011-04-24 04:34:10 UTC (rev 18287)
@@ -664,17 +664,17 @@
\texttt{absorb\_elastic\_right*****.bin}\\
\texttt{absorb\_elastic\_top*****.bin}\\
\texttt{lastframe\_elastic*****.bin}\\
-\texttt{S****.AA.BHX.semd}\\
-\texttt{S****.AA.BHZ.semd}\\
+\texttt{S****.AA.BXX.semd}\\
+\texttt{S****.AA.BXZ.semd}\\
\item[2.] Define the adjoint source: \\
Use \texttt{adj\_seismogram.f90}\\
Edit to update \texttt{NSTEP}, \texttt{nrec}, \texttt{t0}, \texttt{deltat}, and the position of the cut to pic
any given phase if needed (\texttt{tstart},\texttt{tend}), add the right number of stations, and
put one component of the source to zero if needed.
-The ouput files of \texttt{adj\_seismogram.f90} are \texttt{S****.AA.BHX.adj} and \texttt{S****.AA.BHZ.adj}, for P-SV waves (and
-\texttt{S****.AA.BHY.adj}, for SH (membrane) waves). Note that you will need these three
-files (\texttt{S****.AA.BHX.adj}, \texttt{S****.AA.BHY.adj} and \texttt{S****.AA.BHZ.adj}) to be present in the \texttt{SEM/} directory
+The ouput files of \texttt{adj\_seismogram.f90} are \texttt{S****.AA.BXX.adj} and \texttt{S****.AA.BXZ.adj}, for P-SV waves (and
+\texttt{S****.AA.BXY.adj}, for SH (membrane) waves). Note that you will need these three
+files (\texttt{S****.AA.BXX.adj}, \texttt{S****.AA.BXY.adj} and \texttt{S****.AA.BXZ.adj}) to be present in the \texttt{SEM/} directory
together with the \texttt{absorb\_elastic\_****.bin} and \texttt{lastframe\_elastic.bin} files to be read
when running the adjoint simulation.\\
@@ -698,11 +698,11 @@
\begin{itemize}
\item at the moment, adjoint simulations do not support anisotropy, attenuation, and viscous damping.
-\item you will need \texttt{S****.AA.BHX.adj}, \texttt{S****.AA.BHY.adj} and \texttt{S****.AA.BHZ.adj}
+\item you will need \texttt{S****.AA.BXX.adj}, \texttt{S****.AA.BXY.adj} and \texttt{S****.AA.BXZ.adj}
to be present in directory \texttt{SEM/} even if you are just running an acoustic or
poroelastic adjoint simulation.\\
-\texttt{S****.AA.BHX.adj} is the only relevant component for an acoustic case.\\
-\texttt{S****.AA.BHX.adj} and \texttt{S****.AA.BHZ.adj} are the only relevant components for a
+\texttt{S****.AA.BXX.adj} is the only relevant component for an acoustic case.\\
+\texttt{S****.AA.BXX.adj} and \texttt{S****.AA.BXZ.adj} are the only relevant components for a
poroelastic case.
\end{itemize}
Modified: seismo/2D/SPECFEM2D/trunk/setup/config.h.in
===================================================================
--- seismo/2D/SPECFEM2D/trunk/setup/config.h.in 2011-04-23 01:23:54 UTC (rev 18286)
+++ seismo/2D/SPECFEM2D/trunk/setup/config.h.in 2011-04-24 04:34:10 UTC (rev 18287)
@@ -1,4 +1,11 @@
/* config.h.in. Generated from configure.ac by autoheader. */
+/*
+!=====================================================================
+!
+! S p e c f e m 2 D V e r s i o n 6 . 1
+!
+!=====================================================================
+*/
/* Define to dummy `main' function (if any) required to link to the Fortran
libraries. */
Modified: seismo/2D/SPECFEM2D/trunk/setup/constants.h.in
===================================================================
--- seismo/2D/SPECFEM2D/trunk/setup/constants.h.in 2011-04-23 01:23:54 UTC (rev 18286)
+++ seismo/2D/SPECFEM2D/trunk/setup/constants.h.in 2011-04-24 04:34:10 UTC (rev 18287)
@@ -9,7 +9,7 @@
!
! solver in single or double precision depending on the machine (4 or 8 bytes)
!
-! ALSO CHANGE FILE precision_mpi.h ACCORDINGLY
+! ALSO CHANGE FILE precision.h ACCORDINGLY
!
integer, parameter :: SIZE_REAL = 4
integer, parameter :: SIZE_DOUBLE = 8
@@ -18,7 +18,7 @@
! set to SIZE_REAL to run in single precision
! set to SIZE_DOUBLE to run in double precision (increases memory size by 2)
!
-! DO CHANGE precision_mpi.h accordingly
+! DO CHANGE precision.h accordingly
!
integer, parameter :: CUSTOM_REAL = @CUSTOM_REAL@
Copied: seismo/2D/SPECFEM2D/trunk/setup/precision.h.in (from rev 18286, seismo/2D/SPECFEM2D/trunk/setup/precision_mpi.h.in)
===================================================================
--- seismo/2D/SPECFEM2D/trunk/setup/precision.h.in (rev 0)
+++ seismo/2D/SPECFEM2D/trunk/setup/precision.h.in 2011-04-24 04:34:10 UTC (rev 18287)
@@ -0,0 +1,17 @@
+!=====================================================================
+!
+! S p e c f e m 2 D V e r s i o n 6 . 1
+!
+!=====================================================================
+
+! @configure_input@
+
+!
+! solver in single or double precision depending on the machine
+!
+! set to MPI_REAL to run in single precision
+! set to MPI_DOUBLE_PRECISION to run in double precision
+!
+! ALSO CHANGE FILE constants.h ACCORDINGLY
+!
+ integer, parameter :: CUSTOM_MPI_TYPE = @CUSTOM_MPI_TYPE@
Deleted: seismo/2D/SPECFEM2D/trunk/setup/precision_mpi.h.in
===================================================================
--- seismo/2D/SPECFEM2D/trunk/setup/precision_mpi.h.in 2011-04-23 01:23:54 UTC (rev 18286)
+++ seismo/2D/SPECFEM2D/trunk/setup/precision_mpi.h.in 2011-04-24 04:34:10 UTC (rev 18287)
@@ -1,17 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 2 D V e r s i o n 6 . 1
-!
-!=====================================================================
-
-! @configure_input@
-
-!
-! solver in single or double precision depending on the machine
-!
-! set to MPI_REAL to run in single precision
-! set to MPI_DOUBLE_PRECISION to run in double precision
-!
-! ALSO CHANGE FILE constants.h ACCORDINGLY
-!
- integer, parameter :: CUSTOM_MPI_TYPE = @CUSTOM_MPI_TYPE@
Modified: seismo/2D/SPECFEM2D/trunk/src/meshfem2D/Makefile.in
===================================================================
--- seismo/2D/SPECFEM2D/trunk/src/meshfem2D/Makefile.in 2011-04-23 01:23:54 UTC (rev 18286)
+++ seismo/2D/SPECFEM2D/trunk/src/meshfem2D/Makefile.in 2011-04-24 04:34:10 UTC (rev 18287)
@@ -99,6 +99,7 @@
OBJS_MESHFEM2D = \
$O/get_node_number.o \
+ $O/param_reader.o \
$O/part_unstruct.o \
$O/read_interfaces_file.o \
$O/read_materials.o \
@@ -154,8 +155,8 @@
##
## check_quality_external_mesh
##
-xcheck_quality_external_mesh: $O/check_quality_external_mesh.o $O/read_value_parameters.o
- ${F90} $(FLAGS_CHECK) -o ${E}/xcheck_quality_external_mesh $O/check_quality_external_mesh.o $O/read_value_parameters.o
+xcheck_quality_external_mesh: $O/check_quality_external_mesh.o $O/read_value_parameters.o $O/param_reader.o
+ ${F90} $(FLAGS_CHECK) -o ${E}/xcheck_quality_external_mesh $O/check_quality_external_mesh.o $O/read_value_parameters.o $O/param_reader.o
##
## object files
@@ -210,9 +211,12 @@
##
## shared
-##
+##
$O/read_value_parameters.o: ${SHARED}/read_value_parameters.f90
${F90} $(FLAGS_CHECK) -c -o $O/read_value_parameters.o ${SHARED}/read_value_parameters.f90
+$O/param_reader.o: ${SHARED}/param_reader.c
+ ${CC} -c $(CFLAGS) -o $O/param_reader.o ${SHARED}/param_reader.c
+
Modified: seismo/2D/SPECFEM2D/trunk/src/meshfem2D/meshfem2D.F90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/src/meshfem2D/meshfem2D.F90 2011-04-23 01:23:54 UTC (rev 18286)
+++ seismo/2D/SPECFEM2D/trunk/src/meshfem2D/meshfem2D.F90 2011-04-24 04:34:10 UTC (rev 18287)
@@ -373,7 +373,7 @@
integer :: iproc
integer :: ix,iz,i,j
integer :: imaterial_number,inumelem
- integer :: i_source,ios
+ integer :: i_source
double precision :: tang1,tangN
! ***
@@ -383,8 +383,8 @@
print *,'Reading the parameter file ... '
print *
- open(unit=IIN,file='DATA/Par_file',status='old',iostat=ios)
- if( ios /= 0 ) stop 'error opening DATA/Par_file file'
+ ! opens file Par_file
+ call open_parameter_file()
! reads in parameters in DATA/Par_file
call read_parameter_file()
@@ -412,7 +412,8 @@
nelmnts,num_material,nxread,nzread)
endif
- close(IIN)
+ ! closes file Par_file
+ call close_parameter_file()
print *
print *,'Parameter file successfully read... '
Modified: seismo/2D/SPECFEM2D/trunk/src/meshfem2D/read_materials.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/src/meshfem2D/read_materials.f90 2011-04-23 01:23:54 UTC (rev 18286)
+++ seismo/2D/SPECFEM2D/trunk/src/meshfem2D/read_materials.f90 2011-04-24 04:34:10 UTC (rev 18287)
@@ -94,7 +94,12 @@
! reads in material parameters
do imaterial=1,nb_materials
- call read_material_parameters(IIN,DONT_IGNORE_JUNK,i,icodematread, &
+ !call read_material_parameters(IIN,DONT_IGNORE_JUNK,i,icodematread, &
+ ! val0read,val1read,val2read,val3read, &
+ ! val4read,val5read,val6read,val7read, &
+ ! val8read,val9read,val10read,val11read,val12read)
+
+ call read_material_parameters_p(i,icodematread, &
val0read,val1read,val2read,val3read, &
val4read,val5read,val6read,val7read, &
val8read,val9read,val10read,val11read,val12read)
Modified: seismo/2D/SPECFEM2D/trunk/src/meshfem2D/read_parameter_file.F90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/src/meshfem2D/read_parameter_file.F90 2011-04-23 01:23:54 UTC (rev 18286)
+++ seismo/2D/SPECFEM2D/trunk/src/meshfem2D/read_parameter_file.F90 2011-04-24 04:34:10 UTC (rev 18287)
@@ -125,54 +125,125 @@
! local parameters
integer :: ios,ireceiverlines
+ integer,external :: err_occurred
! read file names and path for output
- call read_value_string(IIN,IGNORE_JUNK,title)
+ !call read_value_string(IIN,IGNORE_JUNK,title)
+ call read_value_string_p(title, 'solver.title')
+ if(err_occurred() /= 0) stop 'error reading parameter 1 in Par_file'
write(*,*) 'Title of the simulation'
write(*,*) title
print *
! read type of simulation
- call read_value_integer(IIN,IGNORE_JUNK,SIMULATION_TYPE)
- call read_value_logical(IIN,IGNORE_JUNK,SAVE_FORWARD)
+ !call read_value_integer(IIN,IGNORE_JUNK,SIMULATION_TYPE)
+ call read_value_integer_p(SIMULATION_TYPE, 'solver.SIMULATION_TYPE')
+ if(err_occurred() /= 0) stop 'error reading parameter 2 in Par_file'
+ !call read_value_logical(IIN,IGNORE_JUNK,SAVE_FORWARD)
+ call read_value_logical_p(SAVE_FORWARD, 'solver.SAVE_FORWARD')
+ if(err_occurred() /= 0) stop 'error reading parameter 3 in Par_file'
+
! read info about partitioning
- call read_value_integer(IIN,IGNORE_JUNK,nproc)
- call read_value_integer(IIN,IGNORE_JUNK,partitioning_method)
+ !call read_value_integer(IIN,IGNORE_JUNK,nproc)
+ call read_value_integer_p(nproc, 'solver.nproc')
+ if(err_occurred() /= 0) stop 'error reading parameter 4 in Par_file'
- call read_value_integer(IIN,IGNORE_JUNK,ngnod)
- call read_value_logical(IIN,IGNORE_JUNK,initialfield)
- call read_value_logical(IIN,IGNORE_JUNK,add_Bielak_conditions)
- call read_value_logical(IIN,IGNORE_JUNK,assign_external_model)
- call read_value_logical(IIN,IGNORE_JUNK,READ_EXTERNAL_SEP_FILE)
- call read_value_logical(IIN,IGNORE_JUNK,TURN_ATTENUATION_ON)
+ !call read_value_integer(IIN,IGNORE_JUNK,partitioning_method)
+ call read_value_integer_p(partitioning_method, 'mesher.partitioning_method')
+ if(err_occurred() /= 0) stop 'error reading parameter 5 in Par_file'
+
+ !call read_value_integer(IIN,IGNORE_JUNK,ngnod)
+ call read_value_integer_p(ngnod, 'mesher.ngnod')
+ if(err_occurred() /= 0) stop 'error reading parameter 6 in Par_file'
+
+ !call read_value_logical(IIN,IGNORE_JUNK,initialfield)
+ call read_value_logical_p(initialfield, 'solver.initialfield')
+ if(err_occurred() /= 0) stop 'error reading parameter 7 in Par_file'
+
+ !call read_value_logical(IIN,IGNORE_JUNK,add_Bielak_conditions)
+ call read_value_logical_p(add_Bielak_conditions, 'solver.add_Bielak_conditions')
+ if(err_occurred() /= 0) stop 'error reading parameter 8 in Par_file'
+
+ !call read_value_logical(IIN,IGNORE_JUNK,assign_external_model)
+ call read_value_logical_p(assign_external_model, 'mesher.assign_external_model')
+ if(err_occurred() /= 0) stop 'error reading parameter 9 in Par_file'
+
+ !call read_value_logical(IIN,IGNORE_JUNK,READ_EXTERNAL_SEP_FILE)
+ call read_value_logical_p(READ_EXTERNAL_SEP_FILE, 'mesher.READ_EXTERNAL_SEP_FILE')
+ if(err_occurred() /= 0) stop 'error reading parameter 10 in Par_file'
+
+ !call read_value_logical(IIN,IGNORE_JUNK,TURN_ATTENUATION_ON)
+ call read_value_logical_p(TURN_ATTENUATION_ON, 'solver.TURN_ATTENUATION_ON')
+ if(err_occurred() /= 0) stop 'error reading parameter 11 in Par_file'
+
! read viscous attenuation parameters (poroelastic media)
- call read_value_logical(IIN,IGNORE_JUNK,TURN_VISCATTENUATION_ON)
- call read_value_double_precision(IIN,IGNORE_JUNK,Q0)
- call read_value_double_precision(IIN,IGNORE_JUNK,freq0)
+ !call read_value_logical(IIN,IGNORE_JUNK,TURN_VISCATTENUATION_ON)
+ call read_value_logical_p(TURN_VISCATTENUATION_ON, 'solver.TURN_VISCATTENUATION_ON')
+ if(err_occurred() /= 0) stop 'error reading parameter 12 in Par_file'
+
+ !call read_value_double_precision(IIN,IGNORE_JUNK,Q0)
+ call read_value_double_precision_p(Q0, 'solver.Q0')
+ if(err_occurred() /= 0) stop 'error reading parameter 13 in Par_file'
+
+ !call read_value_double_precision(IIN,IGNORE_JUNK,freq0)
+ call read_value_double_precision_p(freq0, 'solver.freq0')
+ if(err_occurred() /= 0) stop 'error reading parameter 14 in Par_file'
+
! determine if body or surface (membrane) waves calculation
- call read_value_logical(IIN,IGNORE_JUNK,p_sv)
+ !call read_value_logical(IIN,IGNORE_JUNK,p_sv)
+ call read_value_logical_p(p_sv, 'solver.p_sv')
+ if(err_occurred() /= 0) stop 'error reading parameter 15 in Par_file'
! read time step parameters
- call read_value_integer(IIN,IGNORE_JUNK,nt)
- call read_value_double_precision(IIN,IGNORE_JUNK,deltat)
+ !call read_value_integer(IIN,IGNORE_JUNK,nt)
+ call read_value_integer_p(nt, 'solver.nt')
+ if(err_occurred() /= 0) stop 'error reading parameter 16 in Par_file'
+ !call read_value_double_precision(IIN,IGNORE_JUNK,deltat)
+ call read_value_double_precision_p(deltat, 'solver.deltat')
+ if(err_occurred() /= 0) stop 'error reading parameter 17 in Par_file'
+
! read source infos
- call read_value_integer(IIN,IGNORE_JUNK,NSOURCES)
- call read_value_logical(IIN,IGNORE_JUNK,force_normal_to_surface)
+ !call read_value_integer(IIN,IGNORE_JUNK,NSOURCES)
+ call read_value_integer_p(NSOURCES, 'solver.NSOURCES')
+ if(err_occurred() /= 0) stop 'error reading parameter 18 in Par_file'
+ !call read_value_logical(IIN,IGNORE_JUNK,force_normal_to_surface)
+ call read_value_logical_p(force_normal_to_surface, 'solver.force_normal_to_surface')
+ if(err_occurred() /= 0) stop 'error reading parameter 19 in Par_file'
+
! read constants for attenuation
- call read_value_integer(IIN,IGNORE_JUNK,N_SLS)
- call read_value_double_precision(IIN,IGNORE_JUNK,f0_attenuation)
+ !call read_value_integer(IIN,IGNORE_JUNK,N_SLS)
+ call read_value_integer_p(N_SLS, 'solver.N_SLS')
+ if(err_occurred() /= 0) stop 'error reading parameter 20 in Par_file'
+ !call read_value_double_precision(IIN,IGNORE_JUNK,f0_attenuation)
+ call read_value_double_precision_p(f0_attenuation, 'solver.f0_attenuation')
+ if(err_occurred() /= 0) stop 'error reading parameter 21 in Par_file'
+
! read receiver line parameters
- call read_value_integer(IIN,IGNORE_JUNK,seismotype)
- call read_value_logical(IIN,IGNORE_JUNK,generate_STATIONS)
- call read_value_integer(IIN,IGNORE_JUNK,nreceiverlines)
- call read_value_double_precision(IIN,IGNORE_JUNK,anglerec)
- call read_value_logical(IIN,IGNORE_JUNK,rec_normal_to_surface)
+ !call read_value_integer(IIN,IGNORE_JUNK,seismotype)
+ call read_value_integer_p(seismotype, 'solver.seismotype')
+ if(err_occurred() /= 0) stop 'error reading parameter 22 in Par_file'
+ !call read_value_logical(IIN,IGNORE_JUNK,generate_STATIONS)
+ call read_value_logical_p(generate_STATIONS, 'solver.generate_STATIONS')
+ if(err_occurred() /= 0) stop 'error reading parameter 23 in Par_file'
+
+ !call read_value_integer(IIN,IGNORE_JUNK,nreceiverlines)
+ call read_value_integer_p(nreceiverlines, 'solver.nreceiverlines')
+ if(err_occurred() /= 0) stop 'error reading parameter 24 in Par_file'
+
+ !call read_value_double_precision(IIN,IGNORE_JUNK,anglerec)
+ call read_value_double_precision_p(anglerec, 'solver.anglerec')
+ if(err_occurred() /= 0) stop 'error reading parameter 25 in Par_file'
+
+ !call read_value_logical(IIN,IGNORE_JUNK,rec_normal_to_surface)
+ call read_value_logical_p(rec_normal_to_surface, 'solver.rec_normal_to_surface')
+ if(err_occurred() /= 0) stop 'error reading parameter 26 in Par_file'
+
if(nreceiverlines < 1) stop 'number of receiver lines must be greater than 1'
! allocate receiver line arrays
@@ -186,37 +257,105 @@
! loop on all the receiver lines
do ireceiverlines = 1,nreceiverlines
- call read_value_integer(IIN,IGNORE_JUNK,nrec(ireceiverlines))
- call read_value_double_precision(IIN,IGNORE_JUNK,xdeb(ireceiverlines))
- call read_value_double_precision(IIN,IGNORE_JUNK,zdeb(ireceiverlines))
- call read_value_double_precision(IIN,IGNORE_JUNK,xfin(ireceiverlines))
- call read_value_double_precision(IIN,IGNORE_JUNK,zfin(ireceiverlines))
- call read_value_logical(IIN,IGNORE_JUNK,enreg_surf_same_vertical(ireceiverlines))
- if (read_external_mesh .and. enreg_surf_same_vertical(ireceiverlines)) then
- stop 'Cannot use enreg_surf_same_vertical with external meshes!'
- endif
+ !call read_value_integer(IIN,IGNORE_JUNK,nrec(ireceiverlines))
+ call read_value_integer_next_p(nrec(ireceiverlines),'solver.nrec')
+ if(err_occurred() /= 0) stop 'error reading parameter 27 in Par_file'
+
+ !call read_value_double_precision(IIN,IGNORE_JUNK,xdeb(ireceiverlines))
+ call read_value_double_prec_next_p(xdeb(ireceiverlines),'solver.xdeb')
+ if(err_occurred() /= 0) stop 'error reading parameter 28 in Par_file'
+
+ !call read_value_double_precision(IIN,IGNORE_JUNK,zdeb(ireceiverlines))
+ call read_value_double_prec_next_p(zdeb(ireceiverlines),'solver.zdeb')
+ if(err_occurred() /= 0) stop 'error reading parameter 29 in Par_file'
+
+ !call read_value_double_precision(IIN,IGNORE_JUNK,xfin(ireceiverlines))
+ call read_value_double_prec_next_p(xfin(ireceiverlines),'solver.xfin')
+ if(err_occurred() /= 0) stop 'error reading parameter 30 in Par_file'
+
+ !call read_value_double_precision(IIN,IGNORE_JUNK,zfin(ireceiverlines))
+ call read_value_double_prec_next_p(zfin(ireceiverlines),'solver.zfin')
+ if(err_occurred() /= 0) stop 'error reading parameter 31 in Par_file'
+
+ !call read_value_logical(IIN,IGNORE_JUNK,enreg_surf_same_vertical(ireceiverlines))
+ call read_value_logical_next_p(enreg_surf_same_vertical(ireceiverlines),'solver.enreg_surf_same_vertical')
+ if(err_occurred() /= 0) stop 'error reading parameter 32 in Par_file'
+
+ if (read_external_mesh .and. enreg_surf_same_vertical(ireceiverlines)) then
+ stop 'Cannot use enreg_surf_same_vertical with external meshes!'
+ endif
enddo
! read display parameters
- call read_value_integer(IIN,IGNORE_JUNK,NTSTEP_BETWEEN_OUTPUT_INFO)
- call read_value_logical(IIN,IGNORE_JUNK,output_postscript_snapshot)
- call read_value_logical(IIN,IGNORE_JUNK,output_color_image)
- call read_value_integer(IIN,IGNORE_JUNK,imagetype)
- call read_value_double_precision(IIN,IGNORE_JUNK,cutsnaps)
- call read_value_logical(IIN,IGNORE_JUNK,meshvect)
- call read_value_logical(IIN,IGNORE_JUNK,modelvect)
- call read_value_logical(IIN,IGNORE_JUNK,boundvect)
- call read_value_logical(IIN,IGNORE_JUNK,interpol)
- call read_value_integer(IIN,IGNORE_JUNK,pointsdisp)
- call read_value_integer(IIN,IGNORE_JUNK,subsamp)
- call read_value_double_precision(IIN,IGNORE_JUNK,sizemax_arrows)
- call read_value_logical(IIN,IGNORE_JUNK,gnuplot)
- call read_value_logical(IIN,IGNORE_JUNK,output_grid)
- call read_value_logical(IIN,IGNORE_JUNK,output_energy)
- call read_value_logical(IIN,IGNORE_JUNK,output_wavefield_snapshot)
+ !call read_value_integer(IIN,IGNORE_JUNK,NTSTEP_BETWEEN_OUTPUT_INFO)
+ call read_value_integer_p(NTSTEP_BETWEEN_OUTPUT_INFO, 'solver.NTSTEP_BETWEEN_OUTPUT_INFO')
+ if(err_occurred() /= 0) stop 'error reading parameter 33 in Par_file'
+ !call read_value_logical(IIN,IGNORE_JUNK,output_postscript_snapshot)
+ call read_value_logical_p(output_postscript_snapshot, 'solver.output_postscript_snapshot')
+ if(err_occurred() /= 0) stop 'error reading parameter 34 in Par_file'
+
+ !call read_value_logical(IIN,IGNORE_JUNK,output_color_image)
+ call read_value_logical_p(output_color_image, 'solver.output_color_image')
+ if(err_occurred() /= 0) stop 'error reading parameter 35 in Par_file'
+
+ !call read_value_integer(IIN,IGNORE_JUNK,imagetype)
+ call read_value_integer_p(imagetype, 'solver.imagetype')
+ if(err_occurred() /= 0) stop 'error reading parameter 36 in Par_file'
+
+ !call read_value_double_precision(IIN,IGNORE_JUNK,cutsnaps)
+ call read_value_double_precision_p(cutsnaps, 'solver.cutsnaps')
+ if(err_occurred() /= 0) stop 'error reading parameter 37 in Par_file'
+
+ !call read_value_logical(IIN,IGNORE_JUNK,meshvect)
+ call read_value_logical_p(meshvect, 'solver.meshvect')
+ if(err_occurred() /= 0) stop 'error reading parameter 38 in Par_file'
+
+ !call read_value_logical(IIN,IGNORE_JUNK,modelvect)
+ call read_value_logical_p(modelvect, 'solver.modelvect')
+ if(err_occurred() /= 0) stop 'error reading parameter 39 in Par_file'
+
+ !call read_value_logical(IIN,IGNORE_JUNK,boundvect)
+ call read_value_logical_p(boundvect, 'solver.boundvect')
+ if(err_occurred() /= 0) stop 'error reading parameter 40 in Par_file'
+
+ !call read_value_logical(IIN,IGNORE_JUNK,interpol)
+ call read_value_logical_p(interpol, 'solver.interpol')
+ if(err_occurred() /= 0) stop 'error reading parameter 41 in Par_file'
+
+ !call read_value_integer(IIN,IGNORE_JUNK,pointsdisp)
+ call read_value_integer_p(pointsdisp, 'solver.pointsdisp')
+ if(err_occurred() /= 0) stop 'error reading parameter 42 in Par_file'
+
+ !call read_value_integer(IIN,IGNORE_JUNK,subsamp)
+ call read_value_integer_p(subsamp, 'solver.subsamp')
+ if(err_occurred() /= 0) stop 'error reading parameter 43 in Par_file'
+
+ !call read_value_double_precision(IIN,IGNORE_JUNK,sizemax_arrows)
+ call read_value_double_precision_p(sizemax_arrows, 'solver.sizemax_arrows')
+ if(err_occurred() /= 0) stop 'error reading parameter 44 in Par_file'
+
+ !call read_value_logical(IIN,IGNORE_JUNK,gnuplot)
+ call read_value_logical_p(gnuplot, 'solver.gnuplot')
+ if(err_occurred() /= 0) stop 'error reading parameter 45 in Par_file'
+
+ !call read_value_logical(IIN,IGNORE_JUNK,output_grid)
+ call read_value_logical_p(output_grid, 'solver.output_grid')
+ if(err_occurred() /= 0) stop 'error reading parameter 46 in Par_file'
+
+ !call read_value_logical(IIN,IGNORE_JUNK,output_energy)
+ call read_value_logical_p(output_energy, 'solver.output_energy')
+ if(err_occurred() /= 0) stop 'error reading parameter 47 in Par_file'
+
+ !call read_value_logical(IIN,IGNORE_JUNK,output_wavefield_snapshot)
+ call read_value_logical_p(output_wavefield_snapshot, 'solver.output_wavefield_snapshot')
+ if(err_occurred() /= 0) stop 'error reading parameter 48 in Par_file'
+
! read the different material materials
- call read_value_integer(IIN,IGNORE_JUNK,nb_materials)
+ !call read_value_integer(IIN,IGNORE_JUNK,nb_materials)
+ call read_value_integer_p(nb_materials, 'mesher.nbmodels')
+ if(err_occurred() /= 0) stop 'error reading parameter 49 in Par_file'
+
if(nb_materials <= 0) stop 'Negative number of materials not allowed!'
allocate(icodemat(nb_materials))
@@ -250,41 +389,90 @@
eta_f,mu_fr)
! boolean defining whether internal or external mesh
- call read_value_logical(IIN,IGNORE_JUNK,read_external_mesh)
+ !call read_value_logical(IIN,IGNORE_JUNK,read_external_mesh)
+ call read_value_logical_p(read_external_mesh, 'mesher.read_external_mesh')
+ if(err_occurred() /= 0) stop 'error reading parameter 50 in Par_file'
! boolean defining whether to use any absorbing boundaries
- call read_value_logical(IIN,IGNORE_JUNK,any_abs)
+ !call read_value_logical(IIN,IGNORE_JUNK,any_abs)
+ call read_value_logical_p(any_abs, 'solver.absorbing_conditions')
+ if(err_occurred() /= 0) stop 'error reading parameter 51 in Par_file'
+
!-----------------
! external mesh parameters
+ if( read_external_mesh ) then
+
! read info about external mesh
- call read_value_string(IIN,IGNORE_JUNK,mesh_file)
- call read_value_string(IIN,IGNORE_JUNK,nodes_coords_file)
- call read_value_string(IIN,IGNORE_JUNK,materials_file)
- call read_value_string(IIN,IGNORE_JUNK,free_surface_file)
- call read_value_string(IIN,IGNORE_JUNK,absorbing_surface_file)
- call read_value_string(IIN,IGNORE_JUNK,tangential_detection_curve_file)
+ !call read_value_string(IIN,IGNORE_JUNK,mesh_file)
+ call read_value_string_p(mesh_file, 'mesher.mesh_file')
+ if(err_occurred() /= 0) stop 'error reading parameter 52 in Par_file'
+ !call read_value_string(IIN,IGNORE_JUNK,nodes_coords_file)
+ call read_value_string_p(nodes_coords_file, 'mesher.nodes_coords_file')
+ if(err_occurred() /= 0) stop 'error reading parameter 53 in Par_file'
+
+ !call read_value_string(IIN,IGNORE_JUNK,materials_file)
+ call read_value_string_p(materials_file, 'mesher.materials_file')
+ if(err_occurred() /= 0) stop 'error reading parameter 54 in Par_file'
+
+ !call read_value_string(IIN,IGNORE_JUNK,free_surface_file)
+ call read_value_string_p(free_surface_file, 'mesher.free_surface_file')
+ if(err_occurred() /= 0) stop 'error reading parameter 55 in Par_file'
+
+ !call read_value_string(IIN,IGNORE_JUNK,absorbing_surface_file)
+ call read_value_string_p(absorbing_surface_file, 'mesher.absorbing_surface_file')
+ if(err_occurred() /= 0) stop 'error reading parameter 56 in Par_file'
+
+ !call read_value_string(IIN,IGNORE_JUNK,tangential_detection_curve_file)
+ call read_value_string_p(tangential_detection_curve_file, 'mesher.tangential_detection_curve_file')
+ if(err_occurred() /= 0) stop 'error reading parameter 57 in Par_file'
+
+ else
+
!-----------------
! internal mesh parameters
! interfaces file
- call read_value_string(IIN,IGNORE_JUNK,interfacesfile)
+ !call read_value_string(IIN,IGNORE_JUNK,interfacesfile)
+ call read_value_string_p(interfacesfile, 'mesher.interfacesfile')
+ if(err_occurred() /= 0) stop 'error reading parameter 58 in Par_file'
! read grid parameters
- call read_value_double_precision(IIN,IGNORE_JUNK,xmin)
- call read_value_double_precision(IIN,IGNORE_JUNK,xmax)
- call read_value_integer(IIN,IGNORE_JUNK,nx)
+ !call read_value_double_precision(IIN,IGNORE_JUNK,xmin)
+ call read_value_double_precision_p(xmin, 'mesher.xmin')
+ if(err_occurred() /= 0) stop 'error reading parameter 59 in Par_file'
+ !call read_value_double_precision(IIN,IGNORE_JUNK,xmax)
+ call read_value_double_precision_p(xmax, 'mesher.xmax')
+ if(err_occurred() /= 0) stop 'error reading parameter 60 in Par_file'
+
+ !call read_value_integer(IIN,IGNORE_JUNK,nx)
+ call read_value_integer_p(nx, 'mesher.nx')
+ if(err_occurred() /= 0) stop 'error reading parameter 61 in Par_file'
+
! read absorbing boundary parameters
- call read_value_logical(IIN,IGNORE_JUNK,absbottom)
- call read_value_logical(IIN,IGNORE_JUNK,absright)
- call read_value_logical(IIN,IGNORE_JUNK,abstop)
- call read_value_logical(IIN,IGNORE_JUNK,absleft)
+ !call read_value_logical(IIN,IGNORE_JUNK,absbottom)
+ call read_value_logical_p(absbottom, 'solver.absorbbottom')
+ if(err_occurred() /= 0) stop 'error reading parameter 62 in Par_file'
+ !call read_value_logical(IIN,IGNORE_JUNK,absright)
+ call read_value_logical_p(absright, 'solver.absorbright')
+ if(err_occurred() /= 0) stop 'error reading parameter 63 in Par_file'
+
+ !call read_value_logical(IIN,IGNORE_JUNK,abstop)
+ call read_value_logical_p(abstop, 'solver.absorbtop')
+ if(err_occurred() /= 0) stop 'error reading parameter 64 in Par_file'
+
+ !call read_value_logical(IIN,IGNORE_JUNK,absleft)
+ call read_value_logical_p(absleft, 'solver.absorbleft')
+ if(err_occurred() /= 0) stop 'error reading parameter 65 in Par_file'
+
! note: if internal mesh, then regions will be read in by read_regions (from meshfem2D)
+ endif
+
! checks input parameters
call check_parameters()
Modified: seismo/2D/SPECFEM2D/trunk/src/meshfem2D/read_regions.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/src/meshfem2D/read_regions.f90 2011-04-23 01:23:54 UTC (rev 18286)
+++ seismo/2D/SPECFEM2D/trunk/src/meshfem2D/read_regions.f90 2011-04-24 04:34:10 UTC (rev 18287)
@@ -64,10 +64,14 @@
integer :: iregion,ixdebregion,ixfinregion,izdebregion,izfinregion,imaterial_number
integer :: i,j
double precision :: vpregion,vsregion,poisson_ratio
+ integer,external :: err_occurred
! read the material numbers for each region
- call read_value_integer(IIN,IGNORE_JUNK,nbregion)
+ !call read_value_integer(IIN,IGNORE_JUNK,nbregion)
+ call read_value_integer_p(nbregion, 'mesher.nbregions')
+ if(err_occurred() /= 0) stop 'error reading parameter nbregions in Par_file'
+
if(nbregion <= 0) stop 'Negative number of regions not allowed!'
print *
@@ -76,7 +80,10 @@
do iregion = 1,nbregion
- call read_region_coordinates(IIN,DONT_IGNORE_JUNK,ixdebregion,ixfinregion, &
+ !call read_region_coordinates(IIN,DONT_IGNORE_JUNK,ixdebregion,ixfinregion, &
+ ! izdebregion,izfinregion,imaterial_number)
+
+ call read_region_coordinates_p(ixdebregion,ixfinregion, &
izdebregion,izfinregion,imaterial_number)
if(imaterial_number < 1) stop 'Negative material number not allowed!'
Modified: seismo/2D/SPECFEM2D/trunk/src/shared/adj_seismogram.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/src/shared/adj_seismogram.f90 2011-04-23 01:23:54 UTC (rev 18286)
+++ seismo/2D/SPECFEM2D/trunk/src/shared/adj_seismogram.f90 2011-04-24 04:34:10 UTC (rev 18287)
@@ -66,13 +66,13 @@
character(len=150) :: filename
NDIM=3
- comp = (/"BHX","BHY","BHZ"/)
+ comp = (/"BXX","BXY","BXZ"/)
! number of components
!NDIMr=2 ! P-SV
NDIMr=1 ! SH (membrane)
- !compr = (/"BHX","BHZ"/) ! P-SV
- compr = (/"BHY","tmp"/) ! SH (membrane)
+ !compr = (/"BXX","BXZ"/) ! P-SV
+ compr = (/"BXY","tmp"/) ! SH (membrane)
! list of stations
station_name(1) = 'S0001'
@@ -170,7 +170,7 @@
enddo
print*,'*************************'
- print*,'The input files (S****.AA.BHX/BHY/BHZ.adj) needed to run the adjoint simulation are in SEM'
+ print*,'The input files (S****.AA.BXX/BXY/BXZ.adj) needed to run the adjoint simulation are in SEM'
print*,'*************************'
end program adj_seismogram
Modified: seismo/2D/SPECFEM2D/trunk/src/shared/check_quality_external_mesh.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/src/shared/check_quality_external_mesh.f90 2011-04-23 01:23:54 UTC (rev 18286)
+++ seismo/2D/SPECFEM2D/trunk/src/shared/check_quality_external_mesh.f90 2011-04-24 04:34:10 UTC (rev 18287)
@@ -88,11 +88,11 @@
integer :: ntotspecAVS_DX
logical :: USE_OPENDX
- character(len=100) interfacesfile,title
+ !character(len=100) interfacesfile,title
! flag to save the last frame for kernels calculation purpose and type of simulation
- logical :: SAVE_FORWARD
- integer :: SIMULATION_TYPE
+ !logical :: SAVE_FORWARD
+ !integer :: SIMULATION_TYPE
! parameters for external mesh
logical :: read_external_mesh
@@ -104,6 +104,7 @@
integer :: NPOIN_unique_needed
integer, dimension(:), allocatable :: ibool_reduced
logical, dimension(:), allocatable :: mask_ibool
+ integer,external :: err_occurred
if(NGNOD /= 4) stop 'NGNOD must be 4'
@@ -114,22 +115,35 @@
print *,'Reading the parameter file ... '
print *
- open(unit=IIN,file='DATA/Par_file',status='old')
+ !open(unit=IIN,file='DATA/Par_file',status='old')
+ call open_parameter_file()
! read and ignore file names and path for output
- call read_value_string(IIN,IGNORE_JUNK,title)
- call read_value_string(IIN,IGNORE_JUNK,interfacesfile)
+ !call read_value_string(IIN,IGNORE_JUNK,title)
+ !call read_value_string(IIN,IGNORE_JUNK,interfacesfile)
! read and ignore type of simulation
- call read_value_integer(IIN,IGNORE_JUNK,SIMULATION_TYPE)
- call read_value_logical(IIN,IGNORE_JUNK,SAVE_FORWARD)
+ !call read_value_integer(IIN,IGNORE_JUNK,SIMULATION_TYPE)
+ !call read_value_logical(IIN,IGNORE_JUNK,SAVE_FORWARD)
! read info about external mesh
- call read_value_logical(IIN,IGNORE_JUNK,read_external_mesh)
+ !call read_value_logical(IIN,IGNORE_JUNK,read_external_mesh)
+ call read_value_logical_p(read_external_mesh, 'mesher.read_external_mesh')
+ if(err_occurred() /= 0) stop 'error reading parameter read_external_mesh in Par_file'
+
if(.not. read_external_mesh) stop 'this program is designed for read_external_mesh = .true.'
- call read_value_string(IIN,IGNORE_JUNK,mesh_file)
- call read_value_string(IIN,IGNORE_JUNK,nodes_coords_file)
+ !call read_value_string(IIN,IGNORE_JUNK,mesh_file)
+ call read_value_string_p(mesh_file, 'mesher.mesh_file')
+ if(err_occurred() /= 0) stop 'error reading parameter mesh_file in Par_file'
+
+ !call read_value_string(IIN,IGNORE_JUNK,nodes_coords_file)
+ call read_value_string_p(nodes_coords_file, 'mesher.nodes_coords_file')
+ if(err_occurred() /= 0) stop 'error reading parameter nodes_coords_file in Par_file'
+
+ call close_parameter_file()
+
+
print *
print *,'1 = output elements above a certain skewness threshold in OpenDX format'
print *,'2 = output a given element in OpenDX format'
Added: seismo/2D/SPECFEM2D/trunk/src/shared/param_reader.c
===================================================================
--- seismo/2D/SPECFEM2D/trunk/src/shared/param_reader.c (rev 0)
+++ seismo/2D/SPECFEM2D/trunk/src/shared/param_reader.c 2011-04-24 04:34:10 UTC (rev 18287)
@@ -0,0 +1,480 @@
+/*
+ !========================================================================
+ !
+ ! S P E C F E M 2 D Version 6.1
+ ! ------------------------------
+ !
+ ! Copyright Universite de Pau, CNRS and INRIA, France,
+ ! and Princeton University / California Institute of Technology, USA.
+ ! Contributors: Dimitri Komatitsch, dimitri DOT komatitsch aT univ-pau DOT fr
+ ! Nicolas Le Goff, nicolas DOT legoff aT univ-pau DOT fr
+ ! Roland Martin, roland DOT martin aT univ-pau DOT fr
+ ! Christina Morency, cmorency aT princeton DOT edu
+ !
+ ! This software is a computer program whose purpose is to solve
+ ! the two-dimensional viscoelastic anisotropic or poroelastic wave equation
+ ! using a spectral-element method (SEM).
+ !
+ ! 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 in file "LICENSE".
+ !
+ !========================================================================
+ */
+
+/*
+
+ by Dennis McRitchie (Princeton University, USA)
+
+ January 7, 2010 - par_file parsing
+ ..
+ You'll notice that the heart of the parser is a complex regular
+ expression that is compiled within the C code, and then used to split
+ the lines appropriately. It does all the heavy lifting. I don't know of
+ any way to do this in Fortran. I believe that to accomplish this in
+ Fortran, you'd have to write a lot of procedural string manipulation
+ code, for which Fortran is not very well suited.
+
+ But Fortran-C mixes are pretty common these days, so I would not expect
+ any problems on that account. There are no wrapper functions used: just
+ the C routine called directly from a Fortran routine. Also, regarding
+ the use of C, I assumed this would not be a problem since there are
+ already six C files that make up part of the build (though they all are
+ related to the pyre-framework).
+ ..
+ */
+
+#define _GNU_SOURCE
+#include "config.h"
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include <regex.h>
+
+#define LINE_MAX 255
+
+/*
+ * Mac OS X's gcc does not support strnlen and strndup.
+ * So we define them here conditionally, to avoid duplicate definitions
+ * on other systems.
+ */
+#ifdef __APPLE__
+size_t strnlen (const char *string, size_t maxlen)
+{
+ const char *end = memchr (string, '\0', maxlen);
+ return end ? (size_t) (end - string) : maxlen;
+}
+
+char *strndup (char const *s, size_t n)
+{
+ size_t len = strnlen (s, n);
+ char *new = malloc (len + 1);
+
+ if (new == NULL)
+ return NULL;
+
+ new[len] = '\0';
+ return memcpy (new, s, len);
+}
+#endif
+/*===============================================================*/
+
+FILE * fid;
+
+void
+FC_FUNC_(param_open,PARAM_OPEN)(char * filename, int * length, int * ierr)
+{
+ char * fncopy;
+ char * blank;
+
+ // Trim the file name.
+ fncopy = strndup(filename, *length);
+ blank = strchr(fncopy, ' ');
+ if (blank != NULL) {
+ fncopy[blank - fncopy] = '\0';
+ }
+ if ((fid = fopen(fncopy, "r")) == NULL) {
+ printf("Can't open '%s'\n", fncopy);
+ *ierr = 1;
+ return;
+ }
+ free(fncopy);
+}
+
+void
+FC_FUNC_(param_close,PARAM_CLOSE)()
+{
+ fclose(fid);
+}
+
+
+// Parses file to read in parameter
+void
+FC_FUNC_(param_read,PARAM_READ)(char * string_read, int * string_read_len, char * name, int * name_len, int * ierr)
+{
+ char * namecopy;
+ char * blank;
+ char * namecopy2;
+ int status;
+ regex_t compiled_pattern;
+ char line[LINE_MAX];
+ int regret;
+ regmatch_t parameter[3];
+ char * keyword;
+ char * value;
+
+ // Trim the keyword name we're looking for.
+ namecopy = strndup(name, *name_len);
+ blank = strchr(namecopy, ' ');
+ if (blank != NULL) {
+ namecopy[blank - namecopy] = '\0';
+ }
+ // Then get rid of any dot-terminated prefix.
+ namecopy2 = strchr(namecopy, '.');
+ if (namecopy2 != NULL) {
+ namecopy2 += 1;
+ } else {
+ namecopy2 = namecopy;
+ }
+ /* Regular expression for parsing lines from param file.
+ ** Good luck reading this regular expression. Basically, the lines of
+ ** the parameter file should be of the form 'parameter = value'. Blank
+ ** lines, lines containing only white space and lines whose first non-
+ ** whitespace character is '#' are ignored. White space is generally
+ ** ignored. As you will see later in the code, if both parameter and
+ ** value are not specified the line is ignored.
+ */
+ // line must include a "=" character and end with a comment
+ //char pattern[] = "^[ \t]*([^# \t]*)[ \t]*=[ \t]*([^# \t]*)[ \t]*(#.*){0,1}$";
+ // line must include a "=" character (no need to end with a comment)
+ char pattern[] = "^[ \t]*([^# \t]*)[ \t]*=[ \t]*([^# \t]*)[ \t]*";
+
+ // Compile the regular expression.
+ status = regcomp(&compiled_pattern, pattern, REG_EXTENDED);
+ if (status != 0) {
+ printf("regcomp returned error %d\n", status);
+ }
+ // Position the open file to the beginning.
+ if (fseek(fid, 0, SEEK_SET) != 0) {
+ printf("Can't seek to begining of parameter file\n");
+ *ierr = 1;
+ regfree(&compiled_pattern);
+ return;
+ }
+ // Read every line in the file.
+ while (fgets(line, LINE_MAX, fid) != NULL) {
+ // Get rid of the ending newline.
+ int linelen = strlen(line);
+ if (line[linelen-1] == '\n') {
+ line[linelen-1] = '\0';
+ }
+ /* Test if line matches the regular expression pattern, if so
+ ** return position of keyword and value */
+ regret = regexec(&compiled_pattern, line, 3, parameter, 0);
+ // If no match, check the next line.
+ if (regret == REG_NOMATCH) {
+ continue;
+ }
+ // If any error, bail out with an error message.
+ if(regret != 0) {
+ printf("regexec returned error %d\n", regret);
+ *ierr = 1;
+ regfree(&compiled_pattern);
+ return;
+ }
+ //printf("Line read: %s\n", line);
+ //keyword = strndup(line+parameter[0].rm_so, parameter[0].rm_eo-parameter[0].rm_so);
+ //printf("string 0: %s\n", keyword);
+ //free(keyword);
+
+ // If we have a match, extract the keyword from the line.
+ keyword = strndup(line+parameter[1].rm_so, parameter[1].rm_eo-parameter[1].rm_so);
+ //printf("keyword: %s\n", keyword);
+
+ // If the keyword is not the one we're looking for, check the next line.
+ if (strcmp(keyword, namecopy2) != 0) {
+ free(keyword);
+ continue;
+ }
+ free(keyword);
+ regfree(&compiled_pattern);
+ // If it matches, extract the value from the line.
+ value = strndup(line+parameter[2].rm_so, parameter[2].rm_eo-parameter[2].rm_so);
+ //printf("value: %s\n", value);
+
+ // Clear out the return string with blanks, copy the value into it, and return.
+ memset(string_read, ' ', *string_read_len);
+ strncpy(string_read, value, strlen(value));
+ free(value);
+ free(namecopy);
+ *ierr = 0;
+ return;
+ }
+ // If no keyword matches, print out error and die.
+ printf("No match in parameter file for keyword %s\n", namecopy2);
+ free(namecopy);
+ regfree(&compiled_pattern);
+ *ierr = 1;
+ return;
+}
+
+
+// reads next line in file to read in parameters without need of given parameter name
+void
+FC_FUNC_(param_read_nextparam,PARAM_READ_NEXTPARAM)(char * string_read, int * string_read_len, char * name, int * name_len, int * ierr)
+{
+ char * namecopy;
+ char * blank;
+ char * namecopy2;
+ int status;
+ regex_t compiled_pattern;
+ char line[LINE_MAX];
+ int regret;
+ regmatch_t parameter[3];
+ char * keyword;
+ char * value;
+
+ // Trim the keyword name we're looking for.
+ namecopy = strndup(name, *name_len);
+ blank = strchr(namecopy, ' ');
+ if (blank != NULL) {
+ namecopy[blank - namecopy] = '\0';
+ }
+ // Then get rid of any dot-terminated prefix.
+ namecopy2 = strchr(namecopy, '.');
+ if (namecopy2 != NULL) {
+ namecopy2 += 1;
+ } else {
+ namecopy2 = namecopy;
+ }
+
+ /* Regular expression for parsing lines from param file.
+ ** Good luck reading this regular expression. Basically, the lines of
+ ** the parameter file should be of the form 'parameter = value'. Blank
+ ** lines, lines containing only white space and lines whose first non-
+ ** whitespace character is '#' are ignored. White space is generally
+ ** ignored. As you will see later in the code, if both parameter and
+ ** value are not specified the line is ignored.
+ */
+ // line must include a "=" character and end with a comment
+ //char pattern[] = "^[ \t]*([^# \t]*)[ \t]*=[ \t]*([^# \t]*)[ \t]*(#.*){0,1}$";
+ // line must include a "=" character (no need to end with a comment
+ char pattern[] = "^[ \t]*([^# \t]*)[ \t]*=[ \t]*([^# \t]*)[ \t]*";
+
+ // Compile the regular expression.
+ status = regcomp(&compiled_pattern, pattern, REG_EXTENDED);
+ if (status != 0) {
+ printf("regcomp returned error %d\n", status);
+ }
+
+ // skips this... takes current position where file pointer is now...
+ /*
+ // Position the open file to the beginning.
+ if (fseek(fid, 0, SEEK_SET) != 0) {
+ printf("Can't seek to begining of parameter file\n");
+ *ierr = 1;
+ regfree(&compiled_pattern);
+ return;
+ }
+ */
+
+ // Read every line in the file.
+ while (fgets(line, LINE_MAX, fid) != NULL) {
+ // Get rid of the ending newline.
+ int linelen = strlen(line);
+ if (line[linelen-1] == '\n') {
+ line[linelen-1] = '\0';
+ }
+ /* Test if line matches the regular expression pattern, if so
+ ** return position of keyword and value */
+ regret = regexec(&compiled_pattern, line, 3, parameter, 0);
+ // If no match, check the next line.
+ if (regret == REG_NOMATCH) {
+ continue;
+ }
+ // If any error, bail out with an error message.
+ if(regret != 0) {
+ printf("regexec returned error %d\n", regret);
+ *ierr = 1;
+ regfree(&compiled_pattern);
+ return;
+ }
+ //printf("Line nextparam read: %s\n", line);
+
+ // If we have a match, extract the keyword from the line.
+ keyword = strndup(line+parameter[1].rm_so, parameter[1].rm_eo-parameter[1].rm_so);
+ //printf("keyword: %s\n", keyword);
+
+ // If the keyword is not the one we're looking for, return with an error.
+ if (strcmp(keyword, namecopy2) != 0) {
+ printf("keyword returned wrong parameter %s instead of %s \n", keyword,namecopy2);
+ free(keyword);
+ *ierr = 1;
+ regfree(&compiled_pattern);
+ return;
+ }
+ free(keyword);
+ regfree(&compiled_pattern);
+
+ // If it matches, extract the value from the line.
+ value = strndup(line+parameter[2].rm_so, parameter[2].rm_eo-parameter[2].rm_so);
+ //printf("value: %s\n", value);
+
+ // Clear out the return string with blanks, copy the value into it, and return.
+ memset(string_read, ' ', *string_read_len);
+ strncpy(string_read, value, strlen(value));
+ free(value);
+ free(namecopy);
+ *ierr = 0;
+ return;
+ }
+ // If no next line matches, print out error and die.
+ printf("No match in parameter file for %s on next line \n",namecopy2);
+ //free(namecopy);
+ regfree(&compiled_pattern);
+ *ierr = 1;
+ return;
+}
+
+
+// reads next line in file to read in parameters without need of given parameter name
+void
+FC_FUNC_(param_read_nextline,PARAM_READ_NEXTLINE)(char * string_read, int * string_read_len, int * ierr)
+{
+ //char * namecopy;
+ //char * blank;
+ //char * namecopy2;
+ int status;
+ regex_t compiled_pattern;
+ char line[LINE_MAX];
+ int regret;
+ regmatch_t parameter[1];
+ //char * keyword;
+ char * value;
+
+ // no parameter name appears on this line ...
+ /*
+ // Trim the keyword name we're looking for.
+ namecopy = strndup(name, *name_len);
+ blank = strchr(namecopy, ' ');
+ if (blank != NULL) {
+ namecopy[blank - namecopy] = '\0';
+ }
+ // Then get rid of any dot-terminated prefix.
+ namecopy2 = strchr(namecopy, '.');
+ if (namecopy2 != NULL) {
+ namecopy2 += 1;
+ } else {
+ namecopy2 = namecopy;
+ }
+ */
+
+ /* Regular expression for parsing lines from param file.
+ ** Good luck reading this regular expression. Basically, the lines of
+ ** the parameter file should be of the form 'parameter = value'. Blank
+ ** lines, lines containing only white space and lines whose first non-
+ ** whitespace character is '#' are ignored. White space is generally
+ ** ignored. As you will see later in the code, if both parameter and
+ ** value are not specified the line is ignored.
+ */
+ // line must include a "=" character and end with a comment
+ //char pattern[] = "^[ \t]*([^# \t]*)[ \t]*=[ \t]*([^# \t]*)[ \t]*(#.*){0,1}$";
+ // line must include a "=" character (no need to end with a comment)
+ //char pattern[] = "^[ \t]*([^# \t]*)[ \t]*=[ \t]*([^# \t]*)[ \t]*";
+ // line must include numbers
+ char pattern[] = "^[ \t]*[^# \t][0-9]*";
+
+ // Compile the regular expression.
+ status = regcomp(&compiled_pattern, pattern, REG_EXTENDED);
+ if (status != 0) {
+ printf("regcomp returned error %d\n", status);
+ }
+
+ // skips this... takes current position where file pointer is now...
+ /*
+ // Position the open file to the beginning.
+ if (fseek(fid, 0, SEEK_SET) != 0) {
+ printf("Can't seek to begining of parameter file\n");
+ *ierr = 1;
+ regfree(&compiled_pattern);
+ return;
+ }
+ */
+
+ // Read every line in the file.
+ while (fgets(line, LINE_MAX, fid) != NULL) {
+ // Get rid of the ending newline.
+ int linelen = strlen(line);
+ if (line[linelen-1] == '\n') {
+ line[linelen-1] = '\0';
+ }
+ /* Test if line matches the regular expression pattern, if so
+ ** return position of keyword and value */
+ regret = regexec(&compiled_pattern, line, 1, parameter, 0);
+ // If no match, check the next line.
+ if (regret == REG_NOMATCH) {
+ continue;
+ }
+ // If any error, bail out with an error message.
+ if(regret != 0) {
+ printf("regexec returned error %d\n", regret);
+ *ierr = 1;
+ regfree(&compiled_pattern);
+ return;
+ }
+ //printf("Line nextline read: %s\n", line);
+
+ // no comparison with parameter needed
+ /*
+ // If we have a match, extract the keyword from the line.
+ keyword = strndup(line+parameter[1].rm_so, parameter[1].rm_eo-parameter[1].rm_so);
+
+ // If the keyword is not the one we're looking for, check the next line.
+ if (strcmp(keyword, namecopy2) != 0) {
+ free(keyword);
+ continue;
+ }
+ free(keyword);
+ */
+ regfree(&compiled_pattern);
+
+ // If it matches, extract the value from the line.
+ value = strndup(line+parameter[0].rm_so, strlen(line));
+ //printf("value: %s\n", value);
+
+ // Clear out the return string with blanks, copy the value into it, and return.
+ memset(string_read, ' ', *string_read_len);
+ strncpy(string_read, value, strlen(value));
+ free(value);
+ //free(namecopy);
+ *ierr = 0;
+ return;
+ }
+ // If no next line matches, print out error and die.
+ printf("No match in parameter file for next line \n");
+ //free(namecopy);
+ regfree(&compiled_pattern);
+ *ierr = 1;
+ return;
+}
Modified: seismo/2D/SPECFEM2D/trunk/src/shared/read_value_parameters.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/src/shared/read_value_parameters.f90 2011-04-23 01:23:54 UTC (rev 18286)
+++ seismo/2D/SPECFEM2D/trunk/src/shared/read_value_parameters.f90 2011-04-24 04:34:10 UTC (rev 18287)
@@ -209,3 +209,241 @@
end subroutine read_next_line
+!--------------------
+
+
+
+
+!--------------------
+!--------------------
+! uses param_reader.c functions
+!--------------------
+!--------------------
+
+
+ subroutine read_value_integer_p(value_to_read, name)
+
+ implicit none
+
+ integer value_to_read
+ character(len=*) name
+ character(len=100) string_read
+ integer ierr
+ common /param_err_common/ ierr
+
+ call param_read(string_read, len(string_read), name, len(name), ierr)
+ if (ierr .ne. 0) return
+ read(string_read,*) value_to_read
+
+ end subroutine read_value_integer_p
+
+!--------------------
+
+ subroutine read_value_double_precision_p(value_to_read, name)
+
+ implicit none
+
+ double precision value_to_read
+ character(len=*) name
+ character(len=100) string_read
+ integer ierr
+ common /param_err_common/ ierr
+
+ call param_read(string_read, len(string_read), name, len(name), ierr)
+ if (ierr .ne. 0) return
+ read(string_read,*) value_to_read
+
+ end subroutine read_value_double_precision_p
+
+!--------------------
+
+ subroutine read_value_logical_p(value_to_read, name)
+
+ implicit none
+
+ logical value_to_read
+ character(len=*) name
+ character(len=100) string_read
+ integer ierr
+ common /param_err_common/ ierr
+
+ call param_read(string_read, len(string_read), name, len(name), ierr)
+ if (ierr .ne. 0) return
+ read(string_read,*) value_to_read
+
+ end subroutine read_value_logical_p
+
+!--------------------
+
+ subroutine read_value_string_p(value_to_read, name)
+
+ implicit none
+
+ character(len=*) value_to_read
+ character(len=*) name
+ character(len=100) string_read
+ integer ierr
+ common /param_err_common/ ierr
+
+ call param_read(string_read, len(string_read), name, len(name), ierr)
+ if (ierr .ne. 0) return
+ value_to_read = string_read
+
+ end subroutine read_value_string_p
+
+!--------------------
+
+ subroutine read_value_integer_next_p(value_to_read, name)
+
+ implicit none
+
+ integer value_to_read
+ character(len=*) name
+ character(len=100) string_read
+ integer ierr
+ common /param_err_common/ ierr
+
+ call param_read_nextparam(string_read, len(string_read), name, len(name), ierr)
+ if (ierr .ne. 0) return
+ read(string_read,*) value_to_read
+
+ end subroutine read_value_integer_next_p
+
+!--------------------
+
+ subroutine read_value_double_prec_next_p(value_to_read, name)
+
+ implicit none
+
+ double precision value_to_read
+ character(len=*) name
+ character(len=100) string_read
+ integer ierr
+ common /param_err_common/ ierr
+
+ call param_read_nextparam(string_read, len(string_read), name, len(name), ierr)
+ if (ierr .ne. 0) return
+ read(string_read,*) value_to_read
+
+ end subroutine read_value_double_prec_next_p
+
+!--------------------
+
+ subroutine read_value_logical_next_p(value_to_read, name)
+
+ implicit none
+
+ logical value_to_read
+ character(len=*) name
+ character(len=100) string_read
+ integer ierr
+ common /param_err_common/ ierr
+
+ call param_read_nextparam(string_read, len(string_read), name, len(name), ierr)
+ if (ierr .ne. 0) return
+ read(string_read,*) value_to_read
+
+ end subroutine read_value_logical_next_p
+
+
+!--------------------
+
+ subroutine read_material_parameters_p(i,icodematread,val0read,val1read,val2read,val3read, &
+ val4read,val5read,val6read,val7read,val8read,val9read,val10read, &
+ val11read,val12read)
+
+
+ implicit none
+
+ integer i,icodematread
+ double precision val0read,val1read,val2read,val3read,val4read,val5read,val6read,val7read,&
+ val8read,val9read,val10read,val11read,val12read
+
+ character(len=100) string_read
+ integer ierr
+ common /param_err_common/ ierr
+
+ call param_read_nextline(string_read, len(string_read), ierr)
+ if (ierr .ne. 0) stop 'error reading material parameter'
+ print*,trim(string_read)
+ read(string_read,*,iostat=ierr) i,icodematread,val0read,val1read,val2read,val3read,val4read,val5read,&
+ val6read,val7read,val8read,val9read,val10read,val11read,val12read
+
+ if( ierr .ne. 0) stop 'error reading material parameters line'
+
+ end subroutine read_material_parameters_p
+
+!--------------------
+
+ subroutine read_region_coordinates_p(value_to_read_1,value_to_read_2, &
+ value_to_read_3,value_to_read_4,value_to_read_5)
+
+ implicit none
+
+ integer value_to_read_1,value_to_read_2,value_to_read_3,value_to_read_4,value_to_read_5
+ character(len=100) string_read
+ integer ierr
+ common /param_err_common/ ierr
+
+ call param_read_nextline(string_read, len(string_read), ierr)
+ if (ierr .ne. 0) stop 'error reading region coordinates'
+ !print*,string_read
+
+ read(string_read,*,iostat=ierr) value_to_read_1,value_to_read_2,value_to_read_3,value_to_read_4,value_to_read_5
+
+ if( ierr .ne. 0) stop 'error reading region coordinates line'
+
+ end subroutine read_region_coordinates_p
+
+
+!--------------------
+
+
+ subroutine open_parameter_file()
+
+ implicit none
+ include 'constants.h'
+ integer ierr
+ common /param_err_common/ ierr
+ character(len=50) filename
+
+ ! to use fortran routines
+ !open(unit=IIN,file='DATA/Par_file',status='old',iostat=ios)
+ !if( ios /= 0 ) stop 'error opening DATA/Par_file file'
+
+ ! to use c routines
+ filename = 'DATA/Par_file'
+
+ call param_open(filename, len_trim(filename), ierr)
+ if( ierr .ne. 0 ) stop 'error opening DATA/Par_file file'
+
+ end subroutine open_parameter_file
+
+!--------------------
+
+ subroutine close_parameter_file()
+
+ implicit none
+ include 'constants.h'
+
+ ! to use fortran routines
+ !close(IIN)
+
+ ! to use c routines
+ call param_close()
+
+ end subroutine close_parameter_file
+
+!--------------------
+
+ integer function err_occurred()
+
+ implicit none
+
+ integer ierr
+ common /param_err_common/ ierr
+
+ err_occurred = ierr
+
+ end function err_occurred
+
Modified: seismo/2D/SPECFEM2D/trunk/src/specfem2D/Makefile.in
===================================================================
--- seismo/2D/SPECFEM2D/trunk/src/specfem2D/Makefile.in 2011-04-23 01:23:54 UTC (rev 18286)
+++ seismo/2D/SPECFEM2D/trunk/src/specfem2D/Makefile.in 2011-04-24 04:34:10 UTC (rev 18287)
@@ -427,8 +427,10 @@
##
## shared
##
-$O/read_value_parameters.o: ${SHARED}/read_value_parameters.f90
- ${F90} $(FLAGS_CHECK) -c -o $O/read_value_parameters.o ${SHARED}/read_value_parameters.f90
+#$O/read_value_parameters.o: ${SHARED}/read_value_parameters.f90
+# ${F90} $(FLAGS_CHECK) -c -o $O/read_value_parameters.o ${SHARED}/read_value_parameters.f90
+#
+#$O/param_reader.o: ${SHARED}/param_reader.c
+# ${CC} -c $(CFLAGS) -o $O/param_reader.o ${SHARED}/param_reader.c
-
Modified: seismo/2D/SPECFEM2D/trunk/src/specfem2D/assemble_MPI.F90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/src/specfem2D/assemble_MPI.F90 2011-04-23 01:23:54 UTC (rev 18286)
+++ seismo/2D/SPECFEM2D/trunk/src/specfem2D/assemble_MPI.F90 2011-04-24 04:34:10 UTC (rev 18287)
@@ -210,7 +210,7 @@
include 'constants.h'
include 'mpif.h'
- include 'precision_mpi.h'
+ include 'precision.h'
integer, intent(in) :: npoin
integer, intent(in) :: ninterface, ninterface_acoustic
@@ -339,7 +339,7 @@
include 'constants.h'
include 'mpif.h'
- include 'precision_mpi.h'
+ include 'precision.h'
integer, intent(in) :: npoin
integer, intent(in) :: ninterface, ninterface_elastic
@@ -446,7 +446,7 @@
include 'constants.h'
include 'mpif.h'
- include 'precision_mpi.h'
+ include 'precision.h'
integer, intent(in) :: npoin
integer, intent(in) :: ninterface, ninterface_poroelastic
Modified: seismo/2D/SPECFEM2D/trunk/src/specfem2D/compute_arrays_source.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/src/specfem2D/compute_arrays_source.f90 2011-04-23 01:23:54 UTC (rev 18286)
+++ seismo/2D/SPECFEM2D/trunk/src/specfem2D/compute_arrays_source.f90 2011-04-24 04:34:10 UTC (rev 18287)
@@ -165,7 +165,7 @@
adj_sourcearray(:,:,:,:) = 0.
- comp = (/"BHX","BHY","BHZ"/)
+ comp = (/"BXX","BXY","BXZ"/)
do icomp = 1,3
Modified: seismo/2D/SPECFEM2D/trunk/src/specfem2D/specfem2D.F90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/src/specfem2D/specfem2D.F90 2011-04-23 01:23:54 UTC (rev 18286)
+++ seismo/2D/SPECFEM2D/trunk/src/specfem2D/specfem2D.F90 2011-04-24 04:34:10 UTC (rev 18287)
@@ -2712,12 +2712,12 @@
if(SIMULATION_TYPE == 2) then
if(any_elastic) then
- write(outputname,'(a,i6.6,a)') 'snapshot_rho_kappa_mu_',myrank
+ write(outputname,'(a,i6.6,a)') 'proc',myrank,'_rho_kappa_mu_kernel.dat'
open(unit = 97, file = 'OUTPUT_FILES/'//outputname,status = 'unknown',iostat=ios)
- if (ios /= 0) stop 'Error writing snapshot to disk'
- write(outputname,'(a,i6.6,a)') 'snapshot_rhop_alpha_beta_',myrank
+ if (ios /= 0) stop 'Error writing kernel file to disk'
+ write(outputname,'(a,i6.6,a)') 'proc',myrank,'_rhop_alpha_beta_kernel.dat'
open(unit = 98, file = 'OUTPUT_FILES/'//outputname,status = 'unknown',iostat=ios)
- if (ios /= 0) stop 'Error writing snapshot to disk'
+ if (ios /= 0) stop 'Error writing kernel file to disk'
rho_kl(:,:,:) = 0._CUSTOM_REAL
mu_kl(:,:,:) = 0._CUSTOM_REAL
@@ -2735,35 +2735,35 @@
if(any_poroelastic) then
! Primary kernels
- write(outputname,'(a,i6.6,a)') 'snapshot_mu_B_C_',myrank
+ write(outputname,'(a,i6.6,a)') 'proc',myrank,'_mu_B_C_kernel.dat'
open(unit = 144, file = 'OUTPUT_FILES/'//outputname,status = 'unknown',iostat=ios)
- if (ios /= 0) stop 'Error writing snapshot to disk'
- write(outputname,'(a,i6.6,a)') 'snapshot_M_rho_rhof_',myrank
+ if (ios /= 0) stop 'Error writing kernel file to disk'
+ write(outputname,'(a,i6.6,a)') 'proc',myrank,'_M_rho_rhof_kernel.dat'
open(unit = 155, file = 'OUTPUT_FILES/'//outputname,status = 'unknown',iostat=ios)
- if (ios /= 0) stop 'Error writing snapshot to disk'
- write(outputname,'(a,i6.6,a)') 'snapshot_m_eta_',myrank
+ if (ios /= 0) stop 'Error writing kernel file to disk'
+ write(outputname,'(a,i6.6,a)') 'proc',myrank,'_m_eta_kernel.dat'
open(unit = 16, file = 'OUTPUT_FILES/'//outputname,status = 'unknown',iostat=ios)
- if (ios /= 0) stop 'Error writing snapshot to disk'
+ if (ios /= 0) stop 'Error writing kernel file to disk'
! Wavespeed kernels
- write(outputname,'(a,i6.6,a)') 'snapshot_cpI_cpII_cs_',myrank
+ write(outputname,'(a,i6.6,a)') 'proc',myrank,'_cpI_cpII_cs_kernel.dat'
open(unit = 20, file = 'OUTPUT_FILES/'//outputname,status = 'unknown',iostat=ios)
- if (ios /= 0) stop 'Error writing snapshot to disk'
- write(outputname,'(a,i6.6,a)') 'snapshot_rhobb_rhofbb_ratio_',myrank
+ if (ios /= 0) stop 'Error writing kernel file to disk'
+ write(outputname,'(a,i6.6,a)') 'proc',myrank,'_rhobb_rhofbb_ratio_kernel.dat'
open(unit = 21, file = 'OUTPUT_FILES/'//outputname,status = 'unknown',iostat=ios)
- if (ios /= 0) stop 'Error writing snapshot to disk'
- write(outputname,'(a,i6.6,a)') 'snapshot_phib_eta_',myrank
+ if (ios /= 0) stop 'Error writing kernel file to disk'
+ write(outputname,'(a,i6.6,a)') 'proc',myrank,'_phib_eta_kernel.dat'
open(unit = 22, file = 'OUTPUT_FILES/'//outputname,status = 'unknown',iostat=ios)
- if (ios /= 0) stop 'Error writing snapshot to disk'
+ if (ios /= 0) stop 'Error writing kernel file to disk'
! Density normalized kernels
- write(outputname,'(a,i6.6,a)') 'snapshot_mub_Bb_Cb_',myrank
+ write(outputname,'(a,i6.6,a)') 'proc',myrank,'_mub_Bb_Cb_kernel.dat'
open(unit = 17, file = 'OUTPUT_FILES/'//outputname,status = 'unknown',iostat=ios)
- if (ios /= 0) stop 'Error writing snapshot to disk'
- write(outputname,'(a,i6.6,a)') 'snapshot_Mb_rhob_rhofb_',myrank
+ if (ios /= 0) stop 'Error writing kernel file to disk'
+ write(outputname,'(a,i6.6,a)') 'proc',myrank,'_Mb_rhob_rhofb_kernel.dat'
open(unit = 18, file = 'OUTPUT_FILES/'//outputname,status = 'unknown',iostat=ios)
- if (ios /= 0) stop 'Error writing snapshot to disk'
- write(outputname,'(a,i6.6,a)') 'snapshot_mb_etab_',myrank
+ if (ios /= 0) stop 'Error writing kernel file to disk'
+ write(outputname,'(a,i6.6,a)') 'proc',myrank,'_mb_etab_kernel.dat'
open(unit = 19, file = 'OUTPUT_FILES/'//outputname,status = 'unknown',iostat=ios)
- if (ios /= 0) stop 'Error writing snapshot to disk'
+ if (ios /= 0) stop 'Error writing kernel file to disk'
rhot_kl(:,:,:) = 0._CUSTOM_REAL
rhof_kl(:,:,:) = 0._CUSTOM_REAL
@@ -2792,12 +2792,12 @@
endif
if(any_acoustic) then
- write(outputname,'(a,i6.6,a)') 'snapshot_rho_kappa_',myrank
+ write(outputname,'(a,i6.6,a)') 'proc',myrank,'_rho_kappa_kernel.dat'
open(unit = 95, file = 'OUTPUT_FILES/'//outputname,status = 'unknown',iostat=ios)
- if (ios /= 0) stop 'Error writing snapshot to disk'
- write(outputname,'(a,i6.6,a)') 'snapshot_rhop_c_',myrank
+ if (ios /= 0) stop 'Error writing kernel file to disk'
+ write(outputname,'(a,i6.6,a)') 'proc',myrank,'_rhop_c_kernel.dat'
open(unit = 96, file = 'OUTPUT_FILES/'//outputname,status = 'unknown',iostat=ios)
- if (ios /= 0) stop 'Error writing snapshot to disk'
+ if (ios /= 0) stop 'Error writing kernel file to disk'
rho_ac_kl(:,:,:) = 0._CUSTOM_REAL
kappa_ac_kl(:,:,:) = 0._CUSTOM_REAL
Modified: seismo/2D/SPECFEM2D/trunk/src/specfem2D/write_seismograms.F90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/src/specfem2D/write_seismograms.F90 2011-04-23 01:23:54 UTC (rev 18286)
+++ seismo/2D/SPECFEM2D/trunk/src/specfem2D/write_seismograms.F90 2011-04-24 04:34:10 UTC (rev 18287)
@@ -227,9 +227,9 @@
do iorientation = 1,number_of_components
if(iorientation == 1) then
- chn = 'BHX'
+ chn = 'BXX'
else if(iorientation == 2) then
- chn = 'BHZ'
+ chn = 'BXZ'
else if(iorientation == 3) then
chn = 'cur'
else
@@ -239,7 +239,7 @@
! in case of pressure, use different abbreviation
if(seismotype == 4 .or. seismotype == 6) chn = 'PRE'
! in case of SH (membrane) waves, use different abbreviation
- if(.not.p_sv) chn = 'BHY'
+ if(.not.p_sv) chn = 'BXY'
! create the name of the seismogram file for each slice
! file name includes the name of the station, the network and the component
More information about the CIG-COMMITS
mailing list