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