[cig-commits] r16129 - seismo/3D/SPECFEM3D_GLOBE/trunk
danielpeter at geodynamics.org
danielpeter at geodynamics.org
Thu Jan 7 14:14:24 PST 2010
Author: danielpeter
Date: 2010-01-07 14:14:24 -0800 (Thu, 07 Jan 2010)
New Revision: 16129
Added:
seismo/3D/SPECFEM3D_GLOBE/trunk/param_reader.c
Modified:
seismo/3D/SPECFEM3D_GLOBE/trunk/Makefile.in
seismo/3D/SPECFEM3D_GLOBE/trunk/flags.guess
seismo/3D/SPECFEM3D_GLOBE/trunk/get_value_parameters.f90
seismo/3D/SPECFEM3D_GLOBE/trunk/read_compute_parameters.f90
seismo/3D/SPECFEM3D_GLOBE/trunk/read_value_parameters.f90
Log:
added more flexible file parser for DATA/Par_file (allows for any order of the input parameters, by Dennis McRitchie)
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/Makefile.in
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/Makefile.in 2010-01-07 18:07:20 UTC (rev 16128)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/Makefile.in 2010-01-07 22:14:24 UTC (rev 16129)
@@ -123,6 +123,7 @@
$O/moho_stretching.o \
$O/spline_routines.o \
$O/netlib_specfun_erf.o \
+ $O/param_reader.o \
$O/read_arrays_buffers_solver.o \
$O/read_compute_parameters.o \
$O/read_value_parameters.o \
@@ -352,6 +353,9 @@
$O/get_value_parameters.o: constants.h $S/get_value_parameters.f90
${FCCOMPILE_CHECK} -c -o $O/get_value_parameters.o ${FCFLAGS_f90} $S/get_value_parameters.f90
+$O/param_reader.o: $S/param_reader.c
+ ${CC} -c $(CFLAGS) -o $O/param_reader.o $S/param_reader.c
+
$O/topo_bathy.o: constants.h $S/topo_bathy.f90
${FCCOMPILE_CHECK} -c -o $O/topo_bathy.o ${FCFLAGS_f90} $S/topo_bathy.f90
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/flags.guess
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/flags.guess 2010-01-07 18:07:20 UTC (rev 16128)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/flags.guess 2010-01-07 22:14:24 UTC (rev 16129)
@@ -26,11 +26,14 @@
# Intel ifort Fortran90 for Linux
#
if test x"$FLAGS_CHECK" = x; then
- FLAGS_CHECK="-O3 -vec-report0 -e95 -std95 -implicitnone -warn truncated_source -warn argument_checking -warn unused -warn declarations -warn alignments -warn ignore_loc -warn usage -check nobounds -align sequence -assume byterecl -fpe0 -ftz -traceback -ftrapuv" # -mcmodel=medium
+ # without -e95
+ FLAGS_CHECK="-O3 -vec-report0 -std95 -implicitnone -warn truncated_source -warn argument_checking -warn unused -warn declarations -warn alignments -warn ignore_loc -warn usage -check nobounds -align sequence -assume byterecl -fpe0 -ftz -traceback -ftrapuv" # -mcmodel=medium
+ #FLAGS_CHECK="-O3 -vec-report0 -e95 -std95 -implicitnone -warn truncated_source -warn argument_checking -warn unused -warn declarations -warn alignments -warn ignore_loc -warn usage -check nobounds -align sequence -assume byterecl -fpe0 -ftz -traceback -ftrapuv" # -mcmodel=medium
fi
if test x"$FLAGS_NO_CHECK" = x; then
# standard options (leave option -ftz, which is *critical* for performance)
- FLAGS_NO_CHECK="-O3 -xP -vec-report0 -e95 -std95 -implicitnone -warn truncated_source -warn argument_checking -warn unused -warn declarations -warn alignments -warn ignore_loc -warn usage -check nobounds -align sequence -assume byterecl -fpe3 -ftz" # -mcmodel=medium
+ FLAGS_NO_CHECK="-O3 -xP -vec-report0 -std95 -implicitnone -warn truncated_source -warn argument_checking -warn unused -warn declarations -warn alignments -warn ignore_loc -warn usage -check nobounds -align sequence -assume byterecl -fpe3 -ftz" # -mcmodel=medium
+ #FLAGS_NO_CHECK="-O3 -xP -vec-report0 -e95 -std95 -implicitnone -warn truncated_source -warn argument_checking -warn unused -warn declarations -warn alignments -warn ignore_loc -warn usage -check nobounds -align sequence -assume byterecl -fpe3 -ftz" # -mcmodel=medium
fi
#MPI_LIBS = -Vaxlib
;;
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/get_value_parameters.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/get_value_parameters.f90 2010-01-07 18:07:20 UTC (rev 16128)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/get_value_parameters.f90 2010-01-07 22:14:24 UTC (rev 16129)
@@ -25,60 +25,77 @@
!
!=====================================================================
- subroutine get_value_integer(value_to_get, name, default_value)
- implicit none
+ subroutine get_value_string(value_to_get, name, default_value)
- integer value_to_get, default_value
- character(len=*) name
-
- call unused_string(name)
-
- value_to_get = default_value
-
- end subroutine get_value_integer
-
-!--------------------
-
- subroutine get_value_double_precision(value_to_get, name, default_value)
-
implicit none
- double precision value_to_get, default_value
+ character(len=*) value_to_get, default_value
character(len=*) name
call unused_string(name)
value_to_get = default_value
- end subroutine get_value_double_precision
+ end subroutine get_value_string
!--------------------
- subroutine get_value_logical(value_to_get, name, default_value)
+! dummy subroutine to avoid warnings about variable not used in other subroutines
+ subroutine unused_string(s)
- implicit none
+ character(len=*) s
- logical value_to_get, default_value
- character(len=*) name
+ if (len(s) == 1) continue
- call unused_string(name)
+ end subroutine unused_string
- value_to_get = default_value
-
- end subroutine get_value_logical
-
!--------------------
- subroutine get_value_string(value_to_get, name, default_value)
+!
+! unused routines:
+!
- implicit none
+! subroutine get_value_integer(value_to_get, name, default_value)
+!
+! implicit none
+!
+! integer value_to_get, default_value
+! character(len=*) name
+!
+! call unused_string(name)
+!
+! value_to_get = default_value
+!
+! end subroutine get_value_integer
+!
+!!--------------------
+!
+! subroutine get_value_double_precision(value_to_get, name, default_value)
+!
+! implicit none
+!
+! double precision value_to_get, default_value
+! character(len=*) name
+!
+! call unused_string(name)
+!
+! value_to_get = default_value
+!
+! end subroutine get_value_double_precision
+!
+!!--------------------
+!
+! subroutine get_value_logical(value_to_get, name, default_value)
+!
+! implicit none
+!
+! logical value_to_get, default_value
+! character(len=*) name
+!
+! call unused_string(name)
+!
+! value_to_get = default_value
+!
+! end subroutine get_value_logical
- character(len=*) value_to_get, default_value
- character(len=*) name
-
- call unused_string(name)
-
- value_to_get = default_value
-
- end subroutine get_value_string
Added: seismo/3D/SPECFEM3D_GLOBE/trunk/param_reader.c
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/param_reader.c (rev 0)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/param_reader.c 2010-01-07 22:14:24 UTC (rev 16129)
@@ -0,0 +1,177 @@
+/*
+ !=====================================================================
+ !
+ ! S p e c f e m 3 D G l o b e V e r s i o n 4 . 0
+ ! --------------------------------------------------
+ !
+ ! Main authors: Dimitri Komatitsch and Jeroen Tromp
+ ! Seismological Laboratory, California Institute of Technology, USA
+ ! and University of Pau / CNRS / INRIA, France
+ ! (c) California Institute of Technology and University of Pau / CNRS / INRIA
+ ! February 2008
+ !
+ ! This program is free software; you can redistribute it and/or modify
+ ! it under the terms of the GNU General Public License as published by
+ ! the Free Software Foundation; either version 2 of the License, or
+ ! (at your option) any later version.
+ !
+ ! This program is distributed in the hope that it will be useful,
+ ! but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ ! GNU General Public License for more details.
+ !
+ ! You should have received a copy of the GNU General Public License along
+ ! with this program; if not, write to the Free Software Foundation, Inc.,
+ ! 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ !
+ !=====================================================================
+ */
+
+/*
+
+by Dennis McRitchie
+
+ 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).
+ ..
+*/
+
+#include <stdlib.h>
+#include <stdio.h>
+#define __USE_GNU
+#include <string.h>
+#include <regex.h>
+
+#define LINE_MAX 255
+
+FILE * fd;
+
+void 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 ((fd = fopen(fncopy, "r")) == NULL) {
+ printf("Can't open '%s'\n", fncopy);
+ *ierr = 1;
+ return;
+ }
+ free(fncopy);
+}
+
+void param_close_()
+{
+ fclose(fd);
+}
+
+void 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.
+ */
+ char pattern[] = "^[ \t]*([^# \t]*)[ \t]*=[ \t]*([^# \t]*)[ \t]*(#.*){0,1}$";
+
+ // 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(fd, 0, SEEK_SET) != 0) {
+ printf("Can't seek to begining of parameter file\n");
+ *ierr = 1;
+ return;
+ }
+ // Read every line in the file.
+ while (fgets(line, LINE_MAX, fd) != 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;
+ return;
+ }
+ // printf("Line 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);
+ // 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);
+ // If it matches, extract the value from the line.
+ value = strndup(line+parameter[2].rm_so, parameter[2].rm_eo-parameter[2].rm_so);
+ // 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", namecopy);
+ free(namecopy);
+ *ierr = 1;
+ return;
+}
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/read_compute_parameters.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/read_compute_parameters.f90 2010-01-07 18:07:20 UTC (rev 16128)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/read_compute_parameters.f90 2010-01-07 22:14:24 UTC (rev 16129)
@@ -148,25 +148,25 @@
call open_parameter_file
call read_value_integer(SIMULATION_TYPE, 'solver.SIMULATION_TYPE')
- if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file'
+ if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file: SIMULATION_TYPE'
call read_value_logical(SAVE_FORWARD, 'solver.SAVE_FORWARD')
- if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file'
+ if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file: SAVE_FORWARD'
call read_value_integer(NCHUNKS, 'mesher.NCHUNKS')
- if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file'
+ if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file: NCHUNKS'
if(NCHUNKS /= 1 .and. NCHUNKS /= 2 .and. NCHUNKS /= 3 .and. NCHUNKS /= 6) &
stop 'NCHUNKS must be either 1, 2, 3 or 6'
call read_value_double_precision(ANGULAR_WIDTH_XI_IN_DEGREES, 'mesher.ANGULAR_WIDTH_XI_IN_DEGREES')
- if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file'
+ if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file: ANGULAR_WIDTH_XI...'
call read_value_double_precision(ANGULAR_WIDTH_ETA_IN_DEGREES, 'mesher.ANGULAR_WIDTH_ETA_IN_DEGREES')
- if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file'
+ if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file: ANGULAR_WIDTH_ETA...'
call read_value_double_precision(CENTER_LATITUDE_IN_DEGREES, 'mesher.CENTER_LATITUDE_IN_DEGREES')
- if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file'
+ if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file: CENTER_LATITUDE...'
call read_value_double_precision(CENTER_LONGITUDE_IN_DEGREES, 'mesher.CENTER_LONGITUDE_IN_DEGREES')
- if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file'
+ if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file: CENTER_LONGITUDE...'
call read_value_double_precision(GAMMA_ROTATION_AZIMUTH, 'mesher.GAMMA_ROTATION_AZIMUTH')
- if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file'
+ if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file: GAMMA_ROTATION...'
! this MUST be 90 degrees for two chunks or more to match geometrically
if(NCHUNKS > 1 .and. abs(ANGULAR_WIDTH_XI_IN_DEGREES - 90.d0) > 0.00000001d0) &
@@ -188,13 +188,13 @@
! number of elements at the surface along the two sides of the first chunk
call read_value_integer(NEX_XI_read, 'mesher.NEX_XI')
- if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file'
+ if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file: NEX_XI'
call read_value_integer(NEX_ETA_read, 'mesher.NEX_ETA')
- if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file'
+ if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file: NEX_ETA'
call read_value_integer(NPROC_XI_read, 'mesher.NPROC_XI')
- if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file'
+ if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file: NPROC_XI'
call read_value_integer(NPROC_ETA_read, 'mesher.NPROC_ETA')
- if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file'
+ if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file: NPROC_ETA'
if(.not. EMULATE_ONLY) then
NEX_XI = NEX_XI_read
@@ -212,8 +212,8 @@
if(NCHUNKS > 1 .and. (NPROC_XI == 1 .or. NPROC_ETA == 1)) stop 'support for only one slice per chunk has been discontinued'
! define the velocity model
- call read_value_string(MODEL, 'model.name')
- if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file'
+ call read_value_string(MODEL, 'model.MODEL')
+ if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file: MODEL'
! use PREM as the 1D reference model by default
REFERENCE_1D_MODEL = REFERENCE_MODEL_PREM
@@ -843,20 +843,20 @@
DT = DT * (1.d0 - 0.05d0)
call read_value_logical(OCEANS, 'model.OCEANS')
- if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file'
+ if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file: OCEANS'
call read_value_logical(ELLIPTICITY, 'model.ELLIPTICITY')
- if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file'
+ if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file: ELLIPTICITIY'
call read_value_logical(TOPOGRAPHY, 'model.TOPOGRAPHY')
- if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file'
+ if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file: TOPOGRAPHY'
call read_value_logical(GRAVITY, 'model.GRAVITY')
- if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file'
+ if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file: GRAVITY'
call read_value_logical(ROTATION, 'model.ROTATION')
- if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file'
+ if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file: ROTATION'
call read_value_logical(ATTENUATION, 'model.ATTENUATION')
- if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file'
+ if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file: ATTENUATION'
call read_value_logical(ABSORBING_CONDITIONS, 'solver.ABSORBING_CONDITIONS')
- if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file'
+ if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file: ABSORBING_CONDITIONS'
if(ABSORBING_CONDITIONS .and. NCHUNKS == 6) stop 'cannot have absorbing conditions in the full Earth'
@@ -1051,21 +1051,21 @@
endif
call read_value_double_precision(RECORD_LENGTH_IN_MINUTES, 'solver.RECORD_LENGTH_IN_MINUTES')
- if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file'
+ if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file: RECORD_LENGTH..'
! compute total number of time steps, rounded to next multiple of 100
NSTEP = 100 * (int(RECORD_LENGTH_IN_MINUTES * 60.d0 / (100.d0*DT)) + 1)
call read_value_logical(MOVIE_SURFACE, 'solver.MOVIE_SURFACE')
- if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file'
+ if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file: MOVIE_SURFACE'
call read_value_logical(MOVIE_VOLUME, 'solver.MOVIE_VOLUME')
- if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file'
+ if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file: MOVIE_VOLUME'
call read_value_logical(MOVIE_COARSE,'solver.MOVIE_COARSE')
- if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file'
+ if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file: MOVIE_COARSE'
call read_value_integer(NTSTEP_BETWEEN_FRAMES, 'solver.NTSTEP_BETWEEN_FRAMES')
- if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file'
+ if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file: NTSTEP_BETWEEN_FRAMES'
call read_value_double_precision(HDUR_MOVIE, 'solver.HDUR_MOVIE')
- if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file'
+ if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file: HDUR_MOVIE'
! computes a default hdur_movie that creates nice looking movies.
! Sets HDUR_MOVIE as the minimum period the mesh can resolve
@@ -1074,23 +1074,23 @@
240.d0/NEX_ETA*18.d0*ANGULAR_WIDTH_ETA_IN_DEGREES/90.d0)
call read_value_integer(MOVIE_VOLUME_TYPE, 'solver.MOVIE_VOLUME_TYPE')
- if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file'
+ if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file: MOVIE_VOLUME_TYPE'
call read_value_double_precision(MOVIE_TOP_KM, 'solver.MOVIE_TOP_KM')
- if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file'
+ if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file: MOVIE_TOP_KM'
call read_value_double_precision(MOVIE_BOTTOM_KM, 'solver.MOVIE_BOTTOM_KM')
- if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file'
+ if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file: MOVIE_BOTTOM_KM'
call read_value_double_precision(MOVIE_WEST_DEG, 'solver.MOVIE_WEST_DEG')
- if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file'
+ if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file: MOVIE_WEST_DEG'
call read_value_double_precision(MOVIE_EAST_DEG, 'solver.MOVIE_EAST_DEG')
- if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file'
+ if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file: MOVIE_EAST_DEG'
call read_value_double_precision(MOVIE_NORTH_DEG, 'solver.MOVIE_NORTH_DEG')
- if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file'
+ if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file: MOVIE_NORTH_DEG'
call read_value_double_precision(MOVIE_SOUTH_DEG, 'solver.MOVIE_SOUTH_DEG')
- if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file'
+ if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file: MOVIE_SOUTH_DEG'
call read_value_integer(MOVIE_START, 'solver.MOVIE_START')
- if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file'
+ if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file: MOVIE_START'
call read_value_integer(MOVIE_STOP, 'solver.MOVIE_STOP')
- if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file'
+ if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file: MOVIE_STOP'
MOVIE_TOP = (R_EARTH_KM-MOVIE_TOP_KM)/R_EARTH_KM
MOVIE_BOTTOM = (R_EARTH_KM-MOVIE_BOTTOM_KM)/R_EARTH_KM
MOVIE_EAST = MOVIE_EAST_DEG * DEGREES_TO_RADIANS
@@ -1099,41 +1099,40 @@
MOVIE_SOUTH = (90.0d0 - MOVIE_SOUTH_DEG) * DEGREES_TO_RADIANS
call read_value_logical(SAVE_MESH_FILES, 'mesher.SAVE_MESH_FILES')
- if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file'
+ if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file: SAVE_MESH_FILES'
call read_value_integer(NUMBER_OF_RUNS, 'solver.NUMBER_OF_RUNS')
- if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file'
+ if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file: NUMBER_OF_RUNS'
call read_value_integer(NUMBER_OF_THIS_RUN, 'solver.NUMBER_OF_THIS_RUN')
- if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file'
+ if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file: NUMBER_OF_THIS_RUN'
call read_value_string(LOCAL_PATH, 'LOCAL_PATH')
- if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file'
+ if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file: LOCAL_PATH'
call read_value_integer(NTSTEP_BETWEEN_OUTPUT_INFO, 'solver.NTSTEP_BETWEEN_OUTPUT_INFO')
- if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file'
+ if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file: NTSTEP_BETWEEN_OUTPUT_INFO'
call read_value_integer(NTSTEP_BETWEEN_OUTPUT_SEISMOS, 'solver.NTSTEP_BETWEEN_OUTPUT_SEISMOS')
- if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file'
+ if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file: NTSTEP_BETWEEN_OUTPUT_SEISMOS'
call read_value_integer(NTSTEP_BETWEEN_READ_ADJSRC, 'solver.NTSTEP_BETWEEN_READ_ADJSRC')
if(err_occurred() /= 0) return
call read_value_logical(OUTPUT_SEISMOS_ASCII_TEXT, 'solver.OUTPUT_SEISMOS_ASCII_TEXT')
- if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file'
+ if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file: OUTPUT_SIESMOS_ASCII_TEXT'
call read_value_logical(OUTPUT_SEISMOS_SAC_ALPHANUM, 'solver.OUTPUT_SEISMOS_SAC_ALPHANUM')
- if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file'
+ if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file: OUTPUT_SEISMOS_SAC_ALPHANUM'
call read_value_logical(OUTPUT_SEISMOS_SAC_BINARY, 'solver.OUTPUT_SEISMOS_SAC_BINARY')
- if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file'
+ if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file: OUTPUT_SEISMOS_SAC_BINARY'
call read_value_logical(ROTATE_SEISMOGRAMS_RT, 'solver.ROTATE_SEISMOGRAMS_RT')
- if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file'
+ if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file: ROTATE_SEISMOGRAMS_RT'
call read_value_logical(WRITE_SEISMOGRAMS_BY_MASTER, 'solver.WRITE_SEISMOGRAMS_BY_MASTER')
- if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file'
+ if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file: WRITE_SEISMOGRAMS_BY_MASTER'
call read_value_logical(SAVE_ALL_SEISMOS_IN_ONE_FILE, 'solver.SAVE_ALL_SEISMOS_IN_ONE_FILE')
- if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file'
+ if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file: SAVE_ALL_SEISMOS_IN_ONE_FILE'
call read_value_logical(USE_BINARY_FOR_LARGE_FILE, 'solver.USE_BINARY_FOR_LARGE_FILE')
- if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file'
+ if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file: USE_BINARY_FOR_LARGE_FILE'
call read_value_logical(RECEIVERS_CAN_BE_BURIED, 'solver.RECEIVERS_CAN_BE_BURIED')
- if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file'
+ if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file: RECEIVERS_CAN_BE_BURIED'
call read_value_logical(PRINT_SOURCE_TIME_FUNCTION, 'solver.PRINT_SOURCE_TIME_FUNCTION')
+ if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file: PRINT_SOURCE_TIME_FUNCTION'
- if(err_occurred() /= 0) stop 'an error occurred while reading the parameter file'
-
! close parameter file
call close_parameter_file
!--- check that parameters make sense
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/read_value_parameters.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/read_value_parameters.f90 2010-01-07 18:07:20 UTC (rev 16128)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/read_value_parameters.f90 2010-01-07 22:14:24 UTC (rev 16129)
@@ -34,10 +34,11 @@
integer value_to_read
character(len=*) name
character(len=100) string_read
+ integer ierr
+ common /param_err_common/ ierr
- call unused_string(name)
-
- call read_next_line(string_read)
+ 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
@@ -51,10 +52,11 @@
double precision value_to_read
character(len=*) name
character(len=100) string_read
+ integer ierr
+ common /param_err_common/ ierr
- call unused_string(name)
-
- call read_next_line(string_read)
+ 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
@@ -68,10 +70,11 @@
logical value_to_read
character(len=*) name
character(len=100) string_read
+ integer ierr
+ common /param_err_common/ ierr
- call unused_string(name)
-
- call read_next_line(string_read)
+ 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
@@ -85,66 +88,26 @@
character(len=*) value_to_read
character(len=*) name
character(len=100) string_read
+ integer ierr
+ common /param_err_common/ ierr
- call unused_string(name)
-
- call read_next_line(string_read)
+ 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
!--------------------
- subroutine read_next_line(string_read)
-
- implicit none
-
- include "constants.h"
-
- character(len=100) string_read
-
- integer index_equal_sign,ios
-
- do
- read(unit=IIN,fmt="(a100)",iostat=ios) string_read
- if(ios /= 0) stop 'error while reading parameter file'
-
-! suppress leading white spaces, if any
- string_read = adjustl(string_read)
-
-! suppress trailing carriage return (ASCII code 13) if any (e.g. if input text file coming from Windows/DOS)
- if(index(string_read,achar(13)) > 0) string_read = string_read(1:index(string_read,achar(13))-1)
-
-! exit loop when we find the first line that is not a comment or a white line
- if(len_trim(string_read) == 0) cycle
- if(string_read(1:1) /= '#') exit
-
- enddo
-
-! suppress trailing white spaces, if any
- string_read = string_read(1:len_trim(string_read))
-
-! suppress trailing comments, if any
- if(index(string_read,'#') > 0) string_read = string_read(1:index(string_read,'#')-1)
-
-! suppress leading junk (up to the first equal sign, included)
- index_equal_sign = index(string_read,'=')
- if(index_equal_sign <= 1 .or. index_equal_sign == len_trim(string_read)) stop 'incorrect syntax detected in DATA/Par_file'
- string_read = string_read(index_equal_sign + 1:len_trim(string_read))
-
-! suppress leading and trailing white spaces again, if any, after having suppressed the leading junk
- string_read = adjustl(string_read)
- string_read = string_read(1:len_trim(string_read))
-
- end subroutine read_next_line
-
-!--------------------
-
subroutine open_parameter_file
- include "constants.h"
+ integer ierr
+ common /param_err_common/ ierr
+ character(len=50) filename
+ filename = 'DATA/Par_file'
- open(unit=IIN,file='DATA/Par_file',status='old',action='read')
+ call param_open(filename, len(filename), ierr);
+ if (ierr .ne. 0) return
end subroutine open_parameter_file
@@ -152,28 +115,66 @@
subroutine close_parameter_file
- include "constants.h"
+ call param_close();
- close(IIN)
-
end subroutine close_parameter_file
!--------------------
integer function err_occurred()
- err_occurred = 0
+ integer ierr
+ common /param_err_common/ ierr
+ err_occurred = ierr
+
end function err_occurred
!--------------------
-! dummy subroutine to avoid warnings about variable not used in other subroutines
- subroutine unused_string(s)
+!
+! unused routines:
+!
- character(len=*) s
-
- if (len(s) == 1) continue
-
- end subroutine unused_string
-
+! subroutine read_next_line(string_read)
+!
+! implicit none
+!
+! include "constants.h"
+!
+! character(len=100) string_read
+!
+! integer index_equal_sign,ios
+!
+! do
+! read(unit=IIN,fmt="(a100)",iostat=ios) string_read
+! if(ios /= 0) stop 'error while reading parameter file'
+!
+!! suppress leading white spaces, if any
+! string_read = adjustl(string_read)
+!
+!! suppress trailing carriage return (ASCII code 13) if any (e.g. if input text file coming from Windows/DOS)
+! if(index(string_read,achar(13)) > 0) string_read = string_read(1:index(string_read,achar(13))-1)
+!
+!! exit loop when we find the first line that is not a comment or a white line
+! if(len_trim(string_read) == 0) cycle
+! if(string_read(1:1) /= '#') exit
+!
+! enddo
+!
+!! suppress trailing white spaces, if any
+! string_read = string_read(1:len_trim(string_read))
+!
+!! suppress trailing comments, if any
+! if(index(string_read,'#') > 0) string_read = string_read(1:index(string_read,'#')-1)
+!
+!! suppress leading junk (up to the first equal sign, included)
+! index_equal_sign = index(string_read,'=')
+! if(index_equal_sign <= 1 .or. index_equal_sign == len_trim(string_read)) stop 'incorrect syntax detected in DATA/Par_file'
+! string_read = string_read(index_equal_sign + 1:len_trim(string_read))
+!
+!! suppress leading and trailing white spaces again, if any, after having suppressed the leading junk
+! string_read = adjustl(string_read)
+! string_read = string_read(1:len_trim(string_read))
+!
+! end subroutine read_next_line
More information about the CIG-COMMITS
mailing list