Line data Source code
1 :
2 : #if defined HAVE_CONFIG_H
3 : #include "config.h"
4 : #endif
5 : !!****m* ABINIT/m_MapHyb
6 : !! NAME
7 : !! m_MapHyb
8 : !!
9 : !! FUNCTION
10 : !! map template integer/double
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_MapHyb
24 : USE m_Global
25 : IMPLICIT NONE
26 :
27 : !!***
28 :
29 : PRIVATE
30 :
31 : !!****t* m_MapHyb/MapHyb
32 : !! NAME
33 : !! MapHyb
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 :: MapHyb
47 : INTEGER _PRIVATE :: size
48 : INTEGER :: tail
49 : INTEGER , ALLOCATABLE, DIMENSION(:) :: listINT
50 : DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: listDBLE
51 : END TYPE MapHyb
52 : !!***
53 :
54 : INTERFACE MapHyb_sort
55 : MODULE PROCEDURE MapHyb_quickSort, MapHyb_sort
56 : END INTERFACE
57 :
58 : !PUBLIC INTERFACE ASSIGNMENT(=)
59 : ! MODULE PROCEDURE MapHyb_assign
60 : !END INTERFACE
61 :
62 : PUBLIC :: MapHyb_init
63 : PUBLIC :: MapHyb_setSize
64 : PRIVATE :: MapHyb_enlarge
65 : PUBLIC :: MapHyb_assign
66 : PUBLIC :: MapHyb_sort
67 : PUBLIC :: MapHyb_quickSort
68 : PUBLIC :: MapHyb_print
69 : PUBLIC :: MapHyb_clear
70 : PUBLIC :: MapHyb_destroy
71 :
72 : CONTAINS
73 : !!***
74 :
75 : !!****f* ABINIT/m_MapHyb/MapHyb_init
76 : !! NAME
77 : !! MapHyb_init
78 : !!
79 : !! FUNCTION
80 : !! initialize
81 : !!
82 : !! COPYRIGHT
83 : !! Copyright (C) 2013-2026 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 1125 : SUBROUTINE MapHyb_init(this, size)
101 :
102 : !Arguments ------------------------------------
103 : TYPE(MapHyb) , INTENT(INOUT) :: this
104 : INTEGER, OPTIONAL, INTENT(IN ) :: size
105 : !Local variables ------------------------------
106 : INTEGER :: size_val
107 :
108 1125 : size_val = Global_SIZE
109 1125 : IF ( PRESENT(size) ) size_val = size
110 1125 : this%size = size_val
111 1125 : FREEIF(this%listINT)
112 3375 : MALLOC(this%listINT,(1:size_val))
113 1125 : FREEIF(this%listDBLE)
114 3375 : MALLOC(this%listDBLE,(1:size_val))
115 1125 : this%tail = 0
116 1125 : END SUBROUTINE MapHyb_init
117 : !!***
118 :
119 : !!****f* ABINIT/m_MapHyb/MapHyb_setSize
120 : !! NAME
121 : !! MapHyb_setSize
122 : !!
123 : !! FUNCTION
124 : !! impose size of the this
125 : !!
126 : !! COPYRIGHT
127 : !! Copyright (C) 2013-2026 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 158970444 : SUBROUTINE MapHyb_setSize(this,new_tail)
145 :
146 : !Arguments ------------------------------------
147 : TYPE(MapHyb), INTENT(INOUT) :: this
148 : INTEGER , INTENT(IN ) :: new_tail
149 : !Local variables ------------------------------
150 : INTEGER :: size
151 :
152 158970444 : IF ( .NOT. ALLOCATED(this%listINT) ) THEN
153 0 : CALL MapHyb_init(this)
154 : END IF
155 158970444 : size = this%size
156 158970444 : IF( new_tail .GT. size ) THEN
157 0 : CALL MapHyb_enlarge(this, MAX(new_tail-size,Global_SIZE))
158 : END IF
159 158970444 : this%tail = new_tail
160 158970444 : END SUBROUTINE MapHyb_setSize
161 : !!***
162 :
163 : !!****f* ABINIT/m_MapHyb/MapHyb_enlarge
164 : !! NAME
165 : !! MapHyb_enlarge
166 : !!
167 : !! FUNCTION
168 : !! enlarge memory space
169 : !!
170 : !! COPYRIGHT
171 : !! Copyright (C) 2013-2026 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 MapHyb_enlarge(this, size)
189 :
190 : !Arguments ------------------------------------
191 : TYPE(MapHyb) , 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 : DOUBLE PRECISION, 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 MapHyb_init(this, Global_SIZE)
223 : END IF
224 0 : END SUBROUTINE MapHyb_enlarge
225 : !!***
226 :
227 : !!****f* ABINIT/m_MapHyb/MapHyb_assign
228 : !! NAME
229 : !! MapHyb_assign
230 : !!
231 : !! FUNCTION
232 : !! assign this=map
233 : !!
234 : !! COPYRIGHT
235 : !! Copyright (C) 2013-2026 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 MapHyb_assign(this, map)
253 :
254 : !Arguments ------------------------------------
255 : TYPE(MapHyb), INTENT(INOUT) :: this
256 : TYPE(MapHyb), INTENT(IN ) :: map
257 : !Local variables ------------------------------
258 : INTEGER :: tail
259 :
260 0 : tail = map%tail
261 0 : CALL MapHyb_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 MapHyb_assign
266 : !!***
267 :
268 : !!****f* ABINIT/m_MapHyb/MapHyb_sort
269 : !! NAME
270 : !! MapHyb_sort
271 : !!
272 : !! FUNCTION
273 : !! sort the this with respect to the integer array
274 : !!
275 : !! COPYRIGHT
276 : !! Copyright (C) 2013-2026 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 MapHyb_sort(this)
293 :
294 : !Arguments ------------------------------------
295 : TYPE(MapHyb), INTENT(INOUT) :: this
296 :
297 0 : IF ( this%tail .EQ. 1 ) RETURN
298 0 : CALL MapHyb_quickSort(this, 1, this%tail)
299 : END SUBROUTINE MapHyb_sort
300 : !!***
301 :
302 : !!****f* ABINIT/m_MapHyb/MapHyb_quickSort
303 : !! NAME
304 : !! MapHyb_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-2026 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 MapHyb_quickSort(this, begin, end)
330 :
331 : !Arguments ------------------------------------
332 : TYPE(MapHyb), 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 : DOUBLE PRECISION :: 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 MapHyb_quickSort(this,begin,it2)
365 : END IF
366 : !!it2= it1+1
367 0 : IF ( it1 < end ) THEN
368 0 : CALL MapHyb_quickSort(this,it1,end)
369 : END IF
370 :
371 0 : END SUBROUTINE MapHyb_quickSort
372 : !!***
373 :
374 : !!****f* ABINIT/m_MapHyb/MapHyb_print
375 : !! NAME
376 : !! MapHyb_print
377 : !!
378 : !! FUNCTION
379 : !! print the this
380 : !!
381 : !! COPYRIGHT
382 : !! Copyright (C) 2013-2026 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 MapHyb_print(this,ostream)
400 :
401 : !Arguments ------------------------------------
402 : TYPE(MapHyb) , 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 MapHyb_print
415 : !!***
416 :
417 : !!****f* ABINIT/m_MapHyb/MapHyb_clear
418 : !! NAME
419 : !! MapHyb_clear
420 : !!
421 : !! FUNCTION
422 : !! Clear the this
423 : !!
424 : !! COPYRIGHT
425 : !! Copyright (C) 2013-2026 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 1554 : SUBROUTINE MapHyb_clear(this)
442 :
443 : !Arguments ------------------------------------
444 : TYPE(MapHyb), INTENT(INOUT) :: this
445 1554 : this%tail = 0
446 1554 : END SUBROUTINE MapHyb_clear
447 : !!***
448 :
449 : !!****f* ABINIT/m_MapHyb/MapHyb_destroy
450 : !! NAME
451 : !! MapHyb_destroy
452 : !!
453 : !! FUNCTION
454 : !! destroy and deallocate the this
455 : !!
456 : !! COPYRIGHT
457 : !! Copyright (C) 2013-2026 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 1125 : SUBROUTINE MapHyb_destroy(this)
474 :
475 : !Arguments ------------------------------------
476 : TYPE(MapHyb), INTENT(INOUT) :: this
477 :
478 1125 : FREEIF(this%listINT)
479 1125 : FREEIF(this%listDBLE)
480 :
481 1125 : this%tail = 0
482 1125 : this%size = 0
483 1125 : END SUBROUTINE MapHyb_destroy
484 : !!***
485 :
486 0 : END MODULE m_MapHyb
487 : !!***
488 :
489 :
|
