Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2023 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 18867931 : 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 18867931 : CPASSERT(.NOT. ASSOCIATED(enum))
74 18867931 : CPASSERT(SIZE(c_vals) == SIZE(i_vals))
75 18867931 : ALLOCATE (enum)
76 18867931 : enum%ref_count = 1
77 56603793 : ALLOCATE (enum%c_vals(SIZE(c_vals)))
78 106135316 : DO i = 1, SIZE(enum%c_vals)
79 87267385 : CPASSERT(LEN_TRIM(c_vals(i)) > 0)
80 87267385 : enum%c_vals(i) = c_vals(i)
81 106135316 : CALL uppercase(enum%c_vals(i))
82 : END DO
83 56603793 : ALLOCATE (enum%i_vals(SIZE(i_vals)))
84 106135316 : enum%i_vals = i_vals
85 18867931 : enum%strict = .TRUE.
86 18867931 : IF (PRESENT(strict)) enum%strict = strict
87 143871178 : ALLOCATE (enum%desc(SIZE(c_vals)))
88 18867931 : IF (PRESENT(desc)) THEN
89 11670155 : CPASSERT(SIZE(enum%desc) == SIZE(desc))
90 52885626 : DO i = 1, SIZE(enum%desc)
91 41215471 : n = LEN_TRIM(desc(i))
92 123646413 : ALLOCATE (enum%desc(i)%chars(n))
93 2026425099 : DO j = 1, n
94 2014754944 : enum%desc(i)%chars(j) = desc(i) (j:j)
95 : END DO
96 : END DO
97 : ELSE
98 53249690 : DO i = 1, SIZE(enum%desc)
99 46051914 : ALLOCATE (enum%desc(i)%chars(1))
100 99301604 : enum%desc(i)%chars(1:1) = ' '
101 : END DO
102 : END IF
103 18867931 : END SUBROUTINE enum_create
104 :
105 : ! **************************************************************************************************
106 : !> \brief retains the given enumeration
107 : !> \param enum the obect to retain
108 : !> \author fawzi
109 : ! **************************************************************************************************
110 24333406 : SUBROUTINE enum_retain(enum)
111 : TYPE(enumeration_type), POINTER :: enum
112 :
113 24333406 : CPASSERT(ASSOCIATED(enum))
114 24333406 : CPASSERT(enum%ref_count > 0)
115 24333406 : enum%ref_count = enum%ref_count + 1
116 24333406 : END SUBROUTINE enum_retain
117 :
118 : ! **************************************************************************************************
119 : !> \brief releases the given enumeration
120 : !> \param enum the obect to release
121 : !> \author fawzi
122 : ! **************************************************************************************************
123 1518640507 : SUBROUTINE enum_release(enum)
124 : TYPE(enumeration_type), POINTER :: enum
125 :
126 : INTEGER :: i
127 :
128 1518640507 : IF (ASSOCIATED(enum)) THEN
129 43201337 : CPASSERT(enum%ref_count > 0)
130 43201337 : enum%ref_count = enum%ref_count - 1
131 43201337 : IF (enum%ref_count == 0) THEN
132 18867931 : DEALLOCATE (enum%c_vals)
133 18867931 : DEALLOCATE (enum%i_vals)
134 106135316 : DO i = 1, SIZE(enum%desc)
135 106135316 : DEALLOCATE (enum%desc(i)%chars)
136 : END DO
137 18867931 : DEALLOCATE (enum%desc)
138 18867931 : DEALLOCATE (enum)
139 : END IF
140 : END IF
141 1518640507 : NULLIFY (enum)
142 1518640507 : 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 156176 : 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 156176 : CPASSERT(ASSOCIATED(enum))
160 156176 : CPASSERT(enum%ref_count > 0)
161 156176 : res = " "
162 156176 : found = .FALSE.
163 490412 : DO j = 1, SIZE(enum%i_vals)
164 490412 : IF (enum%i_vals(j) == i) THEN
165 156176 : 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 156176 : 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 87670 : 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 87670 : CPASSERT(enum%ref_count > 0)
202 87670 : upc = TRIM(ADJUSTL(c)) !MK Ignore leading and trailing blanks
203 87670 : CALL uppercase(upc)
204 87670 : found = .FALSE.
205 312154 : DO j = 1, SIZE(enum%c_vals)
206 312154 : IF (enum%c_vals(j) == upc) THEN
207 87670 : 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 87670 : END FUNCTION enum_c2i
221 :
222 0 : END MODULE input_enumeration_types
|
