[cig-commits] r14045 - in mc/3D/CitcomS/branches: . cxx cxx/bin cxx/lib cxx/module
leif at geodynamics.org
leif at geodynamics.org
Thu Feb 12 19:39:37 PST 2009
Author: leif
Date: 2009-02-12 19:39:35 -0800 (Thu, 12 Feb 2009)
New Revision: 14045
Added:
mc/3D/CitcomS/branches/cxx/
mc/3D/CitcomS/branches/cxx/bin/Citcom.cc
mc/3D/CitcomS/branches/cxx/bin/CitcomSFull.cc
mc/3D/CitcomS/branches/cxx/bin/CitcomSRegional.cc
mc/3D/CitcomS/branches/cxx/bin/pycitcoms.cc
mc/3D/CitcomS/branches/cxx/lib/Advection_diffusion.cc
mc/3D/CitcomS/branches/cxx/lib/BC_util.cc
mc/3D/CitcomS/branches/cxx/lib/Checkpoints.cc
mc/3D/CitcomS/branches/cxx/lib/Citcom_init.cc
mc/3D/CitcomS/branches/cxx/lib/Composition_related.cc
mc/3D/CitcomS/branches/cxx/lib/Construct_arrays.cc
mc/3D/CitcomS/branches/cxx/lib/Convection.cc
mc/3D/CitcomS/branches/cxx/lib/Determine_net_rotation.cc
mc/3D/CitcomS/branches/cxx/lib/Drive_solvers.cc
mc/3D/CitcomS/branches/cxx/lib/Element_calculations.cc
mc/3D/CitcomS/branches/cxx/lib/Full_boundary_conditions.cc
mc/3D/CitcomS/branches/cxx/lib/Full_geometry_cartesian.cc
mc/3D/CitcomS/branches/cxx/lib/Full_lith_age_read_files.cc
mc/3D/CitcomS/branches/cxx/lib/Full_obsolete.cc
mc/3D/CitcomS/branches/cxx/lib/Full_parallel_related.cc
mc/3D/CitcomS/branches/cxx/lib/Full_read_input_from_files.cc
mc/3D/CitcomS/branches/cxx/lib/Full_solver.cc
mc/3D/CitcomS/branches/cxx/lib/Full_sphere_related.cc
mc/3D/CitcomS/branches/cxx/lib/Full_tracer_advection.cc
mc/3D/CitcomS/branches/cxx/lib/Full_version_dependent.cc
mc/3D/CitcomS/branches/cxx/lib/General_matrix_functions.cc
mc/3D/CitcomS/branches/cxx/lib/Ggrd_handling.cc
mc/3D/CitcomS/branches/cxx/lib/Global_operations.cc
mc/3D/CitcomS/branches/cxx/lib/Initial_temperature.cc
mc/3D/CitcomS/branches/cxx/lib/Instructions.cc
mc/3D/CitcomS/branches/cxx/lib/Interuption.cc
mc/3D/CitcomS/branches/cxx/lib/Lith_age.cc
mc/3D/CitcomS/branches/cxx/lib/Material_properties.cc
mc/3D/CitcomS/branches/cxx/lib/Nodal_mesh.cc
mc/3D/CitcomS/branches/cxx/lib/Obsolete.cc
mc/3D/CitcomS/branches/cxx/lib/Output.cc
mc/3D/CitcomS/branches/cxx/lib/Output_gzdir.cc
mc/3D/CitcomS/branches/cxx/lib/Output_h5.cc
mc/3D/CitcomS/branches/cxx/lib/Output_vtk.cc
mc/3D/CitcomS/branches/cxx/lib/Pan_problem_misc_functions.cc
mc/3D/CitcomS/branches/cxx/lib/Parallel_util.cc
mc/3D/CitcomS/branches/cxx/lib/Parsing.cc
mc/3D/CitcomS/branches/cxx/lib/Phase_change.cc
mc/3D/CitcomS/branches/cxx/lib/Problem_related.cc
mc/3D/CitcomS/branches/cxx/lib/Process_buoyancy.cc
mc/3D/CitcomS/branches/cxx/lib/Regional_boundary_conditions.cc
mc/3D/CitcomS/branches/cxx/lib/Regional_geometry_cartesian.cc
mc/3D/CitcomS/branches/cxx/lib/Regional_lith_age_read_files.cc
mc/3D/CitcomS/branches/cxx/lib/Regional_obsolete.cc
mc/3D/CitcomS/branches/cxx/lib/Regional_parallel_related.cc
mc/3D/CitcomS/branches/cxx/lib/Regional_read_input_from_files.cc
mc/3D/CitcomS/branches/cxx/lib/Regional_solver.cc
mc/3D/CitcomS/branches/cxx/lib/Regional_sphere_related.cc
mc/3D/CitcomS/branches/cxx/lib/Regional_tracer_advection.cc
mc/3D/CitcomS/branches/cxx/lib/Regional_version_dependent.cc
mc/3D/CitcomS/branches/cxx/lib/Shape_functions.cc
mc/3D/CitcomS/branches/cxx/lib/Size_does_matter.cc
mc/3D/CitcomS/branches/cxx/lib/Solver_conj_grad.cc
mc/3D/CitcomS/branches/cxx/lib/Solver_multigrid.cc
mc/3D/CitcomS/branches/cxx/lib/Sphere_harmonics.cc
mc/3D/CitcomS/branches/cxx/lib/Sphere_util.cc
mc/3D/CitcomS/branches/cxx/lib/Stokes_flow_Incomp.cc
mc/3D/CitcomS/branches/cxx/lib/Topo_gravity.cc
mc/3D/CitcomS/branches/cxx/lib/Tracer_setup.cc
mc/3D/CitcomS/branches/cxx/lib/Viscosity_structures.cc
mc/3D/CitcomS/branches/cxx/lib/cproto.h
mc/3D/CitcomS/branches/cxx/module/CitcomSmodule.cc
mc/3D/CitcomS/branches/cxx/module/advdiffu.cc
mc/3D/CitcomS/branches/cxx/module/bindings.cc
mc/3D/CitcomS/branches/cxx/module/exceptions.cc
mc/3D/CitcomS/branches/cxx/module/initial_conditions.cc
mc/3D/CitcomS/branches/cxx/module/mesher.cc
mc/3D/CitcomS/branches/cxx/module/misc.cc
mc/3D/CitcomS/branches/cxx/module/outputs.cc
mc/3D/CitcomS/branches/cxx/module/setProperties.cc
mc/3D/CitcomS/branches/cxx/module/stokes_solver.cc
Removed:
mc/3D/CitcomS/branches/cxx/bin/Citcom.c
mc/3D/CitcomS/branches/cxx/bin/CitcomSFull.c
mc/3D/CitcomS/branches/cxx/bin/CitcomSRegional.c
mc/3D/CitcomS/branches/cxx/bin/pycitcoms.c
mc/3D/CitcomS/branches/cxx/lib/Advection_diffusion.c
mc/3D/CitcomS/branches/cxx/lib/BC_util.c
mc/3D/CitcomS/branches/cxx/lib/Checkpoints.c
mc/3D/CitcomS/branches/cxx/lib/Citcom_init.c
mc/3D/CitcomS/branches/cxx/lib/Composition_related.c
mc/3D/CitcomS/branches/cxx/lib/Construct_arrays.c
mc/3D/CitcomS/branches/cxx/lib/Convection.c
mc/3D/CitcomS/branches/cxx/lib/Determine_net_rotation.c
mc/3D/CitcomS/branches/cxx/lib/Drive_solvers.c
mc/3D/CitcomS/branches/cxx/lib/Element_calculations.c
mc/3D/CitcomS/branches/cxx/lib/Full_boundary_conditions.c
mc/3D/CitcomS/branches/cxx/lib/Full_geometry_cartesian.c
mc/3D/CitcomS/branches/cxx/lib/Full_lith_age_read_files.c
mc/3D/CitcomS/branches/cxx/lib/Full_obsolete.c
mc/3D/CitcomS/branches/cxx/lib/Full_parallel_related.c
mc/3D/CitcomS/branches/cxx/lib/Full_read_input_from_files.c
mc/3D/CitcomS/branches/cxx/lib/Full_solver.c
mc/3D/CitcomS/branches/cxx/lib/Full_sphere_related.c
mc/3D/CitcomS/branches/cxx/lib/Full_tracer_advection.c
mc/3D/CitcomS/branches/cxx/lib/Full_version_dependent.c
mc/3D/CitcomS/branches/cxx/lib/General_matrix_functions.c
mc/3D/CitcomS/branches/cxx/lib/Ggrd_handling.c
mc/3D/CitcomS/branches/cxx/lib/Global_operations.c
mc/3D/CitcomS/branches/cxx/lib/Initial_temperature.c
mc/3D/CitcomS/branches/cxx/lib/Instructions.c
mc/3D/CitcomS/branches/cxx/lib/Interuption.c
mc/3D/CitcomS/branches/cxx/lib/Lith_age.c
mc/3D/CitcomS/branches/cxx/lib/Material_properties.c
mc/3D/CitcomS/branches/cxx/lib/Nodal_mesh.c
mc/3D/CitcomS/branches/cxx/lib/Obsolete.c
mc/3D/CitcomS/branches/cxx/lib/Output.c
mc/3D/CitcomS/branches/cxx/lib/Output_gzdir.c
mc/3D/CitcomS/branches/cxx/lib/Output_h5.c
mc/3D/CitcomS/branches/cxx/lib/Output_vtk.c
mc/3D/CitcomS/branches/cxx/lib/Pan_problem_misc_functions.c
mc/3D/CitcomS/branches/cxx/lib/Parallel_util.c
mc/3D/CitcomS/branches/cxx/lib/Parsing.c
mc/3D/CitcomS/branches/cxx/lib/Phase_change.c
mc/3D/CitcomS/branches/cxx/lib/Problem_related.c
mc/3D/CitcomS/branches/cxx/lib/Process_buoyancy.c
mc/3D/CitcomS/branches/cxx/lib/Regional_boundary_conditions.c
mc/3D/CitcomS/branches/cxx/lib/Regional_geometry_cartesian.c
mc/3D/CitcomS/branches/cxx/lib/Regional_lith_age_read_files.c
mc/3D/CitcomS/branches/cxx/lib/Regional_obsolete.c
mc/3D/CitcomS/branches/cxx/lib/Regional_parallel_related.c
mc/3D/CitcomS/branches/cxx/lib/Regional_read_input_from_files.c
mc/3D/CitcomS/branches/cxx/lib/Regional_solver.c
mc/3D/CitcomS/branches/cxx/lib/Regional_sphere_related.c
mc/3D/CitcomS/branches/cxx/lib/Regional_tracer_advection.c
mc/3D/CitcomS/branches/cxx/lib/Regional_version_dependent.c
mc/3D/CitcomS/branches/cxx/lib/Shape_functions.c
mc/3D/CitcomS/branches/cxx/lib/Size_does_matter.c
mc/3D/CitcomS/branches/cxx/lib/Solver_conj_grad.c
mc/3D/CitcomS/branches/cxx/lib/Solver_multigrid.c
mc/3D/CitcomS/branches/cxx/lib/Sphere_harmonics.c
mc/3D/CitcomS/branches/cxx/lib/Sphere_util.c
mc/3D/CitcomS/branches/cxx/lib/Stokes_flow_Incomp.c
mc/3D/CitcomS/branches/cxx/lib/Topo_gravity.c
mc/3D/CitcomS/branches/cxx/lib/Tracer_setup.c
mc/3D/CitcomS/branches/cxx/lib/Viscosity_structures.c
mc/3D/CitcomS/branches/cxx/module/CitcomSmodule.c
mc/3D/CitcomS/branches/cxx/module/advdiffu.c
mc/3D/CitcomS/branches/cxx/module/bindings.c
mc/3D/CitcomS/branches/cxx/module/exceptions.c
mc/3D/CitcomS/branches/cxx/module/initial_conditions.c
mc/3D/CitcomS/branches/cxx/module/mesher.c
mc/3D/CitcomS/branches/cxx/module/misc.c
mc/3D/CitcomS/branches/cxx/module/outputs.c
mc/3D/CitcomS/branches/cxx/module/setProperties.c
mc/3D/CitcomS/branches/cxx/module/stokes_solver.c
Modified:
mc/3D/CitcomS/branches/cxx/bin/Makefile.am
mc/3D/CitcomS/branches/cxx/configure.ac
mc/3D/CitcomS/branches/cxx/lib/Makefile.am
mc/3D/CitcomS/branches/cxx/lib/advection_diffusion.h
mc/3D/CitcomS/branches/cxx/lib/citcom_init.h
mc/3D/CitcomS/branches/cxx/lib/drive_solvers.h
mc/3D/CitcomS/branches/cxx/lib/global_defs.h
mc/3D/CitcomS/branches/cxx/lib/output.h
mc/3D/CitcomS/branches/cxx/lib/output_h5.h
mc/3D/CitcomS/branches/cxx/lib/parallel_related.h
mc/3D/CitcomS/branches/cxx/module/Makefile.am
Log:
New, unauthorized, experimental branch. Ported C code to C++,
updating old K&R style functions, adding function prototypes, adding
casts, etc.
Copied: mc/3D/CitcomS/branches/cxx (from rev 14044, mc/3D/CitcomS/trunk)
Deleted: mc/3D/CitcomS/branches/cxx/bin/Citcom.c
===================================================================
--- mc/3D/CitcomS/trunk/bin/Citcom.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/bin/Citcom.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,272 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-#include <mpi.h>
-
-#include <math.h>
-#include <sys/types.h>
-
-#include "element_definitions.h"
-#include "global_defs.h"
-#include "citcom_init.h"
-#include "output.h"
-#include "parallel_related.h"
-#include "checkpoints.h"
-
-extern int Emergency_stop;
-
-void solver_init(struct All_variables *E);
-
-int main(argc,argv)
- int argc;
- char **argv;
-
-{ /* Functions called by main*/
- void general_stokes_solver();
- void general_stokes_solver_pseudo_surf();
- void read_instructions();
- void initial_setup();
- void initial_conditions();
- void solve_constrained_flow();
- void solve_derived_velocities();
- void process_temp_field();
- void post_processing();
- void vcopy();
- void construct_mat_group();
- void read_velocity_boundary_from_file();
- void read_rayleigh_from_file();
- void read_mat_from_file();
- void read_temperature_boundary_from_file();
-
- void open_time();
- void output_finalize();
- void PG_timestep_init();
- void tracer_advection();
- void heat_flux();
-
- float dot();
- float cpu_time_on_vp_it;
-
- int cpu_total_seconds,k, *temp;
- double CPU_time0(),time,initial_time,start_time,avaimem();
-
- struct All_variables *E;
- MPI_Comm world;
-
- MPI_Init(&argc,&argv); /* added here to allow command-line input */
-
- if (argc < 2) {
- fprintf(stderr,"Usage: %s PARAMETERFILE\n", argv[0]);
- parallel_process_termination();
- }
-
-
-
- /* this section reads input, allocates memory, and set some initial values;
- * replaced by CitcomS.Controller.initialize() */
- world = MPI_COMM_WORLD;
- E = citcom_init(&world); /* allocate global E and do initializaion here */
-
- solver_init(E);
-
- start_time = time = CPU_time0();
- read_instructions(E, argv[1]);
- initial_setup(E);
-
- cpu_time_on_vp_it = CPU_time0();
- initial_time = cpu_time_on_vp_it - time;
- if (E->parallel.me == 0) {
- fprintf(stderr,"Input parameters taken from file '%s'\n",argv[1]);
- fprintf(stderr,"Initialization complete after %g seconds\n\n",initial_time);
- fprintf(E->fp,"Initialization complete after %g seconds\n\n",initial_time);
- fflush(E->fp);
- }
-
-
-
- /* this section sets the initial condition;
- * replaced by CitcomS.Controller.launch() */
- if (E->control.post_p) {
- /* the initial condition is from previous checkpoint */
- read_checkpoint(E);
-
- /* the program will finish after post_processing */
- post_processing(E);
- (E->problem_output)(E, E->monitor.solution_cycles);
- parallel_process_termination();
- }
-
- if (E->control.restart) {
- /* the initial condition is from previous checkpoint */
- read_checkpoint(E);
- }
- else {
- /* regular init, or read T from file only */
-
- initial_conditions(E);
-
- if(E->control.pseudo_free_surf) {
- if(E->mesh.topvbc == 2)
- general_stokes_solver_pseudo_surf(E);
- else
- assert(0);
- }
- else
- general_stokes_solver(E);
- }
-
- (E->problem_output)(E, E->monitor.solution_cycles);
-
- /* information about simulation time and wall clock time */
- output_time(E, E->monitor.solution_cycles);
-
- if(!E->control.restart) /* if we have not restarted, print new
- checkpoint, else leave as is to
- allow reusing directories */
- output_checkpoint(E);
-
- /* this section stops the computation if only computes stokes' problem
- * no counterpart in pyre */
- if (E->control.stokes) {
-
- if(E->control.tracer==1)
- tracer_advection(E);
-
- parallel_process_termination();
- }
-
-
-
-
- /* this section advances the time step;
- * replaced by CitcomS.Controller.march() */
- while ( E->control.keep_going && (Emergency_stop == 0) ) {
-
- /* The next few lines of code were replaced by
- * pyCitcom_PG_timestep_solve() in Pyre version.
- * If you modify here, make sure its Pyre counterpart
- * is modified as well */
- E->monitor.solution_cycles++;
- if(E->monitor.solution_cycles>E->control.print_convergence)
- E->control.print_convergence=1;
-
- (E->next_buoyancy_field)(E);
- /* */
-
-
- if(((E->advection.total_timesteps < E->advection.max_total_timesteps) &&
- (E->advection.timesteps < E->advection.max_timesteps)) ||
- (E->advection.total_timesteps < E->advection.min_timesteps) )
- E->control.keep_going = 1;
- else
- E->control.keep_going = 0;
-
- cpu_total_seconds = CPU_time0()-start_time;
- if (cpu_total_seconds > E->control.record_all_until) {
- E->control.keep_going = 0;
- }
-
- if (E->monitor.T_interior > E->monitor.T_interior_max_for_exit) {
- fprintf(E->fp,"quit due to maxT = %.4e sub_iteration%d\n",E->monitor.T_interior,E->advection.last_sub_iterations);
- parallel_process_termination();
- }
-
- if(E->control.tracer==1)
- tracer_advection(E);
-
- general_stokes_solver(E);
- if(E->output.write_q_files)
- if ((E->monitor.solution_cycles % E->output.write_q_files)==0)
- heat_flux(E);
-
- if ((E->monitor.solution_cycles % E->control.record_every)==0) {
- (E->problem_output)(E, E->monitor.solution_cycles);
- }
-
-
- /* information about simulation time and wall clock time */
- output_time(E, E->monitor.solution_cycles);
-
- /* print checkpoint every checkpoint_frequency, unless we have restarted,
- then, we would like to avoid overwriting
- */
- if ( ((E->monitor.solution_cycles % E->control.checkpoint_frequency)==0) &&
- ((!E->control.restart) || (E->monitor.solution_cycles != E->monitor.solution_cycles_init))){
- output_checkpoint(E);
- }
- /* updating time-dependent material group
- * if mat_control is 0, the material group has already been
- * initialized in initial_conditions() */
- if(E->control.mat_control==1)
- read_mat_from_file(E);
-
-#ifdef USE_GGRD
- /* updating local rayleigh number (based on Netcdf grds, the
- rayleigh number may be modified laterally in the surface
- layers) */
- /* no counterpart in pyre */
- if(E->control.ggrd.ray_control)
- read_rayleigh_from_file(E);
-#endif
-
- /* updating plate velocity boundary condition */
- if(E->control.vbcs_file==1)
- read_velocity_boundary_from_file(E);
-
- /* updating plate temperature boundary condition */
- if(E->control.tbcs_file)
- read_temperature_boundary_from_file(E);
-
-
- if (E->parallel.me == 0) {
- fprintf(E->fp,"CPU total = %g & CPU = %g for step %d time = %.4e dt = %.4e maxT = %.4e sub_iteration%d\n",CPU_time0()-start_time,CPU_time0()-time,E->monitor.solution_cycles,E->monitor.elapsed_time,E->advection.timestep,E->monitor.T_interior,E->advection.last_sub_iterations);
-
- time = CPU_time0();
- }
-
- }
-
-
-
- /* this section prints time accounting;
- * no counterpart in pyre */
- if (E->parallel.me == 0) {
- fprintf(stderr,"cycles=%d\n",E->monitor.solution_cycles);
- cpu_time_on_vp_it=CPU_time0()-cpu_time_on_vp_it;
- fprintf(stderr,"Average cpu time taken for velocity step = %f\n",
- cpu_time_on_vp_it/((float)(E->monitor.solution_cycles-E->control.restart)));
- fprintf(E->fp,"Initialization overhead = %f\n",initial_time);
- fprintf(E->fp,"Average cpu time taken for velocity step = %f\n",
- cpu_time_on_vp_it/((float)(E->monitor.solution_cycles-E->control.restart)));
- }
-
- output_finalize(E);
- parallel_process_termination();
-
- return(0);
-
-}
Copied: mc/3D/CitcomS/branches/cxx/bin/Citcom.cc (from rev 14029, mc/3D/CitcomS/trunk/bin/Citcom.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/bin/Citcom.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/bin/Citcom.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,248 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+#include <mpi.h>
+
+#include <math.h>
+#include <sys/types.h>
+
+#include "element_definitions.h"
+#include "global_defs.h"
+#include "citcom_init.h"
+#include "output.h"
+#include "parallel_related.h"
+#include "checkpoints.h"
+
+#include "cproto.h"
+
+extern int Emergency_stop;
+
+void solver_init(struct All_variables *E);
+
+int main(int argc, char **argv)
+{ /* Functions called by main*/
+ float cpu_time_on_vp_it;
+
+ int cpu_total_seconds,k, *temp;
+ double time,initial_time,start_time;
+
+ struct All_variables *E;
+ MPI_Comm world;
+
+ MPI_Init(&argc,&argv); /* added here to allow command-line input */
+
+ if (argc < 2) {
+ fprintf(stderr,"Usage: %s PARAMETERFILE\n", argv[0]);
+ parallel_process_termination();
+ }
+
+
+
+ /* this section reads input, allocates memory, and set some initial values;
+ * replaced by CitcomS.Controller.initialize() */
+ world = MPI_COMM_WORLD;
+ E = citcom_init(&world); /* allocate global E and do initializaion here */
+
+ solver_init(E);
+
+ start_time = time = CPU_time0();
+ read_instructions(E, argv[1]);
+ initial_setup(E);
+
+ cpu_time_on_vp_it = CPU_time0();
+ initial_time = cpu_time_on_vp_it - time;
+ if (E->parallel.me == 0) {
+ fprintf(stderr,"Input parameters taken from file '%s'\n",argv[1]);
+ fprintf(stderr,"Initialization complete after %g seconds\n\n",initial_time);
+ fprintf(E->fp,"Initialization complete after %g seconds\n\n",initial_time);
+ fflush(E->fp);
+ }
+
+
+
+ /* this section sets the initial condition;
+ * replaced by CitcomS.Controller.launch() */
+ if (E->control.post_p) {
+ /* the initial condition is from previous checkpoint */
+ read_checkpoint(E);
+
+ /* the program will finish after post_processing */
+ post_processing(E);
+ (E->problem_output)(E, E->monitor.solution_cycles);
+ parallel_process_termination();
+ }
+
+ if (E->control.restart) {
+ /* the initial condition is from previous checkpoint */
+ read_checkpoint(E);
+ }
+ else {
+ /* regular init, or read T from file only */
+
+ initial_conditions(E);
+
+ if(E->control.pseudo_free_surf) {
+ if(E->mesh.topvbc == 2)
+ general_stokes_solver_pseudo_surf(E);
+ else
+ assert(0);
+ }
+ else
+ general_stokes_solver(E);
+ }
+
+ (E->problem_output)(E, E->monitor.solution_cycles);
+
+ /* information about simulation time and wall clock time */
+ output_time(E, E->monitor.solution_cycles);
+
+ if(!E->control.restart) /* if we have not restarted, print new
+ checkpoint, else leave as is to
+ allow reusing directories */
+ output_checkpoint(E);
+
+ /* this section stops the computation if only computes stokes' problem
+ * no counterpart in pyre */
+ if (E->control.stokes) {
+
+ if(E->control.tracer==1)
+ tracer_advection(E);
+
+ parallel_process_termination();
+ }
+
+
+
+
+ /* this section advances the time step;
+ * replaced by CitcomS.Controller.march() */
+ while ( E->control.keep_going && (Emergency_stop == 0) ) {
+
+ /* The next few lines of code were replaced by
+ * pyCitcom_PG_timestep_solve() in Pyre version.
+ * If you modify here, make sure its Pyre counterpart
+ * is modified as well */
+ E->monitor.solution_cycles++;
+ if(E->monitor.solution_cycles>E->control.print_convergence)
+ E->control.print_convergence=1;
+
+ (E->next_buoyancy_field)(E);
+ /* */
+
+
+ if(((E->advection.total_timesteps < E->advection.max_total_timesteps) &&
+ (E->advection.timesteps < E->advection.max_timesteps)) ||
+ (E->advection.total_timesteps < E->advection.min_timesteps) )
+ E->control.keep_going = 1;
+ else
+ E->control.keep_going = 0;
+
+ cpu_total_seconds = (int)(CPU_time0()-start_time);
+ if (cpu_total_seconds > E->control.record_all_until) {
+ E->control.keep_going = 0;
+ }
+
+ if (E->monitor.T_interior > E->monitor.T_interior_max_for_exit) {
+ fprintf(E->fp,"quit due to maxT = %.4e sub_iteration%d\n",E->monitor.T_interior,E->advection.last_sub_iterations);
+ parallel_process_termination();
+ }
+
+ if(E->control.tracer==1)
+ tracer_advection(E);
+
+ general_stokes_solver(E);
+ if(E->output.write_q_files)
+ if ((E->monitor.solution_cycles % E->output.write_q_files)==0)
+ heat_flux(E);
+
+ if ((E->monitor.solution_cycles % E->control.record_every)==0) {
+ (E->problem_output)(E, E->monitor.solution_cycles);
+ }
+
+
+ /* information about simulation time and wall clock time */
+ output_time(E, E->monitor.solution_cycles);
+
+ /* print checkpoint every checkpoint_frequency, unless we have restarted,
+ then, we would like to avoid overwriting
+ */
+ if ( ((E->monitor.solution_cycles % E->control.checkpoint_frequency)==0) &&
+ ((!E->control.restart) || (E->monitor.solution_cycles != E->monitor.solution_cycles_init))){
+ output_checkpoint(E);
+ }
+ /* updating time-dependent material group
+ * if mat_control is 0, the material group has already been
+ * initialized in initial_conditions() */
+ if(E->control.mat_control==1)
+ read_mat_from_file(E);
+
+#ifdef USE_GGRD
+ /* updating local rayleigh number (based on Netcdf grds, the
+ rayleigh number may be modified laterally in the surface
+ layers) */
+ /* no counterpart in pyre */
+ if(E->control.ggrd.ray_control)
+ read_rayleigh_from_file(E);
+#endif
+
+ /* updating plate velocity boundary condition */
+ if(E->control.vbcs_file==1)
+ read_velocity_boundary_from_file(E);
+
+ /* updating plate temperature boundary condition */
+ if(E->control.tbcs_file)
+ read_temperature_boundary_from_file(E);
+
+
+ if (E->parallel.me == 0) {
+ fprintf(E->fp,"CPU total = %g & CPU = %g for step %d time = %.4e dt = %.4e maxT = %.4e sub_iteration%d\n",CPU_time0()-start_time,CPU_time0()-time,E->monitor.solution_cycles,E->monitor.elapsed_time,E->advection.timestep,E->monitor.T_interior,E->advection.last_sub_iterations);
+
+ time = CPU_time0();
+ }
+
+ }
+
+
+
+ /* this section prints time accounting;
+ * no counterpart in pyre */
+ if (E->parallel.me == 0) {
+ fprintf(stderr,"cycles=%d\n",E->monitor.solution_cycles);
+ cpu_time_on_vp_it=CPU_time0()-cpu_time_on_vp_it;
+ fprintf(stderr,"Average cpu time taken for velocity step = %f\n",
+ cpu_time_on_vp_it/((float)(E->monitor.solution_cycles-E->control.restart)));
+ fprintf(E->fp,"Initialization overhead = %f\n",initial_time);
+ fprintf(E->fp,"Average cpu time taken for velocity step = %f\n",
+ cpu_time_on_vp_it/((float)(E->monitor.solution_cycles-E->control.restart)));
+ }
+
+ output_finalize(E);
+ parallel_process_termination();
+
+ return(0);
+
+}
Deleted: mc/3D/CitcomS/branches/cxx/bin/CitcomSFull.c
===================================================================
--- mc/3D/CitcomS/trunk/bin/CitcomSFull.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/bin/CitcomSFull.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,38 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-
-struct All_variables;
-
-void full_solver_init(struct All_variables *E);
-
-void solver_init(struct All_variables *E)
-{
- full_solver_init(E);
-}
-
-/* end of file */
Copied: mc/3D/CitcomS/branches/cxx/bin/CitcomSFull.cc (from rev 14029, mc/3D/CitcomS/trunk/bin/CitcomSFull.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/bin/CitcomSFull.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/bin/CitcomSFull.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,38 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+
+struct All_variables;
+
+void full_solver_init(struct All_variables *E);
+
+void solver_init(struct All_variables *E)
+{
+ full_solver_init(E);
+}
+
+/* end of file */
Deleted: mc/3D/CitcomS/branches/cxx/bin/CitcomSRegional.c
===================================================================
--- mc/3D/CitcomS/trunk/bin/CitcomSRegional.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/bin/CitcomSRegional.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,38 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-
-struct All_variables;
-
-void regional_solver_init(struct All_variables *E);
-
-void solver_init(struct All_variables *E)
-{
- regional_solver_init(E);
-}
-
-/* end of file */
Copied: mc/3D/CitcomS/branches/cxx/bin/CitcomSRegional.cc (from rev 14029, mc/3D/CitcomS/trunk/bin/CitcomSRegional.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/bin/CitcomSRegional.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/bin/CitcomSRegional.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,38 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+
+struct All_variables;
+
+void regional_solver_init(struct All_variables *E);
+
+void solver_init(struct All_variables *E)
+{
+ regional_solver_init(E);
+}
+
+/* end of file */
Modified: mc/3D/CitcomS/branches/cxx/bin/Makefile.am
===================================================================
--- mc/3D/CitcomS/trunk/bin/Makefile.am 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/bin/Makefile.am 2009-02-13 03:39:35 UTC (rev 14045)
@@ -48,7 +48,7 @@
MAYBE_EXCHANGER_MODULE = $(top_builddir)/module/Exchanger/ExchangerLibmodule.la
endif
else
- PYLINK = $(LINK)
+ PYLINK = $(CXXLINK)
MAYBE_WITH_EXCHANGER =
MAYBE_EXCHANGER_MODULE =
endif
@@ -61,9 +61,9 @@
######## legacy drivers ########
-CitcomSFull_SOURCES = Citcom.c CitcomSFull.c
+CitcomSFull_SOURCES = Citcom.cc CitcomSFull.cc
CitcomSFull_LDADD = $(libCitcomS)
-CitcomSRegional_SOURCES = Citcom.c CitcomSRegional.c
+CitcomSRegional_SOURCES = Citcom.cc CitcomSRegional.cc
CitcomSRegional_LDADD = $(libCitcomS)
@@ -120,8 +120,8 @@
# pycitcoms (libCitcomS + CitcomSLibmodule + embedded Python interpreter)
-pycitcoms_SOURCES = pycitcoms.c dummy.cc
-pycitcoms_CFLAGS = $(MAYBE_WITH_EXCHANGER)
+pycitcoms_SOURCES = pycitcoms.cc dummy.cc
+pycitcoms_CXXFLAGS = $(MAYBE_WITH_EXCHANGER)
pycitcoms_LDADD = \
$(top_builddir)/module/libCitcomSLibmodule.a \
$(MAYBE_EXCHANGER_MODULE) \
@@ -138,8 +138,8 @@
# pycitcoms (libCitcomS + CitcomSLibmodule + embedded Python interpreter)
-mpipycitcoms_SOURCES = pycitcoms.c dummy.cc
-mpipycitcoms_CFLAGS = -DUSE_MPI $(MAYBE_WITH_EXCHANGER)
+mpipycitcoms_SOURCES = pycitcoms.cc dummy.cc
+mpipycitcoms_CXXFLAGS = -DUSE_MPI $(MAYBE_WITH_EXCHANGER)
mpipycitcoms_LDADD = \
$(top_builddir)/module/libCitcomSLibmodule.a \
$(MAYBE_EXCHANGER_MODULE) \
Deleted: mc/3D/CitcomS/branches/cxx/bin/pycitcoms.c
===================================================================
--- mc/3D/CitcomS/trunk/bin/pycitcoms.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/bin/pycitcoms.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,108 +0,0 @@
-/*
-//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-//
-//<LicenseText>
-//
-// CitcomS.py by Eh Tan, Eun-seo Choi, and Pururav Thoutireddy.
-// Copyright (C) 2002-2005, California Institute of Technology.
-//
-// 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-//
-//</LicenseText>
-//
-//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-*/
-
-#include <Python.h>
-#include <stddef.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-#include <mpi.h>
-#include "CitcomSmodule.h"
-#ifdef WITH_EXCHANGER
-#include "Exchangermodule.h"
-#endif
-
-#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[] = {
- { "_mpi", init_mpi },
- { "CitcomSLib", initCitcomSLib },
-#ifdef WITH_EXCHANGER
- { "ExchangerLib", initExchangerLib },
-#endif
- { 0, 0 }
-};
-
-int main(int argc, char **argv)
-{
- int status;
-
-#ifdef 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...\n", argv[0]);
- return 1;
- }
-
- if (argc < 3 || strcmp(argv[1], "--pyre-start") != 0) {
- return Py_Main(argc, argv);
- }
-
- /* make sure 'sys.executable' is set to the path of this program */
- Py_SetProgramName(argv[0]);
-
- /* initialize Python */
- Py_Initialize();
-
- /* initialize sys.argv */
- PySys_SetArgv(argc - 1, argv + 1);
-
- /* run the Python command */
- status = PyRun_SimpleString(COMMAND) != 0;
-
- /* shut down Python */
- Py_Finalize();
-
-#ifdef USE_MPI
- /* shut down MPI */
- MPI_Finalize();
-#endif
-
- return status;
-}
-
-/* End of file */
Copied: mc/3D/CitcomS/branches/cxx/bin/pycitcoms.cc (from rev 14029, mc/3D/CitcomS/trunk/bin/pycitcoms.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/bin/pycitcoms.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/bin/pycitcoms.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,108 @@
+/*
+//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+//
+//<LicenseText>
+//
+// CitcomS.py by Eh Tan, Eun-seo Choi, and Pururav Thoutireddy.
+// Copyright (C) 2002-2005, California Institute of Technology.
+//
+// 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+//
+//</LicenseText>
+//
+//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+*/
+
+#include <Python.h>
+#include <stddef.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <mpi.h>
+#include "CitcomSmodule.h"
+#ifdef WITH_EXCHANGER
+#include "Exchangermodule.h"
+#endif
+
+#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[] = {
+ { "_mpi", init_mpi },
+ { "CitcomSLib", initCitcomSLib },
+#ifdef WITH_EXCHANGER
+ { "ExchangerLib", initExchangerLib },
+#endif
+ { 0, 0 }
+};
+
+int main(int argc, char **argv)
+{
+ int status;
+
+#ifdef 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...\n", argv[0]);
+ return 1;
+ }
+
+ if (argc < 3 || strcmp(argv[1], "--pyre-start") != 0) {
+ return Py_Main(argc, argv);
+ }
+
+ /* make sure 'sys.executable' is set to the path of this program */
+ Py_SetProgramName(argv[0]);
+
+ /* initialize Python */
+ Py_Initialize();
+
+ /* initialize sys.argv */
+ PySys_SetArgv(argc - 1, argv + 1);
+
+ /* run the Python command */
+ status = PyRun_SimpleString(COMMAND) != 0;
+
+ /* shut down Python */
+ Py_Finalize();
+
+#ifdef USE_MPI
+ /* shut down MPI */
+ MPI_Finalize();
+#endif
+
+ return status;
+}
+
+/* End of file */
Modified: mc/3D/CitcomS/branches/cxx/configure.ac
===================================================================
--- mc/3D/CitcomS/trunk/configure.ac 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/configure.ac 2009-02-13 03:39:35 UTC (rev 14045)
@@ -27,7 +27,7 @@
AC_PREREQ(2.59)
AC_INIT([CitcomS], [3.0.1], [cig-mc at geodynamics.org], [CitcomS])
AC_CONFIG_AUX_DIR([./aux-config])
-AC_CONFIG_SRCDIR([bin/Citcom.c])
+AC_CONFIG_SRCDIR([bin/Citcom.cc])
AC_CONFIG_HEADER([config.h])
AC_CONFIG_MACRO_DIR([m4])
AM_INIT_AUTOMAKE([foreign])
Deleted: mc/3D/CitcomS/branches/cxx/lib/Advection_diffusion.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Advection_diffusion.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Advection_diffusion.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,962 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-/* Functions which solve the heat transport equations using Petrov-Galerkin
- streamline-upwind methods. The process is basically as described in Alex
- Brooks PhD thesis (Caltech) which refers back to Hughes, Liu and Brooks. */
-
-#include <sys/types.h>
-
-#include "element_definitions.h"
-#include "global_defs.h"
-#include <math.h>
-#include "advection_diffusion.h"
-#include "parsing.h"
-
-static void set_diffusion_timestep(struct All_variables *E);
-static void predictor(struct All_variables *E, double **field,
- double **fielddot);
-static void corrector(struct All_variables *E, double **field,
- double **fielddot, double **Dfielddot);
-static void pg_solver(struct All_variables *E,
- double **T, double **Tdot, double **DTdot,
- struct SOURCES *Q0,
- double diff, int bc, unsigned int **FLAGS);
-static void pg_shape_fn(struct All_variables *E, int el,
- struct Shape_function *PG,
- struct Shape_function_dx *GNx,
- float VV[4][9], double rtf[4][9],
- double diffusion, int m);
-static void element_residual(struct All_variables *E, int el,
- struct Shape_function *PG,
- struct Shape_function_dx *GNx,
- struct Shape_function_dA *dOmega,
- float VV[4][9],
- double **field, double **fielddot,
- struct SOURCES *Q0,
- double Eres[9], double rtf[4][9],
- double diff, float **BC,
- unsigned int **FLAGS, int m);
-static void filter(struct All_variables *E);
-static void process_heating(struct All_variables *E, int psc_pass);
-
-/* ============================================
- Generic adv-diffusion for temperature field.
- ============================================ */
-
-
-/***************************************************************/
-
-void advection_diffusion_parameters(struct All_variables *E)
-{
-
- /* Set intial values, defaults & read parameters*/
- int m=E->parallel.me;
-
- input_boolean("ADV",&(E->advection.ADVECTION),"on",m);
- input_boolean("filter_temp",&(E->advection.filter_temperature),"off",m);
- input_boolean("monitor_max_T",&(E->advection.monitor_max_T),"on",m);
-
- input_int("minstep",&(E->advection.min_timesteps),"1",m);
- input_int("maxstep",&(E->advection.max_timesteps),"1000",m);
- input_int("maxtotstep",&(E->advection.max_total_timesteps),"1000000",m);
- input_float("finetunedt",&(E->advection.fine_tune_dt),"0.9",m);
- input_float("fixed_timestep",&(E->advection.fixed_timestep),"0.0",m);
- input_float("adv_gamma",&(E->advection.gamma),"0.5",m);
- input_int("adv_sub_iterations",&(E->advection.temp_iterations),"2,1,nomax",m);
-
- input_float("inputdiffusivity",&(E->control.inputdiff),"1.0",m);
-
-
- return;
-}
-
-
-void advection_diffusion_allocate_memory(struct All_variables *E)
-{
- int i,m;
-
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
- E->Tdot[m]= (double *)malloc((E->lmesh.nno+1)*sizeof(double));
-
- for(i=1;i<=E->lmesh.nno;i++)
- E->Tdot[m][i]=0.0;
- }
-
- return;
-}
-
-
-void PG_timestep_init(struct All_variables *E)
-{
-
- set_diffusion_timestep(E);
-
- return;
-}
-
-
-void PG_timestep(struct All_variables *E)
-{
- void std_timestep();
- void PG_timestep_solve();
-
- std_timestep(E);
-
- PG_timestep_solve(E);
-
- return;
-}
-
-
-
-/* =====================================================
- Obtain largest possible timestep (no melt considered)
- ===================================================== */
-
-
-void std_timestep(struct All_variables *E)
-{
- int i,d,n,nel,el,node,m;
-
- float global_fmin();
- void velo_from_element();
-
- float adv_timestep;
- float ts,uc1,uc2,uc3,uc,size,step,VV[4][9];
-
- const int dims=E->mesh.nsd;
- const int dofs=E->mesh.dof;
- const int nno=E->lmesh.nno;
- const int lev=E->mesh.levmax;
- const int ends=enodes[dims];
- const int sphere_key = 1;
-
- nel=E->lmesh.nel;
-
- if(E->advection.fixed_timestep != 0.0) {
- E->advection.timestep = E->advection.fixed_timestep;
- return;
- }
-
- adv_timestep = 1.0e8;
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(el=1;el<=nel;el++) {
-
- velo_from_element(E,VV,m,el,sphere_key);
-
- uc=uc1=uc2=uc3=0.0;
- for(i=1;i<=ENODES3D;i++) {
- uc1 += E->N.ppt[GNPINDEX(i,1)]*VV[1][i];
- uc2 += E->N.ppt[GNPINDEX(i,1)]*VV[2][i];
- uc3 += E->N.ppt[GNPINDEX(i,1)]*VV[3][i];
- }
- uc = fabs(uc1)/E->eco[m][el].size[1] + fabs(uc2)/E->eco[m][el].size[2] + fabs(uc3)/E->eco[m][el].size[3];
-
- step = (0.5/uc);
- adv_timestep = min(adv_timestep,step);
- }
-
- adv_timestep = E->advection.dt_reduced * adv_timestep;
-
- adv_timestep = 1.0e-32 + min(E->advection.fine_tune_dt*adv_timestep,
- E->advection.diff_timestep);
-
- E->advection.timestep = global_fmin(E,adv_timestep);
-
-/* if (E->parallel.me==0) */
-/* fprintf(stderr, "adv_timestep=%g diff_timestep=%g\n",adv_timestep,E->advection.diff_timestep); */
-
- return;
-}
-
-
-void PG_timestep_solve(struct All_variables *E)
-{
-
- double Tmaxd();
- void temperatures_conform_bcs();
- void lith_age_conform_tbc();
- void assimilate_lith_conform_bcs();
- int i,m,psc_pass,iredo;
- double time0,time1,T_interior1;
- double *DTdot[NCS], *T1[NCS], *Tdot1[NCS];
-
- E->advection.timesteps++;
-
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- DTdot[m]= (double *)malloc((E->lmesh.nno+1)*sizeof(double));
-
-
- if(E->advection.monitor_max_T) {
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
- T1[m]= (double *)malloc((E->lmesh.nno+1)*sizeof(double));
- Tdot1[m]= (double *)malloc((E->lmesh.nno+1)*sizeof(double));
- }
-
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for (i=1;i<=E->lmesh.nno;i++) {
- T1[m][i] = E->T[m][i];
- Tdot1[m][i] = E->Tdot[m][i];
- }
-
- /* get the max temperature for old T */
- T_interior1 = Tmaxd(E,E->T);
- }
-
- E->advection.dt_reduced = 1.0;
- E->advection.last_sub_iterations = 1;
-
-
- do {
- E->advection.timestep *= E->advection.dt_reduced;
-
- iredo = 0;
- if (E->advection.ADVECTION) {
-
- predictor(E,E->T,E->Tdot);
-
- for(psc_pass=0;psc_pass<E->advection.temp_iterations;psc_pass++) {
- /* adiabatic, dissipative and latent heating*/
- if(E->control.disptn_number != 0)
- process_heating(E, psc_pass);
-
- /* XXX: replace inputdiff with refstate.thermal_conductivity */
- pg_solver(E,E->T,E->Tdot,DTdot,&(E->convection.heat_sources),E->control.inputdiff,1,E->node);
- corrector(E,E->T,E->Tdot,DTdot);
- temperatures_conform_bcs(E);
- }
-
- if(E->advection.monitor_max_T) {
- /* get the max temperature for new T */
- E->monitor.T_interior = Tmaxd(E,E->T);
-
- /* if the max temperature changes too much, restore the old
- * temperature field, calling the temperature solver using
- * half of the timestep size */
- if (E->monitor.T_interior/T_interior1 > E->monitor.T_maxvaried) {
- if(E->parallel.me==0) {
- fprintf(stderr, "max T varied from %e to %e\n",
- T_interior1, E->monitor.T_interior);
- fprintf(E->fp, "max T varied from %e to %e\n",
- T_interior1, E->monitor.T_interior);
- }
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for (i=1;i<=E->lmesh.nno;i++) {
- E->T[m][i] = T1[m][i];
- E->Tdot[m][i] = Tdot1[m][i];
- }
- iredo = 1;
- E->advection.dt_reduced *= 0.5;
- E->advection.last_sub_iterations ++;
- }
- }
- }
-
- } while ( iredo==1 && E->advection.last_sub_iterations <= 5);
-
-
- /* filter temperature to remove over-/under-shoot */
- if(E->advection.filter_temperature)
- filter(E);
-
-
- E->advection.total_timesteps++;
- E->monitor.elapsed_time += E->advection.timestep;
-
- if (E->advection.last_sub_iterations==5)
- E->control.keep_going = 0;
-
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
- free((void *) DTdot[m] );
- }
-
- if(E->advection.monitor_max_T) {
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
- free((void *) T1[m] );
- free((void *) Tdot1[m] );
- }
- }
-
- if(E->control.lith_age) {
- if(E->parallel.me==0) fprintf(stderr,"PG_timestep_solve\n");
- lith_age_conform_tbc(E);
- assimilate_lith_conform_bcs(E);
- }
-
-
- return;
-}
-
-
-/***************************************************************/
-
-static void set_diffusion_timestep(struct All_variables *E)
-{
- float diff_timestep, ts;
- int m, el, d;
-
- float global_fmin();
-
- diff_timestep = 1.0e8;
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(el=1;el<=E->lmesh.nel;el++) {
- for(d=1;d<=E->mesh.nsd;d++) {
- ts = E->eco[m][el].size[d] * E->eco[m][el].size[d];
- diff_timestep = min(diff_timestep,ts);
- }
- }
-
- diff_timestep = global_fmin(E,diff_timestep);
- E->advection.diff_timestep = 0.5 * diff_timestep;
-
- return;
-}
-
-
-/* ==============================
- predictor and corrector steps.
- ============================== */
-
-static void predictor(struct All_variables *E, double **field,
- double **fielddot)
-{
- int node,m;
- double multiplier;
-
- multiplier = (1.0-E->advection.gamma) * E->advection.timestep;
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for(node=1;node<=E->lmesh.nno;node++) {
- field[m][node] += multiplier * fielddot[m][node] ;
- fielddot[m][node] = 0.0;
- }
-
- return;
-}
-
-
-static void corrector(struct All_variables *E, double **field,
- double **fielddot, double **Dfielddot)
-{
- int node,m;
- double multiplier;
-
- multiplier = E->advection.gamma * E->advection.timestep;
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for(node=1;node<=E->lmesh.nno;node++) {
- field[m][node] += multiplier * Dfielddot[m][node];
- fielddot[m][node] += Dfielddot[m][node];
- }
-
- return;
-}
-
-
-/* ===================================================
- The solution step -- determine residual vector from
- advective-diffusive terms and solve for delta Tdot
- Two versions are available -- one for Cray-style
- vector optimizations etc and one optimized for
- workstations.
- =================================================== */
-
-
-static void pg_solver(struct All_variables *E,
- double **T, double **Tdot, double **DTdot,
- struct SOURCES *Q0,
- double diff, int bc, unsigned int **FLAGS)
-{
- void get_rtf_at_vpts();
- void velo_from_element();
-
- int el,e,a,i,a1,m;
- double Eres[9],rtf[4][9]; /* correction to the (scalar) Tdot field */
- float VV[4][9];
-
- struct Shape_function PG;
-
- const int dims=E->mesh.nsd;
- const int dofs=E->mesh.dof;
- const int ends=enodes[dims];
- const int sphere_key = 1;
- const int lev=E->mesh.levmax;
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=1;i<=E->lmesh.nno;i++)
- DTdot[m][i] = 0.0;
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for(el=1;el<=E->lmesh.nel;el++) {
-
- velo_from_element(E,VV,m,el,sphere_key);
-
- get_rtf_at_vpts(E, m, lev, el, rtf);
-
- /* XXX: replace diff with refstate.thermal_conductivity */
- pg_shape_fn(E, el, &PG, &(E->gNX[m][el]), VV,
- rtf, diff, m);
- element_residual(E, el, &PG, &(E->gNX[m][el]), &(E->gDA[m][el]),
- VV, T, Tdot,
- Q0, Eres, rtf, diff, E->sphere.cap[m].TB,
- FLAGS, m);
-
- for(a=1;a<=ends;a++) {
- a1 = E->ien[m][el].node[a];
- DTdot[m][a1] += Eres[a];
- }
-
- } /* next element */
-
- (E->exchange_node_d)(E,DTdot,lev);
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=1;i<=E->lmesh.nno;i++) {
- if(!(E->node[m][i] & (TBX | TBY | TBZ))){
- DTdot[m][i] *= E->TMass[m][i]; /* lumped mass matrix */
- } else
- DTdot[m][i] = 0.0; /* lumped mass matrix */
- }
-
- return;
-}
-
-
-
-/* ===================================================
- Petrov-Galerkin shape functions for a given element
- =================================================== */
-
-static void pg_shape_fn(struct All_variables *E, int el,
- struct Shape_function *PG,
- struct Shape_function_dx *GNx,
- float VV[4][9], double rtf[4][9],
- double diffusion, int m)
-{
- int i,j;
- int *ienm;
-
- double uc1,uc2,uc3;
- double u1,u2,u3,sint[9];
- double uxse,ueta,ufai,xse,eta,fai,adiff;
-
- double prod1,unorm,twodiff;
-
- ienm=E->ien[m][el].node;
-
- twodiff = 2.0*diffusion;
-
- uc1 = uc2 = uc3 = 0.0;
-
- for(i=1;i<=ENODES3D;i++) {
- uc1 += E->N.ppt[GNPINDEX(i,1)]*VV[1][i];
- uc2 += E->N.ppt[GNPINDEX(i,1)]*VV[2][i];
- uc3 += E->N.ppt[GNPINDEX(i,1)]*VV[3][i];
- }
-
- uxse = fabs(uc1*E->eco[m][el].size[1]);
- ueta = fabs(uc2*E->eco[m][el].size[2]);
- ufai = fabs(uc3*E->eco[m][el].size[3]);
-
- xse = (uxse>twodiff)? (1.0-twodiff/uxse):0.0;
- eta = (ueta>twodiff)? (1.0-twodiff/ueta):0.0;
- fai = (ufai>twodiff)? (1.0-twodiff/ufai):0.0;
-
-
- unorm = uc1*uc1 + uc2*uc2 + uc3*uc3;
-
- adiff = (unorm>0.000001)?( (uxse*xse+ueta*eta+ufai*fai)/(2.0*unorm) ):0.0;
-
- for(i=1;i<=VPOINTS3D;i++)
- sint[i] = rtf[3][i]/sin(rtf[1][i]);
-
- for(i=1;i<=VPOINTS3D;i++) {
- u1 = u2 = u3 = 0.0;
- for(j=1;j<=ENODES3D;j++) /* this line heavily used */ {
- u1 += VV[1][j] * E->N.vpt[GNVINDEX(j,i)];
- u2 += VV[2][j] * E->N.vpt[GNVINDEX(j,i)];
- u3 += VV[3][j] * E->N.vpt[GNVINDEX(j,i)];
- }
-
- for(j=1;j<=ENODES3D;j++) {
- prod1 = (u1 * GNx->vpt[GNVXINDEX(0,j,i)]*rtf[3][i] +
- u2 * GNx->vpt[GNVXINDEX(1,j,i)]*sint[i] +
- u3 * GNx->vpt[GNVXINDEX(2,j,i)] ) ;
-
- PG->vpt[GNVINDEX(j,i)] = E->N.vpt[GNVINDEX(j,i)] + adiff * prod1;
- }
- }
-
- return;
-}
-
-
-
-/* ==========================================
- Residual force vector from heat-transport.
- Used to correct the Tdot term.
- ========================================= */
-
-static void element_residual(struct All_variables *E, int el,
- struct Shape_function *PG,
- struct Shape_function_dx *GNx,
- struct Shape_function_dA *dOmega,
- float VV[4][9],
- double **field, double **fielddot,
- struct SOURCES *Q0,
- double Eres[9], double rtf[4][9],
- double diff, float **BC,
- unsigned int **FLAGS, int m)
-{
- int i,j,a,k,node,nodes[5],d,aid,back_front,onedfns;
- double Q;
- double dT[9];
- double tx1[9],tx2[9],tx3[9],sint[9];
- double v1[9],v2[9],v3[9];
- double adv_dT,t2[4];
- double T,DT;
-
- double prod,sfn;
- struct Shape_function1 GM;
- struct Shape_function1_dA dGamma;
- double temp,rho,cp,heating;
- int nz;
-
- void get_global_1d_shape_fn();
-
- const int dims=E->mesh.nsd;
- const int dofs=E->mesh.dof;
- const int nno=E->lmesh.nno;
- const int lev=E->mesh.levmax;
- const int ends=enodes[dims];
- const int vpts=vpoints[dims];
- const int diffusion = (diff != 0.0);
-
- for(i=1;i<=vpts;i++) {
- dT[i]=0.0;
- v1[i] = tx1[i]= 0.0;
- v2[i] = tx2[i]= 0.0;
- v3[i] = tx3[i]= 0.0;
- }
-
- for(i=1;i<=vpts;i++)
- sint[i] = rtf[3][i]/sin(rtf[1][i]);
-
- for(j=1;j<=ends;j++) {
- node = E->ien[m][el].node[j];
- T = field[m][node];
- if(E->node[m][node] & (TBX | TBY | TBZ))
- DT=0.0;
- else
- DT = fielddot[m][node];
-
- for(i=1;i<=vpts;i++) {
- dT[i] += DT * E->N.vpt[GNVINDEX(j,i)];
- tx1[i] += GNx->vpt[GNVXINDEX(0,j,i)] * T * rtf[3][i];
- tx2[i] += GNx->vpt[GNVXINDEX(1,j,i)] * T * sint[i];
- tx3[i] += GNx->vpt[GNVXINDEX(2,j,i)] * T;
- sfn = E->N.vpt[GNVINDEX(j,i)];
- v1[i] += VV[1][j] * sfn;
- v2[i] += VV[2][j] * sfn;
- v3[i] += VV[3][j] * sfn;
- }
- }
-
-/* Q=0.0;
- for(i=0;i<Q0.number;i++)
- Q += Q0->Q[i] * exp(-Q0->lambda[i] * (E->monitor.elapsed_time+Q0->t_offset));
-*/
-
- /* heat production */
- Q = E->control.Q0;
-
- /* should we add a compositional contribution? */
- if(E->control.tracer_enriched){
- /* XXX: change Q and Q0 to be a vector of ncomp elements */
-
- /* Q = Q0 for C = 0, Q = Q0ER for C = 1, and linearly in
- between */
- Q *= (1.0 - E->composition.comp_el[m][0][el]);
- Q += E->composition.comp_el[m][0][el] * E->control.Q0ER;
- }
-
- nz = ((el-1) % E->lmesh.elz) + 1;
- rho = 0.5 * (E->refstate.rho[nz] + E->refstate.rho[nz+1]);
- cp = 0.5 * (E->refstate.heat_capacity[nz] + E->refstate.heat_capacity[nz+1]);
-
- if(E->control.disptn_number == 0)
- heating = rho * Q;
- else
- /* E->heating_latent is actually the inverse of latent heating */
- heating = (rho * Q - E->heating_adi[m][el] + E->heating_visc[m][el])
- * E->heating_latent[m][el];
-
- /* construct residual from this information */
-
-
- if(diffusion){
- for(j=1;j<=ends;j++) {
- Eres[j]=0.0;
- for(i=1;i<=vpts;i++)
- Eres[j] -=
- PG->vpt[GNVINDEX(j,i)] * dOmega->vpt[i]
- * ((dT[i] + v1[i]*tx1[i] + v2[i]*tx2[i] + v3[i]*tx3[i])*rho*cp
- - heating )
- + diff * dOmega->vpt[i] * E->heating_latent[m][el]
- * (GNx->vpt[GNVXINDEX(0,j,i)]*tx1[i]*rtf[3][i] +
- GNx->vpt[GNVXINDEX(1,j,i)]*tx2[i]*sint[i] +
- GNx->vpt[GNVXINDEX(2,j,i)]*tx3[i] );
- }
- }
-
- else { /* no diffusion term */
- for(j=1;j<=ends;j++) {
- Eres[j]=0.0;
- for(i=1;i<=vpts;i++)
- Eres[j] -= PG->vpt[GNVINDEX(j,i)] * dOmega->vpt[i]
- * (dT[i] - heating + v1[i]*tx1[i] + v2[i]*tx2[i] + v3[i]*tx3[i]);
- }
- }
-
- /* See brooks etc: the diffusive term is excused upwinding for
- rectangular elements */
-
- /* include BC's for fluxes at (nominally horizontal) edges (X-Y plane) */
-
- if(FLAGS!=NULL) {
- onedfns=0;
- for(a=1;a<=ends;a++)
- if (FLAGS[m][E->ien[m][el].node[a]] & FBZ) {
- if (!onedfns++) get_global_1d_shape_fn(E,el,&GM,&dGamma,1,m);
-
- nodes[1] = loc[loc[a].node_nebrs[0][0]].node_nebrs[2][0];
- nodes[2] = loc[loc[a].node_nebrs[0][1]].node_nebrs[2][0];
- nodes[4] = loc[loc[a].node_nebrs[0][0]].node_nebrs[2][1];
- nodes[3] = loc[loc[a].node_nebrs[0][1]].node_nebrs[2][1];
-
- for(aid=0,j=1;j<=onedvpoints[E->mesh.nsd];j++)
- if (a==nodes[j])
- aid = j;
- if(aid==0)
- printf("%d: mixed up in pg-flux int: looking for %d\n",el,a);
-
- if (loc[a].plus[1] != 0)
- back_front = 0;
- else back_front = 1;
-
- for(j=1;j<=onedvpoints[dims];j++)
- for(k=1;k<=onedvpoints[dims];k++)
- Eres[a] += dGamma.vpt[GMVGAMMA(back_front,j)] *
- E->M.vpt[GMVINDEX(aid,j)] * g_1d[j].weight[dims-1] *
- BC[2][E->ien[m][el].node[a]] * E->M.vpt[GMVINDEX(k,j)];
- }
- }
-
- return;
-}
-
-
-/* This function filters the temperature field. The temperature above */
-/* Tmax0(==1.0) and Tmin0(==0.0) is removed, while conserving the total */
-/* energy. See Lenardic and Kaula, JGR, 1993. */
-static void filter(struct All_variables *E)
-{
- double Tsum0,Tmin,Tmax,Tsum1,TDIST,TDIST1;
- int m,i;
- double Tmax1,Tmin1;
- double *rhocp, sum_rhocp, total_sum_rhocp;
- int lev, nz;
-
- /* min and max temperature for filtering */
- const double Tmin0 = 0.0;
- const double Tmax0 = 1.0;
-
- Tsum0= Tsum1= 0.0;
- Tmin= Tmax= 0.0;
- Tmin1= Tmax1= 0.0;
- TDIST= TDIST1= 0.0;
- sum_rhocp = 0.0;
-
- lev=E->mesh.levmax;
-
- rhocp = (double *)malloc((E->lmesh.noz+1)*sizeof(double));
- for(i=1;i<=E->lmesh.noz;i++)
- rhocp[i] = E->refstate.rho[i] * E->refstate.heat_capacity[i];
-
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=1;i<=E->lmesh.nno;i++) {
- nz = ((i-1) % E->lmesh.noz) + 1;
-
- /* compute sum(rho*cp*T) before filtering, skipping nodes
- that's shared by another processor */
- if(!(E->NODE[lev][m][i] & SKIP))
- Tsum0 += E->T[m][i]*rhocp[nz];
-
- /* remove overshoot */
- if(E->T[m][i]<Tmin) Tmin=E->T[m][i];
- if(E->T[m][i]<Tmin0) E->T[m][i]=Tmin0;
- if(E->T[m][i]>Tmax) Tmax=E->T[m][i];
- if(E->T[m][i]>Tmax0) E->T[m][i]=Tmax0;
-
- }
-
- /* find global max/min of temperature */
- MPI_Allreduce(&Tmin,&Tmin1,1,MPI_DOUBLE,MPI_MIN,E->parallel.world);
- MPI_Allreduce(&Tmax,&Tmax1,1,MPI_DOUBLE,MPI_MAX,E->parallel.world);
-
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=1;i<=E->lmesh.nno;i++) {
- nz = ((i-1) % E->lmesh.noz) + 1;
-
- /* remvoe undershoot */
- if(E->T[m][i]<=fabs(2*Tmin0-Tmin1)) E->T[m][i]=Tmin0;
- if(E->T[m][i]>=(2*Tmax0-Tmax1)) E->T[m][i]=Tmax0;
-
- /* sum(rho*cp*T) after filtering */
- if (!(E->NODE[lev][m][i] & SKIP)) {
- Tsum1 += E->T[m][i]*rhocp[nz];
- if(E->T[m][i]!=Tmin0 && E->T[m][i]!=Tmax0) {
- sum_rhocp += rhocp[nz];
- }
-
- }
-
- }
-
- /* find the difference of sum(rho*cp*T) before/after the filtering */
- TDIST=Tsum0-Tsum1;
- MPI_Allreduce(&TDIST,&TDIST1,1,MPI_DOUBLE,MPI_SUM,E->parallel.world);
- MPI_Allreduce(&sum_rhocp,&total_sum_rhocp,1,MPI_DOUBLE,MPI_SUM,E->parallel.world);
- TDIST=TDIST1/total_sum_rhocp;
-
- /* keep sum(rho*cp*T) the same before/after the filtering by distributing
- the difference back to nodes */
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=1;i<=E->lmesh.nno;i++) {
- if(E->T[m][i]!=Tmin0 && E->T[m][i]!=Tmax0)
- E->T[m][i] +=TDIST;
- }
-
- free(rhocp);
- return;
-}
-
-
-static void process_visc_heating(struct All_variables *E, int m,
- double *heating)
-{
- void strain_rate_2_inv();
- int e, i;
- double visc, temp;
- float *strain_sqr;
- const int vpts = VPOINTS3D;
-
- strain_sqr = (float*) malloc((E->lmesh.nel+1)*sizeof(float));
- temp = E->control.disptn_number / E->control.Atemp / vpts;
-
- strain_rate_2_inv(E, m, strain_sqr, 0);
-
- for(e=1; e<=E->lmesh.nel; e++) {
- visc = 0.0;
- for(i = 1; i <= vpts; i++)
- visc += E->EVi[m][(e-1)*vpts + i];
-
- heating[e] = temp * visc * strain_sqr[e];
- }
-
- free(strain_sqr);
-
- return;
-}
-
-
-static void process_adi_heating(struct All_variables *E, int m,
- double *heating)
-{
- int e, ez, i, j;
- double matprop, temp1, temp2;
- const int ends = ENODES3D;
-
- temp2 = E->control.disptn_number / ends;
- for(e=1; e<=E->lmesh.nel; e++) {
- ez = (e - 1) % E->lmesh.elz + 1;
- matprop = 0.125
- * (E->refstate.thermal_expansivity[ez] +
- E->refstate.thermal_expansivity[ez + 1])
- * (E->refstate.rho[ez] + E->refstate.rho[ez + 1])
- * (E->refstate.gravity[ez] + E->refstate.gravity[ez + 1]);
-
- temp1 = 0.0;
- for(i=1; i<=ends; i++) {
- j = E->ien[m][e].node[i];
- temp1 += E->sphere.cap[m].V[3][j]
- * (E->T[m][j] + E->control.surface_temp);
- }
-
- heating[e] = matprop * temp1 * temp2;
- }
-
- return;
-}
-
-
-static void latent_heating(struct All_variables *E, int m,
- double *heating_latent, double *heating_adi,
- float **B, float Ra, float clapeyron,
- float depth, float transT, float inv_width)
-{
- double temp, temp0, temp1, temp2, temp3, matprop;
- int e, ez, i, j;
- const int ends = ENODES3D;
-
- temp0 = 2.0 * inv_width * clapeyron * E->control.disptn_number * Ra / E->control.Atemp / ends;
- temp1 = temp0 * clapeyron;
-
- for(e=1; e<=E->lmesh.nel; e++) {
- ez = (e - 1) % E->lmesh.elz + 1;
- matprop = 0.125
- * (E->refstate.thermal_expansivity[ez] +
- E->refstate.thermal_expansivity[ez + 1])
- * (E->refstate.rho[ez] + E->refstate.rho[ez + 1])
- * (E->refstate.gravity[ez] + E->refstate.gravity[ez + 1]);
-
- temp2 = 0;
- temp3 = 0;
- for(i=1; i<=ends; i++) {
- j = E->ien[m][e].node[i];
- temp = (1.0 - B[m][j]) * B[m][j]
- * (E->T[m][j] + E->control.surface_temp);
- temp2 += temp * E->sphere.cap[m].V[3][j];
- temp3 += temp;
- }
-
- /* correction on the adiabatic cooling term */
- heating_adi[e] += matprop * temp2 * temp0;
-
- /* correction on the DT/Dt term */
- heating_latent[e] += temp3 * temp1;
- }
- return;
-}
-
-
-static void process_latent_heating(struct All_variables *E, int m,
- double *heating_latent, double *heating_adi)
-{
- int e;
-
- /* reset */
- for(e=1; e<=E->lmesh.nel; e++)
- heating_latent[e] = 1.0;
-
- if(E->control.Ra_410 != 0.0) {
- latent_heating(E, m, heating_latent, heating_adi,
- E->Fas410, E->control.Ra_410,
- E->control.clapeyron410, E->viscosity.z410,
- E->control.transT410, E->control.inv_width410);
-
- }
-
- if(E->control.Ra_670 != 0.0) {
- latent_heating(E, m, heating_latent, heating_adi,
- E->Fas670, E->control.Ra_670,
- E->control.clapeyron670, E->viscosity.zlm,
- E->control.transT670, E->control.inv_width670);
- }
-
- if(E->control.Ra_cmb != 0.0) {
- latent_heating(E, m, heating_latent, heating_adi,
- E->Fascmb, E->control.Ra_cmb,
- E->control.clapeyroncmb, E->viscosity.zcmb,
- E->control.transTcmb, E->control.inv_widthcmb);
- }
-
-
- if(E->control.Ra_410 != 0 || E->control.Ra_670 != 0.0 ||
- E->control.Ra_cmb != 0) {
- for(e=1; e<=E->lmesh.nel; e++)
- heating_latent[e] = 1.0 / heating_latent[e];
- }
-
- return;
-}
-
-
-static double total_heating(struct All_variables *E, double **heating)
-{
- int m, e;
- double sum, total;
-
- /* sum up within each processor */
- sum = 0;
- for(m=1; m<=E->sphere.caps_per_proc; m++) {
- for(e=1; e<=E->lmesh.nel; e++)
- sum += heating[m][e] * E->eco[m][e].area;
- }
-
- /* sum up for all processors */
- MPI_Allreduce(&sum, &total, 1,
- MPI_DOUBLE, MPI_SUM, E->parallel.world);
-
- return total;
-}
-
-
-static void process_heating(struct All_variables *E, int psc_pass)
-{
- int m;
- double total_visc_heating, total_adi_heating;
-
- for(m=1; m<=E->sphere.caps_per_proc; m++) {
- if(psc_pass == 0) {
- /* visc heating does not change between psc_pass, compute only
- * at first psc_pass */
- process_visc_heating(E, m, E->heating_visc[m]);
- }
- process_adi_heating(E, m, E->heating_adi[m]);
- process_latent_heating(E, m, E->heating_latent[m], E->heating_adi[m]);
- }
-
- /* compute total amount of visc/adi heating over all processors
- * only at last psc_pass */
- if(psc_pass == (E->advection.temp_iterations-1)) {
- total_visc_heating = total_heating(E, E->heating_visc);
- total_adi_heating = total_heating(E, E->heating_adi);
-
- if(E->parallel.me == 0) {
- fprintf(E->fp, "Step: %d, Total_heating(visc, adi): %g %g\n",
- E->monitor.solution_cycles,
- total_visc_heating, total_adi_heating);
- fprintf(stderr, "Step: %d, Total_heating(visc, adi): %g %g\n",
- E->monitor.solution_cycles,
- total_visc_heating, total_adi_heating);
- }
- }
-
- return;
-}
Copied: mc/3D/CitcomS/branches/cxx/lib/Advection_diffusion.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Advection_diffusion.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Advection_diffusion.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Advection_diffusion.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,947 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+/* Functions which solve the heat transport equations using Petrov-Galerkin
+ streamline-upwind methods. The process is basically as described in Alex
+ Brooks PhD thesis (Caltech) which refers back to Hughes, Liu and Brooks. */
+
+#include <sys/types.h>
+
+#include "element_definitions.h"
+#include "global_defs.h"
+#include <math.h>
+#include "advection_diffusion.h"
+#include "parsing.h"
+
+#include "cproto.h"
+
+
+static void set_diffusion_timestep(struct All_variables *E);
+static void predictor(struct All_variables *E, double **field,
+ double **fielddot);
+static void corrector(struct All_variables *E, double **field,
+ double **fielddot, double **Dfielddot);
+static void pg_solver(struct All_variables *E,
+ double **T, double **Tdot, double **DTdot,
+ struct All_variables::CONVECTION::SOURCES *Q0,
+ double diff, int bc, unsigned int **FLAGS);
+static void pg_shape_fn(struct All_variables *E, int el,
+ struct Shape_function *PG,
+ struct Shape_function_dx *GNx,
+ float VV[4][9], double rtf[4][9],
+ double diffusion, int m);
+static void element_residual(struct All_variables *E, int el,
+ struct Shape_function *PG,
+ struct Shape_function_dx *GNx,
+ struct Shape_function_dA *dOmega,
+ float VV[4][9],
+ double **field, double **fielddot,
+ struct All_variables::CONVECTION::SOURCES *Q0,
+ double Eres[9], double rtf[4][9],
+ double diff, float **BC,
+ unsigned int **FLAGS, int m);
+static void filter(struct All_variables *E);
+static void process_heating(struct All_variables *E, int psc_pass);
+
+/* ============================================
+ Generic adv-diffusion for temperature field.
+ ============================================ */
+
+
+/***************************************************************/
+
+void advection_diffusion_parameters(struct All_variables *E)
+{
+
+ /* Set intial values, defaults & read parameters*/
+ int m=E->parallel.me;
+
+ input_boolean("ADV",&(E->advection.ADVECTION),"on",m);
+ input_boolean("filter_temp",&(E->advection.filter_temperature),"off",m);
+ input_boolean("monitor_max_T",&(E->advection.monitor_max_T),"on",m);
+
+ input_int("minstep",&(E->advection.min_timesteps),"1",m);
+ input_int("maxstep",&(E->advection.max_timesteps),"1000",m);
+ input_int("maxtotstep",&(E->advection.max_total_timesteps),"1000000",m);
+ input_float("finetunedt",&(E->advection.fine_tune_dt),"0.9",m);
+ input_float("fixed_timestep",&(E->advection.fixed_timestep),"0.0",m);
+ input_float("adv_gamma",&(E->advection.gamma),"0.5",m);
+ input_int("adv_sub_iterations",&(E->advection.temp_iterations),"2,1,nomax",m);
+
+ input_float("inputdiffusivity",&(E->control.inputdiff),"1.0",m);
+
+
+ return;
+}
+
+
+void advection_diffusion_allocate_memory(struct All_variables *E)
+{
+ int i,m;
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+ E->Tdot[m]= (double *)malloc((E->lmesh.nno+1)*sizeof(double));
+
+ for(i=1;i<=E->lmesh.nno;i++)
+ E->Tdot[m][i]=0.0;
+ }
+
+ return;
+}
+
+
+void PG_timestep_init(struct All_variables *E)
+{
+
+ set_diffusion_timestep(E);
+
+ return;
+}
+
+
+void PG_timestep(struct All_variables *E)
+{
+ std_timestep(E);
+
+ PG_timestep_solve(E);
+
+ return;
+}
+
+
+
+/* =====================================================
+ Obtain largest possible timestep (no melt considered)
+ ===================================================== */
+
+
+void std_timestep(struct All_variables *E)
+{
+ int i,d,n,nel,el,node,m;
+
+ float adv_timestep;
+ float ts,uc1,uc2,uc3,uc,size,step,VV[4][9];
+
+ const int dims=E->mesh.nsd;
+ const int dofs=E->mesh.dof;
+ const int nno=E->lmesh.nno;
+ const int lev=E->mesh.levmax;
+ const int ends=enodes[dims];
+ const int sphere_key = 1;
+
+ nel=E->lmesh.nel;
+
+ if(E->advection.fixed_timestep != 0.0) {
+ E->advection.timestep = E->advection.fixed_timestep;
+ return;
+ }
+
+ adv_timestep = 1.0e8;
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(el=1;el<=nel;el++) {
+
+ velo_from_element(E,VV,m,el,sphere_key);
+
+ uc=uc1=uc2=uc3=0.0;
+ for(i=1;i<=ENODES3D;i++) {
+ uc1 += E->N.ppt[GNPINDEX(i,1)]*VV[1][i];
+ uc2 += E->N.ppt[GNPINDEX(i,1)]*VV[2][i];
+ uc3 += E->N.ppt[GNPINDEX(i,1)]*VV[3][i];
+ }
+ uc = fabs(uc1)/E->eco[m][el].size[1] + fabs(uc2)/E->eco[m][el].size[2] + fabs(uc3)/E->eco[m][el].size[3];
+
+ step = (0.5/uc);
+ adv_timestep = min(adv_timestep,step);
+ }
+
+ adv_timestep = E->advection.dt_reduced * adv_timestep;
+
+ adv_timestep = 1.0e-32 + min(E->advection.fine_tune_dt*adv_timestep,
+ E->advection.diff_timestep);
+
+ E->advection.timestep = global_fmin(E,adv_timestep);
+
+/* if (E->parallel.me==0) */
+/* fprintf(stderr, "adv_timestep=%g diff_timestep=%g\n",adv_timestep,E->advection.diff_timestep); */
+
+ return;
+}
+
+
+void PG_timestep_solve(struct All_variables *E)
+{
+
+ int i,m,psc_pass,iredo;
+ double time0,time1,T_interior1;
+ double *DTdot[NCS], *T1[NCS], *Tdot1[NCS];
+
+ E->advection.timesteps++;
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ DTdot[m]= (double *)malloc((E->lmesh.nno+1)*sizeof(double));
+
+
+ if(E->advection.monitor_max_T) {
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+ T1[m]= (double *)malloc((E->lmesh.nno+1)*sizeof(double));
+ Tdot1[m]= (double *)malloc((E->lmesh.nno+1)*sizeof(double));
+ }
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for (i=1;i<=E->lmesh.nno;i++) {
+ T1[m][i] = E->T[m][i];
+ Tdot1[m][i] = E->Tdot[m][i];
+ }
+
+ /* get the max temperature for old T */
+ T_interior1 = Tmaxd(E,E->T);
+ }
+
+ E->advection.dt_reduced = 1.0;
+ E->advection.last_sub_iterations = 1;
+
+
+ do {
+ E->advection.timestep *= E->advection.dt_reduced;
+
+ iredo = 0;
+ if (E->advection.ADVECTION) {
+
+ predictor(E,E->T,E->Tdot);
+
+ for(psc_pass=0;psc_pass<E->advection.temp_iterations;psc_pass++) {
+ /* adiabatic, dissipative and latent heating*/
+ if(E->control.disptn_number != 0)
+ process_heating(E, psc_pass);
+
+ /* XXX: replace inputdiff with refstate.thermal_conductivity */
+ pg_solver(E,E->T,E->Tdot,DTdot,&(E->convection.heat_sources),E->control.inputdiff,1,E->node);
+ corrector(E,E->T,E->Tdot,DTdot);
+ temperatures_conform_bcs(E);
+ }
+
+ if(E->advection.monitor_max_T) {
+ /* get the max temperature for new T */
+ E->monitor.T_interior = Tmaxd(E,E->T);
+
+ /* if the max temperature changes too much, restore the old
+ * temperature field, calling the temperature solver using
+ * half of the timestep size */
+ if (E->monitor.T_interior/T_interior1 > E->monitor.T_maxvaried) {
+ if(E->parallel.me==0) {
+ fprintf(stderr, "max T varied from %e to %e\n",
+ T_interior1, E->monitor.T_interior);
+ fprintf(E->fp, "max T varied from %e to %e\n",
+ T_interior1, E->monitor.T_interior);
+ }
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for (i=1;i<=E->lmesh.nno;i++) {
+ E->T[m][i] = T1[m][i];
+ E->Tdot[m][i] = Tdot1[m][i];
+ }
+ iredo = 1;
+ E->advection.dt_reduced *= 0.5;
+ E->advection.last_sub_iterations ++;
+ }
+ }
+ }
+
+ } while ( iredo==1 && E->advection.last_sub_iterations <= 5);
+
+
+ /* filter temperature to remove over-/under-shoot */
+ if(E->advection.filter_temperature)
+ filter(E);
+
+
+ E->advection.total_timesteps++;
+ E->monitor.elapsed_time += E->advection.timestep;
+
+ if (E->advection.last_sub_iterations==5)
+ E->control.keep_going = 0;
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+ free((void *) DTdot[m] );
+ }
+
+ if(E->advection.monitor_max_T) {
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+ free((void *) T1[m] );
+ free((void *) Tdot1[m] );
+ }
+ }
+
+ if(E->control.lith_age) {
+ if(E->parallel.me==0) fprintf(stderr,"PG_timestep_solve\n");
+ lith_age_conform_tbc(E);
+ assimilate_lith_conform_bcs(E);
+ }
+
+
+ return;
+}
+
+
+/***************************************************************/
+
+static void set_diffusion_timestep(struct All_variables *E)
+{
+ float diff_timestep, ts;
+ int m, el, d;
+
+ diff_timestep = 1.0e8;
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(el=1;el<=E->lmesh.nel;el++) {
+ for(d=1;d<=E->mesh.nsd;d++) {
+ ts = E->eco[m][el].size[d] * E->eco[m][el].size[d];
+ diff_timestep = min(diff_timestep,ts);
+ }
+ }
+
+ diff_timestep = global_fmin(E,diff_timestep);
+ E->advection.diff_timestep = 0.5 * diff_timestep;
+
+ return;
+}
+
+
+/* ==============================
+ predictor and corrector steps.
+ ============================== */
+
+static void predictor(struct All_variables *E, double **field,
+ double **fielddot)
+{
+ int node,m;
+ double multiplier;
+
+ multiplier = (1.0-E->advection.gamma) * E->advection.timestep;
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for(node=1;node<=E->lmesh.nno;node++) {
+ field[m][node] += multiplier * fielddot[m][node] ;
+ fielddot[m][node] = 0.0;
+ }
+
+ return;
+}
+
+
+static void corrector(struct All_variables *E, double **field,
+ double **fielddot, double **Dfielddot)
+{
+ int node,m;
+ double multiplier;
+
+ multiplier = E->advection.gamma * E->advection.timestep;
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for(node=1;node<=E->lmesh.nno;node++) {
+ field[m][node] += multiplier * Dfielddot[m][node];
+ fielddot[m][node] += Dfielddot[m][node];
+ }
+
+ return;
+}
+
+
+/* ===================================================
+ The solution step -- determine residual vector from
+ advective-diffusive terms and solve for delta Tdot
+ Two versions are available -- one for Cray-style
+ vector optimizations etc and one optimized for
+ workstations.
+ =================================================== */
+
+
+static void pg_solver(struct All_variables *E,
+ double **T, double **Tdot, double **DTdot,
+ struct All_variables::CONVECTION::SOURCES *Q0,
+ double diff, int bc, unsigned int **FLAGS)
+{
+ int el,e,a,i,a1,m;
+ double Eres[9],rtf[4][9]; /* correction to the (scalar) Tdot field */
+ float VV[4][9];
+
+ struct Shape_function PG;
+
+ const int dims=E->mesh.nsd;
+ const int dofs=E->mesh.dof;
+ const int ends=enodes[dims];
+ const int sphere_key = 1;
+ const int lev=E->mesh.levmax;
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=1;i<=E->lmesh.nno;i++)
+ DTdot[m][i] = 0.0;
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for(el=1;el<=E->lmesh.nel;el++) {
+
+ velo_from_element(E,VV,m,el,sphere_key);
+
+ get_rtf_at_vpts(E, m, lev, el, rtf);
+
+ /* XXX: replace diff with refstate.thermal_conductivity */
+ pg_shape_fn(E, el, &PG, &(E->gNX[m][el]), VV,
+ rtf, diff, m);
+ element_residual(E, el, &PG, &(E->gNX[m][el]), &(E->gDA[m][el]),
+ VV, T, Tdot,
+ Q0, Eres, rtf, diff, E->sphere.cap[m].TB,
+ FLAGS, m);
+
+ for(a=1;a<=ends;a++) {
+ a1 = E->ien[m][el].node[a];
+ DTdot[m][a1] += Eres[a];
+ }
+
+ } /* next element */
+
+ (E->exchange_node_d)(E,DTdot,lev);
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=1;i<=E->lmesh.nno;i++) {
+ if(!(E->node[m][i] & (TBX | TBY | TBZ))){
+ DTdot[m][i] *= E->TMass[m][i]; /* lumped mass matrix */
+ } else
+ DTdot[m][i] = 0.0; /* lumped mass matrix */
+ }
+
+ return;
+}
+
+
+
+/* ===================================================
+ Petrov-Galerkin shape functions for a given element
+ =================================================== */
+
+static void pg_shape_fn(struct All_variables *E, int el,
+ struct Shape_function *PG,
+ struct Shape_function_dx *GNx,
+ float VV[4][9], double rtf[4][9],
+ double diffusion, int m)
+{
+ int i,j;
+ int *ienm;
+
+ double uc1,uc2,uc3;
+ double u1,u2,u3,sint[9];
+ double uxse,ueta,ufai,xse,eta,fai,adiff;
+
+ double prod1,unorm,twodiff;
+
+ ienm=E->ien[m][el].node;
+
+ twodiff = 2.0*diffusion;
+
+ uc1 = uc2 = uc3 = 0.0;
+
+ for(i=1;i<=ENODES3D;i++) {
+ uc1 += E->N.ppt[GNPINDEX(i,1)]*VV[1][i];
+ uc2 += E->N.ppt[GNPINDEX(i,1)]*VV[2][i];
+ uc3 += E->N.ppt[GNPINDEX(i,1)]*VV[3][i];
+ }
+
+ uxse = fabs(uc1*E->eco[m][el].size[1]);
+ ueta = fabs(uc2*E->eco[m][el].size[2]);
+ ufai = fabs(uc3*E->eco[m][el].size[3]);
+
+ xse = (uxse>twodiff)? (1.0-twodiff/uxse):0.0;
+ eta = (ueta>twodiff)? (1.0-twodiff/ueta):0.0;
+ fai = (ufai>twodiff)? (1.0-twodiff/ufai):0.0;
+
+
+ unorm = uc1*uc1 + uc2*uc2 + uc3*uc3;
+
+ adiff = (unorm>0.000001)?( (uxse*xse+ueta*eta+ufai*fai)/(2.0*unorm) ):0.0;
+
+ for(i=1;i<=VPOINTS3D;i++)
+ sint[i] = rtf[3][i]/sin(rtf[1][i]);
+
+ for(i=1;i<=VPOINTS3D;i++) {
+ u1 = u2 = u3 = 0.0;
+ for(j=1;j<=ENODES3D;j++) /* this line heavily used */ {
+ u1 += VV[1][j] * E->N.vpt[GNVINDEX(j,i)];
+ u2 += VV[2][j] * E->N.vpt[GNVINDEX(j,i)];
+ u3 += VV[3][j] * E->N.vpt[GNVINDEX(j,i)];
+ }
+
+ for(j=1;j<=ENODES3D;j++) {
+ prod1 = (u1 * GNx->vpt[GNVXINDEX(0,j,i)]*rtf[3][i] +
+ u2 * GNx->vpt[GNVXINDEX(1,j,i)]*sint[i] +
+ u3 * GNx->vpt[GNVXINDEX(2,j,i)] ) ;
+
+ PG->vpt[GNVINDEX(j,i)] = E->N.vpt[GNVINDEX(j,i)] + adiff * prod1;
+ }
+ }
+
+ return;
+}
+
+
+
+/* ==========================================
+ Residual force vector from heat-transport.
+ Used to correct the Tdot term.
+ ========================================= */
+
+static void element_residual(struct All_variables *E, int el,
+ struct Shape_function *PG,
+ struct Shape_function_dx *GNx,
+ struct Shape_function_dA *dOmega,
+ float VV[4][9],
+ double **field, double **fielddot,
+ struct All_variables::CONVECTION::SOURCES *Q0,
+ double Eres[9], double rtf[4][9],
+ double diff, float **BC,
+ unsigned int **FLAGS, int m)
+{
+ int i,j,a,k,node,nodes[5],d,aid,back_front,onedfns;
+ double Q;
+ double dT[9];
+ double tx1[9],tx2[9],tx3[9],sint[9];
+ double v1[9],v2[9],v3[9];
+ double adv_dT,t2[4];
+ double T,DT;
+
+ double prod,sfn;
+ struct Shape_function1 GM;
+ struct Shape_function1_dA dGamma;
+ double temp,rho,cp,heating;
+ int nz;
+
+ const int dims=E->mesh.nsd;
+ const int dofs=E->mesh.dof;
+ const int nno=E->lmesh.nno;
+ const int lev=E->mesh.levmax;
+ const int ends=enodes[dims];
+ const int vpts=vpoints[dims];
+ const int diffusion = (diff != 0.0);
+
+ for(i=1;i<=vpts;i++) {
+ dT[i]=0.0;
+ v1[i] = tx1[i]= 0.0;
+ v2[i] = tx2[i]= 0.0;
+ v3[i] = tx3[i]= 0.0;
+ }
+
+ for(i=1;i<=vpts;i++)
+ sint[i] = rtf[3][i]/sin(rtf[1][i]);
+
+ for(j=1;j<=ends;j++) {
+ node = E->ien[m][el].node[j];
+ T = field[m][node];
+ if(E->node[m][node] & (TBX | TBY | TBZ))
+ DT=0.0;
+ else
+ DT = fielddot[m][node];
+
+ for(i=1;i<=vpts;i++) {
+ dT[i] += DT * E->N.vpt[GNVINDEX(j,i)];
+ tx1[i] += GNx->vpt[GNVXINDEX(0,j,i)] * T * rtf[3][i];
+ tx2[i] += GNx->vpt[GNVXINDEX(1,j,i)] * T * sint[i];
+ tx3[i] += GNx->vpt[GNVXINDEX(2,j,i)] * T;
+ sfn = E->N.vpt[GNVINDEX(j,i)];
+ v1[i] += VV[1][j] * sfn;
+ v2[i] += VV[2][j] * sfn;
+ v3[i] += VV[3][j] * sfn;
+ }
+ }
+
+/* Q=0.0;
+ for(i=0;i<Q0.number;i++)
+ Q += Q0->Q[i] * exp(-Q0->lambda[i] * (E->monitor.elapsed_time+Q0->t_offset));
+*/
+
+ /* heat production */
+ Q = E->control.Q0;
+
+ /* should we add a compositional contribution? */
+ if(E->control.tracer_enriched){
+ /* XXX: change Q and Q0 to be a vector of ncomp elements */
+
+ /* Q = Q0 for C = 0, Q = Q0ER for C = 1, and linearly in
+ between */
+ Q *= (1.0 - E->composition.comp_el[m][0][el]);
+ Q += E->composition.comp_el[m][0][el] * E->control.Q0ER;
+ }
+
+ nz = ((el-1) % E->lmesh.elz) + 1;
+ rho = 0.5 * (E->refstate.rho[nz] + E->refstate.rho[nz+1]);
+ cp = 0.5 * (E->refstate.heat_capacity[nz] + E->refstate.heat_capacity[nz+1]);
+
+ if(E->control.disptn_number == 0)
+ heating = rho * Q;
+ else
+ /* E->heating_latent is actually the inverse of latent heating */
+ heating = (rho * Q - E->heating_adi[m][el] + E->heating_visc[m][el])
+ * E->heating_latent[m][el];
+
+ /* construct residual from this information */
+
+
+ if(diffusion){
+ for(j=1;j<=ends;j++) {
+ Eres[j]=0.0;
+ for(i=1;i<=vpts;i++)
+ Eres[j] -=
+ PG->vpt[GNVINDEX(j,i)] * dOmega->vpt[i]
+ * ((dT[i] + v1[i]*tx1[i] + v2[i]*tx2[i] + v3[i]*tx3[i])*rho*cp
+ - heating )
+ + diff * dOmega->vpt[i] * E->heating_latent[m][el]
+ * (GNx->vpt[GNVXINDEX(0,j,i)]*tx1[i]*rtf[3][i] +
+ GNx->vpt[GNVXINDEX(1,j,i)]*tx2[i]*sint[i] +
+ GNx->vpt[GNVXINDEX(2,j,i)]*tx3[i] );
+ }
+ }
+
+ else { /* no diffusion term */
+ for(j=1;j<=ends;j++) {
+ Eres[j]=0.0;
+ for(i=1;i<=vpts;i++)
+ Eres[j] -= PG->vpt[GNVINDEX(j,i)] * dOmega->vpt[i]
+ * (dT[i] - heating + v1[i]*tx1[i] + v2[i]*tx2[i] + v3[i]*tx3[i]);
+ }
+ }
+
+ /* See brooks etc: the diffusive term is excused upwinding for
+ rectangular elements */
+
+ /* include BC's for fluxes at (nominally horizontal) edges (X-Y plane) */
+
+ if(FLAGS!=NULL) {
+ onedfns=0;
+ for(a=1;a<=ends;a++)
+ if (FLAGS[m][E->ien[m][el].node[a]] & FBZ) {
+ if (!onedfns++) get_global_1d_shape_fn(E,el,&GM,&dGamma,1,m);
+
+ nodes[1] = loc[loc[a].node_nebrs[0][0]].node_nebrs[2][0];
+ nodes[2] = loc[loc[a].node_nebrs[0][1]].node_nebrs[2][0];
+ nodes[4] = loc[loc[a].node_nebrs[0][0]].node_nebrs[2][1];
+ nodes[3] = loc[loc[a].node_nebrs[0][1]].node_nebrs[2][1];
+
+ for(aid=0,j=1;j<=onedvpoints[E->mesh.nsd];j++)
+ if (a==nodes[j])
+ aid = j;
+ if(aid==0)
+ printf("%d: mixed up in pg-flux int: looking for %d\n",el,a);
+
+ if (loc[a].plus[1] != 0)
+ back_front = 0;
+ else back_front = 1;
+
+ for(j=1;j<=onedvpoints[dims];j++)
+ for(k=1;k<=onedvpoints[dims];k++)
+ Eres[a] += dGamma.vpt[GMVGAMMA(back_front,j)] *
+ E->M.vpt[GMVINDEX(aid,j)] * g_1d[j].weight[dims-1] *
+ BC[2][E->ien[m][el].node[a]] * E->M.vpt[GMVINDEX(k,j)];
+ }
+ }
+
+ return;
+}
+
+
+/* This function filters the temperature field. The temperature above */
+/* Tmax0(==1.0) and Tmin0(==0.0) is removed, while conserving the total */
+/* energy. See Lenardic and Kaula, JGR, 1993. */
+static void filter(struct All_variables *E)
+{
+ double Tsum0,Tmin,Tmax,Tsum1,TDIST,TDIST1;
+ int m,i;
+ double Tmax1,Tmin1;
+ double *rhocp, sum_rhocp, total_sum_rhocp;
+ int lev, nz;
+
+ /* min and max temperature for filtering */
+ const double Tmin0 = 0.0;
+ const double Tmax0 = 1.0;
+
+ Tsum0= Tsum1= 0.0;
+ Tmin= Tmax= 0.0;
+ Tmin1= Tmax1= 0.0;
+ TDIST= TDIST1= 0.0;
+ sum_rhocp = 0.0;
+
+ lev=E->mesh.levmax;
+
+ rhocp = (double *)malloc((E->lmesh.noz+1)*sizeof(double));
+ for(i=1;i<=E->lmesh.noz;i++)
+ rhocp[i] = E->refstate.rho[i] * E->refstate.heat_capacity[i];
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=1;i<=E->lmesh.nno;i++) {
+ nz = ((i-1) % E->lmesh.noz) + 1;
+
+ /* compute sum(rho*cp*T) before filtering, skipping nodes
+ that's shared by another processor */
+ if(!(E->NODE[lev][m][i] & SKIP))
+ Tsum0 += E->T[m][i]*rhocp[nz];
+
+ /* remove overshoot */
+ if(E->T[m][i]<Tmin) Tmin=E->T[m][i];
+ if(E->T[m][i]<Tmin0) E->T[m][i]=Tmin0;
+ if(E->T[m][i]>Tmax) Tmax=E->T[m][i];
+ if(E->T[m][i]>Tmax0) E->T[m][i]=Tmax0;
+
+ }
+
+ /* find global max/min of temperature */
+ MPI_Allreduce(&Tmin,&Tmin1,1,MPI_DOUBLE,MPI_MIN,E->parallel.world);
+ MPI_Allreduce(&Tmax,&Tmax1,1,MPI_DOUBLE,MPI_MAX,E->parallel.world);
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=1;i<=E->lmesh.nno;i++) {
+ nz = ((i-1) % E->lmesh.noz) + 1;
+
+ /* remvoe undershoot */
+ if(E->T[m][i]<=fabs(2*Tmin0-Tmin1)) E->T[m][i]=Tmin0;
+ if(E->T[m][i]>=(2*Tmax0-Tmax1)) E->T[m][i]=Tmax0;
+
+ /* sum(rho*cp*T) after filtering */
+ if (!(E->NODE[lev][m][i] & SKIP)) {
+ Tsum1 += E->T[m][i]*rhocp[nz];
+ if(E->T[m][i]!=Tmin0 && E->T[m][i]!=Tmax0) {
+ sum_rhocp += rhocp[nz];
+ }
+
+ }
+
+ }
+
+ /* find the difference of sum(rho*cp*T) before/after the filtering */
+ TDIST=Tsum0-Tsum1;
+ MPI_Allreduce(&TDIST,&TDIST1,1,MPI_DOUBLE,MPI_SUM,E->parallel.world);
+ MPI_Allreduce(&sum_rhocp,&total_sum_rhocp,1,MPI_DOUBLE,MPI_SUM,E->parallel.world);
+ TDIST=TDIST1/total_sum_rhocp;
+
+ /* keep sum(rho*cp*T) the same before/after the filtering by distributing
+ the difference back to nodes */
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=1;i<=E->lmesh.nno;i++) {
+ if(E->T[m][i]!=Tmin0 && E->T[m][i]!=Tmax0)
+ E->T[m][i] +=TDIST;
+ }
+
+ free(rhocp);
+ return;
+}
+
+
+static void process_visc_heating(struct All_variables *E, int m,
+ double *heating)
+{
+ int e, i;
+ double visc, temp;
+ float *strain_sqr;
+ const int vpts = VPOINTS3D;
+
+ strain_sqr = (float*) malloc((E->lmesh.nel+1)*sizeof(float));
+ temp = E->control.disptn_number / E->control.Atemp / vpts;
+
+ strain_rate_2_inv(E, m, strain_sqr, 0);
+
+ for(e=1; e<=E->lmesh.nel; e++) {
+ visc = 0.0;
+ for(i = 1; i <= vpts; i++)
+ visc += E->EVi[m][(e-1)*vpts + i];
+
+ heating[e] = temp * visc * strain_sqr[e];
+ }
+
+ free(strain_sqr);
+
+ return;
+}
+
+
+static void process_adi_heating(struct All_variables *E, int m,
+ double *heating)
+{
+ int e, ez, i, j;
+ double matprop, temp1, temp2;
+ const int ends = ENODES3D;
+
+ temp2 = E->control.disptn_number / ends;
+ for(e=1; e<=E->lmesh.nel; e++) {
+ ez = (e - 1) % E->lmesh.elz + 1;
+ matprop = 0.125
+ * (E->refstate.thermal_expansivity[ez] +
+ E->refstate.thermal_expansivity[ez + 1])
+ * (E->refstate.rho[ez] + E->refstate.rho[ez + 1])
+ * (E->refstate.gravity[ez] + E->refstate.gravity[ez + 1]);
+
+ temp1 = 0.0;
+ for(i=1; i<=ends; i++) {
+ j = E->ien[m][e].node[i];
+ temp1 += E->sphere.cap[m].V[3][j]
+ * (E->T[m][j] + E->control.surface_temp);
+ }
+
+ heating[e] = matprop * temp1 * temp2;
+ }
+
+ return;
+}
+
+
+static void latent_heating(struct All_variables *E, int m,
+ double *heating_latent, double *heating_adi,
+ float **B, float Ra, float clapeyron,
+ float depth, float transT, float inv_width)
+{
+ double temp, temp0, temp1, temp2, temp3, matprop;
+ int e, ez, i, j;
+ const int ends = ENODES3D;
+
+ temp0 = 2.0 * inv_width * clapeyron * E->control.disptn_number * Ra / E->control.Atemp / ends;
+ temp1 = temp0 * clapeyron;
+
+ for(e=1; e<=E->lmesh.nel; e++) {
+ ez = (e - 1) % E->lmesh.elz + 1;
+ matprop = 0.125
+ * (E->refstate.thermal_expansivity[ez] +
+ E->refstate.thermal_expansivity[ez + 1])
+ * (E->refstate.rho[ez] + E->refstate.rho[ez + 1])
+ * (E->refstate.gravity[ez] + E->refstate.gravity[ez + 1]);
+
+ temp2 = 0;
+ temp3 = 0;
+ for(i=1; i<=ends; i++) {
+ j = E->ien[m][e].node[i];
+ temp = (1.0 - B[m][j]) * B[m][j]
+ * (E->T[m][j] + E->control.surface_temp);
+ temp2 += temp * E->sphere.cap[m].V[3][j];
+ temp3 += temp;
+ }
+
+ /* correction on the adiabatic cooling term */
+ heating_adi[e] += matprop * temp2 * temp0;
+
+ /* correction on the DT/Dt term */
+ heating_latent[e] += temp3 * temp1;
+ }
+ return;
+}
+
+
+static void process_latent_heating(struct All_variables *E, int m,
+ double *heating_latent, double *heating_adi)
+{
+ int e;
+
+ /* reset */
+ for(e=1; e<=E->lmesh.nel; e++)
+ heating_latent[e] = 1.0;
+
+ if(E->control.Ra_410 != 0.0) {
+ latent_heating(E, m, heating_latent, heating_adi,
+ E->Fas410, E->control.Ra_410,
+ E->control.clapeyron410, E->viscosity.z410,
+ E->control.transT410, E->control.inv_width410);
+
+ }
+
+ if(E->control.Ra_670 != 0.0) {
+ latent_heating(E, m, heating_latent, heating_adi,
+ E->Fas670, E->control.Ra_670,
+ E->control.clapeyron670, E->viscosity.zlm,
+ E->control.transT670, E->control.inv_width670);
+ }
+
+ if(E->control.Ra_cmb != 0.0) {
+ latent_heating(E, m, heating_latent, heating_adi,
+ E->Fascmb, E->control.Ra_cmb,
+ E->control.clapeyroncmb, E->viscosity.zcmb,
+ E->control.transTcmb, E->control.inv_widthcmb);
+ }
+
+
+ if(E->control.Ra_410 != 0 || E->control.Ra_670 != 0.0 ||
+ E->control.Ra_cmb != 0) {
+ for(e=1; e<=E->lmesh.nel; e++)
+ heating_latent[e] = 1.0 / heating_latent[e];
+ }
+
+ return;
+}
+
+
+static double total_heating(struct All_variables *E, double **heating)
+{
+ int m, e;
+ double sum, total;
+
+ /* sum up within each processor */
+ sum = 0;
+ for(m=1; m<=E->sphere.caps_per_proc; m++) {
+ for(e=1; e<=E->lmesh.nel; e++)
+ sum += heating[m][e] * E->eco[m][e].area;
+ }
+
+ /* sum up for all processors */
+ MPI_Allreduce(&sum, &total, 1,
+ MPI_DOUBLE, MPI_SUM, E->parallel.world);
+
+ return total;
+}
+
+
+static void process_heating(struct All_variables *E, int psc_pass)
+{
+ int m;
+ double total_visc_heating, total_adi_heating;
+
+ for(m=1; m<=E->sphere.caps_per_proc; m++) {
+ if(psc_pass == 0) {
+ /* visc heating does not change between psc_pass, compute only
+ * at first psc_pass */
+ process_visc_heating(E, m, E->heating_visc[m]);
+ }
+ process_adi_heating(E, m, E->heating_adi[m]);
+ process_latent_heating(E, m, E->heating_latent[m], E->heating_adi[m]);
+ }
+
+ /* compute total amount of visc/adi heating over all processors
+ * only at last psc_pass */
+ if(psc_pass == (E->advection.temp_iterations-1)) {
+ total_visc_heating = total_heating(E, E->heating_visc);
+ total_adi_heating = total_heating(E, E->heating_adi);
+
+ if(E->parallel.me == 0) {
+ fprintf(E->fp, "Step: %d, Total_heating(visc, adi): %g %g\n",
+ E->monitor.solution_cycles,
+ total_visc_heating, total_adi_heating);
+ fprintf(stderr, "Step: %d, Total_heating(visc, adi): %g %g\n",
+ E->monitor.solution_cycles,
+ total_visc_heating, total_adi_heating);
+ }
+ }
+
+ return;
+}
Deleted: mc/3D/CitcomS/branches/cxx/lib/BC_util.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/BC_util.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/BC_util.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,141 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-
-#include "global_defs.h"
-
-
-void strip_bcs_from_residual(E,Res,level)
- struct All_variables *E;
- double **Res;
- int level;
-{
- int m,i;
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- if (E->num_zero_resid[level][m])
- for(i=1;i<=E->num_zero_resid[level][m];i++)
- Res[m][E->zero_resid[level][m][i]] = 0.0;
-
- return;
-}
-
-
-void temperatures_conform_bcs(E)
- struct All_variables *E;
-{
- void temperatures_conform_bcs2(struct All_variables *);
- void assimilate_lith_conform_bcs2(struct All_variables *);
-
- if(E->control.lith_age) {
- /*
- This sequence now moved to end of PG_time_step_solve
- lith_age_conform_tbc(E);
- assimilate_lith_conform_bcs(E);
- */
- }
- else
- temperatures_conform_bcs2(E);
- return;
-}
-
-
-void temperatures_conform_bcs2(E)
- struct All_variables *E;
-{
- int j,node;
- unsigned int type;
-
- for(j=1;j<=E->sphere.caps_per_proc;j++)
- for(node=1;node<=E->lmesh.nno;node++) {
-
- type = (E->node[j][node] & (TBX | TBZ | TBY));
-
- switch (type) {
- case 0: /* no match, next node */
- break;
- case TBX:
- E->T[j][node] = E->sphere.cap[j].TB[1][node];
- break;
- case TBZ:
- E->T[j][node] = E->sphere.cap[j].TB[3][node];
- break;
- case TBY:
- E->T[j][node] = E->sphere.cap[j].TB[2][node];
- break;
- case (TBX | TBZ): /* clashes ! */
- E->T[j][node] = 0.5 * (E->sphere.cap[j].TB[1][node] + E->sphere.cap[j].TB[3][node]);
- break;
- case (TBX | TBY): /* clashes ! */
- E->T[j][node] = 0.5 * (E->sphere.cap[j].TB[1][node] + E->sphere.cap[j].TB[2][node]);
- break;
- case (TBZ | TBY): /* clashes ! */
- E->T[j][node] = 0.5 * (E->sphere.cap[j].TB[3][node] + E->sphere.cap[j].TB[2][node]);
- break;
- case (TBZ | TBY | TBX): /* clashes ! */
- E->T[j][node] = 0.3333333 * (E->sphere.cap[j].TB[1][node] + E->sphere.cap[j].TB[2][node] + E->sphere.cap[j].TB[3][node]);
- break;
- }
-
- /* next node */
- }
-
- return;
-
-}
-
-
-void velocities_conform_bcs(E,U)
- struct All_variables *E;
- double **U;
-{
- int node,m;
-
- const unsigned int typex = VBX;
- const unsigned int typez = VBZ;
- const unsigned int typey = VBY;
-
- const int nno = E->lmesh.nno;
-
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
- for(node=1;node<=nno;node++) {
-
- if (E->node[m][node] & typex)
- U[m][E->id[m][node].doff[1]] = E->sphere.cap[m].VB[1][node];
- if (E->node[m][node] & typey)
- U[m][E->id[m][node].doff[2]] = E->sphere.cap[m].VB[2][node];
- if (E->node[m][node] & typez)
- U[m][E->id[m][node].doff[3]] = E->sphere.cap[m].VB[3][node];
- }
- }
-
- return;
-}
-
-
-/* End of file */
-
Copied: mc/3D/CitcomS/branches/cxx/lib/BC_util.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/BC_util.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/BC_util.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/BC_util.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,134 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+
+#include "global_defs.h"
+
+
+void strip_bcs_from_residual(struct All_variables *E, double **Res, int level)
+{
+ int m,i;
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ if (E->num_zero_resid[level][m])
+ for(i=1;i<=E->num_zero_resid[level][m];i++)
+ Res[m][E->zero_resid[level][m][i]] = 0.0;
+
+ return;
+}
+
+
+void temperatures_conform_bcs(struct All_variables *E)
+{
+ void temperatures_conform_bcs2(struct All_variables *);
+ void assimilate_lith_conform_bcs2(struct All_variables *);
+
+ if(E->control.lith_age) {
+ /*
+ This sequence now moved to end of PG_time_step_solve
+ lith_age_conform_tbc(E);
+ assimilate_lith_conform_bcs(E);
+ */
+ }
+ else
+ temperatures_conform_bcs2(E);
+ return;
+}
+
+
+void temperatures_conform_bcs2(struct All_variables *E)
+{
+ int j,node;
+ unsigned int type;
+
+ for(j=1;j<=E->sphere.caps_per_proc;j++)
+ for(node=1;node<=E->lmesh.nno;node++) {
+
+ type = (E->node[j][node] & (TBX | TBZ | TBY));
+
+ switch (type) {
+ case 0: /* no match, next node */
+ break;
+ case TBX:
+ E->T[j][node] = E->sphere.cap[j].TB[1][node];
+ break;
+ case TBZ:
+ E->T[j][node] = E->sphere.cap[j].TB[3][node];
+ break;
+ case TBY:
+ E->T[j][node] = E->sphere.cap[j].TB[2][node];
+ break;
+ case (TBX | TBZ): /* clashes ! */
+ E->T[j][node] = 0.5 * (E->sphere.cap[j].TB[1][node] + E->sphere.cap[j].TB[3][node]);
+ break;
+ case (TBX | TBY): /* clashes ! */
+ E->T[j][node] = 0.5 * (E->sphere.cap[j].TB[1][node] + E->sphere.cap[j].TB[2][node]);
+ break;
+ case (TBZ | TBY): /* clashes ! */
+ E->T[j][node] = 0.5 * (E->sphere.cap[j].TB[3][node] + E->sphere.cap[j].TB[2][node]);
+ break;
+ case (TBZ | TBY | TBX): /* clashes ! */
+ E->T[j][node] = 0.3333333 * (E->sphere.cap[j].TB[1][node] + E->sphere.cap[j].TB[2][node] + E->sphere.cap[j].TB[3][node]);
+ break;
+ }
+
+ /* next node */
+ }
+
+ return;
+
+}
+
+
+void velocities_conform_bcs(struct All_variables *E, double **U)
+{
+ int node,m;
+
+ const unsigned int typex = VBX;
+ const unsigned int typez = VBZ;
+ const unsigned int typey = VBY;
+
+ const int nno = E->lmesh.nno;
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+ for(node=1;node<=nno;node++) {
+
+ if (E->node[m][node] & typex)
+ U[m][E->id[m][node].doff[1]] = E->sphere.cap[m].VB[1][node];
+ if (E->node[m][node] & typey)
+ U[m][E->id[m][node].doff[2]] = E->sphere.cap[m].VB[2][node];
+ if (E->node[m][node] & typez)
+ U[m][E->id[m][node].doff[3]] = E->sphere.cap[m].VB[3][node];
+ }
+ }
+
+ return;
+}
+
+
+/* End of file */
+
Deleted: mc/3D/CitcomS/branches/cxx/lib/Checkpoints.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Checkpoints.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Checkpoints.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,506 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-
-#include <sys/file.h>
-#include <unistd.h>
-#include "global_defs.h"
-#include "composition_related.h"
-
-/* Private function prototypes */
-static void backup_file(const char *output_file);
-static void write_sentinel(FILE *fp);
-static void read_sentinel(FILE *fp, int me);
-
-static void general_checkpoint(struct All_variables *E, FILE *fp);
-static void tracer_checkpoint(struct All_variables *E, FILE *fp);
-static void composition_checkpoint(struct All_variables *E, FILE *fp);
-static void energy_checkpoint(struct All_variables *E, FILE *fp);
-static void momentum_checkpoint(struct All_variables *E, FILE *fp);
-
-static void read_general_checkpoint(struct All_variables *E, FILE *fp);
-static void read_tracer_checkpoint(struct All_variables *E, FILE *fp);
-static void read_composition_checkpoint(struct All_variables *E, FILE *fp);
-static void read_energy_checkpoint(struct All_variables *E, FILE *fp);
-static void read_momentum_checkpoint(struct All_variables *E, FILE *fp);
-
-void myerror(char *,struct All_variables *);
-
-void output_checkpoint(struct All_variables *E)
-{
- char output_file[255];
- FILE *fp1;
-
- sprintf(output_file, "%s.chkpt.%d.%d", E->control.data_file,
- E->parallel.me, E->monitor.solution_cycles);
-
- /* Disable the backup since the filename is unique. */
- /* backup_file(output_file); */
-
- fp1 = fopen(output_file, "wb");
-
- /* checkpoint for general information */
- /* this must be the first to be checkpointed */
- general_checkpoint(E, fp1);
-
- /* checkpoint for energy equation */
- energy_checkpoint(E, fp1);
-
- /* checkpoint for momentum equation */
- momentum_checkpoint(E, fp1);
-
- /* checkpoint for tracer/composition */
- if(E->control.tracer) {
- tracer_checkpoint(E, fp1);
-
- if(E->composition.on)
- composition_checkpoint(E, fp1);
- }
-
- fclose(fp1);
- return;
-}
-
-
-void read_checkpoint(struct All_variables *E)
-{
- void initialize_material(struct All_variables *E);
- void initial_viscosity(struct All_variables *E);
-
- char output_file[255];
- FILE *fp;
-
- /* open the checkpoint file */
- snprintf(output_file, 254, "%s.chkpt.%d.%d", E->control.old_P_file,
- E->parallel.me, E->monitor.solution_cycles_init);
- fp = fopen(output_file, "rb");
- if(fp == NULL) {
- fprintf(stderr, "Cannot open file: %s\n", output_file);
- exit(-1);
- }
- if(E->parallel.me == 0)
- fprintf(stderr,"read_checkpoint: restarting from %s\n",output_file);
-
- /* check mesh information in the checkpoint file */
- read_general_checkpoint(E, fp);
-
- /* init E->mat */
- initialize_material(E);
-
- /* read energy information in the checkpoint file */
- read_energy_checkpoint(E, fp);
-
- /* read momentum information in the checkpoint file */
- read_momentum_checkpoint(E, fp);
-
- /* read tracer/composition information in the checkpoint file */
- if(E->control.tracer) {
- read_tracer_checkpoint(E, fp);
-
- if(E->composition.on)
- read_composition_checkpoint(E, fp);
- }
-
- fclose(fp);
-
- /* finally, init viscosity */
- initial_viscosity(E);
-
- return;
-}
-
-
-static void backup_file(const char *output_file)
-{
- char bak_file[255];
- int ierr;
-
- /* check the existence of output_file */
- if(access(output_file, F_OK) == 0) {
- /* if exist, renamed it to back up */
- sprintf(bak_file, "%s.bak", output_file);
- ierr = rename(output_file, bak_file);
- if(ierr != 0) {
- fprintf(stderr, "Warning, cannot backup checkpoint files\n");
- }
- }
-
- return;
-}
-
-
-static void write_sentinel(FILE *fp)
-{
- int a[4] = {0, 0, 0, 0};
-
- fwrite(a, sizeof(int), 4, fp);
-}
-
-
-static void read_sentinel(FILE *fp, int me)
-{
- int i, a[4];
- int nonzero = 0;
-
- fread(a, sizeof(int), 4, fp);
-
- /* check whether a[i] are all zero */
- for(i=0; i<4; i++)
- nonzero |= a[i];
-
- if(nonzero) {
- fprintf(stderr, "Error in reading checkpoint file: wrong sentinel, "
- "me=%d\n", me);
- exit(-1);
- }
-
- return;
-}
-
-
-static void general_checkpoint(struct All_variables *E, FILE *fp)
-{
- /* write mesh information */
- fwrite(&(E->lmesh.nox), sizeof(int), 1, fp);
- fwrite(&(E->lmesh.noy), sizeof(int), 1, fp);
- fwrite(&(E->lmesh.noz), sizeof(int), 1, fp);
- fwrite(&(E->parallel.nprocx), sizeof(int), 1, fp);
- fwrite(&(E->parallel.nprocy), sizeof(int), 1, fp);
- fwrite(&(E->parallel.nprocz), sizeof(int), 1, fp);
- fwrite(&(E->sphere.caps_per_proc), sizeof(int), 1, fp);
-
- /* write timing information */
- fwrite(&(E->monitor.solution_cycles), sizeof(int), 1, fp);
- fwrite(&(E->monitor.elapsed_time), sizeof(float), 1, fp);
- fwrite(&(E->advection.timestep), sizeof(float), 1, fp);
- fwrite(&(E->control.start_age), sizeof(float), 1, fp);
-
- return;
-}
-
-
-static void read_general_checkpoint(struct All_variables *E, FILE *fp)
-{
- int tmp[7];
- double dtmp;
-
- /* read mesh information */
- fread(tmp, sizeof(int), 7, fp);
-
- if((tmp[0] != E->lmesh.nox) ||
- (tmp[1] != E->lmesh.noy) ||
- (tmp[2] != E->lmesh.noz) ||
- (tmp[3] != E->parallel.nprocx) ||
- (tmp[4] != E->parallel.nprocy) ||
- (tmp[5] != E->parallel.nprocz) ||
- (tmp[6] != E->sphere.caps_per_proc)) {
-
- fprintf(stderr, "Error in reading checkpoint file: mesh parameters mismatch, me=%d\n",
- E->parallel.me);
- fprintf(stderr, "%d %d %d %d %d %d %d\n",
- tmp[0], tmp[1], tmp[2], tmp[3],
- tmp[4], tmp[5], tmp[6]);
- exit(-1);
- }
-
- /* read timing information */
- tmp[0] = fread(&(E->monitor.solution_cycles), sizeof(int), 1, fp);
- tmp[0]+= fread(&(E->monitor.elapsed_time), sizeof(float), 1, fp);
- tmp[0]+= fread(&(E->advection.timestep), sizeof(float), 1, fp);
- tmp[0]+= fread(&(E->control.start_age), sizeof(float), 1, fp);
- if(tmp[0] != 4)
- myerror("read_general_checkpoint: header error",E);
-
- E->advection.timesteps = E->monitor.solution_cycles;
-
- return;
-}
-
-
-static void tracer_checkpoint(struct All_variables *E, FILE *fp)
-{
- int m, i;
-
- write_sentinel(fp);
-
- fwrite(&(E->trace.number_of_basic_quantities), sizeof(int), 1, fp);
- fwrite(&(E->trace.number_of_extra_quantities), sizeof(int), 1, fp);
- fwrite(&(E->trace.nflavors), sizeof(int), 1, fp);
- fwrite(&(E->trace.ilast_tracer_count), sizeof(int), 1, fp);
-
- for(m=1; m<=E->sphere.caps_per_proc; m++)
- fwrite(&(E->trace.ntracers[m]), sizeof(int), 1, fp);
-
- /* the 0-th element of basicq/extraq/ielement is not init'd
- * and won't be used when read it. */
- for(m=1; m<=E->sphere.caps_per_proc; m++) {
- for(i=0; i<6; i++) {
- fwrite(E->trace.basicq[m][i], sizeof(double),
- E->trace.ntracers[m]+1, fp);
- }
- for(i=0; i<E->trace.number_of_extra_quantities; i++) {
- fwrite(E->trace.extraq[m][i], sizeof(double),
- E->trace.ntracers[m]+1, fp);
- }
- fwrite(E->trace.ielement[m], sizeof(int),
- E->trace.ntracers[m]+1, fp);
- }
-
- return;
-}
-
-
-static void read_tracer_checkpoint(struct All_variables *E, FILE *fp)
-{
- void count_tracers_of_flavors(struct All_variables *E);
- void allocate_tracer_arrays();
-
- int m, i, itmp;
-
- read_sentinel(fp, E->parallel.me);
-
- fread(&itmp, sizeof(int), 1, fp);
- if (itmp != E->trace.number_of_basic_quantities) {
- fprintf(stderr, "Error in reading checkpoint file: tracer basicq, me=%d\n",
- E->parallel.me);
- fprintf(stderr, "%d\n", itmp);
- exit(-1);
-
- }
-
- fread(&itmp, sizeof(int), 1, fp);
- if (itmp != E->trace.number_of_extra_quantities) {
- fprintf(stderr, "Error in reading checkpoint file: tracer extraq, me=%d\n",
- E->parallel.me);
- fprintf(stderr, "%d\n", itmp);
- exit(-1);
-
- }
-
- fread(&itmp, sizeof(int), 1, fp);
- if (itmp != E->trace.nflavors) {
- fprintf(stderr, "Error in reading checkpoint file: tracer nflavors, me=%d\n",
- E->parallel.me);
- fprintf(stderr, "%d\n", itmp);
- exit(-1);
-
- }
-
- fread(&itmp, sizeof(int), 1, fp);
- E->trace.ilast_tracer_count = itmp;
-
- /* # of tracers, allocate memory */
- for(m=1; m<=E->sphere.caps_per_proc; m++) {
- fread(&itmp, sizeof(int), 1, fp);
- allocate_tracer_arrays(E, m, itmp);
- E->trace.ntracers[m] = itmp;
- }
-
- /* read tracer data */
- for(m=1; m<=E->sphere.caps_per_proc; m++) {
- for(i=0; i<6; i++) {
- fread(E->trace.basicq[m][i], sizeof(double),
- E->trace.ntracers[m]+1, fp);
- }
- for(i=0; i<E->trace.number_of_extra_quantities; i++) {
- fread(E->trace.extraq[m][i], sizeof(double),
- E->trace.ntracers[m]+1, fp);
- }
- fread(E->trace.ielement[m], sizeof(int),
- E->trace.ntracers[m]+1, fp);
- }
-
- /* init E->trace.ntracer_flavor */
- count_tracers_of_flavors(E);
-
- return;
-}
-
-
-static void composition_checkpoint(struct All_variables *E, FILE *fp)
-{
- int i, m;
-
- write_sentinel(fp);
-
- fwrite(&(E->composition.ncomp), sizeof(int), 1, fp);
- fwrite(E->composition.bulk_composition, sizeof(double),
- E->composition.ncomp, fp);
- fwrite(E->composition.initial_bulk_composition, sizeof(double),
- E->composition.ncomp, fp);
-
- /* the 0-th element of comp_el is not init'd
- * and won't be used when read it. */
- for(m=1; m<=E->sphere.caps_per_proc; m++) {
- for(i=0; i<E->composition.ncomp; i++)
- fwrite(E->composition.comp_el[m][i], sizeof(double),
- E->lmesh.nel+1, fp);
- }
-
- return;
-}
-
-
-static void read_composition_checkpoint(struct All_variables *E, FILE *fp)
-{
- double tmp;
- int m, i, itmp;
-
- read_sentinel(fp, E->parallel.me);
-
- fread(&itmp, sizeof(int), 1, fp);
- if (itmp != E->composition.ncomp) {
- fprintf(stderr, "Error in reading checkpoint file: ncomp, me=%d\n",
- E->parallel.me);
- fprintf(stderr, "%d\n", itmp);
- exit(-1);
- }
-
- fread(E->composition.bulk_composition, sizeof(double),
- E->composition.ncomp, fp);
-
- fread(E->composition.initial_bulk_composition, sizeof(double),
- E->composition.ncomp, fp);
-
- for(m=1; m<=E->sphere.caps_per_proc; m++) {
- for(i=0; i<E->composition.ncomp; i++)
- fread(E->composition.comp_el[m][i], sizeof(double),
- E->lmesh.nel+1, fp);
- }
-
- /* init E->composition.comp_node */
- map_composition_to_nodes(E);
-
- /* preventing uninitialized access */
- E->trace.istat_iempty = 0;
-
- for (i=0; i<E->composition.ncomp; i++) {
- E->composition.error_fraction[i] = E->composition.bulk_composition[i]
- / E->composition.initial_bulk_composition[i] - 1.0;
- }
-
- return;
-}
-
-
-static void energy_checkpoint(struct All_variables *E, FILE *fp)
-{
- int m;
-
- write_sentinel(fp);
-
- for(m=1; m<=E->sphere.caps_per_proc; m++) {
- fwrite(E->T[m], sizeof(double), E->lmesh.nno+1, fp);
- fwrite(E->Tdot[m], sizeof(double), E->lmesh.nno+1, fp);
- }
-
- return;
-}
-
-
-static void read_energy_checkpoint(struct All_variables *E, FILE *fp)
-{
- int m;
-
- read_sentinel(fp, E->parallel.me);
-
- /* the 0-th element of T/Tdot is not init'd
- * and won't be used when read it. */
- for(m=1; m<=E->sphere.caps_per_proc; m++) {
- if(fread(E->T[m], sizeof(double), E->lmesh.nno+1, fp)!= E->lmesh.nno+1)
- myerror("read_energy_checkpoint: error at T",E);
- if(fread(E->Tdot[m], sizeof(double), E->lmesh.nno+1, fp)!=E->lmesh.nno+1)
- myerror("read_energy_checkpoint: error at Tdot",E);
- }
-
- return;
-}
-
-
-static void momentum_checkpoint(struct All_variables *E, FILE *fp)
-{
- int m;
- float junk[2];
- junk[0] = junk[1] = 0;
-
- write_sentinel(fp);
-
- /* for backward compatibility */
- fwrite(junk, sizeof(float), 2, fp);
-
- /* the 0-th element of P/NP/EVI/VI is not init'd
- * and won't be used when read it. */
- for(m=1; m<=E->sphere.caps_per_proc; m++) {
- /* Pressure at equation points */
- fwrite(E->P[m], sizeof(double), E->lmesh.npno+1, fp);
-
- /* velocity at equation points */
- fwrite(E->U[m], sizeof(double), E->lmesh.neq, fp);
- }
-
- return;
-}
-
-
-static void read_momentum_checkpoint(struct All_variables *E, FILE *fp)
-{
- void v_from_vector();
- void p_to_nodes();
- double global_v_norm2(), global_p_norm2();
-
- int m;
- int lev = E->mesh.levmax;
- float junk[2];
-
- read_sentinel(fp, E->parallel.me);
-
- /* for backward compatibility */
- if(fread(junk, sizeof(float), 2, fp)!=2)
- myerror("read_momentum_checkpoint: error at vdotv",E);
-
- for(m=1; m<=E->sphere.caps_per_proc; m++) {
- /* Pressure at equation points */
- if(fread(E->P[m], sizeof(double), E->lmesh.npno+1, fp) != E->lmesh.npno+1)
- myerror("read_momentum_checkpoint: error at P",E);
- /* velocity at equation points */
- if(fread(E->U[m], sizeof(double), E->lmesh.neq, fp) != E->lmesh.neq)
- myerror("read_momentum_checkpoint: error at U",E);
- }
-
- E->monitor.vdotv = global_v_norm2(E, E->U);
- E->monitor.pdotp = global_p_norm2(E, E->P);
-
- /* update velocity array */
- v_from_vector(E);
-
- /* init E->NP */
- p_to_nodes(E, E->P, E->NP, lev);
-
- return;
-}
-
-
Copied: mc/3D/CitcomS/branches/cxx/lib/Checkpoints.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Checkpoints.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Checkpoints.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Checkpoints.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,499 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+
+#include <sys/file.h>
+#include <unistd.h>
+#include "global_defs.h"
+#include "composition_related.h"
+
+#include "cproto.h"
+
+/* Private function prototypes */
+static void backup_file(const char *output_file);
+static void write_sentinel(FILE *fp);
+static void read_sentinel(FILE *fp, int me);
+
+static void general_checkpoint(struct All_variables *E, FILE *fp);
+static void tracer_checkpoint(struct All_variables *E, FILE *fp);
+static void composition_checkpoint(struct All_variables *E, FILE *fp);
+static void energy_checkpoint(struct All_variables *E, FILE *fp);
+static void momentum_checkpoint(struct All_variables *E, FILE *fp);
+
+static void read_general_checkpoint(struct All_variables *E, FILE *fp);
+static void read_tracer_checkpoint(struct All_variables *E, FILE *fp);
+static void read_composition_checkpoint(struct All_variables *E, FILE *fp);
+static void read_energy_checkpoint(struct All_variables *E, FILE *fp);
+static void read_momentum_checkpoint(struct All_variables *E, FILE *fp);
+
+void output_checkpoint(struct All_variables *E)
+{
+ char output_file[255];
+ FILE *fp1;
+
+ sprintf(output_file, "%s.chkpt.%d.%d", E->control.data_file,
+ E->parallel.me, E->monitor.solution_cycles);
+
+ /* Disable the backup since the filename is unique. */
+ /* backup_file(output_file); */
+
+ fp1 = fopen(output_file, "wb");
+
+ /* checkpoint for general information */
+ /* this must be the first to be checkpointed */
+ general_checkpoint(E, fp1);
+
+ /* checkpoint for energy equation */
+ energy_checkpoint(E, fp1);
+
+ /* checkpoint for momentum equation */
+ momentum_checkpoint(E, fp1);
+
+ /* checkpoint for tracer/composition */
+ if(E->control.tracer) {
+ tracer_checkpoint(E, fp1);
+
+ if(E->composition.on)
+ composition_checkpoint(E, fp1);
+ }
+
+ fclose(fp1);
+ return;
+}
+
+
+void read_checkpoint(struct All_variables *E)
+{
+ void initialize_material(struct All_variables *E);
+ void initial_viscosity(struct All_variables *E);
+
+ char output_file[255];
+ FILE *fp;
+
+ /* open the checkpoint file */
+ snprintf(output_file, 254, "%s.chkpt.%d.%d", E->control.old_P_file,
+ E->parallel.me, E->monitor.solution_cycles_init);
+ fp = fopen(output_file, "rb");
+ if(fp == NULL) {
+ fprintf(stderr, "Cannot open file: %s\n", output_file);
+ exit(-1);
+ }
+ if(E->parallel.me == 0)
+ fprintf(stderr,"read_checkpoint: restarting from %s\n",output_file);
+
+ /* check mesh information in the checkpoint file */
+ read_general_checkpoint(E, fp);
+
+ /* init E->mat */
+ initialize_material(E);
+
+ /* read energy information in the checkpoint file */
+ read_energy_checkpoint(E, fp);
+
+ /* read momentum information in the checkpoint file */
+ read_momentum_checkpoint(E, fp);
+
+ /* read tracer/composition information in the checkpoint file */
+ if(E->control.tracer) {
+ read_tracer_checkpoint(E, fp);
+
+ if(E->composition.on)
+ read_composition_checkpoint(E, fp);
+ }
+
+ fclose(fp);
+
+ /* finally, init viscosity */
+ initial_viscosity(E);
+
+ return;
+}
+
+
+static void backup_file(const char *output_file)
+{
+ char bak_file[255];
+ int ierr;
+
+ /* check the existence of output_file */
+ if(access(output_file, F_OK) == 0) {
+ /* if exist, renamed it to back up */
+ sprintf(bak_file, "%s.bak", output_file);
+ ierr = rename(output_file, bak_file);
+ if(ierr != 0) {
+ fprintf(stderr, "Warning, cannot backup checkpoint files\n");
+ }
+ }
+
+ return;
+}
+
+
+static void write_sentinel(FILE *fp)
+{
+ int a[4] = {0, 0, 0, 0};
+
+ fwrite(a, sizeof(int), 4, fp);
+}
+
+
+static void read_sentinel(FILE *fp, int me)
+{
+ int i, a[4];
+ int nonzero = 0;
+
+ fread(a, sizeof(int), 4, fp);
+
+ /* check whether a[i] are all zero */
+ for(i=0; i<4; i++)
+ nonzero |= a[i];
+
+ if(nonzero) {
+ fprintf(stderr, "Error in reading checkpoint file: wrong sentinel, "
+ "me=%d\n", me);
+ exit(-1);
+ }
+
+ return;
+}
+
+
+static void general_checkpoint(struct All_variables *E, FILE *fp)
+{
+ /* write mesh information */
+ fwrite(&(E->lmesh.nox), sizeof(int), 1, fp);
+ fwrite(&(E->lmesh.noy), sizeof(int), 1, fp);
+ fwrite(&(E->lmesh.noz), sizeof(int), 1, fp);
+ fwrite(&(E->parallel.nprocx), sizeof(int), 1, fp);
+ fwrite(&(E->parallel.nprocy), sizeof(int), 1, fp);
+ fwrite(&(E->parallel.nprocz), sizeof(int), 1, fp);
+ fwrite(&(E->sphere.caps_per_proc), sizeof(int), 1, fp);
+
+ /* write timing information */
+ fwrite(&(E->monitor.solution_cycles), sizeof(int), 1, fp);
+ fwrite(&(E->monitor.elapsed_time), sizeof(float), 1, fp);
+ fwrite(&(E->advection.timestep), sizeof(float), 1, fp);
+ fwrite(&(E->control.start_age), sizeof(float), 1, fp);
+
+ return;
+}
+
+
+static void read_general_checkpoint(struct All_variables *E, FILE *fp)
+{
+ int tmp[7];
+ double dtmp;
+
+ /* read mesh information */
+ fread(tmp, sizeof(int), 7, fp);
+
+ if((tmp[0] != E->lmesh.nox) ||
+ (tmp[1] != E->lmesh.noy) ||
+ (tmp[2] != E->lmesh.noz) ||
+ (tmp[3] != E->parallel.nprocx) ||
+ (tmp[4] != E->parallel.nprocy) ||
+ (tmp[5] != E->parallel.nprocz) ||
+ (tmp[6] != E->sphere.caps_per_proc)) {
+
+ fprintf(stderr, "Error in reading checkpoint file: mesh parameters mismatch, me=%d\n",
+ E->parallel.me);
+ fprintf(stderr, "%d %d %d %d %d %d %d\n",
+ tmp[0], tmp[1], tmp[2], tmp[3],
+ tmp[4], tmp[5], tmp[6]);
+ exit(-1);
+ }
+
+ /* read timing information */
+ tmp[0] = fread(&(E->monitor.solution_cycles), sizeof(int), 1, fp);
+ tmp[0]+= fread(&(E->monitor.elapsed_time), sizeof(float), 1, fp);
+ tmp[0]+= fread(&(E->advection.timestep), sizeof(float), 1, fp);
+ tmp[0]+= fread(&(E->control.start_age), sizeof(float), 1, fp);
+ if(tmp[0] != 4)
+ myerror(E, "read_general_checkpoint: header error");
+
+ E->advection.timesteps = E->monitor.solution_cycles;
+
+ return;
+}
+
+
+static void tracer_checkpoint(struct All_variables *E, FILE *fp)
+{
+ int m, i;
+
+ write_sentinel(fp);
+
+ fwrite(&(E->trace.number_of_basic_quantities), sizeof(int), 1, fp);
+ fwrite(&(E->trace.number_of_extra_quantities), sizeof(int), 1, fp);
+ fwrite(&(E->trace.nflavors), sizeof(int), 1, fp);
+ fwrite(&(E->trace.ilast_tracer_count), sizeof(int), 1, fp);
+
+ for(m=1; m<=E->sphere.caps_per_proc; m++)
+ fwrite(&(E->trace.ntracers[m]), sizeof(int), 1, fp);
+
+ /* the 0-th element of basicq/extraq/ielement is not init'd
+ * and won't be used when read it. */
+ for(m=1; m<=E->sphere.caps_per_proc; m++) {
+ for(i=0; i<6; i++) {
+ fwrite(E->trace.basicq[m][i], sizeof(double),
+ E->trace.ntracers[m]+1, fp);
+ }
+ for(i=0; i<E->trace.number_of_extra_quantities; i++) {
+ fwrite(E->trace.extraq[m][i], sizeof(double),
+ E->trace.ntracers[m]+1, fp);
+ }
+ fwrite(E->trace.ielement[m], sizeof(int),
+ E->trace.ntracers[m]+1, fp);
+ }
+
+ return;
+}
+
+
+static void read_tracer_checkpoint(struct All_variables *E, FILE *fp)
+{
+ int m, i, itmp;
+
+ read_sentinel(fp, E->parallel.me);
+
+ fread(&itmp, sizeof(int), 1, fp);
+ if (itmp != E->trace.number_of_basic_quantities) {
+ fprintf(stderr, "Error in reading checkpoint file: tracer basicq, me=%d\n",
+ E->parallel.me);
+ fprintf(stderr, "%d\n", itmp);
+ exit(-1);
+
+ }
+
+ fread(&itmp, sizeof(int), 1, fp);
+ if (itmp != E->trace.number_of_extra_quantities) {
+ fprintf(stderr, "Error in reading checkpoint file: tracer extraq, me=%d\n",
+ E->parallel.me);
+ fprintf(stderr, "%d\n", itmp);
+ exit(-1);
+
+ }
+
+ fread(&itmp, sizeof(int), 1, fp);
+ if (itmp != E->trace.nflavors) {
+ fprintf(stderr, "Error in reading checkpoint file: tracer nflavors, me=%d\n",
+ E->parallel.me);
+ fprintf(stderr, "%d\n", itmp);
+ exit(-1);
+
+ }
+
+ fread(&itmp, sizeof(int), 1, fp);
+ E->trace.ilast_tracer_count = itmp;
+
+ /* # of tracers, allocate memory */
+ for(m=1; m<=E->sphere.caps_per_proc; m++) {
+ fread(&itmp, sizeof(int), 1, fp);
+ allocate_tracer_arrays(E, m, itmp);
+ E->trace.ntracers[m] = itmp;
+ }
+
+ /* read tracer data */
+ for(m=1; m<=E->sphere.caps_per_proc; m++) {
+ for(i=0; i<6; i++) {
+ fread(E->trace.basicq[m][i], sizeof(double),
+ E->trace.ntracers[m]+1, fp);
+ }
+ for(i=0; i<E->trace.number_of_extra_quantities; i++) {
+ fread(E->trace.extraq[m][i], sizeof(double),
+ E->trace.ntracers[m]+1, fp);
+ }
+ fread(E->trace.ielement[m], sizeof(int),
+ E->trace.ntracers[m]+1, fp);
+ }
+
+ /* init E->trace.ntracer_flavor */
+ count_tracers_of_flavors(E);
+
+ return;
+}
+
+
+static void composition_checkpoint(struct All_variables *E, FILE *fp)
+{
+ int i, m;
+
+ write_sentinel(fp);
+
+ fwrite(&(E->composition.ncomp), sizeof(int), 1, fp);
+ fwrite(E->composition.bulk_composition, sizeof(double),
+ E->composition.ncomp, fp);
+ fwrite(E->composition.initial_bulk_composition, sizeof(double),
+ E->composition.ncomp, fp);
+
+ /* the 0-th element of comp_el is not init'd
+ * and won't be used when read it. */
+ for(m=1; m<=E->sphere.caps_per_proc; m++) {
+ for(i=0; i<E->composition.ncomp; i++)
+ fwrite(E->composition.comp_el[m][i], sizeof(double),
+ E->lmesh.nel+1, fp);
+ }
+
+ return;
+}
+
+
+static void read_composition_checkpoint(struct All_variables *E, FILE *fp)
+{
+ double tmp;
+ int m, i, itmp;
+
+ read_sentinel(fp, E->parallel.me);
+
+ fread(&itmp, sizeof(int), 1, fp);
+ if (itmp != E->composition.ncomp) {
+ fprintf(stderr, "Error in reading checkpoint file: ncomp, me=%d\n",
+ E->parallel.me);
+ fprintf(stderr, "%d\n", itmp);
+ exit(-1);
+ }
+
+ fread(E->composition.bulk_composition, sizeof(double),
+ E->composition.ncomp, fp);
+
+ fread(E->composition.initial_bulk_composition, sizeof(double),
+ E->composition.ncomp, fp);
+
+ for(m=1; m<=E->sphere.caps_per_proc; m++) {
+ for(i=0; i<E->composition.ncomp; i++)
+ fread(E->composition.comp_el[m][i], sizeof(double),
+ E->lmesh.nel+1, fp);
+ }
+
+ /* init E->composition.comp_node */
+ map_composition_to_nodes(E);
+
+ /* preventing uninitialized access */
+ E->trace.istat_iempty = 0;
+
+ for (i=0; i<E->composition.ncomp; i++) {
+ E->composition.error_fraction[i] = E->composition.bulk_composition[i]
+ / E->composition.initial_bulk_composition[i] - 1.0;
+ }
+
+ return;
+}
+
+
+static void energy_checkpoint(struct All_variables *E, FILE *fp)
+{
+ int m;
+
+ write_sentinel(fp);
+
+ for(m=1; m<=E->sphere.caps_per_proc; m++) {
+ fwrite(E->T[m], sizeof(double), E->lmesh.nno+1, fp);
+ fwrite(E->Tdot[m], sizeof(double), E->lmesh.nno+1, fp);
+ }
+
+ return;
+}
+
+
+static void read_energy_checkpoint(struct All_variables *E, FILE *fp)
+{
+ int m;
+
+ read_sentinel(fp, E->parallel.me);
+
+ /* the 0-th element of T/Tdot is not init'd
+ * and won't be used when read it. */
+ for(m=1; m<=E->sphere.caps_per_proc; m++) {
+ if(fread(E->T[m], sizeof(double), E->lmesh.nno+1, fp)!= E->lmesh.nno+1)
+ myerror(E, "read_energy_checkpoint: error at T");
+ if(fread(E->Tdot[m], sizeof(double), E->lmesh.nno+1, fp)!=E->lmesh.nno+1)
+ myerror(E, "read_energy_checkpoint: error at Tdot");
+ }
+
+ return;
+}
+
+
+static void momentum_checkpoint(struct All_variables *E, FILE *fp)
+{
+ int m;
+ float junk[2];
+ junk[0] = junk[1] = 0;
+
+ write_sentinel(fp);
+
+ /* for backward compatibility */
+ fwrite(junk, sizeof(float), 2, fp);
+
+ /* the 0-th element of P/NP/EVI/VI is not init'd
+ * and won't be used when read it. */
+ for(m=1; m<=E->sphere.caps_per_proc; m++) {
+ /* Pressure at equation points */
+ fwrite(E->P[m], sizeof(double), E->lmesh.npno+1, fp);
+
+ /* velocity at equation points */
+ fwrite(E->U[m], sizeof(double), E->lmesh.neq, fp);
+ }
+
+ return;
+}
+
+
+static void read_momentum_checkpoint(struct All_variables *E, FILE *fp)
+{
+ int m;
+ int lev = E->mesh.levmax;
+ float junk[2];
+
+ read_sentinel(fp, E->parallel.me);
+
+ /* for backward compatibility */
+ if(fread(junk, sizeof(float), 2, fp)!=2)
+ myerror(E, "read_momentum_checkpoint: error at vdotv");
+
+ for(m=1; m<=E->sphere.caps_per_proc; m++) {
+ /* Pressure at equation points */
+ if(fread(E->P[m], sizeof(double), E->lmesh.npno+1, fp) != E->lmesh.npno+1)
+ myerror(E, "read_momentum_checkpoint: error at P");
+ /* velocity at equation points */
+ if(fread(E->U[m], sizeof(double), E->lmesh.neq, fp) != E->lmesh.neq)
+ myerror(E, "read_momentum_checkpoint: error at U");
+ }
+
+ E->monitor.vdotv = global_v_norm2(E, E->U);
+ E->monitor.pdotp = global_p_norm2(E, E->P);
+
+ /* update velocity array */
+ v_from_vector(E);
+
+ /* init E->NP */
+ p_to_nodes(E, E->P, E->NP, lev);
+
+ return;
+}
+
+
Deleted: mc/3D/CitcomS/branches/cxx/lib/Citcom_init.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Citcom_init.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Citcom_init.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,59 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-
-#include "global_defs.h"
-#include "citcom_init.h"
-
-struct All_variables* citcom_init(MPI_Comm *world)
-{
- int get_process_identifier();
-
- struct All_variables *E;
- int rank, nproc;
-
- E = (struct All_variables*) malloc(sizeof(struct All_variables));
-
- MPI_Comm_rank(*world, &rank);
- MPI_Comm_size(*world, &nproc);
-
- E->control.PID = get_process_identifier();
- E->parallel.world = *world;
- E->parallel.nproc = nproc;
- E->parallel.me = rank;
-
- /* fprintf(stderr,"%d in %d processpors, E at %p pid=%d\n",
- rank, nproc, E, E->control.PID); */
-
- E->monitor.solution_cycles=0;
- E->control.keep_going=1;
-
- E->control.total_iteration_cycles=0;
- E->control.total_v_solver_calls=0;
-
- return(E);
-}
Copied: mc/3D/CitcomS/branches/cxx/lib/Citcom_init.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Citcom_init.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Citcom_init.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Citcom_init.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,59 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+
+#include "global_defs.h"
+#include "citcom_init.h"
+
+struct All_variables* citcom_init(MPI_Comm *world)
+{
+ int get_process_identifier();
+
+ struct All_variables *E;
+ int rank, nproc;
+
+ E = (struct All_variables*) malloc(sizeof(struct All_variables));
+
+ MPI_Comm_rank(*world, &rank);
+ MPI_Comm_size(*world, &nproc);
+
+ E->control.PID = get_process_identifier();
+ E->parallel.world = *world;
+ E->parallel.nproc = nproc;
+ E->parallel.me = rank;
+
+ /* fprintf(stderr,"%d in %d processpors, E at %p pid=%d\n",
+ rank, nproc, E, E->control.PID); */
+
+ E->monitor.solution_cycles=0;
+ E->control.keep_going=1;
+
+ E->control.total_iteration_cycles=0;
+ E->control.total_v_solver_calls=0;
+
+ return(E);
+}
Deleted: mc/3D/CitcomS/branches/cxx/lib/Composition_related.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Composition_related.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Composition_related.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,534 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-
-#include <math.h>
-#include "global_defs.h"
-#include "parsing.h"
-#include "parallel_related.h"
-#include "composition_related.h"
-
-
-static void allocate_composition_memory(struct All_variables *E);
-static void compute_elemental_composition_ratio_method(struct All_variables *E);
-static void init_bulk_composition(struct All_variables *E);
-static void check_initial_composition(struct All_variables *E);
-static void fill_composition_from_neighbors(struct All_variables *E);
-
-
-void composition_input(struct All_variables *E)
-{
- int i;
- int m = E->parallel.me;
-
- input_boolean("chemical_buoyancy",
- &(E->composition.ichemical_buoyancy),
- "1,0,nomax",m);
-
- if (E->control.tracer && E->composition.ichemical_buoyancy) {
-
- /* ibuoy_type=0 (absolute method) */
- /* ibuoy_type=1 (ratio method) */
-
- input_int("buoy_type",&(E->composition.ibuoy_type),"1,0,nomax",m);
- if (E->composition.ibuoy_type!=1) {
- fprintf(stderr,"Terror-Sorry, only ratio method allowed now\n");
- fflush(stderr);
- parallel_process_termination();
- }
-
- if (E->composition.ibuoy_type==0)
- E->composition.ncomp = E->trace.nflavors;
- else if (E->composition.ibuoy_type==1)
- E->composition.ncomp = E->trace.nflavors - 1;
-
- E->composition.buoyancy_ratio = (double*) malloc(E->composition.ncomp
- *sizeof(double));
-
- /* default values .... */
- for (i=0; i<E->composition.ncomp; i++)
- E->composition.buoyancy_ratio[i] = 1.0;
-
- input_double_vector("buoyancy_ratio", E->composition.ncomp,
- E->composition.buoyancy_ratio,m);
-
- }
-
-
- /* compositional rheology */
-
- /* icompositional_rheology=0 (off) */
- /* icompositional_rheology=1 (on) */
- E->composition.icompositional_rheology = 0;
- /*
- input_int("compositional_rheology",
- &(E->composition.icompositional_rheology),"1,0,nomax",m);
-
- if (E->composition.icompositional_rheology==1) {
- input_double("compositional_prefactor",
- &(E->composition.compositional_rheology_prefactor),
- "1.0",m);
- }
- */
-
- return;
-}
-
-
-
-void composition_setup(struct All_variables *E)
-{
- allocate_composition_memory(E);
-
- return;
-}
-
-
-void write_composition_instructions(struct All_variables *E)
-{
- int k;
-
- if (E->composition.ichemical_buoyancy ||
- E->composition.icompositional_rheology)
- E->composition.on = 1;
-
- if (E->composition.on) {
-
- if (E->trace.nflavors < 1) {
- fprintf(E->trace.fpt, "Tracer flavors must be greater than 1 to track composition\n");
- parallel_process_termination();
- }
-
- if (!E->composition.ichemical_buoyancy)
- fprintf(E->trace.fpt,"Passive Tracers\n");
- else
- fprintf(E->trace.fpt,"Active Tracers\n");
-
-
- if (E->composition.ibuoy_type==1)
- fprintf(E->trace.fpt,"Ratio Method\n");
- if (E->composition.ibuoy_type==0)
- fprintf(E->trace.fpt,"Absolute Method\n");
-
- for(k=0; k<E->composition.ncomp; k++) {
- fprintf(E->trace.fpt,"Buoyancy Ratio: %f\n", E->composition.buoyancy_ratio[k]);
- }
-
- /*
- if (E->composition.icompositional_rheology==0) {
- fprintf(E->trace.fpt,"Compositional Rheology - OFF\n");
- }
- else if (E->composition.icompositional_rheology>0) {
- fprintf(E->trace.fpt,"Compositional Rheology - ON\n");
- fprintf(E->trace.fpt,"Compositional Prefactor: %f\n",
- E->composition.compositional_rheology_prefactor);
- }
- */
-
- fflush(E->trace.fpt);
- }
-
- return;
-}
-
-
-/************ FILL COMPOSITION ************************/
-void fill_composition(struct All_variables *E)
-{
-
- /* XXX: Currently, only the ratio method works here. */
- /* Will have to come back here to include the absolute method. */
-
- /* ratio method */
-
- if (E->composition.ibuoy_type==1) {
- compute_elemental_composition_ratio_method(E);
- }
-
- /* absolute method */
-
- if (E->composition.ibuoy_type!=1) {
- fprintf(E->trace.fpt,"Error(compute...)-only ratio method now\n");
- fflush(E->trace.fpt);
- exit(10);
- }
-
- /* Map elemental composition to nodal points */
-
- map_composition_to_nodes(E);
-
- return;
-}
-
-
-
-static void allocate_composition_memory(struct All_variables *E)
-{
- int i, j;
-
- for (i=0; i<E->composition.ncomp; i++) {
- E->composition.bulk_composition = (double*) malloc(E->composition.ncomp*sizeof(double));
- E->composition.initial_bulk_composition = (double*) malloc(E->composition.ncomp*sizeof(double));
- E->composition.error_fraction = (double*) malloc(E->composition.ncomp*sizeof(double));
- }
-
-
- /* for horizontal average */
- E->Have.C = (float **)malloc((E->composition.ncomp+1)*sizeof(float*));
- for (i=0; i<E->composition.ncomp; i++) {
- E->Have.C[i] = (float *)malloc((E->lmesh.noz+2)*sizeof(float));
- }
-
-
- /* allocat memory for composition fields at the nodes and elements */
-
- for (j=1;j<=E->sphere.caps_per_proc;j++) {
- if ((E->composition.comp_el[j]=(double **)malloc((E->composition.ncomp)*sizeof(double*)))==NULL) {
- fprintf(E->trace.fpt,"AKM(allocate_composition_memory)-no memory 8987y\n");
- fflush(E->trace.fpt);
- exit(10);
- }
- if ((E->composition.comp_node[j]=(double **)malloc((E->composition.ncomp)*sizeof(double*)))==NULL) {
- fprintf(E->trace.fpt,"AKM(allocate_composition_memory)-no memory 8988y\n");
- fflush(E->trace.fpt);
- exit(10);
- }
-
- for (i=0; i<E->composition.ncomp; i++) {
- if ((E->composition.comp_el[j][i]=(double *)malloc((E->lmesh.nel+1)*sizeof(double)))==NULL) {
- fprintf(E->trace.fpt,"AKM(allocate_composition_memory)-no memory 8989y\n");
- fflush(E->trace.fpt);
- exit(10);
- }
-
- if ((E->composition.comp_node[j][i]=(double *)malloc((E->lmesh.nno+1)*sizeof(double)))==NULL) {
- fprintf(E->trace.fpt,"AKM(allocate_composition_memory)-no memory 983rk\n");
- fflush(E->trace.fpt);
- exit(10);
- }
- }
-
- }
-
- return;
-}
-
-
-void init_composition(struct All_variables *E)
-{
- /* XXX: Currently, only the ratio method works here. */
- /* Will have to come back here to include the absolute method. */
-
- /* ratio method */
- if (E->composition.ibuoy_type==1) {
- compute_elemental_composition_ratio_method(E);
- }
-
- /* absolute method */
- if (E->composition.ibuoy_type!=1) {
- fprintf(E->trace.fpt,"Error(compute...)-only ratio method now\n");
- fflush(E->trace.fpt);
- exit(10);
- }
-
- /* for empty elements */
- check_initial_composition(E);
-
- /* Map elemental composition to nodal points */
- map_composition_to_nodes(E);
-
- init_bulk_composition(E);
-
- return;
-}
-
-
-static void check_initial_composition(struct All_variables *E)
-{
- /* check empty element if using ratio method */
- if (E->composition.ibuoy_type == 1) {
- if (E->trace.istat_iempty) {
- /* using the composition of neighboring elements to determine
- the initial composition of empty elements. */
- fill_composition_from_neighbors(E);
- }
- }
-
- return;
-}
-
-
-
-/*********** COMPUTE ELEMENTAL COMPOSITION RATIO METHOD ***/
-/* */
-/* This function computes the composition per element. */
-/* The concentration of material i in an element is */
-/* defined as: */
-/* (# of tracers of flavor i) / (# of all tracers) */
-
-static void compute_elemental_composition_ratio_method(struct All_variables *E)
-{
- int i, j, e, flavor, numtracers;
- int iempty = 0;
-
-
- for (j=1; j<=E->sphere.caps_per_proc; j++) {
- for (e=1; e<=E->lmesh.nel; e++) {
- numtracers = 0;
- for (flavor=0; flavor<E->trace.nflavors; flavor++)
- numtracers += E->trace.ntracer_flavor[j][flavor][e];
-
- /* Check for empty entries and compute ratio. */
- /* If no tracers are in an element, skip this element, */
- /* use previous composition. */
- if (numtracers == 0) {
- iempty++;
- /* fprintf(E->trace.fpt, "No tracer in element %d!\n", e); */
- continue;
- }
-
- for(i=0;i<E->composition.ncomp;i++) {
- flavor = i + 1;
- E->composition.comp_el[j][i][e] =
- E->trace.ntracer_flavor[j][flavor][e] / (double)numtracers;
- }
- }
-
-
- if (iempty) {
-
- if ((1.0*iempty/E->lmesh.nel)>0.80) {
- fprintf(E->trace.fpt,"WARNING(compute_elemental...)-number of tracers is REALLY LOW\n");
- fflush(E->trace.fpt);
- if (E->trace.itracer_warnings) exit(10);
- }
- }
-
- } /* end j */
-
- E->trace.istat_iempty += iempty;
-
- return;
-}
-
-/********** MAP COMPOSITION TO NODES ****************/
-/* */
-
-
-void map_composition_to_nodes(struct All_variables *E)
-{
- double *tmp[NCS];
- int i, n, kk;
- int nelem, nodenum;
- int j;
-
-
- for (j=1;j<=E->sphere.caps_per_proc;j++) {
-
- /* first, initialize node array */
- for(i=0;i<E->composition.ncomp;i++) {
- for (kk=1;kk<=E->lmesh.nno;kk++)
- E->composition.comp_node[j][i][kk]=0.0;
- }
-
- /* Loop through all elements */
- for (nelem=1;nelem<=E->lmesh.nel;nelem++) {
-
- /* for each element, loop through element nodes */
-
- /* weight composition */
-
- for (nodenum=1;nodenum<=8;nodenum++) {
- n = E->ien[j][nelem].node[nodenum];
- for(i=0;i<E->composition.ncomp;i++) {
-
- E->composition.comp_node[j][i][n] +=
- E->composition.comp_el[j][i][nelem]*
- E->TWW[E->mesh.levmax][j][nelem].node[nodenum];
- }
- }
-
- } /* end nelem */
- } /* end j */
-
- for(i=0;i<E->composition.ncomp;i++) {
- for (j=1;j<=E->sphere.caps_per_proc;j++)
- tmp[j] = E->composition.comp_node[j][i];
-
- (E->exchange_node_d)(E,tmp,E->mesh.levmax);
- }
-
- /* Divide by nodal volume */
- for (j=1;j<=E->sphere.caps_per_proc;j++) {
- for(i=0;i<E->composition.ncomp;i++)
- for (kk=1;kk<=E->lmesh.nno;kk++)
- E->composition.comp_node[j][i][kk] *= E->MASS[E->mesh.levmax][j][kk];
-
- /* testing */
- /**
- for(i=0;i<E->composition.ncomp;i++)
- for (kk=1;kk<=E->lmesh.nel;kk++) {
- fprintf(E->trace.fpt,"%d %f\n",kk,E->composition.comp_el[j][i][kk]);
- }
-
- for(i=0;i<E->composition.ncomp;i++)
- for (kk=1;kk<=E->lmesh.nno;kk++) {
- fprintf(E->trace.fpt,"%d %f %f\n",kk,E->sx[j][3][kk],E->composition.comp_node[j][i][kk]);
- }
- fflush(E->trace.fpt);
- /**/
-
- } /* end j */
-
- return;
-}
-
-
-/****************************************************************/
-
-static void fill_composition_from_neighbors(struct All_variables *E)
-{
- int i, j, k, e, ee, n, flavor, numtracers, count;
- double *sum;
- const int n_nghbrs = 4;
- int nghbrs[n_nghbrs];
- int *is_empty;
-
- fprintf(E->trace.fpt,"WARNING(check_initial_composition)-number of tracers is low, %d elements contain no tracer initially\n", E->trace.istat_iempty);
-
- fprintf(E->trace.fpt,"Using neighboring elements for initial composition...\n");
-
- /* index shift for neighboring elements in horizontal direction */
- nghbrs[0] = E->lmesh.elz;
- nghbrs[1] = -E->lmesh.elz;
- nghbrs[2] = E->lmesh.elz * E->lmesh.elx;
- nghbrs[3] = -E->lmesh.elz * E->lmesh.elx;
-
- is_empty = (int *)calloc(E->lmesh.nel+1, sizeof(int));
- sum = (double *)malloc(E->composition.ncomp * sizeof(double));
-
- for (j=1; j<=E->sphere.caps_per_proc; j++) {
- /* which element is empty? */
- for (e=1; e<=E->lmesh.nel; e++) {
- numtracers = 0;
- for (flavor=0; flavor<E->trace.nflavors; flavor++)
- numtracers += E->trace.ntracer_flavor[j][flavor][e];
-
- if (numtracers == 0)
- is_empty[e] = 1;
- }
-
- /* using the average comp_el from neighboring elements */
- for (e=1; e<=E->lmesh.nel; e++) {
- if(is_empty[e]) {
- count = 0;
- for (i=0; i<E->composition.ncomp; i++)
- sum[i] = 0.0;
-
- for(n=0; n<n_nghbrs; n++) {
- ee = e + nghbrs[n];
- /* is ee a valid element number and the elemnt is not empty? */
- if((ee>0) && (ee<=E->lmesh.nel) && (!is_empty[ee])) {
- count++;
- for (i=0; i<E->composition.ncomp; i++)
- sum[i] += E->composition.comp_el[j][i][ee];
- }
- }
-
- if(count == 0) {
- fprintf(E->trace.fpt,"Error(fill_composition_from_neighbors)-all neighboring elements are empty\n");
- fflush(E->trace.fpt);
- exit(10);
- }
-
- for (i=0; i<E->composition.ncomp; i++)
- E->composition.comp_el[j][i][e] = sum[i] / count;
- }
- }
- }
-
- free(is_empty);
- free(sum);
-
- fprintf(E->trace.fpt,"Done.\n");
- fflush(E->trace.fpt);
- return;
-}
-
-
-/*********** GET BULK COMPOSITION *******************************/
-
-static void init_bulk_composition(struct All_variables *E)
-{
-
- double return_bulk_value_d();
- double volume;
- double *tmp[NCS];
- int i, m;
- const int ival=0;
-
-
- for (i=0; i<E->composition.ncomp; i++) {
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- tmp[m] = E->composition.comp_node[m][i];
-
- /* ival=0 returns integral not average */
- volume = return_bulk_value_d(E,tmp,ival);
-
- E->composition.bulk_composition[i] = volume;
- E->composition.initial_bulk_composition[i] = volume;
- }
-
- return;
-}
-
-
-void get_bulk_composition(struct All_variables *E)
-{
-
- double return_bulk_value_d();
- double volume;
- double *tmp[NCS];
- int i, m;
- const int ival = 0;
-
- for (i=0; i<E->composition.ncomp; i++) {
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- tmp[m] = E->composition.comp_node[m][i];
-
- /* ival=0 returns integral not average */
- volume = return_bulk_value_d(E,tmp,ival);
-
- E->composition.bulk_composition[i] = volume;
-
- E->composition.error_fraction[i] = (volume - E->composition.initial_bulk_composition[i]) / E->composition.initial_bulk_composition[i];
- }
-
- return;
-}
Copied: mc/3D/CitcomS/branches/cxx/lib/Composition_related.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Composition_related.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Composition_related.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Composition_related.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,534 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+
+#include <math.h>
+#include "global_defs.h"
+#include "parsing.h"
+#include "parallel_related.h"
+#include "composition_related.h"
+
+#include "cproto.h"
+
+
+static void allocate_composition_memory(struct All_variables *E);
+static void compute_elemental_composition_ratio_method(struct All_variables *E);
+static void init_bulk_composition(struct All_variables *E);
+static void check_initial_composition(struct All_variables *E);
+static void fill_composition_from_neighbors(struct All_variables *E);
+
+
+void composition_input(struct All_variables *E)
+{
+ int i;
+ int m = E->parallel.me;
+
+ input_boolean("chemical_buoyancy",
+ &(E->composition.ichemical_buoyancy),
+ "1,0,nomax",m);
+
+ if (E->control.tracer && E->composition.ichemical_buoyancy) {
+
+ /* ibuoy_type=0 (absolute method) */
+ /* ibuoy_type=1 (ratio method) */
+
+ input_int("buoy_type",&(E->composition.ibuoy_type),"1,0,nomax",m);
+ if (E->composition.ibuoy_type!=1) {
+ fprintf(stderr,"Terror-Sorry, only ratio method allowed now\n");
+ fflush(stderr);
+ parallel_process_termination();
+ }
+
+ if (E->composition.ibuoy_type==0)
+ E->composition.ncomp = E->trace.nflavors;
+ else if (E->composition.ibuoy_type==1)
+ E->composition.ncomp = E->trace.nflavors - 1;
+
+ E->composition.buoyancy_ratio = (double*) malloc(E->composition.ncomp
+ *sizeof(double));
+
+ /* default values .... */
+ for (i=0; i<E->composition.ncomp; i++)
+ E->composition.buoyancy_ratio[i] = 1.0;
+
+ input_double_vector("buoyancy_ratio", E->composition.ncomp,
+ E->composition.buoyancy_ratio,m);
+
+ }
+
+
+ /* compositional rheology */
+
+ /* icompositional_rheology=0 (off) */
+ /* icompositional_rheology=1 (on) */
+ E->composition.icompositional_rheology = 0;
+ /*
+ input_int("compositional_rheology",
+ &(E->composition.icompositional_rheology),"1,0,nomax",m);
+
+ if (E->composition.icompositional_rheology==1) {
+ input_double("compositional_prefactor",
+ &(E->composition.compositional_rheology_prefactor),
+ "1.0",m);
+ }
+ */
+
+ return;
+}
+
+
+
+void composition_setup(struct All_variables *E)
+{
+ allocate_composition_memory(E);
+
+ return;
+}
+
+
+void write_composition_instructions(struct All_variables *E)
+{
+ int k;
+
+ if (E->composition.ichemical_buoyancy ||
+ E->composition.icompositional_rheology)
+ E->composition.on = 1;
+
+ if (E->composition.on) {
+
+ if (E->trace.nflavors < 1) {
+ fprintf(E->trace.fpt, "Tracer flavors must be greater than 1 to track composition\n");
+ parallel_process_termination();
+ }
+
+ if (!E->composition.ichemical_buoyancy)
+ fprintf(E->trace.fpt,"Passive Tracers\n");
+ else
+ fprintf(E->trace.fpt,"Active Tracers\n");
+
+
+ if (E->composition.ibuoy_type==1)
+ fprintf(E->trace.fpt,"Ratio Method\n");
+ if (E->composition.ibuoy_type==0)
+ fprintf(E->trace.fpt,"Absolute Method\n");
+
+ for(k=0; k<E->composition.ncomp; k++) {
+ fprintf(E->trace.fpt,"Buoyancy Ratio: %f\n", E->composition.buoyancy_ratio[k]);
+ }
+
+ /*
+ if (E->composition.icompositional_rheology==0) {
+ fprintf(E->trace.fpt,"Compositional Rheology - OFF\n");
+ }
+ else if (E->composition.icompositional_rheology>0) {
+ fprintf(E->trace.fpt,"Compositional Rheology - ON\n");
+ fprintf(E->trace.fpt,"Compositional Prefactor: %f\n",
+ E->composition.compositional_rheology_prefactor);
+ }
+ */
+
+ fflush(E->trace.fpt);
+ }
+
+ return;
+}
+
+
+/************ FILL COMPOSITION ************************/
+void fill_composition(struct All_variables *E)
+{
+
+ /* XXX: Currently, only the ratio method works here. */
+ /* Will have to come back here to include the absolute method. */
+
+ /* ratio method */
+
+ if (E->composition.ibuoy_type==1) {
+ compute_elemental_composition_ratio_method(E);
+ }
+
+ /* absolute method */
+
+ if (E->composition.ibuoy_type!=1) {
+ fprintf(E->trace.fpt,"Error(compute...)-only ratio method now\n");
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+
+ /* Map elemental composition to nodal points */
+
+ map_composition_to_nodes(E);
+
+ return;
+}
+
+
+
+static void allocate_composition_memory(struct All_variables *E)
+{
+ int i, j;
+
+ for (i=0; i<E->composition.ncomp; i++) {
+ E->composition.bulk_composition = (double*) malloc(E->composition.ncomp*sizeof(double));
+ E->composition.initial_bulk_composition = (double*) malloc(E->composition.ncomp*sizeof(double));
+ E->composition.error_fraction = (double*) malloc(E->composition.ncomp*sizeof(double));
+ }
+
+
+ /* for horizontal average */
+ E->Have.C = (float **)malloc((E->composition.ncomp+1)*sizeof(float*));
+ for (i=0; i<E->composition.ncomp; i++) {
+ E->Have.C[i] = (float *)malloc((E->lmesh.noz+2)*sizeof(float));
+ }
+
+
+ /* allocat memory for composition fields at the nodes and elements */
+
+ for (j=1;j<=E->sphere.caps_per_proc;j++) {
+ if ((E->composition.comp_el[j]=(double **)malloc((E->composition.ncomp)*sizeof(double*)))==NULL) {
+ fprintf(E->trace.fpt,"AKM(allocate_composition_memory)-no memory 8987y\n");
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+ if ((E->composition.comp_node[j]=(double **)malloc((E->composition.ncomp)*sizeof(double*)))==NULL) {
+ fprintf(E->trace.fpt,"AKM(allocate_composition_memory)-no memory 8988y\n");
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+
+ for (i=0; i<E->composition.ncomp; i++) {
+ if ((E->composition.comp_el[j][i]=(double *)malloc((E->lmesh.nel+1)*sizeof(double)))==NULL) {
+ fprintf(E->trace.fpt,"AKM(allocate_composition_memory)-no memory 8989y\n");
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+
+ if ((E->composition.comp_node[j][i]=(double *)malloc((E->lmesh.nno+1)*sizeof(double)))==NULL) {
+ fprintf(E->trace.fpt,"AKM(allocate_composition_memory)-no memory 983rk\n");
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+ }
+
+ }
+
+ return;
+}
+
+
+void init_composition(struct All_variables *E)
+{
+ /* XXX: Currently, only the ratio method works here. */
+ /* Will have to come back here to include the absolute method. */
+
+ /* ratio method */
+ if (E->composition.ibuoy_type==1) {
+ compute_elemental_composition_ratio_method(E);
+ }
+
+ /* absolute method */
+ if (E->composition.ibuoy_type!=1) {
+ fprintf(E->trace.fpt,"Error(compute...)-only ratio method now\n");
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+
+ /* for empty elements */
+ check_initial_composition(E);
+
+ /* Map elemental composition to nodal points */
+ map_composition_to_nodes(E);
+
+ init_bulk_composition(E);
+
+ return;
+}
+
+
+static void check_initial_composition(struct All_variables *E)
+{
+ /* check empty element if using ratio method */
+ if (E->composition.ibuoy_type == 1) {
+ if (E->trace.istat_iempty) {
+ /* using the composition of neighboring elements to determine
+ the initial composition of empty elements. */
+ fill_composition_from_neighbors(E);
+ }
+ }
+
+ return;
+}
+
+
+
+/*********** COMPUTE ELEMENTAL COMPOSITION RATIO METHOD ***/
+/* */
+/* This function computes the composition per element. */
+/* The concentration of material i in an element is */
+/* defined as: */
+/* (# of tracers of flavor i) / (# of all tracers) */
+
+static void compute_elemental_composition_ratio_method(struct All_variables *E)
+{
+ int i, j, e, flavor, numtracers;
+ int iempty = 0;
+
+
+ for (j=1; j<=E->sphere.caps_per_proc; j++) {
+ for (e=1; e<=E->lmesh.nel; e++) {
+ numtracers = 0;
+ for (flavor=0; flavor<E->trace.nflavors; flavor++)
+ numtracers += E->trace.ntracer_flavor[j][flavor][e];
+
+ /* Check for empty entries and compute ratio. */
+ /* If no tracers are in an element, skip this element, */
+ /* use previous composition. */
+ if (numtracers == 0) {
+ iempty++;
+ /* fprintf(E->trace.fpt, "No tracer in element %d!\n", e); */
+ continue;
+ }
+
+ for(i=0;i<E->composition.ncomp;i++) {
+ flavor = i + 1;
+ E->composition.comp_el[j][i][e] =
+ E->trace.ntracer_flavor[j][flavor][e] / (double)numtracers;
+ }
+ }
+
+
+ if (iempty) {
+
+ if ((1.0*iempty/E->lmesh.nel)>0.80) {
+ fprintf(E->trace.fpt,"WARNING(compute_elemental...)-number of tracers is REALLY LOW\n");
+ fflush(E->trace.fpt);
+ if (E->trace.itracer_warnings) exit(10);
+ }
+ }
+
+ } /* end j */
+
+ E->trace.istat_iempty += iempty;
+
+ return;
+}
+
+/********** MAP COMPOSITION TO NODES ****************/
+/* */
+
+
+void map_composition_to_nodes(struct All_variables *E)
+{
+ double *tmp[NCS];
+ int i, n, kk;
+ int nelem, nodenum;
+ int j;
+
+
+ for (j=1;j<=E->sphere.caps_per_proc;j++) {
+
+ /* first, initialize node array */
+ for(i=0;i<E->composition.ncomp;i++) {
+ for (kk=1;kk<=E->lmesh.nno;kk++)
+ E->composition.comp_node[j][i][kk]=0.0;
+ }
+
+ /* Loop through all elements */
+ for (nelem=1;nelem<=E->lmesh.nel;nelem++) {
+
+ /* for each element, loop through element nodes */
+
+ /* weight composition */
+
+ for (nodenum=1;nodenum<=8;nodenum++) {
+ n = E->ien[j][nelem].node[nodenum];
+ for(i=0;i<E->composition.ncomp;i++) {
+
+ E->composition.comp_node[j][i][n] +=
+ E->composition.comp_el[j][i][nelem]*
+ E->TWW[E->mesh.levmax][j][nelem].node[nodenum];
+ }
+ }
+
+ } /* end nelem */
+ } /* end j */
+
+ for(i=0;i<E->composition.ncomp;i++) {
+ for (j=1;j<=E->sphere.caps_per_proc;j++)
+ tmp[j] = E->composition.comp_node[j][i];
+
+ (E->exchange_node_d)(E,tmp,E->mesh.levmax);
+ }
+
+ /* Divide by nodal volume */
+ for (j=1;j<=E->sphere.caps_per_proc;j++) {
+ for(i=0;i<E->composition.ncomp;i++)
+ for (kk=1;kk<=E->lmesh.nno;kk++)
+ E->composition.comp_node[j][i][kk] *= E->MASS[E->mesh.levmax][j][kk];
+
+ /* testing */
+ /**
+ for(i=0;i<E->composition.ncomp;i++)
+ for (kk=1;kk<=E->lmesh.nel;kk++) {
+ fprintf(E->trace.fpt,"%d %f\n",kk,E->composition.comp_el[j][i][kk]);
+ }
+
+ for(i=0;i<E->composition.ncomp;i++)
+ for (kk=1;kk<=E->lmesh.nno;kk++) {
+ fprintf(E->trace.fpt,"%d %f %f\n",kk,E->sx[j][3][kk],E->composition.comp_node[j][i][kk]);
+ }
+ fflush(E->trace.fpt);
+ /**/
+
+ } /* end j */
+
+ return;
+}
+
+
+/****************************************************************/
+
+static void fill_composition_from_neighbors(struct All_variables *E)
+{
+ int i, j, k, e, ee, n, flavor, numtracers, count;
+ double *sum;
+ const int n_nghbrs = 4;
+ int nghbrs[n_nghbrs];
+ int *is_empty;
+
+ fprintf(E->trace.fpt,"WARNING(check_initial_composition)-number of tracers is low, %d elements contain no tracer initially\n", E->trace.istat_iempty);
+
+ fprintf(E->trace.fpt,"Using neighboring elements for initial composition...\n");
+
+ /* index shift for neighboring elements in horizontal direction */
+ nghbrs[0] = E->lmesh.elz;
+ nghbrs[1] = -E->lmesh.elz;
+ nghbrs[2] = E->lmesh.elz * E->lmesh.elx;
+ nghbrs[3] = -E->lmesh.elz * E->lmesh.elx;
+
+ is_empty = (int *)calloc(E->lmesh.nel+1, sizeof(int));
+ sum = (double *)malloc(E->composition.ncomp * sizeof(double));
+
+ for (j=1; j<=E->sphere.caps_per_proc; j++) {
+ /* which element is empty? */
+ for (e=1; e<=E->lmesh.nel; e++) {
+ numtracers = 0;
+ for (flavor=0; flavor<E->trace.nflavors; flavor++)
+ numtracers += E->trace.ntracer_flavor[j][flavor][e];
+
+ if (numtracers == 0)
+ is_empty[e] = 1;
+ }
+
+ /* using the average comp_el from neighboring elements */
+ for (e=1; e<=E->lmesh.nel; e++) {
+ if(is_empty[e]) {
+ count = 0;
+ for (i=0; i<E->composition.ncomp; i++)
+ sum[i] = 0.0;
+
+ for(n=0; n<n_nghbrs; n++) {
+ ee = e + nghbrs[n];
+ /* is ee a valid element number and the elemnt is not empty? */
+ if((ee>0) && (ee<=E->lmesh.nel) && (!is_empty[ee])) {
+ count++;
+ for (i=0; i<E->composition.ncomp; i++)
+ sum[i] += E->composition.comp_el[j][i][ee];
+ }
+ }
+
+ if(count == 0) {
+ fprintf(E->trace.fpt,"Error(fill_composition_from_neighbors)-all neighboring elements are empty\n");
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+
+ for (i=0; i<E->composition.ncomp; i++)
+ E->composition.comp_el[j][i][e] = sum[i] / count;
+ }
+ }
+ }
+
+ free(is_empty);
+ free(sum);
+
+ fprintf(E->trace.fpt,"Done.\n");
+ fflush(E->trace.fpt);
+ return;
+}
+
+
+/*********** GET BULK COMPOSITION *******************************/
+
+static void init_bulk_composition(struct All_variables *E)
+{
+
+ double volume;
+ double *tmp[NCS];
+ int i, m;
+ const int ival=0;
+
+
+ for (i=0; i<E->composition.ncomp; i++) {
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ tmp[m] = E->composition.comp_node[m][i];
+
+ /* ival=0 returns integral not average */
+ volume = return_bulk_value_d(E,tmp,ival);
+
+ E->composition.bulk_composition[i] = volume;
+ E->composition.initial_bulk_composition[i] = volume;
+ }
+
+ return;
+}
+
+
+void get_bulk_composition(struct All_variables *E)
+{
+
+ double volume;
+ double *tmp[NCS];
+ int i, m;
+ const int ival = 0;
+
+ for (i=0; i<E->composition.ncomp; i++) {
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ tmp[m] = E->composition.comp_node[m][i];
+
+ /* ival=0 returns integral not average */
+ volume = return_bulk_value_d(E,tmp,ival);
+
+ E->composition.bulk_composition[i] = volume;
+
+ E->composition.error_fraction[i] = (volume - E->composition.initial_bulk_composition[i]) / E->composition.initial_bulk_composition[i];
+ }
+
+ return;
+}
Deleted: mc/3D/CitcomS/branches/cxx/lib/Construct_arrays.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Construct_arrays.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Construct_arrays.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,843 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-#include <math.h>
-#include <sys/types.h>
-#include "element_definitions.h"
-#include "global_defs.h"
-
-int layers_r(struct All_variables *,float );
-int layers(struct All_variables *,int ,int );
-
-
-/*========================================================
- Function to make the IEN array for a mesh of given
- dimension. IEN is an externally defined structure array
-
- NOTE: this is not really general enough for new elements:
- it should be done through a pre-calculated lookup table.
- ======================================================== */
-
-void construct_ien(E)
- struct All_variables *E;
-
-{
- int lev,p,q,r,rr,j;
- int element,start,nel,nno;
- int elz,elx,ely,nox,noy,noz;
-
- const int dims=E->mesh.nsd;
- const int ends=enodes[dims];
-
- for (lev=E->mesh.levmax;lev>=E->mesh.levmin;lev--) {
- for (j=1;j<=E->sphere.caps_per_proc;j++) {
-
- elx = E->lmesh.ELX[lev];
- elz = E->lmesh.ELZ[lev];
- ely = E->lmesh.ELY[lev];
- nox = E->lmesh.NOX[lev];
- noz = E->lmesh.NOZ[lev];
- noy = E->lmesh.NOY[lev];
- nel=E->lmesh.NEL[lev];
- nno=E->lmesh.NNO[lev];
-
- for(r=1;r<=ely;r++)
- for(q=1;q<=elx;q++)
- for(p=1;p<=elz;p++) {
- element = (r-1)*elx*elz + (q-1)*elz + p;
- start = (r-1)*noz*nox + (q-1)*noz + p;
- for(rr=1;rr<=ends;rr++)
- E->IEN[lev][j][element].node[rr]= start
- + offset[rr].vector[0]
- + offset[rr].vector[1]*noz
- + offset[rr].vector[2]*noz*nox;
- }
-
- } /* end for cap j */
- } /* end loop for lev */
-
-
-/* if(E->control.verbose) { */
-/* for (lev=E->mesh.levmax;lev>=E->mesh.levmin;lev--) { */
-/* fprintf(E->fp_out,"output_IEN_arrays me=%d lev=%d \n",E->parallel.me,lev); */
-/* for (j=1;j<=E->sphere.caps_per_proc;j++) { */
-/* fprintf(E->fp_out,"output_IEN_arrays me=%d %d %d\n",E->parallel.me,j,E->sphere.capid[j]); */
-/* for (i=1;i<=E->lmesh.NEL[lev];i++) */
-/* fprintf(E->fp_out,"%d %d %d %d %d %d %d %d %d\n",i,E->IEN[lev][j][i].node[1],E->IEN[lev][j][i].node[2],E->IEN[lev][j][i].node[3],E->IEN[lev][j][i].node[4],E->IEN[lev][j][i].node[5],E->IEN[lev][j][i].node[6],E->IEN[lev][j][i].node[7],E->IEN[lev][j][i].node[8]); */
-/* } */
-/* } */
-/* fflush (E->fp_out); */
-/* } */
-
- return;
-}
-
-
-/* determine surface things */
-
-void construct_surface( struct All_variables *E)
-{
- int i, j, e, element;
-
- for (j=1;j<=E->sphere.caps_per_proc;j++) {
- e = 0;
- for(element=1;element<=E->lmesh.nel;element++)
- if ( element%E->lmesh.elz==0) { /* top */
- e ++;
- E->sien[j][e].node[1] = E->ien[j][element].node[5]/E->lmesh.noz;
- E->sien[j][e].node[2] = E->ien[j][element].node[6]/E->lmesh.noz;
- E->sien[j][e].node[3] = E->ien[j][element].node[7]/E->lmesh.noz;
- E->sien[j][e].node[4] = E->ien[j][element].node[8]/E->lmesh.noz;
- E->surf_element[j][e] = element;
- }
-
- E->lmesh.snel = e;
- for (i=1;i<=E->lmesh.nsf;i++)
- E->surf_node[j][i] = i*E->lmesh.noz;
-
- } /* end for cap j */
-
- if(E->control.verbose) {
- for (j=1;j<=E->sphere.caps_per_proc;j++) {
- for(e=1;e<=E->lmesh.snel;e++) {
- fprintf(E->fp_out, "sien sel=%d node=%d %d %d %d\n",
- e, E->sien[j][e].node[1], E->sien[j][e].node[2], E->sien[j][e].node[3], E->sien[j][e].node[4]);
- }
- }
- }
-}
-
-
-/*============================================
- Function to make the ID array for above case
- ============================================ */
-
-void construct_id(E)
- struct All_variables *E;
-{
- int i,j,k;
- int eqn_count,node,nno;
- int neq, gneq;
- unsigned int type,doff;
- int lev;
- void get_bcs_id_for_residual();
-
- const int dims=E->mesh.nsd,dofs=E->mesh.dof;
- const int ends=enodes[dims];
-
- for(lev=E->mesh.gridmax;lev>=E->mesh.gridmin;lev--) {
- for(j=1;j<=E->sphere.caps_per_proc;j++) {
- eqn_count = 0;
-
- for(node=1;node<=E->lmesh.NNO[lev];node++)
- for(doff=1;doff<=dims;doff++) {
- E->ID[lev][j][node].doff[doff] = eqn_count;
- eqn_count ++;
- }
-
- E->lmesh.NEQ[lev] = eqn_count;
-
- i = 0;
- for(node=1;node<=E->lmesh.NNO[lev];node++) {
- if (E->NODE[lev][j][node] & SKIP)
- for(doff=1;doff<=dims;doff++) {
- i++;
- E->parallel.Skip_id[lev][j][i] = E->ID[lev][j][node].doff[doff];
- }
- }
-
- E->parallel.Skip_neq[lev][j] = i;
-
- /* global # of unskipped eqn */
- neq = E->lmesh.NEQ[lev] - E->parallel.Skip_neq[lev][j];
- MPI_Allreduce(&neq, &gneq, 1, MPI_INT, MPI_SUM, E->parallel.world);
- E->mesh.NEQ[lev] = gneq;
-
- get_bcs_id_for_residual(E,lev,j);
-
- } /* end for j */
- } /* end for lev */
-
- E->lmesh.neq = E->lmesh.NEQ[E->mesh.levmax];
- E->mesh.neq = E->mesh.NEQ[E->mesh.levmax];
-
-/* if (E->control.verbose) { */
-/* fprintf(E->fp_out,"output_ID_arrays \n"); */
-/* for(j=1;j<=E->sphere.caps_per_proc;j++) */
-/* for (i=1;i<=E->lmesh.nno;i++) */
-/* fprintf(E->fp_out,"%d %d %d %d %d\n",eqn_count,i,E->ID[lev][j][i].doff[1],E->ID[lev][j][i].doff[2],E->ID[lev][j][i].doff[3]); */
-/* fflush(E->fp_out); */
-/* } */
-
-
- return;
- }
-
-
-
-void get_bcs_id_for_residual(E,level,m)
- struct All_variables *E;
- int level,m;
- {
-
- int i,j;
-
- const int nno=E->lmesh.NNO[level];
-
- j = 0;
- for(i=1;i<=nno;i++) {
- if ( (E->NODE[level][m][i] & VBX) != 0 ) {
- j++;
- E->zero_resid[level][m][j] = E->ID[level][m][i].doff[1];
- }
- if ( (E->NODE[level][m][i] & VBY) != 0 ) {
- j++;
- E->zero_resid[level][m][j] = E->ID[level][m][i].doff[2];
- }
- if ( (E->NODE[level][m][i] & VBZ) != 0 ) {
- j++;
- E->zero_resid[level][m][j] = E->ID[level][m][i].doff[3];
- }
- }
-
- E->num_zero_resid[level][m] = j;
-
- return;
-}
-
-/*==========================================================
- Function to construct the LM array from the ID and IEN arrays
- ========================================================== */
-
-void construct_lm(E)
- struct All_variables *E;
-{
- int i,j,a,e;
- int lev,eqn_no;
- int nel, nel2;
-
- const int dims=E->mesh.nsd,dofs=E->mesh.dof;
- const int ends=enodes[dims];
-
- return;
-}
-
-
-/* =====================================================
- Function to build the local node matrix indexing maps
- ===================================================== */
-
-void construct_node_maps(E)
- struct All_variables *E;
-{
- double time1,CPU_time0();
-
- int ii,noz,noxz,m,n,nn,lev,i,j,k,jj,kk,ia,ja,is,ie,js,je,ks,ke,doff;
- int neq,nno,dims2,matrix,nox,noy;
-
- const int dims=E->mesh.nsd,dofs=E->mesh.dof;
- const int ends=enodes[dims];
- int max_eqn;
-
- dims2 = dims-1;
- for(lev=E->mesh.gridmax;lev>=E->mesh.gridmin;lev--)
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- neq=E->lmesh.NEQ[lev];
- nno=E->lmesh.NNO[lev];
- noxz = E->lmesh.NOX[lev]*E->lmesh.NOZ[lev];
- noz = E->lmesh.NOZ[lev];
- noy = E->lmesh.NOY[lev];
- nox = E->lmesh.NOX[lev];
- max_eqn = 14*dims;
- matrix = max_eqn*nno;
-
- E->Node_map[lev][m]=(int *) malloc (matrix*sizeof(int));
-
- for(i=0;i<matrix;i++)
- E->Node_map[lev][m][i] = neq; /* neq indicates an invalid eqn # */
-
- for (ii=1;ii<=noy;ii++)
- for (jj=1;jj<=nox;jj++)
- for (kk=1;kk<=noz;kk++) {
- nn = kk + (jj-1)*noz+ (ii-1)*noxz;
- for(doff=1;doff<=dims;doff++)
- E->Node_map[lev][m][(nn-1)*max_eqn+doff-1] = E->ID[lev][m][nn].doff[doff];
-
- ia = 0;
- is=1; ie=dims2;
- js=1; je=dims;
- ks=1; ke=dims;
- if (kk==1 ) ks=2;
- if (kk==noz) ke=2;
- if (jj==1 ) js=2;
- if (jj==nox) je=2;
- if (ii==1 ) is=2;
- if (ii==noy) ie=2;
- for (i=is;i<=ie;i++)
- for (j=js;j<=je;j++)
- for (k=ks;k<=ke;k++) {
- ja = nn-((2-i)*noxz + (2-j)*noz + 2-k);
- if (ja<nn) {
- ia++;
- for (doff=1;doff<=dims;doff++)
- E->Node_map[lev][m][(nn-1)*max_eqn+ia*dims+doff-1]=E->ID[lev][m][ja].doff[doff];
- }
- }
- }
-
- E->Eqn_k1[lev][m] = (higher_precision *)malloc(matrix*sizeof(higher_precision));
- E->Eqn_k2[lev][m] = (higher_precision *)malloc(matrix*sizeof(higher_precision));
- E->Eqn_k3[lev][m] = (higher_precision *)malloc(matrix*sizeof(higher_precision));
-
- E->mesh.matrix_size[lev] = matrix;
-
- if(E->control.verbose) {
- fprintf(E->fp_out, "output Node_map lev=%d m=%d\n", lev, m);
- fprintf(E->fp_out, "neq=%d nno=%d max_eqn=%d matrix=%d\n", neq, nno, max_eqn, matrix);
- for(i=0;i<matrix;i++)
- fprintf(E->fp_out, "%d %d\n", i, E->Node_map[lev][m][i]);
- }
-
- } /* end for level and m */
-
- return;
-}
-
-
-void construct_node_ks(E)
- struct All_variables *E;
-{
- int m,level,i,j,k,e;
- int node,node1,eqn1,eqn2,eqn3,loc0,loc1,loc2,loc3,found,element,index,pp,qq;
- int neq,nno,nel,max_eqn;
-
- double elt_K[24*24];
- double w1,w2,w3,ww1,ww2,ww3,zero;
-
- higher_precision *B1,*B2,*B3;
-
- void get_elt_k();
- void get_aug_k();
- void build_diagonal_of_K();
- void parallel_process_termination();
-
- const int dims=E->mesh.nsd,dofs=E->mesh.dof;
- const int ends=enodes[dims];
- const int lms=loc_mat_size[E->mesh.nsd];
-
- zero = 0.0;
- max_eqn = 14*dims;
-
- for(level=E->mesh.gridmax;level>=E->mesh.gridmin;level--) {
-
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
-
- neq=E->lmesh.NEQ[level];
- nel=E->lmesh.NEL[level];
- nno=E->lmesh.NNO[level];
- for(i=0;i<neq;i++)
- E->BI[level][m][i] = zero;
- for(i=0;i<E->mesh.matrix_size[level];i++) {
- E->Eqn_k1[level][m][i] = zero;
- E->Eqn_k2[level][m][i] = zero;
- E->Eqn_k3[level][m][i] = zero;
- }
-
- for(element=1;element<=nel;element++) {
-
- get_elt_k(E,element,elt_K,level,m,0);
-
- if (E->control.augmented_Lagr)
- get_aug_k(E,element,elt_K,level,m);
-
- build_diagonal_of_K(E,element,elt_K,level,m);
-
- for(i=1;i<=ends;i++) { /* i, is the node we are storing to */
- node=E->IEN[level][m][element].node[i];
-
- pp=(i-1)*dims;
- w1=w2=w3=1.0;
-
- loc0=(node-1)*max_eqn;
-
- if(E->NODE[level][m][node] & VBX) w1=0.0;
- if(E->NODE[level][m][node] & VBZ) w3=0.0;
- if(E->NODE[level][m][node] & VBY) w2=0.0;
-
- for(j=1;j<=ends;j++) { /* j is the node we are receiving from */
- node1=E->IEN[level][m][element].node[j];
-
- /* only for half of the matrix ,because of the symmetry */
- if (node1<=node) {
-
- ww1=ww2=ww3=1.0;
- qq=(j-1)*dims;
- eqn1=E->ID[level][m][node1].doff[1];
- eqn2=E->ID[level][m][node1].doff[2];
- eqn3=E->ID[level][m][node1].doff[3];
-
- if(E->NODE[level][m][node1] & VBX) ww1=0.0;
- if(E->NODE[level][m][node1] & VBZ) ww3=0.0;
- if(E->NODE[level][m][node1] & VBY) ww2=0.0;
-
- /* search for direction 1*/
-
- found=0;
- for(k=0;k<max_eqn;k++)
- if(E->Node_map[level][m][loc0+k] == eqn1) { /* found, index next equation */
- index=k;
- found++;
- break;
- }
-
- assert(found /* direction 1 */);
-
- E->Eqn_k1[level][m][loc0+index] += w1*ww1*elt_K[pp*lms+qq]; /* direction 1 */
- E->Eqn_k2[level][m][loc0+index] += w2*ww1*elt_K[(pp+1)*lms+qq]; /* direction 1 */
- E->Eqn_k3[level][m][loc0+index] += w3*ww1*elt_K[(pp+2)*lms+qq]; /* direction 1 */
-
- /* search for direction 2*/
-
- found=0;
- for(k=0;k<max_eqn;k++)
- if(E->Node_map[level][m][loc0+k] == eqn2) { /* found, index next equation */
- index=k;
- found++;
- break;
- }
-
- assert(found /* direction 2 */);
-
- E->Eqn_k1[level][m][loc0+index] += w1*ww2*elt_K[pp*lms+qq+1]; /* direction 1 */
- E->Eqn_k2[level][m][loc0+index] += w2*ww2*elt_K[(pp+1)*lms+qq+1]; /* direction 2 */
- E->Eqn_k3[level][m][loc0+index] += w3*ww2*elt_K[(pp+2)*lms+qq+1]; /* direction 3 */
-
- /* search for direction 3*/
-
- found=0;
- for(k=0;k<max_eqn;k++)
- if(E->Node_map[level][m][loc0+k] == eqn3) { /* found, index next equation */
- index=k;
- found++;
- break;
- }
-
- assert(found /* direction 3 */);
-
- E->Eqn_k1[level][m][loc0+index] += w1*ww3*elt_K[pp*lms+qq+2]; /* direction 1 */
- E->Eqn_k2[level][m][loc0+index] += w2*ww3*elt_K[(pp+1)*lms+qq+2]; /* direction 2 */
- E->Eqn_k3[level][m][loc0+index] += w3*ww3*elt_K[(pp+2)*lms+qq+2]; /* direction 3 */
-
- } /* end for j */
- } /* end for node1<= node */
- } /* end for i */
- } /* end for element */
- } /* end for m */
-
- (E->solver.exchange_id_d)(E, E->BI[level], level);
-
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
- neq=E->lmesh.NEQ[level];
-
- for(j=0;j<neq;j++) {
- if(E->BI[level][m][j] ==0.0) fprintf(stderr,"me= %d level %d, equation %d/%d has zero diagonal term\n",E->parallel.me,level,j,neq);
- assert( E->BI[level][m][j] != 0 /* diagonal of matrix = 0, not acceptable */);
- E->BI[level][m][j] = (double) 1.0/E->BI[level][m][j];
- }
- } /* end for m */
-
-
- } /* end for level */
-
- return;
-}
-
-void rebuild_BI_on_boundary(E)
- struct All_variables *E;
-{
- int m,level,i,j;
- int eqn1,eqn2,eqn3;
-
- higher_precision *B1,*B2,*B3;
- int *C;
-
- const int dims=E->mesh.nsd,dofs=E->mesh.dof;
-
- const int max_eqn = dims*14;
-
- for(level=E->mesh.gridmax;level>=E->mesh.gridmin;level--) {
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- for(j=0;j<=E->lmesh.NEQ[level];j++)
- E->temp[m][j]=0.0;
-
- for(i=1;i<=E->lmesh.NNO[level];i++) {
- eqn1=E->ID[level][m][i].doff[1];
- eqn2=E->ID[level][m][i].doff[2];
- eqn3=E->ID[level][m][i].doff[3];
-
- C=E->Node_map[level][m] + (i-1)*max_eqn;
- B1=E->Eqn_k1[level][m]+(i-1)*max_eqn;
- B2=E->Eqn_k2[level][m]+(i-1)*max_eqn;
- B3=E->Eqn_k3[level][m]+(i-1)*max_eqn;
-
- for(j=3;j<max_eqn;j++) {
- E->temp[m][eqn1] += fabs(B1[j]);
- E->temp[m][eqn2] += fabs(B2[j]);
- E->temp[m][eqn3] += fabs(B3[j]);
- }
-
- for(j=0;j<max_eqn;j++)
- E->temp[m][C[j]] += fabs(B1[j]) + fabs(B2[j]) + fabs(B3[j]);
-
- }
- }
-
- (E->solver.exchange_id_d)(E, E->temp, level);
-
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- for(i=0;i<E->lmesh.NEQ[level];i++) {
- E->temp[m][i] = E->temp[m][i] - 1.0/E->BI[level][m][i];
- }
- for(i=1;i<=E->lmesh.NNO[level];i++)
- if (E->NODE[level][m][i] & OFFSIDE) {
- eqn1=E->ID[level][m][i].doff[1];
- eqn2=E->ID[level][m][i].doff[2];
- eqn3=E->ID[level][m][i].doff[3];
- E->BI[level][m][eqn1] = (double) 1.0/E->temp[m][eqn1];
- E->BI[level][m][eqn2] = (double) 1.0/E->temp[m][eqn2];
- E->BI[level][m][eqn3] = (double) 1.0/E->temp[m][eqn3];
- }
- }
-
-
- } /* end for level */
-
- return;
-}
-
-
-/* ============================================
- Function to set up the boundary condition
- masks and other indicators.
- ============================================ */
-
-void construct_masks(E) /* Add lid/edge masks/nodal weightings */
- struct All_variables *E;
-{
- int i,j,k,l,node,el,elt;
- int lev,elx,elz,ely,nno,nox,noz,noy;
-
- for(lev=E->mesh.gridmax;lev>=E->mesh.gridmin;lev--)
- for (j=1;j<=E->sphere.caps_per_proc;j++) {
- elz = E->lmesh.ELZ[lev];
- ely = E->lmesh.ELY[lev];
- noy = E->lmesh.NOY[lev];
- noz = E->lmesh.NOZ[lev];
- nno = E->lmesh.NNO[lev];
-
- if (E->parallel.me_loc[3]==0 )
- for (i=1;i<=E->parallel.NUM_NNO[lev][j].bound[5];i++) {
- node = E->parallel.NODE[lev][j][i].bound[5];
- E->NODE[lev][j][node] = E->NODE[lev][j][node] | TZEDGE;
- }
- if ( E->parallel.me_loc[3]==E->parallel.nprocz-1 )
- for (i=1;i<=E->parallel.NUM_NNO[lev][j].bound[6];i++) {
- node = E->parallel.NODE[lev][j][i].bound[6];
- E->NODE[lev][j][node] = E->NODE[lev][j][node] | TZEDGE;
- }
-
- } /* end for j & lev */
-
-/* if (E->control.verbose) { */
-/* for(lev=E->mesh.gridmax;lev>=E->mesh.gridmin;lev--) */
-/* for (j=1;j<=E->sphere.caps_per_proc;j++) { */
-/* for (i=1;i<=E->parallel.NUM_NNO[lev][j].bound[5];i++) { */
-/* node = E->parallel.NODE[lev][j][i].bound[5]; */
-/* fprintf(E->fp_out,"bound=5 NODE[lev=%1d][node=%3d]=%d\n",lev,node,E->NODE[lev][j][node]); */
-/* } */
-/* for (i=1;i<=E->parallel.NUM_NNO[lev][j].bound[6];i++) { */
-/* node = E->parallel.NODE[lev][j][i].bound[6]; */
-/* fprintf(E->fp_out,"bound=6 NODE[lev=%1d][node=%3d]=%d\n",lev,node,E->NODE[lev][j][node]); */
-/* } */
-/* } */
-/* fflush(E->fp_out); */
-/* } */
-
- return;
- }
-
-
-/* ==========================================
- build the sub-element reference matrices
- ========================================== */
-
-void construct_sub_element(E)
- struct All_variables *E;
-
-{ int i,j,k,l,m;
- int lev,nox,noy,noz,nnn,elx,elz,ely,elzu,elxu,elt,eltu;
-
-
- for(lev=E->mesh.levmax-1;lev>=E->mesh.levmin;lev--)
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- elx = E->lmesh.ELX[lev];
- elz = E->lmesh.ELZ[lev];
- ely = E->lmesh.ELY[lev];
- nox = E->lmesh.NOX[lev];
- noy = E->lmesh.NOY[lev];
- noz = E->lmesh.NOZ[lev];
- elz = E->lmesh.ELZ[lev];
- ely = E->lmesh.ELY[lev];
- elxu = 2 * elx;
- elzu = 2 * elz;
- if (!(E->control.NMULTIGRID||E->control.EMULTIGRID)) {
- elzu = 1;
- if (lev == E->mesh.levmax-1)
- elzu = E->lmesh.ELZ[E->mesh.levmax];
- }
-
- for(i=1;i<=elx;i++)
- for(j=1;j<=elz;j++)
- for(k=1;k<=ely;k++) {
- elt = j + (i-1)*elz +(k-1)*elz*elx;
- eltu = (j*2-1) + elzu *2*(i-1) + elxu*elzu*2*(k-1);
-
- for(l=1;l<=enodes[E->mesh.nsd];l++) {
- E->EL[lev][m][elt].sub[l] = eltu
- + offset[l].vector[0]
- + offset[l].vector[1] * elzu
- + offset[l].vector[2] * elzu * elxu;
- }
- }
-
- }
-
-
- return;
- }
-
-
-void construct_elt_ks(E)
- struct All_variables *E;
-{
- int e,el,lev,j,k,ii,m;
- void get_elt_k();
- void get_aug_k();
- void build_diagonal_of_K();
-
- const int dims=E->mesh.nsd;
- const int n=loc_mat_size[E->mesh.nsd];
-
-/* if(E->parallel.me==0) */
-/* fprintf(stderr,"storing elt k matrices\n"); */
-
- for(lev=E->mesh.gridmin;lev<=E->mesh.gridmax;lev++) {
-
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
-
- for(el=1;el<=E->lmesh.NEL[lev];el++) {
-
- get_elt_k(E,el,E->elt_k[lev][m][el].k,lev,m,0);
-
- if (E->control.augmented_Lagr)
- get_aug_k(E,el,E->elt_k[lev][m][el].k,lev,m);
-
- build_diagonal_of_K(E,el,E->elt_k[lev][m][el].k,lev,m);
-
- }
- } /* end for m */
-
- (E->solver.exchange_id_d)(E, E->BI[lev], lev); /*correct BI */
-
- for(m=1;m<=E->sphere.caps_per_proc;m++)
-
- for(j=0;j<E->lmesh.NEQ[lev];j++) {
- if(E->BI[lev][m][j] ==0.0) fprintf(stderr,"me= %d level %d, equation %d/%d has zero diagonal term\n",E->parallel.me,lev,j,E->lmesh.NEQ[lev]);
- assert( E->BI[lev][m][j] != 0 /* diagonal of matrix = 0, not acceptable */);
- E->BI[lev][m][j] = (double) 1.0/E->BI[lev][m][j];
- }
-
- } /* end for level */
-
- return;
-}
-
-
-
-void construct_elt_gs(E)
- struct All_variables *E;
-{ int m,el,lev,a;
- void get_elt_g();
-
- const int dims=E->mesh.nsd,dofs=E->mesh.dof;
- const int ends=enodes[dims];
-
-/* if(E->control.verbose && E->parallel.me==0) */
-/* fprintf(stderr,"storing elt g matrices\n"); */
-
- for(lev=E->mesh.gridmin;lev<=E->mesh.gridmax;lev++)
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(el=1;el<=E->lmesh.NEL[lev];el++)
- get_elt_g(E,el,E->elt_del[lev][m][el].g,lev,m);
-
-
- return;
-}
-
-
-/*==============================================
- For compressible cases, construct c matrix,
- where c = \frac{d rho_r}{dr} / rho_r * u_r
- ==============================================*/
-
-void construct_elt_cs(struct All_variables *E)
-{
- int m, el, lev;
- void get_elt_c();
-
-/* if(E->control.verbose && E->parallel.me==0) */
-/* fprintf(stderr,"storing elt c matrices\n"); */
-
- for(lev=E->mesh.gridmin;lev<=E->mesh.gridmax;lev++)
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(el=1;el<=E->lmesh.NEL[lev];el++) {
- get_elt_c(E,el,E->elt_c[lev][m][el].c,lev,m);
- }
-
-
- return;
-}
-
-
-/* ==============================================================
- routine for constructing stiffness and node_maps
- ============================================================== */
-
-void construct_stiffness_B_matrix(E)
- struct All_variables *E;
-{
- void build_diagonal_of_K();
- void build_diagonal_of_Ahat();
- void project_viscosity();
- void construct_node_maps();
- void construct_node_ks();
- void construct_elt_ks();
- void rebuild_BI_on_boundary();
-
- if (E->control.NMULTIGRID)
- project_viscosity(E);
-
- if (E->control.NMULTIGRID || E->control.NASSEMBLE) {
- construct_node_ks(E);
- }
- else {
- construct_elt_ks(E);
- }
-
- build_diagonal_of_Ahat(E);
-
- if (E->control.NMULTIGRID || (E->control.NASSEMBLE && !E->control.CONJ_GRAD))
- rebuild_BI_on_boundary(E);
-
-
- return;
-}
-
-/* took this apart to allow call from other subroutines */
-
-/*
-
-
-determine viscosity layer number based on radial coordinate r
-
-if E->viscosity.z... set to Earth values, and old, num_mat=4 style is
-used then
-
-1: lithosphere 2: 100-410 3: 410-660 and 4: lower mantle
-
-if z_layer is used, the layer numbers will refer to those read in with
-z_layer
-
-*/
-int layers_r(struct All_variables *E,float r)
-{
- int llayers, i;
- float rl;
- /*
- the z-values, as read in, are non-dimensionalized depth
- convert to radii
-
- */
- rl = r + E->sphere.ro;
- llayers = 0;
- for(i = 0;i < E->viscosity.num_mat;i++)
- if(r > (E->sphere.ro - E->viscosity.zbase_layer[i])){
- i++;
- break;
- }
- llayers = i;
-
- return (llayers);
-}
-
-/* determine layer number of node "node" of cap "m" */
-int layers(struct All_variables *E,int m,int node)
-{
- return(layers_r(E,E->sx[m][3][node]));
-}
-
-
-/* ==============================================================
- construct array mat
-
-
-
-
- ============================================================== */
-void construct_mat_group(E)
- struct All_variables *E;
-{
- int m,i,j,k,kk,el,lev,a,nodea,els,llayer;
-
- const int dims=E->mesh.nsd,dofs=E->mesh.dof;
- const int ends=enodes[dims];
-
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- for(el=1;el<=E->lmesh.nel;el++) {
- E->mat[m][el] = 1;
- nodea = E->ien[m][el].node[2];
- llayer = layers(E,m,nodea);
- if (llayer) {
- E->mat[m][el] = llayer;
- }
- }
- }
-
- return;
-}
-
-
Copied: mc/3D/CitcomS/branches/cxx/lib/Construct_arrays.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Construct_arrays.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Construct_arrays.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Construct_arrays.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,831 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+#include <math.h>
+#include <sys/types.h>
+#include "element_definitions.h"
+#include "global_defs.h"
+
+#include "cproto.h"
+
+
+int layers_r(struct All_variables *,float );
+int layers(struct All_variables *,int ,int );
+
+
+/*========================================================
+ Function to make the IEN array for a mesh of given
+ dimension. IEN is an externally defined structure array
+
+ NOTE: this is not really general enough for new elements:
+ it should be done through a pre-calculated lookup table.
+ ======================================================== */
+
+void construct_ien(struct All_variables *E)
+
+{
+ int lev,p,q,r,rr,j;
+ int element,start,nel,nno;
+ int elz,elx,ely,nox,noy,noz;
+
+ const int dims=E->mesh.nsd;
+ const int ends=enodes[dims];
+
+ for (lev=E->mesh.levmax;lev>=E->mesh.levmin;lev--) {
+ for (j=1;j<=E->sphere.caps_per_proc;j++) {
+
+ elx = E->lmesh.ELX[lev];
+ elz = E->lmesh.ELZ[lev];
+ ely = E->lmesh.ELY[lev];
+ nox = E->lmesh.NOX[lev];
+ noz = E->lmesh.NOZ[lev];
+ noy = E->lmesh.NOY[lev];
+ nel=E->lmesh.NEL[lev];
+ nno=E->lmesh.NNO[lev];
+
+ for(r=1;r<=ely;r++)
+ for(q=1;q<=elx;q++)
+ for(p=1;p<=elz;p++) {
+ element = (r-1)*elx*elz + (q-1)*elz + p;
+ start = (r-1)*noz*nox + (q-1)*noz + p;
+ for(rr=1;rr<=ends;rr++)
+ E->IEN[lev][j][element].node[rr]= start
+ + offset[rr].vector[0]
+ + offset[rr].vector[1]*noz
+ + offset[rr].vector[2]*noz*nox;
+ }
+
+ } /* end for cap j */
+ } /* end loop for lev */
+
+
+/* if(E->control.verbose) { */
+/* for (lev=E->mesh.levmax;lev>=E->mesh.levmin;lev--) { */
+/* fprintf(E->fp_out,"output_IEN_arrays me=%d lev=%d \n",E->parallel.me,lev); */
+/* for (j=1;j<=E->sphere.caps_per_proc;j++) { */
+/* fprintf(E->fp_out,"output_IEN_arrays me=%d %d %d\n",E->parallel.me,j,E->sphere.capid[j]); */
+/* for (i=1;i<=E->lmesh.NEL[lev];i++) */
+/* fprintf(E->fp_out,"%d %d %d %d %d %d %d %d %d\n",i,E->IEN[lev][j][i].node[1],E->IEN[lev][j][i].node[2],E->IEN[lev][j][i].node[3],E->IEN[lev][j][i].node[4],E->IEN[lev][j][i].node[5],E->IEN[lev][j][i].node[6],E->IEN[lev][j][i].node[7],E->IEN[lev][j][i].node[8]); */
+/* } */
+/* } */
+/* fflush (E->fp_out); */
+/* } */
+
+ return;
+}
+
+
+/* determine surface things */
+
+void construct_surface( struct All_variables *E)
+{
+ int i, j, e, element;
+
+ for (j=1;j<=E->sphere.caps_per_proc;j++) {
+ e = 0;
+ for(element=1;element<=E->lmesh.nel;element++)
+ if ( element%E->lmesh.elz==0) { /* top */
+ e ++;
+ E->sien[j][e].node[1] = E->ien[j][element].node[5]/E->lmesh.noz;
+ E->sien[j][e].node[2] = E->ien[j][element].node[6]/E->lmesh.noz;
+ E->sien[j][e].node[3] = E->ien[j][element].node[7]/E->lmesh.noz;
+ E->sien[j][e].node[4] = E->ien[j][element].node[8]/E->lmesh.noz;
+ E->surf_element[j][e] = element;
+ }
+
+ E->lmesh.snel = e;
+ for (i=1;i<=E->lmesh.nsf;i++)
+ E->surf_node[j][i] = i*E->lmesh.noz;
+
+ } /* end for cap j */
+
+ if(E->control.verbose) {
+ for (j=1;j<=E->sphere.caps_per_proc;j++) {
+ for(e=1;e<=E->lmesh.snel;e++) {
+ fprintf(E->fp_out, "sien sel=%d node=%d %d %d %d\n",
+ e, E->sien[j][e].node[1], E->sien[j][e].node[2], E->sien[j][e].node[3], E->sien[j][e].node[4]);
+ }
+ }
+ }
+}
+
+
+/*============================================
+ Function to make the ID array for above case
+ ============================================ */
+
+void construct_id(struct All_variables *E)
+{
+ int i,j,k;
+ int eqn_count,node,nno;
+ int neq, gneq;
+ unsigned int type,doff;
+ int lev;
+
+ const int dims=E->mesh.nsd,dofs=E->mesh.dof;
+ const int ends=enodes[dims];
+
+ for(lev=E->mesh.gridmax;lev>=E->mesh.gridmin;lev--) {
+ for(j=1;j<=E->sphere.caps_per_proc;j++) {
+ eqn_count = 0;
+
+ for(node=1;node<=E->lmesh.NNO[lev];node++)
+ for(doff=1;doff<=dims;doff++) {
+ E->ID[lev][j][node].doff[doff] = eqn_count;
+ eqn_count ++;
+ }
+
+ E->lmesh.NEQ[lev] = eqn_count;
+
+ i = 0;
+ for(node=1;node<=E->lmesh.NNO[lev];node++) {
+ if (E->NODE[lev][j][node] & SKIP)
+ for(doff=1;doff<=dims;doff++) {
+ i++;
+ E->parallel.Skip_id[lev][j][i] = E->ID[lev][j][node].doff[doff];
+ }
+ }
+
+ E->parallel.Skip_neq[lev][j] = i;
+
+ /* global # of unskipped eqn */
+ neq = E->lmesh.NEQ[lev] - E->parallel.Skip_neq[lev][j];
+ MPI_Allreduce(&neq, &gneq, 1, MPI_INT, MPI_SUM, E->parallel.world);
+ E->mesh.NEQ[lev] = gneq;
+
+ get_bcs_id_for_residual(E,lev,j);
+
+ } /* end for j */
+ } /* end for lev */
+
+ E->lmesh.neq = E->lmesh.NEQ[E->mesh.levmax];
+ E->mesh.neq = E->mesh.NEQ[E->mesh.levmax];
+
+/* if (E->control.verbose) { */
+/* fprintf(E->fp_out,"output_ID_arrays \n"); */
+/* for(j=1;j<=E->sphere.caps_per_proc;j++) */
+/* for (i=1;i<=E->lmesh.nno;i++) */
+/* fprintf(E->fp_out,"%d %d %d %d %d\n",eqn_count,i,E->ID[lev][j][i].doff[1],E->ID[lev][j][i].doff[2],E->ID[lev][j][i].doff[3]); */
+/* fflush(E->fp_out); */
+/* } */
+
+
+ return;
+ }
+
+
+
+void get_bcs_id_for_residual(struct All_variables *E, int level, int m)
+{
+
+ int i,j;
+
+ const int nno=E->lmesh.NNO[level];
+
+ j = 0;
+ for(i=1;i<=nno;i++) {
+ if ( (E->NODE[level][m][i] & VBX) != 0 ) {
+ j++;
+ E->zero_resid[level][m][j] = E->ID[level][m][i].doff[1];
+ }
+ if ( (E->NODE[level][m][i] & VBY) != 0 ) {
+ j++;
+ E->zero_resid[level][m][j] = E->ID[level][m][i].doff[2];
+ }
+ if ( (E->NODE[level][m][i] & VBZ) != 0 ) {
+ j++;
+ E->zero_resid[level][m][j] = E->ID[level][m][i].doff[3];
+ }
+ }
+
+ E->num_zero_resid[level][m] = j;
+
+ return;
+}
+
+/*==========================================================
+ Function to construct the LM array from the ID and IEN arrays
+ ========================================================== */
+
+void construct_lm(struct All_variables *E)
+{
+ int i,j,a,e;
+ int lev,eqn_no;
+ int nel, nel2;
+
+ const int dims=E->mesh.nsd,dofs=E->mesh.dof;
+ const int ends=enodes[dims];
+
+ return;
+}
+
+
+/* =====================================================
+ Function to build the local node matrix indexing maps
+ ===================================================== */
+
+void construct_node_maps(struct All_variables *E)
+{
+ double time1,CPU_time0();
+
+ int ii,noz,noxz,m,n,nn,lev,i,j,k,jj,kk,ia,ja,is,ie,js,je,ks,ke,doff;
+ int neq,nno,dims2,matrix,nox,noy;
+
+ const int dims=E->mesh.nsd,dofs=E->mesh.dof;
+ const int ends=enodes[dims];
+ int max_eqn;
+
+ dims2 = dims-1;
+ for(lev=E->mesh.gridmax;lev>=E->mesh.gridmin;lev--)
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ neq=E->lmesh.NEQ[lev];
+ nno=E->lmesh.NNO[lev];
+ noxz = E->lmesh.NOX[lev]*E->lmesh.NOZ[lev];
+ noz = E->lmesh.NOZ[lev];
+ noy = E->lmesh.NOY[lev];
+ nox = E->lmesh.NOX[lev];
+ max_eqn = 14*dims;
+ matrix = max_eqn*nno;
+
+ E->Node_map[lev][m]=(int *) malloc (matrix*sizeof(int));
+
+ for(i=0;i<matrix;i++)
+ E->Node_map[lev][m][i] = neq; /* neq indicates an invalid eqn # */
+
+ for (ii=1;ii<=noy;ii++)
+ for (jj=1;jj<=nox;jj++)
+ for (kk=1;kk<=noz;kk++) {
+ nn = kk + (jj-1)*noz+ (ii-1)*noxz;
+ for(doff=1;doff<=dims;doff++)
+ E->Node_map[lev][m][(nn-1)*max_eqn+doff-1] = E->ID[lev][m][nn].doff[doff];
+
+ ia = 0;
+ is=1; ie=dims2;
+ js=1; je=dims;
+ ks=1; ke=dims;
+ if (kk==1 ) ks=2;
+ if (kk==noz) ke=2;
+ if (jj==1 ) js=2;
+ if (jj==nox) je=2;
+ if (ii==1 ) is=2;
+ if (ii==noy) ie=2;
+ for (i=is;i<=ie;i++)
+ for (j=js;j<=je;j++)
+ for (k=ks;k<=ke;k++) {
+ ja = nn-((2-i)*noxz + (2-j)*noz + 2-k);
+ if (ja<nn) {
+ ia++;
+ for (doff=1;doff<=dims;doff++)
+ E->Node_map[lev][m][(nn-1)*max_eqn+ia*dims+doff-1]=E->ID[lev][m][ja].doff[doff];
+ }
+ }
+ }
+
+ E->Eqn_k1[lev][m] = (higher_precision *)malloc(matrix*sizeof(higher_precision));
+ E->Eqn_k2[lev][m] = (higher_precision *)malloc(matrix*sizeof(higher_precision));
+ E->Eqn_k3[lev][m] = (higher_precision *)malloc(matrix*sizeof(higher_precision));
+
+ E->mesh.matrix_size[lev] = matrix;
+
+ if(E->control.verbose) {
+ fprintf(E->fp_out, "output Node_map lev=%d m=%d\n", lev, m);
+ fprintf(E->fp_out, "neq=%d nno=%d max_eqn=%d matrix=%d\n", neq, nno, max_eqn, matrix);
+ for(i=0;i<matrix;i++)
+ fprintf(E->fp_out, "%d %d\n", i, E->Node_map[lev][m][i]);
+ }
+
+ } /* end for level and m */
+
+ return;
+}
+
+
+void construct_node_ks(struct All_variables *E)
+{
+ int m,level,i,j,k,e;
+ int node,node1,eqn1,eqn2,eqn3,loc0,loc1,loc2,loc3,found,element,index,pp,qq;
+ int neq,nno,nel,max_eqn;
+
+ double elt_K[24*24];
+ double w1,w2,w3,ww1,ww2,ww3,zero;
+
+ higher_precision *B1,*B2,*B3;
+
+ void get_elt_k();
+ void get_aug_k();
+ void build_diagonal_of_K();
+ void parallel_process_termination();
+
+ const int dims=E->mesh.nsd,dofs=E->mesh.dof;
+ const int ends=enodes[dims];
+ const int lms=loc_mat_size[E->mesh.nsd];
+
+ zero = 0.0;
+ max_eqn = 14*dims;
+
+ for(level=E->mesh.gridmax;level>=E->mesh.gridmin;level--) {
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+
+ neq=E->lmesh.NEQ[level];
+ nel=E->lmesh.NEL[level];
+ nno=E->lmesh.NNO[level];
+ for(i=0;i<neq;i++)
+ E->BI[level][m][i] = zero;
+ for(i=0;i<E->mesh.matrix_size[level];i++) {
+ E->Eqn_k1[level][m][i] = zero;
+ E->Eqn_k2[level][m][i] = zero;
+ E->Eqn_k3[level][m][i] = zero;
+ }
+
+ for(element=1;element<=nel;element++) {
+
+ get_elt_k(E,element,elt_K,level,m,0);
+
+ if (E->control.augmented_Lagr)
+ get_aug_k(E,element,elt_K,level,m);
+
+ build_diagonal_of_K(E,element,elt_K,level,m);
+
+ for(i=1;i<=ends;i++) { /* i, is the node we are storing to */
+ node=E->IEN[level][m][element].node[i];
+
+ pp=(i-1)*dims;
+ w1=w2=w3=1.0;
+
+ loc0=(node-1)*max_eqn;
+
+ if(E->NODE[level][m][node] & VBX) w1=0.0;
+ if(E->NODE[level][m][node] & VBZ) w3=0.0;
+ if(E->NODE[level][m][node] & VBY) w2=0.0;
+
+ for(j=1;j<=ends;j++) { /* j is the node we are receiving from */
+ node1=E->IEN[level][m][element].node[j];
+
+ /* only for half of the matrix ,because of the symmetry */
+ if (node1<=node) {
+
+ ww1=ww2=ww3=1.0;
+ qq=(j-1)*dims;
+ eqn1=E->ID[level][m][node1].doff[1];
+ eqn2=E->ID[level][m][node1].doff[2];
+ eqn3=E->ID[level][m][node1].doff[3];
+
+ if(E->NODE[level][m][node1] & VBX) ww1=0.0;
+ if(E->NODE[level][m][node1] & VBZ) ww3=0.0;
+ if(E->NODE[level][m][node1] & VBY) ww2=0.0;
+
+ /* search for direction 1*/
+
+ found=0;
+ for(k=0;k<max_eqn;k++)
+ if(E->Node_map[level][m][loc0+k] == eqn1) { /* found, index next equation */
+ index=k;
+ found++;
+ break;
+ }
+
+ assert(found /* direction 1 */);
+
+ E->Eqn_k1[level][m][loc0+index] += w1*ww1*elt_K[pp*lms+qq]; /* direction 1 */
+ E->Eqn_k2[level][m][loc0+index] += w2*ww1*elt_K[(pp+1)*lms+qq]; /* direction 1 */
+ E->Eqn_k3[level][m][loc0+index] += w3*ww1*elt_K[(pp+2)*lms+qq]; /* direction 1 */
+
+ /* search for direction 2*/
+
+ found=0;
+ for(k=0;k<max_eqn;k++)
+ if(E->Node_map[level][m][loc0+k] == eqn2) { /* found, index next equation */
+ index=k;
+ found++;
+ break;
+ }
+
+ assert(found /* direction 2 */);
+
+ E->Eqn_k1[level][m][loc0+index] += w1*ww2*elt_K[pp*lms+qq+1]; /* direction 1 */
+ E->Eqn_k2[level][m][loc0+index] += w2*ww2*elt_K[(pp+1)*lms+qq+1]; /* direction 2 */
+ E->Eqn_k3[level][m][loc0+index] += w3*ww2*elt_K[(pp+2)*lms+qq+1]; /* direction 3 */
+
+ /* search for direction 3*/
+
+ found=0;
+ for(k=0;k<max_eqn;k++)
+ if(E->Node_map[level][m][loc0+k] == eqn3) { /* found, index next equation */
+ index=k;
+ found++;
+ break;
+ }
+
+ assert(found /* direction 3 */);
+
+ E->Eqn_k1[level][m][loc0+index] += w1*ww3*elt_K[pp*lms+qq+2]; /* direction 1 */
+ E->Eqn_k2[level][m][loc0+index] += w2*ww3*elt_K[(pp+1)*lms+qq+2]; /* direction 2 */
+ E->Eqn_k3[level][m][loc0+index] += w3*ww3*elt_K[(pp+2)*lms+qq+2]; /* direction 3 */
+
+ } /* end for j */
+ } /* end for node1<= node */
+ } /* end for i */
+ } /* end for element */
+ } /* end for m */
+
+ (E->solver.exchange_id_d)(E, E->BI[level], level);
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+ neq=E->lmesh.NEQ[level];
+
+ for(j=0;j<neq;j++) {
+ if(E->BI[level][m][j] ==0.0) fprintf(stderr,"me= %d level %d, equation %d/%d has zero diagonal term\n",E->parallel.me,level,j,neq);
+ assert( E->BI[level][m][j] != 0 /* diagonal of matrix = 0, not acceptable */);
+ E->BI[level][m][j] = (double) 1.0/E->BI[level][m][j];
+ }
+ } /* end for m */
+
+
+ } /* end for level */
+
+ return;
+}
+
+void rebuild_BI_on_boundary(struct All_variables *E)
+{
+ int m,level,i,j;
+ int eqn1,eqn2,eqn3;
+
+ higher_precision *B1,*B2,*B3;
+ int *C;
+
+ const int dims=E->mesh.nsd,dofs=E->mesh.dof;
+
+ const int max_eqn = dims*14;
+
+ for(level=E->mesh.gridmax;level>=E->mesh.gridmin;level--) {
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ for(j=0;j<=E->lmesh.NEQ[level];j++)
+ E->temp[m][j]=0.0;
+
+ for(i=1;i<=E->lmesh.NNO[level];i++) {
+ eqn1=E->ID[level][m][i].doff[1];
+ eqn2=E->ID[level][m][i].doff[2];
+ eqn3=E->ID[level][m][i].doff[3];
+
+ C=E->Node_map[level][m] + (i-1)*max_eqn;
+ B1=E->Eqn_k1[level][m]+(i-1)*max_eqn;
+ B2=E->Eqn_k2[level][m]+(i-1)*max_eqn;
+ B3=E->Eqn_k3[level][m]+(i-1)*max_eqn;
+
+ for(j=3;j<max_eqn;j++) {
+ E->temp[m][eqn1] += fabs(B1[j]);
+ E->temp[m][eqn2] += fabs(B2[j]);
+ E->temp[m][eqn3] += fabs(B3[j]);
+ }
+
+ for(j=0;j<max_eqn;j++)
+ E->temp[m][C[j]] += fabs(B1[j]) + fabs(B2[j]) + fabs(B3[j]);
+
+ }
+ }
+
+ (E->solver.exchange_id_d)(E, E->temp, level);
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ for(i=0;i<E->lmesh.NEQ[level];i++) {
+ E->temp[m][i] = E->temp[m][i] - 1.0/E->BI[level][m][i];
+ }
+ for(i=1;i<=E->lmesh.NNO[level];i++)
+ if (E->NODE[level][m][i] & OFFSIDE) {
+ eqn1=E->ID[level][m][i].doff[1];
+ eqn2=E->ID[level][m][i].doff[2];
+ eqn3=E->ID[level][m][i].doff[3];
+ E->BI[level][m][eqn1] = (double) 1.0/E->temp[m][eqn1];
+ E->BI[level][m][eqn2] = (double) 1.0/E->temp[m][eqn2];
+ E->BI[level][m][eqn3] = (double) 1.0/E->temp[m][eqn3];
+ }
+ }
+
+
+ } /* end for level */
+
+ return;
+}
+
+
+/* ============================================
+ Function to set up the boundary condition
+ masks and other indicators.
+ ============================================ */
+
+void construct_masks(struct All_variables *E) /* Add lid/edge masks/nodal weightings */
+{
+ int i,j,k,l,node,el,elt;
+ int lev,elx,elz,ely,nno,nox,noz,noy;
+
+ for(lev=E->mesh.gridmax;lev>=E->mesh.gridmin;lev--)
+ for (j=1;j<=E->sphere.caps_per_proc;j++) {
+ elz = E->lmesh.ELZ[lev];
+ ely = E->lmesh.ELY[lev];
+ noy = E->lmesh.NOY[lev];
+ noz = E->lmesh.NOZ[lev];
+ nno = E->lmesh.NNO[lev];
+
+ if (E->parallel.me_loc[3]==0 )
+ for (i=1;i<=E->parallel.NUM_NNO[lev][j].bound[5];i++) {
+ node = E->parallel.NODE[lev][j][i].bound[5];
+ E->NODE[lev][j][node] = E->NODE[lev][j][node] | TZEDGE;
+ }
+ if ( E->parallel.me_loc[3]==E->parallel.nprocz-1 )
+ for (i=1;i<=E->parallel.NUM_NNO[lev][j].bound[6];i++) {
+ node = E->parallel.NODE[lev][j][i].bound[6];
+ E->NODE[lev][j][node] = E->NODE[lev][j][node] | TZEDGE;
+ }
+
+ } /* end for j & lev */
+
+/* if (E->control.verbose) { */
+/* for(lev=E->mesh.gridmax;lev>=E->mesh.gridmin;lev--) */
+/* for (j=1;j<=E->sphere.caps_per_proc;j++) { */
+/* for (i=1;i<=E->parallel.NUM_NNO[lev][j].bound[5];i++) { */
+/* node = E->parallel.NODE[lev][j][i].bound[5]; */
+/* fprintf(E->fp_out,"bound=5 NODE[lev=%1d][node=%3d]=%d\n",lev,node,E->NODE[lev][j][node]); */
+/* } */
+/* for (i=1;i<=E->parallel.NUM_NNO[lev][j].bound[6];i++) { */
+/* node = E->parallel.NODE[lev][j][i].bound[6]; */
+/* fprintf(E->fp_out,"bound=6 NODE[lev=%1d][node=%3d]=%d\n",lev,node,E->NODE[lev][j][node]); */
+/* } */
+/* } */
+/* fflush(E->fp_out); */
+/* } */
+
+ return;
+ }
+
+
+/* ==========================================
+ build the sub-element reference matrices
+ ========================================== */
+
+void construct_sub_element(struct All_variables *E)
+
+{ int i,j,k,l,m;
+ int lev,nox,noy,noz,nnn,elx,elz,ely,elzu,elxu,elt,eltu;
+
+
+ for(lev=E->mesh.levmax-1;lev>=E->mesh.levmin;lev--)
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ elx = E->lmesh.ELX[lev];
+ elz = E->lmesh.ELZ[lev];
+ ely = E->lmesh.ELY[lev];
+ nox = E->lmesh.NOX[lev];
+ noy = E->lmesh.NOY[lev];
+ noz = E->lmesh.NOZ[lev];
+ elz = E->lmesh.ELZ[lev];
+ ely = E->lmesh.ELY[lev];
+ elxu = 2 * elx;
+ elzu = 2 * elz;
+ if (!(E->control.NMULTIGRID||E->control.EMULTIGRID)) {
+ elzu = 1;
+ if (lev == E->mesh.levmax-1)
+ elzu = E->lmesh.ELZ[E->mesh.levmax];
+ }
+
+ for(i=1;i<=elx;i++)
+ for(j=1;j<=elz;j++)
+ for(k=1;k<=ely;k++) {
+ elt = j + (i-1)*elz +(k-1)*elz*elx;
+ eltu = (j*2-1) + elzu *2*(i-1) + elxu*elzu*2*(k-1);
+
+ for(l=1;l<=enodes[E->mesh.nsd];l++) {
+ E->EL[lev][m][elt].sub[l] = eltu
+ + offset[l].vector[0]
+ + offset[l].vector[1] * elzu
+ + offset[l].vector[2] * elzu * elxu;
+ }
+ }
+
+ }
+
+
+ return;
+ }
+
+
+void construct_elt_ks(struct All_variables *E)
+{
+ int e,el,lev,j,k,ii,m;
+ void get_elt_k();
+ void get_aug_k();
+ void build_diagonal_of_K();
+
+ const int dims=E->mesh.nsd;
+ const int n=loc_mat_size[E->mesh.nsd];
+
+/* if(E->parallel.me==0) */
+/* fprintf(stderr,"storing elt k matrices\n"); */
+
+ for(lev=E->mesh.gridmin;lev<=E->mesh.gridmax;lev++) {
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+
+ for(el=1;el<=E->lmesh.NEL[lev];el++) {
+
+ get_elt_k(E,el,E->elt_k[lev][m][el].k,lev,m,0);
+
+ if (E->control.augmented_Lagr)
+ get_aug_k(E,el,E->elt_k[lev][m][el].k,lev,m);
+
+ build_diagonal_of_K(E,el,E->elt_k[lev][m][el].k,lev,m);
+
+ }
+ } /* end for m */
+
+ (E->solver.exchange_id_d)(E, E->BI[lev], lev); /*correct BI */
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+
+ for(j=0;j<E->lmesh.NEQ[lev];j++) {
+ if(E->BI[lev][m][j] ==0.0) fprintf(stderr,"me= %d level %d, equation %d/%d has zero diagonal term\n",E->parallel.me,lev,j,E->lmesh.NEQ[lev]);
+ assert( E->BI[lev][m][j] != 0 /* diagonal of matrix = 0, not acceptable */);
+ E->BI[lev][m][j] = (double) 1.0/E->BI[lev][m][j];
+ }
+
+ } /* end for level */
+
+ return;
+}
+
+
+
+void construct_elt_gs(struct All_variables *E)
+{ int m,el,lev,a;
+ void get_elt_g();
+
+ const int dims=E->mesh.nsd,dofs=E->mesh.dof;
+ const int ends=enodes[dims];
+
+/* if(E->control.verbose && E->parallel.me==0) */
+/* fprintf(stderr,"storing elt g matrices\n"); */
+
+ for(lev=E->mesh.gridmin;lev<=E->mesh.gridmax;lev++)
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(el=1;el<=E->lmesh.NEL[lev];el++)
+ get_elt_g(E,el,E->elt_del[lev][m][el].g,lev,m);
+
+
+ return;
+}
+
+
+/*==============================================
+ For compressible cases, construct c matrix,
+ where c = \frac{d rho_r}{dr} / rho_r * u_r
+ ==============================================*/
+
+void construct_elt_cs(struct All_variables *E)
+{
+ int m, el, lev;
+ void get_elt_c();
+
+/* if(E->control.verbose && E->parallel.me==0) */
+/* fprintf(stderr,"storing elt c matrices\n"); */
+
+ for(lev=E->mesh.gridmin;lev<=E->mesh.gridmax;lev++)
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(el=1;el<=E->lmesh.NEL[lev];el++) {
+ get_elt_c(E,el,E->elt_c[lev][m][el].c,lev,m);
+ }
+
+
+ return;
+}
+
+
+/* ==============================================================
+ routine for constructing stiffness and node_maps
+ ============================================================== */
+
+void construct_stiffness_B_matrix(struct All_variables *E)
+{
+ void build_diagonal_of_K();
+ void build_diagonal_of_Ahat();
+ void project_viscosity();
+ void construct_node_maps();
+ void construct_node_ks();
+ void construct_elt_ks();
+ void rebuild_BI_on_boundary();
+
+ if (E->control.NMULTIGRID)
+ project_viscosity(E);
+
+ if (E->control.NMULTIGRID || E->control.NASSEMBLE) {
+ construct_node_ks(E);
+ }
+ else {
+ construct_elt_ks(E);
+ }
+
+ build_diagonal_of_Ahat(E);
+
+ if (E->control.NMULTIGRID || (E->control.NASSEMBLE && !E->control.CONJ_GRAD))
+ rebuild_BI_on_boundary(E);
+
+
+ return;
+}
+
+/* took this apart to allow call from other subroutines */
+
+/*
+
+
+determine viscosity layer number based on radial coordinate r
+
+if E->viscosity.z... set to Earth values, and old, num_mat=4 style is
+used then
+
+1: lithosphere 2: 100-410 3: 410-660 and 4: lower mantle
+
+if z_layer is used, the layer numbers will refer to those read in with
+z_layer
+
+*/
+int layers_r(struct All_variables *E,float r)
+{
+ int llayers, i;
+ float rl;
+ /*
+ the z-values, as read in, are non-dimensionalized depth
+ convert to radii
+
+ */
+ rl = r + E->sphere.ro;
+ llayers = 0;
+ for(i = 0;i < E->viscosity.num_mat;i++)
+ if(r > (E->sphere.ro - E->viscosity.zbase_layer[i])){
+ i++;
+ break;
+ }
+ llayers = i;
+
+ return (llayers);
+}
+
+/* determine layer number of node "node" of cap "m" */
+int layers(struct All_variables *E,int m,int node)
+{
+ return(layers_r(E,E->sx[m][3][node]));
+}
+
+
+/* ==============================================================
+ construct array mat
+
+
+
+
+ ============================================================== */
+void construct_mat_group(struct All_variables *E)
+{
+ int m,i,j,k,kk,el,lev,a,nodea,els,llayer;
+
+ const int dims=E->mesh.nsd,dofs=E->mesh.dof;
+ const int ends=enodes[dims];
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ for(el=1;el<=E->lmesh.nel;el++) {
+ E->mat[m][el] = 1;
+ nodea = E->ien[m][el].node[2];
+ llayer = layers(E,m,nodea);
+ if (llayer) {
+ E->mat[m][el] = llayer;
+ }
+ }
+ }
+
+ return;
+}
+
+
Deleted: mc/3D/CitcomS/branches/cxx/lib/Convection.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Convection.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Convection.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,133 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-/* Assumes parameter list is opened and reads the things it needs.
- Variables are initialized etc, default values are set */
-
-
-#include <math.h>
-#include <sys/types.h>
-#include "element_definitions.h"
-#include "global_defs.h"
-#include <stdlib.h> /* for "system" command */
-#include <strings.h>
-
-void set_convection_defaults(E)
- struct All_variables *E;
-{
- void PG_timestep();
- void PG_timestep_init();
- void read_convection_settings();
- void convection_derived_values();
- void convection_allocate_memory();
- void convection_boundary_conditions();
- void convection_initial_fields();
- void twiddle_thumbs();
-
- E->advection.timestep = 0.0;
- E->advection.timesteps = 0;
- E->advection.temp_iterations = 2; /* petrov-galerkin iterations: minimum value. */
- E->advection.total_timesteps = 1;
- E->advection.sub_iterations = 1;
- E->advection.last_sub_iterations = 1;
- E->advection.gamma = 0.5;
- E->advection.dt_reduced = 1.0;
-
- E->monitor.T_maxvaried = 1.05;
-
- E->next_buoyancy_field = PG_timestep;
- E->next_buoyancy_field_init = PG_timestep_init;
- E->special_process_new_buoyancy = twiddle_thumbs;
- E->problem_settings = read_convection_settings;
- E->problem_derived_values = convection_derived_values;
- E->problem_allocate_vars = convection_allocate_memory;
- E->problem_boundary_conds = convection_boundary_conditions;
- E->problem_initial_fields = convection_initial_fields;
- E->problem_update_node_positions = twiddle_thumbs;
- E->problem_update_bcs = twiddle_thumbs;
-
- return;
-}
-
-void read_convection_settings(E)
- struct All_variables *E;
-
-{
- void advection_diffusion_parameters();
-
- /* parameters */
-
- advection_diffusion_parameters(E);
-
- return;
-}
-
-/* =================================================================
- Any setup which relates only to the convection stuff goes in here
- ================================================================= */
-
-void convection_derived_values(E)
- struct All_variables *E;
-
-{
-
- return;
-}
-
-void convection_allocate_memory(E)
- struct All_variables *E;
-
-{ void advection_diffusion_allocate_memory();
-
- advection_diffusion_allocate_memory(E);
-
- return;
-}
-
-/* ============================================ */
-
-void convection_initial_fields(E)
- struct All_variables *E;
-
-{
- void convection_initial_temperature();
-
- convection_initial_temperature(E);
-
- return; }
-
-/* =========================================== */
-
-void convection_boundary_conditions(E)
- struct All_variables *E;
-
-{
- (E->solver.velocity_boundary_conditions)(E); /* universal */
- (E->solver.temperature_boundary_conditions)(E);
- return;
-}
-
Copied: mc/3D/CitcomS/branches/cxx/lib/Convection.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Convection.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Convection.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Convection.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,112 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+/* Assumes parameter list is opened and reads the things it needs.
+ Variables are initialized etc, default values are set */
+
+
+#include <math.h>
+#include <sys/types.h>
+#include "element_definitions.h"
+#include "global_defs.h"
+#include <stdlib.h> /* for "system" command */
+#include <strings.h>
+
+#include "cproto.h"
+
+
+void set_convection_defaults(struct All_variables *E)
+{
+ E->advection.timestep = 0.0;
+ E->advection.timesteps = 0;
+ E->advection.temp_iterations = 2; /* petrov-galerkin iterations: minimum value. */
+ E->advection.total_timesteps = 1;
+ E->advection.sub_iterations = 1;
+ E->advection.last_sub_iterations = 1;
+ E->advection.gamma = 0.5;
+ E->advection.dt_reduced = 1.0;
+
+ E->monitor.T_maxvaried = 1.05;
+
+ E->next_buoyancy_field = PG_timestep;
+ E->next_buoyancy_field_init = PG_timestep_init;
+ E->special_process_new_buoyancy = twiddle_thumbs;
+ E->problem_settings = read_convection_settings;
+ E->problem_derived_values = convection_derived_values;
+ E->problem_allocate_vars = convection_allocate_memory;
+ E->problem_boundary_conds = convection_boundary_conditions;
+ E->problem_initial_fields = convection_initial_fields;
+ E->problem_update_node_positions = twiddle_thumbs;
+ E->problem_update_bcs = twiddle_thumbs;
+
+ return;
+}
+
+void read_convection_settings(struct All_variables *E)
+{
+ /* parameters */
+
+ advection_diffusion_parameters(E);
+
+ return;
+}
+
+/* =================================================================
+ Any setup which relates only to the convection stuff goes in here
+ ================================================================= */
+
+void convection_derived_values(struct All_variables *E)
+{
+
+ return;
+}
+
+void convection_allocate_memory(struct All_variables *E)
+{
+
+ advection_diffusion_allocate_memory(E);
+
+ return;
+}
+
+/* ============================================ */
+
+void convection_initial_fields(struct All_variables *E)
+{
+ convection_initial_temperature(E);
+
+ return; }
+
+/* =========================================== */
+
+void convection_boundary_conditions(struct All_variables *E)
+{
+ (E->solver.velocity_boundary_conditions)(E); /* universal */
+ (E->solver.temperature_boundary_conditions)(E);
+ return;
+}
+
Deleted: mc/3D/CitcomS/branches/cxx/lib/Determine_net_rotation.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Determine_net_rotation.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Determine_net_rotation.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,461 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-
-/*
-
-routines to determine the net rotation velocity of the whole model
-
-TWB
-
-These have been superceded by the routines in Global_opertations and can probably be removed
-
-
-*/
-
-#include <stdio.h>
-#include <stdlib.h>
-#include <math.h>
-#include "element_definitions.h"
-#include "global_defs.h"
-#include "parallel_related.h"
-#include "parsing.h"
-#include "output.h"
-
-double determine_netr_tp(float, float, float, float, float, int, double *, double *);
-void sub_netr(float, float, float, float *, float *, double *);
-void hc_ludcmp_3x3(double [3][3], int *);
-void hc_lubksb_3x3(double [3][3], int *, double *);
-void xyz2rtp(float ,float ,float ,float *);
-void *safe_malloc (size_t );
-double determine_model_net_rotation(struct All_variables *,double *);
-void myerror(struct All_variables *,char *);
-/*
-
-determine the mean net rotation of the velocities at all layers
-
-
-modeled after horizontal layer average routines
-
-*/
-double determine_model_net_rotation(struct All_variables *E,double *omega)
-{
- const int dims = E->mesh.nsd;
- int m,i,j,k,d,nint,el,elz,elx,ely,j1,j2,i1,i2,k1,k2,nproc;
- int top,lnode[5],elz9;
- double *acoef,*coef,*lomega,ddummy,oamp,lamp;
- float v[2],vw,vtmp,r,t,p,x[3],xp[3],r1,r2,rr;
- struct Shape_function1 M;
- struct Shape_function1_dA dGamma;
- void get_global_1d_shape_fn();
-
- elz = E->lmesh.elz;elx = E->lmesh.elx;ely = E->lmesh.ely;
-
- elz9 = elz*9;
-
- acoef = (double *)safe_malloc(elz9*sizeof(double));
- coef = (double *)safe_malloc(elz9*sizeof(double));
- lomega = (double *)safe_malloc(3*elz*sizeof(double));
-
- for (i=1;i <= elz;i++) { /* loop through depths */
-
- /* zero out coef for init */
- determine_netr_tp(ddummy,ddummy,ddummy,ddummy,ddummy,0,(coef+(i-1)*9),&ddummy);
-
- if (i==elz)
- top = 1;
- else
- top = 0;
- for (m=1;m <= E->sphere.caps_per_proc;m++)
- for (k=1;k <= ely;k++)
- for (j=1;j <= elx;j++) {
- el = i + (j-1)*elz + (k-1)*elx*elz;
- get_global_1d_shape_fn(E,el,&M,&dGamma,top,m);
-
- /* find mean element location and horizontal velocity */
-
- x[0] = x[1] = x[2] = v[0] = v[1] = vw = 0.0;
-
- lnode[1] = E->ien[m][el].node[1];
- lnode[2] = E->ien[m][el].node[2];
- lnode[3] = E->ien[m][el].node[3];
- lnode[4] = E->ien[m][el].node[4];
-
- for(nint=1;nint <= onedvpoints[E->mesh.nsd];nint++) {
- for(d=1;d <= onedvpoints[E->mesh.nsd];d++){
- vtmp = E->M.vpt[GMVINDEX(d,nint)] * dGamma.vpt[GMVGAMMA(0,nint)];
- x[0] += E->x[m][1][lnode[d]] * vtmp; /* coords */
- x[1] += E->x[m][2][lnode[d]] * vtmp;
- x[2] += E->x[m][3][lnode[d]] * vtmp;
-
- v[0] += E->sphere.cap[m].V[1][lnode[d]] * vtmp; /* theta */
- v[1] += E->sphere.cap[m].V[2][lnode[d]] * vtmp; /* phi */
- vw += dGamma.vpt[GMVGAMMA(0,nint)];
- }
- }
- if (i==elz) {
- lnode[1] = E->ien[m][el].node[5];
- lnode[2] = E->ien[m][el].node[6];
- lnode[3] = E->ien[m][el].node[7];
- lnode[4] = E->ien[m][el].node[8];
-
- for(nint=1;nint<=onedvpoints[E->mesh.nsd];nint++) {
- for(d=1;d<=onedvpoints[E->mesh.nsd];d++){
- vtmp = E->M.vpt[GMVINDEX(d,nint)] * dGamma.vpt[GMVGAMMA(1,nint)];
- x[0] += E->x[m][1][lnode[d]] * vtmp; /* coords */
- x[1] += E->x[m][2][lnode[d]] * vtmp;
- x[2] += E->x[m][3][lnode[d]] * vtmp;
- /* */
- v[0] += E->sphere.cap[m].V[1][lnode[d]] * vtmp;
- v[1] += E->sphere.cap[m].V[2][lnode[d]] * vtmp;
- vw += dGamma.vpt[GMVGAMMA(1,nint)];
- }
- }
- } /* end of if i==elz */
- x[0] /= vw;x[1] /= vw;x[2] /= vw; /* convert */
- xyz2rtp(x[0],x[1],x[2],xp);
- v[0] /= vw;v[1] /= vw;
- /* add */
- determine_netr_tp(xp[0],xp[1],xp[2],v[0],v[1],1,(coef+(i-1)*9),&ddummy);
- } /* end of j and k, and m */
-
- } /* Done for i */
- /*
- sum it all up
- */
- MPI_Allreduce(coef,acoef,elz9,MPI_DOUBLE,MPI_SUM,E->parallel.horizontal_comm);
-
- omega[0]=omega[1]=omega[2]=0.0;
-
- /* depth range */
- rr = E->sx[1][3][E->ien[1][elz].node[5]] - E->sx[1][3][E->ien[1][1].node[1]];
- if(rr < 1e-7)
- myerror(E,"rr error in net r determine");
- vw = 0.0;
- for (i=0;i < elz;i++) { /* regular 0..n-1 loop */
- /* solve layer NR */
- lamp = determine_netr_tp(ddummy,ddummy,ddummy,ddummy,ddummy,2,(acoef+i*9),(lomega+i*3));
- r1 = E->sx[1][3][E->ien[1][i+1].node[1]]; /* nodal radii for the
- i-th element, this
- assumes that there
- are no lateral
- variations in radii!
- */
- r2 = E->sx[1][3][E->ien[1][i+1].node[5]];
- vtmp = (r2-r1)/rr; /* weight for this layer */
- //if(E->parallel.me == 0)
- // fprintf(stderr,"NR layer %5i (%11g - %11g, %11g): |%11g %11g %11g| = %11g\n",
- // i+1,r1,r2,vtmp,lomega[i*3+0],lomega[i*3+1],lomega[i*3+2],lamp);
- /* */
- for(i1=0;i1<3;i1++)
- omega[i1] += lomega[i*3+i1] * vtmp;
- vw += vtmp;
- }
- if(fabs(vw) > 1e-8) /* when would it be zero? */
- for(i1=0;i1 < 3;i1++)
- omega[i1] /= vw;
- else
- for(i1=0;i1 < 3;i1++)
- omega[i1] = 0.0;
- free ((void *) acoef);
- free ((void *) coef);
- free ((void *) lomega);
-
-
- oamp = sqrt(omega[0]*omega[0] + omega[1]*omega[1] + omega[2]*omega[2]);
- if(E->parallel.me == 0)
- fprintf(stderr,"determined net rotation of | %.4e %.4e %.4e | = %.4e\n",
- omega[0],omega[1],omega[2],oamp);
- return oamp;
-}
-
-/*
-
-
-
-compute net rotation from velocities given at r, theta, phi as vel_theta and vel_phi
-
-the routines below are based on code originally from Peter Bird, see
-copyright notice below
-
-
-
-the routine will only properly work for global models if the sampling
-is roughly equal area!
-
-mode: 0 initialize
- 1 sum
- 2 solve
-
-*/
-
-
-double determine_netr_tp(float r,float theta,float phi,
- float velt,float velp,int mode,
- double *c9,double *omega)
-{
- float coslat,coslon,sinlat,sinlon,rx,ry,rz,rate,rzu,a,b,c,d,e,f;
- int i,j,ind[3];
- double amp,coef[3][3];
- switch(mode){
- case 0: /* initialize */
- for(i=0;i < 9;i++)
- c9[i] = 0.0;
- amp = 0.0;
- break;
- case 1: /* add this velocity */
- if((fabs(theta) > 1e-5) &&(fabs(theta-M_PI) > 1e-5)){
- coslat=sin(theta);
- coslon=cos(phi);
- sinlat=cos(theta);
- sinlon=sin(phi);
-
- rx=coslat*coslon*r;
- ry=coslat*sinlon*r;
- rz=sinlat*r;
-
- rzu=sinlat;
-
- a = -rz*rzu*sinlon-ry*coslat;
- b = -rz*coslon;
- c = rz*rzu*coslon+rx*coslat;
- d = -rz*sinlon;
- e = -ry*rzu*coslon+rx*rzu*sinlon;
-
- f = ry*sinlon+rx*coslon;
-
- c9[0] += a*a+b*b;
- c9[1] += a*c+b*d;
- c9[2] += a*e+b*f;
- c9[3] += c*c+d*d;
- c9[4] += c*e+d*f;
- c9[5] += e*e+f*f;
-
- c9[6] += a*velt+b*velp;
- c9[7] += c*velt+d*velp;
- c9[8] += e*velt+f*velp;
- }
- amp = 0;
- break;
- case 2: /* solve */
- coef[0][0] = c9[0]; /* assemble matrix */
- coef[0][1] = c9[1];
- coef[0][2] = c9[2];
- coef[1][1] = c9[3];
- coef[1][2] = c9[4];
- coef[2][2] = c9[5];
- coef[1][0]=coef[0][1]; /* symmetric */
- coef[2][0]=coef[0][2];
- coef[2][1]=coef[1][2];
- /* */
- omega[0] = c9[6];
- omega[1] = c9[7];
- omega[2] = c9[8];
-
- /* solve solution*/
- hc_ludcmp_3x3(coef,ind);
- hc_lubksb_3x3(coef,ind,omega);
- amp = sqrt(omega[0]*omega[0] + omega[1]*omega[1] + omega[2]*omega[2]);
- break;
- default:
- fprintf(stderr,"determine_netr_tp: mode %i undefined\n",mode);
- parallel_process_termination();
- break;
- }
- return amp;
-}
-
-//
-// subtract a net rotation component from a velocity
-// field given as v_theta (velt) and v_phi (velp)
-//
-
-void sub_netr(float r,float theta,float phi,float *velt,float *velp, double *omega)
-{
-
- float coslat,coslon,sinlon,sinlat,rx,ry,rz;
- float vx,vy,vz,tx,ty,tz,vtheta,pc,px,py,vphi;
-
- coslat=sin(theta);
- coslon=cos(phi);
- sinlat=cos(theta);
- sinlon=sin(phi);
-
- rx = coslat*coslon*r; /* location vector in Cartesian */
- ry = coslat*sinlon*r;
- rz = sinlat*r;
-
- vx = omega[1]*rz - omega[2]*ry; /* cross product */
- vy = omega[2]*rx - omega[0]*rz;
- vz = omega[0]*ry - omega[1]*rx;
-
- tx = sinlat*coslon; /* theta basis vectors */
- ty = sinlat*sinlon;
- tz = -coslat;
-
- vtheta = vx*tx + vy*ty + vz*tz;
-
- px = -sinlon; /* phi basis vectors */
- py = coslon;
-
- vphi = vx * px + vy * py;
-
- /* remove */
- *velt = *velt - vtheta;
- *velp = *velp - vphi;
-}
-
-
-
-//
-// PROGRAM -OrbScore-: COMPARES OUTPUT FROM -SHELLS-
-// WITH DATA FROM GEODETI// NETWORKS,
-// STRESS DIRECTIONS, FAULT SLIP RATES,
-// SEAFLOOR SPREADING RATES, AND SEISMICITY,
-// AND REPORTS SUMMARY SCALAR SCORES.
-//
-//=========== PART OF THE "SHELLS" PACKAGE OF PROGRAMS===========
-//
-// GIVEN A FINITE ELEMENT GRID FILE, IN THE FORMAT PRODUCED BY
-// -OrbWeave- AND RENUMBERED BY -OrbNumbr-, WITH NODAL DATA
-// ADDED BY -OrbData-, AND NODE-VELOCITY OUTPUT FROM -SHELLS-,
-// COMPUTES A VARIETY OF SCORES OF THE RESULTS.
-//
-// NOTE: Does not contain VISCOS or DIAMND, hence independent
-// of changes made in May 1998, and equally compatible
-// with Old_SHELLS or with improved SHELLS.
-//
-// by
-// Peter Bird
-// Department of Earth and Spcae Sciences,
-// University of California, Los Angeles, California 90095-1567
-// (C) Copyright 1994, 1998, 1999, 2000
-// by Peter Bird and the Regents of
-// the University of California.
-// (For version data see FORMAT 1 below)
-//
-// THIS PROGRAM WAS DEVELOPED WITH SUPPORT FROM THE UNIVERSITY OF
-// CALIFORNIA, THE UNITED STATES GEOLOGI// SURVEY, THE NATIONAL
-// SCIENCE FOUNDATION, AND THE NATIONAL AERONAUTICS AND SPACE
-// ADMINISTRATION.
-// IT IS FREEWARE, AND MAY BE COPIED AND USED WITHOUT CHARGE.
-// IT MAY NOT BE MODIFIED IN A WAY WHICH HIDES ITS ORIGIN
-// OR REMOVES THIS MESSAGE OR THE COPYRIGHT MESSAGE.
-// IT MAY NOT BE RESOLD FOR MORE THAN THE COST OF REPRODUCTION
-// AND MAILING.
-//
-
-
-
-/*
-
-matrix solvers from numerical recipes
-
- */
-#define NR_TINY 1.0e-20;
-
-void hc_ludcmp_3x3(double a[3][3],int *indx)
-{
- int i,imax=0,j,k;
- double big,dum,sum,temp;
- double vv[3];
-
- for (i=0;i < 3;i++) {
- big=0.0;
- for (j=0;j < 3;j++)
- if ((temp = fabs(a[i][j])) > big)
- big=temp;
- if (fabs(big) < 5e-15) {
- fprintf(stderr,"hc_ludcmp_3x3: singular matrix in routine, big: %g\n",
- big);
- //hc_print_3x3(a,stderr);
- for(j=0;j<3;j++)
- fprintf(stderr,"%g %g %g\n",a[j][0],a[j][1],a[j][2]);
- parallel_process_termination();
- }
- vv[i]=1.0/big;
- }
- for (j=0;j < 3;j++) {
- for (i=0;i < j;i++) {
- sum = a[i][j];
- for (k=0;k < i;k++)
- sum -= a[i][k] * a[k][j];
- a[i][j]=sum;
- }
- big=0.0;
- for (i=j;i < 3;i++) {
- sum=a[i][j];
- for (k=0;k < j;k++)
- sum -= a[i][k] * a[k][j];
- a[i][j]=sum;
- if ( (dum = vv[i]*fabs(sum)) >= big) {
- big=dum;
- imax=i;
- }
- }
- if (j != imax) {
- for (k=0;k < 3;k++) {
- dum = a[imax][k];
- a[imax][k]=a[j][k];
- a[j][k]=dum;
- }
- vv[imax]=vv[j];
- }
- indx[j]=imax;
- if (fabs(a[j][j]) < 5e-15)
- a[j][j] = NR_TINY;
- if (j != 2) {
- dum=1.0/(a[j][j]);
- for (i=j+1;i < 3;i++)
- a[i][j] *= dum;
- }
- }
-}
-#undef NR_TINY
-void hc_lubksb_3x3(double a[3][3], int *indx, double *b)
-{
- int i,ii=0,ip,j;
- double sum;
- for (i=0;i < 3;i++) {
- ip = indx[i];
- sum = b[ip];
- b[ip]=b[i];
- if (ii)
- for (j=ii-1;j <= i-1;j++)
- sum -= a[i][j]*b[j];
- else if (fabs(sum) > 5e-15)
- ii = i+1;
- b[i]=sum;
- }
- for (i=2;i>=0;i--) {
- sum=b[i];
- for (j=i+1;j < 3;j++)
- sum -= a[i][j]*b[j];
- b[i] = sum/a[i][i];
- }
-}
-
Copied: mc/3D/CitcomS/branches/cxx/lib/Determine_net_rotation.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Determine_net_rotation.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Determine_net_rotation.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Determine_net_rotation.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,462 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+
+/*
+
+routines to determine the net rotation velocity of the whole model
+
+TWB
+
+These have been superceded by the routines in Global_opertations and can probably be removed
+
+
+*/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <math.h>
+#include "element_definitions.h"
+#include "global_defs.h"
+#include "parallel_related.h"
+#include "parsing.h"
+#include "output.h"
+
+#include "cproto.h"
+
+double determine_netr_tp(float, float, float, float, float, int, double *, double *);
+void sub_netr(float, float, float, float *, float *, double *);
+void hc_ludcmp_3x3(double [3][3], int *);
+void hc_lubksb_3x3(double [3][3], int *, double *);
+void xyz2rtp(float ,float ,float ,float *);
+void *safe_malloc (size_t );
+double determine_model_net_rotation(struct All_variables *,double *);
+void myerror(struct All_variables *,char *);
+/*
+
+determine the mean net rotation of the velocities at all layers
+
+
+modeled after horizontal layer average routines
+
+*/
+double determine_model_net_rotation(struct All_variables *E,double *omega)
+{
+ const int dims = E->mesh.nsd;
+ int m,i,j,k,d,nint,el,elz,elx,ely,j1,j2,i1,i2,k1,k2,nproc;
+ int top,lnode[5],elz9;
+ double *acoef,*coef,*lomega,ddummy,oamp,lamp;
+ float v[2],vw,vtmp,r,t,p,x[3],xp[3],r1,r2,rr;
+ struct Shape_function1 M;
+ struct Shape_function1_dA dGamma;
+
+ elz = E->lmesh.elz;elx = E->lmesh.elx;ely = E->lmesh.ely;
+
+ elz9 = elz*9;
+
+ acoef = (double *)safe_malloc(elz9*sizeof(double));
+ coef = (double *)safe_malloc(elz9*sizeof(double));
+ lomega = (double *)safe_malloc(3*elz*sizeof(double));
+
+ for (i=1;i <= elz;i++) { /* loop through depths */
+
+ /* zero out coef for init */
+ determine_netr_tp(ddummy,ddummy,ddummy,ddummy,ddummy,0,(coef+(i-1)*9),&ddummy);
+
+ if (i==elz)
+ top = 1;
+ else
+ top = 0;
+ for (m=1;m <= E->sphere.caps_per_proc;m++)
+ for (k=1;k <= ely;k++)
+ for (j=1;j <= elx;j++) {
+ el = i + (j-1)*elz + (k-1)*elx*elz;
+ get_global_1d_shape_fn(E,el,&M,&dGamma,top,m);
+
+ /* find mean element location and horizontal velocity */
+
+ x[0] = x[1] = x[2] = v[0] = v[1] = vw = 0.0;
+
+ lnode[1] = E->ien[m][el].node[1];
+ lnode[2] = E->ien[m][el].node[2];
+ lnode[3] = E->ien[m][el].node[3];
+ lnode[4] = E->ien[m][el].node[4];
+
+ for(nint=1;nint <= onedvpoints[E->mesh.nsd];nint++) {
+ for(d=1;d <= onedvpoints[E->mesh.nsd];d++){
+ vtmp = E->M.vpt[GMVINDEX(d,nint)] * dGamma.vpt[GMVGAMMA(0,nint)];
+ x[0] += E->x[m][1][lnode[d]] * vtmp; /* coords */
+ x[1] += E->x[m][2][lnode[d]] * vtmp;
+ x[2] += E->x[m][3][lnode[d]] * vtmp;
+
+ v[0] += E->sphere.cap[m].V[1][lnode[d]] * vtmp; /* theta */
+ v[1] += E->sphere.cap[m].V[2][lnode[d]] * vtmp; /* phi */
+ vw += dGamma.vpt[GMVGAMMA(0,nint)];
+ }
+ }
+ if (i==elz) {
+ lnode[1] = E->ien[m][el].node[5];
+ lnode[2] = E->ien[m][el].node[6];
+ lnode[3] = E->ien[m][el].node[7];
+ lnode[4] = E->ien[m][el].node[8];
+
+ for(nint=1;nint<=onedvpoints[E->mesh.nsd];nint++) {
+ for(d=1;d<=onedvpoints[E->mesh.nsd];d++){
+ vtmp = E->M.vpt[GMVINDEX(d,nint)] * dGamma.vpt[GMVGAMMA(1,nint)];
+ x[0] += E->x[m][1][lnode[d]] * vtmp; /* coords */
+ x[1] += E->x[m][2][lnode[d]] * vtmp;
+ x[2] += E->x[m][3][lnode[d]] * vtmp;
+ /* */
+ v[0] += E->sphere.cap[m].V[1][lnode[d]] * vtmp;
+ v[1] += E->sphere.cap[m].V[2][lnode[d]] * vtmp;
+ vw += dGamma.vpt[GMVGAMMA(1,nint)];
+ }
+ }
+ } /* end of if i==elz */
+ x[0] /= vw;x[1] /= vw;x[2] /= vw; /* convert */
+ xyz2rtp(x[0],x[1],x[2],xp);
+ v[0] /= vw;v[1] /= vw;
+ /* add */
+ determine_netr_tp(xp[0],xp[1],xp[2],v[0],v[1],1,(coef+(i-1)*9),&ddummy);
+ } /* end of j and k, and m */
+
+ } /* Done for i */
+ /*
+ sum it all up
+ */
+ MPI_Allreduce(coef,acoef,elz9,MPI_DOUBLE,MPI_SUM,E->parallel.horizontal_comm);
+
+ omega[0]=omega[1]=omega[2]=0.0;
+
+ /* depth range */
+ rr = E->sx[1][3][E->ien[1][elz].node[5]] - E->sx[1][3][E->ien[1][1].node[1]];
+ if(rr < 1e-7)
+ myerror(E,"rr error in net r determine");
+ vw = 0.0;
+ for (i=0;i < elz;i++) { /* regular 0..n-1 loop */
+ /* solve layer NR */
+ lamp = determine_netr_tp(ddummy,ddummy,ddummy,ddummy,ddummy,2,(acoef+i*9),(lomega+i*3));
+ r1 = E->sx[1][3][E->ien[1][i+1].node[1]]; /* nodal radii for the
+ i-th element, this
+ assumes that there
+ are no lateral
+ variations in radii!
+ */
+ r2 = E->sx[1][3][E->ien[1][i+1].node[5]];
+ vtmp = (r2-r1)/rr; /* weight for this layer */
+ //if(E->parallel.me == 0)
+ // fprintf(stderr,"NR layer %5i (%11g - %11g, %11g): |%11g %11g %11g| = %11g\n",
+ // i+1,r1,r2,vtmp,lomega[i*3+0],lomega[i*3+1],lomega[i*3+2],lamp);
+ /* */
+ for(i1=0;i1<3;i1++)
+ omega[i1] += lomega[i*3+i1] * vtmp;
+ vw += vtmp;
+ }
+ if(fabs(vw) > 1e-8) /* when would it be zero? */
+ for(i1=0;i1 < 3;i1++)
+ omega[i1] /= vw;
+ else
+ for(i1=0;i1 < 3;i1++)
+ omega[i1] = 0.0;
+ free ((void *) acoef);
+ free ((void *) coef);
+ free ((void *) lomega);
+
+
+ oamp = sqrt(omega[0]*omega[0] + omega[1]*omega[1] + omega[2]*omega[2]);
+ if(E->parallel.me == 0)
+ fprintf(stderr,"determined net rotation of | %.4e %.4e %.4e | = %.4e\n",
+ omega[0],omega[1],omega[2],oamp);
+ return oamp;
+}
+
+/*
+
+
+
+compute net rotation from velocities given at r, theta, phi as vel_theta and vel_phi
+
+the routines below are based on code originally from Peter Bird, see
+copyright notice below
+
+
+
+the routine will only properly work for global models if the sampling
+is roughly equal area!
+
+mode: 0 initialize
+ 1 sum
+ 2 solve
+
+*/
+
+
+double determine_netr_tp(float r,float theta,float phi,
+ float velt,float velp,int mode,
+ double *c9,double *omega)
+{
+ float coslat,coslon,sinlat,sinlon,rx,ry,rz,rate,rzu,a,b,c,d,e,f;
+ int i,j,ind[3];
+ double amp,coef[3][3];
+ switch(mode){
+ case 0: /* initialize */
+ for(i=0;i < 9;i++)
+ c9[i] = 0.0;
+ amp = 0.0;
+ break;
+ case 1: /* add this velocity */
+ if((fabs(theta) > 1e-5) &&(fabs(theta-M_PI) > 1e-5)){
+ coslat=sin(theta);
+ coslon=cos(phi);
+ sinlat=cos(theta);
+ sinlon=sin(phi);
+
+ rx=coslat*coslon*r;
+ ry=coslat*sinlon*r;
+ rz=sinlat*r;
+
+ rzu=sinlat;
+
+ a = -rz*rzu*sinlon-ry*coslat;
+ b = -rz*coslon;
+ c = rz*rzu*coslon+rx*coslat;
+ d = -rz*sinlon;
+ e = -ry*rzu*coslon+rx*rzu*sinlon;
+
+ f = ry*sinlon+rx*coslon;
+
+ c9[0] += a*a+b*b;
+ c9[1] += a*c+b*d;
+ c9[2] += a*e+b*f;
+ c9[3] += c*c+d*d;
+ c9[4] += c*e+d*f;
+ c9[5] += e*e+f*f;
+
+ c9[6] += a*velt+b*velp;
+ c9[7] += c*velt+d*velp;
+ c9[8] += e*velt+f*velp;
+ }
+ amp = 0;
+ break;
+ case 2: /* solve */
+ coef[0][0] = c9[0]; /* assemble matrix */
+ coef[0][1] = c9[1];
+ coef[0][2] = c9[2];
+ coef[1][1] = c9[3];
+ coef[1][2] = c9[4];
+ coef[2][2] = c9[5];
+ coef[1][0]=coef[0][1]; /* symmetric */
+ coef[2][0]=coef[0][2];
+ coef[2][1]=coef[1][2];
+ /* */
+ omega[0] = c9[6];
+ omega[1] = c9[7];
+ omega[2] = c9[8];
+
+ /* solve solution*/
+ hc_ludcmp_3x3(coef,ind);
+ hc_lubksb_3x3(coef,ind,omega);
+ amp = sqrt(omega[0]*omega[0] + omega[1]*omega[1] + omega[2]*omega[2]);
+ break;
+ default:
+ fprintf(stderr,"determine_netr_tp: mode %i undefined\n",mode);
+ parallel_process_termination();
+ break;
+ }
+ return amp;
+}
+
+//
+// subtract a net rotation component from a velocity
+// field given as v_theta (velt) and v_phi (velp)
+//
+
+void sub_netr(float r,float theta,float phi,float *velt,float *velp, double *omega)
+{
+
+ float coslat,coslon,sinlon,sinlat,rx,ry,rz;
+ float vx,vy,vz,tx,ty,tz,vtheta,pc,px,py,vphi;
+
+ coslat=sin(theta);
+ coslon=cos(phi);
+ sinlat=cos(theta);
+ sinlon=sin(phi);
+
+ rx = coslat*coslon*r; /* location vector in Cartesian */
+ ry = coslat*sinlon*r;
+ rz = sinlat*r;
+
+ vx = omega[1]*rz - omega[2]*ry; /* cross product */
+ vy = omega[2]*rx - omega[0]*rz;
+ vz = omega[0]*ry - omega[1]*rx;
+
+ tx = sinlat*coslon; /* theta basis vectors */
+ ty = sinlat*sinlon;
+ tz = -coslat;
+
+ vtheta = vx*tx + vy*ty + vz*tz;
+
+ px = -sinlon; /* phi basis vectors */
+ py = coslon;
+
+ vphi = vx * px + vy * py;
+
+ /* remove */
+ *velt = *velt - vtheta;
+ *velp = *velp - vphi;
+}
+
+
+
+//
+// PROGRAM -OrbScore-: COMPARES OUTPUT FROM -SHELLS-
+// WITH DATA FROM GEODETI// NETWORKS,
+// STRESS DIRECTIONS, FAULT SLIP RATES,
+// SEAFLOOR SPREADING RATES, AND SEISMICITY,
+// AND REPORTS SUMMARY SCALAR SCORES.
+//
+//=========== PART OF THE "SHELLS" PACKAGE OF PROGRAMS===========
+//
+// GIVEN A FINITE ELEMENT GRID FILE, IN THE FORMAT PRODUCED BY
+// -OrbWeave- AND RENUMBERED BY -OrbNumbr-, WITH NODAL DATA
+// ADDED BY -OrbData-, AND NODE-VELOCITY OUTPUT FROM -SHELLS-,
+// COMPUTES A VARIETY OF SCORES OF THE RESULTS.
+//
+// NOTE: Does not contain VISCOS or DIAMND, hence independent
+// of changes made in May 1998, and equally compatible
+// with Old_SHELLS or with improved SHELLS.
+//
+// by
+// Peter Bird
+// Department of Earth and Spcae Sciences,
+// University of California, Los Angeles, California 90095-1567
+// (C) Copyright 1994, 1998, 1999, 2000
+// by Peter Bird and the Regents of
+// the University of California.
+// (For version data see FORMAT 1 below)
+//
+// THIS PROGRAM WAS DEVELOPED WITH SUPPORT FROM THE UNIVERSITY OF
+// CALIFORNIA, THE UNITED STATES GEOLOGI// SURVEY, THE NATIONAL
+// SCIENCE FOUNDATION, AND THE NATIONAL AERONAUTICS AND SPACE
+// ADMINISTRATION.
+// IT IS FREEWARE, AND MAY BE COPIED AND USED WITHOUT CHARGE.
+// IT MAY NOT BE MODIFIED IN A WAY WHICH HIDES ITS ORIGIN
+// OR REMOVES THIS MESSAGE OR THE COPYRIGHT MESSAGE.
+// IT MAY NOT BE RESOLD FOR MORE THAN THE COST OF REPRODUCTION
+// AND MAILING.
+//
+
+
+
+/*
+
+matrix solvers from numerical recipes
+
+ */
+#define NR_TINY 1.0e-20;
+
+void hc_ludcmp_3x3(double a[3][3],int *indx)
+{
+ int i,imax=0,j,k;
+ double big,dum,sum,temp;
+ double vv[3];
+
+ for (i=0;i < 3;i++) {
+ big=0.0;
+ for (j=0;j < 3;j++)
+ if ((temp = fabs(a[i][j])) > big)
+ big=temp;
+ if (fabs(big) < 5e-15) {
+ fprintf(stderr,"hc_ludcmp_3x3: singular matrix in routine, big: %g\n",
+ big);
+ //hc_print_3x3(a,stderr);
+ for(j=0;j<3;j++)
+ fprintf(stderr,"%g %g %g\n",a[j][0],a[j][1],a[j][2]);
+ parallel_process_termination();
+ }
+ vv[i]=1.0/big;
+ }
+ for (j=0;j < 3;j++) {
+ for (i=0;i < j;i++) {
+ sum = a[i][j];
+ for (k=0;k < i;k++)
+ sum -= a[i][k] * a[k][j];
+ a[i][j]=sum;
+ }
+ big=0.0;
+ for (i=j;i < 3;i++) {
+ sum=a[i][j];
+ for (k=0;k < j;k++)
+ sum -= a[i][k] * a[k][j];
+ a[i][j]=sum;
+ if ( (dum = vv[i]*fabs(sum)) >= big) {
+ big=dum;
+ imax=i;
+ }
+ }
+ if (j != imax) {
+ for (k=0;k < 3;k++) {
+ dum = a[imax][k];
+ a[imax][k]=a[j][k];
+ a[j][k]=dum;
+ }
+ vv[imax]=vv[j];
+ }
+ indx[j]=imax;
+ if (fabs(a[j][j]) < 5e-15)
+ a[j][j] = NR_TINY;
+ if (j != 2) {
+ dum=1.0/(a[j][j]);
+ for (i=j+1;i < 3;i++)
+ a[i][j] *= dum;
+ }
+ }
+}
+#undef NR_TINY
+void hc_lubksb_3x3(double a[3][3], int *indx, double *b)
+{
+ int i,ii=0,ip,j;
+ double sum;
+ for (i=0;i < 3;i++) {
+ ip = indx[i];
+ sum = b[ip];
+ b[ip]=b[i];
+ if (ii)
+ for (j=ii-1;j <= i-1;j++)
+ sum -= a[i][j]*b[j];
+ else if (fabs(sum) > 5e-15)
+ ii = i+1;
+ b[i]=sum;
+ }
+ for (i=2;i>=0;i--) {
+ sum=b[i];
+ for (j=i+1;j < 3;j++)
+ sum -= a[i][j]*b[j];
+ b[i] = sum/a[i][i];
+ }
+}
+
Deleted: mc/3D/CitcomS/branches/cxx/lib/Drive_solvers.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Drive_solvers.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Drive_solvers.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,271 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-#include <math.h>
-#include <sys/types.h>
-#include "element_definitions.h"
-#include "global_defs.h"
-#include "drive_solvers.h"
-
-double global_vdot();
-double vnorm_nonnewt();
-int need_visc_update(struct All_variables *);
-
-
-
-/************************************************************/
-
-void general_stokes_solver_setup(struct All_variables *E)
-{
- int i, m;
- void construct_node_maps();
-
- if (E->control.NMULTIGRID || E->control.NASSEMBLE)
- construct_node_maps(E);
- else
- for (i=E->mesh.gridmin;i<=E->mesh.gridmax;i++)
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- E->elt_k[i][m]=(struct EK *)malloc((E->lmesh.NEL[i]+1)*sizeof(struct EK));
-
-
- return;
-}
-
-
-
-
-void general_stokes_solver(struct All_variables *E)
-{
- void solve_constrained_flow_iterative();
- void construct_stiffness_B_matrix();
- void velocities_conform_bcs();
- void assemble_forces();
- void sphere_harmonics_layer();
- void get_system_viscosity();
- void remove_rigid_rot();
-
- float vmag;
-
- double Udot_mag, dUdot_mag,omega[3];
- int m,count,i,j,k;
-
- double *oldU[NCS], *delta_U[NCS];
-
- const int nno = E->lmesh.nno;
- const int nel = E->lmesh.nel;
- const int neq = E->lmesh.neq;
- const int vpts = vpoints[E->mesh.nsd];
- const int dims = E->mesh.nsd;
- const int addi_dof = additional_dof[dims];
-
- velocities_conform_bcs(E,E->U);
-
- assemble_forces(E,0);
- if(need_visc_update(E)){
- get_system_viscosity(E,1,E->EVI[E->mesh.levmax],E->VI[E->mesh.levmax]);
- construct_stiffness_B_matrix(E);
- }
-
- solve_constrained_flow_iterative(E);
-
- if (E->viscosity.SDEPV || E->viscosity.PDEPV) {
- /* outer iterations for velocity dependent viscosity */
-
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- delta_U[m] = (double *)malloc(neq*sizeof(double));
- oldU[m] = (double *)malloc(neq*sizeof(double));
- for(i=0;i<neq;i++)
- oldU[m][i]=0.0;
- }
-
- Udot_mag=dUdot_mag=0.0;
- count=1;
-
- while (1) {
-
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for (i=0;i<neq;i++) {
- delta_U[m][i] = E->U[m][i] - oldU[m][i];
- oldU[m][i] = E->U[m][i];
- }
-
- Udot_mag = sqrt(global_vdot(E,oldU,oldU,E->mesh.levmax));
- dUdot_mag = vnorm_nonnewt(E,delta_U,oldU,E->mesh.levmax);
-
-
- if(E->parallel.me==0){
- fprintf(stderr,"Stress dep. visc./plast.: DUdot = %.4e (%.4e) for iteration %d\n",
- dUdot_mag,Udot_mag,count);
- fprintf(E->fp,"Stress dep. visc./plast.: DUdot = %.4e (%.4e) for iteration %d\n",
- dUdot_mag,Udot_mag,count);
- fflush(E->fp);
- }
- if ((count>50) || (dUdot_mag < E->viscosity.sdepv_misfit))
- break;
-
- get_system_viscosity(E,1,E->EVI[E->mesh.levmax],E->VI[E->mesh.levmax]);
- construct_stiffness_B_matrix(E);
- solve_constrained_flow_iterative(E);
-
- count++;
-
- } /*end while*/
-
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- free((void *) oldU[m]);
- free((void *) delta_U[m]);
- }
-
- } /*end if SDEPV or PDEPV */
-
- /* remove the rigid rotation component from the velocity solution */
- if((E->sphere.caps == 12) && E->control.remove_rigid_rotation) {
- remove_rigid_rot(E);
- }
-
- return;
-}
-
-int need_visc_update(struct All_variables *E)
-{
- if(E->viscosity.update_allowed){
- /* always update */
- return 1;
- }else{
- /* deal with first time called */
- if(E->control.restart){
- /* restart step - when this function is called, the cycle has
- already been incremented */
- if(E->monitor.solution_cycles == E->monitor.solution_cycles_init + 1)
- return 1;
- else
- return 0;
- }else{
- /* regular step */
- if(E->monitor.solution_cycles == 0)
- return 1;
- else
- return 0;
- }
- }
-}
-
-void general_stokes_solver_pseudo_surf(struct All_variables *E)
-{
- void solve_constrained_flow_iterative_pseudo_surf();
- void construct_stiffness_B_matrix();
- void velocities_conform_bcs();
- void assemble_forces_pseudo_surf();
- void get_system_viscosity();
- void std_timestep();
- void remove_rigid_rot();
- void get_STD_freesurf(struct All_variables *, float**);
-
- float vmag;
-
- double Udot_mag, dUdot_mag;
- int m,count,i,j,k,topo_loop;
-
- double *oldU[NCS], *delta_U[NCS];
-
- const int nno = E->lmesh.nno;
- const int nel = E->lmesh.nel;
- const int neq = E->lmesh.neq;
- const int vpts = vpoints[E->mesh.nsd];
- const int dims = E->mesh.nsd;
- const int addi_dof = additional_dof[dims];
-
- velocities_conform_bcs(E,E->U);
-
- E->monitor.stop_topo_loop = 0;
- E->monitor.topo_loop = 0;
- if(E->monitor.solution_cycles==0) std_timestep(E);
- while(E->monitor.stop_topo_loop == 0) {
- assemble_forces_pseudo_surf(E,0);
- if(need_visc_update(E)){
- get_system_viscosity(E,1,E->EVI[E->mesh.levmax],E->VI[E->mesh.levmax]);
- construct_stiffness_B_matrix(E);
- }
- solve_constrained_flow_iterative_pseudo_surf(E);
-
- if (E->viscosity.SDEPV || E->viscosity.PDEPV) {
-
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- delta_U[m] = (double *)malloc(neq*sizeof(double));
- oldU[m] = (double *)malloc(neq*sizeof(double));
- for(i=0;i<neq;i++)
- oldU[m][i]=0.0;
- }
-
- Udot_mag=dUdot_mag=0.0;
- count=1;
-
- while (1) {
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for (i=0;i<neq;i++) {
- delta_U[m][i] = E->U[m][i] - oldU[m][i];
- oldU[m][i] = E->U[m][i];
- }
-
- Udot_mag = sqrt(global_vdot(E,oldU,oldU,E->mesh.levmax));
- dUdot_mag = vnorm_nonnewt(E,delta_U,oldU,E->mesh.levmax);
-
- if(E->parallel.me==0){
- fprintf(stderr,"Stress dependent viscosity: DUdot = %.4e (%.4e) for iteration %d\n",dUdot_mag,Udot_mag,count);
- fprintf(E->fp,"Stress dependent viscosity: DUdot = %.4e (%.4e) for iteration %d\n",dUdot_mag,Udot_mag,count);
- fflush(E->fp);
- }
-
- if (count>50 || dUdot_mag<E->viscosity.sdepv_misfit)
- break;
-
- get_system_viscosity(E,1,E->EVI[E->mesh.levmax],E->VI[E->mesh.levmax]);
- construct_stiffness_B_matrix(E);
- solve_constrained_flow_iterative_pseudo_surf(E);
-
- count++;
-
- } /*end while */
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- free((void *) oldU[m]);
- free((void *) delta_U[m]);
- }
-
- } /*end if SDEPV or PDEPV */
- E->monitor.topo_loop++;
- }
-
- /* remove the rigid rotation component from the velocity solution */
- if(E->sphere.caps == 12 && E->control.remove_rigid_rotation)
- remove_rigid_rot(E);
-
- get_STD_freesurf(E,E->slice.freesurf);
-
- return;
-}
Copied: mc/3D/CitcomS/branches/cxx/lib/Drive_solvers.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Drive_solvers.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Drive_solvers.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Drive_solvers.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,255 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+#include <math.h>
+#include <sys/types.h>
+#include "element_definitions.h"
+#include "global_defs.h"
+#include "drive_solvers.h"
+
+#include "cproto.h"
+
+double global_vdot();
+double vnorm_nonnewt();
+int need_visc_update(struct All_variables *);
+
+
+
+/************************************************************/
+
+void general_stokes_solver_setup(struct All_variables *E)
+{
+ int i, m;
+
+ if (E->control.NMULTIGRID || E->control.NASSEMBLE)
+ construct_node_maps(E);
+ else
+ for (i=E->mesh.gridmin;i<=E->mesh.gridmax;i++)
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ E->elt_k[i][m]=(struct EK *)malloc((E->lmesh.NEL[i]+1)*sizeof(struct EK));
+
+
+ return;
+}
+
+
+
+
+void general_stokes_solver(struct All_variables *E)
+{
+ float vmag;
+
+ double Udot_mag, dUdot_mag,omega[3];
+ int m,count,i,j,k;
+
+ double *oldU[NCS], *delta_U[NCS];
+
+ const int nno = E->lmesh.nno;
+ const int nel = E->lmesh.nel;
+ const int neq = E->lmesh.neq;
+ const int vpts = vpoints[E->mesh.nsd];
+ const int dims = E->mesh.nsd;
+ const int addi_dof = additional_dof[dims];
+
+ velocities_conform_bcs(E,E->U);
+
+ assemble_forces(E,0);
+ if(need_visc_update(E)){
+ get_system_viscosity(E,1,E->EVI[E->mesh.levmax],E->VI[E->mesh.levmax]);
+ construct_stiffness_B_matrix(E);
+ }
+
+ solve_constrained_flow_iterative(E);
+
+ if (E->viscosity.SDEPV || E->viscosity.PDEPV) {
+ /* outer iterations for velocity dependent viscosity */
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ delta_U[m] = (double *)malloc(neq*sizeof(double));
+ oldU[m] = (double *)malloc(neq*sizeof(double));
+ for(i=0;i<neq;i++)
+ oldU[m][i]=0.0;
+ }
+
+ Udot_mag=dUdot_mag=0.0;
+ count=1;
+
+ while (1) {
+
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for (i=0;i<neq;i++) {
+ delta_U[m][i] = E->U[m][i] - oldU[m][i];
+ oldU[m][i] = E->U[m][i];
+ }
+
+ Udot_mag = sqrt(global_vdot(E,oldU,oldU,E->mesh.levmax));
+ dUdot_mag = vnorm_nonnewt(E,delta_U,oldU,E->mesh.levmax);
+
+
+ if(E->parallel.me==0){
+ fprintf(stderr,"Stress dep. visc./plast.: DUdot = %.4e (%.4e) for iteration %d\n",
+ dUdot_mag,Udot_mag,count);
+ fprintf(E->fp,"Stress dep. visc./plast.: DUdot = %.4e (%.4e) for iteration %d\n",
+ dUdot_mag,Udot_mag,count);
+ fflush(E->fp);
+ }
+ if ((count>50) || (dUdot_mag < E->viscosity.sdepv_misfit))
+ break;
+
+ get_system_viscosity(E,1,E->EVI[E->mesh.levmax],E->VI[E->mesh.levmax]);
+ construct_stiffness_B_matrix(E);
+ solve_constrained_flow_iterative(E);
+
+ count++;
+
+ } /*end while*/
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ free((void *) oldU[m]);
+ free((void *) delta_U[m]);
+ }
+
+ } /*end if SDEPV or PDEPV */
+
+ /* remove the rigid rotation component from the velocity solution */
+ if((E->sphere.caps == 12) && E->control.remove_rigid_rotation) {
+ remove_rigid_rot(E);
+ }
+
+ return;
+}
+
+int need_visc_update(struct All_variables *E)
+{
+ if(E->viscosity.update_allowed){
+ /* always update */
+ return 1;
+ }else{
+ /* deal with first time called */
+ if(E->control.restart){
+ /* restart step - when this function is called, the cycle has
+ already been incremented */
+ if(E->monitor.solution_cycles == E->monitor.solution_cycles_init + 1)
+ return 1;
+ else
+ return 0;
+ }else{
+ /* regular step */
+ if(E->monitor.solution_cycles == 0)
+ return 1;
+ else
+ return 0;
+ }
+ }
+}
+
+void general_stokes_solver_pseudo_surf(struct All_variables *E)
+{
+ float vmag;
+
+ double Udot_mag, dUdot_mag;
+ int m,count,i,j,k,topo_loop;
+
+ double *oldU[NCS], *delta_U[NCS];
+
+ const int nno = E->lmesh.nno;
+ const int nel = E->lmesh.nel;
+ const int neq = E->lmesh.neq;
+ const int vpts = vpoints[E->mesh.nsd];
+ const int dims = E->mesh.nsd;
+ const int addi_dof = additional_dof[dims];
+
+ velocities_conform_bcs(E,E->U);
+
+ E->monitor.stop_topo_loop = 0;
+ E->monitor.topo_loop = 0;
+ if(E->monitor.solution_cycles==0) std_timestep(E);
+ while(E->monitor.stop_topo_loop == 0) {
+ assemble_forces_pseudo_surf(E,0);
+ if(need_visc_update(E)){
+ get_system_viscosity(E,1,E->EVI[E->mesh.levmax],E->VI[E->mesh.levmax]);
+ construct_stiffness_B_matrix(E);
+ }
+ solve_constrained_flow_iterative_pseudo_surf(E);
+
+ if (E->viscosity.SDEPV || E->viscosity.PDEPV) {
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ delta_U[m] = (double *)malloc(neq*sizeof(double));
+ oldU[m] = (double *)malloc(neq*sizeof(double));
+ for(i=0;i<neq;i++)
+ oldU[m][i]=0.0;
+ }
+
+ Udot_mag=dUdot_mag=0.0;
+ count=1;
+
+ while (1) {
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for (i=0;i<neq;i++) {
+ delta_U[m][i] = E->U[m][i] - oldU[m][i];
+ oldU[m][i] = E->U[m][i];
+ }
+
+ Udot_mag = sqrt(global_vdot(E,oldU,oldU,E->mesh.levmax));
+ dUdot_mag = vnorm_nonnewt(E,delta_U,oldU,E->mesh.levmax);
+
+ if(E->parallel.me==0){
+ fprintf(stderr,"Stress dependent viscosity: DUdot = %.4e (%.4e) for iteration %d\n",dUdot_mag,Udot_mag,count);
+ fprintf(E->fp,"Stress dependent viscosity: DUdot = %.4e (%.4e) for iteration %d\n",dUdot_mag,Udot_mag,count);
+ fflush(E->fp);
+ }
+
+ if (count>50 || dUdot_mag<E->viscosity.sdepv_misfit)
+ break;
+
+ get_system_viscosity(E,1,E->EVI[E->mesh.levmax],E->VI[E->mesh.levmax]);
+ construct_stiffness_B_matrix(E);
+ solve_constrained_flow_iterative_pseudo_surf(E);
+
+ count++;
+
+ } /*end while */
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ free((void *) oldU[m]);
+ free((void *) delta_U[m]);
+ }
+
+ } /*end if SDEPV or PDEPV */
+ E->monitor.topo_loop++;
+ }
+
+ /* remove the rigid rotation component from the velocity solution */
+ if(E->sphere.caps == 12 && E->control.remove_rigid_rotation)
+ remove_rigid_rot(E);
+
+ get_STD_freesurf(E,E->slice.freesurf);
+
+ return;
+}
Deleted: mc/3D/CitcomS/branches/cxx/lib/Element_calculations.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Element_calculations.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Element_calculations.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,1309 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-/* Functions to assemble the element k matrices and the element f vector.
- Note that for the regular grid case the calculation of k becomes repetitive
- to the point of redundancy. */
-
-#include <math.h>
-#include "element_definitions.h"
-#include "global_defs.h"
-#include "material_properties.h"
-
-/* else, PGI would complain */
-void construct_side_c3x3matrix_el(struct All_variables *,int ,
- struct CC *,struct CCX *,
- int ,int ,int ,int );
-void construct_c3x3matrix(struct All_variables *);
-void construct_c3x3matrix_el (struct All_variables *,int ,struct CC *,
- struct CCX *,int ,int ,int );
-void assemble_div_u(struct All_variables *,
- double **, double **, int );
-void get_elt_tr(struct All_variables *, int , int , double [24], int );
-void get_elt_tr_pseudo_surf(struct All_variables *, int , int , double [24], int );
-
-
-void add_force(struct All_variables *E, int e, double elt_f[24], int m)
-{
- const int dims=E->mesh.nsd;
- const int ends=enodes[E->mesh.nsd];
- int a, a1, a2, a3, p, node;
-
- for(a=1;a<=ends;a++) {
- node = E->ien[m][e].node[a];
- p=(a-1)*dims;
- a1=E->id[m][node].doff[1];
- E->F[m][a1] += elt_f[p];
- a2=E->id[m][node].doff[2];
- E->F[m][a2] += elt_f[p+1];
- a3=E->id[m][node].doff[3];
- E->F[m][a3] += elt_f[p+2];
- }
-}
-
-
-
-/* ================================================================
- Function to assemble the global F vector.
- +
- Function to get the global H vector (mixed method driving terms)
- ================================================================ */
-
-void assemble_forces(E,penalty)
- struct All_variables *E;
- int penalty;
-{
- double elt_f[24];
- int m,a,e,i;
-
- void get_buoyancy();
- void get_elt_f();
- void get_elt_tr();
- void strip_bcs_from_residual();
- double global_vdot();
-
- const int neq=E->lmesh.neq;
- const int nel=E->lmesh.nel;
- const int lev=E->mesh.levmax;
-
- get_buoyancy(E,E->buoyancy);
-
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
-
- for(a=0;a<neq;a++)
- E->F[m][a] = 0.0;
-
- for (e=1;e<=nel;e++) {
- get_elt_f(E,e,elt_f,1,m);
- add_force(E, e, elt_f, m);
- }
-
- /* for traction bc */
- for(i=1; i<=E->boundary.nel; i++) {
- e = E->boundary.element[m][i];
-
- for(a=0;a<24;a++) elt_f[a] = 0.0;
- for(a=SIDE_BEGIN; a<=SIDE_END; a++)
- get_elt_tr(E, i, a, elt_f, m);
-
- add_force(E, e, elt_f, m);
- }
- } /* end for m */
-
- (E->solver.exchange_id_d)(E, E->F, lev);
- strip_bcs_from_residual(E,E->F,lev);
-
- /* compute the norm of E->F */
- E->monitor.fdotf = sqrt(global_vdot(E, E->F, E->F, lev));
-
- if(E->parallel.me==0) {
- fprintf(stderr, "Momentum equation force %.9e\n",
- E->monitor.fdotf);
- fprintf(E->fp, "Momentum equation force %.9e\n",
- E->monitor.fdotf);
- }
-
- return;
-}
-
-
-void assemble_forces_pseudo_surf(E,penalty)
- struct All_variables *E;
- int penalty;
-{
- double elt_f[24];
- int m,a,e,i;
-
- void get_buoyancy();
- void get_elt_f();
- void get_elt_tr_pseudo_surf();
- void strip_bcs_from_residual();
-
- const int neq=E->lmesh.neq;
- const int nel=E->lmesh.nel;
- const int lev=E->mesh.levmax;
-
- get_buoyancy(E,E->buoyancy);
-
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
-
- for(a=0;a<neq;a++)
- E->F[m][a] = 0.0;
-
- for (e=1;e<=nel;e++) {
- get_elt_f(E,e,elt_f,1,m);
- add_force(E, e, elt_f, m);
- }
-
- /* for traction bc */
- for(i=1; i<=E->boundary.nel; i++) {
- e = E->boundary.element[m][i];
-
- for(a=0;a<24;a++) elt_f[a] = 0.0;
- for(a=SIDE_BEGIN; a<=SIDE_END; a++)
- get_elt_tr_pseudo_surf(E, i, a, elt_f, m);
-
- add_force(E, e, elt_f, m);
- }
- } /* end for m */
-
- (E->solver.exchange_id_d)(E, E->F, lev);
- strip_bcs_from_residual(E,E->F,lev);
- return;
-}
-
-
-/*==============================================================
- Function to supply the element strain-displacement matrix Ba at velocity
- quadrature points, which is used to compute element stiffness matrix
- ============================================================== */
-
-void get_ba(struct Shape_function *N, struct Shape_function_dx *GNx,
- struct CC *cc, struct CCX *ccx, double rtf[4][9],
- int dims, double ba[9][9][4][7])
-{
- int k, a, n;
- const int vpts = VPOINTS3D;
- const int ends = ENODES3D;
-
- double ra[9], isi[9], ct[9];
- double gnx0, gnx1, gnx2, shp, cc1, cc2, cc3;
-
- for(k=1;k<=vpts;k++) {
- ra[k] = rtf[3][k];
- isi[k] = 1.0 / sin(rtf[1][k]);
- ct[k] = cos(rtf[1][k]) * isi[k];
- }
-
- for(a=1;a<=ends;a++)
- for(k=1;k<=vpts;k++) {
- gnx0 = GNx->vpt[GNVXINDEX(0,a,k)];
- gnx1 = GNx->vpt[GNVXINDEX(1,a,k)];
- gnx2 = GNx->vpt[GNVXINDEX(2,a,k)];
- shp = N->vpt[GNVINDEX(a,k)];
- for(n=1;n<=dims;n++) {
- cc1 = cc->vpt[BVINDEX(1,n,a,k)];
- cc2 = cc->vpt[BVINDEX(2,n,a,k)];
- cc3 = cc->vpt[BVINDEX(3,n,a,k)];
-
- ba[a][k][n][1] = ( gnx0 * cc1
- + shp * ccx->vpt[BVXINDEX(1,n,1,a,k)]
- + shp * cc3 ) * ra[k];
-
- ba[a][k][n][2] = ( shp * cc1 * ct[k]
- + shp * cc3
- + ( gnx1 * cc2
- + shp * ccx->vpt[BVXINDEX(2,n,2,a,k)] )
- * isi[k] ) * ra[k];
-
- ba[a][k][n][3] = gnx2 * cc3;
-
- ba[a][k][n][4] = ( gnx0 * cc2
- + shp * ccx->vpt[BVXINDEX(2,n,1,a,k)]
- - shp * cc2 * ct[k]
- + ( gnx1 * cc1
- + shp * ccx->vpt[BVXINDEX(1,n,2,a,k)] )
- * isi[k] ) * ra[k];
-
- ba[a][k][n][5] = gnx2 * cc1
- + ( gnx0 * cc3
- + shp * ( ccx->vpt[BVXINDEX(3,n,1,a,k)]
- - cc1 ) ) * ra[k];
-
- ba[a][k][n][6] = gnx2 * cc2
- - ra[k] * shp * cc2
- + ( gnx1 * cc3
- + shp * ccx->vpt[BVXINDEX(3,n,2,a,k)] )
- * isi[k] * ra[k];
- }
- }
-
- return;
-}
-
-
-/*==============================================================
- Function to supply the element strain-displacement matrix Ba at pressure
- quadrature points, which is used to compute strain rate
- ============================================================== */
-
-void get_ba_p(struct Shape_function *N, struct Shape_function_dx *GNx,
- struct CC *cc, struct CCX *ccx, double rtf[4][9],
- int dims, double ba[9][9][4][7])
-{
- int k, a, n;
- const int ppts = PPOINTS3D;
- const int ends = ENODES3D;
-
- double ra[9], isi[9], ct[9];
- double gnx0, gnx1, gnx2, shp, cc1, cc2, cc3;
-
- for(k=1;k<=ppts;k++) {
- ra[k] = rtf[3][k];
- isi[k] = 1.0 / sin(rtf[1][k]);
- ct[k] = cos(rtf[1][k]) * isi[k];
- }
-
- for(k=1;k<=ppts;k++)
- for(a=1;a<=ends;a++) {
- gnx0 = GNx->ppt[GNPXINDEX(0,a,k)];
- gnx1 = GNx->ppt[GNPXINDEX(1,a,k)];
- gnx2 = GNx->ppt[GNPXINDEX(2,a,k)];
- shp = N->ppt[GNPINDEX(a,k)];
- for(n=1;n<=dims;n++) {
- cc1 = cc->ppt[BPINDEX(1,n,a,k)];
- cc2 = cc->ppt[BPINDEX(2,n,a,k)];
- cc3 = cc->ppt[BPINDEX(3,n,a,k)];
-
- ba[a][k][n][1] = ( gnx0 * cc1
- + shp * ccx->ppt[BPXINDEX(1,n,1,a,k)]
- + shp * cc3 ) * ra[k];
-
- ba[a][k][n][2] = ( shp * cc1 * ct[k]
- + shp * cc3
- + ( gnx1 * cc2
- + shp * ccx->ppt[BPXINDEX(2,n,2,a,k)] )
- * isi[k] ) * ra[k];
-
- ba[a][k][n][3] = gnx2 * cc3;
-
- ba[a][k][n][4] = ( gnx0 * cc2
- + shp * ccx->ppt[BPXINDEX(2,n,1,a,k)]
- - shp * cc2 * ct[k]
- + ( gnx1 * cc1
- + shp * ccx->ppt[BPXINDEX(1,n,2,a,k)] )
- * isi[k] ) * ra[k];
-
- ba[a][k][n][5] = gnx2 * cc1
- + ( gnx0 * cc3
- + shp * ( ccx->ppt[BPXINDEX(3,n,1,a,k)]
- - cc1 ) ) * ra[k];
-
- ba[a][k][n][6] = gnx2 * cc2
- - ra[k] * shp * cc2
- + ( gnx1 * cc3
- + shp * ccx->ppt[BPXINDEX(3,n,2,a,k)] )
- * isi[k] * ra[k];
- }
- }
- return;
-}
-
-
-
-/*==============================================================
- Function to supply the element k matrix for a given element e.
- ============================================================== */
-
-void get_elt_k(E,el,elt_k,lev,m,iconv)
- struct All_variables *E;
- int el,m;
- double elt_k[24*24];
- int lev, iconv;
-{
- double bdbmu[4][4];
- int pn,qn,ad,bd;
-
- int a,b,i,j,i1,j1,k;
- double rtf[4][9],W[9];
-
- const double two = 2.0;
- const double two_thirds = 2.0/3.0;
-
- void get_rtf_at_vpts();
-
- double ba[9][9][4][7]; /* integration points,node,3x6 matrix */
-
- const int nn=loc_mat_size[E->mesh.nsd];
- const int vpts = VPOINTS3D;
- const int ends = ENODES3D;
- const int dims=E->mesh.nsd;
-
- get_rtf_at_vpts(E, m, lev, el, rtf);
-
- if (iconv || (el-1)%E->lmesh.ELZ[lev]==0)
- construct_c3x3matrix_el(E,el,&E->element_Cc,&E->element_Ccx,lev,m,0);
-
- /* Note N[a].gauss_pt[n] is the value of shape fn a at the nth gaussian
- quadrature point. Nx[d] is the derivative wrt x[d]. */
-
- for(k=1;k<=vpts;k++) {
- W[k]=g_point[k].weight[dims-1]*E->GDA[lev][m][el].vpt[k]*E->EVI[lev][m][(el-1)*vpts+k];
- }
-
- get_ba(&(E->N), &(E->GNX[lev][m][el]), &E->element_Cc, &E->element_Ccx,
- rtf, E->mesh.nsd, ba);
-
- for(a=1;a<=ends;a++)
- for(b=a;b<=ends;b++) {
- bdbmu[1][1]=bdbmu[1][2]=bdbmu[1][3]=
- bdbmu[2][1]=bdbmu[2][2]=bdbmu[2][3]=
- bdbmu[3][1]=bdbmu[3][2]=bdbmu[3][3]=0.0;
-
- for(i=1;i<=dims;i++)
- for(j=1;j<=dims;j++)
- for(k=1;k<=VPOINTS3D;k++)
- bdbmu[i][j] += W[k] * ( two * ( ba[a][k][i][1]*ba[b][k][j][1] +
- ba[a][k][i][2]*ba[b][k][j][2] +
- ba[a][k][i][3]*ba[b][k][j][3] ) +
- ba[a][k][i][4]*ba[b][k][j][4] +
- ba[a][k][i][5]*ba[b][k][j][5] +
- ba[a][k][i][6]*ba[b][k][j][6] );
-
- if(E->control.inv_gruneisen != 0)
- for(i=1;i<=dims;i++)
- for(j=1;j<=dims;j++)
- for(k=1;k<=VPOINTS3D;k++)
- bdbmu[i][j] -= W[k] * two_thirds *
- ( ba[a][k][i][1] + ba[a][k][i][2] + ba[a][k][i][3] ) *
- ( ba[b][k][j][1] + ba[b][k][j][2] + ba[b][k][j][3] );
-
-
- /**/
- ad=dims*(a-1);
- bd=dims*(b-1);
-
- pn=ad*nn+bd;
- qn=bd*nn+ad;
-
- elt_k[pn ] = bdbmu[1][1] ; /* above */
- elt_k[pn+1 ] = bdbmu[1][2] ;
- elt_k[pn+2 ] = bdbmu[1][3] ;
- elt_k[pn+nn ] = bdbmu[2][1] ;
- elt_k[pn+nn+1 ] = bdbmu[2][2] ;
- elt_k[pn+nn+2 ] = bdbmu[2][3] ;
- elt_k[pn+2*nn ] = bdbmu[3][1] ;
- elt_k[pn+2*nn+1] = bdbmu[3][2] ;
- elt_k[pn+2*nn+2] = bdbmu[3][3] ;
-
- elt_k[qn ] = bdbmu[1][1] ; /* below diag */
- elt_k[qn+1 ] = bdbmu[2][1] ;
- elt_k[qn+2 ] = bdbmu[3][1] ;
- elt_k[qn+nn ] = bdbmu[1][2] ;
- elt_k[qn+nn+1 ] = bdbmu[2][2] ;
- elt_k[qn+nn+2 ] = bdbmu[3][2] ;
- elt_k[qn+2*nn ] = bdbmu[1][3] ;
- elt_k[qn+2*nn+1] = bdbmu[2][3] ;
- elt_k[qn+2*nn+2] = bdbmu[3][3] ;
- /**/
-
- } /* Sum over all the a,b's to obtain full elt_k matrix */
-
- return;
-}
-
-
-/* =============================================
- General calling function for del_squared:
- according to whether it should be element by
- element or node by node.
- ============================================= */
-
-void assemble_del2_u(E,u,Au,level,strip_bcs)
- struct All_variables *E;
- double **u,**Au;
- int level;
- int strip_bcs;
-{
- void e_assemble_del2_u();
- void n_assemble_del2_u();
-
- if(E->control.NMULTIGRID||E->control.NASSEMBLE)
- n_assemble_del2_u(E,u,Au,level,strip_bcs);
- else
- e_assemble_del2_u(E,u,Au,level,strip_bcs);
-
- return;
-}
-
-/* ======================================
- Assemble del_squared_u vector el by el
- ====================================== */
-
-void e_assemble_del2_u(E,u,Au,level,strip_bcs)
- struct All_variables *E;
- double **u,**Au;
- int level;
- int strip_bcs;
-
-{
- int e,i,a,b,a1,a2,a3,ii,m,nodeb;
- void strip_bcs_from_residual();
-
- const int n=loc_mat_size[E->mesh.nsd];
- const int ends=enodes[E->mesh.nsd];
- const int dims=E->mesh.nsd;
- const int nel=E->lmesh.NEL[level];
- const int neq=E->lmesh.NEQ[level];
-
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- for(i=0;i<neq;i++)
- Au[m][i] = 0.0;
-
- for(e=1;e<=nel;e++) {
- for(a=1;a<=ends;a++) {
- ii = E->IEN[level][m][e].node[a];
- a1 = E->ID[level][m][ii].doff[1];
- a2 = E->ID[level][m][ii].doff[2];
- a3 = E->ID[level][m][ii].doff[3];
- for(b=1;b<=ends;b++) {
- nodeb = E->IEN[level][m][e].node[b];
- ii = (a*n+b)*dims-(dims*n+dims);
- /* i=1, j=1,2 */
- /* i=1, j=1,2,3 */
- Au[m][a1] +=
- E->elt_k[level][m][e].k[ii] *
- u[m][E->ID[level][m][nodeb].doff[1]]
- + E->elt_k[level][m][e].k[ii+1] *
- u[m][E->ID[level][m][nodeb].doff[2]]
- + E->elt_k[level][m][e].k[ii+2] *
- u[m][E->ID[level][m][nodeb].doff[3]];
- /* i=2, j=1,2,3 */
- Au[m][a2] +=
- E->elt_k[level][m][e].k[ii+n] *
- u[m][E->ID[level][m][nodeb].doff[1]]
- + E->elt_k[level][m][e].k[ii+n+1] *
- u[m][E->ID[level][m][nodeb].doff[2]]
- + E->elt_k[level][m][e].k[ii+n+2] *
- u[m][E->ID[level][m][nodeb].doff[3]];
- /* i=3, j=1,2,3 */
- Au[m][a3] +=
- E->elt_k[level][m][e].k[ii+n+n] *
- u[m][E->ID[level][m][nodeb].doff[1]]
- + E->elt_k[level][m][e].k[ii+n+n+1] *
- u[m][E->ID[level][m][nodeb].doff[2]]
- + E->elt_k[level][m][e].k[ii+n+n+2] *
- u[m][E->ID[level][m][nodeb].doff[3]];
-
- } /* end for loop b */
- } /* end for loop a */
-
- } /* end for e */
- } /* end for m */
-
- (E->solver.exchange_id_d)(E, Au, level);
-
- if(strip_bcs)
- strip_bcs_from_residual(E,Au,level);
-
- return; }
-
-
-/* ======================================================
- Assemble Au using stored, nodal coefficients.
- ====================================================== */
-
-void n_assemble_del2_u(E,u,Au,level,strip_bcs)
- struct All_variables *E;
- double **u,**Au;
- int level;
- int strip_bcs;
-{
- int m, e,i;
- int eqn1,eqn2,eqn3;
-
- double UU,U1,U2,U3;
- void strip_bcs_from_residual();
-
- int *C;
- higher_precision *B1,*B2,*B3;
-
- const int neq=E->lmesh.NEQ[level];
- const int nno=E->lmesh.NNO[level];
- const int dims=E->mesh.nsd;
- const int max_eqn = dims*14;
-
-
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
-
- for(e=0;e<=neq;e++)
- Au[m][e]=0.0;
-
- u[m][neq] = 0.0;
-
- for(e=1;e<=nno;e++) {
-
- eqn1=E->ID[level][m][e].doff[1];
- eqn2=E->ID[level][m][e].doff[2];
- eqn3=E->ID[level][m][e].doff[3];
-
- U1 = u[m][eqn1];
- U2 = u[m][eqn2];
- U3 = u[m][eqn3];
-
- C=E->Node_map[level][m] + (e-1)*max_eqn;
- B1=E->Eqn_k1[level][m]+(e-1)*max_eqn;
- B2=E->Eqn_k2[level][m]+(e-1)*max_eqn;
- B3=E->Eqn_k3[level][m]+(e-1)*max_eqn;
-
- for(i=3;i<max_eqn;i++) {
- UU = u[m][C[i]];
- Au[m][eqn1] += B1[i]*UU;
- Au[m][eqn2] += B2[i]*UU;
- Au[m][eqn3] += B3[i]*UU;
- }
- for(i=0;i<max_eqn;i++)
- Au[m][C[i]] += B1[i]*U1+B2[i]*U2+B3[i]*U3;
-
- } /* end for e */
- } /* end for m */
-
- (E->solver.exchange_id_d)(E, Au, level);
-
- if (strip_bcs)
- strip_bcs_from_residual(E,Au,level);
-
- return;
-}
-
-
-void build_diagonal_of_K(E,el,elt_k,level,m)
- struct All_variables *E;
- int level,el,m;
- double elt_k[24*24];
-
-{
- int a,a1,a2,p,node;
-
- const int n=loc_mat_size[E->mesh.nsd];
- const int dims=E->mesh.nsd;
- const int ends=enodes[E->mesh.nsd];
-
- for(a=1;a<=ends;a++) {
- node=E->IEN[level][m][el].node[a];
- /* dirn 1 */
- a1 = E->ID[level][m][node].doff[1];
- p=(a-1)*dims;
- E->BI[level][m][a1] += elt_k[p*n+p];
-
- /* dirn 2 */
- a2 = E->ID[level][m][node].doff[2];
- p=(a-1)*dims+1;
- E->BI[level][m][a2] += elt_k[p*n+p];
-
- /* dirn 3 */
- a1 = E->ID[level][m][node].doff[3];
- p=(a-1)*dims+2;
- E->BI[level][m][a1] += elt_k[p*n+p];
- }
-
- return;
-}
-
-void build_diagonal_of_Ahat(E)
- struct All_variables *E;
-{
- double assemble_dAhatp_entry();
-
- double BU;
- int m,e,npno,neq,level;
-
- for (level=E->mesh.gridmin;level<=E->mesh.gridmax;level++)
-
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
-
- npno = E->lmesh.NPNO[level];
- neq=E->lmesh.NEQ[level];
-
- for(e=1;e<=npno;e++)
- E->BPI[level][m][e]=1.0;
-
- if(!E->control.precondition)
- return;
-
- for(e=1;e<=npno;e++) {
- BU=assemble_dAhatp_entry(E,e,level,m);
- if(BU != 0.0)
- E->BPI[level][m][e] = 1.0/BU;
- else
- E->BPI[level][m][e] = 1.0;
- }
- }
-
- return;
-}
-
-
-/* =====================================================
- Assemble grad(rho_ref*ez)*V element by element.
- Note that the storage is not zero'd before assembling.
- ===================================================== */
-
-void assemble_c_u(struct All_variables *E,
- double **U, double **result, int level)
-{
- int e,j1,j2,j3,p,a,b,m;
-
- const int nel = E->lmesh.NEL[level];
- const int ends = enodes[E->mesh.nsd];
- const int dims = E->mesh.nsd;
- const int npno = E->lmesh.NPNO[level];
-
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(a=1;a<=ends;a++) {
- p = (a-1)*dims;
- for(e=1;e<=nel;e++) {
- b = E->IEN[level][m][e].node[a];
- j1= E->ID[level][m][b].doff[1];
- j2= E->ID[level][m][b].doff[2];
- j3= E->ID[level][m][b].doff[3];
- result[m][e] += E->elt_c[level][m][e].c[p ][0] * U[m][j1]
- + E->elt_c[level][m][e].c[p+1][0] * U[m][j2]
- + E->elt_c[level][m][e].c[p+2][0] * U[m][j3];
- }
- }
-
- return;
-}
-
-
-
-/* =====================================================
- Assemble div(rho_ref*V) = div(V) + grad(rho_ref*ez)*V
- element by element
- ===================================================== */
-
-void assemble_div_rho_u(struct All_variables *E,
- double **U, double **result, int level)
-{
- void assemble_div_u();
- assemble_div_u(E, U, result, level);
- assemble_c_u(E, U, result, level);
-
- return;
-}
-
-
-/* ==========================================
- Assemble a div_u vector element by element
- ========================================== */
-
-void assemble_div_u(struct All_variables *E,
- double **U, double **divU, int level)
-{
- int e,j1,j2,j3,p,a,b,m;
-
- const int nel=E->lmesh.NEL[level];
- const int ends=enodes[E->mesh.nsd];
- const int dims=E->mesh.nsd;
- const int npno=E->lmesh.NPNO[level];
-
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(e=1;e<=npno;e++)
- divU[m][e] = 0.0;
-
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(a=1;a<=ends;a++) {
- p = (a-1)*dims;
- for(e=1;e<=nel;e++) {
- b = E->IEN[level][m][e].node[a];
- j1= E->ID[level][m][b].doff[1];
- j2= E->ID[level][m][b].doff[2];
- j3= E->ID[level][m][b].doff[3];
- divU[m][e] += E->elt_del[level][m][e].g[p ][0] * U[m][j1]
- + E->elt_del[level][m][e].g[p+1][0] * U[m][j2]
- + E->elt_del[level][m][e].g[p+2][0] * U[m][j3];
- }
- }
-
- return;
-}
-
-
-/* ==========================================
- Assemble a grad_P vector element by element
- ========================================== */
-
-void assemble_grad_p(E,P,gradP,lev)
- struct All_variables *E;
- double **P,**gradP;
- int lev;
-
-{
- int m,e,i,j1,j2,j3,p,a,b,nel,neq;
- void strip_bcs_from_residual();
-
- const int ends=enodes[E->mesh.nsd];
- const int dims=E->mesh.nsd;
-
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
-
- nel=E->lmesh.NEL[lev];
- neq=E->lmesh.NEQ[lev];
-
- for(i=0;i<neq;i++)
- gradP[m][i] = 0.0;
-
- for(e=1;e<=nel;e++) {
-
- if(0.0==P[m][e])
- continue;
-
- for(a=1;a<=ends;a++) {
- p = (a-1)*dims;
- b = E->IEN[lev][m][e].node[a];
- j1= E->ID[lev][m][b].doff[1];
- j2= E->ID[lev][m][b].doff[2];
- j3= E->ID[lev][m][b].doff[3];
- /*for(b=0;b<ploc_mat_size[E->mesh.nsd];b++) */
- gradP[m][j1] += E->elt_del[lev][m][e].g[p ][0] * P[m][e];
- gradP[m][j2] += E->elt_del[lev][m][e].g[p+1][0] * P[m][e];
- gradP[m][j3] += E->elt_del[lev][m][e].g[p+2][0] * P[m][e];
- }
- } /* end for el */
- } /* end for m */
-
- (E->solver.exchange_id_d)(E, gradP, lev); /* correct gradP */
-
-
- strip_bcs_from_residual(E,gradP,lev);
-
-return;
-}
-
-
-double assemble_dAhatp_entry(E,e,level,m)
- struct All_variables *E;
- int e,level,m;
-
-{
- int i,j,p,a,b,node,npno;
- void strip_bcs_from_residual();
-
- double gradP[81],divU;
-
- const int ends=enodes[E->mesh.nsd];
- const int dims=E->mesh.nsd;
-
- npno=E->lmesh.NPNO[level];
-
- for(i=0;i<81;i++)
- gradP[i] = 0.0;
-
- divU=0.0;
-
- for(a=1;a<=ends;a++) {
- p = (a-1)*dims;
- node = E->IEN[level][m][e].node[a];
- j=E->ID[level][m][node].doff[1];
- gradP[p] += E->BI[level][m][j]*E->elt_del[level][m][e].g[p][0];
-
- j=E->ID[level][m][node].doff[2];
- gradP[p+1] += E->BI[level][m][j]*E->elt_del[level][m][e].g[p+1][0];
-
- j=E->ID[level][m][node].doff[3];
- gradP[p+2] += E->BI[level][m][j]*E->elt_del[level][m][e].g[p+2][0];
- }
-
-
- /* calculate div U from the same thing .... */
-
- /* only need to run over nodes with non-zero grad P, i.e. the ones in
- the element accessed above, BUT it is only necessary to update the
- value in the original element, because the diagonal is all we use at
- the end ... */
-
- for(b=1;b<=ends;b++) {
- p = (b-1)*dims;
- divU +=E->elt_del[level][m][e].g[p][0] * gradP[p];
- divU +=E->elt_del[level][m][e].g[p+1][0] * gradP[p+1];
- divU +=E->elt_del[level][m][e].g[p+2][0] * gradP[p+2];
- }
-
-return(divU); }
-
-
-/*==============================================================
- Function to supply the element c matrix for a given element e.
- ============================================================== */
-
-void get_elt_c(struct All_variables *E, int el,
- higher_precision elt_c[24][1], int lev, int m)
-{
-
- int p, a, i, j, nz;
- double temp, beta, rho_avg, x[4];
-
- double rho[9];
-
- const int dims = E->mesh.nsd;
- const int ends = enodes[dims];
-
- if ((el-1)%E->lmesh.ELZ[lev]==0)
- construct_c3x3matrix_el(E,el,&E->element_Cc,&E->element_Ccx,lev,m,1);
-
- temp = p_point[1].weight[dims-1] * E->GDA[lev][m][el].ppt[1];
-
- switch (E->refstate.choice) {
- case 1:
- /* the reference state is computed by rho=exp((1-r)Di/gamma) */
- /* so d(rho)/dr/rho == -Di/gamma */
-
- beta = - E->control.disptn_number * E->control.inv_gruneisen;
-
- for(a=1;a<=ends;a++) {
- for (i=1;i<=dims;i++) {
- x[i] = E->N.ppt[GNPINDEX(a,1)]
- * E->element_Cc.ppt[BPINDEX(3,i,a,1)];
- }
- p=dims*(a-1);
- elt_c[p ][0] = -x[1] * temp * beta;
- elt_c[p+1][0] = -x[2] * temp * beta;
- elt_c[p+2][0] = -x[3] * temp * beta;
- }
- break;
- default:
- /* compute d(rho)/dr/rho from rho(r) */
-
- for(a=1;a<=ends;a++) {
- j = E->IEN[lev][m][el].node[a];
- nz = (j - 1) % E->lmesh.noz + 1;
- rho[a] = E->refstate.rho[nz];
- }
-
- rho_avg = 0;
- for(a=1;a<=ends;a++) {
- rho_avg += rho[a];
- }
- rho_avg /= ends;
-
- for(a=1;a<=ends;a++) {
- for (i=1;i<=dims;i++) {
- x[i] = rho[a] * E->GNX[lev][m][el].ppt[GNPXINDEX(2,a,1)]
- * E->N.ppt[GNPINDEX(a,1)]
- * E->element_Cc.ppt[BPINDEX(3,i,a,1)];
- }
- p=dims*(a-1);
- elt_c[p ][0] = -x[1] * temp / rho_avg;
- elt_c[p+1][0] = -x[2] * temp / rho_avg;
- elt_c[p+2][0] = -x[3] * temp / rho_avg;
- }
-
- }
-
- return;
-}
-
-
-/*==============================================================
- Function to supply the element g matrix for a given element e.
- ============================================================== */
-
-void get_elt_g(E,el,elt_del,lev,m)
- struct All_variables *E;
- int el,m;
- higher_precision elt_del[24][1];
- int lev;
-
-{
- void get_rtf_at_ppts();
- int p,a,i;
- double ra,ct,si,x[4],rtf[4][9];
- double temp;
-
- const int dims=E->mesh.nsd;
- const int ends=enodes[dims];
-
- /* Special case, 4/8 node bilinear cartesian square/cube element -> 1 pressure point */
-
- if ((el-1)%E->lmesh.ELZ[lev]==0)
- construct_c3x3matrix_el(E,el,&E->element_Cc,&E->element_Ccx,lev,m,1);
-
- get_rtf_at_ppts(E, m, lev, el, rtf);
-
- temp=p_point[1].weight[dims-1] * E->GDA[lev][m][el].ppt[1];
-
- ra = rtf[3][1];
- si = 1.0/sin(rtf[1][1]);
- ct = cos(rtf[1][1])*si;
-
- for(a=1;a<=ends;a++) {
- for (i=1;i<=dims;i++)
- x[i]=E->GNX[lev][m][el].ppt[GNPXINDEX(2,a,1)]*E->element_Cc.ppt[BPINDEX(3,i,a,1)]
- + 2.0*ra*E->N.ppt[GNPINDEX(a,1)]*E->element_Cc.ppt[BPINDEX(3,i,a,1)]
- + ra*(E->GNX[lev][m][el].ppt[GNPXINDEX(0,a,1)]*E->element_Cc.ppt[BPINDEX(1,i,a,1)]
- +E->N.ppt[GNPINDEX(a,1)]*E->element_Ccx.ppt[BPXINDEX(1,i,1,a,1)]
- +ct*E->N.ppt[GNPINDEX(a,1)]*E->element_Cc.ppt[BPINDEX(1,i,a,1)]
- +si*(E->GNX[lev][m][el].ppt[GNPXINDEX(1,a,1)]*E->element_Cc.ppt[BPINDEX(2,i,a,1)]
- +E->N.ppt[GNPINDEX(a,1)]*E->element_Ccx.ppt[BPXINDEX(2,i,2,a,1)]));
-
- p=dims*(a-1);
- elt_del[p ][0] = -x[1] * temp;
- elt_del[p+1][0] = -x[2] * temp;
- elt_del[p+2][0] = -x[3] * temp;
-
- /* fprintf (E->fp,"B= %d %d %g %g %g %g %g\n",el,a,E->GDA[lev][m][el].ppt[1],E->GNX[lev][m][el].ppt[GNPXINDEX(0,a,1)],E->GNX[lev][m][el].ppt[GNPXINDEX(1,a,1)],elt_del[p][0],elt_del[p+1][0]);
- */
- }
-
- return;
- }
-
-/*=================================================================
- Function to create the element force vector (allowing for velocity b.c.'s)
- ================================================================= */
-
-void get_elt_f(E,el,elt_f,bcs,m)
- struct All_variables *E;
- int el,m;
- double elt_f[24];
- int bcs;
-
-{
-
- int i,p,a,b,j,k,q,es;
- int got_elt_k,nodea,nodeb;
- unsigned int type;
- const unsigned int vbc_flag[] = {0, VBX, VBY, VBZ};
-
- double force[9],force_at_gs[9],elt_k[24*24];
-
-
- const int dims=E->mesh.nsd;
- const int n=loc_mat_size[dims];
- const int ends=enodes[dims];
- const int vpts=vpoints[dims];
-
- es = (el-1)/E->lmesh.elz + 1;
-
- if ((el-1)%E->lmesh.elz==0)
- construct_c3x3matrix_el(E,el,&E->element_Cc,&E->element_Ccx,E->mesh.levmax,m,0);
-
- for(p=0;p<n;p++) elt_f[p] = 0.0;
-
- for(p=1;p<=ends;p++)
- force[p] = E->buoyancy[m][E->ien[m][el].node[p]];
-
- for(j=1;j<=vpts;j++) { /*compute force at each int point */
- force_at_gs[j] = 0.0;
- for(k=1;k<=ends;k++)
- force_at_gs[j] += force[k] * E->N.vpt[GNVINDEX(k,j)] ;
- }
-
- for(i=1;i<=dims;i++) {
- for(a=1;a<=ends;a++) {
- nodea=E->ien[m][el].node[a];
- p= dims*(a-1)+i-1;
-
- for(j=1;j<=vpts;j++) /*compute sum(Na(j)*F(j)*det(j)) */
- elt_f[p] += force_at_gs[j] * E->N.vpt[GNVINDEX(a,j)]
- *E->gDA[m][el].vpt[j]*g_point[j].weight[dims-1]
- *E->element_Cc.vpt[BVINDEX(3,i,a,j)];
-
- /* imposed velocity terms */
-
- if(bcs) {
- got_elt_k = 0;
- for(j=1;j<=dims;j++) {
- type=vbc_flag[j];
- for(b=1;b<=ends;b++) {
- nodeb=E->ien[m][el].node[b];
- if ((E->node[m][nodeb]&type)&&(E->sphere.cap[m].VB[j][nodeb]!=0.0)){
- if(!got_elt_k) {
- get_elt_k(E,el,elt_k,E->mesh.levmax,m,1);
- got_elt_k = 1;
- }
- q = dims*(b-1)+j-1;
- if(p!=q) {
- elt_f[p] -= elt_k[p*n+q] * E->sphere.cap[m].VB[j][nodeb];
- }
- }
- } /* end for b */
- } /* end for j */
- } /* end if for if bcs */
-
- }
- } /* Complete the loops for a,i */
-
-
-
- return;
-}
-
-
-/*=================================================================
- Function to create the element force vector due to stress b.c.
- ================================================================= */
-
-void get_elt_tr(struct All_variables *E, int bel, int side, double elt_tr[24], int m)
-{
-
- const int dims=E->mesh.nsd;
- const int ends1=enodes[dims-1];
- const int oned = onedvpoints[dims];
-
- struct CC Cc;
- struct CCX Ccx;
-
- const unsigned sbc_flag[4] = {0,SBX,SBY,SBZ};
-
- double traction[4][5],traction_at_gs[4][5], value, tmp;
- int j, b, p, k, a, nodea, d;
- int el = E->boundary.element[m][bel];
- int flagged;
- int found = 0;
-
- const float rho = E->data.density;
- const float g = E->data.grav_acc;
- const float R = 6371000.0;
- const float eta = E->data.ref_viscosity;
- const float kappa = E->data.therm_diff;
- const float factor = 1.0e+00;
- int nodeas;
-
- if(E->control.side_sbcs)
- for(a=1;a<=ends1;a++) {
- nodea = E->ien[m][el].node[ sidenodes[side][a] ];
- for(d=1;d<=dims;d++) {
- value = E->sbc.SB[m][side][d][ E->sbc.node[m][nodea] ];
- flagged = (E->node[m][nodea] & sbc_flag[d]) && (value);
- found |= flagged;
- traction[d][a] = ( flagged ? value : 0.0 );
- }
- }
- else {
- /* if side_sbcs is false, only apply sbc on top and bottom surfaces */
- if(side == SIDE_BOTTOM || side == SIDE_TOP) {
- for(a=1;a<=ends1;a++) {
- nodea = E->ien[m][el].node[ sidenodes[side][a] ];
- for(d=1;d<=dims;d++) {
- value = E->sphere.cap[m].VB[d][nodea];
- flagged = (E->node[m][nodea] & sbc_flag[d]) && (value);
- found |= flagged;
- traction[d][a] = ( flagged ? value : 0.0 );
- }
- }
- }
- }
-
- /* skip the following computation if no sbc_flag is set
- or value of sbcs are zero */
- if(!found) return;
-
- /* compute traction at each int point */
- construct_side_c3x3matrix_el(E,el,&Cc,&Ccx,
- E->mesh.levmax,m,0,side);
-
- for(k=1;k<=oned;k++)
- for(d=1;d<=dims;d++) {
- traction_at_gs[d][k] = 0.0;
- for(j=1;j<=ends1;j++)
- traction_at_gs[d][k] += traction[d][j] * E->M.vpt[GMVINDEX(j,k)] ;
- }
-
- for(j=1;j<=ends1;j++) {
- a = sidenodes[side][j];
- for(d=1;d<=dims;d++) {
- p = dims*(a-1)+d-1;
- for(k=1;k<=oned;k++) {
- tmp = 0.0;
- for(b=1;b<=dims;b++)
- tmp += traction_at_gs[b][k] * Cc.vpt[BVINDEX(b,d,a,k)];
-
- elt_tr[p] += tmp * E->M.vpt[GMVINDEX(j,k)]
- * E->boundary.det[m][side][k][bel] * g_1d[k].weight[dims-1];
-
- }
- }
- }
-}
-
-void get_elt_tr_pseudo_surf(struct All_variables *E, int bel, int side, double elt_tr[24], int m)
-{
-
- const int dims=E->mesh.nsd;
- const int ends1=enodes[dims-1];
- const int oned = onedvpoints[dims];
-
- struct CC Cc;
- struct CCX Ccx;
-
- const unsigned sbc_flag[4] = {0,SBX,SBY,SBZ};
-
- double traction[4][5],traction_at_gs[4][5], value, tmp;
- int j, b, p, k, a, nodea, d;
- int el = E->boundary.element[m][bel];
- int flagged;
- int found = 0;
-
- const float rho = E->data.density;
- const float g = E->data.grav_acc;
- const float R = 6371000.0;
- const float eta = E->data.ref_viscosity;
- const float kappa = E->data.therm_diff;
- const float factor = 1.0e+00;
- int nodeas;
-
- if(E->control.side_sbcs)
- for(a=1;a<=ends1;a++) {
- nodea = E->ien[m][el].node[ sidenodes[side][a] ];
- for(d=1;d<=dims;d++) {
- value = E->sbc.SB[m][side][d][ E->sbc.node[m][nodea] ];
- flagged = (E->node[m][nodea] & sbc_flag[d]) && (value);
- found |= flagged;
- traction[d][a] = ( flagged ? value : 0.0 );
- }
- }
- else {
- if( side == SIDE_TOP && E->parallel.me_loc[3]==E->parallel.nprocz-1 && (el%E->lmesh.elz==0)) {
- for(a=1;a<=ends1;a++) {
- nodea = E->ien[m][el].node[ sidenodes[side][a] ];
- nodeas = E->ien[m][el].node[ sidenodes[side][a] ]/E->lmesh.noz;
- traction[1][a] = 0.0;
- traction[2][a] = 0.0;
- traction[3][a] = -1.0*factor*rho*g*(R*R*R)/(eta*kappa)
- *(E->slice.freesurf[m][nodeas]+E->sphere.cap[m].V[3][nodea]*E->advection.timestep);
- if(E->parallel.me==11 && nodea==3328)
- fprintf(stderr,"traction=%e vnew=%e timestep=%e coeff=%e\n",traction[3][a],E->sphere.cap[m].V[3][nodea],E->advection.timestep,-1.0*factor*rho*g*(R*R*R)/(eta*kappa));
- found = 1;
-#if 0
- if(found && E->parallel.me==1)
- fprintf(stderr,"me=%d bel=%d el=%d side=%d TOP=%d a=%d sidenodes=%d ien=%d noz=%d nodea=%d traction=%e %e %e\n",
- E->parallel.me,bel,el,side,SIDE_TOP,a,sidenodes[side][a],
- E->ien[m][el].node[ sidenodes[side][a] ],E->lmesh.noz,
- nodea,traction[1][a],traction[2][a],traction[3][a]);
-
-#endif
- }
- }
- else {
- for(a=1;a<=ends1;a++) {
- nodea = E->ien[m][el].node[ sidenodes[side][a] ];
- for(d=1;d<=dims;d++) {
- value = E->sphere.cap[m].VB[d][nodea];
- flagged = (E->node[m][nodea] & sbc_flag[d]) && (value);
- found |= flagged;
- traction[d][a] = ( flagged ? value : 0.0 );
- }
- }
- }
- }
-
- /* skip the following computation if no sbc_flag is set
- or value of sbcs are zero */
- if(!found) return;
-
- /* compute traction at each int point */
- construct_side_c3x3matrix_el(E,el,&Cc,&Ccx,
- E->mesh.levmax,m,0,side);
-
- for(k=1;k<=oned;k++)
- for(d=1;d<=dims;d++) {
- traction_at_gs[d][k] = 0.0;
- for(j=1;j<=ends1;j++)
- traction_at_gs[d][k] += traction[d][j] * E->M.vpt[GMVINDEX(j,k)] ;
- }
-
- for(j=1;j<=ends1;j++) {
- a = sidenodes[side][j];
- for(d=1;d<=dims;d++) {
- p = dims*(a-1)+d-1;
- for(k=1;k<=oned;k++) {
- tmp = 0.0;
- for(b=1;b<=dims;b++)
- tmp += traction_at_gs[b][k] * Cc.vpt[BVINDEX(b,d,a,k)];
-
- elt_tr[p] += tmp * E->M.vpt[GMVINDEX(j,k)]
- * E->boundary.det[m][side][k][bel] * g_1d[k].weight[dims-1];
-
- }
- }
- }
-}
-
-
-/* =================================================================
- subroutine to get augmented lagrange part of stiffness matrix
-================================================================== */
-
-void get_aug_k(E,el,elt_k,level,m)
- struct All_variables *E;
- int el,m;
- double elt_k[24*24];
- int level;
-{
- int i,p[9],a,b,nodea,nodeb;
- double Visc;
-
- const int n=loc_mat_size[E->mesh.nsd];
- const int ends=enodes[E->mesh.nsd];
- const int vpts=vpoints[E->mesh.nsd];
- const int dims=E->mesh.nsd;
-
- Visc = 0.0;
- for(a=1;a<=vpts;a++) {
- p[a] = (a-1)*dims;
- Visc += E->EVI[level][m][(el-1)*vpts+a];
- }
- Visc = Visc/vpts;
-
- for(a=1;a<=ends;a++) {
- nodea=E->IEN[level][m][el].node[a];
- for(b=1;b<=ends;b++) {
- nodeb=E->IEN[level][m][el].node[b]; /* for Kab dims*dims */
- i = (a-1)*n*dims+(b-1)*dims;
- elt_k[i ] += Visc*E->control.augmented*
- E->elt_del[level][m][el].g[p[a]][0]*
- E->elt_del[level][m][el].g[p[b]][0]; /*for 11 */
- elt_k[i+1] += Visc*E->control.augmented*
- E->elt_del[level][m][el].g[p[a]][0]*
- E->elt_del[level][m][el].g[p[b]+1][0]; /* for 12 */
- elt_k[i+n] += Visc*E->control.augmented*
- E->elt_del[level][m][el].g[p[a]+1][0]*
- E->elt_del[level][m][el].g[p[b]][0]; /* for 21 */
- elt_k[i+n+1] += Visc*E->control.augmented*
- E->elt_del[level][m][el].g[p[a]+1][0]*
- E->elt_del[level][m][el].g[p[b]+1][0]; /* for 22 */
-
- if(3==dims) {
- elt_k[i+2] += Visc*E->control.augmented*
- E->elt_del[level][m][el].g[p[a]][0]*
- E->elt_del[level][m][el].g[p[b]+2][0]; /* for 13 */
- elt_k[i+n+2] += Visc*E->control.augmented*
- E->elt_del[level][m][el].g[p[a]+1][0]*
- E->elt_del[level][m][el].g[p[b]+2][0]; /* for 23 */
- elt_k[i+n+n] += Visc*E->control.augmented*
- E->elt_del[level][m][el].g[p[a]+2][0]*
- E->elt_del[level][m][el].g[p[b]][0]; /* for 31 */
- elt_k[i+n+n+1] += Visc*E->control.augmented*
- E->elt_del[level][m][el].g[p[a]+2][0]*
- E->elt_del[level][m][el].g[p[b]+1][0]; /* for 32 */
- elt_k[i+n+n+2] += Visc*E->control.augmented*
- E->elt_del[level][m][el].g[p[a]+2][0]*
- E->elt_del[level][m][el].g[p[b]+2][0]; /* for 33 */
- }
- }
- }
-
- return;
- }
-
-
-/* version */
-/* $Id$ */
-
-/* End of file */
Copied: mc/3D/CitcomS/branches/cxx/lib/Element_calculations.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Element_calculations.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Element_calculations.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Element_calculations.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,1294 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+/* Functions to assemble the element k matrices and the element f vector.
+ Note that for the regular grid case the calculation of k becomes repetitive
+ to the point of redundancy. */
+
+#include <math.h>
+#include "element_definitions.h"
+#include "global_defs.h"
+#include "material_properties.h"
+
+#include "cproto.h"
+
+
+/* else, PGI would complain */
+void construct_side_c3x3matrix_el(struct All_variables *,int ,
+ struct CC *,struct CCX *,
+ int ,int ,int ,int );
+void construct_c3x3matrix(struct All_variables *);
+void construct_c3x3matrix_el (struct All_variables *,int ,struct CC *,
+ struct CCX *,int ,int ,int );
+void assemble_div_u(struct All_variables *,
+ double **, double **, int );
+void get_elt_tr(struct All_variables *, int , int , double [24], int );
+void get_elt_tr_pseudo_surf(struct All_variables *, int , int , double [24], int );
+
+
+void add_force(struct All_variables *E, int e, double elt_f[24], int m)
+{
+ const int dims=E->mesh.nsd;
+ const int ends=enodes[E->mesh.nsd];
+ int a, a1, a2, a3, p, node;
+
+ for(a=1;a<=ends;a++) {
+ node = E->ien[m][e].node[a];
+ p=(a-1)*dims;
+ a1=E->id[m][node].doff[1];
+ E->F[m][a1] += elt_f[p];
+ a2=E->id[m][node].doff[2];
+ E->F[m][a2] += elt_f[p+1];
+ a3=E->id[m][node].doff[3];
+ E->F[m][a3] += elt_f[p+2];
+ }
+}
+
+
+
+/* ================================================================
+ Function to assemble the global F vector.
+ +
+ Function to get the global H vector (mixed method driving terms)
+ ================================================================ */
+
+void assemble_forces(struct All_variables *E, int penalty)
+{
+ double elt_f[24];
+ int m,a,e,i;
+
+ const int neq=E->lmesh.neq;
+ const int nel=E->lmesh.nel;
+ const int lev=E->mesh.levmax;
+
+ get_buoyancy(E,E->buoyancy);
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+
+ for(a=0;a<neq;a++)
+ E->F[m][a] = 0.0;
+
+ for (e=1;e<=nel;e++) {
+ get_elt_f(E,e,elt_f,1,m);
+ add_force(E, e, elt_f, m);
+ }
+
+ /* for traction bc */
+ for(i=1; i<=E->boundary.nel; i++) {
+ e = E->boundary.element[m][i];
+
+ for(a=0;a<24;a++) elt_f[a] = 0.0;
+ for(a=SIDE_BEGIN; a<=SIDE_END; a++)
+ get_elt_tr(E, i, a, elt_f, m);
+
+ add_force(E, e, elt_f, m);
+ }
+ } /* end for m */
+
+ (E->solver.exchange_id_d)(E, E->F, lev);
+ strip_bcs_from_residual(E,E->F,lev);
+
+ /* compute the norm of E->F */
+ E->monitor.fdotf = sqrt(global_vdot(E, E->F, E->F, lev));
+
+ if(E->parallel.me==0) {
+ fprintf(stderr, "Momentum equation force %.9e\n",
+ E->monitor.fdotf);
+ fprintf(E->fp, "Momentum equation force %.9e\n",
+ E->monitor.fdotf);
+ }
+
+ return;
+}
+
+
+void assemble_forces_pseudo_surf(struct All_variables *E, int penalty)
+{
+ double elt_f[24];
+ int m,a,e,i;
+
+ const int neq=E->lmesh.neq;
+ const int nel=E->lmesh.nel;
+ const int lev=E->mesh.levmax;
+
+ get_buoyancy(E,E->buoyancy);
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+
+ for(a=0;a<neq;a++)
+ E->F[m][a] = 0.0;
+
+ for (e=1;e<=nel;e++) {
+ get_elt_f(E,e,elt_f,1,m);
+ add_force(E, e, elt_f, m);
+ }
+
+ /* for traction bc */
+ for(i=1; i<=E->boundary.nel; i++) {
+ e = E->boundary.element[m][i];
+
+ for(a=0;a<24;a++) elt_f[a] = 0.0;
+ for(a=SIDE_BEGIN; a<=SIDE_END; a++)
+ get_elt_tr_pseudo_surf(E, i, a, elt_f, m);
+
+ add_force(E, e, elt_f, m);
+ }
+ } /* end for m */
+
+ (E->solver.exchange_id_d)(E, E->F, lev);
+ strip_bcs_from_residual(E,E->F,lev);
+ return;
+}
+
+
+/*==============================================================
+ Function to supply the element strain-displacement matrix Ba at velocity
+ quadrature points, which is used to compute element stiffness matrix
+ ============================================================== */
+
+void get_ba(struct Shape_function *N, struct Shape_function_dx *GNx,
+ struct CC *cc, struct CCX *ccx, double rtf[4][9],
+ int dims, double ba[9][9][4][7])
+{
+ int k, a, n;
+ const int vpts = VPOINTS3D;
+ const int ends = ENODES3D;
+
+ double ra[9], isi[9], ct[9];
+ double gnx0, gnx1, gnx2, shp, cc1, cc2, cc3;
+
+ for(k=1;k<=vpts;k++) {
+ ra[k] = rtf[3][k];
+ isi[k] = 1.0 / sin(rtf[1][k]);
+ ct[k] = cos(rtf[1][k]) * isi[k];
+ }
+
+ for(a=1;a<=ends;a++)
+ for(k=1;k<=vpts;k++) {
+ gnx0 = GNx->vpt[GNVXINDEX(0,a,k)];
+ gnx1 = GNx->vpt[GNVXINDEX(1,a,k)];
+ gnx2 = GNx->vpt[GNVXINDEX(2,a,k)];
+ shp = N->vpt[GNVINDEX(a,k)];
+ for(n=1;n<=dims;n++) {
+ cc1 = cc->vpt[BVINDEX(1,n,a,k)];
+ cc2 = cc->vpt[BVINDEX(2,n,a,k)];
+ cc3 = cc->vpt[BVINDEX(3,n,a,k)];
+
+ ba[a][k][n][1] = ( gnx0 * cc1
+ + shp * ccx->vpt[BVXINDEX(1,n,1,a,k)]
+ + shp * cc3 ) * ra[k];
+
+ ba[a][k][n][2] = ( shp * cc1 * ct[k]
+ + shp * cc3
+ + ( gnx1 * cc2
+ + shp * ccx->vpt[BVXINDEX(2,n,2,a,k)] )
+ * isi[k] ) * ra[k];
+
+ ba[a][k][n][3] = gnx2 * cc3;
+
+ ba[a][k][n][4] = ( gnx0 * cc2
+ + shp * ccx->vpt[BVXINDEX(2,n,1,a,k)]
+ - shp * cc2 * ct[k]
+ + ( gnx1 * cc1
+ + shp * ccx->vpt[BVXINDEX(1,n,2,a,k)] )
+ * isi[k] ) * ra[k];
+
+ ba[a][k][n][5] = gnx2 * cc1
+ + ( gnx0 * cc3
+ + shp * ( ccx->vpt[BVXINDEX(3,n,1,a,k)]
+ - cc1 ) ) * ra[k];
+
+ ba[a][k][n][6] = gnx2 * cc2
+ - ra[k] * shp * cc2
+ + ( gnx1 * cc3
+ + shp * ccx->vpt[BVXINDEX(3,n,2,a,k)] )
+ * isi[k] * ra[k];
+ }
+ }
+
+ return;
+}
+
+
+/*==============================================================
+ Function to supply the element strain-displacement matrix Ba at pressure
+ quadrature points, which is used to compute strain rate
+ ============================================================== */
+
+void get_ba_p(struct Shape_function *N, struct Shape_function_dx *GNx,
+ struct CC *cc, struct CCX *ccx, double rtf[4][9],
+ int dims, double ba[9][9][4][7])
+{
+ int k, a, n;
+ const int ppts = PPOINTS3D;
+ const int ends = ENODES3D;
+
+ double ra[9], isi[9], ct[9];
+ double gnx0, gnx1, gnx2, shp, cc1, cc2, cc3;
+
+ for(k=1;k<=ppts;k++) {
+ ra[k] = rtf[3][k];
+ isi[k] = 1.0 / sin(rtf[1][k]);
+ ct[k] = cos(rtf[1][k]) * isi[k];
+ }
+
+ for(k=1;k<=ppts;k++)
+ for(a=1;a<=ends;a++) {
+ gnx0 = GNx->ppt[GNPXINDEX(0,a,k)];
+ gnx1 = GNx->ppt[GNPXINDEX(1,a,k)];
+ gnx2 = GNx->ppt[GNPXINDEX(2,a,k)];
+ shp = N->ppt[GNPINDEX(a,k)];
+ for(n=1;n<=dims;n++) {
+ cc1 = cc->ppt[BPINDEX(1,n,a,k)];
+ cc2 = cc->ppt[BPINDEX(2,n,a,k)];
+ cc3 = cc->ppt[BPINDEX(3,n,a,k)];
+
+ ba[a][k][n][1] = ( gnx0 * cc1
+ + shp * ccx->ppt[BPXINDEX(1,n,1,a,k)]
+ + shp * cc3 ) * ra[k];
+
+ ba[a][k][n][2] = ( shp * cc1 * ct[k]
+ + shp * cc3
+ + ( gnx1 * cc2
+ + shp * ccx->ppt[BPXINDEX(2,n,2,a,k)] )
+ * isi[k] ) * ra[k];
+
+ ba[a][k][n][3] = gnx2 * cc3;
+
+ ba[a][k][n][4] = ( gnx0 * cc2
+ + shp * ccx->ppt[BPXINDEX(2,n,1,a,k)]
+ - shp * cc2 * ct[k]
+ + ( gnx1 * cc1
+ + shp * ccx->ppt[BPXINDEX(1,n,2,a,k)] )
+ * isi[k] ) * ra[k];
+
+ ba[a][k][n][5] = gnx2 * cc1
+ + ( gnx0 * cc3
+ + shp * ( ccx->ppt[BPXINDEX(3,n,1,a,k)]
+ - cc1 ) ) * ra[k];
+
+ ba[a][k][n][6] = gnx2 * cc2
+ - ra[k] * shp * cc2
+ + ( gnx1 * cc3
+ + shp * ccx->ppt[BPXINDEX(3,n,2,a,k)] )
+ * isi[k] * ra[k];
+ }
+ }
+ return;
+}
+
+
+
+/*==============================================================
+ Function to supply the element k matrix for a given element e.
+ ============================================================== */
+
+void get_elt_k(
+ struct All_variables *E,
+ int el,
+ double elt_k[24*24],
+ int lev, int m, int iconv
+ )
+{
+ double bdbmu[4][4];
+ int pn,qn,ad,bd;
+
+ int a,b,i,j,i1,j1,k;
+ double rtf[4][9],W[9];
+
+ const double two = 2.0;
+ const double two_thirds = 2.0/3.0;
+
+ void get_rtf_at_vpts();
+
+ double ba[9][9][4][7]; /* integration points,node,3x6 matrix */
+
+ const int nn=loc_mat_size[E->mesh.nsd];
+ const int vpts = VPOINTS3D;
+ const int ends = ENODES3D;
+ const int dims=E->mesh.nsd;
+
+ get_rtf_at_vpts(E, m, lev, el, rtf);
+
+ if (iconv || (el-1)%E->lmesh.ELZ[lev]==0)
+ construct_c3x3matrix_el(E,el,&E->element_Cc,&E->element_Ccx,lev,m,0);
+
+ /* Note N[a].gauss_pt[n] is the value of shape fn a at the nth gaussian
+ quadrature point. Nx[d] is the derivative wrt x[d]. */
+
+ for(k=1;k<=vpts;k++) {
+ W[k]=g_point[k].weight[dims-1]*E->GDA[lev][m][el].vpt[k]*E->EVI[lev][m][(el-1)*vpts+k];
+ }
+
+ get_ba(&(E->N), &(E->GNX[lev][m][el]), &E->element_Cc, &E->element_Ccx,
+ rtf, E->mesh.nsd, ba);
+
+ for(a=1;a<=ends;a++)
+ for(b=a;b<=ends;b++) {
+ bdbmu[1][1]=bdbmu[1][2]=bdbmu[1][3]=
+ bdbmu[2][1]=bdbmu[2][2]=bdbmu[2][3]=
+ bdbmu[3][1]=bdbmu[3][2]=bdbmu[3][3]=0.0;
+
+ for(i=1;i<=dims;i++)
+ for(j=1;j<=dims;j++)
+ for(k=1;k<=VPOINTS3D;k++)
+ bdbmu[i][j] += W[k] * ( two * ( ba[a][k][i][1]*ba[b][k][j][1] +
+ ba[a][k][i][2]*ba[b][k][j][2] +
+ ba[a][k][i][3]*ba[b][k][j][3] ) +
+ ba[a][k][i][4]*ba[b][k][j][4] +
+ ba[a][k][i][5]*ba[b][k][j][5] +
+ ba[a][k][i][6]*ba[b][k][j][6] );
+
+ if(E->control.inv_gruneisen != 0)
+ for(i=1;i<=dims;i++)
+ for(j=1;j<=dims;j++)
+ for(k=1;k<=VPOINTS3D;k++)
+ bdbmu[i][j] -= W[k] * two_thirds *
+ ( ba[a][k][i][1] + ba[a][k][i][2] + ba[a][k][i][3] ) *
+ ( ba[b][k][j][1] + ba[b][k][j][2] + ba[b][k][j][3] );
+
+
+ /**/
+ ad=dims*(a-1);
+ bd=dims*(b-1);
+
+ pn=ad*nn+bd;
+ qn=bd*nn+ad;
+
+ elt_k[pn ] = bdbmu[1][1] ; /* above */
+ elt_k[pn+1 ] = bdbmu[1][2] ;
+ elt_k[pn+2 ] = bdbmu[1][3] ;
+ elt_k[pn+nn ] = bdbmu[2][1] ;
+ elt_k[pn+nn+1 ] = bdbmu[2][2] ;
+ elt_k[pn+nn+2 ] = bdbmu[2][3] ;
+ elt_k[pn+2*nn ] = bdbmu[3][1] ;
+ elt_k[pn+2*nn+1] = bdbmu[3][2] ;
+ elt_k[pn+2*nn+2] = bdbmu[3][3] ;
+
+ elt_k[qn ] = bdbmu[1][1] ; /* below diag */
+ elt_k[qn+1 ] = bdbmu[2][1] ;
+ elt_k[qn+2 ] = bdbmu[3][1] ;
+ elt_k[qn+nn ] = bdbmu[1][2] ;
+ elt_k[qn+nn+1 ] = bdbmu[2][2] ;
+ elt_k[qn+nn+2 ] = bdbmu[3][2] ;
+ elt_k[qn+2*nn ] = bdbmu[1][3] ;
+ elt_k[qn+2*nn+1] = bdbmu[2][3] ;
+ elt_k[qn+2*nn+2] = bdbmu[3][3] ;
+ /**/
+
+ } /* Sum over all the a,b's to obtain full elt_k matrix */
+
+ return;
+}
+
+
+/* =============================================
+ General calling function for del_squared:
+ according to whether it should be element by
+ element or node by node.
+ ============================================= */
+
+void assemble_del2_u(
+ struct All_variables *E,
+ double **u, double **Au,
+ int level,
+ int strip_bcs
+ )
+{
+ if(E->control.NMULTIGRID||E->control.NASSEMBLE)
+ n_assemble_del2_u(E,u,Au,level,strip_bcs);
+ else
+ e_assemble_del2_u(E,u,Au,level,strip_bcs);
+
+ return;
+}
+
+/* ======================================
+ Assemble del_squared_u vector el by el
+ ====================================== */
+
+void e_assemble_del2_u(
+ struct All_variables *E,
+ double **u, double **Au,
+ int level,
+ int strip_bcs
+ )
+{
+ int e,i,a,b,a1,a2,a3,ii,m,nodeb;
+
+ const int n=loc_mat_size[E->mesh.nsd];
+ const int ends=enodes[E->mesh.nsd];
+ const int dims=E->mesh.nsd;
+ const int nel=E->lmesh.NEL[level];
+ const int neq=E->lmesh.NEQ[level];
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ for(i=0;i<neq;i++)
+ Au[m][i] = 0.0;
+
+ for(e=1;e<=nel;e++) {
+ for(a=1;a<=ends;a++) {
+ ii = E->IEN[level][m][e].node[a];
+ a1 = E->ID[level][m][ii].doff[1];
+ a2 = E->ID[level][m][ii].doff[2];
+ a3 = E->ID[level][m][ii].doff[3];
+ for(b=1;b<=ends;b++) {
+ nodeb = E->IEN[level][m][e].node[b];
+ ii = (a*n+b)*dims-(dims*n+dims);
+ /* i=1, j=1,2 */
+ /* i=1, j=1,2,3 */
+ Au[m][a1] +=
+ E->elt_k[level][m][e].k[ii] *
+ u[m][E->ID[level][m][nodeb].doff[1]]
+ + E->elt_k[level][m][e].k[ii+1] *
+ u[m][E->ID[level][m][nodeb].doff[2]]
+ + E->elt_k[level][m][e].k[ii+2] *
+ u[m][E->ID[level][m][nodeb].doff[3]];
+ /* i=2, j=1,2,3 */
+ Au[m][a2] +=
+ E->elt_k[level][m][e].k[ii+n] *
+ u[m][E->ID[level][m][nodeb].doff[1]]
+ + E->elt_k[level][m][e].k[ii+n+1] *
+ u[m][E->ID[level][m][nodeb].doff[2]]
+ + E->elt_k[level][m][e].k[ii+n+2] *
+ u[m][E->ID[level][m][nodeb].doff[3]];
+ /* i=3, j=1,2,3 */
+ Au[m][a3] +=
+ E->elt_k[level][m][e].k[ii+n+n] *
+ u[m][E->ID[level][m][nodeb].doff[1]]
+ + E->elt_k[level][m][e].k[ii+n+n+1] *
+ u[m][E->ID[level][m][nodeb].doff[2]]
+ + E->elt_k[level][m][e].k[ii+n+n+2] *
+ u[m][E->ID[level][m][nodeb].doff[3]];
+
+ } /* end for loop b */
+ } /* end for loop a */
+
+ } /* end for e */
+ } /* end for m */
+
+ (E->solver.exchange_id_d)(E, Au, level);
+
+ if(strip_bcs)
+ strip_bcs_from_residual(E,Au,level);
+
+ return; }
+
+
+/* ======================================================
+ Assemble Au using stored, nodal coefficients.
+ ====================================================== */
+
+void n_assemble_del2_u(
+ struct All_variables *E,
+ double **u, double **Au,
+ int level,
+ int strip_bcs
+ )
+{
+ int m, e,i;
+ int eqn1,eqn2,eqn3;
+
+ double UU,U1,U2,U3;
+
+ int *C;
+ higher_precision *B1,*B2,*B3;
+
+ const int neq=E->lmesh.NEQ[level];
+ const int nno=E->lmesh.NNO[level];
+ const int dims=E->mesh.nsd;
+ const int max_eqn = dims*14;
+
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+
+ for(e=0;e<=neq;e++)
+ Au[m][e]=0.0;
+
+ u[m][neq] = 0.0;
+
+ for(e=1;e<=nno;e++) {
+
+ eqn1=E->ID[level][m][e].doff[1];
+ eqn2=E->ID[level][m][e].doff[2];
+ eqn3=E->ID[level][m][e].doff[3];
+
+ U1 = u[m][eqn1];
+ U2 = u[m][eqn2];
+ U3 = u[m][eqn3];
+
+ C=E->Node_map[level][m] + (e-1)*max_eqn;
+ B1=E->Eqn_k1[level][m]+(e-1)*max_eqn;
+ B2=E->Eqn_k2[level][m]+(e-1)*max_eqn;
+ B3=E->Eqn_k3[level][m]+(e-1)*max_eqn;
+
+ for(i=3;i<max_eqn;i++) {
+ UU = u[m][C[i]];
+ Au[m][eqn1] += B1[i]*UU;
+ Au[m][eqn2] += B2[i]*UU;
+ Au[m][eqn3] += B3[i]*UU;
+ }
+ for(i=0;i<max_eqn;i++)
+ Au[m][C[i]] += B1[i]*U1+B2[i]*U2+B3[i]*U3;
+
+ } /* end for e */
+ } /* end for m */
+
+ (E->solver.exchange_id_d)(E, Au, level);
+
+ if (strip_bcs)
+ strip_bcs_from_residual(E,Au,level);
+
+ return;
+}
+
+
+void build_diagonal_of_K(
+ struct All_variables *E,
+ int el,
+ double elt_k[24*24],
+ int level, int m
+ )
+{
+ int a,a1,a2,p,node;
+
+ const int n=loc_mat_size[E->mesh.nsd];
+ const int dims=E->mesh.nsd;
+ const int ends=enodes[E->mesh.nsd];
+
+ for(a=1;a<=ends;a++) {
+ node=E->IEN[level][m][el].node[a];
+ /* dirn 1 */
+ a1 = E->ID[level][m][node].doff[1];
+ p=(a-1)*dims;
+ E->BI[level][m][a1] += elt_k[p*n+p];
+
+ /* dirn 2 */
+ a2 = E->ID[level][m][node].doff[2];
+ p=(a-1)*dims+1;
+ E->BI[level][m][a2] += elt_k[p*n+p];
+
+ /* dirn 3 */
+ a1 = E->ID[level][m][node].doff[3];
+ p=(a-1)*dims+2;
+ E->BI[level][m][a1] += elt_k[p*n+p];
+ }
+
+ return;
+}
+
+void build_diagonal_of_Ahat(struct All_variables *E)
+{
+ double BU;
+ int m,e,npno,neq,level;
+
+ for (level=E->mesh.gridmin;level<=E->mesh.gridmax;level++)
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+
+ npno = E->lmesh.NPNO[level];
+ neq=E->lmesh.NEQ[level];
+
+ for(e=1;e<=npno;e++)
+ E->BPI[level][m][e]=1.0;
+
+ if(!E->control.precondition)
+ return;
+
+ for(e=1;e<=npno;e++) {
+ BU=assemble_dAhatp_entry(E,e,level,m);
+ if(BU != 0.0)
+ E->BPI[level][m][e] = 1.0/BU;
+ else
+ E->BPI[level][m][e] = 1.0;
+ }
+ }
+
+ return;
+}
+
+
+/* =====================================================
+ Assemble grad(rho_ref*ez)*V element by element.
+ Note that the storage is not zero'd before assembling.
+ ===================================================== */
+
+void assemble_c_u(struct All_variables *E,
+ double **U, double **result, int level)
+{
+ int e,j1,j2,j3,p,a,b,m;
+
+ const int nel = E->lmesh.NEL[level];
+ const int ends = enodes[E->mesh.nsd];
+ const int dims = E->mesh.nsd;
+ const int npno = E->lmesh.NPNO[level];
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(a=1;a<=ends;a++) {
+ p = (a-1)*dims;
+ for(e=1;e<=nel;e++) {
+ b = E->IEN[level][m][e].node[a];
+ j1= E->ID[level][m][b].doff[1];
+ j2= E->ID[level][m][b].doff[2];
+ j3= E->ID[level][m][b].doff[3];
+ result[m][e] += E->elt_c[level][m][e].c[p ][0] * U[m][j1]
+ + E->elt_c[level][m][e].c[p+1][0] * U[m][j2]
+ + E->elt_c[level][m][e].c[p+2][0] * U[m][j3];
+ }
+ }
+
+ return;
+}
+
+
+
+/* =====================================================
+ Assemble div(rho_ref*V) = div(V) + grad(rho_ref*ez)*V
+ element by element
+ ===================================================== */
+
+void assemble_div_rho_u(struct All_variables *E,
+ double **U, double **result, int level)
+{
+ assemble_div_u(E, U, result, level);
+ assemble_c_u(E, U, result, level);
+
+ return;
+}
+
+
+/* ==========================================
+ Assemble a div_u vector element by element
+ ========================================== */
+
+void assemble_div_u(struct All_variables *E,
+ double **U, double **divU, int level)
+{
+ int e,j1,j2,j3,p,a,b,m;
+
+ const int nel=E->lmesh.NEL[level];
+ const int ends=enodes[E->mesh.nsd];
+ const int dims=E->mesh.nsd;
+ const int npno=E->lmesh.NPNO[level];
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(e=1;e<=npno;e++)
+ divU[m][e] = 0.0;
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(a=1;a<=ends;a++) {
+ p = (a-1)*dims;
+ for(e=1;e<=nel;e++) {
+ b = E->IEN[level][m][e].node[a];
+ j1= E->ID[level][m][b].doff[1];
+ j2= E->ID[level][m][b].doff[2];
+ j3= E->ID[level][m][b].doff[3];
+ divU[m][e] += E->elt_del[level][m][e].g[p ][0] * U[m][j1]
+ + E->elt_del[level][m][e].g[p+1][0] * U[m][j2]
+ + E->elt_del[level][m][e].g[p+2][0] * U[m][j3];
+ }
+ }
+
+ return;
+}
+
+
+/* ==========================================
+ Assemble a grad_P vector element by element
+ ========================================== */
+
+void assemble_grad_p(
+ struct All_variables *E,
+ double **P, double **gradP,
+ int lev
+ )
+{
+ int m,e,i,j1,j2,j3,p,a,b,nel,neq;
+ void strip_bcs_from_residual();
+
+ const int ends=enodes[E->mesh.nsd];
+ const int dims=E->mesh.nsd;
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+
+ nel=E->lmesh.NEL[lev];
+ neq=E->lmesh.NEQ[lev];
+
+ for(i=0;i<neq;i++)
+ gradP[m][i] = 0.0;
+
+ for(e=1;e<=nel;e++) {
+
+ if(0.0==P[m][e])
+ continue;
+
+ for(a=1;a<=ends;a++) {
+ p = (a-1)*dims;
+ b = E->IEN[lev][m][e].node[a];
+ j1= E->ID[lev][m][b].doff[1];
+ j2= E->ID[lev][m][b].doff[2];
+ j3= E->ID[lev][m][b].doff[3];
+ /*for(b=0;b<ploc_mat_size[E->mesh.nsd];b++) */
+ gradP[m][j1] += E->elt_del[lev][m][e].g[p ][0] * P[m][e];
+ gradP[m][j2] += E->elt_del[lev][m][e].g[p+1][0] * P[m][e];
+ gradP[m][j3] += E->elt_del[lev][m][e].g[p+2][0] * P[m][e];
+ }
+ } /* end for el */
+ } /* end for m */
+
+ (E->solver.exchange_id_d)(E, gradP, lev); /* correct gradP */
+
+
+ strip_bcs_from_residual(E,gradP,lev);
+
+return;
+}
+
+
+double assemble_dAhatp_entry(
+ struct All_variables *E,
+ int e, int level, int m
+ )
+{
+ int i,j,p,a,b,node,npno;
+
+ double gradP[81],divU;
+
+ const int ends=enodes[E->mesh.nsd];
+ const int dims=E->mesh.nsd;
+
+ npno=E->lmesh.NPNO[level];
+
+ for(i=0;i<81;i++)
+ gradP[i] = 0.0;
+
+ divU=0.0;
+
+ for(a=1;a<=ends;a++) {
+ p = (a-1)*dims;
+ node = E->IEN[level][m][e].node[a];
+ j=E->ID[level][m][node].doff[1];
+ gradP[p] += E->BI[level][m][j]*E->elt_del[level][m][e].g[p][0];
+
+ j=E->ID[level][m][node].doff[2];
+ gradP[p+1] += E->BI[level][m][j]*E->elt_del[level][m][e].g[p+1][0];
+
+ j=E->ID[level][m][node].doff[3];
+ gradP[p+2] += E->BI[level][m][j]*E->elt_del[level][m][e].g[p+2][0];
+ }
+
+
+ /* calculate div U from the same thing .... */
+
+ /* only need to run over nodes with non-zero grad P, i.e. the ones in
+ the element accessed above, BUT it is only necessary to update the
+ value in the original element, because the diagonal is all we use at
+ the end ... */
+
+ for(b=1;b<=ends;b++) {
+ p = (b-1)*dims;
+ divU +=E->elt_del[level][m][e].g[p][0] * gradP[p];
+ divU +=E->elt_del[level][m][e].g[p+1][0] * gradP[p+1];
+ divU +=E->elt_del[level][m][e].g[p+2][0] * gradP[p+2];
+ }
+
+return(divU); }
+
+
+/*==============================================================
+ Function to supply the element c matrix for a given element e.
+ ============================================================== */
+
+void get_elt_c(struct All_variables *E, int el,
+ higher_precision elt_c[24][1], int lev, int m)
+{
+
+ int p, a, i, j, nz;
+ double temp, beta, rho_avg, x[4];
+
+ double rho[9];
+
+ const int dims = E->mesh.nsd;
+ const int ends = enodes[dims];
+
+ if ((el-1)%E->lmesh.ELZ[lev]==0)
+ construct_c3x3matrix_el(E,el,&E->element_Cc,&E->element_Ccx,lev,m,1);
+
+ temp = p_point[1].weight[dims-1] * E->GDA[lev][m][el].ppt[1];
+
+ switch (E->refstate.choice) {
+ case 1:
+ /* the reference state is computed by rho=exp((1-r)Di/gamma) */
+ /* so d(rho)/dr/rho == -Di/gamma */
+
+ beta = - E->control.disptn_number * E->control.inv_gruneisen;
+
+ for(a=1;a<=ends;a++) {
+ for (i=1;i<=dims;i++) {
+ x[i] = E->N.ppt[GNPINDEX(a,1)]
+ * E->element_Cc.ppt[BPINDEX(3,i,a,1)];
+ }
+ p=dims*(a-1);
+ elt_c[p ][0] = -x[1] * temp * beta;
+ elt_c[p+1][0] = -x[2] * temp * beta;
+ elt_c[p+2][0] = -x[3] * temp * beta;
+ }
+ break;
+ default:
+ /* compute d(rho)/dr/rho from rho(r) */
+
+ for(a=1;a<=ends;a++) {
+ j = E->IEN[lev][m][el].node[a];
+ nz = (j - 1) % E->lmesh.noz + 1;
+ rho[a] = E->refstate.rho[nz];
+ }
+
+ rho_avg = 0;
+ for(a=1;a<=ends;a++) {
+ rho_avg += rho[a];
+ }
+ rho_avg /= ends;
+
+ for(a=1;a<=ends;a++) {
+ for (i=1;i<=dims;i++) {
+ x[i] = rho[a] * E->GNX[lev][m][el].ppt[GNPXINDEX(2,a,1)]
+ * E->N.ppt[GNPINDEX(a,1)]
+ * E->element_Cc.ppt[BPINDEX(3,i,a,1)];
+ }
+ p=dims*(a-1);
+ elt_c[p ][0] = -x[1] * temp / rho_avg;
+ elt_c[p+1][0] = -x[2] * temp / rho_avg;
+ elt_c[p+2][0] = -x[3] * temp / rho_avg;
+ }
+
+ }
+
+ return;
+}
+
+
+/*==============================================================
+ Function to supply the element g matrix for a given element e.
+ ============================================================== */
+
+void get_elt_g(
+ struct All_variables *E,
+ int el,
+ higher_precision elt_del[24][1],
+ int lev, int m
+ )
+
+{
+ void get_rtf_at_ppts();
+ int p,a,i;
+ double ra,ct,si,x[4],rtf[4][9];
+ double temp;
+
+ const int dims=E->mesh.nsd;
+ const int ends=enodes[dims];
+
+ /* Special case, 4/8 node bilinear cartesian square/cube element -> 1 pressure point */
+
+ if ((el-1)%E->lmesh.ELZ[lev]==0)
+ construct_c3x3matrix_el(E,el,&E->element_Cc,&E->element_Ccx,lev,m,1);
+
+ get_rtf_at_ppts(E, m, lev, el, rtf);
+
+ temp=p_point[1].weight[dims-1] * E->GDA[lev][m][el].ppt[1];
+
+ ra = rtf[3][1];
+ si = 1.0/sin(rtf[1][1]);
+ ct = cos(rtf[1][1])*si;
+
+ for(a=1;a<=ends;a++) {
+ for (i=1;i<=dims;i++)
+ x[i]=E->GNX[lev][m][el].ppt[GNPXINDEX(2,a,1)]*E->element_Cc.ppt[BPINDEX(3,i,a,1)]
+ + 2.0*ra*E->N.ppt[GNPINDEX(a,1)]*E->element_Cc.ppt[BPINDEX(3,i,a,1)]
+ + ra*(E->GNX[lev][m][el].ppt[GNPXINDEX(0,a,1)]*E->element_Cc.ppt[BPINDEX(1,i,a,1)]
+ +E->N.ppt[GNPINDEX(a,1)]*E->element_Ccx.ppt[BPXINDEX(1,i,1,a,1)]
+ +ct*E->N.ppt[GNPINDEX(a,1)]*E->element_Cc.ppt[BPINDEX(1,i,a,1)]
+ +si*(E->GNX[lev][m][el].ppt[GNPXINDEX(1,a,1)]*E->element_Cc.ppt[BPINDEX(2,i,a,1)]
+ +E->N.ppt[GNPINDEX(a,1)]*E->element_Ccx.ppt[BPXINDEX(2,i,2,a,1)]));
+
+ p=dims*(a-1);
+ elt_del[p ][0] = -x[1] * temp;
+ elt_del[p+1][0] = -x[2] * temp;
+ elt_del[p+2][0] = -x[3] * temp;
+
+ /* fprintf (E->fp,"B= %d %d %g %g %g %g %g\n",el,a,E->GDA[lev][m][el].ppt[1],E->GNX[lev][m][el].ppt[GNPXINDEX(0,a,1)],E->GNX[lev][m][el].ppt[GNPXINDEX(1,a,1)],elt_del[p][0],elt_del[p+1][0]);
+ */
+ }
+
+ return;
+ }
+
+/*=================================================================
+ Function to create the element force vector (allowing for velocity b.c.'s)
+ ================================================================= */
+
+void get_elt_f(
+ struct All_variables *E,
+ int el,
+ double elt_f[24],
+ int bcs,
+ int m
+ )
+{
+
+ int i,p,a,b,j,k,q,es;
+ int got_elt_k,nodea,nodeb;
+ unsigned int type;
+ const unsigned int vbc_flag[] = {0, VBX, VBY, VBZ};
+
+ double force[9],force_at_gs[9],elt_k[24*24];
+
+
+ const int dims=E->mesh.nsd;
+ const int n=loc_mat_size[dims];
+ const int ends=enodes[dims];
+ const int vpts=vpoints[dims];
+
+ es = (el-1)/E->lmesh.elz + 1;
+
+ if ((el-1)%E->lmesh.elz==0)
+ construct_c3x3matrix_el(E,el,&E->element_Cc,&E->element_Ccx,E->mesh.levmax,m,0);
+
+ for(p=0;p<n;p++) elt_f[p] = 0.0;
+
+ for(p=1;p<=ends;p++)
+ force[p] = E->buoyancy[m][E->ien[m][el].node[p]];
+
+ for(j=1;j<=vpts;j++) { /*compute force at each int point */
+ force_at_gs[j] = 0.0;
+ for(k=1;k<=ends;k++)
+ force_at_gs[j] += force[k] * E->N.vpt[GNVINDEX(k,j)] ;
+ }
+
+ for(i=1;i<=dims;i++) {
+ for(a=1;a<=ends;a++) {
+ nodea=E->ien[m][el].node[a];
+ p= dims*(a-1)+i-1;
+
+ for(j=1;j<=vpts;j++) /*compute sum(Na(j)*F(j)*det(j)) */
+ elt_f[p] += force_at_gs[j] * E->N.vpt[GNVINDEX(a,j)]
+ *E->gDA[m][el].vpt[j]*g_point[j].weight[dims-1]
+ *E->element_Cc.vpt[BVINDEX(3,i,a,j)];
+
+ /* imposed velocity terms */
+
+ if(bcs) {
+ got_elt_k = 0;
+ for(j=1;j<=dims;j++) {
+ type=vbc_flag[j];
+ for(b=1;b<=ends;b++) {
+ nodeb=E->ien[m][el].node[b];
+ if ((E->node[m][nodeb]&type)&&(E->sphere.cap[m].VB[j][nodeb]!=0.0)){
+ if(!got_elt_k) {
+ get_elt_k(E,el,elt_k,E->mesh.levmax,m,1);
+ got_elt_k = 1;
+ }
+ q = dims*(b-1)+j-1;
+ if(p!=q) {
+ elt_f[p] -= elt_k[p*n+q] * E->sphere.cap[m].VB[j][nodeb];
+ }
+ }
+ } /* end for b */
+ } /* end for j */
+ } /* end if for if bcs */
+
+ }
+ } /* Complete the loops for a,i */
+
+
+
+ return;
+}
+
+
+/*=================================================================
+ Function to create the element force vector due to stress b.c.
+ ================================================================= */
+
+void get_elt_tr(struct All_variables *E, int bel, int side, double elt_tr[24], int m)
+{
+
+ const int dims=E->mesh.nsd;
+ const int ends1=enodes[dims-1];
+ const int oned = onedvpoints[dims];
+
+ struct CC Cc;
+ struct CCX Ccx;
+
+ const unsigned sbc_flag[4] = {0,SBX,SBY,SBZ};
+
+ double traction[4][5],traction_at_gs[4][5], value, tmp;
+ int j, b, p, k, a, nodea, d;
+ int el = E->boundary.element[m][bel];
+ int flagged;
+ int found = 0;
+
+ const float rho = E->data.density;
+ const float g = E->data.grav_acc;
+ const float R = 6371000.0;
+ const float eta = E->data.ref_viscosity;
+ const float kappa = E->data.therm_diff;
+ const float factor = 1.0e+00;
+ int nodeas;
+
+ if(E->control.side_sbcs)
+ for(a=1;a<=ends1;a++) {
+ nodea = E->ien[m][el].node[ sidenodes[side][a] ];
+ for(d=1;d<=dims;d++) {
+ value = E->sbc.SB[m][side][d][ E->sbc.node[m][nodea] ];
+ flagged = (E->node[m][nodea] & sbc_flag[d]) && (value);
+ found |= flagged;
+ traction[d][a] = ( flagged ? value : 0.0 );
+ }
+ }
+ else {
+ /* if side_sbcs is false, only apply sbc on top and bottom surfaces */
+ if(side == SIDE_BOTTOM || side == SIDE_TOP) {
+ for(a=1;a<=ends1;a++) {
+ nodea = E->ien[m][el].node[ sidenodes[side][a] ];
+ for(d=1;d<=dims;d++) {
+ value = E->sphere.cap[m].VB[d][nodea];
+ flagged = (E->node[m][nodea] & sbc_flag[d]) && (value);
+ found |= flagged;
+ traction[d][a] = ( flagged ? value : 0.0 );
+ }
+ }
+ }
+ }
+
+ /* skip the following computation if no sbc_flag is set
+ or value of sbcs are zero */
+ if(!found) return;
+
+ /* compute traction at each int point */
+ construct_side_c3x3matrix_el(E,el,&Cc,&Ccx,
+ E->mesh.levmax,m,0,side);
+
+ for(k=1;k<=oned;k++)
+ for(d=1;d<=dims;d++) {
+ traction_at_gs[d][k] = 0.0;
+ for(j=1;j<=ends1;j++)
+ traction_at_gs[d][k] += traction[d][j] * E->M.vpt[GMVINDEX(j,k)] ;
+ }
+
+ for(j=1;j<=ends1;j++) {
+ a = sidenodes[side][j];
+ for(d=1;d<=dims;d++) {
+ p = dims*(a-1)+d-1;
+ for(k=1;k<=oned;k++) {
+ tmp = 0.0;
+ for(b=1;b<=dims;b++)
+ tmp += traction_at_gs[b][k] * Cc.vpt[BVINDEX(b,d,a,k)];
+
+ elt_tr[p] += tmp * E->M.vpt[GMVINDEX(j,k)]
+ * E->boundary.det[m][side][k][bel] * g_1d[k].weight[dims-1];
+
+ }
+ }
+ }
+}
+
+void get_elt_tr_pseudo_surf(struct All_variables *E, int bel, int side, double elt_tr[24], int m)
+{
+
+ const int dims=E->mesh.nsd;
+ const int ends1=enodes[dims-1];
+ const int oned = onedvpoints[dims];
+
+ struct CC Cc;
+ struct CCX Ccx;
+
+ const unsigned sbc_flag[4] = {0,SBX,SBY,SBZ};
+
+ double traction[4][5],traction_at_gs[4][5], value, tmp;
+ int j, b, p, k, a, nodea, d;
+ int el = E->boundary.element[m][bel];
+ int flagged;
+ int found = 0;
+
+ const float rho = E->data.density;
+ const float g = E->data.grav_acc;
+ const float R = 6371000.0;
+ const float eta = E->data.ref_viscosity;
+ const float kappa = E->data.therm_diff;
+ const float factor = 1.0e+00;
+ int nodeas;
+
+ if(E->control.side_sbcs)
+ for(a=1;a<=ends1;a++) {
+ nodea = E->ien[m][el].node[ sidenodes[side][a] ];
+ for(d=1;d<=dims;d++) {
+ value = E->sbc.SB[m][side][d][ E->sbc.node[m][nodea] ];
+ flagged = (E->node[m][nodea] & sbc_flag[d]) && (value);
+ found |= flagged;
+ traction[d][a] = ( flagged ? value : 0.0 );
+ }
+ }
+ else {
+ if( side == SIDE_TOP && E->parallel.me_loc[3]==E->parallel.nprocz-1 && (el%E->lmesh.elz==0)) {
+ for(a=1;a<=ends1;a++) {
+ nodea = E->ien[m][el].node[ sidenodes[side][a] ];
+ nodeas = E->ien[m][el].node[ sidenodes[side][a] ]/E->lmesh.noz;
+ traction[1][a] = 0.0;
+ traction[2][a] = 0.0;
+ traction[3][a] = -1.0*factor*rho*g*(R*R*R)/(eta*kappa)
+ *(E->slice.freesurf[m][nodeas]+E->sphere.cap[m].V[3][nodea]*E->advection.timestep);
+ if(E->parallel.me==11 && nodea==3328)
+ fprintf(stderr,"traction=%e vnew=%e timestep=%e coeff=%e\n",traction[3][a],E->sphere.cap[m].V[3][nodea],E->advection.timestep,-1.0*factor*rho*g*(R*R*R)/(eta*kappa));
+ found = 1;
+#if 0
+ if(found && E->parallel.me==1)
+ fprintf(stderr,"me=%d bel=%d el=%d side=%d TOP=%d a=%d sidenodes=%d ien=%d noz=%d nodea=%d traction=%e %e %e\n",
+ E->parallel.me,bel,el,side,SIDE_TOP,a,sidenodes[side][a],
+ E->ien[m][el].node[ sidenodes[side][a] ],E->lmesh.noz,
+ nodea,traction[1][a],traction[2][a],traction[3][a]);
+
+#endif
+ }
+ }
+ else {
+ for(a=1;a<=ends1;a++) {
+ nodea = E->ien[m][el].node[ sidenodes[side][a] ];
+ for(d=1;d<=dims;d++) {
+ value = E->sphere.cap[m].VB[d][nodea];
+ flagged = (E->node[m][nodea] & sbc_flag[d]) && (value);
+ found |= flagged;
+ traction[d][a] = ( flagged ? value : 0.0 );
+ }
+ }
+ }
+ }
+
+ /* skip the following computation if no sbc_flag is set
+ or value of sbcs are zero */
+ if(!found) return;
+
+ /* compute traction at each int point */
+ construct_side_c3x3matrix_el(E,el,&Cc,&Ccx,
+ E->mesh.levmax,m,0,side);
+
+ for(k=1;k<=oned;k++)
+ for(d=1;d<=dims;d++) {
+ traction_at_gs[d][k] = 0.0;
+ for(j=1;j<=ends1;j++)
+ traction_at_gs[d][k] += traction[d][j] * E->M.vpt[GMVINDEX(j,k)] ;
+ }
+
+ for(j=1;j<=ends1;j++) {
+ a = sidenodes[side][j];
+ for(d=1;d<=dims;d++) {
+ p = dims*(a-1)+d-1;
+ for(k=1;k<=oned;k++) {
+ tmp = 0.0;
+ for(b=1;b<=dims;b++)
+ tmp += traction_at_gs[b][k] * Cc.vpt[BVINDEX(b,d,a,k)];
+
+ elt_tr[p] += tmp * E->M.vpt[GMVINDEX(j,k)]
+ * E->boundary.det[m][side][k][bel] * g_1d[k].weight[dims-1];
+
+ }
+ }
+ }
+}
+
+
+/* =================================================================
+ subroutine to get augmented lagrange part of stiffness matrix
+================================================================== */
+
+void get_aug_k(
+ struct All_variables *E,
+ int el,
+ double elt_k[24*24],
+ int level, int m
+ )
+{
+ int i,p[9],a,b,nodea,nodeb;
+ double Visc;
+
+ const int n=loc_mat_size[E->mesh.nsd];
+ const int ends=enodes[E->mesh.nsd];
+ const int vpts=vpoints[E->mesh.nsd];
+ const int dims=E->mesh.nsd;
+
+ Visc = 0.0;
+ for(a=1;a<=vpts;a++) {
+ p[a] = (a-1)*dims;
+ Visc += E->EVI[level][m][(el-1)*vpts+a];
+ }
+ Visc = Visc/vpts;
+
+ for(a=1;a<=ends;a++) {
+ nodea=E->IEN[level][m][el].node[a];
+ for(b=1;b<=ends;b++) {
+ nodeb=E->IEN[level][m][el].node[b]; /* for Kab dims*dims */
+ i = (a-1)*n*dims+(b-1)*dims;
+ elt_k[i ] += Visc*E->control.augmented*
+ E->elt_del[level][m][el].g[p[a]][0]*
+ E->elt_del[level][m][el].g[p[b]][0]; /*for 11 */
+ elt_k[i+1] += Visc*E->control.augmented*
+ E->elt_del[level][m][el].g[p[a]][0]*
+ E->elt_del[level][m][el].g[p[b]+1][0]; /* for 12 */
+ elt_k[i+n] += Visc*E->control.augmented*
+ E->elt_del[level][m][el].g[p[a]+1][0]*
+ E->elt_del[level][m][el].g[p[b]][0]; /* for 21 */
+ elt_k[i+n+1] += Visc*E->control.augmented*
+ E->elt_del[level][m][el].g[p[a]+1][0]*
+ E->elt_del[level][m][el].g[p[b]+1][0]; /* for 22 */
+
+ if(3==dims) {
+ elt_k[i+2] += Visc*E->control.augmented*
+ E->elt_del[level][m][el].g[p[a]][0]*
+ E->elt_del[level][m][el].g[p[b]+2][0]; /* for 13 */
+ elt_k[i+n+2] += Visc*E->control.augmented*
+ E->elt_del[level][m][el].g[p[a]+1][0]*
+ E->elt_del[level][m][el].g[p[b]+2][0]; /* for 23 */
+ elt_k[i+n+n] += Visc*E->control.augmented*
+ E->elt_del[level][m][el].g[p[a]+2][0]*
+ E->elt_del[level][m][el].g[p[b]][0]; /* for 31 */
+ elt_k[i+n+n+1] += Visc*E->control.augmented*
+ E->elt_del[level][m][el].g[p[a]+2][0]*
+ E->elt_del[level][m][el].g[p[b]+1][0]; /* for 32 */
+ elt_k[i+n+n+2] += Visc*E->control.augmented*
+ E->elt_del[level][m][el].g[p[a]+2][0]*
+ E->elt_del[level][m][el].g[p[b]+2][0]; /* for 33 */
+ }
+ }
+ }
+
+ return;
+ }
+
+
+/* version */
+/* $Id$ */
+
+/* End of file */
Deleted: mc/3D/CitcomS/branches/cxx/lib/Full_boundary_conditions.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Full_boundary_conditions.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Full_boundary_conditions.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,242 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-#include "element_definitions.h"
-#include "global_defs.h"
-#include <math.h>
-
-#include "lith_age.h"
-
-/* ========================================== */
-
-static void horizontal_bc();
-static void velocity_apply_periodic_bcs();
-static void temperature_apply_periodic_bcs();
-void read_temperature_boundary_from_file(struct All_variables *);
-void read_velocity_boundary_from_file(struct All_variables *);
-
-/* ========================================== */
-
-void full_velocity_boundary_conditions(E)
- struct All_variables *E;
-{
- void velocity_imp_vert_bc();
- void velocity_apply_periodicapply_periodic_bcs();
-
- void apply_side_sbc();
-
- int j,noz,lv;
-
- for(lv=E->mesh.gridmax;lv>=E->mesh.gridmin;lv--)
- for (j=1;j<=E->sphere.caps_per_proc;j++) {
- noz = E->mesh.NOZ[lv];
- if(E->mesh.topvbc != 1) { /* free slip top */
- horizontal_bc(E,E->sphere.cap[j].VB,noz,1,0.0,VBX,0,lv,j);
- horizontal_bc(E,E->sphere.cap[j].VB,noz,3,0.0,VBZ,1,lv,j);
- horizontal_bc(E,E->sphere.cap[j].VB,noz,2,0.0,VBY,0,lv,j);
- horizontal_bc(E,E->sphere.cap[j].VB,noz,1,E->control.VBXtopval,SBX,1,lv,j);
- horizontal_bc(E,E->sphere.cap[j].VB,noz,3,0.0,SBZ,0,lv,j);
- horizontal_bc(E,E->sphere.cap[j].VB,noz,2,E->control.VBYtopval,SBY,1,lv,j);
- }
- if(E->mesh.botvbc != 1) { /* free slip bottom */
- horizontal_bc(E,E->sphere.cap[j].VB,1,1,0.0,VBX,0,lv,j);
- horizontal_bc(E,E->sphere.cap[j].VB,1,3,0.0,VBZ,1,lv,j);
- horizontal_bc(E,E->sphere.cap[j].VB,1,2,0.0,VBY,0,lv,j);
- horizontal_bc(E,E->sphere.cap[j].VB,1,1,E->control.VBXbotval,SBX,1,lv,j);
- horizontal_bc(E,E->sphere.cap[j].VB,1,3,0.0,SBZ,0,lv,j);
- horizontal_bc(E,E->sphere.cap[j].VB,1,2,E->control.VBYbotval,SBY,1,lv,j);
- }
-
- if(E->mesh.topvbc == 1) { /* velocity/no slip BC */
- horizontal_bc(E,E->sphere.cap[j].VB,noz,1,E->control.VBXtopval,VBX,1,lv,j);
- horizontal_bc(E,E->sphere.cap[j].VB,noz,3,0.0,VBZ,1,lv,j);
- horizontal_bc(E,E->sphere.cap[j].VB,noz,2,E->control.VBYtopval,VBY,1,lv,j);
- horizontal_bc(E,E->sphere.cap[j].VB,noz,1,0.0,SBX,0,lv,j);
- horizontal_bc(E,E->sphere.cap[j].VB,noz,3,0.0,SBZ,0,lv,j);
- horizontal_bc(E,E->sphere.cap[j].VB,noz,2,0.0,SBY,0,lv,j);
-
- if(E->control.vbcs_file){ /* this should either only be called
- once, or the input routines need
- to be told what to do for each
- multigrid level and cap. it might
- be easiest to call only once and
- have routines deal with multigrid
- */
- if((lv == E->mesh.gridmin) && (j == E->sphere.caps_per_proc))
- read_velocity_boundary_from_file(E);
- }
- }
- if(E->mesh.botvbc == 1) { /* velocity bottom BC */
- horizontal_bc(E,E->sphere.cap[j].VB,1,1,E->control.VBXbotval,VBX,1,lv,j);
- horizontal_bc(E,E->sphere.cap[j].VB,1,3,0.0,VBZ,1,lv,j);
- horizontal_bc(E,E->sphere.cap[j].VB,1,2,E->control.VBYbotval,VBY,1,lv,j);
- horizontal_bc(E,E->sphere.cap[j].VB,1,1,0.0,SBX,0,lv,j);
- horizontal_bc(E,E->sphere.cap[j].VB,1,3,0.0,SBZ,0,lv,j);
- horizontal_bc(E,E->sphere.cap[j].VB,1,2,0.0,SBY,0,lv,j);
- }
- } /* end for j and lv */
-
- if(E->control.side_sbcs)
- apply_side_sbc(E);
-
-/* if(E->control.verbose) { */
-/* for (j=1;j<=E->sphere.caps_per_proc;j++) */
-/* for (node=1;node<=E->lmesh.nno;node++) */
-/* fprintf(E->fp_out,"m=%d VB== %d %g %g %g flag %u %u %u\n",j,node,E->sphere.cap[j].VB[1][node],E->sphere.cap[j].VB[2][node],E->sphere.cap[j].VB[3][node],E->node[j][node]&VBX,E->node[j][node]&VBY,E->node[j][node]&VBZ); */
-/* fflush(E->fp_out); */
-/* } */
-
- /* If any imposed internal velocity structure it goes here */
-
-
- return; }
-
-/* ========================================== */
-
-void full_temperature_boundary_conditions(E)
- struct All_variables *E;
-{
- void temperatures_conform_bcs();
- void temperature_imposed_vert_bcs();
- int j,lev,noz;
-
- lev = E->mesh.levmax;
- for (j=1;j<=E->sphere.caps_per_proc;j++) {
- noz = E->mesh.noz;
- if(E->mesh.toptbc == 1) {
- horizontal_bc(E,E->sphere.cap[j].TB,noz,3,E->control.TBCtopval,TBZ,1,lev,j);
- horizontal_bc(E,E->sphere.cap[j].TB,noz,3,E->control.TBCtopval,FBZ,0,lev,j);
- if(E->control.tbcs_file)
- read_temperature_boundary_from_file(E);
- }
- else {
- horizontal_bc(E,E->sphere.cap[j].TB,noz,3,E->control.TBCtopval,TBZ,0,lev,j);
- horizontal_bc(E,E->sphere.cap[j].TB,noz,3,E->control.TBCtopval,FBZ,1,lev,j);
- }
-
- if(E->mesh.bottbc == 1) {
- horizontal_bc(E,E->sphere.cap[j].TB,1,3,E->control.TBCbotval,TBZ,1,lev,j);
- horizontal_bc(E,E->sphere.cap[j].TB,1,3,E->control.TBCbotval,FBZ,0,lev,j);
- }
- else {
- horizontal_bc(E,E->sphere.cap[j].TB,1,3,E->control.TBCbotval,TBZ,0,lev,j);
- horizontal_bc(E,E->sphere.cap[j].TB,1,3,E->control.TBCbotval,FBZ,1,lev,j);
- }
-
- if(E->control.lith_age_time==1) {
-
- /* set the regions in which to use lithosphere files to determine temperature
- note that this is called if the lithosphere age in inputted every time step
- OR it is only maintained in the boundary regions */
- lith_age_temperature_bound_adj(E,lev);
- }
-
-
- } /* end for j */
-
- temperatures_conform_bcs(E);
- E->temperatures_conform_bcs = temperatures_conform_bcs;
-
- return; }
-
-
-/* ========================================================= */
-
-
-static void horizontal_bc(E,BC,ROW,dirn,value,mask,onoff,level,m)
- struct All_variables *E;
- float *BC[];
- int ROW;
- int dirn;
- float value;
- unsigned int mask;
- char onoff;
- int level,m;
-
-{
- int i,j,node,rowl;
-
- /* safety feature */
- if(dirn > E->mesh.nsd)
- return;
-
- if (ROW==1)
- rowl = 1;
- else
- rowl = E->lmesh.NOZ[level];
-
- if ( ( (ROW==1) && (E->parallel.me_loc[3]==0) ) ||
- ( (ROW==E->mesh.NOZ[level]) && (E->parallel.me_loc[3]==E->parallel.nprocz-1) ) ) {
-
- /* turn bc marker to zero */
- if (onoff == 0) {
- for(j=1;j<=E->lmesh.NOY[level];j++)
- for(i=1;i<=E->lmesh.NOX[level];i++) {
- node = rowl+(i-1)*E->lmesh.NOZ[level]+(j-1)*E->lmesh.NOX[level]*E->lmesh.NOZ[level];
- E->NODE[level][m][node] = E->NODE[level][m][node] & (~ mask);
- } /* end for loop i & j */
- }
-
- /* turn bc marker to one */
- else {
- for(j=1;j<=E->lmesh.NOY[level];j++)
- for(i=1;i<=E->lmesh.NOX[level];i++) {
- node = rowl+(i-1)*E->lmesh.NOZ[level]+(j-1)*E->lmesh.NOX[level]*E->lmesh.NOZ[level];
- E->NODE[level][m][node] = E->NODE[level][m][node] | (mask);
- if(level==E->mesh.levmax) /* NB */
- BC[dirn][node] = value;
- } /* end for loop i & j */
- }
-
- } /* end for if ROW */
-
- return;
-}
-
-
-static void velocity_apply_periodic_bcs(E)
- struct All_variables *E;
-{
- fprintf(E->fp,"Periodic boundary conditions\n");
-
- return;
- }
-
-static void temperature_apply_periodic_bcs(E)
- struct All_variables *E;
-{
- fprintf(E->fp,"Periodic temperature boundary conditions\n");
-
- return;
- }
-
-
-
-/* version */
-/* $Id$ */
-
-/* End of file */
Copied: mc/3D/CitcomS/branches/cxx/lib/Full_boundary_conditions.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Full_boundary_conditions.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Full_boundary_conditions.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Full_boundary_conditions.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,242 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+#include "element_definitions.h"
+#include "global_defs.h"
+#include <math.h>
+
+#include "lith_age.h"
+
+#include "cproto.h"
+
+/* ========================================== */
+
+static void horizontal_bc(
+ struct All_variables *E,
+ float *BC[],
+ int ROW,
+ int dirn,
+ float value,
+ unsigned int mask,
+ char onoff,
+ int level, int m
+ );
+static void velocity_apply_periodic_bcs(struct All_variables *E);
+static void temperature_apply_periodic_bcs(struct All_variables *E);
+void read_temperature_boundary_from_file(struct All_variables *);
+void read_velocity_boundary_from_file(struct All_variables *);
+
+/* ========================================== */
+
+void full_velocity_boundary_conditions(struct All_variables *E)
+{
+ int j,noz,lv;
+
+ for(lv=E->mesh.gridmax;lv>=E->mesh.gridmin;lv--)
+ for (j=1;j<=E->sphere.caps_per_proc;j++) {
+ noz = E->mesh.NOZ[lv];
+ if(E->mesh.topvbc != 1) { /* free slip top */
+ horizontal_bc(E,E->sphere.cap[j].VB,noz,1,0.0,VBX,0,lv,j);
+ horizontal_bc(E,E->sphere.cap[j].VB,noz,3,0.0,VBZ,1,lv,j);
+ horizontal_bc(E,E->sphere.cap[j].VB,noz,2,0.0,VBY,0,lv,j);
+ horizontal_bc(E,E->sphere.cap[j].VB,noz,1,E->control.VBXtopval,SBX,1,lv,j);
+ horizontal_bc(E,E->sphere.cap[j].VB,noz,3,0.0,SBZ,0,lv,j);
+ horizontal_bc(E,E->sphere.cap[j].VB,noz,2,E->control.VBYtopval,SBY,1,lv,j);
+ }
+ if(E->mesh.botvbc != 1) { /* free slip bottom */
+ horizontal_bc(E,E->sphere.cap[j].VB,1,1,0.0,VBX,0,lv,j);
+ horizontal_bc(E,E->sphere.cap[j].VB,1,3,0.0,VBZ,1,lv,j);
+ horizontal_bc(E,E->sphere.cap[j].VB,1,2,0.0,VBY,0,lv,j);
+ horizontal_bc(E,E->sphere.cap[j].VB,1,1,E->control.VBXbotval,SBX,1,lv,j);
+ horizontal_bc(E,E->sphere.cap[j].VB,1,3,0.0,SBZ,0,lv,j);
+ horizontal_bc(E,E->sphere.cap[j].VB,1,2,E->control.VBYbotval,SBY,1,lv,j);
+ }
+
+ if(E->mesh.topvbc == 1) { /* velocity/no slip BC */
+ horizontal_bc(E,E->sphere.cap[j].VB,noz,1,E->control.VBXtopval,VBX,1,lv,j);
+ horizontal_bc(E,E->sphere.cap[j].VB,noz,3,0.0,VBZ,1,lv,j);
+ horizontal_bc(E,E->sphere.cap[j].VB,noz,2,E->control.VBYtopval,VBY,1,lv,j);
+ horizontal_bc(E,E->sphere.cap[j].VB,noz,1,0.0,SBX,0,lv,j);
+ horizontal_bc(E,E->sphere.cap[j].VB,noz,3,0.0,SBZ,0,lv,j);
+ horizontal_bc(E,E->sphere.cap[j].VB,noz,2,0.0,SBY,0,lv,j);
+
+ if(E->control.vbcs_file){ /* this should either only be called
+ once, or the input routines need
+ to be told what to do for each
+ multigrid level and cap. it might
+ be easiest to call only once and
+ have routines deal with multigrid
+ */
+ if((lv == E->mesh.gridmin) && (j == E->sphere.caps_per_proc))
+ read_velocity_boundary_from_file(E);
+ }
+ }
+ if(E->mesh.botvbc == 1) { /* velocity bottom BC */
+ horizontal_bc(E,E->sphere.cap[j].VB,1,1,E->control.VBXbotval,VBX,1,lv,j);
+ horizontal_bc(E,E->sphere.cap[j].VB,1,3,0.0,VBZ,1,lv,j);
+ horizontal_bc(E,E->sphere.cap[j].VB,1,2,E->control.VBYbotval,VBY,1,lv,j);
+ horizontal_bc(E,E->sphere.cap[j].VB,1,1,0.0,SBX,0,lv,j);
+ horizontal_bc(E,E->sphere.cap[j].VB,1,3,0.0,SBZ,0,lv,j);
+ horizontal_bc(E,E->sphere.cap[j].VB,1,2,0.0,SBY,0,lv,j);
+ }
+ } /* end for j and lv */
+
+ if(E->control.side_sbcs)
+ apply_side_sbc(E);
+
+/* if(E->control.verbose) { */
+/* for (j=1;j<=E->sphere.caps_per_proc;j++) */
+/* for (node=1;node<=E->lmesh.nno;node++) */
+/* fprintf(E->fp_out,"m=%d VB== %d %g %g %g flag %u %u %u\n",j,node,E->sphere.cap[j].VB[1][node],E->sphere.cap[j].VB[2][node],E->sphere.cap[j].VB[3][node],E->node[j][node]&VBX,E->node[j][node]&VBY,E->node[j][node]&VBZ); */
+/* fflush(E->fp_out); */
+/* } */
+
+ /* If any imposed internal velocity structure it goes here */
+
+
+ return; }
+
+/* ========================================== */
+
+void full_temperature_boundary_conditions(struct All_variables *E)
+{
+ int j,lev,noz;
+
+ lev = E->mesh.levmax;
+ for (j=1;j<=E->sphere.caps_per_proc;j++) {
+ noz = E->mesh.noz;
+ if(E->mesh.toptbc == 1) {
+ horizontal_bc(E,E->sphere.cap[j].TB,noz,3,E->control.TBCtopval,TBZ,1,lev,j);
+ horizontal_bc(E,E->sphere.cap[j].TB,noz,3,E->control.TBCtopval,FBZ,0,lev,j);
+ if(E->control.tbcs_file)
+ read_temperature_boundary_from_file(E);
+ }
+ else {
+ horizontal_bc(E,E->sphere.cap[j].TB,noz,3,E->control.TBCtopval,TBZ,0,lev,j);
+ horizontal_bc(E,E->sphere.cap[j].TB,noz,3,E->control.TBCtopval,FBZ,1,lev,j);
+ }
+
+ if(E->mesh.bottbc == 1) {
+ horizontal_bc(E,E->sphere.cap[j].TB,1,3,E->control.TBCbotval,TBZ,1,lev,j);
+ horizontal_bc(E,E->sphere.cap[j].TB,1,3,E->control.TBCbotval,FBZ,0,lev,j);
+ }
+ else {
+ horizontal_bc(E,E->sphere.cap[j].TB,1,3,E->control.TBCbotval,TBZ,0,lev,j);
+ horizontal_bc(E,E->sphere.cap[j].TB,1,3,E->control.TBCbotval,FBZ,1,lev,j);
+ }
+
+ if(E->control.lith_age_time==1) {
+
+ /* set the regions in which to use lithosphere files to determine temperature
+ note that this is called if the lithosphere age in inputted every time step
+ OR it is only maintained in the boundary regions */
+ lith_age_temperature_bound_adj(E,lev);
+ }
+
+
+ } /* end for j */
+
+ temperatures_conform_bcs(E);
+ E->temperatures_conform_bcs = temperatures_conform_bcs;
+
+ return; }
+
+
+/* ========================================================= */
+
+
+static void horizontal_bc(
+ struct All_variables *E,
+ float *BC[],
+ int ROW,
+ int dirn,
+ float value,
+ unsigned int mask,
+ char onoff,
+ int level, int m
+ )
+{
+ int i,j,node,rowl;
+
+ /* safety feature */
+ if(dirn > E->mesh.nsd)
+ return;
+
+ if (ROW==1)
+ rowl = 1;
+ else
+ rowl = E->lmesh.NOZ[level];
+
+ if ( ( (ROW==1) && (E->parallel.me_loc[3]==0) ) ||
+ ( (ROW==E->mesh.NOZ[level]) && (E->parallel.me_loc[3]==E->parallel.nprocz-1) ) ) {
+
+ /* turn bc marker to zero */
+ if (onoff == 0) {
+ for(j=1;j<=E->lmesh.NOY[level];j++)
+ for(i=1;i<=E->lmesh.NOX[level];i++) {
+ node = rowl+(i-1)*E->lmesh.NOZ[level]+(j-1)*E->lmesh.NOX[level]*E->lmesh.NOZ[level];
+ E->NODE[level][m][node] = E->NODE[level][m][node] & (~ mask);
+ } /* end for loop i & j */
+ }
+
+ /* turn bc marker to one */
+ else {
+ for(j=1;j<=E->lmesh.NOY[level];j++)
+ for(i=1;i<=E->lmesh.NOX[level];i++) {
+ node = rowl+(i-1)*E->lmesh.NOZ[level]+(j-1)*E->lmesh.NOX[level]*E->lmesh.NOZ[level];
+ E->NODE[level][m][node] = E->NODE[level][m][node] | (mask);
+ if(level==E->mesh.levmax) /* NB */
+ BC[dirn][node] = value;
+ } /* end for loop i & j */
+ }
+
+ } /* end for if ROW */
+
+ return;
+}
+
+
+static void velocity_apply_periodic_bcs(struct All_variables *E)
+{
+ fprintf(E->fp,"Periodic boundary conditions\n");
+
+ return;
+ }
+
+static void temperature_apply_periodic_bcs(struct All_variables *E)
+{
+ fprintf(E->fp,"Periodic temperature boundary conditions\n");
+
+ return;
+ }
+
+
+
+/* version */
+/* $Id$ */
+
+/* End of file */
Deleted: mc/3D/CitcomS/branches/cxx/lib/Full_geometry_cartesian.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Full_geometry_cartesian.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Full_geometry_cartesian.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,126 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-#include <math.h>
-#include "element_definitions.h"
-#include "global_defs.h"
-#include "parsing.h"
-
-
-void full_set_2dc_defaults(E)
- struct All_variables *E;
-{
-
- E->mesh.nsd = 2;
- E->mesh.dof = 2;
-
-}
-
-
-void full_set_2pt5dc_defaults(E)
- struct All_variables *E;
-{
-
- E->mesh.nsd = 2;
- E->mesh.dof = 3;
-
-}
-
-void full_set_3dc_defaults(E)
- struct All_variables *E;
-{
-
- E->mesh.nsd = 3;
- E->mesh.dof = 3;
-
-}
-
-void full_set_3dsphere_defaults(E)
- struct All_variables *E;
-{
- void full_set_3dsphere_defaults2(struct All_variables *);
- int m=E->parallel.me;
-
- input_double("radius_outer",&(E->sphere.ro),"1",m);
- input_double("radius_inner",&(E->sphere.ri),"0.55",m);
-
- full_set_3dsphere_defaults2(E);
-
- return;
-}
-
-
-void full_set_3dsphere_defaults2(struct All_variables *E)
-{
- int i,j;
- double offset;
-
- E->mesh.nsd = 3;
- E->mesh.dof = 3;
-
- E->sphere.caps = 12;
- E->sphere.max_connections = 6;
-
- /* adjust the corner coordinates so that the size (surface area) of
- each cap is about the same. */
- offset = 9.736/180.0*M_PI;
-
- for (i=1;i<=4;i++) {
- E->sphere.cap[(i-1)*3+1].theta[1] = 0.0;
- E->sphere.cap[(i-1)*3+1].theta[2] = M_PI/4.0+offset;
- E->sphere.cap[(i-1)*3+1].theta[3] = M_PI/2.0;
- E->sphere.cap[(i-1)*3+1].theta[4] = M_PI/4.0+offset;
- E->sphere.cap[(i-1)*3+1].fi[1] = 0.0;
- E->sphere.cap[(i-1)*3+1].fi[2] = (i-1)*M_PI/2.0;
- E->sphere.cap[(i-1)*3+1].fi[3] = (i-1)*M_PI/2.0 + M_PI/4.0;
- E->sphere.cap[(i-1)*3+1].fi[4] = i*M_PI/2.0;
-
- E->sphere.cap[(i-1)*3+2].theta[1] = M_PI/4.0+offset;
- E->sphere.cap[(i-1)*3+2].theta[2] = M_PI/2.0;
- E->sphere.cap[(i-1)*3+2].theta[3] = 3*M_PI/4.0-offset;
- E->sphere.cap[(i-1)*3+2].theta[4] = M_PI/2.0;
- E->sphere.cap[(i-1)*3+2].fi[1] = i*M_PI/2.0;
- E->sphere.cap[(i-1)*3+2].fi[2] = i*M_PI/2.0 - M_PI/4.0;
- E->sphere.cap[(i-1)*3+2].fi[3] = i*M_PI/2.0;
- E->sphere.cap[(i-1)*3+2].fi[4] = i*M_PI/2.0 + M_PI/4.0;
- }
-
- for (i=1;i<=4;i++) {
- j = (i-1)*3;
- if (i==1) j=12;
- E->sphere.cap[j].theta[1] = M_PI/2.0;
- E->sphere.cap[j].theta[2] = 3*M_PI/4.0-offset;
- E->sphere.cap[j].theta[3] = M_PI;
- E->sphere.cap[j].theta[4] = 3*M_PI/4.0-offset;
- E->sphere.cap[j].fi[1] = (i-1)*M_PI/2.0 + M_PI/4.0;
- E->sphere.cap[j].fi[2] = (i-1)*M_PI/2.0;
- E->sphere.cap[j].fi[3] = 0.0;
- E->sphere.cap[j].fi[4] = i*M_PI/2.0;
- }
-
- return;
-}
Copied: mc/3D/CitcomS/branches/cxx/lib/Full_geometry_cartesian.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Full_geometry_cartesian.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Full_geometry_cartesian.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Full_geometry_cartesian.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,123 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+#include <math.h>
+#include "element_definitions.h"
+#include "global_defs.h"
+#include "parsing.h"
+
+#include "cproto.h"
+
+
+void full_set_2dc_defaults(struct All_variables *E)
+{
+
+ E->mesh.nsd = 2;
+ E->mesh.dof = 2;
+
+}
+
+
+void full_set_2pt5dc_defaults(struct All_variables *E)
+{
+
+ E->mesh.nsd = 2;
+ E->mesh.dof = 3;
+
+}
+
+void full_set_3dc_defaults(struct All_variables *E)
+{
+
+ E->mesh.nsd = 3;
+ E->mesh.dof = 3;
+
+}
+
+void full_set_3dsphere_defaults(struct All_variables *E)
+{
+ int m=E->parallel.me;
+
+ input_double("radius_outer",&(E->sphere.ro),"1",m);
+ input_double("radius_inner",&(E->sphere.ri),"0.55",m);
+
+ full_set_3dsphere_defaults2(E);
+
+ return;
+}
+
+
+void full_set_3dsphere_defaults2(struct All_variables *E)
+{
+ int i,j;
+ double offset;
+
+ E->mesh.nsd = 3;
+ E->mesh.dof = 3;
+
+ E->sphere.caps = 12;
+ E->sphere.max_connections = 6;
+
+ /* adjust the corner coordinates so that the size (surface area) of
+ each cap is about the same. */
+ offset = 9.736/180.0*M_PI;
+
+ for (i=1;i<=4;i++) {
+ E->sphere.cap[(i-1)*3+1].theta[1] = 0.0;
+ E->sphere.cap[(i-1)*3+1].theta[2] = M_PI/4.0+offset;
+ E->sphere.cap[(i-1)*3+1].theta[3] = M_PI/2.0;
+ E->sphere.cap[(i-1)*3+1].theta[4] = M_PI/4.0+offset;
+ E->sphere.cap[(i-1)*3+1].fi[1] = 0.0;
+ E->sphere.cap[(i-1)*3+1].fi[2] = (i-1)*M_PI/2.0;
+ E->sphere.cap[(i-1)*3+1].fi[3] = (i-1)*M_PI/2.0 + M_PI/4.0;
+ E->sphere.cap[(i-1)*3+1].fi[4] = i*M_PI/2.0;
+
+ E->sphere.cap[(i-1)*3+2].theta[1] = M_PI/4.0+offset;
+ E->sphere.cap[(i-1)*3+2].theta[2] = M_PI/2.0;
+ E->sphere.cap[(i-1)*3+2].theta[3] = 3*M_PI/4.0-offset;
+ E->sphere.cap[(i-1)*3+2].theta[4] = M_PI/2.0;
+ E->sphere.cap[(i-1)*3+2].fi[1] = i*M_PI/2.0;
+ E->sphere.cap[(i-1)*3+2].fi[2] = i*M_PI/2.0 - M_PI/4.0;
+ E->sphere.cap[(i-1)*3+2].fi[3] = i*M_PI/2.0;
+ E->sphere.cap[(i-1)*3+2].fi[4] = i*M_PI/2.0 + M_PI/4.0;
+ }
+
+ for (i=1;i<=4;i++) {
+ j = (i-1)*3;
+ if (i==1) j=12;
+ E->sphere.cap[j].theta[1] = M_PI/2.0;
+ E->sphere.cap[j].theta[2] = 3*M_PI/4.0-offset;
+ E->sphere.cap[j].theta[3] = M_PI;
+ E->sphere.cap[j].theta[4] = 3*M_PI/4.0-offset;
+ E->sphere.cap[j].fi[1] = (i-1)*M_PI/2.0 + M_PI/4.0;
+ E->sphere.cap[j].fi[2] = (i-1)*M_PI/2.0;
+ E->sphere.cap[j].fi[3] = 0.0;
+ E->sphere.cap[j].fi[4] = i*M_PI/2.0;
+ }
+
+ return;
+}
Deleted: mc/3D/CitcomS/branches/cxx/lib/Full_lith_age_read_files.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Full_lith_age_read_files.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Full_lith_age_read_files.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,41 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-
-
-#include "global_defs.h"
-
-
-void full_lith_age_read_files(struct All_variables *E, int output)
-{
- void full_read_input_files_for_timesteps();
- full_read_input_files_for_timesteps(E,2,output); /*2 (=action) is for lith_age*/
- return;
-}
-
-
-/* End of file */
Copied: mc/3D/CitcomS/branches/cxx/lib/Full_lith_age_read_files.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Full_lith_age_read_files.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Full_lith_age_read_files.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Full_lith_age_read_files.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,41 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+
+
+#include "global_defs.h"
+
+#include "cproto.h"
+
+void full_lith_age_read_files(struct All_variables *E, int output)
+{
+ full_read_input_files_for_timesteps(E,2,output); /*2 (=action) is for lith_age*/
+ return;
+}
+
+
+/* End of file */
Deleted: mc/3D/CitcomS/branches/cxx/lib/Full_obsolete.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Full_obsolete.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Full_obsolete.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,1069 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-/*
- This file contains functions that are no longer used in this version of
- CitcomS. To reduce compilation time and maintenance effort, these functions
- are removed from its original location to here.
-*/
-
-
-
-/*************************************************************************/
-/* from Parallel_related.c */
-/*************************************************************************/
-
-void parallel_process_initilization(E,argc,argv)
- struct All_variables *E;
- int argc;
- char **argv;
- {
-
- E->parallel.me = 0;
- E->parallel.nproc = 1;
- E->parallel.me_loc[1] = 0;
- E->parallel.me_loc[2] = 0;
- E->parallel.me_loc[3] = 0;
-
- /* MPI_Init(&argc,&argv); moved to main{} in Citcom.c, CPC 6/16/00 */
- MPI_Comm_rank(E->parallel.world, &(E->parallel.me) );
- MPI_Comm_size(E->parallel.world, &(E->parallel.nproc) );
-
- return;
- }
-
-/* get numerical grid coordinates for each relevant processor */
-
-void parallel_domain_decomp2(E,GX)
- struct All_variables *E;
- float *GX[4];
- {
-
- return;
- }
-
-
- void scatter_to_nlayer_id (E,AUi,AUo,lev)
- struct All_variables *E;
- double **AUi,**AUo;
- int lev;
- {
-
- int i,j,k,k1,m,node1,node,eqn1,eqn,d;
-
- const int dims = E->mesh.nsd;
-
- static double *SD;
- static int been_here=0;
- static int *processors,rootid,nproc,NOZ;
-
- MPI_Status status;
-
- if (E->parallel.nprocz==1) {
- if (E->parallel.me==0) fprintf(stderr,"scatter_to_nlayer should not be called\n");
- return;
- }
-
- if (been_here==0) {
- NOZ = E->lmesh.ELZ[lev]*E->parallel.nprocz + 1;
-
- processors = (int *)malloc((E->parallel.nprocz+2)*sizeof(int));
-
- SD = (double *)malloc((E->lmesh.NEQ[lev])*sizeof(double));
-
-
- rootid = E->parallel.me_sph*E->parallel.nprocz; /* which is the bottom cpu */
- nproc = 0;
- for (j=0;j<E->parallel.nprocz;j++) {
- d = rootid + j;
- processors[nproc] = d;
- nproc ++;
- }
-
- been_here++;
- }
-
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- if (E->parallel.me==rootid)
- for (d=0;d<E->parallel.nprocz;d++) {
-
- for (k=1;k<=E->lmesh.NOZ[lev];k++) {
- k1 = k + d*E->lmesh.ELZ[lev];
- for (j=1;j<=E->lmesh.NOY[lev];j++)
- for (i=1;i<=E->lmesh.NOX[lev];i++) {
- node = k + (i-1)*E->lmesh.NOZ[lev] + (j-1)*E->lmesh.NOZ[lev]*E->lmesh.NOX[lev];
- node1= k1+ (i-1)*NOZ + (j-1)*NOZ*E->lmesh.NOX[lev];
- SD[dims*(node-1)] = AUi[m][dims*(node1-1)];
- SD[dims*(node-1)+1] = AUi[m][dims*(node1-1)+1];
- SD[dims*(node-1)+2] = AUi[m][dims*(node1-1)+2];
- }
- }
-
- if (processors[d]!=rootid) {
- MPI_Send(SD,E->lmesh.NEQ[lev],MPI_DOUBLE,processors[d],rootid,E->parallel.world);
- }
- else
- for (i=0;i<E->lmesh.NEQ[lev];i++)
- AUo[m][i] = SD[i];
- }
- else
- MPI_Recv(AUo[m],E->lmesh.NEQ[lev],MPI_DOUBLE,rootid,rootid,E->parallel.world,&status);
- }
-
- return;
- }
-
-
- void gather_to_1layer_id (E,AUi,AUo,lev)
- struct All_variables *E;
- double **AUi,**AUo;
- int lev;
- {
-
- int i,j,k,k1,m,node1,node,eqn1,eqn,d;
-
- const int dims = E->mesh.nsd;
-
- MPI_Status status;
-
- static double *RV;
- static int been_here=0;
- static int *processors,rootid,nproc,NOZ;
-
- if (E->parallel.nprocz==1) {
- if (E->parallel.me==0) fprintf(stderr,"gather_to_1layer should not be called\n");
- return;
- }
-
- if (been_here==0) {
- NOZ = E->lmesh.ELZ[lev]*E->parallel.nprocz + 1;
-
- processors = (int *)malloc((E->parallel.nprocz+2)*sizeof(int));
-
- RV = (double *)malloc((E->lmesh.NEQ[lev])*sizeof(double));
-
-
- rootid = E->parallel.me_sph*E->parallel.nprocz; /* which is the bottom cpu */
- nproc = 0;
- for (j=0;j<E->parallel.nprocz;j++) {
- d = rootid + j;
- processors[nproc] = d;
- nproc ++;
- }
-
- been_here++;
- }
-
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- if (E->parallel.me!=rootid)
- MPI_Send(AUi[m],E->lmesh.NEQ[lev],MPI_DOUBLE,rootid,E->parallel.me,E->parallel.world);
- else
- for (d=0;d<E->parallel.nprocz;d++) {
- if (processors[d]!=rootid)
- MPI_Recv(RV,E->lmesh.NEQ[lev],MPI_DOUBLE,processors[d],processors[d],E->parallel.world,&status);
- else
- for (node=0;node<E->lmesh.NEQ[lev];node++)
- RV[node] = AUi[m][node];
-
- for (k=1;k<=E->lmesh.NOZ[lev];k++) {
- k1 = k + d*E->lmesh.ELZ[lev];
- for (j=1;j<=E->lmesh.NOY[lev];j++)
- for (i=1;i<=E->lmesh.NOX[lev];i++) {
- node = k + (i-1)*E->lmesh.NOZ[lev] + (j-1)*E->lmesh.NOZ[lev]*E->lmesh.NOX[lev];
- node1 = k1 + (i-1)*NOZ + (j-1)*NOZ*E->lmesh.NOX[lev];
-
- AUo[m][dims*(node1-1)] = RV[dims*(node-1)];
- AUo[m][dims*(node1-1)+1] = RV[dims*(node-1)+1];
- AUo[m][dims*(node1-1)+2] = RV[dims*(node-1)+2];
- }
- }
- }
- }
-
- return;
- }
-
-
- void gather_to_1layer_node (E,AUi,AUo,lev)
- struct All_variables *E;
- float **AUi,**AUo;
- int lev;
- {
-
- int i,j,k,k1,m,node1,node,d;
-
- MPI_Status status;
-
- static float *RV;
- static int been_here=0;
- static int *processors,rootid,nproc,NOZ,NNO;
-
- if (E->parallel.nprocz==1) {
- if (E->parallel.me==0) fprintf(stderr,"gather_to_1layer should not be called\n");
- return;
- }
-
- if (been_here==0) {
- NOZ = E->lmesh.ELZ[lev]*E->parallel.nprocz + 1;
- NNO = NOZ*E->lmesh.NOX[lev]*E->lmesh.NOY[lev];
-
- processors = (int *)malloc((E->parallel.nprocz+2)*sizeof(int));
- RV = (float *)malloc((E->lmesh.NNO[lev]+2)*sizeof(float));
-
-
- rootid = E->parallel.me_sph*E->parallel.nprocz; /* which is the bottom cpu */
- nproc = 0;
- for (j=0;j<E->parallel.nprocz;j++) {
- d = rootid + j;
- processors[nproc] = d;
- nproc ++;
- }
-
- been_here++;
- }
-
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- if (E->parallel.me!=rootid) {
- MPI_Send(AUi[m],E->lmesh.NNO[lev]+1,MPI_FLOAT,rootid,E->parallel.me,E->parallel.world);
- for (node=1;node<=NNO;node++)
- AUo[m][node] = 1.0;
- }
- else
- for (d=0;d<E->parallel.nprocz;d++) {
- if (processors[d]!=rootid)
- MPI_Recv(RV,E->lmesh.NNO[lev]+1,MPI_FLOAT,processors[d],processors[d],E->parallel.world,&status);
- else
- for (node=1;node<=E->lmesh.NNO[lev];node++)
- RV[node] = AUi[m][node];
-
- for (k=1;k<=E->lmesh.NOZ[lev];k++) {
- k1 = k + d*E->lmesh.ELZ[lev];
- for (j=1;j<=E->lmesh.NOY[lev];j++)
- for (i=1;i<=E->lmesh.NOX[lev];i++) {
- node = k + (i-1)*E->lmesh.NOZ[lev] + (j-1)*E->lmesh.NOZ[lev]*E->lmesh.NOX[lev];
- node1 = k1 + (i-1)*NOZ + (j-1)*NOZ*E->lmesh.NOX[lev];
- AUo[m][node1] = RV[node];
- }
- }
- }
- }
-
- return;
- }
-
-
- void gather_to_1layer_ele (E,AUi,AUo,lev)
- struct All_variables *E;
- float **AUi,**AUo;
- int lev;
- {
-
- int i,j,k,k1,m,e,d,e1;
-
- MPI_Status status;
-
- static float *RV;
- static int been_here=0;
- static int *processors,rootid,nproc,NOZ,NNO;
-
- if (E->parallel.nprocz==1) {
- if (E->parallel.me==0) fprintf(stderr,"gather_to_1layer should not be called\n");
- return;
- }
-
- if (been_here==0) {
- NOZ = E->lmesh.ELZ[lev]*E->parallel.nprocz;
- NNO = NOZ*E->lmesh.ELX[lev]*E->lmesh.ELY[lev];
-
- processors = (int *)malloc((E->parallel.nprocz+2)*sizeof(int));
- RV = (float *)malloc((E->lmesh.NEL[lev]+2)*sizeof(float));
-
-
- rootid = E->parallel.me_sph*E->parallel.nprocz; /* which is the bottom cpu */
- nproc = 0;
- for (j=0;j<E->parallel.nprocz;j++) {
- d = rootid + j;
- processors[nproc] = d;
- nproc ++;
- }
-
- been_here++;
- }
-
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- if (E->parallel.me!=rootid) {
- MPI_Send(AUi[m],E->lmesh.NEL[lev]+1,MPI_FLOAT,rootid,E->parallel.me,E->parallel.world);
- for (e=1;e<=NNO;e++)
- AUo[m][e] = 1.0;
- }
- else
- for (d=0;d<E->parallel.nprocz;d++) {
- if (processors[d]!=rootid)
- MPI_Recv(RV,E->lmesh.NEL[lev]+1,MPI_FLOAT,processors[d],processors[d],E->parallel.world,&status);
- else
- for (e=1;e<=E->lmesh.NEL[lev];e++)
- RV[e] = AUi[m][e];
-
- for (k=1;k<=E->lmesh.ELZ[lev];k++) {
- k1 = k + d*E->lmesh.ELZ[lev];
- for (j=1;j<=E->lmesh.ELY[lev];j++)
- for (i=1;i<=E->lmesh.ELX[lev];i++) {
- e = k + (i-1)*E->lmesh.ELZ[lev] + (j-1)*E->lmesh.ELZ[lev]*E->lmesh.ELX[lev];
- e1 = k1 + (i-1)*NOZ + (j-1)*NOZ*E->lmesh.ELX[lev];
- AUo[m][e1] = RV[e];
- }
- }
- }
- }
-
- return;
- }
-
-
-
-void gather_TG_to_me0(E,TG)
- struct All_variables *E;
- float *TG;
- {
-
- int i,j,nsl,idb,to_everyone,from_proc,mst,me;
-
- static float *RG[20];
- static int been_here=0;
- const float e_16=1.e-16;
-
- MPI_Status status[100];
- MPI_Status status1;
- MPI_Request request[100];
-
- if (E->parallel.nprocxy==1) return;
-
- nsl = E->sphere.nsf+1;
- me = E->parallel.me;
-
- if (been_here==0) {
- been_here++;
- for (i=1;i<E->parallel.nprocxy*E->parallel.surf_proc_per_cap;i++)
- RG[i] = ( float *)malloc((E->sphere.nsf+1)*sizeof(float));
- }
-
-
- idb=0;
- for (i=1;i<=E->parallel.nprocxy*E->parallel.surf_proc_per_cap;i++) {
- to_everyone = E->parallel.nprocz*(i-1) + E->parallel.me_loc[3];
-
- if (me!=to_everyone) { /* send TG */
- idb++;
- mst = me;
- MPI_Isend(TG,nsl,MPI_FLOAT,to_everyone,mst,E->parallel.world,&request[idb-1]);
- }
- }
-
-
- idb=0;
- for (i=1;i<=E->parallel.nprocxy*E->parallel.surf_proc_per_cap;i++) {
- from_proc = E->parallel.nprocz*(i-1) + E->parallel.me_loc[3];
- if (me!=from_proc) { /* me==0 receive all TG and add them up */
- mst = from_proc;
- idb++;
- MPI_Irecv(RG[idb],nsl,MPI_FLOAT,from_proc,mst,E->parallel.world,&request[idb-1]);
- }
- }
-
- MPI_Waitall(idb,request,status);
-
- for (i=1;i<E->parallel.nprocxy*E->parallel.surf_proc_per_cap;i++)
- for (j=1;j<=E->sphere.nsf; j++) {
- if (fabs(TG[j]) < e_16) TG[j] += RG[i][j];
- }
-
- return;
- }
-
-
-
-void sum_across_depth_sph(E,sphc,sphs,dest_proc)
- struct All_variables *E;
- int dest_proc;
- float *sphc,*sphs;
- {
-
- int jumpp,i,j,nsl,idb,to_proc,from_proc,mst,me;
-
- float *RG,*TG;
-
- MPI_Status status[100];
- MPI_Status status1;
- MPI_Request request[100];
-
- if (E->parallel.nprocz==1) return;
-
- jumpp = E->sphere.hindice;
- nsl = E->sphere.hindice*2;
- me = E->parallel.me;
-
- TG = ( float *)malloc(nsl*sizeof(float));
- if (E->parallel.me_loc[3]==dest_proc)
- RG = ( float *)malloc(nsl*sizeof(float));
-
- for (i=0;i<E->sphere.hindice;i++) {
- TG[i] = sphc[i];
- TG[i+jumpp] = sphs[i];
- }
-
-
- if (E->parallel.me_loc[3]!=dest_proc) { /* send TG */
- to_proc = E->parallel.me_sph*E->parallel.nprocz+E->parallel.nprocz-1;
- mst = me;
- MPI_Send(TG,nsl,MPI_FLOAT,to_proc,mst,E->parallel.world);
- }
-
- parallel_process_sync(E);
-
- if (E->parallel.me_loc[3]==dest_proc) {
- for (i=1;i<E->parallel.nprocz;i++) {
- from_proc = me - i;
- mst = from_proc;
- MPI_Recv(RG,nsl,MPI_FLOAT,from_proc,mst,E->parallel.world,&status1);
-
- for (j=0;j<E->sphere.hindice;j++) {
- sphc[j] += RG[j];
- sphs[j] += RG[j+jumpp];
- }
- }
- }
-
- free((void *) TG);
- if (E->parallel.me_loc[3]==dest_proc)
- free((void *) RG);
-
- return;
- }
-
-
-void sum_across_surf_sph(E,TG,loc_proc)
- struct All_variables *E;
- int loc_proc;
- float *TG;
- {
-
- int i,j,nsl,idb,to_everyone,from_proc,mst,me;
-
- float *RG[20];
-
- MPI_Status status[100];
- MPI_Status status1;
- MPI_Request request[100];
-
- if (E->parallel.nprocxy==1) return;
-
- nsl = E->sphere.hindice*2;
- me = E->parallel.me;
-
- for (i=1;i<E->parallel.nprocxy*E->parallel.surf_proc_per_cap;i++)
- RG[i] = ( float *)malloc(nsl*sizeof(float));
-
-
- idb=0;
- for (i=1;i<=E->parallel.nprocxy*E->parallel.surf_proc_per_cap;i++) {
- to_everyone = E->parallel.nprocz*(i-1) + loc_proc;
-
- if (me!=to_everyone) { /* send TG */
- idb++;
- mst = me;
- MPI_Isend(TG,nsl,MPI_FLOAT,to_everyone,mst,E->parallel.world,&request[idb-1]);
- }
- }
-
-
- idb=0;
- for (i=1;i<=E->parallel.nprocxy*E->parallel.surf_proc_per_cap;i++) {
- from_proc = E->parallel.nprocz*(i-1) + loc_proc;
- if (me!=from_proc) { /* me==0 receive all TG and add them up */
- mst = from_proc;
- idb++;
- MPI_Irecv(RG[idb],nsl,MPI_FLOAT,from_proc,mst,E->parallel.world,&request[idb-1]);
- }
- }
-
- MPI_Waitall(idb,request,status);
-
- for (i=1;i<E->parallel.nprocxy*E->parallel.surf_proc_per_cap;i++)
- for (j=0;j<nsl; j++) {
- TG[j] += RG[i][j];
- }
-
-
- for (i=1;i<E->parallel.nprocxy*E->parallel.surf_proc_per_cap;i++)
- free((void *) RG[i]);
-
- return;
- }
-
-
-
-
-
-void set_communication_sphereh(E)
- struct All_variables *E;
- {
- int i;
-
- i = cases[E->sphere.caps_per_proc];
-
- E->parallel.nproc_sph[1] = incases3[i].xy[0];
- E->parallel.nproc_sph[2] = incases3[i].xy[1];
-
- E->sphere.lelx = E->sphere.elx/E->parallel.nproc_sph[1];
- E->sphere.lely = E->sphere.ely/E->parallel.nproc_sph[2];
- E->sphere.lsnel = E->sphere.lely*E->sphere.lelx;
- E->sphere.lnox = E->sphere.lelx + 1;
- E->sphere.lnoy = E->sphere.lely + 1;
- E->sphere.lnsf = E->sphere.lnox*E->sphere.lnoy;
-
- for (i=0;i<=E->parallel.nprocz-1;i++)
- if (E->parallel.me_loc[3] == i) {
- E->parallel.me_sph = (E->parallel.me-i)/E->parallel.nprocz;
- E->parallel.me_loc_sph[1] = E->parallel.me_sph%E->parallel.nproc_sph[1];
- E->parallel.me_loc_sph[2] = E->parallel.me_sph/E->parallel.nproc_sph[1];
- }
-
- E->sphere.lexs = E->sphere.lelx * E->parallel.me_loc_sph[1];
- E->sphere.leys = E->sphere.lely * E->parallel.me_loc_sph[2];
-
- return;
- }
-
-
-
-/*************************************************************************/
-/* from Process_buoyancy.c */
-/*************************************************************************/
-
-
-void process_temp_field(E,ii)
- struct All_variables *E;
- int ii;
-{
- void heat_flux();
- void output_temp();
- void process_output_field();
- int record_h;
-
- record_h = E->control.record_every;
-
- if ( (ii == 0) || ((ii % record_h) == 0) || E->control.DIRECTII) {
- heat_flux(E);
- parallel_process_sync(E);
-/* output_temp(E,ii); */
- }
-
- if ( ((ii == 0) || ((ii % E->control.record_every) == 0))
- || E->control.DIRECTII) {
- process_output_field(E,ii);
- }
-
- return;
-}
-
-
-/*************************************************************************/
-/* from Output.h */
-/*************************************************************************/
-
-void output_velo_related(E,file_number)
- struct All_variables *E;
- int file_number;
-{
- int el,els,i,j,k,ii,m,node,fd;
- int s,nox,noz,noy,size1,size2,size3;
-
- char output_file[255];
- FILE *fp1,*fp2,*fp3,*fp4,*fp5,*fp6,*fp7,*fp8;
-/* static float *SV,*EV; */
-/* float *VE[NCS],*VIN[NCS],*VN[NCS]; */
- static int been_here=0;
- int lev = E->mesh.levmax;
-
- void get_surface_velo ();
- void get_ele_visc ();
- void visc_from_ele_to_gint();
- void visc_from_gint_to_nodes();
- const int nno = E->lmesh.nno;
- const int nsd = E->mesh.nsd;
- const int vpts = vpoints[nsd];
-
-
- if (been_here==0) {
-/* ii = E->lmesh.nsf; */
-/* m = (E->parallel.me_loc[3]==0)?ii:0; */
-/* SV = (float *) malloc ((2*m+2)*sizeof(float)); */
-
- /* size2 = (E->lmesh.nel+1)*sizeof(float); */
- /* use the line from the original CitcomS */
-
- sprintf(output_file,"%s.coord.%d",E->control.data_file,E->parallel.me);
- fp1=fopen(output_file,"w");
- if (fp1 == NULL) {
- fprintf(E->fp,"(Output.c #1) Cannot open %s\n",output_file);
- exit(8);
- }
- for(j=1;j<=E->sphere.caps_per_proc;j++) {
- fprintf(fp1,"%3d %7d\n",j,E->lmesh.nno);
- for(i=1;i<=E->lmesh.nno;i++)
- fprintf(fp1,"%.3e %.3e %.3e\n",E->sx[j][1][i],E->sx[j][2][i],E->sx[j][3][i]);
- }
- fclose(fp1);
-
- been_here++;
- }
-
-
- sprintf(output_file,"%s.visc.%d.%d",E->control.data_file,E->parallel.me,file_number);
- fp1=fopen(output_file,"w");
- for(j=1;j<=E->sphere.caps_per_proc;j++) {
- fprintf(fp1,"%3d %7d\n",j,E->lmesh.nno);
- for(i=1;i<=E->lmesh.nno;i++)
- fprintf(fp1,"%.3e\n",E->VI[lev][j][i]);
-
- }
- fclose(fp1);
-
- sprintf(output_file,"%s.velo.%d.%d",E->control.data_file,E->parallel.me,file_number);
- fp1=fopen(output_file,"w");
- fprintf(fp1,"%d %d %.5e\n",file_number,E->lmesh.nno,E->monitor.elapsed_time);
- for(j=1;j<=E->sphere.caps_per_proc;j++) {
- fprintf(fp1,"%3d %7d\n",j,E->lmesh.nno);
- for(i=1;i<=E->lmesh.nno;i++)
- fprintf(fp1,"%.6e %.6e %.6e %.6e\n",E->sphere.cap[j].V[1][i],E->sphere.cap[j].V[2][i],E->sphere.cap[j].V[3][i],E->T[j][i]);
- /* for(i=1;i<=E->lmesh.nno;i++)
- fprintf(fp1,"%.6e\n",E->T[j][i]); */
- }
-
- fclose(fp1);
-
- if (E->parallel.me_loc[3]==E->parallel.nprocz-1) {
- sprintf(output_file,"%s.surf.%d.%d",E->control.data_file,E->parallel.me,file_number);
- fp2=fopen(output_file,"w");
- for(j=1;j<=E->sphere.caps_per_proc;j++) {
- fprintf(fp2,"%3d %7d\n",j,E->lmesh.nsf);
- for(i=1;i<=E->lmesh.nsf;i++) {
- s = i*E->lmesh.noz;
- fprintf(fp2,"%.4e %.4e %.4e %.4e\n",E->slice.tpg[j][i],E->slice.shflux[j][i],E->sphere.cap[j].V[1][s],E->sphere.cap[j].V[2][s]);
- }
- }
- fclose(fp2);
-
- }
-
- if (E->parallel.me_loc[3]==0) {
- sprintf(output_file,"%s.botm.%d.%d",E->control.data_file,E->parallel.me,file_number);
- fp2=fopen(output_file,"w");
- for(j=1;j<=E->sphere.caps_per_proc;j++) {
- fprintf(fp2,"%3d %7d\n",j,E->lmesh.nsf);
- for(i=1;i<=E->lmesh.nsf;i++) {
- s = (i-1)*E->lmesh.noz + 1;
- fprintf(fp2,"%.4e %.4e %.4e %.4e\n",E->slice.tpgb[j][i],E->slice.bhflux[j][i],E->sphere.cap[j].V[1][s],E->sphere.cap[j].V[2][s]);
- }
- }
- fclose(fp2);
- }
-
- /* remove horizontal average output by Tan2 Mar. 1 2002 */
-
-/* if (E->parallel.me<E->parallel.nprocz) { */
-/* sprintf(output_file,"%s.ave_r.%d.%d",E->control.data_file,E->parallel.me,file_number); */
-/* fp2=fopen(output_file,"w"); */
-/* for(j=1;j<=E->lmesh.noz;j++) { */
-/* fprintf(fp2,"%.4e %.4e %.4e %.4e\n",E->sx[1][3][j],E->Have.T[j],E->Have.V[1][j],E->Have.V[2][j]); */
-/* } */
-/* fclose(fp2); */
-/* } */
-
- return;
- }
-
-
-
-void output_temp(E,file_number)
- struct All_variables *E;
- int file_number;
-{
- int m,nno,i,j,fd;
- static int *temp1;
- static int been_here=0;
- static int size2,size1;
- char output_file[255];
-
- return;
-}
-
-
-
-void output_stress(E,file_number,SXX,SYY,SZZ,SXY,SXZ,SZY)
- struct All_variables *E;
- int file_number;
- float *SXX,*SYY,*SZZ,*SXY,*SXZ,*SZY;
-{
- int i,j,k,ii,m,fd,size2;
- int nox,noz,noy;
- char output_file[255];
-
- size2= (E->lmesh.nno+1)*sizeof(float);
-
- sprintf(output_file,"%s.%05d.SZZ",E->control.data_file,file_number);
- fd=open(output_file,O_RDWR | O_CREAT, 0644);
- write(fd,SZZ,size2);
- close (fd);
-
- return;
- }
-
-
-
-void print_field_spectral_regular(E,TG,sphc,sphs,proc_loc,filen)
- struct All_variables *E;
- float *TG,*sphc,*sphs;
- int proc_loc;
- char * filen;
- {
- FILE *fp,*fp1;
- char output_file[255];
- int i,node,j,ll,mm;
- float minx,maxx,t,f,rad;
- rad = 180.0/M_PI;
-
- maxx=-1.e26;
- minx=1.e26;
- if (E->parallel.me==proc_loc) {
-
- sprintf(output_file,"%s.%s_intp",E->control.data_file,filen);
- fp=fopen(output_file,"w");
- for (i=E->sphere.nox;i>=1;i--)
- for (j=1;j<=E->sphere.noy;j++) {
- node = i + (j-1)*E->sphere.nox;
- t = 90-E->sphere.sx[1][node]*rad;
- f = E->sphere.sx[2][node]*rad;
- fprintf (fp,"%.3e %.3e %.4e\n",f,t,TG[node]);
- if(TG[node]>maxx)maxx=TG[node];
- if(TG[node]<minx)minx=TG[node];
- }
- fprintf(stderr,"lmaxx=%.4e lminx=%.4e for %s\n",maxx,minx,filen);
- fprintf(E->fp,"lmaxx=%.4e lminx=%.4e for %s\n",maxx,minx,filen);
- fclose(fp);
-
- sprintf(output_file,"%s.%s_sharm",E->control.data_file,filen);
- fp1=fopen(output_file,"w");
- fprintf(fp1,"lmaxx=%.4e lminx=%.4e for %s\n",maxx,minx,filen);
- fprintf(fp1," ll mm cos sin \n");
- for (ll=0;ll<=E->output.llmax;ll++)
- for(mm=0;mm<=ll;mm++) {
- i = E->sphere.hindex[ll][mm];
- fprintf(fp1,"%3d %3d %.4e %.4e \n",ll,mm,sphc[i],sphs[i]);
- }
-
- fclose(fp1);
- }
-
-
- return;
- }
-
-
-
-/*************************************************************************/
-/* from Full_tracer_advection.c */
-/*************************************************************************/
-
-
-
-/* */
-/* This function writes the radial distribution of tracers */
-/* (horizontally averaged) */
-
-void write_radial_horizontal_averages(E)
- struct All_variables *E;
-{
-
- char output_file[200];
-
- int j;
- int kk;
- double halfpoint;
- double *reltrac[13];
-
- static int been_here=0;
-
- void return_horiz_ave();
- void return_elementwise_horiz_ave();
-
- FILE *fp2;
-
- if (been_here==0)
- {
- E->trace.Have_C=(double *)malloc((E->lmesh.noz+2)*sizeof(double));
- E->trace.Havel_tracers=(double *)malloc((E->lmesh.elz+2)*sizeof(double));
- }
-
- /* Tracers */
-
- /* first, change from int to double */
-
- for (j=1;j<=E->sphere.caps_per_proc;j++)
- {
- reltrac[j]=(double *) malloc((E->lmesh.nel+1)*sizeof(double));
- for (kk=1;kk<=E->lmesh.nel;kk++)
- {
- reltrac[j][kk]=(1.0*E->composition.ieltrac[j][kk]);
- }
- }
-
- return_elementwise_horiz_ave(E,reltrac,E->trace.Havel_tracers);
-
- for (j=1;j<=E->sphere.caps_per_proc;j++)
- {
- free(reltrac[j]);
- }
-
- if (E->parallel.me<E->parallel.nprocz)
- {
- sprintf(output_file,"%s.ave_tracers.%d.%d",E->control.data_file,E->parallel.me,E->monitor.solution_cycles);
- fp2=fopen(output_file,"w");
- for(kk=1;kk<=E->lmesh.elz;kk++)
- {
- halfpoint=0.5*(E->sx[1][3][kk+1]+E->sx[1][3][kk]);
- fprintf(fp2,"%.4e %.4e\n",halfpoint,E->trace.Havel_tracers[kk]);
- }
- fclose(fp2);
- }
-
- /* Composition */
-
- if (E->composition.chemical_buoyancy==1)
- {
- return_horiz_ave(E,E->composition.comp_node,E->trace.Have_C);
-
-
- if (E->parallel.me<E->parallel.nprocz)
- {
- sprintf(output_file,"%s.ave_c.%d.%d",E->control.data_file,E->parallel.me,E->monitor.solution_cycles);
- fp2=fopen(output_file,"w");
- for(kk=1;kk<=E->lmesh.noz;kk++)
- {
- fprintf(fp2,"%.4e %.4e\n",E->sx[1][3][kk],E->trace.Have_C[kk]);
- }
- fclose(fp2);
-
- }
- }
-
- been_here++;
-
- return;
-}
-
-
-/****** ICHECK REGULAR NEIGHBORS *****************************/
-/* */
-/* This function searches the regular element neighborhood. */
-
-/* This function is no longer used! */
-
-int icheck_regular_neighbors(E,j,ntheta,nphi,x,y,z,theta,phi,rad)
- struct All_variables *E;
- int j,ntheta,nphi;
- double x,y,z;
- double theta,phi,rad;
-{
-
- int new_ntheta,new_nphi;
- int kk,pp;
- int iregel;
- int ival;
- int imap[5];
- int ichoice;
- int irange;
-
- int iquick_element_column_search();
-
- fprintf(E->trace.fpt,"ERROR(icheck_regular_neighbors)-this subroutine is no longer used !\n");
- fflush(E->trace.fpt);
- exit(10);
-
- irange=2;
-
- for (kk=-irange;kk<=irange;kk++)
- {
- for (pp=-irange;pp<=irange;pp++)
- {
- new_ntheta=ntheta+kk;
- new_nphi=nphi+pp;
- if ( (new_ntheta>0)&&(new_ntheta<=E->trace.numtheta[j])&&(new_nphi>0)&&(new_nphi<=E->trace.numphi[j]) )
- {
- iregel=new_ntheta+(new_nphi-1)*E->trace.numtheta[j];
- if ((iregel>0) && (iregel<=E->trace.numregel[j]))
- {
- ival=iquick_element_column_search(E,j,iregel,new_ntheta,new_nphi,x,y,z,theta,phi,rad,imap,&ichoice);
- if (ival>0) return ival;
- }
- }
- }
- }
-
-
- return -99;
-}
-
-
-/****** IQUICK ELEMENT SEARCH *****************************/
-/* */
-/* This function does a quick regular to real element */
-/* map check. Element number, if found, is returned. */
-/* Otherwise, -99 is returned. */
-/* Pointers to imap and ichoice are used because they may */
-/* prove to be convenient. */
-/* This routine is no longer used */
-
-int iquick_element_column_search(E,j,iregel,ntheta,nphi,x,y,z,theta,phi,rad,imap,ich)
- struct All_variables *E;
- int j,iregel;
- int ntheta,nphi;
- double x,y,z,theta,phi,rad;
- int *imap;
- int *ich;
-{
-
- int iregnode[5];
- int kk,pp;
- int nel,ival;
- int ichoice;
- int icount;
- int itemp1;
- int itemp2;
-
- int icheck_element_column();
-
- fprintf(E->trace.fpt,"ERROR(iquick element)-this routine is no longer used!\n");
- fflush(E->trace.fpt);
- exit(10);
-
- /* REMOVE*/
- /*
- ichoice=*ich;
-
- fprintf(E->trace.fpt,"AA: ichoice: %d\n",ichoice);
- fflush(E->trace.fpt);
- */
-
- /* find regular nodes on regular element */
-
- /*
- iregnode[1]=iregel+(nphi-1);
- iregnode[2]=iregel+nphi;
- iregnode[3]=iregel+nphi+E->trace.numtheta[j]+1;
- iregnode[4]=iregel+nphi+E->trace.numtheta[j];
- */
-
- itemp1=iregel+nphi;
- itemp2=itemp1+E->trace.numtheta[j];
-
- iregnode[1]=itemp1-1;
- iregnode[2]=itemp1;
- iregnode[3]=itemp2+1;
- iregnode[4]=itemp2;
-
- for (kk=1;kk<=4;kk++)
- {
- if ((iregnode[kk]<1) || (iregnode[kk]>E->trace.numregnodes[j]) )
- {
- fprintf(E->trace.fpt,"ERROR(iquick)-weird regnode %d\n",iregnode[kk]);
- fflush(E->trace.fpt);
- exit(10);
- }
- }
-
- /* find number of choices */
-
- ichoice=0;
- icount=0;
- for (kk=1;kk<=4;kk++)
- {
- if (E->trace.regnodetoel[j][iregnode[kk]]<=0) goto next_corner;
-
- icount++;
- for (pp=1;pp<=(kk-1);pp++)
- {
- if (E->trace.regnodetoel[j][iregnode[kk]]==E->trace.regnodetoel[j][iregnode[pp]]) goto next_corner;
- }
- ichoice++;
- imap[ichoice]=E->trace.regnodetoel[j][iregnode[kk]];
-
-
- next_corner:
- ;
- } /* end kk */
-
- *ich=ichoice;
-
- /* statistical counter */
-
- E->trace.istat_ichoice[j][ichoice]++;
-
- if (ichoice==0) return -99;
-
- /* Here, no check is performed if all 4 corners */
- /* lie within a given element. */
- /* It may be possible (not sure) but unlikely */
- /* that the tracer is still not in that element */
-
- /* Decided to comment this out. */
- /* May not be valid for large regular grids. */
- /*
- */
- /* AKMA */
-
- if ((ichoice==1)&&(icount==4)) return imap[1];
-
- /* check others */
-
- for (kk=1;kk<=ichoice;kk++)
- {
- nel=imap[kk];
- ival=icheck_element_column(E,j,nel,x,y,z,rad);
- if (ival>0) return nel;
- }
-
- /* if still here, no element was found */
-
- return -99;
-}
-
-
-/*************************************************************************/
-/* from */
-/*************************************************************************/
-
Copied: mc/3D/CitcomS/branches/cxx/lib/Full_obsolete.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Full_obsolete.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Full_obsolete.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Full_obsolete.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,1069 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+/*
+ This file contains functions that are no longer used in this version of
+ CitcomS. To reduce compilation time and maintenance effort, these functions
+ are removed from its original location to here.
+*/
+
+
+
+/*************************************************************************/
+/* from Parallel_related.c */
+/*************************************************************************/
+
+void parallel_process_initilization(E,argc,argv)
+ struct All_variables *E;
+ int argc;
+ char **argv;
+ {
+
+ E->parallel.me = 0;
+ E->parallel.nproc = 1;
+ E->parallel.me_loc[1] = 0;
+ E->parallel.me_loc[2] = 0;
+ E->parallel.me_loc[3] = 0;
+
+ /* MPI_Init(&argc,&argv); moved to main{} in Citcom.c, CPC 6/16/00 */
+ MPI_Comm_rank(E->parallel.world, &(E->parallel.me) );
+ MPI_Comm_size(E->parallel.world, &(E->parallel.nproc) );
+
+ return;
+ }
+
+/* get numerical grid coordinates for each relevant processor */
+
+void parallel_domain_decomp2(E,GX)
+ struct All_variables *E;
+ float *GX[4];
+ {
+
+ return;
+ }
+
+
+ void scatter_to_nlayer_id (E,AUi,AUo,lev)
+ struct All_variables *E;
+ double **AUi,**AUo;
+ int lev;
+ {
+
+ int i,j,k,k1,m,node1,node,eqn1,eqn,d;
+
+ const int dims = E->mesh.nsd;
+
+ static double *SD;
+ static int been_here=0;
+ static int *processors,rootid,nproc,NOZ;
+
+ MPI_Status status;
+
+ if (E->parallel.nprocz==1) {
+ if (E->parallel.me==0) fprintf(stderr,"scatter_to_nlayer should not be called\n");
+ return;
+ }
+
+ if (been_here==0) {
+ NOZ = E->lmesh.ELZ[lev]*E->parallel.nprocz + 1;
+
+ processors = (int *)malloc((E->parallel.nprocz+2)*sizeof(int));
+
+ SD = (double *)malloc((E->lmesh.NEQ[lev])*sizeof(double));
+
+
+ rootid = E->parallel.me_sph*E->parallel.nprocz; /* which is the bottom cpu */
+ nproc = 0;
+ for (j=0;j<E->parallel.nprocz;j++) {
+ d = rootid + j;
+ processors[nproc] = d;
+ nproc ++;
+ }
+
+ been_here++;
+ }
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ if (E->parallel.me==rootid)
+ for (d=0;d<E->parallel.nprocz;d++) {
+
+ for (k=1;k<=E->lmesh.NOZ[lev];k++) {
+ k1 = k + d*E->lmesh.ELZ[lev];
+ for (j=1;j<=E->lmesh.NOY[lev];j++)
+ for (i=1;i<=E->lmesh.NOX[lev];i++) {
+ node = k + (i-1)*E->lmesh.NOZ[lev] + (j-1)*E->lmesh.NOZ[lev]*E->lmesh.NOX[lev];
+ node1= k1+ (i-1)*NOZ + (j-1)*NOZ*E->lmesh.NOX[lev];
+ SD[dims*(node-1)] = AUi[m][dims*(node1-1)];
+ SD[dims*(node-1)+1] = AUi[m][dims*(node1-1)+1];
+ SD[dims*(node-1)+2] = AUi[m][dims*(node1-1)+2];
+ }
+ }
+
+ if (processors[d]!=rootid) {
+ MPI_Send(SD,E->lmesh.NEQ[lev],MPI_DOUBLE,processors[d],rootid,E->parallel.world);
+ }
+ else
+ for (i=0;i<E->lmesh.NEQ[lev];i++)
+ AUo[m][i] = SD[i];
+ }
+ else
+ MPI_Recv(AUo[m],E->lmesh.NEQ[lev],MPI_DOUBLE,rootid,rootid,E->parallel.world,&status);
+ }
+
+ return;
+ }
+
+
+ void gather_to_1layer_id (E,AUi,AUo,lev)
+ struct All_variables *E;
+ double **AUi,**AUo;
+ int lev;
+ {
+
+ int i,j,k,k1,m,node1,node,eqn1,eqn,d;
+
+ const int dims = E->mesh.nsd;
+
+ MPI_Status status;
+
+ static double *RV;
+ static int been_here=0;
+ static int *processors,rootid,nproc,NOZ;
+
+ if (E->parallel.nprocz==1) {
+ if (E->parallel.me==0) fprintf(stderr,"gather_to_1layer should not be called\n");
+ return;
+ }
+
+ if (been_here==0) {
+ NOZ = E->lmesh.ELZ[lev]*E->parallel.nprocz + 1;
+
+ processors = (int *)malloc((E->parallel.nprocz+2)*sizeof(int));
+
+ RV = (double *)malloc((E->lmesh.NEQ[lev])*sizeof(double));
+
+
+ rootid = E->parallel.me_sph*E->parallel.nprocz; /* which is the bottom cpu */
+ nproc = 0;
+ for (j=0;j<E->parallel.nprocz;j++) {
+ d = rootid + j;
+ processors[nproc] = d;
+ nproc ++;
+ }
+
+ been_here++;
+ }
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ if (E->parallel.me!=rootid)
+ MPI_Send(AUi[m],E->lmesh.NEQ[lev],MPI_DOUBLE,rootid,E->parallel.me,E->parallel.world);
+ else
+ for (d=0;d<E->parallel.nprocz;d++) {
+ if (processors[d]!=rootid)
+ MPI_Recv(RV,E->lmesh.NEQ[lev],MPI_DOUBLE,processors[d],processors[d],E->parallel.world,&status);
+ else
+ for (node=0;node<E->lmesh.NEQ[lev];node++)
+ RV[node] = AUi[m][node];
+
+ for (k=1;k<=E->lmesh.NOZ[lev];k++) {
+ k1 = k + d*E->lmesh.ELZ[lev];
+ for (j=1;j<=E->lmesh.NOY[lev];j++)
+ for (i=1;i<=E->lmesh.NOX[lev];i++) {
+ node = k + (i-1)*E->lmesh.NOZ[lev] + (j-1)*E->lmesh.NOZ[lev]*E->lmesh.NOX[lev];
+ node1 = k1 + (i-1)*NOZ + (j-1)*NOZ*E->lmesh.NOX[lev];
+
+ AUo[m][dims*(node1-1)] = RV[dims*(node-1)];
+ AUo[m][dims*(node1-1)+1] = RV[dims*(node-1)+1];
+ AUo[m][dims*(node1-1)+2] = RV[dims*(node-1)+2];
+ }
+ }
+ }
+ }
+
+ return;
+ }
+
+
+ void gather_to_1layer_node (E,AUi,AUo,lev)
+ struct All_variables *E;
+ float **AUi,**AUo;
+ int lev;
+ {
+
+ int i,j,k,k1,m,node1,node,d;
+
+ MPI_Status status;
+
+ static float *RV;
+ static int been_here=0;
+ static int *processors,rootid,nproc,NOZ,NNO;
+
+ if (E->parallel.nprocz==1) {
+ if (E->parallel.me==0) fprintf(stderr,"gather_to_1layer should not be called\n");
+ return;
+ }
+
+ if (been_here==0) {
+ NOZ = E->lmesh.ELZ[lev]*E->parallel.nprocz + 1;
+ NNO = NOZ*E->lmesh.NOX[lev]*E->lmesh.NOY[lev];
+
+ processors = (int *)malloc((E->parallel.nprocz+2)*sizeof(int));
+ RV = (float *)malloc((E->lmesh.NNO[lev]+2)*sizeof(float));
+
+
+ rootid = E->parallel.me_sph*E->parallel.nprocz; /* which is the bottom cpu */
+ nproc = 0;
+ for (j=0;j<E->parallel.nprocz;j++) {
+ d = rootid + j;
+ processors[nproc] = d;
+ nproc ++;
+ }
+
+ been_here++;
+ }
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ if (E->parallel.me!=rootid) {
+ MPI_Send(AUi[m],E->lmesh.NNO[lev]+1,MPI_FLOAT,rootid,E->parallel.me,E->parallel.world);
+ for (node=1;node<=NNO;node++)
+ AUo[m][node] = 1.0;
+ }
+ else
+ for (d=0;d<E->parallel.nprocz;d++) {
+ if (processors[d]!=rootid)
+ MPI_Recv(RV,E->lmesh.NNO[lev]+1,MPI_FLOAT,processors[d],processors[d],E->parallel.world,&status);
+ else
+ for (node=1;node<=E->lmesh.NNO[lev];node++)
+ RV[node] = AUi[m][node];
+
+ for (k=1;k<=E->lmesh.NOZ[lev];k++) {
+ k1 = k + d*E->lmesh.ELZ[lev];
+ for (j=1;j<=E->lmesh.NOY[lev];j++)
+ for (i=1;i<=E->lmesh.NOX[lev];i++) {
+ node = k + (i-1)*E->lmesh.NOZ[lev] + (j-1)*E->lmesh.NOZ[lev]*E->lmesh.NOX[lev];
+ node1 = k1 + (i-1)*NOZ + (j-1)*NOZ*E->lmesh.NOX[lev];
+ AUo[m][node1] = RV[node];
+ }
+ }
+ }
+ }
+
+ return;
+ }
+
+
+ void gather_to_1layer_ele (E,AUi,AUo,lev)
+ struct All_variables *E;
+ float **AUi,**AUo;
+ int lev;
+ {
+
+ int i,j,k,k1,m,e,d,e1;
+
+ MPI_Status status;
+
+ static float *RV;
+ static int been_here=0;
+ static int *processors,rootid,nproc,NOZ,NNO;
+
+ if (E->parallel.nprocz==1) {
+ if (E->parallel.me==0) fprintf(stderr,"gather_to_1layer should not be called\n");
+ return;
+ }
+
+ if (been_here==0) {
+ NOZ = E->lmesh.ELZ[lev]*E->parallel.nprocz;
+ NNO = NOZ*E->lmesh.ELX[lev]*E->lmesh.ELY[lev];
+
+ processors = (int *)malloc((E->parallel.nprocz+2)*sizeof(int));
+ RV = (float *)malloc((E->lmesh.NEL[lev]+2)*sizeof(float));
+
+
+ rootid = E->parallel.me_sph*E->parallel.nprocz; /* which is the bottom cpu */
+ nproc = 0;
+ for (j=0;j<E->parallel.nprocz;j++) {
+ d = rootid + j;
+ processors[nproc] = d;
+ nproc ++;
+ }
+
+ been_here++;
+ }
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ if (E->parallel.me!=rootid) {
+ MPI_Send(AUi[m],E->lmesh.NEL[lev]+1,MPI_FLOAT,rootid,E->parallel.me,E->parallel.world);
+ for (e=1;e<=NNO;e++)
+ AUo[m][e] = 1.0;
+ }
+ else
+ for (d=0;d<E->parallel.nprocz;d++) {
+ if (processors[d]!=rootid)
+ MPI_Recv(RV,E->lmesh.NEL[lev]+1,MPI_FLOAT,processors[d],processors[d],E->parallel.world,&status);
+ else
+ for (e=1;e<=E->lmesh.NEL[lev];e++)
+ RV[e] = AUi[m][e];
+
+ for (k=1;k<=E->lmesh.ELZ[lev];k++) {
+ k1 = k + d*E->lmesh.ELZ[lev];
+ for (j=1;j<=E->lmesh.ELY[lev];j++)
+ for (i=1;i<=E->lmesh.ELX[lev];i++) {
+ e = k + (i-1)*E->lmesh.ELZ[lev] + (j-1)*E->lmesh.ELZ[lev]*E->lmesh.ELX[lev];
+ e1 = k1 + (i-1)*NOZ + (j-1)*NOZ*E->lmesh.ELX[lev];
+ AUo[m][e1] = RV[e];
+ }
+ }
+ }
+ }
+
+ return;
+ }
+
+
+
+void gather_TG_to_me0(E,TG)
+ struct All_variables *E;
+ float *TG;
+ {
+
+ int i,j,nsl,idb,to_everyone,from_proc,mst,me;
+
+ static float *RG[20];
+ static int been_here=0;
+ const float e_16=1.e-16;
+
+ MPI_Status status[100];
+ MPI_Status status1;
+ MPI_Request request[100];
+
+ if (E->parallel.nprocxy==1) return;
+
+ nsl = E->sphere.nsf+1;
+ me = E->parallel.me;
+
+ if (been_here==0) {
+ been_here++;
+ for (i=1;i<E->parallel.nprocxy*E->parallel.surf_proc_per_cap;i++)
+ RG[i] = ( float *)malloc((E->sphere.nsf+1)*sizeof(float));
+ }
+
+
+ idb=0;
+ for (i=1;i<=E->parallel.nprocxy*E->parallel.surf_proc_per_cap;i++) {
+ to_everyone = E->parallel.nprocz*(i-1) + E->parallel.me_loc[3];
+
+ if (me!=to_everyone) { /* send TG */
+ idb++;
+ mst = me;
+ MPI_Isend(TG,nsl,MPI_FLOAT,to_everyone,mst,E->parallel.world,&request[idb-1]);
+ }
+ }
+
+
+ idb=0;
+ for (i=1;i<=E->parallel.nprocxy*E->parallel.surf_proc_per_cap;i++) {
+ from_proc = E->parallel.nprocz*(i-1) + E->parallel.me_loc[3];
+ if (me!=from_proc) { /* me==0 receive all TG and add them up */
+ mst = from_proc;
+ idb++;
+ MPI_Irecv(RG[idb],nsl,MPI_FLOAT,from_proc,mst,E->parallel.world,&request[idb-1]);
+ }
+ }
+
+ MPI_Waitall(idb,request,status);
+
+ for (i=1;i<E->parallel.nprocxy*E->parallel.surf_proc_per_cap;i++)
+ for (j=1;j<=E->sphere.nsf; j++) {
+ if (fabs(TG[j]) < e_16) TG[j] += RG[i][j];
+ }
+
+ return;
+ }
+
+
+
+void sum_across_depth_sph(E,sphc,sphs,dest_proc)
+ struct All_variables *E;
+ int dest_proc;
+ float *sphc,*sphs;
+ {
+
+ int jumpp,i,j,nsl,idb,to_proc,from_proc,mst,me;
+
+ float *RG,*TG;
+
+ MPI_Status status[100];
+ MPI_Status status1;
+ MPI_Request request[100];
+
+ if (E->parallel.nprocz==1) return;
+
+ jumpp = E->sphere.hindice;
+ nsl = E->sphere.hindice*2;
+ me = E->parallel.me;
+
+ TG = ( float *)malloc(nsl*sizeof(float));
+ if (E->parallel.me_loc[3]==dest_proc)
+ RG = ( float *)malloc(nsl*sizeof(float));
+
+ for (i=0;i<E->sphere.hindice;i++) {
+ TG[i] = sphc[i];
+ TG[i+jumpp] = sphs[i];
+ }
+
+
+ if (E->parallel.me_loc[3]!=dest_proc) { /* send TG */
+ to_proc = E->parallel.me_sph*E->parallel.nprocz+E->parallel.nprocz-1;
+ mst = me;
+ MPI_Send(TG,nsl,MPI_FLOAT,to_proc,mst,E->parallel.world);
+ }
+
+ parallel_process_sync(E);
+
+ if (E->parallel.me_loc[3]==dest_proc) {
+ for (i=1;i<E->parallel.nprocz;i++) {
+ from_proc = me - i;
+ mst = from_proc;
+ MPI_Recv(RG,nsl,MPI_FLOAT,from_proc,mst,E->parallel.world,&status1);
+
+ for (j=0;j<E->sphere.hindice;j++) {
+ sphc[j] += RG[j];
+ sphs[j] += RG[j+jumpp];
+ }
+ }
+ }
+
+ free((void *) TG);
+ if (E->parallel.me_loc[3]==dest_proc)
+ free((void *) RG);
+
+ return;
+ }
+
+
+void sum_across_surf_sph(E,TG,loc_proc)
+ struct All_variables *E;
+ int loc_proc;
+ float *TG;
+ {
+
+ int i,j,nsl,idb,to_everyone,from_proc,mst,me;
+
+ float *RG[20];
+
+ MPI_Status status[100];
+ MPI_Status status1;
+ MPI_Request request[100];
+
+ if (E->parallel.nprocxy==1) return;
+
+ nsl = E->sphere.hindice*2;
+ me = E->parallel.me;
+
+ for (i=1;i<E->parallel.nprocxy*E->parallel.surf_proc_per_cap;i++)
+ RG[i] = ( float *)malloc(nsl*sizeof(float));
+
+
+ idb=0;
+ for (i=1;i<=E->parallel.nprocxy*E->parallel.surf_proc_per_cap;i++) {
+ to_everyone = E->parallel.nprocz*(i-1) + loc_proc;
+
+ if (me!=to_everyone) { /* send TG */
+ idb++;
+ mst = me;
+ MPI_Isend(TG,nsl,MPI_FLOAT,to_everyone,mst,E->parallel.world,&request[idb-1]);
+ }
+ }
+
+
+ idb=0;
+ for (i=1;i<=E->parallel.nprocxy*E->parallel.surf_proc_per_cap;i++) {
+ from_proc = E->parallel.nprocz*(i-1) + loc_proc;
+ if (me!=from_proc) { /* me==0 receive all TG and add them up */
+ mst = from_proc;
+ idb++;
+ MPI_Irecv(RG[idb],nsl,MPI_FLOAT,from_proc,mst,E->parallel.world,&request[idb-1]);
+ }
+ }
+
+ MPI_Waitall(idb,request,status);
+
+ for (i=1;i<E->parallel.nprocxy*E->parallel.surf_proc_per_cap;i++)
+ for (j=0;j<nsl; j++) {
+ TG[j] += RG[i][j];
+ }
+
+
+ for (i=1;i<E->parallel.nprocxy*E->parallel.surf_proc_per_cap;i++)
+ free((void *) RG[i]);
+
+ return;
+ }
+
+
+
+
+
+void set_communication_sphereh(E)
+ struct All_variables *E;
+ {
+ int i;
+
+ i = cases[E->sphere.caps_per_proc];
+
+ E->parallel.nproc_sph[1] = incases3[i].xy[0];
+ E->parallel.nproc_sph[2] = incases3[i].xy[1];
+
+ E->sphere.lelx = E->sphere.elx/E->parallel.nproc_sph[1];
+ E->sphere.lely = E->sphere.ely/E->parallel.nproc_sph[2];
+ E->sphere.lsnel = E->sphere.lely*E->sphere.lelx;
+ E->sphere.lnox = E->sphere.lelx + 1;
+ E->sphere.lnoy = E->sphere.lely + 1;
+ E->sphere.lnsf = E->sphere.lnox*E->sphere.lnoy;
+
+ for (i=0;i<=E->parallel.nprocz-1;i++)
+ if (E->parallel.me_loc[3] == i) {
+ E->parallel.me_sph = (E->parallel.me-i)/E->parallel.nprocz;
+ E->parallel.me_loc_sph[1] = E->parallel.me_sph%E->parallel.nproc_sph[1];
+ E->parallel.me_loc_sph[2] = E->parallel.me_sph/E->parallel.nproc_sph[1];
+ }
+
+ E->sphere.lexs = E->sphere.lelx * E->parallel.me_loc_sph[1];
+ E->sphere.leys = E->sphere.lely * E->parallel.me_loc_sph[2];
+
+ return;
+ }
+
+
+
+/*************************************************************************/
+/* from Process_buoyancy.c */
+/*************************************************************************/
+
+
+void process_temp_field(E,ii)
+ struct All_variables *E;
+ int ii;
+{
+ void heat_flux();
+ void output_temp();
+ void process_output_field();
+ int record_h;
+
+ record_h = E->control.record_every;
+
+ if ( (ii == 0) || ((ii % record_h) == 0) || E->control.DIRECTII) {
+ heat_flux(E);
+ parallel_process_sync(E);
+/* output_temp(E,ii); */
+ }
+
+ if ( ((ii == 0) || ((ii % E->control.record_every) == 0))
+ || E->control.DIRECTII) {
+ process_output_field(E,ii);
+ }
+
+ return;
+}
+
+
+/*************************************************************************/
+/* from Output.h */
+/*************************************************************************/
+
+void output_velo_related(E,file_number)
+ struct All_variables *E;
+ int file_number;
+{
+ int el,els,i,j,k,ii,m,node,fd;
+ int s,nox,noz,noy,size1,size2,size3;
+
+ char output_file[255];
+ FILE *fp1,*fp2,*fp3,*fp4,*fp5,*fp6,*fp7,*fp8;
+/* static float *SV,*EV; */
+/* float *VE[NCS],*VIN[NCS],*VN[NCS]; */
+ static int been_here=0;
+ int lev = E->mesh.levmax;
+
+ void get_surface_velo ();
+ void get_ele_visc ();
+ void visc_from_ele_to_gint();
+ void visc_from_gint_to_nodes();
+ const int nno = E->lmesh.nno;
+ const int nsd = E->mesh.nsd;
+ const int vpts = vpoints[nsd];
+
+
+ if (been_here==0) {
+/* ii = E->lmesh.nsf; */
+/* m = (E->parallel.me_loc[3]==0)?ii:0; */
+/* SV = (float *) malloc ((2*m+2)*sizeof(float)); */
+
+ /* size2 = (E->lmesh.nel+1)*sizeof(float); */
+ /* use the line from the original CitcomS */
+
+ sprintf(output_file,"%s.coord.%d",E->control.data_file,E->parallel.me);
+ fp1=fopen(output_file,"w");
+ if (fp1 == NULL) {
+ fprintf(E->fp,"(Output.c #1) Cannot open %s\n",output_file);
+ exit(8);
+ }
+ for(j=1;j<=E->sphere.caps_per_proc;j++) {
+ fprintf(fp1,"%3d %7d\n",j,E->lmesh.nno);
+ for(i=1;i<=E->lmesh.nno;i++)
+ fprintf(fp1,"%.3e %.3e %.3e\n",E->sx[j][1][i],E->sx[j][2][i],E->sx[j][3][i]);
+ }
+ fclose(fp1);
+
+ been_here++;
+ }
+
+
+ sprintf(output_file,"%s.visc.%d.%d",E->control.data_file,E->parallel.me,file_number);
+ fp1=fopen(output_file,"w");
+ for(j=1;j<=E->sphere.caps_per_proc;j++) {
+ fprintf(fp1,"%3d %7d\n",j,E->lmesh.nno);
+ for(i=1;i<=E->lmesh.nno;i++)
+ fprintf(fp1,"%.3e\n",E->VI[lev][j][i]);
+
+ }
+ fclose(fp1);
+
+ sprintf(output_file,"%s.velo.%d.%d",E->control.data_file,E->parallel.me,file_number);
+ fp1=fopen(output_file,"w");
+ fprintf(fp1,"%d %d %.5e\n",file_number,E->lmesh.nno,E->monitor.elapsed_time);
+ for(j=1;j<=E->sphere.caps_per_proc;j++) {
+ fprintf(fp1,"%3d %7d\n",j,E->lmesh.nno);
+ for(i=1;i<=E->lmesh.nno;i++)
+ fprintf(fp1,"%.6e %.6e %.6e %.6e\n",E->sphere.cap[j].V[1][i],E->sphere.cap[j].V[2][i],E->sphere.cap[j].V[3][i],E->T[j][i]);
+ /* for(i=1;i<=E->lmesh.nno;i++)
+ fprintf(fp1,"%.6e\n",E->T[j][i]); */
+ }
+
+ fclose(fp1);
+
+ if (E->parallel.me_loc[3]==E->parallel.nprocz-1) {
+ sprintf(output_file,"%s.surf.%d.%d",E->control.data_file,E->parallel.me,file_number);
+ fp2=fopen(output_file,"w");
+ for(j=1;j<=E->sphere.caps_per_proc;j++) {
+ fprintf(fp2,"%3d %7d\n",j,E->lmesh.nsf);
+ for(i=1;i<=E->lmesh.nsf;i++) {
+ s = i*E->lmesh.noz;
+ fprintf(fp2,"%.4e %.4e %.4e %.4e\n",E->slice.tpg[j][i],E->slice.shflux[j][i],E->sphere.cap[j].V[1][s],E->sphere.cap[j].V[2][s]);
+ }
+ }
+ fclose(fp2);
+
+ }
+
+ if (E->parallel.me_loc[3]==0) {
+ sprintf(output_file,"%s.botm.%d.%d",E->control.data_file,E->parallel.me,file_number);
+ fp2=fopen(output_file,"w");
+ for(j=1;j<=E->sphere.caps_per_proc;j++) {
+ fprintf(fp2,"%3d %7d\n",j,E->lmesh.nsf);
+ for(i=1;i<=E->lmesh.nsf;i++) {
+ s = (i-1)*E->lmesh.noz + 1;
+ fprintf(fp2,"%.4e %.4e %.4e %.4e\n",E->slice.tpgb[j][i],E->slice.bhflux[j][i],E->sphere.cap[j].V[1][s],E->sphere.cap[j].V[2][s]);
+ }
+ }
+ fclose(fp2);
+ }
+
+ /* remove horizontal average output by Tan2 Mar. 1 2002 */
+
+/* if (E->parallel.me<E->parallel.nprocz) { */
+/* sprintf(output_file,"%s.ave_r.%d.%d",E->control.data_file,E->parallel.me,file_number); */
+/* fp2=fopen(output_file,"w"); */
+/* for(j=1;j<=E->lmesh.noz;j++) { */
+/* fprintf(fp2,"%.4e %.4e %.4e %.4e\n",E->sx[1][3][j],E->Have.T[j],E->Have.V[1][j],E->Have.V[2][j]); */
+/* } */
+/* fclose(fp2); */
+/* } */
+
+ return;
+ }
+
+
+
+void output_temp(E,file_number)
+ struct All_variables *E;
+ int file_number;
+{
+ int m,nno,i,j,fd;
+ static int *temp1;
+ static int been_here=0;
+ static int size2,size1;
+ char output_file[255];
+
+ return;
+}
+
+
+
+void output_stress(E,file_number,SXX,SYY,SZZ,SXY,SXZ,SZY)
+ struct All_variables *E;
+ int file_number;
+ float *SXX,*SYY,*SZZ,*SXY,*SXZ,*SZY;
+{
+ int i,j,k,ii,m,fd,size2;
+ int nox,noz,noy;
+ char output_file[255];
+
+ size2= (E->lmesh.nno+1)*sizeof(float);
+
+ sprintf(output_file,"%s.%05d.SZZ",E->control.data_file,file_number);
+ fd=open(output_file,O_RDWR | O_CREAT, 0644);
+ write(fd,SZZ,size2);
+ close (fd);
+
+ return;
+ }
+
+
+
+void print_field_spectral_regular(E,TG,sphc,sphs,proc_loc,filen)
+ struct All_variables *E;
+ float *TG,*sphc,*sphs;
+ int proc_loc;
+ char * filen;
+ {
+ FILE *fp,*fp1;
+ char output_file[255];
+ int i,node,j,ll,mm;
+ float minx,maxx,t,f,rad;
+ rad = 180.0/M_PI;
+
+ maxx=-1.e26;
+ minx=1.e26;
+ if (E->parallel.me==proc_loc) {
+
+ sprintf(output_file,"%s.%s_intp",E->control.data_file,filen);
+ fp=fopen(output_file,"w");
+ for (i=E->sphere.nox;i>=1;i--)
+ for (j=1;j<=E->sphere.noy;j++) {
+ node = i + (j-1)*E->sphere.nox;
+ t = 90-E->sphere.sx[1][node]*rad;
+ f = E->sphere.sx[2][node]*rad;
+ fprintf (fp,"%.3e %.3e %.4e\n",f,t,TG[node]);
+ if(TG[node]>maxx)maxx=TG[node];
+ if(TG[node]<minx)minx=TG[node];
+ }
+ fprintf(stderr,"lmaxx=%.4e lminx=%.4e for %s\n",maxx,minx,filen);
+ fprintf(E->fp,"lmaxx=%.4e lminx=%.4e for %s\n",maxx,minx,filen);
+ fclose(fp);
+
+ sprintf(output_file,"%s.%s_sharm",E->control.data_file,filen);
+ fp1=fopen(output_file,"w");
+ fprintf(fp1,"lmaxx=%.4e lminx=%.4e for %s\n",maxx,minx,filen);
+ fprintf(fp1," ll mm cos sin \n");
+ for (ll=0;ll<=E->output.llmax;ll++)
+ for(mm=0;mm<=ll;mm++) {
+ i = E->sphere.hindex[ll][mm];
+ fprintf(fp1,"%3d %3d %.4e %.4e \n",ll,mm,sphc[i],sphs[i]);
+ }
+
+ fclose(fp1);
+ }
+
+
+ return;
+ }
+
+
+
+/*************************************************************************/
+/* from Full_tracer_advection.c */
+/*************************************************************************/
+
+
+
+/* */
+/* This function writes the radial distribution of tracers */
+/* (horizontally averaged) */
+
+void write_radial_horizontal_averages(E)
+ struct All_variables *E;
+{
+
+ char output_file[200];
+
+ int j;
+ int kk;
+ double halfpoint;
+ double *reltrac[13];
+
+ static int been_here=0;
+
+ void return_horiz_ave();
+ void return_elementwise_horiz_ave();
+
+ FILE *fp2;
+
+ if (been_here==0)
+ {
+ E->trace.Have_C=(double *)malloc((E->lmesh.noz+2)*sizeof(double));
+ E->trace.Havel_tracers=(double *)malloc((E->lmesh.elz+2)*sizeof(double));
+ }
+
+ /* Tracers */
+
+ /* first, change from int to double */
+
+ for (j=1;j<=E->sphere.caps_per_proc;j++)
+ {
+ reltrac[j]=(double *) malloc((E->lmesh.nel+1)*sizeof(double));
+ for (kk=1;kk<=E->lmesh.nel;kk++)
+ {
+ reltrac[j][kk]=(1.0*E->composition.ieltrac[j][kk]);
+ }
+ }
+
+ return_elementwise_horiz_ave(E,reltrac,E->trace.Havel_tracers);
+
+ for (j=1;j<=E->sphere.caps_per_proc;j++)
+ {
+ free(reltrac[j]);
+ }
+
+ if (E->parallel.me<E->parallel.nprocz)
+ {
+ sprintf(output_file,"%s.ave_tracers.%d.%d",E->control.data_file,E->parallel.me,E->monitor.solution_cycles);
+ fp2=fopen(output_file,"w");
+ for(kk=1;kk<=E->lmesh.elz;kk++)
+ {
+ halfpoint=0.5*(E->sx[1][3][kk+1]+E->sx[1][3][kk]);
+ fprintf(fp2,"%.4e %.4e\n",halfpoint,E->trace.Havel_tracers[kk]);
+ }
+ fclose(fp2);
+ }
+
+ /* Composition */
+
+ if (E->composition.chemical_buoyancy==1)
+ {
+ return_horiz_ave(E,E->composition.comp_node,E->trace.Have_C);
+
+
+ if (E->parallel.me<E->parallel.nprocz)
+ {
+ sprintf(output_file,"%s.ave_c.%d.%d",E->control.data_file,E->parallel.me,E->monitor.solution_cycles);
+ fp2=fopen(output_file,"w");
+ for(kk=1;kk<=E->lmesh.noz;kk++)
+ {
+ fprintf(fp2,"%.4e %.4e\n",E->sx[1][3][kk],E->trace.Have_C[kk]);
+ }
+ fclose(fp2);
+
+ }
+ }
+
+ been_here++;
+
+ return;
+}
+
+
+/****** ICHECK REGULAR NEIGHBORS *****************************/
+/* */
+/* This function searches the regular element neighborhood. */
+
+/* This function is no longer used! */
+
+int icheck_regular_neighbors(E,j,ntheta,nphi,x,y,z,theta,phi,rad)
+ struct All_variables *E;
+ int j,ntheta,nphi;
+ double x,y,z;
+ double theta,phi,rad;
+{
+
+ int new_ntheta,new_nphi;
+ int kk,pp;
+ int iregel;
+ int ival;
+ int imap[5];
+ int ichoice;
+ int irange;
+
+ int iquick_element_column_search();
+
+ fprintf(E->trace.fpt,"ERROR(icheck_regular_neighbors)-this subroutine is no longer used !\n");
+ fflush(E->trace.fpt);
+ exit(10);
+
+ irange=2;
+
+ for (kk=-irange;kk<=irange;kk++)
+ {
+ for (pp=-irange;pp<=irange;pp++)
+ {
+ new_ntheta=ntheta+kk;
+ new_nphi=nphi+pp;
+ if ( (new_ntheta>0)&&(new_ntheta<=E->trace.numtheta[j])&&(new_nphi>0)&&(new_nphi<=E->trace.numphi[j]) )
+ {
+ iregel=new_ntheta+(new_nphi-1)*E->trace.numtheta[j];
+ if ((iregel>0) && (iregel<=E->trace.numregel[j]))
+ {
+ ival=iquick_element_column_search(E,j,iregel,new_ntheta,new_nphi,x,y,z,theta,phi,rad,imap,&ichoice);
+ if (ival>0) return ival;
+ }
+ }
+ }
+ }
+
+
+ return -99;
+}
+
+
+/****** IQUICK ELEMENT SEARCH *****************************/
+/* */
+/* This function does a quick regular to real element */
+/* map check. Element number, if found, is returned. */
+/* Otherwise, -99 is returned. */
+/* Pointers to imap and ichoice are used because they may */
+/* prove to be convenient. */
+/* This routine is no longer used */
+
+int iquick_element_column_search(E,j,iregel,ntheta,nphi,x,y,z,theta,phi,rad,imap,ich)
+ struct All_variables *E;
+ int j,iregel;
+ int ntheta,nphi;
+ double x,y,z,theta,phi,rad;
+ int *imap;
+ int *ich;
+{
+
+ int iregnode[5];
+ int kk,pp;
+ int nel,ival;
+ int ichoice;
+ int icount;
+ int itemp1;
+ int itemp2;
+
+ int icheck_element_column();
+
+ fprintf(E->trace.fpt,"ERROR(iquick element)-this routine is no longer used!\n");
+ fflush(E->trace.fpt);
+ exit(10);
+
+ /* REMOVE*/
+ /*
+ ichoice=*ich;
+
+ fprintf(E->trace.fpt,"AA: ichoice: %d\n",ichoice);
+ fflush(E->trace.fpt);
+ */
+
+ /* find regular nodes on regular element */
+
+ /*
+ iregnode[1]=iregel+(nphi-1);
+ iregnode[2]=iregel+nphi;
+ iregnode[3]=iregel+nphi+E->trace.numtheta[j]+1;
+ iregnode[4]=iregel+nphi+E->trace.numtheta[j];
+ */
+
+ itemp1=iregel+nphi;
+ itemp2=itemp1+E->trace.numtheta[j];
+
+ iregnode[1]=itemp1-1;
+ iregnode[2]=itemp1;
+ iregnode[3]=itemp2+1;
+ iregnode[4]=itemp2;
+
+ for (kk=1;kk<=4;kk++)
+ {
+ if ((iregnode[kk]<1) || (iregnode[kk]>E->trace.numregnodes[j]) )
+ {
+ fprintf(E->trace.fpt,"ERROR(iquick)-weird regnode %d\n",iregnode[kk]);
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+ }
+
+ /* find number of choices */
+
+ ichoice=0;
+ icount=0;
+ for (kk=1;kk<=4;kk++)
+ {
+ if (E->trace.regnodetoel[j][iregnode[kk]]<=0) goto next_corner;
+
+ icount++;
+ for (pp=1;pp<=(kk-1);pp++)
+ {
+ if (E->trace.regnodetoel[j][iregnode[kk]]==E->trace.regnodetoel[j][iregnode[pp]]) goto next_corner;
+ }
+ ichoice++;
+ imap[ichoice]=E->trace.regnodetoel[j][iregnode[kk]];
+
+
+ next_corner:
+ ;
+ } /* end kk */
+
+ *ich=ichoice;
+
+ /* statistical counter */
+
+ E->trace.istat_ichoice[j][ichoice]++;
+
+ if (ichoice==0) return -99;
+
+ /* Here, no check is performed if all 4 corners */
+ /* lie within a given element. */
+ /* It may be possible (not sure) but unlikely */
+ /* that the tracer is still not in that element */
+
+ /* Decided to comment this out. */
+ /* May not be valid for large regular grids. */
+ /*
+ */
+ /* AKMA */
+
+ if ((ichoice==1)&&(icount==4)) return imap[1];
+
+ /* check others */
+
+ for (kk=1;kk<=ichoice;kk++)
+ {
+ nel=imap[kk];
+ ival=icheck_element_column(E,j,nel,x,y,z,rad);
+ if (ival>0) return nel;
+ }
+
+ /* if still here, no element was found */
+
+ return -99;
+}
+
+
+/*************************************************************************/
+/* from */
+/*************************************************************************/
+
Deleted: mc/3D/CitcomS/branches/cxx/lib/Full_parallel_related.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Full_parallel_related.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Full_parallel_related.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,1368 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-/* Routines here are for intel paragon with MPI */
-
-#include <mpi.h>
-#include <math.h>
-
-#include "element_definitions.h"
-#include "global_defs.h"
-#include "sphere_communication.h"
-
-#include "parallel_related.h"
-
-
-static void set_horizontal_communicator(struct All_variables*);
-static void set_vertical_communicator(struct All_variables*);
-
-static void exchange_node_d(struct All_variables *, double**, int);
-static void exchange_node_f(struct All_variables *, float**, int);
-
-
-/* ============================================ */
-/* ============================================ */
-
-void full_parallel_processor_setup(struct All_variables *E)
- {
-
- int i,j,k,m,me,temp,pid_surf;
- int cap_id_surf;
- int surf_proc_per_cap, proc_per_cap, total_proc;
-
- me = E->parallel.me;
-
- if ( E->parallel.nprocx != E->parallel.nprocy ) {
- if (E->parallel.me==0) fprintf(stderr,"!!!! nprocx must equal to nprocy \n");
- parallel_process_termination();
- }
-
- surf_proc_per_cap = E->parallel.nprocx * E->parallel.nprocy;
- proc_per_cap = surf_proc_per_cap * E->parallel.nprocz;
- total_proc = E->sphere.caps * proc_per_cap;
- E->parallel.total_surf_proc = E->sphere.caps * surf_proc_per_cap;
-
- if ( total_proc != E->parallel.nproc ) {
- if (E->parallel.me==0) fprintf(stderr,"!!!! # of requested CPU is incorrect \n");
- parallel_process_termination();
- }
-
- E->sphere.caps_per_proc = max(1,E->sphere.caps*E->parallel.nprocz/E->parallel.nproc);
-
- if (E->sphere.caps_per_proc > 1) {
- if (E->parallel.me==0) fprintf(stderr,"!!!! # caps per proc > 1 is not supported.\n \n");
- parallel_process_termination();
- }
-
- /* determine the location of processors in each cap */
- cap_id_surf = me / proc_per_cap;
-
- /* z-direction first*/
- E->parallel.me_loc[3] = (me - cap_id_surf*proc_per_cap) % E->parallel.nprocz;
-
- /* x-direction then*/
- E->parallel.me_loc[1] = ((me - cap_id_surf*proc_per_cap - E->parallel.me_loc[3])/E->parallel.nprocz) % E->parallel.nprocx;
-
- /* y-direction then*/
- E->parallel.me_loc[2] = ((((me - cap_id_surf*proc_per_cap - E->parallel.me_loc[3])/E->parallel.nprocz) - E->parallel.me_loc[1])/E->parallel.nprocx) % E->parallel.nprocy;
-
-
-/*
-the numbering of proc in each caps is as so (example for an xyz = 2x2x2 box):
-NOTE: This is different (in a way) than the numbering of the nodes:
-the nodeal number has the first oordinate as theta, which goes N-S and
-the second oordinate as fi, which goes E-W. Here we use R-L as the first
-oordinate and F-B
- 0 = lower left front corner=[000] 4 = lower left back corner=[010]
- 1 = upper left front corner=[001] 5 = upper left back corner=[011]
- 2 = lower right front corner=[100] 6 = lower right back corner=[110]
- 3 = upper right front corner=[101] 7 = upper right back corner=[111]
-[xyz] is x=E->parallel.me_loc[1],y=E->parallel.me_loc[2],z=E->parallel.me_loc[3]
-*/
-
- /* determine cap id for each cap in a given processor */
- pid_surf = me/proc_per_cap; /* cap number (0~11) */
- i = cases[E->sphere.caps_per_proc]; /* 1 for more than 12 processors */
-
- for (j=1;j<=E->sphere.caps_per_proc;j++) {
- temp = pid_surf*E->sphere.caps_per_proc + j-1; /* cap number (out of 12) */
- E->sphere.capid[j] = incases1[i].links[temp]; /* id (1~12) of the current cap */
- }
-
- /* determine which caps are linked with each of 12 caps */
- /* if the 12 caps are broken, set these up instead */
- if (surf_proc_per_cap > 1) {
- E->sphere.max_connections = 8;
- }
-
- /* steup location-to-processor map */
- E->parallel.loc2proc_map = (int ****) malloc(E->sphere.caps*sizeof(int ***));
- for (m=0;m<E->sphere.caps;m++) {
- E->parallel.loc2proc_map[m] = (int ***) malloc(E->parallel.nprocx*sizeof(int **));
- for (i=0;i<E->parallel.nprocx;i++) {
- E->parallel.loc2proc_map[m][i] = (int **) malloc(E->parallel.nprocy*sizeof(int *));
- for (j=0;j<E->parallel.nprocy;j++)
- E->parallel.loc2proc_map[m][i][j] = (int *) malloc(E->parallel.nprocz*sizeof(int));
- }
- }
-
- for (m=0;m<E->sphere.caps;m++)
- for (i=0;i<E->parallel.nprocx;i++)
- for (j=0;j<E->parallel.nprocy;j++)
- for (k=0;k<E->parallel.nprocz;k++) {
- if (E->sphere.caps_per_proc>1) {
- temp = cases[E->sphere.caps_per_proc];
- E->parallel.loc2proc_map[m][i][j][k] = incases2[temp].links[m-1];
- }
- else
- E->parallel.loc2proc_map[m][i][j][k] = m*proc_per_cap
- + j*E->parallel.nprocx*E->parallel.nprocz
- + i*E->parallel.nprocz + k;
- }
-
- if (E->control.verbose) {
- fprintf(E->fp_out,"me=%d loc1=%d loc2=%d loc3=%d\n",me,E->parallel.me_loc[1],E->parallel.me_loc[2],E->parallel.me_loc[3]);
- for (j=1;j<=E->sphere.caps_per_proc;j++) {
- fprintf(E->fp_out,"capid[%d]=%d \n",j,E->sphere.capid[j]);
- }
- for (m=0;m<E->sphere.caps;m++)
- for (j=0;j<E->parallel.nprocy;j++)
- for (i=0;i<E->parallel.nprocx;i++)
- for (k=0;k<E->parallel.nprocz;k++)
- fprintf(E->fp_out,"loc2proc_map[cap=%d][x=%d][y=%d][z=%d] = %d\n",
- m,i,j,k,E->parallel.loc2proc_map[m][i][j][k]);
-
- fflush(E->fp_out);
- }
-
- set_vertical_communicator(E);
- set_horizontal_communicator(E);
-
- E->exchange_node_d = exchange_node_d;
- E->exchange_node_f = exchange_node_f;
-
- return;
- }
-
-
-
-static void set_horizontal_communicator(struct All_variables *E)
-{
- MPI_Group world_g, horizon_g;
- int i,j,k,m,n;
- int *processors;
-
- processors = (int *) malloc((E->parallel.total_surf_proc+1)*sizeof(int));
-
- k = E->parallel.me_loc[3];
- n = 0;
- for (m=0;m<E->sphere.caps;m++)
- for (i=0;i<E->parallel.nprocx;i++)
- for (j=0;j<E->parallel.nprocy;j++) {
- processors[n] = E->parallel.loc2proc_map[m][i][j][k];
- n++;
- }
-
- MPI_Comm_group(E->parallel.world, &world_g);
- MPI_Group_incl(world_g, E->parallel.total_surf_proc, processors, &horizon_g);
- MPI_Comm_create(E->parallel.world, horizon_g, &(E->parallel.horizontal_comm));
-
- if (E->control.verbose) {
- fprintf(E->fp_out,"horizontal group of me=%d loc3=%d\n",E->parallel.me,E->parallel.me_loc[3]);
- for (j=0;j<E->parallel.total_surf_proc;j++) {
- fprintf(E->fp_out,"%d proc=%d\n",j,processors[j]);
- }
- fflush(E->fp_out);
- }
-
- MPI_Group_free(&horizon_g);
- MPI_Group_free(&world_g);
- free((void *) processors);
-
- return;
-}
-
-
-static void set_vertical_communicator(struct All_variables *E)
-{
- MPI_Group world_g, vertical_g;
- int i,j,k,m;
- int *processors;
-
- processors = (int *)malloc((E->parallel.nprocz+2)*sizeof(int));
-
- m = E->sphere.capid[1] - 1; /* assume 1 cap per proc. */
- i = E->parallel.me_loc[1];
- j = E->parallel.me_loc[2];
-
- for (k=0;k<E->parallel.nprocz;k++) {
- processors[k] = E->parallel.loc2proc_map[m][i][j][k];
- }
-
- MPI_Comm_group(E->parallel.world, &world_g);
- MPI_Group_incl(world_g, E->parallel.nprocz, processors, &vertical_g);
- MPI_Comm_create(E->parallel.world, vertical_g, &(E->parallel.vertical_comm));
-
- if (E->control.verbose) {
- fprintf(E->fp_out,"vertical group of me=%d loc1=%d loc2=%d\n",E->parallel.me,E->parallel.me_loc[1],E->parallel.me_loc[2]);
- for (j=0;j<E->parallel.nprocz;j++) {
- fprintf(E->fp_out,"%d proc=%d\n",j,processors[j]);
- }
- fflush(E->fp_out);
- }
-
- MPI_Group_free(&vertical_g);
- MPI_Group_free(&world_g);
- free((void *) processors);
-}
-
-
-/* =========================================================================
-get element information for each processor.
- ========================================================================= */
-
-void full_parallel_domain_decomp0(struct All_variables *E)
- {
-
- int i,nox,noz,noy,me;
-
- me = E->parallel.me;
-
- E->lmesh.elx = E->mesh.elx/E->parallel.nprocx;
- E->lmesh.elz = E->mesh.elz/E->parallel.nprocz;
- E->lmesh.ely = E->mesh.ely/E->parallel.nprocy;
- E->lmesh.nox = E->lmesh.elx + 1;
- E->lmesh.noz = E->lmesh.elz + 1;
- E->lmesh.noy = E->lmesh.ely + 1;
-
- E->lmesh.exs = E->parallel.me_loc[1]*E->lmesh.elx;
- E->lmesh.eys = E->parallel.me_loc[2]*E->lmesh.ely;
- E->lmesh.ezs = E->parallel.me_loc[3]*E->lmesh.elz;
- E->lmesh.nxs = E->parallel.me_loc[1]*E->lmesh.elx+1;
- E->lmesh.nys = E->parallel.me_loc[2]*E->lmesh.ely+1;
- E->lmesh.nzs = E->parallel.me_loc[3]*E->lmesh.elz+1;
-
- E->lmesh.nno = E->lmesh.noz*E->lmesh.nox*E->lmesh.noy;
- E->lmesh.nel = E->lmesh.ely*E->lmesh.elx*E->lmesh.elz;
- E->lmesh.npno = E->lmesh.nel;
-
- E->lmesh.nsf = E->lmesh.nno/E->lmesh.noz;
- E->lmesh.snel = E->lmesh.elx*E->lmesh.ely;
-
- for(i=E->mesh.levmax;i>=E->mesh.levmin;i--) {
-
- if (E->control.NMULTIGRID||E->control.EMULTIGRID) {
- nox = E->lmesh.elx/(int)pow(2.0,(double)(E->mesh.levmax-i))+1;
- noy = E->lmesh.ely/(int)pow(2.0,(double)(E->mesh.levmax-i))+1;
- noz = E->lmesh.elz/(int)pow(2.0,(double)(E->mesh.levmax-i))+1;
- E->parallel.redundant[i]=0;
- }
- else
- { noz = E->lmesh.noz;
- noy = E->lmesh.noy;
- nox = E->lmesh.nox;
- }
-
- E->lmesh.ELX[i] = nox-1;
- E->lmesh.ELY[i] = noy-1;
- E->lmesh.ELZ[i] = noz-1;
- E->lmesh.NOZ[i] = noz;
- E->lmesh.NOY[i] = noy;
- E->lmesh.NOX[i] = nox;
- E->lmesh.NNO[i] = nox * noz * noy;
- E->lmesh.NNOV[i] = E->lmesh.NNO[i];
- E->lmesh.SNEL[i] = E->lmesh.ELX[i]*E->lmesh.ELY[i];
-
- E->lmesh.NEL[i] = (nox-1) * (noz-1) * (noy-1);
- E->lmesh.NPNO[i] = E->lmesh.NEL[i] ;
-
- E->lmesh.NEQ[i] = E->mesh.nsd * E->lmesh.NNOV[i] ;
-
- E->lmesh.EXS[i] = E->parallel.me_loc[1]*E->lmesh.ELX[i];
- E->lmesh.EYS[i] = E->parallel.me_loc[2]*E->lmesh.ELY[i];
- E->lmesh.EZS[i] = E->parallel.me_loc[3]*E->lmesh.ELZ[i];
- E->lmesh.NXS[i] = E->parallel.me_loc[1]*E->lmesh.ELX[i]+1;
- E->lmesh.NYS[i] = E->parallel.me_loc[2]*E->lmesh.ELY[i]+1;
- E->lmesh.NZS[i] = E->parallel.me_loc[3]*E->lmesh.ELZ[i]+1;
- }
-
-/*
-fprintf(stderr,"b %d %d %d %d %d %d %d\n",E->parallel.me,E->parallel.me_loc[1],E->parallel.me_loc[2],E->parallel.me_loc[3],E->lmesh.nzs,E->lmesh.nys,E->lmesh.noy);
-*/
-/* parallel_process_termination();
-*/
- return;
- }
-
-
-
-/* ============================================
- determine boundary nodes for
- exchange info across the boundaries
- ============================================ */
-
-void full_parallel_domain_boundary_nodes(E)
- struct All_variables *E;
- {
-
- void parallel_process_termination();
-
- int m,i,ii,j,k,l,node,el,lnode;
- int lev,ele,elx,elz,ely,nel,nno,nox,noz,noy;
- FILE *fp;
- char output_file[255];
-
- for(lev=E->mesh.gridmin;lev<=E->mesh.gridmax;lev++) {
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
- nel = E->lmesh.NEL[lev];
- elx = E->lmesh.ELX[lev];
- elz = E->lmesh.ELZ[lev];
- ely = E->lmesh.ELY[lev];
- nox = E->lmesh.NOX[lev];
- noy = E->lmesh.NOY[lev];
- noz = E->lmesh.NOZ[lev];
- nno = E->lmesh.NNO[lev];
-
-/* do the ZOY boundary elements first */
- lnode = 0;
- ii =1; /* left */
- for(j=1;j<=noz;j++)
- for(k=1;k<=noy;k++) {
- node = j + (k-1)*noz*nox;
- E->parallel.NODE[lev][m][++lnode].bound[ii] = node;
- E->NODE[lev][m][node] = E->NODE[lev][m][node] | OFFSIDE;
- }
-
- E->parallel.NUM_NNO[lev][m].bound[ii] = lnode;
-
-
- lnode = 0;
- ii =2; /* right */
- for(j=1;j<=noz;j++)
- for(k=1;k<=noy;k++) {
- node = (nox-1)*noz + j + (k-1)*noz*nox;
- E->parallel.NODE[lev][m][++lnode].bound[ii] = node;
- E->NODE[lev][m][node] = E->NODE[lev][m][node] | OFFSIDE;
- }
-
- E->parallel.NUM_NNO[lev][m].bound[ii] = lnode;
-
-
-/* do XOY boundary elements */
- ii=5; /* bottom */
- lnode=0;
- for(k=1;k<=noy;k++)
- for(i=1;i<=nox;i++) {
- node = (k-1)*nox*noz + (i-1)*noz + 1;
- E->parallel.NODE[lev][m][++lnode].bound[ii] = node;
- E->NODE[lev][m][node] = E->NODE[lev][m][node] | OFFSIDE;
- }
-
- E->parallel.NUM_NNO[lev][m].bound[ii] = lnode;
-
- ii=6; /* top */
- lnode=0;
- for(k=1;k<=noy;k++)
- for(i=1;i<=nox;i++) {
- node = (k-1)*nox*noz + i*noz;
- E->parallel.NODE[lev][m][++lnode].bound[ii] = node;
- E->NODE[lev][m][node] = E->NODE[lev][m][node] | OFFSIDE;
- }
-
- E->parallel.NUM_NNO[lev][m].bound[ii] = lnode;
-
-
-/* do XOZ boundary elements for 3D */
- ii=3; /* front */
- lnode=0;
- for(j=1;j<=noz;j++)
- for(i=1;i<=nox;i++) {
- node = (i-1)*noz +j;
- E->parallel.NODE[lev][m][++lnode].bound[ii] = node;
- E->NODE[lev][m][node] = E->NODE[lev][m][node] | OFFSIDE;
- }
-
- E->parallel.NUM_NNO[lev][m].bound[ii] = lnode;
-
- ii=4; /* rear */
- lnode=0;
- for(j=1;j<=noz;j++)
- for(i=1;i<=nox;i++) {
- node = noz*nox*(noy-1) + (i-1)*noz +j;
- E->parallel.NODE[lev][m][++lnode].bound[ii] = node;
- E->NODE[lev][m][node] = E->NODE[lev][m][node] | OFFSIDE;
- }
-
- E->parallel.NUM_NNO[lev][m].bound[ii] = lnode;
-
- /* determine the overlapped nodes between caps or between proc */
-
- /* horizontal direction:
- all nodes at right (ix==nox) and front (iy==1) faces
- are skipped */
- for (lnode=1;lnode<=E->parallel.NUM_NNO[lev][m].bound[2];lnode++) {
- node = E->parallel.NODE[lev][m][lnode].bound[2];
- E->NODE[lev][m][node] = E->NODE[lev][m][node] | SKIP;
- }
-
- for (lnode=1;lnode<=E->parallel.NUM_NNO[lev][m].bound[3];lnode++) {
- node = E->parallel.NODE[lev][m][lnode].bound[3];
- E->NODE[lev][m][node] = E->NODE[lev][m][node] | SKIP;
- }
-
- /* nodes at N/S poles are skipped by all proc.
- add them back here */
-
- /* north pole is at the front left proc. of 1st cap */
- if (E->sphere.capid[m] == 1 &&
- E->parallel.me_loc[1] == 0 &&
- E->parallel.me_loc[2] == 0)
- for(j=1;j<=noz;j++) {
- node = j;
- E->NODE[lev][m][node] = E->NODE[lev][m][node] & ~SKIP;
- }
-
- /* south pole is at the back right proc. of final cap */
- if (E->sphere.capid[m] == E->sphere.caps &&
- E->parallel.me_loc[1] == E->parallel.nprocx-1 &&
- E->parallel.me_loc[2] == E->parallel.nprocy-1)
- for(j=1;j<=noz;j++) {
- node = j*nox*noy;
- E->NODE[lev][m][node] = E->NODE[lev][m][node] & ~SKIP;
- }
-
- /* radial direction is easy:
- all top nodes except those at top processors are skipped */
- if (E->parallel.me_loc[3]!=E->parallel.nprocz-1 )
- for (lnode=1;lnode<=E->parallel.NUM_NNO[lev][m].bound[6];lnode++) {
- node = E->parallel.NODE[lev][m][lnode].bound[6];
- E->NODE[lev][m][node] = E->NODE[lev][m][node] | SKIP;
- }
-
- } /* end for m */
- } /* end for level */
-
-
-if (E->control.verbose) {
- fprintf(E->fp_out,"output_shared_nodes %d \n",E->parallel.me);
- for(lev=E->mesh.gridmax;lev>=E->mesh.gridmin;lev--)
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- fprintf(E->fp_out,"lev=%d me=%d capid=%d m=%d \n",lev,E->parallel.me,E->sphere.capid[m],m);
- for (ii=1;ii<=6;ii++)
- for (i=1;i<=E->parallel.NUM_NNO[lev][m].bound[ii];i++)
- fprintf(E->fp_out,"ii=%d %d %d \n",ii,i,E->parallel.NODE[lev][m][i].bound[ii]);
-
- lnode=0;
- for (node=1;node<=E->lmesh.NNO[lev];node++)
- if((E->NODE[lev][m][node] & SKIP)) {
- lnode++;
- fprintf(E->fp_out,"skip %d %d \n",lnode,node);
- }
- }
- fflush(E->fp_out);
- }
-
-
-
- return;
- }
-
-
-/* ============================================
- determine communication routs and boundary ID for
- exchange info across the boundaries
- assuming fault nodes are in the top row of processors
- ============================================ */
-
-static void face_eqn_node_to_pass(struct All_variables *, int, int, int, int);
-static void line_eqn_node_to_pass(struct All_variables *, int, int, int, int, int, int);
-
-void full_parallel_communication_routs_v(E)
- struct All_variables *E;
- {
-
- int m,i,ii,j,k,l,node,el,elt,lnode,jj,doff,target;
- int lev,elx,elz,ely,nno,nox,noz,noy,p,kkk,kk,kf,kkkp;
- int me, nprocx,nprocy,nprocz,nprocxz;
- int tscaps,cap,scap,large,npass,lx,ly,lz,temp,layer;
-
- const int dims=E->mesh.nsd;
-
- me = E->parallel.me;
- nprocx = E->parallel.nprocx;
- nprocy = E->parallel.nprocy;
- nprocz = E->parallel.nprocz;
- nprocxz = nprocx * nprocz;
- tscaps = E->parallel.total_surf_proc;
- lx = E->parallel.me_loc[1];
- ly = E->parallel.me_loc[2];
- lz = E->parallel.me_loc[3];
-
- /* determine the communications in horizontal direction */
- for(lev=E->mesh.gridmax;lev>=E->mesh.gridmin;lev--) {
- nox = E->lmesh.NOX[lev];
- noz = E->lmesh.NOZ[lev];
- noy = E->lmesh.NOY[lev];
-
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
- cap = E->sphere.capid[m] - 1; /* which cap I am in (0~11) */
-
- /* -X face */
- npass = ii = 1;
- if (lx != 0)
- target = E->parallel.loc2proc_map[cap][lx-1][ly][lz];
- else
- if ( cap%3 != 0) {
- temp = (cap+2) % 12;
- target = E->parallel.loc2proc_map[temp][nprocx-1][ly][lz];
- }
- else {
- temp = (cap+3) % 12;
- target = E->parallel.loc2proc_map[temp][ly][0][lz];
- }
-
- E->parallel.PROCESSOR[lev][m].pass[npass] = target;
- face_eqn_node_to_pass(E,lev,m,npass,ii);
-
- /* +X face */
- npass = ii = 2;
- if (lx != nprocx-1)
- target = E->parallel.loc2proc_map[cap][lx+1][ly][lz];
- else
- if ( cap%3 != 2) {
- temp = (12+cap-2) % 12;
- target = E->parallel.loc2proc_map[temp][0][ly][lz];
- }
- else {
- temp = (12+cap-3) % 12;
- target = E->parallel.loc2proc_map[temp][ly][nprocy-1][lz];
- }
- E->parallel.PROCESSOR[lev][m].pass[npass] = target;
- face_eqn_node_to_pass(E,lev,m,npass,ii);
-
- /* -Y face */
- npass = ii = 3;
- if (ly != 0)
- target = E->parallel.loc2proc_map[cap][lx][ly-1][lz];
- else
- if ( cap%3 != 0) {
- temp = cap-1;
- target = E->parallel.loc2proc_map[temp][lx][nprocy-1][lz];
- }
- else {
- temp = (12+cap-3) % 12;
- target = E->parallel.loc2proc_map[temp][0][lx][lz];
- }
-
- E->parallel.PROCESSOR[lev][m].pass[npass] = target;
- face_eqn_node_to_pass(E,lev,m,npass,ii);
-
- /* +Y face */
- npass = ii = 4;
- if (ly != nprocy-1)
- target = E->parallel.loc2proc_map[cap][lx][ly+1][lz];
- else
- if ( cap%3 != 2) {
- temp = cap+1;
- target = E->parallel.loc2proc_map[temp][lx][0][lz];
- }
- else {
- temp = (cap+3) % 12;
- target = E->parallel.loc2proc_map[temp][nprocx-1][lx][lz];
- }
-
- E->parallel.PROCESSOR[lev][m].pass[npass] = target;
- face_eqn_node_to_pass(E,lev,m,npass,ii);
-
- /* do lines parallel to Z */
-
- /* -X-Y line */
- if (!( (cap%3==1) && (lx==0) && (ly==0) )) {
- npass ++;
- if ((cap%3==0) && (lx==0) && (ly==0)) {
- temp = (cap+6) % 12;
- target = E->parallel.loc2proc_map[temp][lx][ly][lz];
- }
- else if ((cap%3==0) && (lx==0))
- target = E->parallel.PROCESSOR[lev][m].pass[1] - nprocz;
- else if ((cap%3==0) && (ly==0))
- target = E->parallel.PROCESSOR[lev][m].pass[3] - nprocxz;
- else
- target = E->parallel.PROCESSOR[lev][m].pass[1] - nprocxz;
-
- E->parallel.PROCESSOR[lev][m].pass[npass] = target;
- line_eqn_node_to_pass(E,lev,m,npass,noz,1,1);
- }
-
- /* +X+Y line */
- if (!( (cap%3==1) && (lx==nprocx-1) && (ly==nprocy-1) )) {
- npass ++;
- if ((cap%3==2) && (lx==nprocx-1) && (ly==nprocy-1)) {
- temp = (cap+6) % 12;
- target = E->parallel.loc2proc_map[temp][lx][ly][lz];
- }
- else if ((cap%3==2) && (lx==nprocx-1))
- target = E->parallel.PROCESSOR[lev][m].pass[2] + nprocz;
- else if ((cap%3==2) && (ly==nprocy-1))
- target = E->parallel.PROCESSOR[lev][m].pass[4] + nprocxz;
- else
- target = E->parallel.PROCESSOR[lev][m].pass[2] + nprocxz;
-
- E->parallel.PROCESSOR[lev][m].pass[npass] = target;
- line_eqn_node_to_pass(E,lev,m,npass,noz,(noy*nox-1)*noz+1,1);
- }
-
- /* -X+Y line */
- if (!( (cap%3==2 || cap%3==0) && (lx==0) && (ly==nprocy-1) )) {
- npass ++;
- if ((cap%3==2) && (ly==nprocy-1))
- target = E->parallel.PROCESSOR[lev][m].pass[4] - nprocxz;
- else if ((cap%3==0) && (lx==0))
- target = E->parallel.PROCESSOR[lev][m].pass[1] + nprocz;
- else
- target = E->parallel.PROCESSOR[lev][m].pass[1] + nprocxz;
-
- E->parallel.PROCESSOR[lev][m].pass[npass] = target;
- line_eqn_node_to_pass(E,lev,m,npass,noz,(noy-1)*nox*noz+1,1);
- }
-
- /* +X-Y line */
- if (!( (cap%3==2 || cap%3==0) && (lx==nprocx-1) && (ly==0) )) {
- npass ++;
- if ((cap%3==2) && (lx==nprocx-1))
- target = E->parallel.PROCESSOR[lev][m].pass[2] - nprocz;
- else if ((cap%3==0) && (ly==0))
- target = E->parallel.PROCESSOR[lev][m].pass[3] + nprocxz;
- else
- target = E->parallel.PROCESSOR[lev][m].pass[2] - nprocxz;
-
- E->parallel.PROCESSOR[lev][m].pass[npass] = target;
- line_eqn_node_to_pass(E,lev,m,npass,noz,(nox-1)*noz+1,1);
- }
-
-
- E->parallel.TNUM_PASS[lev][m] = npass;
-
- } /* end for m */
- } /* end for lev */
-
- /* determine the communications in vertical direction */
- for(lev=E->mesh.gridmax;lev>=E->mesh.gridmin;lev--) {
- kkk = 0;
- for(ii=5;ii<=6;ii++) { /* do top & bottom */
- E->parallel.NUM_PASSz[lev].bound[ii] = 1;
- if(lz==0 && ii==5)
- E->parallel.NUM_PASSz[lev].bound[ii] = 0;
- else if(lz==nprocz-1 && ii==6)
- E->parallel.NUM_PASSz[lev].bound[ii] = 0;
-
- for (p=1;p<=E->parallel.NUM_PASSz[lev].bound[ii];p++) {
- kkk ++;
- /* determine the pass ID for ii-th boundary and p-th pass */
- kkkp = kkk + E->sphere.max_connections;
-
- E->parallel.NUM_NODEz[lev].pass[kkk] = 0;
- E->parallel.NUM_NEQz[lev].pass[kkk] = 0;
-
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
- cap = E->sphere.capid[m] - 1; /* which cap I am in (0~11) */
- E->parallel.PROCESSORz[lev].pass[kkk] =
- E->parallel.loc2proc_map[cap][lx][ly][lz+((ii==5)?-1:1)];
-
- jj=0; kk=0;
- for (k=1;k<=E->parallel.NUM_NNO[lev][m].bound[ii];k++) {
- node = E->parallel.NODE[lev][m][k].bound[ii];
- E->parallel.EXCHANGE_NODE[lev][m][++kk].pass[kkkp] = node;
- for(doff=1;doff<=dims;doff++)
- E->parallel.EXCHANGE_ID[lev][m][++jj].pass[kkkp] =
- E->ID[lev][m][node].doff[doff];
- }
- E->parallel.NUM_NODE[lev][m].pass[kkkp] = kk;
- E->parallel.NUM_NEQ[lev][m].pass[kkkp] = jj;
- E->parallel.NUM_NODEz[lev].pass[kkk] += kk;
- E->parallel.NUM_NEQz[lev].pass[kkk] += jj;
- }
-
- } /* end for loop p */
- } /* end for j */
-
- E->parallel.TNUM_PASSz[lev] = kkk;
- } /* end for level */
-
-
-
- if(E->control.verbose) {
- for(lev=E->mesh.gridmax;lev>=E->mesh.gridmin;lev--) {
- fprintf(E->fp_out,"output_communication route surface for lev=%d \n",lev);
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- fprintf(E->fp_out," me= %d cap=%d pass %d \n",E->parallel.me,E->sphere.capid[m],E->parallel.TNUM_PASS[lev][m]);
- for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
- fprintf(E->fp_out,"proc %d and pass %d to proc %d with %d eqn and %d node\n",E->parallel.me,k,E->parallel.PROCESSOR[lev][m].pass[k],E->parallel.NUM_NEQ[lev][m].pass[k],E->parallel.NUM_NODE[lev][m].pass[k]);
- fprintf(E->fp_out,"Eqn:\n");
- for (ii=1;ii<=E->parallel.NUM_NEQ[lev][m].pass[k];ii++)
- fprintf(E->fp_out,"%d %d\n",ii,E->parallel.EXCHANGE_ID[lev][m][ii].pass[k]);
- fprintf(E->fp_out,"Node:\n");
- for (ii=1;ii<=E->parallel.NUM_NODE[lev][m].pass[k];ii++)
- fprintf(E->fp_out,"%d %d\n",ii,E->parallel.EXCHANGE_NODE[lev][m][ii].pass[k]);
- }
- }
-
- fprintf(E->fp_out,"output_communication route vertical \n");
- fprintf(E->fp_out," me= %d pass %d \n",E->parallel.me,E->parallel.TNUM_PASSz[lev]);
- for (k=1;k<=E->parallel.TNUM_PASSz[lev];k++) {
- kkkp = k + E->sphere.max_connections;
- fprintf(E->fp_out,"proc %d and pass %d to proc %d\n",E->parallel.me,k,E->parallel.PROCESSORz[lev].pass[k]);
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- fprintf(E->fp_out,"cap=%d eqn=%d node=%d\n",E->sphere.capid[m],E->parallel.NUM_NEQ[lev][m].pass[kkkp],E->parallel.NUM_NODE[lev][m].pass[kkkp]);
- for (ii=1;ii<=E->parallel.NUM_NEQ[lev][m].pass[kkkp];ii++)
- fprintf(E->fp_out,"%d %d\n",ii,E->parallel.EXCHANGE_ID[lev][m][ii].pass[kkkp]);
- for (ii=1;ii<=E->parallel.NUM_NODE[lev][m].pass[kkkp];ii++)
- fprintf(E->fp_out,"%d %d\n",ii,E->parallel.EXCHANGE_NODE[lev][m][ii].pass[kkkp]);
- }
- }
- }
- fflush(E->fp_out);
- }
-
- return;
- }
-
-
-/* ============================================
- determine communication routs for
- exchange info across the boundaries on the surfaces
- assuming fault nodes are in the top row of processors
- ============================================ */
-
-void full_parallel_communication_routs_s(E)
- struct All_variables *E;
-{
-
- int i,ii,j,k,l,node,el,elt,lnode,jj,doff;
- int lev,nno,nox,noz,noy,kkk,kk,kf;
- int me,m, nprocz;
- void parallel_process_termination();
-
- const int dims=E->mesh.nsd;
-
- me = E->parallel.me;
- nprocz = E->parallel.nprocz;
-
- /* determine the communications in horizontal direction */
- for(lev=E->mesh.gridmax;lev>=E->mesh.gridmin;lev--) {
- nox = E->lmesh.NOX[lev];
- noz = E->lmesh.NOZ[lev];
- noy = E->lmesh.NOY[lev];
-
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
- j = E->sphere.capid[m];
-
- for (kkk=1;kkk<=E->parallel.TNUM_PASS[lev][m];kkk++) {
- if (kkk<=4) { /* first 4 communications are for XZ and YZ planes */
- ii = kkk;
- E->parallel.NUM_sNODE[lev][m].pass[kkk] =
- E->parallel.NUM_NNO[lev][m].bound[ii]/noz;
-
- for (k=1;k<=E->parallel.NUM_sNODE[lev][m].pass[kkk];k++) {
- lnode = k;
- node = (E->parallel.NODE[lev][m][lnode].bound[ii]-1)/noz + 1;
- E->parallel.EXCHANGE_sNODE[lev][m][k].pass[kkk] = node;
- } /* end for node k */
- } /* end for first 4 communications */
-
- else { /* the last FOUR communications are for lines */
- E->parallel.NUM_sNODE[lev][m].pass[kkk]=1;
-
- for (k=1;k<=E->parallel.NUM_sNODE[lev][m].pass[kkk];k++) {
- node = E->parallel.EXCHANGE_NODE[lev][m][k].pass[kkk]/noz + 1;
- E->parallel.EXCHANGE_sNODE[lev][m][k].pass[kkk] = node;
- } /* end for node k */
- } /* end for the last FOUR communications */
-
- } /* end for kkk */
- } /* end for m */
-
- } /* end for lev */
-
- if(E->control.verbose) {
- for(lev=E->mesh.gridmax;lev>=E->mesh.gridmin;lev--) {
- fprintf(E->fp_out,"output_communication route surface for lev=%d \n",lev);
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- fprintf(E->fp_out," me= %d cap=%d pass %d \n",E->parallel.me,E->sphere.capid[m],E->parallel.TNUM_PASS[lev][m]);
- for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
- fprintf(E->fp_out,"proc %d and pass %d to proc %d with %d node\n",E->parallel.me,k,E->parallel.PROCESSOR[lev][m].pass[k],E->parallel.NUM_sNODE[lev][m].pass[k]);
- fprintf(E->fp_out,"Node:\n");
- for (ii=1;ii<=E->parallel.NUM_sNODE[lev][m].pass[k];ii++)
- fprintf(E->fp_out,"%d %d\n",ii,E->parallel.EXCHANGE_sNODE[lev][m][ii].pass[k]);
- }
- }
-
- }
- fflush(E->fp_out);
- }
-
- return;
-}
-
-
-
-/* ================================================ */
-/* ================================================ */
-
-static void face_eqn_node_to_pass(E,lev,m,npass,bd)
- struct All_variables *E;
- int lev,m,npass,bd;
-{
- int jj,kk,node,doff;
- const int dims=E->mesh.nsd;
-
- E->parallel.NUM_NODE[lev][m].pass[npass] = E->parallel.NUM_NNO[lev][m].bound[bd];
-
- jj = 0;
- for (kk=1;kk<=E->parallel.NUM_NODE[lev][m].pass[npass];kk++) {
- node = E->parallel.NODE[lev][m][kk].bound[bd];
- E->parallel.EXCHANGE_NODE[lev][m][kk].pass[npass] = node;
- for(doff=1;doff<=dims;doff++)
- E->parallel.EXCHANGE_ID[lev][m][++jj].pass[npass] = E->ID[lev][m][node].doff[doff];
- }
-
- E->parallel.NUM_NEQ[lev][m].pass[npass] = jj;
-
- return;
-}
-
-/* ================================================ */
-/* ================================================ */
-
-static void line_eqn_node_to_pass(E,lev,m,npass,num_node,offset,stride)
- struct All_variables *E;
- int lev,m,npass,num_node,offset,stride;
-{
- int jj,kk,node,doff;
- const int dims=E->mesh.nsd;
-
- E->parallel.NUM_NODE[lev][m].pass[npass] = num_node;
-
- jj=0;
- for (kk=1;kk<=E->parallel.NUM_NODE[lev][m].pass[npass];kk++) {
- node = (kk-1)*stride + offset;
- E->parallel.EXCHANGE_NODE[lev][m][kk].pass[npass] = node;
- for(doff=1;doff<=dims;doff++)
- E->parallel.EXCHANGE_ID[lev][m][++jj].pass[npass] = E->ID[lev][m][node].doff[doff];
- }
-
- E->parallel.NUM_NEQ[lev][m].pass[npass] = jj;
-
- return;
-}
-
-/* ================================================
-WARNING: BUGS AHEAD
-
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
-
- sizeofk = (1+E->parallel.NUM_NEQ[lev][m].pass[k])*sizeof(double);
- S[k]=(double *)malloc( sizeofk );
- R[k]=(double *)malloc( sizeofk );
- }
- }
-
-This piece of code contain a bug. Arrays S and R are allocated for each m.
-But most of the memory is leaked.
-
-In this version of CitcomS, sphere.caps_per_proc is always equal to one.
-So, this bug won't manifest itself. But in other version of CitcomS, it will.
-
-by Tan2 7/21, 2003
-================================================ */
-
-void full_exchange_id_d(E, U, lev)
- struct All_variables *E;
- double **U;
- int lev;
- {
-
- int ii,j,jj,m,k,kk,t_cap,idb,msginfo[8];
- double *S[73],*R[73], *RV, *SV;
- int mid_recv, sizeofk;
-
- MPI_Status status[100];
- MPI_Status status1;
- MPI_Request request[100];
-
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
- sizeofk = (1+E->parallel.NUM_NEQ[lev][m].pass[k])*sizeof(double);
- S[k]=(double *)malloc( sizeofk );
- R[k]=(double *)malloc( sizeofk );
- }
- }
-
- sizeofk = 0;
- for (k=1;k<=E->parallel.TNUM_PASSz[lev];k++) {
- kk = (1+E->parallel.NUM_NEQz[lev].pass[k])*sizeof(double);
- sizeofk = max(sizeofk, kk);
- }
- RV=(double *)malloc( sizeofk );
- SV=(double *)malloc( sizeofk );
-
- idb=0;
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
-
- for (j=1;j<=E->parallel.NUM_NEQ[lev][m].pass[k];j++) {
- S[k][j-1] = U[m][ E->parallel.EXCHANGE_ID[lev][m][j].pass[k] ];
- }
-
- if (E->parallel.PROCESSOR[lev][m].pass[k] != E->parallel.me &&
- E->parallel.PROCESSOR[lev][m].pass[k] != -1) {
- idb ++;
- MPI_Isend(S[k], E->parallel.NUM_NEQ[lev][m].pass[k], MPI_DOUBLE,
- E->parallel.PROCESSOR[lev][m].pass[k], 1,
- E->parallel.world, &request[idb-1]);
- }
- } /* for k */
- } /* for m */ /* finish sending */
-
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
-
- if (E->parallel.PROCESSOR[lev][m].pass[k] != E->parallel.me &&
- E->parallel.PROCESSOR[lev][m].pass[k] != -1) {
- idb++;
- MPI_Irecv(R[k],E->parallel.NUM_NEQ[lev][m].pass[k], MPI_DOUBLE,
- E->parallel.PROCESSOR[lev][m].pass[k], 1,
- E->parallel.world, &request[idb-1]);
- }
- else {
- for (j=1;j<=E->parallel.NUM_NEQ[lev][m].pass[k];j++)
- U[m][ E->parallel.EXCHANGE_ID[lev][m][j].pass[k] ] += S[k][j-1];
- }
- } /* for k */
- } /* for m */ /* finish receiving */
-
- MPI_Waitall(idb,request,status);
-
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
-
- if (E->parallel.PROCESSOR[lev][m].pass[k] != E->parallel.me &&
- E->parallel.PROCESSOR[lev][m].pass[k] != -1) {
- for (j=1;j<=E->parallel.NUM_NEQ[lev][m].pass[k];j++)
- U[m][ E->parallel.EXCHANGE_ID[lev][m][j].pass[k] ] += R[k][j-1];
- }
- }
- }
-
- /* for vertical direction */
-
- for (k=1;k<=E->parallel.TNUM_PASSz[lev];k++) {
- jj = 0;
- kk = k + E->sphere.max_connections;
-
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for (j=1;j<=E->parallel.NUM_NEQ[lev][m].pass[kk];j++)
- SV[jj++] = U[m][ E->parallel.EXCHANGE_ID[lev][m][j].pass[kk] ];
-
- MPI_Sendrecv(SV, E->parallel.NUM_NEQz[lev].pass[k], MPI_DOUBLE,
- E->parallel.PROCESSORz[lev].pass[k], 1,
- RV, E->parallel.NUM_NEQz[lev].pass[k], MPI_DOUBLE,
- E->parallel.PROCESSORz[lev].pass[k], 1,
- E->parallel.world, &status1);
-
- jj = 0;
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for (j=1;j<=E->parallel.NUM_NEQ[lev][m].pass[kk];j++)
- U[m][ E->parallel.EXCHANGE_ID[lev][m][j].pass[kk] ] += RV[jj++];
- }
-
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
- free((void*) S[k]);
- free((void*) R[k]);
- }
- }
-
- free((void*) SV);
- free((void*) RV);
-
- return;
- }
-
-
-/* ================================================ */
-/* ================================================ */
-static void exchange_node_d(E, U, lev)
- struct All_variables *E;
- double **U;
- int lev;
- {
-
- int ii,j,jj,m,k,kk,t_cap,idb,msginfo[8];
- double *S[73],*R[73], *RV, *SV;
- int mid_recv, sizeofk;
-
- MPI_Status status[100];
- MPI_Status status1;
- MPI_Request request[100];
-
- kk=0;
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
- ++kk;
- sizeofk = (1+E->parallel.NUM_NODE[lev][m].pass[k])*sizeof(double);
- S[kk]=(double *)malloc( sizeofk );
- R[kk]=(double *)malloc( sizeofk );
- }
- }
-
- idb= 0;
- for (k=1;k<=E->parallel.TNUM_PASSz[lev];k++) {
- sizeofk = (1+E->parallel.NUM_NODEz[lev].pass[k])*sizeof(double);
- idb = max(idb,sizeofk);
- }
-
- RV=(double *)malloc( idb );
- SV=(double *)malloc( idb );
-
- idb=0;
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
- kk=k;
-
- for (j=1;j<=E->parallel.NUM_NODE[lev][m].pass[k];j++)
- S[kk][j-1] = U[m][ E->parallel.EXCHANGE_NODE[lev][m][j].pass[k] ];
-
- if (E->parallel.PROCESSOR[lev][m].pass[k]!=E->parallel.me) {
- if (E->parallel.PROCESSOR[lev][m].pass[k]!=-1) {
- idb ++;
- MPI_Isend(S[kk],E->parallel.NUM_NODE[lev][m].pass[k],MPI_DOUBLE,
- E->parallel.PROCESSOR[lev][m].pass[k],1,E->parallel.world,&request[idb-1]);
- }
- }
- } /* for k */
- } /* for m */ /* finish sending */
-
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
- kk=k;
-
- if (E->parallel.PROCESSOR[lev][m].pass[k]!=E->parallel.me) {
- if (E->parallel.PROCESSOR[lev][m].pass[k]!=-1) {
- idb++;
- MPI_Irecv(R[kk],E->parallel.NUM_NODE[lev][m].pass[k],MPI_DOUBLE,
- E->parallel.PROCESSOR[lev][m].pass[k],1,E->parallel.world,&request[idb-1]);
- }
- }
-
- else {
- kk=k;
- for (j=1;j<=E->parallel.NUM_NODE[lev][m].pass[k];j++)
- U[m][ E->parallel.EXCHANGE_NODE[lev][m][j].pass[k] ] += S[kk][j-1];
- }
- } /* for k */
- } /* for m */ /* finish receiving */
-
- MPI_Waitall(idb,request,status);
-
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
- kk=k;
-
- if (E->parallel.PROCESSOR[lev][m].pass[k]!=E->parallel.me)
- if (E->parallel.PROCESSOR[lev][m].pass[k]!=-1) {
- for (j=1;j<=E->parallel.NUM_NODE[lev][m].pass[k];j++)
- U[m][ E->parallel.EXCHANGE_NODE[lev][m][j].pass[k] ] += R[kk][j-1];
- }
- }
- }
-
- /* for vertical direction */
-
- for (k=1;k<=E->parallel.TNUM_PASSz[lev];k++) {
- jj = 0;
- kk = k + E->sphere.max_connections;
-
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for (j=1;j<=E->parallel.NUM_NODE[lev][m].pass[kk];j++)
- SV[jj++] = U[m][ E->parallel.EXCHANGE_NODE[lev][m][j].pass[kk] ];
-
- MPI_Sendrecv(SV,E->parallel.NUM_NODEz[lev].pass[k],MPI_DOUBLE,
- E->parallel.PROCESSORz[lev].pass[k],1,
- RV,E->parallel.NUM_NODEz[lev].pass[k],MPI_DOUBLE,
- E->parallel.PROCESSORz[lev].pass[k],1,E->parallel.world,&status1);
-
- jj = 0;
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for (j=1;j<=E->parallel.NUM_NODE[lev][m].pass[kk];j++)
- U[m][ E->parallel.EXCHANGE_NODE[lev][m][j].pass[kk] ] += RV[jj++];
- }
-
- kk = 0;
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
- kk++;
- free((void*) S[kk]);
- free((void*) R[kk]);
- }
- }
-
- free((void*) SV);
- free((void*) RV);
-
- return;
-}
-
-/* ================================================ */
-/* ================================================ */
-
-static void exchange_node_f(E, U, lev)
- struct All_variables *E;
- float **U;
- int lev;
- {
-
- int ii,j,jj,m,k,kk,t_cap,idb,msginfo[8];
-
- float *S[73],*R[73], *RV, *SV;
- int mid_recv, sizeofk;
-
- MPI_Status status[100];
- MPI_Status status1;
- MPI_Request request[100];
-
- kk=0;
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
- ++kk;
- sizeofk = (1+E->parallel.NUM_NODE[lev][m].pass[k])*sizeof(float);
- S[kk]=(float *)malloc( sizeofk );
- R[kk]=(float *)malloc( sizeofk );
- }
- }
-
- idb= 0;
- for (k=1;k<=E->parallel.TNUM_PASSz[lev];k++) {
- sizeofk = (1+E->parallel.NUM_NODEz[lev].pass[k])*sizeof(float);
- idb = max(idb,sizeofk);
- }
-
- RV=(float *)malloc( idb );
- SV=(float *)malloc( idb );
-
- idb=0;
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
- kk=k;
-
- for (j=1;j<=E->parallel.NUM_NODE[lev][m].pass[k];j++)
- S[kk][j-1] = U[m][ E->parallel.EXCHANGE_NODE[lev][m][j].pass[k] ];
-
- if (E->parallel.PROCESSOR[lev][m].pass[k]!=E->parallel.me) {
- if (E->parallel.PROCESSOR[lev][m].pass[k]!=-1) {
- idb ++;
- MPI_Isend(S[kk],E->parallel.NUM_NODE[lev][m].pass[k],MPI_FLOAT,
- E->parallel.PROCESSOR[lev][m].pass[k],1,E->parallel.world,&request[idb-1]);
- }
- }
- } /* for k */
- } /* for m */ /* finish sending */
-
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
- kk=k;
-
- if (E->parallel.PROCESSOR[lev][m].pass[k]!=E->parallel.me) {
- if (E->parallel.PROCESSOR[lev][m].pass[k]!=-1) {
- idb++;
- MPI_Irecv(R[kk],E->parallel.NUM_NODE[lev][m].pass[k],MPI_FLOAT,
- E->parallel.PROCESSOR[lev][m].pass[k],1,E->parallel.world,&request[idb-1]);
- }
- }
-
- else {
- kk=k;
- for (j=1;j<=E->parallel.NUM_NODE[lev][m].pass[k];j++)
- U[m][ E->parallel.EXCHANGE_NODE[lev][m][j].pass[k] ] += S[kk][j-1];
- }
- } /* for k */
- } /* for m */ /* finish receiving */
-
- MPI_Waitall(idb,request,status);
-
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
- kk=k;
-
- if (E->parallel.PROCESSOR[lev][m].pass[k]!=E->parallel.me)
- if (E->parallel.PROCESSOR[lev][m].pass[k]!=-1) {
- for (j=1;j<=E->parallel.NUM_NODE[lev][m].pass[k];j++)
- U[m][ E->parallel.EXCHANGE_NODE[lev][m][j].pass[k] ] += R[kk][j-1];
- }
- }
- }
-
- /* for vertical direction */
-
- for (k=1;k<=E->parallel.TNUM_PASSz[lev];k++) {
- jj = 0;
- kk = k + E->sphere.max_connections;
-
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for (j=1;j<=E->parallel.NUM_NODE[lev][m].pass[kk];j++)
- SV[jj++] = U[m][ E->parallel.EXCHANGE_NODE[lev][m][j].pass[kk] ];
-
- MPI_Sendrecv(SV,E->parallel.NUM_NODEz[lev].pass[k],MPI_FLOAT,
- E->parallel.PROCESSORz[lev].pass[k],1,
- RV,E->parallel.NUM_NODEz[lev].pass[k],MPI_FLOAT,
- E->parallel.PROCESSORz[lev].pass[k],1,E->parallel.world,&status1);
-
- jj = 0;
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for (j=1;j<=E->parallel.NUM_NODE[lev][m].pass[kk];j++)
- U[m][ E->parallel.EXCHANGE_NODE[lev][m][j].pass[kk] ] += RV[jj++];
- }
-
- kk = 0;
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
- kk++;
- free((void*) S[kk]);
- free((void*) R[kk]);
- }
- }
-
- free((void*) SV);
- free((void*) RV);
-
- return;
- }
-/* ================================================ */
-/* ================================================ */
-
-void full_exchange_snode_f(struct All_variables *E, float **U1,
- float **U2, int lev)
- {
-
- int ii,j,k,m,kk,t_cap,idb,msginfo[8];
- float *S[73],*R[73];
- int mid_recv, sizeofk;
-
- MPI_Status status[100];
- MPI_Status status1;
- MPI_Request request[100];
-
- kk=0;
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- for (k=1;k<=E->parallel.TNUM_PASS[E->mesh.levmax][m];k++) {
- ++kk;
- sizeofk = (1+2*E->parallel.NUM_sNODE[E->mesh.levmax][m].pass[k])*sizeof(float);
- S[kk]=(float *)malloc( sizeofk );
- R[kk]=(float *)malloc( sizeofk );
- }
- }
-
- idb=0;
- /* sending */
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
- kk=k;
-
- /* pack */
- for (j=1;j<=E->parallel.NUM_sNODE[lev][m].pass[k];j++) {
- S[kk][j-1] = U1[m][ E->parallel.EXCHANGE_sNODE[lev][m][j].pass[k] ];
- S[kk][j-1+E->parallel.NUM_sNODE[lev][m].pass[k]]
- = U2[m][ E->parallel.EXCHANGE_sNODE[lev][m][j].pass[k] ];
- }
-
- if (E->parallel.PROCESSOR[lev][m].pass[k]!=E->parallel.me) {
- if (E->parallel.PROCESSOR[lev][m].pass[k]!=-1) {
- idb ++;
- MPI_Isend(S[kk],2*E->parallel.NUM_sNODE[lev][m].pass[k],MPI_FLOAT,
- E->parallel.PROCESSOR[lev][m].pass[k],1,E->parallel.world,&request[idb-1]);
- }
- }
- } /* for k */
- } /* for m */ /* finish sending */
-
- /* receiving */
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
- kk=k;
-
- if (E->parallel.PROCESSOR[lev][m].pass[k]!=E->parallel.me) {
- if (E->parallel.PROCESSOR[lev][m].pass[k]!=-1) {
-
- idb ++;
- MPI_Irecv(R[kk],2*E->parallel.NUM_sNODE[lev][m].pass[k],MPI_FLOAT,
- E->parallel.PROCESSOR[lev][m].pass[k],1,E->parallel.world,&request[idb-1]);
- }
- }
-
- else {
- kk=k;
- for (j=1;j<=E->parallel.NUM_sNODE[lev][m].pass[k];j++) {
- U1[m][ E->parallel.EXCHANGE_sNODE[lev][m][j].pass[k] ] += S[kk][j-1];
- U2[m][ E->parallel.EXCHANGE_sNODE[lev][m][j].pass[k] ] +=
- S[kk][j-1+E->parallel.NUM_sNODE[lev][m].pass[k]];
- }
- }
- } /* for k */
- } /* for m */ /* finish receiving */
-
- MPI_Waitall(idb,request,status);
-
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
- kk=k;
-
- /* unpack */
- if (E->parallel.PROCESSOR[lev][m].pass[k]!=E->parallel.me)
- if (E->parallel.PROCESSOR[lev][m].pass[k]!=-1) {
- for (j=1;j<=E->parallel.NUM_sNODE[lev][m].pass[k];j++) {
- U1[m][ E->parallel.EXCHANGE_sNODE[lev][m][j].pass[k] ] += R[kk][j-1];
- U2[m][ E->parallel.EXCHANGE_sNODE[lev][m][j].pass[k] ] +=
- R[kk][j-1+E->parallel.NUM_sNODE[lev][m].pass[k]];
- }
- }
- }
- }
-
- kk=0;
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- for (k=1;k<=E->parallel.TNUM_PASS[E->mesh.levmax][m];k++) {
- ++kk;
- free((void*) S[kk]);
- free((void*) R[kk]);
- }
- }
-
- return;
- }
-
-
Copied: mc/3D/CitcomS/branches/cxx/lib/Full_parallel_related.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Full_parallel_related.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Full_parallel_related.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Full_parallel_related.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,1368 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+/* Routines here are for intel paragon with MPI */
+
+#include <mpi.h>
+#include <math.h>
+
+#include "element_definitions.h"
+#include "global_defs.h"
+#include "sphere_communication.h"
+
+#include "parallel_related.h"
+
+#include "cproto.h"
+
+
+static void set_horizontal_communicator(struct All_variables*);
+static void set_vertical_communicator(struct All_variables*);
+
+static void exchange_node_d(struct All_variables *, double**, int);
+static void exchange_node_f(struct All_variables *, float**, int);
+
+
+/* ============================================ */
+/* ============================================ */
+
+void full_parallel_processor_setup(struct All_variables *E)
+ {
+
+ int i,j,k,m,me,temp,pid_surf;
+ int cap_id_surf;
+ int surf_proc_per_cap, proc_per_cap, total_proc;
+
+ me = E->parallel.me;
+
+ if ( E->parallel.nprocx != E->parallel.nprocy ) {
+ if (E->parallel.me==0) fprintf(stderr,"!!!! nprocx must equal to nprocy \n");
+ parallel_process_termination();
+ }
+
+ surf_proc_per_cap = E->parallel.nprocx * E->parallel.nprocy;
+ proc_per_cap = surf_proc_per_cap * E->parallel.nprocz;
+ total_proc = E->sphere.caps * proc_per_cap;
+ E->parallel.total_surf_proc = E->sphere.caps * surf_proc_per_cap;
+
+ if ( total_proc != E->parallel.nproc ) {
+ if (E->parallel.me==0) fprintf(stderr,"!!!! # of requested CPU is incorrect \n");
+ parallel_process_termination();
+ }
+
+ E->sphere.caps_per_proc = max(1,E->sphere.caps*E->parallel.nprocz/E->parallel.nproc);
+
+ if (E->sphere.caps_per_proc > 1) {
+ if (E->parallel.me==0) fprintf(stderr,"!!!! # caps per proc > 1 is not supported.\n \n");
+ parallel_process_termination();
+ }
+
+ /* determine the location of processors in each cap */
+ cap_id_surf = me / proc_per_cap;
+
+ /* z-direction first*/
+ E->parallel.me_loc[3] = (me - cap_id_surf*proc_per_cap) % E->parallel.nprocz;
+
+ /* x-direction then*/
+ E->parallel.me_loc[1] = ((me - cap_id_surf*proc_per_cap - E->parallel.me_loc[3])/E->parallel.nprocz) % E->parallel.nprocx;
+
+ /* y-direction then*/
+ E->parallel.me_loc[2] = ((((me - cap_id_surf*proc_per_cap - E->parallel.me_loc[3])/E->parallel.nprocz) - E->parallel.me_loc[1])/E->parallel.nprocx) % E->parallel.nprocy;
+
+
+/*
+the numbering of proc in each caps is as so (example for an xyz = 2x2x2 box):
+NOTE: This is different (in a way) than the numbering of the nodes:
+the nodeal number has the first oordinate as theta, which goes N-S and
+the second oordinate as fi, which goes E-W. Here we use R-L as the first
+oordinate and F-B
+ 0 = lower left front corner=[000] 4 = lower left back corner=[010]
+ 1 = upper left front corner=[001] 5 = upper left back corner=[011]
+ 2 = lower right front corner=[100] 6 = lower right back corner=[110]
+ 3 = upper right front corner=[101] 7 = upper right back corner=[111]
+[xyz] is x=E->parallel.me_loc[1],y=E->parallel.me_loc[2],z=E->parallel.me_loc[3]
+*/
+
+ /* determine cap id for each cap in a given processor */
+ pid_surf = me/proc_per_cap; /* cap number (0~11) */
+ i = cases[E->sphere.caps_per_proc]; /* 1 for more than 12 processors */
+
+ for (j=1;j<=E->sphere.caps_per_proc;j++) {
+ temp = pid_surf*E->sphere.caps_per_proc + j-1; /* cap number (out of 12) */
+ E->sphere.capid[j] = incases1[i].links[temp]; /* id (1~12) of the current cap */
+ }
+
+ /* determine which caps are linked with each of 12 caps */
+ /* if the 12 caps are broken, set these up instead */
+ if (surf_proc_per_cap > 1) {
+ E->sphere.max_connections = 8;
+ }
+
+ /* steup location-to-processor map */
+ E->parallel.loc2proc_map = (int ****) malloc(E->sphere.caps*sizeof(int ***));
+ for (m=0;m<E->sphere.caps;m++) {
+ E->parallel.loc2proc_map[m] = (int ***) malloc(E->parallel.nprocx*sizeof(int **));
+ for (i=0;i<E->parallel.nprocx;i++) {
+ E->parallel.loc2proc_map[m][i] = (int **) malloc(E->parallel.nprocy*sizeof(int *));
+ for (j=0;j<E->parallel.nprocy;j++)
+ E->parallel.loc2proc_map[m][i][j] = (int *) malloc(E->parallel.nprocz*sizeof(int));
+ }
+ }
+
+ for (m=0;m<E->sphere.caps;m++)
+ for (i=0;i<E->parallel.nprocx;i++)
+ for (j=0;j<E->parallel.nprocy;j++)
+ for (k=0;k<E->parallel.nprocz;k++) {
+ if (E->sphere.caps_per_proc>1) {
+ temp = cases[E->sphere.caps_per_proc];
+ E->parallel.loc2proc_map[m][i][j][k] = incases2[temp].links[m-1];
+ }
+ else
+ E->parallel.loc2proc_map[m][i][j][k] = m*proc_per_cap
+ + j*E->parallel.nprocx*E->parallel.nprocz
+ + i*E->parallel.nprocz + k;
+ }
+
+ if (E->control.verbose) {
+ fprintf(E->fp_out,"me=%d loc1=%d loc2=%d loc3=%d\n",me,E->parallel.me_loc[1],E->parallel.me_loc[2],E->parallel.me_loc[3]);
+ for (j=1;j<=E->sphere.caps_per_proc;j++) {
+ fprintf(E->fp_out,"capid[%d]=%d \n",j,E->sphere.capid[j]);
+ }
+ for (m=0;m<E->sphere.caps;m++)
+ for (j=0;j<E->parallel.nprocy;j++)
+ for (i=0;i<E->parallel.nprocx;i++)
+ for (k=0;k<E->parallel.nprocz;k++)
+ fprintf(E->fp_out,"loc2proc_map[cap=%d][x=%d][y=%d][z=%d] = %d\n",
+ m,i,j,k,E->parallel.loc2proc_map[m][i][j][k]);
+
+ fflush(E->fp_out);
+ }
+
+ set_vertical_communicator(E);
+ set_horizontal_communicator(E);
+
+ E->exchange_node_d = exchange_node_d;
+ E->exchange_node_f = exchange_node_f;
+
+ return;
+ }
+
+
+
+static void set_horizontal_communicator(struct All_variables *E)
+{
+ MPI_Group world_g, horizon_g;
+ int i,j,k,m,n;
+ int *processors;
+
+ processors = (int *) malloc((E->parallel.total_surf_proc+1)*sizeof(int));
+
+ k = E->parallel.me_loc[3];
+ n = 0;
+ for (m=0;m<E->sphere.caps;m++)
+ for (i=0;i<E->parallel.nprocx;i++)
+ for (j=0;j<E->parallel.nprocy;j++) {
+ processors[n] = E->parallel.loc2proc_map[m][i][j][k];
+ n++;
+ }
+
+ MPI_Comm_group(E->parallel.world, &world_g);
+ MPI_Group_incl(world_g, E->parallel.total_surf_proc, processors, &horizon_g);
+ MPI_Comm_create(E->parallel.world, horizon_g, &(E->parallel.horizontal_comm));
+
+ if (E->control.verbose) {
+ fprintf(E->fp_out,"horizontal group of me=%d loc3=%d\n",E->parallel.me,E->parallel.me_loc[3]);
+ for (j=0;j<E->parallel.total_surf_proc;j++) {
+ fprintf(E->fp_out,"%d proc=%d\n",j,processors[j]);
+ }
+ fflush(E->fp_out);
+ }
+
+ MPI_Group_free(&horizon_g);
+ MPI_Group_free(&world_g);
+ free((void *) processors);
+
+ return;
+}
+
+
+static void set_vertical_communicator(struct All_variables *E)
+{
+ MPI_Group world_g, vertical_g;
+ int i,j,k,m;
+ int *processors;
+
+ processors = (int *)malloc((E->parallel.nprocz+2)*sizeof(int));
+
+ m = E->sphere.capid[1] - 1; /* assume 1 cap per proc. */
+ i = E->parallel.me_loc[1];
+ j = E->parallel.me_loc[2];
+
+ for (k=0;k<E->parallel.nprocz;k++) {
+ processors[k] = E->parallel.loc2proc_map[m][i][j][k];
+ }
+
+ MPI_Comm_group(E->parallel.world, &world_g);
+ MPI_Group_incl(world_g, E->parallel.nprocz, processors, &vertical_g);
+ MPI_Comm_create(E->parallel.world, vertical_g, &(E->parallel.vertical_comm));
+
+ if (E->control.verbose) {
+ fprintf(E->fp_out,"vertical group of me=%d loc1=%d loc2=%d\n",E->parallel.me,E->parallel.me_loc[1],E->parallel.me_loc[2]);
+ for (j=0;j<E->parallel.nprocz;j++) {
+ fprintf(E->fp_out,"%d proc=%d\n",j,processors[j]);
+ }
+ fflush(E->fp_out);
+ }
+
+ MPI_Group_free(&vertical_g);
+ MPI_Group_free(&world_g);
+ free((void *) processors);
+}
+
+
+/* =========================================================================
+get element information for each processor.
+ ========================================================================= */
+
+void full_parallel_domain_decomp0(struct All_variables *E)
+ {
+
+ int i,nox,noz,noy,me;
+
+ me = E->parallel.me;
+
+ E->lmesh.elx = E->mesh.elx/E->parallel.nprocx;
+ E->lmesh.elz = E->mesh.elz/E->parallel.nprocz;
+ E->lmesh.ely = E->mesh.ely/E->parallel.nprocy;
+ E->lmesh.nox = E->lmesh.elx + 1;
+ E->lmesh.noz = E->lmesh.elz + 1;
+ E->lmesh.noy = E->lmesh.ely + 1;
+
+ E->lmesh.exs = E->parallel.me_loc[1]*E->lmesh.elx;
+ E->lmesh.eys = E->parallel.me_loc[2]*E->lmesh.ely;
+ E->lmesh.ezs = E->parallel.me_loc[3]*E->lmesh.elz;
+ E->lmesh.nxs = E->parallel.me_loc[1]*E->lmesh.elx+1;
+ E->lmesh.nys = E->parallel.me_loc[2]*E->lmesh.ely+1;
+ E->lmesh.nzs = E->parallel.me_loc[3]*E->lmesh.elz+1;
+
+ E->lmesh.nno = E->lmesh.noz*E->lmesh.nox*E->lmesh.noy;
+ E->lmesh.nel = E->lmesh.ely*E->lmesh.elx*E->lmesh.elz;
+ E->lmesh.npno = E->lmesh.nel;
+
+ E->lmesh.nsf = E->lmesh.nno/E->lmesh.noz;
+ E->lmesh.snel = E->lmesh.elx*E->lmesh.ely;
+
+ for(i=E->mesh.levmax;i>=E->mesh.levmin;i--) {
+
+ if (E->control.NMULTIGRID||E->control.EMULTIGRID) {
+ nox = E->lmesh.elx/(int)pow(2.0,(double)(E->mesh.levmax-i))+1;
+ noy = E->lmesh.ely/(int)pow(2.0,(double)(E->mesh.levmax-i))+1;
+ noz = E->lmesh.elz/(int)pow(2.0,(double)(E->mesh.levmax-i))+1;
+ E->parallel.redundant[i]=0;
+ }
+ else
+ { noz = E->lmesh.noz;
+ noy = E->lmesh.noy;
+ nox = E->lmesh.nox;
+ }
+
+ E->lmesh.ELX[i] = nox-1;
+ E->lmesh.ELY[i] = noy-1;
+ E->lmesh.ELZ[i] = noz-1;
+ E->lmesh.NOZ[i] = noz;
+ E->lmesh.NOY[i] = noy;
+ E->lmesh.NOX[i] = nox;
+ E->lmesh.NNO[i] = nox * noz * noy;
+ E->lmesh.NNOV[i] = E->lmesh.NNO[i];
+ E->lmesh.SNEL[i] = E->lmesh.ELX[i]*E->lmesh.ELY[i];
+
+ E->lmesh.NEL[i] = (nox-1) * (noz-1) * (noy-1);
+ E->lmesh.NPNO[i] = E->lmesh.NEL[i] ;
+
+ E->lmesh.NEQ[i] = E->mesh.nsd * E->lmesh.NNOV[i] ;
+
+ E->lmesh.EXS[i] = E->parallel.me_loc[1]*E->lmesh.ELX[i];
+ E->lmesh.EYS[i] = E->parallel.me_loc[2]*E->lmesh.ELY[i];
+ E->lmesh.EZS[i] = E->parallel.me_loc[3]*E->lmesh.ELZ[i];
+ E->lmesh.NXS[i] = E->parallel.me_loc[1]*E->lmesh.ELX[i]+1;
+ E->lmesh.NYS[i] = E->parallel.me_loc[2]*E->lmesh.ELY[i]+1;
+ E->lmesh.NZS[i] = E->parallel.me_loc[3]*E->lmesh.ELZ[i]+1;
+ }
+
+/*
+fprintf(stderr,"b %d %d %d %d %d %d %d\n",E->parallel.me,E->parallel.me_loc[1],E->parallel.me_loc[2],E->parallel.me_loc[3],E->lmesh.nzs,E->lmesh.nys,E->lmesh.noy);
+*/
+/* parallel_process_termination();
+*/
+ return;
+ }
+
+
+
+/* ============================================
+ determine boundary nodes for
+ exchange info across the boundaries
+ ============================================ */
+
+void full_parallel_domain_boundary_nodes(struct All_variables *E)
+ {
+ int m,i,ii,j,k,l,node,el,lnode;
+ int lev,ele,elx,elz,ely,nel,nno,nox,noz,noy;
+ FILE *fp;
+ char output_file[255];
+
+ for(lev=E->mesh.gridmin;lev<=E->mesh.gridmax;lev++) {
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+ nel = E->lmesh.NEL[lev];
+ elx = E->lmesh.ELX[lev];
+ elz = E->lmesh.ELZ[lev];
+ ely = E->lmesh.ELY[lev];
+ nox = E->lmesh.NOX[lev];
+ noy = E->lmesh.NOY[lev];
+ noz = E->lmesh.NOZ[lev];
+ nno = E->lmesh.NNO[lev];
+
+/* do the ZOY boundary elements first */
+ lnode = 0;
+ ii =1; /* left */
+ for(j=1;j<=noz;j++)
+ for(k=1;k<=noy;k++) {
+ node = j + (k-1)*noz*nox;
+ E->parallel.NODE[lev][m][++lnode].bound[ii] = node;
+ E->NODE[lev][m][node] = E->NODE[lev][m][node] | OFFSIDE;
+ }
+
+ E->parallel.NUM_NNO[lev][m].bound[ii] = lnode;
+
+
+ lnode = 0;
+ ii =2; /* right */
+ for(j=1;j<=noz;j++)
+ for(k=1;k<=noy;k++) {
+ node = (nox-1)*noz + j + (k-1)*noz*nox;
+ E->parallel.NODE[lev][m][++lnode].bound[ii] = node;
+ E->NODE[lev][m][node] = E->NODE[lev][m][node] | OFFSIDE;
+ }
+
+ E->parallel.NUM_NNO[lev][m].bound[ii] = lnode;
+
+
+/* do XOY boundary elements */
+ ii=5; /* bottom */
+ lnode=0;
+ for(k=1;k<=noy;k++)
+ for(i=1;i<=nox;i++) {
+ node = (k-1)*nox*noz + (i-1)*noz + 1;
+ E->parallel.NODE[lev][m][++lnode].bound[ii] = node;
+ E->NODE[lev][m][node] = E->NODE[lev][m][node] | OFFSIDE;
+ }
+
+ E->parallel.NUM_NNO[lev][m].bound[ii] = lnode;
+
+ ii=6; /* top */
+ lnode=0;
+ for(k=1;k<=noy;k++)
+ for(i=1;i<=nox;i++) {
+ node = (k-1)*nox*noz + i*noz;
+ E->parallel.NODE[lev][m][++lnode].bound[ii] = node;
+ E->NODE[lev][m][node] = E->NODE[lev][m][node] | OFFSIDE;
+ }
+
+ E->parallel.NUM_NNO[lev][m].bound[ii] = lnode;
+
+
+/* do XOZ boundary elements for 3D */
+ ii=3; /* front */
+ lnode=0;
+ for(j=1;j<=noz;j++)
+ for(i=1;i<=nox;i++) {
+ node = (i-1)*noz +j;
+ E->parallel.NODE[lev][m][++lnode].bound[ii] = node;
+ E->NODE[lev][m][node] = E->NODE[lev][m][node] | OFFSIDE;
+ }
+
+ E->parallel.NUM_NNO[lev][m].bound[ii] = lnode;
+
+ ii=4; /* rear */
+ lnode=0;
+ for(j=1;j<=noz;j++)
+ for(i=1;i<=nox;i++) {
+ node = noz*nox*(noy-1) + (i-1)*noz +j;
+ E->parallel.NODE[lev][m][++lnode].bound[ii] = node;
+ E->NODE[lev][m][node] = E->NODE[lev][m][node] | OFFSIDE;
+ }
+
+ E->parallel.NUM_NNO[lev][m].bound[ii] = lnode;
+
+ /* determine the overlapped nodes between caps or between proc */
+
+ /* horizontal direction:
+ all nodes at right (ix==nox) and front (iy==1) faces
+ are skipped */
+ for (lnode=1;lnode<=E->parallel.NUM_NNO[lev][m].bound[2];lnode++) {
+ node = E->parallel.NODE[lev][m][lnode].bound[2];
+ E->NODE[lev][m][node] = E->NODE[lev][m][node] | SKIP;
+ }
+
+ for (lnode=1;lnode<=E->parallel.NUM_NNO[lev][m].bound[3];lnode++) {
+ node = E->parallel.NODE[lev][m][lnode].bound[3];
+ E->NODE[lev][m][node] = E->NODE[lev][m][node] | SKIP;
+ }
+
+ /* nodes at N/S poles are skipped by all proc.
+ add them back here */
+
+ /* north pole is at the front left proc. of 1st cap */
+ if (E->sphere.capid[m] == 1 &&
+ E->parallel.me_loc[1] == 0 &&
+ E->parallel.me_loc[2] == 0)
+ for(j=1;j<=noz;j++) {
+ node = j;
+ E->NODE[lev][m][node] = E->NODE[lev][m][node] & ~SKIP;
+ }
+
+ /* south pole is at the back right proc. of final cap */
+ if (E->sphere.capid[m] == E->sphere.caps &&
+ E->parallel.me_loc[1] == E->parallel.nprocx-1 &&
+ E->parallel.me_loc[2] == E->parallel.nprocy-1)
+ for(j=1;j<=noz;j++) {
+ node = j*nox*noy;
+ E->NODE[lev][m][node] = E->NODE[lev][m][node] & ~SKIP;
+ }
+
+ /* radial direction is easy:
+ all top nodes except those at top processors are skipped */
+ if (E->parallel.me_loc[3]!=E->parallel.nprocz-1 )
+ for (lnode=1;lnode<=E->parallel.NUM_NNO[lev][m].bound[6];lnode++) {
+ node = E->parallel.NODE[lev][m][lnode].bound[6];
+ E->NODE[lev][m][node] = E->NODE[lev][m][node] | SKIP;
+ }
+
+ } /* end for m */
+ } /* end for level */
+
+
+if (E->control.verbose) {
+ fprintf(E->fp_out,"output_shared_nodes %d \n",E->parallel.me);
+ for(lev=E->mesh.gridmax;lev>=E->mesh.gridmin;lev--)
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ fprintf(E->fp_out,"lev=%d me=%d capid=%d m=%d \n",lev,E->parallel.me,E->sphere.capid[m],m);
+ for (ii=1;ii<=6;ii++)
+ for (i=1;i<=E->parallel.NUM_NNO[lev][m].bound[ii];i++)
+ fprintf(E->fp_out,"ii=%d %d %d \n",ii,i,E->parallel.NODE[lev][m][i].bound[ii]);
+
+ lnode=0;
+ for (node=1;node<=E->lmesh.NNO[lev];node++)
+ if((E->NODE[lev][m][node] & SKIP)) {
+ lnode++;
+ fprintf(E->fp_out,"skip %d %d \n",lnode,node);
+ }
+ }
+ fflush(E->fp_out);
+ }
+
+
+
+ return;
+ }
+
+
+/* ============================================
+ determine communication routs and boundary ID for
+ exchange info across the boundaries
+ assuming fault nodes are in the top row of processors
+ ============================================ */
+
+static void face_eqn_node_to_pass(struct All_variables *, int, int, int, int);
+static void line_eqn_node_to_pass(struct All_variables *, int, int, int, int, int, int);
+
+void full_parallel_communication_routs_v(struct All_variables *E)
+ {
+
+ int m,i,ii,j,k,l,node,el,elt,lnode,jj,doff,target;
+ int lev,elx,elz,ely,nno,nox,noz,noy,p,kkk,kk,kf,kkkp;
+ int me, nprocx,nprocy,nprocz,nprocxz;
+ int tscaps,cap,scap,large,npass,lx,ly,lz,temp,layer;
+
+ const int dims=E->mesh.nsd;
+
+ me = E->parallel.me;
+ nprocx = E->parallel.nprocx;
+ nprocy = E->parallel.nprocy;
+ nprocz = E->parallel.nprocz;
+ nprocxz = nprocx * nprocz;
+ tscaps = E->parallel.total_surf_proc;
+ lx = E->parallel.me_loc[1];
+ ly = E->parallel.me_loc[2];
+ lz = E->parallel.me_loc[3];
+
+ /* determine the communications in horizontal direction */
+ for(lev=E->mesh.gridmax;lev>=E->mesh.gridmin;lev--) {
+ nox = E->lmesh.NOX[lev];
+ noz = E->lmesh.NOZ[lev];
+ noy = E->lmesh.NOY[lev];
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+ cap = E->sphere.capid[m] - 1; /* which cap I am in (0~11) */
+
+ /* -X face */
+ npass = ii = 1;
+ if (lx != 0)
+ target = E->parallel.loc2proc_map[cap][lx-1][ly][lz];
+ else
+ if ( cap%3 != 0) {
+ temp = (cap+2) % 12;
+ target = E->parallel.loc2proc_map[temp][nprocx-1][ly][lz];
+ }
+ else {
+ temp = (cap+3) % 12;
+ target = E->parallel.loc2proc_map[temp][ly][0][lz];
+ }
+
+ E->parallel.PROCESSOR[lev][m].pass[npass] = target;
+ face_eqn_node_to_pass(E,lev,m,npass,ii);
+
+ /* +X face */
+ npass = ii = 2;
+ if (lx != nprocx-1)
+ target = E->parallel.loc2proc_map[cap][lx+1][ly][lz];
+ else
+ if ( cap%3 != 2) {
+ temp = (12+cap-2) % 12;
+ target = E->parallel.loc2proc_map[temp][0][ly][lz];
+ }
+ else {
+ temp = (12+cap-3) % 12;
+ target = E->parallel.loc2proc_map[temp][ly][nprocy-1][lz];
+ }
+ E->parallel.PROCESSOR[lev][m].pass[npass] = target;
+ face_eqn_node_to_pass(E,lev,m,npass,ii);
+
+ /* -Y face */
+ npass = ii = 3;
+ if (ly != 0)
+ target = E->parallel.loc2proc_map[cap][lx][ly-1][lz];
+ else
+ if ( cap%3 != 0) {
+ temp = cap-1;
+ target = E->parallel.loc2proc_map[temp][lx][nprocy-1][lz];
+ }
+ else {
+ temp = (12+cap-3) % 12;
+ target = E->parallel.loc2proc_map[temp][0][lx][lz];
+ }
+
+ E->parallel.PROCESSOR[lev][m].pass[npass] = target;
+ face_eqn_node_to_pass(E,lev,m,npass,ii);
+
+ /* +Y face */
+ npass = ii = 4;
+ if (ly != nprocy-1)
+ target = E->parallel.loc2proc_map[cap][lx][ly+1][lz];
+ else
+ if ( cap%3 != 2) {
+ temp = cap+1;
+ target = E->parallel.loc2proc_map[temp][lx][0][lz];
+ }
+ else {
+ temp = (cap+3) % 12;
+ target = E->parallel.loc2proc_map[temp][nprocx-1][lx][lz];
+ }
+
+ E->parallel.PROCESSOR[lev][m].pass[npass] = target;
+ face_eqn_node_to_pass(E,lev,m,npass,ii);
+
+ /* do lines parallel to Z */
+
+ /* -X-Y line */
+ if (!( (cap%3==1) && (lx==0) && (ly==0) )) {
+ npass ++;
+ if ((cap%3==0) && (lx==0) && (ly==0)) {
+ temp = (cap+6) % 12;
+ target = E->parallel.loc2proc_map[temp][lx][ly][lz];
+ }
+ else if ((cap%3==0) && (lx==0))
+ target = E->parallel.PROCESSOR[lev][m].pass[1] - nprocz;
+ else if ((cap%3==0) && (ly==0))
+ target = E->parallel.PROCESSOR[lev][m].pass[3] - nprocxz;
+ else
+ target = E->parallel.PROCESSOR[lev][m].pass[1] - nprocxz;
+
+ E->parallel.PROCESSOR[lev][m].pass[npass] = target;
+ line_eqn_node_to_pass(E,lev,m,npass,noz,1,1);
+ }
+
+ /* +X+Y line */
+ if (!( (cap%3==1) && (lx==nprocx-1) && (ly==nprocy-1) )) {
+ npass ++;
+ if ((cap%3==2) && (lx==nprocx-1) && (ly==nprocy-1)) {
+ temp = (cap+6) % 12;
+ target = E->parallel.loc2proc_map[temp][lx][ly][lz];
+ }
+ else if ((cap%3==2) && (lx==nprocx-1))
+ target = E->parallel.PROCESSOR[lev][m].pass[2] + nprocz;
+ else if ((cap%3==2) && (ly==nprocy-1))
+ target = E->parallel.PROCESSOR[lev][m].pass[4] + nprocxz;
+ else
+ target = E->parallel.PROCESSOR[lev][m].pass[2] + nprocxz;
+
+ E->parallel.PROCESSOR[lev][m].pass[npass] = target;
+ line_eqn_node_to_pass(E,lev,m,npass,noz,(noy*nox-1)*noz+1,1);
+ }
+
+ /* -X+Y line */
+ if (!( (cap%3==2 || cap%3==0) && (lx==0) && (ly==nprocy-1) )) {
+ npass ++;
+ if ((cap%3==2) && (ly==nprocy-1))
+ target = E->parallel.PROCESSOR[lev][m].pass[4] - nprocxz;
+ else if ((cap%3==0) && (lx==0))
+ target = E->parallel.PROCESSOR[lev][m].pass[1] + nprocz;
+ else
+ target = E->parallel.PROCESSOR[lev][m].pass[1] + nprocxz;
+
+ E->parallel.PROCESSOR[lev][m].pass[npass] = target;
+ line_eqn_node_to_pass(E,lev,m,npass,noz,(noy-1)*nox*noz+1,1);
+ }
+
+ /* +X-Y line */
+ if (!( (cap%3==2 || cap%3==0) && (lx==nprocx-1) && (ly==0) )) {
+ npass ++;
+ if ((cap%3==2) && (lx==nprocx-1))
+ target = E->parallel.PROCESSOR[lev][m].pass[2] - nprocz;
+ else if ((cap%3==0) && (ly==0))
+ target = E->parallel.PROCESSOR[lev][m].pass[3] + nprocxz;
+ else
+ target = E->parallel.PROCESSOR[lev][m].pass[2] - nprocxz;
+
+ E->parallel.PROCESSOR[lev][m].pass[npass] = target;
+ line_eqn_node_to_pass(E,lev,m,npass,noz,(nox-1)*noz+1,1);
+ }
+
+
+ E->parallel.TNUM_PASS[lev][m] = npass;
+
+ } /* end for m */
+ } /* end for lev */
+
+ /* determine the communications in vertical direction */
+ for(lev=E->mesh.gridmax;lev>=E->mesh.gridmin;lev--) {
+ kkk = 0;
+ for(ii=5;ii<=6;ii++) { /* do top & bottom */
+ E->parallel.NUM_PASSz[lev].bound[ii] = 1;
+ if(lz==0 && ii==5)
+ E->parallel.NUM_PASSz[lev].bound[ii] = 0;
+ else if(lz==nprocz-1 && ii==6)
+ E->parallel.NUM_PASSz[lev].bound[ii] = 0;
+
+ for (p=1;p<=E->parallel.NUM_PASSz[lev].bound[ii];p++) {
+ kkk ++;
+ /* determine the pass ID for ii-th boundary and p-th pass */
+ kkkp = kkk + E->sphere.max_connections;
+
+ E->parallel.NUM_NODEz[lev].pass[kkk] = 0;
+ E->parallel.NUM_NEQz[lev].pass[kkk] = 0;
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+ cap = E->sphere.capid[m] - 1; /* which cap I am in (0~11) */
+ E->parallel.PROCESSORz[lev].pass[kkk] =
+ E->parallel.loc2proc_map[cap][lx][ly][lz+((ii==5)?-1:1)];
+
+ jj=0; kk=0;
+ for (k=1;k<=E->parallel.NUM_NNO[lev][m].bound[ii];k++) {
+ node = E->parallel.NODE[lev][m][k].bound[ii];
+ E->parallel.EXCHANGE_NODE[lev][m][++kk].pass[kkkp] = node;
+ for(doff=1;doff<=dims;doff++)
+ E->parallel.EXCHANGE_ID[lev][m][++jj].pass[kkkp] =
+ E->ID[lev][m][node].doff[doff];
+ }
+ E->parallel.NUM_NODE[lev][m].pass[kkkp] = kk;
+ E->parallel.NUM_NEQ[lev][m].pass[kkkp] = jj;
+ E->parallel.NUM_NODEz[lev].pass[kkk] += kk;
+ E->parallel.NUM_NEQz[lev].pass[kkk] += jj;
+ }
+
+ } /* end for loop p */
+ } /* end for j */
+
+ E->parallel.TNUM_PASSz[lev] = kkk;
+ } /* end for level */
+
+
+
+ if(E->control.verbose) {
+ for(lev=E->mesh.gridmax;lev>=E->mesh.gridmin;lev--) {
+ fprintf(E->fp_out,"output_communication route surface for lev=%d \n",lev);
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ fprintf(E->fp_out," me= %d cap=%d pass %d \n",E->parallel.me,E->sphere.capid[m],E->parallel.TNUM_PASS[lev][m]);
+ for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
+ fprintf(E->fp_out,"proc %d and pass %d to proc %d with %d eqn and %d node\n",E->parallel.me,k,E->parallel.PROCESSOR[lev][m].pass[k],E->parallel.NUM_NEQ[lev][m].pass[k],E->parallel.NUM_NODE[lev][m].pass[k]);
+ fprintf(E->fp_out,"Eqn:\n");
+ for (ii=1;ii<=E->parallel.NUM_NEQ[lev][m].pass[k];ii++)
+ fprintf(E->fp_out,"%d %d\n",ii,E->parallel.EXCHANGE_ID[lev][m][ii].pass[k]);
+ fprintf(E->fp_out,"Node:\n");
+ for (ii=1;ii<=E->parallel.NUM_NODE[lev][m].pass[k];ii++)
+ fprintf(E->fp_out,"%d %d\n",ii,E->parallel.EXCHANGE_NODE[lev][m][ii].pass[k]);
+ }
+ }
+
+ fprintf(E->fp_out,"output_communication route vertical \n");
+ fprintf(E->fp_out," me= %d pass %d \n",E->parallel.me,E->parallel.TNUM_PASSz[lev]);
+ for (k=1;k<=E->parallel.TNUM_PASSz[lev];k++) {
+ kkkp = k + E->sphere.max_connections;
+ fprintf(E->fp_out,"proc %d and pass %d to proc %d\n",E->parallel.me,k,E->parallel.PROCESSORz[lev].pass[k]);
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ fprintf(E->fp_out,"cap=%d eqn=%d node=%d\n",E->sphere.capid[m],E->parallel.NUM_NEQ[lev][m].pass[kkkp],E->parallel.NUM_NODE[lev][m].pass[kkkp]);
+ for (ii=1;ii<=E->parallel.NUM_NEQ[lev][m].pass[kkkp];ii++)
+ fprintf(E->fp_out,"%d %d\n",ii,E->parallel.EXCHANGE_ID[lev][m][ii].pass[kkkp]);
+ for (ii=1;ii<=E->parallel.NUM_NODE[lev][m].pass[kkkp];ii++)
+ fprintf(E->fp_out,"%d %d\n",ii,E->parallel.EXCHANGE_NODE[lev][m][ii].pass[kkkp]);
+ }
+ }
+ }
+ fflush(E->fp_out);
+ }
+
+ return;
+ }
+
+
+/* ============================================
+ determine communication routs for
+ exchange info across the boundaries on the surfaces
+ assuming fault nodes are in the top row of processors
+ ============================================ */
+
+void full_parallel_communication_routs_s(struct All_variables *E)
+{
+
+ int i,ii,j,k,l,node,el,elt,lnode,jj,doff;
+ int lev,nno,nox,noz,noy,kkk,kk,kf;
+ int me,m, nprocz;
+
+ const int dims=E->mesh.nsd;
+
+ me = E->parallel.me;
+ nprocz = E->parallel.nprocz;
+
+ /* determine the communications in horizontal direction */
+ for(lev=E->mesh.gridmax;lev>=E->mesh.gridmin;lev--) {
+ nox = E->lmesh.NOX[lev];
+ noz = E->lmesh.NOZ[lev];
+ noy = E->lmesh.NOY[lev];
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+ j = E->sphere.capid[m];
+
+ for (kkk=1;kkk<=E->parallel.TNUM_PASS[lev][m];kkk++) {
+ if (kkk<=4) { /* first 4 communications are for XZ and YZ planes */
+ ii = kkk;
+ E->parallel.NUM_sNODE[lev][m].pass[kkk] =
+ E->parallel.NUM_NNO[lev][m].bound[ii]/noz;
+
+ for (k=1;k<=E->parallel.NUM_sNODE[lev][m].pass[kkk];k++) {
+ lnode = k;
+ node = (E->parallel.NODE[lev][m][lnode].bound[ii]-1)/noz + 1;
+ E->parallel.EXCHANGE_sNODE[lev][m][k].pass[kkk] = node;
+ } /* end for node k */
+ } /* end for first 4 communications */
+
+ else { /* the last FOUR communications are for lines */
+ E->parallel.NUM_sNODE[lev][m].pass[kkk]=1;
+
+ for (k=1;k<=E->parallel.NUM_sNODE[lev][m].pass[kkk];k++) {
+ node = E->parallel.EXCHANGE_NODE[lev][m][k].pass[kkk]/noz + 1;
+ E->parallel.EXCHANGE_sNODE[lev][m][k].pass[kkk] = node;
+ } /* end for node k */
+ } /* end for the last FOUR communications */
+
+ } /* end for kkk */
+ } /* end for m */
+
+ } /* end for lev */
+
+ if(E->control.verbose) {
+ for(lev=E->mesh.gridmax;lev>=E->mesh.gridmin;lev--) {
+ fprintf(E->fp_out,"output_communication route surface for lev=%d \n",lev);
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ fprintf(E->fp_out," me= %d cap=%d pass %d \n",E->parallel.me,E->sphere.capid[m],E->parallel.TNUM_PASS[lev][m]);
+ for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
+ fprintf(E->fp_out,"proc %d and pass %d to proc %d with %d node\n",E->parallel.me,k,E->parallel.PROCESSOR[lev][m].pass[k],E->parallel.NUM_sNODE[lev][m].pass[k]);
+ fprintf(E->fp_out,"Node:\n");
+ for (ii=1;ii<=E->parallel.NUM_sNODE[lev][m].pass[k];ii++)
+ fprintf(E->fp_out,"%d %d\n",ii,E->parallel.EXCHANGE_sNODE[lev][m][ii].pass[k]);
+ }
+ }
+
+ }
+ fflush(E->fp_out);
+ }
+
+ return;
+}
+
+
+
+/* ================================================ */
+/* ================================================ */
+
+static void face_eqn_node_to_pass(
+ struct All_variables *E,
+ int lev, int m, int npass, int bd
+ )
+{
+ int jj,kk,node,doff;
+ const int dims=E->mesh.nsd;
+
+ E->parallel.NUM_NODE[lev][m].pass[npass] = E->parallel.NUM_NNO[lev][m].bound[bd];
+
+ jj = 0;
+ for (kk=1;kk<=E->parallel.NUM_NODE[lev][m].pass[npass];kk++) {
+ node = E->parallel.NODE[lev][m][kk].bound[bd];
+ E->parallel.EXCHANGE_NODE[lev][m][kk].pass[npass] = node;
+ for(doff=1;doff<=dims;doff++)
+ E->parallel.EXCHANGE_ID[lev][m][++jj].pass[npass] = E->ID[lev][m][node].doff[doff];
+ }
+
+ E->parallel.NUM_NEQ[lev][m].pass[npass] = jj;
+
+ return;
+}
+
+/* ================================================ */
+/* ================================================ */
+
+static void line_eqn_node_to_pass(
+ struct All_variables *E,
+ int lev, int m, int npass, int num_node, int offset, int stride
+ )
+{
+ int jj,kk,node,doff;
+ const int dims=E->mesh.nsd;
+
+ E->parallel.NUM_NODE[lev][m].pass[npass] = num_node;
+
+ jj=0;
+ for (kk=1;kk<=E->parallel.NUM_NODE[lev][m].pass[npass];kk++) {
+ node = (kk-1)*stride + offset;
+ E->parallel.EXCHANGE_NODE[lev][m][kk].pass[npass] = node;
+ for(doff=1;doff<=dims;doff++)
+ E->parallel.EXCHANGE_ID[lev][m][++jj].pass[npass] = E->ID[lev][m][node].doff[doff];
+ }
+
+ E->parallel.NUM_NEQ[lev][m].pass[npass] = jj;
+
+ return;
+}
+
+/* ================================================
+WARNING: BUGS AHEAD
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
+
+ sizeofk = (1+E->parallel.NUM_NEQ[lev][m].pass[k])*sizeof(double);
+ S[k]=(double *)malloc( sizeofk );
+ R[k]=(double *)malloc( sizeofk );
+ }
+ }
+
+This piece of code contain a bug. Arrays S and R are allocated for each m.
+But most of the memory is leaked.
+
+In this version of CitcomS, sphere.caps_per_proc is always equal to one.
+So, this bug won't manifest itself. But in other version of CitcomS, it will.
+
+by Tan2 7/21, 2003
+================================================ */
+
+void full_exchange_id_d(
+ struct All_variables *E,
+ double **U,
+ int lev
+ )
+ {
+
+ int ii,j,jj,m,k,kk,t_cap,idb,msginfo[8];
+ double *S[73],*R[73], *RV, *SV;
+ int mid_recv, sizeofk;
+
+ MPI_Status status[100];
+ MPI_Status status1;
+ MPI_Request request[100];
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
+ sizeofk = (1+E->parallel.NUM_NEQ[lev][m].pass[k])*sizeof(double);
+ S[k]=(double *)malloc( sizeofk );
+ R[k]=(double *)malloc( sizeofk );
+ }
+ }
+
+ sizeofk = 0;
+ for (k=1;k<=E->parallel.TNUM_PASSz[lev];k++) {
+ kk = (1+E->parallel.NUM_NEQz[lev].pass[k])*sizeof(double);
+ sizeofk = max(sizeofk, kk);
+ }
+ RV=(double *)malloc( sizeofk );
+ SV=(double *)malloc( sizeofk );
+
+ idb=0;
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
+
+ for (j=1;j<=E->parallel.NUM_NEQ[lev][m].pass[k];j++) {
+ S[k][j-1] = U[m][ E->parallel.EXCHANGE_ID[lev][m][j].pass[k] ];
+ }
+
+ if (E->parallel.PROCESSOR[lev][m].pass[k] != E->parallel.me &&
+ E->parallel.PROCESSOR[lev][m].pass[k] != -1) {
+ idb ++;
+ MPI_Isend(S[k], E->parallel.NUM_NEQ[lev][m].pass[k], MPI_DOUBLE,
+ E->parallel.PROCESSOR[lev][m].pass[k], 1,
+ E->parallel.world, &request[idb-1]);
+ }
+ } /* for k */
+ } /* for m */ /* finish sending */
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
+
+ if (E->parallel.PROCESSOR[lev][m].pass[k] != E->parallel.me &&
+ E->parallel.PROCESSOR[lev][m].pass[k] != -1) {
+ idb++;
+ MPI_Irecv(R[k],E->parallel.NUM_NEQ[lev][m].pass[k], MPI_DOUBLE,
+ E->parallel.PROCESSOR[lev][m].pass[k], 1,
+ E->parallel.world, &request[idb-1]);
+ }
+ else {
+ for (j=1;j<=E->parallel.NUM_NEQ[lev][m].pass[k];j++)
+ U[m][ E->parallel.EXCHANGE_ID[lev][m][j].pass[k] ] += S[k][j-1];
+ }
+ } /* for k */
+ } /* for m */ /* finish receiving */
+
+ MPI_Waitall(idb,request,status);
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
+
+ if (E->parallel.PROCESSOR[lev][m].pass[k] != E->parallel.me &&
+ E->parallel.PROCESSOR[lev][m].pass[k] != -1) {
+ for (j=1;j<=E->parallel.NUM_NEQ[lev][m].pass[k];j++)
+ U[m][ E->parallel.EXCHANGE_ID[lev][m][j].pass[k] ] += R[k][j-1];
+ }
+ }
+ }
+
+ /* for vertical direction */
+
+ for (k=1;k<=E->parallel.TNUM_PASSz[lev];k++) {
+ jj = 0;
+ kk = k + E->sphere.max_connections;
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for (j=1;j<=E->parallel.NUM_NEQ[lev][m].pass[kk];j++)
+ SV[jj++] = U[m][ E->parallel.EXCHANGE_ID[lev][m][j].pass[kk] ];
+
+ MPI_Sendrecv(SV, E->parallel.NUM_NEQz[lev].pass[k], MPI_DOUBLE,
+ E->parallel.PROCESSORz[lev].pass[k], 1,
+ RV, E->parallel.NUM_NEQz[lev].pass[k], MPI_DOUBLE,
+ E->parallel.PROCESSORz[lev].pass[k], 1,
+ E->parallel.world, &status1);
+
+ jj = 0;
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for (j=1;j<=E->parallel.NUM_NEQ[lev][m].pass[kk];j++)
+ U[m][ E->parallel.EXCHANGE_ID[lev][m][j].pass[kk] ] += RV[jj++];
+ }
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
+ free((void*) S[k]);
+ free((void*) R[k]);
+ }
+ }
+
+ free((void*) SV);
+ free((void*) RV);
+
+ return;
+ }
+
+
+/* ================================================ */
+/* ================================================ */
+static void exchange_node_d(
+ struct All_variables *E,
+ double **U,
+ int lev
+ )
+ {
+
+ int ii,j,jj,m,k,kk,t_cap,idb,msginfo[8];
+ double *S[73],*R[73], *RV, *SV;
+ int mid_recv, sizeofk;
+
+ MPI_Status status[100];
+ MPI_Status status1;
+ MPI_Request request[100];
+
+ kk=0;
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
+ ++kk;
+ sizeofk = (1+E->parallel.NUM_NODE[lev][m].pass[k])*sizeof(double);
+ S[kk]=(double *)malloc( sizeofk );
+ R[kk]=(double *)malloc( sizeofk );
+ }
+ }
+
+ idb= 0;
+ for (k=1;k<=E->parallel.TNUM_PASSz[lev];k++) {
+ sizeofk = (1+E->parallel.NUM_NODEz[lev].pass[k])*sizeof(double);
+ idb = max(idb,sizeofk);
+ }
+
+ RV=(double *)malloc( idb );
+ SV=(double *)malloc( idb );
+
+ idb=0;
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
+ kk=k;
+
+ for (j=1;j<=E->parallel.NUM_NODE[lev][m].pass[k];j++)
+ S[kk][j-1] = U[m][ E->parallel.EXCHANGE_NODE[lev][m][j].pass[k] ];
+
+ if (E->parallel.PROCESSOR[lev][m].pass[k]!=E->parallel.me) {
+ if (E->parallel.PROCESSOR[lev][m].pass[k]!=-1) {
+ idb ++;
+ MPI_Isend(S[kk],E->parallel.NUM_NODE[lev][m].pass[k],MPI_DOUBLE,
+ E->parallel.PROCESSOR[lev][m].pass[k],1,E->parallel.world,&request[idb-1]);
+ }
+ }
+ } /* for k */
+ } /* for m */ /* finish sending */
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
+ kk=k;
+
+ if (E->parallel.PROCESSOR[lev][m].pass[k]!=E->parallel.me) {
+ if (E->parallel.PROCESSOR[lev][m].pass[k]!=-1) {
+ idb++;
+ MPI_Irecv(R[kk],E->parallel.NUM_NODE[lev][m].pass[k],MPI_DOUBLE,
+ E->parallel.PROCESSOR[lev][m].pass[k],1,E->parallel.world,&request[idb-1]);
+ }
+ }
+
+ else {
+ kk=k;
+ for (j=1;j<=E->parallel.NUM_NODE[lev][m].pass[k];j++)
+ U[m][ E->parallel.EXCHANGE_NODE[lev][m][j].pass[k] ] += S[kk][j-1];
+ }
+ } /* for k */
+ } /* for m */ /* finish receiving */
+
+ MPI_Waitall(idb,request,status);
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
+ kk=k;
+
+ if (E->parallel.PROCESSOR[lev][m].pass[k]!=E->parallel.me)
+ if (E->parallel.PROCESSOR[lev][m].pass[k]!=-1) {
+ for (j=1;j<=E->parallel.NUM_NODE[lev][m].pass[k];j++)
+ U[m][ E->parallel.EXCHANGE_NODE[lev][m][j].pass[k] ] += R[kk][j-1];
+ }
+ }
+ }
+
+ /* for vertical direction */
+
+ for (k=1;k<=E->parallel.TNUM_PASSz[lev];k++) {
+ jj = 0;
+ kk = k + E->sphere.max_connections;
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for (j=1;j<=E->parallel.NUM_NODE[lev][m].pass[kk];j++)
+ SV[jj++] = U[m][ E->parallel.EXCHANGE_NODE[lev][m][j].pass[kk] ];
+
+ MPI_Sendrecv(SV,E->parallel.NUM_NODEz[lev].pass[k],MPI_DOUBLE,
+ E->parallel.PROCESSORz[lev].pass[k],1,
+ RV,E->parallel.NUM_NODEz[lev].pass[k],MPI_DOUBLE,
+ E->parallel.PROCESSORz[lev].pass[k],1,E->parallel.world,&status1);
+
+ jj = 0;
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for (j=1;j<=E->parallel.NUM_NODE[lev][m].pass[kk];j++)
+ U[m][ E->parallel.EXCHANGE_NODE[lev][m][j].pass[kk] ] += RV[jj++];
+ }
+
+ kk = 0;
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
+ kk++;
+ free((void*) S[kk]);
+ free((void*) R[kk]);
+ }
+ }
+
+ free((void*) SV);
+ free((void*) RV);
+
+ return;
+}
+
+/* ================================================ */
+/* ================================================ */
+
+static void exchange_node_f(
+ struct All_variables *E,
+ float **U,
+ int lev
+ )
+ {
+
+ int ii,j,jj,m,k,kk,t_cap,idb,msginfo[8];
+
+ float *S[73],*R[73], *RV, *SV;
+ int mid_recv, sizeofk;
+
+ MPI_Status status[100];
+ MPI_Status status1;
+ MPI_Request request[100];
+
+ kk=0;
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
+ ++kk;
+ sizeofk = (1+E->parallel.NUM_NODE[lev][m].pass[k])*sizeof(float);
+ S[kk]=(float *)malloc( sizeofk );
+ R[kk]=(float *)malloc( sizeofk );
+ }
+ }
+
+ idb= 0;
+ for (k=1;k<=E->parallel.TNUM_PASSz[lev];k++) {
+ sizeofk = (1+E->parallel.NUM_NODEz[lev].pass[k])*sizeof(float);
+ idb = max(idb,sizeofk);
+ }
+
+ RV=(float *)malloc( idb );
+ SV=(float *)malloc( idb );
+
+ idb=0;
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
+ kk=k;
+
+ for (j=1;j<=E->parallel.NUM_NODE[lev][m].pass[k];j++)
+ S[kk][j-1] = U[m][ E->parallel.EXCHANGE_NODE[lev][m][j].pass[k] ];
+
+ if (E->parallel.PROCESSOR[lev][m].pass[k]!=E->parallel.me) {
+ if (E->parallel.PROCESSOR[lev][m].pass[k]!=-1) {
+ idb ++;
+ MPI_Isend(S[kk],E->parallel.NUM_NODE[lev][m].pass[k],MPI_FLOAT,
+ E->parallel.PROCESSOR[lev][m].pass[k],1,E->parallel.world,&request[idb-1]);
+ }
+ }
+ } /* for k */
+ } /* for m */ /* finish sending */
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
+ kk=k;
+
+ if (E->parallel.PROCESSOR[lev][m].pass[k]!=E->parallel.me) {
+ if (E->parallel.PROCESSOR[lev][m].pass[k]!=-1) {
+ idb++;
+ MPI_Irecv(R[kk],E->parallel.NUM_NODE[lev][m].pass[k],MPI_FLOAT,
+ E->parallel.PROCESSOR[lev][m].pass[k],1,E->parallel.world,&request[idb-1]);
+ }
+ }
+
+ else {
+ kk=k;
+ for (j=1;j<=E->parallel.NUM_NODE[lev][m].pass[k];j++)
+ U[m][ E->parallel.EXCHANGE_NODE[lev][m][j].pass[k] ] += S[kk][j-1];
+ }
+ } /* for k */
+ } /* for m */ /* finish receiving */
+
+ MPI_Waitall(idb,request,status);
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
+ kk=k;
+
+ if (E->parallel.PROCESSOR[lev][m].pass[k]!=E->parallel.me)
+ if (E->parallel.PROCESSOR[lev][m].pass[k]!=-1) {
+ for (j=1;j<=E->parallel.NUM_NODE[lev][m].pass[k];j++)
+ U[m][ E->parallel.EXCHANGE_NODE[lev][m][j].pass[k] ] += R[kk][j-1];
+ }
+ }
+ }
+
+ /* for vertical direction */
+
+ for (k=1;k<=E->parallel.TNUM_PASSz[lev];k++) {
+ jj = 0;
+ kk = k + E->sphere.max_connections;
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for (j=1;j<=E->parallel.NUM_NODE[lev][m].pass[kk];j++)
+ SV[jj++] = U[m][ E->parallel.EXCHANGE_NODE[lev][m][j].pass[kk] ];
+
+ MPI_Sendrecv(SV,E->parallel.NUM_NODEz[lev].pass[k],MPI_FLOAT,
+ E->parallel.PROCESSORz[lev].pass[k],1,
+ RV,E->parallel.NUM_NODEz[lev].pass[k],MPI_FLOAT,
+ E->parallel.PROCESSORz[lev].pass[k],1,E->parallel.world,&status1);
+
+ jj = 0;
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for (j=1;j<=E->parallel.NUM_NODE[lev][m].pass[kk];j++)
+ U[m][ E->parallel.EXCHANGE_NODE[lev][m][j].pass[kk] ] += RV[jj++];
+ }
+
+ kk = 0;
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
+ kk++;
+ free((void*) S[kk]);
+ free((void*) R[kk]);
+ }
+ }
+
+ free((void*) SV);
+ free((void*) RV);
+
+ return;
+ }
+/* ================================================ */
+/* ================================================ */
+
+void full_exchange_snode_f(struct All_variables *E, float **U1,
+ float **U2, int lev)
+ {
+
+ int ii,j,k,m,kk,t_cap,idb,msginfo[8];
+ float *S[73],*R[73];
+ int mid_recv, sizeofk;
+
+ MPI_Status status[100];
+ MPI_Status status1;
+ MPI_Request request[100];
+
+ kk=0;
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ for (k=1;k<=E->parallel.TNUM_PASS[E->mesh.levmax][m];k++) {
+ ++kk;
+ sizeofk = (1+2*E->parallel.NUM_sNODE[E->mesh.levmax][m].pass[k])*sizeof(float);
+ S[kk]=(float *)malloc( sizeofk );
+ R[kk]=(float *)malloc( sizeofk );
+ }
+ }
+
+ idb=0;
+ /* sending */
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
+ kk=k;
+
+ /* pack */
+ for (j=1;j<=E->parallel.NUM_sNODE[lev][m].pass[k];j++) {
+ S[kk][j-1] = U1[m][ E->parallel.EXCHANGE_sNODE[lev][m][j].pass[k] ];
+ S[kk][j-1+E->parallel.NUM_sNODE[lev][m].pass[k]]
+ = U2[m][ E->parallel.EXCHANGE_sNODE[lev][m][j].pass[k] ];
+ }
+
+ if (E->parallel.PROCESSOR[lev][m].pass[k]!=E->parallel.me) {
+ if (E->parallel.PROCESSOR[lev][m].pass[k]!=-1) {
+ idb ++;
+ MPI_Isend(S[kk],2*E->parallel.NUM_sNODE[lev][m].pass[k],MPI_FLOAT,
+ E->parallel.PROCESSOR[lev][m].pass[k],1,E->parallel.world,&request[idb-1]);
+ }
+ }
+ } /* for k */
+ } /* for m */ /* finish sending */
+
+ /* receiving */
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
+ kk=k;
+
+ if (E->parallel.PROCESSOR[lev][m].pass[k]!=E->parallel.me) {
+ if (E->parallel.PROCESSOR[lev][m].pass[k]!=-1) {
+
+ idb ++;
+ MPI_Irecv(R[kk],2*E->parallel.NUM_sNODE[lev][m].pass[k],MPI_FLOAT,
+ E->parallel.PROCESSOR[lev][m].pass[k],1,E->parallel.world,&request[idb-1]);
+ }
+ }
+
+ else {
+ kk=k;
+ for (j=1;j<=E->parallel.NUM_sNODE[lev][m].pass[k];j++) {
+ U1[m][ E->parallel.EXCHANGE_sNODE[lev][m][j].pass[k] ] += S[kk][j-1];
+ U2[m][ E->parallel.EXCHANGE_sNODE[lev][m][j].pass[k] ] +=
+ S[kk][j-1+E->parallel.NUM_sNODE[lev][m].pass[k]];
+ }
+ }
+ } /* for k */
+ } /* for m */ /* finish receiving */
+
+ MPI_Waitall(idb,request,status);
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
+ kk=k;
+
+ /* unpack */
+ if (E->parallel.PROCESSOR[lev][m].pass[k]!=E->parallel.me)
+ if (E->parallel.PROCESSOR[lev][m].pass[k]!=-1) {
+ for (j=1;j<=E->parallel.NUM_sNODE[lev][m].pass[k];j++) {
+ U1[m][ E->parallel.EXCHANGE_sNODE[lev][m][j].pass[k] ] += R[kk][j-1];
+ U2[m][ E->parallel.EXCHANGE_sNODE[lev][m][j].pass[k] ] +=
+ R[kk][j-1+E->parallel.NUM_sNODE[lev][m].pass[k]];
+ }
+ }
+ }
+ }
+
+ kk=0;
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ for (k=1;k<=E->parallel.TNUM_PASS[E->mesh.levmax][m];k++) {
+ ++kk;
+ free((void*) S[kk]);
+ free((void*) R[kk]);
+ }
+ }
+
+ return;
+ }
+
+
Deleted: mc/3D/CitcomS/branches/cxx/lib/Full_read_input_from_files.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Full_read_input_from_files.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Full_read_input_from_files.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,404 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-#include <math.h>
-#include <sys/types.h>
-#include "element_definitions.h"
-#include "global_defs.h"
-#ifdef USE_GGRD
-#include "ggrd_handling.h"
-#endif
-
-/*=======================================================================
- Calculate ages (MY) for opening input files -> material, ages, velocities
- Open these files, read in results, and average if necessary
-=========================================================================*/
-
-void full_read_input_files_for_timesteps(E,action,output)
- struct All_variables *E;
- int action, output;
-{
- float find_age_in_MY();
-
- FILE *fp1, *fp2;
- float age, newage1, newage2;
- char output_file1[255],output_file2[255];
- float *TB1, *TB2, *VB1[4],*VB2[4], inputage1, inputage2;
- int nox,noz,noy,nnn,nox1,noz1,noy1;
- int i,ii,ll,m,mm,j,k,n,nodeg,nodel,node,cap;
- int intage, pos_age;
- int nodea;
- int nn,el;
-
- const int dims=E->mesh.nsd;
-
- int elx,ely,elz,elg,emax;
- float *VIP1,*VIP2;
- int *LL1, *LL2;
-
- int llayer;
- int layers();
-
- nox=E->mesh.nox;
- noy=E->mesh.noy;
- noz=E->mesh.noz;
- nox1=E->lmesh.nox;
- noz1=E->lmesh.noz;
- noy1=E->lmesh.noy;
-
- elx=E->lmesh.elx;
- elz=E->lmesh.elz;
- ely=E->lmesh.ely;
-
- emax=E->mesh.elx*E->mesh.elz*E->mesh.ely;
-
- age=find_age_in_MY(E);
-
- if (age < 0.0) { /* age is negative -> use age=0 for input files */
- intage = 0;
- newage2 = newage1 = 0.0;
- pos_age = 0;
- }
- else {
- intage = age;
- newage1 = 1.0*intage;
- newage2 = 1.0*intage + 1.0;
- pos_age = 1;
- }
-
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- cap = E->sphere.capid[m] - 1; /* capid: 1-12 */
-
- switch (action) { /* set up files to open */
-
- case 1: /* read velocity boundary conditions */
-#ifdef USE_GGRD
- if(!E->control.ggrd.vtop_control){
-#endif
- sprintf(output_file1,"%s%0.0f.%d",E->control.velocity_boundary_file,newage1,cap);
- sprintf(output_file2,"%s%0.0f.%d",E->control.velocity_boundary_file,newage2,cap);
- fp1=fopen(output_file1,"r");
- if (fp1 == NULL) {
- fprintf(E->fp,"(Problem_related #4) Cannot open %s\n",output_file1);
- exit(8);
- }
- if (pos_age) {
- fp2=fopen(output_file2,"r");
- if (fp2 == NULL) {
- fprintf(E->fp,"(Problem_related #5) Cannot open %s\n",output_file2);
- exit(8);
- }
- }
- if((E->parallel.me==0) && (output==1)) {
- fprintf(E->fp,"Velocity: Starting Age = %g, Elapsed time = %g, Current Age = %g\n",E->control.start_age,E->monitor.elapsed_time,age);
- fprintf(E->fp,"Velocity: File1 = %s\n",output_file1);
- if (pos_age)
- fprintf(E->fp,"Velocity: File2 = %s\n",output_file2);
- else
- fprintf(E->fp,"Velocity: File2 = No file inputted (negative age)\n");
- }
-#ifdef USE_GGRD
- }
-#endif
- break;
-
- case 2: /* read ages for lithosphere temperature assimilation */
-#ifdef USE_GGRD
- if(!E->control.ggrd.age_control){
-#endif
- sprintf(output_file1,"%s%0.0f.%d",E->control.lith_age_file,newage1,cap);
- sprintf(output_file2,"%s%0.0f.%d",E->control.lith_age_file,newage2,cap);
- fp1=fopen(output_file1,"r");
- if (fp1 == NULL) {
- fprintf(E->fp,"(Problem_related #6) Cannot open %s\n",output_file1);
- exit(8);
- }
- if (pos_age) {
- fp2=fopen(output_file2,"r");
- if (fp2 == NULL) {
- fprintf(E->fp,"(Problem_related #7) Cannot open %s\n",output_file2);
- exit(8);
- }
- }
- if((E->parallel.me==0) && (output==1)) {
- fprintf(E->fp,"Age: Starting Age = %g, Elapsed time = %g, Current Age = %g\n",E->control.start_age,E->monitor.elapsed_time,age);
- fprintf(E->fp,"Age: File1 = %s\n",output_file1);
- if (pos_age)
- fprintf(E->fp,"Age: File2 = %s\n",output_file2);
- else
- fprintf(E->fp,"Age: File2 = No file inputted (negative age)\n");
- }
-#ifdef USE_GGRD
- }
-#endif
- break;
-
- case 3: /* read element materials */
-#ifdef USE_GGRD
- if(!E->control.ggrd.mat_control){
-#endif
- sprintf(output_file1,"%s%0.0f.%d",E->control.mat_file,newage1,cap);
- sprintf(output_file2,"%s%0.0f.%d",E->control.mat_file,newage2,cap);
- fp1=fopen(output_file1,"r");
- if (fp1 == NULL) {
- fprintf(E->fp,"(Problem_related #8) Cannot open %s\n",output_file1);
- exit(8);
- }
- if (pos_age) {
- fp2=fopen(output_file2,"r");
- if (fp2 == NULL) {
- fprintf(E->fp,"(Problem_related #9) Cannot open %s\n",output_file2);
- exit(8);
- }
- }
- if((E->parallel.me==0) && (output==1)) {
- fprintf(E->fp,"Mat: Starting Age = %g, Elapsed time = %g, Current Age = %g\n",E->control.start_age,E->monitor.elapsed_time,age);
- fprintf(E->fp,"Mat: File1 = %s\n",output_file1);
- if (pos_age)
- fprintf(E->fp,"Mat: File2 = %s\n",output_file2);
- else
- fprintf(E->fp,"Mat: File2 = No file inputted (negative age)\n");
- }
-#ifdef USE_GGRD
- }
-#endif
- break;
- /* mode 4 is rayleigh control for GGRD, see below */
-
- case 5: /* read temperature boundary conditions, top surface */
- sprintf(output_file1,"%s%0.0f.%d",E->control.temperature_boundary_file,newage1,cap);
- sprintf(output_file2,"%s%0.0f.%d",E->control.temperature_boundary_file,newage2,cap);
- fp1=fopen(output_file1,"r");
- if (fp1 == NULL) {
- fprintf(E->fp,"(Problem_related #10) Cannot open %s\n",output_file1);
- exit(8);
- }
- if (pos_age) {
- fp2=fopen(output_file2,"r");
- if (fp2 == NULL) {
- fprintf(E->fp,"(Problem_related #11) Cannot open %s\n",output_file2);
- exit(8);
- }
- }
- if((E->parallel.me==0) && (output==1)) {
- fprintf(E->fp,"Surface Temperature: Starting Age = %g, Elapsed time = %g, Current Age = %g\n",E->control.start_age,E->monitor.elapsed_time,age);
- fprintf(E->fp,"Surface Temperature: File1 = %s\n",output_file1);
- if (pos_age)
- fprintf(E->fp,"Surface Temperature: File2 = %s\n",output_file2);
- else
- fprintf(E->fp,"Velocity: File2 = No file inputted (negative age)\n");
- }
- break;
-
- } /* end switch */
-
-
-
- switch (action) { /* Read the contents of files and average */
-
- case 1: /* velocity boundary conditions */
-#ifdef USE_GGRD
- if(E->control.ggrd.vtop_control){
- ggrd_read_vtop_from_file(E, 1);
- }else{
-#endif
- nnn=nox*noy;
- for(i=1;i<=dims;i++) {
- VB1[i]=(float*) malloc ((nnn+1)*sizeof(float));
- VB2[i]=(float*) malloc ((nnn+1)*sizeof(float));
- }
- for(i=1;i<=nnn;i++) {
- fscanf(fp1,"%f %f",&(VB1[1][i]),&(VB1[2][i]));
- VB1[1][i] *= E->data.timedir;
- VB1[2][i] *= E->data.timedir;
- if (pos_age) {
- fscanf(fp2,"%f %f",&(VB2[1][i]),&(VB2[2][i]));
- VB2[1][i] *= E->data.timedir;
- VB2[2][i] *= E->data.timedir;
- }
- /* if( E->parallel.me ==0)
- fprintf(stderr,"%d %f %f %f %f\n",i,VB1[1][i],VB1[2][i],VB2[1][i],VB2[2][i]); */
- }
- fclose(fp1);
- if (pos_age) fclose(fp2);
-
- if(E->parallel.me_loc[3]==E->parallel.nprocz-1 ) {
- for(k=1;k<=noy1;k++)
- for(i=1;i<=nox1;i++) {
- nodeg = E->lmesh.nxs+i-1 + (E->lmesh.nys+k-2)*nox;
- nodel = (k-1)*nox1*noz1 + (i-1)*noz1+noz1;
- if (pos_age) { /* positive ages - we must interpolate */
- E->sphere.cap[m].VB[1][nodel] = (VB1[1][nodeg] + (VB2[1][nodeg]-VB1[1][nodeg])/(newage2-newage1)*(age-newage1))*E->data.scalev;
- E->sphere.cap[m].VB[2][nodel] = (VB1[2][nodeg] + (VB2[2][nodeg]-VB1[2][nodeg])/(newage2-newage1)*(age-newage1))*E->data.scalev;
- E->sphere.cap[m].VB[3][nodel] = 0.0;
- }
- else { /* negative ages - don't do the interpolation */
- E->sphere.cap[m].VB[1][nodel] = VB1[1][nodeg] * E->data.scalev;
- E->sphere.cap[m].VB[2][nodel] = VB1[2][nodeg] * E->data.scalev;
- E->sphere.cap[m].VB[3][nodel] = 0.0;
- }
- }
- } /* end of E->parallel.me_loc[3]==E->parallel.nproczl-1 */
- for(i=1;i<=dims;i++) {
- free ((void *) VB1[i]);
- free ((void *) VB2[i]);
- }
-#ifdef USE_GGRD
- }
-#endif
- break;
-
- case 2: /* ages for lithosphere temperature assimilation */
-#ifdef USE_GGRD
- if(E->control.ggrd.age_control){
- ggrd_read_age_from_file(E, 1);
- }else{
-#endif
- for(i=1;i<=noy;i++)
- for(j=1;j<=nox;j++) {
- node=j+(i-1)*nox;
- fscanf(fp1,"%f",&inputage1);
- if (pos_age) { /* positive ages - we must interpolate */
- fscanf(fp2,"%f",&inputage2);
- E->age_t[node] = (inputage1 + (inputage2-inputage1)/(newage2-newage1)*(age-newage1))/E->data.scalet;
- }
- else { /* negative ages - don't do the interpolation */
- E->age_t[node] = inputage1;
- }
- }
- fclose(fp1);
- if (pos_age) fclose(fp2);
-#ifdef USE_GGRD
- } /* end of branch if allowing for ggrd handling */
-#endif
- break;
-
- case 3: /* read element materials and Ray */
-#ifdef USE_GGRD
- if(E->control.ggrd.mat_control){ /* use netcdf grids */
- ggrd_read_mat_from_file(E, 1);
- }else{
-#endif
- VIP1 = (float*) malloc ((emax+1)*sizeof(float));
- VIP2 = (float*) malloc ((emax+1)*sizeof(float));
- LL1 = (int*) malloc ((emax+1)*sizeof(int));
- LL2 = (int*) malloc ((emax+1)*sizeof(int));
-
-
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for (el=1; el<=elx*ely*elz; el++) {
- nodea = E->ien[m][el].node[2];
- llayer = layers(E,m,nodea);
- if (llayer) { /* for layers:1-lithosphere,2-upper, 3-trans, and 4-lower mantle */
- E->mat[m][el] = llayer;
- fprintf(stderr,"\nINSIDE llayer=%d",llayer);
- }
- }
- for(i=1;i<=emax;i++) {
- fscanf(fp1,"%d %d %f", &nn,&(LL1[i]),&(VIP1[i]));
- fscanf(fp2,"%d %d %f", &nn,&(LL2[i]),&(VIP2[i]));
- }
-
- fclose(fp1);
- fclose(fp2);
-
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- for (k=1;k<=ely;k++) {
- for (i=1;i<=elx;i++) {
- for (j=1;j<=elz;j++) {
- el = j + (i-1)*E->lmesh.elz + (k-1)*E->lmesh.elz*E->lmesh.elx;
- elg = E->lmesh.ezs+j + (E->lmesh.exs+i-1)*E->mesh.elz + (E->lmesh.eys+k-1)*E->mesh.elz*E->mesh.elx;
-
- E->VIP[m][el] = VIP1[elg]+(VIP2[elg]-VIP1[elg])/(newage2-newage1)*(age-newage1);
- /* E->mat[m][el] = LL1[elg]; */ /*get material numbers from radius internally */
-
- } /* end for j */
- } /* end for i */
- } /* end for k */
- } /* end for m */
-
- free ((void *) VIP1);
- free ((void *) VIP2);
- free ((void *) LL1);
- free ((void *) LL2);
-#ifdef USE_GGRD
- } /* end of branch if allowing for ggrd handling */
-#endif
- break;
- case 4: /* material control */
-#ifdef USE_GGRD
- /* read laterally varying rayleigh number prefactor from
- file */
- if(E->control.ggrd.ray_control)
- ggrd_read_ray_from_file(E, 1);
-#else
- myerror(E,"input_from_files: mode 4 only for GGRD");
-#endif
- break;
-
- case 5: /* read temperature boundary conditions, top surface */
- nnn=nox*noy;
- TB1=(float*) malloc ((nnn+1)*sizeof(float));
- TB2=(float*) malloc ((nnn+1)*sizeof(float));
-
- for(i=1;i<=nnn;i++) {
- fscanf(fp1,"%f",&(TB1[i]));
- if (pos_age) {
- fscanf(fp2,"%f",&(TB2[i]));
- }
- }
- fclose(fp1);
- if (pos_age) fclose(fp2);
-
- if(E->parallel.me_loc[3]==E->parallel.nprocz-1 ) {
- for(k=1;k<=noy1;k++)
- for(i=1;i<=nox1;i++) {
- nodeg = E->lmesh.nxs+i-1 + (E->lmesh.nys+k-2)*nox;
- nodel = (k-1)*nox1*noz1 + (i-1)*noz1+noz1;
- if (pos_age) { /* positive ages - we must interpolate */
- E->sphere.cap[m].TB[1][nodel] = (TB1[nodeg] + (TB2[nodeg]-TB1[nodeg])/(newage2-newage1)*(age-newage1));
- E->sphere.cap[m].TB[2][nodel] = (TB1[nodeg] + (TB2[nodeg]-TB1[nodeg])/(newage2-newage1)*(age-newage1));
- E->sphere.cap[m].TB[3][nodel] = (TB1[nodeg] + (TB2[nodeg]-TB1[nodeg])/(newage2-newage1)*(age-newage1));
- }
- else { /* negative ages - don't do the interpolation */
- E->sphere.cap[m].TB[1][nodel] = TB1[nodeg];
- E->sphere.cap[m].TB[2][nodel] = TB1[nodeg];
- E->sphere.cap[m].TB[3][nodel] = TB1[nodeg];
- }
- }
- } /* end of E->parallel.me_loc[3]==E->parallel.nproczl-1 */
- free ((void *) TB1);
- free ((void *) TB2);
- break;
-
- } /* end switch */
- } /* end for m */
-
- fflush(E->fp);
-
- return;
-}
Copied: mc/3D/CitcomS/branches/cxx/lib/Full_read_input_from_files.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Full_read_input_from_files.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Full_read_input_from_files.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Full_read_input_from_files.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,404 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+#include <math.h>
+#include <sys/types.h>
+#include "element_definitions.h"
+#include "global_defs.h"
+#ifdef USE_GGRD
+#include "ggrd_handling.h"
+#endif
+
+#include "cproto.h"
+
+/*=======================================================================
+ Calculate ages (MY) for opening input files -> material, ages, velocities
+ Open these files, read in results, and average if necessary
+=========================================================================*/
+
+void full_read_input_files_for_timesteps(
+ struct All_variables *E,
+ int action, int output
+ )
+{
+ FILE *fp1, *fp2;
+ float age, newage1, newage2;
+ char output_file1[255],output_file2[255];
+ float *TB1, *TB2, *VB1[4],*VB2[4], inputage1, inputage2;
+ int nox,noz,noy,nnn,nox1,noz1,noy1;
+ int i,ii,ll,m,mm,j,k,n,nodeg,nodel,node,cap;
+ int intage, pos_age;
+ int nodea;
+ int nn,el;
+
+ const int dims=E->mesh.nsd;
+
+ int elx,ely,elz,elg,emax;
+ float *VIP1,*VIP2;
+ int *LL1, *LL2;
+
+ int llayer;
+
+ nox=E->mesh.nox;
+ noy=E->mesh.noy;
+ noz=E->mesh.noz;
+ nox1=E->lmesh.nox;
+ noz1=E->lmesh.noz;
+ noy1=E->lmesh.noy;
+
+ elx=E->lmesh.elx;
+ elz=E->lmesh.elz;
+ ely=E->lmesh.ely;
+
+ emax=E->mesh.elx*E->mesh.elz*E->mesh.ely;
+
+ age=find_age_in_MY(E);
+
+ if (age < 0.0) { /* age is negative -> use age=0 for input files */
+ intage = 0;
+ newage2 = newage1 = 0.0;
+ pos_age = 0;
+ }
+ else {
+ intage = (int)age;
+ newage1 = 1.0*intage;
+ newage2 = 1.0*intage + 1.0;
+ pos_age = 1;
+ }
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ cap = E->sphere.capid[m] - 1; /* capid: 1-12 */
+
+ switch (action) { /* set up files to open */
+
+ case 1: /* read velocity boundary conditions */
+#ifdef USE_GGRD
+ if(!E->control.ggrd.vtop_control){
+#endif
+ sprintf(output_file1,"%s%0.0f.%d",E->control.velocity_boundary_file,newage1,cap);
+ sprintf(output_file2,"%s%0.0f.%d",E->control.velocity_boundary_file,newage2,cap);
+ fp1=fopen(output_file1,"r");
+ if (fp1 == NULL) {
+ fprintf(E->fp,"(Problem_related #4) Cannot open %s\n",output_file1);
+ exit(8);
+ }
+ if (pos_age) {
+ fp2=fopen(output_file2,"r");
+ if (fp2 == NULL) {
+ fprintf(E->fp,"(Problem_related #5) Cannot open %s\n",output_file2);
+ exit(8);
+ }
+ }
+ if((E->parallel.me==0) && (output==1)) {
+ fprintf(E->fp,"Velocity: Starting Age = %g, Elapsed time = %g, Current Age = %g\n",E->control.start_age,E->monitor.elapsed_time,age);
+ fprintf(E->fp,"Velocity: File1 = %s\n",output_file1);
+ if (pos_age)
+ fprintf(E->fp,"Velocity: File2 = %s\n",output_file2);
+ else
+ fprintf(E->fp,"Velocity: File2 = No file inputted (negative age)\n");
+ }
+#ifdef USE_GGRD
+ }
+#endif
+ break;
+
+ case 2: /* read ages for lithosphere temperature assimilation */
+#ifdef USE_GGRD
+ if(!E->control.ggrd.age_control){
+#endif
+ sprintf(output_file1,"%s%0.0f.%d",E->control.lith_age_file,newage1,cap);
+ sprintf(output_file2,"%s%0.0f.%d",E->control.lith_age_file,newage2,cap);
+ fp1=fopen(output_file1,"r");
+ if (fp1 == NULL) {
+ fprintf(E->fp,"(Problem_related #6) Cannot open %s\n",output_file1);
+ exit(8);
+ }
+ if (pos_age) {
+ fp2=fopen(output_file2,"r");
+ if (fp2 == NULL) {
+ fprintf(E->fp,"(Problem_related #7) Cannot open %s\n",output_file2);
+ exit(8);
+ }
+ }
+ if((E->parallel.me==0) && (output==1)) {
+ fprintf(E->fp,"Age: Starting Age = %g, Elapsed time = %g, Current Age = %g\n",E->control.start_age,E->monitor.elapsed_time,age);
+ fprintf(E->fp,"Age: File1 = %s\n",output_file1);
+ if (pos_age)
+ fprintf(E->fp,"Age: File2 = %s\n",output_file2);
+ else
+ fprintf(E->fp,"Age: File2 = No file inputted (negative age)\n");
+ }
+#ifdef USE_GGRD
+ }
+#endif
+ break;
+
+ case 3: /* read element materials */
+#ifdef USE_GGRD
+ if(!E->control.ggrd.mat_control){
+#endif
+ sprintf(output_file1,"%s%0.0f.%d",E->control.mat_file,newage1,cap);
+ sprintf(output_file2,"%s%0.0f.%d",E->control.mat_file,newage2,cap);
+ fp1=fopen(output_file1,"r");
+ if (fp1 == NULL) {
+ fprintf(E->fp,"(Problem_related #8) Cannot open %s\n",output_file1);
+ exit(8);
+ }
+ if (pos_age) {
+ fp2=fopen(output_file2,"r");
+ if (fp2 == NULL) {
+ fprintf(E->fp,"(Problem_related #9) Cannot open %s\n",output_file2);
+ exit(8);
+ }
+ }
+ if((E->parallel.me==0) && (output==1)) {
+ fprintf(E->fp,"Mat: Starting Age = %g, Elapsed time = %g, Current Age = %g\n",E->control.start_age,E->monitor.elapsed_time,age);
+ fprintf(E->fp,"Mat: File1 = %s\n",output_file1);
+ if (pos_age)
+ fprintf(E->fp,"Mat: File2 = %s\n",output_file2);
+ else
+ fprintf(E->fp,"Mat: File2 = No file inputted (negative age)\n");
+ }
+#ifdef USE_GGRD
+ }
+#endif
+ break;
+ /* mode 4 is rayleigh control for GGRD, see below */
+
+ case 5: /* read temperature boundary conditions, top surface */
+ sprintf(output_file1,"%s%0.0f.%d",E->control.temperature_boundary_file,newage1,cap);
+ sprintf(output_file2,"%s%0.0f.%d",E->control.temperature_boundary_file,newage2,cap);
+ fp1=fopen(output_file1,"r");
+ if (fp1 == NULL) {
+ fprintf(E->fp,"(Problem_related #10) Cannot open %s\n",output_file1);
+ exit(8);
+ }
+ if (pos_age) {
+ fp2=fopen(output_file2,"r");
+ if (fp2 == NULL) {
+ fprintf(E->fp,"(Problem_related #11) Cannot open %s\n",output_file2);
+ exit(8);
+ }
+ }
+ if((E->parallel.me==0) && (output==1)) {
+ fprintf(E->fp,"Surface Temperature: Starting Age = %g, Elapsed time = %g, Current Age = %g\n",E->control.start_age,E->monitor.elapsed_time,age);
+ fprintf(E->fp,"Surface Temperature: File1 = %s\n",output_file1);
+ if (pos_age)
+ fprintf(E->fp,"Surface Temperature: File2 = %s\n",output_file2);
+ else
+ fprintf(E->fp,"Velocity: File2 = No file inputted (negative age)\n");
+ }
+ break;
+
+ } /* end switch */
+
+
+
+ switch (action) { /* Read the contents of files and average */
+
+ case 1: /* velocity boundary conditions */
+#ifdef USE_GGRD
+ if(E->control.ggrd.vtop_control){
+ ggrd_read_vtop_from_file(E, 1);
+ }else{
+#endif
+ nnn=nox*noy;
+ for(i=1;i<=dims;i++) {
+ VB1[i]=(float*) malloc ((nnn+1)*sizeof(float));
+ VB2[i]=(float*) malloc ((nnn+1)*sizeof(float));
+ }
+ for(i=1;i<=nnn;i++) {
+ fscanf(fp1,"%f %f",&(VB1[1][i]),&(VB1[2][i]));
+ VB1[1][i] *= E->data.timedir;
+ VB1[2][i] *= E->data.timedir;
+ if (pos_age) {
+ fscanf(fp2,"%f %f",&(VB2[1][i]),&(VB2[2][i]));
+ VB2[1][i] *= E->data.timedir;
+ VB2[2][i] *= E->data.timedir;
+ }
+ /* if( E->parallel.me ==0)
+ fprintf(stderr,"%d %f %f %f %f\n",i,VB1[1][i],VB1[2][i],VB2[1][i],VB2[2][i]); */
+ }
+ fclose(fp1);
+ if (pos_age) fclose(fp2);
+
+ if(E->parallel.me_loc[3]==E->parallel.nprocz-1 ) {
+ for(k=1;k<=noy1;k++)
+ for(i=1;i<=nox1;i++) {
+ nodeg = E->lmesh.nxs+i-1 + (E->lmesh.nys+k-2)*nox;
+ nodel = (k-1)*nox1*noz1 + (i-1)*noz1+noz1;
+ if (pos_age) { /* positive ages - we must interpolate */
+ E->sphere.cap[m].VB[1][nodel] = (VB1[1][nodeg] + (VB2[1][nodeg]-VB1[1][nodeg])/(newage2-newage1)*(age-newage1))*E->data.scalev;
+ E->sphere.cap[m].VB[2][nodel] = (VB1[2][nodeg] + (VB2[2][nodeg]-VB1[2][nodeg])/(newage2-newage1)*(age-newage1))*E->data.scalev;
+ E->sphere.cap[m].VB[3][nodel] = 0.0;
+ }
+ else { /* negative ages - don't do the interpolation */
+ E->sphere.cap[m].VB[1][nodel] = VB1[1][nodeg] * E->data.scalev;
+ E->sphere.cap[m].VB[2][nodel] = VB1[2][nodeg] * E->data.scalev;
+ E->sphere.cap[m].VB[3][nodel] = 0.0;
+ }
+ }
+ } /* end of E->parallel.me_loc[3]==E->parallel.nproczl-1 */
+ for(i=1;i<=dims;i++) {
+ free ((void *) VB1[i]);
+ free ((void *) VB2[i]);
+ }
+#ifdef USE_GGRD
+ }
+#endif
+ break;
+
+ case 2: /* ages for lithosphere temperature assimilation */
+#ifdef USE_GGRD
+ if(E->control.ggrd.age_control){
+ ggrd_read_age_from_file(E, 1);
+ }else{
+#endif
+ for(i=1;i<=noy;i++)
+ for(j=1;j<=nox;j++) {
+ node=j+(i-1)*nox;
+ fscanf(fp1,"%f",&inputage1);
+ if (pos_age) { /* positive ages - we must interpolate */
+ fscanf(fp2,"%f",&inputage2);
+ E->age_t[node] = (inputage1 + (inputage2-inputage1)/(newage2-newage1)*(age-newage1))/E->data.scalet;
+ }
+ else { /* negative ages - don't do the interpolation */
+ E->age_t[node] = inputage1;
+ }
+ }
+ fclose(fp1);
+ if (pos_age) fclose(fp2);
+#ifdef USE_GGRD
+ } /* end of branch if allowing for ggrd handling */
+#endif
+ break;
+
+ case 3: /* read element materials and Ray */
+#ifdef USE_GGRD
+ if(E->control.ggrd.mat_control){ /* use netcdf grids */
+ ggrd_read_mat_from_file(E, 1);
+ }else{
+#endif
+ VIP1 = (float*) malloc ((emax+1)*sizeof(float));
+ VIP2 = (float*) malloc ((emax+1)*sizeof(float));
+ LL1 = (int*) malloc ((emax+1)*sizeof(int));
+ LL2 = (int*) malloc ((emax+1)*sizeof(int));
+
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for (el=1; el<=elx*ely*elz; el++) {
+ nodea = E->ien[m][el].node[2];
+ llayer = layers(E,m,nodea);
+ if (llayer) { /* for layers:1-lithosphere,2-upper, 3-trans, and 4-lower mantle */
+ E->mat[m][el] = llayer;
+ fprintf(stderr,"\nINSIDE llayer=%d",llayer);
+ }
+ }
+ for(i=1;i<=emax;i++) {
+ fscanf(fp1,"%d %d %f", &nn,&(LL1[i]),&(VIP1[i]));
+ fscanf(fp2,"%d %d %f", &nn,&(LL2[i]),&(VIP2[i]));
+ }
+
+ fclose(fp1);
+ fclose(fp2);
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ for (k=1;k<=ely;k++) {
+ for (i=1;i<=elx;i++) {
+ for (j=1;j<=elz;j++) {
+ el = j + (i-1)*E->lmesh.elz + (k-1)*E->lmesh.elz*E->lmesh.elx;
+ elg = E->lmesh.ezs+j + (E->lmesh.exs+i-1)*E->mesh.elz + (E->lmesh.eys+k-1)*E->mesh.elz*E->mesh.elx;
+
+ E->VIP[m][el] = VIP1[elg]+(VIP2[elg]-VIP1[elg])/(newage2-newage1)*(age-newage1);
+ /* E->mat[m][el] = LL1[elg]; */ /*get material numbers from radius internally */
+
+ } /* end for j */
+ } /* end for i */
+ } /* end for k */
+ } /* end for m */
+
+ free ((void *) VIP1);
+ free ((void *) VIP2);
+ free ((void *) LL1);
+ free ((void *) LL2);
+#ifdef USE_GGRD
+ } /* end of branch if allowing for ggrd handling */
+#endif
+ break;
+ case 4: /* material control */
+#ifdef USE_GGRD
+ /* read laterally varying rayleigh number prefactor from
+ file */
+ if(E->control.ggrd.ray_control)
+ ggrd_read_ray_from_file(E, 1);
+#else
+ myerror(E,"input_from_files: mode 4 only for GGRD");
+#endif
+ break;
+
+ case 5: /* read temperature boundary conditions, top surface */
+ nnn=nox*noy;
+ TB1=(float*) malloc ((nnn+1)*sizeof(float));
+ TB2=(float*) malloc ((nnn+1)*sizeof(float));
+
+ for(i=1;i<=nnn;i++) {
+ fscanf(fp1,"%f",&(TB1[i]));
+ if (pos_age) {
+ fscanf(fp2,"%f",&(TB2[i]));
+ }
+ }
+ fclose(fp1);
+ if (pos_age) fclose(fp2);
+
+ if(E->parallel.me_loc[3]==E->parallel.nprocz-1 ) {
+ for(k=1;k<=noy1;k++)
+ for(i=1;i<=nox1;i++) {
+ nodeg = E->lmesh.nxs+i-1 + (E->lmesh.nys+k-2)*nox;
+ nodel = (k-1)*nox1*noz1 + (i-1)*noz1+noz1;
+ if (pos_age) { /* positive ages - we must interpolate */
+ E->sphere.cap[m].TB[1][nodel] = (TB1[nodeg] + (TB2[nodeg]-TB1[nodeg])/(newage2-newage1)*(age-newage1));
+ E->sphere.cap[m].TB[2][nodel] = (TB1[nodeg] + (TB2[nodeg]-TB1[nodeg])/(newage2-newage1)*(age-newage1));
+ E->sphere.cap[m].TB[3][nodel] = (TB1[nodeg] + (TB2[nodeg]-TB1[nodeg])/(newage2-newage1)*(age-newage1));
+ }
+ else { /* negative ages - don't do the interpolation */
+ E->sphere.cap[m].TB[1][nodel] = TB1[nodeg];
+ E->sphere.cap[m].TB[2][nodel] = TB1[nodeg];
+ E->sphere.cap[m].TB[3][nodel] = TB1[nodeg];
+ }
+ }
+ } /* end of E->parallel.me_loc[3]==E->parallel.nproczl-1 */
+ free ((void *) TB1);
+ free ((void *) TB2);
+ break;
+
+ } /* end switch */
+ } /* end for m */
+
+ fflush(E->fp);
+
+ return;
+}
Deleted: mc/3D/CitcomS/branches/cxx/lib/Full_solver.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Full_solver.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Full_solver.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,96 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-
-
-#include "global_defs.h"
-
-
-/* Boundary_conditions.c */
-void full_velocity_boundary_conditions(struct All_variables *);
-void full_temperature_boundary_conditions(struct All_variables *);
-
-/* Geometry_cartesian.c */
-void full_set_2dc_defaults(struct All_variables *);
-void full_set_2pt5dc_defaults(struct All_variables *);
-void full_set_3dc_defaults(struct All_variables *);
-void full_set_3dsphere_defaults(struct All_variables *);
-
-/* Lith_age.c */
-void full_lith_age_read_files(struct All_variables *, int);
-
-/* Parallel_related.c */
-void full_parallel_processor_setup(struct All_variables *);
-void full_parallel_domain_decomp0(struct All_variables *);
-void full_parallel_domain_boundary_nodes(struct All_variables *);
-void full_parallel_communication_routs_v(struct All_variables *);
-void full_parallel_communication_routs_s(struct All_variables *);
-void full_exchange_id_d(struct All_variables *, double **, int);
-
-/* Read_input_from_files.c */
-void full_read_input_files_for_timesteps(struct All_variables *, int, int);
-
-/* Version_dependent.c */
-void full_node_locations(struct All_variables *);
-void full_construct_boundary(struct All_variables *);
-
-
-void full_solver_init(struct All_variables *E)
-{
- /* Boundary_conditions.c */
- E->solver.velocity_boundary_conditions = full_velocity_boundary_conditions;
- E->solver.temperature_boundary_conditions = full_temperature_boundary_conditions;
-
- /* Geometry_cartesian.c */
- E->solver.set_2dc_defaults = full_set_2dc_defaults;
- E->solver.set_2pt5dc_defaults = full_set_2pt5dc_defaults;
- E->solver.set_3dc_defaults = full_set_3dc_defaults;
- E->solver.set_3dsphere_defaults = full_set_3dsphere_defaults;
-
- /* Lith_age.c */
- E->solver.lith_age_read_files = full_lith_age_read_files;
-
- /* Parallel_related.c */
- E->solver.parallel_processor_setup = full_parallel_processor_setup;
- E->solver.parallel_domain_decomp0 = full_parallel_domain_decomp0;
- E->solver.parallel_domain_boundary_nodes = full_parallel_domain_boundary_nodes;
- E->solver.parallel_communication_routs_v = full_parallel_communication_routs_v;
- E->solver.parallel_communication_routs_s = full_parallel_communication_routs_s;
- E->solver.exchange_id_d = full_exchange_id_d;
-
- /* Read_input_from_files.c */
- E->solver.read_input_files_for_timesteps = full_read_input_files_for_timesteps;
-
- /* Version_dependent.c */
- E->solver.node_locations = full_node_locations;
- E->solver.construct_boundary = full_construct_boundary;
-
- return;
-}
-
-
-/* End of file */
Copied: mc/3D/CitcomS/branches/cxx/lib/Full_solver.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Full_solver.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Full_solver.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Full_solver.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,96 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+
+
+#include "global_defs.h"
+
+
+/* Boundary_conditions.c */
+void full_velocity_boundary_conditions(struct All_variables *);
+void full_temperature_boundary_conditions(struct All_variables *);
+
+/* Geometry_cartesian.c */
+void full_set_2dc_defaults(struct All_variables *);
+void full_set_2pt5dc_defaults(struct All_variables *);
+void full_set_3dc_defaults(struct All_variables *);
+void full_set_3dsphere_defaults(struct All_variables *);
+
+/* Lith_age.c */
+void full_lith_age_read_files(struct All_variables *, int);
+
+/* Parallel_related.c */
+void full_parallel_processor_setup(struct All_variables *);
+void full_parallel_domain_decomp0(struct All_variables *);
+void full_parallel_domain_boundary_nodes(struct All_variables *);
+void full_parallel_communication_routs_v(struct All_variables *);
+void full_parallel_communication_routs_s(struct All_variables *);
+void full_exchange_id_d(struct All_variables *, double **, int);
+
+/* Read_input_from_files.c */
+void full_read_input_files_for_timesteps(struct All_variables *, int, int);
+
+/* Version_dependent.c */
+void full_node_locations(struct All_variables *);
+void full_construct_boundary(struct All_variables *);
+
+
+void full_solver_init(struct All_variables *E)
+{
+ /* Boundary_conditions.c */
+ E->solver.velocity_boundary_conditions = full_velocity_boundary_conditions;
+ E->solver.temperature_boundary_conditions = full_temperature_boundary_conditions;
+
+ /* Geometry_cartesian.c */
+ E->solver.set_2dc_defaults = full_set_2dc_defaults;
+ E->solver.set_2pt5dc_defaults = full_set_2pt5dc_defaults;
+ E->solver.set_3dc_defaults = full_set_3dc_defaults;
+ E->solver.set_3dsphere_defaults = full_set_3dsphere_defaults;
+
+ /* Lith_age.c */
+ E->solver.lith_age_read_files = full_lith_age_read_files;
+
+ /* Parallel_related.c */
+ E->solver.parallel_processor_setup = full_parallel_processor_setup;
+ E->solver.parallel_domain_decomp0 = full_parallel_domain_decomp0;
+ E->solver.parallel_domain_boundary_nodes = full_parallel_domain_boundary_nodes;
+ E->solver.parallel_communication_routs_v = full_parallel_communication_routs_v;
+ E->solver.parallel_communication_routs_s = full_parallel_communication_routs_s;
+ E->solver.exchange_id_d = full_exchange_id_d;
+
+ /* Read_input_from_files.c */
+ E->solver.read_input_files_for_timesteps = full_read_input_files_for_timesteps;
+
+ /* Version_dependent.c */
+ E->solver.node_locations = full_node_locations;
+ E->solver.construct_boundary = full_construct_boundary;
+
+ return;
+}
+
+
+/* End of file */
Deleted: mc/3D/CitcomS/branches/cxx/lib/Full_sphere_related.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Full_sphere_related.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Full_sphere_related.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,483 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-
-
-/* Functions relating to the building and use of mesh locations ... */
-
-#include <math.h>
-#include <sys/types.h>
-#include "element_definitions.h"
-#include "global_defs.h"
-
-
-/**************************************************************/
-/* This function transforms theta and phi to new coords */
-/* u and v using gnomonic projection. */
-/* See http://mathworld.wolfram.com/GnomonicProjection.html */
-
-void spherical_to_uv2(double center[2], int len,
- double *theta, double *phi,
- double *u, double *v)
-{
- double theta_f, phi_f;
- double cos_tf, sin_tf;
- double cosc, cost, sint, cosp2, sinp2;
- int i;
-
- /* theta_f and phi_f are the reference points of the cap */
-
- theta_f = center[0];
- phi_f = center[1];
-
- cos_tf = cos(theta_f);
- sin_tf = sin(theta_f);
-
- for(i=0; i<len; i++) {
- cost = cos(theta[i]);
- sint = sin(theta[i]);
-
- cosp2 = cos(phi[i] - phi_f);
- sinp2 = sin(phi[i] - phi_f);
-
- cosc = cos_tf * cost + sin_tf * sint * cosp2;
- cosc = 1.0 / cosc;
-
- u[i] = sint * sinp2 * cosc;
- v[i] = (sin_tf * cost - cos_tf * sint * cosp2) * cosc;
- }
- return;
-}
-
-
-/**************************************************************/
-/* This function transforms u and v to spherical coord */
-/* theta and phi using inverse gnomonic projection. */
-/* See http://mathworld.wolfram.com/GnomonicProjection.html */
-
-void uv_to_spherical(double center[2], int len,
- double *u, double *v,
- double *theta, double *phi)
-{
- double theta_f, phi_f, cos_tf, sin_tf;
- double x, y, r, c;
- double cosc, sinc;
- int i;
-
- /* theta_f and phi_f are the reference points at the midpoint of the cap */
-
- theta_f = center[0];
- phi_f = center[1];
-
- cos_tf = cos(theta_f);
- sin_tf = sin(theta_f);
-
- for(i=0; i<len; i++) {
- x = u[i];
- y = v[i];
- r = sqrt(x*x + y*y);
-
- /* special case: r=0, then (u,v) is the reference point */
- if(r == 0) {
- theta[i] = theta_f;
- phi[i] = phi_f;
- continue;
- }
-
- /* c = atan(r); cosc = cos(c); sinc = sin(c);*/
- cosc = 1.0 / sqrt(1 + r*r);
- sinc = sqrt(1 - cosc*cosc);
-
- theta[i] = acos(cosc * cos_tf +
- y * sinc * sin_tf / r);
- phi[i] = phi_f + atan(x * sinc /
- (r * sin_tf * cosc - y * cos_tf * sinc));
- }
- return;
-}
-
-
-/* Find the intersection point of two lines */
-/* The lines are: (x[0], y[0]) to (x[1], y[1]) */
-/* (x[2], y[2]) to (x[3], y[3]) */
-/* If found, the intersection point is stored */
-/* in (px, py) and return 1 */
-/* If not found, return 0 */
-
-static int find_intersection(double *x, double *y,
- double *px, double *py)
-{
- double a1, b1, c1;
- double a2, b2, c2;
- double denom;
-
- a1 = y[1] - y[0];
- b1 = x[0] - x[1];
- c1 = x[1]*y[0] - x[0]*y[1];
-
- a2 = y[3] - y[2];
- b2 = x[2] - x[3];
- c2 = x[3]*y[2] - x[2]*y[3];
-
- denom = a1*b2 - a2*b1;
- if (denom == 0) return 0; /* the lines are parallel! */
-
- *px = (b1*c2 - b2*c1)/denom;
- *py = (a2*c1 - a1*c2)/denom;
- return 1;
-}
-
-
-void full_coord_of_cap(struct All_variables *E, int m, int icap)
-{
- int i, j, k, lev, temp, elx, ely;
- int node, snode, ns, step;
- int lelx, lely, lnox, lnoy;
- int lvnox, lvnoy, lvnoz;
- int ok;
- double x[5], y[5], z[5], center[3], referencep[2];
- double xx[5], yy[5];
- double *theta0, *fi0;
- double *tt1, *tt2, *tt3, *tt4, *ff1, *ff2, *ff3, *ff4;
- double *u1, *u2, *u3, *u4, *v1, *v2, *v3, *v4;
- double *px, *py, *qx, *qy;
- double theta, fi, cost, sint, cosf, sinf, efac2,rfac;
- double a, b;
- double myatan();
-
- void even_divide_arc12();
-
- temp = max(E->mesh.noy, E->mesh.nox);
-
- theta0 = (double *)malloc((temp+1)*sizeof(double));
- fi0 = (double *)malloc((temp+1)*sizeof(double));
-
- tt1 = (double *)malloc((temp+1)*sizeof(double));
- tt2 = (double *)malloc((temp+1)*sizeof(double));
- tt3 = (double *)malloc((temp+1)*sizeof(double));
- tt4 = (double *)malloc((temp+1)*sizeof(double));
-
- ff1 = (double *)malloc((temp+1)*sizeof(double));
- ff2 = (double *)malloc((temp+1)*sizeof(double));
- ff3 = (double *)malloc((temp+1)*sizeof(double));
- ff4 = (double *)malloc((temp+1)*sizeof(double));
-
- u1 = (double *)malloc((temp+1)*sizeof(double));
- u2 = (double *)malloc((temp+1)*sizeof(double));
- u3 = (double *)malloc((temp+1)*sizeof(double));
- u4 = (double *)malloc((temp+1)*sizeof(double));
-
- v1 = (double *)malloc((temp+1)*sizeof(double));
- v2 = (double *)malloc((temp+1)*sizeof(double));
- v3 = (double *)malloc((temp+1)*sizeof(double));
- v4 = (double *)malloc((temp+1)*sizeof(double));
-
- temp = E->mesh.noy * E->mesh.nox;
- px = malloc((temp+1)*sizeof(double));
- py = malloc((temp+1)*sizeof(double));
- qx = malloc((temp+1)*sizeof(double));
- qy = malloc((temp+1)*sizeof(double));
-
-
-
- /* 4 corners of the cap in Cartesian coordinates */
- /* the order of corners is: */
- /* 1 - 4 */
- /* | | */
- /* 2 - 3 */
- center[0] = center[1] = center[2] = 0;
-#ifdef ALLOW_ELLIPTICAL
- for (i=1;i<=4;i++) { /* works for both elliptical and spherical */
-
- x[i] = E->data.ra * sin(E->sphere.cap[icap].theta[i])*cos(E->sphere.cap[icap].fi[i]);
- y[i] = E->data.ra * sin(E->sphere.cap[icap].theta[i])*sin(E->sphere.cap[icap].fi[i]);
- z[i] = E->data.rc * cos(E->sphere.cap[icap].theta[i]);
-
- center[0] += x[i];
- center[1] += y[i];
- center[2] += z[i];
- }
-#else
- /* only spherical */
- for (i=1;i<=4;i++) {
- x[i] = sin(E->sphere.cap[icap].theta[i])*cos(E->sphere.cap[icap].fi[i]);
- y[i] = sin(E->sphere.cap[icap].theta[i])*sin(E->sphere.cap[icap].fi[i]);
- z[i] = cos(E->sphere.cap[icap].theta[i]);
- center[0] += x[i];
- center[1] += y[i];
- center[2] += z[i];
- }
-#endif
-
- center[0] *= 0.25;
- center[1] *= 0.25;
- center[2] *= 0.25;
-
- /* use the center as the reference point for gnomonic projection */
- referencep[0] = acos(center[2] /
- sqrt(center[0]*center[0] +
- center[1]*center[1] +
- center[2]*center[2]));;
- referencep[1] = myatan(center[1], center[0]);
-
-
- lev = E->mesh.levmax;
-
- /* # of elements/nodes per cap */
- elx = E->lmesh.ELX[lev]*E->parallel.nprocx;
- ely = E->lmesh.ELY[lev]*E->parallel.nprocy;
-
- /* # of elements/nodes per processor */
- lelx = E->lmesh.ELX[lev];
- lely = E->lmesh.ELY[lev];
- lnox = lelx+1;
- lnoy = lely+1;
-
- /* evenly divide arc linking corner 1 and 2 */
- even_divide_arc12(elx,x[1],y[1],z[1],x[2],y[2],z[2],theta0,fi0);
-
- /* pick up only points within this processor */
- for (j=0, i=E->lmesh.nxs; j<lnox; j++, i++) {
- tt1[j] = theta0[i];
- ff1[j] = fi0[i];
- }
-
- /* evenly divide arc linking corner 4 and 3 */
- even_divide_arc12(elx,x[4],y[4],z[4],x[3],y[3],z[3],theta0,fi0);
-
- /* pick up only points within this processor */
- for (j=0, i=E->lmesh.nxs; j<lnox; j++, i++) {
- tt2[j] = theta0[i];
- ff2[j] = fi0[i];
- }
-
- /* evenly divide arc linking corner 1 and 4 */
- even_divide_arc12(ely,x[1],y[1],z[1],x[4],y[4],z[4],theta0,fi0);
-
- /* pick up only points within this processor */
- for (k=0, i=E->lmesh.nys; k<lnoy; k++, i++) {
- tt3[k] = theta0[i];
- ff3[k] = fi0[i];
- }
-
- /* evenly divide arc linking corner 2 and 3 */
- even_divide_arc12(ely,x[2],y[2],z[2],x[3],y[3],z[3],theta0,fi0);
-
- /* pick up only points within this processor */
- for (k=0, i=E->lmesh.nys; k<lnoy; k++, i++) {
- tt4[k] = theta0[i];
- ff4[k] = fi0[i];
- }
-
- /* compute the intersection point of these great circles */
- /* the point is first found in u-v space and project back */
- /* to theta-phi space later */
-
- spherical_to_uv2(referencep, lnox, tt1, ff1, u1, v1);
- spherical_to_uv2(referencep, lnox, tt2, ff2, u2, v2);
- spherical_to_uv2(referencep, lnoy, tt3, ff3, u3, v3);
- spherical_to_uv2(referencep, lnoy, tt4, ff4, u4, v4);
-
- snode = 0;
- for(k=0; k<lnoy; k++) {
- xx[2] = u3[k];
- yy[2] = v3[k];
-
- xx[3] = u4[k];
- yy[3] = v4[k];
-
- for(j=0; j<lnox; j++) {
- xx[0] = u1[j];
- yy[0] = v1[j];
-
- xx[1] = u2[j];
- yy[1] = v2[j];
-
- ok = find_intersection(xx, yy, &a, &b);
- if(!ok) {
- fprintf(stderr, "Error(Full_coord_of_cap): cannot find intersection point! rank=%d, nx=%d, ny=%d\n", E->parallel.me, j, k);
- fprintf(stderr, "L1: (%g, %g)-(%g, %g) L2 (%g, %g)-(%g, %g)\n",
- xx[0],yy[0],xx[1],yy[1],xx[2],yy[2],xx[3],yy[3]);
- exit(10);
- }
-
- px[snode] = a;
- py[snode] = b;
- snode++;
- }
- }
-
- uv_to_spherical(referencep, snode, px, py, qx, qy);
-
- /* replace (qx, qy) by (tt?, ff?) for points on the edge */
- if(E->parallel.me_loc[2] == 0) {
- /* x boundary */
- for(k=0; k<lnox; k++) {
- i = k;
- qx[i] = tt1[k];
- qy[i] = ff1[k];
- }
- }
-
- if(E->parallel.me_loc[2] == E->parallel.nprocy-1) {
- /* x boundary */
- for(k=0; k<lnox; k++) {
- i = k + (lnoy - 1) * lnox;
- qx[i] = tt2[k];
- qy[i] = ff2[k];
- }
- }
-
- if(E->parallel.me_loc[1] == 0) {
- /* y boundary */
- for(k=0; k<lnoy; k++) {
- i = k * lnox;
- qx[i] = tt3[k];
- qy[i] = ff3[k];
- }
- }
-
- if(E->parallel.me_loc[1] == E->parallel.nprocx-1) {
- /* y boundary */
- for(k=0; k<lnoy; k++) {
- i = (k + 1) * lnox - 1;
- qx[i] = tt4[k];
- qy[i] = ff4[k];
- }
- }
-
-#ifdef ALLOW_ELLIPTICAL
- /* both spherical and elliptical */
- efac2 = E->data.ellipticity*(2.0 - E->data.ellipticity)/
- ((1.- E->data.ellipticity)*(1.-E->data.ellipticity));
-
- for (lev=E->mesh.levmax, step=1; lev>=E->mesh.levmin; lev--, step*=2) {
- /* store the node location in spherical and cartesian coordinates */
-
- lvnox = E->lmesh.NOX[lev];
- lvnoy = E->lmesh.NOY[lev];
- lvnoz = E->lmesh.NOZ[lev];
-
- node = 1;
- for (k=0; k<lvnoy; k++) {
- for (j=0, ns=step*lnoy*k; j<lvnox; j++, ns+=step) {
- theta = qx[ns];
- fi = qy[ns];
-
- cost = cos(theta);
-
- rfac = E->data.ra*1./sqrt(1.0+efac2*cost*cost);
- sint = sin(theta);
- cosf = cos(fi);
- sinf = sin(fi);
-
- for (i=1; i<=lvnoz; i++) {
- /* theta,fi,and r coordinates */
- E->SX[lev][m][1][node] = theta;
- E->SX[lev][m][2][node] = fi;
- E->SX[lev][m][3][node] = rfac * E->sphere.R[lev][i];
-
- /* x,y,and z oordinates */
- E->X[lev][m][1][node] = E->data.ra * E->sphere.R[lev][i]*sint*cosf;
- E->X[lev][m][2][node] = E->data.ra * E->sphere.R[lev][i]*sint*sinf;
- E->X[lev][m][3][node] = E->data.rc * E->sphere.R[lev][i]*cost;
-
- node++;
- }
- }
- }
- } /* end for lev */
-#else
- /* spherical */
- for (lev=E->mesh.levmax, step=1; lev>=E->mesh.levmin; lev--, step*=2) {
- /* store the node location in spherical and cartesian coordinates */
-
- lvnox = E->lmesh.NOX[lev];
- lvnoy = E->lmesh.NOY[lev];
- lvnoz = E->lmesh.NOZ[lev];
-
- node = 1;
- for (k=0; k<lvnoy; k++) {
- for (j=0, ns=step*lnoy*k; j<lvnox; j++, ns+=step) {
- theta = qx[ns];
- fi = qy[ns];
-
- cost = cos(theta);
- sint = sin(theta);
- cosf = cos(fi);
- sinf = sin(fi);
-
- for (i=1; i<=lvnoz; i++) {
- /* theta,fi,and r coordinates */
- E->SX[lev][m][1][node] = theta;
- E->SX[lev][m][2][node] = fi;
- E->SX[lev][m][3][node] = E->sphere.R[lev][i];
-
- /* x,y,and z oordinates */
- E->X[lev][m][1][node] = E->sphere.R[lev][i]*sint*cosf;
- E->X[lev][m][2][node] = E->sphere.R[lev][i]*sint*sinf;
- E->X[lev][m][3][node] = E->sphere.R[lev][i]*cost;
-
- node++;
- }
- }
- }
- } /* end for lev */
-#endif
-
- free ((void *)theta0);
- free ((void *)fi0 );
-
- free ((void *)tt1 );
- free ((void *)tt2 );
- free ((void *)tt3 );
- free ((void *)tt4 );
-
- free ((void *)ff1 );
- free ((void *)ff2 );
- free ((void *)ff3 );
- free ((void *)ff4 );
-
- free ((void *)u1 );
- free ((void *)u2 );
- free ((void *)u3 );
- free ((void *)u4 );
-
- free ((void *)v1 );
- free ((void *)v2 );
- free ((void *)v3 );
- free ((void *)v4 );
-
- free ((void *)px );
- free ((void *)py );
- free ((void *)qx );
- free ((void *)qy );
-
-
- return;
-}
-
Copied: mc/3D/CitcomS/branches/cxx/lib/Full_sphere_related.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Full_sphere_related.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Full_sphere_related.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Full_sphere_related.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,482 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+
+
+/* Functions relating to the building and use of mesh locations ... */
+
+#include <math.h>
+#include <sys/types.h>
+#include "element_definitions.h"
+#include "global_defs.h"
+
+#include "cproto.h"
+
+
+/**************************************************************/
+/* This function transforms theta and phi to new coords */
+/* u and v using gnomonic projection. */
+/* See http://mathworld.wolfram.com/GnomonicProjection.html */
+
+void spherical_to_uv2(double center[2], int len,
+ double *theta, double *phi,
+ double *u, double *v)
+{
+ double theta_f, phi_f;
+ double cos_tf, sin_tf;
+ double cosc, cost, sint, cosp2, sinp2;
+ int i;
+
+ /* theta_f and phi_f are the reference points of the cap */
+
+ theta_f = center[0];
+ phi_f = center[1];
+
+ cos_tf = cos(theta_f);
+ sin_tf = sin(theta_f);
+
+ for(i=0; i<len; i++) {
+ cost = cos(theta[i]);
+ sint = sin(theta[i]);
+
+ cosp2 = cos(phi[i] - phi_f);
+ sinp2 = sin(phi[i] - phi_f);
+
+ cosc = cos_tf * cost + sin_tf * sint * cosp2;
+ cosc = 1.0 / cosc;
+
+ u[i] = sint * sinp2 * cosc;
+ v[i] = (sin_tf * cost - cos_tf * sint * cosp2) * cosc;
+ }
+ return;
+}
+
+
+/**************************************************************/
+/* This function transforms u and v to spherical coord */
+/* theta and phi using inverse gnomonic projection. */
+/* See http://mathworld.wolfram.com/GnomonicProjection.html */
+
+void uv_to_spherical(double center[2], int len,
+ double *u, double *v,
+ double *theta, double *phi)
+{
+ double theta_f, phi_f, cos_tf, sin_tf;
+ double x, y, r, c;
+ double cosc, sinc;
+ int i;
+
+ /* theta_f and phi_f are the reference points at the midpoint of the cap */
+
+ theta_f = center[0];
+ phi_f = center[1];
+
+ cos_tf = cos(theta_f);
+ sin_tf = sin(theta_f);
+
+ for(i=0; i<len; i++) {
+ x = u[i];
+ y = v[i];
+ r = sqrt(x*x + y*y);
+
+ /* special case: r=0, then (u,v) is the reference point */
+ if(r == 0) {
+ theta[i] = theta_f;
+ phi[i] = phi_f;
+ continue;
+ }
+
+ /* c = atan(r); cosc = cos(c); sinc = sin(c);*/
+ cosc = 1.0 / sqrt(1 + r*r);
+ sinc = sqrt(1 - cosc*cosc);
+
+ theta[i] = acos(cosc * cos_tf +
+ y * sinc * sin_tf / r);
+ phi[i] = phi_f + atan(x * sinc /
+ (r * sin_tf * cosc - y * cos_tf * sinc));
+ }
+ return;
+}
+
+
+/* Find the intersection point of two lines */
+/* The lines are: (x[0], y[0]) to (x[1], y[1]) */
+/* (x[2], y[2]) to (x[3], y[3]) */
+/* If found, the intersection point is stored */
+/* in (px, py) and return 1 */
+/* If not found, return 0 */
+
+static int find_intersection(double *x, double *y,
+ double *px, double *py)
+{
+ double a1, b1, c1;
+ double a2, b2, c2;
+ double denom;
+
+ a1 = y[1] - y[0];
+ b1 = x[0] - x[1];
+ c1 = x[1]*y[0] - x[0]*y[1];
+
+ a2 = y[3] - y[2];
+ b2 = x[2] - x[3];
+ c2 = x[3]*y[2] - x[2]*y[3];
+
+ denom = a1*b2 - a2*b1;
+ if (denom == 0) return 0; /* the lines are parallel! */
+
+ *px = (b1*c2 - b2*c1)/denom;
+ *py = (a2*c1 - a1*c2)/denom;
+ return 1;
+}
+
+
+void full_coord_of_cap(struct All_variables *E, int m, int icap)
+{
+ int i, j, k, lev, temp, elx, ely;
+ int node, snode, ns, step;
+ int lelx, lely, lnox, lnoy;
+ int lvnox, lvnoy, lvnoz;
+ int ok;
+ double x[5], y[5], z[5], center[3], referencep[2];
+ double xx[5], yy[5];
+ double *theta0, *fi0;
+ double *tt1, *tt2, *tt3, *tt4, *ff1, *ff2, *ff3, *ff4;
+ double *u1, *u2, *u3, *u4, *v1, *v2, *v3, *v4;
+ double *px, *py, *qx, *qy;
+ double theta, fi, cost, sint, cosf, sinf, efac2,rfac;
+ double a, b;
+
+ temp = max(E->mesh.noy, E->mesh.nox);
+
+ theta0 = (double *)malloc((temp+1)*sizeof(double));
+ fi0 = (double *)malloc((temp+1)*sizeof(double));
+
+ tt1 = (double *)malloc((temp+1)*sizeof(double));
+ tt2 = (double *)malloc((temp+1)*sizeof(double));
+ tt3 = (double *)malloc((temp+1)*sizeof(double));
+ tt4 = (double *)malloc((temp+1)*sizeof(double));
+
+ ff1 = (double *)malloc((temp+1)*sizeof(double));
+ ff2 = (double *)malloc((temp+1)*sizeof(double));
+ ff3 = (double *)malloc((temp+1)*sizeof(double));
+ ff4 = (double *)malloc((temp+1)*sizeof(double));
+
+ u1 = (double *)malloc((temp+1)*sizeof(double));
+ u2 = (double *)malloc((temp+1)*sizeof(double));
+ u3 = (double *)malloc((temp+1)*sizeof(double));
+ u4 = (double *)malloc((temp+1)*sizeof(double));
+
+ v1 = (double *)malloc((temp+1)*sizeof(double));
+ v2 = (double *)malloc((temp+1)*sizeof(double));
+ v3 = (double *)malloc((temp+1)*sizeof(double));
+ v4 = (double *)malloc((temp+1)*sizeof(double));
+
+ temp = E->mesh.noy * E->mesh.nox;
+ px = (double *)malloc((temp+1)*sizeof(double));
+ py = (double *)malloc((temp+1)*sizeof(double));
+ qx = (double *)malloc((temp+1)*sizeof(double));
+ qy = (double *)malloc((temp+1)*sizeof(double));
+
+
+
+ /* 4 corners of the cap in Cartesian coordinates */
+ /* the order of corners is: */
+ /* 1 - 4 */
+ /* | | */
+ /* 2 - 3 */
+ center[0] = center[1] = center[2] = 0;
+#ifdef ALLOW_ELLIPTICAL
+ for (i=1;i<=4;i++) { /* works for both elliptical and spherical */
+
+ x[i] = E->data.ra * sin(E->sphere.cap[icap].theta[i])*cos(E->sphere.cap[icap].fi[i]);
+ y[i] = E->data.ra * sin(E->sphere.cap[icap].theta[i])*sin(E->sphere.cap[icap].fi[i]);
+ z[i] = E->data.rc * cos(E->sphere.cap[icap].theta[i]);
+
+ center[0] += x[i];
+ center[1] += y[i];
+ center[2] += z[i];
+ }
+#else
+ /* only spherical */
+ for (i=1;i<=4;i++) {
+ x[i] = sin(E->sphere.cap[icap].theta[i])*cos(E->sphere.cap[icap].fi[i]);
+ y[i] = sin(E->sphere.cap[icap].theta[i])*sin(E->sphere.cap[icap].fi[i]);
+ z[i] = cos(E->sphere.cap[icap].theta[i]);
+ center[0] += x[i];
+ center[1] += y[i];
+ center[2] += z[i];
+ }
+#endif
+
+ center[0] *= 0.25;
+ center[1] *= 0.25;
+ center[2] *= 0.25;
+
+ /* use the center as the reference point for gnomonic projection */
+ referencep[0] = acos(center[2] /
+ sqrt(center[0]*center[0] +
+ center[1]*center[1] +
+ center[2]*center[2]));;
+ referencep[1] = myatan(center[1], center[0]);
+
+
+ lev = E->mesh.levmax;
+
+ /* # of elements/nodes per cap */
+ elx = E->lmesh.ELX[lev]*E->parallel.nprocx;
+ ely = E->lmesh.ELY[lev]*E->parallel.nprocy;
+
+ /* # of elements/nodes per processor */
+ lelx = E->lmesh.ELX[lev];
+ lely = E->lmesh.ELY[lev];
+ lnox = lelx+1;
+ lnoy = lely+1;
+
+ /* evenly divide arc linking corner 1 and 2 */
+ even_divide_arc12(elx,x[1],y[1],z[1],x[2],y[2],z[2],theta0,fi0);
+
+ /* pick up only points within this processor */
+ for (j=0, i=E->lmesh.nxs; j<lnox; j++, i++) {
+ tt1[j] = theta0[i];
+ ff1[j] = fi0[i];
+ }
+
+ /* evenly divide arc linking corner 4 and 3 */
+ even_divide_arc12(elx,x[4],y[4],z[4],x[3],y[3],z[3],theta0,fi0);
+
+ /* pick up only points within this processor */
+ for (j=0, i=E->lmesh.nxs; j<lnox; j++, i++) {
+ tt2[j] = theta0[i];
+ ff2[j] = fi0[i];
+ }
+
+ /* evenly divide arc linking corner 1 and 4 */
+ even_divide_arc12(ely,x[1],y[1],z[1],x[4],y[4],z[4],theta0,fi0);
+
+ /* pick up only points within this processor */
+ for (k=0, i=E->lmesh.nys; k<lnoy; k++, i++) {
+ tt3[k] = theta0[i];
+ ff3[k] = fi0[i];
+ }
+
+ /* evenly divide arc linking corner 2 and 3 */
+ even_divide_arc12(ely,x[2],y[2],z[2],x[3],y[3],z[3],theta0,fi0);
+
+ /* pick up only points within this processor */
+ for (k=0, i=E->lmesh.nys; k<lnoy; k++, i++) {
+ tt4[k] = theta0[i];
+ ff4[k] = fi0[i];
+ }
+
+ /* compute the intersection point of these great circles */
+ /* the point is first found in u-v space and project back */
+ /* to theta-phi space later */
+
+ spherical_to_uv2(referencep, lnox, tt1, ff1, u1, v1);
+ spherical_to_uv2(referencep, lnox, tt2, ff2, u2, v2);
+ spherical_to_uv2(referencep, lnoy, tt3, ff3, u3, v3);
+ spherical_to_uv2(referencep, lnoy, tt4, ff4, u4, v4);
+
+ snode = 0;
+ for(k=0; k<lnoy; k++) {
+ xx[2] = u3[k];
+ yy[2] = v3[k];
+
+ xx[3] = u4[k];
+ yy[3] = v4[k];
+
+ for(j=0; j<lnox; j++) {
+ xx[0] = u1[j];
+ yy[0] = v1[j];
+
+ xx[1] = u2[j];
+ yy[1] = v2[j];
+
+ ok = find_intersection(xx, yy, &a, &b);
+ if(!ok) {
+ fprintf(stderr, "Error(Full_coord_of_cap): cannot find intersection point! rank=%d, nx=%d, ny=%d\n", E->parallel.me, j, k);
+ fprintf(stderr, "L1: (%g, %g)-(%g, %g) L2 (%g, %g)-(%g, %g)\n",
+ xx[0],yy[0],xx[1],yy[1],xx[2],yy[2],xx[3],yy[3]);
+ exit(10);
+ }
+
+ px[snode] = a;
+ py[snode] = b;
+ snode++;
+ }
+ }
+
+ uv_to_spherical(referencep, snode, px, py, qx, qy);
+
+ /* replace (qx, qy) by (tt?, ff?) for points on the edge */
+ if(E->parallel.me_loc[2] == 0) {
+ /* x boundary */
+ for(k=0; k<lnox; k++) {
+ i = k;
+ qx[i] = tt1[k];
+ qy[i] = ff1[k];
+ }
+ }
+
+ if(E->parallel.me_loc[2] == E->parallel.nprocy-1) {
+ /* x boundary */
+ for(k=0; k<lnox; k++) {
+ i = k + (lnoy - 1) * lnox;
+ qx[i] = tt2[k];
+ qy[i] = ff2[k];
+ }
+ }
+
+ if(E->parallel.me_loc[1] == 0) {
+ /* y boundary */
+ for(k=0; k<lnoy; k++) {
+ i = k * lnox;
+ qx[i] = tt3[k];
+ qy[i] = ff3[k];
+ }
+ }
+
+ if(E->parallel.me_loc[1] == E->parallel.nprocx-1) {
+ /* y boundary */
+ for(k=0; k<lnoy; k++) {
+ i = (k + 1) * lnox - 1;
+ qx[i] = tt4[k];
+ qy[i] = ff4[k];
+ }
+ }
+
+#ifdef ALLOW_ELLIPTICAL
+ /* both spherical and elliptical */
+ efac2 = E->data.ellipticity*(2.0 - E->data.ellipticity)/
+ ((1.- E->data.ellipticity)*(1.-E->data.ellipticity));
+
+ for (lev=E->mesh.levmax, step=1; lev>=E->mesh.levmin; lev--, step*=2) {
+ /* store the node location in spherical and cartesian coordinates */
+
+ lvnox = E->lmesh.NOX[lev];
+ lvnoy = E->lmesh.NOY[lev];
+ lvnoz = E->lmesh.NOZ[lev];
+
+ node = 1;
+ for (k=0; k<lvnoy; k++) {
+ for (j=0, ns=step*lnoy*k; j<lvnox; j++, ns+=step) {
+ theta = qx[ns];
+ fi = qy[ns];
+
+ cost = cos(theta);
+
+ rfac = E->data.ra*1./sqrt(1.0+efac2*cost*cost);
+ sint = sin(theta);
+ cosf = cos(fi);
+ sinf = sin(fi);
+
+ for (i=1; i<=lvnoz; i++) {
+ /* theta,fi,and r coordinates */
+ E->SX[lev][m][1][node] = theta;
+ E->SX[lev][m][2][node] = fi;
+ E->SX[lev][m][3][node] = rfac * E->sphere.R[lev][i];
+
+ /* x,y,and z oordinates */
+ E->X[lev][m][1][node] = E->data.ra * E->sphere.R[lev][i]*sint*cosf;
+ E->X[lev][m][2][node] = E->data.ra * E->sphere.R[lev][i]*sint*sinf;
+ E->X[lev][m][3][node] = E->data.rc * E->sphere.R[lev][i]*cost;
+
+ node++;
+ }
+ }
+ }
+ } /* end for lev */
+#else
+ /* spherical */
+ for (lev=E->mesh.levmax, step=1; lev>=E->mesh.levmin; lev--, step*=2) {
+ /* store the node location in spherical and cartesian coordinates */
+
+ lvnox = E->lmesh.NOX[lev];
+ lvnoy = E->lmesh.NOY[lev];
+ lvnoz = E->lmesh.NOZ[lev];
+
+ node = 1;
+ for (k=0; k<lvnoy; k++) {
+ for (j=0, ns=step*lnoy*k; j<lvnox; j++, ns+=step) {
+ theta = qx[ns];
+ fi = qy[ns];
+
+ cost = cos(theta);
+ sint = sin(theta);
+ cosf = cos(fi);
+ sinf = sin(fi);
+
+ for (i=1; i<=lvnoz; i++) {
+ /* theta,fi,and r coordinates */
+ E->SX[lev][m][1][node] = theta;
+ E->SX[lev][m][2][node] = fi;
+ E->SX[lev][m][3][node] = E->sphere.R[lev][i];
+
+ /* x,y,and z oordinates */
+ E->X[lev][m][1][node] = E->sphere.R[lev][i]*sint*cosf;
+ E->X[lev][m][2][node] = E->sphere.R[lev][i]*sint*sinf;
+ E->X[lev][m][3][node] = E->sphere.R[lev][i]*cost;
+
+ node++;
+ }
+ }
+ }
+ } /* end for lev */
+#endif
+
+ free ((void *)theta0);
+ free ((void *)fi0 );
+
+ free ((void *)tt1 );
+ free ((void *)tt2 );
+ free ((void *)tt3 );
+ free ((void *)tt4 );
+
+ free ((void *)ff1 );
+ free ((void *)ff2 );
+ free ((void *)ff3 );
+ free ((void *)ff4 );
+
+ free ((void *)u1 );
+ free ((void *)u2 );
+ free ((void *)u3 );
+ free ((void *)u4 );
+
+ free ((void *)v1 );
+ free ((void *)v2 );
+ free ((void *)v3 );
+ free ((void *)v4 );
+
+ free ((void *)px );
+ free ((void *)py );
+ free ((void *)qx );
+ free ((void *)qy );
+
+
+ return;
+}
+
Deleted: mc/3D/CitcomS/branches/cxx/lib/Full_tracer_advection.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Full_tracer_advection.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Full_tracer_advection.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,3492 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-
-#include <math.h>
-#include "element_definitions.h"
-#include "global_defs.h"
-#include "parsing.h"
-#include "parallel_related.h"
-#include "composition_related.h"
-
-static void get_2dshape(struct All_variables *E,
- int j, int nelem,
- double u, double v,
- int iwedge, double * shape2d);
-static void get_radial_shape(struct All_variables *E,
- int j, int nelem,
- double rad, double *shaperad);
-static void spherical_to_uv(struct All_variables *E, int j,
- double theta, double phi,
- double *u, double *v);
-static void make_regular_grid(struct All_variables *E);
-static void write_trace_instructions(struct All_variables *E);
-static int icheck_column_neighbors(struct All_variables *E,
- int j, int nel,
- double x, double y, double z,
- double rad);
-static int icheck_all_columns(struct All_variables *E,
- int j,
- double x, double y, double z,
- double rad);
-static int icheck_element(struct All_variables *E,
- int j, int nel,
- double x, double y, double z,
- double rad);
-static int icheck_shell(struct All_variables *E,
- int nel, double rad);
-static int icheck_element_column(struct All_variables *E,
- int j, int nel,
- double x, double y, double z,
- double rad);
-static int icheck_bounds(struct All_variables *E,
- double *test_point,
- double *rnode1, double *rnode2,
- double *rnode3, double *rnode4);
-static double findradial(struct All_variables *E, double *vec,
- double cost, double sint,
- double cosf, double sinf);
-static void makevector(double *vec, double xf, double yf, double zf,
- double x0, double y0, double z0);
-static void crossit(double *cross, double *A, double *B);
-static void fix_radius(struct All_variables *E,
- double *radius, double *theta, double *phi,
- double *x, double *y, double *z);
-static void fix_angle(double *angle);
-static void fix_theta_phi(double *theta, double *phi);
-static int iget_radial_element(struct All_variables *E,
- int j, int iel,
- double rad);
-static int iget_regel(struct All_variables *E, int j,
- double theta, double phi,
- int *ntheta, int *nphi);
-static void define_uv_space(struct All_variables *E);
-static void determine_shape_coefficients(struct All_variables *E);
-static void full_put_lost_tracers(struct All_variables *E,
- int isend[13][13], double *send[13][13]);
-void pdebug(struct All_variables *E, int i);
-int full_icheck_cap(struct All_variables *E, int icap,
- double x, double y, double z, double rad);
-
-
-
-/******* FULL TRACER INPUT *********************/
-
-void full_tracer_input(struct All_variables *E)
-{
- int m = E->parallel.me;
-
-
- /* Regular grid parameters */
- /* (first fill uniform del[0] value) */
- /* (later, in make_regular_grid, will adjust and distribute to caps */
-
- E->trace.deltheta[0]=1.0;
- E->trace.delphi[0]=1.0;
- input_double("regular_grid_deltheta",&(E->trace.deltheta[0]),"1.0",m);
- input_double("regular_grid_delphi",&(E->trace.delphi[0]),"1.0",m);
-
-
- /* Analytical Test Function */
-
- E->trace.ianalytical_tracer_test=0;
- /* input_int("analytical_tracer_test",&(E->trace.ianalytical_tracer_test),
- "0,0,nomax",m); */
-
-
- return;
-}
-
-/***** FULL TRACER SETUP ************************/
-
-void full_tracer_setup(struct All_variables *E)
-{
-
- char output_file[200];
- void get_neighboring_caps();
- void analytical_test();
- double CPU_time0();
- double begin_time = CPU_time0();
-
- /* Some error control */
-
- if (E->sphere.caps_per_proc>1) {
- fprintf(stderr,"This code does not work for multiple caps per processor!\n");
- parallel_process_termination();
- }
-
-
- /* open tracing output file */
-
- sprintf(output_file,"%s.tracer_log.%d",E->control.data_file,E->parallel.me);
- E->trace.fpt=fopen(output_file,"w");
-
-
- /* reset statistical counters */
-
- E->trace.istat_isend=0;
- E->trace.istat_iempty=0;
- E->trace.istat_elements_checked=0;
- E->trace.istat1=0;
-
-
- /* some obscure initial parameters */
- /* This parameter specifies how close a tracer can get to the boundary */
- E->trace.box_cushion=0.00001;
-
- /* Determine number of tracer quantities */
-
- /* advection_quantites - those needed for advection */
- E->trace.number_of_basic_quantities=12;
-
- /* extra_quantities - used for flavors, composition, etc. */
- /* (can be increased for additional science i.e. tracing chemistry */
-
- E->trace.number_of_extra_quantities = 0;
- if (E->trace.nflavors > 0)
- E->trace.number_of_extra_quantities += 1;
-
-
- E->trace.number_of_tracer_quantities =
- E->trace.number_of_basic_quantities +
- E->trace.number_of_extra_quantities;
-
-
- /* Fixed positions in tracer array */
- /* Flavor is always in extraq position 0 */
- /* Current coordinates are always kept in basicq positions 0-5 */
- /* Other positions may be used depending on science being done */
-
-
- /* Some error control regarding size of pointer arrays */
-
- if (E->trace.number_of_basic_quantities>99) {
- fprintf(E->trace.fpt,"ERROR(initialize_trace)-increase 2nd position size of basic in tracer_defs.h\n");
- fflush(E->trace.fpt);
- parallel_process_termination();
- }
- if (E->trace.number_of_extra_quantities>99) {
- fprintf(E->trace.fpt,"ERROR(initialize_trace)-increase 2nd position size of extraq in tracer_defs.h\n");
- fflush(E->trace.fpt);
- parallel_process_termination();
- }
- if (E->trace.number_of_tracer_quantities>99) {
- fprintf(E->trace.fpt,"ERROR(initialize_trace)-increase 2nd position size of rlater in tracer_defs.h\n");
- fflush(E->trace.fpt);
- parallel_process_termination();
- }
-
- write_trace_instructions(E);
-
-
- /* Gnometric projection for velocity interpolation */
- define_uv_space(E);
- determine_shape_coefficients(E);
-
-
- /* The bounding box of neiboring processors */
- get_neighboring_caps(E);
-
-
- /* Fine-grained regular grid to search tracers */
- make_regular_grid(E);
-
-
- if (E->trace.ianalytical_tracer_test==1) {
- //TODO: walk into this code...
- analytical_test(E);
- parallel_process_termination();
- }
-
- if (E->composition.on)
- composition_setup(E);
-
- fprintf(E->trace.fpt, "Tracer intiailization takes %f seconds.\n",
- CPU_time0() - begin_time);
-
- return;
-}
-
-
-/************** LOST SOULS ***************************************************/
-/* */
-/* This function is used to transport tracers to proper processor domains. */
-/* (MPI parallel) */
-/* All of the tracers that were sent to rlater arrays are destined to another*/
-/* cap and sent there. Then they are raised up or down for multiple z procs. */
-/* isend[j][n]=number of tracers this processor cap is sending to cap n */
-/* ireceive[j][n]=number of tracers this processor cap receiving from cap n */
-
-
-void full_lost_souls(struct All_variables *E)
-{
- /* This code works only if E->sphere.caps_per_proc==1 */
- const int j = 1;
-
- int ithiscap;
- int ithatcap=1;
- int isend[13][13];
- int ireceive[13][13];
- int isize[13];
- int kk,pp;
- int mm;
- int numtracers;
- int icheck=0;
- int isend_position;
- int ipos,ipos2,ipos3;
- int idb;
- int idestination_proc=0;
- int isource_proc;
- int isend_z[13][3];
- int ireceive_z[13][3];
- int isum[13];
- int irad;
- int ival;
- int ithat_processor;
- int ireceive_position;
- int ivertical_neighbor;
- int ilast_receiver_position;
- int it;
- int irec[13];
- int irec_position;
- int iel;
- int num_tracers;
- int isize_send;
- int isize_receive;
- int itemp_size;
- int itracers_subject_to_vertical_transport[13];
-
- double x,y,z;
- double theta,phi,rad;
- double *send[13][13];
- double *receive[13][13];
- double *send_z[13][3];
- double *receive_z[13][3];
- double *REC[13];
-
- void expand_tracer_arrays();
- int icheck_that_processor_shell();
-
- double CPU_time0();
- double begin_time = CPU_time0();
-
- int number_of_caps=12;
- int lev=E->mesh.levmax;
- int num_ngb = E->parallel.TNUM_PASS[lev][j];
-
- /* Note, if for some reason, the number of neighbors exceeds */
- /* 50, which is unlikely, the MPI arrays must be increased. */
- MPI_Status status[200];
- MPI_Request request[200];
- MPI_Status status1;
- MPI_Status status2;
- int itag=1;
-
-
- parallel_process_sync(E);
- if(E->control.verbose)
- fprintf(E->trace.fpt, "Entering lost_souls()\n");
-
-
- E->trace.istat_isend=E->trace.ilater[j];
- /** debug **
- for (kk=1; kk<=E->trace.istat_isend; kk++) {
- fprintf(E->trace.fpt, "tracer#=%d xx=(%g,%g,%g)\n", kk,
- E->trace.rlater[j][0][kk],
- E->trace.rlater[j][1][kk],
- E->trace.rlater[j][2][kk]);
- }
- fflush(E->trace.fpt);
- /**/
-
-
-
- /* initialize isend and ireceive */
- /* # of neighbors in the horizontal plane */
- isize[j]=E->trace.ilater[j]*E->trace.number_of_tracer_quantities;
- for (kk=0;kk<=num_ngb;kk++) isend[j][kk]=0;
- for (kk=0;kk<=num_ngb;kk++) ireceive[j][kk]=0;
-
- /* Allocate Maximum Memory to Send Arrays */
-
- itemp_size=max(isize[j],1);
-
- for (kk=0;kk<=num_ngb;kk++) {
- if ((send[j][kk]=(double *)malloc(itemp_size*sizeof(double)))==NULL) {
- fprintf(E->trace.fpt,"Error(lost souls)-no memory (u389)\n");
- fflush(E->trace.fpt);
- exit(10);
- }
- }
-
-
- /** debug **
- ithiscap=E->sphere.capid[j];
- for (kk=1;kk<=num_ngb;kk++) {
- ithatcap=E->parallel.PROCESSOR[lev][j].pass[kk];
- fprintf(E->trace.fpt,"cap: %d me %d TNUM: %d rank: %d\n",
- ithiscap,E->parallel.me,kk,ithatcap);
-
- }
- fflush(E->trace.fpt);
- /**/
-
-
- /* Pre communication */
- full_put_lost_tracers(E, isend, send);
-
-
- /* Send info to other processors regarding number of send tracers */
-
- /* idb is the request array index variable */
- /* Each send and receive has a request variable */
-
- idb=0;
- ithiscap=0;
-
- /* if tracer is in same cap (nprocz>1) */
-
- if (E->parallel.nprocz>1) {
- ireceive[j][ithiscap]=isend[j][ithiscap];
- }
-
- for (kk=1;kk<=num_ngb;kk++) {
- idestination_proc=E->parallel.PROCESSOR[lev][j].pass[kk];
-
- MPI_Isend(&isend[j][kk],1,MPI_INT,idestination_proc,
- 11,E->parallel.world,&request[idb++]);
-
- MPI_Irecv(&ireceive[j][kk],1,MPI_INT,idestination_proc,
- 11,E->parallel.world,&request[idb++]);
-
- } /* end kk, number of neighbors */
-
- /* Wait for non-blocking calls to complete */
-
- MPI_Waitall(idb,request,status);
-
-
- /** debug **
- for (kk=0;kk<=num_ngb;kk++) {
- if(kk==0)
- isource_proc=E->parallel.me;
- else
- isource_proc=E->parallel.PROCESSOR[lev][j].pass[kk];
-
- fprintf(E->trace.fpt,"%d send %d to proc %d\n",
- E->parallel.me,isend[j][kk],isource_proc);
- fprintf(E->trace.fpt,"%d recv %d from proc %d\n",
- E->parallel.me,ireceive[j][kk],isource_proc);
- }
- /**/
-
- /* Allocate memory in receive arrays */
-
- for (ithatcap=0;ithatcap<=num_ngb;ithatcap++) {
- isize[j]=ireceive[j][ithatcap]*E->trace.number_of_tracer_quantities;
-
- itemp_size=max(1,isize[j]);
-
- if ((receive[j][ithatcap]=(double *)malloc(itemp_size*sizeof(double)))==NULL) {
- fprintf(E->trace.fpt,"Error(lost souls)-no memory (c721)\n");
- fflush(E->trace.fpt);
- exit(10);
- }
- }
-
- /* Now, send the tracers to proper caps */
-
- idb=0;
- ithiscap=0;
-
- /* same cap */
-
- if (E->parallel.nprocz>1) {
-
- ithatcap=ithiscap;
- isize[j]=isend[j][ithatcap]*E->trace.number_of_tracer_quantities;
- for (mm=0;mm<isize[j];mm++) {
- receive[j][ithatcap][mm]=send[j][ithatcap][mm];
- }
-
- }
-
- /* neighbor caps */
-
- for (kk=1;kk<=num_ngb;kk++) {
- idestination_proc=E->parallel.PROCESSOR[lev][j].pass[kk];
-
- isize[j]=isend[j][kk]*E->trace.number_of_tracer_quantities;
-
- MPI_Isend(send[j][kk],isize[j],MPI_DOUBLE,idestination_proc,
- 11,E->parallel.world,&request[idb++]);
-
- isize[j]=ireceive[j][kk]*E->trace.number_of_tracer_quantities;
-
- MPI_Irecv(receive[j][kk],isize[j],MPI_DOUBLE,idestination_proc,
- 11,E->parallel.world,&request[idb++]);
-
- } /* end kk, number of neighbors */
-
- /* Wait for non-blocking calls to complete */
-
- MPI_Waitall(idb,request,status);
-
-
- /* Put all received tracers in array REC[j] */
- /* This makes things more convenient. */
-
- /* Sum up size of receive arrays (all tracers sent to this processor) */
-
- isum[j]=0;
-
- ithiscap=0;
-
- for (kk=0;kk<=num_ngb;kk++) {
- isum[j]=isum[j]+ireceive[j][kk];
- }
-
- itracers_subject_to_vertical_transport[j]=isum[j];
-
-
- /* Allocate Memory for REC array */
-
- isize[j]=isum[j]*E->trace.number_of_tracer_quantities;
- isize[j]=max(isize[j],1);
- if ((REC[j]=(double *)malloc(isize[j]*sizeof(double)))==NULL) {
- fprintf(E->trace.fpt,"Error(lost souls)-no memory (g323)\n");
- fflush(E->trace.fpt);
- exit(10);
- }
-
-
- /* Put Received tracers in REC */
- irec[j]=0;
-
- irec_position=0;
-
- for (kk=0;kk<=num_ngb;kk++) {
-
- ithatcap=kk;
-
- for (pp=0;pp<ireceive[j][ithatcap];pp++) {
- irec[j]++;
- ipos=pp*E->trace.number_of_tracer_quantities;
-
- for (mm=0;mm<E->trace.number_of_tracer_quantities;mm++) {
- ipos2=ipos+mm;
- REC[j][irec_position]=receive[j][ithatcap][ipos2];
-
- irec_position++;
-
- } /* end mm (cycling tracer quantities) */
- } /* end pp (cycling tracers) */
- } /* end kk (cycling neighbors) */
-
-
- /* Done filling REC */
-
-
- /* VERTICAL COMMUNICATION */
-
- if (E->parallel.nprocz>1) {
-
- /* Allocate memory for send_z */
- /* Make send_z the size of receive array (max size) */
- /* (No dynamic reallocation of send_z necessary) */
-
- for (kk=1;kk<=E->parallel.TNUM_PASSz[lev];kk++) {
- isize[j]=itracers_subject_to_vertical_transport[j]*E->trace.number_of_tracer_quantities;
- isize[j]=max(isize[j],1);
-
- if ((send_z[j][kk]=(double *)malloc(isize[j]*sizeof(double)))==NULL) {
- fprintf(E->trace.fpt,"Error(lost souls)-no memory (c721)\n");
- fflush(E->trace.fpt);
- exit(10);
- }
- }
-
-
- for (ivertical_neighbor=1;ivertical_neighbor<=E->parallel.TNUM_PASSz[lev];ivertical_neighbor++) {
-
- ithat_processor=E->parallel.PROCESSORz[lev].pass[ivertical_neighbor];
-
- /* initialize isend_z and ireceive_z array */
-
- isend_z[j][ivertical_neighbor]=0;
- ireceive_z[j][ivertical_neighbor]=0;
-
- /* sort through receive array and check radius */
-
- it=0;
- num_tracers=irec[j];
- for (kk=1;kk<=num_tracers;kk++) {
-
- ireceive_position=it*E->trace.number_of_tracer_quantities;
- it++;
-
- irad=ireceive_position+2;
-
- rad=REC[j][irad];
-
- ival=icheck_that_processor_shell(E,j,ithat_processor,rad);
-
-
- /* if tracer is in other shell, take out of receive array and give to send_z*/
-
- if (ival==1) {
-
-
- isend_position=isend_z[j][ivertical_neighbor]*E->trace.number_of_tracer_quantities;
- isend_z[j][ivertical_neighbor]++;
-
- ilast_receiver_position=(irec[j]-1)*E->trace.number_of_tracer_quantities;
-
- for (mm=0;mm<=(E->trace.number_of_tracer_quantities-1);mm++) {
- ipos=ireceive_position+mm;
- ipos2=isend_position+mm;
-
- send_z[j][ivertical_neighbor][ipos2]=REC[j][ipos];
-
-
- /* eject tracer info from REC array, and replace with last tracer in array */
-
- ipos3=ilast_receiver_position+mm;
- REC[j][ipos]=REC[j][ipos3];
-
- }
-
- it--;
- irec[j]--;
-
- } /* end if ival===1 */
-
- /* Otherwise, leave tracer */
-
- } /* end kk (cycling through tracers) */
-
- } /* end ivertical_neighbor */
-
-
- /* Send arrays are now filled. */
- /* Now send send information to vertical processor neighbor */
- idb=0;
- for (kk=1;kk<=E->parallel.TNUM_PASSz[lev];kk++) {
-
- idestination_proc = E->parallel.PROCESSORz[lev].pass[kk];
- MPI_Isend(&isend_z[j][kk],1,MPI_INT,idestination_proc,
- 14,E->parallel.world,&request[idb++]);
-
- MPI_Irecv(&ireceive_z[j][kk],1,MPI_INT,idestination_proc,
- 14,E->parallel.world,&request[idb++]);
-
- } /* end ivertical_neighbor */
-
- /* Wait for non-blocking calls to complete */
-
- MPI_Waitall(idb,request,status);
-
-
- /** debug **
- for (kk=1;kk<=E->parallel.TNUM_PASSz[lev];kk++) {
- fprintf(E->trace.fpt, "PROC: %d IVN: %d (P: %d) "
- "SEND: %d REC: %d\n",
- E->parallel.me,kk,E->parallel.PROCESSORz[lev].pass[kk],
- isend_z[j][kk],ireceive_z[j][kk]);
- }
- fflush(E->trace.fpt);
- /**/
-
-
- /* Allocate memory to receive_z arrays */
-
-
- for (kk=1;kk<=E->parallel.TNUM_PASSz[lev];kk++) {
- isize[j]=ireceive_z[j][kk]*E->trace.number_of_tracer_quantities;
- isize[j]=max(isize[j],1);
-
- if ((receive_z[j][kk]=(double *)malloc(isize[j]*sizeof(double)))==NULL) {
- fprintf(E->trace.fpt,"Error(lost souls)-no memory (t590)\n");
- fflush(E->trace.fpt);
- exit(10);
- }
- }
-
- /* Send Tracers */
-
- idb=0;
- for (kk=1;kk<=E->parallel.TNUM_PASSz[lev];kk++) {
-
- idestination_proc = E->parallel.PROCESSORz[lev].pass[kk];
-
- isize_send=isend_z[j][kk]*E->trace.number_of_tracer_quantities;
-
- MPI_Isend(send_z[j][kk],isize_send,MPI_DOUBLE,idestination_proc,
- 15,E->parallel.world,&request[idb++]);
-
- isize_receive=ireceive_z[j][kk]*E->trace.number_of_tracer_quantities;
-
- MPI_Irecv(receive_z[j][kk],isize_receive,MPI_DOUBLE,idestination_proc,
- 15,E->parallel.world,&request[idb++]);
- }
-
- /* Wait for non-blocking calls to complete */
-
- MPI_Waitall(idb,request,status);
-
-
- /* Put tracers into REC array */
-
- /* First, reallocate memory to REC */
-
- isum[j]=0;
- for (ivertical_neighbor=1;ivertical_neighbor<=E->parallel.TNUM_PASSz[lev];ivertical_neighbor++) {
- isum[j]=isum[j]+ireceive_z[j][ivertical_neighbor];
- }
-
- isum[j]=isum[j]+irec[j];
-
- isize[j]=isum[j]*E->trace.number_of_tracer_quantities;
-
- if (isize[j]>0) {
- if ((REC[j]=(double *)realloc(REC[j],isize[j]*sizeof(double)))==NULL) {
- fprintf(E->trace.fpt,"Error(lost souls)-no memory (i981)\n");
- fprintf(E->trace.fpt,"isize: %d\n",isize[j]);
- fflush(E->trace.fpt);
- exit(10);
- }
- }
-
-
- for (ivertical_neighbor=1;ivertical_neighbor<=E->parallel.TNUM_PASSz[lev];ivertical_neighbor++) {
-
- for (kk=0;kk<ireceive_z[j][ivertical_neighbor];kk++) {
-
- irec_position=irec[j]*E->trace.number_of_tracer_quantities;
- irec[j]++;
- ireceive_position=kk*E->trace.number_of_tracer_quantities;
-
- for (mm=0;mm<E->trace.number_of_tracer_quantities;mm++) {
- REC[j][irec_position+mm]=receive_z[j][ivertical_neighbor][ireceive_position+mm];
- }
- }
-
- }
-
- /* Free Vertical Arrays */
- for (ivertical_neighbor=1;ivertical_neighbor<=E->parallel.TNUM_PASSz[lev];ivertical_neighbor++) {
- free(send_z[j][ivertical_neighbor]);
- free(receive_z[j][ivertical_neighbor]);
- }
-
- } /* endif nprocz>1 */
-
- /* END OF VERTICAL TRANSPORT */
-
- /* Put away tracers */
-
-
- for (kk=0;kk<irec[j];kk++) {
- E->trace.ntracers[j]++;
-
- if (E->trace.ntracers[j]>(E->trace.max_ntracers[j]-5)) expand_tracer_arrays(E,j);
-
- ireceive_position=kk*E->trace.number_of_tracer_quantities;
-
- for (mm=0;mm<E->trace.number_of_basic_quantities;mm++) {
- ipos=ireceive_position+mm;
-
- E->trace.basicq[j][mm][E->trace.ntracers[j]]=REC[j][ipos];
- }
- for (mm=0;mm<E->trace.number_of_extra_quantities;mm++) {
- ipos=ireceive_position+E->trace.number_of_basic_quantities+mm;
-
- E->trace.extraq[j][mm][E->trace.ntracers[j]]=REC[j][ipos];
- }
-
- theta=E->trace.basicq[j][0][E->trace.ntracers[j]];
- phi=E->trace.basicq[j][1][E->trace.ntracers[j]];
- rad=E->trace.basicq[j][2][E->trace.ntracers[j]];
- x=E->trace.basicq[j][3][E->trace.ntracers[j]];
- y=E->trace.basicq[j][4][E->trace.ntracers[j]];
- z=E->trace.basicq[j][5][E->trace.ntracers[j]];
-
-
- iel=(E->trace.iget_element)(E,j,-99,x,y,z,theta,phi,rad);
-
- if (iel<1) {
- fprintf(E->trace.fpt,"Error(lost souls) - element not here?\n");
- fprintf(E->trace.fpt,"x,y,z-theta,phi,rad: %f %f %f - %f %f %f\n",x,y,z,theta,phi,rad);
- fflush(E->trace.fpt);
- exit(10);
- }
-
- E->trace.ielement[j][E->trace.ntracers[j]]=iel;
-
- }
- if(E->control.verbose){
- fprintf(E->trace.fpt,"Freeing memory in lost_souls()\n");
- fflush(E->trace.fpt);
- }
- parallel_process_sync(E);
-
- /* Free Arrays */
-
- free(REC[j]);
-
- for (kk=0;kk<=num_ngb;kk++) {
- free(send[j][kk]);
- free(receive[j][kk]);
-
- }
- if(E->control.verbose){
- fprintf(E->trace.fpt,"Leaving lost_souls()\n");
- fflush(E->trace.fpt);
- }
-
- E->trace.lost_souls_time += CPU_time0() - begin_time;
- return;
-}
-
-
-static void full_put_lost_tracers(struct All_variables *E,
- int isend[13][13], double *send[13][13])
-{
- const int j = 1;
- int kk, pp;
- int numtracers, ithatcap, icheck;
- int isend_position, ipos;
- int lev = E->mesh.levmax;
- double theta, phi, rad;
- double x, y, z;
-
- /* transfer tracers from rlater to send */
-
- numtracers=E->trace.ilater[j];
-
- for (kk=1;kk<=numtracers;kk++) {
- rad=E->trace.rlater[j][2][kk];
- x=E->trace.rlater[j][3][kk];
- y=E->trace.rlater[j][4][kk];
- z=E->trace.rlater[j][5][kk];
-
- /* first check same cap if nprocz>1 */
-
- if (E->parallel.nprocz>1) {
- ithatcap=0;
- icheck=full_icheck_cap(E,ithatcap,x,y,z,rad);
- if (icheck==1) goto foundit;
-
- }
-
- /* check neighboring caps */
-
- for (pp=1;pp<=E->parallel.TNUM_PASS[lev][j];pp++) {
- ithatcap=pp;
- icheck=full_icheck_cap(E,ithatcap,x,y,z,rad);
- if (icheck==1) goto foundit;
- }
-
-
- /* should not be here */
- if (icheck!=1) {
- fprintf(E->trace.fpt,"Error(lost souls)-should not be here\n");
- fprintf(E->trace.fpt,"x: %f y: %f z: %f rad: %f\n",x,y,z,rad);
- icheck=full_icheck_cap(E,0,x,y,z,rad);
- if (icheck==1) fprintf(E->trace.fpt," icheck here!\n");
- else fprintf(E->trace.fpt,"icheck not here!\n");
- fflush(E->trace.fpt);
- exit(10);
- }
-
- foundit:
-
- isend[j][ithatcap]++;
-
- /* assign tracer to send */
-
- isend_position=(isend[j][ithatcap]-1)*E->trace.number_of_tracer_quantities;
-
- for (pp=0;pp<=(E->trace.number_of_tracer_quantities-1);pp++) {
- ipos=isend_position+pp;
- send[j][ithatcap][ipos]=E->trace.rlater[j][pp][kk];
- }
-
- } /* end kk, assigning tracers */
-
- return;
-}
-
-/************************ GET SHAPE FUNCTION *********************************/
-/* Real theta,phi,rad space is transformed into u,v space. This transformation */
-/* maps great circles into straight lines. Here, elements boundaries are */
-/* assumed to be great circle planes (not entirely true, it is actually only */
-/* the nodal arrangement that lies upon great circles). Element boundaries */
-/* are then mapped into planes. The element is then divided into 2 wedges */
-/* in which standard shape functions are used to interpolate velocity. */
-/* This transformation was found on the internet (refs were difficult to */
-/* to obtain). It was tested that nodal configuration is indeed transformed */
-/* into straight lines. */
-/* Radial and azimuthal shape functions are decoupled. First find the shape */
-/* functions associated with the 2D surface plane, then apply radial shape */
-/* functions. */
-/* */
-/* Wedge information: */
-/* */
-/* Wedge 1 Wedge 2 */
-/* _______ _______ */
-/* */
-/* wedge_node real_node wedge_node real_node */
-/* ---------- --------- ---------- --------- */
-/* */
-/* 1 1 1 1 */
-/* 2 2 2 3 */
-/* 3 3 3 4 */
-/* 4 5 4 5 */
-/* 5 6 5 7 */
-/* 6 7 6 8 */
-
-void full_get_shape_functions(struct All_variables *E,
- double shp[9], int nelem,
- double theta, double phi, double rad)
-{
- const int j = 1;
-
- int iwedge,inum;
- int i, kk;
- int ival;
- int itry;
-
- double u,v;
- double shape2d[4];
- double shaperad[3];
- double shape[7];
- double x,y,z;
-
- int maxlevel=E->mesh.levmax;
-
- const double eps=-1e-4;
-
- void sphere_to_cart();
-
-
- /* find u and v using spherical coordinates */
-
- spherical_to_uv(E,j,theta,phi,&u,&v);
-
- inum=0;
- itry=1;
-
- try_again:
-
- /* Check first wedge (1 of 2) */
-
- iwedge=1;
-
- next_wedge:
-
- /* determine shape functions of wedge */
- /* There are 3 shape functions for the triangular wedge */
-
- get_2dshape(E,j,nelem,u,v,iwedge,shape2d);
-
- /* if any shape functions are negative, goto next wedge */
-
- if (shape2d[1]<eps||shape2d[2]<eps||shape2d[3]<eps)
- {
- inum=inum+1;
- /* AKMA clean this up */
- if (inum>3)
- {
- fprintf(E->trace.fpt,"ERROR(gnomonic_interpolation)-inum>3!\n");
- fflush(E->trace.fpt);
- exit(10);
- }
- if (inum>1 && itry==1)
- {
- fprintf(E->trace.fpt,"ERROR(gnomonic_interpolation)-inum>1\n");
- fprintf(E->trace.fpt,"shape %f %f %f\n",shape2d[1],shape2d[2],shape2d[3]);
- fprintf(E->trace.fpt,"u %f v %f element: %d \n",u,v, nelem);
- fprintf(E->trace.fpt,"Element uv boundaries: \n");
- for(kk=1;kk<=4;kk++) {
- i = (E->ien[j][nelem].node[kk] - 1) / E->lmesh.noz + 1;
- fprintf(E->trace.fpt,"%d: U: %f V:%f\n",kk,E->gnomonic[i].u,E->gnomonic[i].v);
- }
- fprintf(E->trace.fpt,"theta: %f phi: %f rad: %f\n",theta,phi,rad);
- fprintf(E->trace.fpt,"Element theta-phi boundaries: \n");
- for(kk=1;kk<=4;kk++)
- fprintf(E->trace.fpt,"%d: Theta: %f Phi:%f\n",kk,E->sx[j][1][E->ien[j][nelem].node[kk]],E->sx[j][2][E->ien[j][nelem].node[kk]]);
- sphere_to_cart(E,theta,phi,rad,&x,&y,&z);
- ival=icheck_element(E,j,nelem,x,y,z,rad);
- fprintf(E->trace.fpt,"ICHECK?: %d\n",ival);
- ival=(E->trace.iget_element)(E,j,-99,x,y,z,theta,phi,rad);
- fprintf(E->trace.fpt,"New Element?: %d\n",ival);
- ival=icheck_column_neighbors(E,j,nelem,x,y,z,rad);
- fprintf(E->trace.fpt,"New Element (neighs)?: %d\n",ival);
- nelem=ival;
- ival=icheck_element(E,j,nelem,x,y,z,rad);
- fprintf(E->trace.fpt,"ICHECK?: %d\n",ival);
- itry++;
- if (ival>0) goto try_again;
- fprintf(E->trace.fpt,"NO LUCK\n");
- fflush(E->trace.fpt);
- exit(10);
- }
-
- iwedge=2;
- goto next_wedge;
- }
-
- /* Determine radial shape functions */
- /* There are 2 shape functions radially */
-
- get_radial_shape(E,j,nelem,rad,shaperad);
-
- /* There are 6 nodes to the solid wedge. */
- /* The 6 shape functions assocated with the 6 nodes */
- /* are products of radial and wedge shape functions. */
-
- /* Sum of shape functions is 1 */
-
- shp[0]=iwedge;
- shp[1]=shaperad[1]*shape2d[1];
- shp[2]=shaperad[1]*shape2d[2];
- shp[3]=shaperad[1]*shape2d[3];
- shp[4]=shaperad[2]*shape2d[1];
- shp[5]=shaperad[2]*shape2d[2];
- shp[6]=shaperad[2]*shape2d[3];
-
- /** debug **
- fprintf(E->trace.fpt, "shp: %e %e %e %e %e %e\n",
- shp[1], shp[2], shp[3], shp[4], shp[5], shp[6]);
- /**/
-
- return;
-}
-
-
-double full_interpolate_data(struct All_variables *E,
- double shp[9], double data[9])
-{
- int iwedge = shp[0];
-
- if (iwedge==1)
- return data[1]*shp[1] + data[2]*shp[2] + data[3]*shp[3]
- + data[5]*shp[4] + data[6]*shp[5] + data[7]*shp[6];
-
- if (iwedge==2)
- return data[1]*shp[1] + data[3]*shp[2] + data[4]*shp[3]
- + data[5]*shp[4] + data[7]*shp[5] + data[8]*shp[6];
-
- fprintf(stderr, "full_interpolate_data: shouldn't be here\n");
- exit(2);
-}
-
-
-/************************ GET VELOCITY ***************************************/
-/* */
-/* This function interpolates tracer velocity using gnominic interpolation. */
-/* The element is divided into 2 wedges in which standard shape functions */
-/* are used to interpolate velocity. */
-/* */
-/* Wedge information: */
-/* */
-/* Wedge 1 Wedge 2 */
-/* _______ _______ */
-/* */
-/* wedge_node real_node wedge_node real_node */
-/* ---------- --------- ---------- --------- */
-/* */
-/* 1 1 1 1 */
-/* 2 2 2 3 */
-/* 3 3 3 4 */
-/* 4 5 4 5 */
-/* 5 6 5 7 */
-/* 6 7 6 8 */
-
-void full_get_velocity(struct All_variables *E,
- int j, int nelem,
- double theta, double phi, double rad,
- double *velocity_vector)
-{
- int iwedge;
- const int sphere_key = 0;
-
- double shape[9];
- double VV[4][9];
- double vx[7],vy[7],vz[7];
-
- void velo_from_element_d();
-
- full_get_shape_functions(E, shape, nelem, theta, phi, rad);
- iwedge=shape[0];
-
- /* get cartesian velocity */
- velo_from_element_d(E, VV, j, nelem, sphere_key);
-
- /* depending on wedge, set up velocity points */
-
- if (iwedge==1)
- {
- vx[1]=VV[1][1];
- vx[2]=VV[1][2];
- vx[3]=VV[1][3];
- vx[4]=VV[1][5];
- vx[5]=VV[1][6];
- vx[6]=VV[1][7];
- vy[1]=VV[2][1];
- vy[2]=VV[2][2];
- vy[3]=VV[2][3];
- vy[4]=VV[2][5];
- vy[5]=VV[2][6];
- vy[6]=VV[2][7];
- vz[1]=VV[3][1];
- vz[2]=VV[3][2];
- vz[3]=VV[3][3];
- vz[4]=VV[3][5];
- vz[5]=VV[3][6];
- vz[6]=VV[3][7];
- }
- if (iwedge==2)
- {
- vx[1]=VV[1][1];
- vx[2]=VV[1][3];
- vx[3]=VV[1][4];
- vx[4]=VV[1][5];
- vx[5]=VV[1][7];
- vx[6]=VV[1][8];
- vy[1]=VV[2][1];
- vy[2]=VV[2][3];
- vy[3]=VV[2][4];
- vy[4]=VV[2][5];
- vy[5]=VV[2][7];
- vy[6]=VV[2][8];
- vz[1]=VV[3][1];
- vz[2]=VV[3][3];
- vz[3]=VV[3][4];
- vz[4]=VV[3][5];
- vz[5]=VV[3][7];
- vz[6]=VV[3][8];
- }
-
- velocity_vector[1]=vx[1]*shape[1]+vx[2]*shape[2]+shape[3]*vx[3]+
- vx[4]*shape[4]+vx[5]*shape[5]+shape[6]*vx[6];
- velocity_vector[2]=vy[1]*shape[1]+vy[2]*shape[2]+shape[3]*vy[3]+
- vy[4]*shape[4]+vy[5]*shape[5]+shape[6]*vy[6];
- velocity_vector[3]=vz[1]*shape[1]+vz[2]*shape[2]+shape[3]*vz[3]+
- vz[4]*shape[4]+vz[5]*shape[5]+shape[6]*vz[6];
-
-
-
- return;
-}
-
-/***************************************************************/
-/* GET 2DSHAPE */
-/* */
-/* This function determines shape functions at u,v */
-/* This method uses standard linear shape functions of */
-/* triangular elements. (See Cuvelier, Segal, and */
-/* van Steenhoven, 1986). */
-
-static void get_2dshape(struct All_variables *E,
- int j, int nelem,
- double u, double v,
- int iwedge, double * shape2d)
-{
-
- double a0,a1,a2;
- /* convert nelem to surface element number */
- int n = (nelem - 1) / E->lmesh.elz + 1;
-
- /* shape function 1 */
-
- a0=E->trace.shape_coefs[j][iwedge][1][n];
- a1=E->trace.shape_coefs[j][iwedge][2][n];
- a2=E->trace.shape_coefs[j][iwedge][3][n];
-
- shape2d[1]=a0+a1*u+a2*v;
-
- /* shape function 2 */
-
- a0=E->trace.shape_coefs[j][iwedge][4][n];
- a1=E->trace.shape_coefs[j][iwedge][5][n];
- a2=E->trace.shape_coefs[j][iwedge][6][n];
-
- shape2d[2]=a0+a1*u+a2*v;
-
- /* shape function 3 */
-
- a0=E->trace.shape_coefs[j][iwedge][7][n];
- a1=E->trace.shape_coefs[j][iwedge][8][n];
- a2=E->trace.shape_coefs[j][iwedge][9][n];
-
- shape2d[3]=a0+a1*u+a2*v;
-
- /** debug **
- fprintf(E->trace.fpt, "el=%d els=%d iwedge=%d shape=(%e %e %e)\n",
- nelem, n, iwedge, shape2d[1], shape2d[2], shape2d[3]);
- /**/
-
- return;
-}
-
-/***************************************************************/
-/* GET RADIAL SHAPE */
-/* */
-/* This function determines radial shape functions at rad */
-
-static void get_radial_shape(struct All_variables *E,
- int j, int nelem,
- double rad, double *shaperad)
-{
-
- int node1,node5;
- double rad1,rad5,f1,f2,delrad;
-
- const double eps=1e-6;
- double top_bound=1.0+eps;
- double bottom_bound=0.0-eps;
-
- node1=E->ien[j][nelem].node[1];
- node5=E->ien[j][nelem].node[5];
-
- rad1=E->sx[j][3][node1];
- rad5=E->sx[j][3][node5];
-
- delrad=rad5-rad1;
-
- f1=(rad-rad1)/delrad;
- f2=(rad5-rad)/delrad;
-
- /* Save a small amount of computation here */
- /* because f1+f2=1, shapes can be switched */
- /*
- shaperad[1]=1.0-f1=1.0-(1.0-f2)=f2;
- shaperad[2]=1.0-f2=1.0-(10-f1)=f1;
- */
-
- shaperad[1]=f2;
- shaperad[2]=f1;
-
- /* Some error control */
-
- if (shaperad[1]>(top_bound)||shaperad[1]<(bottom_bound)||
- shaperad[2]>(top_bound)||shaperad[2]<(bottom_bound))
- {
- fprintf(E->trace.fpt,"ERROR(get_radial_shape)\n");
- fprintf(E->trace.fpt,"shaperad[1]: %f \n",shaperad[1]);
- fprintf(E->trace.fpt,"shaperad[2]: %f \n",shaperad[2]);
- fflush(E->trace.fpt);
- exit(10);
- }
-
- return;
-}
-
-
-
-
-
-/**************************************************************/
-/* SPHERICAL TO UV */
-/* */
-/* This function transforms theta and phi to new coords */
-/* u and v using gnomonic projection. */
-
-static void spherical_to_uv(struct All_variables *E, int j,
- double theta, double phi,
- double *u, double *v)
-{
- double phi_f;
- double cosc;
- double cos_theta_f,sin_theta_f;
- double cost,sint,cosp2,sinp2;
-
- /* theta_f and phi_f are the reference points of the cap */
-
- phi_f = E->gnomonic_reference_phi;
-
- cos_theta_f = E->gnomonic[0].u;
- sin_theta_f = E->gnomonic[0].v;
-
- cost=cos(theta);
- /*
- sint=sin(theta);
- */
- sint=sqrt(1.0-cost*cost);
-
- cosp2=cos(phi-phi_f);
- sinp2=sin(phi-phi_f);
-
- cosc=cos_theta_f*cost+sin_theta_f*sint*cosp2;
- cosc=1.0/cosc;
-
- *u=sint*sinp2*cosc;
- *v=(sin_theta_f*cost-cos_theta_f*sint*cosp2)*cosc;
-
- /** debug **
- fprintf(E->trace.fpt, "(%e %e) -> (%e %e)\n",
- theta, phi, *u, *v);
- /**/
-
- return;
-}
-
-
-/*********** MAKE REGULAR GRID ********************************/
-/* */
-/* This function generates the finer regular grid which is */
-/* mapped to real elements */
-
-static void make_regular_grid(struct All_variables *E)
-{
-
- int j;
- int kk;
- int mm;
- int pp,node;
- int numtheta,numphi;
- int nodestheta,nodesphi;
- unsigned int numregel;
- unsigned int numregnodes;
- int idum1,idum2;
- int ifound_one;
- int ival;
- int ilast_el;
- int imap;
- int elz;
- int nelsurf;
- int iregnode[5];
- int ntheta,nphi;
- int ichoice;
- int icount;
- int itemp[5];
- int iregel;
- int istat_ichoice[13][5];
- int isum;
-
- double x,y,z;
- double theta,phi,rad;
- double deltheta;
- double delphi;
- double thetamax,thetamin;
- double phimax,phimin;
- double start_time;
- double theta_min,phi_min;
- double theta_max,phi_max;
- double half_diff;
- double expansion;
-
- double *tmin;
- double *tmax;
- double *fmin;
- double *fmax;
-
- void sphere_to_cart();
-
- const double two_pi=2.0*M_PI;
-
- elz=E->lmesh.elz;
-
- nelsurf=E->lmesh.elx*E->lmesh.ely;
-
- //TODO: find the bounding box of the mesh, if the box is too close to
- // to core, set a flag (rotated_reggrid) to true and rotate the
- // bounding box to the equator. Generate the regular grid with the new
- // bounding box. The rotation should be a simple one, e.g.
- // (theta, phi) -> (??)
- // Whenever the regular grid is used, check the flat (rotated_reggrid),
- // if true, rotate the checkpoint as well.
-
- /* note, mesh is rotated along theta 22.5 degrees divided by elx. */
- /* We at least want that much expansion here! Otherwise, theta min */
- /* will not be valid near poles. We do a little more (x2) to be safe */
- /* Typically 1-2 degrees. Look in nodal_mesh.c for this. */
-
- expansion=2.0*0.5*(M_PI/4.0)/(1.0*E->lmesh.elx);
-
- start_time=CPU_time0();
-
- if (E->parallel.me==0) fprintf(stderr,"Generating Regular Grid\n");
-
-
- /* for each cap, determine theta and phi bounds, watch out near poles */
-
- numregnodes=0;
- for(j=1;j<=E->sphere.caps_per_proc;j++)
- {
-
- thetamax=0.0;
- thetamin=M_PI;
-
- phimax=two_pi;
- phimin=0.0;
-
- for (kk=1;kk<=E->lmesh.nno;kk=kk+E->lmesh.noz)
- {
-
- theta=E->sx[j][1][kk];
- phi=E->sx[j][2][kk];
-
- thetamax=max(thetamax,theta);
- thetamin=min(thetamin,theta);
-
- }
-
- /* expand range slightly (should take care of poles) */
-
- thetamax=thetamax+expansion;
- thetamax=min(thetamax,M_PI);
-
- thetamin=thetamin-expansion;
- thetamin=max(thetamin,0.0);
-
- /* Convert input data from degrees to radians */
-
- deltheta=E->trace.deltheta[0]*M_PI/180.0;
- delphi=E->trace.delphi[0]*M_PI/180.0;
-
-
- /* Adjust deltheta and delphi to fit a uniform number of regular elements */
-
- numtheta=fabs(thetamax-thetamin)/deltheta;
- numphi=fabs(phimax-phimin)/delphi;
- nodestheta=numtheta+1;
- nodesphi=numphi+1;
- numregel=numtheta*numphi;
- numregnodes=nodestheta*nodesphi;
-
- if ((numtheta==0)||(numphi==0))
- {
- fprintf(E->trace.fpt,"Error(make_regular_grid): numtheta: %d numphi: %d\n",numtheta,numphi);
- fflush(E->trace.fpt);
- exit(10);
- }
-
- deltheta=fabs(thetamax-thetamin)/(1.0*numtheta);
- delphi=fabs(phimax-phimin)/(1.0*numphi);
-
- /* fill global variables */
-
- E->trace.deltheta[j]=deltheta;
- E->trace.delphi[j]=delphi;
- E->trace.numtheta[j]=numtheta;
- E->trace.numphi[j]=numphi;
- E->trace.thetamax[j]=thetamax;
- E->trace.thetamin[j]=thetamin;
- E->trace.phimax[j]=phimax;
- E->trace.phimin[j]=phimin;
- E->trace.numregel[j]=numregel;
- E->trace.numregnodes[j]=numregnodes;
-
- if ( ((1.0*numregel)/(1.0*E->lmesh.elx*E->lmesh.ely)) < 0.5 )
- {
- fprintf(E->trace.fpt,"\n ! WARNING: regular/real ratio low: %f ! \n",
- ((1.0*numregel)/(1.0*E->lmesh.nel)) );
- fprintf(E->trace.fpt," Should reduce size of regular mesh\n");
- fprintf(stderr,"! WARNING: regular/real ratio low: %f ! \n",
- ((1.0*numregel)/(1.0*E->lmesh.nel)) );
- fprintf(stderr," Should reduce size of regular mesh\n");
- fflush(E->trace.fpt);
- if (E->trace.itracer_warnings) exit(10);
- }
-
- /* print some output */
-
- fprintf(E->trace.fpt,"\nRegular grid:\n");
- fprintf(E->trace.fpt,"Theta min: %f max: %f \n",thetamin,thetamax);
- fprintf(E->trace.fpt,"Phi min: %f max: %f \n",phimin,phimax);
- fprintf(E->trace.fpt,"Adjusted deltheta: %f delphi: %f\n",deltheta,delphi);
- fprintf(E->trace.fpt,"(numtheta: %d numphi: %d)\n",numtheta,numphi);
- fprintf(E->trace.fpt,"Number of regular elements: %d (nodes: %d)\n",numregel,numregnodes);
-
- fprintf(E->trace.fpt,"regular/real ratio: %f\n",((1.0*numregel)/(1.0*E->lmesh.elx*E->lmesh.ely)));
- fflush(E->trace.fpt);
-
- /* Allocate memory for regnodetoel */
- /* Regtoel is an integer array which represents nodes on */
- /* the regular mesh. Each node on the regular mesh contains */
- /* the real element value if one exists (-99 otherwise) */
-
-
-
- if ((E->trace.regnodetoel[j]=(int *)malloc((numregnodes+1)*sizeof(int)))==NULL)
- {
- fprintf(E->trace.fpt,"ERROR(make regular) -no memory - uh3ud\n");
- fflush(E->trace.fpt);
- exit(10);
- }
-
-
- /* Initialize regnodetoel - reg elements not used =-99 */
-
- for (kk=1;kk<=numregnodes;kk++)
- {
- E->trace.regnodetoel[j][kk]=-99;
- }
-
- /* Begin Mapping (only need to use surface elements) */
-
- parallel_process_sync(E);
- if (E->parallel.me==0) fprintf(stderr,"Beginning Mapping\n");
-
- /* Generate temporary arrays of max and min values for each surface element */
-
-
- if ((tmin=(double *)malloc((nelsurf+1)*sizeof(double)))==NULL)
- {
- fprintf(E->trace.fpt,"ERROR(make regular) -no memory - 7t1a\n");
- fflush(E->trace.fpt);
- exit(10);
- }
- if ((tmax=(double *)malloc((nelsurf+1)*sizeof(double)))==NULL)
- {
- fprintf(E->trace.fpt,"ERROR(make regular) -no memory - 7t1a\n");
- fflush(E->trace.fpt);
- exit(10);
- }
- if ((fmin=(double *)malloc((nelsurf+1)*sizeof(double)))==NULL)
- {
- fprintf(E->trace.fpt,"ERROR(make regular) -no memory - 7t1a\n");
- fflush(E->trace.fpt);
- exit(10);
- }
- if ((fmax=(double *)malloc((nelsurf+1)*sizeof(double)))==NULL)
- {
- fprintf(E->trace.fpt,"ERROR(make regular) -no memory - 7t1a\n");
- fflush(E->trace.fpt);
- exit(10);
- }
-
- for (mm=elz;mm<=E->lmesh.nel;mm=mm+elz)
- {
-
- kk=mm/elz;
-
- theta_min=M_PI;
- theta_max=0.0;
- phi_min=two_pi;
- phi_max=0.0;
- for (pp=1;pp<=4;pp++)
- {
- node=E->ien[j][mm].node[pp];
- theta=E->sx[j][1][node];
- phi=E->sx[j][2][node];
-
- theta_min=min(theta_min,theta);
- theta_max=max(theta_max,theta);
- phi_min=min(phi_min,phi);
- phi_max=max(phi_max,phi);
- }
-
- /* add half difference to phi and expansion to theta to be safe */
-
- theta_max=theta_max+expansion;
- theta_min=theta_min-expansion;
-
- theta_max=min(M_PI,theta_max);
- theta_min=max(0.0,theta_min);
-
- half_diff=0.5*(phi_max-phi_min);
- phi_max=phi_max+half_diff;
- phi_min=phi_min-half_diff;
-
- fix_angle(&phi_max);
- fix_angle(&phi_min);
-
- if (phi_min>phi_max)
- {
- phi_min=0.0;
- phi_max=two_pi;
- }
-
- tmin[kk]=theta_min;
- tmax[kk]=theta_max;
- fmin[kk]=phi_min;
- fmax[kk]=phi_max;
- }
-
- /* end looking through elements */
-
- ifound_one=0;
-
- rad=E->sphere.ro;
-
- imap=0;
-
- for (kk=1;kk<=numregnodes;kk++)
- {
-
- E->trace.regnodetoel[j][kk]=-99;
-
- /* find theta and phi for a given regular node */
-
- idum1=(kk-1)/(numtheta+1);
- idum2=kk-1-idum1*(numtheta+1);
-
- theta=thetamin+(1.0*idum2*deltheta);
- phi=phimin+(1.0*idum1*delphi);
-
- sphere_to_cart(E,theta,phi,rad,&x,&y,&z);
-
-
- ilast_el=1;
-
- /* if previous element not found yet, check all surface elements */
-
- /*
- if (ifound_one==0)
- {
- for (mm=elz;mm<=E->lmesh.nel;mm=mm+elz)
- {
- pp=mm/elz;
- if ( (theta>=tmin[pp]) && (theta<=tmax[pp]) && (phi>=fmin[pp]) && (phi<=fmax[pp]) )
- {
- ival=icheck_element_column(E,j,mm,x,y,z,rad);
- if (ival>0)
- {
- ilast_el=mm;
- ifound_one++;
- E->trace.regnodetoel[j][kk]=mm;
- goto foundit;
- }
- }
- }
- goto foundit;
- }
- */
-
- /* first check previous element */
-
- ival=icheck_element_column(E,j,ilast_el,x,y,z,rad);
- if (ival>0)
- {
- E->trace.regnodetoel[j][kk]=ilast_el;
- goto foundit;
- }
-
- /* check neighbors */
-
- ival=icheck_column_neighbors(E,j,ilast_el,x,y,z,rad);
- if (ival>0)
- {
- E->trace.regnodetoel[j][kk]=ival;
- ilast_el=ival;
- goto foundit;
- }
-
- /* check all */
-
- for (mm=elz;mm<=E->lmesh.nel;mm=mm+elz)
- {
- pp=mm/elz;
- if ( (theta>=tmin[pp]) && (theta<=tmax[pp]) && (phi>=fmin[pp]) && (phi<=fmax[pp]) )
- {
- ival=icheck_element_column(E,j,mm,x,y,z,rad);
- if (ival>0)
- {
- ilast_el=mm;
- E->trace.regnodetoel[j][kk]=mm;
- goto foundit;
- }
- }
- }
-
- foundit:
-
- if (E->trace.regnodetoel[j][kk]>0) imap++;
-
- } /* end all regular nodes (kk) */
-
- fprintf(E->trace.fpt,"percentage mapped: %f\n", (1.0*imap)/(1.0*numregnodes)*100.0);
- fflush(E->trace.fpt);
-
- /* free temporary arrays */
-
- free(tmin);
- free(tmax);
- free(fmin);
- free(fmax);
-
- } /* end j */
-
-
- /* some error control */
-
- for (j=1;j<=E->sphere.caps_per_proc;j++)
- {
- for (kk=1;kk<=numregnodes;kk++)
- {
-
- if (E->trace.regnodetoel[j][kk]!=-99)
- {
- if ( (E->trace.regnodetoel[j][kk]<1)||(E->trace.regnodetoel[j][kk]>E->lmesh.nel) )
- {
- fprintf(stderr,"Error(make_regular_grid)-invalid element: %d\n",E->trace.regnodetoel[j][kk]);
- fprintf(E->trace.fpt,"Error(make_regular_grid)-invalid element: %d\n",E->trace.regnodetoel[j][kk]);
- fflush(E->trace.fpt);
- fflush(stderr);
- exit(10);
- }
- }
- }
- }
-
-
- /* Now put regnodetoel information into regtoel */
-
-
- if (E->parallel.me==0) fprintf(stderr,"Beginning Regtoel submapping \n");
-
- /* AKMA decided it would be more efficient to have reg element choice array */
- /* rather than reg node array as used before */
-
-
- for(j=1;j<=E->sphere.caps_per_proc;j++)
- {
-
- /* initialize statistical counter */
-
- for (pp=0;pp<=4;pp++) istat_ichoice[j][pp]=0;
-
- /* Allocate memory for regtoel */
- /* Regtoel consists of 4 positions for each regular element */
- /* Position[0] lists the number of element choices (later */
- /* referred to as ichoice), followed */
- /* by the possible element choices. */
- /* ex.) A regular element has 4 nodes. Each node resides in */
- /* a real element. The number of real elements a regular */
- /* element touches (one of its nodes are in) is ichoice. */
- /* Special ichoice notes: */
- /* ichoice=-1 all regular element nodes = -99 (no elements) */
- /* ichoice=0 all 4 corners within one element */
- /* ichoice=1 one element choice (diff from ichoice 0 in */
- /* that perhaps one reg node is in an element */
- /* and the rest are not (-99). */
- /* ichoice>1 Multiple elements to check */
-
- numregel= E->trace.numregel[j];
-
- for (pp=0;pp<=4;pp++)
- {
- if ((E->trace.regtoel[j][pp]=(int *)malloc((numregel+1)*sizeof(int)))==NULL)
- {
- fprintf(E->trace.fpt,"ERROR(make regular)-no memory 98d (%d %d %d)\n",pp,numregel,j);
- fflush(E->trace.fpt);
- exit(10);
- }
- }
-
- numtheta=E->trace.numtheta[j];
- numphi=E->trace.numphi[j];
-
- for (nphi=1;nphi<=numphi;nphi++)
- {
- for (ntheta=1;ntheta<=numtheta;ntheta++)
- {
-
- iregel=ntheta+(nphi-1)*numtheta;
-
- /* initialize regtoel (not necessary really) */
-
- for (pp=0;pp<=4;pp++) E->trace.regtoel[j][pp][iregel]=-33;
-
- if ( (iregel>numregel)||(iregel<1) )
- {
- fprintf(E->trace.fpt,"ERROR(make_regular_grid)-weird iregel: %d (max: %d)\n",iregel,numregel);
- fflush(E->trace.fpt);
- exit(10);
- }
-
- iregnode[1]=iregel+(nphi-1);
- iregnode[2]=iregel+nphi;
- iregnode[3]=iregel+nphi+E->trace.numtheta[j]+1;
- iregnode[4]=iregel+nphi+E->trace.numtheta[j];
-
- for (kk=1;kk<=4;kk++)
- {
- if ((iregnode[kk]<1)||(iregnode[kk]>numregnodes))
- {
- fprintf(E->trace.fpt,"ERROR(make regular)-bad regnode %d\n",iregnode[kk]);
- fflush(E->trace.fpt);
- exit(10);
- }
- if (E->trace.regnodetoel[j][iregnode[kk]]>E->lmesh.nel)
- {
- fprintf(E->trace.fpt,"AABB HERE %d %d %d %d\n",iregel,iregnode[kk],kk,E->trace.regnodetoel[j][iregnode[kk]]);
- fflush(E->trace.fpt);
- }
- }
-
-
- /* find number of choices */
-
- ichoice=0;
- icount=0;
-
- for (kk=1;kk<=4;kk++)
- {
-
- if (E->trace.regnodetoel[j][iregnode[kk]]<=0) goto next_corner;
-
- icount++;
- for (pp=1;pp<=(kk-1);pp++)
- {
- if (E->trace.regnodetoel[j][iregnode[kk]]==E->trace.regnodetoel[j][iregnode[pp]]) goto next_corner;
- }
- ichoice++;
- itemp[ichoice]=E->trace.regnodetoel[j][iregnode[kk]];
-
- if ((ichoice<0) || (ichoice>4) )
- {
- fprintf(E->trace.fpt,"ERROR(make regular) - weird ichoice %d \n",ichoice);
- fflush(E->trace.fpt);
- exit(10);
- }
- if ((itemp[ichoice]<0) || (itemp[ichoice]>E->lmesh.nel) )
- {
- fprintf(E->trace.fpt,"ERROR(make regular) - weird element choice %d %d\n",itemp[ichoice],ichoice);
- fflush(E->trace.fpt);
- exit(10);
- }
-
- next_corner:
- ;
- } /* end kk */
-
- istat_ichoice[j][ichoice]++;
-
- if ((ichoice<0) || (ichoice>4))
- {
- fprintf(E->trace.fpt,"ERROR(make_regular)-wierd ichoice %d\n",ichoice);
- fflush(E->trace.fpt);
- exit(10);
- }
-
- if (ichoice==0)
- {
- E->trace.regtoel[j][0][iregel]=-1;
- /*
- fprintf(E->trace.fpt,"HH1: (%p) iregel: %d ichoice: %d value: %d %d\n",&E->trace.regtoel[j][1][iregel],iregel,ichoice,E->trace.regtoel[j][0][iregel],E->trace.regtoel[j][1][iregel]);
- */
- }
- else if ( (ichoice==1) && (icount==4) )
- {
- E->trace.regtoel[j][0][iregel]=0;
- E->trace.regtoel[j][1][iregel]=itemp[1];
-
- /*
- fprintf(E->trace.fpt,"HH2: (%p) iregel: %d ichoice: %d value: %d %d\n",&E->trace.regtoel[j][1][iregel],iregel,ichoice,E->trace.regtoel[j][0][iregel],E->trace.regtoel[j][1][iregel]);
- */
-
- if (itemp[1]<1 || itemp[1]>E->lmesh.nel)
- {
- fprintf(E->trace.fpt,"ERROR(make_regular)-huh? wierd itemp\n");
- fflush(E->trace.fpt);
- exit(10);
- }
- }
- else if ( (ichoice>0) && (ichoice<5) )
- {
- E->trace.regtoel[j][0][iregel]=ichoice;
- for (pp=1;pp<=ichoice;pp++)
- {
- E->trace.regtoel[j][pp][iregel]=itemp[pp];
-
- /*
- fprintf(E->trace.fpt,"HH:(%p) iregel: %d ichoice: %d pp: %d value: %d %d\n",&E->trace.regtoel[j][pp][iregel],iregel,ichoice,pp,itemp[pp],E->trace.regtoel[j][pp][iregel]);
- */
- if (itemp[pp]<1 || itemp[pp]>E->lmesh.nel)
- {
- fprintf(E->trace.fpt,"ERROR(make_regular)-huh? wierd itemp 2 \n");
- fflush(E->trace.fpt);
- exit(10);
- }
- }
- }
- else
- {
- fprintf(E->trace.fpt,"ERROR(make_regular)- should not be here! %d\n",ichoice);
- fflush(E->trace.fpt);
- exit(10);
- }
- }
- }
-
- /* can now free regnodetoel */
-
- free (E->trace.regnodetoel[j]);
-
-
- /* testing */
- for (kk=1;kk<=E->trace.numregel[j];kk++)
- {
- if ((E->trace.regtoel[j][0][kk]<-1)||(E->trace.regtoel[j][0][kk]>4))
- {
- fprintf(E->trace.fpt,"ERROR(make regular) regtoel ichoice0? %d %d \n",kk,E->trace.regtoel[j][pp][kk]);
- fflush(E->trace.fpt);
- exit(10);
- }
- for (pp=1;pp<=4;pp++)
- {
- if (((E->trace.regtoel[j][pp][kk]<1)&&(E->trace.regtoel[j][pp][kk]!=-33))||(E->trace.regtoel[j][pp][kk]>E->lmesh.nel))
- {
- fprintf(E->trace.fpt,"ERROR(make regular) (%p) regtoel? %d %d(%d) %d\n",&E->trace.regtoel[j][pp][kk],kk,pp,E->trace.regtoel[j][0][kk],E->trace.regtoel[j][pp][kk]);
- fflush(E->trace.fpt);
- exit(10);
- }
- }
- }
-
- } /* end j */
-
-
- fprintf(E->trace.fpt,"Mapping completed (%f seconds)\n",CPU_time0()-start_time);
- fflush(E->trace.fpt);
-
- parallel_process_sync(E);
-
- if (E->parallel.me==0) fprintf(stderr,"Mapping completed (%f seconds)\n",CPU_time0()-start_time);
-
- /* Print out information regarding regular/real element coverage */
-
- for (j=1;j<=E->sphere.caps_per_proc;j++)
- {
-
- isum=0;
- for (kk=0;kk<=4;kk++) isum=isum+istat_ichoice[j][kk];
- fprintf(E->trace.fpt,"\n\nInformation regarding number of real elements per regular elements\n");
- fprintf(E->trace.fpt," (stats done on regular elements that were used)\n");
- fprintf(E->trace.fpt,"Ichoice is number of real elements touched by a regular element\n");
- fprintf(E->trace.fpt," (ichoice=0 is optimal)\n");
- fprintf(E->trace.fpt,"Ichoice=0: %f percent\n",(100.0*istat_ichoice[j][0])/(1.0*isum));
- fprintf(E->trace.fpt,"Ichoice=1: %f percent\n",(100.0*istat_ichoice[j][1])/(1.0*isum));
- fprintf(E->trace.fpt,"Ichoice=2: %f percent\n",(100.0*istat_ichoice[j][2])/(1.0*isum));
- fprintf(E->trace.fpt,"Ichoice=3: %f percent\n",(100.0*istat_ichoice[j][3])/(1.0*isum));
- fprintf(E->trace.fpt,"Ichoice=4: %f percent\n",(100.0*istat_ichoice[j][4])/(1.0*isum));
-
- } /* end j */
-
-
- return;
-}
-
-
-/**** WRITE TRACE INSTRUCTIONS ***************/
-static void write_trace_instructions(struct All_variables *E)
-{
- int i;
-
- fprintf(E->trace.fpt,"\nTracing Activated! (proc: %d)\n",E->parallel.me);
- fprintf(E->trace.fpt," Allen K. McNamara 12-2003\n\n");
-
- if (E->trace.ic_method==0)
- {
- fprintf(E->trace.fpt,"Generating New Tracer Array\n");
- fprintf(E->trace.fpt,"Tracers per element: %d\n",E->trace.itperel);
- }
- if (E->trace.ic_method==1)
- {
- fprintf(E->trace.fpt,"Reading tracer file %s\n",E->trace.tracer_file);
- }
- if (E->trace.ic_method==2)
- {
- fprintf(E->trace.fpt,"Reading individual tracer files\n");
- }
-
- fprintf(E->trace.fpt,"Number of tracer flavors: %d\n", E->trace.nflavors);
-
- if (E->trace.nflavors && E->trace.ic_method==0) {
- fprintf(E->trace.fpt,"Initialized tracer flavors by: %d\n", E->trace.ic_method_for_flavors);
- if (E->trace.ic_method_for_flavors == 0) {
- fprintf(E->trace.fpt,"Layered tracer flavors\n");
- for (i=0; i<E->trace.nflavors-1; i++)
- fprintf(E->trace.fpt,"Interface Height: %d %f\n",i,E->trace.z_interface[i]);
- }
-#ifdef USE_GGRD
- else if(E->trace.ic_method_for_flavors == 1) {
- fprintf(E->trace.fpt,"netcdf grd assigned tracer flavors\n");
- fprintf(E->trace.fpt,"file: %s top %i layeres\n",E->trace.ggrd_file,
- E->trace.ggrd_layers);
- }
-#endif
- else {
- fprintf(E->trace.fpt,"Sorry-This IC methods for Flavors are Unavailable %d\n",E->trace.ic_method_for_flavors);
- fflush(E->trace.fpt);
- parallel_process_termination();
- }
- }
-
- for (i=0; i<E->trace.nflavors-2; i++) {
- if (E->trace.z_interface[i] < E->trace.z_interface[i+1]) {
- fprintf(E->trace.fpt,"Sorry - The %d-th z_interface is smaller than the next one.\n", i);
- fflush(E->trace.fpt);
- parallel_process_termination();
- }
- }
-
-
-
- /* regular grid stuff */
-
- fprintf(E->trace.fpt,"Regular Grid-> deltheta: %f delphi: %f\n",
- E->trace.deltheta[0],E->trace.delphi[0]);
-
-
-
-
- /* more obscure stuff */
-
- fprintf(E->trace.fpt,"Box Cushion: %f\n",E->trace.box_cushion);
- fprintf(E->trace.fpt,"Number of Basic Quantities: %d\n",
- E->trace.number_of_basic_quantities);
- fprintf(E->trace.fpt,"Number of Extra Quantities: %d\n",
- E->trace.number_of_extra_quantities);
- fprintf(E->trace.fpt,"Total Number of Tracer Quantities: %d\n",
- E->trace.number_of_tracer_quantities);
-
-
- /* analytical test */
-
- if (E->trace.ianalytical_tracer_test==1)
- {
- fprintf(E->trace.fpt,"\n\n ! Analytical Test Being Performed ! \n");
- fprintf(E->trace.fpt,"(some of the above parameters may not be used or applied\n");
- fprintf(E->trace.fpt,"Velocity functions given in main code\n");
- fflush(E->trace.fpt);
- }
-
- if (E->trace.itracer_warnings==0)
- {
- fprintf(E->trace.fpt,"\n WARNING EXITS ARE TURNED OFF! TURN THEM ON!\n");
- fprintf(stderr,"\n WARNING EXITS ARE TURNED OFF! TURN THEM ON!\n");
- fflush(E->trace.fpt);
- }
-
- write_composition_instructions(E);
- return;
-}
-
-
-/********* ICHECK COLUMN NEIGHBORS ***************************/
-/* */
-/* This function check whether a point is in a neighboring */
-/* column. Neighbor surface element number is returned */
-
-static int icheck_column_neighbors(struct All_variables *E,
- int j, int nel,
- double x, double y, double z,
- double rad)
-{
-
- int ival;
- int neighbor[25];
- int elx,ely,elz;
- int elxz;
- int kk;
-
- /*
- const int number_of_neighbors=24;
- */
-
- /* maybe faster to only check inner ring */
-
- const int number_of_neighbors=8;
-
- elx=E->lmesh.elx;
- ely=E->lmesh.ely;
- elz=E->lmesh.elz;
-
- elxz=elx*elz;
-
- /* inner ring */
-
- neighbor[1]=nel-elxz-elz;
- neighbor[2]=nel-elxz;
- neighbor[3]=nel-elxz+elz;
- neighbor[4]=nel-elz;
- neighbor[5]=nel+elz;
- neighbor[6]=nel+elxz-elz;
- neighbor[7]=nel+elxz;
- neighbor[8]=nel+elxz+elz;
-
- /* outer ring */
-
- neighbor[9]=nel+2*elxz-elz;
- neighbor[10]=nel+2*elxz;
- neighbor[11]=nel+2*elxz+elz;
- neighbor[12]=nel+2*elxz+2*elz;
- neighbor[13]=nel+elxz+2*elz;
- neighbor[14]=nel+2*elz;
- neighbor[15]=nel-elxz+2*elz;
- neighbor[16]=nel-2*elxz+2*elz;
- neighbor[17]=nel-2*elxz+elz;
- neighbor[18]=nel-2*elxz;
- neighbor[19]=nel-2*elxz-elz;
- neighbor[20]=nel-2*elxz-2*elz;
- neighbor[21]=nel-elxz-2*elz;
- neighbor[22]=nel-2*elz;
- neighbor[23]=nel+elxz-2*elz;
- neighbor[24]=nel+2*elxz-2*elz;
-
-
- for (kk=1;kk<=number_of_neighbors;kk++)
- {
-
- if ((neighbor[kk]>=1)&&(neighbor[kk]<=E->lmesh.nel))
- {
- ival=icheck_element_column(E,j,neighbor[kk],x,y,z,rad);
- if (ival>0)
- {
- return neighbor[kk];
- }
- }
- }
-
- return -99;
-}
-
-
-/********** ICHECK ALL COLUMNS ********************************/
-/* */
-/* This function check all columns until the proper one for */
-/* a point (x,y,z) is found. The surface element is returned */
-/* else -99 if can't be found. */
-
-static int icheck_all_columns(struct All_variables *E,
- int j,
- double x, double y, double z,
- double rad)
-{
-
- int icheck;
- int nel;
-
- int elz=E->lmesh.elz;
- int numel=E->lmesh.nel;
-
- for (nel=elz;nel<=numel;nel=nel+elz)
- {
- icheck=icheck_element_column(E,j,nel,x,y,z,rad);
- if (icheck==1)
- {
- return nel;
- }
- }
-
-
- return -99;
-}
-
-
-/******* ICHECK ELEMENT *************************************/
-/* */
-/* This function serves to determine if a point lies within */
-/* a given element */
-
-static int icheck_element(struct All_variables *E,
- int j, int nel,
- double x, double y, double z,
- double rad)
-{
-
- int icheck;
-
- icheck=icheck_shell(E,nel,rad);
- if (icheck==0)
- {
- return 0;
- }
-
- icheck=icheck_element_column(E,j,nel,x,y,z,rad);
- if (icheck==0)
- {
- return 0;
- }
-
-
- return 1;
-}
-
-
-/******** ICHECK SHELL ************************************/
-/* */
-/* This function serves to check whether a point lies */
-/* within the proper radial shell of a given element */
-/* note: j set to 1; shouldn't depend on cap */
-
-static int icheck_shell(struct All_variables *E,
- int nel, double rad)
-{
-
- int ival;
- int ibottom_node;
- int itop_node;
-
- double bottom_rad;
- double top_rad;
-
-
- ibottom_node=E->ien[1][nel].node[1];
- itop_node=E->ien[1][nel].node[5];
-
- bottom_rad=E->sx[1][3][ibottom_node];
- top_rad=E->sx[1][3][itop_node];
-
- ival=0;
- if ((rad>=bottom_rad)&&(rad<top_rad)) ival=1;
-
- return ival;
-}
-
-/******** ICHECK ELEMENT COLUMN ****************************/
-/* */
-/* This function serves to determine if a point lies within */
-/* a given element's column */
-
-static int icheck_element_column(struct All_variables *E,
- int j, int nel,
- double x, double y, double z,
- double rad)
-{
-
- double test_point[4];
- double rnode[5][10];
-
- int lev = E->mesh.levmax;
- int ival;
- int kk;
- int node;
-
-
- E->trace.istat_elements_checked++;
-
- /* surface coords of element nodes */
-
- for (kk=1;kk<=4;kk++)
- {
-
- node=E->ien[j][nel].node[kk+4];
-
- rnode[kk][1]=E->x[j][1][node];
- rnode[kk][2]=E->x[j][2][node];
- rnode[kk][3]=E->x[j][3][node];
-
- rnode[kk][4]=E->sx[j][1][node];
- rnode[kk][5]=E->sx[j][2][node];
-
- rnode[kk][6]=E->SinCos[lev][j][2][node]; /* cos(theta) */
- rnode[kk][7]=E->SinCos[lev][j][0][node]; /* sin(theta) */
- rnode[kk][8]=E->SinCos[lev][j][3][node]; /* cos(phi) */
- rnode[kk][9]=E->SinCos[lev][j][1][node]; /* sin(phi) */
-
- }
-
- /* test_point - project to outer radius */
-
- test_point[1]=x/rad;
- test_point[2]=y/rad;
- test_point[3]=z/rad;
-
- ival=icheck_bounds(E,test_point,rnode[1],rnode[2],rnode[3],rnode[4]);
-
-
- return ival;
-}
-
-
-/********* ICHECK CAP ***************************************/
-/* */
-/* This function serves to determine if a point lies within */
-/* a given cap */
-/* */
-int full_icheck_cap(struct All_variables *E, int icap,
- double x, double y, double z, double rad)
-{
-
- double test_point[4];
- double rnode[5][10];
-
- int ival;
- int kk;
-
- /* surface coords of cap nodes */
-
-
- for (kk=1;kk<=4;kk++)
- {
-
- rnode[kk][1]=E->trace.xcap[icap][kk];
- rnode[kk][2]=E->trace.ycap[icap][kk];
- rnode[kk][3]=E->trace.zcap[icap][kk];
- rnode[kk][4]=E->trace.theta_cap[icap][kk];
- rnode[kk][5]=E->trace.phi_cap[icap][kk];
- rnode[kk][6]=E->trace.cos_theta[icap][kk];
- rnode[kk][7]=E->trace.sin_theta[icap][kk];
- rnode[kk][8]=E->trace.cos_phi[icap][kk];
- rnode[kk][9]=E->trace.sin_phi[icap][kk];
- }
-
-
- /* test_point - project to outer radius */
-
- test_point[1]=x/rad;
- test_point[2]=y/rad;
- test_point[3]=z/rad;
-
- ival=icheck_bounds(E,test_point,rnode[1],rnode[2],rnode[3],rnode[4]);
-
-
- return ival;
-}
-
-/***** ICHECK BOUNDS ******************************/
-/* */
-/* This function check if a test_point is bounded */
-/* by 4 nodes */
-/* This is done by: */
-/* 1) generate vectors from node to node */
-/* 2) generate vectors from each node to point */
-/* in question */
-/* 3) for each node, take cross product of vector */
-/* pointing to it from previous node and */
-/* vector from node to point in question */
-/* 4) Find radial components of all the cross */
-/* products. */
-/* 5) If all radial components are positive, */
-/* point is bounded by the 4 nodes */
-/* 6) If some radial components are negative */
-/* point is on a boundary - adjust it an */
-/* epsilon amount for this analysis only */
-/* which will force it to lie in one element */
-/* or cap */
-
-static int icheck_bounds(struct All_variables *E,
- double *test_point,
- double *rnode1, double *rnode2,
- double *rnode3, double *rnode4)
-{
-
- int number_of_tries=0;
- int icheck;
-
- double v12[4];
- double v23[4];
- double v34[4];
- double v41[4];
- double v1p[4];
- double v2p[4];
- double v3p[4];
- double v4p[4];
- double cross1[4];
- double cross2[4];
- double cross3[4];
- double cross4[4];
- double rad1,rad2,rad3,rad4;
- double theta, phi;
- double tiny, eps;
- double x,y,z;
-
- double myatan();
-
- /* make vectors from node to node */
-
- makevector(v12,rnode2[1],rnode2[2],rnode2[3],rnode1[1],rnode1[2],rnode1[3]);
- makevector(v23,rnode3[1],rnode3[2],rnode3[3],rnode2[1],rnode2[2],rnode2[3]);
- makevector(v34,rnode4[1],rnode4[2],rnode4[3],rnode3[1],rnode3[2],rnode3[3]);
- makevector(v41,rnode1[1],rnode1[2],rnode1[3],rnode4[1],rnode4[2],rnode4[3]);
-
- try_again:
-
- number_of_tries++;
-
- /* make vectors from test point to node */
-
- makevector(v1p,test_point[1],test_point[2],test_point[3],rnode1[1],rnode1[2],rnode1[3]);
- makevector(v2p,test_point[1],test_point[2],test_point[3],rnode2[1],rnode2[2],rnode2[3]);
- makevector(v3p,test_point[1],test_point[2],test_point[3],rnode3[1],rnode3[2],rnode3[3]);
- makevector(v4p,test_point[1],test_point[2],test_point[3],rnode4[1],rnode4[2],rnode4[3]);
-
- /* Calculate cross products */
-
- crossit(cross2,v12,v2p);
- crossit(cross3,v23,v3p);
- crossit(cross4,v34,v4p);
- crossit(cross1,v41,v1p);
-
- /* Calculate radial component of cross products */
-
- rad1=findradial(E,cross1,rnode1[6],rnode1[7],rnode1[8],rnode1[9]);
- rad2=findradial(E,cross2,rnode2[6],rnode2[7],rnode2[8],rnode2[9]);
- rad3=findradial(E,cross3,rnode3[6],rnode3[7],rnode3[8],rnode3[9]);
- rad4=findradial(E,cross4,rnode4[6],rnode4[7],rnode4[8],rnode4[9]);
-
- /* Check if any radial components is zero (along a boundary), adjust if so */
- /* Hopefully, this doesn't happen often, may be expensive */
-
- tiny=1e-15;
- eps=1e-6;
-
- if (number_of_tries>3)
- {
- fprintf(E->trace.fpt,"Error(icheck_bounds)-too many tries\n");
- fprintf(E->trace.fpt,"Rads: %f %f %f %f\n",rad1,rad2,rad3,rad4);
- fprintf(E->trace.fpt,"Test Point: %f %f %f \n",test_point[1],test_point[2],test_point[3]);
- fprintf(E->trace.fpt,"Nodal points: 1: %f %f %f\n",rnode1[1],rnode1[2],rnode1[3]);
- fprintf(E->trace.fpt,"Nodal points: 2: %f %f %f\n",rnode2[1],rnode2[2],rnode2[3]);
- fprintf(E->trace.fpt,"Nodal points: 3: %f %f %f\n",rnode3[1],rnode3[2],rnode3[3]);
- fprintf(E->trace.fpt,"Nodal points: 4: %f %f %f\n",rnode4[1],rnode4[2],rnode4[3]);
- fflush(E->trace.fpt);
- exit(10);
- }
-
- if (fabs(rad1)<=tiny||fabs(rad2)<=tiny||fabs(rad3)<=tiny||fabs(rad4)<=tiny)
- {
- x=test_point[1];
- y=test_point[2];
- z=test_point[3];
- theta=myatan(sqrt(x*x+y*y),z);
- phi=myatan(y,x);
-
- if (theta<=M_PI/2.0)
- {
- theta=theta+eps;
- }
- else
- {
- theta=theta-eps;
- }
- phi=phi+eps;
- x=sin(theta)*cos(phi);
- y=sin(theta)*sin(phi);
- z=cos(theta);
- test_point[1]=x;
- test_point[2]=y;
- test_point[3]=z;
-
- number_of_tries++;
- goto try_again;
-
- }
-
- icheck=0;
- if (rad1>0.0&&rad2>0.0&&rad3>0.0&&rad4>0.0) icheck=1;
-
- /*
- fprintf(stderr,"%d: icheck: %d\n",E->parallel.me,icheck);
- fprintf(stderr,"%d: rads: %f %f %f %f\n",E->parallel.me,rad1,rad2,rad3,rad4);
- */
-
- return icheck;
-
-}
-
-/****************************************************************************/
-/* FINDRADIAL */
-/* */
-/* This function finds the radial component of a Cartesian vector */
-
-static double findradial(struct All_variables *E, double *vec,
- double cost, double sint,
- double cosf, double sinf)
-{
- double radialparti,radialpartj,radialpartk;
- double radial;
-
- radialparti=vec[1]*sint*cosf;
- radialpartj=vec[2]*sint*sinf;
- radialpartk=vec[3]*cost;
-
- radial=radialparti+radialpartj+radialpartk;
-
-
- return radial;
-}
-
-
-/******************MAKEVECTOR*********************************************************/
-
-static void makevector(double *vec, double xf, double yf, double zf,
- double x0, double y0, double z0)
-{
-
- vec[1]=xf-x0;
- vec[2]=yf-y0;
- vec[3]=zf-z0;
-
-
- return;
-}
-
-/********************CROSSIT********************************************************/
-
-static void crossit(double *cross, double *A, double *B)
-{
-
- cross[1]=A[2]*B[3]-A[3]*B[2];
- cross[2]=A[3]*B[1]-A[1]*B[3];
- cross[3]=A[1]*B[2]-A[2]*B[1];
-
-
- return;
-}
-
-
-/************ FIX RADIUS ********************************************/
-/* This function moves particles back in bounds if they left */
-/* during advection */
-
-static void fix_radius(struct All_variables *E,
- double *radius, double *theta, double *phi,
- double *x, double *y, double *z)
-{
- double sint,cost,sinf,cosf,rad;
- double max_radius, min_radius;
-
- max_radius = E->sphere.ro - E->trace.box_cushion;
- min_radius = E->sphere.ri + E->trace.box_cushion;
-
- if (*radius > max_radius) {
- *radius=max_radius;
- rad=max_radius;
- cost=cos(*theta);
- sint=sqrt(1.0-cost*cost);
- cosf=cos(*phi);
- sinf=sin(*phi);
- *x=rad*sint*cosf;
- *y=rad*sint*sinf;
- *z=rad*cost;
- }
- if (*radius < min_radius) {
- *radius=min_radius;
- rad=min_radius;
- cost=cos(*theta);
- sint=sqrt(1.0-cost*cost);
- cosf=cos(*phi);
- sinf=sin(*phi);
- *x=rad*sint*cosf;
- *y=rad*sint*sinf;
- *z=rad*cost;
- }
-
- return;
-}
-
-
-/******************************************************************/
-/* FIX ANGLE */
-/* */
-/* This function constrains the value of angle to be */
-/* between 0 and 2 PI */
-/* */
-
-static void fix_angle(double *angle)
-{
- const double two_pi = 2.0*M_PI;
-
- double d2 = floor(*angle / two_pi);
-
- *angle -= two_pi * d2;
-
- return;
-}
-
-/******************************************************************/
-/* FIX THETA PHI */
-/* */
-/* This function constrains the value of theta to be */
-/* between 0 and PI, and */
-/* this function constrains the value of phi to be */
-/* between 0 and 2 PI */
-/* */
-static void fix_theta_phi(double *theta, double *phi)
-{
- const double two_pi=2.0*M_PI;
-
- fix_angle(theta);
-
- if (*theta > M_PI) {
- *theta = two_pi - *theta;
- *phi += M_PI;
- }
-
- fix_angle(phi);
-
- return;
-}
-
-/********** IGET ELEMENT *****************************************/
-/* */
-/* This function returns the the real element for a given point. */
-/* Returns -99 if not in this cap. */
-/* iprevious_element, if known, is the last known element. If */
-/* it is not known, input a negative number. */
-
-int full_iget_element(struct All_variables *E,
- int j, int iprevious_element,
- double x, double y, double z,
- double theta, double phi, double rad)
-{
- int icheck_processor_shell();
- int iregel;
- int iel;
- int ntheta,nphi;
- int ival;
- int ichoice;
- int kk;
- int ineighbor;
- int icorner[5];
- int elx,ely,elz,elxz;
- int ifinal_iel;
- int nelem;
-
- elx=E->lmesh.elx;
- ely=E->lmesh.ely;
- elz=E->lmesh.elz;
-
-
- ntheta=0;
- nphi=0;
-
- /* check the radial range */
- if (E->parallel.nprocz>1)
- {
- ival=icheck_processor_shell(E,j,rad);
- if (ival!=1) return -99;
- }
-
- /* do quick search to see if element can be easily found. */
- /* note that element may still be out of this cap, but */
- /* it is probably fast to do a quick search before */
- /* checking cap */
-
-
- /* get regular element number */
-
- iregel=iget_regel(E,j,theta,phi,&ntheta,&nphi);
- if (iregel<=0)
- {
- return -99;
- }
-
-
- /* AKMA put safety here or in make grid */
-
- if (E->trace.regtoel[j][0][iregel]==0)
- {
- iel=E->trace.regtoel[j][1][iregel];
- goto foundit;
- }
-
- /* first check previous element */
-
- if (iprevious_element>0)
- {
- ival=icheck_element_column(E,j,iprevious_element,x,y,z,rad);
- if (ival==1)
- {
- iel=iprevious_element;
- goto foundit;
- }
- }
-
- /* Check all regular mapping choices */
-
- ichoice=0;
- if (E->trace.regtoel[j][0][iregel]>0)
- {
-
- ichoice=E->trace.regtoel[j][0][iregel];
- for (kk=1;kk<=ichoice;kk++)
- {
- nelem=E->trace.regtoel[j][kk][iregel];
-
- if (nelem!=iprevious_element)
- {
- ival=icheck_element_column(E,j,nelem,x,y,z,rad);
- if (ival==1)
- {
- iel=nelem;
- goto foundit;
- }
-
- }
- }
- }
-
- /* If here, it means that tracer could not be found quickly with regular element map */
-
- /* First check previous element neighbors */
-
- if (iprevious_element>0)
- {
- iel=icheck_column_neighbors(E,j,iprevious_element,x,y,z,rad);
- if (iel>0)
- {
- goto foundit;
- }
- }
-
- /* check if still in cap */
-
- ival=full_icheck_cap(E,0,x,y,z,rad);
- if (ival==0)
- {
- return -99;
- }
-
- /* if here, still in cap (hopefully, without a doubt) */
-
- /* check cap corners (they are sometimes tricky) */
-
- elxz=elx*elz;
- icorner[1]=elz;
- icorner[2]=elxz;
- icorner[3]=elxz*(ely-1)+elz;
- icorner[4]=elxz*ely;
- for (kk=1;kk<=4;kk++)
- {
- ival=icheck_element_column(E,j,icorner[kk],x,y,z,rad);
- if (ival>0)
- {
- iel=icorner[kk];
- goto foundit;
- }
- }
-
-
- /* if previous element is not known, check neighbors of those tried in iquick... */
-
- if (iprevious_element<0)
- {
- if (ichoice>0)
- {
- for (kk=1;kk<=ichoice;kk++)
- {
- ineighbor=E->trace.regtoel[j][kk][iregel];
- iel=icheck_column_neighbors(E,j,ineighbor,x,y,z,rad);
- if (iel>0)
- {
- goto foundit;
- }
- }
- }
-
- }
-
- /* As a last resort, check all element columns */
-
- E->trace.istat1++;
-
- iel=icheck_all_columns(E,j,x,y,z,rad);
-
- /*
- fprintf(E->trace.fpt,"WARNING(full_iget_element)-doing a full search!\n");
- fprintf(E->trace.fpt," Most often means tracers have moved more than 1 element away\n");
- fprintf(E->trace.fpt," or regular element resolution is way too low.\n");
- fprintf(E->trace.fpt," COLUMN: %d \n",iel);
- fprintf(E->trace.fpt," PREVIOUS ELEMENT: %d \n",iprevious_element);
- fprintf(E->trace.fpt," x,y,z,theta,phi,rad: %f %f %f %f %f %f\n",x,y,z,theta,phi,rad);
- fflush(E->trace.fpt);
- if (E->trace.itracer_warnings) exit(10);
- */
-
- if (E->trace.istat1%100==0)
- {
- fprintf(E->trace.fpt,"Checked all elements %d times already this turn\n",E->trace.istat1);
- fflush(E->trace.fpt);
- }
- if (iel>0)
- {
- goto foundit;
- }
-
-
- /* if still here, there is a problem */
-
- fprintf(E->trace.fpt,"Error(full_iget_element) - element not found\n");
- fprintf(E->trace.fpt,"x,y,z,theta,phi,iregel %.15e %.15e %.15e %.15e %.15e %d\n",
- x,y,z,theta,phi,iregel);
- fflush(E->trace.fpt);
- exit(10);
-
- foundit:
-
- /* find radial element */
-
- ifinal_iel=iget_radial_element(E,j,iel,rad);
-
- return ifinal_iel;
-}
-
-
-/***** IGET RADIAL ELEMENT ***********************************/
-/* */
-/* This function returns the proper radial element, given */
-/* an element (iel) from the column. */
-
-static int iget_radial_element(struct All_variables *E,
- int j, int iel,
- double rad)
-{
-
- int elz=E->lmesh.elz;
- int ibottom_element;
- int iradial_element;
- int node;
- int kk;
- int idum;
-
- double top_rad;
-
- /* first project to the lowest element in the column */
-
- idum=(iel-1)/elz;
- ibottom_element=idum*elz+1;
-
- iradial_element=ibottom_element;
-
- for (kk=1;kk<=elz;kk++)
- {
-
- node=E->ien[j][iradial_element].node[8];
- top_rad=E->sx[j][3][node];
-
- if (rad<top_rad) goto found_it;
-
- iradial_element++;
-
- } /* end kk */
-
-
- /* should not be here */
-
- fprintf(E->trace.fpt,"Error(iget_radial_element)-out of range %f %d %d %d\n",rad,j,iel,ibottom_element);
- fflush(E->trace.fpt);
- exit(10);
-
- found_it:
-
- return iradial_element;
-}
-
-
-/*********** IGET REGEL ******************************************/
-/* */
-/* This function returns the regular element in which a point */
-/* exists. If not found, returns -99. */
-/* npi and ntheta are modified for later use */
-
-static int iget_regel(struct All_variables *E, int j,
- double theta, double phi,
- int *ntheta, int *nphi)
-{
-
- int iregel;
- int idum;
-
- double rdum;
-
- /* first check whether theta is in range */
-
- if (theta<E->trace.thetamin[j]) return -99;
- if (theta>E->trace.thetamax[j]) return -99;
-
- /* get ntheta, nphi on regular mesh */
-
- rdum=theta-E->trace.thetamin[j];
- idum=rdum/E->trace.deltheta[j];
- *ntheta=idum+1;
-
- rdum=phi-E->trace.phimin[j];
- idum=rdum/E->trace.delphi[j];
- *nphi=idum+1;
-
- iregel=*ntheta+(*nphi-1)*E->trace.numtheta[j];
-
- /* check range to be sure */
-
- if (iregel>E->trace.numregel[j]) return -99;
- if (iregel<1) return -99;
-
- return iregel;
-}
-
-
-
-/****************************************************************/
-/* DEFINE UV SPACE */
-/* */
-/* This function defines nodal points as orthodrome coordinates */
-/* u and v. In uv space, great circles form straight lines. */
-/* This is used for interpolation method 1 */
-/* E->gnomonic[node].u = u */
-/* E->gnomonic[node].v = v */
-
-static void define_uv_space(struct All_variables *E)
-{
- const int j = 1;
- const int lev = E->mesh.levmax;
- int refnode;
- int i, n;
-
- double u, v, cosc, theta_f, phi_f, dphi, cosd;
- double *cost, *sint, *cosf, *sinf;
-
- if ((E->gnomonic = malloc((E->lmesh.nsf+1)*sizeof(struct CITCOM_GNOMONIC)))
- == NULL) {
- fprintf(stderr,"Error(define uv)-not enough memory(a)\n");
- exit(10);
- }
-
- sint = E->SinCos[lev][j][0];
- sinf = E->SinCos[lev][j][1];
- cost = E->SinCos[lev][j][2];
- cosf = E->SinCos[lev][j][3];
-
- /* uv space requires a reference point */
- /* use the point at middle of the cap */
- refnode = 1 + E->lmesh.noz * ((E->lmesh.noy / 2) * E->lmesh.nox
- + E->lmesh.nox / 2);
- phi_f = E->gnomonic_reference_phi = E->sx[j][2][refnode];
-
- /** debug **
- theta_f = E->sx[j][1][refnode];
- for (i=1; i<=E->lmesh.nsf; i++) {
- fprintf(E->trace.fpt, "i=%d (%e %e %e %e)\n",
- i, sint[i], sinf[i], cost[i], cosf[i]);
- }
- fprintf(E->trace.fpt, "%d %d %d ref=(%e %e)\n",
- E->lmesh.noz, E->lmesh.nsf, refnode, theta_f, phi_f);
- /**/
-
- /* store cos(theta_f) and sin(theta_f) */
- E->gnomonic[0].u = cost[refnode];
- E->gnomonic[0].v = sint[refnode];
-
-
- /* convert each nodal point to u and v */
-
- for (i=1, n=1; i<=E->lmesh.nsf; i++, n+=E->lmesh.noz) {
- dphi = E->sx[j][2][n] - phi_f;
- cosd = cos(dphi);
- cosc = cost[refnode] * cost[n] + sint[refnode] * sint[n] * cosd;
- u = sint[n] * sin(dphi) / cosc;
- v = (sint[refnode] * cost[n] - cost[refnode] * sint[n] * cosd)
- / cosc;
-
- E->gnomonic[i].u = u;
- E->gnomonic[i].v = v;
-
- /** debug **
- fprintf(E->trace.fpt, "n=%d ns=%d cosc=%e (%e %e) -> (%e %e)\n",
- n, i, cosc, E->sx[j][1][n], E->sx[j][2][n], u, v);
- /**/
- }
-
- return;
-}
-
-
-/***************************************************************/
-/* DETERMINE SHAPE COEFFICIENTS */
-/* */
-/* An initialization function that determines the coeffiecients*/
-/* to all element shape functions. */
-/* This method uses standard linear shape functions of */
-/* triangular elements. (See Cuvelier, Segal, and */
-/* van Steenhoven, 1986). This is all in UV space. */
-/* */
-/* shape_coefs[cap][wedge][3 shape functions*3 coefs][nelems] */
-
-static void determine_shape_coefficients(struct All_variables *E)
-{
- const int j = 1;
- int nelem, iwedge, kk, i;
- int snode;
-
- double u[5], v[5];
- double x1 = 0.0;
- double x2 = 0.0;
- double x3 = 0.0;
- double y1 = 0.0;
- double y2 = 0.0;
- double y3 = 0.0;
- double delta, a0, a1, a2;
-
- /* first, allocate memory */
-
- for(iwedge=1; iwedge<=2; iwedge++) {
- for (kk=1; kk<=9; kk++) {
- if ((E->trace.shape_coefs[j][iwedge][kk] =
- (double *)malloc((E->lmesh.snel+1)*sizeof(double))) == NULL) {
- fprintf(E->trace.fpt,"ERROR(find shape coefs)-not enough memory(a)\n");
- fflush(E->trace.fpt);
- exit(10);
- }
- }
- }
-
- for (i=1, nelem=1; i<=E->lmesh.snel; i++, nelem+=E->lmesh.elz) {
-
- /* find u,v of local nodes at one radius */
-
- for(kk=1; kk<=4; kk++) {
- snode = (E->ien[j][nelem].node[kk]-1) / E->lmesh.noz + 1;
- u[kk] = E->gnomonic[snode].u;
- v[kk] = E->gnomonic[snode].v;
- }
-
- for(iwedge=1; iwedge<=2; iwedge++) {
-
- if (iwedge == 1) {
- x1 = u[1];
- x2 = u[2];
- x3 = u[3];
- y1 = v[1];
- y2 = v[2];
- y3 = v[3];
- }
- if (iwedge == 2) {
- x1 = u[1];
- x2 = u[3];
- x3 = u[4];
- y1 = v[1];
- y2 = v[3];
- y3 = v[4];
- }
-
- /* shape function 1 */
-
- delta = (x3-x2)*(y1-y2)-(y2-y3)*(x2-x1);
- a0 = (x2*y3-x3*y2)/delta;
- a1 = (y2-y3)/delta;
- a2 = (x3-x2)/delta;
-
- E->trace.shape_coefs[j][iwedge][1][i] = a0;
- E->trace.shape_coefs[j][iwedge][2][i] = a1;
- E->trace.shape_coefs[j][iwedge][3][i] = a2;
-
- /* shape function 2 */
-
- delta = (x3-x1)*(y2-y1)-(y1-y3)*(x1-x2);
- a0 = (x1*y3-x3*y1)/delta;
- a1 = (y1-y3)/delta;
- a2 = (x3-x1)/delta;
-
- E->trace.shape_coefs[j][iwedge][4][i] = a0;
- E->trace.shape_coefs[j][iwedge][5][i] = a1;
- E->trace.shape_coefs[j][iwedge][6][i] = a2;
-
- /* shape function 3 */
-
- delta = (x1-x2)*(y3-y2)-(y2-y1)*(x2-x3);
- a0 = (x2*y1-x1*y2)/delta;
- a1 = (y2-y1)/delta;
- a2 = (x1-x2)/delta;
-
- E->trace.shape_coefs[j][iwedge][7][i] = a0;
- E->trace.shape_coefs[j][iwedge][8][i] = a1;
- E->trace.shape_coefs[j][iwedge][9][i] = a2;
-
- /** debug **
- fprintf(E->trace.fpt, "el=%d els=%d iwedge=%d shape=(%e %e %e, %e %e %e, %e %e %e)\n",
- nelem, i, iwedge,
- E->trace.shape_coefs[j][iwedge][1][i],
- E->trace.shape_coefs[j][iwedge][2][i],
- E->trace.shape_coefs[j][iwedge][3][i],
- E->trace.shape_coefs[j][iwedge][4][i],
- E->trace.shape_coefs[j][iwedge][5][i],
- E->trace.shape_coefs[j][iwedge][6][i],
- E->trace.shape_coefs[j][iwedge][7][i],
- E->trace.shape_coefs[j][iwedge][8][i],
- E->trace.shape_coefs[j][iwedge][9][i]);
- /**/
-
- } /* end wedge */
- } /* end elem */
-
- return;
-}
-
-
-/*********** KEEP WITHIN BOUNDS *****************************************/
-/* */
-/* This function makes sure the particle is within the sphere, and */
-/* phi and theta are within the proper degree range. */
-
-void full_keep_within_bounds(struct All_variables *E,
- double *x, double *y, double *z,
- double *theta, double *phi, double *rad)
-{
- fix_theta_phi(theta, phi);
- fix_radius(E,rad,theta,phi,x,y,z);
-
- return;
-}
-
-
-/* &&&&&&&&&&&&&&&&&&&& ANALYTICAL TESTS &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&**************/
-
-/**************** ANALYTICAL TEST *********************************************************/
-/* */
-/* This function (and the 2 following) are used to test advection of tracers by assigning */
-/* a test function (in "analytical_test_function"). */
-
-void analytical_test(E)
- struct All_variables *E;
-
-{
-#if 0
- int kk,pp;
- int nsteps;
- int j;
- int my_number,number;
- int nrunge_steps;
- int nrunge_refinement;
-
- double dt;
- double runge_dt;
- double theta,phi,rad;
- double time;
- double vel_s[4];
- double vel_c[4];
- double my_theta0,my_phi0,my_rad0;
- double my_thetaf,my_phif,my_radf;
- double theta0,phi0,rad0;
- double thetaf,phif,radf;
- double x0_s[4],xf_s[4];
- double x0_c[4],xf_c[4];
- double vec[4];
- double runge_path_length,runge_time;
- double x0,y0,z0;
- double xf,yf,zf;
- double difference;
- double difperpath;
-
- void analytical_test_function();
- void predict_tracers();
- void correct_tracers();
- void analytical_runge_kutte();
- void sphere_to_cart();
-
-
- fprintf(E->trace.fpt,"Starting Analytical Test\n");
- if (E->parallel.me==0) fprintf(stderr,"Starting Analytical Test\n");
- fflush(E->trace.fpt);
-
- /* Reset Box cushion to 0 */
-
- E->trace.box_cushion=0.0000;
-
- /* test paramters */
-
- nsteps=200;
- dt=0.0001;
-
- E->advection.timestep=dt;
-
- fprintf(E->trace.fpt,"steps: %d dt: %f\n",nsteps,dt);
-
- /* Assign test velocity to Citcom nodes */
-
- for (j=1;j<=E->sphere.caps_per_proc;j++)
- {
- for (kk=1;kk<=E->lmesh.nno;kk++)
- {
-
- theta=E->sx[j][1][kk];
- phi=E->sx[j][2][kk];
- rad=E->sx[j][3][kk];
-
- analytical_test_function(E,theta,phi,rad,vel_s,vel_c);
-
- E->sphere.cap[j].V[1][kk]=vel_s[1];
- E->sphere.cap[j].V[2][kk]=vel_s[2];
- E->sphere.cap[j].V[3][kk]=vel_s[3];
- }
- }
-
- time=0.0;
-
- my_theta0=0.0;
- my_phi0=0.0;
- my_rad0=0.0;
- my_thetaf=0.0;
- my_phif=0.0;
- my_radf=0.0;
-
- for (j=1;j<=E->sphere.caps_per_proc;j++)
- {
- if (E->trace.ntracers[j]>10)
- {
- fprintf(E->trace.fpt,"Warning(analytical)-too many tracers to print!\n");
- fflush(E->trace.fpt);
- if (E->trace.itracer_warnings) exit(10);
- }
- }
-
- /* print initial positions */
-
- E->monitor.solution_cycles=0;
- for (j=1;j<=E->sphere.caps_per_proc;j++)
- {
- for (pp=1;pp<=E->trace.ntracers[j];pp++)
- {
- theta=E->trace.basicq[j][0][pp];
- phi=E->trace.basicq[j][1][pp];
- rad=E->trace.basicq[j][2][pp];
-
- fprintf(E->trace.fpt,"(%d) time: %f theta: %f phi: %f rad: %f\n",E->monitor.solution_cycles,time,theta,phi,rad);
-
- if (pp==1) fprintf(stderr,"(%d) time: %f theta: %f phi: %f rad: %f\n",E->monitor.solution_cycles,time,theta,phi,rad);
-
- if (pp==1)
- {
- my_theta0=theta;
- my_phi0=phi;
- my_rad0=rad;
- }
- }
- }
-
- /* advect tracers */
-
- for (kk=1;kk<=nsteps;kk++)
- {
- E->monitor.solution_cycles=kk;
-
- time=time+dt;
-
- predict_tracers(E);
- correct_tracers(E);
-
- for (j=1;j<=E->sphere.caps_per_proc;j++)
- {
- for (pp=1;pp<=E->trace.ntracers[j];pp++)
- {
- theta=E->trace.basicq[j][0][pp];
- phi=E->trace.basicq[j][1][pp];
- rad=E->trace.basicq[j][2][pp];
-
- fprintf(E->trace.fpt,"(%d) time: %f theta: %f phi: %f rad: %f\n",E->monitor.solution_cycles,time,theta,phi,rad);
-
- if (pp==1) fprintf(stderr,"(%d) time: %f theta: %f phi: %f rad: %f\n",E->monitor.solution_cycles,time,theta,phi,rad);
-
- if ((kk==nsteps) && (pp==1))
- {
- my_thetaf=theta;
- my_phif=phi;
- my_radf=rad;
- }
- }
- }
-
- }
-
- /* Get ready for comparison to Runge-Kutte (only works for one tracer) */
-
- fflush(E->trace.fpt);
- parallel_process_sync(E);
-
- fprintf(E->trace.fpt,"\n\nComparison to Runge-Kutte\n");
- if (E->parallel.me==0) fprintf(stderr,"Comparison to Runge-Kutte\n");
-
- for (j=1;j<=E->sphere.caps_per_proc;j++)
- {
- my_number=E->trace.ntracers[j];
- }
-
- MPI_Allreduce(&my_number,&number,1,MPI_INT,MPI_SUM,E->parallel.world);
-
- fprintf(E->trace.fpt,"Number of tracers: %d\n", number);
- if (E->parallel.me==0) fprintf(stderr,"Number of tracers: %d\n", number);
-
- /* if more than 1 tracer, exit */
-
- if (number!=1)
- {
- fprintf(E->trace.fpt,"(Note: RK comparison only appropriate for one tracing particle (%d here) \n",number);
- if (E->parallel.me==0) fprintf(stderr,"(Note: RK comparison only appropriate for one tracing particle (%d here) \n",number);
- fflush(E->trace.fpt);
- parallel_process_termination();
- }
-
-
- /* communicate starting and final positions */
-
- MPI_Allreduce(&my_theta0,&theta0,1,MPI_DOUBLE,MPI_SUM,E->parallel.world);
- MPI_Allreduce(&my_phi0,&phi0,1,MPI_DOUBLE,MPI_SUM,E->parallel.world);
- MPI_Allreduce(&my_rad0,&rad0,1,MPI_DOUBLE,MPI_SUM,E->parallel.world);
- MPI_Allreduce(&my_thetaf,&thetaf,1,MPI_DOUBLE,MPI_SUM,E->parallel.world);
- MPI_Allreduce(&my_phif,&phif,1,MPI_DOUBLE,MPI_SUM,E->parallel.world);
- MPI_Allreduce(&my_radf,&radf,1,MPI_DOUBLE,MPI_SUM,E->parallel.world);
-
- x0_s[1]=theta0;
- x0_s[2]=phi0;
- x0_s[3]=rad0;
-
- nrunge_refinement=1000;
-
- nrunge_steps=nsteps*nrunge_refinement;
- runge_dt=dt/(1.0*nrunge_refinement);
-
-
- analytical_runge_kutte(E,nrunge_steps,runge_dt,x0_s,x0_c,xf_s,xf_c,vec);
-
- runge_time=vec[1];
- runge_path_length=vec[2];
-
- /* initial coordinates - both citcom and RK */
-
- x0=x0_c[1];
- y0=x0_c[2];
- z0=x0_c[3];
-
- /* convert final citcom coords into cartesian */
-
- sphere_to_cart(E,thetaf,phif,radf,&xf,&yf,&zf);
-
- difference=sqrt((xf-xf_c[1])*(xf-xf_c[1])+(yf-xf_c[2])*(yf-xf_c[2])+(zf-xf_c[3])*(zf-xf_c[3]));
-
- difperpath=difference/runge_path_length;
-
- /* Print out results */
-
- fprintf(E->trace.fpt,"Citcom calculation: steps: %d dt: %f\n",nsteps,dt);
- fprintf(E->trace.fpt," (nodes per cap: %d x %d x %d)\n",E->lmesh.nox,E->lmesh.noy,(E->lmesh.noz-1)*E->parallel.nprocz+1);
- fprintf(E->trace.fpt," starting position: theta: %f phi: %f rad: %f\n", theta0,phi0,rad0);
- fprintf(E->trace.fpt," final position: theta: %f phi: %f rad: %f\n", thetaf,phif,radf);
- fprintf(E->trace.fpt," (final time: %f) \n",time );
-
- fprintf(E->trace.fpt,"\n\nRunge-Kutte calculation: steps: %d dt: %g\n",nrunge_steps,runge_dt);
- fprintf(E->trace.fpt," starting position: theta: %f phi: %f rad: %f\n", theta0,phi0,rad0);
- fprintf(E->trace.fpt," final position: theta: %f phi: %f rad: %f\n",xf_s[1],xf_s[2],xf_s[3]);
- fprintf(E->trace.fpt," path length: %f \n",runge_path_length );
- fprintf(E->trace.fpt," (final time: %f) \n",runge_time );
-
- fprintf(E->trace.fpt,"\n\n Difference between Citcom and RK: %e (diff per path length: %e)\n\n",difference,difperpath);
-
- if (E->parallel.me==0)
- {
- fprintf(stderr,"Citcom calculation: steps: %d dt: %f\n",nsteps,dt);
- fprintf(stderr," (nodes per cap: %d x %d x %d)\n",E->lmesh.nox,E->lmesh.noy,(E->lmesh.noz-1)*E->parallel.nprocz+1);
- fprintf(stderr," starting position: theta: %f phi: %f rad: %f\n", theta0,phi0,rad0);
- fprintf(stderr," final position: theta: %f phi: %f rad: %f\n", thetaf,phif,radf);
- fprintf(stderr," (final time: %f) \n",time );
-
- fprintf(stderr,"\n\nRunge-Kutte calculation: steps: %d dt: %f\n",nrunge_steps,runge_dt);
- fprintf(stderr," starting position: theta: %f phi: %f rad: %f\n", theta0,phi0,rad0);
- fprintf(stderr," final position: theta: %f phi: %f rad: %f\n",xf_s[1],xf_s[2],xf_s[3]);
- fprintf(stderr," path length: %f \n",runge_path_length );
- fprintf(stderr," (final time: %f) \n",runge_time );
-
- fprintf(stderr,"\n\n Difference between Citcom and RK: %e (diff per path length: %e)\n\n",difference,difperpath);
-
- }
-
- fflush(E->trace.fpt);
-#endif
- return;
-}
-
-/*************** ANALYTICAL RUNGE KUTTE ******************/
-/* */
-void analytical_runge_kutte(E,nsteps,dt,x0_s,x0_c,xf_s,xf_c,vec)
- struct All_variables *E;
- int nsteps;
- double dt;
- double *x0_c;
- double *x0_s;
- double *xf_c;
- double *xf_s;
- double *vec;
-
-{
-
- int kk;
-
- double x_0,y_0,z_0;
- double x_p,y_p,z_p;
- double x_c=0.0;
- double y_c=0.0;
- double z_c=0.0;
- double theta_0,phi_0,rad_0;
- double theta_p,phi_p,rad_p;
- double theta_c,phi_c,rad_c;
- double vel0_s[4],vel0_c[4];
- double velp_s[4],velp_c[4];
- double time;
- double path,dtpath;
-
- void sphere_to_cart();
- void cart_to_sphere();
- void analytical_test_function();
-
- theta_0=x0_s[1];
- phi_0=x0_s[2];
- rad_0=x0_s[3];
-
- sphere_to_cart(E,theta_0,phi_0,rad_0,&x_0,&y_0,&z_0);
-
- /* fill initial cartesian vector to send back */
-
- x0_c[1]=x_0;
- x0_c[2]=y_0;
- x0_c[3]=z_0;
-
- time=0.0;
- path=0.0;
-
- for (kk=1;kk<=nsteps;kk++)
- {
-
- /* get velocity at initial position */
-
- analytical_test_function(E,theta_0,phi_0,rad_0,vel0_s,vel0_c);
-
- /* Find predicted midpoint position */
-
- x_p=x_0+vel0_c[1]*dt*0.5;
- y_p=y_0+vel0_c[2]*dt*0.5;
- z_p=z_0+vel0_c[3]*dt*0.5;
-
- /* convert to spherical */
-
- cart_to_sphere(E,x_p,y_p,z_p,&theta_p,&phi_p,&rad_p);
-
- /* get velocity at predicted midpoint position */
-
- analytical_test_function(E,theta_p,phi_p,rad_p,velp_s,velp_c);
-
- /* Find corrected position using midpoint velocity */
-
- x_c=x_0+velp_c[1]*dt;
- y_c=y_0+velp_c[2]*dt;
- z_c=z_0+velp_c[3]*dt;
-
- /* convert to spherical */
-
- cart_to_sphere(E,x_c,y_c,z_c,&theta_c,&phi_c,&rad_c);
-
- /* compute path lenght */
-
- dtpath=sqrt((x_c-x_0)*(x_c-x_0)+(y_c-y_0)*(y_c-y_0)+(z_c-z_0)*(z_c-z_0));
- path=path+dtpath;
-
- time=time+dt;
-
- x_0=x_c;
- y_0=y_c;
- z_0=z_c;
-
- /* next time step */
-
- }
-
- /* fill final spherical and cartesian vectors to send back */
-
- xf_s[1]=theta_c;
- xf_s[2]=phi_c;
- xf_s[3]=rad_c;
-
- xf_c[1]=x_c;
- xf_c[2]=y_c;
- xf_c[3]=z_c;
-
- vec[1]=time;
- vec[2]=path;
-
- return;
-}
-
-
-
-/**************** ANALYTICAL TEST FUNCTION ******************/
-/* */
-/* vel_s[1] => velocity in theta direction */
-/* vel_s[2] => velocity in phi direction */
-/* vel_s[3] => velocity in radial direction */
-/* */
-/* vel_c[1] => velocity in x direction */
-/* vel_c[2] => velocity in y direction */
-/* vel_c[3] => velocity in z direction */
-
-void analytical_test_function(E,theta,phi,rad,vel_s,vel_c)
- struct All_variables *E;
- double theta,phi,rad;
- double *vel_s;
- double *vel_c;
-
-{
-
- double sint,sinf,cost,cosf;
- double v_theta,v_phi,v_rad;
- double vx,vy,vz;
-
- /* This is where the function is given in spherical */
-
- v_theta=50.0*rad*cos(phi);
- v_phi=100.0*rad*sin(theta);
- v_rad=25.0*rad;
-
- vel_s[1]=v_theta;
- vel_s[2]=v_phi;
- vel_s[3]=v_rad;
-
- /* Convert the function into cartesian */
-
- sint=sin(theta);
- sinf=sin(phi);
- cost=cos(theta);
- cosf=cos(phi);
-
- vx=v_theta*cost*cosf-v_phi*sinf+v_rad*sint*cosf;
- vy=v_theta*cost*sinf+v_phi*cosf+v_rad*sint*sinf;
- vz=-v_theta*sint+v_rad*cost;
-
- vel_c[1]=vx;
- vel_c[2]=vy;
- vel_c[3]=vz;
-
- return;
-}
-
-
-/**** PDEBUG ***********************************************************/
-void pdebug(struct All_variables *E, int i)
-{
-
- fprintf(E->trace.fpt,"HERE (Before Sync): %d\n",i);
- fflush(E->trace.fpt);
- parallel_process_sync(E);
- fprintf(E->trace.fpt,"HERE (After Sync): %d\n",i);
- fflush(E->trace.fpt);
-
- return;
-}
Copied: mc/3D/CitcomS/branches/cxx/lib/Full_tracer_advection.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Full_tracer_advection.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Full_tracer_advection.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Full_tracer_advection.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,3465 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+
+#include <math.h>
+#include "element_definitions.h"
+#include "global_defs.h"
+#include "parsing.h"
+#include "parallel_related.h"
+#include "composition_related.h"
+
+#include "cproto.h"
+
+static void get_2dshape(struct All_variables *E,
+ int j, int nelem,
+ double u, double v,
+ int iwedge, double * shape2d);
+static void get_radial_shape(struct All_variables *E,
+ int j, int nelem,
+ double rad, double *shaperad);
+static void spherical_to_uv(struct All_variables *E, int j,
+ double theta, double phi,
+ double *u, double *v);
+static void make_regular_grid(struct All_variables *E);
+static void write_trace_instructions(struct All_variables *E);
+static int icheck_column_neighbors(struct All_variables *E,
+ int j, int nel,
+ double x, double y, double z,
+ double rad);
+static int icheck_all_columns(struct All_variables *E,
+ int j,
+ double x, double y, double z,
+ double rad);
+static int icheck_element(struct All_variables *E,
+ int j, int nel,
+ double x, double y, double z,
+ double rad);
+static int icheck_shell(struct All_variables *E,
+ int nel, double rad);
+static int icheck_element_column(struct All_variables *E,
+ int j, int nel,
+ double x, double y, double z,
+ double rad);
+static int icheck_bounds(struct All_variables *E,
+ double *test_point,
+ double *rnode1, double *rnode2,
+ double *rnode3, double *rnode4);
+static double findradial(struct All_variables *E, double *vec,
+ double cost, double sint,
+ double cosf, double sinf);
+static void makevector(double *vec, double xf, double yf, double zf,
+ double x0, double y0, double z0);
+static void crossit(double *cross, double *A, double *B);
+static void fix_radius(struct All_variables *E,
+ double *radius, double *theta, double *phi,
+ double *x, double *y, double *z);
+static void fix_angle(double *angle);
+static void fix_theta_phi(double *theta, double *phi);
+static int iget_radial_element(struct All_variables *E,
+ int j, int iel,
+ double rad);
+static int iget_regel(struct All_variables *E, int j,
+ double theta, double phi,
+ int *ntheta, int *nphi);
+static void define_uv_space(struct All_variables *E);
+static void determine_shape_coefficients(struct All_variables *E);
+static void full_put_lost_tracers(struct All_variables *E,
+ int isend[13][13], double *send[13][13]);
+void pdebug(struct All_variables *E, int i);
+int full_icheck_cap(struct All_variables *E, int icap,
+ double x, double y, double z, double rad);
+
+
+
+/******* FULL TRACER INPUT *********************/
+
+void full_tracer_input(struct All_variables *E)
+{
+ int m = E->parallel.me;
+
+
+ /* Regular grid parameters */
+ /* (first fill uniform del[0] value) */
+ /* (later, in make_regular_grid, will adjust and distribute to caps */
+
+ E->trace.deltheta[0]=1.0;
+ E->trace.delphi[0]=1.0;
+ input_double("regular_grid_deltheta",&(E->trace.deltheta[0]),"1.0",m);
+ input_double("regular_grid_delphi",&(E->trace.delphi[0]),"1.0",m);
+
+
+ /* Analytical Test Function */
+
+ E->trace.ianalytical_tracer_test=0;
+ /* input_int("analytical_tracer_test",&(E->trace.ianalytical_tracer_test),
+ "0,0,nomax",m); */
+
+
+ return;
+}
+
+/***** FULL TRACER SETUP ************************/
+
+void full_tracer_setup(struct All_variables *E)
+{
+
+ char output_file[200];
+ double begin_time = CPU_time0();
+
+ /* Some error control */
+
+ if (E->sphere.caps_per_proc>1) {
+ fprintf(stderr,"This code does not work for multiple caps per processor!\n");
+ parallel_process_termination();
+ }
+
+
+ /* open tracing output file */
+
+ sprintf(output_file,"%s.tracer_log.%d",E->control.data_file,E->parallel.me);
+ E->trace.fpt=fopen(output_file,"w");
+
+
+ /* reset statistical counters */
+
+ E->trace.istat_isend=0;
+ E->trace.istat_iempty=0;
+ E->trace.istat_elements_checked=0;
+ E->trace.istat1=0;
+
+
+ /* some obscure initial parameters */
+ /* This parameter specifies how close a tracer can get to the boundary */
+ E->trace.box_cushion=0.00001;
+
+ /* Determine number of tracer quantities */
+
+ /* advection_quantites - those needed for advection */
+ E->trace.number_of_basic_quantities=12;
+
+ /* extra_quantities - used for flavors, composition, etc. */
+ /* (can be increased for additional science i.e. tracing chemistry */
+
+ E->trace.number_of_extra_quantities = 0;
+ if (E->trace.nflavors > 0)
+ E->trace.number_of_extra_quantities += 1;
+
+
+ E->trace.number_of_tracer_quantities =
+ E->trace.number_of_basic_quantities +
+ E->trace.number_of_extra_quantities;
+
+
+ /* Fixed positions in tracer array */
+ /* Flavor is always in extraq position 0 */
+ /* Current coordinates are always kept in basicq positions 0-5 */
+ /* Other positions may be used depending on science being done */
+
+
+ /* Some error control regarding size of pointer arrays */
+
+ if (E->trace.number_of_basic_quantities>99) {
+ fprintf(E->trace.fpt,"ERROR(initialize_trace)-increase 2nd position size of basic in tracer_defs.h\n");
+ fflush(E->trace.fpt);
+ parallel_process_termination();
+ }
+ if (E->trace.number_of_extra_quantities>99) {
+ fprintf(E->trace.fpt,"ERROR(initialize_trace)-increase 2nd position size of extraq in tracer_defs.h\n");
+ fflush(E->trace.fpt);
+ parallel_process_termination();
+ }
+ if (E->trace.number_of_tracer_quantities>99) {
+ fprintf(E->trace.fpt,"ERROR(initialize_trace)-increase 2nd position size of rlater in tracer_defs.h\n");
+ fflush(E->trace.fpt);
+ parallel_process_termination();
+ }
+
+ write_trace_instructions(E);
+
+
+ /* Gnometric projection for velocity interpolation */
+ define_uv_space(E);
+ determine_shape_coefficients(E);
+
+
+ /* The bounding box of neiboring processors */
+ get_neighboring_caps(E);
+
+
+ /* Fine-grained regular grid to search tracers */
+ make_regular_grid(E);
+
+
+ if (E->trace.ianalytical_tracer_test==1) {
+ //TODO: walk into this code...
+ analytical_test(E);
+ parallel_process_termination();
+ }
+
+ if (E->composition.on)
+ composition_setup(E);
+
+ fprintf(E->trace.fpt, "Tracer intiailization takes %f seconds.\n",
+ CPU_time0() - begin_time);
+
+ return;
+}
+
+
+/************** LOST SOULS ***************************************************/
+/* */
+/* This function is used to transport tracers to proper processor domains. */
+/* (MPI parallel) */
+/* All of the tracers that were sent to rlater arrays are destined to another*/
+/* cap and sent there. Then they are raised up or down for multiple z procs. */
+/* isend[j][n]=number of tracers this processor cap is sending to cap n */
+/* ireceive[j][n]=number of tracers this processor cap receiving from cap n */
+
+
+void full_lost_souls(struct All_variables *E)
+{
+ /* This code works only if E->sphere.caps_per_proc==1 */
+ const int j = 1;
+
+ int ithiscap;
+ int ithatcap=1;
+ int isend[13][13];
+ int ireceive[13][13];
+ int isize[13];
+ int kk,pp;
+ int mm;
+ int numtracers;
+ int icheck=0;
+ int isend_position;
+ int ipos,ipos2,ipos3;
+ int idb;
+ int idestination_proc=0;
+ int isource_proc;
+ int isend_z[13][3];
+ int ireceive_z[13][3];
+ int isum[13];
+ int irad;
+ int ival;
+ int ithat_processor;
+ int ireceive_position;
+ int ivertical_neighbor;
+ int ilast_receiver_position;
+ int it;
+ int irec[13];
+ int irec_position;
+ int iel;
+ int num_tracers;
+ int isize_send;
+ int isize_receive;
+ int itemp_size;
+ int itracers_subject_to_vertical_transport[13];
+
+ double x,y,z;
+ double theta,phi,rad;
+ double *send[13][13];
+ double *receive[13][13];
+ double *send_z[13][3];
+ double *receive_z[13][3];
+ double *REC[13];
+
+ double begin_time = CPU_time0();
+
+ int number_of_caps=12;
+ int lev=E->mesh.levmax;
+ int num_ngb = E->parallel.TNUM_PASS[lev][j];
+
+ /* Note, if for some reason, the number of neighbors exceeds */
+ /* 50, which is unlikely, the MPI arrays must be increased. */
+ MPI_Status status[200];
+ MPI_Request request[200];
+ MPI_Status status1;
+ MPI_Status status2;
+ int itag=1;
+
+
+ parallel_process_sync(E);
+ if(E->control.verbose)
+ fprintf(E->trace.fpt, "Entering lost_souls()\n");
+
+
+ E->trace.istat_isend=E->trace.ilater[j];
+ /** debug **
+ for (kk=1; kk<=E->trace.istat_isend; kk++) {
+ fprintf(E->trace.fpt, "tracer#=%d xx=(%g,%g,%g)\n", kk,
+ E->trace.rlater[j][0][kk],
+ E->trace.rlater[j][1][kk],
+ E->trace.rlater[j][2][kk]);
+ }
+ fflush(E->trace.fpt);
+ /**/
+
+
+
+ /* initialize isend and ireceive */
+ /* # of neighbors in the horizontal plane */
+ isize[j]=E->trace.ilater[j]*E->trace.number_of_tracer_quantities;
+ for (kk=0;kk<=num_ngb;kk++) isend[j][kk]=0;
+ for (kk=0;kk<=num_ngb;kk++) ireceive[j][kk]=0;
+
+ /* Allocate Maximum Memory to Send Arrays */
+
+ itemp_size=max(isize[j],1);
+
+ for (kk=0;kk<=num_ngb;kk++) {
+ if ((send[j][kk]=(double *)malloc(itemp_size*sizeof(double)))==NULL) {
+ fprintf(E->trace.fpt,"Error(lost souls)-no memory (u389)\n");
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+ }
+
+
+ /** debug **
+ ithiscap=E->sphere.capid[j];
+ for (kk=1;kk<=num_ngb;kk++) {
+ ithatcap=E->parallel.PROCESSOR[lev][j].pass[kk];
+ fprintf(E->trace.fpt,"cap: %d me %d TNUM: %d rank: %d\n",
+ ithiscap,E->parallel.me,kk,ithatcap);
+
+ }
+ fflush(E->trace.fpt);
+ /**/
+
+
+ /* Pre communication */
+ full_put_lost_tracers(E, isend, send);
+
+
+ /* Send info to other processors regarding number of send tracers */
+
+ /* idb is the request array index variable */
+ /* Each send and receive has a request variable */
+
+ idb=0;
+ ithiscap=0;
+
+ /* if tracer is in same cap (nprocz>1) */
+
+ if (E->parallel.nprocz>1) {
+ ireceive[j][ithiscap]=isend[j][ithiscap];
+ }
+
+ for (kk=1;kk<=num_ngb;kk++) {
+ idestination_proc=E->parallel.PROCESSOR[lev][j].pass[kk];
+
+ MPI_Isend(&isend[j][kk],1,MPI_INT,idestination_proc,
+ 11,E->parallel.world,&request[idb++]);
+
+ MPI_Irecv(&ireceive[j][kk],1,MPI_INT,idestination_proc,
+ 11,E->parallel.world,&request[idb++]);
+
+ } /* end kk, number of neighbors */
+
+ /* Wait for non-blocking calls to complete */
+
+ MPI_Waitall(idb,request,status);
+
+
+ /** debug **
+ for (kk=0;kk<=num_ngb;kk++) {
+ if(kk==0)
+ isource_proc=E->parallel.me;
+ else
+ isource_proc=E->parallel.PROCESSOR[lev][j].pass[kk];
+
+ fprintf(E->trace.fpt,"%d send %d to proc %d\n",
+ E->parallel.me,isend[j][kk],isource_proc);
+ fprintf(E->trace.fpt,"%d recv %d from proc %d\n",
+ E->parallel.me,ireceive[j][kk],isource_proc);
+ }
+ /**/
+
+ /* Allocate memory in receive arrays */
+
+ for (ithatcap=0;ithatcap<=num_ngb;ithatcap++) {
+ isize[j]=ireceive[j][ithatcap]*E->trace.number_of_tracer_quantities;
+
+ itemp_size=max(1,isize[j]);
+
+ if ((receive[j][ithatcap]=(double *)malloc(itemp_size*sizeof(double)))==NULL) {
+ fprintf(E->trace.fpt,"Error(lost souls)-no memory (c721)\n");
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+ }
+
+ /* Now, send the tracers to proper caps */
+
+ idb=0;
+ ithiscap=0;
+
+ /* same cap */
+
+ if (E->parallel.nprocz>1) {
+
+ ithatcap=ithiscap;
+ isize[j]=isend[j][ithatcap]*E->trace.number_of_tracer_quantities;
+ for (mm=0;mm<isize[j];mm++) {
+ receive[j][ithatcap][mm]=send[j][ithatcap][mm];
+ }
+
+ }
+
+ /* neighbor caps */
+
+ for (kk=1;kk<=num_ngb;kk++) {
+ idestination_proc=E->parallel.PROCESSOR[lev][j].pass[kk];
+
+ isize[j]=isend[j][kk]*E->trace.number_of_tracer_quantities;
+
+ MPI_Isend(send[j][kk],isize[j],MPI_DOUBLE,idestination_proc,
+ 11,E->parallel.world,&request[idb++]);
+
+ isize[j]=ireceive[j][kk]*E->trace.number_of_tracer_quantities;
+
+ MPI_Irecv(receive[j][kk],isize[j],MPI_DOUBLE,idestination_proc,
+ 11,E->parallel.world,&request[idb++]);
+
+ } /* end kk, number of neighbors */
+
+ /* Wait for non-blocking calls to complete */
+
+ MPI_Waitall(idb,request,status);
+
+
+ /* Put all received tracers in array REC[j] */
+ /* This makes things more convenient. */
+
+ /* Sum up size of receive arrays (all tracers sent to this processor) */
+
+ isum[j]=0;
+
+ ithiscap=0;
+
+ for (kk=0;kk<=num_ngb;kk++) {
+ isum[j]=isum[j]+ireceive[j][kk];
+ }
+
+ itracers_subject_to_vertical_transport[j]=isum[j];
+
+
+ /* Allocate Memory for REC array */
+
+ isize[j]=isum[j]*E->trace.number_of_tracer_quantities;
+ isize[j]=max(isize[j],1);
+ if ((REC[j]=(double *)malloc(isize[j]*sizeof(double)))==NULL) {
+ fprintf(E->trace.fpt,"Error(lost souls)-no memory (g323)\n");
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+
+
+ /* Put Received tracers in REC */
+ irec[j]=0;
+
+ irec_position=0;
+
+ for (kk=0;kk<=num_ngb;kk++) {
+
+ ithatcap=kk;
+
+ for (pp=0;pp<ireceive[j][ithatcap];pp++) {
+ irec[j]++;
+ ipos=pp*E->trace.number_of_tracer_quantities;
+
+ for (mm=0;mm<E->trace.number_of_tracer_quantities;mm++) {
+ ipos2=ipos+mm;
+ REC[j][irec_position]=receive[j][ithatcap][ipos2];
+
+ irec_position++;
+
+ } /* end mm (cycling tracer quantities) */
+ } /* end pp (cycling tracers) */
+ } /* end kk (cycling neighbors) */
+
+
+ /* Done filling REC */
+
+
+ /* VERTICAL COMMUNICATION */
+
+ if (E->parallel.nprocz>1) {
+
+ /* Allocate memory for send_z */
+ /* Make send_z the size of receive array (max size) */
+ /* (No dynamic reallocation of send_z necessary) */
+
+ for (kk=1;kk<=E->parallel.TNUM_PASSz[lev];kk++) {
+ isize[j]=itracers_subject_to_vertical_transport[j]*E->trace.number_of_tracer_quantities;
+ isize[j]=max(isize[j],1);
+
+ if ((send_z[j][kk]=(double *)malloc(isize[j]*sizeof(double)))==NULL) {
+ fprintf(E->trace.fpt,"Error(lost souls)-no memory (c721)\n");
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+ }
+
+
+ for (ivertical_neighbor=1;ivertical_neighbor<=E->parallel.TNUM_PASSz[lev];ivertical_neighbor++) {
+
+ ithat_processor=E->parallel.PROCESSORz[lev].pass[ivertical_neighbor];
+
+ /* initialize isend_z and ireceive_z array */
+
+ isend_z[j][ivertical_neighbor]=0;
+ ireceive_z[j][ivertical_neighbor]=0;
+
+ /* sort through receive array and check radius */
+
+ it=0;
+ num_tracers=irec[j];
+ for (kk=1;kk<=num_tracers;kk++) {
+
+ ireceive_position=it*E->trace.number_of_tracer_quantities;
+ it++;
+
+ irad=ireceive_position+2;
+
+ rad=REC[j][irad];
+
+ ival=icheck_that_processor_shell(E,j,ithat_processor,rad);
+
+
+ /* if tracer is in other shell, take out of receive array and give to send_z*/
+
+ if (ival==1) {
+
+
+ isend_position=isend_z[j][ivertical_neighbor]*E->trace.number_of_tracer_quantities;
+ isend_z[j][ivertical_neighbor]++;
+
+ ilast_receiver_position=(irec[j]-1)*E->trace.number_of_tracer_quantities;
+
+ for (mm=0;mm<=(E->trace.number_of_tracer_quantities-1);mm++) {
+ ipos=ireceive_position+mm;
+ ipos2=isend_position+mm;
+
+ send_z[j][ivertical_neighbor][ipos2]=REC[j][ipos];
+
+
+ /* eject tracer info from REC array, and replace with last tracer in array */
+
+ ipos3=ilast_receiver_position+mm;
+ REC[j][ipos]=REC[j][ipos3];
+
+ }
+
+ it--;
+ irec[j]--;
+
+ } /* end if ival===1 */
+
+ /* Otherwise, leave tracer */
+
+ } /* end kk (cycling through tracers) */
+
+ } /* end ivertical_neighbor */
+
+
+ /* Send arrays are now filled. */
+ /* Now send send information to vertical processor neighbor */
+ idb=0;
+ for (kk=1;kk<=E->parallel.TNUM_PASSz[lev];kk++) {
+
+ idestination_proc = E->parallel.PROCESSORz[lev].pass[kk];
+ MPI_Isend(&isend_z[j][kk],1,MPI_INT,idestination_proc,
+ 14,E->parallel.world,&request[idb++]);
+
+ MPI_Irecv(&ireceive_z[j][kk],1,MPI_INT,idestination_proc,
+ 14,E->parallel.world,&request[idb++]);
+
+ } /* end ivertical_neighbor */
+
+ /* Wait for non-blocking calls to complete */
+
+ MPI_Waitall(idb,request,status);
+
+
+ /** debug **
+ for (kk=1;kk<=E->parallel.TNUM_PASSz[lev];kk++) {
+ fprintf(E->trace.fpt, "PROC: %d IVN: %d (P: %d) "
+ "SEND: %d REC: %d\n",
+ E->parallel.me,kk,E->parallel.PROCESSORz[lev].pass[kk],
+ isend_z[j][kk],ireceive_z[j][kk]);
+ }
+ fflush(E->trace.fpt);
+ /**/
+
+
+ /* Allocate memory to receive_z arrays */
+
+
+ for (kk=1;kk<=E->parallel.TNUM_PASSz[lev];kk++) {
+ isize[j]=ireceive_z[j][kk]*E->trace.number_of_tracer_quantities;
+ isize[j]=max(isize[j],1);
+
+ if ((receive_z[j][kk]=(double *)malloc(isize[j]*sizeof(double)))==NULL) {
+ fprintf(E->trace.fpt,"Error(lost souls)-no memory (t590)\n");
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+ }
+
+ /* Send Tracers */
+
+ idb=0;
+ for (kk=1;kk<=E->parallel.TNUM_PASSz[lev];kk++) {
+
+ idestination_proc = E->parallel.PROCESSORz[lev].pass[kk];
+
+ isize_send=isend_z[j][kk]*E->trace.number_of_tracer_quantities;
+
+ MPI_Isend(send_z[j][kk],isize_send,MPI_DOUBLE,idestination_proc,
+ 15,E->parallel.world,&request[idb++]);
+
+ isize_receive=ireceive_z[j][kk]*E->trace.number_of_tracer_quantities;
+
+ MPI_Irecv(receive_z[j][kk],isize_receive,MPI_DOUBLE,idestination_proc,
+ 15,E->parallel.world,&request[idb++]);
+ }
+
+ /* Wait for non-blocking calls to complete */
+
+ MPI_Waitall(idb,request,status);
+
+
+ /* Put tracers into REC array */
+
+ /* First, reallocate memory to REC */
+
+ isum[j]=0;
+ for (ivertical_neighbor=1;ivertical_neighbor<=E->parallel.TNUM_PASSz[lev];ivertical_neighbor++) {
+ isum[j]=isum[j]+ireceive_z[j][ivertical_neighbor];
+ }
+
+ isum[j]=isum[j]+irec[j];
+
+ isize[j]=isum[j]*E->trace.number_of_tracer_quantities;
+
+ if (isize[j]>0) {
+ if ((REC[j]=(double *)realloc(REC[j],isize[j]*sizeof(double)))==NULL) {
+ fprintf(E->trace.fpt,"Error(lost souls)-no memory (i981)\n");
+ fprintf(E->trace.fpt,"isize: %d\n",isize[j]);
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+ }
+
+
+ for (ivertical_neighbor=1;ivertical_neighbor<=E->parallel.TNUM_PASSz[lev];ivertical_neighbor++) {
+
+ for (kk=0;kk<ireceive_z[j][ivertical_neighbor];kk++) {
+
+ irec_position=irec[j]*E->trace.number_of_tracer_quantities;
+ irec[j]++;
+ ireceive_position=kk*E->trace.number_of_tracer_quantities;
+
+ for (mm=0;mm<E->trace.number_of_tracer_quantities;mm++) {
+ REC[j][irec_position+mm]=receive_z[j][ivertical_neighbor][ireceive_position+mm];
+ }
+ }
+
+ }
+
+ /* Free Vertical Arrays */
+ for (ivertical_neighbor=1;ivertical_neighbor<=E->parallel.TNUM_PASSz[lev];ivertical_neighbor++) {
+ free(send_z[j][ivertical_neighbor]);
+ free(receive_z[j][ivertical_neighbor]);
+ }
+
+ } /* endif nprocz>1 */
+
+ /* END OF VERTICAL TRANSPORT */
+
+ /* Put away tracers */
+
+
+ for (kk=0;kk<irec[j];kk++) {
+ E->trace.ntracers[j]++;
+
+ if (E->trace.ntracers[j]>(E->trace.max_ntracers[j]-5)) expand_tracer_arrays(E,j);
+
+ ireceive_position=kk*E->trace.number_of_tracer_quantities;
+
+ for (mm=0;mm<E->trace.number_of_basic_quantities;mm++) {
+ ipos=ireceive_position+mm;
+
+ E->trace.basicq[j][mm][E->trace.ntracers[j]]=REC[j][ipos];
+ }
+ for (mm=0;mm<E->trace.number_of_extra_quantities;mm++) {
+ ipos=ireceive_position+E->trace.number_of_basic_quantities+mm;
+
+ E->trace.extraq[j][mm][E->trace.ntracers[j]]=REC[j][ipos];
+ }
+
+ theta=E->trace.basicq[j][0][E->trace.ntracers[j]];
+ phi=E->trace.basicq[j][1][E->trace.ntracers[j]];
+ rad=E->trace.basicq[j][2][E->trace.ntracers[j]];
+ x=E->trace.basicq[j][3][E->trace.ntracers[j]];
+ y=E->trace.basicq[j][4][E->trace.ntracers[j]];
+ z=E->trace.basicq[j][5][E->trace.ntracers[j]];
+
+
+ iel=(E->trace.iget_element)(E,j,-99,x,y,z,theta,phi,rad);
+
+ if (iel<1) {
+ fprintf(E->trace.fpt,"Error(lost souls) - element not here?\n");
+ fprintf(E->trace.fpt,"x,y,z-theta,phi,rad: %f %f %f - %f %f %f\n",x,y,z,theta,phi,rad);
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+
+ E->trace.ielement[j][E->trace.ntracers[j]]=iel;
+
+ }
+ if(E->control.verbose){
+ fprintf(E->trace.fpt,"Freeing memory in lost_souls()\n");
+ fflush(E->trace.fpt);
+ }
+ parallel_process_sync(E);
+
+ /* Free Arrays */
+
+ free(REC[j]);
+
+ for (kk=0;kk<=num_ngb;kk++) {
+ free(send[j][kk]);
+ free(receive[j][kk]);
+
+ }
+ if(E->control.verbose){
+ fprintf(E->trace.fpt,"Leaving lost_souls()\n");
+ fflush(E->trace.fpt);
+ }
+
+ E->trace.lost_souls_time += CPU_time0() - begin_time;
+ return;
+}
+
+
+static void full_put_lost_tracers(struct All_variables *E,
+ int isend[13][13], double *send[13][13])
+{
+ const int j = 1;
+ int kk, pp;
+ int numtracers, ithatcap, icheck;
+ int isend_position, ipos;
+ int lev = E->mesh.levmax;
+ double theta, phi, rad;
+ double x, y, z;
+
+ /* transfer tracers from rlater to send */
+
+ numtracers=E->trace.ilater[j];
+
+ for (kk=1;kk<=numtracers;kk++) {
+ rad=E->trace.rlater[j][2][kk];
+ x=E->trace.rlater[j][3][kk];
+ y=E->trace.rlater[j][4][kk];
+ z=E->trace.rlater[j][5][kk];
+
+ /* first check same cap if nprocz>1 */
+
+ if (E->parallel.nprocz>1) {
+ ithatcap=0;
+ icheck=full_icheck_cap(E,ithatcap,x,y,z,rad);
+ if (icheck==1) goto foundit;
+
+ }
+
+ /* check neighboring caps */
+
+ for (pp=1;pp<=E->parallel.TNUM_PASS[lev][j];pp++) {
+ ithatcap=pp;
+ icheck=full_icheck_cap(E,ithatcap,x,y,z,rad);
+ if (icheck==1) goto foundit;
+ }
+
+
+ /* should not be here */
+ if (icheck!=1) {
+ fprintf(E->trace.fpt,"Error(lost souls)-should not be here\n");
+ fprintf(E->trace.fpt,"x: %f y: %f z: %f rad: %f\n",x,y,z,rad);
+ icheck=full_icheck_cap(E,0,x,y,z,rad);
+ if (icheck==1) fprintf(E->trace.fpt," icheck here!\n");
+ else fprintf(E->trace.fpt,"icheck not here!\n");
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+
+ foundit:
+
+ isend[j][ithatcap]++;
+
+ /* assign tracer to send */
+
+ isend_position=(isend[j][ithatcap]-1)*E->trace.number_of_tracer_quantities;
+
+ for (pp=0;pp<=(E->trace.number_of_tracer_quantities-1);pp++) {
+ ipos=isend_position+pp;
+ send[j][ithatcap][ipos]=E->trace.rlater[j][pp][kk];
+ }
+
+ } /* end kk, assigning tracers */
+
+ return;
+}
+
+/************************ GET SHAPE FUNCTION *********************************/
+/* Real theta,phi,rad space is transformed into u,v space. This transformation */
+/* maps great circles into straight lines. Here, elements boundaries are */
+/* assumed to be great circle planes (not entirely true, it is actually only */
+/* the nodal arrangement that lies upon great circles). Element boundaries */
+/* are then mapped into planes. The element is then divided into 2 wedges */
+/* in which standard shape functions are used to interpolate velocity. */
+/* This transformation was found on the internet (refs were difficult to */
+/* to obtain). It was tested that nodal configuration is indeed transformed */
+/* into straight lines. */
+/* Radial and azimuthal shape functions are decoupled. First find the shape */
+/* functions associated with the 2D surface plane, then apply radial shape */
+/* functions. */
+/* */
+/* Wedge information: */
+/* */
+/* Wedge 1 Wedge 2 */
+/* _______ _______ */
+/* */
+/* wedge_node real_node wedge_node real_node */
+/* ---------- --------- ---------- --------- */
+/* */
+/* 1 1 1 1 */
+/* 2 2 2 3 */
+/* 3 3 3 4 */
+/* 4 5 4 5 */
+/* 5 6 5 7 */
+/* 6 7 6 8 */
+
+void full_get_shape_functions(struct All_variables *E,
+ double shp[9], int nelem,
+ double theta, double phi, double rad)
+{
+ const int j = 1;
+
+ int iwedge,inum;
+ int i, kk;
+ int ival;
+ int itry;
+
+ double u,v;
+ double shape2d[4];
+ double shaperad[3];
+ double shape[7];
+ double x,y,z;
+
+ int maxlevel=E->mesh.levmax;
+
+ const double eps=-1e-4;
+
+ /* find u and v using spherical coordinates */
+
+ spherical_to_uv(E,j,theta,phi,&u,&v);
+
+ inum=0;
+ itry=1;
+
+ try_again:
+
+ /* Check first wedge (1 of 2) */
+
+ iwedge=1;
+
+ next_wedge:
+
+ /* determine shape functions of wedge */
+ /* There are 3 shape functions for the triangular wedge */
+
+ get_2dshape(E,j,nelem,u,v,iwedge,shape2d);
+
+ /* if any shape functions are negative, goto next wedge */
+
+ if (shape2d[1]<eps||shape2d[2]<eps||shape2d[3]<eps)
+ {
+ inum=inum+1;
+ /* AKMA clean this up */
+ if (inum>3)
+ {
+ fprintf(E->trace.fpt,"ERROR(gnomonic_interpolation)-inum>3!\n");
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+ if (inum>1 && itry==1)
+ {
+ fprintf(E->trace.fpt,"ERROR(gnomonic_interpolation)-inum>1\n");
+ fprintf(E->trace.fpt,"shape %f %f %f\n",shape2d[1],shape2d[2],shape2d[3]);
+ fprintf(E->trace.fpt,"u %f v %f element: %d \n",u,v, nelem);
+ fprintf(E->trace.fpt,"Element uv boundaries: \n");
+ for(kk=1;kk<=4;kk++) {
+ i = (E->ien[j][nelem].node[kk] - 1) / E->lmesh.noz + 1;
+ fprintf(E->trace.fpt,"%d: U: %f V:%f\n",kk,E->gnomonic[i].u,E->gnomonic[i].v);
+ }
+ fprintf(E->trace.fpt,"theta: %f phi: %f rad: %f\n",theta,phi,rad);
+ fprintf(E->trace.fpt,"Element theta-phi boundaries: \n");
+ for(kk=1;kk<=4;kk++)
+ fprintf(E->trace.fpt,"%d: Theta: %f Phi:%f\n",kk,E->sx[j][1][E->ien[j][nelem].node[kk]],E->sx[j][2][E->ien[j][nelem].node[kk]]);
+ sphere_to_cart(E,theta,phi,rad,&x,&y,&z);
+ ival=icheck_element(E,j,nelem,x,y,z,rad);
+ fprintf(E->trace.fpt,"ICHECK?: %d\n",ival);
+ ival=(E->trace.iget_element)(E,j,-99,x,y,z,theta,phi,rad);
+ fprintf(E->trace.fpt,"New Element?: %d\n",ival);
+ ival=icheck_column_neighbors(E,j,nelem,x,y,z,rad);
+ fprintf(E->trace.fpt,"New Element (neighs)?: %d\n",ival);
+ nelem=ival;
+ ival=icheck_element(E,j,nelem,x,y,z,rad);
+ fprintf(E->trace.fpt,"ICHECK?: %d\n",ival);
+ itry++;
+ if (ival>0) goto try_again;
+ fprintf(E->trace.fpt,"NO LUCK\n");
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+
+ iwedge=2;
+ goto next_wedge;
+ }
+
+ /* Determine radial shape functions */
+ /* There are 2 shape functions radially */
+
+ get_radial_shape(E,j,nelem,rad,shaperad);
+
+ /* There are 6 nodes to the solid wedge. */
+ /* The 6 shape functions assocated with the 6 nodes */
+ /* are products of radial and wedge shape functions. */
+
+ /* Sum of shape functions is 1 */
+
+ shp[0]=iwedge;
+ shp[1]=shaperad[1]*shape2d[1];
+ shp[2]=shaperad[1]*shape2d[2];
+ shp[3]=shaperad[1]*shape2d[3];
+ shp[4]=shaperad[2]*shape2d[1];
+ shp[5]=shaperad[2]*shape2d[2];
+ shp[6]=shaperad[2]*shape2d[3];
+
+ /** debug **
+ fprintf(E->trace.fpt, "shp: %e %e %e %e %e %e\n",
+ shp[1], shp[2], shp[3], shp[4], shp[5], shp[6]);
+ /**/
+
+ return;
+}
+
+
+double full_interpolate_data(struct All_variables *E,
+ double shp[9], double data[9])
+{
+ int iwedge = (int)shp[0];
+
+ if (iwedge==1)
+ return data[1]*shp[1] + data[2]*shp[2] + data[3]*shp[3]
+ + data[5]*shp[4] + data[6]*shp[5] + data[7]*shp[6];
+
+ if (iwedge==2)
+ return data[1]*shp[1] + data[3]*shp[2] + data[4]*shp[3]
+ + data[5]*shp[4] + data[7]*shp[5] + data[8]*shp[6];
+
+ fprintf(stderr, "full_interpolate_data: shouldn't be here\n");
+ exit(2);
+}
+
+
+/************************ GET VELOCITY ***************************************/
+/* */
+/* This function interpolates tracer velocity using gnominic interpolation. */
+/* The element is divided into 2 wedges in which standard shape functions */
+/* are used to interpolate velocity. */
+/* */
+/* Wedge information: */
+/* */
+/* Wedge 1 Wedge 2 */
+/* _______ _______ */
+/* */
+/* wedge_node real_node wedge_node real_node */
+/* ---------- --------- ---------- --------- */
+/* */
+/* 1 1 1 1 */
+/* 2 2 2 3 */
+/* 3 3 3 4 */
+/* 4 5 4 5 */
+/* 5 6 5 7 */
+/* 6 7 6 8 */
+
+void full_get_velocity(struct All_variables *E,
+ int j, int nelem,
+ double theta, double phi, double rad,
+ double *velocity_vector)
+{
+ int iwedge;
+ const int sphere_key = 0;
+
+ double shape[9];
+ double VV[4][9];
+ double vx[7],vy[7],vz[7];
+
+ full_get_shape_functions(E, shape, nelem, theta, phi, rad);
+ iwedge=(int)shape[0];
+
+ /* get cartesian velocity */
+ velo_from_element_d(E, VV, j, nelem, sphere_key);
+
+ /* depending on wedge, set up velocity points */
+
+ if (iwedge==1)
+ {
+ vx[1]=VV[1][1];
+ vx[2]=VV[1][2];
+ vx[3]=VV[1][3];
+ vx[4]=VV[1][5];
+ vx[5]=VV[1][6];
+ vx[6]=VV[1][7];
+ vy[1]=VV[2][1];
+ vy[2]=VV[2][2];
+ vy[3]=VV[2][3];
+ vy[4]=VV[2][5];
+ vy[5]=VV[2][6];
+ vy[6]=VV[2][7];
+ vz[1]=VV[3][1];
+ vz[2]=VV[3][2];
+ vz[3]=VV[3][3];
+ vz[4]=VV[3][5];
+ vz[5]=VV[3][6];
+ vz[6]=VV[3][7];
+ }
+ if (iwedge==2)
+ {
+ vx[1]=VV[1][1];
+ vx[2]=VV[1][3];
+ vx[3]=VV[1][4];
+ vx[4]=VV[1][5];
+ vx[5]=VV[1][7];
+ vx[6]=VV[1][8];
+ vy[1]=VV[2][1];
+ vy[2]=VV[2][3];
+ vy[3]=VV[2][4];
+ vy[4]=VV[2][5];
+ vy[5]=VV[2][7];
+ vy[6]=VV[2][8];
+ vz[1]=VV[3][1];
+ vz[2]=VV[3][3];
+ vz[3]=VV[3][4];
+ vz[4]=VV[3][5];
+ vz[5]=VV[3][7];
+ vz[6]=VV[3][8];
+ }
+
+ velocity_vector[1]=vx[1]*shape[1]+vx[2]*shape[2]+shape[3]*vx[3]+
+ vx[4]*shape[4]+vx[5]*shape[5]+shape[6]*vx[6];
+ velocity_vector[2]=vy[1]*shape[1]+vy[2]*shape[2]+shape[3]*vy[3]+
+ vy[4]*shape[4]+vy[5]*shape[5]+shape[6]*vy[6];
+ velocity_vector[3]=vz[1]*shape[1]+vz[2]*shape[2]+shape[3]*vz[3]+
+ vz[4]*shape[4]+vz[5]*shape[5]+shape[6]*vz[6];
+
+
+
+ return;
+}
+
+/***************************************************************/
+/* GET 2DSHAPE */
+/* */
+/* This function determines shape functions at u,v */
+/* This method uses standard linear shape functions of */
+/* triangular elements. (See Cuvelier, Segal, and */
+/* van Steenhoven, 1986). */
+
+static void get_2dshape(struct All_variables *E,
+ int j, int nelem,
+ double u, double v,
+ int iwedge, double * shape2d)
+{
+
+ double a0,a1,a2;
+ /* convert nelem to surface element number */
+ int n = (nelem - 1) / E->lmesh.elz + 1;
+
+ /* shape function 1 */
+
+ a0=E->trace.shape_coefs[j][iwedge][1][n];
+ a1=E->trace.shape_coefs[j][iwedge][2][n];
+ a2=E->trace.shape_coefs[j][iwedge][3][n];
+
+ shape2d[1]=a0+a1*u+a2*v;
+
+ /* shape function 2 */
+
+ a0=E->trace.shape_coefs[j][iwedge][4][n];
+ a1=E->trace.shape_coefs[j][iwedge][5][n];
+ a2=E->trace.shape_coefs[j][iwedge][6][n];
+
+ shape2d[2]=a0+a1*u+a2*v;
+
+ /* shape function 3 */
+
+ a0=E->trace.shape_coefs[j][iwedge][7][n];
+ a1=E->trace.shape_coefs[j][iwedge][8][n];
+ a2=E->trace.shape_coefs[j][iwedge][9][n];
+
+ shape2d[3]=a0+a1*u+a2*v;
+
+ /** debug **
+ fprintf(E->trace.fpt, "el=%d els=%d iwedge=%d shape=(%e %e %e)\n",
+ nelem, n, iwedge, shape2d[1], shape2d[2], shape2d[3]);
+ /**/
+
+ return;
+}
+
+/***************************************************************/
+/* GET RADIAL SHAPE */
+/* */
+/* This function determines radial shape functions at rad */
+
+static void get_radial_shape(struct All_variables *E,
+ int j, int nelem,
+ double rad, double *shaperad)
+{
+
+ int node1,node5;
+ double rad1,rad5,f1,f2,delrad;
+
+ const double eps=1e-6;
+ double top_bound=1.0+eps;
+ double bottom_bound=0.0-eps;
+
+ node1=E->ien[j][nelem].node[1];
+ node5=E->ien[j][nelem].node[5];
+
+ rad1=E->sx[j][3][node1];
+ rad5=E->sx[j][3][node5];
+
+ delrad=rad5-rad1;
+
+ f1=(rad-rad1)/delrad;
+ f2=(rad5-rad)/delrad;
+
+ /* Save a small amount of computation here */
+ /* because f1+f2=1, shapes can be switched */
+ /*
+ shaperad[1]=1.0-f1=1.0-(1.0-f2)=f2;
+ shaperad[2]=1.0-f2=1.0-(10-f1)=f1;
+ */
+
+ shaperad[1]=f2;
+ shaperad[2]=f1;
+
+ /* Some error control */
+
+ if (shaperad[1]>(top_bound)||shaperad[1]<(bottom_bound)||
+ shaperad[2]>(top_bound)||shaperad[2]<(bottom_bound))
+ {
+ fprintf(E->trace.fpt,"ERROR(get_radial_shape)\n");
+ fprintf(E->trace.fpt,"shaperad[1]: %f \n",shaperad[1]);
+ fprintf(E->trace.fpt,"shaperad[2]: %f \n",shaperad[2]);
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+
+ return;
+}
+
+
+
+
+
+/**************************************************************/
+/* SPHERICAL TO UV */
+/* */
+/* This function transforms theta and phi to new coords */
+/* u and v using gnomonic projection. */
+
+static void spherical_to_uv(struct All_variables *E, int j,
+ double theta, double phi,
+ double *u, double *v)
+{
+ double phi_f;
+ double cosc;
+ double cos_theta_f,sin_theta_f;
+ double cost,sint,cosp2,sinp2;
+
+ /* theta_f and phi_f are the reference points of the cap */
+
+ phi_f = E->gnomonic_reference_phi;
+
+ cos_theta_f = E->gnomonic[0].u;
+ sin_theta_f = E->gnomonic[0].v;
+
+ cost=cos(theta);
+ /*
+ sint=sin(theta);
+ */
+ sint=sqrt(1.0-cost*cost);
+
+ cosp2=cos(phi-phi_f);
+ sinp2=sin(phi-phi_f);
+
+ cosc=cos_theta_f*cost+sin_theta_f*sint*cosp2;
+ cosc=1.0/cosc;
+
+ *u=sint*sinp2*cosc;
+ *v=(sin_theta_f*cost-cos_theta_f*sint*cosp2)*cosc;
+
+ /** debug **
+ fprintf(E->trace.fpt, "(%e %e) -> (%e %e)\n",
+ theta, phi, *u, *v);
+ /**/
+
+ return;
+}
+
+
+/*********** MAKE REGULAR GRID ********************************/
+/* */
+/* This function generates the finer regular grid which is */
+/* mapped to real elements */
+
+static void make_regular_grid(struct All_variables *E)
+{
+
+ int j;
+ int kk;
+ int mm;
+ int pp,node;
+ int numtheta,numphi;
+ int nodestheta,nodesphi;
+ unsigned int numregel;
+ unsigned int numregnodes;
+ int idum1,idum2;
+ int ifound_one;
+ int ival;
+ int ilast_el;
+ int imap;
+ int elz;
+ int nelsurf;
+ int iregnode[5];
+ int ntheta,nphi;
+ int ichoice;
+ int icount;
+ int itemp[5];
+ int iregel;
+ int istat_ichoice[13][5];
+ int isum;
+
+ double x,y,z;
+ double theta,phi,rad;
+ double deltheta;
+ double delphi;
+ double thetamax,thetamin;
+ double phimax,phimin;
+ double start_time;
+ double theta_min,phi_min;
+ double theta_max,phi_max;
+ double half_diff;
+ double expansion;
+
+ double *tmin;
+ double *tmax;
+ double *fmin;
+ double *fmax;
+
+ const double two_pi=2.0*M_PI;
+
+ elz=E->lmesh.elz;
+
+ nelsurf=E->lmesh.elx*E->lmesh.ely;
+
+ //TODO: find the bounding box of the mesh, if the box is too close to
+ // to core, set a flag (rotated_reggrid) to true and rotate the
+ // bounding box to the equator. Generate the regular grid with the new
+ // bounding box. The rotation should be a simple one, e.g.
+ // (theta, phi) -> (??)
+ // Whenever the regular grid is used, check the flat (rotated_reggrid),
+ // if true, rotate the checkpoint as well.
+
+ /* note, mesh is rotated along theta 22.5 degrees divided by elx. */
+ /* We at least want that much expansion here! Otherwise, theta min */
+ /* will not be valid near poles. We do a little more (x2) to be safe */
+ /* Typically 1-2 degrees. Look in nodal_mesh.c for this. */
+
+ expansion=2.0*0.5*(M_PI/4.0)/(1.0*E->lmesh.elx);
+
+ start_time=CPU_time0();
+
+ if (E->parallel.me==0) fprintf(stderr,"Generating Regular Grid\n");
+
+
+ /* for each cap, determine theta and phi bounds, watch out near poles */
+
+ numregnodes=0;
+ for(j=1;j<=E->sphere.caps_per_proc;j++)
+ {
+
+ thetamax=0.0;
+ thetamin=M_PI;
+
+ phimax=two_pi;
+ phimin=0.0;
+
+ for (kk=1;kk<=E->lmesh.nno;kk=kk+E->lmesh.noz)
+ {
+
+ theta=E->sx[j][1][kk];
+ phi=E->sx[j][2][kk];
+
+ thetamax=max(thetamax,theta);
+ thetamin=min(thetamin,theta);
+
+ }
+
+ /* expand range slightly (should take care of poles) */
+
+ thetamax=thetamax+expansion;
+ thetamax=min(thetamax,M_PI);
+
+ thetamin=thetamin-expansion;
+ thetamin=max(thetamin,0.0);
+
+ /* Convert input data from degrees to radians */
+
+ deltheta=E->trace.deltheta[0]*M_PI/180.0;
+ delphi=E->trace.delphi[0]*M_PI/180.0;
+
+
+ /* Adjust deltheta and delphi to fit a uniform number of regular elements */
+
+ numtheta=(int)(fabs(thetamax-thetamin)/deltheta);
+ numphi=(int)(fabs(phimax-phimin)/delphi);
+ nodestheta=numtheta+1;
+ nodesphi=numphi+1;
+ numregel=numtheta*numphi;
+ numregnodes=nodestheta*nodesphi;
+
+ if ((numtheta==0)||(numphi==0))
+ {
+ fprintf(E->trace.fpt,"Error(make_regular_grid): numtheta: %d numphi: %d\n",numtheta,numphi);
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+
+ deltheta=fabs(thetamax-thetamin)/(1.0*numtheta);
+ delphi=fabs(phimax-phimin)/(1.0*numphi);
+
+ /* fill global variables */
+
+ E->trace.deltheta[j]=deltheta;
+ E->trace.delphi[j]=delphi;
+ E->trace.numtheta[j]=numtheta;
+ E->trace.numphi[j]=numphi;
+ E->trace.thetamax[j]=thetamax;
+ E->trace.thetamin[j]=thetamin;
+ E->trace.phimax[j]=phimax;
+ E->trace.phimin[j]=phimin;
+ E->trace.numregel[j]=numregel;
+ E->trace.numregnodes[j]=numregnodes;
+
+ if ( ((1.0*numregel)/(1.0*E->lmesh.elx*E->lmesh.ely)) < 0.5 )
+ {
+ fprintf(E->trace.fpt,"\n ! WARNING: regular/real ratio low: %f ! \n",
+ ((1.0*numregel)/(1.0*E->lmesh.nel)) );
+ fprintf(E->trace.fpt," Should reduce size of regular mesh\n");
+ fprintf(stderr,"! WARNING: regular/real ratio low: %f ! \n",
+ ((1.0*numregel)/(1.0*E->lmesh.nel)) );
+ fprintf(stderr," Should reduce size of regular mesh\n");
+ fflush(E->trace.fpt);
+ if (E->trace.itracer_warnings) exit(10);
+ }
+
+ /* print some output */
+
+ fprintf(E->trace.fpt,"\nRegular grid:\n");
+ fprintf(E->trace.fpt,"Theta min: %f max: %f \n",thetamin,thetamax);
+ fprintf(E->trace.fpt,"Phi min: %f max: %f \n",phimin,phimax);
+ fprintf(E->trace.fpt,"Adjusted deltheta: %f delphi: %f\n",deltheta,delphi);
+ fprintf(E->trace.fpt,"(numtheta: %d numphi: %d)\n",numtheta,numphi);
+ fprintf(E->trace.fpt,"Number of regular elements: %d (nodes: %d)\n",numregel,numregnodes);
+
+ fprintf(E->trace.fpt,"regular/real ratio: %f\n",((1.0*numregel)/(1.0*E->lmesh.elx*E->lmesh.ely)));
+ fflush(E->trace.fpt);
+
+ /* Allocate memory for regnodetoel */
+ /* Regtoel is an integer array which represents nodes on */
+ /* the regular mesh. Each node on the regular mesh contains */
+ /* the real element value if one exists (-99 otherwise) */
+
+
+
+ if ((E->trace.regnodetoel[j]=(int *)malloc((numregnodes+1)*sizeof(int)))==NULL)
+ {
+ fprintf(E->trace.fpt,"ERROR(make regular) -no memory - uh3ud\n");
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+
+
+ /* Initialize regnodetoel - reg elements not used =-99 */
+
+ for (kk=1;kk<=numregnodes;kk++)
+ {
+ E->trace.regnodetoel[j][kk]=-99;
+ }
+
+ /* Begin Mapping (only need to use surface elements) */
+
+ parallel_process_sync(E);
+ if (E->parallel.me==0) fprintf(stderr,"Beginning Mapping\n");
+
+ /* Generate temporary arrays of max and min values for each surface element */
+
+
+ if ((tmin=(double *)malloc((nelsurf+1)*sizeof(double)))==NULL)
+ {
+ fprintf(E->trace.fpt,"ERROR(make regular) -no memory - 7t1a\n");
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+ if ((tmax=(double *)malloc((nelsurf+1)*sizeof(double)))==NULL)
+ {
+ fprintf(E->trace.fpt,"ERROR(make regular) -no memory - 7t1a\n");
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+ if ((fmin=(double *)malloc((nelsurf+1)*sizeof(double)))==NULL)
+ {
+ fprintf(E->trace.fpt,"ERROR(make regular) -no memory - 7t1a\n");
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+ if ((fmax=(double *)malloc((nelsurf+1)*sizeof(double)))==NULL)
+ {
+ fprintf(E->trace.fpt,"ERROR(make regular) -no memory - 7t1a\n");
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+
+ for (mm=elz;mm<=E->lmesh.nel;mm=mm+elz)
+ {
+
+ kk=mm/elz;
+
+ theta_min=M_PI;
+ theta_max=0.0;
+ phi_min=two_pi;
+ phi_max=0.0;
+ for (pp=1;pp<=4;pp++)
+ {
+ node=E->ien[j][mm].node[pp];
+ theta=E->sx[j][1][node];
+ phi=E->sx[j][2][node];
+
+ theta_min=min(theta_min,theta);
+ theta_max=max(theta_max,theta);
+ phi_min=min(phi_min,phi);
+ phi_max=max(phi_max,phi);
+ }
+
+ /* add half difference to phi and expansion to theta to be safe */
+
+ theta_max=theta_max+expansion;
+ theta_min=theta_min-expansion;
+
+ theta_max=min(M_PI,theta_max);
+ theta_min=max(0.0,theta_min);
+
+ half_diff=0.5*(phi_max-phi_min);
+ phi_max=phi_max+half_diff;
+ phi_min=phi_min-half_diff;
+
+ fix_angle(&phi_max);
+ fix_angle(&phi_min);
+
+ if (phi_min>phi_max)
+ {
+ phi_min=0.0;
+ phi_max=two_pi;
+ }
+
+ tmin[kk]=theta_min;
+ tmax[kk]=theta_max;
+ fmin[kk]=phi_min;
+ fmax[kk]=phi_max;
+ }
+
+ /* end looking through elements */
+
+ ifound_one=0;
+
+ rad=E->sphere.ro;
+
+ imap=0;
+
+ for (kk=1;kk<=numregnodes;kk++)
+ {
+
+ E->trace.regnodetoel[j][kk]=-99;
+
+ /* find theta and phi for a given regular node */
+
+ idum1=(kk-1)/(numtheta+1);
+ idum2=kk-1-idum1*(numtheta+1);
+
+ theta=thetamin+(1.0*idum2*deltheta);
+ phi=phimin+(1.0*idum1*delphi);
+
+ sphere_to_cart(E,theta,phi,rad,&x,&y,&z);
+
+
+ ilast_el=1;
+
+ /* if previous element not found yet, check all surface elements */
+
+ /*
+ if (ifound_one==0)
+ {
+ for (mm=elz;mm<=E->lmesh.nel;mm=mm+elz)
+ {
+ pp=mm/elz;
+ if ( (theta>=tmin[pp]) && (theta<=tmax[pp]) && (phi>=fmin[pp]) && (phi<=fmax[pp]) )
+ {
+ ival=icheck_element_column(E,j,mm,x,y,z,rad);
+ if (ival>0)
+ {
+ ilast_el=mm;
+ ifound_one++;
+ E->trace.regnodetoel[j][kk]=mm;
+ goto foundit;
+ }
+ }
+ }
+ goto foundit;
+ }
+ */
+
+ /* first check previous element */
+
+ ival=icheck_element_column(E,j,ilast_el,x,y,z,rad);
+ if (ival>0)
+ {
+ E->trace.regnodetoel[j][kk]=ilast_el;
+ goto foundit;
+ }
+
+ /* check neighbors */
+
+ ival=icheck_column_neighbors(E,j,ilast_el,x,y,z,rad);
+ if (ival>0)
+ {
+ E->trace.regnodetoel[j][kk]=ival;
+ ilast_el=ival;
+ goto foundit;
+ }
+
+ /* check all */
+
+ for (mm=elz;mm<=E->lmesh.nel;mm=mm+elz)
+ {
+ pp=mm/elz;
+ if ( (theta>=tmin[pp]) && (theta<=tmax[pp]) && (phi>=fmin[pp]) && (phi<=fmax[pp]) )
+ {
+ ival=icheck_element_column(E,j,mm,x,y,z,rad);
+ if (ival>0)
+ {
+ ilast_el=mm;
+ E->trace.regnodetoel[j][kk]=mm;
+ goto foundit;
+ }
+ }
+ }
+
+ foundit:
+
+ if (E->trace.regnodetoel[j][kk]>0) imap++;
+
+ } /* end all regular nodes (kk) */
+
+ fprintf(E->trace.fpt,"percentage mapped: %f\n", (1.0*imap)/(1.0*numregnodes)*100.0);
+ fflush(E->trace.fpt);
+
+ /* free temporary arrays */
+
+ free(tmin);
+ free(tmax);
+ free(fmin);
+ free(fmax);
+
+ } /* end j */
+
+
+ /* some error control */
+
+ for (j=1;j<=E->sphere.caps_per_proc;j++)
+ {
+ for (kk=1;kk<=numregnodes;kk++)
+ {
+
+ if (E->trace.regnodetoel[j][kk]!=-99)
+ {
+ if ( (E->trace.regnodetoel[j][kk]<1)||(E->trace.regnodetoel[j][kk]>E->lmesh.nel) )
+ {
+ fprintf(stderr,"Error(make_regular_grid)-invalid element: %d\n",E->trace.regnodetoel[j][kk]);
+ fprintf(E->trace.fpt,"Error(make_regular_grid)-invalid element: %d\n",E->trace.regnodetoel[j][kk]);
+ fflush(E->trace.fpt);
+ fflush(stderr);
+ exit(10);
+ }
+ }
+ }
+ }
+
+
+ /* Now put regnodetoel information into regtoel */
+
+
+ if (E->parallel.me==0) fprintf(stderr,"Beginning Regtoel submapping \n");
+
+ /* AKMA decided it would be more efficient to have reg element choice array */
+ /* rather than reg node array as used before */
+
+
+ for(j=1;j<=E->sphere.caps_per_proc;j++)
+ {
+
+ /* initialize statistical counter */
+
+ for (pp=0;pp<=4;pp++) istat_ichoice[j][pp]=0;
+
+ /* Allocate memory for regtoel */
+ /* Regtoel consists of 4 positions for each regular element */
+ /* Position[0] lists the number of element choices (later */
+ /* referred to as ichoice), followed */
+ /* by the possible element choices. */
+ /* ex.) A regular element has 4 nodes. Each node resides in */
+ /* a real element. The number of real elements a regular */
+ /* element touches (one of its nodes are in) is ichoice. */
+ /* Special ichoice notes: */
+ /* ichoice=-1 all regular element nodes = -99 (no elements) */
+ /* ichoice=0 all 4 corners within one element */
+ /* ichoice=1 one element choice (diff from ichoice 0 in */
+ /* that perhaps one reg node is in an element */
+ /* and the rest are not (-99). */
+ /* ichoice>1 Multiple elements to check */
+
+ numregel= E->trace.numregel[j];
+
+ for (pp=0;pp<=4;pp++)
+ {
+ if ((E->trace.regtoel[j][pp]=(int *)malloc((numregel+1)*sizeof(int)))==NULL)
+ {
+ fprintf(E->trace.fpt,"ERROR(make regular)-no memory 98d (%d %d %d)\n",pp,numregel,j);
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+ }
+
+ numtheta=E->trace.numtheta[j];
+ numphi=E->trace.numphi[j];
+
+ for (nphi=1;nphi<=numphi;nphi++)
+ {
+ for (ntheta=1;ntheta<=numtheta;ntheta++)
+ {
+
+ iregel=ntheta+(nphi-1)*numtheta;
+
+ /* initialize regtoel (not necessary really) */
+
+ for (pp=0;pp<=4;pp++) E->trace.regtoel[j][pp][iregel]=-33;
+
+ if ( (iregel>numregel)||(iregel<1) )
+ {
+ fprintf(E->trace.fpt,"ERROR(make_regular_grid)-weird iregel: %d (max: %d)\n",iregel,numregel);
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+
+ iregnode[1]=iregel+(nphi-1);
+ iregnode[2]=iregel+nphi;
+ iregnode[3]=iregel+nphi+E->trace.numtheta[j]+1;
+ iregnode[4]=iregel+nphi+E->trace.numtheta[j];
+
+ for (kk=1;kk<=4;kk++)
+ {
+ if ((iregnode[kk]<1)||(iregnode[kk]>numregnodes))
+ {
+ fprintf(E->trace.fpt,"ERROR(make regular)-bad regnode %d\n",iregnode[kk]);
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+ if (E->trace.regnodetoel[j][iregnode[kk]]>E->lmesh.nel)
+ {
+ fprintf(E->trace.fpt,"AABB HERE %d %d %d %d\n",iregel,iregnode[kk],kk,E->trace.regnodetoel[j][iregnode[kk]]);
+ fflush(E->trace.fpt);
+ }
+ }
+
+
+ /* find number of choices */
+
+ ichoice=0;
+ icount=0;
+
+ for (kk=1;kk<=4;kk++)
+ {
+
+ if (E->trace.regnodetoel[j][iregnode[kk]]<=0) goto next_corner;
+
+ icount++;
+ for (pp=1;pp<=(kk-1);pp++)
+ {
+ if (E->trace.regnodetoel[j][iregnode[kk]]==E->trace.regnodetoel[j][iregnode[pp]]) goto next_corner;
+ }
+ ichoice++;
+ itemp[ichoice]=E->trace.regnodetoel[j][iregnode[kk]];
+
+ if ((ichoice<0) || (ichoice>4) )
+ {
+ fprintf(E->trace.fpt,"ERROR(make regular) - weird ichoice %d \n",ichoice);
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+ if ((itemp[ichoice]<0) || (itemp[ichoice]>E->lmesh.nel) )
+ {
+ fprintf(E->trace.fpt,"ERROR(make regular) - weird element choice %d %d\n",itemp[ichoice],ichoice);
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+
+ next_corner:
+ ;
+ } /* end kk */
+
+ istat_ichoice[j][ichoice]++;
+
+ if ((ichoice<0) || (ichoice>4))
+ {
+ fprintf(E->trace.fpt,"ERROR(make_regular)-wierd ichoice %d\n",ichoice);
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+
+ if (ichoice==0)
+ {
+ E->trace.regtoel[j][0][iregel]=-1;
+ /*
+ fprintf(E->trace.fpt,"HH1: (%p) iregel: %d ichoice: %d value: %d %d\n",&E->trace.regtoel[j][1][iregel],iregel,ichoice,E->trace.regtoel[j][0][iregel],E->trace.regtoel[j][1][iregel]);
+ */
+ }
+ else if ( (ichoice==1) && (icount==4) )
+ {
+ E->trace.regtoel[j][0][iregel]=0;
+ E->trace.regtoel[j][1][iregel]=itemp[1];
+
+ /*
+ fprintf(E->trace.fpt,"HH2: (%p) iregel: %d ichoice: %d value: %d %d\n",&E->trace.regtoel[j][1][iregel],iregel,ichoice,E->trace.regtoel[j][0][iregel],E->trace.regtoel[j][1][iregel]);
+ */
+
+ if (itemp[1]<1 || itemp[1]>E->lmesh.nel)
+ {
+ fprintf(E->trace.fpt,"ERROR(make_regular)-huh? wierd itemp\n");
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+ }
+ else if ( (ichoice>0) && (ichoice<5) )
+ {
+ E->trace.regtoel[j][0][iregel]=ichoice;
+ for (pp=1;pp<=ichoice;pp++)
+ {
+ E->trace.regtoel[j][pp][iregel]=itemp[pp];
+
+ /*
+ fprintf(E->trace.fpt,"HH:(%p) iregel: %d ichoice: %d pp: %d value: %d %d\n",&E->trace.regtoel[j][pp][iregel],iregel,ichoice,pp,itemp[pp],E->trace.regtoel[j][pp][iregel]);
+ */
+ if (itemp[pp]<1 || itemp[pp]>E->lmesh.nel)
+ {
+ fprintf(E->trace.fpt,"ERROR(make_regular)-huh? wierd itemp 2 \n");
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+ }
+ }
+ else
+ {
+ fprintf(E->trace.fpt,"ERROR(make_regular)- should not be here! %d\n",ichoice);
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+ }
+ }
+
+ /* can now free regnodetoel */
+
+ free (E->trace.regnodetoel[j]);
+
+
+ /* testing */
+ for (kk=1;kk<=E->trace.numregel[j];kk++)
+ {
+ if ((E->trace.regtoel[j][0][kk]<-1)||(E->trace.regtoel[j][0][kk]>4))
+ {
+ fprintf(E->trace.fpt,"ERROR(make regular) regtoel ichoice0? %d %d \n",kk,E->trace.regtoel[j][pp][kk]);
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+ for (pp=1;pp<=4;pp++)
+ {
+ if (((E->trace.regtoel[j][pp][kk]<1)&&(E->trace.regtoel[j][pp][kk]!=-33))||(E->trace.regtoel[j][pp][kk]>E->lmesh.nel))
+ {
+ fprintf(E->trace.fpt,"ERROR(make regular) (%p) regtoel? %d %d(%d) %d\n",&E->trace.regtoel[j][pp][kk],kk,pp,E->trace.regtoel[j][0][kk],E->trace.regtoel[j][pp][kk]);
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+ }
+ }
+
+ } /* end j */
+
+
+ fprintf(E->trace.fpt,"Mapping completed (%f seconds)\n",CPU_time0()-start_time);
+ fflush(E->trace.fpt);
+
+ parallel_process_sync(E);
+
+ if (E->parallel.me==0) fprintf(stderr,"Mapping completed (%f seconds)\n",CPU_time0()-start_time);
+
+ /* Print out information regarding regular/real element coverage */
+
+ for (j=1;j<=E->sphere.caps_per_proc;j++)
+ {
+
+ isum=0;
+ for (kk=0;kk<=4;kk++) isum=isum+istat_ichoice[j][kk];
+ fprintf(E->trace.fpt,"\n\nInformation regarding number of real elements per regular elements\n");
+ fprintf(E->trace.fpt," (stats done on regular elements that were used)\n");
+ fprintf(E->trace.fpt,"Ichoice is number of real elements touched by a regular element\n");
+ fprintf(E->trace.fpt," (ichoice=0 is optimal)\n");
+ fprintf(E->trace.fpt,"Ichoice=0: %f percent\n",(100.0*istat_ichoice[j][0])/(1.0*isum));
+ fprintf(E->trace.fpt,"Ichoice=1: %f percent\n",(100.0*istat_ichoice[j][1])/(1.0*isum));
+ fprintf(E->trace.fpt,"Ichoice=2: %f percent\n",(100.0*istat_ichoice[j][2])/(1.0*isum));
+ fprintf(E->trace.fpt,"Ichoice=3: %f percent\n",(100.0*istat_ichoice[j][3])/(1.0*isum));
+ fprintf(E->trace.fpt,"Ichoice=4: %f percent\n",(100.0*istat_ichoice[j][4])/(1.0*isum));
+
+ } /* end j */
+
+
+ return;
+}
+
+
+/**** WRITE TRACE INSTRUCTIONS ***************/
+static void write_trace_instructions(struct All_variables *E)
+{
+ int i;
+
+ fprintf(E->trace.fpt,"\nTracing Activated! (proc: %d)\n",E->parallel.me);
+ fprintf(E->trace.fpt," Allen K. McNamara 12-2003\n\n");
+
+ if (E->trace.ic_method==0)
+ {
+ fprintf(E->trace.fpt,"Generating New Tracer Array\n");
+ fprintf(E->trace.fpt,"Tracers per element: %d\n",E->trace.itperel);
+ }
+ if (E->trace.ic_method==1)
+ {
+ fprintf(E->trace.fpt,"Reading tracer file %s\n",E->trace.tracer_file);
+ }
+ if (E->trace.ic_method==2)
+ {
+ fprintf(E->trace.fpt,"Reading individual tracer files\n");
+ }
+
+ fprintf(E->trace.fpt,"Number of tracer flavors: %d\n", E->trace.nflavors);
+
+ if (E->trace.nflavors && E->trace.ic_method==0) {
+ fprintf(E->trace.fpt,"Initialized tracer flavors by: %d\n", E->trace.ic_method_for_flavors);
+ if (E->trace.ic_method_for_flavors == 0) {
+ fprintf(E->trace.fpt,"Layered tracer flavors\n");
+ for (i=0; i<E->trace.nflavors-1; i++)
+ fprintf(E->trace.fpt,"Interface Height: %d %f\n",i,E->trace.z_interface[i]);
+ }
+#ifdef USE_GGRD
+ else if(E->trace.ic_method_for_flavors == 1) {
+ fprintf(E->trace.fpt,"netcdf grd assigned tracer flavors\n");
+ fprintf(E->trace.fpt,"file: %s top %i layeres\n",E->trace.ggrd_file,
+ E->trace.ggrd_layers);
+ }
+#endif
+ else {
+ fprintf(E->trace.fpt,"Sorry-This IC methods for Flavors are Unavailable %d\n",E->trace.ic_method_for_flavors);
+ fflush(E->trace.fpt);
+ parallel_process_termination();
+ }
+ }
+
+ for (i=0; i<E->trace.nflavors-2; i++) {
+ if (E->trace.z_interface[i] < E->trace.z_interface[i+1]) {
+ fprintf(E->trace.fpt,"Sorry - The %d-th z_interface is smaller than the next one.\n", i);
+ fflush(E->trace.fpt);
+ parallel_process_termination();
+ }
+ }
+
+
+
+ /* regular grid stuff */
+
+ fprintf(E->trace.fpt,"Regular Grid-> deltheta: %f delphi: %f\n",
+ E->trace.deltheta[0],E->trace.delphi[0]);
+
+
+
+
+ /* more obscure stuff */
+
+ fprintf(E->trace.fpt,"Box Cushion: %f\n",E->trace.box_cushion);
+ fprintf(E->trace.fpt,"Number of Basic Quantities: %d\n",
+ E->trace.number_of_basic_quantities);
+ fprintf(E->trace.fpt,"Number of Extra Quantities: %d\n",
+ E->trace.number_of_extra_quantities);
+ fprintf(E->trace.fpt,"Total Number of Tracer Quantities: %d\n",
+ E->trace.number_of_tracer_quantities);
+
+
+ /* analytical test */
+
+ if (E->trace.ianalytical_tracer_test==1)
+ {
+ fprintf(E->trace.fpt,"\n\n ! Analytical Test Being Performed ! \n");
+ fprintf(E->trace.fpt,"(some of the above parameters may not be used or applied\n");
+ fprintf(E->trace.fpt,"Velocity functions given in main code\n");
+ fflush(E->trace.fpt);
+ }
+
+ if (E->trace.itracer_warnings==0)
+ {
+ fprintf(E->trace.fpt,"\n WARNING EXITS ARE TURNED OFF! TURN THEM ON!\n");
+ fprintf(stderr,"\n WARNING EXITS ARE TURNED OFF! TURN THEM ON!\n");
+ fflush(E->trace.fpt);
+ }
+
+ write_composition_instructions(E);
+ return;
+}
+
+
+/********* ICHECK COLUMN NEIGHBORS ***************************/
+/* */
+/* This function check whether a point is in a neighboring */
+/* column. Neighbor surface element number is returned */
+
+static int icheck_column_neighbors(struct All_variables *E,
+ int j, int nel,
+ double x, double y, double z,
+ double rad)
+{
+
+ int ival;
+ int neighbor[25];
+ int elx,ely,elz;
+ int elxz;
+ int kk;
+
+ /*
+ const int number_of_neighbors=24;
+ */
+
+ /* maybe faster to only check inner ring */
+
+ const int number_of_neighbors=8;
+
+ elx=E->lmesh.elx;
+ ely=E->lmesh.ely;
+ elz=E->lmesh.elz;
+
+ elxz=elx*elz;
+
+ /* inner ring */
+
+ neighbor[1]=nel-elxz-elz;
+ neighbor[2]=nel-elxz;
+ neighbor[3]=nel-elxz+elz;
+ neighbor[4]=nel-elz;
+ neighbor[5]=nel+elz;
+ neighbor[6]=nel+elxz-elz;
+ neighbor[7]=nel+elxz;
+ neighbor[8]=nel+elxz+elz;
+
+ /* outer ring */
+
+ neighbor[9]=nel+2*elxz-elz;
+ neighbor[10]=nel+2*elxz;
+ neighbor[11]=nel+2*elxz+elz;
+ neighbor[12]=nel+2*elxz+2*elz;
+ neighbor[13]=nel+elxz+2*elz;
+ neighbor[14]=nel+2*elz;
+ neighbor[15]=nel-elxz+2*elz;
+ neighbor[16]=nel-2*elxz+2*elz;
+ neighbor[17]=nel-2*elxz+elz;
+ neighbor[18]=nel-2*elxz;
+ neighbor[19]=nel-2*elxz-elz;
+ neighbor[20]=nel-2*elxz-2*elz;
+ neighbor[21]=nel-elxz-2*elz;
+ neighbor[22]=nel-2*elz;
+ neighbor[23]=nel+elxz-2*elz;
+ neighbor[24]=nel+2*elxz-2*elz;
+
+
+ for (kk=1;kk<=number_of_neighbors;kk++)
+ {
+
+ if ((neighbor[kk]>=1)&&(neighbor[kk]<=E->lmesh.nel))
+ {
+ ival=icheck_element_column(E,j,neighbor[kk],x,y,z,rad);
+ if (ival>0)
+ {
+ return neighbor[kk];
+ }
+ }
+ }
+
+ return -99;
+}
+
+
+/********** ICHECK ALL COLUMNS ********************************/
+/* */
+/* This function check all columns until the proper one for */
+/* a point (x,y,z) is found. The surface element is returned */
+/* else -99 if can't be found. */
+
+static int icheck_all_columns(struct All_variables *E,
+ int j,
+ double x, double y, double z,
+ double rad)
+{
+
+ int icheck;
+ int nel;
+
+ int elz=E->lmesh.elz;
+ int numel=E->lmesh.nel;
+
+ for (nel=elz;nel<=numel;nel=nel+elz)
+ {
+ icheck=icheck_element_column(E,j,nel,x,y,z,rad);
+ if (icheck==1)
+ {
+ return nel;
+ }
+ }
+
+
+ return -99;
+}
+
+
+/******* ICHECK ELEMENT *************************************/
+/* */
+/* This function serves to determine if a point lies within */
+/* a given element */
+
+static int icheck_element(struct All_variables *E,
+ int j, int nel,
+ double x, double y, double z,
+ double rad)
+{
+
+ int icheck;
+
+ icheck=icheck_shell(E,nel,rad);
+ if (icheck==0)
+ {
+ return 0;
+ }
+
+ icheck=icheck_element_column(E,j,nel,x,y,z,rad);
+ if (icheck==0)
+ {
+ return 0;
+ }
+
+
+ return 1;
+}
+
+
+/******** ICHECK SHELL ************************************/
+/* */
+/* This function serves to check whether a point lies */
+/* within the proper radial shell of a given element */
+/* note: j set to 1; shouldn't depend on cap */
+
+static int icheck_shell(struct All_variables *E,
+ int nel, double rad)
+{
+
+ int ival;
+ int ibottom_node;
+ int itop_node;
+
+ double bottom_rad;
+ double top_rad;
+
+
+ ibottom_node=E->ien[1][nel].node[1];
+ itop_node=E->ien[1][nel].node[5];
+
+ bottom_rad=E->sx[1][3][ibottom_node];
+ top_rad=E->sx[1][3][itop_node];
+
+ ival=0;
+ if ((rad>=bottom_rad)&&(rad<top_rad)) ival=1;
+
+ return ival;
+}
+
+/******** ICHECK ELEMENT COLUMN ****************************/
+/* */
+/* This function serves to determine if a point lies within */
+/* a given element's column */
+
+static int icheck_element_column(struct All_variables *E,
+ int j, int nel,
+ double x, double y, double z,
+ double rad)
+{
+
+ double test_point[4];
+ double rnode[5][10];
+
+ int lev = E->mesh.levmax;
+ int ival;
+ int kk;
+ int node;
+
+
+ E->trace.istat_elements_checked++;
+
+ /* surface coords of element nodes */
+
+ for (kk=1;kk<=4;kk++)
+ {
+
+ node=E->ien[j][nel].node[kk+4];
+
+ rnode[kk][1]=E->x[j][1][node];
+ rnode[kk][2]=E->x[j][2][node];
+ rnode[kk][3]=E->x[j][3][node];
+
+ rnode[kk][4]=E->sx[j][1][node];
+ rnode[kk][5]=E->sx[j][2][node];
+
+ rnode[kk][6]=E->SinCos[lev][j][2][node]; /* cos(theta) */
+ rnode[kk][7]=E->SinCos[lev][j][0][node]; /* sin(theta) */
+ rnode[kk][8]=E->SinCos[lev][j][3][node]; /* cos(phi) */
+ rnode[kk][9]=E->SinCos[lev][j][1][node]; /* sin(phi) */
+
+ }
+
+ /* test_point - project to outer radius */
+
+ test_point[1]=x/rad;
+ test_point[2]=y/rad;
+ test_point[3]=z/rad;
+
+ ival=icheck_bounds(E,test_point,rnode[1],rnode[2],rnode[3],rnode[4]);
+
+
+ return ival;
+}
+
+
+/********* ICHECK CAP ***************************************/
+/* */
+/* This function serves to determine if a point lies within */
+/* a given cap */
+/* */
+int full_icheck_cap(struct All_variables *E, int icap,
+ double x, double y, double z, double rad)
+{
+
+ double test_point[4];
+ double rnode[5][10];
+
+ int ival;
+ int kk;
+
+ /* surface coords of cap nodes */
+
+
+ for (kk=1;kk<=4;kk++)
+ {
+
+ rnode[kk][1]=E->trace.xcap[icap][kk];
+ rnode[kk][2]=E->trace.ycap[icap][kk];
+ rnode[kk][3]=E->trace.zcap[icap][kk];
+ rnode[kk][4]=E->trace.theta_cap[icap][kk];
+ rnode[kk][5]=E->trace.phi_cap[icap][kk];
+ rnode[kk][6]=E->trace.cos_theta[icap][kk];
+ rnode[kk][7]=E->trace.sin_theta[icap][kk];
+ rnode[kk][8]=E->trace.cos_phi[icap][kk];
+ rnode[kk][9]=E->trace.sin_phi[icap][kk];
+ }
+
+
+ /* test_point - project to outer radius */
+
+ test_point[1]=x/rad;
+ test_point[2]=y/rad;
+ test_point[3]=z/rad;
+
+ ival=icheck_bounds(E,test_point,rnode[1],rnode[2],rnode[3],rnode[4]);
+
+
+ return ival;
+}
+
+/***** ICHECK BOUNDS ******************************/
+/* */
+/* This function check if a test_point is bounded */
+/* by 4 nodes */
+/* This is done by: */
+/* 1) generate vectors from node to node */
+/* 2) generate vectors from each node to point */
+/* in question */
+/* 3) for each node, take cross product of vector */
+/* pointing to it from previous node and */
+/* vector from node to point in question */
+/* 4) Find radial components of all the cross */
+/* products. */
+/* 5) If all radial components are positive, */
+/* point is bounded by the 4 nodes */
+/* 6) If some radial components are negative */
+/* point is on a boundary - adjust it an */
+/* epsilon amount for this analysis only */
+/* which will force it to lie in one element */
+/* or cap */
+
+static int icheck_bounds(struct All_variables *E,
+ double *test_point,
+ double *rnode1, double *rnode2,
+ double *rnode3, double *rnode4)
+{
+
+ int number_of_tries=0;
+ int icheck;
+
+ double v12[4];
+ double v23[4];
+ double v34[4];
+ double v41[4];
+ double v1p[4];
+ double v2p[4];
+ double v3p[4];
+ double v4p[4];
+ double cross1[4];
+ double cross2[4];
+ double cross3[4];
+ double cross4[4];
+ double rad1,rad2,rad3,rad4;
+ double theta, phi;
+ double tiny, eps;
+ double x,y,z;
+
+ /* make vectors from node to node */
+
+ makevector(v12,rnode2[1],rnode2[2],rnode2[3],rnode1[1],rnode1[2],rnode1[3]);
+ makevector(v23,rnode3[1],rnode3[2],rnode3[3],rnode2[1],rnode2[2],rnode2[3]);
+ makevector(v34,rnode4[1],rnode4[2],rnode4[3],rnode3[1],rnode3[2],rnode3[3]);
+ makevector(v41,rnode1[1],rnode1[2],rnode1[3],rnode4[1],rnode4[2],rnode4[3]);
+
+ try_again:
+
+ number_of_tries++;
+
+ /* make vectors from test point to node */
+
+ makevector(v1p,test_point[1],test_point[2],test_point[3],rnode1[1],rnode1[2],rnode1[3]);
+ makevector(v2p,test_point[1],test_point[2],test_point[3],rnode2[1],rnode2[2],rnode2[3]);
+ makevector(v3p,test_point[1],test_point[2],test_point[3],rnode3[1],rnode3[2],rnode3[3]);
+ makevector(v4p,test_point[1],test_point[2],test_point[3],rnode4[1],rnode4[2],rnode4[3]);
+
+ /* Calculate cross products */
+
+ crossit(cross2,v12,v2p);
+ crossit(cross3,v23,v3p);
+ crossit(cross4,v34,v4p);
+ crossit(cross1,v41,v1p);
+
+ /* Calculate radial component of cross products */
+
+ rad1=findradial(E,cross1,rnode1[6],rnode1[7],rnode1[8],rnode1[9]);
+ rad2=findradial(E,cross2,rnode2[6],rnode2[7],rnode2[8],rnode2[9]);
+ rad3=findradial(E,cross3,rnode3[6],rnode3[7],rnode3[8],rnode3[9]);
+ rad4=findradial(E,cross4,rnode4[6],rnode4[7],rnode4[8],rnode4[9]);
+
+ /* Check if any radial components is zero (along a boundary), adjust if so */
+ /* Hopefully, this doesn't happen often, may be expensive */
+
+ tiny=1e-15;
+ eps=1e-6;
+
+ if (number_of_tries>3)
+ {
+ fprintf(E->trace.fpt,"Error(icheck_bounds)-too many tries\n");
+ fprintf(E->trace.fpt,"Rads: %f %f %f %f\n",rad1,rad2,rad3,rad4);
+ fprintf(E->trace.fpt,"Test Point: %f %f %f \n",test_point[1],test_point[2],test_point[3]);
+ fprintf(E->trace.fpt,"Nodal points: 1: %f %f %f\n",rnode1[1],rnode1[2],rnode1[3]);
+ fprintf(E->trace.fpt,"Nodal points: 2: %f %f %f\n",rnode2[1],rnode2[2],rnode2[3]);
+ fprintf(E->trace.fpt,"Nodal points: 3: %f %f %f\n",rnode3[1],rnode3[2],rnode3[3]);
+ fprintf(E->trace.fpt,"Nodal points: 4: %f %f %f\n",rnode4[1],rnode4[2],rnode4[3]);
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+
+ if (fabs(rad1)<=tiny||fabs(rad2)<=tiny||fabs(rad3)<=tiny||fabs(rad4)<=tiny)
+ {
+ x=test_point[1];
+ y=test_point[2];
+ z=test_point[3];
+ theta=myatan(sqrt(x*x+y*y),z);
+ phi=myatan(y,x);
+
+ if (theta<=M_PI/2.0)
+ {
+ theta=theta+eps;
+ }
+ else
+ {
+ theta=theta-eps;
+ }
+ phi=phi+eps;
+ x=sin(theta)*cos(phi);
+ y=sin(theta)*sin(phi);
+ z=cos(theta);
+ test_point[1]=x;
+ test_point[2]=y;
+ test_point[3]=z;
+
+ number_of_tries++;
+ goto try_again;
+
+ }
+
+ icheck=0;
+ if (rad1>0.0&&rad2>0.0&&rad3>0.0&&rad4>0.0) icheck=1;
+
+ /*
+ fprintf(stderr,"%d: icheck: %d\n",E->parallel.me,icheck);
+ fprintf(stderr,"%d: rads: %f %f %f %f\n",E->parallel.me,rad1,rad2,rad3,rad4);
+ */
+
+ return icheck;
+
+}
+
+/****************************************************************************/
+/* FINDRADIAL */
+/* */
+/* This function finds the radial component of a Cartesian vector */
+
+static double findradial(struct All_variables *E, double *vec,
+ double cost, double sint,
+ double cosf, double sinf)
+{
+ double radialparti,radialpartj,radialpartk;
+ double radial;
+
+ radialparti=vec[1]*sint*cosf;
+ radialpartj=vec[2]*sint*sinf;
+ radialpartk=vec[3]*cost;
+
+ radial=radialparti+radialpartj+radialpartk;
+
+
+ return radial;
+}
+
+
+/******************MAKEVECTOR*********************************************************/
+
+static void makevector(double *vec, double xf, double yf, double zf,
+ double x0, double y0, double z0)
+{
+
+ vec[1]=xf-x0;
+ vec[2]=yf-y0;
+ vec[3]=zf-z0;
+
+
+ return;
+}
+
+/********************CROSSIT********************************************************/
+
+static void crossit(double *cross, double *A, double *B)
+{
+
+ cross[1]=A[2]*B[3]-A[3]*B[2];
+ cross[2]=A[3]*B[1]-A[1]*B[3];
+ cross[3]=A[1]*B[2]-A[2]*B[1];
+
+
+ return;
+}
+
+
+/************ FIX RADIUS ********************************************/
+/* This function moves particles back in bounds if they left */
+/* during advection */
+
+static void fix_radius(struct All_variables *E,
+ double *radius, double *theta, double *phi,
+ double *x, double *y, double *z)
+{
+ double sint,cost,sinf,cosf,rad;
+ double max_radius, min_radius;
+
+ max_radius = E->sphere.ro - E->trace.box_cushion;
+ min_radius = E->sphere.ri + E->trace.box_cushion;
+
+ if (*radius > max_radius) {
+ *radius=max_radius;
+ rad=max_radius;
+ cost=cos(*theta);
+ sint=sqrt(1.0-cost*cost);
+ cosf=cos(*phi);
+ sinf=sin(*phi);
+ *x=rad*sint*cosf;
+ *y=rad*sint*sinf;
+ *z=rad*cost;
+ }
+ if (*radius < min_radius) {
+ *radius=min_radius;
+ rad=min_radius;
+ cost=cos(*theta);
+ sint=sqrt(1.0-cost*cost);
+ cosf=cos(*phi);
+ sinf=sin(*phi);
+ *x=rad*sint*cosf;
+ *y=rad*sint*sinf;
+ *z=rad*cost;
+ }
+
+ return;
+}
+
+
+/******************************************************************/
+/* FIX ANGLE */
+/* */
+/* This function constrains the value of angle to be */
+/* between 0 and 2 PI */
+/* */
+
+static void fix_angle(double *angle)
+{
+ const double two_pi = 2.0*M_PI;
+
+ double d2 = floor(*angle / two_pi);
+
+ *angle -= two_pi * d2;
+
+ return;
+}
+
+/******************************************************************/
+/* FIX THETA PHI */
+/* */
+/* This function constrains the value of theta to be */
+/* between 0 and PI, and */
+/* this function constrains the value of phi to be */
+/* between 0 and 2 PI */
+/* */
+static void fix_theta_phi(double *theta, double *phi)
+{
+ const double two_pi=2.0*M_PI;
+
+ fix_angle(theta);
+
+ if (*theta > M_PI) {
+ *theta = two_pi - *theta;
+ *phi += M_PI;
+ }
+
+ fix_angle(phi);
+
+ return;
+}
+
+/********** IGET ELEMENT *****************************************/
+/* */
+/* This function returns the the real element for a given point. */
+/* Returns -99 if not in this cap. */
+/* iprevious_element, if known, is the last known element. If */
+/* it is not known, input a negative number. */
+
+int full_iget_element(struct All_variables *E,
+ int j, int iprevious_element,
+ double x, double y, double z,
+ double theta, double phi, double rad)
+{
+ int iregel;
+ int iel;
+ int ntheta,nphi;
+ int ival;
+ int ichoice;
+ int kk;
+ int ineighbor;
+ int icorner[5];
+ int elx,ely,elz,elxz;
+ int ifinal_iel;
+ int nelem;
+
+ elx=E->lmesh.elx;
+ ely=E->lmesh.ely;
+ elz=E->lmesh.elz;
+
+
+ ntheta=0;
+ nphi=0;
+
+ /* check the radial range */
+ if (E->parallel.nprocz>1)
+ {
+ ival=icheck_processor_shell(E,j,rad);
+ if (ival!=1) return -99;
+ }
+
+ /* do quick search to see if element can be easily found. */
+ /* note that element may still be out of this cap, but */
+ /* it is probably fast to do a quick search before */
+ /* checking cap */
+
+
+ /* get regular element number */
+
+ iregel=iget_regel(E,j,theta,phi,&ntheta,&nphi);
+ if (iregel<=0)
+ {
+ return -99;
+ }
+
+
+ /* AKMA put safety here or in make grid */
+
+ if (E->trace.regtoel[j][0][iregel]==0)
+ {
+ iel=E->trace.regtoel[j][1][iregel];
+ goto foundit;
+ }
+
+ /* first check previous element */
+
+ if (iprevious_element>0)
+ {
+ ival=icheck_element_column(E,j,iprevious_element,x,y,z,rad);
+ if (ival==1)
+ {
+ iel=iprevious_element;
+ goto foundit;
+ }
+ }
+
+ /* Check all regular mapping choices */
+
+ ichoice=0;
+ if (E->trace.regtoel[j][0][iregel]>0)
+ {
+
+ ichoice=E->trace.regtoel[j][0][iregel];
+ for (kk=1;kk<=ichoice;kk++)
+ {
+ nelem=E->trace.regtoel[j][kk][iregel];
+
+ if (nelem!=iprevious_element)
+ {
+ ival=icheck_element_column(E,j,nelem,x,y,z,rad);
+ if (ival==1)
+ {
+ iel=nelem;
+ goto foundit;
+ }
+
+ }
+ }
+ }
+
+ /* If here, it means that tracer could not be found quickly with regular element map */
+
+ /* First check previous element neighbors */
+
+ if (iprevious_element>0)
+ {
+ iel=icheck_column_neighbors(E,j,iprevious_element,x,y,z,rad);
+ if (iel>0)
+ {
+ goto foundit;
+ }
+ }
+
+ /* check if still in cap */
+
+ ival=full_icheck_cap(E,0,x,y,z,rad);
+ if (ival==0)
+ {
+ return -99;
+ }
+
+ /* if here, still in cap (hopefully, without a doubt) */
+
+ /* check cap corners (they are sometimes tricky) */
+
+ elxz=elx*elz;
+ icorner[1]=elz;
+ icorner[2]=elxz;
+ icorner[3]=elxz*(ely-1)+elz;
+ icorner[4]=elxz*ely;
+ for (kk=1;kk<=4;kk++)
+ {
+ ival=icheck_element_column(E,j,icorner[kk],x,y,z,rad);
+ if (ival>0)
+ {
+ iel=icorner[kk];
+ goto foundit;
+ }
+ }
+
+
+ /* if previous element is not known, check neighbors of those tried in iquick... */
+
+ if (iprevious_element<0)
+ {
+ if (ichoice>0)
+ {
+ for (kk=1;kk<=ichoice;kk++)
+ {
+ ineighbor=E->trace.regtoel[j][kk][iregel];
+ iel=icheck_column_neighbors(E,j,ineighbor,x,y,z,rad);
+ if (iel>0)
+ {
+ goto foundit;
+ }
+ }
+ }
+
+ }
+
+ /* As a last resort, check all element columns */
+
+ E->trace.istat1++;
+
+ iel=icheck_all_columns(E,j,x,y,z,rad);
+
+ /*
+ fprintf(E->trace.fpt,"WARNING(full_iget_element)-doing a full search!\n");
+ fprintf(E->trace.fpt," Most often means tracers have moved more than 1 element away\n");
+ fprintf(E->trace.fpt," or regular element resolution is way too low.\n");
+ fprintf(E->trace.fpt," COLUMN: %d \n",iel);
+ fprintf(E->trace.fpt," PREVIOUS ELEMENT: %d \n",iprevious_element);
+ fprintf(E->trace.fpt," x,y,z,theta,phi,rad: %f %f %f %f %f %f\n",x,y,z,theta,phi,rad);
+ fflush(E->trace.fpt);
+ if (E->trace.itracer_warnings) exit(10);
+ */
+
+ if (E->trace.istat1%100==0)
+ {
+ fprintf(E->trace.fpt,"Checked all elements %d times already this turn\n",E->trace.istat1);
+ fflush(E->trace.fpt);
+ }
+ if (iel>0)
+ {
+ goto foundit;
+ }
+
+
+ /* if still here, there is a problem */
+
+ fprintf(E->trace.fpt,"Error(full_iget_element) - element not found\n");
+ fprintf(E->trace.fpt,"x,y,z,theta,phi,iregel %.15e %.15e %.15e %.15e %.15e %d\n",
+ x,y,z,theta,phi,iregel);
+ fflush(E->trace.fpt);
+ exit(10);
+
+ foundit:
+
+ /* find radial element */
+
+ ifinal_iel=iget_radial_element(E,j,iel,rad);
+
+ return ifinal_iel;
+}
+
+
+/***** IGET RADIAL ELEMENT ***********************************/
+/* */
+/* This function returns the proper radial element, given */
+/* an element (iel) from the column. */
+
+static int iget_radial_element(struct All_variables *E,
+ int j, int iel,
+ double rad)
+{
+
+ int elz=E->lmesh.elz;
+ int ibottom_element;
+ int iradial_element;
+ int node;
+ int kk;
+ int idum;
+
+ double top_rad;
+
+ /* first project to the lowest element in the column */
+
+ idum=(iel-1)/elz;
+ ibottom_element=idum*elz+1;
+
+ iradial_element=ibottom_element;
+
+ for (kk=1;kk<=elz;kk++)
+ {
+
+ node=E->ien[j][iradial_element].node[8];
+ top_rad=E->sx[j][3][node];
+
+ if (rad<top_rad) goto found_it;
+
+ iradial_element++;
+
+ } /* end kk */
+
+
+ /* should not be here */
+
+ fprintf(E->trace.fpt,"Error(iget_radial_element)-out of range %f %d %d %d\n",rad,j,iel,ibottom_element);
+ fflush(E->trace.fpt);
+ exit(10);
+
+ found_it:
+
+ return iradial_element;
+}
+
+
+/*********** IGET REGEL ******************************************/
+/* */
+/* This function returns the regular element in which a point */
+/* exists. If not found, returns -99. */
+/* npi and ntheta are modified for later use */
+
+static int iget_regel(struct All_variables *E, int j,
+ double theta, double phi,
+ int *ntheta, int *nphi)
+{
+
+ int iregel;
+ int idum;
+
+ double rdum;
+
+ /* first check whether theta is in range */
+
+ if (theta<E->trace.thetamin[j]) return -99;
+ if (theta>E->trace.thetamax[j]) return -99;
+
+ /* get ntheta, nphi on regular mesh */
+
+ rdum=theta-E->trace.thetamin[j];
+ idum=(int)(rdum/E->trace.deltheta[j]);
+ *ntheta=idum+1;
+
+ rdum=phi-E->trace.phimin[j];
+ idum=(int)(rdum/E->trace.delphi[j]);
+ *nphi=idum+1;
+
+ iregel=*ntheta+(*nphi-1)*E->trace.numtheta[j];
+
+ /* check range to be sure */
+
+ if (iregel>E->trace.numregel[j]) return -99;
+ if (iregel<1) return -99;
+
+ return iregel;
+}
+
+
+
+/****************************************************************/
+/* DEFINE UV SPACE */
+/* */
+/* This function defines nodal points as orthodrome coordinates */
+/* u and v. In uv space, great circles form straight lines. */
+/* This is used for interpolation method 1 */
+/* E->gnomonic[node].u = u */
+/* E->gnomonic[node].v = v */
+
+static void define_uv_space(struct All_variables *E)
+{
+ const int j = 1;
+ const int lev = E->mesh.levmax;
+ int refnode;
+ int i, n;
+
+ double u, v, cosc, theta_f, phi_f, dphi, cosd;
+ double *cost, *sint, *cosf, *sinf;
+
+ if ((E->gnomonic = (struct CITCOM_GNOMONIC *)malloc((E->lmesh.nsf+1)*sizeof(struct CITCOM_GNOMONIC)))
+ == NULL) {
+ fprintf(stderr,"Error(define uv)-not enough memory(a)\n");
+ exit(10);
+ }
+
+ sint = E->SinCos[lev][j][0];
+ sinf = E->SinCos[lev][j][1];
+ cost = E->SinCos[lev][j][2];
+ cosf = E->SinCos[lev][j][3];
+
+ /* uv space requires a reference point */
+ /* use the point at middle of the cap */
+ refnode = 1 + E->lmesh.noz * ((E->lmesh.noy / 2) * E->lmesh.nox
+ + E->lmesh.nox / 2);
+ phi_f = E->gnomonic_reference_phi = E->sx[j][2][refnode];
+
+ /** debug **
+ theta_f = E->sx[j][1][refnode];
+ for (i=1; i<=E->lmesh.nsf; i++) {
+ fprintf(E->trace.fpt, "i=%d (%e %e %e %e)\n",
+ i, sint[i], sinf[i], cost[i], cosf[i]);
+ }
+ fprintf(E->trace.fpt, "%d %d %d ref=(%e %e)\n",
+ E->lmesh.noz, E->lmesh.nsf, refnode, theta_f, phi_f);
+ /**/
+
+ /* store cos(theta_f) and sin(theta_f) */
+ E->gnomonic[0].u = cost[refnode];
+ E->gnomonic[0].v = sint[refnode];
+
+
+ /* convert each nodal point to u and v */
+
+ for (i=1, n=1; i<=E->lmesh.nsf; i++, n+=E->lmesh.noz) {
+ dphi = E->sx[j][2][n] - phi_f;
+ cosd = cos(dphi);
+ cosc = cost[refnode] * cost[n] + sint[refnode] * sint[n] * cosd;
+ u = sint[n] * sin(dphi) / cosc;
+ v = (sint[refnode] * cost[n] - cost[refnode] * sint[n] * cosd)
+ / cosc;
+
+ E->gnomonic[i].u = u;
+ E->gnomonic[i].v = v;
+
+ /** debug **
+ fprintf(E->trace.fpt, "n=%d ns=%d cosc=%e (%e %e) -> (%e %e)\n",
+ n, i, cosc, E->sx[j][1][n], E->sx[j][2][n], u, v);
+ /**/
+ }
+
+ return;
+}
+
+
+/***************************************************************/
+/* DETERMINE SHAPE COEFFICIENTS */
+/* */
+/* An initialization function that determines the coeffiecients*/
+/* to all element shape functions. */
+/* This method uses standard linear shape functions of */
+/* triangular elements. (See Cuvelier, Segal, and */
+/* van Steenhoven, 1986). This is all in UV space. */
+/* */
+/* shape_coefs[cap][wedge][3 shape functions*3 coefs][nelems] */
+
+static void determine_shape_coefficients(struct All_variables *E)
+{
+ const int j = 1;
+ int nelem, iwedge, kk, i;
+ int snode;
+
+ double u[5], v[5];
+ double x1 = 0.0;
+ double x2 = 0.0;
+ double x3 = 0.0;
+ double y1 = 0.0;
+ double y2 = 0.0;
+ double y3 = 0.0;
+ double delta, a0, a1, a2;
+
+ /* first, allocate memory */
+
+ for(iwedge=1; iwedge<=2; iwedge++) {
+ for (kk=1; kk<=9; kk++) {
+ if ((E->trace.shape_coefs[j][iwedge][kk] =
+ (double *)malloc((E->lmesh.snel+1)*sizeof(double))) == NULL) {
+ fprintf(E->trace.fpt,"ERROR(find shape coefs)-not enough memory(a)\n");
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+ }
+ }
+
+ for (i=1, nelem=1; i<=E->lmesh.snel; i++, nelem+=E->lmesh.elz) {
+
+ /* find u,v of local nodes at one radius */
+
+ for(kk=1; kk<=4; kk++) {
+ snode = (E->ien[j][nelem].node[kk]-1) / E->lmesh.noz + 1;
+ u[kk] = E->gnomonic[snode].u;
+ v[kk] = E->gnomonic[snode].v;
+ }
+
+ for(iwedge=1; iwedge<=2; iwedge++) {
+
+ if (iwedge == 1) {
+ x1 = u[1];
+ x2 = u[2];
+ x3 = u[3];
+ y1 = v[1];
+ y2 = v[2];
+ y3 = v[3];
+ }
+ if (iwedge == 2) {
+ x1 = u[1];
+ x2 = u[3];
+ x3 = u[4];
+ y1 = v[1];
+ y2 = v[3];
+ y3 = v[4];
+ }
+
+ /* shape function 1 */
+
+ delta = (x3-x2)*(y1-y2)-(y2-y3)*(x2-x1);
+ a0 = (x2*y3-x3*y2)/delta;
+ a1 = (y2-y3)/delta;
+ a2 = (x3-x2)/delta;
+
+ E->trace.shape_coefs[j][iwedge][1][i] = a0;
+ E->trace.shape_coefs[j][iwedge][2][i] = a1;
+ E->trace.shape_coefs[j][iwedge][3][i] = a2;
+
+ /* shape function 2 */
+
+ delta = (x3-x1)*(y2-y1)-(y1-y3)*(x1-x2);
+ a0 = (x1*y3-x3*y1)/delta;
+ a1 = (y1-y3)/delta;
+ a2 = (x3-x1)/delta;
+
+ E->trace.shape_coefs[j][iwedge][4][i] = a0;
+ E->trace.shape_coefs[j][iwedge][5][i] = a1;
+ E->trace.shape_coefs[j][iwedge][6][i] = a2;
+
+ /* shape function 3 */
+
+ delta = (x1-x2)*(y3-y2)-(y2-y1)*(x2-x3);
+ a0 = (x2*y1-x1*y2)/delta;
+ a1 = (y2-y1)/delta;
+ a2 = (x1-x2)/delta;
+
+ E->trace.shape_coefs[j][iwedge][7][i] = a0;
+ E->trace.shape_coefs[j][iwedge][8][i] = a1;
+ E->trace.shape_coefs[j][iwedge][9][i] = a2;
+
+ /** debug **
+ fprintf(E->trace.fpt, "el=%d els=%d iwedge=%d shape=(%e %e %e, %e %e %e, %e %e %e)\n",
+ nelem, i, iwedge,
+ E->trace.shape_coefs[j][iwedge][1][i],
+ E->trace.shape_coefs[j][iwedge][2][i],
+ E->trace.shape_coefs[j][iwedge][3][i],
+ E->trace.shape_coefs[j][iwedge][4][i],
+ E->trace.shape_coefs[j][iwedge][5][i],
+ E->trace.shape_coefs[j][iwedge][6][i],
+ E->trace.shape_coefs[j][iwedge][7][i],
+ E->trace.shape_coefs[j][iwedge][8][i],
+ E->trace.shape_coefs[j][iwedge][9][i]);
+ /**/
+
+ } /* end wedge */
+ } /* end elem */
+
+ return;
+}
+
+
+/*********** KEEP WITHIN BOUNDS *****************************************/
+/* */
+/* This function makes sure the particle is within the sphere, and */
+/* phi and theta are within the proper degree range. */
+
+void full_keep_within_bounds(struct All_variables *E,
+ double *x, double *y, double *z,
+ double *theta, double *phi, double *rad)
+{
+ fix_theta_phi(theta, phi);
+ fix_radius(E,rad,theta,phi,x,y,z);
+
+ return;
+}
+
+
+/* &&&&&&&&&&&&&&&&&&&& ANALYTICAL TESTS &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&**************/
+
+/**************** ANALYTICAL TEST *********************************************************/
+/* */
+/* This function (and the 2 following) are used to test advection of tracers by assigning */
+/* a test function (in "analytical_test_function"). */
+
+void analytical_test(struct All_variables *E)
+
+{
+#if 0
+ int kk,pp;
+ int nsteps;
+ int j;
+ int my_number,number;
+ int nrunge_steps;
+ int nrunge_refinement;
+
+ double dt;
+ double runge_dt;
+ double theta,phi,rad;
+ double time;
+ double vel_s[4];
+ double vel_c[4];
+ double my_theta0,my_phi0,my_rad0;
+ double my_thetaf,my_phif,my_radf;
+ double theta0,phi0,rad0;
+ double thetaf,phif,radf;
+ double x0_s[4],xf_s[4];
+ double x0_c[4],xf_c[4];
+ double vec[4];
+ double runge_path_length,runge_time;
+ double x0,y0,z0;
+ double xf,yf,zf;
+ double difference;
+ double difperpath;
+
+ fprintf(E->trace.fpt,"Starting Analytical Test\n");
+ if (E->parallel.me==0) fprintf(stderr,"Starting Analytical Test\n");
+ fflush(E->trace.fpt);
+
+ /* Reset Box cushion to 0 */
+
+ E->trace.box_cushion=0.0000;
+
+ /* test paramters */
+
+ nsteps=200;
+ dt=0.0001;
+
+ E->advection.timestep=dt;
+
+ fprintf(E->trace.fpt,"steps: %d dt: %f\n",nsteps,dt);
+
+ /* Assign test velocity to Citcom nodes */
+
+ for (j=1;j<=E->sphere.caps_per_proc;j++)
+ {
+ for (kk=1;kk<=E->lmesh.nno;kk++)
+ {
+
+ theta=E->sx[j][1][kk];
+ phi=E->sx[j][2][kk];
+ rad=E->sx[j][3][kk];
+
+ analytical_test_function(E,theta,phi,rad,vel_s,vel_c);
+
+ E->sphere.cap[j].V[1][kk]=vel_s[1];
+ E->sphere.cap[j].V[2][kk]=vel_s[2];
+ E->sphere.cap[j].V[3][kk]=vel_s[3];
+ }
+ }
+
+ time=0.0;
+
+ my_theta0=0.0;
+ my_phi0=0.0;
+ my_rad0=0.0;
+ my_thetaf=0.0;
+ my_phif=0.0;
+ my_radf=0.0;
+
+ for (j=1;j<=E->sphere.caps_per_proc;j++)
+ {
+ if (E->trace.ntracers[j]>10)
+ {
+ fprintf(E->trace.fpt,"Warning(analytical)-too many tracers to print!\n");
+ fflush(E->trace.fpt);
+ if (E->trace.itracer_warnings) exit(10);
+ }
+ }
+
+ /* print initial positions */
+
+ E->monitor.solution_cycles=0;
+ for (j=1;j<=E->sphere.caps_per_proc;j++)
+ {
+ for (pp=1;pp<=E->trace.ntracers[j];pp++)
+ {
+ theta=E->trace.basicq[j][0][pp];
+ phi=E->trace.basicq[j][1][pp];
+ rad=E->trace.basicq[j][2][pp];
+
+ fprintf(E->trace.fpt,"(%d) time: %f theta: %f phi: %f rad: %f\n",E->monitor.solution_cycles,time,theta,phi,rad);
+
+ if (pp==1) fprintf(stderr,"(%d) time: %f theta: %f phi: %f rad: %f\n",E->monitor.solution_cycles,time,theta,phi,rad);
+
+ if (pp==1)
+ {
+ my_theta0=theta;
+ my_phi0=phi;
+ my_rad0=rad;
+ }
+ }
+ }
+
+ /* advect tracers */
+
+ for (kk=1;kk<=nsteps;kk++)
+ {
+ E->monitor.solution_cycles=kk;
+
+ time=time+dt;
+
+ predict_tracers(E);
+ correct_tracers(E);
+
+ for (j=1;j<=E->sphere.caps_per_proc;j++)
+ {
+ for (pp=1;pp<=E->trace.ntracers[j];pp++)
+ {
+ theta=E->trace.basicq[j][0][pp];
+ phi=E->trace.basicq[j][1][pp];
+ rad=E->trace.basicq[j][2][pp];
+
+ fprintf(E->trace.fpt,"(%d) time: %f theta: %f phi: %f rad: %f\n",E->monitor.solution_cycles,time,theta,phi,rad);
+
+ if (pp==1) fprintf(stderr,"(%d) time: %f theta: %f phi: %f rad: %f\n",E->monitor.solution_cycles,time,theta,phi,rad);
+
+ if ((kk==nsteps) && (pp==1))
+ {
+ my_thetaf=theta;
+ my_phif=phi;
+ my_radf=rad;
+ }
+ }
+ }
+
+ }
+
+ /* Get ready for comparison to Runge-Kutte (only works for one tracer) */
+
+ fflush(E->trace.fpt);
+ parallel_process_sync(E);
+
+ fprintf(E->trace.fpt,"\n\nComparison to Runge-Kutte\n");
+ if (E->parallel.me==0) fprintf(stderr,"Comparison to Runge-Kutte\n");
+
+ for (j=1;j<=E->sphere.caps_per_proc;j++)
+ {
+ my_number=E->trace.ntracers[j];
+ }
+
+ MPI_Allreduce(&my_number,&number,1,MPI_INT,MPI_SUM,E->parallel.world);
+
+ fprintf(E->trace.fpt,"Number of tracers: %d\n", number);
+ if (E->parallel.me==0) fprintf(stderr,"Number of tracers: %d\n", number);
+
+ /* if more than 1 tracer, exit */
+
+ if (number!=1)
+ {
+ fprintf(E->trace.fpt,"(Note: RK comparison only appropriate for one tracing particle (%d here) \n",number);
+ if (E->parallel.me==0) fprintf(stderr,"(Note: RK comparison only appropriate for one tracing particle (%d here) \n",number);
+ fflush(E->trace.fpt);
+ parallel_process_termination();
+ }
+
+
+ /* communicate starting and final positions */
+
+ MPI_Allreduce(&my_theta0,&theta0,1,MPI_DOUBLE,MPI_SUM,E->parallel.world);
+ MPI_Allreduce(&my_phi0,&phi0,1,MPI_DOUBLE,MPI_SUM,E->parallel.world);
+ MPI_Allreduce(&my_rad0,&rad0,1,MPI_DOUBLE,MPI_SUM,E->parallel.world);
+ MPI_Allreduce(&my_thetaf,&thetaf,1,MPI_DOUBLE,MPI_SUM,E->parallel.world);
+ MPI_Allreduce(&my_phif,&phif,1,MPI_DOUBLE,MPI_SUM,E->parallel.world);
+ MPI_Allreduce(&my_radf,&radf,1,MPI_DOUBLE,MPI_SUM,E->parallel.world);
+
+ x0_s[1]=theta0;
+ x0_s[2]=phi0;
+ x0_s[3]=rad0;
+
+ nrunge_refinement=1000;
+
+ nrunge_steps=nsteps*nrunge_refinement;
+ runge_dt=dt/(1.0*nrunge_refinement);
+
+
+ analytical_runge_kutte(E,nrunge_steps,runge_dt,x0_s,x0_c,xf_s,xf_c,vec);
+
+ runge_time=vec[1];
+ runge_path_length=vec[2];
+
+ /* initial coordinates - both citcom and RK */
+
+ x0=x0_c[1];
+ y0=x0_c[2];
+ z0=x0_c[3];
+
+ /* convert final citcom coords into cartesian */
+
+ sphere_to_cart(E,thetaf,phif,radf,&xf,&yf,&zf);
+
+ difference=sqrt((xf-xf_c[1])*(xf-xf_c[1])+(yf-xf_c[2])*(yf-xf_c[2])+(zf-xf_c[3])*(zf-xf_c[3]));
+
+ difperpath=difference/runge_path_length;
+
+ /* Print out results */
+
+ fprintf(E->trace.fpt,"Citcom calculation: steps: %d dt: %f\n",nsteps,dt);
+ fprintf(E->trace.fpt," (nodes per cap: %d x %d x %d)\n",E->lmesh.nox,E->lmesh.noy,(E->lmesh.noz-1)*E->parallel.nprocz+1);
+ fprintf(E->trace.fpt," starting position: theta: %f phi: %f rad: %f\n", theta0,phi0,rad0);
+ fprintf(E->trace.fpt," final position: theta: %f phi: %f rad: %f\n", thetaf,phif,radf);
+ fprintf(E->trace.fpt," (final time: %f) \n",time );
+
+ fprintf(E->trace.fpt,"\n\nRunge-Kutte calculation: steps: %d dt: %g\n",nrunge_steps,runge_dt);
+ fprintf(E->trace.fpt," starting position: theta: %f phi: %f rad: %f\n", theta0,phi0,rad0);
+ fprintf(E->trace.fpt," final position: theta: %f phi: %f rad: %f\n",xf_s[1],xf_s[2],xf_s[3]);
+ fprintf(E->trace.fpt," path length: %f \n",runge_path_length );
+ fprintf(E->trace.fpt," (final time: %f) \n",runge_time );
+
+ fprintf(E->trace.fpt,"\n\n Difference between Citcom and RK: %e (diff per path length: %e)\n\n",difference,difperpath);
+
+ if (E->parallel.me==0)
+ {
+ fprintf(stderr,"Citcom calculation: steps: %d dt: %f\n",nsteps,dt);
+ fprintf(stderr," (nodes per cap: %d x %d x %d)\n",E->lmesh.nox,E->lmesh.noy,(E->lmesh.noz-1)*E->parallel.nprocz+1);
+ fprintf(stderr," starting position: theta: %f phi: %f rad: %f\n", theta0,phi0,rad0);
+ fprintf(stderr," final position: theta: %f phi: %f rad: %f\n", thetaf,phif,radf);
+ fprintf(stderr," (final time: %f) \n",time );
+
+ fprintf(stderr,"\n\nRunge-Kutte calculation: steps: %d dt: %f\n",nrunge_steps,runge_dt);
+ fprintf(stderr," starting position: theta: %f phi: %f rad: %f\n", theta0,phi0,rad0);
+ fprintf(stderr," final position: theta: %f phi: %f rad: %f\n",xf_s[1],xf_s[2],xf_s[3]);
+ fprintf(stderr," path length: %f \n",runge_path_length );
+ fprintf(stderr," (final time: %f) \n",runge_time );
+
+ fprintf(stderr,"\n\n Difference between Citcom and RK: %e (diff per path length: %e)\n\n",difference,difperpath);
+
+ }
+
+ fflush(E->trace.fpt);
+#endif
+ return;
+}
+
+/*************** ANALYTICAL RUNGE KUTTE ******************/
+/* */
+void analytical_runge_kutte(
+ struct All_variables *E,
+ int nsteps,
+ double dt,
+ double *x0_s,
+ double *x0_c,
+ double *xf_s,
+ double *xf_c,
+ double *vec
+ )
+{
+
+ int kk;
+
+ double x_0,y_0,z_0;
+ double x_p,y_p,z_p;
+ double x_c=0.0;
+ double y_c=0.0;
+ double z_c=0.0;
+ double theta_0,phi_0,rad_0;
+ double theta_p,phi_p,rad_p;
+ double theta_c,phi_c,rad_c;
+ double vel0_s[4],vel0_c[4];
+ double velp_s[4],velp_c[4];
+ double time;
+ double path,dtpath;
+
+ theta_0=x0_s[1];
+ phi_0=x0_s[2];
+ rad_0=x0_s[3];
+
+ sphere_to_cart(E,theta_0,phi_0,rad_0,&x_0,&y_0,&z_0);
+
+ /* fill initial cartesian vector to send back */
+
+ x0_c[1]=x_0;
+ x0_c[2]=y_0;
+ x0_c[3]=z_0;
+
+ time=0.0;
+ path=0.0;
+
+ for (kk=1;kk<=nsteps;kk++)
+ {
+
+ /* get velocity at initial position */
+
+ analytical_test_function(E,theta_0,phi_0,rad_0,vel0_s,vel0_c);
+
+ /* Find predicted midpoint position */
+
+ x_p=x_0+vel0_c[1]*dt*0.5;
+ y_p=y_0+vel0_c[2]*dt*0.5;
+ z_p=z_0+vel0_c[3]*dt*0.5;
+
+ /* convert to spherical */
+
+ cart_to_sphere(E,x_p,y_p,z_p,&theta_p,&phi_p,&rad_p);
+
+ /* get velocity at predicted midpoint position */
+
+ analytical_test_function(E,theta_p,phi_p,rad_p,velp_s,velp_c);
+
+ /* Find corrected position using midpoint velocity */
+
+ x_c=x_0+velp_c[1]*dt;
+ y_c=y_0+velp_c[2]*dt;
+ z_c=z_0+velp_c[3]*dt;
+
+ /* convert to spherical */
+
+ cart_to_sphere(E,x_c,y_c,z_c,&theta_c,&phi_c,&rad_c);
+
+ /* compute path lenght */
+
+ dtpath=sqrt((x_c-x_0)*(x_c-x_0)+(y_c-y_0)*(y_c-y_0)+(z_c-z_0)*(z_c-z_0));
+ path=path+dtpath;
+
+ time=time+dt;
+
+ x_0=x_c;
+ y_0=y_c;
+ z_0=z_c;
+
+ /* next time step */
+
+ }
+
+ /* fill final spherical and cartesian vectors to send back */
+
+ xf_s[1]=theta_c;
+ xf_s[2]=phi_c;
+ xf_s[3]=rad_c;
+
+ xf_c[1]=x_c;
+ xf_c[2]=y_c;
+ xf_c[3]=z_c;
+
+ vec[1]=time;
+ vec[2]=path;
+
+ return;
+}
+
+
+
+/**************** ANALYTICAL TEST FUNCTION ******************/
+/* */
+/* vel_s[1] => velocity in theta direction */
+/* vel_s[2] => velocity in phi direction */
+/* vel_s[3] => velocity in radial direction */
+/* */
+/* vel_c[1] => velocity in x direction */
+/* vel_c[2] => velocity in y direction */
+/* vel_c[3] => velocity in z direction */
+
+void analytical_test_function(
+ struct All_variables *E,
+ double theta, double phi, double rad,
+ double *vel_s,
+ double *vel_c
+ )
+{
+
+ double sint,sinf,cost,cosf;
+ double v_theta,v_phi,v_rad;
+ double vx,vy,vz;
+
+ /* This is where the function is given in spherical */
+
+ v_theta=50.0*rad*cos(phi);
+ v_phi=100.0*rad*sin(theta);
+ v_rad=25.0*rad;
+
+ vel_s[1]=v_theta;
+ vel_s[2]=v_phi;
+ vel_s[3]=v_rad;
+
+ /* Convert the function into cartesian */
+
+ sint=sin(theta);
+ sinf=sin(phi);
+ cost=cos(theta);
+ cosf=cos(phi);
+
+ vx=v_theta*cost*cosf-v_phi*sinf+v_rad*sint*cosf;
+ vy=v_theta*cost*sinf+v_phi*cosf+v_rad*sint*sinf;
+ vz=-v_theta*sint+v_rad*cost;
+
+ vel_c[1]=vx;
+ vel_c[2]=vy;
+ vel_c[3]=vz;
+
+ return;
+}
+
+
+/**** PDEBUG ***********************************************************/
+void pdebug(struct All_variables *E, int i)
+{
+
+ fprintf(E->trace.fpt,"HERE (Before Sync): %d\n",i);
+ fflush(E->trace.fpt);
+ parallel_process_sync(E);
+ fprintf(E->trace.fpt,"HERE (After Sync): %d\n",i);
+ fflush(E->trace.fpt);
+
+ return;
+}
Deleted: mc/3D/CitcomS/branches/cxx/lib/Full_version_dependent.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Full_version_dependent.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Full_version_dependent.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,281 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-#include <math.h>
-
-#include "global_defs.h"
-#include "parallel_related.h"
-#ifdef USE_GGRD
-void ggrd_full_temp_init(struct All_variables *);
-#endif
-
-void get_r_spacing_fine(double *,struct All_variables *);
-void get_r_spacing_at_levels(double *,struct All_variables *);
-void myerror(struct All_variables *,char *);
-#ifdef ALLOW_ELLIPTICAL
-double theta_g(double , struct All_variables *);
-#endif
-
-
-/* =================================================
- rotate the mesh by a rotation matrix
- =================================================*/
-static void full_rotate_mesh(struct All_variables *E, double dircos[4][4],
- int m, int icap)
-{
- int i,lev;
- double t[4], myatan();
-
- for (lev=E->mesh.levmin;lev<=E->mesh.levmax;lev++) {
- for (i=1;i<=E->lmesh.NNO[lev];i++) {
- t[0] = E->X[lev][m][1][i]*dircos[1][1]+
- E->X[lev][m][2][i]*dircos[1][2]+
- E->X[lev][m][3][i]*dircos[1][3];
- t[1] = E->X[lev][m][1][i]*dircos[2][1]+
- E->X[lev][m][2][i]*dircos[2][2]+
- E->X[lev][m][3][i]*dircos[2][3];
- t[2] = E->X[lev][m][1][i]*dircos[3][1]+
- E->X[lev][m][2][i]*dircos[3][2]+
- E->X[lev][m][3][i]*dircos[3][3];
-
- E->X[lev][m][1][i] = t[0];
- E->X[lev][m][2][i] = t[1];
- E->X[lev][m][3][i] = t[2];
- E->SX[lev][m][1][i] = acos(t[2]/E->SX[lev][m][3][i]);
- E->SX[lev][m][2][i] = myatan(t[1],t[0]);
- }
- } /* lev */
-
- return;
-}
-
-/* =================================================
- Standard node positions including mesh refinement
-
- ================================================= */
-
-void full_node_locations(E)
- struct All_variables *E;
-{
- int i,j,k,ii,lev;
- double ro,dr,*rr,*RR,fo,tg;
- double dircos[4][4];
- float tt1;
- int step,nn;
- char output_file[255], a[255];
- FILE *fp1;
-
- void full_coord_of_cap();
- void compute_angle_surf_area ();
- rr = (double *) malloc((E->mesh.noz+1)*sizeof(double));
- RR = (double *) malloc((E->mesh.noz+1)*sizeof(double));
-
-
- switch(E->control.coor){
- case 0:
- /* generate uniform mesh in radial direction */
- dr = (E->sphere.ro-E->sphere.ri)/(E->mesh.noz-1);
-
- for (k=1;k <= E->mesh.noz;k++) {
- rr[k] = E->sphere.ri + (k-1)*dr;
- }
- break;
- case 1: /* read nodal radii from file */
- sprintf(output_file,"%s",E->control.coor_file);
- fp1=fopen(output_file,"r");
- if (fp1 == NULL) {
- fprintf(E->fp,"(Nodal_mesh.c #1) Cannot open %s\n",output_file);
- exit(8);
- }
- fscanf(fp1,"%s %d",a,&i);
- for (k=1;k<=E->mesh.noz;k++) {
- fscanf(fp1,"%d %f",&nn,&tt1);
- rr[k]=tt1;
- }
-
- fclose(fp1);
- break;
- case 2:
- /* higher radial spacing in top and bottom fractions */
- get_r_spacing_fine(rr,E);
- break;
- case 3:
- /* assign radial spacing CitcomCU style */
- get_r_spacing_at_levels(rr,E);
- break;
- default:
- myerror(E,"coor flag undefined in Full_version_dependent");
- break;
- }
-
- for (i=1;i<=E->lmesh.noz;i++) {
- k = E->lmesh.nzs+i-1;
- RR[i] = rr[k];
-
-
- }
-
-
- for (lev=E->mesh.levmin;lev<=E->mesh.levmax;lev++) {
-
- if (E->control.NMULTIGRID||E->control.EMULTIGRID)
- step = (int) pow(2.0,(double)(E->mesh.levmax-lev));
- else
- step = 1;
-
- for (i=1;i<=E->lmesh.NOZ[lev];i++)
- E->sphere.R[lev][i] = RR[(i-1)*step+1];
-
- } /* lev */
-
- free ((void *) rr);
- free ((void *) RR);
-
- for (j=1;j<=E->sphere.caps_per_proc;j++) {
- ii = E->sphere.capid[j];
- full_coord_of_cap(E,j,ii);
- }
-
- if (E->control.verbose) {
- for (lev=E->mesh.levmin;lev<=E->mesh.levmax;lev++) {
- fprintf(E->fp_out,"output_coordinates before rotation %d \n",lev);
- for (j=1;j<=E->sphere.caps_per_proc;j++)
- for (i=1;i<=E->lmesh.NNO[lev];i++)
- if(i%E->lmesh.NOZ[lev]==1)
- fprintf(E->fp_out,"%d %d %g %g %g\n",j,i,E->SX[lev][j][1][i],E->SX[lev][j][2][i],E->SX[lev][j][3][i]);
- }
- fflush(E->fp_out);
- }
-
- /* rotate the mesh to avoid two poles on mesh points */
-
- ro = -0.5*(M_PI/4.0)/E->mesh.elx;
- fo = 0.0;
-
- dircos[1][1] = cos(ro)*cos(fo);
- dircos[1][2] = cos(ro)*sin(fo);
- dircos[1][3] = -sin(ro);
- dircos[2][1] = -sin(fo);
- dircos[2][2] = cos(fo);
- dircos[2][3] = 0.0;
- dircos[3][1] = sin(ro)*cos(fo);
- dircos[3][2] = sin(ro)*sin(fo);
- dircos[3][3] = cos(ro);
-
- for (j=1;j<=E->sphere.caps_per_proc;j++) {
- ii = E->sphere.capid[j];
- full_rotate_mesh(E,dircos,j,ii);
- }
-
- if (E->control.verbose) {
- for (lev=E->mesh.levmin;lev<=E->mesh.levmax;lev++) {
- fprintf(E->fp_out,"output_coordinates after rotation %d \n",lev);
- for (j=1;j<=E->sphere.caps_per_proc;j++)
- for (i=1;i<=E->lmesh.NNO[lev];i++)
- if(i%E->lmesh.NOZ[lev]==1)
- fprintf(E->fp_out,"%d %d %g %g %g\n",j,i,E->SX[lev][j][1][i],E->SX[lev][j][2][i],E->SX[lev][j][3][i]);
- }
- fflush(E->fp_out);
- }
-
- compute_angle_surf_area (E); /* used for interpolation */
-#ifdef ALLOW_ELLIPTICAL
- /* spherical or elliptical, correct theta to theta_g for local surface-normal theta */
- for (lev=E->mesh.levmin;lev<=E->mesh.levmax;lev++)
- for (j=1;j<=E->sphere.caps_per_proc;j++)
- for (i=1;i<=E->lmesh.NNO[lev];i++) {
- tg = theta_g(E->SX[lev][j][1][i],E);
- E->SinCos[lev][j][0][i] = sin(tg); /* */
- E->SinCos[lev][j][1][i] = sin(E->SX[lev][j][2][i]);
- E->SinCos[lev][j][2][i] = cos(tg);
- E->SinCos[lev][j][3][i] = cos(E->SX[lev][j][2][i]);
- }
-#else
- /* spherical */
- for (lev=E->mesh.levmin;lev<=E->mesh.levmax;lev++)
- for (j=1;j<=E->sphere.caps_per_proc;j++)
- for (i=1;i<=E->lmesh.NNO[lev];i++) {
- E->SinCos[lev][j][0][i] = sin(E->SX[lev][j][1][i]); /* sin(theta) */
- E->SinCos[lev][j][1][i] = sin(E->SX[lev][j][2][i]); /* sin(phi) */
- E->SinCos[lev][j][2][i] = cos(E->SX[lev][j][1][i]); /* cos(theta) */
- E->SinCos[lev][j][3][i] = cos(E->SX[lev][j][2][i]); /* cos(phi) */
- }
-
-#endif
-
- return;
-}
-
-
-
-/* setup boundary node and element arrays for bookkeeping */
-
-void full_construct_boundary( struct All_variables *E)
-{
-
- const int dims=E->mesh.nsd;
-
- int m, i, j, k, d, el, count;
-
- /* boundary = top + bottom */
- int max_size = 2*E->lmesh.elx*E->lmesh.ely + 1;
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
- E->boundary.element[m] = (int *)malloc(max_size*sizeof(int));
-
- for(d=1; d<=dims; d++)
- E->boundary.normal[m][d] = (int *)malloc(max_size*sizeof(int));
- }
-
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
- count = 1;
- for(k=1; k<=E->lmesh.ely; k++)
- for(j=1; j<=E->lmesh.elx; j++) {
- if(E->parallel.me_loc[3] == 0) {
- i = 1;
- el = i + (j-1)*E->lmesh.elz + (k-1)*E->lmesh.elz*E->lmesh.elx;
- E->boundary.element[m][count] = el;
- E->boundary.normal[m][dims][count] = -1;
- for(d=1; d<dims; d++)
- E->boundary.normal[m][d][count] = 0;
- ++count;
- }
-
- if(E->parallel.me_loc[3] == E->parallel.nprocz - 1) {
- i = E->lmesh.elz;
- el = i + (j-1)*E->lmesh.elz + (k-1)*E->lmesh.elz*E->lmesh.elx;
- E->boundary.element[m][count] = el;
- E->boundary.normal[m][dims][count] = 1;
- for(d=1; d<dims; d++)
- E->boundary.normal[m][d][count] = 0;
- ++count;
- }
-
- } /* end for i, j, k */
-
- E->boundary.nel = count - 1;
- } /* end for m */
-}
Copied: mc/3D/CitcomS/branches/cxx/lib/Full_version_dependent.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Full_version_dependent.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Full_version_dependent.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Full_version_dependent.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,280 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+#include <math.h>
+
+#include "global_defs.h"
+#include "parallel_related.h"
+#ifdef USE_GGRD
+void ggrd_full_temp_init(struct All_variables *);
+#endif
+
+void get_r_spacing_fine(double *,struct All_variables *);
+void get_r_spacing_at_levels(double *,struct All_variables *);
+void myerror(struct All_variables *,char *);
+#ifdef ALLOW_ELLIPTICAL
+double theta_g(double , struct All_variables *);
+#endif
+
+#include "cproto.h"
+
+
+/* =================================================
+ rotate the mesh by a rotation matrix
+ =================================================*/
+static void full_rotate_mesh(struct All_variables *E, double dircos[4][4],
+ int m, int icap)
+{
+ int i,lev;
+ double t[4];
+
+ for (lev=E->mesh.levmin;lev<=E->mesh.levmax;lev++) {
+ for (i=1;i<=E->lmesh.NNO[lev];i++) {
+ t[0] = E->X[lev][m][1][i]*dircos[1][1]+
+ E->X[lev][m][2][i]*dircos[1][2]+
+ E->X[lev][m][3][i]*dircos[1][3];
+ t[1] = E->X[lev][m][1][i]*dircos[2][1]+
+ E->X[lev][m][2][i]*dircos[2][2]+
+ E->X[lev][m][3][i]*dircos[2][3];
+ t[2] = E->X[lev][m][1][i]*dircos[3][1]+
+ E->X[lev][m][2][i]*dircos[3][2]+
+ E->X[lev][m][3][i]*dircos[3][3];
+
+ E->X[lev][m][1][i] = t[0];
+ E->X[lev][m][2][i] = t[1];
+ E->X[lev][m][3][i] = t[2];
+ E->SX[lev][m][1][i] = acos(t[2]/E->SX[lev][m][3][i]);
+ E->SX[lev][m][2][i] = myatan(t[1],t[0]);
+ }
+ } /* lev */
+
+ return;
+}
+
+/* =================================================
+ Standard node positions including mesh refinement
+
+ ================================================= */
+
+void full_node_locations(struct All_variables *E)
+{
+ int i,j,k,ii,lev;
+ double ro,dr,*rr,*RR,fo,tg;
+ double dircos[4][4];
+ float tt1;
+ int step,nn;
+ char output_file[255], a[255];
+ FILE *fp1;
+
+ rr = (double *) malloc((E->mesh.noz+1)*sizeof(double));
+ RR = (double *) malloc((E->mesh.noz+1)*sizeof(double));
+
+
+ switch(E->control.coor){
+ case 0:
+ /* generate uniform mesh in radial direction */
+ dr = (E->sphere.ro-E->sphere.ri)/(E->mesh.noz-1);
+
+ for (k=1;k <= E->mesh.noz;k++) {
+ rr[k] = E->sphere.ri + (k-1)*dr;
+ }
+ break;
+ case 1: /* read nodal radii from file */
+ sprintf(output_file,"%s",E->control.coor_file);
+ fp1=fopen(output_file,"r");
+ if (fp1 == NULL) {
+ fprintf(E->fp,"(Nodal_mesh.c #1) Cannot open %s\n",output_file);
+ exit(8);
+ }
+ fscanf(fp1,"%s %d",a,&i);
+ for (k=1;k<=E->mesh.noz;k++) {
+ fscanf(fp1,"%d %f",&nn,&tt1);
+ rr[k]=tt1;
+ }
+
+ fclose(fp1);
+ break;
+ case 2:
+ /* higher radial spacing in top and bottom fractions */
+ get_r_spacing_fine(rr,E);
+ break;
+ case 3:
+ /* assign radial spacing CitcomCU style */
+ get_r_spacing_at_levels(rr,E);
+ break;
+ default:
+ myerror(E,"coor flag undefined in Full_version_dependent");
+ break;
+ }
+
+ for (i=1;i<=E->lmesh.noz;i++) {
+ k = E->lmesh.nzs+i-1;
+ RR[i] = rr[k];
+
+
+ }
+
+
+ for (lev=E->mesh.levmin;lev<=E->mesh.levmax;lev++) {
+
+ if (E->control.NMULTIGRID||E->control.EMULTIGRID)
+ step = (int) pow(2.0,(double)(E->mesh.levmax-lev));
+ else
+ step = 1;
+
+ for (i=1;i<=E->lmesh.NOZ[lev];i++)
+ E->sphere.R[lev][i] = RR[(i-1)*step+1];
+
+ } /* lev */
+
+ free ((void *) rr);
+ free ((void *) RR);
+
+ for (j=1;j<=E->sphere.caps_per_proc;j++) {
+ ii = E->sphere.capid[j];
+ full_coord_of_cap(E,j,ii);
+ }
+
+ if (E->control.verbose) {
+ for (lev=E->mesh.levmin;lev<=E->mesh.levmax;lev++) {
+ fprintf(E->fp_out,"output_coordinates before rotation %d \n",lev);
+ for (j=1;j<=E->sphere.caps_per_proc;j++)
+ for (i=1;i<=E->lmesh.NNO[lev];i++)
+ if(i%E->lmesh.NOZ[lev]==1)
+ fprintf(E->fp_out,"%d %d %g %g %g\n",j,i,E->SX[lev][j][1][i],E->SX[lev][j][2][i],E->SX[lev][j][3][i]);
+ }
+ fflush(E->fp_out);
+ }
+
+ /* rotate the mesh to avoid two poles on mesh points */
+
+ ro = -0.5*(M_PI/4.0)/E->mesh.elx;
+ fo = 0.0;
+
+ dircos[1][1] = cos(ro)*cos(fo);
+ dircos[1][2] = cos(ro)*sin(fo);
+ dircos[1][3] = -sin(ro);
+ dircos[2][1] = -sin(fo);
+ dircos[2][2] = cos(fo);
+ dircos[2][3] = 0.0;
+ dircos[3][1] = sin(ro)*cos(fo);
+ dircos[3][2] = sin(ro)*sin(fo);
+ dircos[3][3] = cos(ro);
+
+ for (j=1;j<=E->sphere.caps_per_proc;j++) {
+ ii = E->sphere.capid[j];
+ full_rotate_mesh(E,dircos,j,ii);
+ }
+
+ if (E->control.verbose) {
+ for (lev=E->mesh.levmin;lev<=E->mesh.levmax;lev++) {
+ fprintf(E->fp_out,"output_coordinates after rotation %d \n",lev);
+ for (j=1;j<=E->sphere.caps_per_proc;j++)
+ for (i=1;i<=E->lmesh.NNO[lev];i++)
+ if(i%E->lmesh.NOZ[lev]==1)
+ fprintf(E->fp_out,"%d %d %g %g %g\n",j,i,E->SX[lev][j][1][i],E->SX[lev][j][2][i],E->SX[lev][j][3][i]);
+ }
+ fflush(E->fp_out);
+ }
+
+ compute_angle_surf_area (E); /* used for interpolation */
+#ifdef ALLOW_ELLIPTICAL
+ /* spherical or elliptical, correct theta to theta_g for local surface-normal theta */
+ for (lev=E->mesh.levmin;lev<=E->mesh.levmax;lev++)
+ for (j=1;j<=E->sphere.caps_per_proc;j++)
+ for (i=1;i<=E->lmesh.NNO[lev];i++) {
+ tg = theta_g(E->SX[lev][j][1][i],E);
+ E->SinCos[lev][j][0][i] = sin(tg); /* */
+ E->SinCos[lev][j][1][i] = sin(E->SX[lev][j][2][i]);
+ E->SinCos[lev][j][2][i] = cos(tg);
+ E->SinCos[lev][j][3][i] = cos(E->SX[lev][j][2][i]);
+ }
+#else
+ /* spherical */
+ for (lev=E->mesh.levmin;lev<=E->mesh.levmax;lev++)
+ for (j=1;j<=E->sphere.caps_per_proc;j++)
+ for (i=1;i<=E->lmesh.NNO[lev];i++) {
+ E->SinCos[lev][j][0][i] = sin(E->SX[lev][j][1][i]); /* sin(theta) */
+ E->SinCos[lev][j][1][i] = sin(E->SX[lev][j][2][i]); /* sin(phi) */
+ E->SinCos[lev][j][2][i] = cos(E->SX[lev][j][1][i]); /* cos(theta) */
+ E->SinCos[lev][j][3][i] = cos(E->SX[lev][j][2][i]); /* cos(phi) */
+ }
+
+#endif
+
+ return;
+}
+
+
+
+/* setup boundary node and element arrays for bookkeeping */
+
+void full_construct_boundary( struct All_variables *E)
+{
+
+ const int dims=E->mesh.nsd;
+
+ int m, i, j, k, d, el, count;
+
+ /* boundary = top + bottom */
+ int max_size = 2*E->lmesh.elx*E->lmesh.ely + 1;
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+ E->boundary.element[m] = (int *)malloc(max_size*sizeof(int));
+
+ for(d=1; d<=dims; d++)
+ E->boundary.normal[m][d] = (int *)malloc(max_size*sizeof(int));
+ }
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+ count = 1;
+ for(k=1; k<=E->lmesh.ely; k++)
+ for(j=1; j<=E->lmesh.elx; j++) {
+ if(E->parallel.me_loc[3] == 0) {
+ i = 1;
+ el = i + (j-1)*E->lmesh.elz + (k-1)*E->lmesh.elz*E->lmesh.elx;
+ E->boundary.element[m][count] = el;
+ E->boundary.normal[m][dims][count] = -1;
+ for(d=1; d<dims; d++)
+ E->boundary.normal[m][d][count] = 0;
+ ++count;
+ }
+
+ if(E->parallel.me_loc[3] == E->parallel.nprocz - 1) {
+ i = E->lmesh.elz;
+ el = i + (j-1)*E->lmesh.elz + (k-1)*E->lmesh.elz*E->lmesh.elx;
+ E->boundary.element[m][count] = el;
+ E->boundary.normal[m][dims][count] = 1;
+ for(d=1; d<dims; d++)
+ E->boundary.normal[m][d][count] = 0;
+ ++count;
+ }
+
+ } /* end for i, j, k */
+
+ E->boundary.nel = count - 1;
+ } /* end for m */
+}
Deleted: mc/3D/CitcomS/branches/cxx/lib/General_matrix_functions.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/General_matrix_functions.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/General_matrix_functions.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,846 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-#include <math.h>
-#include <sys/types.h>
-#include "element_definitions.h"
-#include "global_defs.h"
-
-#ifdef _UNICOS
-#include <fortran.h>
-#endif
-
-int epsilon[4][4] = { /* Levi-Cita epsilon */
- {0, 0, 0, 0},
- {0, 1,-1, 1},
- {0,-1, 1,-1},
- {0, 1,-1, 1} };
-
-
-/* ===========================================================
- Iterative solver also using multigrid ........
- =========================================================== */
-
-int solve_del2_u(E,d0,F,acc,high_lev)
- struct All_variables *E;
- double **d0;
- double **F;
- double acc;
- int high_lev;
-{
- void assemble_del2_u();
- void e_assemble_del2_u();
- void n_assemble_del2_u();
- void strip_bcs_from_residual();
- void gauss_seidel();
-
- double conj_grad();
- double multi_grid();
- double global_vdot();
- void record();
- void report();
-
- int count,counts,cycles,convergent,valid;
- int i, neq, m;
-
- char message[200];
-
- double CPU_time0(),initial_time,time;
- double residual,prior_residual,r0;
- double *D1[NCS], *r[NCS], *Au[NCS];
-
- neq = E->lmesh.NEQ[high_lev];
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=0;i<neq;i++) {
- d0[m][i] = 0.0;
- }
-
- r0=residual=sqrt(global_vdot(E,F,F,high_lev));
-
- prior_residual=2*residual;
- count = 0;
- initial_time=CPU_time0();
-
- if (!(E->control.NMULTIGRID || E->control.EMULTIGRID)) {
- /* conjugate gradient solution */
-
- cycles = E->control.v_steps_low;
- residual = conj_grad(E,d0,F,acc,&cycles,high_lev);
- valid = (residual < acc)? 1:0;
- } else {
-
- /* solve using multigrid */
-
- counts =0;
- if(E->parallel.me==0){ /* output */
- snprintf(message,200,"resi = %.6e for iter %d acc %.6e",residual,counts,acc);
- record(E,message);
- report(E,message);
- }
-
- do {
- residual=multi_grid(E,d0,F,acc,high_lev);
- valid = (residual < acc)?1:0;
- counts ++;
- if(E->parallel.me==0){ /* output */
- snprintf(message,200,"resi = %.6e for iter %d acc %.6e",residual,counts,acc);
- record(E,message);
- report(E,message);
- }
- } while (!valid);
-
- cycles = counts;
- }
-
-
- /* Convergence check .....
- We should give it a chance to recover if it briefly diverges initially, and
- don't worry about slower convergence if it is close to the answer */
-
- if((count > 0) &&
- (residual > r0*2.0) ||
- (fabs(residual-prior_residual) < acc*0.1 && (residual > acc * 10.0)) )
- convergent=0;
- else {
- convergent=1;
- prior_residual=residual;
- }
-
- if(E->control.print_convergence&&E->parallel.me==0) {
- fprintf(E->fp,"%s residual (%03d) = %.3e from %.3e to %.3e in %5.2f secs \n",
- (convergent ? " * ":"!!!"),cycles,residual,r0,acc,CPU_time0()-initial_time);
- fflush(E->fp);
- }
-
- count++;
-
- E->monitor.momentum_residual = residual;
- E->control.total_iteration_cycles += count;
- E->control.total_v_solver_calls += 1;
-
- return(valid);
-}
-
-/* =================================
- recursive multigrid function ....
- ================================= */
-
-double multi_grid(E,d1,F,acc,hl)
- struct All_variables *E;
- double **d1;
- double **F;
- double acc;
- int hl; /* higher level of two */
-{
- double residual,AudotAu;
- void interp_vector();
- void project_vector();
- int m,i,j,Vn,Vnmax,cycles;
- double alpha,beta;
- void gauss_seidel();
- void element_gauss_seidel();
- void e_assemble_del2_u();
- void strip_bcs_from_residual();
- void n_assemble_del2_u();
-
- double conj_grad(),global_vdot();
-
- FILE *fp;
- char filename[1000];
- int lev,ic,ulev,dlev;
-
- const int levmin = E->mesh.levmin;
- const int levmax = E->mesh.levmax;
-
- double time1,time,CPU_time0();
- double *res[MAX_LEVELS][NCS],*AU[MAX_LEVELS][NCS];
- double *vel[MAX_LEVELS][NCS],*del_vel[MAX_LEVELS][NCS];
- double *rhs[MAX_LEVELS][NCS],*fl[MAX_LEVELS][NCS];
- /* because it's recursive, need a copy at
- each level */
-
- for(i=E->mesh.levmin;i<=E->mesh.levmax;i++)
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
- del_vel[i][m]=(double *)malloc((E->lmesh.NEQ[i]+1)*sizeof(double));
- AU[i][m] = (double *)malloc((E->lmesh.NEQ[i]+1)*sizeof(double));
- vel[i][m]=(double *)malloc((E->lmesh.NEQ[i]+1)*sizeof(double));
- res[i][m]=(double *)malloc((E->lmesh.NEQ[i])*sizeof(double));
- if (i<E->mesh.levmax)
- fl[i][m]=(double *)malloc((E->lmesh.NEQ[i])*sizeof(double));
- }
-
- Vnmax = E->control.mg_cycle;
-
- /* Project residual onto all the lower levels */
-
- project_vector(E,levmax,F,fl[levmax-1],1);
- strip_bcs_from_residual(E,fl[levmax-1],levmax-1);
- for(lev=levmax-1;lev>levmin;lev--) {
- project_vector(E,lev,fl[lev],fl[lev-1],1);
- strip_bcs_from_residual(E,fl[lev-1],lev-1);
- }
-
- /* Solve for the lowest level */
-
-/* time=CPU_time0(); */
- cycles = E->control.v_steps_low;
-
- gauss_seidel(E,vel[levmin],fl[levmin],AU[levmin],acc*0.01,&cycles,levmin,0);
-
- for(lev=levmin+1;lev<=levmax;lev++) {
- time=CPU_time0();
-
- /* Utilize coarse solution and smooth at this level */
- interp_vector(E,lev-1,vel[lev-1],vel[lev]);
- strip_bcs_from_residual(E,vel[lev],lev);
-
- if (lev==levmax)
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(j=0;j<E->lmesh.NEQ[lev];j++)
- res[lev][m][j]=F[m][j];
- else
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(j=0;j<E->lmesh.NEQ[lev];j++)
- res[lev][m][j]=fl[lev][m][j];
-
- for(Vn=1;Vn<=Vnmax;Vn++) {
- /* Downward stoke of the V */
- for (dlev=lev;dlev>=levmin+1;dlev--) {
-
- /* Pre-smoothing */
- cycles=((dlev==levmax)?E->control.v_steps_high:E->control.down_heavy);
- ic = ((dlev==lev)?1:0);
- gauss_seidel(E,vel[dlev],res[dlev],AU[dlev],0.01,&cycles,dlev,ic);
-
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=0;i<E->lmesh.NEQ[dlev];i++) {
- res[dlev][m][i] = res[dlev][m][i] - AU[dlev][m][i];
- }
-
- project_vector(E,dlev,res[dlev],res[dlev-1],1);
- strip_bcs_from_residual(E,res[dlev-1],dlev-1);
- }
-
- /* Bottom of the V */
- cycles = E->control.v_steps_low;
- gauss_seidel(E,vel[levmin],res[levmin],AU[levmin],acc*0.01,&cycles,levmin,0);
- /* Upward stoke of the V */
- for (ulev=levmin+1;ulev<=lev;ulev++) {
- cycles=((ulev==levmax)?E->control.v_steps_high:E->control.up_heavy);
-
- interp_vector(E,ulev-1,vel[ulev-1],del_vel[ulev]);
- strip_bcs_from_residual(E,del_vel[ulev],ulev);
- gauss_seidel(E,del_vel[ulev],res[ulev],AU[ulev],0.01,&cycles,ulev,1);
-
- AudotAu = global_vdot(E,AU[ulev],AU[ulev],ulev);
- alpha = global_vdot(E,AU[ulev],res[ulev],ulev)/AudotAu;
-
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=0;i<E->lmesh.NEQ[ulev];i++) {
- vel[ulev][m][i] += alpha*del_vel[ulev][m][i];
- }
-
- if (ulev ==levmax)
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=0;i<E->lmesh.NEQ[ulev];i++) {
- res[ulev][m][i] -= alpha*AU[ulev][m][i];
- }
-
- }
- }
- }
-
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(j=0;j<E->lmesh.NEQ[levmax];j++) {
- F[m][j]=res[levmax][m][j];
- d1[m][j]+=vel[levmax][m][j];
- }
-
- residual = sqrt(global_vdot(E,F,F,hl));
-
- for(i=E->mesh.levmin;i<=E->mesh.levmax;i++)
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
- free((double*) del_vel[i][m]);
- free((double*) AU[i][m]);
- free((double*) vel[i][m]);
- free((double*) res[i][m]);
- if (i<E->mesh.levmax)
- free((double*) fl[i][m]);
- }
-
-
- return(residual);
-}
-
-
-/* ===========================================================
- Conjugate gradient relaxation for the matrix equation Kd = f
- Returns the residual reduction after itn iterations ...
- =========================================================== */
-
-
-double conj_grad(E,d0,F,acc,cycles,level)
- struct All_variables *E;
- double **d0;
- double **F;
- double acc;
- int *cycles;
- int level;
-{
- double *r0[NCS],*r1[NCS],*r2[NCS];
- double *z0[NCS],*z1[NCS],*z2[NCS];
- double *p1[NCS],*p2[NCS];
- double *Ap[NCS];
- double *shuffle[NCS];
-
- int m,count,i,steps;
- double residual;
- double alpha,beta,dotprod,dotr1z1,dotr0z0;
-
- double CPU_time0(),time;
-
- void parallel_process_termination();
- void assemble_del2_u();
- void strip_bcs_from_residual();
- double global_vdot();
-
- const int mem_lev=E->mesh.levmax;
- const int high_neq = E->lmesh.NEQ[level];
-
- steps = *cycles;
-
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
- r0[m] = (double *)malloc(E->lmesh.NEQ[mem_lev]*sizeof(double));
- r1[m] = (double *)malloc(E->lmesh.NEQ[mem_lev]*sizeof(double));
- r2[m] = (double *)malloc(E->lmesh.NEQ[mem_lev]*sizeof(double));
- z0[m] = (double *)malloc(E->lmesh.NEQ[mem_lev]*sizeof(double));
- z1[m] = (double *)malloc(E->lmesh.NEQ[mem_lev]*sizeof(double));
- p1[m] = (double *)malloc((1+E->lmesh.NEQ[mem_lev])*sizeof(double));
- p2[m] = (double *)malloc((1+E->lmesh.NEQ[mem_lev])*sizeof(double));
- Ap[m] = (double *)malloc((1+E->lmesh.NEQ[mem_lev])*sizeof(double));
- }
-
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=0;i<high_neq;i++) {
- r1[m][i] = F[m][i];
- d0[m][i] = 0.0;
- }
-
- residual = sqrt(global_vdot(E,r1,r1,level));
-
- assert(residual != 0.0 /* initial residual for CG = 0.0 */);
- count = 0;
-
- while (((residual > acc) && (count < steps)) || count == 0) {
-
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=0;i<high_neq;i++)
- z1[m][i] = E->BI[level][m][i] * r1[m][i];
-
- dotr1z1 = global_vdot(E,r1,z1,level);
-
- if (0==count)
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=0;i<high_neq;i++)
- p2[m][i] = z1[m][i];
- else {
- assert(dotr0z0 != 0.0 /* in head of conj_grad */);
- beta = dotr1z1/dotr0z0;
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=0;i<high_neq;i++)
- p2[m][i] = z1[m][i] + beta * p1[m][i];
- }
-
- dotr0z0 = dotr1z1;
-
- assemble_del2_u(E,p2,Ap,level,1);
-
- dotprod=global_vdot(E,p2,Ap,level);
-
- if(0.0==dotprod)
- alpha=1.0e-3;
- else
- alpha = dotr1z1/dotprod;
-
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=0;i<high_neq;i++) {
- d0[m][i] += alpha * p2[m][i];
- r2[m][i] = r1[m][i] - alpha * Ap[m][i];
- }
-
- residual = sqrt(global_vdot(E,r2,r2,level));
-
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
- shuffle[m] = r0[m]; r0[m] = r1[m]; r1[m] = r2[m]; r2[m] = shuffle[m];
- shuffle[m] = z0[m]; z0[m] = z1[m]; z1[m] = shuffle[m];
- shuffle[m] = p1[m]; p1[m] = p2[m]; p2[m] = shuffle[m];
- }
-
- count++;
- /* end of while-loop */
-
- }
-
- *cycles=count;
-
- strip_bcs_from_residual(E,d0,level);
-
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
- free((double*) r0[m]);
- free((double*) r1[m]);
- free((double*) r2[m]);
- free((double*) z0[m]);
- free((double*) z1[m]);
- free((double*) p1[m]);
- free((double*) p2[m]);
- free((double*) Ap[m]);
- }
-
- return(residual); }
-
-
-/* ========================================================================================
- An element by element version of the gauss-seidel routine. Initially this is a test
- platform, we want to know if it handles discontinuities any better than the node/equation
- versions
- =========================================================================================*/
-
-void element_gauss_seidel(E,d0,F,Ad,acc,cycles,level,guess)
- struct All_variables *E;
- double **d0;
- double **F,**Ad;
- double acc;
- int *cycles;
- int level;
- int guess;
-{
- int count,i,j,k,l,m,ns,nc,d,steps,loc;
- int p1,p2,p3,q1,q2,q3;
- int e,eq,node,node1;
- int element,eqn1,eqn2,eqn3,eqn11,eqn12,eqn13;
-
- void e_assemble_del2_u();
- void n_assemble_del2_u();
- void strip_bcs_from_residual();
-
- double U1[24],AD1[24],F1[24];
- double w1,w2,w3;
- double w11,w12,w13;
- double w[24];
-
- double *dd[NCS],*elt_k;
- int *vis[NCS];
-
- const int dims=E->mesh.nsd;
- const int ends=enodes[dims];
- const int n=loc_mat_size[E->mesh.nsd];
- const int neq=E->lmesh.NEQ[level];
- const int nel=E->lmesh.NEL[level];
- const int nno=E->lmesh.NNO[level];
-
-
- steps=*cycles;
-
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- dd[m] = (double *)malloc(neq*sizeof(double));
- vis[m] = (int *)malloc((nno+1)*sizeof(int));
- }
- elt_k=(double *)malloc((24*24)*sizeof(double));
-
- if(guess){
- e_assemble_del2_u(E,d0,Ad,level,1);
- }
- else {
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=0;i<neq;i++)
- Ad[m][i]=d0[m][i]=0.0;
- }
-
- count=0;
- while (count <= steps) {
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- for(i=1;i<=nno;i++)
- vis[m][i]=0;
-
- for(e=1;e<=nel;e++) {
-
- elt_k = E->elt_k[level][m][e].k;
-
- for(i=1;i<=ends;i++) {
- node=E->IEN[level][m][e].node[i];
- p1=(i-1)*dims;
- w[p1] = w[p1+1] = w[p1+2] = 1.0;
- if(E->NODE[level][m][node] & VBX)
- w[p1] = 0.0;
- if(E->NODE[level][m][node] & VBY)
- w[p1+1] = 0.0;
- if(E->NODE[level][m][node] & VBZ)
- w[p1+2] = 0.0;
-
- }
-
-
- for(i=1;i<=ends;i++) {
- node=E->IEN[level][m][e].node[i];
- if(!vis[m][node])
- continue;
-
- eqn1=E->ID[level][m][node].doff[1];
- eqn2=E->ID[level][m][node].doff[2];
- eqn3=E->ID[level][m][node].doff[3];
- p1=(i-1)*dims*n;
- p2=p1+n;
- p3=p2+n;
-
-
- /* update Au */
- for(j=1;j<=ends;j++) {
- node1=E->IEN[level][m][e].node[j];
-
- eqn11=E->ID[level][m][node1].doff[1];
- eqn12=E->ID[level][m][node1].doff[2];
- eqn13=E->ID[level][m][node1].doff[3];
- q1=(j-1)*3;
-
- Ad[m][eqn11] += w[q1]*(elt_k[p1+q1] * dd[m][eqn1] + elt_k[p2+q1] * dd[m][eqn2] + elt_k[p3+q1] * dd[m][eqn3]);
- Ad[m][eqn12] += w[q1+1]*(elt_k[p1+q1+1] * dd[m][eqn1] + elt_k[p2+q1+1] * dd[m][eqn2] + elt_k[p3+q1+1] * dd[m][eqn3]);
- Ad[m][eqn13] += w[q1+2]*(elt_k[p1+q1+2] * dd[m][eqn1] + elt_k[p2+q1+2] * dd[m][eqn2] + elt_k[p3+q1+2] * dd[m][eqn3]);
-
- }
- }
-
-
- for(i=1;i<=ends;i++) {
- node=E->IEN[level][m][e].node[i];
- if(vis[m][node])
- continue;
-
- eqn1=E->ID[level][m][node].doff[1];
- eqn2=E->ID[level][m][node].doff[2];
- eqn3=E->ID[level][m][node].doff[3];
- p1=(i-1)*dims*n;
- p2=p1+n;
- p3=p2+n;
-
- /* update dd, d0 */
- d0[m][eqn1] += (dd[m][eqn1] = w[(i-1)*dims]*(F[m][eqn1]-Ad[m][eqn1])*E->BI[level][m][eqn1]);
- d0[m][eqn2] += (dd[m][eqn2] = w[(i-1)*dims+1]*(F[m][eqn2]-Ad[m][eqn2])*E->BI[level][m][eqn2]);
- d0[m][eqn3] += (dd[m][eqn3] = w[(i-1)*dims+2]*(F[m][eqn3]-Ad[m][eqn3])*E->BI[level][m][eqn3]);
-
- vis[m][node]=1;
-
- /* update Au */
- for(j=1;j<=ends;j++) {
- node1=E->IEN[level][m][e].node[j];
-
- eqn11=E->ID[level][m][node1].doff[1];
- eqn12=E->ID[level][m][node1].doff[2];
- eqn13=E->ID[level][m][node1].doff[3];
- q1=(j-1)*3;
- q2=q1+1;
- q3=q1+2;
-
- Ad[m][eqn11] += w[q1]*(elt_k[p1+q1] * dd[m][eqn1] + elt_k[p2+q1] * dd[m][eqn2] + elt_k[p3+q1] * dd[m][eqn3]);
- Ad[m][eqn12] += w[q2]*(elt_k[p1+q2] * dd[m][eqn1] + elt_k[p2+q2] * dd[m][eqn2] + elt_k[p3+q2] * dd[m][eqn3]);
- Ad[m][eqn13] += w[q3]*(elt_k[p1+q3] * dd[m][eqn1] + elt_k[p2+q3] * dd[m][eqn2] + elt_k[p3+q3] * dd[m][eqn3]);
- }
- }
-
- } /* end for el */
- } /* end for m */
-
- (E->solver.exchange_id_d)(E, Ad, level);
- (E->solver.exchange_id_d)(E, d0, level);
-
- /* completed cycle */
-
- count++;
-
- }
-
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- free((double*) dd[m]);
- free((int*) vis[m]);
- }
- free((double*) elt_k);
-
- return;
-}
-
-
-/* ============================================================================
- Multigrid Gauss-Seidel relaxation scheme which requires the storage of local
- information, otherwise some other method is required. NOTE this is a bit worse
- than real gauss-seidel because it relaxes all the equations for a node at one
- time (Jacobi at a node). It does the job though.
- ============================================================================ */
-
-void gauss_seidel(E,d0,F,Ad,acc,cycles,level,guess)
- struct All_variables *E;
- double **d0;
- double **F,**Ad;
- double acc;
- int *cycles;
- int level;
- int guess;
-{
-
- int count,i,j,k,l,m,ns,steps;
- int *C;
- int eqn1,eqn2,eqn3;
-
- void parallel_process_termination();
- void n_assemble_del2_u();
-
- double U1,U2,U3,UU;
- double sor,residual,global_vdot();
-
- higher_precision *B1,*B2,*B3;
-
-
- const int dims=E->mesh.nsd;
- const int ends=enodes[dims];
- const int n=loc_mat_size[E->mesh.nsd];
- const int neq=E->lmesh.NEQ[level];
- const int num_nodes=E->lmesh.NNO[level];
- const int nox=E->lmesh.NOX[level];
- const int noz=E->lmesh.NOY[level];
- const int noy=E->lmesh.NOZ[level];
- const int max_eqn=14*dims;
-
- const double zeroo = 0.0;
-
- steps=*cycles;
- sor = 1.3;
-
- if(guess) {
- n_assemble_del2_u(E,d0,Ad,level,1);
- }
- else
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=0;i<neq;i++) {
- d0[m][i]=Ad[m][i]=zeroo;
- }
-
- count = 0;
-
-
- while (count < steps) {
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for(j=0;j<=E->lmesh.NEQ[level];j++)
- E->temp[m][j] = zeroo;
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- Ad[m][neq] = zeroo;
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=1;i<=E->lmesh.NNO[level];i++)
- if(E->NODE[level][m][i] & OFFSIDE) {
-
- eqn1=E->ID[level][m][i].doff[1];
- eqn2=E->ID[level][m][i].doff[2];
- eqn3=E->ID[level][m][i].doff[3];
- E->temp[m][eqn1] = (F[m][eqn1] - Ad[m][eqn1])*E->BI[level][m][eqn1];
- E->temp[m][eqn2] = (F[m][eqn2] - Ad[m][eqn2])*E->BI[level][m][eqn2];
- E->temp[m][eqn3] = (F[m][eqn3] - Ad[m][eqn3])*E->BI[level][m][eqn3];
- E->temp1[m][eqn1] = Ad[m][eqn1];
- E->temp1[m][eqn2] = Ad[m][eqn2];
- E->temp1[m][eqn3] = Ad[m][eqn3];
- }
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=1;i<=E->lmesh.NNO[level];i++) {
-
- eqn1=E->ID[level][m][i].doff[1];
- eqn2=E->ID[level][m][i].doff[2];
- eqn3=E->ID[level][m][i].doff[3];
- C=E->Node_map[level][m]+(i-1)*max_eqn;
- B1=E->Eqn_k1[level][m]+(i-1)*max_eqn;
- B2=E->Eqn_k2[level][m]+(i-1)*max_eqn;
- B3=E->Eqn_k3[level][m]+(i-1)*max_eqn;
-
- /* Ad on boundaries differs after the following operation, but
- no communications are needed yet, because boundary Ad will
- not be used for the G-S iterations for interior nodes */
-
- for(j=3;j<max_eqn;j++) {
- UU = E->temp[m][C[j]];
- Ad[m][eqn1] += B1[j]*UU;
- Ad[m][eqn2] += B2[j]*UU;
- Ad[m][eqn3] += B3[j]*UU;
- }
-
- if (!(E->NODE[level][m][i]&OFFSIDE)) {
- E->temp[m][eqn1] = (F[m][eqn1] - Ad[m][eqn1])*E->BI[level][m][eqn1];
- E->temp[m][eqn2] = (F[m][eqn2] - Ad[m][eqn2])*E->BI[level][m][eqn2];
- E->temp[m][eqn3] = (F[m][eqn3] - Ad[m][eqn3])*E->BI[level][m][eqn3];
- }
-
- /* Ad on boundaries differs after the following operation */
- for(j=0;j<max_eqn;j++)
- Ad[m][C[j]] += B1[j]*E->temp[m][eqn1]
- + B2[j]*E->temp[m][eqn2]
- + B3[j]*E->temp[m][eqn3];
-
- d0[m][eqn1] += E->temp[m][eqn1];
- d0[m][eqn2] += E->temp[m][eqn2];
- d0[m][eqn3] += E->temp[m][eqn3];
- }
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=1;i<=E->lmesh.NNO[level];i++)
- if(E->NODE[level][m][i] & OFFSIDE) {
- eqn1=E->ID[level][m][i].doff[1];
- eqn2=E->ID[level][m][i].doff[2];
- eqn3=E->ID[level][m][i].doff[3];
- Ad[m][eqn1] -= E->temp1[m][eqn1];
- Ad[m][eqn2] -= E->temp1[m][eqn2];
- Ad[m][eqn3] -= E->temp1[m][eqn3];
- }
-
- (E->solver.exchange_id_d)(E, Ad, level);
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=1;i<=E->lmesh.NNO[level];i++)
- if(E->NODE[level][m][i] & OFFSIDE) {
- eqn1=E->ID[level][m][i].doff[1];
- eqn2=E->ID[level][m][i].doff[2];
- eqn3=E->ID[level][m][i].doff[3];
- Ad[m][eqn1] += E->temp1[m][eqn1];
- Ad[m][eqn2] += E->temp1[m][eqn2];
- Ad[m][eqn3] += E->temp1[m][eqn3];
- }
-
-
- count++;
-
-/* for (m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=0;i<neq;i++) {
- F[m][i] -= Ad[m][i];
- Ad[m][i] = 0.0;
- }
-*/
- }
-
- *cycles=count;
- return;
-
-}
-
-
-double cofactor(A,i,j,n)
- double A[4][4];
- int i,j,n;
-
-{ int k,l,p,q;
- double determinant();
-
- double B[4][4]; /* because of recursive behaviour of det/cofac, need to use
- new copy of B at each 'n' level of this routine */
-
- if (n>3) printf("Error, no cofactors for matrix more than 3x3\n");
-
- p=q=1;
-
- for(k=1;k<=n;k++) {
- if(k==i) continue;
- for(l=1;l<=n;l++) {
- if (l==j) continue;
- B[p][q]=A[k][l];
- q++ ;
- }
- q=1;p++;
- }
-
-
- return(epsilon[i][j]*determinant(B,n-1));
-
-
-}
-
-
-/* Fast (conditional) determinant for 3x3 or 2x2 ... otherwise calls general routine */
-
-double determinant(A,n)
- double A[4][4];
- int n;
-
-{ double gen_determinant();
-
- switch (n)
- { case 1:
- return(A[1][1]);
- case 2:
- return(A[1][1]*A[2][2]-A[1][2]*A[2][1]);
- case 3:
- return(A[1][1]*(A[2][2]*A[3][3]-A[2][3]*A[3][2])-
- A[1][2]*(A[2][1]*A[3][3]-A[2][3]*A[3][1])+
- A[1][3]*(A[2][1]*A[3][2]-A[2][2]*A[3][1]));
- default:
- return(1);
-/* return(gen_determinant(A,n)); */
- }
-}
-
-
-/* recursive function to determine matrix determinant */
-
-double gen_determinant(A,n)
- double **A;
- int n;
-
-{ double det;
- double cofactor();
-
- int i;
-
-
- if(n==1) return(A[1][1]); /* need a way to break the recursion */
-
- det=0.0;
- for(i=1;i<=n;i++)
- det += A[1][i]*cofactor(A,1,i,n);
-
- return(det);
-}
-
-
-long double lg_pow(long double a, int n)
-{
- /* compute the value of "a" raised to the power of "n" */
- long double b = 1.0;
- int i;
-
- for(i=0; i<n; i++) {
- b = b*a;
- }
-
- return(b);
-}
-
-
Copied: mc/3D/CitcomS/branches/cxx/lib/General_matrix_functions.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/General_matrix_functions.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/General_matrix_functions.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/General_matrix_functions.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,831 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+#include <math.h>
+#include <sys/types.h>
+#include "element_definitions.h"
+#include "global_defs.h"
+
+#include "cproto.h"
+
+#ifdef _UNICOS
+#include <fortran.h>
+#endif
+
+int epsilon[4][4] = { /* Levi-Cita epsilon */
+ {0, 0, 0, 0},
+ {0, 1,-1, 1},
+ {0,-1, 1,-1},
+ {0, 1,-1, 1} };
+
+
+/* ===========================================================
+ Iterative solver also using multigrid ........
+ =========================================================== */
+
+int solve_del2_u(
+ struct All_variables *E,
+ double **d0,
+ double **F,
+ double acc,
+ int high_lev
+ )
+{
+ int count,counts,cycles,convergent,valid;
+ int i, neq, m;
+
+ char message[200];
+
+ double CPU_time0(),initial_time,time;
+ double residual,prior_residual,r0;
+ double *D1[NCS], *r[NCS], *Au[NCS];
+
+ neq = E->lmesh.NEQ[high_lev];
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=0;i<neq;i++) {
+ d0[m][i] = 0.0;
+ }
+
+ r0=residual=sqrt(global_vdot(E,F,F,high_lev));
+
+ prior_residual=2*residual;
+ count = 0;
+ initial_time=CPU_time0();
+
+ if (!(E->control.NMULTIGRID || E->control.EMULTIGRID)) {
+ /* conjugate gradient solution */
+
+ cycles = E->control.v_steps_low;
+ residual = conj_grad(E,d0,F,acc,&cycles,high_lev);
+ valid = (residual < acc)? 1:0;
+ } else {
+
+ /* solve using multigrid */
+
+ counts =0;
+ if(E->parallel.me==0){ /* output */
+ snprintf(message,200,"resi = %.6e for iter %d acc %.6e",residual,counts,acc);
+ record(E,message);
+ report(E,message);
+ }
+
+ do {
+ residual=multi_grid(E,d0,F,acc,high_lev);
+ valid = (residual < acc)?1:0;
+ counts ++;
+ if(E->parallel.me==0){ /* output */
+ snprintf(message,200,"resi = %.6e for iter %d acc %.6e",residual,counts,acc);
+ record(E,message);
+ report(E,message);
+ }
+ } while (!valid);
+
+ cycles = counts;
+ }
+
+
+ /* Convergence check .....
+ We should give it a chance to recover if it briefly diverges initially, and
+ don't worry about slower convergence if it is close to the answer */
+
+ if((count > 0) &&
+ (residual > r0*2.0) ||
+ (fabs(residual-prior_residual) < acc*0.1 && (residual > acc * 10.0)) )
+ convergent=0;
+ else {
+ convergent=1;
+ prior_residual=residual;
+ }
+
+ if(E->control.print_convergence&&E->parallel.me==0) {
+ fprintf(E->fp,"%s residual (%03d) = %.3e from %.3e to %.3e in %5.2f secs \n",
+ (convergent ? " * ":"!!!"),cycles,residual,r0,acc,CPU_time0()-initial_time);
+ fflush(E->fp);
+ }
+
+ count++;
+
+ E->monitor.momentum_residual = residual;
+ E->control.total_iteration_cycles += count;
+ E->control.total_v_solver_calls += 1;
+
+ return(valid);
+}
+
+/* =================================
+ recursive multigrid function ....
+ ================================= */
+
+double multi_grid(
+ struct All_variables *E,
+ double **d1,
+ double **F,
+ double acc,
+ int hl /* higher level of two */
+ )
+{
+ double residual,AudotAu;
+ int m,i,j,Vn,Vnmax,cycles;
+ double alpha,beta;
+
+ FILE *fp;
+ char filename[1000];
+ int lev,ic,ulev,dlev;
+
+ const int levmin = E->mesh.levmin;
+ const int levmax = E->mesh.levmax;
+
+ double time1,time,CPU_time0();
+ double *res[MAX_LEVELS][NCS],*AU[MAX_LEVELS][NCS];
+ double *vel[MAX_LEVELS][NCS],*del_vel[MAX_LEVELS][NCS];
+ double *rhs[MAX_LEVELS][NCS],*fl[MAX_LEVELS][NCS];
+ /* because it's recursive, need a copy at
+ each level */
+
+ for(i=E->mesh.levmin;i<=E->mesh.levmax;i++)
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+ del_vel[i][m]=(double *)malloc((E->lmesh.NEQ[i]+1)*sizeof(double));
+ AU[i][m] = (double *)malloc((E->lmesh.NEQ[i]+1)*sizeof(double));
+ vel[i][m]=(double *)malloc((E->lmesh.NEQ[i]+1)*sizeof(double));
+ res[i][m]=(double *)malloc((E->lmesh.NEQ[i])*sizeof(double));
+ if (i<E->mesh.levmax)
+ fl[i][m]=(double *)malloc((E->lmesh.NEQ[i])*sizeof(double));
+ }
+
+ Vnmax = E->control.mg_cycle;
+
+ /* Project residual onto all the lower levels */
+
+ project_vector(E,levmax,F,fl[levmax-1],1);
+ strip_bcs_from_residual(E,fl[levmax-1],levmax-1);
+ for(lev=levmax-1;lev>levmin;lev--) {
+ project_vector(E,lev,fl[lev],fl[lev-1],1);
+ strip_bcs_from_residual(E,fl[lev-1],lev-1);
+ }
+
+ /* Solve for the lowest level */
+
+/* time=CPU_time0(); */
+ cycles = E->control.v_steps_low;
+
+ gauss_seidel(E,vel[levmin],fl[levmin],AU[levmin],acc*0.01,&cycles,levmin,0);
+
+ for(lev=levmin+1;lev<=levmax;lev++) {
+ time=CPU_time0();
+
+ /* Utilize coarse solution and smooth at this level */
+ interp_vector(E,lev-1,vel[lev-1],vel[lev]);
+ strip_bcs_from_residual(E,vel[lev],lev);
+
+ if (lev==levmax)
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(j=0;j<E->lmesh.NEQ[lev];j++)
+ res[lev][m][j]=F[m][j];
+ else
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(j=0;j<E->lmesh.NEQ[lev];j++)
+ res[lev][m][j]=fl[lev][m][j];
+
+ for(Vn=1;Vn<=Vnmax;Vn++) {
+ /* Downward stoke of the V */
+ for (dlev=lev;dlev>=levmin+1;dlev--) {
+
+ /* Pre-smoothing */
+ cycles=((dlev==levmax)?E->control.v_steps_high:E->control.down_heavy);
+ ic = ((dlev==lev)?1:0);
+ gauss_seidel(E,vel[dlev],res[dlev],AU[dlev],0.01,&cycles,dlev,ic);
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=0;i<E->lmesh.NEQ[dlev];i++) {
+ res[dlev][m][i] = res[dlev][m][i] - AU[dlev][m][i];
+ }
+
+ project_vector(E,dlev,res[dlev],res[dlev-1],1);
+ strip_bcs_from_residual(E,res[dlev-1],dlev-1);
+ }
+
+ /* Bottom of the V */
+ cycles = E->control.v_steps_low;
+ gauss_seidel(E,vel[levmin],res[levmin],AU[levmin],acc*0.01,&cycles,levmin,0);
+ /* Upward stoke of the V */
+ for (ulev=levmin+1;ulev<=lev;ulev++) {
+ cycles=((ulev==levmax)?E->control.v_steps_high:E->control.up_heavy);
+
+ interp_vector(E,ulev-1,vel[ulev-1],del_vel[ulev]);
+ strip_bcs_from_residual(E,del_vel[ulev],ulev);
+ gauss_seidel(E,del_vel[ulev],res[ulev],AU[ulev],0.01,&cycles,ulev,1);
+
+ AudotAu = global_vdot(E,AU[ulev],AU[ulev],ulev);
+ alpha = global_vdot(E,AU[ulev],res[ulev],ulev)/AudotAu;
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=0;i<E->lmesh.NEQ[ulev];i++) {
+ vel[ulev][m][i] += alpha*del_vel[ulev][m][i];
+ }
+
+ if (ulev ==levmax)
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=0;i<E->lmesh.NEQ[ulev];i++) {
+ res[ulev][m][i] -= alpha*AU[ulev][m][i];
+ }
+
+ }
+ }
+ }
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(j=0;j<E->lmesh.NEQ[levmax];j++) {
+ F[m][j]=res[levmax][m][j];
+ d1[m][j]+=vel[levmax][m][j];
+ }
+
+ residual = sqrt(global_vdot(E,F,F,hl));
+
+ for(i=E->mesh.levmin;i<=E->mesh.levmax;i++)
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+ free((double*) del_vel[i][m]);
+ free((double*) AU[i][m]);
+ free((double*) vel[i][m]);
+ free((double*) res[i][m]);
+ if (i<E->mesh.levmax)
+ free((double*) fl[i][m]);
+ }
+
+
+ return(residual);
+}
+
+
+/* ===========================================================
+ Conjugate gradient relaxation for the matrix equation Kd = f
+ Returns the residual reduction after itn iterations ...
+ =========================================================== */
+
+
+double conj_grad(
+ struct All_variables *E,
+ double **d0,
+ double **F,
+ double acc,
+ int *cycles,
+ int level
+ )
+{
+ double *r0[NCS],*r1[NCS],*r2[NCS];
+ double *z0[NCS],*z1[NCS],*z2[NCS];
+ double *p1[NCS],*p2[NCS];
+ double *Ap[NCS];
+ double *shuffle[NCS];
+
+ int m,count,i,steps;
+ double residual;
+ double alpha,beta,dotprod,dotr1z1,dotr0z0;
+
+ double CPU_time0(),time;
+
+ void parallel_process_termination();
+ void assemble_del2_u();
+ void strip_bcs_from_residual();
+ double global_vdot();
+
+ const int mem_lev=E->mesh.levmax;
+ const int high_neq = E->lmesh.NEQ[level];
+
+ steps = *cycles;
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+ r0[m] = (double *)malloc(E->lmesh.NEQ[mem_lev]*sizeof(double));
+ r1[m] = (double *)malloc(E->lmesh.NEQ[mem_lev]*sizeof(double));
+ r2[m] = (double *)malloc(E->lmesh.NEQ[mem_lev]*sizeof(double));
+ z0[m] = (double *)malloc(E->lmesh.NEQ[mem_lev]*sizeof(double));
+ z1[m] = (double *)malloc(E->lmesh.NEQ[mem_lev]*sizeof(double));
+ p1[m] = (double *)malloc((1+E->lmesh.NEQ[mem_lev])*sizeof(double));
+ p2[m] = (double *)malloc((1+E->lmesh.NEQ[mem_lev])*sizeof(double));
+ Ap[m] = (double *)malloc((1+E->lmesh.NEQ[mem_lev])*sizeof(double));
+ }
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=0;i<high_neq;i++) {
+ r1[m][i] = F[m][i];
+ d0[m][i] = 0.0;
+ }
+
+ residual = sqrt(global_vdot(E,r1,r1,level));
+
+ assert(residual != 0.0 /* initial residual for CG = 0.0 */);
+ count = 0;
+
+ while (((residual > acc) && (count < steps)) || count == 0) {
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=0;i<high_neq;i++)
+ z1[m][i] = E->BI[level][m][i] * r1[m][i];
+
+ dotr1z1 = global_vdot(E,r1,z1,level);
+
+ if (0==count)
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=0;i<high_neq;i++)
+ p2[m][i] = z1[m][i];
+ else {
+ assert(dotr0z0 != 0.0 /* in head of conj_grad */);
+ beta = dotr1z1/dotr0z0;
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=0;i<high_neq;i++)
+ p2[m][i] = z1[m][i] + beta * p1[m][i];
+ }
+
+ dotr0z0 = dotr1z1;
+
+ assemble_del2_u(E,p2,Ap,level,1);
+
+ dotprod=global_vdot(E,p2,Ap,level);
+
+ if(0.0==dotprod)
+ alpha=1.0e-3;
+ else
+ alpha = dotr1z1/dotprod;
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=0;i<high_neq;i++) {
+ d0[m][i] += alpha * p2[m][i];
+ r2[m][i] = r1[m][i] - alpha * Ap[m][i];
+ }
+
+ residual = sqrt(global_vdot(E,r2,r2,level));
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+ shuffle[m] = r0[m]; r0[m] = r1[m]; r1[m] = r2[m]; r2[m] = shuffle[m];
+ shuffle[m] = z0[m]; z0[m] = z1[m]; z1[m] = shuffle[m];
+ shuffle[m] = p1[m]; p1[m] = p2[m]; p2[m] = shuffle[m];
+ }
+
+ count++;
+ /* end of while-loop */
+
+ }
+
+ *cycles=count;
+
+ strip_bcs_from_residual(E,d0,level);
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+ free((double*) r0[m]);
+ free((double*) r1[m]);
+ free((double*) r2[m]);
+ free((double*) z0[m]);
+ free((double*) z1[m]);
+ free((double*) p1[m]);
+ free((double*) p2[m]);
+ free((double*) Ap[m]);
+ }
+
+ return(residual); }
+
+
+/* ========================================================================================
+ An element by element version of the gauss-seidel routine. Initially this is a test
+ platform, we want to know if it handles discontinuities any better than the node/equation
+ versions
+ =========================================================================================*/
+
+void element_gauss_seidel(
+ struct All_variables *E,
+ double **d0,
+ double **F, double **Ad,
+ double acc,
+ int *cycles,
+ int level,
+ int guess
+ )
+{
+ int count,i,j,k,l,m,ns,nc,d,steps,loc;
+ int p1,p2,p3,q1,q2,q3;
+ int e,eq,node,node1;
+ int element,eqn1,eqn2,eqn3,eqn11,eqn12,eqn13;
+
+ void e_assemble_del2_u();
+ void n_assemble_del2_u();
+ void strip_bcs_from_residual();
+
+ double U1[24],AD1[24],F1[24];
+ double w1,w2,w3;
+ double w11,w12,w13;
+ double w[24];
+
+ double *dd[NCS],*elt_k;
+ int *vis[NCS];
+
+ const int dims=E->mesh.nsd;
+ const int ends=enodes[dims];
+ const int n=loc_mat_size[E->mesh.nsd];
+ const int neq=E->lmesh.NEQ[level];
+ const int nel=E->lmesh.NEL[level];
+ const int nno=E->lmesh.NNO[level];
+
+
+ steps=*cycles;
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ dd[m] = (double *)malloc(neq*sizeof(double));
+ vis[m] = (int *)malloc((nno+1)*sizeof(int));
+ }
+ elt_k=(double *)malloc((24*24)*sizeof(double));
+
+ if(guess){
+ e_assemble_del2_u(E,d0,Ad,level,1);
+ }
+ else {
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=0;i<neq;i++)
+ Ad[m][i]=d0[m][i]=0.0;
+ }
+
+ count=0;
+ while (count <= steps) {
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ for(i=1;i<=nno;i++)
+ vis[m][i]=0;
+
+ for(e=1;e<=nel;e++) {
+
+ elt_k = E->elt_k[level][m][e].k;
+
+ for(i=1;i<=ends;i++) {
+ node=E->IEN[level][m][e].node[i];
+ p1=(i-1)*dims;
+ w[p1] = w[p1+1] = w[p1+2] = 1.0;
+ if(E->NODE[level][m][node] & VBX)
+ w[p1] = 0.0;
+ if(E->NODE[level][m][node] & VBY)
+ w[p1+1] = 0.0;
+ if(E->NODE[level][m][node] & VBZ)
+ w[p1+2] = 0.0;
+
+ }
+
+
+ for(i=1;i<=ends;i++) {
+ node=E->IEN[level][m][e].node[i];
+ if(!vis[m][node])
+ continue;
+
+ eqn1=E->ID[level][m][node].doff[1];
+ eqn2=E->ID[level][m][node].doff[2];
+ eqn3=E->ID[level][m][node].doff[3];
+ p1=(i-1)*dims*n;
+ p2=p1+n;
+ p3=p2+n;
+
+
+ /* update Au */
+ for(j=1;j<=ends;j++) {
+ node1=E->IEN[level][m][e].node[j];
+
+ eqn11=E->ID[level][m][node1].doff[1];
+ eqn12=E->ID[level][m][node1].doff[2];
+ eqn13=E->ID[level][m][node1].doff[3];
+ q1=(j-1)*3;
+
+ Ad[m][eqn11] += w[q1]*(elt_k[p1+q1] * dd[m][eqn1] + elt_k[p2+q1] * dd[m][eqn2] + elt_k[p3+q1] * dd[m][eqn3]);
+ Ad[m][eqn12] += w[q1+1]*(elt_k[p1+q1+1] * dd[m][eqn1] + elt_k[p2+q1+1] * dd[m][eqn2] + elt_k[p3+q1+1] * dd[m][eqn3]);
+ Ad[m][eqn13] += w[q1+2]*(elt_k[p1+q1+2] * dd[m][eqn1] + elt_k[p2+q1+2] * dd[m][eqn2] + elt_k[p3+q1+2] * dd[m][eqn3]);
+
+ }
+ }
+
+
+ for(i=1;i<=ends;i++) {
+ node=E->IEN[level][m][e].node[i];
+ if(vis[m][node])
+ continue;
+
+ eqn1=E->ID[level][m][node].doff[1];
+ eqn2=E->ID[level][m][node].doff[2];
+ eqn3=E->ID[level][m][node].doff[3];
+ p1=(i-1)*dims*n;
+ p2=p1+n;
+ p3=p2+n;
+
+ /* update dd, d0 */
+ d0[m][eqn1] += (dd[m][eqn1] = w[(i-1)*dims]*(F[m][eqn1]-Ad[m][eqn1])*E->BI[level][m][eqn1]);
+ d0[m][eqn2] += (dd[m][eqn2] = w[(i-1)*dims+1]*(F[m][eqn2]-Ad[m][eqn2])*E->BI[level][m][eqn2]);
+ d0[m][eqn3] += (dd[m][eqn3] = w[(i-1)*dims+2]*(F[m][eqn3]-Ad[m][eqn3])*E->BI[level][m][eqn3]);
+
+ vis[m][node]=1;
+
+ /* update Au */
+ for(j=1;j<=ends;j++) {
+ node1=E->IEN[level][m][e].node[j];
+
+ eqn11=E->ID[level][m][node1].doff[1];
+ eqn12=E->ID[level][m][node1].doff[2];
+ eqn13=E->ID[level][m][node1].doff[3];
+ q1=(j-1)*3;
+ q2=q1+1;
+ q3=q1+2;
+
+ Ad[m][eqn11] += w[q1]*(elt_k[p1+q1] * dd[m][eqn1] + elt_k[p2+q1] * dd[m][eqn2] + elt_k[p3+q1] * dd[m][eqn3]);
+ Ad[m][eqn12] += w[q2]*(elt_k[p1+q2] * dd[m][eqn1] + elt_k[p2+q2] * dd[m][eqn2] + elt_k[p3+q2] * dd[m][eqn3]);
+ Ad[m][eqn13] += w[q3]*(elt_k[p1+q3] * dd[m][eqn1] + elt_k[p2+q3] * dd[m][eqn2] + elt_k[p3+q3] * dd[m][eqn3]);
+ }
+ }
+
+ } /* end for el */
+ } /* end for m */
+
+ (E->solver.exchange_id_d)(E, Ad, level);
+ (E->solver.exchange_id_d)(E, d0, level);
+
+ /* completed cycle */
+
+ count++;
+
+ }
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ free((double*) dd[m]);
+ free((int*) vis[m]);
+ }
+ free((double*) elt_k);
+
+ return;
+}
+
+
+/* ============================================================================
+ Multigrid Gauss-Seidel relaxation scheme which requires the storage of local
+ information, otherwise some other method is required. NOTE this is a bit worse
+ than real gauss-seidel because it relaxes all the equations for a node at one
+ time (Jacobi at a node). It does the job though.
+ ============================================================================ */
+
+void gauss_seidel(
+ struct All_variables *E,
+ double **d0,
+ double **F, double **Ad,
+ double acc,
+ int *cycles,
+ int level,
+ int guess
+ )
+{
+
+ int count,i,j,k,l,m,ns,steps;
+ int *C;
+ int eqn1,eqn2,eqn3;
+
+ void parallel_process_termination();
+ void n_assemble_del2_u();
+
+ double U1,U2,U3,UU;
+ double sor,residual,global_vdot();
+
+ higher_precision *B1,*B2,*B3;
+
+
+ const int dims=E->mesh.nsd;
+ const int ends=enodes[dims];
+ const int n=loc_mat_size[E->mesh.nsd];
+ const int neq=E->lmesh.NEQ[level];
+ const int num_nodes=E->lmesh.NNO[level];
+ const int nox=E->lmesh.NOX[level];
+ const int noz=E->lmesh.NOY[level];
+ const int noy=E->lmesh.NOZ[level];
+ const int max_eqn=14*dims;
+
+ const double zeroo = 0.0;
+
+ steps=*cycles;
+ sor = 1.3;
+
+ if(guess) {
+ n_assemble_del2_u(E,d0,Ad,level,1);
+ }
+ else
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=0;i<neq;i++) {
+ d0[m][i]=Ad[m][i]=zeroo;
+ }
+
+ count = 0;
+
+
+ while (count < steps) {
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for(j=0;j<=E->lmesh.NEQ[level];j++)
+ E->temp[m][j] = zeroo;
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ Ad[m][neq] = zeroo;
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=1;i<=E->lmesh.NNO[level];i++)
+ if(E->NODE[level][m][i] & OFFSIDE) {
+
+ eqn1=E->ID[level][m][i].doff[1];
+ eqn2=E->ID[level][m][i].doff[2];
+ eqn3=E->ID[level][m][i].doff[3];
+ E->temp[m][eqn1] = (F[m][eqn1] - Ad[m][eqn1])*E->BI[level][m][eqn1];
+ E->temp[m][eqn2] = (F[m][eqn2] - Ad[m][eqn2])*E->BI[level][m][eqn2];
+ E->temp[m][eqn3] = (F[m][eqn3] - Ad[m][eqn3])*E->BI[level][m][eqn3];
+ E->temp1[m][eqn1] = Ad[m][eqn1];
+ E->temp1[m][eqn2] = Ad[m][eqn2];
+ E->temp1[m][eqn3] = Ad[m][eqn3];
+ }
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=1;i<=E->lmesh.NNO[level];i++) {
+
+ eqn1=E->ID[level][m][i].doff[1];
+ eqn2=E->ID[level][m][i].doff[2];
+ eqn3=E->ID[level][m][i].doff[3];
+ C=E->Node_map[level][m]+(i-1)*max_eqn;
+ B1=E->Eqn_k1[level][m]+(i-1)*max_eqn;
+ B2=E->Eqn_k2[level][m]+(i-1)*max_eqn;
+ B3=E->Eqn_k3[level][m]+(i-1)*max_eqn;
+
+ /* Ad on boundaries differs after the following operation, but
+ no communications are needed yet, because boundary Ad will
+ not be used for the G-S iterations for interior nodes */
+
+ for(j=3;j<max_eqn;j++) {
+ UU = E->temp[m][C[j]];
+ Ad[m][eqn1] += B1[j]*UU;
+ Ad[m][eqn2] += B2[j]*UU;
+ Ad[m][eqn3] += B3[j]*UU;
+ }
+
+ if (!(E->NODE[level][m][i]&OFFSIDE)) {
+ E->temp[m][eqn1] = (F[m][eqn1] - Ad[m][eqn1])*E->BI[level][m][eqn1];
+ E->temp[m][eqn2] = (F[m][eqn2] - Ad[m][eqn2])*E->BI[level][m][eqn2];
+ E->temp[m][eqn3] = (F[m][eqn3] - Ad[m][eqn3])*E->BI[level][m][eqn3];
+ }
+
+ /* Ad on boundaries differs after the following operation */
+ for(j=0;j<max_eqn;j++)
+ Ad[m][C[j]] += B1[j]*E->temp[m][eqn1]
+ + B2[j]*E->temp[m][eqn2]
+ + B3[j]*E->temp[m][eqn3];
+
+ d0[m][eqn1] += E->temp[m][eqn1];
+ d0[m][eqn2] += E->temp[m][eqn2];
+ d0[m][eqn3] += E->temp[m][eqn3];
+ }
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=1;i<=E->lmesh.NNO[level];i++)
+ if(E->NODE[level][m][i] & OFFSIDE) {
+ eqn1=E->ID[level][m][i].doff[1];
+ eqn2=E->ID[level][m][i].doff[2];
+ eqn3=E->ID[level][m][i].doff[3];
+ Ad[m][eqn1] -= E->temp1[m][eqn1];
+ Ad[m][eqn2] -= E->temp1[m][eqn2];
+ Ad[m][eqn3] -= E->temp1[m][eqn3];
+ }
+
+ (E->solver.exchange_id_d)(E, Ad, level);
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=1;i<=E->lmesh.NNO[level];i++)
+ if(E->NODE[level][m][i] & OFFSIDE) {
+ eqn1=E->ID[level][m][i].doff[1];
+ eqn2=E->ID[level][m][i].doff[2];
+ eqn3=E->ID[level][m][i].doff[3];
+ Ad[m][eqn1] += E->temp1[m][eqn1];
+ Ad[m][eqn2] += E->temp1[m][eqn2];
+ Ad[m][eqn3] += E->temp1[m][eqn3];
+ }
+
+
+ count++;
+
+/* for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=0;i<neq;i++) {
+ F[m][i] -= Ad[m][i];
+ Ad[m][i] = 0.0;
+ }
+*/
+ }
+
+ *cycles=count;
+ return;
+
+}
+
+
+double cofactor(
+ double A[4][4],
+ int i,int j, int n
+ )
+{ int k,l,p,q;
+ double B[4][4]; /* because of recursive behaviour of det/cofac, need to use
+ new copy of B at each 'n' level of this routine */
+
+ if (n>3) printf("Error, no cofactors for matrix more than 3x3\n");
+
+ p=q=1;
+
+ for(k=1;k<=n;k++) {
+ if(k==i) continue;
+ for(l=1;l<=n;l++) {
+ if (l==j) continue;
+ B[p][q]=A[k][l];
+ q++ ;
+ }
+ q=1;p++;
+ }
+
+
+ return(epsilon[i][j]*determinant(B,n-1));
+
+
+}
+
+
+/* Fast (conditional) determinant for 3x3 or 2x2 ... otherwise calls general routine */
+
+double determinant(
+ double A[4][4],
+ int n
+ )
+{
+
+ switch (n)
+ { case 1:
+ return(A[1][1]);
+ case 2:
+ return(A[1][1]*A[2][2]-A[1][2]*A[2][1]);
+ case 3:
+ return(A[1][1]*(A[2][2]*A[3][3]-A[2][3]*A[3][2])-
+ A[1][2]*(A[2][1]*A[3][3]-A[2][3]*A[3][1])+
+ A[1][3]*(A[2][1]*A[3][2]-A[2][2]*A[3][1]));
+ default:
+ return(1);
+/* return(gen_determinant(A,n)); */
+ }
+}
+
+
+/* recursive function to determine matrix determinant */
+
+#if 0
+double gen_determinant(
+ double **A,
+ int n
+ )
+{ double det;
+
+ int i;
+
+
+ if(n==1) return(A[1][1]); /* need a way to break the recursion */
+
+ det=0.0;
+ for(i=1;i<=n;i++)
+ det += A[1][i]*cofactor(A,1,i,n);
+
+ return(det);
+}
+#endif
+
+
+long double lg_pow(long double a, int n)
+{
+ /* compute the value of "a" raised to the power of "n" */
+ long double b = 1.0;
+ int i;
+
+ for(i=0; i<n; i++) {
+ b = b*a;
+ }
+
+ return(b);
+}
+
+
Deleted: mc/3D/CitcomS/branches/cxx/lib/Ggrd_handling.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Ggrd_handling.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Ggrd_handling.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,1098 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-/*
-
-routines that deal with GMT/netcdf grd I/O as supported through
-the ggrd subroutines of the hc package
-
-*/
-#ifdef USE_GZDIR
-#include <zlib.h>
-gzFile *gzdir_output_open(char *,char *);
-
-#endif
-
-#include <math.h>
-#include "global_defs.h"
-#include "parsing.h"
-#include "parallel_related.h"
-#include "composition_related.h"
-#include "element_definitions.h"
-
-#ifdef USE_GGRD
-
-#include "hc.h" /* ggrd and hc packages */
-#include "ggrd_handling.h"
-
-void report(struct All_variables *,char *);
-int layers_r(struct All_variables *,float );
-void construct_mat_group(struct All_variables *);
-void temperatures_conform_bcs(struct All_variables *);
-int layers(struct All_variables *,int ,int );
-
-/*
-
-assign tracer flavor based on its depth (within top n layers),
-and the grd value
-
-
-*/
-void ggrd_init_tracer_flavors(struct All_variables *E)
-{
- int j, kk, number_of_tracers;
- double rad,theta,phi,indbl;
- char char_dummy[1],error[255],gmt_bc[10];
- struct ggrd_gt ggrd_ict[1];
- /* for dealing with several processors */
- MPI_Status mpi_stat;
- int mpi_rc;
- int mpi_inmsg, mpi_success_message = 1;
- static ggrd_boolean shift_to_pos_lon = FALSE; /* this should not be needed anymore */
- report(E,"ggrd_init_tracer_flavors: ggrd mat init");
-
- /*
- are we global?
- */
- if (E->parallel.nprocxy == 12){
- /* use GMT's geographic boundary conditions */
- sprintf(gmt_bc,GGRD_GMT_GLOBAL_STRING);
- }else{ /* regional */
- sprintf(gmt_bc,"");
- }
-
- /*
- initialize the ggrd control
- */
- if(E->parallel.me > 0){
- /* wait for previous processor */
- mpi_rc = MPI_Recv(&mpi_inmsg, 1, MPI_INT, (E->parallel.me-1),
- 0, E->parallel.world, &mpi_stat);
- }
- if(ggrd_grdtrack_init_general(FALSE,E->trace.ggrd_file,
- char_dummy,gmt_bc,
- ggrd_ict,FALSE,FALSE)){
- myerror(E,"ggrd tracer init error");
- }
- /* shold we decide on shifting to positive longitudes, ie. 0...360? */
- if(E->parallel.me < E->parallel.nproc-1){
- /* tell the next proc to go ahead */
- mpi_rc = MPI_Send(&mpi_success_message, 1,
- MPI_INT, (E->parallel.me+1), 0, E->parallel.world);
- }else{
- report(E,"ggrd_init_tracer_flavors: last processor done with ggrd mat init");
- }
- /* init done */
-
- /* assign values to each tracer based on grd file */
- for (j=1;j<=E->sphere.caps_per_proc;j++) {
- number_of_tracers = E->trace.ntracers[j];
- for (kk=1;kk <= number_of_tracers;kk++) {
- rad = E->trace.basicq[j][2][kk]; /* tracer radius */
-
-
- if(layers_r(E,rad) <= E->trace.ggrd_layers){
- /*
- in top layers
- */
- phi = E->trace.basicq[j][1][kk];
- theta = E->trace.basicq[j][0][kk];
- /* interpolate from grid */
- if(!ggrd_grdtrack_interpolate_tp((double)theta,(double)phi,
- ggrd_ict,&indbl,FALSE,shift_to_pos_lon)){
- snprintf(error,255,"ggrd_init_tracer_flavors: interpolation error at lon: %g lat: %g",
- phi*180/M_PI, 90-theta*180/M_PI);
- myerror(E,error);
- }
- /* limit to 0 or 1 */
- if(indbl < .5)
- indbl = 0.0;
- else
- indbl = 1.0;
- E->trace.extraq[j][0][kk]= indbl;
- }else{
- /* below */
- E->trace.extraq[j][0][kk] = 0.0;
- }
- }
- }
-
- /* free grd structure */
- ggrd_grdtrack_free_gstruc(ggrd_ict);
- report(E,"ggrd tracer init done");
- if(E->parallel.me == 0)
- fprintf(stderr,"ggrd tracer init OK\n");
-}
-
-void ggrd_full_temp_init(struct All_variables *E)
-{
- ggrd_temp_init_general(E,1);
-}
-void ggrd_reg_temp_init(struct All_variables *E)
-{
- ggrd_temp_init_general(E,0);
-}
-
-
-
-/*
-
-initialize temperatures from grd files for spherical geometry
-
-*/
-
-void ggrd_temp_init_general(struct All_variables *E,int is_global)
-{
-
- MPI_Status mpi_stat;
- int mpi_rc;
- int mpi_inmsg, mpi_success_message = 1;
- double temp1,tbot,tgrad,tmean,tadd,rho_prem;
- char gmt_string[10];
- int i,j,k,m,node,noxnoz,nox,noy,noz;
- static ggrd_boolean shift_to_pos_lon = FALSE;
-
- if(is_global) /* decide on GMT flag */
- sprintf(gmt_string,GGRD_GMT_GLOBAL_STRING); /* global */
- else
- sprintf(gmt_string,"");
-
- noy=E->lmesh.noy;
- nox=E->lmesh.nox;
- noz=E->lmesh.noz;
- noxnoz = nox * noz;
-
- if(E->parallel.me == 0)
- fprintf(stderr,"ggrd_temp_init_general: using GMT grd files for temperatures, gmtflag: %s\n",gmt_string);
- /*
-
-
- read in tempeatures/density from GMT grd files
-
-
- */
- /*
-
- begin MPI synchronization part
-
- */
- if(E->parallel.me > 0){
- /*
- wait for the previous processor
- */
- mpi_rc = MPI_Recv(&mpi_inmsg, 1, MPI_INT, (E->parallel.me-1),
- 0, E->parallel.world, &mpi_stat);
- }
-
- if(E->control.ggrd.temp.scale_with_prem){/* initialize PREM */
- if(prem_read_model(E->control.ggrd.temp.prem.model_filename,
- &E->control.ggrd.temp.prem, (E->parallel.me == 0)))
- myerror(E,"PREM init error");
- }
- /*
- initialize the GMT grid files
- */
- E->control.ggrd.temp.d[0].init = FALSE;
- if(ggrd_grdtrack_init_general(TRUE,E->control.ggrd.temp.gfile,
- E->control.ggrd.temp.dfile,gmt_string,
- E->control.ggrd.temp.d,(E->parallel.me == 0),
- FALSE))
- myerror(E,"grd init error");
- /* */
- if(E->parallel.me < E->parallel.nproc-1){
- /* tell the next processor to go ahead with the init step */
- mpi_rc = MPI_Send(&mpi_success_message, 1, MPI_INT, (E->parallel.me+1), 0, E->parallel.world);
- }else{
- fprintf(stderr,"ggrd_temp_init_general: last processor (%i) done with grd init\n",
- E->parallel.me);
- }
- /*
-
- interpolate densities to temperature given PREM variations
-
- */
- if(E->mesh.bottbc == 1){
- /* bottom has specified temperature */
- tbot = E->control.TBCbotval;
- }else{
- /*
- bottom has specified heat flux start with unity bottom temperature
- */
- tbot = 1.0;
- }
- /*
- mean temp is (top+bot)/2 + offset
- */
- tmean = (tbot + E->control.TBCtopval)/2.0 + E->control.ggrd.temp.offset;
-
-
- for(m=1;m <= E->sphere.caps_per_proc;m++)
- for(i=1;i <= noy;i++)
- for(j=1;j <= nox;j++)
- for(k=1;k <= noz;k++) {
- /* node numbers */
- node=k+(j-1)*noz+(i-1)*noxnoz;
-
- /*
- get interpolated velocity anomaly
- */
- if(!ggrd_grdtrack_interpolate_rtp((double)E->sx[m][3][node],(double)E->sx[m][1][node],
- (double)E->sx[m][2][node],
- E->control.ggrd.temp.d,&tadd,
- FALSE,shift_to_pos_lon)){
- fprintf(stderr,"%g %g %g\n",E->sx[m][2][node]*57.29577951308232087,
- 90-E->sx[m][1][node]*57.29577951308232087,(1-E->sx[m][3][node])*6371);
-
- myerror(E,"ggrd__temp_init_general: interpolation error");
-
- }
- if(E->control.ggrd.temp.scale_with_prem){
- /*
- get the PREM density at r for additional scaling
- */
- prem_get_rho(&rho_prem,(double)E->sx[m][3][node],&E->control.ggrd.temp.prem);
- if(rho_prem < 3200.0)
- rho_prem = 3200.0; /* we don't want the density of water */
- /*
- assign temperature
- */
- E->T[m][node] = tmean + tadd * E->control.ggrd.temp.scale *
- rho_prem / E->data.density;
- }else{
- /* no PREM scaling */
- E->T[m][node] = tmean + tadd * E->control.ggrd.temp.scale;
- }
-
- if(E->control.ggrd.temp.limit_trange){
- /* limit to 0 < T < 1 ?*/
- E->T[m][node] = min(max(E->T[m][node], 0.0),1.0);
- }
- //fprintf(stderr,"z: %11g T: %11g\n",E->sx[m][3][node],E->T[m][node]);
- if(E->control.ggrd.temp.override_tbc){
- if((k == 1) && (E->mesh.bottbc == 1)){ /* bottom TBC */
- E->sphere.cap[m].TB[1][node] = E->T[m][node];
- E->sphere.cap[m].TB[2][node] = E->T[m][node];
- E->sphere.cap[m].TB[3][node] = E->T[m][node];
- //fprintf(stderr,"z: %11g TBB: %11g\n",E->sx[m][3][node],E->T[m][node]);
- }
- if((k == noz) && (E->mesh.toptbc == 1)){ /* top TBC */
- E->sphere.cap[m].TB[1][node] = E->T[m][node];
- E->sphere.cap[m].TB[2][node] = E->T[m][node];
- E->sphere.cap[m].TB[3][node] = E->T[m][node];
- //fprintf(stderr,"z: %11g TBT: %11g\n",E->sx[m][3][node],E->T[m][node]);
- }
- }
-
-
-
- }
- /*
- free the structure, not needed anymore since T should now
- change internally
- */
- ggrd_grdtrack_free_gstruc(E->control.ggrd.temp.d);
- /*
- end temperature/density from GMT grd init
- */
- temperatures_conform_bcs(E);
-}
-
-/*
-
-
-read in material, i.e. viscosity prefactor from ggrd file, this will get assigned if
-
-layer <= E->control.ggrd.mat_control
-
-
-*/
-void ggrd_read_mat_from_file(struct All_variables *E, int is_global)
-{
- MPI_Status mpi_stat;
- int mpi_rc,timedep,interpolate;
- int mpi_inmsg, mpi_success_message = 1;
- int m,el,i,j,k,inode,i1,i2,elxlz,elxlylz,ind;
- int llayer,nox,noy,noz,nox1,noz1,noy1,level,lselect,idim,elx,ely,elz;
- char gmt_string[10],char_dummy;
- double indbl,indbl2,age,f1,f2,vip,rout[3],xloc[4];
- char tfilename[1000];
- static ggrd_boolean shift_to_pos_lon = FALSE;
- const int dims=E->mesh.nsd;
- const int ends = enodes[dims];
-
- nox=E->mesh.nox;noy=E->mesh.noy;noz=E->mesh.noz;
- nox1=E->lmesh.nox;noz1=E->lmesh.noz;noy1=E->lmesh.noy;
- elx=E->lmesh.elx;elz=E->lmesh.elz;ely=E->lmesh.ely;
- elxlz = elx * elz;
- elxlylz = elxlz * ely;
-
- /*
- if we have not initialized the time history structure, do it now
- */
- if(!E->control.ggrd.time_hist.init){
- /*
- init times, if available
- */
- ggrd_init_thist_from_file(&E->control.ggrd.time_hist,
- E->control.ggrd.time_hist.file,TRUE,(E->parallel.me == 0));
- E->control.ggrd.time_hist.init = 1;
- }
- /* time dependent? */
- timedep = (E->control.ggrd.time_hist.nvtimes > 1)?(1):(0);
- if(!E->control.ggrd.mat_control_init){
- /* assign the general depth dependent material group */
- construct_mat_group(E);
- if(E->parallel.me==0)
- fprintf(stderr,"ggrd_read_mat_from_file: initializing ggrd materials, assigning to all above %g km\n",
- E->data.radius_km*E->viscosity.zbase_layer[E->control.ggrd.mat_control-1]);
- if(is_global) /* decide on GMT flag */
- sprintf(gmt_string,GGRD_GMT_GLOBAL_STRING); /* global */
- else
- sprintf(gmt_string,"");
- /*
-
- initialization steps
-
- */
- if(E->parallel.me > 0) /* wait for previous processor */
- mpi_rc = MPI_Recv(&mpi_inmsg, 1, MPI_INT, (E->parallel.me-1),
- 0, E->parallel.world, &mpi_stat);
- /*
- read in the material file(s)
- */
- E->control.ggrd.mat = (struct ggrd_gt *)calloc(E->control.ggrd.time_hist.nvtimes,sizeof(struct ggrd_gt));
- for(i=0;i < E->control.ggrd.time_hist.nvtimes;i++){
- if(!timedep) /* constant */
- sprintf(tfilename,"%s",E->control.ggrd.mat_file);
- else
- sprintf(tfilename,"%s/%i/weak.grd",E->control.ggrd.mat_file,i+1);
- /* 2D file init */
- if(ggrd_grdtrack_init_general(FALSE,tfilename,&char_dummy,
- gmt_string,(E->control.ggrd.mat+i),(E->parallel.me == 0),FALSE))
- myerror(E,"ggrd init error");
- }
- if(E->parallel.me < E->parallel.nproc-1){ /* tell the next proc to go ahead */
- mpi_rc = MPI_Send(&mpi_success_message, 1,
- MPI_INT, (E->parallel.me+1), 0, E->parallel.world);
- }else{
- fprintf(stderr,"ggrd_read_mat_from_file: last processor done with ggrd mat init\n");
- fprintf(stderr,"ggrd_read_mat_from_file: WARNING: assuming a regular grid geometry\n");
- }
-
- /* end init */
- }
- if(timedep || (!E->control.ggrd.mat_control_init)){
- age = find_age_in_MY(E);
- if(E->parallel.me == 0)
- fprintf(stderr,"ggrd_read_mat_from_ggrd_file: assigning at age %g\n",age);
- if(timedep){
- ggrd_interpol_time(age,&E->control.ggrd.time_hist,&i1,&i2,&f1,&f2,
- E->control.ggrd.time_hist.vstage_transition);
- interpolate = 1;
- }else{
- interpolate = 0;
- i1 = 0;
- }
- /*
- loop through all elements and assign
- */
- for (m=1;m <= E->sphere.caps_per_proc;m++) {
- for (j=1;j <= elz;j++) { /* this assumes a regular grid sorted as in (1)!!! */
- if(E->mat[m][j] <= E->control.ggrd.mat_control ){
- /*
- lithosphere or asthenosphere
- */
- for (k=1;k <= ely;k++){
- for (i=1;i <= elx;i++) {
- /* eq.(1) */
- el = j + (i-1) * elz + (k-1)*elxlz;
- /*
- find average horizontal coordinate
-
- (DO WE HAVE THIS STORED ALREADY, E.G. FROM PRESSURE
- EVAL FORM FUNCTION???)
- */
- xloc[1] = xloc[2] = xloc[3] = 0.0;
- for(inode=1;inode <= 4;inode++){
- ind = E->ien[m][el].node[inode];
- xloc[1] += E->x[m][1][ind];xloc[2] += E->x[m][2][ind];xloc[3] += E->x[m][3][ind];
- }
- xloc[1]/=4.;xloc[2]/=4.;xloc[3]/=4.;
- xyz2rtpd(xloc[1],xloc[2],xloc[3],rout);
- /* material */
- if(!ggrd_grdtrack_interpolate_tp(rout[1],rout[2],(E->control.ggrd.mat+i1),&indbl,
- FALSE,shift_to_pos_lon)){
- fprintf(stderr,"ggrd_read_mat_from_ggrd_file: interpolation error at lon: %g lat: %g\n",
- rout[2]*180/M_PI,90-rout[1]*180/M_PI);
- parallel_process_termination();
- }
- if(interpolate){
- if(!ggrd_grdtrack_interpolate_tp((double)rout[1],(double)rout[2],
- (E->control.ggrd.mat+i2),&indbl2,
- FALSE,shift_to_pos_lon)){
- fprintf(stderr,"ggrd_read_mat_from_ggrd_file: interpolation error at lon: %g lat: %g\n",
- rout[2]*180/M_PI,90-rout[1]*180/M_PI);
- parallel_process_termination();
- }
- /* average smoothly between the two tectonic stages */
- vip = exp((f1*log(indbl)+f2*log(indbl2)));
- }else{
- vip = indbl;
- }
- /* limit the input scaling? */
- if(vip < 1e-5)
- vip = 1e-5;
- if(vip > 1e5)
- vip = 1e5;
- E->VIP[m][el] = vip;
- }
- }
- }else{
- /* outside the lithosphere */
- for (k=1;k <= ely;k++){
- for (i=1;i <= elx;i++) {
- el = j + (i-1) * elz + (k-1)*elxlz;
- /* no scaling else */
- E->VIP[m][el] = 1.0;
- }
- }
- }
- } /* end elz loop */
- } /* end m loop */
- } /* end assignment loop */
- if((!timedep) && (!E->control.ggrd.mat_control_init)){ /* forget the grid */
- ggrd_grdtrack_free_gstruc(E->control.ggrd.mat);
- }
- E->control.ggrd.mat_control_init = 1;
-} /* end mat control */
-
-
-/*
-
-
-read in Rayleigh number prefactor from file, this will get assigned if
-
-layer <= E->control.ggrd.ray_control
-
-
-I.e. this function can be used to assign a laterally varying prefactor
-to the rayleigh number in the surface layers, e.g. to have a simple
-way to represent stationary, chemical heterogeneity
-
-*/
-void ggrd_read_ray_from_file(struct All_variables *E, int is_global)
-{
- MPI_Status mpi_stat;
- int mpi_rc,timedep,interpolate;
- int mpi_inmsg, mpi_success_message = 1;
- int m,el,i,j,k,node,i1,i2,elxlz,elxlylz,ind;
- int llayer,nox,noy,noz,nox1,noz1,noy1,lev,lselect,idim,elx,ely,elz;
- char gmt_string[10],char_dummy;
- double indbl,indbl2,age,f1,f2,vip,rout[3],xloc[4];
- char tfilename[1000];
- static ggrd_boolean shift_to_pos_lon = FALSE;
-
- const int dims=E->mesh.nsd;
- const int ends = enodes[dims];
- /* dimensional ints */
- nox=E->mesh.nox;noy=E->mesh.noy;noz=E->mesh.noz;
- nox1=E->lmesh.nox;noz1=E->lmesh.noz;noy1=E->lmesh.noy;
- elx=E->lmesh.elx;elz=E->lmesh.elz;ely=E->lmesh.ely;
- elxlz = elx * elz;
- elxlylz = elxlz * ely;
- lev=E->mesh.levmax;
- /*
- if we have not initialized the time history structure, do it now
- any function can do that
-
- we could only use the surface processors, but maybe the rayleigh
- number is supposed to be changed at large depths
- */
- if(!E->control.ggrd.time_hist.init){
- ggrd_init_thist_from_file(&E->control.ggrd.time_hist,
- E->control.ggrd.time_hist.file,TRUE,(E->parallel.me == 0));
- E->control.ggrd.time_hist.init = 1;
- }
- timedep = (E->control.ggrd.time_hist.nvtimes > 1)?(1):(0);
- if(!E->control.ggrd.ray_control_init){
- /* init step */
- if(E->parallel.me==0)
- fprintf(stderr,"ggrd_read_ray_from_file: initializing from %s\n",E->control.ggrd.ray_file);
- if(is_global) /* decide on GMT flag */
- sprintf(gmt_string,GGRD_GMT_GLOBAL_STRING); /* global */
- else
- sprintf(gmt_string,"");
- if(E->parallel.me > 0) /* wait for previous processor */
- mpi_rc = MPI_Recv(&mpi_inmsg, 1, MPI_INT, (E->parallel.me-1),
- 0, E->parallel.world, &mpi_stat);
- E->control.ggrd.ray = (struct ggrd_gt *)calloc(E->control.ggrd.time_hist.nvtimes,sizeof(struct ggrd_gt));
- for(i=0;i < E->control.ggrd.time_hist.nvtimes;i++){
- if(!timedep) /* constant */
- sprintf(tfilename,"%s",E->control.ggrd.ray_file);
- else
- sprintf(tfilename,"%s/%i/rayleigh.grd",E->control.ggrd.ray_file,i+1);
- if(ggrd_grdtrack_init_general(FALSE,tfilename,&char_dummy,
- gmt_string,(E->control.ggrd.ray+i),(E->parallel.me == 0),FALSE))
- myerror(E,"ggrd init error");
- }
- if(E->parallel.me < E->parallel.nproc-1){ /* tell the next proc to go ahead */
- mpi_rc = MPI_Send(&mpi_success_message, 1,
- MPI_INT, (E->parallel.me+1), 0, E->parallel.world);
- }else{
- fprintf(stderr,"ggrd_read_ray_from_file: last processor done with ggrd ray init\n");
- }
- E->control.surface_rayleigh = (float *)malloc(sizeof(float)*(E->lmesh.nsf+2));
- if(!E->control.surface_rayleigh)
- myerror(E,"ggrd rayleigh mem error");
- }
- if(timedep || (!E->control.ggrd.ray_control_init)){
- if(timedep){
- age = find_age_in_MY(E);
- ggrd_interpol_time(age,&E->control.ggrd.time_hist,&i1,&i2,&f1,&f2,
- E->control.ggrd.time_hist.vstage_transition);
- interpolate = 1;
- }else{
- interpolate = 0;i1 = 0;
- }
- if(E->parallel.me == 0)
- fprintf(stderr,"ggrd_read_ray_from_ggrd_file: assigning at time %g\n",age);
- for (m=1;m <= E->sphere.caps_per_proc;m++) {
- /* loop through all surface nodes */
- for (j=1;j <= E->lmesh.nsf;j++) {
- node = j * E->lmesh.noz ;
- rout[1] = (double)E->sx[m][1][node];
- rout[2] = (double)E->sx[m][2][node];
- if(!ggrd_grdtrack_interpolate_tp(rout[1],rout[2],(E->control.ggrd.ray+i1),&indbl,
- FALSE,shift_to_pos_lon)){
- fprintf(stderr,"ggrd_read_ray_from_ggrd_file: interpolation error at %g, %g\n",
- rout[1],rout[2]);
- parallel_process_termination();
- }
- //fprintf(stderr,"%i %i %g %g %g\n",j,E->lmesh.nsf,rout[1],rout[2],indbl);
- if(interpolate){
- if(!ggrd_grdtrack_interpolate_tp(rout[1],rout[2],
- (E->control.ggrd.ray+i2),&indbl2,
- FALSE,shift_to_pos_lon)){
- fprintf(stderr,"ggrd_read_ray_from_ggrd_file: interpolation error at %g, %g\n",
- rout[1],rout[2]);
- parallel_process_termination();
- }
- /* average smoothly between the two tectonic stages */
- vip = f1*indbl+f2*indbl2;
- }else{
- vip = indbl;
- }
- E->control.surface_rayleigh[j] = vip;
- } /* end node loop */
- } /* end cap loop */
- } /* end assign loop */
- if((!timedep) && (!E->control.ggrd.ray_control_init)){ /* forget the grid */
- ggrd_grdtrack_free_gstruc(E->control.ggrd.ray);
- }
- E->control.ggrd.ray_control_init = 1;
-} /* end ray control */
-
-
-/*
-
-read surface velocity boundary conditions from netcdf grd files
-
-
-*/
-
-
-
-void ggrd_read_vtop_from_file(struct All_variables *E, int is_global)
-{
- MPI_Status mpi_stat;
- int mpi_rc,interpolate,timedep,use_codes,code;
- int mpi_inmsg, mpi_success_message = 1;
- int m,el,i,k,i1,i2,ind,nodel,j,level;
- int noxg,nozg,noyg,noxl,noyl,nozl,lselect,idim,noxgnozg,noxlnozl,save_codes;
- char gmt_string[10],char_dummy;
- static int lc =0; /* only for debugging */
- double vin1[2],vin2[2],age,f1,f2,vscale,rout[3],cutoff,v[3],sin_theta,vx[4],
- cos_theta,sin_phi,cos_phi,theta_max,theta_min;
- char tfilename1[1000],tfilename2[1000];
- static pole_warned = FALSE;
- static ggrd_boolean shift_to_pos_lon = FALSE;
- const int dims=E->mesh.nsd;
-#ifdef USE_GZDIR
- gzFile *fp1;
-#else
- myerror(E,"ggrd_read_vtop_from_file needs to use GZDIR (set USE_GZDIR flag) because of code output");
-#endif
- /* read in plate code files? */
- use_codes = (E->control.ggrd_vtop_omega[0] > 1e-7)?(1):(0);
- save_codes = 0;
- /* */
- if(E->mesh.topvbc != 1)
- myerror(E,"ggrd_read_vtop_from_file: top velocity BCs, but topvbc is free slip");
- /* global, top level number of nodes */
- noxg = E->lmesh.nox;nozg=E->lmesh.noz;noyg=E->lmesh.noy;
- noxgnozg = noxg*nozg;
-
- /*
- velocity scaling, assuming input is cm/yr
- */
- vscale = E->data.scalev * E->data.timedir;
- if(use_codes)
- vscale *= E->data.radius_km*1e3/1e6*1e2*M_PI/180.; /* for deg/Myr -> cm/yr conversion */
- if (E->parallel.me_loc[3] == E->parallel.nprocz-1) {
-
- /*
- TOP PROCESSORs ONLY
-
- */
-
- /*
- if we have not initialized the time history structure, do it now
- if this file is not found, will use constant velocities
- */
- if(!E->control.ggrd.time_hist.init){/* init times, if available*/
- ggrd_init_thist_from_file(&E->control.ggrd.time_hist,E->control.ggrd.time_hist.file,
- TRUE,(E->parallel.me == 0));
- E->control.ggrd.time_hist.init = 1;
- }
- timedep = (E->control.ggrd.time_hist.nvtimes > 1)?(1):(0);
-
- if(!E->control.ggrd.vtop_control_init){
- /*
- read in grd files (only needed for top processors, really, but
- leave as is for now
- */
- if(E->parallel.me==0)
- fprintf(stderr,"ggrd_read_vtop_from_file: initializing ggrd velocities for %s setup\n",
- is_global?("global"):("regional"));
- if(is_global){ /* decide on GMT flag */
- //sprintf(gmt_string,""); /* periodic */
- sprintf(gmt_string,GGRD_GMT_GLOBAL_STRING); /* global */
- }else
- sprintf(gmt_string,"");
-
- /*
-
- initialization steps
-
- */
- /*
- read in the velocity file(s)
- */
- E->control.ggrd.svt = (struct ggrd_gt *)calloc(E->control.ggrd.time_hist.nvtimes,sizeof(struct ggrd_gt));
- E->control.ggrd.svp = (struct ggrd_gt *)calloc(E->control.ggrd.time_hist.nvtimes,sizeof(struct ggrd_gt));
- /* for detecting the actual max */
- E->control.ggrd.svt->bandlim = E->control.ggrd.svp->bandlim = 1e6;
- for(i=0;i < E->control.ggrd.time_hist.nvtimes;i++){
- /*
-
- by default, all velocity grids will be stored in memory, this
- may or may not be ideal
-
- */
- if(!timedep){ /* constant */
- if(use_codes)
- sprintf(tfilename1,"%s/code.grd",E->control.ggrd.vtop_dir);
- else{
- sprintf(tfilename1,"%s/vt.grd",E->control.ggrd.vtop_dir);
- sprintf(tfilename2,"%s/vp.grd",E->control.ggrd.vtop_dir);
- }
- } else { /* f(t) */
- if(use_codes)
- sprintf(tfilename1,"%s/%i/code.grd",E->control.ggrd.vtop_dir,i+1);
- else{
- sprintf(tfilename1,"%s/%i/vt.grd",E->control.ggrd.vtop_dir,i+1);
- sprintf(tfilename2,"%s/%i/vp.grd",E->control.ggrd.vtop_dir,i+1);
- }
- }
- if(use_codes){
- if(ggrd_grdtrack_init_general(FALSE,tfilename1,&char_dummy,
- gmt_string,(E->control.ggrd.svt+i),(E->parallel.me == 0),FALSE))
- myerror(E,"ggrd init error codes");
-
- }else{
- if(ggrd_grdtrack_init_general(FALSE,tfilename1,&char_dummy,
- gmt_string,(E->control.ggrd.svt+i),(E->parallel.me == 0),FALSE))
- myerror(E,"ggrd init error vt");
- if(ggrd_grdtrack_init_general(FALSE,tfilename2,&char_dummy,
- gmt_string,(E->control.ggrd.svp+i),(E->parallel.me == 0),FALSE))
- myerror(E,"ggrd init error vp");
- }
- }/* all grids read */
- if(use_codes){
- save_codes = 1;
- snprintf(tfilename1,1000,"%s/codes.%d.gz", E->control.data_dir,E->parallel.me);
- fp1 = gzdir_output_open(tfilename1,"w");
- }
- if(E->parallel.me == 0)
- if(use_codes)
- fprintf(stderr,"ggrd_read_vtop_from_file: assigning Euler vector %g, %g, %g to plates with code %i\n",
- E->control.ggrd_vtop_omega[1],
- E->control.ggrd_vtop_omega[2],
- E->control.ggrd_vtop_omega[3],
- (int)E->control.ggrd_vtop_omega[0]);
- else
- fprintf(stderr,"ggrd_read_vtop_from_file: done with ggrd vtop BC init, %i timesteps, vp band lim max: %g\n",
- E->control.ggrd.time_hist.nvtimes,E->control.ggrd.svp->fmaxlim[0]);
- } /* end init */
-
- /* geographic bounds */
- theta_max = (90-E->control.ggrd.svp[i1].south)*M_PI/180-1e-5;
- theta_min = (90-E->control.ggrd.svp[i1].north)*M_PI/180+1e-5;
- if((E->parallel.me ==0) && (is_global)){
- fprintf(stderr,"ggrd_read_vtop_from_file: determined South/North range: %g/%g\n",
- E->control.ggrd.svp[i1].south,E->control.ggrd.svp[i1].north);
- }
-
- if((E->control.ggrd.time_hist.nvtimes > 1)|| (!E->control.ggrd.vtop_control_init)){
- /*
- either first time around, or time-dependent assignment
- */
- age = find_age_in_MY(E);
- if(timedep){
- /*
- interpolate by time
- */
- if(age < 0){ /* Opposite of other method */
- interpolate = 0;
- /* present day should be last file*/
- i1 = E->control.ggrd.time_hist.nvtimes - 1;
- if(E->parallel.me == 0)
- fprintf(stderr,"ggrd_read_vtop_from_file: using present day vtop for age = %g\n",age);
- }else{
- /* */
- ggrd_interpol_time(age,&E->control.ggrd.time_hist,&i1,&i2,&f1,&f2,
- E->control.ggrd.time_hist.vstage_transition);
- interpolate = 1;
- if(E->parallel.me == 0)
- fprintf(stderr,"ggrd_read_vtop_from_file: interpolating vtop for age = %g\n",age);
- }
-
- }else{
- interpolate = 0; /* single timestep, use single file */
- i1 = 0;
- if(E->parallel.me == 0)
- fprintf(stderr,"ggrd_read_vtop_from_file: temporally constant velocity BC \n");
- }
-
- if(E->parallel.me==0){
- fprintf(stderr,"ggrd_read_vtop_from_file: assigning velocities BC, timedep: %i time: %g\n",
- timedep,age);
-
- }
- /* if mixed BCs are allowed, need to reassign the boundary
- condition */
- if(E->control.ggrd_allow_mixed_vbcs){
-
- /*
-
- mixed BC part
-
- */
- if(use_codes)
- myerror(E,"cannot mix Euler velocities for plate codes and mixed vbcs");
- if(E->parallel.me == 0)
- fprintf(stderr,"WARNING: allowing mixed velocity BCs\n");
-
-
- /* velocities larger than the cutoff will be assigned as free
- slip */
- cutoff = E->control.ggrd.svp->fmaxlim[0] + 1e-5;
- for(level=E->mesh.gridmax;level>=E->mesh.gridmin;level--){/* multigrid levels */
- noxl = E->lmesh.NOX[level];
- noyl = E->lmesh.NOY[level];
- nozl = E->lmesh.NOZ[level];
- noxlnozl = noxl*nozl;
- for (m=1;m <= E->sphere.caps_per_proc;m++) {
- /*
- loop through all horizontal nodes
- */
- for(i=1;i<=noyl;i++){
- for(j=1;j<=noxl;j++) {
- nodel = j * nozl + (i-1)*noxlnozl; /* top node = nozl + (j-1) * nozl + (i-1)*noxlnozl; */
- /* node location */
- rout[1] = E->SX[level][m][1][nodel]; /* theta,phi */
- /*
-
- for global grid, shift theta if too close to poles
-
- */
- if((is_global)&&(rout[1] > theta_max)){
- if(!pole_warned){
- fprintf(stderr,"WARNING: shifting theta from %g (%g) to max theta %g (%g)\n",
- rout[1],90-180/M_PI*rout[1],theta_max,90-180/M_PI*theta_max);
- pole_warned = TRUE;
- }
- rout[1] = theta_max;
- }
- if((is_global)&&(rout[1] < theta_min)){
- if(!pole_warned){
- fprintf(stderr,"WARNING: shifting theta from %g (%g) to min theta %g (%g)\n",
- rout[1],90-180/M_PI*rout[1],theta_min,90-180/M_PI*theta_min);
- pole_warned = TRUE;
- }
- rout[1] = theta_min;
- }
- /* */
- rout[2] = E->SX[level][m][2][nodel];
- /* find vp */
- if(!ggrd_grdtrack_interpolate_tp(rout[1],rout[2],(E->control.ggrd.svp+i1),
- vin1,FALSE,shift_to_pos_lon)){
- fprintf(stderr,"ggrd_read_vtop_from_ggrd_file: interpolation error at %g, %g\n",
- rout[1],rout[2]);
- parallel_process_termination();
- }
- if(interpolate){ /* second time */
- if(!ggrd_grdtrack_interpolate_tp(rout[1],rout[2],(E->control.ggrd.svp+i2),vin2,
- FALSE,shift_to_pos_lon)){
- fprintf(stderr,"ggrd_read_mat_from_ggrd_file: interpolation error at %g, %g\n",
- rout[1],rout[2]);
- parallel_process_termination();
- }
- v[2] = (f1*vin1[0] + f2*vin2[0]); /* vphi unscaled! */
- }else{
- v[2] = vin1[0]; /* vphi */
- }
- if(fabs(v[2]) > cutoff){
- /* free slip */
- E->NODE[level][m][nodel] = E->NODE[level][m][nodel] & (~VBX);
- E->NODE[level][m][nodel] = E->NODE[level][m][nodel] | SBX;
- E->NODE[level][m][nodel] = E->NODE[level][m][nodel] & (~VBY);
- E->NODE[level][m][nodel] = E->NODE[level][m][nodel] | SBY;
- }else{
- /* no slip */
- E->NODE[level][m][nodel] = E->NODE[level][m][nodel] | VBX;
- E->NODE[level][m][nodel] = E->NODE[level][m][nodel] & (~SBX);
- E->NODE[level][m][nodel] = E->NODE[level][m][nodel] | VBY;
- E->NODE[level][m][nodel] = E->NODE[level][m][nodel] & (~SBY);
- }
- } /* end x loop */
- } /* end y loop */
- /* sum up all assignments */
- } /* cap */
- } /* level */
- } /* end mixed BC assign */
-
- /*
-
- now loop through all nodes and assign velocity boundary condition
- values
-
- */
- for (m=1;m <= E->sphere.caps_per_proc;m++) {
- /* scaled cutoff velocity */
- if(!use_codes) /* else, is not defined */
- cutoff = E->control.ggrd.svp->fmaxlim[0] * vscale + 1e-5;
- else{
- cutoff = 1e30;
- if(save_codes) /* those will be surface nodes only */
- gzprintf(fp1,"%3d %7d\n",m,E->lmesh.nsf);
- }
- for(k=1;k <= noyg;k++) {/* loop through surface nodes */
- for(i=1;i <= noxg;i++) {
- nodel = (k-1)*noxgnozg + i * nozg; /* top node = nozg + (i-1) * nozg + (k-1)*noxgnozg */
- /* */
- rout[1] = E->sx[m][1][nodel]; /* theta,phi coordinates */
-
- /*
-
- for global grid, shift theta if too close to poles
-
- */
- if((is_global)&&(rout[1] > theta_max)){
- if(!pole_warned){
- fprintf(stderr,"WARNING: shifting theta from %g (%g) to max theta %g (%g)\n",
- rout[1],90-180/M_PI*rout[1],theta_max,90-180/M_PI*theta_max);
- pole_warned = TRUE;
- }
- rout[1] = theta_max;
- }
- if((is_global)&&(rout[1] < theta_min)){
- if(!pole_warned){
- fprintf(stderr,"WARNING: shifting theta from %g (%g) to min theta %g (%g)\n",
- rout[1],90-180/M_PI*rout[1],theta_min,90-180/M_PI*theta_min);
- pole_warned = TRUE;
- }
- rout[1] = theta_min;
- }
-
-
- rout[2] = E->sx[m][2][nodel];
- if(!ggrd_grdtrack_interpolate_tp(rout[1],rout[2],(E->control.ggrd.svt+i1),
- vin1,FALSE,shift_to_pos_lon)){
- fprintf(stderr,"ggrd_read_vtop_from_ggrd_file: interpolation error at %g, %g\n",
- rout[1],rout[2]);
- parallel_process_termination();
- }
- if(!use_codes)
- if(!ggrd_grdtrack_interpolate_tp(rout[1],rout[2],(E->control.ggrd.svp+i1),
- (vin1+1),FALSE,shift_to_pos_lon)){
- fprintf(stderr,"ggrd_read_vtop_from_ggrd_file: interpolation error at %g, %g\n",
- rout[1],rout[2]);
- parallel_process_termination();
- }
- if(interpolate){ /* second time */
- if(!ggrd_grdtrack_interpolate_tp(rout[1],rout[2],(E->control.ggrd.svt+i2),vin2,
- FALSE,shift_to_pos_lon)){
- fprintf(stderr,"ggrd_read_mat_from_ggrd_file: interpolation error at %g, %g\n",
- rout[1],rout[2]);
- parallel_process_termination();
- }
- if(!use_codes){
- if(!ggrd_grdtrack_interpolate_tp(rout[1],rout[2],(E->control.ggrd.svp+i2),(vin2+1),
- FALSE,shift_to_pos_lon)){
- fprintf(stderr,"ggrd_read_mat_from_ggrd_file: interpolation error at %g, %g\n",
- rout[1],rout[2]);
- parallel_process_termination();
- }
- v[1] = (f1*vin1[0] + f2*vin2[0])*vscale; /* theta */
- v[2] = (f1*vin1[1] + f2*vin2[1])*vscale; /* phi */
- }else{
- v[1] = (f1*vin1[0] + f2*vin2[0]); /* theta */
- }
- }else{
- if(!use_codes){
- v[1] = vin1[0]*vscale; /* theta */
- v[2] = vin1[1]*vscale; /* phi */
- }else{
- v[1] = vin1[0]; /* theta */
- }
- }
- if(use_codes){
- /* find code from v[1], theta */
- code = (int)(v[1] + 0.5);
- if(save_codes) /* lon lat code */
- gzprintf(fp1, "%9.4f %9.4f %i\n",
- rout[2]/M_PI*180,90-rout[1]*180/M_PI,code);
- if((int)E->control.ggrd_vtop_omega[0] == code){
- /* within plate */
- sin_theta=sin(rout[1]);cos_theta=cos(rout[1]);
- sin_phi =sin(rout[2]);cos_phi= cos(rout[2]);
- /* compute spherical velocities in cm/yr at this
- location, assuming rotation pole is in deg/Myr */
- vx[1]=E->control.ggrd_vtop_omega[2]*E->x[m][3][nodel] - E->control.ggrd_vtop_omega[3]*E->x[m][2][nodel];
- vx[2]=E->control.ggrd_vtop_omega[3]*E->x[m][1][nodel] - E->control.ggrd_vtop_omega[1]*E->x[m][3][nodel];
- vx[3]=E->control.ggrd_vtop_omega[1]*E->x[m][2][nodel] - E->control.ggrd_vtop_omega[2]*E->x[m][1][nodel];
- /* */
- v[1]= cos_theta*cos_phi*vx[1] + cos_theta*sin_phi*vx[2] - sin_theta*vx[3]; /* theta */
- v[2]=- sin_phi*vx[1] + cos_phi*vx[2]; /* phie */
- /* scale */
- v[1] *= vscale;v[2] *= vscale;
- }else{
- v[1] = v[2] = 0.0;
- }
- }
- /* assign velociites */
- if(fabs(v[2]) > cutoff){
- /* huge velocitie - free slip */
- E->sphere.cap[m].VB[1][nodel] = 0; /* theta */
- E->sphere.cap[m].VB[2][nodel] = 0; /* phi */
- }else{
- /* regular no slip , assign velocities as BCs */
- E->sphere.cap[m].VB[1][nodel] = v[1]; /* theta */
- E->sphere.cap[m].VB[2][nodel] = v[2]; /* phi */
- }
- E->sphere.cap[m].VB[3][nodel] = 0.0; /* r */
- }
- } /* end surface node loop */
- } /* end cap loop */
-
- if((!timedep)&&(!E->control.ggrd.vtop_control_init)){ /* forget the grids */
- ggrd_grdtrack_free_gstruc(E->control.ggrd.svt);
- ggrd_grdtrack_free_gstruc(E->control.ggrd.svp);
- }
- } /* end assignment branch */
- if(use_codes && save_codes){
- save_codes = 0;
- gzclose(fp1);
- }
- } /* end top proc branch */
- E->control.ggrd.vtop_control_init = 1;
- if(E->parallel.me == 0)fprintf(stderr,"vtop from grd done: %i\n",lc++);
-}
-
-
-
-void ggrd_read_age_from_file(struct All_variables *E, int is_global)
-{
- myerror(E,"not implemented yet");
-} /* end age control */
-
-/* adjust Ra in top boundary layer */
-void ggrd_adjust_tbl_rayleigh(struct All_variables *E,
- double **buoy)
-{
- int m,snode,node,i;
- double xloc,fac,bnew;
- if(!E->control.ggrd.ray_control_init)
- myerror(E,"ggrd rayleigh not initialized, but in adjust tbl");
- if(E->parallel.me == 0)
- fprintf(stderr,"ggrd__adjust_tbl_rayleigh: adjusting Rayleigh in top %i layers\n",
- E->control.ggrd.ray_control);
-
- /*
- need to scale buoy with the material determined rayleigh numbers
- */
- for(m=1;m <= E->sphere.caps_per_proc;m++){
- for(snode=1;snode <= E->lmesh.nsf;snode++){ /* loop through surface nodes */
- if(fabs(E->control.surface_rayleigh[snode]-1.0)>1e-6){
- for(i=1;i <= E->lmesh.noz;i++){ /* go through depth layers */
- node = (snode-1)*E->lmesh.noz + i; /* global node number */
- if(layers(E,m,node) <= E->control.ggrd.ray_control){
- /*
- node is in top layers
- */
- /* depth factor, cos^2 tapered */
- xloc=1.0 + ((1 - E->sx[m][3][node]) -
- E->viscosity.zbase_layer[E->control.ggrd.ray_control-1])/
- E->viscosity.zbase_layer[E->control.ggrd.ray_control-1];
- fac = cos(xloc*1.5707963267);fac *= fac; /* cos^2
- tapering,
- factor
- decrease from
- 1 at surface
- to zero at
- boundary */
- bnew = buoy[m][node] * E->control.surface_rayleigh[snode]; /* modified rayleigh */
- /* debugging */
- /* fprintf(stderr,"z: %11g tl: %i zm: %11g fac: %11g sra: %11g bnew: %11g bold: %11g\n", */
- /* (1 - E->sx[m][3][node])*E->data.radius_km,E->control.ggrd.ray_control, */
- /* E->viscosity.zbase_layer[E->control.ggrd.ray_control-1]*E->data.radius_km, */
- /* fac,E->control.surface_rayleigh[snode],(fac * bnew + (1-fac)*buoy[m][node]),buoy[m][node]); */
- buoy[m][node] = fac * bnew + (1-fac)*buoy[m][node];
- }
- }
- }
- }
- }
-
-}
-
-
-
-#endif
-
-
Copied: mc/3D/CitcomS/branches/cxx/lib/Ggrd_handling.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Ggrd_handling.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Ggrd_handling.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Ggrd_handling.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,1098 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+/*
+
+routines that deal with GMT/netcdf grd I/O as supported through
+the ggrd subroutines of the hc package
+
+*/
+#ifdef USE_GZDIR
+#include <zlib.h>
+gzFile *gzdir_output_open(char *,char *);
+
+#endif
+
+#include <math.h>
+#include "global_defs.h"
+#include "parsing.h"
+#include "parallel_related.h"
+#include "composition_related.h"
+#include "element_definitions.h"
+
+#ifdef USE_GGRD
+
+#include "hc.h" /* ggrd and hc packages */
+#include "ggrd_handling.h"
+
+void report(struct All_variables *,char *);
+int layers_r(struct All_variables *,float );
+void construct_mat_group(struct All_variables *);
+void temperatures_conform_bcs(struct All_variables *);
+int layers(struct All_variables *,int ,int );
+
+/*
+
+assign tracer flavor based on its depth (within top n layers),
+and the grd value
+
+
+*/
+void ggrd_init_tracer_flavors(struct All_variables *E)
+{
+ int j, kk, number_of_tracers;
+ double rad,theta,phi,indbl;
+ char char_dummy[1],error[255],gmt_bc[10];
+ struct ggrd_gt ggrd_ict[1];
+ /* for dealing with several processors */
+ MPI_Status mpi_stat;
+ int mpi_rc;
+ int mpi_inmsg, mpi_success_message = 1;
+ static ggrd_boolean shift_to_pos_lon = FALSE; /* this should not be needed anymore */
+ report(E,"ggrd_init_tracer_flavors: ggrd mat init");
+
+ /*
+ are we global?
+ */
+ if (E->parallel.nprocxy == 12){
+ /* use GMT's geographic boundary conditions */
+ sprintf(gmt_bc,GGRD_GMT_GLOBAL_STRING);
+ }else{ /* regional */
+ sprintf(gmt_bc,"");
+ }
+
+ /*
+ initialize the ggrd control
+ */
+ if(E->parallel.me > 0){
+ /* wait for previous processor */
+ mpi_rc = MPI_Recv(&mpi_inmsg, 1, MPI_INT, (E->parallel.me-1),
+ 0, E->parallel.world, &mpi_stat);
+ }
+ if(ggrd_grdtrack_init_general(FALSE,E->trace.ggrd_file,
+ char_dummy,gmt_bc,
+ ggrd_ict,FALSE,FALSE)){
+ myerror(E,"ggrd tracer init error");
+ }
+ /* shold we decide on shifting to positive longitudes, ie. 0...360? */
+ if(E->parallel.me < E->parallel.nproc-1){
+ /* tell the next proc to go ahead */
+ mpi_rc = MPI_Send(&mpi_success_message, 1,
+ MPI_INT, (E->parallel.me+1), 0, E->parallel.world);
+ }else{
+ report(E,"ggrd_init_tracer_flavors: last processor done with ggrd mat init");
+ }
+ /* init done */
+
+ /* assign values to each tracer based on grd file */
+ for (j=1;j<=E->sphere.caps_per_proc;j++) {
+ number_of_tracers = E->trace.ntracers[j];
+ for (kk=1;kk <= number_of_tracers;kk++) {
+ rad = E->trace.basicq[j][2][kk]; /* tracer radius */
+
+
+ if(layers_r(E,rad) <= E->trace.ggrd_layers){
+ /*
+ in top layers
+ */
+ phi = E->trace.basicq[j][1][kk];
+ theta = E->trace.basicq[j][0][kk];
+ /* interpolate from grid */
+ if(!ggrd_grdtrack_interpolate_tp((double)theta,(double)phi,
+ ggrd_ict,&indbl,FALSE,shift_to_pos_lon)){
+ snprintf(error,255,"ggrd_init_tracer_flavors: interpolation error at lon: %g lat: %g",
+ phi*180/M_PI, 90-theta*180/M_PI);
+ myerror(E,error);
+ }
+ /* limit to 0 or 1 */
+ if(indbl < .5)
+ indbl = 0.0;
+ else
+ indbl = 1.0;
+ E->trace.extraq[j][0][kk]= indbl;
+ }else{
+ /* below */
+ E->trace.extraq[j][0][kk] = 0.0;
+ }
+ }
+ }
+
+ /* free grd structure */
+ ggrd_grdtrack_free_gstruc(ggrd_ict);
+ report(E,"ggrd tracer init done");
+ if(E->parallel.me == 0)
+ fprintf(stderr,"ggrd tracer init OK\n");
+}
+
+void ggrd_full_temp_init(struct All_variables *E)
+{
+ ggrd_temp_init_general(E,1);
+}
+void ggrd_reg_temp_init(struct All_variables *E)
+{
+ ggrd_temp_init_general(E,0);
+}
+
+
+
+/*
+
+initialize temperatures from grd files for spherical geometry
+
+*/
+
+void ggrd_temp_init_general(struct All_variables *E,int is_global)
+{
+
+ MPI_Status mpi_stat;
+ int mpi_rc;
+ int mpi_inmsg, mpi_success_message = 1;
+ double temp1,tbot,tgrad,tmean,tadd,rho_prem;
+ char gmt_string[10];
+ int i,j,k,m,node,noxnoz,nox,noy,noz;
+ static ggrd_boolean shift_to_pos_lon = FALSE;
+
+ if(is_global) /* decide on GMT flag */
+ sprintf(gmt_string,GGRD_GMT_GLOBAL_STRING); /* global */
+ else
+ sprintf(gmt_string,"");
+
+ noy=E->lmesh.noy;
+ nox=E->lmesh.nox;
+ noz=E->lmesh.noz;
+ noxnoz = nox * noz;
+
+ if(E->parallel.me == 0)
+ fprintf(stderr,"ggrd_temp_init_general: using GMT grd files for temperatures, gmtflag: %s\n",gmt_string);
+ /*
+
+
+ read in tempeatures/density from GMT grd files
+
+
+ */
+ /*
+
+ begin MPI synchronization part
+
+ */
+ if(E->parallel.me > 0){
+ /*
+ wait for the previous processor
+ */
+ mpi_rc = MPI_Recv(&mpi_inmsg, 1, MPI_INT, (E->parallel.me-1),
+ 0, E->parallel.world, &mpi_stat);
+ }
+
+ if(E->control.ggrd.temp.scale_with_prem){/* initialize PREM */
+ if(prem_read_model(E->control.ggrd.temp.prem.model_filename,
+ &E->control.ggrd.temp.prem, (E->parallel.me == 0)))
+ myerror(E,"PREM init error");
+ }
+ /*
+ initialize the GMT grid files
+ */
+ E->control.ggrd.temp.d[0].init = FALSE;
+ if(ggrd_grdtrack_init_general(TRUE,E->control.ggrd.temp.gfile,
+ E->control.ggrd.temp.dfile,gmt_string,
+ E->control.ggrd.temp.d,(E->parallel.me == 0),
+ FALSE))
+ myerror(E,"grd init error");
+ /* */
+ if(E->parallel.me < E->parallel.nproc-1){
+ /* tell the next processor to go ahead with the init step */
+ mpi_rc = MPI_Send(&mpi_success_message, 1, MPI_INT, (E->parallel.me+1), 0, E->parallel.world);
+ }else{
+ fprintf(stderr,"ggrd_temp_init_general: last processor (%i) done with grd init\n",
+ E->parallel.me);
+ }
+ /*
+
+ interpolate densities to temperature given PREM variations
+
+ */
+ if(E->mesh.bottbc == 1){
+ /* bottom has specified temperature */
+ tbot = E->control.TBCbotval;
+ }else{
+ /*
+ bottom has specified heat flux start with unity bottom temperature
+ */
+ tbot = 1.0;
+ }
+ /*
+ mean temp is (top+bot)/2 + offset
+ */
+ tmean = (tbot + E->control.TBCtopval)/2.0 + E->control.ggrd.temp.offset;
+
+
+ for(m=1;m <= E->sphere.caps_per_proc;m++)
+ for(i=1;i <= noy;i++)
+ for(j=1;j <= nox;j++)
+ for(k=1;k <= noz;k++) {
+ /* node numbers */
+ node=k+(j-1)*noz+(i-1)*noxnoz;
+
+ /*
+ get interpolated velocity anomaly
+ */
+ if(!ggrd_grdtrack_interpolate_rtp((double)E->sx[m][3][node],(double)E->sx[m][1][node],
+ (double)E->sx[m][2][node],
+ E->control.ggrd.temp.d,&tadd,
+ FALSE,shift_to_pos_lon)){
+ fprintf(stderr,"%g %g %g\n",E->sx[m][2][node]*57.29577951308232087,
+ 90-E->sx[m][1][node]*57.29577951308232087,(1-E->sx[m][3][node])*6371);
+
+ myerror(E,"ggrd__temp_init_general: interpolation error");
+
+ }
+ if(E->control.ggrd.temp.scale_with_prem){
+ /*
+ get the PREM density at r for additional scaling
+ */
+ prem_get_rho(&rho_prem,(double)E->sx[m][3][node],&E->control.ggrd.temp.prem);
+ if(rho_prem < 3200.0)
+ rho_prem = 3200.0; /* we don't want the density of water */
+ /*
+ assign temperature
+ */
+ E->T[m][node] = tmean + tadd * E->control.ggrd.temp.scale *
+ rho_prem / E->data.density;
+ }else{
+ /* no PREM scaling */
+ E->T[m][node] = tmean + tadd * E->control.ggrd.temp.scale;
+ }
+
+ if(E->control.ggrd.temp.limit_trange){
+ /* limit to 0 < T < 1 ?*/
+ E->T[m][node] = min(max(E->T[m][node], 0.0),1.0);
+ }
+ //fprintf(stderr,"z: %11g T: %11g\n",E->sx[m][3][node],E->T[m][node]);
+ if(E->control.ggrd.temp.override_tbc){
+ if((k == 1) && (E->mesh.bottbc == 1)){ /* bottom TBC */
+ E->sphere.cap[m].TB[1][node] = E->T[m][node];
+ E->sphere.cap[m].TB[2][node] = E->T[m][node];
+ E->sphere.cap[m].TB[3][node] = E->T[m][node];
+ //fprintf(stderr,"z: %11g TBB: %11g\n",E->sx[m][3][node],E->T[m][node]);
+ }
+ if((k == noz) && (E->mesh.toptbc == 1)){ /* top TBC */
+ E->sphere.cap[m].TB[1][node] = E->T[m][node];
+ E->sphere.cap[m].TB[2][node] = E->T[m][node];
+ E->sphere.cap[m].TB[3][node] = E->T[m][node];
+ //fprintf(stderr,"z: %11g TBT: %11g\n",E->sx[m][3][node],E->T[m][node]);
+ }
+ }
+
+
+
+ }
+ /*
+ free the structure, not needed anymore since T should now
+ change internally
+ */
+ ggrd_grdtrack_free_gstruc(E->control.ggrd.temp.d);
+ /*
+ end temperature/density from GMT grd init
+ */
+ temperatures_conform_bcs(E);
+}
+
+/*
+
+
+read in material, i.e. viscosity prefactor from ggrd file, this will get assigned if
+
+layer <= E->control.ggrd.mat_control
+
+
+*/
+void ggrd_read_mat_from_file(struct All_variables *E, int is_global)
+{
+ MPI_Status mpi_stat;
+ int mpi_rc,timedep,interpolate;
+ int mpi_inmsg, mpi_success_message = 1;
+ int m,el,i,j,k,inode,i1,i2,elxlz,elxlylz,ind;
+ int llayer,nox,noy,noz,nox1,noz1,noy1,level,lselect,idim,elx,ely,elz;
+ char gmt_string[10],char_dummy;
+ double indbl,indbl2,age,f1,f2,vip,rout[3],xloc[4];
+ char tfilename[1000];
+ static ggrd_boolean shift_to_pos_lon = FALSE;
+ const int dims=E->mesh.nsd;
+ const int ends = enodes[dims];
+
+ nox=E->mesh.nox;noy=E->mesh.noy;noz=E->mesh.noz;
+ nox1=E->lmesh.nox;noz1=E->lmesh.noz;noy1=E->lmesh.noy;
+ elx=E->lmesh.elx;elz=E->lmesh.elz;ely=E->lmesh.ely;
+ elxlz = elx * elz;
+ elxlylz = elxlz * ely;
+
+ /*
+ if we have not initialized the time history structure, do it now
+ */
+ if(!E->control.ggrd.time_hist.init){
+ /*
+ init times, if available
+ */
+ ggrd_init_thist_from_file(&E->control.ggrd.time_hist,
+ E->control.ggrd.time_hist.file,TRUE,(E->parallel.me == 0));
+ E->control.ggrd.time_hist.init = 1;
+ }
+ /* time dependent? */
+ timedep = (E->control.ggrd.time_hist.nvtimes > 1)?(1):(0);
+ if(!E->control.ggrd.mat_control_init){
+ /* assign the general depth dependent material group */
+ construct_mat_group(E);
+ if(E->parallel.me==0)
+ fprintf(stderr,"ggrd_read_mat_from_file: initializing ggrd materials, assigning to all above %g km\n",
+ E->data.radius_km*E->viscosity.zbase_layer[E->control.ggrd.mat_control-1]);
+ if(is_global) /* decide on GMT flag */
+ sprintf(gmt_string,GGRD_GMT_GLOBAL_STRING); /* global */
+ else
+ sprintf(gmt_string,"");
+ /*
+
+ initialization steps
+
+ */
+ if(E->parallel.me > 0) /* wait for previous processor */
+ mpi_rc = MPI_Recv(&mpi_inmsg, 1, MPI_INT, (E->parallel.me-1),
+ 0, E->parallel.world, &mpi_stat);
+ /*
+ read in the material file(s)
+ */
+ E->control.ggrd.mat = (struct ggrd_gt *)calloc(E->control.ggrd.time_hist.nvtimes,sizeof(struct ggrd_gt));
+ for(i=0;i < E->control.ggrd.time_hist.nvtimes;i++){
+ if(!timedep) /* constant */
+ sprintf(tfilename,"%s",E->control.ggrd.mat_file);
+ else
+ sprintf(tfilename,"%s/%i/weak.grd",E->control.ggrd.mat_file,i+1);
+ /* 2D file init */
+ if(ggrd_grdtrack_init_general(FALSE,tfilename,&char_dummy,
+ gmt_string,(E->control.ggrd.mat+i),(E->parallel.me == 0),FALSE))
+ myerror(E,"ggrd init error");
+ }
+ if(E->parallel.me < E->parallel.nproc-1){ /* tell the next proc to go ahead */
+ mpi_rc = MPI_Send(&mpi_success_message, 1,
+ MPI_INT, (E->parallel.me+1), 0, E->parallel.world);
+ }else{
+ fprintf(stderr,"ggrd_read_mat_from_file: last processor done with ggrd mat init\n");
+ fprintf(stderr,"ggrd_read_mat_from_file: WARNING: assuming a regular grid geometry\n");
+ }
+
+ /* end init */
+ }
+ if(timedep || (!E->control.ggrd.mat_control_init)){
+ age = find_age_in_MY(E);
+ if(E->parallel.me == 0)
+ fprintf(stderr,"ggrd_read_mat_from_ggrd_file: assigning at age %g\n",age);
+ if(timedep){
+ ggrd_interpol_time(age,&E->control.ggrd.time_hist,&i1,&i2,&f1,&f2,
+ E->control.ggrd.time_hist.vstage_transition);
+ interpolate = 1;
+ }else{
+ interpolate = 0;
+ i1 = 0;
+ }
+ /*
+ loop through all elements and assign
+ */
+ for (m=1;m <= E->sphere.caps_per_proc;m++) {
+ for (j=1;j <= elz;j++) { /* this assumes a regular grid sorted as in (1)!!! */
+ if(E->mat[m][j] <= E->control.ggrd.mat_control ){
+ /*
+ lithosphere or asthenosphere
+ */
+ for (k=1;k <= ely;k++){
+ for (i=1;i <= elx;i++) {
+ /* eq.(1) */
+ el = j + (i-1) * elz + (k-1)*elxlz;
+ /*
+ find average horizontal coordinate
+
+ (DO WE HAVE THIS STORED ALREADY, E.G. FROM PRESSURE
+ EVAL FORM FUNCTION???)
+ */
+ xloc[1] = xloc[2] = xloc[3] = 0.0;
+ for(inode=1;inode <= 4;inode++){
+ ind = E->ien[m][el].node[inode];
+ xloc[1] += E->x[m][1][ind];xloc[2] += E->x[m][2][ind];xloc[3] += E->x[m][3][ind];
+ }
+ xloc[1]/=4.;xloc[2]/=4.;xloc[3]/=4.;
+ xyz2rtpd(xloc[1],xloc[2],xloc[3],rout);
+ /* material */
+ if(!ggrd_grdtrack_interpolate_tp(rout[1],rout[2],(E->control.ggrd.mat+i1),&indbl,
+ FALSE,shift_to_pos_lon)){
+ fprintf(stderr,"ggrd_read_mat_from_ggrd_file: interpolation error at lon: %g lat: %g\n",
+ rout[2]*180/M_PI,90-rout[1]*180/M_PI);
+ parallel_process_termination();
+ }
+ if(interpolate){
+ if(!ggrd_grdtrack_interpolate_tp((double)rout[1],(double)rout[2],
+ (E->control.ggrd.mat+i2),&indbl2,
+ FALSE,shift_to_pos_lon)){
+ fprintf(stderr,"ggrd_read_mat_from_ggrd_file: interpolation error at lon: %g lat: %g\n",
+ rout[2]*180/M_PI,90-rout[1]*180/M_PI);
+ parallel_process_termination();
+ }
+ /* average smoothly between the two tectonic stages */
+ vip = exp((f1*log(indbl)+f2*log(indbl2)));
+ }else{
+ vip = indbl;
+ }
+ /* limit the input scaling? */
+ if(vip < 1e-5)
+ vip = 1e-5;
+ if(vip > 1e5)
+ vip = 1e5;
+ E->VIP[m][el] = vip;
+ }
+ }
+ }else{
+ /* outside the lithosphere */
+ for (k=1;k <= ely;k++){
+ for (i=1;i <= elx;i++) {
+ el = j + (i-1) * elz + (k-1)*elxlz;
+ /* no scaling else */
+ E->VIP[m][el] = 1.0;
+ }
+ }
+ }
+ } /* end elz loop */
+ } /* end m loop */
+ } /* end assignment loop */
+ if((!timedep) && (!E->control.ggrd.mat_control_init)){ /* forget the grid */
+ ggrd_grdtrack_free_gstruc(E->control.ggrd.mat);
+ }
+ E->control.ggrd.mat_control_init = 1;
+} /* end mat control */
+
+
+/*
+
+
+read in Rayleigh number prefactor from file, this will get assigned if
+
+layer <= E->control.ggrd.ray_control
+
+
+I.e. this function can be used to assign a laterally varying prefactor
+to the rayleigh number in the surface layers, e.g. to have a simple
+way to represent stationary, chemical heterogeneity
+
+*/
+void ggrd_read_ray_from_file(struct All_variables *E, int is_global)
+{
+ MPI_Status mpi_stat;
+ int mpi_rc,timedep,interpolate;
+ int mpi_inmsg, mpi_success_message = 1;
+ int m,el,i,j,k,node,i1,i2,elxlz,elxlylz,ind;
+ int llayer,nox,noy,noz,nox1,noz1,noy1,lev,lselect,idim,elx,ely,elz;
+ char gmt_string[10],char_dummy;
+ double indbl,indbl2,age,f1,f2,vip,rout[3],xloc[4];
+ char tfilename[1000];
+ static ggrd_boolean shift_to_pos_lon = FALSE;
+
+ const int dims=E->mesh.nsd;
+ const int ends = enodes[dims];
+ /* dimensional ints */
+ nox=E->mesh.nox;noy=E->mesh.noy;noz=E->mesh.noz;
+ nox1=E->lmesh.nox;noz1=E->lmesh.noz;noy1=E->lmesh.noy;
+ elx=E->lmesh.elx;elz=E->lmesh.elz;ely=E->lmesh.ely;
+ elxlz = elx * elz;
+ elxlylz = elxlz * ely;
+ lev=E->mesh.levmax;
+ /*
+ if we have not initialized the time history structure, do it now
+ any function can do that
+
+ we could only use the surface processors, but maybe the rayleigh
+ number is supposed to be changed at large depths
+ */
+ if(!E->control.ggrd.time_hist.init){
+ ggrd_init_thist_from_file(&E->control.ggrd.time_hist,
+ E->control.ggrd.time_hist.file,TRUE,(E->parallel.me == 0));
+ E->control.ggrd.time_hist.init = 1;
+ }
+ timedep = (E->control.ggrd.time_hist.nvtimes > 1)?(1):(0);
+ if(!E->control.ggrd.ray_control_init){
+ /* init step */
+ if(E->parallel.me==0)
+ fprintf(stderr,"ggrd_read_ray_from_file: initializing from %s\n",E->control.ggrd.ray_file);
+ if(is_global) /* decide on GMT flag */
+ sprintf(gmt_string,GGRD_GMT_GLOBAL_STRING); /* global */
+ else
+ sprintf(gmt_string,"");
+ if(E->parallel.me > 0) /* wait for previous processor */
+ mpi_rc = MPI_Recv(&mpi_inmsg, 1, MPI_INT, (E->parallel.me-1),
+ 0, E->parallel.world, &mpi_stat);
+ E->control.ggrd.ray = (struct ggrd_gt *)calloc(E->control.ggrd.time_hist.nvtimes,sizeof(struct ggrd_gt));
+ for(i=0;i < E->control.ggrd.time_hist.nvtimes;i++){
+ if(!timedep) /* constant */
+ sprintf(tfilename,"%s",E->control.ggrd.ray_file);
+ else
+ sprintf(tfilename,"%s/%i/rayleigh.grd",E->control.ggrd.ray_file,i+1);
+ if(ggrd_grdtrack_init_general(FALSE,tfilename,&char_dummy,
+ gmt_string,(E->control.ggrd.ray+i),(E->parallel.me == 0),FALSE))
+ myerror(E,"ggrd init error");
+ }
+ if(E->parallel.me < E->parallel.nproc-1){ /* tell the next proc to go ahead */
+ mpi_rc = MPI_Send(&mpi_success_message, 1,
+ MPI_INT, (E->parallel.me+1), 0, E->parallel.world);
+ }else{
+ fprintf(stderr,"ggrd_read_ray_from_file: last processor done with ggrd ray init\n");
+ }
+ E->control.surface_rayleigh = (float *)malloc(sizeof(float)*(E->lmesh.nsf+2));
+ if(!E->control.surface_rayleigh)
+ myerror(E,"ggrd rayleigh mem error");
+ }
+ if(timedep || (!E->control.ggrd.ray_control_init)){
+ if(timedep){
+ age = find_age_in_MY(E);
+ ggrd_interpol_time(age,&E->control.ggrd.time_hist,&i1,&i2,&f1,&f2,
+ E->control.ggrd.time_hist.vstage_transition);
+ interpolate = 1;
+ }else{
+ interpolate = 0;i1 = 0;
+ }
+ if(E->parallel.me == 0)
+ fprintf(stderr,"ggrd_read_ray_from_ggrd_file: assigning at time %g\n",age);
+ for (m=1;m <= E->sphere.caps_per_proc;m++) {
+ /* loop through all surface nodes */
+ for (j=1;j <= E->lmesh.nsf;j++) {
+ node = j * E->lmesh.noz ;
+ rout[1] = (double)E->sx[m][1][node];
+ rout[2] = (double)E->sx[m][2][node];
+ if(!ggrd_grdtrack_interpolate_tp(rout[1],rout[2],(E->control.ggrd.ray+i1),&indbl,
+ FALSE,shift_to_pos_lon)){
+ fprintf(stderr,"ggrd_read_ray_from_ggrd_file: interpolation error at %g, %g\n",
+ rout[1],rout[2]);
+ parallel_process_termination();
+ }
+ //fprintf(stderr,"%i %i %g %g %g\n",j,E->lmesh.nsf,rout[1],rout[2],indbl);
+ if(interpolate){
+ if(!ggrd_grdtrack_interpolate_tp(rout[1],rout[2],
+ (E->control.ggrd.ray+i2),&indbl2,
+ FALSE,shift_to_pos_lon)){
+ fprintf(stderr,"ggrd_read_ray_from_ggrd_file: interpolation error at %g, %g\n",
+ rout[1],rout[2]);
+ parallel_process_termination();
+ }
+ /* average smoothly between the two tectonic stages */
+ vip = f1*indbl+f2*indbl2;
+ }else{
+ vip = indbl;
+ }
+ E->control.surface_rayleigh[j] = vip;
+ } /* end node loop */
+ } /* end cap loop */
+ } /* end assign loop */
+ if((!timedep) && (!E->control.ggrd.ray_control_init)){ /* forget the grid */
+ ggrd_grdtrack_free_gstruc(E->control.ggrd.ray);
+ }
+ E->control.ggrd.ray_control_init = 1;
+} /* end ray control */
+
+
+/*
+
+read surface velocity boundary conditions from netcdf grd files
+
+
+*/
+
+
+
+void ggrd_read_vtop_from_file(struct All_variables *E, int is_global)
+{
+ MPI_Status mpi_stat;
+ int mpi_rc,interpolate,timedep,use_codes,code;
+ int mpi_inmsg, mpi_success_message = 1;
+ int m,el,i,k,i1,i2,ind,nodel,j,level;
+ int noxg,nozg,noyg,noxl,noyl,nozl,lselect,idim,noxgnozg,noxlnozl,save_codes;
+ char gmt_string[10],char_dummy;
+ static int lc =0; /* only for debugging */
+ double vin1[2],vin2[2],age,f1,f2,vscale,rout[3],cutoff,v[3],sin_theta,vx[4],
+ cos_theta,sin_phi,cos_phi,theta_max,theta_min;
+ char tfilename1[1000],tfilename2[1000];
+ static pole_warned = FALSE;
+ static ggrd_boolean shift_to_pos_lon = FALSE;
+ const int dims=E->mesh.nsd;
+#ifdef USE_GZDIR
+ gzFile *fp1;
+#else
+ myerror(E,"ggrd_read_vtop_from_file needs to use GZDIR (set USE_GZDIR flag) because of code output");
+#endif
+ /* read in plate code files? */
+ use_codes = (E->control.ggrd_vtop_omega[0] > 1e-7)?(1):(0);
+ save_codes = 0;
+ /* */
+ if(E->mesh.topvbc != 1)
+ myerror(E,"ggrd_read_vtop_from_file: top velocity BCs, but topvbc is free slip");
+ /* global, top level number of nodes */
+ noxg = E->lmesh.nox;nozg=E->lmesh.noz;noyg=E->lmesh.noy;
+ noxgnozg = noxg*nozg;
+
+ /*
+ velocity scaling, assuming input is cm/yr
+ */
+ vscale = E->data.scalev * E->data.timedir;
+ if(use_codes)
+ vscale *= E->data.radius_km*1e3/1e6*1e2*M_PI/180.; /* for deg/Myr -> cm/yr conversion */
+ if (E->parallel.me_loc[3] == E->parallel.nprocz-1) {
+
+ /*
+ TOP PROCESSORs ONLY
+
+ */
+
+ /*
+ if we have not initialized the time history structure, do it now
+ if this file is not found, will use constant velocities
+ */
+ if(!E->control.ggrd.time_hist.init){/* init times, if available*/
+ ggrd_init_thist_from_file(&E->control.ggrd.time_hist,E->control.ggrd.time_hist.file,
+ TRUE,(E->parallel.me == 0));
+ E->control.ggrd.time_hist.init = 1;
+ }
+ timedep = (E->control.ggrd.time_hist.nvtimes > 1)?(1):(0);
+
+ if(!E->control.ggrd.vtop_control_init){
+ /*
+ read in grd files (only needed for top processors, really, but
+ leave as is for now
+ */
+ if(E->parallel.me==0)
+ fprintf(stderr,"ggrd_read_vtop_from_file: initializing ggrd velocities for %s setup\n",
+ is_global?("global"):("regional"));
+ if(is_global){ /* decide on GMT flag */
+ //sprintf(gmt_string,""); /* periodic */
+ sprintf(gmt_string,GGRD_GMT_GLOBAL_STRING); /* global */
+ }else
+ sprintf(gmt_string,"");
+
+ /*
+
+ initialization steps
+
+ */
+ /*
+ read in the velocity file(s)
+ */
+ E->control.ggrd.svt = (struct ggrd_gt *)calloc(E->control.ggrd.time_hist.nvtimes,sizeof(struct ggrd_gt));
+ E->control.ggrd.svp = (struct ggrd_gt *)calloc(E->control.ggrd.time_hist.nvtimes,sizeof(struct ggrd_gt));
+ /* for detecting the actual max */
+ E->control.ggrd.svt->bandlim = E->control.ggrd.svp->bandlim = 1e6;
+ for(i=0;i < E->control.ggrd.time_hist.nvtimes;i++){
+ /*
+
+ by default, all velocity grids will be stored in memory, this
+ may or may not be ideal
+
+ */
+ if(!timedep){ /* constant */
+ if(use_codes)
+ sprintf(tfilename1,"%s/code.grd",E->control.ggrd.vtop_dir);
+ else{
+ sprintf(tfilename1,"%s/vt.grd",E->control.ggrd.vtop_dir);
+ sprintf(tfilename2,"%s/vp.grd",E->control.ggrd.vtop_dir);
+ }
+ } else { /* f(t) */
+ if(use_codes)
+ sprintf(tfilename1,"%s/%i/code.grd",E->control.ggrd.vtop_dir,i+1);
+ else{
+ sprintf(tfilename1,"%s/%i/vt.grd",E->control.ggrd.vtop_dir,i+1);
+ sprintf(tfilename2,"%s/%i/vp.grd",E->control.ggrd.vtop_dir,i+1);
+ }
+ }
+ if(use_codes){
+ if(ggrd_grdtrack_init_general(FALSE,tfilename1,&char_dummy,
+ gmt_string,(E->control.ggrd.svt+i),(E->parallel.me == 0),FALSE))
+ myerror(E,"ggrd init error codes");
+
+ }else{
+ if(ggrd_grdtrack_init_general(FALSE,tfilename1,&char_dummy,
+ gmt_string,(E->control.ggrd.svt+i),(E->parallel.me == 0),FALSE))
+ myerror(E,"ggrd init error vt");
+ if(ggrd_grdtrack_init_general(FALSE,tfilename2,&char_dummy,
+ gmt_string,(E->control.ggrd.svp+i),(E->parallel.me == 0),FALSE))
+ myerror(E,"ggrd init error vp");
+ }
+ }/* all grids read */
+ if(use_codes){
+ save_codes = 1;
+ snprintf(tfilename1,1000,"%s/codes.%d.gz", E->control.data_dir,E->parallel.me);
+ fp1 = gzdir_output_open(tfilename1,"w");
+ }
+ if(E->parallel.me == 0)
+ if(use_codes)
+ fprintf(stderr,"ggrd_read_vtop_from_file: assigning Euler vector %g, %g, %g to plates with code %i\n",
+ E->control.ggrd_vtop_omega[1],
+ E->control.ggrd_vtop_omega[2],
+ E->control.ggrd_vtop_omega[3],
+ (int)E->control.ggrd_vtop_omega[0]);
+ else
+ fprintf(stderr,"ggrd_read_vtop_from_file: done with ggrd vtop BC init, %i timesteps, vp band lim max: %g\n",
+ E->control.ggrd.time_hist.nvtimes,E->control.ggrd.svp->fmaxlim[0]);
+ } /* end init */
+
+ /* geographic bounds */
+ theta_max = (90-E->control.ggrd.svp[i1].south)*M_PI/180-1e-5;
+ theta_min = (90-E->control.ggrd.svp[i1].north)*M_PI/180+1e-5;
+ if((E->parallel.me ==0) && (is_global)){
+ fprintf(stderr,"ggrd_read_vtop_from_file: determined South/North range: %g/%g\n",
+ E->control.ggrd.svp[i1].south,E->control.ggrd.svp[i1].north);
+ }
+
+ if((E->control.ggrd.time_hist.nvtimes > 1)|| (!E->control.ggrd.vtop_control_init)){
+ /*
+ either first time around, or time-dependent assignment
+ */
+ age = find_age_in_MY(E);
+ if(timedep){
+ /*
+ interpolate by time
+ */
+ if(age < 0){ /* Opposite of other method */
+ interpolate = 0;
+ /* present day should be last file*/
+ i1 = E->control.ggrd.time_hist.nvtimes - 1;
+ if(E->parallel.me == 0)
+ fprintf(stderr,"ggrd_read_vtop_from_file: using present day vtop for age = %g\n",age);
+ }else{
+ /* */
+ ggrd_interpol_time(age,&E->control.ggrd.time_hist,&i1,&i2,&f1,&f2,
+ E->control.ggrd.time_hist.vstage_transition);
+ interpolate = 1;
+ if(E->parallel.me == 0)
+ fprintf(stderr,"ggrd_read_vtop_from_file: interpolating vtop for age = %g\n",age);
+ }
+
+ }else{
+ interpolate = 0; /* single timestep, use single file */
+ i1 = 0;
+ if(E->parallel.me == 0)
+ fprintf(stderr,"ggrd_read_vtop_from_file: temporally constant velocity BC \n");
+ }
+
+ if(E->parallel.me==0){
+ fprintf(stderr,"ggrd_read_vtop_from_file: assigning velocities BC, timedep: %i time: %g\n",
+ timedep,age);
+
+ }
+ /* if mixed BCs are allowed, need to reassign the boundary
+ condition */
+ if(E->control.ggrd_allow_mixed_vbcs){
+
+ /*
+
+ mixed BC part
+
+ */
+ if(use_codes)
+ myerror(E,"cannot mix Euler velocities for plate codes and mixed vbcs");
+ if(E->parallel.me == 0)
+ fprintf(stderr,"WARNING: allowing mixed velocity BCs\n");
+
+
+ /* velocities larger than the cutoff will be assigned as free
+ slip */
+ cutoff = E->control.ggrd.svp->fmaxlim[0] + 1e-5;
+ for(level=E->mesh.gridmax;level>=E->mesh.gridmin;level--){/* multigrid levels */
+ noxl = E->lmesh.NOX[level];
+ noyl = E->lmesh.NOY[level];
+ nozl = E->lmesh.NOZ[level];
+ noxlnozl = noxl*nozl;
+ for (m=1;m <= E->sphere.caps_per_proc;m++) {
+ /*
+ loop through all horizontal nodes
+ */
+ for(i=1;i<=noyl;i++){
+ for(j=1;j<=noxl;j++) {
+ nodel = j * nozl + (i-1)*noxlnozl; /* top node = nozl + (j-1) * nozl + (i-1)*noxlnozl; */
+ /* node location */
+ rout[1] = E->SX[level][m][1][nodel]; /* theta,phi */
+ /*
+
+ for global grid, shift theta if too close to poles
+
+ */
+ if((is_global)&&(rout[1] > theta_max)){
+ if(!pole_warned){
+ fprintf(stderr,"WARNING: shifting theta from %g (%g) to max theta %g (%g)\n",
+ rout[1],90-180/M_PI*rout[1],theta_max,90-180/M_PI*theta_max);
+ pole_warned = TRUE;
+ }
+ rout[1] = theta_max;
+ }
+ if((is_global)&&(rout[1] < theta_min)){
+ if(!pole_warned){
+ fprintf(stderr,"WARNING: shifting theta from %g (%g) to min theta %g (%g)\n",
+ rout[1],90-180/M_PI*rout[1],theta_min,90-180/M_PI*theta_min);
+ pole_warned = TRUE;
+ }
+ rout[1] = theta_min;
+ }
+ /* */
+ rout[2] = E->SX[level][m][2][nodel];
+ /* find vp */
+ if(!ggrd_grdtrack_interpolate_tp(rout[1],rout[2],(E->control.ggrd.svp+i1),
+ vin1,FALSE,shift_to_pos_lon)){
+ fprintf(stderr,"ggrd_read_vtop_from_ggrd_file: interpolation error at %g, %g\n",
+ rout[1],rout[2]);
+ parallel_process_termination();
+ }
+ if(interpolate){ /* second time */
+ if(!ggrd_grdtrack_interpolate_tp(rout[1],rout[2],(E->control.ggrd.svp+i2),vin2,
+ FALSE,shift_to_pos_lon)){
+ fprintf(stderr,"ggrd_read_mat_from_ggrd_file: interpolation error at %g, %g\n",
+ rout[1],rout[2]);
+ parallel_process_termination();
+ }
+ v[2] = (f1*vin1[0] + f2*vin2[0]); /* vphi unscaled! */
+ }else{
+ v[2] = vin1[0]; /* vphi */
+ }
+ if(fabs(v[2]) > cutoff){
+ /* free slip */
+ E->NODE[level][m][nodel] = E->NODE[level][m][nodel] & (~VBX);
+ E->NODE[level][m][nodel] = E->NODE[level][m][nodel] | SBX;
+ E->NODE[level][m][nodel] = E->NODE[level][m][nodel] & (~VBY);
+ E->NODE[level][m][nodel] = E->NODE[level][m][nodel] | SBY;
+ }else{
+ /* no slip */
+ E->NODE[level][m][nodel] = E->NODE[level][m][nodel] | VBX;
+ E->NODE[level][m][nodel] = E->NODE[level][m][nodel] & (~SBX);
+ E->NODE[level][m][nodel] = E->NODE[level][m][nodel] | VBY;
+ E->NODE[level][m][nodel] = E->NODE[level][m][nodel] & (~SBY);
+ }
+ } /* end x loop */
+ } /* end y loop */
+ /* sum up all assignments */
+ } /* cap */
+ } /* level */
+ } /* end mixed BC assign */
+
+ /*
+
+ now loop through all nodes and assign velocity boundary condition
+ values
+
+ */
+ for (m=1;m <= E->sphere.caps_per_proc;m++) {
+ /* scaled cutoff velocity */
+ if(!use_codes) /* else, is not defined */
+ cutoff = E->control.ggrd.svp->fmaxlim[0] * vscale + 1e-5;
+ else{
+ cutoff = 1e30;
+ if(save_codes) /* those will be surface nodes only */
+ gzprintf(fp1,"%3d %7d\n",m,E->lmesh.nsf);
+ }
+ for(k=1;k <= noyg;k++) {/* loop through surface nodes */
+ for(i=1;i <= noxg;i++) {
+ nodel = (k-1)*noxgnozg + i * nozg; /* top node = nozg + (i-1) * nozg + (k-1)*noxgnozg */
+ /* */
+ rout[1] = E->sx[m][1][nodel]; /* theta,phi coordinates */
+
+ /*
+
+ for global grid, shift theta if too close to poles
+
+ */
+ if((is_global)&&(rout[1] > theta_max)){
+ if(!pole_warned){
+ fprintf(stderr,"WARNING: shifting theta from %g (%g) to max theta %g (%g)\n",
+ rout[1],90-180/M_PI*rout[1],theta_max,90-180/M_PI*theta_max);
+ pole_warned = TRUE;
+ }
+ rout[1] = theta_max;
+ }
+ if((is_global)&&(rout[1] < theta_min)){
+ if(!pole_warned){
+ fprintf(stderr,"WARNING: shifting theta from %g (%g) to min theta %g (%g)\n",
+ rout[1],90-180/M_PI*rout[1],theta_min,90-180/M_PI*theta_min);
+ pole_warned = TRUE;
+ }
+ rout[1] = theta_min;
+ }
+
+
+ rout[2] = E->sx[m][2][nodel];
+ if(!ggrd_grdtrack_interpolate_tp(rout[1],rout[2],(E->control.ggrd.svt+i1),
+ vin1,FALSE,shift_to_pos_lon)){
+ fprintf(stderr,"ggrd_read_vtop_from_ggrd_file: interpolation error at %g, %g\n",
+ rout[1],rout[2]);
+ parallel_process_termination();
+ }
+ if(!use_codes)
+ if(!ggrd_grdtrack_interpolate_tp(rout[1],rout[2],(E->control.ggrd.svp+i1),
+ (vin1+1),FALSE,shift_to_pos_lon)){
+ fprintf(stderr,"ggrd_read_vtop_from_ggrd_file: interpolation error at %g, %g\n",
+ rout[1],rout[2]);
+ parallel_process_termination();
+ }
+ if(interpolate){ /* second time */
+ if(!ggrd_grdtrack_interpolate_tp(rout[1],rout[2],(E->control.ggrd.svt+i2),vin2,
+ FALSE,shift_to_pos_lon)){
+ fprintf(stderr,"ggrd_read_mat_from_ggrd_file: interpolation error at %g, %g\n",
+ rout[1],rout[2]);
+ parallel_process_termination();
+ }
+ if(!use_codes){
+ if(!ggrd_grdtrack_interpolate_tp(rout[1],rout[2],(E->control.ggrd.svp+i2),(vin2+1),
+ FALSE,shift_to_pos_lon)){
+ fprintf(stderr,"ggrd_read_mat_from_ggrd_file: interpolation error at %g, %g\n",
+ rout[1],rout[2]);
+ parallel_process_termination();
+ }
+ v[1] = (f1*vin1[0] + f2*vin2[0])*vscale; /* theta */
+ v[2] = (f1*vin1[1] + f2*vin2[1])*vscale; /* phi */
+ }else{
+ v[1] = (f1*vin1[0] + f2*vin2[0]); /* theta */
+ }
+ }else{
+ if(!use_codes){
+ v[1] = vin1[0]*vscale; /* theta */
+ v[2] = vin1[1]*vscale; /* phi */
+ }else{
+ v[1] = vin1[0]; /* theta */
+ }
+ }
+ if(use_codes){
+ /* find code from v[1], theta */
+ code = (int)(v[1] + 0.5);
+ if(save_codes) /* lon lat code */
+ gzprintf(fp1, "%9.4f %9.4f %i\n",
+ rout[2]/M_PI*180,90-rout[1]*180/M_PI,code);
+ if((int)E->control.ggrd_vtop_omega[0] == code){
+ /* within plate */
+ sin_theta=sin(rout[1]);cos_theta=cos(rout[1]);
+ sin_phi =sin(rout[2]);cos_phi= cos(rout[2]);
+ /* compute spherical velocities in cm/yr at this
+ location, assuming rotation pole is in deg/Myr */
+ vx[1]=E->control.ggrd_vtop_omega[2]*E->x[m][3][nodel] - E->control.ggrd_vtop_omega[3]*E->x[m][2][nodel];
+ vx[2]=E->control.ggrd_vtop_omega[3]*E->x[m][1][nodel] - E->control.ggrd_vtop_omega[1]*E->x[m][3][nodel];
+ vx[3]=E->control.ggrd_vtop_omega[1]*E->x[m][2][nodel] - E->control.ggrd_vtop_omega[2]*E->x[m][1][nodel];
+ /* */
+ v[1]= cos_theta*cos_phi*vx[1] + cos_theta*sin_phi*vx[2] - sin_theta*vx[3]; /* theta */
+ v[2]=- sin_phi*vx[1] + cos_phi*vx[2]; /* phie */
+ /* scale */
+ v[1] *= vscale;v[2] *= vscale;
+ }else{
+ v[1] = v[2] = 0.0;
+ }
+ }
+ /* assign velociites */
+ if(fabs(v[2]) > cutoff){
+ /* huge velocitie - free slip */
+ E->sphere.cap[m].VB[1][nodel] = 0; /* theta */
+ E->sphere.cap[m].VB[2][nodel] = 0; /* phi */
+ }else{
+ /* regular no slip , assign velocities as BCs */
+ E->sphere.cap[m].VB[1][nodel] = v[1]; /* theta */
+ E->sphere.cap[m].VB[2][nodel] = v[2]; /* phi */
+ }
+ E->sphere.cap[m].VB[3][nodel] = 0.0; /* r */
+ }
+ } /* end surface node loop */
+ } /* end cap loop */
+
+ if((!timedep)&&(!E->control.ggrd.vtop_control_init)){ /* forget the grids */
+ ggrd_grdtrack_free_gstruc(E->control.ggrd.svt);
+ ggrd_grdtrack_free_gstruc(E->control.ggrd.svp);
+ }
+ } /* end assignment branch */
+ if(use_codes && save_codes){
+ save_codes = 0;
+ gzclose(fp1);
+ }
+ } /* end top proc branch */
+ E->control.ggrd.vtop_control_init = 1;
+ if(E->parallel.me == 0)fprintf(stderr,"vtop from grd done: %i\n",lc++);
+}
+
+
+
+void ggrd_read_age_from_file(struct All_variables *E, int is_global)
+{
+ myerror(E,"not implemented yet");
+} /* end age control */
+
+/* adjust Ra in top boundary layer */
+void ggrd_adjust_tbl_rayleigh(struct All_variables *E,
+ double **buoy)
+{
+ int m,snode,node,i;
+ double xloc,fac,bnew;
+ if(!E->control.ggrd.ray_control_init)
+ myerror(E,"ggrd rayleigh not initialized, but in adjust tbl");
+ if(E->parallel.me == 0)
+ fprintf(stderr,"ggrd__adjust_tbl_rayleigh: adjusting Rayleigh in top %i layers\n",
+ E->control.ggrd.ray_control);
+
+ /*
+ need to scale buoy with the material determined rayleigh numbers
+ */
+ for(m=1;m <= E->sphere.caps_per_proc;m++){
+ for(snode=1;snode <= E->lmesh.nsf;snode++){ /* loop through surface nodes */
+ if(fabs(E->control.surface_rayleigh[snode]-1.0)>1e-6){
+ for(i=1;i <= E->lmesh.noz;i++){ /* go through depth layers */
+ node = (snode-1)*E->lmesh.noz + i; /* global node number */
+ if(layers(E,m,node) <= E->control.ggrd.ray_control){
+ /*
+ node is in top layers
+ */
+ /* depth factor, cos^2 tapered */
+ xloc=1.0 + ((1 - E->sx[m][3][node]) -
+ E->viscosity.zbase_layer[E->control.ggrd.ray_control-1])/
+ E->viscosity.zbase_layer[E->control.ggrd.ray_control-1];
+ fac = cos(xloc*1.5707963267);fac *= fac; /* cos^2
+ tapering,
+ factor
+ decrease from
+ 1 at surface
+ to zero at
+ boundary */
+ bnew = buoy[m][node] * E->control.surface_rayleigh[snode]; /* modified rayleigh */
+ /* debugging */
+ /* fprintf(stderr,"z: %11g tl: %i zm: %11g fac: %11g sra: %11g bnew: %11g bold: %11g\n", */
+ /* (1 - E->sx[m][3][node])*E->data.radius_km,E->control.ggrd.ray_control, */
+ /* E->viscosity.zbase_layer[E->control.ggrd.ray_control-1]*E->data.radius_km, */
+ /* fac,E->control.surface_rayleigh[snode],(fac * bnew + (1-fac)*buoy[m][node]),buoy[m][node]); */
+ buoy[m][node] = fac * bnew + (1-fac)*buoy[m][node];
+ }
+ }
+ }
+ }
+ }
+
+}
+
+
+
+#endif
+
+
Deleted: mc/3D/CitcomS/branches/cxx/lib/Global_operations.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Global_operations.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Global_operations.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,1001 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-#include <mpi.h>
-
-#include <math.h>
-#include <sys/types.h>
-#include "element_definitions.h"
-#include "global_defs.h"
-#ifdef ALLOW_ELLIPTICAL
-double theta_g(double , struct All_variables *);
-#endif
-
-void calc_cbase_at_tp(float , float , float *);
-
-/* ===============================================
- strips horizontal average from nodal field X.
- Assumes orthogonal mesh, otherwise, horizontals
- aren't & another method is required.
- =============================================== */
-
-void remove_horiz_ave(E,X,H,store_or_not)
- struct All_variables *E;
- double **X, *H;
- int store_or_not;
-
-{
- int m,i,j,k,n,nox,noz,noy;
- void return_horiz_ave();
-
- const int dims = E->mesh.nsd;
-
- noy = E->lmesh.noy;
- noz = E->lmesh.noz;
- nox = E->lmesh.nox;
-
- return_horiz_ave(E,X,H);
-
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(k=1;k<=noy;k++)
- for(j=1;j<=nox;j++)
- for(i=1;i<=noz;i++) {
- n = i+(j-1)*noz+(k-1)*noz*nox;
- X[m][n] -= H[i];
- }
-
- return;
-}
-
-
-void remove_horiz_ave2(struct All_variables *E, double **X)
-{
- double *H;
-
- H = (double *)malloc( (E->lmesh.noz+1)*sizeof(double));
- remove_horiz_ave(E, X, H, 0);
- free ((void *) H);
-}
-
-
-void return_horiz_ave(E,X,H)
- struct All_variables *E;
- double **X, *H;
-{
- const int dims = E->mesh.nsd;
- int m,i,j,k,d,nint,noz,nox,noy,el,elz,elx,ely,j1,j2,i1,i2,k1,k2,nproc;
- int top,lnode[5], sizeofH, noz2,iroot;
- double *Have,*temp,aa[5];
- struct Shape_function1 M;
- struct Shape_function1_dA dGamma;
- void get_global_1d_shape_fn();
-
- sizeofH = (2*E->lmesh.noz+2)*sizeof(double);
-
- Have = (double *)malloc(sizeofH);
- temp = (double *)malloc(sizeofH);
-
- noz = E->lmesh.noz;
- noy = E->lmesh.noy;
- elz = E->lmesh.elz;
- elx = E->lmesh.elx;
- ely = E->lmesh.ely;
- noz2 = 2*noz;
-
- for (i=1;i<=elz;i++) {
- temp[i] = temp[i+noz] = 0.0;
- temp[i+1] = temp[i+1+noz] = 0.0;
- top = 0;
- if (i==elz) top = 1;
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for (k=1;k<=ely;k++)
- for (j=1;j<=elx;j++) {
- el = i + (j-1)*elz + (k-1)*elx*elz;
- get_global_1d_shape_fn(E,el,&M,&dGamma,top,m);
-
- lnode[1] = E->ien[m][el].node[1];
- lnode[2] = E->ien[m][el].node[2];
- lnode[3] = E->ien[m][el].node[3];
- lnode[4] = E->ien[m][el].node[4];
-
- for(nint=1;nint<=onedvpoints[E->mesh.nsd];nint++) {
- for(d=1;d<=onedvpoints[E->mesh.nsd];d++)
- temp[i] += X[m][lnode[d]] * E->M.vpt[GMVINDEX(d,nint)]
- * dGamma.vpt[GMVGAMMA(0,nint)];
- temp[i+noz] += dGamma.vpt[GMVGAMMA(0,nint)];
- }
-
- if (i==elz) {
- lnode[1] = E->ien[m][el].node[5];
- lnode[2] = E->ien[m][el].node[6];
- lnode[3] = E->ien[m][el].node[7];
- lnode[4] = E->ien[m][el].node[8];
-
- for(nint=1;nint<=onedvpoints[E->mesh.nsd];nint++) {
- for(d=1;d<=onedvpoints[E->mesh.nsd];d++)
- temp[i+1] += X[m][lnode[d]] * E->M.vpt[GMVINDEX(d,nint)]
- * dGamma.vpt[GMVGAMMA(1,nint)];
- temp[i+1+noz] += dGamma.vpt[GMVGAMMA(1,nint)];
- }
-
- } /* end of if i==elz */
- } /* end of j and k, and m */
- } /* Done for i */
-
- MPI_Allreduce(temp,Have,noz2+1,MPI_DOUBLE,MPI_SUM,E->parallel.horizontal_comm);
-
- for (i=1;i<=noz;i++) {
- if(Have[i+noz] != 0.0)
- H[i] = Have[i]/Have[i+noz];
- }
- /* if (E->parallel.me==0)
- for(i=1;i<=noz;i++)
- fprintf(stderr,"area %d %d %g\n",E->parallel.me,i,Have[i+noz]);
-*/
- free ((void *) Have);
- free ((void *) temp);
-
- return;
- }
-
-void return_horiz_ave_f(E,X,H)
- struct All_variables *E;
- float **X, *H;
-{
- const int dims = E->mesh.nsd;
- int m,i,j,k,d,nint,noz,nox,noy,el,elz,elx,ely,j1,j2,i1,i2,k1,k2,nproc;
- int top,lnode[5], sizeofH, noz2,iroot;
- float *Have,*temp,aa[5];
- struct Shape_function1 M;
- struct Shape_function1_dA dGamma;
- void get_global_1d_shape_fn();
-
- sizeofH = (2*E->lmesh.noz+2)*sizeof(float);
-
- Have = (float *)malloc(sizeofH);
- temp = (float *)malloc(sizeofH);
-
- noz = E->lmesh.noz;
- noy = E->lmesh.noy;
- elz = E->lmesh.elz;
- elx = E->lmesh.elx;
- ely = E->lmesh.ely;
- noz2 = 2*noz;
-
- for (i=1;i<=elz;i++) {
- temp[i] = temp[i+noz] = 0.0;
- temp[i+1] = temp[i+1+noz] = 0.0;
- top = 0;
- if (i==elz) top = 1;
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for (k=1;k<=ely;k++)
- for (j=1;j<=elx;j++) {
- el = i + (j-1)*elz + (k-1)*elx*elz;
- get_global_1d_shape_fn(E,el,&M,&dGamma,top,m);
-
- lnode[1] = E->ien[m][el].node[1];
- lnode[2] = E->ien[m][el].node[2];
- lnode[3] = E->ien[m][el].node[3];
- lnode[4] = E->ien[m][el].node[4];
-
- for(nint=1;nint<=onedvpoints[E->mesh.nsd];nint++) {
- for(d=1;d<=onedvpoints[E->mesh.nsd];d++)
- temp[i] += X[m][lnode[d]] * E->M.vpt[GMVINDEX(d,nint)]
- * dGamma.vpt[GMVGAMMA(0,nint)];
- temp[i+noz] += dGamma.vpt[GMVGAMMA(0,nint)];
- }
-
- if (i==elz) {
- lnode[1] = E->ien[m][el].node[5];
- lnode[2] = E->ien[m][el].node[6];
- lnode[3] = E->ien[m][el].node[7];
- lnode[4] = E->ien[m][el].node[8];
-
- for(nint=1;nint<=onedvpoints[E->mesh.nsd];nint++) {
- for(d=1;d<=onedvpoints[E->mesh.nsd];d++)
- temp[i+1] += X[m][lnode[d]] * E->M.vpt[GMVINDEX(d,nint)]
- * dGamma.vpt[GMVGAMMA(1,nint)];
- temp[i+1+noz] += dGamma.vpt[GMVGAMMA(1,nint)];
- }
-
- } /* end of if i==elz */
- } /* end of j and k, and m */
- } /* Done for i */
-
- MPI_Allreduce(temp,Have,noz2+1,MPI_FLOAT,MPI_SUM,E->parallel.horizontal_comm);
-
- for (i=1;i<=noz;i++) {
- if(Have[i+noz] != 0.0)
- H[i] = Have[i]/Have[i+noz];
- }
- /* if (E->parallel.me==0)
- for(i=1;i<=noz;i++)
- fprintf(stderr,"area %d %d %g\n",E->parallel.me,i,Have[i+noz]);
-*/
- free ((void *) Have);
- free ((void *) temp);
-
- return;
- }
-
-
-/******* RETURN ELEMENTWISE HORIZ AVE ********************************/
-/* */
-/* This function is similar to return_horiz_ave in the citcom code */
-/* however here, elemental horizontal averages are given rather than */
-/* nodal averages. Also note, here is average per element */
-
-void return_elementwise_horiz_ave(E,X,H)
- struct All_variables *E;
- double **X, *H;
-{
-
- int m,i,j,k,d,noz,noy,el,elz,elx,ely,nproc;
- int sizeofH;
- int elz2;
- double *Have,*temp;
-
- sizeofH = (2*E->lmesh.elz+2)*sizeof(double);
-
- Have = (double *)malloc(sizeofH);
- temp = (double *)malloc(sizeofH);
-
- noz = E->lmesh.noz;
- noy = E->lmesh.noy;
- elz = E->lmesh.elz;
- elx = E->lmesh.elx;
- ely = E->lmesh.ely;
- elz2 = 2*elz;
-
- for (i=0;i<=(elz*2+1);i++)
- {
- temp[i]=0.0;
- }
-
- for (i=1;i<=elz;i++)
- {
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- {
- for (k=1;k<=ely;k++)
- {
- for (j=1;j<=elx;j++)
- {
- el = i + (j-1)*elz + (k-1)*elx*elz;
- temp[i] += X[m][el]*E->ECO[E->mesh.levmax][m][el].area;
- temp[i+elz] += E->ECO[E->mesh.levmax][m][el].area;
- }
- }
- }
- }
-
-
-
-/* determine which processors should get the message from me for
- computing the layer averages */
-
- MPI_Allreduce(temp,Have,elz2+1,MPI_DOUBLE,MPI_SUM,E->parallel.horizontal_comm);
-
- for (i=1;i<=elz;i++) {
- if(Have[i+elz] != 0.0)
- H[i] = Have[i]/Have[i+elz];
- }
-
-
- free ((void *) Have);
- free ((void *) temp);
-
- return;
-}
-
-float return_bulk_value(E,Z,average)
- struct All_variables *E;
- float **Z;
- int average;
-
-{
- int n,i,j,k,el,m;
- float volume,integral,volume1,integral1;
-
- const int vpts = vpoints[E->mesh.nsd];
- const int ends = enodes[E->mesh.nsd];
-
- volume1=0.0;
- integral1=0.0;
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for (el=1;el<=E->lmesh.nel;el++) {
-
- for(j=1;j<=vpts;j++)
- for(i=1;i<=ends;i++) {
- n = E->ien[m][el].node[i];
- volume1 += E->N.vpt[GNVINDEX(i,j)] * E->gDA[m][el].vpt[j];
- integral1 += Z[m][n] * E->N.vpt[GNVINDEX(i,j)] * E->gDA[m][el].vpt[j];
- }
-
- }
-
-
- MPI_Allreduce(&volume1 ,&volume ,1,MPI_FLOAT,MPI_SUM,E->parallel.world);
- MPI_Allreduce(&integral1,&integral,1,MPI_FLOAT,MPI_SUM,E->parallel.world);
-
- if(average && volume != 0.0)
- integral /= volume;
-
- return((float)integral);
-}
-
-/************ RETURN BULK VALUE_D *****************************************/
-/* */
-/* Same as return_bulk_value but allowing double instead of float. */
-/* I think when integer average =1, volume average is returned. */
-/* when integer average =0, integral is returned. */
-
-
-double return_bulk_value_d(E,Z,average)
- struct All_variables *E;
- double **Z;
- int average;
-
-{
- int n,i,j,el,m;
- double volume,integral,volume1,integral1;
-
- const int vpts = vpoints[E->mesh.nsd];
- const int ends = enodes[E->mesh.nsd];
-
- volume1=0.0;
- integral1=0.0;
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for (el=1;el<=E->lmesh.nel;el++) {
-
- for(j=1;j<=vpts;j++)
- for(i=1;i<=ends;i++) {
- n = E->ien[m][el].node[i];
- volume1 += E->N.vpt[GNVINDEX(i,j)] * E->gDA[m][el].vpt[j];
- integral1 += Z[m][n] * E->N.vpt[GNVINDEX(i,j)] * E->gDA[m][el].vpt[j];
- }
-
- }
-
-
- MPI_Allreduce(&volume1 ,&volume ,1,MPI_DOUBLE,MPI_SUM,E->parallel.world);
- MPI_Allreduce(&integral1,&integral,1,MPI_DOUBLE,MPI_SUM,E->parallel.world);
-
- if(average && volume != 0.0)
- integral /= volume;
-
- return((double)integral);
-}
-
-/* ================================================== */
-float find_max_horizontal(E,Tmax)
-struct All_variables *E;
-float Tmax;
-{
- float ttmax;
-
- MPI_Allreduce(&Tmax,&ttmax,1,MPI_FLOAT,MPI_MAX,E->parallel.horizontal_comm);
-
- return(ttmax);
- }
-
-/* ================================================== */
-void sum_across_surface(E,data,total)
-struct All_variables *E;
-float *data;
-int total;
-{
- int j,d;
- float *temp;
-
- temp = (float *)malloc((total+1)*sizeof(float));
- MPI_Allreduce(data,temp,total,MPI_FLOAT,MPI_SUM,E->parallel.horizontal_comm);
-
- for (j=0;j<total;j++) {
- data[j] = temp[j];
- }
-
- free((void *)temp);
-
- return;
-}
-
-/* ================================================== */
-/* ================================================== */
-
-/* ================================================== */
-void sum_across_surf_sph1(E,sphc,sphs)
-struct All_variables *E;
-float *sphc,*sphs;
-{
- int jumpp,total,j,d;
- float *sphcs,*temp;
-
- temp = (float *) malloc((E->sphere.hindice*2)*sizeof(float));
- sphcs = (float *) malloc((E->sphere.hindice*2)*sizeof(float));
-
- /* pack */
- jumpp = E->sphere.hindice;
- total = E->sphere.hindice*2;
- for (j=0;j<E->sphere.hindice;j++) {
- sphcs[j] = sphc[j];
- sphcs[j+jumpp] = sphs[j];
- }
-
- /* sum across processors in horizontal direction */
- MPI_Allreduce(sphcs,temp,total,MPI_FLOAT,MPI_SUM,E->parallel.horizontal_comm);
-
- /* unpack */
- for (j=0;j<E->sphere.hindice;j++) {
- sphc[j] = temp[j];
- sphs[j] = temp[j+jumpp];
- }
-
- free((void *)temp);
- free((void *)sphcs);
-
- return;
-}
-
-/* ================================================== */
-
-
-float global_fvdot(E,A,B,lev)
- struct All_variables *E;
- float **A,**B;
- int lev;
-
-{
- int m,i,neq;
- float prod, temp,temp1;
-
- neq=E->lmesh.NEQ[lev];
-
- temp = 0.0;
- temp1 = 0.0;
- prod = 0.0;
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- neq=E->lmesh.NEQ[lev];
- temp1 = 0.0;
- for (i=0;i<neq;i++)
- temp += A[m][i]*B[m][i];
-
- for (i=1;i<=E->parallel.Skip_neq[lev][m];i++)
- temp1 += A[m][E->parallel.Skip_id[lev][m][i]]*B[m][E->parallel.Skip_id[lev][m][i]];
-
- temp -= temp1;
-
- }
-
- MPI_Allreduce(&temp, &prod,1,MPI_FLOAT,MPI_SUM,E->parallel.world);
-
- return (prod);
-}
-
-
-double kineticE_radial(E,A,lev)
- struct All_variables *E;
- double **A;
- int lev;
-
-{
- int m,i,neq;
- double prod, temp,temp1;
-
- temp = 0.0;
- prod = 0.0;
-
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- neq=E->lmesh.NEQ[lev];
- temp1 = 0.0;
- for (i=0;i<neq;i++)
- if ((i+1)%3==0)
- temp += A[m][i]*A[m][i];
-
- for (i=1;i<=E->parallel.Skip_neq[lev][m];i++)
- if ((E->parallel.Skip_id[lev][m][i]+1)%3==0)
- temp1 += A[m][E->parallel.Skip_id[lev][m][i]]*A[m][E->parallel.Skip_id[lev][m][i]];
-
- temp -= temp1;
-
- }
-
- MPI_Allreduce(&temp, &prod,1,MPI_DOUBLE,MPI_SUM,E->parallel.world);
-
- return (prod);
-}
-
-double global_vdot(E,A,B,lev)
- struct All_variables *E;
- double **A,**B;
- int lev;
-
-{
- int m,i,neq;
- double prod, temp,temp1;
-
- temp = 0.0;
- prod = 0.0;
-
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- neq=E->lmesh.NEQ[lev];
- temp1 = 0.0;
- for (i=0;i<neq;i++)
- temp += A[m][i]*B[m][i];
-
- for (i=1;i<=E->parallel.Skip_neq[lev][m];i++)
- temp1 += A[m][E->parallel.Skip_id[lev][m][i]]*B[m][E->parallel.Skip_id[lev][m][i]];
-
- temp -= temp1;
-
- }
-
- MPI_Allreduce(&temp, &prod,1,MPI_DOUBLE,MPI_SUM,E->parallel.world);
-
- return (prod);
-}
-
-
-double global_pdot(E,A,B,lev)
- struct All_variables *E;
- double **A,**B;
- int lev;
-
-{
- int i,m,npno;
- double prod, temp;
-
- npno=E->lmesh.NPNO[lev];
-
- temp = 0.0;
- prod = 0.0;
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- npno=E->lmesh.NPNO[lev];
- for (i=1;i<=npno;i++)
- temp += A[m][i]*B[m][i];
- }
-
- MPI_Allreduce(&temp, &prod,1,MPI_DOUBLE,MPI_SUM,E->parallel.world);
-
- return (prod);
-}
-
-
-/* return ||V||^2 */
-double global_v_norm2(struct All_variables *E, double **V)
-{
- int i, m, d;
- int eqn1, eqn2, eqn3;
- double prod, temp;
-
- temp = 0.0;
- prod = 0.0;
- for (m=1; m<=E->sphere.caps_per_proc; m++)
- for (i=1; i<=E->lmesh.nno; i++) {
- eqn1 = E->id[m][i].doff[1];
- eqn2 = E->id[m][i].doff[2];
- eqn3 = E->id[m][i].doff[3];
- /* L2 norm */
- temp += (V[m][eqn1] * V[m][eqn1] +
- V[m][eqn2] * V[m][eqn2] +
- V[m][eqn3] * V[m][eqn3]) * E->NMass[m][i];
- }
-
- MPI_Allreduce(&temp, &prod, 1, MPI_DOUBLE, MPI_SUM, E->parallel.world);
-
- return (prod/E->mesh.volume);
-}
-
-
-/* return ||P||^2 */
-double global_p_norm2(struct All_variables *E, double **P)
-{
- int i, m;
- double prod, temp;
-
- temp = 0.0;
- prod = 0.0;
- for (m=1; m<=E->sphere.caps_per_proc; m++)
- for (i=1; i<=E->lmesh.npno; i++) {
- /* L2 norm */
- temp += P[m][i] * P[m][i] * E->eco[m][i].area;
- }
-
- MPI_Allreduce(&temp, &prod, 1, MPI_DOUBLE, MPI_SUM, E->parallel.world);
-
- return (prod/E->mesh.volume);
-}
-
-
-/* return ||A||^2, where A_i is \int{div(u) d\Omega_i} */
-double global_div_norm2(struct All_variables *E, double **A)
-{
- int i, m;
- double prod, temp;
-
- temp = 0.0;
- prod = 0.0;
- for (m=1; m<=E->sphere.caps_per_proc; m++)
- for (i=1; i<=E->lmesh.npno; i++) {
- /* L2 norm of div(u) */
- temp += A[m][i] * A[m][i] / E->eco[m][i].area;
-
- /* L1 norm */
- /*temp += fabs(A[m][i]);*/
- }
-
- MPI_Allreduce(&temp, &prod, 1, MPI_DOUBLE, MPI_SUM, E->parallel.world);
-
- return (prod/E->mesh.volume);
-}
-
-
-double global_tdot_d(E,A,B,lev)
- struct All_variables *E;
- double **A,**B;
- int lev;
-
-{
- int i,nno,m;
- double prod, temp;
-
- nno=E->lmesh.NNO[lev];
-
- temp = 0.0;
- prod = 0.0;
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- nno=E->lmesh.NNO[lev];
- for (i=1;i<=nno;i++)
- if (!(E->NODE[lev][m][i] & SKIP))
- temp += A[m][i];
- }
-
- MPI_Allreduce(&temp, &prod,1,MPI_DOUBLE,MPI_SUM,E->parallel.world);
-
- return (prod);
- }
-
-float global_tdot(E,A,B,lev)
- struct All_variables *E;
- float **A,**B;
- int lev;
-
-{
- int i,nno,m;
- float prod, temp;
-
-
- temp = 0.0;
- prod = 0.0;
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- nno=E->lmesh.NNO[lev];
- for (i=1;i<=nno;i++)
- if (!(E->NODE[lev][m][i] & SKIP))
- temp += A[m][i]*B[m][i];
- }
-
- MPI_Allreduce(&temp, &prod,1,MPI_FLOAT,MPI_SUM,E->parallel.world);
-
- return (prod);
- }
-
-
-float global_fmin(E,a)
- struct All_variables *E;
- float a;
-{
- float temp;
- MPI_Allreduce(&a, &temp,1,MPI_FLOAT,MPI_MIN,E->parallel.world);
- return (temp);
- }
-
-double global_dmax(E,a)
- struct All_variables *E;
- double a;
-{
- double temp;
- MPI_Allreduce(&a, &temp,1,MPI_DOUBLE,MPI_MAX,E->parallel.world);
- return (temp);
- }
-
-
-float global_fmax(E,a)
- struct All_variables *E;
- float a;
-{
- float temp;
- MPI_Allreduce(&a, &temp,1,MPI_FLOAT,MPI_MAX,E->parallel.world);
- return (temp);
- }
-
-double Tmaxd(E,T)
- struct All_variables *E;
- double **T;
-{
- double global_dmax(),temp,temp1;
- int i,m;
-
- temp = -10.0;
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=1;i<=E->lmesh.nno;i++)
- temp = max(T[m][i],temp);
-
- temp1 = global_dmax(E,temp);
- return (temp1);
- }
-
-
-float Tmax(E,T)
- struct All_variables *E;
- float **T;
-{
- float global_fmax(),temp,temp1;
- int i,m;
-
- temp = -10.0;
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=1;i<=E->lmesh.nno;i++)
- temp = max(T[m][i],temp);
-
- temp1 = global_fmax(E,temp);
- return (temp1);
- }
-
-
-double vnorm_nonnewt(E,dU,U,lev)
- struct All_variables *E;
- double **dU,**U;
- int lev;
-{
- double temp1,temp2,dtemp,temp;
- int a,e,i,m,node;
- const int dims = E->mesh.nsd;
- const int ends = enodes[dims];
- const int nel=E->lmesh.nel;
-
- dtemp=0.0;
- temp=0.0;
-for (m=1;m<=E->sphere.caps_per_proc;m++)
- for (e=1;e<=nel;e++)
- /*if (E->mat[m][e]==1)*/
- for (i=1;i<=dims;i++)
- for (a=1;a<=ends;a++) {
- node = E->IEN[lev][m][e].node[a];
- dtemp += dU[m][ E->ID[lev][m][node].doff[i] ]*
- dU[m][ E->ID[lev][m][node].doff[i] ];
- temp += U[m][ E->ID[lev][m][node].doff[i] ]*
- U[m][ E->ID[lev][m][node].doff[i] ];
- }
-
-
- MPI_Allreduce(&dtemp, &temp2,1,MPI_DOUBLE,MPI_SUM,E->parallel.world);
- MPI_Allreduce(&temp, &temp1,1,MPI_DOUBLE,MPI_SUM,E->parallel.world);
-
- temp1 = sqrt(temp2/temp1);
-
- return (temp1);
-}
-
-
-void sum_across_depth_sph1(E,sphc,sphs)
- struct All_variables *E;
- float *sphc,*sphs;
-{
- int jumpp,total,j;
-
- float *sphcs,*temp;
-
- if (E->parallel.nprocz > 1) {
- total = E->sphere.hindice*2;
- temp = (float *) malloc(total*sizeof(float));
- sphcs = (float *) malloc(total*sizeof(float));
-
- /* pack sphc[] and sphs[] into sphcs[] */
- jumpp = E->sphere.hindice;
- for (j=0;j<E->sphere.hindice;j++) {
- sphcs[j] = sphc[j];
- sphcs[j+jumpp] = sphs[j];
- }
-
- /* sum across processors in z direction */
- MPI_Allreduce(sphcs, temp, total, MPI_FLOAT, MPI_SUM,
- E->parallel.vertical_comm);
-
- /* unpack */
- for (j=0;j<E->sphere.hindice;j++) {
- sphc[j] = temp[j];
- sphs[j] = temp[j+jumpp];
- }
-
- free(temp);
- free(sphcs);
- }
-
-
- return;
-}
-
-
-/* ================================================== */
-/* ================================================== */
-void broadcast_vertical(struct All_variables *E,
- float *sphc, float *sphs,
- int root)
-{
- int jumpp, total, j;
- float *temp;
-
- if(E->parallel.nprocz == 1) return;
-
- jumpp = E->sphere.hindice;
- total = E->sphere.hindice*2;
- temp = (float *) malloc(total*sizeof(float));
-
- if (E->parallel.me_loc[3] == root) {
- /* pack */
- for (j=0; j<E->sphere.hindice; j++) {
- temp[j] = sphc[j];
- temp[j+jumpp] = sphs[j];
- }
- }
-
- MPI_Bcast(temp, total, MPI_FLOAT, root, E->parallel.vertical_comm);
-
- if (E->parallel.me_loc[3] != root) {
- /* unpack */
- for (j=0; j<E->sphere.hindice; j++) {
- sphc[j] = temp[j];
- sphs[j] = temp[j+jumpp];
- }
- }
-
- free((void *)temp);
-
- return;
-}
-
-
-/*
- * remove rigid body rotation from the velocity
- */
-
-void remove_rigid_rot(struct All_variables *E)
-{
- void velo_from_element_d();
- double myatan();
- double wx, wy, wz, v_theta, v_phi, cos_t,sin_t,sin_f, cos_f,frd;
- double vx[9], vy[9], vz[9];
- double r, t, f, efac,tg;
- float cart_base[9];
- double exyz[4], fxyz[4];
-
- int m, e, i, k, j, node;
- const int lev = E->mesh.levmax;
- const int nno = E->lmesh.nno;
- const int ends = ENODES3D;
- const int ppts = PPOINTS3D;
- const int vpts = VPOINTS3D;
- const int sphere_key = 1;
- double VV[4][9];
- double rot, fr, tr;
-
-
-
- /* Note: no need to weight in rho(r) here. */
- double moment_of_inertia = (8.0*M_PI/15.0)*
- (pow(E->sphere.ro,(double)5.0) - pow(E->sphere.ri,(double)5.0));
-
- /* compute and add angular momentum components */
-
- exyz[1] = exyz[2] = exyz[3] = 0.0;
- fxyz[1] = fxyz[2] = fxyz[3] = 0.0;
-
-
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- for (e=1;e<=E->lmesh.nel;e++) {
-#ifdef ALLOW_ELLIPTICAL
- t = theta_g(E->eco[m][e].centre[1],E);
-#else
- t = E->eco[m][e].centre[1];
-#endif
- f = E->eco[m][e].centre[2];
- r = E->eco[m][e].centre[3];
-
- cos_t = cos(t);sin_t = sin(t);
- sin_f = sin(f);cos_f = cos(f);
-
- /* get Cartesian, element local velocities */
- velo_from_element_d(E,VV,m,e,sphere_key);
- for (j=1;j<=ppts;j++) {
- vx[j] = 0.0;vy[j] = 0.0;
- }
- for (j=1;j<=ppts;j++) {
- for (i=1;i<=ends;i++) {
- vx[j] += VV[1][i]*E->N.ppt[GNPINDEX(i,j)];
- vy[j] += VV[2][i]*E->N.ppt[GNPINDEX(i,j)];
- }
- }
- wx = -r*vy[1];
- wy = r*vx[1];
- exyz[1] += (wx*cos_t*cos_f - wy*sin_f) * E->eco[m][e].area;
- exyz[2] += (wx*cos_t*sin_f + wy*cos_f) * E->eco[m][e].area;
- exyz[3] -= (wx*sin_t ) * E->eco[m][e].area;
- }
- } /* end cap */
-
- MPI_Allreduce(exyz,fxyz,4,MPI_DOUBLE,MPI_SUM,E->parallel.world);
-
- fxyz[1] = fxyz[1] / moment_of_inertia;
- fxyz[2] = fxyz[2] / moment_of_inertia;
- fxyz[3] = fxyz[3] / moment_of_inertia;
-
- rot = sqrt(fxyz[1]*fxyz[1] + fxyz[2]*fxyz[2] + fxyz[3]*fxyz[3]);
- fr = myatan(fxyz[2], fxyz[1]);
- tr = acos(fxyz[3] / rot);
-
- if (E->parallel.me==0) {
- fprintf(E->fp,"Rigid rotation: rot=%e tr=%e fr=%e\n",rot,tr*180/M_PI,fr*180/M_PI);
- fprintf(stderr,"Rigid rotation: rot=%e tr=%e fr=%e\n",rot,tr*180/M_PI,fr*180/M_PI);
- }
- /*
- remove rigid rotation
- */
-#ifdef ALLOW_ELLIPTICAL
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- for (node=1;node<=nno;node++) {
- /* cartesian velocity = omega \cross r */
- vx[0] = fxyz[2]* E->x[m][3][node] - fxyz[3]*E->x[m][2][node];
- vx[1] = fxyz[3]* E->x[m][1][node] - fxyz[1]*E->x[m][3][node];
- vx[2] = fxyz[1]* E->x[m][2][node] - fxyz[2]*E->x[m][1][node];
- /* project into theta, phi */
- calc_cbase_at_node(m,node,cart_base,E);
- v_theta = vx[0]*cart_base[3] + vx[1]*cart_base[4] + vx[2]*cart_base[5] ;
- v_phi = vx[0]*cart_base[6] + vx[1]*cart_base[7];
- E->sphere.cap[m].V[1][node] -= v_theta;
- E->sphere.cap[m].V[2][node] -= v_phi;
- }
- }
-#else
- sin_t = sin(tr) * rot;
- cos_t = cos(tr) * rot;
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- for (node=1;node<=nno;node++) {
- frd = fr - E->sx[m][2][node];
- v_theta = E->sx[m][3][node] * sin_t * sin(frd);
- v_phi = E->sx[m][3][node] *
- ( E->SinCos[lev][m][0][node] * cos_t - E->SinCos[lev][m][2][node] * sin_t * cos(frd) );
-
- E->sphere.cap[m].V[1][node] -= v_theta;
- E->sphere.cap[m].V[2][node] -= v_phi;
- }
- }
-#endif
-
- return;
-
-}
Copied: mc/3D/CitcomS/branches/cxx/lib/Global_operations.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Global_operations.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Global_operations.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Global_operations.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,1012 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+#include <mpi.h>
+
+#include <math.h>
+#include <sys/types.h>
+#include "element_definitions.h"
+#include "global_defs.h"
+
+#include "cproto.h"
+
+#ifdef ALLOW_ELLIPTICAL
+double theta_g(double , struct All_variables *);
+#endif
+
+void calc_cbase_at_tp(float , float , float *);
+
+/* ===============================================
+ strips horizontal average from nodal field X.
+ Assumes orthogonal mesh, otherwise, horizontals
+ aren't & another method is required.
+ =============================================== */
+
+void remove_horiz_ave(
+ struct All_variables *E,
+ double **X, double *H,
+ int store_or_not
+ )
+{
+ int m,i,j,k,n,nox,noz,noy;
+
+ const int dims = E->mesh.nsd;
+
+ noy = E->lmesh.noy;
+ noz = E->lmesh.noz;
+ nox = E->lmesh.nox;
+
+ return_horiz_ave(E,X,H);
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(k=1;k<=noy;k++)
+ for(j=1;j<=nox;j++)
+ for(i=1;i<=noz;i++) {
+ n = i+(j-1)*noz+(k-1)*noz*nox;
+ X[m][n] -= H[i];
+ }
+
+ return;
+}
+
+
+void remove_horiz_ave2(struct All_variables *E, double **X)
+{
+ double *H;
+
+ H = (double *)malloc( (E->lmesh.noz+1)*sizeof(double));
+ remove_horiz_ave(E, X, H, 0);
+ free ((void *) H);
+}
+
+
+void return_horiz_ave(
+ struct All_variables *E,
+ double **X, double *H
+ )
+{
+ const int dims = E->mesh.nsd;
+ int m,i,j,k,d,nint,noz,nox,noy,el,elz,elx,ely,j1,j2,i1,i2,k1,k2,nproc;
+ int top,lnode[5], sizeofH, noz2,iroot;
+ double *Have,*temp,aa[5];
+ struct Shape_function1 M;
+ struct Shape_function1_dA dGamma;
+
+ sizeofH = (2*E->lmesh.noz+2)*sizeof(double);
+
+ Have = (double *)malloc(sizeofH);
+ temp = (double *)malloc(sizeofH);
+
+ noz = E->lmesh.noz;
+ noy = E->lmesh.noy;
+ elz = E->lmesh.elz;
+ elx = E->lmesh.elx;
+ ely = E->lmesh.ely;
+ noz2 = 2*noz;
+
+ for (i=1;i<=elz;i++) {
+ temp[i] = temp[i+noz] = 0.0;
+ temp[i+1] = temp[i+1+noz] = 0.0;
+ top = 0;
+ if (i==elz) top = 1;
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for (k=1;k<=ely;k++)
+ for (j=1;j<=elx;j++) {
+ el = i + (j-1)*elz + (k-1)*elx*elz;
+ get_global_1d_shape_fn(E,el,&M,&dGamma,top,m);
+
+ lnode[1] = E->ien[m][el].node[1];
+ lnode[2] = E->ien[m][el].node[2];
+ lnode[3] = E->ien[m][el].node[3];
+ lnode[4] = E->ien[m][el].node[4];
+
+ for(nint=1;nint<=onedvpoints[E->mesh.nsd];nint++) {
+ for(d=1;d<=onedvpoints[E->mesh.nsd];d++)
+ temp[i] += X[m][lnode[d]] * E->M.vpt[GMVINDEX(d,nint)]
+ * dGamma.vpt[GMVGAMMA(0,nint)];
+ temp[i+noz] += dGamma.vpt[GMVGAMMA(0,nint)];
+ }
+
+ if (i==elz) {
+ lnode[1] = E->ien[m][el].node[5];
+ lnode[2] = E->ien[m][el].node[6];
+ lnode[3] = E->ien[m][el].node[7];
+ lnode[4] = E->ien[m][el].node[8];
+
+ for(nint=1;nint<=onedvpoints[E->mesh.nsd];nint++) {
+ for(d=1;d<=onedvpoints[E->mesh.nsd];d++)
+ temp[i+1] += X[m][lnode[d]] * E->M.vpt[GMVINDEX(d,nint)]
+ * dGamma.vpt[GMVGAMMA(1,nint)];
+ temp[i+1+noz] += dGamma.vpt[GMVGAMMA(1,nint)];
+ }
+
+ } /* end of if i==elz */
+ } /* end of j and k, and m */
+ } /* Done for i */
+
+ MPI_Allreduce(temp,Have,noz2+1,MPI_DOUBLE,MPI_SUM,E->parallel.horizontal_comm);
+
+ for (i=1;i<=noz;i++) {
+ if(Have[i+noz] != 0.0)
+ H[i] = Have[i]/Have[i+noz];
+ }
+ /* if (E->parallel.me==0)
+ for(i=1;i<=noz;i++)
+ fprintf(stderr,"area %d %d %g\n",E->parallel.me,i,Have[i+noz]);
+*/
+ free ((void *) Have);
+ free ((void *) temp);
+
+ return;
+ }
+
+void return_horiz_ave_f(
+ struct All_variables *E,
+ float **X, float *H
+ )
+{
+ const int dims = E->mesh.nsd;
+ int m,i,j,k,d,nint,noz,nox,noy,el,elz,elx,ely,j1,j2,i1,i2,k1,k2,nproc;
+ int top,lnode[5], sizeofH, noz2,iroot;
+ float *Have,*temp,aa[5];
+ struct Shape_function1 M;
+ struct Shape_function1_dA dGamma;
+
+ sizeofH = (2*E->lmesh.noz+2)*sizeof(float);
+
+ Have = (float *)malloc(sizeofH);
+ temp = (float *)malloc(sizeofH);
+
+ noz = E->lmesh.noz;
+ noy = E->lmesh.noy;
+ elz = E->lmesh.elz;
+ elx = E->lmesh.elx;
+ ely = E->lmesh.ely;
+ noz2 = 2*noz;
+
+ for (i=1;i<=elz;i++) {
+ temp[i] = temp[i+noz] = 0.0;
+ temp[i+1] = temp[i+1+noz] = 0.0;
+ top = 0;
+ if (i==elz) top = 1;
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for (k=1;k<=ely;k++)
+ for (j=1;j<=elx;j++) {
+ el = i + (j-1)*elz + (k-1)*elx*elz;
+ get_global_1d_shape_fn(E,el,&M,&dGamma,top,m);
+
+ lnode[1] = E->ien[m][el].node[1];
+ lnode[2] = E->ien[m][el].node[2];
+ lnode[3] = E->ien[m][el].node[3];
+ lnode[4] = E->ien[m][el].node[4];
+
+ for(nint=1;nint<=onedvpoints[E->mesh.nsd];nint++) {
+ for(d=1;d<=onedvpoints[E->mesh.nsd];d++)
+ temp[i] += X[m][lnode[d]] * E->M.vpt[GMVINDEX(d,nint)]
+ * dGamma.vpt[GMVGAMMA(0,nint)];
+ temp[i+noz] += dGamma.vpt[GMVGAMMA(0,nint)];
+ }
+
+ if (i==elz) {
+ lnode[1] = E->ien[m][el].node[5];
+ lnode[2] = E->ien[m][el].node[6];
+ lnode[3] = E->ien[m][el].node[7];
+ lnode[4] = E->ien[m][el].node[8];
+
+ for(nint=1;nint<=onedvpoints[E->mesh.nsd];nint++) {
+ for(d=1;d<=onedvpoints[E->mesh.nsd];d++)
+ temp[i+1] += X[m][lnode[d]] * E->M.vpt[GMVINDEX(d,nint)]
+ * dGamma.vpt[GMVGAMMA(1,nint)];
+ temp[i+1+noz] += dGamma.vpt[GMVGAMMA(1,nint)];
+ }
+
+ } /* end of if i==elz */
+ } /* end of j and k, and m */
+ } /* Done for i */
+
+ MPI_Allreduce(temp,Have,noz2+1,MPI_FLOAT,MPI_SUM,E->parallel.horizontal_comm);
+
+ for (i=1;i<=noz;i++) {
+ if(Have[i+noz] != 0.0)
+ H[i] = Have[i]/Have[i+noz];
+ }
+ /* if (E->parallel.me==0)
+ for(i=1;i<=noz;i++)
+ fprintf(stderr,"area %d %d %g\n",E->parallel.me,i,Have[i+noz]);
+*/
+ free ((void *) Have);
+ free ((void *) temp);
+
+ return;
+ }
+
+
+/******* RETURN ELEMENTWISE HORIZ AVE ********************************/
+/* */
+/* This function is similar to return_horiz_ave in the citcom code */
+/* however here, elemental horizontal averages are given rather than */
+/* nodal averages. Also note, here is average per element */
+
+void return_elementwise_horiz_ave(
+ struct All_variables *E,
+ double **X, double *H
+ )
+{
+
+ int m,i,j,k,d,noz,noy,el,elz,elx,ely,nproc;
+ int sizeofH;
+ int elz2;
+ double *Have,*temp;
+
+ sizeofH = (2*E->lmesh.elz+2)*sizeof(double);
+
+ Have = (double *)malloc(sizeofH);
+ temp = (double *)malloc(sizeofH);
+
+ noz = E->lmesh.noz;
+ noy = E->lmesh.noy;
+ elz = E->lmesh.elz;
+ elx = E->lmesh.elx;
+ ely = E->lmesh.ely;
+ elz2 = 2*elz;
+
+ for (i=0;i<=(elz*2+1);i++)
+ {
+ temp[i]=0.0;
+ }
+
+ for (i=1;i<=elz;i++)
+ {
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ {
+ for (k=1;k<=ely;k++)
+ {
+ for (j=1;j<=elx;j++)
+ {
+ el = i + (j-1)*elz + (k-1)*elx*elz;
+ temp[i] += X[m][el]*E->ECO[E->mesh.levmax][m][el].area;
+ temp[i+elz] += E->ECO[E->mesh.levmax][m][el].area;
+ }
+ }
+ }
+ }
+
+
+
+/* determine which processors should get the message from me for
+ computing the layer averages */
+
+ MPI_Allreduce(temp,Have,elz2+1,MPI_DOUBLE,MPI_SUM,E->parallel.horizontal_comm);
+
+ for (i=1;i<=elz;i++) {
+ if(Have[i+elz] != 0.0)
+ H[i] = Have[i]/Have[i+elz];
+ }
+
+
+ free ((void *) Have);
+ free ((void *) temp);
+
+ return;
+}
+
+float return_bulk_value(
+ struct All_variables *E,
+ float **Z,
+ int average
+ )
+{
+ int n,i,j,k,el,m;
+ float volume,integral,volume1,integral1;
+
+ const int vpts = vpoints[E->mesh.nsd];
+ const int ends = enodes[E->mesh.nsd];
+
+ volume1=0.0;
+ integral1=0.0;
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for (el=1;el<=E->lmesh.nel;el++) {
+
+ for(j=1;j<=vpts;j++)
+ for(i=1;i<=ends;i++) {
+ n = E->ien[m][el].node[i];
+ volume1 += E->N.vpt[GNVINDEX(i,j)] * E->gDA[m][el].vpt[j];
+ integral1 += Z[m][n] * E->N.vpt[GNVINDEX(i,j)] * E->gDA[m][el].vpt[j];
+ }
+
+ }
+
+
+ MPI_Allreduce(&volume1 ,&volume ,1,MPI_FLOAT,MPI_SUM,E->parallel.world);
+ MPI_Allreduce(&integral1,&integral,1,MPI_FLOAT,MPI_SUM,E->parallel.world);
+
+ if(average && volume != 0.0)
+ integral /= volume;
+
+ return((float)integral);
+}
+
+/************ RETURN BULK VALUE_D *****************************************/
+/* */
+/* Same as return_bulk_value but allowing double instead of float. */
+/* I think when integer average =1, volume average is returned. */
+/* when integer average =0, integral is returned. */
+
+
+double return_bulk_value_d(
+ struct All_variables *E,
+ double **Z,
+ int average
+ )
+{
+ int n,i,j,el,m;
+ double volume,integral,volume1,integral1;
+
+ const int vpts = vpoints[E->mesh.nsd];
+ const int ends = enodes[E->mesh.nsd];
+
+ volume1=0.0;
+ integral1=0.0;
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for (el=1;el<=E->lmesh.nel;el++) {
+
+ for(j=1;j<=vpts;j++)
+ for(i=1;i<=ends;i++) {
+ n = E->ien[m][el].node[i];
+ volume1 += E->N.vpt[GNVINDEX(i,j)] * E->gDA[m][el].vpt[j];
+ integral1 += Z[m][n] * E->N.vpt[GNVINDEX(i,j)] * E->gDA[m][el].vpt[j];
+ }
+
+ }
+
+
+ MPI_Allreduce(&volume1 ,&volume ,1,MPI_DOUBLE,MPI_SUM,E->parallel.world);
+ MPI_Allreduce(&integral1,&integral,1,MPI_DOUBLE,MPI_SUM,E->parallel.world);
+
+ if(average && volume != 0.0)
+ integral /= volume;
+
+ return((double)integral);
+}
+
+/* ================================================== */
+float find_max_horizontal(
+ struct All_variables *E,
+ float Tmax
+ )
+{
+ float ttmax;
+
+ MPI_Allreduce(&Tmax,&ttmax,1,MPI_FLOAT,MPI_MAX,E->parallel.horizontal_comm);
+
+ return(ttmax);
+ }
+
+/* ================================================== */
+void sum_across_surface(
+ struct All_variables *E,
+ float *data,
+ int total
+ )
+{
+ int j,d;
+ float *temp;
+
+ temp = (float *)malloc((total+1)*sizeof(float));
+ MPI_Allreduce(data,temp,total,MPI_FLOAT,MPI_SUM,E->parallel.horizontal_comm);
+
+ for (j=0;j<total;j++) {
+ data[j] = temp[j];
+ }
+
+ free((void *)temp);
+
+ return;
+}
+
+/* ================================================== */
+/* ================================================== */
+
+/* ================================================== */
+void sum_across_surf_sph1(
+ struct All_variables *E,
+ float *sphc, float *sphs
+ )
+{
+ int jumpp,total,j,d;
+ float *sphcs,*temp;
+
+ temp = (float *) malloc((E->sphere.hindice*2)*sizeof(float));
+ sphcs = (float *) malloc((E->sphere.hindice*2)*sizeof(float));
+
+ /* pack */
+ jumpp = E->sphere.hindice;
+ total = E->sphere.hindice*2;
+ for (j=0;j<E->sphere.hindice;j++) {
+ sphcs[j] = sphc[j];
+ sphcs[j+jumpp] = sphs[j];
+ }
+
+ /* sum across processors in horizontal direction */
+ MPI_Allreduce(sphcs,temp,total,MPI_FLOAT,MPI_SUM,E->parallel.horizontal_comm);
+
+ /* unpack */
+ for (j=0;j<E->sphere.hindice;j++) {
+ sphc[j] = temp[j];
+ sphs[j] = temp[j+jumpp];
+ }
+
+ free((void *)temp);
+ free((void *)sphcs);
+
+ return;
+}
+
+/* ================================================== */
+
+
+float global_fvdot(
+ struct All_variables *E,
+ float **A, float **B,
+ int lev
+ )
+{
+ int m,i,neq;
+ float prod, temp,temp1;
+
+ neq=E->lmesh.NEQ[lev];
+
+ temp = 0.0;
+ temp1 = 0.0;
+ prod = 0.0;
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ neq=E->lmesh.NEQ[lev];
+ temp1 = 0.0;
+ for (i=0;i<neq;i++)
+ temp += A[m][i]*B[m][i];
+
+ for (i=1;i<=E->parallel.Skip_neq[lev][m];i++)
+ temp1 += A[m][E->parallel.Skip_id[lev][m][i]]*B[m][E->parallel.Skip_id[lev][m][i]];
+
+ temp -= temp1;
+
+ }
+
+ MPI_Allreduce(&temp, &prod,1,MPI_FLOAT,MPI_SUM,E->parallel.world);
+
+ return (prod);
+}
+
+
+double kineticE_radial(
+ struct All_variables *E,
+ double **A,
+ int lev
+ )
+{
+ int m,i,neq;
+ double prod, temp,temp1;
+
+ temp = 0.0;
+ prod = 0.0;
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ neq=E->lmesh.NEQ[lev];
+ temp1 = 0.0;
+ for (i=0;i<neq;i++)
+ if ((i+1)%3==0)
+ temp += A[m][i]*A[m][i];
+
+ for (i=1;i<=E->parallel.Skip_neq[lev][m];i++)
+ if ((E->parallel.Skip_id[lev][m][i]+1)%3==0)
+ temp1 += A[m][E->parallel.Skip_id[lev][m][i]]*A[m][E->parallel.Skip_id[lev][m][i]];
+
+ temp -= temp1;
+
+ }
+
+ MPI_Allreduce(&temp, &prod,1,MPI_DOUBLE,MPI_SUM,E->parallel.world);
+
+ return (prod);
+}
+
+double global_vdot(
+ struct All_variables *E,
+ double **A, double **B,
+ int lev
+ )
+{
+ int m,i,neq;
+ double prod, temp,temp1;
+
+ temp = 0.0;
+ prod = 0.0;
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ neq=E->lmesh.NEQ[lev];
+ temp1 = 0.0;
+ for (i=0;i<neq;i++)
+ temp += A[m][i]*B[m][i];
+
+ for (i=1;i<=E->parallel.Skip_neq[lev][m];i++)
+ temp1 += A[m][E->parallel.Skip_id[lev][m][i]]*B[m][E->parallel.Skip_id[lev][m][i]];
+
+ temp -= temp1;
+
+ }
+
+ MPI_Allreduce(&temp, &prod,1,MPI_DOUBLE,MPI_SUM,E->parallel.world);
+
+ return (prod);
+}
+
+
+double global_pdot(
+ struct All_variables *E,
+ double **A, double **B,
+ int lev
+ )
+{
+ int i,m,npno;
+ double prod, temp;
+
+ npno=E->lmesh.NPNO[lev];
+
+ temp = 0.0;
+ prod = 0.0;
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ npno=E->lmesh.NPNO[lev];
+ for (i=1;i<=npno;i++)
+ temp += A[m][i]*B[m][i];
+ }
+
+ MPI_Allreduce(&temp, &prod,1,MPI_DOUBLE,MPI_SUM,E->parallel.world);
+
+ return (prod);
+}
+
+
+/* return ||V||^2 */
+double global_v_norm2(struct All_variables *E, double **V)
+{
+ int i, m, d;
+ int eqn1, eqn2, eqn3;
+ double prod, temp;
+
+ temp = 0.0;
+ prod = 0.0;
+ for (m=1; m<=E->sphere.caps_per_proc; m++)
+ for (i=1; i<=E->lmesh.nno; i++) {
+ eqn1 = E->id[m][i].doff[1];
+ eqn2 = E->id[m][i].doff[2];
+ eqn3 = E->id[m][i].doff[3];
+ /* L2 norm */
+ temp += (V[m][eqn1] * V[m][eqn1] +
+ V[m][eqn2] * V[m][eqn2] +
+ V[m][eqn3] * V[m][eqn3]) * E->NMass[m][i];
+ }
+
+ MPI_Allreduce(&temp, &prod, 1, MPI_DOUBLE, MPI_SUM, E->parallel.world);
+
+ return (prod/E->mesh.volume);
+}
+
+
+/* return ||P||^2 */
+double global_p_norm2(struct All_variables *E, double **P)
+{
+ int i, m;
+ double prod, temp;
+
+ temp = 0.0;
+ prod = 0.0;
+ for (m=1; m<=E->sphere.caps_per_proc; m++)
+ for (i=1; i<=E->lmesh.npno; i++) {
+ /* L2 norm */
+ temp += P[m][i] * P[m][i] * E->eco[m][i].area;
+ }
+
+ MPI_Allreduce(&temp, &prod, 1, MPI_DOUBLE, MPI_SUM, E->parallel.world);
+
+ return (prod/E->mesh.volume);
+}
+
+
+/* return ||A||^2, where A_i is \int{div(u) d\Omega_i} */
+double global_div_norm2(struct All_variables *E, double **A)
+{
+ int i, m;
+ double prod, temp;
+
+ temp = 0.0;
+ prod = 0.0;
+ for (m=1; m<=E->sphere.caps_per_proc; m++)
+ for (i=1; i<=E->lmesh.npno; i++) {
+ /* L2 norm of div(u) */
+ temp += A[m][i] * A[m][i] / E->eco[m][i].area;
+
+ /* L1 norm */
+ /*temp += fabs(A[m][i]);*/
+ }
+
+ MPI_Allreduce(&temp, &prod, 1, MPI_DOUBLE, MPI_SUM, E->parallel.world);
+
+ return (prod/E->mesh.volume);
+}
+
+
+double global_tdot_d(
+ struct All_variables *E,
+ double **A, double **B,
+ int lev
+ )
+{
+ int i,nno,m;
+ double prod, temp;
+
+ nno=E->lmesh.NNO[lev];
+
+ temp = 0.0;
+ prod = 0.0;
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ nno=E->lmesh.NNO[lev];
+ for (i=1;i<=nno;i++)
+ if (!(E->NODE[lev][m][i] & SKIP))
+ temp += A[m][i];
+ }
+
+ MPI_Allreduce(&temp, &prod,1,MPI_DOUBLE,MPI_SUM,E->parallel.world);
+
+ return (prod);
+ }
+
+float global_tdot(
+ struct All_variables *E,
+ float **A, double **B,
+ int lev
+ )
+{
+ int i,nno,m;
+ float prod, temp;
+
+
+ temp = 0.0;
+ prod = 0.0;
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ nno=E->lmesh.NNO[lev];
+ for (i=1;i<=nno;i++)
+ if (!(E->NODE[lev][m][i] & SKIP))
+ temp += A[m][i]*B[m][i];
+ }
+
+ MPI_Allreduce(&temp, &prod,1,MPI_FLOAT,MPI_SUM,E->parallel.world);
+
+ return (prod);
+ }
+
+
+float global_fmin(
+ struct All_variables *E,
+ float a
+ )
+{
+ float temp;
+ MPI_Allreduce(&a, &temp,1,MPI_FLOAT,MPI_MIN,E->parallel.world);
+ return (temp);
+ }
+
+double global_dmax(
+ struct All_variables *E,
+ double a
+ )
+{
+ double temp;
+ MPI_Allreduce(&a, &temp,1,MPI_DOUBLE,MPI_MAX,E->parallel.world);
+ return (temp);
+ }
+
+
+float global_fmax(
+ struct All_variables *E,
+ float a
+ )
+{
+ float temp;
+ MPI_Allreduce(&a, &temp,1,MPI_FLOAT,MPI_MAX,E->parallel.world);
+ return (temp);
+ }
+
+double Tmaxd(
+ struct All_variables *E,
+ double **T
+ )
+{
+ double temp,temp1;
+ int i,m;
+
+ temp = -10.0;
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=1;i<=E->lmesh.nno;i++)
+ temp = max(T[m][i],temp);
+
+ temp1 = global_dmax(E,temp);
+ return (temp1);
+ }
+
+
+float Tmax(
+ struct All_variables *E,
+ float **T
+ )
+{
+ float temp,temp1;
+ int i,m;
+
+ temp = -10.0;
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=1;i<=E->lmesh.nno;i++)
+ temp = max(T[m][i],temp);
+
+ temp1 = global_fmax(E,temp);
+ return (temp1);
+ }
+
+
+double vnorm_nonnewt(
+ struct All_variables *E,
+ double **dU, double **U,
+ int lev
+ )
+{
+ double temp1,temp2,dtemp,temp;
+ int a,e,i,m,node;
+ const int dims = E->mesh.nsd;
+ const int ends = enodes[dims];
+ const int nel=E->lmesh.nel;
+
+ dtemp=0.0;
+ temp=0.0;
+for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for (e=1;e<=nel;e++)
+ /*if (E->mat[m][e]==1)*/
+ for (i=1;i<=dims;i++)
+ for (a=1;a<=ends;a++) {
+ node = E->IEN[lev][m][e].node[a];
+ dtemp += dU[m][ E->ID[lev][m][node].doff[i] ]*
+ dU[m][ E->ID[lev][m][node].doff[i] ];
+ temp += U[m][ E->ID[lev][m][node].doff[i] ]*
+ U[m][ E->ID[lev][m][node].doff[i] ];
+ }
+
+
+ MPI_Allreduce(&dtemp, &temp2,1,MPI_DOUBLE,MPI_SUM,E->parallel.world);
+ MPI_Allreduce(&temp, &temp1,1,MPI_DOUBLE,MPI_SUM,E->parallel.world);
+
+ temp1 = sqrt(temp2/temp1);
+
+ return (temp1);
+}
+
+
+void sum_across_depth_sph1(
+ struct All_variables *E,
+ float *sphc, float *sphs
+ )
+{
+ int jumpp,total,j;
+
+ float *sphcs,*temp;
+
+ if (E->parallel.nprocz > 1) {
+ total = E->sphere.hindice*2;
+ temp = (float *) malloc(total*sizeof(float));
+ sphcs = (float *) malloc(total*sizeof(float));
+
+ /* pack sphc[] and sphs[] into sphcs[] */
+ jumpp = E->sphere.hindice;
+ for (j=0;j<E->sphere.hindice;j++) {
+ sphcs[j] = sphc[j];
+ sphcs[j+jumpp] = sphs[j];
+ }
+
+ /* sum across processors in z direction */
+ MPI_Allreduce(sphcs, temp, total, MPI_FLOAT, MPI_SUM,
+ E->parallel.vertical_comm);
+
+ /* unpack */
+ for (j=0;j<E->sphere.hindice;j++) {
+ sphc[j] = temp[j];
+ sphs[j] = temp[j+jumpp];
+ }
+
+ free(temp);
+ free(sphcs);
+ }
+
+
+ return;
+}
+
+
+/* ================================================== */
+/* ================================================== */
+void broadcast_vertical(struct All_variables *E,
+ float *sphc, float *sphs,
+ int root)
+{
+ int jumpp, total, j;
+ float *temp;
+
+ if(E->parallel.nprocz == 1) return;
+
+ jumpp = E->sphere.hindice;
+ total = E->sphere.hindice*2;
+ temp = (float *) malloc(total*sizeof(float));
+
+ if (E->parallel.me_loc[3] == root) {
+ /* pack */
+ for (j=0; j<E->sphere.hindice; j++) {
+ temp[j] = sphc[j];
+ temp[j+jumpp] = sphs[j];
+ }
+ }
+
+ MPI_Bcast(temp, total, MPI_FLOAT, root, E->parallel.vertical_comm);
+
+ if (E->parallel.me_loc[3] != root) {
+ /* unpack */
+ for (j=0; j<E->sphere.hindice; j++) {
+ sphc[j] = temp[j];
+ sphs[j] = temp[j+jumpp];
+ }
+ }
+
+ free((void *)temp);
+
+ return;
+}
+
+
+/*
+ * remove rigid body rotation from the velocity
+ */
+
+void remove_rigid_rot(struct All_variables *E)
+{
+ double wx, wy, wz, v_theta, v_phi, cos_t,sin_t,sin_f, cos_f,frd;
+ double vx[9], vy[9], vz[9];
+ double r, t, f, efac,tg;
+ float cart_base[9];
+ double exyz[4], fxyz[4];
+
+ int m, e, i, k, j, node;
+ const int lev = E->mesh.levmax;
+ const int nno = E->lmesh.nno;
+ const int ends = ENODES3D;
+ const int ppts = PPOINTS3D;
+ const int vpts = VPOINTS3D;
+ const int sphere_key = 1;
+ double VV[4][9];
+ double rot, fr, tr;
+
+
+
+ /* Note: no need to weight in rho(r) here. */
+ double moment_of_inertia = (8.0*M_PI/15.0)*
+ (pow(E->sphere.ro,(double)5.0) - pow(E->sphere.ri,(double)5.0));
+
+ /* compute and add angular momentum components */
+
+ exyz[1] = exyz[2] = exyz[3] = 0.0;
+ fxyz[1] = fxyz[2] = fxyz[3] = 0.0;
+
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ for (e=1;e<=E->lmesh.nel;e++) {
+#ifdef ALLOW_ELLIPTICAL
+ t = theta_g(E->eco[m][e].centre[1],E);
+#else
+ t = E->eco[m][e].centre[1];
+#endif
+ f = E->eco[m][e].centre[2];
+ r = E->eco[m][e].centre[3];
+
+ cos_t = cos(t);sin_t = sin(t);
+ sin_f = sin(f);cos_f = cos(f);
+
+ /* get Cartesian, element local velocities */
+ velo_from_element_d(E,VV,m,e,sphere_key);
+ for (j=1;j<=ppts;j++) {
+ vx[j] = 0.0;vy[j] = 0.0;
+ }
+ for (j=1;j<=ppts;j++) {
+ for (i=1;i<=ends;i++) {
+ vx[j] += VV[1][i]*E->N.ppt[GNPINDEX(i,j)];
+ vy[j] += VV[2][i]*E->N.ppt[GNPINDEX(i,j)];
+ }
+ }
+ wx = -r*vy[1];
+ wy = r*vx[1];
+ exyz[1] += (wx*cos_t*cos_f - wy*sin_f) * E->eco[m][e].area;
+ exyz[2] += (wx*cos_t*sin_f + wy*cos_f) * E->eco[m][e].area;
+ exyz[3] -= (wx*sin_t ) * E->eco[m][e].area;
+ }
+ } /* end cap */
+
+ MPI_Allreduce(exyz,fxyz,4,MPI_DOUBLE,MPI_SUM,E->parallel.world);
+
+ fxyz[1] = fxyz[1] / moment_of_inertia;
+ fxyz[2] = fxyz[2] / moment_of_inertia;
+ fxyz[3] = fxyz[3] / moment_of_inertia;
+
+ rot = sqrt(fxyz[1]*fxyz[1] + fxyz[2]*fxyz[2] + fxyz[3]*fxyz[3]);
+ fr = myatan(fxyz[2], fxyz[1]);
+ tr = acos(fxyz[3] / rot);
+
+ if (E->parallel.me==0) {
+ fprintf(E->fp,"Rigid rotation: rot=%e tr=%e fr=%e\n",rot,tr*180/M_PI,fr*180/M_PI);
+ fprintf(stderr,"Rigid rotation: rot=%e tr=%e fr=%e\n",rot,tr*180/M_PI,fr*180/M_PI);
+ }
+ /*
+ remove rigid rotation
+ */
+#ifdef ALLOW_ELLIPTICAL
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ for (node=1;node<=nno;node++) {
+ /* cartesian velocity = omega \cross r */
+ vx[0] = fxyz[2]* E->x[m][3][node] - fxyz[3]*E->x[m][2][node];
+ vx[1] = fxyz[3]* E->x[m][1][node] - fxyz[1]*E->x[m][3][node];
+ vx[2] = fxyz[1]* E->x[m][2][node] - fxyz[2]*E->x[m][1][node];
+ /* project into theta, phi */
+ calc_cbase_at_node(m,node,cart_base,E);
+ v_theta = vx[0]*cart_base[3] + vx[1]*cart_base[4] + vx[2]*cart_base[5] ;
+ v_phi = vx[0]*cart_base[6] + vx[1]*cart_base[7];
+ E->sphere.cap[m].V[1][node] -= v_theta;
+ E->sphere.cap[m].V[2][node] -= v_phi;
+ }
+ }
+#else
+ sin_t = sin(tr) * rot;
+ cos_t = cos(tr) * rot;
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ for (node=1;node<=nno;node++) {
+ frd = fr - E->sx[m][2][node];
+ v_theta = E->sx[m][3][node] * sin_t * sin(frd);
+ v_phi = E->sx[m][3][node] *
+ ( E->SinCos[lev][m][0][node] * cos_t - E->SinCos[lev][m][2][node] * sin_t * cos(frd) );
+
+ E->sphere.cap[m].V[1][node] -= v_theta;
+ E->sphere.cap[m].V[2][node] -= v_phi;
+ }
+ }
+#endif
+
+ return;
+
+}
Deleted: mc/3D/CitcomS/branches/cxx/lib/Initial_temperature.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Initial_temperature.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Initial_temperature.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,678 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-
-#include <math.h>
-#include <assert.h>
-#include <string.h>
-
-#include "global_defs.h"
-#include "lith_age.h"
-#include "parsing.h"
-
-void parallel_process_termination();
-void temperatures_conform_bcs(struct All_variables *);
-double modified_plgndr_a(int, int, double);
-
-#include "initial_temperature.h"
-static void debug_tic(struct All_variables *);
-static void read_tic_from_file(struct All_variables *);
-static void construct_tic_from_input(struct All_variables *);
-
-#ifdef USE_GZDIR
-void restart_tic_from_gzdir_file(struct All_variables *);
-#endif
-#ifdef USE_GGRD
-#include "ggrd_handling.h"
-#endif
-
-
-void tic_input(struct All_variables *E)
-{
-
- int m = E->parallel.me;
- int noz = E->lmesh.noz;
- int n;
-#ifdef USE_GGRD
- int tmp;
-#endif
-
- input_int("tic_method", &(E->convection.tic_method), "0,0,2", m);
-
-#ifdef USE_GGRD /* for backward capability */
- input_int("ggrd_tinit", &tmp, "0", m);
- if(tmp){
- E->convection.tic_method = 4; /* */
- E->control.ggrd.use_temp = 1;
- }
-#endif
- /* When tic_method is 0 (default), the temperature is a linear profile +
- perturbation at some layers.
-
- When tic_method is -1, the temperature is read in from the
- [datafile_old].velo.[rank].[solution_cycles_init] files.
-
- When tic_method is 1, the temperature is isothermal (== bottom b.c.) +
- uniformly cold plate (thickness specified by 'half_space_age').
-
- When tic_method is 2, (tic_method==1) + a hot blob. A user can specify
- the location and radius of the blob, and also the amplitude of temperature
- change in the blob relative to the ambient mantle temperautre
- (E->control.lith_age_mantle_temp).
- - blob_center: A comma-separated list of three float numbers.
- - blob_radius: A dmensionless length, typically a fraction
- of the Earth's radius.
- - blob_dT : Dimensionless temperature.
-
- When tic_method is 3, the temperature is a linear profile + perturbation
- for whole mantle.
-
- tic_method is 4: read in initial temperature distribution from a set of netcdf grd
- files. this required the GGRD extension to be compiled in
-
- */
-
- /* This part put a temperature anomaly at depth where the global
- node number is equal to load_depth. The horizontal pattern of
- the anomaly is given by spherical harmonic ll & mm. */
-
- input_int("num_perturbations", &n, "0,0,PERTURB_MAX_LAYERS", m);
-
- if (n > 0) {
- E->convection.number_of_perturbations = n;
-
- if (! input_float_vector("perturbmag", n, E->convection.perturb_mag, m) ) {
- fprintf(stderr,"Missing input parameter: 'perturbmag'\n");
- parallel_process_termination();
- }
- if (! input_int_vector("perturbm", n, E->convection.perturb_mm, m) ) {
- fprintf(stderr,"Missing input parameter: 'perturbm'\n");
- parallel_process_termination();
- }
- if (! input_int_vector("perturbl", n, E->convection.perturb_ll, m) ) {
- fprintf(stderr,"Missing input parameter: 'perturbl'\n");
- parallel_process_termination();
- }
- if (! input_int_vector("perturblayer", n, E->convection.load_depth, m) ) {
- fprintf(stderr,"Missing input parameter: 'perturblayer'\n");
- parallel_process_termination();
- }
- }
- else {
- E->convection.number_of_perturbations = 1;
- E->convection.perturb_mag[0] = 1;
- E->convection.perturb_mm[0] = 2;
- E->convection.perturb_ll[0] = 2;
- E->convection.load_depth[0] = (noz+1)/2;
- }
-
- input_float("half_space_age", &(E->convection.half_space_age), "40.0,1e-3,nomax", m);
-
- switch(E->convection.tic_method){
- case 2: /* blob */
- if( ! input_float_vector("blob_centqer", 3, E->convection.blob_center, m)) {
- assert( E->sphere.caps == 12 || E->sphere.caps == 1 );
- if(E->sphere.caps == 12) { /* Full version: just quit here */
- fprintf(stderr,"Missing input parameter: 'blob_center'.\n");
- parallel_process_termination();
- }
- else if(E->sphere.caps == 1) { /* Regional version: put the blob at the center */
- fprintf(stderr,"Missing input parameter: 'blob_center'. The blob will be placed at the center of the domain.\n");
- E->convection.blob_center[0] = 0.5*(E->control.theta_min+E->control.theta_max);
- E->convection.blob_center[1] = 0.5*(E->control.fi_min+E->control.fi_max);
- E->convection.blob_center[2] = 0.5*(E->sphere.ri+E->sphere.ro);
- }
- }
- input_float("blob_radius", &(E->convection.blob_radius), "0.063,0.0,1.0", m);
- input_float("blob_dT", &(E->convection.blob_dT), "0.18,nomin,nomax", m);
- break;
- case 4:
- /*
- case 4: initial temp from grd files
- */
-#ifdef USE_GGRD
- /*
- read in some more parameters
-
- */
- /* scale the anomalies with PREM densities */
- input_boolean("ggrd_tinit_scale_with_prem",&(E->control.ggrd.temp.scale_with_prem),"off",E->parallel.me);
- /* limit T to 0...1 */
- input_boolean("ggrd_tinit_limit_trange",&(E->control.ggrd.temp.limit_trange),"on",E->parallel.me);
- /* scaling factor for the grids */
- input_double("ggrd_tinit_scale",&(E->control.ggrd.temp.scale),"1.0",E->parallel.me); /* scale */
- /* temperature offset factor */
- input_double("ggrd_tinit_offset",&(E->control.ggrd.temp.offset),"0.0",E->parallel.me); /* offset */
- /* grid name, without the .i.grd suffix */
- input_string("ggrd_tinit_gfile",E->control.ggrd.temp.gfile,"",E->parallel.me); /* grids */
- input_string("ggrd_tinit_dfile",E->control.ggrd.temp.dfile,"",E->parallel.me); /* depth.dat layers of grids*/
- /* override temperature boundary condition? */
- input_boolean("ggrd_tinit_override_tbc",&(E->control.ggrd.temp.override_tbc),"off",E->parallel.me);
- input_string("ggrd_tinit_prem_file",E->control.ggrd.temp.prem.model_filename,"hc/prem/prem.dat", E->parallel.me); /* PREM model filename */
-#else
- fprintf(stderr,"tic_method 4 only works for USE_GGRD compiled code\n");
- parallel_process_termination();
-#endif
- break;
- } /* no default needed */
- return;
-}
-
-
-
-void convection_initial_temperature(struct All_variables *E)
-{
- void report();
-
- report(E,"Initialize temperature field");
-
- if (E->convection.tic_method == -1) {
- /* read temperature from file */
-#ifdef USE_GZDIR
- if(strcmp(E->output.format, "ascii-gz") == 0)
- restart_tic_from_gzdir_file(E);
- else
-#endif
- read_tic_from_file(E);
- }
- else if (E->control.lith_age)
- lith_age_construct_tic(E);
- else
- construct_tic_from_input(E);
-
- /* Note: it is the callee's responsibility to conform tbc. */
- /* like a call to temperatures_conform_bcs(E); */
-
- if (E->control.verbose)
- debug_tic(E);
-
- return;
-}
-
-
-static void debug_tic(struct All_variables *E)
-{
- int m, j;
-
- fprintf(E->fp_out,"output_temperature\n");
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
- fprintf(E->fp_out,"for cap %d\n",E->sphere.capid[m]);
- for (j=1;j<=E->lmesh.nno;j++)
- fprintf(E->fp_out,"X = %.6e Z = %.6e Y = %.6e T[%06d] = %.6e \n",E->sx[m][1][j],E->sx[m][2][j],E->sx[m][3][j],j,E->T[m][j]);
- }
- fflush(E->fp_out);
-
- return;
-}
-
-
-
-static void read_tic_from_file(struct All_variables *E)
-{
- int ii, ll, mm;
- float tt;
- int i, m;
- char output_file[255], input_s[1000];
- FILE *fp;
-
- float v1, v2, v3, g;
-
- ii = E->monitor.solution_cycles_init;
- sprintf(output_file,"%s.velo.%d.%d",E->control.old_P_file,E->parallel.me,ii);
- fp=fopen(output_file,"r");
- if (fp == NULL) {
- fprintf(E->fp,"(Initial_temperature.c #1) Cannot open %s\n",output_file);
- parallel_process_termination();
- }
-
- if (E->parallel.me==0)
- fprintf(E->fp,"Reading %s for initial temperature\n",output_file);
-
- fgets(input_s,1000,fp);
- sscanf(input_s,"%d %d %f",&ll,&mm,&tt);
-
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
- fgets(input_s,1000,fp);
- sscanf(input_s,"%d %d",&ll,&mm);
- for(i=1;i<=E->lmesh.nno;i++) {
- fgets(input_s,1000,fp);
- sscanf(input_s,"%g %g %g %f",&(v1),&(v2),&(v3),&(g));
-
- /* Truncate the temperature to be within (0,1). */
- /* This might not be desirable in some situations. */
- E->T[m][i] = max(0.0,min(g,1.0));
- }
- }
- fclose (fp);
-
- temperatures_conform_bcs(E);
-
- return;
-}
-
-
-static void linear_temperature_profile(struct All_variables *E)
-{
- int m, i, j, k, node;
- int nox, noy, noz;
- double r1;
-
- nox = E->lmesh.nox;
- noy = E->lmesh.noy;
- noz = E->lmesh.noz;
-
- for(m=1; m<=E->sphere.caps_per_proc; m++)
- for(i=1; i<=noy; i++)
- for(j=1; j<=nox;j ++)
- for(k=1; k<=noz; k++) {
- node = k + (j-1)*noz + (i-1)*nox*noz;
- r1 = E->sx[m][3][node];
- E->T[m][node] = E->control.TBCbotval - (E->control.TBCtopval + E->control.TBCbotval)*(r1 - E->sphere.ri)/(E->sphere.ro - E->sphere.ri);
- }
-
- return;
-}
-
-
-static void conductive_temperature_profile(struct All_variables *E)
-{
- int m, i, j, k, node;
- int nox, noy, noz;
- double r1;
-
- nox = E->lmesh.nox;
- noy = E->lmesh.noy;
- noz = E->lmesh.noz;
-
- for(m=1; m<=E->sphere.caps_per_proc; m++)
- for(i=1; i<=noy; i++)
- for(j=1; j<=nox;j ++)
- for(k=1; k<=noz; k++) {
- node = k + (j-1)*noz + (i-1)*nox*noz;
- r1 = E->sx[m][3][node];
- E->T[m][node] = (E->control.TBCtopval*E->sphere.ro
- - E->control.TBCbotval*E->sphere.ri)
- / (E->sphere.ro - E->sphere.ri)
- + (E->control.TBCbotval - E->control.TBCtopval)
- * E->sphere.ro * E->sphere.ri / r1
- / (E->sphere.ro - E->sphere.ri);
- }
-
- return;
-}
-
-
-static void constant_temperature_profile(struct All_variables *E, double mantle_temp)
-{
- int m, i;
-
- for(m=1; m<=E->sphere.caps_per_proc; m++)
- for(i=1; i<=E->lmesh.nno; i++)
- E->T[m][i] = mantle_temp;
-
- return;
-}
-
-
-static void add_top_tbl(struct All_variables *E, double age_in_myrs, double mantle_temp)
-{
- int m, i, j, k, node;
- int nox, noy, noz;
- double r1, dT, tmp;
-
- nox = E->lmesh.nox;
- noy = E->lmesh.noy;
- noz = E->lmesh.noz;
-
- dT = (mantle_temp - E->control.TBCtopval);
- tmp = 0.5 / sqrt(age_in_myrs / E->data.scalet);
-
- fprintf(stderr, "%e %e\n", dT, tmp);
- for(m=1; m<=E->sphere.caps_per_proc; m++)
- for(i=1; i<=noy; i++)
- for(j=1; j<=nox;j ++)
- for(k=1; k<=noz; k++) {
- node = k + (j-1)*noz + (i-1)*nox*noz;
- r1 = E->sx[m][3][node];
- E->T[m][node] -= dT * erfc(tmp * (E->sphere.ro - r1));
- }
-
- return;
-}
-
-
-static void add_bottom_tbl(struct All_variables *E, double age_in_myrs, double mantle_temp)
-{
- int m, i, j, k, node;
- int nox, noy, noz;
- double r1, dT, tmp;
-
- nox = E->lmesh.nox;
- noy = E->lmesh.noy;
- noz = E->lmesh.noz;
-
- dT = (E->control.TBCbotval - mantle_temp);
- tmp = 0.5 / sqrt(age_in_myrs / E->data.scalet);
-
- for(m=1; m<=E->sphere.caps_per_proc; m++)
- for(i=1; i<=noy; i++)
- for(j=1; j<=nox;j ++)
- for(k=1; k<=noz; k++) {
- node = k + (j-1)*noz + (i-1)*nox*noz;
- r1 = E->sx[m][3][node];
- E->T[m][node] += dT * erfc(tmp * (r1 - E->sphere.ri));
- }
-
- return;
-}
-
-
-static void add_perturbations_at_layers(struct All_variables *E)
-{
- /* This function put a temperature anomaly at depth where the global
- node number is equal to load_depth. The horizontal pattern of
- the anomaly is given by wavenumber (in regional model) or
- by spherical harmonic (in global model). */
-
- int m, i, j, k, node;
- int p, ll, mm, kk;
- int nox, noy, noz, gnoz;
- double t1, f1, tlen, flen, con;
-
- nox = E->lmesh.nox;
- noy = E->lmesh.noy;
- noz = E->lmesh.noz;
- gnoz = E->mesh.noz;
-
- for (p=0; p<E->convection.number_of_perturbations; p++) {
- ll = E->convection.perturb_ll[p];
- mm = E->convection.perturb_mm[p];
- kk = E->convection.load_depth[p];
- con = E->convection.perturb_mag[p];
-
- if ( (kk < 1) || (kk >= gnoz) ) continue; /* layer kk is outside domain */
-
- k = kk - E->lmesh.nzs + 1; /* convert global nz to local nz */
- if ( (k < 1) || (k >= noz) ) continue; /* layer k is not inside this proc. */
- if (E->parallel.me_loc[1] == 0 && E->parallel.me_loc[2] == 0
- && E->sphere.capid[1] == 1 )
- fprintf(stderr,"Initial temperature perturbation: layer=%d mag=%g l=%d m=%d\n", kk, con, ll, mm);
-
- if(E->sphere.caps == 1) {
- /* regional mode, add sinosoidal perturbation */
-
- tlen = M_PI / (E->control.theta_max - E->control.theta_min);
- flen = M_PI / (E->control.fi_max - E->control.fi_min);
-
- for(m=1; m<=E->sphere.caps_per_proc; m++)
- for(i=1; i<=noy; i++)
- for(j=1; j<=nox;j ++) {
- node = k + (j-1)*noz + (i-1)*nox*noz;
- t1 = (E->sx[m][1][node] - E->control.theta_min) * tlen;
- f1 = (E->sx[m][2][node] - E->control.fi_min) * flen;
-
- E->T[m][node] += con * cos(ll*t1) * cos(mm*f1);
- }
- }
- else {
- /* global mode, add spherical harmonics perturbation */
-
- for(m=1; m<=E->sphere.caps_per_proc; m++)
- for(i=1; i<=noy; i++)
- for(j=1; j<=nox;j ++) {
- node = k + (j-1)*noz + (i-1)*nox*noz;
- t1 = E->sx[m][1][node];
- f1 = E->sx[m][2][node];
-
- E->T[m][node] += con * modified_plgndr_a(ll,mm,t1) * cos(mm*f1);
- }
- } /* end if */
- } /* end for p */
-
- return;
-}
-
-
-static void add_perturbations_at_all_layers(struct All_variables *E)
-{
- /* This function put a temperature anomaly for whole mantle with
- a sinosoidal amplitude in radial dependence. The horizontal pattern
- of the anomaly is given by wavenumber (in regional model) or
- by spherical harmonic (in global model). */
-
- int m, i, j, k, node;
- int p, ll, mm;
- int nox, noy, noz, gnoz;
- double r1, t1, f1, tlen, flen, rlen, con;
-
- nox = E->lmesh.nox;
- noy = E->lmesh.noy;
- noz = E->lmesh.noz;
- gnoz = E->mesh.noz;
-
- rlen = M_PI / (E->sphere.ro - E->sphere.ri);
-
- for (p=0; p<E->convection.number_of_perturbations; p++) {
- ll = E->convection.perturb_ll[p];
- mm = E->convection.perturb_mm[p];
- con = E->convection.perturb_mag[p];
-
- if (E->parallel.me_loc[1] == 0 && E->parallel.me_loc[2] == 0
- && E->sphere.capid[1] == 1 )
- fprintf(stderr,"Initial temperature perturbation: mag=%g l=%d m=%d\n", con, ll, mm);
-
- if(E->sphere.caps == 1) {
- /* regional mode, add sinosoidal perturbation */
-
- tlen = M_PI / (E->control.theta_max - E->control.theta_min);
- flen = M_PI / (E->control.fi_max - E->control.fi_min);
-
- for(m=1; m<=E->sphere.caps_per_proc; m++)
- for(i=1; i<=noy; i++)
- for(j=1; j<=nox;j ++)
- for(k=1; k<=noz; k++) {
- node = k + (j-1)*noz + (i-1)*nox*noz;
- t1 = (E->sx[m][1][node] - E->control.theta_min) * tlen;
- f1 = (E->sx[m][2][node] - E->control.fi_min) * flen;
- r1 = E->sx[m][3][node];
-
- E->T[m][node] += con * cos(ll*t1) * cos(mm*f1)
- * sin((r1-E->sphere.ri) * rlen);
- }
- }
- else {
- /* global mode, add spherical harmonics perturbation */
-
- for(m=1; m<=E->sphere.caps_per_proc; m++)
- for(i=1; i<=noy; i++)
- for(j=1; j<=nox;j ++)
- for(k=1; k<=noz; k++) {
- node = k + (j-1)*noz + (i-1)*nox*noz;
- t1 = E->sx[m][1][node];
- f1 = E->sx[m][2][node];
- r1 = E->sx[m][3][node];
-
- E->T[m][node] += con * modified_plgndr_a(ll,mm,t1)
- * (cos(mm*f1) + sin(mm*f1))
- * sin((r1-E->sphere.ri) * rlen);
- }
- } /* end if */
- } /* end for p */
-
- return;
-}
-
-
-static void add_spherical_anomaly(struct All_variables *E)
-{
- int i, j ,k , m, node;
- int nox, noy, noz;
-
- double theta_center, fi_center, r_center;
- double radius, amp;
-
- double x_center, y_center, z_center;
- double x, y, z, distance;
-
- noy = E->lmesh.noy;
- nox = E->lmesh.nox;
- noz = E->lmesh.noz;
-
- theta_center = E->convection.blob_center[0];
- fi_center = E->convection.blob_center[1];
- r_center = E->convection.blob_center[2];
- radius = E->convection.blob_radius;
- amp = E->convection.blob_dT;
-
- fprintf(stderr,"center=(%e %e %e) radius=%e dT=%e\n",
- theta_center, fi_center, r_center, radius, amp);
-
- x_center = r_center * sin(fi_center) * cos(theta_center);
- y_center = r_center * sin(fi_center) * sin(theta_center);
- z_center = r_center * cos(fi_center);
-
- /* compute temperature field according to nodal coordinate */
- for(m=1; m<=E->sphere.caps_per_proc; m++)
- for(i=1; i<=noy; i++)
- for(j=1; j<=nox;j ++)
- for(k=1; k<=noz; k++) {
- node = k + (j-1)*noz + (i-1)*nox*noz;
-
- x = E->x[m][1][node];
- y = E->x[m][2][node];
- z = E->x[m][3][node];
-
- distance = sqrt((x-x_center)*(x-x_center) +
- (y-y_center)*(y-y_center) +
- (z-z_center)*(z-z_center));
-
- if (distance < radius)
- E->T[m][node] += amp * exp(-1.0*distance/radius);
- }
- return;
-}
-
-
-static void construct_tic_from_input(struct All_variables *E)
-{
- double mantle_temperature;
-
- switch (E->convection.tic_method){
- case 0:
- /* a linear temperature profile + perturbations at some layers */
- linear_temperature_profile(E);
- add_perturbations_at_layers(E);
- break;
-
- case 1:
- /* T=1 for whole mantle + cold lithosphere TBL */
- mantle_temperature = 1;
- constant_temperature_profile(E, mantle_temperature);
- add_top_tbl(E, E->convection.half_space_age, mantle_temperature);
- break;
-
- case 2:
- /* T='mantle_temp' for whole mantle + cold lithosphere TBL
- + a spherical anomaly at lower center */
- mantle_temperature = E->control.lith_age_mantle_temp;
- constant_temperature_profile(E, mantle_temperature);
- add_top_tbl(E, E->convection.half_space_age, mantle_temperature);
- add_spherical_anomaly(E);
- break;
-
- case 3:
- /* a conductive temperature profile + perturbations at all layers */
- conductive_temperature_profile(E);
- add_perturbations_at_all_layers(E);
- break;
-
- case 4:
- /* read initial temperature from grd files */
-#ifdef USE_GGRD
- if (E->sphere.caps == 1)
- ggrd_reg_temp_init(E);
- else
- ggrd_full_temp_init(E);
-#else
- fprintf(stderr,"tic_method 4 only works for USE_GGRD compiled code\n");
- parallel_process_termination();
-#endif
- break;
-
- case 10:
- /* T='mantle_temp' for whole mantle + cold lithosphere TBL
- + perturbations at some layers */
-
- mantle_temperature = E->control.lith_age_mantle_temp;
- constant_temperature_profile(E, mantle_temperature);
- add_top_tbl(E, E->convection.half_space_age, mantle_temperature);
- add_perturbations_at_all_layers(E);
- break;
-
- case 11:
- /* T='mantle_temp' for whole mantle + hot CMB TBL
- + perturbations at some layers */
-
- mantle_temperature = E->control.lith_age_mantle_temp;
- constant_temperature_profile(E, mantle_temperature);
- add_bottom_tbl(E, E->convection.half_space_age, mantle_temperature);
- add_perturbations_at_all_layers(E);
- break;
-
- case 12:
- /* T='mantle_temp' for whole mantle + cold lithosphere TBL
- + hot CMB TBL + perturbations at some layers */
-
- mantle_temperature = E->control.lith_age_mantle_temp;
- constant_temperature_profile(E, mantle_temperature);
- add_top_tbl(E, E->convection.half_space_age, mantle_temperature);
- add_bottom_tbl(E, E->convection.half_space_age, mantle_temperature);
- add_perturbations_at_all_layers(E);
- break;
-
- case 100:
- /* user-defined initial temperature goes here */
- fprintf(stderr,"Need user definition for initial temperture: 'tic_method=%d'\n",
- E->convection.tic_method);
- parallel_process_termination();
- break;
-
- default:
- /* unknown option */
- fprintf(stderr,"Invalid value: 'tic_method=%d'\n", E->convection.tic_method);
- parallel_process_termination();
- break;
- }
-
- temperatures_conform_bcs(E);
-
- /* debugging the code of expanding spherical harmonics */
- /* debug_sphere_expansion(E);*/
- return;
-}
-
-
Copied: mc/3D/CitcomS/branches/cxx/lib/Initial_temperature.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Initial_temperature.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Initial_temperature.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Initial_temperature.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,678 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+
+#include <math.h>
+#include <assert.h>
+#include <string.h>
+
+#include "global_defs.h"
+#include "lith_age.h"
+#include "parsing.h"
+
+#include "cproto.h"
+
+void parallel_process_termination();
+void temperatures_conform_bcs(struct All_variables *);
+double modified_plgndr_a(int, int, double);
+
+#include "initial_temperature.h"
+static void debug_tic(struct All_variables *);
+static void read_tic_from_file(struct All_variables *);
+static void construct_tic_from_input(struct All_variables *);
+
+#ifdef USE_GZDIR
+void restart_tic_from_gzdir_file(struct All_variables *);
+#endif
+#ifdef USE_GGRD
+#include "ggrd_handling.h"
+#endif
+
+
+void tic_input(struct All_variables *E)
+{
+
+ int m = E->parallel.me;
+ int noz = E->lmesh.noz;
+ int n;
+#ifdef USE_GGRD
+ int tmp;
+#endif
+
+ input_int("tic_method", &(E->convection.tic_method), "0,0,2", m);
+
+#ifdef USE_GGRD /* for backward capability */
+ input_int("ggrd_tinit", &tmp, "0", m);
+ if(tmp){
+ E->convection.tic_method = 4; /* */
+ E->control.ggrd.use_temp = 1;
+ }
+#endif
+ /* When tic_method is 0 (default), the temperature is a linear profile +
+ perturbation at some layers.
+
+ When tic_method is -1, the temperature is read in from the
+ [datafile_old].velo.[rank].[solution_cycles_init] files.
+
+ When tic_method is 1, the temperature is isothermal (== bottom b.c.) +
+ uniformly cold plate (thickness specified by 'half_space_age').
+
+ When tic_method is 2, (tic_method==1) + a hot blob. A user can specify
+ the location and radius of the blob, and also the amplitude of temperature
+ change in the blob relative to the ambient mantle temperautre
+ (E->control.lith_age_mantle_temp).
+ - blob_center: A comma-separated list of three float numbers.
+ - blob_radius: A dmensionless length, typically a fraction
+ of the Earth's radius.
+ - blob_dT : Dimensionless temperature.
+
+ When tic_method is 3, the temperature is a linear profile + perturbation
+ for whole mantle.
+
+ tic_method is 4: read in initial temperature distribution from a set of netcdf grd
+ files. this required the GGRD extension to be compiled in
+
+ */
+
+ /* This part put a temperature anomaly at depth where the global
+ node number is equal to load_depth. The horizontal pattern of
+ the anomaly is given by spherical harmonic ll & mm. */
+
+ input_int("num_perturbations", &n, "0,0,PERTURB_MAX_LAYERS", m);
+
+ if (n > 0) {
+ E->convection.number_of_perturbations = n;
+
+ if (! input_float_vector("perturbmag", n, E->convection.perturb_mag, m) ) {
+ fprintf(stderr,"Missing input parameter: 'perturbmag'\n");
+ parallel_process_termination();
+ }
+ if (! input_int_vector("perturbm", n, E->convection.perturb_mm, m) ) {
+ fprintf(stderr,"Missing input parameter: 'perturbm'\n");
+ parallel_process_termination();
+ }
+ if (! input_int_vector("perturbl", n, E->convection.perturb_ll, m) ) {
+ fprintf(stderr,"Missing input parameter: 'perturbl'\n");
+ parallel_process_termination();
+ }
+ if (! input_int_vector("perturblayer", n, E->convection.load_depth, m) ) {
+ fprintf(stderr,"Missing input parameter: 'perturblayer'\n");
+ parallel_process_termination();
+ }
+ }
+ else {
+ E->convection.number_of_perturbations = 1;
+ E->convection.perturb_mag[0] = 1;
+ E->convection.perturb_mm[0] = 2;
+ E->convection.perturb_ll[0] = 2;
+ E->convection.load_depth[0] = (noz+1)/2;
+ }
+
+ input_float("half_space_age", &(E->convection.half_space_age), "40.0,1e-3,nomax", m);
+
+ switch(E->convection.tic_method){
+ case 2: /* blob */
+ if( ! input_float_vector("blob_centqer", 3, E->convection.blob_center, m)) {
+ assert( E->sphere.caps == 12 || E->sphere.caps == 1 );
+ if(E->sphere.caps == 12) { /* Full version: just quit here */
+ fprintf(stderr,"Missing input parameter: 'blob_center'.\n");
+ parallel_process_termination();
+ }
+ else if(E->sphere.caps == 1) { /* Regional version: put the blob at the center */
+ fprintf(stderr,"Missing input parameter: 'blob_center'. The blob will be placed at the center of the domain.\n");
+ E->convection.blob_center[0] = 0.5*(E->control.theta_min+E->control.theta_max);
+ E->convection.blob_center[1] = 0.5*(E->control.fi_min+E->control.fi_max);
+ E->convection.blob_center[2] = 0.5*(E->sphere.ri+E->sphere.ro);
+ }
+ }
+ input_float("blob_radius", &(E->convection.blob_radius), "0.063,0.0,1.0", m);
+ input_float("blob_dT", &(E->convection.blob_dT), "0.18,nomin,nomax", m);
+ break;
+ case 4:
+ /*
+ case 4: initial temp from grd files
+ */
+#ifdef USE_GGRD
+ /*
+ read in some more parameters
+
+ */
+ /* scale the anomalies with PREM densities */
+ input_boolean("ggrd_tinit_scale_with_prem",&(E->control.ggrd.temp.scale_with_prem),"off",E->parallel.me);
+ /* limit T to 0...1 */
+ input_boolean("ggrd_tinit_limit_trange",&(E->control.ggrd.temp.limit_trange),"on",E->parallel.me);
+ /* scaling factor for the grids */
+ input_double("ggrd_tinit_scale",&(E->control.ggrd.temp.scale),"1.0",E->parallel.me); /* scale */
+ /* temperature offset factor */
+ input_double("ggrd_tinit_offset",&(E->control.ggrd.temp.offset),"0.0",E->parallel.me); /* offset */
+ /* grid name, without the .i.grd suffix */
+ input_string("ggrd_tinit_gfile",E->control.ggrd.temp.gfile,"",E->parallel.me); /* grids */
+ input_string("ggrd_tinit_dfile",E->control.ggrd.temp.dfile,"",E->parallel.me); /* depth.dat layers of grids*/
+ /* override temperature boundary condition? */
+ input_boolean("ggrd_tinit_override_tbc",&(E->control.ggrd.temp.override_tbc),"off",E->parallel.me);
+ input_string("ggrd_tinit_prem_file",E->control.ggrd.temp.prem.model_filename,"hc/prem/prem.dat", E->parallel.me); /* PREM model filename */
+#else
+ fprintf(stderr,"tic_method 4 only works for USE_GGRD compiled code\n");
+ parallel_process_termination();
+#endif
+ break;
+ } /* no default needed */
+ return;
+}
+
+
+
+void convection_initial_temperature(struct All_variables *E)
+{
+ report(E,"Initialize temperature field");
+
+ if (E->convection.tic_method == -1) {
+ /* read temperature from file */
+#ifdef USE_GZDIR
+ if(strcmp(E->output.format, "ascii-gz") == 0)
+ restart_tic_from_gzdir_file(E);
+ else
+#endif
+ read_tic_from_file(E);
+ }
+ else if (E->control.lith_age)
+ lith_age_construct_tic(E);
+ else
+ construct_tic_from_input(E);
+
+ /* Note: it is the callee's responsibility to conform tbc. */
+ /* like a call to temperatures_conform_bcs(E); */
+
+ if (E->control.verbose)
+ debug_tic(E);
+
+ return;
+}
+
+
+static void debug_tic(struct All_variables *E)
+{
+ int m, j;
+
+ fprintf(E->fp_out,"output_temperature\n");
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+ fprintf(E->fp_out,"for cap %d\n",E->sphere.capid[m]);
+ for (j=1;j<=E->lmesh.nno;j++)
+ fprintf(E->fp_out,"X = %.6e Z = %.6e Y = %.6e T[%06d] = %.6e \n",E->sx[m][1][j],E->sx[m][2][j],E->sx[m][3][j],j,E->T[m][j]);
+ }
+ fflush(E->fp_out);
+
+ return;
+}
+
+
+
+static void read_tic_from_file(struct All_variables *E)
+{
+ int ii, ll, mm;
+ float tt;
+ int i, m;
+ char output_file[255], input_s[1000];
+ FILE *fp;
+
+ float v1, v2, v3, g;
+
+ ii = E->monitor.solution_cycles_init;
+ sprintf(output_file,"%s.velo.%d.%d",E->control.old_P_file,E->parallel.me,ii);
+ fp=fopen(output_file,"r");
+ if (fp == NULL) {
+ fprintf(E->fp,"(Initial_temperature.c #1) Cannot open %s\n",output_file);
+ parallel_process_termination();
+ }
+
+ if (E->parallel.me==0)
+ fprintf(E->fp,"Reading %s for initial temperature\n",output_file);
+
+ fgets(input_s,1000,fp);
+ sscanf(input_s,"%d %d %f",&ll,&mm,&tt);
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+ fgets(input_s,1000,fp);
+ sscanf(input_s,"%d %d",&ll,&mm);
+ for(i=1;i<=E->lmesh.nno;i++) {
+ fgets(input_s,1000,fp);
+ sscanf(input_s,"%g %g %g %f",&(v1),&(v2),&(v3),&(g));
+
+ /* Truncate the temperature to be within (0,1). */
+ /* This might not be desirable in some situations. */
+ E->T[m][i] = max(0.0,min(g,1.0));
+ }
+ }
+ fclose (fp);
+
+ temperatures_conform_bcs(E);
+
+ return;
+}
+
+
+static void linear_temperature_profile(struct All_variables *E)
+{
+ int m, i, j, k, node;
+ int nox, noy, noz;
+ double r1;
+
+ nox = E->lmesh.nox;
+ noy = E->lmesh.noy;
+ noz = E->lmesh.noz;
+
+ for(m=1; m<=E->sphere.caps_per_proc; m++)
+ for(i=1; i<=noy; i++)
+ for(j=1; j<=nox;j ++)
+ for(k=1; k<=noz; k++) {
+ node = k + (j-1)*noz + (i-1)*nox*noz;
+ r1 = E->sx[m][3][node];
+ E->T[m][node] = E->control.TBCbotval - (E->control.TBCtopval + E->control.TBCbotval)*(r1 - E->sphere.ri)/(E->sphere.ro - E->sphere.ri);
+ }
+
+ return;
+}
+
+
+static void conductive_temperature_profile(struct All_variables *E)
+{
+ int m, i, j, k, node;
+ int nox, noy, noz;
+ double r1;
+
+ nox = E->lmesh.nox;
+ noy = E->lmesh.noy;
+ noz = E->lmesh.noz;
+
+ for(m=1; m<=E->sphere.caps_per_proc; m++)
+ for(i=1; i<=noy; i++)
+ for(j=1; j<=nox;j ++)
+ for(k=1; k<=noz; k++) {
+ node = k + (j-1)*noz + (i-1)*nox*noz;
+ r1 = E->sx[m][3][node];
+ E->T[m][node] = (E->control.TBCtopval*E->sphere.ro
+ - E->control.TBCbotval*E->sphere.ri)
+ / (E->sphere.ro - E->sphere.ri)
+ + (E->control.TBCbotval - E->control.TBCtopval)
+ * E->sphere.ro * E->sphere.ri / r1
+ / (E->sphere.ro - E->sphere.ri);
+ }
+
+ return;
+}
+
+
+static void constant_temperature_profile(struct All_variables *E, double mantle_temp)
+{
+ int m, i;
+
+ for(m=1; m<=E->sphere.caps_per_proc; m++)
+ for(i=1; i<=E->lmesh.nno; i++)
+ E->T[m][i] = mantle_temp;
+
+ return;
+}
+
+
+static void add_top_tbl(struct All_variables *E, double age_in_myrs, double mantle_temp)
+{
+ int m, i, j, k, node;
+ int nox, noy, noz;
+ double r1, dT, tmp;
+
+ nox = E->lmesh.nox;
+ noy = E->lmesh.noy;
+ noz = E->lmesh.noz;
+
+ dT = (mantle_temp - E->control.TBCtopval);
+ tmp = 0.5 / sqrt(age_in_myrs / E->data.scalet);
+
+ fprintf(stderr, "%e %e\n", dT, tmp);
+ for(m=1; m<=E->sphere.caps_per_proc; m++)
+ for(i=1; i<=noy; i++)
+ for(j=1; j<=nox;j ++)
+ for(k=1; k<=noz; k++) {
+ node = k + (j-1)*noz + (i-1)*nox*noz;
+ r1 = E->sx[m][3][node];
+ E->T[m][node] -= dT * erfc(tmp * (E->sphere.ro - r1));
+ }
+
+ return;
+}
+
+
+static void add_bottom_tbl(struct All_variables *E, double age_in_myrs, double mantle_temp)
+{
+ int m, i, j, k, node;
+ int nox, noy, noz;
+ double r1, dT, tmp;
+
+ nox = E->lmesh.nox;
+ noy = E->lmesh.noy;
+ noz = E->lmesh.noz;
+
+ dT = (E->control.TBCbotval - mantle_temp);
+ tmp = 0.5 / sqrt(age_in_myrs / E->data.scalet);
+
+ for(m=1; m<=E->sphere.caps_per_proc; m++)
+ for(i=1; i<=noy; i++)
+ for(j=1; j<=nox;j ++)
+ for(k=1; k<=noz; k++) {
+ node = k + (j-1)*noz + (i-1)*nox*noz;
+ r1 = E->sx[m][3][node];
+ E->T[m][node] += dT * erfc(tmp * (r1 - E->sphere.ri));
+ }
+
+ return;
+}
+
+
+static void add_perturbations_at_layers(struct All_variables *E)
+{
+ /* This function put a temperature anomaly at depth where the global
+ node number is equal to load_depth. The horizontal pattern of
+ the anomaly is given by wavenumber (in regional model) or
+ by spherical harmonic (in global model). */
+
+ int m, i, j, k, node;
+ int p, ll, mm, kk;
+ int nox, noy, noz, gnoz;
+ double t1, f1, tlen, flen, con;
+
+ nox = E->lmesh.nox;
+ noy = E->lmesh.noy;
+ noz = E->lmesh.noz;
+ gnoz = E->mesh.noz;
+
+ for (p=0; p<E->convection.number_of_perturbations; p++) {
+ ll = E->convection.perturb_ll[p];
+ mm = E->convection.perturb_mm[p];
+ kk = E->convection.load_depth[p];
+ con = E->convection.perturb_mag[p];
+
+ if ( (kk < 1) || (kk >= gnoz) ) continue; /* layer kk is outside domain */
+
+ k = kk - E->lmesh.nzs + 1; /* convert global nz to local nz */
+ if ( (k < 1) || (k >= noz) ) continue; /* layer k is not inside this proc. */
+ if (E->parallel.me_loc[1] == 0 && E->parallel.me_loc[2] == 0
+ && E->sphere.capid[1] == 1 )
+ fprintf(stderr,"Initial temperature perturbation: layer=%d mag=%g l=%d m=%d\n", kk, con, ll, mm);
+
+ if(E->sphere.caps == 1) {
+ /* regional mode, add sinosoidal perturbation */
+
+ tlen = M_PI / (E->control.theta_max - E->control.theta_min);
+ flen = M_PI / (E->control.fi_max - E->control.fi_min);
+
+ for(m=1; m<=E->sphere.caps_per_proc; m++)
+ for(i=1; i<=noy; i++)
+ for(j=1; j<=nox;j ++) {
+ node = k + (j-1)*noz + (i-1)*nox*noz;
+ t1 = (E->sx[m][1][node] - E->control.theta_min) * tlen;
+ f1 = (E->sx[m][2][node] - E->control.fi_min) * flen;
+
+ E->T[m][node] += con * cos(ll*t1) * cos(mm*f1);
+ }
+ }
+ else {
+ /* global mode, add spherical harmonics perturbation */
+
+ for(m=1; m<=E->sphere.caps_per_proc; m++)
+ for(i=1; i<=noy; i++)
+ for(j=1; j<=nox;j ++) {
+ node = k + (j-1)*noz + (i-1)*nox*noz;
+ t1 = E->sx[m][1][node];
+ f1 = E->sx[m][2][node];
+
+ E->T[m][node] += con * modified_plgndr_a(ll,mm,t1) * cos(mm*f1);
+ }
+ } /* end if */
+ } /* end for p */
+
+ return;
+}
+
+
+static void add_perturbations_at_all_layers(struct All_variables *E)
+{
+ /* This function put a temperature anomaly for whole mantle with
+ a sinosoidal amplitude in radial dependence. The horizontal pattern
+ of the anomaly is given by wavenumber (in regional model) or
+ by spherical harmonic (in global model). */
+
+ int m, i, j, k, node;
+ int p, ll, mm;
+ int nox, noy, noz, gnoz;
+ double r1, t1, f1, tlen, flen, rlen, con;
+
+ nox = E->lmesh.nox;
+ noy = E->lmesh.noy;
+ noz = E->lmesh.noz;
+ gnoz = E->mesh.noz;
+
+ rlen = M_PI / (E->sphere.ro - E->sphere.ri);
+
+ for (p=0; p<E->convection.number_of_perturbations; p++) {
+ ll = E->convection.perturb_ll[p];
+ mm = E->convection.perturb_mm[p];
+ con = E->convection.perturb_mag[p];
+
+ if (E->parallel.me_loc[1] == 0 && E->parallel.me_loc[2] == 0
+ && E->sphere.capid[1] == 1 )
+ fprintf(stderr,"Initial temperature perturbation: mag=%g l=%d m=%d\n", con, ll, mm);
+
+ if(E->sphere.caps == 1) {
+ /* regional mode, add sinosoidal perturbation */
+
+ tlen = M_PI / (E->control.theta_max - E->control.theta_min);
+ flen = M_PI / (E->control.fi_max - E->control.fi_min);
+
+ for(m=1; m<=E->sphere.caps_per_proc; m++)
+ for(i=1; i<=noy; i++)
+ for(j=1; j<=nox;j ++)
+ for(k=1; k<=noz; k++) {
+ node = k + (j-1)*noz + (i-1)*nox*noz;
+ t1 = (E->sx[m][1][node] - E->control.theta_min) * tlen;
+ f1 = (E->sx[m][2][node] - E->control.fi_min) * flen;
+ r1 = E->sx[m][3][node];
+
+ E->T[m][node] += con * cos(ll*t1) * cos(mm*f1)
+ * sin((r1-E->sphere.ri) * rlen);
+ }
+ }
+ else {
+ /* global mode, add spherical harmonics perturbation */
+
+ for(m=1; m<=E->sphere.caps_per_proc; m++)
+ for(i=1; i<=noy; i++)
+ for(j=1; j<=nox;j ++)
+ for(k=1; k<=noz; k++) {
+ node = k + (j-1)*noz + (i-1)*nox*noz;
+ t1 = E->sx[m][1][node];
+ f1 = E->sx[m][2][node];
+ r1 = E->sx[m][3][node];
+
+ E->T[m][node] += con * modified_plgndr_a(ll,mm,t1)
+ * (cos(mm*f1) + sin(mm*f1))
+ * sin((r1-E->sphere.ri) * rlen);
+ }
+ } /* end if */
+ } /* end for p */
+
+ return;
+}
+
+
+static void add_spherical_anomaly(struct All_variables *E)
+{
+ int i, j ,k , m, node;
+ int nox, noy, noz;
+
+ double theta_center, fi_center, r_center;
+ double radius, amp;
+
+ double x_center, y_center, z_center;
+ double x, y, z, distance;
+
+ noy = E->lmesh.noy;
+ nox = E->lmesh.nox;
+ noz = E->lmesh.noz;
+
+ theta_center = E->convection.blob_center[0];
+ fi_center = E->convection.blob_center[1];
+ r_center = E->convection.blob_center[2];
+ radius = E->convection.blob_radius;
+ amp = E->convection.blob_dT;
+
+ fprintf(stderr,"center=(%e %e %e) radius=%e dT=%e\n",
+ theta_center, fi_center, r_center, radius, amp);
+
+ x_center = r_center * sin(fi_center) * cos(theta_center);
+ y_center = r_center * sin(fi_center) * sin(theta_center);
+ z_center = r_center * cos(fi_center);
+
+ /* compute temperature field according to nodal coordinate */
+ for(m=1; m<=E->sphere.caps_per_proc; m++)
+ for(i=1; i<=noy; i++)
+ for(j=1; j<=nox;j ++)
+ for(k=1; k<=noz; k++) {
+ node = k + (j-1)*noz + (i-1)*nox*noz;
+
+ x = E->x[m][1][node];
+ y = E->x[m][2][node];
+ z = E->x[m][3][node];
+
+ distance = sqrt((x-x_center)*(x-x_center) +
+ (y-y_center)*(y-y_center) +
+ (z-z_center)*(z-z_center));
+
+ if (distance < radius)
+ E->T[m][node] += amp * exp(-1.0*distance/radius);
+ }
+ return;
+}
+
+
+static void construct_tic_from_input(struct All_variables *E)
+{
+ double mantle_temperature;
+
+ switch (E->convection.tic_method){
+ case 0:
+ /* a linear temperature profile + perturbations at some layers */
+ linear_temperature_profile(E);
+ add_perturbations_at_layers(E);
+ break;
+
+ case 1:
+ /* T=1 for whole mantle + cold lithosphere TBL */
+ mantle_temperature = 1;
+ constant_temperature_profile(E, mantle_temperature);
+ add_top_tbl(E, E->convection.half_space_age, mantle_temperature);
+ break;
+
+ case 2:
+ /* T='mantle_temp' for whole mantle + cold lithosphere TBL
+ + a spherical anomaly at lower center */
+ mantle_temperature = E->control.lith_age_mantle_temp;
+ constant_temperature_profile(E, mantle_temperature);
+ add_top_tbl(E, E->convection.half_space_age, mantle_temperature);
+ add_spherical_anomaly(E);
+ break;
+
+ case 3:
+ /* a conductive temperature profile + perturbations at all layers */
+ conductive_temperature_profile(E);
+ add_perturbations_at_all_layers(E);
+ break;
+
+ case 4:
+ /* read initial temperature from grd files */
+#ifdef USE_GGRD
+ if (E->sphere.caps == 1)
+ ggrd_reg_temp_init(E);
+ else
+ ggrd_full_temp_init(E);
+#else
+ fprintf(stderr,"tic_method 4 only works for USE_GGRD compiled code\n");
+ parallel_process_termination();
+#endif
+ break;
+
+ case 10:
+ /* T='mantle_temp' for whole mantle + cold lithosphere TBL
+ + perturbations at some layers */
+
+ mantle_temperature = E->control.lith_age_mantle_temp;
+ constant_temperature_profile(E, mantle_temperature);
+ add_top_tbl(E, E->convection.half_space_age, mantle_temperature);
+ add_perturbations_at_all_layers(E);
+ break;
+
+ case 11:
+ /* T='mantle_temp' for whole mantle + hot CMB TBL
+ + perturbations at some layers */
+
+ mantle_temperature = E->control.lith_age_mantle_temp;
+ constant_temperature_profile(E, mantle_temperature);
+ add_bottom_tbl(E, E->convection.half_space_age, mantle_temperature);
+ add_perturbations_at_all_layers(E);
+ break;
+
+ case 12:
+ /* T='mantle_temp' for whole mantle + cold lithosphere TBL
+ + hot CMB TBL + perturbations at some layers */
+
+ mantle_temperature = E->control.lith_age_mantle_temp;
+ constant_temperature_profile(E, mantle_temperature);
+ add_top_tbl(E, E->convection.half_space_age, mantle_temperature);
+ add_bottom_tbl(E, E->convection.half_space_age, mantle_temperature);
+ add_perturbations_at_all_layers(E);
+ break;
+
+ case 100:
+ /* user-defined initial temperature goes here */
+ fprintf(stderr,"Need user definition for initial temperture: 'tic_method=%d'\n",
+ E->convection.tic_method);
+ parallel_process_termination();
+ break;
+
+ default:
+ /* unknown option */
+ fprintf(stderr,"Invalid value: 'tic_method=%d'\n", E->convection.tic_method);
+ parallel_process_termination();
+ break;
+ }
+
+ temperatures_conform_bcs(E);
+
+ /* debugging the code of expanding spherical harmonics */
+ /* debug_sphere_expansion(E);*/
+ return;
+}
+
+
Deleted: mc/3D/CitcomS/branches/cxx/lib/Instructions.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Instructions.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Instructions.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,1794 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-/* Set up the finite element problem to suit: returns with all memory */
-/* allocated, temperature, viscosity, node locations and how to use */
-/* them all established. 8.29.92 or 29.8.92 depending on your nationality*/
-
-#include <math.h>
-#include <string.h>
-#include <stdlib.h>
-#include <stddef.h>
-#include <sys/stat.h>
-#include <sys/errno.h>
-#include <unistd.h>
-#include <ctype.h>
-#include "element_definitions.h"
-#include "global_defs.h"
-
-#include "citcom_init.h"
-#include "initial_temperature.h"
-#include "lith_age.h"
-#include "material_properties.h"
-#include "output.h"
-#include "output_h5.h"
-#include "parallel_related.h"
-#include "parsing.h"
-#include "phase_change.h"
-#include "interuption.h"
-
-void parallel_process_termination();
-void allocate_common_vars(struct All_variables*);
-void allocate_velocity_vars(struct All_variables*);
-void check_bc_consistency(struct All_variables*);
-void construct_elt_gs(struct All_variables*);
-void construct_elt_cs(struct All_variables*);
-void construct_shape_function_derivatives(struct All_variables *E);
-void construct_id(struct All_variables*);
-void construct_ien(struct All_variables*);
-void construct_lm(struct All_variables*);
-void construct_masks(struct All_variables*);
-void construct_shape_functions(struct All_variables*);
-void construct_sub_element(struct All_variables*);
-void construct_surf_det (struct All_variables*);
-void construct_bdry_det (struct All_variables*);
-void construct_surface (struct All_variables*);
-void get_initial_elapsed_time(struct All_variables*);
-void lith_age_init(struct All_variables *E);
-void mass_matrix(struct All_variables*);
-void output_init(struct All_variables*);
-void set_elapsed_time(struct All_variables*);
-void set_sphere_harmonics (struct All_variables*);
-void set_starting_age(struct All_variables*);
-void tracer_initial_settings(struct All_variables*);
-void tracer_input(struct All_variables*);
-void viscosity_input(struct All_variables*);
-void vtk_output(struct All_variables*, int);
-void get_vtk_filename(char *,int,struct All_variables *,int);
-void myerror(struct All_variables *,char *);
-void open_qfiles(struct All_variables *) ;
-void read_rayleigh_from_file(struct All_variables *);
-void read_initial_settings(struct All_variables *);
-void check_settings_consistency(struct All_variables *);
-void global_derived_values(struct All_variables *);
-
-
-void initial_mesh_solver_setup(struct All_variables *E)
-{
- int chatty;
- //chatty = ((E->parallel.me == 0)&&(E->control.verbose))?(1):(0);
- chatty = E->parallel.me == 0;
-
- E->monitor.cpu_time_at_last_cycle =
- E->monitor.cpu_time_at_start = CPU_time0();
-
- output_init(E);
- (E->problem_derived_values)(E); /* call this before global_derived_ */
- global_derived_values(E);
-
- (E->solver.parallel_processor_setup)(E); /* get # of proc in x,y,z */
- (E->solver.parallel_domain_decomp0)(E); /* get local nel, nno, elx, nox et al */
-
- allocate_common_vars(E);
- (E->problem_allocate_vars)(E);
- (E->solver_allocate_vars)(E);
- if(chatty)fprintf(stderr,"memory allocation done\n");
- /* logical domain */
- construct_ien(E);
- construct_surface(E);
- (E->solver.construct_boundary)(E);
- (E->solver.parallel_domain_boundary_nodes)(E);
- if(chatty)fprintf(stderr,"parallel setup done\n");
-
- /* physical domain */
- (E->solver.node_locations)(E);
- if(chatty)fprintf(stderr,"node locations done\n");
-
- allocate_velocity_vars(E);
- if(chatty)fprintf(stderr,"velocity vars done\n");
-
-
- get_initial_elapsed_time(E); /* Set elapsed time */
- set_starting_age(E); /* set the starting age to elapsed time, if desired */
- set_elapsed_time(E); /* reset to elapsed time to zero, if desired */
-
-
- /* open the heatflow files here because we need to know about loc_me */
- if(E->output.write_q_files)
- open_qfiles(E);
- else{
- E->output.fpqt = E->output.fpqb = NULL;
- }
-
-
-
- if(E->control.lith_age)
- lith_age_init(E);
-
- (E->problem_boundary_conds)(E);
-
- check_bc_consistency(E);
- if(chatty)fprintf(stderr,"boundary conditions done\n");
-
- construct_masks(E); /* order is important here */
- construct_id(E);
- construct_lm(E);
- if(chatty)fprintf(stderr,"id/lm done\n");
-
- (E->solver.parallel_communication_routs_v)(E);
- if(chatty)fprintf(stderr,"v communications done\n");
-
- if(E->control.use_cbf_topo){
- (E->solver.parallel_communication_routs_s)(E);
- if(chatty)fprintf(stderr,"s communications done\n");
- }
- reference_state(E);
-
- construct_sub_element(E);
- construct_shape_functions(E);
- construct_shape_function_derivatives(E);
- construct_elt_gs(E);
- if(E->control.inv_gruneisen != 0)
- construct_elt_cs(E);
-
- /* this matrix results from spherical geometry */
- /* construct_c3x3matrix(E); */
-
- mass_matrix(E);
-
- construct_surf_det (E);
- construct_bdry_det (E);
-
- if(chatty)fprintf(stderr,"mass matrix, dets done\n");
-
- set_sphere_harmonics (E);
-
-
- if(E->control.tracer) {
- tracer_initial_settings(E);
- (E->problem_tracer_setup)(E);
- }
- if(chatty)fprintf(stderr,"initial_mesh_solver_setup done\n");
-}
-
-
-void read_instructions(struct All_variables *E, char *filename)
-{
- void read_initial_settings();
- void global_default_values();
-
- void setup_parser();
- void shutdown_parser();
-
- /* =====================================================
- Global interuption handling routine defined once here
- ===================================================== */
-
- set_signal();
-
- /* ==================================================
- Initialize from the command line
- from startup files. (See Parsing.c).
- ================================================== */
-
- setup_parser(E,filename);
-
- global_default_values(E);
- read_initial_settings(E);
- shutdown_parser(E);
-
- return;
-}
-
-
-/* This function is replaced by CitcomS.Solver._setup() */
-void initial_setup(struct All_variables *E)
-{
- void general_stokes_solver_setup();
- void initial_mesh_solver_setup();
-
- initial_mesh_solver_setup(E);
-
- general_stokes_solver_setup(E);
-
-#ifdef USE_GGRD
- /* updating local rayleigh number (based on Netcdf grds, the
- rayleigh number may be modified laterally in the surface
- layers) */
- /* no counterpart in pyre */
- if(E->control.ggrd.ray_control)
- read_rayleigh_from_file(E);
-#endif
-
- (E->next_buoyancy_field_init)(E);
- if (E->parallel.me==0) fprintf(stderr,"time=%f\n",
- CPU_time0()-E->monitor.cpu_time_at_start);
-
- return;
-}
-
-
-void initialize_material(struct All_variables *E)
-{
- void construct_mat_group();
- void read_mat_from_file();
-
- if(E->control.mat_control)
- read_mat_from_file(E);
- else
- construct_mat_group(E);
-}
-
-
-/* This function is replaced by CitcomS.Components.IC.launch()*/
-void initial_conditions(struct All_variables *E)
-{
- void initialize_tracers();
- void init_composition();
- void common_initial_fields();
-
- initialize_material(E);
-
- if (E->control.tracer==1) {
- initialize_tracers(E);
-
- if (E->composition.on)
- init_composition(E);
- }
-
- (E->problem_initial_fields)(E); /* temperature/chemistry/melting etc */
- common_initial_fields(E); /* velocity/pressure/viscosity (viscosity must be done LAST) */
-
- return;
-}
-
-
-void read_initial_settings(struct All_variables *E)
-{
- void set_convection_defaults();
- void set_cg_defaults();
- void set_mg_defaults();
- float tmp;
- double ell_tmp;
- int m=E->parallel.me;
- double levmax;
-
- /* first the problem type (defines subsequent behaviour) */
-
- input_string("Problem",E->control.PROBLEM_TYPE,"convection",m);
- if ( strcmp(E->control.PROBLEM_TYPE,"convection") == 0) {
- E->control.CONVECTION = 1;
- set_convection_defaults(E);
- }
-
- else if ( strcmp(E->control.PROBLEM_TYPE,"convection-chemical") == 0) {
- E->control.CONVECTION = 1;
- set_convection_defaults(E);
- }
-
- else {
- fprintf(E->fp,"Unable to determine problem type, assuming convection ... \n");
- E->control.CONVECTION = 1;
- set_convection_defaults(E);
- }
-
- input_string("Geometry",E->control.GEOMETRY,"sphere",m);
- if ( strcmp(E->control.GEOMETRY,"cart2d") == 0)
- { E->control.CART2D = 1;
- (E->solver.set_2dc_defaults)(E);}
- else if ( strcmp(E->control.GEOMETRY,"axi") == 0)
- { E->control.AXI = 1;
- }
- else if ( strcmp(E->control.GEOMETRY,"cart2pt5d") == 0)
- { E->control.CART2pt5D = 1;
- (E->solver.set_2pt5dc_defaults)(E);}
- else if ( strcmp(E->control.GEOMETRY,"cart3d") == 0)
- { E->control.CART3D = 1;
- (E->solver.set_3dc_defaults)(E);}
- else if ( strcmp(E->control.GEOMETRY,"sphere") == 0)
- {
- (E->solver.set_3dsphere_defaults)(E);}
- else
- { fprintf(E->fp,"Unable to determine geometry, assuming cartesian 2d ... \n");
- E->control.CART2D = 1;
- (E->solver.set_2dc_defaults)(E); }
-
- input_string("Solver",E->control.SOLVER_TYPE,"cgrad",m);
- if ( strcmp(E->control.SOLVER_TYPE,"cgrad") == 0)
- { E->control.CONJ_GRAD = 1;
- set_cg_defaults(E);}
- else if ( strcmp(E->control.SOLVER_TYPE,"multigrid") == 0)
- { E->control.NMULTIGRID = 1;
- set_mg_defaults(E);}
- else if ( strcmp(E->control.SOLVER_TYPE,"multigrid-el") == 0)
- { E->control.EMULTIGRID = 1;
- set_mg_defaults(E);}
- else
- { if (E->parallel.me==0) fprintf(stderr,"Unable to determine how to solve, specify Solver=VALID_OPTION \n");
- parallel_process_termination();
- }
-
-
- /* admin */
-
- input_string("Spacing",E->control.NODE_SPACING,"regular",m);
- if ( strcmp(E->control.NODE_SPACING,"regular") == 0)
- E->control.GRID_TYPE = 1;
- else if ( strcmp(E->control.NODE_SPACING,"bound_lyr") == 0)
- E->control.GRID_TYPE = 2;
- else if ( strcmp(E->control.NODE_SPACING,"region") == 0)
- E->control.GRID_TYPE = 3;
- else if ( strcmp(E->control.NODE_SPACING,"ortho_files") == 0)
- E->control.GRID_TYPE = 4;
- else
- { E->control.GRID_TYPE = 1; }
-
- /* Information on which files to print, which variables of the flow to calculate and print.
- Default is no information recorded (apart from special things for given applications.
- */
-
- input_string("datadir",E->control.data_dir,".",m);
- input_string("datafile",E->control.data_prefix,"initialize",m);
- input_string("datadir_old",E->control.data_dir_old,".",m);
- input_string("datafile_old",E->control.data_prefix_old,"initialize",m);
-
- input_int("nproc_surf",&(E->parallel.nprocxy),"1",m);
- input_int("nprocx",&(E->parallel.nprocx),"1",m);
- input_int("nprocy",&(E->parallel.nprocy),"1",m);
- input_int("nprocz",&(E->parallel.nprocz),"1",m);
-
- if ( strcmp(E->control.SOLVER_TYPE,"cgrad") == 0) {
- input_int("nodex",&(E->mesh.nox),"essential",m);
- input_int("nodez",&(E->mesh.noz),"essential",m);
- input_int("nodey",&(E->mesh.noy),"essential",m);
-
- E->mesh.mgunitx = E->mesh.nox - 1;
- E->mesh.mgunity = E->mesh.noy - 1;
- E->mesh.mgunitz = E->mesh.noz - 1;
- E->mesh.levels = 1;
- }
- else {
- input_int("mgunitx",&(E->mesh.mgunitx),"1",m);
- input_int("mgunitz",&(E->mesh.mgunitz),"1",m);
- input_int("mgunity",&(E->mesh.mgunity),"1",m);
-
- input_int("levels",&(E->mesh.levels),"1",m);
-
- levmax = E->mesh.levels - 1;
- E->mesh.nox = E->mesh.mgunitx * (int) pow(2.0,levmax) * E->parallel.nprocx + 1;
- E->mesh.noy = E->mesh.mgunity * (int) pow(2.0,levmax) * E->parallel.nprocy + 1;
- E->mesh.noz = E->mesh.mgunitz * (int) pow(2.0,levmax) * E->parallel.nprocz + 1;
- }
-
- input_int("coor",&(E->control.coor),"0",m);
- if(E->control.coor == 2){
- /*
- refinement in two layers
- */
- /* number of refinement layers */
- E->control.coor_refine[0] = 0.10; /* bottom 10% */
- E->control.coor_refine[1] = 0.15; /* get 15% of the nodes */
- E->control.coor_refine[2] = 0.10; /* top 10% */
- E->control.coor_refine[3] = 0.20; /* get 20% of the nodes */
- input_float_vector("coor_refine",4,E->control.coor_refine,m);
- }else if(E->control.coor == 3){
- /*
-
- refinement CitcomCU style, by reading in layers, e.g.
-
- r_grid_layers=3 # minus 1 is number of layers with uniform grid in r
- rr=0.5,0.75,1.0 # starting and ending r coodinates
- nr=1,37,97 # starting and ending node in r direction
-
- */
- input_int("r_grid_layers", &(E->control.rlayers), "1",m);
- if(E->control.rlayers > 20)
- myerror(E,"number of rlayers out of bounds (20) for coor = 3");
- /* layers radii */
- input_float_vector("rr", E->control.rlayers, (E->control.rrlayer),m);
- /* associated node numbers */
- input_int_vector("nr", E->control.rlayers, (E->control.nrlayer),m);
- }
-
- input_string("coor_file",E->control.coor_file,"",m);
-
-
- input_boolean("node_assemble",&(E->control.NASSEMBLE),"off",m);
- /* general mesh structure */
-
- input_boolean("verbose",&(E->control.verbose),"off",m);
- input_boolean("see_convergence",&(E->control.print_convergence),"off",m);
-
- input_boolean("stokes_flow_only",&(E->control.stokes),"off",m);
-
- //input_boolean("remove_hor_buoy_avg",&(E->control.remove_hor_buoy_avg),"on",m);
-
-
- /* restart from checkpoint file */
- input_boolean("restart",&(E->control.restart),"off",m);
- input_int("post_p",&(E->control.post_p),"0",m);
- input_int("solution_cycles_init",&(E->monitor.solution_cycles_init),"0",m);
-
- /* for layers */
-
- input_int("num_mat",&(E->viscosity.num_mat),"1",m); /* number of layers, moved
- from Viscosity_structures.c */
- if(E->viscosity.num_mat > CITCOM_MAX_VISC_LAYER)
- myerror(E,"too many viscosity layers as per num_mat, increase CITCOM_MAX_VISC_LAYER");
-
- /* those are specific depth layers associated with phase
- transitions, default values should be fixed */
- input_float("z_cmb",&(E->viscosity.zcmb),"0.45",m); /* 0.45063569 */
- input_float("z_lmantle",&(E->viscosity.zlm),"0.45",m); /*0.10359441 */
- input_float("z_410",&(E->viscosity.z410),"0.225",m); /* 0.06434, more like it */
- input_float("z_lith",&(E->viscosity.zlith),"0.225",m); /* 0.0157, more like it */
-
-
- /* those are depth layers associated with viscosity or material
- jumps, they may or may not be identical with the phase changes */
- E->viscosity.zbase_layer[0] = E->viscosity.zbase_layer[1] = -999;
- input_float_vector("z_layer",E->viscosity.num_mat,(E->viscosity.zbase_layer),m);
- if((fabs(E->viscosity.zbase_layer[0]+999) < 1e-5) &&
- (fabs(E->viscosity.zbase_layer[1]+999) < 1e-5)){
- /*
- no z_layer input found
- */
- if(E->viscosity.num_mat != 4)
- myerror(E,"error: either use z_layer for non dim layer depths, or set num_mat to four");
-
- E->viscosity.zbase_layer[0] = E->viscosity.zlith;
- E->viscosity.zbase_layer[1] = E->viscosity.z410;
- E->viscosity.zbase_layer[2] = E->viscosity.zlm;
- E->viscosity.zbase_layer[3] = E->viscosity.zcmb;
- }
-
- /* the start age and initial subduction history */
- input_float("start_age",&(E->control.start_age),"0.0",m);
- input_int("reset_startage",&(E->control.reset_startage),"0",m);
- input_int("zero_elapsed_time",&(E->control.zero_elapsed_time),"0",m);
-
- input_int("output_ll_max",&(E->output.llmax),"1",m);
-
- input_int("topvbc",&(E->mesh.topvbc),"0",m);
- input_int("botvbc",&(E->mesh.botvbc),"0",m);
-
- input_float("topvbxval",&(E->control.VBXtopval),"0.0",m);
- input_float("botvbxval",&(E->control.VBXbotval),"0.0",m);
- input_float("topvbyval",&(E->control.VBYtopval),"0.0",m);
- input_float("botvbyval",&(E->control.VBYbotval),"0.0",m);
-
-
- input_float("T_interior_max_for_exit",&(E->monitor.T_interior_max_for_exit),"1.5",m);
-
- input_int("pseudo_free_surf",&(E->control.pseudo_free_surf),"0",m);
-
- input_int("toptbc",&(E->mesh.toptbc),"1",m);
- input_int("bottbc",&(E->mesh.bottbc),"1",m);
- input_float("toptbcval",&(E->control.TBCtopval),"0.0",m);
- input_float("bottbcval",&(E->control.TBCbotval),"1.0",m);
-
- input_boolean("side_sbcs",&(E->control.side_sbcs),"off",m);
-
- input_int("file_vbcs",&(E->control.vbcs_file),"0",m);
- input_string("vel_bound_file",E->control.velocity_boundary_file,"",m);
-
- input_int("file_tbcs",&(E->control.tbcs_file),"0",m);
- input_string("temp_bound_file",E->control.temperature_boundary_file,"",m);
-
- input_int("reference_state",&(E->refstate.choice),"1",m);
- if(E->refstate.choice == 0) {
- input_string("refstate_file",E->refstate.filename,"refstate.dat",m);
- }
-
- input_int("mat_control",&(E->control.mat_control),"0",m);
- input_string("mat_file",E->control.mat_file,"",m);
-
-#ifdef USE_GGRD
-
-
- /*
-
- note that this part of the code might override mat_control, file_vbcs,
-
- MATERIAL CONTROL
-
- usage:
- (a)
-
- ggrd_mat_control=2
- ggrd_mat_file="weak.grd"
-
- read in time-constant prefactors from weak.grd netcdf file that apply to top two E->mat layers
-
- (b)
-
- ggrd_mat_control=2
- ggrd_mat_file="mythist"
- ggrd_time_hist_file="mythist/times.dat"
-
-
- time-dependent, will look for n files named mythist/i/weak.grd
- where i = 1...n and n is the number of times as specified in
- ggrd_time_hist_file which has time in Ma for n stages like so
-
- -->age is positive, and forward marching in time decreases the age<--
-
- 0 15
- 15 30
- 30 60
-
- */
- ggrd_init_master(&E->control.ggrd);
- /* this is controlling velocities, material, and age */
- /* time history file, if not specified, will use constant VBCs and material grids */
- input_string("ggrd_time_hist_file",
- E->control.ggrd.time_hist.file,"",m);
- /* if > 0, will use top E->control.ggrd.mat_control layers and assign a prefactor for the viscosity */
- input_int("ggrd_mat_control",&(E->control.ggrd.mat_control),"0",m);
- input_string("ggrd_mat_file",E->control.ggrd.mat_file,"",m); /* file to read prefactors from */
- if(E->control.ggrd.mat_control) /* this will override mat_control setting */
- E->control.mat_control = 1;
- /*
-
- Surface layer Rayleigh number control, similar to above
-
- */
- input_int("ggrd_rayleigh_control",
- &(E->control.ggrd.ray_control),"0",m);
- input_string("ggrd_rayleigh_file",
- E->control.ggrd.ray_file,"",m); /* file to read prefactors from */
- /*
-
- surface velocity control, similar to material control above
-
- if time-dependent, will look for ggrd_vtop_file/i/v?.grd
- if constant, will look for ggrd_vtop_file/v?.grd
-
- where vp/vt.grd are Netcdf GRD files with East and South velocities in cm/yr
-
-
- */
- input_int("ggrd_vtop_control",&(E->control.ggrd.vtop_control),"0",m);
- input_string("ggrd_vtop_dir",E->control.ggrd.vtop_dir,"",m); /* file to read prefactors from */
-
- /*
- read in omega[4] vector
-
- if omega[0] is > 0, will read in a code.grd file instead of
- vp.grd/vt.grd and assign the Euler vector omega[1-3] to all
- locations with that omega[0] code. The Euler pole is assumed to
- be in deg/Myr
-
- ggrd_vtop_omega=4,-0.0865166,0.277312,-0.571239
-
- will assign the NUVEL-1A NNR Pacific plate rotation vector to all
- points with code 4
-
- */
- E->control.ggrd_vtop_omega[0] = 0;
- input_float_vector("ggrd_vtop_omega",4,E->control.ggrd_vtop_omega,m);
- if(E->control.ggrd_vtop_omega[0] > 0)
- E->control.ggrd.vtop_control = 1;
-
- if(E->control.ggrd.vtop_control) /* this will override mat_control setting */
- E->control.vbcs_file = 1;
-
- /* if set, will check the theta velocities from grid input for
- scaled (internal non dim) values of > 1e9. if found, those nodes will
- be set to free slip
- */
- input_boolean("allow_mixed_vbcs",&(E->control.ggrd_allow_mixed_vbcs),"off",m);
-
-
-#endif
-
- input_boolean("aug_lagr",&(E->control.augmented_Lagr),"off",m);
- input_double("aug_number",&(E->control.augmented),"0.0",m);
-
- input_boolean("remove_rigid_rotation",&(E->control.remove_rigid_rotation),"on",m);
-
- input_boolean("self_gravitation",&(E->control.self_gravitation),"off",m);
- input_boolean("use_cbf_topo",&(E->control.use_cbf_topo),"off",m); /* make default on later XXX TWB */
-
-
- input_int("storage_spacing",&(E->control.record_every),"10",m);
- input_int("checkpointFrequency",&(E->control.checkpoint_frequency),"100",m);
- input_int("cpu_limits_in_seconds",&(E->control.record_all_until),"5",m);
- input_int("write_q_files",&(E->output.write_q_files),"0",m);/* write additional
- heat flux files? */
- if(E->output.write_q_files){ /* make sure those get written at
- least as often as velocities */
- E->output.write_q_files = min(E->output.write_q_files,E->control.record_every);
- }
-
-
- input_boolean("precond",&(E->control.precondition),"off",m);
-
- input_int("mg_cycle",&(E->control.mg_cycle),"2,0,nomax",m);
- input_int("down_heavy",&(E->control.down_heavy),"1,0,nomax",m);
- input_int("up_heavy",&(E->control.up_heavy),"1,0,nomax",m);
- input_double("accuracy",&(E->control.accuracy),"1.0e-4,0.0,1.0",m);
- input_boolean("only_check_vel_convergence",&(E->control.only_check_vel_convergence),"off",m);
-
- input_int("vhighstep",&(E->control.v_steps_high),"1,0,nomax",m);
- input_int("vlowstep",&(E->control.v_steps_low),"250,0,nomax",m);
- input_int("piterations",&(E->control.p_iterations),"100,0,nomax",m);
-
- input_float("rayleigh",&(E->control.Atemp),"essential",m);
-
- input_float("dissipation_number",&(E->control.disptn_number),"0.0",m);
- input_float("gruneisen",&(tmp),"0.0",m);
- /* special case: if tmp==0, set gruneisen as inf */
- if(tmp != 0)
- E->control.inv_gruneisen = 1/tmp;
- else
- E->control.inv_gruneisen = 0;
-
- if(E->control.inv_gruneisen != 0) {
- /* which compressible solver to use: "cg" or "bicg" */
- input_string("uzawa",E->control.uzawa,"cg",m);
- if(strcmp(E->control.uzawa, "cg") == 0) {
- /* more convergence parameters for "cg" */
- input_int("compress_iter_maxstep",&(E->control.compress_iter_maxstep),"100",m);
- }
- else if(strcmp(E->control.uzawa, "bicg") == 0) {
- }
- else
- myerror(E, "Error: unknown Uzawa iteration\n");
- }
-
- input_float("surfaceT",&(E->control.surface_temp),"0.1",m);
- /*input_float("adiabaticT0",&(E->control.adiabaticT0),"0.4",m);*/
- input_float("Q0",&(E->control.Q0),"0.0",m);
- /* Q0_enriched gets read in Tracer_setup.c */
-
- /* data section */
- input_float("gravacc",&(E->data.grav_acc),"9.81",m);
- input_float("thermexp",&(E->data.therm_exp),"3.0e-5",m);
- input_float("cp",&(E->data.Cp),"1200.0",m);
- input_float("thermdiff",&(E->data.therm_diff),"1.0e-6",m);
- input_float("density",&(E->data.density),"3340.0",m);
- input_float("density_above",&(E->data.density_above),"1030.0",m);
- input_float("density_below",&(E->data.density_below),"6600.0",m);
- input_float("refvisc",&(E->data.ref_viscosity),"1.0e21",m);
-
-
- input_double("ellipticity",&ell_tmp,"0.0",m);
-#ifdef ALLOW_ELLIPTICAL
- /*
-
- ellipticity and rotation settings
-
- */
- /* f = (a-c)/a, where c is the short, a=b the long axis
- 1/298.257 = 0.00335281317789691 for Earth at present day
- */
- E->data.ellipticity = ell_tmp;
- if(fabs(E->data.ellipticity) > 5e-7){
-
- /* define ra and rc such that R=1 is the volume equivalanet */
- E->data.ra = pow((1.-E->data.ellipticity),-1./3.); /* non dim long axis */
- E->data.rc = 1./(E->data.ra * E->data.ra); /* non dim short axis */
- E->data.efac = (1.-E->data.ellipticity)*(1.-E->data.ellipticity);
- if(E->parallel.me == 0){
- fprintf(stderr,"WARNING: EXPERIMENTAL: ellipticity: %.5e equivalent radii: r_a: %g r_b: %g\n",
- E->data.ellipticity,E->data.ra,E->data.rc);
- }
- E->data.use_ellipse = 1;
- }else{
- E->data.ra = E->data.rc = E->data.efac=1.0;
- E->data.use_ellipse = 0;
- }
- /*
- centrifugal ratio between \omega^2 a^3/GM, 3.46775e-3 for the
- Earth at present day
- */
- input_double("rotation_m",&E->data.rotm,"0.0",m);
- if(fabs(E->data.rotm) > 5e-7){
- /* J2 from flattening */
- E->data.j2 = 2./3.*E->data.ellipticity*(1.-E->data.ellipticity/2.)-
- E->data.rotm/3.*(1.-3./2.*E->data.rotm-2./7.*E->data.ellipticity);
- /* normalized gravity at the equator */
- E->data.ge = 1/(E->data.ra*E->data.ra)*(1+3./2.*E->data.j2-E->data.rotm);
- if(E->parallel.me==0)
- fprintf(stderr,"WARNING: rotational fraction m: %.5e J2: %.5e g_e: %g\n",
- E->data.rotm,E->data.j2,E->data.ge);
- E->data.use_rotation_g = 1;
- }else{
- E->data.use_rotation_g = 0;
- }
-#else
- if(fabs(ell_tmp) > 5e-7){
- myerror(E,"ellipticity not zero, but not compiled with ALLOW_ELLIPTICAL");
- }
-#endif
- input_float("radius",&tmp,"6371e3.0",m);
- E->data.radius_km = tmp / 1e3;
-
- E->data.therm_cond = E->data.therm_diff * E->data.density * E->data.Cp;
-
- E->data.ref_temperature = E->control.Atemp * E->data.therm_diff
- * E->data.ref_viscosity
- / (E->data.density * E->data.grav_acc * E->data.therm_exp)
- / (E->data.radius_km * E->data.radius_km * E->data.radius_km * 1e9);
-
- output_common_input(E);
- h5input_params(E);
- phase_change_input(E);
- lith_age_input(E);
-
- tic_input(E);
- tracer_input(E);
-
- viscosity_input(E); /* moved the viscosity input behind
- the tracer input */
-
- (E->problem_settings)(E);
-
- check_settings_consistency(E);
- return;
-}
-
-/* Checking the consistency of input parameters */
-void check_settings_consistency(struct All_variables *E)
-{
-
- if (strcmp(E->control.SOLVER_TYPE, "cgrad") == 0) {
- /* conjugate gradient has only one level */
- if(E->mesh.levels != 1)
- myerror(E, "Conjugate gradient solver is used. 'levels' must be 1.\n");
- }
- else {
- /* multigrid solver needs two or more levels */
- if(E->mesh.levels < 2)
- myerror(E, "number of multigrid levels < 2\n");
- if(E->mesh.levels > MAX_LEVELS)
- myerror(E, "number of multigrid levels out of bound\n");
- }
-
- if((E->parallel.me == 0) && (E->control.only_check_vel_convergence)) {
- fprintf(stderr,"solve_Ahat_p_fhat: WARNING: overriding pressure and div check\n");
- }
-
- return;
-}
-
-
-/* Setup global mesh parameters */
-void global_derived_values(struct All_variables *E)
-{
- int d,i,nox,noz,noy;
-
- E->mesh.levmax = E->mesh.levels-1;
- E->mesh.gridmax = E->mesh.levmax;
-
- E->mesh.elx = E->mesh.nox-1;
- E->mesh.ely = E->mesh.noy-1;
- E->mesh.elz = E->mesh.noz-1;
-
- if(E->sphere.caps == 1) {
- /* number of nodes, excluding overlaping nodes between processors */
- E->mesh.nno = E->sphere.caps * E->mesh.nox * E->mesh.noy * E->mesh.noz;
- }
- else {
- /* number of nodes, excluding overlaping nodes between processors */
- /* each cap has one row of nox and one row of noy overlapped, exclude these nodes.
- * nodes at north/south poles are exclued by all caps, include them by 2*noz*/
- E->mesh.nno = E->sphere.caps * (E->mesh.nox-1) * (E->mesh.noy-1) * E->mesh.noz
- + 2*E->mesh.noz;
- }
-
- E->mesh.nel = E->sphere.caps*E->mesh.elx*E->mesh.elz*E->mesh.ely;
-
- E->mesh.nnov = E->mesh.nno;
-
- /* this is a rough estimate for global neq, a more accurate neq will
- be computed later. */
- E->mesh.neq = E->mesh.nnov*E->mesh.nsd;
-
- E->mesh.npno = E->mesh.nel;
- E->mesh.nsf = E->mesh.nox*E->mesh.noy;
-
- for(i=E->mesh.levmax;i>=E->mesh.levmin;i--) {
- nox = E->mesh.mgunitx * (int) pow(2.0,(double)i)*E->parallel.nprocx + 1;
- noy = E->mesh.mgunity * (int) pow(2.0,(double)i)*E->parallel.nprocy + 1;
- noz = E->mesh.mgunitz * (int) pow(2.0,(double)i)*E->parallel.nprocz + 1;
-
- E->mesh.ELX[i] = nox-1;
- E->mesh.ELY[i] = noy-1;
- E->mesh.ELZ[i] = noz-1;
- if(E->sphere.caps == 1) {
- E->mesh.NNO[i] = nox * noz * noy;
- }
- else {
- E->mesh.NNO[i] = E->sphere.caps * (nox-1) * (noy-1) * noz + 2 * noz;
- }
- E->mesh.NEL[i] = E->sphere.caps * (nox-1) * (noz-1) * (noy-1);
- E->mesh.NPNO[i] = E->mesh.NEL[i] ;
- E->mesh.NOX[i] = nox;
- E->mesh.NOZ[i] = noz;
- E->mesh.NOY[i] = noy;
-
- E->mesh.NNOV[i] = E->mesh.NNO[i];
- E->mesh.NEQ[i] = E->mesh.nsd * E->mesh.NNOV[i] ;
-
- }
-
- /* Scaling from dimensionless units to Millions of years for input velocity
- and time, timdir is the direction of time for advection. CPC 6/25/00 */
-
- /* Myr */
- E->data.scalet = (E->data.radius_km*1e3*E->data.radius_km*1e3/E->data.therm_diff)/(1.e6*365.25*24*3600);
- /* cm/yr */
- E->data.scalev = (E->data.radius_km*1e3/E->data.therm_diff)/(100*365.25*24*3600);
- E->data.timedir = E->control.Atemp / fabs(E->control.Atemp);
-
-
- if(E->control.print_convergence && E->parallel.me==0) {
- fprintf(stderr,"Problem has %d x %d x %d nodes per cap, %d nodes and %d elements in total\n",
- E->mesh.nox, E->mesh.noz, E->mesh.noy, E->mesh.nno, E->mesh.nel);
- fprintf(E->fp,"Problem has %d x %d x %d nodes per cap, %d nodes and %d elements in total\n",
- E->mesh.nox, E->mesh.noz, E->mesh.noy, E->mesh.nno, E->mesh.nel);
- }
- return;
-}
-
-
-/* ===================================
- Functions which set up details
- common to all problems follow ...
- =================================== */
-
-void allocate_common_vars(E)
- struct All_variables *E;
-
-{
- void set_up_nonmg_aliases();
- int m,n,snel,nsf,elx,ely,nox,noy,noz,nno,nel,npno;
- int k,i,j,d,l,nno_l,npno_l,nozl,nnov_l,nxyz;
-
- m=0;
- n=1;
-
- for (j=1;j<=E->sphere.caps_per_proc;j++) {
-
- npno = E->lmesh.npno;
- nel = E->lmesh.nel;
- nno = E->lmesh.nno;
- nsf = E->lmesh.nsf;
- noz = E->lmesh.noz;
- nox = E->lmesh.nox;
- noy = E->lmesh.noy;
- elx = E->lmesh.elx;
- ely = E->lmesh.ely;
-
- E->P[j] = (double *) malloc((npno+1)*sizeof(double));
- E->T[j] = (double *) malloc((nno+1)*sizeof(double));
- E->NP[j] = (float *) malloc((nno+1)*sizeof(float));
- E->buoyancy[j] = (double *) malloc((nno+1)*sizeof(double));
-
- E->gstress[j] = (float *) malloc((6*nno+1)*sizeof(float));
- // TWB do we need this anymore XXX
- //E->stress[j] = (float *) malloc((12*nsf+1)*sizeof(float));
-
- for(i=1;i<=E->mesh.nsd;i++)
- E->sphere.cap[j].TB[i] = (float *) malloc((nno+1)*sizeof(float));
-
- E->slice.tpg[j] = (float *)malloc((nsf+2)*sizeof(float));
- E->slice.tpgb[j] = (float *)malloc((nsf+2)*sizeof(float));
- E->slice.divg[j] = (float *)malloc((nsf+2)*sizeof(float));
- E->slice.vort[j] = (float *)malloc((nsf+2)*sizeof(float));
- E->slice.shflux[j] = (float *)malloc((nsf+2)*sizeof(float));
- E->slice.bhflux[j] = (float *)malloc((nsf+2)*sizeof(float));
- /* if(E->mesh.topvbc==2 && E->control.pseudo_free_surf) */
- E->slice.freesurf[j] = (float *)malloc((nsf+2)*sizeof(float));
-
- E->mat[j] = (int *) malloc((nel+2)*sizeof(int));
- E->VIP[j] = (float *) malloc((nel+2)*sizeof(float));
-
- E->heating_adi[j] = (double *) malloc((nel+1)*sizeof(double));
- E->heating_visc[j] = (double *) malloc((nel+1)*sizeof(double));
- E->heating_latent[j] = (double *) malloc((nel+1)*sizeof(double));
-
- /* lump mass matrix for the energy eqn */
- E->TMass[j] = (double *) malloc((nno+1)*sizeof(double));
-
- /* nodal mass */
- E->NMass[j] = (double *) malloc((nno+1)*sizeof(double));
-
- nxyz = max(nox*noz,nox*noy);
- nxyz = 2*max(nxyz,noz*noy);
-
- E->sien[j] = (struct SIEN *) malloc((nxyz+2)*sizeof(struct SIEN));
- E->surf_element[j] = (int *) malloc((nxyz+2)*sizeof(int));
- E->surf_node[j] = (int *) malloc((nsf+2)*sizeof(int));
-
- } /* end for cap j */
-
- /* density field */
- E->rho = (double *) malloc((nno+1)*sizeof(double));
-
- /* horizontal average */
- E->Have.T = (float *)malloc((E->lmesh.noz+2)*sizeof(float));
- E->Have.V[1] = (float *)malloc((E->lmesh.noz+2)*sizeof(float));
- E->Have.V[2] = (float *)malloc((E->lmesh.noz+2)*sizeof(float));
-
- for(i=E->mesh.levmin;i<=E->mesh.levmax;i++) {
- E->sphere.R[i] = (double *) malloc((E->lmesh.NOZ[i]+1)*sizeof(double));
- for (j=1;j<=E->sphere.caps_per_proc;j++) {
- nno = E->lmesh.NNO[i];
- npno = E->lmesh.NPNO[i];
- nel = E->lmesh.NEL[i];
- nox = E->lmesh.NOX[i];
- noz = E->lmesh.NOZ[i];
- noy = E->lmesh.NOY[i];
- elx = E->lmesh.ELX[i];
- ely = E->lmesh.ELY[i];
- snel=E->lmesh.SNEL[i];
-
- for(d=1;d<=E->mesh.nsd;d++) {
- E->X[i][j][d] = (double *) malloc((nno+1)*sizeof(double));
- E->SX[i][j][d] = (double *) malloc((nno+1)*sizeof(double));
- }
-
- for(d=0;d<=3;d++)
- E->SinCos[i][j][d] = (double *) malloc((nno+1)*sizeof(double));
-
- E->IEN[i][j] = (struct IEN *) malloc((nel+2)*sizeof(struct IEN));
- E->EL[i][j] = (struct SUBEL *) malloc((nel+2)*sizeof(struct SUBEL));
- E->sphere.area1[i][j] = (double *) malloc((snel+1)*sizeof(double));
- for (k=1;k<=4;k++)
- E->sphere.angle1[i][j][k] = (double *) malloc((snel+1)*sizeof(double));
-
- E->GNX[i][j] = (struct Shape_function_dx *)malloc((nel+1)*sizeof(struct Shape_function_dx));
- E->GDA[i][j] = (struct Shape_function_dA *)malloc((nel+1)*sizeof(struct Shape_function_dA));
-
- E->MASS[i][j] = (double *) malloc((nno+1)*sizeof(double));
- E->ECO[i][j] = (struct COORD *) malloc((nno+2)*sizeof(struct COORD));
-
- E->TWW[i][j] = (struct FNODE *) malloc((nel+2)*sizeof(struct FNODE));
-
- for(d=1;d<=E->mesh.nsd;d++)
- for(l=1;l<=E->lmesh.NNO[i];l++) {
- E->SX[i][j][d][l] = 0.0;
- E->X[i][j][d][l] = 0.0;
- }
-
- }
- }
-
- for(i=0;i<=E->output.llmax;i++)
- E->sphere.hindex[i] = (int *) malloc((E->output.llmax+3)
- *sizeof(int));
-
-
- for(i=E->mesh.gridmin;i<=E->mesh.gridmax;i++)
- for (j=1;j<=E->sphere.caps_per_proc;j++) {
-
- nno = E->lmesh.NNO[i];
- npno = E->lmesh.NPNO[i];
- nel = E->lmesh.NEL[i];
- nox = E->lmesh.NOX[i];
- noz = E->lmesh.NOZ[i];
- noy = E->lmesh.NOY[i];
- elx = E->lmesh.ELX[i];
- ely = E->lmesh.ELY[i];
-
- nxyz = elx*ely;
- E->CC[i][j] =(struct CC *) malloc((1)*sizeof(struct CC));
- E->CCX[i][j]=(struct CCX *) malloc((1)*sizeof(struct CCX));
-
- E->elt_del[i][j] = (struct EG *) malloc((nel+1)*sizeof(struct EG));
-
- if(E->control.inv_gruneisen != 0)
- E->elt_c[i][j] = (struct EC *) malloc((nel+1)*sizeof(struct EC));
-
- E->EVI[i][j] = (float *) malloc((nel+1)*vpoints[E->mesh.nsd]*sizeof(float));
- E->BPI[i][j] = (double *) malloc((npno+1)*sizeof(double));
-
- E->ID[i][j] = (struct ID *) malloc((nno+1)*sizeof(struct ID));
- E->VI[i][j] = (float *) malloc((nno+1)*sizeof(float));
- E->NODE[i][j] = (unsigned int *)malloc((nno+1)*sizeof(unsigned int));
-
- nxyz = max(nox*noz,nox*noy);
- nxyz = 2*max(nxyz,noz*noy);
- nozl = max(noy,nox*2);
-
-
-
- E->parallel.EXCHANGE_sNODE[i][j] = (struct PASS *) malloc((nozl+2)*sizeof(struct PASS));
- E->parallel.NODE[i][j] = (struct BOUND *) malloc((nxyz+2)*sizeof(struct BOUND));
- E->parallel.EXCHANGE_NODE[i][j]= (struct PASS *) malloc((nxyz+2)*sizeof(struct PASS));
- E->parallel.EXCHANGE_ID[i][j] = (struct PASS *) malloc((nxyz*E->mesh.nsd+3)*sizeof(struct PASS));
-
- for(l=1;l<=E->lmesh.NNO[i];l++) {
- E->NODE[i][j][l] = (INTX | INTY | INTZ); /* and any others ... */
- E->VI[i][j][l] = 1.0;
- }
-
-
- } /* end for cap and i & j */
-
-
- for (j=1;j<=E->sphere.caps_per_proc;j++) {
-
- for(k=1;k<=E->mesh.nsd;k++)
- for(i=1;i<=E->lmesh.nno;i++)
- E->sphere.cap[j].TB[k][i] = 0.0;
-
- for(i=1;i<=E->lmesh.nno;i++)
- E->T[j][i] = 0.0;
-
- for(i=1;i<=E->lmesh.nel;i++) {
- E->mat[j][i]=1;
- E->VIP[j][i]=1.0;
-
- E->heating_adi[j][i] = 0;
- E->heating_visc[j][i] = 0;
- E->heating_latent[j][i] = 1.0;
- }
-
- for(i=1;i<=E->lmesh.npno;i++)
- E->P[j][i] = 0.0;
-
- mat_prop_allocate(E);
- phase_change_allocate(E);
- set_up_nonmg_aliases(E,j);
-
- } /* end for cap j */
-
- if (strcmp(E->output.format, "hdf5") == 0)
- h5output_allocate_memory(E);
-
- return;
- }
-
-/* ========================================================= */
-
-void allocate_velocity_vars(E)
- struct All_variables *E;
-
-{
- int m,n,i,j,k,l;
-
- E->monitor.incompressibility = 0;
- E->monitor.fdotf = 0;
- E->monitor.vdotv = 0;
- E->monitor.pdotp = 0;
-
- m=0;
- n=1;
- for (j=1;j<=E->sphere.caps_per_proc;j++) {
- E->lmesh.nnov = E->lmesh.nno;
- E->lmesh.neq = E->lmesh.nnov * E->mesh.nsd;
-
- E->temp[j] = (double *) malloc((E->lmesh.neq+1)*sizeof(double));
- E->temp1[j] = (double *) malloc(E->lmesh.neq*sizeof(double));
- E->F[j] = (double *) malloc(E->lmesh.neq*sizeof(double));
- E->U[j] = (double *) malloc((E->lmesh.neq+1)*sizeof(double));
- E->u1[j] = (double *) malloc((E->lmesh.neq+1)*sizeof(double));
-
-
- for(i=1;i<=E->mesh.nsd;i++) {
- E->sphere.cap[j].V[i] = (float *) malloc((E->lmesh.nnov+1)*sizeof(float));
- E->sphere.cap[j].VB[i] = (float *)malloc((E->lmesh.nnov+1)*sizeof(float));
- E->sphere.cap[j].Vprev[i] = (float *) malloc((E->lmesh.nnov+1)*sizeof(float));
- }
-
- for(i=0;i<E->lmesh.neq;i++)
- E->U[j][i] = E->temp[j][i] = E->temp1[j][i] = 0.0;
-
-
- for(k=1;k<=E->mesh.nsd;k++)
- for(i=1;i<=E->lmesh.nnov;i++)
- E->sphere.cap[j].VB[k][i] = 0.0;
-
- } /* end for cap j */
-
- for(l=E->mesh.gridmin;l<=E->mesh.gridmax;l++)
- for (j=1;j<=E->sphere.caps_per_proc;j++) {
- E->lmesh.NEQ[l] = E->lmesh.NNOV[l] * E->mesh.nsd;
-
- E->BI[l][j] = (double *) malloc((E->lmesh.NEQ[l])*sizeof(double));
- k = (E->lmesh.NOX[l]*E->lmesh.NOZ[l]+E->lmesh.NOX[l]*E->lmesh.NOY[l]+
- E->lmesh.NOY[l]*E->lmesh.NOZ[l])*6;
- E->zero_resid[l][j] = (int *) malloc((k+2)*sizeof(int));
- E->parallel.Skip_id[l][j] = (int *) malloc((k+2)*sizeof(int));
-
- for(i=0;i<E->lmesh.NEQ[l];i++) {
- E->BI[l][j][i]=0.0;
- }
-
- } /* end for j & l */
-
- return;
- }
-
-
-/* ========================================================= */
-
-void global_default_values(E)
- struct All_variables *E;
-{
-
- /* FIRST: values which are not changed routinely by the user */
-
- E->control.v_steps_low = 10;
- E->control.v_steps_upper = 1;
- E->control.accuracy = 1.0e-4;
- E->control.verbose=0; /* debugging/profiles */
-
- /* SECOND: values for which an obvious default setting is useful */
-
- E->control.stokes=0;
- E->control.restart=0;
- E->control.CONVECTION = 0;
- E->control.CART2D = 0;
- E->control.CART3D = 0;
- E->control.CART2pt5D = 0;
- E->control.AXI = 0;
- E->control.CONJ_GRAD = 0;
- E->control.NMULTIGRID = 0;
- E->control.EMULTIGRID = 0;
- E->control.augmented_Lagr = 0;
- E->control.augmented = 0.0;
-
- E->control.GRID_TYPE=1;
-
- E->trace.fpt = NULL;
- E->control.tracer = 0;
- E->composition.on = 0;
-
- E->parallel.nprocx=1; E->parallel.nprocz=1; E->parallel.nprocy=1;
-
- E->mesh.levmax=0;
- E->mesh.levmin=0;
- E->mesh.gridmax=0;
- E->mesh.gridmin=0;
- E->mesh.noz = 1; E->mesh.nzs = 1; E->lmesh.noz = 1; E->lmesh.nzs = 1;
- E->mesh.noy = 1; E->mesh.nys = 1; E->lmesh.noy = 1; E->lmesh.nys = 1;
- E->mesh.nox = 1; E->mesh.nxs = 1; E->lmesh.nox = 1; E->lmesh.nxs = 1;
-
- E->sphere.ro = 1.0;
- E->sphere.ri = 0.5;
-
- E->control.precondition = 0; /* for larger visc contrasts turn this back on */
-
- E->mesh.toptbc = 1; /* fixed t */
- E->mesh.bottbc = 1;
- E->mesh.topvbc = 0; /* stress */
- E->mesh.botvbc = 0;
- E->control.VBXtopval=0.0;
- E->control.VBYtopval=0.0;
- E->control.VBXbotval=0.0;
- E->control.VBYbotval=0.0;
-
- E->data.radius_km = 6370.0; /* Earth, whole mantle defaults */
- E->data.grav_acc = 9.81;
- E->data.therm_diff = 1.0e-6;
- E->data.therm_exp = 3.e-5;
- E->data.density = 3300.0;
- E->data.ref_viscosity=1.e21;
- E->data.density_above = 1000.0; /* sea water */
- E->data.density_below = 6600.0; /* sea water */
-
- E->data.Cp = 1200.0;
- E->data.therm_cond = 3.168;
- E->data.res_density = 3300.0; /* density when X = ... */
- E->data.res_density_X = 0.3;
- E->data.melt_density = 2800.0;
- E->data.permeability = 3.0e-10;
- E->data.gas_const = 8.3;
- E->data.surf_heat_flux = 4.4e-2;
-
- E->data.grav_const = 6.6742e-11;
-
- E->data.youngs_mod = 1.0e11;
- E->data.Te = 0.0;
- E->data.T_sol0 = 1373.0; /* Dave's values 1991 (for the earth) */
- E->data.Tsurf = 273.0;
- E->data.dTsol_dz = 3.4e-3 ;
- E->data.dTsol_dF = 440.0;
- E->data.dT_dz = 0.48e-3;
- E->data.delta_S = 250.0;
- E->data.ref_temperature = 2 * 1350.0; /* fixed temperature ... delta T */
-
- /* THIRD: you forgot and then went home, let's see if we can help out */
-
- sprintf(E->control.data_prefix,"citcom.tmp.%d",getpid());
-
- E->control.NASSEMBLE = 0;
-
- E->monitor.elapsed_time=0.0;
-
- E->control.record_all_until = 10000000;
-
- return; }
-
-
-/* =============================================================
- ============================================================= */
-
-void check_bc_consistency(E)
- struct All_variables *E;
-
-{ int i,j,lev;
-
- for (j=1;j<=E->sphere.caps_per_proc;j++) {
- for(i=1;i<=E->lmesh.nno;i++) {
- if ((E->node[j][i] & VBX) && (E->node[j][i] & SBX))
- printf("Inconsistent x velocity bc at %d\n",i);
- if ((E->node[j][i] & VBZ) && (E->node[j][i] & SBZ))
- printf("Inconsistent z velocity bc at %d\n",i);
- if ((E->node[j][i] & VBY) && (E->node[j][i] & SBY))
- printf("Inconsistent y velocity bc at %d\n",i);
- if ((E->node[j][i] & TBX) && (E->node[j][i] & FBX))
- printf("Inconsistent x temperature bc at %d\n",i);
- if ((E->node[j][i] & TBZ) && (E->node[j][i] & FBZ))
- printf("Inconsistent z temperature bc at %d\n",i);
- if ((E->node[j][i] & TBY) && (E->node[j][i] & FBY))
- printf("Inconsistent y temperature bc at %d\n",i);
- }
- } /* end for j */
-
- for(lev=E->mesh.gridmin;lev<=E->mesh.gridmax;lev++)
- for (j=1;j<=E->sphere.caps_per_proc;j++) {
- for(i=1;i<=E->lmesh.NNO[lev];i++) {
- if ((E->NODE[lev][j][i] & VBX) && (E->NODE[lev][j][i] & SBX))
- printf("Inconsistent x velocity bc at %d,%d\n",lev,i);
- if ((E->NODE[lev][j][i] & VBZ) && (E->NODE[lev][j][i] & SBZ))
- printf("Inconsistent z velocity bc at %d,%d\n",lev,i);
- if ((E->NODE[lev][j][i] & VBY) && (E->NODE[lev][j][i] & SBY))
- printf("Inconsistent y velocity bc at %d,%d\n",lev,i);
- /* Tbc's not applicable below top level */
- }
-
- } /* end for j and lev */
-
- return;
-
-}
-
-void set_up_nonmg_aliases(E,j)
- struct All_variables *E;
- int j;
-
-{ /* Aliases for functions only interested in the highest mg level */
-
- int i;
-
- E->eco[j] = E->ECO[E->mesh.levmax][j];
- E->ien[j] = E->IEN[E->mesh.levmax][j];
- E->id[j] = E->ID[E->mesh.levmax][j];
- E->Vi[j] = E->VI[E->mesh.levmax][j];
- E->EVi[j] = E->EVI[E->mesh.levmax][j];
- E->node[j] = E->NODE[E->mesh.levmax][j];
- E->cc[j] = E->CC[E->mesh.levmax][j];
- E->ccx[j] = E->CCX[E->mesh.levmax][j];
- E->Mass[j] = E->MASS[E->mesh.levmax][j];
- E->gDA[j] = E->GDA[E->mesh.levmax][j];
- E->gNX[j] = E->GNX[E->mesh.levmax][j];
-
- for (i=1;i<=E->mesh.nsd;i++) {
- E->x[j][i] = E->X[E->mesh.levmax][j][i];
- E->sx[j][i] = E->SX[E->mesh.levmax][j][i];
- }
-
- return; }
-
-void report(E,string)
- struct All_variables *E;
- char * string;
-{ if(E->control.verbose && E->parallel.me==0)
- { fprintf(stderr,"%s\n",string);
- fflush(stderr);
- }
- return;
-}
-
-void record(E,string)
- struct All_variables *E;
- char * string;
-{ if(E->control.verbose)
- { fprintf(E->fp,"%s\n",string);
- fflush(E->fp);
- }
-
- return;
-}
-
-
-
-/* =============================================================
- Initialize values which are not problem dependent.
- NOTE: viscosity may be a function of all previous
- input fields (temperature, pressure, velocity, chemistry) and
- so is always to be done last.
- ============================================================= */
-
-
-/* This function is replaced by CitcomS.Components.IC.launch()*/
-void common_initial_fields(E)
- struct All_variables *E;
-{
- void initial_pressure();
- void initial_velocity();
- /*void read_viscosity_option();*/
- void initial_viscosity();
-
- report(E,"Initialize pressure field");
- initial_pressure(E);
- report(E,"Initialize velocity field");
- initial_velocity(E);
- report(E,"Initialize viscosity field");
- /*get_viscosity_option(E);*/
- initial_viscosity(E);
-
- return;
-
-}
-
-/* ========================================== */
-
-void initial_pressure(E)
- struct All_variables *E;
-{
- int i,m;
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=1;i<=E->lmesh.npno;i++)
- E->P[m][i]=0.0;
-
- return;
-}
-
-void initial_velocity(E)
- struct All_variables *E;
-{
- int i,m;
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=1;i<=E->lmesh.nnov;i++) {
- E->sphere.cap[m].V[1][i]=0.0;
- E->sphere.cap[m].V[2][i]=0.0;
- E->sphere.cap[m].V[3][i]=0.0;
- }
-
- return;
-}
-
-
-
-static void open_log(struct All_variables *E)
-{
- char logfile[255];
-
- E->fp = NULL;
- if (strcmp(E->output.format, "ascii-gz") == 0)
- sprintf(logfile,"%s/log", E->control.data_dir);
- else
- sprintf(logfile,"%s.log", E->control.data_file);
-
- if (E->control.restart || E->control.post_p)
- /* append the log file if restart */
- E->fp = output_open(logfile, "a");
- else
- E->fp = output_open(logfile, "w");
-
- return;
-}
-
-
-static void open_time(struct All_variables *E)
-{
- char timeoutput[255];
-
- E->fptime = NULL;
- if (E->parallel.me == 0) {
- if (strcmp(E->output.format, "ascii-gz") == 0)
- sprintf(timeoutput,"%s/time", E->control.data_dir);
- else
- sprintf(timeoutput,"%s.time", E->control.data_file);
-
- if (E->control.restart || E->control.post_p)
- /* append the time file if restart */
- E->fptime = output_open(timeoutput, "a");
- else
- E->fptime = output_open(timeoutput, "w");
- }
-
- return;
-}
-
-
-static void open_info(struct All_variables *E)
-{
- char output_file[255];
-
- E->fp_out = NULL;
- if (E->control.verbose) {
- if (strcmp(E->output.format, "ascii-gz") == 0)
- sprintf(output_file,"%s/info.%d", E->control.data_dir, E->parallel.me);
- else
- sprintf(output_file,"%s.info.%d", E->control.data_file, E->parallel.me);
- E->fp_out = output_open(output_file, "w");
- }
-
- return;
-}
-
-void open_qfiles(struct All_variables *E) /* additional heat
- flux output */
-{
- char output_file[255];
-
- /* only one CPU will write to those */
- if((E->parallel.me_loc[3] == E->parallel.nprocz-1) &&
- (E->parallel.me==E->parallel.nprocz-1)){
- /* top heat flux and other stat quantities */
- if (strcmp(E->output.format, "ascii-gz") == 0)
- sprintf(output_file,"%s/qt.dat", E->control.data_dir);
- else
- sprintf(output_file,"%s.qt.dat", E->control.data_file);
- if(E->control.restart)
- E->output.fpqt = output_open(output_file, "a"); /* append for restart */
- else
- E->output.fpqt = output_open(output_file, "w");
- }else{
- E->output.fpqt = NULL;
- }
- if (E->parallel.me_loc[3] == 0) {
- /* bottom heat flux and other stat quantities */
- if (strcmp(E->output.format, "ascii-gz") == 0)
- sprintf(output_file,"%s/qb.dat", E->control.data_dir);
- else
- sprintf(output_file,"%s.qb.dat", E->control.data_file);
- if(E->control.restart)
- E->output.fpqb = output_open(output_file, "a"); /* append */
- else
- E->output.fpqb = output_open(output_file, "w");
- }else{
- E->output.fpqb = NULL;
- }
-
-
- return;
-}
-
-
-static void output_parse_optional(struct All_variables *E)
-{
- char* strip(char*);
-
- int pos, len;
- char *prev, *next;
-
- len = strlen(E->output.optional);
- /* fprintf(stderr, "### length of optional is %d\n", len); */
- pos = 0;
- next = E->output.optional;
-
- E->output.connectivity = 0;
- E->output.stress = 0;
- E->output.pressure = 0;
- E->output.surf = 0;
- E->output.botm = 0;
- E->output.geoid = 0;
- E->output.horiz_avg = 0;
- E->output.tracer = 0;
- E->output.comp_el = 0;
- E->output.comp_nd = 0;
- E->output.heating = 0;
-
- while(1) {
- /* get next field */
- prev = strsep(&next, ",");
-
- /* break if no more field */
- if(prev == NULL) break;
-
- /* skip if empty */
- if(prev[0] == '\0') continue;
-
- /* strip off leading and trailing whitespaces */
- prev = strip(prev);
-
- /* skip empty field */
- if (strlen(prev) == 0) continue;
-
- /* fprintf(stderr, "### %s: %s\n", prev, next); */
- if(strcmp(prev, "connectivity")==0)
- E->output.connectivity = 1;
- else if(strcmp(prev, "stress")==0)
- E->output.stress = 1;
- else if(strcmp(prev, "pressure")==0)
- E->output.pressure = 1;
- else if(strcmp(prev, "surf")==0)
- E->output.surf = 1;
- else if(strcmp(prev, "botm")==0)
- E->output.botm = 1;
- else if(strcmp(prev, "geoid")==0)
- if (E->parallel.nprocxy != 12) {
- fprintf(stderr, "Warning: geoid calculation only works in full version. Disabled\n");
- }
- else {
- /* geoid calculation requires surface and CMB topo */
- /* make sure the topos are available! */
- E->output.geoid = 1;
- }
- else if(strcmp(prev, "horiz_avg")==0)
- E->output.horiz_avg = 1;
- else if(strcmp(prev, "tracer")==0)
- E->output.tracer = 1;
- else if(strcmp(prev, "comp_el")==0)
- E->output.comp_el = 1;
- else if(strcmp(prev, "comp_nd")==0)
- E->output.comp_nd = 1;
- else if(strcmp(prev, "heating")==0)
- E->output.heating = 1;
- else
- if(E->parallel.me == 0)
- fprintf(stderr, "Warning: unknown field for output_optional: %s\n", prev);
-
- }
-
- return;
-}
-
-/* check whether E->control.data_file contains a path seperator */
-static void chk_prefix(struct All_variables *E)
-{
- char *found;
-
- found = strchr(E->control.data_prefix, '/');
- if (found) {
- fprintf(stderr, "error in input parameter: datafile='%s' contains '/'\n", E->control.data_file);
- parallel_process_termination();
- }
-
- if (E->control.restart || E->control.post_p ||
- (E->convection.tic_method == -1) ||
- (E->control.tracer && (E->trace.ic_method == 2))) {
- found = strchr(E->control.data_prefix_old, '/');
- if (found) {
- fprintf(stderr, "error in input parameter: datafile_old='%s' contains '/'\n", E->control.data_file);
- parallel_process_termination();
- }
- }
-}
-
-
-/* search src and substitue the 1st occurance of target by value */
-static void expand_str(char *src, size_t max_size,
- const char *target, const char *value)
-{
- char *pos, *end, *new_end;
- size_t end_len, value_len;
-
- /* is target a substring of src? */
- pos = strstr(src, target);
- if (pos != NULL) {
- value_len = strlen(value);
-
- /* the end part of the original string... */
- end = pos + strlen(target);
- /* ...and where it is going */
- new_end = pos + value_len;
- end_len = strlen(end);
- if (new_end + end_len >= src + max_size) {
- /* too long */
- return;
- }
-
- /* move the end part of the original string */
- memmove(new_end, end, end_len + 1); /* incl. null byte */
-
- /* insert the value */
- memcpy(pos, value, value_len);
- }
-}
-
-static void expand_datadir(struct All_variables *E, char *datadir)
-{
- char *found, *err;
- char tmp[150];
- int diff;
- FILE *pipe;
- const char str1[] = "%HOSTNAME";
- const char str2[] = "%RANK";
- const char str3[] = "%DATADIR";
- const char str3_prog[] = "citcoms_datadir";
-
- /* expand str1 by machine's hostname */
- found = strstr(datadir, str1);
- if (found) {
- gethostname(tmp, 100);
- expand_str(datadir, 150, str1, tmp);
- }
-
- /* expand str2 by MPI rank */
- found = strstr(datadir, str2);
- if (found) {
- sprintf(tmp, "%d", E->parallel.me);
- expand_str(datadir, 150, str2, tmp);
- }
-
- /* expand str3 by the result of the external program */
- diff = strcmp(datadir, str3);
- if (!diff) {
- pipe = popen(str3_prog, "r");
- err = fgets(tmp, 150, pipe);
- pclose(stdout);
- if (err != NULL)
- sscanf(tmp, " %s", datadir);
- else {
- fprintf(stderr, "Cannot get datadir from command '%s'\n", str3_prog);
- parallel_process_termination();
- }
- }
-}
-
-
-void mkdatadir(const char *dir)
-{
- int err;
-
- err = mkdir(dir, 0755);
- if (err && errno != EEXIST) {
- /* if error occured and the directory is not exisitng */
- fprintf(stderr, "Cannot make new directory '%s'\n", dir);
- parallel_process_termination();
- }
-}
-
-
-void output_init(struct All_variables *E)
-{
- chk_prefix(E);
- expand_datadir(E, E->control.data_dir);
- mkdatadir(E->control.data_dir);
- snprintf(E->control.data_file, 200, "%s/%s", E->control.data_dir,
- E->control.data_prefix);
-
- if (E->control.restart || E->control.post_p ||
- (E->convection.tic_method == -1) ||
- (E->control.tracer && (E->trace.ic_method == 2))) {
- expand_datadir(E, E->control.data_dir_old);
- snprintf(E->control.old_P_file, 200, "%s/%s", E->control.data_dir_old,
- E->control.data_prefix_old);
- }
-
- open_log(E);
- open_time(E);
- open_info(E);
-
- if (strcmp(E->output.format, "ascii") == 0) {
- E->problem_output = output;
- }
- else if (strcmp(E->output.format, "hdf5") == 0)
- E->problem_output = h5output;
- else if (strcmp(E->output.format, "vtk") == 0)
- E->problem_output = vtk_output;
-#ifdef USE_GZDIR
- else if (strcmp(E->output.format, "ascii-gz") == 0)
- E->problem_output = gzdir_output;
- else {
- /* indicate error here */
- if (E->parallel.me == 0) {
- fprintf(stderr, "wrong output_format, must be 'ascii', 'hdf5', 'ascii-gz' or 'vtk'\n");
- fprintf(E->fp, "wrong output_format, must be 'ascii', 'hdf5' 'ascii-gz', or 'vtk'\n");
- }
- parallel_process_termination(E);
- }
-#else
- else {
- /* indicate error here */
- if (E->parallel.me == 0) {
- fprintf(stderr, "wrong output_format, must be 'ascii', 'hdf5', or 'vtk' (USE_GZDIR undefined)\n");
- fprintf(E->fp, "wrong output_format, must be 'ascii', 'hdf5', or 'vtk' (USE_GZDIR undefined)\n");
- }
- parallel_process_termination(E);
- }
-#endif
-
- output_parse_optional(E);
-}
-
-
-
-void output_finalize(struct All_variables *E)
-{
- char message[255],files[255];
- if (E->fp)
- fclose(E->fp);
-
- if (E->fptime)
- fclose(E->fptime);
-
- if (E->fp_out)
- fclose(E->fp_out);
-
- if (E->trace.fpt)
- fclose(E->trace.fpt);
-
- if(E->output.fpqt)
- fclose(E->output.fpqt);
- if(E->output.fpqb)
- fclose(E->output.fpqb);
-
-
-#ifdef USE_GZDIR
- /*
- remove VTK geo file in case we used that for IO
- */
- if((E->output.gzdir.vtk_io != 0) &&
- (strcmp(E->output.format, "ascii-gz") == 0)){
- if((E->output.gzdir.vtk_io == 3)||(E->parallel.me == 0)){
- /* delete the geo files */
- get_vtk_filename(files,1,E,0);
- remove(files);
- if(E->parallel.me == 0){
- /* close the log */
- fclose(E->output.gzdir.vtk_fp);
- }
- }
- }
-#endif
-}
-
-
-char* strip(char *input)
-{
- int end;
- char *str;
- end = strlen(input) - 1;
- str = input;
-
- /* trim trailing whitespace */
- while (isspace(str[end]))
- end--;
-
- str[++end] = 0;
-
- /* trim leading whitespace */
- while(isspace(*str))
- str++;
-
- return str;
-}
-
-
Copied: mc/3D/CitcomS/branches/cxx/lib/Instructions.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Instructions.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Instructions.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Instructions.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,1751 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+/* Set up the finite element problem to suit: returns with all memory */
+/* allocated, temperature, viscosity, node locations and how to use */
+/* them all established. 8.29.92 or 29.8.92 depending on your nationality*/
+
+#include <math.h>
+#include <string.h>
+#include <stdlib.h>
+#include <stddef.h>
+#include <sys/stat.h>
+#include <sys/errno.h>
+#include <unistd.h>
+#include <ctype.h>
+#include "element_definitions.h"
+#include "global_defs.h"
+
+#include "citcom_init.h"
+#include "initial_temperature.h"
+#include "lith_age.h"
+#include "material_properties.h"
+#include "output.h"
+#include "output_h5.h"
+#include "parallel_related.h"
+#include "parsing.h"
+#include "phase_change.h"
+#include "interuption.h"
+
+#include "cproto.h"
+
+void allocate_common_vars(struct All_variables*);
+void allocate_velocity_vars(struct All_variables*);
+void check_bc_consistency(struct All_variables*);
+void construct_elt_gs(struct All_variables*);
+void construct_elt_cs(struct All_variables*);
+void construct_shape_function_derivatives(struct All_variables *E);
+void construct_id(struct All_variables*);
+void construct_ien(struct All_variables*);
+void construct_lm(struct All_variables*);
+void construct_masks(struct All_variables*);
+void construct_shape_functions(struct All_variables*);
+void construct_sub_element(struct All_variables*);
+void construct_surf_det (struct All_variables*);
+void construct_bdry_det (struct All_variables*);
+void construct_surface (struct All_variables*);
+void get_initial_elapsed_time(struct All_variables*);
+void lith_age_init(struct All_variables *E);
+void mass_matrix(struct All_variables*);
+void output_init(struct All_variables*);
+void set_elapsed_time(struct All_variables*);
+void set_sphere_harmonics (struct All_variables*);
+void set_starting_age(struct All_variables*);
+void tracer_initial_settings(struct All_variables*);
+void tracer_input(struct All_variables*);
+void viscosity_input(struct All_variables*);
+void vtk_output(struct All_variables*, int);
+void get_vtk_filename(char *,int,struct All_variables *,int);
+void myerror(struct All_variables *,char *);
+void open_qfiles(struct All_variables *) ;
+void read_rayleigh_from_file(struct All_variables *);
+void read_initial_settings(struct All_variables *);
+void check_settings_consistency(struct All_variables *);
+void global_derived_values(struct All_variables *);
+
+
+void initial_mesh_solver_setup(struct All_variables *E)
+{
+ int chatty;
+ //chatty = ((E->parallel.me == 0)&&(E->control.verbose))?(1):(0);
+ chatty = E->parallel.me == 0;
+
+ E->monitor.cpu_time_at_last_cycle =
+ E->monitor.cpu_time_at_start = CPU_time0();
+
+ output_init(E);
+ (E->problem_derived_values)(E); /* call this before global_derived_ */
+ global_derived_values(E);
+
+ (E->solver.parallel_processor_setup)(E); /* get # of proc in x,y,z */
+ (E->solver.parallel_domain_decomp0)(E); /* get local nel, nno, elx, nox et al */
+
+ allocate_common_vars(E);
+ (E->problem_allocate_vars)(E);
+ (E->solver_allocate_vars)(E);
+ if(chatty)fprintf(stderr,"memory allocation done\n");
+ /* logical domain */
+ construct_ien(E);
+ construct_surface(E);
+ (E->solver.construct_boundary)(E);
+ (E->solver.parallel_domain_boundary_nodes)(E);
+ if(chatty)fprintf(stderr,"parallel setup done\n");
+
+ /* physical domain */
+ (E->solver.node_locations)(E);
+ if(chatty)fprintf(stderr,"node locations done\n");
+
+ allocate_velocity_vars(E);
+ if(chatty)fprintf(stderr,"velocity vars done\n");
+
+
+ get_initial_elapsed_time(E); /* Set elapsed time */
+ set_starting_age(E); /* set the starting age to elapsed time, if desired */
+ set_elapsed_time(E); /* reset to elapsed time to zero, if desired */
+
+
+ /* open the heatflow files here because we need to know about loc_me */
+ if(E->output.write_q_files)
+ open_qfiles(E);
+ else{
+ E->output.fpqt = E->output.fpqb = NULL;
+ }
+
+
+
+ if(E->control.lith_age)
+ lith_age_init(E);
+
+ (E->problem_boundary_conds)(E);
+
+ check_bc_consistency(E);
+ if(chatty)fprintf(stderr,"boundary conditions done\n");
+
+ construct_masks(E); /* order is important here */
+ construct_id(E);
+ construct_lm(E);
+ if(chatty)fprintf(stderr,"id/lm done\n");
+
+ (E->solver.parallel_communication_routs_v)(E);
+ if(chatty)fprintf(stderr,"v communications done\n");
+
+ if(E->control.use_cbf_topo){
+ (E->solver.parallel_communication_routs_s)(E);
+ if(chatty)fprintf(stderr,"s communications done\n");
+ }
+ reference_state(E);
+
+ construct_sub_element(E);
+ construct_shape_functions(E);
+ construct_shape_function_derivatives(E);
+ construct_elt_gs(E);
+ if(E->control.inv_gruneisen != 0)
+ construct_elt_cs(E);
+
+ /* this matrix results from spherical geometry */
+ /* construct_c3x3matrix(E); */
+
+ mass_matrix(E);
+
+ construct_surf_det (E);
+ construct_bdry_det (E);
+
+ if(chatty)fprintf(stderr,"mass matrix, dets done\n");
+
+ set_sphere_harmonics (E);
+
+
+ if(E->control.tracer) {
+ tracer_initial_settings(E);
+ (E->problem_tracer_setup)(E);
+ }
+ if(chatty)fprintf(stderr,"initial_mesh_solver_setup done\n");
+}
+
+
+void read_instructions(struct All_variables *E, char *filename)
+{
+ /* =====================================================
+ Global interuption handling routine defined once here
+ ===================================================== */
+
+ set_signal();
+
+ /* ==================================================
+ Initialize from the command line
+ from startup files. (See Parsing.c).
+ ================================================== */
+
+ setup_parser(E,filename);
+
+ global_default_values(E);
+ read_initial_settings(E);
+ shutdown_parser(E);
+
+ return;
+}
+
+
+/* This function is replaced by CitcomS.Solver._setup() */
+void initial_setup(struct All_variables *E)
+{
+ initial_mesh_solver_setup(E);
+
+ general_stokes_solver_setup(E);
+
+#ifdef USE_GGRD
+ /* updating local rayleigh number (based on Netcdf grds, the
+ rayleigh number may be modified laterally in the surface
+ layers) */
+ /* no counterpart in pyre */
+ if(E->control.ggrd.ray_control)
+ read_rayleigh_from_file(E);
+#endif
+
+ (E->next_buoyancy_field_init)(E);
+ if (E->parallel.me==0) fprintf(stderr,"time=%f\n",
+ CPU_time0()-E->monitor.cpu_time_at_start);
+
+ return;
+}
+
+
+void initialize_material(struct All_variables *E)
+{
+ if(E->control.mat_control)
+ read_mat_from_file(E);
+ else
+ construct_mat_group(E);
+}
+
+
+/* This function is replaced by CitcomS.Components.IC.launch()*/
+void initial_conditions(struct All_variables *E)
+{
+ initialize_material(E);
+
+ if (E->control.tracer==1) {
+ initialize_tracers(E);
+
+ if (E->composition.on)
+ init_composition(E);
+ }
+
+ (E->problem_initial_fields)(E); /* temperature/chemistry/melting etc */
+ common_initial_fields(E); /* velocity/pressure/viscosity (viscosity must be done LAST) */
+
+ return;
+}
+
+
+void read_initial_settings(struct All_variables *E)
+{
+ float tmp;
+ double ell_tmp;
+ int m=E->parallel.me;
+ double levmax;
+
+ /* first the problem type (defines subsequent behaviour) */
+
+ input_string("Problem",E->control.PROBLEM_TYPE,"convection",m);
+ if ( strcmp(E->control.PROBLEM_TYPE,"convection") == 0) {
+ E->control.CONVECTION = 1;
+ set_convection_defaults(E);
+ }
+
+ else if ( strcmp(E->control.PROBLEM_TYPE,"convection-chemical") == 0) {
+ E->control.CONVECTION = 1;
+ set_convection_defaults(E);
+ }
+
+ else {
+ fprintf(E->fp,"Unable to determine problem type, assuming convection ... \n");
+ E->control.CONVECTION = 1;
+ set_convection_defaults(E);
+ }
+
+ input_string("Geometry",E->control.GEOMETRY,"sphere",m);
+ if ( strcmp(E->control.GEOMETRY,"cart2d") == 0)
+ { E->control.CART2D = 1;
+ (E->solver.set_2dc_defaults)(E);}
+ else if ( strcmp(E->control.GEOMETRY,"axi") == 0)
+ { E->control.AXI = 1;
+ }
+ else if ( strcmp(E->control.GEOMETRY,"cart2pt5d") == 0)
+ { E->control.CART2pt5D = 1;
+ (E->solver.set_2pt5dc_defaults)(E);}
+ else if ( strcmp(E->control.GEOMETRY,"cart3d") == 0)
+ { E->control.CART3D = 1;
+ (E->solver.set_3dc_defaults)(E);}
+ else if ( strcmp(E->control.GEOMETRY,"sphere") == 0)
+ {
+ (E->solver.set_3dsphere_defaults)(E);}
+ else
+ { fprintf(E->fp,"Unable to determine geometry, assuming cartesian 2d ... \n");
+ E->control.CART2D = 1;
+ (E->solver.set_2dc_defaults)(E); }
+
+ input_string("Solver",E->control.SOLVER_TYPE,"cgrad",m);
+ if ( strcmp(E->control.SOLVER_TYPE,"cgrad") == 0)
+ { E->control.CONJ_GRAD = 1;
+ set_cg_defaults(E);}
+ else if ( strcmp(E->control.SOLVER_TYPE,"multigrid") == 0)
+ { E->control.NMULTIGRID = 1;
+ set_mg_defaults(E);}
+ else if ( strcmp(E->control.SOLVER_TYPE,"multigrid-el") == 0)
+ { E->control.EMULTIGRID = 1;
+ set_mg_defaults(E);}
+ else
+ { if (E->parallel.me==0) fprintf(stderr,"Unable to determine how to solve, specify Solver=VALID_OPTION \n");
+ parallel_process_termination();
+ }
+
+
+ /* admin */
+
+ input_string("Spacing",E->control.NODE_SPACING,"regular",m);
+ if ( strcmp(E->control.NODE_SPACING,"regular") == 0)
+ E->control.GRID_TYPE = 1;
+ else if ( strcmp(E->control.NODE_SPACING,"bound_lyr") == 0)
+ E->control.GRID_TYPE = 2;
+ else if ( strcmp(E->control.NODE_SPACING,"region") == 0)
+ E->control.GRID_TYPE = 3;
+ else if ( strcmp(E->control.NODE_SPACING,"ortho_files") == 0)
+ E->control.GRID_TYPE = 4;
+ else
+ { E->control.GRID_TYPE = 1; }
+
+ /* Information on which files to print, which variables of the flow to calculate and print.
+ Default is no information recorded (apart from special things for given applications.
+ */
+
+ input_string("datadir",E->control.data_dir,".",m);
+ input_string("datafile",E->control.data_prefix,"initialize",m);
+ input_string("datadir_old",E->control.data_dir_old,".",m);
+ input_string("datafile_old",E->control.data_prefix_old,"initialize",m);
+
+ input_int("nproc_surf",&(E->parallel.nprocxy),"1",m);
+ input_int("nprocx",&(E->parallel.nprocx),"1",m);
+ input_int("nprocy",&(E->parallel.nprocy),"1",m);
+ input_int("nprocz",&(E->parallel.nprocz),"1",m);
+
+ if ( strcmp(E->control.SOLVER_TYPE,"cgrad") == 0) {
+ input_int("nodex",&(E->mesh.nox),"essential",m);
+ input_int("nodez",&(E->mesh.noz),"essential",m);
+ input_int("nodey",&(E->mesh.noy),"essential",m);
+
+ E->mesh.mgunitx = E->mesh.nox - 1;
+ E->mesh.mgunity = E->mesh.noy - 1;
+ E->mesh.mgunitz = E->mesh.noz - 1;
+ E->mesh.levels = 1;
+ }
+ else {
+ input_int("mgunitx",&(E->mesh.mgunitx),"1",m);
+ input_int("mgunitz",&(E->mesh.mgunitz),"1",m);
+ input_int("mgunity",&(E->mesh.mgunity),"1",m);
+
+ input_int("levels",&(E->mesh.levels),"1",m);
+
+ levmax = E->mesh.levels - 1;
+ E->mesh.nox = E->mesh.mgunitx * (int) pow(2.0,levmax) * E->parallel.nprocx + 1;
+ E->mesh.noy = E->mesh.mgunity * (int) pow(2.0,levmax) * E->parallel.nprocy + 1;
+ E->mesh.noz = E->mesh.mgunitz * (int) pow(2.0,levmax) * E->parallel.nprocz + 1;
+ }
+
+ input_int("coor",&(E->control.coor),"0",m);
+ if(E->control.coor == 2){
+ /*
+ refinement in two layers
+ */
+ /* number of refinement layers */
+ E->control.coor_refine[0] = 0.10; /* bottom 10% */
+ E->control.coor_refine[1] = 0.15; /* get 15% of the nodes */
+ E->control.coor_refine[2] = 0.10; /* top 10% */
+ E->control.coor_refine[3] = 0.20; /* get 20% of the nodes */
+ input_float_vector("coor_refine",4,E->control.coor_refine,m);
+ }else if(E->control.coor == 3){
+ /*
+
+ refinement CitcomCU style, by reading in layers, e.g.
+
+ r_grid_layers=3 # minus 1 is number of layers with uniform grid in r
+ rr=0.5,0.75,1.0 # starting and ending r coodinates
+ nr=1,37,97 # starting and ending node in r direction
+
+ */
+ input_int("r_grid_layers", &(E->control.rlayers), "1",m);
+ if(E->control.rlayers > 20)
+ myerror(E,"number of rlayers out of bounds (20) for coor = 3");
+ /* layers radii */
+ input_float_vector("rr", E->control.rlayers, (E->control.rrlayer),m);
+ /* associated node numbers */
+ input_int_vector("nr", E->control.rlayers, (E->control.nrlayer),m);
+ }
+
+ input_string("coor_file",E->control.coor_file,"",m);
+
+
+ input_boolean("node_assemble",&(E->control.NASSEMBLE),"off",m);
+ /* general mesh structure */
+
+ input_boolean("verbose",&(E->control.verbose),"off",m);
+ input_boolean("see_convergence",&(E->control.print_convergence),"off",m);
+
+ input_boolean("stokes_flow_only",&(E->control.stokes),"off",m);
+
+ //input_boolean("remove_hor_buoy_avg",&(E->control.remove_hor_buoy_avg),"on",m);
+
+
+ /* restart from checkpoint file */
+ input_boolean("restart",&(E->control.restart),"off",m);
+ input_int("post_p",&(E->control.post_p),"0",m);
+ input_int("solution_cycles_init",&(E->monitor.solution_cycles_init),"0",m);
+
+ /* for layers */
+
+ input_int("num_mat",&(E->viscosity.num_mat),"1",m); /* number of layers, moved
+ from Viscosity_structures.c */
+ if(E->viscosity.num_mat > CITCOM_MAX_VISC_LAYER)
+ myerror(E,"too many viscosity layers as per num_mat, increase CITCOM_MAX_VISC_LAYER");
+
+ /* those are specific depth layers associated with phase
+ transitions, default values should be fixed */
+ input_float("z_cmb",&(E->viscosity.zcmb),"0.45",m); /* 0.45063569 */
+ input_float("z_lmantle",&(E->viscosity.zlm),"0.45",m); /*0.10359441 */
+ input_float("z_410",&(E->viscosity.z410),"0.225",m); /* 0.06434, more like it */
+ input_float("z_lith",&(E->viscosity.zlith),"0.225",m); /* 0.0157, more like it */
+
+
+ /* those are depth layers associated with viscosity or material
+ jumps, they may or may not be identical with the phase changes */
+ E->viscosity.zbase_layer[0] = E->viscosity.zbase_layer[1] = -999;
+ input_float_vector("z_layer",E->viscosity.num_mat,(E->viscosity.zbase_layer),m);
+ if((fabs(E->viscosity.zbase_layer[0]+999) < 1e-5) &&
+ (fabs(E->viscosity.zbase_layer[1]+999) < 1e-5)){
+ /*
+ no z_layer input found
+ */
+ if(E->viscosity.num_mat != 4)
+ myerror(E,"error: either use z_layer for non dim layer depths, or set num_mat to four");
+
+ E->viscosity.zbase_layer[0] = E->viscosity.zlith;
+ E->viscosity.zbase_layer[1] = E->viscosity.z410;
+ E->viscosity.zbase_layer[2] = E->viscosity.zlm;
+ E->viscosity.zbase_layer[3] = E->viscosity.zcmb;
+ }
+
+ /* the start age and initial subduction history */
+ input_float("start_age",&(E->control.start_age),"0.0",m);
+ input_int("reset_startage",&(E->control.reset_startage),"0",m);
+ input_int("zero_elapsed_time",&(E->control.zero_elapsed_time),"0",m);
+
+ input_int("output_ll_max",&(E->output.llmax),"1",m);
+
+ input_int("topvbc",&(E->mesh.topvbc),"0",m);
+ input_int("botvbc",&(E->mesh.botvbc),"0",m);
+
+ input_float("topvbxval",&(E->control.VBXtopval),"0.0",m);
+ input_float("botvbxval",&(E->control.VBXbotval),"0.0",m);
+ input_float("topvbyval",&(E->control.VBYtopval),"0.0",m);
+ input_float("botvbyval",&(E->control.VBYbotval),"0.0",m);
+
+
+ input_float("T_interior_max_for_exit",&(E->monitor.T_interior_max_for_exit),"1.5",m);
+
+ input_int("pseudo_free_surf",&(E->control.pseudo_free_surf),"0",m);
+
+ input_int("toptbc",&(E->mesh.toptbc),"1",m);
+ input_int("bottbc",&(E->mesh.bottbc),"1",m);
+ input_float("toptbcval",&(E->control.TBCtopval),"0.0",m);
+ input_float("bottbcval",&(E->control.TBCbotval),"1.0",m);
+
+ input_boolean("side_sbcs",&(E->control.side_sbcs),"off",m);
+
+ input_int("file_vbcs",&(E->control.vbcs_file),"0",m);
+ input_string("vel_bound_file",E->control.velocity_boundary_file,"",m);
+
+ input_int("file_tbcs",&(E->control.tbcs_file),"0",m);
+ input_string("temp_bound_file",E->control.temperature_boundary_file,"",m);
+
+ input_int("reference_state",&(E->refstate.choice),"1",m);
+ if(E->refstate.choice == 0) {
+ input_string("refstate_file",E->refstate.filename,"refstate.dat",m);
+ }
+
+ input_int("mat_control",&(E->control.mat_control),"0",m);
+ input_string("mat_file",E->control.mat_file,"",m);
+
+#ifdef USE_GGRD
+
+
+ /*
+
+ note that this part of the code might override mat_control, file_vbcs,
+
+ MATERIAL CONTROL
+
+ usage:
+ (a)
+
+ ggrd_mat_control=2
+ ggrd_mat_file="weak.grd"
+
+ read in time-constant prefactors from weak.grd netcdf file that apply to top two E->mat layers
+
+ (b)
+
+ ggrd_mat_control=2
+ ggrd_mat_file="mythist"
+ ggrd_time_hist_file="mythist/times.dat"
+
+
+ time-dependent, will look for n files named mythist/i/weak.grd
+ where i = 1...n and n is the number of times as specified in
+ ggrd_time_hist_file which has time in Ma for n stages like so
+
+ -->age is positive, and forward marching in time decreases the age<--
+
+ 0 15
+ 15 30
+ 30 60
+
+ */
+ ggrd_init_master(&E->control.ggrd);
+ /* this is controlling velocities, material, and age */
+ /* time history file, if not specified, will use constant VBCs and material grids */
+ input_string("ggrd_time_hist_file",
+ E->control.ggrd.time_hist.file,"",m);
+ /* if > 0, will use top E->control.ggrd.mat_control layers and assign a prefactor for the viscosity */
+ input_int("ggrd_mat_control",&(E->control.ggrd.mat_control),"0",m);
+ input_string("ggrd_mat_file",E->control.ggrd.mat_file,"",m); /* file to read prefactors from */
+ if(E->control.ggrd.mat_control) /* this will override mat_control setting */
+ E->control.mat_control = 1;
+ /*
+
+ Surface layer Rayleigh number control, similar to above
+
+ */
+ input_int("ggrd_rayleigh_control",
+ &(E->control.ggrd.ray_control),"0",m);
+ input_string("ggrd_rayleigh_file",
+ E->control.ggrd.ray_file,"",m); /* file to read prefactors from */
+ /*
+
+ surface velocity control, similar to material control above
+
+ if time-dependent, will look for ggrd_vtop_file/i/v?.grd
+ if constant, will look for ggrd_vtop_file/v?.grd
+
+ where vp/vt.grd are Netcdf GRD files with East and South velocities in cm/yr
+
+
+ */
+ input_int("ggrd_vtop_control",&(E->control.ggrd.vtop_control),"0",m);
+ input_string("ggrd_vtop_dir",E->control.ggrd.vtop_dir,"",m); /* file to read prefactors from */
+
+ /*
+ read in omega[4] vector
+
+ if omega[0] is > 0, will read in a code.grd file instead of
+ vp.grd/vt.grd and assign the Euler vector omega[1-3] to all
+ locations with that omega[0] code. The Euler pole is assumed to
+ be in deg/Myr
+
+ ggrd_vtop_omega=4,-0.0865166,0.277312,-0.571239
+
+ will assign the NUVEL-1A NNR Pacific plate rotation vector to all
+ points with code 4
+
+ */
+ E->control.ggrd_vtop_omega[0] = 0;
+ input_float_vector("ggrd_vtop_omega",4,E->control.ggrd_vtop_omega,m);
+ if(E->control.ggrd_vtop_omega[0] > 0)
+ E->control.ggrd.vtop_control = 1;
+
+ if(E->control.ggrd.vtop_control) /* this will override mat_control setting */
+ E->control.vbcs_file = 1;
+
+ /* if set, will check the theta velocities from grid input for
+ scaled (internal non dim) values of > 1e9. if found, those nodes will
+ be set to free slip
+ */
+ input_boolean("allow_mixed_vbcs",&(E->control.ggrd_allow_mixed_vbcs),"off",m);
+
+
+#endif
+
+ input_boolean("aug_lagr",&(E->control.augmented_Lagr),"off",m);
+ input_double("aug_number",&(E->control.augmented),"0.0",m);
+
+ input_boolean("remove_rigid_rotation",&(E->control.remove_rigid_rotation),"on",m);
+
+ input_boolean("self_gravitation",&(E->control.self_gravitation),"off",m);
+ input_boolean("use_cbf_topo",&(E->control.use_cbf_topo),"off",m); /* make default on later XXX TWB */
+
+
+ input_int("storage_spacing",&(E->control.record_every),"10",m);
+ input_int("checkpointFrequency",&(E->control.checkpoint_frequency),"100",m);
+ input_int("cpu_limits_in_seconds",&(E->control.record_all_until),"5",m);
+ input_int("write_q_files",&(E->output.write_q_files),"0",m);/* write additional
+ heat flux files? */
+ if(E->output.write_q_files){ /* make sure those get written at
+ least as often as velocities */
+ E->output.write_q_files = min(E->output.write_q_files,E->control.record_every);
+ }
+
+
+ input_boolean("precond",&(E->control.precondition),"off",m);
+
+ input_int("mg_cycle",&(E->control.mg_cycle),"2,0,nomax",m);
+ input_int("down_heavy",&(E->control.down_heavy),"1,0,nomax",m);
+ input_int("up_heavy",&(E->control.up_heavy),"1,0,nomax",m);
+ input_double("accuracy",&(E->control.accuracy),"1.0e-4,0.0,1.0",m);
+ input_boolean("only_check_vel_convergence",&(E->control.only_check_vel_convergence),"off",m);
+
+ input_int("vhighstep",&(E->control.v_steps_high),"1,0,nomax",m);
+ input_int("vlowstep",&(E->control.v_steps_low),"250,0,nomax",m);
+ input_int("piterations",&(E->control.p_iterations),"100,0,nomax",m);
+
+ input_float("rayleigh",&(E->control.Atemp),"essential",m);
+
+ input_float("dissipation_number",&(E->control.disptn_number),"0.0",m);
+ input_float("gruneisen",&(tmp),"0.0",m);
+ /* special case: if tmp==0, set gruneisen as inf */
+ if(tmp != 0)
+ E->control.inv_gruneisen = 1/tmp;
+ else
+ E->control.inv_gruneisen = 0;
+
+ if(E->control.inv_gruneisen != 0) {
+ /* which compressible solver to use: "cg" or "bicg" */
+ input_string("uzawa",E->control.uzawa,"cg",m);
+ if(strcmp(E->control.uzawa, "cg") == 0) {
+ /* more convergence parameters for "cg" */
+ input_int("compress_iter_maxstep",&(E->control.compress_iter_maxstep),"100",m);
+ }
+ else if(strcmp(E->control.uzawa, "bicg") == 0) {
+ }
+ else
+ myerror(E, "Error: unknown Uzawa iteration\n");
+ }
+
+ input_float("surfaceT",&(E->control.surface_temp),"0.1",m);
+ /*input_float("adiabaticT0",&(E->control.adiabaticT0),"0.4",m);*/
+ input_float("Q0",&(E->control.Q0),"0.0",m);
+ /* Q0_enriched gets read in Tracer_setup.c */
+
+ /* data section */
+ input_float("gravacc",&(E->data.grav_acc),"9.81",m);
+ input_float("thermexp",&(E->data.therm_exp),"3.0e-5",m);
+ input_float("cp",&(E->data.Cp),"1200.0",m);
+ input_float("thermdiff",&(E->data.therm_diff),"1.0e-6",m);
+ input_float("density",&(E->data.density),"3340.0",m);
+ input_float("density_above",&(E->data.density_above),"1030.0",m);
+ input_float("density_below",&(E->data.density_below),"6600.0",m);
+ input_float("refvisc",&(E->data.ref_viscosity),"1.0e21",m);
+
+
+ input_double("ellipticity",&ell_tmp,"0.0",m);
+#ifdef ALLOW_ELLIPTICAL
+ /*
+
+ ellipticity and rotation settings
+
+ */
+ /* f = (a-c)/a, where c is the short, a=b the long axis
+ 1/298.257 = 0.00335281317789691 for Earth at present day
+ */
+ E->data.ellipticity = ell_tmp;
+ if(fabs(E->data.ellipticity) > 5e-7){
+
+ /* define ra and rc such that R=1 is the volume equivalanet */
+ E->data.ra = pow((1.-E->data.ellipticity),-1./3.); /* non dim long axis */
+ E->data.rc = 1./(E->data.ra * E->data.ra); /* non dim short axis */
+ E->data.efac = (1.-E->data.ellipticity)*(1.-E->data.ellipticity);
+ if(E->parallel.me == 0){
+ fprintf(stderr,"WARNING: EXPERIMENTAL: ellipticity: %.5e equivalent radii: r_a: %g r_b: %g\n",
+ E->data.ellipticity,E->data.ra,E->data.rc);
+ }
+ E->data.use_ellipse = 1;
+ }else{
+ E->data.ra = E->data.rc = E->data.efac=1.0;
+ E->data.use_ellipse = 0;
+ }
+ /*
+ centrifugal ratio between \omega^2 a^3/GM, 3.46775e-3 for the
+ Earth at present day
+ */
+ input_double("rotation_m",&E->data.rotm,"0.0",m);
+ if(fabs(E->data.rotm) > 5e-7){
+ /* J2 from flattening */
+ E->data.j2 = 2./3.*E->data.ellipticity*(1.-E->data.ellipticity/2.)-
+ E->data.rotm/3.*(1.-3./2.*E->data.rotm-2./7.*E->data.ellipticity);
+ /* normalized gravity at the equator */
+ E->data.ge = 1/(E->data.ra*E->data.ra)*(1+3./2.*E->data.j2-E->data.rotm);
+ if(E->parallel.me==0)
+ fprintf(stderr,"WARNING: rotational fraction m: %.5e J2: %.5e g_e: %g\n",
+ E->data.rotm,E->data.j2,E->data.ge);
+ E->data.use_rotation_g = 1;
+ }else{
+ E->data.use_rotation_g = 0;
+ }
+#else
+ if(fabs(ell_tmp) > 5e-7){
+ myerror(E,"ellipticity not zero, but not compiled with ALLOW_ELLIPTICAL");
+ }
+#endif
+ input_float("radius",&tmp,"6371e3.0",m);
+ E->data.radius_km = tmp / 1e3;
+
+ E->data.therm_cond = E->data.therm_diff * E->data.density * E->data.Cp;
+
+ E->data.ref_temperature = E->control.Atemp * E->data.therm_diff
+ * E->data.ref_viscosity
+ / (E->data.density * E->data.grav_acc * E->data.therm_exp)
+ / (E->data.radius_km * E->data.radius_km * E->data.radius_km * 1e9);
+
+ output_common_input(E);
+ h5input_params(E);
+ phase_change_input(E);
+ lith_age_input(E);
+
+ tic_input(E);
+ tracer_input(E);
+
+ viscosity_input(E); /* moved the viscosity input behind
+ the tracer input */
+
+ (E->problem_settings)(E);
+
+ check_settings_consistency(E);
+ return;
+}
+
+/* Checking the consistency of input parameters */
+void check_settings_consistency(struct All_variables *E)
+{
+
+ if (strcmp(E->control.SOLVER_TYPE, "cgrad") == 0) {
+ /* conjugate gradient has only one level */
+ if(E->mesh.levels != 1)
+ myerror(E, "Conjugate gradient solver is used. 'levels' must be 1.\n");
+ }
+ else {
+ /* multigrid solver needs two or more levels */
+ if(E->mesh.levels < 2)
+ myerror(E, "number of multigrid levels < 2\n");
+ if(E->mesh.levels > MAX_LEVELS)
+ myerror(E, "number of multigrid levels out of bound\n");
+ }
+
+ if((E->parallel.me == 0) && (E->control.only_check_vel_convergence)) {
+ fprintf(stderr,"solve_Ahat_p_fhat: WARNING: overriding pressure and div check\n");
+ }
+
+ return;
+}
+
+
+/* Setup global mesh parameters */
+void global_derived_values(struct All_variables *E)
+{
+ int d,i,nox,noz,noy;
+
+ E->mesh.levmax = E->mesh.levels-1;
+ E->mesh.gridmax = E->mesh.levmax;
+
+ E->mesh.elx = E->mesh.nox-1;
+ E->mesh.ely = E->mesh.noy-1;
+ E->mesh.elz = E->mesh.noz-1;
+
+ if(E->sphere.caps == 1) {
+ /* number of nodes, excluding overlaping nodes between processors */
+ E->mesh.nno = E->sphere.caps * E->mesh.nox * E->mesh.noy * E->mesh.noz;
+ }
+ else {
+ /* number of nodes, excluding overlaping nodes between processors */
+ /* each cap has one row of nox and one row of noy overlapped, exclude these nodes.
+ * nodes at north/south poles are exclued by all caps, include them by 2*noz*/
+ E->mesh.nno = E->sphere.caps * (E->mesh.nox-1) * (E->mesh.noy-1) * E->mesh.noz
+ + 2*E->mesh.noz;
+ }
+
+ E->mesh.nel = E->sphere.caps*E->mesh.elx*E->mesh.elz*E->mesh.ely;
+
+ E->mesh.nnov = E->mesh.nno;
+
+ /* this is a rough estimate for global neq, a more accurate neq will
+ be computed later. */
+ E->mesh.neq = E->mesh.nnov*E->mesh.nsd;
+
+ E->mesh.npno = E->mesh.nel;
+ E->mesh.nsf = E->mesh.nox*E->mesh.noy;
+
+ for(i=E->mesh.levmax;i>=E->mesh.levmin;i--) {
+ nox = E->mesh.mgunitx * (int) pow(2.0,(double)i)*E->parallel.nprocx + 1;
+ noy = E->mesh.mgunity * (int) pow(2.0,(double)i)*E->parallel.nprocy + 1;
+ noz = E->mesh.mgunitz * (int) pow(2.0,(double)i)*E->parallel.nprocz + 1;
+
+ E->mesh.ELX[i] = nox-1;
+ E->mesh.ELY[i] = noy-1;
+ E->mesh.ELZ[i] = noz-1;
+ if(E->sphere.caps == 1) {
+ E->mesh.NNO[i] = nox * noz * noy;
+ }
+ else {
+ E->mesh.NNO[i] = E->sphere.caps * (nox-1) * (noy-1) * noz + 2 * noz;
+ }
+ E->mesh.NEL[i] = E->sphere.caps * (nox-1) * (noz-1) * (noy-1);
+ E->mesh.NPNO[i] = E->mesh.NEL[i] ;
+ E->mesh.NOX[i] = nox;
+ E->mesh.NOZ[i] = noz;
+ E->mesh.NOY[i] = noy;
+
+ E->mesh.NNOV[i] = E->mesh.NNO[i];
+ E->mesh.NEQ[i] = E->mesh.nsd * E->mesh.NNOV[i] ;
+
+ }
+
+ /* Scaling from dimensionless units to Millions of years for input velocity
+ and time, timdir is the direction of time for advection. CPC 6/25/00 */
+
+ /* Myr */
+ E->data.scalet = (E->data.radius_km*1e3*E->data.radius_km*1e3/E->data.therm_diff)/(1.e6*365.25*24*3600);
+ /* cm/yr */
+ E->data.scalev = (E->data.radius_km*1e3/E->data.therm_diff)/(100*365.25*24*3600);
+ E->data.timedir = E->control.Atemp / fabs(E->control.Atemp);
+
+
+ if(E->control.print_convergence && E->parallel.me==0) {
+ fprintf(stderr,"Problem has %d x %d x %d nodes per cap, %d nodes and %d elements in total\n",
+ E->mesh.nox, E->mesh.noz, E->mesh.noy, E->mesh.nno, E->mesh.nel);
+ fprintf(E->fp,"Problem has %d x %d x %d nodes per cap, %d nodes and %d elements in total\n",
+ E->mesh.nox, E->mesh.noz, E->mesh.noy, E->mesh.nno, E->mesh.nel);
+ }
+ return;
+}
+
+
+/* ===================================
+ Functions which set up details
+ common to all problems follow ...
+ =================================== */
+
+void allocate_common_vars(struct All_variables *E)
+{
+ int m,n,snel,nsf,elx,ely,nox,noy,noz,nno,nel,npno;
+ int k,i,j,d,l,nno_l,npno_l,nozl,nnov_l,nxyz;
+
+ m=0;
+ n=1;
+
+ for (j=1;j<=E->sphere.caps_per_proc;j++) {
+
+ npno = E->lmesh.npno;
+ nel = E->lmesh.nel;
+ nno = E->lmesh.nno;
+ nsf = E->lmesh.nsf;
+ noz = E->lmesh.noz;
+ nox = E->lmesh.nox;
+ noy = E->lmesh.noy;
+ elx = E->lmesh.elx;
+ ely = E->lmesh.ely;
+
+ E->P[j] = (double *) malloc((npno+1)*sizeof(double));
+ E->T[j] = (double *) malloc((nno+1)*sizeof(double));
+ E->NP[j] = (float *) malloc((nno+1)*sizeof(float));
+ E->buoyancy[j] = (double *) malloc((nno+1)*sizeof(double));
+
+ E->gstress[j] = (float *) malloc((6*nno+1)*sizeof(float));
+ // TWB do we need this anymore XXX
+ //E->stress[j] = (float *) malloc((12*nsf+1)*sizeof(float));
+
+ for(i=1;i<=E->mesh.nsd;i++)
+ E->sphere.cap[j].TB[i] = (float *) malloc((nno+1)*sizeof(float));
+
+ E->slice.tpg[j] = (float *)malloc((nsf+2)*sizeof(float));
+ E->slice.tpgb[j] = (float *)malloc((nsf+2)*sizeof(float));
+ E->slice.divg[j] = (float *)malloc((nsf+2)*sizeof(float));
+ E->slice.vort[j] = (float *)malloc((nsf+2)*sizeof(float));
+ E->slice.shflux[j] = (float *)malloc((nsf+2)*sizeof(float));
+ E->slice.bhflux[j] = (float *)malloc((nsf+2)*sizeof(float));
+ /* if(E->mesh.topvbc==2 && E->control.pseudo_free_surf) */
+ E->slice.freesurf[j] = (float *)malloc((nsf+2)*sizeof(float));
+
+ E->mat[j] = (int *) malloc((nel+2)*sizeof(int));
+ E->VIP[j] = (float *) malloc((nel+2)*sizeof(float));
+
+ E->heating_adi[j] = (double *) malloc((nel+1)*sizeof(double));
+ E->heating_visc[j] = (double *) malloc((nel+1)*sizeof(double));
+ E->heating_latent[j] = (double *) malloc((nel+1)*sizeof(double));
+
+ /* lump mass matrix for the energy eqn */
+ E->TMass[j] = (double *) malloc((nno+1)*sizeof(double));
+
+ /* nodal mass */
+ E->NMass[j] = (double *) malloc((nno+1)*sizeof(double));
+
+ nxyz = max(nox*noz,nox*noy);
+ nxyz = 2*max(nxyz,noz*noy);
+
+ E->sien[j] = (struct SIEN *) malloc((nxyz+2)*sizeof(struct SIEN));
+ E->surf_element[j] = (int *) malloc((nxyz+2)*sizeof(int));
+ E->surf_node[j] = (int *) malloc((nsf+2)*sizeof(int));
+
+ } /* end for cap j */
+
+ /* density field */
+ E->rho = (double *) malloc((nno+1)*sizeof(double));
+
+ /* horizontal average */
+ E->Have.T = (float *)malloc((E->lmesh.noz+2)*sizeof(float));
+ E->Have.V[1] = (float *)malloc((E->lmesh.noz+2)*sizeof(float));
+ E->Have.V[2] = (float *)malloc((E->lmesh.noz+2)*sizeof(float));
+
+ for(i=E->mesh.levmin;i<=E->mesh.levmax;i++) {
+ E->sphere.R[i] = (double *) malloc((E->lmesh.NOZ[i]+1)*sizeof(double));
+ for (j=1;j<=E->sphere.caps_per_proc;j++) {
+ nno = E->lmesh.NNO[i];
+ npno = E->lmesh.NPNO[i];
+ nel = E->lmesh.NEL[i];
+ nox = E->lmesh.NOX[i];
+ noz = E->lmesh.NOZ[i];
+ noy = E->lmesh.NOY[i];
+ elx = E->lmesh.ELX[i];
+ ely = E->lmesh.ELY[i];
+ snel=E->lmesh.SNEL[i];
+
+ for(d=1;d<=E->mesh.nsd;d++) {
+ E->X[i][j][d] = (double *) malloc((nno+1)*sizeof(double));
+ E->SX[i][j][d] = (double *) malloc((nno+1)*sizeof(double));
+ }
+
+ for(d=0;d<=3;d++)
+ E->SinCos[i][j][d] = (double *) malloc((nno+1)*sizeof(double));
+
+ E->IEN[i][j] = (struct IEN *) malloc((nel+2)*sizeof(struct IEN));
+ E->EL[i][j] = (struct SUBEL *) malloc((nel+2)*sizeof(struct SUBEL));
+ E->sphere.area1[i][j] = (double *) malloc((snel+1)*sizeof(double));
+ for (k=1;k<=4;k++)
+ E->sphere.angle1[i][j][k] = (double *) malloc((snel+1)*sizeof(double));
+
+ E->GNX[i][j] = (struct Shape_function_dx *)malloc((nel+1)*sizeof(struct Shape_function_dx));
+ E->GDA[i][j] = (struct Shape_function_dA *)malloc((nel+1)*sizeof(struct Shape_function_dA));
+
+ E->MASS[i][j] = (double *) malloc((nno+1)*sizeof(double));
+ E->ECO[i][j] = (struct COORD *) malloc((nno+2)*sizeof(struct COORD));
+
+ E->TWW[i][j] = (struct FNODE *) malloc((nel+2)*sizeof(struct FNODE));
+
+ for(d=1;d<=E->mesh.nsd;d++)
+ for(l=1;l<=E->lmesh.NNO[i];l++) {
+ E->SX[i][j][d][l] = 0.0;
+ E->X[i][j][d][l] = 0.0;
+ }
+
+ }
+ }
+
+ for(i=0;i<=E->output.llmax;i++)
+ E->sphere.hindex[i] = (int *) malloc((E->output.llmax+3)
+ *sizeof(int));
+
+
+ for(i=E->mesh.gridmin;i<=E->mesh.gridmax;i++)
+ for (j=1;j<=E->sphere.caps_per_proc;j++) {
+
+ nno = E->lmesh.NNO[i];
+ npno = E->lmesh.NPNO[i];
+ nel = E->lmesh.NEL[i];
+ nox = E->lmesh.NOX[i];
+ noz = E->lmesh.NOZ[i];
+ noy = E->lmesh.NOY[i];
+ elx = E->lmesh.ELX[i];
+ ely = E->lmesh.ELY[i];
+
+ nxyz = elx*ely;
+ E->CC[i][j] =(struct CC *) malloc((1)*sizeof(struct CC));
+ E->CCX[i][j]=(struct CCX *) malloc((1)*sizeof(struct CCX));
+
+ E->elt_del[i][j] = (struct EG *) malloc((nel+1)*sizeof(struct EG));
+
+ if(E->control.inv_gruneisen != 0)
+ E->elt_c[i][j] = (struct EC *) malloc((nel+1)*sizeof(struct EC));
+
+ E->EVI[i][j] = (float *) malloc((nel+1)*vpoints[E->mesh.nsd]*sizeof(float));
+ E->BPI[i][j] = (double *) malloc((npno+1)*sizeof(double));
+
+ E->ID[i][j] = (struct ID *) malloc((nno+1)*sizeof(struct ID));
+ E->VI[i][j] = (float *) malloc((nno+1)*sizeof(float));
+ E->NODE[i][j] = (unsigned int *)malloc((nno+1)*sizeof(unsigned int));
+
+ nxyz = max(nox*noz,nox*noy);
+ nxyz = 2*max(nxyz,noz*noy);
+ nozl = max(noy,nox*2);
+
+
+
+ E->parallel.EXCHANGE_sNODE[i][j] = (struct PASS *) malloc((nozl+2)*sizeof(struct PASS));
+ E->parallel.NODE[i][j] = (struct BOUND *) malloc((nxyz+2)*sizeof(struct BOUND));
+ E->parallel.EXCHANGE_NODE[i][j]= (struct PASS *) malloc((nxyz+2)*sizeof(struct PASS));
+ E->parallel.EXCHANGE_ID[i][j] = (struct PASS *) malloc((nxyz*E->mesh.nsd+3)*sizeof(struct PASS));
+
+ for(l=1;l<=E->lmesh.NNO[i];l++) {
+ E->NODE[i][j][l] = (INTX | INTY | INTZ); /* and any others ... */
+ E->VI[i][j][l] = 1.0;
+ }
+
+
+ } /* end for cap and i & j */
+
+
+ for (j=1;j<=E->sphere.caps_per_proc;j++) {
+
+ for(k=1;k<=E->mesh.nsd;k++)
+ for(i=1;i<=E->lmesh.nno;i++)
+ E->sphere.cap[j].TB[k][i] = 0.0;
+
+ for(i=1;i<=E->lmesh.nno;i++)
+ E->T[j][i] = 0.0;
+
+ for(i=1;i<=E->lmesh.nel;i++) {
+ E->mat[j][i]=1;
+ E->VIP[j][i]=1.0;
+
+ E->heating_adi[j][i] = 0;
+ E->heating_visc[j][i] = 0;
+ E->heating_latent[j][i] = 1.0;
+ }
+
+ for(i=1;i<=E->lmesh.npno;i++)
+ E->P[j][i] = 0.0;
+
+ mat_prop_allocate(E);
+ phase_change_allocate(E);
+ set_up_nonmg_aliases(E,j);
+
+ } /* end for cap j */
+
+ if (strcmp(E->output.format, "hdf5") == 0)
+ h5output_allocate_memory(E);
+
+ return;
+ }
+
+/* ========================================================= */
+
+void allocate_velocity_vars(struct All_variables *E)
+{
+ int m,n,i,j,k,l;
+
+ E->monitor.incompressibility = 0;
+ E->monitor.fdotf = 0;
+ E->monitor.vdotv = 0;
+ E->monitor.pdotp = 0;
+
+ m=0;
+ n=1;
+ for (j=1;j<=E->sphere.caps_per_proc;j++) {
+ E->lmesh.nnov = E->lmesh.nno;
+ E->lmesh.neq = E->lmesh.nnov * E->mesh.nsd;
+
+ E->temp[j] = (double *) malloc((E->lmesh.neq+1)*sizeof(double));
+ E->temp1[j] = (double *) malloc(E->lmesh.neq*sizeof(double));
+ E->F[j] = (double *) malloc(E->lmesh.neq*sizeof(double));
+ E->U[j] = (double *) malloc((E->lmesh.neq+1)*sizeof(double));
+ E->u1[j] = (double *) malloc((E->lmesh.neq+1)*sizeof(double));
+
+
+ for(i=1;i<=E->mesh.nsd;i++) {
+ E->sphere.cap[j].V[i] = (float *) malloc((E->lmesh.nnov+1)*sizeof(float));
+ E->sphere.cap[j].VB[i] = (float *)malloc((E->lmesh.nnov+1)*sizeof(float));
+ E->sphere.cap[j].Vprev[i] = (float *) malloc((E->lmesh.nnov+1)*sizeof(float));
+ }
+
+ for(i=0;i<E->lmesh.neq;i++)
+ E->U[j][i] = E->temp[j][i] = E->temp1[j][i] = 0.0;
+
+
+ for(k=1;k<=E->mesh.nsd;k++)
+ for(i=1;i<=E->lmesh.nnov;i++)
+ E->sphere.cap[j].VB[k][i] = 0.0;
+
+ } /* end for cap j */
+
+ for(l=E->mesh.gridmin;l<=E->mesh.gridmax;l++)
+ for (j=1;j<=E->sphere.caps_per_proc;j++) {
+ E->lmesh.NEQ[l] = E->lmesh.NNOV[l] * E->mesh.nsd;
+
+ E->BI[l][j] = (double *) malloc((E->lmesh.NEQ[l])*sizeof(double));
+ k = (E->lmesh.NOX[l]*E->lmesh.NOZ[l]+E->lmesh.NOX[l]*E->lmesh.NOY[l]+
+ E->lmesh.NOY[l]*E->lmesh.NOZ[l])*6;
+ E->zero_resid[l][j] = (int *) malloc((k+2)*sizeof(int));
+ E->parallel.Skip_id[l][j] = (int *) malloc((k+2)*sizeof(int));
+
+ for(i=0;i<E->lmesh.NEQ[l];i++) {
+ E->BI[l][j][i]=0.0;
+ }
+
+ } /* end for j & l */
+
+ return;
+ }
+
+
+/* ========================================================= */
+
+void global_default_values(struct All_variables *E)
+{
+
+ /* FIRST: values which are not changed routinely by the user */
+
+ E->control.v_steps_low = 10;
+ E->control.v_steps_upper = 1;
+ E->control.accuracy = 1.0e-4;
+ E->control.verbose=0; /* debugging/profiles */
+
+ /* SECOND: values for which an obvious default setting is useful */
+
+ E->control.stokes=0;
+ E->control.restart=0;
+ E->control.CONVECTION = 0;
+ E->control.CART2D = 0;
+ E->control.CART3D = 0;
+ E->control.CART2pt5D = 0;
+ E->control.AXI = 0;
+ E->control.CONJ_GRAD = 0;
+ E->control.NMULTIGRID = 0;
+ E->control.EMULTIGRID = 0;
+ E->control.augmented_Lagr = 0;
+ E->control.augmented = 0.0;
+
+ E->control.GRID_TYPE=1;
+
+ E->trace.fpt = NULL;
+ E->control.tracer = 0;
+ E->composition.on = 0;
+
+ E->parallel.nprocx=1; E->parallel.nprocz=1; E->parallel.nprocy=1;
+
+ E->mesh.levmax=0;
+ E->mesh.levmin=0;
+ E->mesh.gridmax=0;
+ E->mesh.gridmin=0;
+ E->mesh.noz = 1; E->mesh.nzs = 1; E->lmesh.noz = 1; E->lmesh.nzs = 1;
+ E->mesh.noy = 1; E->mesh.nys = 1; E->lmesh.noy = 1; E->lmesh.nys = 1;
+ E->mesh.nox = 1; E->mesh.nxs = 1; E->lmesh.nox = 1; E->lmesh.nxs = 1;
+
+ E->sphere.ro = 1.0;
+ E->sphere.ri = 0.5;
+
+ E->control.precondition = 0; /* for larger visc contrasts turn this back on */
+
+ E->mesh.toptbc = 1; /* fixed t */
+ E->mesh.bottbc = 1;
+ E->mesh.topvbc = 0; /* stress */
+ E->mesh.botvbc = 0;
+ E->control.VBXtopval=0.0;
+ E->control.VBYtopval=0.0;
+ E->control.VBXbotval=0.0;
+ E->control.VBYbotval=0.0;
+
+ E->data.radius_km = 6370.0; /* Earth, whole mantle defaults */
+ E->data.grav_acc = 9.81;
+ E->data.therm_diff = 1.0e-6;
+ E->data.therm_exp = 3.e-5;
+ E->data.density = 3300.0;
+ E->data.ref_viscosity=1.e21;
+ E->data.density_above = 1000.0; /* sea water */
+ E->data.density_below = 6600.0; /* sea water */
+
+ E->data.Cp = 1200.0;
+ E->data.therm_cond = 3.168;
+ E->data.res_density = 3300.0; /* density when X = ... */
+ E->data.res_density_X = 0.3;
+ E->data.melt_density = 2800.0;
+ E->data.permeability = 3.0e-10;
+ E->data.gas_const = 8.3;
+ E->data.surf_heat_flux = 4.4e-2;
+
+ E->data.grav_const = 6.6742e-11;
+
+ E->data.youngs_mod = 1.0e11;
+ E->data.Te = 0.0;
+ E->data.T_sol0 = 1373.0; /* Dave's values 1991 (for the earth) */
+ E->data.Tsurf = 273.0;
+ E->data.dTsol_dz = 3.4e-3 ;
+ E->data.dTsol_dF = 440.0;
+ E->data.dT_dz = 0.48e-3;
+ E->data.delta_S = 250.0;
+ E->data.ref_temperature = 2 * 1350.0; /* fixed temperature ... delta T */
+
+ /* THIRD: you forgot and then went home, let's see if we can help out */
+
+ sprintf(E->control.data_prefix,"citcom.tmp.%d",getpid());
+
+ E->control.NASSEMBLE = 0;
+
+ E->monitor.elapsed_time=0.0;
+
+ E->control.record_all_until = 10000000;
+
+ return; }
+
+
+/* =============================================================
+ ============================================================= */
+
+void check_bc_consistency(struct All_variables *E)
+{ int i,j,lev;
+
+ for (j=1;j<=E->sphere.caps_per_proc;j++) {
+ for(i=1;i<=E->lmesh.nno;i++) {
+ if ((E->node[j][i] & VBX) && (E->node[j][i] & SBX))
+ printf("Inconsistent x velocity bc at %d\n",i);
+ if ((E->node[j][i] & VBZ) && (E->node[j][i] & SBZ))
+ printf("Inconsistent z velocity bc at %d\n",i);
+ if ((E->node[j][i] & VBY) && (E->node[j][i] & SBY))
+ printf("Inconsistent y velocity bc at %d\n",i);
+ if ((E->node[j][i] & TBX) && (E->node[j][i] & FBX))
+ printf("Inconsistent x temperature bc at %d\n",i);
+ if ((E->node[j][i] & TBZ) && (E->node[j][i] & FBZ))
+ printf("Inconsistent z temperature bc at %d\n",i);
+ if ((E->node[j][i] & TBY) && (E->node[j][i] & FBY))
+ printf("Inconsistent y temperature bc at %d\n",i);
+ }
+ } /* end for j */
+
+ for(lev=E->mesh.gridmin;lev<=E->mesh.gridmax;lev++)
+ for (j=1;j<=E->sphere.caps_per_proc;j++) {
+ for(i=1;i<=E->lmesh.NNO[lev];i++) {
+ if ((E->NODE[lev][j][i] & VBX) && (E->NODE[lev][j][i] & SBX))
+ printf("Inconsistent x velocity bc at %d,%d\n",lev,i);
+ if ((E->NODE[lev][j][i] & VBZ) && (E->NODE[lev][j][i] & SBZ))
+ printf("Inconsistent z velocity bc at %d,%d\n",lev,i);
+ if ((E->NODE[lev][j][i] & VBY) && (E->NODE[lev][j][i] & SBY))
+ printf("Inconsistent y velocity bc at %d,%d\n",lev,i);
+ /* Tbc's not applicable below top level */
+ }
+
+ } /* end for j and lev */
+
+ return;
+
+}
+
+void set_up_nonmg_aliases(struct All_variables *E, int j)
+{ /* Aliases for functions only interested in the highest mg level */
+
+ int i;
+
+ E->eco[j] = E->ECO[E->mesh.levmax][j];
+ E->ien[j] = E->IEN[E->mesh.levmax][j];
+ E->id[j] = E->ID[E->mesh.levmax][j];
+ E->Vi[j] = E->VI[E->mesh.levmax][j];
+ E->EVi[j] = E->EVI[E->mesh.levmax][j];
+ E->node[j] = E->NODE[E->mesh.levmax][j];
+ E->cc[j] = E->CC[E->mesh.levmax][j];
+ E->ccx[j] = E->CCX[E->mesh.levmax][j];
+ E->Mass[j] = E->MASS[E->mesh.levmax][j];
+ E->gDA[j] = E->GDA[E->mesh.levmax][j];
+ E->gNX[j] = E->GNX[E->mesh.levmax][j];
+
+ for (i=1;i<=E->mesh.nsd;i++) {
+ E->x[j][i] = E->X[E->mesh.levmax][j][i];
+ E->sx[j][i] = E->SX[E->mesh.levmax][j][i];
+ }
+
+ return; }
+
+void report(struct All_variables *E, char * string)
+{ if(E->control.verbose && E->parallel.me==0)
+ { fprintf(stderr,"%s\n",string);
+ fflush(stderr);
+ }
+ return;
+}
+
+void record(struct All_variables *E,char * string)
+{ if(E->control.verbose)
+ { fprintf(E->fp,"%s\n",string);
+ fflush(E->fp);
+ }
+
+ return;
+}
+
+
+
+/* =============================================================
+ Initialize values which are not problem dependent.
+ NOTE: viscosity may be a function of all previous
+ input fields (temperature, pressure, velocity, chemistry) and
+ so is always to be done last.
+ ============================================================= */
+
+
+/* This function is replaced by CitcomS.Components.IC.launch()*/
+void common_initial_fields(struct All_variables *E)
+{
+ report(E,"Initialize pressure field");
+ initial_pressure(E);
+ report(E,"Initialize velocity field");
+ initial_velocity(E);
+ report(E,"Initialize viscosity field");
+ /*get_viscosity_option(E);*/
+ initial_viscosity(E);
+
+ return;
+
+}
+
+/* ========================================== */
+
+void initial_pressure(struct All_variables *E)
+{
+ int i,m;
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=1;i<=E->lmesh.npno;i++)
+ E->P[m][i]=0.0;
+
+ return;
+}
+
+void initial_velocity(struct All_variables *E)
+{
+ int i,m;
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=1;i<=E->lmesh.nnov;i++) {
+ E->sphere.cap[m].V[1][i]=0.0;
+ E->sphere.cap[m].V[2][i]=0.0;
+ E->sphere.cap[m].V[3][i]=0.0;
+ }
+
+ return;
+}
+
+
+
+static void open_log(struct All_variables *E)
+{
+ char logfile[255];
+
+ E->fp = NULL;
+ if (strcmp(E->output.format, "ascii-gz") == 0)
+ sprintf(logfile,"%s/log", E->control.data_dir);
+ else
+ sprintf(logfile,"%s.log", E->control.data_file);
+
+ if (E->control.restart || E->control.post_p)
+ /* append the log file if restart */
+ E->fp = output_open(logfile, "a");
+ else
+ E->fp = output_open(logfile, "w");
+
+ return;
+}
+
+
+static void open_time(struct All_variables *E)
+{
+ char timeoutput[255];
+
+ E->fptime = NULL;
+ if (E->parallel.me == 0) {
+ if (strcmp(E->output.format, "ascii-gz") == 0)
+ sprintf(timeoutput,"%s/time", E->control.data_dir);
+ else
+ sprintf(timeoutput,"%s.time", E->control.data_file);
+
+ if (E->control.restart || E->control.post_p)
+ /* append the time file if restart */
+ E->fptime = output_open(timeoutput, "a");
+ else
+ E->fptime = output_open(timeoutput, "w");
+ }
+
+ return;
+}
+
+
+static void open_info(struct All_variables *E)
+{
+ char output_file[255];
+
+ E->fp_out = NULL;
+ if (E->control.verbose) {
+ if (strcmp(E->output.format, "ascii-gz") == 0)
+ sprintf(output_file,"%s/info.%d", E->control.data_dir, E->parallel.me);
+ else
+ sprintf(output_file,"%s.info.%d", E->control.data_file, E->parallel.me);
+ E->fp_out = output_open(output_file, "w");
+ }
+
+ return;
+}
+
+void open_qfiles(struct All_variables *E) /* additional heat
+ flux output */
+{
+ char output_file[255];
+
+ /* only one CPU will write to those */
+ if((E->parallel.me_loc[3] == E->parallel.nprocz-1) &&
+ (E->parallel.me==E->parallel.nprocz-1)){
+ /* top heat flux and other stat quantities */
+ if (strcmp(E->output.format, "ascii-gz") == 0)
+ sprintf(output_file,"%s/qt.dat", E->control.data_dir);
+ else
+ sprintf(output_file,"%s.qt.dat", E->control.data_file);
+ if(E->control.restart)
+ E->output.fpqt = output_open(output_file, "a"); /* append for restart */
+ else
+ E->output.fpqt = output_open(output_file, "w");
+ }else{
+ E->output.fpqt = NULL;
+ }
+ if (E->parallel.me_loc[3] == 0) {
+ /* bottom heat flux and other stat quantities */
+ if (strcmp(E->output.format, "ascii-gz") == 0)
+ sprintf(output_file,"%s/qb.dat", E->control.data_dir);
+ else
+ sprintf(output_file,"%s.qb.dat", E->control.data_file);
+ if(E->control.restart)
+ E->output.fpqb = output_open(output_file, "a"); /* append */
+ else
+ E->output.fpqb = output_open(output_file, "w");
+ }else{
+ E->output.fpqb = NULL;
+ }
+
+
+ return;
+}
+
+
+static void output_parse_optional(struct All_variables *E)
+{
+ int pos, len;
+ char *prev, *next;
+
+ len = strlen(E->output.optional);
+ /* fprintf(stderr, "### length of optional is %d\n", len); */
+ pos = 0;
+ next = E->output.optional;
+
+ E->output.connectivity = 0;
+ E->output.stress = 0;
+ E->output.pressure = 0;
+ E->output.surf = 0;
+ E->output.botm = 0;
+ E->output.geoid = 0;
+ E->output.horiz_avg = 0;
+ E->output.tracer = 0;
+ E->output.comp_el = 0;
+ E->output.comp_nd = 0;
+ E->output.heating = 0;
+
+ while(1) {
+ /* get next field */
+ prev = strsep(&next, ",");
+
+ /* break if no more field */
+ if(prev == NULL) break;
+
+ /* skip if empty */
+ if(prev[0] == '\0') continue;
+
+ /* strip off leading and trailing whitespaces */
+ prev = strip(prev);
+
+ /* skip empty field */
+ if (strlen(prev) == 0) continue;
+
+ /* fprintf(stderr, "### %s: %s\n", prev, next); */
+ if(strcmp(prev, "connectivity")==0)
+ E->output.connectivity = 1;
+ else if(strcmp(prev, "stress")==0)
+ E->output.stress = 1;
+ else if(strcmp(prev, "pressure")==0)
+ E->output.pressure = 1;
+ else if(strcmp(prev, "surf")==0)
+ E->output.surf = 1;
+ else if(strcmp(prev, "botm")==0)
+ E->output.botm = 1;
+ else if(strcmp(prev, "geoid")==0)
+ if (E->parallel.nprocxy != 12) {
+ fprintf(stderr, "Warning: geoid calculation only works in full version. Disabled\n");
+ }
+ else {
+ /* geoid calculation requires surface and CMB topo */
+ /* make sure the topos are available! */
+ E->output.geoid = 1;
+ }
+ else if(strcmp(prev, "horiz_avg")==0)
+ E->output.horiz_avg = 1;
+ else if(strcmp(prev, "tracer")==0)
+ E->output.tracer = 1;
+ else if(strcmp(prev, "comp_el")==0)
+ E->output.comp_el = 1;
+ else if(strcmp(prev, "comp_nd")==0)
+ E->output.comp_nd = 1;
+ else if(strcmp(prev, "heating")==0)
+ E->output.heating = 1;
+ else
+ if(E->parallel.me == 0)
+ fprintf(stderr, "Warning: unknown field for output_optional: %s\n", prev);
+
+ }
+
+ return;
+}
+
+/* check whether E->control.data_file contains a path seperator */
+static void chk_prefix(struct All_variables *E)
+{
+ char *found;
+
+ found = strchr(E->control.data_prefix, '/');
+ if (found) {
+ fprintf(stderr, "error in input parameter: datafile='%s' contains '/'\n", E->control.data_file);
+ parallel_process_termination();
+ }
+
+ if (E->control.restart || E->control.post_p ||
+ (E->convection.tic_method == -1) ||
+ (E->control.tracer && (E->trace.ic_method == 2))) {
+ found = strchr(E->control.data_prefix_old, '/');
+ if (found) {
+ fprintf(stderr, "error in input parameter: datafile_old='%s' contains '/'\n", E->control.data_file);
+ parallel_process_termination();
+ }
+ }
+}
+
+
+/* search src and substitue the 1st occurance of target by value */
+static void expand_str(char *src, size_t max_size,
+ const char *target, const char *value)
+{
+ char *pos, *end, *new_end;
+ size_t end_len, value_len;
+
+ /* is target a substring of src? */
+ pos = strstr(src, target);
+ if (pos != NULL) {
+ value_len = strlen(value);
+
+ /* the end part of the original string... */
+ end = pos + strlen(target);
+ /* ...and where it is going */
+ new_end = pos + value_len;
+ end_len = strlen(end);
+ if (new_end + end_len >= src + max_size) {
+ /* too long */
+ return;
+ }
+
+ /* move the end part of the original string */
+ memmove(new_end, end, end_len + 1); /* incl. null byte */
+
+ /* insert the value */
+ memcpy(pos, value, value_len);
+ }
+}
+
+static void expand_datadir(struct All_variables *E, char *datadir)
+{
+ char *found, *err;
+ char tmp[150];
+ int diff;
+ FILE *pipe;
+ const char str1[] = "%HOSTNAME";
+ const char str2[] = "%RANK";
+ const char str3[] = "%DATADIR";
+ const char str3_prog[] = "citcoms_datadir";
+
+ /* expand str1 by machine's hostname */
+ found = strstr(datadir, str1);
+ if (found) {
+ gethostname(tmp, 100);
+ expand_str(datadir, 150, str1, tmp);
+ }
+
+ /* expand str2 by MPI rank */
+ found = strstr(datadir, str2);
+ if (found) {
+ sprintf(tmp, "%d", E->parallel.me);
+ expand_str(datadir, 150, str2, tmp);
+ }
+
+ /* expand str3 by the result of the external program */
+ diff = strcmp(datadir, str3);
+ if (!diff) {
+ pipe = popen(str3_prog, "r");
+ err = fgets(tmp, 150, pipe);
+ pclose(stdout);
+ if (err != NULL)
+ sscanf(tmp, " %s", datadir);
+ else {
+ fprintf(stderr, "Cannot get datadir from command '%s'\n", str3_prog);
+ parallel_process_termination();
+ }
+ }
+}
+
+
+void mkdatadir(const char *dir)
+{
+ int err;
+
+ err = mkdir(dir, 0755);
+ if (err && errno != EEXIST) {
+ /* if error occured and the directory is not exisitng */
+ fprintf(stderr, "Cannot make new directory '%s'\n", dir);
+ parallel_process_termination();
+ }
+}
+
+
+void output_init(struct All_variables *E)
+{
+ chk_prefix(E);
+ expand_datadir(E, E->control.data_dir);
+ mkdatadir(E->control.data_dir);
+ snprintf(E->control.data_file, 200, "%s/%s", E->control.data_dir,
+ E->control.data_prefix);
+
+ if (E->control.restart || E->control.post_p ||
+ (E->convection.tic_method == -1) ||
+ (E->control.tracer && (E->trace.ic_method == 2))) {
+ expand_datadir(E, E->control.data_dir_old);
+ snprintf(E->control.old_P_file, 200, "%s/%s", E->control.data_dir_old,
+ E->control.data_prefix_old);
+ }
+
+ open_log(E);
+ open_time(E);
+ open_info(E);
+
+ if (strcmp(E->output.format, "ascii") == 0) {
+ E->problem_output = output;
+ }
+ else if (strcmp(E->output.format, "hdf5") == 0)
+ E->problem_output = h5output;
+ else if (strcmp(E->output.format, "vtk") == 0)
+ E->problem_output = vtk_output;
+#ifdef USE_GZDIR
+ else if (strcmp(E->output.format, "ascii-gz") == 0)
+ E->problem_output = gzdir_output;
+ else {
+ /* indicate error here */
+ if (E->parallel.me == 0) {
+ fprintf(stderr, "wrong output_format, must be 'ascii', 'hdf5', 'ascii-gz' or 'vtk'\n");
+ fprintf(E->fp, "wrong output_format, must be 'ascii', 'hdf5' 'ascii-gz', or 'vtk'\n");
+ }
+ parallel_process_termination();
+ }
+#else
+ else {
+ /* indicate error here */
+ if (E->parallel.me == 0) {
+ fprintf(stderr, "wrong output_format, must be 'ascii', 'hdf5', or 'vtk' (USE_GZDIR undefined)\n");
+ fprintf(E->fp, "wrong output_format, must be 'ascii', 'hdf5', or 'vtk' (USE_GZDIR undefined)\n");
+ }
+ parallel_process_termination(E);
+ }
+#endif
+
+ output_parse_optional(E);
+}
+
+
+
+void output_finalize(struct All_variables *E)
+{
+ char message[255],files[255];
+ if (E->fp)
+ fclose(E->fp);
+
+ if (E->fptime)
+ fclose(E->fptime);
+
+ if (E->fp_out)
+ fclose(E->fp_out);
+
+ if (E->trace.fpt)
+ fclose(E->trace.fpt);
+
+ if(E->output.fpqt)
+ fclose(E->output.fpqt);
+ if(E->output.fpqb)
+ fclose(E->output.fpqb);
+
+
+#ifdef USE_GZDIR
+ /*
+ remove VTK geo file in case we used that for IO
+ */
+ if((E->output.gzdir.vtk_io != 0) &&
+ (strcmp(E->output.format, "ascii-gz") == 0)){
+ if((E->output.gzdir.vtk_io == 3)||(E->parallel.me == 0)){
+ /* delete the geo files */
+ get_vtk_filename(files,1,E,0);
+ remove(files);
+ if(E->parallel.me == 0){
+ /* close the log */
+ fclose(E->output.gzdir.vtk_fp);
+ }
+ }
+ }
+#endif
+}
+
+
+char* strip(char *input)
+{
+ int end;
+ char *str;
+ end = strlen(input) - 1;
+ str = input;
+
+ /* trim trailing whitespace */
+ while (isspace(str[end]))
+ end--;
+
+ str[++end] = 0;
+
+ /* trim leading whitespace */
+ while(isspace(*str))
+ str++;
+
+ return str;
+}
+
+
Deleted: mc/3D/CitcomS/branches/cxx/lib/Interuption.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Interuption.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Interuption.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,61 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-#include <signal.h>
-#include <stdio.h>
-#include <stdlib.h>
-
-#include "interuption.h"
-
-void parallel_process_termination();
-
-int Emergency_stop;
-
-
-
-void interuption(int signal_number)
-{
- if (Emergency_stop)
- parallel_process_termination();
- else
- Emergency_stop++;
- fprintf(stderr,"Cleaning up before exit\n");
- return;
-}
-
-
-void set_signal()
-{
- Emergency_stop = 0;
-
- signal(SIGINT,interuption);
- signal(SIGTERM,interuption);
- return;
-}
-
-
-
Copied: mc/3D/CitcomS/branches/cxx/lib/Interuption.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Interuption.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Interuption.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Interuption.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,61 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+#include <signal.h>
+#include <stdio.h>
+#include <stdlib.h>
+
+#include "interuption.h"
+
+void parallel_process_termination();
+
+int Emergency_stop;
+
+
+
+void interuption(int signal_number)
+{
+ if (Emergency_stop)
+ parallel_process_termination();
+ else
+ Emergency_stop++;
+ fprintf(stderr,"Cleaning up before exit\n");
+ return;
+}
+
+
+void set_signal()
+{
+ Emergency_stop = 0;
+
+ signal(SIGINT,interuption);
+ signal(SIGTERM,interuption);
+ return;
+}
+
+
+
Deleted: mc/3D/CitcomS/branches/cxx/lib/Lith_age.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Lith_age.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Lith_age.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,443 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-
-#include <math.h>
-
-#include "global_defs.h"
-
-/*#include "age_related.h"*/
-#include "parallel_related.h"
-#include "parsing.h"
-#include "lith_age.h"
-
-float find_age_in_MY();
-void lith_age_update_tbc(struct All_variables *E);
-
-
-void lith_age_input(struct All_variables *E)
-{
- int m = E->parallel.me;
-
- E->control.lith_age = 0;
- E->control.lith_age_time = 0;
- E->control.temperature_bound_adj = 0;
-
- input_int("lith_age",&(E->control.lith_age),"0",m);
-#ifdef USE_GGRD
- input_int("ggrd_age_control",&(E->control.ggrd.age_control),"0",m); /* if > 0, will use top E->control.ggrd.mat_control layers and assign a prefactor for the viscosity */
- if(E->control.ggrd.age_control){
- E->control.lith_age = 1;
- }
-#endif
-
- input_float("mantle_temp",&(E->control.lith_age_mantle_temp),"1.0",m);
-
- if (E->control.lith_age) {
- input_int("lith_age_time",&(E->control.lith_age_time),"0",m);
- input_string("lith_age_file",E->control.lith_age_file,"",m);
- input_float("lith_age_depth",&(E->control.lith_age_depth),"0.0471",m);
-
- input_int("temperature_bound_adj",&(E->control.temperature_bound_adj),"0",m);
- if (E->control.temperature_bound_adj) {
- input_float("depth_bound_adj",&(E->control.depth_bound_adj),"0.1570",m);
- input_float("width_bound_adj",&(E->control.width_bound_adj),"0.08727",m);
- }
- }
- return;
-}
-
-
-void lith_age_init(struct All_variables *E)
-{
- char output_file[255];
- FILE *fp1;
- int node, i, j, output;
-
- int gnox, gnoy;
- gnox=E->mesh.nox;
- gnoy=E->mesh.noy;
-
- if (E->parallel.me == 0 ) fprintf(stderr,"INSIDE lith_age_init\n");
- E->age_t=(float*) malloc((gnox*gnoy+1)*sizeof(float));
-
- if(E->control.lith_age_time==1) {
- /* to open files every timestep */
- E->control.lith_age_old_cycles = E->monitor.solution_cycles;
- output = 1;
- (E->solver.lith_age_read_files)(E,output);
- }
- else {
- /* otherwise, just open for the first timestep */
- /* NOTE: This is only used if we are adjusting the boundaries */
- sprintf(output_file,"%s",E->control.lith_age_file);
- fp1=fopen(output_file,"r");
- if (fp1 == NULL) {
- fprintf(E->fp,"(Boundary_conditions #1) Can't open %s\n",output_file);
- parallel_process_termination();
- }
- for(i=1;i<=gnoy;i++)
- for(j=1;j<=gnox;j++) {
- node=j+(i-1)*gnox;
- fscanf(fp1,"%f",&(E->age_t[node]));
- E->age_t[node]=E->age_t[node]*E->data.scalet;
- }
- fclose(fp1);
- } /* end E->control.lith_age_time == false */
-}
-
-
-void lith_age_construct_tic(struct All_variables *E)
-{
- int i, j, k, m, node, nodeg;
- int nox, noy, noz, gnox, gnoy, gnoz;
- double r1, temp;
- float age;
- void temperatures_conform_bcs();
-
- noy=E->lmesh.noy;
- nox=E->lmesh.nox;
- noz=E->lmesh.noz;
-
- gnox=E->mesh.nox;
- gnoy=E->mesh.noy;
- gnoz=E->mesh.noz;
-
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=1;i<=noy;i++)
- for(j=1;j<=nox;j++)
- for(k=1;k<=noz;k++) {
- nodeg=E->lmesh.nxs-1+j+(E->lmesh.nys+i-2)*gnox;
- node=k+(j-1)*noz+(i-1)*nox*noz;
- r1=E->sx[m][3][node];
- E->T[m][node] = E->control.lith_age_mantle_temp;
- if( r1 >= E->sphere.ro-E->control.lith_age_depth )
- { /* if closer than (lith_age_depth) from top */
- temp = (E->sphere.ro-r1) *0.5 /sqrt(E->age_t[nodeg]);
- E->T[m][node] = E->control.lith_age_mantle_temp * erf(temp);
- }
- }
-
- /* modify temperature BC to be concorded with read in T */
- lith_age_update_tbc(E);
-
- temperatures_conform_bcs(E);
-
- return;
-}
-
-
-void lith_age_update_tbc(struct All_variables *E)
-{
- int i, j, k, m, node;
- int nox, noy, noz;
- double r1, rout, rin;
- const float e_4=1.e-4;
-
- noy = E->lmesh.noy;
- nox = E->lmesh.nox;
- noz = E->lmesh.noz;
- rout = E->sphere.ro;
- rin = E->sphere.ri;
-
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=1;i<=noy;i++)
- for(j=1;j<=nox;j++)
- for(k=1;k<=noz;k++) {
- node=k+(j-1)*noz+(i-1)*nox*noz;
- r1=E->sx[m][3][node];
-
- if(fabs(r1-rout)>=e_4 && fabs(r1-rin)>=e_4) {
- E->sphere.cap[m].TB[1][node]=E->T[m][node];
- E->sphere.cap[m].TB[2][node]=E->T[m][node];
- E->sphere.cap[m].TB[3][node]=E->T[m][node];
- }
- }
-
- return;
-}
-
-
-void lith_age_temperature_bound_adj(struct All_variables *E, int lv)
-{
- int j,node,nno;
- float ttt2,ttt3,fff2,fff3;
-
- nno=E->lmesh.nno;
-
-/* NOTE: To start, the relevent bits of "node" are zero. Thus, they only
-get set to TBX/TBY/TBZ if the node is in one of the bounding regions.
-Also note that right now, no matter which bounding region you are in,
-all three get set to true. CPC 6/20/00 */
-
- if (E->control.temperature_bound_adj) {
- ttt2=E->control.theta_min + E->control.width_bound_adj;
- ttt3=E->control.theta_max - E->control.width_bound_adj;
- fff2=E->control.fi_min + E->control.width_bound_adj;
- fff3=E->control.fi_max - E->control.width_bound_adj;
-
- if(lv==E->mesh.gridmax)
- for(j=1;j<=E->sphere.caps_per_proc;j++)
- for(node=1;node<=E->lmesh.nno;node++) {
- if( ((E->sx[j][1][node]<=ttt2) && (E->sx[j][3][node]>=E->sphere.ro-E->control.depth_bound_adj)) || ((E->sx[j][1][node]>=ttt3) && (E->sx[j][3][node]>=E->sphere.ro-E->control.depth_bound_adj)) )
- /* if < (width) from x bounds AND (depth) from top */
- {
- E->node[j][node]=E->node[j][node] | TBX;
- E->node[j][node]=E->node[j][node] & (~FBX);
- E->node[j][node]=E->node[j][node] | TBY;
- E->node[j][node]=E->node[j][node] & (~FBY);
- E->node[j][node]=E->node[j][node] | TBZ;
- E->node[j][node]=E->node[j][node] & (~FBZ);
- }
-
- if( ((E->sx[j][2][node]<=fff2) && (E->sx[j][3][node]>=E->sphere.ro-E->control.depth_bound_adj)) )
- /* if fi is < (width) from side AND z is < (depth) from top */
- {
- E->node[j][node]=E->node[j][node] | TBX;
- E->node[j][node]=E->node[j][node] & (~FBX);
- E->node[j][node]=E->node[j][node] | TBY;
- E->node[j][node]=E->node[j][node] & (~FBY);
- E->node[j][node]=E->node[j][node] | TBZ;
- E->node[j][node]=E->node[j][node] & (~FBZ);
- }
-
- if( ((E->sx[j][2][node]>=fff3) && (E->sx[j][3][node]>=E->sphere.ro-E->control.depth_bound_adj)) )
- /* if fi is < (width) from side AND z is < (depth) from top */
- {
- E->node[j][node]=E->node[j][node] | TBX;
- E->node[j][node]=E->node[j][node] & (~FBX);
- E->node[j][node]=E->node[j][node] | TBY;
- E->node[j][node]=E->node[j][node] & (~FBY);
- E->node[j][node]=E->node[j][node] | TBZ;
- E->node[j][node]=E->node[j][node] & (~FBZ);
- }
-
- }
- } /* end E->control.temperature_bound_adj */
-
- if (E->control.lith_age_time) {
- if(lv==E->mesh.gridmax)
- for(j=1;j<=E->sphere.caps_per_proc;j++)
- for(node=1;node<=E->lmesh.nno;node++) {
- if(E->sx[j][3][node]>=E->sphere.ro-E->control.lith_age_depth)
- { /* if closer than (lith_age_depth) from top */
- E->node[j][node]=E->node[j][node] | TBX;
- E->node[j][node]=E->node[j][node] & (~FBX);
- E->node[j][node]=E->node[j][node] | TBY;
- E->node[j][node]=E->node[j][node] & (~FBY);
- E->node[j][node]=E->node[j][node] | TBZ;
- E->node[j][node]=E->node[j][node] & (~FBZ);
- }
-
- }
- } /* end E->control.lith_age_time */
-
- return;
-}
-
-
-void lith_age_conform_tbc(struct All_variables *E)
-{
- int m,j,node,nox,noz,noy,gnox,gnoy,gnoz,nodeg,i,k;
- float ttt2,ttt3,fff2,fff3;
- float r1,t1,f1,t0,temp;
- float depth;
- float e_4;
- FILE *fp1;
- char output_file[255];
- int output;
-
-
- e_4=1.e-4;
- output = 0;
-
- gnox=E->mesh.nox;
- gnoy=E->mesh.noy;
- gnoz=E->mesh.noz;
- nox=E->lmesh.nox;
- noy=E->lmesh.noy;
- noz=E->lmesh.noz;
-
- if(E->control.lith_age_time==1) {
- /* to open files every timestep */
- if (E->control.lith_age_old_cycles != E->monitor.solution_cycles) {
- /*update so that output only happens once*/
- output = 1;
- E->control.lith_age_old_cycles = E->monitor.solution_cycles;
- }
- if (E->parallel.me == 0) fprintf(stderr,"INSIDE lith_age_conform_tbc\n");
- (E->solver.lith_age_read_files)(E,output);
- }
-
- /* NOW SET THE TEMPERATURES IN THE BOUNDARY REGIONS */
- if(E->monitor.solution_cycles>1 && E->control.temperature_bound_adj) {
- ttt2=E->control.theta_min + E->control.width_bound_adj;
- ttt3=E->control.theta_max - E->control.width_bound_adj;
- fff2=E->control.fi_min + E->control.width_bound_adj;
- fff3=E->control.fi_max - E->control.width_bound_adj;
-
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=1;i<=noy;i++)
- for(j=1;j<=nox;j++)
- for(k=1;k<=noz;k++) {
- nodeg=E->lmesh.nxs-1+j+(E->lmesh.nys+i-2)*gnox;
- node=k+(j-1)*noz+(i-1)*nox*noz;
- t1=E->sx[m][1][node];
- f1=E->sx[m][2][node];
- r1=E->sx[m][3][node];
-
- if(fabs(r1-E->sphere.ro)>=e_4 && fabs(r1-E->sphere.ri)>=e_4) { /* if NOT right on the boundary */
- if( ((E->sx[m][1][node]<=ttt2) && (E->sx[m][3][node]>=E->sphere.ro-E->control.depth_bound_adj)) || ((E->sx[m][1][node]>=ttt3) && (E->sx[m][3][node]>=E->sphere.ro-E->control.depth_bound_adj)) ) {
- /* if < (width) from x bounds AND (depth) from top */
- temp = (E->sphere.ro-r1) *0.5 /sqrt(E->age_t[nodeg]);
- t0 = E->control.lith_age_mantle_temp * erf(temp);
-
- /* keep the age the same! */
- E->sphere.cap[m].TB[1][node]=t0;
- E->sphere.cap[m].TB[2][node]=t0;
- E->sphere.cap[m].TB[3][node]=t0;
- }
-
- if( ((E->sx[m][2][node]<=fff2) || (E->sx[m][2][node]>=fff3)) && (E->sx[m][3][node]>=E->sphere.ro-E->control.depth_bound_adj) ) {
- /* if < (width) from y bounds AND (depth) from top */
-
-
- /* keep the age the same! */
- temp = (E->sphere.ro-r1) *0.5 /sqrt(E->age_t[nodeg]);
- t0 = E->control.lith_age_mantle_temp * erf(temp);
-
- E->sphere.cap[m].TB[1][node]=t0;
- E->sphere.cap[m].TB[2][node]=t0;
- E->sphere.cap[m].TB[3][node]=t0;
-
- }
-
- }
-
- } /* end k */
-
- } /* end of solution cycles && temperature_bound_adj */
-
-
- /* NOW SET THE TEMPERATURES IN THE LITHOSPHERE IF CHANGING EVERY TIME STEP */
- if(E->monitor.solution_cycles>0 && E->control.lith_age_time) {
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=1;i<=noy;i++)
- for(j=1;j<=nox;j++)
- for(k=1;k<=noz;k++) {
- nodeg=E->lmesh.nxs-1+j+(E->lmesh.nys+i-2)*gnox;
- node=k+(j-1)*noz+(i-1)*nox*noz;
- t1=E->sx[m][1][node];
- f1=E->sx[m][2][node];
- r1=E->sx[m][3][node];
-
- if(fabs(r1-E->sphere.ro)>=e_4 && fabs(r1-E->sphere.ri)>=e_4) { /* if NOT right on the boundary */
- if( E->sx[m][3][node]>=E->sphere.ro-E->control.lith_age_depth ) {
- /* if closer than (lith_age_depth) from top */
-
- depth=E->sphere.ro - E->sx[m][3][node];
-
- /* set a new age from the file */
- temp = (E->sphere.ro-r1) *0.5 /sqrt(E->age_t[nodeg]);
- t0 = E->control.lith_age_mantle_temp * erf(temp);
-
- E->sphere.cap[m].TB[1][node]=t0;
- E->sphere.cap[m].TB[2][node]=t0;
- E->sphere.cap[m].TB[3][node]=t0;
- }
- }
- } /* end k */
- } /* end of solution cycles && lith_age_time */
-
- return;
-}
-
-
-void assimilate_lith_conform_bcs(struct All_variables *E)
-{
- float depth, daf, assimilate_new_temp;
- int m,j,nno,node,nox,noz,noy,gnox,gnoy,gnoz,nodeg,ii,i,k;
- unsigned int type;
-
- nno=E->lmesh.nno;
- gnox=E->mesh.nox;
- gnoy=E->mesh.noy;
- gnoz=E->mesh.noz;
- nox=E->lmesh.nox;
- noy=E->lmesh.noy;
- noz=E->lmesh.noz;
-
- for(j=1;j<=E->sphere.caps_per_proc;j++)
- for(node=1;node<=E->lmesh.nno;node++) {
-
- type = (E->node[j][node] & (TBX | TBZ | TBY));
-
- switch (type) {
- case 0: /* no match, next node */
- break;
- case TBX:
- assimilate_new_temp = E->sphere.cap[j].TB[1][node];
- break;
- case TBZ:
- assimilate_new_temp = E->sphere.cap[j].TB[3][node];
- break;
- case TBY:
- assimilate_new_temp = E->sphere.cap[j].TB[2][node];
- break;
- case (TBX | TBZ): /* clashes ! */
- assimilate_new_temp = 0.5 * (E->sphere.cap[j].TB[1][node] + E->sphere.cap[j].TB[3][node]);
- break;
- case (TBX | TBY): /* clashes ! */
- assimilate_new_temp = 0.5 * (E->sphere.cap[j].TB[1][node] + E->sphere.cap[j].TB[2][node]);
- break;
- case (TBZ | TBY): /* clashes ! */
- assimilate_new_temp = 0.5 * (E->sphere.cap[j].TB[3][node] + E->sphere.cap[j].TB[2][node]);
- break;
- case (TBZ | TBY | TBX): /* clashes ! */
- assimilate_new_temp = 0.3333333 * (E->sphere.cap[j].TB[1][node] + E->sphere.cap[j].TB[2][node] + E->sphere.cap[j].TB[3][node]);
- break;
- } /* end switch */
-
- depth = E->sphere.ro - E->sx[j][3][node];
-
- switch (type) {
- case 0: /* no match, next node */
- break;
- default:
- if(depth <= E->control.lith_age_depth) {
- /* daf == depth_assimilation_factor */
- daf = 0.5*depth/E->control.lith_age_depth;
- E->T[j][node] = daf*E->T[j][node] + (1.0-daf)*assimilate_new_temp;
- }
- else
- E->T[j][node] = assimilate_new_temp;
- } /* end switch */
-
- } /* next node */
-
-return;
-}
Copied: mc/3D/CitcomS/branches/cxx/lib/Lith_age.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Lith_age.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Lith_age.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Lith_age.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,444 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+
+#include <math.h>
+
+#include "global_defs.h"
+
+/*#include "age_related.h"*/
+#include "parallel_related.h"
+#include "parsing.h"
+#include "lith_age.h"
+
+#include "cproto.h"
+
+float find_age_in_MY();
+void lith_age_update_tbc(struct All_variables *E);
+
+
+void lith_age_input(struct All_variables *E)
+{
+ int m = E->parallel.me;
+
+ E->control.lith_age = 0;
+ E->control.lith_age_time = 0;
+ E->control.temperature_bound_adj = 0;
+
+ input_int("lith_age",&(E->control.lith_age),"0",m);
+#ifdef USE_GGRD
+ input_int("ggrd_age_control",&(E->control.ggrd.age_control),"0",m); /* if > 0, will use top E->control.ggrd.mat_control layers and assign a prefactor for the viscosity */
+ if(E->control.ggrd.age_control){
+ E->control.lith_age = 1;
+ }
+#endif
+
+ input_float("mantle_temp",&(E->control.lith_age_mantle_temp),"1.0",m);
+
+ if (E->control.lith_age) {
+ input_int("lith_age_time",&(E->control.lith_age_time),"0",m);
+ input_string("lith_age_file",E->control.lith_age_file,"",m);
+ input_float("lith_age_depth",&(E->control.lith_age_depth),"0.0471",m);
+
+ input_int("temperature_bound_adj",&(E->control.temperature_bound_adj),"0",m);
+ if (E->control.temperature_bound_adj) {
+ input_float("depth_bound_adj",&(E->control.depth_bound_adj),"0.1570",m);
+ input_float("width_bound_adj",&(E->control.width_bound_adj),"0.08727",m);
+ }
+ }
+ return;
+}
+
+
+void lith_age_init(struct All_variables *E)
+{
+ char output_file[255];
+ FILE *fp1;
+ int node, i, j, output;
+
+ int gnox, gnoy;
+ gnox=E->mesh.nox;
+ gnoy=E->mesh.noy;
+
+ if (E->parallel.me == 0 ) fprintf(stderr,"INSIDE lith_age_init\n");
+ E->age_t=(float*) malloc((gnox*gnoy+1)*sizeof(float));
+
+ if(E->control.lith_age_time==1) {
+ /* to open files every timestep */
+ E->control.lith_age_old_cycles = E->monitor.solution_cycles;
+ output = 1;
+ (E->solver.lith_age_read_files)(E,output);
+ }
+ else {
+ /* otherwise, just open for the first timestep */
+ /* NOTE: This is only used if we are adjusting the boundaries */
+ sprintf(output_file,"%s",E->control.lith_age_file);
+ fp1=fopen(output_file,"r");
+ if (fp1 == NULL) {
+ fprintf(E->fp,"(Boundary_conditions #1) Can't open %s\n",output_file);
+ parallel_process_termination();
+ }
+ for(i=1;i<=gnoy;i++)
+ for(j=1;j<=gnox;j++) {
+ node=j+(i-1)*gnox;
+ fscanf(fp1,"%f",&(E->age_t[node]));
+ E->age_t[node]=E->age_t[node]*E->data.scalet;
+ }
+ fclose(fp1);
+ } /* end E->control.lith_age_time == false */
+}
+
+
+void lith_age_construct_tic(struct All_variables *E)
+{
+ int i, j, k, m, node, nodeg;
+ int nox, noy, noz, gnox, gnoy, gnoz;
+ double r1, temp;
+ float age;
+
+ noy=E->lmesh.noy;
+ nox=E->lmesh.nox;
+ noz=E->lmesh.noz;
+
+ gnox=E->mesh.nox;
+ gnoy=E->mesh.noy;
+ gnoz=E->mesh.noz;
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=1;i<=noy;i++)
+ for(j=1;j<=nox;j++)
+ for(k=1;k<=noz;k++) {
+ nodeg=E->lmesh.nxs-1+j+(E->lmesh.nys+i-2)*gnox;
+ node=k+(j-1)*noz+(i-1)*nox*noz;
+ r1=E->sx[m][3][node];
+ E->T[m][node] = E->control.lith_age_mantle_temp;
+ if( r1 >= E->sphere.ro-E->control.lith_age_depth )
+ { /* if closer than (lith_age_depth) from top */
+ temp = (E->sphere.ro-r1) *0.5 /sqrt(E->age_t[nodeg]);
+ E->T[m][node] = E->control.lith_age_mantle_temp * erf(temp);
+ }
+ }
+
+ /* modify temperature BC to be concorded with read in T */
+ lith_age_update_tbc(E);
+
+ temperatures_conform_bcs(E);
+
+ return;
+}
+
+
+void lith_age_update_tbc(struct All_variables *E)
+{
+ int i, j, k, m, node;
+ int nox, noy, noz;
+ double r1, rout, rin;
+ const float e_4=1.e-4;
+
+ noy = E->lmesh.noy;
+ nox = E->lmesh.nox;
+ noz = E->lmesh.noz;
+ rout = E->sphere.ro;
+ rin = E->sphere.ri;
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=1;i<=noy;i++)
+ for(j=1;j<=nox;j++)
+ for(k=1;k<=noz;k++) {
+ node=k+(j-1)*noz+(i-1)*nox*noz;
+ r1=E->sx[m][3][node];
+
+ if(fabs(r1-rout)>=e_4 && fabs(r1-rin)>=e_4) {
+ E->sphere.cap[m].TB[1][node]=E->T[m][node];
+ E->sphere.cap[m].TB[2][node]=E->T[m][node];
+ E->sphere.cap[m].TB[3][node]=E->T[m][node];
+ }
+ }
+
+ return;
+}
+
+
+void lith_age_temperature_bound_adj(struct All_variables *E, int lv)
+{
+ int j,node,nno;
+ float ttt2,ttt3,fff2,fff3;
+
+ nno=E->lmesh.nno;
+
+/* NOTE: To start, the relevent bits of "node" are zero. Thus, they only
+get set to TBX/TBY/TBZ if the node is in one of the bounding regions.
+Also note that right now, no matter which bounding region you are in,
+all three get set to true. CPC 6/20/00 */
+
+ if (E->control.temperature_bound_adj) {
+ ttt2=E->control.theta_min + E->control.width_bound_adj;
+ ttt3=E->control.theta_max - E->control.width_bound_adj;
+ fff2=E->control.fi_min + E->control.width_bound_adj;
+ fff3=E->control.fi_max - E->control.width_bound_adj;
+
+ if(lv==E->mesh.gridmax)
+ for(j=1;j<=E->sphere.caps_per_proc;j++)
+ for(node=1;node<=E->lmesh.nno;node++) {
+ if( ((E->sx[j][1][node]<=ttt2) && (E->sx[j][3][node]>=E->sphere.ro-E->control.depth_bound_adj)) || ((E->sx[j][1][node]>=ttt3) && (E->sx[j][3][node]>=E->sphere.ro-E->control.depth_bound_adj)) )
+ /* if < (width) from x bounds AND (depth) from top */
+ {
+ E->node[j][node]=E->node[j][node] | TBX;
+ E->node[j][node]=E->node[j][node] & (~FBX);
+ E->node[j][node]=E->node[j][node] | TBY;
+ E->node[j][node]=E->node[j][node] & (~FBY);
+ E->node[j][node]=E->node[j][node] | TBZ;
+ E->node[j][node]=E->node[j][node] & (~FBZ);
+ }
+
+ if( ((E->sx[j][2][node]<=fff2) && (E->sx[j][3][node]>=E->sphere.ro-E->control.depth_bound_adj)) )
+ /* if fi is < (width) from side AND z is < (depth) from top */
+ {
+ E->node[j][node]=E->node[j][node] | TBX;
+ E->node[j][node]=E->node[j][node] & (~FBX);
+ E->node[j][node]=E->node[j][node] | TBY;
+ E->node[j][node]=E->node[j][node] & (~FBY);
+ E->node[j][node]=E->node[j][node] | TBZ;
+ E->node[j][node]=E->node[j][node] & (~FBZ);
+ }
+
+ if( ((E->sx[j][2][node]>=fff3) && (E->sx[j][3][node]>=E->sphere.ro-E->control.depth_bound_adj)) )
+ /* if fi is < (width) from side AND z is < (depth) from top */
+ {
+ E->node[j][node]=E->node[j][node] | TBX;
+ E->node[j][node]=E->node[j][node] & (~FBX);
+ E->node[j][node]=E->node[j][node] | TBY;
+ E->node[j][node]=E->node[j][node] & (~FBY);
+ E->node[j][node]=E->node[j][node] | TBZ;
+ E->node[j][node]=E->node[j][node] & (~FBZ);
+ }
+
+ }
+ } /* end E->control.temperature_bound_adj */
+
+ if (E->control.lith_age_time) {
+ if(lv==E->mesh.gridmax)
+ for(j=1;j<=E->sphere.caps_per_proc;j++)
+ for(node=1;node<=E->lmesh.nno;node++) {
+ if(E->sx[j][3][node]>=E->sphere.ro-E->control.lith_age_depth)
+ { /* if closer than (lith_age_depth) from top */
+ E->node[j][node]=E->node[j][node] | TBX;
+ E->node[j][node]=E->node[j][node] & (~FBX);
+ E->node[j][node]=E->node[j][node] | TBY;
+ E->node[j][node]=E->node[j][node] & (~FBY);
+ E->node[j][node]=E->node[j][node] | TBZ;
+ E->node[j][node]=E->node[j][node] & (~FBZ);
+ }
+
+ }
+ } /* end E->control.lith_age_time */
+
+ return;
+}
+
+
+void lith_age_conform_tbc(struct All_variables *E)
+{
+ int m,j,node,nox,noz,noy,gnox,gnoy,gnoz,nodeg,i,k;
+ float ttt2,ttt3,fff2,fff3;
+ float r1,t1,f1,t0,temp;
+ float depth;
+ float e_4;
+ FILE *fp1;
+ char output_file[255];
+ int output;
+
+
+ e_4=1.e-4;
+ output = 0;
+
+ gnox=E->mesh.nox;
+ gnoy=E->mesh.noy;
+ gnoz=E->mesh.noz;
+ nox=E->lmesh.nox;
+ noy=E->lmesh.noy;
+ noz=E->lmesh.noz;
+
+ if(E->control.lith_age_time==1) {
+ /* to open files every timestep */
+ if (E->control.lith_age_old_cycles != E->monitor.solution_cycles) {
+ /*update so that output only happens once*/
+ output = 1;
+ E->control.lith_age_old_cycles = E->monitor.solution_cycles;
+ }
+ if (E->parallel.me == 0) fprintf(stderr,"INSIDE lith_age_conform_tbc\n");
+ (E->solver.lith_age_read_files)(E,output);
+ }
+
+ /* NOW SET THE TEMPERATURES IN THE BOUNDARY REGIONS */
+ if(E->monitor.solution_cycles>1 && E->control.temperature_bound_adj) {
+ ttt2=E->control.theta_min + E->control.width_bound_adj;
+ ttt3=E->control.theta_max - E->control.width_bound_adj;
+ fff2=E->control.fi_min + E->control.width_bound_adj;
+ fff3=E->control.fi_max - E->control.width_bound_adj;
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=1;i<=noy;i++)
+ for(j=1;j<=nox;j++)
+ for(k=1;k<=noz;k++) {
+ nodeg=E->lmesh.nxs-1+j+(E->lmesh.nys+i-2)*gnox;
+ node=k+(j-1)*noz+(i-1)*nox*noz;
+ t1=E->sx[m][1][node];
+ f1=E->sx[m][2][node];
+ r1=E->sx[m][3][node];
+
+ if(fabs(r1-E->sphere.ro)>=e_4 && fabs(r1-E->sphere.ri)>=e_4) { /* if NOT right on the boundary */
+ if( ((E->sx[m][1][node]<=ttt2) && (E->sx[m][3][node]>=E->sphere.ro-E->control.depth_bound_adj)) || ((E->sx[m][1][node]>=ttt3) && (E->sx[m][3][node]>=E->sphere.ro-E->control.depth_bound_adj)) ) {
+ /* if < (width) from x bounds AND (depth) from top */
+ temp = (E->sphere.ro-r1) *0.5 /sqrt(E->age_t[nodeg]);
+ t0 = E->control.lith_age_mantle_temp * erf(temp);
+
+ /* keep the age the same! */
+ E->sphere.cap[m].TB[1][node]=t0;
+ E->sphere.cap[m].TB[2][node]=t0;
+ E->sphere.cap[m].TB[3][node]=t0;
+ }
+
+ if( ((E->sx[m][2][node]<=fff2) || (E->sx[m][2][node]>=fff3)) && (E->sx[m][3][node]>=E->sphere.ro-E->control.depth_bound_adj) ) {
+ /* if < (width) from y bounds AND (depth) from top */
+
+
+ /* keep the age the same! */
+ temp = (E->sphere.ro-r1) *0.5 /sqrt(E->age_t[nodeg]);
+ t0 = E->control.lith_age_mantle_temp * erf(temp);
+
+ E->sphere.cap[m].TB[1][node]=t0;
+ E->sphere.cap[m].TB[2][node]=t0;
+ E->sphere.cap[m].TB[3][node]=t0;
+
+ }
+
+ }
+
+ } /* end k */
+
+ } /* end of solution cycles && temperature_bound_adj */
+
+
+ /* NOW SET THE TEMPERATURES IN THE LITHOSPHERE IF CHANGING EVERY TIME STEP */
+ if(E->monitor.solution_cycles>0 && E->control.lith_age_time) {
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=1;i<=noy;i++)
+ for(j=1;j<=nox;j++)
+ for(k=1;k<=noz;k++) {
+ nodeg=E->lmesh.nxs-1+j+(E->lmesh.nys+i-2)*gnox;
+ node=k+(j-1)*noz+(i-1)*nox*noz;
+ t1=E->sx[m][1][node];
+ f1=E->sx[m][2][node];
+ r1=E->sx[m][3][node];
+
+ if(fabs(r1-E->sphere.ro)>=e_4 && fabs(r1-E->sphere.ri)>=e_4) { /* if NOT right on the boundary */
+ if( E->sx[m][3][node]>=E->sphere.ro-E->control.lith_age_depth ) {
+ /* if closer than (lith_age_depth) from top */
+
+ depth=E->sphere.ro - E->sx[m][3][node];
+
+ /* set a new age from the file */
+ temp = (E->sphere.ro-r1) *0.5 /sqrt(E->age_t[nodeg]);
+ t0 = E->control.lith_age_mantle_temp * erf(temp);
+
+ E->sphere.cap[m].TB[1][node]=t0;
+ E->sphere.cap[m].TB[2][node]=t0;
+ E->sphere.cap[m].TB[3][node]=t0;
+ }
+ }
+ } /* end k */
+ } /* end of solution cycles && lith_age_time */
+
+ return;
+}
+
+
+void assimilate_lith_conform_bcs(struct All_variables *E)
+{
+ float depth, daf, assimilate_new_temp;
+ int m,j,nno,node,nox,noz,noy,gnox,gnoy,gnoz,nodeg,ii,i,k;
+ unsigned int type;
+
+ nno=E->lmesh.nno;
+ gnox=E->mesh.nox;
+ gnoy=E->mesh.noy;
+ gnoz=E->mesh.noz;
+ nox=E->lmesh.nox;
+ noy=E->lmesh.noy;
+ noz=E->lmesh.noz;
+
+ for(j=1;j<=E->sphere.caps_per_proc;j++)
+ for(node=1;node<=E->lmesh.nno;node++) {
+
+ type = (E->node[j][node] & (TBX | TBZ | TBY));
+
+ switch (type) {
+ case 0: /* no match, next node */
+ break;
+ case TBX:
+ assimilate_new_temp = E->sphere.cap[j].TB[1][node];
+ break;
+ case TBZ:
+ assimilate_new_temp = E->sphere.cap[j].TB[3][node];
+ break;
+ case TBY:
+ assimilate_new_temp = E->sphere.cap[j].TB[2][node];
+ break;
+ case (TBX | TBZ): /* clashes ! */
+ assimilate_new_temp = 0.5 * (E->sphere.cap[j].TB[1][node] + E->sphere.cap[j].TB[3][node]);
+ break;
+ case (TBX | TBY): /* clashes ! */
+ assimilate_new_temp = 0.5 * (E->sphere.cap[j].TB[1][node] + E->sphere.cap[j].TB[2][node]);
+ break;
+ case (TBZ | TBY): /* clashes ! */
+ assimilate_new_temp = 0.5 * (E->sphere.cap[j].TB[3][node] + E->sphere.cap[j].TB[2][node]);
+ break;
+ case (TBZ | TBY | TBX): /* clashes ! */
+ assimilate_new_temp = 0.3333333 * (E->sphere.cap[j].TB[1][node] + E->sphere.cap[j].TB[2][node] + E->sphere.cap[j].TB[3][node]);
+ break;
+ } /* end switch */
+
+ depth = E->sphere.ro - E->sx[j][3][node];
+
+ switch (type) {
+ case 0: /* no match, next node */
+ break;
+ default:
+ if(depth <= E->control.lith_age_depth) {
+ /* daf == depth_assimilation_factor */
+ daf = 0.5*depth/E->control.lith_age_depth;
+ E->T[j][node] = daf*E->T[j][node] + (1.0-daf)*assimilate_new_temp;
+ }
+ else
+ E->T[j][node] = assimilate_new_temp;
+ } /* end switch */
+
+ } /* next node */
+
+return;
+}
Modified: mc/3D/CitcomS/branches/cxx/lib/Makefile.am
===================================================================
--- mc/3D/CitcomS/trunk/lib/Makefile.am 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Makefile.am 2009-02-13 03:39:35 UTC (rev 14045)
@@ -48,7 +48,7 @@
endif
# static library
-libCitcomS_a_CFLAGS = $(AM_CFLAGS) # hack for automake
+libCitcomS_a_CXXFLAGS = $(AM_CXXFLAGS) # hack for automake
libCitcomS_a_SOURCES = $(sources)
# shared library (libtool)
@@ -56,90 +56,90 @@
libCitcomS_la_SOURCES = $(sources)
sources = \
- Advection_diffusion.c \
+ Advection_diffusion.cc \
advection_diffusion.h \
advection.h \
- BC_util.c \
- Checkpoints.c \
+ BC_util.cc \
+ Checkpoints.cc \
checkpoints.h \
- Citcom_init.c \
+ Citcom_init.cc \
citcom_init.h \
- Composition_related.c \
+ Composition_related.cc \
composition_related.h \
- Construct_arrays.c \
- Convection.c \
+ Construct_arrays.cc \
+ Convection.cc \
convection_variables.h \
- Determine_net_rotation.c \
- Drive_solvers.c \
+ Determine_net_rotation.cc \
+ Drive_solvers.cc \
drive_solvers.h \
- Element_calculations.c \
+ Element_calculations.cc \
element_definitions.h \
- General_matrix_functions.c \
+ General_matrix_functions.cc \
global_defs.h \
- Ggrd_handling.c \
- Global_operations.c \
+ Ggrd_handling.cc \
+ Global_operations.cc \
hdf5_related.h \
- Initial_temperature.c \
+ Initial_temperature.cc \
initial_temperature.h \
- Instructions.c \
- Interuption.c \
+ Instructions.cc \
+ Interuption.cc \
interuption.h \
lith_age.h \
- Lith_age.c \
- Material_properties.c \
+ Lith_age.cc \
+ Material_properties.cc \
material_properties.h \
- Nodal_mesh.c \
- Output.c \
+ Nodal_mesh.cc \
+ Output.cc \
output.h \
- Output_gzdir.c \
- Output_h5.c \
+ Output_gzdir.cc \
+ Output_h5.cc \
output_h5.h \
- Output_vtk.c \
- Pan_problem_misc_functions.c \
+ Output_vtk.cc \
+ Pan_problem_misc_functions.cc \
parallel_related.h \
- Parallel_util.c \
- Parsing.c \
+ Parallel_util.cc \
+ Parsing.cc \
parsing.h \
- Phase_change.c \
+ Phase_change.cc \
phase_change.h \
- Problem_related.c \
- Process_buoyancy.c \
- Shape_functions.c \
- Size_does_matter.c \
- Solver_conj_grad.c \
- Solver_multigrid.c \
+ Problem_related.cc \
+ Process_buoyancy.cc \
+ Shape_functions.cc \
+ Size_does_matter.cc \
+ Solver_conj_grad.cc \
+ Solver_multigrid.cc \
solver.h \
sphere_communication.h \
- Sphere_harmonics.c \
- Sphere_util.c \
- Stokes_flow_Incomp.c \
- Topo_gravity.c \
+ Sphere_harmonics.cc \
+ Sphere_util.cc \
+ Stokes_flow_Incomp.cc \
+ Topo_gravity.cc \
tracer_defs.h \
- Tracer_setup.c \
+ Tracer_setup.cc \
viscosity_descriptions.h \
- Viscosity_structures.c \
- Full_boundary_conditions.c \
- Full_geometry_cartesian.c \
- Full_lith_age_read_files.c \
- Full_parallel_related.c \
- Full_read_input_from_files.c \
- Full_solver.c \
- Full_sphere_related.c \
- Full_tracer_advection.c \
- Full_version_dependent.c \
- Regional_boundary_conditions.c \
- Regional_geometry_cartesian.c \
- Regional_lith_age_read_files.c \
- Regional_parallel_related.c \
- Regional_read_input_from_files.c \
- Regional_solver.c \
- Regional_sphere_related.c \
- Regional_tracer_advection.c \
- Regional_version_dependent.c
+ Viscosity_structures.cc \
+ Full_boundary_conditions.cc \
+ Full_geometry_cartesian.cc \
+ Full_lith_age_read_files.cc \
+ Full_parallel_related.cc \
+ Full_read_input_from_files.cc \
+ Full_solver.cc \
+ Full_sphere_related.cc \
+ Full_tracer_advection.cc \
+ Full_version_dependent.cc \
+ Regional_boundary_conditions.cc \
+ Regional_geometry_cartesian.cc \
+ Regional_lith_age_read_files.cc \
+ Regional_parallel_related.cc \
+ Regional_read_input_from_files.cc \
+ Regional_solver.cc \
+ Regional_sphere_related.cc \
+ Regional_tracer_advection.cc \
+ Regional_version_dependent.cc
EXTRA_DIST = \
- Obsolete.c \
- Full_obsolete.c \
- Regional_obsolete.c
+ Obsolete.cc \
+ Full_obsolete.cc \
+ Regional_obsolete.cc
## end of Makefile.am
Deleted: mc/3D/CitcomS/branches/cxx/lib/Material_properties.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Material_properties.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Material_properties.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,177 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-
-#ifdef HAVE_CONFIG_H
-#include "config.h"
-#endif
-
-#include <math.h>
-
-#include "global_defs.h"
-#include "material_properties.h"
-#include "parallel_related.h"
-
-static void read_refstate(struct All_variables *E);
-static void adams_williamson_eos(struct All_variables *E);
-
-int layers_r(struct All_variables *,float);
-
-void mat_prop_allocate(struct All_variables *E)
-{
- int noz = E->lmesh.noz;
- int nno = E->lmesh.nno;
- int nel = E->lmesh.nel;
-
- /* reference profile of density */
- E->refstate.rho = (double *) malloc((noz+1)*sizeof(double));
-
- /* reference profile of gravity */
- E->refstate.gravity = (double *) malloc((noz+1)*sizeof(double));
-
- /* reference profile of coefficient of thermal expansion */
- E->refstate.thermal_expansivity = (double *) malloc((noz+1)*sizeof(double));
-
- /* reference profile of heat capacity */
- E->refstate.heat_capacity = (double *) malloc((noz+1)*sizeof(double));
-
- /* reference profile of thermal conductivity */
- /*E->refstate.thermal_conductivity = (double *) malloc((noz+1)*sizeof(double));*/
-
- /* reference profile of temperature */
- /*E->refstate.Tadi = (double *) malloc((noz+1)*sizeof(double));*/
-
-}
-
-
-void reference_state(struct All_variables *E)
-{
- int i;
-
- /* All refstate variables (except Tadi) must be 1 at the surface.
- * Otherwise, the scaling of eqns in the code might not be correct. */
-
- /* select the choice of reference state */
- switch(E->refstate.choice) {
- case 0:
- /* read from a file */
- read_refstate(E);
- break;
- case 1:
- /* Adams-Williamson EoS */
- adams_williamson_eos(E);
- break;
- default:
- if (E->parallel.me) {
- fprintf(stderr, "Unknown option for reference state\n");
- fprintf(E->fp, "Unknown option for reference state\n");
- fflush(E->fp);
- }
- parallel_process_termination();
- }
-
- if(E->parallel.me == 0) {
- fprintf(stderr, " nz radius depth rho layer\n");
- }
- if(E->parallel.me < E->parallel.nprocz)
- for(i=1; i<=E->lmesh.noz; i++) {
- fprintf(stderr, "%6d %11f %11f %11e %5i\n",
- i+E->lmesh.nzs-1, E->sx[1][3][i], 1-E->sx[1][3][i],
- E->refstate.rho[i],layers_r(E,E->sx[1][3][i]));
- }
-
- return;
-}
-
-
-static void read_refstate(struct All_variables *E)
-{
- FILE *fp;
- int i;
- char buffer[255];
- double not_used1, not_used2, not_used3;
-
- fp = fopen(E->refstate.filename, "r");
- if(fp == NULL) {
- fprintf(stderr, "Cannot open reference state file: %s\n",
- E->refstate.filename);
- parallel_process_termination();
- }
-
- /* skip these lines, which belong to other processors */
- for(i=1; i<E->lmesh.nzs; i++) {
- fgets(buffer, 255, fp);
- }
-
- for(i=1; i<=E->lmesh.noz; i++) {
- fgets(buffer, 255, fp);
- sscanf(buffer, "%lf %lf %lf %lf %lf %lf %lf\n",
- &(E->refstate.rho[i]),
- &(E->refstate.gravity[i]),
- &(E->refstate.thermal_expansivity[i]),
- &(E->refstate.heat_capacity[i]),
- ¬_used1,
- ¬_used2,
- ¬_used3);
-
- /**** debug ****
- fprintf(stderr, "%d %f %f %f %f\n",
- i,
- E->refstate.rho[i],
- E->refstate.gravity[i],
- E->refstate.thermal_expansivity[i],
- E->refstate.heat_capacity[i]);
- /* end of debug */
- }
-
- fclose(fp);
- return;
-}
-
-
-static void adams_williamson_eos(struct All_variables *E)
-{
- int i;
- double r, z, beta;
-
- beta = E->control.disptn_number * E->control.inv_gruneisen;
-
- for(i=1; i<=E->lmesh.noz; i++) {
- r = E->sx[1][3][i];
- z = 1 - r;
- E->refstate.rho[i] = exp(beta*z);
- E->refstate.gravity[i] = 1;
- E->refstate.thermal_expansivity[i] = 1;
- E->refstate.heat_capacity[i] = 1;
- /*E->refstate.thermal_conductivity[i] = 1;*/
- /*E->refstate.Tadi[i] = (E->control.adiabaticT0 + E->control.surface_temp) * exp(E->control.disptn_number * z) - E->control.surface_temp;*/
- }
-
- return;
-}
-
-
Copied: mc/3D/CitcomS/branches/cxx/lib/Material_properties.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Material_properties.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Material_properties.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Material_properties.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,177 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+
+#include <math.h>
+
+#include "global_defs.h"
+#include "material_properties.h"
+#include "parallel_related.h"
+
+static void read_refstate(struct All_variables *E);
+static void adams_williamson_eos(struct All_variables *E);
+
+int layers_r(struct All_variables *,float);
+
+void mat_prop_allocate(struct All_variables *E)
+{
+ int noz = E->lmesh.noz;
+ int nno = E->lmesh.nno;
+ int nel = E->lmesh.nel;
+
+ /* reference profile of density */
+ E->refstate.rho = (double *) malloc((noz+1)*sizeof(double));
+
+ /* reference profile of gravity */
+ E->refstate.gravity = (double *) malloc((noz+1)*sizeof(double));
+
+ /* reference profile of coefficient of thermal expansion */
+ E->refstate.thermal_expansivity = (double *) malloc((noz+1)*sizeof(double));
+
+ /* reference profile of heat capacity */
+ E->refstate.heat_capacity = (double *) malloc((noz+1)*sizeof(double));
+
+ /* reference profile of thermal conductivity */
+ /*E->refstate.thermal_conductivity = (double *) malloc((noz+1)*sizeof(double));*/
+
+ /* reference profile of temperature */
+ /*E->refstate.Tadi = (double *) malloc((noz+1)*sizeof(double));*/
+
+}
+
+
+void reference_state(struct All_variables *E)
+{
+ int i;
+
+ /* All refstate variables (except Tadi) must be 1 at the surface.
+ * Otherwise, the scaling of eqns in the code might not be correct. */
+
+ /* select the choice of reference state */
+ switch(E->refstate.choice) {
+ case 0:
+ /* read from a file */
+ read_refstate(E);
+ break;
+ case 1:
+ /* Adams-Williamson EoS */
+ adams_williamson_eos(E);
+ break;
+ default:
+ if (E->parallel.me) {
+ fprintf(stderr, "Unknown option for reference state\n");
+ fprintf(E->fp, "Unknown option for reference state\n");
+ fflush(E->fp);
+ }
+ parallel_process_termination();
+ }
+
+ if(E->parallel.me == 0) {
+ fprintf(stderr, " nz radius depth rho layer\n");
+ }
+ if(E->parallel.me < E->parallel.nprocz)
+ for(i=1; i<=E->lmesh.noz; i++) {
+ fprintf(stderr, "%6d %11f %11f %11e %5i\n",
+ i+E->lmesh.nzs-1, E->sx[1][3][i], 1-E->sx[1][3][i],
+ E->refstate.rho[i],layers_r(E,E->sx[1][3][i]));
+ }
+
+ return;
+}
+
+
+static void read_refstate(struct All_variables *E)
+{
+ FILE *fp;
+ int i;
+ char buffer[255];
+ double not_used1, not_used2, not_used3;
+
+ fp = fopen(E->refstate.filename, "r");
+ if(fp == NULL) {
+ fprintf(stderr, "Cannot open reference state file: %s\n",
+ E->refstate.filename);
+ parallel_process_termination();
+ }
+
+ /* skip these lines, which belong to other processors */
+ for(i=1; i<E->lmesh.nzs; i++) {
+ fgets(buffer, 255, fp);
+ }
+
+ for(i=1; i<=E->lmesh.noz; i++) {
+ fgets(buffer, 255, fp);
+ sscanf(buffer, "%lf %lf %lf %lf %lf %lf %lf\n",
+ &(E->refstate.rho[i]),
+ &(E->refstate.gravity[i]),
+ &(E->refstate.thermal_expansivity[i]),
+ &(E->refstate.heat_capacity[i]),
+ ¬_used1,
+ ¬_used2,
+ ¬_used3);
+
+ /**** debug ****
+ fprintf(stderr, "%d %f %f %f %f\n",
+ i,
+ E->refstate.rho[i],
+ E->refstate.gravity[i],
+ E->refstate.thermal_expansivity[i],
+ E->refstate.heat_capacity[i]);
+ /* end of debug */
+ }
+
+ fclose(fp);
+ return;
+}
+
+
+static void adams_williamson_eos(struct All_variables *E)
+{
+ int i;
+ double r, z, beta;
+
+ beta = E->control.disptn_number * E->control.inv_gruneisen;
+
+ for(i=1; i<=E->lmesh.noz; i++) {
+ r = E->sx[1][3][i];
+ z = 1 - r;
+ E->refstate.rho[i] = exp(beta*z);
+ E->refstate.gravity[i] = 1;
+ E->refstate.thermal_expansivity[i] = 1;
+ E->refstate.heat_capacity[i] = 1;
+ /*E->refstate.thermal_conductivity[i] = 1;*/
+ /*E->refstate.Tadi[i] = (E->control.adiabaticT0 + E->control.surface_temp) * exp(E->control.disptn_number * z) - E->control.surface_temp;*/
+ }
+
+ return;
+}
+
+
Deleted: mc/3D/CitcomS/branches/cxx/lib/Nodal_mesh.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Nodal_mesh.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Nodal_mesh.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,340 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-/* Functions relating to the building and use of mesh locations ... */
-
-
-#include <math.h>
-#include <sys/types.h>
-#include "element_definitions.h"
-#include "global_defs.h"
-
-
-/* get nodal spherical velocities from the solution vector */
-void v_from_vector(E)
- struct All_variables *E;
-{
- int m,node;
- const int nno = E->lmesh.nno;
-
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- for(node=1;node<=nno;node++) {
- E->sphere.cap[m].V[1][node] = E->U[m][E->id[m][node].doff[1]];
- E->sphere.cap[m].V[2][node] = E->U[m][E->id[m][node].doff[2]];
- E->sphere.cap[m].V[3][node] = E->U[m][E->id[m][node].doff[3]];
- if (E->node[m][node] & VBX)
- E->sphere.cap[m].V[1][node] = E->sphere.cap[m].VB[1][node];
- if (E->node[m][node] & VBY)
- E->sphere.cap[m].V[2][node] = E->sphere.cap[m].VB[2][node];
- if (E->node[m][node] & VBZ)
- E->sphere.cap[m].V[3][node] = E->sphere.cap[m].VB[3][node];
- }
- }
-
- return;
-}
-
-void v_from_vector_pseudo_surf(E)
- struct All_variables *E;
-{
- int m,node;
-
- const int nno = E->lmesh.nno;
- double sum_V = 0.0, sum_dV = 0.0, rel_error = 0.0, global_max_error = 0.0;
- double tol_error = 1.0e-03;
-
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- for(node=1;node<=nno;node++) {
- E->sphere.cap[m].Vprev[1][node] = E->sphere.cap[m].V[1][node];
- E->sphere.cap[m].Vprev[2][node] = E->sphere.cap[m].V[2][node];
- E->sphere.cap[m].Vprev[3][node] = E->sphere.cap[m].V[3][node];
-
- E->sphere.cap[m].V[1][node] = E->U[m][E->id[m][node].doff[1]];
- E->sphere.cap[m].V[2][node] = E->U[m][E->id[m][node].doff[2]];
- E->sphere.cap[m].V[3][node] = E->U[m][E->id[m][node].doff[3]];
- if (E->node[m][node] & VBX)
- E->sphere.cap[m].V[1][node] = E->sphere.cap[m].VB[1][node];
- if (E->node[m][node] & VBY)
- E->sphere.cap[m].V[2][node] = E->sphere.cap[m].VB[2][node];
- if (E->node[m][node] & VBZ)
- E->sphere.cap[m].V[3][node] = E->sphere.cap[m].VB[3][node];
-
- sum_dV += (E->sphere.cap[m].V[1][node] - E->sphere.cap[m].Vprev[1][node])*(E->sphere.cap[m].V[1][node] - E->sphere.cap[m].Vprev[1][node])
- + (E->sphere.cap[m].V[2][node] - E->sphere.cap[m].Vprev[2][node])*(E->sphere.cap[m].V[2][node] - E->sphere.cap[m].Vprev[2][node])
- + (E->sphere.cap[m].V[3][node] - E->sphere.cap[m].Vprev[3][node])*(E->sphere.cap[m].V[3][node] - E->sphere.cap[m].Vprev[3][node]);
- sum_V += E->sphere.cap[m].V[1][node]*E->sphere.cap[m].V[1][node]
- + E->sphere.cap[m].V[2][node]*E->sphere.cap[m].V[2][node]
- + E->sphere.cap[m].V[3][node]*E->sphere.cap[m].V[3][node];
- }
- rel_error = sqrt(sum_dV)/sqrt(sum_V);
- MPI_Allreduce(&rel_error,&global_max_error,1,MPI_DOUBLE,MPI_MAX,E->parallel.world);
- if(global_max_error <= tol_error) E->monitor.stop_topo_loop = 1;
- if(E->parallel.me==0)
- fprintf(stderr,"global_max_error=%e stop_topo_loop=%d\n",global_max_error,E->monitor.stop_topo_loop);
-
- }
-
- return;
-}
-/* cartesian velocities within element, single prec version */
-void velo_from_element(E,VV,m,el,sphere_key)
- struct All_variables *E;
- float VV[4][9];
- int el,m,sphere_key;
-{
-
- int a, node;
- double sint, cost, sinf, cosf;
- const int ends=enodes[E->mesh.nsd];
- const int lev=E->mesh.levmax;
-
- if (sphere_key)
- for(a=1;a<=ends;a++) {
- node = E->ien[m][el].node[a];
- VV[1][a] = E->sphere.cap[m].V[1][node];
- VV[2][a] = E->sphere.cap[m].V[2][node];
- VV[3][a] = E->sphere.cap[m].V[3][node];
- }
- else {
- for(a=1;a<=ends;a++) {
- node = E->ien[m][el].node[a];
-
- sint = E->SinCos[lev][m][0][node];
- sinf = E->SinCos[lev][m][1][node];
- cost = E->SinCos[lev][m][2][node];
- cosf = E->SinCos[lev][m][3][node];
-
- VV[1][a] = E->sphere.cap[m].V[1][node]*cost*cosf
- - E->sphere.cap[m].V[2][node]*sinf
- + E->sphere.cap[m].V[3][node]*sint*cosf;
- VV[2][a] = E->sphere.cap[m].V[1][node]*cost*sinf
- + E->sphere.cap[m].V[2][node]*cosf
- + E->sphere.cap[m].V[3][node]*sint*sinf;
- VV[3][a] = -E->sphere.cap[m].V[1][node]*sint
- + E->sphere.cap[m].V[3][node]*cost;
- }
- }
- return;
-}
-
-/* double prec version */
-void velo_from_element_d(E,VV,m,el,sphere_key)
- struct All_variables *E;
- double VV[4][9];
- int el,m,sphere_key;
-{
-
- int a, node;
- double sint, cost, sinf, cosf;
- const int dims=E->mesh.nsd;
- const int ends=enodes[E->mesh.nsd];
- const int nno=E->lmesh.nno;
- const int lev=E->mesh.levmax;
-
- if (sphere_key)
- for(a=1;a<=ends;a++) {
- node = E->ien[m][el].node[a];
- VV[1][a] = E->sphere.cap[m].V[1][node];
- VV[2][a] = E->sphere.cap[m].V[2][node];
- VV[3][a] = E->sphere.cap[m].V[3][node];
- }
- else {
- for(a=1;a<=ends;a++) {
- node = E->ien[m][el].node[a];
-
- sint = E->SinCos[lev][m][0][node];
- sinf = E->SinCos[lev][m][1][node];
- cost = E->SinCos[lev][m][2][node];
- cosf = E->SinCos[lev][m][3][node];
-
- VV[1][a] = E->sphere.cap[m].V[1][node]*cost*cosf
- - E->sphere.cap[m].V[2][node]*sinf
- + E->sphere.cap[m].V[3][node]*sint*cosf;
- VV[2][a] = E->sphere.cap[m].V[1][node]*cost*sinf
- + E->sphere.cap[m].V[2][node]*cosf
- + E->sphere.cap[m].V[3][node]*sint*sinf;
- VV[3][a] = -E->sphere.cap[m].V[1][node]*sint
- + E->sphere.cap[m].V[3][node]*cost;
- }
- }
- return;
-}
-
-
-void p_to_nodes(E,P,PN,lev)
- struct All_variables *E;
- double **P;
- float **PN;
- int lev;
-
-{ int e,element,node,j,m;
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for(node=1;node<=E->lmesh.NNO[lev];node++)
- PN[m][node] = 0.0;
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for(element=1;element<=E->lmesh.NEL[lev];element++)
- for(j=1;j<=enodes[E->mesh.nsd];j++) {
- node = E->IEN[lev][m][element].node[j];
- PN[m][node] += P[m][element] * E->TWW[lev][m][element].node[j] ;
- }
-
- (E->exchange_node_f)(E,PN,lev);
-
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(node=1;node<=E->lmesh.NNO[lev];node++)
- PN[m][node] *= E->MASS[lev][m][node];
-
- return;
-}
-
-
-
-void visc_from_gint_to_nodes(E,VE,VN,lev)
- struct All_variables *E;
- float **VE,**VN;
- int lev;
- {
- int m,e,i,j,k,n;
- const int nsd=E->mesh.nsd;
- const int vpts=vpoints[nsd];
- const int ends=enodes[nsd];
- double temp_visc;
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=1;i<=E->lmesh.NNO[lev];i++)
- VN[m][i] = 0.0;
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for(e=1;e<=E->lmesh.NEL[lev];e++) {
- temp_visc=0.0;
- for(i=1;i<=vpts;i++)
- temp_visc += VE[m][(e-1)*vpts + i];
- temp_visc = temp_visc/vpts;
-
- for(j=1;j<=ends;j++) {
- n = E->IEN[lev][m][e].node[j];
- VN[m][n] += E->TWW[lev][m][e].node[j] * temp_visc;
- }
- }
-
- (E->exchange_node_f)(E,VN,lev);
-
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(n=1;n<=E->lmesh.NNO[lev];n++)
- VN[m][n] *= E->MASS[lev][m][n];
-
- return;
-}
-
-
-void visc_from_nodes_to_gint(E,VN,VE,lev)
- struct All_variables *E;
- float **VE,**VN;
- int lev;
- {
-
- int m,e,i,j,k,n;
- const int nsd=E->mesh.nsd;
- const int vpts=vpoints[nsd];
- const int ends=enodes[nsd];
- double temp_visc;
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for(e=1;e<=E->lmesh.NEL[lev];e++)
- for(i=1;i<=vpts;i++)
- VE[m][(e-1)*vpts+i] = 0.0;
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for(e=1;e<=E->lmesh.NEL[lev];e++)
- for(i=1;i<=vpts;i++) {
- temp_visc=0.0;
- for(j=1;j<=ends;j++)
- temp_visc += E->N.vpt[GNVINDEX(j,i)]*VN[m][E->IEN[lev][m][e].node[j]];
-
- VE[m][(e-1)*vpts+i] = temp_visc;
- }
-
- return;
- }
-
-void visc_from_gint_to_ele(E,VE,VN,lev)
- struct All_variables *E;
- float **VE,**VN;
- int lev;
- {
- int m,e,i,j,k,n;
- const int nsd=E->mesh.nsd;
- const int vpts=vpoints[nsd];
- const int ends=enodes[nsd];
- double temp_visc;
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=1;i<=E->lmesh.NEL[lev];i++)
- VN[m][i] = 0.0;
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for(e=1;e<=E->lmesh.NEL[lev];e++) {
- temp_visc=0.0;
- for(i=1;i<=vpts;i++)
- temp_visc += VE[m][(e-1)*vpts + i];
- temp_visc = temp_visc/vpts;
-
- VN[m][e] = temp_visc;
- }
-
- return;
-}
-
-
-void visc_from_ele_to_gint(E,VN,VE,lev)
- struct All_variables *E;
- float **VE,**VN;
- int lev;
- {
-
- int m,e,i,j,k,n;
- const int nsd=E->mesh.nsd;
- const int vpts=vpoints[nsd];
- const int ends=enodes[nsd];
- double temp_visc;
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for(e=1;e<=E->lmesh.NEL[lev];e++)
- for(i=1;i<=vpts;i++)
- VE[m][(e-1)*vpts+i] = 0.0;
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for(e=1;e<=E->lmesh.NEL[lev];e++)
- for(i=1;i<=vpts;i++) {
-
- VE[m][(e-1)*vpts+i] = VN[m][e];
- }
-
- return;
- }
Copied: mc/3D/CitcomS/branches/cxx/lib/Nodal_mesh.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Nodal_mesh.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Nodal_mesh.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Nodal_mesh.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,344 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+/* Functions relating to the building and use of mesh locations ... */
+
+
+#include <math.h>
+#include <sys/types.h>
+#include "element_definitions.h"
+#include "global_defs.h"
+
+
+/* get nodal spherical velocities from the solution vector */
+void v_from_vector(struct All_variables *E)
+{
+ int m,node;
+ const int nno = E->lmesh.nno;
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ for(node=1;node<=nno;node++) {
+ E->sphere.cap[m].V[1][node] = E->U[m][E->id[m][node].doff[1]];
+ E->sphere.cap[m].V[2][node] = E->U[m][E->id[m][node].doff[2]];
+ E->sphere.cap[m].V[3][node] = E->U[m][E->id[m][node].doff[3]];
+ if (E->node[m][node] & VBX)
+ E->sphere.cap[m].V[1][node] = E->sphere.cap[m].VB[1][node];
+ if (E->node[m][node] & VBY)
+ E->sphere.cap[m].V[2][node] = E->sphere.cap[m].VB[2][node];
+ if (E->node[m][node] & VBZ)
+ E->sphere.cap[m].V[3][node] = E->sphere.cap[m].VB[3][node];
+ }
+ }
+
+ return;
+}
+
+void v_from_vector_pseudo_surf(struct All_variables *E)
+{
+ int m,node;
+
+ const int nno = E->lmesh.nno;
+ double sum_V = 0.0, sum_dV = 0.0, rel_error = 0.0, global_max_error = 0.0;
+ double tol_error = 1.0e-03;
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ for(node=1;node<=nno;node++) {
+ E->sphere.cap[m].Vprev[1][node] = E->sphere.cap[m].V[1][node];
+ E->sphere.cap[m].Vprev[2][node] = E->sphere.cap[m].V[2][node];
+ E->sphere.cap[m].Vprev[3][node] = E->sphere.cap[m].V[3][node];
+
+ E->sphere.cap[m].V[1][node] = E->U[m][E->id[m][node].doff[1]];
+ E->sphere.cap[m].V[2][node] = E->U[m][E->id[m][node].doff[2]];
+ E->sphere.cap[m].V[3][node] = E->U[m][E->id[m][node].doff[3]];
+ if (E->node[m][node] & VBX)
+ E->sphere.cap[m].V[1][node] = E->sphere.cap[m].VB[1][node];
+ if (E->node[m][node] & VBY)
+ E->sphere.cap[m].V[2][node] = E->sphere.cap[m].VB[2][node];
+ if (E->node[m][node] & VBZ)
+ E->sphere.cap[m].V[3][node] = E->sphere.cap[m].VB[3][node];
+
+ sum_dV += (E->sphere.cap[m].V[1][node] - E->sphere.cap[m].Vprev[1][node])*(E->sphere.cap[m].V[1][node] - E->sphere.cap[m].Vprev[1][node])
+ + (E->sphere.cap[m].V[2][node] - E->sphere.cap[m].Vprev[2][node])*(E->sphere.cap[m].V[2][node] - E->sphere.cap[m].Vprev[2][node])
+ + (E->sphere.cap[m].V[3][node] - E->sphere.cap[m].Vprev[3][node])*(E->sphere.cap[m].V[3][node] - E->sphere.cap[m].Vprev[3][node]);
+ sum_V += E->sphere.cap[m].V[1][node]*E->sphere.cap[m].V[1][node]
+ + E->sphere.cap[m].V[2][node]*E->sphere.cap[m].V[2][node]
+ + E->sphere.cap[m].V[3][node]*E->sphere.cap[m].V[3][node];
+ }
+ rel_error = sqrt(sum_dV)/sqrt(sum_V);
+ MPI_Allreduce(&rel_error,&global_max_error,1,MPI_DOUBLE,MPI_MAX,E->parallel.world);
+ if(global_max_error <= tol_error) E->monitor.stop_topo_loop = 1;
+ if(E->parallel.me==0)
+ fprintf(stderr,"global_max_error=%e stop_topo_loop=%d\n",global_max_error,E->monitor.stop_topo_loop);
+
+ }
+
+ return;
+}
+/* cartesian velocities within element, single prec version */
+void velo_from_element(
+ struct All_variables *E,
+ float VV[4][9],
+ int m, int el, int sphere_key
+ )
+{
+
+ int a, node;
+ double sint, cost, sinf, cosf;
+ const int ends=enodes[E->mesh.nsd];
+ const int lev=E->mesh.levmax;
+
+ if (sphere_key)
+ for(a=1;a<=ends;a++) {
+ node = E->ien[m][el].node[a];
+ VV[1][a] = E->sphere.cap[m].V[1][node];
+ VV[2][a] = E->sphere.cap[m].V[2][node];
+ VV[3][a] = E->sphere.cap[m].V[3][node];
+ }
+ else {
+ for(a=1;a<=ends;a++) {
+ node = E->ien[m][el].node[a];
+
+ sint = E->SinCos[lev][m][0][node];
+ sinf = E->SinCos[lev][m][1][node];
+ cost = E->SinCos[lev][m][2][node];
+ cosf = E->SinCos[lev][m][3][node];
+
+ VV[1][a] = E->sphere.cap[m].V[1][node]*cost*cosf
+ - E->sphere.cap[m].V[2][node]*sinf
+ + E->sphere.cap[m].V[3][node]*sint*cosf;
+ VV[2][a] = E->sphere.cap[m].V[1][node]*cost*sinf
+ + E->sphere.cap[m].V[2][node]*cosf
+ + E->sphere.cap[m].V[3][node]*sint*sinf;
+ VV[3][a] = -E->sphere.cap[m].V[1][node]*sint
+ + E->sphere.cap[m].V[3][node]*cost;
+ }
+ }
+ return;
+}
+
+/* double prec version */
+void velo_from_element_d(
+ struct All_variables *E,
+ double VV[4][9],
+ int m, int el, int sphere_key
+ )
+{
+
+ int a, node;
+ double sint, cost, sinf, cosf;
+ const int dims=E->mesh.nsd;
+ const int ends=enodes[E->mesh.nsd];
+ const int nno=E->lmesh.nno;
+ const int lev=E->mesh.levmax;
+
+ if (sphere_key)
+ for(a=1;a<=ends;a++) {
+ node = E->ien[m][el].node[a];
+ VV[1][a] = E->sphere.cap[m].V[1][node];
+ VV[2][a] = E->sphere.cap[m].V[2][node];
+ VV[3][a] = E->sphere.cap[m].V[3][node];
+ }
+ else {
+ for(a=1;a<=ends;a++) {
+ node = E->ien[m][el].node[a];
+
+ sint = E->SinCos[lev][m][0][node];
+ sinf = E->SinCos[lev][m][1][node];
+ cost = E->SinCos[lev][m][2][node];
+ cosf = E->SinCos[lev][m][3][node];
+
+ VV[1][a] = E->sphere.cap[m].V[1][node]*cost*cosf
+ - E->sphere.cap[m].V[2][node]*sinf
+ + E->sphere.cap[m].V[3][node]*sint*cosf;
+ VV[2][a] = E->sphere.cap[m].V[1][node]*cost*sinf
+ + E->sphere.cap[m].V[2][node]*cosf
+ + E->sphere.cap[m].V[3][node]*sint*sinf;
+ VV[3][a] = -E->sphere.cap[m].V[1][node]*sint
+ + E->sphere.cap[m].V[3][node]*cost;
+ }
+ }
+ return;
+}
+
+
+void p_to_nodes(
+ struct All_variables *E,
+ double **P,
+ float **PN,
+ int lev
+ )
+{ int e,element,node,j,m;
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for(node=1;node<=E->lmesh.NNO[lev];node++)
+ PN[m][node] = 0.0;
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for(element=1;element<=E->lmesh.NEL[lev];element++)
+ for(j=1;j<=enodes[E->mesh.nsd];j++) {
+ node = E->IEN[lev][m][element].node[j];
+ PN[m][node] += P[m][element] * E->TWW[lev][m][element].node[j] ;
+ }
+
+ (E->exchange_node_f)(E,PN,lev);
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(node=1;node<=E->lmesh.NNO[lev];node++)
+ PN[m][node] *= E->MASS[lev][m][node];
+
+ return;
+}
+
+
+
+void visc_from_gint_to_nodes(
+ struct All_variables *E,
+ float **VE, float **VN,
+ int lev
+ )
+{
+ int m,e,i,j,k,n;
+ const int nsd=E->mesh.nsd;
+ const int vpts=vpoints[nsd];
+ const int ends=enodes[nsd];
+ double temp_visc;
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=1;i<=E->lmesh.NNO[lev];i++)
+ VN[m][i] = 0.0;
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for(e=1;e<=E->lmesh.NEL[lev];e++) {
+ temp_visc=0.0;
+ for(i=1;i<=vpts;i++)
+ temp_visc += VE[m][(e-1)*vpts + i];
+ temp_visc = temp_visc/vpts;
+
+ for(j=1;j<=ends;j++) {
+ n = E->IEN[lev][m][e].node[j];
+ VN[m][n] += E->TWW[lev][m][e].node[j] * temp_visc;
+ }
+ }
+
+ (E->exchange_node_f)(E,VN,lev);
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(n=1;n<=E->lmesh.NNO[lev];n++)
+ VN[m][n] *= E->MASS[lev][m][n];
+
+ return;
+}
+
+
+void visc_from_nodes_to_gint(
+ struct All_variables *E,
+ float **VN, float **VE,
+ int lev
+ )
+{
+
+ int m,e,i,j,k,n;
+ const int nsd=E->mesh.nsd;
+ const int vpts=vpoints[nsd];
+ const int ends=enodes[nsd];
+ double temp_visc;
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for(e=1;e<=E->lmesh.NEL[lev];e++)
+ for(i=1;i<=vpts;i++)
+ VE[m][(e-1)*vpts+i] = 0.0;
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for(e=1;e<=E->lmesh.NEL[lev];e++)
+ for(i=1;i<=vpts;i++) {
+ temp_visc=0.0;
+ for(j=1;j<=ends;j++)
+ temp_visc += E->N.vpt[GNVINDEX(j,i)]*VN[m][E->IEN[lev][m][e].node[j]];
+
+ VE[m][(e-1)*vpts+i] = temp_visc;
+ }
+
+ return;
+ }
+
+void visc_from_gint_to_ele(
+ struct All_variables *E,
+ float **VE, float **VN,
+ int lev
+ )
+{
+ int m,e,i,j,k,n;
+ const int nsd=E->mesh.nsd;
+ const int vpts=vpoints[nsd];
+ const int ends=enodes[nsd];
+ double temp_visc;
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=1;i<=E->lmesh.NEL[lev];i++)
+ VN[m][i] = 0.0;
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for(e=1;e<=E->lmesh.NEL[lev];e++) {
+ temp_visc=0.0;
+ for(i=1;i<=vpts;i++)
+ temp_visc += VE[m][(e-1)*vpts + i];
+ temp_visc = temp_visc/vpts;
+
+ VN[m][e] = temp_visc;
+ }
+
+ return;
+}
+
+
+void visc_from_ele_to_gint(
+ struct All_variables *E,
+ float **VN, float **VE,
+ int lev
+ )
+{
+
+ int m,e,i,j,k,n;
+ const int nsd=E->mesh.nsd;
+ const int vpts=vpoints[nsd];
+ const int ends=enodes[nsd];
+ double temp_visc;
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for(e=1;e<=E->lmesh.NEL[lev];e++)
+ for(i=1;i<=vpts;i++)
+ VE[m][(e-1)*vpts+i] = 0.0;
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for(e=1;e<=E->lmesh.NEL[lev];e++)
+ for(i=1;i<=vpts;i++) {
+
+ VE[m][(e-1)*vpts+i] = VN[m][e];
+ }
+
+ return;
+ }
Deleted: mc/3D/CitcomS/branches/cxx/lib/Obsolete.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Obsolete.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Obsolete.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,1532 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-/*
- This file contains functions that are no longer used in this version of
- CitcomS. To reduce compilantion time and maintanance effort, these functions
- are removed from its original location to here.
-*/
-
-
-
-/* ========================================================== */
-/* from Size_does_matter.c */
-/* =========================================================== */
-
-
-
-/* ==================================================================================
- Function to give the global shape function from the local: Assumes ORTHOGONAL MESH
- ================================================================================== */
-
-void get_global_shape_fn(E,el,GN,GNx,dOmega,pressure,sphere,rtf,lev,m)
- struct All_variables *E;
- int el,m;
- struct Shape_function *GN;
- struct Shape_function_dx *GNx;
- struct Shape_function_dA *dOmega;
- int pressure,lev,sphere;
- double rtf[4][9];
-{
- int i,j,k,d,e;
- double jacobian;
- double determinant();
- double cofactor(),myatan();
- void form_rtf_bc();
-
- struct Shape_function_dx LGNx;
-
- double dxda[4][4],cof[4][4],x[4],bc[4][4];
-
-
- const int dims=E->mesh.nsd;
- const int ends=enodes[dims];
- const int vpts=vpoints[dims];
- const int ppts=ppoints[dims];
-
-
- if(pressure < 2) {
- for(k=1;k<=vpts;k++) { /* all of the vpoints */
- for(d=1;d<=dims;d++) {
- x[d]=0.0;
- for(e=1;e<=dims;e++)
- dxda[d][e]=0.0;
- }
-
- for(d=1;d<=dims;d++)
- for(i=1;i<=ends;i++)
- x[d] += E->X[lev][m][d][E->IEN[lev][m][el].node[i]]*
- E->N.vpt[GNVINDEX(i,k)];
-
- for(d=1;d<=dims;d++)
- for(e=1;e<=dims;e++)
- for(i=1;i<=ends;i++)
- dxda[d][e] += E->X[lev][m][e][E->IEN[lev][m][el].node[i]]
- * E->Nx.vpt[GNVXINDEX(d-1,i,k)];
-
- jacobian = determinant(dxda,E->mesh.nsd);
- dOmega->vpt[k] = jacobian;
-
- for(d=1;d<=dims;d++)
- for(e=1;e<=dims;e++)
- cof[d][e]=cofactor(dxda,d,e,dims);
-
- if (sphere) {
-
- form_rtf_bc(k,x,rtf,bc);
- for(j=1;j<=ends;j++)
- for(d=1;d<=dims;d++) {
- LGNx.vpt[GNVXINDEX(d-1,j,k)] = 0.0;
- for(e=1;e<=dims;e++)
- LGNx.vpt[GNVXINDEX(d-1,j,k)] +=
- E->Nx.vpt[GNVXINDEX(e-1,j,k)] *cof[e][d];
-
- LGNx.vpt[GNVXINDEX(d-1,j,k)] /= jacobian;
- }
-
- for(j=1;j<=ends;j++)
- for(d=1;d<=dims;d++) {
- GNx->vpt[GNVXINDEX(d-1,j,k)] =
- bc[d][1]*LGNx.vpt[GNVXINDEX(0,j,k)]
- + bc[d][2]*LGNx.vpt[GNVXINDEX(1,j,k)]
- + bc[d][3]*LGNx.vpt[GNVXINDEX(2,j,k)];
- }
- }
- else {
- for(j=1;j<=ends;j++)
- for(d=1;d<=dims;d++) {
- GNx->vpt[GNVXINDEX(d-1,j,k)] = 0.0;
- for(e=1;e<=dims;e++)
- GNx->vpt[GNVXINDEX(d-1,j,k)] +=
- E->Nx.vpt[GNVXINDEX(e-1,j,k)] *cof[e][d];
-
- GNx->vpt[GNVXINDEX(d-1,j,k)] /= jacobian;
- }
- }
- } /* end for k */
- } /* end for pressure */
-
- if(pressure > 0 && pressure < 3) {
- for(k=1;k<=ppts;k++) { /* all of the ppoints */
- for(d=1;d<=dims;d++) {
- x[d]=0.0;
- for(e=1;e<=dims;e++)
- dxda[d][e]=0.0;
- }
-
- for(d=1;d<=dims;d++)
- for(i=1;i<=ends;i++)
- x[d] += E->X[lev][m][d][E->IEN[lev][m][el].node[i]]
- *E->N.ppt[GNPINDEX(i,k)];
-
- for(d=1;d<=dims;d++)
- for(e=1;e<=dims;e++)
- for(i=1;i<=ends;i++)
- dxda[d][e] += E->X[lev][m][e][E->IEN[lev][m][el].node[i]]
- * E->Nx.ppt[GNPXINDEX(d-1,i,k)];
-
- jacobian = determinant(dxda,E->mesh.nsd);
- dOmega->ppt[k] = jacobian;
-
- for(d=1;d<=dims;d++)
- for(e=1;e<=dims;e++)
- cof[d][e]=cofactor(dxda,d,e,E->mesh.nsd);
-
- if (sphere) {
- form_rtf_bc(k,x,rtf,bc);
- for(j=1;j<=ends;j++)
- for(d=1;d<=dims;d++) {
- LGNx.ppt[GNPXINDEX(d-1,j,k)]=0.0;
- for(e=1;e<=dims;e++)
- LGNx.ppt[GNPXINDEX(d-1,j,k)] +=
- E->Nx.ppt[GNPXINDEX(e-1,j,k)]*cof[e][d];
- LGNx.ppt[GNPXINDEX(d-1,j,k)] /= jacobian;
- }
- for(j=1;j<=ends;j++)
- for(d=1;d<=dims;d++) {
- GNx->ppt[GNPXINDEX(d-1,j,k)]
- = bc[d][1]*LGNx.ppt[GNPXINDEX(0,j,k)]
- + bc[d][2]*LGNx.ppt[GNPXINDEX(1,j,k)]
- + bc[d][3]*LGNx.ppt[GNPXINDEX(2,j,k)];
- }
- }
-
- else {
- for(j=1;j<=ends;j++)
- for(d=1;d<=dims;d++) {
- GNx->ppt[GNPXINDEX(d-1,j,k)]=0.0;
- for(e=1;e<=dims;e++)
- GNx->ppt[GNPXINDEX(d-1,j,k)] +=
- E->Nx.ppt[GNPXINDEX(e-1,j,k)]*cof[e][d];
- GNx->ppt[GNPXINDEX(d-1,j,k)] /= jacobian;
- }
- }
-
- } /* end for k int */
- } /* end for pressure */
-
-
- return;
-}
-
-
-void get_global_1d_shape_fn_1(E,el,GM,dGammax,nodal,m)
- struct All_variables *E;
- int el,nodal,m;
- struct Shape_function *GM;
- struct Shape_function_dA *dGammax;
-{
- int i,k,d,e,h,l,kk;
-
- double jacobian;
- double determinant();
- double cofactor();
- double **dmatrix();
-
- const int dims=E->mesh.nsd,dofs=E->mesh.dof;
- const int ends=enodes[dims];
-
- double dxda[4][4],cof[4][4];
-
-
- for(k=1;k<=vpoints[E->mesh.nsd];k++) {
-
- for(d=1;d<=dims;d++)
- for(e=1;e<=dims;e++) {
- dxda[d][e] = 0.0;
- for(i=1;i<=ends;i++)
- dxda[d][e] += E->NMx.vpt[GNVXINDEX(d-1,i,k)]
- * E->x[m][e][E->ien[m][el].node[i]];
- }
-
- for(d=1;d<=dims;d++)
- for(e=1;e<=dims;e++) {
- cof[d][e] = 0.0;
- for(h=1;h<=dims;h++)
- cof[d][e] += dxda[d][h]*dxda[e][h];
- }
-
- if (cof[3][3]!=0.0)
- jacobian = sqrt(fabs(determinant(cof,E->mesh.nsd)))/cof[3][3];
-
- dGammax->vpt[k] = jacobian;
-
- }
-
- return;
-}
-
-
-/* ======================================================================
- For calculating pressure boundary term --- Choi, 11/13/02
- ====================================================================== */
-void get_global_side_1d_shape_fn(E,el,GM,GMx,dGamma,NS,far,m)
- struct All_variables *E;
- int el,far,m,NS;
- struct Shape_function1 *GM;
- struct Shape_function1_dx *GMx;
- struct Shape_function_side_dA *dGamma;
-{
- int ii,i,j,k,d,a,e,node;
-
- double jacobian;
- double determinant();
- double cofactor();
- void form_rtf_bc();
-
- struct Shape_function1 LGM;
- struct Shape_function1_dx LGMx;
-
- int dims[2][3];
- int *elist[3];
- const int oned = onedvpoints[E->mesh.nsd];
- const int vpts = vpoints[E->mesh.nsd-1];
- const int ppts = ppoints[E->mesh.nsd-1];
- const int ends = enodes[E->mesh.nsd-1];
- double to,fo,ro,xx[4][5],dxda[4][4],dxdy[4][4];
-
- /******************************************/
- elist[0] = (int *)malloc(9*sizeof(int));
- elist[1] = (int *)malloc(9*sizeof(int));
- elist[2] = (int *)malloc(9*sizeof(int));
- /*for NS boundary elements */
- elist[0][0]=0; elist[0][1]=1; elist[0][2]=4; elist[0][3]=8; elist[0][4]=5;
- elist[0][5]=2; elist[0][6]=3; elist[0][7]=7; elist[0][8]=6;
- /*for EW boundary elements */
- elist[1][0]=0; elist[1][1]=1; elist[1][2]=2; elist[1][3]=6; elist[1][4]=5;
- elist[1][5]=4; elist[1][6]=3; elist[1][7]=7; elist[1][8]=8;
- /*for TB boundary elements */
- elist[2][0]=0; elist[2][1]=1; elist[2][2]=2; elist[2][3]=3; elist[2][4]=4;
- elist[2][5]=5; elist[2][6]=6; elist[2][7]=7; elist[2][8]=8;
- /******************************************/
-
- to = E->eco[m][el].centre[1];
- fo = E->eco[m][el].centre[2];
- ro = E->eco[m][el].centre[3];
-
- dxdy[1][1] = cos(to)*cos(fo);
- dxdy[1][2] = cos(to)*sin(fo);
- dxdy[1][3] = -sin(to);
- dxdy[2][1] = -sin(fo);
- dxdy[2][2] = cos(fo);
- dxdy[2][3] = 0.0;
- dxdy[3][1] = sin(to)*cos(fo);
- dxdy[3][2] = sin(to)*sin(fo);
- dxdy[3][3] = cos(to);
-
- /*for side elements*/
- for(i=1;i<=ends;i++) {
- a = elist[NS][i+far*ends];
- node=E->ien[m][el].node[a];
- xx[1][i] = E->x[m][1][node]*dxdy[1][1]
- + E->x[m][2][node]*dxdy[1][2]
- + E->x[m][3][node]*dxdy[1][3];
- xx[2][i] = E->x[m][1][node]*dxdy[2][1]
- + E->x[m][2][node]*dxdy[2][2]
- + E->x[m][3][node]*dxdy[2][3];
- xx[3][i] = E->x[m][1][node]*dxdy[3][1]
- + E->x[m][2][node]*dxdy[3][2]
- + E->x[m][3][node]*dxdy[3][3];
- }
-
- for(k=1;k<=oned;k++) {
- for(d=1;d<=E->mesh.nsd-1;d++)
- for(e=1;e<=E->mesh.nsd-1;e++)
- dxda[d][e]=0.0;
-
- if(NS==0) {
- for(i=1;i<=oned;i++) {
- dims[NS][1]=2; dims[NS][2]=3;
- for(d=1;d<=E->mesh.nsd-1;d++)
- for(e=1;e<=E->mesh.nsd-1;e++) {
- dxda[d][e] += xx[dims[NS][e]][i]*E->Mx.vpt[GMVXINDEX(d-1,i,k)];
- }
- }
- }
- else if(NS==1) {
- for(i=1;i<=oned;i++) {
- dims[NS][1]=1; dims[NS][2]=3;
- for(d=1;d<=E->mesh.nsd-1;d++)
- for(e=1;e<=E->mesh.nsd-1;e++) {
- dxda[d][e] += xx[dims[NS][e]][i]*E->Mx.vpt[GMVXINDEX(d-1,i,k)];
- }
- }
- }
- else if(NS==2) {
- for(i=1;i<=oned;i++) {
- dims[NS][1]=1; dims[NS][2]=2;
- for(d=1;d<=E->mesh.nsd-1;d++)
- for(e=1;e<=E->mesh.nsd-1;e++) {
- dxda[d][e] += xx[dims[NS][e]][i]*E->Mx.vpt[GMVXINDEX(d-1,i,k)];
- }
- }
- }
-
- jacobian = determinant(dxda,E->mesh.nsd-1);
- dGamma->vpt[k] = jacobian;
- }
-
- for(i=1;i<=ppts;i++) { /* all of the ppoints*/
- for(d=1;d<=E->mesh.nsd-1;d++)
- for(e=1;e<=E->mesh.nsd-1;e++)
- dxda[d][e]=0.0;
-
- if(NS==0) {
- for(k=1;k<=ends;k++) {
- dims[NS][1]=2; dims[NS][2]=3;
- for(d=1;d<=E->mesh.nsd-1;d++)
- for(e=1;e<=E->mesh.nsd-1;e++)
- dxda[d][e] += xx[dims[NS][e]][k]*E->Mx.ppt[GMPXINDEX(d-1,k,i)];
- }
- }
- else if(NS==1) {
- for(k=1;k<=ends;k++) {
- dims[NS][1]=1; dims[NS][2]=3;
- for(d=1;d<=E->mesh.nsd-1;d++)
- for(e=1;e<=E->mesh.nsd-1;e++) {
- a = elist[NS][k+far*ends];
- node=E->ien[m][el].node[a];
- dxda[d][e] += xx[dims[NS][e]][k]*E->Mx.ppt[GMPXINDEX(d-1,k,i)];
- }
- }
- }
- else if(NS==2) {
- for(k=1;k<=ends;k++) {
- dims[NS][1]=1; dims[NS][2]=2;
- for(d=1;d<=E->mesh.nsd-1;d++)
- for(e=1;e<=E->mesh.nsd-1;e++) {
- a = elist[NS][k+far*ends];
- node=E->ien[m][el].node[a];
- dxda[d][e] += xx[dims[NS][e]][k]*E->Mx.ppt[GMPXINDEX(d-1,k,i)];
- }
- }
- }
-
- jacobian = determinant(dxda,E->mesh.nsd-1);
- dGamma->ppt[i] = jacobian;
- }
-
- for(i=0;i<3;i++)
- free((void *) elist[i]);
-
- return;
-}
-
-
-
-/* ========================================================== */
-/* from Element_calculations.c */
-/* =========================================================== */
-
-/* ===============================================================
- Function to create the element pressure-forcing vector (due
- to imposed velocity boundary conditions, mixed method).
- =============================================================== */
-
-void get_elt_h(E,el,elt_h,m)
- struct All_variables *E;
- int el,m;
- double elt_h[1];
-{
- int i,p,a,b,q,got_g;
- unsigned int type;
- higher_precision elt_g[24][1];
- void get_elt_g();
-
- for(p=0;p<1;p++) elt_h[p] = 0.0;
-
- got_g = 0;
-
- type=VBX;
- for(i=1;i<=E->mesh.nsd;i++)
- { for(a=1;a<=enodes[E->mesh.nsd];a++)
- { if (E->node[m][E->ien[m][el].node[a]] & type)
- { if(!got_g)
- { get_elt_g(E,el,elt_g,E->mesh.levmax,m);
- got_g++;
- }
-
- p=E->mesh.nsd*(a-1) + i - 1;
- for(b=1;b<=pnodes[E->mesh.nsd];b++)
- { q = b-1;
- elt_h[q] -= elt_g[p][q] * E->sphere.cap[m].VB[i][E->ien[m][el].node[a]];
- }
- }
- }
- type *= (unsigned int) 2;
- }
- return;
-}
-
-/* ========================================================== */
-/* from Process_velocity.c */
-/* =========================================================== */
-
-void get_ele_visc(E, EV,m)
- struct All_variables *E;
- float *EV;
- int m;
- {
-
- int el,j,lev;
-
- const int nel=E->lmesh.nel;
- const int vpts=vpoints[E->mesh.nsd];
-
- lev = E->mesh.levmax;
-
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for (el=1;el<=nel;el++) {
- EV[el] = 0.0;
- for (j=1;j<=vpts;j++) {
- EV[el] += E->EVI[lev][m][(el-1)*vpts+j];
- }
-
- EV[el] /= vpts;
- }
-
- return;
- }
-
-
-/* ========================================================== */
-/* From Sphere_harmonics.c */
-/* =========================================================== */
-
-
-
-/* This function construct sph harm tables on a regular grid */
-/* for inverse interpolation */
-
-static void compute_sphereh_int_table(E)
- struct All_variables *E;
-{
- int i,j;
- double t,f;
- double dth,dfi,sqrt_multis();
-
- E->sphere.con = (double *)malloc(E->sphere.hindice*sizeof(double));
- for (ll=0;ll<=E->output.llmax;ll++)
- for (mm=0;mm<=ll;mm++) {
- E->sphere.con[E->sphere.hindex[ll][mm]] =
- sqrt( (2.0-((mm==0)?1.0:0.0))*(2*ll+1)/(4.0*M_PI) )
- *sqrt_multis(ll+mm,ll-mm); /* which is sqrt((ll-mm)!/(ll+mm)!) */
- }
-
- E->sphere.tablenplm = (double **) malloc((E->sphere.nox+1)
- *sizeof(double*));
- for (i=1;i<=E->sphere.nox;i++)
- E->sphere.tablenplm[i]= (double *)malloc(E->sphere.hindice
- *sizeof(double));
-
- E->sphere.tablencosf = (double **) malloc((E->sphere.noy+1)
- *sizeof(double*));
- E->sphere.tablensinf = (double **) malloc((E->sphere.noy+1)
- *sizeof(double*));
- for (i=1;i<=E->sphere.noy;i++) {
- E->sphere.tablencosf[i]= (double *)malloc((E->output.llmax+3)
- *sizeof(double));
- E->sphere.tablensinf[i]= (double *)malloc((E->output.llmax+3)
- *sizeof(double));
- }
-
- E->sphere.sx[1] = (double *) malloc((E->sphere.nsf+1)*sizeof(double));
- E->sphere.sx[2] = (double *) malloc((E->sphere.nsf+1)*sizeof(double));
-
- dth = M_PI/E->sphere.elx;
- dfi = 2.0*M_PI/E->sphere.ely;
-
- for (j=1;j<=E->sphere.noy;j++)
- for (i=1;i<=E->sphere.nox;i++) {
- node = i+(j-1)*E->sphere.nox;
- E->sphere.sx[1][node] = dth*(i-1);
- E->sphere.sx[2][node] = dfi*(j-1);
- }
-
- for (j=1;j<=E->sphere.nox;j++) {
- t=E->sphere.sx[1][j];
- for (ll=0;ll<=E->output.llmax;ll++)
- for (mm=0;mm<=ll;mm++) {
- p = E->sphere.hindex[ll][mm];
- E->sphere.tablenplm[j][p] = modified_plgndr_a(ll,mm,t) ;
- }
- }
- for (j=1;j<=E->sphere.noy;j++) {
- node = 1+(j-1)*E->sphere.nox;
- f=E->sphere.sx[2][node];
- for (mm=0;mm<=E->output.llmax;mm++) {
- E->sphere.tablencosf[j][mm] = cos( (double)(mm)*f );
- E->sphere.tablensinf[j][mm] = sin( (double)(mm)*f );
- }
- }
-}
-
-
-/* ================================================
- for a given node, this routine gives which cap and element
- the node is in.
- ================================================*/
-void construct_interp_net(E)
- struct All_variables *E;
-{
-
- void parallel_process_termination();
- void parallel_process_sync();
- int ii,jj,es,i,j,m,el,node;
- int locate_cap(),locate_element();
- double x[4],t,f;
-
- const int ends=4;
-
- for (i=1;i<=E->sphere.nox;i++)
- for (j=1;j<=E->sphere.noy;j++) {
- node = i+(j-1)*E->sphere.nox;
- E->sphere.int_cap[node]=0;
- E->sphere.int_ele[node]=0;
- }
-
-
- for (i=1;i<=E->sphere.nox;i++)
- for (j=1;j<=E->sphere.noy;j++) {
- node = i+(j-1)*E->sphere.nox;
-
- /* first find which cap this node (i,j) is in */
- t = E->sphere.sx[1][node];
- f = E->sphere.sx[2][node];
-
- x[1] = sin(t)*cos(f); /* radius does not matter */
- x[2] = sin(t)*sin(f);
- x[3] = cos(t);
-
-
- fprintf(E->fp,"mmm0=%d\n",node);
-
- m = locate_cap(E,x);
-
- fprintf(E->fp,"mmm=%d\n",m);
-
- if (m>0) {
- el = locate_element(E,m,x,node); /* bottom element */
-
- if (el<=0) {
- fprintf(stderr,"!!! Processor %d cannot find the right element in cap %d\n",E->parallel.me,m);
- parallel_process_termination();
- }
-
- E->sphere.int_cap[node]=m;
- E->sphere.int_ele[node]=el;
-
- }
- } /* end for i and j */
-
- parallel_process_sync(E);
-
- return;
-}
-
-/* ================================================
- locate the cap for node (i,j)
- ================================================*/
-
-int locate_cap(E,x)
- struct All_variables *E;
- double x[4];
-{
-
- int ia[5],i,m,mm;
- double xx[4],angle[5],angle1[5];
- double get_angle();
- double area1,rr;
- const double e_7=1.e-7;
- static int been_here=0;
-
- mm = 0;
-
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- ia[1] = 1;
- ia[2] = E->lmesh.noz*E->lmesh.nox-E->lmesh.noz+1;
- ia[3] = E->lmesh.nno-E->lmesh.noz+1;
- ia[4] = ia[3]-E->lmesh.noz*(E->lmesh.nox-1);
-
- for (i=1;i<=4;i++) {
- xx[1] = E->x[m][1][ia[i]]/E->sx[m][3][ia[1]];
- xx[2] = E->x[m][2][ia[i]]/E->sx[m][3][ia[1]];
- xx[3] = E->x[m][3][ia[i]]/E->sx[m][3][ia[1]];
- angle[i] = get_angle(x,xx); /* get angle between (i,j) and other four*/
- angle1[i]=E->sphere.angle[m][i];
- }
-
- area1 = area_of_sphere_triag(angle[1],angle[2],angle1[1])
- + area_of_sphere_triag(angle[2],angle[3],angle1[2])
- + area_of_sphere_triag(angle[3],angle[4],angle1[3])
- + area_of_sphere_triag(angle[4],angle[1],angle1[4]);
-
- if ( fabs ((area1-E->sphere.area[m])/E->sphere.area[m]) <e_7 ) {
- mm = m;
- return (mm);
- }
- }
-
- return (mm);
-}
-
-/* ================================================
- locate the element containing the node (i,j) with coord x.
- The radius is assumed to be 1 in computing the areas.
- NOTE: The returned element el is for the bottom layer.
- ================================================*/
-
-int locate_element(E,m,x,ne)
- struct All_variables *E;
- double x[4];
-int m,ne;
-{
-
- int el_temp,el,es,el_located,level,lev,lev_plus,el_plus,es_plus,i,j,node;
- double area,area1,areamin;
- double area_of_5points();
- const double e_7=1.e-7;
- const double e_6=1.e6;
-
- el_located = 0;
-
-
- level=E->mesh.levmin;
- for (es=1;es<=E->lmesh.SNEL[level];es++) {
-
- el = (es-1)*E->lmesh.ELZ[level]+1;
- area1 = area_of_5points (E,level,m,el,x,ne);
- area = E->sphere.area1[level][m][es];
-
- if(fabs ((area1-area)/area) <e_7 ) {
- for (lev=E->mesh.levmin;lev<E->mesh.levmax;lev++) {
- lev_plus = lev + 1;
- j=1;
- areamin = e_6;
- do {
- el_plus = E->EL[lev][m][el].sub[j];
-
- es_plus = (el_plus-1)/E->lmesh.ELZ[lev_plus]+1;
-
- area1 = area_of_5points(E,lev_plus,m,el_plus,x,ne);
- area = E->sphere.area1[lev_plus][m][es_plus];
-
- if(fabs(area1-area)<areamin) {
- areamin=fabs(area1-area);
- el_temp = el_plus;
- }
- j++;
- } while (j<5 && fabs((area1-area)/area) > e_7);
- el = el_plus;
- /* if exit with ..>e_7, pick the best one*/
- if (fabs((area1-area)/area) > e_7) el = el_temp;
- } /* end for loop lev */
- el_located = el;
- } /* end for if */
-
- if(el_located) break;
- } /* end for es at the coarsest level */
-
- return (el_located);
-}
-
-/* ===============================================================
- interpolate nodal T's within cap m and element el onto node with
- coordinate x[3] which is derived from a regular mesh and within
- the element el. NOTE the radius of x[3] is the inner radius.
- =============================================================== */
-
-float sphere_interpolate_point(E,T,m,el,x,ne)
- struct All_variables *E;
- float **T;
- double x[4];
-int m,el,ne;
-{
- double to,fo,y[4],yy[4][5],dxdy[4][4];
- double a1,b1,c1,d1,a2,b2,c2,d2,a,b,c,xx1,yy1,y1,y2;
- float ta,t[5];
- int es,snode,i,j,node;
-
- const int oned=4;
- const double e_7=1.e-7;
- const double four=4.0;
- const double two=2.0;
- const double one=1.0;
- const double pt25=0.25;
-
- /* first rotate the coord such that the center of element is
- the pole */
-
- es = (el-1)/E->lmesh.elz+1;
-
- to = E->eco[m][el].centre[1];
- fo = E->eco[m][el].centre[2];
-
- dxdy[1][1] = cos(to)*cos(fo);
- dxdy[1][2] = cos(to)*sin(fo);
- dxdy[1][3] = -sin(to);
- dxdy[2][1] = -sin(fo);
- dxdy[2][2] = cos(fo);
- dxdy[2][3] = 0.0;
- dxdy[3][1] = sin(to)*cos(fo);
- dxdy[3][2] = sin(to)*sin(fo);
- dxdy[3][3] = cos(to);
-
- for(i=1;i<=oned;i++) { /* nodes */
- node = E->ien[m][el].node[i];
- snode = E->sien[m][es].node[i];
- t[i] = T[m][snode];
- for (j=1;j<=E->mesh.nsd;j++)
- yy[j][i] = E->x[m][1][node]*dxdy[j][1]
- + E->x[m][2][node]*dxdy[j][2]
- + E->x[m][3][node]*dxdy[j][3];
- }
-
- for (j=1;j<=E->mesh.nsd;j++)
- y[j] = x[1]*dxdy[j][1] + x[2]*dxdy[j][2] + x[3]*dxdy[j][3];
-
- /* then for node y, determine its coordinates xx1,yy1
- in the parental element in the isoparametric element system*/
-
- a1 = yy[1][1] + yy[1][2] + yy[1][3] + yy[1][4];
- b1 = yy[1][3] + yy[1][2] - yy[1][1] - yy[1][4];
- c1 = yy[1][3] + yy[1][1] - yy[1][2] - yy[1][4];
- d1 = yy[1][3] + yy[1][4] - yy[1][1] - yy[1][2];
- a2 = yy[2][1] + yy[2][2] + yy[2][3] + yy[2][4];
- b2 = yy[2][3] + yy[2][2] - yy[2][1] - yy[2][4];
- c2 = yy[2][3] + yy[2][1] - yy[2][2] - yy[2][4];
- d2 = yy[2][3] + yy[2][4] - yy[2][1] - yy[2][2];
-
- a = d2*c1;
- b = a2*c1+b1*d2-d1*c2-d1*b2-four*c1*y[2];
- c=four*c2*y[1]-c2*a1-a1*b2+four*b2*y[1]-four*b1*y[2]+a2*b1;
-
- if (fabs(a)<e_7) {
- yy1 = -c/b;
- xx1 = (four*y[1]-a1-d1*yy1)/(b1+c1*yy1);
- }
- else {
- y1= (-b+sqrt(b*b-four*a*c))/(two*a);
- y2= (-b-sqrt(b*b-four*a*c))/(two*a);
- if (fabs(y1)>fabs(y2))
- yy1 = y2;
- else
- yy1 = y1;
- xx1 = (four*y[1]-a1-d1*yy1)/(b1+c1*yy1);
- }
-
- /* now we can calculate T at x[4] using shape function */
-
- ta = ((one-xx1)*(one-yy1)*t[1]+(one+xx1)*(one-yy1)*t[2]+
- (one+xx1)*(one+yy1)*t[3]+(one-xx1)*(one+yy1)*t[4])*pt25;
-
- /*if(fabs(xx1)>1.5 || fabs(yy1)>1.5)fprintf(E->fp_out,"ME= %d %d %d %g %g %g %g %g %g %g\n",ne,m,es,t[1],t[2],t[3],t[4],ta,xx1,yy1);
- */
- return (ta);
-}
-
-/* ===================================================================
- do the interpolation on sphere for data T, which is needed for both
- spherical harmonic expansion and graphics
- =================================================================== */
-
-void sphere_interpolate(E,T,TG)
- struct All_variables *E;
- float **T,*TG;
-{
-
- float sphere_interpolate_point();
- void gather_TG_to_me0();
- void parallel_process_termination();
-
- int ii,jj,es,i,j,m,el,node;
- double x[4],t,f;
-
- const int ends=4;
-
- TG[0] = 0.0;
- for (i=1;i<=E->sphere.nox;i++)
- for (j=1;j<=E->sphere.noy;j++) {
- node = i+(j-1)*E->sphere.nox;
- TG[node] = 0.0;
- /* first find which cap this node (i,j) is in */
-
- m = E->sphere.int_cap[node];
- el = E->sphere.int_ele[node];
-
- if (m>0 && el>0) {
- t = E->sphere.sx[1][node];
- f = E->sphere.sx[2][node];
-
- x[1] = E->sx[1][3][1]*sin(t)*cos(f);
- x[2] = E->sx[1][3][1]*sin(t)*sin(f);
- x[3] = E->sx[1][3][1]*cos(t);
-
- TG[node] = sphere_interpolate_point(E,T,m,el,x,node);
-
- }
-
- } /* end for i and j */
-
- gather_TG_to_me0(E,TG);
-
- return;
-}
-
-
-
-/* ========================================================== */
-/* From Phase_change.c */
-/* =========================================================== */
-
-
-void phase_change_410(E,B,B_b)
- struct All_variables *E;
- float **B,**B_b;
-{
- int i,j,k,n,ns,m;
- float e_pressure,pt5,one;
-
- pt5 = 0.5; one=1.0;
-
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
- for(i=1;i<=E->lmesh.nno;i++) {
- e_pressure = (E->sphere.ro-E->sx[m][3][i])-E->viscosity.z410-
- E->control.clapeyron410*(E->T[m][i]-E->control.transT410);
-
- B[m][i] = pt5*(one+tanh(E->control.width410*e_pressure));
- }
-
- ns = 0;
- for (k=1;k<=E->lmesh.noy;k++)
- for (j=1;j<=E->lmesh.nox;j++) {
- ns = ns + 1;
- B_b[m][ns]=0.0;
- for (i=1;i<E->lmesh.noz;i++) {
- n = (k-1)*E->lmesh.noz*E->lmesh.nox + (j-1)*E->lmesh.noz + i;
- if (B[m][n]>=pt5&&B[m][n+1]<=pt5)
- B_b[m][ns]=(E->sx[m][3][n+1]-E->sx[m][3][n])*(pt5-B[m][n])/(B[m][n+1]-B[m][n])+E->sx[m][3][n];
- }
- }
- }
-
-
- return;
- }
-
-
-void phase_change_670(E,B,B_b)
- struct All_variables *E;
- float **B,**B_b;
-{
- int i,j,k,n,ns,m;
- float e_pressure,pt5,one;
-
- pt5 = 0.5; one=1.0;
-
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
- for(i=1;i<=E->lmesh.nno;i++) {
- e_pressure = (E->sphere.ro-E->sx[m][3][i])-E->viscosity.zlm-
- E->control.clapeyron670*(E->T[m][i]-E->control.transT670);
-
- B[m][i] = pt5*(one+tanh(E->control.width670*e_pressure));
- }
-
- ns = 0;
- for (k=1;k<=E->lmesh.noy;k++)
- for (j=1;j<=E->lmesh.nox;j++) {
- ns = ns + 1;
- B_b[m][ns]=0.0;
- for (i=1;i<E->lmesh.noz;i++) {
- n = (k-1)*E->lmesh.noz*E->lmesh.nox + (j-1)*E->lmesh.noz + i;
- if (B[m][n]>=pt5&&B[m][n+1]<=pt5)
- B_b[m][ns]=(E->sx[m][3][n+1]-E->sx[m][3][n])*(pt5-B[m][n])/(B[m][n+1]-B[m][n])+E->sx[m][3][n];
- }
- }
- }
-
-
- return;
- }
-
-
-void phase_change_cmb(E,B,B_b)
- struct All_variables *E;
- float **B,**B_b;
-{
- int i,j,k,n,ns,m;
- float e_pressure,pt5,one;
-
- pt5 = 0.5; one=1.0;
-
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
- for(i=1;i<=E->lmesh.nno;i++) {
- e_pressure = (E->sphere.ro-E->sx[m][3][i])-E->viscosity.zcmb-
- E->control.clapeyroncmb*(E->T[m][i]-E->control.transTcmb);
-
- B[m][i] = pt5*(one+tanh(E->control.widthcmb*e_pressure));
- }
-
- ns = 0;
- for (k=1;k<=E->lmesh.noy;k++)
- for (j=1;j<=E->lmesh.nox;j++) {
- ns = ns + 1;
- B_b[m][ns]=0.0;
- for (i=1;i<E->lmesh.noz;i++) {
- n = (k-1)*E->lmesh.noz*E->lmesh.nox + (j-1)*E->lmesh.noz + i;
- if (B[m][n]>=pt5&&B[m][n+1]<=pt5)
- B_b[m][ns]=(E->sx[m][3][n+1]-E->sx[m][3][n])*(pt5-B[m][n])/(B[m][n+1]-B[m][n])+E->sx[m][3][n];
- }
- }
- }
-
- return;
-}
-
-
-/* ========================================================== */
-/* From Nodal_mesh.c */
-/* =========================================================== */
-
-void flogical_mesh_to_real(E,data,level)
- struct All_variables *E;
- float *data;
- int level;
-
-{ int i,j,n1,n2;
-
- return;
-}
-
-
-void p_to_centres(E,PN,P,lev)
- struct All_variables *E;
- float **PN;
- double **P;
- int lev;
-
-{ int p,element,node,j,m;
- double weight;
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for(p=1;p<=E->lmesh.NEL[lev];p++)
- P[m][p] = 0.0;
-
- weight=1.0/((double)enodes[E->mesh.nsd]) ;
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for(p=1;p<=E->lmesh.NEL[lev];p++)
- for(j=1;j<=enodes[E->mesh.nsd];j++)
- P[m][p] += PN[m][E->IEN[lev][m][p].node[j]] * weight;
-
- return;
- }
-
-
-void v_to_intpts(E,VN,VE,lev)
- struct All_variables *E;
- float **VN,**VE;
- int lev;
- {
-
- int m,e,i,j,k;
- const int nsd=E->mesh.nsd;
- const int vpts=vpoints[nsd];
- const int ends=enodes[nsd];
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for(e=1;e<=E->lmesh.NEL[lev];e++)
- for(i=1;i<=vpts;i++) {
- VE[m][(e-1)*vpts + i] = 0.0;
- for(j=1;j<=ends;j++)
- VE[m][(e-1)*vpts + i] += VN[m][E->IEN[lev][m][e].node[j]]*E->N.vpt[GNVINDEX(j,i)];
- }
-
- return;
- }
-
-
-void visc_to_intpts(E,VN,VE,lev)
- struct All_variables *E;
- float **VN,**VE;
- int lev;
- {
-
- int m,e,i,j,k;
- const int nsd=E->mesh.nsd;
- const int vpts=vpoints[nsd];
- const int ends=enodes[nsd];
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for(e=1;e<=E->lmesh.NEL[lev];e++)
- for(i=1;i<=vpts;i++) {
- VE[m][(e-1)*vpts + i] = 0.0;
- for(j=1;j<=ends;j++)
- VE[m][(e-1)*vpts + i] += log(VN[m][E->IEN[lev][m][e].node[j]]) * E->N.vpt[GNVINDEX(j,i)];
- VE[m][(e-1)*vpts + i] = exp(VE[m][(e-1)*vpts + i]);
- }
-
- }
-
-
-/* ========================================================== */
-/* From Pan_problem_misc_functions.c */
-/* =========================================================== */
-
-double SIN_D(x)
- double x;
-{
-#if defined(__osf__)
- return sind(x);
-#else
- return sin((x/180.0) * M_PI);
-#endif
-
-}
-
-double COT_D(x)
- double x;
-{
-#if defined(__osf__)
- return cotd(x);
-#else
- return tan(((90.0-x)/180.0) * M_PI);
-#endif
-
-}
-
-
-/* non-runaway malloc */
-
-void * Malloc1(bytes,file,line)
- int bytes;
- char *file;
- int line;
-{
- void *ptr;
-
- ptr = malloc((size_t)bytes);
- if (ptr == (void *)NULL) {
- fprintf(stderr,"Memory: cannot allocate another %d bytes \n(line %d of file %s)\n",bytes,line,file);
- parallel_process_termination();
- }
-
- return(ptr);
-}
-
-
-/* returns the out of plane component of the cross product of
- the two vectors assuming that one is looking AGAINST the
- direction of the axis of D, anti-clockwise angles
- are positive (are you sure ?), and the axes are ordered 2,3 or 1,3 or 1,2 */
-
-
-float cross2d(x11,x12,x21,x22,D)
- float x11,x12,x21,x22;
- int D;
-{
- float temp;
- if(1==D)
- temp = ( x11*x22-x12*x21);
- if(2==D)
- temp = (-x11*x22+x12*x21);
- if(3==D)
- temp = ( x11*x22-x12*x21);
-
- return(temp);
-}
-
-
-/* ========================================================== */
-/* From General_matrix_functions.c */
-/* =========================================================== */
-
-/*=====================================================================
- Variable dimension matrix allocation function from numerical recipes
- Note: ANSII consistency requires some additional features !
- ===================================================================== */
-
-double **dmatrix(nrl,nrh,ncl,nch)
- int nrl,nrh,ncl,nch;
-{
- int i,nrow = nrh-nrl+1,ncol=nch-ncl+1;
- double **m;
-
- /* allocate pointer to rows */
- m=(double **) malloc((nrow+1)* sizeof(double *));
- m+=1;
- m-= nrl;
-
- /* allocate rows and set the pointers accordingly */
- m[nrl] = (double *) malloc((nrow*ncol+1)* sizeof(double));
- m[nrl] += 1;
- m[nrl] -= ncl;
-
- for(i=nrl+1;i<=nrh;i++)
- m[i] = m[i-1] + ncol;
-
- return(m); }
-
-
-float **fmatrix(nrl,nrh,ncl,nch)
- int nrl,nrh,ncl,nch;
-{
- int i,nrow = nrh-nrl+1,ncol=nch-ncl+1;
- float **m;
-
- /* allocate pointer to rows */
- m=(float **) malloc((unsigned)((nrow+1)* sizeof(float *)));
- m+=1;
- m-= nrl;
-
- /* allocate rows and set the pointers accordingly */
- m[nrl] = (float *) malloc((unsigned)((nrow*ncol+1)* sizeof(float)));
- m[nrl] += 1;
- m[nrl] -= ncl;
-
- for(i=nrl+1;i<=nrh;i++)
- m[i] = m[i-1] + ncol;
-
- return(m); }
-
-
-void dfree_matrix(m,nrl,nrh,ncl,nch)
- double **m;
- int nrl,nrh,ncl,nch;
-{
- int i;
- for(i=nrh;i>=nrl;i--)
- free((void *)(m[i] + ncl));
- free((void *) (m+nrl));
- return;
-}
-
-void ffree_matrix(m,nrl,nrh,ncl,nch)
- float **m;
- int nrl,nrh,ncl,nch;
-{
- int i;
- for(i=nrh;i>=nrl;i--)
- free((void *)(m[i] + ncl));
- free((void *) (m+nrl));
- return;
-}
-
-/*=============================================================
- Functions to allocate/remove space for variable sized vector.
- ============================================================= */
-
-double *dvector(nl,nh)
- int nl,nh;
-{
- double *v;
- v=(double *) malloc((unsigned) ( nh - nl +1)* sizeof(double));
- return( v-nl ); }
-
-float *fvector(nl,nh)
- int nl,nh;
-{
- float *v;
- v=(float *) malloc((unsigned) ( nh - nl +1)* sizeof(float));
- return( v-nl ); }
-
-void dfree_vector(v,nl,nh)
- double *v;
- int nl,nh;
-{
- free((char*) (v+nl)); }
-
-void ffree_vector(v,nl,nh)
- float *v;
- int nl,nh;
-{
- free((char*) (v+nl)); }
-
-int *sivector(nl,nh)
- int nl,nh;
-{
- int *v;
- v=(int*) malloc((unsigned)(nh-nl +1) * sizeof(int));
- return (v-nl);
-}
-
-void sifree_vector(v,nl,nh)
- int *v;
- int nl,nh;
-{ free((char *) (v+nl)); }
-
-
-
-void dvcopy(E,A,B,a,b)
- struct All_variables *E;
- double **A,**B;
- int a,b;
-
-{ int i,m;
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=a;i<=b;i++)
- A[m][i] = B[m][i];
-
- return; }
-
-void vcopy(A,B,a,b)
- float *A,*B;
- int a,b;
-
-{ int i;
-
- for(i=a;i<=b;i++)
- A[i] = B[i];
-
- return; }
-
-
-
-/* =====================================*/
- double sphere_h(l,m,t,f,ic)
- int l,m,ic;
- double t,f;
- {
-
- double plgndr_a(),sphere_hamonics;
-
- sphere_hamonics = 0.0;
- if (ic==0)
- sphere_hamonics = cos(m*f)*plgndr_a(l,m,t);
- else if (m)
- sphere_hamonics = sin(m*f)*plgndr_a(l,m,t);
-
- return sphere_hamonics;
- }
-
-/* =====================================*/
- double plgndr_a(l,m,t)
- int l,m;
- double t;
- {
-
- int i,ll;
- double x,fact,pll,pmm,pmmp1,somx2,plgndr;
- const double two=2.0;
- const double one=1.0;
-
- x = cos(t);
- pmm=one;
- if(m>0) {
- somx2=sqrt((one-x)*(one+x));
- fact = one;
- for (i=1;i<=m;i++) {
- pmm = -pmm*fact*somx2;
- fact = fact + two;
- }
- }
-
- if (l==m)
- plgndr = pmm;
- else {
- pmmp1 = x*(2*m+1)*pmm;
- if(l==m+1)
- plgndr = pmmp1;
- else {
- for (ll=m+2;ll<=l;ll++) {
- pll = (x*(2*ll-1)*pmmp1-(ll+m-1)*pmm)/(ll-m);
- pmm = pmmp1;
- pmmp1 = pll;
- }
- plgndr = pll;
- }
- }
-
- return plgndr;
- }
-
- float area_of_4node(x1,y1,x2,y2,x3,y3,x4,y4)
- float x1,y1,x2,y2,x3,y3,x4,y4;
-
- {
- float area;
-
- area = fabs(0.5*(x1*(y2-y4)+x2*(y4-y1)+x4*(y1-y2)))
- + fabs(0.5*(x2*(y3-y4)+x3*(y4-y2)+x4*(y2-y3)));
-
- return area;
- }
-
-void print_elt_k(E,a)
- struct All_variables *E;
- double a[24*24];
-
-{ int l,ll,n;
-
- printf("elt k is ...\n");
-
-
- n = loc_mat_size[E->mesh.nsd];
-
- for(l=0;l<n;l++)
- { fprintf(stderr,"\n");fflush(stderr);
- for(ll=0;ll<n;ll++)
- { fprintf(stderr,"%s%.3e ",a[ll*n+l] >= 0.0 ? "+" : "",a[ll*n+l]);
- fflush(stderr);
- }
- }
- fprintf(stderr,"\n"); fflush(stderr);
-
- return; }
-
-
- /* =================================== */
- double sqrt_multis(jj,ii)
- int ii,jj;
- {
- int i;
- double sqrt_multisa;
-
- sqrt_multisa = 1.0;
- if(jj>ii)
- for (i=jj;i>ii;i--)
- sqrt_multisa *= 1.0/sqrt((double)i);
-
- return sqrt_multisa;
- }
-
- /* =================================== */
- double multis(ii)
- int ii;
- {
- int i;
- double multisa;
-
- multisa = 1.0;
- if (ii)
- for (i=2;i<=ii;i++)
- multisa *= (double)i;
-
- return multisa;
- }
-
-
- /* =================================== */
- int int_multis(ii)
- int ii;
- {
- int i,multisa;
-
- multisa = 1;
- if (ii)
- for (i=2;i<=ii;i++)
- multisa *= i;
-
- return multisa;
- }
-
-
-void jacobi(E,d0,F,Ad,acc,cycles,level,guess)
- struct All_variables *E;
- double **d0;
- double **F,**Ad;
- double acc;
- int *cycles;
- int level;
- int guess;
-{
-
- int count,i,j,k,l,m,ns,steps;
- int *C;
- int eqn1,eqn2,eqn3,gneq;
-
- void n_assemble_del2_u();
-
- double sum1,sum2,sum3,residual,global_vdot(),U1,U2,U3;
-
- double *r1[NCS];
-
- higher_precision *B1,*B2,*B3;
-
-
- const int dims=E->mesh.nsd;
- const int ends=enodes[dims];
- const int n=loc_mat_size[E->mesh.nsd];
- const int neq=E->lmesh.NEQ[level];
- const int num_nodes=E->lmesh.NNO[level];
- const int nox=E->lmesh.NOX[level];
- const int noz=E->lmesh.NOY[level];
- const int noy=E->lmesh.NOZ[level];
- const int max_eqn=14*dims;
-
- gneq = E->mesh.NEQ[level];
-
- steps=*cycles;
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- r1[m] = (double *)malloc(E->lmesh.neq*sizeof(double));
-
- if(guess) {
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- d0[m][neq]=0.0;
- n_assemble_del2_u(E,d0,Ad,level,1);
- }
- else
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=0;i<=neq;i++) {
- d0[m][i]=Ad[m][i]=0.0;
- }
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=0;i<neq;i++)
- r1[m][i]=F[m][i]-Ad[m][i];
-
-
- count = 0;
-
- while (count < steps) {
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=1;i<=E->lmesh.NNO[level];i++) {
- eqn1=E->ID[level][m][i].doff[1];
- eqn2=E->ID[level][m][i].doff[2];
- eqn3=E->ID[level][m][i].doff[3];
- d0[m][eqn1] += r1[m][eqn1]*E->BI[level][m][eqn1];
- d0[m][eqn2] += r1[m][eqn2]*E->BI[level][m][eqn2];
- d0[m][eqn3] += r1[m][eqn3]*E->BI[level][m][eqn3];
- }
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=0;i<=neq;i++)
- Ad[m][i]=0.0;
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=1;i<=E->lmesh.NNO[level];i++) {
- eqn1=E->ID[level][m][i].doff[1];
- eqn2=E->ID[level][m][i].doff[2];
- eqn3=E->ID[level][m][i].doff[3];
- U1 = d0[m][eqn1];
- U2 = d0[m][eqn2];
- U3 = d0[m][eqn3];
-
- C=E->Node_map[level][m]+(i-1)*max_eqn;
- B1=E->Eqn_k1[level][m]+(i-1)*max_eqn;
- B2=E->Eqn_k2[level][m]+(i-1)*max_eqn;
- B3=E->Eqn_k3[level][m]+(i-1)*max_eqn;
-
- for(j=3;j<max_eqn;j++) {
- Ad[m][eqn1] += B1[j]*d0[m][C[j]];
- Ad[m][eqn2] += B2[j]*d0[m][C[j]];
- Ad[m][eqn3] += B3[j]*d0[m][C[j]];
- }
-
- for(j=0;j<max_eqn;j++) {
- Ad[m][C[j]] += B1[j]*U1 + B2[j]*U2 + B3[j]*U3;
- }
- } /* end for i and m */
-
- (E->solver.exchange_id_d)(E, Ad, level);
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=0;i<neq;i++)
- r1[m][i] = F[m][i] - Ad[m][i];
-
- /* residual = sqrt(global_vdot(E,r1,r1,level))/gneq;
-
- if(E->parallel.me==0)fprintf(stderr,"residuall =%.5e for %d\n",residual,count);
-*/ count++;
- }
-
- *cycles=count;
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- free((double*) r1[m]);
-
- return;
-
- }
-
-
-/* version */
-/* $Id$ */
-
-/* End of file */
Copied: mc/3D/CitcomS/branches/cxx/lib/Obsolete.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Obsolete.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Obsolete.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Obsolete.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,1532 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+/*
+ This file contains functions that are no longer used in this version of
+ CitcomS. To reduce compilantion time and maintanance effort, these functions
+ are removed from its original location to here.
+*/
+
+
+
+/* ========================================================== */
+/* from Size_does_matter.c */
+/* =========================================================== */
+
+
+
+/* ==================================================================================
+ Function to give the global shape function from the local: Assumes ORTHOGONAL MESH
+ ================================================================================== */
+
+void get_global_shape_fn(E,el,GN,GNx,dOmega,pressure,sphere,rtf,lev,m)
+ struct All_variables *E;
+ int el,m;
+ struct Shape_function *GN;
+ struct Shape_function_dx *GNx;
+ struct Shape_function_dA *dOmega;
+ int pressure,lev,sphere;
+ double rtf[4][9];
+{
+ int i,j,k,d,e;
+ double jacobian;
+ double determinant();
+ double cofactor(),myatan();
+ void form_rtf_bc();
+
+ struct Shape_function_dx LGNx;
+
+ double dxda[4][4],cof[4][4],x[4],bc[4][4];
+
+
+ const int dims=E->mesh.nsd;
+ const int ends=enodes[dims];
+ const int vpts=vpoints[dims];
+ const int ppts=ppoints[dims];
+
+
+ if(pressure < 2) {
+ for(k=1;k<=vpts;k++) { /* all of the vpoints */
+ for(d=1;d<=dims;d++) {
+ x[d]=0.0;
+ for(e=1;e<=dims;e++)
+ dxda[d][e]=0.0;
+ }
+
+ for(d=1;d<=dims;d++)
+ for(i=1;i<=ends;i++)
+ x[d] += E->X[lev][m][d][E->IEN[lev][m][el].node[i]]*
+ E->N.vpt[GNVINDEX(i,k)];
+
+ for(d=1;d<=dims;d++)
+ for(e=1;e<=dims;e++)
+ for(i=1;i<=ends;i++)
+ dxda[d][e] += E->X[lev][m][e][E->IEN[lev][m][el].node[i]]
+ * E->Nx.vpt[GNVXINDEX(d-1,i,k)];
+
+ jacobian = determinant(dxda,E->mesh.nsd);
+ dOmega->vpt[k] = jacobian;
+
+ for(d=1;d<=dims;d++)
+ for(e=1;e<=dims;e++)
+ cof[d][e]=cofactor(dxda,d,e,dims);
+
+ if (sphere) {
+
+ form_rtf_bc(k,x,rtf,bc);
+ for(j=1;j<=ends;j++)
+ for(d=1;d<=dims;d++) {
+ LGNx.vpt[GNVXINDEX(d-1,j,k)] = 0.0;
+ for(e=1;e<=dims;e++)
+ LGNx.vpt[GNVXINDEX(d-1,j,k)] +=
+ E->Nx.vpt[GNVXINDEX(e-1,j,k)] *cof[e][d];
+
+ LGNx.vpt[GNVXINDEX(d-1,j,k)] /= jacobian;
+ }
+
+ for(j=1;j<=ends;j++)
+ for(d=1;d<=dims;d++) {
+ GNx->vpt[GNVXINDEX(d-1,j,k)] =
+ bc[d][1]*LGNx.vpt[GNVXINDEX(0,j,k)]
+ + bc[d][2]*LGNx.vpt[GNVXINDEX(1,j,k)]
+ + bc[d][3]*LGNx.vpt[GNVXINDEX(2,j,k)];
+ }
+ }
+ else {
+ for(j=1;j<=ends;j++)
+ for(d=1;d<=dims;d++) {
+ GNx->vpt[GNVXINDEX(d-1,j,k)] = 0.0;
+ for(e=1;e<=dims;e++)
+ GNx->vpt[GNVXINDEX(d-1,j,k)] +=
+ E->Nx.vpt[GNVXINDEX(e-1,j,k)] *cof[e][d];
+
+ GNx->vpt[GNVXINDEX(d-1,j,k)] /= jacobian;
+ }
+ }
+ } /* end for k */
+ } /* end for pressure */
+
+ if(pressure > 0 && pressure < 3) {
+ for(k=1;k<=ppts;k++) { /* all of the ppoints */
+ for(d=1;d<=dims;d++) {
+ x[d]=0.0;
+ for(e=1;e<=dims;e++)
+ dxda[d][e]=0.0;
+ }
+
+ for(d=1;d<=dims;d++)
+ for(i=1;i<=ends;i++)
+ x[d] += E->X[lev][m][d][E->IEN[lev][m][el].node[i]]
+ *E->N.ppt[GNPINDEX(i,k)];
+
+ for(d=1;d<=dims;d++)
+ for(e=1;e<=dims;e++)
+ for(i=1;i<=ends;i++)
+ dxda[d][e] += E->X[lev][m][e][E->IEN[lev][m][el].node[i]]
+ * E->Nx.ppt[GNPXINDEX(d-1,i,k)];
+
+ jacobian = determinant(dxda,E->mesh.nsd);
+ dOmega->ppt[k] = jacobian;
+
+ for(d=1;d<=dims;d++)
+ for(e=1;e<=dims;e++)
+ cof[d][e]=cofactor(dxda,d,e,E->mesh.nsd);
+
+ if (sphere) {
+ form_rtf_bc(k,x,rtf,bc);
+ for(j=1;j<=ends;j++)
+ for(d=1;d<=dims;d++) {
+ LGNx.ppt[GNPXINDEX(d-1,j,k)]=0.0;
+ for(e=1;e<=dims;e++)
+ LGNx.ppt[GNPXINDEX(d-1,j,k)] +=
+ E->Nx.ppt[GNPXINDEX(e-1,j,k)]*cof[e][d];
+ LGNx.ppt[GNPXINDEX(d-1,j,k)] /= jacobian;
+ }
+ for(j=1;j<=ends;j++)
+ for(d=1;d<=dims;d++) {
+ GNx->ppt[GNPXINDEX(d-1,j,k)]
+ = bc[d][1]*LGNx.ppt[GNPXINDEX(0,j,k)]
+ + bc[d][2]*LGNx.ppt[GNPXINDEX(1,j,k)]
+ + bc[d][3]*LGNx.ppt[GNPXINDEX(2,j,k)];
+ }
+ }
+
+ else {
+ for(j=1;j<=ends;j++)
+ for(d=1;d<=dims;d++) {
+ GNx->ppt[GNPXINDEX(d-1,j,k)]=0.0;
+ for(e=1;e<=dims;e++)
+ GNx->ppt[GNPXINDEX(d-1,j,k)] +=
+ E->Nx.ppt[GNPXINDEX(e-1,j,k)]*cof[e][d];
+ GNx->ppt[GNPXINDEX(d-1,j,k)] /= jacobian;
+ }
+ }
+
+ } /* end for k int */
+ } /* end for pressure */
+
+
+ return;
+}
+
+
+void get_global_1d_shape_fn_1(E,el,GM,dGammax,nodal,m)
+ struct All_variables *E;
+ int el,nodal,m;
+ struct Shape_function *GM;
+ struct Shape_function_dA *dGammax;
+{
+ int i,k,d,e,h,l,kk;
+
+ double jacobian;
+ double determinant();
+ double cofactor();
+ double **dmatrix();
+
+ const int dims=E->mesh.nsd,dofs=E->mesh.dof;
+ const int ends=enodes[dims];
+
+ double dxda[4][4],cof[4][4];
+
+
+ for(k=1;k<=vpoints[E->mesh.nsd];k++) {
+
+ for(d=1;d<=dims;d++)
+ for(e=1;e<=dims;e++) {
+ dxda[d][e] = 0.0;
+ for(i=1;i<=ends;i++)
+ dxda[d][e] += E->NMx.vpt[GNVXINDEX(d-1,i,k)]
+ * E->x[m][e][E->ien[m][el].node[i]];
+ }
+
+ for(d=1;d<=dims;d++)
+ for(e=1;e<=dims;e++) {
+ cof[d][e] = 0.0;
+ for(h=1;h<=dims;h++)
+ cof[d][e] += dxda[d][h]*dxda[e][h];
+ }
+
+ if (cof[3][3]!=0.0)
+ jacobian = sqrt(fabs(determinant(cof,E->mesh.nsd)))/cof[3][3];
+
+ dGammax->vpt[k] = jacobian;
+
+ }
+
+ return;
+}
+
+
+/* ======================================================================
+ For calculating pressure boundary term --- Choi, 11/13/02
+ ====================================================================== */
+void get_global_side_1d_shape_fn(E,el,GM,GMx,dGamma,NS,far,m)
+ struct All_variables *E;
+ int el,far,m,NS;
+ struct Shape_function1 *GM;
+ struct Shape_function1_dx *GMx;
+ struct Shape_function_side_dA *dGamma;
+{
+ int ii,i,j,k,d,a,e,node;
+
+ double jacobian;
+ double determinant();
+ double cofactor();
+ void form_rtf_bc();
+
+ struct Shape_function1 LGM;
+ struct Shape_function1_dx LGMx;
+
+ int dims[2][3];
+ int *elist[3];
+ const int oned = onedvpoints[E->mesh.nsd];
+ const int vpts = vpoints[E->mesh.nsd-1];
+ const int ppts = ppoints[E->mesh.nsd-1];
+ const int ends = enodes[E->mesh.nsd-1];
+ double to,fo,ro,xx[4][5],dxda[4][4],dxdy[4][4];
+
+ /******************************************/
+ elist[0] = (int *)malloc(9*sizeof(int));
+ elist[1] = (int *)malloc(9*sizeof(int));
+ elist[2] = (int *)malloc(9*sizeof(int));
+ /*for NS boundary elements */
+ elist[0][0]=0; elist[0][1]=1; elist[0][2]=4; elist[0][3]=8; elist[0][4]=5;
+ elist[0][5]=2; elist[0][6]=3; elist[0][7]=7; elist[0][8]=6;
+ /*for EW boundary elements */
+ elist[1][0]=0; elist[1][1]=1; elist[1][2]=2; elist[1][3]=6; elist[1][4]=5;
+ elist[1][5]=4; elist[1][6]=3; elist[1][7]=7; elist[1][8]=8;
+ /*for TB boundary elements */
+ elist[2][0]=0; elist[2][1]=1; elist[2][2]=2; elist[2][3]=3; elist[2][4]=4;
+ elist[2][5]=5; elist[2][6]=6; elist[2][7]=7; elist[2][8]=8;
+ /******************************************/
+
+ to = E->eco[m][el].centre[1];
+ fo = E->eco[m][el].centre[2];
+ ro = E->eco[m][el].centre[3];
+
+ dxdy[1][1] = cos(to)*cos(fo);
+ dxdy[1][2] = cos(to)*sin(fo);
+ dxdy[1][3] = -sin(to);
+ dxdy[2][1] = -sin(fo);
+ dxdy[2][2] = cos(fo);
+ dxdy[2][3] = 0.0;
+ dxdy[3][1] = sin(to)*cos(fo);
+ dxdy[3][2] = sin(to)*sin(fo);
+ dxdy[3][3] = cos(to);
+
+ /*for side elements*/
+ for(i=1;i<=ends;i++) {
+ a = elist[NS][i+far*ends];
+ node=E->ien[m][el].node[a];
+ xx[1][i] = E->x[m][1][node]*dxdy[1][1]
+ + E->x[m][2][node]*dxdy[1][2]
+ + E->x[m][3][node]*dxdy[1][3];
+ xx[2][i] = E->x[m][1][node]*dxdy[2][1]
+ + E->x[m][2][node]*dxdy[2][2]
+ + E->x[m][3][node]*dxdy[2][3];
+ xx[3][i] = E->x[m][1][node]*dxdy[3][1]
+ + E->x[m][2][node]*dxdy[3][2]
+ + E->x[m][3][node]*dxdy[3][3];
+ }
+
+ for(k=1;k<=oned;k++) {
+ for(d=1;d<=E->mesh.nsd-1;d++)
+ for(e=1;e<=E->mesh.nsd-1;e++)
+ dxda[d][e]=0.0;
+
+ if(NS==0) {
+ for(i=1;i<=oned;i++) {
+ dims[NS][1]=2; dims[NS][2]=3;
+ for(d=1;d<=E->mesh.nsd-1;d++)
+ for(e=1;e<=E->mesh.nsd-1;e++) {
+ dxda[d][e] += xx[dims[NS][e]][i]*E->Mx.vpt[GMVXINDEX(d-1,i,k)];
+ }
+ }
+ }
+ else if(NS==1) {
+ for(i=1;i<=oned;i++) {
+ dims[NS][1]=1; dims[NS][2]=3;
+ for(d=1;d<=E->mesh.nsd-1;d++)
+ for(e=1;e<=E->mesh.nsd-1;e++) {
+ dxda[d][e] += xx[dims[NS][e]][i]*E->Mx.vpt[GMVXINDEX(d-1,i,k)];
+ }
+ }
+ }
+ else if(NS==2) {
+ for(i=1;i<=oned;i++) {
+ dims[NS][1]=1; dims[NS][2]=2;
+ for(d=1;d<=E->mesh.nsd-1;d++)
+ for(e=1;e<=E->mesh.nsd-1;e++) {
+ dxda[d][e] += xx[dims[NS][e]][i]*E->Mx.vpt[GMVXINDEX(d-1,i,k)];
+ }
+ }
+ }
+
+ jacobian = determinant(dxda,E->mesh.nsd-1);
+ dGamma->vpt[k] = jacobian;
+ }
+
+ for(i=1;i<=ppts;i++) { /* all of the ppoints*/
+ for(d=1;d<=E->mesh.nsd-1;d++)
+ for(e=1;e<=E->mesh.nsd-1;e++)
+ dxda[d][e]=0.0;
+
+ if(NS==0) {
+ for(k=1;k<=ends;k++) {
+ dims[NS][1]=2; dims[NS][2]=3;
+ for(d=1;d<=E->mesh.nsd-1;d++)
+ for(e=1;e<=E->mesh.nsd-1;e++)
+ dxda[d][e] += xx[dims[NS][e]][k]*E->Mx.ppt[GMPXINDEX(d-1,k,i)];
+ }
+ }
+ else if(NS==1) {
+ for(k=1;k<=ends;k++) {
+ dims[NS][1]=1; dims[NS][2]=3;
+ for(d=1;d<=E->mesh.nsd-1;d++)
+ for(e=1;e<=E->mesh.nsd-1;e++) {
+ a = elist[NS][k+far*ends];
+ node=E->ien[m][el].node[a];
+ dxda[d][e] += xx[dims[NS][e]][k]*E->Mx.ppt[GMPXINDEX(d-1,k,i)];
+ }
+ }
+ }
+ else if(NS==2) {
+ for(k=1;k<=ends;k++) {
+ dims[NS][1]=1; dims[NS][2]=2;
+ for(d=1;d<=E->mesh.nsd-1;d++)
+ for(e=1;e<=E->mesh.nsd-1;e++) {
+ a = elist[NS][k+far*ends];
+ node=E->ien[m][el].node[a];
+ dxda[d][e] += xx[dims[NS][e]][k]*E->Mx.ppt[GMPXINDEX(d-1,k,i)];
+ }
+ }
+ }
+
+ jacobian = determinant(dxda,E->mesh.nsd-1);
+ dGamma->ppt[i] = jacobian;
+ }
+
+ for(i=0;i<3;i++)
+ free((void *) elist[i]);
+
+ return;
+}
+
+
+
+/* ========================================================== */
+/* from Element_calculations.c */
+/* =========================================================== */
+
+/* ===============================================================
+ Function to create the element pressure-forcing vector (due
+ to imposed velocity boundary conditions, mixed method).
+ =============================================================== */
+
+void get_elt_h(E,el,elt_h,m)
+ struct All_variables *E;
+ int el,m;
+ double elt_h[1];
+{
+ int i,p,a,b,q,got_g;
+ unsigned int type;
+ higher_precision elt_g[24][1];
+ void get_elt_g();
+
+ for(p=0;p<1;p++) elt_h[p] = 0.0;
+
+ got_g = 0;
+
+ type=VBX;
+ for(i=1;i<=E->mesh.nsd;i++)
+ { for(a=1;a<=enodes[E->mesh.nsd];a++)
+ { if (E->node[m][E->ien[m][el].node[a]] & type)
+ { if(!got_g)
+ { get_elt_g(E,el,elt_g,E->mesh.levmax,m);
+ got_g++;
+ }
+
+ p=E->mesh.nsd*(a-1) + i - 1;
+ for(b=1;b<=pnodes[E->mesh.nsd];b++)
+ { q = b-1;
+ elt_h[q] -= elt_g[p][q] * E->sphere.cap[m].VB[i][E->ien[m][el].node[a]];
+ }
+ }
+ }
+ type *= (unsigned int) 2;
+ }
+ return;
+}
+
+/* ========================================================== */
+/* from Process_velocity.c */
+/* =========================================================== */
+
+void get_ele_visc(E, EV,m)
+ struct All_variables *E;
+ float *EV;
+ int m;
+ {
+
+ int el,j,lev;
+
+ const int nel=E->lmesh.nel;
+ const int vpts=vpoints[E->mesh.nsd];
+
+ lev = E->mesh.levmax;
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for (el=1;el<=nel;el++) {
+ EV[el] = 0.0;
+ for (j=1;j<=vpts;j++) {
+ EV[el] += E->EVI[lev][m][(el-1)*vpts+j];
+ }
+
+ EV[el] /= vpts;
+ }
+
+ return;
+ }
+
+
+/* ========================================================== */
+/* From Sphere_harmonics.c */
+/* =========================================================== */
+
+
+
+/* This function construct sph harm tables on a regular grid */
+/* for inverse interpolation */
+
+static void compute_sphereh_int_table(E)
+ struct All_variables *E;
+{
+ int i,j;
+ double t,f;
+ double dth,dfi,sqrt_multis();
+
+ E->sphere.con = (double *)malloc(E->sphere.hindice*sizeof(double));
+ for (ll=0;ll<=E->output.llmax;ll++)
+ for (mm=0;mm<=ll;mm++) {
+ E->sphere.con[E->sphere.hindex[ll][mm]] =
+ sqrt( (2.0-((mm==0)?1.0:0.0))*(2*ll+1)/(4.0*M_PI) )
+ *sqrt_multis(ll+mm,ll-mm); /* which is sqrt((ll-mm)!/(ll+mm)!) */
+ }
+
+ E->sphere.tablenplm = (double **) malloc((E->sphere.nox+1)
+ *sizeof(double*));
+ for (i=1;i<=E->sphere.nox;i++)
+ E->sphere.tablenplm[i]= (double *)malloc(E->sphere.hindice
+ *sizeof(double));
+
+ E->sphere.tablencosf = (double **) malloc((E->sphere.noy+1)
+ *sizeof(double*));
+ E->sphere.tablensinf = (double **) malloc((E->sphere.noy+1)
+ *sizeof(double*));
+ for (i=1;i<=E->sphere.noy;i++) {
+ E->sphere.tablencosf[i]= (double *)malloc((E->output.llmax+3)
+ *sizeof(double));
+ E->sphere.tablensinf[i]= (double *)malloc((E->output.llmax+3)
+ *sizeof(double));
+ }
+
+ E->sphere.sx[1] = (double *) malloc((E->sphere.nsf+1)*sizeof(double));
+ E->sphere.sx[2] = (double *) malloc((E->sphere.nsf+1)*sizeof(double));
+
+ dth = M_PI/E->sphere.elx;
+ dfi = 2.0*M_PI/E->sphere.ely;
+
+ for (j=1;j<=E->sphere.noy;j++)
+ for (i=1;i<=E->sphere.nox;i++) {
+ node = i+(j-1)*E->sphere.nox;
+ E->sphere.sx[1][node] = dth*(i-1);
+ E->sphere.sx[2][node] = dfi*(j-1);
+ }
+
+ for (j=1;j<=E->sphere.nox;j++) {
+ t=E->sphere.sx[1][j];
+ for (ll=0;ll<=E->output.llmax;ll++)
+ for (mm=0;mm<=ll;mm++) {
+ p = E->sphere.hindex[ll][mm];
+ E->sphere.tablenplm[j][p] = modified_plgndr_a(ll,mm,t) ;
+ }
+ }
+ for (j=1;j<=E->sphere.noy;j++) {
+ node = 1+(j-1)*E->sphere.nox;
+ f=E->sphere.sx[2][node];
+ for (mm=0;mm<=E->output.llmax;mm++) {
+ E->sphere.tablencosf[j][mm] = cos( (double)(mm)*f );
+ E->sphere.tablensinf[j][mm] = sin( (double)(mm)*f );
+ }
+ }
+}
+
+
+/* ================================================
+ for a given node, this routine gives which cap and element
+ the node is in.
+ ================================================*/
+void construct_interp_net(E)
+ struct All_variables *E;
+{
+
+ void parallel_process_termination();
+ void parallel_process_sync();
+ int ii,jj,es,i,j,m,el,node;
+ int locate_cap(),locate_element();
+ double x[4],t,f;
+
+ const int ends=4;
+
+ for (i=1;i<=E->sphere.nox;i++)
+ for (j=1;j<=E->sphere.noy;j++) {
+ node = i+(j-1)*E->sphere.nox;
+ E->sphere.int_cap[node]=0;
+ E->sphere.int_ele[node]=0;
+ }
+
+
+ for (i=1;i<=E->sphere.nox;i++)
+ for (j=1;j<=E->sphere.noy;j++) {
+ node = i+(j-1)*E->sphere.nox;
+
+ /* first find which cap this node (i,j) is in */
+ t = E->sphere.sx[1][node];
+ f = E->sphere.sx[2][node];
+
+ x[1] = sin(t)*cos(f); /* radius does not matter */
+ x[2] = sin(t)*sin(f);
+ x[3] = cos(t);
+
+
+ fprintf(E->fp,"mmm0=%d\n",node);
+
+ m = locate_cap(E,x);
+
+ fprintf(E->fp,"mmm=%d\n",m);
+
+ if (m>0) {
+ el = locate_element(E,m,x,node); /* bottom element */
+
+ if (el<=0) {
+ fprintf(stderr,"!!! Processor %d cannot find the right element in cap %d\n",E->parallel.me,m);
+ parallel_process_termination();
+ }
+
+ E->sphere.int_cap[node]=m;
+ E->sphere.int_ele[node]=el;
+
+ }
+ } /* end for i and j */
+
+ parallel_process_sync(E);
+
+ return;
+}
+
+/* ================================================
+ locate the cap for node (i,j)
+ ================================================*/
+
+int locate_cap(E,x)
+ struct All_variables *E;
+ double x[4];
+{
+
+ int ia[5],i,m,mm;
+ double xx[4],angle[5],angle1[5];
+ double get_angle();
+ double area1,rr;
+ const double e_7=1.e-7;
+ static int been_here=0;
+
+ mm = 0;
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ ia[1] = 1;
+ ia[2] = E->lmesh.noz*E->lmesh.nox-E->lmesh.noz+1;
+ ia[3] = E->lmesh.nno-E->lmesh.noz+1;
+ ia[4] = ia[3]-E->lmesh.noz*(E->lmesh.nox-1);
+
+ for (i=1;i<=4;i++) {
+ xx[1] = E->x[m][1][ia[i]]/E->sx[m][3][ia[1]];
+ xx[2] = E->x[m][2][ia[i]]/E->sx[m][3][ia[1]];
+ xx[3] = E->x[m][3][ia[i]]/E->sx[m][3][ia[1]];
+ angle[i] = get_angle(x,xx); /* get angle between (i,j) and other four*/
+ angle1[i]=E->sphere.angle[m][i];
+ }
+
+ area1 = area_of_sphere_triag(angle[1],angle[2],angle1[1])
+ + area_of_sphere_triag(angle[2],angle[3],angle1[2])
+ + area_of_sphere_triag(angle[3],angle[4],angle1[3])
+ + area_of_sphere_triag(angle[4],angle[1],angle1[4]);
+
+ if ( fabs ((area1-E->sphere.area[m])/E->sphere.area[m]) <e_7 ) {
+ mm = m;
+ return (mm);
+ }
+ }
+
+ return (mm);
+}
+
+/* ================================================
+ locate the element containing the node (i,j) with coord x.
+ The radius is assumed to be 1 in computing the areas.
+ NOTE: The returned element el is for the bottom layer.
+ ================================================*/
+
+int locate_element(E,m,x,ne)
+ struct All_variables *E;
+ double x[4];
+int m,ne;
+{
+
+ int el_temp,el,es,el_located,level,lev,lev_plus,el_plus,es_plus,i,j,node;
+ double area,area1,areamin;
+ double area_of_5points();
+ const double e_7=1.e-7;
+ const double e_6=1.e6;
+
+ el_located = 0;
+
+
+ level=E->mesh.levmin;
+ for (es=1;es<=E->lmesh.SNEL[level];es++) {
+
+ el = (es-1)*E->lmesh.ELZ[level]+1;
+ area1 = area_of_5points (E,level,m,el,x,ne);
+ area = E->sphere.area1[level][m][es];
+
+ if(fabs ((area1-area)/area) <e_7 ) {
+ for (lev=E->mesh.levmin;lev<E->mesh.levmax;lev++) {
+ lev_plus = lev + 1;
+ j=1;
+ areamin = e_6;
+ do {
+ el_plus = E->EL[lev][m][el].sub[j];
+
+ es_plus = (el_plus-1)/E->lmesh.ELZ[lev_plus]+1;
+
+ area1 = area_of_5points(E,lev_plus,m,el_plus,x,ne);
+ area = E->sphere.area1[lev_plus][m][es_plus];
+
+ if(fabs(area1-area)<areamin) {
+ areamin=fabs(area1-area);
+ el_temp = el_plus;
+ }
+ j++;
+ } while (j<5 && fabs((area1-area)/area) > e_7);
+ el = el_plus;
+ /* if exit with ..>e_7, pick the best one*/
+ if (fabs((area1-area)/area) > e_7) el = el_temp;
+ } /* end for loop lev */
+ el_located = el;
+ } /* end for if */
+
+ if(el_located) break;
+ } /* end for es at the coarsest level */
+
+ return (el_located);
+}
+
+/* ===============================================================
+ interpolate nodal T's within cap m and element el onto node with
+ coordinate x[3] which is derived from a regular mesh and within
+ the element el. NOTE the radius of x[3] is the inner radius.
+ =============================================================== */
+
+float sphere_interpolate_point(E,T,m,el,x,ne)
+ struct All_variables *E;
+ float **T;
+ double x[4];
+int m,el,ne;
+{
+ double to,fo,y[4],yy[4][5],dxdy[4][4];
+ double a1,b1,c1,d1,a2,b2,c2,d2,a,b,c,xx1,yy1,y1,y2;
+ float ta,t[5];
+ int es,snode,i,j,node;
+
+ const int oned=4;
+ const double e_7=1.e-7;
+ const double four=4.0;
+ const double two=2.0;
+ const double one=1.0;
+ const double pt25=0.25;
+
+ /* first rotate the coord such that the center of element is
+ the pole */
+
+ es = (el-1)/E->lmesh.elz+1;
+
+ to = E->eco[m][el].centre[1];
+ fo = E->eco[m][el].centre[2];
+
+ dxdy[1][1] = cos(to)*cos(fo);
+ dxdy[1][2] = cos(to)*sin(fo);
+ dxdy[1][3] = -sin(to);
+ dxdy[2][1] = -sin(fo);
+ dxdy[2][2] = cos(fo);
+ dxdy[2][3] = 0.0;
+ dxdy[3][1] = sin(to)*cos(fo);
+ dxdy[3][2] = sin(to)*sin(fo);
+ dxdy[3][3] = cos(to);
+
+ for(i=1;i<=oned;i++) { /* nodes */
+ node = E->ien[m][el].node[i];
+ snode = E->sien[m][es].node[i];
+ t[i] = T[m][snode];
+ for (j=1;j<=E->mesh.nsd;j++)
+ yy[j][i] = E->x[m][1][node]*dxdy[j][1]
+ + E->x[m][2][node]*dxdy[j][2]
+ + E->x[m][3][node]*dxdy[j][3];
+ }
+
+ for (j=1;j<=E->mesh.nsd;j++)
+ y[j] = x[1]*dxdy[j][1] + x[2]*dxdy[j][2] + x[3]*dxdy[j][3];
+
+ /* then for node y, determine its coordinates xx1,yy1
+ in the parental element in the isoparametric element system*/
+
+ a1 = yy[1][1] + yy[1][2] + yy[1][3] + yy[1][4];
+ b1 = yy[1][3] + yy[1][2] - yy[1][1] - yy[1][4];
+ c1 = yy[1][3] + yy[1][1] - yy[1][2] - yy[1][4];
+ d1 = yy[1][3] + yy[1][4] - yy[1][1] - yy[1][2];
+ a2 = yy[2][1] + yy[2][2] + yy[2][3] + yy[2][4];
+ b2 = yy[2][3] + yy[2][2] - yy[2][1] - yy[2][4];
+ c2 = yy[2][3] + yy[2][1] - yy[2][2] - yy[2][4];
+ d2 = yy[2][3] + yy[2][4] - yy[2][1] - yy[2][2];
+
+ a = d2*c1;
+ b = a2*c1+b1*d2-d1*c2-d1*b2-four*c1*y[2];
+ c=four*c2*y[1]-c2*a1-a1*b2+four*b2*y[1]-four*b1*y[2]+a2*b1;
+
+ if (fabs(a)<e_7) {
+ yy1 = -c/b;
+ xx1 = (four*y[1]-a1-d1*yy1)/(b1+c1*yy1);
+ }
+ else {
+ y1= (-b+sqrt(b*b-four*a*c))/(two*a);
+ y2= (-b-sqrt(b*b-four*a*c))/(two*a);
+ if (fabs(y1)>fabs(y2))
+ yy1 = y2;
+ else
+ yy1 = y1;
+ xx1 = (four*y[1]-a1-d1*yy1)/(b1+c1*yy1);
+ }
+
+ /* now we can calculate T at x[4] using shape function */
+
+ ta = ((one-xx1)*(one-yy1)*t[1]+(one+xx1)*(one-yy1)*t[2]+
+ (one+xx1)*(one+yy1)*t[3]+(one-xx1)*(one+yy1)*t[4])*pt25;
+
+ /*if(fabs(xx1)>1.5 || fabs(yy1)>1.5)fprintf(E->fp_out,"ME= %d %d %d %g %g %g %g %g %g %g\n",ne,m,es,t[1],t[2],t[3],t[4],ta,xx1,yy1);
+ */
+ return (ta);
+}
+
+/* ===================================================================
+ do the interpolation on sphere for data T, which is needed for both
+ spherical harmonic expansion and graphics
+ =================================================================== */
+
+void sphere_interpolate(E,T,TG)
+ struct All_variables *E;
+ float **T,*TG;
+{
+
+ float sphere_interpolate_point();
+ void gather_TG_to_me0();
+ void parallel_process_termination();
+
+ int ii,jj,es,i,j,m,el,node;
+ double x[4],t,f;
+
+ const int ends=4;
+
+ TG[0] = 0.0;
+ for (i=1;i<=E->sphere.nox;i++)
+ for (j=1;j<=E->sphere.noy;j++) {
+ node = i+(j-1)*E->sphere.nox;
+ TG[node] = 0.0;
+ /* first find which cap this node (i,j) is in */
+
+ m = E->sphere.int_cap[node];
+ el = E->sphere.int_ele[node];
+
+ if (m>0 && el>0) {
+ t = E->sphere.sx[1][node];
+ f = E->sphere.sx[2][node];
+
+ x[1] = E->sx[1][3][1]*sin(t)*cos(f);
+ x[2] = E->sx[1][3][1]*sin(t)*sin(f);
+ x[3] = E->sx[1][3][1]*cos(t);
+
+ TG[node] = sphere_interpolate_point(E,T,m,el,x,node);
+
+ }
+
+ } /* end for i and j */
+
+ gather_TG_to_me0(E,TG);
+
+ return;
+}
+
+
+
+/* ========================================================== */
+/* From Phase_change.c */
+/* =========================================================== */
+
+
+void phase_change_410(E,B,B_b)
+ struct All_variables *E;
+ float **B,**B_b;
+{
+ int i,j,k,n,ns,m;
+ float e_pressure,pt5,one;
+
+ pt5 = 0.5; one=1.0;
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+ for(i=1;i<=E->lmesh.nno;i++) {
+ e_pressure = (E->sphere.ro-E->sx[m][3][i])-E->viscosity.z410-
+ E->control.clapeyron410*(E->T[m][i]-E->control.transT410);
+
+ B[m][i] = pt5*(one+tanh(E->control.width410*e_pressure));
+ }
+
+ ns = 0;
+ for (k=1;k<=E->lmesh.noy;k++)
+ for (j=1;j<=E->lmesh.nox;j++) {
+ ns = ns + 1;
+ B_b[m][ns]=0.0;
+ for (i=1;i<E->lmesh.noz;i++) {
+ n = (k-1)*E->lmesh.noz*E->lmesh.nox + (j-1)*E->lmesh.noz + i;
+ if (B[m][n]>=pt5&&B[m][n+1]<=pt5)
+ B_b[m][ns]=(E->sx[m][3][n+1]-E->sx[m][3][n])*(pt5-B[m][n])/(B[m][n+1]-B[m][n])+E->sx[m][3][n];
+ }
+ }
+ }
+
+
+ return;
+ }
+
+
+void phase_change_670(E,B,B_b)
+ struct All_variables *E;
+ float **B,**B_b;
+{
+ int i,j,k,n,ns,m;
+ float e_pressure,pt5,one;
+
+ pt5 = 0.5; one=1.0;
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+ for(i=1;i<=E->lmesh.nno;i++) {
+ e_pressure = (E->sphere.ro-E->sx[m][3][i])-E->viscosity.zlm-
+ E->control.clapeyron670*(E->T[m][i]-E->control.transT670);
+
+ B[m][i] = pt5*(one+tanh(E->control.width670*e_pressure));
+ }
+
+ ns = 0;
+ for (k=1;k<=E->lmesh.noy;k++)
+ for (j=1;j<=E->lmesh.nox;j++) {
+ ns = ns + 1;
+ B_b[m][ns]=0.0;
+ for (i=1;i<E->lmesh.noz;i++) {
+ n = (k-1)*E->lmesh.noz*E->lmesh.nox + (j-1)*E->lmesh.noz + i;
+ if (B[m][n]>=pt5&&B[m][n+1]<=pt5)
+ B_b[m][ns]=(E->sx[m][3][n+1]-E->sx[m][3][n])*(pt5-B[m][n])/(B[m][n+1]-B[m][n])+E->sx[m][3][n];
+ }
+ }
+ }
+
+
+ return;
+ }
+
+
+void phase_change_cmb(E,B,B_b)
+ struct All_variables *E;
+ float **B,**B_b;
+{
+ int i,j,k,n,ns,m;
+ float e_pressure,pt5,one;
+
+ pt5 = 0.5; one=1.0;
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+ for(i=1;i<=E->lmesh.nno;i++) {
+ e_pressure = (E->sphere.ro-E->sx[m][3][i])-E->viscosity.zcmb-
+ E->control.clapeyroncmb*(E->T[m][i]-E->control.transTcmb);
+
+ B[m][i] = pt5*(one+tanh(E->control.widthcmb*e_pressure));
+ }
+
+ ns = 0;
+ for (k=1;k<=E->lmesh.noy;k++)
+ for (j=1;j<=E->lmesh.nox;j++) {
+ ns = ns + 1;
+ B_b[m][ns]=0.0;
+ for (i=1;i<E->lmesh.noz;i++) {
+ n = (k-1)*E->lmesh.noz*E->lmesh.nox + (j-1)*E->lmesh.noz + i;
+ if (B[m][n]>=pt5&&B[m][n+1]<=pt5)
+ B_b[m][ns]=(E->sx[m][3][n+1]-E->sx[m][3][n])*(pt5-B[m][n])/(B[m][n+1]-B[m][n])+E->sx[m][3][n];
+ }
+ }
+ }
+
+ return;
+}
+
+
+/* ========================================================== */
+/* From Nodal_mesh.c */
+/* =========================================================== */
+
+void flogical_mesh_to_real(E,data,level)
+ struct All_variables *E;
+ float *data;
+ int level;
+
+{ int i,j,n1,n2;
+
+ return;
+}
+
+
+void p_to_centres(E,PN,P,lev)
+ struct All_variables *E;
+ float **PN;
+ double **P;
+ int lev;
+
+{ int p,element,node,j,m;
+ double weight;
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for(p=1;p<=E->lmesh.NEL[lev];p++)
+ P[m][p] = 0.0;
+
+ weight=1.0/((double)enodes[E->mesh.nsd]) ;
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for(p=1;p<=E->lmesh.NEL[lev];p++)
+ for(j=1;j<=enodes[E->mesh.nsd];j++)
+ P[m][p] += PN[m][E->IEN[lev][m][p].node[j]] * weight;
+
+ return;
+ }
+
+
+void v_to_intpts(E,VN,VE,lev)
+ struct All_variables *E;
+ float **VN,**VE;
+ int lev;
+ {
+
+ int m,e,i,j,k;
+ const int nsd=E->mesh.nsd;
+ const int vpts=vpoints[nsd];
+ const int ends=enodes[nsd];
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for(e=1;e<=E->lmesh.NEL[lev];e++)
+ for(i=1;i<=vpts;i++) {
+ VE[m][(e-1)*vpts + i] = 0.0;
+ for(j=1;j<=ends;j++)
+ VE[m][(e-1)*vpts + i] += VN[m][E->IEN[lev][m][e].node[j]]*E->N.vpt[GNVINDEX(j,i)];
+ }
+
+ return;
+ }
+
+
+void visc_to_intpts(E,VN,VE,lev)
+ struct All_variables *E;
+ float **VN,**VE;
+ int lev;
+ {
+
+ int m,e,i,j,k;
+ const int nsd=E->mesh.nsd;
+ const int vpts=vpoints[nsd];
+ const int ends=enodes[nsd];
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for(e=1;e<=E->lmesh.NEL[lev];e++)
+ for(i=1;i<=vpts;i++) {
+ VE[m][(e-1)*vpts + i] = 0.0;
+ for(j=1;j<=ends;j++)
+ VE[m][(e-1)*vpts + i] += log(VN[m][E->IEN[lev][m][e].node[j]]) * E->N.vpt[GNVINDEX(j,i)];
+ VE[m][(e-1)*vpts + i] = exp(VE[m][(e-1)*vpts + i]);
+ }
+
+ }
+
+
+/* ========================================================== */
+/* From Pan_problem_misc_functions.c */
+/* =========================================================== */
+
+double SIN_D(x)
+ double x;
+{
+#if defined(__osf__)
+ return sind(x);
+#else
+ return sin((x/180.0) * M_PI);
+#endif
+
+}
+
+double COT_D(x)
+ double x;
+{
+#if defined(__osf__)
+ return cotd(x);
+#else
+ return tan(((90.0-x)/180.0) * M_PI);
+#endif
+
+}
+
+
+/* non-runaway malloc */
+
+void * Malloc1(bytes,file,line)
+ int bytes;
+ char *file;
+ int line;
+{
+ void *ptr;
+
+ ptr = malloc((size_t)bytes);
+ if (ptr == (void *)NULL) {
+ fprintf(stderr,"Memory: cannot allocate another %d bytes \n(line %d of file %s)\n",bytes,line,file);
+ parallel_process_termination();
+ }
+
+ return(ptr);
+}
+
+
+/* returns the out of plane component of the cross product of
+ the two vectors assuming that one is looking AGAINST the
+ direction of the axis of D, anti-clockwise angles
+ are positive (are you sure ?), and the axes are ordered 2,3 or 1,3 or 1,2 */
+
+
+float cross2d(x11,x12,x21,x22,D)
+ float x11,x12,x21,x22;
+ int D;
+{
+ float temp;
+ if(1==D)
+ temp = ( x11*x22-x12*x21);
+ if(2==D)
+ temp = (-x11*x22+x12*x21);
+ if(3==D)
+ temp = ( x11*x22-x12*x21);
+
+ return(temp);
+}
+
+
+/* ========================================================== */
+/* From General_matrix_functions.c */
+/* =========================================================== */
+
+/*=====================================================================
+ Variable dimension matrix allocation function from numerical recipes
+ Note: ANSII consistency requires some additional features !
+ ===================================================================== */
+
+double **dmatrix(nrl,nrh,ncl,nch)
+ int nrl,nrh,ncl,nch;
+{
+ int i,nrow = nrh-nrl+1,ncol=nch-ncl+1;
+ double **m;
+
+ /* allocate pointer to rows */
+ m=(double **) malloc((nrow+1)* sizeof(double *));
+ m+=1;
+ m-= nrl;
+
+ /* allocate rows and set the pointers accordingly */
+ m[nrl] = (double *) malloc((nrow*ncol+1)* sizeof(double));
+ m[nrl] += 1;
+ m[nrl] -= ncl;
+
+ for(i=nrl+1;i<=nrh;i++)
+ m[i] = m[i-1] + ncol;
+
+ return(m); }
+
+
+float **fmatrix(nrl,nrh,ncl,nch)
+ int nrl,nrh,ncl,nch;
+{
+ int i,nrow = nrh-nrl+1,ncol=nch-ncl+1;
+ float **m;
+
+ /* allocate pointer to rows */
+ m=(float **) malloc((unsigned)((nrow+1)* sizeof(float *)));
+ m+=1;
+ m-= nrl;
+
+ /* allocate rows and set the pointers accordingly */
+ m[nrl] = (float *) malloc((unsigned)((nrow*ncol+1)* sizeof(float)));
+ m[nrl] += 1;
+ m[nrl] -= ncl;
+
+ for(i=nrl+1;i<=nrh;i++)
+ m[i] = m[i-1] + ncol;
+
+ return(m); }
+
+
+void dfree_matrix(m,nrl,nrh,ncl,nch)
+ double **m;
+ int nrl,nrh,ncl,nch;
+{
+ int i;
+ for(i=nrh;i>=nrl;i--)
+ free((void *)(m[i] + ncl));
+ free((void *) (m+nrl));
+ return;
+}
+
+void ffree_matrix(m,nrl,nrh,ncl,nch)
+ float **m;
+ int nrl,nrh,ncl,nch;
+{
+ int i;
+ for(i=nrh;i>=nrl;i--)
+ free((void *)(m[i] + ncl));
+ free((void *) (m+nrl));
+ return;
+}
+
+/*=============================================================
+ Functions to allocate/remove space for variable sized vector.
+ ============================================================= */
+
+double *dvector(nl,nh)
+ int nl,nh;
+{
+ double *v;
+ v=(double *) malloc((unsigned) ( nh - nl +1)* sizeof(double));
+ return( v-nl ); }
+
+float *fvector(nl,nh)
+ int nl,nh;
+{
+ float *v;
+ v=(float *) malloc((unsigned) ( nh - nl +1)* sizeof(float));
+ return( v-nl ); }
+
+void dfree_vector(v,nl,nh)
+ double *v;
+ int nl,nh;
+{
+ free((char*) (v+nl)); }
+
+void ffree_vector(v,nl,nh)
+ float *v;
+ int nl,nh;
+{
+ free((char*) (v+nl)); }
+
+int *sivector(nl,nh)
+ int nl,nh;
+{
+ int *v;
+ v=(int*) malloc((unsigned)(nh-nl +1) * sizeof(int));
+ return (v-nl);
+}
+
+void sifree_vector(v,nl,nh)
+ int *v;
+ int nl,nh;
+{ free((char *) (v+nl)); }
+
+
+
+void dvcopy(E,A,B,a,b)
+ struct All_variables *E;
+ double **A,**B;
+ int a,b;
+
+{ int i,m;
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=a;i<=b;i++)
+ A[m][i] = B[m][i];
+
+ return; }
+
+void vcopy(A,B,a,b)
+ float *A,*B;
+ int a,b;
+
+{ int i;
+
+ for(i=a;i<=b;i++)
+ A[i] = B[i];
+
+ return; }
+
+
+
+/* =====================================*/
+ double sphere_h(l,m,t,f,ic)
+ int l,m,ic;
+ double t,f;
+ {
+
+ double plgndr_a(),sphere_hamonics;
+
+ sphere_hamonics = 0.0;
+ if (ic==0)
+ sphere_hamonics = cos(m*f)*plgndr_a(l,m,t);
+ else if (m)
+ sphere_hamonics = sin(m*f)*plgndr_a(l,m,t);
+
+ return sphere_hamonics;
+ }
+
+/* =====================================*/
+ double plgndr_a(l,m,t)
+ int l,m;
+ double t;
+ {
+
+ int i,ll;
+ double x,fact,pll,pmm,pmmp1,somx2,plgndr;
+ const double two=2.0;
+ const double one=1.0;
+
+ x = cos(t);
+ pmm=one;
+ if(m>0) {
+ somx2=sqrt((one-x)*(one+x));
+ fact = one;
+ for (i=1;i<=m;i++) {
+ pmm = -pmm*fact*somx2;
+ fact = fact + two;
+ }
+ }
+
+ if (l==m)
+ plgndr = pmm;
+ else {
+ pmmp1 = x*(2*m+1)*pmm;
+ if(l==m+1)
+ plgndr = pmmp1;
+ else {
+ for (ll=m+2;ll<=l;ll++) {
+ pll = (x*(2*ll-1)*pmmp1-(ll+m-1)*pmm)/(ll-m);
+ pmm = pmmp1;
+ pmmp1 = pll;
+ }
+ plgndr = pll;
+ }
+ }
+
+ return plgndr;
+ }
+
+ float area_of_4node(x1,y1,x2,y2,x3,y3,x4,y4)
+ float x1,y1,x2,y2,x3,y3,x4,y4;
+
+ {
+ float area;
+
+ area = fabs(0.5*(x1*(y2-y4)+x2*(y4-y1)+x4*(y1-y2)))
+ + fabs(0.5*(x2*(y3-y4)+x3*(y4-y2)+x4*(y2-y3)));
+
+ return area;
+ }
+
+void print_elt_k(E,a)
+ struct All_variables *E;
+ double a[24*24];
+
+{ int l,ll,n;
+
+ printf("elt k is ...\n");
+
+
+ n = loc_mat_size[E->mesh.nsd];
+
+ for(l=0;l<n;l++)
+ { fprintf(stderr,"\n");fflush(stderr);
+ for(ll=0;ll<n;ll++)
+ { fprintf(stderr,"%s%.3e ",a[ll*n+l] >= 0.0 ? "+" : "",a[ll*n+l]);
+ fflush(stderr);
+ }
+ }
+ fprintf(stderr,"\n"); fflush(stderr);
+
+ return; }
+
+
+ /* =================================== */
+ double sqrt_multis(jj,ii)
+ int ii,jj;
+ {
+ int i;
+ double sqrt_multisa;
+
+ sqrt_multisa = 1.0;
+ if(jj>ii)
+ for (i=jj;i>ii;i--)
+ sqrt_multisa *= 1.0/sqrt((double)i);
+
+ return sqrt_multisa;
+ }
+
+ /* =================================== */
+ double multis(ii)
+ int ii;
+ {
+ int i;
+ double multisa;
+
+ multisa = 1.0;
+ if (ii)
+ for (i=2;i<=ii;i++)
+ multisa *= (double)i;
+
+ return multisa;
+ }
+
+
+ /* =================================== */
+ int int_multis(ii)
+ int ii;
+ {
+ int i,multisa;
+
+ multisa = 1;
+ if (ii)
+ for (i=2;i<=ii;i++)
+ multisa *= i;
+
+ return multisa;
+ }
+
+
+void jacobi(E,d0,F,Ad,acc,cycles,level,guess)
+ struct All_variables *E;
+ double **d0;
+ double **F,**Ad;
+ double acc;
+ int *cycles;
+ int level;
+ int guess;
+{
+
+ int count,i,j,k,l,m,ns,steps;
+ int *C;
+ int eqn1,eqn2,eqn3,gneq;
+
+ void n_assemble_del2_u();
+
+ double sum1,sum2,sum3,residual,global_vdot(),U1,U2,U3;
+
+ double *r1[NCS];
+
+ higher_precision *B1,*B2,*B3;
+
+
+ const int dims=E->mesh.nsd;
+ const int ends=enodes[dims];
+ const int n=loc_mat_size[E->mesh.nsd];
+ const int neq=E->lmesh.NEQ[level];
+ const int num_nodes=E->lmesh.NNO[level];
+ const int nox=E->lmesh.NOX[level];
+ const int noz=E->lmesh.NOY[level];
+ const int noy=E->lmesh.NOZ[level];
+ const int max_eqn=14*dims;
+
+ gneq = E->mesh.NEQ[level];
+
+ steps=*cycles;
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ r1[m] = (double *)malloc(E->lmesh.neq*sizeof(double));
+
+ if(guess) {
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ d0[m][neq]=0.0;
+ n_assemble_del2_u(E,d0,Ad,level,1);
+ }
+ else
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=0;i<=neq;i++) {
+ d0[m][i]=Ad[m][i]=0.0;
+ }
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=0;i<neq;i++)
+ r1[m][i]=F[m][i]-Ad[m][i];
+
+
+ count = 0;
+
+ while (count < steps) {
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=1;i<=E->lmesh.NNO[level];i++) {
+ eqn1=E->ID[level][m][i].doff[1];
+ eqn2=E->ID[level][m][i].doff[2];
+ eqn3=E->ID[level][m][i].doff[3];
+ d0[m][eqn1] += r1[m][eqn1]*E->BI[level][m][eqn1];
+ d0[m][eqn2] += r1[m][eqn2]*E->BI[level][m][eqn2];
+ d0[m][eqn3] += r1[m][eqn3]*E->BI[level][m][eqn3];
+ }
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=0;i<=neq;i++)
+ Ad[m][i]=0.0;
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=1;i<=E->lmesh.NNO[level];i++) {
+ eqn1=E->ID[level][m][i].doff[1];
+ eqn2=E->ID[level][m][i].doff[2];
+ eqn3=E->ID[level][m][i].doff[3];
+ U1 = d0[m][eqn1];
+ U2 = d0[m][eqn2];
+ U3 = d0[m][eqn3];
+
+ C=E->Node_map[level][m]+(i-1)*max_eqn;
+ B1=E->Eqn_k1[level][m]+(i-1)*max_eqn;
+ B2=E->Eqn_k2[level][m]+(i-1)*max_eqn;
+ B3=E->Eqn_k3[level][m]+(i-1)*max_eqn;
+
+ for(j=3;j<max_eqn;j++) {
+ Ad[m][eqn1] += B1[j]*d0[m][C[j]];
+ Ad[m][eqn2] += B2[j]*d0[m][C[j]];
+ Ad[m][eqn3] += B3[j]*d0[m][C[j]];
+ }
+
+ for(j=0;j<max_eqn;j++) {
+ Ad[m][C[j]] += B1[j]*U1 + B2[j]*U2 + B3[j]*U3;
+ }
+ } /* end for i and m */
+
+ (E->solver.exchange_id_d)(E, Ad, level);
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=0;i<neq;i++)
+ r1[m][i] = F[m][i] - Ad[m][i];
+
+ /* residual = sqrt(global_vdot(E,r1,r1,level))/gneq;
+
+ if(E->parallel.me==0)fprintf(stderr,"residuall =%.5e for %d\n",residual,count);
+*/ count++;
+ }
+
+ *cycles=count;
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ free((double*) r1[m]);
+
+ return;
+
+ }
+
+
+/* version */
+/* $Id$ */
+
+/* End of file */
Deleted: mc/3D/CitcomS/branches/cxx/lib/Output.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Output.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Output.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,603 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-/* Routine to process the output of the finite element cycles
- and to turn them into a coherent suite files */
-
-
-#include <stdlib.h>
-#include <math.h>
-#include "element_definitions.h"
-#include "global_defs.h"
-#include "parsing.h"
-#include "output.h"
-
-void output_comp_nd(struct All_variables *, int);
-void output_comp_el(struct All_variables *, int);
-void output_coord(struct All_variables *);
-void output_mat(struct All_variables *);
-void output_velo(struct All_variables *, int);
-void output_visc_prepare(struct All_variables *, float **);
-void output_visc(struct All_variables *, int);
-void output_surf_botm(struct All_variables *, int);
-void output_geoid(struct All_variables *, int);
-void output_stress(struct All_variables *, int);
-void output_horiz_avg(struct All_variables *, int);
-void output_tracer(struct All_variables *, int);
-void output_pressure(struct All_variables *, int);
-void output_heating(struct All_variables *, int);
-
-extern void parallel_process_termination();
-extern void heat_flux(struct All_variables *);
-extern void get_STD_topo(struct All_variables *, float**, float**,
- float**, float**, int);
-extern void get_CBF_topo(struct All_variables *, float**, float**);
-
-/**********************************************************************/
-
-void output_common_input(struct All_variables *E)
-{
- int m = E->parallel.me;
-
- input_string("output_format", E->output.format, "ascii",m);
- input_string("output_optional", E->output.optional, "surf,botm,tracer",m);
-
- /* gzdir type of I/O */
- E->output.gzdir.vtk_io = 0;
- E->output.gzdir.rnr = 0;
- if(strcmp(E->output.format, "ascii-gz") == 0){
- /*
- vtk_io = 1: write files for post-processing into VTK
- vtk_io = 2: write serial legacy VTK file
- vtk_io = 3: write paralle legacy VTK file
-
- */
- input_int("gzdir_vtkio",&(E->output.gzdir.vtk_io),"0",m);
- /* remove net rotation on output step? */
- input_boolean("gzdir_rnr",&(E->output.gzdir.rnr),"off",m);
- E->output.gzdir.vtk_base_init = 0;
- E->output.gzdir.vtk_base_save = 1; /* should we save the basis vectors? (memory!) */
- //fprintf(stderr,"gzdir: vtkio: %i save basis vectors: %i\n",
- // E->output.gzdir.vtk_io,E->output.gzdir.vtk_base_save);
- }
-}
-
-
-
-void output(struct All_variables *E, int cycles)
-{
-
- if (cycles == 0) {
- output_coord(E);
- /*output_mat(E);*/
- }
-
-
- output_velo(E, cycles);
- output_visc(E, cycles);
-
- output_surf_botm(E, cycles);
-
-
- /* optional output below */
-
- /* compute and output geoid (in spherical harmonics coeff) */
- if (E->output.geoid) /* this needs to be called after the
- surface and bottom topo has been
- computed! */
- output_geoid(E, cycles);
-
- if (E->output.stress){
- output_stress(E, cycles);
- }
- if (E->output.pressure)
- output_pressure(E, cycles);
-
- if (E->output.horiz_avg)
- output_horiz_avg(E, cycles);
-
- if(E->output.tracer && E->control.tracer)
- output_tracer(E, cycles);
-
- if (E->output.comp_nd && E->composition.on)
- output_comp_nd(E, cycles);
-
- if (E->output.comp_el && E->composition.on)
- output_comp_el(E, cycles);
-
- if(E->output.heating && E->control.disptn_number != 0)
- output_heating(E, cycles);
-
- return;
-}
-
-
-FILE* output_open(char *filename, char *mode)
-{
- FILE *fp1;
-
- /* if filename is empty, output to stderr. */
- if (*filename) {
- fp1 = fopen(filename,mode);
- if (!fp1) {
- fprintf(stderr,"Cannot open file '%s' for '%s'\n",
- filename,mode);
- parallel_process_termination();
- }
- }
- else
- fp1 = stderr;
-
- return fp1;
-}
-
-
-void output_coord(struct All_variables *E)
-{
- int i, j;
- char output_file[255];
- FILE *fp1;
-
- sprintf(output_file,"%s.coord.%d",E->control.data_file,E->parallel.me);
- fp1 = output_open(output_file, "w");
-
- for(j=1;j<=E->sphere.caps_per_proc;j++) {
- fprintf(fp1,"%3d %7d\n",j,E->lmesh.nno);
- for(i=1;i<=E->lmesh.nno;i++)
- fprintf(fp1,"%.6e %.6e %.6e\n",E->sx[j][1][i],E->sx[j][2][i],E->sx[j][3][i]);
- }
-
- fclose(fp1);
-
- return;
-}
-
-
-void output_visc(struct All_variables *E, int cycles)
-{
- int i, j;
- char output_file[255];
- FILE *fp1;
- int lev = E->mesh.levmax;
-
- sprintf(output_file,"%s.visc.%d.%d", E->control.data_file,
- E->parallel.me, cycles);
- fp1 = output_open(output_file, "w");
-
-
- for(j=1;j<=E->sphere.caps_per_proc;j++) {
- fprintf(fp1,"%3d %7d\n",j,E->lmesh.nno);
- for(i=1;i<=E->lmesh.nno;i++)
- fprintf(fp1,"%.4e\n",E->VI[lev][j][i]);
- }
-
- fclose(fp1);
-
- return;
-}
-
-
-void output_velo(struct All_variables *E, int cycles)
-{
- int i, j;
- char output_file[255];
- FILE *fp1;
-
- sprintf(output_file,"%s.velo.%d.%d", E->control.data_file,
- E->parallel.me, cycles);
- fp1 = output_open(output_file, "w");
-
- fprintf(fp1,"%d %d %.5e\n",cycles,E->lmesh.nno,E->monitor.elapsed_time);
-
- for(j=1;j<=E->sphere.caps_per_proc;j++) {
- fprintf(fp1,"%3d %7d\n",j,E->lmesh.nno);
- for(i=1;i<=E->lmesh.nno;i++) {
- fprintf(fp1,"%.6e %.6e %.6e %.6e\n",E->sphere.cap[j].V[1][i],E->sphere.cap[j].V[2][i],E->sphere.cap[j].V[3][i],E->T[j][i]);
- }
- }
-
- fclose(fp1);
-
- return;
-}
-
-
-void output_surf_botm(struct All_variables *E, int cycles)
-{
- int i, j, s;
- char output_file[255];
- FILE* fp2;
- float *topo;
-
- if((E->output.write_q_files == 0) || (cycles == 0) ||
- (cycles % E->output.write_q_files)!=0)
- heat_flux(E);
- /* else, the heat flux will have been computed already */
-
- if(E->control.use_cbf_topo){
- get_CBF_topo(E,E->slice.tpg,E->slice.tpgb);
-
- }else{
- get_STD_topo(E,E->slice.tpg,E->slice.tpgb,E->slice.divg,E->slice.vort,cycles);
- }
-
- if (E->output.surf && (E->parallel.me_loc[3]==E->parallel.nprocz-1)) {
- sprintf(output_file,"%s.surf.%d.%d", E->control.data_file,
- E->parallel.me, cycles);
- fp2 = output_open(output_file, "w");
-
- for(j=1;j<=E->sphere.caps_per_proc;j++) {
- /* choose either STD topo or pseudo-free-surf topo */
- if(E->control.pseudo_free_surf)
- topo = E->slice.freesurf[j];
- else
- topo = E->slice.tpg[j];
-
- fprintf(fp2,"%3d %7d\n",j,E->lmesh.nsf);
- for(i=1;i<=E->lmesh.nsf;i++) {
- s = i*E->lmesh.noz;
- fprintf(fp2,"%.4e %.4e %.4e %.4e\n",
- topo[i],E->slice.shflux[j][i],E->sphere.cap[j].V[1][s],E->sphere.cap[j].V[2][s]);
- }
- }
- fclose(fp2);
- }
-
-
- if (E->output.botm && (E->parallel.me_loc[3]==0)) {
- sprintf(output_file,"%s.botm.%d.%d", E->control.data_file,
- E->parallel.me, cycles);
- fp2 = output_open(output_file, "w");
-
- for(j=1;j<=E->sphere.caps_per_proc;j++) {
- fprintf(fp2,"%3d %7d\n",j,E->lmesh.nsf);
- for(i=1;i<=E->lmesh.nsf;i++) {
- s = (i-1)*E->lmesh.noz + 1;
- fprintf(fp2,"%.4e %.4e %.4e %.4e\n",
- E->slice.tpgb[j][i],E->slice.bhflux[j][i],E->sphere.cap[j].V[1][s],E->sphere.cap[j].V[2][s]);
- }
- }
- fclose(fp2);
- }
-
- return;
-}
-
-
-void output_geoid(struct All_variables *E, int cycles)
-{
- void compute_geoid();
- int ll, mm, p;
- char output_file[255];
- FILE *fp1;
-
- compute_geoid(E);
-
- if (E->parallel.me == (E->parallel.nprocz-1)) {
- sprintf(output_file, "%s.geoid.%d.%d", E->control.data_file,
- E->parallel.me, cycles);
- fp1 = output_open(output_file, "w");
-
- /* write headers */
- fprintf(fp1, "%d %d %.5e\n", cycles, E->output.llmax,
- E->monitor.elapsed_time);
-
- /* write sph harm coeff of geoid and topos */
- for (ll=0; ll<=E->output.llmax; ll++)
- for(mm=0; mm<=ll; mm++) {
- p = E->sphere.hindex[ll][mm];
- fprintf(fp1,"%d %d %.4e %.4e %.4e %.4e %.4e %.4e\n",
- ll, mm,
- E->sphere.harm_geoid[0][p],
- E->sphere.harm_geoid[1][p],
- E->sphere.harm_geoid_from_tpgt[0][p],
- E->sphere.harm_geoid_from_tpgt[1][p],
- E->sphere.harm_geoid_from_bncy[0][p],
- E->sphere.harm_geoid_from_bncy[1][p]);
-
-
- }
-
- fclose(fp1);
- }
-}
-
-
-
-void output_stress(struct All_variables *E, int cycles)
-{
- int m, node;
- char output_file[255];
- FILE *fp1;
- /* for stress computation */
- void allocate_STD_mem();
- void compute_nodal_stress();
- void free_STD_mem();
- float *SXX[NCS],*SYY[NCS],*SXY[NCS],*SXZ[NCS],*SZY[NCS],*SZZ[NCS];
- float *divv[NCS],*vorv[NCS];
- /* */
- if(E->control.use_cbf_topo) {/* for CBF topo, stress will not have been computed */
- allocate_STD_mem(E, SXX, SYY, SZZ, SXY, SXZ, SZY, divv, vorv);
- compute_nodal_stress(E, SXX, SYY, SZZ, SXY, SXZ, SZY, divv, vorv);
- free_STD_mem(E, SXX, SYY, SZZ, SXY, SXZ, SZY, divv, vorv);
- }
- sprintf(output_file,"%s.stress.%d.%d", E->control.data_file,
- E->parallel.me, cycles);
- fp1 = output_open(output_file, "w");
-
- fprintf(fp1,"%d %d %.5e\n",cycles,E->lmesh.nno,E->monitor.elapsed_time);
-
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
- fprintf(fp1,"%3d %7d\n",m,E->lmesh.nno);
- /* those are sorted like stt spp srr stp str srp */
- for (node=1;node<=E->lmesh.nno;node++)
- fprintf(fp1, "%.4e %.4e %.4e %.4e %.4e %.4e\n",
- E->gstress[m][(node-1)*6+1],
- E->gstress[m][(node-1)*6+2],
- E->gstress[m][(node-1)*6+3],
- E->gstress[m][(node-1)*6+4],
- E->gstress[m][(node-1)*6+5],
- E->gstress[m][(node-1)*6+6]);
- }
- fclose(fp1);
-}
-
-
-void output_horiz_avg(struct All_variables *E, int cycles)
-{
- /* horizontal average output of temperature, composition and rms velocity*/
- void compute_horiz_avg();
-
- int j;
- char output_file[255];
- FILE *fp1;
-
- /* compute horizontal average here.... */
- compute_horiz_avg(E);
-
- /* only the first nprocz processors need to output */
-
- if (E->parallel.me<E->parallel.nprocz) {
- sprintf(output_file,"%s.horiz_avg.%d.%d", E->control.data_file,
- E->parallel.me, cycles);
- fp1=fopen(output_file,"w");
- for(j=1;j<=E->lmesh.noz;j++) {
- fprintf(fp1,"%.4e %.4e %.4e %.4e",E->sx[1][3][j],
- E->Have.T[j],E->Have.V[1][j],E->Have.V[2][j]);
-
- if (E->composition.on) {
- int n;
- for(n=0; n<E->composition.ncomp; n++)
- fprintf(fp1," %.4e", E->Have.C[n][j]);
- }
- fprintf(fp1,"\n");
- }
- fclose(fp1);
- }
-
- return;
-}
-
-
-
-void output_mat(struct All_variables *E)
-{
- int m, el;
- char output_file[255];
- FILE* fp;
-
- sprintf(output_file,"%s.mat.%d", E->control.data_file,E->parallel.me);
- fp = output_open(output_file, "w");
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for(el=1;el<=E->lmesh.nel;el++)
- fprintf(fp,"%d %d %f\n", el,E->mat[m][el],E->VIP[m][el]);
-
- fclose(fp);
-
- return;
-}
-
-
-
-void output_pressure(struct All_variables *E, int cycles)
-{
- int i, j;
- char output_file[255];
- FILE *fp1;
-
- sprintf(output_file,"%s.pressure.%d.%d", E->control.data_file,
- E->parallel.me, cycles);
- fp1 = output_open(output_file, "w");
-
- fprintf(fp1,"%d %d %.5e\n",cycles,E->lmesh.nno,E->monitor.elapsed_time);
-
- for(j=1;j<=E->sphere.caps_per_proc;j++) {
- fprintf(fp1,"%3d %7d\n",j,E->lmesh.nno);
- for(i=1;i<=E->lmesh.nno;i++)
- fprintf(fp1,"%.6e\n",E->NP[j][i]);
- }
-
- fclose(fp1);
-
- return;
-}
-
-
-
-void output_tracer(struct All_variables *E, int cycles)
-{
- int i, j, n, ncolumns;
- char output_file[255];
- FILE *fp1;
-
- sprintf(output_file,"%s.tracer.%d.%d", E->control.data_file,
- E->parallel.me, cycles);
- fp1 = output_open(output_file, "w");
-
- ncolumns = 3 + E->trace.number_of_extra_quantities;
-
- for(j=1;j<=E->sphere.caps_per_proc;j++) {
- fprintf(fp1,"%d %d %d %.5e\n", cycles, E->trace.ntracers[j],
- ncolumns, E->monitor.elapsed_time);
-
- for(n=1;n<=E->trace.ntracers[j];n++) {
- /* write basic quantities (coordinate) */
- fprintf(fp1,"%.12e %.12e %.12e",
- E->trace.basicq[j][0][n],
- E->trace.basicq[j][1][n],
- E->trace.basicq[j][2][n]);
-
- /* write extra quantities */
- for (i=0; i<E->trace.number_of_extra_quantities; i++) {
- fprintf(fp1," %.12e", E->trace.extraq[j][i][n]);
- }
- fprintf(fp1, "\n");
- }
-
- }
-
- fclose(fp1);
- return;
-}
-
-
-void output_comp_nd(struct All_variables *E, int cycles)
-{
- int i, j, k;
- char output_file[255];
- FILE *fp1;
-
- sprintf(output_file,"%s.comp_nd.%d.%d", E->control.data_file,
- E->parallel.me, cycles);
- fp1 = output_open(output_file, "w");
-
- for(j=1;j<=E->sphere.caps_per_proc;j++) {
- fprintf(fp1,"%3d %7d %.5e %d\n",
- j, E->lmesh.nel,
- E->monitor.elapsed_time, E->composition.ncomp);
- for(i=0;i<E->composition.ncomp;i++) {
- fprintf(fp1,"%.5e %.5e ",
- E->composition.initial_bulk_composition[i],
- E->composition.bulk_composition[i]);
- }
- fprintf(fp1,"\n");
-
- for(i=1;i<=E->lmesh.nno;i++) {
- for(k=0;k<E->composition.ncomp;k++) {
- fprintf(fp1,"%.6e ",E->composition.comp_node[j][k][i]);
- }
- fprintf(fp1,"\n");
- }
-
- }
-
- fclose(fp1);
- return;
-}
-
-
-void output_comp_el(struct All_variables *E, int cycles)
-{
- int i, j, k;
- char output_file[255];
- FILE *fp1;
-
- sprintf(output_file,"%s.comp_el.%d.%d", E->control.data_file,
- E->parallel.me, cycles);
- fp1 = output_open(output_file, "w");
-
- for(j=1;j<=E->sphere.caps_per_proc;j++) {
- fprintf(fp1,"%3d %7d %.5e %d\n",
- j, E->lmesh.nel,
- E->monitor.elapsed_time, E->composition.ncomp);
- for(i=0;i<E->composition.ncomp;i++) {
- fprintf(fp1,"%.5e %.5e ",
- E->composition.initial_bulk_composition[i],
- E->composition.bulk_composition[i]);
- }
- fprintf(fp1,"\n");
-
- for(i=1;i<=E->lmesh.nel;i++) {
- for(k=0;k<E->composition.ncomp;k++) {
- fprintf(fp1,"%.6e ",
- E->composition.comp_el[j][k][i]);
- }
- fprintf(fp1,"\n");
- }
- }
-
- fclose(fp1);
- return;
-}
-
-
-void output_heating(struct All_variables *E, int cycles)
-{
- int j, e;
- char output_file[255];
- FILE *fp1;
-
- sprintf(output_file,"%s.heating.%d.%d", E->control.data_file,
- E->parallel.me, cycles);
- fp1 = output_open(output_file, "w");
-
- fprintf(fp1,"%.5e\n",E->monitor.elapsed_time);
-
- for(j=1;j<=E->sphere.caps_per_proc;j++) {
- fprintf(fp1,"%3d %7d\n", j, E->lmesh.nel);
- for(e=1; e<=E->lmesh.nel; e++)
- fprintf(fp1, "%.4e %.4e %.4e\n", E->heating_adi[j][e],
- E->heating_visc[j][e], E->heating_latent[j][e]);
- }
- fclose(fp1);
-
- return;
-}
-
-
-void output_time(struct All_variables *E, int cycles)
-{
- double CPU_time0();
-
- double current_time = CPU_time0();
-
- if (E->parallel.me == 0) {
- fprintf(E->fptime,"%d %.4e %.4e %.4e %.4e\n",
- cycles,
- E->monitor.elapsed_time,
- E->advection.timestep,
- current_time - E->monitor.cpu_time_at_start,
- current_time - E->monitor.cpu_time_at_last_cycle);
-
- fflush(E->fptime);
- }
-
- E->monitor.cpu_time_at_last_cycle = current_time;
-
- return;
-}
Copied: mc/3D/CitcomS/branches/cxx/lib/Output.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Output.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Output.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Output.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,601 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+/* Routine to process the output of the finite element cycles
+ and to turn them into a coherent suite files */
+
+
+#include <stdlib.h>
+#include <string.h>
+#include <math.h>
+#include "element_definitions.h"
+#include "global_defs.h"
+#include "parsing.h"
+#include "output.h"
+
+#include "cproto.h"
+
+void output_comp_nd(struct All_variables *, int);
+void output_comp_el(struct All_variables *, int);
+void output_coord(struct All_variables *);
+void output_mat(struct All_variables *);
+void output_velo(struct All_variables *, int);
+void output_visc_prepare(struct All_variables *, float **);
+void output_visc(struct All_variables *, int);
+void output_surf_botm(struct All_variables *, int);
+void output_geoid(struct All_variables *, int);
+void output_stress(struct All_variables *, int);
+void output_horiz_avg(struct All_variables *, int);
+void output_tracer(struct All_variables *, int);
+void output_pressure(struct All_variables *, int);
+void output_heating(struct All_variables *, int);
+
+extern void parallel_process_termination();
+extern void heat_flux(struct All_variables *);
+extern void get_STD_topo(struct All_variables *, float**, float**,
+ float**, float**, int);
+extern void get_CBF_topo(struct All_variables *, float**, float**);
+
+/**********************************************************************/
+
+void output_common_input(struct All_variables *E)
+{
+ int m = E->parallel.me;
+
+ input_string("output_format", E->output.format, "ascii",m);
+ input_string("output_optional", E->output.optional, "surf,botm,tracer",m);
+
+ /* gzdir type of I/O */
+ E->output.gzdir.vtk_io = 0;
+ E->output.gzdir.rnr = 0;
+ if(strcmp(E->output.format, "ascii-gz") == 0){
+ /*
+ vtk_io = 1: write files for post-processing into VTK
+ vtk_io = 2: write serial legacy VTK file
+ vtk_io = 3: write paralle legacy VTK file
+
+ */
+ input_int("gzdir_vtkio",&(E->output.gzdir.vtk_io),"0",m);
+ /* remove net rotation on output step? */
+ input_boolean("gzdir_rnr",&(E->output.gzdir.rnr),"off",m);
+ E->output.gzdir.vtk_base_init = 0;
+ E->output.gzdir.vtk_base_save = 1; /* should we save the basis vectors? (memory!) */
+ //fprintf(stderr,"gzdir: vtkio: %i save basis vectors: %i\n",
+ // E->output.gzdir.vtk_io,E->output.gzdir.vtk_base_save);
+ }
+}
+
+
+
+void output(struct All_variables *E, int cycles)
+{
+
+ if (cycles == 0) {
+ output_coord(E);
+ /*output_mat(E);*/
+ }
+
+
+ output_velo(E, cycles);
+ output_visc(E, cycles);
+
+ output_surf_botm(E, cycles);
+
+
+ /* optional output below */
+
+ /* compute and output geoid (in spherical harmonics coeff) */
+ if (E->output.geoid) /* this needs to be called after the
+ surface and bottom topo has been
+ computed! */
+ output_geoid(E, cycles);
+
+ if (E->output.stress){
+ output_stress(E, cycles);
+ }
+ if (E->output.pressure)
+ output_pressure(E, cycles);
+
+ if (E->output.horiz_avg)
+ output_horiz_avg(E, cycles);
+
+ if(E->output.tracer && E->control.tracer)
+ output_tracer(E, cycles);
+
+ if (E->output.comp_nd && E->composition.on)
+ output_comp_nd(E, cycles);
+
+ if (E->output.comp_el && E->composition.on)
+ output_comp_el(E, cycles);
+
+ if(E->output.heating && E->control.disptn_number != 0)
+ output_heating(E, cycles);
+
+ return;
+}
+
+
+FILE* output_open(char *filename, char *mode)
+{
+ FILE *fp1;
+
+ /* if filename is empty, output to stderr. */
+ if (*filename) {
+ fp1 = fopen(filename,mode);
+ if (!fp1) {
+ fprintf(stderr,"Cannot open file '%s' for '%s'\n",
+ filename,mode);
+ parallel_process_termination();
+ }
+ }
+ else
+ fp1 = stderr;
+
+ return fp1;
+}
+
+
+void output_coord(struct All_variables *E)
+{
+ int i, j;
+ char output_file[255];
+ FILE *fp1;
+
+ sprintf(output_file,"%s.coord.%d",E->control.data_file,E->parallel.me);
+ fp1 = output_open(output_file, "w");
+
+ for(j=1;j<=E->sphere.caps_per_proc;j++) {
+ fprintf(fp1,"%3d %7d\n",j,E->lmesh.nno);
+ for(i=1;i<=E->lmesh.nno;i++)
+ fprintf(fp1,"%.6e %.6e %.6e\n",E->sx[j][1][i],E->sx[j][2][i],E->sx[j][3][i]);
+ }
+
+ fclose(fp1);
+
+ return;
+}
+
+
+void output_visc(struct All_variables *E, int cycles)
+{
+ int i, j;
+ char output_file[255];
+ FILE *fp1;
+ int lev = E->mesh.levmax;
+
+ sprintf(output_file,"%s.visc.%d.%d", E->control.data_file,
+ E->parallel.me, cycles);
+ fp1 = output_open(output_file, "w");
+
+
+ for(j=1;j<=E->sphere.caps_per_proc;j++) {
+ fprintf(fp1,"%3d %7d\n",j,E->lmesh.nno);
+ for(i=1;i<=E->lmesh.nno;i++)
+ fprintf(fp1,"%.4e\n",E->VI[lev][j][i]);
+ }
+
+ fclose(fp1);
+
+ return;
+}
+
+
+void output_velo(struct All_variables *E, int cycles)
+{
+ int i, j;
+ char output_file[255];
+ FILE *fp1;
+
+ sprintf(output_file,"%s.velo.%d.%d", E->control.data_file,
+ E->parallel.me, cycles);
+ fp1 = output_open(output_file, "w");
+
+ fprintf(fp1,"%d %d %.5e\n",cycles,E->lmesh.nno,E->monitor.elapsed_time);
+
+ for(j=1;j<=E->sphere.caps_per_proc;j++) {
+ fprintf(fp1,"%3d %7d\n",j,E->lmesh.nno);
+ for(i=1;i<=E->lmesh.nno;i++) {
+ fprintf(fp1,"%.6e %.6e %.6e %.6e\n",E->sphere.cap[j].V[1][i],E->sphere.cap[j].V[2][i],E->sphere.cap[j].V[3][i],E->T[j][i]);
+ }
+ }
+
+ fclose(fp1);
+
+ return;
+}
+
+
+void output_surf_botm(struct All_variables *E, int cycles)
+{
+ int i, j, s;
+ char output_file[255];
+ FILE* fp2;
+ float *topo;
+
+ if((E->output.write_q_files == 0) || (cycles == 0) ||
+ (cycles % E->output.write_q_files)!=0)
+ heat_flux(E);
+ /* else, the heat flux will have been computed already */
+
+ if(E->control.use_cbf_topo){
+ get_CBF_topo(E,E->slice.tpg,E->slice.tpgb);
+
+ }else{
+ get_STD_topo(E,E->slice.tpg,E->slice.tpgb,E->slice.divg,E->slice.vort,cycles);
+ }
+
+ if (E->output.surf && (E->parallel.me_loc[3]==E->parallel.nprocz-1)) {
+ sprintf(output_file,"%s.surf.%d.%d", E->control.data_file,
+ E->parallel.me, cycles);
+ fp2 = output_open(output_file, "w");
+
+ for(j=1;j<=E->sphere.caps_per_proc;j++) {
+ /* choose either STD topo or pseudo-free-surf topo */
+ if(E->control.pseudo_free_surf)
+ topo = E->slice.freesurf[j];
+ else
+ topo = E->slice.tpg[j];
+
+ fprintf(fp2,"%3d %7d\n",j,E->lmesh.nsf);
+ for(i=1;i<=E->lmesh.nsf;i++) {
+ s = i*E->lmesh.noz;
+ fprintf(fp2,"%.4e %.4e %.4e %.4e\n",
+ topo[i],E->slice.shflux[j][i],E->sphere.cap[j].V[1][s],E->sphere.cap[j].V[2][s]);
+ }
+ }
+ fclose(fp2);
+ }
+
+
+ if (E->output.botm && (E->parallel.me_loc[3]==0)) {
+ sprintf(output_file,"%s.botm.%d.%d", E->control.data_file,
+ E->parallel.me, cycles);
+ fp2 = output_open(output_file, "w");
+
+ for(j=1;j<=E->sphere.caps_per_proc;j++) {
+ fprintf(fp2,"%3d %7d\n",j,E->lmesh.nsf);
+ for(i=1;i<=E->lmesh.nsf;i++) {
+ s = (i-1)*E->lmesh.noz + 1;
+ fprintf(fp2,"%.4e %.4e %.4e %.4e\n",
+ E->slice.tpgb[j][i],E->slice.bhflux[j][i],E->sphere.cap[j].V[1][s],E->sphere.cap[j].V[2][s]);
+ }
+ }
+ fclose(fp2);
+ }
+
+ return;
+}
+
+
+void output_geoid(struct All_variables *E, int cycles)
+{
+ int ll, mm, p;
+ char output_file[255];
+ FILE *fp1;
+
+ compute_geoid(E);
+
+ if (E->parallel.me == (E->parallel.nprocz-1)) {
+ sprintf(output_file, "%s.geoid.%d.%d", E->control.data_file,
+ E->parallel.me, cycles);
+ fp1 = output_open(output_file, "w");
+
+ /* write headers */
+ fprintf(fp1, "%d %d %.5e\n", cycles, E->output.llmax,
+ E->monitor.elapsed_time);
+
+ /* write sph harm coeff of geoid and topos */
+ for (ll=0; ll<=E->output.llmax; ll++)
+ for(mm=0; mm<=ll; mm++) {
+ p = E->sphere.hindex[ll][mm];
+ fprintf(fp1,"%d %d %.4e %.4e %.4e %.4e %.4e %.4e\n",
+ ll, mm,
+ E->sphere.harm_geoid[0][p],
+ E->sphere.harm_geoid[1][p],
+ E->sphere.harm_geoid_from_tpgt[0][p],
+ E->sphere.harm_geoid_from_tpgt[1][p],
+ E->sphere.harm_geoid_from_bncy[0][p],
+ E->sphere.harm_geoid_from_bncy[1][p]);
+
+
+ }
+
+ fclose(fp1);
+ }
+}
+
+
+
+void output_stress(struct All_variables *E, int cycles)
+{
+ int m, node;
+ char output_file[255];
+ FILE *fp1;
+ /* for stress computation */
+ float *SXX[NCS],*SYY[NCS],*SXY[NCS],*SXZ[NCS],*SZY[NCS],*SZZ[NCS];
+ float *divv[NCS],*vorv[NCS];
+ /* */
+ if(E->control.use_cbf_topo) {/* for CBF topo, stress will not have been computed */
+ allocate_STD_mem(E, SXX, SYY, SZZ, SXY, SXZ, SZY, divv, vorv);
+ compute_nodal_stress(E, SXX, SYY, SZZ, SXY, SXZ, SZY, divv, vorv);
+ free_STD_mem(E, SXX, SYY, SZZ, SXY, SXZ, SZY, divv, vorv);
+ }
+ sprintf(output_file,"%s.stress.%d.%d", E->control.data_file,
+ E->parallel.me, cycles);
+ fp1 = output_open(output_file, "w");
+
+ fprintf(fp1,"%d %d %.5e\n",cycles,E->lmesh.nno,E->monitor.elapsed_time);
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+ fprintf(fp1,"%3d %7d\n",m,E->lmesh.nno);
+ /* those are sorted like stt spp srr stp str srp */
+ for (node=1;node<=E->lmesh.nno;node++)
+ fprintf(fp1, "%.4e %.4e %.4e %.4e %.4e %.4e\n",
+ E->gstress[m][(node-1)*6+1],
+ E->gstress[m][(node-1)*6+2],
+ E->gstress[m][(node-1)*6+3],
+ E->gstress[m][(node-1)*6+4],
+ E->gstress[m][(node-1)*6+5],
+ E->gstress[m][(node-1)*6+6]);
+ }
+ fclose(fp1);
+}
+
+
+void output_horiz_avg(struct All_variables *E, int cycles)
+{
+ /* horizontal average output of temperature, composition and rms velocity*/
+
+ int j;
+ char output_file[255];
+ FILE *fp1;
+
+ /* compute horizontal average here.... */
+ compute_horiz_avg(E);
+
+ /* only the first nprocz processors need to output */
+
+ if (E->parallel.me<E->parallel.nprocz) {
+ sprintf(output_file,"%s.horiz_avg.%d.%d", E->control.data_file,
+ E->parallel.me, cycles);
+ fp1=fopen(output_file,"w");
+ for(j=1;j<=E->lmesh.noz;j++) {
+ fprintf(fp1,"%.4e %.4e %.4e %.4e",E->sx[1][3][j],
+ E->Have.T[j],E->Have.V[1][j],E->Have.V[2][j]);
+
+ if (E->composition.on) {
+ int n;
+ for(n=0; n<E->composition.ncomp; n++)
+ fprintf(fp1," %.4e", E->Have.C[n][j]);
+ }
+ fprintf(fp1,"\n");
+ }
+ fclose(fp1);
+ }
+
+ return;
+}
+
+
+
+void output_mat(struct All_variables *E)
+{
+ int m, el;
+ char output_file[255];
+ FILE* fp;
+
+ sprintf(output_file,"%s.mat.%d", E->control.data_file,E->parallel.me);
+ fp = output_open(output_file, "w");
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for(el=1;el<=E->lmesh.nel;el++)
+ fprintf(fp,"%d %d %f\n", el,E->mat[m][el],E->VIP[m][el]);
+
+ fclose(fp);
+
+ return;
+}
+
+
+
+void output_pressure(struct All_variables *E, int cycles)
+{
+ int i, j;
+ char output_file[255];
+ FILE *fp1;
+
+ sprintf(output_file,"%s.pressure.%d.%d", E->control.data_file,
+ E->parallel.me, cycles);
+ fp1 = output_open(output_file, "w");
+
+ fprintf(fp1,"%d %d %.5e\n",cycles,E->lmesh.nno,E->monitor.elapsed_time);
+
+ for(j=1;j<=E->sphere.caps_per_proc;j++) {
+ fprintf(fp1,"%3d %7d\n",j,E->lmesh.nno);
+ for(i=1;i<=E->lmesh.nno;i++)
+ fprintf(fp1,"%.6e\n",E->NP[j][i]);
+ }
+
+ fclose(fp1);
+
+ return;
+}
+
+
+
+void output_tracer(struct All_variables *E, int cycles)
+{
+ int i, j, n, ncolumns;
+ char output_file[255];
+ FILE *fp1;
+
+ sprintf(output_file,"%s.tracer.%d.%d", E->control.data_file,
+ E->parallel.me, cycles);
+ fp1 = output_open(output_file, "w");
+
+ ncolumns = 3 + E->trace.number_of_extra_quantities;
+
+ for(j=1;j<=E->sphere.caps_per_proc;j++) {
+ fprintf(fp1,"%d %d %d %.5e\n", cycles, E->trace.ntracers[j],
+ ncolumns, E->monitor.elapsed_time);
+
+ for(n=1;n<=E->trace.ntracers[j];n++) {
+ /* write basic quantities (coordinate) */
+ fprintf(fp1,"%.12e %.12e %.12e",
+ E->trace.basicq[j][0][n],
+ E->trace.basicq[j][1][n],
+ E->trace.basicq[j][2][n]);
+
+ /* write extra quantities */
+ for (i=0; i<E->trace.number_of_extra_quantities; i++) {
+ fprintf(fp1," %.12e", E->trace.extraq[j][i][n]);
+ }
+ fprintf(fp1, "\n");
+ }
+
+ }
+
+ fclose(fp1);
+ return;
+}
+
+
+void output_comp_nd(struct All_variables *E, int cycles)
+{
+ int i, j, k;
+ char output_file[255];
+ FILE *fp1;
+
+ sprintf(output_file,"%s.comp_nd.%d.%d", E->control.data_file,
+ E->parallel.me, cycles);
+ fp1 = output_open(output_file, "w");
+
+ for(j=1;j<=E->sphere.caps_per_proc;j++) {
+ fprintf(fp1,"%3d %7d %.5e %d\n",
+ j, E->lmesh.nel,
+ E->monitor.elapsed_time, E->composition.ncomp);
+ for(i=0;i<E->composition.ncomp;i++) {
+ fprintf(fp1,"%.5e %.5e ",
+ E->composition.initial_bulk_composition[i],
+ E->composition.bulk_composition[i]);
+ }
+ fprintf(fp1,"\n");
+
+ for(i=1;i<=E->lmesh.nno;i++) {
+ for(k=0;k<E->composition.ncomp;k++) {
+ fprintf(fp1,"%.6e ",E->composition.comp_node[j][k][i]);
+ }
+ fprintf(fp1,"\n");
+ }
+
+ }
+
+ fclose(fp1);
+ return;
+}
+
+
+void output_comp_el(struct All_variables *E, int cycles)
+{
+ int i, j, k;
+ char output_file[255];
+ FILE *fp1;
+
+ sprintf(output_file,"%s.comp_el.%d.%d", E->control.data_file,
+ E->parallel.me, cycles);
+ fp1 = output_open(output_file, "w");
+
+ for(j=1;j<=E->sphere.caps_per_proc;j++) {
+ fprintf(fp1,"%3d %7d %.5e %d\n",
+ j, E->lmesh.nel,
+ E->monitor.elapsed_time, E->composition.ncomp);
+ for(i=0;i<E->composition.ncomp;i++) {
+ fprintf(fp1,"%.5e %.5e ",
+ E->composition.initial_bulk_composition[i],
+ E->composition.bulk_composition[i]);
+ }
+ fprintf(fp1,"\n");
+
+ for(i=1;i<=E->lmesh.nel;i++) {
+ for(k=0;k<E->composition.ncomp;k++) {
+ fprintf(fp1,"%.6e ",
+ E->composition.comp_el[j][k][i]);
+ }
+ fprintf(fp1,"\n");
+ }
+ }
+
+ fclose(fp1);
+ return;
+}
+
+
+void output_heating(struct All_variables *E, int cycles)
+{
+ int j, e;
+ char output_file[255];
+ FILE *fp1;
+
+ sprintf(output_file,"%s.heating.%d.%d", E->control.data_file,
+ E->parallel.me, cycles);
+ fp1 = output_open(output_file, "w");
+
+ fprintf(fp1,"%.5e\n",E->monitor.elapsed_time);
+
+ for(j=1;j<=E->sphere.caps_per_proc;j++) {
+ fprintf(fp1,"%3d %7d\n", j, E->lmesh.nel);
+ for(e=1; e<=E->lmesh.nel; e++)
+ fprintf(fp1, "%.4e %.4e %.4e\n", E->heating_adi[j][e],
+ E->heating_visc[j][e], E->heating_latent[j][e]);
+ }
+ fclose(fp1);
+
+ return;
+}
+
+
+void output_time(struct All_variables *E, int cycles)
+{
+ double CPU_time0();
+
+ double current_time = CPU_time0();
+
+ if (E->parallel.me == 0) {
+ fprintf(E->fptime,"%d %.4e %.4e %.4e %.4e\n",
+ cycles,
+ E->monitor.elapsed_time,
+ E->advection.timestep,
+ current_time - E->monitor.cpu_time_at_start,
+ current_time - E->monitor.cpu_time_at_last_cycle);
+
+ fflush(E->fptime);
+ }
+
+ E->monitor.cpu_time_at_last_cycle = current_time;
+
+ return;
+}
Deleted: mc/3D/CitcomS/branches/cxx/lib/Output_gzdir.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Output_gzdir.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Output_gzdir.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,1451 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-/* Routine to process the output of the finite element cycles
- and to turn them into a coherent suite files */
-
-/*
-
-this version uses gzipped, ascii output to subdirectories for the
-ascii-gz option
-
-if, additionally, gzdir.vtk_io = 1, will write different format files
- for later post-processing into VTK
-
- gzdir.vtk_io = 2, will try to write legacy serial VTK (experimental)
-
- gzdir.vtk_io = 3, will try to write to legacy parallel VTK (experimental)
-
-
-
- the VTK output is the "legacy" type, requires that
- all processors see the same filesystem, and will
- likely lead to a bottleneck for large CPU
- computations as each processor has to wait til the
- previous is done.
-
-TWB
-
-*/
-#ifdef USE_GZDIR
-
-
-//#define ASCII_DEBUG
-
-#include <zlib.h>
-
-#define BE_WERROR {myerror(E,"write error be output");}
-#include <stdio.h>
-#include <stdlib.h>
-#include <math.h>
-#include "element_definitions.h"
-#include "global_defs.h"
-#include "parsing.h"
-#include "parallel_related.h"
-#include "output.h"
-/* Big endian crap */
-#include <string.h>
-#ifdef HAVE_MALLOC_H
-#include <malloc.h>
-#endif
-
-
-void be_flipit(void *, void *, size_t );
-void be_flip_byte_order(void *, size_t );
-int be_is_little_endian(void);
-int be_write_float_to_file(float *, int , FILE *);
-int be_write_int_to_file(int *, int , FILE *);
-void myfprintf(FILE *,char *);
-void calc_cbase_at_node(int , int , float *,struct All_variables *);
-
-/* */
-void get_vtk_filename(char *,int,struct All_variables *,int);
-
-gzFile *gzdir_output_open(char *,char *);
-void gzdir_output(struct All_variables *, int );
-void gzdir_output_comp_nd(struct All_variables *, int);
-void gzdir_output_comp_el(struct All_variables *, int);
-void gzdir_output_coord(struct All_variables *);
-void gzdir_output_mat(struct All_variables *);
-void gzdir_output_velo_temp(struct All_variables *, int);
-void gzdir_output_visc_prepare(struct All_variables *, float **);
-void gzdir_output_visc(struct All_variables *, int);
-void gzdir_output_surf_botm(struct All_variables *, int);
-void gzdir_output_geoid(struct All_variables *, int);
-void gzdir_output_stress(struct All_variables *, int);
-void gzdir_output_horiz_avg(struct All_variables *, int);
-void gzdir_output_tracer(struct All_variables *, int);
-void gzdir_output_pressure(struct All_variables *, int);
-void gzdir_output_heating(struct All_variables *, int);
-
-
-void sub_netr(float, float, float, float *, float *, double *);
-double determine_model_net_rotation(struct All_variables *,double *);
-
-
-void restart_tic_from_gzdir_file(struct All_variables *);
-
-void calc_cbase_at_tp(float , float , float *);
-void rtp2xyz(float , float , float, float *);
-void convert_pvec_to_cvec(float ,float , float , float *,float *);
-void *safe_malloc (size_t );
-
-int open_file_zipped(char *, FILE **,struct All_variables *);
-void gzip_file(char *);
-
-
-extern void temperatures_conform_bcs(struct All_variables *);
-extern void myerror(struct All_variables *,char *);
-extern void mkdatadir(const char *);
-extern void heat_flux(struct All_variables *);
-extern void get_STD_topo(struct All_variables *, float**, float**,
- float**, float**, int);
-extern void get_CBF_topo(struct All_variables *, float**, float**);
-
-/**********************************************************************/
-
-
-void gzdir_output(struct All_variables *E, int out_cycles)
-{
- char output_dir[255];
-
- if (out_cycles == 0 ){
- /* initial I/O */
-
- gzdir_output_coord(E);
- /*gzdir_output_mat(E);*/
- }
-
- /*
- make a new directory for all the other output
-
- (all procs need to do that, because we might be using a local tmp
- dir)
-
- */
- /* make a directory */
- snprintf(output_dir,255,"%s/%d",E->control.data_dir,out_cycles);
-
- mkdatadir(output_dir);
-
-
- /* output */
-
- gzdir_output_velo_temp(E, out_cycles); /* don't move this around,
- else new VTK output won't
- work */
- gzdir_output_visc(E, out_cycles);
-
- gzdir_output_surf_botm(E, out_cycles);
-
- /* optiotnal output below */
- /* compute and output geoid (in spherical harmonics coeff) */
- if (E->output.geoid)
- gzdir_output_geoid(E, out_cycles);
-
- if (E->output.stress){
- gzdir_output_stress(E, out_cycles);
- }
- if (E->output.pressure)
- gzdir_output_pressure(E, out_cycles);
-
- if (E->output.horiz_avg)
- gzdir_output_horiz_avg(E, out_cycles);
-
- if(E->control.tracer){
- if(E->output.tracer ||
- (out_cycles == E->advection.max_timesteps))
- gzdir_output_tracer(E, out_cycles);
- }
-
- if (E->output.comp_nd && E->composition.on)
- gzdir_output_comp_nd(E, out_cycles);
-
- if (E->output.comp_el && E->composition.on)
- gzdir_output_comp_el(E, out_cycles);
-
- if(E->output.heating && E->control.disptn_number != 0)
- gzdir_output_heating(E, out_cycles);
-
- return;
-}
-
-
-gzFile *gzdir_output_open(char *filename,char *mode)
-{
- gzFile *fp1;
-
- if (*filename) {
- fp1 = (gzFile *)gzopen(filename,mode);
- if (!fp1) {
- fprintf(stderr,"gzdir: cannot open file '%s'\n",filename);
- parallel_process_termination();
- }
- }else{
- fprintf(stderr,"gzdir: no file name given '%s'\n",filename);
- parallel_process_termination();
- }
- return fp1;
-}
-
-/*
-
-initialization output of geometries, only called once
-
-
- */
-void gzdir_output_coord(struct All_variables *E)
-{
- int i, j, offset,ix[9],out;
- char output_file[255],ostring[255],message[255];
- float x[3];
- gzFile *gz1;
- FILE *fp1;
- MPI_Status mpi_stat;
- int mpi_rc, mpi_inmsg, mpi_success_message = 1;
- if((E->output.gzdir.vtk_io == 2)||(E->output.gzdir.vtk_io == 3)){
- /*
- direct VTK file output
- */
- if(E->output.gzdir.vtk_io == 2) /* serial */
- parallel_process_sync(E);
- /*
-
- start geometry pre-file, to which data will get appended later
-
- */
- E->output.gzdir.vtk_ocount = -1;
- get_vtk_filename(output_file,1,E,0); /* geometry file */
- if(E->parallel.me == 0){
- /* start log file */
- snprintf(message,255,"%s/vtk_time.log",E->control.data_dir);
- E->output.gzdir.vtk_fp = output_open(message,"w");
- }
- if((E->parallel.me == 0) || (E->output.gzdir.vtk_io == 3)){
- /* either in first CPU or parallel output */
- /* start geo file */
- fp1 = output_open(output_file,"w");
- myfprintf(fp1,"# vtk DataFile Version 2.0\n");
- myfprintf(fp1,"model name, extra info\n");
-#ifdef ASCII_DEBUG
- myfprintf(fp1,"ASCII\n");
-#else
- myfprintf(fp1,"BINARY\n");
-#endif
- myfprintf(fp1,"DATASET UNSTRUCTURED_GRID\n");
- if(E->output.gzdir.vtk_io == 2) /* serial */
- sprintf(message,"POINTS %i float\n", /* total number of nodes */
- E->lmesh.nno * E->parallel.nproc *
- E->sphere.caps_per_proc);
- else /* parallel */
- sprintf(message,"POINTS %i float\n",
- E->lmesh.nno * E->sphere.caps_per_proc);
- myfprintf(fp1,message);
- }else{ /* serial output */
- /* if not first CPU, wait for previous before appending */
- mpi_rc = MPI_Recv(&mpi_inmsg, 1, MPI_INT, (E->parallel.me-1), 0, E->parallel.world, &mpi_stat);
- /* open for append */
- fp1 = output_open(output_file,"a");
- }
- out = 0;
- /* write nodal coordinate to file, big endian */
- for(j=1;j <= E->sphere.caps_per_proc;j++) {
- for(i=1;i <= E->lmesh.nno;i++) {
- x[0]=E->x[j][1][i];x[1]=E->x[j][2][i];x[2]=E->x[j][3][i];
- if(be_write_float_to_file(x,3,fp1) != 3)
- BE_WERROR;
- out++;
- }
- }
- if(E->output.gzdir.vtk_io == 2){ /* serial output, close and have
- next one write */
- fclose(fp1);fflush(fp1); /* close file and flush buffer */
- if(E->parallel.me < E->parallel.nproc-1){/* send to next if not last*/
- mpi_rc = MPI_Send(&mpi_success_message, 1, MPI_INT, (E->parallel.me+1), 0, E->parallel.world);
- }
- /*
- node numbers for all the elements
- */
- parallel_process_sync(E);
- }
- if((E->output.gzdir.vtk_io == 3) || (E->parallel.me == 0)){ /* in first CPU, or parallel output */
- if(E->output.gzdir.vtk_io == 2){ /* need to reopen, serial */
- fp1 = output_open(output_file,"a");
- j = E->parallel.nproc * E->lmesh.nel *
- E->sphere.caps_per_proc; /* total number of elements */
- }else{ /* parallel */
- j = E->lmesh.nel * E->sphere.caps_per_proc;
- }
- sprintf(message,"CELLS %i %i\n", /* number of elements
- total number of int entries
-
- */
- j,j*(enodes[E->mesh.nsd]+1));
- myfprintf(fp1,message);
- }else{
- /* if not first, wait for previous */
- mpi_rc = MPI_Recv(&mpi_inmsg, 1, MPI_INT, (E->parallel.me-1), 0, E->parallel.world, &mpi_stat);
- fp1 = output_open(output_file,"a");
- }
- /*
- write CELL element nodes
- */
- if(enodes[E->mesh.nsd] != 8)
- myerror(E,"vtk error, only eight node hexes supported");
- if(E->output.gzdir.vtk_io == 2){ /* serial, global node numbers */
- offset = E->lmesh.nno * E->parallel.me - 1;
- }else{ /* parallel, only use local node numbers? */
- offset = -1;
- }
- ix[0] = enodes[E->mesh.nsd];
- for(j=1;j <= E->sphere.caps_per_proc;j++) {
- for(i=1;i <= E->lmesh.nel;i++) {
- /*
- need to add offset according to the processor for global
- node numbers
- */
- ix[1]= E->ien[j][i].node[1]+offset;ix[2] = E->ien[j][i].node[2]+offset;
- ix[3]= E->ien[j][i].node[3]+offset;ix[4] = E->ien[j][i].node[4]+offset;
- ix[5]= E->ien[j][i].node[5]+offset;ix[6] = E->ien[j][i].node[6]+offset;
- ix[7]= E->ien[j][i].node[7]+offset;ix[8] = E->ien[j][i].node[8]+offset;
- if(be_write_int_to_file(ix,9,fp1)!=9)
- BE_WERROR;
- }
- }
- if(E->output.gzdir.vtk_io == 2){ /* serial IO */
- fclose(fp1);fflush(fp1); /* close file and flush buffer */
- if(E->parallel.me < E->parallel.nproc-1)
- mpi_rc = MPI_Send(&mpi_success_message, 1, MPI_INT, (E->parallel.me+1), 0, E->parallel.world);
- parallel_process_sync(E);
- }
- if((E->output.gzdir.vtk_io==3) || (E->parallel.me == 0) ){
- if(E->output.gzdir.vtk_io == 2){ /* serial */
- fp1 = output_open(output_file,"a");
- j=E->parallel.nproc*E->lmesh.nel*E->sphere.caps_per_proc;
- }else{ /* parallel */
- j = E->lmesh.nel*E->sphere.caps_per_proc;
- }
- sprintf(message,"CELL_TYPES %i\n",j); /* number of elements*/
- myfprintf(fp1,message);
- ix[0] = 12;
- for(i=0;i<j;i++)
- if(be_write_int_to_file(ix,1,fp1)!=1)BE_WERROR;
- fclose(fp1);fflush(fp1); /* all procs close file and flush buffer */
- if(E->parallel.me == 0)
- fprintf(stderr,"vtk_io: vtk geometry done for %s\n",output_file);
- }
- /* done straight VTK output, geometry part */
- }else{
- /*
-
- either zipped regular, or old VTK type for post-processing
-
- */
- /*
- don't use data file name
- */
- snprintf(output_file,255,"%s/coord.%d.gz",
- E->control.data_dir,E->parallel.me);
- gz1 = gzdir_output_open(output_file,"w");
-
- /* nodal coordinates */
- for(j=1;j<=E->sphere.caps_per_proc;j++) {
- gzprintf(gz1,"%3d %7d\n",j,E->lmesh.nno);
- for(i=1;i<=E->lmesh.nno;i++)
- gzprintf(gz1,"%.6e %.6e %.6e\n",
- E->sx[j][1][i],E->sx[j][2][i],E->sx[j][3][i]);
- }
-
- gzclose(gz1);
- if(E->output.gzdir.vtk_io == 1){
- /*
-
- output of Cartesian coordinates and element connectivitiy for
- vtk visualization
-
- */
- /*
- nodal coordinates in Cartesian
- */
- snprintf(output_file,255,"%s/vtk_ecor.%d.gz",
- E->control.data_dir,E->parallel.me);
- gz1 = gzdir_output_open(output_file,"w");
- for(j=1;j <= E->sphere.caps_per_proc;j++) {
- for(i=1;i <= E->lmesh.nno;i++) {
- gzprintf(gz1,"%9.6f %9.6f %9.6f\n", /* cartesian nodal coordinates */
- E->x[j][1][i],E->x[j][2][i],E->x[j][3][i]);
- }
- }
- gzclose(gz1);
- /*
- connectivity for all elements
- */
- offset = E->lmesh.nno * E->parallel.me - 1;
- snprintf(output_file,255,"%s/vtk_econ.%d.gz",
- E->control.data_dir,E->parallel.me);
- gz1 = gzdir_output_open(output_file,"w");
- for(j=1;j <= E->sphere.caps_per_proc;j++) {
- for(i=1;i <= E->lmesh.nel;i++) {
- gzprintf(gz1,"%2i\t",enodes[E->mesh.nsd]);
- if(enodes[E->mesh.nsd] != 8){
- gzprintf(stderr,"gzdir: Output: error, only eight node hexes supported");
- parallel_process_termination();
- }
- /*
- need to add offset according to the processor for global
- node numbers
- */
- gzprintf(gz1,"%6i %6i %6i %6i %6i %6i %6i %6i\n",
- E->ien[j][i].node[1]+offset,E->ien[j][i].node[2]+offset,
- E->ien[j][i].node[3]+offset,E->ien[j][i].node[4]+offset,
- E->ien[j][i].node[5]+offset,E->ien[j][i].node[6]+offset,
- E->ien[j][i].node[7]+offset,E->ien[j][i].node[8]+offset);
- }
- }
- gzclose(gz1);
- } /* end vtkio = 1 (pre VTK) */
- }
-
- return;
-}
-
-/*
-
-this needs to be called after the geometry files have been
-established, and before any of the other stuff if VTK straight output
-is chosen
-
-
-*/
-void gzdir_output_velo_temp(struct All_variables *E, int cycles)
-{
- int i, j, k,os;
- char output_file[255],output_file2[255],message[255],geo_file[255];
- float cvec[3],vcorr[3];
- double omega[3],oamp;
- gzFile *gzout;
- FILE *fp1;
- /* for dealing with several processors */
- MPI_Status mpi_stat;
- int mpi_rc;
- int mpi_inmsg, mpi_success_message = 1;
-
-
- if(E->output.gzdir.vtk_io){ /* all VTK modes need basis vectors */
- os = E->lmesh.nno*9;
- if((!E->output.gzdir.vtk_base_init) ||(!E->output.gzdir.vtk_base_save)){
- /* either not computed, or need to compute anew */
- if(!E->output.gzdir.vtk_base_init) /* init space */
- E->output.gzdir.vtk_base = (float *)safe_malloc(sizeof(float)*os*E->sphere.caps_per_proc);
- /* compute */
- for(k=0,j=1;j <= E->sphere.caps_per_proc;j++,k += os) {
- for(i=1;i <= E->lmesh.nno;i++,k += 9){
- /* cartesian basis vectors at theta, phi */
- calc_cbase_at_node(j,i,(E->output.gzdir.vtk_base+k),E);
- }
- }
- E->output.gzdir.vtk_base_init = 1;
- }
- }
-
- if(E->output.gzdir.rnr){ /* remove the whole model net rotation */
- if((E->control.remove_rigid_rotation)&&
- (E->parallel.me == 0)) /* that's not too terrible but wastes time */
- fprintf(stderr,"WARNING: both gzdir.rnr and remove_rigid_rotation are switched on!\n");
- oamp = determine_model_net_rotation(E,omega);
- if(E->parallel.me == 0)
- fprintf(stderr,"gzdir_output_velo_temp: removing net rotation: |%8.3e, %8.3e, %8.3e| = %8.3e\n",
- omega[0],omega[1],omega[2],oamp);
- }
- if((E->output.gzdir.vtk_io == 2) || (E->output.gzdir.vtk_io == 3)){
- /*
-
- direct VTK
-
- */
- if(E->output.gzdir.vtk_io == 2)
- parallel_process_sync(E); /* serial needs sync */
-
- E->output.gzdir.vtk_ocount++; /* regular output file name */
- get_vtk_filename(geo_file,1,E,cycles);
- get_vtk_filename(output_file,0,E,cycles);
- /*
-
- start with temperature
-
- */
- if((E->parallel.me == 0) || (E->output.gzdir.vtk_io == 3)){
- /* copy geo file over to start out vtk file */
- snprintf(output_file2,255,"cp %s %s",geo_file,output_file);
- system(output_file2);
- /* should we do something to check if this has worked? */
- if(E->parallel.me == 0){
- /* write a time log */
- fprintf(E->output.gzdir.vtk_fp,"%12i %12i %12.6e %s\n",
- E->output.gzdir.vtk_ocount,cycles,E->monitor.elapsed_time,output_file);
- }
- fp1 = output_open(output_file,"a");
- if(E->output.gzdir.vtk_io == 2) /* serial */
- sprintf(message,"POINT_DATA %i\n",E->lmesh.nno*E->parallel.nproc*E->sphere.caps_per_proc);
- else /* parallel */
- sprintf(message,"POINT_DATA %i\n",E->lmesh.nno*E->sphere.caps_per_proc);
- myfprintf(fp1,message);
- myfprintf(fp1,"SCALARS temperature float 1\n");
- myfprintf(fp1,"LOOKUP_TABLE default\n");
- }else{
- /* if not first, wait for previous */
- mpi_rc = MPI_Recv(&mpi_inmsg, 1, MPI_INT, (E->parallel.me-1), 7, E->parallel.world, &mpi_stat);
- /* open for append */
- fp1 = output_open(output_file,"a");
- }
- for(j=1; j<= E->sphere.caps_per_proc;j++) /* print the temperatures */
- for(i=1;i<=E->lmesh.nno;i++){
- cvec[0] = E->T[j][i];
- if(be_write_float_to_file(cvec,1,fp1)!=1)
- BE_WERROR;
- }
- if(E->output.gzdir.vtk_io == 2){
- fclose(fp1);fflush(fp1); /* close file and flush buffer */
- if(E->parallel.me < E->parallel.nproc-1){
- mpi_rc = MPI_Send(&mpi_success_message, 1, MPI_INT, (E->parallel.me+1), 7, E->parallel.world);
- }else{
- mpi_rc = MPI_Send(&mpi_success_message, 1, MPI_INT, 0, 6, E->parallel.world); /* tell m=0 to go ahead */
- }
- }
- /*
- velocities second
- */
- if((E->output.gzdir.vtk_io == 3) || (E->parallel.me == 0)){
- if(E->output.gzdir.vtk_io == 2){
- mpi_rc = MPI_Recv(&mpi_inmsg, 1, MPI_INT, E->parallel.nproc-1 , 6, E->parallel.world, &mpi_stat);
- fp1 = output_open(output_file,"a"); /* append velocities */
- }
- sprintf(message,"VECTORS velocity float\n");myfprintf(fp1,message);
- }else{
- mpi_rc = MPI_Recv(&mpi_inmsg, 1, MPI_INT, (E->parallel.me-1), 5, E->parallel.world, &mpi_stat);
- fp1 = output_open(output_file,"a");
- }
- for(k=0,j=1;j <= E->sphere.caps_per_proc;j++,k += os) {
- if(E->output.gzdir.rnr){
- /* remove NR */
- for(i=1;i<=E->lmesh.nno;i++,k += 9) {
- vcorr[0] = E->sphere.cap[j].V[1][i]; /* vtheta */
- vcorr[1] = E->sphere.cap[j].V[2][i]; /* vphi */
- /* remove the velocity that corresponds to a net rotation of omega[0..2] at location
- r,t,p from the t,p velocities in vcorr[0..1]
- */
- sub_netr(E->sx[j][3][i],E->sx[j][1][i],E->sx[j][2][i],(vcorr+0),(vcorr+1),omega);
-
- convert_pvec_to_cvec(E->sphere.cap[j].V[3][i],vcorr[0],vcorr[1],
- (E->output.gzdir.vtk_base+k),cvec);
- if(be_write_float_to_file(cvec,3,fp1)!=3)BE_WERROR;
- }
- }else{
- /* regular output */
- for(i=1;i<=E->lmesh.nno;i++,k += 9) {
- convert_pvec_to_cvec(E->sphere.cap[j].V[3][i],E->sphere.cap[j].V[1][i],E->sphere.cap[j].V[2][i],
- (E->output.gzdir.vtk_base+k),cvec);
- if(be_write_float_to_file(cvec,3,fp1)!=3)BE_WERROR;
- }
- }
- }
- fclose(fp1);fflush(fp1); /* close file and flush buffer */
- if(E->output.gzdir.vtk_io == 2){
- if(E->parallel.me < E->parallel.nproc-1){
- mpi_rc = MPI_Send(&mpi_success_message, 1, MPI_INT, (E->parallel.me+1), 5, E->parallel.world);
- }else{
- fprintf(stderr,"vtk_io: geo, temp, & vel writtend to %s\n",output_file);
- }
- }else{
- if(E->parallel.me == 0)
- fprintf(stderr,"vtk_io: geo, temp, & vel written to %s\n",output_file);
- }
- /* new VTK velo and temp done */
- }else{
- /*
-
- modified zipped output
-
- */
- /*
-
-
- temperatures are printed along with velocities for old type of
- output
-
- if VTK is selected, will generate a separate temperature file
-
- */
- if(E->output.gzdir.vtk_io == 1) {
- /*
- for VTK, only print temperature
- */
- snprintf(output_file2,255,"%s/%d/t.%d.%d",
- E->control.data_dir,
- cycles,E->parallel.me,cycles);
- }else{ /* vel + T for old output */
- snprintf(output_file2,255,"%s/%d/velo.%d.%d",
- E->control.data_dir,cycles,
- E->parallel.me,cycles);
- }
- snprintf(output_file,255,"%s.gz",output_file2); /* add the .gz */
-
- gzout = gzdir_output_open(output_file,"w");
- gzprintf(gzout,"%d %d %.5e\n",
- cycles,E->lmesh.nno,E->monitor.elapsed_time);
- for(j=1; j<= E->sphere.caps_per_proc;j++) {
- gzprintf(gzout,"%3d %7d\n",j,E->lmesh.nno);
- if(E->output.gzdir.vtk_io){
- /* VTK */
- for(i=1;i<=E->lmesh.nno;i++)
- gzprintf(gzout,"%.6e\n",E->T[j][i]);
- } else {
- /* old velo + T output */
- if(E->output.gzdir.rnr){
- /* remove NR */
- for(i=1;i<=E->lmesh.nno;i++){
- vcorr[0] = E->sphere.cap[j].V[1][i]; /* vt */
- vcorr[1] = E->sphere.cap[j].V[2][i]; /* vphi */
- sub_netr(E->sx[j][3][i],E->sx[j][1][i],E->sx[j][2][i],(vcorr+0),(vcorr+1),omega);
- gzprintf(gzout,"%.6e %.6e %.6e %.6e\n",
- vcorr[0],vcorr[1],
- E->sphere.cap[j].V[3][i],E->T[j][i]);
-
- }
- }else{
- for(i=1;i<=E->lmesh.nno;i++)
- gzprintf(gzout,"%.6e %.6e %.6e %.6e\n",
- E->sphere.cap[j].V[1][i],
- E->sphere.cap[j].V[2][i],
- E->sphere.cap[j].V[3][i],E->T[j][i]);
- }
- }
- }
- gzclose(gzout);
- if(E->output.gzdir.vtk_io){
- /*
- write Cartesian velocities to file
- */
- snprintf(output_file,255,"%s/%d/vtk_v.%d.%d.gz",
- E->control.data_dir,cycles,E->parallel.me,cycles);
- gzout = gzdir_output_open(output_file,"w");
- for(k=0,j=1;j <= E->sphere.caps_per_proc;j++,k += os) {
- if(E->output.gzdir.rnr){
- /* remove NR */
- for(i=1;i<=E->lmesh.nno;i++,k += 9) {
- vcorr[0] = E->sphere.cap[j].V[1][i];
- vcorr[1] = E->sphere.cap[j].V[2][i];
- sub_netr(E->sx[j][3][i],E->sx[j][1][i],E->sx[j][2][i],(vcorr+0),(vcorr+1),omega);
- convert_pvec_to_cvec(E->sphere.cap[j].V[3][i],vcorr[0],vcorr[1],
- (E->output.gzdir.vtk_base+k),cvec);
- gzprintf(gzout,"%10.4e %10.4e %10.4e\n",cvec[0],cvec[1],cvec[2]);
- }
- }else{
- /* regular output */
- for(i=1;i<=E->lmesh.nno;i++,k += 9) {
- /* convert r,theta,phi vector to x,y,z at base location */
- convert_pvec_to_cvec(E->sphere.cap[j].V[3][i],
- E->sphere.cap[j].V[1][i],
- E->sphere.cap[j].V[2][i],
- (E->output.gzdir.vtk_base+k),cvec);
- /* output of cartesian vector */
- gzprintf(gzout,"%10.4e %10.4e %10.4e\n",
- cvec[0],cvec[1],cvec[2]);
- }
- }
- }
- gzclose(gzout);
-
- }
- } /* end gzipped and old VTK out */
- if(E->output.gzdir.vtk_io){ /* all VTK modes */
- /* free memory */
- if(!E->output.gzdir.vtk_base_save)
- free(E->output.gzdir.vtk_base);
- }
- return;
-}
-
-/*
- viscosity
-*/
-void gzdir_output_visc(struct All_variables *E, int cycles)
-{
- int i, j;
- char output_file[255];
- gzFile *gz1;
- FILE *fp1;
- int lev = E->mesh.levmax;
- float ftmp;
- /* for dealing with several processors */
- MPI_Status mpi_stat;
- int mpi_rc;
- int mpi_inmsg, mpi_success_message = 1;
-
-
- if(E->output.gzdir.vtk_io < 2){
- snprintf(output_file,255,
- "%s/%d/visc.%d.%d.gz", E->control.data_dir,
- cycles,E->parallel.me, cycles);
- gz1 = gzdir_output_open(output_file,"w");
- for(j=1;j<=E->sphere.caps_per_proc;j++) {
- gzprintf(gz1,"%3d %7d\n",j,E->lmesh.nno);
- for(i=1;i<=E->lmesh.nno;i++)
- gzprintf(gz1,"%.4e\n",E->VI[lev][j][i]);
- }
-
- gzclose(gz1);
- }else{
- if(E->output.gzdir.vtk_io == 2)
- parallel_process_sync(E);
- /* new legacy VTK */
- get_vtk_filename(output_file,0,E,cycles);
- if((E->parallel.me == 0) || (E->output.gzdir.vtk_io == 3)){
- fp1 = output_open(output_file,"a");
- myfprintf(fp1,"SCALARS log10(visc) float 1\n");
- myfprintf(fp1,"LOOKUP_TABLE default\n");
- }else{
- /* if not first, wait for previous */
- mpi_rc = MPI_Recv(&mpi_inmsg, 1, MPI_INT, (E->parallel.me-1), 0, E->parallel.world, &mpi_stat);
- /* open for append */
- fp1 = output_open(output_file,"a");
- }
- for(j=1; j<= E->sphere.caps_per_proc;j++)
- for(i=1;i<=E->lmesh.nno;i++){
- ftmp = log10(E->VI[lev][j][i]);
- if(fabs(ftmp) < 5e-7)ftmp = 0.0;
- if(be_write_float_to_file(&ftmp,1,fp1)!=1)BE_WERROR;
- }
- fclose(fp1);fflush(fp1); /* close file and flush buffer */
- if(E->output.gzdir.vtk_io == 2)
- if(E->parallel.me < E->parallel.nproc-1){
- mpi_rc = MPI_Send(&mpi_success_message, 1, MPI_INT, (E->parallel.me+1), 0, E->parallel.world);
- }
- }
- return;
-}
-
-
-
-void gzdir_output_surf_botm(struct All_variables *E, int cycles)
-{
- int i, j, s;
- char output_file[255];
- gzFile *fp2;
- float *topo;
-
- if((E->output.write_q_files == 0) || (cycles == 0) ||
- (cycles % E->output.write_q_files)!=0)
- heat_flux(E);
- /* else, the heat flux will have been computed already */
-
- if(E->control.use_cbf_topo){
- get_CBF_topo(E,E->slice.tpg,E->slice.tpgb);
- }else{
- get_STD_topo(E,E->slice.tpg,E->slice.tpgb,E->slice.divg,E->slice.vort,cycles);
- }
-
-
- if (E->output.surf && (E->parallel.me_loc[3]==E->parallel.nprocz-1)) {
- snprintf(output_file,255,"%s/%d/surf.%d.%d.gz", E->control.data_dir,
- cycles,E->parallel.me, cycles);
- fp2 = gzdir_output_open(output_file,"w");
-
- for(j=1;j<=E->sphere.caps_per_proc;j++) {
- /* choose either STD topo or pseudo-free-surf topo */
- if(E->control.pseudo_free_surf)
- topo = E->slice.freesurf[j];
- else
- topo = E->slice.tpg[j];
-
- gzprintf(fp2,"%3d %7d\n",j,E->lmesh.nsf);
- for(i=1;i<=E->lmesh.nsf;i++) {
- s = i*E->lmesh.noz;
- gzprintf(fp2,"%.4e %.4e %.4e %.4e\n",
- topo[i],E->slice.shflux[j][i],E->sphere.cap[j].V[1][s],E->sphere.cap[j].V[2][s]);
- }
- }
- gzclose(fp2);
- }
-
-
- if (E->output.botm && (E->parallel.me_loc[3]==0)) {
- snprintf(output_file,255,"%s/%d/botm.%d.%d.gz", E->control.data_dir,
- cycles,E->parallel.me, cycles);
- fp2 = gzdir_output_open(output_file,"w");
-
- for(j=1;j<=E->sphere.caps_per_proc;j++) {
- gzprintf(fp2,"%3d %7d\n",j,E->lmesh.nsf);
- for(i=1;i<=E->lmesh.nsf;i++) {
- s = (i-1)*E->lmesh.noz + 1;
- gzprintf(fp2,"%.4e %.4e %.4e %.4e\n",
- E->slice.tpgb[j][i],E->slice.bhflux[j][i],E->sphere.cap[j].V[1][s],E->sphere.cap[j].V[2][s]);
- }
- }
- gzclose(fp2);
- }
-
- return;
-}
-
-
-void gzdir_output_geoid(struct All_variables *E, int cycles)
-{
- void compute_geoid();
- int ll, mm, p;
- char output_file[255];
- gzFile *fp1;
-
- compute_geoid(E);
-
- if (E->parallel.me == (E->parallel.nprocz-1)) {
- snprintf(output_file, 255,
- "%s/%d/geoid.%d.%d.gz", E->control.data_dir,
- cycles,E->parallel.me, cycles);
- fp1 = gzdir_output_open(output_file,"w");
-
- /* write headers */
- gzprintf(fp1, "%d %d %.5e\n", cycles, E->output.llmax,
- E->monitor.elapsed_time);
-
- /* write sph harm coeff of geoid and topos */
- for (ll=0; ll<=E->output.llmax; ll++)
- for(mm=0; mm<=ll; mm++) {
- p = E->sphere.hindex[ll][mm];
- gzprintf(fp1,"%d %d %.4e %.4e %.4e %.4e %.4e %.4e\n",
- ll, mm,
- E->sphere.harm_geoid[0][p],
- E->sphere.harm_geoid[1][p],
- E->sphere.harm_geoid_from_tpgt[0][p],
- E->sphere.harm_geoid_from_tpgt[1][p],
- E->sphere.harm_geoid_from_bncy[0][p],
- E->sphere.harm_geoid_from_bncy[1][p]);
-
- }
-
- gzclose(fp1);
- }
-}
-
-
-
-void gzdir_output_stress(struct All_variables *E, int cycles)
-{
- int m, node;
- char output_file[255];
- gzFile *fp1;
- /* for stress computation */
- void allocate_STD_mem();
- void compute_nodal_stress();
- void free_STD_mem();
- float *SXX[NCS],*SYY[NCS],*SXY[NCS],*SXZ[NCS],*SZY[NCS],*SZZ[NCS];
- float *divv[NCS],*vorv[NCS];
- /* */
- if(E->control.use_cbf_topo) {/* for CBF topo, stress will not have been computed */
- allocate_STD_mem(E, SXX, SYY, SZZ, SXY, SXZ, SZY, divv, vorv);
- compute_nodal_stress(E, SXX, SYY, SZZ, SXY, SXZ, SZY, divv, vorv);
- free_STD_mem(E, SXX, SYY, SZZ, SXY, SXZ, SZY, divv, vorv);
- }
-
- snprintf(output_file,255,"%s/%d/stress.%d.%d.gz", E->control.data_dir,
- cycles,E->parallel.me, cycles);
- fp1 = gzdir_output_open(output_file,"w");
-
- gzprintf(fp1,"%d %d %.5e\n",cycles,E->lmesh.nno,E->monitor.elapsed_time);
-
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
- gzprintf(fp1,"%3d %7d\n",m,E->lmesh.nno);
- for (node=1;node<=E->lmesh.nno;node++)
- gzprintf(fp1, "%.4e %.4e %.4e %.4e %.4e %.4e\n",
- E->gstress[m][(node-1)*6+1], /* stt */
- E->gstress[m][(node-1)*6+2], /* spp */
- E->gstress[m][(node-1)*6+3], /* srr */
- E->gstress[m][(node-1)*6+4], /* stp */
- E->gstress[m][(node-1)*6+5], /* str */
- E->gstress[m][(node-1)*6+6]); /* srp */
- }
- gzclose(fp1);
-}
-
-
-void gzdir_output_horiz_avg(struct All_variables *E, int cycles)
-{
- /* horizontal average output of temperature, composition and rms velocity*/
- void compute_horiz_avg();
-
- int j;
- char output_file[255];
- gzFile *fp1;
-
- /* compute horizontal average here.... */
- compute_horiz_avg(E);
-
- /* only the first nprocz processors need to output */
-
- if (E->parallel.me<E->parallel.nprocz) {
- snprintf(output_file,255,"%s/%d/horiz_avg.%d.%d.gz", E->control.data_dir,
- cycles,E->parallel.me, cycles);
- fp1=gzdir_output_open(output_file,"w");
- for(j=1;j<=E->lmesh.noz;j++) {
- gzprintf(fp1,"%.4e %.4e %.4e %.4e",E->sx[1][3][j],E->Have.T[j],E->Have.V[1][j],E->Have.V[2][j]);
-
- if (E->composition.on) {
- int n;
- for(n=0; n<E->composition.ncomp; n++)
- gzprintf(fp1," %.4e", E->Have.C[n][j]);
- }
- gzprintf(fp1,"\n");
- }
- gzclose(fp1);
- }
-
- return;
-}
-
-
-/* only called once */
-void gzdir_output_mat(struct All_variables *E)
-{
- int m, el;
- char output_file[255];
- gzFile* fp;
-
- snprintf(output_file,255,"%s/mat.%d.gz", E->control.data_dir,E->parallel.me);
- fp = gzdir_output_open(output_file,"w");
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for(el=1;el<=E->lmesh.nel;el++)
- gzprintf(fp,"%d %d %f\n", el,E->mat[m][el],E->VIP[m][el]);
-
- gzclose(fp);
-
- return;
-}
-
-
-
-void gzdir_output_pressure(struct All_variables *E, int cycles)
-{
- int i, j;
- float ftmp;
- char output_file[255];
- gzFile *gz1;
- FILE *fp1;
- /* for dealing with several processors */
- MPI_Status mpi_stat;
- int mpi_rc;
- int mpi_inmsg, mpi_success_message = 1;
-
- if(E->output.gzdir.vtk_io < 2){ /* old */
- snprintf(output_file,255,"%s/%d/pressure.%d.%d.gz", E->control.data_dir,cycles,
- E->parallel.me, cycles);
- gz1 = gzdir_output_open(output_file,"w");
- gzprintf(gz1,"%d %d %.5e\n",cycles,E->lmesh.nno,E->monitor.elapsed_time);
- for(j=1;j<=E->sphere.caps_per_proc;j++) {
- gzprintf(gz1,"%3d %7d\n",j,E->lmesh.nno);
- for(i=1;i<=E->lmesh.nno;i++)
- gzprintf(gz1,"%.6e\n",E->NP[j][i]);
- }
- gzclose(gz1);
- }else{/* new legacy VTK */
- if(E->output.gzdir.vtk_io == 2)
- parallel_process_sync(E);
- get_vtk_filename(output_file,0,E,cycles);
- if((E->parallel.me == 0) || (E->output.gzdir.vtk_io == 3)){
- fp1 = output_open(output_file,"a");
- myfprintf(fp1,"SCALARS pressure float 1\n");
- myfprintf(fp1,"LOOKUP_TABLE default\n");
- }else{
- mpi_rc = MPI_Recv(&mpi_inmsg, 1, MPI_INT, (E->parallel.me-1), 0, E->parallel.world, &mpi_stat);
- fp1 = output_open(output_file,"a");
- }
- for(j=1; j<= E->sphere.caps_per_proc;j++)
- for(i=1;i<=E->lmesh.nno;i++){
- ftmp = E->NP[j][i];
- if(be_write_float_to_file(&ftmp,1,fp1)!=1)BE_WERROR;
- }
- fclose(fp1);fflush(fp1); /* close file and flush buffer */
- if(E->output.gzdir.vtk_io == 2)
- if(E->parallel.me < E->parallel.nproc-1){
- mpi_rc = MPI_Send(&mpi_success_message, 1, MPI_INT, (E->parallel.me+1), 0, E->parallel.world);
- }
- }
- return;
-}
-
-
-
-void gzdir_output_tracer(struct All_variables *E, int cycles)
-{
- int i, j, n, ncolumns;
- char output_file[255];
- gzFile *fp1;
-
- snprintf(output_file,255,"%s/%d/tracer.%d.%d.gz",
- E->control.data_dir,cycles,
- E->parallel.me, cycles);
- fp1 = gzdir_output_open(output_file,"w");
-
- ncolumns = 3 + E->trace.number_of_extra_quantities;
-
- for(j=1;j<=E->sphere.caps_per_proc;j++) {
- gzprintf(fp1,"%d %d %d %.5e\n", cycles, E->trace.ntracers[j],
- ncolumns, E->monitor.elapsed_time);
-
- for(n=1;n<=E->trace.ntracers[j];n++) {
- /* write basic quantities (coordinate) */
- gzprintf(fp1,"%9.5e %9.5e %9.5e",
- E->trace.basicq[j][0][n],
- E->trace.basicq[j][1][n],
- E->trace.basicq[j][2][n]);
-
- /* write extra quantities */
- for (i=0; i<E->trace.number_of_extra_quantities; i++) {
- gzprintf(fp1," %9.5e", E->trace.extraq[j][i][n]);
- }
- gzprintf(fp1, "\n");
- }
-
- }
-
- gzclose(fp1);
- return;
-}
-
-
-void gzdir_output_comp_nd(struct All_variables *E, int cycles)
-{
- int i, j, k;
- char output_file[255],message[255];
- gzFile *gz1;
- FILE *fp1;
- float ftmp;
- /* for dealing with several processors */
- MPI_Status mpi_stat;
- int mpi_rc;
- int mpi_inmsg, mpi_success_message = 1;
-
- if(E->output.gzdir.vtk_io < 2){
- snprintf(output_file,255,"%s/%d/comp_nd.%d.%d.gz",
- E->control.data_dir,cycles,
- E->parallel.me, cycles);
- gz1 = gzdir_output_open(output_file,"w");
- for(j=1;j<=E->sphere.caps_per_proc;j++) {
- gzprintf(gz1,"%3d %7d %.5e %.5e %.5e\n",
- j, E->lmesh.nel,
- E->monitor.elapsed_time,
- E->composition.initial_bulk_composition,
- E->composition.bulk_composition);
- for(i=1;i<=E->lmesh.nno;i++) {
- for(k=0;k<E->composition.ncomp;k++)
- gzprintf(gz1,"%.6e ",E->composition.comp_node[j][k][i]);
- gzprintf(gz1,"\n");
- }
- }
- gzclose(gz1);
- }else{/* new legacy VTK */
- if(E->output.gzdir.vtk_io == 2)
- parallel_process_sync(E);
- get_vtk_filename(output_file,0,E,cycles);
- if((E->output.gzdir.vtk_io==3) || (E->parallel.me == 0)){
- fp1 = output_open(output_file,"a");
- if(E->composition.ncomp > 4)
- myerror(E,"vtk out error: ncomp out of bounds (needs to be < 4)");
- sprintf(message,"SCALARS composition float %d\n",E->composition.ncomp);
- myfprintf(fp1,message);
- myfprintf(fp1,"LOOKUP_TABLE default\n");
- }else{ /* serial wait */
- mpi_rc = MPI_Recv(&mpi_inmsg, 1, MPI_INT, (E->parallel.me-1), 0, E->parallel.world, &mpi_stat);
- fp1 = output_open(output_file,"a");
- }
- for(j=1; j<= E->sphere.caps_per_proc;j++)
- for(i=1;i<=E->lmesh.nno;i++){
- for(k=0;k<E->composition.ncomp;k++){
- ftmp = E->composition.comp_node[j][k][i];
- if(be_write_float_to_file(&ftmp,1,fp1)!=1)BE_WERROR;
- }
- }
- fclose(fp1);fflush(fp1); /* close file and flush buffer */
- if(E->output.gzdir.vtk_io == 2) /* serial */
- if(E->parallel.me < E->parallel.nproc-1){
- mpi_rc = MPI_Send(&mpi_success_message, 1, MPI_INT, (E->parallel.me+1), 0, E->parallel.world);
- }
- }
- return;
-}
-
-
-void gzdir_output_comp_el(struct All_variables *E, int cycles)
-{
- int i, j, k;
- char output_file[255];
- gzFile *fp1;
-
- snprintf(output_file,255,"%s/%d/comp_el.%d.%d.gz", E->control.data_dir,
- cycles,E->parallel.me, cycles);
- fp1 = gzdir_output_open(output_file,"w");
-
- for(j=1;j<=E->sphere.caps_per_proc;j++) {
- gzprintf(fp1,"%3d %7d %.5e %.5e %.5e\n",
- j, E->lmesh.nel,
- E->monitor.elapsed_time,
- E->composition.initial_bulk_composition,
- E->composition.bulk_composition);
-
- for(i=1;i<=E->lmesh.nel;i++) {
- for(k=0;k<E->composition.ncomp;k++)
- gzprintf(fp1,"%.6e ",E->composition.comp_el[j][k][i]);
- gzprintf(fp1,"\n");
- }
- }
-
- gzclose(fp1);
- return;
-}
-
-
-void gzdir_output_heating(struct All_variables *E, int cycles)
-{
- int j, e;
- char output_file[255];
- gzFile *fp1;
-
- snprintf(output_file,255,"%s/%d/heating.%d.%d.gz", E->control.data_dir,
- cycles,E->parallel.me, cycles);
- fp1 = gzdir_output_open(output_file,"w");
-
- gzprintf(fp1,"%.5e\n",E->monitor.elapsed_time);
-
- for(j=1;j<=E->sphere.caps_per_proc;j++) {
- gzprintf(fp1,"%3d %7d\n", j, E->lmesh.nel);
- for(e=1; e<=E->lmesh.nel; e++)
- gzprintf(fp1, "%.4e %.4e %.4e\n", E->heating_adi[j][e],
- E->heating_visc[j][e], E->heating_latent[j][e]);
- }
- gzclose(fp1);
-
- return;
-}
-
-
-/*
-
-restart facility for zipped/VTK style , will init temperature
-
-*/
-void restart_tic_from_gzdir_file(struct All_variables *E)
-{
- int ii, ll, mm,rezip;
- float restart_elapsed_time;
- int i, m;
- char output_file[255], input_s[1000];
- FILE *fp;
-
- float v1, v2, v3, g;
-
- ii = E->monitor.solution_cycles_init;
- switch(E->output.gzdir.vtk_io){
- case 2:
- case 3:
- myerror(E,"sorry, restart with vtk_io 2 or 3 not implemented yet");
- break;
- case 1:
- /* VTK I/O */
- snprintf(output_file,255,"%s/%d/t.%d.%d",
- E->control.data_dir_old,
- ii,E->parallel.me,ii);
- break;
- default:
- snprintf(output_file,255,"%s/%d/velo.%d.%d",
- E->control.data_dir_old,ii,
- E->parallel.me,ii);
- break;
- }
- /* open file */
- rezip = open_file_zipped(output_file,&fp,E);
- if (E->parallel.me==0){
- fprintf(stderr,"restart_tic_from_gzdir_file: using %s for restarted temperature\n",
- output_file);
- fprintf(E->fp,"restart_tic_from_gzdir_file: using %s for restarted temperature\n",
- output_file);
- }
- if(fscanf(fp,"%i %i %f",&ll,&mm,&restart_elapsed_time) != 3)
- myerror(E,"restart vtkl read error 0");
- if(mm != E->lmesh.nno){
- fprintf(stderr,"%i %i\n",mm, E->lmesh.nno);
- myerror(E,"lmesh.nno mismatch in restart files");
- }
-
- switch(E->output.gzdir.vtk_io) {
- case 1: /* VTK */
- for(m=1;m <= E->sphere.caps_per_proc;m++) {
- if(fscanf(fp,"%i %i",&ll,&mm) != 2)
- myerror(E,"restart vtkl read error 1");
- for(i=1;i<=E->lmesh.nno;i++){
- if(fscanf(fp,"%f",&g) != 1)
- myerror(E,"restart vtkl read error 2");
- if(!finite(g)){
- fprintf(stderr,"WARNING: found a NaN in input temperatures\n");
- g=0.0;
- }
- E->T[m][i] = g;
- }
- }
- break;
- default: /* old style velo */
- for(m=1;m <= E->sphere.caps_per_proc;m++) {
- fscanf(fp,"%i %i",&ll,&mm);
- for(i=1;i<=E->lmesh.nno;i++) {
- fscanf(fp,"%f %f %f %f",&v1,&v2,&v3,&g);
- /* E->sphere.cap[m].V[1][i] = v1;
- E->sphere.cap[m].V[1][i] = v2;
- E->sphere.cap[m].V[1][i] = v3; */
- /* I don't like that */
- //E->T[m][i] = max(0.0,min(g,1.0));
- E->T[m][i] = g;
- }
- }
- break;
- }
- fclose (fp);
- if(rezip) /* rezip */
- gzip_file(output_file);
-
- temperatures_conform_bcs(E);
-
- return;
-}
-
-
-/*
-
-tries to open 'name'. if name exists, out will be pointer to file and
-return 0. if name doesn't exist, will check for name.gz. if this
-exists, will unzip and open, and return 1
-
-the idea is to preserve the initial file state
-
-*/
-int open_file_zipped(char *name, FILE **in,
- struct All_variables *E)
-{
- char mstring[1000];
- *in = fopen(name,"r");
- if (*in == NULL) {
- /*
- unzipped file not found
- */
- snprintf(mstring,1000,"%s.gz",name);
- *in= fopen(mstring,"r");
- if(*in != NULL){
- /*
- zipped version was found
- */
- fclose(*in);
- snprintf(mstring,1000,"gunzip -f %s.gz",name); /* brutal */
- system(mstring); /* unzip */
- /* open unzipped file for read */
- *in = fopen(name,"r");
- if(*in == NULL)
- myerror(E,"open_file_zipped: unzipping error");
- return 1;
- }else{
- /*
- no file, either zipped or unzipped
- */
- snprintf(mstring,1000,"no files %s and %s.gz were found, exiting",
- name,name);
- myerror(E,mstring);
- return 0;
- }
- }else{
- /*
- file was found unzipped
- */
- return 0;
- }
-}
-
-/* compress a file using the sytem command */
-void gzip_file(char *output_file)
-{
- char command_string[300];
- snprintf(command_string,300,"gzip -f %s",output_file); /* brutal */
- system(command_string);
-}
-
-
-
-
-void get_vtk_filename(char *output_file,
- int geo,struct All_variables *E,
- int cycles)
-{
- if(E->output.gzdir.vtk_io == 2){ /* serial */
- if(geo) /* geometry */
- sprintf(output_file,"%s/vtk_geo",
- E->control.data_dir);
- else /* data part */
- sprintf(output_file,"%s/d.%08i.vtk",
- E->control.data_dir, E->output.gzdir.vtk_ocount);
- }else{ /* parallel */
- if(geo) /* geometry */
- sprintf(output_file,"%s/vtk_geo.%i",
- E->control.data_dir,E->parallel.me);
- else /* data part */
- sprintf(output_file,"%s/%d/d.%08i.%i.vtk",
- E->control.data_dir,cycles,
- E->output.gzdir.vtk_ocount,
- E->parallel.me);
- }
-}
-
-
-
-
-/*
-
-
-big endian I/O (needed for vtk)
-
-
-*/
-
-/*
-
-write the x[n] array to file, making sure it is written big endian
-
-*/
-int be_write_float_to_file(float *x, int n, FILE *out)
-{
- int i,nout;
- static size_t len = sizeof(float);
- size_t bsize;
- float ftmp;
-#ifdef ASCII_DEBUG
- for(i=0;i<n;i++)
- fprintf(out,"%11g ",x[i]);
- fprintf(out,"\n");
- nout = n;
-#else
- /*
- do we need to flip?
- */
- if(be_is_little_endian()){
- nout = 0;
- for(i=0;i < n;i++){
- ftmp = x[i];
- be_flip_byte_order((void *)(&ftmp),len);
- nout += fwrite(&ftmp,len,(size_t)1,out); /* write to file */
- }
- }else{ /* operate on x */
- nout = fwrite(x,len,(size_t)n,out); /* write to file */
- }
-#endif
- return nout;
-}
-int be_write_int_to_file(int *x, int n, FILE *out)
-{
- int i,nout;
- static size_t len = sizeof(int);
- size_t bsize;
- int itmp;
-#ifdef ASCII_DEBUG
- for(i=0;i<n;i++)
- fprintf(out,"%11i ",x[i]);
- fprintf(out,"\n");
- nout = n;
-#else
- /*
- do we need to flip?
- */
- if(be_is_little_endian()){
- nout = 0;
- for(i=0;i < n;i++){
- itmp = x[i];
- be_flip_byte_order((void *)(&itmp),len);
- nout += fwrite(&itmp,len,(size_t)1,out); /* write to file */
- }
- }else{ /* operate on x */
- nout = fwrite(x,len,(size_t)n,out); /* write to file */
- }
-#endif
- return nout;
-}
-
-
-/* does this make a difference? nope, didn't, and why would it */
-void myfprintf(FILE *out,char *string)
-{
-#ifdef ASCII_DEBUG
- fprintf(out,string);
-#else
- fwrite(string, sizeof(char), strlen(string), out);
-#endif
-}
-
-int be_is_little_endian(void)
-{
- static const unsigned long a = 1;
- return *(const unsigned char *)&a;
-}
-
-/*
-
-
-flip endian-ness
-
-
-*/
-/*
-
-flip endianness of x
-
-*/
-void be_flip_byte_order(void *x, size_t len)
-{
- void *copy;
- int i;
- copy = (void *)malloc(len); /* don't check here for speed */
- memcpy(copy,x,len);
- be_flipit(x,copy,len);
- free(copy);
-}
-
-/* this should not be called with (i,i,size i) */
-void be_flipit(void *d, void *s, size_t len)
-{
- unsigned char *dest = d;
- unsigned char *src = s;
- src += len - 1;
- for (; len; len--)
- *dest++ = *src--;
-}
-
-
-#undef BE_WERROR
-#endif /* gzdir switch */
Copied: mc/3D/CitcomS/branches/cxx/lib/Output_gzdir.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Output_gzdir.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Output_gzdir.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Output_gzdir.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,1448 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+/* Routine to process the output of the finite element cycles
+ and to turn them into a coherent suite files */
+
+/*
+
+this version uses gzipped, ascii output to subdirectories for the
+ascii-gz option
+
+if, additionally, gzdir.vtk_io = 1, will write different format files
+ for later post-processing into VTK
+
+ gzdir.vtk_io = 2, will try to write legacy serial VTK (experimental)
+
+ gzdir.vtk_io = 3, will try to write to legacy parallel VTK (experimental)
+
+
+
+ the VTK output is the "legacy" type, requires that
+ all processors see the same filesystem, and will
+ likely lead to a bottleneck for large CPU
+ computations as each processor has to wait til the
+ previous is done.
+
+TWB
+
+*/
+#ifdef USE_GZDIR
+
+
+//#define ASCII_DEBUG
+
+#include <zlib.h>
+
+#define BE_WERROR {myerror(E,"write error be output");}
+#include <stdio.h>
+#include <stdlib.h>
+#include <math.h>
+#include "element_definitions.h"
+#include "global_defs.h"
+#include "parsing.h"
+#include "parallel_related.h"
+#include "output.h"
+/* Big endian crap */
+#include <string.h>
+#ifdef HAVE_MALLOC_H
+#include <malloc.h>
+#endif
+
+#include "cproto.h"
+
+
+void be_flipit(void *, void *, size_t );
+void be_flip_byte_order(void *, size_t );
+int be_is_little_endian(void);
+int be_write_float_to_file(float *, int , FILE *);
+int be_write_int_to_file(int *, int , FILE *);
+void myfprintf(FILE *,char *);
+void calc_cbase_at_node(int , int , float *,struct All_variables *);
+
+/* */
+void get_vtk_filename(char *,int,struct All_variables *,int);
+
+gzFile *gzdir_output_open(char *,char *);
+void gzdir_output(struct All_variables *, int );
+void gzdir_output_comp_nd(struct All_variables *, int);
+void gzdir_output_comp_el(struct All_variables *, int);
+void gzdir_output_coord(struct All_variables *);
+void gzdir_output_mat(struct All_variables *);
+void gzdir_output_velo_temp(struct All_variables *, int);
+void gzdir_output_visc_prepare(struct All_variables *, float **);
+void gzdir_output_visc(struct All_variables *, int);
+void gzdir_output_surf_botm(struct All_variables *, int);
+void gzdir_output_geoid(struct All_variables *, int);
+void gzdir_output_stress(struct All_variables *, int);
+void gzdir_output_horiz_avg(struct All_variables *, int);
+void gzdir_output_tracer(struct All_variables *, int);
+void gzdir_output_pressure(struct All_variables *, int);
+void gzdir_output_heating(struct All_variables *, int);
+
+
+void sub_netr(float, float, float, float *, float *, double *);
+double determine_model_net_rotation(struct All_variables *,double *);
+
+
+void restart_tic_from_gzdir_file(struct All_variables *);
+
+void calc_cbase_at_tp(float , float , float *);
+void rtp2xyz(float , float , float, float *);
+void convert_pvec_to_cvec(float ,float , float , float *,float *);
+void *safe_malloc (size_t );
+
+int open_file_zipped(char *, FILE **,struct All_variables *);
+void gzip_file(char *);
+
+
+extern void temperatures_conform_bcs(struct All_variables *);
+extern void myerror(struct All_variables *,char *);
+extern void mkdatadir(const char *);
+extern void heat_flux(struct All_variables *);
+extern void get_STD_topo(struct All_variables *, float**, float**,
+ float**, float**, int);
+extern void get_CBF_topo(struct All_variables *, float**, float**);
+
+/**********************************************************************/
+
+
+void gzdir_output(struct All_variables *E, int out_cycles)
+{
+ char output_dir[255];
+
+ if (out_cycles == 0 ){
+ /* initial I/O */
+
+ gzdir_output_coord(E);
+ /*gzdir_output_mat(E);*/
+ }
+
+ /*
+ make a new directory for all the other output
+
+ (all procs need to do that, because we might be using a local tmp
+ dir)
+
+ */
+ /* make a directory */
+ snprintf(output_dir,255,"%s/%d",E->control.data_dir,out_cycles);
+
+ mkdatadir(output_dir);
+
+
+ /* output */
+
+ gzdir_output_velo_temp(E, out_cycles); /* don't move this around,
+ else new VTK output won't
+ work */
+ gzdir_output_visc(E, out_cycles);
+
+ gzdir_output_surf_botm(E, out_cycles);
+
+ /* optiotnal output below */
+ /* compute and output geoid (in spherical harmonics coeff) */
+ if (E->output.geoid)
+ gzdir_output_geoid(E, out_cycles);
+
+ if (E->output.stress){
+ gzdir_output_stress(E, out_cycles);
+ }
+ if (E->output.pressure)
+ gzdir_output_pressure(E, out_cycles);
+
+ if (E->output.horiz_avg)
+ gzdir_output_horiz_avg(E, out_cycles);
+
+ if(E->control.tracer){
+ if(E->output.tracer ||
+ (out_cycles == E->advection.max_timesteps))
+ gzdir_output_tracer(E, out_cycles);
+ }
+
+ if (E->output.comp_nd && E->composition.on)
+ gzdir_output_comp_nd(E, out_cycles);
+
+ if (E->output.comp_el && E->composition.on)
+ gzdir_output_comp_el(E, out_cycles);
+
+ if(E->output.heating && E->control.disptn_number != 0)
+ gzdir_output_heating(E, out_cycles);
+
+ return;
+}
+
+
+gzFile *gzdir_output_open(char *filename,char *mode)
+{
+ gzFile *fp1;
+
+ if (*filename) {
+ fp1 = (gzFile *)gzopen(filename,mode);
+ if (!fp1) {
+ fprintf(stderr,"gzdir: cannot open file '%s'\n",filename);
+ parallel_process_termination();
+ }
+ }else{
+ fprintf(stderr,"gzdir: no file name given '%s'\n",filename);
+ parallel_process_termination();
+ }
+ return fp1;
+}
+
+/*
+
+initialization output of geometries, only called once
+
+
+ */
+void gzdir_output_coord(struct All_variables *E)
+{
+ int i, j, offset,ix[9],out;
+ char output_file[255],ostring[255],message[255];
+ float x[3];
+ gzFile *gz1;
+ FILE *fp1;
+ MPI_Status mpi_stat;
+ int mpi_rc, mpi_inmsg, mpi_success_message = 1;
+ if((E->output.gzdir.vtk_io == 2)||(E->output.gzdir.vtk_io == 3)){
+ /*
+ direct VTK file output
+ */
+ if(E->output.gzdir.vtk_io == 2) /* serial */
+ parallel_process_sync(E);
+ /*
+
+ start geometry pre-file, to which data will get appended later
+
+ */
+ E->output.gzdir.vtk_ocount = -1;
+ get_vtk_filename(output_file,1,E,0); /* geometry file */
+ if(E->parallel.me == 0){
+ /* start log file */
+ snprintf(message,255,"%s/vtk_time.log",E->control.data_dir);
+ E->output.gzdir.vtk_fp = output_open(message,"w");
+ }
+ if((E->parallel.me == 0) || (E->output.gzdir.vtk_io == 3)){
+ /* either in first CPU or parallel output */
+ /* start geo file */
+ fp1 = output_open(output_file,"w");
+ myfprintf(fp1,"# vtk DataFile Version 2.0\n");
+ myfprintf(fp1,"model name, extra info\n");
+#ifdef ASCII_DEBUG
+ myfprintf(fp1,"ASCII\n");
+#else
+ myfprintf(fp1,"BINARY\n");
+#endif
+ myfprintf(fp1,"DATASET UNSTRUCTURED_GRID\n");
+ if(E->output.gzdir.vtk_io == 2) /* serial */
+ sprintf(message,"POINTS %i float\n", /* total number of nodes */
+ E->lmesh.nno * E->parallel.nproc *
+ E->sphere.caps_per_proc);
+ else /* parallel */
+ sprintf(message,"POINTS %i float\n",
+ E->lmesh.nno * E->sphere.caps_per_proc);
+ myfprintf(fp1,message);
+ }else{ /* serial output */
+ /* if not first CPU, wait for previous before appending */
+ mpi_rc = MPI_Recv(&mpi_inmsg, 1, MPI_INT, (E->parallel.me-1), 0, E->parallel.world, &mpi_stat);
+ /* open for append */
+ fp1 = output_open(output_file,"a");
+ }
+ out = 0;
+ /* write nodal coordinate to file, big endian */
+ for(j=1;j <= E->sphere.caps_per_proc;j++) {
+ for(i=1;i <= E->lmesh.nno;i++) {
+ x[0]=E->x[j][1][i];x[1]=E->x[j][2][i];x[2]=E->x[j][3][i];
+ if(be_write_float_to_file(x,3,fp1) != 3)
+ BE_WERROR;
+ out++;
+ }
+ }
+ if(E->output.gzdir.vtk_io == 2){ /* serial output, close and have
+ next one write */
+ fclose(fp1);fflush(fp1); /* close file and flush buffer */
+ if(E->parallel.me < E->parallel.nproc-1){/* send to next if not last*/
+ mpi_rc = MPI_Send(&mpi_success_message, 1, MPI_INT, (E->parallel.me+1), 0, E->parallel.world);
+ }
+ /*
+ node numbers for all the elements
+ */
+ parallel_process_sync(E);
+ }
+ if((E->output.gzdir.vtk_io == 3) || (E->parallel.me == 0)){ /* in first CPU, or parallel output */
+ if(E->output.gzdir.vtk_io == 2){ /* need to reopen, serial */
+ fp1 = output_open(output_file,"a");
+ j = E->parallel.nproc * E->lmesh.nel *
+ E->sphere.caps_per_proc; /* total number of elements */
+ }else{ /* parallel */
+ j = E->lmesh.nel * E->sphere.caps_per_proc;
+ }
+ sprintf(message,"CELLS %i %i\n", /* number of elements
+ total number of int entries
+
+ */
+ j,j*(enodes[E->mesh.nsd]+1));
+ myfprintf(fp1,message);
+ }else{
+ /* if not first, wait for previous */
+ mpi_rc = MPI_Recv(&mpi_inmsg, 1, MPI_INT, (E->parallel.me-1), 0, E->parallel.world, &mpi_stat);
+ fp1 = output_open(output_file,"a");
+ }
+ /*
+ write CELL element nodes
+ */
+ if(enodes[E->mesh.nsd] != 8)
+ myerror(E,"vtk error, only eight node hexes supported");
+ if(E->output.gzdir.vtk_io == 2){ /* serial, global node numbers */
+ offset = E->lmesh.nno * E->parallel.me - 1;
+ }else{ /* parallel, only use local node numbers? */
+ offset = -1;
+ }
+ ix[0] = enodes[E->mesh.nsd];
+ for(j=1;j <= E->sphere.caps_per_proc;j++) {
+ for(i=1;i <= E->lmesh.nel;i++) {
+ /*
+ need to add offset according to the processor for global
+ node numbers
+ */
+ ix[1]= E->ien[j][i].node[1]+offset;ix[2] = E->ien[j][i].node[2]+offset;
+ ix[3]= E->ien[j][i].node[3]+offset;ix[4] = E->ien[j][i].node[4]+offset;
+ ix[5]= E->ien[j][i].node[5]+offset;ix[6] = E->ien[j][i].node[6]+offset;
+ ix[7]= E->ien[j][i].node[7]+offset;ix[8] = E->ien[j][i].node[8]+offset;
+ if(be_write_int_to_file(ix,9,fp1)!=9)
+ BE_WERROR;
+ }
+ }
+ if(E->output.gzdir.vtk_io == 2){ /* serial IO */
+ fclose(fp1);fflush(fp1); /* close file and flush buffer */
+ if(E->parallel.me < E->parallel.nproc-1)
+ mpi_rc = MPI_Send(&mpi_success_message, 1, MPI_INT, (E->parallel.me+1), 0, E->parallel.world);
+ parallel_process_sync(E);
+ }
+ if((E->output.gzdir.vtk_io==3) || (E->parallel.me == 0) ){
+ if(E->output.gzdir.vtk_io == 2){ /* serial */
+ fp1 = output_open(output_file,"a");
+ j=E->parallel.nproc*E->lmesh.nel*E->sphere.caps_per_proc;
+ }else{ /* parallel */
+ j = E->lmesh.nel*E->sphere.caps_per_proc;
+ }
+ sprintf(message,"CELL_TYPES %i\n",j); /* number of elements*/
+ myfprintf(fp1,message);
+ ix[0] = 12;
+ for(i=0;i<j;i++)
+ if(be_write_int_to_file(ix,1,fp1)!=1)BE_WERROR;
+ fclose(fp1);fflush(fp1); /* all procs close file and flush buffer */
+ if(E->parallel.me == 0)
+ fprintf(stderr,"vtk_io: vtk geometry done for %s\n",output_file);
+ }
+ /* done straight VTK output, geometry part */
+ }else{
+ /*
+
+ either zipped regular, or old VTK type for post-processing
+
+ */
+ /*
+ don't use data file name
+ */
+ snprintf(output_file,255,"%s/coord.%d.gz",
+ E->control.data_dir,E->parallel.me);
+ gz1 = gzdir_output_open(output_file,"w");
+
+ /* nodal coordinates */
+ for(j=1;j<=E->sphere.caps_per_proc;j++) {
+ gzprintf(gz1,"%3d %7d\n",j,E->lmesh.nno);
+ for(i=1;i<=E->lmesh.nno;i++)
+ gzprintf(gz1,"%.6e %.6e %.6e\n",
+ E->sx[j][1][i],E->sx[j][2][i],E->sx[j][3][i]);
+ }
+
+ gzclose(gz1);
+ if(E->output.gzdir.vtk_io == 1){
+ /*
+
+ output of Cartesian coordinates and element connectivitiy for
+ vtk visualization
+
+ */
+ /*
+ nodal coordinates in Cartesian
+ */
+ snprintf(output_file,255,"%s/vtk_ecor.%d.gz",
+ E->control.data_dir,E->parallel.me);
+ gz1 = gzdir_output_open(output_file,"w");
+ for(j=1;j <= E->sphere.caps_per_proc;j++) {
+ for(i=1;i <= E->lmesh.nno;i++) {
+ gzprintf(gz1,"%9.6f %9.6f %9.6f\n", /* cartesian nodal coordinates */
+ E->x[j][1][i],E->x[j][2][i],E->x[j][3][i]);
+ }
+ }
+ gzclose(gz1);
+ /*
+ connectivity for all elements
+ */
+ offset = E->lmesh.nno * E->parallel.me - 1;
+ snprintf(output_file,255,"%s/vtk_econ.%d.gz",
+ E->control.data_dir,E->parallel.me);
+ gz1 = gzdir_output_open(output_file,"w");
+ for(j=1;j <= E->sphere.caps_per_proc;j++) {
+ for(i=1;i <= E->lmesh.nel;i++) {
+ gzprintf(gz1,"%2i\t",enodes[E->mesh.nsd]);
+ if(enodes[E->mesh.nsd] != 8){
+ gzprintf(stderr,"gzdir: Output: error, only eight node hexes supported");
+ parallel_process_termination();
+ }
+ /*
+ need to add offset according to the processor for global
+ node numbers
+ */
+ gzprintf(gz1,"%6i %6i %6i %6i %6i %6i %6i %6i\n",
+ E->ien[j][i].node[1]+offset,E->ien[j][i].node[2]+offset,
+ E->ien[j][i].node[3]+offset,E->ien[j][i].node[4]+offset,
+ E->ien[j][i].node[5]+offset,E->ien[j][i].node[6]+offset,
+ E->ien[j][i].node[7]+offset,E->ien[j][i].node[8]+offset);
+ }
+ }
+ gzclose(gz1);
+ } /* end vtkio = 1 (pre VTK) */
+ }
+
+ return;
+}
+
+/*
+
+this needs to be called after the geometry files have been
+established, and before any of the other stuff if VTK straight output
+is chosen
+
+
+*/
+void gzdir_output_velo_temp(struct All_variables *E, int cycles)
+{
+ int i, j, k,os;
+ char output_file[255],output_file2[255],message[255],geo_file[255];
+ float cvec[3],vcorr[3];
+ double omega[3],oamp;
+ gzFile *gzout;
+ FILE *fp1;
+ /* for dealing with several processors */
+ MPI_Status mpi_stat;
+ int mpi_rc;
+ int mpi_inmsg, mpi_success_message = 1;
+
+
+ if(E->output.gzdir.vtk_io){ /* all VTK modes need basis vectors */
+ os = E->lmesh.nno*9;
+ if((!E->output.gzdir.vtk_base_init) ||(!E->output.gzdir.vtk_base_save)){
+ /* either not computed, or need to compute anew */
+ if(!E->output.gzdir.vtk_base_init) /* init space */
+ E->output.gzdir.vtk_base = (float *)safe_malloc(sizeof(float)*os*E->sphere.caps_per_proc);
+ /* compute */
+ for(k=0,j=1;j <= E->sphere.caps_per_proc;j++,k += os) {
+ for(i=1;i <= E->lmesh.nno;i++,k += 9){
+ /* cartesian basis vectors at theta, phi */
+ calc_cbase_at_node(j,i,(E->output.gzdir.vtk_base+k),E);
+ }
+ }
+ E->output.gzdir.vtk_base_init = 1;
+ }
+ }
+
+ if(E->output.gzdir.rnr){ /* remove the whole model net rotation */
+ if((E->control.remove_rigid_rotation)&&
+ (E->parallel.me == 0)) /* that's not too terrible but wastes time */
+ fprintf(stderr,"WARNING: both gzdir.rnr and remove_rigid_rotation are switched on!\n");
+ oamp = determine_model_net_rotation(E,omega);
+ if(E->parallel.me == 0)
+ fprintf(stderr,"gzdir_output_velo_temp: removing net rotation: |%8.3e, %8.3e, %8.3e| = %8.3e\n",
+ omega[0],omega[1],omega[2],oamp);
+ }
+ if((E->output.gzdir.vtk_io == 2) || (E->output.gzdir.vtk_io == 3)){
+ /*
+
+ direct VTK
+
+ */
+ if(E->output.gzdir.vtk_io == 2)
+ parallel_process_sync(E); /* serial needs sync */
+
+ E->output.gzdir.vtk_ocount++; /* regular output file name */
+ get_vtk_filename(geo_file,1,E,cycles);
+ get_vtk_filename(output_file,0,E,cycles);
+ /*
+
+ start with temperature
+
+ */
+ if((E->parallel.me == 0) || (E->output.gzdir.vtk_io == 3)){
+ /* copy geo file over to start out vtk file */
+ snprintf(output_file2,255,"cp %s %s",geo_file,output_file);
+ system(output_file2);
+ /* should we do something to check if this has worked? */
+ if(E->parallel.me == 0){
+ /* write a time log */
+ fprintf(E->output.gzdir.vtk_fp,"%12i %12i %12.6e %s\n",
+ E->output.gzdir.vtk_ocount,cycles,E->monitor.elapsed_time,output_file);
+ }
+ fp1 = output_open(output_file,"a");
+ if(E->output.gzdir.vtk_io == 2) /* serial */
+ sprintf(message,"POINT_DATA %i\n",E->lmesh.nno*E->parallel.nproc*E->sphere.caps_per_proc);
+ else /* parallel */
+ sprintf(message,"POINT_DATA %i\n",E->lmesh.nno*E->sphere.caps_per_proc);
+ myfprintf(fp1,message);
+ myfprintf(fp1,"SCALARS temperature float 1\n");
+ myfprintf(fp1,"LOOKUP_TABLE default\n");
+ }else{
+ /* if not first, wait for previous */
+ mpi_rc = MPI_Recv(&mpi_inmsg, 1, MPI_INT, (E->parallel.me-1), 7, E->parallel.world, &mpi_stat);
+ /* open for append */
+ fp1 = output_open(output_file,"a");
+ }
+ for(j=1; j<= E->sphere.caps_per_proc;j++) /* print the temperatures */
+ for(i=1;i<=E->lmesh.nno;i++){
+ cvec[0] = E->T[j][i];
+ if(be_write_float_to_file(cvec,1,fp1)!=1)
+ BE_WERROR;
+ }
+ if(E->output.gzdir.vtk_io == 2){
+ fclose(fp1);fflush(fp1); /* close file and flush buffer */
+ if(E->parallel.me < E->parallel.nproc-1){
+ mpi_rc = MPI_Send(&mpi_success_message, 1, MPI_INT, (E->parallel.me+1), 7, E->parallel.world);
+ }else{
+ mpi_rc = MPI_Send(&mpi_success_message, 1, MPI_INT, 0, 6, E->parallel.world); /* tell m=0 to go ahead */
+ }
+ }
+ /*
+ velocities second
+ */
+ if((E->output.gzdir.vtk_io == 3) || (E->parallel.me == 0)){
+ if(E->output.gzdir.vtk_io == 2){
+ mpi_rc = MPI_Recv(&mpi_inmsg, 1, MPI_INT, E->parallel.nproc-1 , 6, E->parallel.world, &mpi_stat);
+ fp1 = output_open(output_file,"a"); /* append velocities */
+ }
+ sprintf(message,"VECTORS velocity float\n");myfprintf(fp1,message);
+ }else{
+ mpi_rc = MPI_Recv(&mpi_inmsg, 1, MPI_INT, (E->parallel.me-1), 5, E->parallel.world, &mpi_stat);
+ fp1 = output_open(output_file,"a");
+ }
+ for(k=0,j=1;j <= E->sphere.caps_per_proc;j++,k += os) {
+ if(E->output.gzdir.rnr){
+ /* remove NR */
+ for(i=1;i<=E->lmesh.nno;i++,k += 9) {
+ vcorr[0] = E->sphere.cap[j].V[1][i]; /* vtheta */
+ vcorr[1] = E->sphere.cap[j].V[2][i]; /* vphi */
+ /* remove the velocity that corresponds to a net rotation of omega[0..2] at location
+ r,t,p from the t,p velocities in vcorr[0..1]
+ */
+ sub_netr(E->sx[j][3][i],E->sx[j][1][i],E->sx[j][2][i],(vcorr+0),(vcorr+1),omega);
+
+ convert_pvec_to_cvec(E->sphere.cap[j].V[3][i],vcorr[0],vcorr[1],
+ (E->output.gzdir.vtk_base+k),cvec);
+ if(be_write_float_to_file(cvec,3,fp1)!=3)BE_WERROR;
+ }
+ }else{
+ /* regular output */
+ for(i=1;i<=E->lmesh.nno;i++,k += 9) {
+ convert_pvec_to_cvec(E->sphere.cap[j].V[3][i],E->sphere.cap[j].V[1][i],E->sphere.cap[j].V[2][i],
+ (E->output.gzdir.vtk_base+k),cvec);
+ if(be_write_float_to_file(cvec,3,fp1)!=3)BE_WERROR;
+ }
+ }
+ }
+ fclose(fp1);fflush(fp1); /* close file and flush buffer */
+ if(E->output.gzdir.vtk_io == 2){
+ if(E->parallel.me < E->parallel.nproc-1){
+ mpi_rc = MPI_Send(&mpi_success_message, 1, MPI_INT, (E->parallel.me+1), 5, E->parallel.world);
+ }else{
+ fprintf(stderr,"vtk_io: geo, temp, & vel writtend to %s\n",output_file);
+ }
+ }else{
+ if(E->parallel.me == 0)
+ fprintf(stderr,"vtk_io: geo, temp, & vel written to %s\n",output_file);
+ }
+ /* new VTK velo and temp done */
+ }else{
+ /*
+
+ modified zipped output
+
+ */
+ /*
+
+
+ temperatures are printed along with velocities for old type of
+ output
+
+ if VTK is selected, will generate a separate temperature file
+
+ */
+ if(E->output.gzdir.vtk_io == 1) {
+ /*
+ for VTK, only print temperature
+ */
+ snprintf(output_file2,255,"%s/%d/t.%d.%d",
+ E->control.data_dir,
+ cycles,E->parallel.me,cycles);
+ }else{ /* vel + T for old output */
+ snprintf(output_file2,255,"%s/%d/velo.%d.%d",
+ E->control.data_dir,cycles,
+ E->parallel.me,cycles);
+ }
+ snprintf(output_file,255,"%s.gz",output_file2); /* add the .gz */
+
+ gzout = gzdir_output_open(output_file,"w");
+ gzprintf(gzout,"%d %d %.5e\n",
+ cycles,E->lmesh.nno,E->monitor.elapsed_time);
+ for(j=1; j<= E->sphere.caps_per_proc;j++) {
+ gzprintf(gzout,"%3d %7d\n",j,E->lmesh.nno);
+ if(E->output.gzdir.vtk_io){
+ /* VTK */
+ for(i=1;i<=E->lmesh.nno;i++)
+ gzprintf(gzout,"%.6e\n",E->T[j][i]);
+ } else {
+ /* old velo + T output */
+ if(E->output.gzdir.rnr){
+ /* remove NR */
+ for(i=1;i<=E->lmesh.nno;i++){
+ vcorr[0] = E->sphere.cap[j].V[1][i]; /* vt */
+ vcorr[1] = E->sphere.cap[j].V[2][i]; /* vphi */
+ sub_netr(E->sx[j][3][i],E->sx[j][1][i],E->sx[j][2][i],(vcorr+0),(vcorr+1),omega);
+ gzprintf(gzout,"%.6e %.6e %.6e %.6e\n",
+ vcorr[0],vcorr[1],
+ E->sphere.cap[j].V[3][i],E->T[j][i]);
+
+ }
+ }else{
+ for(i=1;i<=E->lmesh.nno;i++)
+ gzprintf(gzout,"%.6e %.6e %.6e %.6e\n",
+ E->sphere.cap[j].V[1][i],
+ E->sphere.cap[j].V[2][i],
+ E->sphere.cap[j].V[3][i],E->T[j][i]);
+ }
+ }
+ }
+ gzclose(gzout);
+ if(E->output.gzdir.vtk_io){
+ /*
+ write Cartesian velocities to file
+ */
+ snprintf(output_file,255,"%s/%d/vtk_v.%d.%d.gz",
+ E->control.data_dir,cycles,E->parallel.me,cycles);
+ gzout = gzdir_output_open(output_file,"w");
+ for(k=0,j=1;j <= E->sphere.caps_per_proc;j++,k += os) {
+ if(E->output.gzdir.rnr){
+ /* remove NR */
+ for(i=1;i<=E->lmesh.nno;i++,k += 9) {
+ vcorr[0] = E->sphere.cap[j].V[1][i];
+ vcorr[1] = E->sphere.cap[j].V[2][i];
+ sub_netr(E->sx[j][3][i],E->sx[j][1][i],E->sx[j][2][i],(vcorr+0),(vcorr+1),omega);
+ convert_pvec_to_cvec(E->sphere.cap[j].V[3][i],vcorr[0],vcorr[1],
+ (E->output.gzdir.vtk_base+k),cvec);
+ gzprintf(gzout,"%10.4e %10.4e %10.4e\n",cvec[0],cvec[1],cvec[2]);
+ }
+ }else{
+ /* regular output */
+ for(i=1;i<=E->lmesh.nno;i++,k += 9) {
+ /* convert r,theta,phi vector to x,y,z at base location */
+ convert_pvec_to_cvec(E->sphere.cap[j].V[3][i],
+ E->sphere.cap[j].V[1][i],
+ E->sphere.cap[j].V[2][i],
+ (E->output.gzdir.vtk_base+k),cvec);
+ /* output of cartesian vector */
+ gzprintf(gzout,"%10.4e %10.4e %10.4e\n",
+ cvec[0],cvec[1],cvec[2]);
+ }
+ }
+ }
+ gzclose(gzout);
+
+ }
+ } /* end gzipped and old VTK out */
+ if(E->output.gzdir.vtk_io){ /* all VTK modes */
+ /* free memory */
+ if(!E->output.gzdir.vtk_base_save)
+ free(E->output.gzdir.vtk_base);
+ }
+ return;
+}
+
+/*
+ viscosity
+*/
+void gzdir_output_visc(struct All_variables *E, int cycles)
+{
+ int i, j;
+ char output_file[255];
+ gzFile *gz1;
+ FILE *fp1;
+ int lev = E->mesh.levmax;
+ float ftmp;
+ /* for dealing with several processors */
+ MPI_Status mpi_stat;
+ int mpi_rc;
+ int mpi_inmsg, mpi_success_message = 1;
+
+
+ if(E->output.gzdir.vtk_io < 2){
+ snprintf(output_file,255,
+ "%s/%d/visc.%d.%d.gz", E->control.data_dir,
+ cycles,E->parallel.me, cycles);
+ gz1 = gzdir_output_open(output_file,"w");
+ for(j=1;j<=E->sphere.caps_per_proc;j++) {
+ gzprintf(gz1,"%3d %7d\n",j,E->lmesh.nno);
+ for(i=1;i<=E->lmesh.nno;i++)
+ gzprintf(gz1,"%.4e\n",E->VI[lev][j][i]);
+ }
+
+ gzclose(gz1);
+ }else{
+ if(E->output.gzdir.vtk_io == 2)
+ parallel_process_sync(E);
+ /* new legacy VTK */
+ get_vtk_filename(output_file,0,E,cycles);
+ if((E->parallel.me == 0) || (E->output.gzdir.vtk_io == 3)){
+ fp1 = output_open(output_file,"a");
+ myfprintf(fp1,"SCALARS log10(visc) float 1\n");
+ myfprintf(fp1,"LOOKUP_TABLE default\n");
+ }else{
+ /* if not first, wait for previous */
+ mpi_rc = MPI_Recv(&mpi_inmsg, 1, MPI_INT, (E->parallel.me-1), 0, E->parallel.world, &mpi_stat);
+ /* open for append */
+ fp1 = output_open(output_file,"a");
+ }
+ for(j=1; j<= E->sphere.caps_per_proc;j++)
+ for(i=1;i<=E->lmesh.nno;i++){
+ ftmp = log10(E->VI[lev][j][i]);
+ if(fabs(ftmp) < 5e-7)ftmp = 0.0;
+ if(be_write_float_to_file(&ftmp,1,fp1)!=1)BE_WERROR;
+ }
+ fclose(fp1);fflush(fp1); /* close file and flush buffer */
+ if(E->output.gzdir.vtk_io == 2)
+ if(E->parallel.me < E->parallel.nproc-1){
+ mpi_rc = MPI_Send(&mpi_success_message, 1, MPI_INT, (E->parallel.me+1), 0, E->parallel.world);
+ }
+ }
+ return;
+}
+
+
+
+void gzdir_output_surf_botm(struct All_variables *E, int cycles)
+{
+ int i, j, s;
+ char output_file[255];
+ gzFile *fp2;
+ float *topo;
+
+ if((E->output.write_q_files == 0) || (cycles == 0) ||
+ (cycles % E->output.write_q_files)!=0)
+ heat_flux(E);
+ /* else, the heat flux will have been computed already */
+
+ if(E->control.use_cbf_topo){
+ get_CBF_topo(E,E->slice.tpg,E->slice.tpgb);
+ }else{
+ get_STD_topo(E,E->slice.tpg,E->slice.tpgb,E->slice.divg,E->slice.vort,cycles);
+ }
+
+
+ if (E->output.surf && (E->parallel.me_loc[3]==E->parallel.nprocz-1)) {
+ snprintf(output_file,255,"%s/%d/surf.%d.%d.gz", E->control.data_dir,
+ cycles,E->parallel.me, cycles);
+ fp2 = gzdir_output_open(output_file,"w");
+
+ for(j=1;j<=E->sphere.caps_per_proc;j++) {
+ /* choose either STD topo or pseudo-free-surf topo */
+ if(E->control.pseudo_free_surf)
+ topo = E->slice.freesurf[j];
+ else
+ topo = E->slice.tpg[j];
+
+ gzprintf(fp2,"%3d %7d\n",j,E->lmesh.nsf);
+ for(i=1;i<=E->lmesh.nsf;i++) {
+ s = i*E->lmesh.noz;
+ gzprintf(fp2,"%.4e %.4e %.4e %.4e\n",
+ topo[i],E->slice.shflux[j][i],E->sphere.cap[j].V[1][s],E->sphere.cap[j].V[2][s]);
+ }
+ }
+ gzclose(fp2);
+ }
+
+
+ if (E->output.botm && (E->parallel.me_loc[3]==0)) {
+ snprintf(output_file,255,"%s/%d/botm.%d.%d.gz", E->control.data_dir,
+ cycles,E->parallel.me, cycles);
+ fp2 = gzdir_output_open(output_file,"w");
+
+ for(j=1;j<=E->sphere.caps_per_proc;j++) {
+ gzprintf(fp2,"%3d %7d\n",j,E->lmesh.nsf);
+ for(i=1;i<=E->lmesh.nsf;i++) {
+ s = (i-1)*E->lmesh.noz + 1;
+ gzprintf(fp2,"%.4e %.4e %.4e %.4e\n",
+ E->slice.tpgb[j][i],E->slice.bhflux[j][i],E->sphere.cap[j].V[1][s],E->sphere.cap[j].V[2][s]);
+ }
+ }
+ gzclose(fp2);
+ }
+
+ return;
+}
+
+
+void gzdir_output_geoid(struct All_variables *E, int cycles)
+{
+ int ll, mm, p;
+ char output_file[255];
+ gzFile *fp1;
+
+ compute_geoid(E);
+
+ if (E->parallel.me == (E->parallel.nprocz-1)) {
+ snprintf(output_file, 255,
+ "%s/%d/geoid.%d.%d.gz", E->control.data_dir,
+ cycles,E->parallel.me, cycles);
+ fp1 = gzdir_output_open(output_file,"w");
+
+ /* write headers */
+ gzprintf(fp1, "%d %d %.5e\n", cycles, E->output.llmax,
+ E->monitor.elapsed_time);
+
+ /* write sph harm coeff of geoid and topos */
+ for (ll=0; ll<=E->output.llmax; ll++)
+ for(mm=0; mm<=ll; mm++) {
+ p = E->sphere.hindex[ll][mm];
+ gzprintf(fp1,"%d %d %.4e %.4e %.4e %.4e %.4e %.4e\n",
+ ll, mm,
+ E->sphere.harm_geoid[0][p],
+ E->sphere.harm_geoid[1][p],
+ E->sphere.harm_geoid_from_tpgt[0][p],
+ E->sphere.harm_geoid_from_tpgt[1][p],
+ E->sphere.harm_geoid_from_bncy[0][p],
+ E->sphere.harm_geoid_from_bncy[1][p]);
+
+ }
+
+ gzclose(fp1);
+ }
+}
+
+
+
+void gzdir_output_stress(struct All_variables *E, int cycles)
+{
+ int m, node;
+ char output_file[255];
+ gzFile *fp1;
+ /* for stress computation */
+ float *SXX[NCS],*SYY[NCS],*SXY[NCS],*SXZ[NCS],*SZY[NCS],*SZZ[NCS];
+ float *divv[NCS],*vorv[NCS];
+ /* */
+ if(E->control.use_cbf_topo) {/* for CBF topo, stress will not have been computed */
+ allocate_STD_mem(E, SXX, SYY, SZZ, SXY, SXZ, SZY, divv, vorv);
+ compute_nodal_stress(E, SXX, SYY, SZZ, SXY, SXZ, SZY, divv, vorv);
+ free_STD_mem(E, SXX, SYY, SZZ, SXY, SXZ, SZY, divv, vorv);
+ }
+
+ snprintf(output_file,255,"%s/%d/stress.%d.%d.gz", E->control.data_dir,
+ cycles,E->parallel.me, cycles);
+ fp1 = gzdir_output_open(output_file,"w");
+
+ gzprintf(fp1,"%d %d %.5e\n",cycles,E->lmesh.nno,E->monitor.elapsed_time);
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+ gzprintf(fp1,"%3d %7d\n",m,E->lmesh.nno);
+ for (node=1;node<=E->lmesh.nno;node++)
+ gzprintf(fp1, "%.4e %.4e %.4e %.4e %.4e %.4e\n",
+ E->gstress[m][(node-1)*6+1], /* stt */
+ E->gstress[m][(node-1)*6+2], /* spp */
+ E->gstress[m][(node-1)*6+3], /* srr */
+ E->gstress[m][(node-1)*6+4], /* stp */
+ E->gstress[m][(node-1)*6+5], /* str */
+ E->gstress[m][(node-1)*6+6]); /* srp */
+ }
+ gzclose(fp1);
+}
+
+
+void gzdir_output_horiz_avg(struct All_variables *E, int cycles)
+{
+ /* horizontal average output of temperature, composition and rms velocity*/
+
+ int j;
+ char output_file[255];
+ gzFile *fp1;
+
+ /* compute horizontal average here.... */
+ compute_horiz_avg(E);
+
+ /* only the first nprocz processors need to output */
+
+ if (E->parallel.me<E->parallel.nprocz) {
+ snprintf(output_file,255,"%s/%d/horiz_avg.%d.%d.gz", E->control.data_dir,
+ cycles,E->parallel.me, cycles);
+ fp1=gzdir_output_open(output_file,"w");
+ for(j=1;j<=E->lmesh.noz;j++) {
+ gzprintf(fp1,"%.4e %.4e %.4e %.4e",E->sx[1][3][j],E->Have.T[j],E->Have.V[1][j],E->Have.V[2][j]);
+
+ if (E->composition.on) {
+ int n;
+ for(n=0; n<E->composition.ncomp; n++)
+ gzprintf(fp1," %.4e", E->Have.C[n][j]);
+ }
+ gzprintf(fp1,"\n");
+ }
+ gzclose(fp1);
+ }
+
+ return;
+}
+
+
+/* only called once */
+void gzdir_output_mat(struct All_variables *E)
+{
+ int m, el;
+ char output_file[255];
+ gzFile* fp;
+
+ snprintf(output_file,255,"%s/mat.%d.gz", E->control.data_dir,E->parallel.me);
+ fp = gzdir_output_open(output_file,"w");
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for(el=1;el<=E->lmesh.nel;el++)
+ gzprintf(fp,"%d %d %f\n", el,E->mat[m][el],E->VIP[m][el]);
+
+ gzclose(fp);
+
+ return;
+}
+
+
+
+void gzdir_output_pressure(struct All_variables *E, int cycles)
+{
+ int i, j;
+ float ftmp;
+ char output_file[255];
+ gzFile *gz1;
+ FILE *fp1;
+ /* for dealing with several processors */
+ MPI_Status mpi_stat;
+ int mpi_rc;
+ int mpi_inmsg, mpi_success_message = 1;
+
+ if(E->output.gzdir.vtk_io < 2){ /* old */
+ snprintf(output_file,255,"%s/%d/pressure.%d.%d.gz", E->control.data_dir,cycles,
+ E->parallel.me, cycles);
+ gz1 = gzdir_output_open(output_file,"w");
+ gzprintf(gz1,"%d %d %.5e\n",cycles,E->lmesh.nno,E->monitor.elapsed_time);
+ for(j=1;j<=E->sphere.caps_per_proc;j++) {
+ gzprintf(gz1,"%3d %7d\n",j,E->lmesh.nno);
+ for(i=1;i<=E->lmesh.nno;i++)
+ gzprintf(gz1,"%.6e\n",E->NP[j][i]);
+ }
+ gzclose(gz1);
+ }else{/* new legacy VTK */
+ if(E->output.gzdir.vtk_io == 2)
+ parallel_process_sync(E);
+ get_vtk_filename(output_file,0,E,cycles);
+ if((E->parallel.me == 0) || (E->output.gzdir.vtk_io == 3)){
+ fp1 = output_open(output_file,"a");
+ myfprintf(fp1,"SCALARS pressure float 1\n");
+ myfprintf(fp1,"LOOKUP_TABLE default\n");
+ }else{
+ mpi_rc = MPI_Recv(&mpi_inmsg, 1, MPI_INT, (E->parallel.me-1), 0, E->parallel.world, &mpi_stat);
+ fp1 = output_open(output_file,"a");
+ }
+ for(j=1; j<= E->sphere.caps_per_proc;j++)
+ for(i=1;i<=E->lmesh.nno;i++){
+ ftmp = E->NP[j][i];
+ if(be_write_float_to_file(&ftmp,1,fp1)!=1)BE_WERROR;
+ }
+ fclose(fp1);fflush(fp1); /* close file and flush buffer */
+ if(E->output.gzdir.vtk_io == 2)
+ if(E->parallel.me < E->parallel.nproc-1){
+ mpi_rc = MPI_Send(&mpi_success_message, 1, MPI_INT, (E->parallel.me+1), 0, E->parallel.world);
+ }
+ }
+ return;
+}
+
+
+
+void gzdir_output_tracer(struct All_variables *E, int cycles)
+{
+ int i, j, n, ncolumns;
+ char output_file[255];
+ gzFile *fp1;
+
+ snprintf(output_file,255,"%s/%d/tracer.%d.%d.gz",
+ E->control.data_dir,cycles,
+ E->parallel.me, cycles);
+ fp1 = gzdir_output_open(output_file,"w");
+
+ ncolumns = 3 + E->trace.number_of_extra_quantities;
+
+ for(j=1;j<=E->sphere.caps_per_proc;j++) {
+ gzprintf(fp1,"%d %d %d %.5e\n", cycles, E->trace.ntracers[j],
+ ncolumns, E->monitor.elapsed_time);
+
+ for(n=1;n<=E->trace.ntracers[j];n++) {
+ /* write basic quantities (coordinate) */
+ gzprintf(fp1,"%9.5e %9.5e %9.5e",
+ E->trace.basicq[j][0][n],
+ E->trace.basicq[j][1][n],
+ E->trace.basicq[j][2][n]);
+
+ /* write extra quantities */
+ for (i=0; i<E->trace.number_of_extra_quantities; i++) {
+ gzprintf(fp1," %9.5e", E->trace.extraq[j][i][n]);
+ }
+ gzprintf(fp1, "\n");
+ }
+
+ }
+
+ gzclose(fp1);
+ return;
+}
+
+
+void gzdir_output_comp_nd(struct All_variables *E, int cycles)
+{
+ int i, j, k;
+ char output_file[255],message[255];
+ gzFile *gz1;
+ FILE *fp1;
+ float ftmp;
+ /* for dealing with several processors */
+ MPI_Status mpi_stat;
+ int mpi_rc;
+ int mpi_inmsg, mpi_success_message = 1;
+
+ if(E->output.gzdir.vtk_io < 2){
+ snprintf(output_file,255,"%s/%d/comp_nd.%d.%d.gz",
+ E->control.data_dir,cycles,
+ E->parallel.me, cycles);
+ gz1 = gzdir_output_open(output_file,"w");
+ for(j=1;j<=E->sphere.caps_per_proc;j++) {
+ gzprintf(gz1,"%3d %7d %.5e %.5e %.5e\n",
+ j, E->lmesh.nel,
+ E->monitor.elapsed_time,
+ E->composition.initial_bulk_composition,
+ E->composition.bulk_composition);
+ for(i=1;i<=E->lmesh.nno;i++) {
+ for(k=0;k<E->composition.ncomp;k++)
+ gzprintf(gz1,"%.6e ",E->composition.comp_node[j][k][i]);
+ gzprintf(gz1,"\n");
+ }
+ }
+ gzclose(gz1);
+ }else{/* new legacy VTK */
+ if(E->output.gzdir.vtk_io == 2)
+ parallel_process_sync(E);
+ get_vtk_filename(output_file,0,E,cycles);
+ if((E->output.gzdir.vtk_io==3) || (E->parallel.me == 0)){
+ fp1 = output_open(output_file,"a");
+ if(E->composition.ncomp > 4)
+ myerror(E,"vtk out error: ncomp out of bounds (needs to be < 4)");
+ sprintf(message,"SCALARS composition float %d\n",E->composition.ncomp);
+ myfprintf(fp1,message);
+ myfprintf(fp1,"LOOKUP_TABLE default\n");
+ }else{ /* serial wait */
+ mpi_rc = MPI_Recv(&mpi_inmsg, 1, MPI_INT, (E->parallel.me-1), 0, E->parallel.world, &mpi_stat);
+ fp1 = output_open(output_file,"a");
+ }
+ for(j=1; j<= E->sphere.caps_per_proc;j++)
+ for(i=1;i<=E->lmesh.nno;i++){
+ for(k=0;k<E->composition.ncomp;k++){
+ ftmp = E->composition.comp_node[j][k][i];
+ if(be_write_float_to_file(&ftmp,1,fp1)!=1)BE_WERROR;
+ }
+ }
+ fclose(fp1);fflush(fp1); /* close file and flush buffer */
+ if(E->output.gzdir.vtk_io == 2) /* serial */
+ if(E->parallel.me < E->parallel.nproc-1){
+ mpi_rc = MPI_Send(&mpi_success_message, 1, MPI_INT, (E->parallel.me+1), 0, E->parallel.world);
+ }
+ }
+ return;
+}
+
+
+void gzdir_output_comp_el(struct All_variables *E, int cycles)
+{
+ int i, j, k;
+ char output_file[255];
+ gzFile *fp1;
+
+ snprintf(output_file,255,"%s/%d/comp_el.%d.%d.gz", E->control.data_dir,
+ cycles,E->parallel.me, cycles);
+ fp1 = gzdir_output_open(output_file,"w");
+
+ for(j=1;j<=E->sphere.caps_per_proc;j++) {
+ gzprintf(fp1,"%3d %7d %.5e %.5e %.5e\n",
+ j, E->lmesh.nel,
+ E->monitor.elapsed_time,
+ E->composition.initial_bulk_composition,
+ E->composition.bulk_composition);
+
+ for(i=1;i<=E->lmesh.nel;i++) {
+ for(k=0;k<E->composition.ncomp;k++)
+ gzprintf(fp1,"%.6e ",E->composition.comp_el[j][k][i]);
+ gzprintf(fp1,"\n");
+ }
+ }
+
+ gzclose(fp1);
+ return;
+}
+
+
+void gzdir_output_heating(struct All_variables *E, int cycles)
+{
+ int j, e;
+ char output_file[255];
+ gzFile *fp1;
+
+ snprintf(output_file,255,"%s/%d/heating.%d.%d.gz", E->control.data_dir,
+ cycles,E->parallel.me, cycles);
+ fp1 = gzdir_output_open(output_file,"w");
+
+ gzprintf(fp1,"%.5e\n",E->monitor.elapsed_time);
+
+ for(j=1;j<=E->sphere.caps_per_proc;j++) {
+ gzprintf(fp1,"%3d %7d\n", j, E->lmesh.nel);
+ for(e=1; e<=E->lmesh.nel; e++)
+ gzprintf(fp1, "%.4e %.4e %.4e\n", E->heating_adi[j][e],
+ E->heating_visc[j][e], E->heating_latent[j][e]);
+ }
+ gzclose(fp1);
+
+ return;
+}
+
+
+/*
+
+restart facility for zipped/VTK style , will init temperature
+
+*/
+void restart_tic_from_gzdir_file(struct All_variables *E)
+{
+ int ii, ll, mm,rezip;
+ float restart_elapsed_time;
+ int i, m;
+ char output_file[255], input_s[1000];
+ FILE *fp;
+
+ float v1, v2, v3, g;
+
+ ii = E->monitor.solution_cycles_init;
+ switch(E->output.gzdir.vtk_io){
+ case 2:
+ case 3:
+ myerror(E,"sorry, restart with vtk_io 2 or 3 not implemented yet");
+ break;
+ case 1:
+ /* VTK I/O */
+ snprintf(output_file,255,"%s/%d/t.%d.%d",
+ E->control.data_dir_old,
+ ii,E->parallel.me,ii);
+ break;
+ default:
+ snprintf(output_file,255,"%s/%d/velo.%d.%d",
+ E->control.data_dir_old,ii,
+ E->parallel.me,ii);
+ break;
+ }
+ /* open file */
+ rezip = open_file_zipped(output_file,&fp,E);
+ if (E->parallel.me==0){
+ fprintf(stderr,"restart_tic_from_gzdir_file: using %s for restarted temperature\n",
+ output_file);
+ fprintf(E->fp,"restart_tic_from_gzdir_file: using %s for restarted temperature\n",
+ output_file);
+ }
+ if(fscanf(fp,"%i %i %f",&ll,&mm,&restart_elapsed_time) != 3)
+ myerror(E,"restart vtkl read error 0");
+ if(mm != E->lmesh.nno){
+ fprintf(stderr,"%i %i\n",mm, E->lmesh.nno);
+ myerror(E,"lmesh.nno mismatch in restart files");
+ }
+
+ switch(E->output.gzdir.vtk_io) {
+ case 1: /* VTK */
+ for(m=1;m <= E->sphere.caps_per_proc;m++) {
+ if(fscanf(fp,"%i %i",&ll,&mm) != 2)
+ myerror(E,"restart vtkl read error 1");
+ for(i=1;i<=E->lmesh.nno;i++){
+ if(fscanf(fp,"%f",&g) != 1)
+ myerror(E,"restart vtkl read error 2");
+ if(!finite(g)){
+ fprintf(stderr,"WARNING: found a NaN in input temperatures\n");
+ g=0.0;
+ }
+ E->T[m][i] = g;
+ }
+ }
+ break;
+ default: /* old style velo */
+ for(m=1;m <= E->sphere.caps_per_proc;m++) {
+ fscanf(fp,"%i %i",&ll,&mm);
+ for(i=1;i<=E->lmesh.nno;i++) {
+ fscanf(fp,"%f %f %f %f",&v1,&v2,&v3,&g);
+ /* E->sphere.cap[m].V[1][i] = v1;
+ E->sphere.cap[m].V[1][i] = v2;
+ E->sphere.cap[m].V[1][i] = v3; */
+ /* I don't like that */
+ //E->T[m][i] = max(0.0,min(g,1.0));
+ E->T[m][i] = g;
+ }
+ }
+ break;
+ }
+ fclose (fp);
+ if(rezip) /* rezip */
+ gzip_file(output_file);
+
+ temperatures_conform_bcs(E);
+
+ return;
+}
+
+
+/*
+
+tries to open 'name'. if name exists, out will be pointer to file and
+return 0. if name doesn't exist, will check for name.gz. if this
+exists, will unzip and open, and return 1
+
+the idea is to preserve the initial file state
+
+*/
+int open_file_zipped(char *name, FILE **in,
+ struct All_variables *E)
+{
+ char mstring[1000];
+ *in = fopen(name,"r");
+ if (*in == NULL) {
+ /*
+ unzipped file not found
+ */
+ snprintf(mstring,1000,"%s.gz",name);
+ *in= fopen(mstring,"r");
+ if(*in != NULL){
+ /*
+ zipped version was found
+ */
+ fclose(*in);
+ snprintf(mstring,1000,"gunzip -f %s.gz",name); /* brutal */
+ system(mstring); /* unzip */
+ /* open unzipped file for read */
+ *in = fopen(name,"r");
+ if(*in == NULL)
+ myerror(E,"open_file_zipped: unzipping error");
+ return 1;
+ }else{
+ /*
+ no file, either zipped or unzipped
+ */
+ snprintf(mstring,1000,"no files %s and %s.gz were found, exiting",
+ name,name);
+ myerror(E,mstring);
+ return 0;
+ }
+ }else{
+ /*
+ file was found unzipped
+ */
+ return 0;
+ }
+}
+
+/* compress a file using the sytem command */
+void gzip_file(char *output_file)
+{
+ char command_string[300];
+ snprintf(command_string,300,"gzip -f %s",output_file); /* brutal */
+ system(command_string);
+}
+
+
+
+
+void get_vtk_filename(char *output_file,
+ int geo,struct All_variables *E,
+ int cycles)
+{
+ if(E->output.gzdir.vtk_io == 2){ /* serial */
+ if(geo) /* geometry */
+ sprintf(output_file,"%s/vtk_geo",
+ E->control.data_dir);
+ else /* data part */
+ sprintf(output_file,"%s/d.%08i.vtk",
+ E->control.data_dir, E->output.gzdir.vtk_ocount);
+ }else{ /* parallel */
+ if(geo) /* geometry */
+ sprintf(output_file,"%s/vtk_geo.%i",
+ E->control.data_dir,E->parallel.me);
+ else /* data part */
+ sprintf(output_file,"%s/%d/d.%08i.%i.vtk",
+ E->control.data_dir,cycles,
+ E->output.gzdir.vtk_ocount,
+ E->parallel.me);
+ }
+}
+
+
+
+
+/*
+
+
+big endian I/O (needed for vtk)
+
+
+*/
+
+/*
+
+write the x[n] array to file, making sure it is written big endian
+
+*/
+int be_write_float_to_file(float *x, int n, FILE *out)
+{
+ int i,nout;
+ static size_t len = sizeof(float);
+ size_t bsize;
+ float ftmp;
+#ifdef ASCII_DEBUG
+ for(i=0;i<n;i++)
+ fprintf(out,"%11g ",x[i]);
+ fprintf(out,"\n");
+ nout = n;
+#else
+ /*
+ do we need to flip?
+ */
+ if(be_is_little_endian()){
+ nout = 0;
+ for(i=0;i < n;i++){
+ ftmp = x[i];
+ be_flip_byte_order((void *)(&ftmp),len);
+ nout += fwrite(&ftmp,len,(size_t)1,out); /* write to file */
+ }
+ }else{ /* operate on x */
+ nout = fwrite(x,len,(size_t)n,out); /* write to file */
+ }
+#endif
+ return nout;
+}
+int be_write_int_to_file(int *x, int n, FILE *out)
+{
+ int i,nout;
+ static size_t len = sizeof(int);
+ size_t bsize;
+ int itmp;
+#ifdef ASCII_DEBUG
+ for(i=0;i<n;i++)
+ fprintf(out,"%11i ",x[i]);
+ fprintf(out,"\n");
+ nout = n;
+#else
+ /*
+ do we need to flip?
+ */
+ if(be_is_little_endian()){
+ nout = 0;
+ for(i=0;i < n;i++){
+ itmp = x[i];
+ be_flip_byte_order((void *)(&itmp),len);
+ nout += fwrite(&itmp,len,(size_t)1,out); /* write to file */
+ }
+ }else{ /* operate on x */
+ nout = fwrite(x,len,(size_t)n,out); /* write to file */
+ }
+#endif
+ return nout;
+}
+
+
+/* does this make a difference? nope, didn't, and why would it */
+void myfprintf(FILE *out,char *string)
+{
+#ifdef ASCII_DEBUG
+ fprintf(out,string);
+#else
+ fwrite(string, sizeof(char), strlen(string), out);
+#endif
+}
+
+int be_is_little_endian(void)
+{
+ static const unsigned long a = 1;
+ return *(const unsigned char *)&a;
+}
+
+/*
+
+
+flip endian-ness
+
+
+*/
+/*
+
+flip endianness of x
+
+*/
+void be_flip_byte_order(void *x, size_t len)
+{
+ void *copy;
+ int i;
+ copy = (void *)malloc(len); /* don't check here for speed */
+ memcpy(copy,x,len);
+ be_flipit(x,copy,len);
+ free(copy);
+}
+
+/* this should not be called with (i,i,size i) */
+void be_flipit(void *d, void *s, size_t len)
+{
+ unsigned char *dest = (unsigned char *)d;
+ unsigned char *src = (unsigned char *)s;
+ src += len - 1;
+ for (; len; len--)
+ *dest++ = *src--;
+}
+
+
+#undef BE_WERROR
+#endif /* gzdir switch */
Deleted: mc/3D/CitcomS/branches/cxx/lib/Output_h5.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Output_h5.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Output_h5.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,2418 +0,0 @@
-/*
- * Output_h5.c by Luis Armendariz and Eh Tan.
- * Copyright (C) 1994-2006, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- */
-
-/* Routines to write the output of the finite element cycles
- * into an HDF5 file, using parallel I/O.
- */
-
-
-#include <stdlib.h>
-#include <math.h>
-#include "element_definitions.h"
-#include "global_defs.h"
-#include "parsing.h"
-#include "output_h5.h"
-
-
-#ifdef USE_HDF5
-
-/****************************************************************************
- * Structs for HDF5 output *
- ****************************************************************************/
-
-enum field_class_t
-{
- SCALAR_FIELD = 0,
- VECTOR_FIELD = 1,
- TENSOR_FIELD = 2
-};
-
-struct field_t
-{
- /* field datatype (in file) */
- hid_t dtype;
-
- /* field dataspace (in file) */
- int rank;
- hsize_t *dims;
- hsize_t *maxdims;
- hsize_t *chunkdims;
-
- /* hyperslab selection parameters */
- hsize_t *offset;
- hsize_t *stride;
- hsize_t *count;
- hsize_t *block;
-
- /* number of data points in buffer */
- int n;
- float *data;
-
-};
-
-
-/****************************************************************************
- * Prototypes for functions local to this file. They are conditionally *
- * included only when the HDF5 library is available. *
- ****************************************************************************/
-
-/* for open/close HDF5 file */
-static void h5output_open(struct All_variables *, char *filename);
-static void h5output_close(struct All_variables *);
-
-static void h5output_const(struct All_variables *E);
-static void h5output_timedep(struct All_variables *E, int cycles);
-
-/* for creation of HDF5 objects (wrapped for compatibility with PyTables) */
-static hid_t h5create_file(const char *filename, unsigned flags, hid_t fcpl_id, hid_t fapl_id);
-static hid_t h5create_group(hid_t loc_id, const char *name, size_t size_hint);
-static herr_t h5create_dataset(hid_t loc_id, const char *name, const char *title, hid_t type_id, int rank, hsize_t *dims, hsize_t *maxdims, hsize_t *chunkdims);
-
-/* for creation of field and other dataset objects */
-static herr_t h5allocate_field(struct All_variables *E, enum field_class_t field_class, int nsd, hid_t dtype, field_t **field);
-static herr_t h5create_field(hid_t loc_id, field_t *field, const char *name, const char *title);
-static herr_t h5create_connectivity(hid_t loc_id, int nel);
-
-/* for writing to datasets */
-static herr_t h5write_dataset(hid_t dset_id, hid_t mem_type_id, const void *data, int rank, hsize_t *memdims, hsize_t *offset, hsize_t *stride, hsize_t *count, hsize_t *block, int collective, int dowrite);
-static herr_t h5write_field(hid_t dset_id, field_t *field, int collective, int dowrite);
-
-/* for releasing resources from field object */
-static herr_t h5close_field(field_t **field);
-
-/* for writing to HDF5 attributes */
-static herr_t find_attribute(hid_t loc_id, const char *attr_name);
-herr_t set_attribute_string(hid_t obj_id, const char *attr_name, const char *attr_data);
-herr_t set_attribute(hid_t obj_id, const char *attr_name, hid_t type_id, const void *data);
-herr_t set_attribute_float(hid_t obj_id, const char *attr_name, float x);
-herr_t set_attribute_double(hid_t obj_id, const char *attr_name, double x);
-herr_t set_attribute_int(hid_t obj_id, const char *attr_name, int n);
-herr_t set_attribute_long(hid_t obj_id, const char *attr_name, long n);
-herr_t set_attribute_llong(hid_t obj_id, const char *attr_name, long long n);
-herr_t set_attribute_array(hid_t obj_id, const char *attr_name, size_t rank, hsize_t *dims, hid_t type_id, const void *data);
-herr_t set_attribute_vector(hid_t obj_id, const char *attr_name, hsize_t dim, hid_t type_id, const void *data);
-herr_t set_attribute_int_vector(hid_t obj_id, const char *attr_name, hsize_t dim, const int *data);
-herr_t set_attribute_float_vector(hid_t obj_id, const char *attr_name, hsize_t dim, const float *data);
-herr_t set_attribute_double_vector(hid_t obj_id, const char *attr_name, hsize_t dim, const double *data);
-
-/* constant data (only for first cycle) */
-void h5output_meta(struct All_variables *);
-void h5output_coord(struct All_variables *);
-void h5output_surf_botm_coord(struct All_variables *);
-void h5output_have_coord(struct All_variables *);
-void h5output_material(struct All_variables *);
-void h5output_connectivity(struct All_variables *);
-
-/* time-varying data */
-void h5output_velocity(struct All_variables *, int);
-void h5output_temperature(struct All_variables *, int);
-void h5output_viscosity(struct All_variables *, int);
-void h5output_pressure(struct All_variables *, int);
-void h5output_stress(struct All_variables *, int);
-void h5output_tracer(struct All_variables *, int);
-void h5output_surf_botm(struct All_variables *, int);
-void h5output_geoid(struct All_variables *, int);
-void h5output_horiz_avg(struct All_variables *, int);
-void h5output_time(struct All_variables *, int);
-
-#endif
-
-extern void parallel_process_termination();
-extern void heat_flux(struct All_variables *);
-extern void get_STD_topo(struct All_variables *, float**, float**, float**, float**, int);
-extern void get_CBF_topo(struct All_variables *, float**, float**);
-extern void compute_geoid(struct All_variables *);
-
-
-/****************************************************************************
- * Functions that allocate memory for HDF5 output *
- ****************************************************************************/
-
-void h5output_allocate_memory(struct All_variables *E)
-{
-#ifdef USE_HDF5
- /*
- * Field variables
- */
-
- field_t *tensor3d;
- field_t *vector3d;
- field_t *vector2d;
- field_t *scalar3d;
- field_t *scalar2d;
- field_t *scalar1d;
-
- hid_t dtype; /* datatype for dataset creation */
-
- int nprocx = E->parallel.nprocx;
- int nprocy = E->parallel.nprocy;
- int nprocz = E->parallel.nprocz;
-
- /* Determine current cap and remember it */
- E->hdf5.cap = (E->parallel.me) / (nprocx * nprocy * nprocz);
-
- /********************************************************************
- * Allocate field objects for use in dataset writes... *
- ********************************************************************/
-
- tensor3d = NULL;
- vector3d = NULL;
- vector2d = NULL;
- scalar3d = NULL;
- scalar2d = NULL;
- scalar1d = NULL;
-
- /* store solutions as floats in .h5 file */
- dtype = H5T_NATIVE_FLOAT;
- h5allocate_field(E, TENSOR_FIELD, 3, dtype, &tensor3d);
- h5allocate_field(E, VECTOR_FIELD, 3, dtype, &vector3d);
- h5allocate_field(E, VECTOR_FIELD, 2, dtype, &vector2d);
- h5allocate_field(E, SCALAR_FIELD, 3, dtype, &scalar3d);
- h5allocate_field(E, SCALAR_FIELD, 2, dtype, &scalar2d);
- h5allocate_field(E, SCALAR_FIELD, 1, dtype, &scalar1d);
-
- /* allocate buffer */
- if (E->output.stress == 1)
- E->hdf5.data = (float *)malloc((tensor3d->n) * sizeof(float));
- else
- E->hdf5.data = (float *)malloc((vector3d->n) * sizeof(float));
-
- /* reuse buffer */
- tensor3d->data = E->hdf5.data;
- vector3d->data = E->hdf5.data;
- vector2d->data = E->hdf5.data;
- scalar3d->data = E->hdf5.data;
- scalar2d->data = E->hdf5.data;
- scalar1d->data = E->hdf5.data;
-
- E->hdf5.tensor3d = tensor3d;
- E->hdf5.vector3d = vector3d;
- E->hdf5.vector2d = vector2d;
- E->hdf5.scalar3d = scalar3d;
- E->hdf5.scalar2d = scalar2d;
- E->hdf5.scalar1d = scalar1d;
-
-#endif
-}
-
-
-
-/****************************************************************************
- * Functions that control which data is saved to output file(s). *
- * These represent possible choices for (E->output) function pointer. *
- ****************************************************************************/
-
-void h5output(struct All_variables *E, int cycles)
-{
-#ifndef USE_HDF5
- if(E->parallel.me == 0)
- fprintf(stderr, "h5output(): CitcomS was compiled without HDF5!\n");
- MPI_Finalize();
- exit(8);
-#else
- if (cycles == 0) {
- h5output_const(E);
- }
- h5output_timedep(E, cycles);
-#endif
-}
-
-
-/****************************************************************************
- * Function to read input parameters for legacy CitcomS *
- ****************************************************************************/
-
-void h5input_params(struct All_variables *E)
-{
-#ifdef USE_HDF5
-
- int m = E->parallel.me;
-
- /* TODO: use non-optimized defaults to avoid unnecessary failures */
-
- input_int("cb_block_size", &(E->output.cb_block_size), "1048576", m);
- input_int("cb_buffer_size", &(E->output.cb_buffer_size), "4194304", m);
-
- input_int("sieve_buf_size", &(E->output.sieve_buf_size), "1048576", m);
-
- input_int("output_alignment", &(E->output.alignment), "262144", m);
- input_int("output_alignment_threshold", &(E->output.alignment_threshold), "524288", m);
-
- input_int("cache_mdc_nelmts", &(E->output.cache_mdc_nelmts), "10330", m);
- input_int("cache_rdcc_nelmts", &(E->output.cache_rdcc_nelmts), "521", m);
- input_int("cache_rdcc_nbytes", &(E->output.cache_rdcc_nbytes), "1048576", m);
-
-#endif
-}
-
-
-#ifdef USE_HDF5
-
-static void h5output_const(struct All_variables *E)
-{
- char filename[100];
-
- /* determine filename */
- snprintf(filename, (size_t)100, "%s.h5", E->control.data_file);
-
- h5output_open(E, filename);
-
- h5output_meta(E);
- h5output_coord(E);
- h5output_connectivity(E);
- /*h5output_material(E);*/
-
- h5output_close(E);
-}
-
-static void h5output_timedep(struct All_variables *E, int cycles)
-{
- char filename[100];
-
- /* determine filename */
- snprintf(filename, (size_t)100, "%s.%d.h5",
- E->control.data_file, cycles);
-
- h5output_open(E, filename);
-
- h5output_time(E, cycles);
- h5output_velocity(E, cycles);
- h5output_temperature(E, cycles);
- h5output_viscosity(E, cycles);
-
- h5output_surf_botm(E, cycles);
-
- /* output tracer location if using tracer */
- if(E->control.tracer == 1)
- h5output_tracer(E, cycles);
-
- /* optional output below */
- if(E->output.geoid == 1)
- h5output_geoid(E, cycles);
-
- if(E->output.stress == 1){
- h5output_stress(E, cycles);
- }
- if(E->output.pressure == 1)
- h5output_pressure(E, cycles);
-
- if (E->output.horiz_avg == 1)
- h5output_horiz_avg(E, cycles);
-
- h5output_close(E);
-
-}
-
-
-/****************************************************************************
- * Functions to initialize and finalize access to HDF5 output file. *
- * Responsible for creating all necessary groups, attributes, and arrays. *
- ****************************************************************************/
-
-/* This function should open the HDF5 file
- */
-static void h5output_open(struct All_variables *E, char *filename)
-{
- /*
- * MPI variables
- */
-
- MPI_Comm comm = E->parallel.world;
- MPI_Info info = MPI_INFO_NULL;
- int ierr;
- char tmp[100];
-
- /*
- * HDF5 variables
- */
-
- hid_t file_id; /* HDF5 file identifier */
- hid_t fcpl_id; /* file creation property list identifier */
- hid_t fapl_id; /* file access property list identifier */
- herr_t status;
-
-
- /********************************************************************
- * Create HDF5 file using parallel I/O *
- ********************************************************************/
-
- /* TODO: figure out if it's possible give HDF5 a size hint when
- * creating the file
- */
-
- /* set up file creation property list with defaults */
- fcpl_id = H5P_DEFAULT;
-
- /* create an MPI_Info object to pass some tuning parameters
- * to the underlying MPI_File_open call
- */
- ierr = MPI_Info_create(&info);
- ierr = MPI_Info_set(info, "access_style", "write_once");
- ierr = MPI_Info_set(info, "collective_buffering", "true");
- snprintf(tmp, (size_t)100, "%d", E->output.cb_block_size);
- ierr = MPI_Info_set(info, "cb_block_size", tmp);
- snprintf(tmp, (size_t)100, "%d", E->output.cb_buffer_size);
- ierr = MPI_Info_set(info, "cb_buffer_size", tmp);
-
- /* set up file access property list with parallel I/O access */
- fapl_id = H5Pcreate(H5P_FILE_ACCESS);
-
- status = H5Pset_sieve_buf_size(fapl_id, (size_t)(E->output.sieve_buf_size));
- status = H5Pset_alignment(fapl_id, (hsize_t)(E->output.alignment_threshold),
- (hsize_t)(E->output.alignment));
- status = H5Pset_cache(fapl_id, E->output.cache_mdc_nelmts,
- (size_t)(E->output.cache_rdcc_nelmts),
- (size_t)(E->output.cache_rdcc_nbytes),
- 1.0);
-
- /* tell HDF5 to use MPI-IO */
- status = H5Pset_fapl_mpio(fapl_id, comm, info);
-
- /* close mpi info object */
- ierr = MPI_Info_free(&(info));
-
- /* create a new file collectively and release property list identifier */
- file_id = h5create_file(filename, H5F_ACC_TRUNC, fcpl_id, fapl_id);
- status = H5Pclose(fapl_id);
-
- /* save the file identifier for later use */
- E->hdf5.file_id = file_id;
-
-}
-
-
-/* Finalizing access to HDF5 objects.
- */
-static void h5output_close(struct All_variables *E)
-{
- herr_t status;
-
- /* close file */
- status = H5Fclose(E->hdf5.file_id);
-}
-
-
-/****************************************************************************
- * The following functions are used to save specific physical quantities *
- * from CitcomS into HDF5 arrays. *
- ****************************************************************************/
-
-
-/****************************************************************************
- * 3D Fields *
- ****************************************************************************/
-
-void h5output_coord(struct All_variables *E)
-{
- hid_t dataset;
- herr_t status;
- field_t *field;
-
- int i, j, k;
- int n, nx, ny, nz;
- int m, mx, my, mz;
-
- field = E->hdf5.vector3d;
-
- nx = E->lmesh.nox;
- ny = E->lmesh.noy;
- nz = E->lmesh.noz;
-
- mx = field->block[1];
- my = field->block[2];
- mz = field->block[3];
-
- /* prepare the data -- change citcom yxz order to xyz order */
- for(i = 0; i < mx; i++)
- {
- for(j = 0; j < my; j++)
- {
- for(k = 0; k < mz; k++)
- {
- n = k + i*nz + j*nz*nx;
- m = k + j*mz + i*mz*my;
- field->data[3*m+0] = E->sx[1][1][n+1];
- field->data[3*m+1] = E->sx[1][2][n+1];
- field->data[3*m+2] = E->sx[1][3][n+1];
- }
- }
- }
-
- h5create_field(E->hdf5.file_id, field, "coord", "coordinates of nodes");
-
- /* write to dataset */
- dataset = H5Dopen(E->hdf5.file_id, "/coord");
- status = h5write_field(dataset, field, 1, 1);
-
- /* release resources */
- status = H5Dclose(dataset);
-}
-
-void h5output_velocity(struct All_variables *E, int cycles)
-{
- hid_t dataset;
- herr_t status;
- field_t *field;
-
- int i, j, k;
- int n, nx, ny, nz;
- int m, mx, my, mz;
-
- field = E->hdf5.vector3d;
-
- nx = E->lmesh.nox;
- ny = E->lmesh.noy;
- nz = E->lmesh.noz;
-
- mx = field->block[1];
- my = field->block[2];
- mz = field->block[3];
-
- /* prepare the data -- change citcom yxz order to xyz order */
- for(i = 0; i < mx; i++)
- {
- for(j = 0; j < my; j++)
- {
- for(k = 0; k < mz; k++)
- {
- n = k + i*nz + j*nz*nx;
- m = k + j*mz + i*mz*my;
- field->data[3*m+0] = E->sphere.cap[1].V[1][n+1];
- field->data[3*m+1] = E->sphere.cap[1].V[2][n+1];
- field->data[3*m+2] = E->sphere.cap[1].V[3][n+1];
- }
- }
- }
-
- h5create_field(E->hdf5.file_id, field, "velocity", "velocity values on nodes");
-
- /* write to dataset */
- dataset = H5Dopen(E->hdf5.file_id, "/velocity");
- status = h5write_field(dataset, field, 1, 1);
-
- /* release resources */
- status = H5Dclose(dataset);
-}
-
-void h5output_temperature(struct All_variables *E, int cycles)
-{
- hid_t dataset;
- herr_t status;
- field_t *field;
-
- int i, j, k;
- int n, nx, ny, nz;
- int m, mx, my, mz;
-
- field = E->hdf5.scalar3d;
-
- nx = E->lmesh.nox;
- ny = E->lmesh.noy;
- nz = E->lmesh.noz;
-
- mx = field->block[1];
- my = field->block[2];
- mz = field->block[3];
-
- /* prepare the data -- change citcom yxz order to xyz order */
- for(i = 0; i < mx; i++)
- {
- for(j = 0; j < my; j++)
- {
- for(k = 0; k < mz; k++)
- {
- n = k + i*nz + j*nz*nx;
- m = k + j*mz + i*mz*my;
- field->data[m] = E->T[1][n+1];
- }
- }
- }
-
- h5create_field(E->hdf5.file_id, field, "temperature", "temperature values on nodes");
- /* write to dataset */
- dataset = H5Dopen(E->hdf5.file_id, "/temperature");
- status = h5write_field(dataset, field, 1, 1);
-
- /* release resources */
- status = H5Dclose(dataset);
-}
-
-void h5output_viscosity(struct All_variables *E, int cycles)
-{
- hid_t dataset;
- herr_t status;
- field_t *field;
-
- int lev;
- int i, j, k;
- int n, nx, ny, nz;
- int m, mx, my, mz;
-
- field = E->hdf5.scalar3d;
-
- lev = E->mesh.levmax;
-
- nx = E->lmesh.nox;
- ny = E->lmesh.noy;
- nz = E->lmesh.noz;
-
- mx = field->block[1];
- my = field->block[2];
- mz = field->block[3];
-
- /* prepare the data -- change citcom yxz order to xyz order */
- for(i = 0; i < mx; i++)
- {
- for(j = 0; j < my; j++)
- {
- for(k = 0; k < mz; k++)
- {
- n = k + i*nz + j*nz*nx;
- m = k + j*mz + i*mz*my;
- field->data[m] = E->VI[lev][1][n+1];
- }
- }
- }
-
- h5create_field(E->hdf5.file_id, field, "viscosity", "viscosity values on nodes");
- /* write to dataset */
- dataset = H5Dopen(E->hdf5.file_id, "/viscosity");
- status = h5write_field(dataset, field, 1, 1);
-
- /* release resources */
- status = H5Dclose(dataset);
-}
-
-void h5output_pressure(struct All_variables *E, int cycles)
-{
- hid_t dataset;
- herr_t status;
- field_t *field;
-
- int i, j, k;
- int n, nx, ny, nz;
- int m, mx, my, mz;
-
- field = E->hdf5.scalar3d;
-
- nx = E->lmesh.nox;
- ny = E->lmesh.noy;
- nz = E->lmesh.noz;
-
- mx = field->block[1];
- my = field->block[2];
- mz = field->block[3];
-
- /* prepare the data -- change citcom yxz order to xyz order */
- for(i = 0; i < mx; i++)
- {
- for(j = 0; j < my; j++)
- {
- for(k = 0; k < mz; k++)
- {
- n = k + i*nz + j*nz*nx;
- m = k + j*mz + i*mz*my;
- field->data[m] = E->NP[1][n+1];
- }
- }
- }
-
- /* Create /pressure dataset */
- h5create_field(E->hdf5.file_id, field, "pressure", "pressure values on nodes");
-
- /* write to dataset */
- dataset = H5Dopen(E->hdf5.file_id, "/pressure");
- status = h5write_field(dataset, field, 1, 1);
-
- /* release resources */
- status = H5Dclose(dataset);
-}
-
-void h5output_stress(struct All_variables *E, int cycles)
-{
- hid_t dataset;
- herr_t status;
- field_t *field;
-
- int i, j, k;
- int n, nx, ny, nz;
- int m, mx, my, mz;
- /* for stress computation */
- void allocate_STD_mem();
- void compute_nodal_stress();
- void free_STD_mem();
- float *SXX[NCS],*SYY[NCS],*SXY[NCS],*SXZ[NCS],*SZY[NCS],*SZZ[NCS];
- float *divv[NCS],*vorv[NCS];
- /* */
-
- if(E->control.use_cbf_topo) {/* for CBF topo, stress will not have been computed */
- allocate_STD_mem(E, SXX, SYY, SZZ, SXY, SXZ, SZY, divv, vorv);
- compute_nodal_stress(E, SXX, SYY, SZZ, SXY, SXZ, SZY, divv, vorv);
- free_STD_mem(E, SXX, SYY, SZZ, SXY, SXZ, SZY, divv, vorv);
- }
-
- field = E->hdf5.tensor3d;
-
- nx = E->lmesh.nox;
- ny = E->lmesh.noy;
- nz = E->lmesh.noz;
-
- mx = field->block[1];
- my = field->block[2];
- mz = field->block[3];
-
- /* prepare the data -- change citcom yxz order to xyz order */
- for(i = 0; i < mx; i++)
- {
- for(j = 0; j < my; j++)
- {
- for(k = 0; k < mz; k++)
- {
- n = k + i*nz + j*nz*nx;
- m = k + j*mz + i*mz*my;
- field->data[6*m+0] = E->gstress[1][6*n+1];
- field->data[6*m+1] = E->gstress[1][6*n+2];
- field->data[6*m+2] = E->gstress[1][6*n+3];
- field->data[6*m+3] = E->gstress[1][6*n+4];
- field->data[6*m+4] = E->gstress[1][6*n+5];
- field->data[6*m+5] = E->gstress[1][6*n+6];
- }
- }
- }
-
- /* Create /stress dataset */
- h5create_field(E->hdf5.file_id, field, "stress", "stress values on nodes");
-
- /* write to dataset */
- dataset = H5Dopen(E->hdf5.file_id, "/stress");
- status = h5write_field(dataset, field, 1, 1);
-
- /* release resources */
- status = H5Dclose(dataset);
-}
-
-void h5output_material(struct All_variables *E)
-{
-}
-
-void h5output_tracer(struct All_variables *E, int cycles)
-{
-}
-
-/****************************************************************************
- * 2D Fields *
- ****************************************************************************/
-
-void h5output_surf_botm_coord(struct All_variables *E)
-{
- hid_t dataset;
- herr_t status;
- field_t *field;
-
- int i, j, k;
- int n, nx, ny, nz;
- int m, mx, my;
-
- int pz = E->parallel.me_loc[3];
- int nprocz = E->parallel.nprocz;
-
- field = E->hdf5.vector2d;
-
- nx = E->lmesh.nox;
- ny = E->lmesh.noy;
- nz = E->lmesh.noz;
-
- mx = field->block[1];
- my = field->block[2];
-
- if (E->output.surf == 1)
- {
- k = nz-1;
- for(i = 0; i < mx; i++)
- {
- for(j = 0; j < my; j++)
- {
- n = k + i*nz + j*nz*nx;
- m = j + i*my;
- field->data[2*m+0] = E->sx[1][1][n+1];
- field->data[2*m+1] = E->sx[1][2][n+1];
- }
- }
- dataset = H5Dopen(E->hdf5.file_id, "/surf/coord");
- status = h5write_field(dataset, field, 0, (pz == nprocz-1));
- status = H5Dclose(dataset);
- }
-
- if (E->output.botm == 1)
- {
- k = 0;
- for(i = 0; i < mx; i++)
- {
- for(j = 0; j < my; j++)
- {
- n = k + i*nz + j*nz*nx;
- m = j + i*my;
- field->data[2*m+0] = E->sx[1][1][n+1];
- field->data[2*m+1] = E->sx[1][2][n+1];
- }
- }
- dataset = H5Dopen(E->hdf5.file_id, "/botm/coord");
- status = h5write_field(dataset, field, 0, (pz == 0));
- status = H5Dclose(dataset);
- }
-}
-
-void h5output_surf_botm(struct All_variables *E, int cycles)
-{
- hid_t file_id;
- hid_t surf_group; /* group identifier for top cap surface */
- hid_t botm_group; /* group identifier for bottom cap surface */
- hid_t dataset;
- herr_t status;
- field_t *scalar;
- field_t *vector;
-
- float *topo;
-
- int i, j, k;
- int n, nx, ny, nz;
- int m, mx, my;
-
- int pz = E->parallel.me_loc[3];
- int nprocz = E->parallel.nprocz;
-
- file_id = E->hdf5.file_id;
-
- scalar = E->hdf5.scalar2d;
- vector = E->hdf5.vector2d;
-
- nx = E->lmesh.nox;
- ny = E->lmesh.noy;
- nz = E->lmesh.noz;
-
- mx = scalar->block[1];
- my = scalar->block[2];
-
- if((E->output.write_q_files == 0) || (cycles == 0) ||
- (cycles % E->output.write_q_files)!=0)
- heat_flux(E);
- /* else, the heat flux will have been computed already */
-
-
-
- if(E->control.use_cbf_topo){
- get_CBF_topo(E, E->slice.tpg, E->slice.tpgb);
- }else{
- get_STD_topo(E, E->slice.tpg, E->slice.tpgb, E->slice.divg, E->slice.vort, cycles);
- }
-
- /********************************************************************
- * Top surface *
- ********************************************************************/
- if (E->output.surf == 1)
- {
- /* Create /surf/ group*/
- surf_group = h5create_group(file_id, "surf", (size_t)0);
- h5create_field(surf_group, E->hdf5.vector2d, "velocity",
- "top surface velocity");
- h5create_field(surf_group, E->hdf5.scalar2d, "heatflux",
- "top surface heatflux");
- h5create_field(surf_group, E->hdf5.scalar2d, "topography",
- "top surface topography");
- status = H5Gclose(surf_group);
-
- /* radial index */
- k = nz-1;
-
- /* velocity data */
- for(i = 0; i < mx; i++)
- {
- for(j = 0; j < my; j++)
- {
- n = k + i*nz + j*nz*nx;
- m = j + i*my;
- vector->data[2*m+0] = E->sphere.cap[1].V[1][n+1];
- vector->data[2*m+1] = E->sphere.cap[1].V[2][n+1];
- }
- }
- dataset = H5Dopen(file_id, "/surf/velocity");
- status = h5write_field(dataset, vector, 0, (pz == nprocz-1));
- status = H5Dclose(dataset);
-
- /* heatflux data */
- for(i = 0; i < mx; i++)
- {
- for(j = 0; j < my; j++)
- {
- n = k + i*nz + j*nz*nx;
- m = j + i*my;
- scalar->data[m] = E->slice.shflux[1][n+1];
- }
- }
-
- dataset = H5Dopen(file_id, "/surf/heatflux");
- status = h5write_field(dataset, scalar, 0, (pz == nprocz-1));
- status = H5Dclose(dataset);
-
- /* choose either STD topo or pseudo-free-surf topo */
- if (E->control.pseudo_free_surf)
- topo = E->slice.freesurf[1];
- else
- topo = E->slice.tpg[1];
-
- /* topography data */
- for(i = 0; i < mx; i++)
- {
- for(j = 0; j < my; j++)
- {
- n = k + i*nz + j*nz*nx;
- m = j + i*my;
- scalar->data[m] = topo[i];
- }
- }
- dataset = H5Dopen(file_id, "/surf/topography");
- status = h5write_field(dataset, scalar, 0, (pz == nprocz-1));
- status = H5Dclose(dataset);
- }
-
-
- /********************************************************************
- * Bottom surface *
- ********************************************************************/
- if (E->output.botm == 1)
- {
- /* Create /botm/ group */
- botm_group = h5create_group(file_id, "botm", (size_t)0);
- h5create_field(botm_group, E->hdf5.vector2d, "velocity",
- "bottom surface velocity");
- h5create_field(botm_group, E->hdf5.scalar2d, "heatflux",
- "bottom surface heatflux");
- h5create_field(botm_group, E->hdf5.scalar2d, "topography",
- "bottom surface topography");
- status = H5Gclose(botm_group);
-
- /* radial index */
- k = 0;
-
- /* velocity data */
- for(i = 0; i < mx; i++)
- {
- for(j = 0; j < my; j++)
- {
- n = k + i*nz + j*nz*nx;
- m = j + i*my;
- vector->data[2*m+0] = E->sphere.cap[1].V[1][n+1];
- vector->data[2*m+1] = E->sphere.cap[1].V[2][n+1];
- }
- }
- dataset = H5Dopen(file_id, "/botm/velocity");
- status = h5write_field(dataset, vector, 0, (pz == 0));
- status = H5Dclose(dataset);
-
- /* heatflux data */
- for(i = 0; i < mx; i++)
- {
- for(j = 0; j < my; j++)
- {
- n = k + i*nz + j*nz*nx;
- m = j + i*my;
- scalar->data[m] = E->slice.bhflux[1][n+1];
- }
- }
- dataset = H5Dopen(file_id, "/botm/heatflux");
- status = h5write_field(dataset, scalar, 0, (pz == 0));
- status = H5Dclose(dataset);
-
- /* topography data */
- topo = E->slice.tpg[1];
- for(i = 0; i < mx; i++)
- {
- for(j = 0; j < my; j++)
- {
- n = k + i*nz + j*nz*nx;
- m = j + i*my;
- scalar->data[m] = topo[i];
- }
- }
- dataset = H5Dopen(file_id, "/botm/topography");
- status = h5write_field(dataset, scalar, 0, (pz == 0));
- status = H5Dclose(dataset);
- }
-}
-
-
-/****************************************************************************
- * 1D Fields *
- ****************************************************************************/
-
-void h5output_have_coord(struct All_variables *E)
-{
- hid_t file_id;
- hid_t dataset;
- herr_t status;
-
- field_t *field;
-
- int k;
- int mz;
-
- int px = E->parallel.me_loc[1];
- int py = E->parallel.me_loc[2];
-
- field = E->hdf5.scalar1d;
-
- mz = field->block[1];
-
- if (E->output.horiz_avg == 1)
- {
- for(k = 0; k < mz; k++)
- field->data[k] = E->sx[1][3][k+1];
- dataset = H5Dopen(E->hdf5.file_id, "/horiz_avg/coord");
- status = h5write_field(dataset, field, 0, (px == 0 && py == 0));
- status = H5Dclose(dataset);
- }
-
-}
-
-void h5output_horiz_avg(struct All_variables *E, int cycles)
-{
- /* horizontal average output of temperature and rms velocity */
- void compute_horiz_avg();
-
- hid_t file_id;
- hid_t avg_group; /* group identifier for horizontal averages */
- hid_t dataset;
- herr_t status;
-
- field_t *field;
-
- int k;
- int mz;
-
- int px = E->parallel.me_loc[1];
- int py = E->parallel.me_loc[2];
-
-
- file_id = E->hdf5.file_id;
-
- field = E->hdf5.scalar1d;
-
- mz = field->block[1];
-
- /* calculate horizontal averages */
- compute_horiz_avg(E);
-
- /* Create /horiz_avg/ group */
- avg_group = h5create_group(file_id, "horiz_avg", (size_t)0);
- h5create_field(avg_group, E->hdf5.scalar1d, "temperature",
- "horizontal temperature average");
- h5create_field(avg_group, E->hdf5.scalar1d, "velocity_xy",
- "horizontal Vxy average (rms)");
- h5create_field(avg_group, E->hdf5.scalar1d, "velocity_z",
- "horizontal Vz average (rms)");
- status = H5Gclose(avg_group);
-
- /*
- * note that only the first nprocz processes need to output
- */
-
- /* temperature horizontal average */
- for(k = 0; k < mz; k++)
- field->data[k] = E->Have.T[k+1];
- dataset = H5Dopen(file_id, "/horiz_avg/temperature");
- status = h5write_field(dataset, field, 0, (px == 0 && py == 0));
- status = H5Dclose(dataset);
-
- /* Vxy horizontal average (rms) */
- for(k = 0; k < mz; k++)
- field->data[k] = E->Have.V[1][k+1];
- dataset = H5Dopen(file_id, "/horiz_avg/velocity_xy");
- status = h5write_field(dataset, field, 0, (px == 0 && py == 0));
- status = H5Dclose(dataset);
-
- /* Vz horizontal average (rms) */
- for(k = 0; k < mz; k++)
- field->data[k] = E->Have.V[2][k+1];
- dataset = H5Dopen(file_id, "/horiz_avg/velocity_z");
- status = h5write_field(dataset, field, 0, (px == 0 && py == 0));
- status = H5Dclose(dataset);
-}
-
-/****************************************************************************
- * Spherical harmonics coefficients *
- ****************************************************************************/
-void h5output_geoid(struct All_variables *E, int cycles)
-{
- struct HDF5_GEOID
- {
- int ll;
- int mm;
- float total_sin;
- float total_cos;
- float tpgt_sin;
- float tpgt_cos;
- float bncy_sin;
- float bncy_cos;
- } *row;
-
-
- hid_t dataset; /* dataset identifier */
- hid_t datatype; /* row datatype identifier */
- hid_t dataspace; /* memory dataspace */
- hid_t dxpl_id; /* data transfer property list identifier */
-
- herr_t status;
-
- hsize_t rank = 1;
- hsize_t dim = E->sphere.hindice;
- int i, ll, mm;
-
- /* Create the memory data type */
- datatype = H5Tcreate(H5T_COMPOUND, sizeof(struct HDF5_GEOID));
- status = H5Tinsert(datatype, "degree", HOFFSET(struct HDF5_GEOID, ll),
- H5T_NATIVE_INT);
- status = H5Tinsert(datatype, "order", HOFFSET(struct HDF5_GEOID, mm),
- H5T_NATIVE_INT);
- status = H5Tinsert(datatype, "total_sin",
- HOFFSET(struct HDF5_GEOID, total_sin),
- H5T_NATIVE_FLOAT);
- status = H5Tinsert(datatype, "total_cos",
- HOFFSET(struct HDF5_GEOID, total_cos),
- H5T_NATIVE_FLOAT);
- status = H5Tinsert(datatype, "tpgt_sin",
- HOFFSET(struct HDF5_GEOID, tpgt_sin),
- H5T_NATIVE_FLOAT);
- status = H5Tinsert(datatype, "tpgt_cos",
- HOFFSET(struct HDF5_GEOID, tpgt_cos),
- H5T_NATIVE_FLOAT);
- status = H5Tinsert(datatype, "bncy_sin",
- HOFFSET(struct HDF5_GEOID, bncy_sin),
- H5T_NATIVE_FLOAT);
- status = H5Tinsert(datatype, "bncy_cos",
- HOFFSET(struct HDF5_GEOID, bncy_cos),
- H5T_NATIVE_FLOAT);
-
- /* Create the dataspace */
- dataspace = H5Screate_simple(rank, &dim, NULL);
-
- /* Create the dataset */
- dataset = H5Dcreate(E->hdf5.file_id, "geoid", datatype,
- dataspace, H5P_DEFAULT);
-
- /*
- * Write necessary attributes for PyTables compatibility
- */
-
- set_attribute_string(dataset, "TITLE", "Geoid table");
- set_attribute_string(dataset, "CLASS", "TABLE");
- set_attribute_string(dataset, "FLAVOR", "numpy");
- set_attribute_string(dataset, "VERSION", "2.6");
-
- set_attribute_llong(dataset, "NROWS", dim);
-
- set_attribute_string(dataset, "FIELD_0_NAME", "degree");
- set_attribute_string(dataset, "FIELD_1_NAME", "order");
- set_attribute_string(dataset, "FIELD_2_NAME", "total_sin");
- set_attribute_string(dataset, "FIELD_3_NAME", "total_cos");
- set_attribute_string(dataset, "FIELD_4_NAME", "tpgt_sin");
- set_attribute_string(dataset, "FIELD_5_NAME", "tpgt_cos");
- set_attribute_string(dataset, "FIELD_6_NAME", "bncy_sin");
- set_attribute_string(dataset, "FIELD_7_NAME", "bncy_cos");
-
- set_attribute_double(dataset, "FIELD_0_FILL", 0);
- set_attribute_double(dataset, "FIELD_1_FILL", 0);
- set_attribute_double(dataset, "FIELD_2_FILL", 0);
- set_attribute_double(dataset, "FIELD_3_FILL", 0);
- set_attribute_double(dataset, "FIELD_4_FILL", 0);
- set_attribute_double(dataset, "FIELD_5_FILL", 0);
- set_attribute_double(dataset, "FIELD_6_FILL", 0);
- set_attribute_double(dataset, "FIELD_7_FILL", 0);
-
- /* Create property list for independent dataset write */
- dxpl_id = H5Pcreate(H5P_DATASET_XFER);
- status = H5Pset_dxpl_mpio(dxpl_id, H5FD_MPIO_INDEPENDENT);
-
- compute_geoid(E);
-
- if (E->parallel.me == 0) {
- /* Prepare data */
- row = (struct HDF5_GEOID *) malloc((E->sphere.hindice)
- * sizeof(struct HDF5_GEOID));
- i = 0;
- for(ll = 0; ll <= E->output.llmax; ll++)
- for(mm = 0; mm <= ll; mm++) {
- row[i].ll = ll;
- row[i].mm = mm;
- row[i].total_sin = E->sphere.harm_geoid[0][i];
- row[i].total_cos = E->sphere.harm_geoid[1][i];
- row[i].tpgt_sin = E->sphere.harm_geoid_from_tpgt[0][i];
- row[i].tpgt_cos = E->sphere.harm_geoid_from_tpgt[1][i];
- row[i].bncy_sin = E->sphere.harm_geoid_from_bncy[0][i];
- row[i].bncy_cos = E->sphere.harm_geoid_from_bncy[1][i];
- i ++;
- }
-
- /* write data */
- status = H5Dwrite(dataset, datatype, dataspace, H5S_ALL,
- dxpl_id, row);
-
- free(row);
- }
-
- /* Release resources */
- status = H5Pclose(dxpl_id);
- status = H5Sclose(dataspace);
- status = H5Tclose(datatype);
- status = H5Dclose(dataset);
-}
-
-
-
-
-/****************************************************************************
- * Create and output /connectivity dataset *
- ****************************************************************************/
-
-static herr_t h5create_connectivity(hid_t loc_id, int nel)
-{
- hid_t dataset;
- hid_t dataspace;
- herr_t status;
-
- hsize_t dims[2];
-
- dims[0] = nel;
- dims[1] = 8;
-
- /* Create the dataspace */
- dataspace = H5Screate_simple(2, dims, NULL);
-
- /* Create the dataset */
- dataset = H5Dcreate(loc_id, "connectivity", H5T_NATIVE_INT, dataspace, H5P_DEFAULT);
-
- /* Write necessary attributes for PyTables compatibility */
- set_attribute_string(dataset, "TITLE", "Node connectivity");
- set_attribute_string(dataset, "CLASS", "ARRAY");
- set_attribute_string(dataset, "FLAVOR", "numpy");
- set_attribute_string(dataset, "VERSION", "2.3");
-
- status = H5Sclose(dataspace);
- status = H5Dclose(dataset);
- return 0;
-}
-
-void h5output_connectivity(struct All_variables *E)
-{
- hid_t dataset;
- herr_t status;
-
- int rank = 2;
- hsize_t memdims[2];
- hsize_t offset[2];
- hsize_t stride[2];
- hsize_t count[2];
- hsize_t block[2];
-
- int p;
- int px = E->parallel.me_loc[1];
- int py = E->parallel.me_loc[2];
- int pz = E->parallel.me_loc[3];
- int nprocx = E->parallel.nprocx;
- int nprocy = E->parallel.nprocy;
- int nprocz = E->parallel.nprocz;
- int procs_per_cap = nprocx * nprocy * nprocz;
-
- int e;
- int nel = E->lmesh.nel;
- int *ien;
-
- int *data;
-
- if (E->output.connectivity == 1)
- {
- /* process id (local to cap) */
- p = pz + px*nprocz + py*nprocz*nprocx;
-
- rank = 2;
-
- memdims[0] = nel;
- memdims[1] = 8;
-
- offset[0] = nel * p;
- offset[1] = 0;
-
- stride[0] = 1;
- stride[1] = 1;
-
- count[0] = 1;
- count[1] = 1;
-
- block[0] = nel;
- block[1] = 8;
-
- data = (int *)malloc((nel*8) * sizeof(int));
-
- for(e = 0; e < nel; e++)
- {
- ien = E->ien[1][e+1].node;
- data[8*e+0] = ien[1]-1; /* TODO: subtract one? */
- data[8*e+1] = ien[2]-1;
- data[8*e+2] = ien[3]-1;
- data[8*e+3] = ien[4]-1;
- data[8*e+4] = ien[5]-1;
- data[8*e+5] = ien[6]-1;
- data[8*e+6] = ien[7]-1;
- data[8*e+7] = ien[8]-1;
- }
-
- /* Create /connectivity dataset */
- h5create_connectivity(E->hdf5.file_id, E->lmesh.nel * procs_per_cap);
-
- dataset = H5Dopen(E->hdf5.file_id, "/connectivity");
-
- status = h5write_dataset(dataset, H5T_NATIVE_INT, data, rank, memdims,
- offset, stride, count, block,
- 0, (E->hdf5.cap == 0));
-
- status = H5Dclose(dataset);
-
- free(data);
- }
-}
-
-
-/****************************************************************************
- * Create and output /time and /timstep attributes *
- ****************************************************************************/
-
-
-void h5output_time(struct All_variables *E, int cycles)
-{
- hid_t root;
- herr_t status;
-
- root = H5Gopen(E->hdf5.file_id, "/");
- status = set_attribute_float(root, "time", E->monitor.elapsed_time);
- status = set_attribute_float(root, "timestep", cycles);
- status = H5Gclose(root);
-}
-
-
-/****************************************************************************
- * Save most CitcomS input parameters, and other information, as *
- * attributes in a group called /input *
- ****************************************************************************/
-
-void h5output_meta(struct All_variables *E)
-{
- hid_t input;
- herr_t status;
-
- int n;
- int rank;
- hsize_t *dims;
- double *data;
- float tmp;
-
- input = h5create_group(E->hdf5.file_id, "input", (size_t)0);
-
- status = set_attribute_int(input, "PID", E->control.PID);
-
- /*
- * Advection_diffusion.inventory
- */
-
- status = set_attribute_int(input, "ADV", E->advection.ADVECTION);
- status = set_attribute_int(input, "filter_temp", E->advection.filter_temperature);
-
- status = set_attribute_float(input, "finetunedt", E->advection.fine_tune_dt);
- status = set_attribute_float(input, "fixed_timestep", E->advection.fixed_timestep);
- status = set_attribute_float(input, "inputdiffusivity", E->control.inputdiff);
-
- status = set_attribute_int(input, "adv_sub_iterations", E->advection.temp_iterations);
-
-
- /*
- * BC.inventory
- */
-
- status = set_attribute_int(input, "side_sbcs", E->control.side_sbcs);
- status = set_attribute_int(input, "pseudo_free_surf", E->control.pseudo_free_surf);
-
- status = set_attribute_int(input, "topvbc", E->mesh.topvbc);
- status = set_attribute_float(input, "topvbxval", E->control.VBXtopval);
- status = set_attribute_float(input, "topvbyval", E->control.VBYtopval);
-
-
- status = set_attribute_int(input, "botvbc", E->mesh.botvbc);
- status = set_attribute_float(input, "botvbxval", E->control.VBXbotval);
- status = set_attribute_float(input, "botvbyval", E->control.VBYbotval);
-
- status = set_attribute_int(input, "toptbc", E->mesh.toptbc);
- status = set_attribute_float(input, "toptbcval", E->control.TBCtopval);
-
- status = set_attribute_int(input, "bottbc", E->mesh.bottbc);
- status = set_attribute_float(input, "bottbcval", E->control.TBCbotval);
-
- status = set_attribute_int(input, "temperature_bound_adj", E->control.temperature_bound_adj);
- status = set_attribute_float(input, "depth_bound_adj", E->control.depth_bound_adj);
- status = set_attribute_float(input, "width_bound_adj", E->control.width_bound_adj);
-
- /*
- * Const.inventory
- */
-
- status = set_attribute_float(input, "density", E->data.density);
- status = set_attribute_float(input, "thermdiff", E->data.therm_diff);
- status = set_attribute_float(input, "gravacc", E->data.grav_acc);
- status = set_attribute_float(input, "thermexp", E->data.therm_exp);
- status = set_attribute_float(input, "refvisc", E->data.ref_viscosity);
- status = set_attribute_float(input, "cp", E->data.Cp);
- status = set_attribute_float(input, "density_above", E->data.density_above);
- status = set_attribute_float(input, "density_below", E->data.density_below);
-
- status = set_attribute_float(input, "z_lith", E->viscosity.zlith);
- status = set_attribute_float(input, "z_410", E->viscosity.z410);
- status = set_attribute_float(input, "z_lmantle", E->viscosity.zlm);
- status = set_attribute_float(input, "z_cmb", E->viscosity.zcmb);
-
- status = set_attribute_float(input, "radius_km", E->data.radius_km);
- status = set_attribute_float(input, "scalev", E->data.scalev);
- status = set_attribute_float(input, "scalet", E->data.scalet);
-
- /*
- * IC.inventory
- */
-
- status = set_attribute_int(input, "restart", E->control.restart);
- status = set_attribute_int(input, "post_p", E->control.post_p);
- status = set_attribute_int(input, "solution_cycles_init", E->monitor.solution_cycles_init);
- status = set_attribute_int(input, "zero_elapsed_time", E->control.zero_elapsed_time);
-
- status = set_attribute_int(input, "tic_method", E->convection.tic_method);
-
- if (E->convection.tic_method == 0)
- {
- n = E->convection.number_of_perturbations;
- status = set_attribute_int(input, "num_perturbations", n);
- status = set_attribute_int_vector(input, "perturbl", n, E->convection.perturb_ll);
- status = set_attribute_int_vector(input, "perturbm", n, E->convection.perturb_mm);
- status = set_attribute_int_vector(input, "perturblayer", n, E->convection.load_depth);
- status = set_attribute_float_vector(input, "perturbmag", n, E->convection.perturb_mag);
- }
- else if (E->convection.tic_method == 1)
- {
- status = set_attribute_float(input, "half_space_age", E->convection.half_space_age);
- }
- else if (E->convection.tic_method == 2)
- {
- status = set_attribute_float(input, "half_space_age", E->convection.half_space_age);
- status = set_attribute_float_vector(input, "blob_center", 3, E->convection.blob_center);
- status = set_attribute_float(input, "blob_radius", E->convection.blob_radius);
- status = set_attribute_float(input, "blob_dT", E->convection.blob_dT);
- }
-
- /*
- * Param.inventory
- */
-
- status = set_attribute_int(input, "file_vbcs", E->control.vbcs_file);
- status = set_attribute_string(input, "vel_bound_file", E->control.velocity_boundary_file);
-
- status = set_attribute_int(input, "file_tbcs", E->control.tbcs_file);
- status = set_attribute_string(input, "temp_bound_file", E->control.temperature_boundary_file);
-
- status = set_attribute_int(input, "mat_control", E->control.mat_control);
- status = set_attribute_string(input, "mat_file", E->control.mat_file);
-
- status = set_attribute_int(input, "lith_age", E->control.lith_age);
- status = set_attribute_string(input, "lith_age_file", E->control.lith_age_file);
- status = set_attribute_int(input, "lith_age_time", E->control.lith_age_time);
- status = set_attribute_float(input, "lith_age_depth", E->control.lith_age_depth);
- status = set_attribute_float(input, "mantle_temp", E->control.lith_age_mantle_temp);
-
- status = set_attribute_float(input, "start_age", E->control.start_age);
- status = set_attribute_int(input, "reset_startage", E->control.reset_startage);
-
- /*
- * Phase.inventory
- */
-
- status = set_attribute_float(input, "Ra_410", E->control.Ra_410);
- status = set_attribute_float(input, "clapeyron410", E->control.clapeyron410);
- status = set_attribute_float(input, "transT410", E->control.transT410);
- status = set_attribute_float(input, "width410",
- (E->control.inv_width410 == 0)?
- E->control.inv_width410 :
- 1.0/E->control.inv_width410);
-
- status = set_attribute_float(input, "Ra_670", E->control.Ra_670);
- status = set_attribute_float(input, "clapeyron670", E->control.clapeyron670);
- status = set_attribute_float(input, "transT670", E->control.transT670);
- status = set_attribute_float(input, "width670",
- (E->control.inv_width670 == 0)?
- E->control.inv_width670 :
- 1.0/E->control.inv_width670);
-
- status = set_attribute_float(input, "Ra_cmb", E->control.Ra_cmb);
- status = set_attribute_float(input, "clapeyroncmb", E->control.clapeyroncmb);
- status = set_attribute_float(input, "transTcmb", E->control.transTcmb);
- status = set_attribute_float(input, "widthcmb",
- (E->control.inv_widthcmb == 0)?
- E->control.inv_widthcmb :
- 1.0/E->control.inv_widthcmb);
-
- /*
- * Solver.inventory
- */
-
- status = set_attribute_string(input, "datadir", E->control.data_dir);
- status = set_attribute_string(input, "datafile", E->control.data_file);
- status = set_attribute_string(input, "datadir_old", E->control.data_dir_old);
- status = set_attribute_string(input, "datafile_old", E->control.old_P_file);
-
- status = set_attribute_float(input, "rayleigh", E->control.Atemp);
- status = set_attribute_float(input, "dissipation_number", E->control.disptn_number);
- status = set_attribute_float(input, "gruneisen",
- (E->control.inv_gruneisen == 0)?
- 1.0/E->control.inv_gruneisen :
- E->control.inv_gruneisen);
- status = set_attribute_float(input, "surfaceT", E->control.surface_temp);
- status = set_attribute_float(input, "Q0", E->control.Q0);
-
- status = set_attribute_int(input, "stokes_flow_only", E->control.stokes);
-
- status = set_attribute_string(input, "output_format", E->output.format);
- status = set_attribute_string(input, "output_optional", E->output.optional);
- status = set_attribute_int(input, "output_ll_max", E->output.llmax);
-
- status = set_attribute_int(input, "verbose", E->control.verbose);
- status = set_attribute_int(input, "see_convergence", E->control.print_convergence);
-
- /*
- * Sphere.inventory
- */
-
- status = set_attribute_int(input, "nproc_surf", E->parallel.nprocxy);
-
- status = set_attribute_int(input, "nprocx", E->parallel.nprocx);
- status = set_attribute_int(input, "nprocy", E->parallel.nprocy);
- status = set_attribute_int(input, "nprocz", E->parallel.nprocz);
-
- status = set_attribute_int(input, "coor", E->control.coor);
- status = set_attribute_string(input, "coor_file", E->control.coor_file);
-
- status = set_attribute_int(input, "nodex", E->mesh.nox);
- status = set_attribute_int(input, "nodey", E->mesh.noy);
- status = set_attribute_int(input, "nodez", E->mesh.noz);
-
- status = set_attribute_int(input, "levels", E->mesh.levels);
- status = set_attribute_int(input, "mgunitx", E->mesh.mgunitx);
- status = set_attribute_int(input, "mgunity", E->mesh.mgunity);
- status = set_attribute_int(input, "mgunitz", E->mesh.mgunitz);
-
- status = set_attribute_double(input, "radius_outer", E->sphere.ro);
- status = set_attribute_double(input, "radius_inner", E->sphere.ri);
-
- status = set_attribute_int(input, "caps", E->sphere.caps);
-
- rank = 2;
- dims = (hsize_t *)malloc(rank * sizeof(hsize_t));
- dims[0] = E->sphere.caps;
- dims[1] = 4;
- data = (double *)malloc((dims[0]*dims[1]) * sizeof(double));
-
- for(n = 1; n <= E->sphere.caps; n++)
- {
- data[4*(n-1) + 0] = E->sphere.cap[n].theta[1];
- data[4*(n-1) + 1] = E->sphere.cap[n].theta[2];
- data[4*(n-1) + 2] = E->sphere.cap[n].theta[3];
- data[4*(n-1) + 3] = E->sphere.cap[n].theta[4];
- }
- status = set_attribute_array(input, "theta", rank, dims, H5T_NATIVE_DOUBLE, data);
-
- for(n = 1; n <= E->sphere.caps; n++)
- {
- data[4*(n-1) + 0] = E->sphere.cap[n].fi[1];
- data[4*(n-1) + 1] = E->sphere.cap[n].fi[2];
- data[4*(n-1) + 2] = E->sphere.cap[n].fi[3];
- data[4*(n-1) + 3] = E->sphere.cap[n].fi[4];
- }
- status = set_attribute_array(input, "fi", rank, dims, H5T_NATIVE_DOUBLE, data);
-
- free(data);
- free(dims);
-
- if (E->sphere.caps == 1)
- {
- status = set_attribute_double(input, "theta_min", E->control.theta_min);
- status = set_attribute_double(input, "theta_max", E->control.theta_max);
- status = set_attribute_double(input, "fi_min", E->control.fi_min);
- status = set_attribute_double(input, "fi_max", E->control.fi_max);
- }
-
- /*
- * Tracer.inventory
- */
-
- status = set_attribute_int(input, "tracer", E->control.tracer);
- status = set_attribute_string(input, "tracer_file", E->trace.tracer_file);
-
- /*
- * Visc.inventory
- */
-
- status = set_attribute_string(input, "Viscosity", E->viscosity.STRUCTURE);
- status = set_attribute_int(input, "visc_smooth_method", E->viscosity.smooth_cycles);
- status = set_attribute_int(input, "VISC_UPDATE", E->viscosity.update_allowed);
-
- n = E->viscosity.num_mat;
- status = set_attribute_int(input, "num_mat", n);
- status = set_attribute_float_vector(input, "visc0", n, E->viscosity.N0);
- status = set_attribute_int(input, "TDEPV", E->viscosity.TDEPV);
- status = set_attribute_int(input, "rheol", E->viscosity.RHEOL);
- status = set_attribute_float_vector(input, "viscE", n, E->viscosity.E);
- status = set_attribute_float_vector(input, "viscT", n, E->viscosity.T);
- status = set_attribute_float_vector(input, "viscZ", n, E->viscosity.Z);
-
- status = set_attribute_int(input, "SDEPV", E->viscosity.SDEPV);
- status = set_attribute_float(input, "sdepv_misfit", E->viscosity.sdepv_misfit);
- status = set_attribute_float_vector(input, "sdepv_expt", n, E->viscosity.sdepv_expt);
-
- status = set_attribute_int(input, "VMIN", E->viscosity.MIN);
- status = set_attribute_float(input, "visc_min", E->viscosity.min_value);
-
- status = set_attribute_int(input, "VMAX", E->viscosity.MAX);
- status = set_attribute_float(input, "visc_max", E->viscosity.max_value);
-
- /*
- * Incompressible.inventory
- */
-
- status = set_attribute_string(input, "Solver", E->control.SOLVER_TYPE);
- status = set_attribute_int(input, "node_assemble", E->control.NASSEMBLE);
- status = set_attribute_int(input, "precond", E->control.precondition);
-
- status = set_attribute_double(input, "accuracy", E->control.accuracy);
-
- status = set_attribute_int(input, "mg_cycle", E->control.mg_cycle);
- status = set_attribute_int(input, "down_heavy", E->control.down_heavy);
- status = set_attribute_int(input, "up_heavy", E->control.up_heavy);
-
- status = set_attribute_int(input, "vlowstep", E->control.v_steps_low);
- status = set_attribute_int(input, "vhighstep", E->control.v_steps_high);
- status = set_attribute_int(input, "piterations", E->control.p_iterations);
-
- status = set_attribute_int(input, "aug_lagr", E->control.augmented_Lagr);
- status = set_attribute_double(input, "aug_number", E->control.augmented);
-
- /* status = set_attribute(input, "", H5T_NATIVE_, &(E->)); */
-
- /*
- * Release resources
- */
- status = H5Gclose(input);
-}
-
-
-
-/*****************************************************************************
- * Private functions to simplify certain tasks in the h5output_*() functions *
- * The rest of the file can now be hidden from the compiler, when HDF5 *
- * is not enabled. *
- *****************************************************************************/
-
-/* Function to create an HDF5 file compatible with PyTables.
- *
- * To enable parallel I/O access, use something like the following:
- *
- * hid_t file_id;
- * hid_t fcpl_id, fapl_id;
- * herr_t status;
- *
- * MPI_Comm comm = MPI_COMM_WORLD;
- * MPI_Info info = MPI_INFO_NULL;
- *
- * ...
- *
- * fcpl_id = H5P_DEFAULT;
- *
- * fapl_id = H5Pcreate(H5P_FILE_ACCESS);
- * status = H5Pset_fapl_mpio(fapl_id, comm, info);
- *
- * file_id = h5create_file(filename, H5F_ACC_TRUNC, fcpl_id, fapl_id);
- * status = H5Pclose(fapl_id);
- */
-static hid_t h5create_file(const char *filename,
- unsigned flags,
- hid_t fcpl_id,
- hid_t fapl_id)
-{
- hid_t file_id;
- hid_t root;
-
- herr_t status;
-
- /* Create the HDF5 file */
- file_id = H5Fcreate(filename, flags, fcpl_id, fapl_id);
-
- /* Write necessary attributes to root group for PyTables compatibility */
- root = H5Gopen(file_id, "/");
- set_attribute_string(root, "TITLE", "CitcomS output");
- set_attribute_string(root, "CLASS", "GROUP");
- set_attribute_string(root, "VERSION", "1.0");
- set_attribute_string(root, "PYTABLES_FORMAT_VERSION", "1.5");
-
- /* release resources */
- status = H5Gclose(root);
-
- return file_id;
-}
-
-
-/* Function to create an HDF5 group compatible with PyTables.
- * To close group, call H5Gclose().
- */
-static hid_t h5create_group(hid_t loc_id, const char *name, size_t size_hint)
-{
- hid_t group_id;
-
- /* TODO:
- * Make sure this function is called with an appropriately
- * estimated size_hint parameter
- */
- group_id = H5Gcreate(loc_id, name, size_hint);
-
- /* Write necessary attributes for PyTables compatibility */
- set_attribute_string(group_id, "TITLE", "CitcomS HDF5 group");
- set_attribute_string(group_id, "CLASS", "GROUP");
- set_attribute_string(group_id, "VERSION", "1.0");
- set_attribute_string(group_id, "PYTABLES_FORMAT_VERSION", "1.5");
-
- return group_id;
-}
-
-
-static herr_t h5create_dataset(hid_t loc_id,
- const char *name,
- const char *title,
- hid_t type_id,
- int rank,
- hsize_t *dims,
- hsize_t *maxdims,
- hsize_t *chunkdims)
-{
- hid_t dataset; /* dataset identifier */
- hid_t dataspace; /* file dataspace identifier */
- hid_t dcpl_id; /* dataset creation property list identifier */
- herr_t status;
-
- /* create the dataspace for the dataset */
- dataspace = H5Screate_simple(rank, dims, maxdims);
- if (dataspace < 0)
- {
- /*TODO: print error*/
- return -1;
- }
-
- dcpl_id = H5P_DEFAULT;
- if (chunkdims != NULL)
- {
- /* modify dataset creation properties to enable chunking */
- dcpl_id = H5Pcreate(H5P_DATASET_CREATE);
- status = H5Pset_chunk(dcpl_id, rank, chunkdims);
- /*status = H5Pset_fill_value(dcpl_id, H5T_NATIVE_FLOAT, &fillvalue);*/
- }
-
- /* create the dataset */
- dataset = H5Dcreate(loc_id, name, type_id, dataspace, dcpl_id);
- if (dataset < 0)
- {
- /*TODO: print error*/
- return -1;
- }
-
- /* Write necessary attributes for PyTables compatibility */
- set_attribute_string(dataset, "TITLE", title);
- set_attribute_string(dataset, "CLASS", "ARRAY");
- set_attribute_string(dataset, "FLAVOR", "numpy");
- set_attribute_string(dataset, "VERSION", "2.3");
-
- /* release resources */
- if (chunkdims != NULL)
- {
- status = H5Pclose(dcpl_id);
- }
- status = H5Sclose(dataspace);
- status = H5Dclose(dataset);
-
- return 0;
-}
-
-static herr_t h5allocate_field(struct All_variables *E,
- enum field_class_t field_class,
- int nsd,
- hid_t dtype,
- field_t **field)
-{
- int rank = 0;
- int tdim = 0;
- int cdim = 0;
-
- /* indices */
- int s = -100; /* caps dimension */
- int x = -100; /* first spatial dimension */
- int y = -100; /* second spatial dimension */
- int z = -100; /* third spatial dimension */
- int c = -100; /* dimension for components */
-
- int dim;
-
- int px, py, pz;
- int nprocx, nprocy, nprocz;
-
- int nx, ny, nz;
- int nodex, nodey, nodez;
-
- /* coordinates of current process in cap */
- px = E->parallel.me_loc[1];
- py = E->parallel.me_loc[2];
- pz = E->parallel.me_loc[3];
-
- /* dimensions of processes per cap */
- nprocx = E->parallel.nprocx;
- nprocy = E->parallel.nprocy;
- nprocz = E->parallel.nprocz;
-
- /* determine dimensions of mesh */
- nodex = E->mesh.nox;
- nodey = E->mesh.noy;
- nodez = E->mesh.noz;
-
- /* determine dimensions of local mesh */
- nx = E->lmesh.nox;
- ny = E->lmesh.noy;
- nz = E->lmesh.noz;
-
- /* clear struct pointer */
- *field = NULL;
-
- /* start with caps as the first dimension */
- rank = 1;
- s = 0;
-
- /* add the spatial dimensions */
- switch (nsd)
- {
- case 3:
- rank += 3;
- x = 1;
- y = 2;
- z = 3;
- break;
- case 2:
- rank += 2;
- x = 1;
- y = 2;
- break;
- case 1:
- rank += 1;
- z = 1;
- break;
- default:
- return -1;
- }
-
- /* add components dimension at end */
- switch (field_class)
- {
- case TENSOR_FIELD:
- cdim = 6;
- rank += 1;
- c = rank-1;
- break;
- case VECTOR_FIELD:
- cdim = nsd;
- rank += 1;
- c = rank-1;
- break;
- case SCALAR_FIELD:
- cdim = 0;
- break;
- }
-
- if (rank > 1)
- {
- *field = (field_t *)malloc(sizeof(field_t));
-
- (*field)->dtype = dtype;
-
- (*field)->rank = rank;
- (*field)->dims = (hsize_t *)malloc(rank * sizeof(hsize_t));
- (*field)->maxdims = (hsize_t *)malloc(rank * sizeof(hsize_t));
- (*field)->chunkdims = NULL;
-
- (*field)->offset = (hsize_t *)malloc(rank * sizeof(hsize_t));
- (*field)->stride = (hsize_t *)malloc(rank * sizeof(hsize_t));
- (*field)->count = (hsize_t *)malloc(rank * sizeof(hsize_t));
- (*field)->block = (hsize_t *)malloc(rank * sizeof(hsize_t));
-
-
- if (s >= 0)
- {
- /* dataspace parameters */
- (*field)->dims[s] = E->sphere.caps;
- (*field)->maxdims[s] = E->sphere.caps;
-
- /* hyperslab selection parameters */
- (*field)->offset[s] = E->hdf5.cap;
- (*field)->stride[s] = 1;
- (*field)->count[s] = 1;
- (*field)->block[s] = 1;
- }
-
- if (x >= 0)
- {
- /* dataspace parameters */
- (*field)->dims[x] = nodex;
- (*field)->maxdims[x] = nodex;
-
- /* hyperslab selection parameters */
- (*field)->offset[x] = px*(nx-1);
- (*field)->stride[x] = 1;
- (*field)->count[x] = 1;
- (*field)->block[x] = ((px == nprocx-1) ? nx : nx-1);
- }
-
- if (y >= 0)
- {
- /* dataspace parameters */
- (*field)->dims[y] = nodey;
- (*field)->maxdims[y] = nodey;
-
- /* hyperslab selection parameters */
- (*field)->offset[y] = py*(ny-1);
- (*field)->stride[y] = 1;
- (*field)->count[y] = 1;
- (*field)->block[y] = ((py == nprocy-1) ? ny : ny-1);
- }
-
- if (z >= 0)
- {
- /* dataspace parameters */
- (*field)->dims[z] = nodez;
- (*field)->maxdims[z] = nodez;
-
- /* hyperslab selection parameters */
- (*field)->offset[z] = pz*(nz-1);
- (*field)->stride[z] = 1;
- (*field)->count[z] = 1;
- (*field)->block[z] = ((pz == nprocz-1) ? nz : nz-1);
- }
-
- if (c >= 0)
- {
- /* dataspace parameters */
- (*field)->dims[c] = cdim;
- (*field)->maxdims[c] = cdim;
-
- /* hyperslab selection parameters */
- (*field)->offset[c] = 0;
- (*field)->stride[c] = 1;
- (*field)->count[c] = 1;
- (*field)->block[c] = cdim;
- }
-
- /* count number of data points */
- (*field)->n = 1;
- for(dim = 0; dim < rank; dim++)
- (*field)->n *= (*field)->block[dim];
-
-
- if(E->control.verbose) {
- fprintf(E->fp_out, "creating dataset: rank=%d size=%d\n",
- rank, (*field)->n);
- fprintf(E->fp_out, " s=%d x=%d y=%d z=%d c=%d\n",
- s, x, y, z, c);
- fprintf(E->fp_out, "\tdim\tmaxdim\toffset\tstride\tcount\tblock\n");
- for(dim = 0; dim < rank; dim++) {
- fprintf(E->fp_out, "\t%d\t%d\t%d\t%d\t%d\t%d\n",
- (int) (*field)->dims[dim],
- (int) (*field)->maxdims[dim],
- (int) (*field)->offset[dim],
- (int) (*field)->stride[dim],
- (int) (*field)->count[dim],
- (int) (*field)->block[dim]);
- }
- }
- return 0;
- }
-
- return -1;
-}
-
-static herr_t h5create_field(hid_t loc_id,
- field_t *field,
- const char *name,
- const char *title)
-{
- herr_t status;
-
- status = h5create_dataset(loc_id, name, title, field->dtype, field->rank,
- field->dims, field->maxdims, field->chunkdims);
-
- return status;
-}
-
-
-static herr_t h5write_dataset(hid_t dset_id,
- hid_t mem_type_id,
- const void *data,
- int rank,
- hsize_t *memdims,
- hsize_t *offset,
- hsize_t *stride,
- hsize_t *count,
- hsize_t *block,
- int collective,
- int dowrite)
-{
- hid_t memspace; /* memory dataspace */
- hid_t filespace; /* file dataspace */
- hid_t dxpl_id; /* dataset transfer property list identifier */
- herr_t status;
-
- /* create memory dataspace */
- memspace = H5Screate_simple(rank, memdims, NULL);
- if (memspace < 0)
- {
- /*TODO: print error*/
- return -1;
- }
-
- /* get file dataspace */
- filespace = H5Dget_space(dset_id);
- if (filespace < 0)
- {
- /*TODO: print error*/
- H5Sclose(memspace);
- return -1;
- }
-
- /* hyperslab selection */
- status = H5Sselect_hyperslab(filespace, H5S_SELECT_SET,
- offset, stride, count, block);
- if (status < 0)
- {
- /*TODO: print error*/
- status = H5Sclose(filespace);
- status = H5Sclose(memspace);
- return -1;
- }
-
- /* dataset transfer property list */
- dxpl_id = H5Pcreate(H5P_DATASET_XFER);
- if (dxpl_id < 0)
- {
- /*TODO: print error*/
- status = H5Sclose(filespace);
- status = H5Sclose(memspace);
- return -1;
- }
-
- if (collective)
- status = H5Pset_dxpl_mpio(dxpl_id, H5FD_MPIO_COLLECTIVE);
- else
- status = H5Pset_dxpl_mpio(dxpl_id, H5FD_MPIO_INDEPENDENT);
-
- if (status < 0)
- {
- /*TODO: print error*/
- status = H5Pclose(dxpl_id);
- status = H5Sclose(filespace);
- status = H5Sclose(memspace);
- return -1;
- }
-
- /* write the data to the hyperslab */
- if (dowrite || collective)
- {
- status = H5Dwrite(dset_id, mem_type_id, memspace, filespace, dxpl_id, data);
- if (status < 0)
- {
- /*TODO: print error*/
- H5Pclose(dxpl_id);
- H5Sclose(filespace);
- H5Sclose(memspace);
- return -1;
- }
- }
-
- /* release resources */
- status = H5Pclose(dxpl_id);
- status = H5Sclose(filespace);
- status = H5Sclose(memspace);
-
- return 0;
-}
-
-static herr_t h5write_field(hid_t dset_id, field_t *field, int collective, int dowrite)
-{
- herr_t status;
-
- status = h5write_dataset(dset_id, H5T_NATIVE_FLOAT, field->data,
- field->rank, field->block, field->offset,
- field->stride, field->count, field->block,
- collective, dowrite);
- return status;
-}
-
-
-static herr_t h5close_field(field_t **field)
-{
- if (field != NULL)
- if (*field != NULL)
- {
- free((*field)->dims);
- free((*field)->maxdims);
- if((*field)->chunkdims != NULL)
- free((*field)->chunkdims);
- free((*field)->offset);
- free((*field)->stride);
- free((*field)->count);
- free((*field)->block);
- /*free((*field)->data);*/
- free(*field);
- }
-}
-
-
-
-/****************************************************************************
- * Some of the following functions were based from the H5ATTR.c *
- * source file in PyTables, which is a BSD-licensed python extension *
- * for accessing HDF5 files. *
- * *
- * The copyright notice is hereby retained. *
- * *
- * NCSA HDF *
- * Scientific Data Technologies *
- * National Center for Supercomputing Applications *
- * University of Illinois at Urbana-Champaign *
- * 605 E. Springfield, Champaign IL 61820 *
- * *
- * For conditions of distribution and use, see the accompanying *
- * hdf/COPYING file. *
- * *
- * Modified versions of H5LT for getting and setting attributes for open *
- * groups and leaves. *
- * F. Altet 2005/09/29 *
- * *
- ****************************************************************************/
-
-/* Function : find_attr
- * Purpose : operator function used by find_attribute
- * Programmer: Pedro Vicente, pvn at ncsa.uiuc.edu
- * Date : June 21, 2001
- */
-static herr_t find_attr(hid_t loc_id, const char *name, void *op_data)
-{
- /* Define a default zero value for return. This will cause the
- * iterator to continue if the palette attribute is not found yet.
- */
-
- int ret = 0;
-
- char *attr_name = (char *)op_data;
-
- /* Shut the compiler up */
- loc_id = loc_id;
-
- /* Define a positive value for return value if the attribute was
- * found. This will cause the iterator to immediately return that
- * positive value, indicating short-circuit success
- */
-
- if(strcmp(name, attr_name) == 0)
- ret = 1;
-
- return ret;
-}
-
-/* Function : find_attribute
- * Purpose : Inquires if an attribute named attr_name exists attached
- * attached to the object loc_id.
- * Programmer: Pedro Vicente, pvn at ncsa.uiuc.edu
- * Date : June 21, 2001
- *
- * Comments:
- * The function uses H5Aiterate with the operator function find_attr
- *
- * Return:
- *
- * Success: The return value of the first operator that returns
- * non-zero, or zero if all members were processed with no
- * operator returning non-zero.
- *
- * Failure: Negative if something goes wrong within the library,
- * or the negative value returned by one of the operators.
- */
-static herr_t find_attribute(hid_t loc_id, const char *attr_name)
-{
- unsigned int attr_num;
- herr_t ret;
-
- attr_num = 0;
- ret = H5Aiterate(loc_id, &attr_num, find_attr, (void *)attr_name);
-
- return ret;
-}
-
-
-/* Function: set_attribute_string
- * Purpose : Creates and writes a string attribute named attr_name
- * and attaches it to the object specified by obj_id
- * Return : Success 0, Failure -1
- * Comments: If the attribute already exists, it is overwritten.
- */
-herr_t set_attribute_string(hid_t obj_id,
- const char *attr_name,
- const char *attr_data)
-{
- hid_t attr_type;
- hid_t attr_size;
- hid_t attr_space_id;
- hid_t attr_id;
- int has_attr;
- herr_t status;
-
- /* Create the attribute */
- attr_type = H5Tcopy(H5T_C_S1);
- if (attr_type < 0) goto out;
-
- attr_size = strlen(attr_data) + 1; /* extra null term */
-
- status = H5Tset_size(attr_type, (size_t)attr_size);
- if (status < 0) goto out;
-
- status = H5Tset_strpad(attr_type, H5T_STR_NULLTERM);
- if (status < 0) goto out;
-
- attr_space_id = H5Screate(H5S_SCALAR);
- if (status < 0) goto out;
-
- /* Verify if the attribute already exists */
- has_attr = find_attribute(obj_id, attr_name);
-
- /* The attribute already exists, delete it */
- if (has_attr == 1)
- {
- status = H5Adelete(obj_id, attr_name);
- if (status < 0) goto out;
- }
-
- /* Create and write the attribute */
-
- attr_id = H5Acreate(obj_id, attr_name, attr_type, attr_space_id,
- H5P_DEFAULT);
- if(attr_id < 0) goto out;
-
- status = H5Awrite(attr_id, attr_type, attr_data);
- if(status < 0) goto out;
-
- status = H5Aclose(attr_id);
- if(status < 0) goto out;
-
- status = H5Sclose(attr_space_id);
- if(status < 0) goto out;
-
- status = H5Tclose(attr_type);
- if(status < 0) goto out;
-
-
- return 0;
-
-out:
- return -1;
-}
-
-
-/* Function : set_attribute
- * Purpose : Private function used by
- * set_attribute_int and set_attribute_float
- * Return : Success 0, Failure -1
- * Programmer: Pedro Vicente, pvn at ncsa.uiuc.edu
- * Date : July 25, 2001
- */
-herr_t set_attribute(hid_t obj_id,
- const char *attr_name,
- hid_t type_id,
- const void *data)
-{
- hid_t space_id, attr_id;
- herr_t status;
-
- int has_attr;
-
- /* Create the data space for the attribute. */
- space_id = H5Screate(H5S_SCALAR);
- if (space_id < 0) goto out;
-
- /* Verify if the attribute already exists */
- has_attr = find_attribute(obj_id, attr_name);
- if (has_attr == 1)
- {
- /* The attribute already exists. Delete it. */
- status = H5Adelete(obj_id, attr_name);
- if(status < 0) goto out;
- }
-
- /* Create the attribute. */
- attr_id = H5Acreate(obj_id, attr_name, type_id, space_id, H5P_DEFAULT);
- if (attr_id < 0) goto out;
-
- /* Write the attribute data. */
- status = H5Awrite(attr_id, type_id, data);
- if (status < 0) goto out;
-
- /* Close the attribute. */
- status = H5Aclose(attr_id);
- if (status < 0) goto out;
-
- /* Close the data space. */
- status = H5Sclose(space_id);
- if (status < 0) goto out;
-
- return 0;
-
-out:
- return -1;
-}
-
-herr_t set_attribute_float(hid_t obj_id, const char *attr_name, float x)
-{
- return set_attribute(obj_id, attr_name, H5T_NATIVE_FLOAT, &x);
-}
-
-herr_t set_attribute_double(hid_t obj_id, const char *attr_name, double x)
-{
- return set_attribute(obj_id, attr_name, H5T_NATIVE_DOUBLE, &x);
-}
-
-herr_t set_attribute_int(hid_t obj_id, const char *attr_name, int n)
-{
- return set_attribute(obj_id, attr_name, H5T_NATIVE_INT, &n);
-}
-
-herr_t set_attribute_long(hid_t obj_id, const char *attr_name, long n)
-{
- return set_attribute(obj_id, attr_name, H5T_NATIVE_LONG, &n);
-}
-
-herr_t set_attribute_llong(hid_t obj_id, const char *attr_name, long long n)
-{
- return set_attribute(obj_id, attr_name, H5T_NATIVE_LLONG, &n);
-}
-
-/* Function: set_attribute_array
- * Purpose : write an array attribute
- * Return : Success 0, Failure -1
- * Date : July 25, 2001
- */
-herr_t set_attribute_array(hid_t obj_id,
- const char *attr_name,
- size_t rank,
- hsize_t *dims,
- hid_t type_id,
- const void *data)
-{
- hid_t space_id, attr_id;
- herr_t status;
-
- int has_attr;
-
- /* Create the data space for the attribute. */
- space_id = H5Screate_simple(rank, dims, NULL);
- if (space_id < 0) goto out;
-
- /* Verify if the attribute already exists. */
- has_attr = find_attribute(obj_id, attr_name);
- if (has_attr == 1)
- {
- /* The attribute already exists. Delete it. */
- status = H5Adelete(obj_id, attr_name);
- if (status < 0) goto out;
- }
-
- /* Create the attribute. */
- attr_id = H5Acreate(obj_id, attr_name, type_id, space_id, H5P_DEFAULT);
- if (attr_id < 0) goto out;
-
- /* Write the attribute data. */
- status = H5Awrite(attr_id, type_id, data);
- if (status < 0) goto out;
-
- /* Close the attribute. */
- status = H5Aclose(attr_id);
- if (status < 0) goto out;
-
- /* Close the dataspace. */
- status = H5Sclose(space_id);
- if (status < 0) goto out;
-
- return 0;
-
-out:
- return -1;
-}
-
-herr_t set_attribute_vector(hid_t obj_id,
- const char *attr_name,
- hsize_t dim,
- hid_t type_id,
- const void *data)
-{
- return set_attribute_array(obj_id, attr_name, 1, &dim, type_id, data);
-}
-
-herr_t set_attribute_int_vector(hid_t obj_id,
- const char *attr_name,
- hsize_t dim,
- const int *data)
-{
- return set_attribute_array(obj_id, attr_name, 1, &dim, H5T_NATIVE_INT, data);
-}
-
-herr_t set_attribute_float_vector(hid_t obj_id,
- const char *attr_name,
- hsize_t dim,
- const float *data)
-{
- return set_attribute_array(obj_id, attr_name, 1, &dim, H5T_NATIVE_FLOAT, data);
-}
-
-herr_t set_attribute_double_vector(hid_t obj_id,
- const char *attr_name,
- hsize_t dim,
- const double *data)
-{
- return set_attribute_array(obj_id, attr_name, 1, &dim, H5T_NATIVE_DOUBLE, data);
-}
-
-#endif /* #ifdef USE_HDF5 */
Copied: mc/3D/CitcomS/branches/cxx/lib/Output_h5.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Output_h5.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Output_h5.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Output_h5.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,2418 @@
+/*
+ * Output_h5.c by Luis Armendariz and Eh Tan.
+ * Copyright (C) 1994-2006, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ */
+
+/* Routines to write the output of the finite element cycles
+ * into an HDF5 file, using parallel I/O.
+ */
+
+
+#include <stdlib.h>
+#include <math.h>
+#include "element_definitions.h"
+#include "global_defs.h"
+#include "parsing.h"
+#include "output_h5.h"
+
+
+#ifdef USE_HDF5
+
+/****************************************************************************
+ * Structs for HDF5 output *
+ ****************************************************************************/
+
+enum field_class_t
+{
+ SCALAR_FIELD = 0,
+ VECTOR_FIELD = 1,
+ TENSOR_FIELD = 2
+};
+
+struct field_t
+{
+ /* field datatype (in file) */
+ hid_t dtype;
+
+ /* field dataspace (in file) */
+ int rank;
+ hsize_t *dims;
+ hsize_t *maxdims;
+ hsize_t *chunkdims;
+
+ /* hyperslab selection parameters */
+ hsize_t *offset;
+ hsize_t *stride;
+ hsize_t *count;
+ hsize_t *block;
+
+ /* number of data points in buffer */
+ int n;
+ float *data;
+
+};
+
+
+/****************************************************************************
+ * Prototypes for functions local to this file. They are conditionally *
+ * included only when the HDF5 library is available. *
+ ****************************************************************************/
+
+/* for open/close HDF5 file */
+static void h5output_open(struct All_variables *, char *filename);
+static void h5output_close(struct All_variables *);
+
+static void h5output_const(struct All_variables *E);
+static void h5output_timedep(struct All_variables *E, int cycles);
+
+/* for creation of HDF5 objects (wrapped for compatibility with PyTables) */
+static hid_t h5create_file(const char *filename, unsigned flags, hid_t fcpl_id, hid_t fapl_id);
+static hid_t h5create_group(hid_t loc_id, const char *name, size_t size_hint);
+static herr_t h5create_dataset(hid_t loc_id, const char *name, const char *title, hid_t type_id, int rank, hsize_t *dims, hsize_t *maxdims, hsize_t *chunkdims);
+
+/* for creation of field and other dataset objects */
+static herr_t h5allocate_field(struct All_variables *E, enum field_class_t field_class, int nsd, hid_t dtype, field_t **field);
+static herr_t h5create_field(hid_t loc_id, field_t *field, const char *name, const char *title);
+static herr_t h5create_connectivity(hid_t loc_id, int nel);
+
+/* for writing to datasets */
+static herr_t h5write_dataset(hid_t dset_id, hid_t mem_type_id, const void *data, int rank, hsize_t *memdims, hsize_t *offset, hsize_t *stride, hsize_t *count, hsize_t *block, int collective, int dowrite);
+static herr_t h5write_field(hid_t dset_id, field_t *field, int collective, int dowrite);
+
+/* for releasing resources from field object */
+static herr_t h5close_field(field_t **field);
+
+/* for writing to HDF5 attributes */
+static herr_t find_attribute(hid_t loc_id, const char *attr_name);
+herr_t set_attribute_string(hid_t obj_id, const char *attr_name, const char *attr_data);
+herr_t set_attribute(hid_t obj_id, const char *attr_name, hid_t type_id, const void *data);
+herr_t set_attribute_float(hid_t obj_id, const char *attr_name, float x);
+herr_t set_attribute_double(hid_t obj_id, const char *attr_name, double x);
+herr_t set_attribute_int(hid_t obj_id, const char *attr_name, int n);
+herr_t set_attribute_long(hid_t obj_id, const char *attr_name, long n);
+herr_t set_attribute_llong(hid_t obj_id, const char *attr_name, long long n);
+herr_t set_attribute_array(hid_t obj_id, const char *attr_name, size_t rank, hsize_t *dims, hid_t type_id, const void *data);
+herr_t set_attribute_vector(hid_t obj_id, const char *attr_name, hsize_t dim, hid_t type_id, const void *data);
+herr_t set_attribute_int_vector(hid_t obj_id, const char *attr_name, hsize_t dim, const int *data);
+herr_t set_attribute_float_vector(hid_t obj_id, const char *attr_name, hsize_t dim, const float *data);
+herr_t set_attribute_double_vector(hid_t obj_id, const char *attr_name, hsize_t dim, const double *data);
+
+/* constant data (only for first cycle) */
+void h5output_meta(struct All_variables *);
+void h5output_coord(struct All_variables *);
+void h5output_surf_botm_coord(struct All_variables *);
+void h5output_have_coord(struct All_variables *);
+void h5output_material(struct All_variables *);
+void h5output_connectivity(struct All_variables *);
+
+/* time-varying data */
+void h5output_velocity(struct All_variables *, int);
+void h5output_temperature(struct All_variables *, int);
+void h5output_viscosity(struct All_variables *, int);
+void h5output_pressure(struct All_variables *, int);
+void h5output_stress(struct All_variables *, int);
+void h5output_tracer(struct All_variables *, int);
+void h5output_surf_botm(struct All_variables *, int);
+void h5output_geoid(struct All_variables *, int);
+void h5output_horiz_avg(struct All_variables *, int);
+void h5output_time(struct All_variables *, int);
+
+#endif
+
+extern void parallel_process_termination();
+extern void heat_flux(struct All_variables *);
+extern void get_STD_topo(struct All_variables *, float**, float**, float**, float**, int);
+extern void get_CBF_topo(struct All_variables *, float**, float**);
+extern void compute_geoid(struct All_variables *);
+
+
+/****************************************************************************
+ * Functions that allocate memory for HDF5 output *
+ ****************************************************************************/
+
+void h5output_allocate_memory(struct All_variables *E)
+{
+#ifdef USE_HDF5
+ /*
+ * Field variables
+ */
+
+ field_t *tensor3d;
+ field_t *vector3d;
+ field_t *vector2d;
+ field_t *scalar3d;
+ field_t *scalar2d;
+ field_t *scalar1d;
+
+ hid_t dtype; /* datatype for dataset creation */
+
+ int nprocx = E->parallel.nprocx;
+ int nprocy = E->parallel.nprocy;
+ int nprocz = E->parallel.nprocz;
+
+ /* Determine current cap and remember it */
+ E->hdf5.cap = (E->parallel.me) / (nprocx * nprocy * nprocz);
+
+ /********************************************************************
+ * Allocate field objects for use in dataset writes... *
+ ********************************************************************/
+
+ tensor3d = NULL;
+ vector3d = NULL;
+ vector2d = NULL;
+ scalar3d = NULL;
+ scalar2d = NULL;
+ scalar1d = NULL;
+
+ /* store solutions as floats in .h5 file */
+ dtype = H5T_NATIVE_FLOAT;
+ h5allocate_field(E, TENSOR_FIELD, 3, dtype, &tensor3d);
+ h5allocate_field(E, VECTOR_FIELD, 3, dtype, &vector3d);
+ h5allocate_field(E, VECTOR_FIELD, 2, dtype, &vector2d);
+ h5allocate_field(E, SCALAR_FIELD, 3, dtype, &scalar3d);
+ h5allocate_field(E, SCALAR_FIELD, 2, dtype, &scalar2d);
+ h5allocate_field(E, SCALAR_FIELD, 1, dtype, &scalar1d);
+
+ /* allocate buffer */
+ if (E->output.stress == 1)
+ E->hdf5.data = (float *)malloc((tensor3d->n) * sizeof(float));
+ else
+ E->hdf5.data = (float *)malloc((vector3d->n) * sizeof(float));
+
+ /* reuse buffer */
+ tensor3d->data = E->hdf5.data;
+ vector3d->data = E->hdf5.data;
+ vector2d->data = E->hdf5.data;
+ scalar3d->data = E->hdf5.data;
+ scalar2d->data = E->hdf5.data;
+ scalar1d->data = E->hdf5.data;
+
+ E->hdf5.tensor3d = tensor3d;
+ E->hdf5.vector3d = vector3d;
+ E->hdf5.vector2d = vector2d;
+ E->hdf5.scalar3d = scalar3d;
+ E->hdf5.scalar2d = scalar2d;
+ E->hdf5.scalar1d = scalar1d;
+
+#endif
+}
+
+
+
+/****************************************************************************
+ * Functions that control which data is saved to output file(s). *
+ * These represent possible choices for (E->output) function pointer. *
+ ****************************************************************************/
+
+void h5output(struct All_variables *E, int cycles)
+{
+#ifndef USE_HDF5
+ if(E->parallel.me == 0)
+ fprintf(stderr, "h5output(): CitcomS was compiled without HDF5!\n");
+ MPI_Finalize();
+ exit(8);
+#else
+ if (cycles == 0) {
+ h5output_const(E);
+ }
+ h5output_timedep(E, cycles);
+#endif
+}
+
+
+/****************************************************************************
+ * Function to read input parameters for legacy CitcomS *
+ ****************************************************************************/
+
+void h5input_params(struct All_variables *E)
+{
+#ifdef USE_HDF5
+
+ int m = E->parallel.me;
+
+ /* TODO: use non-optimized defaults to avoid unnecessary failures */
+
+ input_int("cb_block_size", &(E->output.cb_block_size), "1048576", m);
+ input_int("cb_buffer_size", &(E->output.cb_buffer_size), "4194304", m);
+
+ input_int("sieve_buf_size", &(E->output.sieve_buf_size), "1048576", m);
+
+ input_int("output_alignment", &(E->output.alignment), "262144", m);
+ input_int("output_alignment_threshold", &(E->output.alignment_threshold), "524288", m);
+
+ input_int("cache_mdc_nelmts", &(E->output.cache_mdc_nelmts), "10330", m);
+ input_int("cache_rdcc_nelmts", &(E->output.cache_rdcc_nelmts), "521", m);
+ input_int("cache_rdcc_nbytes", &(E->output.cache_rdcc_nbytes), "1048576", m);
+
+#endif
+}
+
+
+#ifdef USE_HDF5
+
+static void h5output_const(struct All_variables *E)
+{
+ char filename[100];
+
+ /* determine filename */
+ snprintf(filename, (size_t)100, "%s.h5", E->control.data_file);
+
+ h5output_open(E, filename);
+
+ h5output_meta(E);
+ h5output_coord(E);
+ h5output_connectivity(E);
+ /*h5output_material(E);*/
+
+ h5output_close(E);
+}
+
+static void h5output_timedep(struct All_variables *E, int cycles)
+{
+ char filename[100];
+
+ /* determine filename */
+ snprintf(filename, (size_t)100, "%s.%d.h5",
+ E->control.data_file, cycles);
+
+ h5output_open(E, filename);
+
+ h5output_time(E, cycles);
+ h5output_velocity(E, cycles);
+ h5output_temperature(E, cycles);
+ h5output_viscosity(E, cycles);
+
+ h5output_surf_botm(E, cycles);
+
+ /* output tracer location if using tracer */
+ if(E->control.tracer == 1)
+ h5output_tracer(E, cycles);
+
+ /* optional output below */
+ if(E->output.geoid == 1)
+ h5output_geoid(E, cycles);
+
+ if(E->output.stress == 1){
+ h5output_stress(E, cycles);
+ }
+ if(E->output.pressure == 1)
+ h5output_pressure(E, cycles);
+
+ if (E->output.horiz_avg == 1)
+ h5output_horiz_avg(E, cycles);
+
+ h5output_close(E);
+
+}
+
+
+/****************************************************************************
+ * Functions to initialize and finalize access to HDF5 output file. *
+ * Responsible for creating all necessary groups, attributes, and arrays. *
+ ****************************************************************************/
+
+/* This function should open the HDF5 file
+ */
+static void h5output_open(struct All_variables *E, char *filename)
+{
+ /*
+ * MPI variables
+ */
+
+ MPI_Comm comm = E->parallel.world;
+ MPI_Info info = MPI_INFO_NULL;
+ int ierr;
+ char tmp[100];
+
+ /*
+ * HDF5 variables
+ */
+
+ hid_t file_id; /* HDF5 file identifier */
+ hid_t fcpl_id; /* file creation property list identifier */
+ hid_t fapl_id; /* file access property list identifier */
+ herr_t status;
+
+
+ /********************************************************************
+ * Create HDF5 file using parallel I/O *
+ ********************************************************************/
+
+ /* TODO: figure out if it's possible give HDF5 a size hint when
+ * creating the file
+ */
+
+ /* set up file creation property list with defaults */
+ fcpl_id = H5P_DEFAULT;
+
+ /* create an MPI_Info object to pass some tuning parameters
+ * to the underlying MPI_File_open call
+ */
+ ierr = MPI_Info_create(&info);
+ ierr = MPI_Info_set(info, "access_style", "write_once");
+ ierr = MPI_Info_set(info, "collective_buffering", "true");
+ snprintf(tmp, (size_t)100, "%d", E->output.cb_block_size);
+ ierr = MPI_Info_set(info, "cb_block_size", tmp);
+ snprintf(tmp, (size_t)100, "%d", E->output.cb_buffer_size);
+ ierr = MPI_Info_set(info, "cb_buffer_size", tmp);
+
+ /* set up file access property list with parallel I/O access */
+ fapl_id = H5Pcreate(H5P_FILE_ACCESS);
+
+ status = H5Pset_sieve_buf_size(fapl_id, (size_t)(E->output.sieve_buf_size));
+ status = H5Pset_alignment(fapl_id, (hsize_t)(E->output.alignment_threshold),
+ (hsize_t)(E->output.alignment));
+ status = H5Pset_cache(fapl_id, E->output.cache_mdc_nelmts,
+ (size_t)(E->output.cache_rdcc_nelmts),
+ (size_t)(E->output.cache_rdcc_nbytes),
+ 1.0);
+
+ /* tell HDF5 to use MPI-IO */
+ status = H5Pset_fapl_mpio(fapl_id, comm, info);
+
+ /* close mpi info object */
+ ierr = MPI_Info_free(&(info));
+
+ /* create a new file collectively and release property list identifier */
+ file_id = h5create_file(filename, H5F_ACC_TRUNC, fcpl_id, fapl_id);
+ status = H5Pclose(fapl_id);
+
+ /* save the file identifier for later use */
+ E->hdf5.file_id = file_id;
+
+}
+
+
+/* Finalizing access to HDF5 objects.
+ */
+static void h5output_close(struct All_variables *E)
+{
+ herr_t status;
+
+ /* close file */
+ status = H5Fclose(E->hdf5.file_id);
+}
+
+
+/****************************************************************************
+ * The following functions are used to save specific physical quantities *
+ * from CitcomS into HDF5 arrays. *
+ ****************************************************************************/
+
+
+/****************************************************************************
+ * 3D Fields *
+ ****************************************************************************/
+
+void h5output_coord(struct All_variables *E)
+{
+ hid_t dataset;
+ herr_t status;
+ field_t *field;
+
+ int i, j, k;
+ int n, nx, ny, nz;
+ int m, mx, my, mz;
+
+ field = E->hdf5.vector3d;
+
+ nx = E->lmesh.nox;
+ ny = E->lmesh.noy;
+ nz = E->lmesh.noz;
+
+ mx = field->block[1];
+ my = field->block[2];
+ mz = field->block[3];
+
+ /* prepare the data -- change citcom yxz order to xyz order */
+ for(i = 0; i < mx; i++)
+ {
+ for(j = 0; j < my; j++)
+ {
+ for(k = 0; k < mz; k++)
+ {
+ n = k + i*nz + j*nz*nx;
+ m = k + j*mz + i*mz*my;
+ field->data[3*m+0] = E->sx[1][1][n+1];
+ field->data[3*m+1] = E->sx[1][2][n+1];
+ field->data[3*m+2] = E->sx[1][3][n+1];
+ }
+ }
+ }
+
+ h5create_field(E->hdf5.file_id, field, "coord", "coordinates of nodes");
+
+ /* write to dataset */
+ dataset = H5Dopen(E->hdf5.file_id, "/coord");
+ status = h5write_field(dataset, field, 1, 1);
+
+ /* release resources */
+ status = H5Dclose(dataset);
+}
+
+void h5output_velocity(struct All_variables *E, int cycles)
+{
+ hid_t dataset;
+ herr_t status;
+ field_t *field;
+
+ int i, j, k;
+ int n, nx, ny, nz;
+ int m, mx, my, mz;
+
+ field = E->hdf5.vector3d;
+
+ nx = E->lmesh.nox;
+ ny = E->lmesh.noy;
+ nz = E->lmesh.noz;
+
+ mx = field->block[1];
+ my = field->block[2];
+ mz = field->block[3];
+
+ /* prepare the data -- change citcom yxz order to xyz order */
+ for(i = 0; i < mx; i++)
+ {
+ for(j = 0; j < my; j++)
+ {
+ for(k = 0; k < mz; k++)
+ {
+ n = k + i*nz + j*nz*nx;
+ m = k + j*mz + i*mz*my;
+ field->data[3*m+0] = E->sphere.cap[1].V[1][n+1];
+ field->data[3*m+1] = E->sphere.cap[1].V[2][n+1];
+ field->data[3*m+2] = E->sphere.cap[1].V[3][n+1];
+ }
+ }
+ }
+
+ h5create_field(E->hdf5.file_id, field, "velocity", "velocity values on nodes");
+
+ /* write to dataset */
+ dataset = H5Dopen(E->hdf5.file_id, "/velocity");
+ status = h5write_field(dataset, field, 1, 1);
+
+ /* release resources */
+ status = H5Dclose(dataset);
+}
+
+void h5output_temperature(struct All_variables *E, int cycles)
+{
+ hid_t dataset;
+ herr_t status;
+ field_t *field;
+
+ int i, j, k;
+ int n, nx, ny, nz;
+ int m, mx, my, mz;
+
+ field = E->hdf5.scalar3d;
+
+ nx = E->lmesh.nox;
+ ny = E->lmesh.noy;
+ nz = E->lmesh.noz;
+
+ mx = field->block[1];
+ my = field->block[2];
+ mz = field->block[3];
+
+ /* prepare the data -- change citcom yxz order to xyz order */
+ for(i = 0; i < mx; i++)
+ {
+ for(j = 0; j < my; j++)
+ {
+ for(k = 0; k < mz; k++)
+ {
+ n = k + i*nz + j*nz*nx;
+ m = k + j*mz + i*mz*my;
+ field->data[m] = E->T[1][n+1];
+ }
+ }
+ }
+
+ h5create_field(E->hdf5.file_id, field, "temperature", "temperature values on nodes");
+ /* write to dataset */
+ dataset = H5Dopen(E->hdf5.file_id, "/temperature");
+ status = h5write_field(dataset, field, 1, 1);
+
+ /* release resources */
+ status = H5Dclose(dataset);
+}
+
+void h5output_viscosity(struct All_variables *E, int cycles)
+{
+ hid_t dataset;
+ herr_t status;
+ field_t *field;
+
+ int lev;
+ int i, j, k;
+ int n, nx, ny, nz;
+ int m, mx, my, mz;
+
+ field = E->hdf5.scalar3d;
+
+ lev = E->mesh.levmax;
+
+ nx = E->lmesh.nox;
+ ny = E->lmesh.noy;
+ nz = E->lmesh.noz;
+
+ mx = field->block[1];
+ my = field->block[2];
+ mz = field->block[3];
+
+ /* prepare the data -- change citcom yxz order to xyz order */
+ for(i = 0; i < mx; i++)
+ {
+ for(j = 0; j < my; j++)
+ {
+ for(k = 0; k < mz; k++)
+ {
+ n = k + i*nz + j*nz*nx;
+ m = k + j*mz + i*mz*my;
+ field->data[m] = E->VI[lev][1][n+1];
+ }
+ }
+ }
+
+ h5create_field(E->hdf5.file_id, field, "viscosity", "viscosity values on nodes");
+ /* write to dataset */
+ dataset = H5Dopen(E->hdf5.file_id, "/viscosity");
+ status = h5write_field(dataset, field, 1, 1);
+
+ /* release resources */
+ status = H5Dclose(dataset);
+}
+
+void h5output_pressure(struct All_variables *E, int cycles)
+{
+ hid_t dataset;
+ herr_t status;
+ field_t *field;
+
+ int i, j, k;
+ int n, nx, ny, nz;
+ int m, mx, my, mz;
+
+ field = E->hdf5.scalar3d;
+
+ nx = E->lmesh.nox;
+ ny = E->lmesh.noy;
+ nz = E->lmesh.noz;
+
+ mx = field->block[1];
+ my = field->block[2];
+ mz = field->block[3];
+
+ /* prepare the data -- change citcom yxz order to xyz order */
+ for(i = 0; i < mx; i++)
+ {
+ for(j = 0; j < my; j++)
+ {
+ for(k = 0; k < mz; k++)
+ {
+ n = k + i*nz + j*nz*nx;
+ m = k + j*mz + i*mz*my;
+ field->data[m] = E->NP[1][n+1];
+ }
+ }
+ }
+
+ /* Create /pressure dataset */
+ h5create_field(E->hdf5.file_id, field, "pressure", "pressure values on nodes");
+
+ /* write to dataset */
+ dataset = H5Dopen(E->hdf5.file_id, "/pressure");
+ status = h5write_field(dataset, field, 1, 1);
+
+ /* release resources */
+ status = H5Dclose(dataset);
+}
+
+void h5output_stress(struct All_variables *E, int cycles)
+{
+ hid_t dataset;
+ herr_t status;
+ field_t *field;
+
+ int i, j, k;
+ int n, nx, ny, nz;
+ int m, mx, my, mz;
+ /* for stress computation */
+ void allocate_STD_mem();
+ void compute_nodal_stress();
+ void free_STD_mem();
+ float *SXX[NCS],*SYY[NCS],*SXY[NCS],*SXZ[NCS],*SZY[NCS],*SZZ[NCS];
+ float *divv[NCS],*vorv[NCS];
+ /* */
+
+ if(E->control.use_cbf_topo) {/* for CBF topo, stress will not have been computed */
+ allocate_STD_mem(E, SXX, SYY, SZZ, SXY, SXZ, SZY, divv, vorv);
+ compute_nodal_stress(E, SXX, SYY, SZZ, SXY, SXZ, SZY, divv, vorv);
+ free_STD_mem(E, SXX, SYY, SZZ, SXY, SXZ, SZY, divv, vorv);
+ }
+
+ field = E->hdf5.tensor3d;
+
+ nx = E->lmesh.nox;
+ ny = E->lmesh.noy;
+ nz = E->lmesh.noz;
+
+ mx = field->block[1];
+ my = field->block[2];
+ mz = field->block[3];
+
+ /* prepare the data -- change citcom yxz order to xyz order */
+ for(i = 0; i < mx; i++)
+ {
+ for(j = 0; j < my; j++)
+ {
+ for(k = 0; k < mz; k++)
+ {
+ n = k + i*nz + j*nz*nx;
+ m = k + j*mz + i*mz*my;
+ field->data[6*m+0] = E->gstress[1][6*n+1];
+ field->data[6*m+1] = E->gstress[1][6*n+2];
+ field->data[6*m+2] = E->gstress[1][6*n+3];
+ field->data[6*m+3] = E->gstress[1][6*n+4];
+ field->data[6*m+4] = E->gstress[1][6*n+5];
+ field->data[6*m+5] = E->gstress[1][6*n+6];
+ }
+ }
+ }
+
+ /* Create /stress dataset */
+ h5create_field(E->hdf5.file_id, field, "stress", "stress values on nodes");
+
+ /* write to dataset */
+ dataset = H5Dopen(E->hdf5.file_id, "/stress");
+ status = h5write_field(dataset, field, 1, 1);
+
+ /* release resources */
+ status = H5Dclose(dataset);
+}
+
+void h5output_material(struct All_variables *E)
+{
+}
+
+void h5output_tracer(struct All_variables *E, int cycles)
+{
+}
+
+/****************************************************************************
+ * 2D Fields *
+ ****************************************************************************/
+
+void h5output_surf_botm_coord(struct All_variables *E)
+{
+ hid_t dataset;
+ herr_t status;
+ field_t *field;
+
+ int i, j, k;
+ int n, nx, ny, nz;
+ int m, mx, my;
+
+ int pz = E->parallel.me_loc[3];
+ int nprocz = E->parallel.nprocz;
+
+ field = E->hdf5.vector2d;
+
+ nx = E->lmesh.nox;
+ ny = E->lmesh.noy;
+ nz = E->lmesh.noz;
+
+ mx = field->block[1];
+ my = field->block[2];
+
+ if (E->output.surf == 1)
+ {
+ k = nz-1;
+ for(i = 0; i < mx; i++)
+ {
+ for(j = 0; j < my; j++)
+ {
+ n = k + i*nz + j*nz*nx;
+ m = j + i*my;
+ field->data[2*m+0] = E->sx[1][1][n+1];
+ field->data[2*m+1] = E->sx[1][2][n+1];
+ }
+ }
+ dataset = H5Dopen(E->hdf5.file_id, "/surf/coord");
+ status = h5write_field(dataset, field, 0, (pz == nprocz-1));
+ status = H5Dclose(dataset);
+ }
+
+ if (E->output.botm == 1)
+ {
+ k = 0;
+ for(i = 0; i < mx; i++)
+ {
+ for(j = 0; j < my; j++)
+ {
+ n = k + i*nz + j*nz*nx;
+ m = j + i*my;
+ field->data[2*m+0] = E->sx[1][1][n+1];
+ field->data[2*m+1] = E->sx[1][2][n+1];
+ }
+ }
+ dataset = H5Dopen(E->hdf5.file_id, "/botm/coord");
+ status = h5write_field(dataset, field, 0, (pz == 0));
+ status = H5Dclose(dataset);
+ }
+}
+
+void h5output_surf_botm(struct All_variables *E, int cycles)
+{
+ hid_t file_id;
+ hid_t surf_group; /* group identifier for top cap surface */
+ hid_t botm_group; /* group identifier for bottom cap surface */
+ hid_t dataset;
+ herr_t status;
+ field_t *scalar;
+ field_t *vector;
+
+ float *topo;
+
+ int i, j, k;
+ int n, nx, ny, nz;
+ int m, mx, my;
+
+ int pz = E->parallel.me_loc[3];
+ int nprocz = E->parallel.nprocz;
+
+ file_id = E->hdf5.file_id;
+
+ scalar = E->hdf5.scalar2d;
+ vector = E->hdf5.vector2d;
+
+ nx = E->lmesh.nox;
+ ny = E->lmesh.noy;
+ nz = E->lmesh.noz;
+
+ mx = scalar->block[1];
+ my = scalar->block[2];
+
+ if((E->output.write_q_files == 0) || (cycles == 0) ||
+ (cycles % E->output.write_q_files)!=0)
+ heat_flux(E);
+ /* else, the heat flux will have been computed already */
+
+
+
+ if(E->control.use_cbf_topo){
+ get_CBF_topo(E, E->slice.tpg, E->slice.tpgb);
+ }else{
+ get_STD_topo(E, E->slice.tpg, E->slice.tpgb, E->slice.divg, E->slice.vort, cycles);
+ }
+
+ /********************************************************************
+ * Top surface *
+ ********************************************************************/
+ if (E->output.surf == 1)
+ {
+ /* Create /surf/ group*/
+ surf_group = h5create_group(file_id, "surf", (size_t)0);
+ h5create_field(surf_group, E->hdf5.vector2d, "velocity",
+ "top surface velocity");
+ h5create_field(surf_group, E->hdf5.scalar2d, "heatflux",
+ "top surface heatflux");
+ h5create_field(surf_group, E->hdf5.scalar2d, "topography",
+ "top surface topography");
+ status = H5Gclose(surf_group);
+
+ /* radial index */
+ k = nz-1;
+
+ /* velocity data */
+ for(i = 0; i < mx; i++)
+ {
+ for(j = 0; j < my; j++)
+ {
+ n = k + i*nz + j*nz*nx;
+ m = j + i*my;
+ vector->data[2*m+0] = E->sphere.cap[1].V[1][n+1];
+ vector->data[2*m+1] = E->sphere.cap[1].V[2][n+1];
+ }
+ }
+ dataset = H5Dopen(file_id, "/surf/velocity");
+ status = h5write_field(dataset, vector, 0, (pz == nprocz-1));
+ status = H5Dclose(dataset);
+
+ /* heatflux data */
+ for(i = 0; i < mx; i++)
+ {
+ for(j = 0; j < my; j++)
+ {
+ n = k + i*nz + j*nz*nx;
+ m = j + i*my;
+ scalar->data[m] = E->slice.shflux[1][n+1];
+ }
+ }
+
+ dataset = H5Dopen(file_id, "/surf/heatflux");
+ status = h5write_field(dataset, scalar, 0, (pz == nprocz-1));
+ status = H5Dclose(dataset);
+
+ /* choose either STD topo or pseudo-free-surf topo */
+ if (E->control.pseudo_free_surf)
+ topo = E->slice.freesurf[1];
+ else
+ topo = E->slice.tpg[1];
+
+ /* topography data */
+ for(i = 0; i < mx; i++)
+ {
+ for(j = 0; j < my; j++)
+ {
+ n = k + i*nz + j*nz*nx;
+ m = j + i*my;
+ scalar->data[m] = topo[i];
+ }
+ }
+ dataset = H5Dopen(file_id, "/surf/topography");
+ status = h5write_field(dataset, scalar, 0, (pz == nprocz-1));
+ status = H5Dclose(dataset);
+ }
+
+
+ /********************************************************************
+ * Bottom surface *
+ ********************************************************************/
+ if (E->output.botm == 1)
+ {
+ /* Create /botm/ group */
+ botm_group = h5create_group(file_id, "botm", (size_t)0);
+ h5create_field(botm_group, E->hdf5.vector2d, "velocity",
+ "bottom surface velocity");
+ h5create_field(botm_group, E->hdf5.scalar2d, "heatflux",
+ "bottom surface heatflux");
+ h5create_field(botm_group, E->hdf5.scalar2d, "topography",
+ "bottom surface topography");
+ status = H5Gclose(botm_group);
+
+ /* radial index */
+ k = 0;
+
+ /* velocity data */
+ for(i = 0; i < mx; i++)
+ {
+ for(j = 0; j < my; j++)
+ {
+ n = k + i*nz + j*nz*nx;
+ m = j + i*my;
+ vector->data[2*m+0] = E->sphere.cap[1].V[1][n+1];
+ vector->data[2*m+1] = E->sphere.cap[1].V[2][n+1];
+ }
+ }
+ dataset = H5Dopen(file_id, "/botm/velocity");
+ status = h5write_field(dataset, vector, 0, (pz == 0));
+ status = H5Dclose(dataset);
+
+ /* heatflux data */
+ for(i = 0; i < mx; i++)
+ {
+ for(j = 0; j < my; j++)
+ {
+ n = k + i*nz + j*nz*nx;
+ m = j + i*my;
+ scalar->data[m] = E->slice.bhflux[1][n+1];
+ }
+ }
+ dataset = H5Dopen(file_id, "/botm/heatflux");
+ status = h5write_field(dataset, scalar, 0, (pz == 0));
+ status = H5Dclose(dataset);
+
+ /* topography data */
+ topo = E->slice.tpg[1];
+ for(i = 0; i < mx; i++)
+ {
+ for(j = 0; j < my; j++)
+ {
+ n = k + i*nz + j*nz*nx;
+ m = j + i*my;
+ scalar->data[m] = topo[i];
+ }
+ }
+ dataset = H5Dopen(file_id, "/botm/topography");
+ status = h5write_field(dataset, scalar, 0, (pz == 0));
+ status = H5Dclose(dataset);
+ }
+}
+
+
+/****************************************************************************
+ * 1D Fields *
+ ****************************************************************************/
+
+void h5output_have_coord(struct All_variables *E)
+{
+ hid_t file_id;
+ hid_t dataset;
+ herr_t status;
+
+ field_t *field;
+
+ int k;
+ int mz;
+
+ int px = E->parallel.me_loc[1];
+ int py = E->parallel.me_loc[2];
+
+ field = E->hdf5.scalar1d;
+
+ mz = field->block[1];
+
+ if (E->output.horiz_avg == 1)
+ {
+ for(k = 0; k < mz; k++)
+ field->data[k] = E->sx[1][3][k+1];
+ dataset = H5Dopen(E->hdf5.file_id, "/horiz_avg/coord");
+ status = h5write_field(dataset, field, 0, (px == 0 && py == 0));
+ status = H5Dclose(dataset);
+ }
+
+}
+
+void h5output_horiz_avg(struct All_variables *E, int cycles)
+{
+ /* horizontal average output of temperature and rms velocity */
+ void compute_horiz_avg();
+
+ hid_t file_id;
+ hid_t avg_group; /* group identifier for horizontal averages */
+ hid_t dataset;
+ herr_t status;
+
+ field_t *field;
+
+ int k;
+ int mz;
+
+ int px = E->parallel.me_loc[1];
+ int py = E->parallel.me_loc[2];
+
+
+ file_id = E->hdf5.file_id;
+
+ field = E->hdf5.scalar1d;
+
+ mz = field->block[1];
+
+ /* calculate horizontal averages */
+ compute_horiz_avg(E);
+
+ /* Create /horiz_avg/ group */
+ avg_group = h5create_group(file_id, "horiz_avg", (size_t)0);
+ h5create_field(avg_group, E->hdf5.scalar1d, "temperature",
+ "horizontal temperature average");
+ h5create_field(avg_group, E->hdf5.scalar1d, "velocity_xy",
+ "horizontal Vxy average (rms)");
+ h5create_field(avg_group, E->hdf5.scalar1d, "velocity_z",
+ "horizontal Vz average (rms)");
+ status = H5Gclose(avg_group);
+
+ /*
+ * note that only the first nprocz processes need to output
+ */
+
+ /* temperature horizontal average */
+ for(k = 0; k < mz; k++)
+ field->data[k] = E->Have.T[k+1];
+ dataset = H5Dopen(file_id, "/horiz_avg/temperature");
+ status = h5write_field(dataset, field, 0, (px == 0 && py == 0));
+ status = H5Dclose(dataset);
+
+ /* Vxy horizontal average (rms) */
+ for(k = 0; k < mz; k++)
+ field->data[k] = E->Have.V[1][k+1];
+ dataset = H5Dopen(file_id, "/horiz_avg/velocity_xy");
+ status = h5write_field(dataset, field, 0, (px == 0 && py == 0));
+ status = H5Dclose(dataset);
+
+ /* Vz horizontal average (rms) */
+ for(k = 0; k < mz; k++)
+ field->data[k] = E->Have.V[2][k+1];
+ dataset = H5Dopen(file_id, "/horiz_avg/velocity_z");
+ status = h5write_field(dataset, field, 0, (px == 0 && py == 0));
+ status = H5Dclose(dataset);
+}
+
+/****************************************************************************
+ * Spherical harmonics coefficients *
+ ****************************************************************************/
+void h5output_geoid(struct All_variables *E, int cycles)
+{
+ struct HDF5_GEOID
+ {
+ int ll;
+ int mm;
+ float total_sin;
+ float total_cos;
+ float tpgt_sin;
+ float tpgt_cos;
+ float bncy_sin;
+ float bncy_cos;
+ } *row;
+
+
+ hid_t dataset; /* dataset identifier */
+ hid_t datatype; /* row datatype identifier */
+ hid_t dataspace; /* memory dataspace */
+ hid_t dxpl_id; /* data transfer property list identifier */
+
+ herr_t status;
+
+ hsize_t rank = 1;
+ hsize_t dim = E->sphere.hindice;
+ int i, ll, mm;
+
+ /* Create the memory data type */
+ datatype = H5Tcreate(H5T_COMPOUND, sizeof(struct HDF5_GEOID));
+ status = H5Tinsert(datatype, "degree", HOFFSET(struct HDF5_GEOID, ll),
+ H5T_NATIVE_INT);
+ status = H5Tinsert(datatype, "order", HOFFSET(struct HDF5_GEOID, mm),
+ H5T_NATIVE_INT);
+ status = H5Tinsert(datatype, "total_sin",
+ HOFFSET(struct HDF5_GEOID, total_sin),
+ H5T_NATIVE_FLOAT);
+ status = H5Tinsert(datatype, "total_cos",
+ HOFFSET(struct HDF5_GEOID, total_cos),
+ H5T_NATIVE_FLOAT);
+ status = H5Tinsert(datatype, "tpgt_sin",
+ HOFFSET(struct HDF5_GEOID, tpgt_sin),
+ H5T_NATIVE_FLOAT);
+ status = H5Tinsert(datatype, "tpgt_cos",
+ HOFFSET(struct HDF5_GEOID, tpgt_cos),
+ H5T_NATIVE_FLOAT);
+ status = H5Tinsert(datatype, "bncy_sin",
+ HOFFSET(struct HDF5_GEOID, bncy_sin),
+ H5T_NATIVE_FLOAT);
+ status = H5Tinsert(datatype, "bncy_cos",
+ HOFFSET(struct HDF5_GEOID, bncy_cos),
+ H5T_NATIVE_FLOAT);
+
+ /* Create the dataspace */
+ dataspace = H5Screate_simple(rank, &dim, NULL);
+
+ /* Create the dataset */
+ dataset = H5Dcreate(E->hdf5.file_id, "geoid", datatype,
+ dataspace, H5P_DEFAULT);
+
+ /*
+ * Write necessary attributes for PyTables compatibility
+ */
+
+ set_attribute_string(dataset, "TITLE", "Geoid table");
+ set_attribute_string(dataset, "CLASS", "TABLE");
+ set_attribute_string(dataset, "FLAVOR", "numpy");
+ set_attribute_string(dataset, "VERSION", "2.6");
+
+ set_attribute_llong(dataset, "NROWS", dim);
+
+ set_attribute_string(dataset, "FIELD_0_NAME", "degree");
+ set_attribute_string(dataset, "FIELD_1_NAME", "order");
+ set_attribute_string(dataset, "FIELD_2_NAME", "total_sin");
+ set_attribute_string(dataset, "FIELD_3_NAME", "total_cos");
+ set_attribute_string(dataset, "FIELD_4_NAME", "tpgt_sin");
+ set_attribute_string(dataset, "FIELD_5_NAME", "tpgt_cos");
+ set_attribute_string(dataset, "FIELD_6_NAME", "bncy_sin");
+ set_attribute_string(dataset, "FIELD_7_NAME", "bncy_cos");
+
+ set_attribute_double(dataset, "FIELD_0_FILL", 0);
+ set_attribute_double(dataset, "FIELD_1_FILL", 0);
+ set_attribute_double(dataset, "FIELD_2_FILL", 0);
+ set_attribute_double(dataset, "FIELD_3_FILL", 0);
+ set_attribute_double(dataset, "FIELD_4_FILL", 0);
+ set_attribute_double(dataset, "FIELD_5_FILL", 0);
+ set_attribute_double(dataset, "FIELD_6_FILL", 0);
+ set_attribute_double(dataset, "FIELD_7_FILL", 0);
+
+ /* Create property list for independent dataset write */
+ dxpl_id = H5Pcreate(H5P_DATASET_XFER);
+ status = H5Pset_dxpl_mpio(dxpl_id, H5FD_MPIO_INDEPENDENT);
+
+ compute_geoid(E);
+
+ if (E->parallel.me == 0) {
+ /* Prepare data */
+ row = (struct HDF5_GEOID *) malloc((E->sphere.hindice)
+ * sizeof(struct HDF5_GEOID));
+ i = 0;
+ for(ll = 0; ll <= E->output.llmax; ll++)
+ for(mm = 0; mm <= ll; mm++) {
+ row[i].ll = ll;
+ row[i].mm = mm;
+ row[i].total_sin = E->sphere.harm_geoid[0][i];
+ row[i].total_cos = E->sphere.harm_geoid[1][i];
+ row[i].tpgt_sin = E->sphere.harm_geoid_from_tpgt[0][i];
+ row[i].tpgt_cos = E->sphere.harm_geoid_from_tpgt[1][i];
+ row[i].bncy_sin = E->sphere.harm_geoid_from_bncy[0][i];
+ row[i].bncy_cos = E->sphere.harm_geoid_from_bncy[1][i];
+ i ++;
+ }
+
+ /* write data */
+ status = H5Dwrite(dataset, datatype, dataspace, H5S_ALL,
+ dxpl_id, row);
+
+ free(row);
+ }
+
+ /* Release resources */
+ status = H5Pclose(dxpl_id);
+ status = H5Sclose(dataspace);
+ status = H5Tclose(datatype);
+ status = H5Dclose(dataset);
+}
+
+
+
+
+/****************************************************************************
+ * Create and output /connectivity dataset *
+ ****************************************************************************/
+
+static herr_t h5create_connectivity(hid_t loc_id, int nel)
+{
+ hid_t dataset;
+ hid_t dataspace;
+ herr_t status;
+
+ hsize_t dims[2];
+
+ dims[0] = nel;
+ dims[1] = 8;
+
+ /* Create the dataspace */
+ dataspace = H5Screate_simple(2, dims, NULL);
+
+ /* Create the dataset */
+ dataset = H5Dcreate(loc_id, "connectivity", H5T_NATIVE_INT, dataspace, H5P_DEFAULT);
+
+ /* Write necessary attributes for PyTables compatibility */
+ set_attribute_string(dataset, "TITLE", "Node connectivity");
+ set_attribute_string(dataset, "CLASS", "ARRAY");
+ set_attribute_string(dataset, "FLAVOR", "numpy");
+ set_attribute_string(dataset, "VERSION", "2.3");
+
+ status = H5Sclose(dataspace);
+ status = H5Dclose(dataset);
+ return 0;
+}
+
+void h5output_connectivity(struct All_variables *E)
+{
+ hid_t dataset;
+ herr_t status;
+
+ int rank = 2;
+ hsize_t memdims[2];
+ hsize_t offset[2];
+ hsize_t stride[2];
+ hsize_t count[2];
+ hsize_t block[2];
+
+ int p;
+ int px = E->parallel.me_loc[1];
+ int py = E->parallel.me_loc[2];
+ int pz = E->parallel.me_loc[3];
+ int nprocx = E->parallel.nprocx;
+ int nprocy = E->parallel.nprocy;
+ int nprocz = E->parallel.nprocz;
+ int procs_per_cap = nprocx * nprocy * nprocz;
+
+ int e;
+ int nel = E->lmesh.nel;
+ int *ien;
+
+ int *data;
+
+ if (E->output.connectivity == 1)
+ {
+ /* process id (local to cap) */
+ p = pz + px*nprocz + py*nprocz*nprocx;
+
+ rank = 2;
+
+ memdims[0] = nel;
+ memdims[1] = 8;
+
+ offset[0] = nel * p;
+ offset[1] = 0;
+
+ stride[0] = 1;
+ stride[1] = 1;
+
+ count[0] = 1;
+ count[1] = 1;
+
+ block[0] = nel;
+ block[1] = 8;
+
+ data = (int *)malloc((nel*8) * sizeof(int));
+
+ for(e = 0; e < nel; e++)
+ {
+ ien = E->ien[1][e+1].node;
+ data[8*e+0] = ien[1]-1; /* TODO: subtract one? */
+ data[8*e+1] = ien[2]-1;
+ data[8*e+2] = ien[3]-1;
+ data[8*e+3] = ien[4]-1;
+ data[8*e+4] = ien[5]-1;
+ data[8*e+5] = ien[6]-1;
+ data[8*e+6] = ien[7]-1;
+ data[8*e+7] = ien[8]-1;
+ }
+
+ /* Create /connectivity dataset */
+ h5create_connectivity(E->hdf5.file_id, E->lmesh.nel * procs_per_cap);
+
+ dataset = H5Dopen(E->hdf5.file_id, "/connectivity");
+
+ status = h5write_dataset(dataset, H5T_NATIVE_INT, data, rank, memdims,
+ offset, stride, count, block,
+ 0, (E->hdf5.cap == 0));
+
+ status = H5Dclose(dataset);
+
+ free(data);
+ }
+}
+
+
+/****************************************************************************
+ * Create and output /time and /timstep attributes *
+ ****************************************************************************/
+
+
+void h5output_time(struct All_variables *E, int cycles)
+{
+ hid_t root;
+ herr_t status;
+
+ root = H5Gopen(E->hdf5.file_id, "/");
+ status = set_attribute_float(root, "time", E->monitor.elapsed_time);
+ status = set_attribute_float(root, "timestep", cycles);
+ status = H5Gclose(root);
+}
+
+
+/****************************************************************************
+ * Save most CitcomS input parameters, and other information, as *
+ * attributes in a group called /input *
+ ****************************************************************************/
+
+void h5output_meta(struct All_variables *E)
+{
+ hid_t input;
+ herr_t status;
+
+ int n;
+ int rank;
+ hsize_t *dims;
+ double *data;
+ float tmp;
+
+ input = h5create_group(E->hdf5.file_id, "input", (size_t)0);
+
+ status = set_attribute_int(input, "PID", E->control.PID);
+
+ /*
+ * Advection_diffusion.inventory
+ */
+
+ status = set_attribute_int(input, "ADV", E->advection.ADVECTION);
+ status = set_attribute_int(input, "filter_temp", E->advection.filter_temperature);
+
+ status = set_attribute_float(input, "finetunedt", E->advection.fine_tune_dt);
+ status = set_attribute_float(input, "fixed_timestep", E->advection.fixed_timestep);
+ status = set_attribute_float(input, "inputdiffusivity", E->control.inputdiff);
+
+ status = set_attribute_int(input, "adv_sub_iterations", E->advection.temp_iterations);
+
+
+ /*
+ * BC.inventory
+ */
+
+ status = set_attribute_int(input, "side_sbcs", E->control.side_sbcs);
+ status = set_attribute_int(input, "pseudo_free_surf", E->control.pseudo_free_surf);
+
+ status = set_attribute_int(input, "topvbc", E->mesh.topvbc);
+ status = set_attribute_float(input, "topvbxval", E->control.VBXtopval);
+ status = set_attribute_float(input, "topvbyval", E->control.VBYtopval);
+
+
+ status = set_attribute_int(input, "botvbc", E->mesh.botvbc);
+ status = set_attribute_float(input, "botvbxval", E->control.VBXbotval);
+ status = set_attribute_float(input, "botvbyval", E->control.VBYbotval);
+
+ status = set_attribute_int(input, "toptbc", E->mesh.toptbc);
+ status = set_attribute_float(input, "toptbcval", E->control.TBCtopval);
+
+ status = set_attribute_int(input, "bottbc", E->mesh.bottbc);
+ status = set_attribute_float(input, "bottbcval", E->control.TBCbotval);
+
+ status = set_attribute_int(input, "temperature_bound_adj", E->control.temperature_bound_adj);
+ status = set_attribute_float(input, "depth_bound_adj", E->control.depth_bound_adj);
+ status = set_attribute_float(input, "width_bound_adj", E->control.width_bound_adj);
+
+ /*
+ * Const.inventory
+ */
+
+ status = set_attribute_float(input, "density", E->data.density);
+ status = set_attribute_float(input, "thermdiff", E->data.therm_diff);
+ status = set_attribute_float(input, "gravacc", E->data.grav_acc);
+ status = set_attribute_float(input, "thermexp", E->data.therm_exp);
+ status = set_attribute_float(input, "refvisc", E->data.ref_viscosity);
+ status = set_attribute_float(input, "cp", E->data.Cp);
+ status = set_attribute_float(input, "density_above", E->data.density_above);
+ status = set_attribute_float(input, "density_below", E->data.density_below);
+
+ status = set_attribute_float(input, "z_lith", E->viscosity.zlith);
+ status = set_attribute_float(input, "z_410", E->viscosity.z410);
+ status = set_attribute_float(input, "z_lmantle", E->viscosity.zlm);
+ status = set_attribute_float(input, "z_cmb", E->viscosity.zcmb);
+
+ status = set_attribute_float(input, "radius_km", E->data.radius_km);
+ status = set_attribute_float(input, "scalev", E->data.scalev);
+ status = set_attribute_float(input, "scalet", E->data.scalet);
+
+ /*
+ * IC.inventory
+ */
+
+ status = set_attribute_int(input, "restart", E->control.restart);
+ status = set_attribute_int(input, "post_p", E->control.post_p);
+ status = set_attribute_int(input, "solution_cycles_init", E->monitor.solution_cycles_init);
+ status = set_attribute_int(input, "zero_elapsed_time", E->control.zero_elapsed_time);
+
+ status = set_attribute_int(input, "tic_method", E->convection.tic_method);
+
+ if (E->convection.tic_method == 0)
+ {
+ n = E->convection.number_of_perturbations;
+ status = set_attribute_int(input, "num_perturbations", n);
+ status = set_attribute_int_vector(input, "perturbl", n, E->convection.perturb_ll);
+ status = set_attribute_int_vector(input, "perturbm", n, E->convection.perturb_mm);
+ status = set_attribute_int_vector(input, "perturblayer", n, E->convection.load_depth);
+ status = set_attribute_float_vector(input, "perturbmag", n, E->convection.perturb_mag);
+ }
+ else if (E->convection.tic_method == 1)
+ {
+ status = set_attribute_float(input, "half_space_age", E->convection.half_space_age);
+ }
+ else if (E->convection.tic_method == 2)
+ {
+ status = set_attribute_float(input, "half_space_age", E->convection.half_space_age);
+ status = set_attribute_float_vector(input, "blob_center", 3, E->convection.blob_center);
+ status = set_attribute_float(input, "blob_radius", E->convection.blob_radius);
+ status = set_attribute_float(input, "blob_dT", E->convection.blob_dT);
+ }
+
+ /*
+ * Param.inventory
+ */
+
+ status = set_attribute_int(input, "file_vbcs", E->control.vbcs_file);
+ status = set_attribute_string(input, "vel_bound_file", E->control.velocity_boundary_file);
+
+ status = set_attribute_int(input, "file_tbcs", E->control.tbcs_file);
+ status = set_attribute_string(input, "temp_bound_file", E->control.temperature_boundary_file);
+
+ status = set_attribute_int(input, "mat_control", E->control.mat_control);
+ status = set_attribute_string(input, "mat_file", E->control.mat_file);
+
+ status = set_attribute_int(input, "lith_age", E->control.lith_age);
+ status = set_attribute_string(input, "lith_age_file", E->control.lith_age_file);
+ status = set_attribute_int(input, "lith_age_time", E->control.lith_age_time);
+ status = set_attribute_float(input, "lith_age_depth", E->control.lith_age_depth);
+ status = set_attribute_float(input, "mantle_temp", E->control.lith_age_mantle_temp);
+
+ status = set_attribute_float(input, "start_age", E->control.start_age);
+ status = set_attribute_int(input, "reset_startage", E->control.reset_startage);
+
+ /*
+ * Phase.inventory
+ */
+
+ status = set_attribute_float(input, "Ra_410", E->control.Ra_410);
+ status = set_attribute_float(input, "clapeyron410", E->control.clapeyron410);
+ status = set_attribute_float(input, "transT410", E->control.transT410);
+ status = set_attribute_float(input, "width410",
+ (E->control.inv_width410 == 0)?
+ E->control.inv_width410 :
+ 1.0/E->control.inv_width410);
+
+ status = set_attribute_float(input, "Ra_670", E->control.Ra_670);
+ status = set_attribute_float(input, "clapeyron670", E->control.clapeyron670);
+ status = set_attribute_float(input, "transT670", E->control.transT670);
+ status = set_attribute_float(input, "width670",
+ (E->control.inv_width670 == 0)?
+ E->control.inv_width670 :
+ 1.0/E->control.inv_width670);
+
+ status = set_attribute_float(input, "Ra_cmb", E->control.Ra_cmb);
+ status = set_attribute_float(input, "clapeyroncmb", E->control.clapeyroncmb);
+ status = set_attribute_float(input, "transTcmb", E->control.transTcmb);
+ status = set_attribute_float(input, "widthcmb",
+ (E->control.inv_widthcmb == 0)?
+ E->control.inv_widthcmb :
+ 1.0/E->control.inv_widthcmb);
+
+ /*
+ * Solver.inventory
+ */
+
+ status = set_attribute_string(input, "datadir", E->control.data_dir);
+ status = set_attribute_string(input, "datafile", E->control.data_file);
+ status = set_attribute_string(input, "datadir_old", E->control.data_dir_old);
+ status = set_attribute_string(input, "datafile_old", E->control.old_P_file);
+
+ status = set_attribute_float(input, "rayleigh", E->control.Atemp);
+ status = set_attribute_float(input, "dissipation_number", E->control.disptn_number);
+ status = set_attribute_float(input, "gruneisen",
+ (E->control.inv_gruneisen == 0)?
+ 1.0/E->control.inv_gruneisen :
+ E->control.inv_gruneisen);
+ status = set_attribute_float(input, "surfaceT", E->control.surface_temp);
+ status = set_attribute_float(input, "Q0", E->control.Q0);
+
+ status = set_attribute_int(input, "stokes_flow_only", E->control.stokes);
+
+ status = set_attribute_string(input, "output_format", E->output.format);
+ status = set_attribute_string(input, "output_optional", E->output.optional);
+ status = set_attribute_int(input, "output_ll_max", E->output.llmax);
+
+ status = set_attribute_int(input, "verbose", E->control.verbose);
+ status = set_attribute_int(input, "see_convergence", E->control.print_convergence);
+
+ /*
+ * Sphere.inventory
+ */
+
+ status = set_attribute_int(input, "nproc_surf", E->parallel.nprocxy);
+
+ status = set_attribute_int(input, "nprocx", E->parallel.nprocx);
+ status = set_attribute_int(input, "nprocy", E->parallel.nprocy);
+ status = set_attribute_int(input, "nprocz", E->parallel.nprocz);
+
+ status = set_attribute_int(input, "coor", E->control.coor);
+ status = set_attribute_string(input, "coor_file", E->control.coor_file);
+
+ status = set_attribute_int(input, "nodex", E->mesh.nox);
+ status = set_attribute_int(input, "nodey", E->mesh.noy);
+ status = set_attribute_int(input, "nodez", E->mesh.noz);
+
+ status = set_attribute_int(input, "levels", E->mesh.levels);
+ status = set_attribute_int(input, "mgunitx", E->mesh.mgunitx);
+ status = set_attribute_int(input, "mgunity", E->mesh.mgunity);
+ status = set_attribute_int(input, "mgunitz", E->mesh.mgunitz);
+
+ status = set_attribute_double(input, "radius_outer", E->sphere.ro);
+ status = set_attribute_double(input, "radius_inner", E->sphere.ri);
+
+ status = set_attribute_int(input, "caps", E->sphere.caps);
+
+ rank = 2;
+ dims = (hsize_t *)malloc(rank * sizeof(hsize_t));
+ dims[0] = E->sphere.caps;
+ dims[1] = 4;
+ data = (double *)malloc((dims[0]*dims[1]) * sizeof(double));
+
+ for(n = 1; n <= E->sphere.caps; n++)
+ {
+ data[4*(n-1) + 0] = E->sphere.cap[n].theta[1];
+ data[4*(n-1) + 1] = E->sphere.cap[n].theta[2];
+ data[4*(n-1) + 2] = E->sphere.cap[n].theta[3];
+ data[4*(n-1) + 3] = E->sphere.cap[n].theta[4];
+ }
+ status = set_attribute_array(input, "theta", rank, dims, H5T_NATIVE_DOUBLE, data);
+
+ for(n = 1; n <= E->sphere.caps; n++)
+ {
+ data[4*(n-1) + 0] = E->sphere.cap[n].fi[1];
+ data[4*(n-1) + 1] = E->sphere.cap[n].fi[2];
+ data[4*(n-1) + 2] = E->sphere.cap[n].fi[3];
+ data[4*(n-1) + 3] = E->sphere.cap[n].fi[4];
+ }
+ status = set_attribute_array(input, "fi", rank, dims, H5T_NATIVE_DOUBLE, data);
+
+ free(data);
+ free(dims);
+
+ if (E->sphere.caps == 1)
+ {
+ status = set_attribute_double(input, "theta_min", E->control.theta_min);
+ status = set_attribute_double(input, "theta_max", E->control.theta_max);
+ status = set_attribute_double(input, "fi_min", E->control.fi_min);
+ status = set_attribute_double(input, "fi_max", E->control.fi_max);
+ }
+
+ /*
+ * Tracer.inventory
+ */
+
+ status = set_attribute_int(input, "tracer", E->control.tracer);
+ status = set_attribute_string(input, "tracer_file", E->trace.tracer_file);
+
+ /*
+ * Visc.inventory
+ */
+
+ status = set_attribute_string(input, "Viscosity", E->viscosity.STRUCTURE);
+ status = set_attribute_int(input, "visc_smooth_method", E->viscosity.smooth_cycles);
+ status = set_attribute_int(input, "VISC_UPDATE", E->viscosity.update_allowed);
+
+ n = E->viscosity.num_mat;
+ status = set_attribute_int(input, "num_mat", n);
+ status = set_attribute_float_vector(input, "visc0", n, E->viscosity.N0);
+ status = set_attribute_int(input, "TDEPV", E->viscosity.TDEPV);
+ status = set_attribute_int(input, "rheol", E->viscosity.RHEOL);
+ status = set_attribute_float_vector(input, "viscE", n, E->viscosity.E);
+ status = set_attribute_float_vector(input, "viscT", n, E->viscosity.T);
+ status = set_attribute_float_vector(input, "viscZ", n, E->viscosity.Z);
+
+ status = set_attribute_int(input, "SDEPV", E->viscosity.SDEPV);
+ status = set_attribute_float(input, "sdepv_misfit", E->viscosity.sdepv_misfit);
+ status = set_attribute_float_vector(input, "sdepv_expt", n, E->viscosity.sdepv_expt);
+
+ status = set_attribute_int(input, "VMIN", E->viscosity.MIN);
+ status = set_attribute_float(input, "visc_min", E->viscosity.min_value);
+
+ status = set_attribute_int(input, "VMAX", E->viscosity.MAX);
+ status = set_attribute_float(input, "visc_max", E->viscosity.max_value);
+
+ /*
+ * Incompressible.inventory
+ */
+
+ status = set_attribute_string(input, "Solver", E->control.SOLVER_TYPE);
+ status = set_attribute_int(input, "node_assemble", E->control.NASSEMBLE);
+ status = set_attribute_int(input, "precond", E->control.precondition);
+
+ status = set_attribute_double(input, "accuracy", E->control.accuracy);
+
+ status = set_attribute_int(input, "mg_cycle", E->control.mg_cycle);
+ status = set_attribute_int(input, "down_heavy", E->control.down_heavy);
+ status = set_attribute_int(input, "up_heavy", E->control.up_heavy);
+
+ status = set_attribute_int(input, "vlowstep", E->control.v_steps_low);
+ status = set_attribute_int(input, "vhighstep", E->control.v_steps_high);
+ status = set_attribute_int(input, "piterations", E->control.p_iterations);
+
+ status = set_attribute_int(input, "aug_lagr", E->control.augmented_Lagr);
+ status = set_attribute_double(input, "aug_number", E->control.augmented);
+
+ /* status = set_attribute(input, "", H5T_NATIVE_, &(E->)); */
+
+ /*
+ * Release resources
+ */
+ status = H5Gclose(input);
+}
+
+
+
+/*****************************************************************************
+ * Private functions to simplify certain tasks in the h5output_*() functions *
+ * The rest of the file can now be hidden from the compiler, when HDF5 *
+ * is not enabled. *
+ *****************************************************************************/
+
+/* Function to create an HDF5 file compatible with PyTables.
+ *
+ * To enable parallel I/O access, use something like the following:
+ *
+ * hid_t file_id;
+ * hid_t fcpl_id, fapl_id;
+ * herr_t status;
+ *
+ * MPI_Comm comm = MPI_COMM_WORLD;
+ * MPI_Info info = MPI_INFO_NULL;
+ *
+ * ...
+ *
+ * fcpl_id = H5P_DEFAULT;
+ *
+ * fapl_id = H5Pcreate(H5P_FILE_ACCESS);
+ * status = H5Pset_fapl_mpio(fapl_id, comm, info);
+ *
+ * file_id = h5create_file(filename, H5F_ACC_TRUNC, fcpl_id, fapl_id);
+ * status = H5Pclose(fapl_id);
+ */
+static hid_t h5create_file(const char *filename,
+ unsigned flags,
+ hid_t fcpl_id,
+ hid_t fapl_id)
+{
+ hid_t file_id;
+ hid_t root;
+
+ herr_t status;
+
+ /* Create the HDF5 file */
+ file_id = H5Fcreate(filename, flags, fcpl_id, fapl_id);
+
+ /* Write necessary attributes to root group for PyTables compatibility */
+ root = H5Gopen(file_id, "/");
+ set_attribute_string(root, "TITLE", "CitcomS output");
+ set_attribute_string(root, "CLASS", "GROUP");
+ set_attribute_string(root, "VERSION", "1.0");
+ set_attribute_string(root, "PYTABLES_FORMAT_VERSION", "1.5");
+
+ /* release resources */
+ status = H5Gclose(root);
+
+ return file_id;
+}
+
+
+/* Function to create an HDF5 group compatible with PyTables.
+ * To close group, call H5Gclose().
+ */
+static hid_t h5create_group(hid_t loc_id, const char *name, size_t size_hint)
+{
+ hid_t group_id;
+
+ /* TODO:
+ * Make sure this function is called with an appropriately
+ * estimated size_hint parameter
+ */
+ group_id = H5Gcreate(loc_id, name, size_hint);
+
+ /* Write necessary attributes for PyTables compatibility */
+ set_attribute_string(group_id, "TITLE", "CitcomS HDF5 group");
+ set_attribute_string(group_id, "CLASS", "GROUP");
+ set_attribute_string(group_id, "VERSION", "1.0");
+ set_attribute_string(group_id, "PYTABLES_FORMAT_VERSION", "1.5");
+
+ return group_id;
+}
+
+
+static herr_t h5create_dataset(hid_t loc_id,
+ const char *name,
+ const char *title,
+ hid_t type_id,
+ int rank,
+ hsize_t *dims,
+ hsize_t *maxdims,
+ hsize_t *chunkdims)
+{
+ hid_t dataset; /* dataset identifier */
+ hid_t dataspace; /* file dataspace identifier */
+ hid_t dcpl_id; /* dataset creation property list identifier */
+ herr_t status;
+
+ /* create the dataspace for the dataset */
+ dataspace = H5Screate_simple(rank, dims, maxdims);
+ if (dataspace < 0)
+ {
+ /*TODO: print error*/
+ return -1;
+ }
+
+ dcpl_id = H5P_DEFAULT;
+ if (chunkdims != NULL)
+ {
+ /* modify dataset creation properties to enable chunking */
+ dcpl_id = H5Pcreate(H5P_DATASET_CREATE);
+ status = H5Pset_chunk(dcpl_id, rank, chunkdims);
+ /*status = H5Pset_fill_value(dcpl_id, H5T_NATIVE_FLOAT, &fillvalue);*/
+ }
+
+ /* create the dataset */
+ dataset = H5Dcreate(loc_id, name, type_id, dataspace, dcpl_id);
+ if (dataset < 0)
+ {
+ /*TODO: print error*/
+ return -1;
+ }
+
+ /* Write necessary attributes for PyTables compatibility */
+ set_attribute_string(dataset, "TITLE", title);
+ set_attribute_string(dataset, "CLASS", "ARRAY");
+ set_attribute_string(dataset, "FLAVOR", "numpy");
+ set_attribute_string(dataset, "VERSION", "2.3");
+
+ /* release resources */
+ if (chunkdims != NULL)
+ {
+ status = H5Pclose(dcpl_id);
+ }
+ status = H5Sclose(dataspace);
+ status = H5Dclose(dataset);
+
+ return 0;
+}
+
+static herr_t h5allocate_field(struct All_variables *E,
+ enum field_class_t field_class,
+ int nsd,
+ hid_t dtype,
+ field_t **field)
+{
+ int rank = 0;
+ int tdim = 0;
+ int cdim = 0;
+
+ /* indices */
+ int s = -100; /* caps dimension */
+ int x = -100; /* first spatial dimension */
+ int y = -100; /* second spatial dimension */
+ int z = -100; /* third spatial dimension */
+ int c = -100; /* dimension for components */
+
+ int dim;
+
+ int px, py, pz;
+ int nprocx, nprocy, nprocz;
+
+ int nx, ny, nz;
+ int nodex, nodey, nodez;
+
+ /* coordinates of current process in cap */
+ px = E->parallel.me_loc[1];
+ py = E->parallel.me_loc[2];
+ pz = E->parallel.me_loc[3];
+
+ /* dimensions of processes per cap */
+ nprocx = E->parallel.nprocx;
+ nprocy = E->parallel.nprocy;
+ nprocz = E->parallel.nprocz;
+
+ /* determine dimensions of mesh */
+ nodex = E->mesh.nox;
+ nodey = E->mesh.noy;
+ nodez = E->mesh.noz;
+
+ /* determine dimensions of local mesh */
+ nx = E->lmesh.nox;
+ ny = E->lmesh.noy;
+ nz = E->lmesh.noz;
+
+ /* clear struct pointer */
+ *field = NULL;
+
+ /* start with caps as the first dimension */
+ rank = 1;
+ s = 0;
+
+ /* add the spatial dimensions */
+ switch (nsd)
+ {
+ case 3:
+ rank += 3;
+ x = 1;
+ y = 2;
+ z = 3;
+ break;
+ case 2:
+ rank += 2;
+ x = 1;
+ y = 2;
+ break;
+ case 1:
+ rank += 1;
+ z = 1;
+ break;
+ default:
+ return -1;
+ }
+
+ /* add components dimension at end */
+ switch (field_class)
+ {
+ case TENSOR_FIELD:
+ cdim = 6;
+ rank += 1;
+ c = rank-1;
+ break;
+ case VECTOR_FIELD:
+ cdim = nsd;
+ rank += 1;
+ c = rank-1;
+ break;
+ case SCALAR_FIELD:
+ cdim = 0;
+ break;
+ }
+
+ if (rank > 1)
+ {
+ *field = (field_t *)malloc(sizeof(field_t));
+
+ (*field)->dtype = dtype;
+
+ (*field)->rank = rank;
+ (*field)->dims = (hsize_t *)malloc(rank * sizeof(hsize_t));
+ (*field)->maxdims = (hsize_t *)malloc(rank * sizeof(hsize_t));
+ (*field)->chunkdims = NULL;
+
+ (*field)->offset = (hsize_t *)malloc(rank * sizeof(hsize_t));
+ (*field)->stride = (hsize_t *)malloc(rank * sizeof(hsize_t));
+ (*field)->count = (hsize_t *)malloc(rank * sizeof(hsize_t));
+ (*field)->block = (hsize_t *)malloc(rank * sizeof(hsize_t));
+
+
+ if (s >= 0)
+ {
+ /* dataspace parameters */
+ (*field)->dims[s] = E->sphere.caps;
+ (*field)->maxdims[s] = E->sphere.caps;
+
+ /* hyperslab selection parameters */
+ (*field)->offset[s] = E->hdf5.cap;
+ (*field)->stride[s] = 1;
+ (*field)->count[s] = 1;
+ (*field)->block[s] = 1;
+ }
+
+ if (x >= 0)
+ {
+ /* dataspace parameters */
+ (*field)->dims[x] = nodex;
+ (*field)->maxdims[x] = nodex;
+
+ /* hyperslab selection parameters */
+ (*field)->offset[x] = px*(nx-1);
+ (*field)->stride[x] = 1;
+ (*field)->count[x] = 1;
+ (*field)->block[x] = ((px == nprocx-1) ? nx : nx-1);
+ }
+
+ if (y >= 0)
+ {
+ /* dataspace parameters */
+ (*field)->dims[y] = nodey;
+ (*field)->maxdims[y] = nodey;
+
+ /* hyperslab selection parameters */
+ (*field)->offset[y] = py*(ny-1);
+ (*field)->stride[y] = 1;
+ (*field)->count[y] = 1;
+ (*field)->block[y] = ((py == nprocy-1) ? ny : ny-1);
+ }
+
+ if (z >= 0)
+ {
+ /* dataspace parameters */
+ (*field)->dims[z] = nodez;
+ (*field)->maxdims[z] = nodez;
+
+ /* hyperslab selection parameters */
+ (*field)->offset[z] = pz*(nz-1);
+ (*field)->stride[z] = 1;
+ (*field)->count[z] = 1;
+ (*field)->block[z] = ((pz == nprocz-1) ? nz : nz-1);
+ }
+
+ if (c >= 0)
+ {
+ /* dataspace parameters */
+ (*field)->dims[c] = cdim;
+ (*field)->maxdims[c] = cdim;
+
+ /* hyperslab selection parameters */
+ (*field)->offset[c] = 0;
+ (*field)->stride[c] = 1;
+ (*field)->count[c] = 1;
+ (*field)->block[c] = cdim;
+ }
+
+ /* count number of data points */
+ (*field)->n = 1;
+ for(dim = 0; dim < rank; dim++)
+ (*field)->n *= (*field)->block[dim];
+
+
+ if(E->control.verbose) {
+ fprintf(E->fp_out, "creating dataset: rank=%d size=%d\n",
+ rank, (*field)->n);
+ fprintf(E->fp_out, " s=%d x=%d y=%d z=%d c=%d\n",
+ s, x, y, z, c);
+ fprintf(E->fp_out, "\tdim\tmaxdim\toffset\tstride\tcount\tblock\n");
+ for(dim = 0; dim < rank; dim++) {
+ fprintf(E->fp_out, "\t%d\t%d\t%d\t%d\t%d\t%d\n",
+ (int) (*field)->dims[dim],
+ (int) (*field)->maxdims[dim],
+ (int) (*field)->offset[dim],
+ (int) (*field)->stride[dim],
+ (int) (*field)->count[dim],
+ (int) (*field)->block[dim]);
+ }
+ }
+ return 0;
+ }
+
+ return -1;
+}
+
+static herr_t h5create_field(hid_t loc_id,
+ field_t *field,
+ const char *name,
+ const char *title)
+{
+ herr_t status;
+
+ status = h5create_dataset(loc_id, name, title, field->dtype, field->rank,
+ field->dims, field->maxdims, field->chunkdims);
+
+ return status;
+}
+
+
+static herr_t h5write_dataset(hid_t dset_id,
+ hid_t mem_type_id,
+ const void *data,
+ int rank,
+ hsize_t *memdims,
+ hsize_t *offset,
+ hsize_t *stride,
+ hsize_t *count,
+ hsize_t *block,
+ int collective,
+ int dowrite)
+{
+ hid_t memspace; /* memory dataspace */
+ hid_t filespace; /* file dataspace */
+ hid_t dxpl_id; /* dataset transfer property list identifier */
+ herr_t status;
+
+ /* create memory dataspace */
+ memspace = H5Screate_simple(rank, memdims, NULL);
+ if (memspace < 0)
+ {
+ /*TODO: print error*/
+ return -1;
+ }
+
+ /* get file dataspace */
+ filespace = H5Dget_space(dset_id);
+ if (filespace < 0)
+ {
+ /*TODO: print error*/
+ H5Sclose(memspace);
+ return -1;
+ }
+
+ /* hyperslab selection */
+ status = H5Sselect_hyperslab(filespace, H5S_SELECT_SET,
+ offset, stride, count, block);
+ if (status < 0)
+ {
+ /*TODO: print error*/
+ status = H5Sclose(filespace);
+ status = H5Sclose(memspace);
+ return -1;
+ }
+
+ /* dataset transfer property list */
+ dxpl_id = H5Pcreate(H5P_DATASET_XFER);
+ if (dxpl_id < 0)
+ {
+ /*TODO: print error*/
+ status = H5Sclose(filespace);
+ status = H5Sclose(memspace);
+ return -1;
+ }
+
+ if (collective)
+ status = H5Pset_dxpl_mpio(dxpl_id, H5FD_MPIO_COLLECTIVE);
+ else
+ status = H5Pset_dxpl_mpio(dxpl_id, H5FD_MPIO_INDEPENDENT);
+
+ if (status < 0)
+ {
+ /*TODO: print error*/
+ status = H5Pclose(dxpl_id);
+ status = H5Sclose(filespace);
+ status = H5Sclose(memspace);
+ return -1;
+ }
+
+ /* write the data to the hyperslab */
+ if (dowrite || collective)
+ {
+ status = H5Dwrite(dset_id, mem_type_id, memspace, filespace, dxpl_id, data);
+ if (status < 0)
+ {
+ /*TODO: print error*/
+ H5Pclose(dxpl_id);
+ H5Sclose(filespace);
+ H5Sclose(memspace);
+ return -1;
+ }
+ }
+
+ /* release resources */
+ status = H5Pclose(dxpl_id);
+ status = H5Sclose(filespace);
+ status = H5Sclose(memspace);
+
+ return 0;
+}
+
+static herr_t h5write_field(hid_t dset_id, field_t *field, int collective, int dowrite)
+{
+ herr_t status;
+
+ status = h5write_dataset(dset_id, H5T_NATIVE_FLOAT, field->data,
+ field->rank, field->block, field->offset,
+ field->stride, field->count, field->block,
+ collective, dowrite);
+ return status;
+}
+
+
+static herr_t h5close_field(field_t **field)
+{
+ if (field != NULL)
+ if (*field != NULL)
+ {
+ free((*field)->dims);
+ free((*field)->maxdims);
+ if((*field)->chunkdims != NULL)
+ free((*field)->chunkdims);
+ free((*field)->offset);
+ free((*field)->stride);
+ free((*field)->count);
+ free((*field)->block);
+ /*free((*field)->data);*/
+ free(*field);
+ }
+}
+
+
+
+/****************************************************************************
+ * Some of the following functions were based from the H5ATTR.c *
+ * source file in PyTables, which is a BSD-licensed python extension *
+ * for accessing HDF5 files. *
+ * *
+ * The copyright notice is hereby retained. *
+ * *
+ * NCSA HDF *
+ * Scientific Data Technologies *
+ * National Center for Supercomputing Applications *
+ * University of Illinois at Urbana-Champaign *
+ * 605 E. Springfield, Champaign IL 61820 *
+ * *
+ * For conditions of distribution and use, see the accompanying *
+ * hdf/COPYING file. *
+ * *
+ * Modified versions of H5LT for getting and setting attributes for open *
+ * groups and leaves. *
+ * F. Altet 2005/09/29 *
+ * *
+ ****************************************************************************/
+
+/* Function : find_attr
+ * Purpose : operator function used by find_attribute
+ * Programmer: Pedro Vicente, pvn at ncsa.uiuc.edu
+ * Date : June 21, 2001
+ */
+static herr_t find_attr(hid_t loc_id, const char *name, void *op_data)
+{
+ /* Define a default zero value for return. This will cause the
+ * iterator to continue if the palette attribute is not found yet.
+ */
+
+ int ret = 0;
+
+ char *attr_name = (char *)op_data;
+
+ /* Shut the compiler up */
+ loc_id = loc_id;
+
+ /* Define a positive value for return value if the attribute was
+ * found. This will cause the iterator to immediately return that
+ * positive value, indicating short-circuit success
+ */
+
+ if(strcmp(name, attr_name) == 0)
+ ret = 1;
+
+ return ret;
+}
+
+/* Function : find_attribute
+ * Purpose : Inquires if an attribute named attr_name exists attached
+ * attached to the object loc_id.
+ * Programmer: Pedro Vicente, pvn at ncsa.uiuc.edu
+ * Date : June 21, 2001
+ *
+ * Comments:
+ * The function uses H5Aiterate with the operator function find_attr
+ *
+ * Return:
+ *
+ * Success: The return value of the first operator that returns
+ * non-zero, or zero if all members were processed with no
+ * operator returning non-zero.
+ *
+ * Failure: Negative if something goes wrong within the library,
+ * or the negative value returned by one of the operators.
+ */
+static herr_t find_attribute(hid_t loc_id, const char *attr_name)
+{
+ unsigned int attr_num;
+ herr_t ret;
+
+ attr_num = 0;
+ ret = H5Aiterate(loc_id, &attr_num, find_attr, (void *)attr_name);
+
+ return ret;
+}
+
+
+/* Function: set_attribute_string
+ * Purpose : Creates and writes a string attribute named attr_name
+ * and attaches it to the object specified by obj_id
+ * Return : Success 0, Failure -1
+ * Comments: If the attribute already exists, it is overwritten.
+ */
+herr_t set_attribute_string(hid_t obj_id,
+ const char *attr_name,
+ const char *attr_data)
+{
+ hid_t attr_type;
+ hid_t attr_size;
+ hid_t attr_space_id;
+ hid_t attr_id;
+ int has_attr;
+ herr_t status;
+
+ /* Create the attribute */
+ attr_type = H5Tcopy(H5T_C_S1);
+ if (attr_type < 0) goto out;
+
+ attr_size = strlen(attr_data) + 1; /* extra null term */
+
+ status = H5Tset_size(attr_type, (size_t)attr_size);
+ if (status < 0) goto out;
+
+ status = H5Tset_strpad(attr_type, H5T_STR_NULLTERM);
+ if (status < 0) goto out;
+
+ attr_space_id = H5Screate(H5S_SCALAR);
+ if (status < 0) goto out;
+
+ /* Verify if the attribute already exists */
+ has_attr = find_attribute(obj_id, attr_name);
+
+ /* The attribute already exists, delete it */
+ if (has_attr == 1)
+ {
+ status = H5Adelete(obj_id, attr_name);
+ if (status < 0) goto out;
+ }
+
+ /* Create and write the attribute */
+
+ attr_id = H5Acreate(obj_id, attr_name, attr_type, attr_space_id,
+ H5P_DEFAULT);
+ if(attr_id < 0) goto out;
+
+ status = H5Awrite(attr_id, attr_type, attr_data);
+ if(status < 0) goto out;
+
+ status = H5Aclose(attr_id);
+ if(status < 0) goto out;
+
+ status = H5Sclose(attr_space_id);
+ if(status < 0) goto out;
+
+ status = H5Tclose(attr_type);
+ if(status < 0) goto out;
+
+
+ return 0;
+
+out:
+ return -1;
+}
+
+
+/* Function : set_attribute
+ * Purpose : Private function used by
+ * set_attribute_int and set_attribute_float
+ * Return : Success 0, Failure -1
+ * Programmer: Pedro Vicente, pvn at ncsa.uiuc.edu
+ * Date : July 25, 2001
+ */
+herr_t set_attribute(hid_t obj_id,
+ const char *attr_name,
+ hid_t type_id,
+ const void *data)
+{
+ hid_t space_id, attr_id;
+ herr_t status;
+
+ int has_attr;
+
+ /* Create the data space for the attribute. */
+ space_id = H5Screate(H5S_SCALAR);
+ if (space_id < 0) goto out;
+
+ /* Verify if the attribute already exists */
+ has_attr = find_attribute(obj_id, attr_name);
+ if (has_attr == 1)
+ {
+ /* The attribute already exists. Delete it. */
+ status = H5Adelete(obj_id, attr_name);
+ if(status < 0) goto out;
+ }
+
+ /* Create the attribute. */
+ attr_id = H5Acreate(obj_id, attr_name, type_id, space_id, H5P_DEFAULT);
+ if (attr_id < 0) goto out;
+
+ /* Write the attribute data. */
+ status = H5Awrite(attr_id, type_id, data);
+ if (status < 0) goto out;
+
+ /* Close the attribute. */
+ status = H5Aclose(attr_id);
+ if (status < 0) goto out;
+
+ /* Close the data space. */
+ status = H5Sclose(space_id);
+ if (status < 0) goto out;
+
+ return 0;
+
+out:
+ return -1;
+}
+
+herr_t set_attribute_float(hid_t obj_id, const char *attr_name, float x)
+{
+ return set_attribute(obj_id, attr_name, H5T_NATIVE_FLOAT, &x);
+}
+
+herr_t set_attribute_double(hid_t obj_id, const char *attr_name, double x)
+{
+ return set_attribute(obj_id, attr_name, H5T_NATIVE_DOUBLE, &x);
+}
+
+herr_t set_attribute_int(hid_t obj_id, const char *attr_name, int n)
+{
+ return set_attribute(obj_id, attr_name, H5T_NATIVE_INT, &n);
+}
+
+herr_t set_attribute_long(hid_t obj_id, const char *attr_name, long n)
+{
+ return set_attribute(obj_id, attr_name, H5T_NATIVE_LONG, &n);
+}
+
+herr_t set_attribute_llong(hid_t obj_id, const char *attr_name, long long n)
+{
+ return set_attribute(obj_id, attr_name, H5T_NATIVE_LLONG, &n);
+}
+
+/* Function: set_attribute_array
+ * Purpose : write an array attribute
+ * Return : Success 0, Failure -1
+ * Date : July 25, 2001
+ */
+herr_t set_attribute_array(hid_t obj_id,
+ const char *attr_name,
+ size_t rank,
+ hsize_t *dims,
+ hid_t type_id,
+ const void *data)
+{
+ hid_t space_id, attr_id;
+ herr_t status;
+
+ int has_attr;
+
+ /* Create the data space for the attribute. */
+ space_id = H5Screate_simple(rank, dims, NULL);
+ if (space_id < 0) goto out;
+
+ /* Verify if the attribute already exists. */
+ has_attr = find_attribute(obj_id, attr_name);
+ if (has_attr == 1)
+ {
+ /* The attribute already exists. Delete it. */
+ status = H5Adelete(obj_id, attr_name);
+ if (status < 0) goto out;
+ }
+
+ /* Create the attribute. */
+ attr_id = H5Acreate(obj_id, attr_name, type_id, space_id, H5P_DEFAULT);
+ if (attr_id < 0) goto out;
+
+ /* Write the attribute data. */
+ status = H5Awrite(attr_id, type_id, data);
+ if (status < 0) goto out;
+
+ /* Close the attribute. */
+ status = H5Aclose(attr_id);
+ if (status < 0) goto out;
+
+ /* Close the dataspace. */
+ status = H5Sclose(space_id);
+ if (status < 0) goto out;
+
+ return 0;
+
+out:
+ return -1;
+}
+
+herr_t set_attribute_vector(hid_t obj_id,
+ const char *attr_name,
+ hsize_t dim,
+ hid_t type_id,
+ const void *data)
+{
+ return set_attribute_array(obj_id, attr_name, 1, &dim, type_id, data);
+}
+
+herr_t set_attribute_int_vector(hid_t obj_id,
+ const char *attr_name,
+ hsize_t dim,
+ const int *data)
+{
+ return set_attribute_array(obj_id, attr_name, 1, &dim, H5T_NATIVE_INT, data);
+}
+
+herr_t set_attribute_float_vector(hid_t obj_id,
+ const char *attr_name,
+ hsize_t dim,
+ const float *data)
+{
+ return set_attribute_array(obj_id, attr_name, 1, &dim, H5T_NATIVE_FLOAT, data);
+}
+
+herr_t set_attribute_double_vector(hid_t obj_id,
+ const char *attr_name,
+ hsize_t dim,
+ const double *data)
+{
+ return set_attribute_array(obj_id, attr_name, 1, &dim, H5T_NATIVE_DOUBLE, data);
+}
+
+#endif /* #ifdef USE_HDF5 */
Deleted: mc/3D/CitcomS/branches/cxx/lib/Output_vtk.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Output_vtk.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Output_vtk.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,234 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-/* Routine to process the output of the finite element cycles
- and to turn them into a coherent suite files */
-
-
-#include <stdlib.h>
-#include <math.h>
-#include "element_definitions.h"
-#include "global_defs.h"
-#include "output.h"
-
-static void vts_file_header(struct All_variables *E, FILE *fp)
-{
-
- const char format[] =
- "<?xml version=\"1.0\"?>\n"
- "<VTKFile type=\"StructuredGrid\" version=\"0.1\">\n"
- " <StructuredGrid WholeExtent=\"%s\">\n"
- " <Piece Extent=\"%s\">\n";
-
- char extent[64], header[1024];
-
- snprintf(extent, 64, "%d %d %d %d %d %d",
- E->lmesh.exs, E->lmesh.exs + E->lmesh.elx,
- E->lmesh.eys, E->lmesh.eys + E->lmesh.ely,
- E->lmesh.ezs, E->lmesh.ezs + E->lmesh.elz);
-
- snprintf(header, 1024, format, extent, extent);
-
- fputs(header, fp);
-
- return;
-}
-
-
-static void vts_file_trailer(struct All_variables *E, FILE *fp)
-{
- const char trailer[] =
- " </Piece>\n"
- " </StructuredGrid>\n"
- "</VTKFile>\n";
-
- fputs(trailer, fp);
-
- return;
-}
-
-
-static void vtk_point_data_header(struct All_variables *E, FILE *fp)
-{
- fputs(" <PointData Scalars=\"temperature\" Vectors=\"velocity\">\n", fp);
-
-
- return;
-}
-
-
-static void vtk_point_data_trailer(struct All_variables *E, FILE *fp)
-{
- fputs(" </PointData>\n", fp);
- return;
-}
-
-
-static void vtk_cell_data_header(struct All_variables *E, FILE *fp)
-{
- fputs(" <CellData>\n", fp);
- return;
-}
-
-
-static void vtk_cell_data_trailer(struct All_variables *E, FILE *fp)
-{
- fputs(" </CellData>\n", fp);
- return;
-}
-
-
-static void vtk_output_temp(struct All_variables *E, FILE *fp)
-{
- int i, j;
-
- fputs(" <DataArray type=\"Float32\" Name=\"temperature\" format=\"ascii\">\n", fp);
-
- for(j=1; j<=E->sphere.caps_per_proc; j++) {
- for(i=1; i<=E->lmesh.nno; i++) {
- fprintf(fp, "%.6e\n", E->T[j][i]);
- }
- }
-
- fputs(" </DataArray>\n", fp);
- return;
-}
-
-
-static void vtk_output_velo(struct All_variables *E, FILE *fp)
-{
- int i, j;
- double sint, sinf, cost, cosf;
- float *V[4];
- const int lev = E->mesh.levmax;
-
- fputs(" <DataArray type=\"Float32\" Name=\"velocity\" NumberOfComponents=\"3\" format=\"ascii\">\n", fp);
-
- for(j=1; j<=E->sphere.caps_per_proc; j++) {
- V[1] = E->sphere.cap[j].V[1];
- V[2] = E->sphere.cap[j].V[2];
- V[3] = E->sphere.cap[j].V[3];
-
- for(i=1; i<=E->lmesh.nno; i++) {
- sint = E->SinCos[lev][j][0][i];
- sinf = E->SinCos[lev][j][1][i];
- cost = E->SinCos[lev][j][2][i];
- cosf = E->SinCos[lev][j][3][i];
-
- fprintf(fp, "%.6e %.6e %.6e\n",
- V[1][i]*cost*cosf - V[2][i]*sinf + V[3][i]*sint*cosf,
- V[1][i]*cost*sinf + V[2][i]*cosf + V[3][i]*sint*sinf,
- -V[1][i]*sint + V[3][i]*cost);
- }
- }
-
- fputs(" </DataArray>\n", fp);
- return;
-}
-
-
-static void vtk_output_visc(struct All_variables *E, FILE *fp)
-{
- int i, j;
- int lev = E->mesh.levmax;
-
- fputs(" <DataArray type=\"Float32\" Name=\"viscosity\" format=\"ascii\">\n", fp);
-
- for(j=1; j<=E->sphere.caps_per_proc; j++) {
- for(i=1; i<=E->lmesh.nno; i++)
- fprintf(fp, "%.4e\n", E->VI[lev][j][i]);
- }
-
- fputs(" </DataArray>\n", fp);
- return;
-}
-
-
-static void vtk_output_coord(struct All_variables *E, FILE *fp)
-{
- /* Output Cartesian coordinates as most VTK visualization softwares
- assume it. */
- int i, j;
-
- fputs(" <Points>\n", fp);
- fputs(" <DataArray type=\"Float32\" Name=\"coordinate\" NumberOfComponents=\"3\" format=\"ascii\">\n", fp);
-
- for(j=1; j<=E->sphere.caps_per_proc; j++) {
- for(i=1; i<=E->lmesh.nno; i++)
- fprintf(fp,"%.6e %.6e %.6e\n",
- E->x[j][1][i],
- E->x[j][2][i],
- E->x[j][3][i]);
- }
-
- fputs(" </DataArray>\n", fp);
- fputs(" </Points>\n", fp);
-
- return;
-}
-
-
-/**********************************************************************/
-
-void vtk_output(struct All_variables *E, int cycles)
-{
- char output_file[255];
- FILE *fp;
-
- snprintf(output_file, 255, "%s.%d.step%d.vts",
- E->control.data_file, E->parallel.me, cycles);
- fp = output_open(output_file, "w");
-
-
- /* first, write volume data to vts file */
- vts_file_header(E, fp);
-
- /* write node-based field */
- vtk_point_data_header(E, fp);
- vtk_output_temp(E, fp);
- vtk_output_velo(E, fp);
- vtk_output_visc(E, fp);
- vtk_point_data_trailer(E, fp);
-
- /* write element-based field */
- vtk_cell_data_header(E, fp);
- /**/
- vtk_cell_data_trailer(E, fp);
-
- /* write coordinate */
- vtk_output_coord(E, fp);
-
- vts_file_trailer(E, fp);
-
- /* then, write other type of data */
- //vtk_output_surf_botm(E, );
-
-
- fclose(fp);
-
- return;
-}
Copied: mc/3D/CitcomS/branches/cxx/lib/Output_vtk.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Output_vtk.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Output_vtk.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Output_vtk.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,234 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+/* Routine to process the output of the finite element cycles
+ and to turn them into a coherent suite files */
+
+
+#include <stdlib.h>
+#include <math.h>
+#include "element_definitions.h"
+#include "global_defs.h"
+#include "output.h"
+
+static void vts_file_header(struct All_variables *E, FILE *fp)
+{
+
+ const char format[] =
+ "<?xml version=\"1.0\"?>\n"
+ "<VTKFile type=\"StructuredGrid\" version=\"0.1\">\n"
+ " <StructuredGrid WholeExtent=\"%s\">\n"
+ " <Piece Extent=\"%s\">\n";
+
+ char extent[64], header[1024];
+
+ snprintf(extent, 64, "%d %d %d %d %d %d",
+ E->lmesh.exs, E->lmesh.exs + E->lmesh.elx,
+ E->lmesh.eys, E->lmesh.eys + E->lmesh.ely,
+ E->lmesh.ezs, E->lmesh.ezs + E->lmesh.elz);
+
+ snprintf(header, 1024, format, extent, extent);
+
+ fputs(header, fp);
+
+ return;
+}
+
+
+static void vts_file_trailer(struct All_variables *E, FILE *fp)
+{
+ const char trailer[] =
+ " </Piece>\n"
+ " </StructuredGrid>\n"
+ "</VTKFile>\n";
+
+ fputs(trailer, fp);
+
+ return;
+}
+
+
+static void vtk_point_data_header(struct All_variables *E, FILE *fp)
+{
+ fputs(" <PointData Scalars=\"temperature\" Vectors=\"velocity\">\n", fp);
+
+
+ return;
+}
+
+
+static void vtk_point_data_trailer(struct All_variables *E, FILE *fp)
+{
+ fputs(" </PointData>\n", fp);
+ return;
+}
+
+
+static void vtk_cell_data_header(struct All_variables *E, FILE *fp)
+{
+ fputs(" <CellData>\n", fp);
+ return;
+}
+
+
+static void vtk_cell_data_trailer(struct All_variables *E, FILE *fp)
+{
+ fputs(" </CellData>\n", fp);
+ return;
+}
+
+
+static void vtk_output_temp(struct All_variables *E, FILE *fp)
+{
+ int i, j;
+
+ fputs(" <DataArray type=\"Float32\" Name=\"temperature\" format=\"ascii\">\n", fp);
+
+ for(j=1; j<=E->sphere.caps_per_proc; j++) {
+ for(i=1; i<=E->lmesh.nno; i++) {
+ fprintf(fp, "%.6e\n", E->T[j][i]);
+ }
+ }
+
+ fputs(" </DataArray>\n", fp);
+ return;
+}
+
+
+static void vtk_output_velo(struct All_variables *E, FILE *fp)
+{
+ int i, j;
+ double sint, sinf, cost, cosf;
+ float *V[4];
+ const int lev = E->mesh.levmax;
+
+ fputs(" <DataArray type=\"Float32\" Name=\"velocity\" NumberOfComponents=\"3\" format=\"ascii\">\n", fp);
+
+ for(j=1; j<=E->sphere.caps_per_proc; j++) {
+ V[1] = E->sphere.cap[j].V[1];
+ V[2] = E->sphere.cap[j].V[2];
+ V[3] = E->sphere.cap[j].V[3];
+
+ for(i=1; i<=E->lmesh.nno; i++) {
+ sint = E->SinCos[lev][j][0][i];
+ sinf = E->SinCos[lev][j][1][i];
+ cost = E->SinCos[lev][j][2][i];
+ cosf = E->SinCos[lev][j][3][i];
+
+ fprintf(fp, "%.6e %.6e %.6e\n",
+ V[1][i]*cost*cosf - V[2][i]*sinf + V[3][i]*sint*cosf,
+ V[1][i]*cost*sinf + V[2][i]*cosf + V[3][i]*sint*sinf,
+ -V[1][i]*sint + V[3][i]*cost);
+ }
+ }
+
+ fputs(" </DataArray>\n", fp);
+ return;
+}
+
+
+static void vtk_output_visc(struct All_variables *E, FILE *fp)
+{
+ int i, j;
+ int lev = E->mesh.levmax;
+
+ fputs(" <DataArray type=\"Float32\" Name=\"viscosity\" format=\"ascii\">\n", fp);
+
+ for(j=1; j<=E->sphere.caps_per_proc; j++) {
+ for(i=1; i<=E->lmesh.nno; i++)
+ fprintf(fp, "%.4e\n", E->VI[lev][j][i]);
+ }
+
+ fputs(" </DataArray>\n", fp);
+ return;
+}
+
+
+static void vtk_output_coord(struct All_variables *E, FILE *fp)
+{
+ /* Output Cartesian coordinates as most VTK visualization softwares
+ assume it. */
+ int i, j;
+
+ fputs(" <Points>\n", fp);
+ fputs(" <DataArray type=\"Float32\" Name=\"coordinate\" NumberOfComponents=\"3\" format=\"ascii\">\n", fp);
+
+ for(j=1; j<=E->sphere.caps_per_proc; j++) {
+ for(i=1; i<=E->lmesh.nno; i++)
+ fprintf(fp,"%.6e %.6e %.6e\n",
+ E->x[j][1][i],
+ E->x[j][2][i],
+ E->x[j][3][i]);
+ }
+
+ fputs(" </DataArray>\n", fp);
+ fputs(" </Points>\n", fp);
+
+ return;
+}
+
+
+/**********************************************************************/
+
+void vtk_output(struct All_variables *E, int cycles)
+{
+ char output_file[255];
+ FILE *fp;
+
+ snprintf(output_file, 255, "%s.%d.step%d.vts",
+ E->control.data_file, E->parallel.me, cycles);
+ fp = output_open(output_file, "w");
+
+
+ /* first, write volume data to vts file */
+ vts_file_header(E, fp);
+
+ /* write node-based field */
+ vtk_point_data_header(E, fp);
+ vtk_output_temp(E, fp);
+ vtk_output_velo(E, fp);
+ vtk_output_visc(E, fp);
+ vtk_point_data_trailer(E, fp);
+
+ /* write element-based field */
+ vtk_cell_data_header(E, fp);
+ /**/
+ vtk_cell_data_trailer(E, fp);
+
+ /* write coordinate */
+ vtk_output_coord(E, fp);
+
+ vts_file_trailer(E, fp);
+
+ /* then, write other type of data */
+ //vtk_output_surf_botm(E, );
+
+
+ fclose(fp);
+
+ return;
+}
Deleted: mc/3D/CitcomS/branches/cxx/lib/Pan_problem_misc_functions.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Pan_problem_misc_functions.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Pan_problem_misc_functions.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,689 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-
-#ifdef HAVE_CONFIG_H
-#include "config.h"
-#endif
-
-#include "element_definitions.h"
-#include "global_defs.h"
-
-#include <stdio.h>
-#include <stdlib.h>
-
-#include <math.h>
-#ifdef HAVE_MALLOC_H
-#include <malloc.h>
-#endif
-#include <sys/types.h>
-#include <unistd.h>
-#include <string.h>
-
-#if defined(__sgi) || defined(__osf__)
-#include <sys/types.h>
-#endif
-
-#include "phase_change.h"
-#include "parallel_related.h"
-
-void calc_cbase_at_tp(float , float , float *);
-void rtp2xyz(float , float , float, float *);
-void convert_pvec_to_cvec(float ,float , float , float *,float *);
-void *safe_malloc (size_t );
-void myerror(struct All_variables *,char *);
-void xyz2rtp(float ,float ,float ,float *);
-void xyz2rtpd(float ,float ,float ,double *);
-void get_r_spacing_fine(double *,struct All_variables *);
-void get_r_spacing_at_levels(double *,struct All_variables *);
-void calc_cbase_at_node(int , int , float *,struct All_variables *);
-#ifdef ALLOW_ELLIPTICAL
-double theta_g(double , struct All_variables *);
-#endif
-#ifdef USE_GGRD
-void ggrd_adjust_tbl_rayleigh(struct All_variables *,double **);
-#endif
-
-int get_process_identifier()
-{
- int pid;
-
- pid = (int) getpid();
- return(pid);
-}
-
-
-void unique_copy_file(E,name,comment)
- struct All_variables *E;
- char *name, *comment;
-{
- char unique_name[500];
- char command[600];
-
- if (E->parallel.me==0) {
- sprintf(unique_name,"%06d.%s-%s",E->control.PID,comment,name);
- sprintf(command,"cp -f %s %s\n",name,unique_name);
-#if 0
- /* disable copying file, since some MPI implementation doesn't support it */
- system(command);
-#endif
- }
-
-}
-
-
-void apply_side_sbc(struct All_variables *E)
-{
- /* This function is called only when E->control.side_sbcs is true.
- Purpose: convert the original b.c. data structure, which only supports
- SBC on top/bottom surfaces, to new data structure, which supports
- SBC on all (6) sides
- */
- int i, j, d, m, side, n;
- const unsigned sbc_flags = SBX | SBY | SBZ;
- const unsigned sbc_flag[4] = {0,SBX,SBY,SBZ};
-
- if(E->parallel.total_surf_proc==12) {
- fprintf(stderr, "side_sbc is applicable only in Regional version\n");
- parallel_process_termination();
- }
-
- for(m=1; m<=E->sphere.caps_per_proc; m++) {
- E->sbc.node[m] = (int* ) malloc((E->lmesh.nno+1)*sizeof(int));
-
- n = 1;
- for(i=1; i<=E->lmesh.nno; i++) {
- if(E->node[m][i] & sbc_flags) {
- E->sbc.node[m][i] = n;
- n++;
- }
- else
- E->sbc.node[m][i] = 0;
-
- }
-
- for(side=SIDE_BEGIN; side<=SIDE_END; side++)
- for(d=1; d<=E->mesh.nsd; d++) {
- E->sbc.SB[m][side][d] = (double *) malloc(n*sizeof(double));
-
- for(i=0; i<n; i++)
- E->sbc.SB[m][side][d][i] = 0;
- }
-
- for(d=1; d<=E->mesh.nsd; d++)
- for(i=1; i<=E->lmesh.nno; i++)
- if(E->node[m][i] & sbc_flag[d] && E->sphere.cap[m].VB[d][i] != 0) {
- j = E->sbc.node[m][i];
- for(side=SIDE_BOTTOM; side<=SIDE_TOP; side++)
- E->sbc.SB[m][side][d][j] = E->sphere.cap[m].VB[d][i];
- }
- }
-}
-
-
-void get_buoyancy(struct All_variables *E, double **buoy)
-{
- int i,j,m,n,nz,nxny;
- int lev = E->mesh.levmax;
- double temp,temp2,rfac,cost2;
- void remove_horiz_ave2(struct All_variables*, double**);
- //char filename[100];FILE *out;
-
- nxny = E->lmesh.nox*E->lmesh.noy;
- /* Rayleigh number */
- temp = E->control.Atemp;
-
- /* thermal buoyancy */
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=1;i<=E->lmesh.nno;i++) {
- nz = ((i-1) % E->lmesh.noz) + 1;
- /* We don't need to substract adiabatic T profile from T here,
- * since the horizontal average of buoy will be removed.
- */
- buoy[m][i] = temp * E->refstate.rho[nz]
- * E->refstate.thermal_expansivity[nz] * E->T[m][i];
- }
-
- /* chemical buoyancy */
- if(E->control.tracer &&
- (E->composition.ichemical_buoyancy)) {
- for(j=0;j<E->composition.ncomp;j++) {
- /* TODO: how to scale chemical buoyancy wrt reference density? */
- temp2 = E->composition.buoyancy_ratio[j] * temp;
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=1;i<=E->lmesh.nno;i++)
- buoy[m][i] -= temp2 * E->composition.comp_node[m][j][i];
- }
- }
-#ifdef USE_GGRD
- /* surface layer Rayleigh modification? */
- if(E->control.ggrd.ray_control)
- ggrd_adjust_tbl_rayleigh(E,buoy);
-#endif
- /* phase change buoyancy */
- phase_change_apply_410(E, buoy);
- phase_change_apply_670(E, buoy);
- phase_change_apply_cmb(E, buoy);
-
- /*
- convert density to buoyancy
- */
-#ifdef ALLOW_ELLIPTICAL
- if(E->data.use_rotation_g){
- /*
-
- rotational correction, the if should not add significant
- computational burden
-
- */
- /* g= g_e (1+(5/2m-f) cos^2(theta)) , not theta_g */
- rfac = E->data.ge*(5./2.*E->data.rotm-E->data.ellipticity);
- /* */
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(j=0;j < nxny;j++) {
- for(i=1;i<=E->lmesh.noz;i++)
- n = j*E->lmesh.noz + i; /* this could be improved by only
- computing the cos as a function
- of lat, but leave for now */
- cost2 = cos(E->sx[m][1][n]);cost2 = cost2*cost2; /* cos^2(theta) */
- /* correct gravity for rotation */
- buoy[m][n] *= E->refstate.gravity[i] * (E->data.ge+rfac*cost2);
- }
- }else{
-#endif
- /* default */
- /* no latitude dependency of gravity */
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(j=0;j < nxny;j++) {
- for(i=1;i<=E->lmesh.noz;i++){
- n = j*E->lmesh.noz + i;
- buoy[m][n] *= E->refstate.gravity[i];
- }
- }
-#ifdef ALLOW_ELLIPTICAL
- }
-#endif
-
-
- remove_horiz_ave2(E,buoy);
-
- return;
-}
-
-
-/*
- * Scan input str to get a double vector *values. The vector length is from
- * input len. The input str contains white-space seperated numbers. Return
- * the number of columns read (can be less than len).
- */
-static int scan_double_vector(const char *str, int len, double *values)
-{
- char *nptr, *endptr;
- int i;
-
- /* cast to avoid compiler warning */
- nptr = endptr = (char *) str;
-
- for (i = 0; i < len; ++i) {
- values[i] = strtod(nptr, &endptr);
- if (nptr == endptr) {
- /* error: no conversion is performed */
- return i;
- }
- nptr = endptr;
- }
-
- /** debug **
- for (i = 0; i < len; ++i) fprintf(stderr, "%e, ", values[i]);
- fprintf(stderr, "\n");
- /**/
- return len;
-}
-
-
-/*
- * From input file, read a line, which contains white-space seperated numbers
- * of lenght num_columns, store the numbers in a double array, return the
- * number of columns read (can be less than num_columns).
- */
-int read_double_vector(FILE *in, int num_columns, double *fields)
-{
- char buffer[256], *p;
-
- p = fgets(buffer, 255, in);
- if (!p) {
- return 0;
- }
-
- return scan_double_vector(buffer, num_columns, fields);
-}
-
-
-/* Read in a file containing previous values of a field. The input in the parameter
- file for this should look like: `previous_name_file=string' and `previous_name_column=int'
- where `name' is substituted by the argument of the function.
-
- The file should have the standard CITCOM output format:
- # HEADER LINES etc
- index X Z Y ... field_value1 ...
- index X Z Y ... field_value2 ...
- where index is the node number, X Z Y are the coordinates and
- the field value is in the column specified by the abbr term in the function argument
-
- If the number of nodes OR the XZY coordinates for the node number (to within a small tolerance)
- are not in agreement with the existing mesh, the data is interpolated.
-
- */
-
-int read_previous_field(E,field,name,abbr)
- struct All_variables *E;
- float **field;
- char *name, *abbr;
-{
- int input_string();
-
- char discard[5001];
- char *token;
- char *filename;
- char *input_token;
- FILE *fp;
- int fnodesx,fnodesz,fnodesy;
- int i,j,column,found,m;
-
- float *X,*Z,*Y;
-
- filename=(char *)malloc(500*sizeof(char));
- input_token=(char *)malloc(1000*sizeof(char));
-
- /* Define field name, read parameter file to determine file name and column number */
-
- sprintf(input_token,"previous_%s_file",name);
- if(!input_string(input_token,filename,"initialize",E->parallel.me)) {
- fprintf(E->fp,"No previous %s information found in input file\n",name);fflush(E->fp);
- return(0); /* if not found, take no further action, return zero */
- }
-
-
- fprintf(E->fp,"Previous %s information is in file %s\n",name,filename);fflush(E->fp);
-
- /* Try opening the file, fatal if this fails too */
-
- if((fp=fopen(filename,"r")) == NULL) {
- fprintf(E->fp,"Unable to open the required file `%s' (this is fatal)",filename);
- fflush(E->fp);
-
- parallel_process_termination();
- }
-
-
- /* Read header, get nodes xzy */
-
- fgets(discard,4999,fp);
- fgets(discard,4999,fp);
- i=sscanf(discard,"# NODESX=%d NODESZ=%d NODESY=%d",&fnodesx,&fnodesz,&fnodesy);
- if(i<3) {
- fprintf(E->fp,"File %s is not in the correct format\n",filename);fflush(E->fp);
- exit(1);
- }
-
- fgets(discard,4999,fp); /* largely irrelevant line */
- fgets(discard,4999,fp);
-
- /* this last line is the column headers, we need to search for the occurence of abbr to
- find out the column to be read in */
-
- if(strtok(discard,"|")==NULL) {
- fprintf(E->fp,"Unable to deciphre the columns in the input file");fflush(E->fp);
- exit(1);
- }
-
- found=0;
- column=1;
-
- while(found==0 && (token=strtok(NULL,"|")) != NULL) {
- if(strstr(token,abbr)!=0)
- found=1;
- column++;
- }
-
- if(found) {
- fprintf(E->fp,"\t%s (%s) found in column %d\n",name,abbr,column);fflush(E->fp);
- }
- else {
- fprintf(E->fp,"\t%s (%s) not found in file: %s\n",name,abbr,filename);fflush(E->fp);
- exit(1);
- }
-
-
-
- /* Another fatal condition (not suitable for interpolation: */
- if(((3!= E->mesh.nsd) && (fnodesy !=1)) || ((3==E->mesh.nsd) && (1==fnodesy))) {
- fprintf(E->fp,"Input data for file `%s' is of inappropriate dimension (not %dD)\n",filename,E->mesh.nsd);fflush(E->fp);
- exit(1);
- }
-
- if(fnodesx != E->lmesh.nox || fnodesz != E->lmesh.noz || fnodesy != E->lmesh.noy) {
- fprintf(stderr,"wrong dimension in the input temperature file!!!!\n");
- exit(1);
- }
-
- X=(float *)malloc((2+fnodesx*fnodesz*fnodesy)*sizeof(float));
- Z=(float *)malloc((2+fnodesx*fnodesz*fnodesy)*sizeof(float));
- Y=(float *)malloc((2+fnodesx*fnodesz*fnodesy)*sizeof(float));
-
- /* Format for reading the input file (including coordinates) */
-
- sprintf(input_token," %%d %%e %%e %%e");
- for(i=5;i<column;i++)
- strcat(input_token," %*f");
- strcat(input_token," %f");
-
-
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=1;i<=fnodesx*fnodesz*fnodesy;i++) {
- fgets(discard,4999,fp);
- sscanf(discard,input_token,&j,&(X[i]),&(Z[i]),&(Y[i]),&field[m][i]);
- }
- /* check consistency & need for interpolation */
-
- fclose(fp);
-
-
- free((void *)X);
- free((void *)Z);
- free((void *)Y);
- free((void *)filename);
- free((void *)input_token);
-
- return(1);
-}
-
-
-/* =================================================
- my version of arc tan
- =================================================*/
-
-double myatan(y,x)
- double y,x;
- {
- double fi;
-
- fi = atan2(y,x);
-
- if (fi<0.0)
- fi += 2*M_PI;
-
- return(fi);
- }
-
-
-double return1_test()
-{
- return 1.0;
-}
-
-/* convert r,theta,phi system to cartesian, xout[3]
- there's a double version of this in Tracer_setup called
- sphere_to_cart
-
-*/
-void rtp2xyz(float r, float theta, float phi, float *xout)
-{
- float rst;
- rst = r * sin(theta);
- xout[0] = rst * cos(phi); /* x */
- xout[1] = rst * sin(phi); /* y */
- xout[2] = r * cos(theta);
-}
-void xyz2rtp(float x,float y,float z,float *rout)
-{
- float tmp1,tmp2;
- tmp1 = x*x + y*y;
- tmp2 = tmp1 + z*z;
- rout[0] = sqrt(tmp2); /* r */
- rout[1] = atan2(sqrt(tmp1),z); /* theta */
- rout[2] = atan2(y,x); /* phi */
-}
-void xyz2rtpd(float x,float y,float z,double *rout)
-{
- double tmp1,tmp2;
- tmp1 = (double)x*(double)x + (double)y*(double)y;
- tmp2 = tmp1 + (double)z*(double)z;
- rout[0] = sqrt(tmp2); /* r */
- rout[1] = atan2(sqrt(tmp1),(double)z); /* theta */
- rout[2] = atan2((double)y,(double)x); /* phi */
-}
-
-
-/* compute base vectors for conversion of polar to cartesian vectors
- base[9], i.e. those are the cartesian representation of the r,
- theta, and phi basis vectors at theta, phi
-*/
-void calc_cbase_at_tp(float theta, float phi, float *base)
-{
-
-
- double ct,cp,st,sp;
-
- ct=cos(theta);
- cp=cos(phi);
- st=sin(theta);
- sp=sin(phi);
- /* r */
- base[0]= st * cp;
- base[1]= st * sp;
- base[2]= ct;
- /* theta */
- base[3]= ct * cp;
- base[4]= ct * sp;
- base[5]= -st;
- /* phi */
- base[6]= -sp;
- base[7]= cp;
- base[8]= 0.0;
-}
-
-/* calculate base at nodal locations where we have precomputed cos/sin */
-
-void calc_cbase_at_node(int cap, int node, float *base,struct All_variables *E)
-{
- int lev ;
- double ct,cp,st,sp;
- lev = E->mesh.levmax;
- st = E->SinCos[lev][cap][0][node]; /* for elliptical, sincos would be corrected */
- sp = E->SinCos[lev][cap][1][node];
- ct = E->SinCos[lev][cap][2][node];
- cp = E->SinCos[lev][cap][3][node];
-
- /* r */
- base[0]= st * cp;
- base[1]= st * sp;
- base[2]= ct;
- /* theta */
- base[3]= ct * cp;
- base[4]= ct * sp;
- base[5]= -st;
- /* phi */
- base[6]= -sp;
- base[7]= cp;
- base[8]= 0.0;
-}
-
-/* given a base from calc_cbase_at_tp, convert a polar vector to
- cartesian */
-void convert_pvec_to_cvec(float vr,float vt,
- float vp, float *base,
- float *cvec)
-{
- int i;
- for(i=0;i<3;i++){
- cvec[i] = base[i] * vr;
- cvec[i] += base[3+i]* vt;
- cvec[i] += base[6+i]* vp;
- }
-}
-/*
- like malloc, but with test
-
- similar to Malloc1 but I didn't like the int as argument
-
-*/
-void *safe_malloc (size_t size)
-{
- void *tmp;
-
- if ((tmp = malloc(size)) == NULL) {
- fprintf(stderr, "safe_malloc: could not allocate memory, %.3f MB\n",
- (float)size/(1024*1024.));
- parallel_process_termination();
- }
- return (tmp);
-}
-/* error handling routine, TWB */
-
-void myerror(struct All_variables *E,char *message)
-{
- void record();
-
- E->control.verbose = 1;
- record(E,message);
- fprintf(stderr,"node %3i: error: %s\n",
- E->parallel.me,message);
- parallel_process_termination();
-}
-
-
-
-/*
-
-
-
-attempt to space rr[1...nz] such that bfrac*nz nodes will be within the lower
-brange fraction of (ro-ri), and similar for the top layer
-
-function below is more general
-
-*/
-void get_r_spacing_fine(double *rr, struct All_variables *E)
-{
- int k,klim,nb,nt,nm;
- double drb,dr0,drt,dr,drm,range,r,mrange, brange,bfrac,trange, tfrac;
-
- brange = (double)E->control.coor_refine[0];
- bfrac = (double)E->control.coor_refine[1];
- trange = (double)E->control.coor_refine[2];
- tfrac = (double)E->control.coor_refine[3];
-
- range = (double) E->sphere.ro - E->sphere.ri; /* original range */
-
- mrange = 1 - brange - trange;
- if(mrange <= 0)
- myerror(E,"get_r_spacing_fine: bottom and top range too large");
-
- brange *= range; /* bottom */
- trange *= range; /* top */
- mrange *= range; /* middle */
-
- nb = E->mesh.noz * bfrac;
- nt = E->mesh.noz * tfrac;
- nm = E->mesh.noz - nb - nt;
- if((nm < 1)||(nt < 2)||(nb < 2))
- myerror(E,"get_r_spacing_fine: refinement out of bounds");
-
- drb = brange/(nb-1);
- drt = trange/(nt-1);
- drm = mrange / (nm + 1);
-
- for(r=E->sphere.ri,k=1;k<=nb;k++,r+=drb){
- rr[k] = r;
- }
- klim = E->mesh.noz - nt + 1;
- for(r=r-drb+drm;k < klim;k++,r+=drm){
- rr[k] = r;
- }
- for(;k <= E->mesh.noz;k++,r+=drt){
- rr[k] = r;
- }
-}
-/*
-
-
-get r spacing at radial locations and node numbers as specified
-CitcomCU style
-
-rr[1...E->mesh.noz]
-
-
-e.g.:
-
- r_grid_layers=3 # minus 1 is number of layers with uniform grid in r
- rr=0.5,0.75,1.0 # starting and ending r coodinates
- nr=1,37,97 # starting and ending node in r direction
-
-*/
-void get_r_spacing_at_levels(double *rr,struct All_variables *E)
-{
- double ddr;
- int k,j;
- /* do some sanity checks */
- if(E->control.nrlayer[0] != 1)
- myerror(E,"first node for coor=3 should be unity");
- if(E->control.nrlayer[E->control.rlayers-1] != E->mesh.noz)
- myerror(E,"last node for coor = 3 input should match max nr z nodes");
- if(fabs(E->control.rrlayer[0] -E->sphere.ri) > 1e-5)
- myerror(E,"inner layer for coor=3 input should be inner radius");
- if(fabs(E->control.rrlayer[ E->control.rlayers-1] - E->sphere.ro)>1e-6)
- myerror(E,"outer layer for coor=3 input should be inner radius");
- if(E->control.rlayers < 2)
- myerror(E,"number of rlayers needs to be at leats two for coor = 3");
-
- rr[1] = E->control.rrlayer[0];
- for(j = 1; j < E->control.rlayers; j++){
- ddr = (E->control.rrlayer[j] - E->control.rrlayer[j - 1]) /
- (E->control.nrlayer[j] - E->control.nrlayer[j - 1]);
- for(k = E->control.nrlayer[j-1]+1;k <= E->control.nrlayer[j];k++)
- rr[k] = rr[k-1]+ddr;
- }
-
-}
-
-#ifdef ALLOW_ELLIPTICAL
-/* correct from spherical coordinate system theta to an ellipsoidal
- theta_g which corresponds to the local base vector direction in
- theta */
-double theta_g(double theta, struct All_variables *E)
-{
- double tmp;
-
- if(E->data.use_ellipse){
- tmp = M_PI_2 - theta;
- return M_PI_2 - atan2(tan(tmp),E->data.efac);
- }else{
- return theta;
- }
-}
-#endif
Copied: mc/3D/CitcomS/branches/cxx/lib/Pan_problem_misc_functions.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Pan_problem_misc_functions.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Pan_problem_misc_functions.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Pan_problem_misc_functions.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,688 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+
+#include "element_definitions.h"
+#include "global_defs.h"
+
+#include <stdio.h>
+#include <stdlib.h>
+
+#include <math.h>
+#ifdef HAVE_MALLOC_H
+#include <malloc.h>
+#endif
+#include <sys/types.h>
+#include <unistd.h>
+#include <string.h>
+
+#if defined(__sgi) || defined(__osf__)
+#include <sys/types.h>
+#endif
+
+#include "phase_change.h"
+#include "parallel_related.h"
+
+#include "cproto.h"
+
+void calc_cbase_at_tp(float , float , float *);
+void rtp2xyz(float , float , float, float *);
+void convert_pvec_to_cvec(float ,float , float , float *,float *);
+void *safe_malloc (size_t );
+void myerror(struct All_variables *,char *);
+void xyz2rtp(float ,float ,float ,float *);
+void xyz2rtpd(float ,float ,float ,double *);
+void get_r_spacing_fine(double *,struct All_variables *);
+void get_r_spacing_at_levels(double *,struct All_variables *);
+void calc_cbase_at_node(int , int , float *,struct All_variables *);
+#ifdef ALLOW_ELLIPTICAL
+double theta_g(double , struct All_variables *);
+#endif
+#ifdef USE_GGRD
+void ggrd_adjust_tbl_rayleigh(struct All_variables *,double **);
+#endif
+
+int get_process_identifier()
+{
+ int pid;
+
+ pid = (int) getpid();
+ return(pid);
+}
+
+
+void unique_copy_file(
+ struct All_variables *E,
+ char *name, char *comment
+ )
+{
+ char unique_name[500];
+ char command[600];
+
+ if (E->parallel.me==0) {
+ sprintf(unique_name,"%06d.%s-%s",E->control.PID,comment,name);
+ sprintf(command,"cp -f %s %s\n",name,unique_name);
+#if 0
+ /* disable copying file, since some MPI implementation doesn't support it */
+ system(command);
+#endif
+ }
+
+}
+
+
+void apply_side_sbc(struct All_variables *E)
+{
+ /* This function is called only when E->control.side_sbcs is true.
+ Purpose: convert the original b.c. data structure, which only supports
+ SBC on top/bottom surfaces, to new data structure, which supports
+ SBC on all (6) sides
+ */
+ int i, j, d, m, side, n;
+ const unsigned sbc_flags = SBX | SBY | SBZ;
+ const unsigned sbc_flag[4] = {0,SBX,SBY,SBZ};
+
+ if(E->parallel.total_surf_proc==12) {
+ fprintf(stderr, "side_sbc is applicable only in Regional version\n");
+ parallel_process_termination();
+ }
+
+ for(m=1; m<=E->sphere.caps_per_proc; m++) {
+ E->sbc.node[m] = (int* ) malloc((E->lmesh.nno+1)*sizeof(int));
+
+ n = 1;
+ for(i=1; i<=E->lmesh.nno; i++) {
+ if(E->node[m][i] & sbc_flags) {
+ E->sbc.node[m][i] = n;
+ n++;
+ }
+ else
+ E->sbc.node[m][i] = 0;
+
+ }
+
+ for(side=SIDE_BEGIN; side<=SIDE_END; side++)
+ for(d=1; d<=E->mesh.nsd; d++) {
+ E->sbc.SB[m][side][d] = (double *) malloc(n*sizeof(double));
+
+ for(i=0; i<n; i++)
+ E->sbc.SB[m][side][d][i] = 0;
+ }
+
+ for(d=1; d<=E->mesh.nsd; d++)
+ for(i=1; i<=E->lmesh.nno; i++)
+ if(E->node[m][i] & sbc_flag[d] && E->sphere.cap[m].VB[d][i] != 0) {
+ j = E->sbc.node[m][i];
+ for(side=SIDE_BOTTOM; side<=SIDE_TOP; side++)
+ E->sbc.SB[m][side][d][j] = E->sphere.cap[m].VB[d][i];
+ }
+ }
+}
+
+
+void get_buoyancy(struct All_variables *E, double **buoy)
+{
+ int i,j,m,n,nz,nxny;
+ int lev = E->mesh.levmax;
+ double temp,temp2,rfac,cost2;
+ void remove_horiz_ave2(struct All_variables*, double**);
+ //char filename[100];FILE *out;
+
+ nxny = E->lmesh.nox*E->lmesh.noy;
+ /* Rayleigh number */
+ temp = E->control.Atemp;
+
+ /* thermal buoyancy */
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=1;i<=E->lmesh.nno;i++) {
+ nz = ((i-1) % E->lmesh.noz) + 1;
+ /* We don't need to substract adiabatic T profile from T here,
+ * since the horizontal average of buoy will be removed.
+ */
+ buoy[m][i] = temp * E->refstate.rho[nz]
+ * E->refstate.thermal_expansivity[nz] * E->T[m][i];
+ }
+
+ /* chemical buoyancy */
+ if(E->control.tracer &&
+ (E->composition.ichemical_buoyancy)) {
+ for(j=0;j<E->composition.ncomp;j++) {
+ /* TODO: how to scale chemical buoyancy wrt reference density? */
+ temp2 = E->composition.buoyancy_ratio[j] * temp;
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=1;i<=E->lmesh.nno;i++)
+ buoy[m][i] -= temp2 * E->composition.comp_node[m][j][i];
+ }
+ }
+#ifdef USE_GGRD
+ /* surface layer Rayleigh modification? */
+ if(E->control.ggrd.ray_control)
+ ggrd_adjust_tbl_rayleigh(E,buoy);
+#endif
+ /* phase change buoyancy */
+ phase_change_apply_410(E, buoy);
+ phase_change_apply_670(E, buoy);
+ phase_change_apply_cmb(E, buoy);
+
+ /*
+ convert density to buoyancy
+ */
+#ifdef ALLOW_ELLIPTICAL
+ if(E->data.use_rotation_g){
+ /*
+
+ rotational correction, the if should not add significant
+ computational burden
+
+ */
+ /* g= g_e (1+(5/2m-f) cos^2(theta)) , not theta_g */
+ rfac = E->data.ge*(5./2.*E->data.rotm-E->data.ellipticity);
+ /* */
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(j=0;j < nxny;j++) {
+ for(i=1;i<=E->lmesh.noz;i++)
+ n = j*E->lmesh.noz + i; /* this could be improved by only
+ computing the cos as a function
+ of lat, but leave for now */
+ cost2 = cos(E->sx[m][1][n]);cost2 = cost2*cost2; /* cos^2(theta) */
+ /* correct gravity for rotation */
+ buoy[m][n] *= E->refstate.gravity[i] * (E->data.ge+rfac*cost2);
+ }
+ }else{
+#endif
+ /* default */
+ /* no latitude dependency of gravity */
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(j=0;j < nxny;j++) {
+ for(i=1;i<=E->lmesh.noz;i++){
+ n = j*E->lmesh.noz + i;
+ buoy[m][n] *= E->refstate.gravity[i];
+ }
+ }
+#ifdef ALLOW_ELLIPTICAL
+ }
+#endif
+
+
+ remove_horiz_ave2(E,buoy);
+
+ return;
+}
+
+
+/*
+ * Scan input str to get a double vector *values. The vector length is from
+ * input len. The input str contains white-space seperated numbers. Return
+ * the number of columns read (can be less than len).
+ */
+static int scan_double_vector(const char *str, int len, double *values)
+{
+ char *nptr, *endptr;
+ int i;
+
+ /* cast to avoid compiler warning */
+ nptr = endptr = (char *) str;
+
+ for (i = 0; i < len; ++i) {
+ values[i] = strtod(nptr, &endptr);
+ if (nptr == endptr) {
+ /* error: no conversion is performed */
+ return i;
+ }
+ nptr = endptr;
+ }
+
+ /** debug **
+ for (i = 0; i < len; ++i) fprintf(stderr, "%e, ", values[i]);
+ fprintf(stderr, "\n");
+ /**/
+ return len;
+}
+
+
+/*
+ * From input file, read a line, which contains white-space seperated numbers
+ * of lenght num_columns, store the numbers in a double array, return the
+ * number of columns read (can be less than num_columns).
+ */
+int read_double_vector(FILE *in, int num_columns, double *fields)
+{
+ char buffer[256], *p;
+
+ p = fgets(buffer, 255, in);
+ if (!p) {
+ return 0;
+ }
+
+ return scan_double_vector(buffer, num_columns, fields);
+}
+
+
+/* Read in a file containing previous values of a field. The input in the parameter
+ file for this should look like: `previous_name_file=string' and `previous_name_column=int'
+ where `name' is substituted by the argument of the function.
+
+ The file should have the standard CITCOM output format:
+ # HEADER LINES etc
+ index X Z Y ... field_value1 ...
+ index X Z Y ... field_value2 ...
+ where index is the node number, X Z Y are the coordinates and
+ the field value is in the column specified by the abbr term in the function argument
+
+ If the number of nodes OR the XZY coordinates for the node number (to within a small tolerance)
+ are not in agreement with the existing mesh, the data is interpolated.
+
+ */
+
+int read_previous_field(
+ struct All_variables *E,
+ float **field,
+ char *name, char *abbr
+ )
+{
+ char discard[5001];
+ char *token;
+ char *filename;
+ char *input_token;
+ FILE *fp;
+ int fnodesx,fnodesz,fnodesy;
+ int i,j,column,found,m;
+
+ float *X,*Z,*Y;
+
+ filename=(char *)malloc(500*sizeof(char));
+ input_token=(char *)malloc(1000*sizeof(char));
+
+ /* Define field name, read parameter file to determine file name and column number */
+
+ sprintf(input_token,"previous_%s_file",name);
+ if(!input_string(input_token,filename,"initialize",E->parallel.me)) {
+ fprintf(E->fp,"No previous %s information found in input file\n",name);fflush(E->fp);
+ return(0); /* if not found, take no further action, return zero */
+ }
+
+
+ fprintf(E->fp,"Previous %s information is in file %s\n",name,filename);fflush(E->fp);
+
+ /* Try opening the file, fatal if this fails too */
+
+ if((fp=fopen(filename,"r")) == NULL) {
+ fprintf(E->fp,"Unable to open the required file `%s' (this is fatal)",filename);
+ fflush(E->fp);
+
+ parallel_process_termination();
+ }
+
+
+ /* Read header, get nodes xzy */
+
+ fgets(discard,4999,fp);
+ fgets(discard,4999,fp);
+ i=sscanf(discard,"# NODESX=%d NODESZ=%d NODESY=%d",&fnodesx,&fnodesz,&fnodesy);
+ if(i<3) {
+ fprintf(E->fp,"File %s is not in the correct format\n",filename);fflush(E->fp);
+ exit(1);
+ }
+
+ fgets(discard,4999,fp); /* largely irrelevant line */
+ fgets(discard,4999,fp);
+
+ /* this last line is the column headers, we need to search for the occurence of abbr to
+ find out the column to be read in */
+
+ if(strtok(discard,"|")==NULL) {
+ fprintf(E->fp,"Unable to deciphre the columns in the input file");fflush(E->fp);
+ exit(1);
+ }
+
+ found=0;
+ column=1;
+
+ while(found==0 && (token=strtok(NULL,"|")) != NULL) {
+ if(strstr(token,abbr)!=0)
+ found=1;
+ column++;
+ }
+
+ if(found) {
+ fprintf(E->fp,"\t%s (%s) found in column %d\n",name,abbr,column);fflush(E->fp);
+ }
+ else {
+ fprintf(E->fp,"\t%s (%s) not found in file: %s\n",name,abbr,filename);fflush(E->fp);
+ exit(1);
+ }
+
+
+
+ /* Another fatal condition (not suitable for interpolation: */
+ if(((3!= E->mesh.nsd) && (fnodesy !=1)) || ((3==E->mesh.nsd) && (1==fnodesy))) {
+ fprintf(E->fp,"Input data for file `%s' is of inappropriate dimension (not %dD)\n",filename,E->mesh.nsd);fflush(E->fp);
+ exit(1);
+ }
+
+ if(fnodesx != E->lmesh.nox || fnodesz != E->lmesh.noz || fnodesy != E->lmesh.noy) {
+ fprintf(stderr,"wrong dimension in the input temperature file!!!!\n");
+ exit(1);
+ }
+
+ X=(float *)malloc((2+fnodesx*fnodesz*fnodesy)*sizeof(float));
+ Z=(float *)malloc((2+fnodesx*fnodesz*fnodesy)*sizeof(float));
+ Y=(float *)malloc((2+fnodesx*fnodesz*fnodesy)*sizeof(float));
+
+ /* Format for reading the input file (including coordinates) */
+
+ sprintf(input_token," %%d %%e %%e %%e");
+ for(i=5;i<column;i++)
+ strcat(input_token," %*f");
+ strcat(input_token," %f");
+
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=1;i<=fnodesx*fnodesz*fnodesy;i++) {
+ fgets(discard,4999,fp);
+ sscanf(discard,input_token,&j,&(X[i]),&(Z[i]),&(Y[i]),&field[m][i]);
+ }
+ /* check consistency & need for interpolation */
+
+ fclose(fp);
+
+
+ free((void *)X);
+ free((void *)Z);
+ free((void *)Y);
+ free((void *)filename);
+ free((void *)input_token);
+
+ return(1);
+}
+
+
+/* =================================================
+ my version of arc tan
+ =================================================*/
+
+double myatan(double y, double x)
+ {
+ double fi;
+
+ fi = atan2(y,x);
+
+ if (fi<0.0)
+ fi += 2*M_PI;
+
+ return(fi);
+ }
+
+
+double return1_test()
+{
+ return 1.0;
+}
+
+/* convert r,theta,phi system to cartesian, xout[3]
+ there's a double version of this in Tracer_setup called
+ sphere_to_cart
+
+*/
+void rtp2xyz(float r, float theta, float phi, float *xout)
+{
+ float rst;
+ rst = r * sin(theta);
+ xout[0] = rst * cos(phi); /* x */
+ xout[1] = rst * sin(phi); /* y */
+ xout[2] = r * cos(theta);
+}
+void xyz2rtp(float x,float y,float z,float *rout)
+{
+ float tmp1,tmp2;
+ tmp1 = x*x + y*y;
+ tmp2 = tmp1 + z*z;
+ rout[0] = sqrt(tmp2); /* r */
+ rout[1] = atan2(sqrt(tmp1),z); /* theta */
+ rout[2] = atan2(y,x); /* phi */
+}
+void xyz2rtpd(float x,float y,float z,double *rout)
+{
+ double tmp1,tmp2;
+ tmp1 = (double)x*(double)x + (double)y*(double)y;
+ tmp2 = tmp1 + (double)z*(double)z;
+ rout[0] = sqrt(tmp2); /* r */
+ rout[1] = atan2(sqrt(tmp1),(double)z); /* theta */
+ rout[2] = atan2((double)y,(double)x); /* phi */
+}
+
+
+/* compute base vectors for conversion of polar to cartesian vectors
+ base[9], i.e. those are the cartesian representation of the r,
+ theta, and phi basis vectors at theta, phi
+*/
+void calc_cbase_at_tp(float theta, float phi, float *base)
+{
+
+
+ double ct,cp,st,sp;
+
+ ct=cos(theta);
+ cp=cos(phi);
+ st=sin(theta);
+ sp=sin(phi);
+ /* r */
+ base[0]= st * cp;
+ base[1]= st * sp;
+ base[2]= ct;
+ /* theta */
+ base[3]= ct * cp;
+ base[4]= ct * sp;
+ base[5]= -st;
+ /* phi */
+ base[6]= -sp;
+ base[7]= cp;
+ base[8]= 0.0;
+}
+
+/* calculate base at nodal locations where we have precomputed cos/sin */
+
+void calc_cbase_at_node(int cap, int node, float *base,struct All_variables *E)
+{
+ int lev ;
+ double ct,cp,st,sp;
+ lev = E->mesh.levmax;
+ st = E->SinCos[lev][cap][0][node]; /* for elliptical, sincos would be corrected */
+ sp = E->SinCos[lev][cap][1][node];
+ ct = E->SinCos[lev][cap][2][node];
+ cp = E->SinCos[lev][cap][3][node];
+
+ /* r */
+ base[0]= st * cp;
+ base[1]= st * sp;
+ base[2]= ct;
+ /* theta */
+ base[3]= ct * cp;
+ base[4]= ct * sp;
+ base[5]= -st;
+ /* phi */
+ base[6]= -sp;
+ base[7]= cp;
+ base[8]= 0.0;
+}
+
+/* given a base from calc_cbase_at_tp, convert a polar vector to
+ cartesian */
+void convert_pvec_to_cvec(float vr,float vt,
+ float vp, float *base,
+ float *cvec)
+{
+ int i;
+ for(i=0;i<3;i++){
+ cvec[i] = base[i] * vr;
+ cvec[i] += base[3+i]* vt;
+ cvec[i] += base[6+i]* vp;
+ }
+}
+/*
+ like malloc, but with test
+
+ similar to Malloc1 but I didn't like the int as argument
+
+*/
+void *safe_malloc (size_t size)
+{
+ void *tmp;
+
+ if ((tmp = malloc(size)) == NULL) {
+ fprintf(stderr, "safe_malloc: could not allocate memory, %.3f MB\n",
+ (float)size/(1024*1024.));
+ parallel_process_termination();
+ }
+ return (tmp);
+}
+/* error handling routine, TWB */
+
+void myerror(struct All_variables *E,char *message)
+{
+ E->control.verbose = 1;
+ record(E,message);
+ fprintf(stderr,"node %3i: error: %s\n",
+ E->parallel.me,message);
+ parallel_process_termination();
+}
+
+
+
+/*
+
+
+
+attempt to space rr[1...nz] such that bfrac*nz nodes will be within the lower
+brange fraction of (ro-ri), and similar for the top layer
+
+function below is more general
+
+*/
+void get_r_spacing_fine(double *rr, struct All_variables *E)
+{
+ int k,klim,nb,nt,nm;
+ double drb,dr0,drt,dr,drm,range,r,mrange, brange,bfrac,trange, tfrac;
+
+ brange = (double)E->control.coor_refine[0];
+ bfrac = (double)E->control.coor_refine[1];
+ trange = (double)E->control.coor_refine[2];
+ tfrac = (double)E->control.coor_refine[3];
+
+ range = (double) E->sphere.ro - E->sphere.ri; /* original range */
+
+ mrange = 1 - brange - trange;
+ if(mrange <= 0)
+ myerror(E,"get_r_spacing_fine: bottom and top range too large");
+
+ brange *= range; /* bottom */
+ trange *= range; /* top */
+ mrange *= range; /* middle */
+
+ nb = (int)(E->mesh.noz * bfrac);
+ nt = (int)(E->mesh.noz * tfrac);
+ nm = E->mesh.noz - nb - nt;
+ if((nm < 1)||(nt < 2)||(nb < 2))
+ myerror(E,"get_r_spacing_fine: refinement out of bounds");
+
+ drb = brange/(nb-1);
+ drt = trange/(nt-1);
+ drm = mrange / (nm + 1);
+
+ for(r=E->sphere.ri,k=1;k<=nb;k++,r+=drb){
+ rr[k] = r;
+ }
+ klim = E->mesh.noz - nt + 1;
+ for(r=r-drb+drm;k < klim;k++,r+=drm){
+ rr[k] = r;
+ }
+ for(;k <= E->mesh.noz;k++,r+=drt){
+ rr[k] = r;
+ }
+}
+/*
+
+
+get r spacing at radial locations and node numbers as specified
+CitcomCU style
+
+rr[1...E->mesh.noz]
+
+
+e.g.:
+
+ r_grid_layers=3 # minus 1 is number of layers with uniform grid in r
+ rr=0.5,0.75,1.0 # starting and ending r coodinates
+ nr=1,37,97 # starting and ending node in r direction
+
+*/
+void get_r_spacing_at_levels(double *rr,struct All_variables *E)
+{
+ double ddr;
+ int k,j;
+ /* do some sanity checks */
+ if(E->control.nrlayer[0] != 1)
+ myerror(E,"first node for coor=3 should be unity");
+ if(E->control.nrlayer[E->control.rlayers-1] != E->mesh.noz)
+ myerror(E,"last node for coor = 3 input should match max nr z nodes");
+ if(fabs(E->control.rrlayer[0] -E->sphere.ri) > 1e-5)
+ myerror(E,"inner layer for coor=3 input should be inner radius");
+ if(fabs(E->control.rrlayer[ E->control.rlayers-1] - E->sphere.ro)>1e-6)
+ myerror(E,"outer layer for coor=3 input should be inner radius");
+ if(E->control.rlayers < 2)
+ myerror(E,"number of rlayers needs to be at leats two for coor = 3");
+
+ rr[1] = E->control.rrlayer[0];
+ for(j = 1; j < E->control.rlayers; j++){
+ ddr = (E->control.rrlayer[j] - E->control.rrlayer[j - 1]) /
+ (E->control.nrlayer[j] - E->control.nrlayer[j - 1]);
+ for(k = E->control.nrlayer[j-1]+1;k <= E->control.nrlayer[j];k++)
+ rr[k] = rr[k-1]+ddr;
+ }
+
+}
+
+#ifdef ALLOW_ELLIPTICAL
+/* correct from spherical coordinate system theta to an ellipsoidal
+ theta_g which corresponds to the local base vector direction in
+ theta */
+double theta_g(double theta, struct All_variables *E)
+{
+ double tmp;
+
+ if(E->data.use_ellipse){
+ tmp = M_PI_2 - theta;
+ return M_PI_2 - atan2(tan(tmp),E->data.efac);
+ }else{
+ return theta;
+ }
+}
+#endif
Deleted: mc/3D/CitcomS/branches/cxx/lib/Parallel_util.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Parallel_util.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Parallel_util.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,66 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-
-
-#include <mpi.h>
-#include <stdlib.h>
-#include "global_defs.h"
-
-/* ============================================ */
-/* ============================================ */
-
-void parallel_process_termination()
-{
-
- MPI_Finalize();
- exit(8);
- return;
- }
-
-/* ============================================ */
-/* ============================================ */
-
-void parallel_process_sync(struct All_variables *E)
-{
-
- MPI_Barrier(E->parallel.world);
- return;
- }
-
-
-/* ========================== */
-
- double CPU_time0()
-{
- double time, MPI_Wtime();
- time = MPI_Wtime();
- return (time);
-}
-
-
-/* End of file */
Copied: mc/3D/CitcomS/branches/cxx/lib/Parallel_util.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Parallel_util.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Parallel_util.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Parallel_util.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,66 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+
+
+#include <mpi.h>
+#include <stdlib.h>
+#include "global_defs.h"
+
+/* ============================================ */
+/* ============================================ */
+
+void parallel_process_termination()
+{
+
+ MPI_Finalize();
+ exit(8);
+ return;
+ }
+
+/* ============================================ */
+/* ============================================ */
+
+void parallel_process_sync(struct All_variables *E)
+{
+
+ MPI_Barrier(E->parallel.world);
+ return;
+ }
+
+
+/* ========================== */
+
+ double CPU_time0()
+{
+ double time;
+ time = MPI_Wtime();
+ return (time);
+}
+
+
+/* End of file */
Deleted: mc/3D/CitcomS/branches/cxx/lib/Parsing.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Parsing.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Parsing.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,840 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-/* Routines which read filenames from the command line and
- then parse the contents as parameters for citcom */
-
-#include <stdio.h>
-#include <sys/types.h>
-#ifndef __sunos__
-#include <strings.h>
-#else
-#include <string.h>
-#endif
-#include "global_defs.h"
-#include "parsing.h"
-
-#define MAXLINE 1024 /* max length of line in input file */
-#define MAXNAME 64 /* max length of name */
-#define MAXVALUE 1024 /* max length of value */
-#define MAXFILENAME 64 /* max length of par file name */
-#define MAXVECTOR 10 /* max # of elements for unspecified vectors */
-#define STRANGE_NUM -98765.4321
-
-/* abbreviations: */
-#define AL struct arglist
-#define PROGNAME ext_par.progname
-#define FLAGS ext_par.argflags
-#define ARGLIST ext_par.arglist
-#define ARGHEAD ext_par.arghead
-#define ARGBUF ext_par.argbuf
-#define NLIST ext_par.nlist
-#define NBUF ext_par.nbuf
-#define LISTMAX ext_par.listmax
-#define BUFMAX ext_par.bufmax
-#define LISTFILE ext_par.listout
-
-#define LISTINC 32 /* increment size for arglist */
-#define BUFINC 1024 /* increment size for argbuf */
-
-struct ext_par /* global variables for getpar */
-{
- char *progname;
- int argflags;
- struct arglist *arglist;
- struct arglist *arghead;
- char *argbuf;
- int nlist;
- int nbuf;
- int listmax;
- int bufmax;
- FILE *listout;
-} ext_par;
-
-struct arglist /* structure of list set up by setpar */
-{
- int argname_offset;
- int argval_offset;
- int hash;
-};
-
-int VERBOSE = 0;
-int DESCRIBE = 0;
-int BEGINNER = 0;
-
-int interpret_control_string();
-
-
-void setup_parser(E,filename)
- struct All_variables *E;
- char *filename;
-{
- void unique_copy_file();
- void add_to_parameter_list();
-
- FILE * fp;
- char *pl,*pn,*pv;
- char t1, t2, line[MAXLINE], name[MAXNAME], value[MAXVALUE];
- int i,j,k;
- int m=E->parallel.me;
-
- /* should get file length & cpp &c before any further parsing */
-
- /* for now, read one filename from the command line, we'll parse that ! */
-
-
- /* this section moved to main() */
-/* if (ac < 2) { */
-/* fprintf(stderr,"Usage: citcom PARAMETERFILE\n"); */
-/* exit(10); */
-/* } */
-
-
- if ((fp = fopen(filename,"r")) == NULL) {
- fprintf(stderr,"(Parsing #1) File: %s is unreadable\n",filename);
- exit(11);
- }
-
-
-
- /* now the parameter file is open, read into memory */
-
- while( fgets(line,MAXLINE,fp) != NULL )
- { pl= line;
- /* loop over entries on each line */
- loop:
- while(*pl==' ' || *pl=='\t') pl++;
- if(*pl=='\0'|| *pl=='\n') continue; /* end of line */
- if(*pl=='#') continue; /* end of interpretable part of line */
-
- /* get name */
- pn= name;
- while(*pl != '=' && *pl != '\0' && *pl != ' '
- && *pl != '\n' /* FIX by Glenn Nelson */
- && *pl != '\t')
- *pn++ = *pl++;
- *pn = '\0';
- if(*pl == '=') pl++;
-
- /* get value */
- *value= '\0';
- pv= value;
- if(*pl=='"' || *pl=='\'')
- t1= t2= *pl++;
- else
- { t1= ' ';
- t2= '\t';
- }
- while(*pl!=t1 && *pl!=t2 &&
- *pl!='\0' && *pl!='\n') *pv++= *pl++;
- *pv= '\0';
- if(*pl=='"' || *pl=='\'')
- pl++;
- add_to_parameter_list(name,value);
-
- goto loop;
- }
-
- fclose(fp);
-
- ARGHEAD= ARGLIST;
-
- /* Now we can use our routines to check & set their own flags ! */
-
- input_boolean("VERBOSE",&i,"off",m);
- input_boolean("DESCRIBE",&j,"off",m);
- input_boolean("BEGINNER",&k,"off",m);
- VERBOSE=i;
- DESCRIBE=j;
- BEGINNER=k;
-
- /* make this an optional behavior */
- input_boolean("copy_input_file",&k,"on",m);
- if(k)
- unique_copy_file(E,filename,"copy");
-
-
-}
-
-void shutdown_parser(E)
- struct All_variables *E;
-
-{
- if(ARGLIST != NULL) free(ARGLIST);
- if(ARGBUF != NULL) free(ARGBUF);
- ARGBUF= NULL;
- ARGLIST= NULL;
-
-}
-
-
-/* add an entry to arglist, expanding memory */
-void add_to_parameter_list(name,value)
- char *name, *value; /* if necessary */
-{
- struct arglist *alptr;
- int len;
- char *ptr;
- int compute_parameter_hash_table();
-
- /* check arglist memory */
- if(NLIST >= LISTMAX)
- { LISTMAX += LISTINC;
- if(ARGLIST == NULL)
- ARGLIST= (AL *)malloc(LISTMAX * sizeof(AL));
- else
- ARGLIST= (AL *)realloc(ARGLIST,LISTMAX * sizeof(AL));
- }
- /* check argbuf memory */
- len= strlen(name) + strlen(value) + 2; /* +2 for terminating nulls */
- if(NBUF+len >= BUFMAX)
- { BUFMAX += BUFINC;
- if(ARGBUF == NULL)
- ARGBUF= (char *)malloc(BUFMAX);
- else ARGBUF= (char *)realloc(ARGBUF,BUFMAX);
- }
- if(ARGBUF == NULL || ARGLIST == NULL)
- fprintf(stderr,"cannot allocate memory\n");
-
- /* add name */
- alptr= ARGLIST + NLIST;
- alptr->hash= compute_parameter_hash_table(name);
- alptr->argname_offset = NBUF;
- ptr= ARGBUF + NBUF;
- do
- *ptr++ = *name;
- while(*name++);
-
- /* add value */
- NBUF += len;
- alptr->argval_offset= ptr - ARGBUF;
- do
- *ptr++ = *value;
- while(*value++);
- NLIST++;
-}
-
-int compute_parameter_hash_table(s)
- char *s;
-{ int h;
-
- h= s[0];
- if(s[1])
- h |= (s[1])<<8;
- else
- return(h);
- if(s[2])
- h |= (s[2])<<16;
- else
- return(h);
- if(s[3])
- h |= (s[3])<<24;
- return(h);
-}
-
-int input_int(name,value,interpret,m)
- char *name;
- int *value;
- char *interpret;
- int m;
-
-{
- struct arglist *alptr;
- int h, found;
- char *str;
-
- int exists,essential;
- double Default,minvalue,maxvalue;
-
- if(m==0)
- if(DESCRIBE)
- fprintf(stderr,"input_int: searching for '%s' with default/range '%s'\n",
- name,(interpret == NULL) ? "**EMPTY**" : interpret);
-
- exists = interpret_control_string(interpret,&essential,&Default,&minvalue,&maxvalue);
-
- *value = (int)(Default);
-
- h=compute_parameter_hash_table(name);
- found=0;
-
- /* search list backwards, stopping at first find */
- for(alptr= ARGLIST +(NLIST-1); alptr >= ARGHEAD; alptr--)
- { if(alptr->hash != h)
- continue;
- if(strcmp(ARGBUF+alptr->argname_offset,name) != 0)
- continue;
-
- str= ARGBUF + alptr->argval_offset;
- sscanf(str,"%d",value);
- found=1;
- break;
- }
-
- if(essential && !found)
- { fprintf(stderr,"There MUST be an entry for the parameter %s\n",name);
- exit(12);
- }
- if((minvalue!=STRANGE_NUM) && (*value < (int) minvalue))
- { *value = (int) minvalue;
- }
- if((maxvalue!=STRANGE_NUM) && (*value > (int) maxvalue))
- { *value = (int) maxvalue;
- }
-
- if(m==0)
- if(VERBOSE)
- { if (found)
- fprintf(stderr,"%25s: (int) = %d \n",name,*value);
- else
- if (Default != STRANGE_NUM)
- fprintf(stderr,"%25s: (int) = not found (%d) \n",name,(int)(Default));
- else
- { fprintf(stderr,"%25s: (int) = not found (no default) \n",name);
- if(BEGINNER)
- { fprintf(stderr,"\t\t Previously set value gives ...");
- fprintf(stderr,"%d\n",*value);
- }
- }
- }
-
- return(found);
-}
-
-int input_string(name,value,Default,m) /* in the case of a string default=NULL forces input */
- char *name;
- char *value;
- char *Default;
- int m;
-{
- char *sptr;
- struct arglist *alptr;
- int h, hno, hyes, found;
- char line[MAXLINE], *str, *noname;
- int essential;
-
-
- if(m==0)
- if(DESCRIBE)
- fprintf(stderr,"input_string: searching for '%s' with default '%s'\n",
- name,(Default == NULL) ? "no default" : Default);
-
- h=compute_parameter_hash_table(name);
- essential=found=0;
-
-
- if (Default != NULL) /* Cannot use "Essential" as this is a valid input */
- strcpy(value,Default);
- else
- essential=1;
-
- /* search list backwards, stopping at first find */
- for(alptr= ARGLIST +(NLIST-1); alptr >= ARGHEAD; alptr--)
- { if(alptr->hash != h)
- continue;
- if(strcmp(ARGBUF+alptr->argname_offset,name) != 0)
- continue;
-
- str= ARGBUF + alptr->argval_offset;
- strcpy(value,str);
- found=1;
- break;
- }
-
- if(essential && !found)
- { fprintf(stderr,"There MUST be an entry for the parameter %s\n",name);
- exit(12);
- }
-
- if(m==0)
- if(VERBOSE)
- fprintf(stderr,"%25s: (string) = %s (%s)\n",name,
- (found ? value : "not found"),
- (Default != NULL ? Default : "no default"));
-
- return(found);
-}
-
-int input_boolean(name,value,interpret,m) /* supports name=on/off too */
- char *name;
- int *value;
- char *interpret;
- int m;
-{
- char *sptr;
- struct arglist *alptr;
- int h, hno, hyes, found;
- char line[MAXLINE], *str, *noname;
-
- int essential;
- double Default,minvalue,maxvalue;
-
- if(m==0)
- if(DESCRIBE)
- fprintf(stderr,"input_boolean: searching for '%s' with default/range '%s'\n",
- name,(interpret == NULL) ? "**EMPTY**" : interpret);
-
-
- interpret_control_string(interpret,&essential,&Default,&minvalue,&maxvalue);
-
- *value = (int)(Default);
-
- h=compute_parameter_hash_table(name);
- found=0;
-
- /* search list backwards, stopping at first find */
- for(alptr= ARGLIST +(NLIST-1); alptr >= ARGHEAD; alptr--)
- { if(alptr->hash != h)
- continue;
- if(strcmp(ARGBUF+alptr->argname_offset,name) != 0)
- continue;
-
- str= ARGBUF + alptr->argval_offset;
- found=1;
- break;
- }
-
- if(!found)
- {if(m==0)
- if(VERBOSE)
- if (Default != STRANGE_NUM)
- fprintf(stderr,"%25s: (boolean int) = not found (%d) \n",name,(int)(Default));
- else
- { fprintf(stderr,"%25s: (boolean int) = not found (no default) \n",name);
- if(BEGINNER)
- { fprintf(stderr,"\t\t Previously set value gives ...");
- fprintf(stderr,"%d\n",*value);
- }
- }
-
- return(0);
- }
-
- if((strstr(str,"on")!=NULL) || (strstr(str,"ON")!=NULL))
- *value=1;
- else if ((strstr(str,"off") != NULL) || (strstr(str,"OFF")!=NULL))
- *value=0;
- else /* assume some numerical value */
- *value=atoi(str);
-
- if(m==0)
- if(VERBOSE)
- fprintf(stderr,"%25s: (boolean int) = %d \n",name,*value);
-
- return(found);
-}
-
-int input_float(name,value,interpret,m)
- char *name;
- float *value;
- char *interpret;
- int m;
-
-{ char *sptr;
- struct arglist *alptr;
-
- int h, hno, hyes, found;
- char line[MAXLINE], *str, *noname;
- int exists,essential;
- double Default,minvalue,maxvalue;
-
- if(m==0)
- if(DESCRIBE)
- fprintf(stderr,"input_float: searching for '%s' with default/range '%s'\n",
- name,(interpret == NULL) ? "**EMPTY**" : interpret);
-
-
- exists=interpret_control_string(interpret,&essential,&Default,&minvalue,&maxvalue);
-
- *value = (float) Default;
-
- h=compute_parameter_hash_table(name);
- found=0;
-
- /* search list backwards, stopping at first find */
- for(alptr= ARGLIST +(NLIST-1); alptr >= ARGHEAD; alptr--)
- { if(alptr->hash != h)
- continue;
- if(strcmp(ARGBUF+alptr->argname_offset,name) != 0)
- continue;
- str= ARGBUF + alptr->argval_offset;
-
- sscanf(str,"%f",value);
- found=1;
- break;
- }
-
- if(essential && !found)
- { fprintf(stderr,"There MUST be an entry for the parameter %s\n",name);
- exit(12);
- }
-
- if((minvalue!=STRANGE_NUM) && (*value < (float) minvalue))
- *value = (float) minvalue;
- if((maxvalue!=STRANGE_NUM) && (*value > (float) maxvalue))
- *value = (float) maxvalue;
-
- if(m==0)
- if(VERBOSE)
- { if (found)
- fprintf(stderr,"%25s: (float) = %g \n",name,*value);
- else
- if (Default != STRANGE_NUM)
- fprintf(stderr,"%25s: (float) = not found (%g) \n",name,Default);
- else
- { fprintf(stderr,"%25s: (float) = not found (no default) \n",name);
- if(BEGINNER)
- { fprintf(stderr,"\t\t Previously set value gives ...");
- fprintf(stderr,"%g\n",*value);
- }
- }
- }
- return(found);
-}
-
-int input_double(name,value,interpret,m)
- char *name;
- double *value;
- char *interpret;
- int m;
-
-{ char *sptr;
- struct arglist *alptr;
-
- int h, hno, hyes, found;
- char line[MAXLINE], *str, *noname;
-
- int exists,essential;
- double Default,minvalue,maxvalue;
-
-
- if(m==0)
- if(DESCRIBE)
- fprintf(stderr,"input_double: searching for '%s' with default/range '%s'\n",
- name,(interpret == NULL) ? "**EMPTY**" : interpret);
-
-
- exists=interpret_control_string(interpret,&essential,&Default,&minvalue,&maxvalue);
-
-
- *value = Default;
-
- h=compute_parameter_hash_table(name);
- found=0;
-
- /* search list backwards, stopping at first find */
- for(alptr= ARGLIST +(NLIST-1); alptr >= ARGHEAD; alptr--)
- { if(alptr->hash != h)
- continue;
- if(strcmp(ARGBUF+alptr->argname_offset,name) != 0)
- continue;
- str= ARGBUF + alptr->argval_offset;
- sscanf(str,"%lf",value);
- found=1;
- break;
- }
-
- if(essential && !found)
- { fprintf(stderr,"There MUST be an entry for the parameter %s\n",name);
- exit(12);
- }
- if((minvalue!=STRANGE_NUM) && (*value < minvalue))
- *value = minvalue;
- if((maxvalue!=STRANGE_NUM) && (*value > maxvalue))
- *value = maxvalue;
-
- if(m==0)
- if(VERBOSE)
- { if (found)
- fprintf(stderr,"%25s: (double) = %g \n",name,*value);
- else
- if (Default != STRANGE_NUM)
- fprintf(stderr,"%25s: (double) = not found (%g) \n",name,Default);
- else
- { fprintf(stderr,"%25s: (double) = not found (no default) \n",name);
- if(BEGINNER)
- { fprintf(stderr,"\t\t Previously set value gives ...");
- fprintf(stderr,"%g\n",*value);
- }
- }
- }
-
-
- return(found);
-}
-
-
-int input_int_vector(char *name, int number,int *value,int m)
-{
- char *sptr;
- struct arglist *alptr;
- char control_string[500];
-
- int h,i, hno, hyes, found;
- char line[MAXLINE], *str, *noname;
-
- if(m==0)
- if(DESCRIBE)
- fprintf(stderr,"input_int_vector: searching for %s (%d times)\n",name,number);
-
- h=compute_parameter_hash_table(name);
- found=0;
-
- /* search list backwards, stopping at first find */
- for(alptr= ARGLIST +(NLIST-1); alptr >= ARGHEAD; alptr--)
- { if(alptr->hash != h)
- continue;
- if(strcmp(ARGBUF+alptr->argname_offset,name) != 0)
- continue;
- str= ARGBUF + alptr->argval_offset;
- found=1;
- break;
- }
- /* now interpret vector */
-
- if(!found) return(0);
-
- for(h=0;h<number;h++)
- { sprintf(control_string,"");
- for(i=0;i<h;i++)
- strcat(control_string,"%*f,");
- strcat(control_string,"%d");
- sscanf(str,control_string,&(value[h]));
- }
-
- if(m==0)
- if(VERBOSE)
- fprintf(stderr,"%25s: (vector) = %s\n",name,str);
-
- return(found);
-}
-
-
-
-int input_char_vector(name,number,value,m)
- char *name;
- int number;
- char *value; /* comma-separated list of ints */
- int m;
-
-{ char *sptr;
- struct arglist *alptr;
- char control_string[500];
-
- int h,i, hno, hyes, found;
- char line[MAXLINE], *str, *noname;
-
- if(m==0)
- if(DESCRIBE)
- fprintf(stderr,"input_char_vector: searching for %s (%d times)\n",name,number);
-
- h=compute_parameter_hash_table(name);
- found=0;
-
- /* search list backwards, stopping at first find */
- for(alptr= ARGLIST +(NLIST-1); alptr >= ARGHEAD; alptr--)
- { if(alptr->hash != h)
- continue;
- if(strcmp(ARGBUF+alptr->argname_offset,name) != 0)
- continue;
- str= ARGBUF + alptr->argval_offset;
- found=1;
- break;
- }
- /* now interpret vector */
-
- if(!found) return(0);
-
- for(h=0;h<number;h++)
- { sprintf(control_string,"");
- for(i=0;i<h;i++)
- strcat(control_string,"%*c,");
- strcat(control_string,"%c");
- sscanf(str,control_string,&(value[h]));
- }
-
- if(m==0)
- if(VERBOSE)
- fprintf(stderr,"%25s: (vector) = %s\n",name,str);
-
- return(found);
-}
-
-int input_float_vector(name,number,value,m)
- char *name;
- int number;
- float *value; /* comma-separated list of floats */
- int m;
-
-{ char *sptr;
- struct arglist *alptr;
- char control_string[500];
-
- int h,i, hno, hyes, found;
- char line[MAXLINE], *str, *noname;
-
- if(0==number)
- return(0);
-
- if(m==0)
- if(DESCRIBE)
- fprintf(stderr,"input_float_vector: searching for %s (%d times)\n",name,number);
-
- h=compute_parameter_hash_table(name);
- found=0;
-
- /* search list backwards, stopping at first find */
- for(alptr= ARGLIST +(NLIST-1); alptr >= ARGHEAD; alptr--)
- { if(alptr->hash != h)
- continue;
- if(strcmp(ARGBUF+alptr->argname_offset,name) != 0)
- continue;
- str= ARGBUF + alptr->argval_offset;
- found=1;
- break;
- }
- /* now interpret vector */
-
- if(!found) return(0);
-
- for(h=0;h<number;h++)
- { sprintf(control_string,"");
- for(i=0;i<h;i++)
- strcat(control_string,"%*f,");
- strcat(control_string,"%f");
- sscanf(str,control_string,&(value[h]));
- }
-
- if(m==0)
- if(VERBOSE)
- fprintf(stderr,"%25s: (float vector) = %s\n",name,str);
-
- return(found);
-}
-
-int input_double_vector(name,number,value,m)
- char *name;
- int number;
- double *value; /* comma-separated list of floats */
- int m;
-
-{ char *sptr;
- struct arglist *alptr;
- char control_string[500];
-
- int h,i, hno, hyes, found;
- char line[MAXLINE], *str, *noname;
-
- if(m==0)
- if(DESCRIBE)
- fprintf(stderr,"input_double_vector: searching for %s (%d times)\n",name,number);
-
- h=compute_parameter_hash_table(name);
- found=0;
-
- /* search list backwards, stopping at first find */
- for(alptr= ARGLIST +(NLIST-1); alptr >= ARGHEAD; alptr--)
- { if(alptr->hash != h)
- continue;
- if(strcmp(ARGBUF+alptr->argname_offset,name) != 0)
- continue;
- str= ARGBUF + alptr->argval_offset;
- found=1;
- break;
- }
-
- if(!found) return(0);
-
- /* now interpret vector */
-
- for(h=0;h<number;h++)
- { sprintf(control_string,"");
- for(i=0;i<h;i++)
- strcat(control_string,"%*f,");
- strcat(control_string,"%lf");
- sscanf(str,control_string,&(value[h]));
- }
-
- if(m==0)
- if(VERBOSE)
- fprintf(stderr,"%25s: (double vector) = %s\n",name,str);
-
- return(found);
-}
-
-/* =================================================== */
-/* This is needed to be fixed on Linux machine
- The function strtok does not work on linux machine
-*/
-
-int interpret_control_string(interpret,essential,Default,minvalue,maxvalue)
- char *interpret;
- int *essential;
- double *Default,*minvalue,*maxvalue;
-
-{ char *substring;
-
- *Default=*maxvalue=*minvalue=STRANGE_NUM;
- *essential=0;
-
- if (strstr(interpret,"essential")!=NULL)
- { *essential=1; /* no default possible, must read a value */
- return(0);
- }
-
- if (strstr(interpret,"nodefault")==NULL)
- { if((strstr(interpret,"on")!=NULL) || (strstr(interpret,"ON")!=NULL))
- *Default = 1.0;
- else
- if ((strstr(interpret,"off") != NULL) || (strstr(interpret,"OFF")!=NULL))
- *Default = 0.0;
- else
- sscanf(interpret,"%lf",Default); /* read number as a default value */
- }
-
- if ((substring=strstr(interpret,",")) == NULL) /* minvalue */
- { /* no minimum, no maximum */
- return(1);
- }
-
- if (strstr(substring,"nomin")==NULL)
- sscanf(substring,"%lf",minvalue);
-
- if ((substring=strstr(substring,",")) == NULL) /* maxvalue */
- { /* no maximum */
-/* if (DESCRIBE) */
-/* fprintf(stderr,"minimum but no maximum\n"); */
- return(2);
- }
-
- if (strstr(substring,"nomax")==NULL)
- sscanf(substring,"%lf",maxvalue);
-
-
- return(0);
-
-}
Copied: mc/3D/CitcomS/branches/cxx/lib/Parsing.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Parsing.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Parsing.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Parsing.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,835 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+/* Routines which read filenames from the command line and
+ then parse the contents as parameters for citcom */
+
+#include <stdio.h>
+#include <sys/types.h>
+#include <string.h>
+#include "global_defs.h"
+#include "parsing.h"
+
+#include "cproto.h"
+
+#define MAXLINE 1024 /* max length of line in input file */
+#define MAXNAME 64 /* max length of name */
+#define MAXVALUE 1024 /* max length of value */
+#define MAXFILENAME 64 /* max length of par file name */
+#define MAXVECTOR 10 /* max # of elements for unspecified vectors */
+#define STRANGE_NUM -98765.4321
+
+/* abbreviations: */
+#define AL struct arglist
+#define PROGNAME ext_par.progname
+#define FLAGS ext_par.argflags
+#define ARGLIST ext_par.arglist
+#define ARGHEAD ext_par.arghead
+#define ARGBUF ext_par.argbuf
+#define NLIST ext_par.nlist
+#define NBUF ext_par.nbuf
+#define LISTMAX ext_par.listmax
+#define BUFMAX ext_par.bufmax
+#define LISTFILE ext_par.listout
+
+#define LISTINC 32 /* increment size for arglist */
+#define BUFINC 1024 /* increment size for argbuf */
+
+struct ext_par /* global variables for getpar */
+{
+ char *progname;
+ int argflags;
+ struct arglist *arglist;
+ struct arglist *arghead;
+ char *argbuf;
+ int nlist;
+ int nbuf;
+ int listmax;
+ int bufmax;
+ FILE *listout;
+} ext_par;
+
+struct arglist /* structure of list set up by setpar */
+{
+ int argname_offset;
+ int argval_offset;
+ int hash;
+};
+
+int VERBOSE = 0;
+int DESCRIBE = 0;
+int BEGINNER = 0;
+
+int interpret_control_string();
+
+
+void setup_parser(
+ struct All_variables *E,
+ char *filename
+ )
+{
+ FILE * fp;
+ char *pl,*pn,*pv;
+ char t1, t2, line[MAXLINE], name[MAXNAME], value[MAXVALUE];
+ int i,j,k;
+ int m=E->parallel.me;
+
+ /* should get file length & cpp &c before any further parsing */
+
+ /* for now, read one filename from the command line, we'll parse that ! */
+
+
+ /* this section moved to main() */
+/* if (ac < 2) { */
+/* fprintf(stderr,"Usage: citcom PARAMETERFILE\n"); */
+/* exit(10); */
+/* } */
+
+
+ if ((fp = fopen(filename,"r")) == NULL) {
+ fprintf(stderr,"(Parsing #1) File: %s is unreadable\n",filename);
+ exit(11);
+ }
+
+
+
+ /* now the parameter file is open, read into memory */
+
+ while( fgets(line,MAXLINE,fp) != NULL )
+ { pl= line;
+ /* loop over entries on each line */
+ loop:
+ while(*pl==' ' || *pl=='\t') pl++;
+ if(*pl=='\0'|| *pl=='\n') continue; /* end of line */
+ if(*pl=='#') continue; /* end of interpretable part of line */
+
+ /* get name */
+ pn= name;
+ while(*pl != '=' && *pl != '\0' && *pl != ' '
+ && *pl != '\n' /* FIX by Glenn Nelson */
+ && *pl != '\t')
+ *pn++ = *pl++;
+ *pn = '\0';
+ if(*pl == '=') pl++;
+
+ /* get value */
+ *value= '\0';
+ pv= value;
+ if(*pl=='"' || *pl=='\'')
+ t1= t2= *pl++;
+ else
+ { t1= ' ';
+ t2= '\t';
+ }
+ while(*pl!=t1 && *pl!=t2 &&
+ *pl!='\0' && *pl!='\n') *pv++= *pl++;
+ *pv= '\0';
+ if(*pl=='"' || *pl=='\'')
+ pl++;
+ add_to_parameter_list(name,value);
+
+ goto loop;
+ }
+
+ fclose(fp);
+
+ ARGHEAD= ARGLIST;
+
+ /* Now we can use our routines to check & set their own flags ! */
+
+ input_boolean("VERBOSE",&i,"off",m);
+ input_boolean("DESCRIBE",&j,"off",m);
+ input_boolean("BEGINNER",&k,"off",m);
+ VERBOSE=i;
+ DESCRIBE=j;
+ BEGINNER=k;
+
+ /* make this an optional behavior */
+ input_boolean("copy_input_file",&k,"on",m);
+ if(k)
+ unique_copy_file(E,filename,"copy");
+
+
+}
+
+void shutdown_parser(struct All_variables *E)
+{
+ if(ARGLIST != NULL) free(ARGLIST);
+ if(ARGBUF != NULL) free(ARGBUF);
+ ARGBUF= NULL;
+ ARGLIST= NULL;
+
+}
+
+
+/* add an entry to arglist, expanding memory */
+void add_to_parameter_list(
+ char *name, char *value /* if necessary */
+ )
+{
+ struct arglist *alptr;
+ int len;
+ char *ptr;
+
+ /* check arglist memory */
+ if(NLIST >= LISTMAX)
+ { LISTMAX += LISTINC;
+ if(ARGLIST == NULL)
+ ARGLIST= (AL *)malloc(LISTMAX * sizeof(AL));
+ else
+ ARGLIST= (AL *)realloc(ARGLIST,LISTMAX * sizeof(AL));
+ }
+ /* check argbuf memory */
+ len= strlen(name) + strlen(value) + 2; /* +2 for terminating nulls */
+ if(NBUF+len >= BUFMAX)
+ { BUFMAX += BUFINC;
+ if(ARGBUF == NULL)
+ ARGBUF= (char *)malloc(BUFMAX);
+ else ARGBUF= (char *)realloc(ARGBUF,BUFMAX);
+ }
+ if(ARGBUF == NULL || ARGLIST == NULL)
+ fprintf(stderr,"cannot allocate memory\n");
+
+ /* add name */
+ alptr= ARGLIST + NLIST;
+ alptr->hash= compute_parameter_hash_table(name);
+ alptr->argname_offset = NBUF;
+ ptr= ARGBUF + NBUF;
+ do
+ *ptr++ = *name;
+ while(*name++);
+
+ /* add value */
+ NBUF += len;
+ alptr->argval_offset= ptr - ARGBUF;
+ do
+ *ptr++ = *value;
+ while(*value++);
+ NLIST++;
+}
+
+int compute_parameter_hash_table(char *s)
+{ int h;
+
+ h= s[0];
+ if(s[1])
+ h |= (s[1])<<8;
+ else
+ return(h);
+ if(s[2])
+ h |= (s[2])<<16;
+ else
+ return(h);
+ if(s[3])
+ h |= (s[3])<<24;
+ return(h);
+}
+
+int input_int(
+ char *name,
+ int *value,
+ char *interpret,
+ int m
+ )
+{
+ struct arglist *alptr;
+ int h, found;
+ char *str;
+
+ int exists,essential;
+ double Default,minvalue,maxvalue;
+
+ if(m==0)
+ if(DESCRIBE)
+ fprintf(stderr,"input_int: searching for '%s' with default/range '%s'\n",
+ name,(interpret == NULL) ? "**EMPTY**" : interpret);
+
+ exists = interpret_control_string(interpret,&essential,&Default,&minvalue,&maxvalue);
+
+ *value = (int)(Default);
+
+ h=compute_parameter_hash_table(name);
+ found=0;
+
+ /* search list backwards, stopping at first find */
+ for(alptr= ARGLIST +(NLIST-1); alptr >= ARGHEAD; alptr--)
+ { if(alptr->hash != h)
+ continue;
+ if(strcmp(ARGBUF+alptr->argname_offset,name) != 0)
+ continue;
+
+ str= ARGBUF + alptr->argval_offset;
+ sscanf(str,"%d",value);
+ found=1;
+ break;
+ }
+
+ if(essential && !found)
+ { fprintf(stderr,"There MUST be an entry for the parameter %s\n",name);
+ exit(12);
+ }
+ if((minvalue!=STRANGE_NUM) && (*value < (int) minvalue))
+ { *value = (int) minvalue;
+ }
+ if((maxvalue!=STRANGE_NUM) && (*value > (int) maxvalue))
+ { *value = (int) maxvalue;
+ }
+
+ if(m==0)
+ if(VERBOSE)
+ { if (found)
+ fprintf(stderr,"%25s: (int) = %d \n",name,*value);
+ else
+ if (Default != STRANGE_NUM)
+ fprintf(stderr,"%25s: (int) = not found (%d) \n",name,(int)(Default));
+ else
+ { fprintf(stderr,"%25s: (int) = not found (no default) \n",name);
+ if(BEGINNER)
+ { fprintf(stderr,"\t\t Previously set value gives ...");
+ fprintf(stderr,"%d\n",*value);
+ }
+ }
+ }
+
+ return(found);
+}
+
+int input_string( /* in the case of a string default=NULL forces input */
+ char *name,
+ char *value,
+ char *Default,
+ int m
+ )
+{
+ char *sptr;
+ struct arglist *alptr;
+ int h, hno, hyes, found;
+ char line[MAXLINE], *str, *noname;
+ int essential;
+
+
+ if(m==0)
+ if(DESCRIBE)
+ fprintf(stderr,"input_string: searching for '%s' with default '%s'\n",
+ name,(Default == NULL) ? "no default" : Default);
+
+ h=compute_parameter_hash_table(name);
+ essential=found=0;
+
+
+ if (Default != NULL) /* Cannot use "Essential" as this is a valid input */
+ strcpy(value,Default);
+ else
+ essential=1;
+
+ /* search list backwards, stopping at first find */
+ for(alptr= ARGLIST +(NLIST-1); alptr >= ARGHEAD; alptr--)
+ { if(alptr->hash != h)
+ continue;
+ if(strcmp(ARGBUF+alptr->argname_offset,name) != 0)
+ continue;
+
+ str= ARGBUF + alptr->argval_offset;
+ strcpy(value,str);
+ found=1;
+ break;
+ }
+
+ if(essential && !found)
+ { fprintf(stderr,"There MUST be an entry for the parameter %s\n",name);
+ exit(12);
+ }
+
+ if(m==0)
+ if(VERBOSE)
+ fprintf(stderr,"%25s: (string) = %s (%s)\n",name,
+ (found ? value : "not found"),
+ (Default != NULL ? Default : "no default"));
+
+ return(found);
+}
+
+int input_boolean( /* supports name=on/off too */
+ char *name,
+ int *value,
+ char *interpret,
+ int m
+ )
+{
+ char *sptr;
+ struct arglist *alptr;
+ int h, hno, hyes, found;
+ char line[MAXLINE], *str, *noname;
+
+ int essential;
+ double Default,minvalue,maxvalue;
+
+ if(m==0)
+ if(DESCRIBE)
+ fprintf(stderr,"input_boolean: searching for '%s' with default/range '%s'\n",
+ name,(interpret == NULL) ? "**EMPTY**" : interpret);
+
+
+ interpret_control_string(interpret,&essential,&Default,&minvalue,&maxvalue);
+
+ *value = (int)(Default);
+
+ h=compute_parameter_hash_table(name);
+ found=0;
+
+ /* search list backwards, stopping at first find */
+ for(alptr= ARGLIST +(NLIST-1); alptr >= ARGHEAD; alptr--)
+ { if(alptr->hash != h)
+ continue;
+ if(strcmp(ARGBUF+alptr->argname_offset,name) != 0)
+ continue;
+
+ str= ARGBUF + alptr->argval_offset;
+ found=1;
+ break;
+ }
+
+ if(!found)
+ {if(m==0)
+ if(VERBOSE)
+ if (Default != STRANGE_NUM)
+ fprintf(stderr,"%25s: (boolean int) = not found (%d) \n",name,(int)(Default));
+ else
+ { fprintf(stderr,"%25s: (boolean int) = not found (no default) \n",name);
+ if(BEGINNER)
+ { fprintf(stderr,"\t\t Previously set value gives ...");
+ fprintf(stderr,"%d\n",*value);
+ }
+ }
+
+ return(0);
+ }
+
+ if((strstr(str,"on")!=NULL) || (strstr(str,"ON")!=NULL))
+ *value=1;
+ else if ((strstr(str,"off") != NULL) || (strstr(str,"OFF")!=NULL))
+ *value=0;
+ else /* assume some numerical value */
+ *value=atoi(str);
+
+ if(m==0)
+ if(VERBOSE)
+ fprintf(stderr,"%25s: (boolean int) = %d \n",name,*value);
+
+ return(found);
+}
+
+int input_float(
+ char *name,
+ float *value,
+ char *interpret,
+ int m
+ )
+{ char *sptr;
+ struct arglist *alptr;
+
+ int h, hno, hyes, found;
+ char line[MAXLINE], *str, *noname;
+ int exists,essential;
+ double Default,minvalue,maxvalue;
+
+ if(m==0)
+ if(DESCRIBE)
+ fprintf(stderr,"input_float: searching for '%s' with default/range '%s'\n",
+ name,(interpret == NULL) ? "**EMPTY**" : interpret);
+
+
+ exists=interpret_control_string(interpret,&essential,&Default,&minvalue,&maxvalue);
+
+ *value = (float) Default;
+
+ h=compute_parameter_hash_table(name);
+ found=0;
+
+ /* search list backwards, stopping at first find */
+ for(alptr= ARGLIST +(NLIST-1); alptr >= ARGHEAD; alptr--)
+ { if(alptr->hash != h)
+ continue;
+ if(strcmp(ARGBUF+alptr->argname_offset,name) != 0)
+ continue;
+ str= ARGBUF + alptr->argval_offset;
+
+ sscanf(str,"%f",value);
+ found=1;
+ break;
+ }
+
+ if(essential && !found)
+ { fprintf(stderr,"There MUST be an entry for the parameter %s\n",name);
+ exit(12);
+ }
+
+ if((minvalue!=STRANGE_NUM) && (*value < (float) minvalue))
+ *value = (float) minvalue;
+ if((maxvalue!=STRANGE_NUM) && (*value > (float) maxvalue))
+ *value = (float) maxvalue;
+
+ if(m==0)
+ if(VERBOSE)
+ { if (found)
+ fprintf(stderr,"%25s: (float) = %g \n",name,*value);
+ else
+ if (Default != STRANGE_NUM)
+ fprintf(stderr,"%25s: (float) = not found (%g) \n",name,Default);
+ else
+ { fprintf(stderr,"%25s: (float) = not found (no default) \n",name);
+ if(BEGINNER)
+ { fprintf(stderr,"\t\t Previously set value gives ...");
+ fprintf(stderr,"%g\n",*value);
+ }
+ }
+ }
+ return(found);
+}
+
+int input_double(
+ char *name,
+ double *value,
+ char *interpret,
+ int m
+ )
+{ char *sptr;
+ struct arglist *alptr;
+
+ int h, hno, hyes, found;
+ char line[MAXLINE], *str, *noname;
+
+ int exists,essential;
+ double Default,minvalue,maxvalue;
+
+
+ if(m==0)
+ if(DESCRIBE)
+ fprintf(stderr,"input_double: searching for '%s' with default/range '%s'\n",
+ name,(interpret == NULL) ? "**EMPTY**" : interpret);
+
+
+ exists=interpret_control_string(interpret,&essential,&Default,&minvalue,&maxvalue);
+
+
+ *value = Default;
+
+ h=compute_parameter_hash_table(name);
+ found=0;
+
+ /* search list backwards, stopping at first find */
+ for(alptr= ARGLIST +(NLIST-1); alptr >= ARGHEAD; alptr--)
+ { if(alptr->hash != h)
+ continue;
+ if(strcmp(ARGBUF+alptr->argname_offset,name) != 0)
+ continue;
+ str= ARGBUF + alptr->argval_offset;
+ sscanf(str,"%lf",value);
+ found=1;
+ break;
+ }
+
+ if(essential && !found)
+ { fprintf(stderr,"There MUST be an entry for the parameter %s\n",name);
+ exit(12);
+ }
+ if((minvalue!=STRANGE_NUM) && (*value < minvalue))
+ *value = minvalue;
+ if((maxvalue!=STRANGE_NUM) && (*value > maxvalue))
+ *value = maxvalue;
+
+ if(m==0)
+ if(VERBOSE)
+ { if (found)
+ fprintf(stderr,"%25s: (double) = %g \n",name,*value);
+ else
+ if (Default != STRANGE_NUM)
+ fprintf(stderr,"%25s: (double) = not found (%g) \n",name,Default);
+ else
+ { fprintf(stderr,"%25s: (double) = not found (no default) \n",name);
+ if(BEGINNER)
+ { fprintf(stderr,"\t\t Previously set value gives ...");
+ fprintf(stderr,"%g\n",*value);
+ }
+ }
+ }
+
+
+ return(found);
+}
+
+
+int input_int_vector(char *name, int number,int *value,int m)
+{
+ char *sptr;
+ struct arglist *alptr;
+ char control_string[500];
+
+ int h,i, hno, hyes, found;
+ char line[MAXLINE], *str, *noname;
+
+ if(m==0)
+ if(DESCRIBE)
+ fprintf(stderr,"input_int_vector: searching for %s (%d times)\n",name,number);
+
+ h=compute_parameter_hash_table(name);
+ found=0;
+
+ /* search list backwards, stopping at first find */
+ for(alptr= ARGLIST +(NLIST-1); alptr >= ARGHEAD; alptr--)
+ { if(alptr->hash != h)
+ continue;
+ if(strcmp(ARGBUF+alptr->argname_offset,name) != 0)
+ continue;
+ str= ARGBUF + alptr->argval_offset;
+ found=1;
+ break;
+ }
+ /* now interpret vector */
+
+ if(!found) return(0);
+
+ for(h=0;h<number;h++)
+ { sprintf(control_string,"");
+ for(i=0;i<h;i++)
+ strcat(control_string,"%*f,");
+ strcat(control_string,"%d");
+ sscanf(str,control_string,&(value[h]));
+ }
+
+ if(m==0)
+ if(VERBOSE)
+ fprintf(stderr,"%25s: (vector) = %s\n",name,str);
+
+ return(found);
+}
+
+
+
+int input_char_vector(
+ char *name,
+ int number,
+ char *value, /* comma-separated list of ints */
+ int m
+ )
+{ char *sptr;
+ struct arglist *alptr;
+ char control_string[500];
+
+ int h,i, hno, hyes, found;
+ char line[MAXLINE], *str, *noname;
+
+ if(m==0)
+ if(DESCRIBE)
+ fprintf(stderr,"input_char_vector: searching for %s (%d times)\n",name,number);
+
+ h=compute_parameter_hash_table(name);
+ found=0;
+
+ /* search list backwards, stopping at first find */
+ for(alptr= ARGLIST +(NLIST-1); alptr >= ARGHEAD; alptr--)
+ { if(alptr->hash != h)
+ continue;
+ if(strcmp(ARGBUF+alptr->argname_offset,name) != 0)
+ continue;
+ str= ARGBUF + alptr->argval_offset;
+ found=1;
+ break;
+ }
+ /* now interpret vector */
+
+ if(!found) return(0);
+
+ for(h=0;h<number;h++)
+ { sprintf(control_string,"");
+ for(i=0;i<h;i++)
+ strcat(control_string,"%*c,");
+ strcat(control_string,"%c");
+ sscanf(str,control_string,&(value[h]));
+ }
+
+ if(m==0)
+ if(VERBOSE)
+ fprintf(stderr,"%25s: (vector) = %s\n",name,str);
+
+ return(found);
+}
+
+int input_float_vector(
+ char *name,
+ int number,
+ float *value, /* comma-separated list of floats */
+ int m
+ )
+{ char *sptr;
+ struct arglist *alptr;
+ char control_string[500];
+
+ int h,i, hno, hyes, found;
+ char line[MAXLINE], *str, *noname;
+
+ if(0==number)
+ return(0);
+
+ if(m==0)
+ if(DESCRIBE)
+ fprintf(stderr,"input_float_vector: searching for %s (%d times)\n",name,number);
+
+ h=compute_parameter_hash_table(name);
+ found=0;
+
+ /* search list backwards, stopping at first find */
+ for(alptr= ARGLIST +(NLIST-1); alptr >= ARGHEAD; alptr--)
+ { if(alptr->hash != h)
+ continue;
+ if(strcmp(ARGBUF+alptr->argname_offset,name) != 0)
+ continue;
+ str= ARGBUF + alptr->argval_offset;
+ found=1;
+ break;
+ }
+ /* now interpret vector */
+
+ if(!found) return(0);
+
+ for(h=0;h<number;h++)
+ { sprintf(control_string,"");
+ for(i=0;i<h;i++)
+ strcat(control_string,"%*f,");
+ strcat(control_string,"%f");
+ sscanf(str,control_string,&(value[h]));
+ }
+
+ if(m==0)
+ if(VERBOSE)
+ fprintf(stderr,"%25s: (float vector) = %s\n",name,str);
+
+ return(found);
+}
+
+int input_double_vector(
+ char *name,
+ int number,
+ double *value, /* comma-separated list of floats */
+ int m
+ )
+{ char *sptr;
+ struct arglist *alptr;
+ char control_string[500];
+
+ int h,i, hno, hyes, found;
+ char line[MAXLINE], *str, *noname;
+
+ if(m==0)
+ if(DESCRIBE)
+ fprintf(stderr,"input_double_vector: searching for %s (%d times)\n",name,number);
+
+ h=compute_parameter_hash_table(name);
+ found=0;
+
+ /* search list backwards, stopping at first find */
+ for(alptr= ARGLIST +(NLIST-1); alptr >= ARGHEAD; alptr--)
+ { if(alptr->hash != h)
+ continue;
+ if(strcmp(ARGBUF+alptr->argname_offset,name) != 0)
+ continue;
+ str= ARGBUF + alptr->argval_offset;
+ found=1;
+ break;
+ }
+
+ if(!found) return(0);
+
+ /* now interpret vector */
+
+ for(h=0;h<number;h++)
+ { sprintf(control_string,"");
+ for(i=0;i<h;i++)
+ strcat(control_string,"%*f,");
+ strcat(control_string,"%lf");
+ sscanf(str,control_string,&(value[h]));
+ }
+
+ if(m==0)
+ if(VERBOSE)
+ fprintf(stderr,"%25s: (double vector) = %s\n",name,str);
+
+ return(found);
+}
+
+/* =================================================== */
+/* This is needed to be fixed on Linux machine
+ The function strtok does not work on linux machine
+*/
+
+int interpret_control_string(
+ char *interpret,
+ int *essential,
+ double *Default, double *minvalue, double *maxvalue
+ )
+{ char *substring;
+
+ *Default=*maxvalue=*minvalue=STRANGE_NUM;
+ *essential=0;
+
+ if (strstr(interpret,"essential")!=NULL)
+ { *essential=1; /* no default possible, must read a value */
+ return(0);
+ }
+
+ if (strstr(interpret,"nodefault")==NULL)
+ { if((strstr(interpret,"on")!=NULL) || (strstr(interpret,"ON")!=NULL))
+ *Default = 1.0;
+ else
+ if ((strstr(interpret,"off") != NULL) || (strstr(interpret,"OFF")!=NULL))
+ *Default = 0.0;
+ else
+ sscanf(interpret,"%lf",Default); /* read number as a default value */
+ }
+
+ if ((substring=strstr(interpret,",")) == NULL) /* minvalue */
+ { /* no minimum, no maximum */
+ return(1);
+ }
+
+ if (strstr(substring,"nomin")==NULL)
+ sscanf(substring,"%lf",minvalue);
+
+ if ((substring=strstr(substring,",")) == NULL) /* maxvalue */
+ { /* no maximum */
+/* if (DESCRIBE) */
+/* fprintf(stderr,"minimum but no maximum\n"); */
+ return(2);
+ }
+
+ if (strstr(substring,"nomax")==NULL)
+ sscanf(substring,"%lf",maxvalue);
+
+
+ return(0);
+
+}
Deleted: mc/3D/CitcomS/branches/cxx/lib/Phase_change.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Phase_change.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Phase_change.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,213 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-#include <stdio.h>
-#include <math.h>
-#include <sys/types.h>
-#include "global_defs.h"
-
-#include "parsing.h"
-#include "phase_change.h"
-
-static void phase_change_apply(struct All_variables *E, double **buoy,
- float **B, float **B_b,
- float Ra, float clapeyron,
- float depth, float transT, float inv_width);
-static void calc_phase_change(struct All_variables *E,
- float **B, float **B_b,
- float Ra, float clapeyron,
- float depth, float transT, float inv_width);
-static void debug_phase_change(struct All_variables *E, float **B);
-
-
-void phase_change_allocate(struct All_variables *E)
-{
- int j;
- int nno = E->lmesh.nno;
- int nsf = E->lmesh.nsf;
-
- for (j=1;j<=E->sphere.caps_per_proc;j++) {
- E->Fas410[j] = (float *) malloc((nno+1)*sizeof(float));
- E->Fas410_b[j] = (float *) malloc((nsf+1)*sizeof(float));
- E->Fas670[j] = (float *) malloc((nno+1)*sizeof(float));
- E->Fas670_b[j] = (float *) malloc((nsf+1)*sizeof(float));
- E->Fascmb[j] = (float *) malloc((nno+1)*sizeof(float));
- E->Fascmb_b[j] = (float *) malloc((nsf+1)*sizeof(float));
- }
-
- return;
-}
-
-
-void phase_change_input(struct All_variables *E)
-{
- int m = E->parallel.me;
- float width;
-
- /* for phase change 410km */
- input_float("Ra_410",&(E->control.Ra_410),"0.0",m);
- input_float("clapeyron410",&(E->control.clapeyron410),"0.0",m);
- input_float("transT410",&(E->control.transT410),"0.0",m);
- input_float("width410",&width,"0.0",m);
-
- if (width!=0.0)
- E->control.inv_width410 = 1.0/width;
-
- /* for phase change 670km */
- input_float("Ra_670",&(E->control.Ra_670),"0.0",m);
- input_float("clapeyron670",&(E->control.clapeyron670),"0.0",m);
- input_float("transT670",&(E->control.transT670),"0.0",m);
- input_float("width670",&width,"0.0",m);
-
- if (width!=0.0)
- E->control.inv_width670 = 1.0/width;
-
- /* for phase change CMB */
- input_float("Ra_cmb",&(E->control.Ra_cmb),"0.0",m);
- input_float("clapeyroncmb",&(E->control.clapeyroncmb),"0.0",m);
- input_float("transTcmb",&(E->control.transTcmb),"0.0",m);
- input_float("widthcmb",&width,"0.0",m);
-
- if (width!=0.0)
- E->control.inv_widthcmb = 1.0/width;
-
-
- return;
-}
-
-
-void phase_change_apply_410(struct All_variables *E, double **buoy)
-{
- if (E->control.Ra_410 != 0.0)
- phase_change_apply(E, buoy, E->Fas410, E->Fas410_b, E->control.Ra_410,
- E->control.clapeyron410, E->viscosity.z410,
- E->control.transT410, E->control.inv_width410);
- return;
-}
-
-
-void phase_change_apply_670(struct All_variables *E, double **buoy)
-{
- if (E->control.Ra_670 != 0.0)
- phase_change_apply(E, buoy, E->Fas670, E->Fas670_b, E->control.Ra_670,
- E->control.clapeyron670, E->viscosity.zlm,
- E->control.transT670, E->control.inv_width670);
- return;
-}
-
-
-void phase_change_apply_cmb(struct All_variables *E, double **buoy)
-{
- if (E->control.Ra_cmb != 0.0)
- phase_change_apply(E, buoy, E->Fascmb, E->Fascmb_b, E->control.Ra_cmb,
- E->control.clapeyroncmb, E->viscosity.zcmb,
- E->control.transTcmb, E->control.inv_widthcmb);
- return;
-}
-
-
-static void phase_change_apply(struct All_variables *E, double **buoy,
- float **B, float **B_b,
- float Ra, float clapeyron,
- float depth, float transT, float inv_width)
-{
- int m, i;
-
- calc_phase_change(E, B, B_b, Ra, clapeyron, depth, transT, inv_width);
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=1;i<=E->lmesh.nno;i++)
- buoy[m][i] -= Ra * B[m][i];
-
- if (E->control.verbose) {
- fprintf(E->fp_out, "Ra=%f, clapeyron=%f, depth=%f, transT=%f, inv_width=%f\n",
- Ra, clapeyron, depth, transT, inv_width);
- debug_phase_change(E,B);
- fflush(E->fp_out);
- }
-
- return;
-}
-
-
-static void calc_phase_change(struct All_variables *E,
- float **B, float **B_b,
- float Ra, float clapeyron,
- float depth, float transT, float inv_width)
-{
- int i,j,k,n,ns,m,nz;
- float e_pressure,pt5,one,dz;
-
- pt5 = 0.5;
- one = 1.0;
-
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
- /* compute phase function B, the concentration of the high pressure
- * phase. B is between 0 and 1. */
- for(i=1;i<=E->lmesh.nno;i++) {
- nz = ((i-1) % E->lmesh.noz) + 1;
- dz = (E->sphere.ro-E->sx[m][3][i]) - depth;
- /*XXX: dz*rho[nz]*g[nz] is only a approximation for the reduced
- * pressure, a more accurate formula is:
- * integral(rho(z)*g(z)*dz) from depth_ph to current depth */
- e_pressure = dz * E->refstate.rho[nz] * E->refstate.gravity[nz]
- - clapeyron * (E->T[m][i] - transT);
-
- B[m][i] = pt5 * (one + tanh(inv_width * e_pressure));
- }
-
- /* compute the phase boundary, defined as the depth where B==0.5 */
- ns = 0;
- for (k=1;k<=E->lmesh.noy;k++)
- for (j=1;j<=E->lmesh.nox;j++) {
- ns++;
- B_b[m][ns]=0.0;
- for (i=1;i<E->lmesh.noz;i++) {
- n = (k-1)*E->lmesh.noz*E->lmesh.nox + (j-1)*E->lmesh.noz + i;
- if (B[m][n]>=pt5 && B[m][n+1]<=pt5)
- B_b[m][ns]=(E->sx[m][3][n+1]-E->sx[m][3][n])*(pt5-B[m][n])/(B[m][n+1]-B[m][n])+E->sx[m][3][n];
- }
- }
- }
-
- return;
-}
-
-
-static void debug_phase_change(struct All_variables *E, float **B)
-{
- int m, j;
-
- fprintf(E->fp_out,"output_phase_change_buoyancy\n");
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
- fprintf(E->fp_out,"for cap %d\n",E->sphere.capid[m]);
- for (j=1;j<=E->lmesh.nno;j++)
- fprintf(E->fp_out,"Z = %.6e T = %.6e B[%06d] = %.6e \n",E->sx[m][3][j],E->T[m][j],j,B[m][j]);
- }
- fflush(E->fp_out);
-
- return;
-}
Copied: mc/3D/CitcomS/branches/cxx/lib/Phase_change.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Phase_change.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Phase_change.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Phase_change.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,213 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+#include <stdio.h>
+#include <math.h>
+#include <sys/types.h>
+#include "global_defs.h"
+
+#include "parsing.h"
+#include "phase_change.h"
+
+static void phase_change_apply(struct All_variables *E, double **buoy,
+ float **B, float **B_b,
+ float Ra, float clapeyron,
+ float depth, float transT, float inv_width);
+static void calc_phase_change(struct All_variables *E,
+ float **B, float **B_b,
+ float Ra, float clapeyron,
+ float depth, float transT, float inv_width);
+static void debug_phase_change(struct All_variables *E, float **B);
+
+
+void phase_change_allocate(struct All_variables *E)
+{
+ int j;
+ int nno = E->lmesh.nno;
+ int nsf = E->lmesh.nsf;
+
+ for (j=1;j<=E->sphere.caps_per_proc;j++) {
+ E->Fas410[j] = (float *) malloc((nno+1)*sizeof(float));
+ E->Fas410_b[j] = (float *) malloc((nsf+1)*sizeof(float));
+ E->Fas670[j] = (float *) malloc((nno+1)*sizeof(float));
+ E->Fas670_b[j] = (float *) malloc((nsf+1)*sizeof(float));
+ E->Fascmb[j] = (float *) malloc((nno+1)*sizeof(float));
+ E->Fascmb_b[j] = (float *) malloc((nsf+1)*sizeof(float));
+ }
+
+ return;
+}
+
+
+void phase_change_input(struct All_variables *E)
+{
+ int m = E->parallel.me;
+ float width;
+
+ /* for phase change 410km */
+ input_float("Ra_410",&(E->control.Ra_410),"0.0",m);
+ input_float("clapeyron410",&(E->control.clapeyron410),"0.0",m);
+ input_float("transT410",&(E->control.transT410),"0.0",m);
+ input_float("width410",&width,"0.0",m);
+
+ if (width!=0.0)
+ E->control.inv_width410 = 1.0/width;
+
+ /* for phase change 670km */
+ input_float("Ra_670",&(E->control.Ra_670),"0.0",m);
+ input_float("clapeyron670",&(E->control.clapeyron670),"0.0",m);
+ input_float("transT670",&(E->control.transT670),"0.0",m);
+ input_float("width670",&width,"0.0",m);
+
+ if (width!=0.0)
+ E->control.inv_width670 = 1.0/width;
+
+ /* for phase change CMB */
+ input_float("Ra_cmb",&(E->control.Ra_cmb),"0.0",m);
+ input_float("clapeyroncmb",&(E->control.clapeyroncmb),"0.0",m);
+ input_float("transTcmb",&(E->control.transTcmb),"0.0",m);
+ input_float("widthcmb",&width,"0.0",m);
+
+ if (width!=0.0)
+ E->control.inv_widthcmb = 1.0/width;
+
+
+ return;
+}
+
+
+void phase_change_apply_410(struct All_variables *E, double **buoy)
+{
+ if (E->control.Ra_410 != 0.0)
+ phase_change_apply(E, buoy, E->Fas410, E->Fas410_b, E->control.Ra_410,
+ E->control.clapeyron410, E->viscosity.z410,
+ E->control.transT410, E->control.inv_width410);
+ return;
+}
+
+
+void phase_change_apply_670(struct All_variables *E, double **buoy)
+{
+ if (E->control.Ra_670 != 0.0)
+ phase_change_apply(E, buoy, E->Fas670, E->Fas670_b, E->control.Ra_670,
+ E->control.clapeyron670, E->viscosity.zlm,
+ E->control.transT670, E->control.inv_width670);
+ return;
+}
+
+
+void phase_change_apply_cmb(struct All_variables *E, double **buoy)
+{
+ if (E->control.Ra_cmb != 0.0)
+ phase_change_apply(E, buoy, E->Fascmb, E->Fascmb_b, E->control.Ra_cmb,
+ E->control.clapeyroncmb, E->viscosity.zcmb,
+ E->control.transTcmb, E->control.inv_widthcmb);
+ return;
+}
+
+
+static void phase_change_apply(struct All_variables *E, double **buoy,
+ float **B, float **B_b,
+ float Ra, float clapeyron,
+ float depth, float transT, float inv_width)
+{
+ int m, i;
+
+ calc_phase_change(E, B, B_b, Ra, clapeyron, depth, transT, inv_width);
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=1;i<=E->lmesh.nno;i++)
+ buoy[m][i] -= Ra * B[m][i];
+
+ if (E->control.verbose) {
+ fprintf(E->fp_out, "Ra=%f, clapeyron=%f, depth=%f, transT=%f, inv_width=%f\n",
+ Ra, clapeyron, depth, transT, inv_width);
+ debug_phase_change(E,B);
+ fflush(E->fp_out);
+ }
+
+ return;
+}
+
+
+static void calc_phase_change(struct All_variables *E,
+ float **B, float **B_b,
+ float Ra, float clapeyron,
+ float depth, float transT, float inv_width)
+{
+ int i,j,k,n,ns,m,nz;
+ float e_pressure,pt5,one,dz;
+
+ pt5 = 0.5;
+ one = 1.0;
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+ /* compute phase function B, the concentration of the high pressure
+ * phase. B is between 0 and 1. */
+ for(i=1;i<=E->lmesh.nno;i++) {
+ nz = ((i-1) % E->lmesh.noz) + 1;
+ dz = (E->sphere.ro-E->sx[m][3][i]) - depth;
+ /*XXX: dz*rho[nz]*g[nz] is only a approximation for the reduced
+ * pressure, a more accurate formula is:
+ * integral(rho(z)*g(z)*dz) from depth_ph to current depth */
+ e_pressure = dz * E->refstate.rho[nz] * E->refstate.gravity[nz]
+ - clapeyron * (E->T[m][i] - transT);
+
+ B[m][i] = pt5 * (one + tanh(inv_width * e_pressure));
+ }
+
+ /* compute the phase boundary, defined as the depth where B==0.5 */
+ ns = 0;
+ for (k=1;k<=E->lmesh.noy;k++)
+ for (j=1;j<=E->lmesh.nox;j++) {
+ ns++;
+ B_b[m][ns]=0.0;
+ for (i=1;i<E->lmesh.noz;i++) {
+ n = (k-1)*E->lmesh.noz*E->lmesh.nox + (j-1)*E->lmesh.noz + i;
+ if (B[m][n]>=pt5 && B[m][n+1]<=pt5)
+ B_b[m][ns]=(E->sx[m][3][n+1]-E->sx[m][3][n])*(pt5-B[m][n])/(B[m][n+1]-B[m][n])+E->sx[m][3][n];
+ }
+ }
+ }
+
+ return;
+}
+
+
+static void debug_phase_change(struct All_variables *E, float **B)
+{
+ int m, j;
+
+ fprintf(E->fp_out,"output_phase_change_buoyancy\n");
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+ fprintf(E->fp_out,"for cap %d\n",E->sphere.capid[m]);
+ for (j=1;j<=E->lmesh.nno;j++)
+ fprintf(E->fp_out,"Z = %.6e T = %.6e B[%06d] = %.6e \n",E->sx[m][3][j],E->T[m][j],j,B[m][j]);
+ }
+ fflush(E->fp_out);
+
+ return;
+}
Deleted: mc/3D/CitcomS/branches/cxx/lib/Problem_related.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Problem_related.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Problem_related.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,190 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-#include <math.h>
-#include <sys/types.h>
-#include "element_definitions.h"
-#include "global_defs.h"
-
-#ifdef USE_GZDIR
-int open_file_zipped(char *, FILE **,struct All_variables *);
-void gzip_file(char *);
-#endif
-/*=======================================================================
- read velocity vectors at the top surface from files
-=========================================================================*/
-
-void read_velocity_boundary_from_file(E)
- struct All_variables *E;
-{
- (E->solver.read_input_files_for_timesteps)(E,1,1); /* read velocity(1) and output(1) */
- return;
-}
-#ifdef USE_GGRD
-/*
-
-wrapper for ggrd functionality to read in netcdf grid files for
-laterally varying rayleigh number in the top layers
-
- */
-void read_rayleigh_from_file(E)
- struct All_variables *E;
-{
- (E->solver.read_input_files_for_timesteps)(E,4,1); /* read Rayleigh number for top layers */
- return;
-}
-#endif
-/*=======================================================================
- construct material array
-=========================================================================*/
-
-void read_mat_from_file(E)
- struct All_variables *E;
-{
- (E->solver.read_input_files_for_timesteps)(E,3,1); /* read element material(3) and output(1) */
- return;
-
-}
-/*=======================================================================
- read temperature at the top surface from files
-=========================================================================*/
-
-void read_temperature_boundary_from_file(E)
- struct All_variables *E;
-{
- (E->solver.read_input_files_for_timesteps)(E,5,1); /* read temperature(5) and output(1) */
- return;
-}
-
-
-/*=======================================================================
- Open restart file to get initial elapsed time, or calculate the right value
-=========================================================================*/
-
-void get_initial_elapsed_time(E)
- struct All_variables *E;
-{
- FILE *fp;
- int ll, mm,rezip;
- char output_file[255],input_s[1000];
-
- E->monitor.elapsed_time = 0.0;
-
- if (E->convection.tic_method == -1) {
-
-#ifdef USE_GZDIR /* gzdir output */
- if(strcmp(E->output.format, "ascii-gz") == 0){
- if(E->output.gzdir.vtk_io)
- sprintf(output_file, "%s/%d/t.%d.%d",
- E->control.data_dir_old,E->monitor.solution_cycles_init,E->parallel.me,E->monitor.solution_cycles_init);
- else
- sprintf(output_file, "%s/%d/velo.%d.%d",
- E->control.data_dir_old,E->monitor.solution_cycles_init,E->parallel.me,E->monitor.solution_cycles_init);
- }else{
- sprintf(output_file, "%s.velo.%d.%d",E->control.old_P_file,E->parallel.me,E->monitor.solution_cycles_init);
- }
- rezip = open_file_zipped(output_file,&fp,E);
-#else /* all others */
- sprintf(output_file, "%s.velo.%d.%d",E->control.old_P_file,E->parallel.me,E->monitor.solution_cycles_init);
- fp=fopen(output_file,"r");
-#endif
-
- if (fp == NULL) {
- fprintf(E->fp,"(Problem_related #8) Cannot open %s\n",output_file);
- exit(8);
- }
- fgets(input_s,1000,fp);
- sscanf(input_s,"%d %d %f",&ll,&mm,&E->monitor.elapsed_time);
- fclose(fp);
-#ifdef USE_GZDIR
- if(rezip)
- gzip_file(output_file);
-#endif
- } /* end if tic_method */
-
- return;
-}
-
-/*=======================================================================
- Sets the elapsed time to zero, if desired.
-=========================================================================*/
-
-void set_elapsed_time(E)
- struct All_variables *E;
-{
-
- if (E->control.zero_elapsed_time) /* set elapsed_time to zero */
- E->monitor.elapsed_time = 0.0;
-
- return;
-}
-
-/*=======================================================================
- Resets the age at which to start time (startage) to the end of the previous
- run, if desired.
-=========================================================================*/
-
-void set_starting_age(E)
- struct All_variables *E;
-{
-/* remember start_age is in MY */
- if (E->control.reset_startage)
- E->control.start_age = E->monitor.elapsed_time*E->data.scalet;
-
- return;
-}
-
-
-/*=======================================================================
- Returns age at which to open an input file (velocity, material, age)
- NOTE: Remember that ages are positive, but going forward in time means
- making ages SMALLER!
-=========================================================================*/
-
- float find_age_in_MY(E)
-
- struct All_variables *E;
-{
- float age_in_MY, e_4;
-
-
- e_4=1.e-4;
-
- if (E->data.timedir >= 0) { /* forward convection */
- age_in_MY = E->control.start_age - E->monitor.elapsed_time*E->data.scalet;
- }
- else { /* backward convection */
- age_in_MY = E->control.start_age + E->monitor.elapsed_time*E->data.scalet;
- }
-
- if (((age_in_MY+e_4) < 0.0) && (E->monitor.solution_cycles < 1)) {
- if (E->parallel.me == 0) fprintf(stderr,"Age = %g Ma, Initial age should not be negative!\n",age_in_MY);
- exit(11);
- }
-
- return(age_in_MY);
-}
Copied: mc/3D/CitcomS/branches/cxx/lib/Problem_related.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Problem_related.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Problem_related.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Problem_related.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,182 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+#include <math.h>
+#include <string.h>
+#include <sys/types.h>
+#include "element_definitions.h"
+#include "global_defs.h"
+
+#ifdef USE_GZDIR
+int open_file_zipped(char *, FILE **,struct All_variables *);
+void gzip_file(char *);
+#endif
+/*=======================================================================
+ read velocity vectors at the top surface from files
+=========================================================================*/
+
+void read_velocity_boundary_from_file(struct All_variables *E)
+{
+ (E->solver.read_input_files_for_timesteps)(E,1,1); /* read velocity(1) and output(1) */
+ return;
+}
+#ifdef USE_GGRD
+/*
+
+wrapper for ggrd functionality to read in netcdf grid files for
+laterally varying rayleigh number in the top layers
+
+ */
+void read_rayleigh_from_file(struct All_variables *E)
+{
+ (E->solver.read_input_files_for_timesteps)(E,4,1); /* read Rayleigh number for top layers */
+ return;
+}
+#endif
+/*=======================================================================
+ construct material array
+=========================================================================*/
+
+void read_mat_from_file(struct All_variables *E)
+{
+ (E->solver.read_input_files_for_timesteps)(E,3,1); /* read element material(3) and output(1) */
+ return;
+
+}
+/*=======================================================================
+ read temperature at the top surface from files
+=========================================================================*/
+
+void read_temperature_boundary_from_file(struct All_variables *E)
+{
+ (E->solver.read_input_files_for_timesteps)(E,5,1); /* read temperature(5) and output(1) */
+ return;
+}
+
+
+/*=======================================================================
+ Open restart file to get initial elapsed time, or calculate the right value
+=========================================================================*/
+
+void get_initial_elapsed_time(struct All_variables *E)
+{
+ FILE *fp;
+ int ll, mm,rezip;
+ char output_file[255],input_s[1000];
+
+ E->monitor.elapsed_time = 0.0;
+
+ if (E->convection.tic_method == -1) {
+
+#ifdef USE_GZDIR /* gzdir output */
+ if(strcmp(E->output.format, "ascii-gz") == 0){
+ if(E->output.gzdir.vtk_io)
+ sprintf(output_file, "%s/%d/t.%d.%d",
+ E->control.data_dir_old,E->monitor.solution_cycles_init,E->parallel.me,E->monitor.solution_cycles_init);
+ else
+ sprintf(output_file, "%s/%d/velo.%d.%d",
+ E->control.data_dir_old,E->monitor.solution_cycles_init,E->parallel.me,E->monitor.solution_cycles_init);
+ }else{
+ sprintf(output_file, "%s.velo.%d.%d",E->control.old_P_file,E->parallel.me,E->monitor.solution_cycles_init);
+ }
+ rezip = open_file_zipped(output_file,&fp,E);
+#else /* all others */
+ sprintf(output_file, "%s.velo.%d.%d",E->control.old_P_file,E->parallel.me,E->monitor.solution_cycles_init);
+ fp=fopen(output_file,"r");
+#endif
+
+ if (fp == NULL) {
+ fprintf(E->fp,"(Problem_related #8) Cannot open %s\n",output_file);
+ exit(8);
+ }
+ fgets(input_s,1000,fp);
+ sscanf(input_s,"%d %d %f",&ll,&mm,&E->monitor.elapsed_time);
+ fclose(fp);
+#ifdef USE_GZDIR
+ if(rezip)
+ gzip_file(output_file);
+#endif
+ } /* end if tic_method */
+
+ return;
+}
+
+/*=======================================================================
+ Sets the elapsed time to zero, if desired.
+=========================================================================*/
+
+void set_elapsed_time(struct All_variables *E)
+{
+
+ if (E->control.zero_elapsed_time) /* set elapsed_time to zero */
+ E->monitor.elapsed_time = 0.0;
+
+ return;
+}
+
+/*=======================================================================
+ Resets the age at which to start time (startage) to the end of the previous
+ run, if desired.
+=========================================================================*/
+
+void set_starting_age(struct All_variables *E)
+{
+/* remember start_age is in MY */
+ if (E->control.reset_startage)
+ E->control.start_age = E->monitor.elapsed_time*E->data.scalet;
+
+ return;
+}
+
+
+/*=======================================================================
+ Returns age at which to open an input file (velocity, material, age)
+ NOTE: Remember that ages are positive, but going forward in time means
+ making ages SMALLER!
+=========================================================================*/
+
+float find_age_in_MY(struct All_variables *E)
+{
+ float age_in_MY, e_4;
+
+
+ e_4=1.e-4;
+
+ if (E->data.timedir >= 0) { /* forward convection */
+ age_in_MY = E->control.start_age - E->monitor.elapsed_time*E->data.scalet;
+ }
+ else { /* backward convection */
+ age_in_MY = E->control.start_age + E->monitor.elapsed_time*E->data.scalet;
+ }
+
+ if (((age_in_MY+e_4) < 0.0) && (E->monitor.solution_cycles < 1)) {
+ if (E->parallel.me == 0) fprintf(stderr,"Age = %g Ma, Initial age should not be negative!\n",age_in_MY);
+ exit(11);
+ }
+
+ return(age_in_MY);
+}
Deleted: mc/3D/CitcomS/branches/cxx/lib/Process_buoyancy.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Process_buoyancy.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Process_buoyancy.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,418 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-
-/* Here are the routines which process the results of each buoyancy solution, and call
- any relevant output routines. Much of the information has probably been output along
- with the velocity field. (So the velocity vectors and other data are fully in sync).
- However, heat fluxes and temperature averages are calculated here (even when they
- get output the next time around the velocity solver);
- */
-
-
-#include "element_definitions.h"
-#include "global_defs.h"
-#include "output.h"
-#include <math.h> /* for sqrt */
-
-void parallel_process_termination(void);
-
-
-static void output_interpolated_fields(struct All_variables *E)
-{
- void compute_horiz_avg(struct All_variables *E);
- void full_get_shape_functions(struct All_variables *E,
- double shp[9], int nelem,
- double theta, double phi, double rad);
- void regional_get_shape_functions(struct All_variables *E,
- double shp[9], int nelem,
- double theta, double phi, double rad);
- double full_interpolate_data(struct All_variables *E,
- double shp[9], double data[9]);
- double regional_interpolate_data(struct All_variables *E,
- double shp[9], double data[9]);
- char output_file[256];
- FILE *fp1;
- const int m = 1;
- int n, ncolumns, ncomp;
- double *compositions;
-
- snprintf(output_file, 255, "%s.intp_fields.%d",
- E->control.data_file, E->parallel.me);
- fp1 = output_open(output_file, "w");
-
- ncomp = 0;
- compositions = NULL;
- if(E->composition.on) {
- ncomp = E->composition.ncomp;
- compositions = malloc(ncomp * sizeof(double));
- if(compositions == NULL) {
- fprintf(stderr, "output_interpolated_fields(): 2 not enough memory.\n");
- exit(1);
- }
- }
-
- switch(E->trace.itracer_interpolate_fields) {
- case 1:
- case 2:
- case 3:
- /* Format of the output --
- * 1st line is the header:
- * [ntracers, model_type, ncolumns, ncompositions]
- * the rest is data:
- * [flavor0, flavor1, radius, temperature, composition(s)]
- */
-
- if(E->parallel.me == 0) {
- fprintf(E->fp, "Temperature contrast is %e Kelvin\n",
- E->data.ref_temperature);
- fprintf(stderr, "Temperature contrast is %e Kelvin\n",
- E->data.ref_temperature);
- }
-
- ncolumns = 4;
- if(E->composition.on) {
- ncolumns += E->composition.ncomp;
- }
-
- /* get the horizontal average of temperature and composition */
- compute_horiz_avg(E);
-
- fprintf(fp1,"%d %d %d %d\n",
- E->trace.ntracers[m], E->trace.itracer_interpolate_fields,
- ncolumns, ncomp);
-
-
- for(n=1; n<=E->trace.ntracers[m]; n++) {
- int i, j, k;
- int nelem, flavor0, flavor1;
- int node[9], nz[9];
- double shpfn[9], data[9];
- double theta, phi, rad;
- double temperature;
-
- nelem = E->trace.ielement[m][n];
- theta = E->trace.basicq[m][0][n];
- phi = E->trace.basicq[m][1][n];
- rad = E->trace.basicq[m][2][n];
-
- flavor0 = E->trace.extraq[m][0][n];
- flavor1 = E->trace.extraq[m][1][n];
-
- /* get shape functions at the tracer location */
- if(E->parallel.nprocxy == 12)
- full_get_shape_functions(E, shpfn, nelem, theta, phi, rad);
- else
- regional_get_shape_functions(E, shpfn, nelem, theta, phi, rad);
-
- /* fetch element data for interpolation */
- for(i=1; i<=ENODES3D; i++) {
- node[i] = E->ien[m][nelem].node[i];
- nz[i] = (node[i] - 1) % E->lmesh.noz + 1;
- }
-
- for(i=1; i<=ENODES3D; i++) {
- data[i] = E->T[m][node[i]] - E->Have.T[nz[i]];
- }
-
- if(E->parallel.nprocxy == 12)
- temperature = full_interpolate_data(E, shpfn, data);
- else
- temperature = regional_interpolate_data(E, shpfn, data);
-
- /** debug **
- fprintf(E->trace.fpt, "result: %e data: %e %e %e %e %e %e %e %e\n",
- temperature, data[1], data[2], data[3], data[4], data[5], data[6], data[7], data[8]);
- /**/
-
- for(j=0; j<E->composition.ncomp; j++) {
- for(i=1; i<=ENODES3D; i++) {
- data[i] = E->composition.comp_node[m][j][node[i]]
- - E->Have.C[j][nz[i]];
- }
- if(E->parallel.nprocxy == 12)
- compositions[j] = full_interpolate_data(E, shpfn, data);
- else
- compositions[j] = regional_interpolate_data(E, shpfn, data);
-
- /** debug **
- fprintf(E->trace.fpt, "result: %e data: %e %e %e %e %e %e %e %e\n",
- compositions[j], data[1], data[2], data[3], data[4], data[5], data[6], data[7], data[8]);
- /**/
- }
-
- /* dimensionalize */
- rad *= 1e3 * E->data.radius_km;
- temperature *= E->data.ref_temperature;
-
- /* output */
- fprintf(fp1,"%d %d %e %e",
- flavor0, flavor1, rad, temperature);
-
- for(j=0; j<E->composition.ncomp; j++) {
- fprintf(fp1," %e", compositions[j]);
- }
- fprintf(fp1, "\n");
- }
-
- break;
- case 100:
- /* user modification here */
- ncolumns = 2;
- break;
- default:
- if(E->parallel.me == 0) {
- fprintf(stderr, "Paramter `itracer_interpolate_fields' has unknown value: %d", E->trace.itracer_interpolate_fields);
- fprintf(E->fp, "Paramter `itracer_interpolate_fields' has unknown value: %d", E->trace.itracer_interpolate_fields);
- }
- parallel_process_termination();
-
- }
-
- if(E->composition.on)
- free(compositions);
-
- fclose(fp1);
- return;
-}
-
-
-void post_processing(struct All_variables *E)
-{
- void dump_and_get_new_tracers_to_interpolate_fields(struct All_variables *E);
-
- if (E->control.tracer && E->trace.itracer_interpolate_fields) {
- dump_and_get_new_tracers_to_interpolate_fields(E);
- output_interpolated_fields(E);
- }
- return;
-}
-
-
-
-/* ===================
- Surface heat flux
- =================== */
-
-void heat_flux(E)
- struct All_variables *E;
-{
- int m,e,el,i,j,node,lnode;
- float *flux[NCS],*SU[NCS],*RU[NCS];
- float VV[4][9],u[9],T[9],dTdz[9],area,uT;
- float *sum_h;
-
- void velo_from_element();
- void sum_across_surface();
- void return_horiz_ave();
- void return_horiz_ave_f();
-
- const int dims=E->mesh.nsd,dofs=E->mesh.dof;
- const int vpts=vpoints[dims];
- const int ppts=ppoints[dims];
- const int ends=enodes[dims];
- const int nno=E->lmesh.nno;
- const int lev = E->mesh.levmax;
- const int sphere_key=1;
-
- sum_h = (float *) malloc((5)*sizeof(float));
- for(i=0;i<=4;i++)
- sum_h[i] = 0.0;
-
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
-
- flux[m] = (float *) malloc((1+nno)*sizeof(float));
-
- for(i=1;i<=nno;i++) {
- flux[m][i] = 0.0;
- }
-
- for(e=1;e<=E->lmesh.nel;e++) {
-
- velo_from_element(E,VV,m,e,sphere_key);
-
- for(i=1;i<=vpts;i++) {
- u[i] = 0.0;
- T[i] = 0.0;
- dTdz[i] = 0.0;
- for(j=1;j<=ends;j++) {
- u[i] += VV[3][j]*E->N.vpt[GNVINDEX(j,i)];
- T[i] += E->T[m][E->ien[m][e].node[j]]*E->N.vpt[GNVINDEX(j,i)];
- dTdz[i] += -E->T[m][E->ien[m][e].node[j]]*E->gNX[m][e].vpt[GNVXINDEX(2,j,i)];
- }
- }
-
- uT = 0.0;
- area = 0.0;
- for(i=1;i<=vpts;i++) {
- /* XXX: missing unit conversion, heat capacity and thermal conductivity */
- uT += u[i]*T[i]*E->gDA[m][e].vpt[i] + dTdz[i]*E->gDA[m][e].vpt[i];
- }
-
- uT /= E->eco[m][e].area;
-
- for(j=1;j<=ends;j++)
- flux[m][E->ien[m][e].node[j]] += uT*E->TWW[lev][m][e].node[j];
-
- } /* end of e */
- } /* end of m */
-
-
- (E->exchange_node_f)(E,flux,lev);
-
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=1;i<=nno;i++)
- flux[m][i] *= E->MASS[lev][m][i];
-
- if (E->parallel.me_loc[3]==E->parallel.nprocz-1)
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=1;i<=E->lmesh.nsf;i++)
- E->slice.shflux[m][i]=2*flux[m][E->surf_node[m][i]]-flux[m][E->surf_node[m][i]-1];
-
- if (E->parallel.me_loc[3]==0)
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=1;i<=E->lmesh.nsf;i++)
- E->slice.bhflux[m][i] = 2*flux[m][E->surf_node[m][i]-E->lmesh.noz+1]
- - flux[m][E->surf_node[m][i]-E->lmesh.noz+2];
-
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(e=1;e<=E->lmesh.snel;e++) {
- uT =(E->slice.shflux[m][E->sien[m][e].node[1]] +
- E->slice.shflux[m][E->sien[m][e].node[2]] +
- E->slice.shflux[m][E->sien[m][e].node[3]] +
- E->slice.shflux[m][E->sien[m][e].node[4]])*0.25;
- el = e*E->lmesh.elz;
- sum_h[0] += uT*E->eco[m][el].area;
- sum_h[1] += E->eco[m][el].area;
-
- uT =(E->slice.bhflux[m][E->sien[m][e].node[1]] +
- E->slice.bhflux[m][E->sien[m][e].node[2]] +
- E->slice.bhflux[m][E->sien[m][e].node[3]] +
- E->slice.bhflux[m][E->sien[m][e].node[4]])*0.25;
- el = (e-1)*E->lmesh.elz+1;
- sum_h[2] += uT*E->eco[m][el].area;
- sum_h[3] += E->eco[m][el].area;
- }
-
- sum_across_surface(E,sum_h,4);
-
- if (E->parallel.me_loc[3]==E->parallel.nprocz-1) {
- sum_h[0] = sum_h[0]/sum_h[1];
- /* if (E->control.verbose && E->parallel.me==E->parallel.nprocz-1) {
- fprintf(E->fp_out,"surface heat flux= %f %f\n",sum_h[0],E->monitor.elapsed_time);
- fflush(E->fp_out);
- } */
- if (E->parallel.me==E->parallel.nprocz-1) {
- fprintf(stderr,"surface heat flux= %f\n",sum_h[0]);
- //fprintf(E->fp,"surface heat flux= %f\n",sum_h[0]); //commented out because E->fp is only on CPU 0
-
- if(E->output.write_q_files > 0){
- /* format: time heat_flow sqrt(v.v) */
- fprintf(E->output.fpqt,"%13.5e %13.5e %13.5e\n",E->monitor.elapsed_time,sum_h[0],sqrt(E->monitor.vdotv));
- fflush(E->output.fpqt);
- }
- }
- }
-
- if (E->parallel.me_loc[3]==0) {
- sum_h[2] = sum_h[2]/sum_h[3];
-/* if (E->control.verbose && E->parallel.me==0) fprintf(E->fp_out,"bottom heat flux= %f %f\n",sum_h[2],E->monitor.elapsed_time); */
- if (E->parallel.me==0) {
- fprintf(stderr,"bottom heat flux= %f\n",sum_h[2]);
- fprintf(E->fp,"bottom heat flux= %f\n",sum_h[2]);
- if(E->output.write_q_files > 0){
- fprintf(E->output.fpqb,"%13.5e %13.5e %13.5e\n",
- E->monitor.elapsed_time,sum_h[2],sqrt(E->monitor.vdotv));
- fflush(E->output.fpqb);
- }
-
- }
- }
-
-
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- free((void *)flux[m]);
-
- free((void *)sum_h);
-
- return;
-}
-
-
-
-/*
- compute horizontal average of temperature, composition and rms velocity
-*/
-void compute_horiz_avg(struct All_variables *E)
-{
- void return_horiz_ave_f();
-
- int m, n, i;
- float *S1[NCS],*S2[NCS],*S3[NCS];
-
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
- S1[m] = (float *)malloc((E->lmesh.nno+1)*sizeof(float));
- S2[m] = (float *)malloc((E->lmesh.nno+1)*sizeof(float));
- S3[m] = (float *)malloc((E->lmesh.nno+1)*sizeof(float));
- }
-
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
- for(i=1;i<=E->lmesh.nno;i++) {
- S1[m][i] = E->T[m][i];
- S2[m][i] = E->sphere.cap[m].V[1][i]*E->sphere.cap[m].V[1][i]
- + E->sphere.cap[m].V[2][i]*E->sphere.cap[m].V[2][i];
- S3[m][i] = E->sphere.cap[m].V[3][i]*E->sphere.cap[m].V[3][i];
- }
- }
-
- return_horiz_ave_f(E,S1,E->Have.T);
- return_horiz_ave_f(E,S2,E->Have.V[1]);
- return_horiz_ave_f(E,S3,E->Have.V[2]);
-
- if (E->composition.on) {
- for(n=0; n<E->composition.ncomp; n++) {
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
- for(i=1;i<=E->lmesh.nno;i++)
- S1[m][i] = E->composition.comp_node[m][n][i];
- }
- return_horiz_ave_f(E,S1,E->Have.C[n]);
- }
- }
-
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
- free((void *)S1[m]);
- free((void *)S2[m]);
- free((void *)S3[m]);
- }
-
- for (i=1;i<=E->lmesh.noz;i++) {
- E->Have.V[1][i] = sqrt(E->Have.V[1][i]);
- E->Have.V[2][i] = sqrt(E->Have.V[2][i]);
- }
-
- return;
-}
Copied: mc/3D/CitcomS/branches/cxx/lib/Process_buoyancy.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Process_buoyancy.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Process_buoyancy.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Process_buoyancy.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,412 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+
+/* Here are the routines which process the results of each buoyancy solution, and call
+ any relevant output routines. Much of the information has probably been output along
+ with the velocity field. (So the velocity vectors and other data are fully in sync).
+ However, heat fluxes and temperature averages are calculated here (even when they
+ get output the next time around the velocity solver);
+ */
+
+
+#include "element_definitions.h"
+#include "global_defs.h"
+#include "output.h"
+#include <math.h> /* for sqrt */
+
+#include "cproto.h"
+
+void parallel_process_termination(void);
+
+
+static void output_interpolated_fields(struct All_variables *E)
+{
+ void compute_horiz_avg(struct All_variables *E);
+ void full_get_shape_functions(struct All_variables *E,
+ double shp[9], int nelem,
+ double theta, double phi, double rad);
+ void regional_get_shape_functions(struct All_variables *E,
+ double shp[9], int nelem,
+ double theta, double phi, double rad);
+ double full_interpolate_data(struct All_variables *E,
+ double shp[9], double data[9]);
+ double regional_interpolate_data(struct All_variables *E,
+ double shp[9], double data[9]);
+ char output_file[256];
+ FILE *fp1;
+ const int m = 1;
+ int n, ncolumns, ncomp;
+ double *compositions;
+
+ snprintf(output_file, 255, "%s.intp_fields.%d",
+ E->control.data_file, E->parallel.me);
+ fp1 = output_open(output_file, "w");
+
+ ncomp = 0;
+ compositions = NULL;
+ if(E->composition.on) {
+ ncomp = E->composition.ncomp;
+ compositions = (double *)malloc(ncomp * sizeof(double));
+ if(compositions == NULL) {
+ fprintf(stderr, "output_interpolated_fields(): 2 not enough memory.\n");
+ exit(1);
+ }
+ }
+
+ switch(E->trace.itracer_interpolate_fields) {
+ case 1:
+ case 2:
+ case 3:
+ /* Format of the output --
+ * 1st line is the header:
+ * [ntracers, model_type, ncolumns, ncompositions]
+ * the rest is data:
+ * [flavor0, flavor1, radius, temperature, composition(s)]
+ */
+
+ if(E->parallel.me == 0) {
+ fprintf(E->fp, "Temperature contrast is %e Kelvin\n",
+ E->data.ref_temperature);
+ fprintf(stderr, "Temperature contrast is %e Kelvin\n",
+ E->data.ref_temperature);
+ }
+
+ ncolumns = 4;
+ if(E->composition.on) {
+ ncolumns += E->composition.ncomp;
+ }
+
+ /* get the horizontal average of temperature and composition */
+ compute_horiz_avg(E);
+
+ fprintf(fp1,"%d %d %d %d\n",
+ E->trace.ntracers[m], E->trace.itracer_interpolate_fields,
+ ncolumns, ncomp);
+
+
+ for(n=1; n<=E->trace.ntracers[m]; n++) {
+ int i, j, k;
+ int nelem, flavor0, flavor1;
+ int node[9], nz[9];
+ double shpfn[9], data[9];
+ double theta, phi, rad;
+ double temperature;
+
+ nelem = E->trace.ielement[m][n];
+ theta = E->trace.basicq[m][0][n];
+ phi = E->trace.basicq[m][1][n];
+ rad = E->trace.basicq[m][2][n];
+
+ flavor0 = (int)E->trace.extraq[m][0][n];
+ flavor1 = (int)E->trace.extraq[m][1][n];
+
+ /* get shape functions at the tracer location */
+ if(E->parallel.nprocxy == 12)
+ full_get_shape_functions(E, shpfn, nelem, theta, phi, rad);
+ else
+ regional_get_shape_functions(E, shpfn, nelem, theta, phi, rad);
+
+ /* fetch element data for interpolation */
+ for(i=1; i<=ENODES3D; i++) {
+ node[i] = E->ien[m][nelem].node[i];
+ nz[i] = (node[i] - 1) % E->lmesh.noz + 1;
+ }
+
+ for(i=1; i<=ENODES3D; i++) {
+ data[i] = E->T[m][node[i]] - E->Have.T[nz[i]];
+ }
+
+ if(E->parallel.nprocxy == 12)
+ temperature = full_interpolate_data(E, shpfn, data);
+ else
+ temperature = regional_interpolate_data(E, shpfn, data);
+
+ /** debug **
+ fprintf(E->trace.fpt, "result: %e data: %e %e %e %e %e %e %e %e\n",
+ temperature, data[1], data[2], data[3], data[4], data[5], data[6], data[7], data[8]);
+ /**/
+
+ for(j=0; j<E->composition.ncomp; j++) {
+ for(i=1; i<=ENODES3D; i++) {
+ data[i] = E->composition.comp_node[m][j][node[i]]
+ - E->Have.C[j][nz[i]];
+ }
+ if(E->parallel.nprocxy == 12)
+ compositions[j] = full_interpolate_data(E, shpfn, data);
+ else
+ compositions[j] = regional_interpolate_data(E, shpfn, data);
+
+ /** debug **
+ fprintf(E->trace.fpt, "result: %e data: %e %e %e %e %e %e %e %e\n",
+ compositions[j], data[1], data[2], data[3], data[4], data[5], data[6], data[7], data[8]);
+ /**/
+ }
+
+ /* dimensionalize */
+ rad *= 1e3 * E->data.radius_km;
+ temperature *= E->data.ref_temperature;
+
+ /* output */
+ fprintf(fp1,"%d %d %e %e",
+ flavor0, flavor1, rad, temperature);
+
+ for(j=0; j<E->composition.ncomp; j++) {
+ fprintf(fp1," %e", compositions[j]);
+ }
+ fprintf(fp1, "\n");
+ }
+
+ break;
+ case 100:
+ /* user modification here */
+ ncolumns = 2;
+ break;
+ default:
+ if(E->parallel.me == 0) {
+ fprintf(stderr, "Paramter `itracer_interpolate_fields' has unknown value: %d", E->trace.itracer_interpolate_fields);
+ fprintf(E->fp, "Paramter `itracer_interpolate_fields' has unknown value: %d", E->trace.itracer_interpolate_fields);
+ }
+ parallel_process_termination();
+
+ }
+
+ if(E->composition.on)
+ free(compositions);
+
+ fclose(fp1);
+ return;
+}
+
+
+void post_processing(struct All_variables *E)
+{
+ void dump_and_get_new_tracers_to_interpolate_fields(struct All_variables *E);
+
+ if (E->control.tracer && E->trace.itracer_interpolate_fields) {
+ dump_and_get_new_tracers_to_interpolate_fields(E);
+ output_interpolated_fields(E);
+ }
+ return;
+}
+
+
+
+/* ===================
+ Surface heat flux
+ =================== */
+
+void heat_flux(struct All_variables *E)
+{
+ int m,e,el,i,j,node,lnode;
+ float *flux[NCS],*SU[NCS],*RU[NCS];
+ float VV[4][9],u[9],T[9],dTdz[9],area,uT;
+ float *sum_h;
+
+ const int dims=E->mesh.nsd,dofs=E->mesh.dof;
+ const int vpts=vpoints[dims];
+ const int ppts=ppoints[dims];
+ const int ends=enodes[dims];
+ const int nno=E->lmesh.nno;
+ const int lev = E->mesh.levmax;
+ const int sphere_key=1;
+
+ sum_h = (float *) malloc((5)*sizeof(float));
+ for(i=0;i<=4;i++)
+ sum_h[i] = 0.0;
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+
+ flux[m] = (float *) malloc((1+nno)*sizeof(float));
+
+ for(i=1;i<=nno;i++) {
+ flux[m][i] = 0.0;
+ }
+
+ for(e=1;e<=E->lmesh.nel;e++) {
+
+ velo_from_element(E,VV,m,e,sphere_key);
+
+ for(i=1;i<=vpts;i++) {
+ u[i] = 0.0;
+ T[i] = 0.0;
+ dTdz[i] = 0.0;
+ for(j=1;j<=ends;j++) {
+ u[i] += VV[3][j]*E->N.vpt[GNVINDEX(j,i)];
+ T[i] += E->T[m][E->ien[m][e].node[j]]*E->N.vpt[GNVINDEX(j,i)];
+ dTdz[i] += -E->T[m][E->ien[m][e].node[j]]*E->gNX[m][e].vpt[GNVXINDEX(2,j,i)];
+ }
+ }
+
+ uT = 0.0;
+ area = 0.0;
+ for(i=1;i<=vpts;i++) {
+ /* XXX: missing unit conversion, heat capacity and thermal conductivity */
+ uT += u[i]*T[i]*E->gDA[m][e].vpt[i] + dTdz[i]*E->gDA[m][e].vpt[i];
+ }
+
+ uT /= E->eco[m][e].area;
+
+ for(j=1;j<=ends;j++)
+ flux[m][E->ien[m][e].node[j]] += uT*E->TWW[lev][m][e].node[j];
+
+ } /* end of e */
+ } /* end of m */
+
+
+ (E->exchange_node_f)(E,flux,lev);
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=1;i<=nno;i++)
+ flux[m][i] *= E->MASS[lev][m][i];
+
+ if (E->parallel.me_loc[3]==E->parallel.nprocz-1)
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=1;i<=E->lmesh.nsf;i++)
+ E->slice.shflux[m][i]=2*flux[m][E->surf_node[m][i]]-flux[m][E->surf_node[m][i]-1];
+
+ if (E->parallel.me_loc[3]==0)
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=1;i<=E->lmesh.nsf;i++)
+ E->slice.bhflux[m][i] = 2*flux[m][E->surf_node[m][i]-E->lmesh.noz+1]
+ - flux[m][E->surf_node[m][i]-E->lmesh.noz+2];
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(e=1;e<=E->lmesh.snel;e++) {
+ uT =(E->slice.shflux[m][E->sien[m][e].node[1]] +
+ E->slice.shflux[m][E->sien[m][e].node[2]] +
+ E->slice.shflux[m][E->sien[m][e].node[3]] +
+ E->slice.shflux[m][E->sien[m][e].node[4]])*0.25;
+ el = e*E->lmesh.elz;
+ sum_h[0] += uT*E->eco[m][el].area;
+ sum_h[1] += E->eco[m][el].area;
+
+ uT =(E->slice.bhflux[m][E->sien[m][e].node[1]] +
+ E->slice.bhflux[m][E->sien[m][e].node[2]] +
+ E->slice.bhflux[m][E->sien[m][e].node[3]] +
+ E->slice.bhflux[m][E->sien[m][e].node[4]])*0.25;
+ el = (e-1)*E->lmesh.elz+1;
+ sum_h[2] += uT*E->eco[m][el].area;
+ sum_h[3] += E->eco[m][el].area;
+ }
+
+ sum_across_surface(E,sum_h,4);
+
+ if (E->parallel.me_loc[3]==E->parallel.nprocz-1) {
+ sum_h[0] = sum_h[0]/sum_h[1];
+ /* if (E->control.verbose && E->parallel.me==E->parallel.nprocz-1) {
+ fprintf(E->fp_out,"surface heat flux= %f %f\n",sum_h[0],E->monitor.elapsed_time);
+ fflush(E->fp_out);
+ } */
+ if (E->parallel.me==E->parallel.nprocz-1) {
+ fprintf(stderr,"surface heat flux= %f\n",sum_h[0]);
+ //fprintf(E->fp,"surface heat flux= %f\n",sum_h[0]); //commented out because E->fp is only on CPU 0
+
+ if(E->output.write_q_files > 0){
+ /* format: time heat_flow sqrt(v.v) */
+ fprintf(E->output.fpqt,"%13.5e %13.5e %13.5e\n",E->monitor.elapsed_time,sum_h[0],sqrt(E->monitor.vdotv));
+ fflush(E->output.fpqt);
+ }
+ }
+ }
+
+ if (E->parallel.me_loc[3]==0) {
+ sum_h[2] = sum_h[2]/sum_h[3];
+/* if (E->control.verbose && E->parallel.me==0) fprintf(E->fp_out,"bottom heat flux= %f %f\n",sum_h[2],E->monitor.elapsed_time); */
+ if (E->parallel.me==0) {
+ fprintf(stderr,"bottom heat flux= %f\n",sum_h[2]);
+ fprintf(E->fp,"bottom heat flux= %f\n",sum_h[2]);
+ if(E->output.write_q_files > 0){
+ fprintf(E->output.fpqb,"%13.5e %13.5e %13.5e\n",
+ E->monitor.elapsed_time,sum_h[2],sqrt(E->monitor.vdotv));
+ fflush(E->output.fpqb);
+ }
+
+ }
+ }
+
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ free((void *)flux[m]);
+
+ free((void *)sum_h);
+
+ return;
+}
+
+
+
+/*
+ compute horizontal average of temperature, composition and rms velocity
+*/
+void compute_horiz_avg(struct All_variables *E)
+{
+ int m, n, i;
+ float *S1[NCS],*S2[NCS],*S3[NCS];
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+ S1[m] = (float *)malloc((E->lmesh.nno+1)*sizeof(float));
+ S2[m] = (float *)malloc((E->lmesh.nno+1)*sizeof(float));
+ S3[m] = (float *)malloc((E->lmesh.nno+1)*sizeof(float));
+ }
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+ for(i=1;i<=E->lmesh.nno;i++) {
+ S1[m][i] = E->T[m][i];
+ S2[m][i] = E->sphere.cap[m].V[1][i]*E->sphere.cap[m].V[1][i]
+ + E->sphere.cap[m].V[2][i]*E->sphere.cap[m].V[2][i];
+ S3[m][i] = E->sphere.cap[m].V[3][i]*E->sphere.cap[m].V[3][i];
+ }
+ }
+
+ return_horiz_ave_f(E,S1,E->Have.T);
+ return_horiz_ave_f(E,S2,E->Have.V[1]);
+ return_horiz_ave_f(E,S3,E->Have.V[2]);
+
+ if (E->composition.on) {
+ for(n=0; n<E->composition.ncomp; n++) {
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+ for(i=1;i<=E->lmesh.nno;i++)
+ S1[m][i] = E->composition.comp_node[m][n][i];
+ }
+ return_horiz_ave_f(E,S1,E->Have.C[n]);
+ }
+ }
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+ free((void *)S1[m]);
+ free((void *)S2[m]);
+ free((void *)S3[m]);
+ }
+
+ for (i=1;i<=E->lmesh.noz;i++) {
+ E->Have.V[1][i] = sqrt(E->Have.V[1][i]);
+ E->Have.V[2][i] = sqrt(E->Have.V[2][i]);
+ }
+
+ return;
+}
Deleted: mc/3D/CitcomS/branches/cxx/lib/Regional_boundary_conditions.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Regional_boundary_conditions.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Regional_boundary_conditions.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,458 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-#include "element_definitions.h"
-#include "global_defs.h"
-#include <math.h>
-
-#include "lith_age.h"
-
-/* ========================================== */
-
-static void horizontal_bc();
-static void velocity_apply_periodic_bcs();
-static void temperature_apply_periodic_bcs();
-static void velocity_refl_vert_bc();
-static void temperature_refl_vert_bc();
-void read_temperature_boundary_from_file(struct All_variables *);
-void read_velocity_boundary_from_file(struct All_variables *);
-
-/* ========================================== */
-
-void regional_velocity_boundary_conditions(E)
- struct All_variables *E;
-{
- void velocity_imp_vert_bc();
- void renew_top_velocity_boundary();
- void apply_side_sbc();
-
- int node,d,j,noz,lv;
-
- for(lv=E->mesh.gridmax;lv>=E->mesh.gridmin;lv--)
- for (j=1;j<=E->sphere.caps_per_proc;j++) {
- noz = E->lmesh.NOZ[lv];
-
- if(E->mesh.topvbc == 0) {
- horizontal_bc(E,E->sphere.cap[j].VB,noz,1,0.0,VBX,0,lv,j);
- horizontal_bc(E,E->sphere.cap[j].VB,noz,3,0.0,VBZ,1,lv,j);
- horizontal_bc(E,E->sphere.cap[j].VB,noz,2,0.0,VBY,0,lv,j);
- horizontal_bc(E,E->sphere.cap[j].VB,noz,1,E->control.VBXtopval,SBX,1,lv,j);
- horizontal_bc(E,E->sphere.cap[j].VB,noz,3,0.0,SBZ,0,lv,j);
- horizontal_bc(E,E->sphere.cap[j].VB,noz,2,E->control.VBYtopval,SBY,1,lv,j);
- }
- else if(E->mesh.topvbc == 1) {
- horizontal_bc(E,E->sphere.cap[j].VB,noz,1,E->control.VBXtopval,VBX,1,lv,j);
- horizontal_bc(E,E->sphere.cap[j].VB,noz,3,0.0,VBZ,1,lv,j);
- horizontal_bc(E,E->sphere.cap[j].VB,noz,2,E->control.VBYtopval,VBY,1,lv,j);
- horizontal_bc(E,E->sphere.cap[j].VB,noz,1,0.0,SBX,0,lv,j);
- horizontal_bc(E,E->sphere.cap[j].VB,noz,3,0.0,SBZ,0,lv,j);
- horizontal_bc(E,E->sphere.cap[j].VB,noz,2,0.0,SBY,0,lv,j);
-
- if(E->control.vbcs_file) {
- if((lv == E->mesh.gridmin) && (j == E->sphere.caps_per_proc))
- read_velocity_boundary_from_file(E); /* read in the velocity boundary condition from file */
- }
- }
- else if(E->mesh.topvbc == 2) {
- /* This extra BC is for a open top */
- horizontal_bc(E,E->sphere.cap[j].VB,noz,1,0.0,VBX,0,lv,j);
- horizontal_bc(E,E->sphere.cap[j].VB,noz,3,0.0,VBZ,0,lv,j);
- horizontal_bc(E,E->sphere.cap[j].VB,noz,2,0.0,VBY,0,lv,j);
- horizontal_bc(E,E->sphere.cap[j].VB,noz,1,E->control.VBXtopval,SBX,1,lv,j);
- horizontal_bc(E,E->sphere.cap[j].VB,noz,3,0.0,SBZ,1,lv,j);
- horizontal_bc(E,E->sphere.cap[j].VB,noz,2,E->control.VBYtopval,SBY,1,lv,j);
- }
-
-
-
- if(E->mesh.botvbc == 0) {
- horizontal_bc(E,E->sphere.cap[j].VB,1,1,0.0,VBX,0,lv,j);
- horizontal_bc(E,E->sphere.cap[j].VB,1,3,0.0,VBZ,1,lv,j);
- horizontal_bc(E,E->sphere.cap[j].VB,1,2,0.0,VBY,0,lv,j);
- horizontal_bc(E,E->sphere.cap[j].VB,1,1,E->control.VBXbotval,SBX,1,lv,j);
- horizontal_bc(E,E->sphere.cap[j].VB,1,3,0.0,SBZ,0,lv,j);
- horizontal_bc(E,E->sphere.cap[j].VB,1,2,E->control.VBYbotval,SBY,1,lv,j);
- }
- else if(E->mesh.botvbc == 1) {
- horizontal_bc(E,E->sphere.cap[j].VB,1,1,E->control.VBXbotval,VBX,1,lv,j);
- horizontal_bc(E,E->sphere.cap[j].VB,1,3,0.0,VBZ,1,lv,j);
- horizontal_bc(E,E->sphere.cap[j].VB,1,2,E->control.VBYbotval,VBY,1,lv,j);
- horizontal_bc(E,E->sphere.cap[j].VB,1,1,0.0,SBX,0,lv,j);
- horizontal_bc(E,E->sphere.cap[j].VB,1,3,0.0,SBZ,0,lv,j);
- horizontal_bc(E,E->sphere.cap[j].VB,1,2,0.0,SBY,0,lv,j);
- }
- } /* end for j and lv */
-
- velocity_refl_vert_bc(E);
-
- if(E->control.side_sbcs)
- apply_side_sbc(E);
-
- if(E->control.verbose) {
- for (j=1;j<=E->sphere.caps_per_proc;j++)
- for (node=1;node<=E->lmesh.nno;node++)
- fprintf(E->fp_out,"m=%d VB== %d %g %g %g flag %u %u %u\n",j,node,E->sphere.cap[j].VB[1][node],E->sphere.cap[j].VB[2][node],E->sphere.cap[j].VB[3][node],E->node[j][node]&VBX,E->node[j][node]&VBY,E->node[j][node]&VBZ);
- fflush(E->fp_out);
- }
- /* If any imposed internal velocity structure it goes here */
-
-
- return;
-}
-
-
-/* ========================================== */
-
-void regional_temperature_boundary_conditions(E)
- struct All_variables *E;
-{
- void temperature_imposed_vert_bcs();
- void temperature_lith_adj();
- void temperatures_conform_bcs();
- int j,lev,noz;
-
- lev = E->mesh.levmax;
-
-
- temperature_refl_vert_bc(E);
-
- for (j=1;j<=E->sphere.caps_per_proc;j++) {
- noz = E->lmesh.noz;
- if(E->mesh.toptbc == 1) {
- horizontal_bc(E,E->sphere.cap[j].TB,noz,3,E->control.TBCtopval,TBZ,1,lev,j);
- horizontal_bc(E,E->sphere.cap[j].TB,noz,3,E->control.TBCtopval,FBZ,0,lev,j);
- if(E->control.tbcs_file) {
- read_temperature_boundary_from_file(E); /* read in the temperature boundary condition from file */
- }
- }
- else {
- horizontal_bc(E,E->sphere.cap[j].TB,noz,3,E->control.TBCtopval,TBZ,0,lev,j);
- horizontal_bc(E,E->sphere.cap[j].TB,noz,3,E->control.TBCtopval,FBZ,1,lev,j);
- }
-
- if(E->mesh.bottbc == 1) {
- horizontal_bc(E,E->sphere.cap[j].TB,1,3,E->control.TBCbotval,TBZ,1,lev,j);
- horizontal_bc(E,E->sphere.cap[j].TB,1,3,E->control.TBCbotval,FBZ,0,lev,j);
- }
- else {
- horizontal_bc(E,E->sphere.cap[j].TB,1,3,E->control.TBCbotval,TBZ,0,lev,j);
- horizontal_bc(E,E->sphere.cap[j].TB,1,3,E->control.TBCbotval,FBZ,1,lev,j);
- }
-
- if((E->control.temperature_bound_adj==1) || (E->control.lith_age_time==1)) {
-/* set the regions in which to use lithosphere files to determine temperature
- note that this is called if the lithosphere age in inputted every time step
- OR it is only maintained in the boundary regions */
- lith_age_temperature_bound_adj(E,lev);
- }
-
- } /* end for j */
-
- temperatures_conform_bcs(E);
- E->temperatures_conform_bcs = temperatures_conform_bcs;
-
- return; }
-
-/* ========================================== */
-
-static void velocity_refl_vert_bc(E)
- struct All_variables *E;
-{
- int m,i,j,ii,jj;
- int node1,node2;
- int level,nox,noy,noz;
- const int dims=E->mesh.nsd;
-
- /* for two YOZ planes */
-
-
- if (E->parallel.me_loc[1]==0 || E->parallel.me_loc[1]==E->parallel.nprocx-1)
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for(j=1;j<=E->lmesh.noy;j++)
- for(i=1;i<=E->lmesh.noz;i++) {
- node1 = i + (j-1)*E->lmesh.noz*E->lmesh.nox;
- node2 = node1 + (E->lmesh.nox-1)*E->lmesh.noz;
-
- ii = i + E->lmesh.nzs - 1;
- if (E->parallel.me_loc[1]==0 ) {
- E->sphere.cap[m].VB[1][node1] = 0.0;
- if((ii != 1) && (ii != E->mesh.noz))
- E->sphere.cap[m].VB[3][node1] = 0.0;
- }
- if (E->parallel.me_loc[1]==E->parallel.nprocx-1) {
- E->sphere.cap[m].VB[1][node2] = 0.0;
- if((ii != 1) && (ii != E->mesh.noz))
- E->sphere.cap[m].VB[3][node2] = 0.0;
- }
- } /* end loop for i and j */
-
-/* for two XOZ planes */
-
-
- if (E->parallel.me_loc[2]==0)
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for(j=1;j<=E->lmesh.nox;j++)
- for(i=1;i<=E->lmesh.noz;i++) {
- node1 = i + (j-1)*E->lmesh.noz;
- ii = i + E->lmesh.nzs - 1;
-
- E->sphere.cap[m].VB[2][node1] = 0.0;
- if((ii != 1) && (ii != E->mesh.noz))
- E->sphere.cap[m].VB[3][node1] = 0.0;
- } /* end of loop i & j */
-
- if (E->parallel.me_loc[2]==E->parallel.nprocy-1)
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for(j=1;j<=E->lmesh.nox;j++)
- for(i=1;i<=E->lmesh.noz;i++) {
- node2 = (E->lmesh.noy-1)*E->lmesh.noz*E->lmesh.nox + i + (j-1)*E->lmesh.noz;
- ii = i + E->lmesh.nzs - 1;
-
- E->sphere.cap[m].VB[2][node2] = 0.0;
- if((ii != 1) && (ii != E->mesh.noz))
- E->sphere.cap[m].VB[3][node2] = 0.0;
- } /* end of loop i & j */
-
-
- /* all vbc's apply at all levels */
- for(level=E->mesh.levmax;level>=E->mesh.levmin;level--) {
-
- if ( (E->control.CONJ_GRAD && level==E->mesh.levmax) ||E->control.NMULTIGRID) {
- noz = E->lmesh.NOZ[level] ;
- noy = E->lmesh.NOY[level] ;
- nox = E->lmesh.NOX[level] ;
-
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- if (E->parallel.me_loc[1]==0 || E->parallel.me_loc[1]==E->parallel.nprocx-1) {
- for(j=1;j<=noy;j++)
- for(i=1;i<=noz;i++) {
- node1 = i + (j-1)*noz*nox;
- node2 = node1 + (nox-1)*noz;
- ii = i + E->lmesh.NZS[level] - 1;
- if (E->parallel.me_loc[1]==0 ) {
- E->NODE[level][m][node1] = E->NODE[level][m][node1] | VBX;
- E->NODE[level][m][node1] = E->NODE[level][m][node1] & (~SBX);
- if((ii!=1) && (ii!=E->mesh.NOZ[level])) {
- E->NODE[level][m][node1] = E->NODE[level][m][node1] & (~VBY);
- E->NODE[level][m][node1] = E->NODE[level][m][node1] | SBY;
- E->NODE[level][m][node1] = E->NODE[level][m][node1] & (~VBZ);
- E->NODE[level][m][node1] = E->NODE[level][m][node1] | SBZ;
- }
- }
- if (E->parallel.me_loc[1]==E->parallel.nprocx-1) {
- E->NODE[level][m][node2] = E->NODE[level][m][node2] | VBX;
- E->NODE[level][m][node2] = E->NODE[level][m][node2] & (~SBX);
- if((ii!=1) && (ii!=E->mesh.NOZ[level])) {
- E->NODE[level][m][node2] = E->NODE[level][m][node2] & (~VBY);
- E->NODE[level][m][node2] = E->NODE[level][m][node2] | SBY;
- E->NODE[level][m][node2] = E->NODE[level][m][node2] & (~VBZ);
- E->NODE[level][m][node2] = E->NODE[level][m][node2] | SBZ;
- }
- }
- } /* end for loop i & j */
-
- }
-
-
- if (E->parallel.me_loc[2]==0)
- for(j=1;j<=nox;j++)
- for(i=1;i<=noz;i++) {
- node1 = i + (j-1)*noz;
- ii = i + E->lmesh.NZS[level] - 1;
- jj = j + E->lmesh.NXS[level] - 1;
-
- E->NODE[level][m][node1] = E->NODE[level][m][node1] | VBY;
- E->NODE[level][m][node1] = E->NODE[level][m][node1] & (~SBY);
- if((ii!= 1) && (ii != E->mesh.NOZ[level])) {
- E->NODE[level][m][node1] = E->NODE[level][m][node1] & (~VBZ);
- E->NODE[level][m][node1] = E->NODE[level][m][node1] | SBZ;
- }
- if((jj!=1) && (jj!=E->mesh.NOX[level]) && (ii!=1) && (ii!=E->mesh.NOZ[level])){
- E->NODE[level][m][node1] = E->NODE[level][m][node1] & (~VBX);
- E->NODE[level][m][node1] = E->NODE[level][m][node1] | SBX;
- }
- } /* end for loop i & j */
-
- if (E->parallel.me_loc[2]==E->parallel.nprocy-1)
- for(j=1;j<=nox;j++)
- for(i=1;i<=noz;i++) {
- node2 = (noy-1)*noz*nox + i + (j-1)*noz;
- ii = i + E->lmesh.NZS[level] - 1;
- jj = j + E->lmesh.NXS[level] - 1;
- E->NODE[level][m][node2] = E->NODE[level][m][node2] | VBY;
- E->NODE[level][m][node2] = E->NODE[level][m][node2] & (~SBY);
- if((ii!= 1) && (ii != E->mesh.NOZ[level])) {
- E->NODE[level][m][node2] = E->NODE[level][m][node2] & (~VBZ);
- E->NODE[level][m][node2] = E->NODE[level][m][node2] | SBZ;
- }
- if((jj!=1) && (jj!=E->mesh.NOX[level]) && (ii!=1) && (ii!=E->mesh.NOZ[level])){
- E->NODE[level][m][node2] = E->NODE[level][m][node2] & (~VBX);
- E->NODE[level][m][node2] = E->NODE[level][m][node2] | SBX;
- }
- }
-
- } /* end for m */
- }
- } /* end for loop level */
-
- return;
-}
-
-static void temperature_refl_vert_bc(E)
- struct All_variables *E;
-{
- int i,j,m;
- int node1,node2;
- const int dims=E->mesh.nsd;
-
- /* Temps and bc-values at top level only */
-
- if (E->parallel.me_loc[1]==0 || E->parallel.me_loc[1]==E->parallel.nprocx-1)
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(j=1;j<=E->lmesh.noy;j++)
- for(i=1;i<=E->lmesh.noz;i++) {
- node1 = i + (j-1)*E->lmesh.noz*E->lmesh.nox;
- node2 = node1 + (E->lmesh.nox-1)*E->lmesh.noz;
- if (E->parallel.me_loc[1]==0 ) {
- E->node[m][node1] = E->node[m][node1] & (~TBX);
- E->node[m][node1] = E->node[m][node1] | FBX;
- E->sphere.cap[m].TB[1][node1] = 0.0;
- }
- if (E->parallel.me_loc[1]==E->parallel.nprocx-1) {
- E->node[m][node2] = E->node[m][node2] & (~TBX);
- E->node[m][node2] = E->node[m][node2] | FBX;
- E->sphere.cap[m].TB[1][node2] = 0.0;
- }
- } /* end for loop i & j */
-
- if (E->parallel.me_loc[2]==0)
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(j=1;j<=E->lmesh.nox;j++)
- for(i=1;i<=E->lmesh.noz;i++) {
- node1 = i + (j-1)*E->lmesh.noz;
- E->node[m][node1] = E->node[m][node1] & (~TBY);
- E->node[m][node1] = E->node[m][node1] | FBY;
- E->sphere.cap[m].TB[2][node1] = 0.0;
- }
-
- if (E->parallel.me_loc[2]==E->parallel.nprocy-1)
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(j=1;j<=E->lmesh.nox;j++)
- for(i=1;i<=E->lmesh.noz;i++) {
- node2 = i +(j-1)*E->lmesh.noz + (E->lmesh.noy-1)*E->lmesh.noz*E->lmesh.nox;
- E->node[m][node2] = E->node[m][node2] & (~TBY);
- E->node[m][node2] = E->node[m][node2] | FBY;
- E->sphere.cap[m].TB[3][node2] = 0.0;
- } /* end loop for i and j */
-
- return;
-}
-
-
-/* ========================================================= */
-
-
-static void horizontal_bc(E,BC,ROW,dirn,value,mask,onoff,level,m)
- struct All_variables *E;
- float *BC[];
- int ROW;
- int dirn;
- float value;
- unsigned int mask;
- char onoff;
- int level,m;
-
-{
- int i,j,node,rowl;
-
- /* safety feature */
- if(dirn > E->mesh.nsd)
- return;
-
- if (ROW==1)
- rowl = 1;
- else
- rowl = E->lmesh.NOZ[level];
-
- if ( (ROW==1 && E->parallel.me_loc[3]==0) ||
- (ROW==E->lmesh.NOZ[level] && E->parallel.me_loc[3]==E->parallel.nprocz-1) ) {
-
- /* turn bc marker to zero */
- if (onoff == 0) {
- for(j=1;j<=E->lmesh.NOY[level];j++)
- for(i=1;i<=E->lmesh.NOX[level];i++) {
- node = rowl+(i-1)*E->lmesh.NOZ[level]+(j-1)*E->lmesh.NOX[level]*E->lmesh.NOZ[level];
- E->NODE[level][m][node] = E->NODE[level][m][node] & (~ mask);
- } /* end for loop i & j */
- }
-
- /* turn bc marker to one */
- else {
- for(j=1;j<=E->lmesh.NOY[level];j++)
- for(i=1;i<=E->lmesh.NOX[level];i++) {
- node = rowl+(i-1)*E->lmesh.NOZ[level]+(j-1)*E->lmesh.NOX[level]*E->lmesh.NOZ[level];
- E->NODE[level][m][node] = E->NODE[level][m][node] | (mask);
-
- if(level==E->mesh.levmax) /* NB */
- BC[dirn][node] = value;
- } /* end for loop i & j */
- }
-
- } /* end for if ROW */
-
- return;
-}
-
-
-static void velocity_apply_periodic_bcs(E)
- struct All_variables *E;
-{
- int n1,n2,level;
- int i,j,ii,jj;
- const int dims=E->mesh.nsd;
-
- fprintf(E->fp,"Periodic boundary conditions\n");
-
- return;
- }
-
-static void temperature_apply_periodic_bcs(E)
- struct All_variables *E;
-{
- const int dims=E->mesh.nsd;
-
- fprintf(E->fp,"pERIodic temperature boundary conditions\n");
-
- return;
- }
-
-
-
-/* version */
-/* $Id$ */
-
-/* End of file */
Copied: mc/3D/CitcomS/branches/cxx/lib/Regional_boundary_conditions.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Regional_boundary_conditions.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Regional_boundary_conditions.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Regional_boundary_conditions.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,457 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+#include "element_definitions.h"
+#include "global_defs.h"
+#include <math.h>
+
+#include "lith_age.h"
+
+#include "cproto.h"
+
+/* ========================================== */
+
+static void horizontal_bc(
+ struct All_variables *E,
+ float *BC[],
+ int ROW,
+ int dirn,
+ float value,
+ unsigned int mask,
+ char onoff,
+ int level, int m
+ );
+
+static void velocity_apply_periodic_bcs(struct All_variables *);
+static void temperature_apply_periodic_bcs(struct All_variables *);
+static void velocity_refl_vert_bc(struct All_variables *);
+static void temperature_refl_vert_bc(struct All_variables *);
+void read_temperature_boundary_from_file(struct All_variables *);
+void read_velocity_boundary_from_file(struct All_variables *);
+
+/* ========================================== */
+
+void regional_velocity_boundary_conditions(struct All_variables *E)
+{
+ int node,d,j,noz,lv;
+
+ for(lv=E->mesh.gridmax;lv>=E->mesh.gridmin;lv--)
+ for (j=1;j<=E->sphere.caps_per_proc;j++) {
+ noz = E->lmesh.NOZ[lv];
+
+ if(E->mesh.topvbc == 0) {
+ horizontal_bc(E,E->sphere.cap[j].VB,noz,1,0.0,VBX,0,lv,j);
+ horizontal_bc(E,E->sphere.cap[j].VB,noz,3,0.0,VBZ,1,lv,j);
+ horizontal_bc(E,E->sphere.cap[j].VB,noz,2,0.0,VBY,0,lv,j);
+ horizontal_bc(E,E->sphere.cap[j].VB,noz,1,E->control.VBXtopval,SBX,1,lv,j);
+ horizontal_bc(E,E->sphere.cap[j].VB,noz,3,0.0,SBZ,0,lv,j);
+ horizontal_bc(E,E->sphere.cap[j].VB,noz,2,E->control.VBYtopval,SBY,1,lv,j);
+ }
+ else if(E->mesh.topvbc == 1) {
+ horizontal_bc(E,E->sphere.cap[j].VB,noz,1,E->control.VBXtopval,VBX,1,lv,j);
+ horizontal_bc(E,E->sphere.cap[j].VB,noz,3,0.0,VBZ,1,lv,j);
+ horizontal_bc(E,E->sphere.cap[j].VB,noz,2,E->control.VBYtopval,VBY,1,lv,j);
+ horizontal_bc(E,E->sphere.cap[j].VB,noz,1,0.0,SBX,0,lv,j);
+ horizontal_bc(E,E->sphere.cap[j].VB,noz,3,0.0,SBZ,0,lv,j);
+ horizontal_bc(E,E->sphere.cap[j].VB,noz,2,0.0,SBY,0,lv,j);
+
+ if(E->control.vbcs_file) {
+ if((lv == E->mesh.gridmin) && (j == E->sphere.caps_per_proc))
+ read_velocity_boundary_from_file(E); /* read in the velocity boundary condition from file */
+ }
+ }
+ else if(E->mesh.topvbc == 2) {
+ /* This extra BC is for a open top */
+ horizontal_bc(E,E->sphere.cap[j].VB,noz,1,0.0,VBX,0,lv,j);
+ horizontal_bc(E,E->sphere.cap[j].VB,noz,3,0.0,VBZ,0,lv,j);
+ horizontal_bc(E,E->sphere.cap[j].VB,noz,2,0.0,VBY,0,lv,j);
+ horizontal_bc(E,E->sphere.cap[j].VB,noz,1,E->control.VBXtopval,SBX,1,lv,j);
+ horizontal_bc(E,E->sphere.cap[j].VB,noz,3,0.0,SBZ,1,lv,j);
+ horizontal_bc(E,E->sphere.cap[j].VB,noz,2,E->control.VBYtopval,SBY,1,lv,j);
+ }
+
+
+
+ if(E->mesh.botvbc == 0) {
+ horizontal_bc(E,E->sphere.cap[j].VB,1,1,0.0,VBX,0,lv,j);
+ horizontal_bc(E,E->sphere.cap[j].VB,1,3,0.0,VBZ,1,lv,j);
+ horizontal_bc(E,E->sphere.cap[j].VB,1,2,0.0,VBY,0,lv,j);
+ horizontal_bc(E,E->sphere.cap[j].VB,1,1,E->control.VBXbotval,SBX,1,lv,j);
+ horizontal_bc(E,E->sphere.cap[j].VB,1,3,0.0,SBZ,0,lv,j);
+ horizontal_bc(E,E->sphere.cap[j].VB,1,2,E->control.VBYbotval,SBY,1,lv,j);
+ }
+ else if(E->mesh.botvbc == 1) {
+ horizontal_bc(E,E->sphere.cap[j].VB,1,1,E->control.VBXbotval,VBX,1,lv,j);
+ horizontal_bc(E,E->sphere.cap[j].VB,1,3,0.0,VBZ,1,lv,j);
+ horizontal_bc(E,E->sphere.cap[j].VB,1,2,E->control.VBYbotval,VBY,1,lv,j);
+ horizontal_bc(E,E->sphere.cap[j].VB,1,1,0.0,SBX,0,lv,j);
+ horizontal_bc(E,E->sphere.cap[j].VB,1,3,0.0,SBZ,0,lv,j);
+ horizontal_bc(E,E->sphere.cap[j].VB,1,2,0.0,SBY,0,lv,j);
+ }
+ } /* end for j and lv */
+
+ velocity_refl_vert_bc(E);
+
+ if(E->control.side_sbcs)
+ apply_side_sbc(E);
+
+ if(E->control.verbose) {
+ for (j=1;j<=E->sphere.caps_per_proc;j++)
+ for (node=1;node<=E->lmesh.nno;node++)
+ fprintf(E->fp_out,"m=%d VB== %d %g %g %g flag %u %u %u\n",j,node,E->sphere.cap[j].VB[1][node],E->sphere.cap[j].VB[2][node],E->sphere.cap[j].VB[3][node],E->node[j][node]&VBX,E->node[j][node]&VBY,E->node[j][node]&VBZ);
+ fflush(E->fp_out);
+ }
+ /* If any imposed internal velocity structure it goes here */
+
+
+ return;
+}
+
+
+/* ========================================== */
+
+void regional_temperature_boundary_conditions(struct All_variables *E)
+{
+ int j,lev,noz;
+
+ lev = E->mesh.levmax;
+
+
+ temperature_refl_vert_bc(E);
+
+ for (j=1;j<=E->sphere.caps_per_proc;j++) {
+ noz = E->lmesh.noz;
+ if(E->mesh.toptbc == 1) {
+ horizontal_bc(E,E->sphere.cap[j].TB,noz,3,E->control.TBCtopval,TBZ,1,lev,j);
+ horizontal_bc(E,E->sphere.cap[j].TB,noz,3,E->control.TBCtopval,FBZ,0,lev,j);
+ if(E->control.tbcs_file) {
+ read_temperature_boundary_from_file(E); /* read in the temperature boundary condition from file */
+ }
+ }
+ else {
+ horizontal_bc(E,E->sphere.cap[j].TB,noz,3,E->control.TBCtopval,TBZ,0,lev,j);
+ horizontal_bc(E,E->sphere.cap[j].TB,noz,3,E->control.TBCtopval,FBZ,1,lev,j);
+ }
+
+ if(E->mesh.bottbc == 1) {
+ horizontal_bc(E,E->sphere.cap[j].TB,1,3,E->control.TBCbotval,TBZ,1,lev,j);
+ horizontal_bc(E,E->sphere.cap[j].TB,1,3,E->control.TBCbotval,FBZ,0,lev,j);
+ }
+ else {
+ horizontal_bc(E,E->sphere.cap[j].TB,1,3,E->control.TBCbotval,TBZ,0,lev,j);
+ horizontal_bc(E,E->sphere.cap[j].TB,1,3,E->control.TBCbotval,FBZ,1,lev,j);
+ }
+
+ if((E->control.temperature_bound_adj==1) || (E->control.lith_age_time==1)) {
+/* set the regions in which to use lithosphere files to determine temperature
+ note that this is called if the lithosphere age in inputted every time step
+ OR it is only maintained in the boundary regions */
+ lith_age_temperature_bound_adj(E,lev);
+ }
+
+ } /* end for j */
+
+ temperatures_conform_bcs(E);
+ E->temperatures_conform_bcs = temperatures_conform_bcs;
+
+ return; }
+
+/* ========================================== */
+
+static void velocity_refl_vert_bc(struct All_variables *E)
+{
+ int m,i,j,ii,jj;
+ int node1,node2;
+ int level,nox,noy,noz;
+ const int dims=E->mesh.nsd;
+
+ /* for two YOZ planes */
+
+
+ if (E->parallel.me_loc[1]==0 || E->parallel.me_loc[1]==E->parallel.nprocx-1)
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for(j=1;j<=E->lmesh.noy;j++)
+ for(i=1;i<=E->lmesh.noz;i++) {
+ node1 = i + (j-1)*E->lmesh.noz*E->lmesh.nox;
+ node2 = node1 + (E->lmesh.nox-1)*E->lmesh.noz;
+
+ ii = i + E->lmesh.nzs - 1;
+ if (E->parallel.me_loc[1]==0 ) {
+ E->sphere.cap[m].VB[1][node1] = 0.0;
+ if((ii != 1) && (ii != E->mesh.noz))
+ E->sphere.cap[m].VB[3][node1] = 0.0;
+ }
+ if (E->parallel.me_loc[1]==E->parallel.nprocx-1) {
+ E->sphere.cap[m].VB[1][node2] = 0.0;
+ if((ii != 1) && (ii != E->mesh.noz))
+ E->sphere.cap[m].VB[3][node2] = 0.0;
+ }
+ } /* end loop for i and j */
+
+/* for two XOZ planes */
+
+
+ if (E->parallel.me_loc[2]==0)
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for(j=1;j<=E->lmesh.nox;j++)
+ for(i=1;i<=E->lmesh.noz;i++) {
+ node1 = i + (j-1)*E->lmesh.noz;
+ ii = i + E->lmesh.nzs - 1;
+
+ E->sphere.cap[m].VB[2][node1] = 0.0;
+ if((ii != 1) && (ii != E->mesh.noz))
+ E->sphere.cap[m].VB[3][node1] = 0.0;
+ } /* end of loop i & j */
+
+ if (E->parallel.me_loc[2]==E->parallel.nprocy-1)
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for(j=1;j<=E->lmesh.nox;j++)
+ for(i=1;i<=E->lmesh.noz;i++) {
+ node2 = (E->lmesh.noy-1)*E->lmesh.noz*E->lmesh.nox + i + (j-1)*E->lmesh.noz;
+ ii = i + E->lmesh.nzs - 1;
+
+ E->sphere.cap[m].VB[2][node2] = 0.0;
+ if((ii != 1) && (ii != E->mesh.noz))
+ E->sphere.cap[m].VB[3][node2] = 0.0;
+ } /* end of loop i & j */
+
+
+ /* all vbc's apply at all levels */
+ for(level=E->mesh.levmax;level>=E->mesh.levmin;level--) {
+
+ if ( (E->control.CONJ_GRAD && level==E->mesh.levmax) ||E->control.NMULTIGRID) {
+ noz = E->lmesh.NOZ[level] ;
+ noy = E->lmesh.NOY[level] ;
+ nox = E->lmesh.NOX[level] ;
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ if (E->parallel.me_loc[1]==0 || E->parallel.me_loc[1]==E->parallel.nprocx-1) {
+ for(j=1;j<=noy;j++)
+ for(i=1;i<=noz;i++) {
+ node1 = i + (j-1)*noz*nox;
+ node2 = node1 + (nox-1)*noz;
+ ii = i + E->lmesh.NZS[level] - 1;
+ if (E->parallel.me_loc[1]==0 ) {
+ E->NODE[level][m][node1] = E->NODE[level][m][node1] | VBX;
+ E->NODE[level][m][node1] = E->NODE[level][m][node1] & (~SBX);
+ if((ii!=1) && (ii!=E->mesh.NOZ[level])) {
+ E->NODE[level][m][node1] = E->NODE[level][m][node1] & (~VBY);
+ E->NODE[level][m][node1] = E->NODE[level][m][node1] | SBY;
+ E->NODE[level][m][node1] = E->NODE[level][m][node1] & (~VBZ);
+ E->NODE[level][m][node1] = E->NODE[level][m][node1] | SBZ;
+ }
+ }
+ if (E->parallel.me_loc[1]==E->parallel.nprocx-1) {
+ E->NODE[level][m][node2] = E->NODE[level][m][node2] | VBX;
+ E->NODE[level][m][node2] = E->NODE[level][m][node2] & (~SBX);
+ if((ii!=1) && (ii!=E->mesh.NOZ[level])) {
+ E->NODE[level][m][node2] = E->NODE[level][m][node2] & (~VBY);
+ E->NODE[level][m][node2] = E->NODE[level][m][node2] | SBY;
+ E->NODE[level][m][node2] = E->NODE[level][m][node2] & (~VBZ);
+ E->NODE[level][m][node2] = E->NODE[level][m][node2] | SBZ;
+ }
+ }
+ } /* end for loop i & j */
+
+ }
+
+
+ if (E->parallel.me_loc[2]==0)
+ for(j=1;j<=nox;j++)
+ for(i=1;i<=noz;i++) {
+ node1 = i + (j-1)*noz;
+ ii = i + E->lmesh.NZS[level] - 1;
+ jj = j + E->lmesh.NXS[level] - 1;
+
+ E->NODE[level][m][node1] = E->NODE[level][m][node1] | VBY;
+ E->NODE[level][m][node1] = E->NODE[level][m][node1] & (~SBY);
+ if((ii!= 1) && (ii != E->mesh.NOZ[level])) {
+ E->NODE[level][m][node1] = E->NODE[level][m][node1] & (~VBZ);
+ E->NODE[level][m][node1] = E->NODE[level][m][node1] | SBZ;
+ }
+ if((jj!=1) && (jj!=E->mesh.NOX[level]) && (ii!=1) && (ii!=E->mesh.NOZ[level])){
+ E->NODE[level][m][node1] = E->NODE[level][m][node1] & (~VBX);
+ E->NODE[level][m][node1] = E->NODE[level][m][node1] | SBX;
+ }
+ } /* end for loop i & j */
+
+ if (E->parallel.me_loc[2]==E->parallel.nprocy-1)
+ for(j=1;j<=nox;j++)
+ for(i=1;i<=noz;i++) {
+ node2 = (noy-1)*noz*nox + i + (j-1)*noz;
+ ii = i + E->lmesh.NZS[level] - 1;
+ jj = j + E->lmesh.NXS[level] - 1;
+ E->NODE[level][m][node2] = E->NODE[level][m][node2] | VBY;
+ E->NODE[level][m][node2] = E->NODE[level][m][node2] & (~SBY);
+ if((ii!= 1) && (ii != E->mesh.NOZ[level])) {
+ E->NODE[level][m][node2] = E->NODE[level][m][node2] & (~VBZ);
+ E->NODE[level][m][node2] = E->NODE[level][m][node2] | SBZ;
+ }
+ if((jj!=1) && (jj!=E->mesh.NOX[level]) && (ii!=1) && (ii!=E->mesh.NOZ[level])){
+ E->NODE[level][m][node2] = E->NODE[level][m][node2] & (~VBX);
+ E->NODE[level][m][node2] = E->NODE[level][m][node2] | SBX;
+ }
+ }
+
+ } /* end for m */
+ }
+ } /* end for loop level */
+
+ return;
+}
+
+static void temperature_refl_vert_bc(struct All_variables *E)
+{
+ int i,j,m;
+ int node1,node2;
+ const int dims=E->mesh.nsd;
+
+ /* Temps and bc-values at top level only */
+
+ if (E->parallel.me_loc[1]==0 || E->parallel.me_loc[1]==E->parallel.nprocx-1)
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(j=1;j<=E->lmesh.noy;j++)
+ for(i=1;i<=E->lmesh.noz;i++) {
+ node1 = i + (j-1)*E->lmesh.noz*E->lmesh.nox;
+ node2 = node1 + (E->lmesh.nox-1)*E->lmesh.noz;
+ if (E->parallel.me_loc[1]==0 ) {
+ E->node[m][node1] = E->node[m][node1] & (~TBX);
+ E->node[m][node1] = E->node[m][node1] | FBX;
+ E->sphere.cap[m].TB[1][node1] = 0.0;
+ }
+ if (E->parallel.me_loc[1]==E->parallel.nprocx-1) {
+ E->node[m][node2] = E->node[m][node2] & (~TBX);
+ E->node[m][node2] = E->node[m][node2] | FBX;
+ E->sphere.cap[m].TB[1][node2] = 0.0;
+ }
+ } /* end for loop i & j */
+
+ if (E->parallel.me_loc[2]==0)
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(j=1;j<=E->lmesh.nox;j++)
+ for(i=1;i<=E->lmesh.noz;i++) {
+ node1 = i + (j-1)*E->lmesh.noz;
+ E->node[m][node1] = E->node[m][node1] & (~TBY);
+ E->node[m][node1] = E->node[m][node1] | FBY;
+ E->sphere.cap[m].TB[2][node1] = 0.0;
+ }
+
+ if (E->parallel.me_loc[2]==E->parallel.nprocy-1)
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(j=1;j<=E->lmesh.nox;j++)
+ for(i=1;i<=E->lmesh.noz;i++) {
+ node2 = i +(j-1)*E->lmesh.noz + (E->lmesh.noy-1)*E->lmesh.noz*E->lmesh.nox;
+ E->node[m][node2] = E->node[m][node2] & (~TBY);
+ E->node[m][node2] = E->node[m][node2] | FBY;
+ E->sphere.cap[m].TB[3][node2] = 0.0;
+ } /* end loop for i and j */
+
+ return;
+}
+
+
+/* ========================================================= */
+
+
+static void horizontal_bc(
+ struct All_variables *E,
+ float *BC[],
+ int ROW,
+ int dirn,
+ float value,
+ unsigned int mask,
+ char onoff,
+ int level, int m
+ )
+{
+ int i,j,node,rowl;
+
+ /* safety feature */
+ if(dirn > E->mesh.nsd)
+ return;
+
+ if (ROW==1)
+ rowl = 1;
+ else
+ rowl = E->lmesh.NOZ[level];
+
+ if ( (ROW==1 && E->parallel.me_loc[3]==0) ||
+ (ROW==E->lmesh.NOZ[level] && E->parallel.me_loc[3]==E->parallel.nprocz-1) ) {
+
+ /* turn bc marker to zero */
+ if (onoff == 0) {
+ for(j=1;j<=E->lmesh.NOY[level];j++)
+ for(i=1;i<=E->lmesh.NOX[level];i++) {
+ node = rowl+(i-1)*E->lmesh.NOZ[level]+(j-1)*E->lmesh.NOX[level]*E->lmesh.NOZ[level];
+ E->NODE[level][m][node] = E->NODE[level][m][node] & (~ mask);
+ } /* end for loop i & j */
+ }
+
+ /* turn bc marker to one */
+ else {
+ for(j=1;j<=E->lmesh.NOY[level];j++)
+ for(i=1;i<=E->lmesh.NOX[level];i++) {
+ node = rowl+(i-1)*E->lmesh.NOZ[level]+(j-1)*E->lmesh.NOX[level]*E->lmesh.NOZ[level];
+ E->NODE[level][m][node] = E->NODE[level][m][node] | (mask);
+
+ if(level==E->mesh.levmax) /* NB */
+ BC[dirn][node] = value;
+ } /* end for loop i & j */
+ }
+
+ } /* end for if ROW */
+
+ return;
+}
+
+
+static void velocity_apply_periodic_bcs(struct All_variables *E)
+{
+ int n1,n2,level;
+ int i,j,ii,jj;
+ const int dims=E->mesh.nsd;
+
+ fprintf(E->fp,"Periodic boundary conditions\n");
+
+ return;
+ }
+
+static void temperature_apply_periodic_bcs(struct All_variables *E)
+{
+ const int dims=E->mesh.nsd;
+
+ fprintf(E->fp,"pERIodic temperature boundary conditions\n");
+
+ return;
+ }
+
+
+
+/* version */
+/* $Id$ */
+
+/* End of file */
Deleted: mc/3D/CitcomS/branches/cxx/lib/Regional_geometry_cartesian.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Regional_geometry_cartesian.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Regional_geometry_cartesian.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,98 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-#include "global_defs.h"
-#include "parsing.h"
-
-
-void regional_set_2dc_defaults(E)
- struct All_variables *E;
-{
-
- E->mesh.nsd = 2;
- E->mesh.dof = 2;
-
-}
-
-
-void regional_set_2pt5dc_defaults(E)
- struct All_variables *E;
-{
-
- E->mesh.nsd = 2;
- E->mesh.dof = 3;
-
-}
-
-void regional_set_3dc_defaults(E)
- struct All_variables *E;
-{
-
- E->mesh.nsd = 3;
- E->mesh.dof = 3;
-
-}
-
-void regional_set_3dsphere_defaults(E)
- struct All_variables *E;
-{
- void regional_set_3dsphere_defaults2(struct All_variables *E);
- int m = E->parallel.me;
-
- input_double("radius_outer",&(E->sphere.ro),"1",m);
- input_double("radius_inner",&(E->sphere.ri),"0.55",m);
-
- input_double("theta_min",&(E->control.theta_min),"essential",m);
- input_double("theta_max",&(E->control.theta_max),"essential",m);
- input_double("fi_min",&(E->control.fi_min),"essential",m);
- input_double("fi_max",&(E->control.fi_max),"essential",m);
-
- regional_set_3dsphere_defaults2(E);
-
- return;
-}
-
-
-void regional_set_3dsphere_defaults2(struct All_variables *E)
-{
- E->mesh.nsd = 3;
- E->mesh.dof = 3;
-
- E->sphere.caps = 1;
- E->sphere.max_connections = 6;
-
- E->sphere.cap[1].theta[1] = E->control.theta_min;
- E->sphere.cap[1].theta[2] = E->control.theta_max;
- E->sphere.cap[1].theta[3] = E->control.theta_max;
- E->sphere.cap[1].theta[4] = E->control.theta_min;
- E->sphere.cap[1].fi[1] = E->control.fi_min;
- E->sphere.cap[1].fi[2] = E->control.fi_min;
- E->sphere.cap[1].fi[3] = E->control.fi_max;
- E->sphere.cap[1].fi[4] = E->control.fi_max;
-
- return;
-}
Copied: mc/3D/CitcomS/branches/cxx/lib/Regional_geometry_cartesian.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Regional_geometry_cartesian.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Regional_geometry_cartesian.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Regional_geometry_cartesian.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,94 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+#include "global_defs.h"
+#include "parsing.h"
+
+#include "cproto.h"
+
+void regional_set_2dc_defaults(struct All_variables *E)
+{
+
+ E->mesh.nsd = 2;
+ E->mesh.dof = 2;
+
+}
+
+
+void regional_set_2pt5dc_defaults(struct All_variables *E)
+{
+
+ E->mesh.nsd = 2;
+ E->mesh.dof = 3;
+
+}
+
+void regional_set_3dc_defaults(struct All_variables *E)
+{
+
+ E->mesh.nsd = 3;
+ E->mesh.dof = 3;
+
+}
+
+void regional_set_3dsphere_defaults(struct All_variables *E)
+{
+ int m = E->parallel.me;
+
+ input_double("radius_outer",&(E->sphere.ro),"1",m);
+ input_double("radius_inner",&(E->sphere.ri),"0.55",m);
+
+ input_double("theta_min",&(E->control.theta_min),"essential",m);
+ input_double("theta_max",&(E->control.theta_max),"essential",m);
+ input_double("fi_min",&(E->control.fi_min),"essential",m);
+ input_double("fi_max",&(E->control.fi_max),"essential",m);
+
+ regional_set_3dsphere_defaults2(E);
+
+ return;
+}
+
+
+void regional_set_3dsphere_defaults2(struct All_variables *E)
+{
+ E->mesh.nsd = 3;
+ E->mesh.dof = 3;
+
+ E->sphere.caps = 1;
+ E->sphere.max_connections = 6;
+
+ E->sphere.cap[1].theta[1] = E->control.theta_min;
+ E->sphere.cap[1].theta[2] = E->control.theta_max;
+ E->sphere.cap[1].theta[3] = E->control.theta_max;
+ E->sphere.cap[1].theta[4] = E->control.theta_min;
+ E->sphere.cap[1].fi[1] = E->control.fi_min;
+ E->sphere.cap[1].fi[2] = E->control.fi_min;
+ E->sphere.cap[1].fi[3] = E->control.fi_max;
+ E->sphere.cap[1].fi[4] = E->control.fi_max;
+
+ return;
+}
Deleted: mc/3D/CitcomS/branches/cxx/lib/Regional_lith_age_read_files.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Regional_lith_age_read_files.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Regional_lith_age_read_files.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,41 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-
-
-#include "global_defs.h"
-
-
-void regional_lith_age_read_files(struct All_variables *E, int output)
-{
- void regional_read_input_files_for_timesteps();
- regional_read_input_files_for_timesteps(E,2,output); /*2 (=action) is for lith_age*/
- return;
-}
-
-
-/* End of file */
Copied: mc/3D/CitcomS/branches/cxx/lib/Regional_lith_age_read_files.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Regional_lith_age_read_files.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Regional_lith_age_read_files.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Regional_lith_age_read_files.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,41 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+
+
+#include "global_defs.h"
+
+#include "cproto.h"
+
+void regional_lith_age_read_files(struct All_variables *E, int output)
+{
+ regional_read_input_files_for_timesteps(E,2,output); /*2 (=action) is for lith_age*/
+ return;
+}
+
+
+/* End of file */
Deleted: mc/3D/CitcomS/branches/cxx/lib/Regional_obsolete.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Regional_obsolete.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Regional_obsolete.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,820 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-/*
- This file contains functions that are no longer used in this version of
- CitcomS. To reduce compilantion time and maintanance effort, these functions
- are removed from its original location to here.
-*/
-
-
-
-/* ========================================================== */
-/* from Parallel_related.c */
-/* =========================================================== */
-
-void parallel_process_initilization(E,argc,argv)
- struct All_variables *E;
- int argc;
- char **argv;
- {
-
- E->parallel.me = 0;
- E->parallel.nproc = 1;
- E->parallel.me_loc[1] = 0;
- E->parallel.me_loc[2] = 0;
- E->parallel.me_loc[3] = 0;
-
- /* MPI_Init(&argc,&argv); moved to main{} in Citcom.c, cpc 12/24/00 */
- MPI_Comm_rank(E->parallel.world, &(E->parallel.me) );
- MPI_Comm_size(E->parallel.world, &(E->parallel.nproc) );
-
- return;
- }
-
-
-/* ============================================
- get numerical grid coordinates for each relevant processor
- ============================================ */
-
-void parallel_domain_decomp2(E,GX)
- struct All_variables *E;
- float *GX[4];
- {
-
- return;
- }
-
-
-void scatter_to_nlayer_id (E,AUi,AUo,lev)
- struct All_variables *E;
-double **AUi,**AUo;
-int lev;
-{
-
- int i,j,k,k1,m,node1,node,eqn1,eqn,d;
-
- const int dims = E->mesh.nsd;
-
- static double *SD;
- static int been_here=0;
- static int *processors,rootid,nproc,NOZ;
-
- MPI_Status status;
-
- if (E->parallel.nprocz==1) {
- if (E->parallel.me==0) fprintf(stderr,"scatter_to_nlayer should not be called\n");
- return;
- }
-
- if (been_here==0) {
- NOZ = E->lmesh.ELZ[lev]*E->parallel.nprocz + 1;
-
- processors = (int *)malloc((E->parallel.nprocz+2)*sizeof(int));
-
- SD = (double *)malloc((E->lmesh.NEQ[lev])*sizeof(double));
-
-
- rootid = E->parallel.me_sph*E->parallel.nprocz; /* which is the bottom cpu */
- nproc = 0;
- for (j=0;j<E->parallel.nprocz;j++) {
- d = rootid + j;
- processors[nproc] = d;
- nproc ++;
- }
-
- been_here++;
- }
-
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- if (E->parallel.me==rootid)
- for (d=0;d<E->parallel.nprocz;d++) {
-
- for (k=1;k<=E->lmesh.NOZ[lev];k++) {
- k1 = k + d*E->lmesh.ELZ[lev];
- for (j=1;j<=E->lmesh.NOY[lev];j++)
- for (i=1;i<=E->lmesh.NOX[lev];i++) {
- node = k + (i-1)*E->lmesh.NOZ[lev] + (j-1)*E->lmesh.NOZ[lev]*E->lmesh.NOX[lev];
- node1= k1+ (i-1)*NOZ + (j-1)*NOZ*E->lmesh.NOX[lev];
- SD[dims*(node-1)] = AUi[m][dims*(node1-1)];
- SD[dims*(node-1)+1] = AUi[m][dims*(node1-1)+1];
- SD[dims*(node-1)+2] = AUi[m][dims*(node1-1)+2];
- }
- }
-
- if (processors[d]!=rootid) {
- MPI_Send(SD,E->lmesh.NEQ[lev],MPI_DOUBLE,processors[d],rootid,E->parallel.world);
- }
- else
- for (i=0;i<=E->lmesh.NEQ[lev];i++)
- AUo[m][i] = SD[i];
- }
- else
- MPI_Recv(AUo[m],E->lmesh.NEQ[lev],MPI_DOUBLE,rootid,rootid,E->parallel.world,&status);
- }
-
- return;
-}
-
-
-
-void gather_to_1layer_id (E,AUi,AUo,lev)
- struct All_variables *E;
-double **AUi,**AUo;
-int lev;
-{
-
- int i,j,k,k1,m,node1,node,eqn1,eqn,d;
-
- const int dims = E->mesh.nsd;
-
- MPI_Status status;
-
- static double *RV;
- static int been_here=0;
- static int *processors,rootid,nproc,NOZ;
-
- if (E->parallel.nprocz==1) {
- if (E->parallel.me==0) fprintf(stderr,"gather_to_1layer should not be called\n");
- return;
- }
-
- if (been_here==0) {
- NOZ = E->lmesh.ELZ[lev]*E->parallel.nprocz + 1;
-
- processors = (int *)malloc((E->parallel.nprocz+2)*sizeof(int));
-
- RV = (double *)malloc((E->lmesh.NEQ[lev])*sizeof(double));
-
-
- rootid = E->parallel.me_sph*E->parallel.nprocz; /* which is the bottom cpu */
- nproc = 0;
- for (j=0;j<E->parallel.nprocz;j++) {
- d = rootid + j;
- processors[nproc] = d;
- nproc ++;
- }
-
- been_here++;
- }
-
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- if (E->parallel.me!=rootid)
- MPI_Send(AUi[m],E->lmesh.NEQ[lev],MPI_DOUBLE,rootid,E->parallel.me,E->parallel.world);
- else
- for (d=0;d<E->parallel.nprocz;d++) {
- if (processors[d]!=rootid)
- MPI_Recv(RV,E->lmesh.NEQ[lev],MPI_DOUBLE,processors[d],processors[d],E->parallel.world,&status);
- else
- for (node=0;node<E->lmesh.NEQ[lev];node++)
- RV[node] = AUi[m][node];
-
- for (k=1;k<=E->lmesh.NOZ[lev];k++) {
- k1 = k + d*E->lmesh.ELZ[lev];
- for (j=1;j<=E->lmesh.NOY[lev];j++)
- for (i=1;i<=E->lmesh.NOX[lev];i++) {
- node = k + (i-1)*E->lmesh.NOZ[lev] + (j-1)*E->lmesh.NOZ[lev]*E->lmesh.NOX[lev];
- node1 = k1 + (i-1)*NOZ + (j-1)*NOZ*E->lmesh.NOX[lev];
-
- AUo[m][dims*(node1-1)] = RV[dims*(node-1)];
- AUo[m][dims*(node1-1)+1] = RV[dims*(node-1)+1];
- AUo[m][dims*(node1-1)+2] = RV[dims*(node-1)+2];
- }
- }
- }
- }
-
- return;
-}
-
-
-void gather_to_1layer_node (E,AUi,AUo,lev)
- struct All_variables *E;
-float **AUi,**AUo;
-int lev;
-{
-
- int i,j,k,k1,m,node1,node,d;
-
- MPI_Status status;
-
- static float *RV;
- static int been_here=0;
- static int *processors,rootid,nproc,NOZ,NNO;
-
- if (E->parallel.nprocz==1) {
- if (E->parallel.me==0) fprintf(stderr,"gather_to_1layer should not be called\n");
- return;
- }
-
- if (been_here==0) {
- NOZ = E->lmesh.ELZ[lev]*E->parallel.nprocz + 1;
- NNO = NOZ*E->lmesh.NOX[lev]*E->lmesh.NOY[lev];
-
- processors = (int *)malloc((E->parallel.nprocz+2)*sizeof(int));
- RV = (float *)malloc((E->lmesh.NNO[lev]+2)*sizeof(float));
-
-
- rootid = E->parallel.me_sph*E->parallel.nprocz; /* which is the bottom cpu */
- nproc = 0;
- for (j=0;j<E->parallel.nprocz;j++) {
- d = rootid + j;
- processors[nproc] = d;
- nproc ++;
- }
-
- been_here++;
- }
-
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- if (E->parallel.me!=rootid) {
- MPI_Send(AUi[m],E->lmesh.NNO[lev]+1,MPI_FLOAT,rootid,E->parallel.me,E->parallel.world);
- for (node=1;node<=NNO;node++)
- AUo[m][node] = 1.0;
- }
- else
- for (d=0;d<E->parallel.nprocz;d++) {
- if (processors[d]!=rootid)
- MPI_Recv(RV,E->lmesh.NNO[lev]+1,MPI_FLOAT,processors[d],processors[d],E->parallel.world,&status);
- else
- for (node=1;node<=E->lmesh.NNO[lev];node++)
- RV[node] = AUi[m][node];
-
- for (k=1;k<=E->lmesh.NOZ[lev];k++) {
- k1 = k + d*E->lmesh.ELZ[lev];
- for (j=1;j<=E->lmesh.NOY[lev];j++)
- for (i=1;i<=E->lmesh.NOX[lev];i++) {
- node = k + (i-1)*E->lmesh.NOZ[lev] + (j-1)*E->lmesh.NOZ[lev]*E->lmesh.NOX[lev];
- node1 = k1 + (i-1)*NOZ + (j-1)*NOZ*E->lmesh.NOX[lev];
- AUo[m][node1] = RV[node];
- }
- }
- }
- }
-
- return;
-}
-
-
-void gather_to_1layer_ele (E,AUi,AUo,lev)
- struct All_variables *E;
-float **AUi,**AUo;
-int lev;
-{
-
- int i,j,k,k1,m,e,d,e1;
-
- MPI_Status status;
-
- static float *RV;
- static int been_here=0;
- static int *processors,rootid,nproc,NOZ,NNO;
-
- if (E->parallel.nprocz==1) {
- if (E->parallel.me==0) fprintf(stderr,"gather_to_1layer should not be called\n");
- return;
- }
-
- if (been_here==0) {
- NOZ = E->lmesh.ELZ[lev]*E->parallel.nprocz;
- NNO = NOZ*E->lmesh.ELX[lev]*E->lmesh.ELY[lev];
-
- processors = (int *)malloc((E->parallel.nprocz+2)*sizeof(int));
- RV = (float *)malloc((E->lmesh.NEL[lev]+2)*sizeof(float));
-
-
- rootid = E->parallel.me_sph*E->parallel.nprocz; /* which is the bottom cpu */
- nproc = 0;
- for (j=0;j<E->parallel.nprocz;j++) {
- d = rootid + j;
- processors[nproc] = d;
- nproc ++;
- }
-
- been_here++;
- }
-
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- if (E->parallel.me!=rootid) {
- MPI_Send(AUi[m],E->lmesh.NEL[lev]+1,MPI_FLOAT,rootid,E->parallel.me,E->parallel.world);
- for (e=1;e<=NNO;e++)
- AUo[m][e] = 1.0;
- }
- else
- for (d=0;d<E->parallel.nprocz;d++) {
- if (processors[d]!=rootid)
- MPI_Recv(RV,E->lmesh.NEL[lev]+1,MPI_FLOAT,processors[d],processors[d],E->parallel.world,&status);
- else
- for (e=1;e<=E->lmesh.NEL[lev];e++)
- RV[e] = AUi[m][e];
-
- for (k=1;k<=E->lmesh.ELZ[lev];k++) {
- k1 = k + d*E->lmesh.ELZ[lev];
- for (j=1;j<=E->lmesh.ELY[lev];j++)
- for (i=1;i<=E->lmesh.ELX[lev];i++) {
- e = k + (i-1)*E->lmesh.ELZ[lev] + (j-1)*E->lmesh.ELZ[lev]*E->lmesh.ELX[lev];
- e1 = k1 + (i-1)*NOZ + (j-1)*NOZ*E->lmesh.ELX[lev];
- AUo[m][e1] = RV[e];
- }
- }
- }
- }
-
- return;
-}
-
-
-void gather_TG_to_me0(E,TG)
- struct All_variables *E;
-float *TG;
-{
-
- int i,j,nsl,idb,to_everyone,from_proc,mst,me;
-
- static float *RG[20];
- static int been_here=0;
- const float e_16=1.e-16;
-
- MPI_Status status[100];
- MPI_Status status1;
- MPI_Request request[100];
-
- if (E->parallel.nprocxy==1) return;
-
- nsl = E->sphere.nsf+1;
- me = E->parallel.me;
-
- if (been_here==0) {
- been_here++;
- for (i=1;i<E->parallel.nprocxy;i++)
- RG[i] = ( float *)malloc((E->sphere.nsf+1)*sizeof(float));
- }
-
- idb=0;
- for (i=1;i<=E->parallel.nprocxy;i++) {
- to_everyone = E->parallel.nprocz*(i-1) + E->parallel.me_loc[3];
-
- if (me!=to_everyone) { /* send TG */
- idb++;
- mst = me;
- MPI_Isend(TG,nsl,MPI_FLOAT,to_everyone,mst,E->parallel.world,&request[idb-1]);
- }
- }
-
- /* parallel_process_sync(E); */
-
- idb=0;
- for (i=1;i<=E->parallel.nprocxy;i++) {
- from_proc = E->parallel.nprocz*(i-1) + E->parallel.me_loc[3];
- if (me!=from_proc) { /* me==0 receive all TG and add them up */
- mst = from_proc;
- idb++;
- MPI_Irecv(RG[idb],nsl,MPI_FLOAT,from_proc,mst,E->parallel.world,&request[idb-1]);
- }
- }
-
- MPI_Waitall(idb,request,status);
-
- for (i=1;i<E->parallel.nprocxy;i++)
- for (j=1;j<=E->sphere.nsf; j++) {
- if (fabs(TG[j]) < e_16) TG[j] += RG[i][j];
- }
-
- /* parallel_process_sync(E); */
-
- return;
-}
-
-
-
-/* ========================================================== */
-/* from Boundary_conditions.c */
-/* =========================================================== */
-
-
-void renew_top_velocity_boundary(E)
- struct All_variables *E;
-{
- int i,k,lev;
- int nox,noz,noy,nodel;
- float fxx10,fxx20,fyy1,fyy2,fxx0,fxx,fyy;
- float vxx1,vxx2,vxx,vvo,vvc;
- float fslope,vslope;
- static float fxx1,fxx2;
-
- FILE *fp;
- char output_file[255];
- nox=E->lmesh.nox;
- noz=E->lmesh.noz;
- noy=E->lmesh.noy;
- lev=E->mesh.levmax;
-
- fxx10=1.0;
- fyy1=0.76;
- fxx20=1.0; /* (fxx1,fyy1), (fxx2,fyy2) the initial coordinates of the trench position */
- fyy2=0.81;
-
- vxx1=-2.*2.018e0;
-
- vvo=6.*2.018e0;
- vvc=-2.*2.018e0; /* vvo--oceanic plate velocity; vvc--continental plate velocity */
-
- if(E->advection.timesteps>1) {
- fxx1=fxx1+E->advection.timestep*vxx1;
- fxx2=fxx2+E->advection.timestep*vxx1;
- }
-
- else {
- fxx1=fxx10;
- fxx2=fxx20;
- }
-
- fprintf(stderr,"%f %f\n",fxx1,fxx2);
-
- if (E->parallel.me_loc[3] == E->parallel.nprocz-1 ) {
- for(k=1;k<=noy;k++)
- for(i=1;i<=nox;i++) {
- nodel = (k-1)*nox*noz + (i-1)*noz+noz;
- fyy=E->SX[lev][1][1][nodel];
- if (fyy < fyy1 || fyy >fyy2 ) {
- E->sphere.cap[1].VB[1][nodel]=0.0;
- E->sphere.cap[1].VB[2][nodel]=-vvc;
- E->sphere.cap[1].VB[3][nodel]=0.0;
- } /* the region outside of the domain bounded by the trench length */
- else if (fyy>=fyy1 && fyy <=fyy2) {
- if (E->SX[lev][1][2][nodel]>=0.00 && E->SX[lev][1][2][nodel]<= fxx1) {
- E->sphere.cap[1].VB[1][nodel]=0.0;
- E->sphere.cap[1].VB[2][nodel]=vvo;
- E->sphere.cap[1].VB[3][nodel]=0.0;
- }
- else if ( E->SX[lev][1][2][nodel]>fxx1 && E->SX[lev][1][2][nodel]<fxx2) {
- E->sphere.cap[1].VB[1][nodel]=0.0;
- E->sphere.cap[1].VB[2][nodel]=vxx1;
- E->sphere.cap[1].VB[3][nodel]=0.0;
- }
- else if ( E->SX[lev][1][2][nodel]>=fxx2) {
- E->sphere.cap[1].VB[1][nodel]=0.0;
- E->sphere.cap[1].VB[2][nodel]=vvc;
- E->sphere.cap[1].VB[3][nodel]=0.0;
- }
- } /* end of else if (fyy>=fyy1 && fyy <=fyy2) */
-
- } /* end if for(i=1;i<nox;i++) */
- } /* end of E->parallel.me_loc[3] */
-
- return;
-}
-
-
-
-/* ========================================================== */
-/* from Output.c */
-/* =========================================================== */
-
-void output_stress(E,file_number,SXX,SYY,SZZ,SXY,SXZ,SZY)
- struct All_variables *E;
-int file_number;
-float *SXX,*SYY,*SZZ,*SXY,*SXZ,*SZY;
-{
- int i,j,k,ii,m,fd,size2;
- int nox,noz,noy;
- char output_file[255];
-
- size2= (E->lmesh.nno+1)*sizeof(float);
-
- sprintf(output_file,"%s.%05d.SZZ",E->control.data_file,file_number);
- fd=open(output_file,O_RDWR | O_CREAT, 0644);
- write(fd,SZZ,size2);
- close (fd);
-
- return;
-}
-
-
-void print_field_spectral_regular(E,TG,sphc,sphs,proc_loc,filen)
- struct All_variables *E;
-float *TG,*sphc,*sphs;
-int proc_loc;
-char * filen;
-{
- FILE *fp,*fp1;
- char output_file[255];
- int i,node,j,ll,mm;
- float minx,maxx,t,f,rad;
- rad = 180.0/M_PI;
-
- maxx=-1.e26;
- minx=1.e26;
- if (E->parallel.me==proc_loc) {
-
- sprintf(output_file,"%s.%s_intp",E->control.data_file,filen);
- fp=fopen(output_file,"w");
- if (fp == NULL) {
- fprintf(E->fp,"(Output.c #7) Cannot open %s\n",output_file);
- exit(8);
- }
- for (i=E->sphere.nox;i>=1;i--)
- for (j=1;j<=E->sphere.noy;j++) {
- node = i + (j-1)*E->sphere.nox;
- t = 90-E->sphere.sx[1][node]*rad;
- f = E->sphere.sx[2][node]*rad;
- fprintf (fp,"%.3e %.3e %.4e\n",f,t,TG[node]);
- if(TG[node]>maxx)maxx=TG[node];
- if(TG[node]<minx)minx=TG[node];
- }
- fprintf(stderr,"lmaxx=%.4e lminx=%.4e for %s\n",maxx,minx,filen);
- fprintf(E->fp,"lmaxx=%.4e lminx=%.4e for %s\n",maxx,minx,filen);
- fclose(fp);
-
- sprintf(output_file,"%s.%s_sharm",E->control.data_file,filen);
- fp1=fopen(output_file,"w");
- if (fp1 == NULL) {
- fprintf(E->fp,"(Output.c #8) Cannot open %s\n",output_file);
- exit(8);
- }
- fprintf(fp1,"lmaxx=%.4e lminx=%.4e for %s\n",maxx,minx,filen);
- fprintf(fp1," ll mm cos sin \n");
- for (ll=0;ll<=E->output.llmax;ll++)
- for(mm=0;mm<=ll;mm++) {
- i = E->sphere.hindex[ll][mm];
- fprintf(fp1,"%3d %3d %.4e %.4e \n",ll,mm,sphc[i],sphs[i]);
- }
-
- fclose(fp1);
- }
-
-
- return;
-}
-
-
-
-void output_velo_related(E,file_number)
- struct All_variables *E;
- int file_number;
-{
- int el,els,i,j,k,m,node,fd;
- int s,nox,noz,noy,size1,size2,size3;
- char output_file[255];
- FILE *fp1,*fp2;
-
-
- output_velo(E);
- output_visc(E);
-
-
- if (E->parallel.me_loc[3]==E->parallel.nprocz-1) {
- sprintf(output_file,"%s.surf.%d.%d",E->control.data_file,E->parallel.me,cycles);
- fp2 = output_open(output_file, "w");
-
- for(j=1;j<=E->sphere.caps_per_proc;j++) {
- fprintf(fp2,"%3d %7d\n",j,E->lmesh.nsf);
- for(i=1;i<=E->lmesh.nsf;i++) {
- s = i*E->lmesh.noz;
- fprintf(fp2,"%.4e %.4e %.4e %.4e\n",E->slice.tpg[j][i],E->slice.shflux[j][i],E->sphere.cap[j].V[1][s],E->sphere.cap[j].V[2][s]);
- }
- }
- fclose(fp2);
-
- }
-
- if (E->parallel.me_loc[3]==0) {
- sprintf(output_file,"%s.botm.%d.%d",E->control.data_file,E->parallel.me,cycles);
- fp2 = output_open(output_file, "w");
-
- for(j=1;j<=E->sphere.caps_per_proc;j++) {
- fprintf(fp2,"%3d %7d\n",j,E->lmesh.nsf);
- for(i=1;i<=E->lmesh.nsf;i++) {
- s = (i-1)*E->lmesh.noz + 1;
- fprintf(fp2,"%.4e %.4e %.4e %.4e\n",E->slice.tpgb[j][i],E->slice.bhflux[j][i],E->sphere.cap[j].V[1][s],E->sphere.cap[j].V[2][s]);
- }
- }
- fclose(fp2);
- }
-
- /* remove horizontal average output by Tan2 Mar. 1 2002 */
-/* if (E->parallel.me<E->parallel.nprocz) { */
-/* sprintf(output_file,"%s.ave_r.%d.%d",E->control.data_file,E->parallel.me,cycles); */
-/* fp2 = output_open(output_file, "w"); */
-/* if (fp2 == NULL) { */
-/* fprintf(E->fp,"(Output.c #6) Cannot open %s\n",output_file); */
-/* exit(8); */
-/* } */
-/* for(j=1;j<=E->lmesh.noz;j++) { */
-/* fprintf(fp2,"%.4e %.4e %.4e %.4e\n",E->sx[1][3][j],E->Have.T[j],E->Have.V[1][j],E->Have.V[2][j]); */
-/* } */
-/* fclose(fp2); */
-/* } */
-
- return;
- }
-
-
-
-void output_temp(E,file_number)
- struct All_variables *E;
- int file_number;
-{
- int m,nno,i,j,fd;
- char output_file[255];
-
- return;
-}
-
-
-void output_visc_prepare(struct All_variables *E, float **VE)
-{
- void get_ele_visc();
- void visc_from_ele_to_gint();
- void visc_from_gint_to_nodes();
-
- float *EV, *VN[NCS];
- const int lev = E->mesh.levmax;
- const int nsd = E->mesh.nsd;
- const int vpts = vpoints[nsd];
- int i, m;
-
-
- // Here is a bug in the original code. EV is not allocated for each
- // E->sphere.caps_per_proc. Later, when elemental viscosity is written
- // to it (in get_ele_visc()), viscosity in high cap number will overwrite
- // that in a lower cap number.
- //
- // Since current CitcomS only support 1 cap per processor, this bug won't
- // manifest itself. So, I will leave it here.
- // by Tan2 5/22/2003
- int size2 = (E->lmesh.nel+1)*sizeof(float);
- EV = (float *) malloc (size2);
-
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
- VN[m]=(float *)malloc((1+E->lmesh.nel*vpts)*sizeof(float));
- }
-
- get_ele_visc(E,EV,1);
-
- for(i=1;i<=E->lmesh.nel;i++)
- VE[1][i]=EV[i];
-
- visc_from_ele_to_gint(E, VE, VN, lev);
- visc_from_gint_to_nodes(E, VN, VE, lev);
-
- free((void *) EV);
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
- free((void *) VN[m]);
- }
-
- return;
-}
-
-
-void output_visc(struct All_variables *E, int cycles)
-{
- int i, j, m;
- char output_file[255];
- FILE *fp1;
- float *VE[NCS];
-
- sprintf(output_file,"%s.visc.%d.%d",E->control.data_file,E->parallel.me,cycles);
- fp1 = output_open(output_file, "w");
-
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
- VE[m]=(float *)malloc((1+E->lmesh.nno)*sizeof(float));
- }
-
- output_visc_prepare(E, VE);
-
- for(j=1;j<=E->sphere.caps_per_proc;j++) {
- fprintf(fp1,"%3d %7d\n",j,E->lmesh.nno);
- for(i=1;i<=E->lmesh.nno;i++)
- fprintf(fp1,"%.3e\n",VE[1][i]);
- }
-
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
- free((void*) VE[m]);
- }
-
- fclose(fp1);
-
- return;
-}
-
-/* ========================================================== */
-/* from Process_buoyancy.c */
-/* =========================================================== */
-
-
-void process_temp_field(E,ii)
- struct All_variables *E;
- int ii;
-{
- void heat_flux();
- void output_temp();
- void process_output_field();
- int record_h;
-
-/* This form prevented running for timesteps less than 10!!
- record_h = E->control.record_every/10; */
- record_h = E->control.record_every;
-
-/* changed to allow 0th time step to be outputted CPC 6/18/00 */
-/* if ( ((ii % record_h) == 0) || E->control.DIRECTII) { */
-
- if ( (ii == 0) || ((ii % record_h) == 0) || E->control.DIRECTII) {
- heat_flux(E);
- parallel_process_sync(E);
-/* output_temp(E,ii); */
- }
-
-/* if ( ((ii % E->control.record_every) == 0) || E->control.DIRECTII) { */
- if ( ((ii == 0) || ((ii % E->control.record_every) == 0))
- || E->control.DIRECTII) {
- process_output_field(E,ii);
- }
-
- return;
-}
-
-
-/* ========================================================== */
-/* from Process_velocity.c */
-/* =========================================================== */
-
-void process_new_velocity(E,ii)
- struct All_variables *E;
- int ii;
-{
- void output_velo_related();
- void get_STD_topo();
- void get_CBF_topo();
-
- int m,i,it;
-
-
- if ( (ii == 0) || ((ii % E->control.record_every) == 0)
- || E->control.DIRECTII) {
- get_STD_topo(E,E->slice.tpg,E->slice.tpgb,E->slice.divg,E->slice.vort,ii);
- parallel_process_sync(E);
- output_velo_related(E,ii); /* also topo */
- }
-
- return;
-}
-
-
-void get_surface_velo(E, SV,m)
- struct All_variables *E;
- float *SV;
- int m;
- {
-
- int el,els,i,node,lev;
- char output_file[255];
- FILE *fp;
-
- const int dims=E->mesh.nsd;
- const int ends=enodes[dims];
- const int nno=E->lmesh.nno;
-
- lev = E->mesh.levmax;
-
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for (node=1;node<=nno;node++)
- if (node%E->lmesh.noz==0) {
- i = node/E->lmesh.noz;
- SV[(i-1)*2+1] = E->sphere.cap[m].V[1][node];
- SV[(i-1)*2+2] = E->sphere.cap[m].V[2][node];
- }
-
- return;
- }
-
-
-
-/* ========================================================== */
-/* from */
-/* =========================================================== */
-
Copied: mc/3D/CitcomS/branches/cxx/lib/Regional_obsolete.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Regional_obsolete.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Regional_obsolete.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Regional_obsolete.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,820 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+/*
+ This file contains functions that are no longer used in this version of
+ CitcomS. To reduce compilantion time and maintanance effort, these functions
+ are removed from its original location to here.
+*/
+
+
+
+/* ========================================================== */
+/* from Parallel_related.c */
+/* =========================================================== */
+
+void parallel_process_initilization(E,argc,argv)
+ struct All_variables *E;
+ int argc;
+ char **argv;
+ {
+
+ E->parallel.me = 0;
+ E->parallel.nproc = 1;
+ E->parallel.me_loc[1] = 0;
+ E->parallel.me_loc[2] = 0;
+ E->parallel.me_loc[3] = 0;
+
+ /* MPI_Init(&argc,&argv); moved to main{} in Citcom.c, cpc 12/24/00 */
+ MPI_Comm_rank(E->parallel.world, &(E->parallel.me) );
+ MPI_Comm_size(E->parallel.world, &(E->parallel.nproc) );
+
+ return;
+ }
+
+
+/* ============================================
+ get numerical grid coordinates for each relevant processor
+ ============================================ */
+
+void parallel_domain_decomp2(E,GX)
+ struct All_variables *E;
+ float *GX[4];
+ {
+
+ return;
+ }
+
+
+void scatter_to_nlayer_id (E,AUi,AUo,lev)
+ struct All_variables *E;
+double **AUi,**AUo;
+int lev;
+{
+
+ int i,j,k,k1,m,node1,node,eqn1,eqn,d;
+
+ const int dims = E->mesh.nsd;
+
+ static double *SD;
+ static int been_here=0;
+ static int *processors,rootid,nproc,NOZ;
+
+ MPI_Status status;
+
+ if (E->parallel.nprocz==1) {
+ if (E->parallel.me==0) fprintf(stderr,"scatter_to_nlayer should not be called\n");
+ return;
+ }
+
+ if (been_here==0) {
+ NOZ = E->lmesh.ELZ[lev]*E->parallel.nprocz + 1;
+
+ processors = (int *)malloc((E->parallel.nprocz+2)*sizeof(int));
+
+ SD = (double *)malloc((E->lmesh.NEQ[lev])*sizeof(double));
+
+
+ rootid = E->parallel.me_sph*E->parallel.nprocz; /* which is the bottom cpu */
+ nproc = 0;
+ for (j=0;j<E->parallel.nprocz;j++) {
+ d = rootid + j;
+ processors[nproc] = d;
+ nproc ++;
+ }
+
+ been_here++;
+ }
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ if (E->parallel.me==rootid)
+ for (d=0;d<E->parallel.nprocz;d++) {
+
+ for (k=1;k<=E->lmesh.NOZ[lev];k++) {
+ k1 = k + d*E->lmesh.ELZ[lev];
+ for (j=1;j<=E->lmesh.NOY[lev];j++)
+ for (i=1;i<=E->lmesh.NOX[lev];i++) {
+ node = k + (i-1)*E->lmesh.NOZ[lev] + (j-1)*E->lmesh.NOZ[lev]*E->lmesh.NOX[lev];
+ node1= k1+ (i-1)*NOZ + (j-1)*NOZ*E->lmesh.NOX[lev];
+ SD[dims*(node-1)] = AUi[m][dims*(node1-1)];
+ SD[dims*(node-1)+1] = AUi[m][dims*(node1-1)+1];
+ SD[dims*(node-1)+2] = AUi[m][dims*(node1-1)+2];
+ }
+ }
+
+ if (processors[d]!=rootid) {
+ MPI_Send(SD,E->lmesh.NEQ[lev],MPI_DOUBLE,processors[d],rootid,E->parallel.world);
+ }
+ else
+ for (i=0;i<=E->lmesh.NEQ[lev];i++)
+ AUo[m][i] = SD[i];
+ }
+ else
+ MPI_Recv(AUo[m],E->lmesh.NEQ[lev],MPI_DOUBLE,rootid,rootid,E->parallel.world,&status);
+ }
+
+ return;
+}
+
+
+
+void gather_to_1layer_id (E,AUi,AUo,lev)
+ struct All_variables *E;
+double **AUi,**AUo;
+int lev;
+{
+
+ int i,j,k,k1,m,node1,node,eqn1,eqn,d;
+
+ const int dims = E->mesh.nsd;
+
+ MPI_Status status;
+
+ static double *RV;
+ static int been_here=0;
+ static int *processors,rootid,nproc,NOZ;
+
+ if (E->parallel.nprocz==1) {
+ if (E->parallel.me==0) fprintf(stderr,"gather_to_1layer should not be called\n");
+ return;
+ }
+
+ if (been_here==0) {
+ NOZ = E->lmesh.ELZ[lev]*E->parallel.nprocz + 1;
+
+ processors = (int *)malloc((E->parallel.nprocz+2)*sizeof(int));
+
+ RV = (double *)malloc((E->lmesh.NEQ[lev])*sizeof(double));
+
+
+ rootid = E->parallel.me_sph*E->parallel.nprocz; /* which is the bottom cpu */
+ nproc = 0;
+ for (j=0;j<E->parallel.nprocz;j++) {
+ d = rootid + j;
+ processors[nproc] = d;
+ nproc ++;
+ }
+
+ been_here++;
+ }
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ if (E->parallel.me!=rootid)
+ MPI_Send(AUi[m],E->lmesh.NEQ[lev],MPI_DOUBLE,rootid,E->parallel.me,E->parallel.world);
+ else
+ for (d=0;d<E->parallel.nprocz;d++) {
+ if (processors[d]!=rootid)
+ MPI_Recv(RV,E->lmesh.NEQ[lev],MPI_DOUBLE,processors[d],processors[d],E->parallel.world,&status);
+ else
+ for (node=0;node<E->lmesh.NEQ[lev];node++)
+ RV[node] = AUi[m][node];
+
+ for (k=1;k<=E->lmesh.NOZ[lev];k++) {
+ k1 = k + d*E->lmesh.ELZ[lev];
+ for (j=1;j<=E->lmesh.NOY[lev];j++)
+ for (i=1;i<=E->lmesh.NOX[lev];i++) {
+ node = k + (i-1)*E->lmesh.NOZ[lev] + (j-1)*E->lmesh.NOZ[lev]*E->lmesh.NOX[lev];
+ node1 = k1 + (i-1)*NOZ + (j-1)*NOZ*E->lmesh.NOX[lev];
+
+ AUo[m][dims*(node1-1)] = RV[dims*(node-1)];
+ AUo[m][dims*(node1-1)+1] = RV[dims*(node-1)+1];
+ AUo[m][dims*(node1-1)+2] = RV[dims*(node-1)+2];
+ }
+ }
+ }
+ }
+
+ return;
+}
+
+
+void gather_to_1layer_node (E,AUi,AUo,lev)
+ struct All_variables *E;
+float **AUi,**AUo;
+int lev;
+{
+
+ int i,j,k,k1,m,node1,node,d;
+
+ MPI_Status status;
+
+ static float *RV;
+ static int been_here=0;
+ static int *processors,rootid,nproc,NOZ,NNO;
+
+ if (E->parallel.nprocz==1) {
+ if (E->parallel.me==0) fprintf(stderr,"gather_to_1layer should not be called\n");
+ return;
+ }
+
+ if (been_here==0) {
+ NOZ = E->lmesh.ELZ[lev]*E->parallel.nprocz + 1;
+ NNO = NOZ*E->lmesh.NOX[lev]*E->lmesh.NOY[lev];
+
+ processors = (int *)malloc((E->parallel.nprocz+2)*sizeof(int));
+ RV = (float *)malloc((E->lmesh.NNO[lev]+2)*sizeof(float));
+
+
+ rootid = E->parallel.me_sph*E->parallel.nprocz; /* which is the bottom cpu */
+ nproc = 0;
+ for (j=0;j<E->parallel.nprocz;j++) {
+ d = rootid + j;
+ processors[nproc] = d;
+ nproc ++;
+ }
+
+ been_here++;
+ }
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ if (E->parallel.me!=rootid) {
+ MPI_Send(AUi[m],E->lmesh.NNO[lev]+1,MPI_FLOAT,rootid,E->parallel.me,E->parallel.world);
+ for (node=1;node<=NNO;node++)
+ AUo[m][node] = 1.0;
+ }
+ else
+ for (d=0;d<E->parallel.nprocz;d++) {
+ if (processors[d]!=rootid)
+ MPI_Recv(RV,E->lmesh.NNO[lev]+1,MPI_FLOAT,processors[d],processors[d],E->parallel.world,&status);
+ else
+ for (node=1;node<=E->lmesh.NNO[lev];node++)
+ RV[node] = AUi[m][node];
+
+ for (k=1;k<=E->lmesh.NOZ[lev];k++) {
+ k1 = k + d*E->lmesh.ELZ[lev];
+ for (j=1;j<=E->lmesh.NOY[lev];j++)
+ for (i=1;i<=E->lmesh.NOX[lev];i++) {
+ node = k + (i-1)*E->lmesh.NOZ[lev] + (j-1)*E->lmesh.NOZ[lev]*E->lmesh.NOX[lev];
+ node1 = k1 + (i-1)*NOZ + (j-1)*NOZ*E->lmesh.NOX[lev];
+ AUo[m][node1] = RV[node];
+ }
+ }
+ }
+ }
+
+ return;
+}
+
+
+void gather_to_1layer_ele (E,AUi,AUo,lev)
+ struct All_variables *E;
+float **AUi,**AUo;
+int lev;
+{
+
+ int i,j,k,k1,m,e,d,e1;
+
+ MPI_Status status;
+
+ static float *RV;
+ static int been_here=0;
+ static int *processors,rootid,nproc,NOZ,NNO;
+
+ if (E->parallel.nprocz==1) {
+ if (E->parallel.me==0) fprintf(stderr,"gather_to_1layer should not be called\n");
+ return;
+ }
+
+ if (been_here==0) {
+ NOZ = E->lmesh.ELZ[lev]*E->parallel.nprocz;
+ NNO = NOZ*E->lmesh.ELX[lev]*E->lmesh.ELY[lev];
+
+ processors = (int *)malloc((E->parallel.nprocz+2)*sizeof(int));
+ RV = (float *)malloc((E->lmesh.NEL[lev]+2)*sizeof(float));
+
+
+ rootid = E->parallel.me_sph*E->parallel.nprocz; /* which is the bottom cpu */
+ nproc = 0;
+ for (j=0;j<E->parallel.nprocz;j++) {
+ d = rootid + j;
+ processors[nproc] = d;
+ nproc ++;
+ }
+
+ been_here++;
+ }
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ if (E->parallel.me!=rootid) {
+ MPI_Send(AUi[m],E->lmesh.NEL[lev]+1,MPI_FLOAT,rootid,E->parallel.me,E->parallel.world);
+ for (e=1;e<=NNO;e++)
+ AUo[m][e] = 1.0;
+ }
+ else
+ for (d=0;d<E->parallel.nprocz;d++) {
+ if (processors[d]!=rootid)
+ MPI_Recv(RV,E->lmesh.NEL[lev]+1,MPI_FLOAT,processors[d],processors[d],E->parallel.world,&status);
+ else
+ for (e=1;e<=E->lmesh.NEL[lev];e++)
+ RV[e] = AUi[m][e];
+
+ for (k=1;k<=E->lmesh.ELZ[lev];k++) {
+ k1 = k + d*E->lmesh.ELZ[lev];
+ for (j=1;j<=E->lmesh.ELY[lev];j++)
+ for (i=1;i<=E->lmesh.ELX[lev];i++) {
+ e = k + (i-1)*E->lmesh.ELZ[lev] + (j-1)*E->lmesh.ELZ[lev]*E->lmesh.ELX[lev];
+ e1 = k1 + (i-1)*NOZ + (j-1)*NOZ*E->lmesh.ELX[lev];
+ AUo[m][e1] = RV[e];
+ }
+ }
+ }
+ }
+
+ return;
+}
+
+
+void gather_TG_to_me0(E,TG)
+ struct All_variables *E;
+float *TG;
+{
+
+ int i,j,nsl,idb,to_everyone,from_proc,mst,me;
+
+ static float *RG[20];
+ static int been_here=0;
+ const float e_16=1.e-16;
+
+ MPI_Status status[100];
+ MPI_Status status1;
+ MPI_Request request[100];
+
+ if (E->parallel.nprocxy==1) return;
+
+ nsl = E->sphere.nsf+1;
+ me = E->parallel.me;
+
+ if (been_here==0) {
+ been_here++;
+ for (i=1;i<E->parallel.nprocxy;i++)
+ RG[i] = ( float *)malloc((E->sphere.nsf+1)*sizeof(float));
+ }
+
+ idb=0;
+ for (i=1;i<=E->parallel.nprocxy;i++) {
+ to_everyone = E->parallel.nprocz*(i-1) + E->parallel.me_loc[3];
+
+ if (me!=to_everyone) { /* send TG */
+ idb++;
+ mst = me;
+ MPI_Isend(TG,nsl,MPI_FLOAT,to_everyone,mst,E->parallel.world,&request[idb-1]);
+ }
+ }
+
+ /* parallel_process_sync(E); */
+
+ idb=0;
+ for (i=1;i<=E->parallel.nprocxy;i++) {
+ from_proc = E->parallel.nprocz*(i-1) + E->parallel.me_loc[3];
+ if (me!=from_proc) { /* me==0 receive all TG and add them up */
+ mst = from_proc;
+ idb++;
+ MPI_Irecv(RG[idb],nsl,MPI_FLOAT,from_proc,mst,E->parallel.world,&request[idb-1]);
+ }
+ }
+
+ MPI_Waitall(idb,request,status);
+
+ for (i=1;i<E->parallel.nprocxy;i++)
+ for (j=1;j<=E->sphere.nsf; j++) {
+ if (fabs(TG[j]) < e_16) TG[j] += RG[i][j];
+ }
+
+ /* parallel_process_sync(E); */
+
+ return;
+}
+
+
+
+/* ========================================================== */
+/* from Boundary_conditions.c */
+/* =========================================================== */
+
+
+void renew_top_velocity_boundary(E)
+ struct All_variables *E;
+{
+ int i,k,lev;
+ int nox,noz,noy,nodel;
+ float fxx10,fxx20,fyy1,fyy2,fxx0,fxx,fyy;
+ float vxx1,vxx2,vxx,vvo,vvc;
+ float fslope,vslope;
+ static float fxx1,fxx2;
+
+ FILE *fp;
+ char output_file[255];
+ nox=E->lmesh.nox;
+ noz=E->lmesh.noz;
+ noy=E->lmesh.noy;
+ lev=E->mesh.levmax;
+
+ fxx10=1.0;
+ fyy1=0.76;
+ fxx20=1.0; /* (fxx1,fyy1), (fxx2,fyy2) the initial coordinates of the trench position */
+ fyy2=0.81;
+
+ vxx1=-2.*2.018e0;
+
+ vvo=6.*2.018e0;
+ vvc=-2.*2.018e0; /* vvo--oceanic plate velocity; vvc--continental plate velocity */
+
+ if(E->advection.timesteps>1) {
+ fxx1=fxx1+E->advection.timestep*vxx1;
+ fxx2=fxx2+E->advection.timestep*vxx1;
+ }
+
+ else {
+ fxx1=fxx10;
+ fxx2=fxx20;
+ }
+
+ fprintf(stderr,"%f %f\n",fxx1,fxx2);
+
+ if (E->parallel.me_loc[3] == E->parallel.nprocz-1 ) {
+ for(k=1;k<=noy;k++)
+ for(i=1;i<=nox;i++) {
+ nodel = (k-1)*nox*noz + (i-1)*noz+noz;
+ fyy=E->SX[lev][1][1][nodel];
+ if (fyy < fyy1 || fyy >fyy2 ) {
+ E->sphere.cap[1].VB[1][nodel]=0.0;
+ E->sphere.cap[1].VB[2][nodel]=-vvc;
+ E->sphere.cap[1].VB[3][nodel]=0.0;
+ } /* the region outside of the domain bounded by the trench length */
+ else if (fyy>=fyy1 && fyy <=fyy2) {
+ if (E->SX[lev][1][2][nodel]>=0.00 && E->SX[lev][1][2][nodel]<= fxx1) {
+ E->sphere.cap[1].VB[1][nodel]=0.0;
+ E->sphere.cap[1].VB[2][nodel]=vvo;
+ E->sphere.cap[1].VB[3][nodel]=0.0;
+ }
+ else if ( E->SX[lev][1][2][nodel]>fxx1 && E->SX[lev][1][2][nodel]<fxx2) {
+ E->sphere.cap[1].VB[1][nodel]=0.0;
+ E->sphere.cap[1].VB[2][nodel]=vxx1;
+ E->sphere.cap[1].VB[3][nodel]=0.0;
+ }
+ else if ( E->SX[lev][1][2][nodel]>=fxx2) {
+ E->sphere.cap[1].VB[1][nodel]=0.0;
+ E->sphere.cap[1].VB[2][nodel]=vvc;
+ E->sphere.cap[1].VB[3][nodel]=0.0;
+ }
+ } /* end of else if (fyy>=fyy1 && fyy <=fyy2) */
+
+ } /* end if for(i=1;i<nox;i++) */
+ } /* end of E->parallel.me_loc[3] */
+
+ return;
+}
+
+
+
+/* ========================================================== */
+/* from Output.c */
+/* =========================================================== */
+
+void output_stress(E,file_number,SXX,SYY,SZZ,SXY,SXZ,SZY)
+ struct All_variables *E;
+int file_number;
+float *SXX,*SYY,*SZZ,*SXY,*SXZ,*SZY;
+{
+ int i,j,k,ii,m,fd,size2;
+ int nox,noz,noy;
+ char output_file[255];
+
+ size2= (E->lmesh.nno+1)*sizeof(float);
+
+ sprintf(output_file,"%s.%05d.SZZ",E->control.data_file,file_number);
+ fd=open(output_file,O_RDWR | O_CREAT, 0644);
+ write(fd,SZZ,size2);
+ close (fd);
+
+ return;
+}
+
+
+void print_field_spectral_regular(E,TG,sphc,sphs,proc_loc,filen)
+ struct All_variables *E;
+float *TG,*sphc,*sphs;
+int proc_loc;
+char * filen;
+{
+ FILE *fp,*fp1;
+ char output_file[255];
+ int i,node,j,ll,mm;
+ float minx,maxx,t,f,rad;
+ rad = 180.0/M_PI;
+
+ maxx=-1.e26;
+ minx=1.e26;
+ if (E->parallel.me==proc_loc) {
+
+ sprintf(output_file,"%s.%s_intp",E->control.data_file,filen);
+ fp=fopen(output_file,"w");
+ if (fp == NULL) {
+ fprintf(E->fp,"(Output.c #7) Cannot open %s\n",output_file);
+ exit(8);
+ }
+ for (i=E->sphere.nox;i>=1;i--)
+ for (j=1;j<=E->sphere.noy;j++) {
+ node = i + (j-1)*E->sphere.nox;
+ t = 90-E->sphere.sx[1][node]*rad;
+ f = E->sphere.sx[2][node]*rad;
+ fprintf (fp,"%.3e %.3e %.4e\n",f,t,TG[node]);
+ if(TG[node]>maxx)maxx=TG[node];
+ if(TG[node]<minx)minx=TG[node];
+ }
+ fprintf(stderr,"lmaxx=%.4e lminx=%.4e for %s\n",maxx,minx,filen);
+ fprintf(E->fp,"lmaxx=%.4e lminx=%.4e for %s\n",maxx,minx,filen);
+ fclose(fp);
+
+ sprintf(output_file,"%s.%s_sharm",E->control.data_file,filen);
+ fp1=fopen(output_file,"w");
+ if (fp1 == NULL) {
+ fprintf(E->fp,"(Output.c #8) Cannot open %s\n",output_file);
+ exit(8);
+ }
+ fprintf(fp1,"lmaxx=%.4e lminx=%.4e for %s\n",maxx,minx,filen);
+ fprintf(fp1," ll mm cos sin \n");
+ for (ll=0;ll<=E->output.llmax;ll++)
+ for(mm=0;mm<=ll;mm++) {
+ i = E->sphere.hindex[ll][mm];
+ fprintf(fp1,"%3d %3d %.4e %.4e \n",ll,mm,sphc[i],sphs[i]);
+ }
+
+ fclose(fp1);
+ }
+
+
+ return;
+}
+
+
+
+void output_velo_related(E,file_number)
+ struct All_variables *E;
+ int file_number;
+{
+ int el,els,i,j,k,m,node,fd;
+ int s,nox,noz,noy,size1,size2,size3;
+ char output_file[255];
+ FILE *fp1,*fp2;
+
+
+ output_velo(E);
+ output_visc(E);
+
+
+ if (E->parallel.me_loc[3]==E->parallel.nprocz-1) {
+ sprintf(output_file,"%s.surf.%d.%d",E->control.data_file,E->parallel.me,cycles);
+ fp2 = output_open(output_file, "w");
+
+ for(j=1;j<=E->sphere.caps_per_proc;j++) {
+ fprintf(fp2,"%3d %7d\n",j,E->lmesh.nsf);
+ for(i=1;i<=E->lmesh.nsf;i++) {
+ s = i*E->lmesh.noz;
+ fprintf(fp2,"%.4e %.4e %.4e %.4e\n",E->slice.tpg[j][i],E->slice.shflux[j][i],E->sphere.cap[j].V[1][s],E->sphere.cap[j].V[2][s]);
+ }
+ }
+ fclose(fp2);
+
+ }
+
+ if (E->parallel.me_loc[3]==0) {
+ sprintf(output_file,"%s.botm.%d.%d",E->control.data_file,E->parallel.me,cycles);
+ fp2 = output_open(output_file, "w");
+
+ for(j=1;j<=E->sphere.caps_per_proc;j++) {
+ fprintf(fp2,"%3d %7d\n",j,E->lmesh.nsf);
+ for(i=1;i<=E->lmesh.nsf;i++) {
+ s = (i-1)*E->lmesh.noz + 1;
+ fprintf(fp2,"%.4e %.4e %.4e %.4e\n",E->slice.tpgb[j][i],E->slice.bhflux[j][i],E->sphere.cap[j].V[1][s],E->sphere.cap[j].V[2][s]);
+ }
+ }
+ fclose(fp2);
+ }
+
+ /* remove horizontal average output by Tan2 Mar. 1 2002 */
+/* if (E->parallel.me<E->parallel.nprocz) { */
+/* sprintf(output_file,"%s.ave_r.%d.%d",E->control.data_file,E->parallel.me,cycles); */
+/* fp2 = output_open(output_file, "w"); */
+/* if (fp2 == NULL) { */
+/* fprintf(E->fp,"(Output.c #6) Cannot open %s\n",output_file); */
+/* exit(8); */
+/* } */
+/* for(j=1;j<=E->lmesh.noz;j++) { */
+/* fprintf(fp2,"%.4e %.4e %.4e %.4e\n",E->sx[1][3][j],E->Have.T[j],E->Have.V[1][j],E->Have.V[2][j]); */
+/* } */
+/* fclose(fp2); */
+/* } */
+
+ return;
+ }
+
+
+
+void output_temp(E,file_number)
+ struct All_variables *E;
+ int file_number;
+{
+ int m,nno,i,j,fd;
+ char output_file[255];
+
+ return;
+}
+
+
+void output_visc_prepare(struct All_variables *E, float **VE)
+{
+ void get_ele_visc();
+ void visc_from_ele_to_gint();
+ void visc_from_gint_to_nodes();
+
+ float *EV, *VN[NCS];
+ const int lev = E->mesh.levmax;
+ const int nsd = E->mesh.nsd;
+ const int vpts = vpoints[nsd];
+ int i, m;
+
+
+ // Here is a bug in the original code. EV is not allocated for each
+ // E->sphere.caps_per_proc. Later, when elemental viscosity is written
+ // to it (in get_ele_visc()), viscosity in high cap number will overwrite
+ // that in a lower cap number.
+ //
+ // Since current CitcomS only support 1 cap per processor, this bug won't
+ // manifest itself. So, I will leave it here.
+ // by Tan2 5/22/2003
+ int size2 = (E->lmesh.nel+1)*sizeof(float);
+ EV = (float *) malloc (size2);
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+ VN[m]=(float *)malloc((1+E->lmesh.nel*vpts)*sizeof(float));
+ }
+
+ get_ele_visc(E,EV,1);
+
+ for(i=1;i<=E->lmesh.nel;i++)
+ VE[1][i]=EV[i];
+
+ visc_from_ele_to_gint(E, VE, VN, lev);
+ visc_from_gint_to_nodes(E, VN, VE, lev);
+
+ free((void *) EV);
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+ free((void *) VN[m]);
+ }
+
+ return;
+}
+
+
+void output_visc(struct All_variables *E, int cycles)
+{
+ int i, j, m;
+ char output_file[255];
+ FILE *fp1;
+ float *VE[NCS];
+
+ sprintf(output_file,"%s.visc.%d.%d",E->control.data_file,E->parallel.me,cycles);
+ fp1 = output_open(output_file, "w");
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+ VE[m]=(float *)malloc((1+E->lmesh.nno)*sizeof(float));
+ }
+
+ output_visc_prepare(E, VE);
+
+ for(j=1;j<=E->sphere.caps_per_proc;j++) {
+ fprintf(fp1,"%3d %7d\n",j,E->lmesh.nno);
+ for(i=1;i<=E->lmesh.nno;i++)
+ fprintf(fp1,"%.3e\n",VE[1][i]);
+ }
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+ free((void*) VE[m]);
+ }
+
+ fclose(fp1);
+
+ return;
+}
+
+/* ========================================================== */
+/* from Process_buoyancy.c */
+/* =========================================================== */
+
+
+void process_temp_field(E,ii)
+ struct All_variables *E;
+ int ii;
+{
+ void heat_flux();
+ void output_temp();
+ void process_output_field();
+ int record_h;
+
+/* This form prevented running for timesteps less than 10!!
+ record_h = E->control.record_every/10; */
+ record_h = E->control.record_every;
+
+/* changed to allow 0th time step to be outputted CPC 6/18/00 */
+/* if ( ((ii % record_h) == 0) || E->control.DIRECTII) { */
+
+ if ( (ii == 0) || ((ii % record_h) == 0) || E->control.DIRECTII) {
+ heat_flux(E);
+ parallel_process_sync(E);
+/* output_temp(E,ii); */
+ }
+
+/* if ( ((ii % E->control.record_every) == 0) || E->control.DIRECTII) { */
+ if ( ((ii == 0) || ((ii % E->control.record_every) == 0))
+ || E->control.DIRECTII) {
+ process_output_field(E,ii);
+ }
+
+ return;
+}
+
+
+/* ========================================================== */
+/* from Process_velocity.c */
+/* =========================================================== */
+
+void process_new_velocity(E,ii)
+ struct All_variables *E;
+ int ii;
+{
+ void output_velo_related();
+ void get_STD_topo();
+ void get_CBF_topo();
+
+ int m,i,it;
+
+
+ if ( (ii == 0) || ((ii % E->control.record_every) == 0)
+ || E->control.DIRECTII) {
+ get_STD_topo(E,E->slice.tpg,E->slice.tpgb,E->slice.divg,E->slice.vort,ii);
+ parallel_process_sync(E);
+ output_velo_related(E,ii); /* also topo */
+ }
+
+ return;
+}
+
+
+void get_surface_velo(E, SV,m)
+ struct All_variables *E;
+ float *SV;
+ int m;
+ {
+
+ int el,els,i,node,lev;
+ char output_file[255];
+ FILE *fp;
+
+ const int dims=E->mesh.nsd;
+ const int ends=enodes[dims];
+ const int nno=E->lmesh.nno;
+
+ lev = E->mesh.levmax;
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for (node=1;node<=nno;node++)
+ if (node%E->lmesh.noz==0) {
+ i = node/E->lmesh.noz;
+ SV[(i-1)*2+1] = E->sphere.cap[m].V[1][node];
+ SV[(i-1)*2+2] = E->sphere.cap[m].V[2][node];
+ }
+
+ return;
+ }
+
+
+
+/* ========================================================== */
+/* from */
+/* =========================================================== */
+
Deleted: mc/3D/CitcomS/branches/cxx/lib/Regional_parallel_related.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Regional_parallel_related.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Regional_parallel_related.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,944 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-#include <mpi.h>
-#include <math.h>
-
-#include "element_definitions.h"
-#include "global_defs.h"
-#include "sphere_communication.h"
-
-#include "parallel_related.h"
-
-
-static void set_horizontal_communicator(struct All_variables*);
-static void set_vertical_communicator(struct All_variables*);
-
-static void exchange_node_d(struct All_variables *, double**, int);
-static void exchange_node_f(struct All_variables *, float**, int);
-
-
-/* ============================================ */
-/* ============================================ */
-
-void regional_parallel_processor_setup(struct All_variables *E)
- {
-
- int i,j,k,m,me,temp,pid_surf;
- int surf_proc_per_cap, proc_per_cap, total_proc;
-
- me = E->parallel.me;
-
- surf_proc_per_cap = E->parallel.nprocx * E->parallel.nprocy;
- proc_per_cap = surf_proc_per_cap * E->parallel.nprocz;
- total_proc = E->sphere.caps * proc_per_cap;
- E->parallel.total_surf_proc = E->sphere.caps * surf_proc_per_cap;
-
- if ( total_proc != E->parallel.nproc ) {
- if (E->parallel.me==0) fprintf(stderr,"!!!! # of requested CPU is incorrect \n");
- parallel_process_termination();
- }
-
- /* determine the location of processors in each cap */
- /* z direction first */
- j = me % E->parallel.nprocz;
- E->parallel.me_loc[3] = j;
-
- /* x direction then */
- k = (me - j)/E->parallel.nprocz % E->parallel.nprocx;
- E->parallel.me_loc[1] = k;
-
- /* y direction then */
- i = ((me - j)/E->parallel.nprocz - k)/E->parallel.nprocx % E->parallel.nprocy;
- E->parallel.me_loc[2] = i;
-
- E->sphere.caps_per_proc = 1;
-
- /* determine cap id for each cap in a given processor */
- pid_surf = me/E->parallel.nprocz;
- i = cases[E->sphere.caps_per_proc];
-
- for (j=1;j<=E->sphere.caps_per_proc;j++) {
- E->sphere.capid[j] = 1;
- }
-
- /* steup location-to-processor map */
- E->parallel.loc2proc_map = (int ****) malloc(E->sphere.caps*sizeof(int ***));
- for (m=0;m<E->sphere.caps;m++) {
- E->parallel.loc2proc_map[m] = (int ***) malloc(E->parallel.nprocx*sizeof(int **));
- for (i=0;i<E->parallel.nprocx;i++) {
- E->parallel.loc2proc_map[m][i] = (int **) malloc(E->parallel.nprocy*sizeof(int *));
- for (j=0;j<E->parallel.nprocy;j++)
- E->parallel.loc2proc_map[m][i][j] = (int *) malloc(E->parallel.nprocz*sizeof(int));
- }
- }
-
- for (m=0;m<E->sphere.caps;m++)
- for (i=0;i<E->parallel.nprocx;i++)
- for (j=0;j<E->parallel.nprocy;j++)
- for (k=0;k<E->parallel.nprocz;k++) {
- E->parallel.loc2proc_map[m][i][j][k] = m*proc_per_cap
- + j*E->parallel.nprocx*E->parallel.nprocz
- + i*E->parallel.nprocz + k;
- }
-
- if (E->control.verbose) {
- fprintf(E->fp_out,"me=%d loc1=%d loc2=%d loc3=%d\n",me,E->parallel.me_loc[1],E->parallel.me_loc[2],E->parallel.me_loc[3]);
- for (j=1;j<=E->sphere.caps_per_proc;j++) {
- fprintf(E->fp_out,"capid[%d]=%d \n",j,E->sphere.capid[j]);
- }
- for (m=0;m<E->sphere.caps;m++)
- for (j=0;j<E->parallel.nprocy;j++)
- for (i=0;i<E->parallel.nprocx;i++)
- for (k=0;k<E->parallel.nprocz;k++)
- fprintf(E->fp_out,"loc2proc_map[cap=%d][x=%d][y=%d][z=%d] = %d\n",
- m,i,j,k,E->parallel.loc2proc_map[m][i][j][k]);
-
- fflush(E->fp_out);
- }
-
- set_horizontal_communicator(E);
- set_vertical_communicator(E);
-
- E->exchange_node_d = exchange_node_d;
- E->exchange_node_f = exchange_node_f;
-
- return;
- }
-
-
-static void set_horizontal_communicator(struct All_variables *E)
-{
- MPI_Group world_g, horizon_g;
- int i,j,k,m,n;
- int *processors;
-
- processors = (int *) malloc((E->parallel.total_surf_proc+1)*sizeof(int));
-
- k = E->parallel.me_loc[3];
- n = 0;
- for (m=0;m<E->sphere.caps;m++)
- for (i=0;i<E->parallel.nprocx;i++)
- for (j=0;j<E->parallel.nprocy;j++) {
- processors[n] = E->parallel.loc2proc_map[m][i][j][k];
- n++;
- }
-
- if (E->control.verbose) {
- fprintf(E->fp_out,"horizontal group of me=%d loc3=%d\n",E->parallel.me,E->parallel.me_loc[3]);
- for (j=0;j<E->parallel.total_surf_proc;j++) {
- fprintf(E->fp_out,"%d proc=%d\n",j,processors[j]);
- }
- fflush(E->fp_out);
- }
-
- MPI_Comm_group(E->parallel.world, &world_g);
- MPI_Group_incl(world_g, E->parallel.total_surf_proc, processors, &horizon_g);
- MPI_Comm_create(E->parallel.world, horizon_g, &(E->parallel.horizontal_comm));
-
-
- MPI_Group_free(&horizon_g);
- MPI_Group_free(&world_g);
- free((void *) processors);
-
- return;
-}
-
-
-static void set_vertical_communicator(struct All_variables *E)
-{
- MPI_Group world_g, vertical_g;
- int i,j,k,m;
- int *processors;
-
- processors = (int *)malloc((E->parallel.nprocz+2)*sizeof(int));
- if (!processors)
- fprintf(stderr,"no memory!!\n");
-
- m = E->sphere.capid[1] - 1; /* assume 1 cap per proc. */
- i = E->parallel.me_loc[1];
- j = E->parallel.me_loc[2];
-
- for (k=0;k<E->parallel.nprocz;k++) {
- processors[k] = E->parallel.loc2proc_map[m][i][j][k];
- }
-
- if (E->control.verbose) {
- fprintf(E->fp_out,"vertical group of me=%d loc1=%d loc2=%d\n",E->parallel.me,E->parallel.me_loc[1],E->parallel.me_loc[2]);
- for (k=0;k<E->parallel.nprocz;k++) {
- fprintf(E->fp_out,"%d proc=%d\n",k,processors[k]);
- }
- fflush(E->fp_out);
- }
-
- MPI_Comm_group(E->parallel.world, &world_g);
- MPI_Group_incl(world_g, E->parallel.nprocz, processors, &vertical_g);
- MPI_Comm_create(E->parallel.world, vertical_g, &(E->parallel.vertical_comm));
-
- MPI_Group_free(&vertical_g);
- MPI_Group_free(&world_g);
- free((void *) processors);
-}
-
-
-
-/* =========================================================================
-get element information for each processor.
- ========================================================================= */
-
-void regional_parallel_domain_decomp0(struct All_variables *E)
- {
-
- int i,nox,noz,noy,me;
-
- me = E->parallel.me;
-
- E->lmesh.elx = E->mesh.elx/E->parallel.nprocx;
- E->lmesh.elz = E->mesh.elz/E->parallel.nprocz;
- E->lmesh.ely = E->mesh.ely/E->parallel.nprocy;
- E->lmesh.nox = E->lmesh.elx + 1;
- E->lmesh.noz = E->lmesh.elz + 1;
- E->lmesh.noy = E->lmesh.ely + 1;
-
- E->lmesh.exs = E->parallel.me_loc[1]*E->lmesh.elx;
- E->lmesh.eys = E->parallel.me_loc[2]*E->lmesh.ely;
- E->lmesh.ezs = E->parallel.me_loc[3]*E->lmesh.elz;
- E->lmesh.nxs = E->parallel.me_loc[1]*E->lmesh.elx+1;
- E->lmesh.nys = E->parallel.me_loc[2]*E->lmesh.ely+1;
- E->lmesh.nzs = E->parallel.me_loc[3]*E->lmesh.elz+1;
-
- E->lmesh.nno = E->lmesh.noz*E->lmesh.nox*E->lmesh.noy;
- E->lmesh.nel = E->lmesh.ely*E->lmesh.elx*E->lmesh.elz;
- E->lmesh.npno = E->lmesh.nel;
-
- E->lmesh.nsf = E->lmesh.nno/E->lmesh.noz;
- E->lmesh.snel = E->lmesh.elx*E->lmesh.ely;
-
-
- for(i=E->mesh.levmax;i>=E->mesh.levmin;i--) {
-
- if (E->control.NMULTIGRID||E->control.EMULTIGRID) {
- nox = E->mesh.mgunitx * (int) pow(2.0,(double)i) + 1;
- noy = E->mesh.mgunity * (int) pow(2.0,(double)i) + 1;
- noz = E->lmesh.elz/(int)pow(2.0,(double)(E->mesh.levmax-i))+1;
- E->parallel.redundant[i]=0;
- }
- else
- { noz = E->lmesh.noz;
- noy = E->mesh.mgunity * (int) pow(2.0,(double)i) + 1;
- nox = E->mesh.mgunitx * (int) pow(2.0,(double)i) + 1;
- if(i<E->mesh.levmax) noz=2;
- }
-
- E->lmesh.ELX[i] = nox-1;
- E->lmesh.ELY[i] = noy-1;
- E->lmesh.ELZ[i] = noz-1;
- E->lmesh.NOZ[i] = noz;
- E->lmesh.NOY[i] = noy;
- E->lmesh.NOX[i] = nox;
- E->lmesh.NNO[i] = nox * noz * noy;
- E->lmesh.NNOV[i] = E->lmesh.NNO[i];
- E->lmesh.SNEL[i] = E->lmesh.ELX[i]*E->lmesh.ELY[i];
-
- E->lmesh.NEL[i] = (nox-1) * (noz-1) * (noy-1);
- E->lmesh.NPNO[i] = E->lmesh.NEL[i] ;
-
- E->lmesh.NEQ[i] = E->mesh.nsd * E->lmesh.NNOV[i] ;
-
- E->lmesh.EXS[i] = E->parallel.me_loc[1]*E->lmesh.ELX[i];
- E->lmesh.EYS[i] = E->parallel.me_loc[2]*E->lmesh.ELY[i];
- E->lmesh.EZS[i] = E->parallel.me_loc[3]*E->lmesh.ELZ[i];
- E->lmesh.NXS[i] = E->parallel.me_loc[1]*E->lmesh.ELX[i]+1;
- E->lmesh.NYS[i] = E->parallel.me_loc[2]*E->lmesh.ELY[i]+1;
- E->lmesh.NZS[i] = E->parallel.me_loc[3]*E->lmesh.ELZ[i]+1;
-
- }
-
-/*
-fprintf(stderr,"b %d %d %d %d %d %d %d\n",E->parallel.me,E->parallel.me_loc[1],E->parallel.me_loc[2],E->parallel.me_loc[3],E->lmesh.nzs,E->lmesh.nys,E->lmesh.noy);
-*/
-/* parallel_process_termination();
-*/
- return;
- }
-
-
-
-
-/* ============================================
- determine boundary nodes for
- exchange info across the boundaries
- ============================================ */
-
-void regional_parallel_domain_boundary_nodes(E)
- struct All_variables *E;
- {
-
- void parallel_process_termination();
-
- int m,i,ii,j,k,l,node,el,lnode;
- int lev,ele,elx,elz,ely,nel,nno,nox,noz,noy;
- FILE *fp,*fp1;
- char output_file[255];
-
- for(lev=E->mesh.gridmin;lev<=E->mesh.gridmax;lev++) {
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
- nel = E->lmesh.NEL[lev];
- elx = E->lmesh.ELX[lev];
- elz = E->lmesh.ELZ[lev];
- ely = E->lmesh.ELY[lev];
- nox = E->lmesh.NOX[lev];
- noy = E->lmesh.NOY[lev];
- noz = E->lmesh.NOZ[lev];
- nno = E->lmesh.NNO[lev];
-
-/* do the ZOY boundary elements first */
- lnode = 0;
- ii =1; /* left */
- for(j=1;j<=noz;j++)
- for(k=1;k<=noy;k++) {
- node = j + (k-1)*noz*nox;
- E->parallel.NODE[lev][m][++lnode].bound[ii] = node;
- E->NODE[lev][m][node] = E->NODE[lev][m][node] | OFFSIDE;
- }
-
- E->parallel.NUM_NNO[lev][m].bound[ii] = lnode;
-
-
- lnode = 0;
- ii =2; /* right */
- for(j=1;j<=noz;j++)
- for(k=1;k<=noy;k++) {
- node = (nox-1)*noz + j + (k-1)*noz*nox;
- E->parallel.NODE[lev][m][++lnode].bound[ii] = node;
- E->NODE[lev][m][node] = E->NODE[lev][m][node] | OFFSIDE;
- }
-
- E->parallel.NUM_NNO[lev][m].bound[ii] = lnode;
-
-
-/* do XOY boundary elements */
- ii=5; /* bottom */
- lnode=0;
- for(k=1;k<=noy;k++)
- for(i=1;i<=nox;i++) {
- node = (k-1)*nox*noz + (i-1)*noz + 1;
- E->parallel.NODE[lev][m][++lnode].bound[ii] = node;
- E->NODE[lev][m][node] = E->NODE[lev][m][node] | OFFSIDE;
- }
-
- E->parallel.NUM_NNO[lev][m].bound[ii] = lnode;
-
- ii=6; /* top */
- lnode=0;
- for(k=1;k<=noy;k++)
- for(i=1;i<=nox;i++) {
- node = (k-1)*nox*noz + i*noz;
- E->parallel.NODE[lev][m][++lnode].bound[ii] = node;
- E->NODE[lev][m][node] = E->NODE[lev][m][node] | OFFSIDE;
- }
-
- E->parallel.NUM_NNO[lev][m].bound[ii] = lnode;
-
-
-/* do XOZ boundary elements for 3D */
- ii=3; /* front */
- lnode=0;
- for(j=1;j<=noz;j++)
- for(i=1;i<=nox;i++) {
- node = (i-1)*noz +j;
- E->parallel.NODE[lev][m][++lnode].bound[ii] = node;
- E->NODE[lev][m][node] = E->NODE[lev][m][node] | OFFSIDE;
- }
-
- E->parallel.NUM_NNO[lev][m].bound[ii] = lnode;
-
- ii=4; /* rear */
- lnode=0;
- for(j=1;j<=noz;j++)
- for(i=1;i<=nox;i++) {
- node = noz*nox*(noy-1) + (i-1)*noz +j;
- E->parallel.NODE[lev][m][++lnode].bound[ii] = node;
- E->NODE[lev][m][node] = E->NODE[lev][m][node] | OFFSIDE;
- }
-
- E->parallel.NUM_NNO[lev][m].bound[ii] = lnode;
-
- /* determine the overlapped nodes between caps or between proc */
-
- if (E->parallel.me_loc[1]!=E->parallel.nprocx-1)
- for (lnode=1;lnode<=E->parallel.NUM_NNO[lev][m].bound[2];lnode++) {
- node = E->parallel.NODE[lev][m][lnode].bound[2];
- E->NODE[lev][m][node] = E->NODE[lev][m][node] | SKIP;
- }
-
- if (E->parallel.me_loc[2]!=E->parallel.nprocy-1)
- for (lnode=1;lnode<=E->parallel.NUM_NNO[lev][m].bound[4];lnode++) {
- node = E->parallel.NODE[lev][m][lnode].bound[4];
- E->NODE[lev][m][node] = E->NODE[lev][m][node] | SKIP;
- }
-
- if (E->parallel.me_loc[3]!=E->parallel.nprocz-1)
- for (lnode=1;lnode<=E->parallel.NUM_NNO[lev][m].bound[6];lnode++) {
- node = E->parallel.NODE[lev][m][lnode].bound[6];
- E->NODE[lev][m][node] = E->NODE[lev][m][node] | SKIP;
- }
-
- } /* end for m */
- } /* end for level */
-
-
-if (E->control.verbose) {
- fprintf(E->fp_out,"output_shared_nodes %d \n",E->parallel.me);
- for(lev=E->mesh.gridmax;lev>=E->mesh.gridmin;lev--)
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- fprintf(E->fp_out,"lev=%d me=%d capid=%d m=%d \n",lev,E->parallel.me,E->sphere.capid[m],m);
- for (ii=1;ii<=6;ii++)
- for (i=1;i<=E->parallel.NUM_NNO[lev][m].bound[ii];i++)
- fprintf(E->fp_out,"ii=%d %d %d \n",ii,i,E->parallel.NODE[lev][m][i].bound[ii]);
-
- lnode=0;
- for (node=1;node<=E->lmesh.NNO[lev];node++)
- if((E->NODE[lev][m][node] & SKIP)) {
- lnode++;
- fprintf(E->fp_out,"skip %d %d \n",lnode,node);
- }
- }
- fflush(E->fp_out);
- }
-
-
-
- return;
- }
-
-
-/* ============================================
- determine communication routs and boundary ID for
- exchange info across the boundaries
- assuming fault nodes are in the top row of processors
- ============================================ */
-
-void regional_parallel_communication_routs_v(E)
- struct All_variables *E;
- {
-
- int m,i,ii,j,k,l,node,el,elt,lnode,jj,doff,target_cap;
- int lev,elx,elz,ely,nno,nox,noz,noy,kkk,kk,kf,kkkp;
- int me, nproczl,nprocxl,nprocyl;
- int temp_dims,addi_doff;
- int cap,lx,ly,lz,dir;
- FILE *fp,*fp1,*fp2;
- char output_file[255];
-
- const int dims=E->mesh.nsd;
-
- me = E->parallel.me;
- nproczl = E->parallel.nprocz;
- nprocyl = E->parallel.nprocy;
- nprocxl = E->parallel.nprocx;
- lx = E->parallel.me_loc[1];
- ly = E->parallel.me_loc[2];
- lz = E->parallel.me_loc[3];
-
- /* determine the communications in horizontal direction */
- for(lev=E->mesh.gridmax;lev>=E->mesh.gridmin;lev--) {
- nox = E->lmesh.NOX[lev];
- noz = E->lmesh.NOZ[lev];
- noy = E->lmesh.NOY[lev];
- ii=0;
- kkk=0;
-
-
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
- cap = E->sphere.capid[m] - 1; /* which cap I am in (0~11) */
-
- for(i=1;i<=2;i++) { /* do YOZ boundaries & OY lines */
-
- ii ++;
- E->parallel.NUM_PASS[lev][m].bound[ii] = 1;
- if(E->parallel.me_loc[1]==0 && i==1)
- E->parallel.NUM_PASS[lev][m].bound[ii] = 0;
- else if(E->parallel.me_loc[1]==nprocxl-1 && i==2)
- E->parallel.NUM_PASS[lev][m].bound[ii] = 0;
-
- if (E->parallel.NUM_PASS[lev][m].bound[ii] == 1) {
- kkk ++;
- /* determine the pass ID for ii-th boundary and kkk-th pass */
-
- /*E->parallel.PROCESSOR[lev][m].pass[kkk]=me-((i==1)?1:-1)*nproczl; */
- dir = ( (i==1)? 1 : -1);
- E->parallel.PROCESSOR[lev][m].pass[kkk]=E->parallel.loc2proc_map[cap][lx-dir][ly][lz];
-
- E->parallel.NUM_NODE[lev][m].pass[kkk] = E->parallel.NUM_NNO[lev][m].bound[ii];
- jj = 0;
- for (k=1;k<=E->parallel.NUM_NODE[lev][m].pass[kkk];k++) {
- lnode = k;
- node = E->parallel.NODE[lev][m][lnode].bound[ii];
- E->parallel.EXCHANGE_NODE[lev][m][k].pass[kkk] = node;
- temp_dims = dims;
-
- for(doff=1;doff<=temp_dims;doff++)
- E->parallel.EXCHANGE_ID[lev][m][++jj].pass[kkk] = E->ID[lev][m][node].doff[doff];
- } /* end for node k */
-
- E->parallel.NUM_NEQ[lev][m].pass[kkk] = jj;
-
- } /* end if */
- } /* end for i */
-
-
- for(k=1;k<=2;k++) { /* do XOZ boundaries & OZ lines */
- ii ++;
- E->parallel.NUM_PASS[lev][m].bound[ii] = 1;
- if(E->parallel.me_loc[2]==0 && k==1)
- E->parallel.NUM_PASS[lev][m].bound[ii] = 0;
- else if(E->parallel.me_loc[2]==nprocyl-1 && k==2)
- E->parallel.NUM_PASS[lev][m].bound[ii] = 0;
-
- if(E->parallel.NUM_PASS[lev][m].bound[ii] == 1) {
-
- kkk ++;
- /* determine the pass ID for ii-th boundary and kkk-th pass */
-
- /*E->parallel.PROCESSOR[lev][m].pass[kkk]=me-((k==1)?1:-1)*nprocxl*nproczl; */
- dir = ( (k==1)? 1 : -1);
- E->parallel.PROCESSOR[lev][m].pass[kkk]=E->parallel.loc2proc_map[cap][lx][ly-dir][lz];
-
- E->parallel.NUM_NODE[lev][m].pass[kkk] = E->parallel.NUM_NNO[lev][m].bound[ii];
-
- jj = 0; kf = 0;
- for (kk=1;kk<=E->parallel.NUM_NODE[lev][m].pass[kkk];kk++) {
- lnode = kk;
- node = E->parallel.NODE[lev][m][lnode].bound[ii];
- E->parallel.EXCHANGE_NODE[lev][m][kk].pass[kkk] = node;
- temp_dims = dims;
- for(doff=1;doff<=temp_dims;doff++)
- E->parallel.EXCHANGE_ID[lev][m][++jj].pass[kkk] = E->ID[lev][m][node].doff[doff];
- } /* end for node kk */
-
- E->parallel.NUM_NEQ[lev][m].pass[kkk] = jj;
-
- } /* end if */
-
- } /* end for k */
-
-
- for(j=1;j<=2;j++) { /* do XOY boundaries & OX lines */
- ii ++;
- E->parallel.NUM_PASS[lev][m].bound[ii] = 1;
- if(E->parallel.me_loc[3]==0 && j==1)
- E->parallel.NUM_PASS[lev][m].bound[ii] = 0;
- else if(E->parallel.me_loc[3]==nproczl-1 && j==2)
- E->parallel.NUM_PASS[lev][m].bound[ii] = 0;
-
- if(E->parallel.NUM_PASS[lev][m].bound[ii] == 1) {
- kkk ++;
- /* determine the pass ID for ii-th boundary and kkk-th pass */
-
- /*E->parallel.PROCESSOR[lev][m].pass[kkk]=me-((j==1)?1:-1);*/
- dir = ( (j==1)? 1 : -1);
- E->parallel.PROCESSOR[lev][m].pass[kkk]=E->parallel.loc2proc_map[cap][lx][ly][lz-dir];
-
- E->parallel.NUM_NODE[lev][m].pass[kkk] = E->parallel.NUM_NNO[lev][m].bound[ii];
-
- jj = 0; kf = 0;
- for (kk=1;kk<=E->parallel.NUM_NODE[lev][m].pass[kkk];kk++) {
- lnode = kk;
- node = E->parallel.NODE[lev][m][lnode].bound[ii];
- E->parallel.EXCHANGE_NODE[lev][m][kk].pass[kkk] = node;
- temp_dims = dims;
- for(doff=1;doff<=temp_dims;doff++)
- E->parallel.EXCHANGE_ID[lev][m][++jj].pass[kkk] = E->ID[lev][m][node].doff[doff];
- } /* end for node k */
-
- E->parallel.NUM_NEQ[lev][m].pass[kkk] = jj;
-
- } /* end if */
-
- } /* end for j */
-
-
- E->parallel.TNUM_PASS[lev][m] = kkk;
-
-
- } /* end for m */
-
- } /* end for level */
-
- if(E->control.verbose) {
- for(lev=E->mesh.gridmax;lev>=E->mesh.gridmin;lev--) {
- fprintf(E->fp_out,"output_communication route surface for lev=%d \n",lev);
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- fprintf(E->fp_out," me= %d cap=%d pass %d \n",E->parallel.me,E->sphere.capid[m],E->parallel.TNUM_PASS[lev][m]);
- for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
- fprintf(E->fp_out,"proc %d and pass %d to proc %d with %d eqn and %d node\n",E->parallel.me,k,E->parallel.PROCESSOR[lev][m].pass[k],E->parallel.NUM_NEQ[lev][m].pass[k],E->parallel.NUM_NODE[lev][m].pass[k]);
-/* fprintf(E->fp_out,"Eqn:\n"); */
-/* for (ii=1;ii<=E->parallel.NUM_NEQ[lev][m].pass[k];ii++) */
-/* fprintf(E->fp_out,"%d %d\n",ii,E->parallel.EXCHANGE_ID[lev][m][ii].pass[k]); */
-/* fprintf(E->fp_out,"Node:\n"); */
-/* for (ii=1;ii<=E->parallel.NUM_NODE[lev][m].pass[k];ii++) */
-/* fprintf(E->fp_out,"%d %d\n",ii,E->parallel.EXCHANGE_NODE[lev][m][ii].pass[k]); */
- }
- }
-
- }
- fflush(E->fp_out);
- }
-
- return;
- }
-
-/* ============================================
- determine communication routs for
- exchange info across the boundaries on the surfaces
- assuming fault nodes are in the top row of processors
- ============================================ */
-
-void regional_parallel_communication_routs_s(E)
- struct All_variables *E;
- {
-
- int i,ii,j,k,l,node,el,elt,lnode,jj,doff;
- int lev,nno,nox,noz,noy,kkk,kk,kf;
- int p,me,m, nprocz;
- int nprocxl,nprocyl,nproczl;
- void parallel_process_termination();
- FILE *fp1,*fp2;
-
- char output_file[200];
- const int dims=E->mesh.nsd;
-
- me = E->parallel.me;
- nprocz = E->parallel.nprocz;
-
- nprocxl = E->parallel.nprocx;
- nprocyl = E->parallel.nprocy;
- nproczl = E->parallel.nprocz;
-
-
- /* determine the communications in horizontal direction */
- for(lev=E->mesh.gridmax;lev>=E->mesh.gridmin;lev--) {
- nox = E->lmesh.NOX[lev];
- noz = E->lmesh.NOZ[lev];
- noy = E->lmesh.NOY[lev];
- ii = 0;
- kkk = 0;
-
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
-
- for(i=1;i<=2;i++) { /* do YOZ boundaries & OY lines */
-
- ii ++;
- E->parallel.NUM_PASS[lev][m].bound[ii] = 1;
- if(E->parallel.me_loc[1]==0 && i==1)
- E->parallel.NUM_PASS[lev][m].bound[ii] = 0;
- else if(E->parallel.me_loc[1]==nprocxl-1 && i==2)
- E->parallel.NUM_PASS[lev][m].bound[ii] = 0;
-
- for (p=1;p<=E->parallel.NUM_PASS[lev][m].bound[ii];p++) {
- kkk ++;
- /* determine the pass ID for ii-th boundary and p-th pass */
-
- E->parallel.sPROCESSOR[lev][m].pass[kkk]=me-((i==1)?1:-1)*nproczl;
-
- E->parallel.NUM_sNODE[lev][m].pass[kkk] =
- E->parallel.NUM_NNO[lev][m].bound[ii]/noz;
- for (k=1;k<=E->parallel.NUM_sNODE[lev][m].pass[kkk];k++) {
- lnode = k; /* due to lnode increases in horizontal di first */
- node = (E->parallel.NODE[lev][m][lnode].bound[ii]-1)/noz+1;
- E->parallel.EXCHANGE_sNODE[lev][m][k].pass[kkk] = node;
- } /* end for node k */
-
- } /* end for loop p */
- } /* end for i */
-
- ii = 2;
- for(k=1;k<=2;k++) { /* do XOZ boundaries & OX lines */
-
- ii ++;
- E->parallel.NUM_PASS[lev][m].bound[ii] = 1;
- if(E->parallel.me_loc[2]==0 && k==1)
- E->parallel.NUM_PASS[lev][m].bound[ii] = 0;
- else if(E->parallel.me_loc[2]==nprocyl-1 && k==2)
- E->parallel.NUM_PASS[lev][m].bound[ii] = 0;
-
- for (p=1;p<=E->parallel.NUM_PASS[lev][m].bound[ii];p++) {
-
- kkk ++;
- /* determine the pass ID for ii-th boundary and p-th pass */
-
- E->parallel.sPROCESSOR[lev][m].pass[kkk]=me-((k==1)?1:-1)*nprocxl*nproczl;
-
- E->parallel.NUM_sNODE[lev][m].pass[kkk] =
- E->parallel.NUM_NNO[lev][m].bound[ii]/noz;
-
- for (kk=1;kk<=E->parallel.NUM_sNODE[lev][m].pass[kkk];kk++) {
- lnode = kk; /* due to lnode increases in horizontal di first */
- node = (E->parallel.NODE[lev][m][lnode].bound[ii]-1)/noz+1;
- E->parallel.EXCHANGE_sNODE[lev][m][kk].pass[kkk] = node;
- } /* end for node kk */
-
- } /* end for loop p */
-
- } /* end for k */
-
-
- E->parallel.sTNUM_PASS[lev][m] = kkk;
-
-
- } /* end for m */
-
- } /* end for lev */
-
-
- return;
- }
-
-
-/* ================================================
-WARNING: BUGS AHEAD
-
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
-
- sizeofk = (1+E->parallel.NUM_NEQ[lev][m].pass[k])*sizeof(double);
- S[k]=(double *)malloc( sizeofk );
- R[k]=(double *)malloc( sizeofk );
- }
- }
-
-This piece of code contain a bug. Arrays S and R are allocated for each m.
-But most of the memory is leaked.
-
-In this version of CitcomS, sphere.caps_per_proc is always equal to one.
-So, this bug won't manifest itself. But in other version of CitcomS, it will.
-
-by Tan2 7/21, 2003
-================================================ */
-
-void regional_exchange_id_d(E, U, lev)
- struct All_variables *E;
- double **U;
- int lev;
- {
-
- int ii,j,jj,m,k;
- double *S[27],*R[27];
- int sizeofk;
-
- MPI_Status status;
-
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
- sizeofk = (1+E->parallel.NUM_NEQ[lev][m].pass[k])*sizeof(double);
- S[k]=(double *)malloc( sizeofk );
- R[k]=(double *)malloc( sizeofk );
- }
- }
-
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
-
- for (j=1;j<=E->parallel.NUM_NEQ[lev][m].pass[k];j++)
- S[k][j-1] = U[m][ E->parallel.EXCHANGE_ID[lev][m][j].pass[k] ];
-
- MPI_Sendrecv(S[k],E->parallel.NUM_NEQ[lev][m].pass[k],MPI_DOUBLE,
- E->parallel.PROCESSOR[lev][m].pass[k],1,
- R[k],E->parallel.NUM_NEQ[lev][m].pass[k],MPI_DOUBLE,
- E->parallel.PROCESSOR[lev][m].pass[k],1,
- E->parallel.world,&status);
-
- for (j=1;j<=E->parallel.NUM_NEQ[lev][m].pass[k];j++)
- U[m][ E->parallel.EXCHANGE_ID[lev][m][j].pass[k] ] += R[k][j-1];
-
- } /* for k */
- } /* for m */ /* finish sending */
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
- free((void*) S[k]);
- free((void*) R[k]);
- }
-
- return;
- }
-
-
-/* ================================================ */
-/* ================================================ */
-static void exchange_node_d(E, U, lev)
- struct All_variables *E;
- double **U;
- int lev;
- {
-
- int ii,j,jj,m,k;
- double *S[27],*R[27];
- int sizeofk;
-
- MPI_Status status;
-
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
- sizeofk = (1+E->parallel.NUM_NODE[lev][m].pass[k])*sizeof(double);
- S[k]=(double *)malloc( sizeofk );
- R[k]=(double *)malloc( sizeofk );
- } /* end for k */
- }
-
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
- for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
-
- for (j=1;j<=E->parallel.NUM_NODE[lev][m].pass[k];j++)
- S[k][j-1] = U[m][ E->parallel.EXCHANGE_NODE[lev][m][j].pass[k] ];
-
- MPI_Sendrecv(S[k],E->parallel.NUM_NODE[lev][m].pass[k],MPI_DOUBLE,
- E->parallel.PROCESSOR[lev][m].pass[k],1,
- R[k],E->parallel.NUM_NODE[lev][m].pass[k],MPI_DOUBLE,
- E->parallel.PROCESSOR[lev][m].pass[k],1,
- E->parallel.world,&status);
-
- for (j=1;j<=E->parallel.NUM_NODE[lev][m].pass[k];j++)
- U[m][ E->parallel.EXCHANGE_NODE[lev][m][j].pass[k] ] += R[k][j-1];
- }
- }
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
- free((void*) S[k]);
- free((void*) R[k]);
- }
-
- return;
-}
-
-/* ================================================ */
-/* ================================================ */
-
-static void exchange_node_f(E, U, lev)
- struct All_variables *E;
- float **U;
- int lev;
-{
-
- int ii,j,jj,m,k;
- float *S[27],*R[27];
- int sizeofk;
-
- MPI_Status status;
-
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
- sizeofk = (1+E->parallel.NUM_NODE[lev][m].pass[k])*sizeof(float);
- S[k]=(float *)malloc( sizeofk );
- R[k]=(float *)malloc( sizeofk );
- } /* end for k */
- }
-
-
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
-
- for (j=1;j<=E->parallel.NUM_NODE[lev][m].pass[k];j++)
- S[k][j-1] = U[m][ E->parallel.EXCHANGE_NODE[lev][m][j].pass[k] ];
-
- MPI_Sendrecv(S[k],E->parallel.NUM_NODE[lev][m].pass[k],MPI_FLOAT,
- E->parallel.PROCESSOR[lev][m].pass[k],1,
- R[k],E->parallel.NUM_NODE[lev][m].pass[k],MPI_FLOAT,
- E->parallel.PROCESSOR[lev][m].pass[k],1,
- E->parallel.world,&status);
-
- for (j=1;j<=E->parallel.NUM_NODE[lev][m].pass[k];j++)
- U[m][ E->parallel.EXCHANGE_NODE[lev][m][j].pass[k] ] += R[k][j-1];
- }
- }
-
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
- free((void*) S[k]);
- free((void*) R[k]);
- }
-
-
- return;
- }
-/* ================================================ */
-/* ================================================ */
-
-void regional_exchange_snode_f(struct All_variables *E, float **U1,
- float **U2, int lev)
- {
-
- int ii,j,k,m,kk,t_cap,idb,msginfo[8];
- float *S[27],*R[27];
- int sizeofk;
-
- MPI_Status status;
-
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- for (k=1;k<=E->parallel.sTNUM_PASS[lev][m];k++) {
- sizeofk = (1+2*E->parallel.NUM_sNODE[lev][m].pass[k])*sizeof(float);
- S[k]=(float *)malloc( sizeofk );
- R[k]=(float *)malloc( sizeofk );
- }
- }
-
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- for (k=1;k<=E->parallel.sTNUM_PASS[lev][m];k++) {
-
- for (j=1;j<=E->parallel.NUM_sNODE[lev][m].pass[k];j++) {
- S[k][j-1] = U1[m][ E->parallel.EXCHANGE_sNODE[lev][m][j].pass[k] ];
- S[k][j-1+E->parallel.NUM_sNODE[lev][m].pass[k]]
- = U2[m][ E->parallel.EXCHANGE_sNODE[lev][m][j].pass[k] ];
- }
-
- MPI_Sendrecv(S[k],2*E->parallel.NUM_sNODE[lev][m].pass[k],MPI_FLOAT,
- E->parallel.sPROCESSOR[lev][m].pass[k],1,
- R[k],2*E->parallel.NUM_sNODE[lev][m].pass[k],MPI_FLOAT,
- E->parallel.sPROCESSOR[lev][m].pass[k],1,
- E->parallel.world,&status);
-
- for (j=1;j<=E->parallel.NUM_sNODE[lev][m].pass[k];j++) {
- U1[m][ E->parallel.EXCHANGE_sNODE[lev][m][j].pass[k] ] += R[k][j-1];
- U2[m][ E->parallel.EXCHANGE_sNODE[lev][m][j].pass[k] ] +=
- R[k][j-1+E->parallel.NUM_sNODE[lev][m].pass[k]];
- }
-
- }
- }
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for (k=1;k<=E->parallel.sTNUM_PASS[lev][m];k++) {
- free((void*) S[k]);
- free((void*) R[k]);
- }
-
- return;
- }
-
Copied: mc/3D/CitcomS/branches/cxx/lib/Regional_parallel_related.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Regional_parallel_related.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Regional_parallel_related.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Regional_parallel_related.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,941 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+#include <mpi.h>
+#include <math.h>
+
+#include "element_definitions.h"
+#include "global_defs.h"
+#include "sphere_communication.h"
+
+#include "parallel_related.h"
+
+
+static void set_horizontal_communicator(struct All_variables*);
+static void set_vertical_communicator(struct All_variables*);
+
+static void exchange_node_d(struct All_variables *, double**, int);
+static void exchange_node_f(struct All_variables *, float**, int);
+
+
+/* ============================================ */
+/* ============================================ */
+
+void regional_parallel_processor_setup(struct All_variables *E)
+ {
+
+ int i,j,k,m,me,temp,pid_surf;
+ int surf_proc_per_cap, proc_per_cap, total_proc;
+
+ me = E->parallel.me;
+
+ surf_proc_per_cap = E->parallel.nprocx * E->parallel.nprocy;
+ proc_per_cap = surf_proc_per_cap * E->parallel.nprocz;
+ total_proc = E->sphere.caps * proc_per_cap;
+ E->parallel.total_surf_proc = E->sphere.caps * surf_proc_per_cap;
+
+ if ( total_proc != E->parallel.nproc ) {
+ if (E->parallel.me==0) fprintf(stderr,"!!!! # of requested CPU is incorrect \n");
+ parallel_process_termination();
+ }
+
+ /* determine the location of processors in each cap */
+ /* z direction first */
+ j = me % E->parallel.nprocz;
+ E->parallel.me_loc[3] = j;
+
+ /* x direction then */
+ k = (me - j)/E->parallel.nprocz % E->parallel.nprocx;
+ E->parallel.me_loc[1] = k;
+
+ /* y direction then */
+ i = ((me - j)/E->parallel.nprocz - k)/E->parallel.nprocx % E->parallel.nprocy;
+ E->parallel.me_loc[2] = i;
+
+ E->sphere.caps_per_proc = 1;
+
+ /* determine cap id for each cap in a given processor */
+ pid_surf = me/E->parallel.nprocz;
+ i = cases[E->sphere.caps_per_proc];
+
+ for (j=1;j<=E->sphere.caps_per_proc;j++) {
+ E->sphere.capid[j] = 1;
+ }
+
+ /* steup location-to-processor map */
+ E->parallel.loc2proc_map = (int ****) malloc(E->sphere.caps*sizeof(int ***));
+ for (m=0;m<E->sphere.caps;m++) {
+ E->parallel.loc2proc_map[m] = (int ***) malloc(E->parallel.nprocx*sizeof(int **));
+ for (i=0;i<E->parallel.nprocx;i++) {
+ E->parallel.loc2proc_map[m][i] = (int **) malloc(E->parallel.nprocy*sizeof(int *));
+ for (j=0;j<E->parallel.nprocy;j++)
+ E->parallel.loc2proc_map[m][i][j] = (int *) malloc(E->parallel.nprocz*sizeof(int));
+ }
+ }
+
+ for (m=0;m<E->sphere.caps;m++)
+ for (i=0;i<E->parallel.nprocx;i++)
+ for (j=0;j<E->parallel.nprocy;j++)
+ for (k=0;k<E->parallel.nprocz;k++) {
+ E->parallel.loc2proc_map[m][i][j][k] = m*proc_per_cap
+ + j*E->parallel.nprocx*E->parallel.nprocz
+ + i*E->parallel.nprocz + k;
+ }
+
+ if (E->control.verbose) {
+ fprintf(E->fp_out,"me=%d loc1=%d loc2=%d loc3=%d\n",me,E->parallel.me_loc[1],E->parallel.me_loc[2],E->parallel.me_loc[3]);
+ for (j=1;j<=E->sphere.caps_per_proc;j++) {
+ fprintf(E->fp_out,"capid[%d]=%d \n",j,E->sphere.capid[j]);
+ }
+ for (m=0;m<E->sphere.caps;m++)
+ for (j=0;j<E->parallel.nprocy;j++)
+ for (i=0;i<E->parallel.nprocx;i++)
+ for (k=0;k<E->parallel.nprocz;k++)
+ fprintf(E->fp_out,"loc2proc_map[cap=%d][x=%d][y=%d][z=%d] = %d\n",
+ m,i,j,k,E->parallel.loc2proc_map[m][i][j][k]);
+
+ fflush(E->fp_out);
+ }
+
+ set_horizontal_communicator(E);
+ set_vertical_communicator(E);
+
+ E->exchange_node_d = exchange_node_d;
+ E->exchange_node_f = exchange_node_f;
+
+ return;
+ }
+
+
+static void set_horizontal_communicator(struct All_variables *E)
+{
+ MPI_Group world_g, horizon_g;
+ int i,j,k,m,n;
+ int *processors;
+
+ processors = (int *) malloc((E->parallel.total_surf_proc+1)*sizeof(int));
+
+ k = E->parallel.me_loc[3];
+ n = 0;
+ for (m=0;m<E->sphere.caps;m++)
+ for (i=0;i<E->parallel.nprocx;i++)
+ for (j=0;j<E->parallel.nprocy;j++) {
+ processors[n] = E->parallel.loc2proc_map[m][i][j][k];
+ n++;
+ }
+
+ if (E->control.verbose) {
+ fprintf(E->fp_out,"horizontal group of me=%d loc3=%d\n",E->parallel.me,E->parallel.me_loc[3]);
+ for (j=0;j<E->parallel.total_surf_proc;j++) {
+ fprintf(E->fp_out,"%d proc=%d\n",j,processors[j]);
+ }
+ fflush(E->fp_out);
+ }
+
+ MPI_Comm_group(E->parallel.world, &world_g);
+ MPI_Group_incl(world_g, E->parallel.total_surf_proc, processors, &horizon_g);
+ MPI_Comm_create(E->parallel.world, horizon_g, &(E->parallel.horizontal_comm));
+
+
+ MPI_Group_free(&horizon_g);
+ MPI_Group_free(&world_g);
+ free((void *) processors);
+
+ return;
+}
+
+
+static void set_vertical_communicator(struct All_variables *E)
+{
+ MPI_Group world_g, vertical_g;
+ int i,j,k,m;
+ int *processors;
+
+ processors = (int *)malloc((E->parallel.nprocz+2)*sizeof(int));
+ if (!processors)
+ fprintf(stderr,"no memory!!\n");
+
+ m = E->sphere.capid[1] - 1; /* assume 1 cap per proc. */
+ i = E->parallel.me_loc[1];
+ j = E->parallel.me_loc[2];
+
+ for (k=0;k<E->parallel.nprocz;k++) {
+ processors[k] = E->parallel.loc2proc_map[m][i][j][k];
+ }
+
+ if (E->control.verbose) {
+ fprintf(E->fp_out,"vertical group of me=%d loc1=%d loc2=%d\n",E->parallel.me,E->parallel.me_loc[1],E->parallel.me_loc[2]);
+ for (k=0;k<E->parallel.nprocz;k++) {
+ fprintf(E->fp_out,"%d proc=%d\n",k,processors[k]);
+ }
+ fflush(E->fp_out);
+ }
+
+ MPI_Comm_group(E->parallel.world, &world_g);
+ MPI_Group_incl(world_g, E->parallel.nprocz, processors, &vertical_g);
+ MPI_Comm_create(E->parallel.world, vertical_g, &(E->parallel.vertical_comm));
+
+ MPI_Group_free(&vertical_g);
+ MPI_Group_free(&world_g);
+ free((void *) processors);
+}
+
+
+
+/* =========================================================================
+get element information for each processor.
+ ========================================================================= */
+
+void regional_parallel_domain_decomp0(struct All_variables *E)
+ {
+
+ int i,nox,noz,noy,me;
+
+ me = E->parallel.me;
+
+ E->lmesh.elx = E->mesh.elx/E->parallel.nprocx;
+ E->lmesh.elz = E->mesh.elz/E->parallel.nprocz;
+ E->lmesh.ely = E->mesh.ely/E->parallel.nprocy;
+ E->lmesh.nox = E->lmesh.elx + 1;
+ E->lmesh.noz = E->lmesh.elz + 1;
+ E->lmesh.noy = E->lmesh.ely + 1;
+
+ E->lmesh.exs = E->parallel.me_loc[1]*E->lmesh.elx;
+ E->lmesh.eys = E->parallel.me_loc[2]*E->lmesh.ely;
+ E->lmesh.ezs = E->parallel.me_loc[3]*E->lmesh.elz;
+ E->lmesh.nxs = E->parallel.me_loc[1]*E->lmesh.elx+1;
+ E->lmesh.nys = E->parallel.me_loc[2]*E->lmesh.ely+1;
+ E->lmesh.nzs = E->parallel.me_loc[3]*E->lmesh.elz+1;
+
+ E->lmesh.nno = E->lmesh.noz*E->lmesh.nox*E->lmesh.noy;
+ E->lmesh.nel = E->lmesh.ely*E->lmesh.elx*E->lmesh.elz;
+ E->lmesh.npno = E->lmesh.nel;
+
+ E->lmesh.nsf = E->lmesh.nno/E->lmesh.noz;
+ E->lmesh.snel = E->lmesh.elx*E->lmesh.ely;
+
+
+ for(i=E->mesh.levmax;i>=E->mesh.levmin;i--) {
+
+ if (E->control.NMULTIGRID||E->control.EMULTIGRID) {
+ nox = E->mesh.mgunitx * (int) pow(2.0,(double)i) + 1;
+ noy = E->mesh.mgunity * (int) pow(2.0,(double)i) + 1;
+ noz = E->lmesh.elz/(int)pow(2.0,(double)(E->mesh.levmax-i))+1;
+ E->parallel.redundant[i]=0;
+ }
+ else
+ { noz = E->lmesh.noz;
+ noy = E->mesh.mgunity * (int) pow(2.0,(double)i) + 1;
+ nox = E->mesh.mgunitx * (int) pow(2.0,(double)i) + 1;
+ if(i<E->mesh.levmax) noz=2;
+ }
+
+ E->lmesh.ELX[i] = nox-1;
+ E->lmesh.ELY[i] = noy-1;
+ E->lmesh.ELZ[i] = noz-1;
+ E->lmesh.NOZ[i] = noz;
+ E->lmesh.NOY[i] = noy;
+ E->lmesh.NOX[i] = nox;
+ E->lmesh.NNO[i] = nox * noz * noy;
+ E->lmesh.NNOV[i] = E->lmesh.NNO[i];
+ E->lmesh.SNEL[i] = E->lmesh.ELX[i]*E->lmesh.ELY[i];
+
+ E->lmesh.NEL[i] = (nox-1) * (noz-1) * (noy-1);
+ E->lmesh.NPNO[i] = E->lmesh.NEL[i] ;
+
+ E->lmesh.NEQ[i] = E->mesh.nsd * E->lmesh.NNOV[i] ;
+
+ E->lmesh.EXS[i] = E->parallel.me_loc[1]*E->lmesh.ELX[i];
+ E->lmesh.EYS[i] = E->parallel.me_loc[2]*E->lmesh.ELY[i];
+ E->lmesh.EZS[i] = E->parallel.me_loc[3]*E->lmesh.ELZ[i];
+ E->lmesh.NXS[i] = E->parallel.me_loc[1]*E->lmesh.ELX[i]+1;
+ E->lmesh.NYS[i] = E->parallel.me_loc[2]*E->lmesh.ELY[i]+1;
+ E->lmesh.NZS[i] = E->parallel.me_loc[3]*E->lmesh.ELZ[i]+1;
+
+ }
+
+/*
+fprintf(stderr,"b %d %d %d %d %d %d %d\n",E->parallel.me,E->parallel.me_loc[1],E->parallel.me_loc[2],E->parallel.me_loc[3],E->lmesh.nzs,E->lmesh.nys,E->lmesh.noy);
+*/
+/* parallel_process_termination();
+*/
+ return;
+ }
+
+
+
+
+/* ============================================
+ determine boundary nodes for
+ exchange info across the boundaries
+ ============================================ */
+
+void regional_parallel_domain_boundary_nodes(struct All_variables *E)
+ {
+
+ int m,i,ii,j,k,l,node,el,lnode;
+ int lev,ele,elx,elz,ely,nel,nno,nox,noz,noy;
+ FILE *fp,*fp1;
+ char output_file[255];
+
+ for(lev=E->mesh.gridmin;lev<=E->mesh.gridmax;lev++) {
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+ nel = E->lmesh.NEL[lev];
+ elx = E->lmesh.ELX[lev];
+ elz = E->lmesh.ELZ[lev];
+ ely = E->lmesh.ELY[lev];
+ nox = E->lmesh.NOX[lev];
+ noy = E->lmesh.NOY[lev];
+ noz = E->lmesh.NOZ[lev];
+ nno = E->lmesh.NNO[lev];
+
+/* do the ZOY boundary elements first */
+ lnode = 0;
+ ii =1; /* left */
+ for(j=1;j<=noz;j++)
+ for(k=1;k<=noy;k++) {
+ node = j + (k-1)*noz*nox;
+ E->parallel.NODE[lev][m][++lnode].bound[ii] = node;
+ E->NODE[lev][m][node] = E->NODE[lev][m][node] | OFFSIDE;
+ }
+
+ E->parallel.NUM_NNO[lev][m].bound[ii] = lnode;
+
+
+ lnode = 0;
+ ii =2; /* right */
+ for(j=1;j<=noz;j++)
+ for(k=1;k<=noy;k++) {
+ node = (nox-1)*noz + j + (k-1)*noz*nox;
+ E->parallel.NODE[lev][m][++lnode].bound[ii] = node;
+ E->NODE[lev][m][node] = E->NODE[lev][m][node] | OFFSIDE;
+ }
+
+ E->parallel.NUM_NNO[lev][m].bound[ii] = lnode;
+
+
+/* do XOY boundary elements */
+ ii=5; /* bottom */
+ lnode=0;
+ for(k=1;k<=noy;k++)
+ for(i=1;i<=nox;i++) {
+ node = (k-1)*nox*noz + (i-1)*noz + 1;
+ E->parallel.NODE[lev][m][++lnode].bound[ii] = node;
+ E->NODE[lev][m][node] = E->NODE[lev][m][node] | OFFSIDE;
+ }
+
+ E->parallel.NUM_NNO[lev][m].bound[ii] = lnode;
+
+ ii=6; /* top */
+ lnode=0;
+ for(k=1;k<=noy;k++)
+ for(i=1;i<=nox;i++) {
+ node = (k-1)*nox*noz + i*noz;
+ E->parallel.NODE[lev][m][++lnode].bound[ii] = node;
+ E->NODE[lev][m][node] = E->NODE[lev][m][node] | OFFSIDE;
+ }
+
+ E->parallel.NUM_NNO[lev][m].bound[ii] = lnode;
+
+
+/* do XOZ boundary elements for 3D */
+ ii=3; /* front */
+ lnode=0;
+ for(j=1;j<=noz;j++)
+ for(i=1;i<=nox;i++) {
+ node = (i-1)*noz +j;
+ E->parallel.NODE[lev][m][++lnode].bound[ii] = node;
+ E->NODE[lev][m][node] = E->NODE[lev][m][node] | OFFSIDE;
+ }
+
+ E->parallel.NUM_NNO[lev][m].bound[ii] = lnode;
+
+ ii=4; /* rear */
+ lnode=0;
+ for(j=1;j<=noz;j++)
+ for(i=1;i<=nox;i++) {
+ node = noz*nox*(noy-1) + (i-1)*noz +j;
+ E->parallel.NODE[lev][m][++lnode].bound[ii] = node;
+ E->NODE[lev][m][node] = E->NODE[lev][m][node] | OFFSIDE;
+ }
+
+ E->parallel.NUM_NNO[lev][m].bound[ii] = lnode;
+
+ /* determine the overlapped nodes between caps or between proc */
+
+ if (E->parallel.me_loc[1]!=E->parallel.nprocx-1)
+ for (lnode=1;lnode<=E->parallel.NUM_NNO[lev][m].bound[2];lnode++) {
+ node = E->parallel.NODE[lev][m][lnode].bound[2];
+ E->NODE[lev][m][node] = E->NODE[lev][m][node] | SKIP;
+ }
+
+ if (E->parallel.me_loc[2]!=E->parallel.nprocy-1)
+ for (lnode=1;lnode<=E->parallel.NUM_NNO[lev][m].bound[4];lnode++) {
+ node = E->parallel.NODE[lev][m][lnode].bound[4];
+ E->NODE[lev][m][node] = E->NODE[lev][m][node] | SKIP;
+ }
+
+ if (E->parallel.me_loc[3]!=E->parallel.nprocz-1)
+ for (lnode=1;lnode<=E->parallel.NUM_NNO[lev][m].bound[6];lnode++) {
+ node = E->parallel.NODE[lev][m][lnode].bound[6];
+ E->NODE[lev][m][node] = E->NODE[lev][m][node] | SKIP;
+ }
+
+ } /* end for m */
+ } /* end for level */
+
+
+if (E->control.verbose) {
+ fprintf(E->fp_out,"output_shared_nodes %d \n",E->parallel.me);
+ for(lev=E->mesh.gridmax;lev>=E->mesh.gridmin;lev--)
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ fprintf(E->fp_out,"lev=%d me=%d capid=%d m=%d \n",lev,E->parallel.me,E->sphere.capid[m],m);
+ for (ii=1;ii<=6;ii++)
+ for (i=1;i<=E->parallel.NUM_NNO[lev][m].bound[ii];i++)
+ fprintf(E->fp_out,"ii=%d %d %d \n",ii,i,E->parallel.NODE[lev][m][i].bound[ii]);
+
+ lnode=0;
+ for (node=1;node<=E->lmesh.NNO[lev];node++)
+ if((E->NODE[lev][m][node] & SKIP)) {
+ lnode++;
+ fprintf(E->fp_out,"skip %d %d \n",lnode,node);
+ }
+ }
+ fflush(E->fp_out);
+ }
+
+
+
+ return;
+ }
+
+
+/* ============================================
+ determine communication routs and boundary ID for
+ exchange info across the boundaries
+ assuming fault nodes are in the top row of processors
+ ============================================ */
+
+void regional_parallel_communication_routs_v(struct All_variables *E)
+{
+
+ int m,i,ii,j,k,l,node,el,elt,lnode,jj,doff,target_cap;
+ int lev,elx,elz,ely,nno,nox,noz,noy,kkk,kk,kf,kkkp;
+ int me, nproczl,nprocxl,nprocyl;
+ int temp_dims,addi_doff;
+ int cap,lx,ly,lz,dir;
+ FILE *fp,*fp1,*fp2;
+ char output_file[255];
+
+ const int dims=E->mesh.nsd;
+
+ me = E->parallel.me;
+ nproczl = E->parallel.nprocz;
+ nprocyl = E->parallel.nprocy;
+ nprocxl = E->parallel.nprocx;
+ lx = E->parallel.me_loc[1];
+ ly = E->parallel.me_loc[2];
+ lz = E->parallel.me_loc[3];
+
+ /* determine the communications in horizontal direction */
+ for(lev=E->mesh.gridmax;lev>=E->mesh.gridmin;lev--) {
+ nox = E->lmesh.NOX[lev];
+ noz = E->lmesh.NOZ[lev];
+ noy = E->lmesh.NOY[lev];
+ ii=0;
+ kkk=0;
+
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+ cap = E->sphere.capid[m] - 1; /* which cap I am in (0~11) */
+
+ for(i=1;i<=2;i++) { /* do YOZ boundaries & OY lines */
+
+ ii ++;
+ E->parallel.NUM_PASS[lev][m].bound[ii] = 1;
+ if(E->parallel.me_loc[1]==0 && i==1)
+ E->parallel.NUM_PASS[lev][m].bound[ii] = 0;
+ else if(E->parallel.me_loc[1]==nprocxl-1 && i==2)
+ E->parallel.NUM_PASS[lev][m].bound[ii] = 0;
+
+ if (E->parallel.NUM_PASS[lev][m].bound[ii] == 1) {
+ kkk ++;
+ /* determine the pass ID for ii-th boundary and kkk-th pass */
+
+ /*E->parallel.PROCESSOR[lev][m].pass[kkk]=me-((i==1)?1:-1)*nproczl; */
+ dir = ( (i==1)? 1 : -1);
+ E->parallel.PROCESSOR[lev][m].pass[kkk]=E->parallel.loc2proc_map[cap][lx-dir][ly][lz];
+
+ E->parallel.NUM_NODE[lev][m].pass[kkk] = E->parallel.NUM_NNO[lev][m].bound[ii];
+ jj = 0;
+ for (k=1;k<=E->parallel.NUM_NODE[lev][m].pass[kkk];k++) {
+ lnode = k;
+ node = E->parallel.NODE[lev][m][lnode].bound[ii];
+ E->parallel.EXCHANGE_NODE[lev][m][k].pass[kkk] = node;
+ temp_dims = dims;
+
+ for(doff=1;doff<=temp_dims;doff++)
+ E->parallel.EXCHANGE_ID[lev][m][++jj].pass[kkk] = E->ID[lev][m][node].doff[doff];
+ } /* end for node k */
+
+ E->parallel.NUM_NEQ[lev][m].pass[kkk] = jj;
+
+ } /* end if */
+ } /* end for i */
+
+
+ for(k=1;k<=2;k++) { /* do XOZ boundaries & OZ lines */
+ ii ++;
+ E->parallel.NUM_PASS[lev][m].bound[ii] = 1;
+ if(E->parallel.me_loc[2]==0 && k==1)
+ E->parallel.NUM_PASS[lev][m].bound[ii] = 0;
+ else if(E->parallel.me_loc[2]==nprocyl-1 && k==2)
+ E->parallel.NUM_PASS[lev][m].bound[ii] = 0;
+
+ if(E->parallel.NUM_PASS[lev][m].bound[ii] == 1) {
+
+ kkk ++;
+ /* determine the pass ID for ii-th boundary and kkk-th pass */
+
+ /*E->parallel.PROCESSOR[lev][m].pass[kkk]=me-((k==1)?1:-1)*nprocxl*nproczl; */
+ dir = ( (k==1)? 1 : -1);
+ E->parallel.PROCESSOR[lev][m].pass[kkk]=E->parallel.loc2proc_map[cap][lx][ly-dir][lz];
+
+ E->parallel.NUM_NODE[lev][m].pass[kkk] = E->parallel.NUM_NNO[lev][m].bound[ii];
+
+ jj = 0; kf = 0;
+ for (kk=1;kk<=E->parallel.NUM_NODE[lev][m].pass[kkk];kk++) {
+ lnode = kk;
+ node = E->parallel.NODE[lev][m][lnode].bound[ii];
+ E->parallel.EXCHANGE_NODE[lev][m][kk].pass[kkk] = node;
+ temp_dims = dims;
+ for(doff=1;doff<=temp_dims;doff++)
+ E->parallel.EXCHANGE_ID[lev][m][++jj].pass[kkk] = E->ID[lev][m][node].doff[doff];
+ } /* end for node kk */
+
+ E->parallel.NUM_NEQ[lev][m].pass[kkk] = jj;
+
+ } /* end if */
+
+ } /* end for k */
+
+
+ for(j=1;j<=2;j++) { /* do XOY boundaries & OX lines */
+ ii ++;
+ E->parallel.NUM_PASS[lev][m].bound[ii] = 1;
+ if(E->parallel.me_loc[3]==0 && j==1)
+ E->parallel.NUM_PASS[lev][m].bound[ii] = 0;
+ else if(E->parallel.me_loc[3]==nproczl-1 && j==2)
+ E->parallel.NUM_PASS[lev][m].bound[ii] = 0;
+
+ if(E->parallel.NUM_PASS[lev][m].bound[ii] == 1) {
+ kkk ++;
+ /* determine the pass ID for ii-th boundary and kkk-th pass */
+
+ /*E->parallel.PROCESSOR[lev][m].pass[kkk]=me-((j==1)?1:-1);*/
+ dir = ( (j==1)? 1 : -1);
+ E->parallel.PROCESSOR[lev][m].pass[kkk]=E->parallel.loc2proc_map[cap][lx][ly][lz-dir];
+
+ E->parallel.NUM_NODE[lev][m].pass[kkk] = E->parallel.NUM_NNO[lev][m].bound[ii];
+
+ jj = 0; kf = 0;
+ for (kk=1;kk<=E->parallel.NUM_NODE[lev][m].pass[kkk];kk++) {
+ lnode = kk;
+ node = E->parallel.NODE[lev][m][lnode].bound[ii];
+ E->parallel.EXCHANGE_NODE[lev][m][kk].pass[kkk] = node;
+ temp_dims = dims;
+ for(doff=1;doff<=temp_dims;doff++)
+ E->parallel.EXCHANGE_ID[lev][m][++jj].pass[kkk] = E->ID[lev][m][node].doff[doff];
+ } /* end for node k */
+
+ E->parallel.NUM_NEQ[lev][m].pass[kkk] = jj;
+
+ } /* end if */
+
+ } /* end for j */
+
+
+ E->parallel.TNUM_PASS[lev][m] = kkk;
+
+
+ } /* end for m */
+
+ } /* end for level */
+
+ if(E->control.verbose) {
+ for(lev=E->mesh.gridmax;lev>=E->mesh.gridmin;lev--) {
+ fprintf(E->fp_out,"output_communication route surface for lev=%d \n",lev);
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ fprintf(E->fp_out," me= %d cap=%d pass %d \n",E->parallel.me,E->sphere.capid[m],E->parallel.TNUM_PASS[lev][m]);
+ for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
+ fprintf(E->fp_out,"proc %d and pass %d to proc %d with %d eqn and %d node\n",E->parallel.me,k,E->parallel.PROCESSOR[lev][m].pass[k],E->parallel.NUM_NEQ[lev][m].pass[k],E->parallel.NUM_NODE[lev][m].pass[k]);
+/* fprintf(E->fp_out,"Eqn:\n"); */
+/* for (ii=1;ii<=E->parallel.NUM_NEQ[lev][m].pass[k];ii++) */
+/* fprintf(E->fp_out,"%d %d\n",ii,E->parallel.EXCHANGE_ID[lev][m][ii].pass[k]); */
+/* fprintf(E->fp_out,"Node:\n"); */
+/* for (ii=1;ii<=E->parallel.NUM_NODE[lev][m].pass[k];ii++) */
+/* fprintf(E->fp_out,"%d %d\n",ii,E->parallel.EXCHANGE_NODE[lev][m][ii].pass[k]); */
+ }
+ }
+
+ }
+ fflush(E->fp_out);
+ }
+
+ return;
+ }
+
+/* ============================================
+ determine communication routs for
+ exchange info across the boundaries on the surfaces
+ assuming fault nodes are in the top row of processors
+ ============================================ */
+
+void regional_parallel_communication_routs_s(struct All_variables *E)
+{
+
+ int i,ii,j,k,l,node,el,elt,lnode,jj,doff;
+ int lev,nno,nox,noz,noy,kkk,kk,kf;
+ int p,me,m, nprocz;
+ int nprocxl,nprocyl,nproczl;
+ FILE *fp1,*fp2;
+
+ char output_file[200];
+ const int dims=E->mesh.nsd;
+
+ me = E->parallel.me;
+ nprocz = E->parallel.nprocz;
+
+ nprocxl = E->parallel.nprocx;
+ nprocyl = E->parallel.nprocy;
+ nproczl = E->parallel.nprocz;
+
+
+ /* determine the communications in horizontal direction */
+ for(lev=E->mesh.gridmax;lev>=E->mesh.gridmin;lev--) {
+ nox = E->lmesh.NOX[lev];
+ noz = E->lmesh.NOZ[lev];
+ noy = E->lmesh.NOY[lev];
+ ii = 0;
+ kkk = 0;
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+
+ for(i=1;i<=2;i++) { /* do YOZ boundaries & OY lines */
+
+ ii ++;
+ E->parallel.NUM_PASS[lev][m].bound[ii] = 1;
+ if(E->parallel.me_loc[1]==0 && i==1)
+ E->parallel.NUM_PASS[lev][m].bound[ii] = 0;
+ else if(E->parallel.me_loc[1]==nprocxl-1 && i==2)
+ E->parallel.NUM_PASS[lev][m].bound[ii] = 0;
+
+ for (p=1;p<=E->parallel.NUM_PASS[lev][m].bound[ii];p++) {
+ kkk ++;
+ /* determine the pass ID for ii-th boundary and p-th pass */
+
+ E->parallel.sPROCESSOR[lev][m].pass[kkk]=me-((i==1)?1:-1)*nproczl;
+
+ E->parallel.NUM_sNODE[lev][m].pass[kkk] =
+ E->parallel.NUM_NNO[lev][m].bound[ii]/noz;
+ for (k=1;k<=E->parallel.NUM_sNODE[lev][m].pass[kkk];k++) {
+ lnode = k; /* due to lnode increases in horizontal di first */
+ node = (E->parallel.NODE[lev][m][lnode].bound[ii]-1)/noz+1;
+ E->parallel.EXCHANGE_sNODE[lev][m][k].pass[kkk] = node;
+ } /* end for node k */
+
+ } /* end for loop p */
+ } /* end for i */
+
+ ii = 2;
+ for(k=1;k<=2;k++) { /* do XOZ boundaries & OX lines */
+
+ ii ++;
+ E->parallel.NUM_PASS[lev][m].bound[ii] = 1;
+ if(E->parallel.me_loc[2]==0 && k==1)
+ E->parallel.NUM_PASS[lev][m].bound[ii] = 0;
+ else if(E->parallel.me_loc[2]==nprocyl-1 && k==2)
+ E->parallel.NUM_PASS[lev][m].bound[ii] = 0;
+
+ for (p=1;p<=E->parallel.NUM_PASS[lev][m].bound[ii];p++) {
+
+ kkk ++;
+ /* determine the pass ID for ii-th boundary and p-th pass */
+
+ E->parallel.sPROCESSOR[lev][m].pass[kkk]=me-((k==1)?1:-1)*nprocxl*nproczl;
+
+ E->parallel.NUM_sNODE[lev][m].pass[kkk] =
+ E->parallel.NUM_NNO[lev][m].bound[ii]/noz;
+
+ for (kk=1;kk<=E->parallel.NUM_sNODE[lev][m].pass[kkk];kk++) {
+ lnode = kk; /* due to lnode increases in horizontal di first */
+ node = (E->parallel.NODE[lev][m][lnode].bound[ii]-1)/noz+1;
+ E->parallel.EXCHANGE_sNODE[lev][m][kk].pass[kkk] = node;
+ } /* end for node kk */
+
+ } /* end for loop p */
+
+ } /* end for k */
+
+
+ E->parallel.sTNUM_PASS[lev][m] = kkk;
+
+
+ } /* end for m */
+
+ } /* end for lev */
+
+
+ return;
+ }
+
+
+/* ================================================
+WARNING: BUGS AHEAD
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
+
+ sizeofk = (1+E->parallel.NUM_NEQ[lev][m].pass[k])*sizeof(double);
+ S[k]=(double *)malloc( sizeofk );
+ R[k]=(double *)malloc( sizeofk );
+ }
+ }
+
+This piece of code contain a bug. Arrays S and R are allocated for each m.
+But most of the memory is leaked.
+
+In this version of CitcomS, sphere.caps_per_proc is always equal to one.
+So, this bug won't manifest itself. But in other version of CitcomS, it will.
+
+by Tan2 7/21, 2003
+================================================ */
+
+void regional_exchange_id_d(
+ struct All_variables *E,
+ double **U,
+ int lev
+ )
+{
+
+ int ii,j,jj,m,k;
+ double *S[27],*R[27];
+ int sizeofk;
+
+ MPI_Status status;
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
+ sizeofk = (1+E->parallel.NUM_NEQ[lev][m].pass[k])*sizeof(double);
+ S[k]=(double *)malloc( sizeofk );
+ R[k]=(double *)malloc( sizeofk );
+ }
+ }
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
+
+ for (j=1;j<=E->parallel.NUM_NEQ[lev][m].pass[k];j++)
+ S[k][j-1] = U[m][ E->parallel.EXCHANGE_ID[lev][m][j].pass[k] ];
+
+ MPI_Sendrecv(S[k],E->parallel.NUM_NEQ[lev][m].pass[k],MPI_DOUBLE,
+ E->parallel.PROCESSOR[lev][m].pass[k],1,
+ R[k],E->parallel.NUM_NEQ[lev][m].pass[k],MPI_DOUBLE,
+ E->parallel.PROCESSOR[lev][m].pass[k],1,
+ E->parallel.world,&status);
+
+ for (j=1;j<=E->parallel.NUM_NEQ[lev][m].pass[k];j++)
+ U[m][ E->parallel.EXCHANGE_ID[lev][m][j].pass[k] ] += R[k][j-1];
+
+ } /* for k */
+ } /* for m */ /* finish sending */
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
+ free((void*) S[k]);
+ free((void*) R[k]);
+ }
+
+ return;
+ }
+
+
+/* ================================================ */
+/* ================================================ */
+static void exchange_node_d(
+ struct All_variables *E,
+ double **U,
+ int lev
+ )
+ {
+
+ int ii,j,jj,m,k;
+ double *S[27],*R[27];
+ int sizeofk;
+
+ MPI_Status status;
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
+ sizeofk = (1+E->parallel.NUM_NODE[lev][m].pass[k])*sizeof(double);
+ S[k]=(double *)malloc( sizeofk );
+ R[k]=(double *)malloc( sizeofk );
+ } /* end for k */
+ }
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+ for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
+
+ for (j=1;j<=E->parallel.NUM_NODE[lev][m].pass[k];j++)
+ S[k][j-1] = U[m][ E->parallel.EXCHANGE_NODE[lev][m][j].pass[k] ];
+
+ MPI_Sendrecv(S[k],E->parallel.NUM_NODE[lev][m].pass[k],MPI_DOUBLE,
+ E->parallel.PROCESSOR[lev][m].pass[k],1,
+ R[k],E->parallel.NUM_NODE[lev][m].pass[k],MPI_DOUBLE,
+ E->parallel.PROCESSOR[lev][m].pass[k],1,
+ E->parallel.world,&status);
+
+ for (j=1;j<=E->parallel.NUM_NODE[lev][m].pass[k];j++)
+ U[m][ E->parallel.EXCHANGE_NODE[lev][m][j].pass[k] ] += R[k][j-1];
+ }
+ }
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
+ free((void*) S[k]);
+ free((void*) R[k]);
+ }
+
+ return;
+}
+
+/* ================================================ */
+/* ================================================ */
+
+static void exchange_node_f(
+ struct All_variables *E,
+ float **U,
+ int lev
+ )
+{
+
+ int ii,j,jj,m,k;
+ float *S[27],*R[27];
+ int sizeofk;
+
+ MPI_Status status;
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
+ sizeofk = (1+E->parallel.NUM_NODE[lev][m].pass[k])*sizeof(float);
+ S[k]=(float *)malloc( sizeofk );
+ R[k]=(float *)malloc( sizeofk );
+ } /* end for k */
+ }
+
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
+
+ for (j=1;j<=E->parallel.NUM_NODE[lev][m].pass[k];j++)
+ S[k][j-1] = U[m][ E->parallel.EXCHANGE_NODE[lev][m][j].pass[k] ];
+
+ MPI_Sendrecv(S[k],E->parallel.NUM_NODE[lev][m].pass[k],MPI_FLOAT,
+ E->parallel.PROCESSOR[lev][m].pass[k],1,
+ R[k],E->parallel.NUM_NODE[lev][m].pass[k],MPI_FLOAT,
+ E->parallel.PROCESSOR[lev][m].pass[k],1,
+ E->parallel.world,&status);
+
+ for (j=1;j<=E->parallel.NUM_NODE[lev][m].pass[k];j++)
+ U[m][ E->parallel.EXCHANGE_NODE[lev][m][j].pass[k] ] += R[k][j-1];
+ }
+ }
+
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for (k=1;k<=E->parallel.TNUM_PASS[lev][m];k++) {
+ free((void*) S[k]);
+ free((void*) R[k]);
+ }
+
+
+ return;
+ }
+/* ================================================ */
+/* ================================================ */
+
+void regional_exchange_snode_f(struct All_variables *E, float **U1,
+ float **U2, int lev)
+ {
+
+ int ii,j,k,m,kk,t_cap,idb,msginfo[8];
+ float *S[27],*R[27];
+ int sizeofk;
+
+ MPI_Status status;
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ for (k=1;k<=E->parallel.sTNUM_PASS[lev][m];k++) {
+ sizeofk = (1+2*E->parallel.NUM_sNODE[lev][m].pass[k])*sizeof(float);
+ S[k]=(float *)malloc( sizeofk );
+ R[k]=(float *)malloc( sizeofk );
+ }
+ }
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ for (k=1;k<=E->parallel.sTNUM_PASS[lev][m];k++) {
+
+ for (j=1;j<=E->parallel.NUM_sNODE[lev][m].pass[k];j++) {
+ S[k][j-1] = U1[m][ E->parallel.EXCHANGE_sNODE[lev][m][j].pass[k] ];
+ S[k][j-1+E->parallel.NUM_sNODE[lev][m].pass[k]]
+ = U2[m][ E->parallel.EXCHANGE_sNODE[lev][m][j].pass[k] ];
+ }
+
+ MPI_Sendrecv(S[k],2*E->parallel.NUM_sNODE[lev][m].pass[k],MPI_FLOAT,
+ E->parallel.sPROCESSOR[lev][m].pass[k],1,
+ R[k],2*E->parallel.NUM_sNODE[lev][m].pass[k],MPI_FLOAT,
+ E->parallel.sPROCESSOR[lev][m].pass[k],1,
+ E->parallel.world,&status);
+
+ for (j=1;j<=E->parallel.NUM_sNODE[lev][m].pass[k];j++) {
+ U1[m][ E->parallel.EXCHANGE_sNODE[lev][m][j].pass[k] ] += R[k][j-1];
+ U2[m][ E->parallel.EXCHANGE_sNODE[lev][m][j].pass[k] ] +=
+ R[k][j-1+E->parallel.NUM_sNODE[lev][m].pass[k]];
+ }
+
+ }
+ }
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for (k=1;k<=E->parallel.sTNUM_PASS[lev][m];k++) {
+ free((void*) S[k]);
+ free((void*) R[k]);
+ }
+
+ return;
+ }
+
Deleted: mc/3D/CitcomS/branches/cxx/lib/Regional_read_input_from_files.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Regional_read_input_from_files.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Regional_read_input_from_files.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,404 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-#include <math.h>
-#include <sys/types.h>
-#include "element_definitions.h"
-#include "global_defs.h"
-#ifdef USE_GGRD
-#include "ggrd_handling.h"
-#endif
-
-/*=======================================================================
- Calculate ages (MY) for opening input files -> material, ages, velocities
- Open these files, read in results, and average if necessary
-=========================================================================*/
-
-void regional_read_input_files_for_timesteps(E,action,output)
- struct All_variables *E;
- int action, output;
-{
- float find_age_in_MY();
-
- FILE *fp1, *fp2;
- float age, newage1, newage2;
- char output_file1[255],output_file2[255];
- float *TB1, *TB2, *VB1[4],*VB2[4], inputage1, inputage2;
- int nox,noz,noy,nnn,nox1,noz1,noy1;
- int i,ii,ll,mm,j,k,n,nodeg,nodel,node;
- int intage, pos_age;
- int nodea;
- int nn, el;
-
- const int dims=E->mesh.nsd;
-
- int elx,ely,elz,elg,emax;
- float *VIP1,*VIP2;
- int *LL1, *LL2;
-
- int llayer;
- int layers();
-
- /*if( E->parallel.me == 0)
- fprintf(stderr, "\nINSIDE regional_read_input_files_for_timesteps action=%d\n",action); */
-
- nox=E->mesh.nox;
- noy=E->mesh.noy;
- noz=E->mesh.noz;
-
- nox1=E->lmesh.nox;
- noz1=E->lmesh.noz;
- noy1=E->lmesh.noy;
-
-
- elx=E->lmesh.elx;
- elz=E->lmesh.elz;
- ely=E->lmesh.ely;
-
- emax=E->mesh.elx*E->mesh.elz*E->mesh.ely;
-
- age=find_age_in_MY(E);
-
- if (age < 0.0) { /* age is negative -> use age=0 for input
- files */
- intage = 0;
- newage2 = newage1 = 0.0;
- pos_age = 0;
- }
- else {
- intage = age;
- newage1 = 1.0*intage;
- newage2 = 1.0*intage + 1.0;
- pos_age = 1;
- }
-
- switch (action) { /* set up files to open */
- case 1: /* read velocity boundary conditions */
-#ifdef USE_GGRD
- if(!E->control.ggrd.vtop_control){ /* regular input */
-#endif
- sprintf(output_file1,"%s%0.0f",E->control.velocity_boundary_file,newage1);
- sprintf(output_file2,"%s%0.0f",E->control.velocity_boundary_file,newage2);
- fp1=fopen(output_file1,"r");
- if (fp1 == NULL) {
- fprintf(E->fp,"(Problem_related #4) Cannot open %s\n",output_file1);
- exit(8);
- }
- if (pos_age) {
- fp2=fopen(output_file2,"r");
- if (fp2 == NULL) {
- fprintf(E->fp,"(Problem_related #5) Cannot open %s\n",output_file2);
- exit(8);
- }
- }
- if((E->parallel.me==0) && (output==1)) {
- fprintf(E->fp,"Velocity: Starting Age = %g, Elapsed time = %g, Current Age = %g\n",E->control.start_age,E->monitor.elapsed_time,age);
- fprintf(E->fp,"Velocity: File1 = %s\n",output_file1);
- if (pos_age)
- fprintf(E->fp,"Velocity: File2 = %s\n",output_file2);
- else
- fprintf(E->fp,"Velocity: File2 = No file inputted (negative age)\n");
- }
-#ifdef USE_GGRD
- }
-#endif
- break;
-
- case 2: /* read ages for lithosphere temperature assimilation */
-#ifdef USE_GGRD
- if(!E->control.ggrd.age_control){ /* regular input */
-#endif
- sprintf(output_file1,"%s%0.0f",E->control.lith_age_file,newage1);
- sprintf(output_file2,"%s%0.0f",E->control.lith_age_file,newage2);
- fp1=fopen(output_file1,"r");
- if (fp1 == NULL) {
- fprintf(E->fp,"(Problem_related #6) Cannot open %s\n",output_file1);
- exit(8);
- }
- if (pos_age) {
- fp2=fopen(output_file2,"r");
- if (fp2 == NULL) {
- fprintf(E->fp,"(Problem_related #7) Cannot open %s\n",output_file2); exit(8);
- }
- }
- if((E->parallel.me==0) && (output==1)) {
- fprintf(E->fp,"Age: Starting Age = %g, Elapsed time = %g, Current Age = %g\n",E->control.start_age,E->monitor.elapsed_time,age);
- fprintf(E->fp,"Age: File1 = %s\n",output_file1);
- if (pos_age)
- fprintf(E->fp,"Age: File2 = %s\n",output_file2);
- else
- fprintf(E->fp,"Age: File2 = No file inputted (negative age)\n");
- }
-#ifdef USE_GGRD
- }
-#endif
- break;
-
- case 3: /* read element materials */
-#ifdef USE_GGRD
- if(!E->control.ggrd.mat_control){
-#endif
- sprintf(output_file1,"%s%0.0f.0",E->control.mat_file,newage1);
- sprintf(output_file2,"%s%0.0f.0",E->control.mat_file,newage2);
- fp1=fopen(output_file1,"r");
- if (fp1 == NULL) {
- fprintf(E->fp,"(Problem_related #8) Cannot open %s\n",output_file1);
- exit(8);
- }
- if (pos_age) {
- fp2=fopen(output_file2,"r");
- if (fp2 == NULL) {
- fprintf(E->fp,"(Problem_related #9) Cannot open %s\n",output_file2);
- exit(8);
- }
- }
- if((E->parallel.me==0) && (output==1)) {
- fprintf(E->fp,"Mat: Starting Age = %g, Elapsed time = %g, Current Age = %g\n",E->control.start_age,E->monitor.elapsed_time,age);
- fprintf(E->fp,"Mat: File1 = %s\n",output_file1);
- if (pos_age)
- fprintf(E->fp,"Mat: File2 = %s\n",output_file2);
- else
- fprintf(E->fp,"Mat: File2 = No file inputted (negative age)\n");
- }
-
-#ifdef USE_GGRD
- }
-#endif
- break;
-
- /* mode 4 is rayleigh control for GGRD, see below */
-
- case 5: /* read temperature boundary conditions, top surface */
- sprintf(output_file1,"%s%0.0f",E->control.temperature_boundary_file,newage1);
- sprintf(output_file2,"%s%0.0f",E->control.temperature_boundary_file,newage2);
- fp1=fopen(output_file1,"r");
- if (fp1 == NULL) {
- fprintf(E->fp,"(Problem_related #10) Cannot open %s\n",output_file1);
- exit(8);
- }
- if (pos_age) {
- fp2=fopen(output_file2,"r");
- if (fp2 == NULL) {
- fprintf(E->fp,"(Problem_related #11) Cannot open %s\n",output_file2);
- exit(8);
- }
- }
- if((E->parallel.me==0) && (output==1)) {
- fprintf(E->fp,"Surface Temperature: Starting Age = %g, Elapsed time = %g, Current Age = %g\n",E->control.start_age,E->monitor.elapsed_time,age);
- fprintf(E->fp,"Surface Temperature: File1 = %s\n",output_file1);
- if (pos_age)
- fprintf(E->fp,"Surface Temperature: File2 = %s\n",output_file2);
- else
- fprintf(E->fp,"Surface Temperature: File2 = No file inputted (negative age)\n");
- }
- break;
-
-
-
- } /* end switch */
-
-
-
- switch (action) { /* Read the contents of files and average */
-
- case 1: /* velocity boundary conditions */
-#ifdef USE_GGRD
- if(E->control.ggrd.vtop_control){
- ggrd_read_vtop_from_file(E, 0);
- }else{
-#endif
- nnn=nox*noy;
- for(i=1;i<=dims;i++) {
- VB1[i]=(float*) malloc ((nnn+1)*sizeof(float));
- VB2[i]=(float*) malloc ((nnn+1)*sizeof(float));
- }
- for(i=1;i<=nnn;i++) {
- fscanf(fp1,"%f %f",&(VB1[1][i]),&(VB1[2][i]));
- VB1[1][i]=E->data.timedir*VB1[1][i];
- VB1[2][i]=E->data.timedir*VB1[2][i];
- if (pos_age) {
- fscanf(fp2,"%f %f",&(VB2[1][i]),&(VB2[2][i]));
- VB2[1][i]=E->data.timedir*VB2[1][i];
- VB2[2][i]=E->data.timedir*VB2[2][i];
- }
- }
- fclose(fp1);
- if (pos_age) fclose(fp2);
-
- if(E->parallel.me_loc[3]==E->parallel.nprocz-1 ) {
- for(k=1;k<=noy1;k++)
- for(i=1;i<=nox1;i++) {
- nodeg = E->lmesh.nxs+i-1 + (E->lmesh.nys+k-2)*nox;
- nodel = (k-1)*nox1*noz1 + (i-1)*noz1+noz1;
- if (pos_age) { /* positive ages - we must interpolate */
- E->sphere.cap[1].VB[1][nodel] = (VB1[1][nodeg] + (VB2[1][nodeg]-VB1[1][nodeg])/(newage2-newage1)*(age-newage1))*E->data.scalev;
- E->sphere.cap[1].VB[2][nodel] = (VB1[2][nodeg] + (VB2[2][nodeg]-VB1[2][nodeg])/(newage2-newage1)*(age-newage1))*E->data.scalev;
- E->sphere.cap[1].VB[3][nodel] = 0.0;
- }
- else { /* negative ages - don't do the interpolation */
- E->sphere.cap[1].VB[1][nodel] = VB1[1][nodeg]*E->data.scalev;
- E->sphere.cap[1].VB[2][nodel] = VB1[2][nodeg]*E->data.scalev;
- E->sphere.cap[1].VB[3][nodel] = 0.0;
- }
- }
- } /* end of E->parallel.me_loc[3]==E->parallel.nprocz-1 */
- for(i=1;i<=dims;i++) {
- free ((void *) VB1[i]);
- free ((void *) VB2[i]);
- }
-
-
-#ifdef USE_GGRD
- } /* end of branch if allowing for ggrd handling */
-#endif
- break;
-
- case 2: /* ages for lithosphere temperature assimilation */
-#ifdef USE_GGRD
- if(E->control.ggrd.age_control){
- ggrd_read_age_from_file(E, 0);
- }else{
-#endif
- for(i=1;i<=noy;i++)
- for(j=1;j<=nox;j++) {
- node=j+(i-1)*nox;
- fscanf(fp1,"%f",&inputage1);
- if (pos_age) { /* positive ages - we must interpolate */
- fscanf(fp2,"%f",&inputage2);
- E->age_t[node] = (inputage1 + (inputage2-inputage1)/(newage2-newage1)*(age-newage1))/E->data.scalet;
- }
- else { /* negative ages - don't do the interpolation */
- E->age_t[node] = inputage1;
- }
- }
- fclose(fp1);
- if (pos_age) fclose(fp2);
-#ifdef USE_GGRD
- } /* end of branch if allowing for ggrd handling */
-#endif
- break;
-
- case 3: /* read element materials */
-#ifdef USE_GGRD
- if(E->control.ggrd.mat_control){
- ggrd_read_mat_from_file(E, 0);
- }else{
-#endif
-
- VIP1 = (float*) malloc ((emax+1)*sizeof(float));
- VIP2 = (float*) malloc ((emax+1)*sizeof(float));
- LL1 = (int*) malloc ((emax+1)*sizeof(int));
- LL2 = (int*) malloc ((emax+1)*sizeof(int));
-
- for (el=1; el<=elx*ely*elz; el++) {
- nodea = E->ien[1][el].node[2];
- llayer = layers(E,1,nodea);
- if (llayer) { /* for layers:1-lithosphere,2-upper, 3-trans, and 4-lower mantle */
- E->mat[1][el] = llayer;
- }
- }
- for(i=1;i<=emax;i++) {
- fscanf(fp1,"%d %d %f", &nn,&(LL1[i]),&(VIP1[i]));
- fscanf(fp2,"%d %d %f", &nn,&(LL2[i]),&(VIP2[i]));
- }
-
- fclose(fp1);
- fclose(fp2);
-
- for (k=1;k<=ely;k++) {
- for (i=1;i<=elx;i++) {
- for (j=1;j<=elz;j++) {
- el = j + (i-1)*E->lmesh.elz + (k-1)*E->lmesh.elz*E->lmesh.elx;
- elg = E->lmesh.ezs+j + (E->lmesh.exs+i-1)*E->mesh.elz + (E->lmesh.eys+k-1)*E->mesh.elz*E->mesh.elx;
-
- E->VIP[1][el] = VIP1[elg]+(VIP2[elg]-VIP1[elg])/(newage2-newage1)*(age-newage1);
- /* E->mat[1][el] = LL1[elg]; */ /*use the mat numbers base on radius*/
-
- } /* end for j */
- } /* end for i */
- } /* end for k */
-
- free ((void *) VIP1);
- free ((void *) VIP2);
- free ((void *) LL1);
- free ((void *) LL2);
-#ifdef USE_GGRD
- } /* end of branch if allowing for ggrd handling */
-#endif
- break;
- case 4: /* material control */
-#ifdef USE_GGRD
- if(E->control.ggrd.ray_control)
- ggrd_read_ray_from_file(E, 0);
-#else
- myerror(E,"input_from_files: mode 4 only for GGRD");
-#endif
- break;
-
- case 5: /* read temperature boundary conditions, top surface */
- nnn=nox*noy;
- TB1=(float*) malloc ((nnn+1)*sizeof(float));
- TB2=(float*) malloc ((nnn+1)*sizeof(float));
-
- for(i=1;i<=nnn;i++) {
- fscanf(fp1,"%f",&(TB1[i]));
- /* if( E->parallel.me == 0)
- fprintf(stderr, "\nINSIDE regional_read_input_files_for_timesteps TB1=%f %d\n",TB1[i],i); */
- if (pos_age) {
- fscanf(fp2,"%f",&(TB2[i]));
- }
- }
- fclose(fp1);
- if (pos_age) fclose(fp2);
-
- if(E->parallel.me_loc[3]==E->parallel.nprocz-1 ) {
- for(k=1;k<=noy1;k++)
- for(i=1;i<=nox1;i++) {
- nodeg = E->lmesh.nxs+i-1 + (E->lmesh.nys+k-2)*nox;
- nodel = (k-1)*nox1*noz1 + (i-1)*noz1+noz1;
- if (pos_age) { /* positive ages - we must interpolate */
- E->sphere.cap[1].TB[1][nodel] = (TB1[nodeg] + (TB2[nodeg]-TB1[nodeg])/(newage2-newage1)*(age-newage1));
- E->sphere.cap[1].TB[2][nodel] = (TB1[nodeg] + (TB2[nodeg]-TB1[nodeg])/(newage2-newage1)*(age-newage1));
- E->sphere.cap[1].TB[3][nodel] = (TB1[nodeg] + (TB2[nodeg]-TB1[nodeg])/(newage2-newage1)*(age-newage1));
- }
- else { /* negative ages - don't do the interpolation */
- E->sphere.cap[1].TB[1][nodel] = TB1[nodeg];
- E->sphere.cap[1].TB[2][nodel] = TB1[nodeg];
- E->sphere.cap[1].TB[3][nodel] = TB1[nodeg];
- }
- }
- } /* end of E->parallel.me_loc[3]==E->parallel.nprocz-1 */
- free ((void *) TB1);
- free ((void *) TB2);
-
- break;
-
-
- } /* end switch */
-
- return;
-}
Copied: mc/3D/CitcomS/branches/cxx/lib/Regional_read_input_from_files.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Regional_read_input_from_files.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Regional_read_input_from_files.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Regional_read_input_from_files.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,404 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+#include <math.h>
+#include <sys/types.h>
+#include "element_definitions.h"
+#include "global_defs.h"
+#ifdef USE_GGRD
+#include "ggrd_handling.h"
+#endif
+
+#include "cproto.h"
+
+/*=======================================================================
+ Calculate ages (MY) for opening input files -> material, ages, velocities
+ Open these files, read in results, and average if necessary
+=========================================================================*/
+
+void regional_read_input_files_for_timesteps(
+ struct All_variables *E,
+ int action, int output
+ )
+{
+ FILE *fp1, *fp2;
+ float age, newage1, newage2;
+ char output_file1[255],output_file2[255];
+ float *TB1, *TB2, *VB1[4],*VB2[4], inputage1, inputage2;
+ int nox,noz,noy,nnn,nox1,noz1,noy1;
+ int i,ii,ll,mm,j,k,n,nodeg,nodel,node;
+ int intage, pos_age;
+ int nodea;
+ int nn, el;
+
+ const int dims=E->mesh.nsd;
+
+ int elx,ely,elz,elg,emax;
+ float *VIP1,*VIP2;
+ int *LL1, *LL2;
+
+ int llayer;
+
+ /*if( E->parallel.me == 0)
+ fprintf(stderr, "\nINSIDE regional_read_input_files_for_timesteps action=%d\n",action); */
+
+ nox=E->mesh.nox;
+ noy=E->mesh.noy;
+ noz=E->mesh.noz;
+
+ nox1=E->lmesh.nox;
+ noz1=E->lmesh.noz;
+ noy1=E->lmesh.noy;
+
+
+ elx=E->lmesh.elx;
+ elz=E->lmesh.elz;
+ ely=E->lmesh.ely;
+
+ emax=E->mesh.elx*E->mesh.elz*E->mesh.ely;
+
+ age=find_age_in_MY(E);
+
+ if (age < 0.0) { /* age is negative -> use age=0 for input
+ files */
+ intage = 0;
+ newage2 = newage1 = 0.0;
+ pos_age = 0;
+ }
+ else {
+ intage = (int)age;
+ newage1 = 1.0*intage;
+ newage2 = 1.0*intage + 1.0;
+ pos_age = 1;
+ }
+
+ switch (action) { /* set up files to open */
+ case 1: /* read velocity boundary conditions */
+#ifdef USE_GGRD
+ if(!E->control.ggrd.vtop_control){ /* regular input */
+#endif
+ sprintf(output_file1,"%s%0.0f",E->control.velocity_boundary_file,newage1);
+ sprintf(output_file2,"%s%0.0f",E->control.velocity_boundary_file,newage2);
+ fp1=fopen(output_file1,"r");
+ if (fp1 == NULL) {
+ fprintf(E->fp,"(Problem_related #4) Cannot open %s\n",output_file1);
+ exit(8);
+ }
+ if (pos_age) {
+ fp2=fopen(output_file2,"r");
+ if (fp2 == NULL) {
+ fprintf(E->fp,"(Problem_related #5) Cannot open %s\n",output_file2);
+ exit(8);
+ }
+ }
+ if((E->parallel.me==0) && (output==1)) {
+ fprintf(E->fp,"Velocity: Starting Age = %g, Elapsed time = %g, Current Age = %g\n",E->control.start_age,E->monitor.elapsed_time,age);
+ fprintf(E->fp,"Velocity: File1 = %s\n",output_file1);
+ if (pos_age)
+ fprintf(E->fp,"Velocity: File2 = %s\n",output_file2);
+ else
+ fprintf(E->fp,"Velocity: File2 = No file inputted (negative age)\n");
+ }
+#ifdef USE_GGRD
+ }
+#endif
+ break;
+
+ case 2: /* read ages for lithosphere temperature assimilation */
+#ifdef USE_GGRD
+ if(!E->control.ggrd.age_control){ /* regular input */
+#endif
+ sprintf(output_file1,"%s%0.0f",E->control.lith_age_file,newage1);
+ sprintf(output_file2,"%s%0.0f",E->control.lith_age_file,newage2);
+ fp1=fopen(output_file1,"r");
+ if (fp1 == NULL) {
+ fprintf(E->fp,"(Problem_related #6) Cannot open %s\n",output_file1);
+ exit(8);
+ }
+ if (pos_age) {
+ fp2=fopen(output_file2,"r");
+ if (fp2 == NULL) {
+ fprintf(E->fp,"(Problem_related #7) Cannot open %s\n",output_file2); exit(8);
+ }
+ }
+ if((E->parallel.me==0) && (output==1)) {
+ fprintf(E->fp,"Age: Starting Age = %g, Elapsed time = %g, Current Age = %g\n",E->control.start_age,E->monitor.elapsed_time,age);
+ fprintf(E->fp,"Age: File1 = %s\n",output_file1);
+ if (pos_age)
+ fprintf(E->fp,"Age: File2 = %s\n",output_file2);
+ else
+ fprintf(E->fp,"Age: File2 = No file inputted (negative age)\n");
+ }
+#ifdef USE_GGRD
+ }
+#endif
+ break;
+
+ case 3: /* read element materials */
+#ifdef USE_GGRD
+ if(!E->control.ggrd.mat_control){
+#endif
+ sprintf(output_file1,"%s%0.0f.0",E->control.mat_file,newage1);
+ sprintf(output_file2,"%s%0.0f.0",E->control.mat_file,newage2);
+ fp1=fopen(output_file1,"r");
+ if (fp1 == NULL) {
+ fprintf(E->fp,"(Problem_related #8) Cannot open %s\n",output_file1);
+ exit(8);
+ }
+ if (pos_age) {
+ fp2=fopen(output_file2,"r");
+ if (fp2 == NULL) {
+ fprintf(E->fp,"(Problem_related #9) Cannot open %s\n",output_file2);
+ exit(8);
+ }
+ }
+ if((E->parallel.me==0) && (output==1)) {
+ fprintf(E->fp,"Mat: Starting Age = %g, Elapsed time = %g, Current Age = %g\n",E->control.start_age,E->monitor.elapsed_time,age);
+ fprintf(E->fp,"Mat: File1 = %s\n",output_file1);
+ if (pos_age)
+ fprintf(E->fp,"Mat: File2 = %s\n",output_file2);
+ else
+ fprintf(E->fp,"Mat: File2 = No file inputted (negative age)\n");
+ }
+
+#ifdef USE_GGRD
+ }
+#endif
+ break;
+
+ /* mode 4 is rayleigh control for GGRD, see below */
+
+ case 5: /* read temperature boundary conditions, top surface */
+ sprintf(output_file1,"%s%0.0f",E->control.temperature_boundary_file,newage1);
+ sprintf(output_file2,"%s%0.0f",E->control.temperature_boundary_file,newage2);
+ fp1=fopen(output_file1,"r");
+ if (fp1 == NULL) {
+ fprintf(E->fp,"(Problem_related #10) Cannot open %s\n",output_file1);
+ exit(8);
+ }
+ if (pos_age) {
+ fp2=fopen(output_file2,"r");
+ if (fp2 == NULL) {
+ fprintf(E->fp,"(Problem_related #11) Cannot open %s\n",output_file2);
+ exit(8);
+ }
+ }
+ if((E->parallel.me==0) && (output==1)) {
+ fprintf(E->fp,"Surface Temperature: Starting Age = %g, Elapsed time = %g, Current Age = %g\n",E->control.start_age,E->monitor.elapsed_time,age);
+ fprintf(E->fp,"Surface Temperature: File1 = %s\n",output_file1);
+ if (pos_age)
+ fprintf(E->fp,"Surface Temperature: File2 = %s\n",output_file2);
+ else
+ fprintf(E->fp,"Surface Temperature: File2 = No file inputted (negative age)\n");
+ }
+ break;
+
+
+
+ } /* end switch */
+
+
+
+ switch (action) { /* Read the contents of files and average */
+
+ case 1: /* velocity boundary conditions */
+#ifdef USE_GGRD
+ if(E->control.ggrd.vtop_control){
+ ggrd_read_vtop_from_file(E, 0);
+ }else{
+#endif
+ nnn=nox*noy;
+ for(i=1;i<=dims;i++) {
+ VB1[i]=(float*) malloc ((nnn+1)*sizeof(float));
+ VB2[i]=(float*) malloc ((nnn+1)*sizeof(float));
+ }
+ for(i=1;i<=nnn;i++) {
+ fscanf(fp1,"%f %f",&(VB1[1][i]),&(VB1[2][i]));
+ VB1[1][i]=E->data.timedir*VB1[1][i];
+ VB1[2][i]=E->data.timedir*VB1[2][i];
+ if (pos_age) {
+ fscanf(fp2,"%f %f",&(VB2[1][i]),&(VB2[2][i]));
+ VB2[1][i]=E->data.timedir*VB2[1][i];
+ VB2[2][i]=E->data.timedir*VB2[2][i];
+ }
+ }
+ fclose(fp1);
+ if (pos_age) fclose(fp2);
+
+ if(E->parallel.me_loc[3]==E->parallel.nprocz-1 ) {
+ for(k=1;k<=noy1;k++)
+ for(i=1;i<=nox1;i++) {
+ nodeg = E->lmesh.nxs+i-1 + (E->lmesh.nys+k-2)*nox;
+ nodel = (k-1)*nox1*noz1 + (i-1)*noz1+noz1;
+ if (pos_age) { /* positive ages - we must interpolate */
+ E->sphere.cap[1].VB[1][nodel] = (VB1[1][nodeg] + (VB2[1][nodeg]-VB1[1][nodeg])/(newage2-newage1)*(age-newage1))*E->data.scalev;
+ E->sphere.cap[1].VB[2][nodel] = (VB1[2][nodeg] + (VB2[2][nodeg]-VB1[2][nodeg])/(newage2-newage1)*(age-newage1))*E->data.scalev;
+ E->sphere.cap[1].VB[3][nodel] = 0.0;
+ }
+ else { /* negative ages - don't do the interpolation */
+ E->sphere.cap[1].VB[1][nodel] = VB1[1][nodeg]*E->data.scalev;
+ E->sphere.cap[1].VB[2][nodel] = VB1[2][nodeg]*E->data.scalev;
+ E->sphere.cap[1].VB[3][nodel] = 0.0;
+ }
+ }
+ } /* end of E->parallel.me_loc[3]==E->parallel.nprocz-1 */
+ for(i=1;i<=dims;i++) {
+ free ((void *) VB1[i]);
+ free ((void *) VB2[i]);
+ }
+
+
+#ifdef USE_GGRD
+ } /* end of branch if allowing for ggrd handling */
+#endif
+ break;
+
+ case 2: /* ages for lithosphere temperature assimilation */
+#ifdef USE_GGRD
+ if(E->control.ggrd.age_control){
+ ggrd_read_age_from_file(E, 0);
+ }else{
+#endif
+ for(i=1;i<=noy;i++)
+ for(j=1;j<=nox;j++) {
+ node=j+(i-1)*nox;
+ fscanf(fp1,"%f",&inputage1);
+ if (pos_age) { /* positive ages - we must interpolate */
+ fscanf(fp2,"%f",&inputage2);
+ E->age_t[node] = (inputage1 + (inputage2-inputage1)/(newage2-newage1)*(age-newage1))/E->data.scalet;
+ }
+ else { /* negative ages - don't do the interpolation */
+ E->age_t[node] = inputage1;
+ }
+ }
+ fclose(fp1);
+ if (pos_age) fclose(fp2);
+#ifdef USE_GGRD
+ } /* end of branch if allowing for ggrd handling */
+#endif
+ break;
+
+ case 3: /* read element materials */
+#ifdef USE_GGRD
+ if(E->control.ggrd.mat_control){
+ ggrd_read_mat_from_file(E, 0);
+ }else{
+#endif
+
+ VIP1 = (float*) malloc ((emax+1)*sizeof(float));
+ VIP2 = (float*) malloc ((emax+1)*sizeof(float));
+ LL1 = (int*) malloc ((emax+1)*sizeof(int));
+ LL2 = (int*) malloc ((emax+1)*sizeof(int));
+
+ for (el=1; el<=elx*ely*elz; el++) {
+ nodea = E->ien[1][el].node[2];
+ llayer = layers(E,1,nodea);
+ if (llayer) { /* for layers:1-lithosphere,2-upper, 3-trans, and 4-lower mantle */
+ E->mat[1][el] = llayer;
+ }
+ }
+ for(i=1;i<=emax;i++) {
+ fscanf(fp1,"%d %d %f", &nn,&(LL1[i]),&(VIP1[i]));
+ fscanf(fp2,"%d %d %f", &nn,&(LL2[i]),&(VIP2[i]));
+ }
+
+ fclose(fp1);
+ fclose(fp2);
+
+ for (k=1;k<=ely;k++) {
+ for (i=1;i<=elx;i++) {
+ for (j=1;j<=elz;j++) {
+ el = j + (i-1)*E->lmesh.elz + (k-1)*E->lmesh.elz*E->lmesh.elx;
+ elg = E->lmesh.ezs+j + (E->lmesh.exs+i-1)*E->mesh.elz + (E->lmesh.eys+k-1)*E->mesh.elz*E->mesh.elx;
+
+ E->VIP[1][el] = VIP1[elg]+(VIP2[elg]-VIP1[elg])/(newage2-newage1)*(age-newage1);
+ /* E->mat[1][el] = LL1[elg]; */ /*use the mat numbers base on radius*/
+
+ } /* end for j */
+ } /* end for i */
+ } /* end for k */
+
+ free ((void *) VIP1);
+ free ((void *) VIP2);
+ free ((void *) LL1);
+ free ((void *) LL2);
+#ifdef USE_GGRD
+ } /* end of branch if allowing for ggrd handling */
+#endif
+ break;
+ case 4: /* material control */
+#ifdef USE_GGRD
+ if(E->control.ggrd.ray_control)
+ ggrd_read_ray_from_file(E, 0);
+#else
+ myerror(E,"input_from_files: mode 4 only for GGRD");
+#endif
+ break;
+
+ case 5: /* read temperature boundary conditions, top surface */
+ nnn=nox*noy;
+ TB1=(float*) malloc ((nnn+1)*sizeof(float));
+ TB2=(float*) malloc ((nnn+1)*sizeof(float));
+
+ for(i=1;i<=nnn;i++) {
+ fscanf(fp1,"%f",&(TB1[i]));
+ /* if( E->parallel.me == 0)
+ fprintf(stderr, "\nINSIDE regional_read_input_files_for_timesteps TB1=%f %d\n",TB1[i],i); */
+ if (pos_age) {
+ fscanf(fp2,"%f",&(TB2[i]));
+ }
+ }
+ fclose(fp1);
+ if (pos_age) fclose(fp2);
+
+ if(E->parallel.me_loc[3]==E->parallel.nprocz-1 ) {
+ for(k=1;k<=noy1;k++)
+ for(i=1;i<=nox1;i++) {
+ nodeg = E->lmesh.nxs+i-1 + (E->lmesh.nys+k-2)*nox;
+ nodel = (k-1)*nox1*noz1 + (i-1)*noz1+noz1;
+ if (pos_age) { /* positive ages - we must interpolate */
+ E->sphere.cap[1].TB[1][nodel] = (TB1[nodeg] + (TB2[nodeg]-TB1[nodeg])/(newage2-newage1)*(age-newage1));
+ E->sphere.cap[1].TB[2][nodel] = (TB1[nodeg] + (TB2[nodeg]-TB1[nodeg])/(newage2-newage1)*(age-newage1));
+ E->sphere.cap[1].TB[3][nodel] = (TB1[nodeg] + (TB2[nodeg]-TB1[nodeg])/(newage2-newage1)*(age-newage1));
+ }
+ else { /* negative ages - don't do the interpolation */
+ E->sphere.cap[1].TB[1][nodel] = TB1[nodeg];
+ E->sphere.cap[1].TB[2][nodel] = TB1[nodeg];
+ E->sphere.cap[1].TB[3][nodel] = TB1[nodeg];
+ }
+ }
+ } /* end of E->parallel.me_loc[3]==E->parallel.nprocz-1 */
+ free ((void *) TB1);
+ free ((void *) TB2);
+
+ break;
+
+
+ } /* end switch */
+
+ return;
+}
Deleted: mc/3D/CitcomS/branches/cxx/lib/Regional_solver.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Regional_solver.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Regional_solver.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,96 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-
-
-#include "global_defs.h"
-
-
-/* Boundary_conditions.c */
-void regional_velocity_boundary_conditions(struct All_variables *);
-void regional_temperature_boundary_conditions(struct All_variables *);
-
-/* Geometry_cartesian.c */
-void regional_set_2dc_defaults(struct All_variables *);
-void regional_set_2pt5dc_defaults(struct All_variables *);
-void regional_set_3dc_defaults(struct All_variables *);
-void regional_set_3dsphere_defaults(struct All_variables *);
-
-/* Lith_age.c */
-void regional_lith_age_read_files(struct All_variables *, int);
-
-/* Parallel_related.c */
-void regional_parallel_processor_setup(struct All_variables *);
-void regional_parallel_domain_decomp0(struct All_variables *);
-void regional_parallel_domain_boundary_nodes(struct All_variables *);
-void regional_parallel_communication_routs_v(struct All_variables *);
-void regional_parallel_communication_routs_s(struct All_variables *);
-void regional_exchange_id_d(struct All_variables *, double **, int);
-
-/* Read_input_from_files.c */
-void regional_read_input_files_for_timesteps(struct All_variables *, int, int);
-
-/* Version_dependent.c */
-void regional_node_locations(struct All_variables *);
-void regional_construct_boundary(struct All_variables *);
-
-
-void regional_solver_init(struct All_variables *E)
-{
- /* Boundary_conditions.c */
- E->solver.velocity_boundary_conditions = regional_velocity_boundary_conditions;
- E->solver.temperature_boundary_conditions = regional_temperature_boundary_conditions;
-
- /* Geometry_cartesian.c */
- E->solver.set_2dc_defaults = regional_set_2dc_defaults;
- E->solver.set_2pt5dc_defaults = regional_set_2pt5dc_defaults;
- E->solver.set_3dc_defaults = regional_set_3dc_defaults;
- E->solver.set_3dsphere_defaults = regional_set_3dsphere_defaults;
-
- /* Lith_age.c */
- E->solver.lith_age_read_files = regional_lith_age_read_files;
-
- /* Parallel_related.c */
- E->solver.parallel_processor_setup = regional_parallel_processor_setup;
- E->solver.parallel_domain_decomp0 = regional_parallel_domain_decomp0;
- E->solver.parallel_domain_boundary_nodes = regional_parallel_domain_boundary_nodes;
- E->solver.parallel_communication_routs_v = regional_parallel_communication_routs_v;
- E->solver.parallel_communication_routs_s = regional_parallel_communication_routs_s;
- E->solver.exchange_id_d = regional_exchange_id_d;
-
- /* Read_input_from_files.c */
- E->solver.read_input_files_for_timesteps = regional_read_input_files_for_timesteps;
-
- /* Version_dependent.c */
- E->solver.node_locations = regional_node_locations;
- E->solver.construct_boundary = regional_construct_boundary;
-
- return;
-}
-
-
-/* End of file */
Copied: mc/3D/CitcomS/branches/cxx/lib/Regional_solver.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Regional_solver.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Regional_solver.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Regional_solver.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,96 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+
+
+#include "global_defs.h"
+
+
+/* Boundary_conditions.c */
+void regional_velocity_boundary_conditions(struct All_variables *);
+void regional_temperature_boundary_conditions(struct All_variables *);
+
+/* Geometry_cartesian.c */
+void regional_set_2dc_defaults(struct All_variables *);
+void regional_set_2pt5dc_defaults(struct All_variables *);
+void regional_set_3dc_defaults(struct All_variables *);
+void regional_set_3dsphere_defaults(struct All_variables *);
+
+/* Lith_age.c */
+void regional_lith_age_read_files(struct All_variables *, int);
+
+/* Parallel_related.c */
+void regional_parallel_processor_setup(struct All_variables *);
+void regional_parallel_domain_decomp0(struct All_variables *);
+void regional_parallel_domain_boundary_nodes(struct All_variables *);
+void regional_parallel_communication_routs_v(struct All_variables *);
+void regional_parallel_communication_routs_s(struct All_variables *);
+void regional_exchange_id_d(struct All_variables *, double **, int);
+
+/* Read_input_from_files.c */
+void regional_read_input_files_for_timesteps(struct All_variables *, int, int);
+
+/* Version_dependent.c */
+void regional_node_locations(struct All_variables *);
+void regional_construct_boundary(struct All_variables *);
+
+
+void regional_solver_init(struct All_variables *E)
+{
+ /* Boundary_conditions.c */
+ E->solver.velocity_boundary_conditions = regional_velocity_boundary_conditions;
+ E->solver.temperature_boundary_conditions = regional_temperature_boundary_conditions;
+
+ /* Geometry_cartesian.c */
+ E->solver.set_2dc_defaults = regional_set_2dc_defaults;
+ E->solver.set_2pt5dc_defaults = regional_set_2pt5dc_defaults;
+ E->solver.set_3dc_defaults = regional_set_3dc_defaults;
+ E->solver.set_3dsphere_defaults = regional_set_3dsphere_defaults;
+
+ /* Lith_age.c */
+ E->solver.lith_age_read_files = regional_lith_age_read_files;
+
+ /* Parallel_related.c */
+ E->solver.parallel_processor_setup = regional_parallel_processor_setup;
+ E->solver.parallel_domain_decomp0 = regional_parallel_domain_decomp0;
+ E->solver.parallel_domain_boundary_nodes = regional_parallel_domain_boundary_nodes;
+ E->solver.parallel_communication_routs_v = regional_parallel_communication_routs_v;
+ E->solver.parallel_communication_routs_s = regional_parallel_communication_routs_s;
+ E->solver.exchange_id_d = regional_exchange_id_d;
+
+ /* Read_input_from_files.c */
+ E->solver.read_input_files_for_timesteps = regional_read_input_files_for_timesteps;
+
+ /* Version_dependent.c */
+ E->solver.node_locations = regional_node_locations;
+ E->solver.construct_boundary = regional_construct_boundary;
+
+ return;
+}
+
+
+/* End of file */
Deleted: mc/3D/CitcomS/branches/cxx/lib/Regional_sphere_related.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Regional_sphere_related.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Regional_sphere_related.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,254 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-/* Functions relating to the building and use of mesh locations ... */
-
-#include <math.h>
-#include <sys/types.h>
-#include "element_definitions.h"
-#include "global_defs.h"
-
-void regional_coord_of_cap(E,m,icap)
- struct All_variables *E;
- int icap,m;
- {
-
- int i,j,k,lev,temp,elx,ely,nox,noy,noz,node,nodes;
- int nprocxl,nprocyl,nproczl;
- int nnproc;
- int gnox,gnoy,gnoz;
- int nodesx,nodesy;
- char output_file[255];
- char a[100];
- int nn,step;
- FILE *fp;
- float *theta1[MAX_LEVELS],*fi1[MAX_LEVELS];
- double *SX[2];
- double *tt,*ff;
- double dt,df;
- double myatan();
- void parallel_process_termination();
- void myerror();
-
- void even_divide_arc12();
-
- m=1;
-
- gnox=E->mesh.nox;
- gnoy=E->mesh.noy;
- gnoz=E->mesh.noz;
- nox=E->lmesh.nox;
- noy=E->lmesh.noy;
- noz=E->lmesh.noz;
-
- nprocxl=E->parallel.nprocx;
- nprocyl=E->parallel.nprocy;
- nproczl=E->parallel.nprocz;
- nnproc=nprocyl*nprocxl*nproczl;
- temp = max(E->mesh.NOY[E->mesh.levmax],E->mesh.NOX[E->mesh.levmax]);
-
-
- if(E->control.coor==1) {
-
- /* read in node locations from file */
-
- for(i=E->mesh.gridmin;i<=E->mesh.gridmax;i++) {
- theta1[i] = (float *)malloc((temp+1)*sizeof(float));
- fi1[i] = (float *)malloc((temp+1)*sizeof(float));
- }
-
- temp = E->mesh.NOY[E->mesh.levmax]*E->mesh.NOX[E->mesh.levmax];
-
- sprintf(output_file,"%s",E->control.coor_file);
- fp=fopen(output_file,"r");
- if (fp == NULL) {
- fprintf(E->fp,"(Sphere_related #1) Cannot open %s\n",output_file);
- exit(8);
- }
-
- fscanf(fp,"%s %d",a,&nn);
- for(i=1;i<=gnox;i++) {
- fscanf(fp,"%d %e",&nn,&theta1[E->mesh.gridmax][i]);
- }
- E->control.theta_min = theta1[E->mesh.gridmax][1];
- E->control.theta_max = theta1[E->mesh.gridmax][gnox];
-
- fscanf(fp,"%s %d",a,&nn);
- for(i=1;i<=gnoy;i++) {
- fscanf(fp,"%d %e",&nn,&fi1[E->mesh.gridmax][i]);
- }
- E->control.fi_min = fi1[E->mesh.gridmax][1];
- E->control.fi_max = fi1[E->mesh.gridmax][gnoy];
-
- fclose(fp);
-
-
- for (lev=E->mesh.gridmin;lev<=E->mesh.gridmax;lev++) {
-
- if (E->control.NMULTIGRID||E->control.EMULTIGRID)
- step = (int) pow(2.0,(double)(E->mesh.levmax-lev));
- else
- step = 1;
-
- for (i=1;i<=E->mesh.NOX[lev];i++)
- theta1[lev][i] = theta1[E->mesh.gridmax][(i-1)*step+1];
-
- for (i=1;i<=E->mesh.NOY[lev];i++)
- fi1[lev][i] = fi1[E->mesh.gridmax][(i-1)*step+1];
-
- }
-
-
- for (lev=E->mesh.gridmin;lev<=E->mesh.gridmax;lev++) {
- elx = E->lmesh.ELX[lev];
- ely = E->lmesh.ELY[lev];
- nox = E->lmesh.NOX[lev];
- noy = E->lmesh.NOY[lev];
- noz = E->lmesh.NOZ[lev];
- /* evenly divide arc linking 1 and 2, and the arc linking 4 and 3 */
-
- /* get the coordinates for the entire cap */
-
- for (j=1;j<=nox;j++)
- for (k=1;k<=noy;k++) {
- nodesx = E->lmesh.NXS[lev]+j-1;
- nodesy = E->lmesh.NYS[lev]+k-1;
-
- for (i=1;i<=noz;i++) {
- node = i + (j-1)*noz + (k-1)*nox*noz;
-
- /* theta,fi,and r coordinates */
- E->SX[lev][m][1][node] = theta1[lev][nodesx];
- E->SX[lev][m][2][node] = fi1[lev][nodesy];
- E->SX[lev][m][3][node] = E->sphere.R[lev][i];
-
- /* x,y,and z oordinates */
- E->X[lev][m][1][node] =
- E->sphere.R[lev][i]*sin(theta1[lev][nodesx])*cos(fi1[lev][nodesy]);
- E->X[lev][m][2][node] =
- E->sphere.R[lev][i]*sin(theta1[lev][nodesx])*sin(fi1[lev][nodesy]);
- E->X[lev][m][3][node] =
- E->sphere.R[lev][i]*cos(theta1[lev][nodesx]);
- }
- }
-
- } /* end for lev */
-
-
-
- for (lev=E->mesh.gridmin;lev<=E->mesh.gridmax;lev++) {
- free ((void *)theta1[lev]);
- free ((void *)fi1[lev] );
- }
-
- } /* end of coord = 1 */
-
- else if((E->control.coor==0) || (E->control.coor==2)|| (E->control.coor==3)) {
-
- /*
- for(i=1;i<=5;i++) {
- x[i] = (double *) malloc((E->parallel.nproc+1)*sizeof(double));
- y[i] = (double *) malloc((E->parallel.nproc+1)*sizeof(double));
- z[i] = (double *) malloc((E->parallel.nproc+1)*sizeof(double));
- */
- tt = (double *) malloc((4+1)*sizeof(double));
- ff = (double *) malloc((4+1)*sizeof(double));
-
-
- temp = E->lmesh.NOY[E->mesh.levmax]*E->lmesh.NOX[E->mesh.levmax];
-
- SX[0] = (double *)malloc((temp+1)*sizeof(double));
- SX[1] = (double *)malloc((temp+1)*sizeof(double));
-
-
- tt[1] = E->sphere.cap[m].theta[1]+(E->sphere.cap[m].theta[2] -E->sphere.cap[m].theta[1])/nprocxl*(E->parallel.me_loc[1]);
- tt[2] = E->sphere.cap[m].theta[1]+(E->sphere.cap[m].theta[2] -E->sphere.cap[m].theta[1])/nprocxl*(E->parallel.me_loc[1]+1);
- tt[3] = tt[2];
- tt[4] = tt[1];
- ff[1] = E->sphere.cap[m].fi[1]+(E->sphere.cap[m].fi[4] -E->sphere.cap[1].fi[1])/nprocyl*(E->parallel.me_loc[2]);
- ff[2] = ff[1];
- ff[3] = E->sphere.cap[m].fi[1]+(E->sphere.cap[m].fi[4] -E->sphere.cap[1].fi[1])/nprocyl*(E->parallel.me_loc[2]+1);
- ff[4] = ff[3];
-
-
- for (lev=E->mesh.levmin;lev<=E->mesh.levmax;lev++) {
-
- elx = E->lmesh.ELX[lev];
- ely = E->lmesh.ELY[lev];
- nox = E->lmesh.NOX[lev];
- noy = E->lmesh.NOY[lev];
- noz = E->lmesh.NOZ[lev];
- /* evenly divide arc linking 1 and 2, and the arc linking 4 and 3 */
-
- for(j=1;j<=nox;j++) {
- dt=(tt[3]-tt[1])/elx;
- df=(ff[3]-ff[1])/ely;
-
- for (k=1;k<=noy;k++) {
- nodes = j + (k-1)*nox;
- SX[0][nodes] = tt[1]+dt*(j-1);
- SX[1][nodes] = ff[1]+df*(k-1);
- }
-
- } /* end for j */
-
- /* get the coordinates for the entire cap */
-
- for (j=1;j<=nox;j++)
- for (k=1;k<=noy;k++) {
- nodes = j + (k-1)*nox;
- for (i=1;i<=noz;i++) {
- node = i + (j-1)*noz + (k-1)*nox*noz;
-
- /* theta,fi,and r coordinates */
- E->SX[lev][m][1][node] = SX[0][nodes];
- E->SX[lev][m][2][node] = SX[1][nodes];
- E->SX[lev][m][3][node] = E->sphere.R[lev][i];
-
- /* x,y,and z oordinates */
- E->X[lev][m][1][node] =
- E->sphere.R[lev][i]*sin(SX[0][nodes])*cos(SX[1][nodes]);
- E->X[lev][m][2][node] =
- E->sphere.R[lev][i]*sin(SX[0][nodes])*sin(SX[1][nodes]);
- E->X[lev][m][3][node] =
- E->sphere.R[lev][i]*cos(SX[0][nodes]);
- }
- }
-
- } /* end for lev */
-
-
-
- free ((void *)SX[0]);
- free ((void *)SX[1]);
- free ((void *)tt);
- free ((void *)ff);
-}
-
- return;
- }
-
Copied: mc/3D/CitcomS/branches/cxx/lib/Regional_sphere_related.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Regional_sphere_related.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Regional_sphere_related.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Regional_sphere_related.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,250 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+/* Functions relating to the building and use of mesh locations ... */
+
+#include <math.h>
+#include <sys/types.h>
+#include "element_definitions.h"
+#include "global_defs.h"
+
+void regional_coord_of_cap(
+ struct All_variables *E,
+ int m, int icap
+ )
+ {
+
+ int i,j,k,lev,temp,elx,ely,nox,noy,noz,node,nodes;
+ int nprocxl,nprocyl,nproczl;
+ int nnproc;
+ int gnox,gnoy,gnoz;
+ int nodesx,nodesy;
+ char output_file[255];
+ char a[100];
+ int nn,step;
+ FILE *fp;
+ float *theta1[MAX_LEVELS],*fi1[MAX_LEVELS];
+ double *SX[2];
+ double *tt,*ff;
+ double dt,df;
+
+ m=1;
+
+ gnox=E->mesh.nox;
+ gnoy=E->mesh.noy;
+ gnoz=E->mesh.noz;
+ nox=E->lmesh.nox;
+ noy=E->lmesh.noy;
+ noz=E->lmesh.noz;
+
+ nprocxl=E->parallel.nprocx;
+ nprocyl=E->parallel.nprocy;
+ nproczl=E->parallel.nprocz;
+ nnproc=nprocyl*nprocxl*nproczl;
+ temp = max(E->mesh.NOY[E->mesh.levmax],E->mesh.NOX[E->mesh.levmax]);
+
+
+ if(E->control.coor==1) {
+
+ /* read in node locations from file */
+
+ for(i=E->mesh.gridmin;i<=E->mesh.gridmax;i++) {
+ theta1[i] = (float *)malloc((temp+1)*sizeof(float));
+ fi1[i] = (float *)malloc((temp+1)*sizeof(float));
+ }
+
+ temp = E->mesh.NOY[E->mesh.levmax]*E->mesh.NOX[E->mesh.levmax];
+
+ sprintf(output_file,"%s",E->control.coor_file);
+ fp=fopen(output_file,"r");
+ if (fp == NULL) {
+ fprintf(E->fp,"(Sphere_related #1) Cannot open %s\n",output_file);
+ exit(8);
+ }
+
+ fscanf(fp,"%s %d",a,&nn);
+ for(i=1;i<=gnox;i++) {
+ fscanf(fp,"%d %e",&nn,&theta1[E->mesh.gridmax][i]);
+ }
+ E->control.theta_min = theta1[E->mesh.gridmax][1];
+ E->control.theta_max = theta1[E->mesh.gridmax][gnox];
+
+ fscanf(fp,"%s %d",a,&nn);
+ for(i=1;i<=gnoy;i++) {
+ fscanf(fp,"%d %e",&nn,&fi1[E->mesh.gridmax][i]);
+ }
+ E->control.fi_min = fi1[E->mesh.gridmax][1];
+ E->control.fi_max = fi1[E->mesh.gridmax][gnoy];
+
+ fclose(fp);
+
+
+ for (lev=E->mesh.gridmin;lev<=E->mesh.gridmax;lev++) {
+
+ if (E->control.NMULTIGRID||E->control.EMULTIGRID)
+ step = (int) pow(2.0,(double)(E->mesh.levmax-lev));
+ else
+ step = 1;
+
+ for (i=1;i<=E->mesh.NOX[lev];i++)
+ theta1[lev][i] = theta1[E->mesh.gridmax][(i-1)*step+1];
+
+ for (i=1;i<=E->mesh.NOY[lev];i++)
+ fi1[lev][i] = fi1[E->mesh.gridmax][(i-1)*step+1];
+
+ }
+
+
+ for (lev=E->mesh.gridmin;lev<=E->mesh.gridmax;lev++) {
+ elx = E->lmesh.ELX[lev];
+ ely = E->lmesh.ELY[lev];
+ nox = E->lmesh.NOX[lev];
+ noy = E->lmesh.NOY[lev];
+ noz = E->lmesh.NOZ[lev];
+ /* evenly divide arc linking 1 and 2, and the arc linking 4 and 3 */
+
+ /* get the coordinates for the entire cap */
+
+ for (j=1;j<=nox;j++)
+ for (k=1;k<=noy;k++) {
+ nodesx = E->lmesh.NXS[lev]+j-1;
+ nodesy = E->lmesh.NYS[lev]+k-1;
+
+ for (i=1;i<=noz;i++) {
+ node = i + (j-1)*noz + (k-1)*nox*noz;
+
+ /* theta,fi,and r coordinates */
+ E->SX[lev][m][1][node] = theta1[lev][nodesx];
+ E->SX[lev][m][2][node] = fi1[lev][nodesy];
+ E->SX[lev][m][3][node] = E->sphere.R[lev][i];
+
+ /* x,y,and z oordinates */
+ E->X[lev][m][1][node] =
+ E->sphere.R[lev][i]*sin(theta1[lev][nodesx])*cos(fi1[lev][nodesy]);
+ E->X[lev][m][2][node] =
+ E->sphere.R[lev][i]*sin(theta1[lev][nodesx])*sin(fi1[lev][nodesy]);
+ E->X[lev][m][3][node] =
+ E->sphere.R[lev][i]*cos(theta1[lev][nodesx]);
+ }
+ }
+
+ } /* end for lev */
+
+
+
+ for (lev=E->mesh.gridmin;lev<=E->mesh.gridmax;lev++) {
+ free ((void *)theta1[lev]);
+ free ((void *)fi1[lev] );
+ }
+
+ } /* end of coord = 1 */
+
+ else if((E->control.coor==0) || (E->control.coor==2)|| (E->control.coor==3)) {
+
+ /*
+ for(i=1;i<=5;i++) {
+ x[i] = (double *) malloc((E->parallel.nproc+1)*sizeof(double));
+ y[i] = (double *) malloc((E->parallel.nproc+1)*sizeof(double));
+ z[i] = (double *) malloc((E->parallel.nproc+1)*sizeof(double));
+ */
+ tt = (double *) malloc((4+1)*sizeof(double));
+ ff = (double *) malloc((4+1)*sizeof(double));
+
+
+ temp = E->lmesh.NOY[E->mesh.levmax]*E->lmesh.NOX[E->mesh.levmax];
+
+ SX[0] = (double *)malloc((temp+1)*sizeof(double));
+ SX[1] = (double *)malloc((temp+1)*sizeof(double));
+
+
+ tt[1] = E->sphere.cap[m].theta[1]+(E->sphere.cap[m].theta[2] -E->sphere.cap[m].theta[1])/nprocxl*(E->parallel.me_loc[1]);
+ tt[2] = E->sphere.cap[m].theta[1]+(E->sphere.cap[m].theta[2] -E->sphere.cap[m].theta[1])/nprocxl*(E->parallel.me_loc[1]+1);
+ tt[3] = tt[2];
+ tt[4] = tt[1];
+ ff[1] = E->sphere.cap[m].fi[1]+(E->sphere.cap[m].fi[4] -E->sphere.cap[1].fi[1])/nprocyl*(E->parallel.me_loc[2]);
+ ff[2] = ff[1];
+ ff[3] = E->sphere.cap[m].fi[1]+(E->sphere.cap[m].fi[4] -E->sphere.cap[1].fi[1])/nprocyl*(E->parallel.me_loc[2]+1);
+ ff[4] = ff[3];
+
+
+ for (lev=E->mesh.levmin;lev<=E->mesh.levmax;lev++) {
+
+ elx = E->lmesh.ELX[lev];
+ ely = E->lmesh.ELY[lev];
+ nox = E->lmesh.NOX[lev];
+ noy = E->lmesh.NOY[lev];
+ noz = E->lmesh.NOZ[lev];
+ /* evenly divide arc linking 1 and 2, and the arc linking 4 and 3 */
+
+ for(j=1;j<=nox;j++) {
+ dt=(tt[3]-tt[1])/elx;
+ df=(ff[3]-ff[1])/ely;
+
+ for (k=1;k<=noy;k++) {
+ nodes = j + (k-1)*nox;
+ SX[0][nodes] = tt[1]+dt*(j-1);
+ SX[1][nodes] = ff[1]+df*(k-1);
+ }
+
+ } /* end for j */
+
+ /* get the coordinates for the entire cap */
+
+ for (j=1;j<=nox;j++)
+ for (k=1;k<=noy;k++) {
+ nodes = j + (k-1)*nox;
+ for (i=1;i<=noz;i++) {
+ node = i + (j-1)*noz + (k-1)*nox*noz;
+
+ /* theta,fi,and r coordinates */
+ E->SX[lev][m][1][node] = SX[0][nodes];
+ E->SX[lev][m][2][node] = SX[1][nodes];
+ E->SX[lev][m][3][node] = E->sphere.R[lev][i];
+
+ /* x,y,and z oordinates */
+ E->X[lev][m][1][node] =
+ E->sphere.R[lev][i]*sin(SX[0][nodes])*cos(SX[1][nodes]);
+ E->X[lev][m][2][node] =
+ E->sphere.R[lev][i]*sin(SX[0][nodes])*sin(SX[1][nodes]);
+ E->X[lev][m][3][node] =
+ E->sphere.R[lev][i]*cos(SX[0][nodes]);
+ }
+ }
+
+ } /* end for lev */
+
+
+
+ free ((void *)SX[0]);
+ free ((void *)SX[1]);
+ free ((void *)tt);
+ free ((void *)ff);
+}
+
+ return;
+ }
+
Deleted: mc/3D/CitcomS/branches/cxx/lib/Regional_tracer_advection.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Regional_tracer_advection.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Regional_tracer_advection.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,1033 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-
-
-
-#ifdef HAVE_CONFIG_H
-#include "config.h"
-#endif
-
-#include <mpi.h>
-#include <math.h>
-#include <sys/types.h>
-#ifdef HAVE_MALLOC_H
-#include <malloc.h>
-#endif
-
-#include "element_definitions.h"
-#include "global_defs.h"
-#include "composition_related.h"
-#include "parallel_related.h"
-
-
-static void write_trace_instructions(struct All_variables *E);
-static void make_mesh_ijk(struct All_variables *E);
-static void put_lost_tracers(struct All_variables *E,
- int *send_size, double *send,
- int kk, int j);
-static void put_found_tracers(struct All_variables *E,
- int recv_size, double *recv,
- int j);
-int isearch_neighbors(double *array, int nsize,
- double a, int hint);
-int isearch_all(double *array, int nsize, double a);
-
-
-void regional_tracer_setup(struct All_variables *E)
-{
-
- char output_file[255];
- void get_neighboring_caps();
- double CPU_time0();
- double begin_time = CPU_time0();
-
- /* Some error control */
-
- if (E->sphere.caps_per_proc>1) {
- fprintf(stderr,"This code does not work for multiple caps per processor!\n");
- parallel_process_termination();
- }
-
-
- /* open tracing output file */
-
- sprintf(output_file,"%s.tracer_log.%d",E->control.data_file,E->parallel.me);
- E->trace.fpt=fopen(output_file,"w");
-
-
- /* reset statistical counters */
-
- E->trace.istat_isend=0;
- E->trace.istat_iempty=0;
- E->trace.istat_elements_checked=0;
- E->trace.istat1=0;
-
-
- /* some obscure initial parameters */
- /* This parameter specifies how close a tracer can get to the boundary */
- E->trace.box_cushion=0.00001;
-
- /* Determine number of tracer quantities */
-
- /* advection_quantites - those needed for advection */
- E->trace.number_of_basic_quantities=12;
-
- /* extra_quantities - used for flavors, composition, etc. */
- /* (can be increased for additional science i.e. tracing chemistry */
-
- E->trace.number_of_extra_quantities = 0;
- if (E->trace.nflavors > 0)
- E->trace.number_of_extra_quantities += 1;
-
-
- E->trace.number_of_tracer_quantities =
- E->trace.number_of_basic_quantities +
- E->trace.number_of_extra_quantities;
-
-
- /* Fixed positions in tracer array */
- /* Flavor is always in extraq position 0 */
- /* Current coordinates are always kept in basicq positions 0-5 */
- /* Other positions may be used depending on science being done */
-
-
- /* Some error control regarding size of pointer arrays */
-
- if (E->trace.number_of_basic_quantities>99) {
- fprintf(E->trace.fpt,"ERROR(initialize_trace)-increase 2nd position size of basic in tracer_defs.h\n");
- fflush(E->trace.fpt);
- parallel_process_termination();
- }
- if (E->trace.number_of_extra_quantities>99) {
- fprintf(E->trace.fpt,"ERROR(initialize_trace)-increase 2nd position size of extraq in tracer_defs.h\n");
- fflush(E->trace.fpt);
- parallel_process_termination();
- }
- if (E->trace.number_of_tracer_quantities>99) {
- fprintf(E->trace.fpt,"ERROR(initialize_trace)-increase 2nd position size of rlater in tracer_defs.h\n");
- fflush(E->trace.fpt);
- parallel_process_termination();
- }
-
- write_trace_instructions(E);
-
- /* The bounding box of neiboring processors */
- get_neighboring_caps(E);
-
- make_mesh_ijk(E);
-
- if (E->composition.on)
- composition_setup(E);
-
- fprintf(E->trace.fpt, "Tracer intiailization takes %f seconds.\n",
- CPU_time0() - begin_time);
-
- return;
-}
-
-
-/**** WRITE TRACE INSTRUCTIONS ***************/
-static void write_trace_instructions(struct All_variables *E)
-{
- int i;
-
- fprintf(E->trace.fpt,"\nTracing Activated! (proc: %d)\n",E->parallel.me);
- fprintf(E->trace.fpt," Allen K. McNamara 12-2003\n\n");
-
- if (E->trace.ic_method==0) {
- fprintf(E->trace.fpt,"Generating New Tracer Array\n");
- fprintf(E->trace.fpt,"Tracers per element: %d\n",E->trace.itperel);
- }
- if (E->trace.ic_method==1) {
- fprintf(E->trace.fpt,"Reading tracer file %s\n",E->trace.tracer_file);
- }
- if (E->trace.ic_method==2) {
- fprintf(E->trace.fpt,"Read individual tracer files\n");
- }
-
- fprintf(E->trace.fpt,"Number of tracer flavors: %d\n", E->trace.nflavors);
-
- if (E->trace.nflavors && E->trace.ic_method==0) {
- fprintf(E->trace.fpt,"Initialized tracer flavors by: %d\n", E->trace.ic_method_for_flavors);
- if (E->trace.ic_method_for_flavors == 0) {
- fprintf(E->trace.fpt,"Layered tracer flavors\n");
- for (i=0; i<E->trace.nflavors-1; i++)
- fprintf(E->trace.fpt,"Interface Height: %d %f\n",i,E->trace.z_interface[i]);
- }
- else {
- fprintf(E->trace.fpt,"Sorry-This IC methods for Flavors are Unavailable %d\n",E->trace.ic_method_for_flavors);
- fflush(E->trace.fpt);
- parallel_process_termination();
- }
- }
-
- for (i=0; i<E->trace.nflavors-2; i++) {
- if (E->trace.z_interface[i] < E->trace.z_interface[i+1]) {
- fprintf(E->trace.fpt,"Sorry - The %d-th z_interface is smaller than the next one.\n", i);
- fflush(E->trace.fpt);
- parallel_process_termination();
- }
- }
-
-
-
- /* more obscure stuff */
-
- fprintf(E->trace.fpt,"Box Cushion: %f\n",E->trace.box_cushion);
- fprintf(E->trace.fpt,"Number of Basic Quantities: %d\n",
- E->trace.number_of_basic_quantities);
- fprintf(E->trace.fpt,"Number of Extra Quantities: %d\n",
- E->trace.number_of_extra_quantities);
- fprintf(E->trace.fpt,"Total Number of Tracer Quantities: %d\n",
- E->trace.number_of_tracer_quantities);
-
-
-
- if (E->trace.itracer_warnings==0) {
- fprintf(E->trace.fpt,"\n WARNING EXITS ARE TURNED OFF! TURN THEM ON!\n");
- fprintf(stderr,"\n WARNING EXITS ARE TURNED OFF! TURN THEM ON!\n");
- fflush(E->trace.fpt);
- }
-
- write_composition_instructions(E);
-
-
- return;
-}
-
-
-static void make_mesh_ijk(struct All_variables *E)
-{
- int m,i,j,k,node;
- int nox,noy,noz;
-
- nox=E->lmesh.nox;
- noy=E->lmesh.noy;
- noz=E->lmesh.noz;
-
- E->trace.x_space=(double*) malloc(nox*sizeof(double));
- E->trace.y_space=(double*) malloc(noy*sizeof(double));
- E->trace.z_space=(double*) malloc(noz*sizeof(double));
-
- /***comment by Vlad 1/26/2005
- reading the local mesh coordinate
- ***/
-
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
- for(i=0;i<nox;i++)
- E->trace.x_space[i]=E->sx[m][1][i*noz+1];
-
- for(j=0;j<noy;j++)
- E->trace.y_space[j]=E->sx[m][2][j*nox*noz+1];
-
- for(k=0;k<noz;k++)
- E->trace.z_space[k]=E->sx[m][3][k+1];
-
- } /* end of m */
-
-
- /* debug *
- for(i=0;i<nox;i++)
- fprintf(E->trace.fpt, "i=%d x=%e\n", i, E->trace.x_space[i]);
- for(j=0;j<noy;j++)
- fprintf(E->trace.fpt, "j=%d y=%e\n", j, E->trace.y_space[j]);
- for(k=0;k<noz;k++)
- fprintf(E->trace.fpt, "k=%d z=%e\n", k, E->trace.z_space[k]);
-
- /**
- fprintf(stderr, "%d\n", isearch_neighbors(E->trace.z_space, noz, 0.7, 0));
- fprintf(stderr, "%d\n", isearch_neighbors(E->trace.z_space, noz, 0.7, 1));
- fprintf(stderr, "%d\n", isearch_neighbors(E->trace.z_space, noz, 0.7, 2));
- fprintf(stderr, "%d\n", isearch_neighbors(E->trace.z_space, noz, 0.7, 3));
- fprintf(stderr, "%d\n", isearch_neighbors(E->trace.z_space, noz, 0.7, 4));
-
- fprintf(stderr, "%d\n", isearch_neighbors(E->trace.z_space, noz, 0.56, 0));
- fprintf(stderr, "%d\n", isearch_neighbors(E->trace.z_space, noz, 0.56, 1));
- fprintf(stderr, "%d\n", isearch_neighbors(E->trace.z_space, noz, 0.56, 2));
-
- fprintf(stderr, "%d\n", isearch_neighbors(E->trace.z_space, noz, 0.99, 2));
- fprintf(stderr, "%d\n", isearch_neighbors(E->trace.z_space, noz, 0.99, 3));
- fprintf(stderr, "%d\n", isearch_neighbors(E->trace.z_space, noz, 0.99, 4));
-
- fprintf(stderr, "%d\n", isearch_all(E->trace.z_space, noz, 0.5));
- fprintf(stderr, "%d\n", isearch_all(E->trace.z_space, noz, 1.1));
- fprintf(stderr, "%d\n", isearch_all(E->trace.z_space, noz, 0.55));
- fprintf(stderr, "%d\n", isearch_all(E->trace.z_space, noz, 1.0));
- fprintf(stderr, "%d\n", isearch_all(E->trace.z_space, noz, 0.551));
- fprintf(stderr, "%d\n", isearch_all(E->trace.z_space, noz, 0.99));
- fprintf(stderr, "%d\n", isearch_all(E->trace.z_space, noz, 0.7));
- fprintf(stderr, "%d\n", isearch_all(E->trace.z_space, noz, 0.75));
- fprintf(stderr, "%d\n", isearch_all(E->trace.z_space, noz, 0.775));
- fprintf(stderr, "%d\n", isearch_all(E->trace.z_space, noz, 0.7750001));
- parallel_process_termination();
- /**/
-
- return;
-}
-
-
-/********** IGET ELEMENT *****************************************/
-/* */
-/* This function returns the the real element for a given point. */
-/* Returns -99 in not in this cap. */
-/* iprevious_element, if known, is the last known element. If */
-/* it is not known, input a negative number. */
-
-int regional_iget_element(struct All_variables *E,
- int m, int iprevious_element,
- double dummy1, double dummy2, double dummy3,
- double theta, double phi, double rad)
-{
- int e, i, j, k;
- int ii, jj, kk;
- int elx, ely, elz;
-
- elx = E->lmesh.elx;
- ely = E->lmesh.ely;
- elz = E->lmesh.elz;
-
- //TODO: take care of south west bound
-
-
- /* Search neighboring elements if the previous element is known */
- if (iprevious_element > 0) {
- e = iprevious_element - 1;
- k = e % elz;
- i = (e / elz) % elx;
- j = e / (elz*elx);
-
- ii = isearch_neighbors(E->trace.x_space, elx+1, theta, i);
- jj = isearch_neighbors(E->trace.y_space, ely+1, phi, j);
- kk = isearch_neighbors(E->trace.z_space, elz+1, rad, k);
-
- if (ii>=0 && jj>=0 && kk>=0)
- return jj*elx*elz + ii*elz + kk + 1;
- }
-
- /* Search all elements if either the previous element is unknown */
- /* or failed to find in the neighboring elements */
- ii = isearch_all(E->trace.x_space, elx+1, theta);
- jj = isearch_all(E->trace.y_space, ely+1, phi);
- kk = isearch_all(E->trace.z_space, elz+1, rad);
-
- if (ii<0 || jj<0 || kk<0)
- return -99;
-
- return jj*elx*elz + ii*elz + kk + 1;
-}
-
-
-/* array is an ordered array of length nsize */
-/* return an index i, such that array[i] <= a < array[i+1] */
-/* return -1 if not found. */
-/* Note that -1 is returned if a == array[nsize-1] */
-int isearch_all(double *array, int nsize, double a)
-{
- int high, i, low;
-
- /* check the min/max bound */
- if ((a < array[0]) || (a >= array[nsize-1]))
- return -1;
-
- /* binary search */
- for (low=0, high=nsize-1; high-low>1;) {
- i = (high+low) / 2;
- if ( a < array[i] ) high = i;
- else low = i;
- }
-
- return low;
-}
-
-
-/* Similar the isearch_all(), but with a hint */
-int isearch_neighbors(double *array, int nsize,
- double a, int hint)
-{
- /* search the nearest neighbors only */
- const int number_of_neighbors = 3;
- int neighbors[5];
- int n, i;
-
- neighbors[0] = hint;
- neighbors[1] = hint-1;
- neighbors[2] = hint+1;
- neighbors[3] = hint-2;
- neighbors[4] = hint+2;
-
-
- /**/
- for (n=0; n<number_of_neighbors; n++) {
- i = neighbors[n];
- if ((i >= 0) && (i < nsize-1) &&
- (a >= array[i]) && (a < array[i+1]))
- return i;
- }
-
- return -1;
-}
-
-
-/* */
-/* This function serves to determine if a point lies within */
-/* a given cap */
-/* */
-int regional_icheck_cap(struct All_variables *E, int icap,
- double theta, double phi, double rad, double junk)
-{
- double theta_min, theta_max;
- double phi_min, phi_max;
-
- /* corner 2 is the north-west corner */
- /* corner 4 is the south-east corner */
-
- theta_min = E->trace.theta_cap[icap][2];
- theta_max = E->trace.theta_cap[icap][4];
-
- phi_min = E->trace.phi_cap[icap][2];
- phi_max = E->trace.phi_cap[icap][4];
-
- if ((theta >= theta_min) && (theta < theta_max) &&
- (phi >= phi_min) && (phi < phi_max))
- return 1;
-
- //TODO: deal with south west bounds
- return 0;
-}
-
-
-void regional_get_shape_functions(struct All_variables *E,
- double shp[9], int nelem,
- double theta, double phi, double rad)
-{
- int e, i, j, k;
- int elx, ely, elz;
- double tr_dx, tr_dy, tr_dz;
- double dx, dy, dz;
- double volume;
-
- elx = E->lmesh.elx;
- ely = E->lmesh.ely;
- elz = E->lmesh.elz;
-
- e = nelem - 1;
- k = e % elz;
- i = (e / elz) % elx;
- j = e / (elz*elx);
-
-
- /*** comment by Tan2 1/25/2005
- Find the element that contains the tracer.
-
- node(i) tracer node(i+1)
- | * |
- <----------->
- tr_dx
-
- <-------------------------------->
- dx
- ***/
-
- tr_dx = theta - E->trace.x_space[i];
- dx = E->trace.x_space[i+1] - E->trace.x_space[i];
-
- tr_dy = phi - E->trace.y_space[j];
- dy = E->trace.y_space[j+1] - E->trace.y_space[j];
-
- tr_dz = rad - E->trace.z_space[k];
- dz = E->trace.z_space[k+1] - E->trace.z_space[k];
-
-
-
- /*** comment by Tan2 1/25/2005
- Calculate shape functions from tr_dx, tr_dy, tr_dz
- This assumes linear element
- ***/
-
-
- /* compute volumetic weighting functions */
- volume = dx*dz*dy;
-
- shp[1] = (dx-tr_dx) * (dy-tr_dy) * (dz-tr_dz) / volume;
- shp[2] = tr_dx * (dy-tr_dy) * (dz-tr_dz) / volume;
- shp[3] = tr_dx * tr_dy * (dz-tr_dz) / volume;
- shp[4] = (dx-tr_dx) * tr_dy * (dz-tr_dz) / volume;
- shp[5] = (dx-tr_dx) * (dy-tr_dy) * tr_dz / volume;
- shp[6] = tr_dx * (dy-tr_dy) * tr_dz / volume;
- shp[7] = tr_dx * tr_dy * tr_dz / volume;
- shp[8] = (dx-tr_dx) * tr_dy * tr_dz / volume;
-
- /** debug **
- fprintf(E->trace.fpt, "dr=(%e,%e,%e) tr_dr=(%e,%e,%e)\n",
- dx, dy, dz, tr_dx, tr_dy, tr_dz);
- fprintf(E->trace.fpt, "shp: %e %e %e %e %e %e %e %e\n",
- shp[1], shp[2], shp[3], shp[4], shp[5], shp[6], shp[7], shp[8]);
- fprintf(E->trace.fpt, "sum(shp): %e\n",
- shp[1]+ shp[2]+ shp[3]+ shp[4]+ shp[5]+ shp[6]+ shp[7]+ shp[8]);
- fflush(E->trace.fpt);
- /**/
- return;
-}
-
-
-double regional_interpolate_data(struct All_variables *E,
- double shp[9], double data[9])
-{
- int n;
- double result = 0;
-
- for(n=1; n<=8; n++)
- result += data[n] * shp[n];
-
- return result;
-}
-
-
-/******** GET VELOCITY ***************************************/
-
-void regional_get_velocity(struct All_variables *E,
- int m, int nelem,
- double theta, double phi, double rad,
- double *velocity_vector)
-{
- void velo_from_element_d();
-
- double shp[9], VV[4][9], tmp;
- int n, d, node;
- const int sphere_key = 0;
-
- /* get shape functions at (theta, phi, rad) */
- regional_get_shape_functions(E, shp, nelem, theta, phi, rad);
-
-
- /* get cartesian velocity */
- velo_from_element_d(E, VV, m, nelem, sphere_key);
-
-
- /*** comment by Tan2 1/25/2005
- Interpolate the velocity on the tracer position
- ***/
-
- for(d=1; d<=3; d++)
- velocity_vector[d] = 0;
-
-
- for(d=1; d<=3; d++) {
- for(n=1; n<=8; n++)
- velocity_vector[d] += VV[d][n] * shp[n];
- }
-
-
- /** debug **
- for(d=1; d<=3; d++) {
- fprintf(E->trace.fpt, "VV: %e %e %e %e %e %e %e %e: %e\n",
- VV[d][1], VV[d][2], VV[d][3], VV[d][4],
- VV[d][5], VV[d][6], VV[d][7], VV[d][8],
- velocity_vector[d]);
- }
-
- tmp = 0;
- for(n=1; n<=8; n++)
- tmp += E->sx[m][1][E->ien[m][nelem].node[n]] * shp[n];
-
- fprintf(E->trace.fpt, "THETA: %e -> %e\n", theta, tmp);
-
- fflush(E->trace.fpt);
- /**/
-
- return;
-}
-
-
-void regional_keep_within_bounds(struct All_variables *E,
- double *x, double *y, double *z,
- double *theta, double *phi, double *rad)
-{
- void sphere_to_cart();
- int changed = 0;
-
- if (*theta > E->control.theta_max - E->trace.box_cushion) {
- *theta = E->control.theta_max - E->trace.box_cushion;
- changed = 1;
- }
-
- if (*theta < E->control.theta_min + E->trace.box_cushion) {
- *theta = E->control.theta_min + E->trace.box_cushion;
- changed = 1;
- }
-
- if (*phi > E->control.fi_max - E->trace.box_cushion) {
- *phi = E->control.fi_max - E->trace.box_cushion;
- changed = 1;
- }
-
- if (*phi < E->control.fi_min + E->trace.box_cushion) {
- *phi = E->control.fi_min + E->trace.box_cushion;
- changed = 1;
- }
-
- if (*rad > E->sphere.ro - E->trace.box_cushion) {
- *rad = E->sphere.ro - E->trace.box_cushion;
- changed = 1;
- }
-
- if (*rad < E->sphere.ri + E->trace.box_cushion) {
- *rad = E->sphere.ri + E->trace.box_cushion;
- changed = 1;
- }
-
- if (changed)
- sphere_to_cart(E, *theta, *phi, *rad, x, y, z);
-
-
- return;
-}
-
-
-void regional_lost_souls(struct All_variables *E)
-{
- /* This part only works if E->sphere.caps_per_proc==1 */
- const int j = 1;
- int lev = E->mesh.levmax;
-
- int i, d, kk;
- int max_send_size, isize, itemp_size;
-
- int ngbr_rank[6+1];
-
- double bounds[3][2];
- double *send[2];
- double *recv[2];
-
- void expand_tracer_arrays();
- int icheck_that_processor_shell();
-
- int ipass;
-
- MPI_Status status[4];
- MPI_Request request[4];
-
- double CPU_time0();
- double begin_time = CPU_time0();
-
- E->trace.istat_isend = E->trace.ilater[j];
-
- /* the bounding box */
- for (d=0; d<E->mesh.nsd; d++) {
- bounds[d][0] = E->sx[j][d+1][1];
- bounds[d][1] = E->sx[j][d+1][E->lmesh.nno];
- }
-
- /* set up ranks for neighboring procs */
- /* if ngbr_rank is -1, there is no neighbor on this side */
- ipass = 1;
- for (kk=1; kk<=6; kk++) {
- if (E->parallel.NUM_PASS[lev][j].bound[kk] == 1) {
- ngbr_rank[kk] = E->parallel.PROCESSOR[lev][j].pass[ipass];
- ipass++;
- }
- else {
- ngbr_rank[kk] = -1;
- }
- }
-
- /* debug *
- for (kk=1; kk<=E->trace.istat_isend; kk++) {
- fprintf(E->trace.fpt, "tracer#=%d xx=(%g,%g,%g)\n", kk,
- E->trace.rlater[j][0][kk],
- E->trace.rlater[j][1][kk],
- E->trace.rlater[j][2][kk]);
- }
-
- for (d=0; d<E->mesh.nsd; d++) {
- fprintf(E->trace.fpt, "bounds(dim=%d) = (%e, %e)\n",
- d, bounds[d][0], bounds[d][1]);
- }
-
- for (kk=1; kk<=6; kk++) {
- fprintf(E->trace.fpt, "pass=%d neighbor_rank=%d\n",
- kk, ngbr_rank[kk]);
- }
- fflush(E->trace.fpt);
- parallel_process_sync(E);
- /**/
-
-
- /* Allocate Maximum Memory to Send Arrays */
- max_send_size = max(2*E->trace.ilater[j], E->trace.ntracers[j]/100);
- itemp_size = max_send_size * E->trace.number_of_tracer_quantities;
-
- if ((send[0] = (double *)malloc(itemp_size*sizeof(double)))
- == NULL) {
- fprintf(E->trace.fpt,"Error(lost souls)-no memory (u388)\n");
- fflush(E->trace.fpt);
- exit(10);
- }
- if ((send[1] = (double *)malloc(itemp_size*sizeof(double)))
- == NULL) {
- fprintf(E->trace.fpt,"Error(lost souls)-no memory (u389)\n");
- fflush(E->trace.fpt);
- exit(10);
- }
-
-
- for (d=0; d<E->mesh.nsd; d++) {
- int original_size = E->trace.ilater[j];
- int idb;
- int kk = 1;
- int isend[2], irecv[2];
- isend[0] = isend[1] = 0;
-
-
- /* move out-of-bound tracers to send array */
- while (kk<=E->trace.ilater[j]) {
- double coord;
-
- /* Is the tracer within the bounds in the d-th dimension */
- coord = E->trace.rlater[j][d][kk];
-
- if (coord < bounds[d][0]) {
- put_lost_tracers(E, &(isend[0]), send[0], kk, j);
- }
- else if (coord >= bounds[d][1]) {
- put_lost_tracers(E, &(isend[1]), send[1], kk, j);
- }
- else {
- /* check next tracer */
- kk++;
- }
-
- /* reallocate send if size too small */
- if ((isend[0] > max_send_size - 5) ||
- (isend[1] > max_send_size - 5)) {
-
- isize = max_send_size + max_send_size/4 + 10;
- itemp_size = isize * E->trace.number_of_tracer_quantities;
-
- if ((send[0] = (double *)realloc(send[0],
- itemp_size*sizeof(double)))
- == NULL) {
- fprintf(E->trace.fpt,"Error(lost souls)-no memory (s4)\n");
- fflush(E->trace.fpt);
- exit(10);
- }
- if ((send[1] = (double *)realloc(send[1],
- itemp_size*sizeof(double)))
- == NULL) {
- fprintf(E->trace.fpt,"Error(lost souls)-no memory (s5)\n");
- fflush(E->trace.fpt);
- exit(10);
- }
-
- fprintf(E->trace.fpt,"Expanding physical memory of send to "
- "%d from %d\n",
- isize, max_send_size);
-
- max_send_size = isize;
- }
-
-
- } /* end of while kk */
-
-
- /* check the total # of tracers is conserved */
- if ((isend[0] + isend[1] + E->trace.ilater[j]) != original_size) {
- fprintf(E->trace.fpt, "original_size: %d, rlater_size: %d, "
- "send_size: %d\n",
- original_size, E->trace.ilater[j], kk);
- }
-
-
- /** debug **
- for (i=0; i<2; i++) {
- for (kk=0; kk<isend[i]; kk++) {
- fprintf(E->trace.fpt, "dim:%d side:%d kk=%d coord[kk]=%e\n",
- d, i, kk,
- send[i][kk*E->trace.number_of_tracer_quantities+d]);
- }
- }
- fflush(E->trace.fpt);
- /**/
-
-
- /* Send info to other processors regarding number of send tracers */
-
- /* check whether there is a neighbor in this pass*/
- idb = 0;
- for (i=0; i<2; i++) {
- int target_rank;
- kk = d*2 + i + 1;
- target_rank = ngbr_rank[kk];
- if (target_rank >= 0) {
- MPI_Isend(&isend[i], 1, MPI_INT, target_rank,
- 11, E->parallel.world, &request[idb++]);
-
- MPI_Irecv(&irecv[i], 1, MPI_INT, target_rank,
- 11, E->parallel.world, &request[idb++]);
- }
- else {
- irecv[i] = 0;
- }
- } /* end of for i */
-
-
- /* Wait for non-blocking calls to complete */
- MPI_Waitall(idb, request, status);
-
-
- /** debug **
- for (i=0; i<2; i++) {
- int target_rank;
- kk = d*2 + i + 1;
- target_rank = ngbr_rank[kk];
- if (target_rank >= 0) {
- fprintf(E->trace.fpt, "%d: %d send %d to proc %d\n",
- d, i, isend[i], target_rank);
- fprintf(E->trace.fpt, "%d: %d recv %d from proc %d\n",
- d, i, irecv[i], target_rank);
- }
- }
- parallel_process_sync(E);
- /**/
-
- /* Allocate memory in receive arrays */
- for (i=0; i<2; i++) {
- isize = irecv[i] * E->trace.number_of_tracer_quantities;
- itemp_size = max(1, isize);
-
- if ((recv[i] = (double *)malloc(itemp_size*sizeof(double)))
- == NULL) {
- fprintf(E->trace.fpt, "Error(lost souls)-no memory (c721)\n");
- fflush(E->trace.fpt);
- exit(10);
- }
- }
-
-
- /* Now, send the tracers to proper procs */
- idb = 0;
- for (i=0; i<2; i++) {
- int target_rank;
- kk = d*2 + i + 1;
- target_rank = ngbr_rank[kk];
- if (target_rank >= 0) {
- isize = isend[i] * E->trace.number_of_tracer_quantities;
- MPI_Isend(send[i], isize, MPI_DOUBLE, target_rank,
- 12, E->parallel.world, &request[idb++]);
-
- isize = irecv[i] * E->trace.number_of_tracer_quantities;
- MPI_Irecv(recv[i], isize, MPI_DOUBLE, target_rank,
- 12, E->parallel.world, &request[idb++]);
-
- }
- }
-
-
- /* Wait for non-blocking calls to complete */
- MPI_Waitall(idb, request, status);
-
-
- /** debug **
- for (i=0; i<2; i++) {
- for (kk=1; kk<=irecv[i]; kk++) {
- fprintf(E->trace.fpt, "recv: %d %e %e %e\n",
- kk,
- recv[i][(kk-1)*E->trace.number_of_tracer_quantities],
- recv[i][(kk-1)*E->trace.number_of_tracer_quantities+1],
- recv[i][(kk-1)*E->trace.number_of_tracer_quantities+2]);
- }
- }
- fflush(E->trace.fpt);
- parallel_process_sync(E);
- /**/
-
- /* put the received tracers */
- for (i=0; i<2; i++) {
- put_found_tracers(E, irecv[i], recv[i], j);
- }
-
-
- free(recv[0]);
- free(recv[1]);
-
- } /* end of for d */
-
-
- /* rlater should be empty by now */
- if (E->trace.ilater[j] > 0) {
- fprintf(E->trace.fpt, "Error(regional_lost_souls) lost tracers\n");
- for (kk=1; kk<=E->trace.ilater[j]; kk++) {
- fprintf(E->trace.fpt, "lost #%d xx=(%e, %e, %e)\n", kk,
- E->trace.rlater[j][0][kk],
- E->trace.rlater[j][1][kk],
- E->trace.rlater[j][2][kk]);
- }
- fflush(E->trace.fpt);
- exit(10);
- }
-
-
- /* Free Arrays */
-
- free(send[0]);
- free(send[1]);
-
- E->trace.lost_souls_time += CPU_time0() - begin_time;
- return;
-}
-
-
-static void put_lost_tracers(struct All_variables *E,
- int *send_size, double *send,
- int kk, int j)
-{
- int ilast_tracer, isend_position, ipos;
- int pp;
-
- /* move the tracer from rlater to send */
- isend_position = (*send_size) * E->trace.number_of_tracer_quantities;
-
- for (pp=0; pp<E->trace.number_of_tracer_quantities; pp++) {
- ipos = isend_position + pp;
- send[ipos] = E->trace.rlater[j][pp][kk];
- }
- (*send_size)++;
-
- /* eject the tracer from rlater */
- ilast_tracer = E->trace.ilater[j];
- for (pp=0; pp<E->trace.number_of_tracer_quantities; pp++) {
- E->trace.rlater[j][pp][kk] = E->trace.rlater[j][pp][ilast_tracer];
- }
- E->trace.ilater[j]--;
-
- return;
-}
-
-
-/****************************************************************/
-/* Put the received tracers in basiq & extraq, if within bounds */
-/* Otherwise, append to rlater for sending to another proc */
-
-static void put_found_tracers(struct All_variables *E,
- int recv_size, double *recv,
- int j)
-{
- void expand_tracer_arrays();
- void expand_later_array();
- int icheck_processor_shell();
-
- int kk, pp;
- int ipos, ilast, inside, iel;
- double theta, phi, rad;
-
- for (kk=0; kk<recv_size; kk++) {
- ipos = kk * E->trace.number_of_tracer_quantities;
- theta = recv[ipos];
- phi = recv[ipos + 1];
- rad = recv[ipos + 2];
-
- /* check whether this tracer is inside this proc */
- /* check radius first, since it is cheaper */
- inside = icheck_processor_shell(E, j, rad);
- if (inside == 1)
- inside = regional_icheck_cap(E, 0, theta, phi, rad, rad);
- else
- inside = 0;
-
- /** debug **
- fprintf(E->trace.fpt, "kk=%d, inside=%d, xx=(%e, %e, %e)\n",
- kk, inside, theta, phi, rad);
- fprintf(E->trace.fpt, "before: %d %d\n",
- E->trace.ilater[j], E->trace.ntracers[j]);
- /**/
-
- if (inside) {
-
- E->trace.ntracers[j]++;
- ilast = E->trace.ntracers[j];
-
- if (E->trace.ntracers[j] > (E->trace.max_ntracers[j]-5))
- expand_tracer_arrays(E, j);
-
- for (pp=0; pp<E->trace.number_of_basic_quantities; pp++)
- E->trace.basicq[j][pp][ilast] = recv[ipos+pp];
-
- ipos += E->trace.number_of_basic_quantities;
- for (pp=0; pp<E->trace.number_of_extra_quantities; pp++)
- E->trace.extraq[j][pp][ilast] = recv[ipos+pp];
-
-
- /* found the element */
- iel = regional_iget_element(E, j, -99, 0, 0, 0, theta, phi, rad);
-
- if (iel<1) {
- fprintf(E->trace.fpt, "Error(regional lost souls) - "
- "element not here?\n");
- fprintf(E->trace.fpt, "theta, phi, rad: %f %f %f\n",
- theta, phi, rad);
- fflush(E->trace.fpt);
- exit(10);
- }
-
- E->trace.ielement[j][ilast] = iel;
-
- }
- else {
- if (E->trace.ilatersize[j]==0) {
-
- E->trace.ilatersize[j]=E->trace.max_ntracers[j]/5;
-
- for (kk=0;kk<E->trace.number_of_tracer_quantities;kk++) {
- if ((E->trace.rlater[j][kk]=(double *)malloc(E->trace.ilatersize[j]*sizeof(double)))==NULL) {
- fprintf(E->trace.fpt,"AKM(put_found_tracers)-no memory (%d)\n",kk);
- fflush(E->trace.fpt);
- exit(10);
- }
- }
- } /* end first particle initiating memory allocation */
-
- E->trace.ilater[j]++;
- ilast = E->trace.ilater[j];
-
- if (E->trace.ilater[j] > (E->trace.ilatersize[j]-5))
- expand_later_array(E, j);
-
- for (pp=0; pp<E->trace.number_of_tracer_quantities; pp++)
- E->trace.rlater[j][pp][ilast] = recv[ipos+pp];
- } /* end of if-else */
-
- /** debug **
- fprintf(E->trace.fpt, "after: %d %d\n",
- E->trace.ilater[j], E->trace.ntracers[j]);
- fflush(E->trace.fpt);
- /**/
-
- } /* end of for kk */
-
- return;
-}
Copied: mc/3D/CitcomS/branches/cxx/lib/Regional_tracer_advection.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Regional_tracer_advection.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Regional_tracer_advection.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Regional_tracer_advection.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,1022 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+
+
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+
+#include <mpi.h>
+#include <math.h>
+#include <sys/types.h>
+#ifdef HAVE_MALLOC_H
+#include <malloc.h>
+#endif
+
+#include "element_definitions.h"
+#include "global_defs.h"
+#include "composition_related.h"
+#include "parallel_related.h"
+
+#include "cproto.h"
+
+
+static void write_trace_instructions(struct All_variables *E);
+static void make_mesh_ijk(struct All_variables *E);
+static void put_lost_tracers(struct All_variables *E,
+ int *send_size, double *send,
+ int kk, int j);
+static void put_found_tracers(struct All_variables *E,
+ int recv_size, double *recv,
+ int j);
+int isearch_neighbors(double *array, int nsize,
+ double a, int hint);
+int isearch_all(double *array, int nsize, double a);
+
+
+void regional_tracer_setup(struct All_variables *E)
+{
+
+ char output_file[255];
+ double begin_time = CPU_time0();
+
+ /* Some error control */
+
+ if (E->sphere.caps_per_proc>1) {
+ fprintf(stderr,"This code does not work for multiple caps per processor!\n");
+ parallel_process_termination();
+ }
+
+
+ /* open tracing output file */
+
+ sprintf(output_file,"%s.tracer_log.%d",E->control.data_file,E->parallel.me);
+ E->trace.fpt=fopen(output_file,"w");
+
+
+ /* reset statistical counters */
+
+ E->trace.istat_isend=0;
+ E->trace.istat_iempty=0;
+ E->trace.istat_elements_checked=0;
+ E->trace.istat1=0;
+
+
+ /* some obscure initial parameters */
+ /* This parameter specifies how close a tracer can get to the boundary */
+ E->trace.box_cushion=0.00001;
+
+ /* Determine number of tracer quantities */
+
+ /* advection_quantites - those needed for advection */
+ E->trace.number_of_basic_quantities=12;
+
+ /* extra_quantities - used for flavors, composition, etc. */
+ /* (can be increased for additional science i.e. tracing chemistry */
+
+ E->trace.number_of_extra_quantities = 0;
+ if (E->trace.nflavors > 0)
+ E->trace.number_of_extra_quantities += 1;
+
+
+ E->trace.number_of_tracer_quantities =
+ E->trace.number_of_basic_quantities +
+ E->trace.number_of_extra_quantities;
+
+
+ /* Fixed positions in tracer array */
+ /* Flavor is always in extraq position 0 */
+ /* Current coordinates are always kept in basicq positions 0-5 */
+ /* Other positions may be used depending on science being done */
+
+
+ /* Some error control regarding size of pointer arrays */
+
+ if (E->trace.number_of_basic_quantities>99) {
+ fprintf(E->trace.fpt,"ERROR(initialize_trace)-increase 2nd position size of basic in tracer_defs.h\n");
+ fflush(E->trace.fpt);
+ parallel_process_termination();
+ }
+ if (E->trace.number_of_extra_quantities>99) {
+ fprintf(E->trace.fpt,"ERROR(initialize_trace)-increase 2nd position size of extraq in tracer_defs.h\n");
+ fflush(E->trace.fpt);
+ parallel_process_termination();
+ }
+ if (E->trace.number_of_tracer_quantities>99) {
+ fprintf(E->trace.fpt,"ERROR(initialize_trace)-increase 2nd position size of rlater in tracer_defs.h\n");
+ fflush(E->trace.fpt);
+ parallel_process_termination();
+ }
+
+ write_trace_instructions(E);
+
+ /* The bounding box of neiboring processors */
+ get_neighboring_caps(E);
+
+ make_mesh_ijk(E);
+
+ if (E->composition.on)
+ composition_setup(E);
+
+ fprintf(E->trace.fpt, "Tracer intiailization takes %f seconds.\n",
+ CPU_time0() - begin_time);
+
+ return;
+}
+
+
+/**** WRITE TRACE INSTRUCTIONS ***************/
+static void write_trace_instructions(struct All_variables *E)
+{
+ int i;
+
+ fprintf(E->trace.fpt,"\nTracing Activated! (proc: %d)\n",E->parallel.me);
+ fprintf(E->trace.fpt," Allen K. McNamara 12-2003\n\n");
+
+ if (E->trace.ic_method==0) {
+ fprintf(E->trace.fpt,"Generating New Tracer Array\n");
+ fprintf(E->trace.fpt,"Tracers per element: %d\n",E->trace.itperel);
+ }
+ if (E->trace.ic_method==1) {
+ fprintf(E->trace.fpt,"Reading tracer file %s\n",E->trace.tracer_file);
+ }
+ if (E->trace.ic_method==2) {
+ fprintf(E->trace.fpt,"Read individual tracer files\n");
+ }
+
+ fprintf(E->trace.fpt,"Number of tracer flavors: %d\n", E->trace.nflavors);
+
+ if (E->trace.nflavors && E->trace.ic_method==0) {
+ fprintf(E->trace.fpt,"Initialized tracer flavors by: %d\n", E->trace.ic_method_for_flavors);
+ if (E->trace.ic_method_for_flavors == 0) {
+ fprintf(E->trace.fpt,"Layered tracer flavors\n");
+ for (i=0; i<E->trace.nflavors-1; i++)
+ fprintf(E->trace.fpt,"Interface Height: %d %f\n",i,E->trace.z_interface[i]);
+ }
+ else {
+ fprintf(E->trace.fpt,"Sorry-This IC methods for Flavors are Unavailable %d\n",E->trace.ic_method_for_flavors);
+ fflush(E->trace.fpt);
+ parallel_process_termination();
+ }
+ }
+
+ for (i=0; i<E->trace.nflavors-2; i++) {
+ if (E->trace.z_interface[i] < E->trace.z_interface[i+1]) {
+ fprintf(E->trace.fpt,"Sorry - The %d-th z_interface is smaller than the next one.\n", i);
+ fflush(E->trace.fpt);
+ parallel_process_termination();
+ }
+ }
+
+
+
+ /* more obscure stuff */
+
+ fprintf(E->trace.fpt,"Box Cushion: %f\n",E->trace.box_cushion);
+ fprintf(E->trace.fpt,"Number of Basic Quantities: %d\n",
+ E->trace.number_of_basic_quantities);
+ fprintf(E->trace.fpt,"Number of Extra Quantities: %d\n",
+ E->trace.number_of_extra_quantities);
+ fprintf(E->trace.fpt,"Total Number of Tracer Quantities: %d\n",
+ E->trace.number_of_tracer_quantities);
+
+
+
+ if (E->trace.itracer_warnings==0) {
+ fprintf(E->trace.fpt,"\n WARNING EXITS ARE TURNED OFF! TURN THEM ON!\n");
+ fprintf(stderr,"\n WARNING EXITS ARE TURNED OFF! TURN THEM ON!\n");
+ fflush(E->trace.fpt);
+ }
+
+ write_composition_instructions(E);
+
+
+ return;
+}
+
+
+static void make_mesh_ijk(struct All_variables *E)
+{
+ int m,i,j,k,node;
+ int nox,noy,noz;
+
+ nox=E->lmesh.nox;
+ noy=E->lmesh.noy;
+ noz=E->lmesh.noz;
+
+ E->trace.x_space=(double*) malloc(nox*sizeof(double));
+ E->trace.y_space=(double*) malloc(noy*sizeof(double));
+ E->trace.z_space=(double*) malloc(noz*sizeof(double));
+
+ /***comment by Vlad 1/26/2005
+ reading the local mesh coordinate
+ ***/
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+ for(i=0;i<nox;i++)
+ E->trace.x_space[i]=E->sx[m][1][i*noz+1];
+
+ for(j=0;j<noy;j++)
+ E->trace.y_space[j]=E->sx[m][2][j*nox*noz+1];
+
+ for(k=0;k<noz;k++)
+ E->trace.z_space[k]=E->sx[m][3][k+1];
+
+ } /* end of m */
+
+
+ /* debug *
+ for(i=0;i<nox;i++)
+ fprintf(E->trace.fpt, "i=%d x=%e\n", i, E->trace.x_space[i]);
+ for(j=0;j<noy;j++)
+ fprintf(E->trace.fpt, "j=%d y=%e\n", j, E->trace.y_space[j]);
+ for(k=0;k<noz;k++)
+ fprintf(E->trace.fpt, "k=%d z=%e\n", k, E->trace.z_space[k]);
+
+ /**
+ fprintf(stderr, "%d\n", isearch_neighbors(E->trace.z_space, noz, 0.7, 0));
+ fprintf(stderr, "%d\n", isearch_neighbors(E->trace.z_space, noz, 0.7, 1));
+ fprintf(stderr, "%d\n", isearch_neighbors(E->trace.z_space, noz, 0.7, 2));
+ fprintf(stderr, "%d\n", isearch_neighbors(E->trace.z_space, noz, 0.7, 3));
+ fprintf(stderr, "%d\n", isearch_neighbors(E->trace.z_space, noz, 0.7, 4));
+
+ fprintf(stderr, "%d\n", isearch_neighbors(E->trace.z_space, noz, 0.56, 0));
+ fprintf(stderr, "%d\n", isearch_neighbors(E->trace.z_space, noz, 0.56, 1));
+ fprintf(stderr, "%d\n", isearch_neighbors(E->trace.z_space, noz, 0.56, 2));
+
+ fprintf(stderr, "%d\n", isearch_neighbors(E->trace.z_space, noz, 0.99, 2));
+ fprintf(stderr, "%d\n", isearch_neighbors(E->trace.z_space, noz, 0.99, 3));
+ fprintf(stderr, "%d\n", isearch_neighbors(E->trace.z_space, noz, 0.99, 4));
+
+ fprintf(stderr, "%d\n", isearch_all(E->trace.z_space, noz, 0.5));
+ fprintf(stderr, "%d\n", isearch_all(E->trace.z_space, noz, 1.1));
+ fprintf(stderr, "%d\n", isearch_all(E->trace.z_space, noz, 0.55));
+ fprintf(stderr, "%d\n", isearch_all(E->trace.z_space, noz, 1.0));
+ fprintf(stderr, "%d\n", isearch_all(E->trace.z_space, noz, 0.551));
+ fprintf(stderr, "%d\n", isearch_all(E->trace.z_space, noz, 0.99));
+ fprintf(stderr, "%d\n", isearch_all(E->trace.z_space, noz, 0.7));
+ fprintf(stderr, "%d\n", isearch_all(E->trace.z_space, noz, 0.75));
+ fprintf(stderr, "%d\n", isearch_all(E->trace.z_space, noz, 0.775));
+ fprintf(stderr, "%d\n", isearch_all(E->trace.z_space, noz, 0.7750001));
+ parallel_process_termination();
+ /**/
+
+ return;
+}
+
+
+/********** IGET ELEMENT *****************************************/
+/* */
+/* This function returns the the real element for a given point. */
+/* Returns -99 in not in this cap. */
+/* iprevious_element, if known, is the last known element. If */
+/* it is not known, input a negative number. */
+
+int regional_iget_element(struct All_variables *E,
+ int m, int iprevious_element,
+ double dummy1, double dummy2, double dummy3,
+ double theta, double phi, double rad)
+{
+ int e, i, j, k;
+ int ii, jj, kk;
+ int elx, ely, elz;
+
+ elx = E->lmesh.elx;
+ ely = E->lmesh.ely;
+ elz = E->lmesh.elz;
+
+ //TODO: take care of south west bound
+
+
+ /* Search neighboring elements if the previous element is known */
+ if (iprevious_element > 0) {
+ e = iprevious_element - 1;
+ k = e % elz;
+ i = (e / elz) % elx;
+ j = e / (elz*elx);
+
+ ii = isearch_neighbors(E->trace.x_space, elx+1, theta, i);
+ jj = isearch_neighbors(E->trace.y_space, ely+1, phi, j);
+ kk = isearch_neighbors(E->trace.z_space, elz+1, rad, k);
+
+ if (ii>=0 && jj>=0 && kk>=0)
+ return jj*elx*elz + ii*elz + kk + 1;
+ }
+
+ /* Search all elements if either the previous element is unknown */
+ /* or failed to find in the neighboring elements */
+ ii = isearch_all(E->trace.x_space, elx+1, theta);
+ jj = isearch_all(E->trace.y_space, ely+1, phi);
+ kk = isearch_all(E->trace.z_space, elz+1, rad);
+
+ if (ii<0 || jj<0 || kk<0)
+ return -99;
+
+ return jj*elx*elz + ii*elz + kk + 1;
+}
+
+
+/* array is an ordered array of length nsize */
+/* return an index i, such that array[i] <= a < array[i+1] */
+/* return -1 if not found. */
+/* Note that -1 is returned if a == array[nsize-1] */
+int isearch_all(double *array, int nsize, double a)
+{
+ int high, i, low;
+
+ /* check the min/max bound */
+ if ((a < array[0]) || (a >= array[nsize-1]))
+ return -1;
+
+ /* binary search */
+ for (low=0, high=nsize-1; high-low>1;) {
+ i = (high+low) / 2;
+ if ( a < array[i] ) high = i;
+ else low = i;
+ }
+
+ return low;
+}
+
+
+/* Similar the isearch_all(), but with a hint */
+int isearch_neighbors(double *array, int nsize,
+ double a, int hint)
+{
+ /* search the nearest neighbors only */
+ const int number_of_neighbors = 3;
+ int neighbors[5];
+ int n, i;
+
+ neighbors[0] = hint;
+ neighbors[1] = hint-1;
+ neighbors[2] = hint+1;
+ neighbors[3] = hint-2;
+ neighbors[4] = hint+2;
+
+
+ /**/
+ for (n=0; n<number_of_neighbors; n++) {
+ i = neighbors[n];
+ if ((i >= 0) && (i < nsize-1) &&
+ (a >= array[i]) && (a < array[i+1]))
+ return i;
+ }
+
+ return -1;
+}
+
+
+/* */
+/* This function serves to determine if a point lies within */
+/* a given cap */
+/* */
+int regional_icheck_cap(struct All_variables *E, int icap,
+ double theta, double phi, double rad, double junk)
+{
+ double theta_min, theta_max;
+ double phi_min, phi_max;
+
+ /* corner 2 is the north-west corner */
+ /* corner 4 is the south-east corner */
+
+ theta_min = E->trace.theta_cap[icap][2];
+ theta_max = E->trace.theta_cap[icap][4];
+
+ phi_min = E->trace.phi_cap[icap][2];
+ phi_max = E->trace.phi_cap[icap][4];
+
+ if ((theta >= theta_min) && (theta < theta_max) &&
+ (phi >= phi_min) && (phi < phi_max))
+ return 1;
+
+ //TODO: deal with south west bounds
+ return 0;
+}
+
+
+void regional_get_shape_functions(struct All_variables *E,
+ double shp[9], int nelem,
+ double theta, double phi, double rad)
+{
+ int e, i, j, k;
+ int elx, ely, elz;
+ double tr_dx, tr_dy, tr_dz;
+ double dx, dy, dz;
+ double volume;
+
+ elx = E->lmesh.elx;
+ ely = E->lmesh.ely;
+ elz = E->lmesh.elz;
+
+ e = nelem - 1;
+ k = e % elz;
+ i = (e / elz) % elx;
+ j = e / (elz*elx);
+
+
+ /*** comment by Tan2 1/25/2005
+ Find the element that contains the tracer.
+
+ node(i) tracer node(i+1)
+ | * |
+ <----------->
+ tr_dx
+
+ <-------------------------------->
+ dx
+ ***/
+
+ tr_dx = theta - E->trace.x_space[i];
+ dx = E->trace.x_space[i+1] - E->trace.x_space[i];
+
+ tr_dy = phi - E->trace.y_space[j];
+ dy = E->trace.y_space[j+1] - E->trace.y_space[j];
+
+ tr_dz = rad - E->trace.z_space[k];
+ dz = E->trace.z_space[k+1] - E->trace.z_space[k];
+
+
+
+ /*** comment by Tan2 1/25/2005
+ Calculate shape functions from tr_dx, tr_dy, tr_dz
+ This assumes linear element
+ ***/
+
+
+ /* compute volumetic weighting functions */
+ volume = dx*dz*dy;
+
+ shp[1] = (dx-tr_dx) * (dy-tr_dy) * (dz-tr_dz) / volume;
+ shp[2] = tr_dx * (dy-tr_dy) * (dz-tr_dz) / volume;
+ shp[3] = tr_dx * tr_dy * (dz-tr_dz) / volume;
+ shp[4] = (dx-tr_dx) * tr_dy * (dz-tr_dz) / volume;
+ shp[5] = (dx-tr_dx) * (dy-tr_dy) * tr_dz / volume;
+ shp[6] = tr_dx * (dy-tr_dy) * tr_dz / volume;
+ shp[7] = tr_dx * tr_dy * tr_dz / volume;
+ shp[8] = (dx-tr_dx) * tr_dy * tr_dz / volume;
+
+ /** debug **
+ fprintf(E->trace.fpt, "dr=(%e,%e,%e) tr_dr=(%e,%e,%e)\n",
+ dx, dy, dz, tr_dx, tr_dy, tr_dz);
+ fprintf(E->trace.fpt, "shp: %e %e %e %e %e %e %e %e\n",
+ shp[1], shp[2], shp[3], shp[4], shp[5], shp[6], shp[7], shp[8]);
+ fprintf(E->trace.fpt, "sum(shp): %e\n",
+ shp[1]+ shp[2]+ shp[3]+ shp[4]+ shp[5]+ shp[6]+ shp[7]+ shp[8]);
+ fflush(E->trace.fpt);
+ /**/
+ return;
+}
+
+
+double regional_interpolate_data(struct All_variables *E,
+ double shp[9], double data[9])
+{
+ int n;
+ double result = 0;
+
+ for(n=1; n<=8; n++)
+ result += data[n] * shp[n];
+
+ return result;
+}
+
+
+/******** GET VELOCITY ***************************************/
+
+void regional_get_velocity(struct All_variables *E,
+ int m, int nelem,
+ double theta, double phi, double rad,
+ double *velocity_vector)
+{
+ double shp[9], VV[4][9], tmp;
+ int n, d, node;
+ const int sphere_key = 0;
+
+ /* get shape functions at (theta, phi, rad) */
+ regional_get_shape_functions(E, shp, nelem, theta, phi, rad);
+
+
+ /* get cartesian velocity */
+ velo_from_element_d(E, VV, m, nelem, sphere_key);
+
+
+ /*** comment by Tan2 1/25/2005
+ Interpolate the velocity on the tracer position
+ ***/
+
+ for(d=1; d<=3; d++)
+ velocity_vector[d] = 0;
+
+
+ for(d=1; d<=3; d++) {
+ for(n=1; n<=8; n++)
+ velocity_vector[d] += VV[d][n] * shp[n];
+ }
+
+
+ /** debug **
+ for(d=1; d<=3; d++) {
+ fprintf(E->trace.fpt, "VV: %e %e %e %e %e %e %e %e: %e\n",
+ VV[d][1], VV[d][2], VV[d][3], VV[d][4],
+ VV[d][5], VV[d][6], VV[d][7], VV[d][8],
+ velocity_vector[d]);
+ }
+
+ tmp = 0;
+ for(n=1; n<=8; n++)
+ tmp += E->sx[m][1][E->ien[m][nelem].node[n]] * shp[n];
+
+ fprintf(E->trace.fpt, "THETA: %e -> %e\n", theta, tmp);
+
+ fflush(E->trace.fpt);
+ /**/
+
+ return;
+}
+
+
+void regional_keep_within_bounds(struct All_variables *E,
+ double *x, double *y, double *z,
+ double *theta, double *phi, double *rad)
+{
+ int changed = 0;
+
+ if (*theta > E->control.theta_max - E->trace.box_cushion) {
+ *theta = E->control.theta_max - E->trace.box_cushion;
+ changed = 1;
+ }
+
+ if (*theta < E->control.theta_min + E->trace.box_cushion) {
+ *theta = E->control.theta_min + E->trace.box_cushion;
+ changed = 1;
+ }
+
+ if (*phi > E->control.fi_max - E->trace.box_cushion) {
+ *phi = E->control.fi_max - E->trace.box_cushion;
+ changed = 1;
+ }
+
+ if (*phi < E->control.fi_min + E->trace.box_cushion) {
+ *phi = E->control.fi_min + E->trace.box_cushion;
+ changed = 1;
+ }
+
+ if (*rad > E->sphere.ro - E->trace.box_cushion) {
+ *rad = E->sphere.ro - E->trace.box_cushion;
+ changed = 1;
+ }
+
+ if (*rad < E->sphere.ri + E->trace.box_cushion) {
+ *rad = E->sphere.ri + E->trace.box_cushion;
+ changed = 1;
+ }
+
+ if (changed)
+ sphere_to_cart(E, *theta, *phi, *rad, x, y, z);
+
+
+ return;
+}
+
+
+void regional_lost_souls(struct All_variables *E)
+{
+ /* This part only works if E->sphere.caps_per_proc==1 */
+ const int j = 1;
+ int lev = E->mesh.levmax;
+
+ int i, d, kk;
+ int max_send_size, isize, itemp_size;
+
+ int ngbr_rank[6+1];
+
+ double bounds[3][2];
+ double *send[2];
+ double *recv[2];
+
+ int ipass;
+
+ MPI_Status status[4];
+ MPI_Request request[4];
+
+ double begin_time = CPU_time0();
+
+ E->trace.istat_isend = E->trace.ilater[j];
+
+ /* the bounding box */
+ for (d=0; d<E->mesh.nsd; d++) {
+ bounds[d][0] = E->sx[j][d+1][1];
+ bounds[d][1] = E->sx[j][d+1][E->lmesh.nno];
+ }
+
+ /* set up ranks for neighboring procs */
+ /* if ngbr_rank is -1, there is no neighbor on this side */
+ ipass = 1;
+ for (kk=1; kk<=6; kk++) {
+ if (E->parallel.NUM_PASS[lev][j].bound[kk] == 1) {
+ ngbr_rank[kk] = E->parallel.PROCESSOR[lev][j].pass[ipass];
+ ipass++;
+ }
+ else {
+ ngbr_rank[kk] = -1;
+ }
+ }
+
+ /* debug *
+ for (kk=1; kk<=E->trace.istat_isend; kk++) {
+ fprintf(E->trace.fpt, "tracer#=%d xx=(%g,%g,%g)\n", kk,
+ E->trace.rlater[j][0][kk],
+ E->trace.rlater[j][1][kk],
+ E->trace.rlater[j][2][kk]);
+ }
+
+ for (d=0; d<E->mesh.nsd; d++) {
+ fprintf(E->trace.fpt, "bounds(dim=%d) = (%e, %e)\n",
+ d, bounds[d][0], bounds[d][1]);
+ }
+
+ for (kk=1; kk<=6; kk++) {
+ fprintf(E->trace.fpt, "pass=%d neighbor_rank=%d\n",
+ kk, ngbr_rank[kk]);
+ }
+ fflush(E->trace.fpt);
+ parallel_process_sync(E);
+ /**/
+
+
+ /* Allocate Maximum Memory to Send Arrays */
+ max_send_size = max(2*E->trace.ilater[j], E->trace.ntracers[j]/100);
+ itemp_size = max_send_size * E->trace.number_of_tracer_quantities;
+
+ if ((send[0] = (double *)malloc(itemp_size*sizeof(double)))
+ == NULL) {
+ fprintf(E->trace.fpt,"Error(lost souls)-no memory (u388)\n");
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+ if ((send[1] = (double *)malloc(itemp_size*sizeof(double)))
+ == NULL) {
+ fprintf(E->trace.fpt,"Error(lost souls)-no memory (u389)\n");
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+
+
+ for (d=0; d<E->mesh.nsd; d++) {
+ int original_size = E->trace.ilater[j];
+ int idb;
+ int kk = 1;
+ int isend[2], irecv[2];
+ isend[0] = isend[1] = 0;
+
+
+ /* move out-of-bound tracers to send array */
+ while (kk<=E->trace.ilater[j]) {
+ double coord;
+
+ /* Is the tracer within the bounds in the d-th dimension */
+ coord = E->trace.rlater[j][d][kk];
+
+ if (coord < bounds[d][0]) {
+ put_lost_tracers(E, &(isend[0]), send[0], kk, j);
+ }
+ else if (coord >= bounds[d][1]) {
+ put_lost_tracers(E, &(isend[1]), send[1], kk, j);
+ }
+ else {
+ /* check next tracer */
+ kk++;
+ }
+
+ /* reallocate send if size too small */
+ if ((isend[0] > max_send_size - 5) ||
+ (isend[1] > max_send_size - 5)) {
+
+ isize = max_send_size + max_send_size/4 + 10;
+ itemp_size = isize * E->trace.number_of_tracer_quantities;
+
+ if ((send[0] = (double *)realloc(send[0],
+ itemp_size*sizeof(double)))
+ == NULL) {
+ fprintf(E->trace.fpt,"Error(lost souls)-no memory (s4)\n");
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+ if ((send[1] = (double *)realloc(send[1],
+ itemp_size*sizeof(double)))
+ == NULL) {
+ fprintf(E->trace.fpt,"Error(lost souls)-no memory (s5)\n");
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+
+ fprintf(E->trace.fpt,"Expanding physical memory of send to "
+ "%d from %d\n",
+ isize, max_send_size);
+
+ max_send_size = isize;
+ }
+
+
+ } /* end of while kk */
+
+
+ /* check the total # of tracers is conserved */
+ if ((isend[0] + isend[1] + E->trace.ilater[j]) != original_size) {
+ fprintf(E->trace.fpt, "original_size: %d, rlater_size: %d, "
+ "send_size: %d\n",
+ original_size, E->trace.ilater[j], kk);
+ }
+
+
+ /** debug **
+ for (i=0; i<2; i++) {
+ for (kk=0; kk<isend[i]; kk++) {
+ fprintf(E->trace.fpt, "dim:%d side:%d kk=%d coord[kk]=%e\n",
+ d, i, kk,
+ send[i][kk*E->trace.number_of_tracer_quantities+d]);
+ }
+ }
+ fflush(E->trace.fpt);
+ /**/
+
+
+ /* Send info to other processors regarding number of send tracers */
+
+ /* check whether there is a neighbor in this pass*/
+ idb = 0;
+ for (i=0; i<2; i++) {
+ int target_rank;
+ kk = d*2 + i + 1;
+ target_rank = ngbr_rank[kk];
+ if (target_rank >= 0) {
+ MPI_Isend(&isend[i], 1, MPI_INT, target_rank,
+ 11, E->parallel.world, &request[idb++]);
+
+ MPI_Irecv(&irecv[i], 1, MPI_INT, target_rank,
+ 11, E->parallel.world, &request[idb++]);
+ }
+ else {
+ irecv[i] = 0;
+ }
+ } /* end of for i */
+
+
+ /* Wait for non-blocking calls to complete */
+ MPI_Waitall(idb, request, status);
+
+
+ /** debug **
+ for (i=0; i<2; i++) {
+ int target_rank;
+ kk = d*2 + i + 1;
+ target_rank = ngbr_rank[kk];
+ if (target_rank >= 0) {
+ fprintf(E->trace.fpt, "%d: %d send %d to proc %d\n",
+ d, i, isend[i], target_rank);
+ fprintf(E->trace.fpt, "%d: %d recv %d from proc %d\n",
+ d, i, irecv[i], target_rank);
+ }
+ }
+ parallel_process_sync(E);
+ /**/
+
+ /* Allocate memory in receive arrays */
+ for (i=0; i<2; i++) {
+ isize = irecv[i] * E->trace.number_of_tracer_quantities;
+ itemp_size = max(1, isize);
+
+ if ((recv[i] = (double *)malloc(itemp_size*sizeof(double)))
+ == NULL) {
+ fprintf(E->trace.fpt, "Error(lost souls)-no memory (c721)\n");
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+ }
+
+
+ /* Now, send the tracers to proper procs */
+ idb = 0;
+ for (i=0; i<2; i++) {
+ int target_rank;
+ kk = d*2 + i + 1;
+ target_rank = ngbr_rank[kk];
+ if (target_rank >= 0) {
+ isize = isend[i] * E->trace.number_of_tracer_quantities;
+ MPI_Isend(send[i], isize, MPI_DOUBLE, target_rank,
+ 12, E->parallel.world, &request[idb++]);
+
+ isize = irecv[i] * E->trace.number_of_tracer_quantities;
+ MPI_Irecv(recv[i], isize, MPI_DOUBLE, target_rank,
+ 12, E->parallel.world, &request[idb++]);
+
+ }
+ }
+
+
+ /* Wait for non-blocking calls to complete */
+ MPI_Waitall(idb, request, status);
+
+
+ /** debug **
+ for (i=0; i<2; i++) {
+ for (kk=1; kk<=irecv[i]; kk++) {
+ fprintf(E->trace.fpt, "recv: %d %e %e %e\n",
+ kk,
+ recv[i][(kk-1)*E->trace.number_of_tracer_quantities],
+ recv[i][(kk-1)*E->trace.number_of_tracer_quantities+1],
+ recv[i][(kk-1)*E->trace.number_of_tracer_quantities+2]);
+ }
+ }
+ fflush(E->trace.fpt);
+ parallel_process_sync(E);
+ /**/
+
+ /* put the received tracers */
+ for (i=0; i<2; i++) {
+ put_found_tracers(E, irecv[i], recv[i], j);
+ }
+
+
+ free(recv[0]);
+ free(recv[1]);
+
+ } /* end of for d */
+
+
+ /* rlater should be empty by now */
+ if (E->trace.ilater[j] > 0) {
+ fprintf(E->trace.fpt, "Error(regional_lost_souls) lost tracers\n");
+ for (kk=1; kk<=E->trace.ilater[j]; kk++) {
+ fprintf(E->trace.fpt, "lost #%d xx=(%e, %e, %e)\n", kk,
+ E->trace.rlater[j][0][kk],
+ E->trace.rlater[j][1][kk],
+ E->trace.rlater[j][2][kk]);
+ }
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+
+
+ /* Free Arrays */
+
+ free(send[0]);
+ free(send[1]);
+
+ E->trace.lost_souls_time += CPU_time0() - begin_time;
+ return;
+}
+
+
+static void put_lost_tracers(struct All_variables *E,
+ int *send_size, double *send,
+ int kk, int j)
+{
+ int ilast_tracer, isend_position, ipos;
+ int pp;
+
+ /* move the tracer from rlater to send */
+ isend_position = (*send_size) * E->trace.number_of_tracer_quantities;
+
+ for (pp=0; pp<E->trace.number_of_tracer_quantities; pp++) {
+ ipos = isend_position + pp;
+ send[ipos] = E->trace.rlater[j][pp][kk];
+ }
+ (*send_size)++;
+
+ /* eject the tracer from rlater */
+ ilast_tracer = E->trace.ilater[j];
+ for (pp=0; pp<E->trace.number_of_tracer_quantities; pp++) {
+ E->trace.rlater[j][pp][kk] = E->trace.rlater[j][pp][ilast_tracer];
+ }
+ E->trace.ilater[j]--;
+
+ return;
+}
+
+
+/****************************************************************/
+/* Put the received tracers in basiq & extraq, if within bounds */
+/* Otherwise, append to rlater for sending to another proc */
+
+static void put_found_tracers(struct All_variables *E,
+ int recv_size, double *recv,
+ int j)
+{
+ int kk, pp;
+ int ipos, ilast, inside, iel;
+ double theta, phi, rad;
+
+ for (kk=0; kk<recv_size; kk++) {
+ ipos = kk * E->trace.number_of_tracer_quantities;
+ theta = recv[ipos];
+ phi = recv[ipos + 1];
+ rad = recv[ipos + 2];
+
+ /* check whether this tracer is inside this proc */
+ /* check radius first, since it is cheaper */
+ inside = icheck_processor_shell(E, j, rad);
+ if (inside == 1)
+ inside = regional_icheck_cap(E, 0, theta, phi, rad, rad);
+ else
+ inside = 0;
+
+ /** debug **
+ fprintf(E->trace.fpt, "kk=%d, inside=%d, xx=(%e, %e, %e)\n",
+ kk, inside, theta, phi, rad);
+ fprintf(E->trace.fpt, "before: %d %d\n",
+ E->trace.ilater[j], E->trace.ntracers[j]);
+ /**/
+
+ if (inside) {
+
+ E->trace.ntracers[j]++;
+ ilast = E->trace.ntracers[j];
+
+ if (E->trace.ntracers[j] > (E->trace.max_ntracers[j]-5))
+ expand_tracer_arrays(E, j);
+
+ for (pp=0; pp<E->trace.number_of_basic_quantities; pp++)
+ E->trace.basicq[j][pp][ilast] = recv[ipos+pp];
+
+ ipos += E->trace.number_of_basic_quantities;
+ for (pp=0; pp<E->trace.number_of_extra_quantities; pp++)
+ E->trace.extraq[j][pp][ilast] = recv[ipos+pp];
+
+
+ /* found the element */
+ iel = regional_iget_element(E, j, -99, 0, 0, 0, theta, phi, rad);
+
+ if (iel<1) {
+ fprintf(E->trace.fpt, "Error(regional lost souls) - "
+ "element not here?\n");
+ fprintf(E->trace.fpt, "theta, phi, rad: %f %f %f\n",
+ theta, phi, rad);
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+
+ E->trace.ielement[j][ilast] = iel;
+
+ }
+ else {
+ if (E->trace.ilatersize[j]==0) {
+
+ E->trace.ilatersize[j]=E->trace.max_ntracers[j]/5;
+
+ for (kk=0;kk<E->trace.number_of_tracer_quantities;kk++) {
+ if ((E->trace.rlater[j][kk]=(double *)malloc(E->trace.ilatersize[j]*sizeof(double)))==NULL) {
+ fprintf(E->trace.fpt,"AKM(put_found_tracers)-no memory (%d)\n",kk);
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+ }
+ } /* end first particle initiating memory allocation */
+
+ E->trace.ilater[j]++;
+ ilast = E->trace.ilater[j];
+
+ if (E->trace.ilater[j] > (E->trace.ilatersize[j]-5))
+ expand_later_array(E, j);
+
+ for (pp=0; pp<E->trace.number_of_tracer_quantities; pp++)
+ E->trace.rlater[j][pp][ilast] = recv[ipos+pp];
+ } /* end of if-else */
+
+ /** debug **
+ fprintf(E->trace.fpt, "after: %d %d\n",
+ E->trace.ilater[j], E->trace.ntracers[j]);
+ fflush(E->trace.fpt);
+ /**/
+
+ } /* end of for kk */
+
+ return;
+}
Deleted: mc/3D/CitcomS/branches/cxx/lib/Regional_version_dependent.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Regional_version_dependent.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Regional_version_dependent.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,299 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-#include <math.h>
-
-#include "global_defs.h"
-#include "parallel_related.h"
-
-void get_r_spacing_fine(double *,struct All_variables *);
-void get_r_spacing_at_levels(double *,struct All_variables *);
-
-#ifdef USE_GGRD
-void ggrd_reg_temp_init(struct All_variables *);
-#endif
-
-
-/* =================================================
- Standard node positions including mesh refinement
-
- ================================================= */
-
-void regional_node_locations(E)
- struct All_variables *E;
-{
- int i,j,k,lev;
- double ro,dr,*rr,*RR,fo;
- float tt1;
- int nox,noy,noz,step;
- int nn;
- char output_file[255];
- char a[100];
- FILE *fp1;
-
- void regional_coord_of_cap();
- void compute_angle_surf_area ();
- void parallel_process_termination();
- void myerror();
-
- rr = (double *) malloc((E->mesh.noz+1)*sizeof(double));
- RR = (double *) malloc((E->mesh.noz+1)*sizeof(double));
- nox=E->mesh.nox;
- noy=E->mesh.noy;
- noz=E->mesh.noz;
-
-
- switch(E->control.coor) {
- case 0:
- /* default: regular node spacing */
- dr = (E->sphere.ro-E->sphere.ri)/(E->mesh.noz-1);
- for (k=1;k<=E->mesh.noz;k++) {
- rr[k] = E->sphere.ri + (k-1)*dr;
- }
- break;
- case 1:
- /* get nodal levels from file */
- sprintf(output_file,"%s",E->control.coor_file);
- fp1=fopen(output_file,"r");
- if (fp1 == NULL) {
- fprintf(E->fp,"(Nodal_mesh.c #1) Cannot open %s\n",output_file);
- exit(8);
- }
-
- fscanf(fp1,"%s %d",a,&i);
- for(i=1;i<=nox;i++)
- fscanf(fp1,"%d %f",&nn,&tt1);
-
- fscanf(fp1,"%s %d",a,&i);
- for(i=1;i<=noy;i++)
- fscanf(fp1,"%d %f",&nn,&tt1);
-
- fscanf(fp1,"%s %d",a,&i);
- for (k=1;k<=E->mesh.noz;k++) {
- fscanf(fp1,"%d %f",&nn,&tt1);
- rr[k]=tt1;
- }
- E->sphere.ri = rr[1];
- E->sphere.ro = rr[E->mesh.noz];
-
- fclose(fp1);
- break;
- case 2:
- /* higher radial spacing in top and bottom fractions */
- get_r_spacing_fine(rr, E);
- break;
- case 3:
- /* assign radial spacing CitcomCU style */
- get_r_spacing_at_levels(rr,E);
- break;
- default:
- myerror(E,"regional_version_dependent: coor mode not implemented");
- break;
- }
-
-
-
- for (i=1;i<=E->lmesh.noz;i++) {
- k = E->lmesh.nzs+i-1;
- RR[i] = rr[k];
- }
-
- for (lev=E->mesh.levmin;lev<=E->mesh.levmax;lev++) {
-
- if (E->control.NMULTIGRID||E->control.EMULTIGRID)
- step = (int) pow(2.0,(double)(E->mesh.levmax-lev));
- else
- step = 1;
-
- for (i=1;i<=E->lmesh.NOZ[lev];i++)
- E->sphere.R[lev][i] = RR[(i-1)*step+1];
-
- } /* lev */
-
-
- for (j=1;j<=E->sphere.caps_per_proc;j++) {
- regional_coord_of_cap(E,j,0);
- }
-
-
- if (E->control.verbose) {
- for (lev=E->mesh.levmin;lev<=E->mesh.levmax;lev++) {
- fprintf(E->fp_out,"output_coordinates before rotation %d \n",lev);
- for (j=1;j<=E->sphere.caps_per_proc;j++) {
- fprintf(E->fp_out,"output_coordinates for cap %d %d\n",j,E->lmesh.NNO[lev]);
- for (i=1;i<=E->lmesh.NNO[lev];i++)
- if(i%E->lmesh.NOZ[lev]==1)
- fprintf(E->fp_out,"%d %d %g %g %g\n",j,i,E->SX[lev][j][1][i],E->SX[lev][j][2][i],E->SX[lev][j][3][i]);
- }
- }
- fflush(E->fp_out);
- }
-
- compute_angle_surf_area (E); /* used for interpolation */
-#ifdef ALLOW_ELLIPTICAL
- if(E->data.use_ellipse)
- myerror("ellipticity not implemented for regional code",E);
-#endif
- for (lev=E->mesh.levmin;lev<=E->mesh.levmax;lev++)
- for (j=1;j<=E->sphere.caps_per_proc;j++)
- for (i=1;i<=E->lmesh.NNO[lev];i++) {
- E->SinCos[lev][j][0][i] = sin(E->SX[lev][j][1][i]);
- E->SinCos[lev][j][1][i] = sin(E->SX[lev][j][2][i]);
- E->SinCos[lev][j][2][i] = cos(E->SX[lev][j][1][i]);
- E->SinCos[lev][j][3][i] = cos(E->SX[lev][j][2][i]);
- }
-
-/*
- if (E->parallel.me_loc[3]==E->parallel.nprocz-1) {
- sprintf(output_file,"coord.%d",E->parallel.me);
- fp=fopen(output_file,"w");
- if (fp == NULL) {
- fprintf(E->fp,"(Nodal_mesh.c #2) Cannot open %s\n",output_file);
- exit(8);
- }
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
- for(i=1;i<=E->lmesh.noy;i++) {
- for(j=1;j<=E->lmesh.nox;j++) {
- node=1+(j-1)*E->lmesh.noz+(i-1)*E->lmesh.nox*E->lmesh.noz;
- t1 = 90.0-E->sx[m][1][node]/M_PI*180.0;
- f1 = E->sx[m][2][node]/M_PI*180.0;
- fprintf(fp,"%f %f\n",t1,f1);
- }
- fprintf(fp,">\n");
- }
- for(j=1;j<=E->lmesh.nox;j++) {
- for(i=1;i<=E->lmesh.noy;i++) {
- node=1+(j-1)*E->lmesh.noz+(i-1)*E->lmesh.nox*E->lmesh.noz;
- t1 = 90.0-E->sx[m][1][node]/M_PI*180.0;
- f1 = E->sx[m][2][node]/M_PI*180.0;
- fprintf(fp,"%f %f\n",t1,f1);
- }
- fprintf(fp,">\n");
- }
- }
- fclose(fp);
- }
-*/
-
-
- if (E->control.verbose) {
- for (lev=E->mesh.levmin;lev<=E->mesh.levmax;lev++) {
- fprintf(E->fp_out,"output_coordinates after rotation %d \n",lev);
- for (j=1;j<=E->sphere.caps_per_proc;j++)
- for (i=1;i<=E->lmesh.NNO[lev];i++)
- if(i%E->lmesh.NOZ[lev]==1)
- fprintf(E->fp_out,"%d %d %g %g %g\n",j,i,E->SX[lev][j][1][i],E->SX[lev][j][2][i],E->SX[lev][j][3][i]);
- }
- fflush(E->fp_out);
- }
- free((void *)rr);
- free((void *)RR);
-
- return;
-}
-
-
-
-/* setup boundary node and element arrays for bookkeeping */
-
-void regional_construct_boundary( struct All_variables *E)
-{
- const int dims=E->mesh.nsd;
-
- int m, i, j, k, d, el, count;
- int isBoundary;
- int normalFlag[4];
-
- /* boundary = all - interior */
- int max_size = E->lmesh.elx*E->lmesh.ely*E->lmesh.elz
- - (E->lmesh.elx-2)*(E->lmesh.ely-2)*(E->lmesh.elz-2) + 1;
-
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
- E->boundary.element[m] = (int *)malloc(max_size*sizeof(int));
-
- for(d=1; d<=dims; d++)
- E->boundary.normal[m][d] = (int *)malloc(max_size*sizeof(int));
-
- }
-
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
- count = 1;
- for(k=1; k<=E->lmesh.ely; k++)
- for(j=1; j<=E->lmesh.elx; j++)
- for(i=1; i<=E->lmesh.elz; i++) {
-
- isBoundary = 0;
- for(d=1; d<=dims; d++)
- normalFlag[d] = 0;
-
- if((E->parallel.me_loc[1] == 0) && (j == 1)) {
- isBoundary = 1;
- normalFlag[1] = -1;
- }
-
- if((E->parallel.me_loc[1] == E->parallel.nprocx - 1)
- && (j == E->lmesh.elx)) {
- isBoundary = 1;
- normalFlag[1] = 1;
- }
-
- if((E->parallel.me_loc[2] == 0) && (k == 1)) {
- isBoundary = 1;
- normalFlag[2] = -1;
- }
-
- if((E->parallel.me_loc[2] == E->parallel.nprocy - 1)
- && (k == E->lmesh.ely)) {
- isBoundary = 1;
- normalFlag[2] = 1;
- }
-
- if((E->parallel.me_loc[3] == 0) && (i == 1)) {
- isBoundary = 1;
- normalFlag[3] = -1;
- }
-
- if((E->parallel.me_loc[3] == E->parallel.nprocz - 1)
- && (i == E->lmesh.elz)) {
- isBoundary = 1;
- normalFlag[3] = 1;
- }
-
- if(isBoundary) {
- el = i + (j-1)*E->lmesh.elz + (k-1)*E->lmesh.elz*E->lmesh.elx;
- E->boundary.element[m][count] = el;
- for(d=1; d<=dims; d++)
- E->boundary.normal[m][d][count] = normalFlag[d];
-
- ++count;
- }
-
- } /* end for i, j, k */
-
- E->boundary.nel = count - 1;
- } /* end for m */
-}
Copied: mc/3D/CitcomS/branches/cxx/lib/Regional_version_dependent.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Regional_version_dependent.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Regional_version_dependent.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Regional_version_dependent.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,296 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+#include <math.h>
+
+#include "global_defs.h"
+#include "parallel_related.h"
+
+#include "cproto.h"
+
+
+void get_r_spacing_fine(double *,struct All_variables *);
+void get_r_spacing_at_levels(double *,struct All_variables *);
+
+#ifdef USE_GGRD
+void ggrd_reg_temp_init(struct All_variables *);
+#endif
+
+
+/* =================================================
+ Standard node positions including mesh refinement
+
+ ================================================= */
+
+void regional_node_locations(struct All_variables *E)
+{
+ int i,j,k,lev;
+ double ro,dr,*rr,*RR,fo;
+ float tt1;
+ int nox,noy,noz,step;
+ int nn;
+ char output_file[255];
+ char a[100];
+ FILE *fp1;
+
+ rr = (double *) malloc((E->mesh.noz+1)*sizeof(double));
+ RR = (double *) malloc((E->mesh.noz+1)*sizeof(double));
+ nox=E->mesh.nox;
+ noy=E->mesh.noy;
+ noz=E->mesh.noz;
+
+
+ switch(E->control.coor) {
+ case 0:
+ /* default: regular node spacing */
+ dr = (E->sphere.ro-E->sphere.ri)/(E->mesh.noz-1);
+ for (k=1;k<=E->mesh.noz;k++) {
+ rr[k] = E->sphere.ri + (k-1)*dr;
+ }
+ break;
+ case 1:
+ /* get nodal levels from file */
+ sprintf(output_file,"%s",E->control.coor_file);
+ fp1=fopen(output_file,"r");
+ if (fp1 == NULL) {
+ fprintf(E->fp,"(Nodal_mesh.c #1) Cannot open %s\n",output_file);
+ exit(8);
+ }
+
+ fscanf(fp1,"%s %d",a,&i);
+ for(i=1;i<=nox;i++)
+ fscanf(fp1,"%d %f",&nn,&tt1);
+
+ fscanf(fp1,"%s %d",a,&i);
+ for(i=1;i<=noy;i++)
+ fscanf(fp1,"%d %f",&nn,&tt1);
+
+ fscanf(fp1,"%s %d",a,&i);
+ for (k=1;k<=E->mesh.noz;k++) {
+ fscanf(fp1,"%d %f",&nn,&tt1);
+ rr[k]=tt1;
+ }
+ E->sphere.ri = rr[1];
+ E->sphere.ro = rr[E->mesh.noz];
+
+ fclose(fp1);
+ break;
+ case 2:
+ /* higher radial spacing in top and bottom fractions */
+ get_r_spacing_fine(rr, E);
+ break;
+ case 3:
+ /* assign radial spacing CitcomCU style */
+ get_r_spacing_at_levels(rr,E);
+ break;
+ default:
+ myerror(E,"regional_version_dependent: coor mode not implemented");
+ break;
+ }
+
+
+
+ for (i=1;i<=E->lmesh.noz;i++) {
+ k = E->lmesh.nzs+i-1;
+ RR[i] = rr[k];
+ }
+
+ for (lev=E->mesh.levmin;lev<=E->mesh.levmax;lev++) {
+
+ if (E->control.NMULTIGRID||E->control.EMULTIGRID)
+ step = (int) pow(2.0,(double)(E->mesh.levmax-lev));
+ else
+ step = 1;
+
+ for (i=1;i<=E->lmesh.NOZ[lev];i++)
+ E->sphere.R[lev][i] = RR[(i-1)*step+1];
+
+ } /* lev */
+
+
+ for (j=1;j<=E->sphere.caps_per_proc;j++) {
+ regional_coord_of_cap(E,j,0);
+ }
+
+
+ if (E->control.verbose) {
+ for (lev=E->mesh.levmin;lev<=E->mesh.levmax;lev++) {
+ fprintf(E->fp_out,"output_coordinates before rotation %d \n",lev);
+ for (j=1;j<=E->sphere.caps_per_proc;j++) {
+ fprintf(E->fp_out,"output_coordinates for cap %d %d\n",j,E->lmesh.NNO[lev]);
+ for (i=1;i<=E->lmesh.NNO[lev];i++)
+ if(i%E->lmesh.NOZ[lev]==1)
+ fprintf(E->fp_out,"%d %d %g %g %g\n",j,i,E->SX[lev][j][1][i],E->SX[lev][j][2][i],E->SX[lev][j][3][i]);
+ }
+ }
+ fflush(E->fp_out);
+ }
+
+ compute_angle_surf_area (E); /* used for interpolation */
+#ifdef ALLOW_ELLIPTICAL
+ if(E->data.use_ellipse)
+ myerror("ellipticity not implemented for regional code",E);
+#endif
+ for (lev=E->mesh.levmin;lev<=E->mesh.levmax;lev++)
+ for (j=1;j<=E->sphere.caps_per_proc;j++)
+ for (i=1;i<=E->lmesh.NNO[lev];i++) {
+ E->SinCos[lev][j][0][i] = sin(E->SX[lev][j][1][i]);
+ E->SinCos[lev][j][1][i] = sin(E->SX[lev][j][2][i]);
+ E->SinCos[lev][j][2][i] = cos(E->SX[lev][j][1][i]);
+ E->SinCos[lev][j][3][i] = cos(E->SX[lev][j][2][i]);
+ }
+
+/*
+ if (E->parallel.me_loc[3]==E->parallel.nprocz-1) {
+ sprintf(output_file,"coord.%d",E->parallel.me);
+ fp=fopen(output_file,"w");
+ if (fp == NULL) {
+ fprintf(E->fp,"(Nodal_mesh.c #2) Cannot open %s\n",output_file);
+ exit(8);
+ }
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+ for(i=1;i<=E->lmesh.noy;i++) {
+ for(j=1;j<=E->lmesh.nox;j++) {
+ node=1+(j-1)*E->lmesh.noz+(i-1)*E->lmesh.nox*E->lmesh.noz;
+ t1 = 90.0-E->sx[m][1][node]/M_PI*180.0;
+ f1 = E->sx[m][2][node]/M_PI*180.0;
+ fprintf(fp,"%f %f\n",t1,f1);
+ }
+ fprintf(fp,">\n");
+ }
+ for(j=1;j<=E->lmesh.nox;j++) {
+ for(i=1;i<=E->lmesh.noy;i++) {
+ node=1+(j-1)*E->lmesh.noz+(i-1)*E->lmesh.nox*E->lmesh.noz;
+ t1 = 90.0-E->sx[m][1][node]/M_PI*180.0;
+ f1 = E->sx[m][2][node]/M_PI*180.0;
+ fprintf(fp,"%f %f\n",t1,f1);
+ }
+ fprintf(fp,">\n");
+ }
+ }
+ fclose(fp);
+ }
+*/
+
+
+ if (E->control.verbose) {
+ for (lev=E->mesh.levmin;lev<=E->mesh.levmax;lev++) {
+ fprintf(E->fp_out,"output_coordinates after rotation %d \n",lev);
+ for (j=1;j<=E->sphere.caps_per_proc;j++)
+ for (i=1;i<=E->lmesh.NNO[lev];i++)
+ if(i%E->lmesh.NOZ[lev]==1)
+ fprintf(E->fp_out,"%d %d %g %g %g\n",j,i,E->SX[lev][j][1][i],E->SX[lev][j][2][i],E->SX[lev][j][3][i]);
+ }
+ fflush(E->fp_out);
+ }
+ free((void *)rr);
+ free((void *)RR);
+
+ return;
+}
+
+
+
+/* setup boundary node and element arrays for bookkeeping */
+
+void regional_construct_boundary( struct All_variables *E)
+{
+ const int dims=E->mesh.nsd;
+
+ int m, i, j, k, d, el, count;
+ int isBoundary;
+ int normalFlag[4];
+
+ /* boundary = all - interior */
+ int max_size = E->lmesh.elx*E->lmesh.ely*E->lmesh.elz
+ - (E->lmesh.elx-2)*(E->lmesh.ely-2)*(E->lmesh.elz-2) + 1;
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+ E->boundary.element[m] = (int *)malloc(max_size*sizeof(int));
+
+ for(d=1; d<=dims; d++)
+ E->boundary.normal[m][d] = (int *)malloc(max_size*sizeof(int));
+
+ }
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+ count = 1;
+ for(k=1; k<=E->lmesh.ely; k++)
+ for(j=1; j<=E->lmesh.elx; j++)
+ for(i=1; i<=E->lmesh.elz; i++) {
+
+ isBoundary = 0;
+ for(d=1; d<=dims; d++)
+ normalFlag[d] = 0;
+
+ if((E->parallel.me_loc[1] == 0) && (j == 1)) {
+ isBoundary = 1;
+ normalFlag[1] = -1;
+ }
+
+ if((E->parallel.me_loc[1] == E->parallel.nprocx - 1)
+ && (j == E->lmesh.elx)) {
+ isBoundary = 1;
+ normalFlag[1] = 1;
+ }
+
+ if((E->parallel.me_loc[2] == 0) && (k == 1)) {
+ isBoundary = 1;
+ normalFlag[2] = -1;
+ }
+
+ if((E->parallel.me_loc[2] == E->parallel.nprocy - 1)
+ && (k == E->lmesh.ely)) {
+ isBoundary = 1;
+ normalFlag[2] = 1;
+ }
+
+ if((E->parallel.me_loc[3] == 0) && (i == 1)) {
+ isBoundary = 1;
+ normalFlag[3] = -1;
+ }
+
+ if((E->parallel.me_loc[3] == E->parallel.nprocz - 1)
+ && (i == E->lmesh.elz)) {
+ isBoundary = 1;
+ normalFlag[3] = 1;
+ }
+
+ if(isBoundary) {
+ el = i + (j-1)*E->lmesh.elz + (k-1)*E->lmesh.elz*E->lmesh.elx;
+ E->boundary.element[m][count] = el;
+ for(d=1; d<=dims; d++)
+ E->boundary.normal[m][d][count] = normalFlag[d];
+
+ ++count;
+ }
+
+ } /* end for i, j, k */
+
+ E->boundary.nel = count - 1;
+ } /* end for m */
+}
Deleted: mc/3D/CitcomS/branches/cxx/lib/Shape_functions.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Shape_functions.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Shape_functions.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,223 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-/* Functions which construct the shape function values at all of the gauss
- points in the element (including the reduced quadrature points). The element in question is
- biquadratic in the velocities and therefore bilinear in the pressures.
-
- To change elements it is necessary to change this file: Shape_functions.c,
- and the element-data header file : element_definitions.h but it should not be
- necessary to change the main calculation/setup/solving machinery. */
-
-#include <math.h>
-#include "element_definitions.h"
-#include "global_defs.h"
-
-/* =======================================================
- Function creating shape_fn data in form of a structure
- =======================================================*/
-
-void construct_shape_functions(E)
- struct All_variables *E;
-{
- double lpoly(),lpolydash();
- int i,j,k,d,dd;
- int remapj,remapk;
-
- /* first zero ALL entries, even those not used in 2d. */
-
- for(i=0;i<GNVI;i++)
- { E->N.vpt[i] = 0.0;
- E->Nx.vpt[i] = 0.0;
- E->Nx.vpt[GNVI+i] = 0.0;
- E->Nx.vpt[2*GNVI+i] = 0.0;
- }
-
- for(i=0;i<GNPI;i++)
- { E->N.ppt[i] = 0.0;
- E->Nx.ppt[i] = 0.0;
- E->Nx.ppt[GNPI+i] = 0.0;
- E->Nx.ppt[2*GNPI+i] = 0.0;
- }
-
- for(i=0;i<GN1VI;i++)
- { E->M.vpt[i] = 0.0;
- E->Mx.vpt[i] = 0.0;
- E->Mx.vpt[GN1VI+i] = 0.0;
- }
-
- for(i=0;i<GN1PI;i++)
- { E->M.ppt[i] = 0.0;
- E->Mx.ppt[i] = 0.0;
- E->Mx.ppt[GN1PI+i] = 0.0;
- }
-
- for(i=0;i<GN1VI;i++)
- { E->L.vpt[i] = 0.0;
- E->Lx.vpt[i] = 0.0;
- E->Lx.vpt[GN1VI+i] = 0.0;
- }
-
- for(i=0;i<GNVI;i++)
- { E->NM.vpt[i] = 0.0;
- E->NMx.vpt[i] = 0.0;
- E->NMx.vpt[GNVI+i] = 0.0;
- E->NMx.vpt[2*GNVI+i] = 0.0;
- }
-
- for(i=1;i<=enodes[E->mesh.nsd];i++) {
- /* for each node */
-
- for(j=1;j<=vpoints[E->mesh.nsd];j++) {
-
- /* for each integration point */
- E->N.vpt[GNVINDEX(i,j)] = 1.0;
- for(d=1;d<=E->mesh.nsd;d++)
- E->N.vpt[GNVINDEX(i,j)] *=
- lpoly(bb[d-1][i],g_point[j].x[d-1]);
-
- for(dd=1;dd<=E->mesh.nsd;dd++) {
- E->Nx.vpt[GNVXINDEX(dd-1,i,j)] = lpolydash(bb[dd-1][i],g_point[j].x[dd-1]);
- for(d=1;d<=E->mesh.nsd;d++)
- if (d != dd)
- E->Nx.vpt[GNVXINDEX(dd-1,i,j)] *= lpoly(bb[d-1][i],g_point[j].x[d-1]);
- }
- }
-
-
- for(j=1;j<=ppoints[E->mesh.nsd];j++) {
- /* for each p-integration point */
- E->N.ppt[GNPINDEX(i,j)] = 1.0;
- for(d=1;d<=E->mesh.nsd;d++)
- E->N.ppt[GNPINDEX(i,j)] *=
- lpoly(bb[d-1][i],p_point[j].x[d-1]);
-
- for(dd=1;dd<=E->mesh.nsd;dd++) {
- E->Nx.ppt[GNPXINDEX(dd-1,i,j)] = lpolydash(bb[dd-1][i],p_point[j].x[dd-1]);
- for(d=1;d<=E->mesh.nsd;d++)
- if (d != dd)
- E->Nx.ppt[GNPXINDEX(dd-1,i,j)] *= lpoly(bb[d-1][i],p_point[j].x[d-1]);
- }
- }
- }
-
-
- for(j=1;j<=onedvpoints[E->mesh.nsd];j++)
- for(k=1;k<=onedvpoints[E->mesh.nsd];k++) {
- E->M.vpt[GMVINDEX(j,k)] = 1.0;
- E->L.vpt[GMVINDEX(j,k)] = 1.0;
- for(d=1;d<=E->mesh.nsd-1;d++) {
- E->M.vpt[GMVINDEX(j,k)] *= lpoly(bb[d-1][j],s_point[k].x[d-1]);
- E->L.vpt[GMVINDEX(j,k)] *= lpoly(bb[d-1][j],l_1d[k].x[d-1]);
- }
- for(dd=1;dd<=E->mesh.nsd-1;dd++) {
- E->Mx.vpt[GMVXINDEX(dd-1,j,k)] = lpolydash(bb[dd-1][j],s_point[k].x[d-1]);
- E->Lx.vpt[GMVXINDEX(dd-1,j,k)] = lpolydash(bb[dd-1][j],l_1d[k].x[d-1]);
- for(d=1;d<=E->mesh.nsd-1;d++)
- if (d != dd) {
- E->Mx.vpt[GMVXINDEX(dd-1,j,k)] *= lpoly(bb[d-1][j],s_point[k].x[d-1]);
- E->Lx.vpt[GMVXINDEX(dd-1,j,k)] *= lpoly(bb[d-1][j],l_1d[k].x[d-1]);
- }
- }
- }
-
-
-
-
-
- for(i=1;i<=enodes[E->mesh.nsd];i++) {
- for(j=1;j<=vpoints[E->mesh.nsd];j++) {
- /* for each integration point */
- E->NM.vpt[GNVINDEX(i,j)] = 1.0;
- for(d=1;d<=E->mesh.nsd;d++)
- E->NM.vpt[GNVINDEX(i,j)] *=
- lpoly(bb[d-1][i],s_point[j].x[d-1]);
-
- for(dd=1;dd<=E->mesh.nsd;dd++) {
- E->NMx.vpt[GNVXINDEX(dd-1,i,j)] = lpolydash(bb[dd-1][i],s_point[j].x[dd-1]);
- for(d=1;d<=E->mesh.nsd;d++)
- if (d != dd)
- E->NMx.vpt[GNVXINDEX(dd-1,i,j)] *= lpoly(bb[d-1][i],s_point[j].x[d-1]);
-
- }
- }
-
- }
-
-
- return; }
-
-
-double lpoly(p,y)
- int p; /* selects lagrange polynomial , 1d: node p */
- double y; /* coordinate in given direction to evaluate poly */
-{
- double value;
-
- switch (p)
- {
- case 1:
- value =0.5 * (1-y) ;
- break;
- case 2:
- value =0.5 * (1+y) ;
- break;
- default:
- value = 0.0;
- }
-
- return(value);
-}
-
-double lpolydash(p,y)
- int p;
- double y;
-{
- double value;
- switch (p)
- {
- case 1:
- value = -0.5 ;
- break;
- case 2:
- value = 0.5 ;
- break;
- default:
- value = 0.0;
- }
-
- return(value); }
-
-
-
-
-
-
-
-
-
-
Copied: mc/3D/CitcomS/branches/cxx/lib/Shape_functions.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Shape_functions.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Shape_functions.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Shape_functions.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,217 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+/* Functions which construct the shape function values at all of the gauss
+ points in the element (including the reduced quadrature points). The element in question is
+ biquadratic in the velocities and therefore bilinear in the pressures.
+
+ To change elements it is necessary to change this file: Shape_functions.c,
+ and the element-data header file : element_definitions.h but it should not be
+ necessary to change the main calculation/setup/solving machinery. */
+
+#include <math.h>
+#include "element_definitions.h"
+#include "global_defs.h"
+
+#include "cproto.h"
+
+/* =======================================================
+ Function creating shape_fn data in form of a structure
+ =======================================================*/
+
+void construct_shape_functions(struct All_variables *E)
+{
+ int i,j,k,d,dd;
+ int remapj,remapk;
+
+ /* first zero ALL entries, even those not used in 2d. */
+
+ for(i=0;i<GNVI;i++)
+ { E->N.vpt[i] = 0.0;
+ E->Nx.vpt[i] = 0.0;
+ E->Nx.vpt[GNVI+i] = 0.0;
+ E->Nx.vpt[2*GNVI+i] = 0.0;
+ }
+
+ for(i=0;i<GNPI;i++)
+ { E->N.ppt[i] = 0.0;
+ E->Nx.ppt[i] = 0.0;
+ E->Nx.ppt[GNPI+i] = 0.0;
+ E->Nx.ppt[2*GNPI+i] = 0.0;
+ }
+
+ for(i=0;i<GN1VI;i++)
+ { E->M.vpt[i] = 0.0;
+ E->Mx.vpt[i] = 0.0;
+ E->Mx.vpt[GN1VI+i] = 0.0;
+ }
+
+ for(i=0;i<GN1PI;i++)
+ { E->M.ppt[i] = 0.0;
+ E->Mx.ppt[i] = 0.0;
+ E->Mx.ppt[GN1PI+i] = 0.0;
+ }
+
+ for(i=0;i<GN1VI;i++)
+ { E->L.vpt[i] = 0.0;
+ E->Lx.vpt[i] = 0.0;
+ E->Lx.vpt[GN1VI+i] = 0.0;
+ }
+
+ for(i=0;i<GNVI;i++)
+ { E->NM.vpt[i] = 0.0;
+ E->NMx.vpt[i] = 0.0;
+ E->NMx.vpt[GNVI+i] = 0.0;
+ E->NMx.vpt[2*GNVI+i] = 0.0;
+ }
+
+ for(i=1;i<=enodes[E->mesh.nsd];i++) {
+ /* for each node */
+
+ for(j=1;j<=vpoints[E->mesh.nsd];j++) {
+
+ /* for each integration point */
+ E->N.vpt[GNVINDEX(i,j)] = 1.0;
+ for(d=1;d<=E->mesh.nsd;d++)
+ E->N.vpt[GNVINDEX(i,j)] *=
+ lpoly(bb[d-1][i],g_point[j].x[d-1]);
+
+ for(dd=1;dd<=E->mesh.nsd;dd++) {
+ E->Nx.vpt[GNVXINDEX(dd-1,i,j)] = lpolydash(bb[dd-1][i],g_point[j].x[dd-1]);
+ for(d=1;d<=E->mesh.nsd;d++)
+ if (d != dd)
+ E->Nx.vpt[GNVXINDEX(dd-1,i,j)] *= lpoly(bb[d-1][i],g_point[j].x[d-1]);
+ }
+ }
+
+
+ for(j=1;j<=ppoints[E->mesh.nsd];j++) {
+ /* for each p-integration point */
+ E->N.ppt[GNPINDEX(i,j)] = 1.0;
+ for(d=1;d<=E->mesh.nsd;d++)
+ E->N.ppt[GNPINDEX(i,j)] *=
+ lpoly(bb[d-1][i],p_point[j].x[d-1]);
+
+ for(dd=1;dd<=E->mesh.nsd;dd++) {
+ E->Nx.ppt[GNPXINDEX(dd-1,i,j)] = lpolydash(bb[dd-1][i],p_point[j].x[dd-1]);
+ for(d=1;d<=E->mesh.nsd;d++)
+ if (d != dd)
+ E->Nx.ppt[GNPXINDEX(dd-1,i,j)] *= lpoly(bb[d-1][i],p_point[j].x[d-1]);
+ }
+ }
+ }
+
+
+ for(j=1;j<=onedvpoints[E->mesh.nsd];j++)
+ for(k=1;k<=onedvpoints[E->mesh.nsd];k++) {
+ E->M.vpt[GMVINDEX(j,k)] = 1.0;
+ E->L.vpt[GMVINDEX(j,k)] = 1.0;
+ for(d=1;d<=E->mesh.nsd-1;d++) {
+ E->M.vpt[GMVINDEX(j,k)] *= lpoly(bb[d-1][j],s_point[k].x[d-1]);
+ E->L.vpt[GMVINDEX(j,k)] *= lpoly(bb[d-1][j],l_1d[k].x[d-1]);
+ }
+ for(dd=1;dd<=E->mesh.nsd-1;dd++) {
+ E->Mx.vpt[GMVXINDEX(dd-1,j,k)] = lpolydash(bb[dd-1][j],s_point[k].x[d-1]);
+ E->Lx.vpt[GMVXINDEX(dd-1,j,k)] = lpolydash(bb[dd-1][j],l_1d[k].x[d-1]);
+ for(d=1;d<=E->mesh.nsd-1;d++)
+ if (d != dd) {
+ E->Mx.vpt[GMVXINDEX(dd-1,j,k)] *= lpoly(bb[d-1][j],s_point[k].x[d-1]);
+ E->Lx.vpt[GMVXINDEX(dd-1,j,k)] *= lpoly(bb[d-1][j],l_1d[k].x[d-1]);
+ }
+ }
+ }
+
+
+
+
+
+ for(i=1;i<=enodes[E->mesh.nsd];i++) {
+ for(j=1;j<=vpoints[E->mesh.nsd];j++) {
+ /* for each integration point */
+ E->NM.vpt[GNVINDEX(i,j)] = 1.0;
+ for(d=1;d<=E->mesh.nsd;d++)
+ E->NM.vpt[GNVINDEX(i,j)] *=
+ lpoly(bb[d-1][i],s_point[j].x[d-1]);
+
+ for(dd=1;dd<=E->mesh.nsd;dd++) {
+ E->NMx.vpt[GNVXINDEX(dd-1,i,j)] = lpolydash(bb[dd-1][i],s_point[j].x[dd-1]);
+ for(d=1;d<=E->mesh.nsd;d++)
+ if (d != dd)
+ E->NMx.vpt[GNVXINDEX(dd-1,i,j)] *= lpoly(bb[d-1][i],s_point[j].x[d-1]);
+
+ }
+ }
+
+ }
+
+
+ return; }
+
+
+double lpoly(
+ int p, /* selects lagrange polynomial , 1d: node p */
+ double y /* coordinate in given direction to evaluate poly */
+ )
+{
+ double value;
+
+ switch (p)
+ {
+ case 1:
+ value =0.5 * (1-y) ;
+ break;
+ case 2:
+ value =0.5 * (1+y) ;
+ break;
+ default:
+ value = 0.0;
+ }
+
+ return(value);
+}
+
+double lpolydash(
+ int p,
+ double y
+ )
+{
+ double value;
+ switch (p)
+ {
+ case 1:
+ value = -0.5 ;
+ break;
+ case 2:
+ value = 0.5 ;
+ break;
+ default:
+ value = 0.0;
+ }
+
+ return(value);
+
+}
Deleted: mc/3D/CitcomS/branches/cxx/lib/Size_does_matter.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Size_does_matter.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Size_does_matter.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,1192 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-#include <math.h>
-#include <sys/types.h>
-#include "element_definitions.h"
-#include "global_defs.h"
-
-#ifdef ALLOW_ELLIPTICAL
-double theta_g(double , struct All_variables *);
-#endif
-
-void twiddle_thumbs(yawn,scratch_groin)
- struct All_variables *yawn;
- int scratch_groin;
-
-{ /* Do nothing, just sit back and relax.
- Take it easy for a while, maybe size
- doesn't matter after all. There, there
- that's better. Now ... */
-
- return; }
-
-/* ======================================================================
- ====================================================================== */
-
-static void form_rtf_bc(int k, double x[4],
- double rtf[4][9], double bc[4][4])
-{
- double myatan();
-
- rtf[3][k] = 1.0/sqrt(x[1]*x[1]+x[2]*x[2]+x[3]*x[3]); /* 1/r */
- rtf[1][k] = acos(x[3]*rtf[3][k]); /* theta */
- rtf[2][k] = myatan(x[2],x[1]); /* phi */
-
- bc[1][1] = x[3]*cos(rtf[2][k]); /* theta */
- bc[1][2] = x[3]*sin(rtf[2][k]);
- bc[1][3] = -sin(rtf[1][k])/rtf[3][k];
- bc[2][1] = -x[2]; /* phi basis vector */
- bc[2][2] = x[1];
- bc[2][3] = 0.0;
- bc[3][1] = x[1]*rtf[3][k]; /* */
- bc[3][2] = x[2]*rtf[3][k];
- bc[3][3] = x[3]*rtf[3][k];
-
- return;
-}
-
-
-static void get_global_shape_fn_sph(struct All_variables *E,
- int m, int lev, int el)
-{
- int i,j,k,d,e;
- double jacobian;
- double determinant();
- double cofactor(),myatan();
- void form_rtf_bc();
-
- struct Shape_function_dx LGNx;
-
- double dxda[4][4], cof[4][4], x[4], rtf[4][9], bc[4][4];
-
- const int dims = E->mesh.nsd;
- const int ends = ENODES3D;
- const int vpts = VPOINTS3D;
- const int ppts = PPOINTS3D;
-
-
- for(k=1;k<=vpts;k++) { /* all of the vpoints */
- for(d=1;d<=dims;d++) {
- x[d]=0.0;
- for(e=1;e<=dims;e++)
- dxda[d][e]=0.0;
- }
-
- for(d=1;d<=dims;d++)
- for(i=1;i<=ends;i++)
- x[d] += E->X[lev][m][d][E->IEN[lev][m][el].node[i]]
- * E->N.vpt[GNVINDEX(i,k)];
-
- for(d=1;d<=dims;d++)
- for(e=1;e<=dims;e++)
- for(i=1;i<=ends;i++)
- dxda[d][e] += E->X[lev][m][e][E->IEN[lev][m][el].node[i]]
- * E->Nx.vpt[GNVXINDEX(d-1,i,k)];
-
- jacobian = determinant(dxda, E->mesh.nsd);
- E->GDA[lev][m][el].vpt[k] = jacobian;
-
- for(d=1;d<=dims;d++)
- for(e=1;e<=dims;e++)
- cof[d][e]=cofactor(dxda,d,e,dims);
-
- form_rtf_bc(k,x,rtf,bc);
- for(j=1;j<=ends;j++)
- for(d=1;d<=dims;d++) {
- LGNx.vpt[GNVXINDEX(d-1,j,k)] = 0.0;
- for(e=1;e<=dims;e++)
- LGNx.vpt[GNVXINDEX(d-1,j,k)] +=
- E->Nx.vpt[GNVXINDEX(e-1,j,k)] *cof[e][d];
-
- LGNx.vpt[GNVXINDEX(d-1,j,k)] /= jacobian;
- }
-
- for(j=1;j<=ends;j++)
- for(d=1;d<=dims;d++) {
- E->GNX[lev][m][el].vpt[GNVXINDEX(d-1,j,k)]
- = bc[d][1]*LGNx.vpt[GNVXINDEX(0,j,k)]
- + bc[d][2]*LGNx.vpt[GNVXINDEX(1,j,k)]
- + bc[d][3]*LGNx.vpt[GNVXINDEX(2,j,k)];
- }
- } /* end for k */
-
- for(k=1;k<=ppts;k++) { /* all of the ppoints */
- for(d=1;d<=dims;d++) {
- x[d]=0.0;
- for(e=1;e<=dims;e++)
- dxda[d][e]=0.0;
- }
-
- for(d=1;d<=dims;d++)
- for(i=1;i<=ends;i++)
- x[d] += E->X[lev][m][d][E->IEN[lev][m][el].node[i]]
- * E->N.ppt[GNPINDEX(i,k)];
-
- for(d=1;d<=dims;d++)
- for(e=1;e<=dims;e++)
- for(i=1;i<=ends;i++)
- dxda[d][e] += E->X[lev][m][e][E->IEN[lev][m][el].node[i]]
- * E->Nx.ppt[GNPXINDEX(d-1,i,k)];
-
- jacobian = determinant(dxda,E->mesh.nsd);
- E->GDA[lev][m][el].ppt[k] = jacobian;
-
- for(d=1;d<=dims;d++)
- for(e=1;e<=dims;e++)
- cof[d][e]=cofactor(dxda,d,e,E->mesh.nsd);
-
- form_rtf_bc(k,x,rtf,bc);
- for(j=1;j<=ends;j++)
- for(d=1;d<=dims;d++) {
- LGNx.ppt[GNPXINDEX(d-1,j,k)]=0.0;
- for(e=1;e<=dims;e++)
- LGNx.ppt[GNPXINDEX(d-1,j,k)] +=
- E->Nx.ppt[GNPXINDEX(e-1,j,k)]*cof[e][d];
- LGNx.ppt[GNPXINDEX(d-1,j,k)] /= jacobian;
- }
- for(j=1;j<=ends;j++)
- for(d=1;d<=dims;d++) {
- E->GNX[lev][m][el].ppt[GNPXINDEX(d-1,j,k)]
- = bc[d][1]*LGNx.ppt[GNPXINDEX(0,j,k)]
- + bc[d][2]*LGNx.ppt[GNPXINDEX(1,j,k)]
- + bc[d][3]*LGNx.ppt[GNPXINDEX(2,j,k)];
- }
-
- } /* end for k int */
-
-
- return;
-}
-
-
-void construct_shape_function_derivatives(struct All_variables *E)
-{
- int m, lev, el;
-
- for (m=1; m<=E->sphere.caps_per_proc; m++)
- for(lev=E->mesh.levmax; lev>=E->mesh.levmin; lev--)
- for(el=1; el<=E->lmesh.NEL[lev]; el++) {
- get_global_shape_fn_sph(E, m, lev, el);
- }
-
- return;
-}
-
-
-/*
-
-gets r,theta,phi coordinates at the integration points
-
- */
-void get_rtf_at_vpts(struct All_variables *E, int m, int lev, int el,
- double rtf[4][9])
-{
- int i, k, d;
- double x[4];
-
- double myatan();
-
- const int dims = E->mesh.nsd;
- const int ends = ENODES3D;
- const int vpts = VPOINTS3D;
-
- for(k=1;k<=vpts;k++) { /* all of the vpoints */
- for(d=1;d<=dims;d++)
- x[d]=0.0;
-
- for(d=1;d<=dims;d++)
- for(i=1;i<=ends;i++)
- x[d] += E->X[lev][m][d][E->IEN[lev][m][el].node[i]]
- * E->N.vpt[GNVINDEX(i,k)];
-
- rtf[3][k] = 1.0/sqrt(x[1]*x[1]+x[2]*x[2]+x[3]*x[3]); /* 1/r */
- rtf[1][k] = acos(x[3]*rtf[3][k]); /* theta */
- rtf[2][k] = myatan(x[2],x[1]); /* phi */
- }
-
- return;
-}
-
-
-void get_rtf_at_ppts(struct All_variables *E, int m, int lev, int el,
- double rtf[4][9])
-{
- int i, k, d;
- double x[4];
-
- double myatan();
-
- const int dims = E->mesh.nsd;
- const int ends = ENODES3D;
- const int ppts = PPOINTS3D;
-
- for(k=1;k<=ppts;k++) { /* all of the ppoints */
- for(d=1;d<=dims;d++)
- x[d]=0.0;
-
- for(d=1;d<=dims;d++)
- for(i=1;i<=ends;i++)
- x[d] += E->X[lev][m][d][E->IEN[lev][m][el].node[i]]
- * E->N.ppt[GNPINDEX(i,k)];
-
- rtf[3][k] = 1.0/sqrt(x[1]*x[1]+x[2]*x[2]+x[3]*x[3]);
- rtf[1][k] = acos(x[3]*rtf[3][k]);
- rtf[2][k] = myatan(x[2],x[1]);
- }
-
- return;
-}
-
-
-void get_side_x_cart(struct All_variables *E, double xx[4][5],
- int el, int side, int m)
-{
- double to,fo,dxdy[4][4];
- int i, node, s;
- const int oned = onedvpoints[E->mesh.nsd];
-
-#ifdef ALLOW_ELLIPTICAL
- to = theta_g(E->eco[m][el].centre[1],E);
-#else
- to = E->eco[m][el].centre[1];
-#endif
-
- fo = E->eco[m][el].centre[2];
-
- dxdy[1][1] = cos(to)*cos(fo);
- dxdy[1][2] = cos(to)*sin(fo);
- dxdy[1][3] = -sin(to);
- dxdy[2][1] = -sin(fo);
- dxdy[2][2] = cos(fo);
- dxdy[2][3] = 0.0;
- dxdy[3][1] = sin(to)*cos(fo);
- dxdy[3][2] = sin(to)*sin(fo);
- dxdy[3][3] = cos(to);
-
- for(i=1;i<=oned;i++) { /* nodes */
- s = sidenodes[side][i];
- node = E->ien[m][el].node[s];
- xx[1][i] = E->x[m][1][node]*dxdy[1][1]
- + E->x[m][2][node]*dxdy[1][2]
- + E->x[m][3][node]*dxdy[1][3];
- xx[2][i] = E->x[m][1][node]*dxdy[2][1]
- + E->x[m][2][node]*dxdy[2][2]
- + E->x[m][3][node]*dxdy[2][3];
- xx[3][i] = E->x[m][1][node]*dxdy[3][1]
- + E->x[m][2][node]*dxdy[3][2]
- + E->x[m][3][node]*dxdy[3][3];
- }
-}
-
-
-/* ======================================================================
- ====================================================================== */
-void construct_surf_det (E)
- struct All_variables *E;
-{
-
- int m,i,k,d,e,es,el;
-
- double jacobian;
- double determinant();
- double cofactor();
-
- const int oned = onedvpoints[E->mesh.nsd];
-
- double xx[4][5], dxda[4][4], r2;
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for(k=1;k<=oned;k++) { /* all of the vpoints*/
- E->surf_det[m][k] = (double *)malloc((1+E->lmesh.snel)*sizeof(double));
- }
-
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- r2 = 1.0 / (E->sx[m][3][E->lmesh.elz+1] * E->sx[m][3][E->lmesh.elz+1]);
-
- for (es=1;es<=E->lmesh.snel;es++) {
- el = es * E->lmesh.elz;
- get_side_x_cart(E, xx, el, SIDE_TOP, m);
-
- for(k=1;k<=oned;k++) { /* all of the vpoints*/
- for(d=1;d<=E->mesh.nsd-1;d++)
- for(e=1;e<=E->mesh.nsd-1;e++)
- dxda[d][e]=0.0;
-
- for(i=1;i<=oned;i++) /* nodes */
- for(d=1;d<=E->mesh.nsd-1;d++)
- for(e=1;e<=E->mesh.nsd-1;e++)
- dxda[d][e] += xx[e][i]*E->Mx.vpt[GMVXINDEX(d-1,i,k)];
-
- jacobian = determinant(dxda,E->mesh.nsd-1);
-
- /* scale the jacobian so that it is defined on a unit sphere */
- E->surf_det[m][k][es] = jacobian * r2;
- }
- }
- }
- return;
-}
-
-
-
-/* ======================================================================
- surface (6 sides) determinant of boundary element
- ====================================================================== */
-void construct_bdry_det(struct All_variables *E)
-{
-
- int m,i,k,d,e,es,el,side;
-
- double jacobian;
- double determinant();
- double cofactor();
-
- const int oned = onedvpoints[E->mesh.nsd];
-
- double xx[4][5],dxda[4][4];
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for (side=SIDE_BEGIN; side<=SIDE_END; side++)
- for(d=1; d<=oned; d++)
- E->boundary.det[m][side][d] = (double *)malloc((1+E->boundary.nel)*sizeof(double));
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for (es=1;es<=E->boundary.nel;es++) {
- el = E->boundary.element[m][es];
-
- for (side=SIDE_BEGIN; side<=SIDE_END; side++) {
- get_side_x_cart(E, xx, el, side, m);
-
- for(k=1;k<=oned;k++) { /* all of the vpoints*/
-
- for(d=1;d<=E->mesh.nsd-1;d++)
- for(e=1;e<=E->mesh.nsd-1;e++)
- dxda[d][e]=0.0;
-
- for(i=1;i<=oned;i++) /* nodes */
- for(d=1;d<=E->mesh.nsd-1;d++)
- for(e=1;e<=E->mesh.nsd-1;e++)
- dxda[d][e] += xx[sidedim[side][e]][i]*E->Mx.vpt[GMVXINDEX(d-1,i,k)];
-
- jacobian = determinant(dxda,E->mesh.nsd-1);
- E->boundary.det[m][side][k][es] = jacobian;
- }
-
- /*
- fprintf(stderr, "Boundary det: %d %d- %e %e %e %e; sum = %e\n", el, side,
- E->boundary.det[m][side][1][es],
- E->boundary.det[m][side][2][es],
- E->boundary.det[m][side][3][es],
- E->boundary.det[m][side][4][es],
- E->boundary.det[m][side][1][es]+
- E->boundary.det[m][side][2][es]+
- E->boundary.det[m][side][3][es]+
- E->boundary.det[m][side][4][es]);
- */
- }
-
-
- }
-}
-
-
-
-/* ======================================================================
- ====================================================================== */
-void get_global_1d_shape_fn(E,el,GM,dGammax,top,m)
- struct All_variables *E;
- int el,top,m;
- struct Shape_function1 *GM;
- struct Shape_function1_dA *dGammax;
-{
- int ii,i,k,d,e;
-
- double jacobian;
- double determinant();
-
- const int oned = onedvpoints[E->mesh.nsd];
-
- double xx[4][5],dxda[4][4];
-
- for (ii=0;ii<=top;ii++) { /* ii=0 for bottom and ii=1 for top */
-
- get_side_x_cart(E, xx, el, ii+1, m);
-
- for(k=1;k<=oned;k++) { /* all of the vpoints*/
- for(d=1;d<=E->mesh.nsd-1;d++)
- for(e=1;e<=E->mesh.nsd-1;e++)
- dxda[d][e]=0.0;
-
- for(i=1;i<=oned;i++) /* nodes */
- for(d=1;d<=E->mesh.nsd-1;d++)
- for(e=1;e<=E->mesh.nsd-1;e++)
- dxda[d][e] += xx[e][i]*E->Mx.vpt[GMVXINDEX(d-1,i,k)];
-
- jacobian = determinant(dxda,E->mesh.nsd-1);
- dGammax->vpt[GMVGAMMA(ii,k)] = jacobian;
- }
- }
-
- return;
-}
-
-/* ======================================================================
- ====================================================================== */
-void get_global_1d_shape_fn_L(E,el,GM,dGammax,top,m)
- struct All_variables *E;
- int el,top,m;
- struct Shape_function1 *GM;
- struct Shape_function1_dA *dGammax;
-{
- int ii,i,k,d,e,node;
-
- double jacobian;
- double determinant();
-
- const int oned = onedvpoints[E->mesh.nsd];
-
- double to,fo,xx[4][5],dxdy[4][4],dxda[4][4],cof[4][4];
-
-#ifdef ALLOW_ELLIPTICAL
- to = theta_g(E->eco[m][el].centre[1],E);
-#else
- to = E->eco[m][el].centre[1];
-#endif
- fo = E->eco[m][el].centre[2];
-
- dxdy[1][1] = cos(to)*cos(fo);
- dxdy[1][2] = cos(to)*sin(fo);
- dxdy[1][3] = -sin(to);
- dxdy[2][1] = -sin(fo);
- dxdy[2][2] = cos(fo);
- dxdy[2][3] = 0.0;
- dxdy[3][1] = sin(to)*cos(fo);
- dxdy[3][2] = sin(to)*sin(fo);
- dxdy[3][3] = cos(to);
-
- for (ii=0;ii<=top;ii++) { /* ii=0 for bottom and ii=1 for top */
-
- for(i=1;i<=oned;i++) { /* nodes */
- e = i+ii*oned;
- node = E->ien[m][el].node[e];
- xx[1][i] = E->x[m][1][node]*dxdy[1][1]
- + E->x[m][2][node]*dxdy[1][2]
- + E->x[m][3][node]*dxdy[1][3];
- xx[2][i] = E->x[m][1][node]*dxdy[2][1]
- + E->x[m][2][node]*dxdy[2][2]
- + E->x[m][3][node]*dxdy[2][3];
- xx[3][i] = E->x[m][1][node]*dxdy[3][1]
- + E->x[m][2][node]*dxdy[3][2]
- + E->x[m][3][node]*dxdy[3][3];
- }
-
- for(k=1;k<=oned;k++) { /* all of the vpoints*/
-
- for(d=1;d<=E->mesh.nsd-1;d++)
- for(e=1;e<=E->mesh.nsd-1;e++)
- dxda[d][e]=0.0;
-
- for(i=1;i<=oned;i++) /* nodes */
- for(d=1;d<=E->mesh.nsd-1;d++)
- for(e=1;e<=E->mesh.nsd-1;e++)
- dxda[d][e] += xx[e][i]*E->Lx.vpt[GMVXINDEX(d-1,i,k)];
-
- jacobian = determinant(dxda,E->mesh.nsd-1);
- dGammax->vpt[GMVGAMMA(ii,k)] = jacobian;
- }
- }
-
- return;
-}
-
-/* ======================================================================
- For calculating pressure boundary term --- Choi, 11/13/02
- ====================================================================== */
-void get_global_side_1d_shape_fn(E,el,GM,GMx,dGamma,side,m)
- struct All_variables *E;
- int el,side,m;
- struct Shape_function1 *GM;
- struct Shape_function1_dx *GMx;
- struct Shape_function_side_dA *dGamma;
-{
- int i,k,d,e;
-
- double jacobian;
- double determinant();
-
- const int oned = onedvpoints[E->mesh.nsd];
- double xx[4][5],dxda[4][4];
-
- get_side_x_cart(E, xx, el, side, m);
-
- for(k=1;k<=oned;k++) {
-
- for(d=1;d<=E->mesh.nsd-1;d++)
- for(e=1;e<=E->mesh.nsd-1;e++)
- dxda[d][e]=0.0;
-
- for(i=1;i<=oned;i++) {
- for(d=1;d<=E->mesh.nsd-1;d++)
- for(e=1;e<=E->mesh.nsd-1;e++) {
- dxda[d][e] += xx[sidedim[side][e]][i]*E->Mx.vpt[GMVXINDEX(d-1,i,k)];
- }
- }
-
- jacobian = determinant(dxda,E->mesh.nsd-1);
- dGamma->vpt[k] = jacobian;
- }
-
- return;
-}
-
-
-/* ==================================================== */
-
-void construct_c3x3matrix_el (struct All_variables *E,int el,struct CC *cc,
- struct CCX *ccx,int lev,int m,int pressure)
-{
- int a,i,j,k,d,lnode;
- double cofactor(),myatan();
- double x[4],u[4][4],ux[3][4][4],ua[4][4];
- double costt,cosff,sintt,sinff,rr,tt,ff;
-
- const int dims=E->mesh.nsd;
- const int ends=enodes[dims];
- const int vpts=vpoints[dims];
- const int ppts=ppoints[dims];
-
- if (pressure==0) {
- for(k=1;k<=vpts;k++) { /* all of the vpoints */
- for(d=1;d<=dims;d++)
- x[d]=0.0;
-
- for(d=1;d<=dims;d++)
- for(a=1;a<=ends;a++)
- x[d] += E->X[lev][m][d][E->IEN[lev][m][el].node[a]]
- *E->N.vpt[GNVINDEX(a,k)];
-
- rr = sqrt(x[1]*x[1]+x[2]*x[2]+x[3]*x[3]);
-
- ff = myatan(x[2],x[1]);
-#ifdef ALLOW_ELLIPTICAL
- tt = theta_g(acos(x[3]/rr),E);
-#else
- tt = acos(x[3]/rr);
-#endif
- costt = cos(tt);
- cosff = cos(ff);
- sintt = sin(tt);
- sinff = sin(ff);
-
- u[1][1] = costt*cosff; u[1][2] = costt*sinff; u[1][3] =-sintt;
- u[2][1] =-sinff; u[2][2] = cosff; u[2][3] = 0.0;
- u[3][1] = sintt*cosff; u[3][2] = sintt*sinff; u[3][3] = costt;
-
- ux[1][1][1] =-sintt*cosff; ux[1][1][2] =-sintt*sinff; ux[1][1][3] =-costt;
- ux[2][1][1] =-costt*sinff; ux[2][1][2] = costt*cosff; ux[2][1][3] =0.0;
- ux[1][2][1] =0.0; ux[1][2][2] = 0.0; ux[1][2][3] =0.0;
- ux[2][2][1] =-cosff; ux[2][2][2] =-sinff; ux[2][2][3] =0.0;
- ux[1][3][1] = costt*cosff; ux[1][3][2] = costt*sinff; ux[1][3][3] =-sintt;
- ux[2][3][1] =-sintt*sinff; ux[2][3][2] = sintt*cosff; ux[2][3][3] =0.0;
-
- for(a=1;a<=ends;a++) {
- tt = E->SX[lev][m][1][E->IEN[lev][m][el].node[a]];
- ff = E->SX[lev][m][2][E->IEN[lev][m][el].node[a]];
- costt = cos(tt);
- cosff = cos(ff);
- sintt = sin(tt);
- sinff = sin(ff);
-
- ua[1][1] = costt*cosff; ua[1][2] = costt*sinff; ua[1][3] =-sintt;
- ua[2][1] =-sinff; ua[2][2] = cosff; ua[2][3] = 0.0;
- ua[3][1] = sintt*cosff; ua[3][2] = sintt*sinff; ua[3][3] = costt;
-
- for (i=1;i<=dims;i++)
- for (j=1;j<=dims;j++) {
- cc->vpt[BVINDEX(i,j,a,k)] =
- ua[j][1]*u[i][1]+ua[j][2]*u[i][2]+ua[j][3]*u[i][3];
- ccx->vpt[BVXINDEX(i,j,1,a,k)] =
- ua[j][1]*ux[1][i][1]+ua[j][2]*ux[1][i][2]+ua[j][3]*ux[1][i][3];
- ccx->vpt[BVXINDEX(i,j,2,a,k)] =
- ua[j][1]*ux[2][i][1]+ua[j][2]*ux[2][i][2]+ua[j][3]*ux[2][i][3];
- }
- } /* end for local node */
-
- } /* end for int points */
- } /* end if */
-
- else if (pressure) {
-
- for(k=1;k<=ppts;k++) { /* all of the ppoints */
- for(d=1;d<=dims;d++)
- x[d]=0.0;
-
- for(d=1;d<=dims;d++)
- for(a=1;a<=ends;a++)
- x[d] += E->X[lev][m][d][E->IEN[lev][m][el].node[a]]
- *E->N.ppt[GNPINDEX(a,k)];
-
- rr = sqrt(x[1]*x[1]+x[2]*x[2]+x[3]*x[3]);
-
- ff = myatan(x[2],x[1]);
-#ifdef ALLOW_ELLIPTICAL
- tt = theta_g(acos(x[3]/rr),E);
-#else
- tt = acos(x[3]/rr);
-#endif
- costt = cos(tt);
- cosff = cos(ff);
- sintt = sin(tt);
- sinff = sin(ff);
-
- u[1][1] = costt*cosff; u[1][2] = costt*sinff; u[1][3] =-sintt;
- u[2][1] =-sinff; u[2][2] = cosff; u[2][3] = 0.0;
- u[3][1] = sintt*cosff; u[3][2] = sintt*sinff; u[3][3] = costt;
-
- ux[1][1][1] =-sintt*cosff; ux[1][1][2] =-sintt*sinff; ux[1][1][3] =-costt;
- ux[2][1][1] =-costt*sinff; ux[2][1][2] = costt*cosff; ux[2][1][3] =0.0;
- ux[1][2][1] =0.0; ux[1][2][2] = 0.0; ux[1][2][3] =0.0;
- ux[2][2][1] =-cosff; ux[2][2][2] =-sinff; ux[2][2][3] =0.0;
- ux[1][3][1] = costt*cosff; ux[1][3][2] = costt*sinff; ux[1][3][3] =-sintt;
- ux[2][3][1] =-sintt*sinff; ux[2][3][2] = sintt*cosff; ux[2][3][3] =0.0;
-
- for(a=1;a<=ends;a++) {
-
- lnode = E->IEN[lev][m][el].node[a];
- sintt = E->SinCos[lev][m][0][lnode];
- sinff = E->SinCos[lev][m][1][lnode];
- costt = E->SinCos[lev][m][2][lnode];
- cosff = E->SinCos[lev][m][3][lnode];
-
- ua[1][1] = costt*cosff; ua[1][2] = costt*sinff; ua[1][3] =-sintt;
- ua[2][1] =-sinff; ua[2][2] = cosff; ua[2][3] = 0.0;
- ua[3][1] = sintt*cosff; ua[3][2] = sintt*sinff; ua[3][3] = costt;
-
- for (i=1;i<=dims;i++)
- for (j=1;j<=dims;j++) {
- cc->ppt[BPINDEX(i,j,a,k)] =
- ua[j][1]*u[i][1]+ua[j][2]*u[i][2]+ua[j][3]*u[i][3];
- ccx->ppt[BPXINDEX(i,j,1,a,k)] =
- ua[j][1]*ux[1][i][1]+ua[j][2]*ux[1][i][2]+ua[j][3]*ux[1][i][3];
- ccx->ppt[BPXINDEX(i,j,2,a,k)] =
- ua[j][1]*ux[2][i][1]+ua[j][2]*ux[2][i][2]+ua[j][3]*ux[2][i][3];
- }
-
- } /* end for local node */
-
- } /* end for int points */
-
-
- } /* end if pressure */
-
- return;
- }
-
-
-void construct_side_c3x3matrix_el(struct All_variables *E,int el,
- struct CC *cc,struct CCX *ccx,
- int lev,int m,int pressure,int side)
-{
- int a,aa,i,j,k,d,lnode;
- double cofactor(),myatan();
- double x[4],u[4][4],ux[3][4][4],ua[4][4];
- double costt,cosff,sintt,sinff,rr,tt,ff;
-
- const int dims=E->mesh.nsd;
- const int ends=enodes[dims-1];
- const int vpts=onedvpoints[dims];
- const int ppts=ppoints[dims];
-
- if(pressure==0) {
- for(k=1;k<=vpts;k++) { /* all of the vpoints */
- for(d=1;d<=dims;d++)
- x[d]=0.0;
- for(d=1;d<=dims;d++)
- for(aa=1;aa<=ends;aa++) {
- a=sidenodes[side][aa];
- x[d] += E->X[lev][m][d][E->IEN[lev][m][el].node[a]]
- *E->M.vpt[GMVINDEX(aa,k)];
-
- }
-
- rr = sqrt(x[1]*x[1]+x[2]*x[2]+x[3]*x[3]);
- tt = acos(x[3]/rr);
- ff = myatan(x[2],x[1]);
-#ifdef ALLOW_ELLIPTICAL
- tt = theta_g(acos(x[3]/rr),E);
-#else
- tt = acos(x[3]/rr);
-#endif
-
- costt = cos(tt);
- cosff = cos(ff);
- sintt = sin(tt);
- sinff = sin(ff);
-
- u[1][1] = costt*cosff; u[1][2] = costt*sinff; u[1][3] =-sintt;
- u[2][1] =-sinff; u[2][2] = cosff; u[2][3] = 0.0;
- u[3][1] = sintt*cosff; u[3][2] = sintt*sinff; u[3][3] = costt;
-
- ux[1][1][1] =-sintt*cosff; ux[1][1][2] =-sintt*sinff; ux[1][1][3] =-costt;
- ux[2][1][1] =-costt*sinff; ux[2][1][2] = costt*cosff; ux[2][1][3] =0.0;
- ux[1][2][1] =0.0; ux[1][2][2] = 0.0; ux[1][2][3] =0.0;
- ux[2][2][1] =-cosff; ux[2][2][2] =-sinff; ux[2][2][3] =0.0;
- ux[1][3][1] = costt*cosff; ux[1][3][2] = costt*sinff; ux[1][3][3] =-sintt;
- ux[2][3][1] =-sintt*sinff; ux[2][3][2] = sintt*cosff; ux[2][3][3] =0.0;
-
- for(aa=1;aa<=ends;aa++) {
- a=sidenodes[side][aa];
-
- lnode = E->IEN[lev][m][el].node[a];
- sintt = E->SinCos[lev][m][0][lnode];
- sinff = E->SinCos[lev][m][1][lnode];
- costt = E->SinCos[lev][m][2][lnode];
- cosff = E->SinCos[lev][m][3][lnode];
-
- ua[1][1] = costt*cosff; ua[1][2] = costt*sinff; ua[1][3] =-sintt;
- ua[2][1] =-sinff; ua[2][2] = cosff; ua[2][3] = 0.0;
- ua[3][1] = sintt*cosff; ua[3][2] = sintt*sinff; ua[3][3] = costt;
-
- for (i=1;i<=dims;i++)
- for (j=1;j<=dims;j++) {
- cc->vpt[BVINDEX(i,j,a,k)] =
- ua[j][1]*u[i][1]+ua[j][2]*u[i][2]+ua[j][3]*u[i][3];
- ccx->vpt[BVXINDEX(i,j,1,a,k)] =
- ua[j][1]*ux[1][i][1]+ua[j][2]*ux[1][i][2]+ua[j][3]*ux[1][i][3];
- ccx->vpt[BVXINDEX(i,j,2,a,k)] =
- ua[j][1]*ux[2][i][1]+ua[j][2]*ux[2][i][2]+ua[j][3]*ux[2][i][3];
- }
-
- } /* end for local node */
- } /* end for int points */
- } /* end if */
- else {
- for(k=1;k<=ppts;k++) { /* all of the ppoints */
- for(d=1;d<=E->mesh.nsd;d++)
- x[d]=0.0;
- for(a=1;a<=ends;a++) {
- aa=sidenodes[side][a];
- x[d] += E->X[lev][m][d][E->IEN[lev][m][el].node[aa]]
- *E->M.ppt[GMPINDEX(a,k)];
- }
- rr = sqrt(x[1]*x[1]+x[2]*x[2]+x[3]*x[3]);
- ff = myatan(x[2],x[1]);
-
-#ifdef ALLOW_ELLIPTICAL
- tt = theta_g(acos(x[3]/rr),E);
-#else
- tt = acos(x[3]/rr);
-#endif
- costt = cos(tt);
- cosff = cos(ff);
- sintt = sin(tt);
- sinff = sin(ff);
-
- u[1][1] = costt*cosff; u[1][2] = costt*sinff; u[1][3] =-sintt;
- u[2][1] =-sinff; u[2][2] = cosff; u[2][3] = 0.0;
- u[3][1] = sintt*cosff; u[3][2] = sintt*sinff; u[3][3] = costt;
-
- ux[1][1][1] =-sintt*cosff; ux[1][1][2] =-sintt*sinff; ux[1][1][3] =-costt;
- ux[2][1][1] =-costt*sinff; ux[2][1][2] = costt*cosff; ux[2][1][3] =0.0;
- ux[1][2][1] =0.0; ux[1][2][2] = 0.0; ux[1][2][3] =0.0;
- ux[2][2][1] =-cosff; ux[2][2][2] =-sinff; ux[2][2][3] =0.0;
- ux[1][3][1] = costt*cosff; ux[1][3][2] = costt*sinff; ux[1][3][3] =-sintt;
- ux[2][3][1] =-sintt*sinff; ux[2][3][2] = sintt*cosff; ux[2][3][3] =0.0;
-
- for(a=1;a<=ends;a++) {
- aa=sidenodes[side][a];
-
- lnode = E->IEN[lev][m][el].node[aa];
- sintt = E->SinCos[lev][m][0][lnode];
- sinff = E->SinCos[lev][m][1][lnode];
- costt = E->SinCos[lev][m][2][lnode];
- cosff = E->SinCos[lev][m][3][lnode];
-
- ua[1][1] = costt*cosff; ua[1][2] = costt*sinff; ua[1][3] =-sintt;
- ua[2][1] =-sinff; ua[2][2] = cosff; ua[2][3] = 0.0;
- ua[3][1] = sintt*cosff; ua[3][2] = sintt*sinff; ua[3][3] = costt;
-
- for (i=1;i<=E->mesh.nsd;i++) {
- for (j=1;j<=E->mesh.nsd;j++) {
- cc->ppt[BPINDEX(i,j,a,k)] =
- ua[j][1]*u[i][1]+ua[j][2]*u[i][2]+ua[j][3]*u[i][3];
- ccx->ppt[BPXINDEX(i,j,1,a,k)] =
- ua[j][1]*ux[1][i][1]+ua[j][2]*ux[1][i][2]+ua[j][3]*ux[1][i][3];
- ccx->ppt[BPXINDEX(i,j,2,a,k)] =
- ua[j][1]*ux[2][i][1]+ua[j][2]*ux[2][i][2]+ua[j][3]*ux[2][i][3];
- }
- }
- } /* end for local node */
- } /* end for int points */
- } /* end if pressure */
-
- return;
-}
-
-
-/* ======================================= */
-void construct_c3x3matrix(E)
- struct All_variables *E;
-{
- int m,a,i,j,k,d,es,el,nel_surface,lev,lnode;
- double cofactor(),myatan();
- double x[4],u[4][4],ux[3][4][4],ua[4][4];
- double costt,cosff,sintt,sinff,rr,tt,ff;
-
- const int dims=E->mesh.nsd;
- const int ends=enodes[dims];
- const int vpts=vpoints[dims];
- const int ppts=ppoints[dims];
-
- for (lev=E->mesh.gridmin;lev<=E->mesh.gridmax;lev++)
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- nel_surface = E->lmesh.NEL[lev]/E->lmesh.ELZ[lev];
- for (es=1;es<=nel_surface;es++) {
-
- el = es*E->lmesh.ELZ[lev];
-
- for(k=1;k<=vpts;k++) { /* all of the vpoints */
- for(d=1;d<=dims;d++)
- x[d]=0.0;
-
- for(d=1;d<=dims;d++)
- for(a=1;a<=ends;a++)
- x[d] += E->X[lev][m][d][E->IEN[lev][m][el].node[a]]
- *E->N.vpt[GNVINDEX(a,k)];
-
- rr = sqrt(x[1]*x[1]+x[2]*x[2]+x[3]*x[3]);
- ff = myatan(x[2],x[1]);
-#ifdef ALLOW_ELLIPTICAL
- tt = theta_g(acos(x[3]/rr),E);
-#else
- tt = acos(x[3]/rr);
-#endif
-
- costt = cos(tt);
- cosff = cos(ff);
- sintt = sin(tt);
- sinff = sin(ff);
-
- u[1][1] = costt*cosff; u[1][2] = costt*sinff; u[1][3] =-sintt;
- u[2][1] =-sinff; u[2][2] = cosff; u[2][3] = 0.0;
- u[3][1] = sintt*cosff; u[3][2] = sintt*sinff; u[3][3] = costt;
-
- ux[1][1][1] =-sintt*cosff; ux[1][1][2] =-sintt*sinff; ux[1][1][3] =-costt;
- ux[2][1][1] =-costt*sinff; ux[2][1][2] = costt*cosff; ux[2][1][3] =0.0;
- ux[1][2][1] =0.0; ux[1][2][2] = 0.0; ux[1][2][3] =0.0;
- ux[2][2][1] =-cosff; ux[2][2][2] =-sinff; ux[2][2][3] =0.0;
- ux[1][3][1] = costt*cosff; ux[1][3][2] = costt*sinff; ux[1][3][3] =-sintt;
- ux[2][3][1] =-sintt*sinff; ux[2][3][2] = sintt*cosff; ux[2][3][3] =0.0;
-
- for(a=1;a<=ends;a++) {
-
- lnode = E->IEN[lev][m][el].node[a];
- sintt = E->SinCos[lev][m][0][lnode];
- sinff = E->SinCos[lev][m][1][lnode];
- costt = E->SinCos[lev][m][2][lnode];
- cosff = E->SinCos[lev][m][3][lnode];
-
- ua[1][1] = costt*cosff; ua[1][2] = costt*sinff; ua[1][3] =-sintt;
- ua[2][1] =-sinff; ua[2][2] = cosff; ua[2][3] = 0.0;
- ua[3][1] = sintt*cosff; ua[3][2] = sintt*sinff; ua[3][3] = costt;
-
- for (i=1;i<=dims;i++)
- for (j=1;j<=dims;j++) {
- E->CC[lev][m][es].vpt[BVINDEX(i,j,a,k)] =
- ua[j][1]*u[i][1]+ua[j][2]*u[i][2]+ua[j][3]*u[i][3];
- E->CCX[lev][m][es].vpt[BVXINDEX(i,j,1,a,k)] =
- ua[j][1]*ux[1][i][1]+ua[j][2]*ux[1][i][2]+ua[j][3]*ux[1][i][3];
- E->CCX[lev][m][es].vpt[BVXINDEX(i,j,2,a,k)] =
- ua[j][1]*ux[2][i][1]+ua[j][2]*ux[2][i][2]+ua[j][3]*ux[2][i][3];
- }
- } /* end for local node */
-
- } /* end for int points */
-
- for(k=1;k<=ppts;k++) { /* all of the ppoints */
- for(d=1;d<=dims;d++)
- x[d]=0.0;
-
- for(d=1;d<=dims;d++)
- for(a=1;a<=ends;a++)
- x[d] += E->X[lev][m][d][E->IEN[lev][m][el].node[a]]
- *E->N.ppt[GNPINDEX(a,k)];
-
- rr = sqrt(x[1]*x[1]+x[2]*x[2]+x[3]*x[3]);
- ff = myatan(x[2],x[1]);
-#ifdef ALLOW_ELLIPTICAL
- tt = theta_g(acos(x[3]/rr),E);
-#else
- tt = acos(x[3]/rr);
-#endif
-
- costt = cos(tt);
- cosff = cos(ff);
- sintt = sin(tt);
- sinff = sin(ff);
-
- u[1][1] = costt*cosff; u[1][2] = costt*sinff; u[1][3] =-sintt;
- u[2][1] =-sinff; u[2][2] = cosff; u[2][3] = 0.0;
- u[3][1] = sintt*cosff; u[3][2] = sintt*sinff; u[3][3] = costt;
-
- ux[1][1][1] =-sintt*cosff; ux[1][1][2] =-sintt*sinff; ux[1][1][3] =-costt;
- ux[2][1][1] =-costt*sinff; ux[2][1][2] = costt*cosff; ux[2][1][3] =0.0;
- ux[1][2][1] =0.0; ux[1][2][2] = 0.0; ux[1][2][3] =0.0;
- ux[2][2][1] =-cosff; ux[2][2][2] =-sinff; ux[2][2][3] =0.0;
- ux[1][3][1] = costt*cosff; ux[1][3][2] = costt*sinff; ux[1][3][3] =-sintt;
- ux[2][3][1] =-sintt*sinff; ux[2][3][2] = sintt*cosff; ux[2][3][3] =0.0;
-
- for(a=1;a<=ends;a++) {
-
- lnode = E->IEN[lev][m][el].node[a];
- sintt = E->SinCos[lev][m][0][lnode];
- sinff = E->SinCos[lev][m][1][lnode];
- costt = E->SinCos[lev][m][2][lnode];
- cosff = E->SinCos[lev][m][3][lnode];
-
-
- ua[1][1] = costt*cosff; ua[1][2] = costt*sinff; ua[1][3] =-sintt;
- ua[2][1] =-sinff; ua[2][2] = cosff; ua[2][3] = 0.0;
- ua[3][1] = sintt*cosff; ua[3][2] = sintt*sinff; ua[3][3] = costt;
-
- for (i=1;i<=dims;i++)
- for (j=1;j<=dims;j++) {
- E->CC[lev][m][es].ppt[BPINDEX(i,j,a,k)] =
- ua[j][1]*u[i][1]+ua[j][2]*u[i][2]+ua[j][3]*u[i][3];
- E->CCX[lev][m][es].ppt[BPXINDEX(i,j,1,a,k)] =
- ua[j][1]*ux[1][i][1]+ua[j][2]*ux[1][i][2]+ua[j][3]*ux[1][i][3];
- E->CCX[lev][m][es].ppt[BPXINDEX(i,j,2,a,k)] =
- ua[j][1]*ux[2][i][1]+ua[j][2]*ux[2][i][2]+ua[j][3]*ux[2][i][3];
- }
-
- } /* end for local node */
-
- } /* end for int points */
-
-
- } /* end for es */
- } /* end for m */
-
- return;
- }
-
-
-
-/* ==========================================
- construct the lumped mass matrix. The full
- matrix is the FE integration of the density
- field. The lumped version is the diagonal
- matrix obtained by letting the shape function
- Na be delta(a,b)
- ========================================== */
-
-void mass_matrix(struct All_variables *E)
-{
- int m,node,i,nint,e,lev;
- int n[9], nz;
- double myatan(),area,centre[4],temp[9],temp2[9],dx1,dx2,dx3;
-
- const int vpts=vpoints[E->mesh.nsd];
-
- /* ECO .size can also be defined here */
-
- for(lev=E->mesh.levmin;lev<=E->mesh.levmax;lev++) {
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
-
- for(node=1;node<=E->lmesh.NNO[lev];node++)
- E->MASS[lev][m][node] = 0.0;
-
- for(e=1;e<=E->lmesh.NEL[lev];e++) {
-
- area = centre[1] = centre[2] = centre[3] = 0.0;
-
- for(node=1;node<=enodes[E->mesh.nsd];node++)
- n[node] = E->IEN[lev][m][e].node[node];
-
- for(i=1;i<=E->mesh.nsd;i++) {
- for(node=1;node<=enodes[E->mesh.nsd];node++)
- centre[i] += E->X[lev][m][i][n[node]];
-
- centre[i] = centre[i]/enodes[E->mesh.nsd];
- } /* end for i */
-
- /* dx3=radius, dx1=theta, dx2=phi */
- dx3 = sqrt(centre[1]*centre[1]+centre[2]*centre[2]+centre[3]*centre[3]);
- dx1 = acos( centre[3]/dx3 );
- dx2 = myatan(centre[2],centre[1]);
-
- /* center of this element in the spherical coordinate */
- E->ECO[lev][m][e].centre[1] = dx1;
- E->ECO[lev][m][e].centre[2] = dx2;
- E->ECO[lev][m][e].centre[3] = dx3;
-
- /* delta(theta) of this element */
- dx1 = max( fabs(E->SX[lev][m][1][n[3]]-E->SX[lev][m][1][n[1]]),
- fabs(E->SX[lev][m][1][n[2]]-E->SX[lev][m][1][n[4]]) );
-
- /* length of this element in the theta-direction */
- E->ECO[lev][m][e].size[1] = dx1*E->ECO[lev][m][e].centre[3];
-
- /* delta(phi) of this element */
- dx1 = fabs(E->SX[lev][m][2][n[3]]-E->SX[lev][m][2][n[1]]);
- if (dx1>M_PI)
- dx1 = min(E->SX[lev][m][2][n[3]],E->SX[lev][m][2][n[1]]) + 2.0*M_PI -
- max(E->SX[lev][m][2][n[3]],E->SX[lev][m][2][n[1]]) ;
-
- dx2 = fabs(E->SX[lev][m][2][n[2]]-E->SX[lev][m][2][n[4]]);
- if (dx2>M_PI)
- dx2 = min(E->SX[lev][m][2][n[2]],E->SX[lev][m][2][n[4]]) + 2.0*M_PI -
- max(E->SX[lev][m][2][n[2]],E->SX[lev][m][2][n[4]]) ;
-
- dx2 = max(dx1,dx2);
-
- /* length of this element in the phi-direction */
- E->ECO[lev][m][e].size[2] = dx2*E->ECO[lev][m][e].centre[3]
- *sin(E->ECO[lev][m][e].centre[1]);
-
- /* delta(radius) of this element */
- dx3 = 0.25*(fabs(E->SX[lev][m][3][n[5]]+E->SX[lev][m][3][n[6]]
- +E->SX[lev][m][3][n[7]]+E->SX[lev][m][3][n[8]]
- -E->SX[lev][m][3][n[1]]-E->SX[lev][m][3][n[2]]
- -E->SX[lev][m][3][n[3]]-E->SX[lev][m][3][n[4]]));
-
- /* length of this element in the radius-direction */
- E->ECO[lev][m][e].size[3] = dx3;
-
- /* volume (area in 2D) of this element */
- for(nint=1;nint<=vpts;nint++)
- area += g_point[nint].weight[E->mesh.nsd-1] * E->GDA[lev][m][e].vpt[nint];
- E->ECO[lev][m][e].area = area;
-
- for(node=1;node<=enodes[E->mesh.nsd];node++) {
- temp[node] = 0.0;
- for(nint=1;nint<=vpts;nint++)
- temp[node] += E->GDA[lev][m][e].vpt[nint]*g_point[nint].weight[E->mesh.nsd-1]
- *E->N.vpt[GNVINDEX(node,nint)]; /* int Na dV */
- }
-
- for(node=1;node<=enodes[E->mesh.nsd];node++)
- E->MASS[lev][m][E->IEN[lev][m][e].node[node]] += temp[node];
-
- /* weight of each node, equivalent to pmass in ConMan */
- for(node=1;node<=enodes[E->mesh.nsd];node++)
- E->TWW[lev][m][e].node[node] = temp[node];
-
-
- } /* end of ele*/
-
- } /* end of for m */
-
- if(lev == E->mesh.levmax)
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for(node=1;node<=E->lmesh.NNO[lev];node++)
- E->NMass[m][node] = E->MASS[lev][m][node];
-
- if (E->control.NMULTIGRID||E->control.EMULTIGRID||E->mesh.levmax==lev)
- (E->exchange_node_d)(E,E->MASS[lev],lev);
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for(node=1;node<=E->lmesh.NNO[lev];node++)
- E->MASS[lev][m][node] = 1.0/E->MASS[lev][m][node];
-
- } /* end of for lev */
-
-
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
-
- for(node=1;node<=E->lmesh.nno;node++)
- E->TMass[m][node] = 0.0;
-
- for(e=1;e<=E->lmesh.nel;e++) {
- for(node=1;node<=enodes[E->mesh.nsd];node++) {
- temp[node] = 0.0;
- nz = ((E->ien[m][e].node[node]-1) % E->lmesh.noz) + 1;
- for(nint=1;nint<=vpts;nint++)
- temp[node] += E->refstate.rho[nz]
- * E->refstate.heat_capacity[nz]
- * E->gDA[m][e].vpt[nint]
- * g_point[nint].weight[E->mesh.nsd-1]
- * E->N.vpt[GNVINDEX(node,nint)];
- }
-
- /* lumped mass matrix, equivalent to tmass in ConMan */
- for(node=1;node<=enodes[E->mesh.nsd];node++)
- E->TMass[m][E->ien[m][e].node[node]] += temp[node];
-
- } /* end of for e */
- } /* end of for m */
-
- (E->exchange_node_d)(E,E->TMass,E->mesh.levmax);
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for(node=1;node<=E->lmesh.nno;node++)
- E->TMass[m][node] = 1.0 / E->TMass[m][node];
-
-
- /* compute volume of this processor mesh and the whole mesh */
- E->lmesh.volume = 0;
- E->mesh.volume = 0;
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for(e=1;e<=E->lmesh.nel;e++)
- E->lmesh.volume += E->eco[m][e].area;
-
- MPI_Allreduce(&E->lmesh.volume, &E->mesh.volume, 1, MPI_DOUBLE,
- MPI_SUM, E->parallel.world);
-
-
- if (E->control.verbose) {
- fprintf(E->fp_out, "rank=%d my_volume=%e total_volume=%e\n",
- E->parallel.me, E->lmesh.volume, E->mesh.volume);
-
- for(lev=E->mesh.levmin;lev<=E->mesh.levmax;lev++) {
- fprintf(E->fp_out,"output_mass lev=%d\n",lev);
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- fprintf(E->fp_out,"m=%d %d \n",E->sphere.capid[m],m);
- for(e=1;e<=E->lmesh.NEL[lev];e++)
- fprintf(E->fp_out,"%d %g \n",e,E->ECO[lev][m][e].area);
- for (node=1;node<=E->lmesh.NNO[lev];node++)
- fprintf(E->fp_out,"Mass[%d]= %g \n",node,E->MASS[lev][m][node]);
- }
- }
-
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- fprintf(E->fp_out,"m=%d %d \n",E->sphere.capid[m],m);
- for (node=1;node<=E->lmesh.nno;node++)
- fprintf(E->fp_out,"TMass[%d]= %g \n",node,E->TMass[m][node]);
- }
- fflush(E->fp_out);
- }
-
- return;
-}
-
-
-/* version */
-/* $Id$ */
-
-/* End of file */
Copied: mc/3D/CitcomS/branches/cxx/lib/Size_does_matter.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Size_does_matter.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Size_does_matter.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Size_does_matter.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,1177 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+#include <math.h>
+#include <sys/types.h>
+#include "element_definitions.h"
+#include "global_defs.h"
+
+#include "cproto.h"
+
+#ifdef ALLOW_ELLIPTICAL
+double theta_g(double , struct All_variables *);
+#endif
+
+void twiddle_thumbs(struct All_variables *yawn)
+
+{ /* Do nothing, just sit back and relax.
+ Take it easy for a while, maybe size
+ doesn't matter after all. There, there
+ that's better. Now ... */
+
+ return; }
+
+/* ======================================================================
+ ====================================================================== */
+
+static void form_rtf_bc(int k, double x[4],
+ double rtf[4][9], double bc[4][4])
+{
+ rtf[3][k] = 1.0/sqrt(x[1]*x[1]+x[2]*x[2]+x[3]*x[3]); /* 1/r */
+ rtf[1][k] = acos(x[3]*rtf[3][k]); /* theta */
+ rtf[2][k] = myatan(x[2],x[1]); /* phi */
+
+ bc[1][1] = x[3]*cos(rtf[2][k]); /* theta */
+ bc[1][2] = x[3]*sin(rtf[2][k]);
+ bc[1][3] = -sin(rtf[1][k])/rtf[3][k];
+ bc[2][1] = -x[2]; /* phi basis vector */
+ bc[2][2] = x[1];
+ bc[2][3] = 0.0;
+ bc[3][1] = x[1]*rtf[3][k]; /* */
+ bc[3][2] = x[2]*rtf[3][k];
+ bc[3][3] = x[3]*rtf[3][k];
+
+ return;
+}
+
+
+static void get_global_shape_fn_sph(struct All_variables *E,
+ int m, int lev, int el)
+{
+ int i,j,k,d,e;
+ double jacobian;
+
+ struct Shape_function_dx LGNx;
+
+ double dxda[4][4], cof[4][4], x[4], rtf[4][9], bc[4][4];
+
+ const int dims = E->mesh.nsd;
+ const int ends = ENODES3D;
+ const int vpts = VPOINTS3D;
+ const int ppts = PPOINTS3D;
+
+
+ for(k=1;k<=vpts;k++) { /* all of the vpoints */
+ for(d=1;d<=dims;d++) {
+ x[d]=0.0;
+ for(e=1;e<=dims;e++)
+ dxda[d][e]=0.0;
+ }
+
+ for(d=1;d<=dims;d++)
+ for(i=1;i<=ends;i++)
+ x[d] += E->X[lev][m][d][E->IEN[lev][m][el].node[i]]
+ * E->N.vpt[GNVINDEX(i,k)];
+
+ for(d=1;d<=dims;d++)
+ for(e=1;e<=dims;e++)
+ for(i=1;i<=ends;i++)
+ dxda[d][e] += E->X[lev][m][e][E->IEN[lev][m][el].node[i]]
+ * E->Nx.vpt[GNVXINDEX(d-1,i,k)];
+
+ jacobian = determinant(dxda, E->mesh.nsd);
+ E->GDA[lev][m][el].vpt[k] = jacobian;
+
+ for(d=1;d<=dims;d++)
+ for(e=1;e<=dims;e++)
+ cof[d][e]=cofactor(dxda,d,e,dims);
+
+ form_rtf_bc(k,x,rtf,bc);
+ for(j=1;j<=ends;j++)
+ for(d=1;d<=dims;d++) {
+ LGNx.vpt[GNVXINDEX(d-1,j,k)] = 0.0;
+ for(e=1;e<=dims;e++)
+ LGNx.vpt[GNVXINDEX(d-1,j,k)] +=
+ E->Nx.vpt[GNVXINDEX(e-1,j,k)] *cof[e][d];
+
+ LGNx.vpt[GNVXINDEX(d-1,j,k)] /= jacobian;
+ }
+
+ for(j=1;j<=ends;j++)
+ for(d=1;d<=dims;d++) {
+ E->GNX[lev][m][el].vpt[GNVXINDEX(d-1,j,k)]
+ = bc[d][1]*LGNx.vpt[GNVXINDEX(0,j,k)]
+ + bc[d][2]*LGNx.vpt[GNVXINDEX(1,j,k)]
+ + bc[d][3]*LGNx.vpt[GNVXINDEX(2,j,k)];
+ }
+ } /* end for k */
+
+ for(k=1;k<=ppts;k++) { /* all of the ppoints */
+ for(d=1;d<=dims;d++) {
+ x[d]=0.0;
+ for(e=1;e<=dims;e++)
+ dxda[d][e]=0.0;
+ }
+
+ for(d=1;d<=dims;d++)
+ for(i=1;i<=ends;i++)
+ x[d] += E->X[lev][m][d][E->IEN[lev][m][el].node[i]]
+ * E->N.ppt[GNPINDEX(i,k)];
+
+ for(d=1;d<=dims;d++)
+ for(e=1;e<=dims;e++)
+ for(i=1;i<=ends;i++)
+ dxda[d][e] += E->X[lev][m][e][E->IEN[lev][m][el].node[i]]
+ * E->Nx.ppt[GNPXINDEX(d-1,i,k)];
+
+ jacobian = determinant(dxda,E->mesh.nsd);
+ E->GDA[lev][m][el].ppt[k] = jacobian;
+
+ for(d=1;d<=dims;d++)
+ for(e=1;e<=dims;e++)
+ cof[d][e]=cofactor(dxda,d,e,E->mesh.nsd);
+
+ form_rtf_bc(k,x,rtf,bc);
+ for(j=1;j<=ends;j++)
+ for(d=1;d<=dims;d++) {
+ LGNx.ppt[GNPXINDEX(d-1,j,k)]=0.0;
+ for(e=1;e<=dims;e++)
+ LGNx.ppt[GNPXINDEX(d-1,j,k)] +=
+ E->Nx.ppt[GNPXINDEX(e-1,j,k)]*cof[e][d];
+ LGNx.ppt[GNPXINDEX(d-1,j,k)] /= jacobian;
+ }
+ for(j=1;j<=ends;j++)
+ for(d=1;d<=dims;d++) {
+ E->GNX[lev][m][el].ppt[GNPXINDEX(d-1,j,k)]
+ = bc[d][1]*LGNx.ppt[GNPXINDEX(0,j,k)]
+ + bc[d][2]*LGNx.ppt[GNPXINDEX(1,j,k)]
+ + bc[d][3]*LGNx.ppt[GNPXINDEX(2,j,k)];
+ }
+
+ } /* end for k int */
+
+
+ return;
+}
+
+
+void construct_shape_function_derivatives(struct All_variables *E)
+{
+ int m, lev, el;
+
+ for (m=1; m<=E->sphere.caps_per_proc; m++)
+ for(lev=E->mesh.levmax; lev>=E->mesh.levmin; lev--)
+ for(el=1; el<=E->lmesh.NEL[lev]; el++) {
+ get_global_shape_fn_sph(E, m, lev, el);
+ }
+
+ return;
+}
+
+
+/*
+
+gets r,theta,phi coordinates at the integration points
+
+ */
+void get_rtf_at_vpts(struct All_variables *E, int m, int lev, int el,
+ double rtf[4][9])
+{
+ int i, k, d;
+ double x[4];
+
+ const int dims = E->mesh.nsd;
+ const int ends = ENODES3D;
+ const int vpts = VPOINTS3D;
+
+ for(k=1;k<=vpts;k++) { /* all of the vpoints */
+ for(d=1;d<=dims;d++)
+ x[d]=0.0;
+
+ for(d=1;d<=dims;d++)
+ for(i=1;i<=ends;i++)
+ x[d] += E->X[lev][m][d][E->IEN[lev][m][el].node[i]]
+ * E->N.vpt[GNVINDEX(i,k)];
+
+ rtf[3][k] = 1.0/sqrt(x[1]*x[1]+x[2]*x[2]+x[3]*x[3]); /* 1/r */
+ rtf[1][k] = acos(x[3]*rtf[3][k]); /* theta */
+ rtf[2][k] = myatan(x[2],x[1]); /* phi */
+ }
+
+ return;
+}
+
+
+void get_rtf_at_ppts(struct All_variables *E, int m, int lev, int el,
+ double rtf[4][9])
+{
+ int i, k, d;
+ double x[4];
+
+ const int dims = E->mesh.nsd;
+ const int ends = ENODES3D;
+ const int ppts = PPOINTS3D;
+
+ for(k=1;k<=ppts;k++) { /* all of the ppoints */
+ for(d=1;d<=dims;d++)
+ x[d]=0.0;
+
+ for(d=1;d<=dims;d++)
+ for(i=1;i<=ends;i++)
+ x[d] += E->X[lev][m][d][E->IEN[lev][m][el].node[i]]
+ * E->N.ppt[GNPINDEX(i,k)];
+
+ rtf[3][k] = 1.0/sqrt(x[1]*x[1]+x[2]*x[2]+x[3]*x[3]);
+ rtf[1][k] = acos(x[3]*rtf[3][k]);
+ rtf[2][k] = myatan(x[2],x[1]);
+ }
+
+ return;
+}
+
+
+void get_side_x_cart(struct All_variables *E, double xx[4][5],
+ int el, int side, int m)
+{
+ double to,fo,dxdy[4][4];
+ int i, node, s;
+ const int oned = onedvpoints[E->mesh.nsd];
+
+#ifdef ALLOW_ELLIPTICAL
+ to = theta_g(E->eco[m][el].centre[1],E);
+#else
+ to = E->eco[m][el].centre[1];
+#endif
+
+ fo = E->eco[m][el].centre[2];
+
+ dxdy[1][1] = cos(to)*cos(fo);
+ dxdy[1][2] = cos(to)*sin(fo);
+ dxdy[1][3] = -sin(to);
+ dxdy[2][1] = -sin(fo);
+ dxdy[2][2] = cos(fo);
+ dxdy[2][3] = 0.0;
+ dxdy[3][1] = sin(to)*cos(fo);
+ dxdy[3][2] = sin(to)*sin(fo);
+ dxdy[3][3] = cos(to);
+
+ for(i=1;i<=oned;i++) { /* nodes */
+ s = sidenodes[side][i];
+ node = E->ien[m][el].node[s];
+ xx[1][i] = E->x[m][1][node]*dxdy[1][1]
+ + E->x[m][2][node]*dxdy[1][2]
+ + E->x[m][3][node]*dxdy[1][3];
+ xx[2][i] = E->x[m][1][node]*dxdy[2][1]
+ + E->x[m][2][node]*dxdy[2][2]
+ + E->x[m][3][node]*dxdy[2][3];
+ xx[3][i] = E->x[m][1][node]*dxdy[3][1]
+ + E->x[m][2][node]*dxdy[3][2]
+ + E->x[m][3][node]*dxdy[3][3];
+ }
+}
+
+
+/* ======================================================================
+ ====================================================================== */
+void construct_surf_det(struct All_variables *E)
+{
+
+ int m,i,k,d,e,es,el;
+
+ double jacobian;
+
+ const int oned = onedvpoints[E->mesh.nsd];
+
+ double xx[4][5], dxda[4][4], r2;
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for(k=1;k<=oned;k++) { /* all of the vpoints*/
+ E->surf_det[m][k] = (double *)malloc((1+E->lmesh.snel)*sizeof(double));
+ }
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ r2 = 1.0 / (E->sx[m][3][E->lmesh.elz+1] * E->sx[m][3][E->lmesh.elz+1]);
+
+ for (es=1;es<=E->lmesh.snel;es++) {
+ el = es * E->lmesh.elz;
+ get_side_x_cart(E, xx, el, SIDE_TOP, m);
+
+ for(k=1;k<=oned;k++) { /* all of the vpoints*/
+ for(d=1;d<=E->mesh.nsd-1;d++)
+ for(e=1;e<=E->mesh.nsd-1;e++)
+ dxda[d][e]=0.0;
+
+ for(i=1;i<=oned;i++) /* nodes */
+ for(d=1;d<=E->mesh.nsd-1;d++)
+ for(e=1;e<=E->mesh.nsd-1;e++)
+ dxda[d][e] += xx[e][i]*E->Mx.vpt[GMVXINDEX(d-1,i,k)];
+
+ jacobian = determinant(dxda,E->mesh.nsd-1);
+
+ /* scale the jacobian so that it is defined on a unit sphere */
+ E->surf_det[m][k][es] = jacobian * r2;
+ }
+ }
+ }
+ return;
+}
+
+
+
+/* ======================================================================
+ surface (6 sides) determinant of boundary element
+ ====================================================================== */
+void construct_bdry_det(struct All_variables *E)
+{
+
+ int m,i,k,d,e,es,el,side;
+
+ double jacobian;
+
+ const int oned = onedvpoints[E->mesh.nsd];
+
+ double xx[4][5],dxda[4][4];
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for (side=SIDE_BEGIN; side<=SIDE_END; side++)
+ for(d=1; d<=oned; d++)
+ E->boundary.det[m][side][d] = (double *)malloc((1+E->boundary.nel)*sizeof(double));
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for (es=1;es<=E->boundary.nel;es++) {
+ el = E->boundary.element[m][es];
+
+ for (side=SIDE_BEGIN; side<=SIDE_END; side++) {
+ get_side_x_cart(E, xx, el, side, m);
+
+ for(k=1;k<=oned;k++) { /* all of the vpoints*/
+
+ for(d=1;d<=E->mesh.nsd-1;d++)
+ for(e=1;e<=E->mesh.nsd-1;e++)
+ dxda[d][e]=0.0;
+
+ for(i=1;i<=oned;i++) /* nodes */
+ for(d=1;d<=E->mesh.nsd-1;d++)
+ for(e=1;e<=E->mesh.nsd-1;e++)
+ dxda[d][e] += xx[sidedim[side][e]][i]*E->Mx.vpt[GMVXINDEX(d-1,i,k)];
+
+ jacobian = determinant(dxda,E->mesh.nsd-1);
+ E->boundary.det[m][side][k][es] = jacobian;
+ }
+
+ /*
+ fprintf(stderr, "Boundary det: %d %d- %e %e %e %e; sum = %e\n", el, side,
+ E->boundary.det[m][side][1][es],
+ E->boundary.det[m][side][2][es],
+ E->boundary.det[m][side][3][es],
+ E->boundary.det[m][side][4][es],
+ E->boundary.det[m][side][1][es]+
+ E->boundary.det[m][side][2][es]+
+ E->boundary.det[m][side][3][es]+
+ E->boundary.det[m][side][4][es]);
+ */
+ }
+
+
+ }
+}
+
+
+
+/* ======================================================================
+ ====================================================================== */
+void get_global_1d_shape_fn(
+ struct All_variables *E,
+ int el,
+ struct Shape_function1 *GM,
+ struct Shape_function1_dA *dGammax,
+ int top, int m
+ )
+{
+ int ii,i,k,d,e;
+
+ double jacobian;
+
+ const int oned = onedvpoints[E->mesh.nsd];
+
+ double xx[4][5],dxda[4][4];
+
+ for (ii=0;ii<=top;ii++) { /* ii=0 for bottom and ii=1 for top */
+
+ get_side_x_cart(E, xx, el, ii+1, m);
+
+ for(k=1;k<=oned;k++) { /* all of the vpoints*/
+ for(d=1;d<=E->mesh.nsd-1;d++)
+ for(e=1;e<=E->mesh.nsd-1;e++)
+ dxda[d][e]=0.0;
+
+ for(i=1;i<=oned;i++) /* nodes */
+ for(d=1;d<=E->mesh.nsd-1;d++)
+ for(e=1;e<=E->mesh.nsd-1;e++)
+ dxda[d][e] += xx[e][i]*E->Mx.vpt[GMVXINDEX(d-1,i,k)];
+
+ jacobian = determinant(dxda,E->mesh.nsd-1);
+ dGammax->vpt[GMVGAMMA(ii,k)] = jacobian;
+ }
+ }
+
+ return;
+}
+
+/* ======================================================================
+ ====================================================================== */
+void get_global_1d_shape_fn_L(
+ struct All_variables *E,
+ int el,
+ struct Shape_function1 *GM,
+ struct Shape_function1_dA *dGammax,
+ int top, int m
+ )
+{
+ int ii,i,k,d,e,node;
+
+ double jacobian;
+
+ const int oned = onedvpoints[E->mesh.nsd];
+
+ double to,fo,xx[4][5],dxdy[4][4],dxda[4][4],cof[4][4];
+
+#ifdef ALLOW_ELLIPTICAL
+ to = theta_g(E->eco[m][el].centre[1],E);
+#else
+ to = E->eco[m][el].centre[1];
+#endif
+ fo = E->eco[m][el].centre[2];
+
+ dxdy[1][1] = cos(to)*cos(fo);
+ dxdy[1][2] = cos(to)*sin(fo);
+ dxdy[1][3] = -sin(to);
+ dxdy[2][1] = -sin(fo);
+ dxdy[2][2] = cos(fo);
+ dxdy[2][3] = 0.0;
+ dxdy[3][1] = sin(to)*cos(fo);
+ dxdy[3][2] = sin(to)*sin(fo);
+ dxdy[3][3] = cos(to);
+
+ for (ii=0;ii<=top;ii++) { /* ii=0 for bottom and ii=1 for top */
+
+ for(i=1;i<=oned;i++) { /* nodes */
+ e = i+ii*oned;
+ node = E->ien[m][el].node[e];
+ xx[1][i] = E->x[m][1][node]*dxdy[1][1]
+ + E->x[m][2][node]*dxdy[1][2]
+ + E->x[m][3][node]*dxdy[1][3];
+ xx[2][i] = E->x[m][1][node]*dxdy[2][1]
+ + E->x[m][2][node]*dxdy[2][2]
+ + E->x[m][3][node]*dxdy[2][3];
+ xx[3][i] = E->x[m][1][node]*dxdy[3][1]
+ + E->x[m][2][node]*dxdy[3][2]
+ + E->x[m][3][node]*dxdy[3][3];
+ }
+
+ for(k=1;k<=oned;k++) { /* all of the vpoints*/
+
+ for(d=1;d<=E->mesh.nsd-1;d++)
+ for(e=1;e<=E->mesh.nsd-1;e++)
+ dxda[d][e]=0.0;
+
+ for(i=1;i<=oned;i++) /* nodes */
+ for(d=1;d<=E->mesh.nsd-1;d++)
+ for(e=1;e<=E->mesh.nsd-1;e++)
+ dxda[d][e] += xx[e][i]*E->Lx.vpt[GMVXINDEX(d-1,i,k)];
+
+ jacobian = determinant(dxda,E->mesh.nsd-1);
+ dGammax->vpt[GMVGAMMA(ii,k)] = jacobian;
+ }
+ }
+
+ return;
+}
+
+/* ======================================================================
+ For calculating pressure boundary term --- Choi, 11/13/02
+ ====================================================================== */
+void get_global_side_1d_shape_fn(
+ struct All_variables *E,
+ int el,
+ struct Shape_function1 *GM,
+ struct Shape_function1_dx *GMx,
+ struct Shape_function_side_dA *dGamma,
+ int side, int m
+ )
+{
+ int i,k,d,e;
+
+ double jacobian;
+
+ const int oned = onedvpoints[E->mesh.nsd];
+ double xx[4][5],dxda[4][4];
+
+ get_side_x_cart(E, xx, el, side, m);
+
+ for(k=1;k<=oned;k++) {
+
+ for(d=1;d<=E->mesh.nsd-1;d++)
+ for(e=1;e<=E->mesh.nsd-1;e++)
+ dxda[d][e]=0.0;
+
+ for(i=1;i<=oned;i++) {
+ for(d=1;d<=E->mesh.nsd-1;d++)
+ for(e=1;e<=E->mesh.nsd-1;e++) {
+ dxda[d][e] += xx[sidedim[side][e]][i]*E->Mx.vpt[GMVXINDEX(d-1,i,k)];
+ }
+ }
+
+ jacobian = determinant(dxda,E->mesh.nsd-1);
+ dGamma->vpt[k] = jacobian;
+ }
+
+ return;
+}
+
+
+/* ==================================================== */
+
+void construct_c3x3matrix_el (struct All_variables *E,int el,struct CC *cc,
+ struct CCX *ccx,int lev,int m,int pressure)
+{
+ int a,i,j,k,d,lnode;
+ double x[4],u[4][4],ux[3][4][4],ua[4][4];
+ double costt,cosff,sintt,sinff,rr,tt,ff;
+
+ const int dims=E->mesh.nsd;
+ const int ends=enodes[dims];
+ const int vpts=vpoints[dims];
+ const int ppts=ppoints[dims];
+
+ if (pressure==0) {
+ for(k=1;k<=vpts;k++) { /* all of the vpoints */
+ for(d=1;d<=dims;d++)
+ x[d]=0.0;
+
+ for(d=1;d<=dims;d++)
+ for(a=1;a<=ends;a++)
+ x[d] += E->X[lev][m][d][E->IEN[lev][m][el].node[a]]
+ *E->N.vpt[GNVINDEX(a,k)];
+
+ rr = sqrt(x[1]*x[1]+x[2]*x[2]+x[3]*x[3]);
+
+ ff = myatan(x[2],x[1]);
+#ifdef ALLOW_ELLIPTICAL
+ tt = theta_g(acos(x[3]/rr),E);
+#else
+ tt = acos(x[3]/rr);
+#endif
+ costt = cos(tt);
+ cosff = cos(ff);
+ sintt = sin(tt);
+ sinff = sin(ff);
+
+ u[1][1] = costt*cosff; u[1][2] = costt*sinff; u[1][3] =-sintt;
+ u[2][1] =-sinff; u[2][2] = cosff; u[2][3] = 0.0;
+ u[3][1] = sintt*cosff; u[3][2] = sintt*sinff; u[3][3] = costt;
+
+ ux[1][1][1] =-sintt*cosff; ux[1][1][2] =-sintt*sinff; ux[1][1][3] =-costt;
+ ux[2][1][1] =-costt*sinff; ux[2][1][2] = costt*cosff; ux[2][1][3] =0.0;
+ ux[1][2][1] =0.0; ux[1][2][2] = 0.0; ux[1][2][3] =0.0;
+ ux[2][2][1] =-cosff; ux[2][2][2] =-sinff; ux[2][2][3] =0.0;
+ ux[1][3][1] = costt*cosff; ux[1][3][2] = costt*sinff; ux[1][3][3] =-sintt;
+ ux[2][3][1] =-sintt*sinff; ux[2][3][2] = sintt*cosff; ux[2][3][3] =0.0;
+
+ for(a=1;a<=ends;a++) {
+ tt = E->SX[lev][m][1][E->IEN[lev][m][el].node[a]];
+ ff = E->SX[lev][m][2][E->IEN[lev][m][el].node[a]];
+ costt = cos(tt);
+ cosff = cos(ff);
+ sintt = sin(tt);
+ sinff = sin(ff);
+
+ ua[1][1] = costt*cosff; ua[1][2] = costt*sinff; ua[1][3] =-sintt;
+ ua[2][1] =-sinff; ua[2][2] = cosff; ua[2][3] = 0.0;
+ ua[3][1] = sintt*cosff; ua[3][2] = sintt*sinff; ua[3][3] = costt;
+
+ for (i=1;i<=dims;i++)
+ for (j=1;j<=dims;j++) {
+ cc->vpt[BVINDEX(i,j,a,k)] =
+ ua[j][1]*u[i][1]+ua[j][2]*u[i][2]+ua[j][3]*u[i][3];
+ ccx->vpt[BVXINDEX(i,j,1,a,k)] =
+ ua[j][1]*ux[1][i][1]+ua[j][2]*ux[1][i][2]+ua[j][3]*ux[1][i][3];
+ ccx->vpt[BVXINDEX(i,j,2,a,k)] =
+ ua[j][1]*ux[2][i][1]+ua[j][2]*ux[2][i][2]+ua[j][3]*ux[2][i][3];
+ }
+ } /* end for local node */
+
+ } /* end for int points */
+ } /* end if */
+
+ else if (pressure) {
+
+ for(k=1;k<=ppts;k++) { /* all of the ppoints */
+ for(d=1;d<=dims;d++)
+ x[d]=0.0;
+
+ for(d=1;d<=dims;d++)
+ for(a=1;a<=ends;a++)
+ x[d] += E->X[lev][m][d][E->IEN[lev][m][el].node[a]]
+ *E->N.ppt[GNPINDEX(a,k)];
+
+ rr = sqrt(x[1]*x[1]+x[2]*x[2]+x[3]*x[3]);
+
+ ff = myatan(x[2],x[1]);
+#ifdef ALLOW_ELLIPTICAL
+ tt = theta_g(acos(x[3]/rr),E);
+#else
+ tt = acos(x[3]/rr);
+#endif
+ costt = cos(tt);
+ cosff = cos(ff);
+ sintt = sin(tt);
+ sinff = sin(ff);
+
+ u[1][1] = costt*cosff; u[1][2] = costt*sinff; u[1][3] =-sintt;
+ u[2][1] =-sinff; u[2][2] = cosff; u[2][3] = 0.0;
+ u[3][1] = sintt*cosff; u[3][2] = sintt*sinff; u[3][3] = costt;
+
+ ux[1][1][1] =-sintt*cosff; ux[1][1][2] =-sintt*sinff; ux[1][1][3] =-costt;
+ ux[2][1][1] =-costt*sinff; ux[2][1][2] = costt*cosff; ux[2][1][3] =0.0;
+ ux[1][2][1] =0.0; ux[1][2][2] = 0.0; ux[1][2][3] =0.0;
+ ux[2][2][1] =-cosff; ux[2][2][2] =-sinff; ux[2][2][3] =0.0;
+ ux[1][3][1] = costt*cosff; ux[1][3][2] = costt*sinff; ux[1][3][3] =-sintt;
+ ux[2][3][1] =-sintt*sinff; ux[2][3][2] = sintt*cosff; ux[2][3][3] =0.0;
+
+ for(a=1;a<=ends;a++) {
+
+ lnode = E->IEN[lev][m][el].node[a];
+ sintt = E->SinCos[lev][m][0][lnode];
+ sinff = E->SinCos[lev][m][1][lnode];
+ costt = E->SinCos[lev][m][2][lnode];
+ cosff = E->SinCos[lev][m][3][lnode];
+
+ ua[1][1] = costt*cosff; ua[1][2] = costt*sinff; ua[1][3] =-sintt;
+ ua[2][1] =-sinff; ua[2][2] = cosff; ua[2][3] = 0.0;
+ ua[3][1] = sintt*cosff; ua[3][2] = sintt*sinff; ua[3][3] = costt;
+
+ for (i=1;i<=dims;i++)
+ for (j=1;j<=dims;j++) {
+ cc->ppt[BPINDEX(i,j,a,k)] =
+ ua[j][1]*u[i][1]+ua[j][2]*u[i][2]+ua[j][3]*u[i][3];
+ ccx->ppt[BPXINDEX(i,j,1,a,k)] =
+ ua[j][1]*ux[1][i][1]+ua[j][2]*ux[1][i][2]+ua[j][3]*ux[1][i][3];
+ ccx->ppt[BPXINDEX(i,j,2,a,k)] =
+ ua[j][1]*ux[2][i][1]+ua[j][2]*ux[2][i][2]+ua[j][3]*ux[2][i][3];
+ }
+
+ } /* end for local node */
+
+ } /* end for int points */
+
+
+ } /* end if pressure */
+
+ return;
+ }
+
+
+void construct_side_c3x3matrix_el(struct All_variables *E,int el,
+ struct CC *cc,struct CCX *ccx,
+ int lev,int m,int pressure,int side)
+{
+ int a,aa,i,j,k,d,lnode;
+ double x[4],u[4][4],ux[3][4][4],ua[4][4];
+ double costt,cosff,sintt,sinff,rr,tt,ff;
+
+ const int dims=E->mesh.nsd;
+ const int ends=enodes[dims-1];
+ const int vpts=onedvpoints[dims];
+ const int ppts=ppoints[dims];
+
+ if(pressure==0) {
+ for(k=1;k<=vpts;k++) { /* all of the vpoints */
+ for(d=1;d<=dims;d++)
+ x[d]=0.0;
+ for(d=1;d<=dims;d++)
+ for(aa=1;aa<=ends;aa++) {
+ a=sidenodes[side][aa];
+ x[d] += E->X[lev][m][d][E->IEN[lev][m][el].node[a]]
+ *E->M.vpt[GMVINDEX(aa,k)];
+
+ }
+
+ rr = sqrt(x[1]*x[1]+x[2]*x[2]+x[3]*x[3]);
+ tt = acos(x[3]/rr);
+ ff = myatan(x[2],x[1]);
+#ifdef ALLOW_ELLIPTICAL
+ tt = theta_g(acos(x[3]/rr),E);
+#else
+ tt = acos(x[3]/rr);
+#endif
+
+ costt = cos(tt);
+ cosff = cos(ff);
+ sintt = sin(tt);
+ sinff = sin(ff);
+
+ u[1][1] = costt*cosff; u[1][2] = costt*sinff; u[1][3] =-sintt;
+ u[2][1] =-sinff; u[2][2] = cosff; u[2][3] = 0.0;
+ u[3][1] = sintt*cosff; u[3][2] = sintt*sinff; u[3][3] = costt;
+
+ ux[1][1][1] =-sintt*cosff; ux[1][1][2] =-sintt*sinff; ux[1][1][3] =-costt;
+ ux[2][1][1] =-costt*sinff; ux[2][1][2] = costt*cosff; ux[2][1][3] =0.0;
+ ux[1][2][1] =0.0; ux[1][2][2] = 0.0; ux[1][2][3] =0.0;
+ ux[2][2][1] =-cosff; ux[2][2][2] =-sinff; ux[2][2][3] =0.0;
+ ux[1][3][1] = costt*cosff; ux[1][3][2] = costt*sinff; ux[1][3][3] =-sintt;
+ ux[2][3][1] =-sintt*sinff; ux[2][3][2] = sintt*cosff; ux[2][3][3] =0.0;
+
+ for(aa=1;aa<=ends;aa++) {
+ a=sidenodes[side][aa];
+
+ lnode = E->IEN[lev][m][el].node[a];
+ sintt = E->SinCos[lev][m][0][lnode];
+ sinff = E->SinCos[lev][m][1][lnode];
+ costt = E->SinCos[lev][m][2][lnode];
+ cosff = E->SinCos[lev][m][3][lnode];
+
+ ua[1][1] = costt*cosff; ua[1][2] = costt*sinff; ua[1][3] =-sintt;
+ ua[2][1] =-sinff; ua[2][2] = cosff; ua[2][3] = 0.0;
+ ua[3][1] = sintt*cosff; ua[3][2] = sintt*sinff; ua[3][3] = costt;
+
+ for (i=1;i<=dims;i++)
+ for (j=1;j<=dims;j++) {
+ cc->vpt[BVINDEX(i,j,a,k)] =
+ ua[j][1]*u[i][1]+ua[j][2]*u[i][2]+ua[j][3]*u[i][3];
+ ccx->vpt[BVXINDEX(i,j,1,a,k)] =
+ ua[j][1]*ux[1][i][1]+ua[j][2]*ux[1][i][2]+ua[j][3]*ux[1][i][3];
+ ccx->vpt[BVXINDEX(i,j,2,a,k)] =
+ ua[j][1]*ux[2][i][1]+ua[j][2]*ux[2][i][2]+ua[j][3]*ux[2][i][3];
+ }
+
+ } /* end for local node */
+ } /* end for int points */
+ } /* end if */
+ else {
+ for(k=1;k<=ppts;k++) { /* all of the ppoints */
+ for(d=1;d<=E->mesh.nsd;d++)
+ x[d]=0.0;
+ for(a=1;a<=ends;a++) {
+ aa=sidenodes[side][a];
+ x[d] += E->X[lev][m][d][E->IEN[lev][m][el].node[aa]]
+ *E->M.ppt[GMPINDEX(a,k)];
+ }
+ rr = sqrt(x[1]*x[1]+x[2]*x[2]+x[3]*x[3]);
+ ff = myatan(x[2],x[1]);
+
+#ifdef ALLOW_ELLIPTICAL
+ tt = theta_g(acos(x[3]/rr),E);
+#else
+ tt = acos(x[3]/rr);
+#endif
+ costt = cos(tt);
+ cosff = cos(ff);
+ sintt = sin(tt);
+ sinff = sin(ff);
+
+ u[1][1] = costt*cosff; u[1][2] = costt*sinff; u[1][3] =-sintt;
+ u[2][1] =-sinff; u[2][2] = cosff; u[2][3] = 0.0;
+ u[3][1] = sintt*cosff; u[3][2] = sintt*sinff; u[3][3] = costt;
+
+ ux[1][1][1] =-sintt*cosff; ux[1][1][2] =-sintt*sinff; ux[1][1][3] =-costt;
+ ux[2][1][1] =-costt*sinff; ux[2][1][2] = costt*cosff; ux[2][1][3] =0.0;
+ ux[1][2][1] =0.0; ux[1][2][2] = 0.0; ux[1][2][3] =0.0;
+ ux[2][2][1] =-cosff; ux[2][2][2] =-sinff; ux[2][2][3] =0.0;
+ ux[1][3][1] = costt*cosff; ux[1][3][2] = costt*sinff; ux[1][3][3] =-sintt;
+ ux[2][3][1] =-sintt*sinff; ux[2][3][2] = sintt*cosff; ux[2][3][3] =0.0;
+
+ for(a=1;a<=ends;a++) {
+ aa=sidenodes[side][a];
+
+ lnode = E->IEN[lev][m][el].node[aa];
+ sintt = E->SinCos[lev][m][0][lnode];
+ sinff = E->SinCos[lev][m][1][lnode];
+ costt = E->SinCos[lev][m][2][lnode];
+ cosff = E->SinCos[lev][m][3][lnode];
+
+ ua[1][1] = costt*cosff; ua[1][2] = costt*sinff; ua[1][3] =-sintt;
+ ua[2][1] =-sinff; ua[2][2] = cosff; ua[2][3] = 0.0;
+ ua[3][1] = sintt*cosff; ua[3][2] = sintt*sinff; ua[3][3] = costt;
+
+ for (i=1;i<=E->mesh.nsd;i++) {
+ for (j=1;j<=E->mesh.nsd;j++) {
+ cc->ppt[BPINDEX(i,j,a,k)] =
+ ua[j][1]*u[i][1]+ua[j][2]*u[i][2]+ua[j][3]*u[i][3];
+ ccx->ppt[BPXINDEX(i,j,1,a,k)] =
+ ua[j][1]*ux[1][i][1]+ua[j][2]*ux[1][i][2]+ua[j][3]*ux[1][i][3];
+ ccx->ppt[BPXINDEX(i,j,2,a,k)] =
+ ua[j][1]*ux[2][i][1]+ua[j][2]*ux[2][i][2]+ua[j][3]*ux[2][i][3];
+ }
+ }
+ } /* end for local node */
+ } /* end for int points */
+ } /* end if pressure */
+
+ return;
+}
+
+
+/* ======================================= */
+void construct_c3x3matrix(struct All_variables *E)
+{
+ int m,a,i,j,k,d,es,el,nel_surface,lev,lnode;
+ double x[4],u[4][4],ux[3][4][4],ua[4][4];
+ double costt,cosff,sintt,sinff,rr,tt,ff;
+
+ const int dims=E->mesh.nsd;
+ const int ends=enodes[dims];
+ const int vpts=vpoints[dims];
+ const int ppts=ppoints[dims];
+
+ for (lev=E->mesh.gridmin;lev<=E->mesh.gridmax;lev++)
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ nel_surface = E->lmesh.NEL[lev]/E->lmesh.ELZ[lev];
+ for (es=1;es<=nel_surface;es++) {
+
+ el = es*E->lmesh.ELZ[lev];
+
+ for(k=1;k<=vpts;k++) { /* all of the vpoints */
+ for(d=1;d<=dims;d++)
+ x[d]=0.0;
+
+ for(d=1;d<=dims;d++)
+ for(a=1;a<=ends;a++)
+ x[d] += E->X[lev][m][d][E->IEN[lev][m][el].node[a]]
+ *E->N.vpt[GNVINDEX(a,k)];
+
+ rr = sqrt(x[1]*x[1]+x[2]*x[2]+x[3]*x[3]);
+ ff = myatan(x[2],x[1]);
+#ifdef ALLOW_ELLIPTICAL
+ tt = theta_g(acos(x[3]/rr),E);
+#else
+ tt = acos(x[3]/rr);
+#endif
+
+ costt = cos(tt);
+ cosff = cos(ff);
+ sintt = sin(tt);
+ sinff = sin(ff);
+
+ u[1][1] = costt*cosff; u[1][2] = costt*sinff; u[1][3] =-sintt;
+ u[2][1] =-sinff; u[2][2] = cosff; u[2][3] = 0.0;
+ u[3][1] = sintt*cosff; u[3][2] = sintt*sinff; u[3][3] = costt;
+
+ ux[1][1][1] =-sintt*cosff; ux[1][1][2] =-sintt*sinff; ux[1][1][3] =-costt;
+ ux[2][1][1] =-costt*sinff; ux[2][1][2] = costt*cosff; ux[2][1][3] =0.0;
+ ux[1][2][1] =0.0; ux[1][2][2] = 0.0; ux[1][2][3] =0.0;
+ ux[2][2][1] =-cosff; ux[2][2][2] =-sinff; ux[2][2][3] =0.0;
+ ux[1][3][1] = costt*cosff; ux[1][3][2] = costt*sinff; ux[1][3][3] =-sintt;
+ ux[2][3][1] =-sintt*sinff; ux[2][3][2] = sintt*cosff; ux[2][3][3] =0.0;
+
+ for(a=1;a<=ends;a++) {
+
+ lnode = E->IEN[lev][m][el].node[a];
+ sintt = E->SinCos[lev][m][0][lnode];
+ sinff = E->SinCos[lev][m][1][lnode];
+ costt = E->SinCos[lev][m][2][lnode];
+ cosff = E->SinCos[lev][m][3][lnode];
+
+ ua[1][1] = costt*cosff; ua[1][2] = costt*sinff; ua[1][3] =-sintt;
+ ua[2][1] =-sinff; ua[2][2] = cosff; ua[2][3] = 0.0;
+ ua[3][1] = sintt*cosff; ua[3][2] = sintt*sinff; ua[3][3] = costt;
+
+ for (i=1;i<=dims;i++)
+ for (j=1;j<=dims;j++) {
+ E->CC[lev][m][es].vpt[BVINDEX(i,j,a,k)] =
+ ua[j][1]*u[i][1]+ua[j][2]*u[i][2]+ua[j][3]*u[i][3];
+ E->CCX[lev][m][es].vpt[BVXINDEX(i,j,1,a,k)] =
+ ua[j][1]*ux[1][i][1]+ua[j][2]*ux[1][i][2]+ua[j][3]*ux[1][i][3];
+ E->CCX[lev][m][es].vpt[BVXINDEX(i,j,2,a,k)] =
+ ua[j][1]*ux[2][i][1]+ua[j][2]*ux[2][i][2]+ua[j][3]*ux[2][i][3];
+ }
+ } /* end for local node */
+
+ } /* end for int points */
+
+ for(k=1;k<=ppts;k++) { /* all of the ppoints */
+ for(d=1;d<=dims;d++)
+ x[d]=0.0;
+
+ for(d=1;d<=dims;d++)
+ for(a=1;a<=ends;a++)
+ x[d] += E->X[lev][m][d][E->IEN[lev][m][el].node[a]]
+ *E->N.ppt[GNPINDEX(a,k)];
+
+ rr = sqrt(x[1]*x[1]+x[2]*x[2]+x[3]*x[3]);
+ ff = myatan(x[2],x[1]);
+#ifdef ALLOW_ELLIPTICAL
+ tt = theta_g(acos(x[3]/rr),E);
+#else
+ tt = acos(x[3]/rr);
+#endif
+
+ costt = cos(tt);
+ cosff = cos(ff);
+ sintt = sin(tt);
+ sinff = sin(ff);
+
+ u[1][1] = costt*cosff; u[1][2] = costt*sinff; u[1][3] =-sintt;
+ u[2][1] =-sinff; u[2][2] = cosff; u[2][3] = 0.0;
+ u[3][1] = sintt*cosff; u[3][2] = sintt*sinff; u[3][3] = costt;
+
+ ux[1][1][1] =-sintt*cosff; ux[1][1][2] =-sintt*sinff; ux[1][1][3] =-costt;
+ ux[2][1][1] =-costt*sinff; ux[2][1][2] = costt*cosff; ux[2][1][3] =0.0;
+ ux[1][2][1] =0.0; ux[1][2][2] = 0.0; ux[1][2][3] =0.0;
+ ux[2][2][1] =-cosff; ux[2][2][2] =-sinff; ux[2][2][3] =0.0;
+ ux[1][3][1] = costt*cosff; ux[1][3][2] = costt*sinff; ux[1][3][3] =-sintt;
+ ux[2][3][1] =-sintt*sinff; ux[2][3][2] = sintt*cosff; ux[2][3][3] =0.0;
+
+ for(a=1;a<=ends;a++) {
+
+ lnode = E->IEN[lev][m][el].node[a];
+ sintt = E->SinCos[lev][m][0][lnode];
+ sinff = E->SinCos[lev][m][1][lnode];
+ costt = E->SinCos[lev][m][2][lnode];
+ cosff = E->SinCos[lev][m][3][lnode];
+
+
+ ua[1][1] = costt*cosff; ua[1][2] = costt*sinff; ua[1][3] =-sintt;
+ ua[2][1] =-sinff; ua[2][2] = cosff; ua[2][3] = 0.0;
+ ua[3][1] = sintt*cosff; ua[3][2] = sintt*sinff; ua[3][3] = costt;
+
+ for (i=1;i<=dims;i++)
+ for (j=1;j<=dims;j++) {
+ E->CC[lev][m][es].ppt[BPINDEX(i,j,a,k)] =
+ ua[j][1]*u[i][1]+ua[j][2]*u[i][2]+ua[j][3]*u[i][3];
+ E->CCX[lev][m][es].ppt[BPXINDEX(i,j,1,a,k)] =
+ ua[j][1]*ux[1][i][1]+ua[j][2]*ux[1][i][2]+ua[j][3]*ux[1][i][3];
+ E->CCX[lev][m][es].ppt[BPXINDEX(i,j,2,a,k)] =
+ ua[j][1]*ux[2][i][1]+ua[j][2]*ux[2][i][2]+ua[j][3]*ux[2][i][3];
+ }
+
+ } /* end for local node */
+
+ } /* end for int points */
+
+
+ } /* end for es */
+ } /* end for m */
+
+ return;
+ }
+
+
+
+/* ==========================================
+ construct the lumped mass matrix. The full
+ matrix is the FE integration of the density
+ field. The lumped version is the diagonal
+ matrix obtained by letting the shape function
+ Na be delta(a,b)
+ ========================================== */
+
+void mass_matrix(struct All_variables *E)
+{
+ int m,node,i,nint,e,lev;
+ int n[9], nz;
+ double area,centre[4],temp[9],temp2[9],dx1,dx2,dx3;
+
+ const int vpts=vpoints[E->mesh.nsd];
+
+ /* ECO .size can also be defined here */
+
+ for(lev=E->mesh.levmin;lev<=E->mesh.levmax;lev++) {
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+
+ for(node=1;node<=E->lmesh.NNO[lev];node++)
+ E->MASS[lev][m][node] = 0.0;
+
+ for(e=1;e<=E->lmesh.NEL[lev];e++) {
+
+ area = centre[1] = centre[2] = centre[3] = 0.0;
+
+ for(node=1;node<=enodes[E->mesh.nsd];node++)
+ n[node] = E->IEN[lev][m][e].node[node];
+
+ for(i=1;i<=E->mesh.nsd;i++) {
+ for(node=1;node<=enodes[E->mesh.nsd];node++)
+ centre[i] += E->X[lev][m][i][n[node]];
+
+ centre[i] = centre[i]/enodes[E->mesh.nsd];
+ } /* end for i */
+
+ /* dx3=radius, dx1=theta, dx2=phi */
+ dx3 = sqrt(centre[1]*centre[1]+centre[2]*centre[2]+centre[3]*centre[3]);
+ dx1 = acos( centre[3]/dx3 );
+ dx2 = myatan(centre[2],centre[1]);
+
+ /* center of this element in the spherical coordinate */
+ E->ECO[lev][m][e].centre[1] = dx1;
+ E->ECO[lev][m][e].centre[2] = dx2;
+ E->ECO[lev][m][e].centre[3] = dx3;
+
+ /* delta(theta) of this element */
+ dx1 = max( fabs(E->SX[lev][m][1][n[3]]-E->SX[lev][m][1][n[1]]),
+ fabs(E->SX[lev][m][1][n[2]]-E->SX[lev][m][1][n[4]]) );
+
+ /* length of this element in the theta-direction */
+ E->ECO[lev][m][e].size[1] = dx1*E->ECO[lev][m][e].centre[3];
+
+ /* delta(phi) of this element */
+ dx1 = fabs(E->SX[lev][m][2][n[3]]-E->SX[lev][m][2][n[1]]);
+ if (dx1>M_PI)
+ dx1 = min(E->SX[lev][m][2][n[3]],E->SX[lev][m][2][n[1]]) + 2.0*M_PI -
+ max(E->SX[lev][m][2][n[3]],E->SX[lev][m][2][n[1]]) ;
+
+ dx2 = fabs(E->SX[lev][m][2][n[2]]-E->SX[lev][m][2][n[4]]);
+ if (dx2>M_PI)
+ dx2 = min(E->SX[lev][m][2][n[2]],E->SX[lev][m][2][n[4]]) + 2.0*M_PI -
+ max(E->SX[lev][m][2][n[2]],E->SX[lev][m][2][n[4]]) ;
+
+ dx2 = max(dx1,dx2);
+
+ /* length of this element in the phi-direction */
+ E->ECO[lev][m][e].size[2] = dx2*E->ECO[lev][m][e].centre[3]
+ *sin(E->ECO[lev][m][e].centre[1]);
+
+ /* delta(radius) of this element */
+ dx3 = 0.25*(fabs(E->SX[lev][m][3][n[5]]+E->SX[lev][m][3][n[6]]
+ +E->SX[lev][m][3][n[7]]+E->SX[lev][m][3][n[8]]
+ -E->SX[lev][m][3][n[1]]-E->SX[lev][m][3][n[2]]
+ -E->SX[lev][m][3][n[3]]-E->SX[lev][m][3][n[4]]));
+
+ /* length of this element in the radius-direction */
+ E->ECO[lev][m][e].size[3] = dx3;
+
+ /* volume (area in 2D) of this element */
+ for(nint=1;nint<=vpts;nint++)
+ area += g_point[nint].weight[E->mesh.nsd-1] * E->GDA[lev][m][e].vpt[nint];
+ E->ECO[lev][m][e].area = area;
+
+ for(node=1;node<=enodes[E->mesh.nsd];node++) {
+ temp[node] = 0.0;
+ for(nint=1;nint<=vpts;nint++)
+ temp[node] += E->GDA[lev][m][e].vpt[nint]*g_point[nint].weight[E->mesh.nsd-1]
+ *E->N.vpt[GNVINDEX(node,nint)]; /* int Na dV */
+ }
+
+ for(node=1;node<=enodes[E->mesh.nsd];node++)
+ E->MASS[lev][m][E->IEN[lev][m][e].node[node]] += temp[node];
+
+ /* weight of each node, equivalent to pmass in ConMan */
+ for(node=1;node<=enodes[E->mesh.nsd];node++)
+ E->TWW[lev][m][e].node[node] = temp[node];
+
+
+ } /* end of ele*/
+
+ } /* end of for m */
+
+ if(lev == E->mesh.levmax)
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for(node=1;node<=E->lmesh.NNO[lev];node++)
+ E->NMass[m][node] = E->MASS[lev][m][node];
+
+ if (E->control.NMULTIGRID||E->control.EMULTIGRID||E->mesh.levmax==lev)
+ (E->exchange_node_d)(E,E->MASS[lev],lev);
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for(node=1;node<=E->lmesh.NNO[lev];node++)
+ E->MASS[lev][m][node] = 1.0/E->MASS[lev][m][node];
+
+ } /* end of for lev */
+
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+
+ for(node=1;node<=E->lmesh.nno;node++)
+ E->TMass[m][node] = 0.0;
+
+ for(e=1;e<=E->lmesh.nel;e++) {
+ for(node=1;node<=enodes[E->mesh.nsd];node++) {
+ temp[node] = 0.0;
+ nz = ((E->ien[m][e].node[node]-1) % E->lmesh.noz) + 1;
+ for(nint=1;nint<=vpts;nint++)
+ temp[node] += E->refstate.rho[nz]
+ * E->refstate.heat_capacity[nz]
+ * E->gDA[m][e].vpt[nint]
+ * g_point[nint].weight[E->mesh.nsd-1]
+ * E->N.vpt[GNVINDEX(node,nint)];
+ }
+
+ /* lumped mass matrix, equivalent to tmass in ConMan */
+ for(node=1;node<=enodes[E->mesh.nsd];node++)
+ E->TMass[m][E->ien[m][e].node[node]] += temp[node];
+
+ } /* end of for e */
+ } /* end of for m */
+
+ (E->exchange_node_d)(E,E->TMass,E->mesh.levmax);
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for(node=1;node<=E->lmesh.nno;node++)
+ E->TMass[m][node] = 1.0 / E->TMass[m][node];
+
+
+ /* compute volume of this processor mesh and the whole mesh */
+ E->lmesh.volume = 0;
+ E->mesh.volume = 0;
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for(e=1;e<=E->lmesh.nel;e++)
+ E->lmesh.volume += E->eco[m][e].area;
+
+ MPI_Allreduce(&E->lmesh.volume, &E->mesh.volume, 1, MPI_DOUBLE,
+ MPI_SUM, E->parallel.world);
+
+
+ if (E->control.verbose) {
+ fprintf(E->fp_out, "rank=%d my_volume=%e total_volume=%e\n",
+ E->parallel.me, E->lmesh.volume, E->mesh.volume);
+
+ for(lev=E->mesh.levmin;lev<=E->mesh.levmax;lev++) {
+ fprintf(E->fp_out,"output_mass lev=%d\n",lev);
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ fprintf(E->fp_out,"m=%d %d \n",E->sphere.capid[m],m);
+ for(e=1;e<=E->lmesh.NEL[lev];e++)
+ fprintf(E->fp_out,"%d %g \n",e,E->ECO[lev][m][e].area);
+ for (node=1;node<=E->lmesh.NNO[lev];node++)
+ fprintf(E->fp_out,"Mass[%d]= %g \n",node,E->MASS[lev][m][node]);
+ }
+ }
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ fprintf(E->fp_out,"m=%d %d \n",E->sphere.capid[m],m);
+ for (node=1;node<=E->lmesh.nno;node++)
+ fprintf(E->fp_out,"TMass[%d]= %g \n",node,E->TMass[m][node]);
+ }
+ fflush(E->fp_out);
+ }
+
+ return;
+}
+
+
+/* version */
+/* $Id$ */
+
+/* End of file */
Deleted: mc/3D/CitcomS/branches/cxx/lib/Solver_conj_grad.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Solver_conj_grad.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Solver_conj_grad.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,69 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-#include "element_definitions.h"
-#include "global_defs.h"
-
-void set_cg_defaults(E)
- struct All_variables *E;
-{ void assemble_forces_iterative();
- void solve_constrained_flow_iterative();
- void cg_allocate_vars();
-
- E->build_forcing_term = assemble_forces_iterative;
- E->solve_stokes_problem = solve_constrained_flow_iterative;
- E->solver_allocate_vars = cg_allocate_vars;
-
-
- return;
-}
-
-void cg_allocate_vars(E)
- struct All_variables *E;
-{
- /* Nothing required ONLY by conj-grad stuff */
- /* printf("here here\n"); */
-
- return;
-
-}
-
-void assemble_forces_iterative(E)
- struct All_variables *E;
-{
- int i;
-
- void assemble_forces();
- void strip_bcs_from_residual();
-
- assemble_forces(E,0);
-
- strip_bcs_from_residual(E,E->F,E->mesh.levmax);
-
- return;
-
-}
Copied: mc/3D/CitcomS/branches/cxx/lib/Solver_conj_grad.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Solver_conj_grad.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Solver_conj_grad.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Solver_conj_grad.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,62 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+#include "element_definitions.h"
+#include "global_defs.h"
+
+#include "cproto.h"
+
+void set_cg_defaults(struct All_variables *E)
+{
+ E->build_forcing_term = assemble_forces_iterative;
+ E->solve_stokes_problem = solve_constrained_flow_iterative;
+ E->solver_allocate_vars = cg_allocate_vars;
+
+
+ return;
+}
+
+void cg_allocate_vars(struct All_variables *E)
+{
+ /* Nothing required ONLY by conj-grad stuff */
+ /* printf("here here\n"); */
+
+ return;
+
+}
+
+void assemble_forces_iterative(struct All_variables *E)
+{
+ int i;
+
+ assemble_forces(E,0);
+
+ strip_bcs_from_residual(E,E->F,E->mesh.levmax);
+
+ return;
+
+}
Deleted: mc/3D/CitcomS/branches/cxx/lib/Solver_multigrid.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Solver_multigrid.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Solver_multigrid.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,672 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-#include "element_definitions.h"
-#include "global_defs.h"
-#include <math.h>
-
-
-void set_mg_defaults(E)
- struct All_variables *E;
-{ void assemble_forces_iterative();
- void solve_constrained_flow_iterative();
- void mg_allocate_vars();
-
- E->build_forcing_term = assemble_forces_iterative;
- E->solve_stokes_problem = solve_constrained_flow_iterative;
- E->solver_allocate_vars = mg_allocate_vars;
-
-
-return;
-}
-
-void mg_allocate_vars(E)
- struct All_variables *E;
-{
- return;
-
-}
-
-
-/* =====================================================
- Function to inject data from fine to coarse grid (i.e.
- just dropping values at shared grid points.
- ===================================================== */
-
-void inject_scalar(E,start_lev,AU,AD)
- struct All_variables *E;
- int start_lev;
- float **AU,**AD; /* data on upper/lower mesh */
-
-{
- int i,m,el,node_coarse,node_fine,sl_minus,eqn,eqn_coarse;
- void gather_to_1layer_node ();
-
- const int dims = E->mesh.nsd;
- const int ends = enodes[dims];
-
- if(start_lev == E->mesh.levmin) {
- fprintf(E->fp,"Warning, attempting to project below lowest level\n");
- return;
- }
-
- sl_minus = start_lev-1;
-
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for(el=1;el<=E->lmesh.NEL[sl_minus];el++)
- for(i=1;i<=ends;i++) {
- node_coarse = E->IEN[sl_minus][m][el].node[i];
- node_fine=E->IEN[start_lev][m][E->EL[sl_minus][m][el].sub[i]].node[i];
- AD[m][node_coarse] = AU[m][node_fine];
- }
-
- return;
-}
-
-void inject_vector(E,start_lev,AU,AD)
- struct All_variables *E;
- int start_lev;
- double **AU,**AD; /* data on upper/lower mesh */
-
-{
- int i,j,m,el,node_coarse,node_fine,sl_minus,eqn_fine,eqn_coarse;
-
- const int dims = E->mesh.nsd;
- const int ends = enodes[dims];
-
- void gather_to_1layer_id ();
-
- if(start_lev == E->mesh.levmin) {
- fprintf(E->fp,"Warning, attempting to project below lowest level\n");
- return;
- }
-
- sl_minus = start_lev-1;
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for(el=1;el<=E->lmesh.NEL[sl_minus];el++)
- for(i=1;i<=ends;i++) {
- node_coarse = E->IEN[sl_minus][m][el].node[i];
- node_fine=E->IEN[start_lev][m][E->EL[sl_minus][m][el].sub[i]].node[i];
- for (j=1;j<=dims;j++) {
- eqn_fine = E->ID[start_lev][m][node_fine].doff[j];
- eqn_coarse = E->ID[sl_minus][m][node_coarse].doff[j];
- AD[m][eqn_coarse] = AU[m][eqn_fine];
- }
- }
-
- return;
-}
-
-
-/* =====================================================
- Function to inject data from coarse to fine grid (i.e.
- just dropping values at shared grid points.
- ===================================================== */
-
-void un_inject_vector(E,start_lev,AD,AU)
-
- struct All_variables *E;
- int start_lev;
- double **AU,**AD; /* data on upper/lower mesh */
-{
- int i,m;
- int el,node,node_plus;
- int eqn1,eqn_plus1;
- int eqn2,eqn_plus2;
- int eqn3,eqn_plus3;
-
- const int dims = E->mesh.nsd;
- const int ends = enodes[dims];
- const int sl_plus = start_lev+1;
- const int neq = E->lmesh.NEQ[sl_plus];
- const int nels = E->lmesh.NEL[start_lev];
-
- assert(start_lev != E->mesh.levmax /* un_injection */);
-
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=1;i<neq;i++)
- AU[m][i]=0.0;
-
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(el=1;el<=nels;el++)
- for(i=1;i<=ENODES3D;i++) {
- node = E->IEN[start_lev][m][el].node[i];
- node_plus=E->IEN[sl_plus][m][E->EL[start_lev][m][el].sub[i]].node[i];
-
- eqn1 = E->ID[start_lev][m][node].doff[1];
- eqn2 = E->ID[start_lev][m][node].doff[2];
- eqn3 = E->ID[start_lev][m][node].doff[3];
- eqn_plus1 = E->ID[sl_plus][m][node_plus].doff[1];
- eqn_plus2 = E->ID[sl_plus][m][node_plus].doff[2];
- eqn_plus3 = E->ID[sl_plus][m][node_plus].doff[3];
- AU[m][eqn_plus1] = AD[m][eqn1];
- AU[m][eqn_plus2] = AD[m][eqn2];
- AU[m][eqn_plus3] = AD[m][eqn3];
- }
-
- return;
- }
-
-
-/* =======================================================================================
- Interpolation from coarse grid to fine. See the appology attached to project() if you get
- stressed out by node based assumptions. If it makes you feel any better, I don't like
- it much either.
- ======================================================================================= */
-
-
-void interp_vector(E,start_lev,AD,AU)
-
- struct All_variables *E;
- int start_lev;
- double **AD,**AU; /* data on upper/lower mesh */
-{
- void un_inject_vector();
- void fill_in_gaps();
- void from_rtf_to_xyz();
- void from_xyz_to_rtf();
- void scatter_to_nlayer_id();
-
- int i,j,k,m;
- float x1,x2;
- float n1,n2;
- int noxz,node0,node1,node2;
- int eqn0,eqn1,eqn2;
-
- const int level = start_lev + 1;
- const int dims =E->mesh.nsd;
- const int ends= enodes[dims];
-
- const int nox = E->lmesh.NOX[level];
- const int noz = E->lmesh.NOZ[level];
- const int noy = E->lmesh.NOY[level];
- const int high_eqn = E->lmesh.NEQ[level];
-
- if (start_lev==E->mesh.levmax) return;
-
- from_rtf_to_xyz(E,start_lev,AD,AU); /* transform in xyz coordinates */
- un_inject_vector(E,start_lev,AU,E->temp); /* information from lower level */
- fill_in_gaps(E,E->temp,level);
- from_xyz_to_rtf(E,level,E->temp,AU); /* get back to rtf coordinates */
-
-
- return;
-
-}
-
-
-/* ==============================================
- function to project viscosity down to all the
- levels in the problem. (no gaps for vbcs)
- ============================================== */
-
-void project_viscosity(E)
- struct All_variables *E;
-
-{
- int lv,i,j,k,m,sl_minus;
- void inject_scalar();
- void project_scalar();
- void project_scalar_e();
- void inject_scalar_e();
- void visc_from_gint_to_nodes();
- void visc_from_nodes_to_gint();
- void visc_from_gint_to_ele();
- void visc_from_ele_to_gint();
-
- const int nsd=E->mesh.nsd;
- const int vpts=vpoints[nsd];
-
- float *viscU[NCS],*viscD[NCS];
-
- lv = E->mesh.levmax;
-
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
- viscU[m]=(float *)malloc((1+E->lmesh.NNO[lv])*sizeof(float));
- viscD[m]=(float *)malloc((1+vpts*E->lmesh.NEL[lv-1])*sizeof(float));
- }
-
- for(lv=E->mesh.levmax;lv>E->mesh.levmin;lv--) {
-
- sl_minus = lv -1;
-
- if (E->viscosity.smooth_cycles==1) {
- visc_from_gint_to_nodes(E,E->EVI[lv],viscU,lv);
- project_scalar(E,lv,viscU,viscD);
- visc_from_nodes_to_gint(E,viscD,E->EVI[sl_minus],sl_minus);
- }
- else if (E->viscosity.smooth_cycles==2) {
- visc_from_gint_to_ele(E,E->EVI[lv],viscU,lv);
- inject_scalar_e(E,lv,viscU,E->EVI[sl_minus]);
- }
- else if (E->viscosity.smooth_cycles==3) {
- visc_from_gint_to_ele(E,E->EVI[lv],viscU,lv);
- project_scalar_e(E,lv,viscU,viscD);
- visc_from_ele_to_gint(E,viscD,E->EVI[sl_minus],sl_minus);
- }
- else if (E->viscosity.smooth_cycles==0) {
-/* visc_from_gint_to_nodes(E,E->EVI[lv],viscU,lv);
- inject_scalar(E,lv,viscU,viscD);
- visc_from_nodes_to_gint(E,viscD,E->EVI[sl_minus],sl_minus); */
-
- inject_scalar(E,lv,E->VI[lv],E->VI[sl_minus]);
- visc_from_nodes_to_gint(E,E->VI[sl_minus],E->EVI[sl_minus],sl_minus);
- }
-
-
-/* for(m=1;m<=E->sphere.caps_per_proc;m++) {
- for (i=1;i<=E->lmesh.NEL[lv-1];i++)
- fprintf (E->fp_out,"%d %g\n",i,viscD[m][i]);
- for (i=1;i<=E->lmesh.NEL[lv];i++)
- fprintf (E->fp_out,"%d %g\n",i,viscU[m][i]);
- }
-*/
- }
-
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
- free((void *)viscU[m]);
- free((void *)viscD[m]);
- }
-
- return;
-}
-
-/* ==================================================== */
-void inject_scalar_e(E,start_lev,AU,AD)
-
- struct All_variables *E;
- int start_lev;
- float **AU,**AD; /* data on upper/lower mesh */
-{
- int i,j,m;
- int el,node,e;
- float average,w;
- void gather_to_1layer_ele ();
-
- const int sl_minus = start_lev-1;
- const int nels_minus=E->lmesh.NEL[start_lev-1];
- const int dims=E->mesh.nsd;
- const int ends=enodes[E->mesh.nsd];
- const int vpts=vpoints[E->mesh.nsd];
- const int n_minus=nels_minus*vpts;
-
-
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=1;i<=n_minus;i++)
- AD[m][i] = 0.0;
-
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(el=1;el<=nels_minus;el++)
- for(i=1;i<=ENODES3D;i++) {
- e = E->EL[sl_minus][m][el].sub[i];
- AD[m][(el-1)*vpts+i] = AU[m][e];
- }
-
-return;
-}
-
-/* ==================================================== */
-void project_scalar_e(E,start_lev,AU,AD)
-
- struct All_variables *E;
- int start_lev;
- float **AU,**AD; /* data on upper/lower mesh */
-{
- int i,j,m;
- int el,node,e;
- float average,w;
- void gather_to_1layer_ele ();
-
- const int sl_minus = start_lev-1;
- const int nels_minus=E->lmesh.NEL[start_lev-1];
- const int dims=E->mesh.nsd;
- const int ends=enodes[E->mesh.nsd];
- const double weight=(double) 1.0/ends;
- const int vpts=vpoints[E->mesh.nsd];
- const int n_minus=nels_minus*vpts;
-
-
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=1;i<=n_minus;i++)
- AD[m][i] = 0.0;
-
-
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(el=1;el<=nels_minus;el++) {
- average=0.0;
- for(i=1;i<=ENODES3D;i++) {
- e = E->EL[sl_minus][m][el].sub[i];
- average += AU[m][e];
- }
-
- AD[m][el] = average*weight;
- }
-return;
-}
-
-/* ==================================================== */
-void project_scalar(E,start_lev,AU,AD)
-
- struct All_variables *E;
- int start_lev;
- float **AU,**AD; /* data on upper/lower mesh */
-{
- int i,j,m;
- int el,node,node1;
- float average,w;
- void gather_to_1layer_node ();
-
- const int sl_minus = start_lev-1;
- const int nno_minus=E->lmesh.NNO[start_lev-1];
- const int nels_minus=E->lmesh.NEL[start_lev-1];
- const int dims=E->mesh.nsd;
- const int ends=enodes[E->mesh.nsd];
- const double weight=(double) 1.0/ends;
-
-
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=1;i<=nno_minus;i++)
- AD[m][i] = 0.0;
-
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(el=1;el<=nels_minus;el++)
- for(i=1;i<=ENODES3D;i++) {
- average=0.0;
- node1 = E->EL[sl_minus][m][el].sub[i];
- for(j=1;j<=ENODES3D;j++) {
- node=E->IEN[start_lev][m][node1].node[j];
- average += AU[m][node];
- }
-
- w=weight*average;
-
- node= E->IEN[sl_minus][m][el].node[i];
-
- AD[m][node] += w * E->TWW[sl_minus][m][el].node[i];
- }
-
- (E->exchange_node_f)(E,AD,sl_minus);
-
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=1;i<=nno_minus;i++) {
- AD[m][i] *= E->MASS[sl_minus][m][i];
- }
-
-
-return;
-}
-
-/* this is prefered scheme with averages */
-
-void project_vector(E,start_lev,AU,AD,ic)
-
- struct All_variables *E;
- int start_lev,ic;
- double **AU,**AD; /* data on upper/lower mesh */
-{
- int i,j,m;
- int el,node1,node,e1;
- int eqn1,eqn_minus1;
- int eqn2,eqn_minus2;
- int eqn3,eqn_minus3;
- double average1,average2,average3,w,weight;
- float CPU_time(),time;
-
- void from_rtf_to_xyz();
- void from_xyz_to_rtf();
- void gather_to_1layer_id ();
-
- const int sl_minus = start_lev-1;
- const int neq_minus=E->lmesh.NEQ[start_lev-1];
- const int nno_minus=E->lmesh.NNO[start_lev-1];
- const int nels_minus=E->lmesh.NEL[start_lev-1];
- const int dims=E->mesh.nsd;
- const int ends=enodes[E->mesh.nsd];
-
-
- if (ic==1)
- weight = 1.0;
- else
- weight=(double) 1.0/ends;
-
- if (start_lev==E->mesh.levmin) return;
-
- /* convert into xyz coordinates */
- from_rtf_to_xyz(E,start_lev,AU,E->temp);
-
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=0;i<neq_minus;i++)
- E->temp1[m][i] = 0.0;
-
- /* smooth in xyz coordinates */
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(el=1;el<=nels_minus;el++)
- for(i=1;i<=ENODES3D;i++) {
- node= E->IEN[sl_minus][m][el].node[i];
- average1=average2=average3=0.0;
- e1 = E->EL[sl_minus][m][el].sub[i];
- for(j=1;j<=ENODES3D;j++) {
- node1=E->IEN[start_lev][m][e1].node[j];
- average1 += E->temp[m][E->ID[start_lev][m][node1].doff[1]];
- average2 += E->temp[m][E->ID[start_lev][m][node1].doff[2]];
- average3 += E->temp[m][E->ID[start_lev][m][node1].doff[3]];
- }
- w = weight*E->TWW[sl_minus][m][el].node[i];
-
- E->temp1[m][E->ID[sl_minus][m][node].doff[1]] += w * average1;
- E->temp1[m][E->ID[sl_minus][m][node].doff[2]] += w * average2;
- E->temp1[m][E->ID[sl_minus][m][node].doff[3]] += w * average3;
- }
-
-
- (E->solver.exchange_id_d)(E, E->temp1, sl_minus);
-
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=1;i<=nno_minus;i++) {
- E->temp1[m][E->ID[sl_minus][m][i].doff[1]] *= E->MASS[sl_minus][m][i];
- E->temp1[m][E->ID[sl_minus][m][i].doff[2]] *= E->MASS[sl_minus][m][i];
- E->temp1[m][E->ID[sl_minus][m][i].doff[3]] *= E->MASS[sl_minus][m][i];
- }
-
- /* back into rtf coordinates */
- from_xyz_to_rtf(E,sl_minus,E->temp1,AD);
-
- return;
- }
-
-/* ================================================= */
- void from_xyz_to_rtf(E,level,xyz,rtf)
- struct All_variables *E;
- int level;
- double **rtf,**xyz;
- {
-
- int i,j,m,eqn1,eqn2,eqn3;
- double cost,cosf,sint,sinf;
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for (i=1;i<=E->lmesh.NNO[level];i++) {
- eqn1 = E->ID[level][m][i].doff[1];
- eqn2 = E->ID[level][m][i].doff[2];
- eqn3 = E->ID[level][m][i].doff[3];
- sint = E->SinCos[level][m][0][i];
- sinf = E->SinCos[level][m][1][i];
- cost = E->SinCos[level][m][2][i];
- cosf = E->SinCos[level][m][3][i];
- rtf[m][eqn1] = xyz[m][eqn1]*cost*cosf
- + xyz[m][eqn2]*cost*sinf
- - xyz[m][eqn3]*sint;
- rtf[m][eqn2] = -xyz[m][eqn1]*sinf
- + xyz[m][eqn2]*cosf;
- rtf[m][eqn3] = xyz[m][eqn1]*sint*cosf
- + xyz[m][eqn2]*sint*sinf
- + xyz[m][eqn3]*cost;
- }
-
- return;
- }
-
-/* ================================================= */
- void from_rtf_to_xyz(E,level,rtf,xyz)
- struct All_variables *E;
- int level;
- double **rtf,**xyz;
- {
-
- int i,j,m,eqn1,eqn2,eqn3;
- double cost,cosf,sint,sinf;
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for (i=1;i<=E->lmesh.NNO[level];i++) {
- eqn1 = E->ID[level][m][i].doff[1];
- eqn2 = E->ID[level][m][i].doff[2];
- eqn3 = E->ID[level][m][i].doff[3];
- sint = E->SinCos[level][m][0][i];
- sinf = E->SinCos[level][m][1][i];
- cost = E->SinCos[level][m][2][i];
- cosf = E->SinCos[level][m][3][i];
- xyz[m][eqn1] = rtf[m][eqn1]*cost*cosf
- - rtf[m][eqn2]*sinf
- + rtf[m][eqn3]*sint*cosf;
- xyz[m][eqn2] = rtf[m][eqn1]*cost*sinf
- + rtf[m][eqn2]*cosf
- + rtf[m][eqn3]*sint*sinf;
- xyz[m][eqn3] = -rtf[m][eqn1]*sint
- + rtf[m][eqn3]*cost;
-
- }
-
- return;
- }
-
- /* ========================================================== */
- void fill_in_gaps(E,temp,level)
- struct All_variables *E;
- int level;
- double **temp;
- {
-
- int i,j,k,m;
- float x1,x2;
- float n1,n2;
- int rnoz,noxz,node0,node1,node2;
- int eqn0,eqn1,eqn2;
-
- const int dims =E->mesh.nsd;
- const int ends= enodes[dims];
-
- const int nox = E->lmesh.NOX[level];
- const int noz = E->lmesh.NOZ[level];
- const int noy = E->lmesh.NOY[level];
- const int sl_minus = level-1;
-
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
- n1 = n2 =0.5;
- noxz = nox*noz;
- for(k=1;k<=noy;k+=2) /* Fill in gaps in x direction */
- for(j=1;j<=noz;j+=2)
- for(i=2;i<nox;i+=2) {
- node0 = j + (i-1)*noz + (k-1)*noxz; /* this node */
- node1 = node0 - noz;
- node2 = node0 + noz;
-
- /* now for each direction */
-
- eqn0=E->ID[level][m][node0].doff[1];
- eqn1=E->ID[level][m][node1].doff[1];
- eqn2=E->ID[level][m][node2].doff[1];
- temp[m][eqn0] = n1*temp[m][eqn1]+n2*temp[m][eqn2];
-
- eqn0=E->ID[level][m][node0].doff[2];
- eqn1=E->ID[level][m][node1].doff[2];
- eqn2=E->ID[level][m][node2].doff[2];
- temp[m][eqn0] = n1*temp[m][eqn1]+n2*temp[m][eqn2];
-
- eqn0=E->ID[level][m][node0].doff[3];
- eqn1=E->ID[level][m][node1].doff[3];
- eqn2=E->ID[level][m][node2].doff[3];
- temp[m][eqn0] = n1*temp[m][eqn1]+n2*temp[m][eqn2];
- }
-
- n1 = n2 =0.5;
- for(i=1;i<=nox;i++) /* Fill in gaps in y direction */
- for(j=1;j<=noz;j+=2)
- for(k=2;k<noy;k+=2) {
- node0 = j + (i-1)*noz + (k-1)*noxz; /* this node */
- node1 = node0 - noxz;
- node2 = node0 + noxz;
-
- eqn0=E->ID[level][m][node0].doff[1];
- eqn1=E->ID[level][m][node1].doff[1];
- eqn2=E->ID[level][m][node2].doff[1];
- temp[m][eqn0] = n1*temp[m][eqn1]+n2*temp[m][eqn2];
-
- eqn0=E->ID[level][m][node0].doff[2];
- eqn1=E->ID[level][m][node1].doff[2];
- eqn2=E->ID[level][m][node2].doff[2];
- temp[m][eqn0] = n1*temp[m][eqn1]+n2*temp[m][eqn2];
-
- eqn0=E->ID[level][m][node0].doff[3];
- eqn1=E->ID[level][m][node1].doff[3];
- eqn2=E->ID[level][m][node2].doff[3];
- temp[m][eqn0] = n1*temp[m][eqn1]+n2*temp[m][eqn2];
- }
-
-
- for(j=2;j<noz;j+=2) {
- x1 = E->sphere.R[level][j] - E->sphere.R[level][j-1];
- x2 = E->sphere.R[level][j+1] - E->sphere.R[level][j];
- n1 = x2/(x1+x2);
- n2 = 1.0-n1;
- for(k=1;k<=noy;k++) /* Fill in gaps in z direction */
- for(i=1;i<=nox;i++) {
- node0 = j + (i-1)*noz + (k-1)*noxz; /* this node */
- node1 = node0 - 1;
- node2 = node0 + 1;
-
- eqn0=E->ID[level][m][node0].doff[1];
- eqn1=E->ID[level][m][node1].doff[1];
- eqn2=E->ID[level][m][node2].doff[1];
- temp[m][eqn0] = n1*temp[m][eqn1]+n2*temp[m][eqn2];
-
- eqn0=E->ID[level][m][node0].doff[2];
- eqn1=E->ID[level][m][node1].doff[2];
- eqn2=E->ID[level][m][node2].doff[2];
- temp[m][eqn0] = n1*temp[m][eqn1]+n2*temp[m][eqn2];
-
- eqn0=E->ID[level][m][node0].doff[3];
- eqn1=E->ID[level][m][node1].doff[3];
- eqn2=E->ID[level][m][node2].doff[3];
- temp[m][eqn0] = n1*temp[m][eqn1]+n2*temp[m][eqn2];
- }
- }
- } /* end for m */
-
- return;
- }
Copied: mc/3D/CitcomS/branches/cxx/lib/Solver_multigrid.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Solver_multigrid.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Solver_multigrid.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Solver_multigrid.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,647 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+#include "element_definitions.h"
+#include "global_defs.h"
+#include <math.h>
+
+#include "cproto.h"
+
+
+void set_mg_defaults(struct All_variables *E)
+{
+ E->build_forcing_term = assemble_forces_iterative;
+ E->solve_stokes_problem = solve_constrained_flow_iterative;
+ E->solver_allocate_vars = mg_allocate_vars;
+
+
+return;
+}
+
+void mg_allocate_vars(struct All_variables *E)
+{
+ return;
+
+}
+
+
+/* =====================================================
+ Function to inject data from fine to coarse grid (i.e.
+ just dropping values at shared grid points.
+ ===================================================== */
+
+void inject_scalar(
+ struct All_variables *E,
+ int start_lev,
+ float **AU, float **AD /* data on upper/lower mesh */
+ )
+{
+ int i,m,el,node_coarse,node_fine,sl_minus,eqn,eqn_coarse;
+
+ const int dims = E->mesh.nsd;
+ const int ends = enodes[dims];
+
+ if(start_lev == E->mesh.levmin) {
+ fprintf(E->fp,"Warning, attempting to project below lowest level\n");
+ return;
+ }
+
+ sl_minus = start_lev-1;
+
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for(el=1;el<=E->lmesh.NEL[sl_minus];el++)
+ for(i=1;i<=ends;i++) {
+ node_coarse = E->IEN[sl_minus][m][el].node[i];
+ node_fine=E->IEN[start_lev][m][E->EL[sl_minus][m][el].sub[i]].node[i];
+ AD[m][node_coarse] = AU[m][node_fine];
+ }
+
+ return;
+}
+
+void inject_vector(
+ struct All_variables *E,
+ int start_lev,
+ double **AU, double **AD /* data on upper/lower mesh */
+ )
+{
+ int i,j,m,el,node_coarse,node_fine,sl_minus,eqn_fine,eqn_coarse;
+
+ const int dims = E->mesh.nsd;
+ const int ends = enodes[dims];
+
+ if(start_lev == E->mesh.levmin) {
+ fprintf(E->fp,"Warning, attempting to project below lowest level\n");
+ return;
+ }
+
+ sl_minus = start_lev-1;
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for(el=1;el<=E->lmesh.NEL[sl_minus];el++)
+ for(i=1;i<=ends;i++) {
+ node_coarse = E->IEN[sl_minus][m][el].node[i];
+ node_fine=E->IEN[start_lev][m][E->EL[sl_minus][m][el].sub[i]].node[i];
+ for (j=1;j<=dims;j++) {
+ eqn_fine = E->ID[start_lev][m][node_fine].doff[j];
+ eqn_coarse = E->ID[sl_minus][m][node_coarse].doff[j];
+ AD[m][eqn_coarse] = AU[m][eqn_fine];
+ }
+ }
+
+ return;
+}
+
+
+/* =====================================================
+ Function to inject data from coarse to fine grid (i.e.
+ just dropping values at shared grid points.
+ ===================================================== */
+
+void un_inject_vector(
+ struct All_variables *E,
+ int start_lev,
+ double **AD, double **AU /* data on upper/lower mesh */
+ )
+{
+ int i,m;
+ int el,node,node_plus;
+ int eqn1,eqn_plus1;
+ int eqn2,eqn_plus2;
+ int eqn3,eqn_plus3;
+
+ const int dims = E->mesh.nsd;
+ const int ends = enodes[dims];
+ const int sl_plus = start_lev+1;
+ const int neq = E->lmesh.NEQ[sl_plus];
+ const int nels = E->lmesh.NEL[start_lev];
+
+ assert(start_lev != E->mesh.levmax /* un_injection */);
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=1;i<neq;i++)
+ AU[m][i]=0.0;
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(el=1;el<=nels;el++)
+ for(i=1;i<=ENODES3D;i++) {
+ node = E->IEN[start_lev][m][el].node[i];
+ node_plus=E->IEN[sl_plus][m][E->EL[start_lev][m][el].sub[i]].node[i];
+
+ eqn1 = E->ID[start_lev][m][node].doff[1];
+ eqn2 = E->ID[start_lev][m][node].doff[2];
+ eqn3 = E->ID[start_lev][m][node].doff[3];
+ eqn_plus1 = E->ID[sl_plus][m][node_plus].doff[1];
+ eqn_plus2 = E->ID[sl_plus][m][node_plus].doff[2];
+ eqn_plus3 = E->ID[sl_plus][m][node_plus].doff[3];
+ AU[m][eqn_plus1] = AD[m][eqn1];
+ AU[m][eqn_plus2] = AD[m][eqn2];
+ AU[m][eqn_plus3] = AD[m][eqn3];
+ }
+
+ return;
+ }
+
+
+/* =======================================================================================
+ Interpolation from coarse grid to fine. See the appology attached to project() if you get
+ stressed out by node based assumptions. If it makes you feel any better, I don't like
+ it much either.
+ ======================================================================================= */
+
+
+void interp_vector(
+ struct All_variables *E,
+ int start_lev,
+ double **AD, double **AU /* data on upper/lower mesh */
+ )
+{
+ int i,j,k,m;
+ float x1,x2;
+ float n1,n2;
+ int noxz,node0,node1,node2;
+ int eqn0,eqn1,eqn2;
+
+ const int level = start_lev + 1;
+ const int dims =E->mesh.nsd;
+ const int ends= enodes[dims];
+
+ const int nox = E->lmesh.NOX[level];
+ const int noz = E->lmesh.NOZ[level];
+ const int noy = E->lmesh.NOY[level];
+ const int high_eqn = E->lmesh.NEQ[level];
+
+ if (start_lev==E->mesh.levmax) return;
+
+ from_rtf_to_xyz(E,start_lev,AD,AU); /* transform in xyz coordinates */
+ un_inject_vector(E,start_lev,AU,E->temp); /* information from lower level */
+ fill_in_gaps(E,E->temp,level);
+ from_xyz_to_rtf(E,level,E->temp,AU); /* get back to rtf coordinates */
+
+
+ return;
+
+}
+
+
+/* ==============================================
+ function to project viscosity down to all the
+ levels in the problem. (no gaps for vbcs)
+ ============================================== */
+
+void project_viscosity(struct All_variables *E)
+{
+ int lv,i,j,k,m,sl_minus;
+
+ const int nsd=E->mesh.nsd;
+ const int vpts=vpoints[nsd];
+
+ float *viscU[NCS],*viscD[NCS];
+
+ lv = E->mesh.levmax;
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+ viscU[m]=(float *)malloc((1+E->lmesh.NNO[lv])*sizeof(float));
+ viscD[m]=(float *)malloc((1+vpts*E->lmesh.NEL[lv-1])*sizeof(float));
+ }
+
+ for(lv=E->mesh.levmax;lv>E->mesh.levmin;lv--) {
+
+ sl_minus = lv -1;
+
+ if (E->viscosity.smooth_cycles==1) {
+ visc_from_gint_to_nodes(E,E->EVI[lv],viscU,lv);
+ project_scalar(E,lv,viscU,viscD);
+ visc_from_nodes_to_gint(E,viscD,E->EVI[sl_minus],sl_minus);
+ }
+ else if (E->viscosity.smooth_cycles==2) {
+ visc_from_gint_to_ele(E,E->EVI[lv],viscU,lv);
+ inject_scalar_e(E,lv,viscU,E->EVI[sl_minus]);
+ }
+ else if (E->viscosity.smooth_cycles==3) {
+ visc_from_gint_to_ele(E,E->EVI[lv],viscU,lv);
+ project_scalar_e(E,lv,viscU,viscD);
+ visc_from_ele_to_gint(E,viscD,E->EVI[sl_minus],sl_minus);
+ }
+ else if (E->viscosity.smooth_cycles==0) {
+/* visc_from_gint_to_nodes(E,E->EVI[lv],viscU,lv);
+ inject_scalar(E,lv,viscU,viscD);
+ visc_from_nodes_to_gint(E,viscD,E->EVI[sl_minus],sl_minus); */
+
+ inject_scalar(E,lv,E->VI[lv],E->VI[sl_minus]);
+ visc_from_nodes_to_gint(E,E->VI[sl_minus],E->EVI[sl_minus],sl_minus);
+ }
+
+
+/* for(m=1;m<=E->sphere.caps_per_proc;m++) {
+ for (i=1;i<=E->lmesh.NEL[lv-1];i++)
+ fprintf (E->fp_out,"%d %g\n",i,viscD[m][i]);
+ for (i=1;i<=E->lmesh.NEL[lv];i++)
+ fprintf (E->fp_out,"%d %g\n",i,viscU[m][i]);
+ }
+*/
+ }
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+ free((void *)viscU[m]);
+ free((void *)viscD[m]);
+ }
+
+ return;
+}
+
+/* ==================================================== */
+void inject_scalar_e(
+ struct All_variables *E,
+ int start_lev,
+ float **AU, float **AD /* data on upper/lower mesh */
+ )
+{
+ int i,j,m;
+ int el,node,e;
+ float average,w;
+
+ const int sl_minus = start_lev-1;
+ const int nels_minus=E->lmesh.NEL[start_lev-1];
+ const int dims=E->mesh.nsd;
+ const int ends=enodes[E->mesh.nsd];
+ const int vpts=vpoints[E->mesh.nsd];
+ const int n_minus=nels_minus*vpts;
+
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=1;i<=n_minus;i++)
+ AD[m][i] = 0.0;
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(el=1;el<=nels_minus;el++)
+ for(i=1;i<=ENODES3D;i++) {
+ e = E->EL[sl_minus][m][el].sub[i];
+ AD[m][(el-1)*vpts+i] = AU[m][e];
+ }
+
+return;
+}
+
+/* ==================================================== */
+void project_scalar_e(
+ struct All_variables *E,
+ int start_lev,
+ float **AU, float **AD /* data on upper/lower mesh */
+ )
+{
+ int i,j,m;
+ int el,node,e;
+ float average,w;
+
+ const int sl_minus = start_lev-1;
+ const int nels_minus=E->lmesh.NEL[start_lev-1];
+ const int dims=E->mesh.nsd;
+ const int ends=enodes[E->mesh.nsd];
+ const double weight=(double) 1.0/ends;
+ const int vpts=vpoints[E->mesh.nsd];
+ const int n_minus=nels_minus*vpts;
+
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=1;i<=n_minus;i++)
+ AD[m][i] = 0.0;
+
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(el=1;el<=nels_minus;el++) {
+ average=0.0;
+ for(i=1;i<=ENODES3D;i++) {
+ e = E->EL[sl_minus][m][el].sub[i];
+ average += AU[m][e];
+ }
+
+ AD[m][el] = average*weight;
+ }
+return;
+}
+
+/* ==================================================== */
+void project_scalar(
+ struct All_variables *E,
+ int start_lev,
+ float **AU, float **AD /* data on upper/lower mesh */
+ )
+{
+ int i,j,m;
+ int el,node,node1;
+ float average,w;
+
+ const int sl_minus = start_lev-1;
+ const int nno_minus=E->lmesh.NNO[start_lev-1];
+ const int nels_minus=E->lmesh.NEL[start_lev-1];
+ const int dims=E->mesh.nsd;
+ const int ends=enodes[E->mesh.nsd];
+ const double weight=(double) 1.0/ends;
+
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=1;i<=nno_minus;i++)
+ AD[m][i] = 0.0;
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(el=1;el<=nels_minus;el++)
+ for(i=1;i<=ENODES3D;i++) {
+ average=0.0;
+ node1 = E->EL[sl_minus][m][el].sub[i];
+ for(j=1;j<=ENODES3D;j++) {
+ node=E->IEN[start_lev][m][node1].node[j];
+ average += AU[m][node];
+ }
+
+ w=weight*average;
+
+ node= E->IEN[sl_minus][m][el].node[i];
+
+ AD[m][node] += w * E->TWW[sl_minus][m][el].node[i];
+ }
+
+ (E->exchange_node_f)(E,AD,sl_minus);
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=1;i<=nno_minus;i++) {
+ AD[m][i] *= E->MASS[sl_minus][m][i];
+ }
+
+
+return;
+}
+
+/* this is prefered scheme with averages */
+
+void project_vector(
+ struct All_variables *E,
+ int start_lev,
+ double **AU, double **AD, /* data on upper/lower mesh */
+ int ic
+ )
+{
+ int i,j,m;
+ int el,node1,node,e1;
+ int eqn1,eqn_minus1;
+ int eqn2,eqn_minus2;
+ int eqn3,eqn_minus3;
+ double average1,average2,average3,w,weight;
+ float time;
+
+ const int sl_minus = start_lev-1;
+ const int neq_minus=E->lmesh.NEQ[start_lev-1];
+ const int nno_minus=E->lmesh.NNO[start_lev-1];
+ const int nels_minus=E->lmesh.NEL[start_lev-1];
+ const int dims=E->mesh.nsd;
+ const int ends=enodes[E->mesh.nsd];
+
+
+ if (ic==1)
+ weight = 1.0;
+ else
+ weight=(double) 1.0/ends;
+
+ if (start_lev==E->mesh.levmin) return;
+
+ /* convert into xyz coordinates */
+ from_rtf_to_xyz(E,start_lev,AU,E->temp);
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=0;i<neq_minus;i++)
+ E->temp1[m][i] = 0.0;
+
+ /* smooth in xyz coordinates */
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(el=1;el<=nels_minus;el++)
+ for(i=1;i<=ENODES3D;i++) {
+ node= E->IEN[sl_minus][m][el].node[i];
+ average1=average2=average3=0.0;
+ e1 = E->EL[sl_minus][m][el].sub[i];
+ for(j=1;j<=ENODES3D;j++) {
+ node1=E->IEN[start_lev][m][e1].node[j];
+ average1 += E->temp[m][E->ID[start_lev][m][node1].doff[1]];
+ average2 += E->temp[m][E->ID[start_lev][m][node1].doff[2]];
+ average3 += E->temp[m][E->ID[start_lev][m][node1].doff[3]];
+ }
+ w = weight*E->TWW[sl_minus][m][el].node[i];
+
+ E->temp1[m][E->ID[sl_minus][m][node].doff[1]] += w * average1;
+ E->temp1[m][E->ID[sl_minus][m][node].doff[2]] += w * average2;
+ E->temp1[m][E->ID[sl_minus][m][node].doff[3]] += w * average3;
+ }
+
+
+ (E->solver.exchange_id_d)(E, E->temp1, sl_minus);
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=1;i<=nno_minus;i++) {
+ E->temp1[m][E->ID[sl_minus][m][i].doff[1]] *= E->MASS[sl_minus][m][i];
+ E->temp1[m][E->ID[sl_minus][m][i].doff[2]] *= E->MASS[sl_minus][m][i];
+ E->temp1[m][E->ID[sl_minus][m][i].doff[3]] *= E->MASS[sl_minus][m][i];
+ }
+
+ /* back into rtf coordinates */
+ from_xyz_to_rtf(E,sl_minus,E->temp1,AD);
+
+ return;
+ }
+
+/* ================================================= */
+ void from_xyz_to_rtf(
+ struct All_variables *E,
+ int level,
+ double **xyz, double **rtf
+ )
+{
+
+ int i,j,m,eqn1,eqn2,eqn3;
+ double cost,cosf,sint,sinf;
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for (i=1;i<=E->lmesh.NNO[level];i++) {
+ eqn1 = E->ID[level][m][i].doff[1];
+ eqn2 = E->ID[level][m][i].doff[2];
+ eqn3 = E->ID[level][m][i].doff[3];
+ sint = E->SinCos[level][m][0][i];
+ sinf = E->SinCos[level][m][1][i];
+ cost = E->SinCos[level][m][2][i];
+ cosf = E->SinCos[level][m][3][i];
+ rtf[m][eqn1] = xyz[m][eqn1]*cost*cosf
+ + xyz[m][eqn2]*cost*sinf
+ - xyz[m][eqn3]*sint;
+ rtf[m][eqn2] = -xyz[m][eqn1]*sinf
+ + xyz[m][eqn2]*cosf;
+ rtf[m][eqn3] = xyz[m][eqn1]*sint*cosf
+ + xyz[m][eqn2]*sint*sinf
+ + xyz[m][eqn3]*cost;
+ }
+
+ return;
+ }
+
+/* ================================================= */
+ void from_rtf_to_xyz(
+ struct All_variables *E,
+ int level,
+ double **rtf, double **xyz
+ )
+ {
+
+ int i,j,m,eqn1,eqn2,eqn3;
+ double cost,cosf,sint,sinf;
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for (i=1;i<=E->lmesh.NNO[level];i++) {
+ eqn1 = E->ID[level][m][i].doff[1];
+ eqn2 = E->ID[level][m][i].doff[2];
+ eqn3 = E->ID[level][m][i].doff[3];
+ sint = E->SinCos[level][m][0][i];
+ sinf = E->SinCos[level][m][1][i];
+ cost = E->SinCos[level][m][2][i];
+ cosf = E->SinCos[level][m][3][i];
+ xyz[m][eqn1] = rtf[m][eqn1]*cost*cosf
+ - rtf[m][eqn2]*sinf
+ + rtf[m][eqn3]*sint*cosf;
+ xyz[m][eqn2] = rtf[m][eqn1]*cost*sinf
+ + rtf[m][eqn2]*cosf
+ + rtf[m][eqn3]*sint*sinf;
+ xyz[m][eqn3] = -rtf[m][eqn1]*sint
+ + rtf[m][eqn3]*cost;
+
+ }
+
+ return;
+ }
+
+ /* ========================================================== */
+ void fill_in_gaps(
+ struct All_variables *E,
+ double **temp,
+ int level
+ )
+ {
+
+ int i,j,k,m;
+ float x1,x2;
+ float n1,n2;
+ int rnoz,noxz,node0,node1,node2;
+ int eqn0,eqn1,eqn2;
+
+ const int dims =E->mesh.nsd;
+ const int ends= enodes[dims];
+
+ const int nox = E->lmesh.NOX[level];
+ const int noz = E->lmesh.NOZ[level];
+ const int noy = E->lmesh.NOY[level];
+ const int sl_minus = level-1;
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+ n1 = n2 =0.5;
+ noxz = nox*noz;
+ for(k=1;k<=noy;k+=2) /* Fill in gaps in x direction */
+ for(j=1;j<=noz;j+=2)
+ for(i=2;i<nox;i+=2) {
+ node0 = j + (i-1)*noz + (k-1)*noxz; /* this node */
+ node1 = node0 - noz;
+ node2 = node0 + noz;
+
+ /* now for each direction */
+
+ eqn0=E->ID[level][m][node0].doff[1];
+ eqn1=E->ID[level][m][node1].doff[1];
+ eqn2=E->ID[level][m][node2].doff[1];
+ temp[m][eqn0] = n1*temp[m][eqn1]+n2*temp[m][eqn2];
+
+ eqn0=E->ID[level][m][node0].doff[2];
+ eqn1=E->ID[level][m][node1].doff[2];
+ eqn2=E->ID[level][m][node2].doff[2];
+ temp[m][eqn0] = n1*temp[m][eqn1]+n2*temp[m][eqn2];
+
+ eqn0=E->ID[level][m][node0].doff[3];
+ eqn1=E->ID[level][m][node1].doff[3];
+ eqn2=E->ID[level][m][node2].doff[3];
+ temp[m][eqn0] = n1*temp[m][eqn1]+n2*temp[m][eqn2];
+ }
+
+ n1 = n2 =0.5;
+ for(i=1;i<=nox;i++) /* Fill in gaps in y direction */
+ for(j=1;j<=noz;j+=2)
+ for(k=2;k<noy;k+=2) {
+ node0 = j + (i-1)*noz + (k-1)*noxz; /* this node */
+ node1 = node0 - noxz;
+ node2 = node0 + noxz;
+
+ eqn0=E->ID[level][m][node0].doff[1];
+ eqn1=E->ID[level][m][node1].doff[1];
+ eqn2=E->ID[level][m][node2].doff[1];
+ temp[m][eqn0] = n1*temp[m][eqn1]+n2*temp[m][eqn2];
+
+ eqn0=E->ID[level][m][node0].doff[2];
+ eqn1=E->ID[level][m][node1].doff[2];
+ eqn2=E->ID[level][m][node2].doff[2];
+ temp[m][eqn0] = n1*temp[m][eqn1]+n2*temp[m][eqn2];
+
+ eqn0=E->ID[level][m][node0].doff[3];
+ eqn1=E->ID[level][m][node1].doff[3];
+ eqn2=E->ID[level][m][node2].doff[3];
+ temp[m][eqn0] = n1*temp[m][eqn1]+n2*temp[m][eqn2];
+ }
+
+
+ for(j=2;j<noz;j+=2) {
+ x1 = E->sphere.R[level][j] - E->sphere.R[level][j-1];
+ x2 = E->sphere.R[level][j+1] - E->sphere.R[level][j];
+ n1 = x2/(x1+x2);
+ n2 = 1.0-n1;
+ for(k=1;k<=noy;k++) /* Fill in gaps in z direction */
+ for(i=1;i<=nox;i++) {
+ node0 = j + (i-1)*noz + (k-1)*noxz; /* this node */
+ node1 = node0 - 1;
+ node2 = node0 + 1;
+
+ eqn0=E->ID[level][m][node0].doff[1];
+ eqn1=E->ID[level][m][node1].doff[1];
+ eqn2=E->ID[level][m][node2].doff[1];
+ temp[m][eqn0] = n1*temp[m][eqn1]+n2*temp[m][eqn2];
+
+ eqn0=E->ID[level][m][node0].doff[2];
+ eqn1=E->ID[level][m][node1].doff[2];
+ eqn2=E->ID[level][m][node2].doff[2];
+ temp[m][eqn0] = n1*temp[m][eqn1]+n2*temp[m][eqn2];
+
+ eqn0=E->ID[level][m][node0].doff[3];
+ eqn1=E->ID[level][m][node1].doff[3];
+ eqn2=E->ID[level][m][node2].doff[3];
+ temp[m][eqn0] = n1*temp[m][eqn1]+n2*temp[m][eqn2];
+ }
+ }
+ } /* end for m */
+
+ return;
+ }
Deleted: mc/3D/CitcomS/branches/cxx/lib/Sphere_harmonics.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Sphere_harmonics.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Sphere_harmonics.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,238 +0,0 @@
-/* Functions relating to the building and use of mesh locations ... */
-
-
-#include <math.h>
-#include <sys/types.h>
-#include "element_definitions.h"
-#include "global_defs.h"
-#include <stdlib.h>
-
-static void compute_sphereh_table(struct All_variables *);
-
-/* ======================================================================
- ====================================================================== */
-
-void set_sphere_harmonics(E)
- struct All_variables *E;
-
-{
- int m,node,ll,mm,i,j;
-
- i=0;
- for (ll=0;ll<=E->output.llmax;ll++)
- for (mm=0;mm<=ll;mm++) {
- E->sphere.hindex[ll][mm] = i;
- i++;
- }
-
- E->sphere.hindice = i;
-
- /* spherical harmonic coeff (0=cos, 1=sin)
- for surface topo, cmb topo and geoid */
- for (i=0;i<=1;i++) {
- E->sphere.harm_geoid[i]=(float*)malloc(E->sphere.hindice*sizeof(float));
- E->sphere.harm_geoid_from_bncy[i]=(float*)malloc(E->sphere.hindice*sizeof(float));
- E->sphere.harm_geoid_from_bncy_botm[i]=(float*)malloc(E->sphere.hindice*sizeof(float));
- E->sphere.harm_geoid_from_tpgt[i]=(float*)malloc(E->sphere.hindice*sizeof(float));
- E->sphere.harm_geoid_from_tpgb[i]=(float*)malloc(E->sphere.hindice*sizeof(float));
-
- E->sphere.harm_tpgt[i]=(float*)malloc(E->sphere.hindice*sizeof(float));
- E->sphere.harm_tpgb[i]=(float*)malloc(E->sphere.hindice*sizeof(float));
- }
-
- compute_sphereh_table(E);
-
- return;
-}
-
-/* =====================================
- Generalized Legendre polynomials
- =====================================*/
-double modified_plgndr_a(int l, int m, double t)
-{
- int i,ll;
- double x,fact1,fact2,fact,pll,pmm,pmmp1,somx2,plgndr;
- const double three=3.0;
- const double two=2.0;
- const double one=1.0;
-
- x = cos(t);
- pmm=one;
- if(m>0) {
- somx2=sqrt((one-x)*(one+x));
- fact1= three;
- fact2= two;
- for (i=1;i<=m;i++) {
- fact=sqrt(fact1/fact2);
- pmm = -pmm*fact*somx2;
- fact1+= two;
- fact2+= two;
- }
- }
-
- if (l==m)
- plgndr = pmm;
- else {
- pmmp1 = x*sqrt(two*m+three)*pmm;
- if(l==m+1)
- plgndr = pmmp1;
- else {
- for (ll=m+2;ll<=l;ll++) {
- fact1= sqrt((4.0*ll*ll-one)*(double)(ll-m)/(double)(ll+m));
- fact2= sqrt((2.0*ll+one)*(ll-m)*(ll+m-one)*(ll-m-one)
- /(double)((two*ll-three)*(ll+m)));
- pll = ( x*fact1*pmmp1-fact2*pmm)/(ll-m);
- pmm = pmmp1;
- pmmp1 = pll;
- }
- plgndr = pll;
- }
- }
-
- plgndr /= sqrt(4.0*M_PI);
-
- if (m!=0) plgndr *= sqrt(two);
-
- return plgndr;
-}
-
-
-/* =========================================================
- expand the field TG into spherical harmonics
- ========================================================= */
-void sphere_expansion(E,TG,sphc,sphs)
- struct All_variables *E;
- float **TG,*sphc,*sphs;
-{
- int el,nint,d,p,i,m,j,es,mm,ll,rand();
- void sum_across_surf_sph1();
-
- for (i=0;i<E->sphere.hindice;i++) {
- sphc[i] = 0.0;
- sphs[i] = 0.0;
- }
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for (es=1;es<=E->lmesh.snel;es++) {
-
- for (ll=0;ll<=E->output.llmax;ll++)
- for (mm=0; mm<=ll; mm++) {
-
- p = E->sphere.hindex[ll][mm];
-
- for(nint=1;nint<=onedvpoints[E->mesh.nsd];nint++) {
- for(d=1;d<=onedvpoints[E->mesh.nsd];d++) {
- j = E->sien[m][es].node[d];
- sphc[p] += TG[m][E->sien[m][es].node[d]]
- * E->sphere.tablesplm[m][j][p]
- * E->sphere.tablescosf[m][j][mm]
- * E->M.vpt[GMVINDEX(d,nint)]
- * E->surf_det[m][nint][es];
- sphs[p] += TG[m][E->sien[m][es].node[d]]
- * E->sphere.tablesplm[m][j][p]
- * E->sphere.tablessinf[m][j][mm]
- * E->M.vpt[GMVINDEX(d,nint)]
- * E->surf_det[m][nint][es];
- }
- }
-
- } /* end for ll and mm */
-
- }
-
- sum_across_surf_sph1(E,sphc,sphs);
-
- return;
-}
-
-
-void debug_sphere_expansion(struct All_variables *E)
-{
- /* expand temperature field (which should be a sph. harm. load)
- * and output the expansion coeff. to stderr
- */
- int m, i, j, k, p, node;
- int ll, mm;
- float *TT[NCS], *sph_harm[2];
-
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- TT[m] = (float *) malloc ((E->lmesh.nsf+1)*sizeof(float));
-
- /* sin coeff */
- sph_harm[0] = (float*)malloc(E->sphere.hindice*sizeof(float));
- /* cos coeff */
- sph_harm[1] = (float*)malloc(E->sphere.hindice*sizeof(float));
-
- for(k=1;k<=E->lmesh.noz;k++) {
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=1;i<=E->lmesh.noy;i++)
- for(j=1;j<=E->lmesh.nox;j++) {
- node= k + (j-1)*E->lmesh.noz + (i-1)*E->lmesh.nox*E->lmesh.noz;
- p = j + (i-1)*E->lmesh.nox;
- TT[m][p] = E->T[m][node];
- }
-
- /* expand TT into spherical harmonics */
- sphere_expansion(E, TT, sph_harm[0], sph_harm[1]);
-
- /* only the first nprocz CPU needs output */
- if(E->parallel.me < E->parallel.nprocz) {
- for (ll=0;ll<=E->output.llmax;ll++)
- for (mm=0; mm<=ll; mm++) {
- p = E->sphere.hindex[ll][mm];
- fprintf(stderr, "T expanded layer=%d ll=%d mm=%d -- %12g %12g\n",
- k+E->lmesh.nzs-1, ll, mm,
- sph_harm[0][p], sph_harm[1][p]);
- }
- }
- }
-
- return;
-}
-
-
-/* ==================================================*/
-/* ==================================================*/
-static void compute_sphereh_table(E)
- struct All_variables *E;
-{
- double modified_plgndr_a();
-
- int m,node,ll,mm,i,j,p;
- double t,f,mmf;
-
-
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
- E->sphere.tablesplm[m] = (double **) malloc((E->lmesh.nsf+1)*sizeof(double*));
- E->sphere.tablescosf[m] = (double **) malloc((E->lmesh.nsf+1)*sizeof(double*));
- E->sphere.tablessinf[m] = (double **) malloc((E->lmesh.nsf+1)*sizeof(double*));
-
- for (i=1;i<=E->lmesh.nsf;i++) {
- E->sphere.tablesplm[m][i]= (double *)malloc((E->sphere.hindice)*sizeof(double));
- E->sphere.tablescosf[m][i]= (double *)malloc((E->output.llmax+1)*sizeof(double));
- E->sphere.tablessinf[m][i]= (double *)malloc((E->output.llmax+1)*sizeof(double));
- }
- }
-
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
- for (j=1;j<=E->lmesh.nsf;j++) {
- node = j*E->lmesh.noz;
- f=E->sx[m][2][node];
- t=E->sx[m][1][node];
- for (mm=0;mm<=E->output.llmax;mm++) {
- mmf = (double)(mm)*f;
- E->sphere.tablescosf[m][j][mm] = cos( mmf );
- E->sphere.tablessinf[m][j][mm] = sin( mmf );
- }
-
- for (ll=0;ll<=E->output.llmax;ll++)
- for (mm=0;mm<=ll;mm++) {
- p = E->sphere.hindex[ll][mm];
- E->sphere.tablesplm[m][j][p] = modified_plgndr_a(ll,mm,t) ;
- }
- }
- }
-
- return;
-}
-
Copied: mc/3D/CitcomS/branches/cxx/lib/Sphere_harmonics.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Sphere_harmonics.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Sphere_harmonics.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Sphere_harmonics.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,235 @@
+/* Functions relating to the building and use of mesh locations ... */
+
+
+#include <math.h>
+#include <sys/types.h>
+#include "element_definitions.h"
+#include "global_defs.h"
+#include <stdlib.h>
+
+#include "cproto.h"
+
+static void compute_sphereh_table(struct All_variables *);
+
+/* ======================================================================
+ ====================================================================== */
+
+void set_sphere_harmonics(struct All_variables *E)
+{
+ int m,node,ll,mm,i,j;
+
+ i=0;
+ for (ll=0;ll<=E->output.llmax;ll++)
+ for (mm=0;mm<=ll;mm++) {
+ E->sphere.hindex[ll][mm] = i;
+ i++;
+ }
+
+ E->sphere.hindice = i;
+
+ /* spherical harmonic coeff (0=cos, 1=sin)
+ for surface topo, cmb topo and geoid */
+ for (i=0;i<=1;i++) {
+ E->sphere.harm_geoid[i]=(float*)malloc(E->sphere.hindice*sizeof(float));
+ E->sphere.harm_geoid_from_bncy[i]=(float*)malloc(E->sphere.hindice*sizeof(float));
+ E->sphere.harm_geoid_from_bncy_botm[i]=(float*)malloc(E->sphere.hindice*sizeof(float));
+ E->sphere.harm_geoid_from_tpgt[i]=(float*)malloc(E->sphere.hindice*sizeof(float));
+ E->sphere.harm_geoid_from_tpgb[i]=(float*)malloc(E->sphere.hindice*sizeof(float));
+
+ E->sphere.harm_tpgt[i]=(float*)malloc(E->sphere.hindice*sizeof(float));
+ E->sphere.harm_tpgb[i]=(float*)malloc(E->sphere.hindice*sizeof(float));
+ }
+
+ compute_sphereh_table(E);
+
+ return;
+}
+
+/* =====================================
+ Generalized Legendre polynomials
+ =====================================*/
+double modified_plgndr_a(int l, int m, double t)
+{
+ int i,ll;
+ double x,fact1,fact2,fact,pll,pmm,pmmp1,somx2,plgndr;
+ const double three=3.0;
+ const double two=2.0;
+ const double one=1.0;
+
+ x = cos(t);
+ pmm=one;
+ if(m>0) {
+ somx2=sqrt((one-x)*(one+x));
+ fact1= three;
+ fact2= two;
+ for (i=1;i<=m;i++) {
+ fact=sqrt(fact1/fact2);
+ pmm = -pmm*fact*somx2;
+ fact1+= two;
+ fact2+= two;
+ }
+ }
+
+ if (l==m)
+ plgndr = pmm;
+ else {
+ pmmp1 = x*sqrt(two*m+three)*pmm;
+ if(l==m+1)
+ plgndr = pmmp1;
+ else {
+ for (ll=m+2;ll<=l;ll++) {
+ fact1= sqrt((4.0*ll*ll-one)*(double)(ll-m)/(double)(ll+m));
+ fact2= sqrt((2.0*ll+one)*(ll-m)*(ll+m-one)*(ll-m-one)
+ /(double)((two*ll-three)*(ll+m)));
+ pll = ( x*fact1*pmmp1-fact2*pmm)/(ll-m);
+ pmm = pmmp1;
+ pmmp1 = pll;
+ }
+ plgndr = pll;
+ }
+ }
+
+ plgndr /= sqrt(4.0*M_PI);
+
+ if (m!=0) plgndr *= sqrt(two);
+
+ return plgndr;
+}
+
+
+/* =========================================================
+ expand the field TG into spherical harmonics
+ ========================================================= */
+void sphere_expansion(
+ struct All_variables *E,
+ float **TG, float *sphc, float *sphs
+ )
+{
+ int el,nint,d,p,i,m,j,es,mm,ll;
+
+ for (i=0;i<E->sphere.hindice;i++) {
+ sphc[i] = 0.0;
+ sphs[i] = 0.0;
+ }
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for (es=1;es<=E->lmesh.snel;es++) {
+
+ for (ll=0;ll<=E->output.llmax;ll++)
+ for (mm=0; mm<=ll; mm++) {
+
+ p = E->sphere.hindex[ll][mm];
+
+ for(nint=1;nint<=onedvpoints[E->mesh.nsd];nint++) {
+ for(d=1;d<=onedvpoints[E->mesh.nsd];d++) {
+ j = E->sien[m][es].node[d];
+ sphc[p] += TG[m][E->sien[m][es].node[d]]
+ * E->sphere.tablesplm[m][j][p]
+ * E->sphere.tablescosf[m][j][mm]
+ * E->M.vpt[GMVINDEX(d,nint)]
+ * E->surf_det[m][nint][es];
+ sphs[p] += TG[m][E->sien[m][es].node[d]]
+ * E->sphere.tablesplm[m][j][p]
+ * E->sphere.tablessinf[m][j][mm]
+ * E->M.vpt[GMVINDEX(d,nint)]
+ * E->surf_det[m][nint][es];
+ }
+ }
+
+ } /* end for ll and mm */
+
+ }
+
+ sum_across_surf_sph1(E,sphc,sphs);
+
+ return;
+}
+
+
+void debug_sphere_expansion(struct All_variables *E)
+{
+ /* expand temperature field (which should be a sph. harm. load)
+ * and output the expansion coeff. to stderr
+ */
+ int m, i, j, k, p, node;
+ int ll, mm;
+ float *TT[NCS], *sph_harm[2];
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ TT[m] = (float *) malloc ((E->lmesh.nsf+1)*sizeof(float));
+
+ /* sin coeff */
+ sph_harm[0] = (float*)malloc(E->sphere.hindice*sizeof(float));
+ /* cos coeff */
+ sph_harm[1] = (float*)malloc(E->sphere.hindice*sizeof(float));
+
+ for(k=1;k<=E->lmesh.noz;k++) {
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=1;i<=E->lmesh.noy;i++)
+ for(j=1;j<=E->lmesh.nox;j++) {
+ node= k + (j-1)*E->lmesh.noz + (i-1)*E->lmesh.nox*E->lmesh.noz;
+ p = j + (i-1)*E->lmesh.nox;
+ TT[m][p] = E->T[m][node];
+ }
+
+ /* expand TT into spherical harmonics */
+ sphere_expansion(E, TT, sph_harm[0], sph_harm[1]);
+
+ /* only the first nprocz CPU needs output */
+ if(E->parallel.me < E->parallel.nprocz) {
+ for (ll=0;ll<=E->output.llmax;ll++)
+ for (mm=0; mm<=ll; mm++) {
+ p = E->sphere.hindex[ll][mm];
+ fprintf(stderr, "T expanded layer=%d ll=%d mm=%d -- %12g %12g\n",
+ k+E->lmesh.nzs-1, ll, mm,
+ sph_harm[0][p], sph_harm[1][p]);
+ }
+ }
+ }
+
+ return;
+}
+
+
+/* ==================================================*/
+/* ==================================================*/
+static void compute_sphereh_table(struct All_variables *E)
+{
+ int m,node,ll,mm,i,j,p;
+ double t,f,mmf;
+
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+ E->sphere.tablesplm[m] = (double **) malloc((E->lmesh.nsf+1)*sizeof(double*));
+ E->sphere.tablescosf[m] = (double **) malloc((E->lmesh.nsf+1)*sizeof(double*));
+ E->sphere.tablessinf[m] = (double **) malloc((E->lmesh.nsf+1)*sizeof(double*));
+
+ for (i=1;i<=E->lmesh.nsf;i++) {
+ E->sphere.tablesplm[m][i]= (double *)malloc((E->sphere.hindice)*sizeof(double));
+ E->sphere.tablescosf[m][i]= (double *)malloc((E->output.llmax+1)*sizeof(double));
+ E->sphere.tablessinf[m][i]= (double *)malloc((E->output.llmax+1)*sizeof(double));
+ }
+ }
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+ for (j=1;j<=E->lmesh.nsf;j++) {
+ node = j*E->lmesh.noz;
+ f=E->sx[m][2][node];
+ t=E->sx[m][1][node];
+ for (mm=0;mm<=E->output.llmax;mm++) {
+ mmf = (double)(mm)*f;
+ E->sphere.tablescosf[m][j][mm] = cos( mmf );
+ E->sphere.tablessinf[m][j][mm] = sin( mmf );
+ }
+
+ for (ll=0;ll<=E->output.llmax;ll++)
+ for (mm=0;mm<=ll;mm++) {
+ p = E->sphere.hindex[ll][mm];
+ E->sphere.tablesplm[m][j][p] = modified_plgndr_a(ll,mm,t) ;
+ }
+ }
+ }
+
+ return;
+}
+
Deleted: mc/3D/CitcomS/branches/cxx/lib/Sphere_util.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Sphere_util.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Sphere_util.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,254 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-
-/* Common functions relating to the building and use of mesh locations ... */
-
-#include <math.h>
-#include "global_defs.h"
-
-/* =================================================
- this routine evenly divides the arc between points
- 1 and 2 in a great cicle. The word "evenly" means
- anglewise evenly.
- =================================================*/
-
-void even_divide_arc12(elx,x1,y1,z1,x2,y2,z2,theta,fi)
- double x1,y1,z1,x2,y2,z2,*theta,*fi;
- int elx;
-{
- double dx,dy,dz,xx,yy,zz,myatan();
- int j, nox;
-
- nox = elx+1;
-
- dx = (x2 - x1)/elx;
- dy = (y2 - y1)/elx;
- dz = (z2 - z1)/elx;
- for (j=1;j<=nox;j++) {
- xx = x1 + dx*(j-1) + 5.0e-32;
- yy = y1 + dy*(j-1);
- zz = z1 + dz*(j-1);
- theta[j] = acos(zz/sqrt(xx*xx+yy*yy+zz*zz));
- fi[j] = myatan(yy,xx);
- }
-
- return;
- }
-
-/* ================================================
- compute angle and area
- ================================================*/
-
-void compute_angle_surf_area (E)
- struct All_variables *E;
-{
-
- int es,el,m,i,j,ii,ia[5],lev;
- double aa,y1[4],y2[4],angle[6],xx[4][5],area_sphere_cap();
- void get_angle_sphere_cap();
- void parallel_process_termination();
-
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- ia[1] = 1;
- ia[2] = E->lmesh.noz*E->lmesh.nox-E->lmesh.noz+1;
- ia[3] = E->lmesh.nno-E->lmesh.noz+1;
- ia[4] = ia[3]-E->lmesh.noz*(E->lmesh.nox-1);
-
- for (i=1;i<=4;i++) {
- xx[1][i] = E->x[m][1][ia[i]]/E->sx[m][3][ia[1]];
- xx[2][i] = E->x[m][2][ia[i]]/E->sx[m][3][ia[1]];
- xx[3][i] = E->x[m][3][ia[i]]/E->sx[m][3][ia[1]];
- }
-
- get_angle_sphere_cap(xx,angle);
-
- for (i=1;i<=4;i++) /* angle1: bet 1 & 2; angle2: bet 2 & 3 ..*/
- E->sphere.angle[m][i] = angle[i];
-
- E->sphere.area[m] = area_sphere_cap(angle);
-
- for (lev=E->mesh.levmax;lev>=E->mesh.levmin;lev--)
- for (es=1;es<=E->lmesh.SNEL[lev];es++) {
- el = (es-1)*E->lmesh.ELZ[lev]+1;
- for (i=1;i<=4;i++)
- ia[i] = E->IEN[lev][m][el].node[i];
-
- for (i=1;i<=4;i++) {
- xx[1][i] = E->X[lev][m][1][ia[i]]/E->SX[lev][m][3][ia[1]];
- xx[2][i] = E->X[lev][m][2][ia[i]]/E->SX[lev][m][3][ia[1]];
- xx[3][i] = E->X[lev][m][3][ia[i]]/E->SX[lev][m][3][ia[1]];
- }
-
- get_angle_sphere_cap(xx,angle);
-
- for (i=1;i<=4;i++) /* angle1: bet 1 & 2; angle2: bet 2 & 3 ..*/
- E->sphere.angle1[lev][m][i][es] = angle[i];
-
- E->sphere.area1[lev][m][es] = area_sphere_cap(angle);
-
-/* fprintf(E->fp_out,"lev%d %d %.6e %.6e %.6e %.6e %.6e\n",lev,es,angle[1],angle[2],angle[3],angle[4],E->sphere.area1[lev][m][es]); */
-
- } /* end for lev and es */
-
- } /* end for m */
-
- return;
-}
-
-/* ================================================
- area of spherical rectangle
- ================================================ */
-double area_sphere_cap(angle)
- double angle[6];
-{
-
- double area,a,b,c;
- double area_of_sphere_triag();
-
- a = angle[1];
- b = angle[2];
- c = angle[5];
- area = area_of_sphere_triag(a,b,c);
-
- a = angle[3];
- b = angle[4];
- c = angle[5];
- area += area_of_sphere_triag(a,b,c);
-
- return (area);
-}
-
-/* ================================================
- area of spherical triangle
- ================================================ */
-double area_of_sphere_triag(a,b,c)
- double a,b,c;
-{
-
- double ss,ak,aa,bb,cc,area;
- const double e_16 = 1.0e-16;
- const double two = 2.0;
- const double pt5 = 0.5;
-
- ss = (a+b+c)*pt5;
- area=0.0;
- a = sin(ss-a);
- b = sin(ss-b);
- c = sin(ss-c);
- ak = a*b*c/sin(ss); /* sin(ss-a)*sin(ss-b)*sin(ss-c)/sin(ss) */
- if(ak<e_16) return (area);
- ak = sqrt(ak);
- aa = two*atan(ak/a);
- bb = two*atan(ak/b);
- cc = two*atan(ak/c);
- area = aa+bb+cc-M_PI;
-
- return (area);
-}
-
-/* =====================================================================
- get the area for given five points (4 nodes for a rectangle and one test node)
- angle [i]: angle bet test node and node i of the rectangle
- angle1[i]: angle bet nodes i and i+1 of the rectangle
- ====================================================================== */
-double area_of_5points(E,lev,m,el,x,ne)
- struct All_variables *E;
- int lev,m,el,ne;
- double x[4];
-{
- int i,es,ia[5];
- double area1,get_angle(),area_of_sphere_triag();
- double xx[4],angle[5],angle1[5];
-
- for (i=1;i<=4;i++)
- ia[i] = E->IEN[lev][m][el].node[i];
-
- es = (el-1)/E->lmesh.ELZ[lev]+1;
-
- for (i=1;i<=4;i++) {
- xx[1] = E->X[lev][m][1][ia[i]]/E->SX[lev][m][3][ia[1]];
- xx[2] = E->X[lev][m][2][ia[i]]/E->SX[lev][m][3][ia[1]];
- xx[3] = E->X[lev][m][3][ia[i]]/E->SX[lev][m][3][ia[1]];
- angle[i] = get_angle(x,xx); /* get angle bet (i,j) and other four*/
- angle1[i]= E->sphere.angle1[lev][m][i][es];
- }
-
- area1 = area_of_sphere_triag(angle[1],angle[2],angle1[1])
- + area_of_sphere_triag(angle[2],angle[3],angle1[2])
- + area_of_sphere_triag(angle[3],angle[4],angle1[3])
- + area_of_sphere_triag(angle[4],angle[1],angle1[4]);
-
- return (area1);
-}
-
-/* ================================
- get the angle for given four points spherical rectangle
- ================================= */
-
-void get_angle_sphere_cap(xx,angle)
- double xx[4][5],angle[6];
-{
-
- int i,j,ii;
- double y1[4],y2[4],get_angle();;
-
- for (i=1;i<=4;i++) { /* angle1: bet 1 & 2; angle2: bet 2 & 3 ..*/
- for (j=1;j<=3;j++) {
- ii=(i==4)?1:(i+1);
- y1[j] = xx[j][i];
- y2[j] = xx[j][ii];
- }
- angle[i] = get_angle(y1,y2);
- }
-
- for (j=1;j<=3;j++) {
- y1[j] = xx[j][1];
- y2[j] = xx[j][3];
- }
-
- angle[5] = get_angle(y1,y2); /* angle5 for betw 1 and 3: diagonal */
- return;
-}
-
-/* ================================
- get the angle for given two points
- ================================= */
-double get_angle(x,xx)
- double x[4],xx[4];
-{
- double dist,angle;
- const double pt5 = 0.5;
- const double two = 2.0;
-
- dist=sqrt( (x[1]-xx[1])*(x[1]-xx[1])
- + (x[2]-xx[2])*(x[2]-xx[2])
- + (x[3]-xx[3])*(x[3]-xx[3]) )*pt5;
- angle = asin(dist)*two;
-
- return (angle);
-}
Copied: mc/3D/CitcomS/branches/cxx/lib/Sphere_util.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Sphere_util.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Sphere_util.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Sphere_util.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,251 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+
+/* Common functions relating to the building and use of mesh locations ... */
+
+#include <math.h>
+#include "global_defs.h"
+
+#include "cproto.h"
+
+/* =================================================
+ this routine evenly divides the arc between points
+ 1 and 2 in a great cicle. The word "evenly" means
+ anglewise evenly.
+ =================================================*/
+
+void even_divide_arc12(
+ int elx,
+ double x1, double y1, double z1, double x2, double y2, double z2, double *theta, double *fi
+ )
+{
+ double dx,dy,dz,xx,yy,zz;
+ int j, nox;
+
+ nox = elx+1;
+
+ dx = (x2 - x1)/elx;
+ dy = (y2 - y1)/elx;
+ dz = (z2 - z1)/elx;
+ for (j=1;j<=nox;j++) {
+ xx = x1 + dx*(j-1) + 5.0e-32;
+ yy = y1 + dy*(j-1);
+ zz = z1 + dz*(j-1);
+ theta[j] = acos(zz/sqrt(xx*xx+yy*yy+zz*zz));
+ fi[j] = myatan(yy,xx);
+ }
+
+ return;
+ }
+
+/* ================================================
+ compute angle and area
+ ================================================*/
+
+void compute_angle_surf_area(struct All_variables *E)
+{
+
+ int es,el,m,i,j,ii,ia[5],lev;
+ double aa,y1[4],y2[4],angle[6],xx[4][5];
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ ia[1] = 1;
+ ia[2] = E->lmesh.noz*E->lmesh.nox-E->lmesh.noz+1;
+ ia[3] = E->lmesh.nno-E->lmesh.noz+1;
+ ia[4] = ia[3]-E->lmesh.noz*(E->lmesh.nox-1);
+
+ for (i=1;i<=4;i++) {
+ xx[1][i] = E->x[m][1][ia[i]]/E->sx[m][3][ia[1]];
+ xx[2][i] = E->x[m][2][ia[i]]/E->sx[m][3][ia[1]];
+ xx[3][i] = E->x[m][3][ia[i]]/E->sx[m][3][ia[1]];
+ }
+
+ get_angle_sphere_cap(xx,angle);
+
+ for (i=1;i<=4;i++) /* angle1: bet 1 & 2; angle2: bet 2 & 3 ..*/
+ E->sphere.angle[m][i] = angle[i];
+
+ E->sphere.area[m] = area_sphere_cap(angle);
+
+ for (lev=E->mesh.levmax;lev>=E->mesh.levmin;lev--)
+ for (es=1;es<=E->lmesh.SNEL[lev];es++) {
+ el = (es-1)*E->lmesh.ELZ[lev]+1;
+ for (i=1;i<=4;i++)
+ ia[i] = E->IEN[lev][m][el].node[i];
+
+ for (i=1;i<=4;i++) {
+ xx[1][i] = E->X[lev][m][1][ia[i]]/E->SX[lev][m][3][ia[1]];
+ xx[2][i] = E->X[lev][m][2][ia[i]]/E->SX[lev][m][3][ia[1]];
+ xx[3][i] = E->X[lev][m][3][ia[i]]/E->SX[lev][m][3][ia[1]];
+ }
+
+ get_angle_sphere_cap(xx,angle);
+
+ for (i=1;i<=4;i++) /* angle1: bet 1 & 2; angle2: bet 2 & 3 ..*/
+ E->sphere.angle1[lev][m][i][es] = angle[i];
+
+ E->sphere.area1[lev][m][es] = area_sphere_cap(angle);
+
+/* fprintf(E->fp_out,"lev%d %d %.6e %.6e %.6e %.6e %.6e\n",lev,es,angle[1],angle[2],angle[3],angle[4],E->sphere.area1[lev][m][es]); */
+
+ } /* end for lev and es */
+
+ } /* end for m */
+
+ return;
+}
+
+/* ================================================
+ area of spherical rectangle
+ ================================================ */
+double area_sphere_cap(double angle[6])
+{
+
+ double area,a,b,c;
+
+ a = angle[1];
+ b = angle[2];
+ c = angle[5];
+ area = area_of_sphere_triag(a,b,c);
+
+ a = angle[3];
+ b = angle[4];
+ c = angle[5];
+ area += area_of_sphere_triag(a,b,c);
+
+ return (area);
+}
+
+/* ================================================
+ area of spherical triangle
+ ================================================ */
+double area_of_sphere_triag(double a, double b, double c)
+{
+
+ double ss,ak,aa,bb,cc,area;
+ const double e_16 = 1.0e-16;
+ const double two = 2.0;
+ const double pt5 = 0.5;
+
+ ss = (a+b+c)*pt5;
+ area=0.0;
+ a = sin(ss-a);
+ b = sin(ss-b);
+ c = sin(ss-c);
+ ak = a*b*c/sin(ss); /* sin(ss-a)*sin(ss-b)*sin(ss-c)/sin(ss) */
+ if(ak<e_16) return (area);
+ ak = sqrt(ak);
+ aa = two*atan(ak/a);
+ bb = two*atan(ak/b);
+ cc = two*atan(ak/c);
+ area = aa+bb+cc-M_PI;
+
+ return (area);
+}
+
+/* =====================================================================
+ get the area for given five points (4 nodes for a rectangle and one test node)
+ angle [i]: angle bet test node and node i of the rectangle
+ angle1[i]: angle bet nodes i and i+1 of the rectangle
+ ====================================================================== */
+double area_of_5points(
+ struct All_variables *E,
+ int lev, int m, int el,
+ double x[4],
+ int ne
+ )
+{
+ int i,es,ia[5];
+ double area1;
+ double xx[4],angle[5],angle1[5];
+
+ for (i=1;i<=4;i++)
+ ia[i] = E->IEN[lev][m][el].node[i];
+
+ es = (el-1)/E->lmesh.ELZ[lev]+1;
+
+ for (i=1;i<=4;i++) {
+ xx[1] = E->X[lev][m][1][ia[i]]/E->SX[lev][m][3][ia[1]];
+ xx[2] = E->X[lev][m][2][ia[i]]/E->SX[lev][m][3][ia[1]];
+ xx[3] = E->X[lev][m][3][ia[i]]/E->SX[lev][m][3][ia[1]];
+ angle[i] = get_angle(x,xx); /* get angle bet (i,j) and other four*/
+ angle1[i]= E->sphere.angle1[lev][m][i][es];
+ }
+
+ area1 = area_of_sphere_triag(angle[1],angle[2],angle1[1])
+ + area_of_sphere_triag(angle[2],angle[3],angle1[2])
+ + area_of_sphere_triag(angle[3],angle[4],angle1[3])
+ + area_of_sphere_triag(angle[4],angle[1],angle1[4]);
+
+ return (area1);
+}
+
+/* ================================
+ get the angle for given four points spherical rectangle
+ ================================= */
+
+void get_angle_sphere_cap(double xx[4][5], double angle[6])
+{
+
+ int i,j,ii;
+ double y1[4],y2[4];
+
+ for (i=1;i<=4;i++) { /* angle1: bet 1 & 2; angle2: bet 2 & 3 ..*/
+ for (j=1;j<=3;j++) {
+ ii=(i==4)?1:(i+1);
+ y1[j] = xx[j][i];
+ y2[j] = xx[j][ii];
+ }
+ angle[i] = get_angle(y1,y2);
+ }
+
+ for (j=1;j<=3;j++) {
+ y1[j] = xx[j][1];
+ y2[j] = xx[j][3];
+ }
+
+ angle[5] = get_angle(y1,y2); /* angle5 for betw 1 and 3: diagonal */
+ return;
+}
+
+/* ================================
+ get the angle for given two points
+ ================================= */
+double get_angle(double x[4], double xx[4])
+{
+ double dist,angle;
+ const double pt5 = 0.5;
+ const double two = 2.0;
+
+ dist=sqrt( (x[1]-xx[1])*(x[1]-xx[1])
+ + (x[2]-xx[2])*(x[2]-xx[2])
+ + (x[3]-xx[3])*(x[3]-xx[3]) )*pt5;
+ angle = asin(dist)*two;
+
+ return (angle);
+}
Deleted: mc/3D/CitcomS/branches/cxx/lib/Stokes_flow_Incomp.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Stokes_flow_Incomp.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Stokes_flow_Incomp.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,867 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-
-
-/* Functions which solve for the velocity and pressure fields using Uzawa-type iteration loop. */
-
-#include <math.h>
-#include <string.h>
-#include <sys/types.h>
-#include "element_definitions.h"
-#include "global_defs.h"
-#include <stdlib.h>
-
-void myerror(struct All_variables *,char *);
-
-static void solve_Ahat_p_fhat(struct All_variables *E,
- double **V, double **P, double **F,
- double imp, int *steps_max);
-static void solve_Ahat_p_fhat_CG(struct All_variables *E,
- double **V, double **P, double **F,
- double imp, int *steps_max);
-static void solve_Ahat_p_fhat_BiCG(struct All_variables *E,
- double **V, double **P, double **F,
- double imp, int *steps_max);
-static void solve_Ahat_p_fhat_iterCG(struct All_variables *E,
- double **V, double **P, double **F,
- double imp, int *steps_max);
-static void initial_vel_residual(struct All_variables *E,
- double **V, double **P, double **F,
- double imp);
-
-
-/* Master loop for pressure and (hence) velocity field */
-
-void solve_constrained_flow_iterative(E)
- struct All_variables *E;
-
-{
- void v_from_vector();
- void p_to_nodes();
-
- int cycles;
-
- cycles=E->control.p_iterations;
-
- /* Solve for velocity and pressure, correct for bc's */
-
- solve_Ahat_p_fhat(E,E->U,E->P,E->F,E->control.accuracy,&cycles);
-
- v_from_vector(E);
- p_to_nodes(E,E->P,E->NP,E->mesh.levmax);
-
- return;
-}
-
-void solve_constrained_flow_iterative_pseudo_surf(E)
- struct All_variables *E;
-
-{
- void v_from_vector_pseudo_surf();
- void p_to_nodes();
-
- int cycles;
-
- cycles=E->control.p_iterations;
-
- /* Solve for velocity and pressure, correct for bc's */
-
- solve_Ahat_p_fhat(E,E->U,E->P,E->F,E->control.accuracy,&cycles);
-
- v_from_vector_pseudo_surf(E);
- p_to_nodes(E,E->P,E->NP,E->mesh.levmax);
-
- return;
-}
-
-
-/* ========================================================================= */
-
-static double momentum_eqn_residual(struct All_variables *E,
- double **V, double **P, double **F)
-{
- /* Compute the norm of (F - grad(P) - K*V)
- * This norm is ~= E->monitor.momentum_residual */
- void assemble_del2_u();
- void assemble_grad_p();
- void strip_bcs_from_residual();
- double global_v_norm2();
-
- int i, m;
- double *r1[NCS], *r2[NCS];
- double res;
- const int lev = E->mesh.levmax;
- const int neq = E->lmesh.neq;
-
- for(m=1; m<=E->sphere.caps_per_proc; m++) {
- r1[m] = malloc((neq+1)*sizeof(double));
- r2[m] = malloc((neq+1)*sizeof(double));
- }
-
- /* r2 = F - grad(P) - K*V */
- assemble_grad_p(E, P, E->u1, lev);
- assemble_del2_u(E, V, r1, lev, 1);
- for(m=1; m<=E->sphere.caps_per_proc; m++)
- for(i=0; i<neq; i++)
- r2[m][i] = F[m][i] - E->u1[m][i] - r1[m][i];
-
- strip_bcs_from_residual(E, r2, lev);
-
- res = sqrt(global_v_norm2(E, r2));
-
- for(m=1; m<=E->sphere.caps_per_proc; m++) {
- free(r1[m]);
- free(r2[m]);
- }
- return(res);
-}
-
-
-static void print_convergence_progress(struct All_variables *E,
- int count, double time0,
- double v_norm, double p_norm,
- double dv, double dp,
- double div)
-{
- double CPU_time0(), t;
- t = CPU_time0() - time0;
-
- fprintf(E->fp, "(%03d) %5.1f s v=%e p=%e "
- "div/v=%.2e dv/v=%.2e dp/p=%.2e step %d\n",
- count, t, v_norm, p_norm, div, dv, dp,
- E->monitor.solution_cycles);
- fprintf(stderr, "(%03d) %5.1f s v=%e p=%e "
- "div/v=%.2e dv/v=%.2e dp/p=%.2e step %d\n",
- count, t, v_norm, p_norm, div, dv, dp,
- E->monitor.solution_cycles);
-
- return;
-}
-
-
-
-static void solve_Ahat_p_fhat(struct All_variables *E,
- double **V, double **P, double **F,
- double imp, int *steps_max)
-{
- if(E->control.inv_gruneisen == 0)
- solve_Ahat_p_fhat_CG(E, V, P, F, imp, steps_max);
- else {
- if(strcmp(E->control.uzawa, "cg") == 0)
- solve_Ahat_p_fhat_iterCG(E, V, P, F, imp, steps_max);
- else if(strcmp(E->control.uzawa, "bicg") == 0)
- solve_Ahat_p_fhat_BiCG(E, V, P, F, imp, steps_max);
- else
- myerror(E, "Error: unknown Uzawa iteration\n");
- }
-
- return;
-}
-
-
-/* Solve incompressible Stokes flow using
- * conjugate gradient (CG) iterations
- */
-
-static void solve_Ahat_p_fhat_CG(struct All_variables *E,
- double **V, double **P, double **FF,
- double imp, int *steps_max)
-{
- int m, j, count, valid, lev, npno, neq;
-
- double *r1[NCS], *r2[NCS], *z1[NCS], *s1[NCS], *s2[NCS], *cu[NCS];
- double *F[NCS];
- double *shuffle[NCS];
- double alpha, delta, r0dotz0, r1dotz1;
- double v_res;
-
- double global_pdot();
- double global_v_norm2(), global_p_norm2(), global_div_norm2();
-
- double time0, CPU_time0();
- double v_norm, p_norm;
- double dvelocity, dpressure;
- int converging;
- void assemble_c_u();
- void assemble_div_u();
- void assemble_del2_u();
- void assemble_grad_p();
- void strip_bcs_from_residual();
- int solve_del2_u();
- void parallel_process_termination();
-
- npno = E->lmesh.npno;
- neq = E->lmesh.neq;
- lev = E->mesh.levmax;
-
- for (m=1; m<=E->sphere.caps_per_proc; m++) {
- F[m] = (double *)malloc(neq*sizeof(double));
- r1[m] = (double *)malloc((npno+1)*sizeof(double));
- r2[m] = (double *)malloc((npno+1)*sizeof(double));
- z1[m] = (double *)malloc((npno+1)*sizeof(double));
- s1[m] = (double *)malloc((npno+1)*sizeof(double));
- s2[m] = (double *)malloc((npno+1)*sizeof(double));
- cu[m] = (double *)malloc((npno+1)*sizeof(double));
- }
-
- time0 = CPU_time0();
- count = 0;
- v_res = E->monitor.fdotf;
-
- /* copy the original force vector since we need to keep it intact
- between iterations */
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(j=0;j<neq;j++)
- F[m][j] = FF[m][j];
-
-
- /* calculate the contribution of compressibility in the continuity eqn */
- if(E->control.inv_gruneisen != 0) {
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(j=1;j<=npno;j++)
- cu[m][j] = 0.0;
-
- assemble_c_u(E, V, cu, lev);
- }
-
-
- /* calculate the initial velocity residual */
- /* In the compressible case, the initial guess of P might be bad.
- * Do not correct V with it. */
- if(E->control.inv_gruneisen == 0)
- initial_vel_residual(E, V, P, F, imp*v_res);
-
-
- /* initial residual r1 = div(V) */
- assemble_div_u(E, V, r1, lev);
-
-
- /* add the contribution of compressibility to the initial residual */
- if(E->control.inv_gruneisen != 0)
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(j=1;j<=npno;j++) {
- r1[m][j] += cu[m][j];
- }
-
- E->monitor.vdotv = global_v_norm2(E, V);
- E->monitor.incompressibility = sqrt(global_div_norm2(E, r1)
- / (1e-32 + E->monitor.vdotv));
-
- v_norm = sqrt(E->monitor.vdotv);
- p_norm = sqrt(E->monitor.pdotp);
- dvelocity = 1.0;
- dpressure = 1.0;
- converging = 0;
-
- if (E->control.print_convergence && E->parallel.me==0) {
- print_convergence_progress(E, count, time0,
- v_norm, p_norm,
- dvelocity, dpressure,
- E->monitor.incompressibility);
- }
-
-
- r0dotz0 = 0;
-
- while( (count < *steps_max) &&
- (E->monitor.incompressibility > imp) &&
- (converging < 2) ) {
- /* require two consecutive converging iterations to quit the while-loop */
-
- /* preconditioner BPI ~= inv(K), z1 = BPI*r1 */
- for(m=1; m<=E->sphere.caps_per_proc; m++)
- for(j=1; j<=npno; j++)
- z1[m][j] = E->BPI[lev][m][j] * r1[m][j];
-
-
- /* r1dotz1 = <r1, z1> */
- r1dotz1 = global_pdot(E, r1, z1, lev);
- assert(r1dotz1 != 0.0 /* Division by zero in head of incompressibility iteration */);
-
- /* update search direction */
- if(count == 0)
- for (m=1; m<=E->sphere.caps_per_proc; m++)
- for(j=1; j<=npno; j++)
- s2[m][j] = z1[m][j];
- else {
- /* s2 = z1 + s1 * <r1,z1>/<r0,z0> */
- delta = r1dotz1 / r0dotz0;
- for(m=1; m<=E->sphere.caps_per_proc; m++)
- for(j=1; j<=npno; j++)
- s2[m][j] = z1[m][j] + delta * s1[m][j];
- }
-
- /* solve K*u1 = grad(s2) for u1 */
- assemble_grad_p(E, s2, F, lev);
- valid = solve_del2_u(E, E->u1, F, imp*v_res, lev);
- if(!valid && (E->parallel.me==0)) {
- fputs("Warning: solver not converging! 1\n", stderr);
- fputs("Warning: solver not converging! 1\n", E->fp);
- }
- strip_bcs_from_residual(E, E->u1, lev);
-
-
- /* F = div(u1) */
- assemble_div_u(E, E->u1, F, lev);
-
-
- /* alpha = <r1, z1> / <s2, F> */
- alpha = r1dotz1 / global_pdot(E, s2, F, lev);
-
-
- /* r2 = r1 - alpha * div(u1) */
- for(m=1; m<=E->sphere.caps_per_proc; m++)
- for(j=1; j<=npno; j++)
- r2[m][j] = r1[m][j] - alpha * F[m][j];
-
-
- /* P = P + alpha * s2 */
- for(m=1; m<=E->sphere.caps_per_proc; m++)
- for(j=1; j<=npno; j++)
- P[m][j] += alpha * s2[m][j];
-
-
- /* V = V - alpha * u1 */
- for(m=1; m<=E->sphere.caps_per_proc; m++)
- for(j=0; j<neq; j++)
- V[m][j] -= alpha * E->u1[m][j];
-
-
- /* compute velocity and incompressibility residual */
- E->monitor.vdotv = global_v_norm2(E, V);
- E->monitor.pdotp = global_p_norm2(E, P);
- v_norm = sqrt(E->monitor.vdotv);
- p_norm = sqrt(E->monitor.pdotp);
- dvelocity = alpha * sqrt(global_v_norm2(E, E->u1) / (1e-32 + E->monitor.vdotv));
- dpressure = alpha * sqrt(global_p_norm2(E, s2) / (1e-32 + E->monitor.pdotp));
-
-
-
- assemble_div_u(E, V, z1, lev);
- if(E->control.inv_gruneisen != 0)
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(j=1;j<=npno;j++) {
- z1[m][j] += cu[m][j];
- }
- E->monitor.incompressibility = sqrt(global_div_norm2(E, z1)
- / (1e-32 + E->monitor.vdotv));
-
- count++;
-
-
- if (E->control.print_convergence && E->parallel.me==0) {
- print_convergence_progress(E, count, time0,
- v_norm, p_norm,
- dvelocity, dpressure,
- E->monitor.incompressibility);
- }
- if(E->control.only_check_vel_convergence){
- /* disregard pressure and div check */
- if(dvelocity < imp)
- converging++;
- else
- converging = 0;
- E->monitor.incompressibility = dvelocity;
- }else{
- /* how many consecutive converging iterations? */
- if(dvelocity < imp && dpressure < imp)
- converging++;
- else
- converging = 0;
-
-
- }
-
- /* shift array pointers */
- for(m=1; m<=E->sphere.caps_per_proc; m++) {
- shuffle[m] = s1[m];
- s1[m] = s2[m];
- s2[m] = shuffle[m];
-
- shuffle[m] = r1[m];
- r1[m] = r2[m];
- r2[m] = shuffle[m];
- }
-
- /* shift <r0, z0> = <r1, z1> */
- r0dotz0 = r1dotz1;
-
- } /* end loop for conjugate gradient */
-
- assemble_div_u(E, V, z1, lev);
- if(E->control.inv_gruneisen != 0)
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(j=1;j<=npno;j++) {
- z1[m][j] += cu[m][j];
- }
-
-
- for(m=1; m<=E->sphere.caps_per_proc; m++) {
- free((void *) F[m]);
- free((void *) r1[m]);
- free((void *) r2[m]);
- free((void *) z1[m]);
- free((void *) s1[m]);
- free((void *) s2[m]);
- free((void *) cu[m]);
- }
-
- *steps_max=count;
-
- return;
-}
-
-/* Solve compressible Stokes flow using
- * bi-conjugate gradient stablized (BiCG-stab) iterations
- */
-
-static void solve_Ahat_p_fhat_BiCG(struct All_variables *E,
- double **V, double **P, double **FF,
- double imp, int *steps_max)
-{
- void assemble_div_rho_u();
- void assemble_del2_u();
- void assemble_grad_p();
- void strip_bcs_from_residual();
- int solve_del2_u();
- void parallel_process_termination();
-
- double global_pdot();
- double global_v_norm2(), global_p_norm2(), global_div_norm2();
- double CPU_time0();
-
- int npno, neq;
- int m, j, count, lev;
- int valid;
-
- double alpha, beta, omega;
- double r0dotrt, r1dotrt;
- double v_norm, p_norm;
- double dvelocity, dpressure;
- int converging;
-
- double *F[NCS];
- double *r1[NCS], *r2[NCS], *pt[NCS], *p1[NCS], *p2[NCS];
- double *rt[NCS], *v0[NCS], *s0[NCS], *st[NCS], *t0[NCS];
- double *u0[NCS];
- double *shuffle[NCS];
-
- double time0, v_res;
-
- npno = E->lmesh.npno;
- neq = E->lmesh.neq;
- lev = E->mesh.levmax;
-
- for (m=1; m<=E->sphere.caps_per_proc; m++) {
- F[m] = (double *)malloc(neq*sizeof(double));
- r1[m] = (double *)malloc((npno+1)*sizeof(double));
- r2[m] = (double *)malloc((npno+1)*sizeof(double));
- pt[m] = (double *)malloc((npno+1)*sizeof(double));
- p1[m] = (double *)malloc((npno+1)*sizeof(double));
- p2[m] = (double *)malloc((npno+1)*sizeof(double));
- rt[m] = (double *)malloc((npno+1)*sizeof(double));
- v0[m] = (double *)malloc((npno+1)*sizeof(double));
- s0[m] = (double *)malloc((npno+1)*sizeof(double));
- st[m] = (double *)malloc((npno+1)*sizeof(double));
- t0[m] = (double *)malloc((npno+1)*sizeof(double));
-
- u0[m] = (double *)malloc(neq*sizeof(double));
- }
-
- time0 = CPU_time0();
- count = 0;
- v_res = E->monitor.fdotf;
-
- /* copy the original force vector since we need to keep it intact
- between iterations */
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(j=0;j<neq;j++)
- F[m][j] = FF[m][j];
-
-
- /* calculate the initial velocity residual */
- initial_vel_residual(E, V, P, F, imp*v_res);
-
-
- /* initial residual r1 = div(rho_ref*V) */
- assemble_div_rho_u(E, V, r1, lev);
-
- E->monitor.vdotv = global_v_norm2(E, V);
- E->monitor.incompressibility = sqrt(global_div_norm2(E, r1)
- / (1e-32 + E->monitor.vdotv));
-
- v_norm = sqrt(E->monitor.vdotv);
- p_norm = sqrt(E->monitor.pdotp);
- dvelocity = 1.0;
- dpressure = 1.0;
- converging = 0;
-
-
- if (E->control.print_convergence && E->parallel.me==0) {
- print_convergence_progress(E, count, time0,
- v_norm, p_norm,
- dvelocity, dpressure,
- E->monitor.incompressibility);
- }
-
-
- /* initial conjugate residual rt = r1 */
- for(m=1; m<=E->sphere.caps_per_proc; m++)
- for(j=1; j<=npno; j++)
- rt[m][j] = r1[m][j];
-
-
- valid = 1;
- r0dotrt = alpha = omega = 0;
-
- while( (count < *steps_max) &&
- (E->monitor.incompressibility > imp) &&
- (converging < 2) ) {
- /* require two consecutive converging iterations to quit the while-loop */
-
- /* r1dotrt = <r1, rt> */
- r1dotrt = global_pdot(E, r1, rt, lev);
- if(r1dotrt == 0.0) {
- /* XXX: can we resume the computation when BiCGstab failed? */
- fprintf(E->fp, "BiCGstab method failed!!\n");
- fprintf(stderr, "BiCGstab method failed!!\n");
- parallel_process_termination();
- }
-
-
- /* update search direction */
- if(count == 0)
- for (m=1; m<=E->sphere.caps_per_proc; m++)
- for(j=1; j<=npno; j++)
- p2[m][j] = r1[m][j];
- else {
- /* p2 = r1 + <r1,rt>/<r0,rt> * alpha/omega * (p1 - omega*v0) */
- beta = (r1dotrt / r0dotrt) * (alpha / omega);
- for(m=1; m<=E->sphere.caps_per_proc; m++)
- for(j=1; j<=npno; j++)
- p2[m][j] = r1[m][j] + beta
- * (p1[m][j] - omega * v0[m][j]);
- }
-
-
- /* preconditioner BPI ~= inv(K), pt = BPI*p2 */
- for(m=1; m<=E->sphere.caps_per_proc; m++)
- for(j=1; j<=npno; j++)
- pt[m][j] = E->BPI[lev][m][j] * p2[m][j];
-
-
- /* solve K*u0 = grad(pt) for u1 */
- assemble_grad_p(E, pt, F, lev);
- valid = solve_del2_u(E, u0, F, imp*v_res, lev);
- if(!valid && (E->parallel.me==0)) {
- fputs("Warning: solver not converging! 1\n", stderr);
- fputs("Warning: solver not converging! 1\n", E->fp);
- }
- strip_bcs_from_residual(E, u0, lev);
-
-
- /* v0 = div(rho_ref*u0) */
- assemble_div_rho_u(E, u0, v0, lev);
-
-
- /* alpha = r1dotrt / <rt, v0> */
- alpha = r1dotrt / global_pdot(E, rt, v0, lev);
-
-
- /* s0 = r1 - alpha * v0 */
- for(m=1; m<=E->sphere.caps_per_proc; m++)
- for(j=1; j<=npno; j++)
- s0[m][j] = r1[m][j] - alpha * v0[m][j];
-
-
- /* preconditioner BPI ~= inv(K), st = BPI*s0 */
- for(m=1; m<=E->sphere.caps_per_proc; m++)
- for(j=1; j<=npno; j++)
- st[m][j] = E->BPI[lev][m][j] * s0[m][j];
-
-
- /* solve K*u1 = grad(st) for u1 */
- assemble_grad_p(E, st, F, lev);
- valid = solve_del2_u(E, E->u1, F, imp*v_res, lev);
- if(!valid && (E->parallel.me==0)) {
- fputs("Warning: solver not converging! 2\n", stderr);
- fputs("Warning: solver not converging! 2\n", E->fp);
- }
- strip_bcs_from_residual(E, E->u1, lev);
-
-
- /* t0 = div(rho_ref * u1) */
- assemble_div_rho_u(E, E->u1, t0, lev);
-
-
- /* omega = <t0, s0> / <t0, t0> */
- omega = global_pdot(E, t0, s0, lev) / global_pdot(E, t0, t0, lev);
-
-
- /* r2 = s0 - omega * t0 */
- for(m=1; m<=E->sphere.caps_per_proc; m++)
- for(j=1; j<=npno; j++)
- r2[m][j] = s0[m][j] - omega * t0[m][j];
-
-
- /* P = P + alpha * pt + omega * st */
- for(m=1; m<=E->sphere.caps_per_proc; m++)
- for(j=1; j<=npno; j++)
- s0[m][j] = alpha * pt[m][j] + omega * st[m][j];
-
- for(m=1; m<=E->sphere.caps_per_proc; m++)
- for(j=1; j<=npno; j++)
- P[m][j] += s0[m][j];
-
-
- /* V = V - alpha * u0 - omega * u1 */
- for(m=1; m<=E->sphere.caps_per_proc; m++)
- for(j=0; j<neq; j++)
- F[m][j] = alpha * u0[m][j] + omega * E->u1[m][j];
-
- for(m=1; m<=E->sphere.caps_per_proc; m++)
- for(j=0; j<neq; j++)
- V[m][j] -= F[m][j];
-
-
- /* compute velocity and incompressibility residual */
- E->monitor.vdotv = global_v_norm2(E, V);
- E->monitor.pdotp = global_p_norm2(E, P);
- v_norm = sqrt(E->monitor.vdotv);
- p_norm = sqrt(E->monitor.pdotp);
- dvelocity = sqrt(global_v_norm2(E, F) / (1e-32 + E->monitor.vdotv));
- dpressure = sqrt(global_p_norm2(E, s0) / (1e-32 + E->monitor.pdotp));
-
-
-
-
- assemble_div_rho_u(E, V, t0, lev);
- E->monitor.incompressibility = sqrt(global_div_norm2(E, t0)
- / (1e-32 + E->monitor.vdotv));
-
-
-
-
- count++;
-
- if(E->control.print_convergence && E->parallel.me==0) {
- print_convergence_progress(E, count, time0,
- v_norm, p_norm,
- dvelocity, dpressure,
- E->monitor.incompressibility);
- }
-
- if(E->control.only_check_vel_convergence){
- /*
-
- override pressure and compressibility check
-
- */
- if(dvelocity < imp)
- converging++;
- else
- converging =0;
- E->monitor.incompressibility = dvelocity;
- }else{
- /* how many consecutive converging iterations? */
- if(dvelocity < imp && dpressure < imp)
- converging++;
- else
- converging = 0;
- }
- /* shift array pointers */
- for(m=1; m<=E->sphere.caps_per_proc; m++) {
- shuffle[m] = p1[m];
- p1[m] = p2[m];
- p2[m] = shuffle[m];
-
- shuffle[m] = r1[m];
- r1[m] = r2[m];
- r2[m] = shuffle[m];
- }
-
- /* shift <r0, rt> = <r1, rt> */
- r0dotrt = r1dotrt;
-
- } /* end loop for conjugate gradient */
-
-
- for(m=1; m<=E->sphere.caps_per_proc; m++) {
- free((void *) F[m]);
- free((void *) r1[m]);
- free((void *) r2[m]);
- free((void *) pt[m]);
- free((void *) p1[m]);
- free((void *) p2[m]);
- free((void *) rt[m]);
- free((void *) v0[m]);
- free((void *) s0[m]);
- free((void *) st[m]);
- free((void *) t0[m]);
-
- free((void *) u0[m]);
- }
-
- *steps_max=count;
-
- return;
-
-}
-
-
-/* Solve compressible Stokes flow using
- * conjugate gradient (CG) iterations with an outer iteration
- */
-
-static void solve_Ahat_p_fhat_iterCG(struct All_variables *E,
- double **V, double **P, double **F,
- double imp, int *steps_max)
-{
- int m, i;
- int cycles, num_of_loop;
- double relative_err_v, relative_err_p;
- double *old_v[NCS], *old_p[NCS],*diff_v[NCS],*diff_p[NCS];
- double div_res;
- const int npno = E->lmesh.npno;
- const int neq = E->lmesh.neq;
- const int lev = E->mesh.levmax;
-
- double global_v_norm2(),global_p_norm2();
- double global_div_norm2();
- void assemble_div_rho_u();
-
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- old_v[m] = (double *)malloc(neq*sizeof(double));
- diff_v[m] = (double *)malloc(neq*sizeof(double));
- old_p[m] = (double *)malloc((npno+1)*sizeof(double));
- diff_p[m] = (double *)malloc((npno+1)*sizeof(double));
- }
-
- cycles = E->control.p_iterations;
-
- initial_vel_residual(E, V, P, F,
- imp * E->monitor.fdotf);
-
- div_res = 1.0;
- relative_err_v = 1.0;
- relative_err_p = 1.0;
- num_of_loop = 0;
-
- while((relative_err_v >= imp || relative_err_p >= imp) &&
- (div_res > imp) &&
- (num_of_loop <= E->control.compress_iter_maxstep)) {
-
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- for(i=0;i<neq;i++) old_v[m][i] = V[m][i];
- for(i=1;i<=npno;i++) old_p[m][i] = P[m][i];
- }
-
- solve_Ahat_p_fhat_CG(E, V, P, F, imp, &cycles);
-
- /* compute norm of div(rho*V) */
- assemble_div_rho_u(E, V, E->u1, lev);
- div_res = sqrt(global_div_norm2(E, E->u1) / (1e-32 + E->monitor.vdotv));
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=0;i<neq;i++) diff_v[m][i] = V[m][i] - old_v[m][i];
-
- relative_err_v = sqrt( global_v_norm2(E,diff_v) /
- (1.0e-32 + E->monitor.vdotv) );
-
- for (m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=1;i<=npno;i++) diff_p[m][i] = P[m][i] - old_p[m][i];
-
- relative_err_p = sqrt( global_p_norm2(E,diff_p) /
- (1.0e-32 + E->monitor.pdotp) );
-
- if(E->parallel.me == 0) {
- fprintf(stderr, "itercg -- div(rho*v)/v=%.2e dv/v=%.2e and dp/p=%.2e loop %d\n\n", div_res, relative_err_v, relative_err_p, num_of_loop);
- fprintf(E->fp, "itercg -- div(rho*v)/v=%.2e dv/v=%.2e and dp/p=%.2e loop %d\n\n", div_res, relative_err_v, relative_err_p, num_of_loop);
- }
- if(E->control.only_check_vel_convergence){
- /* override pressure and compressibility check */
- relative_err_p = div_res = relative_err_v;
- }
- num_of_loop++;
-
- } /* end of while */
-
- for (m=1;m<=E->sphere.caps_per_proc;m++) {
- free((void *) old_v[m]);
- free((void *) old_p[m]);
- free((void *) diff_v[m]);
- free((void *) diff_p[m]);
- }
-
- return;
-}
-
-
-static void initial_vel_residual(struct All_variables *E,
- double **V, double **P, double **F,
- double acc)
-{
- void assemble_del2_u();
- void assemble_grad_p();
- void strip_bcs_from_residual();
- int solve_del2_u();
-
- int neq = E->lmesh.neq;
- int lev = E->mesh.levmax;
- int i, m, valid;
-
- /* F = F - grad(P) - K*V */
- assemble_grad_p(E, P, E->u1, lev);
- for(m=1; m<=E->sphere.caps_per_proc; m++)
- for(i=0; i<neq; i++)
- F[m][i] = F[m][i] - E->u1[m][i];
-
- assemble_del2_u(E, V, E->u1, lev, 1);
- for(m=1; m<=E->sphere.caps_per_proc; m++)
- for(i=0; i<neq; i++)
- F[m][i] = F[m][i] - E->u1[m][i];
-
- strip_bcs_from_residual(E, F, lev);
-
-
- /* solve K*u1 = F for u1 */
- valid = solve_del2_u(E, E->u1, F, acc, lev);
- if(!valid && (E->parallel.me==0)) {
- fputs("Warning: solver not converging! 0\n", stderr);
- fputs("Warning: solver not converging! 0\n", E->fp);
- }
- strip_bcs_from_residual(E, E->u1, lev);
-
-
- /* V = V + u1 */
- for(m=1; m<=E->sphere.caps_per_proc; m++)
- for(i=0; i<neq; i++)
- V[m][i] += E->u1[m][i];
-
- return;
-}
Copied: mc/3D/CitcomS/branches/cxx/lib/Stokes_flow_Incomp.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Stokes_flow_Incomp.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Stokes_flow_Incomp.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Stokes_flow_Incomp.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,825 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+
+
+/* Functions which solve for the velocity and pressure fields using Uzawa-type iteration loop. */
+
+#include <math.h>
+#include <string.h>
+#include <sys/types.h>
+#include "element_definitions.h"
+#include "global_defs.h"
+#include <stdlib.h>
+
+#include "cproto.h"
+
+void myerror(struct All_variables *,char *);
+
+static void solve_Ahat_p_fhat(struct All_variables *E,
+ double **V, double **P, double **F,
+ double imp, int *steps_max);
+static void solve_Ahat_p_fhat_CG(struct All_variables *E,
+ double **V, double **P, double **F,
+ double imp, int *steps_max);
+static void solve_Ahat_p_fhat_BiCG(struct All_variables *E,
+ double **V, double **P, double **F,
+ double imp, int *steps_max);
+static void solve_Ahat_p_fhat_iterCG(struct All_variables *E,
+ double **V, double **P, double **F,
+ double imp, int *steps_max);
+static void initial_vel_residual(struct All_variables *E,
+ double **V, double **P, double **F,
+ double imp);
+
+
+/* Master loop for pressure and (hence) velocity field */
+
+void solve_constrained_flow_iterative(struct All_variables *E)
+{
+ int cycles;
+
+ cycles=E->control.p_iterations;
+
+ /* Solve for velocity and pressure, correct for bc's */
+
+ solve_Ahat_p_fhat(E,E->U,E->P,E->F,E->control.accuracy,&cycles);
+
+ v_from_vector(E);
+ p_to_nodes(E,E->P,E->NP,E->mesh.levmax);
+
+ return;
+}
+
+void solve_constrained_flow_iterative_pseudo_surf(struct All_variables *E)
+{
+ int cycles;
+
+ cycles=E->control.p_iterations;
+
+ /* Solve for velocity and pressure, correct for bc's */
+
+ solve_Ahat_p_fhat(E,E->U,E->P,E->F,E->control.accuracy,&cycles);
+
+ v_from_vector_pseudo_surf(E);
+ p_to_nodes(E,E->P,E->NP,E->mesh.levmax);
+
+ return;
+}
+
+
+/* ========================================================================= */
+
+static double momentum_eqn_residual(struct All_variables *E,
+ double **V, double **P, double **F)
+{
+ /* Compute the norm of (F - grad(P) - K*V)
+ * This norm is ~= E->monitor.momentum_residual */
+
+ int i, m;
+ double *r1[NCS], *r2[NCS];
+ double res;
+ const int lev = E->mesh.levmax;
+ const int neq = E->lmesh.neq;
+
+ for(m=1; m<=E->sphere.caps_per_proc; m++) {
+ r1[m] = (double *)malloc((neq+1)*sizeof(double));
+ r2[m] = (double *)malloc((neq+1)*sizeof(double));
+ }
+
+ /* r2 = F - grad(P) - K*V */
+ assemble_grad_p(E, P, E->u1, lev);
+ assemble_del2_u(E, V, r1, lev, 1);
+ for(m=1; m<=E->sphere.caps_per_proc; m++)
+ for(i=0; i<neq; i++)
+ r2[m][i] = F[m][i] - E->u1[m][i] - r1[m][i];
+
+ strip_bcs_from_residual(E, r2, lev);
+
+ res = sqrt(global_v_norm2(E, r2));
+
+ for(m=1; m<=E->sphere.caps_per_proc; m++) {
+ free(r1[m]);
+ free(r2[m]);
+ }
+ return(res);
+}
+
+
+static void print_convergence_progress(struct All_variables *E,
+ int count, double time0,
+ double v_norm, double p_norm,
+ double dv, double dp,
+ double div)
+{
+ double CPU_time0(), t;
+ t = CPU_time0() - time0;
+
+ fprintf(E->fp, "(%03d) %5.1f s v=%e p=%e "
+ "div/v=%.2e dv/v=%.2e dp/p=%.2e step %d\n",
+ count, t, v_norm, p_norm, div, dv, dp,
+ E->monitor.solution_cycles);
+ fprintf(stderr, "(%03d) %5.1f s v=%e p=%e "
+ "div/v=%.2e dv/v=%.2e dp/p=%.2e step %d\n",
+ count, t, v_norm, p_norm, div, dv, dp,
+ E->monitor.solution_cycles);
+
+ return;
+}
+
+
+
+static void solve_Ahat_p_fhat(struct All_variables *E,
+ double **V, double **P, double **F,
+ double imp, int *steps_max)
+{
+ if(E->control.inv_gruneisen == 0)
+ solve_Ahat_p_fhat_CG(E, V, P, F, imp, steps_max);
+ else {
+ if(strcmp(E->control.uzawa, "cg") == 0)
+ solve_Ahat_p_fhat_iterCG(E, V, P, F, imp, steps_max);
+ else if(strcmp(E->control.uzawa, "bicg") == 0)
+ solve_Ahat_p_fhat_BiCG(E, V, P, F, imp, steps_max);
+ else
+ myerror(E, "Error: unknown Uzawa iteration\n");
+ }
+
+ return;
+}
+
+
+/* Solve incompressible Stokes flow using
+ * conjugate gradient (CG) iterations
+ */
+
+static void solve_Ahat_p_fhat_CG(struct All_variables *E,
+ double **V, double **P, double **FF,
+ double imp, int *steps_max)
+{
+ int m, j, count, valid, lev, npno, neq;
+
+ double *r1[NCS], *r2[NCS], *z1[NCS], *s1[NCS], *s2[NCS], *cu[NCS];
+ double *F[NCS];
+ double *shuffle[NCS];
+ double alpha, delta, r0dotz0, r1dotz1;
+ double v_res;
+
+ double time0;
+ double v_norm, p_norm;
+ double dvelocity, dpressure;
+ int converging;
+
+ npno = E->lmesh.npno;
+ neq = E->lmesh.neq;
+ lev = E->mesh.levmax;
+
+ for (m=1; m<=E->sphere.caps_per_proc; m++) {
+ F[m] = (double *)malloc(neq*sizeof(double));
+ r1[m] = (double *)malloc((npno+1)*sizeof(double));
+ r2[m] = (double *)malloc((npno+1)*sizeof(double));
+ z1[m] = (double *)malloc((npno+1)*sizeof(double));
+ s1[m] = (double *)malloc((npno+1)*sizeof(double));
+ s2[m] = (double *)malloc((npno+1)*sizeof(double));
+ cu[m] = (double *)malloc((npno+1)*sizeof(double));
+ }
+
+ time0 = CPU_time0();
+ count = 0;
+ v_res = E->monitor.fdotf;
+
+ /* copy the original force vector since we need to keep it intact
+ between iterations */
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(j=0;j<neq;j++)
+ F[m][j] = FF[m][j];
+
+
+ /* calculate the contribution of compressibility in the continuity eqn */
+ if(E->control.inv_gruneisen != 0) {
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(j=1;j<=npno;j++)
+ cu[m][j] = 0.0;
+
+ assemble_c_u(E, V, cu, lev);
+ }
+
+
+ /* calculate the initial velocity residual */
+ /* In the compressible case, the initial guess of P might be bad.
+ * Do not correct V with it. */
+ if(E->control.inv_gruneisen == 0)
+ initial_vel_residual(E, V, P, F, imp*v_res);
+
+
+ /* initial residual r1 = div(V) */
+ assemble_div_u(E, V, r1, lev);
+
+
+ /* add the contribution of compressibility to the initial residual */
+ if(E->control.inv_gruneisen != 0)
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(j=1;j<=npno;j++) {
+ r1[m][j] += cu[m][j];
+ }
+
+ E->monitor.vdotv = global_v_norm2(E, V);
+ E->monitor.incompressibility = sqrt(global_div_norm2(E, r1)
+ / (1e-32 + E->monitor.vdotv));
+
+ v_norm = sqrt(E->monitor.vdotv);
+ p_norm = sqrt(E->monitor.pdotp);
+ dvelocity = 1.0;
+ dpressure = 1.0;
+ converging = 0;
+
+ if (E->control.print_convergence && E->parallel.me==0) {
+ print_convergence_progress(E, count, time0,
+ v_norm, p_norm,
+ dvelocity, dpressure,
+ E->monitor.incompressibility);
+ }
+
+
+ r0dotz0 = 0;
+
+ while( (count < *steps_max) &&
+ (E->monitor.incompressibility > imp) &&
+ (converging < 2) ) {
+ /* require two consecutive converging iterations to quit the while-loop */
+
+ /* preconditioner BPI ~= inv(K), z1 = BPI*r1 */
+ for(m=1; m<=E->sphere.caps_per_proc; m++)
+ for(j=1; j<=npno; j++)
+ z1[m][j] = E->BPI[lev][m][j] * r1[m][j];
+
+
+ /* r1dotz1 = <r1, z1> */
+ r1dotz1 = global_pdot(E, r1, z1, lev);
+ assert(r1dotz1 != 0.0 /* Division by zero in head of incompressibility iteration */);
+
+ /* update search direction */
+ if(count == 0)
+ for (m=1; m<=E->sphere.caps_per_proc; m++)
+ for(j=1; j<=npno; j++)
+ s2[m][j] = z1[m][j];
+ else {
+ /* s2 = z1 + s1 * <r1,z1>/<r0,z0> */
+ delta = r1dotz1 / r0dotz0;
+ for(m=1; m<=E->sphere.caps_per_proc; m++)
+ for(j=1; j<=npno; j++)
+ s2[m][j] = z1[m][j] + delta * s1[m][j];
+ }
+
+ /* solve K*u1 = grad(s2) for u1 */
+ assemble_grad_p(E, s2, F, lev);
+ valid = solve_del2_u(E, E->u1, F, imp*v_res, lev);
+ if(!valid && (E->parallel.me==0)) {
+ fputs("Warning: solver not converging! 1\n", stderr);
+ fputs("Warning: solver not converging! 1\n", E->fp);
+ }
+ strip_bcs_from_residual(E, E->u1, lev);
+
+
+ /* F = div(u1) */
+ assemble_div_u(E, E->u1, F, lev);
+
+
+ /* alpha = <r1, z1> / <s2, F> */
+ alpha = r1dotz1 / global_pdot(E, s2, F, lev);
+
+
+ /* r2 = r1 - alpha * div(u1) */
+ for(m=1; m<=E->sphere.caps_per_proc; m++)
+ for(j=1; j<=npno; j++)
+ r2[m][j] = r1[m][j] - alpha * F[m][j];
+
+
+ /* P = P + alpha * s2 */
+ for(m=1; m<=E->sphere.caps_per_proc; m++)
+ for(j=1; j<=npno; j++)
+ P[m][j] += alpha * s2[m][j];
+
+
+ /* V = V - alpha * u1 */
+ for(m=1; m<=E->sphere.caps_per_proc; m++)
+ for(j=0; j<neq; j++)
+ V[m][j] -= alpha * E->u1[m][j];
+
+
+ /* compute velocity and incompressibility residual */
+ E->monitor.vdotv = global_v_norm2(E, V);
+ E->monitor.pdotp = global_p_norm2(E, P);
+ v_norm = sqrt(E->monitor.vdotv);
+ p_norm = sqrt(E->monitor.pdotp);
+ dvelocity = alpha * sqrt(global_v_norm2(E, E->u1) / (1e-32 + E->monitor.vdotv));
+ dpressure = alpha * sqrt(global_p_norm2(E, s2) / (1e-32 + E->monitor.pdotp));
+
+
+
+ assemble_div_u(E, V, z1, lev);
+ if(E->control.inv_gruneisen != 0)
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(j=1;j<=npno;j++) {
+ z1[m][j] += cu[m][j];
+ }
+ E->monitor.incompressibility = sqrt(global_div_norm2(E, z1)
+ / (1e-32 + E->monitor.vdotv));
+
+ count++;
+
+
+ if (E->control.print_convergence && E->parallel.me==0) {
+ print_convergence_progress(E, count, time0,
+ v_norm, p_norm,
+ dvelocity, dpressure,
+ E->monitor.incompressibility);
+ }
+ if(E->control.only_check_vel_convergence){
+ /* disregard pressure and div check */
+ if(dvelocity < imp)
+ converging++;
+ else
+ converging = 0;
+ E->monitor.incompressibility = dvelocity;
+ }else{
+ /* how many consecutive converging iterations? */
+ if(dvelocity < imp && dpressure < imp)
+ converging++;
+ else
+ converging = 0;
+
+
+ }
+
+ /* shift array pointers */
+ for(m=1; m<=E->sphere.caps_per_proc; m++) {
+ shuffle[m] = s1[m];
+ s1[m] = s2[m];
+ s2[m] = shuffle[m];
+
+ shuffle[m] = r1[m];
+ r1[m] = r2[m];
+ r2[m] = shuffle[m];
+ }
+
+ /* shift <r0, z0> = <r1, z1> */
+ r0dotz0 = r1dotz1;
+
+ } /* end loop for conjugate gradient */
+
+ assemble_div_u(E, V, z1, lev);
+ if(E->control.inv_gruneisen != 0)
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(j=1;j<=npno;j++) {
+ z1[m][j] += cu[m][j];
+ }
+
+
+ for(m=1; m<=E->sphere.caps_per_proc; m++) {
+ free((void *) F[m]);
+ free((void *) r1[m]);
+ free((void *) r2[m]);
+ free((void *) z1[m]);
+ free((void *) s1[m]);
+ free((void *) s2[m]);
+ free((void *) cu[m]);
+ }
+
+ *steps_max=count;
+
+ return;
+}
+
+/* Solve compressible Stokes flow using
+ * bi-conjugate gradient stablized (BiCG-stab) iterations
+ */
+
+static void solve_Ahat_p_fhat_BiCG(struct All_variables *E,
+ double **V, double **P, double **FF,
+ double imp, int *steps_max)
+{
+ int npno, neq;
+ int m, j, count, lev;
+ int valid;
+
+ double alpha, beta, omega;
+ double r0dotrt, r1dotrt;
+ double v_norm, p_norm;
+ double dvelocity, dpressure;
+ int converging;
+
+ double *F[NCS];
+ double *r1[NCS], *r2[NCS], *pt[NCS], *p1[NCS], *p2[NCS];
+ double *rt[NCS], *v0[NCS], *s0[NCS], *st[NCS], *t0[NCS];
+ double *u0[NCS];
+ double *shuffle[NCS];
+
+ double time0, v_res;
+
+ npno = E->lmesh.npno;
+ neq = E->lmesh.neq;
+ lev = E->mesh.levmax;
+
+ for (m=1; m<=E->sphere.caps_per_proc; m++) {
+ F[m] = (double *)malloc(neq*sizeof(double));
+ r1[m] = (double *)malloc((npno+1)*sizeof(double));
+ r2[m] = (double *)malloc((npno+1)*sizeof(double));
+ pt[m] = (double *)malloc((npno+1)*sizeof(double));
+ p1[m] = (double *)malloc((npno+1)*sizeof(double));
+ p2[m] = (double *)malloc((npno+1)*sizeof(double));
+ rt[m] = (double *)malloc((npno+1)*sizeof(double));
+ v0[m] = (double *)malloc((npno+1)*sizeof(double));
+ s0[m] = (double *)malloc((npno+1)*sizeof(double));
+ st[m] = (double *)malloc((npno+1)*sizeof(double));
+ t0[m] = (double *)malloc((npno+1)*sizeof(double));
+
+ u0[m] = (double *)malloc(neq*sizeof(double));
+ }
+
+ time0 = CPU_time0();
+ count = 0;
+ v_res = E->monitor.fdotf;
+
+ /* copy the original force vector since we need to keep it intact
+ between iterations */
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(j=0;j<neq;j++)
+ F[m][j] = FF[m][j];
+
+
+ /* calculate the initial velocity residual */
+ initial_vel_residual(E, V, P, F, imp*v_res);
+
+
+ /* initial residual r1 = div(rho_ref*V) */
+ assemble_div_rho_u(E, V, r1, lev);
+
+ E->monitor.vdotv = global_v_norm2(E, V);
+ E->monitor.incompressibility = sqrt(global_div_norm2(E, r1)
+ / (1e-32 + E->monitor.vdotv));
+
+ v_norm = sqrt(E->monitor.vdotv);
+ p_norm = sqrt(E->monitor.pdotp);
+ dvelocity = 1.0;
+ dpressure = 1.0;
+ converging = 0;
+
+
+ if (E->control.print_convergence && E->parallel.me==0) {
+ print_convergence_progress(E, count, time0,
+ v_norm, p_norm,
+ dvelocity, dpressure,
+ E->monitor.incompressibility);
+ }
+
+
+ /* initial conjugate residual rt = r1 */
+ for(m=1; m<=E->sphere.caps_per_proc; m++)
+ for(j=1; j<=npno; j++)
+ rt[m][j] = r1[m][j];
+
+
+ valid = 1;
+ r0dotrt = alpha = omega = 0;
+
+ while( (count < *steps_max) &&
+ (E->monitor.incompressibility > imp) &&
+ (converging < 2) ) {
+ /* require two consecutive converging iterations to quit the while-loop */
+
+ /* r1dotrt = <r1, rt> */
+ r1dotrt = global_pdot(E, r1, rt, lev);
+ if(r1dotrt == 0.0) {
+ /* XXX: can we resume the computation when BiCGstab failed? */
+ fprintf(E->fp, "BiCGstab method failed!!\n");
+ fprintf(stderr, "BiCGstab method failed!!\n");
+ parallel_process_termination();
+ }
+
+
+ /* update search direction */
+ if(count == 0)
+ for (m=1; m<=E->sphere.caps_per_proc; m++)
+ for(j=1; j<=npno; j++)
+ p2[m][j] = r1[m][j];
+ else {
+ /* p2 = r1 + <r1,rt>/<r0,rt> * alpha/omega * (p1 - omega*v0) */
+ beta = (r1dotrt / r0dotrt) * (alpha / omega);
+ for(m=1; m<=E->sphere.caps_per_proc; m++)
+ for(j=1; j<=npno; j++)
+ p2[m][j] = r1[m][j] + beta
+ * (p1[m][j] - omega * v0[m][j]);
+ }
+
+
+ /* preconditioner BPI ~= inv(K), pt = BPI*p2 */
+ for(m=1; m<=E->sphere.caps_per_proc; m++)
+ for(j=1; j<=npno; j++)
+ pt[m][j] = E->BPI[lev][m][j] * p2[m][j];
+
+
+ /* solve K*u0 = grad(pt) for u1 */
+ assemble_grad_p(E, pt, F, lev);
+ valid = solve_del2_u(E, u0, F, imp*v_res, lev);
+ if(!valid && (E->parallel.me==0)) {
+ fputs("Warning: solver not converging! 1\n", stderr);
+ fputs("Warning: solver not converging! 1\n", E->fp);
+ }
+ strip_bcs_from_residual(E, u0, lev);
+
+
+ /* v0 = div(rho_ref*u0) */
+ assemble_div_rho_u(E, u0, v0, lev);
+
+
+ /* alpha = r1dotrt / <rt, v0> */
+ alpha = r1dotrt / global_pdot(E, rt, v0, lev);
+
+
+ /* s0 = r1 - alpha * v0 */
+ for(m=1; m<=E->sphere.caps_per_proc; m++)
+ for(j=1; j<=npno; j++)
+ s0[m][j] = r1[m][j] - alpha * v0[m][j];
+
+
+ /* preconditioner BPI ~= inv(K), st = BPI*s0 */
+ for(m=1; m<=E->sphere.caps_per_proc; m++)
+ for(j=1; j<=npno; j++)
+ st[m][j] = E->BPI[lev][m][j] * s0[m][j];
+
+
+ /* solve K*u1 = grad(st) for u1 */
+ assemble_grad_p(E, st, F, lev);
+ valid = solve_del2_u(E, E->u1, F, imp*v_res, lev);
+ if(!valid && (E->parallel.me==0)) {
+ fputs("Warning: solver not converging! 2\n", stderr);
+ fputs("Warning: solver not converging! 2\n", E->fp);
+ }
+ strip_bcs_from_residual(E, E->u1, lev);
+
+
+ /* t0 = div(rho_ref * u1) */
+ assemble_div_rho_u(E, E->u1, t0, lev);
+
+
+ /* omega = <t0, s0> / <t0, t0> */
+ omega = global_pdot(E, t0, s0, lev) / global_pdot(E, t0, t0, lev);
+
+
+ /* r2 = s0 - omega * t0 */
+ for(m=1; m<=E->sphere.caps_per_proc; m++)
+ for(j=1; j<=npno; j++)
+ r2[m][j] = s0[m][j] - omega * t0[m][j];
+
+
+ /* P = P + alpha * pt + omega * st */
+ for(m=1; m<=E->sphere.caps_per_proc; m++)
+ for(j=1; j<=npno; j++)
+ s0[m][j] = alpha * pt[m][j] + omega * st[m][j];
+
+ for(m=1; m<=E->sphere.caps_per_proc; m++)
+ for(j=1; j<=npno; j++)
+ P[m][j] += s0[m][j];
+
+
+ /* V = V - alpha * u0 - omega * u1 */
+ for(m=1; m<=E->sphere.caps_per_proc; m++)
+ for(j=0; j<neq; j++)
+ F[m][j] = alpha * u0[m][j] + omega * E->u1[m][j];
+
+ for(m=1; m<=E->sphere.caps_per_proc; m++)
+ for(j=0; j<neq; j++)
+ V[m][j] -= F[m][j];
+
+
+ /* compute velocity and incompressibility residual */
+ E->monitor.vdotv = global_v_norm2(E, V);
+ E->monitor.pdotp = global_p_norm2(E, P);
+ v_norm = sqrt(E->monitor.vdotv);
+ p_norm = sqrt(E->monitor.pdotp);
+ dvelocity = sqrt(global_v_norm2(E, F) / (1e-32 + E->monitor.vdotv));
+ dpressure = sqrt(global_p_norm2(E, s0) / (1e-32 + E->monitor.pdotp));
+
+
+
+
+ assemble_div_rho_u(E, V, t0, lev);
+ E->monitor.incompressibility = sqrt(global_div_norm2(E, t0)
+ / (1e-32 + E->monitor.vdotv));
+
+
+
+
+ count++;
+
+ if(E->control.print_convergence && E->parallel.me==0) {
+ print_convergence_progress(E, count, time0,
+ v_norm, p_norm,
+ dvelocity, dpressure,
+ E->monitor.incompressibility);
+ }
+
+ if(E->control.only_check_vel_convergence){
+ /*
+
+ override pressure and compressibility check
+
+ */
+ if(dvelocity < imp)
+ converging++;
+ else
+ converging =0;
+ E->monitor.incompressibility = dvelocity;
+ }else{
+ /* how many consecutive converging iterations? */
+ if(dvelocity < imp && dpressure < imp)
+ converging++;
+ else
+ converging = 0;
+ }
+ /* shift array pointers */
+ for(m=1; m<=E->sphere.caps_per_proc; m++) {
+ shuffle[m] = p1[m];
+ p1[m] = p2[m];
+ p2[m] = shuffle[m];
+
+ shuffle[m] = r1[m];
+ r1[m] = r2[m];
+ r2[m] = shuffle[m];
+ }
+
+ /* shift <r0, rt> = <r1, rt> */
+ r0dotrt = r1dotrt;
+
+ } /* end loop for conjugate gradient */
+
+
+ for(m=1; m<=E->sphere.caps_per_proc; m++) {
+ free((void *) F[m]);
+ free((void *) r1[m]);
+ free((void *) r2[m]);
+ free((void *) pt[m]);
+ free((void *) p1[m]);
+ free((void *) p2[m]);
+ free((void *) rt[m]);
+ free((void *) v0[m]);
+ free((void *) s0[m]);
+ free((void *) st[m]);
+ free((void *) t0[m]);
+
+ free((void *) u0[m]);
+ }
+
+ *steps_max=count;
+
+ return;
+
+}
+
+
+/* Solve compressible Stokes flow using
+ * conjugate gradient (CG) iterations with an outer iteration
+ */
+
+static void solve_Ahat_p_fhat_iterCG(struct All_variables *E,
+ double **V, double **P, double **F,
+ double imp, int *steps_max)
+{
+ int m, i;
+ int cycles, num_of_loop;
+ double relative_err_v, relative_err_p;
+ double *old_v[NCS], *old_p[NCS],*diff_v[NCS],*diff_p[NCS];
+ double div_res;
+ const int npno = E->lmesh.npno;
+ const int neq = E->lmesh.neq;
+ const int lev = E->mesh.levmax;
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ old_v[m] = (double *)malloc(neq*sizeof(double));
+ diff_v[m] = (double *)malloc(neq*sizeof(double));
+ old_p[m] = (double *)malloc((npno+1)*sizeof(double));
+ diff_p[m] = (double *)malloc((npno+1)*sizeof(double));
+ }
+
+ cycles = E->control.p_iterations;
+
+ initial_vel_residual(E, V, P, F,
+ imp * E->monitor.fdotf);
+
+ div_res = 1.0;
+ relative_err_v = 1.0;
+ relative_err_p = 1.0;
+ num_of_loop = 0;
+
+ while((relative_err_v >= imp || relative_err_p >= imp) &&
+ (div_res > imp) &&
+ (num_of_loop <= E->control.compress_iter_maxstep)) {
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ for(i=0;i<neq;i++) old_v[m][i] = V[m][i];
+ for(i=1;i<=npno;i++) old_p[m][i] = P[m][i];
+ }
+
+ solve_Ahat_p_fhat_CG(E, V, P, F, imp, &cycles);
+
+ /* compute norm of div(rho*V) */
+ assemble_div_rho_u(E, V, E->u1, lev);
+ div_res = sqrt(global_div_norm2(E, E->u1) / (1e-32 + E->monitor.vdotv));
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=0;i<neq;i++) diff_v[m][i] = V[m][i] - old_v[m][i];
+
+ relative_err_v = sqrt( global_v_norm2(E,diff_v) /
+ (1.0e-32 + E->monitor.vdotv) );
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=1;i<=npno;i++) diff_p[m][i] = P[m][i] - old_p[m][i];
+
+ relative_err_p = sqrt( global_p_norm2(E,diff_p) /
+ (1.0e-32 + E->monitor.pdotp) );
+
+ if(E->parallel.me == 0) {
+ fprintf(stderr, "itercg -- div(rho*v)/v=%.2e dv/v=%.2e and dp/p=%.2e loop %d\n\n", div_res, relative_err_v, relative_err_p, num_of_loop);
+ fprintf(E->fp, "itercg -- div(rho*v)/v=%.2e dv/v=%.2e and dp/p=%.2e loop %d\n\n", div_res, relative_err_v, relative_err_p, num_of_loop);
+ }
+ if(E->control.only_check_vel_convergence){
+ /* override pressure and compressibility check */
+ relative_err_p = div_res = relative_err_v;
+ }
+ num_of_loop++;
+
+ } /* end of while */
+
+ for (m=1;m<=E->sphere.caps_per_proc;m++) {
+ free((void *) old_v[m]);
+ free((void *) old_p[m]);
+ free((void *) diff_v[m]);
+ free((void *) diff_p[m]);
+ }
+
+ return;
+}
+
+
+static void initial_vel_residual(struct All_variables *E,
+ double **V, double **P, double **F,
+ double acc)
+{
+ int neq = E->lmesh.neq;
+ int lev = E->mesh.levmax;
+ int i, m, valid;
+
+ /* F = F - grad(P) - K*V */
+ assemble_grad_p(E, P, E->u1, lev);
+ for(m=1; m<=E->sphere.caps_per_proc; m++)
+ for(i=0; i<neq; i++)
+ F[m][i] = F[m][i] - E->u1[m][i];
+
+ assemble_del2_u(E, V, E->u1, lev, 1);
+ for(m=1; m<=E->sphere.caps_per_proc; m++)
+ for(i=0; i<neq; i++)
+ F[m][i] = F[m][i] - E->u1[m][i];
+
+ strip_bcs_from_residual(E, F, lev);
+
+
+ /* solve K*u1 = F for u1 */
+ valid = solve_del2_u(E, E->u1, F, acc, lev);
+ if(!valid && (E->parallel.me==0)) {
+ fputs("Warning: solver not converging! 0\n", stderr);
+ fputs("Warning: solver not converging! 0\n", E->fp);
+ }
+ strip_bcs_from_residual(E, E->u1, lev);
+
+
+ /* V = V + u1 */
+ for(m=1; m<=E->sphere.caps_per_proc; m++)
+ for(i=0; i<neq; i++)
+ V[m][i] += E->u1[m][i];
+
+ return;
+}
Deleted: mc/3D/CitcomS/branches/cxx/lib/Topo_gravity.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Topo_gravity.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Topo_gravity.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,1080 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-#include <stdio.h>
-#include <math.h>
-#include "element_definitions.h"
-#include "global_defs.h"
-
-void myerror(char *,struct All_variables *);
-void sphere_expansion(struct All_variables *, float **, float *, float *);
-void sphere_expansion();
-void sum_across_depth_sph1(struct All_variables *, float *, float *);
-void broadcast_vertical(struct All_variables *, float *, float *, int);
-long double lg_pow(long double, int);
-void allocate_STD_mem(struct All_variables *E,
- float** , float** , float** ,
- float** , float** , float** ,
- float** , float** );
-void free_STD_mem(struct All_variables *E,
- float** , float** , float** ,
- float** , float** , float** ,
- float** , float** );
-void compute_nodal_stress(struct All_variables *,
- float** , float** , float** ,
- float** , float** , float** ,
- float** , float** );
-void stress_conform_bcs(struct All_variables *);
-
-/*
-
-compute the full stress tensor and the dynamic topo
-
-here, we only need szz, but leave in for potential stress output if
-removed, make sure to recompute in output routines
-
-
- */
-
-void get_STD_topo(E,tpg,tpgb,divg,vort,ii)
- struct All_variables *E;
- float **tpg,**tpgb;
- float **divg,**vort;
- int ii;
-{
- void allocate_STD_mem();
- void compute_nodal_stress();
- void free_STD_mem();
- //void get_surf_stress();
-
- int node,snode,m;
- float *SXX[NCS],*SYY[NCS],*SXY[NCS],*SXZ[NCS],*SZY[NCS],*SZZ[NCS];
- float *divv[NCS],*vorv[NCS];
- float topo_scaling1, topo_scaling2;
-
- allocate_STD_mem(E, SXX, SYY, SZZ, SXY, SXZ, SZY, divv, vorv);
-
- /* this one is for szz */
- compute_nodal_stress(E, SXX, SYY, SZZ, SXY, SXZ, SZY, divv, vorv);
-
- // not needed ? TWB XXX
- //if (E->parallel.me_loc[3]==E->parallel.nprocz-1)
- //get_surf_stress(E,SXX,SYY,SZZ,SXY,SXZ,SZY);
-
-
- topo_scaling1 = topo_scaling2 = 1.0;
-
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(snode=1;snode<=E->lmesh.nsf;snode++) {
- node = E->surf_node[m][snode];
- tpg[m][snode] = -2*SZZ[m][node] + SZZ[m][node-1];
- tpgb[m][snode] = 2*SZZ[m][node-E->lmesh.noz+1]- SZZ[m][node-E->lmesh.noz+2];
-
- tpg[m][snode] = tpg[m][snode] *topo_scaling1;
- tpgb[m][snode] = tpgb[m][snode]*topo_scaling2;
-
- divg[m][snode] = 2*divv[m][node]-divv[m][node-1];
- vort[m][snode] = 2*vorv[m][node]-vorv[m][node-1];
- }
-
- free_STD_mem(E, SXX, SYY, SZZ, SXY, SXZ, SZY, divv, vorv);
-
- return;
-}
-
-void get_STD_freesurf(struct All_variables *E,float **freesurf)
-{
- int node,snode,m;
-
- if (E->parallel.me_loc[3]==E->parallel.nprocz-1)
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(snode=1;snode<=E->lmesh.nsf;snode++) {
- node = E->surf_node[m][snode];
- /*freesurf[m][snode] += 0.5*(E->sphere.cap[m].V[3][node]+E->sphere.cap[m].Vprev[3][node])*E->advection.timestep;*/
- freesurf[m][snode] += E->sphere.cap[m].V[3][node]*E->advection.timestep;
- }
- return;
-}
-
-
-void allocate_STD_mem(struct All_variables *E,
- float** SXX, float** SYY, float** SZZ,
- float** SXY, float** SXZ, float** SZY,
- float** divv, float** vorv)
-{
- int m, i;
-
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
- SXX[m] = (float *)malloc((E->lmesh.nno+1)*sizeof(float));
- SYY[m] = (float *)malloc((E->lmesh.nno+1)*sizeof(float));
- SXY[m] = (float *)malloc((E->lmesh.nno+1)*sizeof(float));
- SXZ[m] = (float *)malloc((E->lmesh.nno+1)*sizeof(float));
- SZY[m] = (float *)malloc((E->lmesh.nno+1)*sizeof(float));
- SZZ[m] = (float *)malloc((E->lmesh.nno+1)*sizeof(float));
- divv[m] = (float *)malloc((E->lmesh.nno+1)*sizeof(float));
- vorv[m] = (float *)malloc((E->lmesh.nno+1)*sizeof(float));
- }
-
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
- for(i=1;i<=E->lmesh.nno;i++) {
- SZZ[m][i] = 0.0;
- SXX[m][i] = 0.0;
- SYY[m][i] = 0.0;
- SXY[m][i] = 0.0;
- SXZ[m][i] = 0.0;
- SZY[m][i] = 0.0;
- divv[m][i] = 0.0;
- vorv[m][i] = 0.0;
- }
- }
- return;
-}
-
-
-void free_STD_mem(struct All_variables *E,
- float** SXX, float** SYY, float** SZZ,
- float** SXY, float** SXZ, float** SZY,
- float** divv, float** vorv)
-{
- int m;
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
- free((void *)SXX[m]);
- free((void *)SYY[m]);
- free((void *)SXY[m]);
- free((void *)SXZ[m]);
- free((void *)SZY[m]);
- free((void *)SZZ[m]);
- free((void *)divv[m]);
- free((void *)vorv[m]);
- }
-}
-
-
-/* void get_surf_stress(E,SXX,SYY,SZZ,SXY,SXZ,SZY) */
-/* struct All_variables *E; */
-/* float **SXX,**SYY,**SZZ,**SXY,**SXZ,**SZY; */
-/* { */
-/* int m,i,node,stride; */
-
-/* stride = E->lmesh.nsf*6; */
-
-/* for(m=1;m<=E->sphere.caps_per_proc;m++) */
-/* for (node=1;node<=E->lmesh.nno;node++) */
-/* if ( (node%E->lmesh.noz)==0 ) { */
-/* i = node/E->lmesh.noz; */
-/* E->stress[m][(i-1)*6+1] = SXX[m][node]; */
-/* E->stress[m][(i-1)*6+2] = SYY[m][node]; */
-/* E->stress[m][(i-1)*6+3] = SZZ[m][node]; */
-/* E->stress[m][(i-1)*6+4] = SXY[m][node]; */
-/* E->stress[m][(i-1)*6+5] = SXZ[m][node]; */
-/* E->stress[m][(i-1)*6+6] = SZY[m][node]; */
-/* } */
-/* else if ( ((node+1)%E->lmesh.noz)==0 ) { */
-/* i = (node+1)/E->lmesh.noz; */
-/* E->stress[m][stride+(i-1)*6+1] = SXX[m][node]; */
-/* E->stress[m][stride+(i-1)*6+2] = SYY[m][node]; */
-/* E->stress[m][stride+(i-1)*6+3] = SZZ[m][node]; */
-/* E->stress[m][stride+(i-1)*6+4] = SXY[m][node]; */
-/* E->stress[m][stride+(i-1)*6+5] = SXZ[m][node]; */
-/* E->stress[m][stride+(i-1)*6+6] = SZY[m][node]; */
-/* } */
-
-/* return; */
-/* } */
-
-
-void compute_nodal_stress(struct All_variables *E,
- float** SXX, float** SYY, float** SZZ,
- float** SXY, float** SXZ, float** SZY,
- float** divv, float** vorv)
-{
- void get_rtf_at_vpts();
- void velo_from_element();
- void stress_conform_bcs();
-
- int i,j,e,node,m;
-
- float VV[4][9],Vxyz[9][9],Szz,Sxx,Syy,Sxy,Sxz,Szy,div,vor;
- double dilation[9];
- double pre[9],tww[9],rtf[4][9];
- double velo_scaling, stress_scaling, mass_fac;
-
- struct Shape_function_dA *dOmega;
- struct Shape_function_dx *GNx;
-
- const int dims=E->mesh.nsd;
- const int vpts=vpoints[dims];
- const int ends=enodes[dims];
- const int lev=E->mesh.levmax;
- const int sphere_key=1;
-
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
- for(e=1;e<=E->lmesh.nel;e++) {
- Szz = 0.0;
- Sxx = 0.0;
- Syy = 0.0;
- Sxy = 0.0;
- Sxz = 0.0;
- Szy = 0.0;
- div = 0.0;
- vor = 0.0;
-
- get_rtf_at_vpts(E, m, lev, e, rtf);// gets r,theta,phi coordinates at the integration points
- velo_from_element(E,VV,m,e,sphere_key); /* assign node-global
- velocities to nodes
- local to the
- element */
- dOmega = &(E->gDA[m][e]); /* Jacobian at integration points */
- GNx = &(E->gNX[m][e]); /* derivatives of shape functions at
- integration points */
-
- /* Vxyz is the strain rate vector, whose relationship with
- * the strain rate tensor (e) is that:
- * Vxyz[1] = e11
- * Vxyz[2] = e22
- * Vxyz[3] = e33
- * Vxyz[4] = 2*e12
- * Vxyz[5] = 2*e13
- * Vxyz[6] = 2*e23
- * where 1 is theta, 2 is phi, and 3 is r
- */
- for(j=1;j<=vpts;j++) {
- pre[j] = E->EVi[m][(e-1)*vpts+j]*dOmega->vpt[j];
- dilation[j] = 0.0;
- Vxyz[1][j] = 0.0;
- Vxyz[2][j] = 0.0;
- Vxyz[3][j] = 0.0;
- Vxyz[4][j] = 0.0;
- Vxyz[5][j] = 0.0;
- Vxyz[6][j] = 0.0;
- Vxyz[7][j] = 0.0;
- Vxyz[8][j] = 0.0;
- }
-
- for(i=1;i<=ends;i++) {
- tww[i] = 0.0;
- for(j=1;j<=vpts;j++) /* weighting, consisting of Jacobian,
- Gauss weight and shape function,
- evaluated at integration points */
- tww[i] += dOmega->vpt[j] * g_point[j].weight[E->mesh.nsd-1]
- * E->N.vpt[GNVINDEX(i,j)];
- }
-
- /* integrate over element */
- for(j=1;j<=vpts;j++) { /* Gauss integration points */
- for(i=1;i<=ends;i++) { /* nodes in element loop */
- /* strain rate contributions from each node */
- Vxyz[1][j]+=( VV[1][i]*GNx->vpt[GNVXINDEX(0,i,j)]
- + VV[3][i]*E->N.vpt[GNVINDEX(i,j)] )*rtf[3][j];
- Vxyz[2][j]+=( (VV[2][i]*GNx->vpt[GNVXINDEX(1,i,j)]
- + VV[1][i]*E->N.vpt[GNVINDEX(i,j)]*cos(rtf[1][j]))/sin(rtf[1][j])
- + VV[3][i]*E->N.vpt[GNVINDEX(i,j)] )*rtf[3][j];
- Vxyz[3][j]+= VV[3][i]*GNx->vpt[GNVXINDEX(2,i,j)];
-
- Vxyz[4][j]+=( (VV[1][i]*GNx->vpt[GNVXINDEX(1,i,j)]
- - VV[2][i]*E->N.vpt[GNVINDEX(i,j)]*cos(rtf[1][j]))/sin(rtf[1][j])
- + VV[2][i]*GNx->vpt[GNVXINDEX(0,i,j)])*rtf[3][j];
- Vxyz[5][j]+=VV[1][i]*GNx->vpt[GNVXINDEX(2,i,j)] + rtf[3][j]*(VV[3][i]
- *GNx->vpt[GNVXINDEX(0,i,j)]-VV[1][i]*E->N.vpt[GNVINDEX(i,j)]);
- Vxyz[6][j]+=VV[2][i]*GNx->vpt[GNVXINDEX(2,i,j)] + rtf[3][j]*(VV[3][i]
- *GNx->vpt[GNVXINDEX(1,i,j)]/sin(rtf[1][j])-VV[2][i]*E->N.vpt[GNVINDEX(i,j)]);
- Vxyz[7][j]+=rtf[3][j] * (
- VV[1][i]*GNx->vpt[GNVXINDEX(0,i,j)]
- + VV[1][i]*E->N.vpt[GNVINDEX(i,j)]*cos(rtf[1][j])/sin(rtf[1][j])
- + VV[2][i]*GNx->vpt[GNVXINDEX(1,i,j)]/sin(rtf[1][j]) );
- Vxyz[8][j]+=rtf[3][j]/sin(rtf[1][j])*
- ( VV[2][i]*GNx->vpt[GNVXINDEX(0,i,j)]*sin(rtf[1][j])
- + VV[2][i]*E->N.vpt[GNVINDEX(i,j)]*cos(rtf[1][j])
- - VV[1][i]*GNx->vpt[GNVXINDEX(1,i,j)] );
- }
- }
-
- if(E->control.inv_gruneisen != 0) { /* isotropic component */
- for(j=1;j<=vpts;j++)
- dilation[j] = (Vxyz[1][j] + Vxyz[2][j] + Vxyz[3][j]) / 3.0;
- }
-
- for(j=1;j<=vpts;j++) {
- Sxx += 2.0 * pre[j] * (Vxyz[1][j] - dilation[j]); /* */
- Syy += 2.0 * pre[j] * (Vxyz[2][j] - dilation[j]);
- Szz += 2.0 * pre[j] * (Vxyz[3][j] - dilation[j]);
- Sxy += pre[j] * Vxyz[4][j]; /* */
- Sxz += pre[j] * Vxyz[5][j];
- Szy += pre[j] * Vxyz[6][j];
- div += Vxyz[7][j]*dOmega->vpt[j]; /* divergence */
- vor += Vxyz[8][j]*dOmega->vpt[j]; /* vorticity */
- }
- /* normalize by volume */
- Sxx /= E->eco[m][e].area;
- Syy /= E->eco[m][e].area;
- Szz /= E->eco[m][e].area;
- Sxy /= E->eco[m][e].area;
- Sxz /= E->eco[m][e].area;
- Szy /= E->eco[m][e].area;
- div /= E->eco[m][e].area;
- vor /= E->eco[m][e].area;
-
- /* add the pressure term */
- Szz -= E->P[m][e];
- Sxx -= E->P[m][e];
- Syy -= E->P[m][e];
-
- for(i=1;i<=ends;i++) {
- node = E->ien[m][e].node[i]; /* assign to global nodes */
- SZZ[m][node] += tww[i] * Szz;
- SXX[m][node] += tww[i] * Sxx;
- SYY[m][node] += tww[i] * Syy;
- SXY[m][node] += tww[i] * Sxy;
- SXZ[m][node] += tww[i] * Sxz;
- SZY[m][node] += tww[i] * Szy;
- divv[m][node]+= tww[i] * div;
- vorv[m][node]+= tww[i] * vor;
- }
-
- } /* end for el */
- } /* end for m */
-
- (E->exchange_node_f)(E,SXX,lev);
- (E->exchange_node_f)(E,SYY,lev);
- (E->exchange_node_f)(E,SZZ,lev);
- (E->exchange_node_f)(E,SXY,lev);
- (E->exchange_node_f)(E,SXZ,lev);
- (E->exchange_node_f)(E,SZY,lev);
- (E->exchange_node_f)(E,divv,lev);
- (E->exchange_node_f)(E,vorv,lev);
-
- stress_scaling = velo_scaling = 1.0;
-
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(node=1;node<=E->lmesh.nno;node++) {
- mass_fac = E->Mass[m][node]*stress_scaling;
- SZZ[m][node] *= mass_fac;
- SXX[m][node] *= mass_fac;
- SYY[m][node] *= mass_fac;
- SXY[m][node] *= mass_fac;
- SXZ[m][node] *= mass_fac;
- SZY[m][node] *= mass_fac;
-
- mass_fac = E->Mass[m][node]*velo_scaling;
- vorv[m][node] *= mass_fac;
- divv[m][node] *= mass_fac;
- }
-
- /* assign stress to all the nodes */
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for (node=1;node<=E->lmesh.nno;node++) {
- E->gstress[m][(node-1)*6+1] = SXX[m][node];
- E->gstress[m][(node-1)*6+2] = SYY[m][node];
- E->gstress[m][(node-1)*6+3] = SZZ[m][node];
- E->gstress[m][(node-1)*6+4] = SXY[m][node];
- E->gstress[m][(node-1)*6+5] = SXZ[m][node];
- E->gstress[m][(node-1)*6+6] = SZY[m][node];
- }
-
- /* replace boundary stresses with boundary conditions (if specified) */
- stress_conform_bcs(E);
-
-}
-
-
-
-
-void stress_conform_bcs(struct All_variables *E)
-{
- int m, i, j, k, n, d;
- const unsigned sbc_flag[4] = {0, SBX, SBY, SBZ};
- const int stress_index[4][4] = { {0, 0, 0, 0},
- {0, 1, 4, 5}, /* N-S sides */
- {0, 4, 2, 6}, /* E-W sides */
- {0, 5, 6, 3} }; /* U-D sides */
-
- if(E->control.side_sbcs) {
-
- for(m=1; m<=E->sphere.caps_per_proc; m++)
- for(i=1; i<=E->lmesh.noy; i++)
- for(j=1; j<=E->lmesh.nox; j++)
- for(k=1; k<=E->lmesh.noz; k++) {
-
- n = k+(j-1)*E->lmesh.noz+(i-1)*E->lmesh.nox*E->lmesh.noz;
-
- for(d=1; d<=E->mesh.nsd; d++)
-
- if(E->node[m][n] & sbc_flag[d]) {
- if(i==1)
- E->gstress[m][(n-1)*6+stress_index[d][2]] = E->sbc.SB[m][SIDE_WEST][d][ E->sbc.node[m][n] ];
- if(i==E->lmesh.noy)
- E->gstress[m][(n-1)*6+stress_index[d][2]] = E->sbc.SB[m][SIDE_EAST][d][ E->sbc.node[m][n] ];
- if(j==1)
- E->gstress[m][(n-1)*6+stress_index[d][1]] = E->sbc.SB[m][SIDE_NORTH][d][ E->sbc.node[m][n] ];
- if(j==E->lmesh.nox)
- E->gstress[m][(n-1)*6+stress_index[d][1]] = E->sbc.SB[m][SIDE_SOUTH][d][ E->sbc.node[m][n] ];
- if(k==1)
- E->gstress[m][(n-1)*6+stress_index[d][3]] = E->sbc.SB[m][SIDE_BOTTOM][d][ E->sbc.node[m][n] ];
- if(k==E->lmesh.noz)
- E->gstress[m][(n-1)*6+stress_index[d][3]] = E->sbc.SB[m][SIDE_TOP][d][ E->sbc.node[m][n] ];
- }
- }
-
- } else {
-
- for(m=1; m<=E->sphere.caps_per_proc; m++)
- for(i=1; i<=E->lmesh.noy; i++)
- for(j=1; j<=E->lmesh.nox; j++)
- for(k=1; k<=E->lmesh.noz; k++) {
- n = k+(j-1)*E->lmesh.noz+(i-1)*E->lmesh.nox*E->lmesh.noz;
- for(d=1; d<=E->mesh.nsd; d++)
- if(E->node[m][n] & sbc_flag[d]) {
- if(i==1 || i==E->lmesh.noy)
- E->gstress[m][(n-1)*6+stress_index[d][2]] = E->sphere.cap[m].VB[d][n];
- if(j==1 || j==E->lmesh.nox)
- E->gstress[m][(n-1)*6+stress_index[d][1]] = E->sphere.cap[m].VB[d][n];
- if(k==1 || k==E->lmesh.noz)
- E->gstress[m][(n-1)*6+stress_index[d][3]] = E->sphere.cap[m].VB[d][n];
- }
- }
- }
-}
-
-
-/* ===================================================================
- =================================================================== */
-
-static void geoid_from_buoyancy(struct All_variables *E,
- float *harm_geoid[2], float *harm_geoidb[2])
-{
- /* Compute the geoid due to internal density distribution.
- *
- * geoid(ll,mm) = 4*pi*G*R*(r/R)^(ll+2)*dlayer*rho(ll,mm)/g/(2*ll+1)
- *
- * E->buoyancy needs to be converted to density (-therm_exp*ref_T/Ra/g)
- * and dimensionalized (data.density). dlayer needs to be dimensionalized.
- */
-
- int m,k,ll,mm,node,i,j,p,noz,snode,nxnz;
- float *TT[NCS],radius,*geoid[2],dlayer,con1,grav,scaling2,scaling,radius_m;
- float cont, conb;
- double buoy2rho;
-
- /* some constants */
- nxnz = E->lmesh.nox*E->lmesh.noz;
- radius_m = E->data.radius_km*1e3;
-
- /* scale for buoyancy */
- scaling2 = -E->data.therm_exp*E->data.ref_temperature*E->data.density
- / E->control.Atemp;
- /* scale for geoid */
- scaling = 4.0 * M_PI * 1.0e3 * E->data.radius_km * E->data.grav_const
- / E->data.grav_acc;
-
- /* density of one layer */
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- TT[m] = (float *) malloc ((E->lmesh.nsf+1)*sizeof(float));
-
- /* sin coeff */
- geoid[0] = (float*)malloc(E->sphere.hindice*sizeof(float));
- /* cos coeff */
- geoid[1] = (float*)malloc(E->sphere.hindice*sizeof(float));
-
- /* reset arrays */
- for (p = 0; p < E->sphere.hindice; p++) {
- harm_geoid[0][p] = 0;
- harm_geoid[1][p] = 0;
- harm_geoidb[0][p] = 0;
- harm_geoidb[1][p] = 0;
- }
-
- /* loop over each layer, notice the range is [1,noz) */
- for(k=1;k<E->lmesh.noz;k++) {
- /* correction for variable gravity */
- grav = 0.5 * (E->refstate.gravity[k] + E->refstate.gravity[k+1]);
- buoy2rho = scaling2 / grav;
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=1;i<=E->lmesh.noy;i++)
- for(j=1;j<=E->lmesh.nox;j++) {
- node= k + (j-1)*E->lmesh.noz + (i-1)*nxnz;
- p = j + (i-1)*E->lmesh.nox;
- /* convert non-dimensional buoyancy to */
- /* dimensional density */
- TT[m][p] = (E->buoyancy[m][node]+E->buoyancy[m][node+1])
- * 0.5 * buoy2rho;
- }
-
- /* expand TT into spherical harmonics */
- sphere_expansion(E,TT,geoid[0],geoid[1]);
-
- /* thickness of the layer */
- dlayer = (E->sx[1][3][k+1]-E->sx[1][3][k])*radius_m;
-
- /* mean radius of the layer */
- radius = (E->sx[1][3][k+1]+E->sx[1][3][k])*0.5;
-
- /* geoid contribution of density at this layer, ignore degree-0 term */
- for (ll=1;ll<=E->output.llmax;ll++) {
- con1 = scaling * dlayer / (2.0*ll+1.0);
- cont = pow(radius, ((double)(ll+2)));
- conb = radius * pow(E->sphere.ri/radius, ((double)(ll)));
-
- for (mm=0;mm<=ll;mm++) {
- p = E->sphere.hindex[ll][mm];
- harm_geoid[0][p] += con1*cont*geoid[0][p];
- harm_geoid[1][p] += con1*cont*geoid[1][p];
- harm_geoidb[0][p] += con1*conb*geoid[0][p];
- harm_geoidb[1][p] += con1*conb*geoid[1][p];
- }
- }
-
- //if(E->parallel.me==0) fprintf(stderr,"layer %d %.5e %g %g %g\n",k,radius,dlayer,con1,con2);
- }
-
- /* accumulate geoid from all layers to the surface (top processors) */
- sum_across_depth_sph1(E, harm_geoid[0], harm_geoid[1]);
-
- /* accumulate geoid from all layers to the CMB (bottom processors) */
- sum_across_depth_sph1(E, harm_geoidb[0], harm_geoidb[1]);
-
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- free ((void *)TT[m]);
-
- free ((void *)geoid[0]);
- free ((void *)geoid[1]);
- return;
-}
-
-static void expand_topo_sph_harm(struct All_variables *E,
- float *tpgt[2],
- float *tpgb[2])
-{
- /* Expand topography into spherical harmonics
- *
- * E->slice.tpg is essentailly non-dimensional stress(rr) and need
- * to be dimensionalized by stress_scaling/(delta_rho*g).
- */
-
- float scaling, stress_scaling, topo_scaling1,topo_scaling2;
- float den_contrast1, den_contrast2, grav1, grav2;
- int i, j;
-
- stress_scaling = E->data.ref_viscosity*E->data.therm_diff/
- (E->data.radius_km*E->data.radius_km*1e6);
-
- /* density contrast across surface, need to dimensionalize reference density */
- den_contrast1 = E->data.density*E->refstate.rho[E->lmesh.noz] - E->data.density_above;
- /* density contrast across CMB, need to dimensionalize reference density */
- den_contrast2 = E->data.density_below - E->data.density*E->refstate.rho[1];
-
- /* gravity at surface */
- grav1 = E->refstate.gravity[E->lmesh.noz] * E->data.grav_acc;
- /* gravity at CMB */
- grav2 = E->refstate.gravity[1] * E->data.grav_acc;
-
- /* scale for surface and CMB topo */
- topo_scaling1 = stress_scaling / (den_contrast1 * grav1);
- topo_scaling2 = stress_scaling / (den_contrast2 * grav2);
-
- /* scale for geoid */
- scaling = 4.0 * M_PI * 1.0e3 * E->data.radius_km * E->data.grav_const
- / E->data.grav_acc;
-
- if (E->parallel.me_loc[3] == E->parallel.nprocz-1) {
- /* expand surface topography into sph. harm. */
- sphere_expansion(E, E->slice.tpg, tpgt[0], tpgt[1]);
-
- /* dimensionalize surface topography */
- for (j=0; j<2; j++)
- for (i=0; i<E->sphere.hindice; i++) {
- tpgt[j][i] *= topo_scaling1;
- }
- }
-
-
- if (E->parallel.me_loc[3] == 0) {
- /* expand bottom topography into sph. harm. */
- sphere_expansion(E, E->slice.tpgb, tpgb[0], tpgb[1]);
-
- /* dimensionalize bottom topography */
- for (j=0; j<2; j++)
- for (i=0; i<E->sphere.hindice; i++) {
- tpgb[j][i] *= topo_scaling2;
- }
- }
-
- /* send arrays to all processors in the same vertical column */
- broadcast_vertical(E, tpgb[0], tpgb[1], 0);
- broadcast_vertical(E, tpgt[0], tpgt[1], E->parallel.nprocz-1);
-
- return;
-}
-
-
-static void geoid_from_topography(struct All_variables *E,
- float *tpgt[2],
- float *tpgb[2],
- float *geoid_tpgt[2],
- float *geoid_tpgb[2])
-{
- /* Compute the geoid due to surface and CMB dynamic topography.
- *
- * geoid(ll,mm) = 4*pi*G*R*delta_rho*topo(ll,mm)/g/(2*ll+1)
- *
- * In theory, the degree-0 and 1 coefficients of topography must be 0.
- * The geoid coefficents for these degrees are ingnored as a result.
- */
-
- float con1,con2,scaling,den_contrast1,den_contrast2;
- int i,j,k,ll,mm,s;
-
- /* density contrast across surface, need to dimensionalize reference density */
- den_contrast1 = E->data.density*E->refstate.rho[E->lmesh.noz] - E->data.density_above;
- /* density contrast across CMB, need to dimensionalize reference density */
- den_contrast2 = E->data.density_below - E->data.density*E->refstate.rho[1];
-
-
- /* reset arrays */
- for (i = 0; i < E->sphere.hindice; i++) {
- geoid_tpgt[0][i] = 0;
- geoid_tpgt[1][i] = 0;
- geoid_tpgb[0][i] = 0;
- geoid_tpgb[1][i] = 0;
- }
-
- if (E->parallel.me_loc[3] == E->parallel.nprocz-1) {
- /* scale for geoid */
- scaling = 4.0 * M_PI * 1.0e3 * E->data.radius_km * E->data.grav_const
- / E->data.grav_acc;
-
- /* compute geoid due to surface topo, skip degree-0 and 1 term */
- for (j=0; j<2; j++)
- for (ll=2; ll<=E->output.llmax; ll++) {
- con1 = den_contrast1 * scaling / (2.0*ll + 1.0);
- for (mm=0; mm<=ll; mm++) {
- i = E->sphere.hindex[ll][mm];
- geoid_tpgt[j][i] = tpgt[j][i] * con1;
- }
- }
- }
-
-
- if (E->parallel.me_loc[3] == 0) {
- /* scale for geoid */
- scaling = 1.0e3 * 4.0 * M_PI * E->data.radius_km * E->data.grav_const
- / (E->data.grav_acc * E->refstate.gravity[1]);
-
- /* compute geoid due to bottom topo, skip degree-0 and 1 term */
- for (j=0; j<2; j++)
- for (ll=2; ll<=E->output.llmax; ll++) {
- con1 = den_contrast2 * scaling / (2.0*ll + 1.0);
- con2 = con1 * pow(E->sphere.ri, ((double)(ll+2)));
- for (mm=0; mm<=ll; mm++) {
- i = E->sphere.hindex[ll][mm];
- geoid_tpgb[j][i] = tpgb[j][i] * con2;
- }
- }
- }
-
- /* send arrays to all processors in the same vertical column */
- broadcast_vertical(E, geoid_tpgb[0], geoid_tpgb[1], 0);
- broadcast_vertical(E, geoid_tpgt[0], geoid_tpgt[1], E->parallel.nprocz-1);
-
- return;
-}
-
-
-static void geoid_from_topography_self_g(struct All_variables *E,
- float *tpgt[2],
- float *tpgb[2],
- float *geoid_bncy[2],
- float *geoid_bncy_botm[2],
- float *geoid_tpgt[2],
- float *geoid_tpgb[2])
-{
- /* geoid correction due to self gravitation. The equation can be
- * found in this reference:
- * Zhong et al., (2008), A Benchmark Study on Mantle Convection
- * in a 3-D Spherical Shell Using CitcomS, submitted to G^3.
- */
-
- double den_contrast1,den_contrast2,grav1,grav2;
- double topo2stress1, topo2stress2;
- long double con4, ri;
- long double a1,b1,c1_0,c1_1,a2,b2,c2_0,c2_1,a11,a12,a21,a22,f1_0,f2_0,f1_1,f2_1,denom;
- int i,j,k,ll,mm,s;
-
- ri = E->sphere.ri;
-
- /* density contrast across surface, need to dimensionalize reference density */
- den_contrast1 = E->data.density*E->refstate.rho[E->lmesh.noz] - E->data.density_above;
- /* density contrast across CMB, need to dimensionalize reference density */
- den_contrast2 = E->data.density_below - E->data.density*E->refstate.rho[1];
-
- /* gravity at surface */
- grav1 = E->refstate.gravity[E->lmesh.noz] * E->data.grav_acc;
- /* gravity at CMB */
- grav2 = E->refstate.gravity[1] * E->data.grav_acc;
-
- /* scale from surface and CMB topo to stress */
- topo2stress1 = den_contrast1 * grav1;
- topo2stress2 = den_contrast2 * grav2;
-
-
- con4 = 4.0*M_PI*E->data.grav_const*E->data.radius_km*1000;
-
- /* reset arrays */
- for (i = 0; i < E->sphere.hindice; i++) {
- geoid_tpgt[0][i] = 0;
- geoid_tpgt[1][i] = 0;
- geoid_tpgb[0][i] = 0;
- geoid_tpgb[1][i] = 0;
- }
-
- for (ll=2;ll<=E->output.llmax;ll++) {
- // dimension: gravity
- a1 = con4/(2*ll+1)*ri*lg_pow(ri,ll+1)*den_contrast2;
- b1 = con4/(2*ll+1)*den_contrast1;
- a2 = con4/(2*ll+1)*ri*den_contrast2;
- b2 = con4/(2*ll+1)*lg_pow(ri,ll)*den_contrast1;
-
- // dimension: rho*g
- a11 = den_contrast1*E->data.grav_acc - E->data.density*b1;
- a12 = - E->data.density*a1;
- a21 =-den_contrast2*b2;
- a22 = den_contrast2*(E->data.grav_acc-a2);
-
- denom = 1.0L / (a11*a22 - a12*a21);
-
- for (mm=0;mm<=ll;mm++) {
- i = E->sphere.hindex[ll][mm];
-
- // cos term
- c1_0 = geoid_bncy[0][i]*E->data.density*grav1;
- c2_0 = geoid_bncy_botm[0][i]*den_contrast2*grav2;
- f1_0 = tpgt[0][i]*topo2stress1 + c1_0;
- f2_0 = tpgb[0][i]*topo2stress2 + c2_0;
-
- tpgt[0][i] = (f1_0*a22-f2_0*a12)*denom;
- tpgb[0][i] = (f2_0*a11-f1_0*a21)*denom;
-
- // sin term
- c1_1 = geoid_bncy[1][i]*E->data.density*grav1;
- c2_1 = geoid_bncy_botm[1][i]*den_contrast2*grav2;
- f1_1 = tpgt[1][i]*topo2stress1 + c1_1;
- f2_1 = tpgb[1][i]*topo2stress2 + c2_1;
-
- /* update topo with self-g */
- tpgt[1][i] = (f1_1*a22-f2_1*a12)*denom;
- tpgb[1][i] = (f2_1*a11-f1_1*a21)*denom;
-
-
- /* update geoid due to topo with self-g */
- geoid_tpgt[0][i] = b1 * tpgt[0][i] / grav1;
- geoid_tpgt[1][i] = b1 * tpgt[1][i] / grav1;
-
- geoid_tpgb[0][i] = a1 * tpgb[0][i] / grav1;
- geoid_tpgb[1][i] = a1 * tpgb[1][i] / grav1;
-
- /* the followings are geoid at the bottom due to topo, not used */
- //geoidb_tpg[0][i] = (a2*tpgb[0][i] +
- // b2*tpgt[0][i]) / grav2;
-
- //geoidb_tpg[1][i] = (a2*tpgb[1][i] +
- // b2*tpgt[1][i]) / grav2;
- }
- }
-
- /* send arrays to all processors in the same vertical column */
- broadcast_vertical(E, geoid_tpgb[0], geoid_tpgb[1], 0);
- broadcast_vertical(E, geoid_tpgt[0], geoid_tpgt[1], E->parallel.nprocz-1);
-
- return;
-}
-
-
-
-void compute_geoid(E)
- struct All_variables *E;
-{
- int i, p;
-
- geoid_from_buoyancy(E, E->sphere.harm_geoid_from_bncy,
- E->sphere.harm_geoid_from_bncy_botm);
-
- expand_topo_sph_harm(E, E->sphere.harm_tpgt, E->sphere.harm_tpgb);
-
- if(E->control.self_gravitation)
- geoid_from_topography_self_g(E,
- E->sphere.harm_tpgt,
- E->sphere.harm_tpgb,
- E->sphere.harm_geoid_from_bncy,
- E->sphere.harm_geoid_from_bncy_botm,
- E->sphere.harm_geoid_from_tpgt,
- E->sphere.harm_geoid_from_tpgb);
- else
- geoid_from_topography(E, E->sphere.harm_tpgt, E->sphere.harm_tpgb,
- E->sphere.harm_geoid_from_tpgt,
- E->sphere.harm_geoid_from_tpgb);
-
- if (E->parallel.me == (E->parallel.nprocz-1)) {
- for (i = 0; i < 2; i++)
- for (p = 0; p < E->sphere.hindice; p++) {
- E->sphere.harm_geoid[i][p]
- = E->sphere.harm_geoid_from_bncy[i][p]
- + E->sphere.harm_geoid_from_tpgt[i][p]
- + E->sphere.harm_geoid_from_tpgb[i][p];
- }
- }
-
- return;
-}
-
-
-/* ===================================================================
- Consistent boundary flux method for stress ... Zhong,Gurnis,Hulbert
-
- Solve for the stress as the code defined it internally, rather than
- what was intended to be solved. This is more appropriate.
-
- Note also that the routine is dependent on the method
- used to solve for the velocity in the first place.
- =================================================================== */
-
-
-/*
-
-this routine does not require stress tensor computation, call
-separately if stress output is needed
-
- */
-void get_CBF_topo(E,H,HB) /* call this only for top and bottom processors*/
- struct All_variables *E;
- float **H,**HB;
-
-{
- void get_elt_k();
- void get_elt_g();
- void get_elt_f();
- void get_global_1d_shape_fn_L();
- void full_exchange_snode_f();
- void regional_exchange_snode_f();
- void velo_from_element();
-
- int a,address,el,elb,els,node,nodeb,nodes,i,j,k,l,m,n,count;
- int nodel,nodem,nodesl,nodesm,nnsf,nel2;
-
- struct Shape_function1 GM,GMb;
- struct Shape_function1_dA dGammax,dGammabx;
-
- float *eltTU,*eltTL,*SU[NCS],*SL[NCS],*RU[NCS],*RL[NCS];
- float VV[4][9];
-
- double eltk[24*24],eltf[24];
- double eltkb[24*24],eltfb[24];
- double res[24],resb[24],eu[24],eub[24];
- higher_precision eltg[24][1],eltgb[24][1];
-
- const int dims=E->mesh.nsd;
- const int Tsize=5; /* maximum values, applicable to 3d, harmless for 2d */
- const int Ssize=4;
- const int ends=enodes[dims];
- const int noz=E->lmesh.noz;
- const int noy=E->lmesh.noy;
- const int nno=E->lmesh.nno;
- const int onedv=onedvpoints[dims];
- const int snode1=1,snode2=4,snode3=5,snode4=8;
- const int elz = E->lmesh.elz;
- const int ely = E->lmesh.ely;
- const int lev=E->mesh.levmax;
- const int sphere_key=1;
-
- const int lnsf=E->lmesh.nsf;
-
- eltTU = (float *)malloc((1+Tsize)*sizeof(float));
- eltTL = (float *)malloc((1+Tsize)*sizeof(float));
-
- for(j=1;j<=E->sphere.caps_per_proc;j++) {
- SU[j] = (float *)malloc((1+lnsf)*sizeof(float));
- SL[j] = (float *)malloc((1+lnsf)*sizeof(float));
- RU[j] = (float *)malloc((1+lnsf)*sizeof(float));
- RL[j] = (float *)malloc((1+lnsf)*sizeof(float));
- }
-
- for(j=1;j<=E->sphere.caps_per_proc;j++) {
-
- for(i=0;i<=lnsf;i++)
- RU[j][i] = RL[j][i] = SU[j][i] = SL[j][i] = 0.0;
-
- /* calculate the element residuals */
-
- for(els=1;els<=E->lmesh.snel;els++) {
- el = E->surf_element[j][els];
- elb = el - elz+1;
-
- velo_from_element(E,VV,j,elb,sphere_key);
-
- for(m=0;m<ends;m++) {
- eub [m*dims ] = VV[1][m+1];
- eub [m*dims+1] = VV[2][m+1];
- eub [m*dims+2] = VV[3][m+1];
- }
-
- velo_from_element(E,VV,j,el,sphere_key);
-
- for(m=0;m<ends;m++) {
- eu [m*dims ] = VV[1][m+1];
- eu [m*dims+1] = VV[2][m+1];
- eu [m*dims+2] = VV[3][m+1];
- }
-
- get_elt_f(E,elb,eltfb,1,j);
- get_elt_f(E,el,eltf,1,j);
- get_elt_k(E,elb,eltkb,lev,j,1);
- get_elt_k(E,el,eltk,lev,j,1);
-// get_elt_g(E,elb,eltgb,lev,j);
-// get_elt_g(E,el,eltg,lev,j);
-
- for(m=0;m<dims*ends;m++) {
- res[m] = eltf[m] - E->elt_del[lev][j][el].g[m][0] * E->P[j][el];
- resb[m] = eltfb[m] - E->elt_del[lev][j][elb].g[m][0]* E->P[j][elb];
-// res[m] = eltf[m] - eltg[m][0] * E->P[j][el];
-// resb[m] = eltfb[m] - eltgb[m][0]* E->P[j][elb];
- }
-
- for(m=0;m<dims*ends;m++)
- for(l=0;l<dims*ends;l++) {
- res[m] -= eltk[ends*dims*m+l] * eu[l];
- resb[m] -= eltkb[ends*dims*m+l] * eub[l];
- }
-
- /* Put relevant (vertical & surface) parts of element residual into surface residual */
-
- for(m=1;m<=ends;m++) {
- if (m<=4) {
- switch (m) {
- case 1:
- nodes = E->sien[j][els].node[1];
- break;
- case 2:
- nodes = E->sien[j][els].node[2];
- break;
- case 3:
- nodes = E->sien[j][els].node[3];
- break;
- case 4:
- nodes = E->sien[j][els].node[4];
- break;
- }
- RL[j][nodes] += resb[(m-1)*dims+2];
- }
- else {
- switch (m) {
- case 5:
- nodes = E->sien[j][els].node[1];
- break;
- case 6:
- nodes = E->sien[j][els].node[2];
- break;
- case 7:
- nodes = E->sien[j][els].node[3];
- break;
- case 8:
- nodes = E->sien[j][els].node[4];
- break;
- }
- RU[j][nodes] += res[(m-1)*dims+2];
- }
- } /* end for m */
- }
-
-
- /* calculate the LHS */
-
- for(els=1;els<=E->lmesh.snel;els++) {
- el = E->surf_element[j][els];
- elb = el - elz+1;
-
- get_global_1d_shape_fn_L(E,el,&GM,&dGammax,1,j);
- get_global_1d_shape_fn_L(E,elb,&GMb,&dGammabx,0,j);
-
- for(m=1;m<=onedv;m++) {
- eltTU[m-1] = 0.0;
- eltTL[m-1] = 0.0;
- for(n=1;n<=onedv;n++) {
- eltTU[m-1] +=
- dGammax.vpt[GMVGAMMA(1,n)]
- * E->L.vpt[GMVINDEX(m,n)] * E->L.vpt[GMVINDEX(m,n)];
- eltTL[m-1] +=
- dGammabx.vpt[GMVGAMMA(0,n)]
- * E->L.vpt[GMVINDEX(m,n)] * E->L.vpt[GMVINDEX(m,n)];
- }
- }
-
- for (m=1;m<=onedv;m++) /* for bottom */
- SL[j][E->sien[j][els].node[m]] += eltTL[m-1];
-
- for (m=1;m<=onedv;m++)
- SU[j][E->sien[j][els].node[m]] += eltTU[m-1];
-
- }
-
- } /* end for j */
-
- /* for bottom topography */
- if(E->parallel.me_loc[3] == 0) {
- if(E->sphere.caps == 12)
- full_exchange_snode_f(E,RL,SL,E->mesh.levmax);
- else
- regional_exchange_snode_f(E,RL,SL,E->mesh.levmax);
-
- for (j=1;j<=E->sphere.caps_per_proc;j++)
- for(i=1;i<=E->lmesh.nsf;i++)
- HB[j][i] = RL[j][i]/SL[j][i];
- }
- /* for top topo */
- if(E->parallel.me_loc[3] == E->parallel.nprocz-1) {
- if(E->sphere.caps == 12)
- full_exchange_snode_f(E,RU,SU,E->mesh.levmax);
- else
- regional_exchange_snode_f(E,RU,SU,E->mesh.levmax);
-
- for (j=1;j<=E->sphere.caps_per_proc;j++)
- for(i=1;i<=E->lmesh.nsf;i++)
- H[j][i] = RU[j][i]/SU[j][i];
- }
- free((void *)eltTU);
- free((void *)eltTL);
- for (j=1;j<=E->sphere.caps_per_proc;j++) {
- free((void *)SU[j]);
- free((void *)SL[j]);
- free((void *)RU[j]);
- free((void *)RL[j]);
- }
- return;
-}
-
-
-/* version */
-/* $Id$ */
-
-/* End of file */
Copied: mc/3D/CitcomS/branches/cxx/lib/Topo_gravity.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Topo_gravity.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Topo_gravity.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Topo_gravity.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,1065 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+#include <stdio.h>
+#include <math.h>
+#include "element_definitions.h"
+#include "global_defs.h"
+
+#include "cproto.h"
+
+void myerror(char *,struct All_variables *);
+void sphere_expansion(struct All_variables *, float **, float *, float *);
+void sphere_expansion();
+void sum_across_depth_sph1(struct All_variables *, float *, float *);
+void broadcast_vertical(struct All_variables *, float *, float *, int);
+long double lg_pow(long double, int);
+void allocate_STD_mem(struct All_variables *E,
+ float** , float** , float** ,
+ float** , float** , float** ,
+ float** , float** );
+void free_STD_mem(struct All_variables *E,
+ float** , float** , float** ,
+ float** , float** , float** ,
+ float** , float** );
+void compute_nodal_stress(struct All_variables *,
+ float** , float** , float** ,
+ float** , float** , float** ,
+ float** , float** );
+void stress_conform_bcs(struct All_variables *);
+
+/*
+
+compute the full stress tensor and the dynamic topo
+
+here, we only need szz, but leave in for potential stress output if
+removed, make sure to recompute in output routines
+
+
+ */
+
+void get_STD_topo(
+ struct All_variables *E,
+ float **tpg, float **tpgb,
+ float **divg, float **vort,
+ int ii
+ )
+{
+ int node,snode,m;
+ float *SXX[NCS],*SYY[NCS],*SXY[NCS],*SXZ[NCS],*SZY[NCS],*SZZ[NCS];
+ float *divv[NCS],*vorv[NCS];
+ float topo_scaling1, topo_scaling2;
+
+ allocate_STD_mem(E, SXX, SYY, SZZ, SXY, SXZ, SZY, divv, vorv);
+
+ /* this one is for szz */
+ compute_nodal_stress(E, SXX, SYY, SZZ, SXY, SXZ, SZY, divv, vorv);
+
+ // not needed ? TWB XXX
+ //if (E->parallel.me_loc[3]==E->parallel.nprocz-1)
+ //get_surf_stress(E,SXX,SYY,SZZ,SXY,SXZ,SZY);
+
+
+ topo_scaling1 = topo_scaling2 = 1.0;
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(snode=1;snode<=E->lmesh.nsf;snode++) {
+ node = E->surf_node[m][snode];
+ tpg[m][snode] = -2*SZZ[m][node] + SZZ[m][node-1];
+ tpgb[m][snode] = 2*SZZ[m][node-E->lmesh.noz+1]- SZZ[m][node-E->lmesh.noz+2];
+
+ tpg[m][snode] = tpg[m][snode] *topo_scaling1;
+ tpgb[m][snode] = tpgb[m][snode]*topo_scaling2;
+
+ divg[m][snode] = 2*divv[m][node]-divv[m][node-1];
+ vort[m][snode] = 2*vorv[m][node]-vorv[m][node-1];
+ }
+
+ free_STD_mem(E, SXX, SYY, SZZ, SXY, SXZ, SZY, divv, vorv);
+
+ return;
+}
+
+void get_STD_freesurf(struct All_variables *E,float **freesurf)
+{
+ int node,snode,m;
+
+ if (E->parallel.me_loc[3]==E->parallel.nprocz-1)
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(snode=1;snode<=E->lmesh.nsf;snode++) {
+ node = E->surf_node[m][snode];
+ /*freesurf[m][snode] += 0.5*(E->sphere.cap[m].V[3][node]+E->sphere.cap[m].Vprev[3][node])*E->advection.timestep;*/
+ freesurf[m][snode] += E->sphere.cap[m].V[3][node]*E->advection.timestep;
+ }
+ return;
+}
+
+
+void allocate_STD_mem(struct All_variables *E,
+ float** SXX, float** SYY, float** SZZ,
+ float** SXY, float** SXZ, float** SZY,
+ float** divv, float** vorv)
+{
+ int m, i;
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+ SXX[m] = (float *)malloc((E->lmesh.nno+1)*sizeof(float));
+ SYY[m] = (float *)malloc((E->lmesh.nno+1)*sizeof(float));
+ SXY[m] = (float *)malloc((E->lmesh.nno+1)*sizeof(float));
+ SXZ[m] = (float *)malloc((E->lmesh.nno+1)*sizeof(float));
+ SZY[m] = (float *)malloc((E->lmesh.nno+1)*sizeof(float));
+ SZZ[m] = (float *)malloc((E->lmesh.nno+1)*sizeof(float));
+ divv[m] = (float *)malloc((E->lmesh.nno+1)*sizeof(float));
+ vorv[m] = (float *)malloc((E->lmesh.nno+1)*sizeof(float));
+ }
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+ for(i=1;i<=E->lmesh.nno;i++) {
+ SZZ[m][i] = 0.0;
+ SXX[m][i] = 0.0;
+ SYY[m][i] = 0.0;
+ SXY[m][i] = 0.0;
+ SXZ[m][i] = 0.0;
+ SZY[m][i] = 0.0;
+ divv[m][i] = 0.0;
+ vorv[m][i] = 0.0;
+ }
+ }
+ return;
+}
+
+
+void free_STD_mem(struct All_variables *E,
+ float** SXX, float** SYY, float** SZZ,
+ float** SXY, float** SXZ, float** SZY,
+ float** divv, float** vorv)
+{
+ int m;
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+ free((void *)SXX[m]);
+ free((void *)SYY[m]);
+ free((void *)SXY[m]);
+ free((void *)SXZ[m]);
+ free((void *)SZY[m]);
+ free((void *)SZZ[m]);
+ free((void *)divv[m]);
+ free((void *)vorv[m]);
+ }
+}
+
+
+/* void get_surf_stress(E,SXX,SYY,SZZ,SXY,SXZ,SZY) */
+/* struct All_variables *E; */
+/* float **SXX,**SYY,**SZZ,**SXY,**SXZ,**SZY; */
+/* { */
+/* int m,i,node,stride; */
+
+/* stride = E->lmesh.nsf*6; */
+
+/* for(m=1;m<=E->sphere.caps_per_proc;m++) */
+/* for (node=1;node<=E->lmesh.nno;node++) */
+/* if ( (node%E->lmesh.noz)==0 ) { */
+/* i = node/E->lmesh.noz; */
+/* E->stress[m][(i-1)*6+1] = SXX[m][node]; */
+/* E->stress[m][(i-1)*6+2] = SYY[m][node]; */
+/* E->stress[m][(i-1)*6+3] = SZZ[m][node]; */
+/* E->stress[m][(i-1)*6+4] = SXY[m][node]; */
+/* E->stress[m][(i-1)*6+5] = SXZ[m][node]; */
+/* E->stress[m][(i-1)*6+6] = SZY[m][node]; */
+/* } */
+/* else if ( ((node+1)%E->lmesh.noz)==0 ) { */
+/* i = (node+1)/E->lmesh.noz; */
+/* E->stress[m][stride+(i-1)*6+1] = SXX[m][node]; */
+/* E->stress[m][stride+(i-1)*6+2] = SYY[m][node]; */
+/* E->stress[m][stride+(i-1)*6+3] = SZZ[m][node]; */
+/* E->stress[m][stride+(i-1)*6+4] = SXY[m][node]; */
+/* E->stress[m][stride+(i-1)*6+5] = SXZ[m][node]; */
+/* E->stress[m][stride+(i-1)*6+6] = SZY[m][node]; */
+/* } */
+
+/* return; */
+/* } */
+
+
+void compute_nodal_stress(struct All_variables *E,
+ float** SXX, float** SYY, float** SZZ,
+ float** SXY, float** SXZ, float** SZY,
+ float** divv, float** vorv)
+{
+ int i,j,e,node,m;
+
+ float VV[4][9],Vxyz[9][9],Szz,Sxx,Syy,Sxy,Sxz,Szy,div,vor;
+ double dilation[9];
+ double pre[9],tww[9],rtf[4][9];
+ double velo_scaling, stress_scaling, mass_fac;
+
+ struct Shape_function_dA *dOmega;
+ struct Shape_function_dx *GNx;
+
+ const int dims=E->mesh.nsd;
+ const int vpts=vpoints[dims];
+ const int ends=enodes[dims];
+ const int lev=E->mesh.levmax;
+ const int sphere_key=1;
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+ for(e=1;e<=E->lmesh.nel;e++) {
+ Szz = 0.0;
+ Sxx = 0.0;
+ Syy = 0.0;
+ Sxy = 0.0;
+ Sxz = 0.0;
+ Szy = 0.0;
+ div = 0.0;
+ vor = 0.0;
+
+ get_rtf_at_vpts(E, m, lev, e, rtf);// gets r,theta,phi coordinates at the integration points
+ velo_from_element(E,VV,m,e,sphere_key); /* assign node-global
+ velocities to nodes
+ local to the
+ element */
+ dOmega = &(E->gDA[m][e]); /* Jacobian at integration points */
+ GNx = &(E->gNX[m][e]); /* derivatives of shape functions at
+ integration points */
+
+ /* Vxyz is the strain rate vector, whose relationship with
+ * the strain rate tensor (e) is that:
+ * Vxyz[1] = e11
+ * Vxyz[2] = e22
+ * Vxyz[3] = e33
+ * Vxyz[4] = 2*e12
+ * Vxyz[5] = 2*e13
+ * Vxyz[6] = 2*e23
+ * where 1 is theta, 2 is phi, and 3 is r
+ */
+ for(j=1;j<=vpts;j++) {
+ pre[j] = E->EVi[m][(e-1)*vpts+j]*dOmega->vpt[j];
+ dilation[j] = 0.0;
+ Vxyz[1][j] = 0.0;
+ Vxyz[2][j] = 0.0;
+ Vxyz[3][j] = 0.0;
+ Vxyz[4][j] = 0.0;
+ Vxyz[5][j] = 0.0;
+ Vxyz[6][j] = 0.0;
+ Vxyz[7][j] = 0.0;
+ Vxyz[8][j] = 0.0;
+ }
+
+ for(i=1;i<=ends;i++) {
+ tww[i] = 0.0;
+ for(j=1;j<=vpts;j++) /* weighting, consisting of Jacobian,
+ Gauss weight and shape function,
+ evaluated at integration points */
+ tww[i] += dOmega->vpt[j] * g_point[j].weight[E->mesh.nsd-1]
+ * E->N.vpt[GNVINDEX(i,j)];
+ }
+
+ /* integrate over element */
+ for(j=1;j<=vpts;j++) { /* Gauss integration points */
+ for(i=1;i<=ends;i++) { /* nodes in element loop */
+ /* strain rate contributions from each node */
+ Vxyz[1][j]+=( VV[1][i]*GNx->vpt[GNVXINDEX(0,i,j)]
+ + VV[3][i]*E->N.vpt[GNVINDEX(i,j)] )*rtf[3][j];
+ Vxyz[2][j]+=( (VV[2][i]*GNx->vpt[GNVXINDEX(1,i,j)]
+ + VV[1][i]*E->N.vpt[GNVINDEX(i,j)]*cos(rtf[1][j]))/sin(rtf[1][j])
+ + VV[3][i]*E->N.vpt[GNVINDEX(i,j)] )*rtf[3][j];
+ Vxyz[3][j]+= VV[3][i]*GNx->vpt[GNVXINDEX(2,i,j)];
+
+ Vxyz[4][j]+=( (VV[1][i]*GNx->vpt[GNVXINDEX(1,i,j)]
+ - VV[2][i]*E->N.vpt[GNVINDEX(i,j)]*cos(rtf[1][j]))/sin(rtf[1][j])
+ + VV[2][i]*GNx->vpt[GNVXINDEX(0,i,j)])*rtf[3][j];
+ Vxyz[5][j]+=VV[1][i]*GNx->vpt[GNVXINDEX(2,i,j)] + rtf[3][j]*(VV[3][i]
+ *GNx->vpt[GNVXINDEX(0,i,j)]-VV[1][i]*E->N.vpt[GNVINDEX(i,j)]);
+ Vxyz[6][j]+=VV[2][i]*GNx->vpt[GNVXINDEX(2,i,j)] + rtf[3][j]*(VV[3][i]
+ *GNx->vpt[GNVXINDEX(1,i,j)]/sin(rtf[1][j])-VV[2][i]*E->N.vpt[GNVINDEX(i,j)]);
+ Vxyz[7][j]+=rtf[3][j] * (
+ VV[1][i]*GNx->vpt[GNVXINDEX(0,i,j)]
+ + VV[1][i]*E->N.vpt[GNVINDEX(i,j)]*cos(rtf[1][j])/sin(rtf[1][j])
+ + VV[2][i]*GNx->vpt[GNVXINDEX(1,i,j)]/sin(rtf[1][j]) );
+ Vxyz[8][j]+=rtf[3][j]/sin(rtf[1][j])*
+ ( VV[2][i]*GNx->vpt[GNVXINDEX(0,i,j)]*sin(rtf[1][j])
+ + VV[2][i]*E->N.vpt[GNVINDEX(i,j)]*cos(rtf[1][j])
+ - VV[1][i]*GNx->vpt[GNVXINDEX(1,i,j)] );
+ }
+ }
+
+ if(E->control.inv_gruneisen != 0) { /* isotropic component */
+ for(j=1;j<=vpts;j++)
+ dilation[j] = (Vxyz[1][j] + Vxyz[2][j] + Vxyz[3][j]) / 3.0;
+ }
+
+ for(j=1;j<=vpts;j++) {
+ Sxx += 2.0 * pre[j] * (Vxyz[1][j] - dilation[j]); /* */
+ Syy += 2.0 * pre[j] * (Vxyz[2][j] - dilation[j]);
+ Szz += 2.0 * pre[j] * (Vxyz[3][j] - dilation[j]);
+ Sxy += pre[j] * Vxyz[4][j]; /* */
+ Sxz += pre[j] * Vxyz[5][j];
+ Szy += pre[j] * Vxyz[6][j];
+ div += Vxyz[7][j]*dOmega->vpt[j]; /* divergence */
+ vor += Vxyz[8][j]*dOmega->vpt[j]; /* vorticity */
+ }
+ /* normalize by volume */
+ Sxx /= E->eco[m][e].area;
+ Syy /= E->eco[m][e].area;
+ Szz /= E->eco[m][e].area;
+ Sxy /= E->eco[m][e].area;
+ Sxz /= E->eco[m][e].area;
+ Szy /= E->eco[m][e].area;
+ div /= E->eco[m][e].area;
+ vor /= E->eco[m][e].area;
+
+ /* add the pressure term */
+ Szz -= E->P[m][e];
+ Sxx -= E->P[m][e];
+ Syy -= E->P[m][e];
+
+ for(i=1;i<=ends;i++) {
+ node = E->ien[m][e].node[i]; /* assign to global nodes */
+ SZZ[m][node] += tww[i] * Szz;
+ SXX[m][node] += tww[i] * Sxx;
+ SYY[m][node] += tww[i] * Syy;
+ SXY[m][node] += tww[i] * Sxy;
+ SXZ[m][node] += tww[i] * Sxz;
+ SZY[m][node] += tww[i] * Szy;
+ divv[m][node]+= tww[i] * div;
+ vorv[m][node]+= tww[i] * vor;
+ }
+
+ } /* end for el */
+ } /* end for m */
+
+ (E->exchange_node_f)(E,SXX,lev);
+ (E->exchange_node_f)(E,SYY,lev);
+ (E->exchange_node_f)(E,SZZ,lev);
+ (E->exchange_node_f)(E,SXY,lev);
+ (E->exchange_node_f)(E,SXZ,lev);
+ (E->exchange_node_f)(E,SZY,lev);
+ (E->exchange_node_f)(E,divv,lev);
+ (E->exchange_node_f)(E,vorv,lev);
+
+ stress_scaling = velo_scaling = 1.0;
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(node=1;node<=E->lmesh.nno;node++) {
+ mass_fac = E->Mass[m][node]*stress_scaling;
+ SZZ[m][node] *= mass_fac;
+ SXX[m][node] *= mass_fac;
+ SYY[m][node] *= mass_fac;
+ SXY[m][node] *= mass_fac;
+ SXZ[m][node] *= mass_fac;
+ SZY[m][node] *= mass_fac;
+
+ mass_fac = E->Mass[m][node]*velo_scaling;
+ vorv[m][node] *= mass_fac;
+ divv[m][node] *= mass_fac;
+ }
+
+ /* assign stress to all the nodes */
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for (node=1;node<=E->lmesh.nno;node++) {
+ E->gstress[m][(node-1)*6+1] = SXX[m][node];
+ E->gstress[m][(node-1)*6+2] = SYY[m][node];
+ E->gstress[m][(node-1)*6+3] = SZZ[m][node];
+ E->gstress[m][(node-1)*6+4] = SXY[m][node];
+ E->gstress[m][(node-1)*6+5] = SXZ[m][node];
+ E->gstress[m][(node-1)*6+6] = SZY[m][node];
+ }
+
+ /* replace boundary stresses with boundary conditions (if specified) */
+ stress_conform_bcs(E);
+
+}
+
+
+
+
+void stress_conform_bcs(struct All_variables *E)
+{
+ int m, i, j, k, n, d;
+ const unsigned sbc_flag[4] = {0, SBX, SBY, SBZ};
+ const int stress_index[4][4] = { {0, 0, 0, 0},
+ {0, 1, 4, 5}, /* N-S sides */
+ {0, 4, 2, 6}, /* E-W sides */
+ {0, 5, 6, 3} }; /* U-D sides */
+
+ if(E->control.side_sbcs) {
+
+ for(m=1; m<=E->sphere.caps_per_proc; m++)
+ for(i=1; i<=E->lmesh.noy; i++)
+ for(j=1; j<=E->lmesh.nox; j++)
+ for(k=1; k<=E->lmesh.noz; k++) {
+
+ n = k+(j-1)*E->lmesh.noz+(i-1)*E->lmesh.nox*E->lmesh.noz;
+
+ for(d=1; d<=E->mesh.nsd; d++)
+
+ if(E->node[m][n] & sbc_flag[d]) {
+ if(i==1)
+ E->gstress[m][(n-1)*6+stress_index[d][2]] = E->sbc.SB[m][SIDE_WEST][d][ E->sbc.node[m][n] ];
+ if(i==E->lmesh.noy)
+ E->gstress[m][(n-1)*6+stress_index[d][2]] = E->sbc.SB[m][SIDE_EAST][d][ E->sbc.node[m][n] ];
+ if(j==1)
+ E->gstress[m][(n-1)*6+stress_index[d][1]] = E->sbc.SB[m][SIDE_NORTH][d][ E->sbc.node[m][n] ];
+ if(j==E->lmesh.nox)
+ E->gstress[m][(n-1)*6+stress_index[d][1]] = E->sbc.SB[m][SIDE_SOUTH][d][ E->sbc.node[m][n] ];
+ if(k==1)
+ E->gstress[m][(n-1)*6+stress_index[d][3]] = E->sbc.SB[m][SIDE_BOTTOM][d][ E->sbc.node[m][n] ];
+ if(k==E->lmesh.noz)
+ E->gstress[m][(n-1)*6+stress_index[d][3]] = E->sbc.SB[m][SIDE_TOP][d][ E->sbc.node[m][n] ];
+ }
+ }
+
+ } else {
+
+ for(m=1; m<=E->sphere.caps_per_proc; m++)
+ for(i=1; i<=E->lmesh.noy; i++)
+ for(j=1; j<=E->lmesh.nox; j++)
+ for(k=1; k<=E->lmesh.noz; k++) {
+ n = k+(j-1)*E->lmesh.noz+(i-1)*E->lmesh.nox*E->lmesh.noz;
+ for(d=1; d<=E->mesh.nsd; d++)
+ if(E->node[m][n] & sbc_flag[d]) {
+ if(i==1 || i==E->lmesh.noy)
+ E->gstress[m][(n-1)*6+stress_index[d][2]] = E->sphere.cap[m].VB[d][n];
+ if(j==1 || j==E->lmesh.nox)
+ E->gstress[m][(n-1)*6+stress_index[d][1]] = E->sphere.cap[m].VB[d][n];
+ if(k==1 || k==E->lmesh.noz)
+ E->gstress[m][(n-1)*6+stress_index[d][3]] = E->sphere.cap[m].VB[d][n];
+ }
+ }
+ }
+}
+
+
+/* ===================================================================
+ =================================================================== */
+
+static void geoid_from_buoyancy(struct All_variables *E,
+ float *harm_geoid[2], float *harm_geoidb[2])
+{
+ /* Compute the geoid due to internal density distribution.
+ *
+ * geoid(ll,mm) = 4*pi*G*R*(r/R)^(ll+2)*dlayer*rho(ll,mm)/g/(2*ll+1)
+ *
+ * E->buoyancy needs to be converted to density (-therm_exp*ref_T/Ra/g)
+ * and dimensionalized (data.density). dlayer needs to be dimensionalized.
+ */
+
+ int m,k,ll,mm,node,i,j,p,noz,snode,nxnz;
+ float *TT[NCS],radius,*geoid[2],dlayer,con1,grav,scaling2,scaling,radius_m;
+ float cont, conb;
+ double buoy2rho;
+
+ /* some constants */
+ nxnz = E->lmesh.nox*E->lmesh.noz;
+ radius_m = E->data.radius_km*1e3;
+
+ /* scale for buoyancy */
+ scaling2 = -E->data.therm_exp*E->data.ref_temperature*E->data.density
+ / E->control.Atemp;
+ /* scale for geoid */
+ scaling = 4.0 * M_PI * 1.0e3 * E->data.radius_km * E->data.grav_const
+ / E->data.grav_acc;
+
+ /* density of one layer */
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ TT[m] = (float *) malloc ((E->lmesh.nsf+1)*sizeof(float));
+
+ /* sin coeff */
+ geoid[0] = (float*)malloc(E->sphere.hindice*sizeof(float));
+ /* cos coeff */
+ geoid[1] = (float*)malloc(E->sphere.hindice*sizeof(float));
+
+ /* reset arrays */
+ for (p = 0; p < E->sphere.hindice; p++) {
+ harm_geoid[0][p] = 0;
+ harm_geoid[1][p] = 0;
+ harm_geoidb[0][p] = 0;
+ harm_geoidb[1][p] = 0;
+ }
+
+ /* loop over each layer, notice the range is [1,noz) */
+ for(k=1;k<E->lmesh.noz;k++) {
+ /* correction for variable gravity */
+ grav = 0.5 * (E->refstate.gravity[k] + E->refstate.gravity[k+1]);
+ buoy2rho = scaling2 / grav;
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=1;i<=E->lmesh.noy;i++)
+ for(j=1;j<=E->lmesh.nox;j++) {
+ node= k + (j-1)*E->lmesh.noz + (i-1)*nxnz;
+ p = j + (i-1)*E->lmesh.nox;
+ /* convert non-dimensional buoyancy to */
+ /* dimensional density */
+ TT[m][p] = (E->buoyancy[m][node]+E->buoyancy[m][node+1])
+ * 0.5 * buoy2rho;
+ }
+
+ /* expand TT into spherical harmonics */
+ sphere_expansion(E,TT,geoid[0],geoid[1]);
+
+ /* thickness of the layer */
+ dlayer = (E->sx[1][3][k+1]-E->sx[1][3][k])*radius_m;
+
+ /* mean radius of the layer */
+ radius = (E->sx[1][3][k+1]+E->sx[1][3][k])*0.5;
+
+ /* geoid contribution of density at this layer, ignore degree-0 term */
+ for (ll=1;ll<=E->output.llmax;ll++) {
+ con1 = scaling * dlayer / (2.0*ll+1.0);
+ cont = pow(radius, ((double)(ll+2)));
+ conb = radius * pow(E->sphere.ri/radius, ((double)(ll)));
+
+ for (mm=0;mm<=ll;mm++) {
+ p = E->sphere.hindex[ll][mm];
+ harm_geoid[0][p] += con1*cont*geoid[0][p];
+ harm_geoid[1][p] += con1*cont*geoid[1][p];
+ harm_geoidb[0][p] += con1*conb*geoid[0][p];
+ harm_geoidb[1][p] += con1*conb*geoid[1][p];
+ }
+ }
+
+ //if(E->parallel.me==0) fprintf(stderr,"layer %d %.5e %g %g %g\n",k,radius,dlayer,con1,con2);
+ }
+
+ /* accumulate geoid from all layers to the surface (top processors) */
+ sum_across_depth_sph1(E, harm_geoid[0], harm_geoid[1]);
+
+ /* accumulate geoid from all layers to the CMB (bottom processors) */
+ sum_across_depth_sph1(E, harm_geoidb[0], harm_geoidb[1]);
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ free ((void *)TT[m]);
+
+ free ((void *)geoid[0]);
+ free ((void *)geoid[1]);
+ return;
+}
+
+static void expand_topo_sph_harm(struct All_variables *E,
+ float *tpgt[2],
+ float *tpgb[2])
+{
+ /* Expand topography into spherical harmonics
+ *
+ * E->slice.tpg is essentailly non-dimensional stress(rr) and need
+ * to be dimensionalized by stress_scaling/(delta_rho*g).
+ */
+
+ float scaling, stress_scaling, topo_scaling1,topo_scaling2;
+ float den_contrast1, den_contrast2, grav1, grav2;
+ int i, j;
+
+ stress_scaling = E->data.ref_viscosity*E->data.therm_diff/
+ (E->data.radius_km*E->data.radius_km*1e6);
+
+ /* density contrast across surface, need to dimensionalize reference density */
+ den_contrast1 = E->data.density*E->refstate.rho[E->lmesh.noz] - E->data.density_above;
+ /* density contrast across CMB, need to dimensionalize reference density */
+ den_contrast2 = E->data.density_below - E->data.density*E->refstate.rho[1];
+
+ /* gravity at surface */
+ grav1 = E->refstate.gravity[E->lmesh.noz] * E->data.grav_acc;
+ /* gravity at CMB */
+ grav2 = E->refstate.gravity[1] * E->data.grav_acc;
+
+ /* scale for surface and CMB topo */
+ topo_scaling1 = stress_scaling / (den_contrast1 * grav1);
+ topo_scaling2 = stress_scaling / (den_contrast2 * grav2);
+
+ /* scale for geoid */
+ scaling = 4.0 * M_PI * 1.0e3 * E->data.radius_km * E->data.grav_const
+ / E->data.grav_acc;
+
+ if (E->parallel.me_loc[3] == E->parallel.nprocz-1) {
+ /* expand surface topography into sph. harm. */
+ sphere_expansion(E, E->slice.tpg, tpgt[0], tpgt[1]);
+
+ /* dimensionalize surface topography */
+ for (j=0; j<2; j++)
+ for (i=0; i<E->sphere.hindice; i++) {
+ tpgt[j][i] *= topo_scaling1;
+ }
+ }
+
+
+ if (E->parallel.me_loc[3] == 0) {
+ /* expand bottom topography into sph. harm. */
+ sphere_expansion(E, E->slice.tpgb, tpgb[0], tpgb[1]);
+
+ /* dimensionalize bottom topography */
+ for (j=0; j<2; j++)
+ for (i=0; i<E->sphere.hindice; i++) {
+ tpgb[j][i] *= topo_scaling2;
+ }
+ }
+
+ /* send arrays to all processors in the same vertical column */
+ broadcast_vertical(E, tpgb[0], tpgb[1], 0);
+ broadcast_vertical(E, tpgt[0], tpgt[1], E->parallel.nprocz-1);
+
+ return;
+}
+
+
+static void geoid_from_topography(struct All_variables *E,
+ float *tpgt[2],
+ float *tpgb[2],
+ float *geoid_tpgt[2],
+ float *geoid_tpgb[2])
+{
+ /* Compute the geoid due to surface and CMB dynamic topography.
+ *
+ * geoid(ll,mm) = 4*pi*G*R*delta_rho*topo(ll,mm)/g/(2*ll+1)
+ *
+ * In theory, the degree-0 and 1 coefficients of topography must be 0.
+ * The geoid coefficents for these degrees are ingnored as a result.
+ */
+
+ float con1,con2,scaling,den_contrast1,den_contrast2;
+ int i,j,k,ll,mm,s;
+
+ /* density contrast across surface, need to dimensionalize reference density */
+ den_contrast1 = E->data.density*E->refstate.rho[E->lmesh.noz] - E->data.density_above;
+ /* density contrast across CMB, need to dimensionalize reference density */
+ den_contrast2 = E->data.density_below - E->data.density*E->refstate.rho[1];
+
+
+ /* reset arrays */
+ for (i = 0; i < E->sphere.hindice; i++) {
+ geoid_tpgt[0][i] = 0;
+ geoid_tpgt[1][i] = 0;
+ geoid_tpgb[0][i] = 0;
+ geoid_tpgb[1][i] = 0;
+ }
+
+ if (E->parallel.me_loc[3] == E->parallel.nprocz-1) {
+ /* scale for geoid */
+ scaling = 4.0 * M_PI * 1.0e3 * E->data.radius_km * E->data.grav_const
+ / E->data.grav_acc;
+
+ /* compute geoid due to surface topo, skip degree-0 and 1 term */
+ for (j=0; j<2; j++)
+ for (ll=2; ll<=E->output.llmax; ll++) {
+ con1 = den_contrast1 * scaling / (2.0*ll + 1.0);
+ for (mm=0; mm<=ll; mm++) {
+ i = E->sphere.hindex[ll][mm];
+ geoid_tpgt[j][i] = tpgt[j][i] * con1;
+ }
+ }
+ }
+
+
+ if (E->parallel.me_loc[3] == 0) {
+ /* scale for geoid */
+ scaling = 1.0e3 * 4.0 * M_PI * E->data.radius_km * E->data.grav_const
+ / (E->data.grav_acc * E->refstate.gravity[1]);
+
+ /* compute geoid due to bottom topo, skip degree-0 and 1 term */
+ for (j=0; j<2; j++)
+ for (ll=2; ll<=E->output.llmax; ll++) {
+ con1 = den_contrast2 * scaling / (2.0*ll + 1.0);
+ con2 = con1 * pow(E->sphere.ri, ((double)(ll+2)));
+ for (mm=0; mm<=ll; mm++) {
+ i = E->sphere.hindex[ll][mm];
+ geoid_tpgb[j][i] = tpgb[j][i] * con2;
+ }
+ }
+ }
+
+ /* send arrays to all processors in the same vertical column */
+ broadcast_vertical(E, geoid_tpgb[0], geoid_tpgb[1], 0);
+ broadcast_vertical(E, geoid_tpgt[0], geoid_tpgt[1], E->parallel.nprocz-1);
+
+ return;
+}
+
+
+static void geoid_from_topography_self_g(struct All_variables *E,
+ float *tpgt[2],
+ float *tpgb[2],
+ float *geoid_bncy[2],
+ float *geoid_bncy_botm[2],
+ float *geoid_tpgt[2],
+ float *geoid_tpgb[2])
+{
+ /* geoid correction due to self gravitation. The equation can be
+ * found in this reference:
+ * Zhong et al., (2008), A Benchmark Study on Mantle Convection
+ * in a 3-D Spherical Shell Using CitcomS, submitted to G^3.
+ */
+
+ double den_contrast1,den_contrast2,grav1,grav2;
+ double topo2stress1, topo2stress2;
+ long double con4, ri;
+ long double a1,b1,c1_0,c1_1,a2,b2,c2_0,c2_1,a11,a12,a21,a22,f1_0,f2_0,f1_1,f2_1,denom;
+ int i,j,k,ll,mm,s;
+
+ ri = E->sphere.ri;
+
+ /* density contrast across surface, need to dimensionalize reference density */
+ den_contrast1 = E->data.density*E->refstate.rho[E->lmesh.noz] - E->data.density_above;
+ /* density contrast across CMB, need to dimensionalize reference density */
+ den_contrast2 = E->data.density_below - E->data.density*E->refstate.rho[1];
+
+ /* gravity at surface */
+ grav1 = E->refstate.gravity[E->lmesh.noz] * E->data.grav_acc;
+ /* gravity at CMB */
+ grav2 = E->refstate.gravity[1] * E->data.grav_acc;
+
+ /* scale from surface and CMB topo to stress */
+ topo2stress1 = den_contrast1 * grav1;
+ topo2stress2 = den_contrast2 * grav2;
+
+
+ con4 = 4.0*M_PI*E->data.grav_const*E->data.radius_km*1000;
+
+ /* reset arrays */
+ for (i = 0; i < E->sphere.hindice; i++) {
+ geoid_tpgt[0][i] = 0;
+ geoid_tpgt[1][i] = 0;
+ geoid_tpgb[0][i] = 0;
+ geoid_tpgb[1][i] = 0;
+ }
+
+ for (ll=2;ll<=E->output.llmax;ll++) {
+ // dimension: gravity
+ a1 = con4/(2*ll+1)*ri*lg_pow(ri,ll+1)*den_contrast2;
+ b1 = con4/(2*ll+1)*den_contrast1;
+ a2 = con4/(2*ll+1)*ri*den_contrast2;
+ b2 = con4/(2*ll+1)*lg_pow(ri,ll)*den_contrast1;
+
+ // dimension: rho*g
+ a11 = den_contrast1*E->data.grav_acc - E->data.density*b1;
+ a12 = - E->data.density*a1;
+ a21 =-den_contrast2*b2;
+ a22 = den_contrast2*(E->data.grav_acc-a2);
+
+ denom = 1.0L / (a11*a22 - a12*a21);
+
+ for (mm=0;mm<=ll;mm++) {
+ i = E->sphere.hindex[ll][mm];
+
+ // cos term
+ c1_0 = geoid_bncy[0][i]*E->data.density*grav1;
+ c2_0 = geoid_bncy_botm[0][i]*den_contrast2*grav2;
+ f1_0 = tpgt[0][i]*topo2stress1 + c1_0;
+ f2_0 = tpgb[0][i]*topo2stress2 + c2_0;
+
+ tpgt[0][i] = (f1_0*a22-f2_0*a12)*denom;
+ tpgb[0][i] = (f2_0*a11-f1_0*a21)*denom;
+
+ // sin term
+ c1_1 = geoid_bncy[1][i]*E->data.density*grav1;
+ c2_1 = geoid_bncy_botm[1][i]*den_contrast2*grav2;
+ f1_1 = tpgt[1][i]*topo2stress1 + c1_1;
+ f2_1 = tpgb[1][i]*topo2stress2 + c2_1;
+
+ /* update topo with self-g */
+ tpgt[1][i] = (f1_1*a22-f2_1*a12)*denom;
+ tpgb[1][i] = (f2_1*a11-f1_1*a21)*denom;
+
+
+ /* update geoid due to topo with self-g */
+ geoid_tpgt[0][i] = b1 * tpgt[0][i] / grav1;
+ geoid_tpgt[1][i] = b1 * tpgt[1][i] / grav1;
+
+ geoid_tpgb[0][i] = a1 * tpgb[0][i] / grav1;
+ geoid_tpgb[1][i] = a1 * tpgb[1][i] / grav1;
+
+ /* the followings are geoid at the bottom due to topo, not used */
+ //geoidb_tpg[0][i] = (a2*tpgb[0][i] +
+ // b2*tpgt[0][i]) / grav2;
+
+ //geoidb_tpg[1][i] = (a2*tpgb[1][i] +
+ // b2*tpgt[1][i]) / grav2;
+ }
+ }
+
+ /* send arrays to all processors in the same vertical column */
+ broadcast_vertical(E, geoid_tpgb[0], geoid_tpgb[1], 0);
+ broadcast_vertical(E, geoid_tpgt[0], geoid_tpgt[1], E->parallel.nprocz-1);
+
+ return;
+}
+
+
+
+void compute_geoid(struct All_variables *E)
+{
+ int i, p;
+
+ geoid_from_buoyancy(E, E->sphere.harm_geoid_from_bncy,
+ E->sphere.harm_geoid_from_bncy_botm);
+
+ expand_topo_sph_harm(E, E->sphere.harm_tpgt, E->sphere.harm_tpgb);
+
+ if(E->control.self_gravitation)
+ geoid_from_topography_self_g(E,
+ E->sphere.harm_tpgt,
+ E->sphere.harm_tpgb,
+ E->sphere.harm_geoid_from_bncy,
+ E->sphere.harm_geoid_from_bncy_botm,
+ E->sphere.harm_geoid_from_tpgt,
+ E->sphere.harm_geoid_from_tpgb);
+ else
+ geoid_from_topography(E, E->sphere.harm_tpgt, E->sphere.harm_tpgb,
+ E->sphere.harm_geoid_from_tpgt,
+ E->sphere.harm_geoid_from_tpgb);
+
+ if (E->parallel.me == (E->parallel.nprocz-1)) {
+ for (i = 0; i < 2; i++)
+ for (p = 0; p < E->sphere.hindice; p++) {
+ E->sphere.harm_geoid[i][p]
+ = E->sphere.harm_geoid_from_bncy[i][p]
+ + E->sphere.harm_geoid_from_tpgt[i][p]
+ + E->sphere.harm_geoid_from_tpgb[i][p];
+ }
+ }
+
+ return;
+}
+
+
+/* ===================================================================
+ Consistent boundary flux method for stress ... Zhong,Gurnis,Hulbert
+
+ Solve for the stress as the code defined it internally, rather than
+ what was intended to be solved. This is more appropriate.
+
+ Note also that the routine is dependent on the method
+ used to solve for the velocity in the first place.
+ =================================================================== */
+
+
+/*
+
+this routine does not require stress tensor computation, call
+separately if stress output is needed
+
+ */
+void get_CBF_topo( /* call this only for top and bottom processors*/
+ struct All_variables *E,
+ float **H, float **HB
+ )
+{
+ int a,address,el,elb,els,node,nodeb,nodes,i,j,k,l,m,n,count;
+ int nodel,nodem,nodesl,nodesm,nnsf,nel2;
+
+ struct Shape_function1 GM,GMb;
+ struct Shape_function1_dA dGammax,dGammabx;
+
+ float *eltTU,*eltTL,*SU[NCS],*SL[NCS],*RU[NCS],*RL[NCS];
+ float VV[4][9];
+
+ double eltk[24*24],eltf[24];
+ double eltkb[24*24],eltfb[24];
+ double res[24],resb[24],eu[24],eub[24];
+ higher_precision eltg[24][1],eltgb[24][1];
+
+ const int dims=E->mesh.nsd;
+ const int Tsize=5; /* maximum values, applicable to 3d, harmless for 2d */
+ const int Ssize=4;
+ const int ends=enodes[dims];
+ const int noz=E->lmesh.noz;
+ const int noy=E->lmesh.noy;
+ const int nno=E->lmesh.nno;
+ const int onedv=onedvpoints[dims];
+ const int snode1=1,snode2=4,snode3=5,snode4=8;
+ const int elz = E->lmesh.elz;
+ const int ely = E->lmesh.ely;
+ const int lev=E->mesh.levmax;
+ const int sphere_key=1;
+
+ const int lnsf=E->lmesh.nsf;
+
+ eltTU = (float *)malloc((1+Tsize)*sizeof(float));
+ eltTL = (float *)malloc((1+Tsize)*sizeof(float));
+
+ for(j=1;j<=E->sphere.caps_per_proc;j++) {
+ SU[j] = (float *)malloc((1+lnsf)*sizeof(float));
+ SL[j] = (float *)malloc((1+lnsf)*sizeof(float));
+ RU[j] = (float *)malloc((1+lnsf)*sizeof(float));
+ RL[j] = (float *)malloc((1+lnsf)*sizeof(float));
+ }
+
+ for(j=1;j<=E->sphere.caps_per_proc;j++) {
+
+ for(i=0;i<=lnsf;i++)
+ RU[j][i] = RL[j][i] = SU[j][i] = SL[j][i] = 0.0;
+
+ /* calculate the element residuals */
+
+ for(els=1;els<=E->lmesh.snel;els++) {
+ el = E->surf_element[j][els];
+ elb = el - elz+1;
+
+ velo_from_element(E,VV,j,elb,sphere_key);
+
+ for(m=0;m<ends;m++) {
+ eub [m*dims ] = VV[1][m+1];
+ eub [m*dims+1] = VV[2][m+1];
+ eub [m*dims+2] = VV[3][m+1];
+ }
+
+ velo_from_element(E,VV,j,el,sphere_key);
+
+ for(m=0;m<ends;m++) {
+ eu [m*dims ] = VV[1][m+1];
+ eu [m*dims+1] = VV[2][m+1];
+ eu [m*dims+2] = VV[3][m+1];
+ }
+
+ get_elt_f(E,elb,eltfb,1,j);
+ get_elt_f(E,el,eltf,1,j);
+ get_elt_k(E,elb,eltkb,lev,j,1);
+ get_elt_k(E,el,eltk,lev,j,1);
+// get_elt_g(E,elb,eltgb,lev,j);
+// get_elt_g(E,el,eltg,lev,j);
+
+ for(m=0;m<dims*ends;m++) {
+ res[m] = eltf[m] - E->elt_del[lev][j][el].g[m][0] * E->P[j][el];
+ resb[m] = eltfb[m] - E->elt_del[lev][j][elb].g[m][0]* E->P[j][elb];
+// res[m] = eltf[m] - eltg[m][0] * E->P[j][el];
+// resb[m] = eltfb[m] - eltgb[m][0]* E->P[j][elb];
+ }
+
+ for(m=0;m<dims*ends;m++)
+ for(l=0;l<dims*ends;l++) {
+ res[m] -= eltk[ends*dims*m+l] * eu[l];
+ resb[m] -= eltkb[ends*dims*m+l] * eub[l];
+ }
+
+ /* Put relevant (vertical & surface) parts of element residual into surface residual */
+
+ for(m=1;m<=ends;m++) {
+ if (m<=4) {
+ switch (m) {
+ case 1:
+ nodes = E->sien[j][els].node[1];
+ break;
+ case 2:
+ nodes = E->sien[j][els].node[2];
+ break;
+ case 3:
+ nodes = E->sien[j][els].node[3];
+ break;
+ case 4:
+ nodes = E->sien[j][els].node[4];
+ break;
+ }
+ RL[j][nodes] += resb[(m-1)*dims+2];
+ }
+ else {
+ switch (m) {
+ case 5:
+ nodes = E->sien[j][els].node[1];
+ break;
+ case 6:
+ nodes = E->sien[j][els].node[2];
+ break;
+ case 7:
+ nodes = E->sien[j][els].node[3];
+ break;
+ case 8:
+ nodes = E->sien[j][els].node[4];
+ break;
+ }
+ RU[j][nodes] += res[(m-1)*dims+2];
+ }
+ } /* end for m */
+ }
+
+
+ /* calculate the LHS */
+
+ for(els=1;els<=E->lmesh.snel;els++) {
+ el = E->surf_element[j][els];
+ elb = el - elz+1;
+
+ get_global_1d_shape_fn_L(E,el,&GM,&dGammax,1,j);
+ get_global_1d_shape_fn_L(E,elb,&GMb,&dGammabx,0,j);
+
+ for(m=1;m<=onedv;m++) {
+ eltTU[m-1] = 0.0;
+ eltTL[m-1] = 0.0;
+ for(n=1;n<=onedv;n++) {
+ eltTU[m-1] +=
+ dGammax.vpt[GMVGAMMA(1,n)]
+ * E->L.vpt[GMVINDEX(m,n)] * E->L.vpt[GMVINDEX(m,n)];
+ eltTL[m-1] +=
+ dGammabx.vpt[GMVGAMMA(0,n)]
+ * E->L.vpt[GMVINDEX(m,n)] * E->L.vpt[GMVINDEX(m,n)];
+ }
+ }
+
+ for (m=1;m<=onedv;m++) /* for bottom */
+ SL[j][E->sien[j][els].node[m]] += eltTL[m-1];
+
+ for (m=1;m<=onedv;m++)
+ SU[j][E->sien[j][els].node[m]] += eltTU[m-1];
+
+ }
+
+ } /* end for j */
+
+ /* for bottom topography */
+ if(E->parallel.me_loc[3] == 0) {
+ if(E->sphere.caps == 12)
+ full_exchange_snode_f(E,RL,SL,E->mesh.levmax);
+ else
+ regional_exchange_snode_f(E,RL,SL,E->mesh.levmax);
+
+ for (j=1;j<=E->sphere.caps_per_proc;j++)
+ for(i=1;i<=E->lmesh.nsf;i++)
+ HB[j][i] = RL[j][i]/SL[j][i];
+ }
+ /* for top topo */
+ if(E->parallel.me_loc[3] == E->parallel.nprocz-1) {
+ if(E->sphere.caps == 12)
+ full_exchange_snode_f(E,RU,SU,E->mesh.levmax);
+ else
+ regional_exchange_snode_f(E,RU,SU,E->mesh.levmax);
+
+ for (j=1;j<=E->sphere.caps_per_proc;j++)
+ for(i=1;i<=E->lmesh.nsf;i++)
+ H[j][i] = RU[j][i]/SU[j][i];
+ }
+ free((void *)eltTU);
+ free((void *)eltTL);
+ for (j=1;j<=E->sphere.caps_per_proc;j++) {
+ free((void *)SU[j]);
+ free((void *)SL[j]);
+ free((void *)RU[j]);
+ free((void *)RL[j]);
+ }
+ return;
+}
+
+
+/* version */
+/* $Id$ */
+
+/* End of file */
Deleted: mc/3D/CitcomS/branches/cxx/lib/Tracer_setup.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Tracer_setup.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Tracer_setup.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,1827 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-/*
-
- Tracer_setup.c
-
- A program which initiates the distribution of tracers
- and advects those tracers in a time evolving velocity field.
- Called and used from the CitCOM finite element code.
- Written 2/96 M. Gurnis for Citcom in cartesian geometry
- Modified by Lijie in 1998 and by Vlad and Eh in 2005 for the
- regional version of CitcomS. In 2003, Allen McNamara wrote the
- tracer module for the global version of CitcomS. In 2007, Eh Tan
- merged the two versions of tracer codes together.
-*/
-
-#include <math.h>
-#include "global_defs.h"
-#include "parsing.h"
-#include "parallel_related.h"
-#include "composition_related.h"
-
-#ifdef USE_GGRD
-#include "ggrd_handling.h"
-#endif
-
-#ifdef USE_GZDIR
-int open_file_zipped(char *, FILE **,struct All_variables *);
-void gzip_file(char *);
-#endif
-
-int icheck_that_processor_shell(struct All_variables *E,
- int j, int nprocessor, double rad);
-void expand_later_array(struct All_variables *E, int j);
-void expand_tracer_arrays(struct All_variables *E, int j);
-void tracer_post_processing(struct All_variables *E);
-void allocate_tracer_arrays(struct All_variables *E,
- int j, int number_of_tracers);
-void count_tracers_of_flavors(struct All_variables *E);
-
-int full_icheck_cap(struct All_variables *E, int icap,
- double x, double y, double z, double rad);
-int regional_icheck_cap(struct All_variables *E, int icap,
- double x, double y, double z, double rad);
-
-static void find_tracers(struct All_variables *E);
-static void predict_tracers(struct All_variables *E);
-static void correct_tracers(struct All_variables *E);
-static void make_tracer_array(struct All_variables *E);
-static void generate_random_tracers(struct All_variables *E,
- int tracers_cap, int j);
-static void read_tracer_file(struct All_variables *E);
-static void read_old_tracer_file(struct All_variables *E);
-static void check_sum(struct All_variables *E);
-static int isum_tracers(struct All_variables *E);
-static void init_tracer_flavors(struct All_variables *E);
-static void free_tracer_arrays(struct All_variables *E, int j);
-static void reduce_tracer_arrays(struct All_variables *E);
-static void put_away_later(struct All_variables *E, int j, int it);
-static void eject_tracer(struct All_variables *E, int j, int it);
-int read_double_vector(FILE *, int , double *);
-void cart_to_sphere(struct All_variables *,
- double , double , double ,
- double *, double *, double *);
-void sphere_to_cart(struct All_variables *,
- double , double , double ,
- double *, double *, double *);
-int icheck_processor_shell(struct All_variables *,
- int , double );
-
-
-
-void tracer_input(struct All_variables *E)
-{
- void full_tracer_input();
- void myerror();
- void report();
- char message[100];
- int m=E->parallel.me;
- int i;
-
- input_boolean("tracer",&(E->control.tracer),"off",m);
- input_boolean("tracer_enriched",
- &(E->control.tracer_enriched),"off",m);
- if(E->control.tracer_enriched){
- if(!E->control.tracer) /* check here so that we can get away
- with only one if statement in
- Advection_diffusion */
- myerror(E,"need to switch on tracers for tracer_enriched");
-
- input_float("Q0_enriched",&(E->control.Q0ER),"0.0",m);
- snprintf(message,100,"using compositionally enriched heating: C = 0: %g C = 1: %g (only one composition!)",
- E->control.Q0,E->control.Q0ER);
- report(E,message);
- //
- // this check doesn't work at this point in the code, and we didn't want to put it into every call to
- // Advection diffusion
- //
- //if(E->composition.ncomp != 1)
- //myerror(E,"enriched tracers cannot deal with more than one composition yet");
-
- }
- if(E->control.tracer) {
-
- /* tracer_ic_method=0 (random generated array) */
- /* tracer_ic_method=1 (all proc read the same file) */
- /* tracer_ic_method=2 (each proc reads its restart file) */
- input_int("tracer_ic_method",&(E->trace.ic_method),"0,0,nomax",m);
-
- if (E->trace.ic_method==0){
- input_int("tracers_per_element",&(E->trace.itperel),"10,0,nomax",m);
- }
- else if (E->trace.ic_method==1)
- input_string("tracer_file",E->trace.tracer_file,"tracer.dat",m);
- else if (E->trace.ic_method==2) {
- /* Use 'datadir_old', 'datafile_old', and 'solution_cycles_init' */
- /* to form the filename */
- }
- else {
- fprintf(stderr,"Sorry, tracer_ic_method only 0, 1 and 2 available\n");
- parallel_process_termination();
- }
-
-
- /* How many flavors of tracers */
- /* If tracer_flavors > 0, each element will report the number of
- * tracers of each flavor inside it. This information can be used
- * later for many purposes. One of it is to compute composition,
- * either using absolute method or ratio method. */
- input_int("tracer_flavors",&(E->trace.nflavors),"0,0,nomax",m);
-
-
- input_int("ic_method_for_flavors",
- &(E->trace.ic_method_for_flavors),"0,0,nomax",m);
-
-
- if (E->trace.nflavors > 1) {
- switch(E->trace.ic_method_for_flavors){
- case 0: /* layer */
- E->trace.z_interface = (double*) malloc((E->trace.nflavors-1)
- *sizeof(double));
- for(i=0; i<E->trace.nflavors-1; i++)
- E->trace.z_interface[i] = 0.7;
-
- input_double_vector("z_interface", E->trace.nflavors-1,
- E->trace.z_interface, m);
- break;
- case 1: /* from grid in top n materials */
- input_string("ictracer_grd_file",E->trace.ggrd_file,"",m); /* file from which to read */
- input_int("ictracer_grd_layers",&(E->trace.ggrd_layers),"2",m); /* which top layers to use */
- break;
- default:
- fprintf(stderr,"ic_method_for_flavors %i undefined\n",E->trace.ic_method_for_flavors);
- parallel_process_termination();
- break;
- }
- }
-
- /* Warning level */
- input_boolean("itracer_warnings",&(E->trace.itracer_warnings),"on",m);
-
-
- /* Interpolate convection fields onto the location of tracers */
- input_int("itracer_interpolate_fields",&(E->trace.itracer_interpolate_fields),"0",m);
-
-
- if(E->parallel.nprocxy == 12)
- full_tracer_input(E);
-
-
- composition_input(E);
-
- }
-
- return;
-}
-
-
-void tracer_initial_settings(struct All_variables *E)
-{
- void full_keep_within_bounds();
- void full_tracer_setup();
- void full_get_velocity();
- int full_iget_element();
- void regional_keep_within_bounds();
- void regional_tracer_setup();
- void regional_get_velocity();
- int regional_iget_element();
-
- E->trace.advection_time = 0;
- E->trace.find_tracers_time = 0;
- E->trace.lost_souls_time = 0;
-
- if(E->parallel.nprocxy == 1) {
- E->problem_tracer_setup = regional_tracer_setup;
-
- E->trace.keep_within_bounds = regional_keep_within_bounds;
- E->trace.get_velocity = regional_get_velocity;
- E->trace.iget_element = regional_iget_element;
- }
- else {
- E->problem_tracer_setup = full_tracer_setup;
-
- E->trace.keep_within_bounds = full_keep_within_bounds;
- E->trace.get_velocity = full_get_velocity;
- E->trace.iget_element = full_iget_element;
- }
-}
-
-
-
-/*****************************************************************************/
-/* This function is the primary tracing routine called from Citcom.c */
-/* In this code, unlike the original 3D cartesian code, force is filled */
-/* during Stokes solution. No need to call thermal_buoyancy() after tracing. */
-
-
-void tracer_advection(struct All_variables *E)
-{
- double CPU_time0();
- double begin_time = CPU_time0();
-
- /* advect tracers */
- predict_tracers(E);
- correct_tracers(E);
-
- /* check that the number of tracers is conserved */
- check_sum(E);
-
- /* count # of tracers of each flavor */
- if (E->trace.nflavors > 0)
- count_tracers_of_flavors(E);
-
- /* update the composition field */
- if (E->composition.on) {
- fill_composition(E);
- }
-
- E->trace.advection_time += CPU_time0() - begin_time;
-
- tracer_post_processing(E);
-
- return;
-}
-
-
-
-/********* TRACER POST PROCESSING ****************************************/
-
-void tracer_post_processing(struct All_variables *E)
-{
- int i;
-
- /* reset statistical counters */
-
- E->trace.istat_isend=0;
- E->trace.istat_elements_checked=0;
- E->trace.istat1=0;
-
- /* write timing information every 20 steps */
- if ((E->monitor.solution_cycles % 20) == 0) {
- fprintf(E->trace.fpt, "STEP %d\n", E->monitor.solution_cycles);
-
- fprintf(E->trace.fpt, "Advecting tracers takes %f seconds.\n",
- E->trace.advection_time - E->trace.find_tracers_time);
- fprintf(E->trace.fpt, "Finding element takes %f seconds.\n",
- E->trace.find_tracers_time - E->trace.lost_souls_time);
- fprintf(E->trace.fpt, "Exchanging lost tracers takes %f seconds.\n",
- E->trace.lost_souls_time);
- }
-
- if(E->control.verbose){
- fprintf(E->trace.fpt,"Number of times for all element search %d\n",E->trace.istat1);
-
- fprintf(E->trace.fpt,"Number of tracers sent to other processors: %d\n",E->trace.istat_isend);
-
- fprintf(E->trace.fpt,"Number of times element columns are checked: %d \n",E->trace.istat_elements_checked);
-
- /* compositional and error fraction data files */
- //TODO: move
- if (E->composition.on) {
- fprintf(E->trace.fpt,"Empty elements filled with old compositional "
- "values: %d (%f percent)\n", E->trace.istat_iempty,
- (100.0*E->trace.istat_iempty)/E->lmesh.nel);
- E->trace.istat_iempty=0;
-
-
- get_bulk_composition(E);
-
- if (E->parallel.me==0) {
-
- fprintf(E->fp,"composition: %e",E->monitor.elapsed_time);
- for (i=0; i<E->composition.ncomp; i++)
- fprintf(E->fp," %e", E->composition.bulk_composition[i]);
- fprintf(E->fp,"\n");
-
- fprintf(E->fp,"composition_error_fraction: %e",E->monitor.elapsed_time);
- for (i=0; i<E->composition.ncomp; i++)
- fprintf(E->fp," %e", E->composition.error_fraction[i]);
- fprintf(E->fp,"\n");
-
- }
- }
- fflush(E->trace.fpt);
- }
-
- return;
-}
-
-
-/*********** PREDICT TRACERS **********************************************/
-/* */
-/* This function predicts tracers performing an euler step */
-/* */
-/* */
-/* Note positions used in tracer array */
-/* [positions 0-5 are always fixed with current coordinates */
-/* Positions 6-8 contain original Cartesian coordinates. */
-/* Positions 9-11 contain original Cartesian velocities. */
-/* */
-
-
-static void predict_tracers(struct All_variables *E)
-{
-
- int numtracers;
- int j;
- int kk;
- int nelem;
-
- double dt;
- double theta0,phi0,rad0;
- double x0,y0,z0;
- double theta_pred,phi_pred,rad_pred;
- double x_pred,y_pred,z_pred;
- double velocity_vector[4];
-
- void cart_to_sphere();
-
-
- dt=E->advection.timestep;
-
-
- for (j=1;j<=E->sphere.caps_per_proc;j++) {
-
- numtracers=E->trace.ntracers[j];
-
- for (kk=1;kk<=numtracers;kk++) {
-
- theta0=E->trace.basicq[j][0][kk];
- phi0=E->trace.basicq[j][1][kk];
- rad0=E->trace.basicq[j][2][kk];
- x0=E->trace.basicq[j][3][kk];
- y0=E->trace.basicq[j][4][kk];
- z0=E->trace.basicq[j][5][kk];
-
- nelem=E->trace.ielement[j][kk];
- (E->trace.get_velocity)(E,j,nelem,theta0,phi0,rad0,velocity_vector);
-
- x_pred=x0+velocity_vector[1]*dt;
- y_pred=y0+velocity_vector[2]*dt;
- z_pred=z0+velocity_vector[3]*dt;
-
-
- /* keep in box */
-
- cart_to_sphere(E,x_pred,y_pred,z_pred,&theta_pred,&phi_pred,&rad_pred);
- (E->trace.keep_within_bounds)(E,&x_pred,&y_pred,&z_pred,&theta_pred,&phi_pred,&rad_pred);
-
- /* Current Coordinates are always kept in positions 0-5. */
-
- E->trace.basicq[j][0][kk]=theta_pred;
- E->trace.basicq[j][1][kk]=phi_pred;
- E->trace.basicq[j][2][kk]=rad_pred;
- E->trace.basicq[j][3][kk]=x_pred;
- E->trace.basicq[j][4][kk]=y_pred;
- E->trace.basicq[j][5][kk]=z_pred;
-
- /* Fill in original coords (positions 6-8) */
-
- E->trace.basicq[j][6][kk]=x0;
- E->trace.basicq[j][7][kk]=y0;
- E->trace.basicq[j][8][kk]=z0;
-
- /* Fill in original velocities (positions 9-11) */
-
- E->trace.basicq[j][9][kk]=velocity_vector[1]; /* Vx */
- E->trace.basicq[j][10][kk]=velocity_vector[2]; /* Vy */
- E->trace.basicq[j][11][kk]=velocity_vector[3]; /* Vz */
-
-
- } /* end kk, predicting tracers */
- } /* end caps */
-
- /* find new tracer elements and caps */
-
- find_tracers(E);
-
- return;
-
-}
-
-
-/*********** CORRECT TRACERS **********************************************/
-/* */
-/* This function corrects tracers using both initial and */
-/* predicted velocities */
-/* */
-/* */
-/* Note positions used in tracer array */
-/* [positions 0-5 are always fixed with current coordinates */
-/* Positions 6-8 contain original Cartesian coordinates. */
-/* Positions 9-11 contain original Cartesian velocities. */
-/* */
-
-
-static void correct_tracers(struct All_variables *E)
-{
-
- int j;
- int kk;
- int nelem;
-
-
- double dt;
- double x0,y0,z0;
- double theta_pred,phi_pred,rad_pred;
- double x_pred,y_pred,z_pred;
- double theta_cor,phi_cor,rad_cor;
- double x_cor,y_cor,z_cor;
- double velocity_vector[4];
- double Vx0,Vy0,Vz0;
- double Vx_pred,Vy_pred,Vz_pred;
-
- void cart_to_sphere();
-
-
- dt=E->advection.timestep;
-
-
- for (j=1;j<=E->sphere.caps_per_proc;j++) {
- for (kk=1;kk<=E->trace.ntracers[j];kk++) {
-
- theta_pred=E->trace.basicq[j][0][kk];
- phi_pred=E->trace.basicq[j][1][kk];
- rad_pred=E->trace.basicq[j][2][kk];
- x_pred=E->trace.basicq[j][3][kk];
- y_pred=E->trace.basicq[j][4][kk];
- z_pred=E->trace.basicq[j][5][kk];
-
- x0=E->trace.basicq[j][6][kk];
- y0=E->trace.basicq[j][7][kk];
- z0=E->trace.basicq[j][8][kk];
-
- Vx0=E->trace.basicq[j][9][kk];
- Vy0=E->trace.basicq[j][10][kk];
- Vz0=E->trace.basicq[j][11][kk];
-
- nelem=E->trace.ielement[j][kk];
-
- (E->trace.get_velocity)(E,j,nelem,theta_pred,phi_pred,rad_pred,velocity_vector);
-
- Vx_pred=velocity_vector[1];
- Vy_pred=velocity_vector[2];
- Vz_pred=velocity_vector[3];
-
- x_cor=x0 + dt * 0.5*(Vx0+Vx_pred);
- y_cor=y0 + dt * 0.5*(Vy0+Vy_pred);
- z_cor=z0 + dt * 0.5*(Vz0+Vz_pred);
-
- cart_to_sphere(E,x_cor,y_cor,z_cor,&theta_cor,&phi_cor,&rad_cor);
- (E->trace.keep_within_bounds)(E,&x_cor,&y_cor,&z_cor,&theta_cor,&phi_cor,&rad_cor);
-
- /* Fill in Current Positions (other positions are no longer important) */
-
- E->trace.basicq[j][0][kk]=theta_cor;
- E->trace.basicq[j][1][kk]=phi_cor;
- E->trace.basicq[j][2][kk]=rad_cor;
- E->trace.basicq[j][3][kk]=x_cor;
- E->trace.basicq[j][4][kk]=y_cor;
- E->trace.basicq[j][5][kk]=z_cor;
-
- } /* end kk, correcting tracers */
- } /* end caps */
-
- /* find new tracer elements and caps */
-
- find_tracers(E);
-
- return;
-}
-
-
-/************ FIND TRACERS *************************************/
-/* */
-/* This function finds tracer elements and moves tracers to */
-/* other processor domains if necessary. */
-/* Array ielement is filled with elemental values. */
-
-static void find_tracers(struct All_variables *E)
-{
-
- int iel;
- int kk;
- int j;
- int it;
- int iprevious_element;
- int num_tracers;
-
- double theta,phi,rad;
- double x,y,z;
- double time_stat1;
- double time_stat2;
-
- void put_away_later();
- void eject_tracer();
- void reduce_tracer_arrays();
- void sphere_to_cart();
- void full_lost_souls();
- void regional_lost_souls();
-
- double CPU_time0();
- double begin_time = CPU_time0();
-
-
- for (j=1;j<=E->sphere.caps_per_proc;j++) {
-
-
- /* initialize arrays and statistical counters */
-
- E->trace.ilater[j]=E->trace.ilatersize[j]=0;
-
- E->trace.istat1=0;
- for (kk=0;kk<=4;kk++) {
- E->trace.istat_ichoice[j][kk]=0;
- }
-
- //TODO: use while-loop instead of for-loop
- /* important to index by it, not kk */
-
- it=0;
- num_tracers=E->trace.ntracers[j];
-
- for (kk=1;kk<=num_tracers;kk++) {
-
- it++;
-
- theta=E->trace.basicq[j][0][it];
- phi=E->trace.basicq[j][1][it];
- rad=E->trace.basicq[j][2][it];
- x=E->trace.basicq[j][3][it];
- y=E->trace.basicq[j][4][it];
- z=E->trace.basicq[j][5][it];
-
- iprevious_element=E->trace.ielement[j][it];
-
- iel=(E->trace.iget_element)(E,j,iprevious_element,x,y,z,theta,phi,rad);
- /* debug *
- fprintf(E->trace.fpt,"BB. kk %d %d %d %d %f %f %f %f %f %f\n",kk,j,iprevious_element,iel,x,y,z,theta,phi,rad);
- fflush(E->trace.fpt);
- /**/
-
- E->trace.ielement[j][it]=iel;
-
- if (iel<0) {
- put_away_later(E,j,it);
- eject_tracer(E,j,it);
- it--;
- }
-
- } /* end tracers */
-
- } /* end j */
-
-
- /* Now take care of tracers that exited cap */
-
- /* REMOVE */
- /*
- parallel_process_termination();
- */
-
- if (E->parallel.nprocxy == 12)
- full_lost_souls(E);
- else
- regional_lost_souls(E);
-
- /* Free later arrays */
-
- for (j=1;j<=E->sphere.caps_per_proc;j++) {
- if (E->trace.ilatersize[j]>0) {
- for (kk=0;kk<=((E->trace.number_of_tracer_quantities)-1);kk++) {
- free(E->trace.rlater[j][kk]);
- }
- }
- } /* end j */
-
-
- /* Adjust Array Sizes */
-
- reduce_tracer_arrays(E);
-
- E->trace.find_tracers_time += CPU_time0() - begin_time;
-
- return;
-}
-
-
-/***********************************************************************/
-/* This function computes the number of tracers in each element. */
-/* Each tracer can be of different "flavors", which is the 0th index */
-/* of extraq. How to interprete "flavor" is left for the application. */
-
-void count_tracers_of_flavors(struct All_variables *E)
-{
-
- int j, flavor, e, kk;
- int numtracers;
-
- for (j=1; j<=E->sphere.caps_per_proc; j++) {
-
- /* first zero arrays */
- for (flavor=0; flavor<E->trace.nflavors; flavor++)
- for (e=1; e<=E->lmesh.nel; e++)
- E->trace.ntracer_flavor[j][flavor][e] = 0;
-
- numtracers=E->trace.ntracers[j];
-
- /* Fill arrays */
- for (kk=1; kk<=numtracers; kk++) {
- e = E->trace.ielement[j][kk];
- flavor = E->trace.extraq[j][0][kk];
- E->trace.ntracer_flavor[j][flavor][e]++;
- }
- }
-
- /* debug */
- /**
- for (j=1; j<=E->sphere.caps_per_proc; j++) {
- for (e=1; e<=E->lmesh.nel; e++) {
- fprintf(E->trace.fpt, "element=%d ntracer_flaver =", e);
- for (flavor=0; flavor<E->trace.nflavors; flavor++) {
- fprintf(E->trace.fpt, " %d",
- E->trace.ntracer_flavor[j][flavor][e]);
- }
- fprintf(E->trace.fpt, "\n");
- }
- }
- fflush(E->trace.fpt);
- /**/
-
- return;
-}
-
-
-
-static void get_new_tracers(struct All_variables *E)
-{
- if (E->trace.ic_method==0)
- make_tracer_array(E);
- else if (E->trace.ic_method==1)
- read_tracer_file(E);
- else if (E->trace.ic_method==2)
- read_old_tracer_file(E);
- else {
- fprintf(E->trace.fpt,"Not ready for other inputs yet\n");
- fflush(E->trace.fpt);
- parallel_process_termination();
- }
-
- /* total number of tracers */
-
- E->trace.ilast_tracer_count = isum_tracers(E);
- fprintf(E->trace.fpt, "Sum of Tracers: %d\n", E->trace.ilast_tracer_count);
- if(E->parallel.me==0)
- fprintf(stderr, "Sum of Tracers: %d\n", E->trace.ilast_tracer_count);
-
-
- /* find elements */
-
- find_tracers(E);
-
- return;
-}
-
-void initialize_tracers(struct All_variables *E)
-{
- get_new_tracers(E);
-
- /* count # of tracers of each flavor */
-
- if (E->trace.nflavors > 0)
- count_tracers_of_flavors(E);
-
- return;
-}
-
-
-void dump_and_get_new_tracers_to_interpolate_fields(struct All_variables *E)
-{
- int j;
-
- for (j=1;j<=E->sphere.caps_per_proc;j++)
- free_tracer_arrays(E, j);
-
- E->trace.number_of_extra_quantities = 2;
- E->trace.number_of_tracer_quantities =
- E->trace.number_of_basic_quantities +
- E->trace.number_of_extra_quantities;
-
- get_new_tracers(E);
- return;
-}
-
-
-/************** MAKE TRACER ARRAY ********************************/
-/* Here, each processor will generate tracers somewhere */
-/* in the sphere - check if its in this cap - then check radial */
-
-static void make_tracer_array(struct All_variables *E)
-{
-
- int tracers_cap;
- int j;
- double processor_fraction;
-
- void generate_random_tracers();
- void init_tracer_flavors();
-
- if (E->parallel.me==0) fprintf(stderr,"Making Tracer Array\n");
-
- for (j=1;j<=E->sphere.caps_per_proc;j++) {
-
- processor_fraction=E->lmesh.volume/E->mesh.volume;
- tracers_cap=E->mesh.nel*E->trace.itperel*processor_fraction;
- /*
- fprintf(stderr,"AA: proc frac: %f (%d) %d %d %f %f\n",processor_fraction,tracers_cap,E->lmesh.nel,E->parallel.nprocz, E->sx[j][3][E->lmesh.noz],E->sx[j][3][1]);
- */
-
- fprintf(E->trace.fpt,"\nGenerating %d Tracers\n",tracers_cap);
-
- generate_random_tracers(E, tracers_cap, j);
-
-
-
- }/* end j */
-
-
- /* Initialize tracer flavors */
- if (E->trace.nflavors) init_tracer_flavors(E);
-
- return;
-}
-
-
-
-static void generate_random_tracers(struct All_variables *E,
- int tracers_cap, int j)
-{
- void cart_to_sphere();
- int kk;
- int ival;
- int number_of_tries=0;
- int max_tries;
-
- double x,y,z;
- double theta,phi,rad;
- double xmin,xmax,ymin,ymax,zmin,zmax;
- double random1,random2,random3;
-
-
- allocate_tracer_arrays(E,j,tracers_cap);
-
- /* Finding the min/max of the cartesian coordinates. */
- /* One must loop over E->X to find the min/max, since the 8 corner */
- /* nodes may not be the min/max. */
- xmin = ymin = zmin = E->sphere.ro;
- xmax = ymax = zmax = -E->sphere.ro;
- for (kk=1; kk<=E->lmesh.nno; kk++) {
- x = E->x[j][1][kk];
- y = E->x[j][2][kk];
- z = E->x[j][3][kk];
-
- xmin = ((xmin < x) ? xmin : x);
- xmax = ((xmax > x) ? xmax : x);
- ymin = ((ymin < y) ? ymin : y);
- ymax = ((ymax > y) ? ymax : y);
- zmin = ((zmin < z) ? zmin : z);
- zmax = ((zmax > z) ? zmax : z);
- }
-
- /* Tracers are placed randomly in cap */
- /* (intentionally using rand() instead of srand() )*/
-
- while (E->trace.ntracers[j]<tracers_cap) {
-
- number_of_tries++;
- max_tries=100*tracers_cap;
-
- if (number_of_tries>max_tries) {
- fprintf(E->trace.fpt,"Error(make_tracer_array)-too many tries?\n");
- fprintf(E->trace.fpt,"%d %d %d\n",max_tries,number_of_tries,RAND_MAX);
- fflush(E->trace.fpt);
- exit(10);
- }
-
-#if 1
- random1=drand48();
- random2=drand48();
- random3=drand48();
-#else
- random1=(1.0*rand())/(1.0*RAND_MAX);
- random2=(1.0*rand())/(1.0*RAND_MAX);
- random3=(1.0*rand())/(1.0*RAND_MAX);
-#endif
-
- x=xmin+random1*(xmax-xmin);
- y=ymin+random2*(ymax-ymin);
- z=zmin+random3*(zmax-zmin);
-
- /* first check if within shell */
-
- cart_to_sphere(E,x,y,z,&theta,&phi,&rad);
-
- if (rad>=E->sx[j][3][E->lmesh.noz]) continue;
- if (rad<E->sx[j][3][1]) continue;
-
-
- /* check if in current cap */
- if (E->parallel.nprocxy==1)
- ival=regional_icheck_cap(E,0,theta,phi,rad,rad);
- else
- ival=full_icheck_cap(E,0,x,y,z,rad);
-
- if (ival!=1) continue;
-
- /* Made it, so record tracer information */
-
- (E->trace.keep_within_bounds)(E,&x,&y,&z,&theta,&phi,&rad);
-
- E->trace.ntracers[j]++;
- kk=E->trace.ntracers[j];
-
- E->trace.basicq[j][0][kk]=theta;
- E->trace.basicq[j][1][kk]=phi;
- E->trace.basicq[j][2][kk]=rad;
- E->trace.basicq[j][3][kk]=x;
- E->trace.basicq[j][4][kk]=y;
- E->trace.basicq[j][5][kk]=z;
-
- } /* end while */
-
- return;
-}
-
-
-/******** READ TRACER ARRAY *********************************************/
-/* */
-/* This function reads tracers from input file. */
-/* All processors read the same input file, then sort out which ones */
-/* belong. */
-
-static void read_tracer_file(struct All_variables *E)
-{
-
- char input_s[1000];
-
- int number_of_tracers, ncolumns;
- int kk;
- int icheck;
- int iestimate;
- int icushion;
- int i, j;
-
-
- int icheck_processor_shell();
- void sphere_to_cart();
- void cart_to_sphere();
- void expand_tracer_arrays();
-
- double x,y,z;
- double theta,phi,rad;
- double buffer[100];
-
- FILE *fptracer;
-
- fptracer=fopen(E->trace.tracer_file,"r");
-
- fgets(input_s,200,fptracer);
- sscanf(input_s,"%d %d",&number_of_tracers,&ncolumns);
- fprintf(E->trace.fpt,"%d Tracers, %d columns in file \n",
- number_of_tracers, ncolumns);
-
- /* some error control */
- if (E->trace.number_of_extra_quantities+3 != ncolumns) {
- fprintf(E->trace.fpt,"ERROR(read tracer file)-wrong # of columns\n");
- fflush(E->trace.fpt);
- exit(10);
- }
-
-
- /* initially size tracer arrays to number of tracers divided by processors */
-
- icushion=100;
-
- iestimate=number_of_tracers/E->parallel.nproc + icushion;
-
- for (j=1;j<=E->sphere.caps_per_proc;j++) {
-
- allocate_tracer_arrays(E,j,iestimate);
-
- for (kk=1;kk<=number_of_tracers;kk++) {
- int len, ncol;
- ncol = 3 + E->trace.number_of_extra_quantities;
-
- len = read_double_vector(fptracer, ncol, buffer);
- if (len != ncol) {
- fprintf(E->trace.fpt,"ERROR(read tracer file) - wrong input file format: %d-th tracer in %s\n", kk, E->trace.tracer_file);
- fflush(E->trace.fpt);
- exit(10);
- }
-
- theta = buffer[0];
- phi = buffer[1];
- rad = buffer[2];
-
- sphere_to_cart(E,theta,phi,rad,&x,&y,&z);
-
-
- /* make sure theta, phi is in range, and radius is within bounds */
-
- (E->trace.keep_within_bounds)(E,&x,&y,&z,&theta,&phi,&rad);
-
- /* check whether tracer is within processor domain */
-
- icheck=1;
- if (E->parallel.nprocz>1) icheck=icheck_processor_shell(E,j,rad);
- if (icheck!=1) continue;
-
- if (E->parallel.nprocxy==1)
- icheck=regional_icheck_cap(E,0,theta,phi,rad,rad);
- else
- icheck=full_icheck_cap(E,0,x,y,z,rad);
-
- if (icheck==0) continue;
-
- /* if still here, tracer is in processor domain */
-
-
- E->trace.ntracers[j]++;
-
- if (E->trace.ntracers[j]>=(E->trace.max_ntracers[j]-5)) expand_tracer_arrays(E,j);
-
- E->trace.basicq[j][0][E->trace.ntracers[j]]=theta;
- E->trace.basicq[j][1][E->trace.ntracers[j]]=phi;
- E->trace.basicq[j][2][E->trace.ntracers[j]]=rad;
- E->trace.basicq[j][3][E->trace.ntracers[j]]=x;
- E->trace.basicq[j][4][E->trace.ntracers[j]]=y;
- E->trace.basicq[j][5][E->trace.ntracers[j]]=z;
-
- for (i=0; i<E->trace.number_of_extra_quantities; i++)
- E->trace.extraq[j][i][E->trace.ntracers[j]]=buffer[i+3];
-
- } /* end kk, number of tracers */
-
- fprintf(E->trace.fpt,"Number of tracers in this cap is: %d\n",
- E->trace.ntracers[j]);
-
- /** debug **
- for (kk=1; kk<=E->trace.ntracers[j]; kk++) {
- fprintf(E->trace.fpt, "tracer#=%d sph_coord=(%g,%g,%g)", kk,
- E->trace.basicq[j][0][kk],
- E->trace.basicq[j][1][kk],
- E->trace.basicq[j][2][kk]);
- fprintf(E->trace.fpt, " extraq=");
- for (i=0; i<E->trace.number_of_extra_quantities; i++)
- fprintf(E->trace.fpt, " %g", E->trace.extraq[j][i][kk]);
- fprintf(E->trace.fpt, "\n");
- }
- fflush(E->trace.fpt);
- /**/
-
- } /* end j */
-
- fclose(fptracer);
-
- icheck=isum_tracers(E);
-
- if (icheck!=number_of_tracers) {
- fprintf(E->trace.fpt,"ERROR(read_tracer_file) - tracers != number in file\n");
- fprintf(E->trace.fpt,"Tracers in system: %d\n", icheck);
- fprintf(E->trace.fpt,"Tracers in file: %d\n", number_of_tracers);
- fflush(E->trace.fpt);
- exit(10);
- }
-
- return;
-}
-
-
-/************** READ OLD TRACER FILE *************************************/
-/* */
-/* This function read tracers written from previous calculation */
-/* and the tracers are read as seperate files for each processor domain. */
-
-static void read_old_tracer_file(struct All_variables *E)
-{
-
- char output_file[200];
- char input_s[1000];
-
- int i,j,kk,rezip;
- int idum1,ncolumns;
- int numtracers;
-
- double rdum1;
- double theta,phi,rad;
- double x,y,z;
- double buffer[100];
-
- void sphere_to_cart();
-
- FILE *fp1;
-
- if (E->trace.number_of_extra_quantities>99) {
- fprintf(E->trace.fpt,"ERROR(read_old_tracer_file)-increase size of extra[]\n");
- fflush(E->trace.fpt);
- parallel_process_termination();
- }
-
-
-
- /* deal with different output formats */
-#ifdef USE_GZDIR
- if(strcmp(E->output.format, "ascii-gz") == 0){
- sprintf(output_file,"%s/%d/tracer.%d.%d",
- E->control.data_dir_old,E->monitor.solution_cycles_init,E->parallel.me,E->monitor.solution_cycles_init);
- rezip = open_file_zipped(output_file,&fp1,E);
- }else{
- sprintf(output_file,"%s.tracer.%d.%d",E->control.old_P_file,E->parallel.me,E->monitor.solution_cycles_init);
- if ( (fp1=fopen(output_file,"r"))==NULL) {
- fprintf(E->trace.fpt,"ERROR(read_old_tracer_file)-gziped file not found %s\n",output_file);
- fflush(E->trace.fpt);
- exit(10);
- }
- }
-#else
- sprintf(output_file,"%s.tracer.%d.%d",E->control.old_P_file,E->parallel.me,E->monitor.solution_cycles_init);
- if ( (fp1=fopen(output_file,"r"))==NULL) {
- fprintf(E->trace.fpt,"ERROR(read_old_tracer_file)-file not found %s\n",output_file);
- fflush(E->trace.fpt);
- exit(10);
- }
-#endif
-
- fprintf(stderr,"Read old tracers from %s\n",output_file);
-
-
- for(j=1;j<=E->sphere.caps_per_proc;j++) {
- fgets(input_s,200,fp1);
- sscanf(input_s,"%d %d %d %lf",
- &idum1, &numtracers, &ncolumns, &rdum1);
-
- /* some error control */
- if (E->trace.number_of_extra_quantities+3 != ncolumns) {
- fprintf(E->trace.fpt,"ERROR(read_old_tracer_file)-wrong # of columns\n");
- fflush(E->trace.fpt);
- exit(10);
- }
-
- /* allocate memory for tracer arrays */
-
- allocate_tracer_arrays(E,j,numtracers);
- E->trace.ntracers[j]=numtracers;
-
- for (kk=1;kk<=numtracers;kk++) {
- int len, ncol;
- ncol = 3 + E->trace.number_of_extra_quantities;
-
- len = read_double_vector(fp1, ncol, buffer);
- if (len != ncol) {
- fprintf(E->trace.fpt,"ERROR(read_old_tracer_file) - wrong input file format: %s\n", output_file);
- fflush(E->trace.fpt);
- exit(10);
- }
-
- theta = buffer[0];
- phi = buffer[1];
- rad = buffer[2];
-
- sphere_to_cart(E,theta,phi,rad,&x,&y,&z);
-
- /* it is possible that if on phi=0 boundary, significant digits can push phi over 2pi */
-
- (E->trace.keep_within_bounds)(E,&x,&y,&z,&theta,&phi,&rad);
-
- E->trace.basicq[j][0][kk]=theta;
- E->trace.basicq[j][1][kk]=phi;
- E->trace.basicq[j][2][kk]=rad;
- E->trace.basicq[j][3][kk]=x;
- E->trace.basicq[j][4][kk]=y;
- E->trace.basicq[j][5][kk]=z;
-
- for (i=0; i<E->trace.number_of_extra_quantities; i++)
- E->trace.extraq[j][i][kk]=buffer[i+3];
-
- }
-
- /** debug **
- for (kk=1; kk<=E->trace.ntracers[j]; kk++) {
- fprintf(E->trace.fpt, "tracer#=%d sph_coord=(%g,%g,%g)", kk,
- E->trace.basicq[j][0][kk],
- E->trace.basicq[j][1][kk],
- E->trace.basicq[j][2][kk]);
- fprintf(E->trace.fpt, " extraq=");
- for (i=0; i<E->trace.number_of_extra_quantities; i++)
- fprintf(E->trace.fpt, " %g", E->trace.extraq[j][i][kk]);
- fprintf(E->trace.fpt, "\n");
- }
- fflush(E->trace.fpt);
- /**/
-
- fprintf(E->trace.fpt,"Read %d tracers from file %s\n",numtracers,output_file);
- fflush(E->trace.fpt);
-
- }
- fclose(fp1);
-#ifdef USE_GZDIR
- if(strcmp(E->output.format, "ascii-gz") == 0)
- if(rezip) /* rezip */
- gzip_file(output_file);
-#endif
-
- return;
-}
-
-
-
-
-
-/*********** CHECK SUM **************************************************/
-/* */
-/* This functions checks to make sure number of tracers is preserved */
-
-static void check_sum(struct All_variables *E)
-{
-
- int number, iold_number;
-
- number = isum_tracers(E);
-
- iold_number = E->trace.ilast_tracer_count;
-
- if (number != iold_number) {
- fprintf(E->trace.fpt,"ERROR(check_sum)-break in conservation %d %d\n",
- number,iold_number);
- fflush(E->trace.fpt);
- if (E->trace.itracer_warnings)
- parallel_process_termination();
- }
-
- E->trace.ilast_tracer_count = number;
-
- return;
-}
-
-
-/************* ISUM TRACERS **********************************************/
-/* */
-/* This function uses MPI to sum all tracers and returns number of them. */
-
-static int isum_tracers(struct All_variables *E)
-{
- int imycount;
- int iallcount;
- int j;
-
- iallcount = 0;
-
- imycount = 0;
- for (j=1; j<=E->sphere.caps_per_proc; j++)
- imycount = imycount + E->trace.ntracers[j];
-
- MPI_Allreduce(&imycount,&iallcount,1,MPI_INT,MPI_SUM,E->parallel.world);
-
- return iallcount;
-}
-
-
-
-/********** CART TO SPHERE ***********************/
-void cart_to_sphere(struct All_variables *E,
- double x, double y, double z,
- double *theta, double *phi, double *rad)
-{
-
- double temp;
- double myatan();
-
- temp=x*x+y*y;
-
- *rad=sqrt(temp+z*z);
- *theta=atan2(sqrt(temp),z);
- *phi=myatan(y,x);
-
-
- return;
-}
-
-/********** SPHERE TO CART ***********************/
-void sphere_to_cart(struct All_variables *E,
- double theta, double phi, double rad,
- double *x, double *y, double *z)
-{
-
- double sint,cost,sinf,cosf;
- double temp;
-
- sint=sin(theta);
- cost=cos(theta);
- sinf=sin(phi);
- cosf=cos(phi);
-
- temp=rad*sint;
-
- *x=temp*cosf;
- *y=temp*sinf;
- *z=rad*cost;
-
- return;
-}
-
-
-
-static void init_tracer_flavors(struct All_variables *E)
-{
- int j, kk, number_of_tracers;
- int i;
- double flavor;
- double rad;
-
- switch(E->trace.ic_method_for_flavors){
- case 0:
- /* ic_method_for_flavors == 0 (layered structure) */
- /* any tracer above z_interface[i] is of flavor i */
- /* any tracer below z_interface is of flavor (nflavors-1) */
- for (j=1;j<=E->sphere.caps_per_proc;j++) {
-
- number_of_tracers = E->trace.ntracers[j];
- for (kk=1;kk<=number_of_tracers;kk++) {
- rad = E->trace.basicq[j][2][kk];
-
- flavor = E->trace.nflavors - 1;
- for (i=0; i<E->trace.nflavors-1; i++) {
- if (rad > E->trace.z_interface[i]) {
- flavor = i;
- break;
- }
- }
- E->trace.extraq[j][0][kk] = flavor;
- }
- }
- break;
-
- case 1: /* from grd in top n layers */
-#ifndef USE_GGRD
- fprintf(stderr,"ic_method_for_flavors %i requires the ggrd routines from hc, -DUSE_GGRD\n",
- E->trace.ic_method_for_flavors);
- parallel_process_termination();
-#else
- ggrd_init_tracer_flavors(E);
-#endif
- break;
-
-
- default:
-
- fprintf(stderr,"ic_method_for_flavors %i undefined\n",E->trace.ic_method_for_flavors);
- parallel_process_termination();
- break;
- }
-
- return;
-}
-
-
-/******************* get_neighboring_caps ************************************/
-/* */
-/* Communicate with neighboring processors to get their cap boundaries, */
-/* which is later used by (E->trace.icheck_cap)() */
-/* */
-
-void get_neighboring_caps(struct All_variables *E)
-{
- void sphere_to_cart();
-
- const int ncorners = 4; /* # of top corner nodes */
- int i, j, n, d, kk, lev, idb;
- int num_ngb, neighbor_proc, tag;
- MPI_Status status[200];
- MPI_Request request[200];
-
- int node[ncorners];
- double xx[ncorners*2], rr[12][ncorners*2];
- int nox,noy,noz;
- double x,y,z;
- double theta,phi,rad;
-
- nox=E->lmesh.nox;
- noy=E->lmesh.noy;
- noz=E->lmesh.noz;
-
- node[0]=nox*noz*(noy-1)+noz;
- node[1]=noz;
- node[2]=noz*nox;
- node[3]=noz*nox*noy;
-
- lev = E->mesh.levmax;
- tag = 45;
-
- for (j=1; j<=E->sphere.caps_per_proc; j++) {
-
- /* loop over top corners to get their coordinates */
- n = 0;
- for (i=0; i<ncorners; i++) {
- for (d=0; d<2; d++) {
- xx[n] = E->sx[j][d+1][node[i]];
- n++;
- }
- }
-
- idb = 0;
- num_ngb = E->parallel.TNUM_PASS[lev][j];
- for (kk=1; kk<=num_ngb; kk++) {
- neighbor_proc = E->parallel.PROCESSOR[lev][j].pass[kk];
-
- MPI_Isend(xx, n, MPI_DOUBLE, neighbor_proc,
- tag, E->parallel.world, &request[idb]);
- idb++;
-
- MPI_Irecv(rr[kk], n, MPI_DOUBLE, neighbor_proc,
- tag, E->parallel.world, &request[idb]);
- idb++;
- }
-
- /* Storing the current cap information */
- for (i=0; i<n; i++)
- rr[0][i] = xx[i];
-
- /* Wait for non-blocking calls to complete */
-
- MPI_Waitall(idb, request, status);
-
- /* Storing the received cap information
- * XXX: this part assumes:
- * 1) E->sphere.caps_per_proc==1
- * 2) E->mesh.nsd==3
- */
- for (kk=0; kk<=num_ngb; kk++) {
- n = 0;
- for (i=1; i<=ncorners; i++) {
- theta = rr[kk][n++];
- phi = rr[kk][n++];
- rad = E->sphere.ro;
-
- sphere_to_cart(E, theta, phi, rad, &x, &y, &z);
-
- E->trace.xcap[kk][i] = x;
- E->trace.ycap[kk][i] = y;
- E->trace.zcap[kk][i] = z;
- E->trace.theta_cap[kk][i] = theta;
- E->trace.phi_cap[kk][i] = phi;
- E->trace.rad_cap[kk][i] = rad;
- E->trace.cos_theta[kk][i] = cos(theta);
- E->trace.sin_theta[kk][i] = sin(theta);
- E->trace.cos_phi[kk][i] = cos(phi);
- E->trace.sin_phi[kk][i] = sin(phi);
- }
- } /* end kk, number of neighbors */
-
- /* debugging output *
- for (kk=0; kk<=num_ngb; kk++) {
- if (kk==0)
- neighbor_proc = E->parallel.me;
- else
- neighbor_proc = E->parallel.PROCESSOR[lev][1].pass[kk];
-
- for (i=1; i<=ncorners; i++) {
- fprintf(E->trace.fpt, "pass=%d rank=%d corner=%d "
- "sx=(%g, %g, %g)\n",
- kk, neighbor_proc, i,
- E->trace.theta_cap[kk][i],
- E->trace.phi_cap[kk][i],
- E->trace.rad_cap[kk][i]);
- }
- }
- fflush(E->trace.fpt);
- /**/
- }
-
- return;
-}
-
-
-/**************** INITIALIZE TRACER ARRAYS ************************************/
-/* */
-/* This function allocates memories to tracer arrays. */
-
-void allocate_tracer_arrays(struct All_variables *E,
- int j, int number_of_tracers)
-{
-
- int kk;
-
- /* max_ntracers is physical size of tracer array */
- /* (initially make it 25% larger than required */
-
- E->trace.max_ntracers[j]=number_of_tracers+number_of_tracers/4;
- E->trace.ntracers[j]=0;
-
- /* make tracer arrays */
-
- if ((E->trace.ielement[j]=(int *) malloc(E->trace.max_ntracers[j]*sizeof(int)))==NULL) {
- fprintf(E->trace.fpt,"ERROR(make tracer array)-no memory 1a\n");
- fflush(E->trace.fpt);
- exit(10);
- }
- for (kk=1;kk<E->trace.max_ntracers[j];kk++)
- E->trace.ielement[j][kk]=-99;
-
-
- for (kk=0;kk<E->trace.number_of_basic_quantities;kk++) {
- if ((E->trace.basicq[j][kk]=(double *)malloc(E->trace.max_ntracers[j]*sizeof(double)))==NULL) {
- fprintf(E->trace.fpt,"ERROR(initialize tracer arrays)-no memory 1b.%d\n",kk);
- fflush(E->trace.fpt);
- exit(10);
- }
- }
-
- for (kk=0;kk<E->trace.number_of_extra_quantities;kk++) {
- if ((E->trace.extraq[j][kk]=(double *)malloc(E->trace.max_ntracers[j]*sizeof(double)))==NULL) {
- fprintf(E->trace.fpt,"ERROR(initialize tracer arrays)-no memory 1c.%d\n",kk);
- fflush(E->trace.fpt);
- exit(10);
- }
- }
-
- if (E->trace.nflavors > 0) {
- E->trace.ntracer_flavor[j]=(int **)malloc(E->trace.nflavors*sizeof(int*));
- for (kk=0;kk<E->trace.nflavors;kk++) {
- if ((E->trace.ntracer_flavor[j][kk]=(int *)malloc((E->lmesh.nel+1)*sizeof(int)))==NULL) {
- fprintf(E->trace.fpt,"ERROR(initialize tracer arrays)-no memory 1c.%d\n",kk);
- fflush(E->trace.fpt);
- exit(10);
- }
- }
- }
-
-
- fprintf(E->trace.fpt,"Physical size of tracer arrays (max_ntracers): %d\n",
- E->trace.max_ntracers[j]);
- fflush(E->trace.fpt);
-
- return;
-}
-
-
-/****** FREE TRACER ARRAYS *****************************************/
-static void free_tracer_arrays(struct All_variables *E, int j)
-{
- int kk;
-
- if (E->trace.nflavors > 0) {
- for (kk=0;kk<E->trace.nflavors;kk++)
- free(E->trace.ntracer_flavor[j][kk]);
- free(E->trace.ntracer_flavor[j]);
- }
-
- for (kk=0;kk<E->trace.number_of_extra_quantities;kk++)
- free(E->trace.extraq[j][kk]);
-
- for (kk=0;kk<E->trace.number_of_basic_quantities;kk++)
- free(E->trace.basicq[j][kk]);
-
- free(E->trace.ielement[j]);
-
- E->trace.max_ntracers[j] = E->trace.ntracers[j] = 0;
-
- return;
-}
-
-
-/****** EXPAND TRACER ARRAYS *****************************************/
-
-void expand_tracer_arrays(struct All_variables *E, int j)
-{
-
- int inewsize;
- int kk;
- int icushion;
-
- /* expand basicq and ielement by 20% */
-
- icushion=100;
-
- inewsize=E->trace.max_ntracers[j]+E->trace.max_ntracers[j]/5+icushion;
-
- if ((E->trace.ielement[j]=(int *)realloc(E->trace.ielement[j],inewsize*sizeof(int)))==NULL) {
- fprintf(E->trace.fpt,"ERROR(expand tracer arrays )-no memory (ielement)\n");
- fflush(E->trace.fpt);
- exit(10);
- }
-
- for (kk=0;kk<=((E->trace.number_of_basic_quantities)-1);kk++) {
- if ((E->trace.basicq[j][kk]=(double *)realloc(E->trace.basicq[j][kk],inewsize*sizeof(double)))==NULL) {
- fprintf(E->trace.fpt,"ERROR(expand tracer arrays )-no memory (%d)\n",kk);
- fflush(E->trace.fpt);
- exit(10);
- }
- }
-
- for (kk=0;kk<=((E->trace.number_of_extra_quantities)-1);kk++) {
- if ((E->trace.extraq[j][kk]=(double *)realloc(E->trace.extraq[j][kk],inewsize*sizeof(double)))==NULL) {
- fprintf(E->trace.fpt,"ERROR(expand tracer arrays )-no memory 78 (%d)\n",kk);
- fflush(E->trace.fpt);
- exit(10);
- }
- }
-
-
- fprintf(E->trace.fpt,"Expanding physical memory of ielement, basicq, and extraq to %d from %d\n",
- inewsize,E->trace.max_ntracers[j]);
-
- E->trace.max_ntracers[j]=inewsize;
-
- return;
-}
-
-
-
-
-/****** REDUCE TRACER ARRAYS *****************************************/
-
-static void reduce_tracer_arrays(struct All_variables *E)
-{
-
- int inewsize;
- int kk;
- int iempty_space;
- int j;
-
- int icushion=100;
-
- for (j=1;j<=E->sphere.caps_per_proc;j++) {
-
-
- /* if physical size is double tracer size, reduce it */
-
- iempty_space=(E->trace.max_ntracers[j]-E->trace.ntracers[j]);
-
- if (iempty_space>(E->trace.ntracers[j]+icushion)) {
-
-
- inewsize=E->trace.ntracers[j]+E->trace.ntracers[j]/4+icushion;
-
- if (inewsize<1) {
- fprintf(E->trace.fpt,"Error(reduce tracer arrays)-something up (hdf3)\n");
- fflush(E->trace.fpt);
- exit(10);
- }
-
-
- if ((E->trace.ielement[j]=(int *)realloc(E->trace.ielement[j],inewsize*sizeof(int)))==NULL) {
- fprintf(E->trace.fpt,"ERROR(reduce tracer arrays )-no memory (ielement)\n");
- fflush(E->trace.fpt);
- exit(10);
- }
-
-
- for (kk=0;kk<=((E->trace.number_of_basic_quantities)-1);kk++) {
- if ((E->trace.basicq[j][kk]=(double *)realloc(E->trace.basicq[j][kk],inewsize*sizeof(double)))==NULL) {
- fprintf(E->trace.fpt,"AKM(reduce tracer arrays )-no memory (%d)\n",kk);
- fflush(E->trace.fpt);
- exit(10);
- }
- }
-
- for (kk=0;kk<=((E->trace.number_of_extra_quantities)-1);kk++) {
- if ((E->trace.extraq[j][kk]=(double *)realloc(E->trace.extraq[j][kk],inewsize*sizeof(double)))==NULL) {
- fprintf(E->trace.fpt,"AKM(reduce tracer arrays )-no memory 783 (%d)\n",kk);
- fflush(E->trace.fpt);
- exit(10);
- }
- }
-
-
- fprintf(E->trace.fpt,"Reducing physical memory of ielement, basicq, and extraq to %d from %d\n",
- E->trace.max_ntracers[j],inewsize);
-
- E->trace.max_ntracers[j]=inewsize;
-
- } /* end if */
-
- } /* end j */
-
- return;
-}
-
-
-/********** PUT AWAY LATER ************************************/
-/* */
-/* rlater has a similar structure to basicq */
-/* ilatersize is the physical memory and */
-/* ilater is the number of tracers */
-
-static void put_away_later(struct All_variables *E, int j, int it)
-{
- int kk;
- void expand_later_array();
-
-
- /* The first tracer in initiates memory allocation. */
- /* Memory is freed after parallel communications */
-
- if (E->trace.ilatersize[j]==0) {
-
- E->trace.ilatersize[j]=E->trace.max_ntracers[j]/5;
-
- for (kk=0;kk<=((E->trace.number_of_tracer_quantities)-1);kk++) {
- if ((E->trace.rlater[j][kk]=(double *)malloc(E->trace.ilatersize[j]*sizeof(double)))==NULL) {
- fprintf(E->trace.fpt,"AKM(put_away_later)-no memory (%d)\n",kk);
- fflush(E->trace.fpt);
- exit(10);
- }
- }
- } /* end first particle initiating memory allocation */
-
-
- /* Put tracer in later array */
-
- E->trace.ilater[j]++;
-
- if (E->trace.ilater[j] >= (E->trace.ilatersize[j]-5)) expand_later_array(E,j);
-
- /* stack basic and extra quantities together (basic first) */
-
- for (kk=0;kk<=((E->trace.number_of_basic_quantities)-1);kk++)
- E->trace.rlater[j][kk][E->trace.ilater[j]]=E->trace.basicq[j][kk][it];
-
- for (kk=0;kk<=((E->trace.number_of_extra_quantities)-1);kk++)
- E->trace.rlater[j][E->trace.number_of_basic_quantities+kk][E->trace.ilater[j]]=E->trace.extraq[j][kk][it];
-
-
- return;
-}
-
-
-/****** EXPAND LATER ARRAY *****************************************/
-
-void expand_later_array(struct All_variables *E, int j)
-{
-
- int inewsize;
- int kk;
- int icushion;
-
- /* expand rlater by 20% */
-
- icushion=100;
-
- inewsize=E->trace.ilatersize[j]+E->trace.ilatersize[j]/5+icushion;
-
- for (kk=0;kk<=((E->trace.number_of_tracer_quantities)-1);kk++) {
- if ((E->trace.rlater[j][kk]=(double *)realloc(E->trace.rlater[j][kk],inewsize*sizeof(double)))==NULL) {
- fprintf(E->trace.fpt,"AKM(expand later array )-no memory (%d)\n",kk);
- fflush(E->trace.fpt);
- exit(10);
- }
- }
-
-
- fprintf(E->trace.fpt,"Expanding physical memory of rlater to %d from %d\n",
- inewsize,E->trace.ilatersize[j]);
-
- E->trace.ilatersize[j]=inewsize;
-
- return;
-}
-
-
-/***** EJECT TRACER ************************************************/
-
-static void eject_tracer(struct All_variables *E, int j, int it)
-{
-
- int ilast_tracer;
- int kk;
-
-
- ilast_tracer=E->trace.ntracers[j];
-
- /* put last tracer in ejected tracer position */
-
- E->trace.ielement[j][it]=E->trace.ielement[j][ilast_tracer];
-
- for (kk=0;kk<=((E->trace.number_of_basic_quantities)-1);kk++)
- E->trace.basicq[j][kk][it]=E->trace.basicq[j][kk][ilast_tracer];
-
- for (kk=0;kk<=((E->trace.number_of_extra_quantities)-1);kk++)
- E->trace.extraq[j][kk][it]=E->trace.extraq[j][kk][ilast_tracer];
-
-
-
- E->trace.ntracers[j]--;
-
- return;
-}
-
-
-
-/********** ICHECK PROCESSOR SHELL *************/
-/* returns -99 if rad is below current shell */
-/* returns 0 if rad is above current shell */
-/* returns 1 if rad is within current shell */
-/* */
-/* Shell, here, refers to processor shell */
-/* */
-/* shell is defined as bottom boundary up to */
-/* and not including the top boundary unless */
-/* the shell in question is the top shell */
-
-int icheck_processor_shell(struct All_variables *E,
- int j, double rad)
-{
-
- const int noz = E->lmesh.noz;
- const int nprocz = E->parallel.nprocz;
- double top_r, bottom_r;
-
- if (nprocz==1) return 1;
-
- top_r = E->sx[j][3][noz];
- bottom_r = E->sx[j][3][1];
-
- /* First check bottom */
-
- if (rad<bottom_r) return -99;
-
-
- /* Check top */
-
- if (rad<top_r) return 1;
-
- /* top processor */
-
- if ( (rad<=top_r) && (E->parallel.me_loc[3]==nprocz-1) ) return 1;
-
- /* If here, means point is above processor */
- return 0;
-}
-
-
-/********* ICHECK THAT PROCESSOR SHELL ********/
-/* */
-/* Checks whether a given radius is within */
-/* a given processors radial domain. */
-/* Returns 0 if not, 1 if so. */
-/* The domain is defined as including the bottom */
-/* radius, but excluding the top radius unless */
-/* we the processor domain is the one that */
-/* is at the surface (then both boundaries are */
-/* included). */
-
-int icheck_that_processor_shell(struct All_variables *E,
- int j, int nprocessor, double rad)
-{
- int icheck_processor_shell();
- int me = E->parallel.me;
-
- /* nprocessor is right on top of me */
- if (nprocessor == me+1) {
- if (icheck_processor_shell(E, j, rad) == 0) return 1;
- else return 0;
- }
-
- /* nprocessor is right on bottom of me */
- if (nprocessor == me-1) {
- if (icheck_processor_shell(E, j, rad) == -99) return 1;
- else return 0;
- }
-
- /* Shouldn't be here */
- fprintf(E->trace.fpt, "Should not be here\n");
- fprintf(E->trace.fpt, "Error(check_shell) nprocessor: %d, radius: %f\n",
- nprocessor, rad);
- fflush(E->trace.fpt);
- exit(10);
-
- return 0;
-}
-
-
Copied: mc/3D/CitcomS/branches/cxx/lib/Tracer_setup.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Tracer_setup.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Tracer_setup.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Tracer_setup.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,1788 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+/*
+
+ Tracer_setup.c
+
+ A program which initiates the distribution of tracers
+ and advects those tracers in a time evolving velocity field.
+ Called and used from the CitCOM finite element code.
+ Written 2/96 M. Gurnis for Citcom in cartesian geometry
+ Modified by Lijie in 1998 and by Vlad and Eh in 2005 for the
+ regional version of CitcomS. In 2003, Allen McNamara wrote the
+ tracer module for the global version of CitcomS. In 2007, Eh Tan
+ merged the two versions of tracer codes together.
+*/
+
+#include <math.h>
+#include <string.h>
+#include "global_defs.h"
+#include "parsing.h"
+#include "parallel_related.h"
+#include "composition_related.h"
+
+#ifdef USE_GGRD
+#include "ggrd_handling.h"
+#endif
+
+#include "cproto.h"
+
+
+#ifdef USE_GZDIR
+int open_file_zipped(char *, FILE **,struct All_variables *);
+void gzip_file(char *);
+#endif
+
+int icheck_that_processor_shell(struct All_variables *E,
+ int j, int nprocessor, double rad);
+void expand_later_array(struct All_variables *E, int j);
+void expand_tracer_arrays(struct All_variables *E, int j);
+void tracer_post_processing(struct All_variables *E);
+void allocate_tracer_arrays(struct All_variables *E,
+ int j, int number_of_tracers);
+void count_tracers_of_flavors(struct All_variables *E);
+
+int full_icheck_cap(struct All_variables *E, int icap,
+ double x, double y, double z, double rad);
+int regional_icheck_cap(struct All_variables *E, int icap,
+ double x, double y, double z, double rad);
+
+static void find_tracers(struct All_variables *E);
+static void predict_tracers(struct All_variables *E);
+static void correct_tracers(struct All_variables *E);
+static void make_tracer_array(struct All_variables *E);
+static void generate_random_tracers(struct All_variables *E,
+ int tracers_cap, int j);
+static void read_tracer_file(struct All_variables *E);
+static void read_old_tracer_file(struct All_variables *E);
+static void check_sum(struct All_variables *E);
+static int isum_tracers(struct All_variables *E);
+static void init_tracer_flavors(struct All_variables *E);
+static void free_tracer_arrays(struct All_variables *E, int j);
+static void reduce_tracer_arrays(struct All_variables *E);
+static void put_away_later(struct All_variables *E, int j, int it);
+static void eject_tracer(struct All_variables *E, int j, int it);
+int read_double_vector(FILE *, int , double *);
+void cart_to_sphere(struct All_variables *,
+ double , double , double ,
+ double *, double *, double *);
+void sphere_to_cart(struct All_variables *,
+ double , double , double ,
+ double *, double *, double *);
+int icheck_processor_shell(struct All_variables *,
+ int , double );
+
+
+
+void tracer_input(struct All_variables *E)
+{
+ char message[100];
+ int m=E->parallel.me;
+ int i;
+
+ input_boolean("tracer",&(E->control.tracer),"off",m);
+ input_boolean("tracer_enriched",
+ &(E->control.tracer_enriched),"off",m);
+ if(E->control.tracer_enriched){
+ if(!E->control.tracer) /* check here so that we can get away
+ with only one if statement in
+ Advection_diffusion */
+ myerror(E,"need to switch on tracers for tracer_enriched");
+
+ input_float("Q0_enriched",&(E->control.Q0ER),"0.0",m);
+ snprintf(message,100,"using compositionally enriched heating: C = 0: %g C = 1: %g (only one composition!)",
+ E->control.Q0,E->control.Q0ER);
+ report(E,message);
+ //
+ // this check doesn't work at this point in the code, and we didn't want to put it into every call to
+ // Advection diffusion
+ //
+ //if(E->composition.ncomp != 1)
+ //myerror(E,"enriched tracers cannot deal with more than one composition yet");
+
+ }
+ if(E->control.tracer) {
+
+ /* tracer_ic_method=0 (random generated array) */
+ /* tracer_ic_method=1 (all proc read the same file) */
+ /* tracer_ic_method=2 (each proc reads its restart file) */
+ input_int("tracer_ic_method",&(E->trace.ic_method),"0,0,nomax",m);
+
+ if (E->trace.ic_method==0){
+ input_int("tracers_per_element",&(E->trace.itperel),"10,0,nomax",m);
+ }
+ else if (E->trace.ic_method==1)
+ input_string("tracer_file",E->trace.tracer_file,"tracer.dat",m);
+ else if (E->trace.ic_method==2) {
+ /* Use 'datadir_old', 'datafile_old', and 'solution_cycles_init' */
+ /* to form the filename */
+ }
+ else {
+ fprintf(stderr,"Sorry, tracer_ic_method only 0, 1 and 2 available\n");
+ parallel_process_termination();
+ }
+
+
+ /* How many flavors of tracers */
+ /* If tracer_flavors > 0, each element will report the number of
+ * tracers of each flavor inside it. This information can be used
+ * later for many purposes. One of it is to compute composition,
+ * either using absolute method or ratio method. */
+ input_int("tracer_flavors",&(E->trace.nflavors),"0,0,nomax",m);
+
+
+ input_int("ic_method_for_flavors",
+ &(E->trace.ic_method_for_flavors),"0,0,nomax",m);
+
+
+ if (E->trace.nflavors > 1) {
+ switch(E->trace.ic_method_for_flavors){
+ case 0: /* layer */
+ E->trace.z_interface = (double*) malloc((E->trace.nflavors-1)
+ *sizeof(double));
+ for(i=0; i<E->trace.nflavors-1; i++)
+ E->trace.z_interface[i] = 0.7;
+
+ input_double_vector("z_interface", E->trace.nflavors-1,
+ E->trace.z_interface, m);
+ break;
+ case 1: /* from grid in top n materials */
+ input_string("ictracer_grd_file",E->trace.ggrd_file,"",m); /* file from which to read */
+ input_int("ictracer_grd_layers",&(E->trace.ggrd_layers),"2",m); /* which top layers to use */
+ break;
+ default:
+ fprintf(stderr,"ic_method_for_flavors %i undefined\n",E->trace.ic_method_for_flavors);
+ parallel_process_termination();
+ break;
+ }
+ }
+
+ /* Warning level */
+ input_boolean("itracer_warnings",&(E->trace.itracer_warnings),"on",m);
+
+
+ /* Interpolate convection fields onto the location of tracers */
+ input_int("itracer_interpolate_fields",&(E->trace.itracer_interpolate_fields),"0",m);
+
+
+ if(E->parallel.nprocxy == 12)
+ full_tracer_input(E);
+
+
+ composition_input(E);
+
+ }
+
+ return;
+}
+
+
+void tracer_initial_settings(struct All_variables *E)
+{
+ E->trace.advection_time = 0;
+ E->trace.find_tracers_time = 0;
+ E->trace.lost_souls_time = 0;
+
+ if(E->parallel.nprocxy == 1) {
+ E->problem_tracer_setup = regional_tracer_setup;
+
+ E->trace.keep_within_bounds = regional_keep_within_bounds;
+ E->trace.get_velocity = regional_get_velocity;
+ E->trace.iget_element = regional_iget_element;
+ }
+ else {
+ E->problem_tracer_setup = full_tracer_setup;
+
+ E->trace.keep_within_bounds = full_keep_within_bounds;
+ E->trace.get_velocity = full_get_velocity;
+ E->trace.iget_element = full_iget_element;
+ }
+}
+
+
+
+/*****************************************************************************/
+/* This function is the primary tracing routine called from Citcom.c */
+/* In this code, unlike the original 3D cartesian code, force is filled */
+/* during Stokes solution. No need to call thermal_buoyancy() after tracing. */
+
+
+void tracer_advection(struct All_variables *E)
+{
+ double begin_time = CPU_time0();
+
+ /* advect tracers */
+ predict_tracers(E);
+ correct_tracers(E);
+
+ /* check that the number of tracers is conserved */
+ check_sum(E);
+
+ /* count # of tracers of each flavor */
+ if (E->trace.nflavors > 0)
+ count_tracers_of_flavors(E);
+
+ /* update the composition field */
+ if (E->composition.on) {
+ fill_composition(E);
+ }
+
+ E->trace.advection_time += CPU_time0() - begin_time;
+
+ tracer_post_processing(E);
+
+ return;
+}
+
+
+
+/********* TRACER POST PROCESSING ****************************************/
+
+void tracer_post_processing(struct All_variables *E)
+{
+ int i;
+
+ /* reset statistical counters */
+
+ E->trace.istat_isend=0;
+ E->trace.istat_elements_checked=0;
+ E->trace.istat1=0;
+
+ /* write timing information every 20 steps */
+ if ((E->monitor.solution_cycles % 20) == 0) {
+ fprintf(E->trace.fpt, "STEP %d\n", E->monitor.solution_cycles);
+
+ fprintf(E->trace.fpt, "Advecting tracers takes %f seconds.\n",
+ E->trace.advection_time - E->trace.find_tracers_time);
+ fprintf(E->trace.fpt, "Finding element takes %f seconds.\n",
+ E->trace.find_tracers_time - E->trace.lost_souls_time);
+ fprintf(E->trace.fpt, "Exchanging lost tracers takes %f seconds.\n",
+ E->trace.lost_souls_time);
+ }
+
+ if(E->control.verbose){
+ fprintf(E->trace.fpt,"Number of times for all element search %d\n",E->trace.istat1);
+
+ fprintf(E->trace.fpt,"Number of tracers sent to other processors: %d\n",E->trace.istat_isend);
+
+ fprintf(E->trace.fpt,"Number of times element columns are checked: %d \n",E->trace.istat_elements_checked);
+
+ /* compositional and error fraction data files */
+ //TODO: move
+ if (E->composition.on) {
+ fprintf(E->trace.fpt,"Empty elements filled with old compositional "
+ "values: %d (%f percent)\n", E->trace.istat_iempty,
+ (100.0*E->trace.istat_iempty)/E->lmesh.nel);
+ E->trace.istat_iempty=0;
+
+
+ get_bulk_composition(E);
+
+ if (E->parallel.me==0) {
+
+ fprintf(E->fp,"composition: %e",E->monitor.elapsed_time);
+ for (i=0; i<E->composition.ncomp; i++)
+ fprintf(E->fp," %e", E->composition.bulk_composition[i]);
+ fprintf(E->fp,"\n");
+
+ fprintf(E->fp,"composition_error_fraction: %e",E->monitor.elapsed_time);
+ for (i=0; i<E->composition.ncomp; i++)
+ fprintf(E->fp," %e", E->composition.error_fraction[i]);
+ fprintf(E->fp,"\n");
+
+ }
+ }
+ fflush(E->trace.fpt);
+ }
+
+ return;
+}
+
+
+/*********** PREDICT TRACERS **********************************************/
+/* */
+/* This function predicts tracers performing an euler step */
+/* */
+/* */
+/* Note positions used in tracer array */
+/* [positions 0-5 are always fixed with current coordinates */
+/* Positions 6-8 contain original Cartesian coordinates. */
+/* Positions 9-11 contain original Cartesian velocities. */
+/* */
+
+
+static void predict_tracers(struct All_variables *E)
+{
+
+ int numtracers;
+ int j;
+ int kk;
+ int nelem;
+
+ double dt;
+ double theta0,phi0,rad0;
+ double x0,y0,z0;
+ double theta_pred,phi_pred,rad_pred;
+ double x_pred,y_pred,z_pred;
+ double velocity_vector[4];
+
+
+ dt=E->advection.timestep;
+
+
+ for (j=1;j<=E->sphere.caps_per_proc;j++) {
+
+ numtracers=E->trace.ntracers[j];
+
+ for (kk=1;kk<=numtracers;kk++) {
+
+ theta0=E->trace.basicq[j][0][kk];
+ phi0=E->trace.basicq[j][1][kk];
+ rad0=E->trace.basicq[j][2][kk];
+ x0=E->trace.basicq[j][3][kk];
+ y0=E->trace.basicq[j][4][kk];
+ z0=E->trace.basicq[j][5][kk];
+
+ nelem=E->trace.ielement[j][kk];
+ (E->trace.get_velocity)(E,j,nelem,theta0,phi0,rad0,velocity_vector);
+
+ x_pred=x0+velocity_vector[1]*dt;
+ y_pred=y0+velocity_vector[2]*dt;
+ z_pred=z0+velocity_vector[3]*dt;
+
+
+ /* keep in box */
+
+ cart_to_sphere(E,x_pred,y_pred,z_pred,&theta_pred,&phi_pred,&rad_pred);
+ (E->trace.keep_within_bounds)(E,&x_pred,&y_pred,&z_pred,&theta_pred,&phi_pred,&rad_pred);
+
+ /* Current Coordinates are always kept in positions 0-5. */
+
+ E->trace.basicq[j][0][kk]=theta_pred;
+ E->trace.basicq[j][1][kk]=phi_pred;
+ E->trace.basicq[j][2][kk]=rad_pred;
+ E->trace.basicq[j][3][kk]=x_pred;
+ E->trace.basicq[j][4][kk]=y_pred;
+ E->trace.basicq[j][5][kk]=z_pred;
+
+ /* Fill in original coords (positions 6-8) */
+
+ E->trace.basicq[j][6][kk]=x0;
+ E->trace.basicq[j][7][kk]=y0;
+ E->trace.basicq[j][8][kk]=z0;
+
+ /* Fill in original velocities (positions 9-11) */
+
+ E->trace.basicq[j][9][kk]=velocity_vector[1]; /* Vx */
+ E->trace.basicq[j][10][kk]=velocity_vector[2]; /* Vy */
+ E->trace.basicq[j][11][kk]=velocity_vector[3]; /* Vz */
+
+
+ } /* end kk, predicting tracers */
+ } /* end caps */
+
+ /* find new tracer elements and caps */
+
+ find_tracers(E);
+
+ return;
+
+}
+
+
+/*********** CORRECT TRACERS **********************************************/
+/* */
+/* This function corrects tracers using both initial and */
+/* predicted velocities */
+/* */
+/* */
+/* Note positions used in tracer array */
+/* [positions 0-5 are always fixed with current coordinates */
+/* Positions 6-8 contain original Cartesian coordinates. */
+/* Positions 9-11 contain original Cartesian velocities. */
+/* */
+
+
+static void correct_tracers(struct All_variables *E)
+{
+
+ int j;
+ int kk;
+ int nelem;
+
+
+ double dt;
+ double x0,y0,z0;
+ double theta_pred,phi_pred,rad_pred;
+ double x_pred,y_pred,z_pred;
+ double theta_cor,phi_cor,rad_cor;
+ double x_cor,y_cor,z_cor;
+ double velocity_vector[4];
+ double Vx0,Vy0,Vz0;
+ double Vx_pred,Vy_pred,Vz_pred;
+
+ dt=E->advection.timestep;
+
+
+ for (j=1;j<=E->sphere.caps_per_proc;j++) {
+ for (kk=1;kk<=E->trace.ntracers[j];kk++) {
+
+ theta_pred=E->trace.basicq[j][0][kk];
+ phi_pred=E->trace.basicq[j][1][kk];
+ rad_pred=E->trace.basicq[j][2][kk];
+ x_pred=E->trace.basicq[j][3][kk];
+ y_pred=E->trace.basicq[j][4][kk];
+ z_pred=E->trace.basicq[j][5][kk];
+
+ x0=E->trace.basicq[j][6][kk];
+ y0=E->trace.basicq[j][7][kk];
+ z0=E->trace.basicq[j][8][kk];
+
+ Vx0=E->trace.basicq[j][9][kk];
+ Vy0=E->trace.basicq[j][10][kk];
+ Vz0=E->trace.basicq[j][11][kk];
+
+ nelem=E->trace.ielement[j][kk];
+
+ (E->trace.get_velocity)(E,j,nelem,theta_pred,phi_pred,rad_pred,velocity_vector);
+
+ Vx_pred=velocity_vector[1];
+ Vy_pred=velocity_vector[2];
+ Vz_pred=velocity_vector[3];
+
+ x_cor=x0 + dt * 0.5*(Vx0+Vx_pred);
+ y_cor=y0 + dt * 0.5*(Vy0+Vy_pred);
+ z_cor=z0 + dt * 0.5*(Vz0+Vz_pred);
+
+ cart_to_sphere(E,x_cor,y_cor,z_cor,&theta_cor,&phi_cor,&rad_cor);
+ (E->trace.keep_within_bounds)(E,&x_cor,&y_cor,&z_cor,&theta_cor,&phi_cor,&rad_cor);
+
+ /* Fill in Current Positions (other positions are no longer important) */
+
+ E->trace.basicq[j][0][kk]=theta_cor;
+ E->trace.basicq[j][1][kk]=phi_cor;
+ E->trace.basicq[j][2][kk]=rad_cor;
+ E->trace.basicq[j][3][kk]=x_cor;
+ E->trace.basicq[j][4][kk]=y_cor;
+ E->trace.basicq[j][5][kk]=z_cor;
+
+ } /* end kk, correcting tracers */
+ } /* end caps */
+
+ /* find new tracer elements and caps */
+
+ find_tracers(E);
+
+ return;
+}
+
+
+/************ FIND TRACERS *************************************/
+/* */
+/* This function finds tracer elements and moves tracers to */
+/* other processor domains if necessary. */
+/* Array ielement is filled with elemental values. */
+
+static void find_tracers(struct All_variables *E)
+{
+
+ int iel;
+ int kk;
+ int j;
+ int it;
+ int iprevious_element;
+ int num_tracers;
+
+ double theta,phi,rad;
+ double x,y,z;
+ double time_stat1;
+ double time_stat2;
+
+ double begin_time = CPU_time0();
+
+
+ for (j=1;j<=E->sphere.caps_per_proc;j++) {
+
+
+ /* initialize arrays and statistical counters */
+
+ E->trace.ilater[j]=E->trace.ilatersize[j]=0;
+
+ E->trace.istat1=0;
+ for (kk=0;kk<=4;kk++) {
+ E->trace.istat_ichoice[j][kk]=0;
+ }
+
+ //TODO: use while-loop instead of for-loop
+ /* important to index by it, not kk */
+
+ it=0;
+ num_tracers=E->trace.ntracers[j];
+
+ for (kk=1;kk<=num_tracers;kk++) {
+
+ it++;
+
+ theta=E->trace.basicq[j][0][it];
+ phi=E->trace.basicq[j][1][it];
+ rad=E->trace.basicq[j][2][it];
+ x=E->trace.basicq[j][3][it];
+ y=E->trace.basicq[j][4][it];
+ z=E->trace.basicq[j][5][it];
+
+ iprevious_element=E->trace.ielement[j][it];
+
+ iel=(E->trace.iget_element)(E,j,iprevious_element,x,y,z,theta,phi,rad);
+ /* debug *
+ fprintf(E->trace.fpt,"BB. kk %d %d %d %d %f %f %f %f %f %f\n",kk,j,iprevious_element,iel,x,y,z,theta,phi,rad);
+ fflush(E->trace.fpt);
+ /**/
+
+ E->trace.ielement[j][it]=iel;
+
+ if (iel<0) {
+ put_away_later(E,j,it);
+ eject_tracer(E,j,it);
+ it--;
+ }
+
+ } /* end tracers */
+
+ } /* end j */
+
+
+ /* Now take care of tracers that exited cap */
+
+ /* REMOVE */
+ /*
+ parallel_process_termination();
+ */
+
+ if (E->parallel.nprocxy == 12)
+ full_lost_souls(E);
+ else
+ regional_lost_souls(E);
+
+ /* Free later arrays */
+
+ for (j=1;j<=E->sphere.caps_per_proc;j++) {
+ if (E->trace.ilatersize[j]>0) {
+ for (kk=0;kk<=((E->trace.number_of_tracer_quantities)-1);kk++) {
+ free(E->trace.rlater[j][kk]);
+ }
+ }
+ } /* end j */
+
+
+ /* Adjust Array Sizes */
+
+ reduce_tracer_arrays(E);
+
+ E->trace.find_tracers_time += CPU_time0() - begin_time;
+
+ return;
+}
+
+
+/***********************************************************************/
+/* This function computes the number of tracers in each element. */
+/* Each tracer can be of different "flavors", which is the 0th index */
+/* of extraq. How to interprete "flavor" is left for the application. */
+
+void count_tracers_of_flavors(struct All_variables *E)
+{
+
+ int j, flavor, e, kk;
+ int numtracers;
+
+ for (j=1; j<=E->sphere.caps_per_proc; j++) {
+
+ /* first zero arrays */
+ for (flavor=0; flavor<E->trace.nflavors; flavor++)
+ for (e=1; e<=E->lmesh.nel; e++)
+ E->trace.ntracer_flavor[j][flavor][e] = 0;
+
+ numtracers=E->trace.ntracers[j];
+
+ /* Fill arrays */
+ for (kk=1; kk<=numtracers; kk++) {
+ e = E->trace.ielement[j][kk];
+ flavor = (int)E->trace.extraq[j][0][kk];
+ E->trace.ntracer_flavor[j][flavor][e]++;
+ }
+ }
+
+ /* debug */
+ /**
+ for (j=1; j<=E->sphere.caps_per_proc; j++) {
+ for (e=1; e<=E->lmesh.nel; e++) {
+ fprintf(E->trace.fpt, "element=%d ntracer_flaver =", e);
+ for (flavor=0; flavor<E->trace.nflavors; flavor++) {
+ fprintf(E->trace.fpt, " %d",
+ E->trace.ntracer_flavor[j][flavor][e]);
+ }
+ fprintf(E->trace.fpt, "\n");
+ }
+ }
+ fflush(E->trace.fpt);
+ /**/
+
+ return;
+}
+
+
+
+static void get_new_tracers(struct All_variables *E)
+{
+ if (E->trace.ic_method==0)
+ make_tracer_array(E);
+ else if (E->trace.ic_method==1)
+ read_tracer_file(E);
+ else if (E->trace.ic_method==2)
+ read_old_tracer_file(E);
+ else {
+ fprintf(E->trace.fpt,"Not ready for other inputs yet\n");
+ fflush(E->trace.fpt);
+ parallel_process_termination();
+ }
+
+ /* total number of tracers */
+
+ E->trace.ilast_tracer_count = isum_tracers(E);
+ fprintf(E->trace.fpt, "Sum of Tracers: %d\n", E->trace.ilast_tracer_count);
+ if(E->parallel.me==0)
+ fprintf(stderr, "Sum of Tracers: %d\n", E->trace.ilast_tracer_count);
+
+
+ /* find elements */
+
+ find_tracers(E);
+
+ return;
+}
+
+void initialize_tracers(struct All_variables *E)
+{
+ get_new_tracers(E);
+
+ /* count # of tracers of each flavor */
+
+ if (E->trace.nflavors > 0)
+ count_tracers_of_flavors(E);
+
+ return;
+}
+
+
+void dump_and_get_new_tracers_to_interpolate_fields(struct All_variables *E)
+{
+ int j;
+
+ for (j=1;j<=E->sphere.caps_per_proc;j++)
+ free_tracer_arrays(E, j);
+
+ E->trace.number_of_extra_quantities = 2;
+ E->trace.number_of_tracer_quantities =
+ E->trace.number_of_basic_quantities +
+ E->trace.number_of_extra_quantities;
+
+ get_new_tracers(E);
+ return;
+}
+
+
+/************** MAKE TRACER ARRAY ********************************/
+/* Here, each processor will generate tracers somewhere */
+/* in the sphere - check if its in this cap - then check radial */
+
+static void make_tracer_array(struct All_variables *E)
+{
+
+ int tracers_cap;
+ int j;
+ double processor_fraction;
+
+ if (E->parallel.me==0) fprintf(stderr,"Making Tracer Array\n");
+
+ for (j=1;j<=E->sphere.caps_per_proc;j++) {
+
+ processor_fraction=E->lmesh.volume/E->mesh.volume;
+ tracers_cap = (int)(E->mesh.nel*E->trace.itperel*processor_fraction);
+ /*
+ fprintf(stderr,"AA: proc frac: %f (%d) %d %d %f %f\n",processor_fraction,tracers_cap,E->lmesh.nel,E->parallel.nprocz, E->sx[j][3][E->lmesh.noz],E->sx[j][3][1]);
+ */
+
+ fprintf(E->trace.fpt,"\nGenerating %d Tracers\n",tracers_cap);
+
+ generate_random_tracers(E, tracers_cap, j);
+
+
+
+ }/* end j */
+
+
+ /* Initialize tracer flavors */
+ if (E->trace.nflavors) init_tracer_flavors(E);
+
+ return;
+}
+
+
+
+static void generate_random_tracers(struct All_variables *E,
+ int tracers_cap, int j)
+{
+ int kk;
+ int ival;
+ int number_of_tries=0;
+ int max_tries;
+
+ double x,y,z;
+ double theta,phi,rad;
+ double xmin,xmax,ymin,ymax,zmin,zmax;
+ double random1,random2,random3;
+
+
+ allocate_tracer_arrays(E,j,tracers_cap);
+
+ /* Finding the min/max of the cartesian coordinates. */
+ /* One must loop over E->X to find the min/max, since the 8 corner */
+ /* nodes may not be the min/max. */
+ xmin = ymin = zmin = E->sphere.ro;
+ xmax = ymax = zmax = -E->sphere.ro;
+ for (kk=1; kk<=E->lmesh.nno; kk++) {
+ x = E->x[j][1][kk];
+ y = E->x[j][2][kk];
+ z = E->x[j][3][kk];
+
+ xmin = ((xmin < x) ? xmin : x);
+ xmax = ((xmax > x) ? xmax : x);
+ ymin = ((ymin < y) ? ymin : y);
+ ymax = ((ymax > y) ? ymax : y);
+ zmin = ((zmin < z) ? zmin : z);
+ zmax = ((zmax > z) ? zmax : z);
+ }
+
+ /* Tracers are placed randomly in cap */
+ /* (intentionally using rand() instead of srand() )*/
+
+ while (E->trace.ntracers[j]<tracers_cap) {
+
+ number_of_tries++;
+ max_tries=100*tracers_cap;
+
+ if (number_of_tries>max_tries) {
+ fprintf(E->trace.fpt,"Error(make_tracer_array)-too many tries?\n");
+ fprintf(E->trace.fpt,"%d %d %d\n",max_tries,number_of_tries,RAND_MAX);
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+
+#if 1
+ random1=drand48();
+ random2=drand48();
+ random3=drand48();
+#else
+ random1=(1.0*rand())/(1.0*RAND_MAX);
+ random2=(1.0*rand())/(1.0*RAND_MAX);
+ random3=(1.0*rand())/(1.0*RAND_MAX);
+#endif
+
+ x=xmin+random1*(xmax-xmin);
+ y=ymin+random2*(ymax-ymin);
+ z=zmin+random3*(zmax-zmin);
+
+ /* first check if within shell */
+
+ cart_to_sphere(E,x,y,z,&theta,&phi,&rad);
+
+ if (rad>=E->sx[j][3][E->lmesh.noz]) continue;
+ if (rad<E->sx[j][3][1]) continue;
+
+
+ /* check if in current cap */
+ if (E->parallel.nprocxy==1)
+ ival=regional_icheck_cap(E,0,theta,phi,rad,rad);
+ else
+ ival=full_icheck_cap(E,0,x,y,z,rad);
+
+ if (ival!=1) continue;
+
+ /* Made it, so record tracer information */
+
+ (E->trace.keep_within_bounds)(E,&x,&y,&z,&theta,&phi,&rad);
+
+ E->trace.ntracers[j]++;
+ kk=E->trace.ntracers[j];
+
+ E->trace.basicq[j][0][kk]=theta;
+ E->trace.basicq[j][1][kk]=phi;
+ E->trace.basicq[j][2][kk]=rad;
+ E->trace.basicq[j][3][kk]=x;
+ E->trace.basicq[j][4][kk]=y;
+ E->trace.basicq[j][5][kk]=z;
+
+ } /* end while */
+
+ return;
+}
+
+
+/******** READ TRACER ARRAY *********************************************/
+/* */
+/* This function reads tracers from input file. */
+/* All processors read the same input file, then sort out which ones */
+/* belong. */
+
+static void read_tracer_file(struct All_variables *E)
+{
+
+ char input_s[1000];
+
+ int number_of_tracers, ncolumns;
+ int kk;
+ int icheck;
+ int iestimate;
+ int icushion;
+ int i, j;
+
+ double x,y,z;
+ double theta,phi,rad;
+ double buffer[100];
+
+ FILE *fptracer;
+
+ fptracer=fopen(E->trace.tracer_file,"r");
+
+ fgets(input_s,200,fptracer);
+ sscanf(input_s,"%d %d",&number_of_tracers,&ncolumns);
+ fprintf(E->trace.fpt,"%d Tracers, %d columns in file \n",
+ number_of_tracers, ncolumns);
+
+ /* some error control */
+ if (E->trace.number_of_extra_quantities+3 != ncolumns) {
+ fprintf(E->trace.fpt,"ERROR(read tracer file)-wrong # of columns\n");
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+
+
+ /* initially size tracer arrays to number of tracers divided by processors */
+
+ icushion=100;
+
+ iestimate=number_of_tracers/E->parallel.nproc + icushion;
+
+ for (j=1;j<=E->sphere.caps_per_proc;j++) {
+
+ allocate_tracer_arrays(E,j,iestimate);
+
+ for (kk=1;kk<=number_of_tracers;kk++) {
+ int len, ncol;
+ ncol = 3 + E->trace.number_of_extra_quantities;
+
+ len = read_double_vector(fptracer, ncol, buffer);
+ if (len != ncol) {
+ fprintf(E->trace.fpt,"ERROR(read tracer file) - wrong input file format: %d-th tracer in %s\n", kk, E->trace.tracer_file);
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+
+ theta = buffer[0];
+ phi = buffer[1];
+ rad = buffer[2];
+
+ sphere_to_cart(E,theta,phi,rad,&x,&y,&z);
+
+
+ /* make sure theta, phi is in range, and radius is within bounds */
+
+ (E->trace.keep_within_bounds)(E,&x,&y,&z,&theta,&phi,&rad);
+
+ /* check whether tracer is within processor domain */
+
+ icheck=1;
+ if (E->parallel.nprocz>1) icheck=icheck_processor_shell(E,j,rad);
+ if (icheck!=1) continue;
+
+ if (E->parallel.nprocxy==1)
+ icheck=regional_icheck_cap(E,0,theta,phi,rad,rad);
+ else
+ icheck=full_icheck_cap(E,0,x,y,z,rad);
+
+ if (icheck==0) continue;
+
+ /* if still here, tracer is in processor domain */
+
+
+ E->trace.ntracers[j]++;
+
+ if (E->trace.ntracers[j]>=(E->trace.max_ntracers[j]-5)) expand_tracer_arrays(E,j);
+
+ E->trace.basicq[j][0][E->trace.ntracers[j]]=theta;
+ E->trace.basicq[j][1][E->trace.ntracers[j]]=phi;
+ E->trace.basicq[j][2][E->trace.ntracers[j]]=rad;
+ E->trace.basicq[j][3][E->trace.ntracers[j]]=x;
+ E->trace.basicq[j][4][E->trace.ntracers[j]]=y;
+ E->trace.basicq[j][5][E->trace.ntracers[j]]=z;
+
+ for (i=0; i<E->trace.number_of_extra_quantities; i++)
+ E->trace.extraq[j][i][E->trace.ntracers[j]]=buffer[i+3];
+
+ } /* end kk, number of tracers */
+
+ fprintf(E->trace.fpt,"Number of tracers in this cap is: %d\n",
+ E->trace.ntracers[j]);
+
+ /** debug **
+ for (kk=1; kk<=E->trace.ntracers[j]; kk++) {
+ fprintf(E->trace.fpt, "tracer#=%d sph_coord=(%g,%g,%g)", kk,
+ E->trace.basicq[j][0][kk],
+ E->trace.basicq[j][1][kk],
+ E->trace.basicq[j][2][kk]);
+ fprintf(E->trace.fpt, " extraq=");
+ for (i=0; i<E->trace.number_of_extra_quantities; i++)
+ fprintf(E->trace.fpt, " %g", E->trace.extraq[j][i][kk]);
+ fprintf(E->trace.fpt, "\n");
+ }
+ fflush(E->trace.fpt);
+ /**/
+
+ } /* end j */
+
+ fclose(fptracer);
+
+ icheck=isum_tracers(E);
+
+ if (icheck!=number_of_tracers) {
+ fprintf(E->trace.fpt,"ERROR(read_tracer_file) - tracers != number in file\n");
+ fprintf(E->trace.fpt,"Tracers in system: %d\n", icheck);
+ fprintf(E->trace.fpt,"Tracers in file: %d\n", number_of_tracers);
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+
+ return;
+}
+
+
+/************** READ OLD TRACER FILE *************************************/
+/* */
+/* This function read tracers written from previous calculation */
+/* and the tracers are read as seperate files for each processor domain. */
+
+static void read_old_tracer_file(struct All_variables *E)
+{
+
+ char output_file[200];
+ char input_s[1000];
+
+ int i,j,kk,rezip;
+ int idum1,ncolumns;
+ int numtracers;
+
+ double rdum1;
+ double theta,phi,rad;
+ double x,y,z;
+ double buffer[100];
+
+ FILE *fp1;
+
+ if (E->trace.number_of_extra_quantities>99) {
+ fprintf(E->trace.fpt,"ERROR(read_old_tracer_file)-increase size of extra[]\n");
+ fflush(E->trace.fpt);
+ parallel_process_termination();
+ }
+
+
+
+ /* deal with different output formats */
+#ifdef USE_GZDIR
+ if(strcmp(E->output.format, "ascii-gz") == 0){
+ sprintf(output_file,"%s/%d/tracer.%d.%d",
+ E->control.data_dir_old,E->monitor.solution_cycles_init,E->parallel.me,E->monitor.solution_cycles_init);
+ rezip = open_file_zipped(output_file,&fp1,E);
+ }else{
+ sprintf(output_file,"%s.tracer.%d.%d",E->control.old_P_file,E->parallel.me,E->monitor.solution_cycles_init);
+ if ( (fp1=fopen(output_file,"r"))==NULL) {
+ fprintf(E->trace.fpt,"ERROR(read_old_tracer_file)-gziped file not found %s\n",output_file);
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+ }
+#else
+ sprintf(output_file,"%s.tracer.%d.%d",E->control.old_P_file,E->parallel.me,E->monitor.solution_cycles_init);
+ if ( (fp1=fopen(output_file,"r"))==NULL) {
+ fprintf(E->trace.fpt,"ERROR(read_old_tracer_file)-file not found %s\n",output_file);
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+#endif
+
+ fprintf(stderr,"Read old tracers from %s\n",output_file);
+
+
+ for(j=1;j<=E->sphere.caps_per_proc;j++) {
+ fgets(input_s,200,fp1);
+ sscanf(input_s,"%d %d %d %lf",
+ &idum1, &numtracers, &ncolumns, &rdum1);
+
+ /* some error control */
+ if (E->trace.number_of_extra_quantities+3 != ncolumns) {
+ fprintf(E->trace.fpt,"ERROR(read_old_tracer_file)-wrong # of columns\n");
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+
+ /* allocate memory for tracer arrays */
+
+ allocate_tracer_arrays(E,j,numtracers);
+ E->trace.ntracers[j]=numtracers;
+
+ for (kk=1;kk<=numtracers;kk++) {
+ int len, ncol;
+ ncol = 3 + E->trace.number_of_extra_quantities;
+
+ len = read_double_vector(fp1, ncol, buffer);
+ if (len != ncol) {
+ fprintf(E->trace.fpt,"ERROR(read_old_tracer_file) - wrong input file format: %s\n", output_file);
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+
+ theta = buffer[0];
+ phi = buffer[1];
+ rad = buffer[2];
+
+ sphere_to_cart(E,theta,phi,rad,&x,&y,&z);
+
+ /* it is possible that if on phi=0 boundary, significant digits can push phi over 2pi */
+
+ (E->trace.keep_within_bounds)(E,&x,&y,&z,&theta,&phi,&rad);
+
+ E->trace.basicq[j][0][kk]=theta;
+ E->trace.basicq[j][1][kk]=phi;
+ E->trace.basicq[j][2][kk]=rad;
+ E->trace.basicq[j][3][kk]=x;
+ E->trace.basicq[j][4][kk]=y;
+ E->trace.basicq[j][5][kk]=z;
+
+ for (i=0; i<E->trace.number_of_extra_quantities; i++)
+ E->trace.extraq[j][i][kk]=buffer[i+3];
+
+ }
+
+ /** debug **
+ for (kk=1; kk<=E->trace.ntracers[j]; kk++) {
+ fprintf(E->trace.fpt, "tracer#=%d sph_coord=(%g,%g,%g)", kk,
+ E->trace.basicq[j][0][kk],
+ E->trace.basicq[j][1][kk],
+ E->trace.basicq[j][2][kk]);
+ fprintf(E->trace.fpt, " extraq=");
+ for (i=0; i<E->trace.number_of_extra_quantities; i++)
+ fprintf(E->trace.fpt, " %g", E->trace.extraq[j][i][kk]);
+ fprintf(E->trace.fpt, "\n");
+ }
+ fflush(E->trace.fpt);
+ /**/
+
+ fprintf(E->trace.fpt,"Read %d tracers from file %s\n",numtracers,output_file);
+ fflush(E->trace.fpt);
+
+ }
+ fclose(fp1);
+#ifdef USE_GZDIR
+ if(strcmp(E->output.format, "ascii-gz") == 0)
+ if(rezip) /* rezip */
+ gzip_file(output_file);
+#endif
+
+ return;
+}
+
+
+
+
+
+/*********** CHECK SUM **************************************************/
+/* */
+/* This functions checks to make sure number of tracers is preserved */
+
+static void check_sum(struct All_variables *E)
+{
+
+ int number, iold_number;
+
+ number = isum_tracers(E);
+
+ iold_number = E->trace.ilast_tracer_count;
+
+ if (number != iold_number) {
+ fprintf(E->trace.fpt,"ERROR(check_sum)-break in conservation %d %d\n",
+ number,iold_number);
+ fflush(E->trace.fpt);
+ if (E->trace.itracer_warnings)
+ parallel_process_termination();
+ }
+
+ E->trace.ilast_tracer_count = number;
+
+ return;
+}
+
+
+/************* ISUM TRACERS **********************************************/
+/* */
+/* This function uses MPI to sum all tracers and returns number of them. */
+
+static int isum_tracers(struct All_variables *E)
+{
+ int imycount;
+ int iallcount;
+ int j;
+
+ iallcount = 0;
+
+ imycount = 0;
+ for (j=1; j<=E->sphere.caps_per_proc; j++)
+ imycount = imycount + E->trace.ntracers[j];
+
+ MPI_Allreduce(&imycount,&iallcount,1,MPI_INT,MPI_SUM,E->parallel.world);
+
+ return iallcount;
+}
+
+
+
+/********** CART TO SPHERE ***********************/
+void cart_to_sphere(struct All_variables *E,
+ double x, double y, double z,
+ double *theta, double *phi, double *rad)
+{
+
+ double temp;
+
+ temp=x*x+y*y;
+
+ *rad=sqrt(temp+z*z);
+ *theta=atan2(sqrt(temp),z);
+ *phi=myatan(y,x);
+
+
+ return;
+}
+
+/********** SPHERE TO CART ***********************/
+void sphere_to_cart(struct All_variables *E,
+ double theta, double phi, double rad,
+ double *x, double *y, double *z)
+{
+
+ double sint,cost,sinf,cosf;
+ double temp;
+
+ sint=sin(theta);
+ cost=cos(theta);
+ sinf=sin(phi);
+ cosf=cos(phi);
+
+ temp=rad*sint;
+
+ *x=temp*cosf;
+ *y=temp*sinf;
+ *z=rad*cost;
+
+ return;
+}
+
+
+
+static void init_tracer_flavors(struct All_variables *E)
+{
+ int j, kk, number_of_tracers;
+ int i;
+ double flavor;
+ double rad;
+
+ switch(E->trace.ic_method_for_flavors){
+ case 0:
+ /* ic_method_for_flavors == 0 (layered structure) */
+ /* any tracer above z_interface[i] is of flavor i */
+ /* any tracer below z_interface is of flavor (nflavors-1) */
+ for (j=1;j<=E->sphere.caps_per_proc;j++) {
+
+ number_of_tracers = E->trace.ntracers[j];
+ for (kk=1;kk<=number_of_tracers;kk++) {
+ rad = E->trace.basicq[j][2][kk];
+
+ flavor = E->trace.nflavors - 1;
+ for (i=0; i<E->trace.nflavors-1; i++) {
+ if (rad > E->trace.z_interface[i]) {
+ flavor = i;
+ break;
+ }
+ }
+ E->trace.extraq[j][0][kk] = flavor;
+ }
+ }
+ break;
+
+ case 1: /* from grd in top n layers */
+#ifndef USE_GGRD
+ fprintf(stderr,"ic_method_for_flavors %i requires the ggrd routines from hc, -DUSE_GGRD\n",
+ E->trace.ic_method_for_flavors);
+ parallel_process_termination();
+#else
+ ggrd_init_tracer_flavors(E);
+#endif
+ break;
+
+
+ default:
+
+ fprintf(stderr,"ic_method_for_flavors %i undefined\n",E->trace.ic_method_for_flavors);
+ parallel_process_termination();
+ break;
+ }
+
+ return;
+}
+
+
+/******************* get_neighboring_caps ************************************/
+/* */
+/* Communicate with neighboring processors to get their cap boundaries, */
+/* which is later used by (E->trace.icheck_cap)() */
+/* */
+
+void get_neighboring_caps(struct All_variables *E)
+{
+ const int ncorners = 4; /* # of top corner nodes */
+ int i, j, n, d, kk, lev, idb;
+ int num_ngb, neighbor_proc, tag;
+ MPI_Status status[200];
+ MPI_Request request[200];
+
+ int node[ncorners];
+ double xx[ncorners*2], rr[12][ncorners*2];
+ int nox,noy,noz;
+ double x,y,z;
+ double theta,phi,rad;
+
+ nox=E->lmesh.nox;
+ noy=E->lmesh.noy;
+ noz=E->lmesh.noz;
+
+ node[0]=nox*noz*(noy-1)+noz;
+ node[1]=noz;
+ node[2]=noz*nox;
+ node[3]=noz*nox*noy;
+
+ lev = E->mesh.levmax;
+ tag = 45;
+
+ for (j=1; j<=E->sphere.caps_per_proc; j++) {
+
+ /* loop over top corners to get their coordinates */
+ n = 0;
+ for (i=0; i<ncorners; i++) {
+ for (d=0; d<2; d++) {
+ xx[n] = E->sx[j][d+1][node[i]];
+ n++;
+ }
+ }
+
+ idb = 0;
+ num_ngb = E->parallel.TNUM_PASS[lev][j];
+ for (kk=1; kk<=num_ngb; kk++) {
+ neighbor_proc = E->parallel.PROCESSOR[lev][j].pass[kk];
+
+ MPI_Isend(xx, n, MPI_DOUBLE, neighbor_proc,
+ tag, E->parallel.world, &request[idb]);
+ idb++;
+
+ MPI_Irecv(rr[kk], n, MPI_DOUBLE, neighbor_proc,
+ tag, E->parallel.world, &request[idb]);
+ idb++;
+ }
+
+ /* Storing the current cap information */
+ for (i=0; i<n; i++)
+ rr[0][i] = xx[i];
+
+ /* Wait for non-blocking calls to complete */
+
+ MPI_Waitall(idb, request, status);
+
+ /* Storing the received cap information
+ * XXX: this part assumes:
+ * 1) E->sphere.caps_per_proc==1
+ * 2) E->mesh.nsd==3
+ */
+ for (kk=0; kk<=num_ngb; kk++) {
+ n = 0;
+ for (i=1; i<=ncorners; i++) {
+ theta = rr[kk][n++];
+ phi = rr[kk][n++];
+ rad = E->sphere.ro;
+
+ sphere_to_cart(E, theta, phi, rad, &x, &y, &z);
+
+ E->trace.xcap[kk][i] = x;
+ E->trace.ycap[kk][i] = y;
+ E->trace.zcap[kk][i] = z;
+ E->trace.theta_cap[kk][i] = theta;
+ E->trace.phi_cap[kk][i] = phi;
+ E->trace.rad_cap[kk][i] = rad;
+ E->trace.cos_theta[kk][i] = cos(theta);
+ E->trace.sin_theta[kk][i] = sin(theta);
+ E->trace.cos_phi[kk][i] = cos(phi);
+ E->trace.sin_phi[kk][i] = sin(phi);
+ }
+ } /* end kk, number of neighbors */
+
+ /* debugging output *
+ for (kk=0; kk<=num_ngb; kk++) {
+ if (kk==0)
+ neighbor_proc = E->parallel.me;
+ else
+ neighbor_proc = E->parallel.PROCESSOR[lev][1].pass[kk];
+
+ for (i=1; i<=ncorners; i++) {
+ fprintf(E->trace.fpt, "pass=%d rank=%d corner=%d "
+ "sx=(%g, %g, %g)\n",
+ kk, neighbor_proc, i,
+ E->trace.theta_cap[kk][i],
+ E->trace.phi_cap[kk][i],
+ E->trace.rad_cap[kk][i]);
+ }
+ }
+ fflush(E->trace.fpt);
+ /**/
+ }
+
+ return;
+}
+
+
+/**************** INITIALIZE TRACER ARRAYS ************************************/
+/* */
+/* This function allocates memories to tracer arrays. */
+
+void allocate_tracer_arrays(struct All_variables *E,
+ int j, int number_of_tracers)
+{
+
+ int kk;
+
+ /* max_ntracers is physical size of tracer array */
+ /* (initially make it 25% larger than required */
+
+ E->trace.max_ntracers[j]=number_of_tracers+number_of_tracers/4;
+ E->trace.ntracers[j]=0;
+
+ /* make tracer arrays */
+
+ if ((E->trace.ielement[j]=(int *) malloc(E->trace.max_ntracers[j]*sizeof(int)))==NULL) {
+ fprintf(E->trace.fpt,"ERROR(make tracer array)-no memory 1a\n");
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+ for (kk=1;kk<E->trace.max_ntracers[j];kk++)
+ E->trace.ielement[j][kk]=-99;
+
+
+ for (kk=0;kk<E->trace.number_of_basic_quantities;kk++) {
+ if ((E->trace.basicq[j][kk]=(double *)malloc(E->trace.max_ntracers[j]*sizeof(double)))==NULL) {
+ fprintf(E->trace.fpt,"ERROR(initialize tracer arrays)-no memory 1b.%d\n",kk);
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+ }
+
+ for (kk=0;kk<E->trace.number_of_extra_quantities;kk++) {
+ if ((E->trace.extraq[j][kk]=(double *)malloc(E->trace.max_ntracers[j]*sizeof(double)))==NULL) {
+ fprintf(E->trace.fpt,"ERROR(initialize tracer arrays)-no memory 1c.%d\n",kk);
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+ }
+
+ if (E->trace.nflavors > 0) {
+ E->trace.ntracer_flavor[j]=(int **)malloc(E->trace.nflavors*sizeof(int*));
+ for (kk=0;kk<E->trace.nflavors;kk++) {
+ if ((E->trace.ntracer_flavor[j][kk]=(int *)malloc((E->lmesh.nel+1)*sizeof(int)))==NULL) {
+ fprintf(E->trace.fpt,"ERROR(initialize tracer arrays)-no memory 1c.%d\n",kk);
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+ }
+ }
+
+
+ fprintf(E->trace.fpt,"Physical size of tracer arrays (max_ntracers): %d\n",
+ E->trace.max_ntracers[j]);
+ fflush(E->trace.fpt);
+
+ return;
+}
+
+
+/****** FREE TRACER ARRAYS *****************************************/
+static void free_tracer_arrays(struct All_variables *E, int j)
+{
+ int kk;
+
+ if (E->trace.nflavors > 0) {
+ for (kk=0;kk<E->trace.nflavors;kk++)
+ free(E->trace.ntracer_flavor[j][kk]);
+ free(E->trace.ntracer_flavor[j]);
+ }
+
+ for (kk=0;kk<E->trace.number_of_extra_quantities;kk++)
+ free(E->trace.extraq[j][kk]);
+
+ for (kk=0;kk<E->trace.number_of_basic_quantities;kk++)
+ free(E->trace.basicq[j][kk]);
+
+ free(E->trace.ielement[j]);
+
+ E->trace.max_ntracers[j] = E->trace.ntracers[j] = 0;
+
+ return;
+}
+
+
+/****** EXPAND TRACER ARRAYS *****************************************/
+
+void expand_tracer_arrays(struct All_variables *E, int j)
+{
+
+ int inewsize;
+ int kk;
+ int icushion;
+
+ /* expand basicq and ielement by 20% */
+
+ icushion=100;
+
+ inewsize=E->trace.max_ntracers[j]+E->trace.max_ntracers[j]/5+icushion;
+
+ if ((E->trace.ielement[j]=(int *)realloc(E->trace.ielement[j],inewsize*sizeof(int)))==NULL) {
+ fprintf(E->trace.fpt,"ERROR(expand tracer arrays )-no memory (ielement)\n");
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+
+ for (kk=0;kk<=((E->trace.number_of_basic_quantities)-1);kk++) {
+ if ((E->trace.basicq[j][kk]=(double *)realloc(E->trace.basicq[j][kk],inewsize*sizeof(double)))==NULL) {
+ fprintf(E->trace.fpt,"ERROR(expand tracer arrays )-no memory (%d)\n",kk);
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+ }
+
+ for (kk=0;kk<=((E->trace.number_of_extra_quantities)-1);kk++) {
+ if ((E->trace.extraq[j][kk]=(double *)realloc(E->trace.extraq[j][kk],inewsize*sizeof(double)))==NULL) {
+ fprintf(E->trace.fpt,"ERROR(expand tracer arrays )-no memory 78 (%d)\n",kk);
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+ }
+
+
+ fprintf(E->trace.fpt,"Expanding physical memory of ielement, basicq, and extraq to %d from %d\n",
+ inewsize,E->trace.max_ntracers[j]);
+
+ E->trace.max_ntracers[j]=inewsize;
+
+ return;
+}
+
+
+
+
+/****** REDUCE TRACER ARRAYS *****************************************/
+
+static void reduce_tracer_arrays(struct All_variables *E)
+{
+
+ int inewsize;
+ int kk;
+ int iempty_space;
+ int j;
+
+ int icushion=100;
+
+ for (j=1;j<=E->sphere.caps_per_proc;j++) {
+
+
+ /* if physical size is double tracer size, reduce it */
+
+ iempty_space=(E->trace.max_ntracers[j]-E->trace.ntracers[j]);
+
+ if (iempty_space>(E->trace.ntracers[j]+icushion)) {
+
+
+ inewsize=E->trace.ntracers[j]+E->trace.ntracers[j]/4+icushion;
+
+ if (inewsize<1) {
+ fprintf(E->trace.fpt,"Error(reduce tracer arrays)-something up (hdf3)\n");
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+
+
+ if ((E->trace.ielement[j]=(int *)realloc(E->trace.ielement[j],inewsize*sizeof(int)))==NULL) {
+ fprintf(E->trace.fpt,"ERROR(reduce tracer arrays )-no memory (ielement)\n");
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+
+
+ for (kk=0;kk<=((E->trace.number_of_basic_quantities)-1);kk++) {
+ if ((E->trace.basicq[j][kk]=(double *)realloc(E->trace.basicq[j][kk],inewsize*sizeof(double)))==NULL) {
+ fprintf(E->trace.fpt,"AKM(reduce tracer arrays )-no memory (%d)\n",kk);
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+ }
+
+ for (kk=0;kk<=((E->trace.number_of_extra_quantities)-1);kk++) {
+ if ((E->trace.extraq[j][kk]=(double *)realloc(E->trace.extraq[j][kk],inewsize*sizeof(double)))==NULL) {
+ fprintf(E->trace.fpt,"AKM(reduce tracer arrays )-no memory 783 (%d)\n",kk);
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+ }
+
+
+ fprintf(E->trace.fpt,"Reducing physical memory of ielement, basicq, and extraq to %d from %d\n",
+ E->trace.max_ntracers[j],inewsize);
+
+ E->trace.max_ntracers[j]=inewsize;
+
+ } /* end if */
+
+ } /* end j */
+
+ return;
+}
+
+
+/********** PUT AWAY LATER ************************************/
+/* */
+/* rlater has a similar structure to basicq */
+/* ilatersize is the physical memory and */
+/* ilater is the number of tracers */
+
+static void put_away_later(struct All_variables *E, int j, int it)
+{
+ int kk;
+
+
+ /* The first tracer in initiates memory allocation. */
+ /* Memory is freed after parallel communications */
+
+ if (E->trace.ilatersize[j]==0) {
+
+ E->trace.ilatersize[j]=E->trace.max_ntracers[j]/5;
+
+ for (kk=0;kk<=((E->trace.number_of_tracer_quantities)-1);kk++) {
+ if ((E->trace.rlater[j][kk]=(double *)malloc(E->trace.ilatersize[j]*sizeof(double)))==NULL) {
+ fprintf(E->trace.fpt,"AKM(put_away_later)-no memory (%d)\n",kk);
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+ }
+ } /* end first particle initiating memory allocation */
+
+
+ /* Put tracer in later array */
+
+ E->trace.ilater[j]++;
+
+ if (E->trace.ilater[j] >= (E->trace.ilatersize[j]-5)) expand_later_array(E,j);
+
+ /* stack basic and extra quantities together (basic first) */
+
+ for (kk=0;kk<=((E->trace.number_of_basic_quantities)-1);kk++)
+ E->trace.rlater[j][kk][E->trace.ilater[j]]=E->trace.basicq[j][kk][it];
+
+ for (kk=0;kk<=((E->trace.number_of_extra_quantities)-1);kk++)
+ E->trace.rlater[j][E->trace.number_of_basic_quantities+kk][E->trace.ilater[j]]=E->trace.extraq[j][kk][it];
+
+
+ return;
+}
+
+
+/****** EXPAND LATER ARRAY *****************************************/
+
+void expand_later_array(struct All_variables *E, int j)
+{
+
+ int inewsize;
+ int kk;
+ int icushion;
+
+ /* expand rlater by 20% */
+
+ icushion=100;
+
+ inewsize=E->trace.ilatersize[j]+E->trace.ilatersize[j]/5+icushion;
+
+ for (kk=0;kk<=((E->trace.number_of_tracer_quantities)-1);kk++) {
+ if ((E->trace.rlater[j][kk]=(double *)realloc(E->trace.rlater[j][kk],inewsize*sizeof(double)))==NULL) {
+ fprintf(E->trace.fpt,"AKM(expand later array )-no memory (%d)\n",kk);
+ fflush(E->trace.fpt);
+ exit(10);
+ }
+ }
+
+
+ fprintf(E->trace.fpt,"Expanding physical memory of rlater to %d from %d\n",
+ inewsize,E->trace.ilatersize[j]);
+
+ E->trace.ilatersize[j]=inewsize;
+
+ return;
+}
+
+
+/***** EJECT TRACER ************************************************/
+
+static void eject_tracer(struct All_variables *E, int j, int it)
+{
+
+ int ilast_tracer;
+ int kk;
+
+
+ ilast_tracer=E->trace.ntracers[j];
+
+ /* put last tracer in ejected tracer position */
+
+ E->trace.ielement[j][it]=E->trace.ielement[j][ilast_tracer];
+
+ for (kk=0;kk<=((E->trace.number_of_basic_quantities)-1);kk++)
+ E->trace.basicq[j][kk][it]=E->trace.basicq[j][kk][ilast_tracer];
+
+ for (kk=0;kk<=((E->trace.number_of_extra_quantities)-1);kk++)
+ E->trace.extraq[j][kk][it]=E->trace.extraq[j][kk][ilast_tracer];
+
+
+
+ E->trace.ntracers[j]--;
+
+ return;
+}
+
+
+
+/********** ICHECK PROCESSOR SHELL *************/
+/* returns -99 if rad is below current shell */
+/* returns 0 if rad is above current shell */
+/* returns 1 if rad is within current shell */
+/* */
+/* Shell, here, refers to processor shell */
+/* */
+/* shell is defined as bottom boundary up to */
+/* and not including the top boundary unless */
+/* the shell in question is the top shell */
+
+int icheck_processor_shell(struct All_variables *E,
+ int j, double rad)
+{
+
+ const int noz = E->lmesh.noz;
+ const int nprocz = E->parallel.nprocz;
+ double top_r, bottom_r;
+
+ if (nprocz==1) return 1;
+
+ top_r = E->sx[j][3][noz];
+ bottom_r = E->sx[j][3][1];
+
+ /* First check bottom */
+
+ if (rad<bottom_r) return -99;
+
+
+ /* Check top */
+
+ if (rad<top_r) return 1;
+
+ /* top processor */
+
+ if ( (rad<=top_r) && (E->parallel.me_loc[3]==nprocz-1) ) return 1;
+
+ /* If here, means point is above processor */
+ return 0;
+}
+
+
+/********* ICHECK THAT PROCESSOR SHELL ********/
+/* */
+/* Checks whether a given radius is within */
+/* a given processors radial domain. */
+/* Returns 0 if not, 1 if so. */
+/* The domain is defined as including the bottom */
+/* radius, but excluding the top radius unless */
+/* we the processor domain is the one that */
+/* is at the surface (then both boundaries are */
+/* included). */
+
+int icheck_that_processor_shell(struct All_variables *E,
+ int j, int nprocessor, double rad)
+{
+ int me = E->parallel.me;
+
+ /* nprocessor is right on top of me */
+ if (nprocessor == me+1) {
+ if (icheck_processor_shell(E, j, rad) == 0) return 1;
+ else return 0;
+ }
+
+ /* nprocessor is right on bottom of me */
+ if (nprocessor == me-1) {
+ if (icheck_processor_shell(E, j, rad) == -99) return 1;
+ else return 0;
+ }
+
+ /* Shouldn't be here */
+ fprintf(E->trace.fpt, "Should not be here\n");
+ fprintf(E->trace.fpt, "Error(check_shell) nprocessor: %d, radius: %f\n",
+ nprocessor, rad);
+ fflush(E->trace.fpt);
+ exit(10);
+
+ return 0;
+}
+
+
Deleted: mc/3D/CitcomS/branches/cxx/lib/Viscosity_structures.c
===================================================================
--- mc/3D/CitcomS/trunk/lib/Viscosity_structures.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/Viscosity_structures.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,1164 +0,0 @@
-/*
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- *
- *<LicenseText>
- *
- * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
- * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
- * Copyright (C) 1994-2005, California Institute of Technology.
- *
- * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- *</LicenseText>
- *
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- */
-/* Functions relating to the determination of viscosity field either
- as a function of the run, as an initial condition or as specified from
- a previous file */
-
-
-#include <math.h>
-#include <sys/types.h>
-#include "element_definitions.h"
-#include "global_defs.h"
-#include "parsing.h"
-
-
-void myerror(struct All_variables *,char *);
-
-static void apply_low_visc_wedge_channel(struct All_variables *E, float **evisc);
-static void low_viscosity_channel_factor(struct All_variables *E, float *F);
-static void low_viscosity_wedge_factor(struct All_variables *E, float *F);
-void parallel_process_termination();
-
-
-void viscosity_system_input(struct All_variables *E)
-{
- int m=E->parallel.me;
- int i;
-
- /* default values .... */
- for(i=0;i < CITCOM_MAX_VISC_LAYER;i++) {
- E->viscosity.N0[i]=1.0;
- E->viscosity.T[i] = 0.0;
- E->viscosity.Z[i] = 0.0;
- E->viscosity.E[i] = 0.0;
-
- E->viscosity.pdepv_a[i] = 1.e20; /* \sigma_y = min(a + b * (1-r),y) */
- E->viscosity.pdepv_b[i] = 0.0;
- E->viscosity.pdepv_y[i] = 1.e20;
-
-
- }
- for(i=0;i<10;i++)
- E->viscosity.cdepv_ff[i] = 1.0; /* flavor factors for CDEPV */
-
-
- /* read in information */
- input_boolean("VISC_UPDATE",&(E->viscosity.update_allowed),"on",m);
- input_int("rheol",&(E->viscosity.RHEOL),"3",m);
-
- input_float_vector("visc0",E->viscosity.num_mat,(E->viscosity.N0),m);
-
- input_boolean("TDEPV",&(E->viscosity.TDEPV),"on",m);
- if (E->viscosity.TDEPV) {
- input_float_vector("viscT",E->viscosity.num_mat,(E->viscosity.T),m);
- input_float_vector("viscE",E->viscosity.num_mat,(E->viscosity.E),m);
- input_float_vector("viscZ",E->viscosity.num_mat,(E->viscosity.Z),m);
- /* for viscosity 8 */
- input_float("T_sol0",&(E->viscosity.T_sol0),"0.6",m);
- input_float("ET_red",&(E->viscosity.ET_red),"0.1",m);
- }
-
-
- E->viscosity.sdepv_misfit = 1.0;
- input_boolean("SDEPV",&(E->viscosity.SDEPV),"off",m);
- if (E->viscosity.SDEPV) {
- E->viscosity.sdepv_visited = 0;
- input_float_vector("sdepv_expt",E->viscosity.num_mat,(E->viscosity.sdepv_expt),m);
- }
-
-
- input_boolean("PDEPV",&(E->viscosity.PDEPV),"off",m); /* plasticity addition by TWB */
- if (E->viscosity.PDEPV) {
- E->viscosity.pdepv_visited = 0;
-
- input_boolean("pdepv_eff",&(E->viscosity.pdepv_eff),"on",m);
- input_float_vector("pdepv_a",E->viscosity.num_mat,(E->viscosity.pdepv_a),m);
- input_float_vector("pdepv_b",E->viscosity.num_mat,(E->viscosity.pdepv_b),m);
- input_float_vector("pdepv_y",E->viscosity.num_mat,(E->viscosity.pdepv_y),m);
-
- input_float("pdepv_offset",&(E->viscosity.pdepv_offset),"0.0",m);
- }
- if(E->viscosity.PDEPV || E->viscosity.SDEPV)
- input_float("sdepv_misfit",&(E->viscosity.sdepv_misfit),"0.001",m);
-
-
- input_boolean("CDEPV",&(E->viscosity.CDEPV),"off",m);
- if(E->viscosity.CDEPV){
- /* compositional viscosity */
- if(E->control.tracer < 1){
- fprintf(stderr,"error: CDEPV requires tracers, but tracer is off\n");
- parallel_process_termination();
- }
- if(E->trace.nflavors > 10)
- myerror(E,"error: too many flavors for CDEPV");
- /* read in flavor factors */
- input_float_vector("cdepv_ff",E->trace.nflavors,
- (E->viscosity.cdepv_ff),m);
- /* and take the log because we're using a geometric avg */
- for(i=0;i<E->trace.nflavors;i++)
- E->viscosity.cdepv_ff[i] = log(E->viscosity.cdepv_ff[i]);
- }
-
-
- input_boolean("low_visc_channel",&(E->viscosity.channel),"off",m);
- input_boolean("low_visc_wedge",&(E->viscosity.wedge),"off",m);
-
- input_float("lv_min_radius",&(E->viscosity.lv_min_radius),"0.9764",m);
- input_float("lv_max_radius",&(E->viscosity.lv_max_radius),"0.9921",m);
- input_float("lv_channel_thickness",&(E->viscosity.lv_channel_thickness),"0.0047",m);
- input_float("lv_reduction",&(E->viscosity.lv_reduction),"0.5",m);
-
- input_boolean("VMAX",&(E->viscosity.MAX),"off",m);
- if (E->viscosity.MAX)
- input_float("visc_max",&(E->viscosity.max_value),"1e22,1,nomax",m);
-
- input_boolean("VMIN",&(E->viscosity.MIN),"off",m);
- if (E->viscosity.MIN)
- input_float("visc_min",&(E->viscosity.min_value),"1e20",m);
-
- return;
-}
-
-
-void viscosity_input(struct All_variables *E)
-{
- int m = E->parallel.me;
-
- input_string("Viscosity",E->viscosity.STRUCTURE,"system",m);
- input_int ("visc_smooth_method",&(E->viscosity.smooth_cycles),"0",m);
-
- if ( strcmp(E->viscosity.STRUCTURE,"system") == 0)
- E->viscosity.FROM_SYSTEM = 1;
- else
- E->viscosity.FROM_SYSTEM = 0;
-
- if (E->viscosity.FROM_SYSTEM)
- viscosity_system_input(E);
-
- return;
-}
-
-
-
-/* ============================================ */
-
-void get_system_viscosity(E,propogate,evisc,visc)
- struct All_variables *E;
- int propogate;
- float **evisc,**visc;
-{
- void visc_from_mat();
- void visc_from_T();
- void visc_from_S();
-
- void visc_from_P();
- void visc_from_C();
-
- void apply_viscosity_smoother();
- void visc_from_gint_to_nodes();
-
-
-
- int i,j,m;
- float temp1,temp2,*vvvis;
- double *TG;
-
- const int vpts = vpoints[E->mesh.nsd];
-
- if(E->viscosity.TDEPV)
- visc_from_T(E,evisc,propogate);
- else
- visc_from_mat(E,evisc);
-
- if(E->viscosity.CDEPV) /* compositional prefactor */
- visc_from_C(E,evisc);
-
- if(E->viscosity.SDEPV)
- visc_from_S(E,evisc,propogate);
-
- if(E->viscosity.PDEPV) /* "plasticity" */
- visc_from_P(E,evisc);
-
-
- /* i think this should me placed differently i.e. before the
- stress dependence but I won't change it because it's by
- someone else
-
- TWB
- */
- if(E->viscosity.channel || E->viscosity.wedge)
- apply_low_visc_wedge_channel(E, evisc);
-
-
- /* min/max cut-off */
-
- if(E->viscosity.MAX) {
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=1;i<=E->lmesh.nel;i++)
- for(j=1;j<=vpts;j++)
- if(evisc[m][(i-1)*vpts + j] > E->viscosity.max_value)
- evisc[m][(i-1)*vpts + j] = E->viscosity.max_value;
- }
-
- if(E->viscosity.MIN) {
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=1;i<=E->lmesh.nel;i++)
- for(j=1;j<=vpts;j++)
- if(evisc[m][(i-1)*vpts + j] < E->viscosity.min_value)
- evisc[m][(i-1)*vpts + j] = E->viscosity.min_value;
- }
-
- if (E->control.verbose) {
- fprintf(E->fp_out,"output_evisc \n");
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
- fprintf(E->fp_out,"output_evisc for cap %d\n",E->sphere.capid[m]);
- for(i=1;i<=E->lmesh.nel;i++)
- fprintf(E->fp_out,"%d %d %f %f\n",i,E->mat[m][i],evisc[m][(i-1)*vpts+1],evisc[m][(i-1)*vpts+7]);
- }
- fflush(E->fp_out);
- }
-
- /* interpolate from gauss quadrature points to node points for output */
- visc_from_gint_to_nodes(E,evisc,visc,E->mesh.levmax);
-
- return;
-}
-
-
-
-void initial_viscosity(struct All_variables *E)
-{
- if (E->viscosity.FROM_SYSTEM)
- get_system_viscosity(E,1,E->EVI[E->mesh.levmax],E->VI[E->mesh.levmax]);
-
- return;
-}
-
-
-void visc_from_mat(E,EEta)
- struct All_variables *E;
- float **EEta;
-{
-
- int i,m,jj;
-
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=1;i<=E->lmesh.nel;i++)
- for(jj=1;jj<=vpoints[E->mesh.nsd];jj++)
- EEta[m][ (i-1)*vpoints[E->mesh.nsd]+jj ] = E->viscosity.N0[E->mat[m][i]-1];
-
- return;
-}
-
-void visc_from_T(E,EEta,propogate)
- struct All_variables *E;
- float **EEta;
- int propogate;
-{
- int m,i,j,k,l,z,jj,kk,imark;
- float zero,e_6,one,eta0,Tave,depth,temp,tempa,temp1,TT[9];
- float zzz,zz[9],dr;
- float visc1, visc2, tempa_exp;
- const int vpts = vpoints[E->mesh.nsd];
- const int ends = enodes[E->mesh.nsd];
- const int nel = E->lmesh.nel;
-
- e_6 = 1.e-6;
- one = 1.0;
- zero = 0.0;
- imark = 0;
-
- /* consisntent handling : l is material number - 1 to allow
- addressing viscosity arrays, which are all 0...n-1 */
- switch (E->viscosity.RHEOL) {
- case 1: /* eta = N_0 exp( E * (T_0 - T)) */
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=1;i<=nel;i++) {
- l = E->mat[m][i] - 1;
-
- if(E->control.mat_control==0)
- tempa = E->viscosity.N0[l];
- else if(E->control.mat_control==1)
- tempa = E->viscosity.N0[l]*E->VIP[m][i];
-
- for(kk=1;kk<=ends;kk++) {
- TT[kk] = E->T[m][E->ien[m][i].node[kk]];
- }
-
- for(jj=1;jj<=vpts;jj++) {
- temp=0.0;
- for(kk=1;kk<=ends;kk++) {
- temp += TT[kk] * E->N.vpt[GNVINDEX(kk,jj)];
- }
-
- EEta[m][ (i-1)*vpts + jj ] = tempa*
- exp( E->viscosity.E[l] * (E->viscosity.T[l] - temp));
-
- }
- }
- break;
-
- case 2: /* eta = N_0 exp(-T/T_0) */
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=1;i<=nel;i++) {
- l = E->mat[m][i] - 1;
-
- if(E->control.mat_control==0)
- tempa = E->viscosity.N0[l];
- else if(E->control.mat_control==1)
- tempa = E->viscosity.N0[l]*E->VIP[m][i];
-
- for(kk=1;kk<=ends;kk++) {
- TT[kk] = E->T[m][E->ien[m][i].node[kk]];
- }
-
- for(jj=1;jj<=vpts;jj++) {
- temp=0.0;
- for(kk=1;kk<=ends;kk++) {
- temp += TT[kk] * E->N.vpt[GNVINDEX(kk,jj)];
- }
-
- EEta[m][ (i-1)*vpts + jj ] = tempa*
- exp( -temp / E->viscosity.T[l]);
-
- }
- }
- break;
-
- case 3: /* eta = N_0 exp(E/(T+T_0) - E/(1+T_0)) */
-
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=1;i<=nel;i++) {
- l = E->mat[m][i] - 1;
- if(E->control.mat_control) /* switch moved up here TWB */
- tempa = E->viscosity.N0[l] * E->VIP[m][i];
- else
- tempa = E->viscosity.N0[l];
- j = 0;
-
- for(kk=1;kk<=ends;kk++) {
- TT[kk] = E->T[m][E->ien[m][i].node[kk]];
- }
-
- for(jj=1;jj<=vpts;jj++) {
- temp=0.0;
- for(kk=1;kk<=ends;kk++) { /* took out
- computation of
- depth, not needed
- TWB */
- TT[kk]=max(TT[kk],zero);
- temp += min(TT[kk],one) * E->N.vpt[GNVINDEX(kk,jj)];
- }
- EEta[m][ (i-1)*vpts + jj ] = tempa*
- exp( E->viscosity.E[l]/(temp+E->viscosity.T[l])
- - E->viscosity.E[l]/(one +E->viscosity.T[l]) );
- }
- }
- break;
-
- case 4:
- /* eta = N_0 exp( (E + (1-z)Z_0) / (T+T_0) ) */
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=1;i<=nel;i++) {
- l = E->mat[m][i] - 1;
- if(E->control.mat_control) /* moved this up here TWB */
- tempa = E->viscosity.N0[l] * E->VIP[m][i];
- else
- tempa = E->viscosity.N0[l];
-
- j = 0;
-
- for(kk=1;kk<=ends;kk++) {
- TT[kk] = E->T[m][E->ien[m][i].node[kk]];
- zz[kk] = (1.-E->sx[m][3][E->ien[m][i].node[kk]]);
- }
-
- for(jj=1;jj<=vpts;jj++) {
- temp=0.0;
- zzz=0.0;
- for(kk=1;kk<=ends;kk++) {
- TT[kk]=max(TT[kk],zero);
- temp += min(TT[kk],one) * E->N.vpt[GNVINDEX(kk,jj)];
- zzz += zz[kk] * E->N.vpt[GNVINDEX(kk,jj)];
- }
-
-
- EEta[m][ (i-1)*vpts + jj ] = tempa*
- exp( (E->viscosity.E[l] + E->viscosity.Z[l]*zzz )
- / (E->viscosity.T[l]+temp) );
-
- }
- }
- break;
-
-
- case 5:
-
- /* same as rheol 3, except alternative margin, VIP, formulation */
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=1;i<=nel;i++) {
- l = E->mat[m][i] - 1;
- tempa = E->viscosity.N0[l];
- /* fprintf(stderr,"\nINSIDE visc_from_T, l=%d, tempa=%g",l+1,tempa);*/
- j = 0;
-
- for(kk=1;kk<=ends;kk++) {
- TT[kk] = E->T[m][E->ien[m][i].node[kk]];
- /* zz[kk] = (1.-E->sx[m][3][E->ien[m][i].node[kk]]); */
- }
-
- for(jj=1;jj<=vpts;jj++) {
- temp=0.0;
- /* zzz=0.0; */
- for(kk=1;kk<=ends;kk++) {
- TT[kk]=max(TT[kk],zero);
- temp += min(TT[kk],one) * E->N.vpt[GNVINDEX(kk,jj)];
- /* zzz += zz[kk] * E->N.vpt[GNVINDEX(kk,jj)]; */
- }
-
- if(E->control.mat_control==0)
- EEta[m][ (i-1)*vpts + jj ] = tempa*
- exp( E->viscosity.E[l]/(temp+E->viscosity.T[l])
- - E->viscosity.E[l]/(one +E->viscosity.T[l]) );
-
- if(E->control.mat_control==1) {
- visc2 = tempa*
- exp( E->viscosity.E[l]/(temp+E->viscosity.T[l])
- - E->viscosity.E[l]/(one +E->viscosity.T[l]) );
- if(E->viscosity.MAX) {
- if(visc2 > E->viscosity.max_value)
- visc2 = E->viscosity.max_value;
- }
- if(E->viscosity.MIN) {
- if(visc2 < E->viscosity.min_value)
- visc2 = E->viscosity.min_value;
- }
- EEta[m][ (i-1)*vpts + jj ] = E->VIP[m][i]*visc2;
- }
-
- }
- }
- break;
-
-
- case 6: /*
- like case 1, but allowing for depth-dependence if Z_0 != 0
-
- eta = N_0 exp(E(T_0-T) + (1-z) Z_0 )
-
- */
-
- for(m=1;m <= E->sphere.caps_per_proc;m++)
- for(i=1;i <= nel;i++) {
-
- l = E->mat[m][i] - 1;
-
- if(E->control.mat_control)
- tempa = E->viscosity.N0[l] * E->VIP[m][i];
- else
- tempa = E->viscosity.N0[l];
- j = 0;
-
- for(kk=1;kk<=ends;kk++) {
- TT[kk] = E->T[m][E->ien[m][i].node[kk]];
- zz[kk] = (1.0 - E->sx[m][3][E->ien[m][i].node[kk]]);
- }
-
- for(jj=1;jj <= vpts;jj++) {
- temp=0.0;zzz=0.0;
- for(kk=1;kk <= ends;kk++) {
- TT[kk]=max(TT[kk],zero);
- temp += min(TT[kk],one) * E->N.vpt[GNVINDEX(kk,jj)];
- zzz += zz[kk] * E->N.vpt[GNVINDEX(kk,jj)];
- }
- EEta[m][ (i-1)*vpts + jj ] = tempa*
- exp( E->viscosity.E[l]*(E->viscosity.T[l] - temp) +
- zzz * E->viscosity.Z[l]);
- //if(E->parallel.me == 0)
- // fprintf(stderr,"z %11g km mat %i N0 %11g T %11g T0 %11g E %11g Z %11g mat: %i log10(eta): %11g\n",
- // zzz *E->data.radius_km ,l+1,
- // tempa,temp,E->viscosity.T[l],E->viscosity.E[l], E->viscosity.Z[l],l+1,log10(EEta[m][ (i-1)*vpts + jj ]));
- }
- }
- break;
-
-
- case 7:
-
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=1;i<=nel;i++) {
- l = E->mat[m][i] - 1;
-
- if(E->control.mat_control)
- tempa = E->viscosity.N0[l] * E->VIP[m][i];
- else
- tempa = E->viscosity.N0[l];
-
- j = 0;
-
- for(kk=1;kk<=ends;kk++) {
- TT[kk] = E->T[m][E->ien[m][i].node[kk]];
- zz[kk] = (1.-E->sx[m][3][E->ien[m][i].node[kk]]);
- }
-
- for(jj=1;jj<=vpts;jj++) {
- temp=0.0;
- zzz=0.0;
- for(kk=1;kk<=ends;kk++) {
- temp += TT[kk] * E->N.vpt[GNVINDEX(kk,jj)];
- zzz += zz[kk] * E->N.vpt[GNVINDEX(kk,jj)];
- }
-
- /* The viscosity formulation (dimensional) is:
- visc=visc0*exp[(Ea+p*Va)/(R*T)]
-
- Typical values for dry upper mantle are:
- Ea = 300 KJ/mol ; Va = 1.e-5 m^3/mol
-
- T=DT*(T0+T');
- where DT - temperature contrast (from Rayleigh number)
- T' - nondimensional temperature;
- T0 - nondimensional surface tempereture;
-
- =>
- visc = visc0 * exp{(Ea+p*Va) / [R*DT*(T0 + T')]}
- = visc0 * exp{[Ea/(R*DT) + p*Va/(R*DT)] / (T0 + T')}
-
- so:
- E->viscosity.E = Ea/(R*DT);
- (1-r) = p/(rho*g);
- E->viscosity.Z = Va*rho*g/(R*DT);
- E->viscosity.T = T0;
-
- after normalizing visc=1 at T'=1 and r=r_CMB:
- visc=visc0*exp{ [viscE + (1-r)*viscZ] / (viscT+T')
- - [viscE + (1-r_CMB)*viscZ] / (viscT+1) }
- */
-
- EEta[m][ (i-1)*vpts + jj ] = tempa*
- exp( (E->viscosity.E[l] + E->viscosity.Z[l]*zzz )
- / (E->viscosity.T[l] + temp)
- - (E->viscosity.E[l] +
- E->viscosity.Z[l]*(E->sphere.ro-E->sphere.ri) )
- / (E->viscosity.T[l] + one) );
- }
- }
- break;
-
- case 8: /*
- eta0 = N_0 exp(E/(T+T_0) - E/(1+T_0))
-
- eta = eta0 if T < T_sol0 + 2(1-z)
- eta = ET_red*eta0 if T >= T_sol0 + 2(1-z)
-
- where z is normalized by layer
- thickness, and T_sol0 is something
- like 0.6, and ET_red = 0.1
-
- (same as case 3, but for viscosity reduction)
-
- */
- dr = E->sphere.ro - E->sphere.ri;
- for(m=1;m<=E->sphere.caps_per_proc;m++)
- for(i=1;i<=nel;i++) {
- l = E->mat[m][i] - 1;
- if(E->control.mat_control)
- tempa = E->viscosity.N0[l] * E->VIP[m][i];
- else
- tempa = E->viscosity.N0[l];
- j = 0;
-
- for(kk=1;kk<=ends;kk++) {
- TT[kk] = E->T[m][E->ien[m][i].node[kk]];
- zz[kk] = E->sx[m][3][E->ien[m][i].node[kk]]; /* radius */
- }
-
- for(jj=1;jj<=vpts;jj++) {
- temp=zzz=0.0;
- for(kk=1;kk<=ends;kk++) {
- TT[kk]=max(TT[kk],zero);
- temp += min(TT[kk],one) * E->N.vpt[GNVINDEX(kk,jj)]; /* mean temp */
- zzz += zz[kk] * E->N.vpt[GNVINDEX(kk,jj)];/* mean r */
- }
- /* convert to z, as defined to be unity at surface
- and zero at CMB */
- zzz = (zzz - E->sphere.ri)/dr;
- visc1 = tempa* exp( E->viscosity.E[l]/(temp+E->viscosity.T[l])
- - E->viscosity.E[l]/(one +E->viscosity.T[l]) );
- if(temp < E->viscosity.T_sol0 + 2.*(1.-zzz))
- EEta[m][ (i-1)*vpts + jj ] = visc1;
- else
- EEta[m][ (i-1)*vpts + jj ] = visc1 * E->viscosity.ET_red;
- }
- }
- break;
-
- case 100:
- /* user-defined viscosity law goes here */
- fprintf(stderr, "Need user definition for viscosity law: 'rheol=%d'\n",
- E->viscosity.RHEOL);
- parallel_process_termination();
- break;
-
- default:
- /* unknown option */
- fprintf(stderr, "Invalid value of 'rheol=%d'\n", E->viscosity.RHEOL);
-
- parallel_process_termination();
- break;
- }
-
-
- return;
-}
-
-
-void visc_from_S(E,EEta,propogate)
- struct All_variables *E;
- float **EEta;
- int propogate;
-{
- float one,two,scale,stress_magnitude,depth,exponent1;
- float *eedot;
-
- void strain_rate_2_inv();
- int m,e,l,z,jj,kk;
-
- const int vpts = vpoints[E->mesh.nsd];
- const int nel = E->lmesh.nel;
-
- eedot = (float *) malloc((2+nel)*sizeof(float));
- one = 1.0;
- two = 2.0;
-
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
- if(E->viscosity.sdepv_visited){
-
- /* get second invariant for all elements */
- strain_rate_2_inv(E,m,eedot,1);
- }else{
- for(e=1;e<=nel;e++) /* initialize with unity if no velocities around */
- eedot[e] = 1.0;
- E->viscosity.sdepv_visited = 1;
-
- }
- /* eedot cannot be too small, or the viscosity will go to inf */
- for(e=1;e<=nel;e++){
- eedot[e] = max(eedot[e], 1.0e-16);
- }
-
- for(e=1;e<=nel;e++) {
- exponent1= one/E->viscosity.sdepv_expt[E->mat[m][e]-1];
- scale=pow(eedot[e],exponent1-one);
- for(jj=1;jj<=vpts;jj++)
- EEta[m][(e-1)*vpts + jj] = scale*pow(EEta[m][(e-1)*vpts+jj],exponent1);
- }
- }
-
- free ((void *)eedot);
- return;
-}
-
-void visc_from_P(E,EEta) /* "plasticity" implementation
-
- viscosity will be limited by a yield stress
-
- \sigma_y = min(a + b * (1-r), y)
-
- where a,b,y are parameters input via pdepv_a,b,y
-
- and
-
- \eta_y = \sigma_y / (2 \eps_II)
-
- where \eps_II is the second invariant. Then
-
- \eta_eff = (\eta_0 \eta_y)/(\eta_0 + \eta_y)
-
- for pdepv_eff = 1
-
- or
-
- \eta_eff = min(\eta_0,\eta_y)
-
- for pdepv_eff = 0
-
- where \eta_0 is the regular viscosity
-
-
- TWB
-
- */
- struct All_variables *E;
- float **EEta;
-{
- float *eedot,zz[9],zzz,tau,eta_p,eta_new;
- int m,e,l,z,jj,kk;
-
- const int vpts = vpoints[E->mesh.nsd];
- const int nel = E->lmesh.nel;
- const int ends = enodes[E->mesh.nsd];
-
- void strain_rate_2_inv();
-
- eedot = (float *) malloc((2+nel)*sizeof(float));
-
- for(m=1;m<=E->sphere.caps_per_proc;m++) {
-
- if(E->viscosity.pdepv_visited){
-
- strain_rate_2_inv(E,m,eedot,1); /* get second invariant for all elements */
-
- }else{
- for(e=1;e<=nel;e++) /* initialize with unity if no velocities around */
- eedot[e] = 1.0;
- if(m == E->sphere.caps_per_proc)
- E->viscosity.pdepv_visited = 1;
- if((E->parallel.me == 0)&&(E->control.verbose)){
- for(e=0;e < E->viscosity.num_mat;e++)
- fprintf(stderr,"num mat: %i a: %g b: %g y: %g\n",
- e,E->viscosity.pdepv_a[e],E->viscosity.pdepv_b[e],E->viscosity.pdepv_y[e]);
- }
- }
-
- for(e=1;e <= nel;e++) { /* loop through all elements */
-
- l = E->mat[m][e] -1 ; /* material of this element */
-
- for(kk=1;kk <= ends;kk++) /* nodal depths */
- zz[kk] = (1.0 - E->sx[m][3][E->ien[m][e].node[kk]]); /* for depth, zz = 1 - r */
-
- for(jj=1;jj <= vpts;jj++){ /* loop through integration points */
-
- zzz = 0.0; /* get mean depth of integration point */
- for(kk=1;kk<=ends;kk++)
- zzz += zz[kk] * E->N.vpt[GNVINDEX(kk,jj)];
-
- /* depth dependent yield stress */
- tau = E->viscosity.pdepv_a[l] + zzz * E->viscosity.pdepv_b[l];
-
- /* min of depth dep. and constant yield stress */
- tau = min(tau, E->viscosity.pdepv_y[l]);
-
- /* yield viscosity */
- eta_p = tau/(2.0 * eedot[e] + 1e-7) + E->viscosity.pdepv_offset;
-
-
- if(E->viscosity.pdepv_eff){
- /* two dashpots in series */
- eta_new = 1.0/(1.0/EEta[m][ (e-1)*vpts + jj ] + 1.0/eta_p);
- }else{
- /* min viscosities*/
- eta_new = min(EEta[m][ (e-1)*vpts + jj ], eta_p);
- }
- //fprintf(stderr,"z: %11g mat: %i a: %11g b: %11g y: %11g ee: %11g tau: %11g eta_p: %11g eta_new: %11g eta_old: %11g\n",
- //zzz,l,E->viscosity.pdepv_a[l], E->viscosity.pdepv_b[l],E->viscosity.pdepv_y[l],
- //eedot[e],tau,eta_p,eta_new,EEta[m][(e-1)*vpts + jj]);
- EEta[m][(e-1)*vpts + jj] = eta_new;
- } /* end integration point loop */
- } /* end element loop */
-
- } /* end caps loop */
- free ((void *)eedot);
- return;
-}
-
-/*
-
-multiply with compositional factor which is determined by a geometric
-mean average from the tracer composition, assuming two flavors and
-compositions between zero and unity
-
-*/
-void visc_from_C( E, EEta)
- struct All_variables *E;
- float **EEta;
-{
- double vmean,cc_loc[10],CC[10][9],cbackground;
- int m,l,z,jj,kk,i,p,q;
-
-
- const int vpts = vpoints[E->mesh.nsd];
- const int nel = E->lmesh.nel;
- const int ends = enodes[E->mesh.nsd];
-
- for(m=1;m <= E->sphere.caps_per_proc;m++) {
- for(i = 1; i <= nel; i++){
- /* determine composition of each of the nodes of the
- element */
- for(p=0; p<E->composition.ncomp; p++) {
- for(kk = 1; kk <= ends; kk++){
- CC[p][kk] = E->composition.comp_node[m][p][E->ien[m][i].node[kk]];
- if(CC[p][kk] < 0)CC[p][kk]=0.0;
- if(CC[p][kk] > 1)CC[p][kk]=1.0;
- }
- }
- for(jj = 1; jj <= vpts; jj++) {
- /* concentration of background material */
- cbackground = 1;
- for(p=0; p<E->composition.ncomp; p++) {
- /* compute mean composition */
- cc_loc[p] = 0.0;
- for(kk = 1; kk <= ends; kk++) {
- cc_loc[p] += CC[p][kk] * E->N.vpt[GNVINDEX(kk, jj)];
- }
- cbackground -= cc_loc[p];
- }
-
- /* geometric mean of viscosity */
- vmean = cbackground * E->viscosity.cdepv_ff[0];
- for(p=0; p<E->composition.ncomp; p++) {
- vmean += cc_loc[p] * E->viscosity.cdepv_ff[p+1];
- }
- vmean = exp(vmean);
-
- /* multiply the viscosity with this prefactor */
- EEta[m][ (i-1)*vpts + jj ] *= vmean;
-
- } /* end jj loop */
- } /* end el loop */
- } /* end cap */
-}
-
-void strain_rate_2_inv(E,m,EEDOT,SQRT)
- struct All_variables *E;
- float *EEDOT;
- int m,SQRT;
-{
- void get_rtf_at_ppts();
- void velo_from_element();
- void construct_c3x3matrix_el();
- void get_ba_p();
-
- struct Shape_function_dx *GNx;
-
- double edot[4][4], rtf[4][9];
- double theta;
- double ba[9][9][4][7];
- float VV[4][9], Vxyz[7][9], dilation[9];
-
- int e, i, j, p, q, n;
-
- const int nel = E->lmesh.nel;
- const int dims = E->mesh.nsd;
- const int ends = enodes[dims];
- const int lev = E->mesh.levmax;
- const int ppts = ppoints[dims];
- const int sphere_key = 1;
-
-
- for(e=1; e<=nel; e++) {
-
- get_rtf_at_ppts(E, m, lev, e, rtf);
- velo_from_element(E, VV, m, e, sphere_key);
- GNx = &(E->gNX[m][e]);
-
- theta = rtf[1][1];
-
-
- /* Vxyz is the strain rate vector, whose relationship with
- * the strain rate tensor (e) is that:
- * Vxyz[1] = e11
- * Vxyz[2] = e22
- * Vxyz[3] = e33
- * Vxyz[4] = 2*e12
- * Vxyz[5] = 2*e13
- * Vxyz[6] = 2*e23
- * where 1 is theta, 2 is phi, and 3 is r
- */
- for(j=1; j<=ppts; j++) {
- Vxyz[1][j] = 0.0;
- Vxyz[2][j] = 0.0;
- Vxyz[3][j] = 0.0;
- Vxyz[4][j] = 0.0;
- Vxyz[5][j] = 0.0;
- Vxyz[6][j] = 0.0;
- dilation[j] = 0.0;
- }
-
- if ((theta < 0.09) || (theta > 3.05)) {
- /* When the element is close to the poles, use a more
- * precise method to compute the strain rate. */
-
- if ((e-1)%E->lmesh.elz==0) {
- construct_c3x3matrix_el(E,e,&E->element_Cc,&E->element_Ccx,lev,m,1);
- }
-
- get_ba_p(&(E->N), GNx, &E->element_Cc, &E->element_Ccx,
- rtf, E->mesh.nsd, ba);
-
- for(j=1;j<=ppts;j++)
- for(p=1;p<=6;p++)
- for(i=1;i<=ends;i++)
- for(q=1;q<=dims;q++) {
- Vxyz[p][j] += ba[i][j][q][p] * VV[q][i];
- }
-
- }
- else {
- for(j=1; j<=ppts; j++) {
- for(i=1; i<=ends; i++) {
- Vxyz[1][j] += (VV[1][i] * GNx->ppt[GNPXINDEX(0, i, j)]
- + VV[3][i] * E->N.ppt[GNPINDEX(i, j)])
- * rtf[3][j];
- Vxyz[2][j] += ((VV[2][i] * GNx->ppt[GNPXINDEX(1, i, j)]
- + VV[1][i] * E->N.ppt[GNPINDEX(i, j)]
- * cos(rtf[1][j])) / sin(rtf[1][j])
- + VV[3][i] * E->N.ppt[GNPINDEX(i, j)])
- * rtf[3][j];
- Vxyz[3][j] += VV[3][i] * GNx->ppt[GNPXINDEX(2, i, j)];
-
- Vxyz[4][j] += ((VV[1][i] * GNx->ppt[GNPXINDEX(1, i, j)]
- - VV[2][i] * E->N.ppt[GNPINDEX(i, j)]
- * cos(rtf[1][j])) / sin(rtf[1][j])
- + VV[2][i] * GNx->ppt[GNPXINDEX(0, i, j)])
- * rtf[3][j];
- Vxyz[5][j] += VV[1][i] * GNx->ppt[GNPXINDEX(2, i, j)]
- + rtf[3][j] * (VV[3][i] * GNx->ppt[GNPXINDEX(0, i, j)]
- - VV[1][i] * E->N.ppt[GNPINDEX(i, j)]);
- Vxyz[6][j] += VV[2][i] * GNx->ppt[GNPXINDEX(2, i, j)]
- + rtf[3][j] * (VV[3][i]
- * GNx->ppt[GNPXINDEX(1, i, j)]
- / sin(rtf[1][j])
- - VV[2][i] * E->N.ppt[GNPINDEX(i, j)]);
- }
- }
- } /* end of else */
-
- if(E->control.inv_gruneisen != 0) {
- for(j=1; j<=ppts; j++)
- dilation[j] = (Vxyz[1][j] + Vxyz[2][j] + Vxyz[3][j]) / 3.0;
- }
-
- edot[1][1] = edot[2][2] = edot[3][3] = 0;
- edot[1][2] = edot[1][3] = edot[2][3] = 0;
-
- /* edot is 2 * (the deviatoric strain rate tensor) */
- for(j=1; j<=ppts; j++) {
- edot[1][1] += 2.0 * (Vxyz[1][j] - dilation[j]);
- edot[2][2] += 2.0 * (Vxyz[2][j] - dilation[j]);
- edot[3][3] += 2.0 * (Vxyz[3][j] - dilation[j]);
- edot[1][2] += Vxyz[4][j];
- edot[1][3] += Vxyz[5][j];
- edot[2][3] += Vxyz[6][j];
- }
-
- EEDOT[e] = edot[1][1] * edot[1][1]
- + edot[1][2] * edot[1][2] * 2.0
- + edot[2][2] * edot[2][2]
- + edot[2][3] * edot[2][3] * 2.0
- + edot[3][3] * edot[3][3]
- + edot[1][3] * edot[1][3] * 2.0;
- }
-
- if(SQRT)
- for(e=1;e<=nel;e++)
- EEDOT[e] = sqrt(0.5 *EEDOT[e]);
- else
- for(e=1;e<=nel;e++)
- EEDOT[e] *= 0.5;
-
- return;
-}
-
-
-static void apply_low_visc_wedge_channel(struct All_variables *E, float **evisc)
-{
- void parallel_process_termination();
-
- int i,j,m;
- const int vpts = vpoints[E->mesh.nsd];
- float *F;
-
- /* low viscosity channel/wedge require tracers to work */
- if(E->control.tracer == 0) {
- if(E->parallel.me == 0) {
- fprintf(stderr, "Error: low viscosity channel/wedge is turned on, "
- "but tracer is off!\n");
- fprintf(E->fp, "Error: low viscosity channel/wedge is turned on, "
- "but tracer is off!\n");
- fflush(E->fp);
- }
- parallel_process_termination();
- }
-
-
- F = (float *)malloc((E->lmesh.nel+1)*sizeof(float));
- for(i=1 ; i<=E->lmesh.nel ; i++)
- F[i] = 0.0;
-
- /* if low viscosity channel ... */
- if(E->viscosity.channel)
- low_viscosity_channel_factor(E, F);
-
-
- /* if low viscosity wedge ... */
- if(E->viscosity.wedge)
- low_viscosity_wedge_factor(E, F);
-
-
- for(i=1 ; i<=E->lmesh.nel ; i++) {
- if (F[i] != 0.0)
- for(m = 1 ; m <= E->sphere.caps_per_proc ; m++) {
- for(j=1;j<=vpts;j++) {
- evisc[m][(i-1)*vpts + j] = F[i];
- }
- }
- }
-
-
- free(F);
-
- return;
-}
-
-
-
-
-static void low_viscosity_channel_factor(struct All_variables *E, float *F)
-{
- int i, ii, k, m, e, ee;
- int nz_min[NCS], nz_max[NCS];
- const int flavor = 0;
- double rad_mean, rr;
-
- for(m=1; m<=E->sphere.caps_per_proc; m++) {
- /* find index of radius corresponding to lv_min_radius */
- for(e=1; e<=E->lmesh.elz; e++) {
- rad_mean = 0.5 * (E->sx[m][3][E->ien[m][e].node[1]] +
- E->sx[m][3][E->ien[m][e].node[8]]);
- if(rad_mean >= E->viscosity.lv_min_radius) break;
- }
- nz_min[m] = e;
-
- /* find index of radius corresponding to lv_max_radius */
- for(e=E->lmesh.elz; e>=1; e--) {
- rad_mean = 0.5 * (E->sx[m][3][E->ien[m][e].node[1]] +
- E->sx[m][3][E->ien[m][e].node[8]]);
- if(rad_mean <= E->viscosity.lv_max_radius) break;
- }
- nz_max[m] = e;
- }
-
-
-
- for(m=1; m<=E->sphere.caps_per_proc; m++) {
- for(k=1; k<=E->lmesh.elx*E->lmesh.ely; k++) {
- for(i=nz_min[m]; i<=nz_max[m]; i++) {
- e = (k-1)*E->lmesh.elz + i;
-
- rad_mean = 0.5 * (E->sx[m][3][E->ien[m][e].node[1]] +
- E->sx[m][3][E->ien[m][e].node[8]]);
-
- /* loop over elements below e */
- for(ii=i; ii>=nz_min[m]; ii--) {
- ee = (k-1)*E->lmesh.elz + ii;
-
- rr = 0.5 * (E->sx[m][3][E->ien[m][ee].node[1]] +
- E->sx[m][3][E->ien[m][ee].node[8]]);
-
- /* if ee has tracers in it and is within the channel */
- if((E->trace.ntracer_flavor[m][flavor][ee] > 0) &&
- (rad_mean <= rr + E->viscosity.lv_channel_thickness)) {
- F[e] = E->viscosity.lv_reduction;
- break;
- }
- }
- }
- }
- }
-
-
- /** debug **
- for(m=1; m<=E->sphere.caps_per_proc; m++)
- for(e=1; e<=E->lmesh.nel; e++)
- fprintf(stderr, "lv_reduction: %d %e\n", e, F[e]);
- /**/
-
- return;
-}
-
-
-static void low_viscosity_wedge_factor(struct All_variables *E, float *F)
-{
- int i, ii, k, m, e, ee;
- int nz_min[NCS], nz_max[NCS];
- const int flavor = 0;
- double rad_mean, rr;
-
- for(m=1; m<=E->sphere.caps_per_proc; m++) {
- /* find index of radius corresponding to lv_min_radius */
- for(e=1; e<=E->lmesh.elz; e++) {
- rad_mean = 0.5 * (E->sx[m][3][E->ien[m][e].node[1]] +
- E->sx[m][3][E->ien[m][e].node[8]]);
- if(rad_mean >= E->viscosity.lv_min_radius) break;
- }
- nz_min[m] = e;
-
- /* find index of radius corresponding to lv_max_radius */
- for(e=E->lmesh.elz; e>=1; e--) {
- rad_mean = 0.5 * (E->sx[m][3][E->ien[m][e].node[1]] +
- E->sx[m][3][E->ien[m][e].node[8]]);
- if(rad_mean <= E->viscosity.lv_max_radius) break;
- }
- nz_max[m] = e;
- }
-
-
-
- for(m=1; m<=E->sphere.caps_per_proc; m++) {
- for(k=1; k<=E->lmesh.elx*E->lmesh.ely; k++) {
- for(i=nz_min[m]; i<=nz_max[m]; i++) {
- e = (k-1)*E->lmesh.elz + i;
-
- rad_mean = 0.5 * (E->sx[m][3][E->ien[m][e].node[1]] +
- E->sx[m][3][E->ien[m][e].node[8]]);
-
- /* loop over elements below e */
- for(ii=i; ii>=nz_min[m]; ii--) {
- ee = (k-1)*E->lmesh.elz + ii;
-
- /* if ee has tracers in it */
- if(E->trace.ntracer_flavor[m][flavor][ee] > 0) {
- F[e] = E->viscosity.lv_reduction;
- break;
- }
- }
- }
- }
- }
-
-
- /** debug **
- for(m=1; m<=E->sphere.caps_per_proc; m++)
- for(e=1; e<=E->lmesh.nel; e++)
- fprintf(stderr, "lv_reduction: %d %e\n", e, F[e]);
- /**/
-
- return;
-}
Copied: mc/3D/CitcomS/branches/cxx/lib/Viscosity_structures.cc (from rev 14029, mc/3D/CitcomS/trunk/lib/Viscosity_structures.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/Viscosity_structures.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/Viscosity_structures.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,1153 @@
+/*
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ *<LicenseText>
+ *
+ * CitcomS by Louis Moresi, Shijie Zhong, Lijie Han, Eh Tan,
+ * Clint Conrad, Michael Gurnis, and Eun-seo Choi.
+ * Copyright (C) 1994-2005, California Institute of Technology.
+ *
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ *</LicenseText>
+ *
+ *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ */
+/* Functions relating to the determination of viscosity field either
+ as a function of the run, as an initial condition or as specified from
+ a previous file */
+
+
+#include <math.h>
+#include <string.h>
+#include <sys/types.h>
+#include "element_definitions.h"
+#include "global_defs.h"
+#include "parsing.h"
+
+#include "cproto.h"
+
+
+void myerror(struct All_variables *,char *);
+
+static void apply_low_visc_wedge_channel(struct All_variables *E, float **evisc);
+static void low_viscosity_channel_factor(struct All_variables *E, float *F);
+static void low_viscosity_wedge_factor(struct All_variables *E, float *F);
+void parallel_process_termination();
+
+
+void viscosity_system_input(struct All_variables *E)
+{
+ int m=E->parallel.me;
+ int i;
+
+ /* default values .... */
+ for(i=0;i < CITCOM_MAX_VISC_LAYER;i++) {
+ E->viscosity.N0[i]=1.0;
+ E->viscosity.T[i] = 0.0;
+ E->viscosity.Z[i] = 0.0;
+ E->viscosity.E[i] = 0.0;
+
+ E->viscosity.pdepv_a[i] = 1.e20; /* \sigma_y = min(a + b * (1-r),y) */
+ E->viscosity.pdepv_b[i] = 0.0;
+ E->viscosity.pdepv_y[i] = 1.e20;
+
+
+ }
+ for(i=0;i<10;i++)
+ E->viscosity.cdepv_ff[i] = 1.0; /* flavor factors for CDEPV */
+
+
+ /* read in information */
+ input_boolean("VISC_UPDATE",&(E->viscosity.update_allowed),"on",m);
+ input_int("rheol",&(E->viscosity.RHEOL),"3",m);
+
+ input_float_vector("visc0",E->viscosity.num_mat,(E->viscosity.N0),m);
+
+ input_boolean("TDEPV",&(E->viscosity.TDEPV),"on",m);
+ if (E->viscosity.TDEPV) {
+ input_float_vector("viscT",E->viscosity.num_mat,(E->viscosity.T),m);
+ input_float_vector("viscE",E->viscosity.num_mat,(E->viscosity.E),m);
+ input_float_vector("viscZ",E->viscosity.num_mat,(E->viscosity.Z),m);
+ /* for viscosity 8 */
+ input_float("T_sol0",&(E->viscosity.T_sol0),"0.6",m);
+ input_float("ET_red",&(E->viscosity.ET_red),"0.1",m);
+ }
+
+
+ E->viscosity.sdepv_misfit = 1.0;
+ input_boolean("SDEPV",&(E->viscosity.SDEPV),"off",m);
+ if (E->viscosity.SDEPV) {
+ E->viscosity.sdepv_visited = 0;
+ input_float_vector("sdepv_expt",E->viscosity.num_mat,(E->viscosity.sdepv_expt),m);
+ }
+
+
+ input_boolean("PDEPV",&(E->viscosity.PDEPV),"off",m); /* plasticity addition by TWB */
+ if (E->viscosity.PDEPV) {
+ E->viscosity.pdepv_visited = 0;
+
+ input_boolean("pdepv_eff",&(E->viscosity.pdepv_eff),"on",m);
+ input_float_vector("pdepv_a",E->viscosity.num_mat,(E->viscosity.pdepv_a),m);
+ input_float_vector("pdepv_b",E->viscosity.num_mat,(E->viscosity.pdepv_b),m);
+ input_float_vector("pdepv_y",E->viscosity.num_mat,(E->viscosity.pdepv_y),m);
+
+ input_float("pdepv_offset",&(E->viscosity.pdepv_offset),"0.0",m);
+ }
+ if(E->viscosity.PDEPV || E->viscosity.SDEPV)
+ input_float("sdepv_misfit",&(E->viscosity.sdepv_misfit),"0.001",m);
+
+
+ input_boolean("CDEPV",&(E->viscosity.CDEPV),"off",m);
+ if(E->viscosity.CDEPV){
+ /* compositional viscosity */
+ if(E->control.tracer < 1){
+ fprintf(stderr,"error: CDEPV requires tracers, but tracer is off\n");
+ parallel_process_termination();
+ }
+ if(E->trace.nflavors > 10)
+ myerror(E,"error: too many flavors for CDEPV");
+ /* read in flavor factors */
+ input_float_vector("cdepv_ff",E->trace.nflavors,
+ (E->viscosity.cdepv_ff),m);
+ /* and take the log because we're using a geometric avg */
+ for(i=0;i<E->trace.nflavors;i++)
+ E->viscosity.cdepv_ff[i] = log(E->viscosity.cdepv_ff[i]);
+ }
+
+
+ input_boolean("low_visc_channel",&(E->viscosity.channel),"off",m);
+ input_boolean("low_visc_wedge",&(E->viscosity.wedge),"off",m);
+
+ input_float("lv_min_radius",&(E->viscosity.lv_min_radius),"0.9764",m);
+ input_float("lv_max_radius",&(E->viscosity.lv_max_radius),"0.9921",m);
+ input_float("lv_channel_thickness",&(E->viscosity.lv_channel_thickness),"0.0047",m);
+ input_float("lv_reduction",&(E->viscosity.lv_reduction),"0.5",m);
+
+ input_boolean("VMAX",&(E->viscosity.MAX),"off",m);
+ if (E->viscosity.MAX)
+ input_float("visc_max",&(E->viscosity.max_value),"1e22,1,nomax",m);
+
+ input_boolean("VMIN",&(E->viscosity.MIN),"off",m);
+ if (E->viscosity.MIN)
+ input_float("visc_min",&(E->viscosity.min_value),"1e20",m);
+
+ return;
+}
+
+
+void viscosity_input(struct All_variables *E)
+{
+ int m = E->parallel.me;
+
+ input_string("Viscosity",E->viscosity.STRUCTURE,"system",m);
+ input_int ("visc_smooth_method",&(E->viscosity.smooth_cycles),"0",m);
+
+ if ( strcmp(E->viscosity.STRUCTURE,"system") == 0)
+ E->viscosity.FROM_SYSTEM = 1;
+ else
+ E->viscosity.FROM_SYSTEM = 0;
+
+ if (E->viscosity.FROM_SYSTEM)
+ viscosity_system_input(E);
+
+ return;
+}
+
+
+
+/* ============================================ */
+
+void get_system_viscosity(
+ struct All_variables *E,
+ int propogate,
+ float **evisc, float **visc
+ )
+{
+ int i,j,m;
+ float temp1,temp2,*vvvis;
+ double *TG;
+
+ const int vpts = vpoints[E->mesh.nsd];
+
+ if(E->viscosity.TDEPV)
+ visc_from_T(E,evisc,propogate);
+ else
+ visc_from_mat(E,evisc);
+
+ if(E->viscosity.CDEPV) /* compositional prefactor */
+ visc_from_C(E,evisc);
+
+ if(E->viscosity.SDEPV)
+ visc_from_S(E,evisc,propogate);
+
+ if(E->viscosity.PDEPV) /* "plasticity" */
+ visc_from_P(E,evisc);
+
+
+ /* i think this should me placed differently i.e. before the
+ stress dependence but I won't change it because it's by
+ someone else
+
+ TWB
+ */
+ if(E->viscosity.channel || E->viscosity.wedge)
+ apply_low_visc_wedge_channel(E, evisc);
+
+
+ /* min/max cut-off */
+
+ if(E->viscosity.MAX) {
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=1;i<=E->lmesh.nel;i++)
+ for(j=1;j<=vpts;j++)
+ if(evisc[m][(i-1)*vpts + j] > E->viscosity.max_value)
+ evisc[m][(i-1)*vpts + j] = E->viscosity.max_value;
+ }
+
+ if(E->viscosity.MIN) {
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=1;i<=E->lmesh.nel;i++)
+ for(j=1;j<=vpts;j++)
+ if(evisc[m][(i-1)*vpts + j] < E->viscosity.min_value)
+ evisc[m][(i-1)*vpts + j] = E->viscosity.min_value;
+ }
+
+ if (E->control.verbose) {
+ fprintf(E->fp_out,"output_evisc \n");
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+ fprintf(E->fp_out,"output_evisc for cap %d\n",E->sphere.capid[m]);
+ for(i=1;i<=E->lmesh.nel;i++)
+ fprintf(E->fp_out,"%d %d %f %f\n",i,E->mat[m][i],evisc[m][(i-1)*vpts+1],evisc[m][(i-1)*vpts+7]);
+ }
+ fflush(E->fp_out);
+ }
+
+ /* interpolate from gauss quadrature points to node points for output */
+ visc_from_gint_to_nodes(E,evisc,visc,E->mesh.levmax);
+
+ return;
+}
+
+
+
+void initial_viscosity(struct All_variables *E)
+{
+ if (E->viscosity.FROM_SYSTEM)
+ get_system_viscosity(E,1,E->EVI[E->mesh.levmax],E->VI[E->mesh.levmax]);
+
+ return;
+}
+
+
+void visc_from_mat(
+ struct All_variables *E,
+ float **EEta
+ )
+{
+
+ int i,m,jj;
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=1;i<=E->lmesh.nel;i++)
+ for(jj=1;jj<=vpoints[E->mesh.nsd];jj++)
+ EEta[m][ (i-1)*vpoints[E->mesh.nsd]+jj ] = E->viscosity.N0[E->mat[m][i]-1];
+
+ return;
+}
+
+void visc_from_T(
+ struct All_variables *E,
+ float **EEta,
+ int propogate
+ )
+{
+ int m,i,j,k,l,z,jj,kk,imark;
+ float zero,e_6,one,eta0,Tave,depth,temp,tempa,temp1,TT[9];
+ float zzz,zz[9],dr;
+ float visc1, visc2, tempa_exp;
+ const int vpts = vpoints[E->mesh.nsd];
+ const int ends = enodes[E->mesh.nsd];
+ const int nel = E->lmesh.nel;
+
+ e_6 = 1.e-6;
+ one = 1.0;
+ zero = 0.0;
+ imark = 0;
+
+ /* consisntent handling : l is material number - 1 to allow
+ addressing viscosity arrays, which are all 0...n-1 */
+ switch (E->viscosity.RHEOL) {
+ case 1: /* eta = N_0 exp( E * (T_0 - T)) */
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=1;i<=nel;i++) {
+ l = E->mat[m][i] - 1;
+
+ if(E->control.mat_control==0)
+ tempa = E->viscosity.N0[l];
+ else if(E->control.mat_control==1)
+ tempa = E->viscosity.N0[l]*E->VIP[m][i];
+
+ for(kk=1;kk<=ends;kk++) {
+ TT[kk] = E->T[m][E->ien[m][i].node[kk]];
+ }
+
+ for(jj=1;jj<=vpts;jj++) {
+ temp=0.0;
+ for(kk=1;kk<=ends;kk++) {
+ temp += TT[kk] * E->N.vpt[GNVINDEX(kk,jj)];
+ }
+
+ EEta[m][ (i-1)*vpts + jj ] = tempa*
+ exp( E->viscosity.E[l] * (E->viscosity.T[l] - temp));
+
+ }
+ }
+ break;
+
+ case 2: /* eta = N_0 exp(-T/T_0) */
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=1;i<=nel;i++) {
+ l = E->mat[m][i] - 1;
+
+ if(E->control.mat_control==0)
+ tempa = E->viscosity.N0[l];
+ else if(E->control.mat_control==1)
+ tempa = E->viscosity.N0[l]*E->VIP[m][i];
+
+ for(kk=1;kk<=ends;kk++) {
+ TT[kk] = E->T[m][E->ien[m][i].node[kk]];
+ }
+
+ for(jj=1;jj<=vpts;jj++) {
+ temp=0.0;
+ for(kk=1;kk<=ends;kk++) {
+ temp += TT[kk] * E->N.vpt[GNVINDEX(kk,jj)];
+ }
+
+ EEta[m][ (i-1)*vpts + jj ] = tempa*
+ exp( -temp / E->viscosity.T[l]);
+
+ }
+ }
+ break;
+
+ case 3: /* eta = N_0 exp(E/(T+T_0) - E/(1+T_0)) */
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=1;i<=nel;i++) {
+ l = E->mat[m][i] - 1;
+ if(E->control.mat_control) /* switch moved up here TWB */
+ tempa = E->viscosity.N0[l] * E->VIP[m][i];
+ else
+ tempa = E->viscosity.N0[l];
+ j = 0;
+
+ for(kk=1;kk<=ends;kk++) {
+ TT[kk] = E->T[m][E->ien[m][i].node[kk]];
+ }
+
+ for(jj=1;jj<=vpts;jj++) {
+ temp=0.0;
+ for(kk=1;kk<=ends;kk++) { /* took out
+ computation of
+ depth, not needed
+ TWB */
+ TT[kk]=max(TT[kk],zero);
+ temp += min(TT[kk],one) * E->N.vpt[GNVINDEX(kk,jj)];
+ }
+ EEta[m][ (i-1)*vpts + jj ] = tempa*
+ exp( E->viscosity.E[l]/(temp+E->viscosity.T[l])
+ - E->viscosity.E[l]/(one +E->viscosity.T[l]) );
+ }
+ }
+ break;
+
+ case 4:
+ /* eta = N_0 exp( (E + (1-z)Z_0) / (T+T_0) ) */
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=1;i<=nel;i++) {
+ l = E->mat[m][i] - 1;
+ if(E->control.mat_control) /* moved this up here TWB */
+ tempa = E->viscosity.N0[l] * E->VIP[m][i];
+ else
+ tempa = E->viscosity.N0[l];
+
+ j = 0;
+
+ for(kk=1;kk<=ends;kk++) {
+ TT[kk] = E->T[m][E->ien[m][i].node[kk]];
+ zz[kk] = (1.-E->sx[m][3][E->ien[m][i].node[kk]]);
+ }
+
+ for(jj=1;jj<=vpts;jj++) {
+ temp=0.0;
+ zzz=0.0;
+ for(kk=1;kk<=ends;kk++) {
+ TT[kk]=max(TT[kk],zero);
+ temp += min(TT[kk],one) * E->N.vpt[GNVINDEX(kk,jj)];
+ zzz += zz[kk] * E->N.vpt[GNVINDEX(kk,jj)];
+ }
+
+
+ EEta[m][ (i-1)*vpts + jj ] = tempa*
+ exp( (E->viscosity.E[l] + E->viscosity.Z[l]*zzz )
+ / (E->viscosity.T[l]+temp) );
+
+ }
+ }
+ break;
+
+
+ case 5:
+
+ /* same as rheol 3, except alternative margin, VIP, formulation */
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=1;i<=nel;i++) {
+ l = E->mat[m][i] - 1;
+ tempa = E->viscosity.N0[l];
+ /* fprintf(stderr,"\nINSIDE visc_from_T, l=%d, tempa=%g",l+1,tempa);*/
+ j = 0;
+
+ for(kk=1;kk<=ends;kk++) {
+ TT[kk] = E->T[m][E->ien[m][i].node[kk]];
+ /* zz[kk] = (1.-E->sx[m][3][E->ien[m][i].node[kk]]); */
+ }
+
+ for(jj=1;jj<=vpts;jj++) {
+ temp=0.0;
+ /* zzz=0.0; */
+ for(kk=1;kk<=ends;kk++) {
+ TT[kk]=max(TT[kk],zero);
+ temp += min(TT[kk],one) * E->N.vpt[GNVINDEX(kk,jj)];
+ /* zzz += zz[kk] * E->N.vpt[GNVINDEX(kk,jj)]; */
+ }
+
+ if(E->control.mat_control==0)
+ EEta[m][ (i-1)*vpts + jj ] = tempa*
+ exp( E->viscosity.E[l]/(temp+E->viscosity.T[l])
+ - E->viscosity.E[l]/(one +E->viscosity.T[l]) );
+
+ if(E->control.mat_control==1) {
+ visc2 = tempa*
+ exp( E->viscosity.E[l]/(temp+E->viscosity.T[l])
+ - E->viscosity.E[l]/(one +E->viscosity.T[l]) );
+ if(E->viscosity.MAX) {
+ if(visc2 > E->viscosity.max_value)
+ visc2 = E->viscosity.max_value;
+ }
+ if(E->viscosity.MIN) {
+ if(visc2 < E->viscosity.min_value)
+ visc2 = E->viscosity.min_value;
+ }
+ EEta[m][ (i-1)*vpts + jj ] = E->VIP[m][i]*visc2;
+ }
+
+ }
+ }
+ break;
+
+
+ case 6: /*
+ like case 1, but allowing for depth-dependence if Z_0 != 0
+
+ eta = N_0 exp(E(T_0-T) + (1-z) Z_0 )
+
+ */
+
+ for(m=1;m <= E->sphere.caps_per_proc;m++)
+ for(i=1;i <= nel;i++) {
+
+ l = E->mat[m][i] - 1;
+
+ if(E->control.mat_control)
+ tempa = E->viscosity.N0[l] * E->VIP[m][i];
+ else
+ tempa = E->viscosity.N0[l];
+ j = 0;
+
+ for(kk=1;kk<=ends;kk++) {
+ TT[kk] = E->T[m][E->ien[m][i].node[kk]];
+ zz[kk] = (1.0 - E->sx[m][3][E->ien[m][i].node[kk]]);
+ }
+
+ for(jj=1;jj <= vpts;jj++) {
+ temp=0.0;zzz=0.0;
+ for(kk=1;kk <= ends;kk++) {
+ TT[kk]=max(TT[kk],zero);
+ temp += min(TT[kk],one) * E->N.vpt[GNVINDEX(kk,jj)];
+ zzz += zz[kk] * E->N.vpt[GNVINDEX(kk,jj)];
+ }
+ EEta[m][ (i-1)*vpts + jj ] = tempa*
+ exp( E->viscosity.E[l]*(E->viscosity.T[l] - temp) +
+ zzz * E->viscosity.Z[l]);
+ //if(E->parallel.me == 0)
+ // fprintf(stderr,"z %11g km mat %i N0 %11g T %11g T0 %11g E %11g Z %11g mat: %i log10(eta): %11g\n",
+ // zzz *E->data.radius_km ,l+1,
+ // tempa,temp,E->viscosity.T[l],E->viscosity.E[l], E->viscosity.Z[l],l+1,log10(EEta[m][ (i-1)*vpts + jj ]));
+ }
+ }
+ break;
+
+
+ case 7:
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=1;i<=nel;i++) {
+ l = E->mat[m][i] - 1;
+
+ if(E->control.mat_control)
+ tempa = E->viscosity.N0[l] * E->VIP[m][i];
+ else
+ tempa = E->viscosity.N0[l];
+
+ j = 0;
+
+ for(kk=1;kk<=ends;kk++) {
+ TT[kk] = E->T[m][E->ien[m][i].node[kk]];
+ zz[kk] = (1.-E->sx[m][3][E->ien[m][i].node[kk]]);
+ }
+
+ for(jj=1;jj<=vpts;jj++) {
+ temp=0.0;
+ zzz=0.0;
+ for(kk=1;kk<=ends;kk++) {
+ temp += TT[kk] * E->N.vpt[GNVINDEX(kk,jj)];
+ zzz += zz[kk] * E->N.vpt[GNVINDEX(kk,jj)];
+ }
+
+ /* The viscosity formulation (dimensional) is:
+ visc=visc0*exp[(Ea+p*Va)/(R*T)]
+
+ Typical values for dry upper mantle are:
+ Ea = 300 KJ/mol ; Va = 1.e-5 m^3/mol
+
+ T=DT*(T0+T');
+ where DT - temperature contrast (from Rayleigh number)
+ T' - nondimensional temperature;
+ T0 - nondimensional surface tempereture;
+
+ =>
+ visc = visc0 * exp{(Ea+p*Va) / [R*DT*(T0 + T')]}
+ = visc0 * exp{[Ea/(R*DT) + p*Va/(R*DT)] / (T0 + T')}
+
+ so:
+ E->viscosity.E = Ea/(R*DT);
+ (1-r) = p/(rho*g);
+ E->viscosity.Z = Va*rho*g/(R*DT);
+ E->viscosity.T = T0;
+
+ after normalizing visc=1 at T'=1 and r=r_CMB:
+ visc=visc0*exp{ [viscE + (1-r)*viscZ] / (viscT+T')
+ - [viscE + (1-r_CMB)*viscZ] / (viscT+1) }
+ */
+
+ EEta[m][ (i-1)*vpts + jj ] = tempa*
+ exp( (E->viscosity.E[l] + E->viscosity.Z[l]*zzz )
+ / (E->viscosity.T[l] + temp)
+ - (E->viscosity.E[l] +
+ E->viscosity.Z[l]*(E->sphere.ro-E->sphere.ri) )
+ / (E->viscosity.T[l] + one) );
+ }
+ }
+ break;
+
+ case 8: /*
+ eta0 = N_0 exp(E/(T+T_0) - E/(1+T_0))
+
+ eta = eta0 if T < T_sol0 + 2(1-z)
+ eta = ET_red*eta0 if T >= T_sol0 + 2(1-z)
+
+ where z is normalized by layer
+ thickness, and T_sol0 is something
+ like 0.6, and ET_red = 0.1
+
+ (same as case 3, but for viscosity reduction)
+
+ */
+ dr = E->sphere.ro - E->sphere.ri;
+ for(m=1;m<=E->sphere.caps_per_proc;m++)
+ for(i=1;i<=nel;i++) {
+ l = E->mat[m][i] - 1;
+ if(E->control.mat_control)
+ tempa = E->viscosity.N0[l] * E->VIP[m][i];
+ else
+ tempa = E->viscosity.N0[l];
+ j = 0;
+
+ for(kk=1;kk<=ends;kk++) {
+ TT[kk] = E->T[m][E->ien[m][i].node[kk]];
+ zz[kk] = E->sx[m][3][E->ien[m][i].node[kk]]; /* radius */
+ }
+
+ for(jj=1;jj<=vpts;jj++) {
+ temp=zzz=0.0;
+ for(kk=1;kk<=ends;kk++) {
+ TT[kk]=max(TT[kk],zero);
+ temp += min(TT[kk],one) * E->N.vpt[GNVINDEX(kk,jj)]; /* mean temp */
+ zzz += zz[kk] * E->N.vpt[GNVINDEX(kk,jj)];/* mean r */
+ }
+ /* convert to z, as defined to be unity at surface
+ and zero at CMB */
+ zzz = (zzz - E->sphere.ri)/dr;
+ visc1 = tempa* exp( E->viscosity.E[l]/(temp+E->viscosity.T[l])
+ - E->viscosity.E[l]/(one +E->viscosity.T[l]) );
+ if(temp < E->viscosity.T_sol0 + 2.*(1.-zzz))
+ EEta[m][ (i-1)*vpts + jj ] = visc1;
+ else
+ EEta[m][ (i-1)*vpts + jj ] = visc1 * E->viscosity.ET_red;
+ }
+ }
+ break;
+
+ case 100:
+ /* user-defined viscosity law goes here */
+ fprintf(stderr, "Need user definition for viscosity law: 'rheol=%d'\n",
+ E->viscosity.RHEOL);
+ parallel_process_termination();
+ break;
+
+ default:
+ /* unknown option */
+ fprintf(stderr, "Invalid value of 'rheol=%d'\n", E->viscosity.RHEOL);
+
+ parallel_process_termination();
+ break;
+ }
+
+
+ return;
+}
+
+
+void visc_from_S(
+ struct All_variables *E,
+ float **EEta,
+ int propogate
+ )
+{
+ float one,two,scale,stress_magnitude,depth,exponent1;
+ float *eedot;
+
+ int m,e,l,z,jj,kk;
+
+ const int vpts = vpoints[E->mesh.nsd];
+ const int nel = E->lmesh.nel;
+
+ eedot = (float *) malloc((2+nel)*sizeof(float));
+ one = 1.0;
+ two = 2.0;
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+ if(E->viscosity.sdepv_visited){
+
+ /* get second invariant for all elements */
+ strain_rate_2_inv(E,m,eedot,1);
+ }else{
+ for(e=1;e<=nel;e++) /* initialize with unity if no velocities around */
+ eedot[e] = 1.0;
+ E->viscosity.sdepv_visited = 1;
+
+ }
+ /* eedot cannot be too small, or the viscosity will go to inf */
+ for(e=1;e<=nel;e++){
+ eedot[e] = max(eedot[e], 1.0e-16);
+ }
+
+ for(e=1;e<=nel;e++) {
+ exponent1= one/E->viscosity.sdepv_expt[E->mat[m][e]-1];
+ scale=pow(eedot[e],exponent1-one);
+ for(jj=1;jj<=vpts;jj++)
+ EEta[m][(e-1)*vpts + jj] = scale*pow(EEta[m][(e-1)*vpts+jj],exponent1);
+ }
+ }
+
+ free ((void *)eedot);
+ return;
+}
+
+void visc_from_P( /* "plasticity" implementation
+
+ viscosity will be limited by a yield stress
+
+ \sigma_y = min(a + b * (1-r), y)
+
+ where a,b,y are parameters input via pdepv_a,b,y
+
+ and
+
+ \eta_y = \sigma_y / (2 \eps_II)
+
+ where \eps_II is the second invariant. Then
+
+ \eta_eff = (\eta_0 \eta_y)/(\eta_0 + \eta_y)
+
+ for pdepv_eff = 1
+
+ or
+
+ \eta_eff = min(\eta_0,\eta_y)
+
+ for pdepv_eff = 0
+
+ where \eta_0 is the regular viscosity
+
+
+ TWB
+
+ */
+ struct All_variables *E,
+ float **EEta
+ )
+{
+ float *eedot,zz[9],zzz,tau,eta_p,eta_new;
+ int m,e,l,z,jj,kk;
+
+ const int vpts = vpoints[E->mesh.nsd];
+ const int nel = E->lmesh.nel;
+ const int ends = enodes[E->mesh.nsd];
+
+ eedot = (float *) malloc((2+nel)*sizeof(float));
+
+ for(m=1;m<=E->sphere.caps_per_proc;m++) {
+
+ if(E->viscosity.pdepv_visited){
+
+ strain_rate_2_inv(E,m,eedot,1); /* get second invariant for all elements */
+
+ }else{
+ for(e=1;e<=nel;e++) /* initialize with unity if no velocities around */
+ eedot[e] = 1.0;
+ if(m == E->sphere.caps_per_proc)
+ E->viscosity.pdepv_visited = 1;
+ if((E->parallel.me == 0)&&(E->control.verbose)){
+ for(e=0;e < E->viscosity.num_mat;e++)
+ fprintf(stderr,"num mat: %i a: %g b: %g y: %g\n",
+ e,E->viscosity.pdepv_a[e],E->viscosity.pdepv_b[e],E->viscosity.pdepv_y[e]);
+ }
+ }
+
+ for(e=1;e <= nel;e++) { /* loop through all elements */
+
+ l = E->mat[m][e] -1 ; /* material of this element */
+
+ for(kk=1;kk <= ends;kk++) /* nodal depths */
+ zz[kk] = (1.0 - E->sx[m][3][E->ien[m][e].node[kk]]); /* for depth, zz = 1 - r */
+
+ for(jj=1;jj <= vpts;jj++){ /* loop through integration points */
+
+ zzz = 0.0; /* get mean depth of integration point */
+ for(kk=1;kk<=ends;kk++)
+ zzz += zz[kk] * E->N.vpt[GNVINDEX(kk,jj)];
+
+ /* depth dependent yield stress */
+ tau = E->viscosity.pdepv_a[l] + zzz * E->viscosity.pdepv_b[l];
+
+ /* min of depth dep. and constant yield stress */
+ tau = min(tau, E->viscosity.pdepv_y[l]);
+
+ /* yield viscosity */
+ eta_p = tau/(2.0 * eedot[e] + 1e-7) + E->viscosity.pdepv_offset;
+
+
+ if(E->viscosity.pdepv_eff){
+ /* two dashpots in series */
+ eta_new = 1.0/(1.0/EEta[m][ (e-1)*vpts + jj ] + 1.0/eta_p);
+ }else{
+ /* min viscosities*/
+ eta_new = min(EEta[m][ (e-1)*vpts + jj ], eta_p);
+ }
+ //fprintf(stderr,"z: %11g mat: %i a: %11g b: %11g y: %11g ee: %11g tau: %11g eta_p: %11g eta_new: %11g eta_old: %11g\n",
+ //zzz,l,E->viscosity.pdepv_a[l], E->viscosity.pdepv_b[l],E->viscosity.pdepv_y[l],
+ //eedot[e],tau,eta_p,eta_new,EEta[m][(e-1)*vpts + jj]);
+ EEta[m][(e-1)*vpts + jj] = eta_new;
+ } /* end integration point loop */
+ } /* end element loop */
+
+ } /* end caps loop */
+ free ((void *)eedot);
+ return;
+}
+
+/*
+
+multiply with compositional factor which is determined by a geometric
+mean average from the tracer composition, assuming two flavors and
+compositions between zero and unity
+
+*/
+void visc_from_C(
+ struct All_variables *E,
+ float **EEta
+ )
+{
+ double vmean,cc_loc[10],CC[10][9],cbackground;
+ int m,l,z,jj,kk,i,p,q;
+
+
+ const int vpts = vpoints[E->mesh.nsd];
+ const int nel = E->lmesh.nel;
+ const int ends = enodes[E->mesh.nsd];
+
+ for(m=1;m <= E->sphere.caps_per_proc;m++) {
+ for(i = 1; i <= nel; i++){
+ /* determine composition of each of the nodes of the
+ element */
+ for(p=0; p<E->composition.ncomp; p++) {
+ for(kk = 1; kk <= ends; kk++){
+ CC[p][kk] = E->composition.comp_node[m][p][E->ien[m][i].node[kk]];
+ if(CC[p][kk] < 0)CC[p][kk]=0.0;
+ if(CC[p][kk] > 1)CC[p][kk]=1.0;
+ }
+ }
+ for(jj = 1; jj <= vpts; jj++) {
+ /* concentration of background material */
+ cbackground = 1;
+ for(p=0; p<E->composition.ncomp; p++) {
+ /* compute mean composition */
+ cc_loc[p] = 0.0;
+ for(kk = 1; kk <= ends; kk++) {
+ cc_loc[p] += CC[p][kk] * E->N.vpt[GNVINDEX(kk, jj)];
+ }
+ cbackground -= cc_loc[p];
+ }
+
+ /* geometric mean of viscosity */
+ vmean = cbackground * E->viscosity.cdepv_ff[0];
+ for(p=0; p<E->composition.ncomp; p++) {
+ vmean += cc_loc[p] * E->viscosity.cdepv_ff[p+1];
+ }
+ vmean = exp(vmean);
+
+ /* multiply the viscosity with this prefactor */
+ EEta[m][ (i-1)*vpts + jj ] *= vmean;
+
+ } /* end jj loop */
+ } /* end el loop */
+ } /* end cap */
+}
+
+void strain_rate_2_inv(
+ struct All_variables *E,
+ int m,
+ float *EEDOT,
+ int SQRT
+ )
+{
+ struct Shape_function_dx *GNx;
+
+ double edot[4][4], rtf[4][9];
+ double theta;
+ double ba[9][9][4][7];
+ float VV[4][9], Vxyz[7][9], dilation[9];
+
+ int e, i, j, p, q, n;
+
+ const int nel = E->lmesh.nel;
+ const int dims = E->mesh.nsd;
+ const int ends = enodes[dims];
+ const int lev = E->mesh.levmax;
+ const int ppts = ppoints[dims];
+ const int sphere_key = 1;
+
+
+ for(e=1; e<=nel; e++) {
+
+ get_rtf_at_ppts(E, m, lev, e, rtf);
+ velo_from_element(E, VV, m, e, sphere_key);
+ GNx = &(E->gNX[m][e]);
+
+ theta = rtf[1][1];
+
+
+ /* Vxyz is the strain rate vector, whose relationship with
+ * the strain rate tensor (e) is that:
+ * Vxyz[1] = e11
+ * Vxyz[2] = e22
+ * Vxyz[3] = e33
+ * Vxyz[4] = 2*e12
+ * Vxyz[5] = 2*e13
+ * Vxyz[6] = 2*e23
+ * where 1 is theta, 2 is phi, and 3 is r
+ */
+ for(j=1; j<=ppts; j++) {
+ Vxyz[1][j] = 0.0;
+ Vxyz[2][j] = 0.0;
+ Vxyz[3][j] = 0.0;
+ Vxyz[4][j] = 0.0;
+ Vxyz[5][j] = 0.0;
+ Vxyz[6][j] = 0.0;
+ dilation[j] = 0.0;
+ }
+
+ if ((theta < 0.09) || (theta > 3.05)) {
+ /* When the element is close to the poles, use a more
+ * precise method to compute the strain rate. */
+
+ if ((e-1)%E->lmesh.elz==0) {
+ construct_c3x3matrix_el(E,e,&E->element_Cc,&E->element_Ccx,lev,m,1);
+ }
+
+ get_ba_p(&(E->N), GNx, &E->element_Cc, &E->element_Ccx,
+ rtf, E->mesh.nsd, ba);
+
+ for(j=1;j<=ppts;j++)
+ for(p=1;p<=6;p++)
+ for(i=1;i<=ends;i++)
+ for(q=1;q<=dims;q++) {
+ Vxyz[p][j] += ba[i][j][q][p] * VV[q][i];
+ }
+
+ }
+ else {
+ for(j=1; j<=ppts; j++) {
+ for(i=1; i<=ends; i++) {
+ Vxyz[1][j] += (VV[1][i] * GNx->ppt[GNPXINDEX(0, i, j)]
+ + VV[3][i] * E->N.ppt[GNPINDEX(i, j)])
+ * rtf[3][j];
+ Vxyz[2][j] += ((VV[2][i] * GNx->ppt[GNPXINDEX(1, i, j)]
+ + VV[1][i] * E->N.ppt[GNPINDEX(i, j)]
+ * cos(rtf[1][j])) / sin(rtf[1][j])
+ + VV[3][i] * E->N.ppt[GNPINDEX(i, j)])
+ * rtf[3][j];
+ Vxyz[3][j] += VV[3][i] * GNx->ppt[GNPXINDEX(2, i, j)];
+
+ Vxyz[4][j] += ((VV[1][i] * GNx->ppt[GNPXINDEX(1, i, j)]
+ - VV[2][i] * E->N.ppt[GNPINDEX(i, j)]
+ * cos(rtf[1][j])) / sin(rtf[1][j])
+ + VV[2][i] * GNx->ppt[GNPXINDEX(0, i, j)])
+ * rtf[3][j];
+ Vxyz[5][j] += VV[1][i] * GNx->ppt[GNPXINDEX(2, i, j)]
+ + rtf[3][j] * (VV[3][i] * GNx->ppt[GNPXINDEX(0, i, j)]
+ - VV[1][i] * E->N.ppt[GNPINDEX(i, j)]);
+ Vxyz[6][j] += VV[2][i] * GNx->ppt[GNPXINDEX(2, i, j)]
+ + rtf[3][j] * (VV[3][i]
+ * GNx->ppt[GNPXINDEX(1, i, j)]
+ / sin(rtf[1][j])
+ - VV[2][i] * E->N.ppt[GNPINDEX(i, j)]);
+ }
+ }
+ } /* end of else */
+
+ if(E->control.inv_gruneisen != 0) {
+ for(j=1; j<=ppts; j++)
+ dilation[j] = (Vxyz[1][j] + Vxyz[2][j] + Vxyz[3][j]) / 3.0;
+ }
+
+ edot[1][1] = edot[2][2] = edot[3][3] = 0;
+ edot[1][2] = edot[1][3] = edot[2][3] = 0;
+
+ /* edot is 2 * (the deviatoric strain rate tensor) */
+ for(j=1; j<=ppts; j++) {
+ edot[1][1] += 2.0 * (Vxyz[1][j] - dilation[j]);
+ edot[2][2] += 2.0 * (Vxyz[2][j] - dilation[j]);
+ edot[3][3] += 2.0 * (Vxyz[3][j] - dilation[j]);
+ edot[1][2] += Vxyz[4][j];
+ edot[1][3] += Vxyz[5][j];
+ edot[2][3] += Vxyz[6][j];
+ }
+
+ EEDOT[e] = edot[1][1] * edot[1][1]
+ + edot[1][2] * edot[1][2] * 2.0
+ + edot[2][2] * edot[2][2]
+ + edot[2][3] * edot[2][3] * 2.0
+ + edot[3][3] * edot[3][3]
+ + edot[1][3] * edot[1][3] * 2.0;
+ }
+
+ if(SQRT)
+ for(e=1;e<=nel;e++)
+ EEDOT[e] = sqrt(0.5 *EEDOT[e]);
+ else
+ for(e=1;e<=nel;e++)
+ EEDOT[e] *= 0.5;
+
+ return;
+}
+
+
+static void apply_low_visc_wedge_channel(struct All_variables *E, float **evisc)
+{
+ int i,j,m;
+ const int vpts = vpoints[E->mesh.nsd];
+ float *F;
+
+ /* low viscosity channel/wedge require tracers to work */
+ if(E->control.tracer == 0) {
+ if(E->parallel.me == 0) {
+ fprintf(stderr, "Error: low viscosity channel/wedge is turned on, "
+ "but tracer is off!\n");
+ fprintf(E->fp, "Error: low viscosity channel/wedge is turned on, "
+ "but tracer is off!\n");
+ fflush(E->fp);
+ }
+ parallel_process_termination();
+ }
+
+
+ F = (float *)malloc((E->lmesh.nel+1)*sizeof(float));
+ for(i=1 ; i<=E->lmesh.nel ; i++)
+ F[i] = 0.0;
+
+ /* if low viscosity channel ... */
+ if(E->viscosity.channel)
+ low_viscosity_channel_factor(E, F);
+
+
+ /* if low viscosity wedge ... */
+ if(E->viscosity.wedge)
+ low_viscosity_wedge_factor(E, F);
+
+
+ for(i=1 ; i<=E->lmesh.nel ; i++) {
+ if (F[i] != 0.0)
+ for(m = 1 ; m <= E->sphere.caps_per_proc ; m++) {
+ for(j=1;j<=vpts;j++) {
+ evisc[m][(i-1)*vpts + j] = F[i];
+ }
+ }
+ }
+
+
+ free(F);
+
+ return;
+}
+
+
+
+
+static void low_viscosity_channel_factor(struct All_variables *E, float *F)
+{
+ int i, ii, k, m, e, ee;
+ int nz_min[NCS], nz_max[NCS];
+ const int flavor = 0;
+ double rad_mean, rr;
+
+ for(m=1; m<=E->sphere.caps_per_proc; m++) {
+ /* find index of radius corresponding to lv_min_radius */
+ for(e=1; e<=E->lmesh.elz; e++) {
+ rad_mean = 0.5 * (E->sx[m][3][E->ien[m][e].node[1]] +
+ E->sx[m][3][E->ien[m][e].node[8]]);
+ if(rad_mean >= E->viscosity.lv_min_radius) break;
+ }
+ nz_min[m] = e;
+
+ /* find index of radius corresponding to lv_max_radius */
+ for(e=E->lmesh.elz; e>=1; e--) {
+ rad_mean = 0.5 * (E->sx[m][3][E->ien[m][e].node[1]] +
+ E->sx[m][3][E->ien[m][e].node[8]]);
+ if(rad_mean <= E->viscosity.lv_max_radius) break;
+ }
+ nz_max[m] = e;
+ }
+
+
+
+ for(m=1; m<=E->sphere.caps_per_proc; m++) {
+ for(k=1; k<=E->lmesh.elx*E->lmesh.ely; k++) {
+ for(i=nz_min[m]; i<=nz_max[m]; i++) {
+ e = (k-1)*E->lmesh.elz + i;
+
+ rad_mean = 0.5 * (E->sx[m][3][E->ien[m][e].node[1]] +
+ E->sx[m][3][E->ien[m][e].node[8]]);
+
+ /* loop over elements below e */
+ for(ii=i; ii>=nz_min[m]; ii--) {
+ ee = (k-1)*E->lmesh.elz + ii;
+
+ rr = 0.5 * (E->sx[m][3][E->ien[m][ee].node[1]] +
+ E->sx[m][3][E->ien[m][ee].node[8]]);
+
+ /* if ee has tracers in it and is within the channel */
+ if((E->trace.ntracer_flavor[m][flavor][ee] > 0) &&
+ (rad_mean <= rr + E->viscosity.lv_channel_thickness)) {
+ F[e] = E->viscosity.lv_reduction;
+ break;
+ }
+ }
+ }
+ }
+ }
+
+
+ /** debug **
+ for(m=1; m<=E->sphere.caps_per_proc; m++)
+ for(e=1; e<=E->lmesh.nel; e++)
+ fprintf(stderr, "lv_reduction: %d %e\n", e, F[e]);
+ /**/
+
+ return;
+}
+
+
+static void low_viscosity_wedge_factor(struct All_variables *E, float *F)
+{
+ int i, ii, k, m, e, ee;
+ int nz_min[NCS], nz_max[NCS];
+ const int flavor = 0;
+ double rad_mean, rr;
+
+ for(m=1; m<=E->sphere.caps_per_proc; m++) {
+ /* find index of radius corresponding to lv_min_radius */
+ for(e=1; e<=E->lmesh.elz; e++) {
+ rad_mean = 0.5 * (E->sx[m][3][E->ien[m][e].node[1]] +
+ E->sx[m][3][E->ien[m][e].node[8]]);
+ if(rad_mean >= E->viscosity.lv_min_radius) break;
+ }
+ nz_min[m] = e;
+
+ /* find index of radius corresponding to lv_max_radius */
+ for(e=E->lmesh.elz; e>=1; e--) {
+ rad_mean = 0.5 * (E->sx[m][3][E->ien[m][e].node[1]] +
+ E->sx[m][3][E->ien[m][e].node[8]]);
+ if(rad_mean <= E->viscosity.lv_max_radius) break;
+ }
+ nz_max[m] = e;
+ }
+
+
+
+ for(m=1; m<=E->sphere.caps_per_proc; m++) {
+ for(k=1; k<=E->lmesh.elx*E->lmesh.ely; k++) {
+ for(i=nz_min[m]; i<=nz_max[m]; i++) {
+ e = (k-1)*E->lmesh.elz + i;
+
+ rad_mean = 0.5 * (E->sx[m][3][E->ien[m][e].node[1]] +
+ E->sx[m][3][E->ien[m][e].node[8]]);
+
+ /* loop over elements below e */
+ for(ii=i; ii>=nz_min[m]; ii--) {
+ ee = (k-1)*E->lmesh.elz + ii;
+
+ /* if ee has tracers in it */
+ if(E->trace.ntracer_flavor[m][flavor][ee] > 0) {
+ F[e] = E->viscosity.lv_reduction;
+ break;
+ }
+ }
+ }
+ }
+ }
+
+
+ /** debug **
+ for(m=1; m<=E->sphere.caps_per_proc; m++)
+ for(e=1; e<=E->lmesh.nel; e++)
+ fprintf(stderr, "lv_reduction: %d %e\n", e, F[e]);
+ /**/
+
+ return;
+}
Modified: mc/3D/CitcomS/branches/cxx/lib/advection_diffusion.h
===================================================================
--- mc/3D/CitcomS/trunk/lib/advection_diffusion.h 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/advection_diffusion.h 2009-02-13 03:39:35 UTC (rev 14045)
@@ -29,16 +29,8 @@
#if !defined(CitcomS_advection_diffusion_h)
#define CitcomS_advection_diffusion_h
-#ifdef __cplusplus
-extern "C" {
-#endif
-
void PG_timestep_init(struct All_variables *);
void PG_timestep_solve(struct All_variables *);
void std_timestep(struct All_variables *);
-#ifdef __cplusplus
-}
#endif
-
-#endif
Modified: mc/3D/CitcomS/branches/cxx/lib/citcom_init.h
===================================================================
--- mc/3D/CitcomS/trunk/lib/citcom_init.h 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/citcom_init.h 2009-02-13 03:39:35 UTC (rev 14045)
@@ -31,15 +31,7 @@
#include "mpi.h"
-#ifdef __cplusplus
-extern "C" {
-#endif
-
extern struct All_variables* citcom_init(MPI_Comm *world);
-#ifdef __cplusplus
-}
#endif
-#endif
-
Added: mc/3D/CitcomS/branches/cxx/lib/cproto.h
===================================================================
--- mc/3D/CitcomS/branches/cxx/lib/cproto.h (rev 0)
+++ mc/3D/CitcomS/branches/cxx/lib/cproto.h 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,507 @@
+/* Advection_diffusion.c */
+void advection_diffusion_parameters(struct All_variables *E);
+void advection_diffusion_allocate_memory(struct All_variables *E);
+void PG_timestep_init(struct All_variables *E);
+void PG_timestep(struct All_variables *E);
+void std_timestep(struct All_variables *E);
+void PG_timestep_solve(struct All_variables *E);
+/* BC_util.c */
+void strip_bcs_from_residual(struct All_variables *E, double **Res, int level);
+void temperatures_conform_bcs(struct All_variables *E);
+void temperatures_conform_bcs2(struct All_variables *E);
+void velocities_conform_bcs(struct All_variables *E, double **U);
+/* Checkpoints.c */
+void output_checkpoint(struct All_variables *E);
+void read_checkpoint(struct All_variables *E);
+/* Citcom_init.c */
+/* Composition_related.c */
+void composition_input(struct All_variables *E);
+void composition_setup(struct All_variables *E);
+void write_composition_instructions(struct All_variables *E);
+void fill_composition(struct All_variables *E);
+void init_composition(struct All_variables *E);
+void map_composition_to_nodes(struct All_variables *E);
+void get_bulk_composition(struct All_variables *E);
+/* Construct_arrays.c */
+void construct_ien(struct All_variables *E);
+void construct_surface(struct All_variables *E);
+void construct_id(struct All_variables *E);
+void get_bcs_id_for_residual(struct All_variables *E, int level, int m);
+void construct_lm(struct All_variables *E);
+void construct_node_maps(struct All_variables *E);
+void construct_node_ks(struct All_variables *E);
+void rebuild_BI_on_boundary(struct All_variables *E);
+void construct_masks(struct All_variables *E);
+void construct_sub_element(struct All_variables *E);
+void construct_elt_ks(struct All_variables *E);
+void construct_elt_gs(struct All_variables *E);
+void construct_elt_cs(struct All_variables *E);
+void construct_stiffness_B_matrix(struct All_variables *E);
+int layers_r(struct All_variables *E, float r);
+int layers(struct All_variables *E, int m, int node);
+void construct_mat_group(struct All_variables *E);
+/* Convection.c */
+void set_convection_defaults(struct All_variables *E);
+void read_convection_settings(struct All_variables *E);
+void convection_derived_values(struct All_variables *E);
+void convection_allocate_memory(struct All_variables *E);
+void convection_initial_fields(struct All_variables *E);
+void convection_boundary_conditions(struct All_variables *E);
+/* Determine_net_rotation.c */
+double determine_model_net_rotation(struct All_variables *E, double *omega);
+double determine_netr_tp(float r, float theta, float phi, float velt, float velp, int mode, double *c9, double *omega);
+void sub_netr(float r, float theta, float phi, float *velt, float *velp, double *omega);
+void hc_ludcmp_3x3(double a[3][3], int *indx);
+void hc_lubksb_3x3(double a[3][3], int *indx, double *b);
+/* Drive_solvers.c */
+void general_stokes_solver_setup(struct All_variables *E);
+void general_stokes_solver(struct All_variables *E);
+int need_visc_update(struct All_variables *E);
+void general_stokes_solver_pseudo_surf(struct All_variables *E);
+/* Element_calculations.c */
+void add_force(struct All_variables *E, int e, double elt_f[24], int m);
+void assemble_forces(struct All_variables *E, int penalty);
+void assemble_forces_pseudo_surf(struct All_variables *E, int penalty);
+void get_ba(struct Shape_function *N, struct Shape_function_dx *GNx, struct CC *cc, struct CCX *ccx, double rtf[4][9], int dims, double ba[9][9][4][7]);
+void get_ba_p(struct Shape_function *N, struct Shape_function_dx *GNx, struct CC *cc, struct CCX *ccx, double rtf[4][9], int dims, double ba[9][9][4][7]);
+void get_elt_k(struct All_variables *E, int el, double elt_k[24*24], int lev, int m, int iconv);
+void assemble_del2_u(struct All_variables *E, double **u, double **Au, int level, int strip_bcs);
+void e_assemble_del2_u(struct All_variables *E, double **u, double **Au, int level, int strip_bcs);
+void n_assemble_del2_u(struct All_variables *E, double **u, double **Au, int level, int strip_bcs);
+void build_diagonal_of_K(struct All_variables *E, int el, double elt_k[24*24], int level, int m);
+void build_diagonal_of_Ahat(struct All_variables *E);
+void assemble_c_u(struct All_variables *E, double **U, double **result, int level);
+void assemble_div_rho_u(struct All_variables *E, double **U, double **result, int level);
+void assemble_div_u(struct All_variables *E, double **U, double **divU, int level);
+void assemble_grad_p(struct All_variables *E, double **P, double **gradP, int lev);
+double assemble_dAhatp_entry(struct All_variables *E, int e, int level, int m);
+void get_elt_c(struct All_variables *E, int el, higher_precision elt_c[24][1], int lev, int m);
+void get_elt_g(struct All_variables *E, int el, higher_precision elt_del[24][1], int lev, int m);
+void get_elt_f(struct All_variables *E, int el, double elt_f[24], int bcs, int m);
+void get_elt_tr(struct All_variables *E, int bel, int side, double elt_tr[24], int m);
+void get_elt_tr_pseudo_surf(struct All_variables *E, int bel, int side, double elt_tr[24], int m);
+void get_aug_k(struct All_variables *E, int el, double elt_k[24*24], int level, int m);
+/* Full_boundary_conditions.c */
+void full_velocity_boundary_conditions(struct All_variables *E);
+void full_temperature_boundary_conditions(struct All_variables *E);
+/* Full_geometry_cartesian.c */
+void full_set_2dc_defaults(struct All_variables *E);
+void full_set_2pt5dc_defaults(struct All_variables *E);
+void full_set_3dc_defaults(struct All_variables *E);
+void full_set_3dsphere_defaults(struct All_variables *E);
+void full_set_3dsphere_defaults2(struct All_variables *E);
+/* Full_lith_age_read_files.c */
+void full_lith_age_read_files(struct All_variables *E, int output);
+/* Full_obsolete.c */
+void parallel_process_initilization(struct All_variables *E, int argc, char **argv);
+void parallel_domain_decomp2(struct All_variables *E, float *GX[4]);
+void scatter_to_nlayer_id(struct All_variables *E, double **AUi, double **AUo, int lev);
+void gather_to_1layer_id(struct All_variables *E, double **AUi, double **AUo, int lev);
+void gather_to_1layer_node(struct All_variables *E, float **AUi, float **AUo, int lev);
+void gather_to_1layer_ele(struct All_variables *E, float **AUi, float **AUo, int lev);
+void gather_TG_to_me0(struct All_variables *E, float *TG);
+void sum_across_depth_sph(struct All_variables *E, float *sphc, float *sphs, int dest_proc);
+void sum_across_surf_sph(struct All_variables *E, float *TG, int loc_proc);
+void set_communication_sphereh(struct All_variables *E);
+void process_temp_field(struct All_variables *E, int ii);
+void output_velo_related(struct All_variables *E, int file_number);
+void output_temp(struct All_variables *E, int file_number);
+void output_stress(struct All_variables *E, int file_number, float *SXX, float *SYY, float *SZZ, float *SXY, float *SXZ, float *SZY);
+void print_field_spectral_regular(struct All_variables *E, float *TG, float *sphc, float *sphs, int proc_loc, char *filen);
+void write_radial_horizontal_averages(struct All_variables *E);
+int icheck_regular_neighbors(struct All_variables *E, int j, int ntheta, int nphi, double x, double y, double z, double theta, double phi, double rad);
+int iquick_element_column_search(struct All_variables *E, int j, int iregel, int ntheta, int nphi, double x, double y, double z, double theta, double phi, double rad, int *imap, int *ich);
+/* Full_parallel_related.c */
+void full_parallel_processor_setup(struct All_variables *E);
+void full_parallel_domain_decomp0(struct All_variables *E);
+void full_parallel_domain_boundary_nodes(struct All_variables *E);
+void full_parallel_communication_routs_v(struct All_variables *E);
+void full_parallel_communication_routs_s(struct All_variables *E);
+void full_exchange_id_d(struct All_variables *E, double **U, int lev);
+void full_exchange_snode_f(struct All_variables *E, float **U1, float **U2, int lev);
+/* Full_read_input_from_files.c */
+void full_read_input_files_for_timesteps(struct All_variables *E, int action, int output);
+/* Full_solver.c */
+void full_solver_init(struct All_variables *E);
+/* Full_sphere_related.c */
+void spherical_to_uv2(double center[2], int len, double *theta, double *phi, double *u, double *v);
+void uv_to_spherical(double center[2], int len, double *u, double *v, double *theta, double *phi);
+void full_coord_of_cap(struct All_variables *E, int m, int icap);
+/* Full_tracer_advection.c */
+void full_tracer_input(struct All_variables *E);
+void full_tracer_setup(struct All_variables *E);
+void full_lost_souls(struct All_variables *E);
+void full_get_shape_functions(struct All_variables *E, double shp[9], int nelem, double theta, double phi, double rad);
+double full_interpolate_data(struct All_variables *E, double shp[9], double data[9]);
+void full_get_velocity(struct All_variables *E, int j, int nelem, double theta, double phi, double rad, double *velocity_vector);
+int full_icheck_cap(struct All_variables *E, int icap, double x, double y, double z, double rad);
+int full_iget_element(struct All_variables *E, int j, int iprevious_element, double x, double y, double z, double theta, double phi, double rad);
+void full_keep_within_bounds(struct All_variables *E, double *x, double *y, double *z, double *theta, double *phi, double *rad);
+void analytical_test(struct All_variables *E);
+void analytical_runge_kutte(struct All_variables *E, int nsteps, double dt, double *x0_s, double *x0_c, double *xf_s, double *xf_c, double *vec);
+void analytical_test_function(struct All_variables *E, double theta, double phi, double rad, double *vel_s, double *vel_c);
+void pdebug(struct All_variables *E, int i);
+/* Full_version_dependent.c */
+void full_node_locations(struct All_variables *E);
+void full_construct_boundary(struct All_variables *E);
+/* General_matrix_functions.c */
+int solve_del2_u(struct All_variables *E, double **d0, double **F, double acc, int high_lev);
+double multi_grid(struct All_variables *E, double **d1, double **F, double acc, int hl);
+double conj_grad(struct All_variables *E, double **d0, double **F, double acc, int *cycles, int level);
+void element_gauss_seidel(struct All_variables *E, double **d0, double **F, double **Ad, double acc, int *cycles, int level, int guess);
+void gauss_seidel(struct All_variables *E, double **d0, double **F, double **Ad, double acc, int *cycles, int level, int guess);
+double cofactor(double A[4][4], int i, int j, int n);
+double determinant(double A[4][4], int n);
+double gen_determinant(double **A, int n);
+long double lg_pow(long double a, int n);
+/* Ggrd_handling.c */
+/* Global_operations.c */
+void remove_horiz_ave(struct All_variables *E, double **X, double *H, int store_or_not);
+void remove_horiz_ave2(struct All_variables *E, double **X);
+void return_horiz_ave(struct All_variables *E, double **X, double *H);
+void return_horiz_ave_f(struct All_variables *E, float **X, float *H);
+void return_elementwise_horiz_ave(struct All_variables *E, double **X, double *H);
+float return_bulk_value(struct All_variables *E, float **Z, int average);
+double return_bulk_value_d(struct All_variables *E, double **Z, int average);
+float find_max_horizontal(struct All_variables *E, double Tmax);
+void sum_across_surface(struct All_variables *E, float *data, int total);
+void sum_across_surf_sph1(struct All_variables *E, float *sphc, float *sphs);
+float global_fvdot(struct All_variables *E, float **A, float **B, int lev);
+double kineticE_radial(struct All_variables *E, double **A, int lev);
+double global_vdot(struct All_variables *E, double **A, double **B, int lev);
+double global_pdot(struct All_variables *E, double **A, double **B, int lev);
+double global_v_norm2(struct All_variables *E, double **V);
+double global_p_norm2(struct All_variables *E, double **P);
+double global_div_norm2(struct All_variables *E, double **A);
+double global_tdot_d(struct All_variables *E, double **A, double **B, int lev);
+float global_tdot(struct All_variables *E, float **A, float **B, int lev);
+float global_fmin(struct All_variables *E, float a);
+double global_dmax(struct All_variables *E, double a);
+float global_fmax(struct All_variables *E, double a);
+double Tmaxd(struct All_variables *E, double **T);
+float Tmax(struct All_variables *E, float **T);
+double vnorm_nonnewt(struct All_variables *E, double **dU, double **U, int lev);
+void sum_across_depth_sph1(struct All_variables *E, float *sphc, float *sphs);
+void broadcast_vertical(struct All_variables *E, float *sphc, float *sphs, int root);
+void remove_rigid_rot(struct All_variables *E);
+/* Initial_temperature.c */
+void tic_input(struct All_variables *E);
+void convection_initial_temperature(struct All_variables *E);
+/* Instructions.c */
+void initial_mesh_solver_setup(struct All_variables *E);
+void read_instructions(struct All_variables *E, char *filename);
+void initial_setup(struct All_variables *E);
+void initialize_material(struct All_variables *E);
+void initial_conditions(struct All_variables *E);
+void read_initial_settings(struct All_variables *E);
+void check_settings_consistency(struct All_variables *E);
+void global_derived_values(struct All_variables *E);
+void allocate_common_vars(struct All_variables *E);
+void allocate_velocity_vars(struct All_variables *E);
+void global_default_values(struct All_variables *E);
+void check_bc_consistency(struct All_variables *E);
+void set_up_nonmg_aliases(struct All_variables *E, int j);
+void report(struct All_variables *E, char *string);
+void record(struct All_variables *E, char *string);
+void common_initial_fields(struct All_variables *E);
+void initial_pressure(struct All_variables *E);
+void initial_velocity(struct All_variables *E);
+void open_qfiles(struct All_variables *E);
+void mkdatadir(const char *dir);
+void output_init(struct All_variables *E);
+void output_finalize(struct All_variables *E);
+char *strip(char *input);
+/* Interuption.c */
+void interuption(int signal_number);
+void set_signal(void);
+/* Lith_age.c */
+void lith_age_input(struct All_variables *E);
+void lith_age_init(struct All_variables *E);
+void lith_age_construct_tic(struct All_variables *E);
+void lith_age_update_tbc(struct All_variables *E);
+void lith_age_temperature_bound_adj(struct All_variables *E, int lv);
+void lith_age_conform_tbc(struct All_variables *E);
+void assimilate_lith_conform_bcs(struct All_variables *E);
+/* Material_properties.c */
+void mat_prop_allocate(struct All_variables *E);
+void reference_state(struct All_variables *E);
+/* Nodal_mesh.c */
+void v_from_vector(struct All_variables *E);
+void v_from_vector_pseudo_surf(struct All_variables *E);
+void velo_from_element(struct All_variables *E, float VV[4][9], int m, int el, int sphere_key);
+void velo_from_element_d(struct All_variables *E, double VV[4][9], int m, int el, int sphere_key);
+void p_to_nodes(struct All_variables *E, double **P, float **PN, int lev);
+void visc_from_gint_to_nodes(struct All_variables *E, float **VE, float **VN, int lev);
+void visc_from_nodes_to_gint(struct All_variables *E, float **VN, float **VE, int lev);
+void visc_from_gint_to_ele(struct All_variables *E, float **VE, float **VN, int lev);
+void visc_from_ele_to_gint(struct All_variables *E, float **VN, float **VE, int lev);
+/* Obsolete.c */
+void get_global_shape_fn(struct All_variables *E, int el, struct Shape_function *GN, struct Shape_function_dx *GNx, struct Shape_function_dA *dOmega, int pressure, int sphere, double rtf[4][9], int lev, int m);
+void get_global_1d_shape_fn_1(struct All_variables *E, int el, struct Shape_function *GM, struct Shape_function_dA *dGammax, int nodal, int m);
+void get_global_side_1d_shape_fn(struct All_variables *E, int el, struct Shape_function1 *GM, struct Shape_function1_dx *GMx, struct Shape_function_side_dA *dGamma, int NS, int far, int m);
+void get_elt_h(struct All_variables *E, int el, double elt_h[1], int m);
+void get_ele_visc(struct All_variables *E, float *EV, int m);
+void construct_interp_net(struct All_variables *E);
+int locate_cap(struct All_variables *E, double x[4]);
+int locate_element(struct All_variables *E, int m, double x[4], int ne);
+float sphere_interpolate_point(struct All_variables *E, float **T, int m, int el, double x[4], int ne);
+void sphere_interpolate(struct All_variables *E, float **T, float *TG);
+void phase_change_410(struct All_variables *E, float **B, float **B_b);
+void phase_change_670(struct All_variables *E, float **B, float **B_b);
+void phase_change_cmb(struct All_variables *E, float **B, float **B_b);
+void flogical_mesh_to_real(struct All_variables *E, float *data, int level);
+void p_to_centres(struct All_variables *E, float **PN, double **P, int lev);
+void v_to_intpts(struct All_variables *E, float **VN, float **VE, int lev);
+void visc_to_intpts(struct All_variables *E, float **VN, float **VE, int lev);
+double SIN_D(double x);
+double COT_D(double x);
+void *Malloc1(int bytes, char *file, int line);
+float cross2d(double x11, double x12, double x21, double x22, int D);
+double **dmatrix(int nrl, int nrh, int ncl, int nch);
+float **fmatrix(int nrl, int nrh, int ncl, int nch);
+void dfree_matrix(double **m, int nrl, int nrh, int ncl, int nch);
+void ffree_matrix(float **m, int nrl, int nrh, int ncl, int nch);
+double *dvector(int nl, int nh);
+float *fvector(int nl, int nh);
+void dfree_vector(double *v, int nl, int nh);
+void ffree_vector(float *v, int nl, int nh);
+int *sivector(int nl, int nh);
+void sifree_vector(int *v, int nl, int nh);
+void dvcopy(struct All_variables *E, double **A, double **B, int a, int b);
+void vcopy(float *A, float *B, int a, int b);
+double sphere_h(int l, int m, double t, double f, int ic);
+double plgndr_a(int l, int m, double t);
+float area_of_4node(double x1, double y1, double x2, double y2, double x3, double y3, double x4, double y4);
+void print_elt_k(struct All_variables *E, double a[24*24]);
+double sqrt_multis(int jj, int ii);
+double multis(int ii);
+int int_multis(int ii);
+void jacobi(struct All_variables *E, double **d0, double **F, double **Ad, double acc, int *cycles, int level, int guess);
+/* Output.c */
+void output_common_input(struct All_variables *E);
+void output(struct All_variables *E, int cycles);
+FILE *output_open(char *filename, char *mode);
+void output_coord(struct All_variables *E);
+void output_visc(struct All_variables *E, int cycles);
+void output_velo(struct All_variables *E, int cycles);
+void output_surf_botm(struct All_variables *E, int cycles);
+void output_geoid(struct All_variables *E, int cycles);
+void output_stress(struct All_variables *E, int cycles);
+void output_horiz_avg(struct All_variables *E, int cycles);
+void output_mat(struct All_variables *E);
+void output_pressure(struct All_variables *E, int cycles);
+void output_tracer(struct All_variables *E, int cycles);
+void output_comp_nd(struct All_variables *E, int cycles);
+void output_comp_el(struct All_variables *E, int cycles);
+void output_heating(struct All_variables *E, int cycles);
+void output_time(struct All_variables *E, int cycles);
+/* Output_gzdir.c */
+/* Output_h5.c */
+void h5output_allocate_memory(struct All_variables *E);
+void h5output(struct All_variables *E, int cycles);
+void h5input_params(struct All_variables *E);
+/* Output_vtk.c */
+void vtk_output(struct All_variables *E, int cycles);
+/* Pan_problem_misc_functions.c */
+int get_process_identifier(void);
+void unique_copy_file(struct All_variables *E, char *name, char *comment);
+void apply_side_sbc(struct All_variables *E);
+void get_buoyancy(struct All_variables *E, double **buoy);
+int read_double_vector(FILE *in, int num_columns, double *fields);
+int read_previous_field(struct All_variables *E, float **field, char *name, char *abbr);
+double myatan(double y, double x);
+double return1_test(void);
+void rtp2xyz(float r, float theta, float phi, float *xout);
+void xyz2rtp(float x, float y, float z, float *rout);
+void xyz2rtpd(float x, float y, float z, double *rout);
+void calc_cbase_at_tp(float theta, float phi, float *base);
+void calc_cbase_at_node(int cap, int node, float *base, struct All_variables *E);
+void convert_pvec_to_cvec(float vr, float vt, float vp, float *base, float *cvec);
+void *safe_malloc(size_t size);
+void myerror(struct All_variables *E, char *message);
+void get_r_spacing_fine(double *rr, struct All_variables *E);
+void get_r_spacing_at_levels(double *rr, struct All_variables *E);
+/* Parallel_util.c */
+void parallel_process_termination(void);
+void parallel_process_sync(struct All_variables *E);
+double CPU_time0(void);
+/* Parsing.c */
+void setup_parser(struct All_variables *E, char *filename);
+void shutdown_parser(struct All_variables *E);
+void add_to_parameter_list(char *name, char *value);
+int compute_parameter_hash_table(char *s);
+int input_int(char *name, int *value, char *interpret, int m);
+int input_string(char *name, char *value, char *Default, int m);
+int input_boolean(char *name, int *value, char *interpret, int m);
+int input_float(char *name, float *value, char *interpret, int m);
+int input_double(char *name, double *value, char *interpret, int m);
+int input_int_vector(char *name, int number, int *value, int m);
+int input_char_vector(char *name, int number, char *value, int m);
+int input_float_vector(char *name, int number, float *value, int m);
+int input_double_vector(char *name, int number, double *value, int m);
+int interpret_control_string(char *interpret, int *essential, double *Default, double *minvalue, double *maxvalue);
+/* Phase_change.c */
+void phase_change_allocate(struct All_variables *E);
+void phase_change_input(struct All_variables *E);
+void phase_change_apply_410(struct All_variables *E, double **buoy);
+void phase_change_apply_670(struct All_variables *E, double **buoy);
+void phase_change_apply_cmb(struct All_variables *E, double **buoy);
+/* Problem_related.c */
+void read_velocity_boundary_from_file(struct All_variables *E);
+void read_mat_from_file(struct All_variables *E);
+void read_temperature_boundary_from_file(struct All_variables *E);
+void get_initial_elapsed_time(struct All_variables *E);
+void set_elapsed_time(struct All_variables *E);
+void set_starting_age(struct All_variables *E);
+float find_age_in_MY(struct All_variables *E);
+/* Process_buoyancy.c */
+void post_processing(struct All_variables *E);
+void heat_flux(struct All_variables *E);
+void compute_horiz_avg(struct All_variables *E);
+/* Regional_boundary_conditions.c */
+void regional_velocity_boundary_conditions(struct All_variables *E);
+void regional_temperature_boundary_conditions(struct All_variables *E);
+/* Regional_geometry_cartesian.c */
+void regional_set_2dc_defaults(struct All_variables *E);
+void regional_set_2pt5dc_defaults(struct All_variables *E);
+void regional_set_3dc_defaults(struct All_variables *E);
+void regional_set_3dsphere_defaults(struct All_variables *E);
+void regional_set_3dsphere_defaults2(struct All_variables *E);
+/* Regional_lith_age_read_files.c */
+void regional_lith_age_read_files(struct All_variables *E, int output);
+/* Regional_obsolete.c */
+void parallel_process_initilization(struct All_variables *E, int argc, char **argv);
+void parallel_domain_decomp2(struct All_variables *E, float *GX[4]);
+void scatter_to_nlayer_id(struct All_variables *E, double **AUi, double **AUo, int lev);
+void gather_to_1layer_id(struct All_variables *E, double **AUi, double **AUo, int lev);
+void gather_to_1layer_node(struct All_variables *E, float **AUi, float **AUo, int lev);
+void gather_to_1layer_ele(struct All_variables *E, float **AUi, float **AUo, int lev);
+void gather_TG_to_me0(struct All_variables *E, float *TG);
+void renew_top_velocity_boundary(struct All_variables *E);
+void output_stress(struct All_variables *E, int file_number, float *SXX, float *SYY, float *SZZ, float *SXY, float *SXZ, float *SZY);
+void print_field_spectral_regular(struct All_variables *E, float *TG, float *sphc, float *sphs, int proc_loc, char *filen);
+void output_velo_related(struct All_variables *E, int file_number);
+void output_temp(struct All_variables *E, int file_number);
+void output_visc_prepare(struct All_variables *E, float **VE);
+void output_visc(struct All_variables *E, int cycles);
+void process_temp_field(struct All_variables *E, int ii);
+void process_new_velocity(struct All_variables *E, int ii);
+void get_surface_velo(struct All_variables *E, float *SV, int m);
+/* Regional_parallel_related.c */
+void regional_parallel_processor_setup(struct All_variables *E);
+void regional_parallel_domain_decomp0(struct All_variables *E);
+void regional_parallel_domain_boundary_nodes(struct All_variables *E);
+void regional_parallel_communication_routs_v(struct All_variables *E);
+void regional_parallel_communication_routs_s(struct All_variables *E);
+void regional_exchange_id_d(struct All_variables *E, double **U, int lev);
+void regional_exchange_snode_f(struct All_variables *E, float **U1, float **U2, int lev);
+/* Regional_read_input_from_files.c */
+void regional_read_input_files_for_timesteps(struct All_variables *E, int action, int output);
+/* Regional_solver.c */
+void regional_solver_init(struct All_variables *E);
+/* Regional_sphere_related.c */
+void regional_coord_of_cap(struct All_variables *E, int m, int icap);
+/* Regional_tracer_advection.c */
+void regional_tracer_setup(struct All_variables *E);
+int regional_iget_element(struct All_variables *E, int m, int iprevious_element, double dummy1, double dummy2, double dummy3, double theta, double phi, double rad);
+int isearch_all(double *array, int nsize, double a);
+int isearch_neighbors(double *array, int nsize, double a, int hint);
+int regional_icheck_cap(struct All_variables *E, int icap, double theta, double phi, double rad, double junk);
+void regional_get_shape_functions(struct All_variables *E, double shp[9], int nelem, double theta, double phi, double rad);
+double regional_interpolate_data(struct All_variables *E, double shp[9], double data[9]);
+void regional_get_velocity(struct All_variables *E, int m, int nelem, double theta, double phi, double rad, double *velocity_vector);
+void regional_keep_within_bounds(struct All_variables *E, double *x, double *y, double *z, double *theta, double *phi, double *rad);
+void regional_lost_souls(struct All_variables *E);
+/* Regional_version_dependent.c */
+void regional_node_locations(struct All_variables *E);
+void regional_construct_boundary(struct All_variables *E);
+/* Shape_functions.c */
+void construct_shape_functions(struct All_variables *E);
+double lpoly(int p, double y);
+double lpolydash(int p, double y);
+/* Size_does_matter.c */
+void twiddle_thumbs(struct All_variables *yawn);
+void construct_shape_function_derivatives(struct All_variables *E);
+void get_rtf_at_vpts(struct All_variables *E, int m, int lev, int el, double rtf[4][9]);
+void get_rtf_at_ppts(struct All_variables *E, int m, int lev, int el, double rtf[4][9]);
+void get_side_x_cart(struct All_variables *E, double xx[4][5], int el, int side, int m);
+void construct_surf_det(struct All_variables *E);
+void construct_bdry_det(struct All_variables *E);
+void get_global_1d_shape_fn(struct All_variables *E, int el, struct Shape_function1 *GM, struct Shape_function1_dA *dGammax, int top, int m);
+void get_global_1d_shape_fn_L(struct All_variables *E, int el, struct Shape_function1 *GM, struct Shape_function1_dA *dGammax, int top, int m);
+void get_global_side_1d_shape_fn(struct All_variables *E, int el, struct Shape_function1 *GM, struct Shape_function1_dx *GMx, struct Shape_function_side_dA *dGamma, int side, int m);
+void construct_c3x3matrix_el(struct All_variables *E, int el, struct CC *cc, struct CCX *ccx, int lev, int m, int pressure);
+void construct_side_c3x3matrix_el(struct All_variables *E, int el, struct CC *cc, struct CCX *ccx, int lev, int m, int pressure, int side);
+void construct_c3x3matrix(struct All_variables *E);
+void mass_matrix(struct All_variables *E);
+/* Solver_conj_grad.c */
+void set_cg_defaults(struct All_variables *E);
+void cg_allocate_vars(struct All_variables *E);
+void assemble_forces_iterative(struct All_variables *E);
+/* Solver_multigrid.c */
+void set_mg_defaults(struct All_variables *E);
+void mg_allocate_vars(struct All_variables *E);
+void inject_scalar(struct All_variables *E, int start_lev, float **AU, float **AD);
+void inject_vector(struct All_variables *E, int start_lev, double **AU, double **AD);
+void un_inject_vector(struct All_variables *E, int start_lev, double **AD, double **AU);
+void interp_vector(struct All_variables *E, int start_lev, double **AD, double **AU);
+void project_viscosity(struct All_variables *E);
+void inject_scalar_e(struct All_variables *E, int start_lev, float **AU, float **AD);
+void project_scalar_e(struct All_variables *E, int start_lev, float **AU, float **AD);
+void project_scalar(struct All_variables *E, int start_lev, float **AU, float **AD);
+void project_vector(struct All_variables *E, int start_lev, double **AU, double **AD, int ic);
+void from_xyz_to_rtf(struct All_variables *E, int level, double **xyz, double **rtf);
+void from_rtf_to_xyz(struct All_variables *E, int level, double **rtf, double **xyz);
+void fill_in_gaps(struct All_variables *E, double **temp, int level);
+/* Sphere_harmonics.c */
+void set_sphere_harmonics(struct All_variables *E);
+double modified_plgndr_a(int l, int m, double t);
+void sphere_expansion(struct All_variables *E, float **TG, float *sphc, float *sphs);
+void debug_sphere_expansion(struct All_variables *E);
+/* Sphere_util.c */
+void even_divide_arc12(int elx, double x1, double y1, double z1, double x2, double y2, double z2, double *theta, double *fi);
+void compute_angle_surf_area(struct All_variables *E);
+double area_sphere_cap(double angle[6]);
+double area_of_sphere_triag(double a, double b, double c);
+double area_of_5points(struct All_variables *E, int lev, int m, int el, double x[4], int ne);
+void get_angle_sphere_cap(double xx[4][5], double angle[6]);
+double get_angle(double x[4], double xx[4]);
+/* Stokes_flow_Incomp.c */
+void solve_constrained_flow_iterative(struct All_variables *E);
+void solve_constrained_flow_iterative_pseudo_surf(struct All_variables *E);
+/* Topo_gravity.c */
+void get_STD_topo(struct All_variables *E, float **tpg, float **tpgb, float **divg, float **vort, int ii);
+void get_STD_freesurf(struct All_variables *E, float **freesurf);
+void allocate_STD_mem(struct All_variables *E, float **SXX, float **SYY, float **SZZ, float **SXY, float **SXZ, float **SZY, float **divv, float **vorv);
+void free_STD_mem(struct All_variables *E, float **SXX, float **SYY, float **SZZ, float **SXY, float **SXZ, float **SZY, float **divv, float **vorv);
+void compute_nodal_stress(struct All_variables *E, float **SXX, float **SYY, float **SZZ, float **SXY, float **SXZ, float **SZY, float **divv, float **vorv);
+void stress_conform_bcs(struct All_variables *E);
+void compute_geoid(struct All_variables *E);
+void get_CBF_topo(struct All_variables *E, float **H, float **HB);
+/* Tracer_setup.c */
+void tracer_input(struct All_variables *E);
+void tracer_initial_settings(struct All_variables *E);
+void tracer_advection(struct All_variables *E);
+void tracer_post_processing(struct All_variables *E);
+void count_tracers_of_flavors(struct All_variables *E);
+void initialize_tracers(struct All_variables *E);
+void dump_and_get_new_tracers_to_interpolate_fields(struct All_variables *E);
+void cart_to_sphere(struct All_variables *E, double x, double y, double z, double *theta, double *phi, double *rad);
+void sphere_to_cart(struct All_variables *E, double theta, double phi, double rad, double *x, double *y, double *z);
+void get_neighboring_caps(struct All_variables *E);
+void allocate_tracer_arrays(struct All_variables *E, int j, int number_of_tracers);
+void expand_tracer_arrays(struct All_variables *E, int j);
+void expand_later_array(struct All_variables *E, int j);
+int icheck_processor_shell(struct All_variables *E, int j, double rad);
+int icheck_that_processor_shell(struct All_variables *E, int j, int nprocessor, double rad);
+/* Viscosity_structures.c */
+void viscosity_system_input(struct All_variables *E);
+void viscosity_input(struct All_variables *E);
+void get_system_viscosity(struct All_variables *E, int propogate, float **evisc, float **visc);
+void initial_viscosity(struct All_variables *E);
+void visc_from_mat(struct All_variables *E, float **EEta);
+void visc_from_T(struct All_variables *E, float **EEta, int propogate);
+void visc_from_S(struct All_variables *E, float **EEta, int propogate);
+void visc_from_P(struct All_variables *E, float **EEta);
+void visc_from_C(struct All_variables *E, float **EEta);
+void strain_rate_2_inv(struct All_variables *E, int m, float *EEDOT, int SQRT);
Modified: mc/3D/CitcomS/branches/cxx/lib/drive_solvers.h
===================================================================
--- mc/3D/CitcomS/trunk/lib/drive_solvers.h 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/drive_solvers.h 2009-02-13 03:39:35 UTC (rev 14045)
@@ -28,15 +28,7 @@
#if !defined(CitcomS_drive_solvers_h)
#define CitcomS_drive_solvers_h
-#ifdef __cplusplus
-extern "C" {
-#endif
-
void general_stokes_solver(struct All_variables*);
void general_stokes_solver_setup(struct All_variables*);
-#ifdef __cplusplus
-}
#endif
-
-#endif
Modified: mc/3D/CitcomS/branches/cxx/lib/global_defs.h
===================================================================
--- mc/3D/CitcomS/trunk/lib/global_defs.h 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/global_defs.h 2009-02-13 03:39:35 UTC (rev 14045)
@@ -48,23 +48,15 @@
#include "hdf5.h"
#endif
-#ifdef __cplusplus
-extern "C" {
-#else
-
-
-
/* Macros */
#define max(A,B) (((A) > (B)) ? (A) : (B))
#define min(A,B) (((A) < (B)) ? (A) : (B))
#define SWAP(a,b) {temp=(a);(a)=(b);(b)=temp;}
-#endif
-
#define LIDN 0x1
#define VBX 0x2
#define VBZ 0x4
@@ -797,27 +789,27 @@
struct Shape_function1_dx Lx;
struct Shape_function_dx NMx;
- void (* build_forcing_term)(void*);
- void (* iterative_solver)(void*);
- void (* next_buoyancy_field)(void*);
- void (* next_buoyancy_field_init)(void*);
- void (* obtain_gravity)(void*);
- void (* problem_settings)(void*);
- void (* problem_derived_values)(void*);
- void (* problem_allocate_vars)(void*);
- void (* problem_boundary_conds)(void*);
- void (* problem_update_node_positions)(void*);
- void (* problem_initial_fields)(void*);
- void (* problem_tracer_setup)(void*);
- void (* problem_tracer_output)(void*, int);
- void (* problem_update_bcs)(void*);
- void (* special_process_new_velocity)(void*);
- void (* special_process_new_buoyancy)(void*);
- void (* solve_stokes_problem)(void*);
- void (* solver_allocate_vars)(void*);
- void (* transform)(void*);
+ void (* build_forcing_term)(struct All_variables *);
+ void (* iterative_solver)(struct All_variables *);
+ void (* next_buoyancy_field)(struct All_variables *);
+ void (* next_buoyancy_field_init)(struct All_variables *);
+ void (* obtain_gravity)(struct All_variables *);
+ void (* problem_settings)(struct All_variables *);
+ void (* problem_derived_values)(struct All_variables *);
+ void (* problem_allocate_vars)(struct All_variables *);
+ void (* problem_boundary_conds)(struct All_variables *);
+ void (* problem_update_node_positions)(struct All_variables *);
+ void (* problem_initial_fields)(struct All_variables *);
+ void (* problem_tracer_setup)(struct All_variables *);
+ void (* problem_tracer_output)(struct All_variables *, int);
+ void (* problem_update_bcs)(struct All_variables *);
+ void (* special_process_new_velocity)(struct All_variables *);
+ void (* special_process_new_buoyancy)(struct All_variables *);
+ void (* solve_stokes_problem)(struct All_variables *);
+ void (* solver_allocate_vars)(struct All_variables *);
+ void (* transform)(struct All_variables *);
- float (* node_space_function[3])(void*);
+ float (* node_space_function[3])(struct All_variables *);
/* function pointer for choosing between various output routines */
void (* problem_output)(struct All_variables *, int);
@@ -825,15 +817,9 @@
/* the following function pointers are for exchanger */
void (* exchange_node_d)(struct All_variables *, double**, int);
void (* exchange_node_f)(struct All_variables *, float**, int);
- void (* temperatures_conform_bcs)(void*);
+ void (* temperatures_conform_bcs)(struct All_variables *);
};
-#ifdef __cplusplus
-}
-#endif
-
-
-
#endif
Modified: mc/3D/CitcomS/branches/cxx/lib/output.h
===================================================================
--- mc/3D/CitcomS/trunk/lib/output.h 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/output.h 2009-02-13 03:39:35 UTC (rev 14045)
@@ -29,10 +29,6 @@
#if !defined(CitcomS_output_h)
#define CitcomS_output_h
-#ifdef __cplusplus
-extern "C" {
-#endif
-
void output_common_input(struct All_variables *);
void output(struct All_variables *, int);
void output_time(struct All_variables *, int);
@@ -40,10 +36,6 @@
FILE* output_open(char *, char *);
-#ifdef __cplusplus
-}
-#endif
-
#ifdef USE_GZDIR
void gzdir_output(struct All_variables *, int );
#endif
Modified: mc/3D/CitcomS/branches/cxx/lib/output_h5.h
===================================================================
--- mc/3D/CitcomS/trunk/lib/output_h5.h 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/output_h5.h 2009-02-13 03:39:35 UTC (rev 14045)
@@ -29,16 +29,8 @@
#if !defined(CitcomS_output_h5_h)
#define CitcomS_output_h5_h
-#ifdef __cplusplus
-extern "C" {
-#endif
-
void h5output_allocate_memory(struct All_variables *);
void h5input_params(struct All_variables *);
void h5output(struct All_variables *, int);
-#ifdef __cplusplus
-}
#endif
-
-#endif
Modified: mc/3D/CitcomS/branches/cxx/lib/parallel_related.h
===================================================================
--- mc/3D/CitcomS/trunk/lib/parallel_related.h 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/lib/parallel_related.h 2009-02-13 03:39:35 UTC (rev 14045)
@@ -29,17 +29,9 @@
#if !defined(CitcomS_parallel_related_h)
#define CitcomS_parallel_related_h
-#ifdef __cplusplus
-extern "C" {
-#endif
-
void parallel_process_termination();
void parallel_process_sync(struct All_variables *E);
double CPU_time0();
void set_communication_sphereh(struct All_variables *E);
-#ifdef __cplusplus
-}
#endif
-
-#endif
Deleted: mc/3D/CitcomS/branches/cxx/module/CitcomSmodule.c
===================================================================
--- mc/3D/CitcomS/trunk/module/CitcomSmodule.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/module/CitcomSmodule.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,64 +0,0 @@
-/*
-//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-//
-//<LicenseText>
-//
-// CitcomS.py by Eh Tan, Eun-seo Choi, and Pururav Thoutireddy.
-// Copyright (C) 2002-2005, California Institute of Technology.
-//
-// 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-//
-//</LicenseText>
-//
-//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-*/
-
-#include <Python.h>
-
-#include "CitcomSmodule.h"
-#include "exceptions.h"
-#include "bindings.h"
-
-
-char pyCitcomS_module__doc__[] = "";
-
-/* Initialization function for the module (*must* be called initCitcomSLib) */
-void
-initCitcomSLib()
-{
- PyObject *m, *d;
- /* create the module and add the functions */
- m = Py_InitModule4(
- "CitcomSLib", pyCitcom_methods,
- pyCitcomS_module__doc__, 0, PYTHON_API_VERSION);
-
- /* get its dictionary */
- d = PyModule_GetDict(m);
-
- /* check for errors */
- if (PyErr_Occurred()) {
- Py_FatalError("can't initialize module CitcomSLib");
- }
-
- /* install the module exceptions */
- pyCitcom_runtimeError = PyErr_NewException("CitcomSLib.runtime", 0, 0);
- PyDict_SetItemString(d, "RuntimeException", pyCitcom_runtimeError);
-
- return;
-}
-
-/* $Id$ */
-
-/* End of file */
Copied: mc/3D/CitcomS/branches/cxx/module/CitcomSmodule.cc (from rev 14029, mc/3D/CitcomS/trunk/module/CitcomSmodule.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/module/CitcomSmodule.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/module/CitcomSmodule.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,64 @@
+/*
+//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+//
+//<LicenseText>
+//
+// CitcomS.py by Eh Tan, Eun-seo Choi, and Pururav Thoutireddy.
+// Copyright (C) 2002-2005, California Institute of Technology.
+//
+// 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+//
+//</LicenseText>
+//
+//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+*/
+
+#include <Python.h>
+
+#include "CitcomSmodule.h"
+#include "exceptions.h"
+#include "bindings.h"
+
+
+char pyCitcomS_module__doc__[] = "";
+
+/* Initialization function for the module (*must* be called initCitcomSLib) */
+void
+initCitcomSLib()
+{
+ PyObject *m, *d;
+ /* create the module and add the functions */
+ m = Py_InitModule4(
+ "CitcomSLib", pyCitcom_methods,
+ pyCitcomS_module__doc__, 0, PYTHON_API_VERSION);
+
+ /* get its dictionary */
+ d = PyModule_GetDict(m);
+
+ /* check for errors */
+ if (PyErr_Occurred()) {
+ Py_FatalError("can't initialize module CitcomSLib");
+ }
+
+ /* install the module exceptions */
+ pyCitcom_runtimeError = PyErr_NewException("CitcomSLib.runtime", 0, 0);
+ PyDict_SetItemString(d, "RuntimeException", pyCitcom_runtimeError);
+
+ return;
+}
+
+/* $Id$ */
+
+/* End of file */
Modified: mc/3D/CitcomS/branches/cxx/module/Makefile.am
===================================================================
--- mc/3D/CitcomS/trunk/module/Makefile.am 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/module/Makefile.am 2009-02-13 03:39:35 UTC (rev 14045)
@@ -52,7 +52,7 @@
# static libraries
-libCitcomSLibmodule_a_CFLAGS = $(AM_CFLAGS) # hack for automake
+libCitcomSLibmodule_a_CXXFLAGS = $(AM_CXXFLAGS) # hack for automake
libCitcomSLibmodule_a_SOURCES = $(sources)
# extension modules (libtool)
@@ -66,26 +66,26 @@
# sources
sources = \
- CitcomSmodule.c \
+ CitcomSmodule.cc \
CitcomSmodule.h \
- advdiffu.c \
+ advdiffu.cc \
advdiffu.h \
- bindings.c \
+ bindings.cc \
bindings.h \
- exceptions.c \
+ exceptions.cc \
exceptions.h \
getProperty.h \
- initial_conditions.c \
+ initial_conditions.cc \
initial_conditions.h \
- mesher.c \
+ mesher.cc \
mesher.h \
- misc.c \
+ misc.cc \
misc.h \
- outputs.c \
+ outputs.cc \
outputs.h \
- setProperties.c \
+ setProperties.cc \
setProperties.h \
- stokes_solver.c \
+ stokes_solver.cc \
stokes_solver.h
## end of Makefile.am
Deleted: mc/3D/CitcomS/branches/cxx/module/advdiffu.c
===================================================================
--- mc/3D/CitcomS/trunk/module/advdiffu.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/module/advdiffu.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,133 +0,0 @@
-/*
-//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-//
-//<LicenseText>
-//
-// CitcomS.py by Eh Tan, Eun-seo Choi, and Pururav Thoutireddy.
-// Copyright (C) 2002-2005, California Institute of Technology.
-//
-// 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-//
-//</LicenseText>
-//
-//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-*/
-
-#include <Python.h>
-#include <stdio.h>
-
-#include "advdiffu.h"
-
-#include "global_defs.h"
-#include "advection_diffusion.h"
-
-
-extern void set_convection_defaults(struct All_variables *);
-
-
-char pyCitcom_PG_timestep_init__doc__[] = "";
-char pyCitcom_PG_timestep_init__name__[] = "PG_timestep_init";
-PyObject * pyCitcom_PG_timestep_init(PyObject *self, PyObject *args)
-{
- PyObject *obj;
- struct All_variables* E;
-
- if (!PyArg_ParseTuple(args, "O:PG_timestep_init", &obj))
- return NULL;
-
- E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
-
- PG_timestep_init(E);
-
- Py_INCREF(Py_None);
- return Py_None;
-}
-
-
-char pyCitcom_PG_timestep_solve__doc__[] = "";
-char pyCitcom_PG_timestep_solve__name__[] = "PG_timestep_solve";
-PyObject * pyCitcom_PG_timestep_solve(PyObject *self, PyObject *args)
-{
- PyObject *obj;
- double dt;
- struct All_variables* E;
-
- if (!PyArg_ParseTuple(args, "Od:PG_timestep_solve", &obj, &dt))
- return NULL;
-
- E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
-
- /* This function replaces some code in Citcom.c
- * If you modify here, make sure its counterpart
- * is modified as well */
- E->monitor.solution_cycles++;
- if(E->monitor.solution_cycles>E->control.print_convergence)
- E->control.print_convergence=1;
-
- /* Since dt may be modified in Pyre, we need to update
- * E->advection.timestep again */
- E->advection.timestep = dt;
-
- PG_timestep_solve(E);
-
- Py_INCREF(Py_None);
- return Py_None;
-}
-
-
-char pyCitcom_set_convection_defaults__doc__[] = "";
-char pyCitcom_set_convection_defaults__name__[] = "set_convection_defaults";
-PyObject * pyCitcom_set_convection_defaults(PyObject *self, PyObject *args)
-{
- PyObject *obj;
- struct All_variables* E;
-
- if (!PyArg_ParseTuple(args, "O:set_convection_defaults", &obj))
- return NULL;
-
- E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
-
- E->control.CONVECTION = 1;
- set_convection_defaults(E);
-
- Py_INCREF(Py_None);
- return Py_None;
-}
-
-
-char pyCitcom_stable_timestep__doc__[] = "";
-char pyCitcom_stable_timestep__name__[] = "stable_timestep";
-PyObject * pyCitcom_stable_timestep(PyObject *self, PyObject *args)
-{
- PyObject *obj;
- struct All_variables* E;
-
- if (!PyArg_ParseTuple(args, "O:stable_timestep", &obj))
- return NULL;
-
- E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
-
-
- std_timestep(E);
-
- return Py_BuildValue("d", E->advection.timestep);
-}
-
-
-
-
-/* $Id$ */
-
-/* End of file */
Copied: mc/3D/CitcomS/branches/cxx/module/advdiffu.cc (from rev 14029, mc/3D/CitcomS/trunk/module/advdiffu.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/module/advdiffu.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/module/advdiffu.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,133 @@
+/*
+//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+//
+//<LicenseText>
+//
+// CitcomS.py by Eh Tan, Eun-seo Choi, and Pururav Thoutireddy.
+// Copyright (C) 2002-2005, California Institute of Technology.
+//
+// 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+//
+//</LicenseText>
+//
+//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+*/
+
+#include <Python.h>
+#include <stdio.h>
+
+#include "advdiffu.h"
+
+#include "global_defs.h"
+#include "advection_diffusion.h"
+
+
+extern void set_convection_defaults(struct All_variables *);
+
+
+char pyCitcom_PG_timestep_init__doc__[] = "";
+char pyCitcom_PG_timestep_init__name__[] = "PG_timestep_init";
+PyObject * pyCitcom_PG_timestep_init(PyObject *self, PyObject *args)
+{
+ PyObject *obj;
+ struct All_variables* E;
+
+ if (!PyArg_ParseTuple(args, "O:PG_timestep_init", &obj))
+ return NULL;
+
+ E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
+
+ PG_timestep_init(E);
+
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+
+char pyCitcom_PG_timestep_solve__doc__[] = "";
+char pyCitcom_PG_timestep_solve__name__[] = "PG_timestep_solve";
+PyObject * pyCitcom_PG_timestep_solve(PyObject *self, PyObject *args)
+{
+ PyObject *obj;
+ double dt;
+ struct All_variables* E;
+
+ if (!PyArg_ParseTuple(args, "Od:PG_timestep_solve", &obj, &dt))
+ return NULL;
+
+ E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
+
+ /* This function replaces some code in Citcom.c
+ * If you modify here, make sure its counterpart
+ * is modified as well */
+ E->monitor.solution_cycles++;
+ if(E->monitor.solution_cycles>E->control.print_convergence)
+ E->control.print_convergence=1;
+
+ /* Since dt may be modified in Pyre, we need to update
+ * E->advection.timestep again */
+ E->advection.timestep = dt;
+
+ PG_timestep_solve(E);
+
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+
+char pyCitcom_set_convection_defaults__doc__[] = "";
+char pyCitcom_set_convection_defaults__name__[] = "set_convection_defaults";
+PyObject * pyCitcom_set_convection_defaults(PyObject *self, PyObject *args)
+{
+ PyObject *obj;
+ struct All_variables* E;
+
+ if (!PyArg_ParseTuple(args, "O:set_convection_defaults", &obj))
+ return NULL;
+
+ E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
+
+ E->control.CONVECTION = 1;
+ set_convection_defaults(E);
+
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+
+char pyCitcom_stable_timestep__doc__[] = "";
+char pyCitcom_stable_timestep__name__[] = "stable_timestep";
+PyObject * pyCitcom_stable_timestep(PyObject *self, PyObject *args)
+{
+ PyObject *obj;
+ struct All_variables* E;
+
+ if (!PyArg_ParseTuple(args, "O:stable_timestep", &obj))
+ return NULL;
+
+ E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
+
+
+ std_timestep(E);
+
+ return Py_BuildValue("d", E->advection.timestep);
+}
+
+
+
+
+/* $Id$ */
+
+/* End of file */
Deleted: mc/3D/CitcomS/branches/cxx/module/bindings.c
===================================================================
--- mc/3D/CitcomS/trunk/module/bindings.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/module/bindings.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,381 +0,0 @@
-/*
-//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-//
-//<LicenseText>
-//
-// CitcomS.py by Eh Tan, Eun-seo Choi, and Pururav Thoutireddy.
-// Copyright (C) 2002-2005, California Institute of Technology.
-//
-// 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-//
-//</LicenseText>
-//
-//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-*/
-
-#include <Python.h>
-
-#include "bindings.h"
-
-#include "advdiffu.h"
-#include "initial_conditions.h"
-#include "mesher.h"
-#include "misc.h"
-#include "outputs.h"
-#include "setProperties.h"
-#include "stokes_solver.h"
-
-
-/* the method table */
-
-struct PyMethodDef pyCitcom_methods[] = {
-
- /* dummy entry for testing */
- {pyCitcom_copyright__name__,
- pyCitcom_copyright,
- METH_VARARGS,
- pyCitcom_copyright__doc__},
-
-
- /*////////////////////////////////////////////////////////////////////////
- // This section is for testing or temporatory implementation
- ////////////////////////////////////////////////////////////////////////*/
-
- {pyCitcom_return1_test__name__,
- pyCitcom_return1_test,
- METH_VARARGS,
- pyCitcom_return1_test__doc__},
-
- {pyCitcom_CPU_time__name__,
- pyCitcom_CPU_time,
- METH_VARARGS,
- pyCitcom_CPU_time__doc__},
-
- {pyCitcom_read_instructions__name__,
- pyCitcom_read_instructions,
- METH_VARARGS,
- pyCitcom_read_instructions__doc__},
-
-
- /*////////////////////////////////////////////////////////////////////////
- // This section is for finished implementation
- ////////////////////////////////////////////////////////////////////////*/
-
- /* from misc.h */
-
- {pyCitcom_citcom_init__name__,
- pyCitcom_citcom_init,
- METH_VARARGS,
- pyCitcom_citcom_init__doc__},
-
- {pyCitcom_full_solver_init__name__,
- pyCitcom_full_solver_init,
- METH_VARARGS,
- pyCitcom_full_solver_init__doc__},
-
- {pyCitcom_regional_solver_init__name__,
- pyCitcom_regional_solver_init,
- METH_VARARGS,
- pyCitcom_regional_solver_init__doc__},
-
- {pyCitcom_global_default_values__name__,
- pyCitcom_global_default_values,
- METH_VARARGS,
- pyCitcom_global_default_values__doc__},
-
- {pyCitcom_set_signal__name__,
- pyCitcom_set_signal,
- METH_VARARGS,
- pyCitcom_set_signal__doc__},
-
- {pyCitcom_check_settings_consistency__name__,
- pyCitcom_check_settings_consistency,
- METH_VARARGS,
- pyCitcom_check_settings_consistency__doc__},
-
- {pyCitcom_velocities_conform_bcs__name__,
- pyCitcom_velocities_conform_bcs,
- METH_VARARGS,
- pyCitcom_velocities_conform_bcs__doc__},
-
- {pyCitcom_BC_update_plate_temperature__name__,
- pyCitcom_BC_update_plate_temperature,
- METH_VARARGS,
- pyCitcom_BC_update_plate_temperature__doc__},
-
- {pyCitcom_BC_update_plate_velocity__name__,
- pyCitcom_BC_update_plate_velocity,
- METH_VARARGS,
- pyCitcom_BC_update_plate_velocity__doc__},
-
- {pyCitcom_Tracer_tracer_advection__name__,
- pyCitcom_Tracer_tracer_advection,
- METH_VARARGS,
- pyCitcom_Tracer_tracer_advection__doc__},
-
- {pyCitcom_Visc_update_material__name__,
- pyCitcom_Visc_update_material,
- METH_VARARGS,
- pyCitcom_Visc_update_material__doc__},
-
- {pyCitcom_return_dt__name__,
- pyCitcom_return_dt,
- METH_VARARGS,
- pyCitcom_return_dt__doc__},
-
- {pyCitcom_return_step__name__,
- pyCitcom_return_step,
- METH_VARARGS,
- pyCitcom_return_step__doc__},
-
- {pyCitcom_return_t__name__,
- pyCitcom_return_t,
- METH_VARARGS,
- pyCitcom_return_t__doc__},
-
- {pyCitcom_return_rank__name__,
- pyCitcom_return_rank,
- METH_VARARGS,
- pyCitcom_return_rank__doc__},
-
- {pyCitcom_return_pid__name__,
- pyCitcom_return_pid,
- METH_VARARGS,
- pyCitcom_return_pid__doc__},
-
- /* from advdiffu.h */
-
- {pyCitcom_PG_timestep_init__name__,
- pyCitcom_PG_timestep_init,
- METH_VARARGS,
- pyCitcom_PG_timestep_init__doc__},
-
- {pyCitcom_PG_timestep_solve__name__,
- pyCitcom_PG_timestep_solve,
- METH_VARARGS,
- pyCitcom_PG_timestep_solve__doc__},
-
- {pyCitcom_set_convection_defaults__name__,
- pyCitcom_set_convection_defaults,
- METH_VARARGS,
- pyCitcom_set_convection_defaults__doc__},
-
- {pyCitcom_stable_timestep__name__,
- pyCitcom_stable_timestep,
- METH_VARARGS,
- pyCitcom_stable_timestep__doc__},
-
- /* from initial_conditions.h */
-
- {pyCitcom_ic_initialize_material__name__,
- pyCitcom_ic_initialize_material,
- METH_VARARGS,
- pyCitcom_ic_initialize_material__doc__},
-
- {pyCitcom_ic_init_tracer_composition__name__,
- pyCitcom_ic_init_tracer_composition,
- METH_VARARGS,
- pyCitcom_ic_init_tracer_composition__doc__},
-
- {pyCitcom_ic_constructTemperature__name__,
- pyCitcom_ic_constructTemperature,
- METH_VARARGS,
- pyCitcom_ic_constructTemperature__doc__},
-
- {pyCitcom_ic_initPressure__name__,
- pyCitcom_ic_initPressure,
- METH_VARARGS,
- pyCitcom_ic_initPressure__doc__},
-
- {pyCitcom_ic_initVelocity__name__,
- pyCitcom_ic_initVelocity,
- METH_VARARGS,
- pyCitcom_ic_initVelocity__doc__},
-
- {pyCitcom_ic_initViscosity__name__,
- pyCitcom_ic_initViscosity,
- METH_VARARGS,
- pyCitcom_ic_initViscosity__doc__},
-
- {pyCitcom_ic_readCheckpoint__name__,
- pyCitcom_ic_readCheckpoint,
- METH_VARARGS,
- pyCitcom_ic_readCheckpoint__doc__},
-
- {pyCitcom_ic_postProcessing__name__,
- pyCitcom_ic_postProcessing,
- METH_VARARGS,
- pyCitcom_ic_postProcessing__doc__},
-
- /* from mesher.h */
-
- {pyCitcom_full_sphere_launch__name__,
- pyCitcom_full_sphere_launch,
- METH_VARARGS,
- pyCitcom_full_sphere_launch__doc__},
-
- {pyCitcom_regional_sphere_launch__name__,
- pyCitcom_regional_sphere_launch,
- METH_VARARGS,
- pyCitcom_regional_sphere_launch__doc__},
-
- /* from outputs.h */
-
- {pyCitcom_output__name__,
- pyCitcom_output,
- METH_VARARGS,
- pyCitcom_output__doc__},
-
- {pyCitcom_output_finalize__name__,
- pyCitcom_output_finalize,
- METH_VARARGS,
- pyCitcom_output_finalize__doc__},
-
- {pyCitcom_output_time__name__,
- pyCitcom_output_time,
- METH_VARARGS,
- pyCitcom_output_time__doc__},
-
- {pyCitcom_output_checkpoint__name__,
- pyCitcom_output_checkpoint,
- METH_VARARGS,
- pyCitcom_output_checkpoint__doc__},
-
- /* from setProperties.h */
-
- {pyCitcom_Advection_diffusion_set_properties__name__,
- pyCitcom_Advection_diffusion_set_properties,
- METH_VARARGS,
- pyCitcom_Advection_diffusion_set_properties__doc__},
-
- {pyCitcom_BC_set_properties__name__,
- pyCitcom_BC_set_properties,
- METH_VARARGS,
- pyCitcom_BC_set_properties__doc__},
-
- {pyCitcom_Const_set_properties__name__,
- pyCitcom_Const_set_properties,
- METH_VARARGS,
- pyCitcom_Const_set_properties__doc__},
-
- {pyCitcom_IC_set_properties__name__,
- pyCitcom_IC_set_properties,
- METH_VARARGS,
- pyCitcom_IC_set_properties__doc__},
-
- {pyCitcom_Output_set_properties__name__,
- pyCitcom_Output_set_properties,
- METH_VARARGS,
- pyCitcom_Output_set_properties__doc__},
-
- {pyCitcom_Param_set_properties__name__,
- pyCitcom_Param_set_properties,
- METH_VARARGS,
- pyCitcom_Param_set_properties__doc__},
-
- {pyCitcom_Phase_set_properties__name__,
- pyCitcom_Phase_set_properties,
- METH_VARARGS,
- pyCitcom_Phase_set_properties__doc__},
-
- {pyCitcom_Solver_set_properties__name__,
- pyCitcom_Solver_set_properties,
- METH_VARARGS,
- pyCitcom_Solver_set_properties__doc__},
-
- {pyCitcom_Sphere_set_properties__name__,
- pyCitcom_Sphere_set_properties,
- METH_VARARGS,
- pyCitcom_Sphere_set_properties__doc__},
-
- {pyCitcom_Tracer_set_properties__name__,
- pyCitcom_Tracer_set_properties,
- METH_VARARGS,
- pyCitcom_Tracer_set_properties__doc__},
-
- {pyCitcom_Visc_set_properties__name__,
- pyCitcom_Visc_set_properties,
- METH_VARARGS,
- pyCitcom_Visc_set_properties__doc__},
-
- {pyCitcom_Incompressible_set_properties__name__,
- pyCitcom_Incompressible_set_properties,
- METH_VARARGS,
- pyCitcom_Incompressible_set_properties__doc__},
-
- /* from stokes_solver.h */
-
- {pyCitcom_assemble_forces__name__,
- pyCitcom_assemble_forces,
- METH_VARARGS,
- pyCitcom_assemble_forces__doc__},
-
- {pyCitcom_assemble_forces_pseudo_surf__name__,
- pyCitcom_assemble_forces_pseudo_surf,
- METH_VARARGS,
- pyCitcom_assemble_forces_pseudo_surf__doc__},
-
- {pyCitcom_construct_stiffness_B_matrix__name__,
- pyCitcom_construct_stiffness_B_matrix,
- METH_VARARGS,
- pyCitcom_construct_stiffness_B_matrix__doc__},
-
- {pyCitcom_general_stokes_solver__name__,
- pyCitcom_general_stokes_solver,
- METH_VARARGS,
- pyCitcom_general_stokes_solver__doc__},
-
- {pyCitcom_general_stokes_solver_setup__name__,
- pyCitcom_general_stokes_solver_setup,
- METH_VARARGS,
- pyCitcom_general_stokes_solver_setup__doc__},
-
- {pyCitcom_get_system_viscosity__name__,
- pyCitcom_get_system_viscosity,
- METH_VARARGS,
- pyCitcom_get_system_viscosity__doc__},
-
- {pyCitcom_set_cg_defaults__name__,
- pyCitcom_set_cg_defaults,
- METH_VARARGS,
- pyCitcom_set_cg_defaults__doc__},
-
- {pyCitcom_set_mg_defaults__name__,
- pyCitcom_set_mg_defaults,
- METH_VARARGS,
- pyCitcom_set_mg_defaults__doc__},
-
- {pyCitcom_set_mg_el_defaults__name__,
- pyCitcom_set_mg_el_defaults,
- METH_VARARGS,
- pyCitcom_set_mg_el_defaults__doc__},
-
- {pyCitcom_solve_constrained_flow_iterative__name__,
- pyCitcom_solve_constrained_flow_iterative,
- METH_VARARGS,
- pyCitcom_solve_constrained_flow_iterative__doc__},
-
- {pyCitcom_solve_constrained_flow_iterative_pseudo_surf__name__,
- pyCitcom_solve_constrained_flow_iterative_pseudo_surf,
- METH_VARARGS,
- pyCitcom_solve_constrained_flow_iterative_pseudo_surf__doc__},
-
- /* Sentinel */
- {0, 0, 0, 0}
-};
-
-/* $Id$ */
-
-/* End of file */
Copied: mc/3D/CitcomS/branches/cxx/module/bindings.cc (from rev 14029, mc/3D/CitcomS/trunk/module/bindings.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/module/bindings.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/module/bindings.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,381 @@
+/*
+//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+//
+//<LicenseText>
+//
+// CitcomS.py by Eh Tan, Eun-seo Choi, and Pururav Thoutireddy.
+// Copyright (C) 2002-2005, California Institute of Technology.
+//
+// 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+//
+//</LicenseText>
+//
+//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+*/
+
+#include <Python.h>
+
+#include "bindings.h"
+
+#include "advdiffu.h"
+#include "initial_conditions.h"
+#include "mesher.h"
+#include "misc.h"
+#include "outputs.h"
+#include "setProperties.h"
+#include "stokes_solver.h"
+
+
+/* the method table */
+
+struct PyMethodDef pyCitcom_methods[] = {
+
+ /* dummy entry for testing */
+ {pyCitcom_copyright__name__,
+ pyCitcom_copyright,
+ METH_VARARGS,
+ pyCitcom_copyright__doc__},
+
+
+ /*////////////////////////////////////////////////////////////////////////
+ // This section is for testing or temporatory implementation
+ ////////////////////////////////////////////////////////////////////////*/
+
+ {pyCitcom_return1_test__name__,
+ pyCitcom_return1_test,
+ METH_VARARGS,
+ pyCitcom_return1_test__doc__},
+
+ {pyCitcom_CPU_time__name__,
+ pyCitcom_CPU_time,
+ METH_VARARGS,
+ pyCitcom_CPU_time__doc__},
+
+ {pyCitcom_read_instructions__name__,
+ pyCitcom_read_instructions,
+ METH_VARARGS,
+ pyCitcom_read_instructions__doc__},
+
+
+ /*////////////////////////////////////////////////////////////////////////
+ // This section is for finished implementation
+ ////////////////////////////////////////////////////////////////////////*/
+
+ /* from misc.h */
+
+ {pyCitcom_citcom_init__name__,
+ pyCitcom_citcom_init,
+ METH_VARARGS,
+ pyCitcom_citcom_init__doc__},
+
+ {pyCitcom_full_solver_init__name__,
+ pyCitcom_full_solver_init,
+ METH_VARARGS,
+ pyCitcom_full_solver_init__doc__},
+
+ {pyCitcom_regional_solver_init__name__,
+ pyCitcom_regional_solver_init,
+ METH_VARARGS,
+ pyCitcom_regional_solver_init__doc__},
+
+ {pyCitcom_global_default_values__name__,
+ pyCitcom_global_default_values,
+ METH_VARARGS,
+ pyCitcom_global_default_values__doc__},
+
+ {pyCitcom_set_signal__name__,
+ pyCitcom_set_signal,
+ METH_VARARGS,
+ pyCitcom_set_signal__doc__},
+
+ {pyCitcom_check_settings_consistency__name__,
+ pyCitcom_check_settings_consistency,
+ METH_VARARGS,
+ pyCitcom_check_settings_consistency__doc__},
+
+ {pyCitcom_velocities_conform_bcs__name__,
+ pyCitcom_velocities_conform_bcs,
+ METH_VARARGS,
+ pyCitcom_velocities_conform_bcs__doc__},
+
+ {pyCitcom_BC_update_plate_temperature__name__,
+ pyCitcom_BC_update_plate_temperature,
+ METH_VARARGS,
+ pyCitcom_BC_update_plate_temperature__doc__},
+
+ {pyCitcom_BC_update_plate_velocity__name__,
+ pyCitcom_BC_update_plate_velocity,
+ METH_VARARGS,
+ pyCitcom_BC_update_plate_velocity__doc__},
+
+ {pyCitcom_Tracer_tracer_advection__name__,
+ pyCitcom_Tracer_tracer_advection,
+ METH_VARARGS,
+ pyCitcom_Tracer_tracer_advection__doc__},
+
+ {pyCitcom_Visc_update_material__name__,
+ pyCitcom_Visc_update_material,
+ METH_VARARGS,
+ pyCitcom_Visc_update_material__doc__},
+
+ {pyCitcom_return_dt__name__,
+ pyCitcom_return_dt,
+ METH_VARARGS,
+ pyCitcom_return_dt__doc__},
+
+ {pyCitcom_return_step__name__,
+ pyCitcom_return_step,
+ METH_VARARGS,
+ pyCitcom_return_step__doc__},
+
+ {pyCitcom_return_t__name__,
+ pyCitcom_return_t,
+ METH_VARARGS,
+ pyCitcom_return_t__doc__},
+
+ {pyCitcom_return_rank__name__,
+ pyCitcom_return_rank,
+ METH_VARARGS,
+ pyCitcom_return_rank__doc__},
+
+ {pyCitcom_return_pid__name__,
+ pyCitcom_return_pid,
+ METH_VARARGS,
+ pyCitcom_return_pid__doc__},
+
+ /* from advdiffu.h */
+
+ {pyCitcom_PG_timestep_init__name__,
+ pyCitcom_PG_timestep_init,
+ METH_VARARGS,
+ pyCitcom_PG_timestep_init__doc__},
+
+ {pyCitcom_PG_timestep_solve__name__,
+ pyCitcom_PG_timestep_solve,
+ METH_VARARGS,
+ pyCitcom_PG_timestep_solve__doc__},
+
+ {pyCitcom_set_convection_defaults__name__,
+ pyCitcom_set_convection_defaults,
+ METH_VARARGS,
+ pyCitcom_set_convection_defaults__doc__},
+
+ {pyCitcom_stable_timestep__name__,
+ pyCitcom_stable_timestep,
+ METH_VARARGS,
+ pyCitcom_stable_timestep__doc__},
+
+ /* from initial_conditions.h */
+
+ {pyCitcom_ic_initialize_material__name__,
+ pyCitcom_ic_initialize_material,
+ METH_VARARGS,
+ pyCitcom_ic_initialize_material__doc__},
+
+ {pyCitcom_ic_init_tracer_composition__name__,
+ pyCitcom_ic_init_tracer_composition,
+ METH_VARARGS,
+ pyCitcom_ic_init_tracer_composition__doc__},
+
+ {pyCitcom_ic_constructTemperature__name__,
+ pyCitcom_ic_constructTemperature,
+ METH_VARARGS,
+ pyCitcom_ic_constructTemperature__doc__},
+
+ {pyCitcom_ic_initPressure__name__,
+ pyCitcom_ic_initPressure,
+ METH_VARARGS,
+ pyCitcom_ic_initPressure__doc__},
+
+ {pyCitcom_ic_initVelocity__name__,
+ pyCitcom_ic_initVelocity,
+ METH_VARARGS,
+ pyCitcom_ic_initVelocity__doc__},
+
+ {pyCitcom_ic_initViscosity__name__,
+ pyCitcom_ic_initViscosity,
+ METH_VARARGS,
+ pyCitcom_ic_initViscosity__doc__},
+
+ {pyCitcom_ic_readCheckpoint__name__,
+ pyCitcom_ic_readCheckpoint,
+ METH_VARARGS,
+ pyCitcom_ic_readCheckpoint__doc__},
+
+ {pyCitcom_ic_postProcessing__name__,
+ pyCitcom_ic_postProcessing,
+ METH_VARARGS,
+ pyCitcom_ic_postProcessing__doc__},
+
+ /* from mesher.h */
+
+ {pyCitcom_full_sphere_launch__name__,
+ pyCitcom_full_sphere_launch,
+ METH_VARARGS,
+ pyCitcom_full_sphere_launch__doc__},
+
+ {pyCitcom_regional_sphere_launch__name__,
+ pyCitcom_regional_sphere_launch,
+ METH_VARARGS,
+ pyCitcom_regional_sphere_launch__doc__},
+
+ /* from outputs.h */
+
+ {pyCitcom_output__name__,
+ pyCitcom_output,
+ METH_VARARGS,
+ pyCitcom_output__doc__},
+
+ {pyCitcom_output_finalize__name__,
+ pyCitcom_output_finalize,
+ METH_VARARGS,
+ pyCitcom_output_finalize__doc__},
+
+ {pyCitcom_output_time__name__,
+ pyCitcom_output_time,
+ METH_VARARGS,
+ pyCitcom_output_time__doc__},
+
+ {pyCitcom_output_checkpoint__name__,
+ pyCitcom_output_checkpoint,
+ METH_VARARGS,
+ pyCitcom_output_checkpoint__doc__},
+
+ /* from setProperties.h */
+
+ {pyCitcom_Advection_diffusion_set_properties__name__,
+ pyCitcom_Advection_diffusion_set_properties,
+ METH_VARARGS,
+ pyCitcom_Advection_diffusion_set_properties__doc__},
+
+ {pyCitcom_BC_set_properties__name__,
+ pyCitcom_BC_set_properties,
+ METH_VARARGS,
+ pyCitcom_BC_set_properties__doc__},
+
+ {pyCitcom_Const_set_properties__name__,
+ pyCitcom_Const_set_properties,
+ METH_VARARGS,
+ pyCitcom_Const_set_properties__doc__},
+
+ {pyCitcom_IC_set_properties__name__,
+ pyCitcom_IC_set_properties,
+ METH_VARARGS,
+ pyCitcom_IC_set_properties__doc__},
+
+ {pyCitcom_Output_set_properties__name__,
+ pyCitcom_Output_set_properties,
+ METH_VARARGS,
+ pyCitcom_Output_set_properties__doc__},
+
+ {pyCitcom_Param_set_properties__name__,
+ pyCitcom_Param_set_properties,
+ METH_VARARGS,
+ pyCitcom_Param_set_properties__doc__},
+
+ {pyCitcom_Phase_set_properties__name__,
+ pyCitcom_Phase_set_properties,
+ METH_VARARGS,
+ pyCitcom_Phase_set_properties__doc__},
+
+ {pyCitcom_Solver_set_properties__name__,
+ pyCitcom_Solver_set_properties,
+ METH_VARARGS,
+ pyCitcom_Solver_set_properties__doc__},
+
+ {pyCitcom_Sphere_set_properties__name__,
+ pyCitcom_Sphere_set_properties,
+ METH_VARARGS,
+ pyCitcom_Sphere_set_properties__doc__},
+
+ {pyCitcom_Tracer_set_properties__name__,
+ pyCitcom_Tracer_set_properties,
+ METH_VARARGS,
+ pyCitcom_Tracer_set_properties__doc__},
+
+ {pyCitcom_Visc_set_properties__name__,
+ pyCitcom_Visc_set_properties,
+ METH_VARARGS,
+ pyCitcom_Visc_set_properties__doc__},
+
+ {pyCitcom_Incompressible_set_properties__name__,
+ pyCitcom_Incompressible_set_properties,
+ METH_VARARGS,
+ pyCitcom_Incompressible_set_properties__doc__},
+
+ /* from stokes_solver.h */
+
+ {pyCitcom_assemble_forces__name__,
+ pyCitcom_assemble_forces,
+ METH_VARARGS,
+ pyCitcom_assemble_forces__doc__},
+
+ {pyCitcom_assemble_forces_pseudo_surf__name__,
+ pyCitcom_assemble_forces_pseudo_surf,
+ METH_VARARGS,
+ pyCitcom_assemble_forces_pseudo_surf__doc__},
+
+ {pyCitcom_construct_stiffness_B_matrix__name__,
+ pyCitcom_construct_stiffness_B_matrix,
+ METH_VARARGS,
+ pyCitcom_construct_stiffness_B_matrix__doc__},
+
+ {pyCitcom_general_stokes_solver__name__,
+ pyCitcom_general_stokes_solver,
+ METH_VARARGS,
+ pyCitcom_general_stokes_solver__doc__},
+
+ {pyCitcom_general_stokes_solver_setup__name__,
+ pyCitcom_general_stokes_solver_setup,
+ METH_VARARGS,
+ pyCitcom_general_stokes_solver_setup__doc__},
+
+ {pyCitcom_get_system_viscosity__name__,
+ pyCitcom_get_system_viscosity,
+ METH_VARARGS,
+ pyCitcom_get_system_viscosity__doc__},
+
+ {pyCitcom_set_cg_defaults__name__,
+ pyCitcom_set_cg_defaults,
+ METH_VARARGS,
+ pyCitcom_set_cg_defaults__doc__},
+
+ {pyCitcom_set_mg_defaults__name__,
+ pyCitcom_set_mg_defaults,
+ METH_VARARGS,
+ pyCitcom_set_mg_defaults__doc__},
+
+ {pyCitcom_set_mg_el_defaults__name__,
+ pyCitcom_set_mg_el_defaults,
+ METH_VARARGS,
+ pyCitcom_set_mg_el_defaults__doc__},
+
+ {pyCitcom_solve_constrained_flow_iterative__name__,
+ pyCitcom_solve_constrained_flow_iterative,
+ METH_VARARGS,
+ pyCitcom_solve_constrained_flow_iterative__doc__},
+
+ {pyCitcom_solve_constrained_flow_iterative_pseudo_surf__name__,
+ pyCitcom_solve_constrained_flow_iterative_pseudo_surf,
+ METH_VARARGS,
+ pyCitcom_solve_constrained_flow_iterative_pseudo_surf__doc__},
+
+ /* Sentinel */
+ {0, 0, 0, 0}
+};
+
+/* $Id$ */
+
+/* End of file */
Deleted: mc/3D/CitcomS/branches/cxx/module/exceptions.c
===================================================================
--- mc/3D/CitcomS/trunk/module/exceptions.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/module/exceptions.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,34 +0,0 @@
-/*
-//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-//
-//<LicenseText>
-//
-// CitcomS.py by Eh Tan, Eun-seo Choi, and Pururav Thoutireddy.
-// Copyright (C) 2002-2005, California Institute of Technology.
-//
-// 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-//
-//</LicenseText>
-//
-//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-*/
-
-#include <Python.h>
-
-PyObject *pyCitcom_runtimeError = 0;
-
-/* $Id$ */
-
-/* End of file */
Copied: mc/3D/CitcomS/branches/cxx/module/exceptions.cc (from rev 14029, mc/3D/CitcomS/trunk/module/exceptions.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/module/exceptions.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/module/exceptions.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,34 @@
+/*
+//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+//
+//<LicenseText>
+//
+// CitcomS.py by Eh Tan, Eun-seo Choi, and Pururav Thoutireddy.
+// Copyright (C) 2002-2005, California Institute of Technology.
+//
+// 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+//
+//</LicenseText>
+//
+//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+*/
+
+#include <Python.h>
+
+PyObject *pyCitcom_runtimeError = 0;
+
+/* $Id$ */
+
+/* End of file */
Deleted: mc/3D/CitcomS/branches/cxx/module/initial_conditions.c
===================================================================
--- mc/3D/CitcomS/trunk/module/initial_conditions.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/module/initial_conditions.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,223 +0,0 @@
-/*
-//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-//
-//<LicenseText>
-//
-// CitcomS.py by Eh Tan, Eun-seo Choi, and Pururav Thoutireddy.
-// Copyright (C) 2002-2005, California Institute of Technology.
-//
-// 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-//
-//</LicenseText>
-//
-//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-*/
-
-#include <Python.h>
-#include "exceptions.h"
-#include "initial_conditions.h"
-
-#include "global_defs.h"
-
-
-void initialize_material(struct All_variables*);
-void initialize_tracers(struct All_variables*);
-void init_composition(struct All_variables*);
-void initial_pressure(struct All_variables*);
-void initial_velocity(struct All_variables*);
-void initial_viscosity(struct All_variables*);
-void parallel_process_termination();
-void post_processing(struct All_variables*);
-void report(struct All_variables*, char* str);
-void read_checkpoint(struct All_variables*);
-
-char pyCitcom_ic_initialize_material__doc__[] = "";
-char pyCitcom_ic_initialize_material__name__[] = "initialize_material";
-
-PyObject * pyCitcom_ic_initialize_material(PyObject *self, PyObject *args)
-{
- PyObject *obj;
- struct All_variables* E;
-
- if (!PyArg_ParseTuple(args, "O:initialize_material", &obj))
- return NULL;
-
- E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
-
- initialize_material(E);
-
- Py_INCREF(Py_None);
- return Py_None;
-}
-
-
-
-char pyCitcom_ic_init_tracer_composition__doc__[] = "";
-char pyCitcom_ic_init_tracer_composition__name__[] = "init_tracer_composition";
-
-PyObject * pyCitcom_ic_init_tracer_composition(PyObject *self, PyObject *args)
-{
- PyObject *obj;
- struct All_variables* E;
-
- if (!PyArg_ParseTuple(args, "O:init_tracer_composition", &obj))
- return NULL;
-
- E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
-
- if (E->control.tracer==1) {
- initialize_tracers(E);
-
- if (E->composition.on)
- init_composition(E);
- }
-
- Py_INCREF(Py_None);
- return Py_None;
-}
-
-
-
-char pyCitcom_ic_constructTemperature__doc__[] = "";
-char pyCitcom_ic_constructTemperature__name__[] = "constructTemperature";
-
-PyObject * pyCitcom_ic_constructTemperature(PyObject *self, PyObject *args)
-{
- PyObject *obj;
- struct All_variables* E;
-
- if (!PyArg_ParseTuple(args, "O:constructTemperature", &obj))
- return NULL;
-
- E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
-
- (E->problem_initial_fields)(E);
-
- Py_INCREF(Py_None);
- return Py_None;
-}
-
-
-
-char pyCitcom_ic_initPressure__doc__[] = "";
-char pyCitcom_ic_initPressure__name__[] = "initPressure";
-
-PyObject * pyCitcom_ic_initPressure(PyObject *self, PyObject *args)
-{
- PyObject *obj;
- struct All_variables* E;
-
- if (!PyArg_ParseTuple(args, "O:initPressure", &obj))
- return NULL;
-
- E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
-
- report(E,"Initialize pressure field");
- initial_pressure(E);
-
- Py_INCREF(Py_None);
- return Py_None;
-}
-
-
-
-char pyCitcom_ic_initVelocity__doc__[] = "";
-char pyCitcom_ic_initVelocity__name__[] = "initVelocity";
-
-PyObject * pyCitcom_ic_initVelocity(PyObject *self, PyObject *args)
-{
- PyObject *obj;
- struct All_variables* E;
-
- if (!PyArg_ParseTuple(args, "O:initVelocity", &obj))
- return NULL;
-
- E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
-
- report(E,"Initialize velocity field");
- initial_velocity(E);
-
- Py_INCREF(Py_None);
- return Py_None;
-}
-
-
-
-char pyCitcom_ic_initViscosity__doc__[] = "";
-char pyCitcom_ic_initViscosity__name__[] = "initViscosity";
-
-PyObject * pyCitcom_ic_initViscosity(PyObject *self, PyObject *args)
-{
- PyObject *obj;
- struct All_variables* E;
-
- if (!PyArg_ParseTuple(args, "O:initViscosity", &obj))
- return NULL;
-
- E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
-
- report(E,"Initialize viscosity field");
- initial_viscosity(E);
-
- Py_INCREF(Py_None);
- return Py_None;
-}
-
-
-
-char pyCitcom_ic_readCheckpoint__doc__[] = "";
-char pyCitcom_ic_readCheckpoint__name__[] = "readCheckpoint";
-
-PyObject * pyCitcom_ic_readCheckpoint(PyObject *self, PyObject *args)
-{
- PyObject *obj;
- struct All_variables* E;
-
- if (!PyArg_ParseTuple(args, "O:readCheckpoint", &obj))
- return NULL;
-
- E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
-
- read_checkpoint(E);
-
- Py_INCREF(Py_None);
- return Py_None;
-}
-
-
-char pyCitcom_ic_postProcessing__doc__[] = "";
-char pyCitcom_ic_postProcessing__name__[] = "postProcessing";
-
-PyObject * pyCitcom_ic_postProcessing(PyObject *self, PyObject *args)
-{
- PyObject *obj;
- struct All_variables* E;
-
- if (!PyArg_ParseTuple(args, "O:postProcessing", &obj))
- return NULL;
-
- E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
-
- post_processing(E);
-
- Py_INCREF(Py_None);
- return Py_None;
-}
-
-
-
-/* $Id$ */
-
-/* End of file */
Copied: mc/3D/CitcomS/branches/cxx/module/initial_conditions.cc (from rev 14029, mc/3D/CitcomS/trunk/module/initial_conditions.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/module/initial_conditions.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/module/initial_conditions.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,223 @@
+/*
+//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+//
+//<LicenseText>
+//
+// CitcomS.py by Eh Tan, Eun-seo Choi, and Pururav Thoutireddy.
+// Copyright (C) 2002-2005, California Institute of Technology.
+//
+// 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+//
+//</LicenseText>
+//
+//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+*/
+
+#include <Python.h>
+#include "exceptions.h"
+#include "initial_conditions.h"
+
+#include "global_defs.h"
+
+
+void initialize_material(struct All_variables*);
+void initialize_tracers(struct All_variables*);
+void init_composition(struct All_variables*);
+void initial_pressure(struct All_variables*);
+void initial_velocity(struct All_variables*);
+void initial_viscosity(struct All_variables*);
+void parallel_process_termination();
+void post_processing(struct All_variables*);
+void report(struct All_variables*, char* str);
+void read_checkpoint(struct All_variables*);
+
+char pyCitcom_ic_initialize_material__doc__[] = "";
+char pyCitcom_ic_initialize_material__name__[] = "initialize_material";
+
+PyObject * pyCitcom_ic_initialize_material(PyObject *self, PyObject *args)
+{
+ PyObject *obj;
+ struct All_variables* E;
+
+ if (!PyArg_ParseTuple(args, "O:initialize_material", &obj))
+ return NULL;
+
+ E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
+
+ initialize_material(E);
+
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+
+
+char pyCitcom_ic_init_tracer_composition__doc__[] = "";
+char pyCitcom_ic_init_tracer_composition__name__[] = "init_tracer_composition";
+
+PyObject * pyCitcom_ic_init_tracer_composition(PyObject *self, PyObject *args)
+{
+ PyObject *obj;
+ struct All_variables* E;
+
+ if (!PyArg_ParseTuple(args, "O:init_tracer_composition", &obj))
+ return NULL;
+
+ E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
+
+ if (E->control.tracer==1) {
+ initialize_tracers(E);
+
+ if (E->composition.on)
+ init_composition(E);
+ }
+
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+
+
+char pyCitcom_ic_constructTemperature__doc__[] = "";
+char pyCitcom_ic_constructTemperature__name__[] = "constructTemperature";
+
+PyObject * pyCitcom_ic_constructTemperature(PyObject *self, PyObject *args)
+{
+ PyObject *obj;
+ struct All_variables* E;
+
+ if (!PyArg_ParseTuple(args, "O:constructTemperature", &obj))
+ return NULL;
+
+ E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
+
+ (E->problem_initial_fields)(E);
+
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+
+
+char pyCitcom_ic_initPressure__doc__[] = "";
+char pyCitcom_ic_initPressure__name__[] = "initPressure";
+
+PyObject * pyCitcom_ic_initPressure(PyObject *self, PyObject *args)
+{
+ PyObject *obj;
+ struct All_variables* E;
+
+ if (!PyArg_ParseTuple(args, "O:initPressure", &obj))
+ return NULL;
+
+ E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
+
+ report(E,"Initialize pressure field");
+ initial_pressure(E);
+
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+
+
+char pyCitcom_ic_initVelocity__doc__[] = "";
+char pyCitcom_ic_initVelocity__name__[] = "initVelocity";
+
+PyObject * pyCitcom_ic_initVelocity(PyObject *self, PyObject *args)
+{
+ PyObject *obj;
+ struct All_variables* E;
+
+ if (!PyArg_ParseTuple(args, "O:initVelocity", &obj))
+ return NULL;
+
+ E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
+
+ report(E,"Initialize velocity field");
+ initial_velocity(E);
+
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+
+
+char pyCitcom_ic_initViscosity__doc__[] = "";
+char pyCitcom_ic_initViscosity__name__[] = "initViscosity";
+
+PyObject * pyCitcom_ic_initViscosity(PyObject *self, PyObject *args)
+{
+ PyObject *obj;
+ struct All_variables* E;
+
+ if (!PyArg_ParseTuple(args, "O:initViscosity", &obj))
+ return NULL;
+
+ E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
+
+ report(E,"Initialize viscosity field");
+ initial_viscosity(E);
+
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+
+
+char pyCitcom_ic_readCheckpoint__doc__[] = "";
+char pyCitcom_ic_readCheckpoint__name__[] = "readCheckpoint";
+
+PyObject * pyCitcom_ic_readCheckpoint(PyObject *self, PyObject *args)
+{
+ PyObject *obj;
+ struct All_variables* E;
+
+ if (!PyArg_ParseTuple(args, "O:readCheckpoint", &obj))
+ return NULL;
+
+ E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
+
+ read_checkpoint(E);
+
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+
+char pyCitcom_ic_postProcessing__doc__[] = "";
+char pyCitcom_ic_postProcessing__name__[] = "postProcessing";
+
+PyObject * pyCitcom_ic_postProcessing(PyObject *self, PyObject *args)
+{
+ PyObject *obj;
+ struct All_variables* E;
+
+ if (!PyArg_ParseTuple(args, "O:postProcessing", &obj))
+ return NULL;
+
+ E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
+
+ post_processing(E);
+
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+
+
+/* $Id$ */
+
+/* End of file */
Deleted: mc/3D/CitcomS/branches/cxx/module/mesher.c
===================================================================
--- mc/3D/CitcomS/trunk/module/mesher.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/module/mesher.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,85 +0,0 @@
-/*
-//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-//
-//<LicenseText>
-//
-// CitcomS.py by Eh Tan, Eun-seo Choi, and Pururav Thoutireddy.
-// Copyright (C) 2002-2005, California Institute of Technology.
-//
-// 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-//
-//</LicenseText>
-//
-//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-*/
-
-#include <Python.h>
-
-#include "exceptions.h"
-#include "mesher.h"
-
-#include "global_defs.h"
-#include "parallel_related.h"
-
-
-extern void initial_mesh_solver_setup(struct All_variables *);
-
-
-
-char pyCitcom_full_sphere_launch__doc__[] = "";
-char pyCitcom_full_sphere_launch__name__[] = "full_sphere_launch";
-
-PyObject * pyCitcom_full_sphere_launch(PyObject *self, PyObject *args)
-{
- PyObject *obj;
- struct All_variables* E;
-
- if (!PyArg_ParseTuple(args, "O:full_sphere_launch", &obj))
- return NULL;
-
- E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
-
- initial_mesh_solver_setup(E);
-
- Py_INCREF(Py_None);
- return Py_None;
-}
-
-
-
-char pyCitcom_regional_sphere_launch__doc__[] = "";
-char pyCitcom_regional_sphere_launch__name__[] = "regional_sphere_launch";
-
-PyObject * pyCitcom_regional_sphere_launch(PyObject *self, PyObject *args)
-{
- PyObject *obj;
- struct All_variables* E;
-
- if (!PyArg_ParseTuple(args, "O:regional_sphere_launch", &obj))
- return NULL;
-
- E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
-
- initial_mesh_solver_setup(E);
-
- Py_INCREF(Py_None);
- return Py_None;
-}
-
-
-
-/* $Id$ */
-
-/* End of file */
Copied: mc/3D/CitcomS/branches/cxx/module/mesher.cc (from rev 14029, mc/3D/CitcomS/trunk/module/mesher.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/module/mesher.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/module/mesher.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,85 @@
+/*
+//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+//
+//<LicenseText>
+//
+// CitcomS.py by Eh Tan, Eun-seo Choi, and Pururav Thoutireddy.
+// Copyright (C) 2002-2005, California Institute of Technology.
+//
+// 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+//
+//</LicenseText>
+//
+//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+*/
+
+#include <Python.h>
+
+#include "exceptions.h"
+#include "mesher.h"
+
+#include "global_defs.h"
+#include "parallel_related.h"
+
+
+extern void initial_mesh_solver_setup(struct All_variables *);
+
+
+
+char pyCitcom_full_sphere_launch__doc__[] = "";
+char pyCitcom_full_sphere_launch__name__[] = "full_sphere_launch";
+
+PyObject * pyCitcom_full_sphere_launch(PyObject *self, PyObject *args)
+{
+ PyObject *obj;
+ struct All_variables* E;
+
+ if (!PyArg_ParseTuple(args, "O:full_sphere_launch", &obj))
+ return NULL;
+
+ E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
+
+ initial_mesh_solver_setup(E);
+
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+
+
+char pyCitcom_regional_sphere_launch__doc__[] = "";
+char pyCitcom_regional_sphere_launch__name__[] = "regional_sphere_launch";
+
+PyObject * pyCitcom_regional_sphere_launch(PyObject *self, PyObject *args)
+{
+ PyObject *obj;
+ struct All_variables* E;
+
+ if (!PyArg_ParseTuple(args, "O:regional_sphere_launch", &obj))
+ return NULL;
+
+ E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
+
+ initial_mesh_solver_setup(E);
+
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+
+
+/* $Id$ */
+
+/* End of file */
Deleted: mc/3D/CitcomS/branches/cxx/module/misc.c
===================================================================
--- mc/3D/CitcomS/trunk/module/misc.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/module/misc.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,454 +0,0 @@
-/*
-//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-//
-//<LicenseText>
-//
-// CitcomS.py by Eh Tan, Eun-seo Choi, and Pururav Thoutireddy.
-// Copyright (C) 2002-2005, California Institute of Technology.
-//
-// 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-//
-//</LicenseText>
-//
-//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-*/
-
-#include <Python.h>
-
-
-#include "exceptions.h"
-#include "misc.h"
-
-#include "mpi.h"
-#include "global_defs.h"
-#include "citcom_init.h"
-#include "advection_diffusion.h"
-
-
-void full_solver_init(struct All_variables*);
-void regional_solver_init(struct All_variables*);
-
-double return1_test();
-void read_instructions(struct All_variables*, char*);
-double CPU_time0();
-
-void global_default_values(struct All_variables*);
-void parallel_process_termination();
-void read_mat_from_file(struct All_variables*);
-void read_temperature_boundary_from_file(struct All_variables*);
-void read_velocity_boundary_from_file(struct All_variables*);
-void set_signal();
-void check_settings_consistency(struct All_variables *);
-void tracer_advection(struct All_variables*);
-void velocities_conform_bcs(struct All_variables*, double **);
-
-
-#include "mpi/pympi.h"
-
-/* copyright */
-
-char pyCitcom_copyright__doc__[] = "";
-char pyCitcom_copyright__name__[] = "copyright";
-
-static char pyCitcom_copyright_note[] =
-"CitcomS python module: Copyright (c) 1998-2003 California Institute of Technology";
-
-
-PyObject * pyCitcom_copyright(PyObject *self, PyObject *args)
-{
- return Py_BuildValue("s", pyCitcom_copyright_note);
-}
-
-/*////////////////////////////////////////////////////////////////////////
-// This section is for testing or temporatory implementation
-////////////////////////////////////////////////////////////////////////*/
-
-
-
-char pyCitcom_return1_test__doc__[] = "";
-char pyCitcom_return1_test__name__[] = "return1_test";
-
-PyObject * pyCitcom_return1_test(PyObject *self, PyObject *args)
-{
- double a;
- a = return1_test();
- return Py_BuildValue("d", a);
-}
-
-
-char pyCitcom_read_instructions__doc__[] = "";
-char pyCitcom_read_instructions__name__[] = "read_instructions";
-
-PyObject * pyCitcom_read_instructions(PyObject *self, PyObject *args)
-{
- PyObject *obj;
- struct All_variables* E;
- char *filename;
-
- if (!PyArg_ParseTuple(args, "Os:read_instructions", &obj, &filename))
- return NULL;
-
- E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
-
- read_instructions(E, filename);
-
- /* test */
- fprintf(stderr,"output file prefix: %s\n", E->control.data_file);
-
- Py_INCREF(Py_None);
- return Py_None;
-}
-
-
-char pyCitcom_CPU_time__doc__[] = "";
-char pyCitcom_CPU_time__name__[] = "CPU_time";
-
-PyObject * pyCitcom_CPU_time(PyObject *self, PyObject *args)
-{
- return Py_BuildValue("d", CPU_time0());
-}
-
-
-/*////////////////////////////////////////////////////////////////////////
-// This section is for finished implementation
-////////////////////////////////////////////////////////////////////////*/
-
-
-void deleteE(struct All_variables *E)
-{
- free(E);
-}
-
-
-char pyCitcom_citcom_init__doc__[] = "";
-char pyCitcom_citcom_init__name__[] = "citcom_init";
-
-PyObject * pyCitcom_citcom_init(PyObject *self, PyObject *args)
-{
- PyObject *obj, *cobj;
- struct All_variables* E;
- PyMPICommObject *pycomm;
- MPI_Comm world;
-
- if (!PyArg_ParseTuple(args, "O:citcom_init", &obj))
- return NULL;
-
- pycomm = (PyMPICommObject *)obj;
- world = pycomm->comm;
-
- /* Allocate global pointer E */
- E = citcom_init(&world);
-
- /* if E is NULL, raise an exception here. */
- if (E == NULL)
- return PyErr_Format(pyCitcom_runtimeError,
- "%s: 'libCitcomSCommon.citcom_init' failed",
- pyCitcom_citcom_init__name__);
-
- cobj = PyCObject_FromVoidPtr(E, deleteE);
-
- return Py_BuildValue("N", cobj);
-}
-
-
-char pyCitcom_full_solver_init__doc__[] = "";
-char pyCitcom_full_solver_init__name__[] = "full_solver_init";
-
-PyObject * pyCitcom_full_solver_init(PyObject *self, PyObject *args)
-{
- PyObject *obj;
- struct All_variables* E;
-
- if (!PyArg_ParseTuple(args, "O:full_solver_init", &obj))
- return NULL;
-
- E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
-
- full_solver_init(E);
-
- Py_INCREF(Py_None);
- return Py_None;
-}
-
-
-char pyCitcom_regional_solver_init__doc__[] = "";
-char pyCitcom_regional_solver_init__name__[] = "regional_solver_init";
-
-PyObject * pyCitcom_regional_solver_init(PyObject *self, PyObject *args)
-{
- PyObject *obj;
- struct All_variables* E;
-
- if (!PyArg_ParseTuple(args, "O:regional_solver_init", &obj))
- return NULL;
-
- E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
-
- regional_solver_init(E);
-
- Py_INCREF(Py_None);
- return Py_None;
-}
-
-
-char pyCitcom_global_default_values__doc__[] = "";
-char pyCitcom_global_default_values__name__[] = "global_default_values";
-
-PyObject * pyCitcom_global_default_values(PyObject *self, PyObject *args)
-{
- PyObject *obj;
- struct All_variables* E;
-
- if (!PyArg_ParseTuple(args, "O:global_default_values", &obj))
- return NULL;
-
- E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
-
- global_default_values(E);
-
- Py_INCREF(Py_None);
- return Py_None;
-}
-
-
-char pyCitcom_set_signal__doc__[] = "";
-char pyCitcom_set_signal__name__[] = "set_signal";
-
-PyObject * pyCitcom_set_signal(PyObject *self, PyObject *args)
-{
- set_signal();
-
- Py_INCREF(Py_None);
- return Py_None;
-}
-
-
-char pyCitcom_check_settings_consistency__doc__[] = "";
-char pyCitcom_check_settings_consistency__name__[] = "check_settings_consistency";
-
-PyObject * pyCitcom_check_settings_consistency(PyObject *self, PyObject *args)
-{
- PyObject *obj;
- struct All_variables* E;
-
- if (!PyArg_ParseTuple(args, "O:check_settings_consistency", &obj))
- return NULL;
-
- E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
-
- check_settings_consistency(E);
-
- Py_INCREF(Py_None);
- return Py_None;
-}
-
-
-char pyCitcom_velocities_conform_bcs__doc__[] = "";
-char pyCitcom_velocities_conform_bcs__name__[] = "velocities_conform_bcs";
-
-PyObject * pyCitcom_velocities_conform_bcs(PyObject *self, PyObject *args)
-{
- PyObject *obj;
- struct All_variables* E;
-
- if (!PyArg_ParseTuple(args, "O:velocities_conform_bcs", &obj))
- return NULL;
-
- E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
-
- velocities_conform_bcs(E, E->U);
-
- Py_INCREF(Py_None);
- return Py_None;
-}
-
-
-char pyCitcom_BC_update_plate_temperature__doc__[] = "";
-char pyCitcom_BC_update_plate_temperature__name__[] = "BC_update_plate_temperature";
-
-PyObject * pyCitcom_BC_update_plate_temperature(PyObject *self, PyObject *args)
-{
- PyObject *obj;
- struct All_variables* E;
-
- if (!PyArg_ParseTuple(args, "O:BC_update_plate_temperature", &obj))
- return NULL;
-
- E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
-
- if(E->control.tbcs_file==1)
- read_temperature_boundary_from_file(E);
-
- Py_INCREF(Py_None);
- return Py_None;
-}
-
-
-char pyCitcom_BC_update_plate_velocity__doc__[] = "";
-char pyCitcom_BC_update_plate_velocity__name__[] = "BC_update_plate_velocity";
-
-PyObject * pyCitcom_BC_update_plate_velocity(PyObject *self, PyObject *args)
-{
- PyObject *obj;
- struct All_variables* E;
-
- if (!PyArg_ParseTuple(args, "O:BC_update_plate_velocity", &obj))
- return NULL;
-
- E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
-
- if(E->control.vbcs_file==1)
- read_velocity_boundary_from_file(E);
-
- Py_INCREF(Py_None);
- return Py_None;
-}
-
-
-char pyCitcom_Tracer_tracer_advection__doc__[] = "";
-char pyCitcom_Tracer_tracer_advection__name__[] = "Tracer_tracer_advection";
-
-PyObject * pyCitcom_Tracer_tracer_advection(PyObject *self, PyObject *args)
-{
- PyObject *obj;
- struct All_variables* E;
-
- if (!PyArg_ParseTuple(args, "O:Tracer_tracer_advection", &obj))
- return NULL;
-
- E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
-
- if(E->control.tracer==1)
- tracer_advection(E);
-
- Py_INCREF(Py_None);
- return Py_None;
-}
-
-
-char pyCitcom_Visc_update_material__doc__[] = "";
-char pyCitcom_Visc_update_material__name__[] = "Visc_update_material";
-
-PyObject * pyCitcom_Visc_update_material(PyObject *self, PyObject *args)
-{
- PyObject *obj;
- struct All_variables* E;
-
- if (!PyArg_ParseTuple(args, "O:Visc_update_material", &obj))
- return NULL;
-
- E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
-
- if(E->control.mat_control==1)
- read_mat_from_file(E);
-
- Py_INCREF(Py_None);
- return Py_None;
-}
-
-
-char pyCitcom_return_dt__doc__[] = "";
-char pyCitcom_return_dt__name__[] = "return_dt";
-
-PyObject * pyCitcom_return_dt(PyObject *self, PyObject *args)
-{
- PyObject *obj;
- struct All_variables* E;
-
- if (!PyArg_ParseTuple(args, "O:return_dt", &obj))
- return NULL;
-
- E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
-
- return Py_BuildValue("f", E->advection.timestep);
-}
-
-
-char pyCitcom_return_step__doc__[] = "";
-char pyCitcom_return_step__name__[] = "return_step";
-
-PyObject * pyCitcom_return_step(PyObject *self, PyObject *args)
-{
- PyObject *obj;
- struct All_variables* E;
-
- if (!PyArg_ParseTuple(args, "O:return_step", &obj))
- return NULL;
-
- E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
-
- return Py_BuildValue("i", E->advection.timesteps);
-}
-
-
-char pyCitcom_return_t__doc__[] = "";
-char pyCitcom_return_t__name__[] = "return_t";
-
-PyObject * pyCitcom_return_t(PyObject *self, PyObject *args)
-{
- PyObject *obj;
- struct All_variables* E;
-
- if (!PyArg_ParseTuple(args, "O:return_t", &obj))
- return NULL;
-
- E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
-
- return Py_BuildValue("f", E->monitor.elapsed_time);
-}
-
-
-char pyCitcom_return_rank__doc__[] = "";
-char pyCitcom_return_rank__name__[] = "return_rank";
-
-PyObject * pyCitcom_return_rank(PyObject *self, PyObject *args)
-{
- PyObject *obj;
- struct All_variables* E;
-
- if (!PyArg_ParseTuple(args, "O:return_rank", &obj))
- return NULL;
-
- E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
-
- return Py_BuildValue("i", E->parallel.me);
-}
-
-
-char pyCitcom_return_pid__doc__[] = "";
-char pyCitcom_return_pid__name__[] = "return_pid";
-
-PyObject * pyCitcom_return_pid(PyObject *self, PyObject *args)
-{
- PyObject *obj;
- struct All_variables* E;
-
- if (!PyArg_ParseTuple(args, "O:return_pid", &obj))
- return NULL;
-
- E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
-
- return Py_BuildValue("i", E->control.PID);
-}
-
-
-/*////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////*/
-
-
-
-/* $Id$ */
-
-/* End of file */
Copied: mc/3D/CitcomS/branches/cxx/module/misc.cc (from rev 14029, mc/3D/CitcomS/trunk/module/misc.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/module/misc.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/module/misc.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,454 @@
+/*
+//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+//
+//<LicenseText>
+//
+// CitcomS.py by Eh Tan, Eun-seo Choi, and Pururav Thoutireddy.
+// Copyright (C) 2002-2005, California Institute of Technology.
+//
+// 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+//
+//</LicenseText>
+//
+//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+*/
+
+#include <Python.h>
+
+
+#include "exceptions.h"
+#include "misc.h"
+
+#include "mpi.h"
+#include "global_defs.h"
+#include "citcom_init.h"
+#include "advection_diffusion.h"
+
+
+void full_solver_init(struct All_variables*);
+void regional_solver_init(struct All_variables*);
+
+double return1_test();
+void read_instructions(struct All_variables*, char*);
+double CPU_time0();
+
+void global_default_values(struct All_variables*);
+void parallel_process_termination();
+void read_mat_from_file(struct All_variables*);
+void read_temperature_boundary_from_file(struct All_variables*);
+void read_velocity_boundary_from_file(struct All_variables*);
+void set_signal();
+void check_settings_consistency(struct All_variables *);
+void tracer_advection(struct All_variables*);
+void velocities_conform_bcs(struct All_variables*, double **);
+
+
+#include "mpi/pympi.h"
+
+/* copyright */
+
+char pyCitcom_copyright__doc__[] = "";
+char pyCitcom_copyright__name__[] = "copyright";
+
+static char pyCitcom_copyright_note[] =
+"CitcomS python module: Copyright (c) 1998-2003 California Institute of Technology";
+
+
+PyObject * pyCitcom_copyright(PyObject *self, PyObject *args)
+{
+ return Py_BuildValue("s", pyCitcom_copyright_note);
+}
+
+/*////////////////////////////////////////////////////////////////////////
+// This section is for testing or temporatory implementation
+////////////////////////////////////////////////////////////////////////*/
+
+
+
+char pyCitcom_return1_test__doc__[] = "";
+char pyCitcom_return1_test__name__[] = "return1_test";
+
+PyObject * pyCitcom_return1_test(PyObject *self, PyObject *args)
+{
+ double a;
+ a = return1_test();
+ return Py_BuildValue("d", a);
+}
+
+
+char pyCitcom_read_instructions__doc__[] = "";
+char pyCitcom_read_instructions__name__[] = "read_instructions";
+
+PyObject * pyCitcom_read_instructions(PyObject *self, PyObject *args)
+{
+ PyObject *obj;
+ struct All_variables* E;
+ char *filename;
+
+ if (!PyArg_ParseTuple(args, "Os:read_instructions", &obj, &filename))
+ return NULL;
+
+ E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
+
+ read_instructions(E, filename);
+
+ /* test */
+ fprintf(stderr,"output file prefix: %s\n", E->control.data_file);
+
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+
+char pyCitcom_CPU_time__doc__[] = "";
+char pyCitcom_CPU_time__name__[] = "CPU_time";
+
+PyObject * pyCitcom_CPU_time(PyObject *self, PyObject *args)
+{
+ return Py_BuildValue("d", CPU_time0());
+}
+
+
+/*////////////////////////////////////////////////////////////////////////
+// This section is for finished implementation
+////////////////////////////////////////////////////////////////////////*/
+
+
+void deleteE(struct All_variables *E)
+{
+ free(E);
+}
+
+
+char pyCitcom_citcom_init__doc__[] = "";
+char pyCitcom_citcom_init__name__[] = "citcom_init";
+
+PyObject * pyCitcom_citcom_init(PyObject *self, PyObject *args)
+{
+ PyObject *obj, *cobj;
+ struct All_variables* E;
+ PyMPICommObject *pycomm;
+ MPI_Comm world;
+
+ if (!PyArg_ParseTuple(args, "O:citcom_init", &obj))
+ return NULL;
+
+ pycomm = (PyMPICommObject *)obj;
+ world = pycomm->comm;
+
+ /* Allocate global pointer E */
+ E = citcom_init(&world);
+
+ /* if E is NULL, raise an exception here. */
+ if (E == NULL)
+ return PyErr_Format(pyCitcom_runtimeError,
+ "%s: 'libCitcomSCommon.citcom_init' failed",
+ pyCitcom_citcom_init__name__);
+
+ cobj = PyCObject_FromVoidPtr((void *)E, (void (*)(void*))deleteE);
+
+ return Py_BuildValue("N", cobj);
+}
+
+
+char pyCitcom_full_solver_init__doc__[] = "";
+char pyCitcom_full_solver_init__name__[] = "full_solver_init";
+
+PyObject * pyCitcom_full_solver_init(PyObject *self, PyObject *args)
+{
+ PyObject *obj;
+ struct All_variables* E;
+
+ if (!PyArg_ParseTuple(args, "O:full_solver_init", &obj))
+ return NULL;
+
+ E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
+
+ full_solver_init(E);
+
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+
+char pyCitcom_regional_solver_init__doc__[] = "";
+char pyCitcom_regional_solver_init__name__[] = "regional_solver_init";
+
+PyObject * pyCitcom_regional_solver_init(PyObject *self, PyObject *args)
+{
+ PyObject *obj;
+ struct All_variables* E;
+
+ if (!PyArg_ParseTuple(args, "O:regional_solver_init", &obj))
+ return NULL;
+
+ E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
+
+ regional_solver_init(E);
+
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+
+char pyCitcom_global_default_values__doc__[] = "";
+char pyCitcom_global_default_values__name__[] = "global_default_values";
+
+PyObject * pyCitcom_global_default_values(PyObject *self, PyObject *args)
+{
+ PyObject *obj;
+ struct All_variables* E;
+
+ if (!PyArg_ParseTuple(args, "O:global_default_values", &obj))
+ return NULL;
+
+ E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
+
+ global_default_values(E);
+
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+
+char pyCitcom_set_signal__doc__[] = "";
+char pyCitcom_set_signal__name__[] = "set_signal";
+
+PyObject * pyCitcom_set_signal(PyObject *self, PyObject *args)
+{
+ set_signal();
+
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+
+char pyCitcom_check_settings_consistency__doc__[] = "";
+char pyCitcom_check_settings_consistency__name__[] = "check_settings_consistency";
+
+PyObject * pyCitcom_check_settings_consistency(PyObject *self, PyObject *args)
+{
+ PyObject *obj;
+ struct All_variables* E;
+
+ if (!PyArg_ParseTuple(args, "O:check_settings_consistency", &obj))
+ return NULL;
+
+ E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
+
+ check_settings_consistency(E);
+
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+
+char pyCitcom_velocities_conform_bcs__doc__[] = "";
+char pyCitcom_velocities_conform_bcs__name__[] = "velocities_conform_bcs";
+
+PyObject * pyCitcom_velocities_conform_bcs(PyObject *self, PyObject *args)
+{
+ PyObject *obj;
+ struct All_variables* E;
+
+ if (!PyArg_ParseTuple(args, "O:velocities_conform_bcs", &obj))
+ return NULL;
+
+ E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
+
+ velocities_conform_bcs(E, E->U);
+
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+
+char pyCitcom_BC_update_plate_temperature__doc__[] = "";
+char pyCitcom_BC_update_plate_temperature__name__[] = "BC_update_plate_temperature";
+
+PyObject * pyCitcom_BC_update_plate_temperature(PyObject *self, PyObject *args)
+{
+ PyObject *obj;
+ struct All_variables* E;
+
+ if (!PyArg_ParseTuple(args, "O:BC_update_plate_temperature", &obj))
+ return NULL;
+
+ E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
+
+ if(E->control.tbcs_file==1)
+ read_temperature_boundary_from_file(E);
+
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+
+char pyCitcom_BC_update_plate_velocity__doc__[] = "";
+char pyCitcom_BC_update_plate_velocity__name__[] = "BC_update_plate_velocity";
+
+PyObject * pyCitcom_BC_update_plate_velocity(PyObject *self, PyObject *args)
+{
+ PyObject *obj;
+ struct All_variables* E;
+
+ if (!PyArg_ParseTuple(args, "O:BC_update_plate_velocity", &obj))
+ return NULL;
+
+ E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
+
+ if(E->control.vbcs_file==1)
+ read_velocity_boundary_from_file(E);
+
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+
+char pyCitcom_Tracer_tracer_advection__doc__[] = "";
+char pyCitcom_Tracer_tracer_advection__name__[] = "Tracer_tracer_advection";
+
+PyObject * pyCitcom_Tracer_tracer_advection(PyObject *self, PyObject *args)
+{
+ PyObject *obj;
+ struct All_variables* E;
+
+ if (!PyArg_ParseTuple(args, "O:Tracer_tracer_advection", &obj))
+ return NULL;
+
+ E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
+
+ if(E->control.tracer==1)
+ tracer_advection(E);
+
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+
+char pyCitcom_Visc_update_material__doc__[] = "";
+char pyCitcom_Visc_update_material__name__[] = "Visc_update_material";
+
+PyObject * pyCitcom_Visc_update_material(PyObject *self, PyObject *args)
+{
+ PyObject *obj;
+ struct All_variables* E;
+
+ if (!PyArg_ParseTuple(args, "O:Visc_update_material", &obj))
+ return NULL;
+
+ E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
+
+ if(E->control.mat_control==1)
+ read_mat_from_file(E);
+
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+
+char pyCitcom_return_dt__doc__[] = "";
+char pyCitcom_return_dt__name__[] = "return_dt";
+
+PyObject * pyCitcom_return_dt(PyObject *self, PyObject *args)
+{
+ PyObject *obj;
+ struct All_variables* E;
+
+ if (!PyArg_ParseTuple(args, "O:return_dt", &obj))
+ return NULL;
+
+ E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
+
+ return Py_BuildValue("f", E->advection.timestep);
+}
+
+
+char pyCitcom_return_step__doc__[] = "";
+char pyCitcom_return_step__name__[] = "return_step";
+
+PyObject * pyCitcom_return_step(PyObject *self, PyObject *args)
+{
+ PyObject *obj;
+ struct All_variables* E;
+
+ if (!PyArg_ParseTuple(args, "O:return_step", &obj))
+ return NULL;
+
+ E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
+
+ return Py_BuildValue("i", E->advection.timesteps);
+}
+
+
+char pyCitcom_return_t__doc__[] = "";
+char pyCitcom_return_t__name__[] = "return_t";
+
+PyObject * pyCitcom_return_t(PyObject *self, PyObject *args)
+{
+ PyObject *obj;
+ struct All_variables* E;
+
+ if (!PyArg_ParseTuple(args, "O:return_t", &obj))
+ return NULL;
+
+ E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
+
+ return Py_BuildValue("f", E->monitor.elapsed_time);
+}
+
+
+char pyCitcom_return_rank__doc__[] = "";
+char pyCitcom_return_rank__name__[] = "return_rank";
+
+PyObject * pyCitcom_return_rank(PyObject *self, PyObject *args)
+{
+ PyObject *obj;
+ struct All_variables* E;
+
+ if (!PyArg_ParseTuple(args, "O:return_rank", &obj))
+ return NULL;
+
+ E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
+
+ return Py_BuildValue("i", E->parallel.me);
+}
+
+
+char pyCitcom_return_pid__doc__[] = "";
+char pyCitcom_return_pid__name__[] = "return_pid";
+
+PyObject * pyCitcom_return_pid(PyObject *self, PyObject *args)
+{
+ PyObject *obj;
+ struct All_variables* E;
+
+ if (!PyArg_ParseTuple(args, "O:return_pid", &obj))
+ return NULL;
+
+ E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
+
+ return Py_BuildValue("i", E->control.PID);
+}
+
+
+/*////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////*/
+
+
+
+/* $Id$ */
+
+/* End of file */
Deleted: mc/3D/CitcomS/branches/cxx/module/outputs.c
===================================================================
--- mc/3D/CitcomS/trunk/module/outputs.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/module/outputs.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,129 +0,0 @@
-/*
-//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-//
-//<LicenseText>
-//
-// CitcomS.py by Eh Tan, Eun-seo Choi, and Pururav Thoutireddy.
-// Copyright (C) 2002-2005, California Institute of Technology.
-//
-// 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-//
-//</LicenseText>
-//
-//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-*/
-
-#include <Python.h>
-#include <stdio.h>
-
-#include "outputs.h"
-
-#include "global_defs.h"
-#include "output.h"
-
-
-void output_finalize(struct All_variables *E);
-
-
-char pyCitcom_output__doc__[] = "";
-char pyCitcom_output__name__[] = "output";
-
-PyObject * pyCitcom_output(PyObject *self, PyObject *args)
-{
- PyObject *obj;
- struct All_variables* E;
- int cycles;
-
- if (!PyArg_ParseTuple(args, "Oi:output", &obj, &cycles))
- return NULL;
-
- E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
-
- (E->problem_output)(E, cycles);
-
-
- Py_INCREF(Py_None);
- return Py_None;
-}
-
-
-char pyCitcom_output_finalize__doc__[] = "";
-char pyCitcom_output_finalize__name__[] = "output_finalize";
-
-PyObject * pyCitcom_output_finalize(PyObject *self, PyObject *args)
-{
- PyObject *obj;
- struct All_variables* E;
- int cycles;
-
- if (!PyArg_ParseTuple(args, "O:output_finalize", &obj))
- return NULL;
-
- E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
-
- output_finalize(E);
-
- Py_INCREF(Py_None);
- return Py_None;
-}
-
-
-char pyCitcom_output_time__doc__[] = "";
-char pyCitcom_output_time__name__[] = "output_time";
-
-PyObject * pyCitcom_output_time(PyObject *self, PyObject *args)
-{
- PyObject *obj;
- struct All_variables* E;
- int cycles;
-
- if (!PyArg_ParseTuple(args, "Oi:output_time", &obj, &cycles))
- return NULL;
-
- E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
-
- output_time(E, cycles);
-
-
- Py_INCREF(Py_None);
- return Py_None;
-}
-
-
-char pyCitcom_output_checkpoint__doc__[] = "";
-char pyCitcom_output_checkpoint__name__[] = "output_checkpoint";
-
-PyObject * pyCitcom_output_checkpoint(PyObject *self, PyObject *args)
-{
- void read_checkpoint(struct All_variables*);
- PyObject *obj;
- struct All_variables* E;
-
- if (!PyArg_ParseTuple(args, "O:output_checkpoint", &obj))
- return NULL;
-
- E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
-
- output_checkpoint(E);
-
-
- Py_INCREF(Py_None);
- return Py_None;
-}
-
-
-/* $Id$ */
-
-/* End of file */
Copied: mc/3D/CitcomS/branches/cxx/module/outputs.cc (from rev 14029, mc/3D/CitcomS/trunk/module/outputs.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/module/outputs.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/module/outputs.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,129 @@
+/*
+//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+//
+//<LicenseText>
+//
+// CitcomS.py by Eh Tan, Eun-seo Choi, and Pururav Thoutireddy.
+// Copyright (C) 2002-2005, California Institute of Technology.
+//
+// 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+//
+//</LicenseText>
+//
+//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+*/
+
+#include <Python.h>
+#include <stdio.h>
+
+#include "outputs.h"
+
+#include "global_defs.h"
+#include "output.h"
+
+
+void output_finalize(struct All_variables *E);
+
+
+char pyCitcom_output__doc__[] = "";
+char pyCitcom_output__name__[] = "output";
+
+PyObject * pyCitcom_output(PyObject *self, PyObject *args)
+{
+ PyObject *obj;
+ struct All_variables* E;
+ int cycles;
+
+ if (!PyArg_ParseTuple(args, "Oi:output", &obj, &cycles))
+ return NULL;
+
+ E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
+
+ (E->problem_output)(E, cycles);
+
+
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+
+char pyCitcom_output_finalize__doc__[] = "";
+char pyCitcom_output_finalize__name__[] = "output_finalize";
+
+PyObject * pyCitcom_output_finalize(PyObject *self, PyObject *args)
+{
+ PyObject *obj;
+ struct All_variables* E;
+ int cycles;
+
+ if (!PyArg_ParseTuple(args, "O:output_finalize", &obj))
+ return NULL;
+
+ E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
+
+ output_finalize(E);
+
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+
+char pyCitcom_output_time__doc__[] = "";
+char pyCitcom_output_time__name__[] = "output_time";
+
+PyObject * pyCitcom_output_time(PyObject *self, PyObject *args)
+{
+ PyObject *obj;
+ struct All_variables* E;
+ int cycles;
+
+ if (!PyArg_ParseTuple(args, "Oi:output_time", &obj, &cycles))
+ return NULL;
+
+ E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
+
+ output_time(E, cycles);
+
+
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+
+char pyCitcom_output_checkpoint__doc__[] = "";
+char pyCitcom_output_checkpoint__name__[] = "output_checkpoint";
+
+PyObject * pyCitcom_output_checkpoint(PyObject *self, PyObject *args)
+{
+ void read_checkpoint(struct All_variables*);
+ PyObject *obj;
+ struct All_variables* E;
+
+ if (!PyArg_ParseTuple(args, "O:output_checkpoint", &obj))
+ return NULL;
+
+ E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
+
+ output_checkpoint(E);
+
+
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+
+/* $Id$ */
+
+/* End of file */
Deleted: mc/3D/CitcomS/branches/cxx/module/setProperties.c
===================================================================
--- mc/3D/CitcomS/trunk/module/setProperties.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/module/setProperties.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,973 +0,0 @@
-/*
-//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-//
-//<LicenseText>
-//
-// CitcomS.py by Eh Tan, Eun-seo Choi, and Pururav Thoutireddy.
-// Copyright (C) 2002-2005, California Institute of Technology.
-//
-// 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-//
-//</LicenseText>
-//
-//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-*/
-
-#include <Python.h>
-#include <stddef.h>
-#include <stdio.h>
-#include <string.h>
-#include <math.h>
-#include "global_defs.h"
-#include "parallel_related.h"
-#include "setProperties.h"
-
-
-/* See PEP 353. */
-#if PY_VERSION_HEX < 0x02050000 && !defined(PY_SSIZE_T_MIN)
-typedef int Py_ssize_t;
-#define PY_SSIZE_T_MAX INT_MAX
-#define PY_SSIZE_T_MIN INT_MIN
-#endif
-
-
-/*==============================================================*/
-/* functions and macros which fetch properties from 'inventory' */
-
-
-FILE *get_output_stream(PyObject *out, struct All_variables*E);
-#define PUTS(s) if (fp) fprintf(fp, s)
-
-int _getStringProperty(PyObject* properties, char* attribute,
- char* value, size_t valueSize, FILE* fp);
-#define getStringProperty(p, a, v, o) if (-1 == _getStringProperty(p, a, v, sizeof(v), o)) return NULL
-
-int _getIntProperty(PyObject* properties, char* attribute, int *value, FILE* fp);
-#define getIntProperty(p, a, v, o) if (-1 == _getIntProperty(p, a, &(v), o)) return NULL
-
-int _getFloatProperty(PyObject* properties, char* attribute, float *value, FILE* fp);
-#define getFloatProperty(p, a, v, o) if (-1 == _getFloatProperty(p, a, &(v), o)) return NULL
-
-int _getDoubleProperty(PyObject* properties, char* attribute, double *value, FILE* fp);
-#define getDoubleProperty(p, a, v, o) if (-1 == _getDoubleProperty(p, a, &(v), o)) return NULL
-
-int _getIntVectorProperty(PyObject* properties, char* attribute,
- int* vector, int len, FILE* fp);
-#define getIntVectorProperty(p, a, v, l, o) if (-1 == _getIntVectorProperty(p, a, v, l, o)) return NULL
-
-int _getFloatVectorProperty(PyObject* properties, char* attribute,
- float* vector, int len, FILE* fp);
-#define getFloatVectorProperty(p, a, v, l, o) if (-1 == _getFloatVectorProperty(p, a, v, l, o)) return NULL
-
-int _getDoubleVectorProperty(PyObject* properties, char* attribute,
- double* vector, int len, FILE* fp);
-#define getDoubleVectorProperty(p, a, v, l, o) if (-1 == _getDoubleVectorProperty(p, a, v, l, o)) return NULL
-
-
-void myerror(struct All_variables *,char *);
-void report(struct All_variables *,char *);
-
-/*==============================================================*/
-
-
-char pyCitcom_Advection_diffusion_set_properties__doc__[] = "";
-char pyCitcom_Advection_diffusion_set_properties__name__[] = "Advection_diffusion_set_properties";
-
-PyObject * pyCitcom_Advection_diffusion_set_properties(PyObject *self, PyObject *args)
-{
- PyObject *obj, *properties, *out;
- struct All_variables *E;
- FILE *fp;
-
- if (!PyArg_ParseTuple(args, "OOO:Advection_diffusion_set_properties",
- &obj, &properties, &out))
- return NULL;
-
- E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
- fp = get_output_stream(out, E);
-
- PUTS(("[CitcomS.solver.tsolver]\n"));
-
- getIntProperty(properties, "ADV", E->advection.ADVECTION, fp);
- getIntProperty(properties, "filter_temp", E->advection.filter_temperature, fp);
- getIntProperty(properties, "monitor_max_T", E->advection.monitor_max_T, fp);
-
- getFloatProperty(properties, "finetunedt", E->advection.fine_tune_dt, fp);
- getFloatProperty(properties, "fixed_timestep", E->advection.fixed_timestep, fp);
- getFloatProperty(properties, "adv_gamma", E->advection.gamma, fp);
- getIntProperty(properties, "adv_sub_iterations", E->advection.temp_iterations, fp);
-
- getFloatProperty(properties, "inputdiffusivity", E->control.inputdiff, fp);
-
-
- PUTS(("\n"));
-
- Py_INCREF(Py_None);
- return Py_None;
-
-}
-
-
-
-char pyCitcom_BC_set_properties__doc__[] = "";
-char pyCitcom_BC_set_properties__name__[] = "BC_set_properties";
-
-PyObject * pyCitcom_BC_set_properties(PyObject *self, PyObject *args)
-{
- PyObject *obj, *properties, *out;
- struct All_variables *E;
- FILE *fp;
-
- if (!PyArg_ParseTuple(args, "OOO:BC_set_properties",
- &obj, &properties, &out))
- return NULL;
-
- E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
- fp = get_output_stream(out, E);
-
- PUTS(("[CitcomS.solver.bc]\n"));
-
- getIntProperty(properties, "side_sbcs", E->control.side_sbcs, fp);
- getIntProperty(properties, "pseudo_free_surf", E->control.pseudo_free_surf, fp);
-
- getIntProperty(properties, "topvbc", E->mesh.topvbc, fp);
- getFloatProperty(properties, "topvbxval", E->control.VBXtopval, fp);
- getFloatProperty(properties, "topvbyval", E->control.VBYtopval, fp);
-
- getIntProperty(properties, "botvbc", E->mesh.botvbc, fp);
- getFloatProperty(properties, "botvbxval", E->control.VBXbotval, fp);
- getFloatProperty(properties, "botvbyval", E->control.VBYbotval, fp);
-
- getIntProperty(properties, "toptbc", E->mesh.toptbc, fp);
- getFloatProperty(properties, "toptbcval", E->control.TBCtopval, fp);
-
- getIntProperty(properties, "bottbc", E->mesh.bottbc, fp);
- getFloatProperty(properties, "bottbcval", E->control.TBCbotval, fp);
-
- getIntProperty(properties, "temperature_bound_adj", E->control.temperature_bound_adj, fp);
- getFloatProperty(properties, "depth_bound_adj", E->control.depth_bound_adj, fp);
- getFloatProperty(properties, "width_bound_adj", E->control.width_bound_adj, fp);
-
-
- PUTS(("\n"));
-
- Py_INCREF(Py_None);
- return Py_None;
-}
-
-
-
-char pyCitcom_Const_set_properties__doc__[] = "";
-char pyCitcom_Const_set_properties__name__[] = "Const_set_properties";
-
-PyObject * pyCitcom_Const_set_properties(PyObject *self, PyObject *args)
-{
- PyObject *obj, *properties, *out;
- struct All_variables *E;
- FILE *fp;
- float radius;
-
- if (!PyArg_ParseTuple(args, "OOO:Const_set_properties",
- &obj, &properties, &out))
- return NULL;
-
- E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
- fp = get_output_stream(out, E);
-
- PUTS(("[CitcomS.solver.const]\n"));
-
- getFloatProperty(properties, "radius", radius, fp);
- getFloatProperty(properties, "density", E->data.density, fp);
- getFloatProperty(properties, "thermdiff", E->data.therm_diff, fp);
- getFloatProperty(properties, "gravacc", E->data.grav_acc, fp);
- getFloatProperty(properties, "thermexp", E->data.therm_exp, fp);
- getFloatProperty(properties, "refvisc", E->data.ref_viscosity, fp);
- getFloatProperty(properties, "cp", E->data.Cp, fp);
- getFloatProperty(properties, "density_above", E->data.density_above, fp);
- getFloatProperty(properties, "density_below", E->data.density_below, fp);
-
- E->data.therm_cond = E->data.therm_diff * E->data.density * E->data.Cp;
- E->data.ref_temperature = E->control.Atemp * E->data.therm_diff
- * E->data.ref_viscosity / (radius * radius * radius)
- / (E->data.density * E->data.grav_acc * E->data.therm_exp);
-
- getFloatProperty(properties, "z_lith", E->viscosity.zlith, fp);
- getFloatProperty(properties, "z_410", E->viscosity.z410, fp);
- getFloatProperty(properties, "z_lmantle", E->viscosity.zlm, fp);
- getFloatProperty(properties, "z_cmb", E->viscosity.zcmb, fp); /* this is used as the D" phase change depth */
-
- E->viscosity.zbase_layer[0] = E->viscosity.zlith;
- E->viscosity.zbase_layer[1] = E->viscosity.z410;
- E->viscosity.zbase_layer[2] = E->viscosity.zlm;
- E->viscosity.zbase_layer[3] = E->viscosity.zcmb;
-
- /* convert meter to kilometer */
- E->data.radius_km = radius / 1e3;
-
- PUTS(("\n"));
-
- Py_INCREF(Py_None);
- return Py_None;
-
-}
-
-
-
-char pyCitcom_IC_set_properties__doc__[] = "";
-char pyCitcom_IC_set_properties__name__[] = "IC_set_properties";
-
-PyObject * pyCitcom_IC_set_properties(PyObject *self, PyObject *args)
-{
- PyObject *obj, *properties, *out;
- struct All_variables *E;
- FILE *fp;
- int num_perturb;
-
- if (!PyArg_ParseTuple(args, "OOO:IC_set_properties",
- &obj, &properties, &out))
- return NULL;
-
- E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
- fp = get_output_stream(out, E);
-
- PUTS(("[CitcomS.solver.ic]\n"));
-
- getIntProperty(properties, "restart", E->control.restart, fp);
- getIntProperty(properties, "post_p", E->control.post_p, fp);
- getIntProperty(properties, "solution_cycles_init", E->monitor.solution_cycles_init, fp);
- getIntProperty(properties, "zero_elapsed_time", E->control.zero_elapsed_time, fp);
-
- getIntProperty(properties, "tic_method", E->convection.tic_method, fp);
-
- getIntProperty(properties, "num_perturbations", num_perturb, fp);
- if(num_perturb > PERTURB_MAX_LAYERS) {
- fprintf(stderr, "'num_perturb' greater than allowed value, set to %d\n", PERTURB_MAX_LAYERS);
- num_perturb = PERTURB_MAX_LAYERS;
- }
- E->convection.number_of_perturbations = num_perturb;
-
- getIntVectorProperty(properties, "perturbl", E->convection.perturb_ll,
- num_perturb, fp);
- getIntVectorProperty(properties, "perturbm", E->convection.perturb_mm,
- num_perturb, fp);
- getIntVectorProperty(properties, "perturblayer", E->convection.load_depth,
- num_perturb, fp);
- getFloatVectorProperty(properties, "perturbmag", E->convection.perturb_mag,
- num_perturb, fp);
-
- getFloatProperty(properties, "half_space_age", E->convection.half_space_age, fp);
- getFloatVectorProperty(properties, "blob_center", E->convection.blob_center, 3, fp);
- if( E->convection.blob_center[0] == -999.0 && E->convection.blob_center[1] == -999.0 && E->convection.blob_center[2] == -999.0 ) {
- E->convection.blob_center[0] = 0.5*(E->control.theta_min+E->control.theta_max);
- E->convection.blob_center[1] = 0.5*(E->control.fi_min+E->control.fi_max);
- E->convection.blob_center[2] = 0.5*(E->sphere.ri+E->sphere.ro);
- }
- getFloatProperty(properties, "blob_radius", E->convection.blob_radius, fp);
- getFloatProperty(properties, "blob_dT", E->convection.blob_dT, fp);
-
- PUTS(("\n"));
-
- if (PyErr_Occurred())
- return NULL;
-
- Py_INCREF(Py_None);
- return Py_None;
-}
-
-
-
-char pyCitcom_Output_set_properties__doc__[] = "";
-char pyCitcom_Output_set_properties__name__[] = "Output_set_properties";
-
-PyObject * pyCitcom_Output_set_properties(PyObject *self, PyObject *args)
-{
- PyObject *obj, *properties, *out;
- struct All_variables *E;
- FILE *fp;
-
- if (!PyArg_ParseTuple(args, "OOO:Output_set_properties",
- &obj, &properties, &out))
- return NULL;
-
- E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
- fp = get_output_stream(out, E);
-
- PUTS(("[CitcomS.solver.output]\n"));
-
- getStringProperty(properties, "output_format", E->output.format, fp);
- getStringProperty(properties, "output_optional", E->output.optional, fp);
-
- getIntProperty(properties, "gzdir_vtkio", E->output.gzdir.vtk_io, fp);
- getIntProperty(properties, "gzdir_rnr", E->output.gzdir.rnr, fp);
- E->output.gzdir.vtk_base_init = 0;
- /* should we save the basis vectors? (memory!) */
- E->output.gzdir.vtk_base_save = 1;
-
- getIntProperty(properties, "output_ll_max", E->output.llmax, fp);
- getIntProperty(properties, "self_gravitation", E->control.self_gravitation, fp);
- getIntProperty(properties, "use_cbf_topo", E->control.use_cbf_topo, fp);
-
- getIntProperty(properties, "cb_block_size", E->output.cb_block_size, fp);
- getIntProperty(properties, "cb_buffer_size", E->output.cb_buffer_size, fp);
-
- getIntProperty(properties, "sieve_buf_size", E->output.sieve_buf_size, fp);
-
- getIntProperty(properties, "output_alignment", E->output.alignment, fp);
- getIntProperty(properties, "output_alignment_threshold", E->output.alignment_threshold, fp);
-
- getIntProperty(properties, "cache_mdc_nelmts", E->output.cache_mdc_nelmts, fp);
- getIntProperty(properties, "cache_rdcc_nelmts", E->output.cache_rdcc_nelmts, fp);
- getIntProperty(properties, "cache_rdcc_nbytes", E->output.cache_rdcc_nbytes, fp);
-
- PUTS(("\n"));
-
- Py_INCREF(Py_None);
- return Py_None;
-
-}
-
-
-
-char pyCitcom_Param_set_properties__doc__[] = "";
-char pyCitcom_Param_set_properties__name__[] = "Param_set_properties";
-
-PyObject * pyCitcom_Param_set_properties(PyObject *self, PyObject *args)
-{
- PyObject *obj, *properties, *out;
- struct All_variables *E;
- FILE *fp;
-
- if (!PyArg_ParseTuple(args, "OOO:Param_set_properties",
- &obj, &properties, &out))
- return NULL;
-
- E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
- fp = get_output_stream(out, E);
-
- PUTS(("[CitcomS.solver.param]\n"));
-
- getIntProperty(properties, "reference_state", E->refstate.choice, fp);
- if(E->refstate.choice == 0) {
- getStringProperty(properties, "refstate_file", E->refstate.filename, fp);
- }
-
- getIntProperty(properties, "file_vbcs", E->control.vbcs_file, fp);
- getStringProperty(properties, "vel_bound_file", E->control.velocity_boundary_file, fp);
-
- getIntProperty(properties, "file_tbcs", E->control.tbcs_file, fp);
- getStringProperty(properties, "temp_bound_file", E->control.temperature_boundary_file, fp);
-
- getIntProperty(properties, "mat_control", E->control.mat_control, fp);
- getStringProperty(properties, "mat_file", E->control.mat_file, fp);
-
- getIntProperty(properties, "lith_age", E->control.lith_age, fp);
- getStringProperty(properties, "lith_age_file", E->control.lith_age_file, fp);
- getIntProperty(properties, "lith_age_time", E->control.lith_age_time, fp);
- getFloatProperty(properties, "lith_age_depth", E->control.lith_age_depth, fp);
- getFloatProperty(properties, "mantle_temp", E->control.lith_age_mantle_temp, fp);
-
- getFloatProperty(properties, "start_age", E->control.start_age, fp);
- getIntProperty(properties, "reset_startage", E->control.reset_startage, fp);
-
- PUTS(("\n"));
-
- Py_INCREF(Py_None);
- return Py_None;
-
-}
-
-
-
-char pyCitcom_Phase_set_properties__doc__[] = "";
-char pyCitcom_Phase_set_properties__name__[] = "Phase_set_properties";
-
-PyObject * pyCitcom_Phase_set_properties(PyObject *self, PyObject *args)
-{
- PyObject *obj, *properties, *out;
- struct All_variables *E;
- FILE *fp;
- float width;
-
- if (!PyArg_ParseTuple(args, "OOO:Phase_set_properties",
- &obj, &properties, &out))
- return NULL;
-
- E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
- fp = get_output_stream(out, E);
-
- PUTS(("[CitcomS.solver.phase]\n"));
-
- getFloatProperty(properties, "Ra_410", E->control.Ra_410, fp);
- getFloatProperty(properties, "clapeyron410", E->control.clapeyron410, fp);
- getFloatProperty(properties, "transT410", E->control.transT410, fp);
- getFloatProperty(properties, "width410", width, fp);
-
- if (width!=0.0)
- E->control.inv_width410 = 1.0 / width;
-
- getFloatProperty(properties, "Ra_670", E->control.Ra_670 , fp);
- getFloatProperty(properties, "clapeyron670", E->control.clapeyron670, fp);
- getFloatProperty(properties, "transT670", E->control.transT670, fp);
- getFloatProperty(properties, "width670", width, fp);
-
- if (width!=0.0)
- E->control.inv_width670 = 1.0 / width;
-
- getFloatProperty(properties, "Ra_cmb", E->control.Ra_cmb, fp);
- getFloatProperty(properties, "clapeyroncmb", E->control.clapeyroncmb, fp);
- getFloatProperty(properties, "transTcmb", E->control.transTcmb, fp);
- getFloatProperty(properties, "widthcmb", width, fp);
-
- if (width!=0.0)
- E->control.inv_widthcmb = 1.0 / width;
-
- PUTS(("\n"));
-
- Py_INCREF(Py_None);
- return Py_None;
-
-}
-
-
-
-char pyCitcom_Solver_set_properties__doc__[] = "";
-char pyCitcom_Solver_set_properties__name__[] = "Solver_set_properties";
-
-PyObject * pyCitcom_Solver_set_properties(PyObject *self, PyObject *args)
-{
- PyObject *obj, *properties, *out;
- struct All_variables *E;
- FILE *fp;
- float tmp;
-
- if (!PyArg_ParseTuple(args, "OOO:Solver_set_properties",
- &obj, &properties, &out))
- return NULL;
-
- E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
- fp = get_output_stream(out, E);
-
- PUTS(("[CitcomS.solver]\n"));
-
- getStringProperty(properties, "datadir", E->control.data_dir, fp);
- getStringProperty(properties, "datafile", E->control.data_prefix, fp);
- getStringProperty(properties, "datadir_old", E->control.data_dir_old, fp);
- getStringProperty(properties, "datafile_old", E->control.data_prefix_old, fp);
-
- getFloatProperty(properties, "rayleigh", E->control.Atemp, fp);
- getFloatProperty(properties, "dissipation_number", E->control.disptn_number, fp);
- getFloatProperty(properties, "gruneisen", tmp, fp);
- /* special case: if tmp==0, set gruneisen as inf */
- if(tmp != 0)
- E->control.inv_gruneisen = 1/tmp;
- else
- E->control.inv_gruneisen = 0;
-
- getFloatProperty(properties, "surfaceT", E->control.surface_temp, fp);
- /*getFloatProperty(properties, "adiabaticT0", E->control.adiabaticT0, fp);*/
- getFloatProperty(properties, "Q0", E->control.Q0, fp);
-
- getIntProperty(properties, "stokes_flow_only", E->control.stokes, fp);
-
- getIntProperty(properties, "verbose", E->control.verbose, fp);
- getIntProperty(properties, "see_convergence", E->control.print_convergence, fp);
-
- /* parameters not used in pyre version,
- assigned value here to prevent uninitialized access */
- E->advection.min_timesteps = 1;
- E->advection.max_timesteps = 1;
- E->advection.max_total_timesteps = 1;
- E->control.checkpoint_frequency = 1;
- E->control.record_every = 1;
- E->control.record_all_until = 1;
-
- PUTS(("\n"));
-
- Py_INCREF(Py_None);
- return Py_None;
-}
-
-
-
-char pyCitcom_Sphere_set_properties__doc__[] = "";
-char pyCitcom_Sphere_set_properties__name__[] = "Sphere_set_properties";
-
-PyObject * pyCitcom_Sphere_set_properties(PyObject *self, PyObject *args)
-{
- void full_set_3dsphere_defaults2(struct All_variables *);
- void regional_set_3dsphere_defaults2(struct All_variables *);
-
- PyObject *obj, *properties, *out;
- struct All_variables *E;
- FILE *fp;
-
- if (!PyArg_ParseTuple(args, "OOO:Sphere_set_properties",
- &obj, &properties, &out))
- return NULL;
-
- E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
- fp = get_output_stream(out, E);
-
- PUTS(("[CitcomS.solver.mesher]\n"));
-
- getIntProperty(properties, "nproc_surf", E->parallel.nprocxy, fp);
-
- getIntProperty(properties, "nprocx", E->parallel.nprocx, fp);
- getIntProperty(properties, "nprocy", E->parallel.nprocy, fp);
- getIntProperty(properties, "nprocz", E->parallel.nprocz, fp);
-
- if (E->parallel.nprocxy == 12)
- if (E->parallel.nprocx != E->parallel.nprocy) {
- char errmsg[] = "!!!! nprocx must equal to nprocy";
- PyErr_SetString(PyExc_SyntaxError, errmsg);
- return NULL;
- }
-
- getIntProperty(properties, "coor", E->control.coor, fp);
- getFloatVectorProperty(properties, "coor_refine", E->control.coor_refine, 4, fp);
- getStringProperty(properties, "coor_file", E->control.coor_file, fp);
-
- if ( strcmp(E->control.SOLVER_TYPE,"cgrad") == 0) {
- getIntProperty(properties, "nodex", E->mesh.nox, fp);
- getIntProperty(properties, "nodey", E->mesh.noy, fp);
- getIntProperty(properties, "nodez", E->mesh.noz, fp);
-
- E->mesh.mgunitx = E->mesh.nox - 1;
- E->mesh.mgunity = E->mesh.noy - 1;
- E->mesh.mgunitz = E->mesh.noz - 1;
- E->mesh.levels = 1;
- }
- else {
- double levmax;
-
- getIntProperty(properties, "mgunitx", E->mesh.mgunitx, fp);
- getIntProperty(properties, "mgunity", E->mesh.mgunity, fp);
- getIntProperty(properties, "mgunitz", E->mesh.mgunitz, fp);
- getIntProperty(properties, "levels", E->mesh.levels, fp);
-
- levmax = E->mesh.levels - 1;
- E->mesh.nox = E->mesh.mgunitx * (int) pow(2.0,levmax) * E->parallel.nprocx + 1;
- E->mesh.noy = E->mesh.mgunity * (int) pow(2.0,levmax) * E->parallel.nprocy + 1;
- E->mesh.noz = E->mesh.mgunitz * (int) pow(2.0,levmax) * E->parallel.nprocz + 1;
- }
-
- if (E->parallel.nprocxy == 12) {
- if (E->mesh.nox != E->mesh.noy) {
- char errmsg[] = "!!!! nodex must equal to nodey";
- PyErr_SetString(PyExc_SyntaxError, errmsg);
- return NULL;
- }
- }
-
- getDoubleProperty(properties, "radius_outer", E->sphere.ro, fp);
- getDoubleProperty(properties, "radius_inner", E->sphere.ri, fp);
-
-
- if (E->parallel.nprocxy == 12) {
- full_set_3dsphere_defaults2(E);
- }
- else {
- getDoubleProperty(properties, "theta_min", E->control.theta_min, fp);
- getDoubleProperty(properties, "theta_max", E->control.theta_max, fp);
- getDoubleProperty(properties, "fi_min", E->control.fi_min, fp);
- getDoubleProperty(properties, "fi_max", E->control.fi_max, fp);
-
- regional_set_3dsphere_defaults2(E);
- }
-
- E->mesh.layer[1] = 1;
- E->mesh.layer[2] = 1;
- E->mesh.layer[3] = 1;
-
- PUTS(("\n"));
-
- Py_INCREF(Py_None);
- return Py_None;
-}
-
-
-
-char pyCitcom_Tracer_set_properties__doc__[] = "";
-char pyCitcom_Tracer_set_properties__name__[] = "Tracer_set_properties";
-
-PyObject * pyCitcom_Tracer_set_properties(PyObject *self, PyObject *args)
-{
- PyObject *obj, *properties, *out;
- struct All_variables *E;
- FILE *fp;
- double tmp;
- char message[100];
-
- if (!PyArg_ParseTuple(args, "OOO:Tracer_set_properties",
- &obj, &properties, &out))
- return NULL;
-
- E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
- fp = get_output_stream(out, E);
-
- PUTS(("[CitcomS.solver.tracer]\n"));
-
- getIntProperty(properties, "tracer", E->control.tracer, fp);
-
- getIntProperty(properties, "tracer_enriched", E->control.tracer_enriched, fp);
- if(E->control.tracer_enriched) {
- if(!E->control.tracer)
- myerror(E,"need to switch on tracers for tracer_enriched");
-
- getFloatProperty(properties, "Q0_enriched", E->control.Q0ER, fp);
- snprintf(message,100,"using compositionally enriched heating: C = 0: %g C = 1: %g (only one composition!)",
- E->control.Q0,E->control.Q0ER);
- report(E,message);
- }
-
- getIntProperty(properties, "tracer_ic_method",
- E->trace.ic_method, fp);
-
- if (E->trace.ic_method==0) {
- getIntProperty(properties, "tracers_per_element",
- E->trace.itperel, fp);
- }
- else if (E->trace.ic_method==1) {
- getStringProperty(properties, "tracer_file",
- E->trace.tracer_file, fp);
- }
- else if (E->trace.ic_method==2) {
- }
- else {
- fprintf(stderr,"Sorry, tracer_ic_method only 0, 1 and 2 available\n");
- fflush(stderr);
- parallel_process_termination();
- }
-
- getIntProperty(properties, "tracer_flavors", E->trace.nflavors, fp);
-
- getIntProperty(properties, "ic_method_for_flavors", E->trace.ic_method_for_flavors, fp);
-
- if (E->trace.nflavors > 1) {
- switch(E->trace.ic_method_for_flavors){
- case 0: /* layer */
- E->trace.z_interface = (double*) malloc((E->trace.nflavors-1)
- *sizeof(double));
-
- getDoubleVectorProperty(properties, "z_interface", E->trace.z_interface, E->trace.nflavors-1, fp);
- break;
- case 1: /* from grid in top n materials */
- /* file from which to read */
- getStringProperty(properties, "ictracer_grd_file", E->trace.ggrd_file, fp);
- /* which top layers to use */
- getIntProperty(properties, "ictracer_grd_layers", E->trace.ggrd_layers, fp);
- break;
- default:
- fprintf(stderr,"ic_method_for_flavors %i undefined\n",E->trace.ic_method_for_flavors);
- parallel_process_termination();
- break;
- }
- }
-
- getIntProperty(properties, "itracer_warnings", E->trace.itracer_warnings, fp);
- getIntProperty(properties, "itracer_interpolate_fields", E->trace.itracer_interpolate_fields, fp);
-
- getIntProperty(properties, "chemical_buoyancy",
- E->composition.ichemical_buoyancy, fp);
-
- if (E->control.tracer && E->composition.ichemical_buoyancy==1) {
- getIntProperty(properties, "buoy_type", E->composition.ibuoy_type, fp);
-
- if (E->composition.ibuoy_type==0)
- E->composition.ncomp = E->trace.nflavors;
- else if (E->composition.ibuoy_type==1)
- E->composition.ncomp = E->trace.nflavors - 1;
-
- E->composition.buoyancy_ratio = (double*) malloc(E->composition.ncomp
- *sizeof(double));
-
- getDoubleVectorProperty(properties, "buoyancy_ratio", E->composition.buoyancy_ratio, E->composition.ncomp, fp);
- }
-
-
- if(E->parallel.nprocxy == 12) {
-
- getDoubleProperty(properties, "regular_grid_deltheta", tmp, fp);
- E->trace.deltheta[0] = tmp;
- getDoubleProperty(properties, "regular_grid_delphi", tmp, fp);
- E->trace.delphi[0] = tmp;
-
- E->trace.ianalytical_tracer_test = 0;
- //getIntProperty(properties, "analytical_tracer_test", E->trace.ianalytical_tracer_test, fp);
-
-
- E->composition.icompositional_rheology = 0;
- /*
- getIntProperty(properties, "compositional_rheology", E->composition.icompositional_rheology, fp);
-
- if (E->composition.icompositional_rheology==1) {
- getDoubleProperty(properties, "compositional_prefactor", E->composition.compositional_rheology_prefactor, fp);
- }
- */
- }
- PUTS(("\n"));
-
- Py_INCREF(Py_None);
- return Py_None;
-}
-
-
-
-char pyCitcom_Visc_set_properties__doc__[] = "";
-char pyCitcom_Visc_set_properties__name__[] = "Visc_set_properties";
-
-PyObject * pyCitcom_Visc_set_properties(PyObject *self, PyObject *args)
-{
- PyObject *obj, *properties, *out;
- struct All_variables *E;
- FILE *fp;
- int num_mat, i;
-
- if (!PyArg_ParseTuple(args, "OOO:Visc_set_properties",
- &obj, &properties, &out))
- return NULL;
-
- E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
- fp = get_output_stream(out, E);
-
- PUTS(("[CitcomS.solver.visc]\n"));
-
- getStringProperty(properties, "Viscosity", E->viscosity.STRUCTURE, fp);
- if (strcmp(E->viscosity.STRUCTURE,"system") == 0)
- E->viscosity.FROM_SYSTEM = 1;
- else
- E->viscosity.FROM_SYSTEM = 0;
-
- getIntProperty(properties, "visc_smooth_method", E->viscosity.smooth_cycles, fp);
- getIntProperty(properties, "VISC_UPDATE", E->viscosity.update_allowed, fp);
-
-#define MAX_MAT 40
-
- getIntProperty(properties, "num_mat", num_mat, fp);
- if(num_mat > MAX_MAT) {
- /* max. allowed material types = 40 */
- fprintf(stderr, "'num_mat' greater than allowed value, set to %d\n", MAX_MAT);
- num_mat = MAX_MAT;
- }
- E->viscosity.num_mat = num_mat;
-
- getFloatVectorProperty(properties, "visc0",
- E->viscosity.N0, num_mat, fp);
-
- getIntProperty(properties, "TDEPV", E->viscosity.TDEPV, fp);
- getIntProperty(properties, "rheol", E->viscosity.RHEOL, fp);
- getFloatVectorProperty(properties, "viscE",
- E->viscosity.E, num_mat, fp);
- getFloatVectorProperty(properties, "viscT",
- E->viscosity.T, num_mat, fp);
- getFloatVectorProperty(properties, "viscZ",
- E->viscosity.Z, num_mat, fp);
-
- getIntProperty(properties, "SDEPV", E->viscosity.SDEPV, fp);
- getFloatVectorProperty(properties, "sdepv_expt",
- E->viscosity.sdepv_expt, num_mat, fp);
-
- getIntProperty(properties, "PDEPV", E->viscosity.PDEPV, fp);
- if (E->viscosity.PDEPV) {
- E->viscosity.pdepv_visited = 0;
- getIntProperty(properties, "pdepv_eff", E->viscosity.pdepv_eff, fp);
- getFloatVectorProperty(properties, "pdepv_a",
- E->viscosity.pdepv_a, num_mat, fp);
- getFloatVectorProperty(properties, "pdepv_b",
- E->viscosity.pdepv_b, num_mat, fp);
- getFloatVectorProperty(properties, "pdepv_y",
- E->viscosity.pdepv_y, num_mat, fp);
- getFloatProperty(properties, "pdepv_offset", E->viscosity.pdepv_offset, fp);
- }
- if(E->viscosity.PDEPV || E->viscosity.SDEPV)
- getFloatProperty(properties, "sdepv_misfit", E->viscosity.sdepv_misfit, fp);
-
- getIntProperty(properties, "CDEPV", E->viscosity.CDEPV, fp);
- if(E->viscosity.CDEPV){ /* compositional viscosity */
- if(!E->control.tracer)
- myerror(E,"error: CDEPV requires tracers, but tracer is off");
- if(E->trace.nflavors > 10)
- myerror(E,"error: too many flavors for CDEPV");
- /* read in flavor factors */
- getFloatVectorProperty(properties, "cdepv_ff",
- E->viscosity.cdepv_ff, E->trace.nflavors, fp);
- /* and take the log because we're using a geometric avg */
- for(i=0;i<E->trace.nflavors;i++)
- E->viscosity.cdepv_ff[i] = log(E->viscosity.cdepv_ff[i]);
- }
-
- getIntProperty(properties, "low_visc_channel", E->viscosity.channel, fp);
- getIntProperty(properties, "low_visc_wedge", E->viscosity.wedge, fp);
-
- getFloatProperty(properties, "lv_min_radius", E->viscosity.lv_min_radius, fp);
- getFloatProperty(properties, "lv_max_radius", E->viscosity.lv_max_radius, fp);
- getFloatProperty(properties, "lv_channel_thickness", E->viscosity.lv_channel_thickness, fp);
- getFloatProperty(properties, "lv_reduction", E->viscosity.lv_reduction, fp);
-
- getIntProperty(properties, "VMIN", E->viscosity.MIN, fp);
- getFloatProperty(properties, "visc_min", E->viscosity.min_value, fp);
-
- getIntProperty(properties, "VMAX", E->viscosity.MAX, fp);
- getFloatProperty(properties, "visc_max", E->viscosity.max_value, fp);
-
- PUTS(("\n"));
-
- Py_INCREF(Py_None);
- return Py_None;
-}
-
-
-char pyCitcom_Incompressible_set_properties__doc__[] = "";
-char pyCitcom_Incompressible_set_properties__name__[] = "Incompressible_set_properties";
-
-PyObject * pyCitcom_Incompressible_set_properties(PyObject *self, PyObject *args)
-{
- PyObject *obj, *properties, *out;
- struct All_variables *E;
- FILE *fp;
-
- if (!PyArg_ParseTuple(args, "OOO:Incompressible_set_properties",
- &obj, &properties, &out))
- return NULL;
-
- E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
- fp = get_output_stream(out, E);
-
- PUTS(("[CitcomS.solver.vsolver]\n"));
-
- getStringProperty(properties, "Solver", E->control.SOLVER_TYPE, fp);
- getIntProperty(properties, "node_assemble", E->control.NASSEMBLE, fp);
- getIntProperty(properties, "precond", E->control.precondition, fp);
-
- getDoubleProperty(properties, "accuracy", E->control.accuracy, fp);
-
- getIntProperty(properties, "mg_cycle", E->control.mg_cycle, fp);
- getIntProperty(properties, "down_heavy", E->control.down_heavy, fp);
- getIntProperty(properties, "up_heavy", E->control.up_heavy, fp);
-
- getIntProperty(properties, "vlowstep", E->control.v_steps_low, fp);
- getIntProperty(properties, "vhighstep", E->control.v_steps_high, fp);
- getIntProperty(properties, "piterations", E->control.p_iterations, fp);
-
- getIntProperty(properties, "aug_lagr", E->control.augmented_Lagr, fp);
- getDoubleProperty(properties, "aug_number", E->control.augmented, fp);
-
- getIntProperty(properties, "remove_rigid_rotation", E->control.remove_rigid_rotation, fp);
-
- if(E->control.inv_gruneisen != 0) {
- /* which compressible solver to use: "cg" or "bicg" */
- getStringProperty(properties, "uzawa", E->control.uzawa, fp);
- if(strcmp(E->control.uzawa, "cg") == 0) {
- /* more convergence parameters for "cg" */
- getIntProperty(properties, "compress_iter_maxstep", E->control.compress_iter_maxstep, fp);
- }
- }
-
- PUTS(("\n"));
-
- Py_INCREF(Py_None);
- return Py_None;
-}
-
-
-
-
-/*==========================================================*/
-/* helper functions */
-
-FILE *get_output_stream(PyObject *out, struct All_variables*E)
-{
- if (PyFile_Check(out)) {
- return PyFile_AsFile(out);
- }
- return NULL;
-}
-
-
-int _getStringProperty(PyObject* properties, char* attribute,
- char* value, size_t valueSize, FILE* fp)
-{
- PyObject *prop;
- char *buffer;
- Py_ssize_t length;
-
- if (!(prop = PyObject_GetAttrString(properties, attribute)))
- return -1;
- if (-1 == PyString_AsStringAndSize(prop, &buffer, &length))
- return -1;
-
- if (length >= (Py_ssize_t)valueSize) {
- PyErr_Format(PyExc_ValueError,
- "value of '%s' cannot exceed %zu characters in length",
- attribute, valueSize);
- return -1;
- }
- strcpy(value, buffer);
-
- if (fp)
- fprintf(fp, "%s=%s\n", attribute, value);
-
- return 0;
-}
-
-
-#define getTYPEProperty _getIntProperty
-#define getTYPEVectorProperty _getIntVectorProperty
-#define PyTYPE_Check PyInt_Check
-#define CTYPE int
-#define PyTYPE_AsCTYPE PyInt_AsLong
-#define MESSAGE "an integer is required"
-#define FORMAT "%d"
-#include "getProperty.h"
-
-#undef getTYPEProperty
-#undef getTYPEVectorProperty
-#undef PyTYPE_Check
-#undef CTYPE
-#undef PyTYPE_AsCTYPE
-#undef MESSAGE
-#undef FORMAT
-
-#define getTYPEProperty _getFloatProperty
-#define getTYPEVectorProperty _getFloatVectorProperty
-#define PyTYPE_Check PyFloat_Check
-#define CTYPE float
-#define PyTYPE_AsCTYPE PyFloat_AsDouble
-#define MESSAGE "a float is required"
-#define FORMAT "%g"
-#include "getProperty.h"
-
-
-#undef getTYPEProperty
-#undef getTYPEVectorProperty
-#undef PyTYPE_Check
-#undef CTYPE
-#undef PyTYPE_AsCTYPE
-#undef MESSAGE
-#undef FORMAT
-
-#define getTYPEProperty _getDoubleProperty
-#define getTYPEVectorProperty _getDoubleVectorProperty
-#define PyTYPE_Check PyFloat_Check
-#define CTYPE double
-#define PyTYPE_AsCTYPE PyFloat_AsDouble
-#define MESSAGE "a float is required"
-#define FORMAT "%g"
-#include "getProperty.h"
-
-
-/* $Id$ */
-
-/* End of file */
Copied: mc/3D/CitcomS/branches/cxx/module/setProperties.cc (from rev 14029, mc/3D/CitcomS/trunk/module/setProperties.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/module/setProperties.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/module/setProperties.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,973 @@
+/*
+//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+//
+//<LicenseText>
+//
+// CitcomS.py by Eh Tan, Eun-seo Choi, and Pururav Thoutireddy.
+// Copyright (C) 2002-2005, California Institute of Technology.
+//
+// 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+//
+//</LicenseText>
+//
+//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+*/
+
+#include <Python.h>
+#include <stddef.h>
+#include <stdio.h>
+#include <string.h>
+#include <math.h>
+#include "global_defs.h"
+#include "parallel_related.h"
+#include "setProperties.h"
+
+
+/* See PEP 353. */
+#if PY_VERSION_HEX < 0x02050000 && !defined(PY_SSIZE_T_MIN)
+typedef int Py_ssize_t;
+#define PY_SSIZE_T_MAX INT_MAX
+#define PY_SSIZE_T_MIN INT_MIN
+#endif
+
+
+/*==============================================================*/
+/* functions and macros which fetch properties from 'inventory' */
+
+
+FILE *get_output_stream(PyObject *out, struct All_variables*E);
+#define PUTS(s) if (fp) fprintf(fp, s)
+
+int _getStringProperty(PyObject* properties, char* attribute,
+ char* value, size_t valueSize, FILE* fp);
+#define getStringProperty(p, a, v, o) if (-1 == _getStringProperty(p, a, v, sizeof(v), o)) return NULL
+
+int _getIntProperty(PyObject* properties, char* attribute, int *value, FILE* fp);
+#define getIntProperty(p, a, v, o) if (-1 == _getIntProperty(p, a, &(v), o)) return NULL
+
+int _getFloatProperty(PyObject* properties, char* attribute, float *value, FILE* fp);
+#define getFloatProperty(p, a, v, o) if (-1 == _getFloatProperty(p, a, &(v), o)) return NULL
+
+int _getDoubleProperty(PyObject* properties, char* attribute, double *value, FILE* fp);
+#define getDoubleProperty(p, a, v, o) if (-1 == _getDoubleProperty(p, a, &(v), o)) return NULL
+
+int _getIntVectorProperty(PyObject* properties, char* attribute,
+ int* vector, int len, FILE* fp);
+#define getIntVectorProperty(p, a, v, l, o) if (-1 == _getIntVectorProperty(p, a, v, l, o)) return NULL
+
+int _getFloatVectorProperty(PyObject* properties, char* attribute,
+ float* vector, int len, FILE* fp);
+#define getFloatVectorProperty(p, a, v, l, o) if (-1 == _getFloatVectorProperty(p, a, v, l, o)) return NULL
+
+int _getDoubleVectorProperty(PyObject* properties, char* attribute,
+ double* vector, int len, FILE* fp);
+#define getDoubleVectorProperty(p, a, v, l, o) if (-1 == _getDoubleVectorProperty(p, a, v, l, o)) return NULL
+
+
+void myerror(struct All_variables *,char *);
+void report(struct All_variables *,char *);
+
+/*==============================================================*/
+
+
+char pyCitcom_Advection_diffusion_set_properties__doc__[] = "";
+char pyCitcom_Advection_diffusion_set_properties__name__[] = "Advection_diffusion_set_properties";
+
+PyObject * pyCitcom_Advection_diffusion_set_properties(PyObject *self, PyObject *args)
+{
+ PyObject *obj, *properties, *out;
+ struct All_variables *E;
+ FILE *fp;
+
+ if (!PyArg_ParseTuple(args, "OOO:Advection_diffusion_set_properties",
+ &obj, &properties, &out))
+ return NULL;
+
+ E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
+ fp = get_output_stream(out, E);
+
+ PUTS(("[CitcomS.solver.tsolver]\n"));
+
+ getIntProperty(properties, "ADV", E->advection.ADVECTION, fp);
+ getIntProperty(properties, "filter_temp", E->advection.filter_temperature, fp);
+ getIntProperty(properties, "monitor_max_T", E->advection.monitor_max_T, fp);
+
+ getFloatProperty(properties, "finetunedt", E->advection.fine_tune_dt, fp);
+ getFloatProperty(properties, "fixed_timestep", E->advection.fixed_timestep, fp);
+ getFloatProperty(properties, "adv_gamma", E->advection.gamma, fp);
+ getIntProperty(properties, "adv_sub_iterations", E->advection.temp_iterations, fp);
+
+ getFloatProperty(properties, "inputdiffusivity", E->control.inputdiff, fp);
+
+
+ PUTS(("\n"));
+
+ Py_INCREF(Py_None);
+ return Py_None;
+
+}
+
+
+
+char pyCitcom_BC_set_properties__doc__[] = "";
+char pyCitcom_BC_set_properties__name__[] = "BC_set_properties";
+
+PyObject * pyCitcom_BC_set_properties(PyObject *self, PyObject *args)
+{
+ PyObject *obj, *properties, *out;
+ struct All_variables *E;
+ FILE *fp;
+
+ if (!PyArg_ParseTuple(args, "OOO:BC_set_properties",
+ &obj, &properties, &out))
+ return NULL;
+
+ E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
+ fp = get_output_stream(out, E);
+
+ PUTS(("[CitcomS.solver.bc]\n"));
+
+ getIntProperty(properties, "side_sbcs", E->control.side_sbcs, fp);
+ getIntProperty(properties, "pseudo_free_surf", E->control.pseudo_free_surf, fp);
+
+ getIntProperty(properties, "topvbc", E->mesh.topvbc, fp);
+ getFloatProperty(properties, "topvbxval", E->control.VBXtopval, fp);
+ getFloatProperty(properties, "topvbyval", E->control.VBYtopval, fp);
+
+ getIntProperty(properties, "botvbc", E->mesh.botvbc, fp);
+ getFloatProperty(properties, "botvbxval", E->control.VBXbotval, fp);
+ getFloatProperty(properties, "botvbyval", E->control.VBYbotval, fp);
+
+ getIntProperty(properties, "toptbc", E->mesh.toptbc, fp);
+ getFloatProperty(properties, "toptbcval", E->control.TBCtopval, fp);
+
+ getIntProperty(properties, "bottbc", E->mesh.bottbc, fp);
+ getFloatProperty(properties, "bottbcval", E->control.TBCbotval, fp);
+
+ getIntProperty(properties, "temperature_bound_adj", E->control.temperature_bound_adj, fp);
+ getFloatProperty(properties, "depth_bound_adj", E->control.depth_bound_adj, fp);
+ getFloatProperty(properties, "width_bound_adj", E->control.width_bound_adj, fp);
+
+
+ PUTS(("\n"));
+
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+
+
+char pyCitcom_Const_set_properties__doc__[] = "";
+char pyCitcom_Const_set_properties__name__[] = "Const_set_properties";
+
+PyObject * pyCitcom_Const_set_properties(PyObject *self, PyObject *args)
+{
+ PyObject *obj, *properties, *out;
+ struct All_variables *E;
+ FILE *fp;
+ float radius;
+
+ if (!PyArg_ParseTuple(args, "OOO:Const_set_properties",
+ &obj, &properties, &out))
+ return NULL;
+
+ E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
+ fp = get_output_stream(out, E);
+
+ PUTS(("[CitcomS.solver.const]\n"));
+
+ getFloatProperty(properties, "radius", radius, fp);
+ getFloatProperty(properties, "density", E->data.density, fp);
+ getFloatProperty(properties, "thermdiff", E->data.therm_diff, fp);
+ getFloatProperty(properties, "gravacc", E->data.grav_acc, fp);
+ getFloatProperty(properties, "thermexp", E->data.therm_exp, fp);
+ getFloatProperty(properties, "refvisc", E->data.ref_viscosity, fp);
+ getFloatProperty(properties, "cp", E->data.Cp, fp);
+ getFloatProperty(properties, "density_above", E->data.density_above, fp);
+ getFloatProperty(properties, "density_below", E->data.density_below, fp);
+
+ E->data.therm_cond = E->data.therm_diff * E->data.density * E->data.Cp;
+ E->data.ref_temperature = E->control.Atemp * E->data.therm_diff
+ * E->data.ref_viscosity / (radius * radius * radius)
+ / (E->data.density * E->data.grav_acc * E->data.therm_exp);
+
+ getFloatProperty(properties, "z_lith", E->viscosity.zlith, fp);
+ getFloatProperty(properties, "z_410", E->viscosity.z410, fp);
+ getFloatProperty(properties, "z_lmantle", E->viscosity.zlm, fp);
+ getFloatProperty(properties, "z_cmb", E->viscosity.zcmb, fp); /* this is used as the D" phase change depth */
+
+ E->viscosity.zbase_layer[0] = E->viscosity.zlith;
+ E->viscosity.zbase_layer[1] = E->viscosity.z410;
+ E->viscosity.zbase_layer[2] = E->viscosity.zlm;
+ E->viscosity.zbase_layer[3] = E->viscosity.zcmb;
+
+ /* convert meter to kilometer */
+ E->data.radius_km = radius / 1e3;
+
+ PUTS(("\n"));
+
+ Py_INCREF(Py_None);
+ return Py_None;
+
+}
+
+
+
+char pyCitcom_IC_set_properties__doc__[] = "";
+char pyCitcom_IC_set_properties__name__[] = "IC_set_properties";
+
+PyObject * pyCitcom_IC_set_properties(PyObject *self, PyObject *args)
+{
+ PyObject *obj, *properties, *out;
+ struct All_variables *E;
+ FILE *fp;
+ int num_perturb;
+
+ if (!PyArg_ParseTuple(args, "OOO:IC_set_properties",
+ &obj, &properties, &out))
+ return NULL;
+
+ E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
+ fp = get_output_stream(out, E);
+
+ PUTS(("[CitcomS.solver.ic]\n"));
+
+ getIntProperty(properties, "restart", E->control.restart, fp);
+ getIntProperty(properties, "post_p", E->control.post_p, fp);
+ getIntProperty(properties, "solution_cycles_init", E->monitor.solution_cycles_init, fp);
+ getIntProperty(properties, "zero_elapsed_time", E->control.zero_elapsed_time, fp);
+
+ getIntProperty(properties, "tic_method", E->convection.tic_method, fp);
+
+ getIntProperty(properties, "num_perturbations", num_perturb, fp);
+ if(num_perturb > PERTURB_MAX_LAYERS) {
+ fprintf(stderr, "'num_perturb' greater than allowed value, set to %d\n", PERTURB_MAX_LAYERS);
+ num_perturb = PERTURB_MAX_LAYERS;
+ }
+ E->convection.number_of_perturbations = num_perturb;
+
+ getIntVectorProperty(properties, "perturbl", E->convection.perturb_ll,
+ num_perturb, fp);
+ getIntVectorProperty(properties, "perturbm", E->convection.perturb_mm,
+ num_perturb, fp);
+ getIntVectorProperty(properties, "perturblayer", E->convection.load_depth,
+ num_perturb, fp);
+ getFloatVectorProperty(properties, "perturbmag", E->convection.perturb_mag,
+ num_perturb, fp);
+
+ getFloatProperty(properties, "half_space_age", E->convection.half_space_age, fp);
+ getFloatVectorProperty(properties, "blob_center", E->convection.blob_center, 3, fp);
+ if( E->convection.blob_center[0] == -999.0 && E->convection.blob_center[1] == -999.0 && E->convection.blob_center[2] == -999.0 ) {
+ E->convection.blob_center[0] = 0.5*(E->control.theta_min+E->control.theta_max);
+ E->convection.blob_center[1] = 0.5*(E->control.fi_min+E->control.fi_max);
+ E->convection.blob_center[2] = 0.5*(E->sphere.ri+E->sphere.ro);
+ }
+ getFloatProperty(properties, "blob_radius", E->convection.blob_radius, fp);
+ getFloatProperty(properties, "blob_dT", E->convection.blob_dT, fp);
+
+ PUTS(("\n"));
+
+ if (PyErr_Occurred())
+ return NULL;
+
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+
+
+char pyCitcom_Output_set_properties__doc__[] = "";
+char pyCitcom_Output_set_properties__name__[] = "Output_set_properties";
+
+PyObject * pyCitcom_Output_set_properties(PyObject *self, PyObject *args)
+{
+ PyObject *obj, *properties, *out;
+ struct All_variables *E;
+ FILE *fp;
+
+ if (!PyArg_ParseTuple(args, "OOO:Output_set_properties",
+ &obj, &properties, &out))
+ return NULL;
+
+ E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
+ fp = get_output_stream(out, E);
+
+ PUTS(("[CitcomS.solver.output]\n"));
+
+ getStringProperty(properties, "output_format", E->output.format, fp);
+ getStringProperty(properties, "output_optional", E->output.optional, fp);
+
+ getIntProperty(properties, "gzdir_vtkio", E->output.gzdir.vtk_io, fp);
+ getIntProperty(properties, "gzdir_rnr", E->output.gzdir.rnr, fp);
+ E->output.gzdir.vtk_base_init = 0;
+ /* should we save the basis vectors? (memory!) */
+ E->output.gzdir.vtk_base_save = 1;
+
+ getIntProperty(properties, "output_ll_max", E->output.llmax, fp);
+ getIntProperty(properties, "self_gravitation", E->control.self_gravitation, fp);
+ getIntProperty(properties, "use_cbf_topo", E->control.use_cbf_topo, fp);
+
+ getIntProperty(properties, "cb_block_size", E->output.cb_block_size, fp);
+ getIntProperty(properties, "cb_buffer_size", E->output.cb_buffer_size, fp);
+
+ getIntProperty(properties, "sieve_buf_size", E->output.sieve_buf_size, fp);
+
+ getIntProperty(properties, "output_alignment", E->output.alignment, fp);
+ getIntProperty(properties, "output_alignment_threshold", E->output.alignment_threshold, fp);
+
+ getIntProperty(properties, "cache_mdc_nelmts", E->output.cache_mdc_nelmts, fp);
+ getIntProperty(properties, "cache_rdcc_nelmts", E->output.cache_rdcc_nelmts, fp);
+ getIntProperty(properties, "cache_rdcc_nbytes", E->output.cache_rdcc_nbytes, fp);
+
+ PUTS(("\n"));
+
+ Py_INCREF(Py_None);
+ return Py_None;
+
+}
+
+
+
+char pyCitcom_Param_set_properties__doc__[] = "";
+char pyCitcom_Param_set_properties__name__[] = "Param_set_properties";
+
+PyObject * pyCitcom_Param_set_properties(PyObject *self, PyObject *args)
+{
+ PyObject *obj, *properties, *out;
+ struct All_variables *E;
+ FILE *fp;
+
+ if (!PyArg_ParseTuple(args, "OOO:Param_set_properties",
+ &obj, &properties, &out))
+ return NULL;
+
+ E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
+ fp = get_output_stream(out, E);
+
+ PUTS(("[CitcomS.solver.param]\n"));
+
+ getIntProperty(properties, "reference_state", E->refstate.choice, fp);
+ if(E->refstate.choice == 0) {
+ getStringProperty(properties, "refstate_file", E->refstate.filename, fp);
+ }
+
+ getIntProperty(properties, "file_vbcs", E->control.vbcs_file, fp);
+ getStringProperty(properties, "vel_bound_file", E->control.velocity_boundary_file, fp);
+
+ getIntProperty(properties, "file_tbcs", E->control.tbcs_file, fp);
+ getStringProperty(properties, "temp_bound_file", E->control.temperature_boundary_file, fp);
+
+ getIntProperty(properties, "mat_control", E->control.mat_control, fp);
+ getStringProperty(properties, "mat_file", E->control.mat_file, fp);
+
+ getIntProperty(properties, "lith_age", E->control.lith_age, fp);
+ getStringProperty(properties, "lith_age_file", E->control.lith_age_file, fp);
+ getIntProperty(properties, "lith_age_time", E->control.lith_age_time, fp);
+ getFloatProperty(properties, "lith_age_depth", E->control.lith_age_depth, fp);
+ getFloatProperty(properties, "mantle_temp", E->control.lith_age_mantle_temp, fp);
+
+ getFloatProperty(properties, "start_age", E->control.start_age, fp);
+ getIntProperty(properties, "reset_startage", E->control.reset_startage, fp);
+
+ PUTS(("\n"));
+
+ Py_INCREF(Py_None);
+ return Py_None;
+
+}
+
+
+
+char pyCitcom_Phase_set_properties__doc__[] = "";
+char pyCitcom_Phase_set_properties__name__[] = "Phase_set_properties";
+
+PyObject * pyCitcom_Phase_set_properties(PyObject *self, PyObject *args)
+{
+ PyObject *obj, *properties, *out;
+ struct All_variables *E;
+ FILE *fp;
+ float width;
+
+ if (!PyArg_ParseTuple(args, "OOO:Phase_set_properties",
+ &obj, &properties, &out))
+ return NULL;
+
+ E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
+ fp = get_output_stream(out, E);
+
+ PUTS(("[CitcomS.solver.phase]\n"));
+
+ getFloatProperty(properties, "Ra_410", E->control.Ra_410, fp);
+ getFloatProperty(properties, "clapeyron410", E->control.clapeyron410, fp);
+ getFloatProperty(properties, "transT410", E->control.transT410, fp);
+ getFloatProperty(properties, "width410", width, fp);
+
+ if (width!=0.0)
+ E->control.inv_width410 = 1.0 / width;
+
+ getFloatProperty(properties, "Ra_670", E->control.Ra_670 , fp);
+ getFloatProperty(properties, "clapeyron670", E->control.clapeyron670, fp);
+ getFloatProperty(properties, "transT670", E->control.transT670, fp);
+ getFloatProperty(properties, "width670", width, fp);
+
+ if (width!=0.0)
+ E->control.inv_width670 = 1.0 / width;
+
+ getFloatProperty(properties, "Ra_cmb", E->control.Ra_cmb, fp);
+ getFloatProperty(properties, "clapeyroncmb", E->control.clapeyroncmb, fp);
+ getFloatProperty(properties, "transTcmb", E->control.transTcmb, fp);
+ getFloatProperty(properties, "widthcmb", width, fp);
+
+ if (width!=0.0)
+ E->control.inv_widthcmb = 1.0 / width;
+
+ PUTS(("\n"));
+
+ Py_INCREF(Py_None);
+ return Py_None;
+
+}
+
+
+
+char pyCitcom_Solver_set_properties__doc__[] = "";
+char pyCitcom_Solver_set_properties__name__[] = "Solver_set_properties";
+
+PyObject * pyCitcom_Solver_set_properties(PyObject *self, PyObject *args)
+{
+ PyObject *obj, *properties, *out;
+ struct All_variables *E;
+ FILE *fp;
+ float tmp;
+
+ if (!PyArg_ParseTuple(args, "OOO:Solver_set_properties",
+ &obj, &properties, &out))
+ return NULL;
+
+ E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
+ fp = get_output_stream(out, E);
+
+ PUTS(("[CitcomS.solver]\n"));
+
+ getStringProperty(properties, "datadir", E->control.data_dir, fp);
+ getStringProperty(properties, "datafile", E->control.data_prefix, fp);
+ getStringProperty(properties, "datadir_old", E->control.data_dir_old, fp);
+ getStringProperty(properties, "datafile_old", E->control.data_prefix_old, fp);
+
+ getFloatProperty(properties, "rayleigh", E->control.Atemp, fp);
+ getFloatProperty(properties, "dissipation_number", E->control.disptn_number, fp);
+ getFloatProperty(properties, "gruneisen", tmp, fp);
+ /* special case: if tmp==0, set gruneisen as inf */
+ if(tmp != 0)
+ E->control.inv_gruneisen = 1/tmp;
+ else
+ E->control.inv_gruneisen = 0;
+
+ getFloatProperty(properties, "surfaceT", E->control.surface_temp, fp);
+ /*getFloatProperty(properties, "adiabaticT0", E->control.adiabaticT0, fp);*/
+ getFloatProperty(properties, "Q0", E->control.Q0, fp);
+
+ getIntProperty(properties, "stokes_flow_only", E->control.stokes, fp);
+
+ getIntProperty(properties, "verbose", E->control.verbose, fp);
+ getIntProperty(properties, "see_convergence", E->control.print_convergence, fp);
+
+ /* parameters not used in pyre version,
+ assigned value here to prevent uninitialized access */
+ E->advection.min_timesteps = 1;
+ E->advection.max_timesteps = 1;
+ E->advection.max_total_timesteps = 1;
+ E->control.checkpoint_frequency = 1;
+ E->control.record_every = 1;
+ E->control.record_all_until = 1;
+
+ PUTS(("\n"));
+
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+
+
+char pyCitcom_Sphere_set_properties__doc__[] = "";
+char pyCitcom_Sphere_set_properties__name__[] = "Sphere_set_properties";
+
+PyObject * pyCitcom_Sphere_set_properties(PyObject *self, PyObject *args)
+{
+ void full_set_3dsphere_defaults2(struct All_variables *);
+ void regional_set_3dsphere_defaults2(struct All_variables *);
+
+ PyObject *obj, *properties, *out;
+ struct All_variables *E;
+ FILE *fp;
+
+ if (!PyArg_ParseTuple(args, "OOO:Sphere_set_properties",
+ &obj, &properties, &out))
+ return NULL;
+
+ E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
+ fp = get_output_stream(out, E);
+
+ PUTS(("[CitcomS.solver.mesher]\n"));
+
+ getIntProperty(properties, "nproc_surf", E->parallel.nprocxy, fp);
+
+ getIntProperty(properties, "nprocx", E->parallel.nprocx, fp);
+ getIntProperty(properties, "nprocy", E->parallel.nprocy, fp);
+ getIntProperty(properties, "nprocz", E->parallel.nprocz, fp);
+
+ if (E->parallel.nprocxy == 12)
+ if (E->parallel.nprocx != E->parallel.nprocy) {
+ char errmsg[] = "!!!! nprocx must equal to nprocy";
+ PyErr_SetString(PyExc_SyntaxError, errmsg);
+ return NULL;
+ }
+
+ getIntProperty(properties, "coor", E->control.coor, fp);
+ getFloatVectorProperty(properties, "coor_refine", E->control.coor_refine, 4, fp);
+ getStringProperty(properties, "coor_file", E->control.coor_file, fp);
+
+ if ( strcmp(E->control.SOLVER_TYPE,"cgrad") == 0) {
+ getIntProperty(properties, "nodex", E->mesh.nox, fp);
+ getIntProperty(properties, "nodey", E->mesh.noy, fp);
+ getIntProperty(properties, "nodez", E->mesh.noz, fp);
+
+ E->mesh.mgunitx = E->mesh.nox - 1;
+ E->mesh.mgunity = E->mesh.noy - 1;
+ E->mesh.mgunitz = E->mesh.noz - 1;
+ E->mesh.levels = 1;
+ }
+ else {
+ double levmax;
+
+ getIntProperty(properties, "mgunitx", E->mesh.mgunitx, fp);
+ getIntProperty(properties, "mgunity", E->mesh.mgunity, fp);
+ getIntProperty(properties, "mgunitz", E->mesh.mgunitz, fp);
+ getIntProperty(properties, "levels", E->mesh.levels, fp);
+
+ levmax = E->mesh.levels - 1;
+ E->mesh.nox = E->mesh.mgunitx * (int) pow(2.0,levmax) * E->parallel.nprocx + 1;
+ E->mesh.noy = E->mesh.mgunity * (int) pow(2.0,levmax) * E->parallel.nprocy + 1;
+ E->mesh.noz = E->mesh.mgunitz * (int) pow(2.0,levmax) * E->parallel.nprocz + 1;
+ }
+
+ if (E->parallel.nprocxy == 12) {
+ if (E->mesh.nox != E->mesh.noy) {
+ char errmsg[] = "!!!! nodex must equal to nodey";
+ PyErr_SetString(PyExc_SyntaxError, errmsg);
+ return NULL;
+ }
+ }
+
+ getDoubleProperty(properties, "radius_outer", E->sphere.ro, fp);
+ getDoubleProperty(properties, "radius_inner", E->sphere.ri, fp);
+
+
+ if (E->parallel.nprocxy == 12) {
+ full_set_3dsphere_defaults2(E);
+ }
+ else {
+ getDoubleProperty(properties, "theta_min", E->control.theta_min, fp);
+ getDoubleProperty(properties, "theta_max", E->control.theta_max, fp);
+ getDoubleProperty(properties, "fi_min", E->control.fi_min, fp);
+ getDoubleProperty(properties, "fi_max", E->control.fi_max, fp);
+
+ regional_set_3dsphere_defaults2(E);
+ }
+
+ E->mesh.layer[1] = 1;
+ E->mesh.layer[2] = 1;
+ E->mesh.layer[3] = 1;
+
+ PUTS(("\n"));
+
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+
+
+char pyCitcom_Tracer_set_properties__doc__[] = "";
+char pyCitcom_Tracer_set_properties__name__[] = "Tracer_set_properties";
+
+PyObject * pyCitcom_Tracer_set_properties(PyObject *self, PyObject *args)
+{
+ PyObject *obj, *properties, *out;
+ struct All_variables *E;
+ FILE *fp;
+ double tmp;
+ char message[100];
+
+ if (!PyArg_ParseTuple(args, "OOO:Tracer_set_properties",
+ &obj, &properties, &out))
+ return NULL;
+
+ E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
+ fp = get_output_stream(out, E);
+
+ PUTS(("[CitcomS.solver.tracer]\n"));
+
+ getIntProperty(properties, "tracer", E->control.tracer, fp);
+
+ getIntProperty(properties, "tracer_enriched", E->control.tracer_enriched, fp);
+ if(E->control.tracer_enriched) {
+ if(!E->control.tracer)
+ myerror(E,"need to switch on tracers for tracer_enriched");
+
+ getFloatProperty(properties, "Q0_enriched", E->control.Q0ER, fp);
+ snprintf(message,100,"using compositionally enriched heating: C = 0: %g C = 1: %g (only one composition!)",
+ E->control.Q0,E->control.Q0ER);
+ report(E,message);
+ }
+
+ getIntProperty(properties, "tracer_ic_method",
+ E->trace.ic_method, fp);
+
+ if (E->trace.ic_method==0) {
+ getIntProperty(properties, "tracers_per_element",
+ E->trace.itperel, fp);
+ }
+ else if (E->trace.ic_method==1) {
+ getStringProperty(properties, "tracer_file",
+ E->trace.tracer_file, fp);
+ }
+ else if (E->trace.ic_method==2) {
+ }
+ else {
+ fprintf(stderr,"Sorry, tracer_ic_method only 0, 1 and 2 available\n");
+ fflush(stderr);
+ parallel_process_termination();
+ }
+
+ getIntProperty(properties, "tracer_flavors", E->trace.nflavors, fp);
+
+ getIntProperty(properties, "ic_method_for_flavors", E->trace.ic_method_for_flavors, fp);
+
+ if (E->trace.nflavors > 1) {
+ switch(E->trace.ic_method_for_flavors){
+ case 0: /* layer */
+ E->trace.z_interface = (double*) malloc((E->trace.nflavors-1)
+ *sizeof(double));
+
+ getDoubleVectorProperty(properties, "z_interface", E->trace.z_interface, E->trace.nflavors-1, fp);
+ break;
+ case 1: /* from grid in top n materials */
+ /* file from which to read */
+ getStringProperty(properties, "ictracer_grd_file", E->trace.ggrd_file, fp);
+ /* which top layers to use */
+ getIntProperty(properties, "ictracer_grd_layers", E->trace.ggrd_layers, fp);
+ break;
+ default:
+ fprintf(stderr,"ic_method_for_flavors %i undefined\n",E->trace.ic_method_for_flavors);
+ parallel_process_termination();
+ break;
+ }
+ }
+
+ getIntProperty(properties, "itracer_warnings", E->trace.itracer_warnings, fp);
+ getIntProperty(properties, "itracer_interpolate_fields", E->trace.itracer_interpolate_fields, fp);
+
+ getIntProperty(properties, "chemical_buoyancy",
+ E->composition.ichemical_buoyancy, fp);
+
+ if (E->control.tracer && E->composition.ichemical_buoyancy==1) {
+ getIntProperty(properties, "buoy_type", E->composition.ibuoy_type, fp);
+
+ if (E->composition.ibuoy_type==0)
+ E->composition.ncomp = E->trace.nflavors;
+ else if (E->composition.ibuoy_type==1)
+ E->composition.ncomp = E->trace.nflavors - 1;
+
+ E->composition.buoyancy_ratio = (double*) malloc(E->composition.ncomp
+ *sizeof(double));
+
+ getDoubleVectorProperty(properties, "buoyancy_ratio", E->composition.buoyancy_ratio, E->composition.ncomp, fp);
+ }
+
+
+ if(E->parallel.nprocxy == 12) {
+
+ getDoubleProperty(properties, "regular_grid_deltheta", tmp, fp);
+ E->trace.deltheta[0] = tmp;
+ getDoubleProperty(properties, "regular_grid_delphi", tmp, fp);
+ E->trace.delphi[0] = tmp;
+
+ E->trace.ianalytical_tracer_test = 0;
+ //getIntProperty(properties, "analytical_tracer_test", E->trace.ianalytical_tracer_test, fp);
+
+
+ E->composition.icompositional_rheology = 0;
+ /*
+ getIntProperty(properties, "compositional_rheology", E->composition.icompositional_rheology, fp);
+
+ if (E->composition.icompositional_rheology==1) {
+ getDoubleProperty(properties, "compositional_prefactor", E->composition.compositional_rheology_prefactor, fp);
+ }
+ */
+ }
+ PUTS(("\n"));
+
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+
+
+char pyCitcom_Visc_set_properties__doc__[] = "";
+char pyCitcom_Visc_set_properties__name__[] = "Visc_set_properties";
+
+PyObject * pyCitcom_Visc_set_properties(PyObject *self, PyObject *args)
+{
+ PyObject *obj, *properties, *out;
+ struct All_variables *E;
+ FILE *fp;
+ int num_mat, i;
+
+ if (!PyArg_ParseTuple(args, "OOO:Visc_set_properties",
+ &obj, &properties, &out))
+ return NULL;
+
+ E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
+ fp = get_output_stream(out, E);
+
+ PUTS(("[CitcomS.solver.visc]\n"));
+
+ getStringProperty(properties, "Viscosity", E->viscosity.STRUCTURE, fp);
+ if (strcmp(E->viscosity.STRUCTURE,"system") == 0)
+ E->viscosity.FROM_SYSTEM = 1;
+ else
+ E->viscosity.FROM_SYSTEM = 0;
+
+ getIntProperty(properties, "visc_smooth_method", E->viscosity.smooth_cycles, fp);
+ getIntProperty(properties, "VISC_UPDATE", E->viscosity.update_allowed, fp);
+
+#define MAX_MAT 40
+
+ getIntProperty(properties, "num_mat", num_mat, fp);
+ if(num_mat > MAX_MAT) {
+ /* max. allowed material types = 40 */
+ fprintf(stderr, "'num_mat' greater than allowed value, set to %d\n", MAX_MAT);
+ num_mat = MAX_MAT;
+ }
+ E->viscosity.num_mat = num_mat;
+
+ getFloatVectorProperty(properties, "visc0",
+ E->viscosity.N0, num_mat, fp);
+
+ getIntProperty(properties, "TDEPV", E->viscosity.TDEPV, fp);
+ getIntProperty(properties, "rheol", E->viscosity.RHEOL, fp);
+ getFloatVectorProperty(properties, "viscE",
+ E->viscosity.E, num_mat, fp);
+ getFloatVectorProperty(properties, "viscT",
+ E->viscosity.T, num_mat, fp);
+ getFloatVectorProperty(properties, "viscZ",
+ E->viscosity.Z, num_mat, fp);
+
+ getIntProperty(properties, "SDEPV", E->viscosity.SDEPV, fp);
+ getFloatVectorProperty(properties, "sdepv_expt",
+ E->viscosity.sdepv_expt, num_mat, fp);
+
+ getIntProperty(properties, "PDEPV", E->viscosity.PDEPV, fp);
+ if (E->viscosity.PDEPV) {
+ E->viscosity.pdepv_visited = 0;
+ getIntProperty(properties, "pdepv_eff", E->viscosity.pdepv_eff, fp);
+ getFloatVectorProperty(properties, "pdepv_a",
+ E->viscosity.pdepv_a, num_mat, fp);
+ getFloatVectorProperty(properties, "pdepv_b",
+ E->viscosity.pdepv_b, num_mat, fp);
+ getFloatVectorProperty(properties, "pdepv_y",
+ E->viscosity.pdepv_y, num_mat, fp);
+ getFloatProperty(properties, "pdepv_offset", E->viscosity.pdepv_offset, fp);
+ }
+ if(E->viscosity.PDEPV || E->viscosity.SDEPV)
+ getFloatProperty(properties, "sdepv_misfit", E->viscosity.sdepv_misfit, fp);
+
+ getIntProperty(properties, "CDEPV", E->viscosity.CDEPV, fp);
+ if(E->viscosity.CDEPV){ /* compositional viscosity */
+ if(!E->control.tracer)
+ myerror(E,"error: CDEPV requires tracers, but tracer is off");
+ if(E->trace.nflavors > 10)
+ myerror(E,"error: too many flavors for CDEPV");
+ /* read in flavor factors */
+ getFloatVectorProperty(properties, "cdepv_ff",
+ E->viscosity.cdepv_ff, E->trace.nflavors, fp);
+ /* and take the log because we're using a geometric avg */
+ for(i=0;i<E->trace.nflavors;i++)
+ E->viscosity.cdepv_ff[i] = log(E->viscosity.cdepv_ff[i]);
+ }
+
+ getIntProperty(properties, "low_visc_channel", E->viscosity.channel, fp);
+ getIntProperty(properties, "low_visc_wedge", E->viscosity.wedge, fp);
+
+ getFloatProperty(properties, "lv_min_radius", E->viscosity.lv_min_radius, fp);
+ getFloatProperty(properties, "lv_max_radius", E->viscosity.lv_max_radius, fp);
+ getFloatProperty(properties, "lv_channel_thickness", E->viscosity.lv_channel_thickness, fp);
+ getFloatProperty(properties, "lv_reduction", E->viscosity.lv_reduction, fp);
+
+ getIntProperty(properties, "VMIN", E->viscosity.MIN, fp);
+ getFloatProperty(properties, "visc_min", E->viscosity.min_value, fp);
+
+ getIntProperty(properties, "VMAX", E->viscosity.MAX, fp);
+ getFloatProperty(properties, "visc_max", E->viscosity.max_value, fp);
+
+ PUTS(("\n"));
+
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+
+char pyCitcom_Incompressible_set_properties__doc__[] = "";
+char pyCitcom_Incompressible_set_properties__name__[] = "Incompressible_set_properties";
+
+PyObject * pyCitcom_Incompressible_set_properties(PyObject *self, PyObject *args)
+{
+ PyObject *obj, *properties, *out;
+ struct All_variables *E;
+ FILE *fp;
+
+ if (!PyArg_ParseTuple(args, "OOO:Incompressible_set_properties",
+ &obj, &properties, &out))
+ return NULL;
+
+ E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
+ fp = get_output_stream(out, E);
+
+ PUTS(("[CitcomS.solver.vsolver]\n"));
+
+ getStringProperty(properties, "Solver", E->control.SOLVER_TYPE, fp);
+ getIntProperty(properties, "node_assemble", E->control.NASSEMBLE, fp);
+ getIntProperty(properties, "precond", E->control.precondition, fp);
+
+ getDoubleProperty(properties, "accuracy", E->control.accuracy, fp);
+
+ getIntProperty(properties, "mg_cycle", E->control.mg_cycle, fp);
+ getIntProperty(properties, "down_heavy", E->control.down_heavy, fp);
+ getIntProperty(properties, "up_heavy", E->control.up_heavy, fp);
+
+ getIntProperty(properties, "vlowstep", E->control.v_steps_low, fp);
+ getIntProperty(properties, "vhighstep", E->control.v_steps_high, fp);
+ getIntProperty(properties, "piterations", E->control.p_iterations, fp);
+
+ getIntProperty(properties, "aug_lagr", E->control.augmented_Lagr, fp);
+ getDoubleProperty(properties, "aug_number", E->control.augmented, fp);
+
+ getIntProperty(properties, "remove_rigid_rotation", E->control.remove_rigid_rotation, fp);
+
+ if(E->control.inv_gruneisen != 0) {
+ /* which compressible solver to use: "cg" or "bicg" */
+ getStringProperty(properties, "uzawa", E->control.uzawa, fp);
+ if(strcmp(E->control.uzawa, "cg") == 0) {
+ /* more convergence parameters for "cg" */
+ getIntProperty(properties, "compress_iter_maxstep", E->control.compress_iter_maxstep, fp);
+ }
+ }
+
+ PUTS(("\n"));
+
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+
+
+
+/*==========================================================*/
+/* helper functions */
+
+FILE *get_output_stream(PyObject *out, struct All_variables*E)
+{
+ if (PyFile_Check(out)) {
+ return PyFile_AsFile(out);
+ }
+ return NULL;
+}
+
+
+int _getStringProperty(PyObject* properties, char* attribute,
+ char* value, size_t valueSize, FILE* fp)
+{
+ PyObject *prop;
+ char *buffer;
+ Py_ssize_t length;
+
+ if (!(prop = PyObject_GetAttrString(properties, attribute)))
+ return -1;
+ if (-1 == PyString_AsStringAndSize(prop, &buffer, &length))
+ return -1;
+
+ if (length >= (Py_ssize_t)valueSize) {
+ PyErr_Format(PyExc_ValueError,
+ "value of '%s' cannot exceed %zu characters in length",
+ attribute, valueSize);
+ return -1;
+ }
+ strcpy(value, buffer);
+
+ if (fp)
+ fprintf(fp, "%s=%s\n", attribute, value);
+
+ return 0;
+}
+
+
+#define getTYPEProperty _getIntProperty
+#define getTYPEVectorProperty _getIntVectorProperty
+#define PyTYPE_Check PyInt_Check
+#define CTYPE int
+#define PyTYPE_AsCTYPE PyInt_AsLong
+#define MESSAGE "an integer is required"
+#define FORMAT "%d"
+#include "getProperty.h"
+
+#undef getTYPEProperty
+#undef getTYPEVectorProperty
+#undef PyTYPE_Check
+#undef CTYPE
+#undef PyTYPE_AsCTYPE
+#undef MESSAGE
+#undef FORMAT
+
+#define getTYPEProperty _getFloatProperty
+#define getTYPEVectorProperty _getFloatVectorProperty
+#define PyTYPE_Check PyFloat_Check
+#define CTYPE float
+#define PyTYPE_AsCTYPE PyFloat_AsDouble
+#define MESSAGE "a float is required"
+#define FORMAT "%g"
+#include "getProperty.h"
+
+
+#undef getTYPEProperty
+#undef getTYPEVectorProperty
+#undef PyTYPE_Check
+#undef CTYPE
+#undef PyTYPE_AsCTYPE
+#undef MESSAGE
+#undef FORMAT
+
+#define getTYPEProperty _getDoubleProperty
+#define getTYPEVectorProperty _getDoubleVectorProperty
+#define PyTYPE_Check PyFloat_Check
+#define CTYPE double
+#define PyTYPE_AsCTYPE PyFloat_AsDouble
+#define MESSAGE "a float is required"
+#define FORMAT "%g"
+#include "getProperty.h"
+
+
+/* $Id$ */
+
+/* End of file */
Deleted: mc/3D/CitcomS/branches/cxx/module/stokes_solver.c
===================================================================
--- mc/3D/CitcomS/trunk/module/stokes_solver.c 2009-02-13 01:02:54 UTC (rev 14044)
+++ mc/3D/CitcomS/branches/cxx/module/stokes_solver.c 2009-02-13 03:39:35 UTC (rev 14045)
@@ -1,290 +0,0 @@
-/*
-//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-//
-//<LicenseText>
-//
-// CitcomS.py by Eh Tan, Eun-seo Choi, and Pururav Thoutireddy.
-// Copyright (C) 2002-2005, California Institute of Technology.
-//
-// 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-//
-//</LicenseText>
-//
-//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-*/
-
-#include <Python.h>
-
-
-#include "exceptions.h"
-#include "stokes_solver.h"
-
-#include "global_defs.h"
-#include "drive_solvers.h"
-
-
-void assemble_forces(struct All_variables*, int);
-void construct_stiffness_B_matrix(struct All_variables*);
-void general_stokes_solver(struct All_variables *);
-void general_stokes_solver_setup(struct All_variables*);
-void get_system_viscosity(struct All_variables*, int, float**, float**);
-void set_cg_defaults(struct All_variables*);
-void set_mg_defaults(struct All_variables*);
-void solve_constrained_flow_iterative(struct All_variables*);
-
-void assemble_forces_pseudo_surf(struct All_variables*, int);
-void general_stokes_solver_pseudo_surf(struct All_variables *);
-void solve_constrained_flow_iterative_pseudo_surf(struct All_variables*);
-
-
-
-char pyCitcom_assemble_forces__doc__[] = "";
-char pyCitcom_assemble_forces__name__[] = "assemble_forces";
-
-PyObject * pyCitcom_assemble_forces(PyObject *self, PyObject *args)
-{
- PyObject *obj;
- struct All_variables* E;
-
- if (!PyArg_ParseTuple(args, "O:assemble_forces", &obj))
- return NULL;
-
- E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
-
- assemble_forces(E,0);
-
- Py_INCREF(Py_None);
- return Py_None;
-}
-
-
-char pyCitcom_assemble_forces_pseudo_surf__doc__[] = "";
-char pyCitcom_assemble_forces_pseudo_surf__name__[] = "assemble_forces_pseudo_surf";
-
-PyObject * pyCitcom_assemble_forces_pseudo_surf(PyObject *self, PyObject *args)
-{
- PyObject *obj;
- struct All_variables* E;
-
- if (!PyArg_ParseTuple(args, "O:assemble_forces_pseudo_surf", &obj))
- return NULL;
-
- E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
-
- assemble_forces_pseudo_surf(E,0);
-
- Py_INCREF(Py_None);
- return Py_None;
-}
-
-
-char pyCitcom_construct_stiffness_B_matrix__doc__[] = "";
-char pyCitcom_construct_stiffness_B_matrix__name__[] = "construct_stiffness_B_matrix";
-
-PyObject * pyCitcom_construct_stiffness_B_matrix(PyObject *self, PyObject *args)
-{
- PyObject *obj;
- struct All_variables* E;
-
- if (!PyArg_ParseTuple(args, "O:construct_stiffness_B_matrix", &obj))
- return NULL;
-
- E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
-
- construct_stiffness_B_matrix(E);
-
- Py_INCREF(Py_None);
- return Py_None;
-}
-
-
-
-char pyCitcom_general_stokes_solver__doc__[] = "";
-char pyCitcom_general_stokes_solver__name__[] = "general_stokes_solver";
-
-PyObject * pyCitcom_general_stokes_solver(PyObject *self, PyObject *args)
-{
- PyObject *obj;
- struct All_variables* E;
-
- if (!PyArg_ParseTuple(args, "O:general_stokes_solver", &obj))
- return NULL;
-
- E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
-
- if(E->control.pseudo_free_surf)
- if(E->mesh.topvbc==2)
- general_stokes_solver_pseudo_surf(E);
- else
- assert(0);
- else
- general_stokes_solver(E);
-
-
-
- Py_INCREF(Py_None);
- return Py_None;
-}
-
-
-char pyCitcom_general_stokes_solver_setup__doc__[] = "";
-char pyCitcom_general_stokes_solver_setup__name__[] = "general_stokes_solver_setup";
-
-PyObject * pyCitcom_general_stokes_solver_setup(PyObject *self, PyObject *args)
-{
- PyObject *obj;
- struct All_variables* E;
-
- if (!PyArg_ParseTuple(args, "O:general_stokes_solver_setup", &obj))
- return NULL;
-
- E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
-
- general_stokes_solver_setup(E);
-
- Py_INCREF(Py_None);
- return Py_None;
-}
-
-
-
-char pyCitcom_get_system_viscosity__doc__[] = "";
-char pyCitcom_get_system_viscosity__name__[] = "get_system_viscosity";
-
-PyObject * pyCitcom_get_system_viscosity(PyObject *self, PyObject *args)
-{
- PyObject *obj;
- struct All_variables* E;
-
- if (!PyArg_ParseTuple(args, "O:get_system_viscosity", &obj))
- return NULL;
-
- E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
-
- get_system_viscosity(E,1,E->EVI[E->mesh.levmax],E->VI[E->mesh.levmax]);
-
- Py_INCREF(Py_None);
- return Py_None;
-}
-
-
-
-char pyCitcom_set_cg_defaults__doc__[] = "";
-char pyCitcom_set_cg_defaults__name__[] = "set_cg_defaults";
-
-PyObject * pyCitcom_set_cg_defaults(PyObject *self, PyObject *args)
-{
- PyObject *obj;
- struct All_variables* E;
-
- if (!PyArg_ParseTuple(args, "O:set_cg_defaults", &obj))
- return NULL;
-
- E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
-
- E->control.CONJ_GRAD = 1;
- set_cg_defaults(E);
-
- Py_INCREF(Py_None);
- return Py_None;
-}
-
-
-
-char pyCitcom_set_mg_defaults__doc__[] = "";
-char pyCitcom_set_mg_defaults__name__[] = "set_mg_defaults";
-
-PyObject * pyCitcom_set_mg_defaults(PyObject *self, PyObject *args)
-{
- PyObject *obj;
- struct All_variables* E;
-
- if (!PyArg_ParseTuple(args, "O:set_mg_defaults", &obj))
- return NULL;
-
- E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
-
- E->control.NMULTIGRID = 1;
- set_mg_defaults(E);
-
- Py_INCREF(Py_None);
- return Py_None;
-}
-
-
-
-char pyCitcom_set_mg_el_defaults__doc__[] = "";
-char pyCitcom_set_mg_el_defaults__name__[] = "set_mg_el_defaults";
-
-PyObject * pyCitcom_set_mg_el_defaults(PyObject *self, PyObject *args)
-{
- PyObject *obj;
- struct All_variables* E;
-
- if (!PyArg_ParseTuple(args, "O:set_mg_el_defaults", &obj))
- return NULL;
-
- E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
-
- E->control.EMULTIGRID = 1;
- set_mg_defaults(E);
-
- Py_INCREF(Py_None);
- return Py_None;
-}
-
-
-
-char pyCitcom_solve_constrained_flow_iterative__doc__[] = "";
-char pyCitcom_solve_constrained_flow_iterative__name__[] = "solve_constrained_flow_iterative";
-
-PyObject * pyCitcom_solve_constrained_flow_iterative(PyObject *self, PyObject *args)
-{
- PyObject *obj;
- struct All_variables* E;
-
- if (!PyArg_ParseTuple(args, "O:solve_constrained_flow_iterative", &obj))
- return NULL;
-
- E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
-
- solve_constrained_flow_iterative(E);
-
- return Py_BuildValue("d", E->viscosity.sdepv_misfit);
-}
-
-
-char pyCitcom_solve_constrained_flow_iterative_pseudo_surf__doc__[] = "";
-char pyCitcom_solve_constrained_flow_iterative_pseudo_surf__name__[] = "solve_constrained_flow_iterative_pseudo_surf";
-
-PyObject * pyCitcom_solve_constrained_flow_iterative_pseudo_surf(PyObject *self, PyObject *args)
-{
- PyObject *obj;
- struct All_variables* E;
-
- if (!PyArg_ParseTuple(args, "O:solve_constrained_flow_iterative_pseudo_surf", &obj))
- return NULL;
-
- E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
-
- solve_constrained_flow_iterative_pseudo_surf(E);
-
- return Py_BuildValue("d", E->viscosity.sdepv_misfit);
-}
-
-
-/* $Id$ */
-
-/* End of file */
Copied: mc/3D/CitcomS/branches/cxx/module/stokes_solver.cc (from rev 14029, mc/3D/CitcomS/trunk/module/stokes_solver.c)
===================================================================
--- mc/3D/CitcomS/branches/cxx/module/stokes_solver.cc (rev 0)
+++ mc/3D/CitcomS/branches/cxx/module/stokes_solver.cc 2009-02-13 03:39:35 UTC (rev 14045)
@@ -0,0 +1,290 @@
+/*
+//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+//
+//<LicenseText>
+//
+// CitcomS.py by Eh Tan, Eun-seo Choi, and Pururav Thoutireddy.
+// Copyright (C) 2002-2005, California Institute of Technology.
+//
+// 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+//
+//</LicenseText>
+//
+//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+*/
+
+#include <Python.h>
+
+
+#include "exceptions.h"
+#include "stokes_solver.h"
+
+#include "global_defs.h"
+#include "drive_solvers.h"
+
+
+void assemble_forces(struct All_variables*, int);
+void construct_stiffness_B_matrix(struct All_variables*);
+void general_stokes_solver(struct All_variables *);
+void general_stokes_solver_setup(struct All_variables*);
+void get_system_viscosity(struct All_variables*, int, float**, float**);
+void set_cg_defaults(struct All_variables*);
+void set_mg_defaults(struct All_variables*);
+void solve_constrained_flow_iterative(struct All_variables*);
+
+void assemble_forces_pseudo_surf(struct All_variables*, int);
+void general_stokes_solver_pseudo_surf(struct All_variables *);
+void solve_constrained_flow_iterative_pseudo_surf(struct All_variables*);
+
+
+
+char pyCitcom_assemble_forces__doc__[] = "";
+char pyCitcom_assemble_forces__name__[] = "assemble_forces";
+
+PyObject * pyCitcom_assemble_forces(PyObject *self, PyObject *args)
+{
+ PyObject *obj;
+ struct All_variables* E;
+
+ if (!PyArg_ParseTuple(args, "O:assemble_forces", &obj))
+ return NULL;
+
+ E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
+
+ assemble_forces(E,0);
+
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+
+char pyCitcom_assemble_forces_pseudo_surf__doc__[] = "";
+char pyCitcom_assemble_forces_pseudo_surf__name__[] = "assemble_forces_pseudo_surf";
+
+PyObject * pyCitcom_assemble_forces_pseudo_surf(PyObject *self, PyObject *args)
+{
+ PyObject *obj;
+ struct All_variables* E;
+
+ if (!PyArg_ParseTuple(args, "O:assemble_forces_pseudo_surf", &obj))
+ return NULL;
+
+ E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
+
+ assemble_forces_pseudo_surf(E,0);
+
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+
+char pyCitcom_construct_stiffness_B_matrix__doc__[] = "";
+char pyCitcom_construct_stiffness_B_matrix__name__[] = "construct_stiffness_B_matrix";
+
+PyObject * pyCitcom_construct_stiffness_B_matrix(PyObject *self, PyObject *args)
+{
+ PyObject *obj;
+ struct All_variables* E;
+
+ if (!PyArg_ParseTuple(args, "O:construct_stiffness_B_matrix", &obj))
+ return NULL;
+
+ E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
+
+ construct_stiffness_B_matrix(E);
+
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+
+
+char pyCitcom_general_stokes_solver__doc__[] = "";
+char pyCitcom_general_stokes_solver__name__[] = "general_stokes_solver";
+
+PyObject * pyCitcom_general_stokes_solver(PyObject *self, PyObject *args)
+{
+ PyObject *obj;
+ struct All_variables* E;
+
+ if (!PyArg_ParseTuple(args, "O:general_stokes_solver", &obj))
+ return NULL;
+
+ E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
+
+ if(E->control.pseudo_free_surf)
+ if(E->mesh.topvbc==2)
+ general_stokes_solver_pseudo_surf(E);
+ else
+ assert(0);
+ else
+ general_stokes_solver(E);
+
+
+
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+
+char pyCitcom_general_stokes_solver_setup__doc__[] = "";
+char pyCitcom_general_stokes_solver_setup__name__[] = "general_stokes_solver_setup";
+
+PyObject * pyCitcom_general_stokes_solver_setup(PyObject *self, PyObject *args)
+{
+ PyObject *obj;
+ struct All_variables* E;
+
+ if (!PyArg_ParseTuple(args, "O:general_stokes_solver_setup", &obj))
+ return NULL;
+
+ E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
+
+ general_stokes_solver_setup(E);
+
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+
+
+char pyCitcom_get_system_viscosity__doc__[] = "";
+char pyCitcom_get_system_viscosity__name__[] = "get_system_viscosity";
+
+PyObject * pyCitcom_get_system_viscosity(PyObject *self, PyObject *args)
+{
+ PyObject *obj;
+ struct All_variables* E;
+
+ if (!PyArg_ParseTuple(args, "O:get_system_viscosity", &obj))
+ return NULL;
+
+ E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
+
+ get_system_viscosity(E,1,E->EVI[E->mesh.levmax],E->VI[E->mesh.levmax]);
+
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+
+
+char pyCitcom_set_cg_defaults__doc__[] = "";
+char pyCitcom_set_cg_defaults__name__[] = "set_cg_defaults";
+
+PyObject * pyCitcom_set_cg_defaults(PyObject *self, PyObject *args)
+{
+ PyObject *obj;
+ struct All_variables* E;
+
+ if (!PyArg_ParseTuple(args, "O:set_cg_defaults", &obj))
+ return NULL;
+
+ E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
+
+ E->control.CONJ_GRAD = 1;
+ set_cg_defaults(E);
+
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+
+
+char pyCitcom_set_mg_defaults__doc__[] = "";
+char pyCitcom_set_mg_defaults__name__[] = "set_mg_defaults";
+
+PyObject * pyCitcom_set_mg_defaults(PyObject *self, PyObject *args)
+{
+ PyObject *obj;
+ struct All_variables* E;
+
+ if (!PyArg_ParseTuple(args, "O:set_mg_defaults", &obj))
+ return NULL;
+
+ E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
+
+ E->control.NMULTIGRID = 1;
+ set_mg_defaults(E);
+
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+
+
+char pyCitcom_set_mg_el_defaults__doc__[] = "";
+char pyCitcom_set_mg_el_defaults__name__[] = "set_mg_el_defaults";
+
+PyObject * pyCitcom_set_mg_el_defaults(PyObject *self, PyObject *args)
+{
+ PyObject *obj;
+ struct All_variables* E;
+
+ if (!PyArg_ParseTuple(args, "O:set_mg_el_defaults", &obj))
+ return NULL;
+
+ E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
+
+ E->control.EMULTIGRID = 1;
+ set_mg_defaults(E);
+
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+
+
+char pyCitcom_solve_constrained_flow_iterative__doc__[] = "";
+char pyCitcom_solve_constrained_flow_iterative__name__[] = "solve_constrained_flow_iterative";
+
+PyObject * pyCitcom_solve_constrained_flow_iterative(PyObject *self, PyObject *args)
+{
+ PyObject *obj;
+ struct All_variables* E;
+
+ if (!PyArg_ParseTuple(args, "O:solve_constrained_flow_iterative", &obj))
+ return NULL;
+
+ E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
+
+ solve_constrained_flow_iterative(E);
+
+ return Py_BuildValue("d", E->viscosity.sdepv_misfit);
+}
+
+
+char pyCitcom_solve_constrained_flow_iterative_pseudo_surf__doc__[] = "";
+char pyCitcom_solve_constrained_flow_iterative_pseudo_surf__name__[] = "solve_constrained_flow_iterative_pseudo_surf";
+
+PyObject * pyCitcom_solve_constrained_flow_iterative_pseudo_surf(PyObject *self, PyObject *args)
+{
+ PyObject *obj;
+ struct All_variables* E;
+
+ if (!PyArg_ParseTuple(args, "O:solve_constrained_flow_iterative_pseudo_surf", &obj))
+ return NULL;
+
+ E = (struct All_variables*)(PyCObject_AsVoidPtr(obj));
+
+ solve_constrained_flow_iterative_pseudo_surf(E);
+
+ return Py_BuildValue("d", E->viscosity.sdepv_misfit);
+}
+
+
+/* $Id$ */
+
+/* End of file */
More information about the CIG-COMMITS
mailing list