├── src ├── swap.inc ├── unique.inc ├── expand_vector.inc ├── binary_search.inc ├── item_routines.inc ├── real32_routines.inc ├── real64_routines.inc ├── int32_routines.inc ├── int64_routines.inc ├── sort_ascending.inc ├── sort_descending.inc └── sorting_module.f90 ├── codecov.yml ├── fortran-search-and-sort.code-workspace ├── ford.md ├── .gitignore ├── fpm.toml ├── LICENSE ├── README.md ├── test ├── int_type_module.f90 ├── intvec_type_module.f90 └── test.f90 └── .github └── workflows └── CI.yml /src/swap.inc: -------------------------------------------------------------------------------- 1 | allocate(tmp,source=v1) 2 | v1 = v2 3 | v2 = tmp 4 | -------------------------------------------------------------------------------- /codecov.yml: -------------------------------------------------------------------------------- 1 | comment: 2 | layout: header, changes, diff, sunburst 3 | coverage: 4 | ignore: 5 | - test 6 | - doc 7 | status: 8 | patch: 9 | default: 10 | target: 20% 11 | project: 12 | default: 13 | target: 60% 14 | -------------------------------------------------------------------------------- /fortran-search-and-sort.code-workspace: -------------------------------------------------------------------------------- 1 | { 2 | "folders": [ 3 | { 4 | "path": "." 5 | } 6 | ], 7 | "settings": { 8 | "files.trimTrailingWhitespace": true, 9 | "editor.insertSpaces": true, 10 | "editor.tabSize": 4, 11 | "editor.trimAutoWhitespace": true 12 | } 13 | } -------------------------------------------------------------------------------- /ford.md: -------------------------------------------------------------------------------- 1 | project: sorting 2 | project_dir: ./src 3 | output_dir: ./doc 4 | project_github: https://github.com/jacobwilliams/fortran-search-and-sort 5 | summary: Searching and sorting with modern Fortran 6 | author: Jacob Williams 7 | github: https://github.com/jacobwilliams 8 | predocmark_alt: > 9 | predocmark: < 10 | docmark_alt: 11 | docmark: ! 12 | display: public 13 | source: true 14 | graph: false 15 | exclude_dir: ./tests 16 | 17 | {!README.md!} 18 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # Directories 2 | /bin 3 | /doc 4 | /build 5 | /lib 6 | /bin 7 | 8 | # Compiled Object files 9 | *.slo 10 | *.lo 11 | *.o 12 | *.obj 13 | 14 | # Precompiled Headers 15 | *.gch 16 | *.pch 17 | 18 | # Compiled Dynamic libraries 19 | *.so 20 | *.dylib 21 | *.dll 22 | 23 | # Fortran module files 24 | *.mod 25 | *.smod 26 | 27 | # Compiled Static libraries 28 | *.lai 29 | *.la 30 | *.a 31 | *.lib 32 | 33 | # Executables 34 | *.exe 35 | *.out 36 | *.app 37 | 38 | # Misc 39 | .DS_Store -------------------------------------------------------------------------------- /fpm.toml: -------------------------------------------------------------------------------- 1 | name = "fortran-search-and-sort" 2 | author = "Jacob Williams" 3 | copyright = "Copyright (c) 2017-2022, Jacob Williams" 4 | license = "BSD-3" 5 | description = "Searching and sorting with modern Fortran" 6 | homepage = "https://github.com/jacobwilliams/fortran-search-and-sort" 7 | keywords = ["sorting", "quicksort"] 8 | 9 | [build] 10 | auto-executables = false 11 | auto-examples = false 12 | auto-tests = true 13 | 14 | [library] 15 | source-dir = "src" 16 | 17 | [install] 18 | library = true -------------------------------------------------------------------------------- /src/unique.inc: -------------------------------------------------------------------------------- 1 | integer,intent(in),optional :: chunk_size !! chunk size for expanding arrays. 2 | !! if not present, default is 100. 3 | 4 | integer :: i !! counter 5 | integer :: n !! number of unique elements 6 | integer :: chunk !! chunk size to use 7 | 8 | if (present(chunk_size)) then 9 | chunk = abs(chunk_size) 10 | else 11 | chunk = 100 12 | end if 13 | 14 | allocate(tmp(size(vec)), source = vec) 15 | 16 | ! first we sort it: 17 | call sort_ascending(tmp) 18 | 19 | ! add the first element: 20 | n = 1 21 | allocate(vec_unique(1), source = tmp(1)) 22 | 23 | ! walk through array and get the unique ones: 24 | if (size(tmp)>1) then 25 | do i = 2, size(tmp) 26 | if (.not. tmp(i)==tmp(i-1)) then 27 | call expand_vector(vec_unique,n,chunk,val=tmp(i)) 28 | end if 29 | end do 30 | call expand_vector(vec_unique,n,chunk,finished=.true.) 31 | end if 32 | -------------------------------------------------------------------------------- /src/expand_vector.inc: -------------------------------------------------------------------------------- 1 | integer,intent(inout) :: n !! counter for last element added to `vec`. 2 | !! must be initialized to `size(vec)` 3 | !! (or 0 if not allocated) before first call 4 | integer,intent(in) :: chunk_size !! allocate `vec` in blocks of this size (>0) 5 | logical,intent(in),optional :: finished !! set to true to return `vec` 6 | !! as its correct size (`n`) 7 | 8 | integer :: i !! counter 9 | 10 | if (present(val)) then 11 | if (n==size(vec)) then 12 | ! have to add another chunk: 13 | allocate(tmp(size(vec)+chunk_size), mold=vec) 14 | do i=1,size(vec) 15 | tmp(i) = vec(i) 16 | end do 17 | call move_alloc(tmp,vec) 18 | end if 19 | n = n + 1 20 | vec(n) = val 21 | end if 22 | 23 | if (present(finished)) then 24 | if (finished) then 25 | ! set vec to actual size (n): 26 | if (allocated(tmp)) deallocate(tmp) 27 | allocate(tmp(n), mold=vec) 28 | do i=1,n 29 | tmp(i) = vec(i) 30 | end do 31 | call move_alloc(tmp,vec) 32 | end if 33 | end if 34 | -------------------------------------------------------------------------------- /src/binary_search.inc: -------------------------------------------------------------------------------- 1 | integer :: jloc !! the first matched index in `vec` 2 | !! (if not found, 0 is returned) 3 | 4 | integer :: j,k,khi,klo,n 5 | 6 | n = size(vec) 7 | jloc = 0 8 | 9 | if ( nval) then 18 | exit ! error 19 | end if 20 | end do 21 | 22 | else 23 | 24 | klo = 1 25 | khi = n 26 | k = (klo+khi+1)/2 27 | do 28 | j = k 29 | if ( valilow ) then 19 | 20 | ! do insertion sort: 21 | do i = ilow + 1,ihigh 22 | do j = i,ilow + 1,-1 23 | if ( vec(j) < vec(j-1) ) then 24 | call swap(vec(j),vec(j-1)) 25 | else 26 | exit 27 | end if 28 | end do 29 | end do 30 | 31 | else if ( ihigh-ilow>max_size_for_insertion_sort ) then 32 | 33 | ! do the normal quicksort: 34 | call partition(ilow,ihigh,ipivot) 35 | call quicksort(ilow,ipivot - 1) 36 | call quicksort(ipivot + 1,ihigh) 37 | 38 | end if 39 | 40 | end subroutine quicksort 41 | 42 | subroutine partition(ilow,ihigh,ipivot) 43 | 44 | !! Partition the array 45 | 46 | implicit none 47 | 48 | integer,intent(in) :: ilow 49 | integer,intent(in) :: ihigh 50 | integer,intent(out) :: ipivot 51 | 52 | integer :: i,ip 53 | 54 | call swap(vec(ilow),vec((ilow+ihigh)/2)) 55 | ip = ilow 56 | do i = ilow + 1, ihigh 57 | if ( vec(i) < vec(ilow) ) then 58 | ip = ip + 1 59 | call swap(vec(ip),vec(i)) 60 | end if 61 | end do 62 | call swap(vec(ilow),vec(ip)) 63 | ipivot = ip 64 | 65 | end subroutine partition 66 | -------------------------------------------------------------------------------- /src/sort_descending.inc: -------------------------------------------------------------------------------- 1 | call quicksort(1,size(vec)) 2 | 3 | contains 4 | 5 | recursive subroutine quicksort(ilow,ihigh) 6 | 7 | !! Sort the array (descending order). 8 | 9 | implicit none 10 | 11 | integer,intent(in) :: ilow 12 | integer,intent(in) :: ihigh 13 | 14 | integer :: ipivot !! pivot element 15 | integer :: i !! counter 16 | integer :: j !! counter 17 | 18 | if ( ihigh-ilow<=max_size_for_insertion_sort .and. ihigh>ilow ) then 19 | 20 | ! do insertion sort: 21 | do i = ilow + 1,ihigh 22 | do j = i,ilow + 1,-1 23 | if ( vec(j) > vec(j-1) ) then 24 | call swap(vec(j),vec(j-1)) 25 | else 26 | exit 27 | end if 28 | end do 29 | end do 30 | 31 | else if ( ihigh-ilow>max_size_for_insertion_sort ) then 32 | 33 | ! do the normal quicksort: 34 | call partition(ilow,ihigh,ipivot) 35 | call quicksort(ilow,ipivot - 1) 36 | call quicksort(ipivot + 1,ihigh) 37 | 38 | end if 39 | 40 | end subroutine quicksort 41 | 42 | subroutine partition(ilow,ihigh,ipivot) 43 | 44 | !! Partition the array 45 | 46 | implicit none 47 | 48 | integer,intent(in) :: ilow 49 | integer,intent(in) :: ihigh 50 | integer,intent(out) :: ipivot 51 | 52 | integer :: i,ip 53 | 54 | call swap(vec(ilow),vec((ilow+ihigh)/2)) 55 | ip = ilow 56 | do i = ilow + 1, ihigh 57 | if ( vec(i) > vec(ilow) ) then 58 | ip = ip + 1 59 | call swap(vec(ip),vec(i)) 60 | end if 61 | end do 62 | call swap(vec(ilow),vec(ip)) 63 | ipivot = ip 64 | 65 | end subroutine partition 66 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ### Status 2 | 3 | [![GitHub release](https://img.shields.io/github/release/jacobwilliams/fortran-search-and-sort.svg?style=plastic)](https://github.com/jacobwilliams/fortran-search-and-sort/releases/latest) 4 | [![CI Status](https://github.com/jacobwilliams/fortran-search-and-sort/actions/workflows/CI.yml/badge.svg)](https://github.com/jacobwilliams/fortran-search-and-sort/actions) 5 | [![codecov](https://codecov.io/gh/jacobwilliams/fortran-search-and-sort/branch/master/graph/badge.svg?token=43HK33CSMY)](https://codecov.io/gh/jacobwilliams/fortran-search-and-sort) 6 | 7 | ### Description 8 | 9 | Basic sorting and searching routines for vectors. 10 | 11 | Supports integer & real vectors, and vectors extended from the abstract `item` class. 12 | 13 | Includes the routines: 14 | 15 | * `function unique(vec)` 16 | * `function binary_search(val,vec)` 17 | * `subroutine sort_ascending(vec)` 18 | * `subroutine sort_descending(vec)` 19 | 20 | ### Compiling 21 | 22 | The library and test program will build with any modern Fortran compiler. A [Fortran Package Manager](https://github.com/fortran-lang/fpm) manifest file (`fpm.toml`) is included, so that the library and tests cases can be compiled with FPM. For example: 23 | 24 | ```text 25 | fpm build --profile release 26 | fpm test --profile release 27 | ``` 28 | 29 | To use `fortran-search-and-sort` within your FPM project, add the following to your `fpm.toml` file: 30 | ```toml 31 | [dependencies] 32 | fortran-search-and-sort = { git="https://github.com/jacobwilliams/fortran-search-and-sort.git" } 33 | ``` 34 | 35 | To generate the documentation using [ford](https://github.com/Fortran-FOSS-Programmers/ford), run: 36 | 37 | ```text 38 | ford ford.md 39 | ``` 40 | 41 | ### Documentation 42 | 43 | The latest API documentation can be found [here](https://jacobwilliams.github.io/fortran-search-and-sort/). This was generated from the source code using [FORD](https://github.com/Fortran-FOSS-Programmers/ford). 44 | 45 | 46 | ### See also 47 | 48 | * [stringsort](https://github.com/jacobwilliams/stringsort) -- Sorting routines for strings. 49 | -------------------------------------------------------------------------------- /test/int_type_module.f90: -------------------------------------------------------------------------------- 1 | 2 | module int_type_module 3 | 4 | use sorting_module 5 | 6 | implicit none 7 | 8 | private 9 | 10 | type,extends(item),public :: myint 11 | integer :: i = 0 12 | contains 13 | procedure :: greater_than => int_greater_than 14 | procedure :: less_than => int_less_than 15 | procedure :: equal_to => int_equal_to 16 | procedure :: assign_equal => int_assign_equal 17 | end type myint 18 | interface myint 19 | module procedure :: int_constructor 20 | end interface 21 | 22 | contains 23 | 24 | function int_constructor(i) 25 | implicit none 26 | type(myint) :: int_constructor 27 | integer,intent(in) :: i 28 | int_constructor%i = i 29 | end function int_constructor 30 | 31 | subroutine int_assign_equal(v1,v2) 32 | implicit none 33 | class(myint),intent(out) :: v1 34 | class(item),intent(in) :: v2 35 | select type(v2) 36 | class is (myint) 37 | v1%i = v2%i 38 | class default 39 | !error stop 'assignment not defined' 40 | end select 41 | end subroutine int_assign_equal 42 | 43 | function int_greater_than(v1,v2) result(gt) 44 | implicit none 45 | class(myint),intent(in) :: v1 46 | class(item),intent(in) :: v2 47 | logical :: gt 48 | select type(v2) 49 | class is (myint) 50 | gt = v1%i > v2%i 51 | class default 52 | !error stop '> operator not defined' 53 | end select 54 | end function int_greater_than 55 | 56 | function int_less_than(v1,v2) result(lt) 57 | implicit none 58 | class(myint),intent(in) :: v1 59 | class(item),intent(in) :: v2 60 | logical :: lt 61 | select type(v2) 62 | class is (myint) 63 | lt = v1%i < v2%i 64 | class default 65 | !error stop '< operator not defined' 66 | end select 67 | end function int_less_than 68 | 69 | function int_equal_to(v1,v2) result(eq) 70 | implicit none 71 | class(myint),intent(in) :: v1 72 | class(item),intent(in) :: v2 73 | logical :: eq 74 | select type(v2) 75 | class is (myint) 76 | eq = v1%i == v2%i 77 | class default 78 | !error stop '== operator not defined' 79 | end select 80 | end function int_equal_to 81 | 82 | end module int_type_module 83 | -------------------------------------------------------------------------------- /test/intvec_type_module.f90: -------------------------------------------------------------------------------- 1 | 2 | module intvec_type_module 3 | 4 | use sorting_module 5 | 6 | implicit none 7 | 8 | private 9 | 10 | type,extends(item),public :: intvec 11 | integer,dimension(4) :: i = [0,0,0,0] 12 | contains 13 | procedure :: greater_than => intvec_greater_than 14 | procedure :: less_than => intvec_less_than 15 | procedure :: equal_to => intvec_equal_to 16 | procedure :: assign_equal => intvec_assign_equal,& 17 | intvec_assign_equal_vec 18 | end type intvec 19 | 20 | contains 21 | 22 | subroutine intvec_assign_equal(v1,v2) 23 | implicit none 24 | class(intvec),intent(out) :: v1 25 | class(item),intent(in) :: v2 26 | select type(v2) 27 | class is (intvec) 28 | v1%i = v2%i 29 | class default 30 | error stop 'assignment not defined' 31 | end select 32 | end subroutine intvec_assign_equal 33 | 34 | subroutine intvec_assign_equal_vec(v1,v2) ! doesn't work? 35 | implicit none ! 36 | class(intvec),intent(out) :: v1 ! 37 | integer,dimension(4),intent(in) :: v2 ! 38 | v1%i = v2 ! 39 | end subroutine intvec_assign_equal_vec ! 40 | 41 | function intvec_greater_than(v1,v2) result(gt) 42 | implicit none 43 | class(intvec),intent(in) :: v1 44 | class(item),intent(in) :: v2 45 | logical :: gt 46 | integer :: i !! counter 47 | select type(v2) 48 | class is (intvec) 49 | if (v1 == v2) then 50 | gt = .false. 51 | else 52 | do i=1,size(v1%i) 53 | if (v1%i(i)==v2%i(i)) then 54 | cycle 55 | elseif (v1%i(i)>v2%i(i)) then 56 | gt = .true. 57 | return 58 | else 59 | gt = .false. 60 | return 61 | end if 62 | end do 63 | end if 64 | class default 65 | error stop '> operator not defined' 66 | end select 67 | end function intvec_greater_than 68 | 69 | function intvec_less_than(v1,v2) result(lt) 70 | implicit none 71 | class(intvec),intent(in) :: v1 72 | class(item),intent(in) :: v2 73 | logical :: lt 74 | lt = (.not.(v1==v2)) .and. (.not.(v1>v2)) 75 | end function intvec_less_than 76 | 77 | function intvec_equal_to(v1,v2) result(eq) 78 | implicit none 79 | class(intvec),intent(in) :: v1 80 | class(item),intent(in) :: v2 81 | logical :: eq 82 | select type(v2) 83 | class is (intvec) 84 | eq = all(v1%i == v2%i) 85 | class default 86 | error stop '== operator not defined' 87 | end select 88 | end function intvec_equal_to 89 | 90 | end module intvec_type_module 91 | -------------------------------------------------------------------------------- /.github/workflows/CI.yml: -------------------------------------------------------------------------------- 1 | name: CI 2 | on: [push] 3 | jobs: 4 | 5 | Build: 6 | runs-on: ${{ matrix.os }} 7 | permissions: 8 | contents: write 9 | strategy: 10 | fail-fast: false 11 | matrix: 12 | os: [ubuntu-latest] 13 | gcc_v: [10] # Version of GFortran we want to use. 14 | python-version: [3.9] 15 | env: 16 | FC: gfortran-${{ matrix.gcc_v }} 17 | GCC_V: ${{ matrix.gcc_v }} 18 | 19 | steps: 20 | - name: Checkout code 21 | uses: actions/checkout@v3 22 | with: 23 | submodules: recursive 24 | 25 | - name: Install Python 26 | uses: actions/setup-python@v4 # Use pip to install latest CMake, & FORD/Jin2For, etc. 27 | with: 28 | python-version: ${{ matrix.python-version }} 29 | 30 | - name: Setup Graphviz 31 | uses: ts-graphviz/setup-graphviz@v1 32 | 33 | - name: Setup Fortran Package Manager 34 | uses: fortran-lang/setup-fpm@v5 35 | with: 36 | github-token: ${{ secrets.GITHUB_TOKEN }} 37 | 38 | - name: Install Python dependencies 39 | if: contains( matrix.os, 'ubuntu') 40 | run: | 41 | python -m pip install --upgrade pip 42 | pip install numpy matplotlib ford 43 | if [ -f requirements.txt ]; then pip install -r requirements.txt; fi 44 | 45 | - name: Install GFortran Linux 46 | if: contains( matrix.os, 'ubuntu') 47 | run: | 48 | sudo apt-get install lcov 49 | sudo add-apt-repository ppa:ubuntu-toolchain-r/test 50 | sudo apt-get update 51 | sudo apt-get install -y gcc-${{ matrix.gcc_v }} gfortran-${{ matrix.gcc_v }} 52 | sudo update-alternatives \ 53 | --install /usr/bin/gcc gcc /usr/bin/gcc-${{ matrix.gcc_v }} 100 \ 54 | --slave /usr/bin/gfortran gfortran /usr/bin/gfortran-${{ matrix.gcc_v }} \ 55 | --slave /usr/bin/gcov gcov /usr/bin/gcov-${{ matrix.gcc_v }} 56 | 57 | # - name: Compile 58 | # run: fpm build --profile release 59 | 60 | - name: Run tests 61 | run: fpm test --profile debug --flag -coverage 62 | 63 | - name: Create coverage report 64 | run: | 65 | mkdir -p ${{ env.COV_DIR }} 66 | mv ./build/gfortran_*/*/* ${{ env.COV_DIR }} 67 | lcov --capture --initial --base-directory . --directory ${{ env.COV_DIR }} --output-file ${{ env.COV_DIR }}/coverage.base 68 | lcov --capture --base-directory . --directory ${{ env.COV_DIR }} --output-file ${{ env.COV_DIR }}/coverage.capture 69 | lcov --add-tracefile ${{ env.COV_DIR }}/coverage.base --add-tracefile ${{ env.COV_DIR }}/coverage.capture --output-file ${{ env.COV_DIR }}/coverage.info 70 | env: 71 | COV_DIR: build/coverage 72 | 73 | - name: Upload coverage report 74 | uses: codecov/codecov-action@v3 75 | with: 76 | files: build/coverage/coverage.info 77 | 78 | - name: Build documentation 79 | run: ford ./ford.md 80 | 81 | - name: Deploy Documentation 82 | if: github.ref == 'refs/heads/master' 83 | uses: JamesIves/github-pages-deploy-action@v4.4.1 84 | with: 85 | branch: gh-pages # The branch the action should deploy to. 86 | folder: doc # The folder the action should deploy. 87 | -------------------------------------------------------------------------------- /test/test.f90: -------------------------------------------------------------------------------- 1 | 2 | program test 3 | 4 | use sorting_module 5 | use int_type_module 6 | use intvec_type_module 7 | 8 | implicit none 9 | 10 | integer,dimension(10) :: integer_list 11 | type(myint),dimension(10) :: list 12 | type(intvec),dimension(24) :: listvec 13 | 14 | class(item),dimension(:),allocatable :: unique_elements 15 | integer :: i,j 16 | type(intvec) :: aa,bb 17 | integer,dimension(:),allocatable :: unique_integer_elements 18 | 19 | integer_list = [9,77,1,2,3,10,2,6,1,1] 20 | 21 | !listvec(1 ) = [ 7,20,31,9 ] ! intvec_assign_equal_vec ... doesn't work? 22 | 23 | listvec(1 )%i = [ 7,20,31,9 ] 24 | listvec(2 )%i = [ 3,22,36,8 ] 25 | listvec(3 )%i = [ 3,22,35,7 ] 26 | listvec(4 )%i = [ 3,22,33,6 ] 27 | listvec(5 )%i = [ 3,22,31,5 ] 28 | listvec(6 )%i = [ 3,20,36,4 ] 29 | listvec(7 )%i = [ 3,20,35,3 ] 30 | listvec(8 )%i = [ 8,22,36,24 ] 31 | listvec(9 )%i = [ 8,22,35,23 ] 32 | listvec(10)%i = [ 8,22,33,22 ] 33 | listvec(11)%i = [ 8,22,31,21 ] 34 | listvec(12)%i = [ 8,20,36,20 ] 35 | listvec(13)%i = [ 3,20,33,2 ] 36 | listvec(14)%i = [ 8,20,35,19 ] 37 | listvec(15)%i = [ 8,20,33,18 ] 38 | listvec(16)%i = [ 8,20,31,17 ] 39 | listvec(17)%i = [ 7,22,36,16 ] 40 | listvec(18)%i = [ 7,22,35,15 ] 41 | listvec(19)%i = [ 7,22,33,14 ] 42 | listvec(20)%i = [ 7,22,31,13 ] 43 | listvec(21)%i = [ 7,20,36,12 ] 44 | listvec(22)%i = [ 7,20,35,11 ] 45 | listvec(23)%i = [ 7,20,33,10 ] 46 | listvec(24)%i = [ 3,20,31,1 ] 47 | 48 | !list = int([9,77,1,2,3,10,2,6,1,1]) ! how to make this happen? 49 | list%i = int([9,77,1,2,3,10,2,6,1,1]) 50 | 51 | write(*,*) '' 52 | write(*,*) 'original list:' 53 | write(*,*) list 54 | 55 | call sort_ascending(list) 56 | 57 | write(*,*) '' 58 | write(*,*) 'sorted list:' 59 | write(*,*) list 60 | 61 | call unique(list,unique_elements) 62 | 63 | select type (unique_elements) 64 | type is (myint) 65 | write(*,*) '' 66 | write(*,*) 'unique elements:' 67 | write(*,*) unique_elements 68 | end select 69 | 70 | write(*,*) '' 71 | write(*,*) 'binary search:' 72 | do i=1,size(unique_elements) 73 | j = binary_search(unique_elements(i),unique_elements) 74 | write(*,*) j 75 | end do 76 | 77 | write(*,*) '' 78 | write(*,*) '----------' 79 | write(*,*) '' 80 | write(*,*) ' listvec: ' 81 | write(*,*) '' 82 | write(*,*) 'original list:' 83 | do i=1,size(listvec) 84 | write(*,'(*(I2,1X))') listvec(i)%i 85 | end do 86 | 87 | call sort_ascending(listvec) 88 | 89 | write(*,*) '' 90 | write(*,*) 'sorted list:' 91 | do i=1,size(listvec) 92 | write(*,'(*(I2,1X))') listvec(i)%i 93 | end do 94 | 95 | write(*,*) '' 96 | aa%i = [ 8,20,36,20 ] 97 | bb%i = [ 3,22,31,5 ] 98 | write(*,*) 'aabb', aa>bb 100 | write(*,*) 'aa==bb', aa==bb 101 | 102 | write(*,*) '' 103 | write(*,*) '-------------------------' 104 | write(*,*) '' 105 | write(*,*) ' integer list: ' 106 | write(*,*) '' 107 | 108 | write(*,*) '' 109 | write(*,*) 'original list:' 110 | write(*,*) integer_list 111 | 112 | call sort_descending(integer_list) 113 | write(*,*) '' 114 | write(*,*) 'sorted list (descending):' 115 | write(*,*) integer_list 116 | 117 | call sort_ascending(integer_list) 118 | write(*,*) '' 119 | write(*,*) 'sorted list (ascending):' 120 | write(*,*) integer_list 121 | 122 | call unique(integer_list,unique_integer_elements) 123 | write(*,*) '' 124 | write(*,*) 'unique elements:' 125 | write(*,*) unique_integer_elements 126 | 127 | write(*,*) '' 128 | write(*,*) 'binary search:' 129 | do i=1,size(unique_integer_elements) 130 | j = binary_search(unique_integer_elements(i),unique_integer_elements) 131 | write(*,*) j 132 | end do 133 | 134 | end program test 135 | -------------------------------------------------------------------------------- /src/sorting_module.f90: -------------------------------------------------------------------------------- 1 | !******************************************************************************* 2 | !> author: Jacob Williams 3 | ! 4 | ! Generic searching and sorting routines. 5 | 6 | module sorting_module 7 | 8 | use iso_fortran_env 9 | 10 | implicit none 11 | 12 | private 13 | 14 | type,abstract,public :: item 15 | !! An item to be sorted or searched. 16 | !! 17 | !! User has to define the operator and assignment functions. 18 | contains 19 | private 20 | generic,public :: operator(>) => greater_than 21 | generic,public :: operator(<) => less_than 22 | generic,public :: operator(==) => equal_to 23 | generic,public :: assignment(=) => assign_equal 24 | procedure(greater_than_func),deferred,public :: greater_than 25 | procedure(less_than_func),deferred,public :: less_than 26 | procedure(equal_to_func),deferred,public :: equal_to 27 | procedure(assign_equal_func),deferred,public :: assign_equal 28 | end type item 29 | 30 | abstract interface 31 | subroutine assign_equal_func(v1,v2) 32 | import :: item 33 | implicit none 34 | class(item),intent(out) :: v1 35 | class(item),intent(in) :: v2 36 | end subroutine assign_equal_func 37 | function greater_than_func(v1,v2) result(gt) 38 | import :: item 39 | implicit none 40 | class(item),intent(in) :: v1 41 | class(item),intent(in) :: v2 42 | logical :: gt 43 | end function greater_than_func 44 | function less_than_func(v1,v2) result(lt) 45 | import :: item 46 | implicit none 47 | class(item),intent(in) :: v1 48 | class(item),intent(in) :: v2 49 | logical :: lt 50 | end function less_than_func 51 | function equal_to_func(v1,v2) result(eq) 52 | import :: item 53 | implicit none 54 | class(item),intent(in) :: v1 55 | class(item),intent(in) :: v2 56 | logical :: eq 57 | end function equal_to_func 58 | end interface 59 | 60 | integer,parameter :: max_size_for_insertion_sort = 20 !! max size for using insertion sort. 61 | !! (otherwise, use quicksort) 62 | integer,parameter :: min_size_for_binary_search = 16 !! min size for using binary search 63 | !! (otherwise, use sequential search) 64 | 65 | interface expand_vector 66 | !! Add elements to a vector in chunks. 67 | procedure :: item_expand_vector,& 68 | int32_expand_vector,int64_expand_vector,& 69 | real64_expand_vector,real32_expand_vector 70 | end interface expand_vector 71 | interface swap 72 | !! Swap two values. 73 | procedure :: item_swap,& 74 | int32_swap,int64_swap,& 75 | real64_swap,real32_swap 76 | end interface swap 77 | interface unique 78 | !! Returns only the unique elements of the vector. 79 | procedure :: item_unique,& 80 | int32_unique,int64_unique,& 81 | real64_unique,real32_unique 82 | end interface unique 83 | interface sort_ascending 84 | !! Sorts an array in increasing order. 85 | !! 86 | !! Uses a basic recursive quicksort 87 | !! (with insertion sort for partitions with \(\le\) 20 elements). 88 | !! Replaces the original array. 89 | procedure :: item_sort_ascending,& 90 | int32_sort_ascending,int64_sort_ascending,& 91 | real64_sort_ascending,real32_sort_ascending 92 | end interface sort_ascending 93 | interface sort_descending 94 | !! Sorts an array in decreasing order. 95 | !! 96 | !! Uses a basic recursive quicksort 97 | !! (with insertion sort for partitions with \(\le\) 20 elements). 98 | !! Replaces the original array. 99 | procedure :: item_sort_descending,& 100 | int32_sort_descending,int64_sort_descending,& 101 | real64_sort_descending,real32_sort_descending 102 | end interface sort_descending 103 | interface binary_search 104 | !! Binary search of a sorted array. 105 | !! (assumed to be in ascending order) 106 | procedure :: item_binary_search,& 107 | int32_binary_search,int64_binary_search,& 108 | real64_binary_search,real32_binary_search 109 | end interface binary_search 110 | 111 | public :: expand_vector 112 | public :: unique 113 | public :: sort_ascending 114 | public :: sort_descending 115 | public :: binary_search 116 | 117 | contains 118 | !******************************************************************************* 119 | 120 | include 'item_routines.inc' 121 | include 'int32_routines.inc' 122 | include 'int64_routines.inc' 123 | include 'real32_routines.inc' 124 | include 'real64_routines.inc' 125 | 126 | !******************************************************************************* 127 | end module sorting_module 128 | !******************************************************************************* 129 | --------------------------------------------------------------------------------