DAMASK with grid solvers  Revision: v2.0.3-2204-gdb1f2151
The Düsseldorf Advanced Material Simulation Kit with Grid Solvers
list.f90
Go to the documentation of this file.
1 # 1 "/home/damask_user/GitLabCI_Pipeline_4301/DAMASK/src/list.f90"
2 # 1 "<built-in>"
3 # 1 "<command-line>"
4 # 1 "/home/damask_user/GitLabCI_Pipeline_4301/DAMASK/src/list.f90"
5 !-------------------------------------------------------------------------------------------------
8 !--------------------------------------------------------------------------------------------------
9 module list
10  use prec
11  use io
12 
13  implicit none
14  private
15  type, private :: tpartitionedstring
16  character(len=:), allocatable :: val
17  integer, dimension(:), allocatable :: pos
18  end type tpartitionedstring
19 
20  type, public :: tpartitionedstringlist
21  type(tpartitionedstring) :: string
22  type(tpartitionedstringlist), pointer :: next => null()
23  contains
24  procedure :: add => add
25  procedure :: show => show
26  procedure :: free => free
27 
28  ! currently, a finalize is needed for all shapes of tPartitionedStringList.
29  ! with Fortran 2015, we can define one recursive elemental function
30  ! https://software.intel.com/en-us/forums/intel-visual-fortran-compiler-for-windows/topic/543326
31  final :: finalize, &
32  finalizearray
33 
34  procedure :: keyexists => keyexists
35  procedure :: countkeys => countkeys
36 
37  procedure :: getfloat => getfloat
38  procedure :: getint => getint
39  procedure :: getstring => getstring
40 
41  procedure :: getfloats => getfloats
42  procedure :: getints => getints
43  procedure :: getstrings => getstrings
44 
45  end type tpartitionedstringlist
46 
47 contains
48 
49 !--------------------------------------------------------------------------------------------------
54 !--------------------------------------------------------------------------------------------------
55 subroutine add(this,string)
56 
57  class(tpartitionedstringlist), target, intent(in) :: this
58  character(len=*), intent(in) :: string
59  type(tpartitionedstringlist), pointer :: new, temp
60 
61  if (io_isblank(string)) return
62 
63  allocate(new)
64  temp => this
65  do while (associated(temp%next))
66  temp => temp%next
67  enddo
68  temp%string%val = io_lc(trim(string))
69  temp%string%pos = io_stringpos(trim(string))
70  temp%next => new
71 
72 end subroutine add
73 
74 
75 !--------------------------------------------------------------------------------------------------
78 !--------------------------------------------------------------------------------------------------
79 subroutine show(this)
80 
81  class(tpartitionedstringlist), target, intent(in) :: this
82  type(tpartitionedstringlist), pointer :: item
83 
84  item => this
85  do while (associated(item%next))
86  write(6,'(a)') ' '//trim(item%string%val)
87  item => item%next
88  enddo
89 
90 end subroutine show
91 
92 
93 !--------------------------------------------------------------------------------------------------
96 !--------------------------------------------------------------------------------------------------
97 subroutine free(this)
98 
99  class(tpartitionedstringlist), intent(inout) :: this
100 
101  if(associated(this%next)) deallocate(this%next)
102 
103 end subroutine free
104 
105 
106 !--------------------------------------------------------------------------------------------------
109 !--------------------------------------------------------------------------------------------------
110 recursive subroutine finalize(this)
111 
112  type(tpartitionedstringlist), intent(inout) :: this
113 
114  if(associated(this%next)) deallocate(this%next)
115 
116 end subroutine finalize
117 
118 
119 !--------------------------------------------------------------------------------------------------
122 !--------------------------------------------------------------------------------------------------
123 subroutine finalizearray(this)
124 
125  integer :: i
126  type(tpartitionedstringlist), intent(inout), dimension(:) :: this
127  type(tpartitionedstringlist), pointer :: temp ! bug in Gfortran?
128 
129  do i=1, size(this)
130  if (associated(this(i)%next)) then
131  temp => this(i)%next
132  !deallocate(this(i)) !internal compiler error: in gfc_build_final_call, at fortran/trans.c:975
133  deallocate(temp)
134  endif
135  enddo
136 
137 end subroutine finalizearray
138 
139 
140 !--------------------------------------------------------------------------------------------------
142 !--------------------------------------------------------------------------------------------------
143 logical function keyexists(this,key)
144 
145  class(tpartitionedstringlist), target, intent(in) :: this
146  character(len=*), intent(in) :: key
147  type(tpartitionedstringlist), pointer :: item
148 
149  keyexists = .false.
150 
151  item => this
152  do while (associated(item%next) .and. .not. keyexists)
153  keyexists = trim(io_stringvalue(item%string%val,item%string%pos,1)) == trim(key)
154  item => item%next
155  enddo
156 
157 end function keyexists
158 
159 
160 !--------------------------------------------------------------------------------------------------
163 !--------------------------------------------------------------------------------------------------
164 integer function countkeys(this,key)
165 
166  class(tpartitionedstringlist), target, intent(in) :: this
167  character(len=*), intent(in) :: key
168  type(tpartitionedstringlist), pointer :: item
169 
170  countkeys = 0
171 
172  item => this
173  do while (associated(item%next))
174  if (trim(io_stringvalue(item%string%val,item%string%pos,1)) == trim(key)) &
175  countkeys = countkeys + 1
176  item => item%next
177  enddo
178 
179 end function countkeys
180 
181 
182 !--------------------------------------------------------------------------------------------------
186 !--------------------------------------------------------------------------------------------------
187 real(pReal) function getfloat(this,key,defaultVal)
188 
189  class(tpartitionedstringlist), target, intent(in) :: this
190  character(len=*), intent(in) :: key
191  real(preal), intent(in), optional :: defaultval
192  type(tpartitionedstringlist), pointer :: item
193  logical :: found
194 
195  getfloat = huge(1.0) ! suppress warning about unitialized value
196  found = present(defaultval)
197  if (found) getfloat = defaultval
198 
199  item => this
200  do while (associated(item%next))
201  if (trim(io_stringvalue(item%string%val,item%string%pos,1)) == trim(key)) then
202  found = .true.
203  if (item%string%pos(1) < 2) call io_error(143,ext_msg=key)
204  getfloat = io_floatvalue(item%string%val,item%string%pos,2)
205  endif
206  item => item%next
207  enddo
208 
209  if (.not. found) call io_error(140,ext_msg=key)
210 
211 end function getfloat
212 
213 
214 !--------------------------------------------------------------------------------------------------
218 !--------------------------------------------------------------------------------------------------
219 integer function getint(this,key,defaultVal)
220 
221  class(tpartitionedstringlist), target, intent(in) :: this
222  character(len=*), intent(in) :: key
223  integer, intent(in), optional :: defaultval
224  type(tpartitionedstringlist), pointer :: item
225  logical :: found
226 
227  getint = huge(1) ! suppress warning about unitialized value
228  found = present(defaultval)
229  if (found) getint = defaultval
230 
231  item => this
232  do while (associated(item%next))
233  if (trim(io_stringvalue(item%string%val,item%string%pos,1)) == trim(key)) then
234  found = .true.
235  if (item%string%pos(1) < 2) call io_error(143,ext_msg=key)
236  getint = io_intvalue(item%string%val,item%string%pos,2)
237  endif
238  item => item%next
239  enddo
240 
241  if (.not. found) call io_error(140,ext_msg=key)
242 
243 end function getint
244 
245 
246 !--------------------------------------------------------------------------------------------------
251 !--------------------------------------------------------------------------------------------------
252 character(len=pStringLen) function getstring(this,key,defaultVal,raw)
253 
254  class(tpartitionedstringlist), target, intent(in) :: this
255  character(len=*), intent(in) :: key
256  character(len=*), intent(in), optional :: defaultval
257  logical, intent(in), optional :: raw
258  type(tpartitionedstringlist), pointer :: item
259  logical :: found, &
260  whole
261  if (present(raw)) then
262  whole = raw
263  else
264  whole = .false.
265  endif
266 
267  found = present(defaultval)
268  if (found) then
269  if (len_trim(defaultval) > len(getstring)) call io_error(0,ext_msg='getString')
270  getstring = trim(defaultval)
271  endif
272 
273  item => this
274  do while (associated(item%next))
275  if (trim(io_stringvalue(item%string%val,item%string%pos,1)) == trim(key)) then
276  found = .true.
277  if (item%string%pos(1) < 2) call io_error(143,ext_msg=key)
278 
279  if (whole) then
280  getstring = trim(item%string%val(item%string%pos(4):)) ! raw string starting a second chunk
281  else
282  getstring = io_stringvalue(item%string%val,item%string%pos,2)
283  endif
284  endif
285  item => item%next
286  enddo
287 
288  if (.not. found) call io_error(140,ext_msg=key)
289 
290 end function getstring
291 
292 
293 !--------------------------------------------------------------------------------------------------
297 !--------------------------------------------------------------------------------------------------
298 function getfloats(this,key,defaultVal,requiredSize)
299 
300  real(preal), dimension(:), allocatable :: getfloats
301  class(tpartitionedstringlist), target, intent(in) :: this
302  character(len=*), intent(in) :: key
303  real(preal), dimension(:), intent(in), optional :: defaultval
304  integer, intent(in), optional :: requiredsize
305  type(tpartitionedstringlist), pointer :: item
306  integer :: i
307  logical :: found, &
308  cumulative
309 
310  cumulative = (key(1:1) == '(' .and. key(len_trim(key):len_trim(key)) == ')')
311  found = .false.
312 
313  allocate(getfloats(0))
314 
315  item => this
316  do while (associated(item%next))
317  if (trim(io_stringvalue(item%string%val,item%string%pos,1)) == trim(key)) then
318  found = .true.
319  if (.not. cumulative) getfloats = [real(preal)::]
320  if (item%string%pos(1) < 2) call io_error(143,ext_msg=key)
321  do i = 2, item%string%pos(1)
322  getfloats = [getfloats,io_floatvalue(item%string%val,item%string%pos,i)]
323  enddo
324  endif
325  item => item%next
326  enddo
327 
328  if (.not. found) then
329  if (present(defaultval)) then; getfloats = defaultval; else; call io_error(140,ext_msg=key); endif
330  endif
331  if (present(requiredsize)) then
332  if(requiredsize /= size(getfloats)) call io_error(146,ext_msg=key)
333  endif
334 
335 end function getfloats
336 
337 
338 !--------------------------------------------------------------------------------------------------
342 !--------------------------------------------------------------------------------------------------
343 function getints(this,key,defaultVal,requiredSize)
344 
345  integer, dimension(:), allocatable :: getints
346  class(tpartitionedstringlist), target, intent(in) :: this
347  character(len=*), intent(in) :: key
348  integer, dimension(:), intent(in), optional :: defaultval
349  integer, intent(in), optional :: requiredsize
350  type(tpartitionedstringlist), pointer :: item
351  integer :: i
352  logical :: found, &
353  cumulative
354 
355  cumulative = (key(1:1) == '(' .and. key(len_trim(key):len_trim(key)) == ')')
356  found = .false.
357 
358  allocate(getints(0))
359 
360  item => this
361  do while (associated(item%next))
362  if (trim(io_stringvalue(item%string%val,item%string%pos,1)) == trim(key)) then
363  found = .true.
364  if (.not. cumulative) getints = [integer::]
365  if (item%string%pos(1) < 2) call io_error(143,ext_msg=key)
366  do i = 2, item%string%pos(1)
367  getints = [getints,io_intvalue(item%string%val,item%string%pos,i)]
368  enddo
369  endif
370  item => item%next
371  enddo
372 
373  if (.not. found) then
374  if (present(defaultval)) then; getints = defaultval; else; call io_error(140,ext_msg=key); endif
375  endif
376  if (present(requiredsize)) then
377  if(requiredsize /= size(getints)) call io_error(146,ext_msg=key)
378  endif
379 
380 end function getints
381 
382 
383 !--------------------------------------------------------------------------------------------------
388 !--------------------------------------------------------------------------------------------------
389 function getstrings(this,key,defaultVal,raw)
390 
391  character(len=pStringLen),dimension(:), allocatable :: getstrings
392  class(tpartitionedstringlist),target, intent(in) :: this
393  character(len=*), intent(in) :: key
394  character(len=*), dimension(:), intent(in), optional :: defaultval
395  logical, intent(in), optional :: raw
396  type(tpartitionedstringlist), pointer :: item
397  character(len=pStringLen) :: str
398  integer :: i
399  logical :: found, &
400  whole, &
401  cumulative
402 
403  cumulative = (key(1:1) == '(' .and. key(len_trim(key):len_trim(key)) == ')')
404  if (present(raw)) then
405  whole = raw
406  else
407  whole = .false.
408  endif
409  found = .false.
410 
411  item => this
412  do while (associated(item%next))
413  if (trim(io_stringvalue(item%string%val,item%string%pos,1)) == trim(key)) then
414  found = .true.
415  if (allocated(getstrings) .and. .not. cumulative) deallocate(getstrings)
416  if (item%string%pos(1) < 2) call io_error(143,ext_msg=key)
417 
418  notallocated: if (.not. allocated(getstrings)) then
419  if (whole) then
420  str = item%string%val(item%string%pos(4):)
421  getstrings = [str]
422  else
423  str = io_stringvalue(item%string%val,item%string%pos,2)
424  allocate(getstrings(1),source=str)
425  do i=3,item%string%pos(1)
426  str = io_stringvalue(item%string%val,item%string%pos,i)
427  getstrings = [getstrings,str]
428  enddo
429  endif
430  else notallocated
431  if (whole) then
432  str = item%string%val(item%string%pos(4):)
433  getstrings = [getstrings,str]
434  else
435  do i=2,item%string%pos(1)
436  str = io_stringvalue(item%string%val,item%string%pos,i)
437  getstrings = [getstrings,str]
438  enddo
439  endif
440  endif notallocated
441  endif
442  item => item%next
443  enddo
444 
445  if (.not. found) then
446  if (present(defaultval)) then
447  if (len(defaultval) > len(getstrings)) call io_error(0,ext_msg='getStrings')
448  getstrings = defaultval
449  else
450  call io_error(140,ext_msg=key)
451  endif
452  endif
453 
454 end function getstrings
455 
456 
457 end module list
list::add
subroutine add(this, string)
add element
Definition: list.f90:56
io::io_stringpos
pure integer function, dimension(:), allocatable, public io_stringpos(string)
locates all whitespace-separated chunks in given string and returns array containing number them and ...
Definition: IO.f90:204
list::show
subroutine show(this)
prints all elements
Definition: list.f90:80
io::io_error
subroutine, public io_error(error_ID, el, ip, g, instance, ext_msg)
write error statements to standard out and terminate the Marc/spectral run with exit #9xxx
Definition: IO.f90:305
list::free
subroutine free(this)
empties list and frees associated memory
Definition: list.f90:98
list::getstrings
character(len=pstringlen) function, dimension(:), allocatable getstrings(this, key, defaultVal, raw)
gets array of string values of for a given key from a linked list
Definition: list.f90:390
list::getints
integer function, dimension(:), allocatable getints(this, key, defaultVal, requiredSize)
gets array of integer values of for a given key from a linked list
Definition: list.f90:344
list::getint
integer function getint(this, key, defaultVal)
gets integer value of for a given key from a linked list
Definition: list.f90:220
list::countkeys
integer function countkeys(this, key)
count number of key appearances
Definition: list.f90:165
list::getfloats
real(preal) function, dimension(:), allocatable getfloats(this, key, defaultVal, requiredSize)
gets array of float values of for a given key from a linked list
Definition: list.f90:299
list::finalize
recursive subroutine finalize(this)
empties list and frees associated memory
Definition: list.f90:111
prec
setting precision for real and int type
Definition: prec.f90:13
list::keyexists
logical function keyexists(this, key)
reports wether a given key (string value at first position) exists in the list
Definition: list.f90:144
list::tpartitionedstring
Definition: list.f90:15
io
input/output functions, partly depending on chosen solver
Definition: IO.f90:12
prec::preal
integer, parameter preal
number with 15 significant digits, up to 1e+-307 (typically 64 bit)
Definition: prec.f90:20
io::io_isblank
logical pure function, public io_isblank(string)
identifies strings without content
Definition: IO.f90:160
list::tpartitionedstringlist
Definition: list.f90:20
list
linked list
Definition: list.f90:9
list::finalizearray
subroutine finalizearray(this)
cleans entire array of linke lists
Definition: list.f90:124
io::io_intvalue
integer function, public io_intvalue(string, chunkPos, myChunk)
reads integer value at myChunk from string
Definition: IO.f90:252
io::io_lc
pure character(len=len(string)) function, public io_lc(string)
changes characters in string to lower case
Definition: IO.f90:280
io::io_stringvalue
character(len=:) function, allocatable, public io_stringvalue(string, chunkPos, myChunk)
reads string value at myChunk from string
Definition: IO.f90:232
list::getstring
character(len=pstringlen) function getstring(this, key, defaultVal, raw)
gets string value of for a given key from a linked list
Definition: list.f90:253
io::io_floatvalue
real(preal) function, public io_floatvalue(string, chunkPos, myChunk)
reads float value at myChunk from string
Definition: IO.f90:266
list::getfloat
real(preal) function getfloat(this, key, defaultVal)
gets float value of for a given key from a linked list
Definition: list.f90:188