LCOV - code coverage report
Current view: top level - src/input - input_keyword_types.F (source / functions) Coverage Total Hit
Test: CP2K Regtests (git:42dac4a) Lines: 45.8 % 382 175
Test Date: 2025-07-25 12:55:17 Functions: 50.0 % 10 5

            Line data    Source code
       1              : !--------------------------------------------------------------------------------------------------!
       2              : !   CP2K: A general program to perform molecular dynamics simulations                              !
       3              : !   Copyright 2000-2025 CP2K developers group <https://cp2k.org>                                   !
       4              : !                                                                                                  !
       5              : !   SPDX-License-Identifier: GPL-2.0-or-later                                                      !
       6              : !--------------------------------------------------------------------------------------------------!
       7              : 
       8              : ! **************************************************************************************************
       9              : !> \brief represents keywords in an input
      10              : !> \par History
      11              : !>      06.2004 created, based on Joost cp_keywords proposal [fawzi]
      12              : !> \author fawzi
      13              : ! **************************************************************************************************
      14              : MODULE input_keyword_types
      15              :    USE cp_units,                        ONLY: cp_unit_create,&
      16              :                                               cp_unit_desc,&
      17              :                                               cp_unit_release,&
      18              :                                               cp_unit_type
      19              :    USE input_enumeration_types,         ONLY: enum_create,&
      20              :                                               enum_release,&
      21              :                                               enum_retain,&
      22              :                                               enumeration_type
      23              :    USE input_val_types,                 ONLY: &
      24              :         char_t, enum_t, integer_t, lchar_t, logical_t, no_t, real_t, val_create, val_release, &
      25              :         val_retain, val_type, val_write, val_write_internal
      26              :    USE kinds,                           ONLY: default_string_length,&
      27              :                                               dp
      28              :    USE print_messages,                  ONLY: print_message
      29              :    USE reference_manager,               ONLY: get_citation_key
      30              :    USE string_utilities,                ONLY: a2s,&
      31              :                                               compress,&
      32              :                                               substitute_special_xml_tokens,&
      33              :                                               typo_match,&
      34              :                                               uppercase
      35              : #include "../base/base_uses.f90"
      36              : 
      37              :    IMPLICIT NONE
      38              :    PRIVATE
      39              : 
      40              :    LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .TRUE.
      41              :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'input_keyword_types'
      42              : 
      43              :    INTEGER, PARAMETER, PUBLIC :: usage_string_length = default_string_length*2
      44              : 
      45              :    PUBLIC :: keyword_p_type, keyword_type, keyword_create, keyword_retain, &
      46              :              keyword_release, keyword_get, keyword_describe, &
      47              :              write_keyword_xml, keyword_typo_match
      48              : 
      49              : ! **************************************************************************************************
      50              : !> \brief represent a pointer to a keyword (to make arrays of pointers)
      51              : !> \param keyword the pointer to the keyword
      52              : !> \author fawzi
      53              : ! **************************************************************************************************
      54              :    TYPE keyword_p_type
      55              :       TYPE(keyword_type), POINTER :: keyword => NULL()
      56              :    END TYPE keyword_p_type
      57              : 
      58              : ! **************************************************************************************************
      59              : !> \brief represent a keyword in the input
      60              : !> \param names the names of the current keyword (at least one should be
      61              : !>        present) for example "MAXSCF"
      62              : !> \param location is where in the source code (file and line) the keyword is created
      63              : !> \param usage how to use it "MAXSCF 10"
      64              : !> \param description what does it do: "MAXSCF : determines the maximum
      65              : !>        number of steps in an SCF run"
      66              : !> \param deprecation_notice show this warning that the keyword is deprecated
      67              : !> \param citations references to literature associated with this keyword
      68              : !> \param type_of_var the type of keyword (controls how it is parsed)
      69              : !>        it can be one of: no_parse_t,logical_t, integer_t, real_t,
      70              : !>        char_t
      71              : !> \param n_var number of values that should be parsed (-1=unknown)
      72              : !> \param repeats if the keyword can be present more than once in the
      73              : !>        section
      74              : !> \param removed to trigger a CPABORT when encountered while parsing the input
      75              : !> \param enum enumeration that defines the mapping between integers and
      76              : !>        strings
      77              : !> \param unit the default unit this keyword is read in (to automatically
      78              : !>        convert to the internal cp2k units during parsing)
      79              : !> \param default_value the default value for the keyword
      80              : !> \param lone_keyword_value value to be used in presence of the keyword
      81              : !>        without any parameter
      82              : !> \note
      83              : !>      I have expressely avoided a format string for the type of keywords:
      84              : !>      they should easily map to basic types of fortran, if you need more
      85              : !>      information use a subsection. [fawzi]
      86              : !> \author Joost & fawzi
      87              : ! **************************************************************************************************
      88              :    TYPE keyword_type
      89              :       INTEGER :: ref_count = 0
      90              :       CHARACTER(LEN=default_string_length), DIMENSION(:), POINTER :: names => NULL()
      91              :       CHARACTER(LEN=usage_string_length) :: location = ""
      92              :       CHARACTER(LEN=usage_string_length) :: usage = ""
      93              :       CHARACTER, DIMENSION(:), POINTER :: description => null()
      94              :       CHARACTER(LEN=:), ALLOCATABLE :: deprecation_notice
      95              :       INTEGER, POINTER, DIMENSION(:) :: citations => NULL()
      96              :       INTEGER :: type_of_var = 0, n_var = 0
      97              :       LOGICAL :: repeats = .FALSE., removed = .FALSE.
      98              :       TYPE(enumeration_type), POINTER :: enum => NULL()
      99              :       TYPE(cp_unit_type), POINTER :: unit => NULL()
     100              :       TYPE(val_type), POINTER :: default_value => NULL()
     101              :       TYPE(val_type), POINTER :: lone_keyword_value => NULL()
     102              :    END TYPE keyword_type
     103              : 
     104              : CONTAINS
     105              : 
     106              : ! **************************************************************************************************
     107              : !> \brief creates a keyword object
     108              : !> \param keyword the keyword object to be created
     109              : !> \param location from where in the source code keyword_create() is called
     110              : !> \param name the name of the keyword
     111              : !> \param description ...
     112              : !> \param usage ...
     113              : !> \param type_of_var ...
     114              : !> \param n_var ...
     115              : !> \param repeats ...
     116              : !> \param variants ...
     117              : !> \param default_val ...
     118              : !> \param default_l_val ...
     119              : !> \param default_r_val ...
     120              : !> \param default_lc_val ...
     121              : !> \param default_c_val ...
     122              : !> \param default_i_val ...
     123              : !> \param default_l_vals ...
     124              : !> \param default_r_vals ...
     125              : !> \param default_c_vals ...
     126              : !> \param default_i_vals ...
     127              : !> \param lone_keyword_val ...
     128              : !> \param lone_keyword_l_val ...
     129              : !> \param lone_keyword_r_val ...
     130              : !> \param lone_keyword_c_val ...
     131              : !> \param lone_keyword_i_val ...
     132              : !> \param lone_keyword_l_vals ...
     133              : !> \param lone_keyword_r_vals ...
     134              : !> \param lone_keyword_c_vals ...
     135              : !> \param lone_keyword_i_vals ...
     136              : !> \param enum_c_vals ...
     137              : !> \param enum_i_vals ...
     138              : !> \param enum ...
     139              : !> \param enum_strict ...
     140              : !> \param enum_desc ...
     141              : !> \param unit_str ...
     142              : !> \param citations ...
     143              : !> \param deprecation_notice ...
     144              : !> \param removed ...
     145              : !> \author fawzi
     146              : ! **************************************************************************************************
     147    649749438 :    SUBROUTINE keyword_create(keyword, location, name, description, usage, type_of_var, &
     148     10804108 :                              n_var, repeats, variants, default_val, &
     149              :                              default_l_val, default_r_val, default_lc_val, default_c_val, default_i_val, &
     150    649749438 :                              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   1299498876 :                              lone_keyword_i_val, lone_keyword_l_vals, lone_keyword_r_vals, &
     153   1949248314 :                              lone_keyword_c_vals, lone_keyword_i_vals, enum_c_vals, enum_i_vals, &
     154   1299498876 :                              enum, enum_strict, enum_desc, unit_str, citations, deprecation_notice, removed)
     155              :       TYPE(keyword_type), POINTER                        :: keyword
     156              :       CHARACTER(len=*), INTENT(in)                       :: location, name, description
     157              :       CHARACTER(len=*), INTENT(in), OPTIONAL             :: usage
     158              :       INTEGER, INTENT(in), OPTIONAL                      :: type_of_var, n_var
     159              :       LOGICAL, INTENT(in), OPTIONAL                      :: repeats
     160              :       CHARACTER(len=*), DIMENSION(:), INTENT(in), &
     161              :          OPTIONAL                                        :: variants
     162              :       TYPE(val_type), OPTIONAL, POINTER                  :: default_val
     163              :       LOGICAL, INTENT(in), OPTIONAL                      :: default_l_val
     164              :       REAL(KIND=DP), INTENT(in), OPTIONAL                :: default_r_val
     165              :       CHARACTER(len=*), INTENT(in), OPTIONAL             :: default_lc_val, default_c_val
     166              :       INTEGER, INTENT(in), OPTIONAL                      :: default_i_val
     167              :       LOGICAL, DIMENSION(:), INTENT(in), OPTIONAL        :: default_l_vals
     168              :       REAL(KIND=DP), DIMENSION(:), INTENT(in), OPTIONAL  :: default_r_vals
     169              :       CHARACTER(len=*), DIMENSION(:), INTENT(in), &
     170              :          OPTIONAL                                        :: default_c_vals
     171              :       INTEGER, DIMENSION(:), INTENT(in), OPTIONAL        :: default_i_vals
     172              :       TYPE(val_type), OPTIONAL, POINTER                  :: lone_keyword_val
     173              :       LOGICAL, INTENT(in), OPTIONAL                      :: lone_keyword_l_val
     174              :       REAL(KIND=DP), INTENT(in), OPTIONAL                :: lone_keyword_r_val
     175              :       CHARACTER(len=*), INTENT(in), OPTIONAL             :: lone_keyword_c_val
     176              :       INTEGER, INTENT(in), OPTIONAL                      :: lone_keyword_i_val
     177              :       LOGICAL, DIMENSION(:), INTENT(in), OPTIONAL        :: lone_keyword_l_vals
     178              :       REAL(KIND=DP), DIMENSION(:), INTENT(in), OPTIONAL  :: lone_keyword_r_vals
     179              :       CHARACTER(len=*), DIMENSION(:), INTENT(in), &
     180              :          OPTIONAL                                        :: lone_keyword_c_vals
     181              :       INTEGER, DIMENSION(:), INTENT(in), OPTIONAL        :: lone_keyword_i_vals
     182              :       CHARACTER(len=*), DIMENSION(:), INTENT(in), &
     183              :          OPTIONAL                                        :: enum_c_vals
     184              :       INTEGER, DIMENSION(:), INTENT(in), OPTIONAL        :: enum_i_vals
     185              :       TYPE(enumeration_type), OPTIONAL, POINTER          :: enum
     186              :       LOGICAL, INTENT(in), OPTIONAL                      :: enum_strict
     187              :       CHARACTER(len=*), DIMENSION(:), INTENT(in), &
     188              :          OPTIONAL                                        :: enum_desc
     189              :       CHARACTER(len=*), INTENT(in), OPTIONAL             :: unit_str
     190              :       INTEGER, DIMENSION(:), INTENT(in), OPTIONAL        :: citations
     191              :       CHARACTER(len=*), INTENT(in), OPTIONAL             :: deprecation_notice
     192              :       LOGICAL, INTENT(in), OPTIONAL                      :: removed
     193              : 
     194              :       CHARACTER(LEN=default_string_length)               :: tmp_string
     195              :       INTEGER                                            :: i, n
     196              :       LOGICAL                                            :: check
     197              : 
     198    649749438 :       CPASSERT(.NOT. ASSOCIATED(keyword))
     199    649749438 :       ALLOCATE (keyword)
     200    649749438 :       keyword%ref_count = 1
     201              :       NULLIFY (keyword%unit)
     202    649749438 :       keyword%location = location
     203    649749438 :       keyword%removed = .FALSE.
     204              : 
     205    649749438 :       CPASSERT(LEN_TRIM(name) > 0)
     206              : 
     207    649749438 :       IF (PRESENT(variants)) THEN
     208     32412324 :          ALLOCATE (keyword%names(SIZE(variants) + 1))
     209     10804108 :          keyword%names(1) = name
     210     25142684 :          DO i = 1, SIZE(variants)
     211     14338576 :             CPASSERT(LEN_TRIM(variants(i)) > 0)
     212     25142684 :             keyword%names(i + 1) = variants(i)
     213              :          END DO
     214              :       ELSE
     215    638945330 :          ALLOCATE (keyword%names(1))
     216    638945330 :          keyword%names(1) = name
     217              :       END IF
     218   1313837452 :       DO i = 1, SIZE(keyword%names)
     219   1313837452 :          CALL uppercase(keyword%names(i))
     220              :       END DO
     221              : 
     222    649749438 :       IF (PRESENT(usage)) THEN
     223    224491390 :          CPASSERT(LEN_TRIM(usage) <= LEN(keyword%usage))
     224    224491390 :          keyword%usage = usage
     225              :          ! Check that the usage string starts with one of the keyword names.
     226    224491390 :          IF (keyword%names(1) /= "_SECTION_PARAMETERS_" .AND. keyword%names(1) /= "_DEFAULT_KEYWORD_") THEN
     227    214578042 :             tmp_string = usage
     228    214578042 :             CALL uppercase(tmp_string)
     229    214578042 :             check = .FALSE.
     230    439750165 :             DO i = 1, SIZE(keyword%names)
     231    440675505 :                check = check .OR. (INDEX(tmp_string, TRIM(keyword%names(i))) == 1)
     232              :             END DO
     233    214578042 :             IF (.NOT. check) THEN
     234            0 :                CPABORT("Usage string must start with one of the keyword name.")
     235              :             END IF
     236              :          END IF
     237              :       ELSE
     238    425258048 :          keyword%usage = ""
     239              :       END IF
     240              : 
     241    649749438 :       n = LEN_TRIM(description)
     242   1948908270 :       ALLOCATE (keyword%description(n))
     243  31632007763 :       DO i = 1, n
     244  31632007763 :          keyword%description(i) = description(i:i)
     245              :       END DO
     246              : 
     247    649749438 :       IF (PRESENT(citations)) THEN
     248      3053910 :          ALLOCATE (keyword%citations(SIZE(citations, 1)))
     249      2935154 :          keyword%citations = citations
     250              :       ELSE
     251    648731468 :          NULLIFY (keyword%citations)
     252              :       END IF
     253              : 
     254    649749438 :       keyword%repeats = .FALSE.
     255    649749438 :       IF (PRESENT(repeats)) keyword%repeats = repeats
     256              : 
     257    649749438 :       NULLIFY (keyword%enum)
     258    649749438 :       IF (PRESENT(enum)) THEN
     259            0 :          keyword%enum => enum
     260            0 :          IF (ASSOCIATED(enum)) CALL enum_retain(enum)
     261              :       END IF
     262    649749438 :       IF (PRESENT(enum_i_vals)) THEN
     263     23304199 :          CPASSERT(PRESENT(enum_c_vals))
     264     23304199 :          CPASSERT(.NOT. ASSOCIATED(keyword%enum))
     265              :          CALL enum_create(keyword%enum, c_vals=enum_c_vals, i_vals=enum_i_vals, &
     266     31944826 :                           desc=enum_desc, strict=enum_strict)
     267              :       ELSE
     268    626445239 :          CPASSERT(.NOT. PRESENT(enum_c_vals))
     269              :       END IF
     270              : 
     271    649749438 :       NULLIFY (keyword%default_value, keyword%lone_keyword_value)
     272    649749438 :       IF (PRESENT(default_val)) THEN
     273              :          IF (PRESENT(default_l_val) .OR. PRESENT(default_l_vals) .OR. &
     274              :              PRESENT(default_i_val) .OR. PRESENT(default_i_vals) .OR. &
     275              :              PRESENT(default_r_val) .OR. PRESENT(default_r_vals) .OR. &
     276            0 :              PRESENT(default_c_val) .OR. PRESENT(default_c_vals)) &
     277            0 :             CPABORT("you should pass either default_val or a default value, not both")
     278            0 :          keyword%default_value => default_val
     279            0 :          IF (ASSOCIATED(default_val%enum)) THEN
     280            0 :             IF (ASSOCIATED(keyword%enum)) THEN
     281            0 :                CPASSERT(ASSOCIATED(keyword%enum, default_val%enum))
     282              :             ELSE
     283            0 :                keyword%enum => default_val%enum
     284            0 :                CALL enum_retain(keyword%enum)
     285              :             END IF
     286              :          ELSE
     287            0 :             CPASSERT(.NOT. ASSOCIATED(keyword%enum))
     288              :          END IF
     289            0 :          CALL val_retain(default_val)
     290              :       END IF
     291    649749438 :       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   4535154421 :                          c_vals=default_c_vals, lc_val=default_lc_val, enum=keyword%enum)
     296              :       END IF
     297              : 
     298    649749438 :       keyword%type_of_var = keyword%default_value%type_of_var
     299    649749438 :       IF (keyword%default_value%type_of_var == no_t) THEN
     300     15713386 :          CALL val_release(keyword%default_value)
     301              :       END IF
     302              : 
     303    649749438 :       IF (keyword%type_of_var == no_t) THEN
     304     15713386 :          IF (PRESENT(type_of_var)) THEN
     305     15713386 :             keyword%type_of_var = type_of_var
     306              :          ELSE
     307              :             CALL cp_abort(__LOCATION__, &
     308              :                           "keyword "//TRIM(keyword%names(1))// &
     309            0 :                           " assumed undefined type by default")
     310              :          END IF
     311    634036052 :       ELSE IF (PRESENT(type_of_var)) THEN
     312     12786226 :          IF (keyword%type_of_var /= type_of_var) &
     313              :             CALL cp_abort(__LOCATION__, &
     314              :                           "keyword "//TRIM(keyword%names(1))// &
     315            0 :                           " has a type different from the type of the default_value")
     316     12786226 :          keyword%type_of_var = type_of_var
     317              :       END IF
     318              : 
     319    649749438 :       IF (keyword%type_of_var == no_t) THEN
     320            0 :          CALL val_create(keyword%default_value)
     321              :       END IF
     322              : 
     323    649749438 :       IF (PRESENT(lone_keyword_val)) THEN
     324              :          IF (PRESENT(lone_keyword_l_val) .OR. PRESENT(lone_keyword_l_vals) .OR. &
     325              :              PRESENT(lone_keyword_i_val) .OR. PRESENT(lone_keyword_i_vals) .OR. &
     326              :              PRESENT(lone_keyword_r_val) .OR. PRESENT(lone_keyword_r_vals) .OR. &
     327            0 :              PRESENT(lone_keyword_c_val) .OR. PRESENT(lone_keyword_c_vals)) &
     328              :             CALL cp_abort(__LOCATION__, &
     329            0 :                           "you should pass either lone_keyword_val or a lone_keyword value, not both")
     330            0 :          keyword%lone_keyword_value => lone_keyword_val
     331            0 :          CALL val_retain(lone_keyword_val)
     332            0 :          IF (ASSOCIATED(lone_keyword_val%enum)) THEN
     333            0 :             IF (ASSOCIATED(keyword%enum)) THEN
     334            0 :                IF (.NOT. ASSOCIATED(keyword%enum, lone_keyword_val%enum)) &
     335            0 :                   CPABORT("keyword%enum/=lone_keyword_val%enum")
     336              :             ELSE
     337            0 :                IF (ASSOCIATED(keyword%lone_keyword_value)) THEN
     338            0 :                   CPABORT(".NOT. ASSOCIATED(keyword%lone_keyword_value)")
     339              :                END IF
     340            0 :                keyword%enum => lone_keyword_val%enum
     341            0 :                CALL enum_retain(keyword%enum)
     342              :             END IF
     343              :          ELSE
     344            0 :             CPASSERT(.NOT. ASSOCIATED(keyword%enum))
     345              :          END IF
     346              :       END IF
     347    649749438 :       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   3898376518 :                          c_vals=lone_keyword_c_vals, enum=keyword%enum)
     352              :       END IF
     353    649749438 :       IF (ASSOCIATED(keyword%lone_keyword_value)) THEN
     354    649749438 :          IF (keyword%lone_keyword_value%type_of_var == no_t) THEN
     355    560577468 :             CALL val_release(keyword%lone_keyword_value)
     356              :          ELSE
     357     89171970 :             IF (keyword%lone_keyword_value%type_of_var /= keyword%type_of_var) &
     358            0 :                CPABORT("lone_keyword_value type incompatible with keyword type")
     359              :             ! lc_val cannot have lone_keyword_value!
     360     89171970 :             IF (keyword%type_of_var == enum_t) THEN
     361      6736218 :                IF (keyword%enum%strict) THEN
     362      6736218 :                   check = .FALSE.
     363     53847140 :                   DO i = 1, SIZE(keyword%enum%i_vals)
     364     81653255 :                      check = check .OR. (keyword%default_value%i_val(1) == keyword%enum%i_vals(i))
     365              :                   END DO
     366      6736218 :                   IF (.NOT. check) &
     367            0 :                      CPABORT("default value not in enumeration : "//keyword%names(1))
     368              :                END IF
     369              :             END IF
     370              :          END IF
     371              :       END IF
     372              : 
     373    649749438 :       keyword%n_var = 1
     374    649749438 :       IF (ASSOCIATED(keyword%default_value)) THEN
     375    717832474 :          SELECT CASE (keyword%default_value%type_of_var)
     376              :          CASE (logical_t)
     377     83796422 :             keyword%n_var = SIZE(keyword%default_value%l_val)
     378              :          CASE (integer_t)
     379    146572448 :             keyword%n_var = SIZE(keyword%default_value%i_val)
     380              :          CASE (enum_t)
     381     23219103 :             IF (keyword%enum%strict) THEN
     382     23219103 :                check = .FALSE.
     383    130130677 :                DO i = 1, SIZE(keyword%enum%i_vals)
     384    166618901 :                   check = check .OR. (keyword%default_value%i_val(1) == keyword%enum%i_vals(i))
     385              :                END DO
     386     23219103 :                IF (.NOT. check) &
     387            0 :                   CPABORT("default value not in enumeration : "//keyword%names(1))
     388              :             END IF
     389     23219103 :             keyword%n_var = SIZE(keyword%default_value%i_val)
     390              :          CASE (real_t)
     391    370640952 :             keyword%n_var = SIZE(keyword%default_value%r_val)
     392              :          CASE (char_t)
     393      2326208 :             keyword%n_var = SIZE(keyword%default_value%c_val)
     394              :          CASE (lchar_t)
     395      7480919 :             keyword%n_var = 1
     396              :          CASE (no_t)
     397            0 :             keyword%n_var = 0
     398              :          CASE default
     399    634036052 :             CPABORT("")
     400              :          END SELECT
     401              :       END IF
     402    649749438 :       IF (PRESENT(n_var)) keyword%n_var = n_var
     403    649749438 :       IF (keyword%type_of_var == lchar_t .AND. keyword%n_var /= 1) &
     404            0 :          CPABORT("arrays of lchar_t not supported : "//keyword%names(1))
     405              : 
     406    649749438 :       IF (PRESENT(unit_str)) THEN
     407    312241700 :          ALLOCATE (keyword%unit)
     408     12489668 :          CALL cp_unit_create(keyword%unit, unit_str)
     409              :       END IF
     410              : 
     411    649749438 :       IF (PRESENT(deprecation_notice)) THEN
     412       105338 :          keyword%deprecation_notice = TRIM(deprecation_notice)
     413              :       END IF
     414              : 
     415    649749438 :       IF (PRESENT(removed)) THEN
     416        36952 :          keyword%removed = removed
     417              :       END IF
     418    649749438 :    END SUBROUTINE keyword_create
     419              : 
     420              : ! **************************************************************************************************
     421              : !> \brief retains the given keyword (see doc/ReferenceCounting.html)
     422              : !> \param keyword the keyword to retain
     423              : !> \author fawzi
     424              : ! **************************************************************************************************
     425    649749438 :    SUBROUTINE keyword_retain(keyword)
     426              :       TYPE(keyword_type), POINTER                        :: keyword
     427              : 
     428    649749438 :       CPASSERT(ASSOCIATED(keyword))
     429    649749438 :       CPASSERT(keyword%ref_count > 0)
     430    649749438 :       keyword%ref_count = keyword%ref_count + 1
     431    649749438 :    END SUBROUTINE keyword_retain
     432              : 
     433              : ! **************************************************************************************************
     434              : !> \brief releases the given keyword (see doc/ReferenceCounting.html)
     435              : !> \param keyword the keyword to release
     436              : !> \author fawzi
     437              : ! **************************************************************************************************
     438   1673069719 :    SUBROUTINE keyword_release(keyword)
     439              :       TYPE(keyword_type), POINTER                        :: keyword
     440              : 
     441   1673069719 :       IF (ASSOCIATED(keyword)) THEN
     442   1299498876 :          CPASSERT(keyword%ref_count > 0)
     443   1299498876 :          keyword%ref_count = keyword%ref_count - 1
     444   1299498876 :          IF (keyword%ref_count == 0) THEN
     445    649749438 :             DEALLOCATE (keyword%names)
     446    649749438 :             DEALLOCATE (keyword%description)
     447    649749438 :             CALL val_release(keyword%default_value)
     448    649749438 :             CALL val_release(keyword%lone_keyword_value)
     449    649749438 :             CALL enum_release(keyword%enum)
     450    649749438 :             IF (ASSOCIATED(keyword%unit)) THEN
     451     12489668 :                CALL cp_unit_release(keyword%unit)
     452     12489668 :                DEALLOCATE (keyword%unit)
     453              :             END IF
     454    649749438 :             IF (ASSOCIATED(keyword%citations)) THEN
     455      1017970 :                DEALLOCATE (keyword%citations)
     456              :             END IF
     457    649749438 :             DEALLOCATE (keyword)
     458              :          END IF
     459              :       END IF
     460   1673069719 :       NULLIFY (keyword)
     461   1673069719 :    END SUBROUTINE keyword_release
     462              : 
     463              : ! **************************************************************************************************
     464              : !> \brief ...
     465              : !> \param keyword ...
     466              : !> \param names ...
     467              : !> \param usage ...
     468              : !> \param description ...
     469              : !> \param type_of_var ...
     470              : !> \param n_var ...
     471              : !> \param default_value ...
     472              : !> \param lone_keyword_value ...
     473              : !> \param repeats ...
     474              : !> \param enum ...
     475              : !> \param citations ...
     476              : !> \author fawzi
     477              : ! **************************************************************************************************
     478        50499 :    SUBROUTINE keyword_get(keyword, names, usage, description, type_of_var, n_var, &
     479              :                           default_value, lone_keyword_value, repeats, enum, citations)
     480              :       TYPE(keyword_type), POINTER                        :: keyword
     481              :       CHARACTER(len=default_string_length), &
     482              :          DIMENSION(:), OPTIONAL, POINTER                 :: names
     483              :       CHARACTER(len=*), INTENT(out), OPTIONAL            :: usage, description
     484              :       INTEGER, INTENT(out), OPTIONAL                     :: type_of_var, n_var
     485              :       TYPE(val_type), OPTIONAL, POINTER                  :: default_value, lone_keyword_value
     486              :       LOGICAL, INTENT(out), OPTIONAL                     :: repeats
     487              :       TYPE(enumeration_type), OPTIONAL, POINTER          :: enum
     488              :       INTEGER, DIMENSION(:), OPTIONAL, POINTER           :: citations
     489              : 
     490            0 :       CPASSERT(ASSOCIATED(keyword))
     491        50499 :       CPASSERT(keyword%ref_count > 0)
     492        50499 :       IF (PRESENT(names)) names => keyword%names
     493        50499 :       IF (PRESENT(usage)) usage = keyword%usage
     494        50499 :       IF (PRESENT(description)) description = a2s(keyword%description)
     495        50499 :       IF (PRESENT(type_of_var)) type_of_var = keyword%type_of_var
     496        50499 :       IF (PRESENT(n_var)) n_var = keyword%n_var
     497        50499 :       IF (PRESENT(repeats)) repeats = keyword%repeats
     498        50499 :       IF (PRESENT(default_value)) default_value => keyword%default_value
     499        50499 :       IF (PRESENT(lone_keyword_value)) lone_keyword_value => keyword%lone_keyword_value
     500        50499 :       IF (PRESENT(enum)) enum => keyword%enum
     501        50499 :       IF (PRESENT(citations)) citations => keyword%citations
     502        50499 :    END SUBROUTINE keyword_get
     503              : 
     504              : ! **************************************************************************************************
     505              : !> \brief writes out a description of the keyword
     506              : !> \param keyword the keyword to describe
     507              : !> \param unit_nr the unit to write to
     508              : !> \param level the description level (0 no description, 1 name
     509              : !>        2: +usage, 3: +variants+description+default_value+repeats
     510              : !>        4: +type_of_var)
     511              : !> \author fawzi
     512              : ! **************************************************************************************************
     513           19 :    SUBROUTINE keyword_describe(keyword, unit_nr, level)
     514              :       TYPE(keyword_type), POINTER                        :: keyword
     515              :       INTEGER, INTENT(in)                                :: unit_nr, level
     516              : 
     517              :       CHARACTER(len=default_string_length)               :: c_string
     518              :       INTEGER                                            :: i, l
     519              : 
     520           19 :       CPASSERT(ASSOCIATED(keyword))
     521           19 :       CPASSERT(keyword%ref_count > 0)
     522           19 :       IF (level > 0 .AND. (unit_nr > 0)) THEN
     523           19 :          WRITE (unit_nr, "(a,a,a)") "                           ---", &
     524           38 :             TRIM(keyword%names(1)), "---"
     525           19 :          IF (level > 1) THEN
     526           19 :             WRITE (unit_nr, "(a,a)") "usage         : ", TRIM(keyword%usage)
     527              :          END IF
     528           19 :          IF (level > 2) THEN
     529           19 :             WRITE (unit_nr, "(a)") "description   : "
     530           19 :             CALL print_message(TRIM(a2s(keyword%description)), unit_nr, 0, 0, 0)
     531           19 :             IF (level > 3) THEN
     532            0 :                SELECT CASE (keyword%type_of_var)
     533              :                CASE (logical_t)
     534            0 :                   IF (keyword%n_var == -1) THEN
     535            0 :                      WRITE (unit_nr, "('  A list of logicals is expected')")
     536            0 :                   ELSE IF (keyword%n_var == 1) THEN
     537            0 :                      WRITE (unit_nr, "('  A logical is expected')")
     538              :                   ELSE
     539            0 :                      WRITE (unit_nr, "(i6,'  logicals are expected')") keyword%n_var
     540              :                   END IF
     541            0 :                   WRITE (unit_nr, "('  (T,TRUE,YES,ON) and (F,FALSE,NO,OFF) are synonyms')")
     542              :                CASE (integer_t)
     543            0 :                   IF (keyword%n_var == -1) THEN
     544            0 :                      WRITE (unit_nr, "('  A list of integers is expected')")
     545            0 :                   ELSE IF (keyword%n_var == 1) THEN
     546            0 :                      WRITE (unit_nr, "('  An integer is expected')")
     547              :                   ELSE
     548            0 :                      WRITE (unit_nr, "(i6,' integers are expected')") keyword%n_var
     549              :                   END IF
     550              :                CASE (real_t)
     551            0 :                   IF (keyword%n_var == -1) THEN
     552            0 :                      WRITE (unit_nr, "('  A list of reals is expected')")
     553            0 :                   ELSE IF (keyword%n_var == 1) THEN
     554            0 :                      WRITE (unit_nr, "('  A real is expected')")
     555              :                   ELSE
     556            0 :                      WRITE (unit_nr, "(i6,' reals are expected')") keyword%n_var
     557              :                   END IF
     558            0 :                   IF (ASSOCIATED(keyword%unit)) THEN
     559            0 :                      c_string = cp_unit_desc(keyword%unit, accept_undefined=.TRUE.)
     560              :                      WRITE (unit_nr, "('the default unit of measure is ',a)") &
     561            0 :                         TRIM(c_string)
     562              :                   END IF
     563              :                CASE (char_t)
     564            0 :                   IF (keyword%n_var == -1) THEN
     565            0 :                      WRITE (unit_nr, "('  A list of words is expected')")
     566            0 :                   ELSE IF (keyword%n_var == 1) THEN
     567            0 :                      WRITE (unit_nr, "('  A word is expected')")
     568              :                   ELSE
     569            0 :                      WRITE (unit_nr, "(i6,' words are expected')") keyword%n_var
     570              :                   END IF
     571              :                CASE (lchar_t)
     572            0 :                   WRITE (unit_nr, "('  A string is expected')")
     573              :                CASE (enum_t)
     574            0 :                   IF (keyword%n_var == -1) THEN
     575            0 :                      WRITE (unit_nr, "('  A list of keywords is expected')")
     576            0 :                   ELSE IF (keyword%n_var == 1) THEN
     577            0 :                      WRITE (unit_nr, "('  A keyword is expected')")
     578              :                   ELSE
     579            0 :                      WRITE (unit_nr, "(i6,' keywords are expected')") keyword%n_var
     580              :                   END IF
     581              :                CASE (no_t)
     582            0 :                   WRITE (unit_nr, "('  Non-standard type.')")
     583              :                CASE default
     584            0 :                   CPABORT("")
     585              :                END SELECT
     586              :             END IF
     587           19 :             IF (keyword%type_of_var == enum_t) THEN
     588            2 :                IF (level > 3) THEN
     589            0 :                   WRITE (unit_nr, "('  valid keywords:')")
     590            0 :                   DO i = 1, SIZE(keyword%enum%c_vals)
     591            0 :                      c_string = keyword%enum%c_vals(i)
     592            0 :                      IF (LEN_TRIM(a2s(keyword%enum%desc(i)%chars)) > 0) THEN
     593              :                         WRITE (unit_nr, "('  - ',a,' : ',a,'.')") &
     594            0 :                            TRIM(c_string), TRIM(a2s(keyword%enum%desc(i)%chars))
     595              :                      ELSE
     596            0 :                         WRITE (unit_nr, "('  - ',a)") TRIM(c_string)
     597              :                      END IF
     598              :                   END DO
     599              :                ELSE
     600            2 :                   WRITE (unit_nr, "('  valid keywords:')", advance='NO')
     601            2 :                   l = 17
     602           18 :                   DO i = 1, SIZE(keyword%enum%c_vals)
     603           16 :                      c_string = keyword%enum%c_vals(i)
     604           16 :                      IF (l + LEN_TRIM(c_string) > 72 .AND. l > 14) THEN
     605            0 :                         WRITE (unit_nr, "(/,'    ')", advance='NO')
     606            0 :                         l = 4
     607              :                      END IF
     608           16 :                      WRITE (unit_nr, "(' ',a)", advance='NO') TRIM(c_string)
     609           18 :                      l = LEN_TRIM(c_string) + 3
     610              :                   END DO
     611            2 :                   WRITE (unit_nr, "()")
     612              :                END IF
     613            2 :                IF (.NOT. keyword%enum%strict) THEN
     614            0 :                   WRITE (unit_nr, "('     other integer values are also accepted.')")
     615              :                END IF
     616              :             END IF
     617           19 :             IF (ASSOCIATED(keyword%default_value) .AND. keyword%type_of_var /= no_t) THEN
     618           17 :                WRITE (unit_nr, "('default_value : ')", advance="NO")
     619           17 :                CALL val_write(keyword%default_value, unit_nr=unit_nr)
     620              :             END IF
     621           19 :             IF (ASSOCIATED(keyword%lone_keyword_value) .AND. keyword%type_of_var /= no_t) THEN
     622            3 :                WRITE (unit_nr, "('lone_keyword  : ')", advance="NO")
     623            3 :                CALL val_write(keyword%lone_keyword_value, unit_nr=unit_nr)
     624              :             END IF
     625           19 :             IF (keyword%repeats) THEN
     626            0 :                WRITE (unit_nr, "(' and it can be repeated more than once')", advance="NO")
     627              :             END IF
     628           19 :             WRITE (unit_nr, "()")
     629           19 :             IF (SIZE(keyword%names) > 1) THEN
     630            1 :                WRITE (unit_nr, "(a)", advance="NO") "variants    : "
     631            3 :                DO i = 2, SIZE(keyword%names)
     632            3 :                   WRITE (unit_nr, "(a,' ')", advance="NO") keyword%names(i)
     633              :                END DO
     634            1 :                WRITE (unit_nr, "()")
     635              :             END IF
     636              :          END IF
     637              :       END IF
     638           19 :    END SUBROUTINE keyword_describe
     639              : 
     640              : ! **************************************************************************************************
     641              : !> \brief Prints a description of a keyword in XML format
     642              : !> \param keyword The keyword to describe
     643              : !> \param level ...
     644              : !> \param unit_number Number of the output unit
     645              : !> \author Matthias Krack
     646              : ! **************************************************************************************************
     647            0 :    SUBROUTINE write_keyword_xml(keyword, level, unit_number)
     648              : 
     649              :       TYPE(keyword_type), POINTER                        :: keyword
     650              :       INTEGER, INTENT(IN)                                :: level, unit_number
     651              : 
     652              :       CHARACTER(LEN=1000)                                :: string
     653              :       CHARACTER(LEN=3)                                   :: removed, repeats
     654              :       CHARACTER(LEN=8)                                   :: short_string
     655              :       INTEGER                                            :: i, l0, l1, l2, l3, l4
     656              : 
     657            0 :       CPASSERT(ASSOCIATED(keyword))
     658            0 :       CPASSERT(keyword%ref_count > 0)
     659              : 
     660              :       ! Indentation for current level, next level, etc.
     661              : 
     662            0 :       l0 = level
     663            0 :       l1 = level + 1
     664            0 :       l2 = level + 2
     665            0 :       l3 = level + 3
     666            0 :       l4 = level + 4
     667              : 
     668            0 :       IF (keyword%repeats) THEN
     669            0 :          repeats = "yes"
     670              :       ELSE
     671            0 :          repeats = "no "
     672              :       END IF
     673              : 
     674            0 :       IF (keyword%removed) THEN
     675            0 :          removed = "yes"
     676              :       ELSE
     677            0 :          removed = "no "
     678              :       END IF
     679              : 
     680              :       ! Write (special) keyword element
     681              : 
     682            0 :       IF (keyword%names(1) == "_SECTION_PARAMETERS_") THEN
     683            0 :          WRITE (UNIT=unit_number, FMT="(A)") &
     684              :             REPEAT(" ", l0)//"<SECTION_PARAMETERS repeats="""//TRIM(repeats)// &
     685            0 :             """ removed="""//TRIM(removed)//""">", &
     686            0 :             REPEAT(" ", l1)//"<NAME type=""default"">SECTION_PARAMETERS</NAME>"
     687            0 :       ELSE IF (keyword%names(1) == "_DEFAULT_KEYWORD_") THEN
     688            0 :          WRITE (UNIT=unit_number, FMT="(A)") &
     689            0 :             REPEAT(" ", l0)//"<DEFAULT_KEYWORD repeats="""//TRIM(repeats)//""">", &
     690            0 :             REPEAT(" ", l1)//"<NAME type=""default"">DEFAULT_KEYWORD</NAME>"
     691              :       ELSE
     692            0 :          WRITE (UNIT=unit_number, FMT="(A)") &
     693              :             REPEAT(" ", l0)//"<KEYWORD repeats="""//TRIM(repeats)// &
     694            0 :             """ removed="""//TRIM(removed)//""">", &
     695              :             REPEAT(" ", l1)//"<NAME type=""default"">"// &
     696            0 :             TRIM(keyword%names(1))//"</NAME>"
     697              :       END IF
     698              : 
     699            0 :       DO i = 2, SIZE(keyword%names)
     700            0 :          WRITE (UNIT=unit_number, FMT="(A)") &
     701              :             REPEAT(" ", l1)//"<NAME type=""alias"">"// &
     702            0 :             TRIM(keyword%names(i))//"</NAME>"
     703              :       END DO
     704              : 
     705            0 :       SELECT CASE (keyword%type_of_var)
     706              :       CASE (logical_t)
     707            0 :          WRITE (UNIT=unit_number, FMT="(A)") &
     708            0 :             REPEAT(" ", l1)//"<DATA_TYPE kind=""logical"">"
     709              :       CASE (integer_t)
     710            0 :          WRITE (UNIT=unit_number, FMT="(A)") &
     711            0 :             REPEAT(" ", l1)//"<DATA_TYPE kind=""integer"">"
     712              :       CASE (real_t)
     713            0 :          WRITE (UNIT=unit_number, FMT="(A)") &
     714            0 :             REPEAT(" ", l1)//"<DATA_TYPE kind=""real"">"
     715              :       CASE (char_t)
     716            0 :          WRITE (UNIT=unit_number, FMT="(A)") &
     717            0 :             REPEAT(" ", l1)//"<DATA_TYPE kind=""word"">"
     718              :       CASE (lchar_t)
     719            0 :          WRITE (UNIT=unit_number, FMT="(A)") &
     720            0 :             REPEAT(" ", l1)//"<DATA_TYPE kind=""string"">"
     721              :       CASE (enum_t)
     722            0 :          WRITE (UNIT=unit_number, FMT="(A)") &
     723            0 :             REPEAT(" ", l1)//"<DATA_TYPE kind=""keyword"">"
     724            0 :          IF (keyword%enum%strict) THEN
     725            0 :             WRITE (UNIT=unit_number, FMT="(A)") &
     726            0 :                REPEAT(" ", l2)//"<ENUMERATION strict=""yes"">"
     727              :          ELSE
     728            0 :             WRITE (UNIT=unit_number, FMT="(A)") &
     729            0 :                REPEAT(" ", l2)//"<ENUMERATION strict=""no"">"
     730              :          END IF
     731            0 :          DO i = 1, SIZE(keyword%enum%c_vals)
     732            0 :             WRITE (UNIT=unit_number, FMT="(A)") &
     733            0 :                REPEAT(" ", l3)//"<ITEM>", &
     734              :                REPEAT(" ", l4)//"<NAME>"// &
     735            0 :                TRIM(ADJUSTL(substitute_special_xml_tokens(keyword%enum%c_vals(i))))//"</NAME>", &
     736              :                REPEAT(" ", l4)//"<DESCRIPTION>"// &
     737              :                TRIM(ADJUSTL(substitute_special_xml_tokens(a2s(keyword%enum%desc(i)%chars)))) &
     738            0 :                //"</DESCRIPTION>", REPEAT(" ", l3)//"</ITEM>"
     739              :          END DO
     740            0 :          WRITE (UNIT=unit_number, FMT="(A)") REPEAT(" ", l2)//"</ENUMERATION>"
     741              :       CASE (no_t)
     742            0 :          WRITE (UNIT=unit_number, FMT="(A)") &
     743            0 :             REPEAT(" ", l1)//"<DATA_TYPE kind=""non-standard type"">"
     744              :       CASE DEFAULT
     745            0 :          CPABORT("")
     746              :       END SELECT
     747              : 
     748            0 :       short_string = ""
     749            0 :       WRITE (UNIT=short_string, FMT="(I8)") keyword%n_var
     750            0 :       WRITE (UNIT=unit_number, FMT="(A)") &
     751            0 :          REPEAT(" ", l2)//"<N_VAR>"//TRIM(ADJUSTL(short_string))//"</N_VAR>", &
     752            0 :          REPEAT(" ", l1)//"</DATA_TYPE>"
     753              : 
     754              :       WRITE (UNIT=unit_number, FMT="(A)") REPEAT(" ", l1)//"<USAGE>"// &
     755              :          TRIM(substitute_special_xml_tokens(keyword%usage)) &
     756            0 :          //"</USAGE>"
     757              : 
     758              :       WRITE (UNIT=unit_number, FMT="(A)") REPEAT(" ", l1)//"<DESCRIPTION>"// &
     759              :          TRIM(substitute_special_xml_tokens(a2s(keyword%description))) &
     760            0 :          //"</DESCRIPTION>"
     761              : 
     762            0 :       IF (ALLOCATED(keyword%deprecation_notice)) &
     763              :          WRITE (UNIT=unit_number, FMT="(A)") REPEAT(" ", l1)//"<DEPRECATION_NOTICE>"// &
     764              :          TRIM(substitute_special_xml_tokens(keyword%deprecation_notice)) &
     765            0 :          //"</DEPRECATION_NOTICE>"
     766              : 
     767            0 :       IF (ASSOCIATED(keyword%default_value) .AND. &
     768              :           (keyword%type_of_var /= no_t)) THEN
     769            0 :          IF (ASSOCIATED(keyword%unit)) THEN
     770              :             CALL val_write_internal(val=keyword%default_value, &
     771              :                                     string=string, &
     772            0 :                                     unit=keyword%unit)
     773              :          ELSE
     774              :             CALL val_write_internal(val=keyword%default_value, &
     775            0 :                                     string=string)
     776              :          END IF
     777            0 :          CALL compress(string)
     778              :          WRITE (UNIT=unit_number, FMT="(A)") &
     779              :             REPEAT(" ", l1)//"<DEFAULT_VALUE>"// &
     780            0 :             TRIM(ADJUSTL(substitute_special_xml_tokens(string)))//"</DEFAULT_VALUE>"
     781              :       END IF
     782              : 
     783            0 :       IF (ASSOCIATED(keyword%unit)) THEN
     784            0 :          string = cp_unit_desc(keyword%unit, accept_undefined=.TRUE.)
     785              :          WRITE (UNIT=unit_number, FMT="(A)") &
     786              :             REPEAT(" ", l1)//"<DEFAULT_UNIT>"// &
     787            0 :             TRIM(ADJUSTL(string))//"</DEFAULT_UNIT>"
     788              :       END IF
     789              : 
     790            0 :       IF (ASSOCIATED(keyword%lone_keyword_value) .AND. &
     791              :           (keyword%type_of_var /= no_t)) THEN
     792              :          CALL val_write_internal(val=keyword%lone_keyword_value, &
     793            0 :                                  string=string)
     794              :          WRITE (UNIT=unit_number, FMT="(A)") &
     795              :             REPEAT(" ", l1)//"<LONE_KEYWORD_VALUE>"// &
     796            0 :             TRIM(ADJUSTL(substitute_special_xml_tokens(string)))//"</LONE_KEYWORD_VALUE>"
     797              :       END IF
     798              : 
     799            0 :       IF (ASSOCIATED(keyword%citations)) THEN
     800            0 :          DO i = 1, SIZE(keyword%citations, 1)
     801            0 :             short_string = ""
     802            0 :             WRITE (UNIT=short_string, FMT="(I8)") keyword%citations(i)
     803              :             WRITE (UNIT=unit_number, FMT="(A)") &
     804            0 :                REPEAT(" ", l1)//"<REFERENCE>", &
     805            0 :                REPEAT(" ", l2)//"<NAME>"//TRIM(get_citation_key(keyword%citations(i)))//"</NAME>", &
     806            0 :                REPEAT(" ", l2)//"<NUMBER>"//TRIM(ADJUSTL(short_string))//"</NUMBER>", &
     807            0 :                REPEAT(" ", l1)//"</REFERENCE>"
     808              :          END DO
     809              :       END IF
     810              : 
     811              :       WRITE (UNIT=unit_number, FMT="(A)") &
     812            0 :          REPEAT(" ", l1)//"<LOCATION>"//TRIM(keyword%location)//"</LOCATION>"
     813              : 
     814              :       ! Close (special) keyword section
     815              : 
     816            0 :       IF (keyword%names(1) == "_SECTION_PARAMETERS_") THEN
     817            0 :          WRITE (UNIT=unit_number, FMT="(A)") &
     818            0 :             REPEAT(" ", l0)//"</SECTION_PARAMETERS>"
     819            0 :       ELSE IF (keyword%names(1) == "_DEFAULT_KEYWORD_") THEN
     820            0 :          WRITE (UNIT=unit_number, FMT="(A)") &
     821            0 :             REPEAT(" ", l0)//"</DEFAULT_KEYWORD>"
     822              :       ELSE
     823            0 :          WRITE (UNIT=unit_number, FMT="(A)") &
     824            0 :             REPEAT(" ", l0)//"</KEYWORD>"
     825              :       END IF
     826              : 
     827            0 :    END SUBROUTINE write_keyword_xml
     828              : 
     829              : ! **************************************************************************************************
     830              : !> \brief ...
     831              : !> \param keyword ...
     832              : !> \param unknown_string ...
     833              : !> \param location_string ...
     834              : !> \param matching_rank ...
     835              : !> \param matching_string ...
     836              : !> \param bonus ...
     837              : ! **************************************************************************************************
     838            0 :    SUBROUTINE keyword_typo_match(keyword, unknown_string, location_string, matching_rank, matching_string, bonus)
     839              : 
     840              :       TYPE(keyword_type), POINTER                        :: keyword
     841              :       CHARACTER(LEN=*)                                   :: unknown_string, location_string
     842              :       INTEGER, DIMENSION(:), INTENT(INOUT)               :: matching_rank
     843              :       CHARACTER(LEN=*), DIMENSION(:), INTENT(INOUT)      :: matching_string
     844              :       INTEGER, INTENT(IN)                                :: bonus
     845              : 
     846            0 :       CHARACTER(LEN=LEN(matching_string(1)))             :: line
     847              :       INTEGER                                            :: i, imatch, imax, irank, j, k
     848              : 
     849            0 :       CPASSERT(ASSOCIATED(keyword))
     850            0 :       CPASSERT(keyword%ref_count > 0)
     851              : 
     852            0 :       DO i = 1, SIZE(keyword%names)
     853            0 :          imatch = typo_match(TRIM(keyword%names(i)), TRIM(unknown_string))
     854            0 :          IF (imatch > 0) THEN
     855            0 :             imatch = imatch + bonus
     856            0 :             WRITE (line, '(T2,A)') " keyword "//TRIM(keyword%names(i))//" in section "//TRIM(location_string)
     857            0 :             imax = SIZE(matching_rank, 1)
     858            0 :             irank = imax + 1
     859            0 :             DO k = imax, 1, -1
     860            0 :                IF (imatch > matching_rank(k)) irank = k
     861              :             END DO
     862            0 :             IF (irank <= imax) THEN
     863            0 :                matching_rank(irank + 1:imax) = matching_rank(irank:imax - 1)
     864            0 :                matching_string(irank + 1:imax) = matching_string(irank:imax - 1)
     865            0 :                matching_rank(irank) = imatch
     866            0 :                matching_string(irank) = line
     867              :             END IF
     868              :          END IF
     869              : 
     870            0 :          IF (keyword%type_of_var == enum_t) THEN
     871            0 :             DO j = 1, SIZE(keyword%enum%c_vals)
     872            0 :                imatch = typo_match(TRIM(keyword%enum%c_vals(j)), TRIM(unknown_string))
     873            0 :                IF (imatch > 0) THEN
     874            0 :                   imatch = imatch + bonus
     875              :                   WRITE (line, '(T2,A)') " enum "//TRIM(keyword%enum%c_vals(j))// &
     876              :                      " in section "//TRIM(location_string)// &
     877            0 :                      " for keyword "//TRIM(keyword%names(i))
     878            0 :                   imax = SIZE(matching_rank, 1)
     879            0 :                   irank = imax + 1
     880            0 :                   DO k = imax, 1, -1
     881            0 :                      IF (imatch > matching_rank(k)) irank = k
     882              :                   END DO
     883            0 :                   IF (irank <= imax) THEN
     884            0 :                      matching_rank(irank + 1:imax) = matching_rank(irank:imax - 1)
     885            0 :                      matching_string(irank + 1:imax) = matching_string(irank:imax - 1)
     886            0 :                      matching_rank(irank) = imatch
     887            0 :                      matching_string(irank) = line
     888              :                   END IF
     889              :                END IF
     890              :             END DO
     891              :          END IF
     892              :       END DO
     893              : 
     894            0 :    END SUBROUTINE keyword_typo_match
     895              : 
     896            0 : END MODULE input_keyword_types
        

Generated by: LCOV version 2.0-1