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 : !!***
811 :
|
