multidip_util.f90

Go to the documentation of this file.

! Copyright 2023
!
! For a comprehensive list of the developers that contributed to these codes
! see the UK-AMOR website.
!
! This file is part of UKRmol-out (UKRmol+ suite).
!
!     UKRmol-out is free software: you can redistribute it and/or modify
!     it under the terms of the GNU General Public License as published by
!     the Free Software Foundation, either version 3 of the License, or
!     (at your option) any later version.
!
!     UKRmol-out is distributed in the hope that it will be useful,
!     but WITHOUT ANY WARRANTY; without even the implied warranty of
!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
!     GNU General Public License for more details.
!
!     You should have received a copy of the GNU General Public License
!     along with  UKRmol-out (in source/COPYING). Alternatively, you can also visit
!     <https://www.gnu.org/licenses/>.
!
module multidip_util
 
    use precisn_gbl, only: wp
 
    implicit none
 
    interface find_column
        procedure find_column_i
        procedure find_column_c
    end interface
 
    interface append_column
        procedure append_column_i
        procedure append_column_c
    end interface
 
contains
 
    integer function find_column_i (table, column) result (idx)
 
        integer, allocatable, intent(in) :: table(:, :)
        integer,              intent(in) :: column(:)
        integer                          :: icol
 
        idx = 0
 
        if (allocated(table)) then
            do icol = 1, size(table, 2)
                if (all(table(:, icol) == column(:))) then
                    idx = icol
                    return
                end if
            end do
        end if
 
    end function find_column_i
 
 
    integer function find_column_c (table, column) result (idx)
 
        complex(wp), allocatable, intent(in) :: table(:, :)
        complex(wp),              intent(in) :: column(:)
        integer                              :: icol
 
        idx = 0
 
        if (allocated(table)) then
            do icol = 1, size(table, 2)
                if (all(table(:, icol) == column(:))) then
                    idx = icol
                    return
                end if
            end do
        end if
 
    end function find_column_c
 
 
    integer function append_column_i (table, column) result (n)
 
        integer, allocatable, intent(inout) :: table(:, :)
        integer,              intent(in)    :: column(:)
        integer, allocatable                :: old_table(:, :)
        integer                             :: m
 
        m = size(column)
        if (.not. allocated(table)) then
            n = 1
            allocate (table(m, n))
            table(:, n) = column(:)
        else
            call move_alloc(table, old_table)
            n = 1 + size(old_table, 2)
            allocate (table(m, n))
            table(:, 1:n-1) = old_table(:, :)
            table(:, n) = column(:)
        end if
 
    end function append_column_i
 
 
    integer function append_column_c (table, column) result (n)
 
        complex(wp), allocatable, intent(inout) :: table(:, :)
        complex(wp),              intent(in)    :: column(:)
        complex(wp), allocatable                :: old_table(:, :)
        integer                                 :: m
 
        m = size(column)
        if (.not. allocated(table)) then
            n = 1
            allocate (table(m, n))
            table(:, n) = column(:)
        else
            n = 1 + size(table, 2)
            call move_alloc(table, old_table)
            allocate (table(m, n))
            table(:, 1:n-1) = old_table(:, :)
            table(:, n) = column(:)
        end if
 
    end function append_column_c
 
end module multidip_util