35#include "../base/base_uses.f90"
40 LOGICAL,
PRIVATE,
PARAMETER :: debug_this_module = .true.
41 CHARACTER(len=*),
PARAMETER,
PRIVATE :: moduleN =
'input_keyword_types'
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.
101 TYPE(
val_type),
POINTER :: lone_keyword_value => null()
147 SUBROUTINE keyword_create(keyword, location, name, description, usage, type_of_var, &
148 n_var, repeats, variants, default_val, &
149 default_l_val, default_r_val, default_lc_val, default_c_val, default_i_val, &
150 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 lone_keyword_i_val, lone_keyword_l_vals, lone_keyword_r_vals, &
153 lone_keyword_c_vals, lone_keyword_i_vals, enum_c_vals, enum_i_vals, &
154 enum, enum_strict, enum_desc, unit_str, citations, deprecation_notice, removed)
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), &
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
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
194 CHARACTER(LEN=default_string_length) :: tmp_string
198 cpassert(.NOT.
ASSOCIATED(keyword))
200 keyword%ref_count = 1
201 NULLIFY (keyword%unit)
202 keyword%location = location
203 keyword%removed = .false.
205 cpassert(len_trim(name) > 0)
207 IF (
PRESENT(variants))
THEN
208 ALLOCATE (keyword%names(
SIZE(variants) + 1))
209 keyword%names(1) = name
210 DO i = 1,
SIZE(variants)
211 cpassert(len_trim(variants(i)) > 0)
212 keyword%names(i + 1) = variants(i)
215 ALLOCATE (keyword%names(1))
216 keyword%names(1) = name
218 DO i = 1,
SIZE(keyword%names)
222 IF (
PRESENT(usage))
THEN
223 cpassert(len_trim(usage) <= len(keyword%usage))
224 keyword%usage = usage
226 IF (keyword%names(1) /=
"_SECTION_PARAMETERS_" .AND. keyword%names(1) /=
"_DEFAULT_KEYWORD_")
THEN
230 DO i = 1,
SIZE(keyword%names)
231 check = check .OR. (index(tmp_string, trim(keyword%names(i))) == 1)
233 IF (.NOT. check)
THEN
234 cpabort(
"Usage string must start with one of the keyword name.")
241 n = len_trim(description)
242 ALLOCATE (keyword%description(n))
244 keyword%description(i) = description(i:i)
247 IF (
PRESENT(citations))
THEN
248 ALLOCATE (keyword%citations(
SIZE(citations, 1)))
249 keyword%citations = citations
251 NULLIFY (keyword%citations)
254 keyword%repeats = .false.
255 IF (
PRESENT(repeats)) keyword%repeats = repeats
257 NULLIFY (keyword%enum)
258 IF (
PRESENT(enum))
THEN
262 IF (
PRESENT(enum_i_vals))
THEN
263 cpassert(
PRESENT(enum_c_vals))
264 cpassert(.NOT.
ASSOCIATED(keyword%enum))
265 CALL enum_create(keyword%enum, c_vals=enum_c_vals, i_vals=enum_i_vals, &
266 desc=enum_desc, strict=enum_strict)
268 cpassert(.NOT.
PRESENT(enum_c_vals))
271 NULLIFY (keyword%default_value, keyword%lone_keyword_value)
272 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 PRESENT(default_c_val) .OR.
PRESENT(default_c_vals)) &
277 cpabort(
"you should pass either default_val or a default value, not both")
278 keyword%default_value => default_val
279 IF (
ASSOCIATED(default_val%enum))
THEN
280 IF (
ASSOCIATED(keyword%enum))
THEN
281 cpassert(
ASSOCIATED(keyword%enum, default_val%enum))
283 keyword%enum => default_val%enum
287 cpassert(.NOT.
ASSOCIATED(keyword%enum))
291 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 c_vals=default_c_vals, lc_val=default_lc_val, enum=keyword%enum)
298 keyword%type_of_var = keyword%default_value%type_of_var
299 IF (keyword%default_value%type_of_var ==
no_t)
THEN
303 IF (keyword%type_of_var ==
no_t)
THEN
304 IF (
PRESENT(type_of_var))
THEN
305 keyword%type_of_var = type_of_var
307 CALL cp_abort(__location__, &
308 "keyword "//trim(keyword%names(1))// &
309 " assumed undefined type by default")
311 ELSE IF (
PRESENT(type_of_var))
THEN
312 IF (keyword%type_of_var /= type_of_var) &
313 CALL cp_abort(__location__, &
314 "keyword "//trim(keyword%names(1))// &
315 " has a type different from the type of the default_value")
316 keyword%type_of_var = type_of_var
319 IF (keyword%type_of_var ==
no_t)
THEN
323 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 PRESENT(lone_keyword_c_val) .OR.
PRESENT(lone_keyword_c_vals)) &
328 CALL cp_abort(__location__, &
329 "you should pass either lone_keyword_val or a lone_keyword value, not both")
330 keyword%lone_keyword_value => lone_keyword_val
332 IF (
ASSOCIATED(lone_keyword_val%enum))
THEN
333 IF (
ASSOCIATED(keyword%enum))
THEN
334 IF (.NOT.
ASSOCIATED(keyword%enum, lone_keyword_val%enum)) &
335 cpabort(
"keyword%enum/=lone_keyword_val%enum")
337 IF (
ASSOCIATED(keyword%lone_keyword_value))
THEN
338 cpabort(.NOT.
" ASSOCIATED(keyword%lone_keyword_value)")
340 keyword%enum => lone_keyword_val%enum
344 cpassert(.NOT.
ASSOCIATED(keyword%enum))
347 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 c_vals=lone_keyword_c_vals, enum=keyword%enum)
353 IF (
ASSOCIATED(keyword%lone_keyword_value))
THEN
354 IF (keyword%lone_keyword_value%type_of_var ==
no_t)
THEN
357 IF (keyword%lone_keyword_value%type_of_var /= keyword%type_of_var) &
358 cpabort(
"lone_keyword_value type incompatible with keyword type")
360 IF (keyword%type_of_var ==
enum_t)
THEN
361 IF (keyword%enum%strict)
THEN
363 DO i = 1,
SIZE(keyword%enum%i_vals)
364 check = check .OR. (keyword%default_value%i_val(1) == keyword%enum%i_vals(i))
367 cpabort(
"default value not in enumeration : "//keyword%names(1))
374 IF (
ASSOCIATED(keyword%default_value))
THEN
375 SELECT CASE (keyword%default_value%type_of_var)
377 keyword%n_var =
SIZE(keyword%default_value%l_val)
379 keyword%n_var =
SIZE(keyword%default_value%i_val)
381 IF (keyword%enum%strict)
THEN
383 DO i = 1,
SIZE(keyword%enum%i_vals)
384 check = check .OR. (keyword%default_value%i_val(1) == keyword%enum%i_vals(i))
387 cpabort(
"default value not in enumeration : "//keyword%names(1))
389 keyword%n_var =
SIZE(keyword%default_value%i_val)
391 keyword%n_var =
SIZE(keyword%default_value%r_val)
393 keyword%n_var =
SIZE(keyword%default_value%c_val)
402 IF (
PRESENT(n_var)) keyword%n_var = n_var
403 IF (keyword%type_of_var ==
lchar_t .AND. keyword%n_var /= 1) &
404 cpabort(
"arrays of lchar_t not supported : "//keyword%names(1))
406 IF (
PRESENT(unit_str))
THEN
407 ALLOCATE (keyword%unit)
411 IF (
PRESENT(deprecation_notice))
THEN
412 keyword%deprecation_notice = trim(deprecation_notice)
415 IF (
PRESENT(removed))
THEN
416 keyword%removed = removed
428 cpassert(
ASSOCIATED(keyword))
429 cpassert(keyword%ref_count > 0)
430 keyword%ref_count = keyword%ref_count + 1
441 IF (
ASSOCIATED(keyword))
THEN
442 cpassert(keyword%ref_count > 0)
443 keyword%ref_count = keyword%ref_count - 1
444 IF (keyword%ref_count == 0)
THEN
445 DEALLOCATE (keyword%names)
446 DEALLOCATE (keyword%description)
450 IF (
ASSOCIATED(keyword%unit))
THEN
452 DEALLOCATE (keyword%unit)
454 IF (
ASSOCIATED(keyword%citations))
THEN
455 DEALLOCATE (keyword%citations)
478 SUBROUTINE keyword_get(keyword, names, usage, description, type_of_var, n_var, &
479 default_value, lone_keyword_value, repeats, enum, citations)
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
488 INTEGER,
DIMENSION(:),
OPTIONAL,
POINTER :: citations
490 cpassert(
ASSOCIATED(keyword))
491 cpassert(keyword%ref_count > 0)
492 IF (
PRESENT(names)) names => keyword%names
493 IF (
PRESENT(usage)) usage = keyword%usage
494 IF (
PRESENT(description)) description =
a2s(keyword%description)
495 IF (
PRESENT(type_of_var)) type_of_var = keyword%type_of_var
496 IF (
PRESENT(n_var)) n_var = keyword%n_var
497 IF (
PRESENT(repeats)) repeats = keyword%repeats
498 IF (
PRESENT(default_value)) default_value => keyword%default_value
499 IF (
PRESENT(lone_keyword_value)) lone_keyword_value => keyword%lone_keyword_value
500 IF (
PRESENT(enum))
enum => keyword%enum
501 IF (
PRESENT(citations)) citations => keyword%citations
515 INTEGER,
INTENT(in) :: unit_nr, level
517 CHARACTER(len=default_string_length) :: c_string
520 cpassert(
ASSOCIATED(keyword))
521 cpassert(keyword%ref_count > 0)
522 IF (level > 0 .AND. (unit_nr > 0))
THEN
523 WRITE (unit_nr,
"(a,a,a)")
" ---", &
524 trim(keyword%names(1)),
"---"
526 WRITE (unit_nr,
"(a,a)")
"usage : ", trim(keyword%usage)
529 WRITE (unit_nr,
"(a)")
"description : "
532 SELECT CASE (keyword%type_of_var)
534 IF (keyword%n_var == -1)
THEN
535 WRITE (unit_nr,
"(' A list of logicals is expected')")
536 ELSE IF (keyword%n_var == 1)
THEN
537 WRITE (unit_nr,
"(' A logical is expected')")
539 WRITE (unit_nr,
"(i6,' logicals are expected')") keyword%n_var
541 WRITE (unit_nr,
"(' (T,TRUE,YES,ON) and (F,FALSE,NO,OFF) are synonyms')")
543 IF (keyword%n_var == -1)
THEN
544 WRITE (unit_nr,
"(' A list of integers is expected')")
545 ELSE IF (keyword%n_var == 1)
THEN
546 WRITE (unit_nr,
"(' An integer is expected')")
548 WRITE (unit_nr,
"(i6,' integers are expected')") keyword%n_var
551 IF (keyword%n_var == -1)
THEN
552 WRITE (unit_nr,
"(' A list of reals is expected')")
553 ELSE IF (keyword%n_var == 1)
THEN
554 WRITE (unit_nr,
"(' A real is expected')")
556 WRITE (unit_nr,
"(i6,' reals are expected')") keyword%n_var
558 IF (
ASSOCIATED(keyword%unit))
THEN
559 c_string =
cp_unit_desc(keyword%unit, accept_undefined=.true.)
560 WRITE (unit_nr,
"('the default unit of measure is ',a)") &
564 IF (keyword%n_var == -1)
THEN
565 WRITE (unit_nr,
"(' A list of words is expected')")
566 ELSE IF (keyword%n_var == 1)
THEN
567 WRITE (unit_nr,
"(' A word is expected')")
569 WRITE (unit_nr,
"(i6,' words are expected')") keyword%n_var
572 WRITE (unit_nr,
"(' A string is expected')")
574 IF (keyword%n_var == -1)
THEN
575 WRITE (unit_nr,
"(' A list of keywords is expected')")
576 ELSE IF (keyword%n_var == 1)
THEN
577 WRITE (unit_nr,
"(' A keyword is expected')")
579 WRITE (unit_nr,
"(i6,' keywords are expected')") keyword%n_var
582 WRITE (unit_nr,
"(' Non-standard type.')")
587 IF (keyword%type_of_var ==
enum_t)
THEN
589 WRITE (unit_nr,
"(' valid keywords:')")
590 DO i = 1,
SIZE(keyword%enum%c_vals)
591 c_string = keyword%enum%c_vals(i)
592 IF (len_trim(
a2s(keyword%enum%desc(i)%chars)) > 0)
THEN
593 WRITE (unit_nr,
"(' - ',a,' : ',a,'.')") &
594 trim(c_string), trim(
a2s(keyword%enum%desc(i)%chars))
596 WRITE (unit_nr,
"(' - ',a)") trim(c_string)
600 WRITE (unit_nr,
"(' valid keywords:')", advance=
'NO')
602 DO i = 1,
SIZE(keyword%enum%c_vals)
603 c_string = keyword%enum%c_vals(i)
604 IF (l + len_trim(c_string) > 72 .AND. l > 14)
THEN
605 WRITE (unit_nr,
"(/,' ')", advance=
'NO')
608 WRITE (unit_nr,
"(' ',a)", advance=
'NO') trim(c_string)
609 l = len_trim(c_string) + 3
611 WRITE (unit_nr,
"()")
613 IF (.NOT. keyword%enum%strict)
THEN
614 WRITE (unit_nr,
"(' other integer values are also accepted.')")
617 IF (
ASSOCIATED(keyword%default_value) .AND. keyword%type_of_var /=
no_t)
THEN
618 WRITE (unit_nr,
"('default_value : ')", advance=
"NO")
619 CALL val_write(keyword%default_value, unit_nr=unit_nr)
621 IF (
ASSOCIATED(keyword%lone_keyword_value) .AND. keyword%type_of_var /=
no_t)
THEN
622 WRITE (unit_nr,
"('lone_keyword : ')", advance=
"NO")
623 CALL val_write(keyword%lone_keyword_value, unit_nr=unit_nr)
625 IF (keyword%repeats)
THEN
626 WRITE (unit_nr,
"(' and it can be repeated more than once')", advance=
"NO")
628 WRITE (unit_nr,
"()")
629 IF (
SIZE(keyword%names) > 1)
THEN
630 WRITE (unit_nr,
"(a)", advance=
"NO")
"variants : "
631 DO i = 2,
SIZE(keyword%names)
632 WRITE (unit_nr,
"(a,' ')", advance=
"NO") keyword%names(i)
634 WRITE (unit_nr,
"()")
650 INTEGER,
INTENT(IN) :: level, unit_number
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
657 cpassert(
ASSOCIATED(keyword))
658 cpassert(keyword%ref_count > 0)
668 IF (keyword%repeats)
THEN
674 IF (keyword%removed)
THEN
682 IF (keyword%names(1) ==
"_SECTION_PARAMETERS_")
THEN
683 WRITE (unit=unit_number, fmt=
"(A)") &
684 repeat(
" ", l0)//
"<SECTION_PARAMETERS repeats="""//trim(repeats)// &
685 """ removed="""//trim(removed)//
""">", &
686 repeat(
" ", l1)//
"<NAME type=""default"">SECTION_PARAMETERS</NAME>"
687 ELSE IF (keyword%names(1) ==
"_DEFAULT_KEYWORD_")
THEN
688 WRITE (unit=unit_number, fmt=
"(A)") &
689 repeat(
" ", l0)//
"<DEFAULT_KEYWORD repeats="""//trim(repeats)//
""">", &
690 repeat(
" ", l1)//
"<NAME type=""default"">DEFAULT_KEYWORD</NAME>"
692 WRITE (unit=unit_number, fmt=
"(A)") &
693 repeat(
" ", l0)//
"<KEYWORD repeats="""//trim(repeats)// &
694 """ removed="""//trim(removed)//
""">", &
695 repeat(
" ", l1)//
"<NAME type=""default"">"// &
696 trim(keyword%names(1))//
"</NAME>"
699 DO i = 2,
SIZE(keyword%names)
700 WRITE (unit=unit_number, fmt=
"(A)") &
701 repeat(
" ", l1)//
"<NAME type=""alias"">"// &
702 trim(keyword%names(i))//
"</NAME>"
705 SELECT CASE (keyword%type_of_var)
707 WRITE (unit=unit_number, fmt=
"(A)") &
708 repeat(
" ", l1)//
"<DATA_TYPE kind=""logical"">"
710 WRITE (unit=unit_number, fmt=
"(A)") &
711 repeat(
" ", l1)//
"<DATA_TYPE kind=""integer"">"
713 WRITE (unit=unit_number, fmt=
"(A)") &
714 repeat(
" ", l1)//
"<DATA_TYPE kind=""real"">"
716 WRITE (unit=unit_number, fmt=
"(A)") &
717 repeat(
" ", l1)//
"<DATA_TYPE kind=""word"">"
719 WRITE (unit=unit_number, fmt=
"(A)") &
720 repeat(
" ", l1)//
"<DATA_TYPE kind=""string"">"
722 WRITE (unit=unit_number, fmt=
"(A)") &
723 repeat(
" ", l1)//
"<DATA_TYPE kind=""keyword"">"
724 IF (keyword%enum%strict)
THEN
725 WRITE (unit=unit_number, fmt=
"(A)") &
726 repeat(
" ", l2)//
"<ENUMERATION strict=""yes"">"
728 WRITE (unit=unit_number, fmt=
"(A)") &
729 repeat(
" ", l2)//
"<ENUMERATION strict=""no"">"
731 DO i = 1,
SIZE(keyword%enum%c_vals)
732 WRITE (unit=unit_number, fmt=
"(A)") &
733 repeat(
" ", l3)//
"<ITEM>", &
734 repeat(
" ", l4)//
"<NAME>"// &
736 repeat(
" ", l4)//
"<DESCRIPTION>"// &
738 //
"</DESCRIPTION>", repeat(
" ", l3)//
"</ITEM>"
740 WRITE (unit=unit_number, fmt=
"(A)") repeat(
" ", l2)//
"</ENUMERATION>"
742 WRITE (unit=unit_number, fmt=
"(A)") &
743 repeat(
" ", l1)//
"<DATA_TYPE kind=""non-standard type"">"
749 WRITE (unit=short_string, fmt=
"(I8)") keyword%n_var
750 WRITE (unit=unit_number, fmt=
"(A)") &
751 repeat(
" ", l2)//
"<N_VAR>"//trim(adjustl(short_string))//
"</N_VAR>", &
752 repeat(
" ", l1)//
"</DATA_TYPE>"
754 WRITE (unit=unit_number, fmt=
"(A)") repeat(
" ", l1)//
"<USAGE>"// &
758 WRITE (unit=unit_number, fmt=
"(A)") repeat(
" ", l1)//
"<DESCRIPTION>"// &
762 IF (
ALLOCATED(keyword%deprecation_notice)) &
763 WRITE (unit=unit_number, fmt=
"(A)") repeat(
" ", l1)//
"<DEPRECATION_NOTICE>"// &
765 //
"</DEPRECATION_NOTICE>"
767 IF (
ASSOCIATED(keyword%default_value) .AND. &
768 (keyword%type_of_var /=
no_t))
THEN
769 IF (
ASSOCIATED(keyword%unit))
THEN
778 WRITE (unit=unit_number, fmt=
"(A)") &
779 repeat(
" ", l1)//
"<DEFAULT_VALUE>"// &
783 IF (
ASSOCIATED(keyword%unit))
THEN
784 string =
cp_unit_desc(keyword%unit, accept_undefined=.true.)
785 WRITE (unit=unit_number, fmt=
"(A)") &
786 repeat(
" ", l1)//
"<DEFAULT_UNIT>"// &
787 trim(adjustl(string))//
"</DEFAULT_UNIT>"
790 IF (
ASSOCIATED(keyword%lone_keyword_value) .AND. &
791 (keyword%type_of_var /=
no_t))
THEN
794 WRITE (unit=unit_number, fmt=
"(A)") &
795 repeat(
" ", l1)//
"<LONE_KEYWORD_VALUE>"// &
799 IF (
ASSOCIATED(keyword%citations))
THEN
800 DO i = 1,
SIZE(keyword%citations, 1)
802 WRITE (unit=short_string, fmt=
"(I8)") keyword%citations(i)
803 WRITE (unit=unit_number, fmt=
"(A)") &
804 repeat(
" ", l1)//
"<REFERENCE>", &
805 repeat(
" ", l2)//
"<NAME>"//trim(
get_citation_key(keyword%citations(i)))//
"</NAME>", &
806 repeat(
" ", l2)//
"<NUMBER>"//trim(adjustl(short_string))//
"</NUMBER>", &
807 repeat(
" ", l1)//
"</REFERENCE>"
811 WRITE (unit=unit_number, fmt=
"(A)") &
812 repeat(
" ", l1)//
"<LOCATION>"//trim(keyword%location)//
"</LOCATION>"
816 IF (keyword%names(1) ==
"_SECTION_PARAMETERS_")
THEN
817 WRITE (unit=unit_number, fmt=
"(A)") &
818 repeat(
" ", l0)//
"</SECTION_PARAMETERS>"
819 ELSE IF (keyword%names(1) ==
"_DEFAULT_KEYWORD_")
THEN
820 WRITE (unit=unit_number, fmt=
"(A)") &
821 repeat(
" ", l0)//
"</DEFAULT_KEYWORD>"
823 WRITE (unit=unit_number, fmt=
"(A)") &
824 repeat(
" ", l0)//
"</KEYWORD>"
838 SUBROUTINE keyword_typo_match(keyword, unknown_string, location_string, matching_rank, matching_string, bonus)
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
846 CHARACTER(LEN=LEN(matching_string(1))) :: line
847 INTEGER :: i, imatch,
imax, irank, j, k
849 cpassert(
ASSOCIATED(keyword))
850 cpassert(keyword%ref_count > 0)
852 DO i = 1,
SIZE(keyword%names)
853 imatch =
typo_match(trim(keyword%names(i)), trim(unknown_string))
855 imatch = imatch + bonus
856 WRITE (line,
'(T2,A)')
" keyword "//trim(keyword%names(i))//
" in section "//trim(location_string)
857 imax =
SIZE(matching_rank, 1)
860 IF (imatch > matching_rank(k)) irank = k
862 IF (irank <=
imax)
THEN
863 matching_rank(irank + 1:
imax) = matching_rank(irank:
imax - 1)
864 matching_string(irank + 1:
imax) = matching_string(irank:
imax - 1)
865 matching_rank(irank) = imatch
866 matching_string(irank) = line
870 IF (keyword%type_of_var ==
enum_t)
THEN
871 DO j = 1,
SIZE(keyword%enum%c_vals)
872 imatch =
typo_match(trim(keyword%enum%c_vals(j)), trim(unknown_string))
874 imatch = imatch + bonus
875 WRITE (line,
'(T2,A)')
" enum "//trim(keyword%enum%c_vals(j))// &
876 " in section "//trim(location_string)// &
877 " for keyword "//trim(keyword%names(i))
878 imax =
SIZE(matching_rank, 1)
881 IF (imatch > matching_rank(k)) irank = k
883 IF (irank <=
imax)
THEN
884 matching_rank(irank + 1:
imax) = matching_rank(irank:
imax - 1)
885 matching_string(irank + 1:
imax) = matching_string(irank:
imax - 1)
886 matching_rank(irank) = imatch
887 matching_string(irank) = line
static int imax(int x, int y)
Returns the larger of two given integers (missing from the C standard)
character(len=cp_unit_desc_length) function, public cp_unit_desc(unit, defaults, accept_undefined)
returns the "name" of the given unit
subroutine, public cp_unit_create(unit, string)
creates a unit parsing a string
elemental subroutine, public cp_unit_release(unit)
releases the given unit
Defines the basic variable types.
integer, parameter, public dp
integer, parameter, public default_string_length
Perform an abnormal program termination.
subroutine, public print_message(message, output_unit, declev, before, after)
Perform a basic blocking of the text in message and print it optionally decorated with a frame of sta...
provides a uniform framework to add references to CP2K cite and output these
pure character(len=default_string_length) function, public get_citation_key(key)
...
Utilities for string manipulations.
subroutine, public compress(string, full)
Eliminate multiple space characters in a string. If full is .TRUE., then all spaces are eliminated.
elemental integer function, public typo_match(string, typo_string)
returns a non-zero positive value if typo_string equals string apart from a few typos....
pure character(len=size(array)) function, public a2s(array)
Converts a character-array into a string.
character(len=2 *len(inp_string)) function, public substitute_special_xml_tokens(inp_string)
Substitutes the five predefined XML entities: &, <, >, ', and ".
elemental subroutine, public uppercase(string)
Convert all lower case characters in a string to upper case.