72 class(*),
target,
intent(inout) :: data
73 type(
mesh_t),
pointer :: msh
74 real(kind=
dp),
pointer :: params(:)
75 character(len=3),
pointer :: cbc(:,:)
76 integer,
allocatable :: curve_type(:,:)
77 logical,
allocatable :: curve_element(:)
78 character(len=1) :: chtemp
79 integer :: ndim, nparam, nskip, nlogic, ncurve
80 integer :: nelgs, nelgv, i, j, ierr, l
81 integer :: el_idx, pt_idx
82 logical :: read_param, read_bcs, read_map
83 real(kind=
dp) :: xc(8), yc(8), zc(8),
curve(5)
84 real(kind=
dp),
allocatable :: bc_data(:,:,:)
85 real(kind=
dp),
allocatable :: curve_data(:,:,:)
89 character(len=1024) :: re2_fname, map_fname
90 integer :: start_el, end_el, nel, edge
94 integer :: sym_facet, pids(4), p_el_idx, p_facet
96 integer,
parameter,
dimension(6) :: facet_map = (/3, 2, 4, 1, 5, 6/)
97 logical :: curve_skip = .false.
98 character(len=LOG_SIZE) :: log_buf
100 integer :: user_labeled_zones(NEKO_MSH_MAX_ZLBLS)
101 integer :: labeled_zone_offsets(NEKO_MSH_MAX_ZLBLS)
102 integer :: total_labeled_zone_offset, current_internal_zone
103 total_labeled_zone_offset = 0
104 labeled_zone_offsets = 0
105 user_labeled_zones = 0
106 current_internal_zone = 1
113 params => data%params
125 if (read_param .and. read_bcs .and.
pe_size .gt. 1)
then
126 call neko_error(
'Reading NEKTON session data only implemented in serial')
130 open(unit=9,
file=trim(this%fname), status=
'old', iostat=ierr)
131 call neko_log%message(
'Reading NEKTON file ' // this%fname)
138 if (.not. read_param)
then
144 allocate(params(nparam))
165 read(9, *) nelgs,ndim, nelgv
166 if (nelgs .lt. 0)
then
167 re2_fname = trim(this%fname(1:scan(trim(this%fname), &
168 '.', back=.true.)))//
're2'
172 write(log_buf,1) ndim, nelgv
173 1
format(
'gdim = ', i1,
', nelements =', i7)
177 inquire(
file=map_fname, exist=read_map)
183 call neko_log%warning(
'No NEKTON map file found')
188 nel = dist%num_local()
189 start_el = dist%start_idx() + 1
190 end_el = dist%end_idx() + 1
192 call msh%init(ndim, dist)
194 call htp%init(2**ndim * nel, ndim)
200 if (ndim .eq. 2)
then
201 read(9, *) (xc(j),j=1,4)
202 read(9, *) (yc(j),j=1,4)
203 if (i .ge. start_el .and. i .le. end_el)
then
209 call msh%add_element(el_idx, p(1), p(2), p(4), p(3))
211 else if (ndim .eq. 3)
then
212 read(9, *) (xc(j),j=1,4)
213 read(9, *) (yc(j),j=1,4)
214 read(9, *) (zc(j),j=1,4)
215 read(9, *) (xc(j),j=5,8)
216 read(9, *) (yc(j),j=5,8)
217 read(9, *) (zc(j),j=5,8)
218 if (i .ge. start_el .and. i .le. end_el)
then
224 call msh%add_element(el_idx, &
225 p(1), p(2), p(4), p(3), p(5), p(6), p(8), p(7))
228 if (i .ge. start_el .and. i .le. end_el)
then
237 allocate(curve_data(5,8,nelgv))
238 allocate(curve_element(nelgv))
239 allocate(curve_type(8,nelgv))
241 curve_element(i) = .false.
245 curve_data(l,j,i) = 0d0
250 read(9, *) edge, el_idx, (
curve(j),j=1,5), chtemp
252 curve_data(j,edge,el_idx) =
curve(j)
254 curve_element(el_idx) = .true.
255 select case(trim(chtemp))
257 curve_type(edge,el_idx) = 1
260 curve_type(edge,el_idx) = 2
263 curve_type(edge,el_idx) = 3
265 curve_type(edge,el_idx) = 4
269 call neko_log%warning(
'Curve type: s, e are not supported, treating mesh as non-curved.')
272 if (curve_element(el_idx))
then
273 call msh%mark_curve_element(el_idx, &
274 curve_data(1,1,el_idx), curve_type(1,el_idx))
278 deallocate(curve_data)
279 deallocate(curve_element)
280 deallocate(curve_type)
285 if (.not. read_bcs)
then
287 allocate(cbc(6,nelgv))
288 allocate(bc_data(6,2*ndim,nelgv))
291 if (nelgv .lt. 1000) off = 1
293 if (i .ge. start_el .and. i .le. end_el)
then
294 el_idx = i - start_el + 1
296 read(9, *) cbc(j, i), (bc_data(l,j,i),l=1,6)
297 sym_facet = facet_map(j)
299 select case(trim(cbc(j,i)))
303 current_internal_zone = current_internal_zone + 1
316 current_internal_zone = current_internal_zone + 1
328 current_internal_zone = current_internal_zone + 1
340 current_internal_zone = current_internal_zone + 1
352 current_internal_zone = current_internal_zone + 1
361 case (
's',
'sl',
'sh',
'shl',
'S',
'SL',
'SH',
'SHL')
364 current_internal_zone = current_internal_zone + 1
374 p_el_idx = int(bc_data(2+off,j,i))
375 p_facet = facet_map(int(bc_data(3+off,j,i)))
376 call msh%get_facet_ids(sym_facet, el_idx, pids)
377 call msh%mark_periodic_facet(sym_facet, el_idx, &
378 p_facet, p_el_idx, pids)
385 if (i .ge. start_el .and. i .le. end_el)
then
386 el_idx = i - start_el + 1
388 sym_facet = facet_map(j)
389 select case(trim(cbc(j,i)))
391 p_el_idx = int(bc_data(2+off,j,i))
392 p_facet = facet_map(int(bc_data(3+off,j,i)))
393 call msh%create_periodic_ids(sym_facet, el_idx, &
400 if (i .ge. start_el .and. i .le. end_el)
then
401 el_idx = i - start_el + 1
403 sym_facet = facet_map(j)
404 select case(trim(cbc(j,i)))
406 p_el_idx = int(bc_data(2+off,j,i))
407 p_facet = facet_map(int(bc_data(3+off,j,i)))
408 call msh%create_periodic_ids(sym_facet, el_idx, &
415 if (i .ge. start_el .and. i .le. end_el)
then
416 el_idx = i - start_el + 1
418 sym_facet = facet_map(j)
419 select case(trim(cbc(j,i)))
421 p_el_idx = int(bc_data(2+off,j,i))
422 p_facet = facet_map(int(bc_data(3+off,j,i)))
423 call msh%create_periodic_ids(sym_facet, el_idx, &
432 allocate(cbc(6,nelgv))
435 read(9,
'(a1, a3)') chtemp, cbc(j, i)
450 class(*),
target,
intent(in) :: data
451 real(kind=
rp),
intent(in),
optional :: t
456 type(
point_t),
intent(inout) :: p
457 integer,
intent(inout) :: idx
460 if (htp%get(p, tmp) .gt. 0)
then
481 type(
mesh_t),
intent(inout) :: msh
482 integer,
intent(in) :: el_idx
483 integer,
intent(in) :: facet
484 character(len=*),
intent(in) :: type
485 integer,
intent(in) :: label
486 integer,
intent(in) :: offset
487 logical,
intent(in) :: print_info
489 integer :: mark_label
490 character(len=LOG_SIZE) :: log_buf
492 mark_label = offset + label
495 call neko_error(
"You have reached the maximum amount of allowed labeled&
496 & zones (max allowed: 20). This happened when converting re2 internal labels&
497 & like e.g. 'w', 'V' or 'o' to labeled zones. Please reduce the number of&
498 & labeled zones that you have defined or make sure that they are labeled&
503 write (log_buf,
"(A3,A,I2)") trim(type),
" => Labeled index ", mark_label
506 call msh%mark_labeled_facet(facet, el_idx, mark_label)
type(mpi_comm) neko_comm
MPI communicator.
integer pe_size
MPI size of communicator.
Defines a domain as a subset of facets in a mesh.
Defines practical data distributions.
Module for file I/O operations.
Implements a hash table ADT.
integer, parameter, public neko_log_debug
Debug log level.
type(log_t), public neko_log
Global log stream.
integer, parameter, public neko_msh_max_zlbls
Max num. zone labels.
integer, parameter, public dp
integer, parameter, public rp
Global precision used in computations.
NEKTON mesh data in re2 format.
NEKTON session data reader.
integer, public neko_shl_bc_label
integer, public neko_o_bc_label
subroutine rea_file_read(this, data)
Load NEKTON session data from an ascii file.
integer, public neko_w_bc_label
integer, public neko_v_bc_label
integer, public neko_on_bc_label
subroutine rea_file_add_point(htp, p, idx)
integer, public neko_sym_bc_label
subroutine rea_file_write(this, data, t)
subroutine rea_file_mark_labeled_bc(msh, el_idx, facet, type, label, offset, print_info)
Mark a labeled zone based on an offset.
subroutine, public rea_free(r)
Free a NEKTON session data.
subroutine, public filename_chsuffix(fname, new_fname, new_suffix)
Change a filename's suffix.
Load-balanced linear distribution .
Interface for NEKTON map files.
A point in with coordinates .
Interface for NEKTON re2 files.
NEKTON session data struct.
Interface for NEKTON ascii files.