[cig-commits] r14301 - in seismo/3D/SPECFEM3D_SESAME/trunk: . UTILS/external_mesh UTILS/external_mesh/model_asteroid_subdivide UTILS/external_mesh/pre_meshfem3D_asteroid_subdivide
dkomati1 at geodynamics.org
dkomati1 at geodynamics.org
Thu Mar 12 10:37:01 PDT 2009
Author: dkomati1
Date: 2009-03-12 10:37:00 -0700 (Thu, 12 Mar 2009)
New Revision: 14301
Added:
seismo/3D/SPECFEM3D_SESAME/trunk/UTILS/external_mesh/model_asteroid_subdivide/decimate_mesh.f90
seismo/3D/SPECFEM3D_SESAME/trunk/UTILS/external_mesh/pre_meshfem3D_asteroid_subdivide/compile_all.csh
seismo/3D/SPECFEM3D_SESAME/trunk/UTILS/external_mesh/pre_meshfem3D_asteroid_subdivide/constants_decompose_mesh.h
seismo/3D/SPECFEM3D_SESAME/trunk/UTILS/external_mesh/pre_meshfem3D_asteroid_subdivide/decompose_mesh.f90
seismo/3D/SPECFEM3D_SESAME/trunk/UTILS/external_mesh/pre_meshfem3D_asteroid_subdivide/part_decompose_mesh.f90
seismo/3D/SPECFEM3D_SESAME/trunk/generate_databases.f90
seismo/3D/SPECFEM3D_SESAME/trunk/program_generate_databases.f90
Removed:
seismo/3D/SPECFEM3D_SESAME/trunk/PyxMeshfem.c
seismo/3D/SPECFEM3D_SESAME/trunk/PyxMeshfem.pyx
seismo/3D/SPECFEM3D_SESAME/trunk/PyxParameters.c
seismo/3D/SPECFEM3D_SESAME/trunk/PyxParameters.pyx
seismo/3D/SPECFEM3D_SESAME/trunk/PyxSpecfem.c
seismo/3D/SPECFEM3D_SESAME/trunk/PyxSpecfem.pyx
seismo/3D/SPECFEM3D_SESAME/trunk/Specfem3D/
seismo/3D/SPECFEM3D_SESAME/trunk/UTILS/external_mesh/model_asteroid_subdivide/sub.f90
seismo/3D/SPECFEM3D_SESAME/trunk/UTILS/external_mesh/pre_meshfem3D_asteroid_subdivide/compil_all.sh
seismo/3D/SPECFEM3D_SESAME/trunk/UTILS/external_mesh/pre_meshfem3D_asteroid_subdivide/constants_pre_meshfem3D.h
seismo/3D/SPECFEM3D_SESAME/trunk/UTILS/external_mesh/pre_meshfem3D_asteroid_subdivide/part_pre_meshfem3D.f90
seismo/3D/SPECFEM3D_SESAME/trunk/UTILS/external_mesh/pre_meshfem3D_asteroid_subdivide/pre_meshfem3D.f90
seismo/3D/SPECFEM3D_SESAME/trunk/main.c
seismo/3D/SPECFEM3D_SESAME/trunk/meshfem3D.f90
seismo/3D/SPECFEM3D_SESAME/trunk/misc.c
seismo/3D/SPECFEM3D_SESAME/trunk/program_meshfem3D.f90
seismo/3D/SPECFEM3D_SESAME/trunk/setup.py
seismo/3D/SPECFEM3D_SESAME/trunk/trampoline.f90
Modified:
seismo/3D/SPECFEM3D_SESAME/trunk/Makefile.in
seismo/3D/SPECFEM3D_SESAME/trunk/README_SPECFEM3D
seismo/3D/SPECFEM3D_SESAME/trunk/UTILS/external_mesh/TODO_list
seismo/3D/SPECFEM3D_SESAME/trunk/go_mesher
seismo/3D/SPECFEM3D_SESAME/trunk/run3d.csh
seismo/3D/SPECFEM3D_SESAME/trunk/specfem3D.f90
seismo/3D/SPECFEM3D_SESAME/trunk/todo_list_please_dont_remove.txt
Log:
renamed pre-meshfem, meshfem and "sub" (to "decimate_mesh);
also got rid of old unused Pyre routines and files.
Modified: seismo/3D/SPECFEM3D_SESAME/trunk/Makefile.in
===================================================================
--- seismo/3D/SPECFEM3D_SESAME/trunk/Makefile.in 2009-03-12 16:31:24 UTC (rev 14300)
+++ seismo/3D/SPECFEM3D_SESAME/trunk/Makefile.in 2009-03-12 17:37:00 UTC (rev 14301)
@@ -53,28 +53,8 @@
ARFLAGS = cru
RANLIB = ranlib
-# extra defines for the Pyrized version
- at COND_PYRE_TRUE@MPICC = @MPICC@
- at COND_PYRE_TRUE@FCLIBS = @FCLIBS@
- at COND_PYRE_TRUE@PYTHON = @PYTHON@
- at COND_PYRE_TRUE@PYTHON_CFLAGS = $(PYTHON_EGG_CFLAGS) $(PYTHON_CPPFLAGS)
- at COND_PYRE_TRUE@PYTHON_CPPFLAGS = $(PYTHON_EGG_CPPFLAGS) -I at PYTHON_INCDIR@
- at COND_PYRE_TRUE@PYTHON_LDFLAGS = $(PYTHON_EGG_LDFLAGS) @PYTHON_LDFLAGS@ @PYTHON_LINKFORSHARED@ @PYTHON_BLDLIBRARY@ @PYTHON_LIBS@ @PYTHON_MODLIBS@ @PYTHON_SYSLIBS@ @PYTHON_LDLAST@
- at COND_PYRE_TRUE@OUTPUT_DIR = OUTPUT_FILES
- at COND_PYRE_TRUE@PYTHON_EGG_CFLAGS = @PYTHON_EGG_CFLAGS@
- at COND_PYRE_TRUE@PYTHON_EGG_CPPFLAGS = @PYTHON_EGG_CPPFLAGS@
- at COND_PYRE_TRUE@PYTHON_EGG_LDFLAGS = @PYTHON_EGG_LDFLAGS@
-
-
O = obj
-# objects toggled between the pure Fortran and Pyrized version
- at COND_PYRE_TRUE@PYRE_EXTRA_OBJECTS = $O/misc.o $O/trampoline.o $O/PyxMeshfem.o
- at COND_PYRE_TRUE@COND_PYRE_OBJECTS = $O/PyxParameters.o $(PYRE_EXTRA_OBJECTS)
-
-# objects toggled between the pure Fortran and Pyrized version
- at COND_PYRE_FALSE@COND_PYRE_OBJECTS = $O/read_value_parameters.o $O/get_value_parameters.o
-
libspecfem_a_OBJECTS = \
$O/aniso_model.o \
$O/calc_jacobian.o \
@@ -110,7 +90,7 @@
$O/locate_receivers.o \
$O/locate_source.o \
$O/mesh_vertical.o \
- $O/meshfem3D.o \
+ $O/generate_databases.o \
$O/netlib_specfun_erf.o \
$O/read_arrays_buffers_solver.o \
$O/read_topo_bathy_file.o \
@@ -146,17 +126,12 @@
@COND_MPI_TRUE at COND_MPI_OBJECTS = $O/parallel.o
@COND_MPI_FALSE at COND_MPI_OBJECTS = $O/serial.o
-LIBSPECFEM = $(COND_PYRE_OBJECTS) $O/libspecfem.a
+LIBSPECFEM = $O/libspecfem.a
# objects for the pure Fortran version
- at COND_PYRE_FALSE@XMESHFEM_OBJECTS = $O/program_meshfem3D.o $(LIBSPECFEM)
+ at COND_PYRE_FALSE@XGENERATE_DATABASES_OBJECTS = $O/program_generate_databases.o $(LIBSPECFEM)
@COND_PYRE_FALSE at XSPECFEM_OBJECTS = $O/program_specfem3D.o $(SOLVER_ARRAY_OBJECTS) $(LIBSPECFEM)
-# objects for the Pyrized version
- at COND_PYRE_TRUE@XMESHFEM_OBJECTS = $(LIBSPECFEM)
- at COND_PYRE_TRUE@XSPECFEM_OBJECTS = $O/PyxSpecfem.o $(SOLVER_ARRAY_OBJECTS) $(LIBSPECFEM)
-
-
####
#### targets
####
@@ -169,14 +144,10 @@
@COND_PYRE_FALSE@ convolve_source_timefunction \
@COND_PYRE_FALSE@ create_movie_AVS_DX \
@COND_PYRE_FALSE@ create_movie_GMT \
- at COND_PYRE_FALSE@ meshfem3D \
+ at COND_PYRE_FALSE@ generate_databases \
@COND_PYRE_FALSE@ specfem3D \
@COND_PYRE_FALSE@ $(EMPTY_MACRO)
-# default targets for the Pyrized version
- at COND_PYRE_TRUE@DEFAULT = specfem3D
-
-
default: $(DEFAULT)
all: clean default
@@ -186,7 +157,7 @@
bak: backup
-meshfem3D: xmeshfem3D
+generate_databases: xgenerate_databases
specfem3D: xspecfem3D
@@ -196,26 +167,14 @@
####
# rules for the pure Fortran version
- at COND_PYRE_FALSE@xmeshfem3D: $(XMESHFEM_OBJECTS) $(COND_MPI_OBJECTS)
- at COND_PYRE_FALSE@ ${FCLINK} -o xmeshfem3D $(XMESHFEM_OBJECTS) $(COND_MPI_OBJECTS) $(MPILIBS)
+ at COND_PYRE_FALSE@xgenerate_databases: $(XGENERATE_DATABASES_OBJECTS) $(COND_MPI_OBJECTS)
+ at COND_PYRE_FALSE@ ${FCLINK} -o xgenerate_databases $(XGENERATE_DATABASES_OBJECTS) $(COND_MPI_OBJECTS) $(MPILIBS)
@COND_PYRE_FALSE@
@COND_PYRE_FALSE@# solver also depends on values from mesher
@COND_PYRE_FALSE at xspecfem3D: $(XSPECFEM_OBJECTS) $(COND_MPI_OBJECTS)
@COND_PYRE_FALSE@ ${FCLINK} -o xspecfem3D $(XSPECFEM_OBJECTS) $(COND_MPI_OBJECTS) $(MPILIBS)
@COND_PYRE_FALSE@
-# rules for the Pyrized version
- at COND_PYRE_TRUE@xspecfem3D: pyspecfem3D
- at COND_PYRE_TRUE@
- at COND_PYRE_TRUE@pyspecfem3D: main.c $(XMESHFEM_OBJECTS) $(COND_MPI_OBJECTS)
- at COND_PYRE_TRUE@ ${MPICC} -o $@ $(CFLAGS) $(PYTHON_CPPFLAGS) main.c \
- at COND_PYRE_TRUE@ $(XMESHFEM_OBJECTS) $(COND_MPI_OBJECTS) $(MPILIBS) $(PYTHON_LDFLAGS) $(FCLIBS)
- at COND_PYRE_TRUE@
- at COND_PYRE_TRUE@$(OUTPUT_DIR)/pyspecfem3D: main.c $(XSPECFEM_OBJECTS) $(COND_MPI_OBJECTS)
- at COND_PYRE_TRUE@ ${MPICC} -o $@ $(CFLAGS) $(PYTHON_CPPFLAGS) -DUSE_MPI -DWITH_SOLVER main.c \
- at COND_PYRE_TRUE@ $(XSPECFEM_OBJECTS) $(COND_MPI_OBJECTS)$(MPILIBS) $(PYTHON_LDFLAGS) $(FCLIBS)
-
-
check_buffers_2D: xcheck_buffers_2D
check_mesh_quality_AVS_DX: xcheck_mesh_quality_AVS_DX
combine_AVS_DX: xcombine_AVS_DX
@@ -226,7 +185,6 @@
combine_vol_data: xcombine_vol_data
combine_surf_data: xcombine_surf_data
-
xconvolve_source_timefunction: $O/convolve_source_timefunction.o
${FCCOMPILE_CHECK} -o xconvolve_source_timefunction $O/convolve_source_timefunction.o
@@ -255,7 +213,7 @@
${FCCOMPILE_CHECK} -o xcreate_movie_GMT $O/create_movie_GMT.o $(LIBSPECFEM)
clean:
- rm -f $O/* *.o *.gnu OUTPUT_FILES/timestamp* OUTPUT_FILES/starttime*txt work.pc* xmeshfem3D xspecfem3D xcombine_AVS_DX xcheck_mesh_quality_AVS_DX xcheck_buffers_2D xconvolve_source_timefunction xcreate_header_file xcreate_movie_AVS_DX xcombine_vol_data xcombine_surf_data xcreate_movie_GMT
+ rm -f $O/* *.o *.gnu OUTPUT_FILES/timestamp* OUTPUT_FILES/starttime*txt work.pc* xgenerate_databases xspecfem3D xcombine_AVS_DX xcheck_mesh_quality_AVS_DX xcheck_buffers_2D xconvolve_source_timefunction xcreate_header_file xcreate_movie_AVS_DX xcombine_vol_data xcombine_surf_data xcreate_movie_GMT
###
### rule for the archive library
@@ -300,11 +258,11 @@
$O/program_specfem3D.o: program_specfem3D.f90
${FCCOMPILE_CHECK} -c -o $O/program_specfem3D.o program_specfem3D.f90
-$O/program_meshfem3D.o: program_meshfem3D.f90
- ${FCCOMPILE_CHECK} -c -o $O/program_meshfem3D.o program_meshfem3D.f90
+$O/program_generate_databases.o: program_generate_databases.f90
+ ${FCCOMPILE_CHECK} -c -o $O/program_generate_databases.o program_generate_databases.f90
-$O/meshfem3D.o: constants.h meshfem3D.f90
- ${FCCOMPILE_CHECK} -c -o $O/meshfem3D.o meshfem3D.f90
+$O/generate_databases.o: constants.h generate_databases.f90
+ ${FCCOMPILE_CHECK} -c -o $O/generate_databases.o generate_databases.f90
$O/locate_source.o: constants.h locate_source.f90
${FCCOMPILE_CHECK} -c -o $O/locate_source.o locate_source.f90
@@ -512,28 +470,3 @@
$O/write_c_binary.o: write_c_binary.c
cc -c -o $O/write_c_binary.o write_c_binary.c
-###
-### additional rules for the Pyrized version
-###
-
-$O/misc.o: misc.c config.h
- ${MPICC} $(CFLAGS) -c $(PYTHON_CPPFLAGS) -o $O/misc.o misc.c
-
-$O/PyxParameters.o: PyxParameters.c config.h
- ${CC} -c $(CFLAGS) $(PYTHON_CPPFLAGS) -o $O/PyxParameters.o PyxParameters.c
-
-$O/PyxMeshfem.o: PyxMeshfem.c config.h
- ${CC} -c $(CFLAGS) $(PYTHON_CPPFLAGS) -o $O/PyxMeshfem.o PyxMeshfem.c
-
-$O/PyxSpecfem.o: PyxSpecfem.c config.h
- ${CC} -c $(CFLAGS) $(PYTHON_CPPFLAGS) -o $O/PyxSpecfem.o PyxSpecfem.c
-
-$O/trampoline.o: trampoline.f90
- ${FCCOMPILE_NO_CHECK} -c -o $O/trampoline.o ${FCFLAGS_f90} trampoline.f90
-
-# target to update the Pyrex-generated code
-# requires Pyrex: http://www.cosc.canterbury.ac.nz/~greg/python/Pyrex/
-pyrex:
- pyrexc PyxParameters.pyx -o PyxParameters.c
- pyrexc PyxMeshfem.pyx -o PyxMeshfem.c
- pyrexc PyxSpecfem.pyx -o PyxSpecfem.c
Deleted: seismo/3D/SPECFEM3D_SESAME/trunk/PyxMeshfem.c
===================================================================
--- seismo/3D/SPECFEM3D_SESAME/trunk/PyxMeshfem.c 2009-03-12 16:31:24 UTC (rev 14300)
+++ seismo/3D/SPECFEM3D_SESAME/trunk/PyxMeshfem.c 2009-03-12 17:37:00 UTC (rev 14301)
@@ -1,235 +0,0 @@
-/* Generated by Pyrex 0.9.4.1 on Wed Jan 10 15:57:12 2007 */
-
-#include "Python.h"
-#include "structmember.h"
-#ifndef PY_LONG_LONG
- #define PY_LONG_LONG LONG_LONG
-#endif
-#ifdef __cplusplus
-#define __PYX_EXTERN_C extern "C"
-#else
-#define __PYX_EXTERN_C extern
-#endif
-__PYX_EXTERN_C double pow(double, double);
-#include "config.h"
-
-
-typedef struct {PyObject **p; char *s;} __Pyx_InternTabEntry; /*proto*/
-typedef struct {PyObject **p; char *s; long n;} __Pyx_StringTabEntry; /*proto*/
-static PyObject *__Pyx_UnpackItem(PyObject *, int); /*proto*/
-static int __Pyx_EndUnpack(PyObject *, int); /*proto*/
-static int __Pyx_PrintItem(PyObject *); /*proto*/
-static int __Pyx_PrintNewline(void); /*proto*/
-static void __Pyx_Raise(PyObject *type, PyObject *value, PyObject *tb); /*proto*/
-static void __Pyx_ReRaise(void); /*proto*/
-static PyObject *__Pyx_Import(PyObject *name, PyObject *from_list); /*proto*/
-static PyObject *__Pyx_GetExcValue(void); /*proto*/
-static int __Pyx_ArgTypeTest(PyObject *obj, PyTypeObject *type, int none_allowed, char *name); /*proto*/
-static int __Pyx_TypeTest(PyObject *obj, PyTypeObject *type); /*proto*/
-static int __Pyx_GetStarArgs(PyObject **args, PyObject **kwds, char *kwd_list[], int nargs, PyObject **args2, PyObject **kwds2); /*proto*/
-static void __Pyx_WriteUnraisable(char *name); /*proto*/
-static void __Pyx_AddTraceback(char *funcname); /*proto*/
-static PyTypeObject *__Pyx_ImportType(char *module_name, char *class_name, long size); /*proto*/
-static int __Pyx_SetVtable(PyObject *dict, void *vtable); /*proto*/
-static int __Pyx_GetVtable(PyObject *dict, void *vtabptr); /*proto*/
-static PyObject *__Pyx_CreateClass(PyObject *bases, PyObject *dict, PyObject *name, char *modname); /*proto*/
-static int __Pyx_InternStrings(__Pyx_InternTabEntry *t); /*proto*/
-static int __Pyx_InitStrings(__Pyx_StringTabEntry *t); /*proto*/
-static PyObject *__Pyx_GetName(PyObject *dict, PyObject *name); /*proto*/
-
-static PyObject *__pyx_m;
-static PyObject *__pyx_b;
-static int __pyx_lineno;
-static char *__pyx_filename;
-static char **__pyx_f;
-
-static char __pyx_mdoc[] = "Python bindings for the SPECFEM3D Global Solver.";
-
-/* Declarations from PyxMeshfem */
-
-__PYX_EXTERN_C void (FC_FUNC(meshfem3d, MESHFEM3D)(void)); /*proto*/
-
-/* Implementation of PyxMeshfem */
-
-static PyObject *__pyx_n_meshfem3D;
-
-static PyObject *__pyx_n_PyxParameters;
-static PyObject *__pyx_n_component;
-
-
-static PyObject *__pyx_f_10PyxMeshfem_meshfem3D(PyObject *__pyx_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
-static char __pyx_doc_10PyxMeshfem_meshfem3D[] = "Run the SPECFEM3D Global Mesher.";
-static PyObject *__pyx_f_10PyxMeshfem_meshfem3D(PyObject *__pyx_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
- PyObject *__pyx_v_arg = 0;
- PyObject *__pyx_v_PyxParameters;
- PyObject *__pyx_r;
- PyObject *__pyx_1 = 0;
- static char *__pyx_argnames[] = {"arg",0};
- if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "O", __pyx_argnames, &__pyx_v_arg)) return 0;
- Py_INCREF(__pyx_v_arg);
- __pyx_v_PyxParameters = Py_None; Py_INCREF(Py_None);
-
- /* "/home/leif/dv/SPECFEM3D_BASIN/PyxMeshfem.pyx":17 */
- __pyx_1 = __Pyx_Import(__pyx_n_PyxParameters, 0); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 17; goto __pyx_L1;}
- Py_DECREF(__pyx_v_PyxParameters);
- __pyx_v_PyxParameters = __pyx_1;
- __pyx_1 = 0;
-
- /* "/home/leif/dv/SPECFEM3D_BASIN/PyxMeshfem.pyx":18 */
- if (PyObject_SetAttr(__pyx_v_PyxParameters, __pyx_n_component, __pyx_v_arg) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 18; goto __pyx_L1;}
-
- /* "/home/leif/dv/SPECFEM3D_BASIN/PyxMeshfem.pyx":19 */
- FC_FUNC(meshfem3d, MESHFEM3D)(); if (PyErr_Occurred()) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 19; goto __pyx_L1;}
-
- __pyx_r = Py_None; Py_INCREF(Py_None);
- goto __pyx_L0;
- __pyx_L1:;
- Py_XDECREF(__pyx_1);
- __Pyx_AddTraceback("PyxMeshfem.meshfem3D");
- __pyx_r = 0;
- __pyx_L0:;
- Py_DECREF(__pyx_v_PyxParameters);
- Py_DECREF(__pyx_v_arg);
- return __pyx_r;
-}
-
-static __Pyx_InternTabEntry __pyx_intern_tab[] = {
- {&__pyx_n_PyxParameters, "PyxParameters"},
- {&__pyx_n_component, "component"},
- {&__pyx_n_meshfem3D, "meshfem3D"},
- {0, 0}
-};
-
-static struct PyMethodDef __pyx_methods[] = {
- {"meshfem3D", (PyCFunction)__pyx_f_10PyxMeshfem_meshfem3D, METH_VARARGS|METH_KEYWORDS, __pyx_doc_10PyxMeshfem_meshfem3D},
- {0, 0, 0, 0}
-};
-
-static void __pyx_init_filenames(void); /*proto*/
-
-PyMODINIT_FUNC initPyxMeshfem(void); /*proto*/
-PyMODINIT_FUNC initPyxMeshfem(void) {
- __pyx_init_filenames();
- __pyx_m = Py_InitModule4("PyxMeshfem", __pyx_methods, __pyx_mdoc, 0, PYTHON_API_VERSION);
- if (!__pyx_m) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 4; goto __pyx_L1;};
- __pyx_b = PyImport_AddModule("__builtin__");
- if (!__pyx_b) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 4; goto __pyx_L1;};
- if (PyObject_SetAttrString(__pyx_m, "__builtins__", __pyx_b) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 4; goto __pyx_L1;};
- if (__Pyx_InternStrings(__pyx_intern_tab) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 4; goto __pyx_L1;};
-
- /* "/home/leif/dv/SPECFEM3D_BASIN/PyxMeshfem.pyx":15 */
- return;
- __pyx_L1:;
- __Pyx_AddTraceback("PyxMeshfem");
-}
-
-static char *__pyx_filenames[] = {
- "PyxMeshfem.pyx",
-};
-
-/* Runtime support code */
-
-static void __pyx_init_filenames(void) {
- __pyx_f = __pyx_filenames;
-}
-
-static PyObject *__Pyx_Import(PyObject *name, PyObject *from_list) {
- PyObject *__import__ = 0;
- PyObject *empty_list = 0;
- PyObject *module = 0;
- PyObject *global_dict = 0;
- PyObject *empty_dict = 0;
- PyObject *list;
- __import__ = PyObject_GetAttrString(__pyx_b, "__import__");
- if (!__import__)
- goto bad;
- if (from_list)
- list = from_list;
- else {
- empty_list = PyList_New(0);
- if (!empty_list)
- goto bad;
- list = empty_list;
- }
- global_dict = PyModule_GetDict(__pyx_m);
- if (!global_dict)
- goto bad;
- empty_dict = PyDict_New();
- if (!empty_dict)
- goto bad;
- module = PyObject_CallFunction(__import__, "OOOO",
- name, global_dict, empty_dict, list);
-bad:
- Py_XDECREF(empty_list);
- Py_XDECREF(__import__);
- Py_XDECREF(empty_dict);
- return module;
-}
-
-static int __Pyx_InternStrings(__Pyx_InternTabEntry *t) {
- while (t->p) {
- *t->p = PyString_InternFromString(t->s);
- if (!*t->p)
- return -1;
- ++t;
- }
- return 0;
-}
-
-#include "compile.h"
-#include "frameobject.h"
-#include "traceback.h"
-
-static void __Pyx_AddTraceback(char *funcname) {
- PyObject *py_srcfile = 0;
- PyObject *py_funcname = 0;
- PyObject *py_globals = 0;
- PyObject *empty_tuple = 0;
- PyObject *empty_string = 0;
- PyCodeObject *py_code = 0;
- PyFrameObject *py_frame = 0;
-
- py_srcfile = PyString_FromString(__pyx_filename);
- if (!py_srcfile) goto bad;
- py_funcname = PyString_FromString(funcname);
- if (!py_funcname) goto bad;
- py_globals = PyModule_GetDict(__pyx_m);
- if (!py_globals) goto bad;
- empty_tuple = PyTuple_New(0);
- if (!empty_tuple) goto bad;
- empty_string = PyString_FromString("");
- if (!empty_string) goto bad;
- py_code = PyCode_New(
- 0, /*int argcount,*/
- 0, /*int nlocals,*/
- 0, /*int stacksize,*/
- 0, /*int flags,*/
- empty_string, /*PyObject *code,*/
- empty_tuple, /*PyObject *consts,*/
- empty_tuple, /*PyObject *names,*/
- empty_tuple, /*PyObject *varnames,*/
- empty_tuple, /*PyObject *freevars,*/
- empty_tuple, /*PyObject *cellvars,*/
- py_srcfile, /*PyObject *filename,*/
- py_funcname, /*PyObject *name,*/
- __pyx_lineno, /*int firstlineno,*/
- empty_string /*PyObject *lnotab*/
- );
- if (!py_code) goto bad;
- py_frame = PyFrame_New(
- PyThreadState_Get(), /*PyThreadState *tstate,*/
- py_code, /*PyCodeObject *code,*/
- py_globals, /*PyObject *globals,*/
- 0 /*PyObject *locals*/
- );
- if (!py_frame) goto bad;
- py_frame->f_lineno = __pyx_lineno;
- PyTraceBack_Here(py_frame);
-bad:
- Py_XDECREF(py_srcfile);
- Py_XDECREF(py_funcname);
- Py_XDECREF(empty_tuple);
- Py_XDECREF(empty_string);
- Py_XDECREF(py_code);
- Py_XDECREF(py_frame);
-}
Deleted: seismo/3D/SPECFEM3D_SESAME/trunk/PyxMeshfem.pyx
===================================================================
--- seismo/3D/SPECFEM3D_SESAME/trunk/PyxMeshfem.pyx 2009-03-12 16:31:24 UTC (rev 14300)
+++ seismo/3D/SPECFEM3D_SESAME/trunk/PyxMeshfem.pyx 2009-03-12 17:37:00 UTC (rev 14301)
@@ -1,22 +0,0 @@
-# Process this file with Pyrex to produce PyxMeshfem.c
-
-
-"""Python bindings for the SPECFEM3D Global Solver."""
-
-
-# include 'config.h' in order to get the definitions of FC_FUNC and FC_FUNC_
-cdef extern from "config.h":
- pass
-
-
-# external Fortran functions
-
-cdef extern void meshfem3D_f "FC_FUNC(meshfem3d, MESHFEM3D)" () except *
-def meshfem3D(arg):
- """Run the SPECFEM3D Global Mesher."""
- import PyxParameters
- PyxParameters.component = arg
- meshfem3D_f()
-
-
-# end of file
Deleted: seismo/3D/SPECFEM3D_SESAME/trunk/PyxParameters.c
===================================================================
--- seismo/3D/SPECFEM3D_SESAME/trunk/PyxParameters.c 2009-03-12 16:31:24 UTC (rev 14300)
+++ seismo/3D/SPECFEM3D_SESAME/trunk/PyxParameters.c 2009-03-12 17:37:00 UTC (rev 14301)
@@ -1,742 +0,0 @@
-/* Generated by Pyrex 0.9.4.1 on Wed Jan 10 15:57:12 2007 */
-
-#include "Python.h"
-#include "structmember.h"
-#ifndef PY_LONG_LONG
- #define PY_LONG_LONG LONG_LONG
-#endif
-#ifdef __cplusplus
-#define __PYX_EXTERN_C extern "C"
-#else
-#define __PYX_EXTERN_C extern
-#endif
-__PYX_EXTERN_C double pow(double, double);
-#include "config.h"
-#include "string.h"
-
-
-typedef struct {PyObject **p; char *s;} __Pyx_InternTabEntry; /*proto*/
-typedef struct {PyObject **p; char *s; long n;} __Pyx_StringTabEntry; /*proto*/
-static PyObject *__Pyx_UnpackItem(PyObject *, int); /*proto*/
-static int __Pyx_EndUnpack(PyObject *, int); /*proto*/
-static int __Pyx_PrintItem(PyObject *); /*proto*/
-static int __Pyx_PrintNewline(void); /*proto*/
-static void __Pyx_Raise(PyObject *type, PyObject *value, PyObject *tb); /*proto*/
-static void __Pyx_ReRaise(void); /*proto*/
-static PyObject *__Pyx_Import(PyObject *name, PyObject *from_list); /*proto*/
-static PyObject *__Pyx_GetExcValue(void); /*proto*/
-static int __Pyx_ArgTypeTest(PyObject *obj, PyTypeObject *type, int none_allowed, char *name); /*proto*/
-static int __Pyx_TypeTest(PyObject *obj, PyTypeObject *type); /*proto*/
-static int __Pyx_GetStarArgs(PyObject **args, PyObject **kwds, char *kwd_list[], int nargs, PyObject **args2, PyObject **kwds2); /*proto*/
-static void __Pyx_WriteUnraisable(char *name); /*proto*/
-static void __Pyx_AddTraceback(char *funcname); /*proto*/
-static PyTypeObject *__Pyx_ImportType(char *module_name, char *class_name, long size); /*proto*/
-static int __Pyx_SetVtable(PyObject *dict, void *vtable); /*proto*/
-static int __Pyx_GetVtable(PyObject *dict, void *vtabptr); /*proto*/
-static PyObject *__Pyx_CreateClass(PyObject *bases, PyObject *dict, PyObject *name, char *modname); /*proto*/
-static int __Pyx_InternStrings(__Pyx_InternTabEntry *t); /*proto*/
-static int __Pyx_InitStrings(__Pyx_StringTabEntry *t); /*proto*/
-static PyObject *__Pyx_GetName(PyObject *dict, PyObject *name); /*proto*/
-
-static PyObject *__pyx_m;
-static PyObject *__pyx_b;
-static int __pyx_lineno;
-static char *__pyx_filename;
-static char **__pyx_f;
-
-static char __pyx_mdoc[] = "Python bindings for the SPECFEM3D Global Solver.";
-
-/* Declarations from PyxParameters */
-
-__PYX_EXTERN_C DL_EXPORT(void) (FC_FUNC_(read_value_integer, READ_VALUE_INTEGER)(int (*),char (*),int )); /*proto*/
-__PYX_EXTERN_C DL_EXPORT(void) (FC_FUNC_(read_value_double_precision, READ_VALUE_DOUBLE_PRECISION)(double (*),char (*),int )); /*proto*/
-__PYX_EXTERN_C DL_EXPORT(void) (FC_FUNC_(read_value_logical, READ_VALUE_LOGICAL)(int (*),char (*),int )); /*proto*/
-__PYX_EXTERN_C DL_EXPORT(void) (FC_FUNC_(read_value_string, READ_VALUE_STRING)(char (*),char (*),int ,int )); /*proto*/
-__PYX_EXTERN_C DL_EXPORT(void) (FC_FUNC_(open_parameter_file, OPEN_PARAMETER_FILE)(void)); /*proto*/
-__PYX_EXTERN_C DL_EXPORT(void) (FC_FUNC_(close_parameter_file, CLOSE_PARAMETER_FILE)(void)); /*proto*/
-__PYX_EXTERN_C DL_EXPORT(void) (FC_FUNC_(get_value_integer, GET_VALUE_INTEGER)(int (*),char (*),int (*),int )); /*proto*/
-__PYX_EXTERN_C DL_EXPORT(void) (FC_FUNC_(get_value_double_precision, GET_VALUE_DOUBLE_PRECISION)(double (*),char (*),double (*),int )); /*proto*/
-__PYX_EXTERN_C DL_EXPORT(void) (FC_FUNC_(get_value_logical, GET_VALUE_LOGICAL)(int (*),char (*),int (*),int )); /*proto*/
-__PYX_EXTERN_C DL_EXPORT(void) (FC_FUNC_(get_value_string, GET_VALUE_STRING)(char (*),char (*),char (*),int ,int ,int )); /*proto*/
-__PYX_EXTERN_C void (FC_FUNC_(create_header_file, CREATE_HEADER_FILE)(void)); /*proto*/
-
-/* Implementation of PyxParameters */
-
-static PyObject *__pyx_n_component;
-static PyObject *__pyx_n_getValue;
-static PyObject *__pyx_n_create_header_file;
-
-static PyObject *__pyx_n_split;
-static PyObject *__pyx_n_getattr;
-
-static PyObject *__pyx_k1p;
-
-static char (__pyx_k1[]) = ".";
-
-static PyObject *__pyx_f_13PyxParameters_getValue(PyObject *__pyx_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
-static char __pyx_doc_13PyxParameters_getValue[] = "Get a value from the Python scripts.";
-static PyObject *__pyx_f_13PyxParameters_getValue(PyObject *__pyx_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
- PyObject *__pyx_v_o = 0;
- PyObject *__pyx_v_name = 0;
- PyObject *__pyx_v_l;
- PyObject *__pyx_v_n;
- PyObject *__pyx_r;
- PyObject *__pyx_1 = 0;
- PyObject *__pyx_2 = 0;
- PyObject *__pyx_3 = 0;
- PyObject *__pyx_4 = 0;
- static char *__pyx_argnames[] = {"o","name",0};
- if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "OO", __pyx_argnames, &__pyx_v_o, &__pyx_v_name)) return 0;
- Py_INCREF(__pyx_v_o);
- Py_INCREF(__pyx_v_name);
- __pyx_v_l = Py_None; Py_INCREF(Py_None);
- __pyx_v_n = Py_None; Py_INCREF(Py_None);
-
- /* "/home/leif/dv/SPECFEM3D_BASIN/PyxParameters.pyx":27 */
- __pyx_1 = PyObject_GetAttr(__pyx_v_name, __pyx_n_split); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 27; goto __pyx_L1;}
- __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 27; goto __pyx_L1;}
- Py_INCREF(__pyx_k1p);
- PyTuple_SET_ITEM(__pyx_2, 0, __pyx_k1p);
- __pyx_3 = PyObject_CallObject(__pyx_1, __pyx_2); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 27; goto __pyx_L1;}
- Py_DECREF(__pyx_1); __pyx_1 = 0;
- Py_DECREF(__pyx_2); __pyx_2 = 0;
- Py_DECREF(__pyx_v_l);
- __pyx_v_l = __pyx_3;
- __pyx_3 = 0;
-
- /* "/home/leif/dv/SPECFEM3D_BASIN/PyxParameters.pyx":28 */
- __pyx_1 = PyObject_GetIter(__pyx_v_l); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 28; goto __pyx_L1;}
- for (;;) {
- __pyx_L2:;
- __pyx_2 = PyIter_Next(__pyx_1);
- if (!__pyx_2) {
- if (PyErr_Occurred()) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 28; goto __pyx_L1;}
- break;
- }
- Py_DECREF(__pyx_v_n);
- __pyx_v_n = __pyx_2;
- __pyx_2 = 0;
-
- /* "/home/leif/dv/SPECFEM3D_BASIN/PyxParameters.pyx":29 */
- __pyx_3 = __Pyx_GetName(__pyx_b, __pyx_n_getattr); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 29; goto __pyx_L1;}
- __pyx_2 = PyTuple_New(2); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 29; goto __pyx_L1;}
- Py_INCREF(__pyx_v_o);
- PyTuple_SET_ITEM(__pyx_2, 0, __pyx_v_o);
- Py_INCREF(__pyx_v_n);
- PyTuple_SET_ITEM(__pyx_2, 1, __pyx_v_n);
- __pyx_4 = PyObject_CallObject(__pyx_3, __pyx_2); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 29; goto __pyx_L1;}
- Py_DECREF(__pyx_3); __pyx_3 = 0;
- Py_DECREF(__pyx_2); __pyx_2 = 0;
- Py_DECREF(__pyx_v_o);
- __pyx_v_o = __pyx_4;
- __pyx_4 = 0;
- }
- __pyx_L3:;
- Py_DECREF(__pyx_1); __pyx_1 = 0;
-
- /* "/home/leif/dv/SPECFEM3D_BASIN/PyxParameters.pyx":30 */
- Py_INCREF(__pyx_v_o);
- __pyx_r = __pyx_v_o;
- goto __pyx_L0;
-
- __pyx_r = Py_None; Py_INCREF(Py_None);
- goto __pyx_L0;
- __pyx_L1:;
- Py_XDECREF(__pyx_1);
- Py_XDECREF(__pyx_2);
- Py_XDECREF(__pyx_3);
- Py_XDECREF(__pyx_4);
- __Pyx_AddTraceback("PyxParameters.getValue");
- __pyx_r = 0;
- __pyx_L0:;
- Py_DECREF(__pyx_v_l);
- Py_DECREF(__pyx_v_n);
- Py_DECREF(__pyx_v_o);
- Py_DECREF(__pyx_v_name);
- return __pyx_r;
-}
-
-__PYX_EXTERN_C DL_EXPORT(void) FC_FUNC_(read_value_integer, READ_VALUE_INTEGER)(int (*__pyx_v_value),char (*__pyx_v_name),int __pyx_v_nameLen) {
- PyObject *__pyx_v_attrName;
- PyObject *__pyx_1 = 0;
- PyObject *__pyx_2 = 0;
- PyObject *__pyx_3 = 0;
- int __pyx_4;
- __pyx_v_attrName = Py_None; Py_INCREF(Py_None);
-
- /* "/home/leif/dv/SPECFEM3D_BASIN/PyxParameters.pyx":36 */
- __pyx_1 = PyString_FromStringAndSize(__pyx_v_name,__pyx_v_nameLen); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 36; goto __pyx_L1;}
- Py_DECREF(__pyx_v_attrName);
- __pyx_v_attrName = __pyx_1;
- __pyx_1 = 0;
-
- /* "/home/leif/dv/SPECFEM3D_BASIN/PyxParameters.pyx":37 */
- __pyx_1 = __Pyx_GetName(__pyx_m, __pyx_n_getValue); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 37; goto __pyx_L1;}
- __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n_component); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 37; goto __pyx_L1;}
- __pyx_3 = PyTuple_New(2); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 37; goto __pyx_L1;}
- PyTuple_SET_ITEM(__pyx_3, 0, __pyx_2);
- Py_INCREF(__pyx_v_attrName);
- PyTuple_SET_ITEM(__pyx_3, 1, __pyx_v_attrName);
- __pyx_2 = 0;
- __pyx_2 = PyObject_CallObject(__pyx_1, __pyx_3); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 37; goto __pyx_L1;}
- Py_DECREF(__pyx_1); __pyx_1 = 0;
- Py_DECREF(__pyx_3); __pyx_3 = 0;
- __pyx_4 = PyInt_AsLong(__pyx_2); if (PyErr_Occurred()) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 37; goto __pyx_L1;}
- Py_DECREF(__pyx_2); __pyx_2 = 0;
- (__pyx_v_value[0]) = __pyx_4;
-
- goto __pyx_L0;
- __pyx_L1:;
- Py_XDECREF(__pyx_1);
- Py_XDECREF(__pyx_2);
- Py_XDECREF(__pyx_3);
- __Pyx_AddTraceback("PyxParameters.read_value_integer");
- __pyx_L0:;
- Py_DECREF(__pyx_v_attrName);
-}
-
-__PYX_EXTERN_C DL_EXPORT(void) FC_FUNC_(read_value_double_precision, READ_VALUE_DOUBLE_PRECISION)(double (*__pyx_v_value),char (*__pyx_v_name),int __pyx_v_nameLen) {
- PyObject *__pyx_v_attrName;
- PyObject *__pyx_1 = 0;
- PyObject *__pyx_2 = 0;
- PyObject *__pyx_3 = 0;
- double __pyx_4;
- __pyx_v_attrName = Py_None; Py_INCREF(Py_None);
-
- /* "/home/leif/dv/SPECFEM3D_BASIN/PyxParameters.pyx":40 */
- __pyx_1 = PyString_FromStringAndSize(__pyx_v_name,__pyx_v_nameLen); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 40; goto __pyx_L1;}
- Py_DECREF(__pyx_v_attrName);
- __pyx_v_attrName = __pyx_1;
- __pyx_1 = 0;
-
- /* "/home/leif/dv/SPECFEM3D_BASIN/PyxParameters.pyx":41 */
- __pyx_1 = __Pyx_GetName(__pyx_m, __pyx_n_getValue); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 41; goto __pyx_L1;}
- __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n_component); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 41; goto __pyx_L1;}
- __pyx_3 = PyTuple_New(2); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 41; goto __pyx_L1;}
- PyTuple_SET_ITEM(__pyx_3, 0, __pyx_2);
- Py_INCREF(__pyx_v_attrName);
- PyTuple_SET_ITEM(__pyx_3, 1, __pyx_v_attrName);
- __pyx_2 = 0;
- __pyx_2 = PyObject_CallObject(__pyx_1, __pyx_3); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 41; goto __pyx_L1;}
- Py_DECREF(__pyx_1); __pyx_1 = 0;
- Py_DECREF(__pyx_3); __pyx_3 = 0;
- __pyx_4 = PyFloat_AsDouble(__pyx_2); if (PyErr_Occurred()) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 41; goto __pyx_L1;}
- Py_DECREF(__pyx_2); __pyx_2 = 0;
- (__pyx_v_value[0]) = __pyx_4;
-
- goto __pyx_L0;
- __pyx_L1:;
- Py_XDECREF(__pyx_1);
- Py_XDECREF(__pyx_2);
- Py_XDECREF(__pyx_3);
- __Pyx_AddTraceback("PyxParameters.read_value_double_precision");
- __pyx_L0:;
- Py_DECREF(__pyx_v_attrName);
-}
-
-__PYX_EXTERN_C DL_EXPORT(void) FC_FUNC_(read_value_logical, READ_VALUE_LOGICAL)(int (*__pyx_v_value),char (*__pyx_v_name),int __pyx_v_nameLen) {
- PyObject *__pyx_v_attrName;
- PyObject *__pyx_1 = 0;
- PyObject *__pyx_2 = 0;
- PyObject *__pyx_3 = 0;
- int __pyx_4;
- __pyx_v_attrName = Py_None; Py_INCREF(Py_None);
-
- /* "/home/leif/dv/SPECFEM3D_BASIN/PyxParameters.pyx":44 */
- __pyx_1 = PyString_FromStringAndSize(__pyx_v_name,__pyx_v_nameLen); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 44; goto __pyx_L1;}
- Py_DECREF(__pyx_v_attrName);
- __pyx_v_attrName = __pyx_1;
- __pyx_1 = 0;
-
- /* "/home/leif/dv/SPECFEM3D_BASIN/PyxParameters.pyx":45 */
- __pyx_1 = __Pyx_GetName(__pyx_m, __pyx_n_getValue); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 45; goto __pyx_L1;}
- __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n_component); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 45; goto __pyx_L1;}
- __pyx_3 = PyTuple_New(2); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 45; goto __pyx_L1;}
- PyTuple_SET_ITEM(__pyx_3, 0, __pyx_2);
- Py_INCREF(__pyx_v_attrName);
- PyTuple_SET_ITEM(__pyx_3, 1, __pyx_v_attrName);
- __pyx_2 = 0;
- __pyx_2 = PyObject_CallObject(__pyx_1, __pyx_3); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 45; goto __pyx_L1;}
- Py_DECREF(__pyx_1); __pyx_1 = 0;
- Py_DECREF(__pyx_3); __pyx_3 = 0;
- __pyx_4 = PyInt_AsLong(__pyx_2); if (PyErr_Occurred()) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 45; goto __pyx_L1;}
- Py_DECREF(__pyx_2); __pyx_2 = 0;
- (__pyx_v_value[0]) = __pyx_4;
-
- goto __pyx_L0;
- __pyx_L1:;
- Py_XDECREF(__pyx_1);
- Py_XDECREF(__pyx_2);
- Py_XDECREF(__pyx_3);
- __Pyx_AddTraceback("PyxParameters.read_value_logical");
- __pyx_L0:;
- Py_DECREF(__pyx_v_attrName);
-}
-
-static PyObject *__pyx_n_len;
-static PyObject *__pyx_n_ValueError;
-
-static PyObject *__pyx_k2p;
-
-static char (__pyx_k2[]) = "%s value '%s' is too long (%d bytes) for destination Fortran buffer (%d bytes)";
-
-__PYX_EXTERN_C DL_EXPORT(void) FC_FUNC_(read_value_string, READ_VALUE_STRING)(char (*__pyx_v_value),char (*__pyx_v_name),int __pyx_v_valueLen,int __pyx_v_nameLen) {
- char (*__pyx_v_vp);
- int __pyx_v_vl;
- int __pyx_v_i;
- PyObject *__pyx_v_attrName;
- PyObject *__pyx_v_v;
- PyObject *__pyx_1 = 0;
- PyObject *__pyx_2 = 0;
- PyObject *__pyx_3 = 0;
- int __pyx_4;
- PyObject *__pyx_5 = 0;
- char (*__pyx_6);
- __pyx_v_attrName = Py_None; Py_INCREF(Py_None);
- __pyx_v_v = Py_None; Py_INCREF(Py_None);
-
- /* "/home/leif/dv/SPECFEM3D_BASIN/PyxParameters.pyx":50 */
- __pyx_1 = PyString_FromStringAndSize(__pyx_v_name,__pyx_v_nameLen); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 50; goto __pyx_L1;}
- Py_DECREF(__pyx_v_attrName);
- __pyx_v_attrName = __pyx_1;
- __pyx_1 = 0;
-
- /* "/home/leif/dv/SPECFEM3D_BASIN/PyxParameters.pyx":51 */
- __pyx_1 = __Pyx_GetName(__pyx_m, __pyx_n_getValue); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 51; goto __pyx_L1;}
- __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n_component); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 51; goto __pyx_L1;}
- __pyx_3 = PyTuple_New(2); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 51; goto __pyx_L1;}
- PyTuple_SET_ITEM(__pyx_3, 0, __pyx_2);
- Py_INCREF(__pyx_v_attrName);
- PyTuple_SET_ITEM(__pyx_3, 1, __pyx_v_attrName);
- __pyx_2 = 0;
- __pyx_2 = PyObject_CallObject(__pyx_1, __pyx_3); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 51; goto __pyx_L1;}
- Py_DECREF(__pyx_1); __pyx_1 = 0;
- Py_DECREF(__pyx_3); __pyx_3 = 0;
- Py_DECREF(__pyx_v_v);
- __pyx_v_v = __pyx_2;
- __pyx_2 = 0;
-
- /* "/home/leif/dv/SPECFEM3D_BASIN/PyxParameters.pyx":52 */
- __pyx_1 = __Pyx_GetName(__pyx_b, __pyx_n_len); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 52; goto __pyx_L1;}
- __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 52; goto __pyx_L1;}
- Py_INCREF(__pyx_v_v);
- PyTuple_SET_ITEM(__pyx_3, 0, __pyx_v_v);
- __pyx_2 = PyObject_CallObject(__pyx_1, __pyx_3); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 52; goto __pyx_L1;}
- Py_DECREF(__pyx_1); __pyx_1 = 0;
- Py_DECREF(__pyx_3); __pyx_3 = 0;
- __pyx_4 = PyInt_AsLong(__pyx_2); if (PyErr_Occurred()) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 52; goto __pyx_L1;}
- Py_DECREF(__pyx_2); __pyx_2 = 0;
- __pyx_v_vl = __pyx_4;
-
- /* "/home/leif/dv/SPECFEM3D_BASIN/PyxParameters.pyx":53 */
- __pyx_4 = (__pyx_v_vl > __pyx_v_valueLen);
- if (__pyx_4) {
-
- /* "/home/leif/dv/SPECFEM3D_BASIN/PyxParameters.pyx":54 */
- __pyx_1 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 54; goto __pyx_L1;}
- __pyx_3 = PyInt_FromLong(__pyx_v_vl); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 54; goto __pyx_L1;}
- __pyx_2 = PyInt_FromLong(__pyx_v_valueLen); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 54; goto __pyx_L1;}
- __pyx_5 = PyTuple_New(4); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 54; goto __pyx_L1;}
- Py_INCREF(__pyx_v_attrName);
- PyTuple_SET_ITEM(__pyx_5, 0, __pyx_v_attrName);
- Py_INCREF(__pyx_v_v);
- PyTuple_SET_ITEM(__pyx_5, 1, __pyx_v_v);
- PyTuple_SET_ITEM(__pyx_5, 2, __pyx_3);
- PyTuple_SET_ITEM(__pyx_5, 3, __pyx_2);
- __pyx_3 = 0;
- __pyx_2 = 0;
- __pyx_3 = PyNumber_Remainder(__pyx_k2p, __pyx_5); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 54; goto __pyx_L1;}
- Py_DECREF(__pyx_5); __pyx_5 = 0;
- __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 54; goto __pyx_L1;}
- PyTuple_SET_ITEM(__pyx_2, 0, __pyx_3);
- __pyx_3 = 0;
- __pyx_5 = PyObject_CallObject(__pyx_1, __pyx_2); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 54; goto __pyx_L1;}
- Py_DECREF(__pyx_1); __pyx_1 = 0;
- Py_DECREF(__pyx_2); __pyx_2 = 0;
- __Pyx_Raise(__pyx_5, 0, 0);
- Py_DECREF(__pyx_5); __pyx_5 = 0;
- {__pyx_filename = __pyx_f[0]; __pyx_lineno = 54; goto __pyx_L1;}
- goto __pyx_L2;
- }
- __pyx_L2:;
-
- /* "/home/leif/dv/SPECFEM3D_BASIN/PyxParameters.pyx":55 */
- __pyx_6 = PyString_AsString(__pyx_v_v); if (PyErr_Occurred()) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 55; goto __pyx_L1;}
- __pyx_v_vp = __pyx_6;
-
- /* "/home/leif/dv/SPECFEM3D_BASIN/PyxParameters.pyx":56 */
- strncpy(__pyx_v_value,__pyx_v_vp,__pyx_v_vl);
-
- /* "/home/leif/dv/SPECFEM3D_BASIN/PyxParameters.pyx":57 */
- for (__pyx_v_i = __pyx_v_vl; __pyx_v_i < __pyx_v_valueLen; ++__pyx_v_i) {
-
- /* "/home/leif/dv/SPECFEM3D_BASIN/PyxParameters.pyx":58 */
- (__pyx_v_value[__pyx_v_i]) = ' ';
- __pyx_L3:;
- }
- __pyx_L4:;
-
- /* "/home/leif/dv/SPECFEM3D_BASIN/PyxParameters.pyx":59 */
- goto __pyx_L0;
-
- goto __pyx_L0;
- __pyx_L1:;
- Py_XDECREF(__pyx_1);
- Py_XDECREF(__pyx_2);
- Py_XDECREF(__pyx_3);
- Py_XDECREF(__pyx_5);
- __Pyx_AddTraceback("PyxParameters.read_value_string");
- __pyx_L0:;
- Py_DECREF(__pyx_v_attrName);
- Py_DECREF(__pyx_v_v);
-}
-
-__PYX_EXTERN_C DL_EXPORT(void) FC_FUNC_(open_parameter_file, OPEN_PARAMETER_FILE)(void) {
-
- /* "/home/leif/dv/SPECFEM3D_BASIN/PyxParameters.pyx":62 */
- goto __pyx_L0;
-
- goto __pyx_L0;
- __pyx_L1:;
- __Pyx_AddTraceback("PyxParameters.open_parameter_file");
- __pyx_L0:;
-}
-
-__PYX_EXTERN_C DL_EXPORT(void) FC_FUNC_(close_parameter_file, CLOSE_PARAMETER_FILE)(void) {
-
- /* "/home/leif/dv/SPECFEM3D_BASIN/PyxParameters.pyx":65 */
- goto __pyx_L0;
-
- goto __pyx_L0;
- __pyx_L1:;
- __Pyx_AddTraceback("PyxParameters.close_parameter_file");
- __pyx_L0:;
-}
-
-__PYX_EXTERN_C DL_EXPORT(void) FC_FUNC_(get_value_integer, GET_VALUE_INTEGER)(int (*__pyx_v_value),char (*__pyx_v_name),int (*__pyx_v_default),int __pyx_v_nameLen) {
-
- /* "/home/leif/dv/SPECFEM3D_BASIN/PyxParameters.pyx":68 */
- (__pyx_v_value[0]) = (__pyx_v_default[0]);
-
- /* "/home/leif/dv/SPECFEM3D_BASIN/PyxParameters.pyx":69 */
- FC_FUNC_(read_value_integer, READ_VALUE_INTEGER)(__pyx_v_value,__pyx_v_name,__pyx_v_nameLen); if (PyErr_Occurred()) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 69; goto __pyx_L1;}
-
- goto __pyx_L0;
- __pyx_L1:;
- __Pyx_WriteUnraisable("PyxParameters.get_value_integer");
- __pyx_L0:;
-}
-
-__PYX_EXTERN_C DL_EXPORT(void) FC_FUNC_(get_value_double_precision, GET_VALUE_DOUBLE_PRECISION)(double (*__pyx_v_value),char (*__pyx_v_name),double (*__pyx_v_default),int __pyx_v_nameLen) {
-
- /* "/home/leif/dv/SPECFEM3D_BASIN/PyxParameters.pyx":72 */
- (__pyx_v_value[0]) = (__pyx_v_default[0]);
-
- /* "/home/leif/dv/SPECFEM3D_BASIN/PyxParameters.pyx":73 */
- FC_FUNC_(read_value_double_precision, READ_VALUE_DOUBLE_PRECISION)(__pyx_v_value,__pyx_v_name,__pyx_v_nameLen); if (PyErr_Occurred()) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 73; goto __pyx_L1;}
-
- goto __pyx_L0;
- __pyx_L1:;
- __Pyx_WriteUnraisable("PyxParameters.get_value_double_precision");
- __pyx_L0:;
-}
-
-__PYX_EXTERN_C DL_EXPORT(void) FC_FUNC_(get_value_logical, GET_VALUE_LOGICAL)(int (*__pyx_v_value),char (*__pyx_v_name),int (*__pyx_v_default),int __pyx_v_nameLen) {
-
- /* "/home/leif/dv/SPECFEM3D_BASIN/PyxParameters.pyx":76 */
- (__pyx_v_value[0]) = (__pyx_v_default[0]);
-
- /* "/home/leif/dv/SPECFEM3D_BASIN/PyxParameters.pyx":77 */
- FC_FUNC_(read_value_logical, READ_VALUE_LOGICAL)(__pyx_v_value,__pyx_v_name,__pyx_v_nameLen); if (PyErr_Occurred()) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 77; goto __pyx_L1;}
-
- goto __pyx_L0;
- __pyx_L1:;
- __Pyx_WriteUnraisable("PyxParameters.get_value_logical");
- __pyx_L0:;
-}
-
-__PYX_EXTERN_C DL_EXPORT(void) FC_FUNC_(get_value_string, GET_VALUE_STRING)(char (*__pyx_v_value),char (*__pyx_v_name),char (*__pyx_v_default),int __pyx_v_valueLen,int __pyx_v_nameLen,int __pyx_v_defaultLen) {
- PyObject *__pyx_v_i;
- int __pyx_1;
- long __pyx_2;
- PyObject *__pyx_3 = 0;
- __pyx_v_i = Py_None; Py_INCREF(Py_None);
-
- /* "/home/leif/dv/SPECFEM3D_BASIN/PyxParameters.pyx":80 */
- __pyx_1 = (__pyx_v_defaultLen > __pyx_v_valueLen);
- if (__pyx_1) {
-
- /* "/home/leif/dv/SPECFEM3D_BASIN/PyxParameters.pyx":81 */
- strncpy(__pyx_v_value,__pyx_v_default,__pyx_v_valueLen);
- goto __pyx_L2;
- }
- /*else*/ {
-
- /* "/home/leif/dv/SPECFEM3D_BASIN/PyxParameters.pyx":83 */
- strncpy(__pyx_v_value,__pyx_v_default,__pyx_v_defaultLen);
-
- /* "/home/leif/dv/SPECFEM3D_BASIN/PyxParameters.pyx":84 */
- for (__pyx_2 = __pyx_v_defaultLen; __pyx_2 < __pyx_v_valueLen; ++__pyx_2) {
- __pyx_3 = PyInt_FromLong(__pyx_2); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 84; goto __pyx_L1;}
- Py_DECREF(__pyx_v_i);
- __pyx_v_i = __pyx_3;
- __pyx_3 = 0;
-
- /* "/home/leif/dv/SPECFEM3D_BASIN/PyxParameters.pyx":85 */
- __pyx_1 = PyInt_AsLong(__pyx_v_i); if (PyErr_Occurred()) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 85; goto __pyx_L1;}
- (__pyx_v_value[__pyx_1]) = ' ';
- __pyx_L3:;
- }
- __pyx_L4:;
- }
- __pyx_L2:;
-
- /* "/home/leif/dv/SPECFEM3D_BASIN/PyxParameters.pyx":86 */
- FC_FUNC_(read_value_string, READ_VALUE_STRING)(__pyx_v_value,__pyx_v_name,__pyx_v_valueLen,__pyx_v_nameLen); if (PyErr_Occurred()) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 86; goto __pyx_L1;}
-
- goto __pyx_L0;
- __pyx_L1:;
- Py_XDECREF(__pyx_3);
- __Pyx_WriteUnraisable("PyxParameters.get_value_string");
- __pyx_L0:;
- Py_DECREF(__pyx_v_i);
-}
-
-static PyObject *__pyx_f_13PyxParameters_create_header_file(PyObject *__pyx_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
-static char __pyx_doc_13PyxParameters_create_header_file[] = "Create the include file for the solver.";
-static PyObject *__pyx_f_13PyxParameters_create_header_file(PyObject *__pyx_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
- PyObject *__pyx_v_arg = 0;
- PyObject *__pyx_r;
- static char *__pyx_argnames[] = {"arg",0};
- if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "O", __pyx_argnames, &__pyx_v_arg)) return 0;
- Py_INCREF(__pyx_v_arg);
-
- /* "/home/leif/dv/SPECFEM3D_BASIN/PyxParameters.pyx":95 */
- if (PyObject_SetAttr(__pyx_m, __pyx_n_component, __pyx_v_arg) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 95; goto __pyx_L1;}
-
- /* "/home/leif/dv/SPECFEM3D_BASIN/PyxParameters.pyx":96 */
- FC_FUNC_(create_header_file, CREATE_HEADER_FILE)(); if (PyErr_Occurred()) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 96; goto __pyx_L1;}
-
- __pyx_r = Py_None; Py_INCREF(Py_None);
- goto __pyx_L0;
- __pyx_L1:;
- __Pyx_AddTraceback("PyxParameters.create_header_file");
- __pyx_r = 0;
- __pyx_L0:;
- Py_DECREF(__pyx_v_arg);
- return __pyx_r;
-}
-
-static __Pyx_InternTabEntry __pyx_intern_tab[] = {
- {&__pyx_n_ValueError, "ValueError"},
- {&__pyx_n_component, "component"},
- {&__pyx_n_create_header_file, "create_header_file"},
- {&__pyx_n_getValue, "getValue"},
- {&__pyx_n_getattr, "getattr"},
- {&__pyx_n_len, "len"},
- {&__pyx_n_split, "split"},
- {0, 0}
-};
-
-static __Pyx_StringTabEntry __pyx_string_tab[] = {
- {&__pyx_k1p, __pyx_k1, sizeof(__pyx_k1)},
- {&__pyx_k2p, __pyx_k2, sizeof(__pyx_k2)},
- {0, 0, 0}
-};
-
-static struct PyMethodDef __pyx_methods[] = {
- {"getValue", (PyCFunction)__pyx_f_13PyxParameters_getValue, METH_VARARGS|METH_KEYWORDS, __pyx_doc_13PyxParameters_getValue},
- {"create_header_file", (PyCFunction)__pyx_f_13PyxParameters_create_header_file, METH_VARARGS|METH_KEYWORDS, __pyx_doc_13PyxParameters_create_header_file},
- {0, 0, 0, 0}
-};
-
-static void __pyx_init_filenames(void); /*proto*/
-
-PyMODINIT_FUNC initPyxParameters(void); /*proto*/
-PyMODINIT_FUNC initPyxParameters(void) {
- __pyx_init_filenames();
- __pyx_m = Py_InitModule4("PyxParameters", __pyx_methods, __pyx_mdoc, 0, PYTHON_API_VERSION);
- if (!__pyx_m) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 4; goto __pyx_L1;};
- __pyx_b = PyImport_AddModule("__builtin__");
- if (!__pyx_b) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 4; goto __pyx_L1;};
- if (PyObject_SetAttrString(__pyx_m, "__builtins__", __pyx_b) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 4; goto __pyx_L1;};
- if (__Pyx_InternStrings(__pyx_intern_tab) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 4; goto __pyx_L1;};
- if (__Pyx_InitStrings(__pyx_string_tab) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 4; goto __pyx_L1;};
-
- /* "/home/leif/dv/SPECFEM3D_BASIN/PyxParameters.pyx":22 */
- if (PyObject_SetAttr(__pyx_m, __pyx_n_component, Py_None) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 22; goto __pyx_L1;}
-
- /* "/home/leif/dv/SPECFEM3D_BASIN/PyxParameters.pyx":92 */
- return;
- __pyx_L1:;
- __Pyx_AddTraceback("PyxParameters");
-}
-
-static char *__pyx_filenames[] = {
- "PyxParameters.pyx",
-};
-
-/* Runtime support code */
-
-static void __pyx_init_filenames(void) {
- __pyx_f = __pyx_filenames;
-}
-
-static PyObject *__Pyx_GetName(PyObject *dict, PyObject *name) {
- PyObject *result;
- result = PyObject_GetAttr(dict, name);
- if (!result)
- PyErr_SetObject(PyExc_NameError, name);
- return result;
-}
-
-static void __Pyx_Raise(PyObject *type, PyObject *value, PyObject *tb) {
- Py_XINCREF(type);
- Py_XINCREF(value);
- Py_XINCREF(tb);
- /* First, check the traceback argument, replacing None with NULL. */
- if (tb == Py_None) {
- Py_DECREF(tb);
- tb = 0;
- }
- else if (tb != NULL && !PyTraceBack_Check(tb)) {
- PyErr_SetString(PyExc_TypeError,
- "raise: arg 3 must be a traceback or None");
- goto raise_error;
- }
- /* Next, replace a missing value with None */
- if (value == NULL) {
- value = Py_None;
- Py_INCREF(value);
- }
- /* Next, repeatedly, replace a tuple exception with its first item */
- while (PyTuple_Check(type) && PyTuple_Size(type) > 0) {
- PyObject *tmp = type;
- type = PyTuple_GET_ITEM(type, 0);
- Py_INCREF(type);
- Py_DECREF(tmp);
- }
- if (PyString_Check(type))
- ;
- else if (PyClass_Check(type))
- ; /*PyErr_NormalizeException(&type, &value, &tb);*/
- else if (PyInstance_Check(type)) {
- /* Raising an instance. The value should be a dummy. */
- if (value != Py_None) {
- PyErr_SetString(PyExc_TypeError,
- "instance exception may not have a separate value");
- goto raise_error;
- }
- else {
- /* Normalize to raise <class>, <instance> */
- Py_DECREF(value);
- value = type;
- type = (PyObject*) ((PyInstanceObject*)type)->in_class;
- Py_INCREF(type);
- }
- }
- else {
- /* Not something you can raise. You get an exception
- anyway, just not what you specified :-) */
- PyErr_Format(PyExc_TypeError,
- "exceptions must be strings, classes, or "
- "instances, not %s", type->ob_type->tp_name);
- goto raise_error;
- }
- PyErr_Restore(type, value, tb);
- return;
-raise_error:
- Py_XDECREF(value);
- Py_XDECREF(type);
- Py_XDECREF(tb);
- return;
-}
-
-static void __Pyx_WriteUnraisable(char *name) {
- PyObject *old_exc, *old_val, *old_tb;
- PyObject *ctx;
- PyErr_Fetch(&old_exc, &old_val, &old_tb);
- ctx = PyString_FromString(name);
- PyErr_Restore(old_exc, old_val, old_tb);
- if (!ctx)
- ctx = Py_None;
- PyErr_WriteUnraisable(ctx);
-}
-
-static int __Pyx_InternStrings(__Pyx_InternTabEntry *t) {
- while (t->p) {
- *t->p = PyString_InternFromString(t->s);
- if (!*t->p)
- return -1;
- ++t;
- }
- return 0;
-}
-
-static int __Pyx_InitStrings(__Pyx_StringTabEntry *t) {
- while (t->p) {
- *t->p = PyString_FromStringAndSize(t->s, t->n - 1);
- if (!*t->p)
- return -1;
- ++t;
- }
- return 0;
-}
-
-#include "compile.h"
-#include "frameobject.h"
-#include "traceback.h"
-
-static void __Pyx_AddTraceback(char *funcname) {
- PyObject *py_srcfile = 0;
- PyObject *py_funcname = 0;
- PyObject *py_globals = 0;
- PyObject *empty_tuple = 0;
- PyObject *empty_string = 0;
- PyCodeObject *py_code = 0;
- PyFrameObject *py_frame = 0;
-
- py_srcfile = PyString_FromString(__pyx_filename);
- if (!py_srcfile) goto bad;
- py_funcname = PyString_FromString(funcname);
- if (!py_funcname) goto bad;
- py_globals = PyModule_GetDict(__pyx_m);
- if (!py_globals) goto bad;
- empty_tuple = PyTuple_New(0);
- if (!empty_tuple) goto bad;
- empty_string = PyString_FromString("");
- if (!empty_string) goto bad;
- py_code = PyCode_New(
- 0, /*int argcount,*/
- 0, /*int nlocals,*/
- 0, /*int stacksize,*/
- 0, /*int flags,*/
- empty_string, /*PyObject *code,*/
- empty_tuple, /*PyObject *consts,*/
- empty_tuple, /*PyObject *names,*/
- empty_tuple, /*PyObject *varnames,*/
- empty_tuple, /*PyObject *freevars,*/
- empty_tuple, /*PyObject *cellvars,*/
- py_srcfile, /*PyObject *filename,*/
- py_funcname, /*PyObject *name,*/
- __pyx_lineno, /*int firstlineno,*/
- empty_string /*PyObject *lnotab*/
- );
- if (!py_code) goto bad;
- py_frame = PyFrame_New(
- PyThreadState_Get(), /*PyThreadState *tstate,*/
- py_code, /*PyCodeObject *code,*/
- py_globals, /*PyObject *globals,*/
- 0 /*PyObject *locals*/
- );
- if (!py_frame) goto bad;
- py_frame->f_lineno = __pyx_lineno;
- PyTraceBack_Here(py_frame);
-bad:
- Py_XDECREF(py_srcfile);
- Py_XDECREF(py_funcname);
- Py_XDECREF(empty_tuple);
- Py_XDECREF(empty_string);
- Py_XDECREF(py_code);
- Py_XDECREF(py_frame);
-}
Deleted: seismo/3D/SPECFEM3D_SESAME/trunk/PyxParameters.pyx
===================================================================
--- seismo/3D/SPECFEM3D_SESAME/trunk/PyxParameters.pyx 2009-03-12 16:31:24 UTC (rev 14300)
+++ seismo/3D/SPECFEM3D_SESAME/trunk/PyxParameters.pyx 2009-03-12 17:37:00 UTC (rev 14301)
@@ -1,99 +0,0 @@
-# Process this file with Pyrex to produce PyxParameters.c
-
-
-"""Python bindings for the SPECFEM3D Global Solver."""
-
-
-# include 'config.h' in order to get the definitions of FC_FUNC and FC_FUNC_
-cdef extern from "config.h":
- pass
-
-
-cdef extern from "string.h":
- char *strncpy(char *, char *, int)
-
-
-cdef extern from "Python.h":
- object PyString_FromStringAndSize(char *, int)
-
-
-# In the future, this could be passed through the Fortran layer as an
-# opaque context argument.
-component = None
-
-
-def getValue(o, name):
- """Get a value from the Python scripts."""
- l = name.split('.')
- for n in l:
- o = getattr(o, n)
- return o
-
-
-# replacements for Fortran functions
-
-cdef public void read_value_integer "FC_FUNC_(read_value_integer, READ_VALUE_INTEGER)" (int *value, char *name, int nameLen) except *:
- attrName = PyString_FromStringAndSize(name, nameLen)
- value[0] = getValue(component, attrName)
-
-cdef public void read_value_double_precision "FC_FUNC_(read_value_double_precision, READ_VALUE_DOUBLE_PRECISION)" (double *value, char *name, int nameLen) except *:
- attrName = PyString_FromStringAndSize(name, nameLen)
- value[0] = getValue(component, attrName)
-
-cdef public void read_value_logical "FC_FUNC_(read_value_logical, READ_VALUE_LOGICAL)" (int *value, char *name, int nameLen) except *:
- attrName = PyString_FromStringAndSize(name, nameLen)
- value[0] = getValue(component, attrName)
-
-cdef public void read_value_string "FC_FUNC_(read_value_string, READ_VALUE_STRING)" (char *value, char *name, int valueLen, int nameLen) except *:
- cdef char *vp
- cdef int vl, i
- attrName = PyString_FromStringAndSize(name, nameLen)
- v = getValue(component, attrName)
- vl = len(v)
- if vl > valueLen:
- raise ValueError("%s value '%s' is too long (%d bytes) for destination Fortran buffer (%d bytes)" % (attrName, v, vl, valueLen))
- vp = v
- strncpy(value, vp, vl)
- for i from vl <= i < valueLen:
- value[i] = c' '
- return
-
-cdef public void open_parameter_file "FC_FUNC_(open_parameter_file, OPEN_PARAMETER_FILE)" () except *:
- return
-
-cdef public void close_parameter_file "FC_FUNC_(close_parameter_file, CLOSE_PARAMETER_FILE)" () except *:
- return
-
-cdef public void get_value_integer "FC_FUNC_(get_value_integer, GET_VALUE_INTEGER)" (int *value, char *name, int *default, int nameLen):
- value[0] = default[0]
- read_value_integer(value, name, nameLen)
-
-cdef public void get_value_double_precision "FC_FUNC_(get_value_double_precision, GET_VALUE_DOUBLE_PRECISION)" (double *value, char *name, double *default, int nameLen):
- value[0] = default[0]
- read_value_double_precision(value, name, nameLen)
-
-cdef public void get_value_logical "FC_FUNC_(get_value_logical, GET_VALUE_LOGICAL)" (int *value, char *name, int *default, int nameLen):
- value[0] = default[0]
- read_value_logical(value, name, nameLen)
-
-cdef public void get_value_string "FC_FUNC_(get_value_string, GET_VALUE_STRING)" (char *value, char *name, char *default, int valueLen, int nameLen, int defaultLen):
- if defaultLen > valueLen:
- strncpy(value, default, valueLen)
- else:
- strncpy(value, default, defaultLen)
- for i from defaultLen <= i < valueLen:
- value[i] = c' '
- read_value_string(value, name, valueLen, nameLen)
-
-
-# external Fortran functions
-
-cdef extern void create_header_file_f "FC_FUNC_(create_header_file, CREATE_HEADER_FILE)" () except *
-def create_header_file(arg):
- """Create the include file for the solver."""
- global component
- component = arg
- create_header_file_f()
-
-
-# end of file
Deleted: seismo/3D/SPECFEM3D_SESAME/trunk/PyxSpecfem.c
===================================================================
--- seismo/3D/SPECFEM3D_SESAME/trunk/PyxSpecfem.c 2009-03-12 16:31:24 UTC (rev 14300)
+++ seismo/3D/SPECFEM3D_SESAME/trunk/PyxSpecfem.c 2009-03-12 17:37:00 UTC (rev 14301)
@@ -1,235 +0,0 @@
-/* Generated by Pyrex 0.9.4.1 on Wed Jan 10 15:57:12 2007 */
-
-#include "Python.h"
-#include "structmember.h"
-#ifndef PY_LONG_LONG
- #define PY_LONG_LONG LONG_LONG
-#endif
-#ifdef __cplusplus
-#define __PYX_EXTERN_C extern "C"
-#else
-#define __PYX_EXTERN_C extern
-#endif
-__PYX_EXTERN_C double pow(double, double);
-#include "config.h"
-
-
-typedef struct {PyObject **p; char *s;} __Pyx_InternTabEntry; /*proto*/
-typedef struct {PyObject **p; char *s; long n;} __Pyx_StringTabEntry; /*proto*/
-static PyObject *__Pyx_UnpackItem(PyObject *, int); /*proto*/
-static int __Pyx_EndUnpack(PyObject *, int); /*proto*/
-static int __Pyx_PrintItem(PyObject *); /*proto*/
-static int __Pyx_PrintNewline(void); /*proto*/
-static void __Pyx_Raise(PyObject *type, PyObject *value, PyObject *tb); /*proto*/
-static void __Pyx_ReRaise(void); /*proto*/
-static PyObject *__Pyx_Import(PyObject *name, PyObject *from_list); /*proto*/
-static PyObject *__Pyx_GetExcValue(void); /*proto*/
-static int __Pyx_ArgTypeTest(PyObject *obj, PyTypeObject *type, int none_allowed, char *name); /*proto*/
-static int __Pyx_TypeTest(PyObject *obj, PyTypeObject *type); /*proto*/
-static int __Pyx_GetStarArgs(PyObject **args, PyObject **kwds, char *kwd_list[], int nargs, PyObject **args2, PyObject **kwds2); /*proto*/
-static void __Pyx_WriteUnraisable(char *name); /*proto*/
-static void __Pyx_AddTraceback(char *funcname); /*proto*/
-static PyTypeObject *__Pyx_ImportType(char *module_name, char *class_name, long size); /*proto*/
-static int __Pyx_SetVtable(PyObject *dict, void *vtable); /*proto*/
-static int __Pyx_GetVtable(PyObject *dict, void *vtabptr); /*proto*/
-static PyObject *__Pyx_CreateClass(PyObject *bases, PyObject *dict, PyObject *name, char *modname); /*proto*/
-static int __Pyx_InternStrings(__Pyx_InternTabEntry *t); /*proto*/
-static int __Pyx_InitStrings(__Pyx_StringTabEntry *t); /*proto*/
-static PyObject *__Pyx_GetName(PyObject *dict, PyObject *name); /*proto*/
-
-static PyObject *__pyx_m;
-static PyObject *__pyx_b;
-static int __pyx_lineno;
-static char *__pyx_filename;
-static char **__pyx_f;
-
-static char __pyx_mdoc[] = "Python bindings for the SPECFEM3D Global Solver.";
-
-/* Declarations from PyxSpecfem */
-
-__PYX_EXTERN_C void (FC_FUNC(specfem3d, SPECFEM3D)(void)); /*proto*/
-
-/* Implementation of PyxSpecfem */
-
-static PyObject *__pyx_n_specfem3D;
-
-static PyObject *__pyx_n_PyxParameters;
-static PyObject *__pyx_n_component;
-
-
-static PyObject *__pyx_f_10PyxSpecfem_specfem3D(PyObject *__pyx_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
-static char __pyx_doc_10PyxSpecfem_specfem3D[] = "Run the SPECFEM3D Global Solver.";
-static PyObject *__pyx_f_10PyxSpecfem_specfem3D(PyObject *__pyx_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
- PyObject *__pyx_v_arg = 0;
- PyObject *__pyx_v_PyxParameters;
- PyObject *__pyx_r;
- PyObject *__pyx_1 = 0;
- static char *__pyx_argnames[] = {"arg",0};
- if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "O", __pyx_argnames, &__pyx_v_arg)) return 0;
- Py_INCREF(__pyx_v_arg);
- __pyx_v_PyxParameters = Py_None; Py_INCREF(Py_None);
-
- /* "/home/leif/dv/SPECFEM3D_BASIN/PyxSpecfem.pyx":17 */
- __pyx_1 = __Pyx_Import(__pyx_n_PyxParameters, 0); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 17; goto __pyx_L1;}
- Py_DECREF(__pyx_v_PyxParameters);
- __pyx_v_PyxParameters = __pyx_1;
- __pyx_1 = 0;
-
- /* "/home/leif/dv/SPECFEM3D_BASIN/PyxSpecfem.pyx":18 */
- if (PyObject_SetAttr(__pyx_v_PyxParameters, __pyx_n_component, __pyx_v_arg) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 18; goto __pyx_L1;}
-
- /* "/home/leif/dv/SPECFEM3D_BASIN/PyxSpecfem.pyx":19 */
- FC_FUNC(specfem3d, SPECFEM3D)(); if (PyErr_Occurred()) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 19; goto __pyx_L1;}
-
- __pyx_r = Py_None; Py_INCREF(Py_None);
- goto __pyx_L0;
- __pyx_L1:;
- Py_XDECREF(__pyx_1);
- __Pyx_AddTraceback("PyxSpecfem.specfem3D");
- __pyx_r = 0;
- __pyx_L0:;
- Py_DECREF(__pyx_v_PyxParameters);
- Py_DECREF(__pyx_v_arg);
- return __pyx_r;
-}
-
-static __Pyx_InternTabEntry __pyx_intern_tab[] = {
- {&__pyx_n_PyxParameters, "PyxParameters"},
- {&__pyx_n_component, "component"},
- {&__pyx_n_specfem3D, "specfem3D"},
- {0, 0}
-};
-
-static struct PyMethodDef __pyx_methods[] = {
- {"specfem3D", (PyCFunction)__pyx_f_10PyxSpecfem_specfem3D, METH_VARARGS|METH_KEYWORDS, __pyx_doc_10PyxSpecfem_specfem3D},
- {0, 0, 0, 0}
-};
-
-static void __pyx_init_filenames(void); /*proto*/
-
-PyMODINIT_FUNC initPyxSpecfem(void); /*proto*/
-PyMODINIT_FUNC initPyxSpecfem(void) {
- __pyx_init_filenames();
- __pyx_m = Py_InitModule4("PyxSpecfem", __pyx_methods, __pyx_mdoc, 0, PYTHON_API_VERSION);
- if (!__pyx_m) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 4; goto __pyx_L1;};
- __pyx_b = PyImport_AddModule("__builtin__");
- if (!__pyx_b) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 4; goto __pyx_L1;};
- if (PyObject_SetAttrString(__pyx_m, "__builtins__", __pyx_b) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 4; goto __pyx_L1;};
- if (__Pyx_InternStrings(__pyx_intern_tab) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 4; goto __pyx_L1;};
-
- /* "/home/leif/dv/SPECFEM3D_BASIN/PyxSpecfem.pyx":15 */
- return;
- __pyx_L1:;
- __Pyx_AddTraceback("PyxSpecfem");
-}
-
-static char *__pyx_filenames[] = {
- "PyxSpecfem.pyx",
-};
-
-/* Runtime support code */
-
-static void __pyx_init_filenames(void) {
- __pyx_f = __pyx_filenames;
-}
-
-static PyObject *__Pyx_Import(PyObject *name, PyObject *from_list) {
- PyObject *__import__ = 0;
- PyObject *empty_list = 0;
- PyObject *module = 0;
- PyObject *global_dict = 0;
- PyObject *empty_dict = 0;
- PyObject *list;
- __import__ = PyObject_GetAttrString(__pyx_b, "__import__");
- if (!__import__)
- goto bad;
- if (from_list)
- list = from_list;
- else {
- empty_list = PyList_New(0);
- if (!empty_list)
- goto bad;
- list = empty_list;
- }
- global_dict = PyModule_GetDict(__pyx_m);
- if (!global_dict)
- goto bad;
- empty_dict = PyDict_New();
- if (!empty_dict)
- goto bad;
- module = PyObject_CallFunction(__import__, "OOOO",
- name, global_dict, empty_dict, list);
-bad:
- Py_XDECREF(empty_list);
- Py_XDECREF(__import__);
- Py_XDECREF(empty_dict);
- return module;
-}
-
-static int __Pyx_InternStrings(__Pyx_InternTabEntry *t) {
- while (t->p) {
- *t->p = PyString_InternFromString(t->s);
- if (!*t->p)
- return -1;
- ++t;
- }
- return 0;
-}
-
-#include "compile.h"
-#include "frameobject.h"
-#include "traceback.h"
-
-static void __Pyx_AddTraceback(char *funcname) {
- PyObject *py_srcfile = 0;
- PyObject *py_funcname = 0;
- PyObject *py_globals = 0;
- PyObject *empty_tuple = 0;
- PyObject *empty_string = 0;
- PyCodeObject *py_code = 0;
- PyFrameObject *py_frame = 0;
-
- py_srcfile = PyString_FromString(__pyx_filename);
- if (!py_srcfile) goto bad;
- py_funcname = PyString_FromString(funcname);
- if (!py_funcname) goto bad;
- py_globals = PyModule_GetDict(__pyx_m);
- if (!py_globals) goto bad;
- empty_tuple = PyTuple_New(0);
- if (!empty_tuple) goto bad;
- empty_string = PyString_FromString("");
- if (!empty_string) goto bad;
- py_code = PyCode_New(
- 0, /*int argcount,*/
- 0, /*int nlocals,*/
- 0, /*int stacksize,*/
- 0, /*int flags,*/
- empty_string, /*PyObject *code,*/
- empty_tuple, /*PyObject *consts,*/
- empty_tuple, /*PyObject *names,*/
- empty_tuple, /*PyObject *varnames,*/
- empty_tuple, /*PyObject *freevars,*/
- empty_tuple, /*PyObject *cellvars,*/
- py_srcfile, /*PyObject *filename,*/
- py_funcname, /*PyObject *name,*/
- __pyx_lineno, /*int firstlineno,*/
- empty_string /*PyObject *lnotab*/
- );
- if (!py_code) goto bad;
- py_frame = PyFrame_New(
- PyThreadState_Get(), /*PyThreadState *tstate,*/
- py_code, /*PyCodeObject *code,*/
- py_globals, /*PyObject *globals,*/
- 0 /*PyObject *locals*/
- );
- if (!py_frame) goto bad;
- py_frame->f_lineno = __pyx_lineno;
- PyTraceBack_Here(py_frame);
-bad:
- Py_XDECREF(py_srcfile);
- Py_XDECREF(py_funcname);
- Py_XDECREF(empty_tuple);
- Py_XDECREF(empty_string);
- Py_XDECREF(py_code);
- Py_XDECREF(py_frame);
-}
Deleted: seismo/3D/SPECFEM3D_SESAME/trunk/PyxSpecfem.pyx
===================================================================
--- seismo/3D/SPECFEM3D_SESAME/trunk/PyxSpecfem.pyx 2009-03-12 16:31:24 UTC (rev 14300)
+++ seismo/3D/SPECFEM3D_SESAME/trunk/PyxSpecfem.pyx 2009-03-12 17:37:00 UTC (rev 14301)
@@ -1,22 +0,0 @@
-# Process this file with Pyrex to produce PyxSpecfem.c
-
-
-"""Python bindings for the SPECFEM3D Global Solver."""
-
-
-# include 'config.h' in order to get the definitions of FC_FUNC and FC_FUNC_
-cdef extern from "config.h":
- pass
-
-
-# external Fortran functions
-
-cdef extern void specfem3D_f "FC_FUNC(specfem3d, SPECFEM3D)" () except *
-def specfem3D(arg):
- """Run the SPECFEM3D Global Solver."""
- import PyxParameters
- PyxParameters.component = arg
- specfem3D_f()
-
-
-# end of file
Modified: seismo/3D/SPECFEM3D_SESAME/trunk/README_SPECFEM3D
===================================================================
--- seismo/3D/SPECFEM3D_SESAME/trunk/README_SPECFEM3D 2009-03-12 16:31:24 UTC (rev 14300)
+++ seismo/3D/SPECFEM3D_SESAME/trunk/README_SPECFEM3D 2009-03-12 17:37:00 UTC (rev 14301)
@@ -26,7 +26,7 @@
!=============================================================================!
! !
! specfem3D is a 3-D spectral-element solver for a local or regional model. !
-! It uses a mesh generated by program meshfem3D !
+! It uses a mesh generated by program generate_databases !
! !
!=============================================================================!
@@ -123,9 +123,9 @@
(need to set the correct mpirun command at the end of the script)
- runall compiles and runs both mesher and solver
-MESHER (meshfem3D):
+MESHER (generate_databases):
-- The mesher meshfem3D needs NPROC_XI * NPROC_ETA processors. NPROC_XI and
+- The mesher generate_databases needs NPROC_XI * NPROC_ETA processors. NPROC_XI and
NPROC_ETA do not need to be equal.
- Note that NPROC_XI = 1 or NPROC_ETA = 1 is valid (in case you have a
machine with a small number of processors). Therefore the code can
@@ -162,7 +162,7 @@
or OpenDX users, www.opendx.org). Do not use if you do not have AVS
or OpenDX, because this option creates large files.
-- Compile the mesher ("make meshfem3D") and run it with the go_mesher script
+- Compile the mesher ("make generate_databases") and run it with the go_mesher script
- Mesher output is provided in the OUTPUT_FILES directory in output_mesher.txt
(output can be directed to the screen instead by uncommenting two lines
in constants.h:
@@ -266,9 +266,9 @@
To do this, one needs to:
- set NPROC_XI = NPROC_ETA = 1 in DATA/Par_file
-- type "make meshfem3D_serial" and "make specfem3D_serial" instead of
- "make meshfem3D" and "make specfem3D"
-- run the code serially with "./xmeshfem3D" and "./xspecfem3D"
+- type "make generate_databases_serial" and "make specfem3D_serial" instead of
+ "make generate_databases" and "make specfem3D"
+- run the code serially with "./xgenerate_databases" and "./xspecfem3D"
BUG REPORTS:
Modified: seismo/3D/SPECFEM3D_SESAME/trunk/UTILS/external_mesh/TODO_list
===================================================================
--- seismo/3D/SPECFEM3D_SESAME/trunk/UTILS/external_mesh/TODO_list 2009-03-12 16:31:24 UTC (rev 14300)
+++ seismo/3D/SPECFEM3D_SESAME/trunk/UTILS/external_mesh/TODO_list 2009-03-12 17:37:00 UTC (rev 14301)
@@ -1,17 +1,29 @@
+
DESIGN :
+
- The subdivision of the mesh should be done inside meshfem3D (there is actually no point in doing it prior to pre_meshfem). The subdivision itself is already implemented, but we also have to subdivide the communications and any other similar data that concerns elements (absorbing boundaries, PML,...).
+
- Nearly all constants declared in constants.h concerning external meshes (look for string 'nlegoff') should be read/computed from a kind of Par_file. The same goes for the declaration of materials, done with a function in meshfem3D.f90 (and also right now in specfem3D.f90 in case of associating materials after pre_meshfem but we should get rid of it). There are also some variables declared as parameters used in create_movie_AVS_DX.f90.
+
- Materials should be associated to elements before pre_meshfem, but it is not always possible (that was the case for Celine Blitz's asteroid mesh with regolith because of limitations in the CUBIT software with huge meshes). An example of how we can isolate elements in contact with the envelope and associate them with another material is commented in specfem3D.f90 (look for string 'NL NL REGOLITH') tough it should in fact be inside meshfem3D, not specfem3D. Identifying the envelope is based on the NGLL points, so there is no problem with tranfering it to meshfem3D.
+
- Calculations on elements in specfem3D for regular meshes should be merged inside compute_forces (the basic calculation is okay, but not attenuation, absorbing boundaries, ...) as there is no reason to differenciate those.
MISC :
+
- The following default options in flags.guess -qlanglvl=2003pure (for xlf) and -std=f2003 (for gfortran) causes some problems with intrinsics. There might be a better way than to simply remove these options.
+
- Reading the file DATA/STATIONS_FILTERED with pgf90 returned an error, because it considered that the lines were truncated, thus failed to read some data even when DATA/STATIONS_FILTERED was also generated by pgf90. Go figures. There might be a better workaround than simply removing writing of blanks ' ' (see rev).
Add-ONS :
+
- Receivers distance to source along the surface computed for an asteroid can be done by computing the shortest path in a graph. No problem in serial, doing so in parallel might be tricky.
+
- Partitioning should be done in meshfem3D, using a parallel partitioner such as ParMETIS and/or SCOTCH (PT-SCOTCH). Reading the (distributed or not) mesh, building the graph, distributing, and partitioning is not a problem, but redistributing the graph/mesh according to the partitioning obtained might well be.
+
- Adding absorbing boundaries, attenuation, PML, moment sources, ... for external meshes.
+
- Differentiate between elements in contact with the envelope, and those that are in contact with a fracture : source, receivers, ... anything based on the envelope detection will have to take into account those fractures. Really tricky without prior information on the mesh.
+
- Settle the issue of normal recording for the receivers. The normal is unique, but the plane can be described using two vectors at random (while conserving an orthonormal reference), so we have no reason to choose a pair of vectors compared to the others.i
Copied: seismo/3D/SPECFEM3D_SESAME/trunk/UTILS/external_mesh/model_asteroid_subdivide/decimate_mesh.f90 (from rev 14285, seismo/3D/SPECFEM3D_SESAME/trunk/UTILS/external_mesh/model_asteroid_subdivide/sub.f90)
===================================================================
--- seismo/3D/SPECFEM3D_SESAME/trunk/UTILS/external_mesh/model_asteroid_subdivide/decimate_mesh.f90 (rev 0)
+++ seismo/3D/SPECFEM3D_SESAME/trunk/UTILS/external_mesh/model_asteroid_subdivide/decimate_mesh.f90 2009-03-12 17:37:00 UTC (rev 14301)
@@ -0,0 +1,594 @@
+
+ program decimate_mesh
+
+! mesh decimation, by Nicolas Le Goff, 2008
+
+! cuts each hexahedron of a given mesh in 8 hexahedra (2 * 2 * 2)
+! recursively in order to increase mesh density by a factor of 2
+
+ implicit none
+
+ include './constants.h'
+
+ integer :: nelmnts_ext_mesh
+ integer, dimension(:,:), allocatable :: elmnts_ext_mesh
+ integer, dimension(:,:), allocatable :: elmnts_ext_mesh_sub
+ integer, dimension(:), allocatable :: mat_ext_mesh
+ integer, dimension(:), allocatable :: mat_ext_mesh_sub
+
+ integer :: nnodes_ext_mesh
+ real, dimension(:,:), allocatable :: nodes_coords_ext_mesh
+ real, dimension(:,:), allocatable :: nodes_coords_ext_mesh_sub
+
+ real, dimension(NDIM,NSUB+1,NSUB+1,NSUB+1) :: temporary_nodes
+ integer, dimension(NSUB+1,NSUB+1,NSUB+1) :: temporary_nodes_lookup
+
+ integer, dimension(:), allocatable :: xadj
+ integer, dimension(:), allocatable :: adjncy
+ integer, dimension(:), allocatable :: nnodes_elmnts
+ integer, dimension(:), allocatable :: nodes_elmnts
+
+ integer :: ispec, inode, ispec_neighbours, ispec_neighbours_sub
+ integer :: nnodes_ext_mesh_sub
+ integer :: i, j, k
+ integer :: ix, iy, iz
+ integer :: idim
+
+ real :: xtol
+
+ real :: xminval,yminval,xmaxval,ymaxval,xtypdist,zminval,zmaxval
+
+ open(unit=98, file='./mesh', status='old', form='formatted')
+ read(98,*) nelmnts_ext_mesh
+ allocate(elmnts_ext_mesh(ESIZE,nelmnts_ext_mesh))
+ do ispec = 1, nelmnts_ext_mesh
+ read(98,*) elmnts_ext_mesh(1,ispec), elmnts_ext_mesh(2,ispec), elmnts_ext_mesh(3,ispec), elmnts_ext_mesh(4,ispec), &
+ elmnts_ext_mesh(5,ispec), elmnts_ext_mesh(6,ispec), elmnts_ext_mesh(7,ispec), elmnts_ext_mesh(8,ispec)
+ end do
+ close(98)
+
+ open(unit=98, file='./mat', status='old', form='formatted')
+ allocate(mat_ext_mesh(nelmnts_ext_mesh))
+ do ispec = 1, nelmnts_ext_mesh
+ read(98,*) mat_ext_mesh(ispec)
+ end do
+ close(98)
+
+ open(unit=98, file='./nodes_coords', status='old', form='formatted')
+ read(98,*) nnodes_ext_mesh
+ allocate(nodes_coords_ext_mesh(NDIM,nnodes_ext_mesh))
+ do inode = 1, nnodes_ext_mesh
+ read(98,*) nodes_coords_ext_mesh(1,inode), nodes_coords_ext_mesh(2,inode),nodes_coords_ext_mesh(3,inode)
+ end do
+ close(98)
+
+
+! check that there really are 8 nodes per element.
+ do ispec = 1, nelmnts_ext_mesh
+ do inode = 1, ESIZE
+ do ix = inode+1, ESIZE
+ if (elmnts_ext_mesh(inode,ispec) == elmnts_ext_mesh(ix,ispec)) then
+ stop 'ERRORERROR'
+ endif
+ enddo
+
+ enddo
+enddo
+
+! set up local geometric tolerances
+ xtypdist=+HUGEVAL
+
+ do ispec=1,nelmnts_ext_mesh
+
+ xminval=+HUGEVAL
+ yminval=+HUGEVAL
+ zminval=+HUGEVAL
+ xmaxval=-HUGEVAL
+ ymaxval=-HUGEVAL
+ zmaxval=-HUGEVAL
+
+ do inode = 1, 8
+ xmaxval=max(nodes_coords_ext_mesh(1,elmnts_ext_mesh(inode,ispec)),xmaxval)
+ xminval=min(nodes_coords_ext_mesh(1,elmnts_ext_mesh(inode,ispec)),xminval)
+ ymaxval=max(nodes_coords_ext_mesh(2,elmnts_ext_mesh(inode,ispec)),ymaxval)
+ yminval=min(nodes_coords_ext_mesh(2,elmnts_ext_mesh(inode,ispec)),yminval)
+ zmaxval=max(nodes_coords_ext_mesh(3,elmnts_ext_mesh(inode,ispec)),zmaxval)
+ zminval=min(nodes_coords_ext_mesh(3,elmnts_ext_mesh(inode,ispec)),zminval)
+ enddo
+
+! compute the minimum typical "size" of an element in the mesh
+ xtypdist = min(xtypdist,xmaxval-xminval)
+ xtypdist = min(xtypdist,ymaxval-yminval)
+ xtypdist = min(xtypdist,zmaxval-zminval)
+ !xtypdist = min(xtypdist,sqrt((xmaxval-xminval)**2 + (ymaxval-yminval)**2 + (zmaxval-zminval)**2))
+
+ enddo
+
+! define a tolerance, small with respect to the minimum size
+ xtol=smallval_tol*xtypdist*1.d7
+
+ print *, 'xtypdist' , xtypdist
+ print *, 'facteur de tolerance XTOL = ', xtol
+
+ print *, 'xmin', minval(nodes_coords_ext_mesh(1,:))
+ print *, 'xmax', maxval(nodes_coords_ext_mesh(1,:))
+ print *, 'ymin', minval(nodes_coords_ext_mesh(2,:))
+ print *, 'ymax', maxval(nodes_coords_ext_mesh(2,:))
+ print *, 'zmin', minval(nodes_coords_ext_mesh(3,:))
+ print *, 'zmax', maxval(nodes_coords_ext_mesh(3,:))
+
+
+
+! we build the graph
+ elmnts_ext_mesh(:,:) = elmnts_ext_mesh(:,:) - 1
+
+ allocate(xadj(1:nelmnts_ext_mesh+1))
+ allocate(adjncy(1:MAX_NEIGHBOURS*nelmnts_ext_mesh))
+ allocate(nnodes_elmnts(1:nnodes_ext_mesh))
+ allocate(nodes_elmnts(1:NSIZE*nnodes_ext_mesh))
+
+ call mesh2dual_ncommonnodes(nelmnts_ext_mesh, nnodes_ext_mesh, elmnts_ext_mesh, xadj, adjncy, nnodes_elmnts, nodes_elmnts,1)
+
+ print *, 'ZZZZ'
+
+ elmnts_ext_mesh(:,:) = elmnts_ext_mesh(:,:) + 1
+ adjncy(:) = adjncy(:) + 1
+ xadj(:) = xadj(:) + 1
+
+ allocate(elmnts_ext_mesh_sub(ESIZE,nelmnts_ext_mesh*NSUB*NSUB*NSUB))
+ allocate(nodes_coords_ext_mesh_sub(NDIM,ESIZE*nelmnts_ext_mesh*(NSUB+1)*(NSUB+1)*(NSUB+1)))
+ allocate(mat_ext_mesh_sub(nelmnts_ext_mesh*NSUB*NSUB*NSUB))
+
+ nnodes_ext_mesh_sub = 0
+
+ do ispec = 1, nelmnts_ext_mesh
+
+ do ix = 1, NSUB+1
+
+ temporary_nodes(1,ix,1,1) = nodes_coords_ext_mesh(1,elmnts_ext_mesh(1,ispec)) + &
+ ( (nodes_coords_ext_mesh(1,elmnts_ext_mesh(2,ispec)) - nodes_coords_ext_mesh(1,elmnts_ext_mesh(1,ispec))) &
+ / real(NSUB)) * (ix-1)
+ temporary_nodes(2,ix,1,1) = nodes_coords_ext_mesh(2,elmnts_ext_mesh(1,ispec)) + &
+ ( (nodes_coords_ext_mesh(2,elmnts_ext_mesh(2,ispec)) - nodes_coords_ext_mesh(2,elmnts_ext_mesh(1,ispec))) &
+ / real(NSUB)) * (ix-1)
+ temporary_nodes(3,ix,1,1) = nodes_coords_ext_mesh(3,elmnts_ext_mesh(1,ispec)) + &
+ ( (nodes_coords_ext_mesh(3,elmnts_ext_mesh(2,ispec)) - nodes_coords_ext_mesh(3,elmnts_ext_mesh(1,ispec))) &
+ / real(NSUB)) * (ix-1)
+
+ temporary_nodes(1,ix,NSUB+1,1) = nodes_coords_ext_mesh(1,elmnts_ext_mesh(4,ispec)) + &
+ ( (nodes_coords_ext_mesh(1,elmnts_ext_mesh(3,ispec)) - nodes_coords_ext_mesh(1,elmnts_ext_mesh(4,ispec))) &
+ / real(NSUB)) * (ix-1)
+ temporary_nodes(2,ix,NSUB+1,1) = nodes_coords_ext_mesh(2,elmnts_ext_mesh(4,ispec)) + &
+ ( (nodes_coords_ext_mesh(2,elmnts_ext_mesh(3,ispec)) - nodes_coords_ext_mesh(2,elmnts_ext_mesh(4,ispec))) &
+ / real(NSUB)) * (ix-1)
+ temporary_nodes(3,ix,NSUB+1,1) = nodes_coords_ext_mesh(3,elmnts_ext_mesh(4,ispec)) + &
+ ( (nodes_coords_ext_mesh(3,elmnts_ext_mesh(3,ispec)) - nodes_coords_ext_mesh(3,elmnts_ext_mesh(4,ispec))) &
+ / real(NSUB)) * (ix-1)
+
+ temporary_nodes(1,ix,1,NSUB+1) = nodes_coords_ext_mesh(1,elmnts_ext_mesh(5,ispec)) + &
+ ( (nodes_coords_ext_mesh(1,elmnts_ext_mesh(6,ispec)) - nodes_coords_ext_mesh(1,elmnts_ext_mesh(5,ispec))) &
+ / real(NSUB)) * (ix-1)
+ temporary_nodes(2,ix,1,NSUB+1) = nodes_coords_ext_mesh(2,elmnts_ext_mesh(5,ispec)) + &
+ ( (nodes_coords_ext_mesh(2,elmnts_ext_mesh(6,ispec)) - nodes_coords_ext_mesh(2,elmnts_ext_mesh(5,ispec))) &
+ / real(NSUB)) * (ix-1)
+ temporary_nodes(3,ix,1,NSUB+1) = nodes_coords_ext_mesh(3,elmnts_ext_mesh(5,ispec)) + &
+ ( (nodes_coords_ext_mesh(3,elmnts_ext_mesh(6,ispec)) - nodes_coords_ext_mesh(3,elmnts_ext_mesh(5,ispec))) &
+ / real(NSUB)) * (ix-1)
+
+ temporary_nodes(1,ix,NSUB+1,NSUB+1) = nodes_coords_ext_mesh(1,elmnts_ext_mesh(8,ispec)) + &
+ ( (nodes_coords_ext_mesh(1,elmnts_ext_mesh(7,ispec)) - nodes_coords_ext_mesh(1,elmnts_ext_mesh(8,ispec))) &
+ / real(NSUB)) * (ix-1)
+ temporary_nodes(2,ix,NSUB+1,NSUB+1) = nodes_coords_ext_mesh(2,elmnts_ext_mesh(8,ispec)) + &
+ ( (nodes_coords_ext_mesh(2,elmnts_ext_mesh(7,ispec)) - nodes_coords_ext_mesh(2,elmnts_ext_mesh(8,ispec))) &
+ / real(NSUB)) * (ix-1)
+ temporary_nodes(3,ix,NSUB+1,NSUB+1) = nodes_coords_ext_mesh(3,elmnts_ext_mesh(8,ispec)) + &
+ ( (nodes_coords_ext_mesh(3,elmnts_ext_mesh(7,ispec)) - nodes_coords_ext_mesh(3,elmnts_ext_mesh(8,ispec))) &
+ / real(NSUB)) * (ix-1)
+
+ enddo
+
+ do iy = 1, NSUB+1
+
+ temporary_nodes(1,1,iy,1) = nodes_coords_ext_mesh(1,elmnts_ext_mesh(1,ispec)) + &
+ ( (nodes_coords_ext_mesh(1,elmnts_ext_mesh(4,ispec)) - nodes_coords_ext_mesh(1,elmnts_ext_mesh(1,ispec))) &
+ / real(NSUB)) * (iy-1)
+ temporary_nodes(2,1,iy,1) = nodes_coords_ext_mesh(2,elmnts_ext_mesh(1,ispec)) + &
+ ( (nodes_coords_ext_mesh(2,elmnts_ext_mesh(4,ispec)) - nodes_coords_ext_mesh(2,elmnts_ext_mesh(1,ispec))) &
+ / real(NSUB)) * (iy-1)
+ temporary_nodes(3,1,iy,1) = nodes_coords_ext_mesh(3,elmnts_ext_mesh(1,ispec)) + &
+ ( (nodes_coords_ext_mesh(3,elmnts_ext_mesh(4,ispec)) - nodes_coords_ext_mesh(3,elmnts_ext_mesh(1,ispec))) &
+ / real(NSUB)) * (iy-1)
+
+ temporary_nodes(1,NSUB+1,iy,1) = nodes_coords_ext_mesh(1,elmnts_ext_mesh(2,ispec)) + &
+ ( (nodes_coords_ext_mesh(1,elmnts_ext_mesh(3,ispec)) - nodes_coords_ext_mesh(1,elmnts_ext_mesh(2,ispec))) &
+ / real(NSUB)) * (iy-1)
+ temporary_nodes(2,NSUB+1,iy,1) = nodes_coords_ext_mesh(2,elmnts_ext_mesh(2,ispec)) + &
+ ( (nodes_coords_ext_mesh(2,elmnts_ext_mesh(3,ispec)) - nodes_coords_ext_mesh(2,elmnts_ext_mesh(2,ispec))) &
+ / real(NSUB)) * (iy-1)
+ temporary_nodes(3,NSUB+1,iy,1) = nodes_coords_ext_mesh(3,elmnts_ext_mesh(2,ispec)) + &
+ ( (nodes_coords_ext_mesh(3,elmnts_ext_mesh(3,ispec)) - nodes_coords_ext_mesh(3,elmnts_ext_mesh(2,ispec))) &
+ / real(NSUB)) * (iy-1)
+
+ temporary_nodes(1,1,iy,NSUB+1) = nodes_coords_ext_mesh(1,elmnts_ext_mesh(5,ispec)) + &
+ ( (nodes_coords_ext_mesh(1,elmnts_ext_mesh(8,ispec)) - nodes_coords_ext_mesh(1,elmnts_ext_mesh(5,ispec))) &
+ / real(NSUB)) * (iy-1)
+ temporary_nodes(2,1,iy,NSUB+1) = nodes_coords_ext_mesh(2,elmnts_ext_mesh(5,ispec)) + &
+ ( (nodes_coords_ext_mesh(2,elmnts_ext_mesh(8,ispec)) - nodes_coords_ext_mesh(2,elmnts_ext_mesh(5,ispec))) &
+ / real(NSUB)) * (iy-1)
+ temporary_nodes(3,1,iy,NSUB+1) = nodes_coords_ext_mesh(3,elmnts_ext_mesh(5,ispec)) + &
+ ( (nodes_coords_ext_mesh(3,elmnts_ext_mesh(8,ispec)) - nodes_coords_ext_mesh(3,elmnts_ext_mesh(5,ispec))) &
+ / real(NSUB)) * (iy-1)
+
+ temporary_nodes(1,NSUB+1,iy,NSUB+1) = nodes_coords_ext_mesh(1,elmnts_ext_mesh(6,ispec)) + &
+ ( (nodes_coords_ext_mesh(1,elmnts_ext_mesh(7,ispec)) - nodes_coords_ext_mesh(1,elmnts_ext_mesh(6,ispec))) &
+ / real(NSUB)) * (iy-1)
+ temporary_nodes(2,NSUB+1,iy,NSUB+1) = nodes_coords_ext_mesh(2,elmnts_ext_mesh(6,ispec)) + &
+ ( (nodes_coords_ext_mesh(2,elmnts_ext_mesh(7,ispec)) - nodes_coords_ext_mesh(2,elmnts_ext_mesh(6,ispec))) &
+ / real(NSUB)) * (iy-1)
+ temporary_nodes(3,NSUB+1,iy,NSUB+1) = nodes_coords_ext_mesh(3,elmnts_ext_mesh(6,ispec)) + &
+ ( (nodes_coords_ext_mesh(3,elmnts_ext_mesh(7,ispec)) - nodes_coords_ext_mesh(3,elmnts_ext_mesh(6,ispec))) &
+ / real(NSUB)) * (iy-1)
+
+ enddo
+
+ do iz = 1, NSUB+1
+
+ temporary_nodes(1,1,1,iz) = nodes_coords_ext_mesh(1,elmnts_ext_mesh(1,ispec)) + &
+ ( (nodes_coords_ext_mesh(1,elmnts_ext_mesh(5,ispec)) - nodes_coords_ext_mesh(1,elmnts_ext_mesh(1,ispec))) &
+ / real(NSUB)) * (iz-1)
+ temporary_nodes(2,1,1,iz) = nodes_coords_ext_mesh(2,elmnts_ext_mesh(1,ispec)) + &
+ ( (nodes_coords_ext_mesh(2,elmnts_ext_mesh(5,ispec)) - nodes_coords_ext_mesh(2,elmnts_ext_mesh(1,ispec))) &
+ / real(NSUB)) * (iz-1)
+ temporary_nodes(3,1,1,iz) = nodes_coords_ext_mesh(3,elmnts_ext_mesh(1,ispec)) + &
+ ( (nodes_coords_ext_mesh(3,elmnts_ext_mesh(5,ispec)) - nodes_coords_ext_mesh(3,elmnts_ext_mesh(1,ispec))) &
+ / real(NSUB)) * (iz-1)
+
+ temporary_nodes(1,NSUB+1,1,iz) = nodes_coords_ext_mesh(1,elmnts_ext_mesh(2,ispec)) + &
+ ( (nodes_coords_ext_mesh(1,elmnts_ext_mesh(6,ispec)) - nodes_coords_ext_mesh(1,elmnts_ext_mesh(2,ispec))) &
+ / real(NSUB)) * (iz-1)
+ temporary_nodes(2,NSUB+1,1,iz) = nodes_coords_ext_mesh(2,elmnts_ext_mesh(2,ispec)) + &
+ ( (nodes_coords_ext_mesh(2,elmnts_ext_mesh(6,ispec)) - nodes_coords_ext_mesh(2,elmnts_ext_mesh(2,ispec))) &
+ / real(NSUB)) * (iz-1)
+ temporary_nodes(3,NSUB+1,1,iz) = nodes_coords_ext_mesh(3,elmnts_ext_mesh(2,ispec)) + &
+ ( (nodes_coords_ext_mesh(3,elmnts_ext_mesh(6,ispec)) - nodes_coords_ext_mesh(3,elmnts_ext_mesh(2,ispec))) &
+ / real(NSUB)) * (iz-1)
+
+ temporary_nodes(1,1,NSUB+1,iz) = nodes_coords_ext_mesh(1,elmnts_ext_mesh(4,ispec)) + &
+ ( (nodes_coords_ext_mesh(1,elmnts_ext_mesh(8,ispec)) - nodes_coords_ext_mesh(1,elmnts_ext_mesh(4,ispec))) &
+ / real(NSUB)) * (iz-1)
+ temporary_nodes(2,1,NSUB+1,iz) = nodes_coords_ext_mesh(2,elmnts_ext_mesh(4,ispec)) + &
+ ( (nodes_coords_ext_mesh(2,elmnts_ext_mesh(8,ispec)) - nodes_coords_ext_mesh(2,elmnts_ext_mesh(4,ispec))) &
+ / real(NSUB)) * (iz-1)
+ temporary_nodes(3,1,NSUB+1,iz) = nodes_coords_ext_mesh(3,elmnts_ext_mesh(4,ispec)) + &
+ ( (nodes_coords_ext_mesh(3,elmnts_ext_mesh(8,ispec)) - nodes_coords_ext_mesh(3,elmnts_ext_mesh(4,ispec))) &
+ / real(NSUB)) * (iz-1)
+
+ temporary_nodes(1,NSUB+1,NSUB+1,iz) = nodes_coords_ext_mesh(1,elmnts_ext_mesh(3,ispec)) + &
+ ( (nodes_coords_ext_mesh(1,elmnts_ext_mesh(7,ispec)) - nodes_coords_ext_mesh(1,elmnts_ext_mesh(3,ispec))) &
+ / real(NSUB)) * (iz-1)
+ temporary_nodes(2,NSUB+1,NSUB+1,iz) = nodes_coords_ext_mesh(2,elmnts_ext_mesh(3,ispec)) + &
+ ( (nodes_coords_ext_mesh(2,elmnts_ext_mesh(7,ispec)) - nodes_coords_ext_mesh(2,elmnts_ext_mesh(3,ispec))) &
+ / real(NSUB)) * (iz-1)
+ temporary_nodes(3,NSUB+1,NSUB+1,iz) = nodes_coords_ext_mesh(3,elmnts_ext_mesh(3,ispec)) + &
+ ( (nodes_coords_ext_mesh(3,elmnts_ext_mesh(7,ispec)) - nodes_coords_ext_mesh(3,elmnts_ext_mesh(3,ispec))) &
+ / real(NSUB)) * (iz-1)
+
+ enddo
+
+ ix = 1
+ do iy = 2, NSUB
+ do iz = 2, NSUB
+ do idim = 1,NDIM
+ temporary_nodes(idim,ix,iy,iz) = ((temporary_nodes(idim,ix,1,iz) + &
+ ((temporary_nodes(idim,ix,NSUB+1,iz)-temporary_nodes(idim,ix,1,iz)) &
+ / real(NSUB)) * (iy-1)) &
+ + (temporary_nodes(idim,ix,iy,1) + ((temporary_nodes(idim,ix,iy,NSUB+1)-temporary_nodes(idim,ix,iy,1)) &
+ / real(NSUB)) * (iz-1))) &
+ * 1./2.
+
+ enddo
+ enddo
+ enddo
+
+ ix = NSUB+1
+ do iy = 2, NSUB
+ do iz = 2, NSUB
+ do idim = 1,NDIM
+ temporary_nodes(idim,ix,iy,iz) = ((temporary_nodes(idim,ix,1,iz) + &
+ ((temporary_nodes(idim,ix,NSUB+1,iz)-temporary_nodes(idim,ix,1,iz)) &
+ / real(NSUB)) * (iy-1)) &
+ + (temporary_nodes(idim,ix,iy,1) + ((temporary_nodes(idim,ix,iy,NSUB+1)-temporary_nodes(idim,ix,iy,1)) &
+ / real(NSUB)) * (iz-1))) &
+ * 1./2.
+
+ enddo
+ enddo
+ enddo
+
+ iy = 1
+ do ix = 2, NSUB
+ do iz = 2, NSUB
+ do idim = 1,NDIM
+ temporary_nodes(idim,ix,iy,iz) = ((temporary_nodes(idim,1,iy,iz) + &
+ ((temporary_nodes(idim,NSUB+1,iy,iz)-temporary_nodes(idim,1,iy,iz)) &
+ / real(NSUB)) * (ix-1)) &
+ + (temporary_nodes(idim,ix,iy,1) + ((temporary_nodes(idim,ix,iy,NSUB+1)-temporary_nodes(idim,ix,iy,1)) &
+ / real(NSUB)) * (iz-1))) &
+ * 1./2.
+
+ enddo
+ enddo
+ enddo
+
+ iy = NSUB+1
+ do ix = 2, NSUB
+ do iz = 2, NSUB
+ do idim = 1,NDIM
+ temporary_nodes(idim,ix,iy,iz) = ((temporary_nodes(idim,1,iy,iz) + &
+ ((temporary_nodes(idim,NSUB+1,iy,iz)-temporary_nodes(idim,1,iy,iz)) &
+ / real(NSUB)) * (ix-1)) &
+ + (temporary_nodes(idim,ix,iy,1) + ((temporary_nodes(idim,ix,iy,NSUB+1)-temporary_nodes(idim,ix,iy,1)) &
+ / real(NSUB)) * (iz-1))) &
+ * 1./2.
+
+ enddo
+ enddo
+ enddo
+
+ iz = 1
+ do ix = 2, NSUB
+ do iy = 2, NSUB
+ do idim = 1,NDIM
+ temporary_nodes(idim,ix,iy,iz) = ((temporary_nodes(idim,1,iy,iz) + &
+ ((temporary_nodes(idim,NSUB+1,iy,iz)-temporary_nodes(idim,1,iy,iz)) &
+ / real(NSUB)) * (ix-1)) &
+ + (temporary_nodes(idim,ix,1,iz) + ((temporary_nodes(idim,ix,NSUB+1,iz)-temporary_nodes(idim,ix,1,iz)) &
+ / real(NSUB)) * (iy-1))) &
+ * 1./2.
+
+ enddo
+ enddo
+ enddo
+
+ iz = NSUB+1
+ do ix = 2, NSUB
+ do iy = 2, NSUB
+ do idim = 1,NDIM
+ temporary_nodes(idim,ix,iy,iz) = ((temporary_nodes(idim,1,iy,iz) + &
+ ((temporary_nodes(idim,NSUB+1,iy,iz)-temporary_nodes(idim,1,iy,iz)) &
+ / real(NSUB)) * (ix-1)) &
+ + (temporary_nodes(idim,ix,1,iz) + ((temporary_nodes(idim,ix,NSUB+1,iz)-temporary_nodes(idim,ix,1,iz)) &
+ / real(NSUB)) * (iy-1))) &
+ * 1./2.
+
+ enddo
+ enddo
+ enddo
+
+ do ix = 2, NSUB
+ do iy = 2, NSUB
+ do iz = 2, NSUB
+ do idim = 1,NDIM
+ temporary_nodes(idim,ix,iy,iz) = ((temporary_nodes(idim,1,iy,iz) + &
+ ((temporary_nodes(idim,NSUB+1,iy,iz)-temporary_nodes(idim,1,iy,iz)) &
+ / real(NSUB)) * (ix-1)) &
+ + (temporary_nodes(idim,ix,1,iz) + ((temporary_nodes(idim,ix,NSUB+1,iz)-temporary_nodes(idim,ix,1,iz)) &
+ / real(NSUB)) * (iy-1)) &
+ + (temporary_nodes(idim,ix,iy,1) + ((temporary_nodes(idim,ix,iy,NSUB+1)-temporary_nodes(idim,ix,iy,1)) &
+ / real(NSUB)) * (iz-1))) &
+ * 1./3.
+
+ enddo
+ enddo
+ enddo
+ enddo
+
+ temporary_nodes_lookup(:,:,:) = 0
+
+ do ispec_neighbours = xadj(ispec), xadj(ispec+1)-1
+ if ( adjncy(ispec_neighbours) < ispec ) then
+ do ispec_neighbours_sub = (adjncy(ispec_neighbours)-1)*NSUB*NSUB*NSUB + 1, adjncy(ispec_neighbours)*NSUB*NSUB*NSUB
+
+ do ix = 1, NSUB+1
+ do iy = 1, NSUB+1
+ do iz = 1, NSUB+1
+ do inode = 1, ESIZE
+ if ( sqrt( &
+ (temporary_nodes(1,ix,iy,iz)-nodes_coords_ext_mesh_sub(1,elmnts_ext_mesh_sub(inode,ispec_neighbours_sub)))**2 + &
+ (temporary_nodes(2,ix,iy,iz)-nodes_coords_ext_mesh_sub(2,elmnts_ext_mesh_sub(inode,ispec_neighbours_sub)))**2 + &
+ (temporary_nodes(3,ix,iy,iz)-nodes_coords_ext_mesh_sub(3,elmnts_ext_mesh_sub(inode,ispec_neighbours_sub)))**2 ) &
+ < xtol ) then
+ temporary_nodes_lookup(ix,iy,iz) = elmnts_ext_mesh_sub(inode,ispec_neighbours_sub)
+ end if
+
+ enddo
+ enddo
+ enddo
+ enddo
+ enddo
+ end if
+ enddo
+
+ do ix = 1, NSUB+1
+ do iy = 1, NSUB+1
+ do iz = 1, NSUB+1
+ if (temporary_nodes_lookup(ix,iy,iz) == 0 ) then
+ nnodes_ext_mesh_sub = nnodes_ext_mesh_sub + 1
+ temporary_nodes_lookup(ix,iy,iz) = nnodes_ext_mesh_sub
+ nodes_coords_ext_mesh_sub(1,nnodes_ext_mesh_sub) = temporary_nodes(1,ix,iy,iz)
+ nodes_coords_ext_mesh_sub(2,nnodes_ext_mesh_sub) = temporary_nodes(2,ix,iy,iz)
+ nodes_coords_ext_mesh_sub(3,nnodes_ext_mesh_sub) = temporary_nodes(3,ix,iy,iz)
+ end if
+ enddo
+ enddo
+ enddo
+
+ do ix = 1, NSUB
+ do iy = 1, NSUB
+ do iz = 1, NSUB
+ elmnts_ext_mesh_sub(1,(ispec-1)*NSUB*NSUB*NSUB+(ix-1)*NSUB*NSUB+(iy-1)*NSUB+iz) = temporary_nodes_lookup(ix,iy,iz)
+ elmnts_ext_mesh_sub(2,(ispec-1)*NSUB*NSUB*NSUB+(ix-1)*NSUB*NSUB+(iy-1)*NSUB+iz) = temporary_nodes_lookup(ix+1,iy,iz)
+ elmnts_ext_mesh_sub(3,(ispec-1)*NSUB*NSUB*NSUB+(ix-1)*NSUB*NSUB+(iy-1)*NSUB+iz) = temporary_nodes_lookup(ix+1,iy+1,iz)
+ elmnts_ext_mesh_sub(4,(ispec-1)*NSUB*NSUB*NSUB+(ix-1)*NSUB*NSUB+(iy-1)*NSUB+iz) = temporary_nodes_lookup(ix,iy+1,iz)
+ elmnts_ext_mesh_sub(5,(ispec-1)*NSUB*NSUB*NSUB+(ix-1)*NSUB*NSUB+(iy-1)*NSUB+iz) = temporary_nodes_lookup(ix,iy,iz+1)
+ elmnts_ext_mesh_sub(6,(ispec-1)*NSUB*NSUB*NSUB+(ix-1)*NSUB*NSUB+(iy-1)*NSUB+iz) = temporary_nodes_lookup(ix+1,iy,iz+1)
+ elmnts_ext_mesh_sub(7,(ispec-1)*NSUB*NSUB*NSUB+(ix-1)*NSUB*NSUB+(iy-1)*NSUB+iz) = temporary_nodes_lookup(ix+1,iy+1,iz+1)
+ elmnts_ext_mesh_sub(8,(ispec-1)*NSUB*NSUB*NSUB+(ix-1)*NSUB*NSUB+(iy-1)*NSUB+iz) = temporary_nodes_lookup(ix,iy+1,iz+1)
+
+ mat_ext_mesh_sub((ispec-1)*NSUB*NSUB*NSUB+(ix-1)*NSUB*NSUB+(iy-1)*NSUB+iz) = mat_ext_mesh(ispec)
+
+ enddo
+ enddo
+ enddo
+
+ enddo
+
+! check that there really are 8 nodes per element.
+ do ispec = 1, nelmnts_ext_mesh*NSUB*NSUB*NSUB
+ do inode = 1, ESIZE
+ do ix = inode+1, ESIZE
+ if (elmnts_ext_mesh_sub(inode,ispec) == elmnts_ext_mesh_sub(ix,ispec)) then
+ stop 'ERRORERROR'
+ endif
+ enddo
+
+ enddo
+enddo
+
+
+ print *, 'xmin', minval(nodes_coords_ext_mesh_sub(1,:))
+ print *, 'xmax', maxval(nodes_coords_ext_mesh_sub(1,:))
+ print *, 'ymin', minval(nodes_coords_ext_mesh_sub(2,:))
+ print *, 'ymax', maxval(nodes_coords_ext_mesh_sub(2,:))
+ print *, 'zmin', minval(nodes_coords_ext_mesh_sub(3,:))
+ print *, 'zmax', maxval(nodes_coords_ext_mesh_sub(3,:))
+
+
+ open(unit=99, file='./mesh_sub', status='unknown', form='formatted')
+ write(99,*) nelmnts_ext_mesh*NSUB*NSUB*NSUB
+ do ispec = 1, nelmnts_ext_mesh*NSUB*NSUB*NSUB
+ write(99,*) elmnts_ext_mesh_sub(1,ispec), elmnts_ext_mesh_sub(2,ispec), elmnts_ext_mesh_sub(3,ispec), &
+ elmnts_ext_mesh_sub(4,ispec), elmnts_ext_mesh_sub(5,ispec), elmnts_ext_mesh_sub(6,ispec), &
+ elmnts_ext_mesh_sub(7,ispec), elmnts_ext_mesh_sub(8,ispec)
+ end do
+ close(99)
+
+ open(unit=99, file='./mat_sub', status='unknown', form='formatted')
+ do ispec = 1, nelmnts_ext_mesh*NSUB*NSUB*NSUB
+ write(99,*) mat_ext_mesh_sub(ispec)
+ end do
+ close(99)
+
+
+ open(unit=99, file='./nodes_coords_sub', status='unknown', form='formatted')
+ write(99,*) nnodes_ext_mesh_sub
+ do inode = 1, nnodes_ext_mesh_sub
+ write(99,*) nodes_coords_ext_mesh_sub(1,inode), nodes_coords_ext_mesh_sub(2,inode), nodes_coords_ext_mesh_sub(3,inode)
+ end do
+ close(99)
+
+ end program decimate_mesh
+
+
+ !-----------------------------------------------
+ ! Creating dual graph (adjacency is defined by 'ncommonnodes' between two elements).
+ !-----------------------------------------------
+ subroutine mesh2dual_ncommonnodes(nelmnts, nnodes, elmnts, xadj, adjncy, nnodes_elmnts, nodes_elmnts, ncommonnodes)
+
+ include './constants.h'
+
+ integer, intent(in) :: nelmnts
+ integer, intent(in) :: nnodes
+ integer, dimension(0:esize*nelmnts-1), intent(in) :: elmnts
+ integer, dimension(0:nelmnts) :: xadj
+ integer, dimension(0:MAX_NEIGHBOURS*nelmnts-1) :: adjncy
+ integer, dimension(0:nnodes-1) :: nnodes_elmnts
+ integer, dimension(0:nsize*nnodes-1) :: nodes_elmnts
+ integer, intent(in) :: ncommonnodes
+
+ integer :: i, j, k, l, m, nb_edges
+ logical :: is_neighbour
+ integer :: num_node, n
+ integer :: elem_base, elem_target
+ integer :: connectivity
+
+ print *, 'RRRRRRRRRR'
+
+ !allocate(xadj(0:nelmnts))
+ xadj(:) = 0
+ !allocate(adjncy(0:MAX_NEIGHBOURS*nelmnts-1))
+ adjncy(:) = 0
+ !allocate(nnodes_elmnts(0:nnodes-1))
+ nnodes_elmnts(:) = 0
+ !allocate(nodes_elmnts(0:nsize*nnodes-1))
+ nodes_elmnts(:) = 0
+
+ nb_edges = 0
+
+
+ ! list of elements per node
+ do i = 0, esize*nelmnts-1
+
+ nodes_elmnts(elmnts(i)*nsize+nnodes_elmnts(elmnts(i))) = i/esize
+ nnodes_elmnts(elmnts(i)) = nnodes_elmnts(elmnts(i)) + 1
+
+ end do
+
+ print *, 'nnodes_elmnts'
+
+ ! checking which elements are neighbours ('ncommonnodes' criteria)
+ do j = 0, nnodes-1
+ do k = 0, nnodes_elmnts(j)-1
+ do l = k+1, nnodes_elmnts(j)-1
+
+ connectivity = 0
+ elem_base = nodes_elmnts(k+j*nsize)
+ elem_target = nodes_elmnts(l+j*nsize)
+ do n = 1, esize
+ num_node = elmnts(esize*elem_base+n-1)
+ do m = 0, nnodes_elmnts(num_node)-1
+ if ( nodes_elmnts(m+num_node*nsize) == elem_target ) then
+ connectivity = connectivity + 1
+ end if
+ end do
+ end do
+
+ if ( connectivity >= ncommonnodes) then
+
+ is_neighbour = .false.
+
+ do m = 0, xadj(nodes_elmnts(k+j*nsize))
+ if ( .not.is_neighbour ) then
+ if ( adjncy(nodes_elmnts(k+j*nsize)*MAX_NEIGHBOURS+m) == nodes_elmnts(l+j*nsize) ) then
+ is_neighbour = .true.
+
+
+ end if
+ end if
+ end do
+ if ( .not.is_neighbour ) then
+ adjncy(nodes_elmnts(k+j*nsize)*MAX_NEIGHBOURS+xadj(nodes_elmnts(k+j*nsize))) = nodes_elmnts(l+j*nsize)
+ xadj(nodes_elmnts(k+j*nsize)) = xadj(nodes_elmnts(k+j*nsize)) + 1
+ adjncy(nodes_elmnts(l+j*nsize)*MAX_NEIGHBOURS+xadj(nodes_elmnts(l+j*nsize))) = nodes_elmnts(k+j*nsize)
+ xadj(nodes_elmnts(l+j*nsize)) = xadj(nodes_elmnts(l+j*nsize)) + 1
+ end if
+ end if
+ end do
+ end do
+ end do
+
+ ! making adjacency arrays compact (to be used for partitioning)
+ do i = 0, nelmnts-1
+ k = xadj(i)
+ xadj(i) = nb_edges
+ do j = 0, k-1
+ adjncy(nb_edges) = adjncy(i*MAX_NEIGHBOURS+j)
+ nb_edges = nb_edges + 1
+ end do
+ end do
+
+ xadj(nelmnts) = nb_edges
+
+
+ end subroutine mesh2dual_ncommonnodes
+
Property changes on: seismo/3D/SPECFEM3D_SESAME/trunk/UTILS/external_mesh/model_asteroid_subdivide/decimate_mesh.f90
___________________________________________________________________
Name: svn:mergeinfo
+
Deleted: seismo/3D/SPECFEM3D_SESAME/trunk/UTILS/external_mesh/model_asteroid_subdivide/sub.f90
===================================================================
--- seismo/3D/SPECFEM3D_SESAME/trunk/UTILS/external_mesh/model_asteroid_subdivide/sub.f90 2009-03-12 16:31:24 UTC (rev 14300)
+++ seismo/3D/SPECFEM3D_SESAME/trunk/UTILS/external_mesh/model_asteroid_subdivide/sub.f90 2009-03-12 17:37:00 UTC (rev 14301)
@@ -1,593 +0,0 @@
-program subdivide_mesh
-
- implicit none
-
- include './constants.h'
-
- integer :: nelmnts_ext_mesh
- integer, dimension(:,:), allocatable :: elmnts_ext_mesh
- integer, dimension(:,:), allocatable :: elmnts_ext_mesh_sub
- integer, dimension(:), allocatable :: mat_ext_mesh
- integer, dimension(:), allocatable :: mat_ext_mesh_sub
-
- integer :: nnodes_ext_mesh
- real, dimension(:,:), allocatable :: nodes_coords_ext_mesh
- real, dimension(:,:), allocatable :: nodes_coords_ext_mesh_sub
-
-
-
- real, dimension(NDIM,NSUB+1,NSUB+1,NSUB+1) :: temporary_nodes
- integer, dimension(NSUB+1,NSUB+1,NSUB+1) :: temporary_nodes_lookup
-
- integer, dimension(:), allocatable :: xadj
- integer, dimension(:), allocatable :: adjncy
- integer, dimension(:), allocatable :: nnodes_elmnts
- integer, dimension(:), allocatable :: nodes_elmnts
-
- integer :: ispec, inode, ispec_neighbours, ispec_neighbours_sub
- integer :: nnodes_ext_mesh_sub
- integer :: i, j, k
- integer :: ix, iy, iz
- integer :: idim
-
- real :: xtol
-
- real :: xminval,yminval,xmaxval,ymaxval,xtypdist,zminval,zmaxval
-
-
-
- open(unit=98, file='./mesh', status='old', form='formatted')
- read(98,*) nelmnts_ext_mesh
- allocate(elmnts_ext_mesh(ESIZE,nelmnts_ext_mesh))
- do ispec = 1, nelmnts_ext_mesh
- read(98,*) elmnts_ext_mesh(1,ispec), elmnts_ext_mesh(2,ispec), elmnts_ext_mesh(3,ispec), elmnts_ext_mesh(4,ispec), &
- elmnts_ext_mesh(5,ispec), elmnts_ext_mesh(6,ispec), elmnts_ext_mesh(7,ispec), elmnts_ext_mesh(8,ispec)
- end do
- close(98)
-
- open(unit=98, file='./mat', status='old', form='formatted')
- allocate(mat_ext_mesh(nelmnts_ext_mesh))
- do ispec = 1, nelmnts_ext_mesh
- read(98,*) mat_ext_mesh(ispec)
- end do
- close(98)
-
- open(unit=98, file='./nodes_coords', status='old', form='formatted')
- read(98,*) nnodes_ext_mesh
- allocate(nodes_coords_ext_mesh(NDIM,nnodes_ext_mesh))
- do inode = 1, nnodes_ext_mesh
- read(98,*) nodes_coords_ext_mesh(1,inode), nodes_coords_ext_mesh(2,inode),nodes_coords_ext_mesh(3,inode)
- end do
- close(98)
-
-
-! check that there really are 8 nodes per element.
- do ispec = 1, nelmnts_ext_mesh
- do inode = 1, ESIZE
- do ix = inode+1, ESIZE
- if (elmnts_ext_mesh(inode,ispec) == elmnts_ext_mesh(ix,ispec)) then
- stop 'ERRORERROR'
- endif
- enddo
-
- enddo
-enddo
-
-! set up local geometric tolerances
- xtypdist=+HUGEVAL
-
- do ispec=1,nelmnts_ext_mesh
-
- xminval=+HUGEVAL
- yminval=+HUGEVAL
- zminval=+HUGEVAL
- xmaxval=-HUGEVAL
- ymaxval=-HUGEVAL
- zmaxval=-HUGEVAL
-
- do inode = 1, 8
- xmaxval=max(nodes_coords_ext_mesh(1,elmnts_ext_mesh(inode,ispec)),xmaxval)
- xminval=min(nodes_coords_ext_mesh(1,elmnts_ext_mesh(inode,ispec)),xminval)
- ymaxval=max(nodes_coords_ext_mesh(2,elmnts_ext_mesh(inode,ispec)),ymaxval)
- yminval=min(nodes_coords_ext_mesh(2,elmnts_ext_mesh(inode,ispec)),yminval)
- zmaxval=max(nodes_coords_ext_mesh(3,elmnts_ext_mesh(inode,ispec)),zmaxval)
- zminval=min(nodes_coords_ext_mesh(3,elmnts_ext_mesh(inode,ispec)),zminval)
- enddo
-
-! compute the minimum typical "size" of an element in the mesh
- xtypdist = min(xtypdist,xmaxval-xminval)
- xtypdist = min(xtypdist,ymaxval-yminval)
- xtypdist = min(xtypdist,zmaxval-zminval)
- !xtypdist = min(xtypdist,sqrt((xmaxval-xminval)**2 + (ymaxval-yminval)**2 + (zmaxval-zminval)**2))
-
- enddo
-
-! define a tolerance, small with respect to the minimum size
- xtol=smallval_tol*xtypdist*1.d7
-
- print *, 'xtypdist' , xtypdist
- print *, 'facteur de tolerance XTOL = ', xtol
-
- print *, 'xmin', minval(nodes_coords_ext_mesh(1,:))
- print *, 'xmax', maxval(nodes_coords_ext_mesh(1,:))
- print *, 'ymin', minval(nodes_coords_ext_mesh(2,:))
- print *, 'ymax', maxval(nodes_coords_ext_mesh(2,:))
- print *, 'zmin', minval(nodes_coords_ext_mesh(3,:))
- print *, 'zmax', maxval(nodes_coords_ext_mesh(3,:))
-
-
-
-! we build the graph
- elmnts_ext_mesh(:,:) = elmnts_ext_mesh(:,:) - 1
-
- allocate(xadj(1:nelmnts_ext_mesh+1))
- allocate(adjncy(1:MAX_NEIGHBOURS*nelmnts_ext_mesh))
- allocate(nnodes_elmnts(1:nnodes_ext_mesh))
- allocate(nodes_elmnts(1:NSIZE*nnodes_ext_mesh))
-
- call mesh2dual_ncommonnodes(nelmnts_ext_mesh, nnodes_ext_mesh, elmnts_ext_mesh, xadj, adjncy, nnodes_elmnts, nodes_elmnts,1)
-
- print *, 'ZZZZ'
-
- elmnts_ext_mesh(:,:) = elmnts_ext_mesh(:,:) + 1
- adjncy(:) = adjncy(:) + 1
- xadj(:) = xadj(:) + 1
-
- allocate(elmnts_ext_mesh_sub(ESIZE,nelmnts_ext_mesh*NSUB*NSUB*NSUB))
- allocate(nodes_coords_ext_mesh_sub(NDIM,ESIZE*nelmnts_ext_mesh*(NSUB+1)*(NSUB+1)*(NSUB+1)))
- allocate(mat_ext_mesh_sub(nelmnts_ext_mesh*NSUB*NSUB*NSUB))
-
- nnodes_ext_mesh_sub = 0
-
- do ispec = 1, nelmnts_ext_mesh
-
- do ix = 1, NSUB+1
-
- temporary_nodes(1,ix,1,1) = nodes_coords_ext_mesh(1,elmnts_ext_mesh(1,ispec)) + &
- ( (nodes_coords_ext_mesh(1,elmnts_ext_mesh(2,ispec)) - nodes_coords_ext_mesh(1,elmnts_ext_mesh(1,ispec))) &
- / real(NSUB)) * (ix-1)
- temporary_nodes(2,ix,1,1) = nodes_coords_ext_mesh(2,elmnts_ext_mesh(1,ispec)) + &
- ( (nodes_coords_ext_mesh(2,elmnts_ext_mesh(2,ispec)) - nodes_coords_ext_mesh(2,elmnts_ext_mesh(1,ispec))) &
- / real(NSUB)) * (ix-1)
- temporary_nodes(3,ix,1,1) = nodes_coords_ext_mesh(3,elmnts_ext_mesh(1,ispec)) + &
- ( (nodes_coords_ext_mesh(3,elmnts_ext_mesh(2,ispec)) - nodes_coords_ext_mesh(3,elmnts_ext_mesh(1,ispec))) &
- / real(NSUB)) * (ix-1)
-
- temporary_nodes(1,ix,NSUB+1,1) = nodes_coords_ext_mesh(1,elmnts_ext_mesh(4,ispec)) + &
- ( (nodes_coords_ext_mesh(1,elmnts_ext_mesh(3,ispec)) - nodes_coords_ext_mesh(1,elmnts_ext_mesh(4,ispec))) &
- / real(NSUB)) * (ix-1)
- temporary_nodes(2,ix,NSUB+1,1) = nodes_coords_ext_mesh(2,elmnts_ext_mesh(4,ispec)) + &
- ( (nodes_coords_ext_mesh(2,elmnts_ext_mesh(3,ispec)) - nodes_coords_ext_mesh(2,elmnts_ext_mesh(4,ispec))) &
- / real(NSUB)) * (ix-1)
- temporary_nodes(3,ix,NSUB+1,1) = nodes_coords_ext_mesh(3,elmnts_ext_mesh(4,ispec)) + &
- ( (nodes_coords_ext_mesh(3,elmnts_ext_mesh(3,ispec)) - nodes_coords_ext_mesh(3,elmnts_ext_mesh(4,ispec))) &
- / real(NSUB)) * (ix-1)
-
- temporary_nodes(1,ix,1,NSUB+1) = nodes_coords_ext_mesh(1,elmnts_ext_mesh(5,ispec)) + &
- ( (nodes_coords_ext_mesh(1,elmnts_ext_mesh(6,ispec)) - nodes_coords_ext_mesh(1,elmnts_ext_mesh(5,ispec))) &
- / real(NSUB)) * (ix-1)
- temporary_nodes(2,ix,1,NSUB+1) = nodes_coords_ext_mesh(2,elmnts_ext_mesh(5,ispec)) + &
- ( (nodes_coords_ext_mesh(2,elmnts_ext_mesh(6,ispec)) - nodes_coords_ext_mesh(2,elmnts_ext_mesh(5,ispec))) &
- / real(NSUB)) * (ix-1)
- temporary_nodes(3,ix,1,NSUB+1) = nodes_coords_ext_mesh(3,elmnts_ext_mesh(5,ispec)) + &
- ( (nodes_coords_ext_mesh(3,elmnts_ext_mesh(6,ispec)) - nodes_coords_ext_mesh(3,elmnts_ext_mesh(5,ispec))) &
- / real(NSUB)) * (ix-1)
-
- temporary_nodes(1,ix,NSUB+1,NSUB+1) = nodes_coords_ext_mesh(1,elmnts_ext_mesh(8,ispec)) + &
- ( (nodes_coords_ext_mesh(1,elmnts_ext_mesh(7,ispec)) - nodes_coords_ext_mesh(1,elmnts_ext_mesh(8,ispec))) &
- / real(NSUB)) * (ix-1)
- temporary_nodes(2,ix,NSUB+1,NSUB+1) = nodes_coords_ext_mesh(2,elmnts_ext_mesh(8,ispec)) + &
- ( (nodes_coords_ext_mesh(2,elmnts_ext_mesh(7,ispec)) - nodes_coords_ext_mesh(2,elmnts_ext_mesh(8,ispec))) &
- / real(NSUB)) * (ix-1)
- temporary_nodes(3,ix,NSUB+1,NSUB+1) = nodes_coords_ext_mesh(3,elmnts_ext_mesh(8,ispec)) + &
- ( (nodes_coords_ext_mesh(3,elmnts_ext_mesh(7,ispec)) - nodes_coords_ext_mesh(3,elmnts_ext_mesh(8,ispec))) &
- / real(NSUB)) * (ix-1)
-
- enddo
-
- do iy = 1, NSUB+1
-
- temporary_nodes(1,1,iy,1) = nodes_coords_ext_mesh(1,elmnts_ext_mesh(1,ispec)) + &
- ( (nodes_coords_ext_mesh(1,elmnts_ext_mesh(4,ispec)) - nodes_coords_ext_mesh(1,elmnts_ext_mesh(1,ispec))) &
- / real(NSUB)) * (iy-1)
- temporary_nodes(2,1,iy,1) = nodes_coords_ext_mesh(2,elmnts_ext_mesh(1,ispec)) + &
- ( (nodes_coords_ext_mesh(2,elmnts_ext_mesh(4,ispec)) - nodes_coords_ext_mesh(2,elmnts_ext_mesh(1,ispec))) &
- / real(NSUB)) * (iy-1)
- temporary_nodes(3,1,iy,1) = nodes_coords_ext_mesh(3,elmnts_ext_mesh(1,ispec)) + &
- ( (nodes_coords_ext_mesh(3,elmnts_ext_mesh(4,ispec)) - nodes_coords_ext_mesh(3,elmnts_ext_mesh(1,ispec))) &
- / real(NSUB)) * (iy-1)
-
- temporary_nodes(1,NSUB+1,iy,1) = nodes_coords_ext_mesh(1,elmnts_ext_mesh(2,ispec)) + &
- ( (nodes_coords_ext_mesh(1,elmnts_ext_mesh(3,ispec)) - nodes_coords_ext_mesh(1,elmnts_ext_mesh(2,ispec))) &
- / real(NSUB)) * (iy-1)
- temporary_nodes(2,NSUB+1,iy,1) = nodes_coords_ext_mesh(2,elmnts_ext_mesh(2,ispec)) + &
- ( (nodes_coords_ext_mesh(2,elmnts_ext_mesh(3,ispec)) - nodes_coords_ext_mesh(2,elmnts_ext_mesh(2,ispec))) &
- / real(NSUB)) * (iy-1)
- temporary_nodes(3,NSUB+1,iy,1) = nodes_coords_ext_mesh(3,elmnts_ext_mesh(2,ispec)) + &
- ( (nodes_coords_ext_mesh(3,elmnts_ext_mesh(3,ispec)) - nodes_coords_ext_mesh(3,elmnts_ext_mesh(2,ispec))) &
- / real(NSUB)) * (iy-1)
-
- temporary_nodes(1,1,iy,NSUB+1) = nodes_coords_ext_mesh(1,elmnts_ext_mesh(5,ispec)) + &
- ( (nodes_coords_ext_mesh(1,elmnts_ext_mesh(8,ispec)) - nodes_coords_ext_mesh(1,elmnts_ext_mesh(5,ispec))) &
- / real(NSUB)) * (iy-1)
- temporary_nodes(2,1,iy,NSUB+1) = nodes_coords_ext_mesh(2,elmnts_ext_mesh(5,ispec)) + &
- ( (nodes_coords_ext_mesh(2,elmnts_ext_mesh(8,ispec)) - nodes_coords_ext_mesh(2,elmnts_ext_mesh(5,ispec))) &
- / real(NSUB)) * (iy-1)
- temporary_nodes(3,1,iy,NSUB+1) = nodes_coords_ext_mesh(3,elmnts_ext_mesh(5,ispec)) + &
- ( (nodes_coords_ext_mesh(3,elmnts_ext_mesh(8,ispec)) - nodes_coords_ext_mesh(3,elmnts_ext_mesh(5,ispec))) &
- / real(NSUB)) * (iy-1)
-
- temporary_nodes(1,NSUB+1,iy,NSUB+1) = nodes_coords_ext_mesh(1,elmnts_ext_mesh(6,ispec)) + &
- ( (nodes_coords_ext_mesh(1,elmnts_ext_mesh(7,ispec)) - nodes_coords_ext_mesh(1,elmnts_ext_mesh(6,ispec))) &
- / real(NSUB)) * (iy-1)
- temporary_nodes(2,NSUB+1,iy,NSUB+1) = nodes_coords_ext_mesh(2,elmnts_ext_mesh(6,ispec)) + &
- ( (nodes_coords_ext_mesh(2,elmnts_ext_mesh(7,ispec)) - nodes_coords_ext_mesh(2,elmnts_ext_mesh(6,ispec))) &
- / real(NSUB)) * (iy-1)
- temporary_nodes(3,NSUB+1,iy,NSUB+1) = nodes_coords_ext_mesh(3,elmnts_ext_mesh(6,ispec)) + &
- ( (nodes_coords_ext_mesh(3,elmnts_ext_mesh(7,ispec)) - nodes_coords_ext_mesh(3,elmnts_ext_mesh(6,ispec))) &
- / real(NSUB)) * (iy-1)
-
- enddo
-
- do iz = 1, NSUB+1
-
- temporary_nodes(1,1,1,iz) = nodes_coords_ext_mesh(1,elmnts_ext_mesh(1,ispec)) + &
- ( (nodes_coords_ext_mesh(1,elmnts_ext_mesh(5,ispec)) - nodes_coords_ext_mesh(1,elmnts_ext_mesh(1,ispec))) &
- / real(NSUB)) * (iz-1)
- temporary_nodes(2,1,1,iz) = nodes_coords_ext_mesh(2,elmnts_ext_mesh(1,ispec)) + &
- ( (nodes_coords_ext_mesh(2,elmnts_ext_mesh(5,ispec)) - nodes_coords_ext_mesh(2,elmnts_ext_mesh(1,ispec))) &
- / real(NSUB)) * (iz-1)
- temporary_nodes(3,1,1,iz) = nodes_coords_ext_mesh(3,elmnts_ext_mesh(1,ispec)) + &
- ( (nodes_coords_ext_mesh(3,elmnts_ext_mesh(5,ispec)) - nodes_coords_ext_mesh(3,elmnts_ext_mesh(1,ispec))) &
- / real(NSUB)) * (iz-1)
-
- temporary_nodes(1,NSUB+1,1,iz) = nodes_coords_ext_mesh(1,elmnts_ext_mesh(2,ispec)) + &
- ( (nodes_coords_ext_mesh(1,elmnts_ext_mesh(6,ispec)) - nodes_coords_ext_mesh(1,elmnts_ext_mesh(2,ispec))) &
- / real(NSUB)) * (iz-1)
- temporary_nodes(2,NSUB+1,1,iz) = nodes_coords_ext_mesh(2,elmnts_ext_mesh(2,ispec)) + &
- ( (nodes_coords_ext_mesh(2,elmnts_ext_mesh(6,ispec)) - nodes_coords_ext_mesh(2,elmnts_ext_mesh(2,ispec))) &
- / real(NSUB)) * (iz-1)
- temporary_nodes(3,NSUB+1,1,iz) = nodes_coords_ext_mesh(3,elmnts_ext_mesh(2,ispec)) + &
- ( (nodes_coords_ext_mesh(3,elmnts_ext_mesh(6,ispec)) - nodes_coords_ext_mesh(3,elmnts_ext_mesh(2,ispec))) &
- / real(NSUB)) * (iz-1)
-
- temporary_nodes(1,1,NSUB+1,iz) = nodes_coords_ext_mesh(1,elmnts_ext_mesh(4,ispec)) + &
- ( (nodes_coords_ext_mesh(1,elmnts_ext_mesh(8,ispec)) - nodes_coords_ext_mesh(1,elmnts_ext_mesh(4,ispec))) &
- / real(NSUB)) * (iz-1)
- temporary_nodes(2,1,NSUB+1,iz) = nodes_coords_ext_mesh(2,elmnts_ext_mesh(4,ispec)) + &
- ( (nodes_coords_ext_mesh(2,elmnts_ext_mesh(8,ispec)) - nodes_coords_ext_mesh(2,elmnts_ext_mesh(4,ispec))) &
- / real(NSUB)) * (iz-1)
- temporary_nodes(3,1,NSUB+1,iz) = nodes_coords_ext_mesh(3,elmnts_ext_mesh(4,ispec)) + &
- ( (nodes_coords_ext_mesh(3,elmnts_ext_mesh(8,ispec)) - nodes_coords_ext_mesh(3,elmnts_ext_mesh(4,ispec))) &
- / real(NSUB)) * (iz-1)
-
- temporary_nodes(1,NSUB+1,NSUB+1,iz) = nodes_coords_ext_mesh(1,elmnts_ext_mesh(3,ispec)) + &
- ( (nodes_coords_ext_mesh(1,elmnts_ext_mesh(7,ispec)) - nodes_coords_ext_mesh(1,elmnts_ext_mesh(3,ispec))) &
- / real(NSUB)) * (iz-1)
- temporary_nodes(2,NSUB+1,NSUB+1,iz) = nodes_coords_ext_mesh(2,elmnts_ext_mesh(3,ispec)) + &
- ( (nodes_coords_ext_mesh(2,elmnts_ext_mesh(7,ispec)) - nodes_coords_ext_mesh(2,elmnts_ext_mesh(3,ispec))) &
- / real(NSUB)) * (iz-1)
- temporary_nodes(3,NSUB+1,NSUB+1,iz) = nodes_coords_ext_mesh(3,elmnts_ext_mesh(3,ispec)) + &
- ( (nodes_coords_ext_mesh(3,elmnts_ext_mesh(7,ispec)) - nodes_coords_ext_mesh(3,elmnts_ext_mesh(3,ispec))) &
- / real(NSUB)) * (iz-1)
-
- enddo
-
- ix = 1
- do iy = 2, NSUB
- do iz = 2, NSUB
- do idim = 1,NDIM
- temporary_nodes(idim,ix,iy,iz) = ((temporary_nodes(idim,ix,1,iz) + &
- ((temporary_nodes(idim,ix,NSUB+1,iz)-temporary_nodes(idim,ix,1,iz)) &
- / real(NSUB)) * (iy-1)) &
- + (temporary_nodes(idim,ix,iy,1) + ((temporary_nodes(idim,ix,iy,NSUB+1)-temporary_nodes(idim,ix,iy,1)) &
- / real(NSUB)) * (iz-1))) &
- * 1./2.
-
- enddo
- enddo
- enddo
-
- ix = NSUB+1
- do iy = 2, NSUB
- do iz = 2, NSUB
- do idim = 1,NDIM
- temporary_nodes(idim,ix,iy,iz) = ((temporary_nodes(idim,ix,1,iz) + &
- ((temporary_nodes(idim,ix,NSUB+1,iz)-temporary_nodes(idim,ix,1,iz)) &
- / real(NSUB)) * (iy-1)) &
- + (temporary_nodes(idim,ix,iy,1) + ((temporary_nodes(idim,ix,iy,NSUB+1)-temporary_nodes(idim,ix,iy,1)) &
- / real(NSUB)) * (iz-1))) &
- * 1./2.
-
- enddo
- enddo
- enddo
-
- iy = 1
- do ix = 2, NSUB
- do iz = 2, NSUB
- do idim = 1,NDIM
- temporary_nodes(idim,ix,iy,iz) = ((temporary_nodes(idim,1,iy,iz) + &
- ((temporary_nodes(idim,NSUB+1,iy,iz)-temporary_nodes(idim,1,iy,iz)) &
- / real(NSUB)) * (ix-1)) &
- + (temporary_nodes(idim,ix,iy,1) + ((temporary_nodes(idim,ix,iy,NSUB+1)-temporary_nodes(idim,ix,iy,1)) &
- / real(NSUB)) * (iz-1))) &
- * 1./2.
-
- enddo
- enddo
- enddo
-
- iy = NSUB+1
- do ix = 2, NSUB
- do iz = 2, NSUB
- do idim = 1,NDIM
- temporary_nodes(idim,ix,iy,iz) = ((temporary_nodes(idim,1,iy,iz) + &
- ((temporary_nodes(idim,NSUB+1,iy,iz)-temporary_nodes(idim,1,iy,iz)) &
- / real(NSUB)) * (ix-1)) &
- + (temporary_nodes(idim,ix,iy,1) + ((temporary_nodes(idim,ix,iy,NSUB+1)-temporary_nodes(idim,ix,iy,1)) &
- / real(NSUB)) * (iz-1))) &
- * 1./2.
-
- enddo
- enddo
- enddo
-
- iz = 1
- do ix = 2, NSUB
- do iy = 2, NSUB
- do idim = 1,NDIM
- temporary_nodes(idim,ix,iy,iz) = ((temporary_nodes(idim,1,iy,iz) + &
- ((temporary_nodes(idim,NSUB+1,iy,iz)-temporary_nodes(idim,1,iy,iz)) &
- / real(NSUB)) * (ix-1)) &
- + (temporary_nodes(idim,ix,1,iz) + ((temporary_nodes(idim,ix,NSUB+1,iz)-temporary_nodes(idim,ix,1,iz)) &
- / real(NSUB)) * (iy-1))) &
- * 1./2.
-
- enddo
- enddo
- enddo
-
- iz = NSUB+1
- do ix = 2, NSUB
- do iy = 2, NSUB
- do idim = 1,NDIM
- temporary_nodes(idim,ix,iy,iz) = ((temporary_nodes(idim,1,iy,iz) + &
- ((temporary_nodes(idim,NSUB+1,iy,iz)-temporary_nodes(idim,1,iy,iz)) &
- / real(NSUB)) * (ix-1)) &
- + (temporary_nodes(idim,ix,1,iz) + ((temporary_nodes(idim,ix,NSUB+1,iz)-temporary_nodes(idim,ix,1,iz)) &
- / real(NSUB)) * (iy-1))) &
- * 1./2.
-
- enddo
- enddo
- enddo
-
- do ix = 2, NSUB
- do iy = 2, NSUB
- do iz = 2, NSUB
- do idim = 1,NDIM
- temporary_nodes(idim,ix,iy,iz) = ((temporary_nodes(idim,1,iy,iz) + &
- ((temporary_nodes(idim,NSUB+1,iy,iz)-temporary_nodes(idim,1,iy,iz)) &
- / real(NSUB)) * (ix-1)) &
- + (temporary_nodes(idim,ix,1,iz) + ((temporary_nodes(idim,ix,NSUB+1,iz)-temporary_nodes(idim,ix,1,iz)) &
- / real(NSUB)) * (iy-1)) &
- + (temporary_nodes(idim,ix,iy,1) + ((temporary_nodes(idim,ix,iy,NSUB+1)-temporary_nodes(idim,ix,iy,1)) &
- / real(NSUB)) * (iz-1))) &
- * 1./3.
-
- enddo
- enddo
- enddo
- enddo
-
- temporary_nodes_lookup(:,:,:) = 0
-
- do ispec_neighbours = xadj(ispec), xadj(ispec+1)-1
- if ( adjncy(ispec_neighbours) < ispec ) then
- do ispec_neighbours_sub = (adjncy(ispec_neighbours)-1)*NSUB*NSUB*NSUB + 1, adjncy(ispec_neighbours)*NSUB*NSUB*NSUB
-
- do ix = 1, NSUB+1
- do iy = 1, NSUB+1
- do iz = 1, NSUB+1
- do inode = 1, ESIZE
- if ( sqrt( &
- (temporary_nodes(1,ix,iy,iz)-nodes_coords_ext_mesh_sub(1,elmnts_ext_mesh_sub(inode,ispec_neighbours_sub)))**2 + &
- (temporary_nodes(2,ix,iy,iz)-nodes_coords_ext_mesh_sub(2,elmnts_ext_mesh_sub(inode,ispec_neighbours_sub)))**2 + &
- (temporary_nodes(3,ix,iy,iz)-nodes_coords_ext_mesh_sub(3,elmnts_ext_mesh_sub(inode,ispec_neighbours_sub)))**2 ) &
- < xtol ) then
- temporary_nodes_lookup(ix,iy,iz) = elmnts_ext_mesh_sub(inode,ispec_neighbours_sub)
- end if
-
- enddo
- enddo
- enddo
- enddo
- enddo
- end if
- enddo
-
- do ix = 1, NSUB+1
- do iy = 1, NSUB+1
- do iz = 1, NSUB+1
- if (temporary_nodes_lookup(ix,iy,iz) == 0 ) then
- nnodes_ext_mesh_sub = nnodes_ext_mesh_sub + 1
- temporary_nodes_lookup(ix,iy,iz) = nnodes_ext_mesh_sub
- nodes_coords_ext_mesh_sub(1,nnodes_ext_mesh_sub) = temporary_nodes(1,ix,iy,iz)
- nodes_coords_ext_mesh_sub(2,nnodes_ext_mesh_sub) = temporary_nodes(2,ix,iy,iz)
- nodes_coords_ext_mesh_sub(3,nnodes_ext_mesh_sub) = temporary_nodes(3,ix,iy,iz)
- end if
- enddo
- enddo
- enddo
-
- do ix = 1, NSUB
- do iy = 1, NSUB
- do iz = 1, NSUB
- elmnts_ext_mesh_sub(1,(ispec-1)*NSUB*NSUB*NSUB+(ix-1)*NSUB*NSUB+(iy-1)*NSUB+iz) = temporary_nodes_lookup(ix,iy,iz)
- elmnts_ext_mesh_sub(2,(ispec-1)*NSUB*NSUB*NSUB+(ix-1)*NSUB*NSUB+(iy-1)*NSUB+iz) = temporary_nodes_lookup(ix+1,iy,iz)
- elmnts_ext_mesh_sub(3,(ispec-1)*NSUB*NSUB*NSUB+(ix-1)*NSUB*NSUB+(iy-1)*NSUB+iz) = temporary_nodes_lookup(ix+1,iy+1,iz)
- elmnts_ext_mesh_sub(4,(ispec-1)*NSUB*NSUB*NSUB+(ix-1)*NSUB*NSUB+(iy-1)*NSUB+iz) = temporary_nodes_lookup(ix,iy+1,iz)
- elmnts_ext_mesh_sub(5,(ispec-1)*NSUB*NSUB*NSUB+(ix-1)*NSUB*NSUB+(iy-1)*NSUB+iz) = temporary_nodes_lookup(ix,iy,iz+1)
- elmnts_ext_mesh_sub(6,(ispec-1)*NSUB*NSUB*NSUB+(ix-1)*NSUB*NSUB+(iy-1)*NSUB+iz) = temporary_nodes_lookup(ix+1,iy,iz+1)
- elmnts_ext_mesh_sub(7,(ispec-1)*NSUB*NSUB*NSUB+(ix-1)*NSUB*NSUB+(iy-1)*NSUB+iz) = temporary_nodes_lookup(ix+1,iy+1,iz+1)
- elmnts_ext_mesh_sub(8,(ispec-1)*NSUB*NSUB*NSUB+(ix-1)*NSUB*NSUB+(iy-1)*NSUB+iz) = temporary_nodes_lookup(ix,iy+1,iz+1)
-
- mat_ext_mesh_sub((ispec-1)*NSUB*NSUB*NSUB+(ix-1)*NSUB*NSUB+(iy-1)*NSUB+iz) = mat_ext_mesh(ispec)
-
- enddo
- enddo
- enddo
-
- enddo
-
-! check that there really are 8 nodes per element.
- do ispec = 1, nelmnts_ext_mesh*NSUB*NSUB*NSUB
- do inode = 1, ESIZE
- do ix = inode+1, ESIZE
- if (elmnts_ext_mesh_sub(inode,ispec) == elmnts_ext_mesh_sub(ix,ispec)) then
- stop 'ERRORERROR'
- endif
- enddo
-
- enddo
-enddo
-
-
- print *, 'xmin', minval(nodes_coords_ext_mesh_sub(1,:))
- print *, 'xmax', maxval(nodes_coords_ext_mesh_sub(1,:))
- print *, 'ymin', minval(nodes_coords_ext_mesh_sub(2,:))
- print *, 'ymax', maxval(nodes_coords_ext_mesh_sub(2,:))
- print *, 'zmin', minval(nodes_coords_ext_mesh_sub(3,:))
- print *, 'zmax', maxval(nodes_coords_ext_mesh_sub(3,:))
-
-
- open(unit=99, file='./mesh_sub', status='unknown', form='formatted')
- write(99,*) nelmnts_ext_mesh*NSUB*NSUB*NSUB
- do ispec = 1, nelmnts_ext_mesh*NSUB*NSUB*NSUB
- write(99,*) elmnts_ext_mesh_sub(1,ispec), elmnts_ext_mesh_sub(2,ispec), elmnts_ext_mesh_sub(3,ispec), &
- elmnts_ext_mesh_sub(4,ispec), elmnts_ext_mesh_sub(5,ispec), elmnts_ext_mesh_sub(6,ispec), &
- elmnts_ext_mesh_sub(7,ispec), elmnts_ext_mesh_sub(8,ispec)
- end do
- close(99)
-
- open(unit=99, file='./mat_sub', status='unknown', form='formatted')
- do ispec = 1, nelmnts_ext_mesh*NSUB*NSUB*NSUB
- write(99,*) mat_ext_mesh_sub(ispec)
- end do
- close(99)
-
-
- open(unit=99, file='./nodes_coords_sub', status='unknown', form='formatted')
- write(99,*) nnodes_ext_mesh_sub
- do inode = 1, nnodes_ext_mesh_sub
- write(99,*) nodes_coords_ext_mesh_sub(1,inode), nodes_coords_ext_mesh_sub(2,inode), nodes_coords_ext_mesh_sub(3,inode)
- end do
- close(99)
-
-end program subdivide_mesh
-
-
-
- !-----------------------------------------------
- ! Creating dual graph (adjacency is defined by 'ncommonnodes' between two elements).
- !-----------------------------------------------
- subroutine mesh2dual_ncommonnodes(nelmnts, nnodes, elmnts, xadj, adjncy, nnodes_elmnts, nodes_elmnts, ncommonnodes)
-
- include './constants.h'
-
- integer, intent(in) :: nelmnts
- integer, intent(in) :: nnodes
- integer, dimension(0:esize*nelmnts-1), intent(in) :: elmnts
- integer, dimension(0:nelmnts) :: xadj
- integer, dimension(0:MAX_NEIGHBOURS*nelmnts-1) :: adjncy
- integer, dimension(0:nnodes-1) :: nnodes_elmnts
- integer, dimension(0:nsize*nnodes-1) :: nodes_elmnts
- integer, intent(in) :: ncommonnodes
-
- integer :: i, j, k, l, m, nb_edges
- logical :: is_neighbour
- integer :: num_node, n
- integer :: elem_base, elem_target
- integer :: connectivity
-
- print *, 'RRRRRRRRRR'
-
- !allocate(xadj(0:nelmnts))
- xadj(:) = 0
- !allocate(adjncy(0:MAX_NEIGHBOURS*nelmnts-1))
- adjncy(:) = 0
- !allocate(nnodes_elmnts(0:nnodes-1))
- nnodes_elmnts(:) = 0
- !allocate(nodes_elmnts(0:nsize*nnodes-1))
- nodes_elmnts(:) = 0
-
- nb_edges = 0
-
-
- ! list of elements per node
- do i = 0, esize*nelmnts-1
-
- nodes_elmnts(elmnts(i)*nsize+nnodes_elmnts(elmnts(i))) = i/esize
- nnodes_elmnts(elmnts(i)) = nnodes_elmnts(elmnts(i)) + 1
-
- end do
-
- print *, 'nnodes_elmnts'
-
- ! checking which elements are neighbours ('ncommonnodes' criteria)
- do j = 0, nnodes-1
- do k = 0, nnodes_elmnts(j)-1
- do l = k+1, nnodes_elmnts(j)-1
-
- connectivity = 0
- elem_base = nodes_elmnts(k+j*nsize)
- elem_target = nodes_elmnts(l+j*nsize)
- do n = 1, esize
- num_node = elmnts(esize*elem_base+n-1)
- do m = 0, nnodes_elmnts(num_node)-1
- if ( nodes_elmnts(m+num_node*nsize) == elem_target ) then
- connectivity = connectivity + 1
- end if
- end do
- end do
-
- if ( connectivity >= ncommonnodes) then
-
- is_neighbour = .false.
-
- do m = 0, xadj(nodes_elmnts(k+j*nsize))
- if ( .not.is_neighbour ) then
- if ( adjncy(nodes_elmnts(k+j*nsize)*MAX_NEIGHBOURS+m) == nodes_elmnts(l+j*nsize) ) then
- is_neighbour = .true.
-
-
- end if
- end if
- end do
- if ( .not.is_neighbour ) then
- adjncy(nodes_elmnts(k+j*nsize)*MAX_NEIGHBOURS+xadj(nodes_elmnts(k+j*nsize))) = nodes_elmnts(l+j*nsize)
- xadj(nodes_elmnts(k+j*nsize)) = xadj(nodes_elmnts(k+j*nsize)) + 1
- adjncy(nodes_elmnts(l+j*nsize)*MAX_NEIGHBOURS+xadj(nodes_elmnts(l+j*nsize))) = nodes_elmnts(k+j*nsize)
- xadj(nodes_elmnts(l+j*nsize)) = xadj(nodes_elmnts(l+j*nsize)) + 1
- end if
- end if
- end do
- end do
- end do
-
- ! making adjacency arrays compact (to be used for partitioning)
- do i = 0, nelmnts-1
- k = xadj(i)
- xadj(i) = nb_edges
- do j = 0, k-1
- adjncy(nb_edges) = adjncy(i*MAX_NEIGHBOURS+j)
- nb_edges = nb_edges + 1
- end do
- end do
-
- xadj(nelmnts) = nb_edges
-
-
- end subroutine mesh2dual_ncommonnodes
-
Deleted: seismo/3D/SPECFEM3D_SESAME/trunk/UTILS/external_mesh/pre_meshfem3D_asteroid_subdivide/compil_all.sh
===================================================================
--- seismo/3D/SPECFEM3D_SESAME/trunk/UTILS/external_mesh/pre_meshfem3D_asteroid_subdivide/compil_all.sh 2009-03-12 16:31:24 UTC (rev 14300)
+++ seismo/3D/SPECFEM3D_SESAME/trunk/UTILS/external_mesh/pre_meshfem3D_asteroid_subdivide/compil_all.sh 2009-03-12 17:37:00 UTC (rev 14301)
@@ -1,13 +0,0 @@
-#!/bin/sh
-
-#. /opt/intel/fce/10.0.026/bin/ifortvars.sh
-# export FCFLAGS="-g -traceback -implicitnone -warn stderrors -warn truncated_source -warn argument_checking -warn unused -warn declarations -std95 -assume byterecl -C"
-
-rm *.o *.mod ./a.out
-
-gfortran -c part_pre_meshfem3D.f90
-gfortran -c pre_meshfem3D.f90
-#gfortran pre_meshfem3D.o part_pre_meshfem3D.o ~/utils/metis-4.0/libmetis.a
-#gfortran pre_meshfem3D.o part_pre_meshfem3D.o ~/utils/scotch_5.1/lib/libscotchmetis.a ~/utils/scotch_5.1/lib/libscotch.a ~/utils/scotch_5.1/lib/libscotcherr.a
-gfortran pre_meshfem3D.o part_pre_meshfem3D.o ~/utils/scotch_5.1/lib/libscotch.a ~/utils/scotch_5.1/lib/libscotcherr.a
-
Copied: seismo/3D/SPECFEM3D_SESAME/trunk/UTILS/external_mesh/pre_meshfem3D_asteroid_subdivide/compile_all.csh (from rev 14285, seismo/3D/SPECFEM3D_SESAME/trunk/UTILS/external_mesh/pre_meshfem3D_asteroid_subdivide/compil_all.sh)
===================================================================
--- seismo/3D/SPECFEM3D_SESAME/trunk/UTILS/external_mesh/pre_meshfem3D_asteroid_subdivide/compile_all.csh (rev 0)
+++ seismo/3D/SPECFEM3D_SESAME/trunk/UTILS/external_mesh/pre_meshfem3D_asteroid_subdivide/compile_all.csh 2009-03-12 17:37:00 UTC (rev 14301)
@@ -0,0 +1,13 @@
+#!/bin/sh
+
+#. /opt/intel/fce/10.0.026/bin/ifortvars.sh
+# export FCFLAGS="-g -traceback -implicitnone -warn stderrors -warn truncated_source -warn argument_checking -warn unused -warn declarations -std95 -assume byterecl -C"
+
+rm *.o *.mod ./a.out
+
+gfortran -c part_decompose_mesh.f90
+gfortran -c decompose_mesh.f90
+#gfortran decompose_mesh.o part_decompose_mesh.o ~/utils/metis-4.0/libmetis.a
+#gfortran decompose_mesh.o part_decompose_mesh.o ~/utils/scotch_5.1/lib/libscotchmetis.a ~/utils/scotch_5.1/lib/libscotch.a ~/utils/scotch_5.1/lib/libscotcherr.a
+gfortran decompose_mesh.o part_decompose_mesh.o ~/utils/scotch_5.1/lib/libscotch.a ~/utils/scotch_5.1/lib/libscotcherr.a
+
Property changes on: seismo/3D/SPECFEM3D_SESAME/trunk/UTILS/external_mesh/pre_meshfem3D_asteroid_subdivide/compile_all.csh
___________________________________________________________________
Name: svn:executable
+ *
Name: svn:mergeinfo
+
Copied: seismo/3D/SPECFEM3D_SESAME/trunk/UTILS/external_mesh/pre_meshfem3D_asteroid_subdivide/constants_decompose_mesh.h (from rev 14285, seismo/3D/SPECFEM3D_SESAME/trunk/UTILS/external_mesh/pre_meshfem3D_asteroid_subdivide/constants_pre_meshfem3D.h)
===================================================================
--- seismo/3D/SPECFEM3D_SESAME/trunk/UTILS/external_mesh/pre_meshfem3D_asteroid_subdivide/constants_decompose_mesh.h (rev 0)
+++ seismo/3D/SPECFEM3D_SESAME/trunk/UTILS/external_mesh/pre_meshfem3D_asteroid_subdivide/constants_decompose_mesh.h 2009-03-12 17:37:00 UTC (rev 14301)
@@ -0,0 +1,11 @@
+! Useful kind types
+integer ,parameter :: short = SELECTED_INT_KIND(4), long = SELECTED_INT_KIND(18)
+
+! Number of nodes per elements.
+integer, parameter :: ESIZE = 8
+
+! Number of faces per element.
+integer, parameter :: nfaces = 6
+
+! very large and very small values
+ double precision, parameter :: HUGEVAL = 1.d+30,TINYVAL = 1.d-9
Property changes on: seismo/3D/SPECFEM3D_SESAME/trunk/UTILS/external_mesh/pre_meshfem3D_asteroid_subdivide/constants_decompose_mesh.h
___________________________________________________________________
Name: svn:mergeinfo
+
Deleted: seismo/3D/SPECFEM3D_SESAME/trunk/UTILS/external_mesh/pre_meshfem3D_asteroid_subdivide/constants_pre_meshfem3D.h
===================================================================
--- seismo/3D/SPECFEM3D_SESAME/trunk/UTILS/external_mesh/pre_meshfem3D_asteroid_subdivide/constants_pre_meshfem3D.h 2009-03-12 16:31:24 UTC (rev 14300)
+++ seismo/3D/SPECFEM3D_SESAME/trunk/UTILS/external_mesh/pre_meshfem3D_asteroid_subdivide/constants_pre_meshfem3D.h 2009-03-12 17:37:00 UTC (rev 14301)
@@ -1,11 +0,0 @@
-! Useful kind types
-integer ,parameter :: short = SELECTED_INT_KIND(4), long = SELECTED_INT_KIND(18)
-
-! Number of nodes per elements.
-integer, parameter :: ESIZE = 8
-
-! Number of faces per element.
-integer, parameter :: nfaces = 6
-
-! very large and very small values
- double precision, parameter :: HUGEVAL = 1.d+30,TINYVAL = 1.d-9
Copied: seismo/3D/SPECFEM3D_SESAME/trunk/UTILS/external_mesh/pre_meshfem3D_asteroid_subdivide/decompose_mesh.f90 (from rev 14285, seismo/3D/SPECFEM3D_SESAME/trunk/UTILS/external_mesh/pre_meshfem3D_asteroid_subdivide/pre_meshfem3D.f90)
===================================================================
--- seismo/3D/SPECFEM3D_SESAME/trunk/UTILS/external_mesh/pre_meshfem3D_asteroid_subdivide/decompose_mesh.f90 (rev 0)
+++ seismo/3D/SPECFEM3D_SESAME/trunk/UTILS/external_mesh/pre_meshfem3D_asteroid_subdivide/decompose_mesh.f90 2009-03-12 17:37:00 UTC (rev 14301)
@@ -0,0 +1,252 @@
+
+ program decompose_mesh
+
+ use part_decompose_mesh
+ implicit none
+
+ include './constants_decompose_mesh.h'
+ include "./scotchf.h"
+
+ integer, parameter :: nparts = 8
+
+ integer(long) :: nspec
+ integer, dimension(:,:), allocatable :: elmnts
+ integer, dimension(:), allocatable :: mat
+ integer, dimension(:), allocatable :: part
+
+ integer :: nnodes
+ double precision, dimension(:,:), allocatable :: nodes_coords
+
+ integer, dimension(:), allocatable :: xadj
+ integer, dimension(:), allocatable :: adjncy
+ integer, dimension(:), allocatable :: nnodes_elmnts
+ integer, dimension(:), allocatable :: nodes_elmnts
+
+ integer, dimension(:), allocatable :: vwgt
+ integer, dimension(:), allocatable :: adjwgt
+ integer, dimension(5) :: metis_options
+
+ integer, dimension(:), pointer :: glob2loc_elmnts
+ integer, dimension(:), pointer :: glob2loc_nodes_nparts
+ integer, dimension(:), pointer :: glob2loc_nodes_parts
+ integer, dimension(:), pointer :: glob2loc_nodes
+
+ integer, dimension(:), pointer :: tab_size_interfaces, tab_interfaces
+ integer, dimension(:), allocatable :: my_interfaces
+ integer, dimension(:), allocatable :: my_nb_interfaces
+ integer :: ninterfaces
+ integer :: my_ninterface
+
+ integer :: nb_materials
+ double precision, dimension(:), allocatable :: cs
+ integer, dimension(:), allocatable :: num_material
+
+ integer(long) :: nsize ! Max number of elements that contain the same node.
+ integer :: edgecut
+ integer :: nb_edges
+
+ integer :: ispec, inode
+ integer :: wgtflag
+ integer :: num_start
+ integer :: ngnod
+ integer :: max_neighbour ! Real maximum number of neighbours per element
+ integer(long) :: sup_neighbour ! Majoration of the maximum number of neighbours per element
+
+ integer :: ipart, nnodes_loc, nspec_loc
+ character(len=256) :: prname
+
+ logical, dimension(:), allocatable :: mask_nodes_elmnts
+ integer, dimension(:), allocatable :: used_nodes_elmnts
+
+!!!! NL NL for SCOTCH partitioner
+ double precision, dimension(SCOTCH_GRAPHDIM) :: scotchgraph
+ double precision, dimension(SCOTCH_STRATDIM) :: scotchstrat
+ character(len=256), parameter :: scotch_strategy='b{job=t,map=t,poli=S,sep=h{pass=30}}'
+ integer :: ierr
+!!!! NL NL
+
+
+ ngnod = esize
+
+! read the elements, material and nodes files
+ open(unit=98, file='../model_asteroid_subdivide/mesh', status='old', form='formatted')
+ read(98,*) nspec
+ allocate(elmnts(esize,nspec))
+ do ispec = 1, nspec
+ read(98,*) elmnts(1,ispec), elmnts(2,ispec), elmnts(3,ispec), elmnts(4,ispec), &
+ elmnts(5,ispec), elmnts(6,ispec), elmnts(7,ispec), elmnts(8,ispec)
+ end do
+ close(98)
+
+ open(unit=98, file='../model_asteroid_subdivide/mat', status='old', form='formatted')
+ allocate(mat(nspec))
+ do ispec = 1, nspec
+ read(98,*) mat(ispec)
+ end do
+ close(98)
+
+ open(unit=98, file='../model_asteroid_subdivide/nodes_coords', status='old', form='formatted')
+ read(98,*) nnodes
+ allocate(nodes_coords(3,nnodes))
+ do inode = 1, nnodes
+ read(98,*) nodes_coords(1,inode), nodes_coords(2,inode), nodes_coords(3,inode)
+ end do
+ close(98)
+
+ allocate(mask_nodes_elmnts(nnodes))
+ allocate(used_nodes_elmnts(nnodes))
+ mask_nodes_elmnts(:) = .false.
+ used_nodes_elmnts(:) = 0
+ do ispec = 1, nspec
+ do inode = 1, ESIZE
+ mask_nodes_elmnts(elmnts(inode,ispec)) = .true.
+ used_nodes_elmnts(elmnts(inode,ispec)) = used_nodes_elmnts(elmnts(inode,ispec)) + 1
+ enddo
+ enddo
+ nsize = maxval(used_nodes_elmnts(:))
+ sup_neighbour = ngnod * nsize - (ngnod + (ngnod/2 - 1)*nfaces)
+ print*, 'nsize = ',nsize, 'sup_neighbour = ', sup_neighbour
+
+ do inode = 1, nnodes
+ if (.not. mask_nodes_elmnts(inode)) then
+ stop 'ERROR : nodes not used.'
+ endif
+ enddo
+! if (maxval(used_nodes_elmnts(:))>nsize) then
+! stop 'ERROR : increase nsize or modify the mesh.'
+! endif
+
+ elmnts(:,:) = elmnts(:,:) - 1
+
+ allocate(xadj(1:nspec+1))
+ allocate(adjncy(1:sup_neighbour*nspec))
+ allocate(nnodes_elmnts(1:nnodes))
+ allocate(nodes_elmnts(1:nsize*nnodes))
+
+ call mesh2dual_ncommonnodes(nspec, nnodes, nsize, sup_neighbour, elmnts, xadj, adjncy, nnodes_elmnts, &
+ nodes_elmnts, max_neighbour, 1)
+ print*, 'max_neighbour = ',max_neighbour
+
+
+ ! elmnts(:,:) = elmnts(:,:) + 1
+ ! adjncy(:) = adjncy(:) + 1
+ ! xadj(:) = xadj(:) + 1
+! allocate(vwgt(0:nspec-1))
+ nb_edges = xadj(nspec+1)
+! allocate(adjwgt(0:nb_edges-1))
+! vwgt(:) = 1
+! adjwgt(:) = 1
+
+! metis_options(1) = 0
+! metis_options(2) = 3
+! metis_options(3) = 1
+! metis_options(4) = 1
+! metis_options(5) = 0
+
+
+! num_start = 0
+! wgtflag = 0
+
+ allocate(part(1:nspec))
+
+
+! Old metis partitioning
+! call METIS_PartGraphRecursive(nspec, xadj(1), adjncy(1), vwgt(0), adjwgt(0), wgtflag, num_start, nparts, &
+! metis_options, edgecut, part(1));
+
+! SCOTCH partitioning
+ call scotchfstratinit (scotchstrat(1), ierr)
+ if (ierr /= 0) then
+ stop 'ERROR : MAIN : Cannot initialize strat'
+ endif
+
+ call scotchfstratgraphmap (scotchstrat(1), trim(scotch_strategy), ierr)
+ if (ierr /= 0) then
+ stop 'ERROR : MAIN : Cannot build strat'
+ endif
+
+ call scotchfgraphinit (scotchgraph (1), ierr)
+ if (ierr /= 0) then
+ stop 'ERROR : MAIN : Cannot initialize graph'
+ endif
+
+ call scotchfgraphbuild (scotchgraph (1), 0, nspec, xadj (1), xadj (1), &
+ xadj (1), xadj (1), nb_edges, adjncy (1), adjncy (1), ierr)
+ if (ierr /= 0) then
+ stop 'ERROR : MAIN : Cannot build graph'
+ endif
+
+ call scotchfgraphcheck (scotchgraph (1), ierr)
+ if (ierr /= 0) then
+ stop 'ERROR : MAIN : Invalid check'
+ endif
+
+ call scotchfgraphpart (scotchgraph (1), nparts, scotchstrat(1),part(1),ierr)
+ if (ierr /= 0) then
+ stop 'ERROR : MAIN : Cannot part graph'
+ endif
+
+ call scotchfgraphexit (scotchgraph (1), ierr)
+ if (ierr /= 0) then
+ stop 'ERROR : MAIN : Cannot destroy graph'
+ endif
+
+ call scotchfstratexit (scotchstrat(1), ierr)
+ if (ierr /= 0) then
+ stop 'ERROR : MAIN : Cannot destroy strat'
+ endif
+
+
+! local number of each element for each partition
+ call Construct_glob2loc_elmnts(nspec, part, nparts, glob2loc_elmnts)
+
+! local number of each node for each partition
+ call Construct_glob2loc_nodes(nspec, nnodes,nsize, nnodes_elmnts, nodes_elmnts, part, nparts, &
+ glob2loc_nodes_nparts, glob2loc_nodes_parts, glob2loc_nodes)
+
+ nb_materials = 1
+ allocate(cs(nb_materials))
+ allocate(num_material(nspec))
+ cs(:) = 1000.d0
+ num_material(:) = 1
+
+ call Construct_interfaces(nspec, nparts, sup_neighbour, part, elmnts, xadj, adjncy, tab_interfaces, &
+ tab_size_interfaces, ninterfaces, nb_materials, cs, num_material)
+
+ allocate(my_interfaces(0:ninterfaces-1))
+ allocate(my_nb_interfaces(0:ninterfaces-1))
+
+
+
+ do ipart = 0, nparts-1
+
+ !write(prname, "('/Database',i5.5)") ipart
+ write(prname, "(i6.6,'_Database')") ipart
+ open(unit=15,file='./OUTPUT_FILES/proc'//prname,status='unknown', action='write', form='formatted')
+
+ call write_glob2loc_nodes_database(15, ipart, nnodes_loc, nodes_coords, glob2loc_nodes_nparts, glob2loc_nodes_parts, &
+ glob2loc_nodes, nnodes, 1)
+ call write_partition_database(15, ipart, nspec_loc, nspec, elmnts, glob2loc_elmnts, glob2loc_nodes_nparts, &
+ glob2loc_nodes_parts, glob2loc_nodes, part, num_material, ngnod, 1)
+
+ write(15,*) nnodes_loc
+ call write_glob2loc_nodes_database(15, ipart, nnodes_loc, nodes_coords, glob2loc_nodes_nparts, glob2loc_nodes_parts, &
+ glob2loc_nodes, nnodes, 2)
+ write(15,*) nspec_loc
+ call write_partition_database(15, ipart, nspec_loc, nspec, elmnts, glob2loc_elmnts, glob2loc_nodes_nparts, &
+ glob2loc_nodes_parts, glob2loc_nodes, part, num_material, ngnod, 2)
+
+ call Write_interfaces_database(15, tab_interfaces, tab_size_interfaces, nparts, ipart, ninterfaces, &
+ my_ninterface, my_interfaces, my_nb_interfaces, glob2loc_elmnts, glob2loc_nodes_nparts, glob2loc_nodes_parts, &
+ glob2loc_nodes, 1)
+ write(15,*) my_ninterface, maxval(my_nb_interfaces)
+ call Write_interfaces_database(15, tab_interfaces, tab_size_interfaces, nparts, ipart, ninterfaces, &
+ my_ninterface, my_interfaces, my_nb_interfaces, glob2loc_elmnts, glob2loc_nodes_nparts, glob2loc_nodes_parts, &
+ glob2loc_nodes, 2)
+
+ close(15)
+
+ enddo
+
+ end program decompose_mesh
+
Property changes on: seismo/3D/SPECFEM3D_SESAME/trunk/UTILS/external_mesh/pre_meshfem3D_asteroid_subdivide/decompose_mesh.f90
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: seismo/3D/SPECFEM3D_SESAME/trunk/UTILS/external_mesh/pre_meshfem3D_asteroid_subdivide/part_decompose_mesh.f90 (from rev 14285, seismo/3D/SPECFEM3D_SESAME/trunk/UTILS/external_mesh/pre_meshfem3D_asteroid_subdivide/part_pre_meshfem3D.f90)
===================================================================
--- seismo/3D/SPECFEM3D_SESAME/trunk/UTILS/external_mesh/pre_meshfem3D_asteroid_subdivide/part_decompose_mesh.f90 (rev 0)
+++ seismo/3D/SPECFEM3D_SESAME/trunk/UTILS/external_mesh/pre_meshfem3D_asteroid_subdivide/part_decompose_mesh.f90 2009-03-12 17:37:00 UTC (rev 14301)
@@ -0,0 +1,622 @@
+module part_decompose_mesh
+
+ implicit none
+
+contains
+
+ !-----------------------------------------------
+ ! Creating dual graph (adjacency is defined by 'ncommonnodes' between two elements).
+ !-----------------------------------------------
+ subroutine mesh2dual_ncommonnodes(nelmnts, nnodes, nsize, sup_neighbour, elmnts, xadj, adjncy, &
+ nnodes_elmnts, nodes_elmnts, max_neighbour, ncommonnodes)
+
+ include './constants_decompose_mesh.h'
+
+ integer(long), intent(in) :: nelmnts
+ integer, intent(in) :: nnodes
+ integer(long), intent(in) :: nsize
+ integer(long), intent(in) :: sup_neighbour
+ integer, dimension(0:esize*nelmnts-1), intent(in) :: elmnts
+ integer, dimension(0:nelmnts) :: xadj
+ integer, dimension(0:sup_neighbour*nelmnts-1) :: adjncy
+ integer, dimension(0:nnodes-1) :: nnodes_elmnts
+ integer, dimension(0:nsize*nnodes-1) :: nodes_elmnts
+ integer, intent(out) :: max_neighbour
+ integer, intent(in) :: ncommonnodes
+
+ integer :: i, j, k, l, m, nb_edges
+ logical :: is_neighbour
+ integer :: num_node, n
+ integer :: elem_base, elem_target
+ integer :: connectivity
+
+
+ !allocate(xadj(0:nelmnts))
+ xadj(:) = 0
+ !allocate(adjncy(0:max_neighbour*nelmnts-1))
+ adjncy(:) = 0
+ !allocate(nnodes_elmnts(0:nnodes-1))
+ nnodes_elmnts(:) = 0
+ !allocate(nodes_elmnts(0:nsize*nnodes-1))
+ nodes_elmnts(:) = 0
+
+ nb_edges = 0
+
+
+ ! list of elements per node
+ do i = 0, esize*nelmnts-1
+ nodes_elmnts(elmnts(i)*nsize+nnodes_elmnts(elmnts(i))) = i/esize
+ nnodes_elmnts(elmnts(i)) = nnodes_elmnts(elmnts(i)) + 1
+
+ end do
+
+ !print *, 'nnodes_elmnts'
+
+ ! checking which elements are neighbours ('ncommonnodes' criteria)
+ do j = 0, nnodes-1
+ do k = 0, nnodes_elmnts(j)-1
+ do l = k+1, nnodes_elmnts(j)-1
+
+ connectivity = 0
+ elem_base = nodes_elmnts(k+j*nsize)
+ elem_target = nodes_elmnts(l+j*nsize)
+ do n = 1, esize
+ num_node = elmnts(esize*elem_base+n-1)
+ do m = 0, nnodes_elmnts(num_node)-1
+ if ( nodes_elmnts(m+num_node*nsize) == elem_target ) then
+ connectivity = connectivity + 1
+ end if
+ end do
+ end do
+
+ if ( connectivity >= ncommonnodes) then
+
+ is_neighbour = .false.
+
+ do m = 0, xadj(nodes_elmnts(k+j*nsize))
+ if ( .not.is_neighbour ) then
+ if ( adjncy(nodes_elmnts(k+j*nsize)*sup_neighbour+m) == nodes_elmnts(l+j*nsize) ) then
+ is_neighbour = .true.
+
+ end if
+ end if
+ end do
+ if ( .not.is_neighbour ) then
+ adjncy(nodes_elmnts(k+j*nsize)*sup_neighbour+xadj(nodes_elmnts(k+j*nsize))) = nodes_elmnts(l+j*nsize)
+ xadj(nodes_elmnts(k+j*nsize)) = xadj(nodes_elmnts(k+j*nsize)) + 1
+ if (xadj(nodes_elmnts(k+j*nsize))>sup_neighbour) stop 'ERROR : too much neighbours per element, modify the mesh.'
+ adjncy(nodes_elmnts(l+j*nsize)*sup_neighbour+xadj(nodes_elmnts(l+j*nsize))) = nodes_elmnts(k+j*nsize)
+ xadj(nodes_elmnts(l+j*nsize)) = xadj(nodes_elmnts(l+j*nsize)) + 1
+ if (xadj(nodes_elmnts(l+j*nsize))>sup_neighbour) stop 'ERROR : too much neighbours per element, modify the mesh.'
+ end if
+ end if
+ end do
+ end do
+ end do
+
+ max_neighbour = maxval(xadj)
+
+ ! making adjacency arrays compact (to be used for partitioning)
+ do i = 0, nelmnts-1
+ k = xadj(i)
+ xadj(i) = nb_edges
+ do j = 0, k-1
+ adjncy(nb_edges) = adjncy(i*sup_neighbour+j)
+ nb_edges = nb_edges + 1
+ end do
+ end do
+
+ xadj(nelmnts) = nb_edges
+
+
+ end subroutine mesh2dual_ncommonnodes
+
+
+
+ !--------------------------------------------------
+ ! construct local numbering for the elements in each partition
+ !--------------------------------------------------
+ subroutine Construct_glob2loc_elmnts(nelmnts, part, nparts, glob2loc_elmnts)
+
+ include './constants_decompose_mesh.h'
+
+ integer(long), intent(in) :: nelmnts
+ integer, intent(in) :: nparts
+ integer, dimension(0:nelmnts-1), intent(in) :: part
+ integer, dimension(:), pointer :: glob2loc_elmnts
+
+ integer :: num_glob, num_part
+ integer, dimension(0:nparts-1) :: num_loc
+
+
+ allocate(glob2loc_elmnts(0:nelmnts-1))
+
+ do num_part = 0, nparts-1
+ num_loc(num_part) = 0
+
+ end do
+
+ do num_glob = 0, nelmnts-1
+ num_part = part(num_glob)
+ glob2loc_elmnts(num_glob) = num_loc(num_part)
+ num_loc(num_part) = num_loc(num_part) + 1
+
+ end do
+
+
+ end subroutine Construct_glob2loc_elmnts
+
+
+
+ !--------------------------------------------------
+ ! construct local numbering for the nodes in each partition
+ !--------------------------------------------------
+ subroutine Construct_glob2loc_nodes(nelmnts, nnodes, nsize, nnodes_elmnts, nodes_elmnts, part, nparts, &
+ glob2loc_nodes_nparts, glob2loc_nodes_parts, glob2loc_nodes)
+
+ include './constants_decompose_mesh.h'
+
+ integer(long), intent(in) :: nelmnts, nsize
+ integer, intent(in) :: nnodes, nparts
+ integer, dimension(0:nelmnts-1), intent(in) :: part
+ integer, dimension(0:nnodes-1), intent(in) :: nnodes_elmnts
+ integer, dimension(0:nsize*nnodes-1), intent(in) :: nodes_elmnts
+ integer, dimension(:), pointer :: glob2loc_nodes_nparts
+ integer, dimension(:), pointer :: glob2loc_nodes_parts
+ integer, dimension(:), pointer :: glob2loc_nodes
+
+ integer :: num_node
+ integer :: el
+ integer :: num_part
+ integer :: size_glob2loc_nodes
+ integer, dimension(0:nparts-1) :: parts_node
+ integer, dimension(0:nparts-1) :: num_parts
+
+ allocate(glob2loc_nodes_nparts(0:nnodes))
+
+ size_glob2loc_nodes = 0
+
+ parts_node(:) = 0
+
+
+ do num_node = 0, nnodes-1
+ glob2loc_nodes_nparts(num_node) = size_glob2loc_nodes
+ do el = 0, nnodes_elmnts(num_node)-1
+ parts_node(part(nodes_elmnts(el+nsize*num_node))) = 1
+
+ end do
+
+ do num_part = 0, nparts-1
+ if ( parts_node(num_part) == 1 ) then
+ size_glob2loc_nodes = size_glob2loc_nodes + 1
+ parts_node(num_part) = 0
+
+ end if
+ end do
+
+ end do
+
+ glob2loc_nodes_nparts(nnodes) = size_glob2loc_nodes
+
+ allocate(glob2loc_nodes_parts(0:glob2loc_nodes_nparts(nnodes)-1))
+ allocate(glob2loc_nodes(0:glob2loc_nodes_nparts(nnodes)-1))
+
+ glob2loc_nodes(0) = 0
+
+ parts_node(:) = 0
+ num_parts(:) = 0
+ size_glob2loc_nodes = 0
+
+
+ do num_node = 0, nnodes-1
+ do el = 0, nnodes_elmnts(num_node)-1
+ parts_node(part(nodes_elmnts(el+nsize*num_node))) = 1
+
+ end do
+ do num_part = 0, nparts-1
+
+ if ( parts_node(num_part) == 1 ) then
+ glob2loc_nodes_parts(size_glob2loc_nodes) = num_part
+ glob2loc_nodes(size_glob2loc_nodes) = num_parts(num_part)
+ size_glob2loc_nodes = size_glob2loc_nodes + 1
+ num_parts(num_part) = num_parts(num_part) + 1
+ parts_node(num_part) = 0
+ end if
+
+ end do
+ end do
+
+
+ end subroutine Construct_glob2loc_nodes
+
+
+
+ !--------------------------------------------------
+ ! Construct interfaces between each partitions.
+ ! Two adjacent elements in distinct partitions make an entry in array tab_interfaces :
+ ! 1/ first element, 2/ second element, 3/ number of common nodes, 4/ first node,
+ ! 5/ second node, if relevant.
+ ! No interface between acoustic and elastic elements.
+ !--------------------------------------------------
+ subroutine Construct_interfaces(nelmnts, nparts, sup_neighbour, part, elmnts, xadj, adjncy, &
+ tab_interfaces, tab_size_interfaces, ninterfaces, nb_materials, cs_material, num_material)
+
+ include './constants_decompose_mesh.h'
+
+ integer, intent(in) :: nparts
+ integer(long), intent(in) :: nelmnts, sup_neighbour
+ integer, dimension(0:nelmnts-1), intent(in) :: part
+ integer, dimension(0:esize*nelmnts-1), intent(in) :: elmnts
+ integer, dimension(0:nelmnts), intent(in) :: xadj
+ integer, dimension(0:sup_neighbour*nelmnts-1), intent(in) :: adjncy
+ integer, dimension(:),pointer :: tab_size_interfaces, tab_interfaces
+ integer, intent(out) :: ninterfaces
+ integer, dimension(1:nelmnts), intent(in) :: num_material
+ double precision, dimension(1:nb_materials), intent(in) :: cs_material
+ integer, intent(in) :: nb_materials
+
+
+ integer :: num_part, num_part_bis, el, el_adj, num_interface, num_edge, ncommon_nodes, &
+ num_node, num_node_bis
+ integer :: i, j
+ logical :: is_acoustic_el, is_acoustic_el_adj
+
+ ninterfaces = 0
+ do i = 0, nparts-1
+ do j = i+1, nparts-1
+ ninterfaces = ninterfaces + 1
+ end do
+ end do
+
+ allocate(tab_size_interfaces(0:ninterfaces))
+ tab_size_interfaces(:) = 0
+
+ num_interface = 0
+ num_edge = 0
+
+ do num_part = 0, nparts-1
+ do num_part_bis = num_part+1, nparts-1
+ do el = 0, nelmnts-1
+ if ( part(el) == num_part ) then
+ if ( cs_material(num_material(el+1)) < TINYVAL) then
+ is_acoustic_el = .true.
+ else
+ is_acoustic_el = .false.
+ end if
+ do el_adj = xadj(el), xadj(el+1)-1
+ if ( cs_material(num_material(adjncy(el_adj)+1)) < TINYVAL) then
+ is_acoustic_el_adj = .true.
+ else
+ is_acoustic_el_adj = .false.
+ end if
+ if ( (part(adjncy(el_adj)) == num_part_bis) .and. (is_acoustic_el .eqv. is_acoustic_el_adj) ) then
+ num_edge = num_edge + 1
+
+ end if
+ end do
+ end if
+ end do
+ tab_size_interfaces(num_interface+1) = tab_size_interfaces(num_interface) + num_edge
+ num_edge = 0
+ num_interface = num_interface + 1
+
+ end do
+ end do
+
+ num_interface = 0
+ num_edge = 0
+
+ allocate(tab_interfaces(0:(tab_size_interfaces(ninterfaces)*7-1)))
+ tab_interfaces(:) = 0
+
+ do num_part = 0, nparts-1
+ do num_part_bis = num_part+1, nparts-1
+ do el = 0, nelmnts-1
+ if ( part(el) == num_part ) then
+ if ( cs_material(num_material(el+1)) < TINYVAL) then
+ is_acoustic_el = .true.
+ else
+ is_acoustic_el = .false.
+ end if
+ do el_adj = xadj(el), xadj(el+1)-1
+ if ( cs_material(num_material(adjncy(el_adj)+1)) < TINYVAL) then
+ is_acoustic_el_adj = .true.
+ else
+ is_acoustic_el_adj = .false.
+ end if
+ if ( (part(adjncy(el_adj)) == num_part_bis) .and. (is_acoustic_el .eqv. is_acoustic_el_adj) ) then
+ tab_interfaces(tab_size_interfaces(num_interface)*7+num_edge*7+0) = el
+ tab_interfaces(tab_size_interfaces(num_interface)*7+num_edge*7+1) = adjncy(el_adj)
+ ncommon_nodes = 0
+ do num_node = 0, esize-1
+ do num_node_bis = 0, esize-1
+ if ( elmnts(el*esize+num_node) == elmnts(adjncy(el_adj)*esize+num_node_bis) ) then
+ tab_interfaces(tab_size_interfaces(num_interface)*7+num_edge*7+3+ncommon_nodes) &
+ = elmnts(el*esize+num_node)
+ ncommon_nodes = ncommon_nodes + 1
+ end if
+ end do
+ end do
+ if ( ncommon_nodes > 0 ) then
+ tab_interfaces(tab_size_interfaces(num_interface)*7+num_edge*7+2) = ncommon_nodes
+ else
+ print *, "Error while building interfaces!", ncommon_nodes
+ end if
+ num_edge = num_edge + 1
+ end if
+ end do
+ end if
+
+ end do
+ num_edge = 0
+ num_interface = num_interface + 1
+ end do
+ end do
+
+
+ end subroutine Construct_interfaces
+
+
+
+ !--------------------------------------------------
+ ! Write nodes (their coordinates) pertaining to iproc partition in the corresponding Database
+ !--------------------------------------------------
+ subroutine write_glob2loc_nodes_database(IIN_database, iproc, npgeo, nodes_coords, glob2loc_nodes_nparts, glob2loc_nodes_parts, &
+ glob2loc_nodes, nnodes, num_phase)
+
+ integer, intent(in) :: IIN_database
+ integer, intent(in) :: nnodes, iproc, num_phase
+ integer, intent(inout) :: npgeo
+
+ double precision, dimension(3,nnodes) :: nodes_coords
+ integer, dimension(:), pointer :: glob2loc_nodes_nparts
+ integer, dimension(:), pointer :: glob2loc_nodes_parts
+ integer, dimension(:), pointer :: glob2loc_nodes
+
+ integer :: i, j
+
+ if ( num_phase == 1 ) then
+ npgeo = 0
+
+ do i = 0, nnodes-1
+ do j = glob2loc_nodes_nparts(i), glob2loc_nodes_nparts(i+1)-1
+ if ( glob2loc_nodes_parts(j) == iproc ) then
+ npgeo = npgeo + 1
+
+ end if
+
+ end do
+ end do
+ else
+ do i = 0, nnodes-1
+ do j = glob2loc_nodes_nparts(i), glob2loc_nodes_nparts(i+1)-1
+ if ( glob2loc_nodes_parts(j) == iproc ) then
+ write(IIN_database,*) glob2loc_nodes(j)+1, nodes_coords(1,i+1), nodes_coords(2,i+1), nodes_coords(3,i+1)
+ end if
+ end do
+ end do
+ end if
+
+ end subroutine Write_glob2loc_nodes_database
+
+
+
+ !--------------------------------------------------
+ ! Write elements (their nodes) pertaining to iproc partition in the corresponding Database
+ !--------------------------------------------------
+ subroutine write_partition_database(IIN_database, iproc, nspec, nelmnts, elmnts, glob2loc_elmnts, glob2loc_nodes_nparts, &
+ glob2loc_nodes_parts, glob2loc_nodes, part, num_modele, ngnod, num_phase)
+
+ include './constants_decompose_mesh.h'
+
+ integer, intent(in) :: IIN_database
+ integer, intent(in) :: num_phase, iproc
+ integer(long), intent(in) :: nelmnts
+ integer, intent(inout) :: nspec
+ integer, dimension(0:nelmnts-1) :: part
+ integer, dimension(0:esize*nelmnts-1) :: elmnts
+ integer, dimension(:), pointer :: glob2loc_elmnts
+ integer, dimension(:) :: num_modele
+ integer, dimension(:), pointer :: glob2loc_nodes_nparts
+ integer, dimension(:), pointer :: glob2loc_nodes_parts
+ integer, dimension(:), pointer :: glob2loc_nodes
+ integer, intent(in) :: ngnod
+
+ integer :: i,j,k
+ integer, dimension(0:ngnod-1) :: loc_nodes
+
+ if ( num_phase == 1 ) then
+ nspec = 0
+
+ do i = 0, nelmnts-1
+ if ( part(i) == iproc ) then
+ nspec = nspec + 1
+
+ end if
+ end do
+
+ else
+ do i = 0, nelmnts-1
+ if ( part(i) == iproc ) then
+
+ do j = 0, ngnod-1
+ do k = glob2loc_nodes_nparts(elmnts(i*ngnod+j)), glob2loc_nodes_nparts(elmnts(i*ngnod+j)+1)-1
+
+ if ( glob2loc_nodes_parts(k) == iproc ) then
+ loc_nodes(j) = glob2loc_nodes(k)
+
+ end if
+ end do
+
+ end do
+ write(IIN_database,*) glob2loc_elmnts(i)+1, num_modele(i+1), (loc_nodes(k)+1, k=0,ngnod-1)
+ end if
+ end do
+ end if
+
+
+ end subroutine write_partition_database
+
+
+
+
+ !--------------------------------------------------
+ ! Write interfaces (element and common nodes) pertaining to iproc partition in the corresponding Database
+ !--------------------------------------------------
+ subroutine write_interfaces_database(IIN_database, tab_interfaces, tab_size_interfaces, nparts, iproc, ninterfaces, &
+ my_ninterface, my_interfaces, my_nb_interfaces, glob2loc_elmnts, glob2loc_nodes_nparts, glob2loc_nodes_parts, &
+ glob2loc_nodes, num_phase)
+
+ integer, intent(in) :: IIN_database
+ integer, intent(in) :: iproc
+ integer, intent(in) :: nparts
+ integer, intent(in) :: ninterfaces
+ integer, intent(inout) :: my_ninterface
+ integer, dimension(:), pointer :: tab_size_interfaces
+ integer, dimension(:), pointer :: tab_interfaces
+ integer, dimension(0:ninterfaces-1), intent(inout) :: my_interfaces
+ integer, dimension(0:ninterfaces-1), intent(inout) :: my_nb_interfaces
+ integer, dimension(:), pointer :: glob2loc_elmnts
+ integer, dimension(:), pointer :: glob2loc_nodes_nparts
+ integer, dimension(:), pointer :: glob2loc_nodes_parts
+ integer, dimension(:), pointer :: glob2loc_nodes
+
+ integer, dimension(4) :: local_nodes
+ integer :: local_elmnt
+ integer :: num_phase
+
+ integer :: i, j, k, l
+ integer :: num_interface
+
+ num_interface = 0
+
+ if ( num_phase == 1 ) then
+
+ my_interfaces(:) = 0
+ my_nb_interfaces(:) = 0
+
+ do i = 0, nparts-1
+ do j = i+1, nparts-1
+ if ( (tab_size_interfaces(num_interface) < tab_size_interfaces(num_interface+1)) .and. &
+ (i == iproc .or. j == iproc) ) then
+ my_interfaces(num_interface) = 1
+ my_nb_interfaces(num_interface) = tab_size_interfaces(num_interface+1) - tab_size_interfaces(num_interface)
+ end if
+ num_interface = num_interface + 1
+ end do
+ end do
+ my_ninterface = sum(my_interfaces(:))
+
+ else
+
+ do i = 0, nparts-1
+ do j = i+1, nparts-1
+ if ( my_interfaces(num_interface) == 1 ) then
+ if ( i == iproc ) then
+ write(IIN_database,*) j, my_nb_interfaces(num_interface)
+ else
+ write(IIN_database,*) i, my_nb_interfaces(num_interface)
+ end if
+
+ do k = tab_size_interfaces(num_interface), tab_size_interfaces(num_interface+1)-1
+ if ( i == iproc ) then
+ local_elmnt = glob2loc_elmnts(tab_interfaces(k*7+0))+1
+ else
+ local_elmnt = glob2loc_elmnts(tab_interfaces(k*7+1))+1
+ end if
+
+!!$ if ( tab_interfaces(k*7+2) == 1 ) then
+!!$ do l = glob2loc_nodes_nparts(tab_interfaces(k*7+3)), &
+!!$ glob2loc_nodes_nparts(tab_interfaces(k*7+3)+1)-1
+!!$ if ( glob2loc_nodes_parts(l) == iproc ) then
+!!$ local_nodes(1) = glob2loc_nodes(l)+1
+!!$ end if
+!!$ end do
+!!$
+!!$ write(IIN_database,*) local_elmnt, tab_interfaces(k*7+2), local_nodes(1), -1
+!!$ else
+!!$ if ( tab_interfaces(k*7+2) == 2 ) then
+!!$ do l = glob2loc_nodes_nparts(tab_interfaces(k*7+3)), &
+!!$ glob2loc_nodes_nparts(tab_interfaces(k*7+3)+1)-1
+!!$ if ( glob2loc_nodes_parts(l) == iproc ) then
+!!$ local_nodes(1) = glob2loc_nodes(l)+1
+!!$ end if
+!!$ end do
+!!$ do l = glob2loc_nodes_nparts(tab_interfaces(k*7+4)), &
+!!$ glob2loc_nodes_nparts(tab_interfaces(k*7+4)+1)-1
+!!$ if ( glob2loc_nodes_parts(l) == iproc ) then
+!!$ local_nodes(2) = glob2loc_nodes(l)+1
+!!$ end if
+!!$ end do
+!!$ write(IIN_database,*) local_elmnt, tab_interfaces(k*7+2), local_nodes(1), local_nodes(2)
+!!$ else
+!!$ write(IIN_database,*) "erreur_write_interface_", tab_interfaces(k*7+2)
+!!$ end if
+!!$ end if
+ select case (tab_interfaces(k*7+2))
+ case (1)
+ do l = glob2loc_nodes_nparts(tab_interfaces(k*7+3)), &
+ glob2loc_nodes_nparts(tab_interfaces(k*7+3)+1)-1
+ if ( glob2loc_nodes_parts(l) == iproc ) then
+ local_nodes(1) = glob2loc_nodes(l)+1
+ end if
+ end do
+ write(IIN_database,*) local_elmnt, tab_interfaces(k*7+2), local_nodes(1), -1, -1, -1
+ case (2)
+ do l = glob2loc_nodes_nparts(tab_interfaces(k*7+3)), &
+ glob2loc_nodes_nparts(tab_interfaces(k*7+3)+1)-1
+ if ( glob2loc_nodes_parts(l) == iproc ) then
+ local_nodes(1) = glob2loc_nodes(l)+1
+ end if
+ end do
+ do l = glob2loc_nodes_nparts(tab_interfaces(k*7+4)), &
+ glob2loc_nodes_nparts(tab_interfaces(k*7+4)+1)-1
+ if ( glob2loc_nodes_parts(l) == iproc ) then
+ local_nodes(2) = glob2loc_nodes(l)+1
+ end if
+ end do
+ write(IIN_database,*) local_elmnt, tab_interfaces(k*7+2), local_nodes(1), local_nodes(2), -1, -1
+ case (4)
+ do l = glob2loc_nodes_nparts(tab_interfaces(k*7+3)), &
+ glob2loc_nodes_nparts(tab_interfaces(k*7+3)+1)-1
+ if ( glob2loc_nodes_parts(l) == iproc ) then
+ local_nodes(1) = glob2loc_nodes(l)+1
+ end if
+ end do
+ do l = glob2loc_nodes_nparts(tab_interfaces(k*7+4)), &
+ glob2loc_nodes_nparts(tab_interfaces(k*7+4)+1)-1
+ if ( glob2loc_nodes_parts(l) == iproc ) then
+ local_nodes(2) = glob2loc_nodes(l)+1
+ end if
+ end do
+ do l = glob2loc_nodes_nparts(tab_interfaces(k*7+5)), &
+ glob2loc_nodes_nparts(tab_interfaces(k*7+5)+1)-1
+ if ( glob2loc_nodes_parts(l) == iproc ) then
+ local_nodes(3) = glob2loc_nodes(l)+1
+ end if
+ end do
+ do l = glob2loc_nodes_nparts(tab_interfaces(k*7+6)), &
+ glob2loc_nodes_nparts(tab_interfaces(k*7+6)+1)-1
+ if ( glob2loc_nodes_parts(l) == iproc ) then
+ local_nodes(4) = glob2loc_nodes(l)+1
+ end if
+ end do
+ write(IIN_database,*) local_elmnt, tab_interfaces(k*7+2), &
+ local_nodes(1), local_nodes(2),local_nodes(3), local_nodes(4)
+ case default
+ print *, "error in write_interfaces_database!", tab_interfaces(k*7+2), iproc
+ end select
+ end do
+
+ end if
+
+ num_interface = num_interface + 1
+ end do
+ end do
+
+ end if
+
+ end subroutine write_interfaces_database
+
+end module part_decompose_mesh
+
Property changes on: seismo/3D/SPECFEM3D_SESAME/trunk/UTILS/external_mesh/pre_meshfem3D_asteroid_subdivide/part_decompose_mesh.f90
___________________________________________________________________
Name: svn:mergeinfo
+
Deleted: seismo/3D/SPECFEM3D_SESAME/trunk/UTILS/external_mesh/pre_meshfem3D_asteroid_subdivide/part_pre_meshfem3D.f90
===================================================================
--- seismo/3D/SPECFEM3D_SESAME/trunk/UTILS/external_mesh/pre_meshfem3D_asteroid_subdivide/part_pre_meshfem3D.f90 2009-03-12 16:31:24 UTC (rev 14300)
+++ seismo/3D/SPECFEM3D_SESAME/trunk/UTILS/external_mesh/pre_meshfem3D_asteroid_subdivide/part_pre_meshfem3D.f90 2009-03-12 17:37:00 UTC (rev 14301)
@@ -1,622 +0,0 @@
-module part_pre_meshfem3D
-
- implicit none
-
-contains
-
- !-----------------------------------------------
- ! Creating dual graph (adjacency is defined by 'ncommonnodes' between two elements).
- !-----------------------------------------------
- subroutine mesh2dual_ncommonnodes(nelmnts, nnodes, nsize, sup_neighbour, elmnts, xadj, adjncy, &
- nnodes_elmnts, nodes_elmnts, max_neighbour, ncommonnodes)
-
- include './constants_pre_meshfem3D.h'
-
- integer(long), intent(in) :: nelmnts
- integer, intent(in) :: nnodes
- integer(long), intent(in) :: nsize
- integer(long), intent(in) :: sup_neighbour
- integer, dimension(0:esize*nelmnts-1), intent(in) :: elmnts
- integer, dimension(0:nelmnts) :: xadj
- integer, dimension(0:sup_neighbour*nelmnts-1) :: adjncy
- integer, dimension(0:nnodes-1) :: nnodes_elmnts
- integer, dimension(0:nsize*nnodes-1) :: nodes_elmnts
- integer, intent(out) :: max_neighbour
- integer, intent(in) :: ncommonnodes
-
- integer :: i, j, k, l, m, nb_edges
- logical :: is_neighbour
- integer :: num_node, n
- integer :: elem_base, elem_target
- integer :: connectivity
-
-
- !allocate(xadj(0:nelmnts))
- xadj(:) = 0
- !allocate(adjncy(0:max_neighbour*nelmnts-1))
- adjncy(:) = 0
- !allocate(nnodes_elmnts(0:nnodes-1))
- nnodes_elmnts(:) = 0
- !allocate(nodes_elmnts(0:nsize*nnodes-1))
- nodes_elmnts(:) = 0
-
- nb_edges = 0
-
-
- ! list of elements per node
- do i = 0, esize*nelmnts-1
- nodes_elmnts(elmnts(i)*nsize+nnodes_elmnts(elmnts(i))) = i/esize
- nnodes_elmnts(elmnts(i)) = nnodes_elmnts(elmnts(i)) + 1
-
- end do
-
- !print *, 'nnodes_elmnts'
-
- ! checking which elements are neighbours ('ncommonnodes' criteria)
- do j = 0, nnodes-1
- do k = 0, nnodes_elmnts(j)-1
- do l = k+1, nnodes_elmnts(j)-1
-
- connectivity = 0
- elem_base = nodes_elmnts(k+j*nsize)
- elem_target = nodes_elmnts(l+j*nsize)
- do n = 1, esize
- num_node = elmnts(esize*elem_base+n-1)
- do m = 0, nnodes_elmnts(num_node)-1
- if ( nodes_elmnts(m+num_node*nsize) == elem_target ) then
- connectivity = connectivity + 1
- end if
- end do
- end do
-
- if ( connectivity >= ncommonnodes) then
-
- is_neighbour = .false.
-
- do m = 0, xadj(nodes_elmnts(k+j*nsize))
- if ( .not.is_neighbour ) then
- if ( adjncy(nodes_elmnts(k+j*nsize)*sup_neighbour+m) == nodes_elmnts(l+j*nsize) ) then
- is_neighbour = .true.
-
- end if
- end if
- end do
- if ( .not.is_neighbour ) then
- adjncy(nodes_elmnts(k+j*nsize)*sup_neighbour+xadj(nodes_elmnts(k+j*nsize))) = nodes_elmnts(l+j*nsize)
- xadj(nodes_elmnts(k+j*nsize)) = xadj(nodes_elmnts(k+j*nsize)) + 1
- if (xadj(nodes_elmnts(k+j*nsize))>sup_neighbour) stop 'ERROR : too much neighbours per element, modify the mesh.'
- adjncy(nodes_elmnts(l+j*nsize)*sup_neighbour+xadj(nodes_elmnts(l+j*nsize))) = nodes_elmnts(k+j*nsize)
- xadj(nodes_elmnts(l+j*nsize)) = xadj(nodes_elmnts(l+j*nsize)) + 1
- if (xadj(nodes_elmnts(l+j*nsize))>sup_neighbour) stop 'ERROR : too much neighbours per element, modify the mesh.'
- end if
- end if
- end do
- end do
- end do
-
- max_neighbour = maxval(xadj)
-
- ! making adjacency arrays compact (to be used for partitioning)
- do i = 0, nelmnts-1
- k = xadj(i)
- xadj(i) = nb_edges
- do j = 0, k-1
- adjncy(nb_edges) = adjncy(i*sup_neighbour+j)
- nb_edges = nb_edges + 1
- end do
- end do
-
- xadj(nelmnts) = nb_edges
-
-
- end subroutine mesh2dual_ncommonnodes
-
-
-
- !--------------------------------------------------
- ! construct local numbering for the elements in each partition
- !--------------------------------------------------
- subroutine Construct_glob2loc_elmnts(nelmnts, part, nparts, glob2loc_elmnts)
-
- include './constants_pre_meshfem3D.h'
-
- integer(long), intent(in) :: nelmnts
- integer, intent(in) :: nparts
- integer, dimension(0:nelmnts-1), intent(in) :: part
- integer, dimension(:), pointer :: glob2loc_elmnts
-
- integer :: num_glob, num_part
- integer, dimension(0:nparts-1) :: num_loc
-
-
- allocate(glob2loc_elmnts(0:nelmnts-1))
-
- do num_part = 0, nparts-1
- num_loc(num_part) = 0
-
- end do
-
- do num_glob = 0, nelmnts-1
- num_part = part(num_glob)
- glob2loc_elmnts(num_glob) = num_loc(num_part)
- num_loc(num_part) = num_loc(num_part) + 1
-
- end do
-
-
- end subroutine Construct_glob2loc_elmnts
-
-
-
- !--------------------------------------------------
- ! construct local numbering for the nodes in each partition
- !--------------------------------------------------
- subroutine Construct_glob2loc_nodes(nelmnts, nnodes, nsize, nnodes_elmnts, nodes_elmnts, part, nparts, &
- glob2loc_nodes_nparts, glob2loc_nodes_parts, glob2loc_nodes)
-
- include './constants_pre_meshfem3D.h'
-
- integer(long), intent(in) :: nelmnts, nsize
- integer, intent(in) :: nnodes, nparts
- integer, dimension(0:nelmnts-1), intent(in) :: part
- integer, dimension(0:nnodes-1), intent(in) :: nnodes_elmnts
- integer, dimension(0:nsize*nnodes-1), intent(in) :: nodes_elmnts
- integer, dimension(:), pointer :: glob2loc_nodes_nparts
- integer, dimension(:), pointer :: glob2loc_nodes_parts
- integer, dimension(:), pointer :: glob2loc_nodes
-
- integer :: num_node
- integer :: el
- integer :: num_part
- integer :: size_glob2loc_nodes
- integer, dimension(0:nparts-1) :: parts_node
- integer, dimension(0:nparts-1) :: num_parts
-
- allocate(glob2loc_nodes_nparts(0:nnodes))
-
- size_glob2loc_nodes = 0
-
- parts_node(:) = 0
-
-
- do num_node = 0, nnodes-1
- glob2loc_nodes_nparts(num_node) = size_glob2loc_nodes
- do el = 0, nnodes_elmnts(num_node)-1
- parts_node(part(nodes_elmnts(el+nsize*num_node))) = 1
-
- end do
-
- do num_part = 0, nparts-1
- if ( parts_node(num_part) == 1 ) then
- size_glob2loc_nodes = size_glob2loc_nodes + 1
- parts_node(num_part) = 0
-
- end if
- end do
-
- end do
-
- glob2loc_nodes_nparts(nnodes) = size_glob2loc_nodes
-
- allocate(glob2loc_nodes_parts(0:glob2loc_nodes_nparts(nnodes)-1))
- allocate(glob2loc_nodes(0:glob2loc_nodes_nparts(nnodes)-1))
-
- glob2loc_nodes(0) = 0
-
- parts_node(:) = 0
- num_parts(:) = 0
- size_glob2loc_nodes = 0
-
-
- do num_node = 0, nnodes-1
- do el = 0, nnodes_elmnts(num_node)-1
- parts_node(part(nodes_elmnts(el+nsize*num_node))) = 1
-
- end do
- do num_part = 0, nparts-1
-
- if ( parts_node(num_part) == 1 ) then
- glob2loc_nodes_parts(size_glob2loc_nodes) = num_part
- glob2loc_nodes(size_glob2loc_nodes) = num_parts(num_part)
- size_glob2loc_nodes = size_glob2loc_nodes + 1
- num_parts(num_part) = num_parts(num_part) + 1
- parts_node(num_part) = 0
- end if
-
- end do
- end do
-
-
- end subroutine Construct_glob2loc_nodes
-
-
-
- !--------------------------------------------------
- ! Construct interfaces between each partitions.
- ! Two adjacent elements in distinct partitions make an entry in array tab_interfaces :
- ! 1/ first element, 2/ second element, 3/ number of common nodes, 4/ first node,
- ! 5/ second node, if relevant.
- ! No interface between acoustic and elastic elements.
- !--------------------------------------------------
- subroutine Construct_interfaces(nelmnts, nparts, sup_neighbour, part, elmnts, xadj, adjncy, &
- tab_interfaces, tab_size_interfaces, ninterfaces, nb_materials, cs_material, num_material)
-
- include './constants_pre_meshfem3D.h'
-
- integer, intent(in) :: nparts
- integer(long), intent(in) :: nelmnts, sup_neighbour
- integer, dimension(0:nelmnts-1), intent(in) :: part
- integer, dimension(0:esize*nelmnts-1), intent(in) :: elmnts
- integer, dimension(0:nelmnts), intent(in) :: xadj
- integer, dimension(0:sup_neighbour*nelmnts-1), intent(in) :: adjncy
- integer, dimension(:),pointer :: tab_size_interfaces, tab_interfaces
- integer, intent(out) :: ninterfaces
- integer, dimension(1:nelmnts), intent(in) :: num_material
- double precision, dimension(1:nb_materials), intent(in) :: cs_material
- integer, intent(in) :: nb_materials
-
-
- integer :: num_part, num_part_bis, el, el_adj, num_interface, num_edge, ncommon_nodes, &
- num_node, num_node_bis
- integer :: i, j
- logical :: is_acoustic_el, is_acoustic_el_adj
-
- ninterfaces = 0
- do i = 0, nparts-1
- do j = i+1, nparts-1
- ninterfaces = ninterfaces + 1
- end do
- end do
-
- allocate(tab_size_interfaces(0:ninterfaces))
- tab_size_interfaces(:) = 0
-
- num_interface = 0
- num_edge = 0
-
- do num_part = 0, nparts-1
- do num_part_bis = num_part+1, nparts-1
- do el = 0, nelmnts-1
- if ( part(el) == num_part ) then
- if ( cs_material(num_material(el+1)) < TINYVAL) then
- is_acoustic_el = .true.
- else
- is_acoustic_el = .false.
- end if
- do el_adj = xadj(el), xadj(el+1)-1
- if ( cs_material(num_material(adjncy(el_adj)+1)) < TINYVAL) then
- is_acoustic_el_adj = .true.
- else
- is_acoustic_el_adj = .false.
- end if
- if ( (part(adjncy(el_adj)) == num_part_bis) .and. (is_acoustic_el .eqv. is_acoustic_el_adj) ) then
- num_edge = num_edge + 1
-
- end if
- end do
- end if
- end do
- tab_size_interfaces(num_interface+1) = tab_size_interfaces(num_interface) + num_edge
- num_edge = 0
- num_interface = num_interface + 1
-
- end do
- end do
-
- num_interface = 0
- num_edge = 0
-
- allocate(tab_interfaces(0:(tab_size_interfaces(ninterfaces)*7-1)))
- tab_interfaces(:) = 0
-
- do num_part = 0, nparts-1
- do num_part_bis = num_part+1, nparts-1
- do el = 0, nelmnts-1
- if ( part(el) == num_part ) then
- if ( cs_material(num_material(el+1)) < TINYVAL) then
- is_acoustic_el = .true.
- else
- is_acoustic_el = .false.
- end if
- do el_adj = xadj(el), xadj(el+1)-1
- if ( cs_material(num_material(adjncy(el_adj)+1)) < TINYVAL) then
- is_acoustic_el_adj = .true.
- else
- is_acoustic_el_adj = .false.
- end if
- if ( (part(adjncy(el_adj)) == num_part_bis) .and. (is_acoustic_el .eqv. is_acoustic_el_adj) ) then
- tab_interfaces(tab_size_interfaces(num_interface)*7+num_edge*7+0) = el
- tab_interfaces(tab_size_interfaces(num_interface)*7+num_edge*7+1) = adjncy(el_adj)
- ncommon_nodes = 0
- do num_node = 0, esize-1
- do num_node_bis = 0, esize-1
- if ( elmnts(el*esize+num_node) == elmnts(adjncy(el_adj)*esize+num_node_bis) ) then
- tab_interfaces(tab_size_interfaces(num_interface)*7+num_edge*7+3+ncommon_nodes) &
- = elmnts(el*esize+num_node)
- ncommon_nodes = ncommon_nodes + 1
- end if
- end do
- end do
- if ( ncommon_nodes > 0 ) then
- tab_interfaces(tab_size_interfaces(num_interface)*7+num_edge*7+2) = ncommon_nodes
- else
- print *, "Error while building interfaces!", ncommon_nodes
- end if
- num_edge = num_edge + 1
- end if
- end do
- end if
-
- end do
- num_edge = 0
- num_interface = num_interface + 1
- end do
- end do
-
-
- end subroutine Construct_interfaces
-
-
-
- !--------------------------------------------------
- ! Write nodes (their coordinates) pertaining to iproc partition in the corresponding Database
- !--------------------------------------------------
- subroutine write_glob2loc_nodes_database(IIN_database, iproc, npgeo, nodes_coords, glob2loc_nodes_nparts, glob2loc_nodes_parts, &
- glob2loc_nodes, nnodes, num_phase)
-
- integer, intent(in) :: IIN_database
- integer, intent(in) :: nnodes, iproc, num_phase
- integer, intent(inout) :: npgeo
-
- double precision, dimension(3,nnodes) :: nodes_coords
- integer, dimension(:), pointer :: glob2loc_nodes_nparts
- integer, dimension(:), pointer :: glob2loc_nodes_parts
- integer, dimension(:), pointer :: glob2loc_nodes
-
- integer :: i, j
-
- if ( num_phase == 1 ) then
- npgeo = 0
-
- do i = 0, nnodes-1
- do j = glob2loc_nodes_nparts(i), glob2loc_nodes_nparts(i+1)-1
- if ( glob2loc_nodes_parts(j) == iproc ) then
- npgeo = npgeo + 1
-
- end if
-
- end do
- end do
- else
- do i = 0, nnodes-1
- do j = glob2loc_nodes_nparts(i), glob2loc_nodes_nparts(i+1)-1
- if ( glob2loc_nodes_parts(j) == iproc ) then
- write(IIN_database,*) glob2loc_nodes(j)+1, nodes_coords(1,i+1), nodes_coords(2,i+1), nodes_coords(3,i+1)
- end if
- end do
- end do
- end if
-
- end subroutine Write_glob2loc_nodes_database
-
-
-
- !--------------------------------------------------
- ! Write elements (their nodes) pertaining to iproc partition in the corresponding Database
- !--------------------------------------------------
- subroutine write_partition_database(IIN_database, iproc, nspec, nelmnts, elmnts, glob2loc_elmnts, glob2loc_nodes_nparts, &
- glob2loc_nodes_parts, glob2loc_nodes, part, num_modele, ngnod, num_phase)
-
- include './constants_pre_meshfem3D.h'
-
- integer, intent(in) :: IIN_database
- integer, intent(in) :: num_phase, iproc
- integer(long), intent(in) :: nelmnts
- integer, intent(inout) :: nspec
- integer, dimension(0:nelmnts-1) :: part
- integer, dimension(0:esize*nelmnts-1) :: elmnts
- integer, dimension(:), pointer :: glob2loc_elmnts
- integer, dimension(:) :: num_modele
- integer, dimension(:), pointer :: glob2loc_nodes_nparts
- integer, dimension(:), pointer :: glob2loc_nodes_parts
- integer, dimension(:), pointer :: glob2loc_nodes
- integer, intent(in) :: ngnod
-
- integer :: i,j,k
- integer, dimension(0:ngnod-1) :: loc_nodes
-
- if ( num_phase == 1 ) then
- nspec = 0
-
- do i = 0, nelmnts-1
- if ( part(i) == iproc ) then
- nspec = nspec + 1
-
- end if
- end do
-
- else
- do i = 0, nelmnts-1
- if ( part(i) == iproc ) then
-
- do j = 0, ngnod-1
- do k = glob2loc_nodes_nparts(elmnts(i*ngnod+j)), glob2loc_nodes_nparts(elmnts(i*ngnod+j)+1)-1
-
- if ( glob2loc_nodes_parts(k) == iproc ) then
- loc_nodes(j) = glob2loc_nodes(k)
-
- end if
- end do
-
- end do
- write(IIN_database,*) glob2loc_elmnts(i)+1, num_modele(i+1), (loc_nodes(k)+1, k=0,ngnod-1)
- end if
- end do
- end if
-
-
- end subroutine write_partition_database
-
-
-
-
- !--------------------------------------------------
- ! Write interfaces (element and common nodes) pertaining to iproc partition in the corresponding Database
- !--------------------------------------------------
- subroutine write_interfaces_database(IIN_database, tab_interfaces, tab_size_interfaces, nparts, iproc, ninterfaces, &
- my_ninterface, my_interfaces, my_nb_interfaces, glob2loc_elmnts, glob2loc_nodes_nparts, glob2loc_nodes_parts, &
- glob2loc_nodes, num_phase)
-
- integer, intent(in) :: IIN_database
- integer, intent(in) :: iproc
- integer, intent(in) :: nparts
- integer, intent(in) :: ninterfaces
- integer, intent(inout) :: my_ninterface
- integer, dimension(:), pointer :: tab_size_interfaces
- integer, dimension(:), pointer :: tab_interfaces
- integer, dimension(0:ninterfaces-1), intent(inout) :: my_interfaces
- integer, dimension(0:ninterfaces-1), intent(inout) :: my_nb_interfaces
- integer, dimension(:), pointer :: glob2loc_elmnts
- integer, dimension(:), pointer :: glob2loc_nodes_nparts
- integer, dimension(:), pointer :: glob2loc_nodes_parts
- integer, dimension(:), pointer :: glob2loc_nodes
-
- integer, dimension(4) :: local_nodes
- integer :: local_elmnt
- integer :: num_phase
-
- integer :: i, j, k, l
- integer :: num_interface
-
- num_interface = 0
-
- if ( num_phase == 1 ) then
-
- my_interfaces(:) = 0
- my_nb_interfaces(:) = 0
-
- do i = 0, nparts-1
- do j = i+1, nparts-1
- if ( (tab_size_interfaces(num_interface) < tab_size_interfaces(num_interface+1)) .and. &
- (i == iproc .or. j == iproc) ) then
- my_interfaces(num_interface) = 1
- my_nb_interfaces(num_interface) = tab_size_interfaces(num_interface+1) - tab_size_interfaces(num_interface)
- end if
- num_interface = num_interface + 1
- end do
- end do
- my_ninterface = sum(my_interfaces(:))
-
- else
-
- do i = 0, nparts-1
- do j = i+1, nparts-1
- if ( my_interfaces(num_interface) == 1 ) then
- if ( i == iproc ) then
- write(IIN_database,*) j, my_nb_interfaces(num_interface)
- else
- write(IIN_database,*) i, my_nb_interfaces(num_interface)
- end if
-
- do k = tab_size_interfaces(num_interface), tab_size_interfaces(num_interface+1)-1
- if ( i == iproc ) then
- local_elmnt = glob2loc_elmnts(tab_interfaces(k*7+0))+1
- else
- local_elmnt = glob2loc_elmnts(tab_interfaces(k*7+1))+1
- end if
-
-!!$ if ( tab_interfaces(k*7+2) == 1 ) then
-!!$ do l = glob2loc_nodes_nparts(tab_interfaces(k*7+3)), &
-!!$ glob2loc_nodes_nparts(tab_interfaces(k*7+3)+1)-1
-!!$ if ( glob2loc_nodes_parts(l) == iproc ) then
-!!$ local_nodes(1) = glob2loc_nodes(l)+1
-!!$ end if
-!!$ end do
-!!$
-!!$ write(IIN_database,*) local_elmnt, tab_interfaces(k*7+2), local_nodes(1), -1
-!!$ else
-!!$ if ( tab_interfaces(k*7+2) == 2 ) then
-!!$ do l = glob2loc_nodes_nparts(tab_interfaces(k*7+3)), &
-!!$ glob2loc_nodes_nparts(tab_interfaces(k*7+3)+1)-1
-!!$ if ( glob2loc_nodes_parts(l) == iproc ) then
-!!$ local_nodes(1) = glob2loc_nodes(l)+1
-!!$ end if
-!!$ end do
-!!$ do l = glob2loc_nodes_nparts(tab_interfaces(k*7+4)), &
-!!$ glob2loc_nodes_nparts(tab_interfaces(k*7+4)+1)-1
-!!$ if ( glob2loc_nodes_parts(l) == iproc ) then
-!!$ local_nodes(2) = glob2loc_nodes(l)+1
-!!$ end if
-!!$ end do
-!!$ write(IIN_database,*) local_elmnt, tab_interfaces(k*7+2), local_nodes(1), local_nodes(2)
-!!$ else
-!!$ write(IIN_database,*) "erreur_write_interface_", tab_interfaces(k*7+2)
-!!$ end if
-!!$ end if
- select case (tab_interfaces(k*7+2))
- case (1)
- do l = glob2loc_nodes_nparts(tab_interfaces(k*7+3)), &
- glob2loc_nodes_nparts(tab_interfaces(k*7+3)+1)-1
- if ( glob2loc_nodes_parts(l) == iproc ) then
- local_nodes(1) = glob2loc_nodes(l)+1
- end if
- end do
- write(IIN_database,*) local_elmnt, tab_interfaces(k*7+2), local_nodes(1), -1, -1, -1
- case (2)
- do l = glob2loc_nodes_nparts(tab_interfaces(k*7+3)), &
- glob2loc_nodes_nparts(tab_interfaces(k*7+3)+1)-1
- if ( glob2loc_nodes_parts(l) == iproc ) then
- local_nodes(1) = glob2loc_nodes(l)+1
- end if
- end do
- do l = glob2loc_nodes_nparts(tab_interfaces(k*7+4)), &
- glob2loc_nodes_nparts(tab_interfaces(k*7+4)+1)-1
- if ( glob2loc_nodes_parts(l) == iproc ) then
- local_nodes(2) = glob2loc_nodes(l)+1
- end if
- end do
- write(IIN_database,*) local_elmnt, tab_interfaces(k*7+2), local_nodes(1), local_nodes(2), -1, -1
- case (4)
- do l = glob2loc_nodes_nparts(tab_interfaces(k*7+3)), &
- glob2loc_nodes_nparts(tab_interfaces(k*7+3)+1)-1
- if ( glob2loc_nodes_parts(l) == iproc ) then
- local_nodes(1) = glob2loc_nodes(l)+1
- end if
- end do
- do l = glob2loc_nodes_nparts(tab_interfaces(k*7+4)), &
- glob2loc_nodes_nparts(tab_interfaces(k*7+4)+1)-1
- if ( glob2loc_nodes_parts(l) == iproc ) then
- local_nodes(2) = glob2loc_nodes(l)+1
- end if
- end do
- do l = glob2loc_nodes_nparts(tab_interfaces(k*7+5)), &
- glob2loc_nodes_nparts(tab_interfaces(k*7+5)+1)-1
- if ( glob2loc_nodes_parts(l) == iproc ) then
- local_nodes(3) = glob2loc_nodes(l)+1
- end if
- end do
- do l = glob2loc_nodes_nparts(tab_interfaces(k*7+6)), &
- glob2loc_nodes_nparts(tab_interfaces(k*7+6)+1)-1
- if ( glob2loc_nodes_parts(l) == iproc ) then
- local_nodes(4) = glob2loc_nodes(l)+1
- end if
- end do
- write(IIN_database,*) local_elmnt, tab_interfaces(k*7+2), &
- local_nodes(1), local_nodes(2),local_nodes(3), local_nodes(4)
- case default
- print *, "error in write_interfaces_database!", tab_interfaces(k*7+2), iproc
- end select
- end do
-
- end if
-
- num_interface = num_interface + 1
- end do
- end do
-
- end if
-
- end subroutine write_interfaces_database
-
-
-end module part_pre_meshfem3D
Deleted: seismo/3D/SPECFEM3D_SESAME/trunk/UTILS/external_mesh/pre_meshfem3D_asteroid_subdivide/pre_meshfem3D.f90
===================================================================
--- seismo/3D/SPECFEM3D_SESAME/trunk/UTILS/external_mesh/pre_meshfem3D_asteroid_subdivide/pre_meshfem3D.f90 2009-03-12 16:31:24 UTC (rev 14300)
+++ seismo/3D/SPECFEM3D_SESAME/trunk/UTILS/external_mesh/pre_meshfem3D_asteroid_subdivide/pre_meshfem3D.f90 2009-03-12 17:37:00 UTC (rev 14301)
@@ -1,258 +0,0 @@
-program pre_meshfem3D
-
- use part_pre_meshfem3D
- implicit none
-
- include './constants_pre_meshfem3D.h'
- include "./scotchf.h"
-
-
- integer, parameter :: nparts=8
-
-
- integer(long) :: nspec
- integer, dimension(:,:), allocatable :: elmnts
- integer, dimension(:), allocatable :: mat
- integer, dimension(:), allocatable :: part
-
- integer :: nnodes
- double precision, dimension(:,:), allocatable :: nodes_coords
-
- integer, dimension(:), allocatable :: xadj
- integer, dimension(:), allocatable :: adjncy
- integer, dimension(:), allocatable :: nnodes_elmnts
- integer, dimension(:), allocatable :: nodes_elmnts
-
- integer, dimension(:), allocatable :: vwgt
- integer, dimension(:), allocatable :: adjwgt
- integer, dimension(5) :: metis_options
-
- integer, dimension(:), pointer :: glob2loc_elmnts
- integer, dimension(:), pointer :: glob2loc_nodes_nparts
- integer, dimension(:), pointer :: glob2loc_nodes_parts
- integer, dimension(:), pointer :: glob2loc_nodes
-
- integer, dimension(:), pointer :: tab_size_interfaces, tab_interfaces
- integer, dimension(:), allocatable :: my_interfaces
- integer, dimension(:), allocatable :: my_nb_interfaces
- integer :: ninterfaces
- integer :: my_ninterface
-
- integer :: nb_materials
- double precision, dimension(:), allocatable :: cs
- integer, dimension(:), allocatable :: num_material
-
- integer(long) :: nsize ! Max number of elements that contain the same node.
- integer :: edgecut
- integer :: nb_edges
-
- integer :: ispec, inode
- integer :: wgtflag
- integer :: num_start
- integer :: ngnod
- integer :: max_neighbour ! Real maximum number of neighbours per element
- integer(long) :: sup_neighbour ! Majoration of the maximum number of neighbours per element
-
- integer :: ipart, nnodes_loc, nspec_loc
- character(len=256) :: prname
-
- logical, dimension(:), allocatable :: mask_nodes_elmnts
- integer, dimension(:), allocatable :: used_nodes_elmnts
-
-!!!! NL NL for SCOTCH partitioner
- double precision, dimension(SCOTCH_GRAPHDIM) :: scotchgraph
- double precision, dimension(SCOTCH_STRATDIM) :: scotchstrat
- character(len=256), parameter :: scotch_strategy='b{job=t,map=t,poli=S,sep=h{pass=30}}'
- integer :: ierr
-!!!! NL NL
-
-
- ngnod = esize
-
-! read the elements, material and nodes files
- open(unit=98, file='../model_asteroid_subdivide/mesh', status='old', form='formatted')
- read(98,*) nspec
- allocate(elmnts(esize,nspec))
- do ispec = 1, nspec
- read(98,*) elmnts(1,ispec), elmnts(2,ispec), elmnts(3,ispec), elmnts(4,ispec), &
- elmnts(5,ispec), elmnts(6,ispec), elmnts(7,ispec), elmnts(8,ispec)
- end do
- close(98)
-
- open(unit=98, file='../model_asteroid_subdivide/mat', status='old', form='formatted')
- allocate(mat(nspec))
- do ispec = 1, nspec
- read(98,*) mat(ispec)
- end do
- close(98)
-
- open(unit=98, file='../model_asteroid_subdivide/nodes_coords', status='old', form='formatted')
- read(98,*) nnodes
- allocate(nodes_coords(3,nnodes))
- do inode = 1, nnodes
- read(98,*) nodes_coords(1,inode), nodes_coords(2,inode), nodes_coords(3,inode)
- end do
- close(98)
-
- allocate(mask_nodes_elmnts(nnodes))
- allocate(used_nodes_elmnts(nnodes))
- mask_nodes_elmnts(:) = .false.
- used_nodes_elmnts(:) = 0
- do ispec = 1, nspec
- do inode = 1, ESIZE
- mask_nodes_elmnts(elmnts(inode,ispec)) = .true.
- used_nodes_elmnts(elmnts(inode,ispec)) = used_nodes_elmnts(elmnts(inode,ispec)) + 1
- enddo
- enddo
- nsize = maxval(used_nodes_elmnts(:))
- sup_neighbour = ngnod * nsize - (ngnod + (ngnod/2 - 1)*nfaces)
- print*, 'nsize = ',nsize, 'sup_neighbour = ', sup_neighbour
-
- do inode = 1, nnodes
- if (.not. mask_nodes_elmnts(inode)) then
- stop 'ERROR : nodes not used.'
- endif
- enddo
-! if (maxval(used_nodes_elmnts(:))>nsize) then
-! stop 'ERROR : increase nsize or modify the mesh.'
-! endif
-
- elmnts(:,:) = elmnts(:,:) - 1
-
- allocate(xadj(1:nspec+1))
- allocate(adjncy(1:sup_neighbour*nspec))
- allocate(nnodes_elmnts(1:nnodes))
- allocate(nodes_elmnts(1:nsize*nnodes))
-
- call mesh2dual_ncommonnodes(nspec, nnodes, nsize, sup_neighbour, elmnts, xadj, adjncy, nnodes_elmnts, &
- nodes_elmnts, max_neighbour, 1)
- print*, 'max_neighbour = ',max_neighbour
-
-
- ! elmnts(:,:) = elmnts(:,:) + 1
- ! adjncy(:) = adjncy(:) + 1
- ! xadj(:) = xadj(:) + 1
-! allocate(vwgt(0:nspec-1))
- nb_edges = xadj(nspec+1)
-! allocate(adjwgt(0:nb_edges-1))
-! vwgt(:) = 1
-! adjwgt(:) = 1
-
-! metis_options(1) = 0
-! metis_options(2) = 3
-! metis_options(3) = 1
-! metis_options(4) = 1
-! metis_options(5) = 0
-
-
-! num_start = 0
-! wgtflag = 0
-
- allocate(part(1:nspec))
-
-
-! Old metis partitioning
-! call METIS_PartGraphRecursive(nspec, xadj(1), adjncy(1), vwgt(0), adjwgt(0), wgtflag, num_start, nparts, &
-! metis_options, edgecut, part(1));
-
-! SCOTCH partitioning
- call scotchfstratinit (scotchstrat(1), ierr)
- if (ierr /= 0) then
- stop 'ERROR : MAIN : Cannot initialize strat'
- endif
-
- call scotchfstratgraphmap (scotchstrat(1), trim(scotch_strategy), ierr)
- if (ierr /= 0) then
- stop 'ERROR : MAIN : Cannot build strat'
- endif
-
- call scotchfgraphinit (scotchgraph (1), ierr)
- if (ierr /= 0) then
- stop 'ERROR : MAIN : Cannot initialize graph'
- endif
-
- call scotchfgraphbuild (scotchgraph (1), 0, nspec, xadj (1), xadj (1), &
- xadj (1), xadj (1), nb_edges, adjncy (1), adjncy (1), ierr)
- if (ierr /= 0) then
- stop 'ERROR : MAIN : Cannot build graph'
- endif
-
- call scotchfgraphcheck (scotchgraph (1), ierr)
- if (ierr /= 0) then
- stop 'ERROR : MAIN : Invalid check'
- endif
-
- call scotchfgraphpart (scotchgraph (1), nparts, scotchstrat(1),part(1),ierr)
- if (ierr /= 0) then
- stop 'ERROR : MAIN : Cannot part graph'
- endif
-
- call scotchfgraphexit (scotchgraph (1), ierr)
- if (ierr /= 0) then
- stop 'ERROR : MAIN : Cannot destroy graph'
- endif
-
- call scotchfstratexit (scotchstrat(1), ierr)
- if (ierr /= 0) then
- stop 'ERROR : MAIN : Cannot destroy strat'
- endif
-
-
-! local number of each element for each partition
- call Construct_glob2loc_elmnts(nspec, part, nparts, glob2loc_elmnts)
-
-! local number of each node for each partition
- call Construct_glob2loc_nodes(nspec, nnodes,nsize, nnodes_elmnts, nodes_elmnts, part, nparts, &
- glob2loc_nodes_nparts, glob2loc_nodes_parts, glob2loc_nodes)
-
- nb_materials = 1
- allocate(cs(nb_materials))
- allocate(num_material(nspec))
- cs(:) = 1000.d0
- num_material(:) = 1
-
- call Construct_interfaces(nspec, nparts, sup_neighbour, part, elmnts, xadj, adjncy, tab_interfaces, &
- tab_size_interfaces, ninterfaces, nb_materials, cs, num_material)
-
- allocate(my_interfaces(0:ninterfaces-1))
- allocate(my_nb_interfaces(0:ninterfaces-1))
-
-
-
- do ipart = 0, nparts-1
-
- !write(prname, "('/Database',i5.5)") ipart
- write(prname, "(i6.6,'_Database')") ipart
- open(unit=15,file='./OUTPUT_FILES/proc'//prname,status='unknown', action='write', form='formatted')
-
- call write_glob2loc_nodes_database(15, ipart, nnodes_loc, nodes_coords, glob2loc_nodes_nparts, glob2loc_nodes_parts, &
- glob2loc_nodes, nnodes, 1)
- call write_partition_database(15, ipart, nspec_loc, nspec, elmnts, glob2loc_elmnts, glob2loc_nodes_nparts, &
- glob2loc_nodes_parts, glob2loc_nodes, part, num_material, ngnod, 1)
-
- write(15,*) nnodes_loc
- call write_glob2loc_nodes_database(15, ipart, nnodes_loc, nodes_coords, glob2loc_nodes_nparts, glob2loc_nodes_parts, &
- glob2loc_nodes, nnodes, 2)
- write(15,*) nspec_loc
- call write_partition_database(15, ipart, nspec_loc, nspec, elmnts, glob2loc_elmnts, glob2loc_nodes_nparts, &
- glob2loc_nodes_parts, glob2loc_nodes, part, num_material, ngnod, 2)
-
- call Write_interfaces_database(15, tab_interfaces, tab_size_interfaces, nparts, ipart, ninterfaces, &
- my_ninterface, my_interfaces, my_nb_interfaces, glob2loc_elmnts, glob2loc_nodes_nparts, glob2loc_nodes_parts, &
- glob2loc_nodes, 1)
- write(15,*) my_ninterface, maxval(my_nb_interfaces)
- call Write_interfaces_database(15, tab_interfaces, tab_size_interfaces, nparts, ipart, ninterfaces, &
- my_ninterface, my_interfaces, my_nb_interfaces, glob2loc_elmnts, glob2loc_nodes_nparts, glob2loc_nodes_parts, &
- glob2loc_nodes, 2)
-
-
- close(15)
-
- end do
-
-
-end program pre_meshfem3D
-
-
-
-
Copied: seismo/3D/SPECFEM3D_SESAME/trunk/generate_databases.f90 (from rev 14285, seismo/3D/SPECFEM3D_SESAME/trunk/meshfem3D.f90)
===================================================================
--- seismo/3D/SPECFEM3D_SESAME/trunk/generate_databases.f90 (rev 0)
+++ seismo/3D/SPECFEM3D_SESAME/trunk/generate_databases.f90 2009-03-12 17:37:00 UTC (rev 14301)
@@ -0,0 +1,968 @@
+!=====================================================================
+!
+! S p e c f e m 3 D V e r s i o n 1 . 4
+! ---------------------------------------
+!
+! Dimitri Komatitsch and Jeroen Tromp
+! Seismological Laboratory - California Institute of Technology
+! (c) California Institute of Technology September 2006
+!
+! 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.
+!
+!=====================================================================
+!
+! United States Government Sponsorship Acknowledged.
+!
+
+ subroutine generate_databases
+
+ implicit none
+
+ include "constants.h"
+
+!=============================================================================!
+! !
+! generate_databases produces a spectral element grid for a local or regional model. !
+! The mesher uses the UTM projection !
+! !
+!=============================================================================!
+!
+! If you use this code for your own research, please cite some of these articles:
+!
+! @ARTICLE{KoLiTrSuStSh04,
+! author={Dimitri Komatitsch and Qinya Liu and Jeroen Tromp and Peter S\"{u}ss
+! and Christiane Stidham and John H. Shaw},
+! year=2004,
+! title={Simulations of Ground Motion in the {L}os {A}ngeles {B}asin
+! based upon the Spectral-Element Method},
+! journal={Bull. Seism. Soc. Am.},
+! volume=94,
+! number=1,
+! pages={187-206}}
+!
+! @ARTICLE{KoTr99,
+! author={D. Komatitsch and J. Tromp},
+! year=1999,
+! title={Introduction to the spectral-element method for 3-{D} seismic wave propagation},
+! journal={Geophys. J. Int.},
+! volume=139,
+! number=3,
+! pages={806-822},
+! doi={10.1046/j.1365-246x.1999.00967.x}}
+!
+! @ARTICLE{KoVi98,
+! author={D. Komatitsch and J. P. Vilotte},
+! title={The spectral-element method: an efficient tool to simulate the seismic response of 2{D} and 3{D} geological structures},
+! journal={Bull. Seismol. Soc. Am.},
+! year=1998,
+! volume=88,
+! number=2,
+! pages={368-392}}
+!
+! If you use the kernel capabilities of the code, please cite
+!
+! @ARTICLE{LiTr06,
+! author={Qinya Liu and Jeroen Tromp},
+! title={Finite-frequency kernels based on adjoint methods},
+! journal={Bull. Seismol. Soc. Am.},
+! year=2006,
+! volume=96,
+! number=6,
+! pages={2383-2397},
+! doi={10.1785/0120060041}}
+!
+! Reference frame - convention:
+! ----------------------------
+!
+! The code uses the following convention for the reference frame:
+!
+! - X axis is East
+! - Y axis is North
+! - Z axis is up
+!
+! Note that this convention is different from both the Aki-Richards convention
+! and the Harvard CMT convention.
+!
+! Let us recall that the Aki-Richards convention is:
+!
+! - X axis is North
+! - Y axis is East
+! - Z axis is down
+!
+! and that the Harvard CMT convention is:
+!
+! - X axis is South
+! - Y axis is East
+! - Z axis is up
+!
+! To report bugs or suggest improvements to the code, please send an email
+! to Jeroen Tromp <jtromp AT caltech.edu> and/or use our online
+! bug tracking system at http://www.geodynamics.org/roundup .
+!
+! Evolution of the code:
+! ---------------------
+!
+! MPI v. 1.4 Dimitri Komatitsch, University of Pau, Qinya Liu and others, Caltech, September 2006:
+! better adjoint and kernel calculations, faster and better I/Os
+! on very large systems, many small improvements and bug fixes
+! MPI v. 1.3 Dimitri Komatitsch, University of Pau, and Qinya Liu, Caltech, July 2005:
+! serial version, regular mesh, adjoint and kernel calculations, ParaView support
+! MPI v. 1.2 Min Chen and Dimitri Komatitsch, Caltech, July 2004:
+! full anisotropy, volume movie
+! MPI v. 1.1 Dimitri Komatitsch, Caltech, October 2002: Zhu's Moho map, scaling
+! of Vs with depth, Hauksson's regional model, attenuation, oceans, movies
+! MPI v. 1.0 Dimitri Komatitsch, Caltech, May 2002: first MPI version
+! based on global code
+
+! number of spectral elements in each block
+ integer nspec,npointot
+
+! meshing parameters
+ double precision, dimension(:), allocatable :: rns
+
+! auxiliary variables to generate the mesh
+ integer ix,iy,ir
+
+ double precision xin,etan,rn
+ double precision x_current,y_current,z_top,z_bot
+
+ double precision, dimension(:,:,:), allocatable :: xgrid,ygrid,zgrid
+
+! parameters needed to store the radii of the grid points
+ integer, dimension(:), allocatable :: idoubling
+ integer, dimension(:,:,:,:), allocatable :: ibool
+
+! arrays with the mesh in double precision
+ double precision, dimension(:,:,:,:), allocatable :: xstore,ystore,zstore
+
+! proc numbers for MPI
+ integer myrank,sizeprocs,ier
+
+! check area and volume of the final mesh
+ double precision area_local_bottom,area_total_bottom
+ double precision area_local_top,area_total_top
+ double precision volume_local,volume_total
+
+ integer iprocnum,npx,npy
+
+! for loop on all the slices
+ integer iproc_xi,iproc_eta
+ integer, dimension(:,:), allocatable :: addressing
+
+! use integer array to store topography values
+ integer icornerlat,icornerlong,NX_TOPO,NY_TOPO
+ double precision lat,long,elevation,ORIG_LAT_TOPO,ORIG_LONG_TOPO,DEGREES_PER_CELL_TOPO
+ double precision long_corner,lat_corner,ratio_xi,ratio_eta
+ character(len=100) topo_file
+ integer, dimension(:,:), allocatable :: itopo_bathy
+
+! use integer array to store Moho depth
+ integer imoho_depth(NX_MOHO,NY_MOHO)
+
+! timer MPI
+ double precision, external :: wtime
+ double precision time_start,tCPU
+
+! addressing for all the slices
+ integer, dimension(:), allocatable :: iproc_xi_slice,iproc_eta_slice
+
+! parameters read from parameter file
+ integer NER_SEDIM,NER_BASEMENT_SEDIM,NER_16_BASEMENT, &
+ NER_MOHO_16,NER_BOTTOM_MOHO,NEX_XI,NEX_ETA, &
+ NPROC_XI,NPROC_ETA,NTSTEP_BETWEEN_OUTPUT_SEISMOS,NSTEP,UTM_PROJECTION_ZONE,SIMULATION_TYPE
+ integer NSOURCES
+
+ double precision UTM_X_MIN,UTM_X_MAX,UTM_Y_MIN,UTM_Y_MAX
+ double precision Z_DEPTH_BLOCK,Z_BASEMENT_SURFACE,Z_DEPTH_MOHO
+ double precision DT,LATITUDE_MIN,LATITUDE_MAX,LONGITUDE_MIN,LONGITUDE_MAX,HDUR_MOVIE
+ double precision THICKNESS_TAPER_BLOCK_HR,THICKNESS_TAPER_BLOCK_MR,VP_MIN_GOCAD,VP_VS_RATIO_GOCAD_TOP,VP_VS_RATIO_GOCAD_BOTTOM
+
+ logical HARVARD_3D_GOCAD_MODEL,TOPOGRAPHY,ATTENUATION,USE_OLSEN_ATTENUATION, &
+ OCEANS,IMPOSE_MINIMUM_VP_GOCAD,HAUKSSON_REGIONAL_MODEL, &
+ BASEMENT_MAP,MOHO_MAP_LUPEI,ABSORBING_CONDITIONS,SAVE_FORWARD
+ logical ANISOTROPY,SAVE_MESH_FILES,PRINT_SOURCE_TIME_FUNCTION
+
+ logical MOVIE_SURFACE,MOVIE_VOLUME,CREATE_SHAKEMAP,SAVE_DISPLACEMENT, &
+ USE_HIGHRES_FOR_MOVIES,SUPPRESS_UTM_PROJECTION,USE_REGULAR_MESH
+ integer NTSTEP_BETWEEN_FRAMES,NTSTEP_BETWEEN_OUTPUT_INFO
+
+ character(len=150) OUTPUT_FILES,LOCAL_PATH,MODEL
+
+! parameters deduced from parameters read from file
+ integer NPROC,NEX_PER_PROC_XI,NEX_PER_PROC_ETA
+ integer NER
+
+! this for all the regions
+ integer NSPEC_AB,NGLOB_AB,NSPEC2D_A_XI,NSPEC2D_B_XI, &
+ NSPEC2D_A_ETA,NSPEC2D_B_ETA, &
+ NSPEC2DMAX_XMIN_XMAX,NSPEC2DMAX_YMIN_YMAX, &
+ NSPEC2D_BOTTOM,NSPEC2D_TOP, &
+ NPOIN2DMAX_XMIN_XMAX,NPOIN2DMAX_YMIN_YMAX
+
+ double precision min_elevation,max_elevation
+ double precision min_elevation_all,max_elevation_all
+
+! for tapered basement map
+ integer icorner_x,icorner_y
+ integer iz_basement
+ double precision x_corner,y_corner
+ double precision z_basement(NX_BASEMENT,NY_BASEMENT)
+ character(len=150) BASEMENT_MAP_FILE
+
+! to filter list of stations
+ integer irec,nrec,nrec_filtered,ios
+ double precision stlat,stlon,stele,stbur
+ character(len=MAX_LENGTH_STATION_NAME) station_name
+ character(len=MAX_LENGTH_NETWORK_NAME) network_name
+ character(len=150) rec_filename,filtered_rec_filename,dummystring
+
+! for Databases of external meshes
+ character(len=150) prname
+ integer :: dummy_node
+ integer :: dummy_elmnt
+ integer :: ispec, inode, num_interface, ie
+ integer :: nnodes_ext_mesh, nelmnts_ext_mesh
+ integer :: ninterface_ext_mesh
+ integer :: max_interface_size_ext_mesh
+ integer, dimension(:), allocatable :: my_neighbours_ext_mesh
+ integer, dimension(:), allocatable :: my_nelmnts_neighbours_ext_mesh
+ integer, dimension(:,:,:), allocatable :: my_interfaces_ext_mesh
+ integer, dimension(:,:), allocatable :: ibool_interfaces_ext_mesh
+ integer, dimension(:), allocatable :: nibool_interfaces_ext_mesh
+ double precision, dimension(:,:), allocatable :: nodes_coords_ext_mesh
+ integer, dimension(:,:), allocatable :: elmnts_ext_mesh
+ integer, dimension(:), allocatable :: mat_ext_mesh
+
+! ************** PROGRAM STARTS HERE **************
+
+! sizeprocs returns number of processes started (should be equal to NPROC).
+! myrank is the rank of each process, between 0 and NPROC-1.
+! as usual in MPI, process 0 is in charge of coordinating everything
+! and also takes care of the main output
+ call world_size(sizeprocs)
+ call world_rank(myrank)
+
+! get the base pathname for output files
+ call get_value_string(OUTPUT_FILES, 'OUTPUT_FILES', 'OUTPUT_FILES')
+
+! open main output file, only written to by process 0
+ if(myrank == 0 .and. IMAIN /= ISTANDARD_OUTPUT) &
+ open(unit=IMAIN,file=trim(OUTPUT_FILES)//'/output_mesher.txt',status='unknown')
+
+! get MPI starting time
+ time_start = wtime()
+
+ if(myrank == 0) then
+ write(IMAIN,*)
+ write(IMAIN,*) '******************************************'
+ write(IMAIN,*) '*** Specfem3D MPI Mesher - f90 version ***'
+ write(IMAIN,*) '******************************************'
+ write(IMAIN,*)
+ endif
+
+! read the parameter file
+ call read_parameter_file(LATITUDE_MIN,LATITUDE_MAX,LONGITUDE_MIN,LONGITUDE_MAX, &
+ UTM_X_MIN,UTM_X_MAX,UTM_Y_MIN,UTM_Y_MAX,Z_DEPTH_BLOCK, &
+ NER_SEDIM,NER_BASEMENT_SEDIM,NER_16_BASEMENT,NER_MOHO_16,NER_BOTTOM_MOHO, &
+ NEX_XI,NEX_ETA,NPROC_XI,NPROC_ETA,NTSTEP_BETWEEN_OUTPUT_SEISMOS,NSTEP,UTM_PROJECTION_ZONE,DT, &
+ ATTENUATION,USE_OLSEN_ATTENUATION,HARVARD_3D_GOCAD_MODEL,TOPOGRAPHY,LOCAL_PATH,NSOURCES, &
+ THICKNESS_TAPER_BLOCK_HR,THICKNESS_TAPER_BLOCK_MR,VP_MIN_GOCAD,VP_VS_RATIO_GOCAD_TOP,VP_VS_RATIO_GOCAD_BOTTOM, &
+ OCEANS,IMPOSE_MINIMUM_VP_GOCAD,HAUKSSON_REGIONAL_MODEL,ANISOTROPY, &
+ BASEMENT_MAP,MOHO_MAP_LUPEI,ABSORBING_CONDITIONS, &
+ MOVIE_SURFACE,MOVIE_VOLUME,CREATE_SHAKEMAP,SAVE_DISPLACEMENT, &
+ NTSTEP_BETWEEN_FRAMES,USE_HIGHRES_FOR_MOVIES,HDUR_MOVIE, &
+ SAVE_MESH_FILES,PRINT_SOURCE_TIME_FUNCTION, &
+ NTSTEP_BETWEEN_OUTPUT_INFO,SUPPRESS_UTM_PROJECTION,MODEL,USE_REGULAR_MESH,SIMULATION_TYPE,SAVE_FORWARD)
+
+ if (sizeprocs == 1 .and. (NPROC_XI /= 1 .or. NPROC_ETA /= 1)) then
+ stop 'must have NPROC_XI = NPROC_ETA = 1 for a serial run'
+ endif
+
+! compute other parameters based upon values read
+ call compute_parameters(NER,NEX_XI,NEX_ETA,NPROC_XI,NPROC_ETA, &
+ NPROC,NEX_PER_PROC_XI,NEX_PER_PROC_ETA, &
+ NER_BOTTOM_MOHO,NER_MOHO_16,NER_16_BASEMENT,NER_BASEMENT_SEDIM,NER_SEDIM, &
+ NSPEC_AB,NSPEC2D_A_XI,NSPEC2D_B_XI, &
+ NSPEC2D_A_ETA,NSPEC2D_B_ETA, &
+ NSPEC2DMAX_XMIN_XMAX,NSPEC2DMAX_YMIN_YMAX,NSPEC2D_BOTTOM,NSPEC2D_TOP, &
+ NPOIN2DMAX_XMIN_XMAX,NPOIN2DMAX_YMIN_YMAX,NGLOB_AB,USE_REGULAR_MESH)
+
+! info about external mesh simulation
+! nlegoff -- should be put in compute_parameters and read_parameter_file for clarity
+ if (USE_EXTERNAL_MESH) then
+ NPROC = sizeprocs
+ endif
+
+! check that the code is running with the requested nb of processes
+ if(sizeprocs /= NPROC) call exit_MPI(myrank,'wrong number of MPI processes')
+
+ if (.not. USE_EXTERNAL_MESH) then
+! dynamic allocation of mesh arrays
+ allocate(rns(0:2*NER))
+
+ allocate(xgrid(0:2*NER,0:2*NEX_PER_PROC_XI,0:2*NEX_PER_PROC_ETA))
+ allocate(ygrid(0:2*NER,0:2*NEX_PER_PROC_XI,0:2*NEX_PER_PROC_ETA))
+ allocate(zgrid(0:2*NER,0:2*NEX_PER_PROC_XI,0:2*NEX_PER_PROC_ETA))
+
+ allocate(addressing(0:NPROC_XI-1,0:NPROC_ETA-1))
+ allocate(iproc_xi_slice(0:NPROC-1))
+ allocate(iproc_eta_slice(0:NPROC-1))
+
+! clear arrays
+ xgrid(:,:,:) = 0.
+ ygrid(:,:,:) = 0.
+ zgrid(:,:,:) = 0.
+
+ iproc_xi_slice(:) = 0
+ iproc_eta_slice(:) = 0
+
+! create global slice addressing for solver
+ if(myrank == 0) then
+ open(unit=IOUT,file=trim(OUTPUT_FILES)//'/addressing.txt',status='unknown')
+ write(IMAIN,*) 'creating global slice addressing'
+ write(IMAIN,*)
+ endif
+ do iproc_eta=0,NPROC_ETA-1
+ do iproc_xi=0,NPROC_XI-1
+ iprocnum = iproc_eta * NPROC_XI + iproc_xi
+ iproc_xi_slice(iprocnum) = iproc_xi
+ iproc_eta_slice(iprocnum) = iproc_eta
+ addressing(iproc_xi,iproc_eta) = iprocnum
+ if(myrank == 0) write(IOUT,*) iprocnum,iproc_xi,iproc_eta
+ enddo
+ enddo
+ if(myrank == 0) close(IOUT)
+
+ if (myrank == 0) then
+ write(IMAIN,*) 'Spatial distribution of slice numbers:'
+ do iproc_eta = NPROC_ETA-1, 0, -1
+ do iproc_xi = 0, NPROC_XI-1, 1
+ write(IMAIN,'(i5)',advance='no') addressing(iproc_xi,iproc_eta)
+ enddo
+ write(IMAIN,'(a1)',advance='yes') ' '
+ enddo
+ endif
+
+ endif ! end of (.not. USE_EXTERNAL_MESH)
+
+ if(myrank == 0) then
+ write(IMAIN,*) 'This is process ',myrank
+ write(IMAIN,*) 'There are ',sizeprocs,' MPI processes'
+ write(IMAIN,*) 'Processes are numbered from 0 to ',sizeprocs-1
+ write(IMAIN,*)
+ write(IMAIN,*) 'There are ',NEX_XI,' elements along xi'
+ write(IMAIN,*) 'There are ',NEX_ETA,' elements along eta'
+ write(IMAIN,*)
+ write(IMAIN,*) 'There are ',NPROC_XI,' slices along xi'
+ write(IMAIN,*) 'There are ',NPROC_ETA,' slices along eta'
+ write(IMAIN,*) 'There is a total of ',NPROC,' slices'
+ write(IMAIN,*)
+ write(IMAIN,*) 'NGLLX = ',NGLLX
+ write(IMAIN,*) 'NGLLY = ',NGLLY
+ write(IMAIN,*) 'NGLLZ = ',NGLLZ
+
+ write(IMAIN,*)
+ write(IMAIN,*) 'Shape functions defined by NGNOD = ',NGNOD,' control nodes'
+ write(IMAIN,*) 'Surface shape functions defined by NGNOD2D = ',NGNOD2D,' control nodes'
+ write(IMAIN,*)
+ endif
+
+! check that reals are either 4 or 8 bytes
+ if(CUSTOM_REAL /= SIZE_REAL .and. CUSTOM_REAL /= SIZE_DOUBLE) call exit_MPI(myrank,'wrong size of CUSTOM_REAL for reals')
+
+ if(NGNOD /= 8) call exit_MPI(myrank,'number of control nodes must be 8')
+ if(NGNOD2D /= 4) call exit_MPI(myrank,'elements with 8 points should have NGNOD2D = 4')
+
+! for the number of standard linear solids for attenuation
+ if(N_SLS /= 3) call exit_MPI(myrank,'number of SLS must be 3')
+
+ if (.not. USE_EXTERNAL_MESH) then
+! check that Poisson's ratio in Gocad block is fine
+ if(VP_VS_RATIO_GOCAD_TOP < sqrt(2.) .or. VP_VS_RATIO_GOCAD_BOTTOM < sqrt(2.))&
+ call exit_MPI(myrank,'vp/vs ratio in Gocad block is too small')
+
+! check that number of slices is at least 1 in each direction
+ if(NPROC_XI < 1) call exit_MPI(myrank,'NPROC_XI must be greater than 1')
+ if(NPROC_ETA < 1) call exit_MPI(myrank,'NPROC_ETA must be greater than 1')
+
+! check that mesh can be cut into the right number of slices
+! also check that mesh can be coarsened in depth twice (block size multiple of 8)
+ if(USE_REGULAR_MESH) then
+ if(mod(NEX_XI,NPROC_XI) /= 0) call exit_MPI(myrank,'NEX_XI must be a multiple of NPROC_XI for a regular mesh')
+ if(mod(NEX_ETA,NPROC_ETA) /= 0) call exit_MPI(myrank,'NEX_ETA must be a multiple of NPROC_ETA for a regular mesh')
+ else
+ if(mod(NEX_XI,8) /= 0) call exit_MPI(myrank,'NEX_XI must be a multiple of 8 for a non-regular mesh')
+ if(mod(NEX_ETA,8) /= 0) call exit_MPI(myrank,'NEX_ETA must be a multiple of 8 for a non-regular mesh')
+
+ if(mod(NEX_XI/8,NPROC_XI) /= 0) call exit_MPI(myrank,'NEX_XI must be a multiple of 8*NPROC_XI for a non-regular mesh')
+ if(mod(NEX_ETA/8,NPROC_ETA) /= 0) call exit_MPI(myrank,'NEX_ETA must be a multiple of 8*NPROC_ETA for a non-regular mesh')
+ endif
+
+ endif ! end of (.not. USE_EXTERNAL_MESH)
+
+ if(myrank == 0) then
+
+ write(IMAIN,*) 'region selected:'
+ write(IMAIN,*)
+ write(IMAIN,*) 'latitude min = ',LATITUDE_MIN
+ write(IMAIN,*) 'latitude max = ',LATITUDE_MAX
+ write(IMAIN,*)
+ write(IMAIN,*) 'longitude min = ',LONGITUDE_MIN
+ write(IMAIN,*) 'longitude max = ',LONGITUDE_MAX
+ write(IMAIN,*)
+ write(IMAIN,*) 'this is mapped to UTM in region ',UTM_PROJECTION_ZONE
+ write(IMAIN,*)
+ write(IMAIN,*) 'UTM X min = ',UTM_X_MIN
+ write(IMAIN,*) 'UTM X max = ',UTM_X_MAX
+ write(IMAIN,*)
+ write(IMAIN,*) 'UTM Y min = ',UTM_Y_MIN
+ write(IMAIN,*) 'UTM Y max = ',UTM_Y_MAX
+ write(IMAIN,*)
+ write(IMAIN,*) 'UTM size of model along X is ',(UTM_X_MAX-UTM_X_MIN)/1000.,' km'
+ write(IMAIN,*) 'UTM size of model along Y is ',(UTM_Y_MAX-UTM_Y_MIN)/1000.,' km'
+ write(IMAIN,*)
+ write(IMAIN,*) 'Bottom of the mesh is at a depth of ',dabs(Z_DEPTH_BLOCK)/1000.,' km'
+ write(IMAIN,*)
+
+
+ write(IMAIN,*)
+ if(TOPOGRAPHY) then
+ write(IMAIN,*) 'incorporating surface topography'
+ else
+ write(IMAIN,*) 'no surface topography'
+ endif
+
+ write(IMAIN,*)
+ if(SUPPRESS_UTM_PROJECTION) then
+ write(IMAIN,*) 'suppressing UTM projection'
+ else
+ write(IMAIN,*) 'using UTM projection in region ',UTM_PROJECTION_ZONE
+ endif
+
+ write(IMAIN,*)
+ if(HARVARD_3D_GOCAD_MODEL) then
+ write(IMAIN,*) 'incorporating 3-D lateral variations'
+ else
+ write(IMAIN,*) 'no 3-D lateral variations'
+ endif
+
+ write(IMAIN,*)
+ if(ATTENUATION) then
+ write(IMAIN,*) 'incorporating attenuation using ',N_SLS,' standard linear solids'
+ if(USE_OLSEN_ATTENUATION) then
+ write(IMAIN,*) 'using Olsen''s attenuation'
+ else
+ write(IMAIN,*) 'not using Olsen''s attenuation'
+ endif
+ else
+ write(IMAIN,*) 'no attenuation'
+ endif
+
+ write(IMAIN,*)
+ if(OCEANS) then
+ write(IMAIN,*) 'incorporating the oceans using equivalent load'
+ else
+ write(IMAIN,*) 'no oceans'
+ endif
+
+ write(IMAIN,*)
+
+ endif
+
+! read topography and bathymetry file
+ if(TOPOGRAPHY .or. OCEANS) then
+
+! for Southern California
+ NX_TOPO = NX_TOPO_SOCAL
+ NY_TOPO = NY_TOPO_SOCAL
+ ORIG_LAT_TOPO = ORIG_LAT_TOPO_SOCAL
+ ORIG_LONG_TOPO = ORIG_LONG_TOPO_SOCAL
+ DEGREES_PER_CELL_TOPO = DEGREES_PER_CELL_TOPO_SOCAL
+ topo_file = TOPO_FILE_SOCAL
+
+ allocate(itopo_bathy(NX_TOPO,NY_TOPO))
+
+ call read_topo_bathy_file(itopo_bathy,NX_TOPO,NY_TOPO,topo_file)
+
+ if(myrank == 0) then
+ write(IMAIN,*)
+ write(IMAIN,*) 'regional topography file read ranges in m from ',minval(itopo_bathy),' to ',maxval(itopo_bathy)
+ write(IMAIN,*)
+ endif
+
+ endif
+
+! read Moho map
+ if(MOHO_MAP_LUPEI) then
+ call read_moho_map(imoho_depth)
+ if(myrank == 0) then
+ write(IMAIN,*)
+ write(IMAIN,*) 'regional Moho depth read ranges in m from ',minval(imoho_depth),' to ',maxval(imoho_depth)
+ write(IMAIN,*)
+ endif
+ endif
+
+! read basement map
+ if(BASEMENT_MAP) then
+ call get_value_string(BASEMENT_MAP_FILE,'model.BASEMENT_MAP_FILE','DATA/la_basement/reggridbase2_filtered_ascii.dat')
+ open(unit=55,file=BASEMENT_MAP_FILE,status='old',action='read')
+ do ix=1,NX_BASEMENT
+ do iy=1,NY_BASEMENT
+ read(55,*) iz_basement
+ z_basement(ix,iy) = dble(iz_basement)
+ enddo
+ enddo
+ close(55)
+ endif
+
+ if (.not. USE_EXTERNAL_MESH) then
+
+! get addressing for this process
+ iproc_xi = iproc_xi_slice(myrank)
+ iproc_eta = iproc_eta_slice(myrank)
+
+! number of elements in each slice
+ npx = 2*NEX_PER_PROC_XI
+ npy = 2*NEX_PER_PROC_ETA
+
+ min_elevation = +HUGEVAL
+ max_elevation = -HUGEVAL
+
+! fill the region between the cutoff depth and the free surface
+ do iy=0,npy
+ do ix=0,npx
+
+! define the mesh points on the top and the bottom
+
+ xin=dble(ix)/dble(npx)
+ x_current = UTM_X_MIN + (dble(iproc_xi)+xin)*(UTM_X_MAX-UTM_X_MIN)/dble(NPROC_XI)
+
+ etan=dble(iy)/dble(npy)
+ y_current = UTM_Y_MIN + (dble(iproc_eta)+etan)*(UTM_Y_MAX-UTM_Y_MIN)/dble(NPROC_ETA)
+
+! define model between topography surface and fictitious bottom
+ if(TOPOGRAPHY) then
+
+! project x and y in UTM back to long/lat since topo file is in long/lat
+ call utm_geo(long,lat,x_current,y_current,UTM_PROJECTION_ZONE,IUTM2LONGLAT,SUPPRESS_UTM_PROJECTION)
+
+! get coordinate of corner in bathy/topo model
+ icornerlong = int((long - ORIG_LONG_TOPO) / DEGREES_PER_CELL_TOPO) + 1
+ icornerlat = int((lat - ORIG_LAT_TOPO) / DEGREES_PER_CELL_TOPO) + 1
+
+! avoid edge effects and extend with identical point if outside model
+ if(icornerlong < 1) icornerlong = 1
+ if(icornerlong > NX_TOPO-1) icornerlong = NX_TOPO-1
+ if(icornerlat < 1) icornerlat = 1
+ if(icornerlat > NY_TOPO-1) icornerlat = NY_TOPO-1
+
+! compute coordinates of corner
+ long_corner = ORIG_LONG_TOPO + (icornerlong-1)*DEGREES_PER_CELL_TOPO
+ lat_corner = ORIG_LAT_TOPO + (icornerlat-1)*DEGREES_PER_CELL_TOPO
+
+! compute ratio for interpolation
+ ratio_xi = (long - long_corner) / DEGREES_PER_CELL_TOPO
+ ratio_eta = (lat - lat_corner) / DEGREES_PER_CELL_TOPO
+
+! avoid edge effects
+ if(ratio_xi < 0.) ratio_xi = 0.
+ if(ratio_xi > 1.) ratio_xi = 1.
+ if(ratio_eta < 0.) ratio_eta = 0.
+ if(ratio_eta > 1.) ratio_eta = 1.
+
+! interpolate elevation at current point
+ elevation = &
+ itopo_bathy(icornerlong,icornerlat)*(1.-ratio_xi)*(1.-ratio_eta) + &
+ itopo_bathy(icornerlong+1,icornerlat)*ratio_xi*(1.-ratio_eta) + &
+ itopo_bathy(icornerlong+1,icornerlat+1)*ratio_xi*ratio_eta + &
+ itopo_bathy(icornerlong,icornerlat+1)*(1.-ratio_xi)*ratio_eta
+
+ else
+
+ elevation = 0.d0
+
+ endif
+
+ z_top = Z_SURFACE + elevation
+ z_bot = - dabs(Z_DEPTH_BLOCK)
+
+! compute global min and max of elevation
+ min_elevation = dmin1(min_elevation,elevation)
+ max_elevation = dmax1(max_elevation,elevation)
+
+! create vertical point distribution at current horizontal point
+ if(BASEMENT_MAP) then
+
+! get coordinate of corner in bathy/topo model
+ icorner_x = int((x_current - ORIG_X_BASEMENT) / SPACING_X_BASEMENT) + 1
+ icorner_y = int((y_current - ORIG_Y_BASEMENT) / SPACING_Y_BASEMENT) + 1
+
+! avoid edge effects and extend with identical point if outside model
+ if(icorner_x < 1) icorner_x = 1
+ if(icorner_x > NX_BASEMENT-1) icorner_x = NX_BASEMENT-1
+ if(icorner_y < 1) icorner_y = 1
+ if(icorner_y > NY_BASEMENT-1) icorner_y = NY_BASEMENT-1
+
+! compute coordinates of corner
+ x_corner = ORIG_X_BASEMENT + (icorner_x-1)*SPACING_X_BASEMENT
+ y_corner = ORIG_Y_BASEMENT + (icorner_y-1)*SPACING_Y_BASEMENT
+
+! compute ratio for interpolation
+ ratio_xi = (x_current - x_corner) / SPACING_X_BASEMENT
+ ratio_eta = (y_current - y_corner) / SPACING_Y_BASEMENT
+
+! avoid edge effects
+ if(ratio_xi < 0.) ratio_xi = 0.
+ if(ratio_xi > 1.) ratio_xi = 1.
+ if(ratio_eta < 0.) ratio_eta = 0.
+ if(ratio_eta > 1.) ratio_eta = 1.
+
+! interpolate basement surface at current point
+ Z_BASEMENT_SURFACE = &
+ z_basement(icorner_x,icorner_y)*(1.-ratio_xi)*(1.-ratio_eta) + &
+ z_basement(icorner_x+1,icorner_y)*ratio_xi*(1.-ratio_eta) + &
+ z_basement(icorner_x+1,icorner_y+1)*ratio_xi*ratio_eta + &
+ z_basement(icorner_x,icorner_y+1)*(1.-ratio_xi)*ratio_eta
+
+ else
+ Z_BASEMENT_SURFACE = DEPTH_5p5km_SOCAL
+ endif
+
+! honor Lupei Zhu's Moho map
+ if(MOHO_MAP_LUPEI) then
+
+! project x and y in UTM back to long/lat since topo file is in long/lat
+ call utm_geo(long,lat,x_current,y_current,UTM_PROJECTION_ZONE,IUTM2LONGLAT,SUPPRESS_UTM_PROJECTION)
+
+! get coordinate of corner in Moho map
+ icornerlong = int((long - ORIG_LONG_MOHO) / DEGREES_PER_CELL_MOHO) + 1
+ icornerlat = int((lat - ORIG_LAT_MOHO) / DEGREES_PER_CELL_MOHO) + 1
+
+! avoid edge effects and extend with identical point if outside model
+ if(icornerlong < 1) icornerlong = 1
+ if(icornerlong > NX_MOHO-1) icornerlong = NX_MOHO-1
+ if(icornerlat < 1) icornerlat = 1
+ if(icornerlat > NY_MOHO-1) icornerlat = NY_MOHO-1
+
+! compute coordinates of corner
+ long_corner = ORIG_LONG_MOHO + (icornerlong-1)*DEGREES_PER_CELL_MOHO
+ lat_corner = ORIG_LAT_MOHO + (icornerlat-1)*DEGREES_PER_CELL_MOHO
+
+! compute ratio for interpolation
+ ratio_xi = (long - long_corner) / DEGREES_PER_CELL_MOHO
+ ratio_eta = (lat - lat_corner) / DEGREES_PER_CELL_MOHO
+
+! avoid edge effects
+ if(ratio_xi < 0.) ratio_xi = 0.
+ if(ratio_xi > 1.) ratio_xi = 1.
+ if(ratio_eta < 0.) ratio_eta = 0.
+ if(ratio_eta > 1.) ratio_eta = 1.
+
+! interpolate Moho depth at current point
+ Z_DEPTH_MOHO = &
+ - (imoho_depth(icornerlong,icornerlat)*(1.-ratio_xi)*(1.-ratio_eta) + &
+ imoho_depth(icornerlong+1,icornerlat)*ratio_xi*(1.-ratio_eta) + &
+ imoho_depth(icornerlong+1,icornerlat+1)*ratio_xi*ratio_eta + &
+ imoho_depth(icornerlong,icornerlat+1)*(1.-ratio_xi)*ratio_eta)
+
+ else
+ Z_DEPTH_MOHO = DEPTH_MOHO_SOCAL
+ endif
+
+! define vertical spacing of the mesh in case of a non-regular mesh with mesh doublings
+ if(.not. USE_REGULAR_MESH) call mesh_vertical(myrank,rns,NER,NER_BOTTOM_MOHO,NER_MOHO_16, &
+ NER_16_BASEMENT,NER_BASEMENT_SEDIM,NER_SEDIM, &
+!! DK DK UGLY modif z_top by Emmanuel Chaljub here
+!! DK DK UGLY modif Manu removed z_top, &
+ Z_DEPTH_BLOCK,Z_BASEMENT_SURFACE,Z_DEPTH_MOHO,MOHO_MAP_LUPEI)
+
+! fill the volume
+ do ir = 0,2*NER
+ if(USE_REGULAR_MESH) then
+ rn = dble(ir) / dble(2*NER)
+ else
+ rn = rns(ir)
+ endif
+ xgrid(ir,ix,iy) = x_current
+ ygrid(ir,ix,iy) = y_current
+ zgrid(ir,ix,iy) = z_bot*(ONE-rn) + z_top*rn
+ enddo
+
+ enddo
+ enddo
+
+ endif ! end of (.not. USE_EXTERNAL_MESH)
+
+ if(myrank == 0) then
+ write(IMAIN,*)
+ write(IMAIN,*) '**************************'
+ write(IMAIN,*) 'creating mesh in the model'
+ write(IMAIN,*) '**************************'
+ write(IMAIN,*)
+ endif
+
+! volume of bottom and top area of the slice
+ volume_local = ZERO
+ area_local_bottom = ZERO
+ area_local_top = ZERO
+
+! read databases about external mesh simulation
+! nlegoff --
+ if (USE_EXTERNAL_MESH) then
+ call create_name_database(prname,myrank,LOCAL_PATH)
+ open(unit=IIN,file=prname(1:len_trim(prname))//'Database',status='old',action='read',form='formatted')
+ read(IIN,*) nnodes_ext_mesh
+ allocate(nodes_coords_ext_mesh(NDIM,nnodes_ext_mesh))
+ do inode = 1, nnodes_ext_mesh
+ read(IIN,*) dummy_node, nodes_coords_ext_mesh(1,inode), nodes_coords_ext_mesh(2,inode), nodes_coords_ext_mesh(3,inode)
+ enddo
+
+ read(IIN,*) nelmnts_ext_mesh
+ allocate(elmnts_ext_mesh(esize,nelmnts_ext_mesh))
+ allocate(mat_ext_mesh(nelmnts_ext_mesh))
+ do ispec = 1, nelmnts_ext_mesh
+ read(IIN,*) dummy_elmnt, mat_ext_mesh(ispec), &
+ elmnts_ext_mesh(1,ispec), elmnts_ext_mesh(2,ispec), elmnts_ext_mesh(3,ispec), elmnts_ext_mesh(4,ispec), &
+ elmnts_ext_mesh(5,ispec), elmnts_ext_mesh(6,ispec), elmnts_ext_mesh(7,ispec), elmnts_ext_mesh(8,ispec)
+ enddo
+ NSPEC_AB = nelmnts_ext_mesh
+
+ read(IIN,*) ninterface_ext_mesh, max_interface_size_ext_mesh
+ allocate(my_neighbours_ext_mesh(ninterface_ext_mesh))
+ allocate(my_nelmnts_neighbours_ext_mesh(ninterface_ext_mesh))
+ allocate(my_interfaces_ext_mesh(6,max_interface_size_ext_mesh,ninterface_ext_mesh))
+ allocate(ibool_interfaces_ext_mesh(NGLLX*NGLLX*max_interface_size_ext_mesh,ninterface_ext_mesh))
+ allocate(nibool_interfaces_ext_mesh(ninterface_ext_mesh))
+ do num_interface = 1, ninterface_ext_mesh
+ read(IIN,*) my_neighbours_ext_mesh(num_interface), my_nelmnts_neighbours_ext_mesh(num_interface)
+ do ie = 1, my_nelmnts_neighbours_ext_mesh(num_interface)
+ read(IIN,*) my_interfaces_ext_mesh(1,ie,num_interface), my_interfaces_ext_mesh(2,ie,num_interface), &
+ my_interfaces_ext_mesh(3,ie,num_interface), my_interfaces_ext_mesh(4,ie,num_interface), &
+ my_interfaces_ext_mesh(5,ie,num_interface), my_interfaces_ext_mesh(6,ie,num_interface)
+ enddo
+ enddo
+
+ close(IIN)
+
+ endif
+
+! assign theoretical number of elements
+ nspec = NSPEC_AB
+
+! compute maximum number of points
+ npointot = nspec * NGLLCUBE
+
+! make sure everybody is synchronized
+ call sync_all()
+
+! use dynamic allocation to allocate memory for arrays
+ allocate(idoubling(nspec))
+ allocate(ibool(NGLLX,NGLLY,NGLLZ,nspec))
+ allocate(xstore(NGLLX,NGLLY,NGLLZ,nspec))
+ allocate(ystore(NGLLX,NGLLY,NGLLZ,nspec))
+ allocate(zstore(NGLLX,NGLLY,NGLLZ,nspec),stat=ier)
+
+! exit if there is not enough memory to allocate all the arrays
+ if(ier /= 0) call exit_MPI(myrank,'not enough memory to allocate arrays')
+
+! create all the regions of the mesh
+ if (USE_EXTERNAL_MESH) then
+ call create_regions_mesh_ext_mesh(ibool, &
+ xstore,ystore,zstore,nspec, &
+ npointot,myrank,LOCAL_PATH, &
+ nnodes_ext_mesh,nelmnts_ext_mesh, &
+ nodes_coords_ext_mesh,elmnts_ext_mesh,mat_ext_mesh, &
+ ninterface_ext_mesh,max_interface_size_ext_mesh, &
+ my_neighbours_ext_mesh,my_nelmnts_neighbours_ext_mesh,my_interfaces_ext_mesh, &
+ ibool_interfaces_ext_mesh,nibool_interfaces_ext_mesh)
+
+ else
+ call create_regions_mesh(xgrid,ygrid,zgrid,ibool,idoubling, &
+ xstore,ystore,zstore,npx,npy, &
+ iproc_xi,iproc_eta,nspec, &
+ volume_local,area_local_bottom,area_local_top, &
+ NGLOB_AB,npointot, &
+ NER_BOTTOM_MOHO,NER_MOHO_16,NER_16_BASEMENT,NER_BASEMENT_SEDIM,NER_SEDIM,NER, &
+ NEX_PER_PROC_XI,NEX_PER_PROC_ETA, &
+ NSPEC2DMAX_XMIN_XMAX, &
+ NSPEC2DMAX_YMIN_YMAX,NSPEC2D_BOTTOM,NSPEC2D_TOP, &
+ HARVARD_3D_GOCAD_MODEL,NPROC_XI,NPROC_ETA,NSPEC2D_A_XI,NSPEC2D_B_XI, &
+ NSPEC2D_A_ETA,NSPEC2D_B_ETA,myrank,LOCAL_PATH, &
+ UTM_X_MIN,UTM_X_MAX,UTM_Y_MIN,UTM_Y_MAX,Z_DEPTH_BLOCK,UTM_PROJECTION_ZONE, &
+ HAUKSSON_REGIONAL_MODEL,OCEANS, &
+ VP_MIN_GOCAD,VP_VS_RATIO_GOCAD_TOP,VP_VS_RATIO_GOCAD_BOTTOM, &
+ IMPOSE_MINIMUM_VP_GOCAD,THICKNESS_TAPER_BLOCK_HR,THICKNESS_TAPER_BLOCK_MR,MOHO_MAP_LUPEI, &
+ ANISOTROPY,SAVE_MESH_FILES,SUPPRESS_UTM_PROJECTION, &
+ ORIG_LAT_TOPO,ORIG_LONG_TOPO,DEGREES_PER_CELL_TOPO,NX_TOPO,NY_TOPO,USE_REGULAR_MESH)
+ endif
+! print min and max of topography included
+ if(TOPOGRAPHY) then
+
+! compute the maximum of the maxima for all the slices using an MPI reduction
+ call min_all_dp(min_elevation,min_elevation_all)
+ call max_all_dp(max_elevation,max_elevation_all)
+
+ if(myrank == 0) then
+ write(IMAIN,*)
+ write(IMAIN,*) 'min and max of topography included in mesh in m is ',min_elevation_all,' ',max_elevation_all
+ write(IMAIN,*)
+ endif
+ endif
+
+
+! use MPI reduction to compute total area and volume
+ area_total_bottom = ZERO
+ area_total_top = ZERO
+ call sum_all_dp(area_local_bottom,area_total_bottom)
+ call sum_all_dp(area_local_top,area_total_top)
+ call sum_all_dp(volume_local,volume_total)
+
+ if(myrank == 0) then
+
+! check volume, and bottom and top area
+
+ write(IMAIN,*)
+ write(IMAIN,*) ' calculated top area: ',area_total_top
+
+! compare to exact theoretical value
+ if(.not. TOPOGRAPHY) &
+ write(IMAIN,*) ' exact area: ',(UTM_Y_MAX-UTM_Y_MIN)*(UTM_X_MAX-UTM_X_MIN)
+
+ write(IMAIN,*)
+ write(IMAIN,*) 'calculated bottom area: ',area_total_bottom
+
+! compare to exact theoretical value (bottom is always flat)
+ write(IMAIN,*) ' exact area: ',(UTM_Y_MAX-UTM_Y_MIN)*(UTM_X_MAX-UTM_X_MIN)
+
+ endif
+
+! make sure everybody is synchronized
+ call sync_all()
+
+ if(myrank == 0) then
+! check volume
+ write(IMAIN,*)
+ write(IMAIN,*) 'calculated volume: ',volume_total
+! take the central cube into account
+ if(.not. TOPOGRAPHY) &
+ write(IMAIN,*) ' exact volume: ', &
+ (UTM_Y_MAX-UTM_Y_MIN)*(UTM_X_MAX-UTM_X_MIN)*dabs(Z_DEPTH_BLOCK)
+
+ endif
+
+!--- print number of points and elements in the mesh
+
+ if(myrank == 0) then
+
+ write(IMAIN,*)
+ write(IMAIN,*) 'Repartition of elements:'
+ write(IMAIN,*) '-----------------------'
+ write(IMAIN,*)
+ write(IMAIN,*) 'total number of elements in each slice: ',NSPEC_AB
+ write(IMAIN,*)
+ write(IMAIN,*) 'total number of points in each slice: ',NGLOB_AB
+
+ write(IMAIN,*)
+ write(IMAIN,*) 'total number of elements in entire mesh: ',NSPEC_AB*NPROC
+ write(IMAIN,*) 'total number of points in entire mesh: ',NGLOB_AB*NPROC
+ write(IMAIN,*) 'total number of DOFs in entire mesh: ',NGLOB_AB*NPROC*NDIM
+ write(IMAIN,*)
+ write(IMAIN,*) 'total number of time steps in the solver will be: ',NSTEP
+ write(IMAIN,*)
+
+! write information about precision used for floating-point operations
+ if(CUSTOM_REAL == SIZE_REAL) then
+ write(IMAIN,*) 'using single precision for the calculations'
+ else
+ write(IMAIN,*) 'using double precision for the calculations'
+ endif
+ write(IMAIN,*)
+ write(IMAIN,*) 'smallest and largest possible floating-point numbers are: ',tiny(1._CUSTOM_REAL),huge(1._CUSTOM_REAL)
+ write(IMAIN,*)
+
+! copy number of elements and points in an include file for the solver
+ call save_header_file(NSPEC_AB,NGLOB_AB,NEX_XI,NEX_ETA,NPROC,NPROC_XI,NPROC_ETA, &
+ UTM_X_MIN,UTM_X_MAX,UTM_Y_MIN,UTM_Y_MAX,ATTENUATION,ANISOTROPY,NSTEP, &
+ NSPEC2DMAX_XMIN_XMAX,NSPEC2DMAX_YMIN_YMAX,NSPEC2D_BOTTOM,NSPEC2D_TOP, &
+ NPOIN2DMAX_XMIN_XMAX,NPOIN2DMAX_YMIN_YMAX,SIMULATION_TYPE)
+
+ call get_value_string(rec_filename, 'solver.STATIONS', 'DATA/STATIONS')
+ call get_value_string(filtered_rec_filename, 'solver.STATIONS_FILTERED', 'DATA/STATIONS_FILTERED')
+
+! get total number of stations
+ open(unit=IIN,file=rec_filename,iostat=ios,status='old',action='read')
+ nrec = 0
+ do while(ios == 0)
+ read(IIN,"(a)",iostat=ios) dummystring
+ if(ios == 0) nrec = nrec + 1
+ enddo
+ close(IIN)
+
+! filter list of stations, only retain stations that are in the model
+ nrec_filtered = 0
+ open(unit=IIN,file=rec_filename,status='old',action='read')
+ do irec = 1,nrec
+ read(IIN,*) station_name,network_name,stlat,stlon,stele,stbur
+ if((stlat >= LATITUDE_MIN .and. stlat <= LATITUDE_MAX .and. stlon >= LONGITUDE_MIN .and. stlon <= LONGITUDE_MAX) &
+ .or. USE_EXTERNAL_MESH) &
+ nrec_filtered = nrec_filtered + 1
+ enddo
+ close(IIN)
+
+ write(IMAIN,*)
+ write(IMAIN,*) 'there are ',nrec,' stations in file ', trim(rec_filename)
+ write(IMAIN,*) 'saving ',nrec_filtered,' stations inside the model in file ', trim(filtered_rec_filename)
+ write(IMAIN,*) 'excluding ',nrec - nrec_filtered,' stations located outside the model'
+ write(IMAIN,*)
+
+ if(nrec_filtered < 1) call exit_MPI(myrank,'need at least one station in the model')
+
+ open(unit=IIN,file=rec_filename,status='old',action='read')
+ open(unit=IOUT,file=filtered_rec_filename,status='unknown')
+
+ do irec = 1,nrec
+ read(IIN,*) station_name,network_name,stlat,stlon,stele,stbur
+ if((stlat >= LATITUDE_MIN .and. stlat <= LATITUDE_MAX .and. stlon >= LONGITUDE_MIN .and. stlon <= LONGITUDE_MAX) &
+ .or. USE_EXTERNAL_MESH) &
+ write(IOUT,*) station_name(1:len_trim(station_name)),' ',network_name(1:len_trim(network_name)),' ', &
+ sngl(stlat),' ',sngl(stlon), ' ', sngl(stele), ' ', sngl(stbur)
+ enddo
+
+ close(IIN)
+ close(IOUT)
+
+ endif ! end of section executed by main process only
+
+! elapsed time since beginning of mesh generation
+ if(myrank == 0) then
+ tCPU = wtime() - time_start
+ write(IMAIN,*)
+ write(IMAIN,*) 'Elapsed time for mesh generation and buffer creation in seconds = ',tCPU
+ write(IMAIN,*) 'End of mesh generation'
+ write(IMAIN,*)
+ endif
+
+! close main output file
+ if(myrank == 0) then
+ write(IMAIN,*) 'done'
+ write(IMAIN,*)
+ close(IMAIN)
+ endif
+
+! synchronize all the processes to make sure everybody has finished
+ call sync_all()
+
+ end subroutine generate_databases
+
Property changes on: seismo/3D/SPECFEM3D_SESAME/trunk/generate_databases.f90
___________________________________________________________________
Name: svn:keywords
+ Author Date Id Revision
Name: svn:mergeinfo
+
Name: svn:eol-style
+ native
Modified: seismo/3D/SPECFEM3D_SESAME/trunk/go_mesher
===================================================================
--- seismo/3D/SPECFEM3D_SESAME/trunk/go_mesher 2009-03-12 16:31:24 UTC (rev 14300)
+++ seismo/3D/SPECFEM3D_SESAME/trunk/go_mesher 2009-03-12 17:37:00 UTC (rev 14301)
@@ -49,11 +49,11 @@
#### use this on Beowulf
set MPIRUN="mpirun"
-$MPIRUN -nolocal -machinefile $machine_file -np $numprocessors $PWD/xmeshfem3D
+$MPIRUN -nolocal -machinefile $machine_file -np $numprocessors $PWD/xgenerate_databases
#### use this on SGI
-# mpirun -np $numprocessors xmeshfem3D
+# mpirun -np $numprocessors xgenerate_databases
#### use this on Compaq Dec Alpha
-# dmpirun -np $numprocessors xmeshfem3D
+# dmpirun -np $numprocessors xgenerate_databases
Deleted: seismo/3D/SPECFEM3D_SESAME/trunk/main.c
===================================================================
--- seismo/3D/SPECFEM3D_SESAME/trunk/main.c 2009-03-12 16:31:24 UTC (rev 14300)
+++ seismo/3D/SPECFEM3D_SESAME/trunk/main.c 2009-03-12 17:37:00 UTC (rev 14301)
@@ -1,108 +0,0 @@
-
-#include <Python.h>
-#include <mpi.h>
-
-#include "config.h"
-
-
-extern void initPyxParameters(void);
-extern void initPyxMeshfem(void);
-#ifdef WITH_SOLVER
-extern void initPyxSpecfem(void);
-#endif
-
-static int g_status;
-int g_argc;
-char **g_argv;
-
-#define COMMAND \
-"import sys; " \
-"path = sys.argv[1]; " \
-"requires = sys.argv[2]; " \
-"entry = sys.argv[3]; " \
-"path = path.split(':'); " \
-"path.extend(sys.path); " \
-"sys.path = path; " \
-"from merlin import loadObject; " \
-"entry = loadObject(entry); " \
-"entry(sys.argv[3:], kwds={'requires': requires})"
-
-/* include the implementation of _mpi */
-#include "mpi/_mpi.c"
-
-struct _inittab inittab[] = {
-#ifdef WITH_MPI
- { "_mpi", init_mpi },
-#endif
- { "PyxParameters", initPyxParameters },
- { "PyxMeshfem", initPyxMeshfem },
-#ifdef WITH_SOLVER
- { "PyxSpecfem", initPyxSpecfem },
-#endif
- { 0, 0 }
-};
-
-
-#define FC_PY_MAIN FC_FUNC_(fc_py_main, FC_PY_MAIN)
-void FC_PY_MAIN()
-{
- if (g_argc < 3 || strcmp(g_argv[1], "--pyre-start") != 0) {
- g_status = Py_Main(g_argc, g_argv);
- return;
- }
-
- /* make sure 'sys.executable' is set to the path of this program */
- Py_SetProgramName(g_argv[0]);
-
- /* initialize Python */
- Py_Initialize();
-
- /* initialize sys.argv */
- PySys_SetArgv(g_argc - 1, g_argv + 1);
-
- /* run the Python command */
- g_status = PyRun_SimpleString(COMMAND) != 0;
-
- /* shut down Python */
- Py_Finalize();
-}
-
-
-int main(int argc, char **argv)
-{
-#if defined(WITH_MPI) && defined(USE_MPI)
- /* initialize MPI */
- if (MPI_Init(&argc, &argv) != MPI_SUCCESS) {
- fprintf(stderr, "%s: MPI_Init failed! Exiting ...", argv[0]);
- return 1;
- }
-#endif
-
- /* add our extension module */
- if (PyImport_ExtendInittab(inittab) == -1) {
- fprintf(stderr, "%s: PyImport_ExtendInittab failed! Exiting ...", argv[0]);
- return 1;
- }
-
- g_argc = argc;
- g_argv = argv;
-
-#define main 42
-#if FC_MAIN == main
- /* start Python */
- FC_PY_MAIN();
-#else
- /* call the Fortran trampoline (which, in turn, starts Python) */
- FC_MAIN();
-#endif
-
-#if defined(WITH_MPI) && defined(USE_MPI)
- /* shut down MPI */
- MPI_Finalize();
-#endif
-
- return g_status;
-}
-
-
-/* end of file */
Deleted: seismo/3D/SPECFEM3D_SESAME/trunk/meshfem3D.f90
===================================================================
--- seismo/3D/SPECFEM3D_SESAME/trunk/meshfem3D.f90 2009-03-12 16:31:24 UTC (rev 14300)
+++ seismo/3D/SPECFEM3D_SESAME/trunk/meshfem3D.f90 2009-03-12 17:37:00 UTC (rev 14301)
@@ -1,968 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology September 2006
-!
-! 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.
-!
-!=====================================================================
-!
-! United States Government Sponsorship Acknowledged.
-!
-
- subroutine meshfem3D
-
- implicit none
-
- include "constants.h"
-
-!=============================================================================!
-! !
-! meshfem3D produces a spectral element grid for a local or regional model. !
-! The mesher uses the UTM projection !
-! !
-!=============================================================================!
-!
-! If you use this code for your own research, please cite some of these articles:
-!
-! @ARTICLE{KoLiTrSuStSh04,
-! author={Dimitri Komatitsch and Qinya Liu and Jeroen Tromp and Peter S\"{u}ss
-! and Christiane Stidham and John H. Shaw},
-! year=2004,
-! title={Simulations of Ground Motion in the {L}os {A}ngeles {B}asin
-! based upon the Spectral-Element Method},
-! journal={Bull. Seism. Soc. Am.},
-! volume=94,
-! number=1,
-! pages={187-206}}
-!
-! @ARTICLE{KoTr99,
-! author={D. Komatitsch and J. Tromp},
-! year=1999,
-! title={Introduction to the spectral-element method for 3-{D} seismic wave propagation},
-! journal={Geophys. J. Int.},
-! volume=139,
-! number=3,
-! pages={806-822},
-! doi={10.1046/j.1365-246x.1999.00967.x}}
-!
-! @ARTICLE{KoVi98,
-! author={D. Komatitsch and J. P. Vilotte},
-! title={The spectral-element method: an efficient tool to simulate the seismic response of 2{D} and 3{D} geological structures},
-! journal={Bull. Seismol. Soc. Am.},
-! year=1998,
-! volume=88,
-! number=2,
-! pages={368-392}}
-!
-! If you use the kernel capabilities of the code, please cite
-!
-! @ARTICLE{LiTr06,
-! author={Qinya Liu and Jeroen Tromp},
-! title={Finite-frequency kernels based on adjoint methods},
-! journal={Bull. Seismol. Soc. Am.},
-! year=2006,
-! volume=96,
-! number=6,
-! pages={2383-2397},
-! doi={10.1785/0120060041}}
-!
-! Reference frame - convention:
-! ----------------------------
-!
-! The code uses the following convention for the reference frame:
-!
-! - X axis is East
-! - Y axis is North
-! - Z axis is up
-!
-! Note that this convention is different from both the Aki-Richards convention
-! and the Harvard CMT convention.
-!
-! Let us recall that the Aki-Richards convention is:
-!
-! - X axis is North
-! - Y axis is East
-! - Z axis is down
-!
-! and that the Harvard CMT convention is:
-!
-! - X axis is South
-! - Y axis is East
-! - Z axis is up
-!
-! To report bugs or suggest improvements to the code, please send an email
-! to Jeroen Tromp <jtromp AT caltech.edu> and/or use our online
-! bug tracking system at http://www.geodynamics.org/roundup .
-!
-! Evolution of the code:
-! ---------------------
-!
-! MPI v. 1.4 Dimitri Komatitsch, University of Pau, Qinya Liu and others, Caltech, September 2006:
-! better adjoint and kernel calculations, faster and better I/Os
-! on very large systems, new Pyre version, many small improvements and bug fixes
-! MPI v. 1.3 Dimitri Komatitsch, University of Pau, and Qinya Liu, Caltech, July 2005:
-! serial version, regular mesh, adjoint and kernel calculations, ParaView support
-! MPI v. 1.2 Min Chen and Dimitri Komatitsch, Caltech, July 2004:
-! full anisotropy, volume movie
-! MPI v. 1.1 Dimitri Komatitsch, Caltech, October 2002: Zhu's Moho map, scaling
-! of Vs with depth, Hauksson's regional model, attenuation, oceans, movies
-! MPI v. 1.0 Dimitri Komatitsch, Caltech, May 2002: first MPI version
-! based on global code
-
-! number of spectral elements in each block
- integer nspec,npointot
-
-! meshing parameters
- double precision, dimension(:), allocatable :: rns
-
-! auxiliary variables to generate the mesh
- integer ix,iy,ir
-
- double precision xin,etan,rn
- double precision x_current,y_current,z_top,z_bot
-
- double precision, dimension(:,:,:), allocatable :: xgrid,ygrid,zgrid
-
-! parameters needed to store the radii of the grid points
- integer, dimension(:), allocatable :: idoubling
- integer, dimension(:,:,:,:), allocatable :: ibool
-
-! arrays with the mesh in double precision
- double precision, dimension(:,:,:,:), allocatable :: xstore,ystore,zstore
-
-! proc numbers for MPI
- integer myrank,sizeprocs,ier
-
-! check area and volume of the final mesh
- double precision area_local_bottom,area_total_bottom
- double precision area_local_top,area_total_top
- double precision volume_local,volume_total
-
- integer iprocnum,npx,npy
-
-! for loop on all the slices
- integer iproc_xi,iproc_eta
- integer, dimension(:,:), allocatable :: addressing
-
-! use integer array to store topography values
- integer icornerlat,icornerlong,NX_TOPO,NY_TOPO
- double precision lat,long,elevation,ORIG_LAT_TOPO,ORIG_LONG_TOPO,DEGREES_PER_CELL_TOPO
- double precision long_corner,lat_corner,ratio_xi,ratio_eta
- character(len=100) topo_file
- integer, dimension(:,:), allocatable :: itopo_bathy
-
-! use integer array to store Moho depth
- integer imoho_depth(NX_MOHO,NY_MOHO)
-
-! timer MPI
- double precision, external :: wtime
- double precision time_start,tCPU
-
-! addressing for all the slices
- integer, dimension(:), allocatable :: iproc_xi_slice,iproc_eta_slice
-
-! parameters read from parameter file
- integer NER_SEDIM,NER_BASEMENT_SEDIM,NER_16_BASEMENT, &
- NER_MOHO_16,NER_BOTTOM_MOHO,NEX_XI,NEX_ETA, &
- NPROC_XI,NPROC_ETA,NTSTEP_BETWEEN_OUTPUT_SEISMOS,NSTEP,UTM_PROJECTION_ZONE,SIMULATION_TYPE
- integer NSOURCES
-
- double precision UTM_X_MIN,UTM_X_MAX,UTM_Y_MIN,UTM_Y_MAX
- double precision Z_DEPTH_BLOCK,Z_BASEMENT_SURFACE,Z_DEPTH_MOHO
- double precision DT,LATITUDE_MIN,LATITUDE_MAX,LONGITUDE_MIN,LONGITUDE_MAX,HDUR_MOVIE
- double precision THICKNESS_TAPER_BLOCK_HR,THICKNESS_TAPER_BLOCK_MR,VP_MIN_GOCAD,VP_VS_RATIO_GOCAD_TOP,VP_VS_RATIO_GOCAD_BOTTOM
-
- logical HARVARD_3D_GOCAD_MODEL,TOPOGRAPHY,ATTENUATION,USE_OLSEN_ATTENUATION, &
- OCEANS,IMPOSE_MINIMUM_VP_GOCAD,HAUKSSON_REGIONAL_MODEL, &
- BASEMENT_MAP,MOHO_MAP_LUPEI,ABSORBING_CONDITIONS,SAVE_FORWARD
- logical ANISOTROPY,SAVE_MESH_FILES,PRINT_SOURCE_TIME_FUNCTION
-
- logical MOVIE_SURFACE,MOVIE_VOLUME,CREATE_SHAKEMAP,SAVE_DISPLACEMENT, &
- USE_HIGHRES_FOR_MOVIES,SUPPRESS_UTM_PROJECTION,USE_REGULAR_MESH
- integer NTSTEP_BETWEEN_FRAMES,NTSTEP_BETWEEN_OUTPUT_INFO
-
- character(len=150) OUTPUT_FILES,LOCAL_PATH,MODEL
-
-! parameters deduced from parameters read from file
- integer NPROC,NEX_PER_PROC_XI,NEX_PER_PROC_ETA
- integer NER
-
-! this for all the regions
- integer NSPEC_AB,NGLOB_AB,NSPEC2D_A_XI,NSPEC2D_B_XI, &
- NSPEC2D_A_ETA,NSPEC2D_B_ETA, &
- NSPEC2DMAX_XMIN_XMAX,NSPEC2DMAX_YMIN_YMAX, &
- NSPEC2D_BOTTOM,NSPEC2D_TOP, &
- NPOIN2DMAX_XMIN_XMAX,NPOIN2DMAX_YMIN_YMAX
-
- double precision min_elevation,max_elevation
- double precision min_elevation_all,max_elevation_all
-
-! for tapered basement map
- integer icorner_x,icorner_y
- integer iz_basement
- double precision x_corner,y_corner
- double precision z_basement(NX_BASEMENT,NY_BASEMENT)
- character(len=150) BASEMENT_MAP_FILE
-
-! to filter list of stations
- integer irec,nrec,nrec_filtered,ios
- double precision stlat,stlon,stele,stbur
- character(len=MAX_LENGTH_STATION_NAME) station_name
- character(len=MAX_LENGTH_NETWORK_NAME) network_name
- character(len=150) rec_filename,filtered_rec_filename,dummystring
-
-! for Databases of external meshes
- character(len=150) prname
- integer :: dummy_node
- integer :: dummy_elmnt
- integer :: ispec, inode, num_interface, ie
- integer :: nnodes_ext_mesh, nelmnts_ext_mesh
- integer :: ninterface_ext_mesh
- integer :: max_interface_size_ext_mesh
- integer, dimension(:), allocatable :: my_neighbours_ext_mesh
- integer, dimension(:), allocatable :: my_nelmnts_neighbours_ext_mesh
- integer, dimension(:,:,:), allocatable :: my_interfaces_ext_mesh
- integer, dimension(:,:), allocatable :: ibool_interfaces_ext_mesh
- integer, dimension(:), allocatable :: nibool_interfaces_ext_mesh
- double precision, dimension(:,:), allocatable :: nodes_coords_ext_mesh
- integer, dimension(:,:), allocatable :: elmnts_ext_mesh
- integer, dimension(:), allocatable :: mat_ext_mesh
-
-! ************** PROGRAM STARTS HERE **************
-
-! sizeprocs returns number of processes started (should be equal to NPROC).
-! myrank is the rank of each process, between 0 and NPROC-1.
-! as usual in MPI, process 0 is in charge of coordinating everything
-! and also takes care of the main output
- call world_size(sizeprocs)
- call world_rank(myrank)
-
-! get the base pathname for output files
- call get_value_string(OUTPUT_FILES, 'OUTPUT_FILES', 'OUTPUT_FILES')
-
-! open main output file, only written to by process 0
- if(myrank == 0 .and. IMAIN /= ISTANDARD_OUTPUT) &
- open(unit=IMAIN,file=trim(OUTPUT_FILES)//'/output_mesher.txt',status='unknown')
-
-! get MPI starting time
- time_start = wtime()
-
- if(myrank == 0) then
- write(IMAIN,*)
- write(IMAIN,*) '******************************************'
- write(IMAIN,*) '*** Specfem3D MPI Mesher - f90 version ***'
- write(IMAIN,*) '******************************************'
- write(IMAIN,*)
- endif
-
-! read the parameter file
- call read_parameter_file(LATITUDE_MIN,LATITUDE_MAX,LONGITUDE_MIN,LONGITUDE_MAX, &
- UTM_X_MIN,UTM_X_MAX,UTM_Y_MIN,UTM_Y_MAX,Z_DEPTH_BLOCK, &
- NER_SEDIM,NER_BASEMENT_SEDIM,NER_16_BASEMENT,NER_MOHO_16,NER_BOTTOM_MOHO, &
- NEX_XI,NEX_ETA,NPROC_XI,NPROC_ETA,NTSTEP_BETWEEN_OUTPUT_SEISMOS,NSTEP,UTM_PROJECTION_ZONE,DT, &
- ATTENUATION,USE_OLSEN_ATTENUATION,HARVARD_3D_GOCAD_MODEL,TOPOGRAPHY,LOCAL_PATH,NSOURCES, &
- THICKNESS_TAPER_BLOCK_HR,THICKNESS_TAPER_BLOCK_MR,VP_MIN_GOCAD,VP_VS_RATIO_GOCAD_TOP,VP_VS_RATIO_GOCAD_BOTTOM, &
- OCEANS,IMPOSE_MINIMUM_VP_GOCAD,HAUKSSON_REGIONAL_MODEL,ANISOTROPY, &
- BASEMENT_MAP,MOHO_MAP_LUPEI,ABSORBING_CONDITIONS, &
- MOVIE_SURFACE,MOVIE_VOLUME,CREATE_SHAKEMAP,SAVE_DISPLACEMENT, &
- NTSTEP_BETWEEN_FRAMES,USE_HIGHRES_FOR_MOVIES,HDUR_MOVIE, &
- SAVE_MESH_FILES,PRINT_SOURCE_TIME_FUNCTION, &
- NTSTEP_BETWEEN_OUTPUT_INFO,SUPPRESS_UTM_PROJECTION,MODEL,USE_REGULAR_MESH,SIMULATION_TYPE,SAVE_FORWARD)
-
- if (sizeprocs == 1 .and. (NPROC_XI /= 1 .or. NPROC_ETA /= 1)) then
- stop 'must have NPROC_XI = NPROC_ETA = 1 for a serial run'
- endif
-
-! compute other parameters based upon values read
- call compute_parameters(NER,NEX_XI,NEX_ETA,NPROC_XI,NPROC_ETA, &
- NPROC,NEX_PER_PROC_XI,NEX_PER_PROC_ETA, &
- NER_BOTTOM_MOHO,NER_MOHO_16,NER_16_BASEMENT,NER_BASEMENT_SEDIM,NER_SEDIM, &
- NSPEC_AB,NSPEC2D_A_XI,NSPEC2D_B_XI, &
- NSPEC2D_A_ETA,NSPEC2D_B_ETA, &
- NSPEC2DMAX_XMIN_XMAX,NSPEC2DMAX_YMIN_YMAX,NSPEC2D_BOTTOM,NSPEC2D_TOP, &
- NPOIN2DMAX_XMIN_XMAX,NPOIN2DMAX_YMIN_YMAX,NGLOB_AB,USE_REGULAR_MESH)
-
-! info about external mesh simulation
-! nlegoff -- should be put in compute_parameters and read_parameter_file for clarity
- if (USE_EXTERNAL_MESH) then
- NPROC = sizeprocs
- endif
-
-! check that the code is running with the requested nb of processes
- if(sizeprocs /= NPROC) call exit_MPI(myrank,'wrong number of MPI processes')
-
- if (.not. USE_EXTERNAL_MESH) then
-! dynamic allocation of mesh arrays
- allocate(rns(0:2*NER))
-
- allocate(xgrid(0:2*NER,0:2*NEX_PER_PROC_XI,0:2*NEX_PER_PROC_ETA))
- allocate(ygrid(0:2*NER,0:2*NEX_PER_PROC_XI,0:2*NEX_PER_PROC_ETA))
- allocate(zgrid(0:2*NER,0:2*NEX_PER_PROC_XI,0:2*NEX_PER_PROC_ETA))
-
- allocate(addressing(0:NPROC_XI-1,0:NPROC_ETA-1))
- allocate(iproc_xi_slice(0:NPROC-1))
- allocate(iproc_eta_slice(0:NPROC-1))
-
-! clear arrays
- xgrid(:,:,:) = 0.
- ygrid(:,:,:) = 0.
- zgrid(:,:,:) = 0.
-
- iproc_xi_slice(:) = 0
- iproc_eta_slice(:) = 0
-
-! create global slice addressing for solver
- if(myrank == 0) then
- open(unit=IOUT,file=trim(OUTPUT_FILES)//'/addressing.txt',status='unknown')
- write(IMAIN,*) 'creating global slice addressing'
- write(IMAIN,*)
- endif
- do iproc_eta=0,NPROC_ETA-1
- do iproc_xi=0,NPROC_XI-1
- iprocnum = iproc_eta * NPROC_XI + iproc_xi
- iproc_xi_slice(iprocnum) = iproc_xi
- iproc_eta_slice(iprocnum) = iproc_eta
- addressing(iproc_xi,iproc_eta) = iprocnum
- if(myrank == 0) write(IOUT,*) iprocnum,iproc_xi,iproc_eta
- enddo
- enddo
- if(myrank == 0) close(IOUT)
-
- if (myrank == 0) then
- write(IMAIN,*) 'Spatial distribution of slice numbers:'
- do iproc_eta = NPROC_ETA-1, 0, -1
- do iproc_xi = 0, NPROC_XI-1, 1
- write(IMAIN,'(i5)',advance='no') addressing(iproc_xi,iproc_eta)
- enddo
- write(IMAIN,'(a1)',advance='yes') ' '
- enddo
- endif
-
- endif ! end of (.not. USE_EXTERNAL_MESH)
-
- if(myrank == 0) then
- write(IMAIN,*) 'This is process ',myrank
- write(IMAIN,*) 'There are ',sizeprocs,' MPI processes'
- write(IMAIN,*) 'Processes are numbered from 0 to ',sizeprocs-1
- write(IMAIN,*)
- write(IMAIN,*) 'There are ',NEX_XI,' elements along xi'
- write(IMAIN,*) 'There are ',NEX_ETA,' elements along eta'
- write(IMAIN,*)
- write(IMAIN,*) 'There are ',NPROC_XI,' slices along xi'
- write(IMAIN,*) 'There are ',NPROC_ETA,' slices along eta'
- write(IMAIN,*) 'There is a total of ',NPROC,' slices'
- write(IMAIN,*)
- write(IMAIN,*) 'NGLLX = ',NGLLX
- write(IMAIN,*) 'NGLLY = ',NGLLY
- write(IMAIN,*) 'NGLLZ = ',NGLLZ
-
- write(IMAIN,*)
- write(IMAIN,*) 'Shape functions defined by NGNOD = ',NGNOD,' control nodes'
- write(IMAIN,*) 'Surface shape functions defined by NGNOD2D = ',NGNOD2D,' control nodes'
- write(IMAIN,*)
- endif
-
-! check that reals are either 4 or 8 bytes
- if(CUSTOM_REAL /= SIZE_REAL .and. CUSTOM_REAL /= SIZE_DOUBLE) call exit_MPI(myrank,'wrong size of CUSTOM_REAL for reals')
-
- if(NGNOD /= 8) call exit_MPI(myrank,'number of control nodes must be 8')
- if(NGNOD2D /= 4) call exit_MPI(myrank,'elements with 8 points should have NGNOD2D = 4')
-
-! for the number of standard linear solids for attenuation
- if(N_SLS /= 3) call exit_MPI(myrank,'number of SLS must be 3')
-
- if (.not. USE_EXTERNAL_MESH) then
-! check that Poisson's ratio in Gocad block is fine
- if(VP_VS_RATIO_GOCAD_TOP < sqrt(2.) .or. VP_VS_RATIO_GOCAD_BOTTOM < sqrt(2.))&
- call exit_MPI(myrank,'vp/vs ratio in Gocad block is too small')
-
-! check that number of slices is at least 1 in each direction
- if(NPROC_XI < 1) call exit_MPI(myrank,'NPROC_XI must be greater than 1')
- if(NPROC_ETA < 1) call exit_MPI(myrank,'NPROC_ETA must be greater than 1')
-
-! check that mesh can be cut into the right number of slices
-! also check that mesh can be coarsened in depth twice (block size multiple of 8)
- if(USE_REGULAR_MESH) then
- if(mod(NEX_XI,NPROC_XI) /= 0) call exit_MPI(myrank,'NEX_XI must be a multiple of NPROC_XI for a regular mesh')
- if(mod(NEX_ETA,NPROC_ETA) /= 0) call exit_MPI(myrank,'NEX_ETA must be a multiple of NPROC_ETA for a regular mesh')
- else
- if(mod(NEX_XI,8) /= 0) call exit_MPI(myrank,'NEX_XI must be a multiple of 8 for a non-regular mesh')
- if(mod(NEX_ETA,8) /= 0) call exit_MPI(myrank,'NEX_ETA must be a multiple of 8 for a non-regular mesh')
-
- if(mod(NEX_XI/8,NPROC_XI) /= 0) call exit_MPI(myrank,'NEX_XI must be a multiple of 8*NPROC_XI for a non-regular mesh')
- if(mod(NEX_ETA/8,NPROC_ETA) /= 0) call exit_MPI(myrank,'NEX_ETA must be a multiple of 8*NPROC_ETA for a non-regular mesh')
- endif
-
- endif ! end of (.not. USE_EXTERNAL_MESH)
-
- if(myrank == 0) then
-
- write(IMAIN,*) 'region selected:'
- write(IMAIN,*)
- write(IMAIN,*) 'latitude min = ',LATITUDE_MIN
- write(IMAIN,*) 'latitude max = ',LATITUDE_MAX
- write(IMAIN,*)
- write(IMAIN,*) 'longitude min = ',LONGITUDE_MIN
- write(IMAIN,*) 'longitude max = ',LONGITUDE_MAX
- write(IMAIN,*)
- write(IMAIN,*) 'this is mapped to UTM in region ',UTM_PROJECTION_ZONE
- write(IMAIN,*)
- write(IMAIN,*) 'UTM X min = ',UTM_X_MIN
- write(IMAIN,*) 'UTM X max = ',UTM_X_MAX
- write(IMAIN,*)
- write(IMAIN,*) 'UTM Y min = ',UTM_Y_MIN
- write(IMAIN,*) 'UTM Y max = ',UTM_Y_MAX
- write(IMAIN,*)
- write(IMAIN,*) 'UTM size of model along X is ',(UTM_X_MAX-UTM_X_MIN)/1000.,' km'
- write(IMAIN,*) 'UTM size of model along Y is ',(UTM_Y_MAX-UTM_Y_MIN)/1000.,' km'
- write(IMAIN,*)
- write(IMAIN,*) 'Bottom of the mesh is at a depth of ',dabs(Z_DEPTH_BLOCK)/1000.,' km'
- write(IMAIN,*)
-
-
- write(IMAIN,*)
- if(TOPOGRAPHY) then
- write(IMAIN,*) 'incorporating surface topography'
- else
- write(IMAIN,*) 'no surface topography'
- endif
-
- write(IMAIN,*)
- if(SUPPRESS_UTM_PROJECTION) then
- write(IMAIN,*) 'suppressing UTM projection'
- else
- write(IMAIN,*) 'using UTM projection in region ',UTM_PROJECTION_ZONE
- endif
-
- write(IMAIN,*)
- if(HARVARD_3D_GOCAD_MODEL) then
- write(IMAIN,*) 'incorporating 3-D lateral variations'
- else
- write(IMAIN,*) 'no 3-D lateral variations'
- endif
-
- write(IMAIN,*)
- if(ATTENUATION) then
- write(IMAIN,*) 'incorporating attenuation using ',N_SLS,' standard linear solids'
- if(USE_OLSEN_ATTENUATION) then
- write(IMAIN,*) 'using Olsen''s attenuation'
- else
- write(IMAIN,*) 'not using Olsen''s attenuation'
- endif
- else
- write(IMAIN,*) 'no attenuation'
- endif
-
- write(IMAIN,*)
- if(OCEANS) then
- write(IMAIN,*) 'incorporating the oceans using equivalent load'
- else
- write(IMAIN,*) 'no oceans'
- endif
-
- write(IMAIN,*)
-
- endif
-
-! read topography and bathymetry file
- if(TOPOGRAPHY .or. OCEANS) then
-
-! for Southern California
- NX_TOPO = NX_TOPO_SOCAL
- NY_TOPO = NY_TOPO_SOCAL
- ORIG_LAT_TOPO = ORIG_LAT_TOPO_SOCAL
- ORIG_LONG_TOPO = ORIG_LONG_TOPO_SOCAL
- DEGREES_PER_CELL_TOPO = DEGREES_PER_CELL_TOPO_SOCAL
- topo_file = TOPO_FILE_SOCAL
-
- allocate(itopo_bathy(NX_TOPO,NY_TOPO))
-
- call read_topo_bathy_file(itopo_bathy,NX_TOPO,NY_TOPO,topo_file)
-
- if(myrank == 0) then
- write(IMAIN,*)
- write(IMAIN,*) 'regional topography file read ranges in m from ',minval(itopo_bathy),' to ',maxval(itopo_bathy)
- write(IMAIN,*)
- endif
-
- endif
-
-! read Moho map
- if(MOHO_MAP_LUPEI) then
- call read_moho_map(imoho_depth)
- if(myrank == 0) then
- write(IMAIN,*)
- write(IMAIN,*) 'regional Moho depth read ranges in m from ',minval(imoho_depth),' to ',maxval(imoho_depth)
- write(IMAIN,*)
- endif
- endif
-
-! read basement map
- if(BASEMENT_MAP) then
- call get_value_string(BASEMENT_MAP_FILE,'model.BASEMENT_MAP_FILE','DATA/la_basement/reggridbase2_filtered_ascii.dat')
- open(unit=55,file=BASEMENT_MAP_FILE,status='old',action='read')
- do ix=1,NX_BASEMENT
- do iy=1,NY_BASEMENT
- read(55,*) iz_basement
- z_basement(ix,iy) = dble(iz_basement)
- enddo
- enddo
- close(55)
- endif
-
- if (.not. USE_EXTERNAL_MESH) then
-
-! get addressing for this process
- iproc_xi = iproc_xi_slice(myrank)
- iproc_eta = iproc_eta_slice(myrank)
-
-! number of elements in each slice
- npx = 2*NEX_PER_PROC_XI
- npy = 2*NEX_PER_PROC_ETA
-
- min_elevation = +HUGEVAL
- max_elevation = -HUGEVAL
-
-! fill the region between the cutoff depth and the free surface
- do iy=0,npy
- do ix=0,npx
-
-! define the mesh points on the top and the bottom
-
- xin=dble(ix)/dble(npx)
- x_current = UTM_X_MIN + (dble(iproc_xi)+xin)*(UTM_X_MAX-UTM_X_MIN)/dble(NPROC_XI)
-
- etan=dble(iy)/dble(npy)
- y_current = UTM_Y_MIN + (dble(iproc_eta)+etan)*(UTM_Y_MAX-UTM_Y_MIN)/dble(NPROC_ETA)
-
-! define model between topography surface and fictitious bottom
- if(TOPOGRAPHY) then
-
-! project x and y in UTM back to long/lat since topo file is in long/lat
- call utm_geo(long,lat,x_current,y_current,UTM_PROJECTION_ZONE,IUTM2LONGLAT,SUPPRESS_UTM_PROJECTION)
-
-! get coordinate of corner in bathy/topo model
- icornerlong = int((long - ORIG_LONG_TOPO) / DEGREES_PER_CELL_TOPO) + 1
- icornerlat = int((lat - ORIG_LAT_TOPO) / DEGREES_PER_CELL_TOPO) + 1
-
-! avoid edge effects and extend with identical point if outside model
- if(icornerlong < 1) icornerlong = 1
- if(icornerlong > NX_TOPO-1) icornerlong = NX_TOPO-1
- if(icornerlat < 1) icornerlat = 1
- if(icornerlat > NY_TOPO-1) icornerlat = NY_TOPO-1
-
-! compute coordinates of corner
- long_corner = ORIG_LONG_TOPO + (icornerlong-1)*DEGREES_PER_CELL_TOPO
- lat_corner = ORIG_LAT_TOPO + (icornerlat-1)*DEGREES_PER_CELL_TOPO
-
-! compute ratio for interpolation
- ratio_xi = (long - long_corner) / DEGREES_PER_CELL_TOPO
- ratio_eta = (lat - lat_corner) / DEGREES_PER_CELL_TOPO
-
-! avoid edge effects
- if(ratio_xi < 0.) ratio_xi = 0.
- if(ratio_xi > 1.) ratio_xi = 1.
- if(ratio_eta < 0.) ratio_eta = 0.
- if(ratio_eta > 1.) ratio_eta = 1.
-
-! interpolate elevation at current point
- elevation = &
- itopo_bathy(icornerlong,icornerlat)*(1.-ratio_xi)*(1.-ratio_eta) + &
- itopo_bathy(icornerlong+1,icornerlat)*ratio_xi*(1.-ratio_eta) + &
- itopo_bathy(icornerlong+1,icornerlat+1)*ratio_xi*ratio_eta + &
- itopo_bathy(icornerlong,icornerlat+1)*(1.-ratio_xi)*ratio_eta
-
- else
-
- elevation = 0.d0
-
- endif
-
- z_top = Z_SURFACE + elevation
- z_bot = - dabs(Z_DEPTH_BLOCK)
-
-! compute global min and max of elevation
- min_elevation = dmin1(min_elevation,elevation)
- max_elevation = dmax1(max_elevation,elevation)
-
-! create vertical point distribution at current horizontal point
- if(BASEMENT_MAP) then
-
-! get coordinate of corner in bathy/topo model
- icorner_x = int((x_current - ORIG_X_BASEMENT) / SPACING_X_BASEMENT) + 1
- icorner_y = int((y_current - ORIG_Y_BASEMENT) / SPACING_Y_BASEMENT) + 1
-
-! avoid edge effects and extend with identical point if outside model
- if(icorner_x < 1) icorner_x = 1
- if(icorner_x > NX_BASEMENT-1) icorner_x = NX_BASEMENT-1
- if(icorner_y < 1) icorner_y = 1
- if(icorner_y > NY_BASEMENT-1) icorner_y = NY_BASEMENT-1
-
-! compute coordinates of corner
- x_corner = ORIG_X_BASEMENT + (icorner_x-1)*SPACING_X_BASEMENT
- y_corner = ORIG_Y_BASEMENT + (icorner_y-1)*SPACING_Y_BASEMENT
-
-! compute ratio for interpolation
- ratio_xi = (x_current - x_corner) / SPACING_X_BASEMENT
- ratio_eta = (y_current - y_corner) / SPACING_Y_BASEMENT
-
-! avoid edge effects
- if(ratio_xi < 0.) ratio_xi = 0.
- if(ratio_xi > 1.) ratio_xi = 1.
- if(ratio_eta < 0.) ratio_eta = 0.
- if(ratio_eta > 1.) ratio_eta = 1.
-
-! interpolate basement surface at current point
- Z_BASEMENT_SURFACE = &
- z_basement(icorner_x,icorner_y)*(1.-ratio_xi)*(1.-ratio_eta) + &
- z_basement(icorner_x+1,icorner_y)*ratio_xi*(1.-ratio_eta) + &
- z_basement(icorner_x+1,icorner_y+1)*ratio_xi*ratio_eta + &
- z_basement(icorner_x,icorner_y+1)*(1.-ratio_xi)*ratio_eta
-
- else
- Z_BASEMENT_SURFACE = DEPTH_5p5km_SOCAL
- endif
-
-! honor Lupei Zhu's Moho map
- if(MOHO_MAP_LUPEI) then
-
-! project x and y in UTM back to long/lat since topo file is in long/lat
- call utm_geo(long,lat,x_current,y_current,UTM_PROJECTION_ZONE,IUTM2LONGLAT,SUPPRESS_UTM_PROJECTION)
-
-! get coordinate of corner in Moho map
- icornerlong = int((long - ORIG_LONG_MOHO) / DEGREES_PER_CELL_MOHO) + 1
- icornerlat = int((lat - ORIG_LAT_MOHO) / DEGREES_PER_CELL_MOHO) + 1
-
-! avoid edge effects and extend with identical point if outside model
- if(icornerlong < 1) icornerlong = 1
- if(icornerlong > NX_MOHO-1) icornerlong = NX_MOHO-1
- if(icornerlat < 1) icornerlat = 1
- if(icornerlat > NY_MOHO-1) icornerlat = NY_MOHO-1
-
-! compute coordinates of corner
- long_corner = ORIG_LONG_MOHO + (icornerlong-1)*DEGREES_PER_CELL_MOHO
- lat_corner = ORIG_LAT_MOHO + (icornerlat-1)*DEGREES_PER_CELL_MOHO
-
-! compute ratio for interpolation
- ratio_xi = (long - long_corner) / DEGREES_PER_CELL_MOHO
- ratio_eta = (lat - lat_corner) / DEGREES_PER_CELL_MOHO
-
-! avoid edge effects
- if(ratio_xi < 0.) ratio_xi = 0.
- if(ratio_xi > 1.) ratio_xi = 1.
- if(ratio_eta < 0.) ratio_eta = 0.
- if(ratio_eta > 1.) ratio_eta = 1.
-
-! interpolate Moho depth at current point
- Z_DEPTH_MOHO = &
- - (imoho_depth(icornerlong,icornerlat)*(1.-ratio_xi)*(1.-ratio_eta) + &
- imoho_depth(icornerlong+1,icornerlat)*ratio_xi*(1.-ratio_eta) + &
- imoho_depth(icornerlong+1,icornerlat+1)*ratio_xi*ratio_eta + &
- imoho_depth(icornerlong,icornerlat+1)*(1.-ratio_xi)*ratio_eta)
-
- else
- Z_DEPTH_MOHO = DEPTH_MOHO_SOCAL
- endif
-
-! define vertical spacing of the mesh in case of a non-regular mesh with mesh doublings
- if(.not. USE_REGULAR_MESH) call mesh_vertical(myrank,rns,NER,NER_BOTTOM_MOHO,NER_MOHO_16, &
- NER_16_BASEMENT,NER_BASEMENT_SEDIM,NER_SEDIM, &
-!! DK DK UGLY modif z_top by Emmanuel Chaljub here
-!! DK DK UGLY modif Manu removed z_top, &
- Z_DEPTH_BLOCK,Z_BASEMENT_SURFACE,Z_DEPTH_MOHO,MOHO_MAP_LUPEI)
-
-! fill the volume
- do ir = 0,2*NER
- if(USE_REGULAR_MESH) then
- rn = dble(ir) / dble(2*NER)
- else
- rn = rns(ir)
- endif
- xgrid(ir,ix,iy) = x_current
- ygrid(ir,ix,iy) = y_current
- zgrid(ir,ix,iy) = z_bot*(ONE-rn) + z_top*rn
- enddo
-
- enddo
- enddo
-
- endif ! end of (.not. USE_EXTERNAL_MESH)
-
- if(myrank == 0) then
- write(IMAIN,*)
- write(IMAIN,*) '**************************'
- write(IMAIN,*) 'creating mesh in the model'
- write(IMAIN,*) '**************************'
- write(IMAIN,*)
- endif
-
-! volume of bottom and top area of the slice
- volume_local = ZERO
- area_local_bottom = ZERO
- area_local_top = ZERO
-
-! read databases about external mesh simulation
-! nlegoff --
- if (USE_EXTERNAL_MESH) then
- call create_name_database(prname,myrank,LOCAL_PATH)
- open(unit=IIN,file=prname(1:len_trim(prname))//'Database',status='old',action='read',form='formatted')
- read(IIN,*) nnodes_ext_mesh
- allocate(nodes_coords_ext_mesh(NDIM,nnodes_ext_mesh))
- do inode = 1, nnodes_ext_mesh
- read(IIN,*) dummy_node, nodes_coords_ext_mesh(1,inode), nodes_coords_ext_mesh(2,inode), nodes_coords_ext_mesh(3,inode)
- enddo
-
- read(IIN,*) nelmnts_ext_mesh
- allocate(elmnts_ext_mesh(esize,nelmnts_ext_mesh))
- allocate(mat_ext_mesh(nelmnts_ext_mesh))
- do ispec = 1, nelmnts_ext_mesh
- read(IIN,*) dummy_elmnt, mat_ext_mesh(ispec), &
- elmnts_ext_mesh(1,ispec), elmnts_ext_mesh(2,ispec), elmnts_ext_mesh(3,ispec), elmnts_ext_mesh(4,ispec), &
- elmnts_ext_mesh(5,ispec), elmnts_ext_mesh(6,ispec), elmnts_ext_mesh(7,ispec), elmnts_ext_mesh(8,ispec)
- enddo
- NSPEC_AB = nelmnts_ext_mesh
-
- read(IIN,*) ninterface_ext_mesh, max_interface_size_ext_mesh
- allocate(my_neighbours_ext_mesh(ninterface_ext_mesh))
- allocate(my_nelmnts_neighbours_ext_mesh(ninterface_ext_mesh))
- allocate(my_interfaces_ext_mesh(6,max_interface_size_ext_mesh,ninterface_ext_mesh))
- allocate(ibool_interfaces_ext_mesh(NGLLX*NGLLX*max_interface_size_ext_mesh,ninterface_ext_mesh))
- allocate(nibool_interfaces_ext_mesh(ninterface_ext_mesh))
- do num_interface = 1, ninterface_ext_mesh
- read(IIN,*) my_neighbours_ext_mesh(num_interface), my_nelmnts_neighbours_ext_mesh(num_interface)
- do ie = 1, my_nelmnts_neighbours_ext_mesh(num_interface)
- read(IIN,*) my_interfaces_ext_mesh(1,ie,num_interface), my_interfaces_ext_mesh(2,ie,num_interface), &
- my_interfaces_ext_mesh(3,ie,num_interface), my_interfaces_ext_mesh(4,ie,num_interface), &
- my_interfaces_ext_mesh(5,ie,num_interface), my_interfaces_ext_mesh(6,ie,num_interface)
- enddo
- enddo
-
- close(IIN)
-
- endif
-
-! assign theoretical number of elements
- nspec = NSPEC_AB
-
-! compute maximum number of points
- npointot = nspec * NGLLCUBE
-
-! make sure everybody is synchronized
- call sync_all()
-
-! use dynamic allocation to allocate memory for arrays
- allocate(idoubling(nspec))
- allocate(ibool(NGLLX,NGLLY,NGLLZ,nspec))
- allocate(xstore(NGLLX,NGLLY,NGLLZ,nspec))
- allocate(ystore(NGLLX,NGLLY,NGLLZ,nspec))
- allocate(zstore(NGLLX,NGLLY,NGLLZ,nspec),stat=ier)
-
-! exit if there is not enough memory to allocate all the arrays
- if(ier /= 0) call exit_MPI(myrank,'not enough memory to allocate arrays')
-
-! create all the regions of the mesh
- if (USE_EXTERNAL_MESH) then
- call create_regions_mesh_ext_mesh(ibool, &
- xstore,ystore,zstore,nspec, &
- npointot,myrank,LOCAL_PATH, &
- nnodes_ext_mesh,nelmnts_ext_mesh, &
- nodes_coords_ext_mesh,elmnts_ext_mesh,mat_ext_mesh, &
- ninterface_ext_mesh,max_interface_size_ext_mesh, &
- my_neighbours_ext_mesh,my_nelmnts_neighbours_ext_mesh,my_interfaces_ext_mesh, &
- ibool_interfaces_ext_mesh,nibool_interfaces_ext_mesh)
-
- else
- call create_regions_mesh(xgrid,ygrid,zgrid,ibool,idoubling, &
- xstore,ystore,zstore,npx,npy, &
- iproc_xi,iproc_eta,nspec, &
- volume_local,area_local_bottom,area_local_top, &
- NGLOB_AB,npointot, &
- NER_BOTTOM_MOHO,NER_MOHO_16,NER_16_BASEMENT,NER_BASEMENT_SEDIM,NER_SEDIM,NER, &
- NEX_PER_PROC_XI,NEX_PER_PROC_ETA, &
- NSPEC2DMAX_XMIN_XMAX, &
- NSPEC2DMAX_YMIN_YMAX,NSPEC2D_BOTTOM,NSPEC2D_TOP, &
- HARVARD_3D_GOCAD_MODEL,NPROC_XI,NPROC_ETA,NSPEC2D_A_XI,NSPEC2D_B_XI, &
- NSPEC2D_A_ETA,NSPEC2D_B_ETA,myrank,LOCAL_PATH, &
- UTM_X_MIN,UTM_X_MAX,UTM_Y_MIN,UTM_Y_MAX,Z_DEPTH_BLOCK,UTM_PROJECTION_ZONE, &
- HAUKSSON_REGIONAL_MODEL,OCEANS, &
- VP_MIN_GOCAD,VP_VS_RATIO_GOCAD_TOP,VP_VS_RATIO_GOCAD_BOTTOM, &
- IMPOSE_MINIMUM_VP_GOCAD,THICKNESS_TAPER_BLOCK_HR,THICKNESS_TAPER_BLOCK_MR,MOHO_MAP_LUPEI, &
- ANISOTROPY,SAVE_MESH_FILES,SUPPRESS_UTM_PROJECTION, &
- ORIG_LAT_TOPO,ORIG_LONG_TOPO,DEGREES_PER_CELL_TOPO,NX_TOPO,NY_TOPO,USE_REGULAR_MESH)
- endif
-! print min and max of topography included
- if(TOPOGRAPHY) then
-
-! compute the maximum of the maxima for all the slices using an MPI reduction
- call min_all_dp(min_elevation,min_elevation_all)
- call max_all_dp(max_elevation,max_elevation_all)
-
- if(myrank == 0) then
- write(IMAIN,*)
- write(IMAIN,*) 'min and max of topography included in mesh in m is ',min_elevation_all,' ',max_elevation_all
- write(IMAIN,*)
- endif
- endif
-
-
-! use MPI reduction to compute total area and volume
- area_total_bottom = ZERO
- area_total_top = ZERO
- call sum_all_dp(area_local_bottom,area_total_bottom)
- call sum_all_dp(area_local_top,area_total_top)
- call sum_all_dp(volume_local,volume_total)
-
- if(myrank == 0) then
-
-! check volume, and bottom and top area
-
- write(IMAIN,*)
- write(IMAIN,*) ' calculated top area: ',area_total_top
-
-! compare to exact theoretical value
- if(.not. TOPOGRAPHY) &
- write(IMAIN,*) ' exact area: ',(UTM_Y_MAX-UTM_Y_MIN)*(UTM_X_MAX-UTM_X_MIN)
-
- write(IMAIN,*)
- write(IMAIN,*) 'calculated bottom area: ',area_total_bottom
-
-! compare to exact theoretical value (bottom is always flat)
- write(IMAIN,*) ' exact area: ',(UTM_Y_MAX-UTM_Y_MIN)*(UTM_X_MAX-UTM_X_MIN)
-
- endif
-
-! make sure everybody is synchronized
- call sync_all()
-
- if(myrank == 0) then
-! check volume
- write(IMAIN,*)
- write(IMAIN,*) 'calculated volume: ',volume_total
-! take the central cube into account
- if(.not. TOPOGRAPHY) &
- write(IMAIN,*) ' exact volume: ', &
- (UTM_Y_MAX-UTM_Y_MIN)*(UTM_X_MAX-UTM_X_MIN)*dabs(Z_DEPTH_BLOCK)
-
- endif
-
-!--- print number of points and elements in the mesh
-
- if(myrank == 0) then
-
- write(IMAIN,*)
- write(IMAIN,*) 'Repartition of elements:'
- write(IMAIN,*) '-----------------------'
- write(IMAIN,*)
- write(IMAIN,*) 'total number of elements in each slice: ',NSPEC_AB
- write(IMAIN,*)
- write(IMAIN,*) 'total number of points in each slice: ',NGLOB_AB
-
- write(IMAIN,*)
- write(IMAIN,*) 'total number of elements in entire mesh: ',NSPEC_AB*NPROC
- write(IMAIN,*) 'total number of points in entire mesh: ',NGLOB_AB*NPROC
- write(IMAIN,*) 'total number of DOFs in entire mesh: ',NGLOB_AB*NPROC*NDIM
- write(IMAIN,*)
- write(IMAIN,*) 'total number of time steps in the solver will be: ',NSTEP
- write(IMAIN,*)
-
-! write information about precision used for floating-point operations
- if(CUSTOM_REAL == SIZE_REAL) then
- write(IMAIN,*) 'using single precision for the calculations'
- else
- write(IMAIN,*) 'using double precision for the calculations'
- endif
- write(IMAIN,*)
- write(IMAIN,*) 'smallest and largest possible floating-point numbers are: ',tiny(1._CUSTOM_REAL),huge(1._CUSTOM_REAL)
- write(IMAIN,*)
-
-! copy number of elements and points in an include file for the solver
- call save_header_file(NSPEC_AB,NGLOB_AB,NEX_XI,NEX_ETA,NPROC,NPROC_XI,NPROC_ETA, &
- UTM_X_MIN,UTM_X_MAX,UTM_Y_MIN,UTM_Y_MAX,ATTENUATION,ANISOTROPY,NSTEP, &
- NSPEC2DMAX_XMIN_XMAX,NSPEC2DMAX_YMIN_YMAX,NSPEC2D_BOTTOM,NSPEC2D_TOP, &
- NPOIN2DMAX_XMIN_XMAX,NPOIN2DMAX_YMIN_YMAX,SIMULATION_TYPE)
-
- call get_value_string(rec_filename, 'solver.STATIONS', 'DATA/STATIONS')
- call get_value_string(filtered_rec_filename, 'solver.STATIONS_FILTERED', 'DATA/STATIONS_FILTERED')
-
-! get total number of stations
- open(unit=IIN,file=rec_filename,iostat=ios,status='old',action='read')
- nrec = 0
- do while(ios == 0)
- read(IIN,"(a)",iostat=ios) dummystring
- if(ios == 0) nrec = nrec + 1
- enddo
- close(IIN)
-
-! filter list of stations, only retain stations that are in the model
- nrec_filtered = 0
- open(unit=IIN,file=rec_filename,status='old',action='read')
- do irec = 1,nrec
- read(IIN,*) station_name,network_name,stlat,stlon,stele,stbur
- if((stlat >= LATITUDE_MIN .and. stlat <= LATITUDE_MAX .and. stlon >= LONGITUDE_MIN .and. stlon <= LONGITUDE_MAX) &
- .or. USE_EXTERNAL_MESH) &
- nrec_filtered = nrec_filtered + 1
- enddo
- close(IIN)
-
- write(IMAIN,*)
- write(IMAIN,*) 'there are ',nrec,' stations in file ', trim(rec_filename)
- write(IMAIN,*) 'saving ',nrec_filtered,' stations inside the model in file ', trim(filtered_rec_filename)
- write(IMAIN,*) 'excluding ',nrec - nrec_filtered,' stations located outside the model'
- write(IMAIN,*)
-
- if(nrec_filtered < 1) call exit_MPI(myrank,'need at least one station in the model')
-
- open(unit=IIN,file=rec_filename,status='old',action='read')
- open(unit=IOUT,file=filtered_rec_filename,status='unknown')
-
- do irec = 1,nrec
- read(IIN,*) station_name,network_name,stlat,stlon,stele,stbur
- if((stlat >= LATITUDE_MIN .and. stlat <= LATITUDE_MAX .and. stlon >= LONGITUDE_MIN .and. stlon <= LONGITUDE_MAX) &
- .or. USE_EXTERNAL_MESH) &
- write(IOUT,*) station_name(1:len_trim(station_name)),' ',network_name(1:len_trim(network_name)),' ', &
- sngl(stlat),' ',sngl(stlon), ' ', sngl(stele), ' ', sngl(stbur)
- enddo
-
- close(IIN)
- close(IOUT)
-
- endif ! end of section executed by main process only
-
-! elapsed time since beginning of mesh generation
- if(myrank == 0) then
- tCPU = wtime() - time_start
- write(IMAIN,*)
- write(IMAIN,*) 'Elapsed time for mesh generation and buffer creation in seconds = ',tCPU
- write(IMAIN,*) 'End of mesh generation'
- write(IMAIN,*)
- endif
-
-! close main output file
- if(myrank == 0) then
- write(IMAIN,*) 'done'
- write(IMAIN,*)
- close(IMAIN)
- endif
-
-! synchronize all the processes to make sure everybody has finished
- call sync_all()
-
- end subroutine meshfem3D
-
Deleted: seismo/3D/SPECFEM3D_SESAME/trunk/misc.c
===================================================================
--- seismo/3D/SPECFEM3D_SESAME/trunk/misc.c 2009-03-12 16:31:24 UTC (rev 14300)
+++ seismo/3D/SPECFEM3D_SESAME/trunk/misc.c 2009-03-12 17:37:00 UTC (rev 14301)
@@ -1,11 +0,0 @@
-
-#include <Python.h>
-#include "config.h"
-
-/* called from Fortran to propagate Python exceptions */
-int FC_FUNC_(err_occurred, ERR_OCCURRED)()
-{
- return PyErr_Occurred() ? 1 : 0;
-}
-
-/* end of file */
Copied: seismo/3D/SPECFEM3D_SESAME/trunk/program_generate_databases.f90 (from rev 14285, seismo/3D/SPECFEM3D_SESAME/trunk/program_meshfem3D.f90)
===================================================================
--- seismo/3D/SPECFEM3D_SESAME/trunk/program_generate_databases.f90 (rev 0)
+++ seismo/3D/SPECFEM3D_SESAME/trunk/program_generate_databases.f90 2009-03-12 17:37:00 UTC (rev 14301)
@@ -0,0 +1,35 @@
+!=====================================================================
+!
+! S p e c f e m 3 D V e r s i o n 1 . 4
+! ---------------------------------------
+!
+! Dimitri Komatitsch and Jeroen Tromp
+! Seismological Laboratory - California Institute of Technology
+! (c) California Institute of Technology September 2006
+!
+! 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.
+!
+!=====================================================================
+
+ program xgenerate_databases
+
+ call init()
+
+! run the main program
+ call generate_databases
+
+ call finalize()
+
+ end program xgenerate_databases
Property changes on: seismo/3D/SPECFEM3D_SESAME/trunk/program_generate_databases.f90
___________________________________________________________________
Name: svn:mergeinfo
+
Deleted: seismo/3D/SPECFEM3D_SESAME/trunk/program_meshfem3D.f90
===================================================================
--- seismo/3D/SPECFEM3D_SESAME/trunk/program_meshfem3D.f90 2009-03-12 16:31:24 UTC (rev 14300)
+++ seismo/3D/SPECFEM3D_SESAME/trunk/program_meshfem3D.f90 2009-03-12 17:37:00 UTC (rev 14301)
@@ -1,35 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D V e r s i o n 1 . 4
-! ---------------------------------------
-!
-! Dimitri Komatitsch and Jeroen Tromp
-! Seismological Laboratory - California Institute of Technology
-! (c) California Institute of Technology September 2006
-!
-! 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.
-!
-!=====================================================================
-
- program xmeshfem3D
-
- call init()
-
-! run the main program
- call meshfem3D
-
- call finalize()
-
- end program xmeshfem3D
Modified: seismo/3D/SPECFEM3D_SESAME/trunk/run3d.csh
===================================================================
--- seismo/3D/SPECFEM3D_SESAME/trunk/run3d.csh 2009-03-12 16:31:24 UTC (rev 14300)
+++ seismo/3D/SPECFEM3D_SESAME/trunk/run3d.csh 2009-03-12 17:37:00 UTC (rev 14301)
@@ -7,7 +7,7 @@
sleep 1
make clean
sleep 1
-make meshfem3D
+make generate_databases
sleep 10
go_mesher
Deleted: seismo/3D/SPECFEM3D_SESAME/trunk/setup.py
===================================================================
--- seismo/3D/SPECFEM3D_SESAME/trunk/setup.py 2009-03-12 16:31:24 UTC (rev 14300)
+++ seismo/3D/SPECFEM3D_SESAME/trunk/setup.py 2009-03-12 17:37:00 UTC (rev 14301)
@@ -1,33 +0,0 @@
-
-from archimedes import use_merlin
-use_merlin()
-
-from merlin import setup
-#import os
-
-setup(
- name = 'Specfem3DBasin',
- version = '1.4',
- url = 'http://www.gps.caltech.edu/~jtromp/research/downloads.html',
- author = 'Dimitri Komatitsch and Jeroen Tromp',
- author_email = 'jtromp AT caltech.edu',
- packages = [ 'Specfem3DBasin' ],
-
- install_requires = [
- 'cig >= 1.0dev-r4449, < 2.0a, == dev',
- 'pythia[mpi] >= 0.8.1.3, < 0.8.2a',
- ],
-
- dependency_links = [
- 'http://geodynamics.org/svn/cig/cs/framework/trunk#egg=cig-dev',
- 'http://geodynamics.org/svn/cig/cs/pythia/trunk#egg=pythia-0.8.1.3', # temporary
- ],
-
- #interpreter = os.path.join(os.getcwd(), "pyspecfem3D"),
- entry_points = {
- 'console_scripts': [
- 'xspecfem3D = Specfem3DBasin.Specfem:main',
- #'xcreate_movie_AVS_DX = Specfem3DBasin.Specfem:create_movie_AVS_DX',
- ],
- },
-)
Modified: seismo/3D/SPECFEM3D_SESAME/trunk/specfem3D.f90
===================================================================
--- seismo/3D/SPECFEM3D_SESAME/trunk/specfem3D.f90 2009-03-12 16:31:24 UTC (rev 14300)
+++ seismo/3D/SPECFEM3D_SESAME/trunk/specfem3D.f90 2009-03-12 17:37:00 UTC (rev 14301)
@@ -37,7 +37,7 @@
!=============================================================================!
! !
! specfem3D is a 3-D spectral-element solver for a local or regional model. !
-! It uses a mesh generated by program meshfem3D !
+! It uses a mesh generated by program generate_databases !
! !
!=============================================================================!
!
@@ -118,7 +118,7 @@
!
! MPI v. 1.4 Dimitri Komatitsch, University of Pau, Qinya Liu and others, Caltech, September 2006:
! better adjoint and kernel calculations, faster and better I/Os
-! on very large systems, new Pyre version, many small improvements and bug fixes
+! on very large systems, many small improvements and bug fixes
! MPI v. 1.3 Dimitri Komatitsch, University of Pau, and Qinya Liu, Caltech, July 2005:
! serial version, regular mesh, adjoint and kernel calculations, ParaView support
! MPI v. 1.2 Min Chen and Dimitri Komatitsch, Caltech, July 2004:
Modified: seismo/3D/SPECFEM3D_SESAME/trunk/todo_list_please_dont_remove.txt
===================================================================
--- seismo/3D/SPECFEM3D_SESAME/trunk/todo_list_please_dont_remove.txt 2009-03-12 16:31:24 UTC (rev 14300)
+++ seismo/3D/SPECFEM3D_SESAME/trunk/todo_list_please_dont_remove.txt 2009-03-12 17:37:00 UTC (rev 14301)
@@ -2,6 +2,13 @@
To-do list for SPECFEM3D, by Dimitri Komatitsch
-----------------------------------------------
+- we should keep and modify the old mesher from SPECFEM3D_BASIN in order
+to be able to quickly generate an analytical mesh for a simple basin without
+using CUBIT, because many users may still want to be able to use the old and
+simple mesher and not the (more complex) CUBIT package, and/or they might not
+have access to CUBIT. Therefore the old mesher should be modified to save its
+files in CUBIT/Abaqus format so that they can be used as input to "decompose_mesh".
+
- Regarding domain decomposition we should forget about both
METIS and ParMETIS, which are both inefficient
for very large meshes. Pieyre has done detailed tests (Pieyre,
Deleted: seismo/3D/SPECFEM3D_SESAME/trunk/trampoline.f90
===================================================================
--- seismo/3D/SPECFEM3D_SESAME/trunk/trampoline.f90 2009-03-12 16:31:24 UTC (rev 14300)
+++ seismo/3D/SPECFEM3D_SESAME/trunk/trampoline.f90 2009-03-12 17:37:00 UTC (rev 14301)
@@ -1,13 +0,0 @@
-
- program trampoline
-
-! Perform Fortran mojo, and then run the Python script.
-
-! With ifort v9 in particular, this function (i.e., MAIN__) will call
-! the undocumented function __intel_new_proc_init or
-! __intel_new_proc_init_P. Without this, SPECFEM runs several
-! times slower (!).
-
- call FC_PY_MAIN()
-
- end program trampoline
More information about the CIG-COMMITS
mailing list