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 5756114 : 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 5756114 : size_val = Global_SIZE
98 5756114 : IF ( PRESENT(size) ) size_val = size
99 5756114 : this%size = size_val
100 5756114 : FREEIF(this%vec)
101 17268342 : MALLOC(this%vec,(1:size_val))
102 5756114 : this%tail = 0
103 30657554 : this%vec = 0.d0
104 5756114 : 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 136 : 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 136 : IF ( .NOT. ALLOCATED(this%vec) ) THEN
141 0 : CALL Vector_init(this,new_tail)
142 : ELSE
143 136 : size = this%size
144 136 : IF( new_tail .GT. size ) THEN
145 40 : CALL Vector_enlarge(this,MAX(Global_SIZE,new_tail-size))
146 : END IF
147 : END IF
148 136 : this%tail = new_tail
149 136 : 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 40 : 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 40 : DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: thistemp
186 : INTEGER :: size_val
187 :
188 40 : IF ( ALLOCATED(this%vec) ) THEN
189 : FREEIF(thistemp)
190 40 : width = this%size
191 40 : tail = this%tail
192 40 : size_val = size
193 120 : MALLOC(thistemp,(1:tail))
194 50536 : thistemp(1:tail) = this%vec(1:tail)
195 40 : FREE(this%vec)
196 40 : this%size = width + size_val
197 120 : MALLOC(this%vec,(1:this%size))
198 50536 : this%vec(1:tail) = thistemp(1:tail)
199 40 : FREE(thistemp)
200 : ELSE
201 0 : CALL Vector_init(this, Global_SIZE)
202 : END IF
203 40 : 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 207373 : 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 207373 : IF ( this%size .EQ. 0 ) THEN
240 0 : CALL Vector_init(this, Global_SIZE)
241 : END IF
242 207373 : tail = this%tail
243 207373 : tail = tail + 1
244 207373 : IF ( tail .GT. this%size ) THEN
245 0 : CALL Vector_enlarge(this,Global_SIZE)
246 : END IF
247 207373 : this%vec(tail) = value
248 207373 : this%tail = tail
249 207373 : 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 392 : SUBROUTINE Vector_clear(this)
277 :
278 : !Arguments ------------------------------------
279 : TYPE(Vector), INTENT(INOUT) :: this
280 392 : this%tail = 0
281 392 : 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 5756114 : SUBROUTINE Vector_destroy(this)
357 :
358 : !Arguments ------------------------------------
359 : TYPE(Vector), INTENT(INOUT) :: this
360 :
361 5756114 : FREEIF(this%vec)
362 :
363 5756114 : this%tail = 0
364 5756114 : this%size = 0
365 5756114 : END SUBROUTINE Vector_destroy
366 : !!***
367 :
368 0 : END MODULE m_Vector
369 : !!***
370 :
|
