util_mod_comparisons.F90 Source File

#if !defined(SX)

module util_mod_comparisons_int
    use constants
    use helem
    use SystemData, only: Symmetry, operator(.eq.), operator(.ne.), &
                          operator(.gt.), operator(.lt.)
    use symdata, only: SymPairProd, operator(.eq.), operator(.ne.), &
                       operator(.gt.), operator(.lt.)
    implicit none
    private
    public :: operator(.arrgt.), operator(.arrlt.)
    public :: arr_lt, arr_gt

    ! Operator and function to test if arr1 > arr2 (if the first differing
    ! element is larger)
    interface operator(.arrgt.)
        module procedure arr_gt_int
    end interface


    ! Operator and function to test if arr1 < arr2 (if the first differing
    ! element is larger)
    interface operator(.arrlt.)
        module procedure arr_lt_int
    end interface

    interface arr_gt
        module procedure arr_gt_int
    end interface

    interface arr_lt
        module procedure arr_lt_int
    end interface

contains
    pure function arr_gt_int (a, b) result (bGt)

        ! Make a comparison we can sort arrays by. Return true if the
        ! first differing items of a, b is such that a(i) > b(i).
        !
        ! In:  a, b - The arrays to compare
        ! Ret: bGt  - a > b

        integer(kind=int32), intent(in), dimension(:) :: a, b
        logical :: bGt
        integer :: i, length

        length = min(size(a), size(b))

        ! Sort by the first item first...
        ! Use > and < comparison, not ==, so that it works with all types (don't want to compare reals)
        do i = 1, length
            if (a(i) > b(i) .or. a(i) < b(i)) exit
        enddo

        ! Make the comparison
        if (i > length) then
            bGt = .false.
        else
            bGt = a(i) > b(i)
        endif
    end function

    pure function arr_lt_int (a, b) result (bLt)

        ! Make a comparison we can sort arrays by. Return true if the first
        ! differing items of a, b is such that a(i) < b(i).
        !
        ! In:  a, b - The arrays to compare
        ! Ret: bLt  - a < b

        integer(kind=int32), intent(in), dimension(:) :: a, b
        logical :: bLt
        integer :: I, length

        length = min(size(a), size(b))

        ! Sort by the first item first...
        ! Use > and < comparison, not ==, so that it works with all types (don't want to compare reals)
        do i = 1, length
            if (a(i) > b(i) .or. a(i) < b(i)) exit
        enddo

        ! Make the comparison
        if (i > length) then
            bLt = .false.
        else
            bLt = a(i) < b(i)
        endif
    end function


end module

#endif



module util_mod_comparisons_int64
    use constants
    use helem
    use SystemData, only: Symmetry, operator(.eq.), operator(.ne.), &
                          operator(.gt.), operator(.lt.)
    use symdata, only: SymPairProd, operator(.eq.), operator(.ne.), &
                       operator(.gt.), operator(.lt.)
    implicit none
    private
    public :: operator(.arrgt.), operator(.arrlt.)
    public :: arr_lt, arr_gt

    ! Operator and function to test if arr1 > arr2 (if the first differing
    ! element is larger)
    interface operator(.arrgt.)
        module procedure arr_gt_int64
    end interface


    ! Operator and function to test if arr1 < arr2 (if the first differing
    ! element is larger)
    interface operator(.arrlt.)
        module procedure arr_lt_int64
    end interface

    interface arr_gt
        module procedure arr_gt_int64
    end interface

    interface arr_lt
        module procedure arr_lt_int64
    end interface

contains
    pure function arr_gt_int64 (a, b) result (bGt)

        ! Make a comparison we can sort arrays by. Return true if the
        ! first differing items of a, b is such that a(i) > b(i).
        !
        ! In:  a, b - The arrays to compare
        ! Ret: bGt  - a > b

        integer(kind=int64), intent(in), dimension(:) :: a, b
        logical :: bGt
        integer :: i, length

        length = min(size(a), size(b))

        ! Sort by the first item first...
        ! Use > and < comparison, not ==, so that it works with all types (don't want to compare reals)
        do i = 1, length
            if (a(i) > b(i) .or. a(i) < b(i)) exit
        enddo

        ! Make the comparison
        if (i > length) then
            bGt = .false.
        else
            bGt = a(i) > b(i)
        endif
    end function

    pure function arr_lt_int64 (a, b) result (bLt)

        ! Make a comparison we can sort arrays by. Return true if the first
        ! differing items of a, b is such that a(i) < b(i).
        !
        ! In:  a, b - The arrays to compare
        ! Ret: bLt  - a < b

        integer(kind=int64), intent(in), dimension(:) :: a, b
        logical :: bLt
        integer :: I, length

        length = min(size(a), size(b))

        ! Sort by the first item first...
        ! Use > and < comparison, not ==, so that it works with all types (don't want to compare reals)
        do i = 1, length
            if (a(i) > b(i) .or. a(i) < b(i)) exit
        enddo

        ! Make the comparison
        if (i > length) then
            bLt = .false.
        else
            bLt = a(i) < b(i)
        endif
    end function


end module


#if !defined(SX)

module util_mod_comparisons_real
    use constants
    use helem
    use SystemData, only: Symmetry, operator(.eq.), operator(.ne.), &
                          operator(.gt.), operator(.lt.)
    use symdata, only: SymPairProd, operator(.eq.), operator(.ne.), &
                       operator(.gt.), operator(.lt.)
    implicit none
    private
    public :: operator(.arrgt.), operator(.arrlt.)
    public :: arr_lt, arr_gt

    ! Operator and function to test if arr1 > arr2 (if the first differing
    ! element is larger)
    interface operator(.arrgt.)
        module procedure arr_gt_real
    end interface


    ! Operator and function to test if arr1 < arr2 (if the first differing
    ! element is larger)
    interface operator(.arrlt.)
        module procedure arr_lt_real
    end interface

    interface arr_gt
        module procedure arr_gt_real
    end interface

    interface arr_lt
        module procedure arr_lt_real
    end interface

contains
    pure function arr_gt_real (a, b) result (bGt)

        ! Make a comparison we can sort arrays by. Return true if the
        ! first differing items of a, b is such that a(i) > b(i).
        !
        ! In:  a, b - The arrays to compare
        ! Ret: bGt  - a > b

        real(kind=sp), intent(in), dimension(:) :: a, b
        logical :: bGt
        integer :: i, length

        length = min(size(a), size(b))

        ! Sort by the first item first...
        ! Use > and < comparison, not ==, so that it works with all types (don't want to compare reals)
        do i = 1, length
            if (a(i) > b(i) .or. a(i) < b(i)) exit
        enddo

        ! Make the comparison
        if (i > length) then
            bGt = .false.
        else
            bGt = a(i) > b(i)
        endif
    end function

    pure function arr_lt_real (a, b) result (bLt)

        ! Make a comparison we can sort arrays by. Return true if the first
        ! differing items of a, b is such that a(i) < b(i).
        !
        ! In:  a, b - The arrays to compare
        ! Ret: bLt  - a < b

        real(kind=sp), intent(in), dimension(:) :: a, b
        logical :: bLt
        integer :: I, length

        length = min(size(a), size(b))

        ! Sort by the first item first...
        ! Use > and < comparison, not ==, so that it works with all types (don't want to compare reals)
        do i = 1, length
            if (a(i) > b(i) .or. a(i) < b(i)) exit
        enddo

        ! Make the comparison
        if (i > length) then
            bLt = .false.
        else
            bLt = a(i) < b(i)
        endif
    end function


end module

#endif



module util_mod_comparisons_doub
    use constants
    use helem
    use SystemData, only: Symmetry, operator(.eq.), operator(.ne.), &
                          operator(.gt.), operator(.lt.)
    use symdata, only: SymPairProd, operator(.eq.), operator(.ne.), &
                       operator(.gt.), operator(.lt.)
    implicit none
    private
    public :: operator(.arrgt.), operator(.arrlt.)
    public :: arr_lt, arr_gt

    ! Operator and function to test if arr1 > arr2 (if the first differing
    ! element is larger)
    interface operator(.arrgt.)
        module procedure arr_gt_doub
    end interface


    ! Operator and function to test if arr1 < arr2 (if the first differing
    ! element is larger)
    interface operator(.arrlt.)
        module procedure arr_lt_doub
    end interface

    interface arr_gt
        module procedure arr_gt_doub
    end interface

    interface arr_lt
        module procedure arr_lt_doub
    end interface

contains
    pure function arr_gt_doub (a, b) result (bGt)

        ! Make a comparison we can sort arrays by. Return true if the
        ! first differing items of a, b is such that a(i) > b(i).
        !
        ! In:  a, b - The arrays to compare
        ! Ret: bGt  - a > b

        real(kind=dp), intent(in), dimension(:) :: a, b
        logical :: bGt
        integer :: i, length

        length = min(size(a), size(b))

        ! Sort by the first item first...
        ! Use > and < comparison, not ==, so that it works with all types (don't want to compare reals)
        do i = 1, length
            if (a(i) > b(i) .or. a(i) < b(i)) exit
        enddo

        ! Make the comparison
        if (i > length) then
            bGt = .false.
        else
            bGt = a(i) > b(i)
        endif
    end function

    pure function arr_lt_doub (a, b) result (bLt)

        ! Make a comparison we can sort arrays by. Return true if the first
        ! differing items of a, b is such that a(i) < b(i).
        !
        ! In:  a, b - The arrays to compare
        ! Ret: bLt  - a < b

        real(kind=dp), intent(in), dimension(:) :: a, b
        logical :: bLt
        integer :: I, length

        length = min(size(a), size(b))

        ! Sort by the first item first...
        ! Use > and < comparison, not ==, so that it works with all types (don't want to compare reals)
        do i = 1, length
            if (a(i) > b(i) .or. a(i) < b(i)) exit
        enddo

        ! Make the comparison
        if (i > length) then
            bLt = .false.
        else
            bLt = a(i) < b(i)
        endif
    end function


end module



module util_mod_comparisons_sym
    use constants
    use helem
    use SystemData, only: Symmetry, operator(.eq.), operator(.ne.), &
                          operator(.gt.), operator(.lt.)
    use symdata, only: SymPairProd, operator(.eq.), operator(.ne.), &
                       operator(.gt.), operator(.lt.)
    implicit none
    private
    public :: operator(.arrgt.), operator(.arrlt.)
    public :: arr_lt, arr_gt

    ! Operator and function to test if arr1 > arr2 (if the first differing
    ! element is larger)
    interface operator(.arrgt.)
        module procedure arr_gt_sym
    end interface


    ! Operator and function to test if arr1 < arr2 (if the first differing
    ! element is larger)
    interface operator(.arrlt.)
        module procedure arr_lt_sym
    end interface

    interface arr_gt
        module procedure arr_gt_sym
    end interface

    interface arr_lt
        module procedure arr_lt_sym
    end interface

contains
    pure function arr_gt_sym (a, b) result (bGt)

        ! Make a comparison we can sort arrays by. Return true if the
        ! first differing items of a, b is such that a(i) > b(i).
        !
        ! In:  a, b - The arrays to compare
        ! Ret: bGt  - a > b

        type(Symmetry), intent(in), dimension(:) :: a, b
        logical :: bGt
        integer :: i, length

        length = min(size(a), size(b))

        ! Sort by the first item first...
        ! Use > and < comparison, not ==, so that it works with all types (don't want to compare reals)
        do i = 1, length
            if (a(i) > b(i) .or. a(i) < b(i)) exit
        enddo

        ! Make the comparison
        if (i > length) then
            bGt = .false.
        else
            bGt = a(i) > b(i)
        endif
    end function

    pure function arr_lt_sym (a, b) result (bLt)

        ! Make a comparison we can sort arrays by. Return true if the first
        ! differing items of a, b is such that a(i) < b(i).
        !
        ! In:  a, b - The arrays to compare
        ! Ret: bLt  - a < b

        type(Symmetry), intent(in), dimension(:) :: a, b
        logical :: bLt
        integer :: I, length

        length = min(size(a), size(b))

        ! Sort by the first item first...
        ! Use > and < comparison, not ==, so that it works with all types (don't want to compare reals)
        do i = 1, length
            if (a(i) > b(i) .or. a(i) < b(i)) exit
        enddo

        ! Make the comparison
        if (i > length) then
            bLt = .false.
        else
            bLt = a(i) < b(i)
        endif
    end function


end module



module util_mod_comparisons_spp
    use constants
    use helem
    use SystemData, only: Symmetry, operator(.eq.), operator(.ne.), &
                          operator(.gt.), operator(.lt.)
    use symdata, only: SymPairProd, operator(.eq.), operator(.ne.), &
                       operator(.gt.), operator(.lt.)
    implicit none
    private
    public :: operator(.arrgt.), operator(.arrlt.)
    public :: arr_lt, arr_gt

    ! Operator and function to test if arr1 > arr2 (if the first differing
    ! element is larger)
    interface operator(.arrgt.)
        module procedure arr_gt_spp
    end interface


    ! Operator and function to test if arr1 < arr2 (if the first differing
    ! element is larger)
    interface operator(.arrlt.)
        module procedure arr_lt_spp
    end interface

    interface arr_gt
        module procedure arr_gt_spp
    end interface

    interface arr_lt
        module procedure arr_lt_spp
    end interface

contains
    pure function arr_gt_spp (a, b) result (bGt)

        ! Make a comparison we can sort arrays by. Return true if the
        ! first differing items of a, b is such that a(i) > b(i).
        !
        ! In:  a, b - The arrays to compare
        ! Ret: bGt  - a > b

        type(SymPairProd), intent(in), dimension(:) :: a, b
        logical :: bGt
        integer :: i, length

        length = min(size(a), size(b))

        ! Sort by the first item first...
        ! Use > and < comparison, not ==, so that it works with all types (don't want to compare reals)
        do i = 1, length
            if (a(i) > b(i) .or. a(i) < b(i)) exit
        enddo

        ! Make the comparison
        if (i > length) then
            bGt = .false.
        else
            bGt = a(i) > b(i)
        endif
    end function

    pure function arr_lt_spp (a, b) result (bLt)

        ! Make a comparison we can sort arrays by. Return true if the first
        ! differing items of a, b is such that a(i) < b(i).
        !
        ! In:  a, b - The arrays to compare
        ! Ret: bLt  - a < b

        type(SymPairProd), intent(in), dimension(:) :: a, b
        logical :: bLt
        integer :: I, length

        length = min(size(a), size(b))

        ! Sort by the first item first...
        ! Use > and < comparison, not ==, so that it works with all types (don't want to compare reals)
        do i = 1, length
            if (a(i) > b(i) .or. a(i) < b(i)) exit
        enddo

        ! Make the comparison
        if (i > length) then
            bLt = .false.
        else
            bLt = a(i) < b(i)
        endif
    end function


end module



module util_mod_comparisons
#if !defined(SX)
    use util_mod_comparisons_int
#endif
    use util_mod_comparisons_int64
#if !defined(SX)
    use util_mod_comparisons_real
#endif
    use util_mod_comparisons_doub
    use util_mod_comparisons_sym
    use util_mod_comparisons_spp
end module