Branch data Line data Source code
1 : :
2 : : #if defined HAVE_CONFIG_H
3 : : #include "config.h"
4 : : #endif
5 : : !!****m* ABINIT/m_Vector
6 : : !! NAME
7 : : !! m_Vector
8 : : !!
9 : : !! FUNCTION
10 : : !! Manage a double precision vector
11 : : !!
12 : : !! COPYRIGHT
13 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
14 : : !! This file is distributed under the terms of the
15 : : !! GNU General Public License, see ~abinit/COPYING
16 : : !! or http://www.gnu.org/copyleft/gpl.txt .
17 : : !!
18 : : !! NOTES
19 : : !!
20 : : !! SOURCE
21 : :
22 : : #include "defs.h"
23 : : MODULE m_Vector
24 : : USE m_Global
25 : : IMPLICIT NONE
26 : :
27 : : !!***
28 : :
29 : : PRIVATE
30 : :
31 : : !!****t* m_Vector/Vector
32 : : !! NAME
33 : : !! Vector
34 : : !!
35 : : !! FUNCTION
36 : : !! This structured datatype contains the necessary data
37 : : !!
38 : : !! COPYRIGHT
39 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
40 : : !! This file is distributed under the terms of the
41 : : !! GNU General Public License, see ~abinit/COPYING
42 : : !! or http://www.gnu.org/copyleft/gpl.txt .
43 : : !!
44 : : !! SOURCE
45 : :
46 : : TYPE, PUBLIC :: Vector
47 : : INTEGER :: size
48 : : INTEGER :: tail
49 : : DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: vec
50 : : END TYPE Vector
51 : : !!***
52 : :
53 : : PUBLIC :: Vector_init
54 : : PUBLIC :: Vector_setSize
55 : : PUBLIC :: Vector_enlarge
56 : : PUBLIC :: Vector_pushBack
57 : : PUBLIC :: Vector_clear
58 : : PUBLIC :: Vector_print
59 : : PUBLIC :: Vector_destroy
60 : :
61 : : CONTAINS
62 : : !!***
63 : :
64 : : !!****f* ABINIT/m_Vector/Vector_init
65 : : !! NAME
66 : : !! Vector_init
67 : : !!
68 : : !! FUNCTION
69 : : !! initialize
70 : : !!
71 : : !! COPYRIGHT
72 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
73 : : !! This file is distributed under the terms of the
74 : : !! GNU General Public License, see ~abinit/COPYING
75 : : !! or http://www.gnu.org/copyleft/gpl.txt .
76 : : !!
77 : : !! INPUTS
78 : : !! this=vector
79 : : !! size=size of initialization
80 : : !!
81 : : !! OUTPUT
82 : : !!
83 : : !! SIDE EFFECTS
84 : : !!
85 : : !! NOTES
86 : : !!
87 : : !! SOURCE
88 : :
89 : 5756130 : SUBROUTINE Vector_init(this, size)
90 : :
91 : : !Arguments ------------------------------------
92 : : TYPE(Vector) , INTENT(INOUT) :: this
93 : : INTEGER, OPTIONAL, INTENT(IN ) :: size
94 : : !Local variables ------------------------------
95 : : INTEGER :: size_val
96 : :
97 : 5756130 : size_val = Global_SIZE
98 [ + - ]: 5756130 : IF ( PRESENT(size) ) size_val = size
99 : 5756130 : this%size = size_val
100 [ - + ]: 5756130 : FREEIF(this%vec)
101 [ + + + - : 17268390 : MALLOC(this%vec,(1:size_val))
+ - + + -
+ - + -
+ ]
102 : 5756130 : this%tail = 0
103 [ + + ]: 30679270 : this%vec = 0.d0
104 : 5756130 : END SUBROUTINE Vector_init
105 : : !!***
106 : :
107 : : !!****f* ABINIT/m_Vector/Vector_setSize
108 : : !! NAME
109 : : !! Vector_setSize
110 : : !!
111 : : !! FUNCTION
112 : : !! impose size
113 : : !!
114 : : !! COPYRIGHT
115 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
116 : : !! This file is distributed under the terms of the
117 : : !! GNU General Public License, see ~abinit/COPYING
118 : : !! or http://www.gnu.org/copyleft/gpl.txt .
119 : : !!
120 : : !! INPUTS
121 : : !! this=vector
122 : : !! new_tail=new_size
123 : : !!
124 : : !! OUTPUT
125 : : !!
126 : : !! SIDE EFFECTS
127 : : !!
128 : : !! NOTES
129 : : !!
130 : : !! SOURCE
131 : :
132 : 144 : SUBROUTINE Vector_setSize(this,new_tail)
133 : :
134 : : !Arguments ------------------------------------
135 : : TYPE(Vector), INTENT(INOUT) :: this
136 : : INTEGER , INTENT(IN ) :: new_tail
137 : : !Local variables ------------------------------
138 : : INTEGER :: size
139 : :
140 [ - + ]: 144 : IF ( .NOT. ALLOCATED(this%vec) ) THEN
141 : 0 : CALL Vector_init(this,new_tail)
142 : : ELSE
143 : 144 : size = this%size
144 [ + + ]: 144 : IF( new_tail .GT. size ) THEN
145 : 48 : CALL Vector_enlarge(this,MAX(Global_SIZE,new_tail-size))
146 : : END IF
147 : : END IF
148 : 144 : this%tail = new_tail
149 : 144 : END SUBROUTINE Vector_setSize
150 : : !!***
151 : :
152 : : !!****f* ABINIT/m_Vector/Vector_enlarge
153 : : !! NAME
154 : : !! Vector_enlarge
155 : : !!
156 : : !! FUNCTION
157 : : !! enlarge memory size
158 : : !!
159 : : !! COPYRIGHT
160 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
161 : : !! This file is distributed under the terms of the
162 : : !! GNU General Public License, see ~abinit/COPYING
163 : : !! or http://www.gnu.org/copyleft/gpl.txt .
164 : : !!
165 : : !! INPUTS
166 : : !! this=vector
167 : : !! size=memory size to add
168 : : !!
169 : : !! OUTPUT
170 : : !!
171 : : !! SIDE EFFECTS
172 : : !!
173 : : !! NOTES
174 : : !!
175 : : !! SOURCE
176 : :
177 : 48 : SUBROUTINE Vector_enlarge(this, size)
178 : :
179 : : !Arguments ------------------------------------
180 : : TYPE(Vector) , INTENT(INOUT) :: this
181 : : INTEGER , INTENT(IN ) :: size
182 : : !Local variables ------------------------------
183 : : INTEGER :: width
184 : : INTEGER :: tail
185 : 48 : DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: thistemp
186 : : INTEGER :: size_val
187 : :
188 [ + - ]: 48 : IF ( ALLOCATED(this%vec) ) THEN
189 : : FREEIF(thistemp)
190 : 48 : width = this%size
191 : 48 : tail = this%tail
192 : 48 : size_val = size
193 [ - + + - : 144 : MALLOC(thistemp,(1:tail))
+ - + - -
+ - + ]
194 [ + + ]: 60644 : thistemp(1:tail) = this%vec(1:tail)
195 : 48 : FREE(this%vec)
196 : 48 : this%size = width + size_val
197 [ - + + - : 144 : MALLOC(this%vec,(1:this%size))
+ - + - -
+ - + ]
198 [ + + ]: 60644 : this%vec(1:tail) = thistemp(1:tail)
199 [ - + ]: 48 : FREE(thistemp)
200 : : ELSE
201 : 0 : CALL Vector_init(this, Global_SIZE)
202 : : END IF
203 : 48 : END SUBROUTINE Vector_enlarge
204 : : !!***
205 : :
206 : : !!****f* ABINIT/m_Vector/Vector_pushBack
207 : : !! NAME
208 : : !! Vector_pushBack
209 : : !!
210 : : !! FUNCTION
211 : : !! push an element at the end
212 : : !!
213 : : !! COPYRIGHT
214 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
215 : : !! This file is distributed under the terms of the
216 : : !! GNU General Public License, see ~abinit/COPYING
217 : : !! or http://www.gnu.org/copyleft/gpl.txt .
218 : : !!
219 : : !! INPUTS
220 : : !! this=vector
221 : : !! value=value to add
222 : : !!
223 : : !! OUTPUT
224 : : !!
225 : : !! SIDE EFFECTS
226 : : !!
227 : : !! NOTES
228 : : !!
229 : : !! SOURCE
230 : :
231 : 219493 : SUBROUTINE Vector_pushBack(this, value)
232 : :
233 : : !Arguments ------------------------------------
234 : : TYPE(Vector) , INTENT(INOUT) :: this
235 : : DOUBLE PRECISION, INTENT(IN ) :: value
236 : : !Local variables ------------------------------
237 : : INTEGER :: tail
238 : :
239 [ - + ]: 219493 : IF ( this%size .EQ. 0 ) THEN
240 : 0 : CALL Vector_init(this, Global_SIZE)
241 : : END IF
242 : 219493 : tail = this%tail
243 : 219493 : tail = tail + 1
244 [ - + ]: 219493 : IF ( tail .GT. this%size ) THEN
245 : 0 : CALL Vector_enlarge(this,Global_SIZE)
246 : : END IF
247 : 219493 : this%vec(tail) = value
248 : 219493 : this%tail = tail
249 : 219493 : END SUBROUTINE Vector_pushBack
250 : : !!***
251 : :
252 : : !!****f* ABINIT/m_Vector/Vector_clear
253 : : !! NAME
254 : : !! Vector_clear
255 : : !!
256 : : !! FUNCTION
257 : : !! Clear vector
258 : : !!
259 : : !! COPYRIGHT
260 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
261 : : !! This file is distributed under the terms of the
262 : : !! GNU General Public License, see ~abinit/COPYING
263 : : !! or http://www.gnu.org/copyleft/gpl.txt .
264 : : !!
265 : : !! INPUTS
266 : : !! this=vector
267 : : !!
268 : : !! OUTPUT
269 : : !!
270 : : !! SIDE EFFECTS
271 : : !!
272 : : !! NOTES
273 : : !!
274 : : !! SOURCE
275 : :
276 : 416 : SUBROUTINE Vector_clear(this)
277 : :
278 : : !Arguments ------------------------------------
279 : : TYPE(Vector), INTENT(INOUT) :: this
280 : 416 : this%tail = 0
281 : 416 : END SUBROUTINE Vector_clear
282 : : !!***
283 : :
284 : : !!****f* ABINIT/m_Vector/Vector_print
285 : : !! NAME
286 : : !! Vector_print
287 : : !!
288 : : !! FUNCTION
289 : : !! print vector
290 : : !!
291 : : !! COPYRIGHT
292 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
293 : : !! This file is distributed under the terms of the
294 : : !! GNU General Public License, see ~abinit/COPYING
295 : : !! or http://www.gnu.org/copyleft/gpl.txt .
296 : : !!
297 : : !! INPUTS
298 : : !! this=vector
299 : : !! ostream=file stream
300 : : !!
301 : : !! OUTPUT
302 : : !!
303 : : !! SIDE EFFECTS
304 : : !!
305 : : !! NOTES
306 : : !!
307 : : !! SOURCE
308 : :
309 : 0 : SUBROUTINE Vector_print(this,ostream)
310 : :
311 : : !Arguments ------------------------------------
312 : : TYPE(Vector), INTENT(IN) :: this
313 : : INTEGER, OPTIONAL, INTENT(IN) :: ostream
314 : : !Local variables ------------------------------
315 : : INTEGER :: ostream_val
316 : : INTEGER :: it1
317 : : CHARACTER(LEN=4 ) :: size
318 : : CHARACTER(LEN=15) :: string
319 : :
320 : 0 : ostream_val = 6
321 [ # # ]: 0 : IF ( PRESENT(ostream) ) ostream_val = ostream
322 : 0 : WRITE(size,'(I4)') this%tail
323 : 0 : WRITE(ostream_val,'(A)') "("
324 : 0 : string ='(1x,1ES10.2)'
325 [ # # ]: 0 : DO it1 = 1, this%tail
326 : 0 : WRITE(ostream_val,string) this%vec(it1)
327 : : END DO
328 : 0 : WRITE(ostream_val,'(A)') ")"
329 : 0 : END SUBROUTINE Vector_print
330 : : !!***
331 : :
332 : : !!****f* ABINIT/m_Vector/Vector_destroy
333 : : !! NAME
334 : : !! Vector_destroy
335 : : !!
336 : : !! FUNCTION
337 : : !! Destroy vector
338 : : !!
339 : : !! COPYRIGHT
340 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
341 : : !! This file is distributed under the terms of the
342 : : !! GNU General Public License, see ~abinit/COPYING
343 : : !! or http://www.gnu.org/copyleft/gpl.txt .
344 : : !!
345 : : !! INPUTS
346 : : !! this=vector
347 : : !!
348 : : !! OUTPUT
349 : : !!
350 : : !! SIDE EFFECTS
351 : : !!
352 : : !! NOTES
353 : : !!
354 : : !! SOURCE
355 : :
356 : 5756130 : SUBROUTINE Vector_destroy(this)
357 : :
358 : : !Arguments ------------------------------------
359 : : TYPE(Vector), INTENT(INOUT) :: this
360 : :
361 [ + - ]: 5756130 : FREEIF(this%vec)
362 : :
363 : 5756130 : this%tail = 0
364 : 5756130 : this%size = 0
365 : 5756130 : END SUBROUTINE Vector_destroy
366 : : !!***
367 : :
368 [ # # # # : 0 : END MODULE m_Vector
# # # # #
# # # ]
369 : : !!***
370 : :
|
