1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
|
! Copyright (C) 2006 Imperial College London and others.
!
! Please see the AUTHORS file in the main source directory for a full list
! of copyright holders.
!
! Prof. C Pain
! Applied Modelling and Computation Group
! Department of Earth Science and Engineering
! Imperial College London
!
! amcgsoftware@imperial.ac.uk
!
! This library is free software; you can redistribute it and/or
! modify it under the terms of the GNU Lesser General Public
! License as published by the Free Software Foundation,
! version 2.1 of the License.
!
! This library 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
! Lesser General Public License for more details.
!
! You should have received a copy of the GNU Lesser General Public
! License along with this library; if not, write to the Free Software
! Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
! USA
#include "fdebug.h"
subroutine fladapt(input_basename, input_basename_len, &
& output_basename, output_basename_len)
!!< Peforms a mesh adapt based on the supplied input options file.
!!< Outputs the resulting mesh.
use adapt_state_module
use diagnostic_fields_wrapper
use diagnostic_fields_new, only : &
& calculate_diagnostic_variables_new => calculate_diagnostic_variables
use edge_length_module
use field_options
use fields
use fldebug
use limit_metric_module
use metric_assemble
use populate_state_module
use reference_counting
use spud
use state_module
use vtk_interfaces
use mesh_files
use populate_state_module
interface
subroutine check_options()
end subroutine check_options
#ifdef HAVE_PYTHON
subroutine python_init()
end subroutine python_init
#endif
end interface
integer :: input_basename_len
integer :: output_basename_len
character(len = input_basename_len), intent(in) :: input_basename
character(len = output_basename_len), intent(in) :: output_basename
integer :: i
type(mesh_type), pointer :: old_mesh
type(state_type), dimension(:), pointer :: states
type(vector_field) :: new_mesh_field
type(vector_field), pointer :: new_mesh_field_ptr, old_mesh_field
type(tensor_field) :: metric, t_edge_lengths
ewrite(1, *) "In fladapt"
#ifdef HAVE_PYTHON
call python_init()
#endif
ewrite(2, *) "Input base name: " // trim(input_basename)
ewrite(2, *) "Output base name: " // trim(output_basename)
! Load the options tree
call load_options(trim(input_basename) // ".flml")
if(.not. have_option("/simulation_name")) then
FLExit("Failed to find simulation name after loading options file")
end if
if(debug_level() >= 1) then
ewrite(1, *) "Options tree:"
call print_options()
end if
#ifdef DDEBUG
ewrite(1, *) "Performing options sanity check"
call check_options()
ewrite(1, *) "Options sanity check successful"
#endif
! Populate the system state
call populate_state(states)
! Calculate diagnostic fields
call calculate_diagnostic_variables(states)
call calculate_diagnostic_variables_new(states)
! Find the external mesh field
!call find_mesh_field_to_adapt(states(1), old_mesh_field)
old_mesh_field => extract_vector_field(states(1), "Coordinate")
old_mesh => old_mesh_field%mesh
! Assemble the error metric
call allocate(metric, old_mesh, "ErrorMetric")
call assemble_metric(states, metric)
ewrite(0, *) "Expected nodes = ", expected_nodes(old_mesh_field, metric)
call allocate(t_edge_lengths, metric%mesh, "TensorEdgeLengths")
call get_edge_lengths(metric, t_edge_lengths)
call vtk_write_fields(trim(output_basename) // "EdgeLengths", position = old_mesh_field, model = metric%mesh, &
& tfields = (/t_edge_lengths, metric/))
call deallocate(t_edge_lengths)
! Adapt the mesh
call allocate_metric_limits(states(1))
if(isparallel()) then
call adapt_state(states, metric)
call find_mesh_field_to_adapt(states(1), new_mesh_field_ptr)
new_mesh_field = new_mesh_field_ptr
call incref(new_mesh_field)
new_mesh_field_ptr => null()
else
call adapt_mesh(old_mesh_field, metric, new_mesh_field)
end if
old_mesh_field => null()
old_mesh => null()
! Write the output mesh
call write_mesh_files(output_basename, new_mesh_field)
! Deallocate
do i = 1, size(states)
call deallocate(states(i))
end do
call deallocate(metric)
call deallocate(new_mesh_field)
call print_references(0)
ewrite(1, *) "Exiting fladapt"
contains
subroutine find_mesh_field_to_adapt(state, mesh_field)
!!< Find the external mesh field to be used by adaptivity
type(state_type), intent(in) :: state
type(vector_field), pointer :: mesh_field
character(len = FIELD_NAME_LEN) :: mesh_field_name
type(mesh_type), pointer :: mesh
call find_mesh_to_adapt(state, mesh)
if(trim(mesh%name) == "CoordinateMesh") then
mesh_field_name = "Coordinate"
else
mesh_field_name = trim(mesh%name) // "Coordinate"
end if
if(.not. has_vector_field(state, mesh_field_name)) then
FLAbort("External mesh field " // trim(mesh_field_name) // " not found in the system state")
end if
mesh_field => extract_vector_field(state, mesh_field_name)
end subroutine find_mesh_field_to_adapt
end subroutine fladapt
|