36 use,
intrinsic :: iso_fortran_env, only: error_unit, output_unit
58 character(len=*),
intent(in) :: fname
60 suffix_pos = scan(trim(fname),
'.', back = .true.)
65 character(len=*),
intent(in) :: fname
67 tslash_pos = scan(trim(fname),
'/', back = .true.)
72 character(len=*),
intent(in) :: fname
73 character(len=*),
intent(out) :: path
77 if (tslash_pos .gt. 0)
then
78 path = trim(fname(1:tslash_pos))
87 character(len=*),
intent(in) :: fname
88 character(len=*),
intent(out) :: name
89 integer :: tslash_pos, suffix_pos, start, end
93 if (tslash_pos .eq. 0)
then
96 start = tslash_pos + 1
98 if (suffix_pos .eq. 0)
then
103 name = trim(fname(start:
end))
108 character(len=*) :: fname
109 character(len=*) :: suffix
115 character(len=*),
intent(in) :: fname
116 character(len=*),
intent(out) :: path, name, suffix
117 integer :: tslash_pos, suffix_pos
122 if (tslash_pos .gt. 0)
then
123 path = trim(fname(1:tslash_pos))
128 if (suffix_pos .gt. 0)
then
129 name = trim(fname(tslash_pos + 1:suffix_pos - 1))
130 suffix = trim(fname(suffix_pos:len_trim(fname)))
132 name = trim(fname(tslash_pos + 1:len_trim(fname)))
140 character(len=*) :: fname
141 character(len=*) :: new_fname
142 character(len=*) :: new_suffix
143 integer :: suffix_pos
146 new_fname = trim(fname(1:suffix_pos))//new_suffix
157 character(len=*),
intent(in) :: fld_filename
158 integer,
intent(in) :: default_index
160 character(len=80) :: suffix
161 integer :: index, fpos, i
170 index = default_index
175 fpos = scan(trim(suffix),
'f')
176 if (fpos .eq. 1)
then
178 do i = 2, len(trim(suffix))
179 if (.not. (iachar(suffix(i:i)) >= iachar(
'0') &
180 .and. iachar(suffix(i:i)) <= iachar(
'9')))
then
189 if (len(trim(suffix)) .ne. 6) valid = .false.
191 if (valid)
read (suffix(2:),
"(I5.5)") index
199 character(len=*) :: string
200 character(len=*) :: delimiter
201 character(len=100),
allocatable :: split_str(:)
202 integer :: length, i, i2, offset, j
206 if (len(trim(string)) .eq. 0)
then
207 allocate(split_str(1))
208 split_str(1) = trim(string)
212 i = scan(string(offset:), delimiter, back = .false.)
218 allocate(split_str(length))
223 i2 = scan(trim(string(offset:)), delimiter, back = .false.)
225 split_str(j) = trim(string(offset:))
228 split_str(j) = trim(string(offset:offset+i2-2))
237 integer,
intent(in) :: i, j, k, l, lx, ly, lz
240 index = (i + lx * ((j - 1) + ly * ((k - 1) + lz * ((l - 1)))))
250 index(4) = lin_idx/(lx*ly*lz)
251 index(3) = (lin_idx-(lx*ly*lz)*index(4))/(lx*ly)
252 index(2) = (lin_idx-(lx*ly*lz)*index(4)-(lx*ly)*index(3))/lx
253 index(1) = (lin_idx-(lx*ly*lz)*index(4)-(lx*ly)*index(3)-lx*index(2))
254 index(1) = index(1) + 1
255 index(2) = index(2) + 1
256 index(3) = index(3) + 1
257 index(4) = index(4) + 1
262 integer,
intent(in) :: i, j, k, lx, ly, lz, facet
268 if (i .eq. 1) is_on = .true.
270 if (i .eq. lx) is_on = .true.
272 if (j .eq. 1) is_on = .true.
274 if (j .eq. ly) is_on = .true.
276 if (k .eq. 1) is_on = .true.
278 if (k .eq. lz) is_on = .true.
286 integer,
optional :: error_code
288 if (
present(error_code))
then
289 write(error_unit, *)
'*** ERROR ***', error_code
292 write(error_unit, *)
'*** ERROR ***'
301 character(len=*) :: error_msg
302 write(error_unit, *)
'*** ERROR: ', error_msg,
' ***'
313 character(len=*),
intent(in) :: base_type
314 character(len=*),
intent(in) :: wrong_type
315 character(len=*),
intent(in) :: known_types(:)
318 write(error_unit, *)
'*** ERROR WHEN SELECTING TYPE ***'
319 write(error_unit, *)
'Type ', wrong_type,
' does not exist for ', base_type
320 write(error_unit, *)
'Valid types are:'
321 do i = 1,
size(known_types)
322 write(error_unit, *)
" ", known_types(i)
328 character(len=*),
intent(in) :: base_type
329 character(len=*),
intent(in) :: wrong_type
330 logical,
intent(in) :: known
332 write(error_unit, *)
'*** ERROR WHEN REGISTERING TYPE ***'
333 write(error_unit, *)
'Type name ', wrong_type, &
334 ' conflicts with and already existing ', base_type,
" type"
336 write(error_unit, *)
'Please rename your custom type.'
338 write(error_unit, *)
'The already existing type is also custom.' // &
339 ' Make all custom type names unique!'
346 character(len=*) :: warning_msg
347 write(output_unit, *)
'*** WARNING: ', warning_msg,
' ***'
356 character(len=*),
intent(in) :: array(:)
357 character(len=*),
intent(in) :: sep
358 logical,
intent(in) :: prepend
359 character(:),
allocatable :: result
362 result = trim(array(1))
363 do i = 2,
size(array)
364 result = result // sep // trim(array(i))
367 if (prepend .eqv. .true.)
then
368 result = sep // result
__inline__ __device__ void nonlinear_index(const int idx, const int lx, int *index)
integer function, public extract_fld_file_index(fld_filename, default_index)
Extracts the index of a field file. For example, "myfield.f00045" will return 45. If the suffix of th...
character(:) function, allocatable, public concat_string_array(array, sep, prepend)
Concatenate an array of strings into one string with array items separated by spaces.
subroutine, public neko_type_registration_error(base_type, wrong_type, known)
subroutine, public filename_name(fname, name)
Extract the base name of a file (without path and suffix)
character(len=100) function, dimension(:), allocatable, public split_string(string, delimiter)
Split a string based on delimiter (tokenizer) OBS: very hacky, this should really be improved,...
pure logical function, public index_is_on_facet(i, j, k, lx, ly, lz, facet)
subroutine neko_error_msg(error_msg)
Reports an error and stops execution.
pure integer function, public linear_index(i, j, k, l, lx, ly, lz)
Compute the address of a (i,j,k,l) array with sizes (1:lx, 1:ly, 1:lz, :)
integer, parameter, public neko_fname_len
subroutine filename_split(fname, path, name, suffix)
Extract file name components.
subroutine, public neko_warning(warning_msg)
Reports a warning to standard output.
subroutine, public filename_chsuffix(fname, new_fname, new_suffix)
Change a filename's suffix.
subroutine, public filename_suffix(fname, suffix)
Extract a filename's suffix.
subroutine, public neko_type_error(base_type, wrong_type, known_types)
Reports an error allocating a type for a particular base pointer class.
pure integer function, public filename_tslash_pos(fname)
Find position (in the string) of a filename's trailing slash.
subroutine neko_error_plain(error_code)
Reports an error and stops execution.
pure integer function, public filename_suffix_pos(fname)
Find position (in the string) of a filename's suffix.
subroutine, public filename_path(fname, path)
Extract the path to a file.