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 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 24296493 : 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 24296493 : CPASSERT(.NOT. ASSOCIATED(enum))
74 24296493 : CPASSERT(SIZE(c_vals) == SIZE(i_vals))
75 24296493 : ALLOCATE (enum)
76 24296493 : enum%ref_count = 1
77 72889479 : ALLOCATE (enum%c_vals(SIZE(c_vals)))
78 136038393 : DO i = 1, SIZE(enum%c_vals)
79 111741900 : CPASSERT(LEN_TRIM(c_vals(i)) > 0)
80 111741900 : enum%c_vals(i) = c_vals(i)
81 136038393 : CALL uppercase(enum%c_vals(i))
82 : END DO
83 72889479 : ALLOCATE (enum%i_vals(SIZE(i_vals)))
84 136038393 : enum%i_vals = i_vals
85 24296493 : enum%strict = .TRUE.
86 24296493 : IF (PRESENT(strict)) enum%strict = strict
87 184631379 : ALLOCATE (enum%desc(SIZE(c_vals)))
88 24296493 : IF (PRESENT(desc)) THEN
89 15327483 : CPASSERT(SIZE(enum%desc) == SIZE(desc))
90 69414999 : DO i = 1, SIZE(enum%desc)
91 54087516 : n = LEN_TRIM(desc(i))
92 162262548 : ALLOCATE (enum%desc(i)%chars(n))
93 2668693896 : DO j = 1, n
94 2653366413 : enum%desc(i)%chars(j) = desc(i) (j:j)
95 : END DO
96 : END DO
97 : ELSE
98 66623394 : DO i = 1, SIZE(enum%desc)
99 57654384 : ALLOCATE (enum%desc(i)%chars(1))
100 124277778 : enum%desc(i)%chars(1:1) = ' '
101 : END DO
102 : END IF
103 24296493 : END SUBROUTINE enum_create
104 :
105 : ! **************************************************************************************************
106 : !> \brief retains the given enumeration
107 : !> \param enum the obect to retain
108 : !> \author fawzi
109 : ! **************************************************************************************************
110 31316478 : SUBROUTINE enum_retain(enum)
111 : TYPE(enumeration_type), POINTER :: enum
112 :
113 31316478 : CPASSERT(ASSOCIATED(enum))
114 31316478 : CPASSERT(enum%ref_count > 0)
115 31316478 : enum%ref_count = enum%ref_count + 1
116 31316478 : END SUBROUTINE enum_retain
117 :
118 : ! **************************************************************************************************
119 : !> \brief releases the given enumeration
120 : !> \param enum the obect to release
121 : !> \author fawzi
122 : ! **************************************************************************************************
123 2124203705 : SUBROUTINE enum_release(enum)
124 : TYPE(enumeration_type), POINTER :: enum
125 :
126 : INTEGER :: i
127 :
128 2124203705 : IF (ASSOCIATED(enum)) THEN
129 55612971 : CPASSERT(enum%ref_count > 0)
130 55612971 : enum%ref_count = enum%ref_count - 1
131 55612971 : IF (enum%ref_count == 0) THEN
132 24296493 : DEALLOCATE (enum%c_vals)
133 24296493 : DEALLOCATE (enum%i_vals)
134 136038393 : DO i = 1, SIZE(enum%desc)
135 136038393 : DEALLOCATE (enum%desc(i)%chars)
136 : END DO
137 24296493 : DEALLOCATE (enum%desc)
138 24296493 : DEALLOCATE (enum)
139 : END IF
140 : END IF
141 2124203705 : NULLIFY (enum)
142 2124203705 : 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 160924 : 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 160924 : CPASSERT(ASSOCIATED(enum))
160 160924 : CPASSERT(enum%ref_count > 0)
161 160924 : res = " "
162 160924 : found = .FALSE.
163 499179 : DO j = 1, SIZE(enum%i_vals)
164 499179 : IF (enum%i_vals(j) == i) THEN
165 160924 : 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 160924 : 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 95774 : 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 95774 : CPASSERT(enum%ref_count > 0)
202 95774 : upc = TRIM(ADJUSTL(c)) !MK Ignore leading and trailing blanks
203 95774 : CALL uppercase(upc)
204 95774 : found = .FALSE.
205 350580 : DO j = 1, SIZE(enum%c_vals)
206 350580 : IF (enum%c_vals(j) == upc) THEN
207 95774 : 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 95774 : END FUNCTION enum_c2i
221 :
222 0 : END MODULE input_enumeration_types
|
