Line data    Source code

       1             : !--------------------------------------------------------------------------------------------------!
       2             : !   CP2K: A general program to perform molecular dynamics simulations                              !
       3             : !   Copyright 2000-2024 CP2K developers group <https://cp2k.org>                                   !
       4             : !                                                                                                  !
       5             : !   SPDX-License-Identifier: GPL-2.0-or-later                                                      !
       6             : !--------------------------------------------------------------------------------------------------!
       7             : 
       8             : ! **************************************************************************************************
       9             : !> \brief represents an enumeration, i.e. a mapping between integers and strings
      10             : !> \par History
      11             : !>      08.2004 created [fawzi]
      12             : !> \author fawzi
      13             : ! **************************************************************************************************
      14             : MODULE input_enumeration_types
      15             : 
      16             :    USE cp_log_handling,                 ONLY: cp_to_string
      17             :    USE kinds,                           ONLY: default_string_length
      18             :    USE string_utilities,                ONLY: a2s,&
      19             :                                               uppercase
      20             : #include "../base/base_uses.f90"
      21             : 
      22             :    IMPLICIT NONE
      23             :    PRIVATE
      24             : 
      25             :    LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .TRUE.
      26             :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'input_enumeration_types'
      27             : 
      28             :    PUBLIC :: enumeration_type
      29             :    PUBLIC :: enum_create, enum_retain, enum_release, enum_i2c, enum_c2i
      30             : 
      31             : ! **************************************************************************************************
      32             : !> \brief represents an enumaration, i.e. a mapping between strings and numbers
      33             : !> \param ref_count reference count
      34             : !> \param c_vals string values
      35             : !> \param i_vals integer values
      36             : !> \param strict if integer values not in the list should be accepted
      37             : !> \author fawzi
      38             : ! **************************************************************************************************
      39             :    TYPE char_array
      40             :       CHARACTER, DIMENSION(:), POINTER :: chars => Null()
      41             :    END TYPE char_array
      42             : 
      43             :    TYPE enumeration_type
      44             :       INTEGER :: ref_count = 0
      45             :       CHARACTER(len=default_string_length), DIMENSION(:), POINTER :: c_vals => NULL()
      46             :       TYPE(char_array), DIMENSION(:), POINTER :: desc => Null()
      47             :       INTEGER, DIMENSION(:), POINTER :: i_vals => NULL()
      48             :       LOGICAL :: strict = .FALSE.
      49             :    END TYPE enumeration_type
      50             : 
      51             : CONTAINS
      52             : 
      53             : ! **************************************************************************************************
      54             : !> \brief creates an enumeration
      55             : !> \param enum the enumeration to be created
      56             : !> \param c_vals string values
      57             : !> \param i_vals integer values
      58             : !> \param desc ...
      59             : !> \param strict if integer values not in the list should be accepted,
      60             : !>        defaults defaults to true
      61             : !> \author fawzi
      62             : ! **************************************************************************************************
      63    22619422 :    SUBROUTINE enum_create(enum, c_vals, i_vals, desc, strict)
      64             :       TYPE(enumeration_type), POINTER                    :: enum
      65             :       CHARACTER(len=*), DIMENSION(:), INTENT(in)         :: c_vals
      66             :       INTEGER, DIMENSION(:), INTENT(in)                  :: i_vals
      67             :       CHARACTER(len=*), DIMENSION(:), INTENT(in), &
      68             :          OPTIONAL                                        :: desc
      69             :       LOGICAL, INTENT(in), OPTIONAL                      :: strict
      70             : 
      71             :       INTEGER                                            :: i, j, n
      72             : 
      73    22619422 :       CPASSERT(.NOT. ASSOCIATED(enum))
      74    22619422 :       CPASSERT(SIZE(c_vals) == SIZE(i_vals))
      75    22619422 :       ALLOCATE (enum)
      76    22619422 :       enum%ref_count = 1
      77    67858266 :       ALLOCATE (enum%c_vals(SIZE(c_vals)))
      78   126667777 :       DO i = 1, SIZE(enum%c_vals)
      79   104048355 :          CPASSERT(LEN_TRIM(c_vals(i)) > 0)
      80   104048355 :          enum%c_vals(i) = c_vals(i)
      81   126667777 :          CALL uppercase(enum%c_vals(i))
      82             :       END DO
      83    67858266 :       ALLOCATE (enum%i_vals(SIZE(i_vals)))
      84   126667777 :       enum%i_vals = i_vals
      85    22619422 :       enum%strict = .TRUE.
      86    22619422 :       IF (PRESENT(strict)) enum%strict = strict
      87   171906621 :       ALLOCATE (enum%desc(SIZE(c_vals)))
      88    22619422 :       IF (PRESENT(desc)) THEN
      89    14223614 :          CPASSERT(SIZE(enum%desc) == SIZE(desc))
      90    64294150 :          DO i = 1, SIZE(enum%desc)
      91    50070536 :             n = LEN_TRIM(desc(i))
      92   150211608 :             ALLOCATE (enum%desc(i)%chars(n))
      93  2468103822 :             DO j = 1, n
      94  2453880208 :                enum%desc(i)%chars(j) = desc(i) (j:j)
      95             :             END DO
      96             :          END DO
      97             :       ELSE
      98    62373627 :          DO i = 1, SIZE(enum%desc)
      99    53977819 :             ALLOCATE (enum%desc(i)%chars(1))
     100   116351446 :             enum%desc(i)%chars(1:1) = ' '
     101             :          END DO
     102             :       END IF
     103    22619422 :    END SUBROUTINE enum_create
     104             : 
     105             : ! **************************************************************************************************
     106             : !> \brief retains the given enumeration
     107             : !> \param enum the obect to retain
     108             : !> \author fawzi
     109             : ! **************************************************************************************************
     110    29162836 :    SUBROUTINE enum_retain(enum)
     111             :       TYPE(enumeration_type), POINTER                    :: enum
     112             : 
     113    29162836 :       CPASSERT(ASSOCIATED(enum))
     114    29162836 :       CPASSERT(enum%ref_count > 0)
     115    29162836 :       enum%ref_count = enum%ref_count + 1
     116    29162836 :    END SUBROUTINE enum_retain
     117             : 
     118             : ! **************************************************************************************************
     119             : !> \brief releases the given enumeration
     120             : !> \param enum the obect to release
     121             : !> \author fawzi
     122             : ! **************************************************************************************************
     123  1741209420 :    SUBROUTINE enum_release(enum)
     124             :       TYPE(enumeration_type), POINTER                    :: enum
     125             : 
     126             :       INTEGER                                            :: i
     127             : 
     128  1741209420 :       IF (ASSOCIATED(enum)) THEN
     129    51782258 :          CPASSERT(enum%ref_count > 0)
     130    51782258 :          enum%ref_count = enum%ref_count - 1
     131    51782258 :          IF (enum%ref_count == 0) THEN
     132    22619422 :             DEALLOCATE (enum%c_vals)
     133    22619422 :             DEALLOCATE (enum%i_vals)
     134   126667777 :             DO i = 1, SIZE(enum%desc)
     135   126667777 :                DEALLOCATE (enum%desc(i)%chars)
     136             :             END DO
     137    22619422 :             DEALLOCATE (enum%desc)
     138    22619422 :             DEALLOCATE (enum)
     139             :          END IF
     140             :       END IF
     141  1741209420 :       NULLIFY (enum)
     142  1741209420 :    END SUBROUTINE enum_release
     143             : 
     144             : ! **************************************************************************************************
     145             : !> \brief maps an integer to a string
     146             : !> \param enum the enumeration to use for the mapping
     147             : !> \param i the value to map
     148             : !> \return ...
     149             : !> \author fawzi
     150             : ! **************************************************************************************************
     151      160516 :    FUNCTION enum_i2c(enum, i) RESULT(res)
     152             :       TYPE(enumeration_type), POINTER                    :: enum
     153             :       INTEGER, INTENT(in)                                :: i
     154             :       CHARACTER(len=default_string_length)               :: res
     155             : 
     156             :       INTEGER                                            :: j
     157             :       LOGICAL                                            :: found
     158             : 
     159      160516 :       CPASSERT(ASSOCIATED(enum))
     160      160516 :       CPASSERT(enum%ref_count > 0)
     161      160516 :       res = " "
     162      160516 :       found = .FALSE.
     163      500960 :       DO j = 1, SIZE(enum%i_vals)
     164      500960 :          IF (enum%i_vals(j) == i) THEN
     165      160516 :             res = enum%c_vals(j)
     166             :             found = .TRUE.
     167             :             EXIT
     168             :          END IF
     169             :       END DO
     170             :       IF (.NOT. found) THEN
     171           0 :          IF (enum%strict) THEN
     172           0 :             DO j = 1, SIZE(enum%desc)
     173           0 :                PRINT *, TRIM(a2s(enum%desc(j)%chars))
     174           0 :                PRINT *, TRIM(enum%c_vals(j))
     175             :             END DO
     176           0 :             PRINT *, enum%i_vals
     177             :          END IF
     178           0 :          IF (enum%strict) &
     179           0 :             CPABORT("invalid value for enumeration:"//cp_to_string(i))
     180           0 :          res = ADJUSTL(cp_to_string(i))
     181             :       END IF
     182      160516 :    END FUNCTION enum_i2c
     183             : 
     184             : ! **************************************************************************************************
     185             : !> \brief maps a string to an integer
     186             : !> \param enum the enumeration to use for the mapping
     187             : !> \param c the value to map
     188             : !> \return ...
     189             : !> \author fawzi
     190             : ! **************************************************************************************************
     191       94602 :    FUNCTION enum_c2i(enum, c) RESULT(res)
     192             :       TYPE(enumeration_type), POINTER                    :: enum
     193             :       CHARACTER(len=*), INTENT(in)                       :: c
     194             :       INTEGER                                            :: res
     195             : 
     196             :       CHARACTER(len=default_string_length)               :: upc
     197             :       INTEGER                                            :: iostat, j
     198             :       LOGICAL                                            :: found
     199             : 
     200           0 :       CPASSERT(ASSOCIATED(enum))
     201       94602 :       CPASSERT(enum%ref_count > 0)
     202       94602 :       upc = TRIM(ADJUSTL(c)) !MK Ignore leading and trailing blanks
     203       94602 :       CALL uppercase(upc)
     204       94602 :       found = .FALSE.
     205      348444 :       DO j = 1, SIZE(enum%c_vals)
     206      348444 :          IF (enum%c_vals(j) == upc) THEN
     207       94602 :             res = enum%i_vals(j)
     208             :             found = .TRUE.
     209             :             EXIT
     210             :          END IF
     211             :       END DO
     212             : 
     213             :       IF (.NOT. found) THEN
     214           0 :          IF (enum%strict) &
     215           0 :             CPABORT("invalid value for enumeration:"//TRIM(c))
     216           0 :          READ (c, "(i10)", iostat=iostat) res
     217           0 :          IF (iostat /= 0) &
     218           0 :             CPABORT("invalid value for enumeration2:"//TRIM(c))
     219             :       END IF
     220       94602 :    END FUNCTION enum_c2i
     221             : 
     222           0 : END MODULE input_enumeration_types