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