Branch data Line data Source code
1 : : !!****m* ABINIT/m_dynarray
2 : : !!
3 : : !! NAME
4 : : !! m_dynarray
5 : : !!
6 : : !! FUNCTION
7 : : !! Module for int and real(dp) array which allocate memory dynamically
8 : : !! real_array_type for real(dp) and int_array_type for integer.
9 : : !! they have push (but no pop) and finalize methods.
10 : : !! TODO hexu: Is this already implemented somewhere in abinit.
11 : : !! If not, should this file be moved to the place to make it more general usable?
12 : : !!
13 : : !! MG: Yes, this module should be moved to a lower level directory so that one can reuse it in other
14 : : !! parts of the code.
15 : : !!
16 : : !!
17 : : !! COPYRIGHT
18 : : !! Copyright (C) 2010-2026 ABINIT group (hexu)
19 : : !! This file is distributed under the terms of the
20 : : !! GNU General Public Licence, see ~abinit/COPYING
21 : : !! or http://www.gnu.org/copyleft/gpl.txt .
22 : : !! For the initials of contributors, see ~abinit/doc/developers/contributors.txt .
23 : : !!
24 : : !! SOURCE
25 : :
26 : :
27 : : #if defined HAVE_CONFIG_H
28 : : #include "config.h"
29 : : #endif
30 : : #include "abi_common.h"
31 : :
32 : : module m_dynamic_array
33 : : use defs_basis
34 : : use m_abicore
35 : : use m_errors
36 : : use m_mathfuncs, only: array_morethan, binsearch_left_integerlist,binsearch_left_integer
37 : : use m_mergesort, only: MergeSort, MergeSort2D
38 : : use m_xmpi, only: xmpi_sum, xmpi_allgather, xmpi_allgatherv
39 : : implicit none
40 : : private
41 : : !!***
42 : :
43 : : !!****t* m_dynarray/real_array_type
44 : : !! NAME
45 : : !! real_array_type
46 : : !!
47 : : !! FUNCTION
48 : : !! datatype of real(dp) array which can be dynamically allocated
49 : : !!
50 : : !! SOURCE
51 : : type, public:: real_array_type
52 : : integer:: size=0, capacity=0
53 : : real(dp), allocatable :: data(:)
54 : : CONTAINS
55 : : procedure :: push => real_array_type_push
56 : : procedure :: sort => real_array_type_sort
57 : : procedure :: from_static => real_array_type_from_static
58 : : procedure :: allgatherv => real_array_type_allgatherv
59 : : procedure :: finalize => real_array_type_finalize
60 : : end type real_array_type
61 : :
62 : :
63 : : !!***
64 : :
65 : : !!****t* m_dynarray/int_array_type
66 : : !! NAME
67 : : !! int_array_type
68 : : !!
69 : : !! FUNCTION
70 : : !! datatype of real(dp) array which can be dynamically allocated
71 : : !!
72 : : !! SOURCE
73 : : type , public::int_array_type
74 : : integer:: size=0, capacity=0
75 : : integer, allocatable :: data(:)
76 : : CONTAINS
77 : : procedure :: push => int_array_type_push
78 : : procedure :: concate => int_array_type_concate
79 : : procedure :: finalize => int_array_type_finalize
80 : : procedure :: sort => int_array_type_sort
81 : : procedure :: tostatic => int_array_type_tostatic
82 : : procedure :: allgatherv => int_array_type_allgatherv
83 : : end type int_array_type
84 : : !!***
85 : :
86 : : !!****t* defs_abitypes/int2d_array_type
87 : : !! NAME
88 : : !! int2d_array_type
89 : : !!
90 : : !! FUNCTION
91 : : !! datatype of integer array which the dim=2 can be dynamically allocated
92 : : !!
93 : : !! SOURCE
94 : : type , public::int2d_array_type
95 : : integer:: size=0, capacity=0, size1=-1
96 : : logical :: sorted=.False.
97 : : integer, allocatable :: data(:,:)
98 : : CONTAINS
99 : : procedure :: push => int2d_array_type_push
100 : : procedure :: concate => int2d_array_type_concate
101 : : procedure :: tostatic => int2d_array_type_tostatic
102 : : procedure :: push_unique => int2d_array_type_push_unique
103 : : procedure :: sort => int2d_array_type_sort
104 : : procedure :: binsearch =>int2d_array_type_binsearch
105 : : procedure :: finalize => int2d_array_type_finalize
106 : : end type int2d_array_type
107 : : !!***
108 : :
109 : : !public :: mpi_gather_int_array
110 : : public:: dynamic_array_unittest
111 : : CONTAINS
112 : :
113 : : ! subroutine merge_int_array(x1, x2, y)
114 : : ! class(int_array_type), intent(in) :: x
115 : : ! class(int_array_type), :: y
116 : :
117 : : ! end subroutine gather_int_array
118 : :
119 : : !subroutine mpi_gather_int_array(a, comm, y, ny)
120 : : ! class(int_array_type) :: a
121 : : ! integer :: comm
122 : : ! integer, allocatable, intent(out) :: y(:, :)
123 : : ! integer, intent(out) :: ny
124 : : !end subroutine mpi_gather_int_array
125 : :
126 : :
127 : :
128 : :
129 : : !****f* m_dynarray/real_array_type_push
130 : : !!
131 : : !! NAME
132 : : !! real_array_type_push
133 : : !!
134 : : !! FUNCTION
135 : : !! push data to a real_array_type
136 : : !!
137 : : !! INPUTS
138 : : !! self = real_array_type object
139 : : !! val= data to be pushed
140 : : !! OUTPUT
141 : : !! real_array<type(real_array_type)()> = real_array_type data
142 : : !! SOURCE
143 : 2553449 : subroutine real_array_type_push(self, val)
144 : :
145 : : class(real_array_type), intent(inout):: self
146 : : real(dp) :: val
147 : 2553449 : real(dp), allocatable :: temp(:)
148 : 2553449 : self%size=self%size+1
149 [ + + ]: 2553449 : if(self%size==1) then
150 : 25 : self%capacity=8
151 [ - + - + ]: 25 : ABI_MALLOC(self%data, (self%capacity))
152 [ + + ]: 2553424 : else if ( self%size>self%capacity ) then
153 : 603 : self%capacity = self%size + self%size / 4 + 8
154 [ - + + - : 1809 : ABI_MALLOC(temp, (self%capacity))
+ - + - -
+ - + ]
155 [ + + ]: 12015622 : temp(:self%size-1) = self%data
156 [ + - ]: 603 : ABI_MOVE_ALLOC(temp, self%data)
157 : : end if
158 : 2553449 : self%data(self%size)=val
159 : :
160 : 2553449 : end subroutine real_array_type_push
161 : : !!***
162 : :
163 : : subroutine int_array_type_from_static(self, A)
164 : : class(int_array_type), intent(inout):: self
165 : : integer, intent(in) :: A(:)
166 : : integer :: n
167 : : n=size(A)
168 : : self%size=n
169 : : self%capacity=n
170 : : ABI_MALLOC(self%data, (n))
171 : : self%data(:) = A
172 : : end subroutine int_array_type_from_static
173 : :
174 [ # # ]: 0 : subroutine real_array_type_from_static(self, A)
175 : : class(real_array_type), intent(inout):: self
176 : : real(dp), intent(in) :: A(:)
177 : : integer :: n
178 : 0 : n=size(A)
179 : 0 : self%size=n
180 : 0 : self%capacity=n
181 [ # # # # : 0 : ABI_MALLOC(self%data, (n))
# # # # #
# # # #
# ]
182 [ # # ]: 0 : self%data(:) = A
183 : 0 : end subroutine real_array_type_from_static
184 : :
185 : 0 : subroutine real_array_type_sort(self, order)
186 : : class(real_array_type), intent(inout):: self
187 : 0 : real(dp):: work((self%size+1)/2)
188 : : integer, optional, intent(inout):: order(self%size)
189 : 0 : integer :: work_order((self%size+1)/2)
190 : 0 : call MergeSort(self%data(:self%size), work, order, work_order)
191 : 0 : end subroutine real_array_type_sort
192 : :
193 : 0 : subroutine real_array_type_allgatherv(self,buff, comm, nproc)
194 : : class(real_array_type), intent(inout):: self
195 : : integer, intent(in) :: comm, nproc
196 : : real(dp), allocatable, intent(out) :: buff(:)
197 : : real(dp), allocatable :: tmp(:)
198 : 0 : integer :: disps(nproc), sizes(nproc)
199 : : integer :: totsize, ierr, i
200 : 0 : totsize=self%size
201 : 0 : call xmpi_sum(totsize, comm, ierr)
202 [ # # # # : 0 : ABI_MALLOC(buff, (totsize))
# # # # #
# # # #
# ]
203 : 0 : call xmpi_allgather(self%size, sizes, comm, ierr)
204 : 0 : disps(1)=0
205 [ # # ]: 0 : do i=2, nproc
206 : 0 : disps(i)=disps(i-1)+sizes(i-1)
207 : : end do
208 [ # # # # : 0 : ABI_MALLOC(tmp, (self%size))
# # # # #
# # # ]
209 [ # # ]: 0 : if(self%size>0) then
210 [ # # ]: 0 : tmp(:)=self%data(:self%size)
211 : : end if
212 : 0 : call xmpi_allgatherv(tmp, self%size, buff, sizes, disps, comm, ierr )
213 [ # # ]: 0 : ABI_FREE(tmp)
214 : 0 : end subroutine real_array_type_allgatherv
215 : :
216 : :
217 : :
218 : : !****f* m_disarray/real_array_type_finalize
219 : : !!
220 : : !! NAME
221 : : !! real_array_type_finalize
222 : : !!
223 : : !! FUNCTION
224 : : !! destroy real_array_type
225 : : !!
226 : : !! INPUTS
227 : : !! self= real_array_type object
228 : : !! OUTPUT
229 : : !! real_array<type(real_array_type)()> = real_array_type data
230 : : !! SOURCE
231 : 38 : subroutine real_array_type_finalize(self)
232 : :
233 : : class(real_array_type), intent(inout):: self
234 [ + + ]: 38 : ABI_SFREE(self%data)
235 : 38 : self%size=0
236 : 38 : self%capacity=0
237 : :
238 : 38 : end subroutine real_array_type_finalize
239 : : !!***
240 : :
241 : : !****f* m_dynarray/int_array_type_push
242 : : !!
243 : : !! NAME
244 : : !! int_array_type_push
245 : : !!
246 : : !! FUNCTION
247 : : !! push data to a int_array_type
248 : : !!
249 : : !! INPUTS
250 : : !! self = int_array_type object
251 : : !! val= data to be pushed
252 : : !! OUTPUT
253 : : !! int_array<type(real_array_type)()> = int_array_type data
254 : : !! SOURCE
255 : 28015 : subroutine int_array_type_push(self, val)
256 : :
257 : : class(int_array_type), intent(inout):: self
258 : : integer :: val
259 : 28015 : integer, allocatable :: temp(:)
260 : 28015 : self%size=self%size+1
261 [ + + ]: 28015 : if(self%size==1) then
262 : 27 : self%capacity=8
263 [ - + - + ]: 27 : ABI_MALLOC(self%data, (self%capacity))
264 [ + + ]: 27988 : else if ( self%size>self%capacity ) then
265 : 208 : self%capacity = self%size + self%size / 4 + 8
266 [ - + + - : 624 : ABI_MALLOC(temp, (self%capacity))
+ - + - -
+ - + ]
267 [ + + ]: 127026 : temp(:self%size-1) = self%data
268 : : !temp gets deallocated
269 [ + - ]: 208 : ABI_MOVE_ALLOC(temp, self%data)
270 : : end if
271 : 28015 : self%data(self%size)=val
272 : :
273 : 28015 : end subroutine int_array_type_push
274 : : !!***
275 : :
276 : :
277 : : !----------------------------------------------------------------------
278 : : !> @brief insertion_sort_int: sort a array using insertion sort algorithm
279 : : !> it is a memory safe method but is generally slow.
280 : : !> @param[inout] a: the array to be sorted. and will output inplace
281 : : !> @param[inout] order (optional) the sorted index, it can be used to sort
282 : : !> other arrays so that the order in consistent.
283 : : !----------------------------------------------------------------------
284 [ # # ]: 0 : subroutine insertion_sort_int(a, order)
285 : : integer, intent(inout) :: a(:)
286 : : integer, optional, intent(inout):: order(size(a))
287 : : integer :: n,i,j, v
288 : 0 : n=size(a)
289 [ # # ]: 0 : if (present(order)) then
290 [ # # ]: 0 : do i = 1,n
291 : 0 : order(i)=i
292 : : end do
293 : : end if
294 [ # # ]: 0 : do i = 2,n
295 : 0 : v=a(i)
296 : 0 : j=i-1
297 [ # # ]: 0 : do while(j>=1 )
298 [ # # ]: 0 : if (a(j)<=v) exit
299 : 0 : a(j+1)=a(j)
300 [ # # ]: 0 : if(present(order)) order(j+1)=order(j)
301 : 0 : j=j-1
302 : : end do
303 : 0 : a(j+1)=v
304 [ # # ]: 0 : if(present(order)) order(j+1)=i
305 : : end do
306 : :
307 [ # # ]: 0 : end subroutine insertion_sort_int
308 : :
309 : : !----------------------------------------------------------------------
310 : : !> @brief int_array_type_insertion_sort: sort a DYNAMIC INT array using insertion sort algorithm
311 : : !> it is a memory safe method but is generally slow.
312 : : !> @param[inout] a: an dynamic array. the array to be sorted. and will output inplace
313 : : !> @param[inout] order (optional) the sorted index, it can be used to sort
314 : : !> other arrays so that the order in consistent.
315 : : !----------------------------------------------------------------------
316 : : subroutine int_array_type_insertion_sort(self, order)
317 : : class(int_array_type), intent(inout):: self
318 : : integer, optional, intent(inout):: order(self%size)
319 : : integer :: i,j, v
320 : : if (present(order)) then
321 : : do i = 1, self%size
322 : : order(i)=i
323 : : end do
324 : : end if
325 : : do i = 2, self%size
326 : : v=self%data(i)
327 : : j=i-1
328 : : do while(j>=1 )
329 : : if(.not. self%data(j)>v) exit
330 : : self%data(j+1)=self%data(j)
331 : : if(present(order)) order(j+1)=order(j)
332 : : j=j-1
333 : : end do
334 : : self%data(j+1)=v
335 : : if(present(order)) order(j+1)=i
336 : : end do
337 : : end subroutine int_array_type_insertion_sort
338 : :
339 : :
340 : : !----------------------------------------------------------------------
341 : : !> @brief int_array_type_insertion_sort: sort a DYNAMIC INT array using merge sort algorithm
342 : : !> @param[inout] a: an dynamic array. the array to be sorted. and will output inplace
343 : : !> @param[inout] order (optional) the sorted index, it can be used to sort
344 : : !> other arrays so that the order in consistent.
345 : : !----------------------------------------------------------------------
346 : 0 : subroutine int_array_type_sort(self, order)
347 : : class(int_array_type), intent(inout):: self
348 : : integer, optional, intent(inout):: order(self%size)
349 : 0 : integer :: work((self%size+1)/2), work_order((self%size+1)/2)
350 : 0 : call MergeSort(self%data(:self%size), work, order, work_order)
351 : 0 : end subroutine int_array_type_sort
352 : :
353 : :
354 : : !****f* m_dynarray/int_array_type_concate
355 : : !!
356 : : !! NAME
357 : : !! int_array_type_concate
358 : : !!
359 : : !! FUNCTION
360 : : !! concate int_array to a int_array_type
361 : : !!
362 : : !! INPUTS
363 : : !! self = int_array_type object
364 : : !! array= array to be concateed
365 : : !! OUTPUT
366 : : !! int_array<type(real_array_type)()> = int_array_type data
367 : : !! SOURCE
368 : 0 : subroutine int_array_type_concate(self, array)
369 : : class(int_array_type), intent(inout):: self
370 : : class(int_array_type), intent(in):: array
371 : : integer :: i
372 [ # # ]: 0 : do i=1, array%size
373 : 0 : call self%push(array%data(i))
374 : : end do
375 : 0 : end subroutine int_array_type_concate
376 : : !!***
377 : :
378 : :
379 : :
380 : :
381 : :
382 : : !****f* m_dynarray/int_array_type_finalize
383 : : !!
384 : : !! NAME
385 : : !! int_array_type_finalize
386 : : !!
387 : : !! FUNCTION
388 : : !! destroy int_array_type
389 : : !!
390 : : !! INPUTS
391 : : !! self= int_array_type object
392 : : !! OUTPUT
393 : : !! int_array<type(int_array_type)()> = int_array_type data
394 : : !! SOURCE
395 : 39 : subroutine int_array_type_finalize(self)
396 : :
397 : : class(int_array_type), intent(inout):: self
398 [ + + ]: 39 : ABI_SFREE(self%data)
399 : 39 : self%size=0
400 : 39 : self%capacity=0
401 : :
402 : 39 : end subroutine int_array_type_finalize
403 : :
404 : 27 : subroutine int_array_type_allgatherv(self,buff, comm, nproc)
405 : : class(int_array_type), intent(inout):: self
406 : : integer, intent(in) :: comm, nproc
407 : : integer, allocatable, intent(out) :: buff(:)
408 : : integer, allocatable :: tmp(:)
409 : 54 : integer :: disps(nproc), sizes(nproc)
410 : : integer :: totsize, ierr, i
411 : 27 : totsize=self%size
412 : 27 : call xmpi_sum(totsize, comm, ierr)
413 [ - + + - : 81 : ABI_MALLOC(buff, (totsize))
+ - + - -
+ - + -
+ ]
414 : 27 : call xmpi_allgather(self%size, sizes, comm, ierr)
415 : 27 : disps(1)=0
416 [ + + ]: 69 : do i=2, nproc
417 : 69 : disps(i)=disps(i-1)+sizes(i-1)
418 : : end do
419 [ + + + - : 81 : ABI_MALLOC(tmp, (self%size))
+ - + + -
+ - + ]
420 [ + + ]: 27 : if(self%size>0) then
421 [ + + ]: 57 : tmp(:)=self%data(:self%size)
422 : : end if
423 : 27 : call xmpi_allgatherv(tmp, self%size, buff, sizes, disps, comm, ierr )
424 [ - + ]: 27 : ABI_FREE(tmp)
425 : 27 : end subroutine int_array_type_allgatherv
426 : :
427 : : !==================================================================
428 : :
429 : : !****f* m_dynarray/int2d_array_type_push
430 : : !!
431 : : !! NAME
432 : : !! int2d_array_type_push
433 : : !!
434 : : !! FUNCTION
435 : : !! push data to a int2d_array_type
436 : : !!
437 : : !! INPUTS
438 : : !! self = int2d_array_type object
439 : : !! val= data to be pushed
440 : : !! OUTPUT
441 : : !! int_array<type(real_array_type)()> = int2d_array_type data
442 : : !! SOURCE
443 [ - + ]: 2571053 : subroutine int2d_array_type_push(self, val)
444 : :
445 : : class(int2d_array_type), intent(inout):: self
446 : : integer :: val(:)
447 : 2571053 : integer, allocatable :: temp(:,:)
448 [ + + ]: 2571053 : if(self%size1<0) then
449 : 113 : self%size1=size(val)
450 [ - + ]: 2570940 : else if(self%size1 /= size(val)) then
451 : 0 : ABI_BUG("The size of the array is inconsistent with the 2d dynamic array")
452 : : end if
453 : 2571053 : self%size=self%size+1
454 [ + + ]: 2571053 : if(self%size==1) then
455 : 1038 : self%capacity=8
456 [ - + + - : 4152 : ABI_MALLOC(self%data, (size(val), self%capacity))
+ - + - +
- - + - +
- + ]
457 [ + + ]: 2570015 : else if ( self%size>self%capacity ) then
458 : 1342 : self%capacity = self%size + self%size / 4 + 8
459 [ - + + - : 5368 : ABI_MALLOC(temp, (size(val), self%capacity))
- + + - +
- + - - +
- + ]
460 [ + + + + ]: 42790057 : temp(:,:self%size-1) = self%data
461 [ + - ]: 1342 : ABI_MOVE_ALLOC(temp, self%data) !temp gets deallocated
462 : : end if
463 [ + + ]: 9075108 : self%data(:,self%size)=val
464 : 2571053 : end subroutine int2d_array_type_push
465 : : !!***
466 : :
467 : : !****f* m_dynarray/int2d_array_type_concate
468 : : !!
469 : : !! NAME
470 : : !! int2d_array_type_concate
471 : : !!
472 : : !! FUNCTION
473 : : !! concate int2d_array to a int2d_array_type
474 : : !!
475 : : !! INPUTS
476 : : !! self = int2d_array_type object
477 : : !! array= array to be concateed
478 : : !! OUTPUT
479 : : !! int_array<type(real_array_type)()> = int2d_array_type data
480 : : !! SOURCE
481 : 1404 : subroutine int2d_array_type_concate(self, array)
482 : : class(int2d_array_type), intent(inout):: self
483 : : class(int2d_array_type), intent(in):: array
484 : : integer :: i
485 [ + + ]: 8660 : do i=1, array%size
486 : 8660 : call self%push(array%data(:, i))
487 : : end do
488 : 1404 : end subroutine int2d_array_type_concate
489 : : !!***
490 : :
491 : 0 : subroutine int_array_type_tostatic(self, a)
492 : : class(int_array_type), intent(inout):: self
493 : : integer, allocatable :: a(:)
494 [ # # ]: 0 : if(self%size>0) then
495 [ # # # # : 0 : ABI_MALLOC(a, (self%size))
# # # # #
# # # ]
496 [ # # ]: 0 : a(:) = self%data(:self%size)
497 : : else
498 [ # # # # : 0 : ABI_MALLOC(a, (self%size))
# # # # #
# # # ]
499 : : end if
500 : 0 : end subroutine int_array_type_tostatic
501 : : !!***
502 : :
503 : :
504 : :
505 : 38 : subroutine int2d_array_type_tostatic(self, a, size1)
506 : : class(int2d_array_type), intent(inout):: self
507 : : integer, allocatable :: a(:, :)
508 : : integer, optional :: size1
509 [ + - ]: 38 : if(self%size>0) then
510 [ - + + - : 152 : ABI_MALLOC(a, (self%size1, self%size))
- + + - +
- + - - +
- + - + ]
511 [ + + + + ]: 29556 : a(:, :) = self%data(:, :self%size)
512 [ # # ]: 0 : else if(present(size1)) then
513 [ # # # # : 0 : ABI_MALLOC(a, (size1, self%size))
# # # # #
# # # # #
# # ]
514 : : else
515 : 0 : ABI_BUG("the size of the 2darray is unkown.")
516 : : end if
517 : 38 : end subroutine int2d_array_type_tostatic
518 : : !!***
519 : :
520 : :
521 : :
522 : :
523 : : !****f* m_dynarray/int2d_array_type_push
524 : : !!
525 : : !! NAME
526 : : !! int2d_array_type_push
527 : : !!
528 : : !! FUNCTION
529 : : !! push data to a int2d_array_type
530 : : !!
531 : : !! INPUTS
532 : : !! self = int2d_array_type object
533 : : !! val= data to be pushed
534 : : !! OUTPUT
535 : : !! int_array<type(real_array_type)()> = int2d_array_type data
536 : : !! SOURCE
537 [ - + ]: 11644 : subroutine int2d_array_type_push_unique(self, val, position)
538 : :
539 : : class(int2d_array_type), intent(inout):: self
540 : : integer, intent(in) :: val(:)
541 : : integer, optional, intent(out) :: position
542 : : integer :: i
543 : : logical :: inside
544 : 11644 : inside=.False.
545 [ + + ]: 106266 : do i=1, self%size
546 [ + + + + : 175210 : if(all(self%data(:,i)==val)) then
+ + ]
547 : 11438 : inside=.True.
548 [ + - ]: 11438 : if (present(position)) position=i
549 : : exit
550 : : endif
551 : : enddo
552 : : if(.not. inside) then
553 : 206 : call self%push(val)
554 [ + - ]: 206 : if (present(position)) position=self%size
555 : : end if
556 : 11644 : end subroutine int2d_array_type_push_unique
557 : : !!***
558 : :
559 : :
560 : :
561 : : !****f* m_dynarray/int2d_array_type_finalize
562 : : !!
563 : : !! NAME
564 : : !! int2d_array_type_finalize
565 : : !!
566 : : !! FUNCTION
567 : : !! destroy int2d_array_type
568 : : !!
569 : : !! INPUTS
570 : : !! self= int2d_array_type object
571 : : !! OUTPUT
572 : : !! int_array<type(int2d_array_type)()> = int2d_array_type data
573 : : !! SOURCE
574 : 2419 : subroutine int2d_array_type_finalize(self)
575 : :
576 : : class(int2d_array_type), intent(inout):: self
577 [ + + ]: 2419 : if ( allocated(self%data) ) then
578 : 1038 : ABI_SFREE(self%data)
579 : : end if
580 : 2419 : self%size=0
581 : 2419 : self%capacity=0
582 : :
583 : 2419 : end subroutine int2d_array_type_finalize
584 : :
585 : : !----------------------------------------------------------------------
586 : : !> @brief sort a 2D DYNAMIC INT array using insertion sort algorithm
587 : : !> it is a memory safe method but is generally slow.
588 : : !> it compares the elements in first dimension i.e. A(:, i) and sort the second dim.
589 : : !> The comparing is from left to right.
590 : : !> @param[inout] a: an dynamic array. the array to be sorted. and will output inplace
591 : : !> @param[inout] order (optional) the sorted index, it can be used to sort
592 : : !> other arrays so that the order in consistent.
593 : : !----------------------------------------------------------------------
594 : :
595 : : subroutine int2d_array_type_insertion_sort(self, order)
596 : : class(int2d_array_type), intent(inout):: self
597 : : integer, optional, intent(inout):: order(self%size)
598 : : integer :: i,j, v(size(self%data, dim=1))
599 : : if (present(order)) then
600 : : do i = 1, self%size
601 : : order(i)=i
602 : : end do
603 : : end if
604 : : do i = 2, self%size
605 : : v(:)=self%data(:,i)
606 : : j=i-1
607 : : do while(j>=1)
608 : : if (.not. (array_morethan(self%data(:,j),v, size(self%data, dim=1)))) exit
609 : : self%data(:,j+1)=self%data(:,j)
610 : : if(present(order)) order(j+1)=order(j)
611 : : j=j-1
612 : : end do
613 : : self%data(:,j+1)=v(:)
614 : : if(present(order)) order(j+1)=i
615 : : end do
616 : : self%sorted=.True.
617 : : end subroutine int2d_array_type_insertion_sort
618 : :
619 : :
620 : : !----------------------------------------------------------------------
621 : : !> @brief sort a 2D DYNAMIC INT array using merge sort algorithm
622 : : !> It is now set as the default sorting algorithm.
623 : : !> it is a memory safe method but is generally slow.
624 : : !> it compares the elements in first dimension i.e. A(:, i) and sort the second dim.
625 : : !> The comparing is from left to right.
626 : : !> @param[inout] a: an dynamic array. the array to be sorted. and will output inplace
627 : : !> @param[inout] order (optional) the sorted index, it can be used to sort
628 : : !> other arrays so that the order in consistent.
629 : : !----------------------------------------------------------------------
630 : :
631 : 12 : subroutine int2d_array_type_sort(self, order)
632 : : class(int2d_array_type), intent(inout):: self
633 : : integer, optional, intent(inout):: order(self%size)
634 : 24 : integer :: work(size(self%data, dim=1), (self%size+1)/2), work_order((self%size+1)/2)
635 : 12 : call MergeSort2D(self%data(:, :self%size), work, order, work_order )
636 : 12 : end subroutine int2d_array_type_sort
637 : :
638 : :
639 : : !----------------------------------------------------------------------
640 : : !> @brief binary search
641 : : !>
642 : : !> @param[in] self: the 2D array to be searched from
643 : : !> @param[in] val: the value to be searched
644 : : !> @param[out] i: the index of the first one found. returns 0 if not found.
645 : : !----------------------------------------------------------------------
646 : :
647 [ # # ]: 0 : function int2d_array_type_binsearch(self, val) result(i)
648 : : class(int2d_array_type), intent(inout):: self
649 : : integer, intent(inout) :: val(:)
650 : : integer :: i
651 : 0 : i=binsearch_left_integerlist(self%data(:,1:self%size), val)
652 : 0 : end function int2d_array_type_binsearch
653 : :
654 : :
655 : :
656 : : !====================== Unit tests======================
657 : :
658 : 0 : subroutine binsearch_test()
659 : : integer :: a(4)=[1,2,3,4], b(3,3)=reshape([0,0,0,0,1,0,1,0,0], [3,3])
660 : : integer :: i
661 : 0 : i=binsearch_left_integer(a, 5)
662 : 0 : i=binsearch_left_integerlist(b, [0,0,0])
663 : 0 : end subroutine binsearch_test
664 : :
665 : 0 : subroutine insertion_sort_int_test()
666 : : integer :: a(4), order(4), b(4), a2(8)
667 : 0 : a=[1,5,3,4]
668 : 0 : b=a
669 : 0 : call insertion_sort_int(a, order)
670 : 0 : a2=[3,6,2,4, 3, 5, 0, 9]
671 : 0 : call insertion_sort_int(a2)
672 : 0 : end subroutine insertion_sort_int_test
673 : :
674 : 0 : subroutine int2d_array_test()
675 : 0 : type(int2d_array_type) :: t
676 : 0 : call t%push_unique([1,1,2])
677 : 0 : call t%push_unique([1,2,2])
678 : 0 : call t%push_unique([1,1,2])
679 : 0 : call t%push_unique([1,1,1])
680 : 0 : call t%push_unique([-1, 3, 3])
681 : 0 : call t%push_unique([2,1, 4])
682 : 0 : call t%sort()
683 [ # # ]: 0 : end subroutine int2d_array_test
684 : :
685 : 0 : subroutine dynamic_array_unittest()
686 : 0 : call binsearch_test()
687 : 0 : call insertion_sort_int_test()
688 : 0 : call int2d_array_test()
689 : 0 : end subroutine dynamic_array_unittest
690 : :
691 : :
692 [ # # # # : 0 : end module m_dynamic_array
# # # # #
# # # ]
693 : : !!***
|
