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