[cig-commits] [commit] pluggable: Added model plugin support API. (943369b)
cig_noreply at geodynamics.org
cig_noreply at geodynamics.org
Wed Apr 9 08:55:03 PDT 2014
Repository : ssh://geoshell/specfem3d_globe
On branch : pluggable
Link : https://github.com/geodynamics/specfem3d_globe/compare/64e1b38f0c5ebb4056cce0b15d41c0b9f94ab6e5...099a4d330d5b173b21e51ad441f9f429e5d37842
>---------------------------------------------------------------
commit 943369b2cdf06932ecc02781bf492c846cf829bb
Author: Leif Strand <leif at geodynamics.org>
Date: Fri Feb 27 01:49:14 2009 +0000
Added model plugin support API.
>---------------------------------------------------------------
943369b2cdf06932ecc02781bf492c846cf829bb
Makefile.in | 4 ++
meshfem3D.f90 | 9 ++--
model_plugin_support.f90 | 118 +++++++++++++++++++++++++++++++++++++++++++++++
3 files changed, 126 insertions(+), 5 deletions(-)
diff --git a/Makefile.in b/Makefile.in
index 92a7501..310cb6a 100644
--- a/Makefile.in
+++ b/Makefile.in
@@ -108,6 +108,7 @@ libspecfem_a_OBJECTS = \
$O/make_ellipticity.o \
$O/make_gravity.o \
$O/memory_eval.o \
+ $O/model_plugin_support.o \
$O/moho_stretching.o \
$O/netlib_specfun_erf.o \
$O/prem_common.o \
@@ -463,6 +464,9 @@ $O/comp_source_spectrum.o: constants.h $S/comp_source_spectrum.f90
$O/add_topography.o: constants.h $S/add_topography.f90
${FCCOMPILE_CHECK} -c -o $O/add_topography.o ${FCFLAGS_f90} $S/add_topography.f90
+$O/model_plugin_support.o: constants.h $S/model_plugin_support.f90
+ ${FCCOMPILE_CHECK} -c -o $O/model_plugin_support.o ${FCFLAGS_f90} $S/model_plugin_support.f90
+
$O/moho_stretching.o: constants.h $S/moho_stretching.f90
${FCCOMPILE_CHECK} -c -o $O/moho_stretching.o ${FCFLAGS_f90} $S/moho_stretching.f90
diff --git a/meshfem3D.f90 b/meshfem3D.f90
index e5128a9..f9139c4 100644
--- a/meshfem3D.f90
+++ b/meshfem3D.f90
@@ -380,11 +380,6 @@
logical :: CUT_SUPERBRICK_XI,CUT_SUPERBRICK_ETA
integer, dimension(MAX_NUM_REGIONS) :: NGLOB1D_RADIAL_TEMP
- ! parameters for passing information to citcoms mantle model
- common /for_citcoms1/ NPROC_XI, NPROC_ETA, NCHUNKS
- common /for_citcoms2/ ANGULAR_WIDTH_XI_RAD, ANGULAR_WIDTH_ETA_RAD
- common /for_citcoms3/ rotation_matrix
-
! ************** PROGRAM STARTS HERE **************
! initialize the MPI communicator and start the NPROCTOT MPI processes.
@@ -868,6 +863,10 @@
if(ELLIPTICITY) call make_ellipticity(nspl,rspl,espl,espl2,ONE_CRUST)
+ call init_model_plugin_support(NCHUNKS, NPROC_XI, NPROC_ETA, &
+ ANGULAR_WIDTH_XI_RAD, ANGULAR_WIDTH_ETA_RAD, &
+ rotation_matrix)
+
call bcast_model(myrank, trim(LOCAL_PATH))
call read_3d_mantle_model()
diff --git a/model_plugin_support.f90 b/model_plugin_support.f90
new file mode 100644
index 0000000..df35ae9
--- /dev/null
+++ b/model_plugin_support.f90
@@ -0,0 +1,118 @@
+!=====================================================================
+!
+! S p e c f e m 3 D G l o b e V e r s i o n 4 . 0
+! --------------------------------------------------
+!
+! Main authors: Dimitri Komatitsch and Jeroen Tromp
+! Seismological Laboratory, California Institute of Technology, USA
+! and University of Pau / CNRS / INRIA, France
+! (c) California Institute of Technology and University of Pau / CNRS / INRIA
+! February 2008
+!
+! This program is free software; you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation; either version 2 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along
+! with this program; if not, write to the Free Software Foundation, Inc.,
+! 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+!
+!=====================================================================
+
+
+module model_plugin_support_module
+
+ include "constants.h"
+
+ type model_plugin_support_variables
+ integer NCHUNKS, NPROC_XI, NPROC_ETA
+ double precision ANGULAR_WIDTH_XI_RAD, ANGULAR_WIDTH_ETA_RAD
+ double precision, dimension(NDIM,NDIM) :: rotation_matrix
+ end type model_plugin_support_variables
+
+ type (model_plugin_support_variables) vars
+
+end module model_plugin_support_module
+
+
+subroutine get_nchunks(NCHUNKS)
+
+ use model_plugin_support_module
+ implicit none
+
+ integer NCHUNKS
+
+ NCHUNKS = vars%NCHUNKS
+
+end subroutine get_nchunks
+
+
+subroutine get_nproc(NPROC_XI, NPROC_ETA)
+
+ use model_plugin_support_module
+ implicit none
+
+ integer NPROC_XI, NPROC_ETA
+
+ NPROC_XI = vars%NPROC_XI
+ NPROC_ETA = vars%NPROC_ETA
+
+end subroutine get_nproc
+
+
+subroutine get_angular_width_in_radians(ANGULAR_WIDTH_XI_RAD, ANGULAR_WIDTH_ETA_RAD)
+
+ use model_plugin_support_module
+ implicit none
+
+ double precision ANGULAR_WIDTH_XI_RAD, ANGULAR_WIDTH_ETA_RAD
+
+ ANGULAR_WIDTH_XI_RAD = vars%ANGULAR_WIDTH_XI_RAD
+ ANGULAR_WIDTH_ETA_RAD = vars%ANGULAR_WIDTH_ETA_RAD
+
+end subroutine get_angular_width_in_radians
+
+
+subroutine get_rotation_matrix(rotation_matrix)
+
+ use model_plugin_support_module
+ implicit none
+
+ double precision, dimension(NDIM,NDIM) :: rotation_matrix
+
+ rotation_matrix = vars%rotation_matrix
+
+end subroutine get_rotation_matrix
+
+
+!---------------------------------------------------------------------
+! private
+
+subroutine init_model_plugin_support(NCHUNKS, NPROC_XI, NPROC_ETA, &
+ ANGULAR_WIDTH_XI_RAD, ANGULAR_WIDTH_ETA_RAD, &
+ rotation_matrix)
+
+ use model_plugin_support_module
+ implicit none
+
+ integer NCHUNKS, NPROC_XI, NPROC_ETA
+ double precision ANGULAR_WIDTH_XI_RAD, ANGULAR_WIDTH_ETA_RAD
+ double precision, dimension(NDIM,NDIM) :: rotation_matrix
+
+ vars%NCHUNKS = NCHUNKS
+
+ vars%NPROC_XI = NPROC_XI
+ vars%NPROC_ETA = NPROC_ETA
+
+ vars%ANGULAR_WIDTH_XI_RAD = ANGULAR_WIDTH_XI_RAD
+ vars%ANGULAR_WIDTH_ETA_RAD = ANGULAR_WIDTH_ETA_RAD
+
+ vars%rotation_matrix = rotation_matrix
+
+end subroutine init_model_plugin_support
More information about the CIG-COMMITS
mailing list