diff --git a/doc/specs/index.md b/doc/specs/index.md
index 91284c2df..c10818fa9 100644
--- a/doc/specs/index.md
+++ b/doc/specs/index.md
@@ -11,6 +11,7 @@ This is and index/directory of the specifications (specs) for each new module/fe
## Experimental Features & Modules
+ - [bitsets](./stdlib_bitsets.html) - Bitset data types and procedures
- [error](./stdlib_error.html) - Catching and handling errors
- [IO](./stdlib_io.html) - Input/output helper & convenience
- [linalg](./stdlib_linalg.html) - Linear Algebra
diff --git a/doc/specs/stdlib_bitsets.md b/doc/specs/stdlib_bitsets.md
new file mode 100644
index 000000000..ea8ddb2a7
--- /dev/null
+++ b/doc/specs/stdlib_bitsets.md
@@ -0,0 +1,2001 @@
+---
+title: Bitsets
+---
+
+# The `stdlib_bitsets` module
+
+[TOC]
+
+## Introduction
+
+The `stdlib_bitsets` module implements bitset types. A bitset is a
+compact representation of a sequence of `bits` binary values. It can
+equivalently be considered as a sequence of logical values or as a
+subset of the integers 0 ... `bits-1`. For example, the value `1110`
+can be considered as defining the subset of integers [1, 2, 3].
+The bits are indexed from 0 to `bits(bitset)-1`.
+A bitset is used when space savings are critical in applications
+that require a large number of closely related logical values.
+It may also improve performance by reducing memory traffic. To
+implement bitsets the module
+defines three bitset types, multiple constants, a character string
+literal that can be read to and from strings and formatted files, a
+simple character string literal that can be read to and from strings,
+assignments, procedures, methods, and operators. Note that the module
+assumes two's complement integers, but all current Fortran 95 and later
+processors use such integers.
+
+Note that the module defines a number of "binary" procedures,
+procedures with two bitset arguments. These arguments must be of the
+same type and should have the same number of `bits`. For reasons of
+performance the module does not enforce the `bits` constraint, but
+failure to obey that constraint results in undefined behavior. This
+undefined behavior includes undefined values for those bits that
+exceed the defined number of `bits` in the smaller bitset. The
+undefined behavior may also include a "segmentation fault" for
+attempting to address bits in the smaller bitset, beyond the defined
+number of `bits`. Other problems are also possible.
+
+
+## The module's constants
+
+The module defines several public integer constants, almost all
+intended to serve as error codes in reporting problems through an
+optional `stat` argument. One constant, `bits_kind` is
+the integer kind value for indexing bits and reporting counts of
+bits. The other constants that are error codes are summarized below:
+
+|Error Code|Summary|
+|----------|-------|
+|`success`|No problems found|
+|`alloc_fault`|Failure with a memory allocation|
+|`array_size_invalid_error`|Attempt to define either negative bits or more than 64 bits in a `bitset_64`|
+|`char_string_invalid_error`|Invalid character found in a character string|
+|`char_string_too_large_error`|Character string was too large to be encoded in the bitset|
+|`char_string_too_small_error`|Character string was too small to hold the expected number of bits|
+|`index_invalid_error`|Index to a bitstring was less than zero or greater than the number of bits|
+|`integer_overflow_error`|Attempt to define an integer value bigger than `huge(0_bits_kind`)|
+|`read_failure`|Failure on a `read` statement|
+|`eof_failure`|An unexpected "End-of-File" on a `read` statement|
+|`write_failure`|Failure on a `write` statement|
+
+
+## The `stdlib_bitsets` derived types
+
+The `stdlib_bitsets` module defines three derived types,
+`bitset_type`, `bitset_64`, and `bitset_large`. `bitset_type` is an abstract
+type that serves as the ancestor of `bitset_64` and
+`bitset_large`. `bitset_type` defines one method, `bits`, and all of its
+other methods are deferred to its extensions. `bitset_64` is a bitset
+that can handle up to 64 bits. `bitset_large` is a bitset that can handle
+up `huge(0_bits_kind)` bits. All attributes of the bitset types are
+private. The various types each define a sequence of binary values: 0
+or 1. In some cases it is useful to associate a logical value, `test`,
+for each element of the sequence, where `test` is `.true.` if the value
+is 1 and `.false.` otherwise. The number of such values in an entity
+of that type is to be termed, `bits`. The bits are ordered in terms of
+position, that, in turn, is indexed from 0 to `bits-1`. `bitset_type` is
+used only as a `class` to define entities that can be either a `bitset_64` or
+a `bitset_large`. The syntax for using the types are:
+
+`class([[stdlib_bitset(module):bitset_type(class)]]) :: variable`
+
+`type([[stdlib_bitset(module):bitset_64(type)]]) :: variable`
+
+and
+
+`type([[stdlib_bitset(module):bitset_large(type)]]) :: variable`
+
+## The *bitset-literal*
+
+A bitset value may be represented as a *bitset-literal-constant*
+character string in source code or as a *bitset-literal* in
+formatted files and non-constant strings.
+
+*bitset-literal-constant* is ' *bitset-literal* '
+ or " *bitset-literal* "
+
+*bitset-literal* is *bitsize-literal* *binary-literal*
+
+*bitsize-literal* is S *digit* [ *digit* ] ...
+
+*binary-literal* is B *binary-digit* [ *binary-digit* ] ...
+
+*digit* is 0
+ or 1
+ or 2
+ or 3
+ or 4
+ or 5
+ or 6
+ or 7
+ or 8
+ or 9
+
+
+*binary-digit* is 0
+ or 1
+
+The *bitset-literal* consists of two parts: a *bitsize-literal* and a
+*binary-literal*. The sequence of decimal digits that is part of the
+*bitsize-literal* is interpreted as the decimal value of `bits`.
+The *binary-literal* value is interpreted as a sequence of bit
+values and there must be as many binary digits in the literal as there
+are `bits`. The sequence of binary digits are treated as if they were
+an unsigned integer with the i-th digit corresponding to the `bits-i`
+bit position.
+
+## The *binary-literal*
+
+In defining the *bitset-literal* we also defined a
+*binary-literal*. While not suitable for file I/0, the
+*binary-literal* is suitable for transfer to and from character
+strings. In that case the length of the string is the number of bits
+and all characters in the string must be either "0" or "1".
+
+## Summary of the module's operations
+
+The `stdlib_bitsets` module defines a number of operations:
+* "unary" methods of class `bitset_type`,
+* "binary" procedure overloads of type `bitset_64` or `bitset_large`,
+* assignments, and
+* "binary" comparison operators of type `bitset_64` or `bitset_large`.
+
+Each category will be discussed separately.
+
+### Table of the `bitset_type` methods
+
+The `bitset_type` class has a number of methods. All except one, `bits`,
+are deferred. The methods consist of all procedures with one argument
+of class `bitset_type`. The procedures with two arguments of type
+`bitset_64` or `bitset_large` are not methods and are
+summarized in a separate table of procedures. The methods are
+summarized below:
+
+|Method name|Class|Summary|
+|-----------|-----|-------|
+|`all`|function|`.true.` if all bits are 1, `.false.` otherwise|
+|`any`|function|`.true.` if any bits are 1, `.false.` otherwise|
+|`bit_count`|function|returns the number of bits that are 1|
+|`bits`|function|returns the number of bits in the bitset|
+|`clear`|subroutine|sets a sequence of one or more bits to 0|
+|`flip`|subroutine|flips the value of a sequence of one or more bits|
+|`from_string`|subroutine|reads the bitset from a string treating it as a binary literal|
+|`init`|subroutine|creates a new bitset of size `bits` with no bits set|
+|`input`|subroutine|reads a bitset from an unformatted I/O unit|
+|`none`|function|`.true.` if no bits are 1, `.false.` otherwise|
+|`not`|subroutine|performs a logical `not` operation on all the bits|
+|`output`|subroutine|writes a bitset to an unformatted I/O unit|
+|`read_bitset`|subroutine|reads a bitset from a bitset literal in a character string or formatted I/O unit|
+|`set`|subroutine|sets a sequence of one or more bits to 1|
+|`test`|function|`.true.` if the bit at `pos` is 1, `.false.` otherwise|
+|`to_string`|subroutine|represents the bitset as a binary literal|
+|`value`|function|1 if the bit at `pos` is 1, 0 otherwise|
+|`write_bitset`|subroutine|writes a bitset as a bitset literal to a character string or formatted I/O unit|
+
+### Table of the non-member procedure overloads
+
+The procedures with two arguments of type `bitset_large` or
+`bitset_64` must have both arguments of the same known type which
+prevents them from being methods. The bitwise "logical" procedures,
+`and`, `and_not`, `or`, and `xor` also require that the two bitset
+arguments have the same number of bits, otherwise the results are
+undefined. These procedures are summarized in the following table:
+
+|Procedure name|Class|Summary|
+|--------------|-----|-------|
+|`and`|elemental subroutine|Sets `self` to the bitwise `and` of the original bits in `self` and `set2`|
+|`and_not`|elemental subroutine|Sets `self` to the bitwise `and` of the original bits in `self` and the negation of `set2`|
+|`extract`|subroutine|creates a new bitset, `new`, from a range in `old`|
+|`or`|elemental subroutine|Sets `self` to the bitwise `or` of the original bits in `self` and `set2`|
+|`xor`|elemental subroutine|Sets `self` to the bitwise exclusive `or` of the original bits in `self` and `set2`|
+
+
+### Assignments
+
+The module defines an assignment operation, `=`, that creates a
+duplicate of an original bitset. It also defines assignments to and
+from rank one arrays of logical type of kinds `int8`, `int16`,
+`int32`, and `int64`. In the assignment to and from logical arrays
+array index, `i`, is mapped to bit position, `pos=i-1`, and `.true.`
+is mapped to a set bit, and `.false.` is mapped to an unset bit.
+
+
+#### Example
+
+```fortran
+ program demo_assignment
+ use stdlib_bitsets
+ logical(int8) :: logical1(64) = .true.
+ logical(int32), allocatable :: logical2(:)
+ type(bitset_64) :: set0, set1
+ set0 = logical1
+ if ( set0 % bits() /= 64 ) then
+ error stop procedure // &
+ ' initialization with logical(int8) failed to set' // &
+ ' the right size.'
+ else if ( .not. set0 % all() ) then
+ error stop procedure // ' initialization with' // &
+ ' logical(int8) failed to set the right values.'
+ else
+ write(*,*) 'Initialization with logical(int8) succeeded.'
+ end if
+ set1 = set0
+ if ( set1 == set0 ) &
+ write(*,*) 'Initialization by assignment succeeded'
+ logical2 = set1
+ if ( all( logical2 ) ) then
+ write(*,*) 'Initialization of logical(int32) succeeded.'
+ end if
+ end program demo_assignment
+```
+
+### Table of the non-member comparison operations
+The comparison operators with two arguments of type `bitset_large` or
+`bitset_64` must have both arguments of the same known type which
+prevents them from being methods. The operands must also have the same
+number of bits otherwise the results are undefined. These operators
+are summarized in the following table:
+
+|Operator|Description|
+|--------|-----------|
+|`==`, `.eq.`|`.true.` if all bits in `set1` and `set2` have the same value, `.false.` otherwise|
+|`/=`, `.ne.`|`.true.` if any bits in `set1` and `set2` differ in value, `.false.` otherwise|
+|`>`, `.gt.`|`.true.` if the bits in `set1` and `set2` differ in value and the highest order differing bit is 1 in `set1` and 0 in `set2`, `.false.` otherwise|
+|`>=`, `.ge.`|`.true.` if the bits in `set1` and `set2` are the same or the highest order differing bit is 1 in `set1` and 0 in `set2`, `.false.` otherwise|
+|`<`, `.lt.`|`.true.` if the bits in `set1` and `set2` differ in value and the highest order differing bit is 0 in `set1` and 1 in `set2`, `.false.` otherwise|
+|`<=`, `.le.`|`.true.` if the bits in `set1` and `set2` are the same or the highest order differing bit is 0 in `set1` and 1 in `set2`, `.false.` otherwise|
+
+
+## Specification of the `stdlib_bitsets` methods and procedures
+
+### `all` - determine whether all bits are set in `self`.
+
+#### Status
+
+Experimental
+
+#### Description
+
+Determines whether all bits are set to 1 in `self`.
+
+#### Syntax
+
+`result = self % [[bitset_type(class):all(bound)]]()`
+
+#### Class
+
+Elemental function.
+
+#### Argument
+
+`self`: shall be a scalar expression of class `bitset_type`. It is an
+`intent(in)` argument.
+
+#### Result value
+
+The result is a default logical scalar.
+The result is `.true.` if all bits in `self` are set,
+otherwise it is `.false.`.
+
+#### Example
+
+```fortran
+ program demo_all
+ use stdlib_bitsets
+ character(*), parameter :: &
+ bits_all = '111111111111111111111111111111111'
+ type(bitset_64) :: set0
+ call set0 % from_string( bits_all )
+ if ( .not. set0 % all() ) then
+ error stop "FROM_STRING failed to interpret" // &
+ "BITS_ALL's value properly."
+ else
+ write(*,*) "FROM_STRING transferred BITS_ALL properly" // &
+ " into set0."
+ end if
+ end program demo_all
+```
+
+#### `and` - bitwise `and` of the bits of two bitsets.
+
+#### Status
+
+Experimental
+
+#### Description
+
+Sets the bits in `set1` to the bitwise `and` of the original bits in
+`set1` and `set2`. Note that `set1` and `set2` must have the same
+number of bits, otherwise the result is undefined.
+
+#### Syntax
+
+`call [[stdlib_bitsets(module):and(interface]] (set1, set2)`
+
+#### Class
+
+Elemental subroutine.
+
+#### Arguments
+
+`set1`: shall be a `bitset_64` or `bitset_large` scalar variable. It
+is an `intent(inout)` argument. On return the values of the bits in
+`set1` are the bitwise `and` of the original bits in `set1` with the
+corresponding bits in `set2`.
+
+`set2`: shall be a scalar expression of the same type as `set1`. It is
+an `intent(in)` argument. Note that `set2` must also have the same
+number of bits as `set1`.
+
+#### Example
+
+```fortran
+ program demo_and
+ use stdlib_bitsets
+ type(bitset_large) :: set0, set1
+ call set0 % init(166)
+ call set1 % init(166)
+ call and( set0, set1 ) ! none none
+ if ( none(set0) ) write(*,*) 'First test of AND worked.'
+ call set0 % not()
+ call and( set0, set1 ) ! all none
+ if ( none(set0) ) write(*,*) 'Second test of AND worked.'
+ call set1 % not()
+ call and( set0, set1 ) ! none all
+ if ( none(set0) ) write(*,*) 'Third test of AND worked.'
+ call set0 % not()
+ call and( set0, set1 ) ! all all
+ if ( all(set0) ) write(*,*) 'Fourth test of AND worked.'
+ end program demo_and
+```
+
+### `and_not` - Bitwise `and` of one bitset with the negation of another
+
+#### Status
+
+Experimental
+
+#### Description
+
+Sets the bits of `set1` to bitwise `and` of the bits of `set1` with
+the bitwise negation of the corresponding bits of `set2`. Note that
+`set1` and `set2` must have the same number of bits, otherwise the
+result is undefined.
+
+#### Syntax
+
+`call [[stdlib_bitsets(module):and_not(interface)]](set1, set2)`
+
+#### Class
+
+Elemental subroutine.
+
+#### Arguments
+
+`set1`: shall be a scalar `bitset_64` or `bitset_large` variable. It
+is an `intent(inout)` argument. On return the values of the bits in
+`set1` are the bitwise `and` of the original bits in `set1` with the
+corresponding negation of the bits in `set2`.
+
+`set2`: shall be a scalar expression of the same type as `set1`. It is
+an `intent(in)` argument. Note that it should also have the same
+number of bits as `set1`, otherwise the result is undefined.
+
+#### Example
+
+```fortran
+ program demo_and_not
+ use stdlib_bitsets
+ type(bitset_large) :: set0, set1
+ call set0 % init(166)
+ call set1 % init(166)
+ call and_not( set0, set1 ) ! none none
+ if ( none(set0) ) write(*,*) 'First test of AND_NOT worked.'
+ call set0 % not()
+ call and_not( set0, set1 ) ! all none
+ if ( all(set0) ) write(*,*) 'Second test of AND_NOT worked.'
+ call set0 % not()
+ call set1 % not()
+ call and_not( set0, set1 ) ! none all
+ if ( none(set0) ) write(*,*) 'Third test of AND_NOT worked.'
+ call set0 % not()
+ call and_not( set0, set1 ) ! all all
+ if ( none(set0) ) write(*,*) 'Fourth test of AND_NOT worked.'
+ end program demo_and_not
+```
+
+### `any` - determine whether any bits are set
+
+#### Status
+
+Experimental
+
+#### Description
+
+Determines whether any bits are set in `self`.
+
+#### Syntax
+
+`result = self % [[bitset_type(class):any(bound)]]()`
+
+#### Class
+
+Elemental function.
+
+#### Argument
+
+`self`: shall be a scalar expression of class `bitset_type`. It is an
+`intent(in)` argument.
+
+#### Result value
+
+The result is a default logical scalar. The result is `.true.` if any bits in `self` are set, otherwise it
+is `.false.`.
+
+#### Example
+
+```fortran
+ program demo_any
+ use stdlib_bitsets
+ character(*), parameter :: &
+ bits_0 = '0000000000000000000'
+ type(bitset_64) :: set0
+ call set0 % from_string( bits_0 )
+ if ( .not. set0 % any() ) then
+ write(*,*) "FROM_STRING interpreted " // &
+ "BITS_0's value properly."
+ end if
+ call set0 % set(5)
+ if ( set0 % any() ) then
+ write(*,*) "ANY interpreted SET0's value properly."
+ end if
+ end program demo_any
+```
+
+### `bit_count` - return the number of bits that are set
+
+#### Status
+
+Experimental
+
+#### Description
+
+Returns the number of bits that are set to one in `self`.
+
+#### Syntax
+
+`result = self % [[bitset_type(class):bit_count(bound)]] ()`
+
+#### Class
+
+Elemental function.
+
+#### Argument
+
+`self`: shall be a scalar expression of class `bitset_type`. It is an
+`intent(in)` argument.
+
+#### Result value
+
+The result is an integer scalar of kind `bits_kind`,
+equal to the number of bits that are set in `self`.
+
+#### Example
+
+```fortran
+ program demo_bit_count
+ use stdlib_bitsets
+ character(*), parameter :: &
+ bits_0 = '0000000000000000000'
+ type(bitset_64) :: set0
+ call set0 % from_string( bits_0 )
+ if ( set0 % bit_count() == 0 ) then
+ write(*,*) "FROM_STRING interpreted " // &
+ "BITS_0's value properly."
+ end if
+ call set0 % set(5)
+ if ( set0 % bit_count() == 1 ) then
+ write(*,*) "BIT_COUNT interpreted SET0's value properly."
+ end if
+ end program demo_bit_count
+```
+
+#### `bits` - returns the number of bits
+
+#### Status
+
+Experimental
+
+#### Description
+
+Reports the number of bits in `self`.
+
+#### Syntax
+
+`result = self % [[bitset_type(class):bits(bound)]] ()`
+
+#### Class
+
+Elemental function.
+
+#### Argument
+
+`self`: shall be a scalar expression of class `bitset_type`. It is an
+`intent(in)` argument.
+
+#### Result value
+
+The result is an integer scalar of kind `bits_kind`, equal to
+the number of defined bits in `self`.
+
+#### Example
+
+```fortran
+ program demo_bits
+ use stdlib_bitsets
+ character(*), parameter :: &
+ bits_0 = '0000000000000000000'
+ type(bitset_64) :: set0
+ call set0 % from_string( bits_0 )
+ if ( set0 % bits() == 19 ) then
+ write(*,*) "FROM_STRING interpreted " // &
+ "BITS_0's size properly."
+ end if
+ end program demo_bits
+```
+
+### `clear` - clears a sequence of one or more bits.
+
+#### Status
+
+Experimental
+
+#### Description
+
+* If only `pos` is present, clears the bit with position `pos` in
+`self`.
+
+* If `start_pos` and `end_pos` are present with `end_pos >= start_pos`
+clears the bits with positions from `start_pos` to `end_pos` in `self`.
+
+* if `start_pos` and `end_pos` are present with `end_pos < start_pos`
+`self` is unmodified.
+
+Note: Positions outside the range 0 to `bits(set) -1` are ignored.
+
+#### Syntax
+
+`call self % [[bitset_type(class):clear(bound)]](pos)'
+
+or
+
+`call self % [[bitset_type(class):clear(bound)]](start_pos, end_pos)`
+
+#### Class
+
+Elemental subroutine
+
+#### Arguments
+
+`self`: shall be a scalar variable of class `bitset_type`. It is an
+ `intent(inout)` argument.
+
+`pos`: shall be a scalar integer expression of kind `bits_kind`. It is
+an `intent(in)` argument.
+
+`start_pos`: shall be a scalar integer expression of kind
+`bits_kind`. It is an `intent(in)` argument.
+
+`end_pos`: shall be a scalar integer expression of kind
+`bits_kind`. It is an `intent(in)` argument.
+
+#### Example
+
+```fortran
+ program demo_clear
+ use stdlib_bitsets
+ type(bitset_large) :: set0
+ call set0 % init(166)
+ call set0 % not()
+ if ( set0 % all() ) write(*,*) 'SET0 is properly initialized.'
+ call set0 % clear(165)
+ if ( .not. set0 % test(165) ) write(*,*) 'Bit 165 is cleared.'
+ call set0 % clear(0,164)
+ if ( set0 % none() ) write(*,*) 'All bits are cleared.'
+ end program demo_clear
+```
+
+### `extract` - create a new bitset from a range in an old bitset
+
+#### Status
+
+Experimental
+
+#### Description
+
+Creates a new bitset, `new`, from a range, `start_pos` to `stop_pos`,
+in bitset `old`. If `start_pos` is greater than `stop_pos` the new
+bitset is empty. If `start_pos` is less than zero or `stop_pos` is
+greater than `bits(old)-1` then if `status` is present it has the
+value `index_invalid_error`, otherwise processing stops with an
+informative message.
+
+#### Syntax
+
+`call [[stdlib_bitsets(module):extract(interface)]](new, old, start_pos, stop_pos, status )`
+
+#### Class
+
+Subroutine
+
+#### Arguments
+
+`new`: shall be a scalar `bitset_64` or `bitset_large` variable. It
+is an `intent(out)` argument. It will be the new bitset.
+
+`old`: shall be a scalar expression of the same type as `new`. It is
+an `intent(in)` argument. It will be the source bitset.
+
+`start_pos`: shall be a scalar integer expression of the kind
+`bits_kind`. It is an `intent(in)` argument.
+
+`stop_pos`: shall be a scalar integer expression of the kind
+`bits_kind`. It is an `intent(in)` argument.
+
+`status` (optional): shall be a scalar default integer variable. It is
+an `intent(out)` argument. If present it shall have one of the values:
+
+* `success` - no problems found
+
+* `index_invalid_error` - `start_pos` was less than zero or `stop_pos`
+ was greater than `bits(old)-1`.
+
+#### Example
+
+```fortran
+ program demo_extract
+ use stdlib_bitsets
+ type(bitset_large) :: set0, set1
+ call set0 % init(166)
+ call set0 % set(100,150)
+ call extract( set1, set0, 100, 150)
+ if ( set1 % bits() == 51 ) &
+ write(*,*) 'SET1 has the proper size.'
+ if ( set1 % all() ) write(*,*) 'SET1 has the proper values.'
+ end program demo_extract
+```
+
+### `flip` - flip the values of a sequence of one or more bits
+
+#### Status
+
+Experimental
+
+#### Description
+
+Flip the values of a sequence of one or more bits.
+* If only `pos` is present flip the bit value with position `pos` in
+ `self`.
+* If `start_pos` and `end_pos` are present with `end_pos >= start_pos`
+flip the bit values with positions from `start_pos` to `end_pos` in
+`self`.
+* If `end_pos < start_pos` then `self` is unmodified.
+
+
+#### Syntax
+
+`call self % [[bitset_type(class):flip(bound)]] (pos)`
+
+or
+
+`call self % [[bitset_type(class):flip(bound)]] (start_pos, end_pos)`
+
+#### Class
+
+Elemental subroutine.
+
+#### Arguments
+
+`self`: shall be a scalar class `bitset_type` variable It is an
+`intent(inout)` argument.
+
+`pos`: shall be a scalar integer expression of kind `bits_kind`. It is
+an `intent(in)` argument.
+
+`start_pos`: shall be a scalar integer expression of kind
+`bits_kind`. It is an `intent(in)` argument.
+
+`end_pos`: shall be a scalar integer expression of kind
+`bits_kind`. It is an `intent(in)` argument.
+
+#### Example
+
+```fortran
+ program demo_flip
+ use stdlib_bitsets
+ type(bitset_large) :: set0
+ call set0 % init(166)
+ if ( set0 % none() ) write(*,*) 'SET0 is properly initialized.'
+ call set0 % flip(165)
+ if ( set0 % test(165) ) write(*,*) 'Bit 165 is flipped.'
+ call set0 % flip(0,164)
+ if ( set0 % all() ) write(*,*) 'All bits are flipped.'
+ end program demo_flip
+```
+
+### `from_string` - initializes a bitset from a binary literal
+
+#### Status
+
+Experimental
+
+#### Description
+
+Initializes the bitset `self` from `string`, treating `string` as a
+binary literal.
+
+#### Syntax
+
+`call self % [[bitset_type(class):from_string(bound)]](string[, status])`
+
+#### Class
+
+Subroutine
+
+#### Arguments
+
+`self`: shall be a scalar class `bitset_type` variable. It is an
+`intent(out)` argument.
+
+`string`: shall be a scalar default character expression. It is an
+`intent(in)` argument. It shall consist only of the characters "0",
+and "1".
+
+`status` (optional): shall be a scalar default integer variable. It is
+an `intent(out)` argument. If present, on return its value shall be
+one of the error codes defined in this module. If absent, and its
+value would not have been `success`, then processing will stop with an
+informative text as its stop code. It shall have one of the error
+codes:
+
+* `success` - if no problems were found,
+
+* `alloc_fault` - if allocation of the bitset failed
+
+* `char_string_too_large_error` - if `string` was too large, or
+
+* `char_string_invalid_error` - if string had an invalid character.
+
+
+#### Example
+
+```fortran
+ program demo_from_string
+ use stdlib_bitsets
+ character(*), parameter :: &
+ bits_all = '111111111111111111111111111111111'
+ type(bitset_64) :: set0
+ call set0 % from_string( bits_all )
+ if ( bits(set0) /= 33 ) then
+ error stop "FROM_STRING failed to interpret " // &
+ 'BITS_ALL's size properly."
+ else if ( .not. set0 % all() ) then
+ error stop "FROM_STRING failed to interpret" // &
+ "BITS_ALL's value properly."
+ else
+ write(*,*) "FROM_STRING transferred BITS_ALL properly" // &
+ " into set0."
+ end if
+ end program demo_from_string
+```
+
+### `init` - `bitset_type` initialization routines.
+
+#### Status
+
+Experimental
+
+#### Description
+
+`bitset_type` initialization routine.
+
+#### Syntax
+
+`call [[stdlib_bitsets(module):init(interface)]] (self, bits [, status])`
+
+#### Class
+
+Subroutine.
+
+#### Arguments
+
+`self`: shall be a scalar `bitset_64` or `bitset_large` variable. It
+is an `intent(out)` argument.
+
+`bits` (optional): shall be a scalar integer expression of kind
+`bits_kind`. It is an `intent(in)` argument that if present
+specifies the number of bits in `set`. A negative value, or a value
+greater than 64 if `self` is of type `bitset_64`, is an error.
+
+`status` (optional): shall be a scalar default integer variable. It is
+an `intent(out)` argument that, if present, returns an error code
+indicating any problem found in processing `init`, and if absent and
+an error was found result in stopping processing with an informative
+stop code. It can have any of the following error codes:
+
+* `success` - no problem found
+
+* `alloc_fault` - `self` was of type `bitset_large` and memory
+ allocation failed
+
+* `array_size_invalid_error` - bits was present with either a negative
+ value, or a value greater than 64 when `self` was of type
+ `bitset_64`.
+
+#### Example
+
+```fortran
+ program demo_init
+ use stdlib_bitsets
+ type(bitset_large) :: set0
+ call set0 % init(166)
+ if ( set0 % bits() == 166 ) &
+ write(*,*) `SET0 has the proper size.'
+ if ( set0 % none() ) write(*,*) 'SET0 is properly initialized.'
+ end program demo_init
+```
+
+### `input` - reads a bitset from an unformatted file
+
+#### Status
+
+Experimental
+
+#### Description
+
+Reads a bitset from its binary representation in an unformatted
+file.
+
+#### Syntax
+
+`call self % [[bitset_type(class):input(bound)]] (unit [, status])`
+
+#### Class
+
+Subroutine
+
+#### Arguments
+
+`self`: shall be a scalar variable of class `bitset_64` or
+`bitset_large`. It is an `intent(out)` argument.
+
+`unit`: shall be a scalar default integer expression. It is an
+`intent(in)` argument. Its value must be that of a logical unit
+number for an open unformatted file with `read` or `readwrite`
+access positioned at the start of a bitset value written by a
+`bitset_type` `output` subroutine by the same processor.
+
+`status` (optional): shall be a scalar default integer variable. If
+present its value shall be of one of the error codes defined in this
+module. If absent and it would have had a value other than `success`
+processing will stop with an informative stop code. Allowed error code
+values for this `status` are:
+
+* `success` - no problem found
+
+* `alloc_fault` - `self` was of type `bitset_large` and allocation of
+ memory failed.
+
+* `array_size_invalid_error` - if the number of bits read from `unit`
+ is either negative or greater than 64, if class of `self` is
+ `bitset_64`.
+
+* `read_failure` - failure during a read statement
+
+#### Example
+
+```fortran
+ program demo_input
+ character(*), parameter :: &
+ bits_0 = '000000000000000000000000000000000', &
+ bits_1 = '000000000000000000000000000000001', &
+ bits_33 = '100000000000000000000000000000000'
+ integer :: unit
+ type(bitset_64) :: set0, set1, set2, set3, set4, set5
+ call set0 % from_string( bits_0 )
+ call set1 % from_string( bits_1 )
+ call set2 % from_string( bits_33 )
+ open( newunit=unit, file='test.bin', status='replace', &
+ form='unformatted', action='write' )
+ call set2 % output(unit)
+ call set1 % output(unit)
+ call set0 % output(unit)
+ close( unit )
+ open( newunit=unit, file='test.bin', status='old', &
+ form='unformatted', action='read' )
+ call set5 % input(unit)
+ call set4 % input(unit)
+ call set3 % input(unit)
+ close( unit )
+ if ( set3 /= set0 .or. set4 /= set1 .or. set5 /= set2 ) then
+ error stop 'Transfer to and from units using ' // &
+ ' output and input failed.'
+ else
+ write(*,*) 'Transfer to and from units using ' // &
+ 'output and input succeeded.'
+ end if
+ end program demo_input
+```
+
+### `none` - determines whether no bits are set
+
+#### Status
+
+Experimental
+
+#### Description
+
+Determines whether no bits are set in `self`.
+
+#### Syntax
+
+`result = self % [[bitset_type(class):none(bound)]] ()`
+
+#### Class
+
+Elemental function.
+
+#### Argument
+
+`self`: shall be a scalar expression of class `bitset_type`. It is an
+ `intent(in)` argument.
+
+#### Result value
+
+The result is a default logical scalar.
+The result is `.true.` if no bits in `self` are set, otherwise it is
+`.false.`.
+
+#### Example
+
+```fortran
+ program demo_none
+ use stdlib_bitsets
+ character(*), parameter :: &
+ bits_0 = '0000000000000000000'
+ type(bitset_large) :: set0
+ call set0 % from_string( bits_0 )
+ if ( set0 % none() ) then
+ write(*,*) "FROM_STRING interpreted " // &
+ "BITS_0's value properly."
+ end if
+ call set0 % set(5)
+ if ( .not. set0 % none() ) then
+ write(*,*) "NONE interpreted SET0's value properly."
+ end if
+ end program demo_none
+```
+
+### `not` - Performs the logical complement on a bitset
+
+#### Status
+
+Experimental
+
+#### Description
+
+Performs the logical complement on the bits of `self`.
+
+#### Syntax
+
+`call self % [[bitset_type(class):not(bound)]] ()`
+
+#### Class
+
+Elemental subroutine.
+
+#### Argument
+
+`self` shall be a scalar variable of class `bitset_type`. It is an
+`intent(inout)` argument. On return its bits shall be the logical
+complement of their values on input.
+
+#### Example
+
+```fortran
+ program demo_not
+ use stdlib_bitsets
+ type(bitset_large) :: set0
+ call set0 % init( 155 )
+ if ( set0 % none() ) then
+ write(*,*) "FROM_STRING interpreted " // &
+ "BITS_0's value properly."
+ end if
+ call set0 % not()
+ if ( set0 % all() ) then
+ write(*,*) "ALL interpreted SET0's value properly."
+ end if
+ end program demo_not
+```
+
+### `or` - Bitwise OR of the bits of two bitsets.
+
+#### Status
+
+Experimental
+
+#### Description
+
+Replaces the original bits of `set1` with the bitwise `or` of those
+bits with the bits of `set2`. Note `set1` and `set2` must have the
+same number of bits, otherwise the result is undefined.
+
+#### Syntax
+
+`call [[stdlib_bitsets(module):or(interface)]](set1, set2)`
+
+#### Class
+
+Elemental subroutine.
+
+#### Arguments
+
+`set1`: shall be a scalar `bitset_64` or `bitset_large` variable. It
+is an `intent(inout)` argument. On return the values of the bits in
+`setf` are the bitwise `or` of the original bits in `set1` with the
+corresponding bits in `set2`.
+
+`set2`: shall be a scalar expression of the same type as `set1`. It is
+an `intent(in)` argument. Note `bits(set2)` must equal `bits(set1)`
+otherwise the results are undefined.
+
+#### Example
+
+```fortran
+ program demo_or
+ use stdlib_bitsets
+ type(bitset_large) :: set0, set1
+ call set0 % init(166)
+ call set1 % init(166)
+ call or( set0, set1 ) ! none none
+ if ( none(set0) ) write(*,*) 'First test of OR worked.'
+ call set0 % not()
+ call or( set0, set1 ) ! all none
+ if ( all(set0) ) write(*,*) 'Second test of OR worked.'
+ call set0 % not()
+ call set1 % not()
+ call or( set0, set1 ) ! none all
+ if ( all(set0) ) write(*,*) 'Third test of OR worked.'
+ call set0 % not()
+ call or( set0, set1 ) ! all all
+ if ( all(set0) ) write(*,*) 'Fourth test of OR worked.'
+ end program demo_or
+```
+
+### `output` - Writes a binary representation of a bitset to a file
+
+#### Status
+
+Experimental
+
+#### Description
+
+Writes a binary representation of a bitset to an unformatted file.
+
+#### Syntax
+
+`call self % [[bitset_type(class):output(bound)]] (unit[, status])`
+
+#### Class
+
+Subroutine.
+
+#### Arguments
+
+`self`: shall be a scalar expression of class `bitset_64` or
+`bitset_large`. It is an `intent(in)` argument.
+
+`unit`: shall be a scalar default integer expression. It is an
+`intent(in)` argument. Its value must be that of an I/O unit number
+for an open unformatted file with `write` or `readwrite` access.
+
+`status` (optional): shall be a scalar default integer variable. It is
+an `intent(out)` argument. If present on return it will have the value
+of `success` or `write_failure`. If absent and it would not have the
+value of `success` then processing will stop with an informative stop
+code. The two code values have the meaning:
+
+* `success` - no problem found
+
+* `write_failure` - a failure occurred in a write statement.
+
+#### Example
+
+```fortran
+ program demo_output
+ character(*), parameter :: &
+ bits_0 = '000000000000000000000000000000000', &
+ bits_1 = '000000000000000000000000000000001', &
+ bits_33 = '100000000000000000000000000000000'
+ integer :: unit
+ type(bitset_64) :: set0, set1, set2, set3, set4, set5
+ call set0 % from_string( bits_0 )
+ call set1 % from_string( bits_1 )
+ call set2 % from_string( bits_33 )
+ open( newunit=unit, file='test.bin', status='replace', &
+ form='unformatted', action='write' )
+ call set2 % output(unit)
+ call set1 % output(unit)
+ call set0 % output(unit)
+ close( unit )
+ open( newunit=unit, file='test.bin', status='old', &
+ form='unformatted', action='read' )
+ call set5 % input(unit)
+ call set4 % input(unit)
+ call set3 % input(unit)
+ close( unit )
+ if ( set3 /= set0 .or. set4 /= set1 .or. set5 /= set2 ) then
+ error stop 'Transfer to and from units using ' // &
+ ' output and input failed.'
+ else
+ write(*,*) 'Transfer to and from units using ' // &
+ 'output and input succeeded.'
+ end if
+ end program demo_output
+```
+
+### `read_bitset` - initializes `self` with the value of a *bitset_literal*
+
+#### Status
+
+Experimental
+
+#### Description
+
+Reads a *bitset-literal* and initializes `self` with the corresponding
+value.
+
+
+#### Syntax
+
+`call self % [[bitset_type(class):read_bitset(bound)]](string[, status])`
+
+or
+
+`call self % [[bitset_type(class):read_bitset(bound)]](unit[, advance, status])`
+
+
+#### Class
+
+Subroutine
+
+#### Arguments
+
+`self`: shall be a scalar variable of class `bitset_type`. It is an
+`intent(out)` argument. Upon a successful return it is initialized with
+the value of a *bitset-literal*.
+
+`string` (optional): shall be a scalar default character
+expression. It is an `intent(in)` argument. It will consist of a left
+justified *bitset-literal*, terminated by either the end of the string
+or a blank.
+
+`unit` (optional): shall be a scalar default integer expression. It is
+an `intent(in)` argument. Its value must be that of an I/O unit number
+for an open formatted file with `read` or `readwrite` access
+positioned at the start of a *bitset-literal*.
+
+`advance` (optional): shall be a scalar default character
+expression. It is an `intent(in)` argument. It is the `advance`
+specifier for the final read of `unit`. If present it should have
+the value `'yes'` or `'no'`. If absent it has the default value of
+`'yes'`.
+
+`status` (optional): shall be a scalar default integer variable. It is
+an `intent(out)` argument. If present on return it shall have the
+value of one of the error codes of this module. If absent and it would
+not have had the value `success` processing will stop with a message
+as its error code. The possible error codes are:
+
+* `success` - no problems found;
+
+* `alloc_fault` - if `self` is of class `bitset_large` and allocation
+ of the bits failed;
+
+* `array_size_invalid_error` - if the *bitset-literal* has a bits
+ value greater than 64 and `self` is of class `bitset_64`;
+
+* `char_string_invalid_error` - if the `bitset-literal` has an invalid
+ character;
+
+* `char_string_too_small_error` - if `string` ends before all the bits
+ are read;
+
+* `eof_failure` - if a `read` statement reached an end-of-file before
+ completing the read of the bitset literal,
+
+* `integer_overflow_error` - if the *bitset-literal* has a `bits`
+ value larger than `huge(0_bits_kind)`; or
+
+* `read_failure` - if a read statement failed.
+
+#### Example
+
+```fortran
+ program demo_read_bitset
+ character(*), parameter :: &
+ bits_0 = 'S33B000000000000000000000000000000000', &
+ bits_1 = 'S33B000000000000000000000000000000001', &
+ bits_33 = 'S33B100000000000000000000000000000000'
+ character(:), allocatable :: test_0, test_1, test_2
+ integer :: unit
+ type(bitset_64) :: set0, set1, set2, set3, set4, set5
+ call set0 % read_bitset( bits_0, status )
+ call set1 % read_bitset( bits_1, status )
+ call set2 % read_bitset( bits_2, status )
+ call set0 % write_bitset( test_0, status )
+ call set1 % write_bitset( test_1, status )
+ call set2 % write_bitset( test_2, status )
+ if ( bits_0 == test_0 .and. bits_1 == test_1 .and. &
+ bits_2 == test_2 ) then
+ write(*,*) 'READ_BITSET to WRITE_BITSET strings worked.'
+ end if
+ open( newunit=unit, file='test.txt', status='replace', &
+ form='formatted', action='write' )
+ call set2 % write_bitset(unit, advance='no')
+ call set1 % write_bitset(unit, advance='no')
+ call set0 % write_bitset(unit)
+ close( unit )
+ open( newunit=unit, file='test.txt', status='old', &
+ form='formatted', action='read' )
+ call set3 % read_bitset(unit, advance='no')
+ call set4 % read_bitset(unit, advance='no')
+ call set5 % read_bitset(unit)
+ if ( set3 == set0 .and. set4 == set1 .and. set5 == set2 ) then
+ write(*,*) WRITE_BITSET to READ_BITSET through unit worked.'
+ end if
+ end program demo_read_bitset
+```
+
+### `set` - sets a sequence of one or more bits to 1.
+
+#### Status
+
+Experimental
+
+#### Description
+
+Sets a sequence of one or more bits in `self` to 1.
+
+* If `start_pos` and `end_pos` are absent sets the bit at position
+`pos` in `self` to 1.
+
+* If `start_pos` and `end_pos` are present with `end_pos >= start_pos`
+set the bits at positions from `start_pos` to `end_pos` in `self` to 1.
+
+* If `start_pos` and `end_pos` are present with `end_pos < start_pos`
+`self` is unchanged.
+
+* Positions outside the range 0 to `bits(self)` are ignored.
+
+
+#### Syntax
+
+`call self % [[bitset_type(class):set(bound)]] (POS)`
+
+or
+
+`call self % [[bitset_type(class):set(bound)]] (START_POS, END_POS)`
+
+#### Class
+
+Elemental subroutine
+
+#### Arguments
+
+`self`: shall be a scalar variable of class `bitset_type`. It is an
+ `intent(inout)` argument.
+
+`pos` (optional): shall be a scalar integer expression of kind
+`bits_kind`. It is an `intent(in)` argument.
+
+`start_pos` (optional): shall be a scalar integer expression of kind
+`bits_kind`. It is an `intent(in)` argument.
+
+`end_pos` (optional): shall be a scalar integer expression of kind
+`bits_kind`. It is an `intent(in)` argument.
+
+#### Example
+
+```fortran
+ program demo_set
+ use stdlib_bitsets
+ type(bitset_large) :: set0
+ call set0 % init(166)
+ if ( set0 % none() ) write(*,*) 'SET0 is properly initialized.'
+ call set0 % set(165)
+ if ( set0 % test(165) ) write(*,*) 'Bit 165 is set.'
+ call set0 % set(0,164)
+ if ( set0 % all() ) write(*,*) 'All bits are set.'
+ end program demo_set
+```
+
+### `test` - determine whether a bit is set
+
+#### Status
+
+Experimental
+
+#### Descriptions
+
+Determine whether the bit at position `pos` is set to 1 in `self`.
+
+
+#### Syntax
+
+`result = self % [[bitset_type(class):test(bound)]](pos)`
+
+#### Class
+
+Elemental function.
+
+#### Arguments
+
+`self`: shall be a scalar expression of class `bitset_type`. It is an
+`intent(in)` argument.
+
+`pos`: shall be a scalar integer expression of kind `bits_kind`. It is
+an `intent(in)` argument.
+
+#### Result value
+
+The result is a default logical scalar.
+The result is `.true.` if the bit at `pos` in `self` is set,
+otherwise it is `.false.`. If `pos` is outside the range
+`0... bits(self)-1` the result is `.false.`.
+
+#### Example
+
+```fortran
+ program demo_test
+ use stdlib_bitsets
+ type(bitset_large) :: set0
+ call set0 % init(166)
+ call set0 % not()
+ if ( set0 % all() ) write(*,*) 'SET0 is properly initialized.'
+ call set0 % clear(165)
+ if ( .not. set0 % test(165) ) write(*,*) 'Bit 165 is cleared.'
+ call set0 % set(165)
+ if ( set0 % test(165) ) write(*,*) 'Bit 165 is set.'
+ end program demo_test
+```
+
+### `to_string` - represent a bitset as a binary literal
+
+### Status
+
+Experimental
+
+#### Description
+
+Represents the value of `self` as a binary literal in `string`.
+
+#### Syntax
+
+`call self % [[bitset_type(class):to_string(bound)]](string[, status])`
+
+#### Class
+
+Subroutine
+
+#### Arguments
+
+`self`: shall be a scalar expression of class `bitset_type`. It is an
+`intent(in)` argument.
+
+`string`: shall be a scalar default character variable of allocatable
+length. It is an `intent(out)` argument. On return it shall have a
+*binary-literal* representation of the bitset `self`.
+
+`status` (optional): shall be a scalar default integer variable. It is
+an `intent(out)` argument. If present it shall have either the value
+`success` or `alloc_fault`. If absent and it would have had the value
+`alloc_fault` then processing will stop with an informative test as
+the stop code. The values have the following meanings:
+
+`success` - no problem found.
+
+`alloc_fault` - allocation of `string` failed.
+
+
+#### Example
+
+```fortran
+ program demo_to_string
+ use stdlib_bitsets
+ character(*), parameter :: &
+ bits_all = '111111111111111111111111111111111'
+ type(bitset_64) :: set0
+ character(:), allocatable :: new_string
+ call set0 % init(33)
+ call set0 % not()
+ call set0 % to_string( new_string )
+ if ( new_string == bits_all ) then
+ write(*,*) "TO_STRING transferred BITS0 properly" // &
+ " into NEW_STRING."
+ end if
+ end program demo_to_string
+```
+
+### `value` - determine the value of a bit
+
+#### Status
+
+Experimental
+
+#### Description
+
+Determines the value of the bit at position, `pos`, in `self`.
+
+#### Syntax
+
+`result = self % [[bitset_type(class):value(bound)]](pos)`
+
+#### Class
+
+Elemental function.
+
+#### Arguments
+
+`self`: shall be a scalar expression of class `bitset_type`. It is an
+`intent(in)` argument.
+
+`pos`: shall be a scalar integer expression of kind `bits_kind`. It is
+an `intent(in)` argument.
+
+#### Result value
+
+The result is a default integer scalar.
+The result is one if the bit at `pos` in `self` is set, otherwise it
+is zero. If `pos` is outside the range `0... bits(set)-1` the result
+is zero.
+
+#### Example
+
+```fortran
+ program demo_value
+ use stdlib_bitsets
+ type(bitset_large) :: set0
+ call set0 % init(166)
+ call set0 % not()
+ if ( set0 % all() ) write(*,*) 'SET0 is properly initialized.'
+ call set0 % clear(165)
+ if ( set0 % value(165) == 0 ) write(*,*) 'Bit 165 is cleared.'
+ call set0 % set(165)
+ if ( set0 % value(165) == 1 ) write(*,*) 'Bit 165 is set.'
+ end program demo_value
+```
+
+### `write_bitset` - writes a *bitset-literal*
+
+#### Status
+
+Experimental
+
+#### Description
+
+Writes a *bitset-literal* representing `self`'s current value to a
+character string or formatted file.
+
+
+#### Syntax
+
+`call self % [[bitset_type(class):write_bitset(bound)]](string[, status])`
+
+or
+
+`call self % [[bitset_type(class):write_bitset(bound)]] (unit[, advance, status])`
+
+#### Class
+
+Subroutine
+
+#### Arguments
+
+`self`: shall be a scalar expression of class `bitset_type`. It is an
+`intent(in)` argument.
+
+`string` (optional): shall be a scalar default character variable of
+allocatable length. It is an `intent(out)` argument.
+
+`unit` (optional): shall be a scalar default logical expression. It is
+an `intent(in)` argument. Its value must be that of a I/O unit number
+for an open formatted file with `write` or `readwrite` access.
+
+`advance` (optional): shall be a scalar default character
+expression. It is an `intent(in)` argument. It is the `advance`
+specifier for the write to `unit`. If present it must have the value
+`'yes'` or `'no'`. It has the default value of `'yes'`.
+
+* if `advance` is not present or is present with a value of `'no'`
+ then the bitset's *bitset-literal* is written to `unit`
+ followed by a blank, and the current record is not advanced.
+
+* If `advance` is present with a value of `'yes'` then the
+ bitset's *bitset-literal* is written to `unit` and the
+ record is immediately advanced.
+
+`status` (optional): shall be a scalar default integer variable. It is
+an `intent(out)` argument. If present on return it shall have the
+value of one of the module's error codes. If absent and a problem was
+found processing will stop with an informative stop code. It may have
+the following error code values:
+
+* `success` - no problem was found
+
+* `alloc_fault` - allocation of the string failed
+
+* `write_failure` - the `write` to the `unit` failed
+
+#### Example
+
+```fortran
+ program demo_write_bitset
+ character(*), parameter :: &
+ bits_0 = 'S33B000000000000000000000000000000000', &
+ bits_1 = 'S33B000000000000000000000000000000001', &
+ bits_33 = 'S33B100000000000000000000000000000000'
+ character(:), allocatable :: test_0, test_1, test_2
+ integer :: unit
+ type(bitset_64) :: set0, set1, set2, set3, set4, set5
+ call set0 % read_bitset( bits_0, status )
+ call set1 % read_bitset( bits_1, status )
+ call set2 % read_bitset( bits_2, status )
+ call set0 % write_bitset( test_0, status )
+ call set1 % write_bitset( test_1, status )
+ call set2 % write_bitset( test_2, status )
+ if ( bits_0 == test_0 .and. bits_1 == test_1 .and. &
+ bits_2 == test_2 ) then
+ write(*,*) 'READ_BITSET to WRITE_BITSET strings worked.'
+ end if
+ open( newunit=unit, file='test.txt', status='replace', &
+ form='formatted', action='write' )
+ call set2 % write_bitset(unit, advance='no')
+ call set1 % write_bitset(unit, advance='no')
+ call set0 % write_bitset(unit)
+ close( unit )
+ open( newunit=unit, file='test.txt', status='old', &
+ form='formatted', action='read' )
+ call set3 % read_bitset(unit, advance='no')
+ call set4 % read_bitset(unit, advance='no')
+ call set5 % read_bitset(unit)
+ if ( set3 == set0 .and. set4 == set1 .and. set5 == set2 ) then
+ write(*,*) WRITE_BITSET to READ_BITSET through unit worked.'
+ end if
+ end program demo_write_bitset
+```
+
+### `xor` - bitwise exclusive `or`
+
+#### Status
+
+Experimental
+
+#### Description
+
+Replaces `set1`'s bitset with the bitwise exclusive `or` of the
+original bits of `set1` and `set2`. Note `set1` and `set2` must have
+the samee number of bits, otherwise the result is undefined.
+
+#### Syntax
+
+`result = [[stdlib_bitsets(module):xor(interface)]] (set1, set2)`
+
+#### Class
+
+Elemental subroutine
+
+#### Arguments
+
+`set1`: shall be a scalar `bitset_64` or `bitset_large` variable. It
+is an `intent(inout)` argument. On return the values of the bits in
+`set1` are the bitwise exclusive `or` of the original bits in `set1`
+with the corresponding bits in `set2`.
+
+`set2` shall be a scalar expression of the same type as `set1`. It is
+ an `intent(in)` argument. Note `set1` and `set2` must have the
+samee number of bits, otherwise the result is undefined.
+
+#### Example
+
+```fortran
+ program demo_xor
+ use stdlib_bitsets
+ type(bitset_large) :: set0, set1
+ call set0 % init(166)
+ call set1 % init(166)
+ call xor( set0, set1 ) ! none none
+ if ( none(set0) ) write(*,*) 'First test of XOR worked.'
+ call set0 % not()
+ call xor( set0, set1 ) ! all none
+ if ( all(set0) ) write(*,*) 'Second test of XOR worked.'
+ call set0 % not()
+ call set1 % not()
+ call xor( set0, set1 ) ! none all
+ if ( all(set0) ) write(*,*) 'Third test of XOR worked.'
+ call set0 % not()
+ call xor( set0, set1 ) ! all all
+ if ( none(set0) ) write(*,*) 'Fourth test of XOR worked.'
+ end program demo_xor
+```
+
+## Specification of the `stdlib_bitsets` operators
+
+### `==` - compare two bitsets to determine whether the bits have the same value
+
+#### Status
+
+Experimental
+
+#### Description
+
+Returns `.true.` if all bits in `set1` and `set2` have the same value,
+`.false.` otherwise.
+
+#### Syntax
+
+`result = set1 [[stdlib_bitsets(module):==(interface)]] set2`
+
+or
+
+`result = set1 [[stdlib_bitsets(module):.EQ.(interface)]] set2`
+
+#### Class
+
+Elemental operator
+
+#### Arguments
+
+`set1`: shall be a scalar `bitset_64` or `bitset_large` expression. It
+is an `intent(in)` argument.
+
+`set2`: shall be a scalar expression of the same type as `self`. It
+will have the same number of bits as `set1`. It is an `intent(in)`
+argument.
+
+#### Result value
+
+The result is a default logical scalar.
+The result is `.true.` if the bits in both bitsets are set
+to the same value, otherwise the result is `.false.`.
+
+#### Example
+
+```fortran
+ program demo_equality
+ 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 == set0 .and. set1 == set1 .and. set2 == set2 .and. &
+ .not. set0 == set1 .and. .not. set0 == set2 .and. .not. &
+ set1 == set2 ) then
+ write(*,*) 'Passed 64 bit equality tests.'
+ else
+ error stop 'Failed 64 bit equality tests.'
+ end if
+ end program demo_equality
+```
+
+### `/=` - compare two bitsets to determine whether any bits differ in value
+
+#### Status
+
+Experimental
+
+#### Description
+
+Returns `.true.` if any bits in `self` and `set2` differ in value,
+`.false.` otherwise.
+
+#### Syntax
+
+`result = set1 [[stdlib_bitsets(module):/=(interface)]] set2`
+
+or
+
+`result = set1 [[stdlib_bitsets(module):.NE.(interface)]] set2`
+
+#### Class
+
+Elemental function
+
+#### Arguments
+
+`set1`: shall be a scalar `bitset_64` or `bitset_large` expression. It
+is an `intent(in)` argument.
+
+`set2`: shall be a scalar expression of the same type as `self`. It
+will have the same number of bits as `set1`. It is an `intent(in)`
+argument.
+
+#### Result value
+
+The result is a default logical scalar.
+The result is `.true.` if any bits in both bitsets differ, otherwise
+the result is `.false.`.
+
+#### Example
+
+```fortran
+ program demo_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 demo_inequality
+```
+
+### `>=` - compare two bitsets to determine whether the first is greater than or equal to the second
+
+#### Status
+
+Experimental
+
+#### Description
+
+Returns `.true.` if the bits in `set1` and `set2` are the same or the
+highest order different bit is set to 1 in `set1` and to 0 in `set2`,
+`.false.`. otherwise. The sets must be the same size otherwise the
+results are undefined.
+
+#### Syntax
+
+`result = set1 [[stdlib_bitsets(module):>=(interface)]] set2`
+
+or
+
+`result = set1 [[stdlib_bitsets(module):.GE.(interface)]] set2`
+
+#### Class
+
+Elemental operator
+
+#### Arguments
+
+`set1`: shall be a scalar `bitset_64` or `bitset_large` expression. It
+is an `intent(in)` argument.
+
+`set2`: shall be a scalar expression of the same type as `self`. It
+will have the same number of bits as `set1`. It is an `intent(in)`
+argument.
+
+#### Result value
+
+The result is a default logical scalar.
+The result is `.true.` if the bits in `set1` and `set2` are the same
+or the highest order different bit is set to 1 in `set1` and to 0 in
+`set2`, `.false.` otherwise.
+
+#### Example
+
+```fortran
+ program demo_ge
+ 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 ( set1 >= set0 .and. set2 >= set1 .and. set2 >= set0 .and. &
+ set0 >= set0 .and. set1 >= set1 .and. set2 >= set2 .and. &
+ .not. set0 >= set1 .and. .not. set0 >= set2 .and. .not. &
+ set1 >= set2 ) then
+ write(*,*) 'Passed 64 bit greater than or equals tests.'
+ else
+ error stop 'Failed 64 bit greater than or equals tests.'
+ end if
+ end program demo_ge
+```
+
+### `>` - compare two bitsets to determine whether the first is greater than the other
+
+#### Status
+
+Experimental
+
+#### Description
+
+Returns `.true.` if the bits in `set1` and `set2` differ and the
+highest order different bit is set to 1 in `set1` and to 0 in `set2`,
+`.false.` otherwise. The sets must be the same size otherwise the
+results are undefined.
+
+#### Syntax
+
+`result = set1 [[stdlib_bitsets(module):>(interface)]] set2`
+
+or
+
+`result = set1 [[stdlib_bitsets(module):.GT.(interface)]] set2`
+
+#### Class
+
+Elemental operator
+
+#### Arguments
+
+`set1`: shall be a scalar `bitset_64` or `bitset_large` expression. It
+is an `intent(in)` argument.
+
+`set2`: shall be a scalar expression of the same type as `self`. It
+will have the same number of bits as `set1`. It is an `intent(in)`
+argument.
+
+#### Result value
+
+The result is a default logical scalar.
+The result is `.true.` if the bits in `set1` and `set2` differ and the
+highest order different bit is set to 1 in `set1` and to 0 in `set2`,
+`.false.` otherwise.
+
+#### Example
+
+```fortran
+ program demo_gt
+ 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 ( set1 > set0 .and. set2 > set1 .and. set2 > set0 .and. &
+ .not. set0 > set0 .and. .not. set0 > set1 .and. .not. &
+ set1 > set2 ) then
+ write(*,*) 'Passed 64 bit greater than tests.'
+ else
+ error stop 'Failed 64 bit greater than tests.'
+ end if
+ end program demo_gt
+```
+
+### `<=` - compare two bitsets to determine whether the first is less than or equal to the other
+
+#### Status
+
+Experimental
+
+#### Description
+
+Returns `.true.` if the bits in `set1` and `set2` are the same or the
+highest order different bit is set to 0 in `set1` and to 1 in `set2`,
+`.false.` otherwise. The sets must be the same size otherwise the
+results are undefined.
+
+#### Syntax
+
+`result = set1 [[stdlib_bitsets(module):<=(interface)]] set2`
+
+or
+
+`result = set1 [[stdlib_bitsets(module):.LE.(interface)]] set2`
+
+#### Class
+
+Elemental operator
+
+#### Arguments
+
+`set1`: shall be a scalar `bitset_64` or `bitset_large` expression. It
+is an `intent(in)` argument.
+
+`set2`: shall be a scalar expression of the same type as `self`. It
+will have the same number of bits as `set1`. It is an `intent(in)`
+argument.
+
+#### Result value
+
+The result is a default logical scalar.
+The result is `.true.` if the bits in `set1` and `set2` are the same
+or the highest order different bit is set to 0 in `set1` and to 1 in
+`set2`, `.false.` otherwise.
+
+#### Example
+
+```fortran
+ program demo_le
+ 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. set1 <= set2 .and. set0 <= set2 .and. &
+ set0 <= set0 .and. set1 <= set1 .and. set2 <= set2 .and. &
+ .not. set1 <= set0 .and. .not. set2 <= set0 .and. .not. &
+ set2 <= set1 ) then
+ write(*,*) 'Passed 64 bit less than or equal tests.'
+ else
+ error stop 'Failed 64 bit less than or equal tests.'
+ end if
+ end program demo_le
+```
+
+### `<` - compare two bitsets to determine whether the first is less than the other
+
+#### Status
+
+Experimental
+
+#### Description
+
+Returns `.true.` if the bits in `set1` and `set2` differ and the
+highest order different bit is set to 0 in `set1` and to 1 in `set2`,
+`.false.` otherwise. The sets must be the same size otherwise the
+results are undefined.
+
+#### Syntax
+
+`result = set1 [[stdlib_bitsets(module):<(interface)]] set2`
+
+or
+
+`result = set1 [[stdlib_bitsets(module):.LT.(interface)]] set2
+
+#### Class
+
+Elemental operator
+
+#### Arguments
+
+`set1`: shall be a scalar `bitset_64` or `bitset_large` expression. It
+is an `intent(in)` argument.
+
+`set2`: shall be a scalar expression of the same type as `self`. It
+will have the same number of bits as `set1`. It is an `intent(in)`
+argument.
+
+#### Result value
+
+The result is a default logical scalar.
+The result is `.true.` if the bits in `set1` and `set2` differ and the
+highest order different bit is set to 0 in `set1` and to 1 in `set2`,
+`.false.` otherwise.
+
+#### Example
+
+```fortran
+ program demo_lt
+ 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. set1 < set2 .and. set0 < set2 .and. &
+ .not. set0 < set0 .and. .not. set2 < set0 .and. .not. &
+ set2 < set1 ) then
+ write(*,*) 'Passed 64 bit less than tests.'
+ else
+ error stop 'Failed 64 bit less than tests.'
+ end if
+ end program demo_lt
+```
diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt
index ea7403663..02604959e 100644
--- a/src/CMakeLists.txt
+++ b/src/CMakeLists.txt
@@ -2,6 +2,9 @@
# Create a list of the files to be preprocessed
set(fppFiles
+ stdlib_bitsets.fypp
+ stdlib_bitsets_64.fypp
+ stdlib_bitsets_large.fypp
stdlib_io.fypp
stdlib_linalg.fypp
stdlib_linalg_diag.fypp
diff --git a/src/Makefile.manual b/src/Makefile.manual
index 1c731b9bb..872f704c0 100644
--- a/src/Makefile.manual
+++ b/src/Makefile.manual
@@ -1,5 +1,8 @@
SRC = f18estop.f90 \
stdlib_ascii.f90 \
+ stdlib_bitsets.f90 \
+ stdlib_bitsets_64.f90 \
+ stdlib_bitsets_large.f90 \
stdlib_error.f90 \
stdlib_io.f90 \
stdlib_kinds.f90 \
@@ -40,6 +43,9 @@ clean:
# Fortran module dependencies
f18estop.o: stdlib_error.o
+stdlib_bitsets.o: stdlib_kinds.o
+stdlib_bitsets_64.o: stdlib_bitsets.o
+stdlib_bitsets_large.o: stdlib_bitsets.o
stdlib_error.o: stdlib_optval.o
stdlib_io.o: \
stdlib_error.o \
@@ -63,6 +69,9 @@ stdlib_stats_var.o: \
stdlib_stats.o
# Fortran sources that are built from fypp templates
+stdlib_bitsets_64.f90: stdlib_bitsets_64.fypp
+stdlib_bitsets_large.f90: stdlib_bitsets_large.fypp
+stdlib_bitsets.f90: stdlib_bitsets.fypp
stdlib_io.f90: stdlib_io.fypp
stdlib_linalg.f90: stdlib_linalg.fypp
stdlib_linalg_diag.f90: stdlib_linalg_diag.fypp
diff --git a/src/stdlib_bitsets.fypp b/src/stdlib_bitsets.fypp
new file mode 100644
index 000000000..881a7bd2c
--- /dev/null
+++ b/src/stdlib_bitsets.fypp
@@ -0,0 +1,2137 @@
+#:include "common.fypp"
+module stdlib_bitsets
+!! Implements zero based bitsets of size up to `huge(0_int32)`.
+!! The current code uses 64 bit integers to store the bits and uses all 64 bits.
+!! The code assumes two's complement integers, and treats negative integers as
+!! having the sign bit set.
+
+ use :: stdlib_kinds, only: &
+ bits_kind => int32, & ! If changed change also max_digits, and
+ block_kind => int64, & ! overflow_bits
+ int8, &
+ int16, &
+ int32, &
+ int64
+
+ use, intrinsic :: &
+ iso_fortran_env, only: &
+ error_unit
+
+ implicit none
+
+ private
+
+ integer(bits_kind), parameter :: &
+ block_size = bit_size(0_block_kind)
+
+ public :: max_digits, overflow_bits
+ integer, parameter :: &
+ max_digits = 10 ! bits_kind == int32
+! max_digits = 19 ! bits_kind == int64
+
+ integer(bits_kind), parameter :: &
+ overflow_bits = 2_bits_kind**30/5 ! bits_kind == int32
+! overflow_bits = 2_bits_kind**62/5 ! bits_kind == int64
+
+ integer(block_kind), parameter :: all_zeros = 0_block_kind
+ integer(block_kind), parameter :: all_ones = not(all_zeros)
+
+ character(*), parameter :: module_name = "STDLIB_BITSETS"
+ integer, parameter :: &
+ ia0 = iachar('0'), &
+ ia9 = iachar('9')
+
+ integer, parameter, public :: success = 0
+!! Error flag indicating no errors
+ integer, parameter, public :: alloc_fault = 1
+!! Error flag indicating a memory allocation failure
+ integer, parameter, public :: array_size_invalid_error = 2
+!! Error flag indicating an invalid bits value
+ integer, parameter, public :: char_string_invalid_error = 3
+!! Error flag indicating an invalid character string
+ integer, parameter, public :: char_string_too_large_error = 4
+!! Error flag indicating a too large character string
+ integer, parameter, public :: char_string_too_small_error = 5
+!! Error flag indicating a too small character string
+ integer, parameter, public :: eof_failure = 6
+!! Error flag indicating unexpected End-of-File on a READ
+ integer, parameter, public :: index_invalid_error = 7
+!! Error flag indicating an invalid index
+ integer, parameter, public :: integer_overflow_error = 8
+!! Error flag indicating integer overflow
+ integer, parameter, public :: read_failure = 9
+!! Error flag indicating failure of a READ statement
+ integer, parameter, public :: write_failure = 10
+!! Error flag indicating a failure on a WRITE statement
+
+ public :: bits_kind
+! Public constant
+
+ public :: &
+ bitset_type, &
+ bitset_large, &
+ bitset_64
+
+! Public types
+
+ public :: &
+ assignment(=), &
+ and, &
+ and_not, &
+ bits, &
+ extract, &
+ operator(==), &
+ operator(/=), &
+ operator(>), &
+ operator(>=), &
+ operator(<), &
+ operator(<=), &
+ or, &
+ xor
+!! Public procedures
+
+ public :: error_handler
+
+ type, abstract :: bitset_type
+!! version: experimental
+!!
+!! Parent type for bitset_64 and bitset_large
+ private
+ integer(bits_kind) :: num_bits
+
+ contains
+
+ procedure(all_abstract), deferred, pass(self) :: all
+ procedure(any_abstract), deferred, pass(self) :: any
+ procedure(bit_count_abstract), deferred, pass(self) :: bit_count
+ procedure, pass(self) :: bits
+ procedure(clear_bit_abstract), deferred, pass(self) :: clear_bit
+ procedure(clear_range_abstract), deferred, pass(self) :: clear_range
+ generic :: clear => clear_bit, clear_range
+ procedure(flip_bit_abstract), deferred, pass(self) :: flip_bit
+ procedure(flip_range_abstract), deferred, pass(self) :: flip_range
+ generic :: flip => flip_bit, flip_range
+ procedure(from_string_abstract), deferred, pass(self) :: from_string
+ procedure(init_zero_abstract), deferred, pass(self) :: init_zero
+ generic :: init => init_zero
+ procedure(input_abstract), deferred, pass(self) :: input
+ procedure(none_abstract), deferred, pass(self) :: none
+ procedure(not_abstract), deferred, pass(self) :: not
+ procedure(output_abstract), deferred, pass(self) :: output
+ procedure(read_bitset_string_abstract), deferred, pass(self) :: &
+ read_bitset_string
+ procedure(read_bitset_unit_abstract), deferred, pass(self) :: &
+ read_bitset_unit
+ generic :: read_bitset => read_bitset_string, read_bitset_unit
+ procedure(set_bit_abstract), deferred, pass(self) :: set_bit
+ procedure(set_range_abstract), deferred, pass(self) :: set_range
+ generic :: set => set_bit, set_range
+ procedure(test_abstract), deferred, pass(self) :: test
+ procedure(to_string_abstract), deferred, pass(self) :: to_string
+ procedure(value_abstract), deferred, pass(self) :: value
+ procedure(write_bitset_string_abstract), deferred, pass(self) :: &
+ write_bitset_string
+ procedure(write_bitset_unit_abstract), deferred, pass(self) :: &
+ write_bitset_unit
+ generic :: write_bitset => write_bitset_string, write_bitset_unit
+
+ end type bitset_type
+
+
+ abstract interface
+
+ elemental function all_abstract( self ) result(all)
+!! Version: experimental
+!!
+!! Returns `.true.` if all bits in `self` are 1, `.false.` otherwise.
+!!
+!!#### Example
+!!
+!!```fortran
+!! program demo_all
+!! use stdlib_bitsets
+!! character(*), parameter :: &
+!! bits_all = '111111111111111111111111111111111'
+!! type(bitset_64) :: set0
+!! call set0 % from_string( bits_all )
+!! if ( bits(set0) /= 33 ) then
+!! error stop "FROM_STRING failed to interpret " // &
+!! 'BITS_ALL's size properly."
+!! else if ( .not. set0 % all() ) then
+!! error stop "FROM_STRING failed to interpret" // &
+!! "BITS_ALL's value properly."
+!! else
+!! write(*,*) "FROM_STRING transferred BITS_ALL properly" // &
+!! " into set0."
+!! end if
+!! end program demo_all
+!!```
+ import :: bitset_type
+ logical :: all
+ class(bitset_type), intent(in) :: self
+ end function all_abstract
+
+ elemental function any_abstract(self) result(any)
+!! Version: experimental
+!!
+!! Returns `.true.` if any bit in `self` is 1, `.false.` otherwise.
+!!
+!!#### Example
+!!
+!!```fortran
+!! program demo_any
+!! use stdlib_bitsets
+!! character(*), parameter :: &
+!! bits_0 = '0000000000000000000'
+!! type(bitset_64) :: set0
+!! call set0 % from_string( bits_0 )
+!! if ( .not. set0 % any() ) then
+!! write(*,*) "FROM_STRING interpreted " // &
+!! "BITS_0's value properly."
+!! end if
+!! call set0 % set(5)
+!! if ( set0 % any() ) then
+!! write(*,*) "ANY interpreted SET0's value properly."
+!! end if
+!! end program demo_any
+!!```
+ import :: bitset_type
+ logical :: any
+ class(bitset_type), intent(in) :: self
+ end function any_abstract
+
+ elemental function bit_count_abstract(self) result(bit_count)
+!! Version: experimental
+!!
+!! Returns the number of non-zero bits in `self`.
+!!
+!!#### Example
+!!
+!!```fortran
+!! program demo_bit_count
+!! use stdlib_bitsets
+!! character(*), parameter :: &
+!! bits_0 = '0000000000000000000'
+!! type(bitset_64) :: set0
+!! call set0 % from_string( bits_0 )
+!! if ( set0 % bit_count() == 0 ) then
+!! write(*,*) "FROM_STRING interpreted " // &
+!! "BITS_0's value properly."
+!! end if
+!! call set0 % set(5)
+!! if ( set0 % bit_count() == 1 ) then
+!! write(*,*) "BIT_COUNT interpreted SET0's value properly."
+!! end if
+!! end program demo_bit_count
+!!```
+ import :: bitset_type, bits_kind
+ integer(bits_kind) :: bit_count
+ class(bitset_type), intent(in) :: self
+ end function bit_count_abstract
+
+ elemental subroutine clear_bit_abstract(self, pos)
+!! Version: experimental
+!!
+!! Sets to zero the `pos` position in `self`. If `pos` is less than zero or
+!! greater than `bits(self)-1` it is ignored.
+!!
+!!#### Example
+!!
+!!```fortran
+!! program demo_clear
+!! use stdlib_bitsets
+!! type(bitset_large) :: set0
+!! call set0 % init(166)
+!! call set0 % not()
+!! if ( set0 % all() ) write(*,*) 'SET0 is properly initialized.'
+!! call set0 % clear(165)
+!! if ( .not. set0 % test(165) ) write(*,*) 'Bit 165 is cleared.'
+!! call set0 % clear(0,164)
+!! if ( set0 % none() ) write(*,*) 'All bits are cleared.'
+!! end program demo_clear
+!!```
+ import :: bitset_type, bits_kind
+ class(bitset_type), intent(inout) :: self
+ integer(bits_kind), intent(in) :: pos
+ end subroutine clear_bit_abstract
+
+ pure subroutine clear_range_abstract(self, start_pos, stop_pos)
+!! Version: experimental
+!!
+!! Sets to zero all bits from the `start_pos` to `stop_pos` positions in `set`.
+!! If `stop_pos < start_pos` then no bits are modified. Positions outside
+!! the range 0 to `bits(self)-1` are ignored.
+ import :: bitset_type, bits_kind
+ class(bitset_type), intent(inout) :: self
+ integer(bits_kind), intent(in) :: start_pos, stop_pos
+ end subroutine clear_range_abstract
+
+ elemental subroutine flip_bit_abstract(self, pos)
+!! Version: experimental
+!!
+!! Flips the value at the `pos` position in `self`, provided the position is
+!! valid. If `pos` is less than 0 or greater than `bits(self)-1`, no value is
+!! changed.
+!!
+!!#### Example
+!!
+!!```fortran
+!! program demo_flip
+!! use stdlib_bitsets
+!! type(bitset_large) :: set0
+!! call set0 % init(166)
+!! if ( set0 % none() ) write(*,*) 'SET0 is properly initialized.'
+!! call set0 % flip(165)
+!! if ( set0 % test(165) ) write(*,*) 'Bit 165 is flipped.'
+!! call set0 % flip(0,164)
+!! if ( set0 % all() ) write(*,*) 'All bits are flipped.'
+!! end program demo_flip
+!!```
+ import :: bitset_type, bits_kind
+ class(bitset_type), intent(inout) :: self
+ integer(bits_kind), intent(in) :: pos
+ end subroutine flip_bit_abstract
+
+ pure subroutine flip_range_abstract(self, start_pos, stop_pos)
+!! Version: experimental
+!!
+!! Flips all valid bits from the `start_pos` to the `stop_pos` positions in
+!! `self`. If `stop_pos < start_pos` no bits are flipped. Positions less than
+!! 0 or greater than `bits(self)-1` are ignored.
+ import :: bitset_type, bits_kind
+ class(bitset_type), intent(inout) :: self
+ integer(bits_kind), intent(in) :: start_pos, stop_pos
+ end subroutine flip_range_abstract
+
+ subroutine from_string_abstract(self, string, status)
+!! Version: experimental
+!!
+!! Initializes the bitset `self` treating `string` as a binary literal
+!! `status` may have the values:
+!! * `success` - if no problems were found,
+!! * `alloc_fault` - if allocation of the bitset failed
+!! * `char_string_too_large_error` - if `string` was too large, or
+!! * `char_string_invalid_error` - if string had an invalid character.
+!!
+!!#### Example
+!!
+!!```fortran
+!! program demo_from_string
+!! use stdlib_bitsets
+!! character(*), parameter :: &
+!! bits_all = '111111111111111111111111111111111'
+!! type(bitset_64) :: set0
+!! call set0 % from_string( bits_all )
+!! if ( bits(set0) /= 33 ) then
+!! error stop "FROM_STRING failed to interpret " // &
+!! 'BITS_ALL's size properly."
+!! else if ( .not. set0 % all() ) then
+!! error stop "FROM_STRING failed to interpret" // &
+!! "BITS_ALL's value properly."
+!! else
+!! write(*,*) "FROM_STRING transferred BITS_ALL properly" // &
+!! " into set0."
+!! end if
+!! end program demo_from_string
+!!```
+ import :: bitset_type
+ class(bitset_type), intent(out) :: self
+ character(*), intent(in) :: string
+ integer, intent(out), optional :: status
+ end subroutine from_string_abstract
+
+ subroutine init_zero_abstract(self, bits, status)
+!! Creates the bitset, `self`, of size `bits`, with all bits initialized to
+!! zero. `bits` must be non-negative. If an error occurs and `status` is
+!! absent then processing stops with an informative stop code. `status`
+!! will have one of the values;
+!! * `success` - if no problems were found,
+!! * `alloc_fault` - if memory allocation failed
+!! * `array_size_invalid_error` - if `bits` is either negative or larger
+!! than 64 with `self` of class `bitset_64`, or
+!!
+!!#### Example
+!!
+!!```fortran
+!! program demo_init
+!! use stdlib_bitsets
+!! type(bitset_large) :: set0
+!! call set0 % init(166)
+!! if ( set0 % bits() == 166 ) &
+!! write(*,*) `SET0 has the proper size.'
+!! if ( set0 % none() ) write(*,*) 'SET0 is properly initialized.'
+!! end program demo_init
+!!```
+ import :: bitset_type, bits_kind
+ class(bitset_type), intent(out) :: self
+ integer(bits_kind), intent(in) :: bits
+ integer, intent(out), optional :: status
+ end subroutine init_zero_abstract
+
+ subroutine input_abstract(self, unit, status)
+!! Version: experimental
+!!
+!! Reads the components of the bitset, `self`, from the unformatted I/O
+!! unit, `unit`, assuming that the components were written using `output`.
+!! If an error occurs and `status` is absent then processing stops with
+!! an informative stop code. `status` has one of the values:
+!! * `success` - if no problem was found
+!! * `alloc_fault` - if it failed allocating memory for `self`, or
+!! * `array_size_invalid_error` if the `bits(self)` in `unit` is negative
+!! or greater than 64 for a `bitset_64` input.
+!! * `read_failure` - if it failed during the reads from `unit`
+!!
+!!#### Example
+!!
+!!```fortran
+!! program demo_input
+!! character(*), parameter :: &
+!! bits_0 = '000000000000000000000000000000000', &
+!! bits_1 = '000000000000000000000000000000001', &
+!! bits_33 = '100000000000000000000000000000000'
+!! integer :: unit
+!! type(bitset_64) :: set0, set1, set2, set3, set4, set5
+!! call set0 % from_string( bits_0 )
+!! call set1 % from_string( bits_1 )
+!! call set2 % from_string( bits_33 )
+!! open( newunit=unit, file='test.bin', status='replace', &
+!! form='unformatted', action='write' )
+!! call set2 % output(unit)
+!! call set1 % output(unit)
+!! call set0 % output(unit)
+!! close( unit )
+!! open( newunit=unit, file='test.bin', status='old', &
+!! form='unformatted', action='read' )
+!! call set5 % input(unit)
+!! call set4 % input(unit)
+!! call set3 % input(unit)
+!! close( unit )
+!! if ( set3 /= set0 .or. set4 /= set1 .or. set5 /= set2 ) then
+!! error stop 'Transfer to and from units using ' // &
+!! ' output and input failed.'
+!! else
+!! write(*,*) 'Transfer to and from units using ' // &
+!! 'output and input succeeded.'
+!! end if
+!! end program demo_input
+!!```
+ import :: bitset_type
+ class(bitset_type), intent(out) :: self
+ integer, intent(in) :: unit
+ integer, intent(out), optional :: status
+ end subroutine input_abstract
+
+ elemental function none_abstract(self) result(none)
+!! Version: experimental
+!!
+!! Returns `.true.` if none of the bits in `self` have the value 1.
+!!
+!!#### Example
+!!
+!!```fortran
+!! program demo_none
+!! use stdlib_bitsets
+!! character(*), parameter :: &
+!! bits_0 = '0000000000000000000'
+!! type(bitset_large) :: set0
+!! call set0 % from_string( bits_0 )
+!! if ( set0 % none() ) then
+!! write(*,*) "FROM_STRING interpreted " // &
+!! "BITS_0's value properly."
+!! end if
+!! call set0 % set(5)
+!! if ( .not. set0 % none() ) then
+!! write(*,*) "NONE interpreted SET0's value properly."
+!! end if
+!! end program demo_none
+!!```
+ import :: bitset_type
+ logical :: none
+ class(bitset_type), intent(in) :: self
+ end function none_abstract
+
+ elemental subroutine not_abstract(self)
+!! Version: experimental
+!!
+!! Sets the bits in `self` to their logical complement
+!!
+!!#### Example
+!!
+!!```fortran
+!! program demo_not
+!! use stdlib_bitsets
+!! type(bitset_large) :: set0
+!! call set0 % init( 155 )
+!! if ( set0 % none() ) then
+!! write(*,*) "FROM_STRING interpreted " // &
+!! "BITS_0's value properly."
+!! end if
+!! call set0 % not()
+!! if ( set0 % all() ) then
+!! write(*,*) "ALL interpreted SET0's value properly."
+!! end if
+!! end program demo_not
+!!```
+ import :: bitset_type
+ class(bitset_type), intent(inout) :: self
+ end subroutine not_abstract
+
+ subroutine output_abstract(self, unit, status)
+!! Version: experimental
+!!
+!! Writes the components of the bitset, `self`, to the unformatted I/O
+!! unit, `unit`, in a unformatted sequence compatible with `input`. If
+!! `status` is absent an error results in an error stop with an
+!! informative stop code. If `status` is present it has the default
+!! value of `success`, or the value `write_failure` if the write failed.
+!!
+!!#### Example
+!!
+!!```fortran
+!! program demo_output
+!! character(*), parameter :: &
+!! bits_0 = '000000000000000000000000000000000', &
+!! bits_1 = '000000000000000000000000000000001', &
+!! bits_33 = '100000000000000000000000000000000'
+!! integer :: unit
+!! type(bitset_64) :: set0, set1, set2, set3, set4, set5
+!! call set0 % from_string( bits_0 )
+!! call set1 % from_string( bits_1 )
+!! call set2 % from_string( bits_33 )
+!! open( newunit=unit, file='test.bin', status='replace', &
+!! form='unformatted', action='write' )
+!! call set2 % output(unit)
+!! call set1 % output(unit)
+!! call set0 % output(unit)
+!! close( unit )
+!! open( newunit=unit, file='test.bin', status='old', &
+!! form='unformatted', action='read' )
+!! call set5 % input(unit)
+!! call set4 % input(unit)
+!! call set3 % input(unit)
+!! close( unit )
+!! if ( set3 /= set0 .or. set4 /= set1 .or. set5 /= set2 ) then
+!! error stop 'Transfer to and from units using ' // &
+!! ' output and input failed.'
+!! else
+!! write(*,*) 'Transfer to and from units using ' // &
+!! 'output and input succeeded.'
+!! end if
+!! end program demo_output
+!!```
+ import :: bitset_type
+ class(bitset_type), intent(in) :: self
+ integer, intent(in) :: unit
+ integer, intent(out), optional :: status
+ end subroutine output_abstract
+
+ subroutine read_bitset_string_abstract(self, string, status)
+!! Version: experimental
+!!
+!! Uses the bitset literal in the default character `string`, to define
+!! the bitset, `self`. The literal may be preceded by an an arbitrary
+!! sequence of blank characters. If `status` is absent an error results
+!! in an error stop with an informative stop code. If `status`
+!! is present it has one of the values
+!! * `success` - if no problems occurred,
+!! * `alloc_fault` - if allocation of memory for SELF failed,
+!! * `array_size_invalid_error - if `bits(self)` in `string` is greater
+!! than 64 for a `bitset_64`,
+!! * `char_string_invalid_error` - if the bitset literal has an invalid
+!! character,
+!! * `char_string_too_small_error - if the string ends before all the bits
+!! are read.
+!! * `integer_overflow_error` - if the bitset literal has a `bits(self)`
+!! value too large to be represented,
+!!
+!!#### Example
+!!
+!!```fortran
+!! program demo_read_bitset
+!! character(*), parameter :: &
+!! bits_0 = 'S33B000000000000000000000000000000000', &
+!! bits_1 = 'S33B000000000000000000000000000000001', &
+!! bits_33 = 'S33B100000000000000000000000000000000'
+!! character(:), allocatable :: test_0, test_1, test_2
+!! integer :: unit
+!! type(bitset_64) :: set0, set1, set2, set3, set4, set5
+!! call set0 % read_bitset( bits_0, status )
+!! call set1 % read_bitset( bits_1, status )
+!! call set2 % read_bitset( bits_2, status )
+!! call set0 % write_bitset( test_0, status )
+!! call set1 % write_bitset( test_1, status )
+!! call set2 % write_bitset( test_2, status )
+!! if ( bits_0 == test_0 .and. bits_1 == test_1 .and. &
+!! bits_2 == test_2 ) then
+!! write(*,*) 'READ_BITSET to WRITE_BITSET strings worked.'
+!! end if
+!! open( newunit=unit, file='test.txt', status='replace', &
+!! form='formatted', action='write' )
+!! call set2 % write_bitset(unit, advance='no')
+!! call set1 % write_bitset(unit, advance='no')
+!! call set0 % write_bitset(unit)
+!! close( unit )
+!! open( newunit=unit, file='test.txt', status='old', &
+!! form='formatted', action='read' )
+!! call set3 % read_bitset(unit, advance='no')
+!! call set4 % read_bitset(unit, advance='no')
+!! call set5 % read_bitset(unit)
+!! if ( set3 == set0 .and. set4 == set1 .and. set5 == set2 ) then
+!! write(*,*) WRITE_BITSET to READ_BITSET through unit worked.'
+!! end if
+!! end program demo_read_bitset
+!!```
+ import :: bitset_type
+ class(bitset_type), intent(out) :: self
+ character(len=*), intent(in) :: string
+ integer, intent(out), optional :: status
+ end subroutine read_bitset_string_abstract
+
+ subroutine read_bitset_unit_abstract(self, unit, advance, status)
+!! Version: experimental
+!!
+!! Uses the bitset literal at the current position in the formatted
+!! file with I/O unit, `unit`, to define the bitset, `self`. The literal
+!! may be preceded by an an arbitrary sequence of blank characters.
+!! If `advance` is present it must be either 'YES' or 'NO'. If absent
+!! it has the default value of 'YES' to determine whether advancing
+!! I/O occurs. If `status` is absent an error results in an error stop
+!! with an informative stop code. If `status` is present it has one of
+!! the values:
+!! * `success` - if no problem occurred,
+!! * `alloc_fault` - if allocation of `self` failed,
+!! * `array_size_invalid_error` - if `bits(self)` in the bitset literal
+!! is greater than 64 for a `bitset_64`,
+!! * `char_string_invalid_error` - if the read of the bitset literal found
+!! an invalid character,
+!! * `eof_failure` - if a `read` statement reached an end-of-file before
+!! completing the read of the bitset literal,
+!! * `integer_overflow_error` - if the bitset literal has a `bits(self)`
+!! value too large to be represented,
+!! * `read_failure` - if a `read` statement fails,
+!
+ import :: bitset_type
+ class(bitset_type), intent(out) :: self
+ integer, intent(in) :: unit
+ character(*), intent(in), optional :: advance
+ integer, intent(out), optional :: status
+ end subroutine read_bitset_unit_abstract
+
+ elemental subroutine set_bit_abstract(self, pos)
+!! Version: experimental
+!!
+!! Sets the value at the `pos` position in `self`, provided the position is
+!! valid. If the position is less than 0 or greater than `bits(self)-1`
+!! then `self` is unchanged.
+!!
+!!#### Example
+!!
+!!```fortran
+!! program demo_set
+!! use stdlib_bitsets
+!! type(bitset_large) :: set0
+!! call set0 % init(166)
+!! if ( set0 % none() ) write(*,*) 'SET0 is properly initialized.'
+!! call set0 % set(165)
+!! if ( set0 % test(165) ) write(*,*) 'Bit 165 is set.'
+!! call set0 % set(0,164)
+!! if ( set0 % all() ) write(*,*) 'All bits are set.'
+!! end program demo_set
+!!```
+ import :: bitset_type, bits_kind
+ class(bitset_type), intent(inout) :: self
+ integer(bits_kind), intent(in) :: pos
+ end subroutine set_bit_abstract
+
+ pure subroutine set_range_abstract(self, start_pos, stop_pos)
+!! Version: experimental
+!!
+!! Sets all valid bits to 1 from the `start_pos` to the `stop_pos` positions
+!! in `self`. If `stop_pos < start_pos` no bits are changed. Positions outside
+!! the range 0 to `bits(self)-1` are ignored.
+ import :: bitset_type, bits_kind
+ class(bitset_type), intent(inout) :: self
+ integer(bits_kind), intent(in) :: start_pos, stop_pos
+ end subroutine set_range_abstract
+
+ elemental function test_abstract(self, pos) result(test)
+!! Version: experimental
+!!
+!! Returns `.true.` if the `pos` position is set, `.false.` otherwise. If `pos`
+!! is negative or greater than `bits(self) - 1` the result is `.false.`.
+!!
+!!#### Example
+!!
+!!```fortran
+!! program demo_test
+!! use stdlib_bitsets
+!! type(bitset_large) :: set0
+!! call set0 % init(166)
+!! call set0 % not()
+!! if ( set0 % all() ) write(*,*) 'SET0 is properly initialized.'
+!! call set0 % clear(165)
+!! if ( .not. set0 % test(165) ) write(*,*) 'Bit 165 is cleared.'
+!! call set0 % set(165)
+!! if ( set0 % test(165) ) write(*,*) 'Bit 165 is set.'
+!! end program demo_test
+!!```
+ import :: bitset_type, bits_kind
+ logical :: test
+ class(bitset_type), intent(in) :: self
+ integer(bits_kind), intent(in) :: pos
+ end function test_abstract
+
+ subroutine to_string_abstract(self, string, status)
+!! Version: experimental
+!!
+!! Represents the value of `self` as a binary literal in `string`
+!! Status may have the values `success` or `alloc_fault`.
+!!
+!!#### Example
+!!
+!!```fortran
+!! program demo_to_string
+!! use stdlib_bitsets
+!! character(*), parameter :: &
+!! bits_all = '111111111111111111111111111111111'
+!! type(bitset_64) :: set0
+!! character(:), allocatable :: new_string
+!! call set0 % init(33)
+!! call set0 % not()
+!! call set0 % to_string( new_string )
+!! if ( new_string == bits_all ) then
+!! write(*,*) "TO_STRING transferred BITS0 properly" // &
+!! " into NEW_STRING."
+!! end if
+!! end program demo_to_string
+!!```
+ import :: bitset_type
+ class(bitset_type), intent(in) :: self
+ character(:), allocatable, intent(out) :: string
+ integer, intent(out), optional :: status
+ end subroutine to_string_abstract
+
+ elemental function value_abstract(self, pos) result(value)
+!! Version: experimental
+!!
+!! Returns 1 if the `pos` position is set, 0 otherwise. If `pos` is negative
+!! or greater than `bits(set) - 1` the result is 0.
+!!
+!!#### Example
+!!
+!!```fortran
+!! program demo_value
+!! use stdlib_bitsets
+!! type(bitset_large) :: set0
+!! call set0 % init(166)
+!! call set0 % not()
+!! if ( set0 % all() ) write(*,*) 'SET0 is properly initialized.'
+!! call set0 % clear(165)
+!! if ( set0 % value(165) == 0 ) write(*,*) 'Bit 165 is cleared.'
+!! call set0 % set(165)
+!! if ( set0 % value(165) == 1 ) write(*,*) 'Bit 165 is set.'
+!! end program demo_value
+!!```
+ import :: bitset_type, bits_kind
+ integer :: value
+ class(bitset_type), intent(in) :: self
+ integer(bits_kind), intent(in) :: pos
+ end function value_abstract
+
+ subroutine write_bitset_string_abstract(self, string, status)
+!! Version: experimental
+!!
+!! Writes a bitset literal to the allocatable default character `string`,
+!! representing the individual bit values in the `bitset_type`, `self`.
+!! If `status` is absent an error results in an error stop with an
+!! informative stop code. If `status` is present it has the default
+!! value of `success`, or the value `alloc_fault` if allocation of
+!! the output string failed.
+!!
+!!#### Example
+!!
+!!```fortran
+!! program demo_write_bitset
+!! character(*), parameter :: &
+!! bits_0 = 'S33B000000000000000000000000000000000', &
+!! bits_1 = 'S33B000000000000000000000000000000001', &
+!! bits_33 = 'S33B100000000000000000000000000000000'
+!! character(:), allocatable :: test_0, test_1, test_2
+!! integer :: unit
+!! type(bitset_64) :: set0, set1, set2, set3, set4, set5
+!! call set0 % read_bitset( bits_0, status )
+!! call set1 % read_bitset( bits_1, status )
+!! call set2 % read_bitset( bits_2, status )
+!! call set0 % write_bitset( test_0, status )
+!! call set1 % write_bitset( test_1, status )
+!! call set2 % write_bitset( test_2, status )
+!! if ( bits_0 == test_0 .and. bits_1 == test_1 .and. &
+!! bits_2 == test_2 ) then
+!! write(*,*) 'READ_BITSET to WRITE_BITSET strings worked.'
+!! end if
+!! open( newunit=unit, file='test.txt', status='replace', &
+!! form='formatted', action='write' )
+!! call set2 % write_bitset(unit, advance='no')
+!! call set1 % write_bitset(unit, advance='no')
+!! call set0 % write_bitset(unit)
+!! close( unit )
+!! open( newunit=unit, file='test.txt', status='old', &
+!! form='formatted', action='read' )
+!! call set3 % read_bitset(unit, advance='no')
+!! call set4 % read_bitset(unit, advance='no')
+!! call set5 % read_bitset(unit)
+!! if ( set3 == set0 .and. set4 == set1 .and. set5 == set2 ) then
+!! write(*,*) WRITE_BITSET to READ_BITSET through unit worked.'
+!! end if
+!! end program demo_write_bitset
+!!```
+ import :: bitset_type
+ class(bitset_type), intent(in) :: self
+ character(len=:), allocatable, intent(out) :: string
+ integer, intent(out), optional :: status
+ end subroutine write_bitset_string_abstract
+
+ subroutine write_bitset_unit_abstract(self, unit, advance, &
+ status)
+!! Version: experimental
+!!
+!! Writes a bitset literal to the I/O unit, `unit`, representing the
+!! individual bit values in the `bitset_t`, `self`. If an error occurs then
+!! processing stops with a message to `error_unit`. By default or if
+!! `advance` is present with the value 'YES', advancing output is used.
+!! If `advance` is present with the value 'NO', then the current record
+!! is not advanced by the write. If `status` is absent, an error results
+!! in an error stop with an informative stop code. If `status` is
+!! present it has the default value of `success`, the value
+!! `alloc_fault` if allocation of the output string failed,
+!! `write_failure` if the `write` statement outputting the literal failed.
+ import :: bitset_type
+ class(bitset_type), intent(in) :: self
+ integer, intent(in) :: unit
+ character(len=*), intent(in), optional :: advance
+ integer, intent(out), optional :: status
+ end subroutine write_bitset_unit_abstract
+
+ end interface
+
+ type, extends(bitset_type) :: bitset_large
+!! Version: experimental
+!!
+!! Type for bitsets with more than 64 bits.
+ private
+ integer(block_kind), private, allocatable :: blocks(:)
+
+ contains
+
+ procedure, pass(self) :: all => all_large
+ procedure, pass(self) :: any => any_large
+ procedure, pass(self) :: bit_count => bit_count_large
+ procedure, pass(self) :: clear_bit => clear_bit_large
+ procedure, pass(self) :: clear_range => clear_range_large
+ procedure, pass(self) :: flip_bit => flip_bit_large
+ procedure, pass(self) :: flip_range => flip_range_large
+ procedure, pass(self) :: from_string => from_string_large
+ procedure, pass(self) :: init_zero => init_zero_large
+ procedure, pass(self) :: input => input_large
+ procedure, pass(self) :: none => none_large
+ procedure, pass(self) :: not => not_large
+ procedure, pass(self) :: output => output_large
+ procedure, pass(self) :: &
+ read_bitset_string => read_bitset_string_large
+ procedure, pass(self) :: read_bitset_unit => read_bitset_unit_large
+ procedure, pass(self) :: set_bit => set_bit_large
+ procedure, pass(self) :: set_range => set_range_large
+ procedure, pass(self) :: test => test_large
+ procedure, pass(self) :: to_string => to_string_large
+ procedure, pass(self) :: value => value_large
+ procedure, pass(self) :: &
+ write_bitset_string => write_bitset_string_large
+ procedure, pass(self) :: write_bitset_unit => write_bitset_unit_large
+
+ end type bitset_large
+
+
+ interface
+
+ elemental module function all_large( self ) result(all)
+!! Version: experimental
+!!
+!! Returns `.true.` if all bits in `self` are 1, `.false.` otherwise.
+ logical :: all
+ class(bitset_large), intent(in) :: self
+ end function all_large
+
+ elemental module function any_large(self) result(any)
+!! Version: experimental
+!!
+!! Returns `.true.` if any bit in `self` is 1, `.false.` otherwise.
+ logical :: any
+ class(bitset_large), intent(in) :: self
+ end function any_large
+
+ elemental module function bit_count_large(self) result(bit_count)
+!! Version: experimental
+!!
+!! Returns the number of non-zero bits in `self`.
+ integer(bits_kind) :: bit_count
+ class(bitset_large), intent(in) :: self
+ end function bit_count_large
+
+ elemental module subroutine clear_bit_large(self, pos)
+!! Version: experimental
+!!
+!! Sets to zero the bit at `pos` position in `self`. If `pos` is less than
+!! zero or greater than `bits(self)-1` it is ignored.
+ class(bitset_large), intent(inout) :: self
+ integer(bits_kind), intent(in) :: pos
+ end subroutine clear_bit_large
+
+ pure module subroutine clear_range_large(self, start_pos, stop_pos)
+!! Version: experimental
+!!
+!! Sets to zero all bits from the `start_pos` to `stop_pos` positions in `self`.
+!! If `stop_pos < start_pos` then no bits are modified. Positions outside
+!! the range 0 to `bits(set)-1` are ignored.
+ class(bitset_large), intent(inout) :: self
+ integer(bits_kind), intent(in) :: start_pos, stop_pos
+ end subroutine clear_range_large
+
+ elemental module subroutine flip_bit_large(self, pos)
+!! Version: experimental
+!!
+!! Flips the bit value at the `pos` position in `self`, provided the position is
+!! valid. If `pos` is less than 0 or greater than `bits(self)-1`, no value is
+!! changed.
+ class(bitset_large), intent(inout) :: self
+ integer(bits_kind), intent(in) :: pos
+ end subroutine flip_bit_large
+
+ pure module subroutine flip_range_large(self, start_pos, stop_pos)
+!! Version: experimental
+!!
+!! Flips all valid bits from the `start_pos` to the `stop_pos` positions in
+!! `self`. If `stop_pos < start_pos` no bits are flipped. Positions less than
+!! 0 or greater than `bits(self)-1` are ignored.
+ class(bitset_large), intent(inout) :: self
+ integer(bits_kind), intent(in) :: start_pos, stop_pos
+ end subroutine flip_range_large
+
+ module subroutine from_string_large(self, string, status)
+!! Version: experimental
+!!
+!! Initializes the bitset `self` treating `string` as a binary literal
+!! `status` may have the values:
+!! * `success` - if no problems were found,
+!! * `alloc_fault` - if allocation of the bitset failed
+!! * `char_string_too_large_error` - if `string` was too large, or
+!! * `char_string_invalid_error` - if string had an invalid character.
+ class(bitset_large), intent(out) :: self
+ character(*), intent(in) :: string
+ integer, intent(out), optional :: status
+ end subroutine from_string_large
+
+ module subroutine init_zero_large(self, bits, status)
+!! Version: experimental
+!!
+!! Creates the bitset, `self`, of size `bits`, with all bits initialized to
+!! zero. `bits` must be non-negative. If an error occurs and `status` is
+!! absent then processing stops with an informative stop code. `status`
+!! will have one of the values;
+!! * `success` - if no problems were found,
+!! * `alloc_fault` - if memory allocation failed
+!! * `array_size_invalid_error` - if `bits` is either negative or larger
+!! than 64 with `self` of class `bitset_64`, or
+ class(bitset_large), intent(out) :: self
+ integer(bits_kind), intent(in) :: bits
+ integer, intent(out), optional :: status
+ end subroutine init_zero_large
+
+ module subroutine input_large(self, unit, status)
+!! Version: experimental
+!!
+!! Reads the components of the bitset, `self`, from the unformatted I/O
+!! unit, `unit`, assuming that the components were written using `output`.
+!! If an error occurs and `status` is absent then processing stops with
+!! an informative stop code. `status` has one of the values:
+!! * `success` - if no problem was found
+!! * `alloc_fault` - if it failed allocating memory for `self`, or
+!! * `array_size_invalid_error` if the `bits(self)` in `unit` is negative
+!! or greater than 64 for a `bitset_64` input.
+!! * `read_failure` - if it failed during the reads from `unit`
+ class(bitset_large), intent(out) :: self
+ integer, intent(in) :: unit
+ integer, intent(out), optional :: status
+ end subroutine input_large
+
+ elemental module function none_large(self) result(none)
+!! Version: experimental
+!!
+!! Returns `.true.` if none of the bits in `self` have the value 1.
+ logical :: none
+ class(bitset_large), intent(in) :: self
+ end function none_large
+
+ elemental module subroutine not_large(self)
+!! Version: experimental
+!!
+!! Sets the bits in `self` to their logical complement
+ class(bitset_large), intent(inout) :: self
+ end subroutine not_large
+
+ module subroutine output_large(self, unit, status)
+!! Version: experimental
+!!
+!! Writes the components of the bitset, `self`, to the unformatted I/O
+!! unit, `unit`, in a unformatted sequence compatible with `input`. If
+!! `status` is absent an error results in an error stop with an
+!! informative stop code. If `status` is present it has the default
+!! value of `success`, or the value `write_failure` if the write failed.
+ class(bitset_large), intent(in) :: self
+ integer, intent(in) :: unit
+ integer, intent(out), optional :: status
+ end subroutine output_large
+
+ module subroutine read_bitset_string_large(self, string, status)
+!! Version: experimental
+!!
+!! Uses the bitset literal in the default character `string`, to define
+!! the bitset, `self`. The literal may be preceded by an an arbitrary
+!! sequence of blank characters. If `status` is absent an error results
+!! in an error stop with an informative stop code. If `status`
+!! is present it has one of the values
+!! * `success` - if no problems occurred,
+!! * `alloc_fault` - if allocation of memory for SELF failed,
+!! * `array_size_invalid_error - if `bits(self)` in `string` is greater
+!! than 64 for a `bitset_64`,
+!! * `char_string_invalid_error` - if the bitset literal has an invalid
+!! character,
+!! * `char_string_too_small_error - if the string ends before all the bits
+!! are read.
+!! * `integer_overflow_error` - if the bitset literal has a `bits(self)`
+!! value too large to be represented,
+ class(bitset_large), intent(out) :: self
+ character(len=*), intent(in) :: string
+ integer, intent(out), optional :: status
+ end subroutine read_bitset_string_large
+
+ module subroutine read_bitset_unit_large(self, unit, advance, status)
+!! Version: experimental
+!!
+!! Uses the bitset literal at the current position in the formatted
+!! file with I/O unit, `unit`, to define the bitset, `self`. The literal
+!! may be preceded by an an arbitrary sequence of blank characters.
+!! If `advance` is present it must be either 'YES' or 'NO'. If absent
+!! it has the default value of 'YES' to determine whether advancing
+!! I/O occurs. If `status` is absent an error results in an error stop
+!! with an informative stop code. If `status` is present it has one of
+!! the values:
+!! * `success` - if no problem occurred,
+!! * `alloc_fault` - if allocation of `self` failed,
+!! * `array_size_invalid_error` - if `bits(self)` in the bitset literal
+!! is greater than 64 for a `bitset_64`,
+!! * `char_string_invalid_error` - if the read of the bitset literal found
+!! an invalid character,
+!! * `eof_failure` - if a `read` statement reached an end-of-file before
+!! completing the read of the bitset literal,
+!! * `integer_overflow_error` - if the bitset literal has a `bits(self)`
+!! value too large to be represented,
+!! * `read_failure` - if a `read` statement fails,
+ class(bitset_large), intent(out) :: self
+ integer, intent(in) :: unit
+ character(*), intent(in), optional :: advance
+ integer, intent(out), optional :: status
+ end subroutine read_bitset_unit_large
+
+ elemental module subroutine set_bit_large(self, pos)
+!! Version: experimental
+!!
+!! Sets the value at the `pos` position in `self`, provided the position is
+!! valid. If the position is less than 0 or greater than `bits(self)-1`
+!! then `self` is unchanged.
+ class(bitset_large), intent(inout) :: self
+ integer(bits_kind), intent(in) :: pos
+ end subroutine set_bit_large
+
+ pure module subroutine set_range_large(self, start_pos, stop_pos)
+!! Version: experimental
+!!
+!! Sets all valid bits to 1 from the `start_pos` to the `stop_pos` positions
+!! in `self`. If `stop_pos < start_pos` no bits are changed. Positions outside
+!! the range 0 to `bits(self)-1` are ignored.
+ class(bitset_large), intent(inout) :: self
+ integer(bits_kind), intent(in) :: start_pos, stop_pos
+ end subroutine set_range_large
+
+ elemental module function test_large(self, pos) result(test)
+!! Version: experimental
+!!
+!! Returns `.true.` if the `pos` position is set, `.false.` otherwise. If `pos`
+!! is negative or greater than `bits(self) - 1` the result is `.false.`.
+ logical :: test
+ class(bitset_large), intent(in) :: self
+ integer(bits_kind), intent(in) :: pos
+ end function test_large
+
+ module subroutine to_string_large(self, string, status)
+!! Version: experimental
+!!
+!! Represents the value of `self` as a binary literal in `string`
+!! Status may have the values `success` or `alloc_fault`.
+ class(bitset_large), intent(in) :: self
+ character(len=:), allocatable, intent(out) :: string
+ integer, intent(out), optional :: status
+ end subroutine to_string_large
+
+ elemental module function value_large(self, pos) result(value)
+!! Version: experimental
+!!
+!! Returns 1 if the `pos` position is set, 0 otherwise. If `pos` is negative
+!! or greater than `bits(set) - 1` the result is 0.
+ integer :: value
+ class(bitset_large), intent(in) :: self
+ integer(bits_kind), intent(in) :: pos
+ end function value_large
+
+ module subroutine write_bitset_string_large(self, string, status)
+!! Version: experimental
+!!
+!! Writes a bitset literal to the allocatable default character `string`,
+!! representing the individual bit values in the bitset_large, `self`.
+!! If `status` is absent an error results in an error stop with an
+!! informative stop code. If `status` is present it has the default
+!! value of `success, or the value `alloc_fault` if allocation of
+!! the output string failed.
+ class(bitset_large), intent(in) :: self
+ character(len=:), allocatable, intent(out) :: string
+ integer, intent(out), optional :: status
+ end subroutine write_bitset_string_large
+
+ module subroutine write_bitset_unit_large(self, unit, advance, status)
+!! Version: experimental
+!!
+!! Writes a bitset literal to the I/O unit, `unit`, representing the
+!! individual bit values in the bitset, `self`. By default or if
+!! `advance` is present with the value 'YES', advancing output is used.
+!! If `advance` is present with the value 'NO', then the current record
+!! is not advanced by the write. If `status` is absent an error results
+!! in an error stop with an informative stop code. If `status` is
+!! present it has the default value of `success`, the value
+!! `alloc_fault` if allocation of the output string failed, or
+!! `write_failure` if the `write` statement outputting the literal failed.
+ class(bitset_large), intent(in) :: self
+ integer, intent(in) :: unit
+ character(len=*), intent(in), optional :: advance
+ integer, intent(out), optional :: status
+ end subroutine write_bitset_unit_large
+
+ end interface
+
+
+ interface assignment(=)
+!!
+!!#### Example
+!!
+!!```fortran
+!! program demo_assignment
+!! use stdlib_bitsets
+!! logical(int8) :: logical1(64) = .true.
+!! logical(int32), allocatable :: logical2(:)
+!! type(bitset_64) :: set0, set1
+!! set0 = logical1
+!! if ( set0 % bits() /= 64 ) then
+!! error stop procedure // &
+!! ' initialization with logical(int8) failed to set' // &
+!! ' the right size.'
+!! else if ( .not. set0 % all() ) then
+!! error stop procedure // ' initialization with' // &
+!! ' logical(int8) failed to set the right values.'
+!! else
+!! write(*,*) 'Initialization with logical(int8) succeeded.'
+!! end if
+!! set1 = set0
+!! if ( set1 == set0 ) &
+!! write(*,*) 'Initialization by assignment succeeded'
+!! logical2 = set1
+!! if ( all( logical2 ) ) then
+!! write(*,*) 'Initialization of logical(int32) succeeded.'
+!! end if
+!! end program demo_assignment
+!!```
+
+ pure module subroutine assign_large( set1, set2 )
+!! Version: experimental
+!!
+!! Used to define assignment for `bitset_large`.
+ type(bitset_large), intent(out) :: set1
+ type(bitset_large), intent(in) :: set2
+ end subroutine assign_large
+
+ #:for k1 in INT_KINDS
+ pure module subroutine assign_log${k1}$_large( self, logical_vector )
+!! Version: experimental
+!!
+!! Used to define assignment from an array of type `logical(${k1}$)` to a
+!! `bitset_large`.
+ type(bitset_large), intent(out) :: self
+ logical(${k1}$), intent(in) :: logical_vector(:)
+ end subroutine assign_log${k1}$_large
+
+ pure module subroutine log${k1}$_assign_large( logical_vector, set )
+!! Version: experimental
+!!
+!! Used to define assignment to an array of type `logical(${k1}$)` from a
+!! `bitset_large`.
+ logical(${k1}$), intent(out), allocatable :: logical_vector(:)
+ type(bitset_large), intent(in) :: set
+ end subroutine log${k1}$_assign_large
+ #:endfor
+
+ end interface assignment(=)
+
+
+ type, extends(bitset_type) :: bitset_64
+!! Version: experimental
+!!
+!! Type for bitsets with no more than 64 bits.
+ private
+ integer(block_kind), private :: block = 0
+
+ contains
+
+ procedure, pass(self) :: all => all_64
+ procedure, pass(self) :: any => any_64
+ procedure, pass(self) :: bit_count => bit_count_64
+ procedure, pass(self) :: clear_bit => clear_bit_64
+ procedure, pass(self) :: clear_range => clear_range_64
+ procedure, pass(self) :: flip_bit => flip_bit_64
+ procedure, pass(self) :: flip_range => flip_range_64
+ procedure, pass(self) :: from_string => from_string_64
+ procedure, pass(self) :: init_zero => init_zero_64
+ procedure, pass(self) :: input => input_64
+ procedure, pass(self) :: none => none_64
+ procedure, pass(self) :: not => not_64
+ procedure, pass(self) :: output => output_64
+ procedure, pass(self) :: read_bitset_string => read_bitset_string_64
+ procedure, pass(self) :: read_bitset_unit => read_bitset_unit_64
+ procedure, pass(self) :: set_bit => set_bit_64
+ procedure, pass(self) :: set_range => set_range_64
+ procedure, pass(self) :: test => test_64
+ procedure, pass(self) :: to_string => to_string_64
+ procedure, pass(self) :: value => value_64
+ procedure, pass(self) :: write_bitset_string => write_bitset_string_64
+ procedure, pass(self) :: write_bitset_unit => write_bitset_unit_64
+
+ end type bitset_64
+
+
+ interface
+
+ elemental module function all_64( self ) result(all)
+!! Version: experimental
+!!
+!! Returns `.true.` if all bits in `self` are 1, `.false.` otherwise.
+ logical :: all
+ class(bitset_64), intent(in) :: self
+ end function all_64
+
+ elemental module function any_64(self) result(any)
+!! Version: experimental
+!!
+!! Returns `.true.` if any bit in `self` is 1, `.false.` otherwise.
+ logical :: any
+ class(bitset_64), intent(in) :: self
+ end function any_64
+
+ elemental module function bit_count_64(self) result(bit_count)
+!! Version: experimental
+!!
+!! Returns the number of non-zero bits in `self`.
+ integer(bits_kind) :: bit_count
+ class(bitset_64), intent(in) :: self
+ end function bit_count_64
+
+ elemental module subroutine clear_bit_64(self, pos)
+!! Version: experimental
+!!
+!! Sets to zero the bit at `pos` position in `self`. If `pos` is less than
+!! zero or greater than `bits(self)-1` it is ignored.
+ class(bitset_64), intent(inout) :: self
+ integer(bits_kind), intent(in) :: pos
+ end subroutine clear_bit_64
+
+ pure module subroutine clear_range_64(self, start_pos, stop_pos)
+!! Version: experimental
+!!
+!! Sets to zero all bits from the `start_pos` to `stop_pos` positions in `self`.
+!! If `stop_pos < start_pos` then no bits are modified. Positions outside
+!! the range 0 to `bits(set)-1` are ignored.
+ class(bitset_64), intent(inout) :: self
+ integer(bits_kind), intent(in) :: start_pos, stop_pos
+ end subroutine clear_range_64
+
+ elemental module subroutine flip_bit_64(self, pos)
+!! Version: experimental
+!!
+!! Flips the bit value at the `pos` position in `self`, provided the position is
+!! valid. If `pos` is less than 0 or greater than `bits(self)-1`, no value is
+!! changed.
+ class(bitset_64), intent(inout) :: self
+ integer(bits_kind), intent(in) :: pos
+ end subroutine flip_bit_64
+
+ pure module subroutine flip_range_64(self, start_pos, stop_pos)
+!! Version: experimental
+!!
+!! Flips all valid bits from the `start_pos` to the `stop_pos` positions in
+!! `self`. If `stop_pos < start_pos` no bits are flipped. Positions less than
+!! 0 or greater than `bits(self)-1` are ignored.
+ class(bitset_64), intent(inout) :: self
+ integer(bits_kind), intent(in) :: start_pos, stop_pos
+ end subroutine flip_range_64
+
+ module subroutine from_string_64(self, string, status)
+!! Version: experimental
+!!
+!! Initializes the bitset `self` treating `string` as a binary literal
+!! `status` may have the values:
+!! * `success` - if no problems were found,
+!! * `alloc_fault` - if allocation of the bitset failed
+!! * `char_string_too_large_error` - if `string` was too large, or
+!! * `char_string_invalid_error` - if string had an invalid character.
+ class(bitset_64), intent(out) :: self
+ character(*), intent(in) :: string
+ integer, intent(out), optional :: status
+ end subroutine from_string_64
+
+ module subroutine init_zero_64(self, bits, status)
+!! Version: experimental
+!!
+!! Creates the bitset, `self`, of size `bits`, with all bits initialized to
+!! zero. `bits` must be non-negative. If an error occurs and `status` is
+!! absent then processing stops with an informative stop code. `status`
+!! will have one of the values:
+!! * `success` - if no problems were found,
+!! * `alloc_fault` - if memory allocation failed
+!! * `array_size_invalid_error` - if `bits` is either negative or larger
+!! than 64 with `self` of class `bitset_64`.
+ class(bitset_64), intent(out) :: self
+ integer(bits_kind), intent(in) :: bits
+ integer, intent(out), optional :: status
+ end subroutine init_zero_64
+
+ module subroutine input_64(self, unit, status)
+!! Version: experimental
+!!
+!! Reads the components of the bitset, `self`, from the unformatted I/O
+!! unit, `unit`, assuming that the components were written using `output`.
+!! If an error occurs and `status` is absent then processing stops with
+!! an informative stop code. `status` has one of the values:
+!! * `success` - if no problem was found
+!! * `alloc_fault` - if it failed allocating memory for `self`, or
+!! * `array_size_invalid_error` if the `bits(self)` in `unit` is negative
+!! or greater than 64 for a `bitset_64` input.
+!! * `read_failure` - if it failed during the reads from `unit`
+ class(bitset_64), intent(out) :: self
+ integer, intent(in) :: unit
+ integer, intent(out), optional :: status
+ end subroutine input_64
+
+ elemental module function none_64(self) result(none)
+!! Version: experimental
+!!
+!! Returns `.true.` if none of the bits in `self` have the value 1.
+ logical :: none
+ class(bitset_64), intent(in) :: self
+ end function none_64
+
+ elemental module subroutine not_64(self)
+!! Version: experimental
+!!
+!! Sets the bits in `self` to their logical complement.
+ class(bitset_64), intent(inout) :: self
+ end subroutine not_64
+
+ module subroutine output_64(self, unit, status)
+!! Version: experimental
+!!
+!! Writes the components of the bitset, `self`, to the unformatted I/O
+!! unit, `unit`, in a unformatted sequence compatible with `input`. If
+!! `status` is absent an error results in an error stop with an
+!! informative stop code. If `status` is present it has the default
+!! value of `success`, or the value `write_failure` if the write failed.
+ class(bitset_64), intent(in) :: self
+ integer, intent(in) :: unit
+ integer, intent(out), optional :: status
+ end subroutine output_64
+
+ module subroutine read_bitset_string_64(self, string, status)
+!! Version: experimental
+!!
+!! Uses the bitset literal in the default character `string`, to define
+!! the bitset, `self`. The literal may be preceded by an an arbitrary
+!! sequence of blank characters. If `status` is absent an error results
+!! in an error stop with an informative stop code. If `status`
+!! is present it has one of the values:
+!! * `success` - if no problems occurred,
+!! * `alloc_fault` - if allocation of memory for SELF failed,
+!! * `array_size_invalid_error - if `bits(self)` in `string` is greater
+!! than 64 for a `bitset_64`,
+!! * `char_string_invalid_error` - if the bitset literal has an invalid
+!! character,
+!! * `char_string_too_small_error - if the string ends before all the bits
+!! are read.
+!! * `integer_overflow_error` - if the bitset literal has a `bits(self)`
+!! value too large to be represented,
+ class(bitset_64), intent(out) :: self
+ character(len=*), intent(in) :: string
+ integer, intent(out), optional :: status
+ end subroutine read_bitset_string_64
+
+ module subroutine read_bitset_unit_64(self, unit, advance, status)
+!! Version: experimental
+!!
+!! Uses the bitset literal at the current position in the formatted
+!! file with I/O unit, `unit`, to define the bitset, `self`. The literal
+!! may be preceded by an an arbitrary sequence of blank characters.
+!! If `advance` is present it must be either 'YES' or 'NO'. If absent
+!! it has the default value of 'YES' to determine whether advancing
+!! I/O occurs. If `status` is absent an error results in an error stop
+!! with an informative stop code. If `status` is present it has one of
+!! the values:
+!! * `success` - if no problem occurred,
+!! * `alloc_fault` - if allocation of `self` failed,
+!! * `array_size_invalid_error` - if `bits(self)` in the bitset literal
+!! is greater than 64 for a `bitset_64`,
+!! * `char_string_invalid_error` - if the read of the bitset literal found
+!! an invalid character,
+!! * `eof_failure` - if a `read` statement reached an end-of-file before
+!! completing the read of the bitset literal,
+!! * `integer_overflow_error` - if the bitset literal has a `bits(self)`
+!! value too large to be represented,
+!! * `read_failure` - if a `read` statement fails,
+ class(bitset_64), intent(out) :: self
+ integer, intent(in) :: unit
+ character(*), intent(in), optional :: advance
+ integer, intent(out), optional :: status
+ end subroutine read_bitset_unit_64
+
+ elemental module subroutine set_bit_64(self, pos)
+!! Version: experimental
+!!
+!! Sets the value at the `pos` position in `self`, provided the position is
+!! valid. If the position is less than 0 or greater than `bits(self)-1`
+!! then `self` is unchanged.
+ class(bitset_64), intent(inout) :: self
+ integer(bits_kind), intent(in) :: pos
+ end subroutine set_bit_64
+
+ pure module subroutine set_range_64(self, start_pos, stop_pos)
+!! Version: experimental
+!!
+!! Sets all valid bits to 1 from the `start_pos` to the `stop_pos` positions
+!! in `self`. If `stop_pos < start_pos` no bits are changed. Positions outside
+!! the range 0 to `bits(self)-1` are ignored.
+ class(bitset_64), intent(inout) :: self
+ integer(bits_kind), intent(in) :: start_pos, stop_pos
+ end subroutine set_range_64
+
+ elemental module function test_64(self, pos) result(test)
+!! Version: experimental
+!!
+!! Returns `.true.` if the `pos` position is set, `.false.` otherwise. If `pos`
+!! is negative or greater than `bits(self)-1` the result is `.false.`.
+ logical :: test
+ class(bitset_64), intent(in) :: self
+ integer(bits_kind), intent(in) :: pos
+ end function test_64
+
+ module subroutine to_string_64(self, string, status)
+!! Version: experimental
+!!
+!! Represents the value of `self` as a binary literal in `string`.
+!! Status may have the values `success` or `alloc_fault`
+ class(bitset_64), intent(in) :: self
+ character(len=:), allocatable, intent(out) :: string
+ integer, intent(out), optional :: status
+ end subroutine to_string_64
+
+ elemental module function value_64(self, pos) result(value)
+!! Version: experimental
+!!
+!! Returns 1 if the `pos` position is set, 0 otherwise. If `pos` is negative
+!! or greater than `bits(set)-1` the result is 0.
+ integer :: value
+ class(bitset_64), intent(in) :: self
+ integer(bits_kind), intent(in) :: pos
+ end function value_64
+
+ module subroutine write_bitset_string_64(self, string, status)
+!! Version: experimental
+!!
+!! Writes a bitset literal to the allocatable default character `string`,
+!! representing the individual bit values in the `bitset_64`, `self`.
+!! If `status` is absent an error results in an error stop with an
+!! informative stop code. If `status` is present it has the default
+!! value of `success`, or the value `alloc_fault` if allocation of
+!! the output string failed.
+ class(bitset_64), intent(in) :: self
+ character(len=:), allocatable, intent(out) :: string
+ integer, intent(out), optional :: status
+ end subroutine write_bitset_string_64
+
+ module subroutine write_bitset_unit_64(self, unit, advance, status)
+!! Version: experimental
+!!
+!! Writes a bitset literal to the I/O unit, `unit`, representing the
+!! individual bit values in the bitset, `self`. By default or if
+!! `advance` is present with the value 'YES', advancing output is used.
+!! If `advance` is present with the value 'NO', then the current record
+!! is not advanced by the write. If `status` is absent an error results
+!! in an error stop with an informative stop code. If `status` is
+!! present it has the default value of `success`, the value
+!! `alloc_fault` if allocation of the output string failed, or
+!! `write_failure` if the `write` statement outputting the literal failed.
+ class(bitset_64), intent(in) :: self
+ integer, intent(in) :: unit
+ character(len=*), intent(in), optional :: advance
+ integer, intent(out), optional :: status
+ end subroutine write_bitset_unit_64
+
+ end interface
+
+
+ interface assignment(=)
+
+ pure module subroutine assign_64( set1, set2 )
+!! Version: experimental
+!!
+!! Used to define assignment for `bitset_64`.
+ type(bitset_64), intent(out) :: set1
+ type(bitset_64), intent(in) :: set2
+ end subroutine assign_64
+
+ #:for k1 in INT_KINDS
+ module subroutine assign_log${k1}$_64( self, logical_vector )
+!! Version: experimental
+!!
+!! Used to define assignment from an array of type `logical(${k1}$)` to a
+!! `bitset_64`.
+ type(bitset_64), intent(out) :: self
+ logical(${k1}$), intent(in) :: logical_vector(:)
+ end subroutine assign_log${k1}$_64
+
+ pure module subroutine log${k1}$_assign_64( logical_vector, set )
+!! Version: experimental
+!!
+!! Used to define assignment to an array of type `logical(${k1}$)` from a
+!! `bitset_64`.
+ logical(${k1}$), intent(out), allocatable :: logical_vector(:)
+ type(bitset_64), intent(in) :: set
+ end subroutine log${k1}$_assign_64
+ #:endfor
+
+ end interface assignment(=)
+
+
+ interface and
+
+ elemental module subroutine and_large(set1, set2)
+!! Version: experimental
+!!
+!! Sets the bits in `set1` to the bitwise `and` of the original bits in `set1`
+!! and `set2`. The sets must have the same number of bits
+!! otherwise the result is undefined.
+!!
+!!#### Example
+!!
+!!```fortran
+!! program demo_and
+!! use stdlib_bitsets
+!! type(bitset_large) :: set0, set1
+!! call set0 % init(166)
+!! call set1 % init(166)
+!! call and( set0, set1 ) ! none none
+!! if ( none(set0) ) write(*,*) 'First test of AND worked.'
+!! call set0 % not()
+!! call and( set0, set1 ) ! all none
+!! if ( none(set0) ) write(*,*) 'Second test of AND worked.'
+!! call set1 % not()
+!! call and( set0, set1 ) ! none all
+!! if ( none(set0) ) write(*,*) 'Third test of AND worked.'
+!! call set0 % not()
+!! call and( set0, set1 ) ! all all
+!! if ( all(set0) ) write(*,*) 'Fourth test of AND worked.'
+!! end program demo_and
+!!```
+ type(bitset_large), intent(inout) :: set1
+ type(bitset_large), intent(in) :: set2
+ end subroutine and_large
+
+ elemental module subroutine and_64(set1, set2)
+!! Version: experimental
+!!
+!! Sets the bits in `set1` to the bitwise `and` of the original bits in `set1`
+!! and `set2`. The sets must have the same number of bits
+!! otherwise the result is undefined.
+ type(bitset_64), intent(inout) :: set1
+ type(bitset_64), intent(in) :: set2
+ end subroutine and_64
+
+ end interface and
+
+
+ interface and_not
+
+ elemental module subroutine and_not_large(set1, set2)
+!! Version: experimental
+!!
+!! Sets the bits in `set1` to the bitwise and of the original bits in `set1`
+!! with the bitwise negation of `set2`. The sets must have the same
+!! number of bits otherwise the result is undefined.
+!!
+!!#### Example
+!!
+!!```fortran
+!! program demo_and_not
+!! use stdlib_bitsets
+!! type(bitset_large) :: set0, set1
+!! call set0 % init(166)
+!! call set1 % init(166)
+!! call and_not( set0, set1 ) ! none none
+!! if ( none(set0) ) write(*,*) 'First test of AND_NOT worked.'
+!! call set0 % not()
+!! call and_not( set0, set1 ) ! all none
+!! if ( all(set0) ) write(*,*) 'Second test of AND_NOT worked.'
+!! call set0 % not()
+!! call set1 % not()
+!! call and_not( set0, set1 ) ! none all
+!! if ( none(set0) ) write(*,*) 'Third test of AND_NOT worked.'
+!! call set0 % not()
+!! call and_not( set0, set1 ) ! all all
+!! if ( none(set0) ) write(*,*) 'Fourth test of AND_NOT worked.'
+!! end program demo_and_not
+!!```
+ type(bitset_large), intent(inout) :: set1
+ type(bitset_large), intent(in) :: set2
+ end subroutine and_not_large
+
+ elemental module subroutine and_not_64(set1, set2)
+!! Version: experimental
+!!
+!! Sets the bits in `set1` to the bitwise and of the original bits in `set1`
+!! with the bitwise negation of `set2`. The sets must have the same
+!! number of bits otherwise the result is undefined.
+ type(bitset_64), intent(inout) :: set1
+ type(bitset_64), intent(in) :: set2
+ end subroutine and_not_64
+
+ end interface and_not
+
+ interface extract
+
+ module subroutine extract_large(new, old, start_pos, stop_pos, status)
+!! Version: experimental
+!!
+!! Creates a new bitset, `new`, from a range, `start_pos` to `stop_pos`, in
+!! bitset `old`. If `start_pos` is greater than `stop_pos` the new bitset is
+!! empty. If `start_pos` is less than zero or `stop_pos` is greater than
+!! `bits(old)-1` then if `status` is present it has the value
+!! `index_invalid_error` and `new` is undefined, otherwise processing stops
+!! with an informative message.
+!!
+!!#### Example
+!!
+!!```fortran
+!! program demo_extract
+!! use stdlib_bitsets
+!! type(bitset_large) :: set0, set1
+!! call set0 % init(166)
+!! call set0 % set(100,150)
+!! call extract( set1, set0, 100, 150)
+!! if ( set1 % bits() == 51 ) &
+!! write(*,*) 'SET1 has the proper size.'
+!! if ( set1 % all() ) write(*,*) 'SET1 has the proper values.'
+!! end program demo_extract
+!!```
+ type(bitset_large), intent(out) :: new
+ type(bitset_large), intent(in) :: old
+ integer(bits_kind), intent(in) :: start_pos, stop_pos
+ integer, intent(out), optional :: status
+ end subroutine extract_large
+
+ module subroutine extract_64(new, old, start_pos, stop_pos, status)
+!! Version: experimental
+!!
+!! Creates a new bitset, `new`, from a range, `start_pos` to `stop_pos`, in
+!! bitset `old`. If `start_pos` is greater than `stop_pos` the new bitset is
+!! empty. If `start_pos` is less than zero or `stop_pos` is greater than
+!! `bits(old)-1` then if `status` is present it has the value
+!! `index_invalid_error`and `new` is undefined, otherwise processing stops
+!! with an informative message.
+ type(bitset_64), intent(out) :: new
+ type(bitset_64), intent(in) :: old
+ integer(bits_kind), intent(in) :: start_pos, stop_pos
+ integer, intent(out), optional :: status
+ end subroutine extract_64
+
+ end interface extract
+
+
+ interface or
+
+ elemental module subroutine or_large(set1, set2)
+!! Version: experimental
+!!
+!! Sets the bits in `set1` to the bitwise `or` of the original bits in `set1`
+!! and `set2`. The sets must have the same number of bits otherwise
+!! the result is undefined.
+!!
+!!#### Example
+!!
+!!```fortran
+!! program demo_or
+!! use stdlib_bitsets
+!! type(bitset_large) :: set0, set1
+!! call set0 % init(166)
+!! call set1 % init(166)
+!! call or( set0, set1 ) ! none none
+!! if ( none(set0) ) write(*,*) 'First test of OR worked.'
+!! call set0 % not()
+!! call or( set0, set1 ) ! all none
+!! if ( all(set0) ) write(*,*) 'Second test of OR worked.'
+!! call set0 % not()
+!! call set1 % not()
+!! call or( set0, set1 ) ! none all
+!! if ( all(set0) ) write(*,*) 'Third test of OR worked.'
+!! call set0 % not()
+!! call or( set0, set1 ) ! all all
+!! if ( all(set0) ) write(*,*) 'Fourth test of OR worked.'
+!! end program demo_or
+!!```
+ type(bitset_large), intent(inout) :: set1
+ type(bitset_large), intent(in) :: set2
+ end subroutine or_large
+
+ elemental module subroutine or_64(set1, set2)
+!! Version: experimental
+!!
+!! Sets the bits in `set1` to the bitwise `or` of the original bits in `set1`
+!! and `set2`. The sets must have the same number of bits otherwise
+!! the result is undefined.
+ type(bitset_64), intent(inout) :: set1
+ type(bitset_64), intent(in) :: set2
+ end subroutine or_64
+
+ end interface or
+
+
+ interface xor
+
+ elemental module subroutine xor_large(set1, set2)
+!! Version: experimental
+!!
+!! Sets the bits in `set1` to the bitwise `xor` of the original bits in `set1`
+!! and `set2`. The sets must have the same number of bits otherwise
+!! the result is undefined.
+!!
+!!#### Example
+!!
+!!```fortran
+!! program demo_xor
+!! use stdlib_bitsets
+!! type(bitset_large) :: set0, set1
+!! call set0 % init(166)
+!! call set1 % init(166)
+!! call xor( set0, set1 ) ! none none
+!! if ( none(set0) ) write(*,*) 'First test of XOR worked.'
+!! call set0 % not()
+!! call xor( set0, set1 ) ! all none
+!! if ( all(set0) ) write(*,*) 'Second test of XOR worked.'
+!! call set0 % not()
+!! call set1 % not()
+!! call xor( set0, set1 ) ! none all
+!! if ( all(set0) ) write(*,*) 'Third test of XOR worked.'
+!! call set0 % not()
+!! call xor( set0, set1 ) ! all all
+!! if ( none(set0) ) write(*,*) 'Fourth test of XOR worked.'
+!! end program demo_xor
+!!```
+ type(bitset_large), intent(inout) :: set1
+ type(bitset_large), intent(in) :: set2
+ end subroutine xor_large
+
+ elemental module subroutine xor_64(set1, set2)
+!! Version: experimental
+!!
+!! Sets the bits in `set1` to the bitwise `xor` of the original bits in `set1`
+!! and `set2`. The sets must have the same number of bits
+!! otherwise the result is undefined.
+ type(bitset_64), intent(inout) :: set1
+ type(bitset_64), intent(in) :: set2
+ end subroutine xor_64
+
+ end interface xor
+
+
+ interface operator(==)
+
+ elemental module function eqv_large(set1, set2) result(eqv)
+!! Version: experimental
+!!
+!! Returns `.true.` if 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.
+!!
+!!#### Example
+!!
+!!```fortran
+!! program demo_equality
+!! 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 == set0 .and. set1 == set1 .and. set2 == set2 .and. &
+!! .not. set0 == set1 .and. .not. set0 == set2 .and. .not. &
+!! set1 == set2 ) then
+!! write(*,*) 'Passed 64 bit equality tests.'
+!! else
+!! error stop 'Failed 64 bit equality tests.'
+!! end if
+!! end program demo_equality
+!!```
+ logical :: eqv
+ type(bitset_large), intent(in) :: set1, set2
+ end function eqv_large
+
+ elemental module function eqv_64(set1, set2) result(eqv)
+!! Version: experimental
+!!
+!! Returns `.true.` if 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.
+ logical :: eqv
+ type(bitset_64), intent(in) :: set1, set2
+ end function eqv_64
+
+ end interface operator(==)
+
+
+ interface operator(/=)
+
+ elemental module function neqv_large(set1, set2) result(neqv)
+!! Version: experimental
+!!
+!! 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.
+!!
+!!#### Example
+!!
+!!```fortran
+!! program demo_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 demo_inequality
+!!```
+ logical :: neqv
+ type(bitset_large), intent(in) :: set1, set2
+ end function neqv_large
+
+ elemental module function neqv_64(set1, set2) result(neqv)
+!! Version: experimental
+!!
+!! 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.
+ logical :: neqv
+ type(bitset_64), intent(in) :: set1, set2
+ end function neqv_64
+
+ end interface operator(/=)
+
+
+ interface operator(>)
+
+ elemental module function gt_large(set1, set2) result(gt)
+!! Version: experimental
+!!
+!! Returns `.true.` if the bits in `set1` and `set2` differ and the
+!! highest order different bit is set to 1 in `set1` and to 0 in `set2`,
+!! `.false.` otherwise. The sets must have the same number of bits
+!! otherwise the result is undefined.
+!!
+!!#### Example
+!!
+!!```fortran
+!! program demo_gt
+!! 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 ( set1 > set0 .and. set2 > set1 .and. set2 > set0 .and. &
+!! .not. set0 > set0 .and. .not. set0 > set1 .and. .not. &
+!! set1 > set2 ) then
+!! write(*,*) 'Passed 64 bit greater than tests.'
+!! else
+!! error stop 'Failed 64 bit greater than tests.'
+!! end if
+!! end program demo_gt
+!!```
+ logical :: gt
+ type(bitset_large), intent(in) :: set1, set2
+ end function gt_large
+
+ elemental module function gt_64(set1, set2) result(gt)
+!! Version: experimental
+!!
+!! Returns `.true.` if the bits in `set1` and `set2` differ and the
+!! highest order different bit is set to 1 in `set1` and to 0 in `set2`,
+!! `.false.` otherwise. The sets must have the same number of bits
+!! otherwise the result is undefined.
+ logical :: gt
+ type(bitset_64), intent(in) :: set1, set2
+ end function gt_64
+
+ end interface operator(>)
+
+
+ interface operator(>=)
+
+ elemental module function ge_large(set1, set2) result(ge)
+!! Version: experimental
+!!
+!! Returns `.true.` if the bits in `set1` and `set2` are the same or the
+!! highest order different bit is set to 1 in `set1` and to 0 in `set2`,
+!! `.false.` otherwise. The sets must have the same number of bits
+!! otherwise the result is undefined.
+!!
+!!#### Example
+!!
+!!```fortran
+!! program demo_ge
+!! 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 ( set1 >= set0 .and. set2 >= set1 .and. set2 >= set0 .and. &
+!! set0 >= set0 .and. set1 >= set1 .and. set2 >= set2 .and. &
+!! .not. set0 >= set1 .and. .not. set0 >= set2 .and. .not. &
+!! set1 >= set2 ) then
+!! write(*,*) 'Passed 64 bit greater than or equals tests.'
+!! else
+!! error stop 'Failed 64 bit greater than or equals tests.'
+!! end if
+!! end program demo_ge
+!!```
+ logical :: ge
+ type(bitset_large), intent(in) :: set1, set2
+ end function ge_large
+
+ elemental module function ge_64(set1, set2) result(ge)
+!! Version: experimental
+!!
+!! Returns `.true.` if the bits in `set1` and `set2` are the same or the
+!! highest order different bit is set to 1 in `set1` and to 0 in `set2`,
+!! `.false.` otherwise. The sets must have the same number of bits
+!! otherwise the result is undefined.
+ logical :: ge
+ type(bitset_64), intent(in) :: set1, set2
+ end function ge_64
+
+ end interface operator(>=)
+
+
+ interface operator(<)
+
+ elemental module function lt_large(set1, set2) result(lt)
+!! Version: experimental
+!!
+!! Returns `.true.` if the bits in `set1` and `set2` differ and the
+!! highest order different bit is set to 0 in `set1` and to 1 in `set2`,
+!! `.false.` otherwise. The sets must have the same number of bits
+!! otherwise the result is undefined.
+!!
+!!#### Example
+!!
+!!```fortran
+!! program demo_lt
+!! 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. set1 < set2 .and. set0 < set2 .and. &
+!! .not. set0 < set0 .and. .not. set2 < set0 .and. .not. &
+!! set2 < set1 ) then
+!! write(*,*) 'Passed 64 bit less than tests.'
+!! else
+!! error stop 'Failed 64 bit less than tests.'
+!! end if
+!! end program demo_lt
+!!```
+ logical :: lt
+ type(bitset_large), intent(in) :: set1, set2
+ end function lt_large
+
+ elemental module function lt_64(set1, set2) result(lt)
+!! Version: experimental
+!!
+!! Returns `.true.` if the bits in `set1` and `set2` differ and the
+!! highest order different bit is set to 0 in `set1` and to 1 in `set2`,
+!! `.false.` otherwise. The sets must have the same number of bits
+!! otherwise the result is undefined.
+ logical :: lt
+ type(bitset_64), intent(in) :: set1, set2
+ end function lt_64
+
+ end interface operator(<)
+
+
+ interface operator(<=)
+
+ elemental module function le_large(set1, set2) result(le)
+!! Version: experimental
+!!
+!! Returns `.true.` if the bits in `set1` and `set2` are the same or the
+!! highest order different bit is set to 0 in `set1` and to 1 in `set2`,
+!! `.false.` otherwise. The sets must have the same number of bits
+!! otherwise the result is undefined.
+!!
+!!#### Example
+!!
+!!```fortran
+!! program demo_le
+!! 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. set1 <= set2 .and. set0 <= set2 .and. &
+!! set0 <= set0 .and. set1 <= set1 .and. set2 <= set2 .and. &
+!! .not. set1 <= set0 .and. .not. set2 <= set0 .and. .not. &
+!! set2 <= set1 ) then
+!! write(*,*) 'Passed 64 bit less than or equal tests.'
+!! else
+!! error stop 'Failed 64 bit less than or equal tests.'
+!! end if
+!! end program demo_le
+!!```
+ logical :: le
+ type(bitset_large), intent(in) :: set1, set2
+ end function le_large
+
+ elemental module function le_64(set1, set2) result(le)
+!! Version: experimental
+!!
+!! Returns `.true.` if the bits in `set1` and `set2` are the same or the
+!! highest order different bit is set to 0 in `set1` and to 1 in `set2`,
+!! `.false.` otherwise. The sets must have the same number of bits
+!! otherwise the result is undefined.
+ logical :: le
+ type(bitset_64), intent(in) :: set1, set2
+ end function le_64
+
+ end interface operator(<=)
+
+ interface error_handler
+ module subroutine error_handler( message, error, status, &
+ module, procedure )
+ character(*), intent(in) :: message
+ integer, intent(in) :: error
+ integer, intent(out), optional :: status
+ character(*), intent(in), optional :: module
+ character(*), intent(in), optional :: procedure
+ end subroutine error_handler
+ end interface error_handler
+
+contains
+
+ elemental function bits(self)
+!! Version: experimental
+!!
+!! Returns the number of bit positions in `self`.
+ integer(bits_kind) :: bits
+ class(bitset_type), intent(in) :: self
+
+ bits = self % num_bits
+
+ return
+ end function bits
+
+ module subroutine error_handler( message, error, status, module, procedure )
+ character(*), intent(in) :: message
+ integer, intent(in) :: error
+ integer, intent(out), optional :: status
+ character(*), intent(in), optional :: module
+ character(*), intent(in), optional :: procedure
+
+ if ( present(status) ) then
+ status = error
+ else
+ if ( present(module) ) then
+ if ( present(procedure) ) then
+ write(error_unit, '(a)') trim(module) // ' % ' // &
+ trim(procedure) // ': ' // trim(message)
+ else
+ write(error_unit, '(a)') trim(module) // ' % N/A: ' // &
+ trim(message)
+ end if
+ else if ( present(procedure) ) then
+ write(error_unit, '(a)') trim(procedure) // ': ' // &
+ trim(message)
+ else
+ write(error_unit, '(a)') trim(message)
+ end if
+ select case(error)
+ case( alloc_fault )
+ error stop 'A memory allocation failed.'
+ case( array_size_invalid_error )
+ error stop "An array size was invalid."
+ case( char_string_invalid_error )
+ error stop "A character string had an invalid character."
+ case( char_string_too_large_error )
+ error stop "A character string was too large."
+ case( char_string_too_small_error )
+ error stop "A character string was too small."
+ case( eof_failure )
+ error stop "An End-Of-File failure occurred on a READ " // &
+ "statement."
+ case( index_invalid_error )
+ error stop "An index was invalid."
+ case( integer_overflow_error )
+ error stop "An integer overflow error occurred."
+ case( read_failure )
+ error stop "A failure occurred in a READ statement."
+ case( write_failure )
+ error stop "A failure occurred on a WRITE statement."
+ end select
+ end if
+ end subroutine error_handler
+
+
+end module stdlib_bitsets
diff --git a/src/stdlib_bitsets_64.fypp b/src/stdlib_bitsets_64.fypp
new file mode 100644
index 000000000..3cdd0b17a
--- /dev/null
+++ b/src/stdlib_bitsets_64.fypp
@@ -0,0 +1,1122 @@
+#:include "common.fypp"
+submodule(stdlib_bitsets) stdlib_bitsets_64
+ implicit none
+
+contains
+
+ elemental module function all_64( self ) result(all)
+! Returns .TRUE. if all bits in SELF are 1, .FALSE. otherwise.
+ logical :: all
+ class(bitset_64), intent(in) :: self
+
+ intrinsic :: btest
+ integer(bits_kind) :: pos
+
+ do pos=0, self % num_bits - 1
+ if ( .not. btest(self % block, pos) ) then
+ all = .false.
+ return
+ end if
+ end do
+ all = .true.
+
+ end function all_64
+
+
+ elemental module subroutine and_64(set1, set2)
+!
+! Sets the bits in SET1 to the bitwise AND of the original bits in SET1
+! and SET2. It is required that SET1 have the same number of bits as
+! SET2 otherwise the result is undefined.
+!
+ type(bitset_64), intent(inout) :: set1
+ type(bitset_64), intent(in) :: set2
+
+! The set2 extent includes the entire extent of set1.
+! The (zeroed) region past the end of set1 is unaffected by
+! the iand.
+ set1 % block = iand( set1 % block, &
+ set2 % block )
+
+ end subroutine and_64
+
+
+ elemental module subroutine and_not_64(set1, set2)
+!
+! Sets the bits in SET1 to the bitwise and of the original bits in SET1
+! with the bitwise negation of SET2. SET1 and SET2 must have the same
+! number of bits otherwise the result is undefined.
+!
+ type(bitset_64), intent(inout) :: set1
+ type(bitset_64), intent(in) :: set2
+
+! The not with iand means that the zero'ed regions past the end of each set
+! do not interact with the in set regions
+ set1 % block = iand( set1 % block, not( set2 % block ) )
+
+ end subroutine and_not_64
+
+
+ elemental module function any_64(self) result(any)
+! Returns .TRUE. if any bit in SELF is 1, .FALSE. otherwise.
+ logical :: any
+ class(bitset_64), intent(in) :: self
+
+ if ( self % block /= 0 ) then
+ any = .true.
+ return
+ else
+ any = .false.
+ end if
+
+ end function any_64
+
+
+ pure module subroutine assign_64( set1, set2 )
+! Used to define assignment for bitset_64
+ type(bitset_64), intent(out) :: set1
+ type(bitset_64), intent(in) :: set2
+
+ set1 % num_bits = set2 % num_bits
+ set1 % block = set2 % block
+
+ end subroutine assign_64
+
+
+ #:for k1 in INT_KINDS
+ module subroutine assign_log${k1}$_64( self, logical_vector )
+! Used to define assignment from an array of type logical for bitset_64
+ type(bitset_64), intent(out) :: self
+ logical(${k1}$), intent(in) :: logical_vector(:)
+
+ integer(bits_kind) :: log_size
+ integer(bits_kind) :: index
+
+ log_size = size( logical_vector, kind=bits_kind )
+ if ( log_size > 64 ) then
+ error stop module_name // ' % ' // 'ASSIGNMENT' // " has " // &
+ "SIZE(LOGICAL_VECTOR) > 64 with assignment to a BITSET_64."
+ end if
+ self % num_bits = log_size
+ self % block = 0
+
+ do index=0, log_size-1
+ if ( logical_vector(index+1) ) then
+ self % block = ibset( self % block, index )
+ end if
+ end do
+
+ end subroutine assign_log${k1}$_64
+
+
+ pure module subroutine log${k1}$_assign_64( logical_vector, set )
+! Used to define assignment to an array of type logical for bitset_64
+ logical(${k1}$), intent(out), allocatable :: logical_vector(:)
+ type(bitset_64), intent(in) :: set
+
+ integer(bits_kind) :: index
+
+ allocate( logical_vector( set % num_bits ) )
+ do index=0, set % num_bits-1
+ if ( set % value( index ) == 1 ) then
+ logical_vector(index+1) = .true.
+ else
+ logical_vector(index+1) = .false.
+ end if
+ end do
+
+ end subroutine log${k1}$_assign_64
+ #:endfor
+
+
+ elemental module function bit_count_64(self) result(bit_count)
+! Returns the number of non-zero bits in SELF.
+ integer(bits_kind) :: bit_count
+ class(bitset_64), intent(in) :: self
+
+ integer(bits_kind) :: pos
+
+ bit_count = 0
+
+ do pos = 0, self % num_bits - 1
+ if ( btest( self % block, pos ) ) bit_count = bit_count + 1
+ end do
+
+ end function bit_count_64
+
+
+ elemental module subroutine clear_bit_64(self, pos)
+!
+! Sets to zero the POS position in SELF. If POS is less than zero or
+! greater than BITS(SELF)-1 it is ignored.
+!
+ class(bitset_64), intent(inout) :: self
+ integer(bits_kind), intent(in) :: pos
+
+ if ( pos < 0 .OR. (pos > self % num_bits-1) ) &
+ return
+ self % block = ibclr( self % block, pos )
+
+ end subroutine clear_bit_64
+
+
+ pure module subroutine clear_range_64(self, start_pos, stop_pos)
+!
+! Sets to zero all bits from the START_POS to STOP_POS positions in SELF.
+! If STOP_POS < START_POS then no bits are modified. Positions outside
+! the range 0 to BITS(SELF)-1 are ignored.
+!
+ class(bitset_64), intent(inout) :: self
+ integer(bits_kind), intent(in) :: start_pos, stop_pos
+
+ integer(bits_kind) :: true_first, true_last
+
+ true_first = max( 0_bits_kind, start_pos )
+ true_last = min( self % num_bits-1, stop_pos )
+ if ( true_last < true_first ) return
+
+ call mvbits( all_zeros, &
+ true_first, &
+ true_last - true_first + 1, &
+ self % block, &
+ true_first )
+
+ end subroutine clear_range_64
+
+
+ elemental module function eqv_64(set1, set2) result(eqv)
+!
+! Returns .TRUE. if all bits in SET1 and SET2 have the same value,
+! .FALSE. otherwise. The sets must have the same number of bits
+! otherwise the results are undefined.
+!
+ logical :: eqv
+ type(bitset_64), intent(in) :: set1, set2
+
+ eqv = set1 % block == set2 % block
+
+ end function eqv_64
+
+
+ module subroutine extract_64(new, old, start_pos, stop_pos, status)
+! Creates a new bitset, NEW, from a range, START_POS to STOP_POS, in bitset
+! OLD. If START_POS is greater than STOP_POS the new bitset is empty.
+! If START_POS is less than zero or STOP_POS is greater than BITS(OLD)-1
+! then if STATUS is present it has the value INDEX_INVALID_ERROR,
+! otherwise processing stops with an informative message.
+ type(bitset_64), intent(out) :: new
+ type(bitset_64), intent(in) :: old
+ integer(bits_kind), intent(in) :: start_pos, stop_pos
+ integer, intent(out), optional :: status
+
+ integer(bits_kind) :: bits, i, k
+ character(*), parameter :: procedure = 'EXTRACT'
+
+ if ( start_pos < 0 ) then
+ call error_handler( 'had a START_POS less than 0.', &
+ index_invalid_error, status, &
+ module_name, procedure )
+ return
+ end if
+ if ( stop_pos >= old % num_bits ) then
+ call error_handler( 'had a STOP_POS greater than BITS(OLD)-1.', &
+ index_invalid_error, status, &
+ module_name, procedure )
+ return
+ end if
+ bits = stop_pos - start_pos + 1
+
+ if ( bits <= 0 ) then
+ new % num_bits = 0
+ new % block = 0
+ return
+ else
+ new % num_bits = bits
+ do i=0, bits-1
+ k = start_pos + i
+ if ( btest( old % block, k ) ) &
+ new % block = ibset(new % block, i)
+ end do
+ end if
+
+ if ( present(status) ) status = success
+
+ end subroutine extract_64
+
+
+ elemental module subroutine flip_bit_64(self, pos)
+!
+! Flips the value at the POS position in SELF, provided the position is
+! valid. If POS is less than 0 or greater than BITS(SELF)-1, no value is
+! changed.
+!
+ class(bitset_64), intent(inout) :: self
+ integer(bits_kind), intent(in) :: pos
+
+ if ( pos < 0 .OR. pos > self % num_bits-1 ) return
+
+ if ( btest( self % block, pos ) ) then
+ self % block = ibclr( self % block, pos )
+ else
+ self % block = ibset( self % block, pos )
+ end if
+
+ end subroutine flip_bit_64
+
+
+ pure module subroutine flip_range_64(self, start_pos, stop_pos)
+!
+! Flips all valid bits from the START_POS to the STOP_POS positions in
+! SELF. If STOP_POS < START_POS no bits are flipped. Positions less than
+! 0 or greater than BITS(SELF)-1 are ignored.
+!
+ class(bitset_64), intent(inout) :: self
+ integer(bits_kind), intent(in) :: start_pos, stop_pos
+
+ integer(bits_kind) :: end_bit, start_bit
+
+ start_bit = max( 0_bits_kind, start_pos )
+ end_bit = min( stop_pos , self % num_bits-1 )
+ call mvbits( not(self % block), &
+ start_bit, &
+ end_bit - start_bit + 1, &
+ self % block, &
+ start_bit )
+
+ end subroutine flip_range_64
+
+
+ module subroutine from_string_64(self, string, status)
+! Initializes the bitset `self` treating `string` as a binary literal
+! `status` may have the values:
+! `success` - if no problems were found,
+! `alloc_fault` - if allocation of the bitset failed
+! `char_string_too_large_error` - if `string` was too large, or
+! `char_string_invalid_error` - if string had an invalid character.
+ class(bitset_64), intent(out) :: self
+ character(*), intent(in) :: string
+ integer, intent(out), optional :: status
+
+ character(*), parameter :: procedure = 'FROM_STRING'
+ integer(int64) :: bit
+ integer(int64) :: bits
+ character(1) :: char
+
+ bits = len(string, kind=int64)
+ if ( bits > 64 ) then
+ call error_handler( 'STRING was too long for a ' // &
+ 'BITSET_64 SELF.', &
+ char_string_too_large_error, status, &
+ module_name, procedure )
+ return
+ end if
+ self % num_bits = bits
+ do bit = 1, bits
+ char = string(bit:bit)
+ if ( char == '0' ) then
+ call self % clear( int(bits-bit, kind=bits_kind) )
+ else if ( char == '1' ) then
+ call self % set( int(bits-bit, kind=bits_kind) )
+ else
+ call error_handler( 'STRING had a character other than ' // &
+ '0 or 1.', &
+ char_string_invalid_error, status, &
+ module_name, procedure )
+ return
+ end if
+ end do
+
+ if ( present(status) ) status = success
+
+ end subroutine from_string_64
+
+
+ elemental module function ge_64(set1, set2) result(ge)
+!
+! Returns .TRUE. if the bits in SET1 and SET2 are the same or the
+! highest order different bit is set to 1 in SET1 and to 0 in set2.
+! .FALSE. otherwise. The sets must have the same number of bits
+! otherwise the results are undefined.
+!
+ logical :: ge
+ type(bitset_64), intent(in) :: set1, set2
+
+ ge = bge( set1 % block, set2 % block )
+
+ end function ge_64
+
+
+ elemental module function gt_64(set1, set2) result(gt)
+!
+! Returns .TRUE. if the bits in SET1 and SET2 differ and the
+! highest order different bit is set to 1 in SET1 and to 0 in set2.
+! .FALSE. otherwise. The sets must have the same number of bits
+! otherwise the results are undefined.
+!
+ logical :: gt
+ type(bitset_64), intent(in) :: set1, set2
+
+ gt = bgt( set1 % block, set2 % block )
+
+ end function gt_64
+
+
+ module subroutine init_zero_64(self, bits, status)
+!
+! Creates the bitset, `self`, of size `bits`, with all bits initialized to
+! zero. `bits` must be non-negative. If an error occurs and `status` is
+! absent then processing stops with an informative stop code. `status`
+! will have one of the values:
+! * `success` - if no problems were found,
+! * `array_size_invalid_error` - if `bits` is either negative or larger
+! than 64 with `self` of class `bitset_64`, or
+! * `alloc_fault` - if memory allocation failed
+!
+ class(bitset_64), intent(out) :: self
+ integer(bits_kind), intent(in) :: bits
+ integer, intent(out), optional :: status
+
+ character(*), parameter :: procedure = "INIT"
+
+ if ( bits < 0 ) then
+ call error_handler( 'BITS had a negative value.', &
+ array_size_invalid_error, status, &
+ module_name, procedure )
+ return
+ end if
+ if ( bits > 64 ) then
+ call error_handler( 'BITS had a value greater than 64.', &
+ array_size_invalid_error, status, &
+ module_name, procedure )
+ return
+ end if
+
+ self % num_bits = bits
+ self % block = all_zeros
+
+ if ( present(status) ) status = success
+
+ end subroutine init_zero_64
+
+
+ module subroutine input_64(self, unit, status)
+!
+! Reads the components of the bitset, `self`, from the unformatted I/O
+! unit, `unit`, assuming that the components were written using `output`.
+! If an error occurs and `status` is absent then processing stops with
+! an informative stop code. `status` has one of the values:
+! * `success` - if no problem was found
+! * `alloc_fault` - if it failed during allocation of memory for `self`, or
+! * `array_size_invalid_error` if the `bits(self)` in `unit` is negative
+! or greater than 64 for a `bitset_64` input.
+! * `read_failure` - if it failed during the reads from `unit`
+!
+ class(bitset_64), intent(out) :: self
+ integer, intent(in) :: unit
+ integer, intent(out), optional :: status
+
+ integer(bits_kind) :: bits
+ integer :: ierr
+ character(len=120) :: message
+ character(*), parameter :: procedure = 'INPUT'
+ integer :: stat
+
+ read(unit, iostat=ierr, iomsg=message) bits
+ if (ierr /= 0) then
+ call error_handler( 'Failure on a READ statement for UNIT.', &
+ read_failure, status, module_name, procedure )
+ return
+ end if
+ if ( bits < 0 ) then
+ call error_handler( 'BITS in UNIT had a negative value.', &
+ array_size_invalid_error, status, &
+ module_name, procedure )
+ return
+ end if
+ if ( bits > 64 ) then
+ call error_handler( 'BITS in UNIT had a value greater than 64.', &
+ array_size_invalid_error, status, &
+ module_name, procedure )
+ return
+ end if
+
+ call self % init(bits, stat)
+ if (stat /= success) then
+ call error_handler( 'Allocation failure for SELF.', &
+ alloc_fault, status, module_name, procedure )
+ return
+ end if
+
+ if (bits < 1) return
+
+ read(unit, iostat=ierr, iomsg=message) self % block
+ if (ierr /= 0) then
+ call error_handler( 'Failure on a READ statement for UNIT.', &
+ read_failure, status, module_name, procedure )
+ return
+ end if
+
+ if ( present(status) ) status = success
+
+ end subroutine input_64
+
+
+ elemental module function le_64(set1, set2) result(le)
+!
+! Returns .TRUE. if the bits in SET1 and SET2 are the same or the
+! highest order different bit is set to 0 in SET1 and to 1 in set2.
+! .FALSE. otherwise. The sets must have the same number of bits
+! otherwise the results are undefined.
+!
+ logical :: le
+ type(bitset_64), intent(in) :: set1, set2
+
+ le = ble( set1 % block, set2 % block )
+
+ end function le_64
+
+
+ elemental module function lt_64(set1, set2) result(lt)
+!
+! Returns .TRUE. if the bits in SET1 and SET2 differ and the
+! highest order different bit is set to 0 in SET1 and to 1 in set2.
+! .FALSE. otherwise. The sets must have the same number of bits
+! otherwise the results are undefined.
+!
+ logical :: lt
+ type(bitset_64), intent(in) :: set1, set2
+
+ lt = blt( set1 % block, set2 % block )
+
+ end function lt_64
+
+
+ elemental module function neqv_64(set1, set2) result(neqv)
+!
+! Returns .TRUE. if all bits in SET1 and SET2 have the same value,
+! .FALSE. otherwise. The sets must have the same number of bits
+! otherwise the results are undefined.
+!
+ logical :: neqv
+ type(bitset_64), intent(in) :: set1, set2
+
+ neqv = set1 % block /= set2 % block
+
+ end function neqv_64
+
+
+ elemental module function none_64(self) result(none)
+!
+! Returns .TRUE. if none of the bits in SELF have the value 1.
+!
+ logical :: none
+ class(bitset_64), intent(in) :: self
+
+ none = .true.
+ if (self % block /= 0) then
+ none = .false.
+ return
+ end if
+
+ end function none_64
+
+
+ elemental module subroutine not_64(self)
+!
+! Sets the bits in SELF to their logical complement
+!
+ class(bitset_64), intent(inout) :: self
+
+ integer(bits_kind) :: bit
+
+ if ( self % num_bits == 0 ) return
+
+ do bit=0, self % num_bits - 1
+ if ( btest( self % block, bit ) ) then
+ self % block = ibclr( self % block, bit )
+ else
+ self % block = ibset( self % block, bit )
+ end if
+ end do
+
+ end subroutine not_64
+
+
+ elemental module subroutine or_64(set1, set2)
+!
+! Sets the bits in SET1 to the bitwise OR of the original bits in SET1
+! and SET2. If SET1 has fewer bits than SET2 then the additional bits
+! in SET2 are ignored. If SET1 has more bits than SET2, then the
+! absent SET2 bits are treated as if present with zero value.
+!
+ type(bitset_64), intent(inout) :: set1
+ type(bitset_64), intent(in) :: set2
+
+ if ( set1 % num_bits >= set2 % num_bits ) then
+ set1 % block = ior( set1 % block, &
+ set2 % block )
+ else
+! The set1 extent ends before set2 => set2 bits must not affect bits in
+! set1 beyond its extent => set those bits to zero while keeping proper
+! values of other bits in set2
+ set1 % block = &
+ ior( set1 % block, &
+ ibits( set2 % block, &
+ 0, &
+ set1 % num_bits ) )
+ end if
+
+ end subroutine or_64
+
+
+ module subroutine output_64(self, unit, status)
+!
+! Writes the components of the bitset, SELF, to the unformatted I/O
+! unit, UNIT, in a unformatted sequence compatible with INPUT. If
+! STATUS is absent an error results in an error stop with an
+! informative stop code. If STATUS is present it has the default
+! value of SUCCESS, or the value WRITE_FAILURE if the write failed.
+!
+ class(bitset_64), intent(in) :: self
+ integer, intent(in) :: unit
+ integer, intent(out), optional :: status
+
+ integer :: ierr
+ character(len=120) :: message
+ character(*), parameter :: procedure = "OUTPUT"
+
+ write(unit, iostat=ierr, iomsg=message) self % num_bits
+ if (ierr /= 0) go to 999
+
+ if (self % num_bits < 1) return
+ write(unit, iostat=ierr, iomsg=message) self % block
+ if (ierr /= 0) go to 999
+
+ return
+
+999 call error_handler( 'Failure on a WRITE statement for UNIT.', &
+ write_failure, status, module_name, procedure )
+
+ end subroutine output_64
+
+
+ module subroutine read_bitset_string_64(self, string, status)
+!
+! Uses the bitset literal in the default character `string`, to define
+! the bitset, `self`. The literal may be preceded by an an arbitrary
+! sequence of blank characters. If `status` is absent an error results
+! in an error stop with an informative stop code. If `status`
+! is present it has one of the values
+! * `success` - if no problems occurred,
+! * `alloc_fault` - if allocation of memory for SELF failed,
+! * `array_size_invalid_error - if `bits(self)` in `string` is greater
+! than 64 for a `bitset_64`,
+! * `char_string_invalid_error` - if the bitset literal has an invalid
+! character,
+! * `char_string_too_small_error - if the string ends before all the bits
+! are read.
+! * `integer_overflow_error` - if the bitset literal has a `bits(self)`
+! value too large to be represented,
+!
+ class(bitset_64), intent(out) :: self
+ character(len=*), intent(in) :: string
+ integer, intent(out), optional :: status
+
+ integer(bits_kind) :: bit, bits
+ integer(bits_kind) :: digits, pos
+ character(*), parameter :: procedure = "READ_BITSET"
+ integer :: stat
+
+ pos = 1
+ find_start: do pos=1, len(string)
+ if ( string(pos:pos) /= ' ' ) exit
+ end do find_start
+
+ if ( pos > len(string) - 8 ) go to 999
+
+ if ( string(pos:pos) /= 's' .AND. string(pos:pos) /= 'S' ) go to 999
+
+ pos = pos + 1
+ bits = 0
+ digits = 0
+
+ do
+ select case( iachar( string(pos:pos) ) )
+ case(ia0:ia9)
+ digits = digits + 1
+ if ( digits == max_digits .AND. bits > overflow_bits ) &
+ go to 996
+ if ( digits > max_digits ) go to 996
+ bits = bits*10 + iachar( string(pos:pos) ) - ia0
+ if ( bits < 0 ) go to 996
+ case(iachar('b'), iachar('B'))
+ exit
+ case default
+ go to 999
+ end select
+
+ pos = pos + 1
+
+ end do
+
+ if ( bits > 64 ) then
+ call error_handler( 'BITS in STRING was greater than 64.', &
+ char_string_too_large_error, status, &
+ module_name, procedure )
+ return
+ end if
+ if ( bits + pos > len(string) ) then
+ call error_handler( 'STRING was too small for the number of ' // &
+ 'bits specified by STRING.', &
+ char_string_too_small_error, status, &
+ module_name, procedure )
+ return
+ end if
+ call self % init( bits, stat )
+ if (stat /= success) then
+ call error_handler( 'There was an allocation fault for SELF.', &
+ alloc_fault, status, module_name, procedure )
+ return
+ end if
+
+ pos = pos + 1
+ bit = bits - 1
+ do
+ if ( string(pos:pos) == '0' ) then
+ call self % clear( bit ) ! this may not be needed
+ else if ( string(pos:pos) == '1' ) then
+ call self % set( bit )
+ else
+ go to 999
+ end if
+ pos = pos + 1
+ bit = bit - 1
+ if ( bit < 0 ) exit
+ end do
+
+ if ( present(status) ) status = success
+
+ return
+
+996 call error_handler( 'There was an integer overflow in reading' // &
+ 'size of bitset literal from UNIT', &
+ integer_overflow_error, status, &
+ module_name, procedure )
+ return
+
+999 call error_handler( 'There was an invalid character in STRING', &
+ char_string_invalid_error, status, &
+ module_name, procedure )
+
+ end subroutine read_bitset_string_64
+
+
+ module subroutine read_bitset_unit_64(self, unit, advance, status)
+!
+! Uses the bitset literal at the current position in the formatted
+! file with I/O unit, `unit`, to define the bitset, `self`. The literal
+! may be preceded by an arbitrary sequence of blank characters.
+! If `advance` is present it must be either 'YES' or 'NO'. If absent
+! it has the default value of 'YES' to determine whether advancing
+! I/O occurs. If `status` is absent an error results in an error stop
+! with an informative stop code. If `status` is present it has one of
+! the values:
+! * `success` - if no problem occurred,
+! * `alloc_fault` - if allocation of `self` failed,
+! * `array_size_invalid_error` - if `bits(self)` in the bitset literal
+! is greater than 64 for a `bitset_64`.
+! * `char_string_invalid_error` - if the read of the bitset literal found
+! an invalid character,
+! * `eof_failure` - if a `read` statement reaches an end-of-file before
+! completing the read of the bitset literal,
+! * `integer_overflow_error` - if the bitset literal has a `bits(self)`
+! value too large to be represented,
+! * `read_failure` - if a `read` statement fails,
+!
+ class(bitset_64), intent(out) :: self
+ integer, intent(in) :: unit
+ character(*), intent(in), optional :: advance
+ integer, intent(out), optional :: status
+
+ integer(bits_kind) :: bit, bits, digits
+ integer :: ierr
+ character(len=128) :: message
+ character(*), parameter :: procedure = "READ_BITSET"
+ character(len=1) :: char
+
+ do
+ read( unit, &
+ advance='NO', &
+ FMT='(A1)', &
+ err=997, &
+ end=998, &
+ iostat=ierr, &
+ iomsg=message ) char
+ select case( char )
+ case( ' ' )
+ cycle
+ case( 's', 'S' )
+ exit
+ case default
+ go to 999
+ end select
+ end do
+
+ bits = 0
+ digits = 0
+ do
+ read( unit, &
+ advance='NO', &
+ FMT='(A1)', &
+ err=998, &
+ end=999, &
+ iostat=ierr, &
+ iomsg=message ) char
+ if ( char == 'b' .or. char == 'B' ) exit
+ select case( char )
+ case( '0', '1', '2', '3', '4', '5', '6', '7', '8', '9' )
+ digits = digits + 1
+ if ( digits == max_digits .AND. bits > overflow_bits ) &
+ go to 996
+ if ( digits > max_digits ) go to 996
+ bits = 10*bits + iachar(char) - iachar('0')
+ if ( bits < 0 ) go to 996
+ case default
+ go to 999
+ end select
+ end do
+
+ if ( bits < 0 .OR. digits == 0 .OR. digits > max_digits ) go to 999
+
+ if ( bits > 64 ) then
+ call error_handler( 'BITS in UNIT was greater than 64.', &
+ array_size_invalid_error, status, &
+ module_name, procedure )
+ return
+ end if
+ call self % init( bits )
+ do bit = 1, bits-1
+ read( unit, &
+ advance='NO', &
+ FMT='(A1)', &
+ err=997, &
+ end=998, &
+ iostat=ierr, &
+ iomsg=message ) char
+ if ( char == '0' ) then
+ call self % clear( bits-bit )
+ else if ( char == '1' ) then
+ call self % set( bits-bit )
+ else
+ go to 999
+ end if
+ end do
+
+ if ( present(advance) ) then
+ read( unit, &
+ advance=advance, &
+ FMT='(A1)', &
+ err=997, &
+ end=998, &
+ iostat=ierr, &
+ iomsg=message ) char
+ else
+ read( unit, &
+ advance='YES', &
+ FMT='(A1)', &
+ err=997, &
+ end=998, &
+ iostat=ierr, &
+ iomsg=message ) char
+ end if
+ if ( char == '0' ) then
+ call self % clear( bits-bit )
+ else if ( char == '1' ) then
+ call self % set( bits-bit )
+ else
+ go to 999
+ end if
+
+ if ( present(status) ) status = success
+
+ return
+
+996 call error_handler( 'Integer overflow in reading size of ' // &
+ 'bitset literal from UNIT.', &
+ read_failure, status, module_name, procedure )
+ return
+
+997 call error_handler( 'Failure on read of UNIT.', &
+ read_failure, status, module_name, procedure )
+ return
+
+998 call error_handler( 'End of File of UNIT before finishing a ' // &
+ 'bitset literal.', &
+ eof_failure, status, module_name, procedure )
+ return
+
+999 call error_handler( 'Invalid character in bitset literal in UNIT ', &
+ char_string_invalid_error, status, &
+ module_name, procedure )
+
+ end subroutine read_bitset_unit_64
+
+
+ elemental module subroutine set_bit_64(self, pos)
+!
+! Sets the value at the POS position in SELF, provided the position is
+! valid. If the position is less than 0 or greater than BITS(SELF)-1
+! then SELF is unchanged.
+!
+ class(bitset_64), intent(inout) :: self
+ integer(bits_kind), intent(in) :: pos
+ integer(block_kind) :: dummy
+
+ if ( pos < 0 .OR. pos > self % num_bits-1 ) return
+ dummy = ibset( self % block, pos )
+ self % block = dummy
+
+ end subroutine set_bit_64
+
+
+ pure module subroutine set_range_64(self, start_pos, stop_pos)
+!
+! Sets all valid bits to 1 from the START_POS to the STOP_POS positions
+! in SELF. If STOP_POA < START_POS no bits are changed. Positions outside
+! the range 0 to BITS(SELF)-1 are ignored.
+!
+ class(bitset_64), intent(inout) :: self
+ integer(bits_kind), intent(in) :: start_pos, stop_pos
+
+ integer(bits_kind) :: end_bit, start_bit
+
+ start_bit = max( 0_bits_kind, start_pos )
+ end_bit = min( stop_pos, self % num_bits-1 )
+ if ( end_bit < start_bit ) return
+
+! FIRST and LAST are in the same block
+ call mvbits( all_ones, &
+ start_bit, &
+ end_bit - start_bit + 1, &
+ self % block, &
+ start_bit )
+
+ end subroutine set_range_64
+
+
+ elemental module function test_64(self, pos) result(test)
+!
+! Returns .TRUE. if the POS position is set, .FALSE. otherwise. If POS
+! is negative or greater than BITS(SELF) - 1 the result is .FALSE..
+!
+ logical :: test
+ class(bitset_64), intent(in) :: self
+ integer(bits_kind), intent(in) :: pos
+
+ if ( pos < 0 .or. pos >= self % num_bits ) then
+ test = .false.
+ else
+ test = btest( self % block, pos )
+ end if
+
+ end function test_64
+
+
+ module subroutine to_string_64(self, string, status)
+!
+! Represents the value of SELF as a binary literal in STRING
+! Status may have the values SUCCESS or ALLOC_FAULT
+!
+ class(bitset_64), intent(in) :: self
+ character(len=:), allocatable, intent(out) :: string
+ integer, intent(out), optional :: status
+
+ character(*), parameter :: procedure = 'TO_STRING'
+ integer :: bit, bit_count, pos, stat
+
+ bit_count = self % num_bits
+ allocate( character(len=bit_count)::string, stat=stat )
+ if ( stat > 0 ) then
+ call error_handler( 'There was an allocation fault for STRING.', &
+ alloc_fault, status, module_name, procedure )
+ return
+ end if
+ do bit=0, bit_count-1
+ pos = bit_count - bit
+ if ( btest( self % block, bit ) ) then
+ string( pos:pos ) = '1'
+ else
+ string( pos:pos ) = '0'
+ end if
+ end do
+
+ if ( present(status) ) status = success
+
+ end subroutine to_string_64
+
+
+ elemental module function value_64(self, pos) result(value)
+!
+! Returns 1 if the POS position is set, 0 otherwise. If POS is negative
+! or greater than BITS(SELF) - 1 the result is 0.
+!
+ integer :: value
+ class(bitset_64), intent(in) :: self
+ integer(bits_kind), intent(in) :: pos
+
+ if ( pos < 0 .or. pos >= self % num_bits ) then
+ value = 0
+
+ else
+ if ( btest( self % block, pos ) ) then
+ value = 1
+
+ else
+ value = 0
+
+ end if
+
+ end if
+
+ end function value_64
+
+
+ module subroutine write_bitset_string_64(self, string, status)
+!
+! Writes a bitset literal to the allocatable default character STRING,
+! representing the individual bit values in the bitset_t, SELF.
+! If STATUS is absent an error results in an error stop with an
+! informative stop code. If STATUS is present it has the default
+! value of SUCCESS, or the value ALLOC_FAULT if allocation of
+! the output string failed.
+!
+ class(bitset_64), intent(in) :: self
+ character(len=:), allocatable, intent(out) :: string
+ integer, intent(out), optional :: status
+
+ integer(bits_kind) :: bit, &
+ bit_count, &
+ count_digits, &
+ pos
+ integer :: stat
+
+ character(*), parameter :: procedure = 'WRITE_BITSET'
+
+ bit_count = bits(self)
+
+ call digit_count( self % num_bits, count_digits )
+
+ allocate( character(len=count_digits+bit_count+2)::string, stat=stat )
+ if ( stat > 0 ) then
+ call error_handler( 'There was an allocation fault for STRING.', &
+ alloc_fault, status, module_name, procedure )
+ return
+ end if
+ write( string, "('S', i0)" ) self % num_bits
+
+ string( count_digits + 2:count_digits + 2 ) = "B"
+ do bit=0, bit_count-1
+ pos = count_digits + 2 + bit_count - bit
+ if ( btest( self % block, bit ) ) then
+ string( pos:pos ) = '1'
+ else
+ string( pos:pos ) = '0'
+ end if
+ end do
+
+ if ( present(status) ) status = success
+
+ contains
+
+ subroutine digit_count( bits, digits )
+ integer(bits_kind), intent(in) :: bits
+ integer(bits_kind), intent(out) :: digits
+
+ integer(bits_kind) :: factor
+
+ factor = bits
+
+ if ( factor <= 0 ) then
+ digits = 1
+ return
+ end if
+
+ do digits = 1, 127
+ factor = factor / 10
+ if ( factor == 0 ) return
+ end do
+
+ end subroutine digit_count
+
+ end subroutine write_bitset_string_64
+
+
+ module subroutine write_bitset_unit_64(self, unit, advance, status)
+!
+! Writes a bitset literal to the I/O unit, UNIT, representing the
+! individual bit values in the bitset_t, SELF. By default or if
+! ADVANCE is present with the value 'YES', advancing output is used.
+! If ADVANCE is present with the value 'NO', then the current record
+! is not advanced by the write. If STATUS is absent an error results
+! in an error stop with an informative stop code. If STATUS is
+! present it has the default value of SUCCESS, the value
+! ALLOC_FAULT if allocation of the output string failed, or
+! WRITE_FAILURE if the WRITE statement outputting the literal failed.
+!
+ class(bitset_64), intent(in) :: self
+ integer, intent(in) :: unit
+ character(len=*), intent(in), optional :: advance
+ integer, intent(out), optional :: status
+
+ integer :: ierr
+ character(:), allocatable :: string
+ character(len=120) :: message
+ character(*), parameter :: procedure = "WRITE_BITSET"
+
+ call self % write_bitset(string, status)
+
+ if ( present(status) ) then
+ if (status /= success ) return
+ end if
+
+
+ if ( present( advance ) ) then
+ write( unit, &
+ FMT='(A)', &
+ advance=advance, &
+ iostat=ierr, &
+ iomsg=message ) &
+ string
+ else
+ write( unit, &
+ FMT='(A)', &
+ advance='YES', &
+ iostat=ierr, &
+ iomsg=message ) &
+ string
+ end if
+ if (ierr /= 0) then
+ call error_handler( 'Failure on a WRITE statement for UNIT.', &
+ write_failure, status, module_name, procedure )
+ return
+ endif
+
+ end subroutine write_bitset_unit_64
+
+
+ elemental module subroutine xor_64(set1, set2)
+!
+! Sets the bits in SET1 to the bitwise XOR of the original bits in SET1
+! and SET2. SET1 and SET2 must have the same number of bits otherwise
+! the result is undefined.
+!
+ type(bitset_64), intent(inout) :: set1
+ type(bitset_64), intent(in) :: set2
+
+ set1 % block = ieor( set1 % block, &
+ set2 % block )
+
+ end subroutine xor_64
+
+
+end submodule stdlib_bitsets_64
diff --git a/src/stdlib_bitsets_large.fypp b/src/stdlib_bitsets_large.fypp
new file mode 100644
index 000000000..2bcd1c659
--- /dev/null
+++ b/src/stdlib_bitsets_large.fypp
@@ -0,0 +1,1347 @@
+#:include "common.fypp"
+submodule(stdlib_bitsets) stdlib_bitsets_large
+ implicit none
+
+contains
+
+
+ elemental module function all_large( self ) result(all)
+! Returns .TRUE. if all bits in SELF are 1, .FALSE. otherwise.
+ logical :: all
+ class(bitset_large), intent(in) :: self
+
+ integer(bits_kind) :: block, full_blocks, pos
+
+ all = .true.
+ full_blocks = bits(self)/block_size
+ do block = 1_bits_kind, full_blocks
+ if ( self % blocks(block) /= -1_block_kind ) then
+ all = .false.
+ return
+ end if
+ end do
+
+ if ( full_blocks == size(self % blocks) ) return
+
+ do pos=0_bits_kind, modulo( bits(self), block_size )-1
+ if ( .not. btest(self % blocks(full_blocks+1), pos) ) then
+ all = .false.
+ return
+ end if
+ end do
+
+ end function all_large
+
+
+ elemental module subroutine and_large(set1, set2)
+!
+! Sets the bits in SET1 to the bitwise AND of the original bits in SET1
+! and SET2. It is required that SET1 have the same number of bits as
+! SET2 otherwise the result is undefined.
+!
+ type(bitset_large), intent(inout) :: set1
+ type(bitset_large), intent(in) :: set2
+
+ integer(bits_kind) :: block_
+
+ do block_ = 1_bits_kind, size(set1 % blocks, kind=bits_kind)
+ set1 % blocks(block_) = iand( set1 % blocks(block_), &
+ set2 % blocks(block_) )
+ end do
+
+ end subroutine and_large
+
+
+ elemental module subroutine and_not_large(set1, set2)
+!
+! Sets the bits in SET1 to the bitwise and of the original bits in SET1
+! with the bitwise negation of SET2. SET1 and SET2 must have the same
+! number of bits otherwise the result is undefined.
+!
+ type(bitset_large), intent(inout) :: set1
+ type(bitset_large), intent(in) :: set2
+
+ integer(bits_kind) :: block_
+
+ do block_ = 1_bits_kind, size( set1 % blocks, kind=bits_kind )
+ set1 % blocks(block_) = &
+ iand( set1 % blocks(block_), not( set2 % blocks(block_) ) )
+ end do
+
+ end subroutine and_not_large
+
+
+ elemental module function any_large(self) result(any)
+! Returns .TRUE. if any bit in SELF is 1, .FALSE. otherwise.
+ logical :: any
+ class(bitset_large), intent(in) :: self
+
+ integer(bits_kind) :: block_
+
+ do block_ = 1_bits_kind, size(self % blocks, kind=bits_kind)
+ if ( self % blocks(block_) /= 0 ) then
+ any = .true.
+ return
+ end if
+ end do
+ any = .false.
+
+ end function any_large
+
+
+ pure module subroutine assign_large( set1, set2 )
+! Used to define assignment for bitset_large
+ type(bitset_large), intent(out) :: set1
+ type(bitset_large), intent(in) :: set2
+
+ set1 % num_bits = set2 % num_bits
+ allocate( set1 % blocks( size( set2 % blocks, kind=bits_kind ) ) )
+ set1 % blocks(:) = set2 % blocks(:)
+
+ end subroutine assign_large
+
+ #:for k1 in INT_KINDS
+ pure module subroutine assign_log${k1}$_large( self, logical_vector )
+! Used to define assignment from an array of type logical for bitset_large
+ type(bitset_large), intent(out) :: self
+ logical(${k1}$), intent(in) :: logical_vector(:)
+
+ integer(bits_kind) :: blocks
+ integer(bits_kind) :: log_size
+ integer(bits_kind) :: index
+
+ log_size = size( logical_vector, kind=bits_kind )
+ self % num_bits = log_size
+ if ( log_size == 0 ) then
+ blocks = 0
+ else
+ blocks = (log_size-1)/block_size + 1
+ end if
+ allocate( self % blocks( blocks ) )
+ self % blocks(:) = 0
+
+ do index=0_bits_kind, log_size-1
+ if ( logical_vector(index+1) ) then
+ call self % set( index )
+ end if
+ end do
+
+ end subroutine assign_log${k1}$_large
+
+
+ pure module subroutine log${k1}$_assign_large( logical_vector, set )
+! Used to define assignment to an array of type logical for bitset_large
+ logical(${k1}$), intent(out), allocatable :: logical_vector(:)
+ type(bitset_large), intent(in) :: set
+
+ integer(bits_kind) :: index
+
+ allocate( logical_vector( set % num_bits ) )
+ do index=0_bits_kind, set % num_bits-1
+ if ( set % value( index ) == 1 ) then
+ logical_vector(index+1) = .true.
+ else
+ logical_vector(index+1) = .false.
+ end if
+ end do
+
+ end subroutine log${k1}$_assign_large
+ #:endfor
+
+
+ elemental module function bit_count_large(self) result(bit_count)
+! Returns the number of non-zero bits in SELF.
+ integer(bits_kind) :: bit_count
+ class(bitset_large), intent(in) :: self
+
+ integer(bits_kind) :: block_, pos
+
+ bit_count = 0
+ do block_ = 1_bits_kind, size(self % blocks, kind=bits_kind) - 1
+ do pos = 0, block_size-1
+ if ( btest( self % blocks(block_), pos ) ) &
+ bit_count = bit_count + 1
+ end do
+
+ end do
+
+ do pos = 0_bits_kind, self % num_bits - (block_-1)*block_size - 1
+ if ( btest( self % blocks(block_), pos ) ) bit_count = bit_count + 1
+ end do
+
+ end function bit_count_large
+
+
+ elemental module subroutine clear_bit_large(self, pos)
+!
+! Sets to zero the POS position in SELF. If POS is less than zero or
+! greater than BITS(SELF)-1 it is ignored.
+!
+ class(bitset_large), intent(inout) :: self
+ integer(bits_kind), intent(in) :: pos
+
+ integer :: clear_block, block_bit
+
+ if ( pos < 0 .OR. (pos > self % num_bits-1) ) return
+ clear_block = pos / block_size + 1
+ block_bit = pos - (clear_block - 1) * block_size
+ self % blocks(clear_block) = &
+ ibclr( self % blocks(clear_block), block_bit )
+
+ end subroutine clear_bit_large
+
+
+ pure module subroutine clear_range_large(self, start_pos, stop_pos)
+!
+! Sets to zero all bits from the START_POS to STOP_POS positions in SELF.
+! If STOP_POS < START_POS then no bits are modified. Positions outside
+! the range 0 to BITS(SELF)-1 are ignored.
+!
+ class(bitset_large), intent(inout) :: self
+ integer(bits_kind), intent(in) :: start_pos, stop_pos
+
+ integer(bits_kind) :: bit, block_, first_block, last_block, &
+ true_first, true_last
+
+ true_first = max( 0_bits_kind, start_pos )
+ true_last = min( self % num_bits-1, stop_pos )
+ if ( true_last < true_first ) return
+
+ first_block = true_first / block_size + 1
+ last_block = true_last / block_size + 1
+ if ( first_block == last_block ) then
+! TRUE_FIRST and TRUE_LAST are in the same block
+ call mvbits( all_zeros, &
+ true_first - (first_block-1)*block_size, &
+ true_last - true_first + 1, &
+ self % blocks(first_block), &
+ true_first - (first_block-1)*block_size )
+ return
+ end if
+
+! Do "partial" black containing FIRST
+ bit = true_first - (first_block-1)*block_size
+ call mvbits( all_zeros, &
+ bit, &
+ block_size - bit, &
+ self % blocks(first_block), &
+ bit )
+
+! Do "partial" black containing LAST
+ bit = true_last - (last_block-1)*block_size
+ call mvbits( all_zeros, &
+ 0, &
+ bit+1, &
+ self % blocks(last_block), &
+ 0 )
+
+! Do intermediate blocks
+ do block_ = first_block+1, last_block-1
+ self % blocks(block_) = all_zeros
+ end do
+
+ end subroutine clear_range_large
+
+
+ elemental module function eqv_large(set1, set2) result(eqv)
+!
+! Returns .TRUE. if all bits in SET1 and SET2 have the same value,
+! .FALSE. otherwise. The sets must have the same number of bits
+! otherwise the results are undefined.
+!
+ logical :: eqv
+ type(bitset_large), intent(in) :: set1, set2
+
+ integer(bits_kind) :: block, common_blocks
+
+ eqv = .false.
+ common_blocks = size(set1 % blocks, kind=bits_kind)
+ do block = 1, common_blocks
+ if ( set1 % blocks(block) /= set2 % blocks(block) ) return
+ end do
+ eqv = .true.
+
+ end function eqv_large
+
+
+ module subroutine extract_large(new, old, start_pos, stop_pos, status)
+! Creates a new bitset, NEW, from a range, START_POS to STOP_POS, in bitset
+! OLD. If START_POS is greater than STOP_POS the new bitset is empty.
+! If START_POS is less than zero or STOP_POS is greater than BITS(OLD)-1
+! then if STATUS is present it has the value INDEX_INVALID_ERROR,
+! otherwise processing stops with an informative message.
+ type(bitset_large), intent(out) :: new
+ type(bitset_large), intent(in) :: old
+ integer(bits_kind), intent(in) :: start_pos, stop_pos
+ integer, intent(out), optional :: status
+
+ integer(bits_kind) :: bits, blocks, ex_block, i, j, k, old_block
+ character(*), parameter :: procedure = 'EXTRACT'
+
+ if ( start_pos < 0 ) then
+ call error_handler( 'had a START_POS less than 0.', &
+ index_invalid_error, status, &
+ module_name, procedure )
+ return
+ end if
+ if ( stop_pos >= old % num_bits ) then
+ call error_handler( 'had a STOP_POS greater than BITS(OLD)-1.', &
+ index_invalid_error, status, &
+ module_name, procedure )
+ return
+ end if
+ bits = stop_pos - start_pos + 1
+
+ if ( bits <= 0 ) then
+ new % num_bits = 0
+ allocate( new % blocks(0) )
+ return
+ end if
+
+ blocks = ((bits-1) / block_size) + 1
+
+ new % num_bits = bits
+ allocate( new % blocks(blocks) )
+ new % blocks(:) = 0
+
+ do i=0_bits_kind, bits-1
+ ex_block = i / block_size + 1
+ j = i - (ex_block-1) * block_size
+ old_block = (start_pos + i) / block_size + 1
+ k = (start_pos + i) - (old_block-1) * block_size
+ if ( btest( old % blocks(old_block), k ) ) then
+ new % blocks(ex_block) = ibset(new % blocks(ex_block), j)
+ end if
+ end do
+
+ if ( present(status) ) status = success
+
+ end subroutine extract_large
+
+
+ elemental module subroutine flip_bit_large(self, pos)
+!
+! Flips the value at the POS position in SELF, provided the position is
+! valid. If POS is less than 0 or greater than BITS(SELF)-1, no value is
+! changed.
+!
+ class(bitset_large), intent(inout) :: self
+ integer(bits_kind), intent(in) :: pos
+
+ integer(bits_kind) :: flip_block, block_bit
+
+ if ( pos < 0 .OR. pos > self % num_bits-1 ) return
+
+ flip_block = pos / block_size + 1
+ block_bit = pos - (flip_block - 1) * block_size
+ if ( btest( self % blocks(flip_block), block_bit ) ) then
+ self % blocks(flip_block) = ibclr( self % blocks(flip_block), &
+ block_bit )
+ else
+ self % blocks(flip_block) = ibset( self % blocks(flip_block), &
+ block_bit )
+ end if
+
+ end subroutine flip_bit_large
+
+
+ pure module subroutine flip_range_large(self, start_pos, stop_pos)
+!
+! Flips all valid bits from the START_POS to the STOP_POS positions in
+! SELF. If STOP_POS < START_POS no bits are flipped. Positions less than
+! 0 or greater than BITS(SELF)-1 are ignored.
+!
+ class(bitset_large), intent(inout) :: self
+ integer(bits_kind), intent(in) :: start_pos, stop_pos
+
+ integer(bits_kind) :: bit, block_, end_bit, first_block, last_block, &
+ start_bit
+
+ start_bit = max( 0_bits_kind, start_pos )
+ end_bit = min( stop_pos , self % num_bits-1 )
+ if ( end_bit < start_bit ) return
+
+ first_block = start_bit / block_size + 1
+ last_block = end_bit / block_size + 1
+ if (first_block == last_block) then
+! FIRST and LAST are in the same block
+ call mvbits( not(self % blocks(first_block)), &
+ start_bit - (first_block-1)*block_size, &
+ end_bit - start_bit + 1, &
+ self % blocks(first_block), &
+ start_bit - (first_block-1)*block_size )
+ return
+ end if
+
+! Do "partial" black containing FIRST
+ bit = start_bit - (first_block-1)*block_size
+ call mvbits( not(self % blocks(first_block) ), &
+ bit, &
+ block_size - bit, &
+ self % blocks(first_block), &
+ bit )
+
+! Do "partial" black containing LAST
+ bit = end_bit - (last_block-1)*block_size
+ call mvbits( not( self % blocks(last_block) ), &
+ 0, &
+ bit+1, &
+ self % blocks(last_block), &
+ 0 )
+
+! Do remaining blocks
+ do block_ = first_block+1, last_block-1
+ self % blocks(block_) = not( self % blocks(block_) )
+ end do
+
+ end subroutine flip_range_large
+
+ module subroutine from_string_large(self, string, status)
+! Initializes the bitset `self` treating `string` as a binary literal
+! `status` may have the values:
+! `success` - if no problems were found,
+! `alloc_fault` - if allocation of the bitset failed
+! `char_string_too_large_error` - if `string` was too large, or
+! `char_string_invalid_error` - if string had an invalid character.
+ class(bitset_large), intent(out) :: self
+ character(*), intent(in) :: string
+ integer, intent(out), optional :: status
+
+ character(*), parameter :: procedure = 'FROM_STRING'
+ integer(int64) :: bit
+ integer(int64) :: bits
+ character(1) :: char
+
+ bits = len(string, kind=int64)
+ if ( bits > huge(0_bits_kind) ) then
+ call error_handler( 'STRING was too long for a ' // &
+ 'BITSET_LARGE SELF.', &
+ char_string_too_large_error, status, &
+ module_name, procedure )
+ return
+ end if
+
+ call init_zero_large( self, int(bits, kind=bits_kind), status )
+
+ if ( present(status) ) then
+ if ( status /= success ) return
+ end if
+
+ do bit = 1_bits_kind, bits
+ char = string(bit:bit)
+ if ( char == '0' ) then
+ call self % clear( int(bits-bit, kind=bits_kind) )
+ else if ( char == '1' ) then
+ call self % set( int(bits-bit, kind=bits_kind) )
+ else
+ call error_handler( 'STRING had a character other than ' // &
+ '0 or 1.', &
+ char_string_invalid_error, status, &
+ module_name, procedure )
+ return
+ end if
+ end do
+
+ if ( present(status) ) status = success
+
+ end subroutine from_string_large
+
+
+ elemental module function ge_large(set1, set2) result(ge)
+!
+! Returns .TRUE. if the bits in SET1 and SET2 are the same or the
+! highest order different bit is set to 1 in SET1 and to 0 in set2.
+! .FALSE. otherwise. The sets must have the same number of bits
+! otherwise the results are undefined.
+!
+ logical :: ge
+ type(bitset_large), intent(in) :: set1, set2
+
+ integer(bits_kind) :: block_
+
+ do block_ = size(set1 % blocks, kind=bits_kind), 1_bits_kind, -1
+ if ( set1 % blocks(block_) == set2 % blocks(block_) ) then
+ cycle
+ else if ( bgt(set1 % blocks(block_), set2 % blocks(block_) ) ) then
+ ge = .true.
+ return
+ else
+ ge = .false.
+ return
+ end if
+ end do
+ ge = .true.
+
+ end function ge_large
+
+
+ elemental module function gt_large(set1, set2) result(gt)
+!
+! Returns .TRUE. if the bits in SET1 and SET2 differ and the
+! highest order different bit is set to 1 in SET1 and to 0 in set2.
+! .FALSE. otherwise. The sets must have the same number of bits
+! otherwise the results are undefined.
+!
+ logical :: gt
+ type(bitset_large), intent(in) :: set1, set2
+
+ integer(bits_kind) :: block_
+
+ do block_ = size(set1 % blocks, kind=bits_kind), 1_bits_kind, -1
+ if ( set1 % blocks(block_) == set2 % blocks(block_) ) then
+ cycle
+ else if ( bgt( set1 % blocks(block_), &
+ set2 % blocks(block_) ) ) then
+ gt = .true.
+ return
+ else
+ gt = .false.
+ return
+ end if
+ end do
+ gt = .false.
+
+ end function gt_large
+
+
+ module subroutine init_zero_large(self, bits, status)
+!
+! Creates the bitset, `self`, of size `bits`, with all bits initialized to
+! zero. `bits` must be non-negative. If an error occurs and `status` is
+! absent then processing stops with an informative stop code. `status`
+! will have one of the values;
+! * `success` - if no problems were found,
+! * `array_size_invalid_error` - if `bits` is either negative or larger
+! than 64 with `self` of class `bitset_64`, or
+! * `alloc_fault` - if memory allocation failed
+!
+ class(bitset_large), intent(out) :: self
+ integer(bits_kind), intent(in) :: bits
+ integer, intent(out), optional :: status
+
+ character(len=120) :: message
+ character(*), parameter :: procedure = "INIT"
+ integer :: blocks, ierr
+
+ message = ''
+ if ( bits < 0 ) then
+ call error_handler( 'BITS had a negative value.', &
+ array_size_invalid_error, status, &
+ module_name, procedure )
+ return
+ end if
+
+ if (bits == 0) then
+ self % num_bits = 0
+ allocate( self % blocks(0), stat=ierr, errmsg=message )
+ if (ierr /= 0) go to 998
+ return
+ else
+ blocks = ((bits-1) / block_size) + 1
+ end if
+
+ self % num_bits = bits
+ allocate( self % blocks(blocks), stat=ierr, errmsg=message )
+ if (ierr /= 0) go to 998
+
+ self % blocks(:) = all_zeros
+
+ if ( present(status) ) status = success
+
+ return
+
+998 call error_handler( 'Allocation failure for SELF.', &
+ alloc_fault, status, &
+ module_name, procedure )
+
+ end subroutine init_zero_large
+
+
+ module subroutine input_large(self, unit, status)
+!
+! Reads the components of the bitset, `self`, from the unformatted I/O
+! unit, `unit`, assuming that the components were written using `output`.
+! If an error occurs and `status` is absent then processing stops with
+! an informative stop code. `status` has one of the values:
+! * `success` - if no problem was found
+! * `alloc_fault` - if it failed during allocation of memory for `self`, or
+! * `array_size_invalid_error` if the `bits(self)` in `unit` is negative
+! or greater than 64 for a `bitset_64` input.
+! * `read_failure` - if it failed during the reads from `unit`
+!
+ class(bitset_large), intent(out) :: self
+ integer, intent(in) :: unit
+ integer, intent(out), optional :: status
+
+ integer(bits_kind) :: bits
+ integer :: ierr
+ character(len=120) :: message
+ character(*), parameter :: procedure = 'INPUT'
+ integer :: stat
+
+ read(unit, iostat=ierr, iomsg=message) bits
+ if (ierr /= 0) then
+ call error_handler( 'Failure on a READ statement for UNIT.', &
+ read_failure, status, module_name, procedure )
+ return
+ end if
+
+ if ( bits < 0 ) then
+ call error_handler( 'BITS in UNIT had a negative value.', &
+ array_size_invalid_error, status, &
+ module_name, procedure )
+ return
+ end if
+
+ call self % init(bits, stat)
+ if (stat /= success) then
+ call error_handler( 'Allocation failure for SELF.', &
+ alloc_fault, status, module_name, procedure )
+ return
+ end if
+
+ if (bits < 1) return
+
+ read(unit, iostat=ierr, iomsg=message) self % blocks(:)
+ if (ierr /= 0) then
+ call error_handler( 'Failure on a READ statement for UNIT.', &
+ read_failure, status, module_name, procedure )
+ return
+ end if
+
+ if ( present(status) ) status = success
+
+ end subroutine input_large
+
+
+ elemental module function le_large(set1, set2) result(le)
+!
+! Returns .TRUE. if the bits in SET1 and SET2 are the same or the
+! highest order different bit is set to 0 in SET1 and to 1 in set2.
+! .FALSE. otherwise. The sets must have the same number of bits
+! otherwise the results are undefined.
+!
+ logical :: le
+ type(bitset_large), intent(in) :: set1, set2
+
+ integer(bits_kind) :: block_
+
+ do block_ = size(set1 % blocks, kind=bits_kind), 1_bits_kind, -1
+ if ( set1 % blocks(block_) == set2 % blocks(block_) ) then
+ cycle
+ else if ( blt( set1 % blocks(block_), &
+ set2 % blocks(block_) ) ) then
+ le = .true.
+ return
+ else
+ le = .false.
+ return
+ end if
+ end do
+
+ le = .true.
+
+ end function le_large
+
+
+ elemental module function lt_large(set1, set2) result(lt)
+!
+! Returns .TRUE. if the bits in SET1 and SET2 differ and the
+! highest order different bit is set to 0 in SET1 and to 1 in set2.
+! .FALSE. otherwise. The sets must have the same number of bits
+! otherwise the results are undefined.
+!
+ logical :: lt
+ type(bitset_large), intent(in) :: set1, set2
+
+ integer(bits_kind) :: block_
+
+ do block_ = size(set1 % blocks, kind=bits_kind), 1_bits_kind, -1
+ if ( set1 % blocks(block_) == set2 % blocks(block_) ) then
+ cycle
+ else if ( blt( set1 % blocks(block_), &
+ set2 % blocks(block_) ) ) then
+ lt = .true.
+ return
+ else
+ lt = .false.
+ return
+ end if
+ end do
+ lt = .false.
+
+ end function lt_large
+
+
+ elemental module function neqv_large(set1, set2) result(neqv)
+!
+! Returns .TRUE. if any bits in SET1 and SET2 differ in value,
+! .FALSE. otherwise. The sets must have the same number of bits
+! otherwise the results are undefined.
+!
+ logical :: neqv
+ type(bitset_large), intent(in) :: set1, set2
+
+ integer(bits_kind) :: block_
+
+ neqv = .true.
+ do block_ = 1_bits_kind, size(set1 % blocks, kind=bits_kind)
+ if ( set1 % blocks(block_) /= set2 % blocks(block_) ) return
+ end do
+ neqv = .false.
+
+ end function neqv_large
+
+
+ elemental module function none_large(self) result(none)
+!
+! Returns .TRUE. if none of the bits in SELF have the value 1.
+!
+ logical :: none
+ class(bitset_large), intent(in) :: self
+
+ integer(bits_kind) :: block
+
+ none = .true.
+ do block = 1_bits_kind, size(self % blocks, kind=bits_kind)
+ if (self % blocks(block) /= 0) then
+ none = .false.
+ return
+ end if
+ end do
+
+ end function none_large
+
+
+ elemental module subroutine not_large(self)
+!
+! Sets the bits in SELF to their logical complement
+!
+ class(bitset_large), intent(inout) :: self
+
+ integer(bits_kind) :: bit, full_blocks, block
+ integer :: remaining_bits
+
+ if ( self % num_bits == 0 ) return
+ full_blocks = self % num_bits / block_size
+ do block = 1_bits_kind, full_blocks
+ self % blocks(block) = not( self % blocks(block) )
+ end do
+ remaining_bits = self % num_bits - full_blocks * block_size
+
+ do bit=0, remaining_bits - 1
+ if ( btest( self % blocks( block ), bit ) ) then
+ self % blocks( block ) = ibclr( self % blocks(block), bit )
+ else
+ self % blocks( block ) = ibset( self % blocks(block), bit )
+ end if
+ end do
+
+ end subroutine not_large
+
+
+ elemental module subroutine or_large(set1, set2)
+!
+! Sets the bits in SET1 to the bitwise OR of the original bits in SET1
+! and SET2. SET1 and SET2 must have the same number of bits otherwise
+! the result is undefined.
+!
+ type(bitset_large), intent(inout) :: set1
+ type(bitset_large), intent(in) :: set2
+
+ integer(bits_kind) :: block_
+
+ do block_ = 1, size( set1 % blocks, kind=bits_kind )
+ set1 % blocks(block_) = ior( set1 % blocks(block_), &
+ set2 % blocks(block_) )
+ end do
+
+ end subroutine or_large
+
+
+ module subroutine output_large(self, unit, status)
+!
+! Writes the components of the bitset, SELF, to the unformatted I/O
+! unit, UNIT, in a unformatted sequence compatible with INPUT. If
+! STATUS is absent an error results in an error stop with an
+! informative stop code. If STATUS is present it has the default
+! value of SUCCESS, or the value WRITE_FAILURE if the write failed.
+!
+ class(bitset_large), intent(in) :: self
+ integer, intent(in) :: unit
+ integer, intent(out), optional :: status
+
+ integer :: ierr
+ character(len=120) :: message
+ character(*), parameter :: procedure = "OUTPUT"
+
+ write(unit, iostat=ierr, iomsg=message) self % num_bits
+ if (ierr /= 0) go to 999
+
+ if (self % num_bits < 1) return
+ write(unit, iostat=ierr, iomsg=message) self % blocks(:)
+ if (ierr /= 0) go to 999
+
+ return
+
+999 call error_handler( 'Failure on a WRITE statement for UNIT.', &
+ write_failure, status, module_name, procedure )
+
+ end subroutine output_large
+
+
+ module subroutine read_bitset_string_large(self, string, status)
+!
+! Uses the bitset literal in the default character `string`, to define
+! the bitset, `self`. The literal may be preceded by an an arbitrary
+! sequence of blank characters. If `status` is absent an error results
+! in an error stop with an informative stop code. If `status`
+! is present it has one of the values
+! * `success` - if no problems occurred,
+! * `alloc_fault` - if allocation of memory for SELF failed,
+! * `array_size_invalid_error - if `bits(self)` in `string` is greater
+! than 64 for a `bitset_64`,
+! * `char_string_invalid_error` - if the bitset literal has an invalid
+! character,
+! * `char_string_too_small_error - if the string ends before all the bits
+! are read.
+! * `integer_overflow_error` - if the bitset literal has a `bits(self)`
+! value too large to be represented,
+!
+ class(bitset_large), intent(out) :: self
+ character(len=*), intent(in) :: string
+ integer, intent(out), optional :: status
+
+ integer(bits_kind) :: bit, bits
+ integer(bits_kind) :: digits, pos
+ character(*), parameter :: procedure = "READ_BITSET"
+ integer :: stat
+
+ pos = 1
+ find_start: do pos=1_bits_kind, len(string, kind=bits_kind)
+ if ( string(pos:pos) /= ' ' ) exit
+ end do find_start
+
+ if ( pos > len(string) - 8 ) go to 999
+
+ if ( string(pos:pos) /= 's' .AND. string(pos:pos) /= 'S' ) go to 999
+
+ pos = pos + 1
+ bits = 0
+ digits = 0
+
+ do
+ select case( iachar( string(pos:pos) ) )
+ case(ia0:ia9)
+ digits = digits + 1
+ if ( digits == max_digits .AND. bits > overflow_bits ) go to 996
+ if ( digits > max_digits ) go to 996
+ bits = bits*10 + iachar( string(pos:pos) ) - ia0
+ if ( bits < 0 ) go to 996
+ case(iachar('b'), iachar('B'))
+ exit
+ case default
+ call error_handler( 'There was an invalid character ' // &
+ 'in STRING', &
+ char_string_invalid_error, status, &
+ module_name, procedure )
+ return
+ end select
+
+ pos = pos + 1
+ end do
+
+ if ( bits + pos > len(string) ) then
+ call error_handler( 'STRING was too small for the number of ' // &
+ 'bits specified by STRING.', &
+ char_string_too_small_error, status, &
+ module_name, procedure )
+ return
+ end if
+ call self % init( bits, stat )
+ if (stat /= success) then
+ call error_handler( 'There was an allocation fault for SELF.', &
+ alloc_fault, status, module_name, procedure )
+ return
+ end if
+
+ pos = pos + 1
+ bit = bits - 1
+ do
+ if ( string(pos:pos) == '0' ) then
+ call self % clear( bit )
+ else if ( string(pos:pos) == '1' ) then
+ call self % set( bit )
+ else
+ go to 999
+ end if
+ pos = pos + 1
+ bit = bit - 1
+ if ( bit < 0 ) exit
+ end do
+
+ if ( present(status) ) status = success
+
+ return
+
+996 call error_handler( 'There was an integer overflow in reading' // &
+ 'size of bitset literal from UNIT', &
+ integer_overflow_error, status, &
+ module_name, procedure )
+ return
+
+999 call error_handler( 'There was an invalid character in STRING', &
+ char_string_invalid_error, status, &
+ module_name, procedure )
+
+ end subroutine read_bitset_string_large
+
+
+ module subroutine read_bitset_unit_large(self, unit, advance, status)
+!
+! Uses the bitset literal at the current position in the formatted
+! file with I/O unit, `unit`, to define the bitset, `self`. The literal
+! may be preceded by an arbitrary sequence of blank characters.
+! If `advance` is present it must be either 'YES' or 'NO'. If absent
+! it has the default value of 'YES' to determine whether advancing
+! I/O occurs. If `status` is absent an error results in an error stop
+! with an informative stop code. If `status` is present it has one of
+! the values:
+! * `success` - if no problem occurred,
+! * `alloc_fault` - if allocation of `self` failed,
+! * `array_size_invalid_error` - if `bits(self)` in the bitset literal
+! is greater than 64 for a `bitset_64`.
+! * `char_string_invalid_error` - if the read of the bitset literal found
+! an invalid character,
+! * `eof_failure` - if a `read` statement reaches an end-of-file before
+! completing the read of the bitset literal,
+! * `integer_overflow_error` - if the bitset literal has a `bits(self)`
+! value too large to be represented,
+! * `read_failure` - if a `read` statement fails,
+!
+ class(bitset_large), intent(out) :: self
+ integer, intent(in) :: unit
+ character(*), intent(in), optional :: advance
+ integer, intent(out), optional :: status
+
+ integer(bits_kind) :: bit, bits, digits
+ integer :: ierr
+ character(len=128) :: message
+ character(*), parameter :: procedure = "READ_BITSET"
+ character(len=1) :: char
+
+ do
+ read( unit, &
+ advance='NO', &
+ FMT='(A1)', &
+ err=997, &
+ end=998, &
+ iostat=ierr, &
+ iomsg=message ) char
+ select case( char )
+ case( ' ' )
+ cycle
+ case( 's', 'S' )
+ exit
+ case default
+ go to 999
+ end select
+ end do
+
+ bits = 0
+ digits = 0
+ do
+ read( unit, &
+ advance='NO', &
+ FMT='(A1)', &
+ err=997, &
+ end=998, &
+ iostat=ierr, &
+ iomsg=message ) char
+ if ( char == 'b' .or. char == 'B' ) exit
+ select case( char )
+ case( '0', '1', '2', '3', '4', '5', '6', '7', '8', '9' )
+ digits = digits + 1
+ if ( digits == max_digits .AND. bits > overflow_bits ) &
+ go to 996
+ if ( digits > max_digits ) go to 996
+ bits = 10*bits + iachar(char) - iachar('0')
+ if ( bits < 0 ) go to 996
+ case default
+ go to 999
+ end select
+ end do
+
+ if ( bits < 0 .OR. digits == 0 .OR. digits > max_digits ) go to 999
+
+ call self % init( bits, status )
+ if ( present(status) ) then
+ call error_handler( 'There was an allocation fault for SELF.', &
+ alloc_fault, status, module_name, procedure )
+ return
+ end if
+ do bit = 1, bits-1
+ read( unit, &
+ advance='NO', &
+ FMT='(A1)', &
+ err=997, &
+ end=998, &
+ iostat=ierr, &
+ iomsg=message ) char
+ if ( char == '0' ) then
+ call self % clear( bits-bit )
+ else if ( char == '1' ) then
+ call self % set( bits-bit )
+ else
+ go to 999
+ end if
+ end do
+
+ if ( present(advance) ) then
+ read( unit, &
+ advance=advance, &
+ FMT='(A1)', &
+ err=997, &
+ end=998, &
+ iostat=ierr, &
+ iomsg=message ) char
+ else
+ read( unit, &
+ advance='YES', &
+ FMT='(A1)', &
+ err=997, &
+ end=998, &
+ iostat=ierr, &
+ iomsg=message ) char
+ end if
+
+ if ( char == '0' ) then
+ call self % clear( bits-bit )
+ else if ( char == '1' ) then
+ call self % set( bits-bit )
+ else
+ go to 999
+ end if
+
+ if ( present(status) ) status = success
+
+ return
+
+996 call error_handler( 'Integer overflow in reading size of ' // &
+ 'bitset literal from UNIT.', &
+ read_failure, status, module_name, procedure )
+ return
+
+997 call error_handler( 'Failure on read of UNIT.', &
+ read_failure, status, module_name, procedure )
+ return
+
+998 call error_handler( 'End of File of UNIT before finishing a ' // &
+ 'bitset literal.', &
+ eof_failure, status, module_name, procedure )
+ return
+
+999 call error_handler( 'Invalid character in bitset literal in UNIT ', &
+ char_string_invalid_error, status, &
+ module_name, procedure )
+
+ end subroutine read_bitset_unit_large
+
+
+ elemental module subroutine set_bit_large(self, pos)
+!
+! Sets the value at the POS position in SELF, provided the position is
+! valid. If the position is less than 0 or greater than BITS(SELF)-1
+! then SELF is unchanged.
+!
+ class(bitset_large), intent(inout) :: self
+ integer(bits_kind), intent(in) :: pos
+
+ integer(bits_kind) :: set_block, block_bit
+
+ if ( pos < 0 .OR. pos > self % num_bits-1 ) return
+
+ set_block = pos / block_size + 1
+ block_bit = pos - (set_block - 1) * block_size
+ self % blocks(set_block) = ibset( self % blocks(set_block), block_bit )
+
+ end subroutine set_bit_large
+
+
+ pure module subroutine set_range_large(self, start_pos, stop_pos)
+!
+! Sets all valid bits to 1 from the START_POS to the STOP_POS positions
+! in SELF. If STOP_POA < START_POS no bits are changed. Positions outside
+! the range 0 to BITS(SELF)-1 are ignored.
+!
+ class(bitset_large), intent(inout) :: self
+ integer(bits_kind), intent(in) :: start_pos, stop_pos
+
+ integer(bits_kind) :: bit, block_, end_bit, first_block, last_block, &
+ start_bit
+
+ start_bit = max( 0_bits_kind, start_pos )
+ end_bit = min( stop_pos, self % num_bits-1 )
+ if ( end_bit < start_bit ) return
+
+ first_block = start_bit / block_size + 1
+ last_block = end_bit / block_size + 1
+ if ( first_block == last_block ) then
+! FIRST and LAST are in the same block
+ call mvbits( all_ones, &
+ start_bit - (first_block-1)*block_size, &
+ end_bit - start_bit + 1, &
+ self % blocks(first_block), &
+ start_bit - (first_block-1)*block_size )
+ return
+ end if
+
+! Do "partial" black containing FIRST
+ bit = start_bit - (first_block-1)*block_size
+ call mvbits( all_ones, &
+ bit, &
+ block_size - bit, &
+ self % blocks(first_block), &
+ bit )
+
+! Do "partial" black containing LAST
+ bit = end_bit - (last_block-1)*block_size
+ call mvbits( all_ones, &
+ 0, &
+ bit+1, &
+ self % blocks(last_block), &
+ 0 )
+
+! Do remaining blocks
+ do block_ = first_block+1, last_block-1
+ self % blocks(block_) = all_ones
+ end do
+
+ end subroutine set_range_large
+
+
+ elemental module function test_large(self, pos) result(test)
+!
+! Returns .TRUE. if the POS position is set, .FALSE. otherwise. If POS
+! is negative or greater than BITS(SELF) - 1 the result is .FALSE..
+!
+ logical :: test
+ class(bitset_large), intent(in) :: self
+ integer(bits_kind), intent(in) :: pos
+
+ integer(bits_kind) :: bit_block
+
+ if ( pos < 0 .or. pos >= self % num_bits ) then
+ test = .false.
+ else
+ bit_block = pos / block_size + 1
+ test = btest( self % blocks(bit_block), &
+ pos - ( bit_block-1 ) * block_size )
+ end if
+
+ end function test_large
+
+
+ module subroutine to_string_large(self, string, status)
+!
+! Represents the value of SELF as a binary literal in STRING
+! Status may have the values SUCCESS or ALLOC_FAULT
+!
+ class(bitset_large), intent(in) :: self
+ character(len=:), allocatable, intent(out) :: string
+ integer, intent(out), optional :: status
+
+ character(*), parameter :: procedure = 'TO_STRING'
+ integer(bits_kind) :: bit, bit_count, pos
+ integer :: stat
+
+ bit_count = self % num_bits
+ allocate( character(len=bit_count)::string, stat=stat )
+ if ( stat > 0 ) then
+ call error_handler( 'There was an allocation fault for STRING.', &
+ alloc_fault, status, module_name, procedure )
+ return
+ end if
+ do bit=0_bits_kind, bit_count-1
+ pos = bit_count - bit
+ if ( self % test( bit) ) then
+ string( pos:pos ) = '1'
+ else
+ string( pos:pos ) = '0'
+ end if
+ end do
+
+ if ( present(status) ) status = success
+
+ end subroutine to_string_large
+
+
+ elemental module function value_large(self, pos) result(value)
+!
+! Returns 1 if the POS position is set, 0 otherwise. If POS is negative
+! or greater than BITS(SELF) - 1 the result is 0.
+!
+ integer :: value
+ class(bitset_large), intent(in) :: self
+ integer(bits_kind), intent(in) :: pos
+
+ integer :: bit_block
+
+ if ( pos < 0 .or. pos >= self % num_bits ) then
+ value = 0
+ else
+ bit_block = pos / block_size + 1
+ if ( btest( self % blocks(bit_block), &
+ pos - ( bit_block-1 ) * block_size ) ) then
+ value = 1
+ else
+ value = 0
+ end if
+ end if
+
+ end function value_large
+
+
+ module subroutine write_bitset_string_large(self, string, status)
+!
+! Writes a bitset literal to the allocatable default character STRING,
+! representing the individual bit values in the bitset_t, SELF.
+! If STATUS is absent an error results in an error stop with an
+! informative stop code. If STATUS is present it has the default
+! value of SUCCESS, or the value ALLOC_FAULT if allocation of
+! the output string failed.
+!
+ class(bitset_large), intent(in) :: self
+ character(len=:), allocatable, intent(out) :: string
+ integer, intent(out), optional :: status
+
+ integer(bits_kind) :: bit, &
+ bit_count, &
+ count_digits, &
+ pos
+ integer :: stat
+
+ character(*), parameter :: procedure = 'WRITE_BITSET'
+
+ bit_count = bits(self)
+
+ call digit_count( self % num_bits, count_digits )
+
+ allocate( character(len=count_digits+bit_count+2)::string, stat=stat )
+ if ( stat > 0 ) then
+ call error_handler( 'There was an allocation fault for STRING.', &
+ alloc_fault, status, module_name, procedure )
+ return
+ end if
+
+ write( string, "('S', i0)" ) self % num_bits
+
+ string( count_digits + 2:count_digits + 2 ) = "B"
+ do bit=0_bits_kind, bit_count-1
+ pos = count_digits + 2 + bit_count - bit
+ if ( self % test( bit) ) then
+ string( pos:pos ) = '1'
+ else
+ string( pos:pos ) = '0'
+ end if
+ end do
+
+ if ( present(status) ) status = success
+
+ contains
+
+ subroutine digit_count( bits, digits )
+ integer(bits_kind), intent(in) :: bits
+ integer(bits_kind), intent(out) :: digits
+
+ integer(bits_kind) :: factor
+
+ factor = bits
+
+ if ( factor <= 0 ) then
+ digits = 1
+ return
+ end if
+
+ do digits = 1, 127
+ factor = factor / 10
+ if ( factor == 0 ) return
+ end do
+
+ end subroutine digit_count
+
+ end subroutine write_bitset_string_large
+
+
+ module subroutine write_bitset_unit_large(self, unit, advance, status)
+!
+! Writes a bitset literal to the I/O unit, UNIT, representing the
+! individual bit values in the bitset_t, SELF. By default or if
+! ADVANCE is present with the value 'YES', advancing output is used.
+! If ADVANCE is present with the value 'NO', then the current record
+! is not advanced by the write. If STATUS is absent an error results
+! in an error stop with an informative stop code. If STATUS is
+! present it has the default value of SUCCESS, the value
+! ALLOC_FAULT if allocation of the output string failed, or
+! WRITE_FAILURE if the WRITE statement outputting the literal failed.
+!
+ class(bitset_large), intent(in) :: self
+ integer, intent(in) :: unit
+ character(len=*), intent(in), optional :: advance
+ integer, intent(out), optional :: status
+
+ integer :: ierr
+ character(:), allocatable :: string
+ character(len=120) :: message
+ character(*), parameter :: procedure = "WRITE_BITSET"
+
+ call self % write_bitset(string, status)
+
+ if ( present(status) ) then
+ if (status /= success ) return
+ end if
+
+
+ if ( present( advance ) ) then
+ write( unit, &
+ FMT='(A)', &
+ advance=advance, &
+ iostat=ierr, &
+ iomsg=message ) &
+ string
+ else
+ write( unit, &
+ FMT='(A)', &
+ advance='YES', &
+ iostat=ierr, &
+ iomsg=message ) &
+ string
+ end if
+ if (ierr /= 0) then
+ call error_handler( 'Failure on a WRITE statement for UNIT.', &
+ write_failure, status, module_name, procedure )
+ return
+ endif
+
+ end subroutine write_bitset_unit_large
+
+
+ elemental module subroutine xor_large(set1, set2)
+!
+! Sets the bits in SET1 to the bitwise XOR of the original bits in SET1
+! and SET2. SET1 and SET2 must have the same number of bits otherwise
+! the result is undefined.
+!
+ type(bitset_large), intent(inout) :: set1
+ type(bitset_large), intent(in) :: set2
+
+ integer(bits_kind) :: block_
+
+ do block_ = 1_bits_kind, size(set1 % blocks, kind=bits_kind)
+ set1 % blocks(block_) = ieor( set1 % blocks(block_), &
+ set2 % blocks(block_) )
+ end do
+
+ end subroutine xor_large
+
+end submodule stdlib_bitsets_large
diff --git a/src/tests/CMakeLists.txt b/src/tests/CMakeLists.txt
index 9e341d380..c3b09e34d 100644
--- a/src/tests/CMakeLists.txt
+++ b/src/tests/CMakeLists.txt
@@ -7,6 +7,7 @@ macro(ADDTEST name)
endmacro(ADDTEST)
add_subdirectory(ascii)
+add_subdirectory(bitsets)
add_subdirectory(io)
add_subdirectory(linalg)
add_subdirectory(logger)
diff --git a/src/tests/Makefile.manual b/src/tests/Makefile.manual
index 9b0227232..89325cd56 100644
--- a/src/tests/Makefile.manual
+++ b/src/tests/Makefile.manual
@@ -2,6 +2,7 @@
all:
$(MAKE) -f Makefile.manual --directory=ascii
+ $(MAKE) -f Makefile.manual --directory=bitsets
$(MAKE) -f Makefile.manual --directory=io
$(MAKE) -f Makefile.manual --directory=logger
$(MAKE) -f Makefile.manual --directory=optval
@@ -10,6 +11,7 @@ all:
test:
$(MAKE) -f Makefile.manual --directory=ascii test
+ $(MAKE) -f Makefile.manual --directory=bitsets test
$(MAKE) -f Makefile.manual --directory=io test
$(MAKE) -f Makefile.manual --directory=logger test
$(MAKE) -f Makefile.manual --directory=optval test
@@ -18,6 +20,7 @@ test:
clean:
$(MAKE) -f Makefile.manual --directory=ascii clean
+ $(MAKE) -f Makefile.manual --directory=bitsets clean
$(MAKE) -f Makefile.manual --directory=io clean
$(MAKE) -f Makefile.manual --directory=logger clean
$(MAKE) -f Makefile.manual --directory=optval clean
diff --git a/src/tests/bitsets/CMakeLists.txt b/src/tests/bitsets/CMakeLists.txt
new file mode 100644
index 000000000..519015e20
--- /dev/null
+++ b/src/tests/bitsets/CMakeLists.txt
@@ -0,0 +1,3 @@
+ADDTEST(stdlib_bitset_64)
+ADDTEST(stdlib_bitset_large)
+
diff --git a/src/tests/bitsets/Makefile.manual b/src/tests/bitsets/Makefile.manual
new file mode 100644
index 000000000..0ecba442e
--- /dev/null
+++ b/src/tests/bitsets/Makefile.manual
@@ -0,0 +1,3 @@
+PROGS_SRC = test_stdlib_bitset_64.f90 test_stdlib_bitset_large.f90
+
+include ../Makefile.manual.test.mk
diff --git a/src/tests/bitsets/test_stdlib_bitset_64.f90 b/src/tests/bitsets/test_stdlib_bitset_64.f90
new file mode 100644
index 000000000..fd92d458d
--- /dev/null
+++ b/src/tests/bitsets/test_stdlib_bitset_64.f90
@@ -0,0 +1,752 @@
+program test_stdlib_bitset_64
+ use :: stdlib_kinds, only : int8, int16, int32, int64
+ use stdlib_bitsets
+ character(*), parameter :: &
+ bitstring_0 = '000000000000000000000000000000000', &
+ bitstring_33 = '100000000000000000000000000000000', &
+ bitstring_all = '111111111111111111111111111111111'
+ type(bitset_64) :: set0, set1, set2, set3, set4, set5
+ integer :: status
+ character(:), allocatable :: string0
+
+ call test_string_operations()
+
+ call test_io()
+
+ call test_initialization()
+
+ call test_bitset_inquiry()
+
+ call test_bit_operations()
+
+ call test_bitset_comparisons()
+
+ call test_bitset_operations()
+
+contains
+
+ subroutine test_string_operations()
+ character(*), parameter:: procedure = 'TEST_STRING_OPERATIONS'
+
+ write(*,'(/a)') 'Test string operations: from_string, ' // &
+ 'read_bitset, to_string, and write_bitset'
+
+ call set0 % from_string( bitstring_0 )
+ if ( bits(set0) /= 33 ) then
+ error stop procedure // ' from_string failed to interpret ' // &
+ 'bitstring_0 size properly.'
+ else if ( .not. set0 % none() ) then
+ error stop procedure // ' failed to interpret bitstring_0 ' // &
+ 'value properly.'
+ else if ( set0 % any() ) then
+ error stop procedure // ' failed to interpret bitstring_0 ' // &
+ 'value properly.'
+ else
+ write(*,*) 'from_string transferred bitstring_0 properly into set0'
+ end if
+
+ call set1 % from_string( bitstring_all )
+ if ( bits(set1) /= 33 ) then
+ error stop procedure // ' from_string failed to interpret ' // &
+ 'bitstring_all size properly.'
+ else if ( set1 % none() ) then
+ error stop procedure // ' failed to interpret bitstring_all ' // &
+ 'value properly.'
+ else if ( .not. set1 % any() ) then
+ error stop procedure // ' failed to interpret bitstring_all ' // &
+ 'value properly.'
+ else if ( .not. set1 % all() ) then
+ error stop procedure // ' failed to interpret bitstring_all ' // &
+ 'value properly.'
+ else
+ write(*,*) 'from_string transferred bitstring_all properly ' // &
+ 'into set1'
+ end if
+
+ call set3 % read_bitset( bitstring_0, status )
+ if ( status /= success ) then
+ write(*,*) 'read_bitset_string failed with bitstring_0 as expected.'
+ else
+ error stop procedure // ' read_bitset_string did not fail ' // &
+ 'with bitstring_0 as expected.'
+ end if
+
+ call set3 % read_bitset( 's33b' // bitstring_0, status )
+
+ if ( bits(set3) /= 33 ) then
+ error stop procedure // ' read_bitset_string failed to ' // &
+ 'interpret "s33b" // bitstring_0 size properly.'
+ else if ( .not. set3 % none() ) then
+ error stop procedure // ' failed to interpret "s33b" // ' // &
+ 'bitstring_0 value properly.'
+ else
+ write(*,*) 'read_bitset_string transferred "s33b" // ' // &
+ 'bitstring_0 properly into set3'
+ end if
+
+ call set4 % read_bitset( 's33b' // bitstring_all )
+ if ( bits(set4) /= 33 ) then
+ error stop procedure // ' read_bitset_string failed to ' // &
+ 'interpret "s33b" // bitstring_all size properly.'
+ else if ( set4 % none() ) then
+ error stop procedure // ' read_bitset_string failed to ' // &
+ 'interpret "s33b" // bitstring_all value properly.'
+ else if ( .not. set4 % any() ) then
+ error stop procedure // ' read_bitset_string failed to // ' // &
+ 'interpret "s33b" bitstring_all value properly.'
+ else if ( .not. set4 % all() ) then
+ error stop procedure // ' read_bitset_string failed to // ' // &
+ 'interpret "s33b" bitstring_all value properly.'
+ else
+ write(*,*) 'read_bitset_string transferred "s33b" // ' // &
+ 'bitstring_all properly into set4.'
+ end if
+
+ call set0 % to_string( string0 )
+ if ( bitstring_0 /= string0 ) then
+ error stop procedure // ' to_string failed to convert set0 ' // &
+ 'value properly.'
+ else
+ write(*,*) 'to_string properly converted the set0 value'
+ end if
+
+ call set1 % to_string( string0 )
+ if ( bitstring_all /= string0 ) then
+ error stop procedure // ' to_string failed to convert set1 ' // &
+ 'value properly.'
+ else
+ write(*,*) 'to_string properly converted the set1 value'
+ end if
+
+ call set0 % write_bitset( string0 )
+ if ( ('S33B' // bitstring_0) /= string0 ) then
+ error stop procedure // ' write_bitset_string failed to ' // &
+ 'convert set0 value properly.'
+ else
+ write(*,*) 'write_bitset_string properly converted the set0 value'
+ end if
+
+ call set1 % write_bitset( string0 )
+ if ( ('S33B' // bitstring_all) /= string0 ) then
+ error stop procedure // ' write_bitset_string failed to ' // &
+ 'convert set1 value properly.'
+ else
+ write(*,*) 'write_bitset_string properly converted the set1 value'
+ end if
+
+ return
+ end subroutine test_string_operations
+
+ subroutine test_io()
+ character(*), parameter:: procedure = 'TEST_IO'
+
+ integer :: unit
+
+ write(*,*)
+ write(*,*) 'Test bitset I/O: input, read_bitset, output, and ' // &
+ 'write_bitset'
+
+ call set2 % from_string( bitstring_33 )
+ open( newunit=unit, file='test.txt', status='replace', &
+ form='formatted', action='write' )
+ call set2 % write_bitset(unit)
+ call set1 % write_bitset(unit)
+ call set0 % write_bitset(unit)
+ close( unit )
+ open( newunit=unit, file='test.txt', status='old', &
+ form='formatted', action='read' )
+ call set3 % read_bitset(unit)
+ call set5 % read_bitset(unit)
+ call set4 % read_bitset(unit)
+
+ if ( set4 /= set0 .or. set5 /= set1 .or. set3 /= set2 ) then
+ error stop procedure // ' transfer to and from units using ' // &
+ 'bitset literals failed.'
+ else
+ write(*,*) 'Transfer to and from units using ' // &
+ 'plain write_bitset_unit and read_bitset_unit succeeded.'
+ end if
+
+ close( unit )
+
+ open( newunit=unit, file='test.txt', status='replace', &
+ form='formatted', action='write' )
+ call set2 % write_bitset(unit, advance='no')
+ call set1 % write_bitset(unit, advance='no')
+ call set0 % write_bitset(unit)
+ close( unit )
+ open( newunit=unit, file='test.txt', status='old', &
+ form='formatted', action='read' )
+ call set3 % read_bitset(unit, advance='no')
+ call set4 % read_bitset(unit, advance='no')
+ call set5 % read_bitset(unit)
+
+ if ( set5 /= set0 .or. set4 /= set1 .or. set3 /= set2 ) then
+ error stop procedure // ' transfer to and from units using ' // &
+ ' bitset literals with advance == "no" failed.'
+ else
+ write(*,*) 'Transfer to and from units using ' // &
+ 'write_bitset_unit and read_bitset_unit with ' // &
+ 'advance=="no" succeeded.'
+ end if
+
+ open( newunit=unit, file='test.bin', status='replace', &
+ form='unformatted', action='write' )
+ call set2 % output(unit)
+ call set1 % output(unit)
+ call set0 % output(unit)
+ close( unit )
+ open( newunit=unit, file='test.bin', status='old', &
+ form='unformatted', action='read' )
+ call set5 % input(unit)
+ call set4 % input(unit)
+ call set3 % input(unit)
+ close( unit )
+
+ if ( set3 /= set0 .or. set4 /= set1 .or. set5 /= set2 ) then
+ error stop procedure // ' transfer to and from units using ' // &
+ ' output and input failed.'
+ else
+ write(*,*) 'Transfer to and from units using ' // &
+ 'output and input succeeded.'
+ end if
+
+ open( newunit=unit, file='test.bin', status='replace', &
+ form='unformatted', access='stream', action='write' )
+ call set2 % output(unit)
+ call set1 % output(unit)
+ call set0 % output(unit)
+ close( unit )
+ open( newunit=unit, file='test.bin', status='old', &
+ form='unformatted', access='stream', action='read' )
+ call set5 % input(unit)
+ call set4 % input(unit)
+ call set3 % input(unit)
+ close( unit )
+
+ if ( set3 /= set0 .or. set4 /= set1 .or. set5 /= set2 ) then
+ error stop procedure // ' transfer to and from units using ' // &
+ ' stream output and input failed.'
+ else
+ write(*,*) 'Transfer to and from units using ' // &
+ 'stream output and input succeeded.'
+ end if
+
+ end subroutine test_io
+
+ subroutine test_initialization()
+ character(*), parameter:: procedure = 'TEST_INITIALIZATION'
+ logical(int8) :: log1(64) = .true.
+ logical(int16) :: log2(31) = .false.
+ logical(int32) :: log3(15) = .true.
+ logical(int64) :: log4(33) = .false.
+ logical(int8), allocatable :: log5(:)
+ logical(int16), allocatable :: log6(:)
+ logical(int32), allocatable :: log7(:)
+ logical(int64), allocatable :: log8(:)
+
+ write(*,*)
+ write(*,*) 'Test initialization: assignment, extract, and init'
+
+ set5 = log1
+ if ( set5 % bits() /= 64 ) then
+ error stop procedure // &
+ ' initialization with logical(int8) failed to set' // &
+ ' the right size.'
+ else if ( .not. set5 % all() ) then
+ error stop procedure // ' initialization with' // &
+ ' logical(int8) failed to set the right values.'
+ else
+ write(*,*) 'Initialization with logical(int8) succeeded.'
+ end if
+
+ set5 = log2
+ if ( set5 % bits() /= 31 ) then
+ error stop procedure // &
+ ' initialization with logical(int16) failed to set' // &
+ ' the right size.'
+ else if ( .not. set5 % none() ) then
+ error stop procedure // &
+ ' initialization with logical(int16) failed to set' // &
+ ' the right values.'
+ else
+ write(*,*) 'Initialization with logical(int16) succeeded.'
+ end if
+
+ set5 = log3
+ if ( set5 % bits() /= 15 ) then
+ error stop procedure // &
+ ' initialization with logical(int32) failed to set' // &
+ ' the right size.'
+ else if ( .not. set5 % all() ) then
+ error stop procedure // &
+ ' initialization with logical(int32) failed to set' // &
+ ' the right values.'
+ else
+ write(*,*) 'Initialization with logical(int32) succeeded.'
+ end if
+
+ set5 = log4
+ if ( set5 % bits() /= 33 ) then
+ error stop procedure // &
+ ' initialization with logical(int64) failed to set' // &
+ ' the right size.'
+ else if ( .not. set5 % none() ) then
+ error stop procedure // &
+ ' initialization with logical(int64) failed to set' // &
+ ' the right values.'
+ else
+ write(*,*) 'Initialization with logical(int64) succeeded.'
+ end if
+
+ set5 = log1
+ call extract( set4, set5, 1_bits_kind, 33_bits_kind )
+ if ( set4 % bits() /= 33 ) then
+ error stop procedure // &
+ ' initialization with extract failed to set' // &
+ ' the right size.'
+ else if ( .not. set4 % all() ) then
+ error stop procedure // &
+ ' initialization with extract failed to set' // &
+ ' the right values.'
+ else
+ write(*,*) 'Initialization with extract succeeded.'
+ end if
+
+ set4 = set5
+ if ( set4 % bits() /= 64 ) then
+ write(*,*) 'Bits = ', set4 % bits()
+ error stop procedure // &
+ ' initialization with simple assignment failed to set' // &
+ ' the right size.'
+ else if ( .not. set4 % all() ) then
+ error stop procedure // &
+ ' initialization with simple assignment failed to set' // &
+ ' the right values.'
+ else
+ write(*,*) 'Initialization with simple assignment succeeded.'
+ end if
+
+ log5 = set5
+ if ( size(log5) /= 64 ) then
+ error stop procedure // &
+ ' initialization of logical(int8) with assignment failed' // &
+ ' to set the right size.'
+ else if ( .not. all(log5) ) then
+ error stop procedure // &
+ ' initialization of logical(int8) with assignment failed' // &
+ ' to set the right values.'
+ else
+ write(*,*) 'Initialization of logical(int8) succeeded.'
+ end if
+
+ log6 = set5
+ if ( size(log6) /= 64 ) then
+ error stop procedure // &
+ ' initialization of logical(int16) with assignment failed' // &
+ ' to set the right size.'
+ else if ( .not. all(log6) ) then
+ error stop procedure // &
+ ' initialization of logical(int16) with assignment failed' // &
+ ' to set the right values.'
+ else
+ write(*,*) 'Initialization of logical(int16) succeeded.'
+ end if
+
+ log7 = set5
+ if ( size(log7) /= 64 ) then
+ error stop procedure // &
+ ' initialization of logical(int32) with assignment failed' // &
+ ' to set the right size.'
+ else if ( .not. all(log7) ) then
+ error stop procedure // &
+ ' initialization of logical(int32) with assignment failed' // &
+ ' to set the right values.'
+ else
+ write(*,*) 'Initialization of logical(int32) succeeded.'
+ end if
+
+ log8 = set5
+ if ( size(log8) /= 64 ) then
+ error stop procedure // &
+ ' initialization of logical(int64) with assignment failed' // &
+ ' to set the right size.'
+ else if ( .not. all(log8) ) then
+ error stop procedure // &
+ ' initialization of logical(int64) with assignment failed' // &
+ ' to set the right values.'
+ else
+ write(*,*) 'Initialization of logical(int64) succeeded.'
+ end if
+
+ end subroutine test_initialization
+
+ subroutine test_bitset_inquiry()
+ character(*), parameter:: procedure = 'TEST_BITSET_INQUIRY'
+ integer(bits_kind) :: i
+
+ write(*,*)
+ write(*,*) 'Test bitset inquiry: all, any, bits, none, test, and value'
+
+ if ( set0 % none() ) then
+ if ( .not. set0 % any() ) then
+ write(*,*) 'As expected set0 has no bits set'
+ else
+ error stop procedure // ' set0 had some bits set which ' // &
+ 'was unexpected.'
+ end if
+ else
+ error stop procedure // ' set0 did not have none set which ' // &
+ 'was unexpected'
+ end if
+
+ call set0 % not()
+ if ( set0 % all() ) then
+ if ( set0 % any() ) then
+ write(*,*) 'As expected set0 now has all bits set'
+ else
+ error stop procedure // ' set0 had no bits set which ' // &
+ 'was unexpected.'
+ end if
+ else
+ error stop procedure // ' set0 did not have all bits set ' // &
+ 'which was unexpected'
+ end if
+
+ if ( set1 % any() ) then
+ if ( set1 % all() ) then
+ write(*,*) 'As expected set1 has all bits set'
+ else
+ error stop procedure // ' set1 did not have all bits set ' // &
+ 'which was unexpected.'
+ end if
+ else
+ error stop procedure // ' set1 had no bits set ' // &
+ 'which was unexpected'
+ end if
+
+ call set0 % not()
+ do i=0, set0 % bits() - 1
+ if ( set0 % test(i) ) then
+ error stop procedure // ' against expectations set0 has ' // &
+ 'at least 1 bit set.'
+ end if
+ end do
+
+ write(*,*) 'As expected set0 had no bits set.'
+
+ do i=0, set1 % bits() - 1
+ if ( .not. set1 % test(i) ) then
+ error stop procedure // ' against expectations set1 has ' // &
+ 'at least 1 bit unset.'
+ end if
+ end do
+
+ write(*,*) 'As expected set1 had all bits set.'
+
+ do i=0, set0 % bits() - 1
+ if ( set0 % value(i) /= 0 ) then
+ error stop procedure // ' against expectations set0 has ' // &
+ 'at least 1 bit set.'
+ end if
+ end do
+
+ write(*,*) 'As expected set0 had no bits set.'
+
+ do i=0, set1 % bits() - 1
+ if ( set1 % value(i) /= 1 ) then
+ error stop procedure // ' against expectations set1 has ' // &
+ 'at least 1 bit unset.'
+ end if
+ end do
+
+ write(*,*) 'As expected set1 had all bits set.'
+
+ if ( set0 % bits() == 33 ) then
+ write(*,*) 'set0 has 33 bits as expected.'
+ else
+ error stop procedure // 'set0 unexpectedly does not have 33 bits.'
+ end if
+
+ end subroutine test_bitset_inquiry
+
+ subroutine test_bit_operations()
+ character(*), parameter:: procedure = 'TEST_BIT_OPERATIONS'
+
+ write(*,*)
+ write(*,*) 'Test bit operations: clear, flip, not, and set'
+
+ if ( .not. set1 % all() ) then
+ error stop procedure // ' set1 is not all set.'
+ end if
+
+ call set1 % clear(0_bits_kind)
+ if ( .not. set1 % test(0_bits_kind) ) then
+ if ( set1 % test(1_bits_kind) ) then
+ write(*,*) 'Cleared one bit in set1 as expected.'
+ else
+ error stop procedure // ' cleared more than one bit in set1.'
+ end if
+ else
+ error stop procedure // ' did not clear the first bit in set1.'
+ end if
+
+ call set1 % clear(1_bits_kind, 32_bits_kind)
+ if ( set1 % none() ) then
+ write(*,*) 'Cleared remaining bits in set1 as expected.'
+ else
+ error stop procedure // ' did not clear remaining bits ' // &
+ 'in set1.'
+ end if
+
+ call set1 % flip(0_bits_kind)
+ if ( set1 % test(0_bits_kind) ) then
+ if ( .not. set1 % test(1_bits_kind) ) then
+ write(*,*) 'Flipped one bit in set1 as expected.'
+ else
+ error stop procedure // ' flipped more than one bit in set1.'
+ end if
+ else
+ error stop procedure // ' did not flip the first bit in set1.'
+ end if
+
+ call set1 % flip(1_bits_kind, 32_bits_kind)
+ if ( set1 % all() ) then
+ write(*,*) 'Flipped remaining bits in set1 as expected.'
+ else
+ error stop procedure // ' did not flip remaining bits ' // &
+ 'in set1.'
+ end if
+
+ call set1 % not()
+ if ( set1 % none() ) then
+ write(*,*) 'Unset bits in set1 as expected.'
+ else
+ error stop procedure // ' did not unset bits in set1.'
+ end if
+
+ call set1 % set(0_bits_kind)
+ if ( set1 % test(0_bits_kind) ) then
+ if ( .not. set1 % test(1_bits_kind) ) then
+ write(*,*) 'Set first bit in set1 as expected.'
+ else
+ error stop procedure // ' set more than one bit in set1.'
+ end if
+ else
+ error stop procedure // ' did not set the first bit in set1.'
+ end if
+
+ call set1 % set(1_bits_kind, 32_bits_kind)
+ if ( set1 % all() ) then
+ write(*,*) 'Set the remaining bits in set1 as expected.'
+ else
+ error stop procedure // ' did not set the remaining bits ' // &
+ 'in set1.'
+ end if
+
+ end subroutine test_bit_operations
+
+ subroutine test_bitset_comparisons()
+ character(*), parameter:: procedure = 'TEST_BITSET_COMPARISON'
+
+ write(*,*)
+ write(*,*) 'Test bitset comparisons: ==, /=, <, <=, >, and >='
+
+ if ( set0 == set0 .and. set1 == set1 .and. set2 == set2 .and. &
+ .not. set0 == set1 .and. .not. set0 == set2 .and. .not. &
+ set1 == set2 ) then
+ write(*,*) 'Passed 64 bit equality tests.'
+ else
+ error stop procedure // ' failed 64 bit equality tests.'
+ end if
+
+ if ( set0 /= set1 .and. set1 /= set2 .and. set0 /= set2 .and. &
+ .not. set0 /= set0 .and. .not. set1 /= set1 .and. .not. &
+ set2 /= set2 ) then
+ write(*,*) 'Passed 64 bit inequality tests.'
+ else
+ error stop procedure // ' failed 64 bit inequality tests.'
+ end if
+
+ if ( set1 > set0 .and. set2 > set0 .and. set1 > set2 .and. &
+ .not. set0 > set1 .and. .not. set1 > set1 .and. .not. &
+ set2 > set1 ) then
+ write(*,*) 'Passed 64 bit greater than tests.'
+ else
+ error stop procedure // ' failed 64 bit greater than tests.'
+ end if
+
+ if ( set1 >= set0 .and. set1 >= set2 .and. set2 >= set2 .and. &
+ .not. set0 >= set1 .and. .not. set0 >= set1 .and. .not. &
+ set2 >= set1 ) then
+ write(*,*) 'Passed 64 bit greater than or equal tests.'
+ else
+ error stop procedure // ' failed 64 bit greater than or ' // &
+ 'equal tests.'
+ end if
+
+ if ( set0 < set1 .and. set0 < set1 .and. set2 < set1 .and. &
+ .not. set1 < set0 .and. .not. set0 < set0 .and. .not. &
+ set1 < set2 ) then
+ write(*,*) 'Passed 64 bit less than tests.'
+ else
+ error stop procedure // ' failed 64 bit less than tests.'
+ end if
+
+ if ( set0 <= set1 .and. set2 <= set1 .and. set2 <= set2 .and. &
+ .not. set1 <= set0 .and. .not. set2 <= set0 .and. .not. &
+ set1 <= set2 ) then
+ write(*,*) 'Passed 64 bit less than or equal tests.'
+ else
+ error stop procedure // ' failed 64 bit less than or ' // &
+ 'equal tests.'
+ end if
+
+ end subroutine test_bitset_comparisons
+
+ subroutine test_bitset_operations()
+ character(*), parameter:: procedure = 'TEST_BITSET_OPERATIONS'
+
+ write(*,*)
+ write(*,*) 'Test bitset operations: and, and_not, or, and xor'
+
+ call set0 % from_string( bitstring_all )
+ call set4 % from_string( bitstring_all )
+ call and( set0, set4 ) ! all all
+ if ( set0 % all() ) then
+ write(*,*) 'First test of AND worked.'
+ else
+ error stop procedure // ' first test of AND failed.'
+ end if
+
+ call set4 % from_string( bitstring_0 )
+ call set3 % from_string( bitstring_all )
+ call and( set3, set4 ) ! all none
+ if ( set3 % none() ) then
+ write(*,*) 'Second test of AND worked.'
+ else
+ error stop procedure // ' second test of AND failed.'
+ end if
+
+ call set3 % from_string( bitstring_all )
+ call set4 % from_string( bitstring_0 )
+ call and( set4, set3 ) ! none all
+ if ( set4 % none() ) then
+ write(*,*) 'Third test of AND worked.'
+ else
+ error stop procedure // ' third test of AND failed.'
+ end if
+
+ call set3 % from_string( bitstring_0 )
+ call and( set4, set3 ) ! none none
+ if ( set4 % none() ) then
+ write(*,*) 'Fourth test of AND worked.'
+ else
+ error stop procedure // ' fourth test of AND failed.'
+ end if
+
+ call set3 % from_string( bitstring_all )
+ call set4 % from_string( bitstring_all )
+ call and_not( set4, set3 ) ! all all
+ if ( set4 % none() ) then
+ write(*,*) 'First test of AND_NOT worked.'
+ else
+ error stop procedure // ' first test of AND_NOT failed.'
+ end if
+
+ call set4 % from_string( bitstring_0 )
+ call and_not( set4, set3 ) ! none all
+ if ( set4 % none() ) then
+ write(*,*) 'Second test of AND_NOT worked.'
+ else
+ error stop procedure // ' second test of AND_NOT failed.'
+ end if
+
+ call set3 % from_string( bitstring_all )
+ call set4 % from_string( bitstring_0 )
+ call and_not( set3, set4 ) ! all none
+ if ( set3 % all() ) then
+ write(*,*) 'Third test of AND_NOT worked.'
+ else
+ error stop procedure // ' third test of AND_NOT failed.'
+ end if
+
+ call set3 % from_string( bitstring_0 )
+ call set4 % from_string( bitstring_0 )
+ call and_not( set3, set4 ) ! none none
+ if ( set3 % none() ) then
+ write(*,*) 'Fourth test of AND_NOT worked.'
+ else
+ error stop procedure // ' fourth test of AND_NOT failed.'
+ end if
+
+ call set3 % from_string( bitstring_all )
+ call set4 % from_string( bitstring_all )
+ call or( set3, set4 ) ! all all
+ if ( set3 % all() ) then
+ write(*,*) 'First test of OR worked.'
+ else
+ error stop procedure // ' first test of OR failed.'
+ end if
+
+ call set3 % from_string( bitstring_0 )
+ call or( set4, set3 ) ! all none
+ if ( set4 % all() ) then
+ write(*,*) 'Second test of OR worked.'
+ else
+ error stop procedure // ' second test of OR failed.'
+ end if
+
+ call or( set3, set4 ) ! none all
+ if ( set3 % all() ) then
+ write(*,*) 'Third test of OR worked.'
+ else
+ error stop procedure // ' third test of OR failed.'
+ end if
+
+ call set3 % from_string( bitstring_0 )
+ call set4 % from_string( bitstring_0 )
+ call or( set4, set3 ) !none none
+ if ( set4 % none() ) then
+ write(*,*) 'Fourth test of OR worked.'
+ else
+ error stop procedure // ' fourth test of OR failed.'
+ end if
+
+ call set3 % from_string( bitstring_0 )
+ call set4 % from_string( bitstring_0 )
+ call xor( set3, set4 ) ! none none
+ if ( set3 % none() ) then
+ write(*,*) 'First test of XOR worked.'
+ else
+ error stop procedure // ' first test of XOR failed.'
+ end if
+
+ call set4 % from_string( bitstring_all )
+ call xor( set3, set4 ) ! none all
+ if ( set3 % all() ) then
+ write(*,*) 'Second test of XOR worked.'
+ else
+ error stop procedure // ' second test of XOR failed.'
+ end if
+
+ call set4 % from_string( bitstring_0 )
+ call xor( set3, set4 ) ! all none
+ if ( set3 % all() ) then
+ write(*,*) 'Third test of XOR worked.'
+ else
+ error stop procedure // ' third test of XOR failed.'
+ end if
+
+ call set4 % from_string( bitstring_all )
+ call xor( set3, set4 ) ! all all
+ if ( set3 % none() ) then
+ write(*,*) 'Fourth test of XOR worked.'
+ else
+ error stop procedure // ' fourth test of XOR failed.'
+ end if
+
+ end subroutine test_bitset_operations
+
+
+end program test_stdlib_bitset_64
diff --git a/src/tests/bitsets/test_stdlib_bitset_large.f90 b/src/tests/bitsets/test_stdlib_bitset_large.f90
new file mode 100644
index 000000000..96d83d036
--- /dev/null
+++ b/src/tests/bitsets/test_stdlib_bitset_large.f90
@@ -0,0 +1,1488 @@
+program test_stdlib_bitset_large
+ use :: stdlib_kinds, only : int8, int16, int32, int64
+ use stdlib_bitsets
+ implicit none
+ character(*), parameter :: &
+ bitstring_0 = '000000000000000000000000000000000', &
+ bitstring_33 = '100000000000000000000000000000000', &
+ bitstring_all = '111111111111111111111111111111111'
+ type(bitset_large) :: set0, set1, set2, set3, set4, set5
+ type(bitset_large) :: set10, set11, set12, set13, set14, set15
+ integer :: status
+ character(:), allocatable :: string0
+
+ call test_string_operations()
+
+ call test_io()
+
+ call test_initialization()
+
+ call test_bitset_inquiry()
+
+ call test_bit_operations()
+
+ call test_bitset_comparisons()
+
+ call test_bitset_operations()
+
+contains
+
+ subroutine test_string_operations()
+ character(*), parameter:: procedure = 'TEST_STRING_OPERATIONS'
+
+ write(*,'(/a)') 'Test string operations: from_string, ' // &
+ 'read_bitset, to_string, and write_bitset'
+
+ call set0 % from_string( bitstring_0 )
+ if ( bits(set0) /= 33 ) then
+ error stop procedure // ' from_string failed to interpret ' // &
+ 'bitstring_0 size properly.'
+ else if ( .not. set0 % none() ) then
+ error stop procedure // ' failed to interpret bitstring_0 ' // &
+ 'value properly.'
+ else if ( set0 % any() ) then
+ error stop procedure // ' failed to interpret bitstring_0 ' // &
+ 'value properly.'
+ else
+ write(*,*) 'from_string transferred bitstring_0 properly into set0'
+ end if
+
+ call set10 % from_string( bitstring_0 // bitstring_0 )
+ if ( bits(set10) /= 66 ) then
+ error stop procedure // ' from_string failed to interpret ' // &
+ 'bitstring_0 // bitstring_0 size properly.'
+ else if ( .not. set10 % none() ) then
+ error stop procedure // ' failed to interpret bitstring_0 ' // &
+ '// bitstring_0 value properly.'
+ else if ( set10 % any() ) then
+ error stop procedure // ' failed to interpret bitstring_0 ' // &
+ '// bitstring_0 value properly.'
+ else
+ write(*,*) 'from_string transferred bitstring_0//bitstring_0' // &
+ ' properly into set10'
+ end if
+
+ call set1 % from_string( bitstring_all )
+ if ( bits(set1) /= 33 ) then
+ error stop procedure // ' from_string failed to interpret ' // &
+ 'bitstring_all size properly.'
+ else if ( set1 % none() ) then
+ error stop procedure // ' failed to interpret bitstring_all ' // &
+ 'value properly.'
+ else if ( .not. set1 % any() ) then
+ error stop procedure // ' failed to interpret bitstring_all ' // &
+ 'value properly.'
+ else if ( .not. set1 % all() ) then
+ error stop procedure // ' failed to interpret bitstring_all ' // &
+ 'value properly.'
+ else
+ write(*,*) 'from_string transferred bitstring_1 properly into set1'
+ end if
+
+ call set11 % from_string( bitstring_all // bitstring_all )
+ if ( bits(set11) /= 66 ) then
+ error stop procedure // ' from_string failed to interpret ' // &
+ 'bitstring_all // bitstring_all size properly.'
+ else if ( set11 % none() ) then
+ error stop procedure // ' failed to interpret bitstring_all ' // &
+ '// bitstring_all value properly.'
+ else if ( .not. set11 % any() ) then
+ error stop procedure // ' failed to interpret bitstring_all ' // &
+ '// bitstring_all value properly.'
+ else if ( .not. set11 % all() ) then
+ error stop procedure // ' failed to interpret bitstring_all ' // &
+ '// bitstring_all value properly.'
+ else
+ write(*,*) 'from_string transferred bitstring_all // ' // &
+ 'bitstring_all properly into set11'
+ end if
+
+ call set3 % read_bitset( bitstring_0, status )
+ if ( status /= success ) then
+ write(*,*) 'read_bitset_string failed with bitstring_0 as expected.'
+ else
+ error stop procedure // ' read_bitset_string did not fail ' // &
+ 'with bitstring_0 as expected.'
+ end if
+
+ call set13 % read_bitset( bitstring_0 // bitstring_0, status )
+ if ( status /= success ) then
+ write(*,*) 'read_bitset_string failed with bitstring_0 ' // &
+ '// bitstring_0 as expected.'
+ end if
+
+ call set3 % read_bitset( 's33b' // bitstring_0, status )
+ if ( bits(set3) /= 33 ) then
+ error stop procedure // ' read_bitset_string failed to ' // &
+ 'interpret "s33b" // bitstring_0 size properly.'
+ else if ( .not. set3 % none() ) then
+ error stop procedure // ' failed to interpret "s33b" // ' // &
+ 'bitstring_0 value properly.'
+ else
+ write(*,*) 'read_bitset_string transferred "s33b" // ' // &
+ 'bitstring_0 properly into set3'
+ end if
+
+ call set13 % read_bitset( 's66b' // bitstring_0 // bitstring_0, &
+ status )
+ if ( bits(set13) /= 66 ) then
+ error stop procedure // ' read_bitset_string failed to ' // &
+ 'interpret "s66b" // bitstring_0 // bitstring_0 size properly.'
+ else if ( .not. set13 % none() ) then
+ error stop procedure // ' failed to interpret "s66b" // ' // &
+ 'bitstring_0 // bitstring_0 value properly.'
+ else
+ write(*,*) 'read_bitset_string transferred "s66b" // ' // &
+ 'bitstring_0 // bitstring_0 properly into set13'
+ end if
+
+ call set4 % read_bitset( 's33b' // bitstring_all )
+ if ( bits(set4) /= 33 ) then
+ error stop procedure // ' read_bitset_string failed to ' // &
+ 'interpret "s33b" // bitstring_all size properly.'
+ else if ( set4 % none() ) then
+ error stop procedure // ' read_bitset_string failed to ' // &
+ 'interpret "s33b" // bitstring_all value properly.'
+ else if ( .not. set4 % any() ) then
+ error stop procedure // ' read_bitset_string failed to // ' // &
+ 'interpret "s33b" bitstring_all value properly.'
+ else if ( .not. set4 % all() ) then
+ error stop procedure // ' read_bitset_string failed to // ' // &
+ 'interpret "s33b" bitstring_all value properly.'
+ else
+ write(*,*) 'read_bitset_string transferred "s33b" // ' // &
+ 'bitstring_all properly into set4.'
+ end if
+
+ call set14 % read_bitset( 's66b' // bitstring_all &
+ // bitstring_all )
+ if ( bits(set14) /= 66 ) then
+ error stop procedure // ' read_bitset_string failed to ' // &
+ 'interpret "s66b" // bitstring_all // bitstring_all ' // &
+ 'size properly.'
+ else if ( set14 % none() ) then
+ error stop procedure // ' read_bitset_string failed to ' // &
+ 'interpret "s66b" // bitstring_all // bitstring_all ' // &
+ 'value properly.'
+ else if ( .not. set14 % any() ) then
+ error stop procedure // ' read_bitset_string failed to // ' // &
+ 'interpret "s66b" bitstring_all // bitstring_all ' // &
+ 'value properly.'
+ else if ( .not. set14 % all() ) then
+ error stop procedure // ' read_bitset_string failed to // ' // &
+ 'interpret "s66b" bitstring_all // bitstring_all ' // &
+ 'value properly.'
+ else
+ write(*,*) 'read_bitset_string transferred "s66b" // ' // &
+ 'bitstring_all // bitstring_all properly into set14.'
+ end if
+
+ call set0 % to_string( string0 )
+ if ( bitstring_0 /= string0 ) then
+ error stop procedure // ' to_string failed to convert set0 ' // &
+ 'value properly.'
+ else
+ write(*,*) 'to_string properly converted the set0 value'
+ end if
+
+ call set10 % to_string( string0 )
+ if ( bitstring_0 // bitstring_0 /= string0 ) then
+ error stop procedure // ' to_string failed to convert set10 ' // &
+ 'value properly.'
+ else
+ write(*,*) 'to_string properly converted the set10 value'
+ end if
+
+ call set1 % to_string( string0 )
+ if ( bitstring_all /= string0 ) then
+ error stop procedure // ' to_string failed to convert set1 ' // &
+ 'value properly.'
+ else
+ write(*,*) 'to_string properly converted the set1 value'
+ end if
+
+ call set11 % to_string( string0 )
+ if ( bitstring_all // bitstring_all /= string0 ) then
+ error stop procedure // ' to_string failed to convert set11 ' // &
+ 'value properly.'
+ else
+ write(*,*) 'to_string properly converted the set11 value'
+ end if
+
+ call set0 % write_bitset( string0 )
+ if ( ('S33B' // bitstring_0) /= string0 ) then
+ error stop procedure // ' write_bitset_string failed to ' // &
+ 'convert set2 value properly.'
+ else
+ write(*,*) 'write_bitset_string properly converted the set0 value'
+ end if
+
+ call set10 % write_bitset( string0 )
+ if ( ('S66B' // bitstring_0 // bitstring_0) /= string0 ) then
+ error stop procedure // ' write_bitset_string failed to ' // &
+ 'convert set10 value properly.'
+ else
+ write(*,*) 'write_bitset_string properly converted the set10 value'
+ end if
+
+ call set1 % write_bitset( string0 )
+ if ( ('S33B' // bitstring_all) /= string0 ) then
+ error stop procedure // ' write_bitset_string failed to ' // &
+ 'convert set1 value properly.'
+ else
+ write(*,*) 'write_bitset_string properly converted the set1 value'
+ end if
+
+ call set11 % write_bitset( string0 )
+ if ( ('S66B' // bitstring_all // bitstring_all) /= string0 ) then
+ error stop procedure // ' write_bitset_string failed to ' // &
+ 'convert set11 value properly.'
+ else
+ write(*,*) 'write_bitset_string properly converted the set11 value'
+ end if
+
+ return
+ end subroutine test_string_operations
+
+ subroutine test_io()
+ character(*), parameter:: procedure = 'TEST_IO'
+
+ integer :: unit
+
+ write(*,*)
+ write(*,*) 'Test bitset I/O: input, read_bitset, output, and ' // &
+ 'write_bitset'
+
+ call set2 % from_string( bitstring_33 )
+ open( newunit=unit, file='test.txt', status='replace', &
+ form='formatted', action='write' )
+ call set2 % write_bitset(unit)
+ call set1 % write_bitset(unit)
+ call set0 % write_bitset(unit)
+ close( unit )
+ open( newunit=unit, file='test.txt', status='old', &
+ form='formatted', action='read' )
+ call set3 % read_bitset(unit)
+ call set5 % read_bitset(unit)
+ call set4 % read_bitset(unit)
+ if ( set4 /= set0 .or. set5 /= set1 .or. set3 /= set2 ) then
+ error stop procedure // ' transfer to and from units using ' // &
+ ' bitset literals failed.'
+ else
+ write(*,*) 'Transfer to and from units using ' // &
+ 'plain write_bitset_unit and read_bitset_unit succeeded.'
+ end if
+
+ close( unit )
+
+ call set12 % from_string( bitstring_33 // bitstring_33 )
+ open( newunit=unit, file='test.txt', status='replace', &
+ form='formatted', action='write' )
+ call set12 % write_bitset(unit)
+ call set11 % write_bitset(unit)
+ call set10 % write_bitset(unit)
+ close( unit )
+ open( newunit=unit, file='test.txt', status='old', &
+ form='formatted', action='read' )
+ call set13 % read_bitset(unit)
+ call set15 % read_bitset(unit)
+ call set14 % read_bitset(unit)
+ if ( set14 /= set10 .or. set15 /= set11 .or. set3 /= set12 ) then
+ error stop procedure // ' transfer to and from units using ' // &
+ ' bitset literals for bits > 64 failed.'
+ else
+ write(*,*) 'Transfer bits > 64 to and from units using ' // &
+ 'plain write_bitset_unit and read_bitset_unit succeeded.'
+ end if
+
+ close( unit )
+
+ open( newunit=unit, file='test.txt', status='replace', &
+ form='formatted', action='write' )
+ call set2 % write_bitset(unit, advance='no')
+ call set1 % write_bitset(unit, advance='no')
+ call set0 % write_bitset(unit)
+ close( unit )
+ open( newunit=unit, file='test.txt', status='old', &
+ form='formatted', action='read' )
+ call set3 % read_bitset(unit, advance='no')
+ call set4 % read_bitset(unit, advance='no')
+ call set5 % read_bitset(unit)
+ if ( set5 /= set0 .or. set4 /= set1 .or. set3 /= set2 ) then
+ error stop procedure // ' transfer to and from units using ' // &
+ ' bitset literals with advance == "no" failed.'
+ else
+ write(*,*) 'Transfer to and from units using ' // &
+ 'write_bitset_unit and read_bitset_unit with ' // &
+ 'advance=="no" succeeded.'
+ end if
+
+ close( unit )
+
+ open( newunit=unit, file='test.txt', status='replace', &
+ form='formatted', action='write' )
+ call set12 % write_bitset(unit, advance='no')
+ call set11 % write_bitset(unit, advance='no')
+ call set10 % write_bitset(unit)
+ close( unit )
+ open( newunit=unit, file='test.txt', status='old', &
+ form='formatted', action='read' )
+ call set13 % read_bitset(unit, advance='no')
+ call set14 % read_bitset(unit, advance='no')
+ call set15 % read_bitset(unit)
+ if ( set15 /= set10 .or. set14 /= set11 .or. set13 /= set12 ) then
+ error stop procedure // ' transfer to and from units using ' // &
+ ' bitset literals for bitss > 64 with advance == "no" failed.'
+ else
+ write(*,*) 'Transfer bits > 64 to and from units using ' // &
+ 'write_bitset_unit and read_bitset_unit with ' // &
+ 'advance=="no" succeeded.'
+ end if
+
+ open( newunit=unit, file='test.bin', status='replace', &
+ form='unformatted', action='write' )
+ call set2 % output(unit)
+ call set1 % output(unit)
+ call set0 % output(unit)
+ close( unit )
+ open( newunit=unit, file='test.bin', status='old', &
+ form='unformatted', action='read' )
+ call set5 % input(unit)
+ call set4 % input(unit)
+ call set3 % input(unit)
+ if ( set3 /= set0 .or. set4 /= set1 .or. set5 /= set2 ) then
+ error stop procedure // ' transfer to and from units using ' // &
+ ' output and input failed.'
+ else
+ write(*,*) 'Transfer to and from units using ' // &
+ 'output and input succeeded.'
+ end if
+
+ close( unit )
+
+ open( newunit=unit, file='test.bin', status='replace', &
+ form='unformatted', access='stream', action='write' )
+ call set2 % output(unit)
+ call set1 % output(unit)
+ call set0 % output(unit)
+ close( unit )
+ open( newunit=unit, file='test.bin', status='old', &
+ form='unformatted', access='stream', action='read' )
+ call set5 % input(unit)
+ call set4 % input(unit)
+ call set3 % input(unit)
+ if ( set3 /= set0 .or. set4 /= set1 .or. set5 /= set2 ) then
+ error stop procedure // ' transfer to and from units using ' // &
+ ' stream output and input failed.'
+ else
+ write(*,*) 'Transfer to and from units using ' // &
+ 'stream output and input succeeded.'
+ end if
+
+ close( unit )
+
+ open( newunit=unit, file='test.bin', status='replace', &
+ form='unformatted', action='write' )
+ call set12 % output(unit)
+ call set11 % output(unit)
+ call set10 % output(unit)
+ close( unit )
+ open( newunit=unit, file='test.bin', status='old', &
+ form='unformatted', action='read' )
+ call set15 % input(unit)
+ call set14 % input(unit)
+ call set13 % input(unit)
+ if ( set13 /= set10 .or. set14 /= set11 .or. set15 /= set12 ) then
+ error stop procedure // ' transfer to and from units using ' // &
+ ' output and input failed for bits . 64.'
+ else
+ write(*,*) 'Transfer to and from units using ' // &
+ 'output and input succeeded for bits > 64.'
+ end if
+ close(unit)
+
+ open( newunit=unit, file='test.bin', status='replace', &
+ form='unformatted', access='stream', action='write' )
+ call set12 % output(unit)
+ call set11 % output(unit)
+ call set10 % output(unit)
+ close( unit )
+ open( newunit=unit, file='test.bin', status='old', &
+ form='unformatted', access='stream', action='read' )
+ call set15 % input(unit)
+ call set14 % input(unit)
+ call set13 % input(unit)
+ if ( set13 /= set10 .or. set14 /= set11 .or. set15 /= set12 ) then
+ error stop procedure // ' transfer to and from units using ' // &
+ ' stream output and input failed for bits . 64.'
+ else
+ write(*,*) 'Transfer to and from units using ' // &
+ 'stream output and input succeeded for bits > 64.'
+ end if
+ close(unit)
+
+ end subroutine test_io
+
+ subroutine test_initialization()
+ character(*), parameter:: procedure = 'TEST_INITIALIZATION'
+ logical(int8) :: log1(64) = .true.
+ logical(int16) :: log2(31) = .false.
+ logical(int32) :: log3(15) = .true.
+ logical(int64) :: log4(33) = .false.
+ logical(int8) :: log11(66) = .true.
+ logical(int16) :: log12(99) = .false.
+ logical(int32) :: log13(132) = .true.
+ logical(int64) :: log14(165) = .false.
+ logical(int8), allocatable :: log5(:)
+ logical(int16), allocatable :: log6(:)
+ logical(int32), allocatable :: log7(:)
+ logical(int64), allocatable :: log8(:)
+
+ write(*,*)
+ write(*,*) 'Test initialization: assignment, extract, and init'
+
+ set5 = log1
+ if ( set5 % bits() /= 64 ) then
+ error stop procedure // &
+ ' initialization with logical(int8) failed to set' // &
+ ' the right size.'
+ else if ( .not. set5 % all() ) then
+ error stop procedure // ' initialization with' // &
+ ' logical(int8) failed to set the right values.'
+ else
+ write(*,*) 'Initialization with logical(int8) succeeded.'
+ end if
+
+ set5 = log11
+ if ( set5 % bits() /= 66 ) then
+ error stop procedure // &
+ ' initialization with logical(int8) failed to set' // &
+ ' the right size > 64 bits.'
+ else if ( .not. set5 % all() ) then
+ error stop procedure // ' initialization with' // &
+ ' logical(int8) failed to set the right values.'
+ else
+ write(*,*) 'Initialization > 64 bits with logical(int8)succeeded.'
+ end if
+
+ set5 = log2
+ if ( set5 % bits() /= 31 ) then
+ error stop procedure // &
+ ' initialization with logical(int16) failed to set' // &
+ ' the right size.'
+ else if ( .not. set5 % none() ) then
+ error stop procedure // &
+ ' initialization with logical(int16) failed to set' // &
+ ' the right values.'
+ else
+ write(*,*) 'Initialization with logical(int16) succeeded.'
+ end if
+
+ set5 = log12
+ if ( set5 % bits() /= 99 ) then
+ error stop procedure // &
+ ' initialization with logical(int16) failed to set' // &
+ ' the right size > 64 bits .'
+ else if ( .not. set5 % none() ) then
+ error stop procedure // &
+ ' initialization with logical(int16) failed to set' // &
+ ' the right values > 64 bits .'
+ else
+ write(*,*) 'Initialization > 64 bits with logical(int16) ' // &
+ 'succeeded.'
+ end if
+
+ set5 = log3
+ if ( set5 % bits() /= 15 ) then
+ error stop procedure // &
+ ' initialization with logical(int32) failed to set' // &
+ ' the right size.'
+ else if ( .not. set5 % all() ) then
+ error stop procedure // &
+ ' initialization with logical(int32) failed to set' // &
+ ' the right values.'
+ else
+ write(*,*) 'Initialization with logical(int32) succeeded.'
+ end if
+
+ set5 = log13
+ if ( set5 % bits() /= 132 ) then
+ error stop procedure // &
+ ' initialization with logical(int32) failed to set' // &
+ ' the right size > 64 bits .'
+ else if ( .not. set5 % all() ) then
+ error stop procedure // &
+ ' initialization with logical(int32) failed to set' // &
+ ' the right values > 64 bits .'
+ else
+ write(*,*) 'Initialization > 64 bits with logical(int32) ' // &
+ 'succeeded.'
+ end if
+
+ set5 = log4
+ if ( set5 % bits() /= 33 ) then
+ error stop procedure // &
+ ' initialization with logical(int64) failed to set' // &
+ ' the right size.'
+ else if ( .not. set5 % none() ) then
+ error stop procedure // &
+ ' initialization with logical(int64) failed to set' // &
+ ' the right values.'
+ else
+ write(*,*) 'Initialization with logical(int64) succeeded.'
+ end if
+
+ set5 = log14
+ if ( set5 % bits() /= 165 ) then
+ error stop procedure // &
+ ' initialization with logical(int64) failed to set' // &
+ ' the right size > 64 bits .'
+ else if ( .not. set5 % none() ) then
+ error stop procedure // &
+ ' initialization with logical(int64) failed to set' // &
+ ' the right values > 64 bits .'
+ else
+ write(*,*) 'Initialization > 64 bits with logical(int64) ' // &
+ 'succeeded.'
+ end if
+
+ set5 = log1
+ call extract( set4, set5, 1_bits_kind, 33_bits_kind )
+ if ( set4 % bits() /= 33 ) then
+ error stop procedure // &
+ ' initialization with extract failed to set' // &
+ ' the right size.'
+ else if ( .not. set4 % all() ) then
+ error stop procedure // &
+ ' initialization with extract failed to set' // &
+ ' the right values.'
+ else
+ write(*,*) 'Initialization with extract succeeded.'
+ end if
+
+ set5 = log11
+ call extract( set4, set5, 1_bits_kind, 65_bits_kind )
+ if ( set4 % bits() /= 65 ) then
+ error stop procedure // &
+ ' initialization with extract failed to set' // &
+ ' the right size > 64 bits.'
+ else if ( .not. set4 % all() ) then
+ error stop procedure // &
+ ' initialization with extract failed to set' // &
+ ' the right values > 64 bits.'
+ else
+ write(*,*) 'Initialization with extract succeeded.'
+ end if
+
+ set5 = log1
+ set4 = set5
+ if ( set4 % bits() /= 64 ) then
+ write(*,*) 'Bits = ', set4 % bits()
+ error stop procedure // &
+ ' initialization with simple assignment failed to set' // &
+ ' the right size.'
+ else if ( .not. set4 % all() ) then
+ error stop procedure // &
+ ' initialization with simple assignment failed to set' // &
+ ' the right values.'
+ else
+ write(*,*) 'Initialization with simple assignment succeeded.'
+ end if
+
+ set5 = log11
+ set4 = set5
+ if ( set4 % bits() /= 66 ) then
+ write(*,*) 'Bits = ', set4 % bits()
+ error stop procedure // &
+ ' initialization with simple assignment failed to set' // &
+ ' the right size > 64 bits.'
+ else if ( .not. set4 % all() ) then
+ error stop procedure // &
+ ' initialization with simple assignment failed to set' // &
+ ' the right values > 64 bits.'
+ else
+ write(*,*) 'Initialization > 64 bits with simple assignment ' // &
+ 'succeeded.'
+ end if
+
+ set5 = log1
+ log5 = set5
+ if ( size(log5) /= 64 ) then
+ error stop procedure // &
+ ' initialization of logical(int8) with assignment failed' // &
+ ' to set the right size.'
+ else if ( .not. all(log5) ) then
+ error stop procedure // &
+ ' initialization of logical(int8) with assignment failed' // &
+ ' to set the right values.'
+ else
+ write(*,*) 'Initialization of logical(int8) succeeded.'
+ end if
+
+ set5 = log11
+ log5 = set5
+ if ( size(log5) /= 66 ) then
+ error stop procedure // &
+ ' initialization of logical(int8) with assignment failed' // &
+ ' to set the right size > 64 bits.'
+ else if ( .not. all(log5) ) then
+ error stop procedure // &
+ ' initialization of logical(int8) with assignment failed' // &
+ ' to set the right values > 64 bits.'
+ else
+ write(*,*) 'Initialization > 64 bits of logical(int8) succeeded.'
+ end if
+
+ set5 = log1
+ log6 = set5
+ if ( size(log6) /= 64 ) then
+ error stop procedure // &
+ ' initialization of logical(int16) with assignment failed' // &
+ ' to set the right size.'
+ else if ( .not. all(log6) ) then
+ error stop procedure // &
+ ' initialization of logical(int16) with assignment failed' // &
+ ' to set the right values.'
+ else
+ write(*,*) 'Initialization of logical(int16) succeeded.'
+ end if
+
+ set5 = log11
+ log6 = set5
+ if ( size(log6) /= 66 ) then
+ error stop procedure // &
+ ' initialization of logical(int16) with assignment failed' // &
+ ' to set the right size > 64 bits.'
+ else if ( .not. all(log6) ) then
+ error stop procedure // &
+ ' initialization of logical(int16) with assignment failed' // &
+ ' to set the right values > 64 bits.'
+ else
+ write(*,*) 'Initialization > 64 bits of logical(int16) succeeded.'
+ end if
+
+ set5 = log1
+ log7 = set5
+ if ( size(log7) /= 64 ) then
+ error stop procedure // &
+ ' initialization of logical(int32) with assignment failed' // &
+ ' to set the right size.'
+ else if ( .not. all(log7) ) then
+ error stop procedure // &
+ ' initialization of logical(int32) with assignment failed' // &
+ ' to set the right values.'
+ else
+ write(*,*) 'Initialization of logical(int32) succeeded.'
+ end if
+
+ set5 = log11
+ log7 = set5
+ if ( size(log7) /= 66 ) then
+ error stop procedure // &
+ ' initialization of logical(int32) with assignment failed' // &
+ ' to set the right size > 64 bits.'
+ else if ( .not. all(log7) ) then
+ error stop procedure // &
+ ' initialization of logical(int32) with assignment failed' // &
+ ' to set the right values > 64 bits.'
+ else
+ write(*,*) 'Initialization > 64 bits of logical(int32) succeeded.'
+ end if
+
+ set5 = log1
+ log8 = set5
+ if ( size(log8) /= 64 ) then
+ error stop procedure // &
+ ' initialization of logical(int64) with assignment failed' // &
+ ' to set the right size.'
+ else if ( .not. all(log8) ) then
+ error stop procedure // &
+ ' initialization of logical(int64) with assignment failed' // &
+ ' to set the right values.'
+ else
+ write(*,*) 'Initialization of logical(int64) succeeded.'
+ end if
+
+ set5 = log11
+ log8 = set5
+ if ( size(log8) /= 66 ) then
+ error stop procedure // &
+ ' initialization of logical(int64) with assignment failed' // &
+ ' to set the right size > 64 bits.'
+ else if ( .not. all(log8) ) then
+ error stop procedure // &
+ ' initialization of logical(int64) with assignment failed' // &
+ ' to set the right values > 64 bits.'
+ else
+ write(*,*) 'Initialization > 64 bits of logical(int64) succeeded.'
+ end if
+
+ end subroutine test_initialization
+
+ subroutine test_bitset_inquiry()
+ character(*), parameter:: procedure = 'TEST_BITSET_INQUIRY'
+ integer(bits_kind) :: i
+
+ write(*,*)
+ write(*,*) 'Test bitset inquiry: all, any, bits, none, test, and value'
+
+ if ( set0 % none() ) then
+ if ( .not. set0 % any() ) then
+ write(*,*) 'As expected set0 has no bits set'
+ else
+ error stop procedure // ' set0 had some bits set which ' // &
+ 'was unexpected.'
+ end if
+ else
+ error stop procedure // ' set0 did not have none set which ' // &
+ 'was unexpected'
+ end if
+
+ call set0 % not()
+
+ if ( set0 % all() ) then
+ if ( set0 % any() ) then
+ write(*,*) 'As expected set0 now has all bits set'
+ else
+ error stop procedure // ' set0 had no bits set which ' // &
+ 'was unexpected.'
+ end if
+ else
+ error stop procedure // ' set0 did not have all bits set ' // &
+ 'which was unexpected'
+ end if
+
+ if ( set1 % any() ) then
+ if ( set1 % all() ) then
+ write(*,*) 'As expected set1 has all bits set'
+ else
+ error stop procedure // ' set1 did not have all bits set ' // &
+ 'which was unexpected.'
+ end if
+ else
+ error stop procedure // ' set1 had none bits set ' // &
+ 'which was unexpected'
+ end if
+
+ call set0 % not()
+ do i=0, set0 % bits() - 1
+ if ( set0 % test(i) ) then
+ error stop procedure // ' against expectations set0 has ' // &
+ 'at least 1 bit set.'
+ end if
+ end do
+
+ write(*,*) 'As expected set0 had no bits set.'
+
+ do i=0, set1 % bits() - 1
+ if ( .not. set1 % test(i) ) then
+ error stop procedure // ' against expectations set0 has ' // &
+ 'at least 1 bit unset.'
+ end if
+ end do
+
+ write(*,*) 'As expected set1 had all bits set.'
+
+ do i=0, set0 % bits() - 1
+ if ( set0 % value(i) /= 0 ) then
+ error stop procedure // ' against expectations set0 has ' // &
+ 'at least 1 bit set.'
+ end if
+ end do
+
+ write(*,*) 'As expected set0 had no bits set.'
+
+ do i=0, set1 % bits() - 1
+ if ( set1 % value(i) /= 1 ) then
+ error stop procedure // ' against expectations set0 has ' // &
+ 'at least 1 bit unset.'
+ end if
+ end do
+
+ write(*,*) 'As expected set1 had all bits set.'
+
+ if ( set0 % bits() == 33 ) then
+ write(*,*) 'set0 has 33 bits as expected.'
+ else
+ error stop procedure // 'set0 unexpectedly does not have 33 bits.'
+ end if
+
+! > 64 bit inquiries
+ call set10 % from_string( bitstring_0 // bitstring_0 // bitstring_0 )
+ if ( set10 % none() ) then
+ if ( .not. set10 % any() ) then
+ write(*,*) 'As expected set10 has no bits set'
+ else
+ error stop procedure // ' set10 had some bits set which ' // &
+ 'was unexpected.'
+ end if
+ else
+ error stop procedure // ' set10 did not have none set which ' // &
+ 'was unexpected'
+ end if
+
+ call set10 % not()
+
+ if ( set10 % all() ) then
+ if ( set10 % any() ) then
+ write(*,*) 'As expected set10 now has all bits set'
+ else
+ error stop procedure // ' set10 had no bits set which ' // &
+ 'was unexpected.'
+ end if
+ else
+ error stop procedure // ' set10 did not have all bits set ' // &
+ 'which was unexpected'
+ end if
+
+ call set11 % from_string( bitstring_all // bitstring_all // &
+ bitstring_all )
+ if ( set11 % any() ) then
+ if ( set11 % all() ) then
+ write(*,*) 'As expected set11 has all bits set'
+ else
+ error stop procedure // ' set11 did not have all bits set ' // &
+ 'which was unexpected.'
+ end if
+ else
+ error stop procedure // ' set11 had none bits set ' // &
+ 'which was unexpected'
+ end if
+
+ call set10 % not()
+ do i=0, set10 % bits() - 1
+ if ( set10 % test(i) ) then
+ error stop procedure // ' against expectations set10 has ' // &
+ 'at least 1 bit set.'
+ end if
+ end do
+
+ write(*,*) 'As expected set10 had no bits set.'
+
+ do i=0, set11 % bits() - 1
+ if ( .not. set11 % test(i) ) then
+ error stop procedure // ' against expectations set11 has ' // &
+ 'at least 1 bit unset.'
+ end if
+ end do
+
+ write(*,*) 'As expected set11 had all bits set.'
+
+ do i=0, set10 % bits() - 1
+ if ( set10 % value(i) /= 0 ) then
+ error stop procedure // ' against expectations set10 has ' // &
+ 'at least 1 bit set.'
+ end if
+ end do
+
+ write(*,*) 'As expected set10 had no bits set.'
+
+ do i=0, set11 % bits() - 1
+ if ( set11 % value(i) /= 1 ) then
+ error stop procedure // ' against expectations set11 has ' // &
+ 'at least 1 bit unset.'
+ end if
+ end do
+
+ write(*,*) 'As expected set11 had all bits set.'
+
+ if ( set0 % bits() == 33 ) then
+ write(*,*) 'set0 has 33 bits as expected.'
+ else
+ error stop procedure // 'set0 unexpectedly does not have 33 bits.'
+ end if
+
+ if ( set10 % bits() == 99 ) then
+ write(*,*) 'set10 has 99 bits as expected.'
+ else
+ error stop procedure // 'set10 unexpectedly does not have 99 bits.'
+ end if
+
+ end subroutine test_bitset_inquiry
+
+ subroutine test_bit_operations()
+ character(*), parameter:: procedure = 'TEST_BIT_OPERATIONS'
+
+ write(*,*)
+ write(*,*) 'Test bit operations: clear, flip, not, and set'
+
+ if ( .not. set1 % all() ) then
+ error stop procedure // ' set1 is not all set.'
+ end if
+
+ call set1 % clear(0_bits_kind)
+ if ( .not. set1 % test(0_bits_kind) ) then
+ if ( set1 % test(1_bits_kind) ) then
+ write(*,*) 'Cleared one bit in set1 as expected.'
+ else
+ error stop procedure // ' cleared more than one bit in set1.'
+ end if
+ else
+ error stop procedure // ' did not clear the first bit in set1.'
+ end if
+
+ call set1 % clear(1_bits_kind, 32_bits_kind)
+ if ( set1 % none() ) then
+ write(*,*) 'Cleared remaining bits in set1 as expected.'
+ else
+ error stop procedure // ' did not clear remaining bits ' // &
+ 'in set1.'
+ end if
+
+ call set1 % flip(0_bits_kind)
+ if ( set1 % test(0_bits_kind) ) then
+ if ( .not. set1 % test(1_bits_kind) ) then
+ write(*,*) 'Flipped one bit in set1 as expected.'
+ else
+ error stop procedure // ' flipped more than one bit in set1.'
+ end if
+ else
+ error stop procedure // ' did not flip the first bit in set1.'
+ end if
+
+ call set1 % flip(1_bits_kind, 32_bits_kind)
+ if ( set1 % all() ) then
+ write(*,*) 'Flipped remaining bits in set1 as expected.'
+ else
+ error stop procedure // ' did not flip remaining bits ' // &
+ 'in set1.'
+ end if
+
+ call set1 % not()
+ if ( set1 % none() ) then
+ write(*,*) 'Unset bits in set1 as expected.'
+ else
+ error stop procedure // ' did not unset bits in set1.'
+ end if
+
+ call set1 % set(0_bits_kind)
+ if ( set1 % test(0_bits_kind) ) then
+ if ( .not. set1 % test(1_bits_kind) ) then
+ write(*,*) 'Set first bit in set1 as expected.'
+ else
+ error stop procedure // ' set more than one bit in set1.'
+ end if
+ else
+ error stop procedure // ' did not set the first bit in set1.'
+ end if
+
+ call set1 % set(1_bits_kind, 32_bits_kind)
+ if ( set1 % all() ) then
+ write(*,*) 'Set the remaining bits in set1 as expected.'
+ else
+ error stop procedure // ' did not set the remaining bits ' // &
+ 'in set1.'
+ end if
+
+ call set11 % init( 166_bits_kind )
+ call set11 % not()
+ if ( .not. set11 % all() ) then
+ error stop procedure // ' set11 is not all set.'
+ end if
+
+ call set11 % clear(0_bits_kind)
+ if ( .not. set11 % test(0_bits_kind) ) then
+ if ( set11 % test(1_bits_kind) ) then
+ write(*,*) 'Cleared one bit in set11 as expected.'
+ else
+ error stop procedure // ' cleared more than one bit in set11.'
+ end if
+ else
+ error stop procedure // ' did not clear the first bit in set11.'
+ end if
+
+ call set11 % clear(165_bits_kind)
+ if ( .not. set11 % test(165_bits_kind) ) then
+ if ( set11 % test(164_bits_kind) ) then
+ write(*,*) 'Cleared the last bit in set11 as expected.'
+ else
+ error stop procedure // ' cleared more than one bit in set11.'
+ end if
+ else
+ error stop procedure // ' did not clear the last bit in set11.'
+ end if
+
+ call set11 % clear(1_bits_kind, 164_bits_kind)
+ if ( set11 % none() ) then
+ write(*,*) 'Cleared remaining bits in set11 as expected.'
+ else
+ error stop procedure // ' did not clear remaining bits ' // &
+ 'in set11.'
+ end if
+
+ call set11 % flip(0_bits_kind)
+ if ( set11 % test(0_bits_kind) ) then
+ if ( .not. set11 % test(1_bits_kind) ) then
+ write(*,*) 'Flipped one bit in set11 as expected.'
+ else
+ error stop procedure // ' flipped more than one bit in set11.'
+ end if
+ else
+ error stop procedure // ' did not flip the first bit in set11.'
+ end if
+
+ call set11 % flip(165_bits_kind)
+ if ( set11 % test(165_bits_kind) ) then
+ if ( .not. set11 % test(164_bits_kind) ) then
+ write(*,*) 'Flipped last bit in set11 as expected.'
+ else
+ error stop procedure // ' flipped more than one bit in set11.'
+ end if
+ else
+ error stop procedure // ' did not flip the last bit in set11.'
+ end if
+
+ call set11 % flip(1_bits_kind, 164_bits_kind)
+ if ( set11 % all() ) then
+ write(*,*) 'Flipped remaining bits in set11 as expected.'
+ else
+ error stop procedure // ' did not flip remaining bits ' // &
+ 'in set11.'
+ end if
+
+ call set11 % not()
+ if ( set11 % none() ) then
+ write(*,*) 'Unset bits in set11 as expected.'
+ else
+ error stop procedure // ' did not unset bits in set11.'
+ end if
+
+ call set11 % set(0_bits_kind)
+ if ( set11 % test(0_bits_kind) ) then
+ if ( .not. set11 % test(1_bits_kind) ) then
+ write(*,*) 'Set first bit in set11 as expected.'
+ else
+ error stop procedure // ' set more than one bit in set11.'
+ end if
+ else
+ error stop procedure // ' did not set the first bit in set11.'
+ end if
+
+ call set11 % set(165_bits_kind)
+ if ( set11 % test(165_bits_kind) ) then
+ if ( .not. set11 % test(164_bits_kind) ) then
+ write(*,*) 'Set last bit in set11 as expected.'
+ else
+ error stop procedure // ' set more than one bit in set11.'
+ end if
+ else
+ error stop procedure // ' did not set the last bit in set11.'
+ end if
+
+ call set11 % set(1_bits_kind, 164_bits_kind)
+ if ( set11 % all() ) then
+ write(*,*) 'Set the remaining bits in set11 as expected.'
+ else
+ error stop procedure // ' did not set the remaining bits ' // &
+ 'in set11.'
+ end if
+
+ end subroutine test_bit_operations
+
+ subroutine test_bitset_comparisons()
+ character(*), parameter:: procedure = 'TEST_BITSET_COMPARISON'
+
+ write(*,*)
+ write(*,*) 'Test bitset comparisons: ==, /=, <, <=, >, and >='
+
+ if ( set0 == set0 .and. set1 == set1 .and. set2 == set2 .and. &
+ .not. set0 == set1 .and. .not. set0 == set2 .and. .not. &
+ set1 == set2 ) then
+ write(*,*) 'Passed 64 bit equality tests.'
+ else
+ error stop procedure // ' failed 64 bit equality tests.'
+ end if
+
+ if ( set0 /= set1 .and. set1 /= set2 .and. set0 /= set2 .and. &
+ .not. set0 /= set0 .and. .not. set1 /= set1 .and. .not. &
+ set2 /= set2 ) then
+ write(*,*) 'Passed 64 bit inequality tests.'
+ else
+ error stop procedure // ' failed 64 bit inequality tests.'
+ end if
+
+ if ( set1 > set0 .and. set2 > set0 .and. set1 > set2 .and. &
+ .not. set0 > set1 .and. .not. set1 > set1 .and. .not. &
+ set2 > set1 ) then
+ write(*,*) 'Passed 64 bit greater than tests.'
+ else
+ error stop procedure // ' failed 64 bit greater than tests.'
+ end if
+
+ if ( set1 >= set0 .and. set1 >= set2 .and. set2 >= set2 .and. &
+ .not. set0 >= set1 .and. .not. set0 >= set1 .and. .not. &
+ set2 >= set1 ) then
+ write(*,*) 'Passed 64 bit greater than or equal tests.'
+ else
+ error stop procedure // ' failed 64 bit greater than or ' // &
+ 'equal tests.'
+ end if
+
+ if ( set0 < set1 .and. set0 < set1 .and. set2 < set1 .and. &
+ .not. set1 < set0 .and. .not. set0 < set0 .and. .not. &
+ set1 < set2 ) then
+ write(*,*) 'Passed 64 bit less than tests.'
+ else
+ error stop procedure // ' failed 64 bit less than tests.'
+ end if
+
+ if ( set0 <= set1 .and. set2 <= set1 .and. set2 <= set2 .and. &
+ .not. set1 <= set0 .and. .not. set2 <= set0 .and. .not. &
+ set1 <= set2 ) then
+ write(*,*) 'Passed 64 bit less than or equal tests.'
+ else
+ error stop procedure // ' failed 64 bit less than or ' // &
+ 'equal tests.'
+ end if
+
+ call set10 % init(166_bits_kind)
+ call set11 % init(166_bits_kind)
+ call set11 % not()
+ call set12 % init(166_bits_kind)
+ call set12 % set(165_bits_kind)
+ call set13 % init(166_bits_kind)
+ call set13 % set(65_bits_kind)
+ call set14 % init(166_bits_kind)
+ call set14 % set(0_bits_kind)
+ if ( set10 == set10 .and. set11 == set11 .and. set12 == set12 .and. &
+ set13 == set13 .and. set14 == set14 .and. &
+ .not. set13 == set14 .and. .not. set12 == set13 .and. &
+ .not. set10 == set11 .and. .not. set10 == set12 .and. .not. &
+ set11 == set12 ) then
+ write(*,*) 'Passed > 64 bit equality tests.'
+ else
+ error stop procedure // ' failed > 64 bit equality tests.'
+ end if
+
+ if ( set10 /= set11 .and. set11 /= set12 .and. set10 /= set12 .and. &
+ set13 /= set12 .and. set14 /= set13 .and. set14 /= set12 .and. &
+ .not. set13 /= set13 .and. .not. set12 /= set12 .and. &
+ .not. set10 /= set10 .and. .not. set11 /= set11 .and. .not. &
+ set12 /= set12 ) then
+ write(*,*) 'Passed > 64 bit inequality tests.'
+ else
+ error stop procedure // ' failed > 64 bit inequality tests.'
+ end if
+
+ if ( set11 > set10 .and. set12 > set10 .and. set11 > set12 .and. &
+ set13 > set14 .and. set12 > set13 .and. set12 > set14 .and. &
+ .not. set14 > set12 .and. .not. set12 > set11 .and. &
+ .not. set10 > set11 .and. .not. set11 > set11 .and. .not. &
+ set12 > set11 ) then
+ write(*,*) 'Passed > 64 bit greater than tests.'
+ else
+ error stop procedure // ' failed > 64 bit greater than tests.'
+ end if
+
+ if ( set11 >= set10 .and. set11 >= set12 .and. set12 >= set12 .and. &
+ set13 >= set14 .and. set12 >= set13 .and. set12 >= set14 .and. &
+ .not. set14 >= set12 .and. .not. set12 >= set11 .and. &
+ .not. set10 >= set11 .and. .not. set10 >= set11 .and. .not. &
+ set12 >= set11 ) then
+ write(*,*) 'Passed > 64 bit greater than or equal tests.'
+ else
+ error stop procedure // ' failed 64 bit greater than or ' // &
+ 'equal tests.'
+ end if
+
+ if ( set10 < set11 .and. set10 < set11 .and. set12 < set11 .and. &
+ set14 < set13 .and. set13 < set12 .and. set14 < set12 .and. &
+ .not. set12 < set14 .and. .not. set11 < set12 .and. &
+ .not. set11 < set10 .and. .not. set10 < set10 .and. .not. &
+ set11 < set12 ) then
+ write(*,*) 'Passed > 64 bit less than tests.'
+ else
+ error stop procedure // ' failed > 64 bit less than tests.'
+ end if
+
+ if ( set10 <= set11 .and. set12 <= set11 .and. set12 <= set12 .and. &
+ set14 <= set13 .and. set13 <= set12 .and. set14 <= set12 .and. &
+ .not. set12 <= set14 .and. .not. set11 <= set12 .and. &
+ .not. set11 <= set10 .and. .not. set12 <= set10 .and. .not. &
+ set11 <= set12 ) then
+ write(*,*) 'Passed > 64 bit less than or equal tests.'
+ else
+ error stop procedure // ' failed > 64 bit less than or ' // &
+ 'equal tests.'
+ end if
+
+ end subroutine test_bitset_comparisons
+
+ subroutine test_bitset_operations()
+ character(*), parameter:: procedure = 'TEST_BITSET_OPERATIONS'
+
+ write(*,*)
+ write(*,*) 'Test bitset operations: and, and_not, or, and xor'
+
+ call set0 % from_string( bitstring_all )
+ call set4 % from_string( bitstring_all )
+ call and( set0, set4 ) ! all all
+ if ( set0 % all() ) then
+ write(*,*) 'First test of < 64 bit AND worked.'
+ else
+ error stop procedure // ' first test of < 64 bit AND failed.'
+ end if
+
+ call set4 % from_string( bitstring_0 )
+ call and( set0, set4 ) ! all none
+ if ( set0 % none() ) then
+ write(*,*) 'Second test of < 64 bit AND worked.'
+ else
+ error stop procedure // ' second test of < 64 bit AND failed.'
+ end if
+
+ call set3 % from_string( bitstring_all )
+ call set4 % from_string( bitstring_0 )
+ call and( set4, set3 ) ! none all
+ if ( set4 % none() ) then
+ write(*,*) 'Third test of < 64 bit AND worked.'
+ else
+ error stop procedure // ' third test of < 64 bit AND failed.'
+ end if
+
+ call set3 % from_string( bitstring_0 )
+ call and( set4, set3 ) ! none none
+ if ( set4 % none() ) then
+ write(*,*) 'Fourth test of < 64 bit AND worked.'
+ else
+ error stop procedure // ' fourth test of < 64 bit AND failed.'
+ end if
+
+ call set3 % from_string( bitstring_all )
+ call set4 % from_string( bitstring_all )
+ call and_not( set4, set3 ) ! all all
+ if ( set4 % none() ) then
+ write(*,*) 'First test of < 64 bit AND_NOT worked.'
+ else
+ error stop procedure // ' first test of < 64 bit AND_NOT failed.'
+ end if
+
+ call set4 % from_string( bitstring_0 )
+ call and_not( set4, set3 ) ! none all
+ if ( set4 % none() ) then
+ write(*,*) 'Second test of < 64 bit AND_NOT worked.'
+ else
+ error stop procedure // ' second test of < 64 bit AND_NOT failed.'
+ end if
+
+ call set3 % from_string( bitstring_all )
+ call set4 % from_string( bitstring_0 )
+ call and_not( set3, set4 ) ! all none
+ if ( set3 % all() ) then
+ write(*,*) 'Third test of < 64 bit AND_NOT worked.'
+ else
+ error stop procedure // ' third test of < 64 bit AND_NOT failed.'
+ end if
+
+ call set3 % from_string( bitstring_0 )
+ call set4 % from_string( bitstring_0 )
+ call and_not( set3, set4 ) ! none none
+ if ( set3 % none() ) then
+ write(*,*) 'Fourth test of < 64 bit AND_NOT worked.'
+ else
+ error stop procedure // ' fourth test of < 64 bit AND_NOT failed.'
+ end if
+
+ call set3 % from_string( bitstring_all )
+ call set4 % from_string( bitstring_all )
+ call or( set3, set4 ) ! all all
+ if ( set3 % all() ) then
+ write(*,*) 'First test of < 64 bit OR worked.'
+ else
+ error stop procedure // ' first test of < 64 bit OR failed.'
+ end if
+
+ call set3 % from_string( bitstring_0 )
+ call or( set4, set3 ) ! all none
+ if ( set4 % all() ) then
+ write(*,*) 'Second test of < 64 bit OR worked.'
+ else
+ error stop procedure // ' second test of < 64 bit OR failed.'
+ end if
+
+ call or( set3, set4 ) ! none all
+ if ( set3 % all() ) then
+ write(*,*) 'Third test of < 64 bit OR worked.'
+ else
+ error stop procedure // ' third test of < 64 bit OR failed.'
+ end if
+
+ call set3 % from_string( bitstring_0 )
+ call set4 % from_string( bitstring_0 )
+ call or( set4, set3 ) !none none
+ if ( set4 % none() ) then
+ write(*,*) 'Fourth test of < 64 bit OR worked.'
+ else
+ error stop procedure // ' fourth test of < 64 bit OR failed.'
+ end if
+
+ call set3 % from_string( bitstring_0 )
+ call set4 % from_string( bitstring_0 )
+ call xor( set3, set4 ) ! none none
+ if ( set3 % none() ) then
+ write(*,*) 'First test of < 64 bit XOR worked.'
+ else
+ error stop procedure // ' first test of < 64 bit XOR failed.'
+ end if
+
+ call set4 % from_string( bitstring_all )
+ call xor( set3, set4 ) ! none all
+ if ( set3 % all() ) then
+ write(*,*) 'Second test of < 64 bit XOR worked.'
+ else
+ error stop procedure // ' second test of < 64 bit XOR failed.'
+ end if
+
+ call set4 % from_string( bitstring_0 )
+ call xor( set3, set4 ) ! all none
+ if ( set3 % all() ) then
+ write(*,*) 'Third test of < 64 bit XOR worked.'
+ else
+ error stop procedure // ' third test of < 64 bit XOR failed.'
+ end if
+
+ call set4 % from_string( bitstring_all )
+ call xor( set3, set4 ) ! all all
+ if ( set3 % none() ) then
+ write(*,*) 'Fourth test of < 64 bit XOR worked.'
+ else
+ error stop procedure // ' fourth test of < 64 bit XOR failed.'
+ end if
+
+ call set0 % init(166_bits_kind)
+ call set0 % not()
+ call set4 % init(166_bits_kind)
+ call set4 % not()
+ call and( set0, set4 ) ! all all
+ if ( set0 % all() ) then
+ write(*,*) 'First test of > 64 bit AND worked.'
+ else
+ error stop procedure // ' first test of > 64 bit AND failed.'
+ end if
+
+ call set4 % init(166_bits_kind)
+ call and( set0, set4 ) ! all none
+ if ( set0 % none() ) then
+ write(*,*) 'Second test of > 64 bit AND worked.'
+ else
+ error stop procedure // ' second test of > 64 bit AND failed.'
+ end if
+
+ call set3 % init(166_bits_kind)
+ call set3 % not()
+ call and( set4, set3 ) ! none all
+ if ( set4 % none() ) then
+ write(*,*) 'Third test of > 64 bit AND worked.'
+ else
+ error stop procedure // ' third test of > 64 bit AND failed.'
+ end if
+
+ call set3 % init(166_bits_kind)
+ call and( set4, set3 ) ! none none
+ if ( set4 % none() ) then
+ write(*,*) 'Fourth test of > 64 bit AND worked.'
+ else
+ error stop procedure // ' fourth test of > 64 bit AND failed.'
+ end if
+
+ call set3 % not()
+ call set4 % not()
+ call and_not( set4, set3 ) ! all all
+ if ( set4 % none() ) then
+ write(*,*) 'First test of > 64 bit AND_NOT worked.'
+ else
+ error stop procedure // ' first test of > 64 bit AND_NOT failed.'
+ end if
+
+ call and_not( set4, set3 ) ! none all
+ if ( set4 % none() ) then
+ write(*,*) 'Second test of > 64 bit AND_NOT worked.'
+ else
+ error stop procedure // ' second test of > 64 bit AND_NOT failed.'
+ end if
+
+ call and_not( set3, set4 ) ! all none
+ if ( set3 % all() ) then
+ write(*,*) 'Third test of > 64 bit AND_NOT worked.'
+ else
+ error stop procedure // ' third test of > 64 bit AND_NOT failed.'
+ end if
+
+ call set3 % not()
+ call and_not( set3, set4 ) ! none none
+ if ( set3 % none() ) then
+ write(*,*) 'Fourth test of > 64 bit AND_NOT worked.'
+ else
+ error stop procedure // ' fourth test of > 64 bit AND_NOT failed.'
+ end if
+
+ call set3 % init(166_bits_kind)
+ call set3 % not()
+ call set4 % init(166_bits_kind)
+ call set4 % not()
+ call or( set3, set4 ) ! all all
+ if ( set3 % all() ) then
+ write(*,*) 'First test of > 64 bit OR worked.'
+ else
+ error stop procedure // ' first test of > 64 bit OR failed.'
+ end if
+
+ call set3 % init(166_bits_kind)
+ call or( set4, set3 ) ! all none
+ if ( set4 % all() ) then
+ write(*,*) 'Second test of > 64 bit OR worked.'
+ else
+ error stop procedure // ' second test of > 64 bit OR failed.'
+ end if
+
+ call or( set3, set4 ) ! none all
+ if ( set3 % all() ) then
+ write(*,*) 'Third test of > 64 bit OR worked.'
+ else
+ error stop procedure // ' third test of > 64 bit OR failed.'
+ end if
+
+ call set3 % init(166_bits_kind)
+ call set4 % init(166_bits_kind)
+ call or( set4, set3 ) !none none
+ if ( set4 % none() ) then
+ write(*,*) 'Fourth test of > 64 bit OR worked.'
+ else
+ error stop procedure // ' fourth test of > 64 bit OR failed.'
+ end if
+
+ call xor( set3, set4 ) ! none none
+ if ( set3 % none() ) then
+ write(*,*) 'First test of > 64 bit XOR worked.'
+ else
+ error stop procedure // ' first test of > 64 bit XOR failed.'
+ end if
+
+ call set4 % not()
+ call xor( set3, set4 ) ! none all
+ if ( set3 % all() ) then
+ write(*,*) 'Second test of > 64 bit XOR worked.'
+ else
+ error stop procedure // ' second test of > 64 bit XOR failed.'
+ end if
+
+ call set4 % not()
+ call xor( set3, set4 ) ! all none
+ if ( set3 % all() ) then
+ write(*,*) 'Third test of > 64 bit XOR worked.'
+ else
+ error stop procedure // ' third test of > 64 bit XOR failed.'
+ end if
+
+ call set4 % not()
+ call xor( set3, set4 ) ! all all
+ if ( set3 % none() ) then
+ write(*,*) 'Fourth test of > 64 bit XOR worked.'
+ else
+ error stop procedure // ' fourth test of > 64 bit XOR failed.'
+ end if
+
+ end subroutine test_bitset_operations
+
+
+end program test_stdlib_bitset_large