operator(/=) Interface

public interface operator(/=)

Returns .true. if not all bits in set1 and set2 have the same value, .false. otherwise. The sets must have the same number of bits otherwise the result is undefined. (Specification)

Example

    program example_inequality
        use stdlib_bitsets
        type(bitset_64) :: set0, set1, set2
        call set0 % init( 33 )
        call set1 % init( 33 )
        call set2 % init( 33 )
        call set1 % set( 0 )
        call set2 % set( 32 )
        if ( set0 /= set1 .and. set0 /= set2 .and. set1 /= set2 .and. &
            .not. set0 /= set0 .and. .not. set1 /= set1 .and. .not.   &
            set2 /= set2 ) then
            write(*,*) 'Passed 64 bit inequality tests.'
        else
            error stop 'Failed 64 bit inequality tests.'
        end if
    end program example_inequality

Contents


Functions

private elemental module function neqv_64(set1, set2) result(neqv)

Arguments

TypeIntentOptionalAttributesName
type(bitset_64), intent(in) :: set1
type(bitset_64), intent(in) :: set2

Return Value logical

private elemental module function neqv_large(set1, set2) result(neqv)

Arguments

TypeIntentOptionalAttributesName
type(bitset_large), intent(in) :: set1
type(bitset_large), intent(in) :: set2

Return Value logical