Merge lp:~fluidity-core/fluidity/gmsh-on-sphere into lp:fluidity

Proposed by Stephan Kramer
Status: Merged
Merged at revision: 3987
Proposed branch: lp:~fluidity-core/fluidity/gmsh-on-sphere
Merge into: lp:fluidity
Diff against target: 2135 lines (+909/-760)
17 files modified
assemble/Adapt_State.F90 (+4/-5)
assemble/Adapt_State_Prescribed.F90 (+2/-2)
assemble/tests/test_empty_populate_state.F90 (+1/-0)
femtools/Checkpoint.F90 (+12/-12)
femtools/Mesh_Files.F90 (+20/-215)
femtools/Read_GMSH.F90 (+97/-290)
femtools/Read_Triangle.F90 (+1/-163)
preprocessor/Populate_State.F90 (+86/-61)
tests/spherical_patch/Makefile (+11/-0)
tests/spherical_patch/spherical_patch.xml (+47/-0)
tests/spherical_patch/spherical_segment.flml (+502/-0)
tests/spherical_patch/src/spherical_segment.geo (+113/-0)
tools/Checkmesh.F90 (+2/-2)
tools/Fladapt.F90 (+4/-4)
tools/periodise.F90 (+3/-2)
tools/project_to_continuous.F90 (+2/-2)
tools/test_laplacian.F90 (+2/-2)
To merge this branch: bzr merge lp:~fluidity-core/fluidity/gmsh-on-sphere
Reviewer Review Type Date Requested Status
Jon Hill Approve
Review via email: mp+99395@code.launchpad.net

Description of the change

This merge fixes the reading of gmsh input meshes in fluidity, where the input mesh is 2d spherical, to be extruded inside fluidity to a 3d mesh. Because this mesh is 2d topologically but has 3d coordinates, this was not supported/broken. The functionality is now tested (first short "on_sphere" test) together with gmsh writing, parallel, checkpointing and flredecomp for this type of mesh.

Some more details of changes in Read_GMSH.F90:
- prevent reading of the gmsh file twice. This was because read_gmsh_simple() called identify_gmsh_file() to establish various dimensions, which it can only do by reading the entire file. Then an appropriate shape functon was allocated and read_gmsh_to_field was called which read the file again.
- only one version of read_gmsh_files to remain is the _simple version (as this was the only one in use). It
first reads in all the data, then establishes the necessary dimensions and then allocates the appropriate femtools
objects.
- the dimension of the read gmsh mesh is now established from the topology of the mesh, basically looking at the
highest dimension elements present, i.e. if there's tets or hexes it's 3d, otherwise 2d (1d gmsh reading is and remains untested). Previously this was done by looking at the z coordinate and seeing if it was small using some hard-coded definition of small=1e-9 (units?!).
- the dimension of the coordinate field that is returned (X%dim) is in most cases chosen to be the same as
the topological dimension. Only with the /geometry/spherical_earth option this is always 3 so that a 2d spherical
horizontal mesh (to be extruded inside fluidity) can be read. This was broken before. The other codes that use
embedded meshes (shallow water) use a specific option that only works for triangle, so that functionality should
remain unchanged.
- remove identify_gmsh_files()
- because of this remove identify_mesh_files() from the mesh_files module
- in all subroutines of the mesh_files module make format a required argument. Before, if the argument was not present a "guess" would be made. In some tools where no option tree is present (e.g. test_laplacian) this would always default to "triangle". These therefore now directly call read_triangle_files. In all other cases the format should be worked out. For output this can be a bit tricky. For checkpointing the same logic is followed as before (look at the option under the external mesh). For adaptivity debugging meshes it now always uses gmsh.
- identify_mesh_files() was only used in populate_state, in the case of inactive process (flredecomp from less
to more processes), where inactive processed needed to know the dimensions of the mesh. This is now communicated
via a MPI_Bcast()

To post a comment you must log in.
3955. By Stephan Kramer

Fix for silly unittest.

Revision history for this message
Jon Hill (jon-hill) wrote :

Code looks good at a quick eyeball.

Build queue is showing red:

unittests:
    Warnings: 1; tests = ['./test_empty_populate_state']
    Failures: 1; tests = ['./test_empty_populate_state']

Medium tests:
Summary of test problems with failures or warnings:
fladapt.xml: F

Any ideas?

Revision history for this message
Lawrence Mitchell (wence) wrote :

The fladapt issue is a real one, but it is generally applicable to all branches, rather than just this one I think. The error (with --enable-debugging) is something like:

Fortran runtime error: Actual string length is shorter than the declared one for dummy argument 'input' (-2123626932/7)

Here's a simplified test of the problematic code:

$ cat > foo.cpp <<\EOF
extern "C" {
#define F77_FUNC(name,NAME) name ## _
#define foo F77_FUNC(foo, FOO)
    void foo(const char *in, const int *len);
}

#include <iostream>
#include <stdlib.h>

using namespace std;
int main(int argc, char **argv)
{
    string in = "fladapt";
    int len = in.size();
    foo(in.c_str(), &len);
    return 0;
}
EOF

$ cat > foo.f90 <<\EOF
subroutine foo(input, length)
  integer, intent(in) :: length
  character(len = length), intent(in) :: input

  write(*,*)input
end subroutine foo
EOF

$ g++ -fbounds-check -O0 -g -c -o foo_main.o foo.cpp
$ gfortran -fbounds-check -O0 -g -c -o foo.o foo.f90
$ g++ -o foo -O0 -g foo.o foo_main.o -lgfortran
$ gdb ./foo
(gdb) r
Starting program: /home/lmitche4/tmp/foo
At line 1 of file foo.f90
Fortran runtime error: Actual string length is shorter than the declared one for dummy argument 'input' (-8200/7)

Program exited with code 02.
(gdb)

I think TRTD is either specified fixed length strings, or use iso_c_binding appropriately as is done in petsc_readnsolve. I think this is necessary for the majority of C++ main tools in tools/

Revision history for this message
Jon Hill (jon-hill) wrote :

I fixed a bunch of these a while back. Looks like there's a bunch more to fix...

Will add a bug report and set-up a branch

Revision history for this message
Stephan Kramer (s-kramer) wrote :

The unittest was already fixed in 3955. Just hasn't run again after that.

Revision history for this message
Jon Hill (jon-hill) wrote :

Just kicked the buildbot for this to check for greenness and will then approve.

3956. By Jon Hill

Merge from trunk, only 1 conflict

Revision history for this message
Stephan Kramer (s-kramer) wrote :

Fladapt was fixed by Jon Hill in the trunk and merged in above. Will merge in again from trunk and restart the buildbot queue.

3957. By Stephan Kramer

Merging in from trunk.

Revision history for this message
Stephan Kramer (s-kramer) wrote :

Ah, the fladapt failure actually didn't have anything to do with fortran/c binding issues, but was simply caused by my own stupidity. Fix is on the way.

3958. By Stephan Kramer

Not a good idea to nullify a pointer just before trying to access its pointee.

Revision history for this message
Jon Hill (jon-hill) wrote :

Kicking buildbot again to test fix

Revision history for this message
Jon Hill (jon-hill) wrote :

Green. Approve.

review: Approve

Preview Diff

