(git:97501a3)
Loading...
Searching...
No Matches
input_keyword_types.F
Go to the documentation of this file.
1!--------------------------------------------------------------------------------------------------!
2! CP2K: A general program to perform molecular dynamics simulations !
3! Copyright 2000-2025 CP2K developers group <https://cp2k.org> !
4! !
5! SPDX-License-Identifier: GPL-2.0-or-later !
6!--------------------------------------------------------------------------------------------------!
7
8! **************************************************************************************************
9!> \brief represents keywords in an input
10!> \par History
11!> 06.2004 created, based on Joost cp_keywords proposal [fawzi]
12!> \author fawzi
13! **************************************************************************************************
14MODULE input_keyword_types
15 USE cp_units, ONLY: cp_unit_create,&
16 cp_unit_desc,&
17 cp_unit_desc_length,&
18 cp_unit_release,&
19 cp_unit_type
20 USE input_enumeration_types, ONLY: enum_create,&
21 enum_release,&
22 enum_retain,&
23 enumeration_type
24 USE input_val_types, ONLY: &
25 char_t, enum_t, integer_t, lchar_t, logical_t, no_t, real_t, val_create, val_release, &
26 val_retain, val_type, val_write, val_write_internal
27 USE kinds, ONLY: default_string_length,&
28 dp
29 USE print_messages, ONLY: print_message
30 USE reference_manager, ONLY: get_citation_key
31 USE string_utilities, ONLY: a2s,&
32 compress,&
33 substitute_special_xml_tokens,&
34 typo_match,&
35 uppercase
36#include "../base/base_uses.f90"
37
38 IMPLICIT NONE
39 PRIVATE
40
41 LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .true.
42 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'input_keyword_types'
43
44 INTEGER, PARAMETER, PUBLIC :: usage_string_length = default_string_length*2
45
46 PUBLIC :: keyword_p_type, keyword_type, keyword_create, keyword_retain, &
47 keyword_release, keyword_get, keyword_describe, &
48 write_keyword_xml, keyword_typo_match
49
50! **************************************************************************************************
51!> \brief represent a pointer to a keyword (to make arrays of pointers)
52!> \param keyword the pointer to the keyword
53!> \author fawzi
54! **************************************************************************************************
55 TYPE keyword_p_type
56 TYPE(keyword_type), POINTER :: keyword => null()
57 END TYPE keyword_p_type
58
59! **************************************************************************************************
60!> \brief represent a keyword in the input
61!> \param names the names of the current keyword (at least one should be
62!> present) for example "MAXSCF"
63!> \param location is where in the source code (file and line) the keyword is created
64!> \param usage how to use it "MAXSCF 10"
65!> \param description what does it do: "MAXSCF : determines the maximum
66!> number of steps in an SCF run"
67!> \param deprecation_notice show this warning that the keyword is deprecated
68!> \param citations references to literature associated with this keyword
69!> \param type_of_var the type of keyword (controls how it is parsed)
70!> it can be one of: no_parse_t,logical_t, integer_t, real_t,
71!> char_t
72!> \param n_var number of values that should be parsed (-1=unknown)
73!> \param repeats if the keyword can be present more than once in the
74!> section
75!> \param removed to trigger a CPABORT when encountered while parsing the input
76!> \param enum enumeration that defines the mapping between integers and
77!> strings
78!> \param unit the default unit this keyword is read in (to automatically
79!> convert to the internal cp2k units during parsing)
80!> \param default_value the default value for the keyword
81!> \param lone_keyword_value value to be used in presence of the keyword
82!> without any parameter
83!> \note
84!> I have expressely avoided a format string for the type of keywords:
85!> they should easily map to basic types of fortran, if you need more
86!> information use a subsection. [fawzi]
87!> \author Joost & fawzi
88! **************************************************************************************************
89 TYPE keyword_type
90 INTEGER :: ref_count = 0
91 CHARACTER(LEN=default_string_length), DIMENSION(:), POINTER :: names => null()
92 CHARACTER(LEN=usage_string_length) :: location = ""
93 CHARACTER(LEN=usage_string_length) :: usage = ""
94 CHARACTER, DIMENSION(:), POINTER :: description => null()
95 CHARACTER(LEN=:), ALLOCATABLE :: deprecation_notice
96 INTEGER, POINTER, DIMENSION(:) :: citations => null()
97 INTEGER :: type_of_var = 0, n_var = 0
98 LOGICAL :: repeats = .false., removed = .false.
99 TYPE(enumeration_type), POINTER :: enum => null()
100 TYPE(cp_unit_type), POINTER :: unit => null()
101 TYPE(val_type), POINTER :: default_value => null()
102 TYPE(val_type), POINTER :: lone_keyword_value => null()
103 END TYPE keyword_type
104
105CONTAINS
106
107! **************************************************************************************************
108!> \brief creates a keyword object
109!> \param keyword the keyword object to be created
110!> \param location from where in the source code keyword_create() is called
111!> \param name the name of the keyword
112!> \param description ...
113!> \param usage ...
114!> \param type_of_var ...
115!> \param n_var ...
116!> \param repeats ...
117!> \param variants ...
118!> \param default_val ...
119!> \param default_l_val ...
120!> \param default_r_val ...
121!> \param default_lc_val ...
122!> \param default_c_val ...
123!> \param default_i_val ...
124!> \param default_l_vals ...
125!> \param default_r_vals ...
126!> \param default_c_vals ...
127!> \param default_i_vals ...
128!> \param lone_keyword_val ...
129!> \param lone_keyword_l_val ...
130!> \param lone_keyword_r_val ...
131!> \param lone_keyword_c_val ...
132!> \param lone_keyword_i_val ...
133!> \param lone_keyword_l_vals ...
134!> \param lone_keyword_r_vals ...
135!> \param lone_keyword_c_vals ...
136!> \param lone_keyword_i_vals ...
137!> \param enum_c_vals ...
138!> \param enum_i_vals ...
139!> \param enum ...
140!> \param enum_strict ...
141!> \param enum_desc ...
142!> \param unit_str ...
143!> \param citations ...
144!> \param deprecation_notice ...
145!> \param removed ...
146!> \author fawzi
147! **************************************************************************************************
148 SUBROUTINE keyword_create(keyword, location, name, description, usage, type_of_var, &
149 n_var, repeats, variants, default_val, &
150 default_l_val, default_r_val, default_lc_val, default_c_val, default_i_val, &
151 default_l_vals, default_r_vals, default_c_vals, default_i_vals, &
152 lone_keyword_val, lone_keyword_l_val, lone_keyword_r_val, lone_keyword_c_val, &
153 lone_keyword_i_val, lone_keyword_l_vals, lone_keyword_r_vals, &
154 lone_keyword_c_vals, lone_keyword_i_vals, enum_c_vals, enum_i_vals, &
155 enum, enum_strict, enum_desc, unit_str, citations, deprecation_notice, removed)
156 TYPE(keyword_type), POINTER :: keyword
157 CHARACTER(len=*), INTENT(in) :: location, name, description
158 CHARACTER(len=*), INTENT(in), OPTIONAL :: usage
159 INTEGER, INTENT(in), OPTIONAL :: type_of_var, n_var
160 LOGICAL, INTENT(in), OPTIONAL :: repeats
161 CHARACTER(len=*), DIMENSION(:), INTENT(in), &
162 OPTIONAL :: variants
163 TYPE(val_type), OPTIONAL, POINTER :: default_val
164 LOGICAL, INTENT(in), OPTIONAL :: default_l_val
165 REAL(kind=dp), INTENT(in), OPTIONAL :: default_r_val
166 CHARACTER(len=*), INTENT(in), OPTIONAL :: default_lc_val, default_c_val
167 INTEGER, INTENT(in), OPTIONAL :: default_i_val
168 LOGICAL, DIMENSION(:), INTENT(in), OPTIONAL :: default_l_vals
169 REAL(kind=dp), DIMENSION(:), INTENT(in), OPTIONAL :: default_r_vals
170 CHARACTER(len=*), DIMENSION(:), INTENT(in), &
171 OPTIONAL :: default_c_vals
172 INTEGER, DIMENSION(:), INTENT(in), OPTIONAL :: default_i_vals
173 TYPE(val_type), OPTIONAL, POINTER :: lone_keyword_val
174 LOGICAL, INTENT(in), OPTIONAL :: lone_keyword_l_val
175 REAL(kind=dp), INTENT(in), OPTIONAL :: lone_keyword_r_val
176 CHARACTER(len=*), INTENT(in), OPTIONAL :: lone_keyword_c_val
177 INTEGER, INTENT(in), OPTIONAL :: lone_keyword_i_val
178 LOGICAL, DIMENSION(:), INTENT(in), OPTIONAL :: lone_keyword_l_vals
179 REAL(kind=dp), DIMENSION(:), INTENT(in), OPTIONAL :: lone_keyword_r_vals
180 CHARACTER(len=*), DIMENSION(:), INTENT(in), &
181 OPTIONAL :: lone_keyword_c_vals
182 INTEGER, DIMENSION(:), INTENT(in), OPTIONAL :: lone_keyword_i_vals
183 CHARACTER(len=*), DIMENSION(:), INTENT(in), &
184 OPTIONAL :: enum_c_vals
185 INTEGER, DIMENSION(:), INTENT(in), OPTIONAL :: enum_i_vals
186 TYPE(enumeration_type), OPTIONAL, POINTER :: enum
187 LOGICAL, INTENT(in), OPTIONAL :: enum_strict
188 CHARACTER(len=*), DIMENSION(:), INTENT(in), &
189 OPTIONAL :: enum_desc
190 CHARACTER(len=*), INTENT(in), OPTIONAL :: unit_str
191 INTEGER, DIMENSION(:), INTENT(in), OPTIONAL :: citations
192 CHARACTER(len=*), INTENT(in), OPTIONAL :: deprecation_notice
193 LOGICAL, INTENT(in), OPTIONAL :: removed
194
195 CHARACTER(LEN=default_string_length) :: tmp_string
196 INTEGER :: i, n
197 LOGICAL :: check
198
199 cpassert(.NOT. ASSOCIATED(keyword))
200 ALLOCATE (keyword)
201 keyword%ref_count = 1
202 NULLIFY (keyword%unit)
203 keyword%location = location
204 keyword%removed = .false.
205
206 cpassert(len_trim(name) > 0)
207
208 IF (PRESENT(variants)) THEN
209 ALLOCATE (keyword%names(SIZE(variants) + 1))
210 keyword%names(1) = name
211 DO i = 1, SIZE(variants)
212 cpassert(len_trim(variants(i)) > 0)
213 keyword%names(i + 1) = variants(i)
214 END DO
215 ELSE
216 ALLOCATE (keyword%names(1))
217 keyword%names(1) = name
218 END IF
219 DO i = 1, SIZE(keyword%names)
220 CALL uppercase(keyword%names(i))
221 END DO
222
223 IF (PRESENT(usage)) THEN
224 cpassert(len_trim(usage) <= len(keyword%usage))
225 keyword%usage = usage
226 ! Check that the usage string starts with one of the keyword names.
227 IF (keyword%names(1) /= "_SECTION_PARAMETERS_" .AND. keyword%names(1) /= "_DEFAULT_KEYWORD_") THEN
228 tmp_string = usage
229 CALL uppercase(tmp_string)
230 check = .false.
231 DO i = 1, SIZE(keyword%names)
232 check = check .OR. (index(tmp_string, trim(keyword%names(i))) == 1)
233 END DO
234 IF (.NOT. check) THEN
235 cpabort("Usage string must start with one of the keyword name.")
236 END IF
237 END IF
238 ELSE
239 keyword%usage = ""
240 END IF
241
242 n = len_trim(description)
243 ALLOCATE (keyword%description(n))
244 DO i = 1, n
245 keyword%description(i) = description(i:i)
246 END DO
247
248 IF (PRESENT(citations)) THEN
249 ALLOCATE (keyword%citations(SIZE(citations, 1)))
250 keyword%citations = citations
251 ELSE
252 NULLIFY (keyword%citations)
253 END IF
254
255 keyword%repeats = .false.
256 IF (PRESENT(repeats)) keyword%repeats = repeats
257
258 NULLIFY (keyword%enum)
259 IF (PRESENT(enum)) THEN
260 keyword%enum => enum
261 IF (ASSOCIATED(enum)) CALL enum_retain(enum)
262 END IF
263 IF (PRESENT(enum_i_vals)) THEN
264 cpassert(PRESENT(enum_c_vals))
265 cpassert(.NOT. ASSOCIATED(keyword%enum))
266 CALL enum_create(keyword%enum, c_vals=enum_c_vals, i_vals=enum_i_vals, &
267 desc=enum_desc, strict=enum_strict)
268 ELSE
269 cpassert(.NOT. PRESENT(enum_c_vals))
270 END IF
271
272 NULLIFY (keyword%default_value, keyword%lone_keyword_value)
273 IF (PRESENT(default_val)) THEN
274 IF (PRESENT(default_l_val) .OR. PRESENT(default_l_vals) .OR. &
275 PRESENT(default_i_val) .OR. PRESENT(default_i_vals) .OR. &
276 PRESENT(default_r_val) .OR. PRESENT(default_r_vals) .OR. &
277 PRESENT(default_c_val) .OR. PRESENT(default_c_vals)) &
278 cpabort("you should pass either default_val or a default value, not both")
279 keyword%default_value => default_val
280 IF (ASSOCIATED(default_val%enum)) THEN
281 IF (ASSOCIATED(keyword%enum)) THEN
282 cpassert(ASSOCIATED(keyword%enum, default_val%enum))
283 ELSE
284 keyword%enum => default_val%enum
285 CALL enum_retain(keyword%enum)
286 END IF
287 ELSE
288 cpassert(.NOT. ASSOCIATED(keyword%enum))
289 END IF
290 CALL val_retain(default_val)
291 END IF
292 IF (.NOT. ASSOCIATED(keyword%default_value)) THEN
293 CALL val_create(keyword%default_value, l_val=default_l_val, &
294 l_vals=default_l_vals, i_val=default_i_val, i_vals=default_i_vals, &
295 r_val=default_r_val, r_vals=default_r_vals, c_val=default_c_val, &
296 c_vals=default_c_vals, lc_val=default_lc_val, enum=keyword%enum)
297 END IF
298
299 keyword%type_of_var = keyword%default_value%type_of_var
300 IF (keyword%default_value%type_of_var == no_t) THEN
301 CALL val_release(keyword%default_value)
302 END IF
303
304 IF (keyword%type_of_var == no_t) THEN
305 IF (PRESENT(type_of_var)) THEN
306 keyword%type_of_var = type_of_var
307 ELSE
308 CALL cp_abort(__location__, &
309 "keyword "//trim(keyword%names(1))// &
310 " assumed undefined type by default")
311 END IF
312 ELSE IF (PRESENT(type_of_var)) THEN
313 IF (keyword%type_of_var /= type_of_var) &
314 CALL cp_abort(__location__, &
315 "keyword "//trim(keyword%names(1))// &
316 " has a type different from the type of the default_value")
317 keyword%type_of_var = type_of_var
318 END IF
319
320 IF (keyword%type_of_var == no_t) THEN
321 CALL val_create(keyword%default_value)
322 END IF
323
324 IF (PRESENT(lone_keyword_val)) THEN
325 IF (PRESENT(lone_keyword_l_val) .OR. PRESENT(lone_keyword_l_vals) .OR. &
326 PRESENT(lone_keyword_i_val) .OR. PRESENT(lone_keyword_i_vals) .OR. &
327 PRESENT(lone_keyword_r_val) .OR. PRESENT(lone_keyword_r_vals) .OR. &
328 PRESENT(lone_keyword_c_val) .OR. PRESENT(lone_keyword_c_vals)) &
329 CALL cp_abort(__location__, &
330 "you should pass either lone_keyword_val or a lone_keyword value, not both")
331 keyword%lone_keyword_value => lone_keyword_val
332 CALL val_retain(lone_keyword_val)
333 IF (ASSOCIATED(lone_keyword_val%enum)) THEN
334 IF (ASSOCIATED(keyword%enum)) THEN
335 IF (.NOT. ASSOCIATED(keyword%enum, lone_keyword_val%enum)) &
336 cpabort("keyword%enum/=lone_keyword_val%enum")
337 ELSE
338 IF (ASSOCIATED(keyword%lone_keyword_value)) THEN
339 cpabort(.NOT." ASSOCIATED(keyword%lone_keyword_value)")
340 END IF
341 keyword%enum => lone_keyword_val%enum
342 CALL enum_retain(keyword%enum)
343 END IF
344 ELSE
345 cpassert(.NOT. ASSOCIATED(keyword%enum))
346 END IF
347 END IF
348 IF (.NOT. ASSOCIATED(keyword%lone_keyword_value)) THEN
349 CALL val_create(keyword%lone_keyword_value, l_val=lone_keyword_l_val, &
350 l_vals=lone_keyword_l_vals, i_val=lone_keyword_i_val, i_vals=lone_keyword_i_vals, &
351 r_val=lone_keyword_r_val, r_vals=lone_keyword_r_vals, c_val=lone_keyword_c_val, &
352 c_vals=lone_keyword_c_vals, enum=keyword%enum)
353 END IF
354 IF (ASSOCIATED(keyword%lone_keyword_value)) THEN
355 IF (keyword%lone_keyword_value%type_of_var == no_t) THEN
356 CALL val_release(keyword%lone_keyword_value)
357 ELSE
358 IF (keyword%lone_keyword_value%type_of_var /= keyword%type_of_var) &
359 cpabort("lone_keyword_value type incompatible with keyword type")
360 ! lc_val cannot have lone_keyword_value!
361 IF (keyword%type_of_var == enum_t) THEN
362 IF (keyword%enum%strict) THEN
363 check = .false.
364 DO i = 1, SIZE(keyword%enum%i_vals)
365 check = check .OR. (keyword%default_value%i_val(1) == keyword%enum%i_vals(i))
366 END DO
367 IF (.NOT. check) &
368 cpabort("default value not in enumeration : "//keyword%names(1))
369 END IF
370 END IF
371 END IF
372 END IF
373
374 keyword%n_var = 1
375 IF (ASSOCIATED(keyword%default_value)) THEN
376 SELECT CASE (keyword%default_value%type_of_var)
377 CASE (logical_t)
378 keyword%n_var = SIZE(keyword%default_value%l_val)
379 CASE (integer_t)
380 keyword%n_var = SIZE(keyword%default_value%i_val)
381 CASE (enum_t)
382 IF (keyword%enum%strict) THEN
383 check = .false.
384 DO i = 1, SIZE(keyword%enum%i_vals)
385 check = check .OR. (keyword%default_value%i_val(1) == keyword%enum%i_vals(i))
386 END DO
387 IF (.NOT. check) &
388 cpabort("default value not in enumeration : "//keyword%names(1))
389 END IF
390 keyword%n_var = SIZE(keyword%default_value%i_val)
391 CASE (real_t)
392 keyword%n_var = SIZE(keyword%default_value%r_val)
393 CASE (char_t)
394 keyword%n_var = SIZE(keyword%default_value%c_val)
395 CASE (lchar_t)
396 keyword%n_var = 1
397 CASE (no_t)
398 keyword%n_var = 0
399 CASE default
400 cpabort("")
401 END SELECT
402 END IF
403 IF (PRESENT(n_var)) keyword%n_var = n_var
404 IF (keyword%type_of_var == lchar_t .AND. keyword%n_var /= 1) &
405 cpabort("arrays of lchar_t not supported : "//keyword%names(1))
406
407 IF (PRESENT(unit_str)) THEN
408 ALLOCATE (keyword%unit)
409 CALL cp_unit_create(keyword%unit, unit_str)
410 END IF
411
412 IF (PRESENT(deprecation_notice)) THEN
413 keyword%deprecation_notice = trim(deprecation_notice)
414 END IF
415
416 IF (PRESENT(removed)) THEN
417 keyword%removed = removed
418 END IF
419 END SUBROUTINE keyword_create
420
421! **************************************************************************************************
422!> \brief retains the given keyword (see doc/ReferenceCounting.html)
423!> \param keyword the keyword to retain
424!> \author fawzi
425! **************************************************************************************************
426 SUBROUTINE keyword_retain(keyword)
427 TYPE(keyword_type), POINTER :: keyword
428
429 cpassert(ASSOCIATED(keyword))
430 cpassert(keyword%ref_count > 0)
431 keyword%ref_count = keyword%ref_count + 1
432 END SUBROUTINE keyword_retain
433
434! **************************************************************************************************
435!> \brief releases the given keyword (see doc/ReferenceCounting.html)
436!> \param keyword the keyword to release
437!> \author fawzi
438! **************************************************************************************************
439 SUBROUTINE keyword_release(keyword)
440 TYPE(keyword_type), POINTER :: keyword
441
442 IF (ASSOCIATED(keyword)) THEN
443 cpassert(keyword%ref_count > 0)
444 keyword%ref_count = keyword%ref_count - 1
445 IF (keyword%ref_count == 0) THEN
446 DEALLOCATE (keyword%names)
447 DEALLOCATE (keyword%description)
448 CALL val_release(keyword%default_value)
449 CALL val_release(keyword%lone_keyword_value)
450 CALL enum_release(keyword%enum)
451 IF (ASSOCIATED(keyword%unit)) THEN
452 CALL cp_unit_release(keyword%unit)
453 DEALLOCATE (keyword%unit)
454 END IF
455 IF (ASSOCIATED(keyword%citations)) THEN
456 DEALLOCATE (keyword%citations)
457 END IF
458 DEALLOCATE (keyword)
459 END IF
460 END IF
461 NULLIFY (keyword)
462 END SUBROUTINE keyword_release
463
464! **************************************************************************************************
465!> \brief ...
466!> \param keyword ...
467!> \param names ...
468!> \param usage ...
469!> \param description ...
470!> \param type_of_var ...
471!> \param n_var ...
472!> \param default_value ...
473!> \param lone_keyword_value ...
474!> \param repeats ...
475!> \param enum ...
476!> \param citations ...
477!> \author fawzi
478! **************************************************************************************************
479 SUBROUTINE keyword_get(keyword, names, usage, description, type_of_var, n_var, &
480 default_value, lone_keyword_value, repeats, enum, citations)
481 TYPE(keyword_type), POINTER :: keyword
482 CHARACTER(len=default_string_length), &
483 DIMENSION(:), OPTIONAL, POINTER :: names
484 CHARACTER(len=*), INTENT(out), OPTIONAL :: usage, description
485 INTEGER, INTENT(out), OPTIONAL :: type_of_var, n_var
486 TYPE(val_type), OPTIONAL, POINTER :: default_value, lone_keyword_value
487 LOGICAL, INTENT(out), OPTIONAL :: repeats
488 TYPE(enumeration_type), OPTIONAL, POINTER :: enum
489 INTEGER, DIMENSION(:), OPTIONAL, POINTER :: citations
490
491 cpassert(ASSOCIATED(keyword))
492 cpassert(keyword%ref_count > 0)
493 IF (PRESENT(names)) names => keyword%names
494 IF (PRESENT(usage)) usage = keyword%usage
495 IF (PRESENT(description)) description = a2s(keyword%description)
496 IF (PRESENT(type_of_var)) type_of_var = keyword%type_of_var
497 IF (PRESENT(n_var)) n_var = keyword%n_var
498 IF (PRESENT(repeats)) repeats = keyword%repeats
499 IF (PRESENT(default_value)) default_value => keyword%default_value
500 IF (PRESENT(lone_keyword_value)) lone_keyword_value => keyword%lone_keyword_value
501 IF (PRESENT(enum)) enum => keyword%enum
502 IF (PRESENT(citations)) citations => keyword%citations
503 END SUBROUTINE keyword_get
504
505! **************************************************************************************************
506!> \brief writes out a description of the keyword
507!> \param keyword the keyword to describe
508!> \param unit_nr the unit to write to
509!> \param level the description level (0 no description, 1 name
510!> 2: +usage, 3: +variants+description+default_value+repeats
511!> 4: +type_of_var)
512!> \author fawzi
513! **************************************************************************************************
514 SUBROUTINE keyword_describe(keyword, unit_nr, level)
515 TYPE(keyword_type), POINTER :: keyword
516 INTEGER, INTENT(in) :: unit_nr, level
517
518 CHARACTER(len=cp_unit_desc_length) :: c_string
519 INTEGER :: i, l
520
521 cpassert(ASSOCIATED(keyword))
522 cpassert(keyword%ref_count > 0)
523 IF (level > 0 .AND. (unit_nr > 0)) THEN
524 WRITE (unit_nr, "(a,a,a)") " ---", &
525 trim(keyword%names(1)), "---"
526 IF (level > 1) THEN
527 WRITE (unit_nr, "(a,a)") "usage : ", trim(keyword%usage)
528 END IF
529 IF (level > 2) THEN
530 WRITE (unit_nr, "(a)") "description : "
531 CALL print_message(trim(a2s(keyword%description)), unit_nr, 0, 0, 0)
532 IF (level > 3) THEN
533 SELECT CASE (keyword%type_of_var)
534 CASE (logical_t)
535 IF (keyword%n_var == -1) THEN
536 WRITE (unit_nr, "(' A list of logicals is expected')")
537 ELSE IF (keyword%n_var == 1) THEN
538 WRITE (unit_nr, "(' A logical is expected')")
539 ELSE
540 WRITE (unit_nr, "(i6,' logicals are expected')") keyword%n_var
541 END IF
542 WRITE (unit_nr, "(' (T,TRUE,YES,ON) and (F,FALSE,NO,OFF) are synonyms')")
543 CASE (integer_t)
544 IF (keyword%n_var == -1) THEN
545 WRITE (unit_nr, "(' A list of integers is expected')")
546 ELSE IF (keyword%n_var == 1) THEN
547 WRITE (unit_nr, "(' An integer is expected')")
548 ELSE
549 WRITE (unit_nr, "(i6,' integers are expected')") keyword%n_var
550 END IF
551 CASE (real_t)
552 IF (keyword%n_var == -1) THEN
553 WRITE (unit_nr, "(' A list of reals is expected')")
554 ELSE IF (keyword%n_var == 1) THEN
555 WRITE (unit_nr, "(' A real is expected')")
556 ELSE
557 WRITE (unit_nr, "(i6,' reals are expected')") keyword%n_var
558 END IF
559 IF (ASSOCIATED(keyword%unit)) THEN
560 c_string = cp_unit_desc(keyword%unit, accept_undefined=.true.)
561 WRITE (unit_nr, "('the default unit of measure is ',a)") &
562 trim(c_string)
563 END IF
564 CASE (char_t)
565 IF (keyword%n_var == -1) THEN
566 WRITE (unit_nr, "(' A list of words is expected')")
567 ELSE IF (keyword%n_var == 1) THEN
568 WRITE (unit_nr, "(' A word is expected')")
569 ELSE
570 WRITE (unit_nr, "(i6,' words are expected')") keyword%n_var
571 END IF
572 CASE (lchar_t)
573 WRITE (unit_nr, "(' A string is expected')")
574 CASE (enum_t)
575 IF (keyword%n_var == -1) THEN
576 WRITE (unit_nr, "(' A list of keywords is expected')")
577 ELSE IF (keyword%n_var == 1) THEN
578 WRITE (unit_nr, "(' A keyword is expected')")
579 ELSE
580 WRITE (unit_nr, "(i6,' keywords are expected')") keyword%n_var
581 END IF
582 CASE (no_t)
583 WRITE (unit_nr, "(' Non-standard type.')")
584 CASE default
585 cpabort("")
586 END SELECT
587 END IF
588 IF (keyword%type_of_var == enum_t) THEN
589 IF (level > 3) THEN
590 WRITE (unit_nr, "(' valid keywords:')")
591 DO i = 1, SIZE(keyword%enum%c_vals)
592 c_string = keyword%enum%c_vals(i)
593 IF (len_trim(a2s(keyword%enum%desc(i)%chars)) > 0) THEN
594 WRITE (unit_nr, "(' - ',a,' : ',a,'.')") &
595 trim(c_string), trim(a2s(keyword%enum%desc(i)%chars))
596 ELSE
597 WRITE (unit_nr, "(' - ',a)") trim(c_string)
598 END IF
599 END DO
600 ELSE
601 WRITE (unit_nr, "(' valid keywords:')", advance='NO')
602 l = 17
603 DO i = 1, SIZE(keyword%enum%c_vals)
604 c_string = keyword%enum%c_vals(i)
605 IF (l + len_trim(c_string) > 72 .AND. l > 14) THEN
606 WRITE (unit_nr, "(/,' ')", advance='NO')
607 l = 4
608 END IF
609 WRITE (unit_nr, "(' ',a)", advance='NO') trim(c_string)
610 l = len_trim(c_string) + 3
611 END DO
612 WRITE (unit_nr, "()")
613 END IF
614 IF (.NOT. keyword%enum%strict) THEN
615 WRITE (unit_nr, "(' other integer values are also accepted.')")
616 END IF
617 END IF
618 IF (ASSOCIATED(keyword%default_value) .AND. keyword%type_of_var /= no_t) THEN
619 WRITE (unit_nr, "('default_value : ')", advance="NO")
620 CALL val_write(keyword%default_value, unit_nr=unit_nr)
621 END IF
622 IF (ASSOCIATED(keyword%lone_keyword_value) .AND. keyword%type_of_var /= no_t) THEN
623 WRITE (unit_nr, "('lone_keyword : ')", advance="NO")
624 CALL val_write(keyword%lone_keyword_value, unit_nr=unit_nr)
625 END IF
626 IF (keyword%repeats) THEN
627 WRITE (unit_nr, "(' and it can be repeated more than once')", advance="NO")
628 END IF
629 WRITE (unit_nr, "()")
630 IF (SIZE(keyword%names) > 1) THEN
631 WRITE (unit_nr, "(a)", advance="NO") "variants : "
632 DO i = 2, SIZE(keyword%names)
633 WRITE (unit_nr, "(a,' ')", advance="NO") keyword%names(i)
634 END DO
635 WRITE (unit_nr, "()")
636 END IF
637 END IF
638 END IF
639 END SUBROUTINE keyword_describe
640
641! **************************************************************************************************
642!> \brief Prints a description of a keyword in XML format
643!> \param keyword The keyword to describe
644!> \param level ...
645!> \param unit_number Number of the output unit
646!> \author Matthias Krack
647! **************************************************************************************************
648 SUBROUTINE write_keyword_xml(keyword, level, unit_number)
649
650 TYPE(keyword_type), POINTER :: keyword
651 INTEGER, INTENT(IN) :: level, unit_number
652
653 CHARACTER(LEN=1000) :: string
654 CHARACTER(LEN=3) :: removed, repeats
655 CHARACTER(LEN=8) :: short_string
656 INTEGER :: i, l0, l1, l2, l3, l4
657
658 cpassert(ASSOCIATED(keyword))
659 cpassert(keyword%ref_count > 0)
660
661 ! Indentation for current level, next level, etc.
662
663 l0 = level
664 l1 = level + 1
665 l2 = level + 2
666 l3 = level + 3
667 l4 = level + 4
668
669 IF (keyword%repeats) THEN
670 repeats = "yes"
671 ELSE
672 repeats = "no "
673 END IF
674
675 IF (keyword%removed) THEN
676 removed = "yes"
677 ELSE
678 removed = "no "
679 END IF
680
681 ! Write (special) keyword element
682
683 IF (keyword%names(1) == "_SECTION_PARAMETERS_") THEN
684 WRITE (unit=unit_number, fmt="(A)") &
685 repeat(" ", l0)//"<SECTION_PARAMETERS repeats="""//trim(repeats)// &
686 """ removed="""//trim(removed)//""">", &
687 repeat(" ", l1)//"<NAME type=""default"">SECTION_PARAMETERS</NAME>"
688 ELSE IF (keyword%names(1) == "_DEFAULT_KEYWORD_") THEN
689 WRITE (unit=unit_number, fmt="(A)") &
690 repeat(" ", l0)//"<DEFAULT_KEYWORD repeats="""//trim(repeats)//""">", &
691 repeat(" ", l1)//"<NAME type=""default"">DEFAULT_KEYWORD</NAME>"
692 ELSE
693 WRITE (unit=unit_number, fmt="(A)") &
694 repeat(" ", l0)//"<KEYWORD repeats="""//trim(repeats)// &
695 """ removed="""//trim(removed)//""">", &
696 repeat(" ", l1)//"<NAME type=""default"">"// &
697 trim(keyword%names(1))//"</NAME>"
698 END IF
699
700 DO i = 2, SIZE(keyword%names)
701 WRITE (unit=unit_number, fmt="(A)") &
702 repeat(" ", l1)//"<NAME type=""alias"">"// &
703 trim(keyword%names(i))//"</NAME>"
704 END DO
705
706 SELECT CASE (keyword%type_of_var)
707 CASE (logical_t)
708 WRITE (unit=unit_number, fmt="(A)") &
709 repeat(" ", l1)//"<DATA_TYPE kind=""logical"">"
710 CASE (integer_t)
711 WRITE (unit=unit_number, fmt="(A)") &
712 repeat(" ", l1)//"<DATA_TYPE kind=""integer"">"
713 CASE (real_t)
714 WRITE (unit=unit_number, fmt="(A)") &
715 repeat(" ", l1)//"<DATA_TYPE kind=""real"">"
716 CASE (char_t)
717 WRITE (unit=unit_number, fmt="(A)") &
718 repeat(" ", l1)//"<DATA_TYPE kind=""word"">"
719 CASE (lchar_t)
720 WRITE (unit=unit_number, fmt="(A)") &
721 repeat(" ", l1)//"<DATA_TYPE kind=""string"">"
722 CASE (enum_t)
723 WRITE (unit=unit_number, fmt="(A)") &
724 repeat(" ", l1)//"<DATA_TYPE kind=""keyword"">"
725 IF (keyword%enum%strict) THEN
726 WRITE (unit=unit_number, fmt="(A)") &
727 repeat(" ", l2)//"<ENUMERATION strict=""yes"">"
728 ELSE
729 WRITE (unit=unit_number, fmt="(A)") &
730 repeat(" ", l2)//"<ENUMERATION strict=""no"">"
731 END IF
732 DO i = 1, SIZE(keyword%enum%c_vals)
733 WRITE (unit=unit_number, fmt="(A)") &
734 repeat(" ", l3)//"<ITEM>", &
735 repeat(" ", l4)//"<NAME>"// &
736 trim(adjustl(substitute_special_xml_tokens(keyword%enum%c_vals(i))))//"</NAME>", &
737 repeat(" ", l4)//"<DESCRIPTION>"// &
738 trim(adjustl(substitute_special_xml_tokens(a2s(keyword%enum%desc(i)%chars)))) &
739 //"</DESCRIPTION>", repeat(" ", l3)//"</ITEM>"
740 END DO
741 WRITE (unit=unit_number, fmt="(A)") repeat(" ", l2)//"</ENUMERATION>"
742 CASE (no_t)
743 WRITE (unit=unit_number, fmt="(A)") &
744 repeat(" ", l1)//"<DATA_TYPE kind=""non-standard type"">"
745 CASE DEFAULT
746 cpabort("")
747 END SELECT
748
749 short_string = ""
750 WRITE (unit=short_string, fmt="(I8)") keyword%n_var
751 WRITE (unit=unit_number, fmt="(A)") &
752 repeat(" ", l2)//"<N_VAR>"//trim(adjustl(short_string))//"</N_VAR>", &
753 repeat(" ", l1)//"</DATA_TYPE>"
754
755 WRITE (unit=unit_number, fmt="(A)") repeat(" ", l1)//"<USAGE>"// &
756 trim(substitute_special_xml_tokens(keyword%usage)) &
757 //"</USAGE>"
758
759 WRITE (unit=unit_number, fmt="(A)") repeat(" ", l1)//"<DESCRIPTION>"// &
760 trim(substitute_special_xml_tokens(a2s(keyword%description))) &
761 //"</DESCRIPTION>"
762
763 IF (ALLOCATED(keyword%deprecation_notice)) &
764 WRITE (unit=unit_number, fmt="(A)") repeat(" ", l1)//"<DEPRECATION_NOTICE>"// &
765 trim(substitute_special_xml_tokens(keyword%deprecation_notice)) &
766 //"</DEPRECATION_NOTICE>"
767
768 IF (ASSOCIATED(keyword%default_value) .AND. &
769 (keyword%type_of_var /= no_t)) THEN
770 IF (ASSOCIATED(keyword%unit)) THEN
771 CALL val_write_internal(val=keyword%default_value, &
772 string=string, &
773 unit=keyword%unit)
774 ELSE
775 CALL val_write_internal(val=keyword%default_value, &
776 string=string)
777 END IF
778 CALL compress(string)
779 WRITE (unit=unit_number, fmt="(A)") &
780 repeat(" ", l1)//"<DEFAULT_VALUE>"// &
781 trim(adjustl(substitute_special_xml_tokens(string)))//"</DEFAULT_VALUE>"
782 END IF
783
784 IF (ASSOCIATED(keyword%unit)) THEN
785 string = cp_unit_desc(keyword%unit, accept_undefined=.true.)
786 WRITE (unit=unit_number, fmt="(A)") &
787 repeat(" ", l1)//"<DEFAULT_UNIT>"// &
788 trim(adjustl(string))//"</DEFAULT_UNIT>"
789 END IF
790
791 IF (ASSOCIATED(keyword%lone_keyword_value) .AND. &
792 (keyword%type_of_var /= no_t)) THEN
793 CALL val_write_internal(val=keyword%lone_keyword_value, &
794 string=string)
795 WRITE (unit=unit_number, fmt="(A)") &
796 repeat(" ", l1)//"<LONE_KEYWORD_VALUE>"// &
797 trim(adjustl(substitute_special_xml_tokens(string)))//"</LONE_KEYWORD_VALUE>"
798 END IF
799
800 IF (ASSOCIATED(keyword%citations)) THEN
801 DO i = 1, SIZE(keyword%citations, 1)
802 short_string = ""
803 WRITE (unit=short_string, fmt="(I8)") keyword%citations(i)
804 WRITE (unit=unit_number, fmt="(A)") &
805 repeat(" ", l1)//"<REFERENCE>", &
806 repeat(" ", l2)//"<NAME>"//trim(get_citation_key(keyword%citations(i)))//"</NAME>", &
807 repeat(" ", l2)//"<NUMBER>"//trim(adjustl(short_string))//"</NUMBER>", &
808 repeat(" ", l1)//"</REFERENCE>"
809 END DO
810 END IF
811
812 WRITE (unit=unit_number, fmt="(A)") &
813 repeat(" ", l1)//"<LOCATION>"//trim(keyword%location)//"</LOCATION>"
814
815 ! Close (special) keyword section
816
817 IF (keyword%names(1) == "_SECTION_PARAMETERS_") THEN
818 WRITE (unit=unit_number, fmt="(A)") &
819 repeat(" ", l0)//"</SECTION_PARAMETERS>"
820 ELSE IF (keyword%names(1) == "_DEFAULT_KEYWORD_") THEN
821 WRITE (unit=unit_number, fmt="(A)") &
822 repeat(" ", l0)//"</DEFAULT_KEYWORD>"
823 ELSE
824 WRITE (unit=unit_number, fmt="(A)") &
825 repeat(" ", l0)//"</KEYWORD>"
826 END IF
827
828 END SUBROUTINE write_keyword_xml
829
830! **************************************************************************************************
831!> \brief ...
832!> \param keyword ...
833!> \param unknown_string ...
834!> \param location_string ...
835!> \param matching_rank ...
836!> \param matching_string ...
837!> \param bonus ...
838! **************************************************************************************************
839 SUBROUTINE keyword_typo_match(keyword, unknown_string, location_string, matching_rank, matching_string, bonus)
840
841 TYPE(keyword_type), POINTER :: keyword
842 CHARACTER(LEN=*) :: unknown_string, location_string
843 INTEGER, DIMENSION(:), INTENT(INOUT) :: matching_rank
844 CHARACTER(LEN=*), DIMENSION(:), INTENT(INOUT) :: matching_string
845 INTEGER, INTENT(IN) :: bonus
846
847 CHARACTER(LEN=LEN(matching_string(1))) :: line
848 INTEGER :: i, imatch, imax, irank, j, k
849
850 cpassert(ASSOCIATED(keyword))
851 cpassert(keyword%ref_count > 0)
852
853 DO i = 1, SIZE(keyword%names)
854 imatch = typo_match(trim(keyword%names(i)), trim(unknown_string))
855 IF (imatch > 0) THEN
856 imatch = imatch + bonus
857 WRITE (line, '(T2,A)') " keyword "//trim(keyword%names(i))//" in section "//trim(location_string)
858 imax = SIZE(matching_rank, 1)
859 irank = imax + 1
860 DO k = imax, 1, -1
861 IF (imatch > matching_rank(k)) irank = k
862 END DO
863 IF (irank <= imax) THEN
864 matching_rank(irank + 1:imax) = matching_rank(irank:imax - 1)
865 matching_string(irank + 1:imax) = matching_string(irank:imax - 1)
866 matching_rank(irank) = imatch
867 matching_string(irank) = line
868 END IF
869 END IF
870
871 IF (keyword%type_of_var == enum_t) THEN
872 DO j = 1, SIZE(keyword%enum%c_vals)
873 imatch = typo_match(trim(keyword%enum%c_vals(j)), trim(unknown_string))
874 IF (imatch > 0) THEN
875 imatch = imatch + bonus
876 WRITE (line, '(T2,A)') " enum "//trim(keyword%enum%c_vals(j))// &
877 " in section "//trim(location_string)// &
878 " for keyword "//trim(keyword%names(i))
879 imax = SIZE(matching_rank, 1)
880 irank = imax + 1
881 DO k = imax, 1, -1
882 IF (imatch > matching_rank(k)) irank = k
883 END DO
884 IF (irank <= imax) THEN
885 matching_rank(irank + 1:imax) = matching_rank(irank:imax - 1)
886 matching_string(irank + 1:imax) = matching_string(irank:imax - 1)
887 matching_rank(irank) = imatch
888 matching_string(irank) = line
889 END IF
890 END IF
891 END DO
892 END IF
893 END DO
894
895 END SUBROUTINE keyword_typo_match
896
897END MODULE input_keyword_types
imax
static int imax(int x, int y)
Returns the larger of two given integers (missing from the C standard)
Definition dbm_internal.h:15
cp_units
unit conversion facility
Definition cp_units.F:30
cp_units::cp_unit_desc
character(len=cp_unit_desc_length) function, public cp_unit_desc(unit, defaults, accept_undefined)
returns the "name" of the given unit
Definition cp_units.F:1035
cp_units::cp_unit_create
subroutine, public cp_unit_create(unit, string)
creates a unit parsing a string
Definition cp_units.F:162
cp_units::cp_unit_desc_length
integer, parameter, public cp_unit_desc_length
Definition cp_units.F:116
cp_units::cp_unit_release
elemental subroutine, public cp_unit_release(unit)
releases the given unit
Definition cp_units.F:544
input_enumeration_types
represents an enumeration, i.e. a mapping between integers and strings
Definition input_enumeration_types.F:14
input_enumeration_types::enum_create
subroutine, public enum_create(enum, c_vals, i_vals, desc, strict)
creates an enumeration
Definition input_enumeration_types.F:64
input_enumeration_types::enum_release
subroutine, public enum_release(enum)
releases the given enumeration
Definition input_enumeration_types.F:124
input_enumeration_types::enum_retain
subroutine, public enum_retain(enum)
retains the given enumeration
Definition input_enumeration_types.F:111
input_keyword_types
represents keywords in an input
Definition input_keyword_types.F:14
input_keyword_types::keyword_retain
subroutine, public keyword_retain(keyword)
retains the given keyword (see doc/ReferenceCounting.html)
Definition input_keyword_types.F:427
input_keyword_types::usage_string_length
integer, parameter, public usage_string_length
Definition input_keyword_types.F:44
input_keyword_types::keyword_describe
subroutine, public keyword_describe(keyword, unit_nr, level)
writes out a description of the keyword
Definition input_keyword_types.F:515
input_keyword_types::write_keyword_xml
subroutine, public write_keyword_xml(keyword, level, unit_number)
Prints a description of a keyword in XML format.
Definition input_keyword_types.F:649
input_keyword_types::keyword_get
subroutine, public keyword_get(keyword, names, usage, description, type_of_var, n_var, default_value, lone_keyword_value, repeats, enum, citations)
...
Definition input_keyword_types.F:481
input_keyword_types::keyword_release
subroutine, public keyword_release(keyword)
releases the given keyword (see doc/ReferenceCounting.html)
Definition input_keyword_types.F:440
input_keyword_types::keyword_typo_match
subroutine, public keyword_typo_match(keyword, unknown_string, location_string, matching_rank, matching_string, bonus)
...
Definition input_keyword_types.F:840
input_keyword_types::keyword_create
subroutine, public keyword_create(keyword, location, name, description, usage, type_of_var, n_var, repeats, variants, default_val, default_l_val, default_r_val, default_lc_val, default_c_val, default_i_val, default_l_vals, default_r_vals, default_c_vals, default_i_vals, lone_keyword_val, lone_keyword_l_val, lone_keyword_r_val, lone_keyword_c_val, lone_keyword_i_val, lone_keyword_l_vals, lone_keyword_r_vals, lone_keyword_c_vals, lone_keyword_i_vals, enum_c_vals, enum_i_vals, enum, enum_strict, enum_desc, unit_str, citations, deprecation_notice, removed)
creates a keyword object
Definition input_keyword_types.F:156
input_val_types
a wrapper for basic fortran types.
Definition input_val_types.F:14
input_val_types::real_t
integer, parameter, public real_t
Definition input_val_types.F:41
input_val_types::lchar_t
integer, parameter, public lchar_t
Definition input_val_types.F:41
input_val_types::logical_t
integer, parameter, public logical_t
Definition input_val_types.F:41
input_val_types::val_retain
subroutine, public val_retain(val)
retains the given val
Definition input_val_types.F:297
input_val_types::val_write
subroutine, public val_write(val, unit_nr, unit, unit_str, fmt)
writes out the values stored in the val
Definition input_val_types.F:477
input_val_types::val_write_internal
subroutine, public val_write_internal(val, string, unit)
Write values to an internal file, i.e. string variable.
Definition input_val_types.F:651
input_val_types::val_create
subroutine, public val_create(val, l_val, l_vals, l_vals_ptr, i_val, i_vals, i_vals_ptr, r_val, r_vals, r_vals_ptr, c_val, c_vals, c_vals_ptr, lc_val, lc_vals, lc_vals_ptr, enum)
creates a keyword value
Definition input_val_types.F:103
input_val_types::val_release
subroutine, public val_release(val)
releases the given val
Definition input_val_types.F:262
input_val_types::char_t
integer, parameter, public char_t
Definition input_val_types.F:41
input_val_types::integer_t
integer, parameter, public integer_t
Definition input_val_types.F:41
input_val_types::no_t
integer, parameter, public no_t
Definition input_val_types.F:41
input_val_types::enum_t
integer, parameter, public enum_t
Definition input_val_types.F:41
kinds
Defines the basic variable types.
Definition kinds.F:23
kinds::dp
integer, parameter, public dp
Definition kinds.F:34
kinds::default_string_length
integer, parameter, public default_string_length
Definition kinds.F:57
print_messages
Perform an abnormal program termination.
Definition print_messages.F:21
print_messages::print_message
subroutine, public print_message(message, output_unit, declev, before, after)
Perform a basic blocking of the text in message and print it optionally decorated with a frame of sta...
Definition print_messages.F:56
reference_manager
provides a uniform framework to add references to CP2K cite and output these
Definition reference_manager.F:25
reference_manager::get_citation_key
pure character(len=default_string_length) function, public get_citation_key(key)
...
Definition reference_manager.F:341
string_utilities
Utilities for string manipulations.
Definition string_utilities.F:16
string_utilities::compress
subroutine, public compress(string, full)
Eliminate multiple space characters in a string. If full is .TRUE., then all spaces are eliminated.
Definition string_utilities.F:3191
string_utilities::typo_match
elemental integer function, public typo_match(string, typo_string)
returns a non-zero positive value if typo_string equals string apart from a few typos....
Definition string_utilities.F:71
string_utilities::a2s
pure character(len=size(array)) function, public a2s(array)
Converts a character-array into a string.
Definition string_utilities.F:135
string_utilities::substitute_special_xml_tokens
character(len=2 *len(inp_string)) function, public substitute_special_xml_tokens(inp_string)
Substitutes the five predefined XML entities: &, <, >, ', and ".
Definition string_utilities.F:3299
string_utilities::uppercase
elemental subroutine, public uppercase(string)
Convert all lower case characters in a string to upper case.
Definition string_utilities.F:3362
cp_units::cp_unit_type
stores a unit
Definition cp_units.F:131
input_enumeration_types::enumeration_type
Definition input_enumeration_types.F:43
input_keyword_types::keyword_p_type
represent a pointer to a keyword (to make arrays of pointers)
Definition input_keyword_types.F:55
input_keyword_types::keyword_type
represent a keyword in the input
Definition input_keyword_types.F:89
input_val_types::val_type
a type to have a wrapper that stores any basic fortran type
Definition input_val_types.F:63