(git:e7e05ae)
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-2024 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,&
16  cp_unit_desc,&
18  cp_unit_type
20  enum_release,&
21  enum_retain,&
22  enumeration_type
23  USE input_val_types, ONLY: &
26  USE kinds, ONLY: default_string_length,&
27  dp
28  USE print_messages, ONLY: print_message
30  USE string_utilities, ONLY: a2s,&
31  compress,&
33  typo_match,&
34  uppercase
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 
45  PUBLIC :: keyword_p_type, keyword_type, keyword_create, keyword_retain, &
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 ! **************************************************************************************************
54  TYPE keyword_p_type
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 ! **************************************************************************************************
88  TYPE keyword_type
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 
104 CONTAINS
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  INTEGER :: i, n
195  LOGICAL :: check
196 
197  cpassert(.NOT. ASSOCIATED(keyword))
198  ALLOCATE (keyword)
199  keyword%ref_count = 1
200  NULLIFY (keyword%unit)
201  keyword%location = location
202  keyword%removed = .false.
203 
204  cpassert(len_trim(name) > 0)
205 
206  IF (PRESENT(variants)) THEN
207  ALLOCATE (keyword%names(SIZE(variants) + 1))
208  keyword%names(1) = name
209  DO i = 1, SIZE(variants)
210  cpassert(len_trim(variants(i)) > 0)
211  keyword%names(i + 1) = variants(i)
212  END DO
213  ELSE
214  ALLOCATE (keyword%names(1))
215  keyword%names(1) = name
216  END IF
217  DO i = 1, SIZE(keyword%names)
218  CALL uppercase(keyword%names(i))
219  END DO
220 
221  IF (PRESENT(usage)) THEN
222  cpassert(len_trim(usage) <= len(keyword%usage))
223  keyword%usage = usage
224  ELSE
225  keyword%usage = ""
226  END IF
227 
228  n = len_trim(description)
229  ALLOCATE (keyword%description(n))
230  DO i = 1, n
231  keyword%description(i) = description(i:i)
232  END DO
233 
234  IF (PRESENT(citations)) THEN
235  ALLOCATE (keyword%citations(SIZE(citations, 1)))
236  keyword%citations = citations
237  ELSE
238  NULLIFY (keyword%citations)
239  END IF
240 
241  keyword%repeats = .false.
242  IF (PRESENT(repeats)) keyword%repeats = repeats
243 
244  NULLIFY (keyword%enum)
245  IF (PRESENT(enum)) THEN
246  keyword%enum => enum
247  IF (ASSOCIATED(enum)) CALL enum_retain(enum)
248  END IF
249  IF (PRESENT(enum_i_vals)) THEN
250  cpassert(PRESENT(enum_c_vals))
251  cpassert(.NOT. ASSOCIATED(keyword%enum))
252  CALL enum_create(keyword%enum, c_vals=enum_c_vals, i_vals=enum_i_vals, &
253  desc=enum_desc, strict=enum_strict)
254  ELSE
255  cpassert(.NOT. PRESENT(enum_c_vals))
256  END IF
257 
258  NULLIFY (keyword%default_value, keyword%lone_keyword_value)
259  IF (PRESENT(default_val)) THEN
260  IF (PRESENT(default_l_val) .OR. PRESENT(default_l_vals) .OR. &
261  PRESENT(default_i_val) .OR. PRESENT(default_i_vals) .OR. &
262  PRESENT(default_r_val) .OR. PRESENT(default_r_vals) .OR. &
263  PRESENT(default_c_val) .OR. PRESENT(default_c_vals)) &
264  cpabort("you should pass either default_val or a default value, not both")
265  keyword%default_value => default_val
266  IF (ASSOCIATED(default_val%enum)) THEN
267  IF (ASSOCIATED(keyword%enum)) THEN
268  cpassert(ASSOCIATED(keyword%enum, default_val%enum))
269  ELSE
270  keyword%enum => default_val%enum
271  CALL enum_retain(keyword%enum)
272  END IF
273  ELSE
274  cpassert(.NOT. ASSOCIATED(keyword%enum))
275  END IF
276  CALL val_retain(default_val)
277  END IF
278  IF (.NOT. ASSOCIATED(keyword%default_value)) THEN
279  CALL val_create(keyword%default_value, l_val=default_l_val, &
280  l_vals=default_l_vals, i_val=default_i_val, i_vals=default_i_vals, &
281  r_val=default_r_val, r_vals=default_r_vals, c_val=default_c_val, &
282  c_vals=default_c_vals, lc_val=default_lc_val, enum=keyword%enum)
283  END IF
284 
285  keyword%type_of_var = keyword%default_value%type_of_var
286  IF (keyword%default_value%type_of_var == no_t) THEN
287  CALL val_release(keyword%default_value)
288  END IF
289 
290  IF (keyword%type_of_var == no_t) THEN
291  IF (PRESENT(type_of_var)) THEN
292  keyword%type_of_var = type_of_var
293  ELSE
294  CALL cp_abort(__location__, &
295  "keyword "//trim(keyword%names(1))// &
296  " assumed undefined type by default")
297  END IF
298  ELSE IF (PRESENT(type_of_var)) THEN
299  IF (keyword%type_of_var /= type_of_var) &
300  CALL cp_abort(__location__, &
301  "keyword "//trim(keyword%names(1))// &
302  " has a type different from the type of the default_value")
303  keyword%type_of_var = type_of_var
304  END IF
305 
306  IF (keyword%type_of_var == no_t) THEN
307  CALL val_create(keyword%default_value)
308  END IF
309 
310  IF (PRESENT(lone_keyword_val)) THEN
311  IF (PRESENT(lone_keyword_l_val) .OR. PRESENT(lone_keyword_l_vals) .OR. &
312  PRESENT(lone_keyword_i_val) .OR. PRESENT(lone_keyword_i_vals) .OR. &
313  PRESENT(lone_keyword_r_val) .OR. PRESENT(lone_keyword_r_vals) .OR. &
314  PRESENT(lone_keyword_c_val) .OR. PRESENT(lone_keyword_c_vals)) &
315  CALL cp_abort(__location__, &
316  "you should pass either lone_keyword_val or a lone_keyword value, not both")
317  keyword%lone_keyword_value => lone_keyword_val
318  CALL val_retain(lone_keyword_val)
319  IF (ASSOCIATED(lone_keyword_val%enum)) THEN
320  IF (ASSOCIATED(keyword%enum)) THEN
321  IF (.NOT. ASSOCIATED(keyword%enum, lone_keyword_val%enum)) &
322  cpabort("keyword%enum/=lone_keyword_val%enum")
323  ELSE
324  IF (ASSOCIATED(keyword%lone_keyword_value)) THEN
325  cpabort(.NOT." ASSOCIATED(keyword%lone_keyword_value)")
326  END IF
327  keyword%enum => lone_keyword_val%enum
328  CALL enum_retain(keyword%enum)
329  END IF
330  ELSE
331  cpassert(.NOT. ASSOCIATED(keyword%enum))
332  END IF
333  END IF
334  IF (.NOT. ASSOCIATED(keyword%lone_keyword_value)) THEN
335  CALL val_create(keyword%lone_keyword_value, l_val=lone_keyword_l_val, &
336  l_vals=lone_keyword_l_vals, i_val=lone_keyword_i_val, i_vals=lone_keyword_i_vals, &
337  r_val=lone_keyword_r_val, r_vals=lone_keyword_r_vals, c_val=lone_keyword_c_val, &
338  c_vals=lone_keyword_c_vals, enum=keyword%enum)
339  END IF
340  IF (ASSOCIATED(keyword%lone_keyword_value)) THEN
341  IF (keyword%lone_keyword_value%type_of_var == no_t) THEN
342  CALL val_release(keyword%lone_keyword_value)
343  ELSE
344  IF (keyword%lone_keyword_value%type_of_var /= keyword%type_of_var) &
345  cpabort("lone_keyword_value type incompatible with keyword type")
346  ! lc_val cannot have lone_keyword_value!
347  IF (keyword%type_of_var == enum_t) THEN
348  IF (keyword%enum%strict) THEN
349  check = .false.
350  DO i = 1, SIZE(keyword%enum%i_vals)
351  check = check .OR. (keyword%default_value%i_val(1) == keyword%enum%i_vals(i))
352  END DO
353  IF (.NOT. check) &
354  cpabort("default value not in enumeration : "//keyword%names(1))
355  END IF
356  END IF
357  END IF
358  END IF
359 
360  keyword%n_var = 1
361  IF (ASSOCIATED(keyword%default_value)) THEN
362  SELECT CASE (keyword%default_value%type_of_var)
363  CASE (logical_t)
364  keyword%n_var = SIZE(keyword%default_value%l_val)
365  CASE (integer_t)
366  keyword%n_var = SIZE(keyword%default_value%i_val)
367  CASE (enum_t)
368  IF (keyword%enum%strict) THEN
369  check = .false.
370  DO i = 1, SIZE(keyword%enum%i_vals)
371  check = check .OR. (keyword%default_value%i_val(1) == keyword%enum%i_vals(i))
372  END DO
373  IF (.NOT. check) &
374  cpabort("default value not in enumeration : "//keyword%names(1))
375  END IF
376  keyword%n_var = SIZE(keyword%default_value%i_val)
377  CASE (real_t)
378  keyword%n_var = SIZE(keyword%default_value%r_val)
379  CASE (char_t)
380  keyword%n_var = SIZE(keyword%default_value%c_val)
381  CASE (lchar_t)
382  keyword%n_var = 1
383  CASE (no_t)
384  keyword%n_var = 0
385  CASE default
386  cpabort("")
387  END SELECT
388  END IF
389  IF (PRESENT(n_var)) keyword%n_var = n_var
390  IF (keyword%type_of_var == lchar_t .AND. keyword%n_var /= 1) &
391  cpabort("arrays of lchar_t not supported : "//keyword%names(1))
392 
393  IF (PRESENT(unit_str)) THEN
394  ALLOCATE (keyword%unit)
395  CALL cp_unit_create(keyword%unit, unit_str)
396  END IF
397 
398  IF (PRESENT(deprecation_notice)) THEN
399  keyword%deprecation_notice = trim(deprecation_notice)
400  END IF
401 
402  IF (PRESENT(removed)) THEN
403  keyword%removed = removed
404  END IF
405  END SUBROUTINE keyword_create
406 
407 ! **************************************************************************************************
408 !> \brief retains the given keyword (see doc/ReferenceCounting.html)
409 !> \param keyword the keyword to retain
410 !> \author fawzi
411 ! **************************************************************************************************
412  SUBROUTINE keyword_retain(keyword)
413  TYPE(keyword_type), POINTER :: keyword
414 
415  cpassert(ASSOCIATED(keyword))
416  cpassert(keyword%ref_count > 0)
417  keyword%ref_count = keyword%ref_count + 1
418  END SUBROUTINE keyword_retain
419 
420 ! **************************************************************************************************
421 !> \brief releases the given keyword (see doc/ReferenceCounting.html)
422 !> \param keyword the keyword to release
423 !> \author fawzi
424 ! **************************************************************************************************
425  SUBROUTINE keyword_release(keyword)
426  TYPE(keyword_type), POINTER :: keyword
427 
428  IF (ASSOCIATED(keyword)) THEN
429  cpassert(keyword%ref_count > 0)
430  keyword%ref_count = keyword%ref_count - 1
431  IF (keyword%ref_count == 0) THEN
432  DEALLOCATE (keyword%names)
433  DEALLOCATE (keyword%description)
434  CALL val_release(keyword%default_value)
435  CALL val_release(keyword%lone_keyword_value)
436  CALL enum_release(keyword%enum)
437  IF (ASSOCIATED(keyword%unit)) THEN
438  CALL cp_unit_release(keyword%unit)
439  DEALLOCATE (keyword%unit)
440  END IF
441  IF (ASSOCIATED(keyword%citations)) THEN
442  DEALLOCATE (keyword%citations)
443  END IF
444  DEALLOCATE (keyword)
445  END IF
446  END IF
447  NULLIFY (keyword)
448  END SUBROUTINE keyword_release
449 
450 ! **************************************************************************************************
451 !> \brief ...
452 !> \param keyword ...
453 !> \param names ...
454 !> \param usage ...
455 !> \param description ...
456 !> \param type_of_var ...
457 !> \param n_var ...
458 !> \param default_value ...
459 !> \param lone_keyword_value ...
460 !> \param repeats ...
461 !> \param enum ...
462 !> \param citations ...
463 !> \author fawzi
464 ! **************************************************************************************************
465  SUBROUTINE keyword_get(keyword, names, usage, description, type_of_var, n_var, &
466  default_value, lone_keyword_value, repeats, enum, citations)
467  TYPE(keyword_type), POINTER :: keyword
468  CHARACTER(len=default_string_length), &
469  DIMENSION(:), OPTIONAL, POINTER :: names
470  CHARACTER(len=*), INTENT(out), OPTIONAL :: usage, description
471  INTEGER, INTENT(out), OPTIONAL :: type_of_var, n_var
472  TYPE(val_type), OPTIONAL, POINTER :: default_value, lone_keyword_value
473  LOGICAL, INTENT(out), OPTIONAL :: repeats
474  TYPE(enumeration_type), OPTIONAL, POINTER :: enum
475  INTEGER, DIMENSION(:), OPTIONAL, POINTER :: citations
476 
477  cpassert(ASSOCIATED(keyword))
478  cpassert(keyword%ref_count > 0)
479  IF (PRESENT(names)) names => keyword%names
480  IF (PRESENT(usage)) usage = keyword%usage
481  IF (PRESENT(description)) description = a2s(keyword%description)
482  IF (PRESENT(type_of_var)) type_of_var = keyword%type_of_var
483  IF (PRESENT(n_var)) n_var = keyword%n_var
484  IF (PRESENT(repeats)) repeats = keyword%repeats
485  IF (PRESENT(default_value)) default_value => keyword%default_value
486  IF (PRESENT(lone_keyword_value)) lone_keyword_value => keyword%lone_keyword_value
487  IF (PRESENT(enum)) enum => keyword%enum
488  IF (PRESENT(citations)) citations => keyword%citations
489  END SUBROUTINE keyword_get
490 
491 ! **************************************************************************************************
492 !> \brief writes out a description of the keyword
493 !> \param keyword the keyword to describe
494 !> \param unit_nr the unit to write to
495 !> \param level the description level (0 no description, 1 name
496 !> 2: +usage, 3: +variants+description+default_value+repeats
497 !> 4: +type_of_var)
498 !> \author fawzi
499 ! **************************************************************************************************
500  SUBROUTINE keyword_describe(keyword, unit_nr, level)
501  TYPE(keyword_type), POINTER :: keyword
502  INTEGER, INTENT(in) :: unit_nr, level
503 
504  CHARACTER(len=default_string_length) :: c_string
505  INTEGER :: i, l
506 
507  cpassert(ASSOCIATED(keyword))
508  cpassert(keyword%ref_count > 0)
509  IF (level > 0 .AND. (unit_nr > 0)) THEN
510  WRITE (unit_nr, "(a,a,a)") " ---", &
511  trim(keyword%names(1)), "---"
512  IF (level > 1) THEN
513  WRITE (unit_nr, "(a,a)") "usage : ", trim(keyword%usage)
514  END IF
515  IF (level > 2) THEN
516  WRITE (unit_nr, "(a)") "description : "
517  CALL print_message(trim(a2s(keyword%description)), unit_nr, 0, 0, 0)
518  IF (level > 3) THEN
519  SELECT CASE (keyword%type_of_var)
520  CASE (logical_t)
521  IF (keyword%n_var == -1) THEN
522  WRITE (unit_nr, "(' A list of logicals is expected')")
523  ELSE IF (keyword%n_var == 1) THEN
524  WRITE (unit_nr, "(' A logical is expected')")
525  ELSE
526  WRITE (unit_nr, "(i6,' logicals are expected')") keyword%n_var
527  END IF
528  WRITE (unit_nr, "(' (T,TRUE,YES,ON) and (F,FALSE,NO,OFF) are synonyms')")
529  CASE (integer_t)
530  IF (keyword%n_var == -1) THEN
531  WRITE (unit_nr, "(' A list of integers is expected')")
532  ELSE IF (keyword%n_var == 1) THEN
533  WRITE (unit_nr, "(' An integer is expected')")
534  ELSE
535  WRITE (unit_nr, "(i6,' integers are expected')") keyword%n_var
536  END IF
537  CASE (real_t)
538  IF (keyword%n_var == -1) THEN
539  WRITE (unit_nr, "(' A list of reals is expected')")
540  ELSE IF (keyword%n_var == 1) THEN
541  WRITE (unit_nr, "(' A real is expected')")
542  ELSE
543  WRITE (unit_nr, "(i6,' reals are expected')") keyword%n_var
544  END IF
545  IF (ASSOCIATED(keyword%unit)) THEN
546  c_string = cp_unit_desc(keyword%unit, accept_undefined=.true.)
547  WRITE (unit_nr, "('the default unit of measure is ',a)") &
548  trim(c_string)
549  END IF
550  CASE (char_t)
551  IF (keyword%n_var == -1) THEN
552  WRITE (unit_nr, "(' A list of words is expected')")
553  ELSE IF (keyword%n_var == 1) THEN
554  WRITE (unit_nr, "(' A word is expected')")
555  ELSE
556  WRITE (unit_nr, "(i6,' words are expected')") keyword%n_var
557  END IF
558  CASE (lchar_t)
559  WRITE (unit_nr, "(' A string is expected')")
560  CASE (enum_t)
561  IF (keyword%n_var == -1) THEN
562  WRITE (unit_nr, "(' A list of keywords is expected')")
563  ELSE IF (keyword%n_var == 1) THEN
564  WRITE (unit_nr, "(' A keyword is expected')")
565  ELSE
566  WRITE (unit_nr, "(i6,' keywords are expected')") keyword%n_var
567  END IF
568  CASE (no_t)
569  WRITE (unit_nr, "(' Non-standard type.')")
570  CASE default
571  cpabort("")
572  END SELECT
573  END IF
574  IF (keyword%type_of_var == enum_t) THEN
575  IF (level > 3) THEN
576  WRITE (unit_nr, "(' valid keywords:')")
577  DO i = 1, SIZE(keyword%enum%c_vals)
578  c_string = keyword%enum%c_vals(i)
579  IF (len_trim(a2s(keyword%enum%desc(i)%chars)) > 0) THEN
580  WRITE (unit_nr, "(' - ',a,' : ',a,'.')") &
581  trim(c_string), trim(a2s(keyword%enum%desc(i)%chars))
582  ELSE
583  WRITE (unit_nr, "(' - ',a)") trim(c_string)
584  END IF
585  END DO
586  ELSE
587  WRITE (unit_nr, "(' valid keywords:')", advance='NO')
588  l = 17
589  DO i = 1, SIZE(keyword%enum%c_vals)
590  c_string = keyword%enum%c_vals(i)
591  IF (l + len_trim(c_string) > 72 .AND. l > 14) THEN
592  WRITE (unit_nr, "(/,' ')", advance='NO')
593  l = 4
594  END IF
595  WRITE (unit_nr, "(' ',a)", advance='NO') trim(c_string)
596  l = len_trim(c_string) + 3
597  END DO
598  WRITE (unit_nr, "()")
599  END IF
600  IF (.NOT. keyword%enum%strict) THEN
601  WRITE (unit_nr, "(' other integer values are also accepted.')")
602  END IF
603  END IF
604  IF (ASSOCIATED(keyword%default_value) .AND. keyword%type_of_var /= no_t) THEN
605  WRITE (unit_nr, "('default_value : ')", advance="NO")
606  CALL val_write(keyword%default_value, unit_nr=unit_nr)
607  END IF
608  IF (ASSOCIATED(keyword%lone_keyword_value) .AND. keyword%type_of_var /= no_t) THEN
609  WRITE (unit_nr, "('lone_keyword : ')", advance="NO")
610  CALL val_write(keyword%lone_keyword_value, unit_nr=unit_nr)
611  END IF
612  IF (keyword%repeats) THEN
613  WRITE (unit_nr, "(' and it can be repeated more than once')", advance="NO")
614  END IF
615  WRITE (unit_nr, "()")
616  IF (SIZE(keyword%names) > 1) THEN
617  WRITE (unit_nr, "(a)", advance="NO") "variants : "
618  DO i = 2, SIZE(keyword%names)
619  WRITE (unit_nr, "(a,' ')", advance="NO") keyword%names(i)
620  END DO
621  WRITE (unit_nr, "()")
622  END IF
623  END IF
624  END IF
625  END SUBROUTINE keyword_describe
626 
627 ! **************************************************************************************************
628 !> \brief Prints a description of a keyword in XML format
629 !> \param keyword The keyword to describe
630 !> \param level ...
631 !> \param unit_number Number of the output unit
632 !> \author Matthias Krack
633 ! **************************************************************************************************
634  SUBROUTINE write_keyword_xml(keyword, level, unit_number)
635 
636  TYPE(keyword_type), POINTER :: keyword
637  INTEGER, INTENT(IN) :: level, unit_number
638 
639  CHARACTER(LEN=1000) :: string
640  CHARACTER(LEN=3) :: removed, repeats
641  CHARACTER(LEN=8) :: short_string
642  INTEGER :: i, l0, l1, l2, l3, l4
643 
644  cpassert(ASSOCIATED(keyword))
645  cpassert(keyword%ref_count > 0)
646 
647  ! Indentation for current level, next level, etc.
648 
649  l0 = level
650  l1 = level + 1
651  l2 = level + 2
652  l3 = level + 3
653  l4 = level + 4
654 
655  IF (keyword%repeats) THEN
656  repeats = "yes"
657  ELSE
658  repeats = "no "
659  END IF
660 
661  IF (keyword%removed) THEN
662  removed = "yes"
663  ELSE
664  removed = "no "
665  END IF
666 
667  ! Write (special) keyword element
668 
669  IF (keyword%names(1) == "_SECTION_PARAMETERS_") THEN
670  WRITE (unit=unit_number, fmt="(A)") &
671  repeat(" ", l0)//"<SECTION_PARAMETERS repeats="""//trim(repeats)// &
672  """ removed="""//trim(removed)//""">", &
673  repeat(" ", l1)//"<NAME type=""default"">SECTION_PARAMETERS</NAME>"
674  ELSE IF (keyword%names(1) == "_DEFAULT_KEYWORD_") THEN
675  WRITE (unit=unit_number, fmt="(A)") &
676  repeat(" ", l0)//"<DEFAULT_KEYWORD repeats="""//trim(repeats)//""">", &
677  repeat(" ", l1)//"<NAME type=""default"">DEFAULT_KEYWORD</NAME>"
678  ELSE
679  WRITE (unit=unit_number, fmt="(A)") &
680  repeat(" ", l0)//"<KEYWORD repeats="""//trim(repeats)// &
681  """ removed="""//trim(removed)//""">", &
682  repeat(" ", l1)//"<NAME type=""default"">"// &
683  trim(keyword%names(1))//"</NAME>"
684  END IF
685 
686  DO i = 2, SIZE(keyword%names)
687  WRITE (unit=unit_number, fmt="(A)") &
688  repeat(" ", l1)//"<NAME type=""alias"">"// &
689  trim(keyword%names(i))//"</NAME>"
690  END DO
691 
692  SELECT CASE (keyword%type_of_var)
693  CASE (logical_t)
694  WRITE (unit=unit_number, fmt="(A)") &
695  repeat(" ", l1)//"<DATA_TYPE kind=""logical"">"
696  CASE (integer_t)
697  WRITE (unit=unit_number, fmt="(A)") &
698  repeat(" ", l1)//"<DATA_TYPE kind=""integer"">"
699  CASE (real_t)
700  WRITE (unit=unit_number, fmt="(A)") &
701  repeat(" ", l1)//"<DATA_TYPE kind=""real"">"
702  CASE (char_t)
703  WRITE (unit=unit_number, fmt="(A)") &
704  repeat(" ", l1)//"<DATA_TYPE kind=""word"">"
705  CASE (lchar_t)
706  WRITE (unit=unit_number, fmt="(A)") &
707  repeat(" ", l1)//"<DATA_TYPE kind=""string"">"
708  CASE (enum_t)
709  WRITE (unit=unit_number, fmt="(A)") &
710  repeat(" ", l1)//"<DATA_TYPE kind=""keyword"">"
711  IF (keyword%enum%strict) THEN
712  WRITE (unit=unit_number, fmt="(A)") &
713  repeat(" ", l2)//"<ENUMERATION strict=""yes"">"
714  ELSE
715  WRITE (unit=unit_number, fmt="(A)") &
716  repeat(" ", l2)//"<ENUMERATION strict=""no"">"
717  END IF
718  DO i = 1, SIZE(keyword%enum%c_vals)
719  WRITE (unit=unit_number, fmt="(A)") &
720  repeat(" ", l3)//"<ITEM>", &
721  repeat(" ", l4)//"<NAME>"// &
722  trim(adjustl(substitute_special_xml_tokens(keyword%enum%c_vals(i))))//"</NAME>", &
723  repeat(" ", l4)//"<DESCRIPTION>"// &
724  trim(adjustl(substitute_special_xml_tokens(a2s(keyword%enum%desc(i)%chars)))) &
725  //"</DESCRIPTION>", repeat(" ", l3)//"</ITEM>"
726  END DO
727  WRITE (unit=unit_number, fmt="(A)") repeat(" ", l2)//"</ENUMERATION>"
728  CASE (no_t)
729  WRITE (unit=unit_number, fmt="(A)") &
730  repeat(" ", l1)//"<DATA_TYPE kind=""non-standard type"">"
731  CASE DEFAULT
732  cpabort("")
733  END SELECT
734 
735  short_string = ""
736  WRITE (unit=short_string, fmt="(I8)") keyword%n_var
737  WRITE (unit=unit_number, fmt="(A)") &
738  repeat(" ", l2)//"<N_VAR>"//trim(adjustl(short_string))//"</N_VAR>", &
739  repeat(" ", l1)//"</DATA_TYPE>"
740 
741  WRITE (unit=unit_number, fmt="(A)") repeat(" ", l1)//"<USAGE>"// &
742  trim(substitute_special_xml_tokens(keyword%usage)) &
743  //"</USAGE>"
744 
745  WRITE (unit=unit_number, fmt="(A)") repeat(" ", l1)//"<DESCRIPTION>"// &
746  trim(substitute_special_xml_tokens(a2s(keyword%description))) &
747  //"</DESCRIPTION>"
748 
749  IF (ALLOCATED(keyword%deprecation_notice)) &
750  WRITE (unit=unit_number, fmt="(A)") repeat(" ", l1)//"<DEPRECATION_NOTICE>"// &
751  trim(substitute_special_xml_tokens(keyword%deprecation_notice)) &
752  //"</DEPRECATION_NOTICE>"
753 
754  IF (ASSOCIATED(keyword%default_value) .AND. &
755  (keyword%type_of_var /= no_t)) THEN
756  IF (ASSOCIATED(keyword%unit)) THEN
757  CALL val_write_internal(val=keyword%default_value, &
758  string=string, &
759  unit=keyword%unit)
760  ELSE
761  CALL val_write_internal(val=keyword%default_value, &
762  string=string)
763  END IF
764  CALL compress(string)
765  WRITE (unit=unit_number, fmt="(A)") &
766  repeat(" ", l1)//"<DEFAULT_VALUE>"// &
767  trim(adjustl(substitute_special_xml_tokens(string)))//"</DEFAULT_VALUE>"
768  END IF
769 
770  IF (ASSOCIATED(keyword%unit)) THEN
771  string = cp_unit_desc(keyword%unit, accept_undefined=.true.)
772  WRITE (unit=unit_number, fmt="(A)") &
773  repeat(" ", l1)//"<DEFAULT_UNIT>"// &
774  trim(adjustl(string))//"</DEFAULT_UNIT>"
775  END IF
776 
777  IF (ASSOCIATED(keyword%lone_keyword_value) .AND. &
778  (keyword%type_of_var /= no_t)) THEN
779  CALL val_write_internal(val=keyword%lone_keyword_value, &
780  string=string)
781  WRITE (unit=unit_number, fmt="(A)") &
782  repeat(" ", l1)//"<LONE_KEYWORD_VALUE>"// &
783  trim(adjustl(substitute_special_xml_tokens(string)))//"</LONE_KEYWORD_VALUE>"
784  END IF
785 
786  IF (ASSOCIATED(keyword%citations)) THEN
787  DO i = 1, SIZE(keyword%citations, 1)
788  short_string = ""
789  WRITE (unit=short_string, fmt="(I8)") keyword%citations(i)
790  WRITE (unit=unit_number, fmt="(A)") &
791  repeat(" ", l1)//"<REFERENCE>", &
792  repeat(" ", l2)//"<NAME>"//trim(get_citation_key(keyword%citations(i)))//"</NAME>", &
793  repeat(" ", l2)//"<NUMBER>"//trim(adjustl(short_string))//"</NUMBER>", &
794  repeat(" ", l1)//"</REFERENCE>"
795  END DO
796  END IF
797 
798  WRITE (unit=unit_number, fmt="(A)") &
799  repeat(" ", l1)//"<LOCATION>"//trim(keyword%location)//"</LOCATION>"
800 
801  ! Close (special) keyword section
802 
803  IF (keyword%names(1) == "_SECTION_PARAMETERS_") THEN
804  WRITE (unit=unit_number, fmt="(A)") &
805  repeat(" ", l0)//"</SECTION_PARAMETERS>"
806  ELSE IF (keyword%names(1) == "_DEFAULT_KEYWORD_") THEN
807  WRITE (unit=unit_number, fmt="(A)") &
808  repeat(" ", l0)//"</DEFAULT_KEYWORD>"
809  ELSE
810  WRITE (unit=unit_number, fmt="(A)") &
811  repeat(" ", l0)//"</KEYWORD>"
812  END IF
813 
814  END SUBROUTINE write_keyword_xml
815 
816 ! **************************************************************************************************
817 !> \brief ...
818 !> \param keyword ...
819 !> \param unknown_string ...
820 !> \param location_string ...
821 !> \param matching_rank ...
822 !> \param matching_string ...
823 !> \param bonus ...
824 ! **************************************************************************************************
825  SUBROUTINE keyword_typo_match(keyword, unknown_string, location_string, matching_rank, matching_string, bonus)
826 
827  TYPE(keyword_type), POINTER :: keyword
828  CHARACTER(LEN=*) :: unknown_string, location_string
829  INTEGER, DIMENSION(:), INTENT(INOUT) :: matching_rank
830  CHARACTER(LEN=*), DIMENSION(:), INTENT(INOUT) :: matching_string
831  INTEGER, INTENT(IN) :: bonus
832 
833  CHARACTER(LEN=LEN(matching_string(1))) :: line
834  INTEGER :: i, imatch, imax, irank, j, k
835 
836  cpassert(ASSOCIATED(keyword))
837  cpassert(keyword%ref_count > 0)
838 
839  DO i = 1, SIZE(keyword%names)
840  imatch = typo_match(trim(keyword%names(i)), trim(unknown_string))
841  IF (imatch > 0) THEN
842  imatch = imatch + bonus
843  WRITE (line, '(T2,A)') " keyword "//trim(keyword%names(i))//" in section "//trim(location_string)
844  imax = SIZE(matching_rank, 1)
845  irank = imax + 1
846  DO k = imax, 1, -1
847  IF (imatch > matching_rank(k)) irank = k
848  END DO
849  IF (irank <= imax) THEN
850  matching_rank(irank + 1:imax) = matching_rank(irank:imax - 1)
851  matching_string(irank + 1:imax) = matching_string(irank:imax - 1)
852  matching_rank(irank) = imatch
853  matching_string(irank) = line
854  END IF
855  END IF
856 
857  IF (keyword%type_of_var == enum_t) THEN
858  DO j = 1, SIZE(keyword%enum%c_vals)
859  imatch = typo_match(trim(keyword%enum%c_vals(j)), trim(unknown_string))
860  IF (imatch > 0) THEN
861  imatch = imatch + bonus
862  WRITE (line, '(T2,A)') " enum "//trim(keyword%enum%c_vals(j))// &
863  " in section "//trim(location_string)// &
864  " for keyword "//trim(keyword%names(i))
865  imax = SIZE(matching_rank, 1)
866  irank = imax + 1
867  DO k = imax, 1, -1
868  IF (imatch > matching_rank(k)) irank = k
869  END DO
870  IF (irank <= imax) THEN
871  matching_rank(irank + 1:imax) = matching_rank(irank:imax - 1)
872  matching_string(irank + 1:imax) = matching_string(irank:imax - 1)
873  matching_rank(irank) = imatch
874  matching_string(irank) = line
875  END IF
876  END IF
877  END DO
878  END IF
879  END DO
880 
881  END SUBROUTINE keyword_typo_match
882 
883 END MODULE input_keyword_types
static int imax(int x, int y)
Returns the larger of two given integer (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.