FLASH-X
Doxygen Generated Documentation From Interface Source Code
nameValueLL_data.F90
Go to the documentation of this file.
1!! NOTICE
2!! Copyright 2022 UChicago Argonne, LLC and contributors
3!!
4!! Licensed under the Apache License, Version 2.0 (the "License");
5!! you may not use this file except in compliance with the License.
6!!
7!! Unless required by applicable law or agreed to in writing, software
8!! distributed under the License is distributed on an "AS IS" BASIS,
9!! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
10!! See the License for the specific language governing permissions and
11!! limitations under the License.
12!!
23
25
26#include "constants.h"
27
28 integer, parameter :: NUM_MAX_RULES = 10
29
30 type real_list_type
31 character(len=MAX_STRING_LENGTH) :: name
32 real :: value
33 real :: initValue
34 logical :: isConstant
35 integer :: numValues
36 real, dimension(:),pointer :: minValues
37 real, dimension(:),pointer :: maxValues
38 type (real_list_type), pointer :: next
39 end type real_list_type
40
41 type int_list_type
42 character(len=MAX_STRING_LENGTH) :: name
43 integer :: value
44 integer :: initValue
45 logical :: isConstant
46 integer :: numValues
47 integer, dimension(:),pointer :: minValues
48 integer, dimension(:),pointer :: maxValues
49 type (int_list_type), pointer :: next
50 end type int_list_type
51
52 type str_list_type
53 character(len=MAX_STRING_LENGTH) :: name
54 character(len=MAX_STRING_LENGTH) :: value
55 character(len=MAX_STRING_LENGTH) :: initValue
56 logical :: isConstant
57 integer :: numValues
58 character(len=MAX_STRING_LENGTH), &
59 & dimension(:),pointer :: validValues
60 type (str_list_type), pointer :: next
61 end type str_list_type
62
63 type log_list_type
64 character(len=MAX_STRING_LENGTH) :: name
65 logical :: value
66 logical :: initValue
67 logical :: isConstant
68 type (log_list_type), pointer :: next
69 end type log_list_type
70
71 type context_type
72 type (real_list_type), pointer :: real_list => NULL()
73 type (int_list_type), pointer :: int_list => NULL()
74 type (str_list_type), pointer :: str_list => NULL()
75 type (log_list_type), pointer :: log_list => NULL()
76 integer :: n_real=0, n_int=0, n_str=0, n_log=0
77 end type context_type
78
79
80
81 ! Parameter type constants, returned by inquiry routines.
82
83 integer, parameter :: name_real = 1, name_int = 2, &
84 & name_str = 3, name_log = 4, &
85 & name_invalid = 0
86
87 integer, parameter :: TYPE_CONST = 0, TYPE_VAR = 1
88
89 integer,save :: num_params = 0
90
91
92
94 module procedure initContext
95 end interface
96
98 module procedure getType
99 end interface
100
102 module procedure nameValueLL_findReal
103 module procedure nameValueLL_findInt
104 module procedure nameValueLL_findStr
105 module procedure nameValueLL_findLog
106 end interface
107
109 module procedure nameValueLL_addReal
110 module procedure nameValueLL_addInt
111 module procedure nameValueLL_addStr
112 module procedure nameValueLL_addLog
113 end interface
114
116 module procedure nameValueLL_checkReal
117 module procedure nameValueLL_checkInt
118 module procedure nameValueLL_checkStr
119 end interface
120
121contains
122
123 !!
132
133 subroutine initContext (context)
134 implicit none
135 type (context_type), intent(out) :: context
136
137 context%real_list => NULL()
138 context%int_list => NULL()
139 context%str_list => NULL()
140 context%log_list => NULL()
141 context%n_real=0
142 context%n_int=0
143 context%n_str=0
144 context%n_log=0
145 end subroutine initContext
146
147 !!
161
162 subroutine getType (context, name, name_type)
163 implicit none
164 type (context_type), intent(inout) :: context
165 character(len=*), intent(in) :: name
166 integer, intent(out) :: name_type
167 type (real_list_type), pointer:: real_test
168 type (int_list_type), pointer :: int_test
169 type (str_list_type), pointer :: str_test
170 type (log_list_type), pointer :: log_test
171
172
173 call nameValueLL_find(context, name, real_test)
174 call nameValueLL_find(context, name, int_test)
175 call nameValueLL_find(context, name, str_test)
176 call nameValueLL_find(context, name, log_test)
177
178 name_type = name_invalid
179 ! Only one of the following should test true if the filters
180 ! in add_*_
181 if (associated(real_test)) name_type = name_real
182 if (associated(int_test)) name_type = name_int
183 if (associated(str_test)) name_type = name_str
184 if (associated(log_test)) name_type = name_log
185
186 return
187 end subroutine getType
188
189 !!
204
205 subroutine nameValueLL_findReal(context, name, result)
206
207 type (context_type), intent(in) :: context
208 type (real_list_type), pointer :: result
209 character(len=*),intent(in) :: name
210 character(len=len(name)) :: name_lcase
211
212 name_lcase = name
213
214 call makeLowercase(name_lcase)
215 result => context%real_list
216 do while (associated(result))
217 if (result%name == name_lcase) then
218 exit
219 end if
220 result => result%next
221 enddo
222
223 return
224 end subroutine nameValueLL_findReal
225
226
227 subroutine nameValueLL_findInt (context, name, result)
228
229 type (context_type), intent(in) :: context
230 type (int_list_type), pointer :: result
231 character(len=*), intent(in) :: name
232 character(len=len(name)) :: name_lcase
233
234 name_lcase = name
235 call makeLowercase(name_lcase)
236 result => context%int_list
237 do while (associated(result))
238 if (result%name == name_lcase) exit
239 result => result%next
240 enddo
241
242 return
243 end subroutine nameValueLL_findInt
244
245
246 subroutine nameValueLL_findStr(context, name, result)
247
248 type (context_type), intent(in) :: context
249 type (str_list_type), pointer :: result
250 character(len=*), intent(in) :: name
251 character(len=len(name)) :: name_lcase
252
253 name_lcase = name
254 call makeLowercase(name_lcase)
255 result => context%str_list
256 do while (associated(result))
257 if (result%name == name_lcase) exit
258 result => result%next
259 enddo
260
261 return
262 end subroutine nameValueLL_findStr
263
264
265 subroutine nameValueLL_findLog (context, name, result)
266
267 type (context_type), intent(in) :: context
268 type (log_list_type), pointer :: result
269 character(len=*), intent(in) :: name
270 character(len=len(name)) :: name_lcase
271
272
273 name_lcase = name
274 call makeLowercase(name_lcase)
275 result => context%log_list
276 do while (associated(result))
277 if (result%name == name_lcase) exit
278 result => result%next
279 enddo
280
281 return
282 end subroutine nameValueLL_findLog
283
284
285 !!
301
302 subroutine nameValueLL_addReal (context, name, value, state)
303
304 type (context_type), intent(inout) :: context
305 character(len=*), intent(in) :: name
306 real, intent(in) :: value
307 integer,intent(in) :: state
308 integer :: istat, name_type
309 type (real_list_type), pointer :: node, this
310
311 ! Check to make sure the name doesn't already exist.
312
313
314 call getType(context, name, name_type)
315 if (name_type /= name_invalid) then
316 !write (*,*) 'add : already exists: ', name
317 else
318
319 ! If it doesn't, create a node and add it to the appropriate
320 ! list.
321
322 allocate (node, stat=istat)
323 if (istat /= 0) then
324 write (*,*) 'add : could not allocate'
325 else
326 node%name = name
327 node%value = value
328 node%initValue = value
329 node%isConstant = .false.
330 node%numValues = 0
331 nullify(node%minValues)
332 nullify(node%maxValues)
333 !! DEV: we removed the state argument -- why?
334 !! reintroducing it 2009-06-05 - KW
335
336 !!if (present(state)) then
337 if (state == TYPE_CONST) then
338 node%isConstant = .true.
339 end if
340 !!end if
341 call makeLowercase(node%name)
342 nullify (node%next)
343 endif
344 if (.not. associated(context%real_list)) then
345 context%real_list => node
346 else
347 this => context%real_list
348 do while (associated(this%next))
349 this => this%next
350 enddo
351 this%next => node
352 endif
353 context%n_real = context%n_real + 1
354 endif
355
356 return
357
358 end subroutine nameValueLL_addReal
359
360
361 subroutine nameValueLL_addInt (context, name, value, state)
362
363 type (context_type), intent(inout) :: context
364 character(len=*), intent(in) :: name
365 integer, intent(in) :: value
366 integer, intent(in) :: state
367 integer :: istat, name_type
368 type (int_list_type), pointer :: node, this
369
370 ! Check to make sure the parameter doesn't already exist.
371
372
373
374 call getType(context, name, name_type)
375 if (name_type /= name_invalid) then
376 !write (*,*) 'add : already exists: ', name
377 else
378
379 ! If it doesn't, create a node and add it to the appropriate
380 ! list.
381
382 allocate (node, stat=istat)
383 if (istat /= 0) then
384 write (*,*) 'add : could not allocate'
385 else
386 nullify (node%next)
387 node%name = name
388 node%value = value
389 node%initValue = value
390 node%isConstant = .false.
391 node%numValues = 0
392 nullify(node%minValues)
393 nullify(node%maxValues)
394 !!if (present(state)) then
395 if (state == TYPE_CONST) then
396 node%isConstant = .true.
397 end if
398 !!end if
399 call makeLowercase(node%name)
400 endif
401 if (.not. associated(context%int_list)) then
402 context%int_list => node
403 else
404 this => context%int_list
405 do while (associated(this%next))
406 this => this%next
407 enddo
408 this%next => node
409 endif
410 context%n_int = context%n_int + 1
411
412 endif
413 return
414
415 end subroutine nameValueLL_addInt
416
417
418 subroutine nameValueLL_addStr (context, name, value, state)
419
420 type (context_type), intent(inout) :: context
421 character(len=*),intent(in) :: name, value
422 integer,intent(in) :: state
423 integer :: istat, name_type
424 type (str_list_type), pointer :: node, this
425
426
427 ! Check to make sure the name doesn't already exist.
428
429 call getType(context, name, name_type)
430 if (name_type /= name_invalid) then
431 !write (*,*) 'add_: already exists: ', name
432 else
433
434 ! If it doesn't, create a node and add it to the appropriate
435 ! list.
436
437 allocate (node, stat=istat)
438 if (istat /= 0) then
439 write (*,*) 'add : could not allocate'
440 else
441 node%name = name
442 node%value = value
443 node%initValue = value
444 node%isConstant = .false.
445 node%numValues = 0
446 nullify(node%validValues)
447 !!if (present(state)) then
448 if (state == TYPE_CONST) then
449 node%isConstant = .true.
450 end if
451 !!end if
452 call makeLowercase(node%name)
453 nullify (node%next)
454 endif
455 if (.not. associated(context%str_list)) then
456 context%str_list => node
457 else
458 this => context%str_list
459 do while (associated(this%next))
460 this => this%next
461 enddo
462 this%next => node
463 endif
464 context%n_str = context%n_str + 1
465
466 endif
467
468 return
469
470 end subroutine nameValueLL_addStr
471
472
473
474 subroutine nameValueLL_addLog (context, name, value, state)
475
476 type (context_type), intent(inout) :: context
477 character(len=*),intent(in) :: name
478 logical,intent(in) :: value
479 integer,intent(in) :: state
480 integer :: istat, name_type
481 type (log_list_type), pointer :: node, this
482
483
484 ! Check to make sure the name doesn't already exist.
485
486
487 call getType(context, name, name_type)
488 if (name_type /= name_invalid) then
489 !write (*,*) 'add : already exists: ', name
490 else
491
492 ! If it doesn't, create a node and add it to the appropriate
493 ! list.
494
495 allocate (node, stat=istat)
496 if (istat /= 0) then
497 write (*,*) 'add : could not allocate'
498 else
499 node%name = name
500 node%value = value
501 node%initValue = value
502 node%isConstant = .false.
503 !!if (present(state)) then
504 if (state == TYPE_CONST) then
505 node%isConstant = .true.
506 end if
507 !!end if
508 call makeLowercase(node%name)
509 nullify (node%next)
510 endif
511 if (.not. associated(context%log_list)) then
512 context%log_list => node
513 else
514 this => context%log_list
515 do while (associated(this%next))
516 this => this%next
517 enddo
518 this%next => node
519 endif
520 context%n_log = context%n_log + 1
521
522 endif
523
524 return
525
526
527 end subroutine nameValueLL_addLog
528
529
530!!
543
544subroutine nameValueLL_checkReal (node, value, valid)
546
547implicit none
548
549 type (real_list_type), pointer :: node
550 real, intent(in) :: value
551 logical, intent(out) :: valid
552 integer :: ctr
553 real, parameter :: epsilon = TINY(1.0)
554
555 valid = .false.
556 if (associated(node)) then
557 if (node%numValues == 0) then
558 valid = .true.
559 else if (.NOT. node%isConstant) then
560 do ctr = 1, node%numValues
561 if ((node%minValues(ctr) .le. value +epsilon) .and. (value-epsilon .le. node%maxValues(ctr))) then
562 valid = .true.
563 endif
564 end do
565 endif
566 else
567 !! name is not found - add it to list
568 call Driver_abort("nameValue_checkReal: invalid node given")
569 endif
570
571 return
572end subroutine nameValueLL_checkReal
573
574!!
587
588subroutine nameValueLL_checkInt (node, value, valid)
590
591implicit none
592
593 type (int_list_type),pointer :: node
594 integer, intent(in) :: value
595 logical, intent(out) :: valid
596 integer :: ctr
597
598 valid = .false.
599 if (associated(node)) then
600 if (node%numValues == 0) then
601 valid = .true.
602 else if (.NOT. node%isConstant) then
603 do ctr = 1, node%numValues
604 if ( (node%minValues(ctr) .le. value) .and. (value .le. node%maxValues(ctr)) ) then
605 valid = .true.
606 endif
607 end do
608 endif
609 else
610 !! name is not found - add it to list
611 call Driver_abort("nameValue_checkAdd: invalid node given")
612 endif
613
614 return
615end subroutine nameValueLL_checkInt
616
617
618!!
631
632subroutine nameValueLL_checkStr (node, value, valid)
634
635#include "constants.h"
636
637implicit none
638
639 type (str_list_type),pointer :: node
640 character(len=*), intent(in) :: value
641 character(len=MAX_STRING_LENGTH) :: lcase
642 logical, intent(out) :: valid
643 integer :: ctr
644
645 valid = .false.
646 lcase = value
647 call makeLowercase(lcase)
648 if (associated(node)) then
649 if (node%numValues == 0) then
650 valid = .true.
651 else if (.NOT. node%isConstant) then
652 do ctr = 1, node%numValues
653 if (trim(node%validValues(ctr)) == trim(lcase)) then
654 valid = .true.
655 endif
656 end do
657 endif
658 else
659 !! name is not found - add it to list
660 call Driver_abort("nameValue_checkStr: invalid node given")
661 endif
662
663 return
664end subroutine nameValueLL_checkStr
665
666end module nameValueLL_data
#define MAX_STRING_LENGTH
Definition: constants.h:7
subroutine makeLowercase(str)
subroutine nameValueLL_addReal(context, name, value, state)
subroutine nameValueLL_checkReal(node, value, valid)
integer, parameter name_invalid
subroutine nameValueLL_findInt(context, name, result)
integer, parameter TYPE_VAR
subroutine nameValueLL_checkStr(node, value, valid)
subroutine nameValueLL_addLog(context, name, value, state)
integer, parameter name_log
subroutine nameValueLL_findStr(context, name, result)
subroutine nameValueLL_addStr(context, name, value, state)
subroutine initContext(context)
integer, save num_params
integer, parameter NUM_MAX_RULES
subroutine nameValueLL_addInt(context, name, value, state)
integer, parameter name_int
integer, parameter name_real
integer, parameter TYPE_CONST
subroutine nameValueLL_checkInt(node, value, valid)
subroutine nameValueLL_findLog(context, name, result)
subroutine nameValueLL_findReal(context, name, result)
subroutine getType(context, name, name_type)
integer, parameter name_str