35 #include "../base/base_uses.f90"
40 LOGICAL,
PRIVATE,
PARAMETER :: debug_this_module = .true.
41 CHARACTER(len=*),
PARAMETER,
PRIVATE :: moduleN =
'input_keyword_types'
55 TYPE(keyword_type),
POINTER :: keyword => null()
56 END TYPE keyword_p_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
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)
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), &
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
197 cpassert(.NOT.
ASSOCIATED(keyword))
199 keyword%ref_count = 1
200 NULLIFY (keyword%unit)
201 keyword%location = location
202 keyword%removed = .false.
204 cpassert(len_trim(name) > 0)
206 IF (
PRESENT(variants))
THEN
207 ALLOCATE (keyword%names(
SIZE(variants) + 1))
208 keyword%names(1) = name
209 DO i = 1,
SIZE(variants)
210 cpassert(len_trim(variants(i)) > 0)
211 keyword%names(i + 1) = variants(i)
214 ALLOCATE (keyword%names(1))
215 keyword%names(1) = name
217 DO i = 1,
SIZE(keyword%names)
221 IF (
PRESENT(usage))
THEN
222 cpassert(len_trim(usage) <= len(keyword%usage))
223 keyword%usage = usage
228 n = len_trim(description)
229 ALLOCATE (keyword%description(n))
231 keyword%description(i) = description(i:i)
234 IF (
PRESENT(citations))
THEN
235 ALLOCATE (keyword%citations(
SIZE(citations, 1)))
236 keyword%citations = citations
238 NULLIFY (keyword%citations)
241 keyword%repeats = .false.
242 IF (
PRESENT(repeats)) keyword%repeats = repeats
244 NULLIFY (keyword%enum)
245 IF (
PRESENT(enum))
THEN
249 IF (
PRESENT(enum_i_vals))
THEN
250 cpassert(
PRESENT(enum_c_vals))
251 cpassert(.NOT.
ASSOCIATED(keyword%enum))
252 CALL enum_create(keyword%enum, c_vals=enum_c_vals, i_vals=enum_i_vals, &
253 desc=enum_desc, strict=enum_strict)
255 cpassert(.NOT.
PRESENT(enum_c_vals))
258 NULLIFY (keyword%default_value, keyword%lone_keyword_value)
259 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 PRESENT(default_c_val) .OR.
PRESENT(default_c_vals)) &
264 cpabort(
"you should pass either default_val or a default value, not both")
265 keyword%default_value => default_val
266 IF (
ASSOCIATED(default_val%enum))
THEN
267 IF (
ASSOCIATED(keyword%enum))
THEN
268 cpassert(
ASSOCIATED(keyword%enum, default_val%enum))
270 keyword%enum => default_val%enum
274 cpassert(.NOT.
ASSOCIATED(keyword%enum))
278 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 c_vals=default_c_vals, lc_val=default_lc_val, enum=keyword%enum)
285 keyword%type_of_var = keyword%default_value%type_of_var
286 IF (keyword%default_value%type_of_var ==
no_t)
THEN
290 IF (keyword%type_of_var ==
no_t)
THEN
291 IF (
PRESENT(type_of_var))
THEN
292 keyword%type_of_var = type_of_var
294 CALL cp_abort(__location__, &
295 "keyword "//trim(keyword%names(1))// &
296 " assumed undefined type by default")
298 ELSE IF (
PRESENT(type_of_var))
THEN
299 IF (keyword%type_of_var /= type_of_var) &
300 CALL cp_abort(__location__, &
301 "keyword "//trim(keyword%names(1))// &
302 " has a type different from the type of the default_value")
303 keyword%type_of_var = type_of_var
306 IF (keyword%type_of_var ==
no_t)
THEN
310 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 PRESENT(lone_keyword_c_val) .OR.
PRESENT(lone_keyword_c_vals)) &
315 CALL cp_abort(__location__, &
316 "you should pass either lone_keyword_val or a lone_keyword value, not both")
317 keyword%lone_keyword_value => lone_keyword_val
319 IF (
ASSOCIATED(lone_keyword_val%enum))
THEN
320 IF (
ASSOCIATED(keyword%enum))
THEN
321 IF (.NOT.
ASSOCIATED(keyword%enum, lone_keyword_val%enum)) &
322 cpabort(
"keyword%enum/=lone_keyword_val%enum")
324 IF (
ASSOCIATED(keyword%lone_keyword_value))
THEN
325 cpabort(.NOT.
" ASSOCIATED(keyword%lone_keyword_value)")
327 keyword%enum => lone_keyword_val%enum
331 cpassert(.NOT.
ASSOCIATED(keyword%enum))
334 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 c_vals=lone_keyword_c_vals, enum=keyword%enum)
340 IF (
ASSOCIATED(keyword%lone_keyword_value))
THEN
341 IF (keyword%lone_keyword_value%type_of_var ==
no_t)
THEN
344 IF (keyword%lone_keyword_value%type_of_var /= keyword%type_of_var) &
345 cpabort(
"lone_keyword_value type incompatible with keyword type")
347 IF (keyword%type_of_var ==
enum_t)
THEN
348 IF (keyword%enum%strict)
THEN
350 DO i = 1,
SIZE(keyword%enum%i_vals)
351 check = check .OR. (keyword%default_value%i_val(1) == keyword%enum%i_vals(i))
354 cpabort(
"default value not in enumeration : "//keyword%names(1))
361 IF (
ASSOCIATED(keyword%default_value))
THEN
362 SELECT CASE (keyword%default_value%type_of_var)
364 keyword%n_var =
SIZE(keyword%default_value%l_val)
366 keyword%n_var =
SIZE(keyword%default_value%i_val)
368 IF (keyword%enum%strict)
THEN
370 DO i = 1,
SIZE(keyword%enum%i_vals)
371 check = check .OR. (keyword%default_value%i_val(1) == keyword%enum%i_vals(i))
374 cpabort(
"default value not in enumeration : "//keyword%names(1))
376 keyword%n_var =
SIZE(keyword%default_value%i_val)
378 keyword%n_var =
SIZE(keyword%default_value%r_val)
380 keyword%n_var =
SIZE(keyword%default_value%c_val)
389 IF (
PRESENT(n_var)) keyword%n_var = n_var
390 IF (keyword%type_of_var ==
lchar_t .AND. keyword%n_var /= 1) &
391 cpabort(
"arrays of lchar_t not supported : "//keyword%names(1))
393 IF (
PRESENT(unit_str))
THEN
394 ALLOCATE (keyword%unit)
398 IF (
PRESENT(deprecation_notice))
THEN
399 keyword%deprecation_notice = trim(deprecation_notice)
402 IF (
PRESENT(removed))
THEN
403 keyword%removed = removed
413 TYPE(keyword_type),
POINTER :: keyword
415 cpassert(
ASSOCIATED(keyword))
416 cpassert(keyword%ref_count > 0)
417 keyword%ref_count = keyword%ref_count + 1
426 TYPE(keyword_type),
POINTER :: keyword
428 IF (
ASSOCIATED(keyword))
THEN
429 cpassert(keyword%ref_count > 0)
430 keyword%ref_count = keyword%ref_count - 1
431 IF (keyword%ref_count == 0)
THEN
432 DEALLOCATE (keyword%names)
433 DEALLOCATE (keyword%description)
437 IF (
ASSOCIATED(keyword%unit))
THEN
439 DEALLOCATE (keyword%unit)
441 IF (
ASSOCIATED(keyword%citations))
THEN
442 DEALLOCATE (keyword%citations)
465 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
477 cpassert(
ASSOCIATED(keyword))
478 cpassert(keyword%ref_count > 0)
479 IF (
PRESENT(names)) names => keyword%names
480 IF (
PRESENT(usage)) usage = keyword%usage
481 IF (
PRESENT(description)) description =
a2s(keyword%description)
482 IF (
PRESENT(type_of_var)) type_of_var = keyword%type_of_var
483 IF (
PRESENT(n_var)) n_var = keyword%n_var
484 IF (
PRESENT(repeats)) repeats = keyword%repeats
485 IF (
PRESENT(default_value)) default_value => keyword%default_value
486 IF (
PRESENT(lone_keyword_value)) lone_keyword_value => keyword%lone_keyword_value
487 IF (
PRESENT(enum))
enum => keyword%enum
488 IF (
PRESENT(citations)) citations => keyword%citations
501 TYPE(keyword_type),
POINTER :: keyword
502 INTEGER,
INTENT(in) :: unit_nr, level
504 CHARACTER(len=default_string_length) :: c_string
507 cpassert(
ASSOCIATED(keyword))
508 cpassert(keyword%ref_count > 0)
509 IF (level > 0 .AND. (unit_nr > 0))
THEN
510 WRITE (unit_nr,
"(a,a,a)")
" ---", &
511 trim(keyword%names(1)),
"---"
513 WRITE (unit_nr,
"(a,a)")
"usage : ", trim(keyword%usage)
516 WRITE (unit_nr,
"(a)")
"description : "
519 SELECT CASE (keyword%type_of_var)
521 IF (keyword%n_var == -1)
THEN
522 WRITE (unit_nr,
"(' A list of logicals is expected')")
523 ELSE IF (keyword%n_var == 1)
THEN
524 WRITE (unit_nr,
"(' A logical is expected')")
526 WRITE (unit_nr,
"(i6,' logicals are expected')") keyword%n_var
528 WRITE (unit_nr,
"(' (T,TRUE,YES,ON) and (F,FALSE,NO,OFF) are synonyms')")
530 IF (keyword%n_var == -1)
THEN
531 WRITE (unit_nr,
"(' A list of integers is expected')")
532 ELSE IF (keyword%n_var == 1)
THEN
533 WRITE (unit_nr,
"(' An integer is expected')")
535 WRITE (unit_nr,
"(i6,' integers are expected')") keyword%n_var
538 IF (keyword%n_var == -1)
THEN
539 WRITE (unit_nr,
"(' A list of reals is expected')")
540 ELSE IF (keyword%n_var == 1)
THEN
541 WRITE (unit_nr,
"(' A real is expected')")
543 WRITE (unit_nr,
"(i6,' reals are expected')") keyword%n_var
545 IF (
ASSOCIATED(keyword%unit))
THEN
546 c_string =
cp_unit_desc(keyword%unit, accept_undefined=.true.)
547 WRITE (unit_nr,
"('the default unit of measure is ',a)") &
551 IF (keyword%n_var == -1)
THEN
552 WRITE (unit_nr,
"(' A list of words is expected')")
553 ELSE IF (keyword%n_var == 1)
THEN
554 WRITE (unit_nr,
"(' A word is expected')")
556 WRITE (unit_nr,
"(i6,' words are expected')") keyword%n_var
559 WRITE (unit_nr,
"(' A string is expected')")
561 IF (keyword%n_var == -1)
THEN
562 WRITE (unit_nr,
"(' A list of keywords is expected')")
563 ELSE IF (keyword%n_var == 1)
THEN
564 WRITE (unit_nr,
"(' A keyword is expected')")
566 WRITE (unit_nr,
"(i6,' keywords are expected')") keyword%n_var
569 WRITE (unit_nr,
"(' Non-standard type.')")
574 IF (keyword%type_of_var ==
enum_t)
THEN
576 WRITE (unit_nr,
"(' valid keywords:')")
577 DO i = 1,
SIZE(keyword%enum%c_vals)
578 c_string = keyword%enum%c_vals(i)
579 IF (len_trim(
a2s(keyword%enum%desc(i)%chars)) > 0)
THEN
580 WRITE (unit_nr,
"(' - ',a,' : ',a,'.')") &
581 trim(c_string), trim(
a2s(keyword%enum%desc(i)%chars))
583 WRITE (unit_nr,
"(' - ',a)") trim(c_string)
587 WRITE (unit_nr,
"(' valid keywords:')", advance=
'NO')
589 DO i = 1,
SIZE(keyword%enum%c_vals)
590 c_string = keyword%enum%c_vals(i)
591 IF (l + len_trim(c_string) > 72 .AND. l > 14)
THEN
592 WRITE (unit_nr,
"(/,' ')", advance=
'NO')
595 WRITE (unit_nr,
"(' ',a)", advance=
'NO') trim(c_string)
596 l = len_trim(c_string) + 3
598 WRITE (unit_nr,
"()")
600 IF (.NOT. keyword%enum%strict)
THEN
601 WRITE (unit_nr,
"(' other integer values are also accepted.')")
604 IF (
ASSOCIATED(keyword%default_value) .AND. keyword%type_of_var /=
no_t)
THEN
605 WRITE (unit_nr,
"('default_value : ')", advance=
"NO")
606 CALL val_write(keyword%default_value, unit_nr=unit_nr)
608 IF (
ASSOCIATED(keyword%lone_keyword_value) .AND. keyword%type_of_var /=
no_t)
THEN
609 WRITE (unit_nr,
"('lone_keyword : ')", advance=
"NO")
610 CALL val_write(keyword%lone_keyword_value, unit_nr=unit_nr)
612 IF (keyword%repeats)
THEN
613 WRITE (unit_nr,
"(' and it can be repeated more than once')", advance=
"NO")
615 WRITE (unit_nr,
"()")
616 IF (
SIZE(keyword%names) > 1)
THEN
617 WRITE (unit_nr,
"(a)", advance=
"NO")
"variants : "
618 DO i = 2,
SIZE(keyword%names)
619 WRITE (unit_nr,
"(a,' ')", advance=
"NO") keyword%names(i)
621 WRITE (unit_nr,
"()")
636 TYPE(keyword_type),
POINTER :: keyword
637 INTEGER,
INTENT(IN) :: level, unit_number
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
644 cpassert(
ASSOCIATED(keyword))
645 cpassert(keyword%ref_count > 0)
655 IF (keyword%repeats)
THEN
661 IF (keyword%removed)
THEN
669 IF (keyword%names(1) ==
"_SECTION_PARAMETERS_")
THEN
670 WRITE (unit=unit_number, fmt=
"(A)") &
671 repeat(
" ", l0)//
"<SECTION_PARAMETERS repeats="""//trim(repeats)// &
672 """ removed="""//trim(removed)//
""">", &
673 repeat(
" ", l1)//
"<NAME type=""default"">SECTION_PARAMETERS</NAME>"
674 ELSE IF (keyword%names(1) ==
"_DEFAULT_KEYWORD_")
THEN
675 WRITE (unit=unit_number, fmt=
"(A)") &
676 repeat(
" ", l0)//
"<DEFAULT_KEYWORD repeats="""//trim(repeats)//
""">", &
677 repeat(
" ", l1)//
"<NAME type=""default"">DEFAULT_KEYWORD</NAME>"
679 WRITE (unit=unit_number, fmt=
"(A)") &
680 repeat(
" ", l0)//
"<KEYWORD repeats="""//trim(repeats)// &
681 """ removed="""//trim(removed)//
""">", &
682 repeat(
" ", l1)//
"<NAME type=""default"">"// &
683 trim(keyword%names(1))//
"</NAME>"
686 DO i = 2,
SIZE(keyword%names)
687 WRITE (unit=unit_number, fmt=
"(A)") &
688 repeat(
" ", l1)//
"<NAME type=""alias"">"// &
689 trim(keyword%names(i))//
"</NAME>"
692 SELECT CASE (keyword%type_of_var)
694 WRITE (unit=unit_number, fmt=
"(A)") &
695 repeat(
" ", l1)//
"<DATA_TYPE kind=""logical"">"
697 WRITE (unit=unit_number, fmt=
"(A)") &
698 repeat(
" ", l1)//
"<DATA_TYPE kind=""integer"">"
700 WRITE (unit=unit_number, fmt=
"(A)") &
701 repeat(
" ", l1)//
"<DATA_TYPE kind=""real"">"
703 WRITE (unit=unit_number, fmt=
"(A)") &
704 repeat(
" ", l1)//
"<DATA_TYPE kind=""word"">"
706 WRITE (unit=unit_number, fmt=
"(A)") &
707 repeat(
" ", l1)//
"<DATA_TYPE kind=""string"">"
709 WRITE (unit=unit_number, fmt=
"(A)") &
710 repeat(
" ", l1)//
"<DATA_TYPE kind=""keyword"">"
711 IF (keyword%enum%strict)
THEN
712 WRITE (unit=unit_number, fmt=
"(A)") &
713 repeat(
" ", l2)//
"<ENUMERATION strict=""yes"">"
715 WRITE (unit=unit_number, fmt=
"(A)") &
716 repeat(
" ", l2)//
"<ENUMERATION strict=""no"">"
718 DO i = 1,
SIZE(keyword%enum%c_vals)
719 WRITE (unit=unit_number, fmt=
"(A)") &
720 repeat(
" ", l3)//
"<ITEM>", &
721 repeat(
" ", l4)//
"<NAME>"// &
723 repeat(
" ", l4)//
"<DESCRIPTION>"// &
725 //
"</DESCRIPTION>", repeat(
" ", l3)//
"</ITEM>"
727 WRITE (unit=unit_number, fmt=
"(A)") repeat(
" ", l2)//
"</ENUMERATION>"
729 WRITE (unit=unit_number, fmt=
"(A)") &
730 repeat(
" ", l1)//
"<DATA_TYPE kind=""non-standard type"">"
736 WRITE (unit=short_string, fmt=
"(I8)") keyword%n_var
737 WRITE (unit=unit_number, fmt=
"(A)") &
738 repeat(
" ", l2)//
"<N_VAR>"//trim(adjustl(short_string))//
"</N_VAR>", &
739 repeat(
" ", l1)//
"</DATA_TYPE>"
741 WRITE (unit=unit_number, fmt=
"(A)") repeat(
" ", l1)//
"<USAGE>"// &
745 WRITE (unit=unit_number, fmt=
"(A)") repeat(
" ", l1)//
"<DESCRIPTION>"// &
749 IF (
ALLOCATED(keyword%deprecation_notice)) &
750 WRITE (unit=unit_number, fmt=
"(A)") repeat(
" ", l1)//
"<DEPRECATION_NOTICE>"// &
752 //
"</DEPRECATION_NOTICE>"
754 IF (
ASSOCIATED(keyword%default_value) .AND. &
755 (keyword%type_of_var /=
no_t))
THEN
756 IF (
ASSOCIATED(keyword%unit))
THEN
765 WRITE (unit=unit_number, fmt=
"(A)") &
766 repeat(
" ", l1)//
"<DEFAULT_VALUE>"// &
770 IF (
ASSOCIATED(keyword%unit))
THEN
771 string =
cp_unit_desc(keyword%unit, accept_undefined=.true.)
772 WRITE (unit=unit_number, fmt=
"(A)") &
773 repeat(
" ", l1)//
"<DEFAULT_UNIT>"// &
774 trim(adjustl(string))//
"</DEFAULT_UNIT>"
777 IF (
ASSOCIATED(keyword%lone_keyword_value) .AND. &
778 (keyword%type_of_var /=
no_t))
THEN
781 WRITE (unit=unit_number, fmt=
"(A)") &
782 repeat(
" ", l1)//
"<LONE_KEYWORD_VALUE>"// &
786 IF (
ASSOCIATED(keyword%citations))
THEN
787 DO i = 1,
SIZE(keyword%citations, 1)
789 WRITE (unit=short_string, fmt=
"(I8)") keyword%citations(i)
790 WRITE (unit=unit_number, fmt=
"(A)") &
791 repeat(
" ", l1)//
"<REFERENCE>", &
792 repeat(
" ", l2)//
"<NAME>"//trim(
get_citation_key(keyword%citations(i)))//
"</NAME>", &
793 repeat(
" ", l2)//
"<NUMBER>"//trim(adjustl(short_string))//
"</NUMBER>", &
794 repeat(
" ", l1)//
"</REFERENCE>"
798 WRITE (unit=unit_number, fmt=
"(A)") &
799 repeat(
" ", l1)//
"<LOCATION>"//trim(keyword%location)//
"</LOCATION>"
803 IF (keyword%names(1) ==
"_SECTION_PARAMETERS_")
THEN
804 WRITE (unit=unit_number, fmt=
"(A)") &
805 repeat(
" ", l0)//
"</SECTION_PARAMETERS>"
806 ELSE IF (keyword%names(1) ==
"_DEFAULT_KEYWORD_")
THEN
807 WRITE (unit=unit_number, fmt=
"(A)") &
808 repeat(
" ", l0)//
"</DEFAULT_KEYWORD>"
810 WRITE (unit=unit_number, fmt=
"(A)") &
811 repeat(
" ", l0)//
"</KEYWORD>"
825 SUBROUTINE keyword_typo_match(keyword, unknown_string, location_string, matching_rank, matching_string, bonus)
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
833 CHARACTER(LEN=LEN(matching_string(1))) :: line
834 INTEGER :: i, imatch,
imax, irank, j, k
836 cpassert(
ASSOCIATED(keyword))
837 cpassert(keyword%ref_count > 0)
839 DO i = 1,
SIZE(keyword%names)
840 imatch =
typo_match(trim(keyword%names(i)), trim(unknown_string))
842 imatch = imatch + bonus
843 WRITE (line,
'(T2,A)')
" keyword "//trim(keyword%names(i))//
" in section "//trim(location_string)
844 imax =
SIZE(matching_rank, 1)
847 IF (imatch > matching_rank(k)) irank = k
849 IF (irank <=
imax)
THEN
850 matching_rank(irank + 1:
imax) = matching_rank(irank:
imax - 1)
851 matching_string(irank + 1:
imax) = matching_string(irank:
imax - 1)
852 matching_rank(irank) = imatch
853 matching_string(irank) = line
857 IF (keyword%type_of_var ==
enum_t)
THEN
858 DO j = 1,
SIZE(keyword%enum%c_vals)
859 imatch =
typo_match(trim(keyword%enum%c_vals(j)), trim(unknown_string))
861 imatch = imatch + bonus
862 WRITE (line,
'(T2,A)')
" enum "//trim(keyword%enum%c_vals(j))// &
863 " in section "//trim(location_string)// &
864 " for keyword "//trim(keyword%names(i))
865 imax =
SIZE(matching_rank, 1)
868 IF (imatch > matching_rank(k)) irank = k
870 IF (irank <=
imax)
THEN
871 matching_rank(irank + 1:
imax) = matching_rank(irank:
imax - 1)
872 matching_string(irank + 1:
imax) = matching_string(irank:
imax - 1)
873 matching_rank(irank) = imatch
874 matching_string(irank) = line
static int imax(int x, int y)
Returns the larger of two given integer (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.