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