Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2022 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 : INTEGER, SAVE, PRIVATE :: last_keyword_id = 0
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
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, id_nr
91 : CHARACTER(LEN=default_string_length), DIMENSION(:), POINTER:: names
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
97 : INTEGER :: type_of_var, n_var
98 : LOGICAL :: repeats, removed
99 : TYPE(enumeration_type), POINTER :: enum
100 : TYPE(cp_unit_type), POINTER :: unit
101 : TYPE(val_type), POINTER :: default_value
102 : TYPE(val_type), POINTER :: lone_keyword_value
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 463553099 : SUBROUTINE keyword_create(keyword, location, name, description, usage, type_of_var, &
149 7326453 : n_var, repeats, variants, default_val, &
150 : default_l_val, default_r_val, default_lc_val, default_c_val, default_i_val, &
151 463553099 : 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 927106198 : lone_keyword_i_val, lone_keyword_l_vals, lone_keyword_r_vals, &
154 1390659297 : lone_keyword_c_vals, lone_keyword_i_vals, enum_c_vals, enum_i_vals, &
155 927106198 : 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 : INTEGER :: i, n
196 : LOGICAL :: check
197 :
198 463553099 : CPASSERT(.NOT. ASSOCIATED(keyword))
199 463553099 : ALLOCATE (keyword)
200 463553099 : keyword%ref_count = 1
201 463553099 : last_keyword_id = last_keyword_id + 1
202 463553099 : keyword%id_nr = last_keyword_id
203 463553099 : NULLIFY (keyword%unit)
204 463553099 : keyword%location = location
205 463553099 : keyword%removed = .FALSE.
206 :
207 463553099 : IF (PRESENT(variants)) THEN
208 21979359 : ALLOCATE (keyword%names(SIZE(variants) + 1))
209 7326453 : keyword%names(1) = name
210 15702477 : DO i = 1, SIZE(variants)
211 15702477 : keyword%names(i + 1) = variants(i)
212 : END DO
213 : ELSE
214 456226646 : ALLOCATE (keyword%names(1))
215 456226646 : keyword%names(1) = name
216 : END IF
217 935482222 : DO i = 1, SIZE(keyword%names)
218 935482222 : CALL uppercase(keyword%names(i))
219 : END DO
220 :
221 463553099 : IF (PRESENT(usage)) THEN
222 194147451 : CPASSERT(LEN_TRIM(usage) <= LEN(keyword%usage))
223 194147451 : keyword%usage = usage
224 : ELSE
225 269405648 : keyword%usage = ""
226 : END IF
227 :
228 463553099 : n = LEN_TRIM(description)
229 1390378209 : ALLOCATE (keyword%description(n))
230 24891132764 : DO i = 1, n
231 24891132764 : keyword%description(i) = description(i:i)
232 : END DO
233 :
234 463553099 : IF (PRESENT(citations)) THEN
235 2635230 : ALLOCATE (keyword%citations(SIZE(citations, 1)))
236 2463839 : keyword%citations = citations
237 : ELSE
238 462674689 : NULLIFY (keyword%citations)
239 : END IF
240 :
241 463553099 : keyword%repeats = .FALSE.
242 463553099 : IF (PRESENT(repeats)) keyword%repeats = repeats
243 :
244 463553099 : NULLIFY (keyword%enum)
245 463553099 : IF (PRESENT(enum)) THEN
246 0 : keyword%enum => enum
247 0 : IF (ASSOCIATED(enum)) CALL enum_retain(enum)
248 : END IF
249 463553099 : IF (PRESENT(enum_i_vals)) THEN
250 20167131 : CPASSERT(PRESENT(enum_c_vals))
251 20167131 : CPASSERT(.NOT. ASSOCIATED(keyword%enum))
252 : CALL enum_create(keyword%enum, c_vals=enum_c_vals, i_vals=enum_i_vals, &
253 36439755 : desc=enum_desc, strict=enum_strict)
254 : ELSE
255 443385968 : CPASSERT(.NOT. PRESENT(enum_c_vals))
256 : END IF
257 :
258 463553099 : NULLIFY (keyword%default_value, keyword%lone_keyword_value)
259 463553099 : 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(keyword%enum%id_nr == default_val%enum%id_nr)
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 463553099 : 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 4616118796 : c_vals=default_c_vals, lc_val=default_lc_val, enum=keyword%enum)
283 : END IF
284 :
285 463553099 : keyword%type_of_var = keyword%default_value%type_of_var
286 463553099 : IF (keyword%default_value%type_of_var == no_t) THEN
287 13771831 : CALL val_release(keyword%default_value)
288 : END IF
289 :
290 463553099 : IF (keyword%type_of_var == no_t) THEN
291 13771831 : IF (PRESENT(type_of_var)) THEN
292 13771831 : 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 449781268 : ELSE IF (PRESENT(type_of_var)) THEN
299 8489821 : 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 8489821 : keyword%type_of_var = type_of_var
304 : END IF
305 :
306 463553099 : IF (keyword%type_of_var == no_t) THEN
307 0 : CALL val_create(keyword%default_value)
308 : END IF
309 :
310 463553099 : 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 (keyword%enum%id_nr /= lone_keyword_val%enum%id_nr) &
322 0 : CPABORT("keyword%enum%id_nr==lone_keyword_val%enum%id_nr")
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 463553099 : 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 3708225028 : c_vals=lone_keyword_c_vals, enum=keyword%enum)
339 : END IF
340 463553099 : IF (ASSOCIATED(keyword%lone_keyword_value)) THEN
341 463553099 : IF (keyword%lone_keyword_value%type_of_var == no_t) THEN
342 399088897 : CALL val_release(keyword%lone_keyword_value)
343 : ELSE
344 64464202 : 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 64464202 : IF (keyword%type_of_var == enum_t) THEN
348 5914304 : IF (keyword%enum%strict) THEN
349 5914304 : check = .FALSE.
350 47593818 : DO i = 1, SIZE(keyword%enum%i_vals)
351 71723348 : check = check .OR. (keyword%default_value%i_val(1) == keyword%enum%i_vals(i))
352 : END DO
353 5914304 : 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 463553099 : keyword%n_var = 1
361 463553099 : IF (ASSOCIATED(keyword%default_value)) THEN
362 508963848 : SELECT CASE (keyword%default_value%type_of_var)
363 : CASE (logical_t)
364 59182580 : keyword%n_var = SIZE(keyword%default_value%l_val)
365 : CASE (integer_t)
366 128801699 : keyword%n_var = SIZE(keyword%default_value%i_val)
367 : CASE (enum_t)
368 20096072 : IF (keyword%enum%strict) THEN
369 20096072 : check = .FALSE.
370 113069044 : DO i = 1, SIZE(keyword%enum%i_vals)
371 145433112 : check = check .OR. (keyword%default_value%i_val(1) == keyword%enum%i_vals(i))
372 : END DO
373 20096072 : IF (.NOT. check) &
374 0 : CPABORT("default value not in enumeration : "//keyword%names(1))
375 : END IF
376 20096072 : keyword%n_var = SIZE(keyword%default_value%i_val)
377 : CASE (real_t)
378 233583799 : keyword%n_var = SIZE(keyword%default_value%r_val)
379 : CASE (char_t)
380 1550583 : keyword%n_var = SIZE(keyword%default_value%c_val)
381 : CASE (lchar_t)
382 6566535 : keyword%n_var = 1
383 : CASE (no_t)
384 0 : keyword%n_var = 0
385 : CASE default
386 449781268 : CPABORT("")
387 : END SELECT
388 : END IF
389 463553099 : IF (PRESENT(n_var)) keyword%n_var = n_var
390 463553099 : 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 463553099 : IF (PRESENT(unit_str)) THEN
394 9623941 : CALL cp_unit_create(keyword%unit, unit_str)
395 : END IF
396 :
397 463553099 : IF (PRESENT(deprecation_notice)) THEN
398 38410 : keyword%deprecation_notice = TRIM(deprecation_notice)
399 : END IF
400 :
401 463553099 : IF (PRESENT(removed)) THEN
402 30728 : keyword%removed = removed
403 : END IF
404 463553099 : END SUBROUTINE keyword_create
405 :
406 : ! **************************************************************************************************
407 : !> \brief retains the given keyword (see doc/ReferenceCounting.html)
408 : !> \param keyword the keyword to retain
409 : !> \author fawzi
410 : ! **************************************************************************************************
411 463553099 : SUBROUTINE keyword_retain(keyword)
412 : TYPE(keyword_type), POINTER :: keyword
413 :
414 463553099 : CPASSERT(ASSOCIATED(keyword))
415 463553099 : CPASSERT(keyword%ref_count > 0)
416 463553099 : keyword%ref_count = keyword%ref_count + 1
417 463553099 : END SUBROUTINE keyword_retain
418 :
419 : ! **************************************************************************************************
420 : !> \brief releases the given keyword (see doc/ReferenceCounting.html)
421 : !> \param keyword the keyword to release
422 : !> \author fawzi
423 : ! **************************************************************************************************
424 1206821593 : SUBROUTINE keyword_release(keyword)
425 : TYPE(keyword_type), POINTER :: keyword
426 :
427 1206821593 : IF (ASSOCIATED(keyword)) THEN
428 927106198 : CPASSERT(keyword%ref_count > 0)
429 927106198 : keyword%ref_count = keyword%ref_count - 1
430 927106198 : IF (keyword%ref_count == 0) THEN
431 463553099 : DEALLOCATE (keyword%names)
432 463553099 : DEALLOCATE (keyword%description)
433 463553099 : CALL val_release(keyword%default_value)
434 463553099 : CALL val_release(keyword%lone_keyword_value)
435 463553099 : CALL enum_release(keyword%enum)
436 463553099 : CALL cp_unit_release(keyword%unit)
437 463553099 : IF (ASSOCIATED(keyword%citations)) THEN
438 878410 : DEALLOCATE (keyword%citations)
439 : END IF
440 463553099 : DEALLOCATE (keyword)
441 : END IF
442 : END IF
443 1206821593 : NULLIFY (keyword)
444 1206821593 : END SUBROUTINE keyword_release
445 :
446 : ! **************************************************************************************************
447 : !> \brief ...
448 : !> \param keyword ...
449 : !> \param names ...
450 : !> \param usage ...
451 : !> \param description ...
452 : !> \param type_of_var ...
453 : !> \param n_var ...
454 : !> \param default_value ...
455 : !> \param lone_keyword_value ...
456 : !> \param repeats ...
457 : !> \param enum ...
458 : !> \param citations ...
459 : !> \author fawzi
460 : ! **************************************************************************************************
461 45246 : SUBROUTINE keyword_get(keyword, names, usage, description, type_of_var, n_var, &
462 : default_value, lone_keyword_value, repeats, enum, citations)
463 : TYPE(keyword_type), POINTER :: keyword
464 : CHARACTER(len=default_string_length), &
465 : DIMENSION(:), OPTIONAL, POINTER :: names
466 : CHARACTER(len=*), INTENT(out), OPTIONAL :: usage, description
467 : INTEGER, INTENT(out), OPTIONAL :: type_of_var, n_var
468 : TYPE(val_type), OPTIONAL, POINTER :: default_value, lone_keyword_value
469 : LOGICAL, INTENT(out), OPTIONAL :: repeats
470 : TYPE(enumeration_type), OPTIONAL, POINTER :: enum
471 : INTEGER, DIMENSION(:), OPTIONAL, POINTER :: citations
472 :
473 0 : CPASSERT(ASSOCIATED(keyword))
474 45246 : CPASSERT(keyword%ref_count > 0)
475 45246 : IF (PRESENT(names)) names => keyword%names
476 45246 : IF (PRESENT(usage)) usage = keyword%usage
477 45246 : IF (PRESENT(description)) description = a2s(keyword%description)
478 45246 : IF (PRESENT(type_of_var)) type_of_var = keyword%type_of_var
479 45246 : IF (PRESENT(n_var)) n_var = keyword%n_var
480 45246 : IF (PRESENT(repeats)) repeats = keyword%repeats
481 45246 : IF (PRESENT(default_value)) default_value => keyword%default_value
482 45246 : IF (PRESENT(lone_keyword_value)) lone_keyword_value => keyword%lone_keyword_value
483 45246 : IF (PRESENT(enum)) enum => keyword%enum
484 45246 : IF (PRESENT(citations)) citations => keyword%citations
485 45246 : END SUBROUTINE keyword_get
486 :
487 : ! **************************************************************************************************
488 : !> \brief writes out a description of the keyword
489 : !> \param keyword the keyword to describe
490 : !> \param unit_nr the unit to write to
491 : !> \param level the description level (0 no description, 1 name
492 : !> 2: +usage, 3: +variants+description+default_value+repeats
493 : !> 4: +type_of_var)
494 : !> \author fawzi
495 : ! **************************************************************************************************
496 19 : SUBROUTINE keyword_describe(keyword, unit_nr, level)
497 : TYPE(keyword_type), POINTER :: keyword
498 : INTEGER, INTENT(in) :: unit_nr, level
499 :
500 : CHARACTER(len=default_string_length) :: c_string
501 : INTEGER :: i, l
502 :
503 19 : CPASSERT(ASSOCIATED(keyword))
504 19 : CPASSERT(keyword%ref_count > 0)
505 19 : IF (level > 0 .AND. (unit_nr > 0)) THEN
506 19 : WRITE (unit_nr, "(a,a,a)") " ---", &
507 38 : TRIM(keyword%names(1)), "---"
508 19 : IF (level > 1) THEN
509 19 : WRITE (unit_nr, "(a,a)") "usage : ", TRIM(keyword%usage)
510 : END IF
511 19 : IF (level > 2) THEN
512 19 : WRITE (unit_nr, "(a)") "description : "
513 19 : CALL print_message(TRIM(a2s(keyword%description)), unit_nr, 0, 0, 0)
514 19 : IF (level > 3) THEN
515 0 : SELECT CASE (keyword%type_of_var)
516 : CASE (logical_t)
517 0 : IF (keyword%n_var == -1) THEN
518 0 : WRITE (unit_nr, "(' A list of logicals is expected')")
519 0 : ELSE IF (keyword%n_var == 1) THEN
520 0 : WRITE (unit_nr, "(' A logical is expected')")
521 : ELSE
522 0 : WRITE (unit_nr, "(i6,' logicals are expected')") keyword%n_var
523 : END IF
524 0 : WRITE (unit_nr, "(' (T,TRUE,YES,ON) and (F,FALSE,NO,OFF) are synonyms')")
525 : CASE (integer_t)
526 0 : IF (keyword%n_var == -1) THEN
527 0 : WRITE (unit_nr, "(' A list of integers is expected')")
528 0 : ELSE IF (keyword%n_var == 1) THEN
529 0 : WRITE (unit_nr, "(' An integer is expected')")
530 : ELSE
531 0 : WRITE (unit_nr, "(i6,' integers are expected')") keyword%n_var
532 : END IF
533 : CASE (real_t)
534 0 : IF (keyword%n_var == -1) THEN
535 0 : WRITE (unit_nr, "(' A list of reals is expected')")
536 0 : ELSE IF (keyword%n_var == 1) THEN
537 0 : WRITE (unit_nr, "(' A real is expected')")
538 : ELSE
539 0 : WRITE (unit_nr, "(i6,' reals are expected')") keyword%n_var
540 : END IF
541 0 : IF (ASSOCIATED(keyword%unit)) THEN
542 0 : c_string = cp_unit_desc(keyword%unit, accept_undefined=.TRUE.)
543 : WRITE (unit_nr, "('the default unit of measure is ',a)") &
544 0 : TRIM(c_string)
545 : END IF
546 : CASE (char_t)
547 0 : IF (keyword%n_var == -1) THEN
548 0 : WRITE (unit_nr, "(' A list of words is expected')")
549 0 : ELSE IF (keyword%n_var == 1) THEN
550 0 : WRITE (unit_nr, "(' A word is expected')")
551 : ELSE
552 0 : WRITE (unit_nr, "(i6,' words are expected')") keyword%n_var
553 : END IF
554 : CASE (lchar_t)
555 0 : WRITE (unit_nr, "(' A string is expected')")
556 : CASE (enum_t)
557 0 : IF (keyword%n_var == -1) THEN
558 0 : WRITE (unit_nr, "(' A list of keywords is expected')")
559 0 : ELSE IF (keyword%n_var == 1) THEN
560 0 : WRITE (unit_nr, "(' A keyword is expected')")
561 : ELSE
562 0 : WRITE (unit_nr, "(i6,' keywords are expected')") keyword%n_var
563 : END IF
564 : CASE (no_t)
565 0 : WRITE (unit_nr, "(' Non-standard type.')")
566 : CASE default
567 0 : CPABORT("")
568 : END SELECT
569 : END IF
570 19 : IF (keyword%type_of_var == enum_t) THEN
571 2 : IF (level > 3) THEN
572 0 : WRITE (unit_nr, "(' valid keywords:')")
573 0 : DO i = 1, SIZE(keyword%enum%c_vals)
574 0 : c_string = keyword%enum%c_vals(i)
575 0 : IF (LEN_TRIM(a2s(keyword%enum%desc(i)%chars)) > 0) THEN
576 : WRITE (unit_nr, "(' - ',a,' : ',a,'.')") &
577 0 : TRIM(c_string), TRIM(a2s(keyword%enum%desc(i)%chars))
578 : ELSE
579 0 : WRITE (unit_nr, "(' - ',a)") TRIM(c_string)
580 : END IF
581 : END DO
582 : ELSE
583 2 : WRITE (unit_nr, "(' valid keywords:')", advance='NO')
584 2 : l = 17
585 18 : DO i = 1, SIZE(keyword%enum%c_vals)
586 16 : c_string = keyword%enum%c_vals(i)
587 16 : IF (l + LEN_TRIM(c_string) > 72 .AND. l > 14) THEN
588 0 : WRITE (unit_nr, "(/,' ')", advance='NO')
589 0 : l = 4
590 : END IF
591 16 : WRITE (unit_nr, "(' ',a)", advance='NO') TRIM(c_string)
592 18 : l = LEN_TRIM(c_string) + 3
593 : END DO
594 2 : WRITE (unit_nr, "()")
595 : END IF
596 2 : IF (.NOT. keyword%enum%strict) THEN
597 0 : WRITE (unit_nr, "(' other integer values are also accepted.')")
598 : END IF
599 : END IF
600 19 : IF (ASSOCIATED(keyword%default_value) .AND. keyword%type_of_var /= no_t) THEN
601 17 : WRITE (unit_nr, "('default_value : ')", advance="NO")
602 17 : CALL val_write(keyword%default_value, unit_nr=unit_nr)
603 : END IF
604 19 : IF (ASSOCIATED(keyword%lone_keyword_value) .AND. keyword%type_of_var /= no_t) THEN
605 3 : WRITE (unit_nr, "('lone_keyword : ')", advance="NO")
606 3 : CALL val_write(keyword%lone_keyword_value, unit_nr=unit_nr)
607 : END IF
608 19 : IF (keyword%repeats) THEN
609 0 : WRITE (unit_nr, "(' and it can be repeated more than once')", advance="NO")
610 : END IF
611 19 : WRITE (unit_nr, "()")
612 19 : IF (SIZE(keyword%names) > 1) THEN
613 1 : WRITE (unit_nr, "(a)", advance="NO") "variants : "
614 3 : DO i = 2, SIZE(keyword%names)
615 3 : WRITE (unit_nr, "(a,' ')", advance="NO") keyword%names(i)
616 : END DO
617 1 : WRITE (unit_nr, "()")
618 : END IF
619 : END IF
620 : END IF
621 19 : END SUBROUTINE keyword_describe
622 :
623 : ! **************************************************************************************************
624 : !> \brief Prints a description of a keyword in XML format
625 : !> \param keyword The keyword to describe
626 : !> \param level ...
627 : !> \param unit_number Number of the output unit
628 : !> \author Matthias Krack
629 : ! **************************************************************************************************
630 0 : SUBROUTINE write_keyword_xml(keyword, level, unit_number)
631 :
632 : TYPE(keyword_type), POINTER :: keyword
633 : INTEGER, INTENT(IN) :: level, unit_number
634 :
635 : CHARACTER(LEN=1000) :: string
636 : CHARACTER(LEN=3) :: removed, repeats
637 : CHARACTER(LEN=8) :: short_string
638 : INTEGER :: i, l0, l1, l2, l3, l4
639 :
640 0 : CPASSERT(ASSOCIATED(keyword))
641 0 : CPASSERT(keyword%ref_count > 0)
642 :
643 : ! Indentation for current level, next level, etc.
644 :
645 0 : l0 = level
646 0 : l1 = level + 1
647 0 : l2 = level + 2
648 0 : l3 = level + 3
649 0 : l4 = level + 4
650 :
651 0 : IF (keyword%repeats) THEN
652 0 : repeats = "yes"
653 : ELSE
654 0 : repeats = "no "
655 : END IF
656 :
657 0 : IF (keyword%removed) THEN
658 0 : removed = "yes"
659 : ELSE
660 0 : removed = "no "
661 : END IF
662 :
663 : ! Write (special) keyword element
664 :
665 0 : IF (keyword%names(1) == "_SECTION_PARAMETERS_") THEN
666 0 : WRITE (UNIT=unit_number, FMT="(A)") &
667 : REPEAT(" ", l0)//"<SECTION_PARAMETERS repeats="""//TRIM(repeats)// &
668 0 : """ removed="""//TRIM(removed)//""">", &
669 0 : REPEAT(" ", l1)//"<NAME type=""default"">SECTION_PARAMETERS</NAME>"
670 0 : ELSE IF (keyword%names(1) == "_DEFAULT_KEYWORD_") THEN
671 0 : WRITE (UNIT=unit_number, FMT="(A)") &
672 0 : REPEAT(" ", l0)//"<DEFAULT_KEYWORD repeats="""//TRIM(repeats)//""">", &
673 0 : REPEAT(" ", l1)//"<NAME type=""default"">DEFAULT_KEYWORD</NAME>"
674 : ELSE
675 0 : WRITE (UNIT=unit_number, FMT="(A)") &
676 : REPEAT(" ", l0)//"<KEYWORD repeats="""//TRIM(repeats)// &
677 0 : """ removed="""//TRIM(removed)//""">", &
678 : REPEAT(" ", l1)//"<NAME type=""default"">"// &
679 0 : TRIM(keyword%names(1))//"</NAME>"
680 : END IF
681 :
682 0 : DO i = 2, SIZE(keyword%names)
683 0 : WRITE (UNIT=unit_number, FMT="(A)") &
684 : REPEAT(" ", l1)//"<NAME type=""alias"">"// &
685 0 : TRIM(keyword%names(i))//"</NAME>"
686 : END DO
687 :
688 0 : SELECT CASE (keyword%type_of_var)
689 : CASE (logical_t)
690 0 : WRITE (UNIT=unit_number, FMT="(A)") &
691 0 : REPEAT(" ", l1)//"<DATA_TYPE kind=""logical"">"
692 : CASE (integer_t)
693 0 : WRITE (UNIT=unit_number, FMT="(A)") &
694 0 : REPEAT(" ", l1)//"<DATA_TYPE kind=""integer"">"
695 : CASE (real_t)
696 0 : WRITE (UNIT=unit_number, FMT="(A)") &
697 0 : REPEAT(" ", l1)//"<DATA_TYPE kind=""real"">"
698 : CASE (char_t)
699 0 : WRITE (UNIT=unit_number, FMT="(A)") &
700 0 : REPEAT(" ", l1)//"<DATA_TYPE kind=""word"">"
701 : CASE (lchar_t)
702 0 : WRITE (UNIT=unit_number, FMT="(A)") &
703 0 : REPEAT(" ", l1)//"<DATA_TYPE kind=""string"">"
704 : CASE (enum_t)
705 0 : WRITE (UNIT=unit_number, FMT="(A)") &
706 0 : REPEAT(" ", l1)//"<DATA_TYPE kind=""keyword"">"
707 0 : IF (keyword%enum%strict) THEN
708 0 : WRITE (UNIT=unit_number, FMT="(A)") &
709 0 : REPEAT(" ", l2)//"<ENUMERATION strict=""yes"">"
710 : ELSE
711 0 : WRITE (UNIT=unit_number, FMT="(A)") &
712 0 : REPEAT(" ", l2)//"<ENUMERATION strict=""no"">"
713 : END IF
714 0 : DO i = 1, SIZE(keyword%enum%c_vals)
715 0 : WRITE (UNIT=unit_number, FMT="(A)") &
716 0 : REPEAT(" ", l3)//"<ITEM>", &
717 : REPEAT(" ", l4)//"<NAME>"// &
718 0 : TRIM(ADJUSTL(substitute_special_xml_tokens(keyword%enum%c_vals(i))))//"</NAME>", &
719 : REPEAT(" ", l4)//"<DESCRIPTION>"// &
720 : TRIM(ADJUSTL(substitute_special_xml_tokens(a2s(keyword%enum%desc(i)%chars)))) &
721 0 : //"</DESCRIPTION>", REPEAT(" ", l3)//"</ITEM>"
722 : END DO
723 0 : WRITE (UNIT=unit_number, FMT="(A)") REPEAT(" ", l2)//"</ENUMERATION>"
724 : CASE (no_t)
725 0 : WRITE (UNIT=unit_number, FMT="(A)") &
726 0 : REPEAT(" ", l1)//"<DATA_TYPE kind=""non-standard type"">"
727 : CASE DEFAULT
728 0 : CPABORT("")
729 : END SELECT
730 :
731 0 : short_string = ""
732 0 : WRITE (UNIT=short_string, FMT="(I8)") keyword%n_var
733 0 : WRITE (UNIT=unit_number, FMT="(A)") &
734 0 : REPEAT(" ", l2)//"<N_VAR>"//TRIM(ADJUSTL(short_string))//"</N_VAR>", &
735 0 : REPEAT(" ", l1)//"</DATA_TYPE>"
736 :
737 : WRITE (UNIT=unit_number, FMT="(A)") REPEAT(" ", l1)//"<USAGE>"// &
738 : TRIM(substitute_special_xml_tokens(keyword%usage)) &
739 0 : //"</USAGE>"
740 :
741 : WRITE (UNIT=unit_number, FMT="(A)") REPEAT(" ", l1)//"<DESCRIPTION>"// &
742 : TRIM(substitute_special_xml_tokens(a2s(keyword%description))) &
743 0 : //"</DESCRIPTION>"
744 :
745 0 : IF (ALLOCATED(keyword%deprecation_notice)) &
746 : WRITE (UNIT=unit_number, FMT="(A)") REPEAT(" ", l1)//"<DEPRECATION_NOTICE>"// &
747 : TRIM(substitute_special_xml_tokens(keyword%deprecation_notice)) &
748 0 : //"</DEPRECATION_NOTICE>"
749 :
750 0 : IF (ASSOCIATED(keyword%default_value) .AND. &
751 : (keyword%type_of_var /= no_t)) THEN
752 0 : IF (ASSOCIATED(keyword%unit)) THEN
753 : CALL val_write_internal(val=keyword%default_value, &
754 : string=string, &
755 0 : unit=keyword%unit)
756 : ELSE
757 : CALL val_write_internal(val=keyword%default_value, &
758 0 : string=string)
759 : END IF
760 0 : CALL compress(string)
761 : WRITE (UNIT=unit_number, FMT="(A)") &
762 : REPEAT(" ", l1)//"<DEFAULT_VALUE>"// &
763 0 : TRIM(ADJUSTL(substitute_special_xml_tokens(string)))//"</DEFAULT_VALUE>"
764 : END IF
765 :
766 0 : IF (ASSOCIATED(keyword%unit)) THEN
767 0 : string = cp_unit_desc(keyword%unit, accept_undefined=.TRUE.)
768 : WRITE (UNIT=unit_number, FMT="(A)") &
769 : REPEAT(" ", l1)//"<DEFAULT_UNIT>"// &
770 0 : TRIM(ADJUSTL(string))//"</DEFAULT_UNIT>"
771 : END IF
772 :
773 0 : IF (ASSOCIATED(keyword%lone_keyword_value) .AND. &
774 : (keyword%type_of_var /= no_t)) THEN
775 : CALL val_write_internal(val=keyword%lone_keyword_value, &
776 0 : string=string)
777 : WRITE (UNIT=unit_number, FMT="(A)") &
778 : REPEAT(" ", l1)//"<LONE_KEYWORD_VALUE>"// &
779 0 : TRIM(ADJUSTL(substitute_special_xml_tokens(string)))//"</LONE_KEYWORD_VALUE>"
780 : END IF
781 :
782 0 : IF (ASSOCIATED(keyword%citations)) THEN
783 0 : DO i = 1, SIZE(keyword%citations, 1)
784 0 : short_string = ""
785 0 : WRITE (UNIT=short_string, FMT="(I8)") keyword%citations(i)
786 : WRITE (UNIT=unit_number, FMT="(A)") &
787 0 : REPEAT(" ", l1)//"<REFERENCE>", &
788 0 : REPEAT(" ", l2)//"<NAME>"//TRIM(get_citation_key(keyword%citations(i)))//"</NAME>", &
789 0 : REPEAT(" ", l2)//"<NUMBER>"//TRIM(ADJUSTL(short_string))//"</NUMBER>", &
790 0 : REPEAT(" ", l1)//"</REFERENCE>"
791 : END DO
792 : END IF
793 :
794 : WRITE (UNIT=unit_number, FMT="(A)") &
795 0 : REPEAT(" ", l1)//"<LOCATION>"//TRIM(keyword%location)//"</LOCATION>"
796 :
797 : ! Close (special) keyword section
798 :
799 0 : IF (keyword%names(1) == "_SECTION_PARAMETERS_") THEN
800 0 : WRITE (UNIT=unit_number, FMT="(A)") &
801 0 : REPEAT(" ", l0)//"</SECTION_PARAMETERS>"
802 0 : ELSE IF (keyword%names(1) == "_DEFAULT_KEYWORD_") THEN
803 0 : WRITE (UNIT=unit_number, FMT="(A)") &
804 0 : REPEAT(" ", l0)//"</DEFAULT_KEYWORD>"
805 : ELSE
806 0 : WRITE (UNIT=unit_number, FMT="(A)") &
807 0 : REPEAT(" ", l0)//"</KEYWORD>"
808 : END IF
809 :
810 0 : END SUBROUTINE write_keyword_xml
811 :
812 : ! **************************************************************************************************
813 : !> \brief ...
814 : !> \param keyword ...
815 : !> \param unknown_string ...
816 : !> \param location_string ...
817 : !> \param matching_rank ...
818 : !> \param matching_string ...
819 : !> \param bonus ...
820 : ! **************************************************************************************************
821 0 : SUBROUTINE keyword_typo_match(keyword, unknown_string, location_string, matching_rank, matching_string, bonus)
822 :
823 : TYPE(keyword_type), POINTER :: keyword
824 : CHARACTER(LEN=*) :: unknown_string, location_string
825 : INTEGER, DIMENSION(:), INTENT(INOUT) :: matching_rank
826 : CHARACTER(LEN=*), DIMENSION(:), INTENT(INOUT) :: matching_string
827 : INTEGER, INTENT(IN) :: bonus
828 :
829 0 : CHARACTER(LEN=LEN(matching_string(1))) :: line
830 : INTEGER :: i, imatch, imax, irank, j, k
831 :
832 0 : CPASSERT(ASSOCIATED(keyword))
833 0 : CPASSERT(keyword%ref_count > 0)
834 :
835 0 : DO i = 1, SIZE(keyword%names)
836 0 : imatch = typo_match(TRIM(keyword%names(i)), TRIM(unknown_string))
837 0 : IF (imatch > 0) THEN
838 0 : imatch = imatch + bonus
839 0 : WRITE (line, '(T2,A)') " keyword "//TRIM(keyword%names(i))//" in section "//TRIM(location_string)
840 0 : imax = SIZE(matching_rank, 1)
841 0 : irank = imax + 1
842 0 : DO k = imax, 1, -1
843 0 : IF (imatch > matching_rank(k)) irank = k
844 : END DO
845 0 : IF (irank <= imax) THEN
846 0 : matching_rank(irank + 1:imax) = matching_rank(irank:imax - 1)
847 0 : matching_string(irank + 1:imax) = matching_string(irank:imax - 1)
848 0 : matching_rank(irank) = imatch
849 0 : matching_string(irank) = line
850 : END IF
851 : END IF
852 :
853 0 : IF (keyword%type_of_var == enum_t) THEN
854 0 : DO j = 1, SIZE(keyword%enum%c_vals)
855 0 : imatch = typo_match(TRIM(keyword%enum%c_vals(j)), TRIM(unknown_string))
856 0 : IF (imatch > 0) THEN
857 0 : imatch = imatch + bonus
858 : WRITE (line, '(T2,A)') " enum "//TRIM(keyword%enum%c_vals(j))// &
859 : " in section "//TRIM(location_string)// &
860 0 : " for keyword "//TRIM(keyword%names(i))
861 0 : imax = SIZE(matching_rank, 1)
862 0 : irank = imax + 1
863 0 : DO k = imax, 1, -1
864 0 : IF (imatch > matching_rank(k)) irank = k
865 : END DO
866 0 : IF (irank <= imax) THEN
867 0 : matching_rank(irank + 1:imax) = matching_rank(irank:imax - 1)
868 0 : matching_string(irank + 1:imax) = matching_string(irank:imax - 1)
869 0 : matching_rank(irank) = imatch
870 0 : matching_string(irank) = line
871 : END IF
872 : END IF
873 : END DO
874 : END IF
875 : END DO
876 :
877 0 : END SUBROUTINE keyword_typo_match
878 :
879 0 : END MODULE input_keyword_types
|
