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