[H/L] Next/Prev Comment, [J/K] Next/Prev File, [N/P] Next/Prev Hunk
=== modified file 'assemble/Adapt_State.F90'
--- assemble/Adapt_State.F90 2012-04-16 12:54:50 +0000
+++ assemble/Adapt_State.F90 2012-05-16 11:01:22 +0000
@@ -73,13 +73,12 @@
73 use diagnostic_variables73 use diagnostic_variables
74 use diagnostic_fields_wrapper_new, only : calculate_diagnostic_variables_new => calculate_diagnostic_variables74 use diagnostic_fields_wrapper_new, only : calculate_diagnostic_variables_new => calculate_diagnostic_variables
75 use pickers75 use pickers
76 use write_gmsh
76#ifdef HAVE_ZOLTAN77#ifdef HAVE_ZOLTAN
77 use zoltan_integration78 use zoltan_integration
78 use mpi_interfaces79 use mpi_interfaces
79#endif80#endif
8081
81 use mesh_files
82
83 implicit none82 implicit none
8483
85 private84 private
@@ -923,10 +922,10 @@
923 output_positions => extract_vector_field(states(1), "Coordinate")922 output_positions => extract_vector_field(states(1), "Coordinate")
924923
925 if(isparallel()) then924 if(isparallel()) then
926 call write_mesh_files(parallel_filename("first_timestep_adapted_mesh"), output_positions)925 call write_gmsh_file(parallel_filename("first_timestep_adapted_mesh"), output_positions)
927 call write_halos("first_timestep_adapted_mesh", output_positions%mesh)926 call write_halos("first_timestep_adapted_mesh", output_positions%mesh)
928 else927 else
929 call write_mesh_files("first_timestep_adapted_mesh", output_positions)928 call write_gmsh_file("first_timestep_adapted_mesh", output_positions)
930 end if929 end if
931930
932 end if931 end if
@@ -1613,7 +1612,7 @@
1613 file_name = adapt_state_debug_file_name("adapted_mesh", mesh_dump_no)1612 file_name = adapt_state_debug_file_name("adapted_mesh", mesh_dump_no)
1614 call find_mesh_to_adapt(states(1), mesh)1613 call find_mesh_to_adapt(states(1), mesh)
1615 positions = get_coordinate_field(states(1), mesh)1614 positions = get_coordinate_field(states(1), mesh)
1616 call write_mesh_files(file_name, positions)1615 call write_gmsh_file(file_name, positions)
1617 if(isparallel()) then1616 if(isparallel()) then
1618 file_name = adapt_state_debug_file_name("adapted_mesh", mesh_dump_no, add_parallel = .false.) ! parallel extension is added by write_halos1617 file_name = adapt_state_debug_file_name("adapted_mesh", mesh_dump_no, add_parallel = .false.) ! parallel extension is added by write_halos
1619 call write_halos(file_name, positions%mesh)1618 call write_halos(file_name, positions%mesh)
16201619
=== modified file 'assemble/Adapt_State_Prescribed.F90'
--- assemble/Adapt_State_Prescribed.F90 2011-07-22 15:34:14 +0000
+++ assemble/Adapt_State_Prescribed.F90 2012-05-16 11:01:22 +0000
@@ -109,8 +109,8 @@
109 if(have_option(base_path // "/mesh/from_file")) then109 if(have_option(base_path // "/mesh/from_file")) then
110 call get_option(base_path // "/mesh/from_file/format/name", format)110 call get_option(base_path // "/mesh/from_file/format/name", format)
111 call get_option("/geometry/quadrature/degree", quad_degree)111 call get_option("/geometry/quadrature/degree", quad_degree)
112 112
113 new_positions = read_mesh_files(mesh_name, quad_degree = quad_degree)113 new_positions = read_mesh_files(mesh_name, quad_degree = quad_degree, format = format)
114 else114 else
115 ewrite(2, *) "Extracting new mesh from state"115 ewrite(2, *) "Extracting new mesh from state"
116 116
117117
=== modified file 'assemble/tests/test_empty_populate_state.F90'
--- assemble/tests/test_empty_populate_state.F90 2009-12-16 14:11:47 +0000
+++ assemble/tests/test_empty_populate_state.F90 2012-05-16 11:01:22 +0000
@@ -11,6 +11,7 @@
11 logical :: fail11 logical :: fail
1212
13 is_active_process = .false.13 is_active_process = .false.
14 no_active_processes = 0
14 call load_options("data/empty-mesh.flml")15 call load_options("data/empty-mesh.flml")
15 call populate_state(states)16 call populate_state(states)
1617
1718
=== modified file 'femtools/Checkpoint.F90'
--- femtools/Checkpoint.F90 2011-07-19 15:52:43 +0000
+++ femtools/Checkpoint.F90 2012-05-16 11:01:22 +0000
@@ -1,4 +1,4 @@
1! Copyright (C) 2006 Imperial College London and others.1! Copyrigh (C) 2006 Imperial College London and others.
2!2!
3! Please see the AUTHORS file in the main source directory for a full list3! Please see the AUTHORS file in the main source directory for a full list
4! of copyright holders.4! of copyright holders.
@@ -164,9 +164,9 @@
164 & total_dete_lag164 & total_dete_lag
165 type(vector_field), pointer :: vfield165 type(vector_field), pointer :: vfield
166166
167 integer(KIND=MPI_OFFSET_KIND) :: location_to_write, offset, offset_to_read167 integer(KIND=MPI_OFFSET_KIND) :: location_to_write, offset
168 integer, ALLOCATABLE, DIMENSION(:) :: status168 integer, ALLOCATABLE, DIMENSION(:) :: status
169 integer :: nints, count, realsize, dimen, total_num_det, number_total_columns169 integer :: nints, realsize, dimen, total_num_det, number_total_columns
170 real, dimension(:), allocatable :: buffer170 real, dimension(:), allocatable :: buffer
171171
172 ewrite(1, *) "Checkpointing detectors"172 ewrite(1, *) "Checkpointing detectors"
@@ -432,14 +432,12 @@
432 logical, optional, intent(in) :: keep_initial_data432 logical, optional, intent(in) :: keep_initial_data
433433
434 type(vector_field), pointer:: position434 type(vector_field), pointer:: position
435 character(len = FIELD_NAME_LEN) :: mesh_name435 character(len = FIELD_NAME_LEN) :: mesh_name, mesh_format
436 character(len = OPTION_PATH_LEN) :: mesh_path, mesh_filename436 character(len = OPTION_PATH_LEN) :: mesh_path, mesh_filename
437 integer :: i, n_meshes, stat1, stat2437 integer :: i, n_meshes, stat1, stat2
438 type(mesh_type), pointer :: mesh438 type(mesh_type), pointer :: mesh, external_mesh
439 logical :: from_file, extruded439 logical :: from_file, extruded
440 440
441 character(len = OPTION_PATH_LEN) :: currentMeshFormat
442
443 assert(len_trim(prefix) > 0)441 assert(len_trim(prefix) > 0)
444442
445 n_meshes = option_count("/geometry/mesh")443 n_meshes = option_count("/geometry/mesh")
@@ -467,12 +465,14 @@
467 ! Update the options tree (required for options tree checkpointing)465 ! Update the options tree (required for options tree checkpointing)
468 if (from_file) then466 if (from_file) then
469 call set_option_attribute(trim(mesh_path) // "/from_file/file_name", trim(mesh_filename))467 call set_option_attribute(trim(mesh_path) // "/from_file/file_name", trim(mesh_filename))
468 call get_option(trim(mesh_path) // "/from_file/format/name", mesh_format)
470 else if (extruded) then469 else if (extruded) then
471470
472 ! Lunge forth with a wild stab at what the current mesh format is471 ! the mesh format is determined from the external mesh
473 call guess_external_mesh_format(currentMeshFormat)472 external_mesh => get_external_mesh(state)
473 call get_option(trim(external_mesh%option_path) // "/from_file/format/name", mesh_format)
474474
475 call set_option_attribute(trim(mesh_path) // "/from_mesh/extrude/checkpoint_from_file/format/name", trim(currentMeshFormat), stat=stat1)475 call set_option_attribute(trim(mesh_path) // "/from_mesh/extrude/checkpoint_from_file/format/name", trim(mesh_format), stat=stat1)
476 call set_option_attribute(trim(mesh_path) // "/from_mesh/extrude/checkpoint_from_file/file_name", trim(mesh_filename), stat=stat2)476 call set_option_attribute(trim(mesh_path) // "/from_mesh/extrude/checkpoint_from_file/file_name", trim(mesh_filename), stat=stat2)
477 if ((stat1/=SPUD_NO_ERROR .and. stat1/=SPUD_NEW_KEY_WARNING) .or. &477 if ((stat1/=SPUD_NO_ERROR .and. stat1/=SPUD_NEW_KEY_WARNING) .or. &
478 & (stat2/=SPUD_NO_ERROR .and. stat2/=SPUD_NEW_KEY_WARNING)) then478 & (stat2/=SPUD_NO_ERROR .and. stat2/=SPUD_NEW_KEY_WARNING)) then
@@ -487,13 +487,13 @@
487 else487 else
488 position => extract_vector_field(state(1), trim(mesh%name)//"Coordinate")488 position => extract_vector_field(state(1), trim(mesh%name)//"Coordinate")
489 end if489 end if
490 call write_mesh_files(parallel_filename(mesh_filename), position)490 call write_mesh_files(parallel_filename(mesh_filename), mesh_format, position)
491 ! Write out the halos491 ! Write out the halos
492 ewrite(2, *) "Checkpointing halos"492 ewrite(2, *) "Checkpointing halos"
493 call write_halos(mesh_filename, mesh)493 call write_halos(mesh_filename, mesh)
494 else494 else
495 ! Write out the mesh495 ! Write out the mesh
496 call write_mesh_files(mesh_filename, state(1), mesh)496 call write_mesh_files(mesh_filename, mesh_format, state(1), mesh)
497 end if497 end if
498 end if498 end if
499 end do499 end do
500500
=== modified file 'femtools/Mesh_Files.F90'
--- femtools/Mesh_Files.F90 2011-03-08 13:26:40 +0000
+++ femtools/Mesh_Files.F90 2012-05-16 11:01:22 +0000
@@ -62,8 +62,7 @@
62 private62 private
6363
64 interface read_mesh_files64 interface read_mesh_files
65 module procedure read_mesh_files_to_field, &65 module procedure read_mesh_simple
66 read_mesh_files_to_state, read_mesh_simple
67 end interface66 end interface
6867
69 interface write_mesh_files68 interface write_mesh_files
@@ -71,8 +70,7 @@
71 write_positions_to_file70 write_positions_to_file
72 end interface71 end interface
7372
74 public :: read_mesh_files, identify_mesh_file, write_mesh_files73 public :: read_mesh_files, write_mesh_files
75 public :: guess_external_mesh_format
7674
7775
78contains76contains
@@ -82,143 +80,18 @@
82 ! Read routines first80 ! Read routines first
83 ! --------------------------------------------------------------------------81 ! --------------------------------------------------------------------------
8482
85 subroutine identify_mesh_file(filename, dim, loc, nodes, elements, &83 function read_mesh_simple(filename, format, quad_degree, &
86 node_attributes, selements, selement_boundaries, format)84 quad_ngi, quad_family, mdim) &
87 ! Discover the dimension and size of the mesh. Filename is
88 ! the base name of the mesh file.
89 ! In parallel, filename must *include* the process number.
90
91 character(len=*), intent(in) :: filename
92 character(len=*), optional, intent(in) :: format
93 !! Dimension of mesh elements.
94 integer, intent(out), optional :: dim
95 !! Number of vertices of elements.
96 integer, intent(out), optional :: loc
97 !! Node and element counts.
98 integer, intent(out), optional :: nodes, elements
99 integer, intent(out), optional :: node_attributes
100 ! Surface element meta data
101 integer, optional, intent(out) :: selements
102 integer, optional, intent(out) :: selement_boundaries
103
104 character(len=OPTION_PATH_LEN) :: meshFormat
105
106 if( .not. present(format) ) then
107 call guess_external_mesh_format(meshFormat)
108 else
109 meshFormat = format
110 end if
111
112 ! Call appropriate subroutine depending upon format
113 select case( trim(meshFormat) )
114 case("triangle")
115 call identify_triangle_file(filename, dim, loc, nodes,&
116 elements, node_attributes, selements, selement_boundaries)
117
118 case("gmsh")
119 call identify_gmsh_file(filename, dim, loc, nodes,&
120 elements, node_attributes, selements, selement_boundaries)
121
122 ! Additional mesh format subroutines go here
123
124 case default
125 FLExit("Identifying mesh type "//format//" not supported within Fluidity")
126 end select
127
128 end subroutine identify_mesh_file
129
130
131 ! --------------------------------------------------------------------------
132
133
134 function read_mesh_files_to_field(filename, format, shape) result (field)
135 character(len=*), intent(in) :: filename
136 type(element_type), intent(in), target :: shape
137 type(vector_field) :: field
138 character(len=OPTION_PATH_LEN) :: meshFormat
139
140 character(len=*), optional, intent(in) :: format
141
142 if( .not. present(format) ) then
143 call guess_external_mesh_format(meshFormat)
144 else
145 meshFormat = format
146 end if
147
148 select case( trim(meshFormat) )
149 case("triangle")
150 field = read_triangle_files(filename, shape)
151
152 case("gmsh")
153 field = read_gmsh_file(filename, shape)
154
155 ! Additional mesh format subroutines go here
156
157 case default
158 FLExit("Reading mesh type "//format//" not supported within Fluidity")
159 end select
160 end function read_mesh_files_to_field
161
162
163 ! --------------------------------------------------------------------------
164
165 function read_mesh_files_to_state(filename, shape, shape_type, &
166 n_states, format) &
167 result (result_state)
168
169 ! Filename is the base name of the mesh file without .ele, .msh, etc.
170 ! In parallel the filename must *not* include the process number.
171
172 character(len=*), intent(in) :: filename
173 type(element_type), intent(in), target :: shape
174 logical , intent(in):: shape_type
175 integer, intent(in), optional :: n_states
176
177 type(state_type) :: result_state
178
179 character(len=*), optional, intent(in) :: format
180 character(len=option_path_len) :: meshFormat
181
182 if( .not. present(format) ) then
183 call guess_external_mesh_format(meshFormat)
184 else
185 meshFormat = format
186 end if
187
188
189 select case( trim(meshFormat) )
190 case("triangle")
191 result_state = read_triangle_files(filename, shape,shape_type,n_states)
192
193 case("gmsh")
194 result_state = read_gmsh_file(filename, shape,shape_type,n_states)
195
196 ! Additional mesh format subroutines go here
197
198 case default
199 FLExit("Reading mesh type "//format//" not supported within Fluidity")
200 end select
201
202 end function read_mesh_files_to_state
203
204
205 ! --------------------------------------------------------------------------
206
207 function read_mesh_simple(filename, quad_degree, &
208 quad_ngi, no_faces, &
209 quad_family, mdim, format ) &
210 result (field)85 result (field)
21186
212 ! A simpler mechanism for reading a mesh file into a field.87 ! A simpler mechanism for reading a mesh file into a field.
213 ! In parallel the filename must *not* include the process number.88 ! In parallel the filename must *not* include the process number.
21489
215 character(len=*), intent(in) :: filename90 character(len=*), intent(in) :: filename, format
216 ! The degree of the quadrature.91 ! The degree of the quadrature.
217 integer, intent(in), optional, target :: quad_degree92 integer, intent(in), optional, target :: quad_degree
218 ! The degree of the quadrature.93 ! The degree of the quadrature.
219 integer, intent(in), optional, target :: quad_ngi94 integer, intent(in), optional, target :: quad_ngi
220 ! Whether to add_faces on the resulting mesh.
221 logical, intent(in), optional :: no_faces
222 ! What quadrature family to use95 ! What quadrature family to use
223 integer, intent(in), optional :: quad_family96 integer, intent(in), optional :: quad_family
224 ! Dimension of mesh97 ! Dimension of mesh
@@ -226,24 +99,17 @@
22699
227 type(vector_field) :: field100 type(vector_field) :: field
228101
229 character(len=*), optional, intent(in) :: format102 select case( trim(format) )
230 character(len=option_path_len) :: meshFormat
231
232 if( .not. present(format) ) then
233 call guess_external_mesh_format(meshFormat)
234 else
235 meshFormat = format
236 end if
237
238
239 select case( trim(meshFormat) )
240 case("triangle")103 case("triangle")
241 field = read_triangle_files(filename, quad_degree, quad_ngi, &104 field = read_triangle_files(filename, quad_degree=quad_degree, quad_ngi=quad_ngi, &
242 no_faces, quad_family, mdim)105 quad_family=quad_family, mdim=mdim)
243106
244 case("gmsh")107 case("gmsh")
245 field = read_gmsh_file(filename, quad_degree, quad_ngi, &108 if (present(mdim)) then
246 no_faces, quad_family)109 FLExit("Cannot specify dimension for gmsh format")
110 end if
111 field = read_gmsh_file(filename, quad_degree=quad_degree, quad_ngi=quad_ngi, &
112 quad_family=quad_family)
247113
248 ! Additional mesh format subroutines go here114 ! Additional mesh format subroutines go here
249115
@@ -260,22 +126,15 @@
260 ! --------------------------------------------------------------------------126 ! --------------------------------------------------------------------------
261127
262128
263 subroutine write_mesh_to_file(filename, state, mesh, format )129 subroutine write_mesh_to_file(filename, format, state, mesh)
264 ! Write out the supplied mesh to the specified filename as mesh files.130 ! Write out the supplied mesh to the specified filename as mesh files.
265131
266 character(len = *), intent(in) :: filename132 character(len = *), intent(in) :: filename
267 character(len = *), intent(in), optional ::format133 character(len = *), intent(in) :: format
268 character(len = option_path_len) :: meshFormat
269 type(state_type), intent(in) :: state134 type(state_type), intent(in) :: state
270 type(mesh_type), intent(in) :: mesh135 type(mesh_type), intent(in) :: mesh
271136
272 if( .not. present(format) ) then137 select case(format)
273 call guess_external_mesh_format(meshFormat)
274 else
275 meshFormat = format
276 end if
277
278 select case(meshFormat)
279 case("triangle")138 case("triangle")
280 call write_triangle_files(filename, state, mesh)139 call write_triangle_files(filename, state, mesh)
281140
@@ -293,24 +152,13 @@
293152
294 ! --------------------------------------------------------------------------153 ! --------------------------------------------------------------------------
295154
296 subroutine write_positions_to_file(filename, positions, format)155 subroutine write_positions_to_file(filename, format, positions)
297 !!< Write out the mesh given by the position field in mesh files156 !!< Write out the mesh given by the position field in mesh files
298 !!< In parallel, empty trailing processes are not written.157 !!< In parallel, empty trailing processes are not written.
299 character(len=*), intent(in):: filename158 character(len=*), intent(in):: filename, format
300 type(vector_field), intent(in):: positions159 type(vector_field), intent(in):: positions
301 !! "triangle" or "gmsh"160
302 character(len=*), intent(in), optional :: format161 select case( trim(format) )
303
304 character(len=option_path_len) :: meshFormat
305
306 if( .not. present(format) ) then
307 call guess_external_mesh_format(meshFormat)
308 else
309 meshFormat = format
310 end if
311
312
313 select case( trim(meshFormat) )
314 case("triangle")162 case("triangle")
315 call write_triangle_files( trim(filename), positions)163 call write_triangle_files( trim(filename), positions)
316164
@@ -325,48 +173,5 @@
325173
326 end subroutine write_positions_to_file174 end subroutine write_positions_to_file
327175
328
329
330
331 ! --------------------------------------------------------------------------
332 ! Subroutine which finds external mesh format and puts it in 'meshFormat'
333 ! Follows similar logic to Field_Options::get_external_mesh()
334
335
336 subroutine guess_external_mesh_format(meshFormat)
337 character(len=*) :: meshFormat
338 character(len=OPTION_PATH_LEN) :: meshPath, formatPath
339 integer :: numMeshes, meshFound, i
340
341 numMeshes = option_count("/geometry/mesh")
342
343 ! Search for external meshes, and exit loop when found one
344 meshFound=0
345 do i = 0, numMeshes-1
346 meshPath = "/geometry/mesh["//int2str(i)//"]/from_file"
347
348 if(have_option(trim(meshPath))) then
349 meshFound=1
350 exit
351 end if
352 end do
353
354 ! We've found a mesh, now get its format
355 if (meshFound==1) then
356 formatPath = trim(meshPath) // "/format/name"
357
358 if(have_option(trim(formatPath))) then
359 call get_option( trim(formatPath), meshFormat )
360 else
361 ! If mesh exists but no format found, default to triangle
362 meshFormat = "triangle"
363 end if
364 else
365 ! If we can't find any external meshes...
366 meshFormat = "triangle"
367 end if
368
369 end subroutine guess_external_mesh_format
370
371end module mesh_files176end module mesh_files
372177
373178
=== modified file 'femtools/Read_GMSH.F90'
--- femtools/Read_GMSH.F90 2011-10-21 10:05:25 +0000
+++ femtools/Read_GMSH.F90 2012-05-16 11:01:22 +0000
@@ -44,160 +44,46 @@
44 private44 private
4545
46 interface read_gmsh_file46 interface read_gmsh_file
47 module procedure read_gmsh_file_to_field, read_gmsh_simple, &47 module procedure read_gmsh_simple
48 read_gmsh_file_to_state
49 end interface48 end interface
5049
51 public :: read_gmsh_file, identify_gmsh_file50 public :: read_gmsh_file
51
52 integer, parameter:: GMSH_LINE=1, GMSH_TRIANGLE=2, GMSH_QUAD=3, GMSH_TET=4, GMSH_HEX=5, GMSH_NODE=15
5253
53contains54contains
5455
55 ! -----------------------------------------------------------------56 ! -----------------------------------------------------------------
56 ! GMSH version of triangle equivalent.
57
58 subroutine identify_gmsh_file(filename, numDimenOut, locOut, &
59 numNodesOut, numElementsOut, &
60 nodeAttributesOut, selementsOut, boundaryFlagOut)
61 ! Discover the dimension and size of the GMSH mesh.
62 ! Filename is the base name of the file without .msh.
63 ! In parallel, filename must *include* the process number.
64
65 character(len=*), intent(in) :: filename
66 character(len=option_path_len) :: lfilename
67
68 !! Number of vertices of elements.
69 integer, intent(out), optional :: numDimenOut, locOut, numNodesOut
70 integer, intent(out), optional :: numElementsOut, nodeAttributesOut
71 integer, intent(out), optional :: selementsOut, boundaryFlagOut
72
73
74 logical :: fileExists
75
76 integer :: fd, gmshFormat
77 type(GMSHnode), pointer :: nodes(:)
78 type(GMSHelement), pointer :: elements(:), faces(:)
79 integer :: numElements, boundaryFlag, numNodes, numDimen
80 integer :: loc, effDimen, nodeAttributes
81 integer :: i
82
83 logical :: haveBounds, haveInternalBounds
84
85
86 lfilename = trim(filename) // ".msh"
87
88 ! Read node file header
89 inquire(file = trim(lfilename), exist = fileExists)
90 if(.not. fileExists) then
91 FLExit("gmsh file " // trim(lfilename) // " not found")
92 end if
93
94 ewrite(2, *) "Opening " // trim(lfilename) // " for reading."
95 fd = free_unit()
96 open(unit = fd, file = trim(lfilename), &
97 err=42, action="read", access="stream", form="formatted" )
98
99 call read_header(fd, lfilename, gmshFormat)
100
101 ! Read in the nodes
102 call read_nodes_coords( fd, lfilename, gmshFormat, nodes )
103
104 numDimen = mesh_dimensions( nodes )
105 numNodes = size(nodes)
106
107 ! Read in elements
108 call read_faces_and_elements( fd, lfilename, gmshFormat, &
109 elements, faces )
110
111
112 ! Try reading in node column ID data (if there is any)
113 call read_node_column_IDs( fd, lfilename, gmshFormat, nodes)
114
115 close( fd )
116
117 ! We're assuming all elements have the same number of vertices/nodes
118 loc = size(elements(1)%nodeIDs)
119
120 do i=1, numNodes
121 if( nodes(i)%columnID>0 ) nodeAttributes=1
122 end do
123
124 ! NOTE: 'boundaries' variable
125 ! (see Read_Triangle.F90) is a flag which indicates whether
126 ! faces have boundaries (physical IDs). Values:
127 ! =0 : no boundaries
128 ! =1 : boundaries, normal
129 ! =2 : boundaries, periodic mesh (internal boundary)
130
131 haveBounds=.false.
132 haveInternalBounds=.false.
133
134 do i=1, size(faces)
135 if(faces(i)%numTags > 0) then
136 ! We have boundaries,
137 haveBounds=.true.
138
139 ! We have internal boundaries (at the join of a period mesh)
140 if(faces(i)%numTags >= 4) then
141 if (faces(i)%tags(4) > 0) then
142 haveInternalBounds=.true.
143 end if
144 end if
145 end if
146 end do
147
148 if(haveInternalBounds) then
149 boundaryFlag=2
150 elseif(haveBounds) then
151 boundaryFlag=1
152 else
153 boundaryFlag=0
154 end if
155
156 if( numDimen.eq.2 .and. have_option("/geometry/spherical_earth/") ) then
157 effDimen = numDimen+1
158 else
159 effDimen = numDimen
160 end if
161
162
163 ! Return optional variables requested
164
165 if(present(nodeAttributesOut)) nodeAttributesOut=nodeAttributes
166 if(present(numDimenOut)) numDimenOut=effDimen
167 if(present(numElementsOut)) numElementsOut=numElements
168 if(present(locOut)) locOut=loc
169 if(present(boundaryFlagOut)) boundaryFlagOut=boundaryFlag
170
171 deallocate(nodes)
172
173 return
174
17542 FLExit("Unable to open "//trim(lfilename))
176
177 end subroutine identify_gmsh_file
178
179
180
181 ! -----------------------------------------------------------------
182 ! The main function for reading GMSH files57 ! The main function for reading GMSH files
18358
184 function read_gmsh_file_to_field(filename, shape) result (field)59 function read_gmsh_simple( filename, quad_degree, &
185 ! Filename is the base name of the GMSH file without .msh 60 quad_ngi, quad_family ) &
186 ! In parallel the filename must *not* include the process number.61 result (field)
62 !!< Read a GMSH file into a coordinate field.
63 !!< In parallel the filename must *not* include the process number.
18764
188 character(len=*), intent(in) :: filename65 character(len=*), intent(in) :: filename
189 type(element_type), intent(in), target :: shape66 !! The degree of the quadrature.
190 type(vector_field) :: field67 integer, intent(in), optional, target :: quad_degree
68 !! The degree of the quadrature.
69 integer, intent(in), optional, target :: quad_ngi
70 !! What quadrature family to use
71 integer, intent(in), optional :: quad_family
72 !! result: a coordinate field
73 type(vector_field) :: field
74
75 type(quadrature_type):: quad
76 type(element_type):: shape
77 type(mesh_type):: mesh
19178
192 integer :: fd79 integer :: fd
193 integer, pointer, dimension(:) :: sndglno, boundaryIDs, faceOwner80 integer, pointer, dimension(:) :: sndglno, boundaryIDs, faceOwner
19481
195 character(len = parallel_filename_len(filename)) :: lfilename82 character(len = parallel_filename_len(filename)) :: lfilename
196 integer :: loc, sloc83 integer :: loc, sloc
197 type(mesh_type) :: mesh
198 integer :: numNodes, numElements, numFaces84 integer :: numNodes, numElements, numFaces
199 logical :: haveBounds, haveElementOwners, haveRegionIDs85 logical :: haveBounds, haveElementOwners, haveRegionIDs
200 integer :: numDimen, effDimen86 integer :: dim, coordinate_dim
201 integer :: gmshFormat87 integer :: gmshFormat
202 integer :: n, d, e, f, nodeID88 integer :: n, d, e, f, nodeID
20389
@@ -225,11 +111,9 @@
225 ! Read in the nodes111 ! Read in the nodes
226 call read_nodes_coords( fd, lfilename, gmshFormat, nodes )112 call read_nodes_coords( fd, lfilename, gmshFormat, nodes )
227113
228 numDimen = mesh_dimensions( nodes )
229
230 ! Read in elements114 ! Read in elements
231 call read_faces_and_elements( fd, lfilename, gmshFormat, &115 call read_faces_and_elements( fd, lfilename, gmshFormat, &
232 elements, faces )116 elements, faces, dim)
233117
234 call read_node_column_IDs( fd, lfilename, gmshFormat, nodes )118 call read_node_column_IDs( fd, lfilename, gmshFormat, nodes )
235119
@@ -285,39 +169,51 @@
285 169
286 end if170 end if
287 171
288 if( numDimen.eq.2 .and. have_option("/geometry/spherical_earth/") ) then172 if(have_option("/geometry/spherical_earth/") ) then
289 effDimen = numDimen+1173 ! on the sphere the input mesh may be 2d (extrusion), or 3d but
290 else174 ! Coordinate is always 3-dimensional
291 effDimen = numDimen175 coordinate_dim = 3
292 end if176 else
293177 coordinate_dim = dim
294178 end if
179
180 loc = size( elements(1)%nodeIDs )
181 if (numFaces>0) then
182 sloc = size( faces(1)%nodeIDs )
183 else
184 sloc = 0
185 end if
186
187 ! Now construct within Fluidity data structures
188
189 if (present(quad_degree)) then
190 quad = make_quadrature(loc, dim, degree=quad_degree, family=quad_family)
191 else if (present(quad_ngi)) then
192 quad = make_quadrature(loc, dim, ngi=quad_ngi, family=quad_family)
193 else
194 FLAbort("Need to specify either quadrature degree or ngi")
195 end if
196 shape=make_element_shape(loc, dim, 1, quad)
295 call allocate(mesh, numNodes, numElements, shape, name="CoordinateMesh")197 call allocate(mesh, numNodes, numElements, shape, name="CoordinateMesh")
296 call allocate( field, effDimen, mesh, name="Coordinate")198 call allocate( field, coordinate_dim, mesh, name="Coordinate")
297 call deallocate( mesh )199
298200 ! deallocate our references of mesh, shape and quadrature:
299 ! Now construct within Fluidity data structures201 call deallocate(mesh)
202 call deallocate(shape)
203 call deallocate(quad)
204
300205
301 if (haveRegionIDs) then206 if (haveRegionIDs) then
302 allocate( field%mesh%region_ids(numElements) )207 allocate( field%mesh%region_ids(numElements) )
303 end if208 end if
304 if(nodes(1)%columnID.ge.0) allocate(field%mesh%columns(1:numNodes))209 if(nodes(1)%columnID>=0) allocate(field%mesh%columns(1:numNodes))
305
306 loc = size( elements(1)%nodeIDs )
307 if (numFaces>0) then
308 sloc = size( faces(1)%nodeIDs )
309 else
310 sloc = 0
311 end if
312
313 assert(loc==shape%loc)
314210
315 ! Loop round nodes copying across coords and column IDs to field mesh,211 ! Loop round nodes copying across coords and column IDs to field mesh,
316 ! if they exist212 ! if they exist
317 do n=1, numNodes213 do n=1, numNodes
318214
319 nodeID = nodes(n)%nodeID215 nodeID = nodes(n)%nodeID
320 forall (d = 1:effDimen)216 forall (d = 1:field%dim)
321 field%val(d,nodeID) = nodes(n)%x(d)217 field%val(d,nodeID) = nodes(n)%x(d)
322 end forall218 end forall
323219
@@ -380,86 +276,8 @@
380276
38143 FLExit("Unable to open "//trim(lfilename))27743 FLExit("Unable to open "//trim(lfilename))
382278
383 end function read_gmsh_file_to_field
384
385
386
387
388
389
390 ! -----------------------------------------------------------------
391 ! Simplified interface to reading GMSH files
392 function read_gmsh_simple( filename, quad_degree, &
393 quad_ngi, no_faces, quad_family ) &
394 result (field)
395 !!< A simpler mechanism for reading a GMSH file into a field.
396 !!< In parallel the filename must *not* include the process number.
397
398 character(len=*), intent(in) :: filename
399 !! The degree of the quadrature.
400 integer, intent(in), optional, target :: quad_degree
401 !! The degree of the quadrature.
402 integer, intent(in), optional, target :: quad_ngi
403 !! Whether to add_faces on the resulting mesh.
404 logical, intent(in), optional :: no_faces
405 !! What quadrature family to use
406 integer, intent(in), optional :: quad_family
407
408 type(vector_field) :: field
409 type(quadrature_type) :: quad
410 type(element_type) :: shape
411
412 integer :: dim, loc
413
414
415 if(isparallel()) then
416 call identify_gmsh_file(parallel_filename(filename), dim, loc)
417 else
418 call identify_gmsh_file(filename, dim, loc)
419 end if
420
421
422 if (present(quad_degree)) then
423 quad = make_quadrature(loc, dim, degree=quad_degree, family=quad_family)
424 else if (present(quad_ngi)) then
425 quad = make_quadrature(loc, dim, ngi=quad_ngi, family=quad_family)
426 else
427 FLAbort("Need to specify either quadrature degree or ngi")
428 end if
429
430
431 shape=make_element_shape(loc, dim, 1, quad)
432
433 field=read_gmsh_file(filename, shape)
434
435 ! deallocate our references of shape and quadrature:
436 call deallocate_element(shape)
437 call deallocate(quad)
438
439 end function read_gmsh_simple279 end function read_gmsh_simple
440280
441
442
443
444 ! -----------------------------------------------------------------
445 ! Read GMSH file to state object.
446
447 function read_gmsh_file_to_state(filename, shape,shape_type,n_states) &
448 result (result_state)
449 ! Filename is the base name of the GMSH file without .node or .ele.
450 ! In parallel the filename must *not* include the process number.
451
452 character(len=*), intent(in) :: filename
453 type(element_type), intent(in), target :: shape
454 logical , intent(in):: shape_type
455 integer, intent(in), optional :: n_states
456 type(state_type) :: result_state
457
458 FLAbort("read_gmsh_file_to_state() not implemented yet")
459
460 end function read_gmsh_file_to_state
461
462
463 ! -----------------------------------------------------------------281 ! -----------------------------------------------------------------
464 ! Read through the head to decide whether binary or ASCII, and decide282 ! Read through the head to decide whether binary or ASCII, and decide
465 ! whether this looks like a GMSH mesh file or not.283 ! whether this looks like a GMSH mesh file or not.
@@ -666,37 +484,17 @@
666484
667485
668 ! -----------------------------------------------------------------486 ! -----------------------------------------------------------------
669 ! Guesstimate mesh dimensions. If any node z-coords are non-zero, then487 ! Read in element header data and establish topological dimension
670 ! it's a 3D mesh; otherwise 2D. Not pretty, but there seems no other
671 ! way to do this.
672
673 integer function mesh_dimensions( nodes )
674 type(GMSHnode), pointer :: nodes(:)
675 real, pointer :: absZ(:)
676
677 mesh_dimensions = 3
678
679 allocate ( absZ(size(nodes)) )
680 absZ(:) = nodes(:)%x(3)
681
682 if( all( absZ > -verySmall .and. absZ < verySmall) ) mesh_dimensions=2
683
684 deallocate(absZ)
685 end function mesh_dimensions
686
687
688
689
690 ! -----------------------------------------------------------------
691 ! Read in element header data
692488
693 subroutine read_faces_and_elements( fd, filename, gmshFormat, &489 subroutine read_faces_and_elements( fd, filename, gmshFormat, &
694 elements, faces )490 elements, faces, dim)
695491
696 integer :: fd, gmshFormat492 integer, intent(in) :: fd, gmshFormat
697 character(len=*) :: filename493 character(len=*), intent(in) :: filename
698494 type(GMSHelement), pointer :: elements(:), faces(:)
699 type(GMSHelement), pointer :: allElements(:), elements(:), faces(:)495 integer, intent(out) :: dim
496
497 type(GMSHelement), pointer :: allElements(:)
700498
701 integer :: numAllElements499 integer :: numAllElements
702 character(len=longStringLen) :: charBuf500 character(len=longStringLen) :: charBuf
@@ -708,14 +506,14 @@
708506
709507
710 read(fd,*) charBuf508 read(fd,*) charBuf
711 if( trim(charBuf) .ne. "$Elements" ) then509 if( trim(charBuf)/="$Elements" ) then
712 FLExit("Error: cannot find '$Elements' in GMSH mesh file")510 FLExit("Error: cannot find '$Elements' in GMSH mesh file")
713 end if511 end if
714512
715 read(fd,*) numAllElements513 read(fd,*) numAllElements
716514
717 ! Sanity check.515 ! Sanity check.
718 if(numAllElements .lt. 1) then516 if(numAllElements<1) then
719 FLExit("Error: number of elements in GMSH file < 1")517 FLExit("Error: number of elements in GMSH file < 1")
720 end if518 end if
721519
@@ -799,23 +597,21 @@
799 allElements(e)%type )597 allElements(e)%type )
800598
801 select case ( allElements(e)%type )599 select case ( allElements(e)%type )
802 ! A line600 case (GMSH_LINE)
803 case (1)
804 numEdges = numEdges+1601 numEdges = numEdges+1
805 ! A triangle602 case (GMSH_TRIANGLE)
806 case (2)
807 numTriangles = numTriangles+1603 numTriangles = numTriangles+1
808 ! A quad604 case (GMSH_QUAD)
809 case (3)
810 numQuads = numQuads+1605 numQuads = numQuads+1
811 case (4)606 case (GMSH_TET)
812 numTets = numTets+1607 numTets = numTets+1
813 case (5)608 case (GMSH_HEX)
814 numHexes = numHexes+1609 numHexes = numHexes+1
815 case (15)610 case (GMSH_NODE)
816 ! Do nothing611 ! Do nothing
817 case default612 case default
818 FLExit("read_faces_and_elements(): unsupported element type")613 ewrite(0,*) "element id,type: ", allElements(e)%elementID, allElements(e)%type
614 FLExit("Unsupported element type in gmsh .msh file")
819 end select615 end select
820616
821 end do617 end do
@@ -833,29 +629,40 @@
833 ! meshes are verboten:629 ! meshes are verboten:
834 ! tet/hex, tet/quad, triangle/hex and triangle/quad630 ! tet/hex, tet/quad, triangle/hex and triangle/quad
835631
836 if (numTets .gt. 0) then632 if (numTets>0) then
837 numElements = numTets633 numElements = numTets
838 elementType = 4634 elementType = GMSH_TET
839 numFaces = numTriangles635 numFaces = numTriangles
840 faceType = 2636 faceType = GMSH_TRIANGLE
637 dim = 3
638 if (numQuads>0 .or. numHexes>0) then
639 FLExit("Cannot combine hexes or quads with tetrahedrals in one gmsh .msh file")
640 end if
841641
842 elseif (numTriangles .gt. 0) then642 elseif (numTriangles>0) then
843 numElements = numTriangles643 numElements = numTriangles
844 elementType = 2644 elementType = GMSH_TRIANGLE
845 numFaces = numEdges645 numFaces = numEdges
846 faceType = 1646 faceType = GMSH_LINE
647 dim = 2
648 if (numQuads>0 .or. numHexes>0) then
649 FLExit("Cannot combine hexes or quads with triangles in one gmsh .msh file")
650 end if
847651
848 elseif (numHexes .gt. 0) then652 elseif (numHexes .gt. 0) then
849 numElements = numHexes653 numElements = numHexes
850 elementType = 5654 elementType = GMSH_HEX
851 numFaces = numQuads655 numFaces = numQuads
852 faceType = 3656 faceType = GMSH_QUAD
657 dim = 3
853658
854 elseif (numQuads .gt. 0) then659 elseif (numQuads .gt. 0) then
855 numElements = numQuads660 numElements = numQuads
856 elementType = 3661 elementType = GMSH_QUAD
857 numFaces = numEdges662 numFaces = numEdges
858 faceType = 1663 faceType = GMSH_LINE
664 dim = 2
665
859 else666 else
860 FLExit("Unsupported mixture of face/element types")667 FLExit("Unsupported mixture of face/element types")
861 end if668 end if
862669
=== modified file 'femtools/Read_Triangle.F90'
--- femtools/Read_Triangle.F90 2011-03-08 13:26:40 +0000
+++ femtools/Read_Triangle.F90 2012-05-16 11:01:22 +0000
@@ -42,8 +42,7 @@
42 private42 private
4343
44 interface read_triangle_files44 interface read_triangle_files
45 module procedure read_triangle_files_to_field, &45 module procedure read_triangle_files_to_field, read_triangle_simple
46 read_triangle_files_to_state, read_triangle_simple
47 end interface46 end interface
4847
49 public :: read_triangle_files, identify_triangle_file, read_elemental_mappings, read_triangle_serial48 public :: read_triangle_files, identify_triangle_file, read_elemental_mappings, read_triangle_serial
@@ -414,167 +413,6 @@
414 413
415 end function read_triangle_files_to_field414 end function read_triangle_files_to_field
416415
417 function read_triangle_files_to_state(filename, shape,shape_type,n_states) result (result_state)
418 !!< Filename is the base name of the triangle file without .node or .ele.
419 !!< In parallel the filename must *not* include the process number.
420
421 character(len=*), intent(in) :: filename
422 type(element_type), intent(in), target :: shape
423 logical , intent(in):: shape_type
424 integer, intent(in), optional :: n_states
425 type(state_type) :: result_state
426 type(vector_field) :: field
427 type(scalar_field), allocatable, dimension(:) :: attribs
428 type(scalar_field) :: bndry_mark
429
430 character(len = parallel_filename_len(filename)) :: lfilename
431 integer :: node_unit, ele_unit
432 real, allocatable, dimension(:) :: read_buffer
433 character(len=6) :: write_buffer
434 integer :: i, j, nodes, dim, xdim, node_attributes, boundaries,&
435 & ele_attributes, loc, elements
436 integer, allocatable, dimension(:) :: node_order
437
438 type(mesh_type), dimension(:), allocatable, save :: meshes
439 integer, save :: counter=0
440
441 assert(shape_type)
442
443 ! If running in parallel, add the process number
444 if(isparallel()) then
445 lfilename = parallel_filename(filename)
446 else
447 lfilename = trim(filename)
448 end if
449
450 node_unit=free_unit()
451
452 counter=counter+1
453 if (counter==1) then
454 if (present(n_states)) then
455 allocate(meshes(n_states))
456 else
457 allocate(meshes(1))
458 end if
459 end if
460 assert(counter .le. size(meshes))
461
462 call nullify(result_state)
463 call deallocate(result_state)
464
465 ewrite(2, *) "Opening "//trim(lfilename)//".node for reading."
466 ! Open node file
467 open(unit=node_unit, file=trim(lfilename)//".node", err=42, action="read")
468
469 ! Read node file header.
470 read (node_unit, *) nodes, xdim, node_attributes, boundaries
471
472 ele_unit=free_unit()
473
474 ewrite(2, *) "Opening "//trim(lfilename)//".ele for reading."
475 ! Open element file
476 open(unit=ele_unit, file=trim(lfilename)//".ele", err=43, action="read")
477
478 ! Read element file header.
479 read (ele_unit, *) elements, loc, ele_attributes
480
481 assert(loc==shape%loc)
482 allocate(node_order(loc))
483 select case(loc)
484 case(3)
485 node_order = (/1,2,3/)
486 case(6)
487 node_order = (/1,6,2,5,4,3/)
488 case default
489 do j=1,loc
490 node_order(:)=j
491 enddo
492 end select
493
494 call allocate(meshes(counter), nodes, elements, shape, name="CoordinateMesh")
495 call allocate(field, xdim, meshes(counter), name=filename//' Coordinate')
496 allocate(attribs(node_attributes))
497 do j=1,node_attributes
498 write(write_buffer,'(i0)') j
499 call allocate(attribs(j),meshes(counter),&
500 name='Attribute '//trim(write_buffer))
501 end do
502 call allocate(bndry_mark,meshes(counter),&
503 name='Boundary Marker')
504
505 allocate(read_buffer(xdim+node_attributes+boundaries+1))
506
507 do i=1,nodes
508 read(node_unit,*) read_buffer
509
510 forall (j=1:xdim)
511 field%val(j,i)=read_buffer(j+1)
512 end forall
513
514 forall (j=1:node_attributes)
515 attribs(j)%val(i)=read_buffer(j+1+xdim)
516 end forall
517
518 if (boundaries>0) then
519 bndry_mark%val(i)=read_buffer(1+1+xdim+node_attributes)
520 end if
521
522 end do
523
524
525 deallocate(read_buffer)
526 allocate(read_buffer(loc+ele_attributes+1))
527
528 if(ele_attributes==1) then ! this assumes the element attribute is a region id
529 allocate(field%mesh%region_ids(1:elements))
530 do j=1,node_attributes
531 allocate(attribs(j)%mesh%region_ids(1:elements))
532 end do
533 allocate(bndry_mark%mesh%region_ids(1:elements))
534 allocate(meshes(counter)%region_ids(1:elements))
535 end if
536
537 do i=1,elements
538 read(ele_unit,*) read_buffer
539
540
541 field%mesh%ndglno((i-1)*loc+1:i*loc)=read_buffer(node_order+1)
542 forall (j=1:node_attributes)
543 attribs(j)%mesh%ndglno((i-1)*loc+1:i*loc)=read_buffer(node_order+1)
544 end forall
545 bndry_mark%mesh%ndglno((i-1)*loc+1:i*loc)=read_buffer(node_order+1)
546 meshes(counter)%ndglno((i-1)*loc+1:i*loc)=read_buffer(node_order+1)
547
548 if(ele_attributes==1) then
549 field%mesh%region_ids(i)=read_buffer(loc+2)
550 forall (j=1:node_attributes)
551 attribs(j)%mesh%region_ids(i)=read_buffer(loc+2)
552 end forall
553 bndry_mark%mesh%region_ids(i)=read_buffer(loc+2)
554 meshes(counter)%region_ids(i)=read_buffer(loc+2)
555 end if
556 end do
557
558 close(node_unit)
559 close(ele_unit)
560
561
562 call insert(result_state,field,"Coordinate")
563 do j=1,node_attributes
564 write(write_buffer,'(i0)') j
565 call insert(result_state,attribs(j),"Attributes "//trim(write_buffer))
566 end do
567 if(boundaries>0) call insert(result_state,bndry_mark,"Boundary Marker")
568 call insert(result_state,meshes(counter),filename)
569
570 return
571
57242 FLExit("Unable to open "//trim(lfilename)//".node")
573
57443 FLExit("Unable to open "//trim(lfilename)//".ele")
575
576 end function read_triangle_files_to_state
577
578 function read_triangle_simple(filename, quad_degree, quad_ngi, no_faces, quad_family, mdim) result (field)416 function read_triangle_simple(filename, quad_degree, quad_ngi, no_faces, quad_family, mdim) result (field)
579 !!< A simpler mechanism for reading a triangle file into a field.417 !!< A simpler mechanism for reading a triangle file into a field.
580 !!< In parallel the filename must *not* include the process number.418 !!< In parallel the filename must *not* include the process number.
581419
=== modified file 'preprocessor/Populate_State.F90'
--- preprocessor/Populate_State.F90 2012-01-30 15:36:17 +0000
+++ preprocessor/Populate_State.F90 2012-05-16 11:01:22 +0000
@@ -174,6 +174,7 @@
174 character(len=OPTION_PATH_LEN) :: mesh_path, mesh_file_name,&174 character(len=OPTION_PATH_LEN) :: mesh_path, mesh_file_name,&
175 & mesh_file_format, from_file_path175 & mesh_file_format, from_file_path
176 integer, dimension(:), pointer :: coplanar_ids176 integer, dimension(:), pointer :: coplanar_ids
177 integer, dimension(3) :: mesh_dims
177 integer :: i, j, nmeshes, nstates, quad_degree, stat178 integer :: i, j, nmeshes, nstates, quad_degree, stat
178 type(element_type), pointer :: shape179 type(element_type), pointer :: shape
179 type(quadrature_type), pointer :: quad180 type(quadrature_type), pointer :: quad
@@ -219,22 +220,96 @@
219 call get_option("/geometry/quadrature/degree", quad_degree)220 call get_option("/geometry/quadrature/degree", quad_degree)
220 quad_family = get_quad_family()221 quad_family = get_quad_family()
221222
223
224 if (is_active_process) then
225 select case (mesh_file_format)
226 case ("triangle", "gmsh")
227 ! Get mesh dimension if present
228 call get_option(trim(mesh_path)//"/from_file/dimension", mdim, stat)
229 ! Read mesh
230 if(stat==0) then
231 position=read_mesh_files(trim(mesh_file_name), &
232 quad_degree=quad_degree, &
233 quad_family=quad_family, mdim=mdim, &
234 format=mesh_file_format)
235 else
236 position=read_mesh_files(trim(mesh_file_name), &
237 quad_degree=quad_degree, &
238 quad_family=quad_family, &
239 format=mesh_file_format)
240 end if
241 mesh=position%mesh
242 case ("vtu")
243 position_ptr => vtk_cache_read_positions_field(mesh_file_name)
244 ! No hybrid mesh support here
245 assert(ele_count(position_ptr) > 0)
246 dim = position_ptr%dim
247 loc = ele_loc(position_ptr, 1)
248
249 ! Generate a copy, and swap the quadrature degree
250 ! Note: Even if positions_ptr has the correct quadrature degree, it
251 ! won't have any faces and hence a copy is still required (as
252 ! add_faces is a construction routine only)
253 allocate(quad)
254 allocate(shape)
255 quad = make_quadrature(loc, dim, degree = quad_degree, family=quad_family)
256 shape = make_element_shape(loc, dim, 1, quad)
257 call allocate(mesh, nodes = node_count(position_ptr), elements = ele_count(position_ptr), shape = shape, name = position_ptr%mesh%name)
258 do j = 1, ele_count(mesh)
259 call set_ele_nodes(mesh, j, ele_nodes(position_ptr%mesh, j))
260 end do
261 call add_faces(mesh)
262 call allocate(position, dim, mesh, position_ptr%name)
263 call set(position, position_ptr)
264 call deallocate(mesh)
265 call deallocate(shape)
266 call deallocate(quad)
267 deallocate(quad)
268 deallocate(shape)
269
270 mesh = position%mesh
271 case default
272 ewrite(-1,*) trim(mesh_file_format), " is not a valid format for a mesh file"
273 FLAbort("Invalid format for mesh file")
274 end select
275 end if
276
277 if (no_active_processes /= getnprocs()) then
278 ! not all processes are active, they need to be told the mesh dimensions
279
280 ! receive the mesh dimension from rank 0
281 if (getrank()==0) then
282 if (is_active_process) then
283 ! normally rank 0 should always be active, so it knows the dimensions
284 mesh_dims(1)=mesh_dim(mesh)
285 mesh_dims(2)=ele_loc(mesh,1)
286 if (associated(mesh%columns)) then
287 mesh_dims(3)=1
288 else
289 mesh_dims(3)=0
290 end if
291 else
292 ! this is a special case for a unit test with 1 inactive process
293 call get_option('/geometry/dimension', mesh_dims(1))
294 mesh_dims(2)=mesh_dims(1)+1
295 mesh_dims(3)=0
296 end if
297 end if
298 call MPI_bcast(mesh_dims, 3, getpinteger(), 0, MPI_COMM_FEMTOOLS, stat)
299 end if
300
301
222 if (.not. is_active_process) then302 if (.not. is_active_process) then
223 ! is_active_process records whether we have data on disk or not303 ! is_active_process records whether we have data on disk or not
224 ! see the comment in Global_Parameters. In this block, 304 ! see the comment in Global_Parameters. In this block,
225 ! we want to allocate an empty mesh and positions.305 ! we want to allocate an empty mesh and positions.
226306
307 dim=mesh_dims(1)
308 loc=mesh_dims(2)
309 column_ids=mesh_dims(3)
310
227 allocate(quad)311 allocate(quad)
228 allocate(shape)312 allocate(shape)
229 if (no_active_processes == 1) then
230 call identify_mesh_file(trim(mesh_file_name), dim, loc, &
231 node_attributes=column_ids, &
232 format=mesh_file_format )
233 else
234 call identify_mesh_file(trim(mesh_file_name) // "_0", dim, loc, &
235 node_attributes=column_ids, &
236 format=mesh_file_format )
237 end if
238 quad = make_quadrature(loc, dim, degree=quad_degree, family=quad_family)313 quad = make_quadrature(loc, dim, degree=quad_degree, family=quad_family)
239 shape=make_element_shape(loc, dim, 1, quad)314 shape=make_element_shape(loc, dim, 1, quad)
240 call allocate(mesh, nodes=0, elements=0, shape=shape, name="EmptyMesh")315 call allocate(mesh, nodes=0, elements=0, shape=shape, name="EmptyMesh")
@@ -252,58 +327,8 @@
252 327
253 deallocate(quad)328 deallocate(quad)
254 deallocate(shape)329 deallocate(shape)
255330 end if
256 else if(trim(mesh_file_format)=="triangle" &331
257 .or. trim(mesh_file_format)=="gmsh") then
258 ! Get mesh dimension if present
259 call get_option(trim(mesh_path)//"/from_file/dimension", mdim, stat)
260 ! Read mesh
261 if(stat==0) then
262 position=read_mesh_files(trim(mesh_file_name), &
263 quad_degree=quad_degree, &
264 quad_family=quad_family, mdim=mdim, &
265 format=mesh_file_format)
266 else
267 position=read_mesh_files(trim(mesh_file_name), &
268 quad_degree=quad_degree, &
269 quad_family=quad_family, &
270 format=mesh_file_format)
271 end if
272 mesh=position%mesh
273 else if(trim(mesh_file_format) == "vtu") then
274 position_ptr => vtk_cache_read_positions_field(mesh_file_name)
275 ! No hybrid mesh support here
276 assert(ele_count(position_ptr) > 0)
277 dim = position_ptr%dim
278 loc = ele_loc(position_ptr, 1)
279
280 ! Generate a copy, and swap the quadrature degree
281 ! Note: Even if positions_ptr has the correct quadrature degree, it
282 ! won't have any faces and hence a copy is still required (as
283 ! add_faces is a construction routine only)
284 allocate(quad)
285 allocate(shape)
286 quad = make_quadrature(loc, dim, degree = quad_degree, family=quad_family)
287 shape = make_element_shape(loc, dim, 1, quad)
288 call allocate(mesh, nodes = node_count(position_ptr), elements = ele_count(position_ptr), shape = shape, name = position_ptr%mesh%name)
289 do j = 1, ele_count(mesh)
290 call set_ele_nodes(mesh, j, ele_nodes(position_ptr%mesh, j))
291 end do
292 call add_faces(mesh)
293 call allocate(position, dim, mesh, position_ptr%name)
294 call set(position, position_ptr)
295 call deallocate(mesh)
296 call deallocate(shape)
297 call deallocate(quad)
298 deallocate(quad)
299 deallocate(shape)
300
301 mesh = position%mesh
302 else
303 ewrite(-1,*) trim(mesh_file_format), " is not a valid format for a mesh file"
304 FLAbort("Invalid format for mesh file")
305 end if
306
307 ! if there is a derived mesh which specifies periodic bcs 332 ! if there is a derived mesh which specifies periodic bcs
308 ! to be *removed*, we assume the external mesh is periodic333 ! to be *removed*, we assume the external mesh is periodic
309 mesh%periodic = option_count("/geometry/mesh/from_mesh/&334 mesh%periodic = option_count("/geometry/mesh/from_mesh/&
310335
=== added directory 'tests/spherical_patch'
=== added file 'tests/spherical_patch/Makefile'
--- tests/spherical_patch/Makefile 1970-01-01 00:00:00 +0000
+++ tests/spherical_patch/Makefile 2012-05-16 11:01:22 +0000
@@ -0,0 +1,11 @@
1GMSH_GEO_FILE=src/spherical_segment.geo
2NPROCS=3
3input: clean
4 gmsh -2 -bin $(GMSH_GEO_FILE) -o patch.msh
5 ../../bin/fldecomp -n $(NPROCS) -s -m gmsh patch
6
7clean:
8 rm -rf *.msh *.halo *.vtu *.stat fluidity.*
9 rm -rf spherical_segment_* *.pvtu
10 rm -rf flredecomp.* matrixdump*
11
012
=== added file 'tests/spherical_patch/spherical_patch.xml'
--- tests/spherical_patch/spherical_patch.xml 1970-01-01 00:00:00 +0000
+++ tests/spherical_patch/spherical_patch.xml 2012-05-16 11:01:22 +0000
@@ -0,0 +1,47 @@
1<?xml version='1.0' encoding='utf-8'?>
2<testproblem>
3 <name>spherical patch<comment>Tests gmsh reading and writing on the sphere with 2d horizontal spherical input mesh, checkpointing and flredecomp.</comment></name>
4 <owner userid="skramer"/>
5 <problem_definition length="short" nprocs="1">
6 <command_line>mpirun -np 3 fluidity -v2 -l spherical_segment.flml &amp;&amp;
7mpirun -np 3 ../../bin/flredecomp -v -l -i 3 -o 1 spherical_segment_2_checkpoint serial &amp;&amp;
8fluidity -v2 -l serial.flml</command_line>
9 </problem_definition>
10 <variables>
11 <variable name="volume_before" language="python">from fluidity_tools import stat_parser
12stat=stat_parser('spherical_segment.stat')
13# this only works because we don't move the free surface
14# we actually compute H \int_top \eta, i.e. the volume difference with
15# equilibrium state multiplied by depth H
16volume_before=stat['Fields']['FreeSurface']['integral']</variable>
17 <variable name="volume_after" language="python">from fluidity_tools import stat_parser
18stat=stat_parser('spherical_segment_checkpoint.stat')
19# this only works because we don't move the free surface
20# we actually compute H \int_top \eta, i.e. the volume difference with
21# equilibrium state multiplied by depth H
22volume_after=stat['Fields']['FreeSurface']['integral']</variable>
23 <variable name="solvers_converged" language="python">import os
24files = os.listdir("./")
25solvers_converged = not "matrixdump" in files and not "matrixdump.info" in files</variable>
26 <variable name="max_velocity_before" language="python">from fluidity_tools import stat_parser
27stat=stat_parser('spherical_segment.stat')
28max_velocity_before=stat['Fields']['Velocity%magnitude']['max']</variable>
29 <variable name="max_velocity_after" language="python">from fluidity_tools import stat_parser
30stat=stat_parser('spherical_segment_checkpoint.stat')
31max_velocity_after=stat['Fields']['Velocity%magnitude']['max']</variable>
32 </variables>
33 <pass_tests>
34 <test name="volume_conservation_run1" language="python">from fluidity_tools import compare_variable
35compare_variable(volume_before[0], volume_before[-1], 1e-5)</test>
36 <test name="volume_conservation_run12" language="python">from fluidity_tools import compare_variable
37# compares volume at the end of first run with that of end first timestep second run
38compare_variable(volume_before[-1], volume_after[0], 1e-5)</test>
39 <test name="volume_conservation_run2" language="python">from fluidity_tools import compare_variable
40compare_variable(volume_after[0], volume_after[-1], 1e-5)</test>
41 <test name="solvers_converged" language="python">assert solvers_converged</test>
42 <test name="max_velocity_run1" language="python"># make sure we're actually doing something and not blowing up
43assert all(max_velocity_before&gt;0.01) and all(max_velocity_before&lt;0.02)</test>
44 <test name="max_velocity_run2" language="python"># make sure we're actually doing something and not blowing up
45assert all(max_velocity_after&gt;0.01) and all(max_velocity_after&lt;0.02)</test>
46 </pass_tests>
47</testproblem>
048
=== added file 'tests/spherical_patch/spherical_segment.flml'
--- tests/spherical_patch/spherical_segment.flml 1970-01-01 00:00:00 +0000
+++ tests/spherical_patch/spherical_segment.flml 2012-05-16 11:01:22 +0000
@@ -0,0 +1,502 @@
1<?xml version='1.0' encoding='utf-8'?>
2<fluidity_options>
3 <simulation_name>
4 <string_value lines="1">spherical_segment</string_value>
5 </simulation_name>
6 <problem_type>
7 <string_value lines="1">oceans</string_value>
8 </problem_type>
9 <geometry>
10 <dimension>
11 <integer_value rank="0">3</integer_value>
12 </dimension>
13 <mesh name="CoordinateMesh">
14 <from_mesh>
15 <mesh name="BaseMesh"/>
16 <mesh_shape>
17 <polynomial_degree>
18 <integer_value rank="0">2</integer_value>
19 </polynomial_degree>
20 </mesh_shape>
21 <stat>
22 <include_in_stat/>
23 </stat>
24 </from_mesh>
25 </mesh>
26 <mesh name="VelocityMesh">
27 <from_mesh>
28 <mesh name="BaseMesh"/>
29 <mesh_continuity>
30 <string_value>discontinuous</string_value>
31 </mesh_continuity>
32 <stat>
33 <exclude_from_stat/>
34 </stat>
35 </from_mesh>
36 </mesh>
37 <mesh name="PressureMesh">
38 <from_mesh>
39 <mesh name="BaseMesh"/>
40 <mesh_shape>
41 <polynomial_degree>
42 <integer_value rank="0">2</integer_value>
43 </polynomial_degree>
44 </mesh_shape>
45 <stat>
46 <exclude_from_stat/>
47 </stat>
48 </from_mesh>
49 </mesh>
50 <mesh name="InputMesh">
51 <from_file file_name="patch">
52 <format name="gmsh"/>
53 <stat>
54 <exclude_from_stat/>
55 </stat>
56 </from_file>
57 </mesh>
58 <mesh name="BaseMesh">
59 <from_mesh>
60 <mesh name="InputMesh"/>
61 <extrude>
62 <regions name="WholeMesh">
63 <bottom_depth>
64 <constant>
65 <real_value rank="0">90</real_value>
66 </constant>
67 </bottom_depth>
68 <sizing_function>
69 <constant>
70 <real_value rank="0">30</real_value>
71 </constant>
72 </sizing_function>
73 <top_surface_id>
74 <integer_value rank="0">1</integer_value>
75 </top_surface_id>
76 <bottom_surface_id>
77 <integer_value rank="0">2</integer_value>
78 </bottom_surface_id>
79 </regions>
80 </extrude>
81 <stat>
82 <include_in_stat/>
83 </stat>
84 </from_mesh>
85 </mesh>
86 <mesh name="P0Mesh">
87 <from_mesh>
88 <mesh name="BaseMesh"/>
89 <mesh_shape>
90 <polynomial_degree>
91 <integer_value rank="0">0</integer_value>
92 </polynomial_degree>
93 </mesh_shape>
94 <mesh_continuity>
95 <string_value>discontinuous</string_value>
96 </mesh_continuity>
97 <stat>
98 <exclude_from_stat/>
99 </stat>
100 </from_mesh>
101 </mesh>
102 <quadrature>
103 <degree>
104 <integer_value rank="0">4</integer_value>
105 </degree>
106 <surface_degree>
107 <integer_value rank="0">3</integer_value>
108 </surface_degree>
109 </quadrature>
110 <spherical_earth>
111 <superparametric_mapping/>
112 </spherical_earth>
113 <ocean_boundaries>
114 <top_surface_ids>
115 <integer_value shape="1" rank="1">1</integer_value>
116 </top_surface_ids>
117 <bottom_surface_ids>
118 <integer_value shape="1" rank="1">2</integer_value>
119 </bottom_surface_ids>
120 <scalar_field name="DistanceToTop" rank="0">
121 <diagnostic>
122 <algorithm name="Internal" material_phase_support="multiple"/>
123 <mesh name="CoordinateMesh"/>
124 <output/>
125 <stat/>
126 <convergence>
127 <include_in_convergence/>
128 </convergence>
129 <detectors>
130 <include_in_detectors/>
131 </detectors>
132 <steady_state>
133 <include_in_steady_state/>
134 </steady_state>
135 </diagnostic>
136 </scalar_field>
137 <scalar_field name="DistanceToBottom" rank="0">
138 <diagnostic>
139 <algorithm name="Internal" material_phase_support="multiple"/>
140 <mesh name="CoordinateMesh"/>
141 <output/>
142 <stat/>
143 <convergence>
144 <include_in_convergence/>
145 </convergence>
146 <detectors>
147 <include_in_detectors/>
148 </detectors>
149 <steady_state>
150 <include_in_steady_state/>
151 </steady_state>
152 </diagnostic>
153 </scalar_field>
154 </ocean_boundaries>
155 </geometry>
156 <io>
157 <dump_format>
158 <string_value>vtk</string_value>
159 </dump_format>
160 <dump_period>
161 <constant>
162 <real_value rank="0">0.0</real_value>
163 <comment>43200: dump results every 12 hours (0.5 days) of simulated time. Given a finish-time of 2592000 s (1 month), 60 dumps are expected. Given a time-step size of 300s, a dump every 144 time steps is expected.</comment>
164 </constant>
165 </dump_period>
166 <output_mesh name="VelocityMesh"/>
167 <checkpointing>
168 <checkpoint_period_in_dumps>
169 <integer_value rank="0">10</integer_value>
170 </checkpoint_period_in_dumps>
171 <checkpoint_at_end/>
172 </checkpointing>
173 <stat/>
174 </io>
175 <timestepping>
176 <current_time>
177 <real_value rank="0">0.0</real_value>
178 <time_units date="seconds since 1987-01-05 00:00.0"/>
179 </current_time>
180 <timestep>
181 <real_value rank="0">3600.0</real_value>
182 </timestep>
183 <finish_time>
184 <real_value rank="0">2592000</real_value>
185 <comment>(2592000)1 month, in seconds. Given a timestep size of 300 s, the simulation should perform 8640 time-steps.</comment>
186 </finish_time>
187 <final_timestep>
188 <integer_value rank="0">2</integer_value>
189 </final_timestep>
190 <nonlinear_iterations>
191 <integer_value rank="0">2</integer_value>
192 </nonlinear_iterations>
193 </timestepping>
194 <physical_parameters>
195 <gravity>
196 <magnitude>
197 <real_value rank="0">9.81</real_value>
198 </magnitude>
199 <vector_field name="GravityDirection" rank="1">
200 <prescribed>
201 <mesh name="CoordinateMesh"/>
202 <value name="WholeMesh">
203 <python>
204 <string_value lines="20" type="code" language="python">def val(X, t):
205
206 a = X[0]
207 b = X[1]
208 c = X[2]
209
210 x_component = -(a/((a**2+b**2+c**2)**0.5))
211 y_component = -(b/((a**2+b**2+c**2)**0.5))
212 z_component = -(c/((a**2+b**2+c**2)**0.5))
213
214 return [x_component, y_component, z_component]</string_value>
215 </python>
216 </value>
217 <output/>
218 <stat>
219 <include_in_stat/>
220 </stat>
221 <detectors>
222 <exclude_from_detectors/>
223 </detectors>
224 </prescribed>
225 </vector_field>
226 </gravity>
227 <coriolis>
228 <on_sphere>
229 <omega>
230 <real_value rank="0">7.27220522e-5</real_value>
231 </omega>
232 </on_sphere>
233 </coriolis>
234 </physical_parameters>
235 <material_phase name="Fields">
236 <equation_of_state>
237 <fluids>
238 <linear>
239 <reference_density>
240 <real_value rank="0">1.0</real_value>
241 </reference_density>
242 <subtract_out_hydrostatic_level/>
243 </linear>
244 </fluids>
245 </equation_of_state>
246 <scalar_field name="Pressure" rank="0">
247 <prognostic>
248 <mesh name="PressureMesh"/>
249 <spatial_discretisation>
250 <continuous_galerkin>
251 <remove_stabilisation_term/>
252 <integrate_continuity_by_parts/>
253 </continuous_galerkin>
254 </spatial_discretisation>
255 <scheme>
256 <poisson_pressure_solution>
257 <string_value lines="1">only first timestep</string_value>
258 </poisson_pressure_solution>
259 <use_projection_method/>
260 </scheme>
261 <solver>
262 <iterative_method name="cg"/>
263 <preconditioner name="mg">
264 <vertical_lumping/>
265 </preconditioner>
266 <relative_error>
267 <real_value rank="0">1.0e-8</real_value>
268 </relative_error>
269 <max_iterations>
270 <integer_value rank="0">5000</integer_value>
271 </max_iterations>
272 <never_ignore_solver_failures/>
273 <diagnostics>
274 <monitors/>
275 </diagnostics>
276 </solver>
277 <initial_condition name="WholeMesh">
278 <free_surface>
279 <python>
280 <string_value type="code" lines="20" language="python">def val(X,t):
281 from math import asin, atan2, sqrt, pi, exp
282 r=sqrt(sum([x**2 for x in X]))
283 lon=180/pi*atan2(X[1],X[0])
284 lat=180/pi*asin(X[2]/r)
285 d=(lat-52.75)**2+(lon+5.875)**2
286 return exp(-d)</string_value>
287 </python>
288 </free_surface>
289 </initial_condition>
290 <output/>
291 <stat/>
292 <convergence>
293 <include_in_convergence/>
294 </convergence>
295 <detectors>
296 <exclude_from_detectors/>
297 </detectors>
298 <steady_state>
299 <include_in_steady_state/>
300 </steady_state>
301 <consistent_interpolation/>
302 </prognostic>
303 </scalar_field>
304 <scalar_field name="Density" rank="0">
305 <diagnostic>
306 <algorithm name="Internal" material_phase_support="multiple"/>
307 <mesh name="VelocityMesh"/>
308 <output/>
309 <stat/>
310 <convergence>
311 <include_in_convergence/>
312 </convergence>
313 <detectors>
314 <include_in_detectors/>
315 </detectors>
316 <steady_state>
317 <include_in_steady_state/>
318 </steady_state>
319 </diagnostic>
320 </scalar_field>
321 <vector_field name="Velocity" rank="1">
322 <prognostic>
323 <mesh name="VelocityMesh"/>
324 <equation name="Boussinesq"/>
325 <spatial_discretisation>
326 <discontinuous_galerkin>
327 <viscosity_scheme>
328 <compact_discontinuous_galerkin/>
329 </viscosity_scheme>
330 <advection_scheme>
331 <upwind/>
332 <project_velocity_to_continuous>
333 <mesh name="BaseMesh"/>
334 </project_velocity_to_continuous>
335 <integrate_advection_by_parts>
336 <twice/>
337 </integrate_advection_by_parts>
338 </advection_scheme>
339 </discontinuous_galerkin>
340 <conservative_advection>
341 <real_value rank="0">0.0</real_value>
342 </conservative_advection>
343 </spatial_discretisation>
344 <temporal_discretisation>
345 <theta>
346 <real_value rank="0">1.0</real_value>
347 </theta>
348 <relaxation>
349 <real_value rank="0">1.0</real_value>
350 </relaxation>
351 <discontinuous_galerkin>
352 <maximum_courant_number_per_subcycle>
353 <real_value rank="0">0.1</real_value>
354 </maximum_courant_number_per_subcycle>
355 </discontinuous_galerkin>
356 </temporal_discretisation>
357 <solver>
358 <iterative_method name="gmres">
359 <restart>
360 <integer_value rank="0">30</integer_value>
361 </restart>
362 </iterative_method>
363 <preconditioner name="sor"/>
364 <relative_error>
365 <real_value rank="0">1.0e-8</real_value>
366 </relative_error>
367 <max_iterations>
368 <integer_value rank="0">10000</integer_value>
369 </max_iterations>
370 <never_ignore_solver_failures/>
371 <diagnostics>
372 <monitors/>
373 </diagnostics>
374 </solver>
375 <initial_condition name="WholeMesh">
376 <constant>
377 <real_value shape="3" dim1="dim" rank="1">0.0 0.0 0.0</real_value>
378 </constant>
379 </initial_condition>
380 <boundary_conditions name="FreeSurface">
381 <surface_ids>
382 <integer_value shape="1" rank="1">1</integer_value>
383 </surface_ids>
384 <type name="free_surface"/>
385 </boundary_conditions>
386 <boundary_conditions name="NoNormalFlow">
387 <surface_ids>
388 <integer_value shape="5" rank="1">2 1009 1010 1011 1013</integer_value>
389 </surface_ids>
390 <type name="no_normal_flow"/>
391 </boundary_conditions>
392 <tensor_field name="Viscosity" rank="2">
393 <prescribed>
394 <value name="WholeMesh">
395 <anisotropic_symmetric>
396 <python>
397 <string_value lines="20" type="code" language="python">def val(X, t):
398 a = X[0]
399 b = X[1]
400 c = X[2]
401 from math import sqrt, sin, cos, atan2, acos
402 r=sqrt(a**2+b**2+c**2)
403 #A1=2000.0
404 A1=20000.0
405 A2=A1
406 A3=1.0
407 phi=atan2(b,a)
408 theta=acos(c/r)
409 T11=A1*sin(phi)**2+A2*cos(theta)**2*cos(phi)**2+A3*sin(theta)**2*cos(phi)**2
410 T12=-A1*sin(phi)*cos(phi)+A2*cos(theta)**2*sin(phi)*cos(phi)+A3*sin(theta)**2*sin(phi)*cos(phi)
411 T13=-A2*sin(theta)*cos(theta)*cos(phi)+A3*sin(theta)*cos(theta)*cos(phi)
412 T21=T12
413 T22=A1*cos(phi)**2+A2*cos(theta)**2*sin(phi)**2+A3*sin(theta)**2*sin(phi)**2
414 T23=-A2*sin(theta)*cos(theta)*sin(phi)+A3*sin(theta)*cos(theta)*sin(phi)
415 T31=T13
416 T32=T23
417 T33=A2*sin(theta)**2+A3*cos(theta)**2
418
419 return [[T11, T12, T13],
420 [T21, T22, T23],
421 [T31, T32, T33]]</string_value>
422 </python>
423 </anisotropic_symmetric>
424 </value>
425 <output/>
426 </prescribed>
427 </tensor_field>
428 <output/>
429 <stat>
430 <include_in_stat/>
431 <previous_time_step>
432 <exclude_from_stat/>
433 </previous_time_step>
434 <nonlinear_field>
435 <exclude_from_stat/>
436 </nonlinear_field>
437 </stat>
438 <convergence>
439 <include_in_convergence/>
440 </convergence>
441 <detectors>
442 <include_in_detectors/>
443 </detectors>
444 <steady_state>
445 <include_in_steady_state/>
446 </steady_state>
447 <consistent_interpolation/>
448 </prognostic>
449 </vector_field>
450 <scalar_field name="FreeSurface" rank="0">
451 <diagnostic>
452 <algorithm name="Internal" material_phase_support="multiple"/>
453 <mesh name="PressureMesh"/>
454 <output/>
455 <stat/>
456 <convergence>
457 <include_in_convergence/>
458 </convergence>
459 <detectors>
460 <include_in_detectors/>
461 </detectors>
462 <steady_state>
463 <include_in_steady_state/>
464 </steady_state>
465 </diagnostic>
466 </scalar_field>
467 <scalar_field name="DG_CourantNumber" rank="0">
468 <diagnostic>
469 <algorithm name="Internal" material_phase_support="multiple"/>
470 <mesh name="VelocityMesh"/>
471 <output/>
472 <stat/>
473 <convergence>
474 <include_in_convergence/>
475 </convergence>
476 <detectors>
477 <include_in_detectors/>
478 </detectors>
479 <steady_state>
480 <include_in_steady_state/>
481 </steady_state>
482 </diagnostic>
483 </scalar_field>
484 <scalar_field name="Partition" rank="0">
485 <diagnostic>
486 <algorithm name="element_ownership" material_phase_support="single"/>
487 <mesh name="P0Mesh"/>
488 <output/>
489 <stat/>
490 <convergence>
491 <include_in_convergence/>
492 </convergence>
493 <detectors>
494 <include_in_detectors/>
495 </detectors>
496 <steady_state>
497 <include_in_steady_state/>
498 </steady_state>
499 </diagnostic>
500 </scalar_field>
501 </material_phase>
502</fluidity_options>
0503
=== added directory 'tests/spherical_patch/src'
=== added file 'tests/spherical_patch/src/spherical_segment.geo'
--- tests/spherical_patch/src/spherical_segment.geo 1970-01-01 00:00:00 +0000
+++ tests/spherical_patch/src/spherical_segment.geo 2012-05-16 11:01:22 +0000
@@ -0,0 +1,113 @@
1Printf("Reading function and point definitions...");
2
3Function DrawParallel
4 alpha = parallelSectionStartingY/parallelSectionStartingX;
5 parallelRadius = Sqrt(parallelSectionStartingX^2 + parallelSectionStartingY^2);
6 deltaAlpha = (parallelSectionEndingY/parallelSectionEndingX - parallelSectionStartingY/parallelSectionStartingX)/pointsOnParallel;
7 For t In {1:pointsOnParallel}
8 alpha += deltaAlpha;
9 newParallelPointX = (parallelSectionStartingX/Fabs(parallelSectionStartingX))*parallelRadius/(Sqrt(alpha^2 + 1));
10 newParallelPointY = newParallelPointX*alpha;
11 newPointOnParallel = newp; Point(newPointOnParallel) = {newParallelPointX, newParallelPointY, 0};
12 EndFor
13 BSpline(newParallelID) = {firstPointOnParallel, newPointOnParallel-(pointsOnParallel-1):newPointOnParallel, lastPointOnParallel};
14Return
15
16//The coordinates of various points on the Surface of the Earth are converted to radians
17//and stereographic coordinatesbelow.
18
19//Point A is located 2 deg 00'W, 48 deg 45'N.
20Point_A_longitude_rad = -(2 + (00/60))*(Pi/180);
21Point_A_latitude_rad = (48 + (45/60))*(Pi/180);
22Point_A_stereographic_x = -Cos(Fabs(Point_A_longitude_rad))*Cos(Fabs(Point_A_latitude_rad))/( 1 + Sin(Fabs(Point_A_latitude_rad)) );
23Point_A_stereographic_y = Cos(Fabs(Point_A_latitude_rad))*Sin(Fabs(Point_A_longitude_rad))/( 1 + Sin(Fabs(Point_A_latitude_rad)) );
24
25//Point B is located at 9 deg 46'W, 48 deg 45'N
26Point_B_longitude_rad = -(9 + (46/60))*(Pi/180);
27Point_B_latitude_rad = (48 + (45/60))*(Pi/180);
28Point_B_stereographic_x = -Cos(Fabs(Point_B_longitude_rad))*Cos(Fabs(Point_B_latitude_rad))/( 1 + Sin(Fabs(Point_B_latitude_rad)) );
29Point_B_stereographic_y = Cos(Fabs(Point_B_latitude_rad))*Sin(Fabs(Point_B_longitude_rad))/( 1 + Sin(Fabs(Point_B_latitude_rad)) );
30
31//Point C is located at 9 deg 45'W, 56 deg 45'N
32Point_C_longitude_rad = -(9 + (45/60))*(Pi/180);
33Point_C_latitude_rad = (56 + (45/60))*(Pi/180);
34Point_C_stereographic_x = -Cos(Fabs(Point_C_longitude_rad))*Cos(Fabs(Point_C_latitude_rad))/( 1 + Sin(Fabs(Point_C_latitude_rad)) );
35Point_C_stereographic_y = Cos(Fabs(Point_C_latitude_rad))*Sin(Fabs(Point_C_longitude_rad))/( 1 + Sin(Fabs(Point_C_latitude_rad)) );
36
37//Point D is located at 2 deg 00'W, 56 deg 45'N
38Point_D_longitude_rad = -(2 + (00/60))*(Pi/180);
39Point_D_latitude_rad = (56 + (45/60))*(Pi/180);
40Point_D_stereographic_x = -Cos(Fabs(Point_D_longitude_rad))*Cos(Fabs(Point_D_latitude_rad))/( 1 + Sin(Fabs(Point_D_latitude_rad)) );
41Point_D_stereographic_y = Cos(Fabs(Point_D_latitude_rad))*Sin(Fabs(Point_D_longitude_rad))/( 1 + Sin(Fabs(Point_D_latitude_rad)) );
42
43//Create point, line, line-loop surface and field ID's
44IP = newp;
45IL = newl;
46ILL = newll;
47IS = news;
48IFI = newf;
49
50//Draw a point on the centre of the earth and one on the North pole, then create a sphere using
51// these points, note that remaining points will be drawin in the stereographic projection plane.
52Point ( IP + 0 ) = {0, 0, 0 };
53Point ( IP + 1 ) = {0, 0,6.37101e+06};
54PolarSphere ( IS + 0 ) = {IP , IP+1};
55
56Printf("Creating Meridian & Parallel segments to close the domain...");
57//So far, only points on the shorelies and curves approximating shorelines have been
58//constructed. we now add points in the sea, to close the domain boundaries
59Point(IP + 60000) = {Point_A_stereographic_x, Point_A_stereographic_y, 0};
60Point(IP + 60001) = {Point_B_stereographic_x, Point_B_stereographic_y, 0};
61Point(IP + 60002) = {Point_C_stereographic_x, Point_C_stereographic_y, 0};
62Point(IP + 60003) = {Point_D_stereographic_x, Point_D_stereographic_y, 0};
63
64//Draw South-most parallel of the Domain.
65pointsOnParallel = 200; //Assign parameters to variables and then call function DrawParallel,
66parallelSectionStartingX = Point_A_stereographic_x;
67parallelSectionStartingY = Point_A_stereographic_y;
68firstPointOnParallel = IP + 60000;
69parallelSectionEndingX = Point_B_stereographic_x;
70parallelSectionEndingY = Point_B_stereographic_y;
71lastPointOnParallel = IP + 60001;
72newParallelID = IL + 1000;
73Call DrawParallel;
74
75BSpline(IL + 1001) = {IP + 60001, IP + 60002};
76BSpline(IL + 1002) = {IP + 60000, IP + 60003};
77
78////Draw North-most parallel of the Domain.
79pointsOnParallel = 200; //Assign parameters to variables and then call function DrawParallel,
80parallelSectionStartingX = Point_C_stereographic_x;
81parallelSectionStartingY = Point_C_stereographic_y;
82firstPointOnParallel = IP + 60002;
83parallelSectionEndingX = Point_D_stereographic_x;
84parallelSectionEndingY = Point_D_stereographic_y;
85lastPointOnParallel = IP + 60003;
86newParallelID = IL + 1003;
87Call DrawParallel;
88
89Printf("Declaring surface on sphere to be meshed...");
90Line Loop(1006) = {1003, -1004, -1002, -1001};
91Plane Surface(1007) = {1006};
92Physical Surface(1008) = {1007};
93
94Physical Line(1009) = {1001}; //Physical line corresponding to south-most parallel.
95Physical Line(1010) = {1002}; //Physical line corresponding to meridian segment through point A.
96Physical Line(1011) = {1003}; //Physical line corresponding to meridian segment through point B.
97Physical Line(1013) = {1004}; //Physical line corresponding to north-most parallel.
98
99Printf("Assigning characteristic mesh sizes...");
100Field[ IFI + 1] = MathEval;
101Field[ IFI + 1].F = "50000";
102
103Background Field = IFI + 1;
104
105// Dont extent the elements sizes from the boundary inside the domain
106Mesh.CharacteristicLengthExtendFromBoundary = 0;
107
108//Set some options for better png output
109General.Color.Background = {255,255,255};
110General.Color.BackgroundGradient = {255,255,255};
111General.Color.Foreground = Black;
112Mesh.Color.Lines = {0,0,0};
113
0114
=== modified file 'tools/Checkmesh.F90'
--- tools/Checkmesh.F90 2012-04-03 12:24:30 +0000
+++ tools/Checkmesh.F90 2012-05-16 11:01:22 +0000
@@ -15,7 +15,7 @@
15 use linked_lists15 use linked_lists
16 use meshdiagnostics16 use meshdiagnostics
17 use metric_tools17 use metric_tools
18 use mesh_files18 use read_triangle
19 use supermesh_construction19 use supermesh_construction
20 use tetrahedron_intersection_module20 use tetrahedron_intersection_module
21 use iso_c_binding21 use iso_c_binding
@@ -38,7 +38,7 @@
38 rformat = real_format() 38 rformat = real_format()
3939
40 print "(a)", "Reading in mesh mesh with base name " // trim(filename)40 print "(a)", "Reading in mesh mesh with base name " // trim(filename)
41 positions = read_mesh_files(filename, quad_degree = 4) 41 positions = read_triangle_files(filename, quad_degree = 4)
42 if(isparallel()) call read_halos(filename, positions)42 if(isparallel()) call read_halos(filename, positions)
43 print "(a)", "Read successful"43 print "(a)", "Read successful"
4444
4545
=== modified file 'tools/Fladapt.F90'
--- tools/Fladapt.F90 2012-04-16 12:54:50 +0000
+++ tools/Fladapt.F90 2012-05-16 11:01:22 +0000
@@ -76,6 +76,7 @@
76 type(vector_field) :: new_mesh_field76 type(vector_field) :: new_mesh_field
77 type(vector_field), pointer :: new_mesh_field_ptr, old_mesh_field77 type(vector_field), pointer :: new_mesh_field_ptr, old_mesh_field
78 type(tensor_field) :: metric, t_edge_lengths78 type(tensor_field) :: metric, t_edge_lengths
79 character(len=FIELD_NAME_LEN) :: mesh_format
7980
80 ! now turn into proper fortran strings (is there an easier way to do this?)81 ! now turn into proper fortran strings (is there an easier way to do this?)
81 do i=1, input_basename_len82 do i=1, input_basename_len
@@ -144,11 +145,10 @@
144 else145 else
145 call adapt_mesh(old_mesh_field, metric, new_mesh_field)146 call adapt_mesh(old_mesh_field, metric, new_mesh_field)
146 end if147 end if
147 old_mesh_field => null()
148 old_mesh => null()
149 148
149 call get_option(trim(old_mesh_field%mesh%option_path)//"/from_file/format/name", mesh_format)
150 ! Write the output mesh150 ! Write the output mesh
151 call write_mesh_files(output_basename, new_mesh_field)151 call write_mesh_files(output_basename, mesh_format, new_mesh_field)
152 152
153 ! Deallocate153 ! Deallocate
154 do i = 1, size(states)154 do i = 1, size(states)
@@ -183,7 +183,7 @@
183 FLAbort("External mesh field " // trim(mesh_field_name) // " not found in the system state")183 FLAbort("External mesh field " // trim(mesh_field_name) // " not found in the system state")
184 end if184 end if
185 185
186 mesh_field => extract_vector_field(state, mesh_field_name) 186 mesh_field => extract_vector_field(state, mesh_field_name)
187 187
188 end subroutine find_mesh_field_to_adapt188 end subroutine find_mesh_field_to_adapt
189 189
190190
=== modified file 'tools/periodise.F90'
--- tools/periodise.F90 2011-02-28 14:43:05 +0000
+++ tools/periodise.F90 2012-05-16 11:01:22 +0000
@@ -20,7 +20,7 @@
20 integer :: status20 integer :: status
21 type(state_type), dimension(:), pointer :: states21 type(state_type), dimension(:), pointer :: states
22 integer :: ierr22 integer :: ierr
23 character(len=FIELD_NAME_LEN) :: external_name, periodic_name23 character(len=FIELD_NAME_LEN) :: external_name, periodic_name, mesh_format
24 type(mesh_type), pointer :: periodic_mesh, external_mesh24 type(mesh_type), pointer :: periodic_mesh, external_mesh
25 type(vector_field) :: periodic_positions, external_positions25 type(vector_field) :: periodic_positions, external_positions
26 integer :: stat, i, nstates26 integer :: stat, i, nstates
@@ -83,7 +83,8 @@
8383
84 ! Dump out the periodic mesh to disk:84 ! Dump out the periodic mesh to disk:
85 new_external_filename = trim(external_filename) // '_periodic'85 new_external_filename = trim(external_filename) // '_periodic'
86 call write_mesh_files(new_external_filename, periodic_positions)86 call get_option(trim(external_mesh%option_path)//"/from_file/format/name", mesh_format)
87 call write_mesh_files(new_external_filename, mesh_format, periodic_positions)
8788
88 ! OK! Now we need to do some setting of options.89 ! OK! Now we need to do some setting of options.
89 call manipulate_options(external_mesh, trim(external_mesh%option_path), periodic_mesh, trim(periodic_mesh%option_path), new_external_filename)90 call manipulate_options(external_mesh, trim(external_mesh%option_path), periodic_mesh, trim(periodic_mesh%option_path), new_external_filename)
9091
=== modified file 'tools/project_to_continuous.F90'
--- tools/project_to_continuous.F90 2011-09-09 13:24:20 +0000
+++ tools/project_to_continuous.F90 2012-05-16 11:01:22 +0000
@@ -35,7 +35,7 @@
35 use state_module35 use state_module
36 use elements36 use elements
37 use fields37 use fields
38 use mesh_files38 use read_triangle
39 use vtk_interfaces39 use vtk_interfaces
40 use sparse_tools40 use sparse_tools
41 use fefields41 use fefields
@@ -72,7 +72,7 @@
7272
73 call vtk_read_state(vtuname, dg_state, quad_degree=6)73 call vtk_read_state(vtuname, dg_state, quad_degree=6)
74 74
75 cg_coordinate= read_mesh_files(meshname, quad_degree=6)75 cg_coordinate= read_triangle_files(meshname, quad_degree=6)
76 cg_mesh=cg_coordinate%mesh76 cg_mesh=cg_coordinate%mesh
7777
78 call allocate(lumped_mass, cg_mesh, "LumpedMass")78 call allocate(lumped_mass, cg_mesh, "LumpedMass")
7979
=== modified file 'tools/test_laplacian.F90'
--- tools/test_laplacian.F90 2010-07-02 08:26:03 +0000
+++ tools/test_laplacian.F90 2012-05-16 11:01:22 +0000
@@ -9,7 +9,7 @@
9 ! 1x1x1 cube with the boundary conditions 1 and 2 applied on the9 ! 1x1x1 cube with the boundary conditions 1 and 2 applied on the
10 ! sides of the first coordinates direction (e.g. test_laplacian.poly10 ! sides of the first coordinates direction (e.g. test_laplacian.poly
11 ! - create a mesh with 'triangle -a0.01 -e test_laplacian.poly' )11 ! - create a mesh with 'triangle -a0.01 -e test_laplacian.poly' )
12 use mesh_files12 use read_triangle
13 use fields13 use fields
14 use FEtools14 use FEtools
15 use elements15 use elements
@@ -70,7 +70,7 @@
7070
71 call read_command_line(filename, degree, quad_degree)71 call read_command_line(filename, degree, quad_degree)
7272
73 positions=read_mesh_files(filename, quad_degree=quad_degree)73 positions=read_triangle_files(filename, quad_degree=quad_degree)
7474
75 call insert(state, positions, "Coordinate")75 call insert(state, positions, "Coordinate")
7676