Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2022 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 : INTEGER, SAVE, PRIVATE :: last_enumeration_id = 0
28 :
29 : PUBLIC :: enumeration_type
30 : PUBLIC :: enum_create, enum_retain, enum_release, enum_i2c, enum_c2i
31 :
32 : ! **************************************************************************************************
33 : !> \brief represents an enumaration, i.e. a mapping between strings and numbers
34 : !> \param id_nr identification number (unique)
35 : !> \param ref_count reference count
36 : !> \param c_vals string values
37 : !> \param i_vals integer values
38 : !> \param strict if integer values not in the list should be accepted
39 : !> \author fawzi
40 : ! **************************************************************************************************
41 : TYPE char_array
42 : CHARACTER, DIMENSION(:), POINTER :: chars => Null()
43 : END TYPE char_array
44 :
45 : TYPE enumeration_type
46 : INTEGER :: id_nr, ref_count
47 : CHARACTER(len=default_string_length), DIMENSION(:), POINTER :: c_vals
48 : TYPE(char_array), DIMENSION(:), POINTER :: desc => Null()
49 : INTEGER, DIMENSION(:), POINTER :: i_vals
50 : LOGICAL :: strict
51 : END TYPE enumeration_type
52 :
53 : CONTAINS
54 :
55 : ! **************************************************************************************************
56 : !> \brief creates an enumeration
57 : !> \param enum the enumeration to be created
58 : !> \param c_vals string values
59 : !> \param i_vals integer values
60 : !> \param desc ...
61 : !> \param strict if integer values not in the list should be accepted,
62 : !> defaults defaults to true
63 : !> \author fawzi
64 : ! **************************************************************************************************
65 19968631 : SUBROUTINE enum_create(enum, c_vals, i_vals, desc, strict)
66 : TYPE(enumeration_type), POINTER :: enum
67 : CHARACTER(len=*), DIMENSION(:), INTENT(in) :: c_vals
68 : INTEGER, DIMENSION(:), INTENT(in) :: i_vals
69 : CHARACTER(len=*), DIMENSION(:), INTENT(in), &
70 : OPTIONAL :: desc
71 : LOGICAL, INTENT(in), OPTIONAL :: strict
72 :
73 : INTEGER :: i, j, n
74 :
75 19968631 : CPASSERT(.NOT. ASSOCIATED(enum))
76 19968631 : CPASSERT(SIZE(c_vals) == SIZE(i_vals))
77 19968631 : ALLOCATE (enum)
78 19968631 : last_enumeration_id = last_enumeration_id + 1
79 19968631 : enum%id_nr = last_enumeration_id
80 19968631 : enum%ref_count = 1
81 59905893 : ALLOCATE (enum%c_vals(SIZE(c_vals)))
82 112257663 : DO i = 1, SIZE(enum%c_vals)
83 92289032 : enum%c_vals(i) = c_vals(i)
84 112257663 : CALL uppercase(enum%c_vals(i))
85 : END DO
86 59905893 : ALLOCATE (enum%i_vals(SIZE(i_vals)))
87 112257663 : enum%i_vals = i_vals
88 19968631 : enum%strict = .TRUE.
89 19968631 : IF (PRESENT(strict)) enum%strict = strict
90 152194925 : ALLOCATE (enum%desc(SIZE(c_vals)))
91 19968631 : IF (PRESENT(desc)) THEN
92 11913672 : CPASSERT(SIZE(enum%desc) == SIZE(desc))
93 54018998 : DO i = 1, SIZE(enum%desc)
94 42105326 : n = LEN_TRIM(desc(i))
95 126315978 : ALLOCATE (enum%desc(i)%chars(n))
96 2089743747 : DO j = 1, n
97 2077830075 : enum%desc(i)%chars(j) = desc(i) (j:j)
98 : END DO
99 : END DO
100 : ELSE
101 58238665 : DO i = 1, SIZE(enum%desc)
102 50183706 : ALLOCATE (enum%desc(i)%chars(1))
103 108422371 : enum%desc(i)%chars(1:1) = ' '
104 : END DO
105 : END IF
106 19968631 : END SUBROUTINE enum_create
107 :
108 : ! **************************************************************************************************
109 : !> \brief retains the given enumeration
110 : !> \param enum the obect to retain
111 : !> \author fawzi
112 : ! **************************************************************************************************
113 25857087 : SUBROUTINE enum_retain(enum)
114 : TYPE(enumeration_type), POINTER :: enum
115 :
116 25857087 : CPASSERT(ASSOCIATED(enum))
117 25857087 : CPASSERT(enum%ref_count > 0)
118 25857087 : enum%ref_count = enum%ref_count + 1
119 25857087 : END SUBROUTINE enum_retain
120 :
121 : ! **************************************************************************************************
122 : !> \brief releases the given enumeration
123 : !> \param enum the obect to release
124 : !> \author fawzi
125 : ! **************************************************************************************************
126 1380350408 : SUBROUTINE enum_release(enum)
127 : TYPE(enumeration_type), POINTER :: enum
128 :
129 : INTEGER :: i
130 :
131 1380350408 : IF (ASSOCIATED(enum)) THEN
132 45825718 : CPASSERT(enum%ref_count > 0)
133 45825718 : enum%ref_count = enum%ref_count - 1
134 45825718 : IF (enum%ref_count == 0) THEN
135 19968631 : DEALLOCATE (enum%c_vals)
136 19968631 : DEALLOCATE (enum%i_vals)
137 112257663 : DO i = 1, SIZE(enum%desc)
138 112257663 : DEALLOCATE (enum%desc(i)%chars)
139 : END DO
140 19968631 : DEALLOCATE (enum%desc)
141 19968631 : DEALLOCATE (enum)
142 : END IF
143 : END IF
144 1380350408 : NULLIFY (enum)
145 1380350408 : END SUBROUTINE enum_release
146 :
147 : ! **************************************************************************************************
148 : !> \brief maps an integer to a string
149 : !> \param enum the enumeration to use for the mapping
150 : !> \param i the value to map
151 : !> \return ...
152 : !> \author fawzi
153 : ! **************************************************************************************************
154 146954 : FUNCTION enum_i2c(enum, i) RESULT(res)
155 : TYPE(enumeration_type), POINTER :: enum
156 : INTEGER, INTENT(in) :: i
157 : CHARACTER(len=default_string_length) :: res
158 :
159 : INTEGER :: j
160 : LOGICAL :: found
161 :
162 146954 : CPASSERT(ASSOCIATED(enum))
163 146954 : CPASSERT(enum%ref_count > 0)
164 146954 : res = " "
165 146954 : found = .FALSE.
166 450787 : DO j = 1, SIZE(enum%i_vals)
167 450787 : IF (enum%i_vals(j) == i) THEN
168 146954 : res = enum%c_vals(j)
169 : found = .TRUE.
170 : EXIT
171 : END IF
172 : END DO
173 : IF (.NOT. found) THEN
174 0 : IF (enum%strict) THEN
175 0 : DO j = 1, SIZE(enum%desc)
176 0 : PRINT *, TRIM(a2s(enum%desc(j)%chars))
177 0 : PRINT *, TRIM(enum%c_vals(j))
178 : END DO
179 0 : PRINT *, enum%i_vals
180 : END IF
181 0 : IF (enum%strict) &
182 0 : CPABORT("invalid value for enumeration:"//cp_to_string(i))
183 0 : res = ADJUSTL(cp_to_string(i))
184 : END IF
185 146954 : END FUNCTION enum_i2c
186 :
187 : ! **************************************************************************************************
188 : !> \brief maps a string to an integer
189 : !> \param enum the enumeration to use for the mapping
190 : !> \param c the value to map
191 : !> \return ...
192 : !> \author fawzi
193 : ! **************************************************************************************************
194 79916 : FUNCTION enum_c2i(enum, c) RESULT(res)
195 : TYPE(enumeration_type), POINTER :: enum
196 : CHARACTER(len=*), INTENT(in) :: c
197 : INTEGER :: res
198 :
199 : CHARACTER(len=default_string_length) :: upc
200 : INTEGER :: iostat, j
201 : LOGICAL :: found
202 :
203 0 : CPASSERT(ASSOCIATED(enum))
204 79916 : CPASSERT(enum%ref_count > 0)
205 79916 : upc = TRIM(ADJUSTL(c)) !MK Ignore leading and trailing blanks
206 79916 : CALL uppercase(upc)
207 79916 : found = .FALSE.
208 282790 : DO j = 1, SIZE(enum%c_vals)
209 282790 : IF (enum%c_vals(j) == upc) THEN
210 79916 : res = enum%i_vals(j)
211 : found = .TRUE.
212 : EXIT
213 : END IF
214 : END DO
215 :
216 : IF (.NOT. found) THEN
217 0 : IF (enum%strict) &
218 0 : CPABORT("invalid value for enumeration:"//TRIM(c))
219 0 : READ (c, "(i10)", iostat=iostat) res
220 0 : IF (iostat /= 0) &
221 0 : CPABORT("invalid value for enumeration2:"//TRIM(c))
222 : END IF
223 79916 : END FUNCTION enum_c2i
224 :
225 0 : END MODULE input_enumeration_types
|
