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