Branch data Line data Source code
1 : :
2 : : #if defined HAVE_CONFIG_H
3 : : #include "config.h"
4 : : #endif
5 : : !!****m* ABINIT/m_ListCdagC
6 : : !! NAME
7 : : !! m_ListCdagC
8 : : !!
9 : : !! FUNCTION
10 : : !! Manage a 2D vector to store couple of c+c
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_ListCdagC
24 : : USE m_Global
25 : :
26 : : IMPLICIT NONE
27 : :
28 : : !!***
29 : :
30 : : PRIVATE
31 : :
32 : : !!****t* m_ListCdagC/ListCdagC
33 : : !! NAME
34 : : !! ListCdagC
35 : : !!
36 : : !! FUNCTION
37 : : !! This structured datatype contains the necessary data
38 : : !!
39 : : !! COPYRIGHT
40 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
41 : : !! This file is distributed under the terms of the
42 : : !! GNU General Public License, see ~abinit/COPYING
43 : : !! or http://www.gnu.org/copyleft/gpl.txt .
44 : : !!
45 : : !! SOURCE
46 : :
47 : : TYPE, PUBLIC :: ListCdagC
48 : : INTEGER, PRIVATE :: size = 0
49 : : ! max size of matrix list
50 : :
51 : : INTEGER :: tail = 0
52 : : ! the size of matrix list that contains physical data (ie number of
53 : : ! segment)
54 : : !DOUBLE PRECISION :: inv_dt = 0.d0
55 : : ! TYPE(CdagC), ALLOCATABLE, DIMENSION(:) :: list => NULL()
56 : : !INTEGER , ALLOCATABLE, DIMENSION(:,:) :: ind
57 : : DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: list
58 : : ! for all elements i below itail, list(i,1:2) are times for creation
59 : : ! and destruction of particles.
60 : : END TYPE ListcdagC
61 : : !!***
62 : :
63 : : INTERFACE ListCdagC_firstHigher
64 : : MODULE PROCEDURE ListCdagC_firstHigherThanReal
65 : : END INTERFACE
66 : :
67 : : INTERFACE ListCdagC_sort
68 : : MODULE PROCEDURE ListCdagC_quickSort, ListCdagC_sort
69 : : END INTERFACE
70 : :
71 : : !INTERFACE ASSIGNMENT(=)
72 : : ! MODULE PROCEDURE ListCdagC_assign
73 : : !END INTERFACE
74 : :
75 : : PUBLIC :: ListCdagC_init
76 : : PUBLIC :: ListCdagC_setSize
77 : : PRIVATE :: ListCdagC_enlarge
78 : : PUBLIC :: listCdagC_assign
79 : : PUBLIC :: ListCdagC_swap
80 : : PUBLIC :: ListCdagC_pushBack
81 : : PUBLIC :: ListCdagC_insert
82 : : PUBLIC :: ListCdagC_popBack
83 : : PUBLIC :: ListCdagC_erase
84 : : PUBLIC :: ListCdagC_firstHigher
85 : : PUBLIC :: ListCdagC_sort
86 : : PUBLIC :: ListCdagC_quickSort
87 : : PUBLIC :: ListCdagC_print
88 : : PUBLIC :: ListCdagC_clear
89 : : PUBLIC :: ListCdagC_destroy
90 : :
91 : : CONTAINS
92 : : !!***
93 : :
94 : : !SUBROUTINE ListCdagC_init(this, inv_dt, size)
95 : : !!****f* ABINIT/m_ListCdagC/ListCdagC_init
96 : : !! NAME
97 : : !! ListCdagC_init
98 : : !!
99 : : !! FUNCTION
100 : : !! initialize
101 : : !!
102 : : !! COPYRIGHT
103 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
104 : : !! This file is distributed under the terms of the
105 : : !! GNU General Public License, see ~abinit/COPYING
106 : : !! or http://www.gnu.org/copyleft/gpl.txt .
107 : : !!
108 : : !! INPUTS
109 : : !! list_1=ListCdagC
110 : : !! size=size of initialization
111 : : !!
112 : : !! OUTPUT
113 : : !!
114 : : !! SIDE EFFECTS
115 : : !!
116 : : !! NOTES
117 : : !!
118 : : !! SOURCE
119 : :
120 : 1097 : SUBROUTINE ListCdagC_init(this, size)
121 : :
122 : : !Arguments ------------------------------------
123 : : TYPE(ListCdagC) , INTENT(INOUT) :: this
124 : : !DOUBLE PRECISION , INTENT(IN ) :: inv_dt
125 : : INTEGER, OPTIONAL, INTENT(IN ) :: size
126 : : !Local variables ------------------------------
127 : : INTEGER :: size_val
128 : :
129 : 1097 : size_val = Global_SIZE
130 : : !this%inv_dt = inv_dt
131 [ + + ]: 1097 : IF ( PRESENT(size) ) size_val = size
132 : 1097 : this%size = size_val
133 [ - + ]: 1097 : FREEIF(this%list)
134 [ - + + - : 4388 : MALLOC(this%list,(0:size_val,1:2))
+ - + - +
- - + - +
- + ]
135 : : !FAKEFREEIF(this%ind)
136 : : !FAKEMALLOC(this%ind,(0:size_val,1:2))
137 : 1097 : this%tail = 0
138 : 1097 : END SUBROUTINE ListCdagC_init
139 : : !!***
140 : :
141 : : !!****f* ABINIT/m_ListCdagC/ListCdagC_setSize
142 : : !! NAME
143 : : !! ListCdagC_setSize
144 : : !!
145 : : !! FUNCTION
146 : : !! Impose size of the list
147 : : !!
148 : : !! COPYRIGHT
149 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
150 : : !! This file is distributed under the terms of the
151 : : !! GNU General Public License, see ~abinit/COPYING
152 : : !! or http://www.gnu.org/copyleft/gpl.txt .
153 : : !!
154 : : !! INPUTS
155 : : !! list_1=ListCdagC
156 : : !! new_tail=new_size
157 : : !!
158 : : !! OUTPUT
159 : : !!
160 : : !! SIDE EFFECTS
161 : : !!
162 : : !! NOTES
163 : : !!
164 : : !! SOURCE
165 : :
166 : 95797 : SUBROUTINE ListCdagC_setSize(this,new_tail)
167 : :
168 : : !Arguments ------------------------------------
169 : : TYPE(ListCdagC), INTENT(INOUT) :: this
170 : : INTEGER , INTENT(IN ) :: new_tail
171 : : !Local variables ------------------------------
172 : : INTEGER :: size
173 : :
174 : : !IF ( .NOT. ALLOCATED(this%list) ) THEN
175 : : ! CALL ListCdagC_init(this, this%inv_dt)
176 : : !END IF
177 [ + + ]: 95797 : IF ( .NOT. ALLOCATED(this%list) ) THEN
178 : 21 : CALL ListCdagC_init(this)
179 : : END IF
180 : 95797 : size = this%size
181 [ - + ]: 95797 : IF( new_tail .GT. size ) THEN
182 : 0 : CALL ListCdagC_enlarge(this,MAX(Global_SIZE, new_tail-size))
183 : : END IF
184 : 95797 : this%tail = new_tail
185 : 95797 : END SUBROUTINE ListCdagC_setSize
186 : : !!***
187 : :
188 : : !!****f* ABINIT/m_ListCdagC/ListCdagC_enlarge
189 : : !! NAME
190 : : !! ListCdagC_enlarge
191 : : !!
192 : : !! FUNCTION
193 : : !! Enlarge memory space of the list
194 : : !!
195 : : !! COPYRIGHT
196 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
197 : : !! This file is distributed under the terms of the
198 : : !! GNU General Public License, see ~abinit/COPYING
199 : : !! or http://www.gnu.org/copyleft/gpl.txt .
200 : : !!
201 : : !! INPUTS
202 : : !! list_1=ListCdagC
203 : : !! size=new memory size
204 : : !!
205 : : !! OUTPUT
206 : : !!
207 : : !! SIDE EFFECTS
208 : : !!
209 : : !! NOTES
210 : : !!
211 : : !! SOURCE
212 : :
213 : 0 : SUBROUTINE ListCdagC_enlarge(this, size)
214 : :
215 : : !Arguments ------------------------------------
216 : : TYPE(ListCdagC), INTENT(INOUT) :: this
217 : : INTEGER, OPTIONAL, INTENT(IN ) :: size
218 : : !Local variables ------------------------------
219 : : INTEGER :: width
220 : : INTEGER :: tail
221 : : INTEGER :: size_val
222 : : !INTEGER , ALLOCATABLE, DIMENSION(:,:) :: ind_temp
223 : 0 : DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: list_temp
224 : :
225 [ # # ]: 0 : IF ( ALLOCATED(this%list) ) THEN
226 : : FREEIF(list_temp)
227 : : !FAKEFREEIF(ind_temp )
228 : 0 : width = this%size
229 : 0 : tail = this%tail
230 : 0 : size_val = width
231 [ # # ]: 0 : IF ( PRESENT(size) ) size_val = size
232 [ # # # # : 0 : MALLOC(list_temp,(0:tail,1:2))
# # # # #
# # # #
# ]
233 : : !MALLOC( ind_temp,(0:width,1:2))
234 [ # # # # ]: 0 : list_temp(0:tail,:) = this%list(0:tail,:)
235 : : !ind_temp = this%ind
236 : 0 : FREE(this%list)
237 : : !FREE(this%ind )
238 : 0 : this%size = width + size_val
239 [ # # # # : 0 : MALLOC(this%list,(0:this%size,1:2))
# # # # #
# # # #
# ]
240 : : !MALLOC(this%ind ,(0:this%size,1:2))
241 [ # # # # ]: 0 : this%list(0:tail,1:2) = list_temp(0:tail,1:2)
242 : : !this%ind (0:width,1:2) = ind_temp (0:width,1:2)
243 [ # # ]: 0 : FREE(list_temp)
244 : : ELSE
245 : : !CALL ListCdagC_init(this, this%inv_dt, Global_SIZE)
246 : 0 : CALL ListCdagC_init(this, Global_SIZE)
247 : : END IF
248 : 0 : END SUBROUTINE ListCdagC_enlarge
249 : : !!***
250 : :
251 : : !!****f* ABINIT/m_ListCdagC/listCdagC_assign
252 : : !! NAME
253 : : !! listCdagC_assign
254 : : !!
255 : : !! FUNCTION
256 : : !! assign routine
257 : : !!
258 : : !! COPYRIGHT
259 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
260 : : !! This file is distributed under the terms of the
261 : : !! GNU General Public License, see ~abinit/COPYING
262 : : !! or http://www.gnu.org/copyleft/gpl.txt .
263 : : !!
264 : : !! INPUTS
265 : : !! list_1=ListCdagC
266 : : !! list_2=ListCdagC
267 : : !!
268 : : !! OUTPUT
269 : : !!
270 : : !! SIDE EFFECTS
271 : : !!
272 : : !! NOTES
273 : : !!
274 : : !! SOURCE
275 : :
276 : 95797 : SUBROUTINE listCdagC_assign(this, list_2)
277 : :
278 : : !Arguments ------------------------------------
279 : : TYPE(ListCdagC), INTENT(INOUT) :: this
280 : : TYPE(ListCdagC), INTENT(IN ) :: list_2
281 : : !Local variables ------------------------------
282 : : INTEGER :: tail
283 : :
284 : 95797 : tail = list_2%tail
285 : 95797 : CALL ListCdagC_setSize(this, tail)
286 [ + + + + ]: 696965 : this%list(0:tail,1:2) = list_2%list(0:tail,1:2)
287 : : !this%ind (0:tail,1:2) = list_2%ind (0:tail,1:2)
288 : :
289 : 95797 : END SUBROUTINE ListCdagC_assign
290 : : !!***
291 : :
292 : : !!****f* ABINIT/m_ListCdagC/ListCdagC_swap
293 : : !! NAME
294 : : !! ListCdagC_swap
295 : : !!
296 : : !! FUNCTION
297 : : !! Swap two lists
298 : : !!
299 : : !! COPYRIGHT
300 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
301 : : !! This file is distributed under the terms of the
302 : : !! GNU General Public License, see ~abinit/COPYING
303 : : !! or http://www.gnu.org/copyleft/gpl.txt .
304 : : !!
305 : : !! INPUTS
306 : : !! list_1=ListCdagC
307 : : !! list_2=ListCdagC
308 : : !!
309 : : !! OUTPUT
310 : : !!
311 : : !! SIDE EFFECTS
312 : : !!
313 : : !! NOTES
314 : : !!
315 : : !! SOURCE
316 : :
317 : 0 : SUBROUTINE ListCdagC_swap(this,list_2)
318 : :
319 : : !Arguments ------------------------------------
320 : : TYPE(ListCdagC), INTENT(INOUT) :: this
321 : : TYPE(ListCdagC), INTENT(INOUT) :: list_2
322 : : !Local variables ------------------------------
323 : : INTEGER :: tail1
324 : : INTEGER :: tail2
325 : : INTEGER :: i
326 : : INTEGER :: j
327 : : !INTEGER , DIMENSION(1:2) :: ind_tmp
328 : : DOUBLE PRECISION, DIMENSION(1:2) :: CdagC_tmp
329 : :
330 : 0 : tail1 = this%tail
331 : 0 : tail2 = list_2%tail
332 : :
333 : 0 : i = MAX(tail1,tail2)
334 [ # # ]: 0 : IF ( this%size .LT. i ) THEN
335 : 0 : CALL ListCdagC_enlarge(this,i)
336 : : END IF
337 [ # # ]: 0 : IF ( list_2%size .LT. i ) THEN
338 : 0 : CALL ListCdagC_enlarge(list_2,i)
339 : : END IF
340 : :
341 [ # # ]: 0 : DO j = 0, i
342 [ # # ]: 0 : CdagC_tmp(1:2) = this%list(j,1:2)
343 : : !ind_tmp (1:2) = this%ind (j,1:2)
344 [ # # ]: 0 : this%list(j,1:2) = list_2%list(j,1:2)
345 : : !this%ind (j,1:2) = list_2%ind (j,1:2)
346 [ # # ]: 0 : list_2%list(j,1:2) = CdagC_tmp(1:2)
347 : : !list_2%ind (j,1:2) = ind_tmp (1:2)
348 : : END DO
349 : 0 : list_2%tail = tail1
350 : 0 : this%tail = tail2
351 : 0 : END SUBROUTINE ListCdagC_swap
352 : : !!***
353 : :
354 : : !!****f* ABINIT/m_ListCdagC/ListCdagC_pushBack
355 : : !! NAME
356 : : !! ListCdagC_pushBack
357 : : !!
358 : : !! FUNCTION
359 : : !! push at the end of the list a couple
360 : : !!
361 : : !! COPYRIGHT
362 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
363 : : !! This file is distributed under the terms of the
364 : : !! GNU General Public License, see ~abinit/COPYING
365 : : !! or http://www.gnu.org/copyleft/gpl.txt .
366 : : !!
367 : : !! INPUTS
368 : : !! list_1=ListCdagC
369 : : !! CdagC_1=couple
370 : : !!
371 : : !! OUTPUT
372 : : !!
373 : : !! SIDE EFFECTS
374 : : !!
375 : : !! NOTES
376 : : !!
377 : : !! SOURCE
378 : :
379 : 0 : SUBROUTINE ListCdagC_pushBack(this, CdagC_1)
380 : :
381 : : !Arguments ------------------------------------
382 : : TYPE(ListCdagC), INTENT(INOUT) :: this
383 : : DOUBLE PRECISION, DIMENSION(1:2), INTENT(IN ) :: CdagC_1
384 : : !Local variables ------------------------------
385 : : INTEGER :: tail
386 : :
387 : : !IF ( this%size .EQ. 0 ) THEN
388 : : ! CALL ListCdagC_init(this, this%inv_dt, Global_SIZE)
389 : : !ENDIF
390 [ # # ]: 0 : IF ( this%size .EQ. 0 ) THEN
391 : 0 : CALL ListCdagC_init(this, Global_SIZE)
392 : : END IF
393 : 0 : tail = this%tail
394 : 0 : tail = tail + 1
395 [ # # ]: 0 : IF ( tail .GT. this%size ) THEN
396 : 0 : CALL ListCdagC_enlarge(this)
397 : : END IF
398 [ # # ]: 0 : this%list(tail,1:2) = CdagC_1
399 : : !this%ind (tail,Cdag_) = INT(CdagC_1(Cdag_) * this%inv_dt + 0.5d0)
400 : : !this%ind (tail,C_ ) = INT(CdagC_1(C_ ) * this%inv_dt + 0.5d0)
401 : 0 : this%tail = tail
402 : 0 : END SUBROUTINE ListCdagC_pushBack
403 : : !!***
404 : :
405 : : !!****f* ABINIT/m_ListCdagC/ListCdagC_insert
406 : : !! NAME
407 : : !! ListCdagC_insert
408 : : !!
409 : : !! FUNCTION
410 : : !! insert somewhere a couple
411 : : !!
412 : : !! COPYRIGHT
413 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
414 : : !! This file is distributed under the terms of the
415 : : !! GNU General Public License, see ~abinit/COPYING
416 : : !! or http://www.gnu.org/copyleft/gpl.txt .
417 : : !!
418 : : !! INPUTS
419 : : !! list_1=ListCdagC
420 : : !! CdagC_1=couple
421 : : !! position=where to insert
422 : : !!
423 : : !! OUTPUT
424 : : !!
425 : : !! SIDE EFFECTS
426 : : !!
427 : : !! NOTES
428 : : !!
429 : : !! SOURCE
430 : :
431 : 85920850 : SUBROUTINE ListCdagC_insert(this, CdagC_1, position)
432 : :
433 : : !Arguments ------------------------------------
434 : : TYPE(ListCdagC), INTENT(INOUT) :: this
435 : : DOUBLE PRECISION, DIMENSION(1:2), INTENT(IN ) :: CdagC_1
436 : : INTEGER , INTENT(IN ) :: position
437 : : !Local variables ------------------------------
438 : : INTEGER :: new_position
439 : : INTEGER :: tail
440 : :
441 : 85920850 : tail = this%tail + 1
442 : 85920850 : new_position = position
443 [ - + ]: 85920850 : IF ( tail .GT. this%size ) THEN
444 : 0 : CALL ListCdagC_enlarge(this)
445 : : END IF
446 [ + + ]: 85920850 : IF ( position .EQ. -1 ) THEN
447 : : new_position = tail
448 [ + - ]: 75679872 : ELSE IF ( position .LE. tail ) THEN
449 : : ! new_position = position
450 [ + + + + : 1026581164 : this%list(tail:position+1:-1,1:2) = this%list(this%tail:position:-1,1:2)
+ + + + +
+ ]
451 : : ELSE
452 : 0 : CALL ERROR("ListCdagC_insert : position > tail ")
453 : : END IF
454 : :
455 [ + + ]: 257762550 : this%list(new_position,1:2) = CdagC_1
456 : : !this%ind (new_position,Cdag_) = INT(CdagC_1(Cdag_) * this%inv_dt + 0.5d0)
457 : : !this%ind (new_position,C_ ) = INT(CdagC_1(C_ ) * this%inv_dt + 0.5d0)
458 : 85920850 : this%tail = tail
459 : 85920850 : END SUBROUTINE ListCdagC_insert
460 : : !!***
461 : :
462 : : !!****f* ABINIT/m_ListCdagC/ListCdagC_popBack
463 : : !! NAME
464 : : !! ListCdagC_popBack
465 : : !!
466 : : !! FUNCTION
467 : : !! Remove the last element
468 : : !!
469 : : !! COPYRIGHT
470 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
471 : : !! This file is distributed under the terms of the
472 : : !! GNU General Public License, see ~abinit/COPYING
473 : : !! or http://www.gnu.org/copyleft/gpl.txt .
474 : : !!
475 : : !! INPUTS
476 : : !! list_1=ListCdagC
477 : : !!
478 : : !! OUTPUT
479 : : !!
480 : : !! SIDE EFFECTS
481 : : !!
482 : : !! NOTES
483 : : !!
484 : : !! SOURCE
485 : :
486 : 0 : SUBROUTINE ListCdagC_popBack(this)
487 : :
488 : : !Arguments ------------------------------------
489 : : TYPE(ListCdagC), INTENT(INOUT) :: this
490 : : !Local variables ------------------------------
491 : : INTEGER :: tail
492 : :
493 : 0 : tail = this%tail
494 [ # # ]: 0 : IF ( tail .EQ. 0 ) RETURN
495 : 0 : this%tail = tail - 1
496 : : END SUBROUTINE ListCdagC_popBack
497 : : !!***
498 : :
499 : : !!****f* ABINIT/m_ListCdagC/ListCdagC_erase
500 : : !! NAME
501 : : !! ListCdagC_erase
502 : : !!
503 : : !! FUNCTION
504 : : !! Erase a couple at a given position
505 : : !!
506 : : !! COPYRIGHT
507 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
508 : : !! This file is distributed under the terms of the
509 : : !! GNU General Public License, see ~abinit/COPYING
510 : : !! or http://www.gnu.org/copyleft/gpl.txt .
511 : : !!
512 : : !! INPUTS
513 : : !! list_1=ListCdagC
514 : : !! position=position of the element to remove
515 : : !!
516 : : !! OUTPUT
517 : : !!
518 : : !! SIDE EFFECTS
519 : : !!
520 : : !! NOTES
521 : : !!
522 : : !! SOURCE
523 : :
524 : 85918401 : SUBROUTINE ListCdagC_erase(this,position)
525 : :
526 : : !Arguments ------------------------------------
527 : : TYPE(ListCdagC), INTENT(INOUT) :: this
528 : : INTEGER, INTENT(IN ) :: position
529 : : !Local variables ------------------------------
530 : : INTEGER :: tail
531 : : INTEGER :: new_tail
532 : : INTEGER :: continueing
533 : :
534 : 85918401 : tail = this%tail
535 [ - + ]: 85918401 : IF ( position .GT. tail ) &
536 : 0 : CALL ERROR("ListCdagC_erase : position > tail ")
537 : 85918401 : new_tail = tail - 1
538 : 85918401 : continueing = position + 1
539 [ + + + + : 1087920750 : this%list(new_tail:position:-1,1:2) = this%list(tail:continueing:-1,1:2)
+ + + + +
+ ]
540 : 85918401 : this%tail = new_tail
541 : 85918401 : END SUBROUTINE ListCdagC_erase
542 : : !!***
543 : :
544 : : !!****f* ABINIT/m_ListCdagC/ListCdagC_firstHigherThanReal
545 : : !! NAME
546 : : !! ListCdagC_firstHigherThanReal
547 : : !!
548 : : !! FUNCTION
549 : : !! search for the first element higher than the real time
550 : : !! assume the list is already sorted
551 : : !!
552 : : !! COPYRIGHT
553 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
554 : : !! This file is distributed under the terms of the
555 : : !! GNU General Public License, see ~abinit/COPYING
556 : : !! or http://www.gnu.org/copyleft/gpl.txt .
557 : : !!
558 : : !! INPUTS
559 : : !! list_1=ListCdagC
560 : : !! time=reference
561 : : !!
562 : : !! OUTPUT
563 : : !!
564 : : !! SIDE EFFECTS
565 : : !!
566 : : !! NOTES
567 : : !!
568 : : !! SOURCE
569 : :
570 [ # # ]: 0 : INTEGER FUNCTION ListCdagC_firstHigherThanReal(this, time)
571 : :
572 : : !Arguments ------------------------------------
573 : : TYPE(ListCdagC), INTENT(IN) :: this
574 : : DOUBLE PRECISION, INTENT(IN) :: time
575 : : #include "ListCdagC_firstHigher.h"
576 : : ! Dichotomic research
577 : : #define list_1 this
578 : : #include "ListCdagC_firstHigher"
579 : : #undef list_1
580 : : ! unefficient function for long list
581 : : ! it = 1
582 : : ! DO WHILE ( it .LE. this%tail .AND. this%list(it) .LE. value )
583 : : ! it = it + 1
584 : : ! END DO
585 : : ! IF ( it .GT. this%tail ) it = -1
586 : : ! ListCdagC_firstHigherThanReal = it
587 : 0 : ListCdagC_firstHigherThanReal = firstHigher
588 : 0 : END FUNCTION ListCdagC_firstHigherThanReal
589 : : !!***
590 : :
591 : : !!****f* ABINIT/m_ListCdagC/ListCdagC_sort
592 : : !! NAME
593 : : !! ListCdagC_sort
594 : : !!
595 : : !! FUNCTION
596 : : !! sort the list by c+ increasing
597 : : !!
598 : : !! COPYRIGHT
599 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
600 : : !! This file is distributed under the terms of the
601 : : !! GNU General Public License, see ~abinit/COPYING
602 : : !! or http://www.gnu.org/copyleft/gpl.txt .
603 : : !!
604 : : !! INPUTS
605 : : !! list_1=ListCdagC
606 : : !!
607 : : !! OUTPUT
608 : : !!
609 : : !! SIDE EFFECTS
610 : : !!
611 : : !! NOTES
612 : : !!
613 : : !! SOURCE
614 : :
615 : 0 : SUBROUTINE ListCdagC_sort(this)
616 : :
617 : : !Arguments ------------------------------------
618 : : TYPE(ListCdagC), INTENT(INOUT) :: this
619 : :
620 [ # # ]: 0 : IF ( this%tail .EQ. 1 ) RETURN
621 : 0 : CALL ListCdagC_quickSort(this, 1, this%tail)
622 : : END SUBROUTINE ListCdagC_sort
623 : : !!***
624 : :
625 : : !!****f* ABINIT/m_ListCdagC/ListCdagC_quickSort
626 : : !! NAME
627 : : !! ListCdagC_quickSort
628 : : !!
629 : : !! FUNCTION
630 : : !! sort the list by c+ increasing with the quick sort algo
631 : : !!
632 : : !! COPYRIGHT
633 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
634 : : !! This file is distributed under the terms of the
635 : : !! GNU General Public License, see ~abinit/COPYING
636 : : !! or http://www.gnu.org/copyleft/gpl.txt .
637 : : !!
638 : : !! INPUTS
639 : : !! list_1=ListCdagC
640 : : !! begin=from element to consider
641 : : !! end=last element to consider
642 : : !!
643 : : !! OUTPUT
644 : : !!
645 : : !! SIDE EFFECTS
646 : : !!
647 : : !! NOTES
648 : : !!
649 : : !! SOURCE
650 : :
651 : 0 : RECURSIVE SUBROUTINE ListCdagC_quickSort(this, begin, end)
652 : :
653 : : !Arguments ------------------------------------
654 : : TYPE(ListCdagC), INTENT(INOUT) :: this
655 : : INTEGER, INTENT(IN ) :: begin
656 : : INTEGER, INTENT(IN ) :: end
657 : : !Local variables k-----------------------------
658 : : INTEGER :: it1
659 : : INTEGER :: it2
660 : : DOUBLE PRECISION :: pivot
661 : : DOUBLE PRECISION, DIMENSION(1:2):: CdagC_swap
662 : : !DOUBLE PRECISION, DIMENSION(1:2):: ind_swap
663 : :
664 : 0 : pivot = this%list((end-begin)/2 + begin,Cdag_) ! not the betterchoice.... FIXME
665 : 0 : it1 = begin
666 : 0 : it2 = end
667 [ # # ]: 0 : DO WHILE (it1 .LE. it2)
668 [ # # ]: 0 : DO WHILE ( this%list(it1,Cdag_) .LT. pivot )
669 : 0 : it1 = it1 + 1
670 : : END DO
671 [ # # ]: 0 : DO WHILE ( this%list(it2,Cdag_) .GT. pivot )
672 : 0 : it2 = it2 - 1
673 : : END DO
674 [ # # ]: 0 : IF ( it1 .LE. it2) THEN
675 [ # # ]: 0 : CdagC_swap = this%list(it1,1:2)
676 : : !ind_swap = this%ind (it1,1:2)
677 [ # # ]: 0 : this%list(it1,1:2) = this%list(it2,1:2)
678 : : !this%ind (it1,1:2) = this%ind (it2,1:2)
679 [ # # ]: 0 : this%list(it2,1:2) = CdagC_swap
680 : : !this%ind (it2,1:2) = ind_swap
681 : 0 : it1 = it1 + 1
682 : 0 : it2 = it2 - 1
683 : : END IF
684 : : END DO
685 [ # # ]: 0 : IF ( begin < it2 ) THEN
686 : 0 : CALL ListCdagC_quickSort(this,begin,it2)
687 : : END IF
688 : : !!it2= it1+1
689 [ # # ]: 0 : IF ( it1 < end ) THEN
690 : 0 : CALL ListCdagC_quickSort(this,it1,end)
691 : : END IF
692 : :
693 : 0 : END SUBROUTINE ListCdagC_quickSort
694 : : !!***
695 : :
696 : : !!****f* ABINIT/m_ListCdagC/ListCdagC_print
697 : : !! NAME
698 : : !! ListCdagC_print
699 : : !!
700 : : !! FUNCTION
701 : : !! print the list
702 : : !!
703 : : !! COPYRIGHT
704 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
705 : : !! This file is distributed under the terms of the
706 : : !! GNU General Public License, see ~abinit/COPYING
707 : : !! or http://www.gnu.org/copyleft/gpl.txt .
708 : : !!
709 : : !! INPUTS
710 : : !! list_1=ListCdagC
711 : : !! ostrean=file stream
712 : : !!
713 : : !! OUTPUT
714 : : !!
715 : : !! SIDE EFFECTS
716 : : !!
717 : : !! NOTES
718 : : !!
719 : : !! SOURCE
720 : :
721 : 0 : SUBROUTINE ListCdagC_print(this,ostream)
722 : :
723 : : !Arguments ------------------------------------
724 : : TYPE(ListCdagC) , INTENT(IN) :: this
725 : : INTEGER, OPTIONAL, INTENT(IN) :: ostream
726 : : !Local variables ------------------------------
727 : : INTEGER :: ostream_val
728 : : INTEGER :: it
729 : :
730 : 0 : ostream_val = 6
731 [ # # ]: 0 : IF ( PRESENT(ostream) ) ostream_val = ostream
732 : 0 : WRITE(ostream_val,'(A,2x,A4,22x,A)') "#","Cdag", "C"
733 [ # # ]: 0 : DO it = 1, this%tail
734 : 0 : WRITE(ostream_val,*) this%list(it,Cdag_), this%list(it,C_)
735 : : END DO
736 : 0 : END SUBROUTINE ListCdagC_print
737 : : !!***
738 : :
739 : : !!****f* ABINIT/m_ListCdagC/ListCdagC_clear
740 : : !! NAME
741 : : !! ListCdagC_clear
742 : : !!
743 : : !! FUNCTION
744 : : !! Clear the list
745 : : !!
746 : : !! COPYRIGHT
747 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
748 : : !! This file is distributed under the terms of the
749 : : !! GNU General Public License, see ~abinit/COPYING
750 : : !! or http://www.gnu.org/copyleft/gpl.txt .
751 : : !!
752 : : !! INPUTS
753 : : !! list_1=ListCdagC
754 : : !!
755 : : !! OUTPUT
756 : : !!
757 : : !! SIDE EFFECTS
758 : : !!
759 : : !! NOTES
760 : : !!
761 : : !! SOURCE
762 : :
763 : 518 : SUBROUTINE ListCdagC_clear(this)
764 : :
765 : : !Arguments ------------------------------------
766 : : TYPE(ListCdagC), INTENT(INOUT) :: this
767 : 518 : this%tail = 0
768 : 518 : END SUBROUTINE ListCdagC_clear
769 : : !!***
770 : :
771 : : !!****f* ABINIT/m_ListCdagC/ListCdagC_destroy
772 : : !! NAME
773 : : !! ListCdagC_destroy
774 : : !!
775 : : !! FUNCTION
776 : : !! destroy the list
777 : : !!
778 : : !! COPYRIGHT
779 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
780 : : !! This file is distributed under the terms of the
781 : : !! GNU General Public License, see ~abinit/COPYING
782 : : !! or http://www.gnu.org/copyleft/gpl.txt .
783 : : !!
784 : : !! INPUTS
785 : : !! list_1=ListCdagC
786 : : !!
787 : : !! OUTPUT
788 : : !!
789 : : !! SIDE EFFECTS
790 : : !!
791 : : !! NOTES
792 : : !!
793 : : !! SOURCE
794 : :
795 : 1178 : SUBROUTINE ListCdagC_destroy(this)
796 : :
797 : : !Arguments ------------------------------------
798 : : TYPE(ListCdagC), INTENT(INOUT) :: this
799 : :
800 [ + + ]: 1178 : FREEIF(this%list)
801 : : !FAKEFREEIF(this%ind )
802 : :
803 : 1178 : this%tail = 0
804 : 1178 : this%size = 0
805 : : !this%inv_dt = 0.d0
806 : 1178 : END SUBROUTINE ListCdagC_destroy
807 : : !!***
808 : :
809 [ # # # # : 0 : END MODULE m_ListCdagC
# # # # #
# # # ]
810 : : !!***
|
