Branch data Line data Source code
1 : :
2 : : #if defined HAVE_CONFIG_H
3 : : #include "config.h"
4 : : #endif
5 : : !!****m* ABINIT/m_MapHybComplex
6 : : !! NAME
7 : : !! m_MapHybComplex
8 : : !!
9 : : !! FUNCTION
10 : : !! map template integer/double
11 : : !!
12 : : !! COPYRIGHT
13 : : !! Copyright (C) 2013-2025 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_MapHybComplex
24 : : USE m_Global
25 : : IMPLICIT NONE
26 : :
27 : : !!***
28 : :
29 : : PRIVATE
30 : :
31 : : !!****t* m_MapHybComplex/MapHybComplex
32 : : !! NAME
33 : : !! MapHybComplex
34 : : !!
35 : : !! FUNCTION
36 : : !! This structured datatype contains the necessary data
37 : : !!
38 : : !! COPYRIGHT
39 : : !! Copyright (C) 2013-2025 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 :: MapHybComplex
47 : : INTEGER, PRIVATE :: size
48 : : INTEGER :: tail
49 : : INTEGER , ALLOCATABLE, DIMENSION(:) :: listINT
50 : : COMPLEX(KIND=8), ALLOCATABLE, DIMENSION(:) :: listDBLE
51 : : END TYPE MapHybComplex
52 : : !!***
53 : :
54 : : INTERFACE MapHybComplex_sort
55 : : MODULE PROCEDURE MapHybComplex_quickSort, MapHybComplex_sort
56 : : END INTERFACE
57 : :
58 : : !PUBLIC INTERFACE ASSIGNMENT(=)
59 : : ! MODULE PROCEDURE MapHybComplex_assign
60 : : !END INTERFACE
61 : :
62 : : PUBLIC :: MapHybComplex_init
63 : : PUBLIC :: MapHybComplex_setSize
64 : : PRIVATE :: MapHybComplex_enlarge
65 : : PUBLIC :: MapHybComplex_assign
66 : : PUBLIC :: MapHybComplex_sort
67 : : PUBLIC :: MapHybComplex_quickSort
68 : : PUBLIC :: MapHybComplex_print
69 : : PUBLIC :: MapHybComplex_clear
70 : : PUBLIC :: MapHybComplex_destroy
71 : :
72 : : CONTAINS
73 : : !!***
74 : :
75 : : !!****f* ABINIT/m_MapHybComplex/MapHybComplex_init
76 : : !! NAME
77 : : !! MapHybComplex_init
78 : : !!
79 : : !! FUNCTION
80 : : !! initialize
81 : : !!
82 : : !! COPYRIGHT
83 : : !! Copyright (C) 2013-2025 ABINIT group (J. Bieder)
84 : : !! This file is distributed under the terms of the
85 : : !! GNU General Public License, see ~abinit/COPYING
86 : : !! or http://www.gnu.org/copyleft/gpl.txt .
87 : : !!
88 : : !! INPUTS
89 : : !! this=Map
90 : : !! size=memory size for initialization
91 : : !!
92 : : !! OUTPUT
93 : : !!
94 : : !! SIDE EFFECTS
95 : : !!
96 : : !! NOTES
97 : : !!
98 : : !! SOURCE
99 : :
100 : 0 : SUBROUTINE MapHybComplex_init(this, size)
101 : :
102 : : !Arguments ------------------------------------
103 : : TYPE(MapHybComplex) , INTENT(INOUT) :: this
104 : : INTEGER, OPTIONAL, INTENT(IN ) :: size
105 : : !Local variables ------------------------------
106 : : INTEGER :: size_val
107 : :
108 : 0 : size_val = Global_SIZE
109 [ # # ]: 0 : IF ( PRESENT(size) ) size_val = size
110 : 0 : this%size = size_val
111 [ # # ]: 0 : FREEIF(this%listINT)
112 [ # # # # : 0 : MALLOC(this%listINT,(1:size_val))
# # # # #
# # # #
# ]
113 [ # # ]: 0 : FREEIF(this%listDBLE)
114 [ # # # # : 0 : MALLOC(this%listDBLE,(1:size_val))
# # # # #
# # # #
# ]
115 : 0 : this%tail = 0
116 : 0 : END SUBROUTINE MapHybComplex_init
117 : : !!***
118 : :
119 : : !!****f* ABINIT/m_MapHybComplex/MapHybComplex_setSize
120 : : !! NAME
121 : : !! MapHybComplex_setSize
122 : : !!
123 : : !! FUNCTION
124 : : !! impose size of the this
125 : : !!
126 : : !! COPYRIGHT
127 : : !! Copyright (C) 2013-2025 ABINIT group (J. Bieder)
128 : : !! This file is distributed under the terms of the
129 : : !! GNU General Public License, see ~abinit/COPYING
130 : : !! or http://www.gnu.org/copyleft/gpl.txt .
131 : : !!
132 : : !! INPUTS
133 : : !! this=Map
134 : : !! new_tail=new size
135 : : !!
136 : : !! OUTPUT
137 : : !!
138 : : !! SIDE EFFECTS
139 : : !!
140 : : !! NOTES
141 : : !!
142 : : !! SOURCE
143 : :
144 : 0 : SUBROUTINE MapHybComplex_setSize(this,new_tail)
145 : :
146 : : !Arguments ------------------------------------
147 : : TYPE(MapHybComplex), INTENT(INOUT) :: this
148 : : INTEGER , INTENT(IN ) :: new_tail
149 : : !Local variables ------------------------------
150 : : INTEGER :: size
151 : :
152 [ # # ]: 0 : IF ( .NOT. ALLOCATED(this%listINT) ) THEN
153 : 0 : CALL MapHybComplex_init(this)
154 : : END IF
155 : 0 : size = this%size
156 [ # # ]: 0 : IF( new_tail .GT. size ) THEN
157 : 0 : CALL MapHybComplex_enlarge(this, MAX(new_tail-size,Global_SIZE))
158 : : END IF
159 : 0 : this%tail = new_tail
160 : 0 : END SUBROUTINE MapHybComplex_setSize
161 : : !!***
162 : :
163 : : !!****f* ABINIT/m_MapHybComplex/MapHybComplex_enlarge
164 : : !! NAME
165 : : !! MapHybComplex_enlarge
166 : : !!
167 : : !! FUNCTION
168 : : !! enlarge memory space
169 : : !!
170 : : !! COPYRIGHT
171 : : !! Copyright (C) 2013-2025 ABINIT group (J. Bieder)
172 : : !! This file is distributed under the terms of the
173 : : !! GNU General Public License, see ~abinit/COPYING
174 : : !! or http://www.gnu.org/copyleft/gpl.txt .
175 : : !!
176 : : !! INPUTS
177 : : !! this=Map
178 : : !! size=new memory size
179 : : !!
180 : : !! OUTPUT
181 : : !!
182 : : !! SIDE EFFECTS
183 : : !!
184 : : !! NOTES
185 : : !!
186 : : !! SOURCE
187 : :
188 : 0 : SUBROUTINE MapHybComplex_enlarge(this, size)
189 : :
190 : : !Arguments ------------------------------------
191 : : TYPE(MapHybComplex) , INTENT(INOUT) :: this
192 : : INTEGER, OPTIONAL, INTENT(IN ) :: size
193 : : !Local variables ------------------------------
194 : : INTEGER :: width
195 : : INTEGER :: tail
196 : : INTEGER :: size_val
197 : 0 : INTEGER , ALLOCATABLE, DIMENSION(:) :: listINT_temp
198 : 0 : COMPLEX(KIND=8), ALLOCATABLE, DIMENSION(:) :: listDBLE_temp
199 : :
200 [ # # ]: 0 : IF ( ALLOCATED(this%listINT) ) THEN
201 : : FREEIF(listINT_temp)
202 : 0 : width = this%size
203 : 0 : tail = this%tail
204 : 0 : size_val = width
205 [ # # ]: 0 : IF ( PRESENT(size) ) size_val = size
206 : : ! listINT enlarge
207 [ # # # # : 0 : MALLOC(listINT_temp,(1:tail))
# # # # #
# # # ]
208 [ # # ]: 0 : listINT_temp(1:tail) = this%listINT(1:tail)
209 : 0 : FREE(this%listINT)
210 : 0 : this%size = width + size_val
211 [ # # # # : 0 : MALLOC(this%listINT,(1:this%size))
# # # # #
# # # ]
212 [ # # ]: 0 : this%listINT(1:tail) = listINT_temp(1:tail)
213 [ # # ]: 0 : FREE(listINT_temp)
214 : : ! listDBLE enlarge
215 [ # # # # : 0 : MALLOC(listDBLE_temp,(1:tail))
# # # # #
# # # ]
216 [ # # ]: 0 : listDBLE_temp(1:tail) = this%listDBLE(1:tail)
217 [ # # ]: 0 : FREE(this%listDBLE)
218 [ # # # # : 0 : MALLOC(this%listDBLE,(1:this%size))
# # # # #
# # # ]
219 [ # # ]: 0 : this%listDBLE(1:tail) = listDBLE_temp(1:tail)
220 [ # # ]: 0 : FREE(listDBLE_temp)
221 : : ELSE
222 : 0 : CALL MapHybComplex_init(this, Global_SIZE)
223 : : END IF
224 : 0 : END SUBROUTINE MapHybComplex_enlarge
225 : : !!***
226 : :
227 : : !!****f* ABINIT/m_MapHybComplex/MapHybComplex_assign
228 : : !! NAME
229 : : !! MapHybComplex_assign
230 : : !!
231 : : !! FUNCTION
232 : : !! assign this=map
233 : : !!
234 : : !! COPYRIGHT
235 : : !! Copyright (C) 2013-2025 ABINIT group (J. Bieder)
236 : : !! This file is distributed under the terms of the
237 : : !! GNU General Public License, see ~abinit/COPYING
238 : : !! or http://www.gnu.org/copyleft/gpl.txt .
239 : : !!
240 : : !! INPUTS
241 : : !! this=this
242 : : !! this=Map
243 : : !!
244 : : !! OUTPUT
245 : : !!
246 : : !! SIDE EFFECTS
247 : : !!
248 : : !! NOTES
249 : : !!
250 : : !! SOURCE
251 : :
252 : 0 : SUBROUTINE MapHybComplex_assign(this, map)
253 : :
254 : : !Arguments ------------------------------------
255 : : TYPE(MapHybComplex), INTENT(INOUT) :: this
256 : : TYPE(MapHybComplex), INTENT(IN ) :: map
257 : : !Local variables ------------------------------
258 : : INTEGER :: tail
259 : :
260 : 0 : tail = map%tail
261 : 0 : CALL MapHybComplex_setSize(this, tail)
262 [ # # ]: 0 : this%listINT(1:tail) = map%listINT(1:tail)
263 [ # # ]: 0 : this%listDBLE(1:tail) = map%listDBLE(1:tail)
264 : :
265 : 0 : END SUBROUTINE MapHybComplex_assign
266 : : !!***
267 : :
268 : : !!****f* ABINIT/m_MapHybComplex/MapHybComplex_sort
269 : : !! NAME
270 : : !! MapHybComplex_sort
271 : : !!
272 : : !! FUNCTION
273 : : !! sort the this with respect to the integer array
274 : : !!
275 : : !! COPYRIGHT
276 : : !! Copyright (C) 2013-2025 ABINIT group (J. Bieder)
277 : : !! This file is distributed under the terms of the
278 : : !! GNU General Public License, see ~abinit/COPYING
279 : : !! or http://www.gnu.org/copyleft/gpl.txt .
280 : : !!
281 : : !! INPUTS
282 : : !! this=Map
283 : : !!
284 : : !! OUTPUT
285 : : !!
286 : : !! SIDE EFFECTS
287 : : !!
288 : : !! NOTES
289 : : !!
290 : : !! SOURCE
291 : :
292 : 0 : SUBROUTINE MapHybComplex_sort(this)
293 : :
294 : : !Arguments ------------------------------------
295 : : TYPE(MapHybComplex), INTENT(INOUT) :: this
296 : :
297 [ # # ]: 0 : IF ( this%tail .EQ. 1 ) RETURN
298 : 0 : CALL MapHybComplex_quickSort(this, 1, this%tail)
299 : : END SUBROUTINE MapHybComplex_sort
300 : : !!***
301 : :
302 : : !!****f* ABINIT/m_MapHybComplex/MapHybComplex_quickSort
303 : : !! NAME
304 : : !! MapHybComplex_quickSort
305 : : !!
306 : : !! FUNCTION
307 : : !! sort the this with respect to the integer array
308 : : !! with the quickSort algo
309 : : !!
310 : : !! COPYRIGHT
311 : : !! Copyright (C) 2013-2025 ABINIT group (J. Bieder)
312 : : !! This file is distributed under the terms of the
313 : : !! GNU General Public License, see ~abinit/COPYING
314 : : !! or http://www.gnu.org/copyleft/gpl.txt .
315 : : !!
316 : : !! INPUTS
317 : : !! this=Map
318 : : !! begin=first element to consider
319 : : !! end=last element to consider
320 : : !!
321 : : !! OUTPUT
322 : : !!
323 : : !! SIDE EFFECTS
324 : : !!
325 : : !! NOTES
326 : : !!
327 : : !! SOURCE
328 : :
329 : 0 : RECURSIVE SUBROUTINE MapHybComplex_quickSort(this, begin, end)
330 : :
331 : : !Arguments ------------------------------------
332 : : TYPE(MapHybComplex), INTENT(INOUT) :: this
333 : : INTEGER , INTENT(IN ) :: begin
334 : : INTEGER , INTENT(IN ) :: end
335 : : !Local variables ------------------------------
336 : : INTEGER :: it1
337 : : INTEGER :: it2
338 : : INTEGER :: pivot
339 : : INTEGER :: Iswap
340 : : COMPLEX(KIND=8) :: Dswap
341 : :
342 : 0 : pivot = this%listINT((end-begin)/2 + begin) ! not the betterchoice.... FIXME
343 : 0 : it1 = begin
344 : 0 : it2 = end
345 [ # # ]: 0 : DO WHILE (it1 .LE. it2)
346 [ # # ]: 0 : DO WHILE ( this%listINT(it1) .LT. pivot )
347 : 0 : it1 = it1 + 1
348 : : END DO
349 [ # # ]: 0 : DO WHILE ( this%listINT(it2) .GT. pivot )
350 : 0 : it2 = it2 - 1
351 : : END DO
352 [ # # ]: 0 : IF ( it1 .LE. it2) THEN
353 : 0 : Iswap = this%listINT(it1)
354 : 0 : Dswap = this%listDBLE(it1)
355 : 0 : this%listINT(it1) = this%listINT(it2)
356 : 0 : this%listDBLE(it1) = this%listDBLE(it2)
357 : 0 : this%listINT(it2) = Iswap
358 : 0 : this%listDBLE(it2) = Dswap
359 : 0 : it1 = it1 + 1
360 : 0 : it2 = it2 - 1
361 : : END IF
362 : : END DO
363 [ # # ]: 0 : IF ( begin < it2 ) THEN
364 : 0 : CALL MapHybComplex_quickSort(this,begin,it2)
365 : : END IF
366 : : !!it2= it1+1
367 [ # # ]: 0 : IF ( it1 < end ) THEN
368 : 0 : CALL MapHybComplex_quickSort(this,it1,end)
369 : : END IF
370 : :
371 : 0 : END SUBROUTINE MapHybComplex_quickSort
372 : : !!***
373 : :
374 : : !!****f* ABINIT/m_MapHybComplex/MapHybComplex_print
375 : : !! NAME
376 : : !! MapHybComplex_print
377 : : !!
378 : : !! FUNCTION
379 : : !! print the this
380 : : !!
381 : : !! COPYRIGHT
382 : : !! Copyright (C) 2013-2025 ABINIT group (J. Bieder)
383 : : !! This file is distributed under the terms of the
384 : : !! GNU General Public License, see ~abinit/COPYING
385 : : !! or http://www.gnu.org/copyleft/gpl.txt .
386 : : !!
387 : : !! INPUTS
388 : : !! this=Map
389 : : !! ostream=file stream
390 : : !!
391 : : !! OUTPUT
392 : : !!
393 : : !! SIDE EFFECTS
394 : : !!
395 : : !! NOTES
396 : : !!
397 : : !! SOURCE
398 : :
399 : 0 : SUBROUTINE MapHybComplex_print(this,ostream)
400 : :
401 : : !Arguments ------------------------------------
402 : : TYPE(MapHybComplex) , INTENT(IN) :: this
403 : : INTEGER, OPTIONAL, INTENT(IN) :: ostream
404 : : !Local variables ------------------------------
405 : : INTEGER :: ostream_val
406 : : INTEGER :: it
407 : :
408 : 0 : ostream_val = 6
409 [ # # ]: 0 : IF ( PRESENT(ostream) ) ostream_val = ostream
410 : 0 : WRITE(ostream_val,'(A,2x,A5,2x,A5)') "#","Index", "Value"
411 [ # # ]: 0 : DO it = 1, this%tail
412 : 0 : WRITE(ostream_val,'(3x,I5,2x,ES22.14)') this%listINT(it), this%listDBLE(it)
413 : : END DO
414 : 0 : END SUBROUTINE MapHybComplex_print
415 : : !!***
416 : :
417 : : !!****f* ABINIT/m_MapHybComplex/MapHybComplex_clear
418 : : !! NAME
419 : : !! MapHybComplex_clear
420 : : !!
421 : : !! FUNCTION
422 : : !! Clear the this
423 : : !!
424 : : !! COPYRIGHT
425 : : !! Copyright (C) 2013-2025 ABINIT group (J. Bieder)
426 : : !! This file is distributed under the terms of the
427 : : !! GNU General Public License, see ~abinit/COPYING
428 : : !! or http://www.gnu.org/copyleft/gpl.txt .
429 : : !!
430 : : !! INPUTS
431 : : !! this=Map
432 : : !!
433 : : !! OUTPUT
434 : : !!
435 : : !! SIDE EFFECTS
436 : : !!
437 : : !! NOTES
438 : : !!
439 : : !! SOURCE
440 : :
441 : 0 : SUBROUTINE MapHybComplex_clear(this)
442 : :
443 : : !Arguments ------------------------------------
444 : : TYPE(MapHybComplex), INTENT(INOUT) :: this
445 : 0 : this%tail = 0
446 : 0 : END SUBROUTINE MapHybComplex_clear
447 : : !!***
448 : :
449 : : !!****f* ABINIT/m_MapHybComplex/MapHybComplex_destroy
450 : : !! NAME
451 : : !! MapHybComplex_destroy
452 : : !!
453 : : !! FUNCTION
454 : : !! destroy and deallocate the this
455 : : !!
456 : : !! COPYRIGHT
457 : : !! Copyright (C) 2013-2025 ABINIT group (J. Bieder)
458 : : !! This file is distributed under the terms of the
459 : : !! GNU General Public License, see ~abinit/COPYING
460 : : !! or http://www.gnu.org/copyleft/gpl.txt .
461 : : !!
462 : : !! INPUTS
463 : : !! this=Map
464 : : !!
465 : : !! OUTPUT
466 : : !!
467 : : !! SIDE EFFECTS
468 : : !!
469 : : !! NOTES
470 : : !!
471 : : !! SOURCE
472 : :
473 : 0 : SUBROUTINE MapHybComplex_destroy(this)
474 : :
475 : : !Arguments ------------------------------------
476 : : TYPE(MapHybComplex), INTENT(INOUT) :: this
477 : :
478 [ # # ]: 0 : FREEIF(this%listINT)
479 [ # # ]: 0 : FREEIF(this%listDBLE)
480 : :
481 : 0 : this%tail = 0
482 : 0 : this%size = 0
483 : 0 : END SUBROUTINE MapHybComplex_destroy
484 : : !!***
485 : :
486 [ # # # # : 0 : END MODULE m_MapHybComplex
# # # # #
# # # #
# ]
487 : : !!***
|
