! bof
! **********************************************************************
! Fortran 95 module type_boolean

! **********************************************************************
! Source Control Strings

! $Id: typebool.f90 1.8 2000/07/03 13:21:54Z Dan Release $

! **********************************************************************
! Copyright 2000 Purple Sage Computing Solutions, Inc.

! **********************************************************************
! type boolean is a 32-bit typeless type with operations and routines

! **********************************************************************
! Summary of License

!   This library is free software; you can redistribute it and/or
!   modify it under the terms of the GNU Library General Public
!   License as published by the Free Software Foundation; either
!   version 2 of the License, or (at your option) any later version.

!   This library is distributed in the hope that it will be useful,
!   but WITHOUT ANY WARRANTY; without even the implied warranty of
!   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
!   Library General Public License for more details.

!   You should have received a copy of the GNU Library General Public
!   License along with this library; if not, write to the Free
!   Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

! To report bugs, suggest enhancements, etc. to the Authors,
! Contact:
!    Purple Sage Computing Solutions, Inc.
!                               send email to dnagle@@erols.com
!                                   or fax to 703 471 0684 (USA)
!                                  or mail to 12142 Purple Sage Ct.
!                                             Reston, VA 20194-5621 USA

!  a variable of type boolean consists of (wordsize) distinct bits
!  an assignment to or from a boolean variable is a bit-wise copy
!  there is no meaning assigned to any bit, hence "typeless"

! **********************************************************************

!  type_boolean types

!     boolean_t a typeless type, an ordered set of bits

!  type_boolean constants

!     all_set all bits set
!     all_clear all bits clear

!  type_boolean operators

!     = assignment

!     + unary operators
!     -

!     .set.       boolean = boolean .set. integer
!     .clear.     boolean = boolean .clear. integer
!     .isset.     logical = boolean .isset. integer
!     .isclear.   logical = boolean .isclear. integer

!     .and.       boolean = boolean .and. boolean
!     .or.        boolean = boolean .or. boolean
!     .eor.       boolean = boolean .eor. boolean
!     .not.       boolean = .not. boolean

!     .xor.       boolean = boolean .xor. boolean
!     .eqv.       boolean = boolean .eqv. boolean
!     .neqv.      boolean = boolean .neqv. boolean

!     .eq.        logical = boolean .eq. boolean
!     .ne.        logical = boolean .ne. boolean
!     .gt.        logical = boolean .gt. boolean
!     .ge.        logical = boolean .ge. boolean
!     .le.        logical = boolean .le. boolean
!     .lt.        logical = boolean .lt. boolean

!     +           boolean = boolean + boolean
!     -           boolean = boolean - boolean
!     *           boolean = boolean * boolean
!     /           boolean = boolean / boolean

!     .hamd.      integer = boolean .hamd. boolean
!     .shift.     boolean = boolean .shift. integer
!     .rotate.    boolean = boolean .rotate. integer

!  type_boolean library

!     bool()      boolean = bool( real integer logical character)
!     int()       integer = int( boolean)
!     real()      real = real( boolean)
!     logical()   logical = logical( boolean)
!     char()      character = char( boolean)

!     compl()     boolean = compl( boolean)
!     csmg()      boolean = csmg( boolean, boolean, boolean)

!     leadz()     integer = leadz( boolean)
!     lastz()     integer = lastz( boolean)
!     popcnt()    integer = popcnt( boolean)
!     poppar()    integer = poppar( boolean)
!     hamd()      integer = hamd( boolean, boolean)

!     mask()      boolean = mask( integer)
!     maskl()     boolean = maskl( integer)
!     maskr()     boolean = maskr( integer)

!     ishft()     boolean = ishft( boolean, integer)
!     ishftc()    boolean = ishftc( boolean, integer, integer)
!     dshftl()    boolean = dshftl( boolean, boolean, integer)
!     dshftr()    boolean = dshftr( boolean, boolean, integer)
!     dshftc()    call dshftc( boolean, boolean, integer)

!     ibset()     boolean = ibset( boolean, integer)
!     ibclr()     boolean = ibclr( boolean, integer)
!     btest()     logical = btest( boolean, integer)
!     bztest()    logical = btest( boolean, integer)
!     mvbits()    call mvbits( boolean, integer, integer, boolean, integer)
!     ibits()     boolean = ibits( boolean, integer, integer)
!     not()       boolean = not( boolean)

!     rev_endian()
!     bit_size()  integer = bit_size( boolean)
!     swap()      call swap( boolean, boolean)

! **********************************************************************
!  type boolean- a bit_size( word) number of bits- "typeless"

! **********************************************************************

module type_boolean

! **********************************************************************
! use standard parameterization of processor dependencies

use standard_types

! **********************************************************************
! declare all variables

implicit none

! **********************************************************************

!  RCS strings

! **********************************************************************

character( len= *), parameter :: type_boolean_rcs_id = &
      '$Id: typebool.f90 1.8 2000/07/03 13:21:54Z Dan Release $'

! **********************************************************************

!  define the type

! **********************************************************************

!  type boolean is one word of bits

   type :: boolean_t                                       ! boolean_t
      private
      integer( kind= int_k) :: bits
   end type boolean_t                                      ! boolean_t

! **********************************************************************

!  boolean_t constants

! **********************************************************************

!  all_set has all bits set

   type( boolean_t), parameter :: all_set = boolean_t( -1)

!  all_clear has all bits clear

   type( boolean_t), parameter :: all_clear = boolean_t( 0)

! **********************************************************************

!  assignment: to/from integer, real, logical, character

   private :: b_to_i                                       ! access by operator only
   private :: i_to_b
   private :: b_to_r
   private :: r_to_b
   private :: b_to_l
   private :: l_to_b
   private :: b_to_c
   private :: c_to_b

   interface assignment( =)
      module procedure b_to_i                              ! int( boolean)
      module procedure i_to_b                              ! bool( integer)
      module procedure b_to_r                              ! real( boolean)
      module procedure r_to_b                              ! bool( real)
      module procedure b_to_l                              ! logical( boolean)
      module procedure l_to_b                              ! bool( logical)
      module procedure b_to_c                              ! char( boolean)
      module procedure c_to_b                              ! bool( char)
   end interface

! **********************************************************************

!  conversion: bool(), int(), real(), logical(), char()

   public :: bool                                          ! generic name

   private :: int_bool                                     ! access by generic only
   private :: single_bool
   private :: logical_bool
   private :: char_bool

   interface bool
      module procedure int_bool                            ! bool( integer)
      module procedure single_bool                         ! bool( real)
      module procedure logical_bool                        ! bool( logical)
      module procedure char_bool                           ! bool( character)
   end interface

   intrinsic :: int                                        ! extend intrinsic

   public :: int                                           ! generic name

   private :: boolean_int                                  ! access by generic only

   interface int
      module procedure boolean_int                         ! int( boolean)
   end interface

   intrinsic :: real                                       ! extend intrinsic

   public :: real                                          ! generic name

   private :: boolean_real                                 ! access by generic only

   interface real
      module procedure boolean_real                        ! real( boolean)
   end interface

   intrinsic :: logical                                    ! extend intrinsic

   public :: logical                                       ! generic name

   private :: boolean_logical                              ! access by generic only

   interface logical
      module procedure boolean_logical                     ! logical( boolean)
   end interface

   intrinsic :: char                                       ! extend intrinsic

   public :: char                                          ! generic name

   private :: boolean_char                                 ! access by generic only

   interface char
      module procedure boolean_char                        ! char( boolean)
   end interface

! **********************************************************************

!  unary operators

! **********************************************************************

!  boolean unary operator +

   private :: boolean_plus                                 ! access by operator only

   interface operator( +)
      module procedure boolean_plus                        ! b = + b
   end interface

!  boolean unary operator -

   private :: boolean_minus                                ! access by operator only

   interface operator( -)
      module procedure boolean_minus                       ! b = - b
   end interface

! **********************************************************************

!  bitwise logical operators & functions

! **********************************************************************

!  boolean binary operator .and.

   private :: boolean_and                                  ! access via operator

   interface operator( .and.)
      module procedure boolean_and                         ! b = b .and. b
   end interface

!  boolean binary operator .or.

   private :: boolean_or                                   ! access via operator

   interface operator( .or.)
      module procedure boolean_or                          ! b = b .or. b
   end interface

!  boolean binary operator .eor.

   private :: boolean_eor                                  ! access via operator

   interface operator( .eor.)
      module procedure boolean_eor                         ! b = b .eor. b
   end interface

!  boolean unary operator .not.

   private :: boolean_not                                  ! access via operator

   interface operator( .not.)
      module procedure boolean_not                         ! b = .not. b
   end interface

!  boolean function compl( i)

   private :: boolean_compl

   interface compl
      module procedure boolean_compl                       ! b = compl( b)
   end interface

!  boolean function csmg( i, j, k)

   private :: boolean_csmg

   interface csmg
      module procedure boolean_csmg                        ! b = csmg( b, b, b)
   end interface

! **********************************************************************

!  boolean logical operators

! **********************************************************************

!  boolean binary operator .xor.

   private :: boolean_xor                                  ! access via operator

   interface operator( .xor.)
      module procedure boolean_xor                         ! b = b .xor. b
   end interface

!  boolean binary operator .eqv.

   private :: boolean_eqv                                  ! access via operator

   interface operator( .eqv.)
      module procedure boolean_eqv                         ! b = b .eqv. b
   end interface

!  boolean binary operator .neqv.

   private :: boolean_neqv                                 ! access via operator

   interface operator( .neqv.)
      module procedure boolean_neqv                        ! b = b .neqv. b
   end interface

! **********************************************************************

!  logical boolean operators: .eq., .ne., .ge., .gt., .le., .lt.

! **********************************************************************

!  boolean binary operator ==

   private :: boolean_eq                                   ! access via operator

   interface operator( .eq.)
      module procedure boolean_eq                          ! l = b == b
   end interface

!  boolean binary operator /=

   private :: boolean_ne                                   ! access via operator

   interface operator( .ne.)
      module procedure boolean_ne                          ! l = b /= b
   end interface

!  boolean binary operator >=

   private :: boolean_ge                                   ! access via operator

   interface operator( .ge.)
      module procedure boolean_ge                          ! l = b >= b
   end interface

!  boolean binary operator >

   private :: boolean_gt                                   ! access via operator

   interface operator( .gt.)
      module procedure boolean_gt                          ! l = b > b
   end interface

!  boolean binary operator <=

   private :: boolean_le                                   ! access via operator

   interface operator( .le.)
      module procedure boolean_le                          ! l = b <= b
   end interface

!  boolean binary operator <

   private :: boolean_lt                                   ! access via operator

   interface operator( .lt.)
      module procedure boolean_lt                          ! l = b < b
   end interface

! **********************************************************************

!  integer arithmetic operators

! **********************************************************************

!  boolean binary operator +

   private :: boolean_add                                  ! access via operator

   interface operator( +)
      module procedure boolean_add                         ! b = b + b
   end interface

!  boolean binary operator -

   private :: boolean_sub                                  ! access via operator

   interface operator( -)
      module procedure boolean_sub                         ! b = b - b
   end interface

!  boolean binary operator *

   private :: boolean_mul                                  ! access via operator

   interface operator( *)
      module procedure boolean_mul                         ! b = b * b
   end interface

!  boolean binary operator /

   private :: boolean_div                                  ! access via operator

   interface operator( /)
      module procedure boolean_div                         ! b = b / b
   end interface

! **********************************************************************

!  bit level functions

! **********************************************************************

!  boolean function leadz

   public :: leadz

   private :: boolean_leadz

   interface leadz
      module procedure boolean_leadz                       ! i = leadz( b)
   end interface

!  boolean function lastz

   public :: lastz

   private :: boolean_lastz

   interface lastz
      module procedure boolean_lastz                       ! i = lastz( b)
   end interface

!  boolean function popcnt

   public :: popcnt

   private :: boolean_popcnt

   interface popcnt
      module procedure boolean_popcnt                      ! i = popcnt( b)
   end interface

!  boolean function poppar

   public :: poppar

   private :: boolean_poppar

   interface poppar
      module procedure boolean_poppar                      ! i = poppar( b)
   end interface

!  boolean hamming distance

   public :: hamd

   private :: boolean_hamd

   interface hamd
      module procedure boolean_hamd                        ! i = hamd( b, b)
   end interface

   interface operator( .hamd.)
      module procedure boolean_hamd                        ! i = b .hamd. b
   end interface

!  boolean hamming distance

   private :: boolean_shift

   interface operator( .shift.)
      module procedure boolean_shift                       ! b = b .shift. i
   end interface

   private :: boolean_rotate

   interface operator( .rotate.)
      module procedure boolean_rotate                      ! b = b .rotate. i
   end interface

! **********************************************************************

!  mask functions

! **********************************************************************

!  boolean mask

   public :: mask

   private :: boolean_mask

   interface mask
      module procedure boolean_mask                        ! b = mask( i)
   end interface

!  boolean maskl

   public :: maskl

   private :: boolean_maskl

   interface maskl
      module procedure boolean_maskl                       ! b = maskl( i)
   end interface

!  boolean maskr

   public :: maskr

   private :: boolean_maskr

   interface maskr
      module procedure boolean_maskr                       ! b = maskr( i)
   end interface

! **********************************************************************

!  shift functions

! **********************************************************************

!  boolean ishft

   intrinsic :: ishft

   public :: ishft

   private :: boolean_ishft

   interface ishft
      module procedure boolean_ishft                       ! b = ishft( b, i)
   end interface

!  boolean ishftc

   intrinsic :: ishftc

   public :: ishftc

   private :: boolean_ishftc

   interface ishftc
      module procedure boolean_ishftc                      ! b = ishftc( b, i, i)
   end interface

!  boolean dshftl

   public :: dshftl

   private :: boolean_dshftl

   interface dshftl
      module procedure boolean_dshftl                      ! b = dshftl( b, b, i)
   end interface

!  boolean dshftr

   public :: dshftr

   private :: boolean_dshftr

   interface dshftr
      module procedure boolean_dshftr                      ! b = dshftr( b, b, i)
   end interface

!  boolean dshftc

   public :: dshftc

   private :: boolean_dshftc

   interface dshftc
      module procedure boolean_dshftc                      ! call dhsftc( b, b, i)
   end interface

! **********************************************************************

!  mil std bit functions

! **********************************************************************

!  boolean ibset

   intrinsic :: ibset

   public :: ibset

   private :: boolean_ibset

   interface operator( .set.)
      module procedure boolean_ibset                       ! b = b .set. i
   end interface

   interface ibset
      module procedure boolean_ibset                       ! b = ibset( b, i)
   end interface

!  boolean ibclr

   intrinsic :: ibclr

   public :: ibclr

   private :: boolean_ibclr

   interface operator( .clear.)
      module procedure boolean_ibclr                       ! b = b .clear. i
   end interface

   interface ibclr
      module procedure boolean_ibclr                       ! b = ibclr( b, i)
   end interface

!  boolean btest

   intrinsic :: btest

   public :: btest

   private :: boolean_btest

   interface operator( .isset.)
      module procedure boolean_btest                       ! l = b .isset. i
   end interface

   interface btest
      module procedure boolean_btest                       ! l = btest( b, i)
   end interface

!  boolean isclear

   public :: bztest

   private :: boolean_bztest

   interface operator( .isclear.)
      module procedure boolean_bztest                      ! l = b .isclear. i
   end interface

   interface bztest
      module procedure boolean_bztest                      ! l = bztest( b, i)
   end interface

!  boolean mvbits

   intrinsic :: mvbits

   public :: mvbits

   private :: boolean_mvbits

   interface mvbits
      module procedure boolean_mvbits                      ! call mvbits( b, i, i, b, i)
   end interface

!  boolean ibits

   intrinsic :: ibits

   public :: ibits

   private :: boolean_ibits

   interface ibits
      module procedure boolean_ibits                       ! b = ibits( b, i, i)
   end interface

! **********************************************************************

!  boolean rev_endian()

   public :: rev_endian

   private :: boolean_rev_endian

   interface rev_endian
      module procedure boolean_rev_endian                  ! call rev_endian( b, b)
   end interface

! **********************************************************************

!  boolean bit_size()

   intrinsic :: bit_size

   public :: bit_size

   private :: boolean_bit_size

   interface bit_size
      module procedure boolean_bit_size                    ! i = bit_size( b)
   end interface

! **********************************************************************

!  boolean swap()

   public :: swap

   private :: boolean_swap

   interface swap
      module procedure boolean_swap                        ! call swap( b, b)
   end interface

! **********************************************************************

!  data

! **********************************************************************

!  mask, maskl, maskr data

   integer( kind= int_k), private, dimension( bit_size( 0_int_k)) :: &
      left_mask, right_mask

   data left_mask/ z'80000000', z'c0000000', z'e0000000', z'f0000000', &
                   z'f8000000', z'fc000000', z'fe000000', z'ff000000', &
                   z'ff800000', z'ffc00000', z'ffe00000', z'fff00000', &
                   z'fff80000', z'fffc0000', z'fffe0000', z'ffff0000', &
                   z'ffff8000', z'ffffc000', z'ffffe000', z'fffff000', &
                   z'fffff800', z'fffffc00', z'fffffe00', z'ffffff00', &
                   z'ffffff80', z'ffffffc0', z'ffffffe0', z'fffffff0', &
                   z'fffffff8', z'fffffffc', z'fffffffe', z'ffffffff'/

   data right_mask/ z'00000001', z'00000003', z'00000007', z'0000000f', &
                    z'0000001f', z'0000003f', z'0000007f', z'000000ff', &
                    z'000001ff', z'000003ff', z'000007ff', z'00000fff', &
                    z'00001fff', z'00003fff', z'00007fff', z'0000ffff', &
                    z'0001ffff', z'0003ffff', z'0007ffff', z'000fffff', &
                    z'001fffff', z'003fffff', z'007fffff', z'00ffffff', &
                    z'01ffffff', z'03ffffff', z'07ffffff', z'0fffffff', &
                    z'1fffffff', z'3fffffff', z'7fffffff', z'ffffffff'/

!  leadz, lastz, popcnt, poppar data

   integer( kind= int_k), private :: lead_probe16 ; data lead_probe16/ z'ffff0000'/
   integer( kind= int_k), private :: lead_probe8 ; data lead_probe8/ z'ff00ff00'/
   integer( kind= int_k), private :: lead_probe4 ; data lead_probe4/ z'f0f0f0f0'/
   integer( kind= int_k), private :: lead_probe2 ; data lead_probe2/ z'cccccccc'/
   integer( kind= int_k), private :: lead_probe1 ; data lead_probe1/ z'aaaaaaaa'/

   integer( kind= int_k), private :: last_probe16 ; data last_probe16/ z'0000ffff'/
   integer( kind= int_k), private :: last_probe8 ; data last_probe8/ z'00ff00ff'/
   integer( kind= int_k), private :: last_probe4 ; data last_probe4/ z'0f0f0f0f'/
   integer( kind= int_k), private :: last_probe2 ; data last_probe2/ z'33333333'/
   integer( kind= int_k), private :: last_probe1 ; data last_probe1/ z'55555555'/

   integer( kind= int_k) :: p1 ; data p1/ z'11111111'/
   integer( kind= int_k) :: p2 ; data p2/ z'22222222'/
   integer( kind= int_k) :: p4 ; data p4/ z'44444444'/
   integer( kind= int_k) :: p8 ; data p8/ z'88888888'/

   integer( kind= int_k) :: hi_nibble ; data hi_nibble/ z'f0f0f0f0'/
   integer( kind= int_k) :: lo_nibble ; data lo_nibble/ z'0f0f0f0f'/

   integer( kind= int_k) :: low_byte ; data low_byte/ z'000000ff'/

   integer( kind= int_k) :: low_bit ; data low_bit/ z'00000001'/

! *********************************************************************

!  library

! **********************************************************************

contains

! **********************************************************************

!  assignment between boolean <--> other csu_per_nsu byte types

! **********************************************************************

!  integer = boolean

elemental subroutine b_to_i( i, b)

type( boolean_t), intent( in) :: b

integer( kind= int_k), intent( out) :: i

!  b_to_i()

continue                                                   ! b_to_i()

   i = transfer( b, i)

return                                                     ! b_to_i()

!  b_to_i()

end subroutine b_to_i

! **********************************************************************

!  boolean = integer

elemental subroutine i_to_b( b, i)

integer( kind= int_k), intent( in) :: i

type( boolean_t), intent( out) :: b

!  i_to_b()

continue                                                   ! i_to_b()

   b = transfer( i, b)

return                                                     ! i_to_b()

!  i_to_b()

end subroutine i_to_b

! **********************************************************************

!  real = boolean

elemental subroutine b_to_r( r, b)

type( boolean_t), intent( in) :: b

real( kind= single_k), intent( out) :: r

!  begin

continue                                                   ! here from caller

   r = transfer( b, r)

return                                                     ! back to caller

!  b_to_r()

end subroutine b_to_r

! **********************************************************************

!  boolean = real

elemental subroutine r_to_b( b, r)

real( kind= single_k), intent( in) :: r

type( boolean_t), intent( out) :: b

!  r_to_b()

continue                                                   ! r_to_b()

   b = transfer( r, b)

return                                                     ! r_to_b()

!  r_to_b()

end subroutine r_to_b

! **********************************************************************

!  logical = boolean

elemental subroutine b_to_l( l, b)

type( boolean_t), intent( in) :: b

logical( kind= l_int_k), intent( out) :: l

!  b_to_l

continue                                                   ! b_to_l()

   l = transfer( b, l)

return                                                     ! b_to_l()

!  b_to_l()

end subroutine b_to_l

! **********************************************************************

!  boolean = logical

elemental subroutine l_to_b( b, l)

logical( kind= l_int_k), intent( in) :: l

type( boolean_t), intent( out) :: b

!  l_to_b()

continue                                                   ! l_to_b()

   b = transfer( l, b)

return                                                     ! l_to_b()

!  l_to_b()

end subroutine l_to_b

! **********************************************************************

!  character*4 = boolean

elemental subroutine b_to_c( c, b)

type( boolean_t), intent( in) :: b

character( len= csu_per_nsu, kind= ascii_k), intent( out) :: c

!  b_to_c()

continue                                                   ! b_to_c()

   c = transfer( b, c)

return                                                     ! b_to_c()

!  b_to_c()

end subroutine b_to_c

! **********************************************************************

!  boolean = character*4

elemental subroutine c_to_b( b, c)

character( len= csu_per_nsu, kind= ascii_k), intent( in) :: c

type( boolean_t), intent( out) :: b

!  c_to_b()

continue                                                   ! c_to_b()

   b = transfer( c, b)

return                                                     ! c_to_b()

!  c_to_b()

end subroutine c_to_b

! **********************************************************************

!  explicit conversion to/from boolean

! **********************************************************************

!  boolean = bool( integer)

elemental type( boolean_t) function int_bool( i)

integer( kind= int_k), intent( in) :: i

!  int_bool()

continue                                                   ! bool()

   int_bool = transfer( i, int_bool)

return                                                     ! bool()

!  int_bool()

end function int_bool
   
! **********************************************************************

!  boolean = bool( real)

elemental type( boolean_t) function single_bool( r)

real( kind= single_k), intent( in) :: r

!  single_bool()

continue                                                   ! bool()

   single_bool = transfer( r, single_bool)

return                                                     ! bool()

!  single_bool()

end function single_bool
   
! **********************************************************************

!  boolean = bool( logical)

elemental type( boolean_t) function logical_bool( l)

logical( kind= l_int_k), intent( in) :: l

!  logical_bool()

continue                                                   ! bool()

   logical_bool = transfer( l, logical_bool)

return                                                     ! bool()

!  logical_bool()

end function logical_bool
   
! **********************************************************************

!  boolean = bool( character*csu_per_nsu)

elemental type( boolean_t) function char_bool( c)

character( len= csu_per_nsu, kind= ascii_k), intent( in) :: c

!  char_bool()

continue                                                   ! bool()

   char_bool = transfer( c, char_bool)

return                                                     ! bool()

!  char_bool()

end function char_bool

! **********************************************************************

!  int = int( boolean)

elemental integer( kind= int_k) function boolean_int( b)

type( boolean_t), intent( in) :: b

!  boolean_int

continue                                                   ! int()

   boolean_int = transfer( b, boolean_int)

return                                                     ! int()

!  boolean_int()

end function boolean_int

! **********************************************************************

!  single = real( boolean)

elemental real( kind= single_k) function boolean_real( b)

type( boolean_t), intent( in) :: b

!  boolean_real()

continue                                                   ! real()

   boolean_real = transfer( b, boolean_real)

return                                                     ! real()

!  boolean_real()

end function boolean_real

! **********************************************************************

!  speed = logical( boolean)

elemental logical( kind= l_int_k) function boolean_logical( b)

type( boolean_t), intent( in) :: b

!  boolean_logical()

continue                                                   ! logical()

   boolean_logical = transfer( b, boolean_logical)

return                                                     ! logical()

!  boolean_logical()

end function boolean_logical

! **********************************************************************

!  character*csu_per_nsu = char( boolean)

elemental character( len= csu_per_nsu, kind= ascii_k) function boolean_char( b)

type( boolean_t), intent( in) :: b

!  boolean_char()

continue                                                   ! char()

   boolean_char = transfer( b, boolean_char)

return                                                     ! char()

!  boolean_char()

end function boolean_char

! **********************************************************************

!  unary operators: +, -

! **********************************************************************

!  boolean_plus(): +b

elemental type( boolean_t) function boolean_plus( b)

type( boolean_t), intent( in) :: b

!  boolean_plus()

continue                                                   ! + b

   boolean_plus% bits = +b% bits

return                                                     ! + b

!  boolean_plus()

end function boolean_plus

! **********************************************************************

!  boolean_minus(): -b

elemental type( boolean_t) function boolean_minus( b)

type( boolean_t), intent( in) :: b

!  boolean_minus()

continue                                                   ! - b

   boolean_minus% bits = -b% bits

return                                                     ! - b

!  boolean_minus()

end function boolean_minus

! **********************************************************************

!  operators and functions: .and., .or., .eor., .not., compl(), csmg()

! **********************************************************************

!  b1 .and. b2

elemental type( boolean_t) function boolean_and( b1, b2)

type( boolean_t), intent( in) :: b1, b2

!  boolean_and()

continue                                                   ! b .and. b

   boolean_and% bits = iand( b1% bits, b2% bits)

return                                                     ! b .and. b

!  boolean_and()

end function boolean_and

! **********************************************************************

!  b1 .or. b2

elemental type( boolean_t) function boolean_or( b1, b2)

type( boolean_t), intent( in) :: b1, b2

!  boolean_or()

continue                                                   ! b .or. b

   boolean_or% bits = ior( b1% bits, b2% bits)

return                                                     ! b .or. b

!  boolean_or()

end function boolean_or

! **********************************************************************

!  b1 .eor. b2

elemental type( boolean_t) function boolean_eor( b1, b2)

type( boolean_t), intent( in) :: b1, b2

!  boolean_eor()

continue                                                   ! b .eor. b

   boolean_eor% bits = ieor( b1% bits, b2% bits)

return                                                     ! b .eor. b

!  boolean_eor()

end function boolean_eor

! **********************************************************************

!  .not. b

elemental type( boolean_t) function boolean_not( b)

type( boolean_t), intent( in) :: b

!  boolean_not()

continue                                                   ! .not. b

   boolean_not% bits = not( b% bits)

return                                                     ! .not. b

!  boolean_not()

end function boolean_not

! **********************************************************************

!  boolean = compl( boolean)

elemental type( boolean_t) function boolean_compl( i)

type( boolean_t), intent( in) :: i

!  boolean_compl()

continue                                                   ! compl()

   boolean_compl% bits = not( i% bits)

return                                                     ! compl()

!  boolean_compl()

end function boolean_compl

! **********************************************************************

!  boolean = csmg( boolean, boolean, boolean)

elemental type( boolean_t) function boolean_csmg( i, j, k)

type( boolean_t), intent( in) :: i, j, k

!  boolean_csmg()

continue                                                   ! csmg()

   boolean_csmg% bits = ior( iand( i% bits, k% bits), iand( j% bits, not( k% bits)) )

return                                                     ! csmg()

!  boolean_csmg()

end function boolean_csmg

! **********************************************************************

!  bit-wise operators: .xor., .eqv., .neqv.

! **********************************************************************

!  b1 .xor. b2

elemental type( boolean_t) function boolean_xor( b1, b2)

type( boolean_t), intent( in) :: b1, b2

!  boolean_xor()

continue                                                   ! b .xor. b

   boolean_xor% bits = ieor( b1% bits, b2% bits)

return                                                     ! b .xor. b

!  boolean_xor()

end function boolean_xor

! **********************************************************************

!  b1 .eqv. b2

elemental type( boolean_t) function boolean_eqv( b1, b2)

type( boolean_t), intent( in) :: b1, b2

!  boolean_eqv()

continue                                                   ! b .eqv. b

   boolean_eqv% bits = not( ieor( b1% bits, b2% bits) )

return                                                     ! b .eqv. b

!  boolean_eqv()

end function boolean_eqv

! **********************************************************************

!  b1 .neqv. b2

elemental type( boolean_t) function boolean_neqv( b1, b2)

type( boolean_t), intent( in) :: b1, b2

!  boolean_neqv()

continue                                                   ! b .neqv. b

   boolean_neqv% bits = ieor( b1% bits, b2% bits)

return                                                     ! b .neqv. b

!  boolean_neqv()

end function boolean_neqv

! **********************************************************************

!  logical operators: .eq., .ne., .ge., .gt., .le., .lt.

! **********************************************************************

!  b1 == b2

elemental logical function boolean_eq( b1, b2)

type( boolean_t), intent( in) :: b1, b2

!  boolean_eq()

continue                                                   ! b == b

   boolean_eq = b1% bits == b2% bits

return                                                     ! b == b

!  boolean_eq()

end function boolean_eq

! **********************************************************************

!  b1 /= b2

elemental logical function boolean_ne( b1, b2)

type( boolean_t), intent( in) :: b1, b2

!  boolean_ne()

continue                                                   ! b /= b

   boolean_ne = b1% bits /= b2% bits

return                                                     ! b /= b

!  boolean_ne()

end function boolean_ne

! **********************************************************************

!  b1 >= b2

elemental logical function boolean_ge( b1, b2)

type( boolean_t), intent( in) :: b1, b2

!  boolean_ge()

continue                                                   ! b >= b

   boolean_ge = b1% bits >= b2% bits

return                                                     ! b >= b

!  boolean_ge()

end function boolean_ge

! **********************************************************************

!  b1 > b2

elemental logical function boolean_gt( b1, b2)

type( boolean_t), intent( in) :: b1, b2

!  boolean_gt()

continue                                                   ! b > b

   boolean_gt = b1% bits > b2% bits

return                                                     ! b > b

!  boolean_gt()

end function boolean_gt

! **********************************************************************

!  b1 <= b2

elemental logical function boolean_le( b1, b2)

type( boolean_t), intent( in) :: b1, b2

!  boolean_le()

continue                                                   ! b <= b

   boolean_le = b1% bits <= b2% bits

return                                                     ! b <= b

!  boolean_le()

end function boolean_le

! **********************************************************************

!  b1 < b2

elemental logical function boolean_lt( b1, b2)

type( boolean_t), intent( in) :: b1, b2

!  boolean_lt()

continue                                                   ! b < b

   boolean_lt = b1% bits < b2% bits

return                                                     ! b < b

!  boolean_lt()

end function boolean_lt

! **********************************************************************

!  operators: +, -, *, /

! **********************************************************************

!  b1 + b2

elemental type( boolean_t) function boolean_add( b1, b2)

type( boolean_t), intent( in) :: b1, b2

!  boolean_add()

continue                                                   ! b + b

   boolean_add% bits = b1% bits + b2% bits

return                                                     ! b + b

!  boolean_add()

end function boolean_add

! **********************************************************************

!  b1 - b2

elemental type( boolean_t) function boolean_sub( b1, b2)

type( boolean_t), intent( in) :: b1, b2

!  boolean_sub()

continue                                                   ! b - b

   boolean_sub% bits = b1% bits - b2% bits

return                                                     ! b - b

!  boolean_sub()

end function boolean_sub

! **********************************************************************

!  b1 * b2

elemental type( boolean_t) function boolean_mul( b1, b2)

type( boolean_t), intent( in) :: b1, b2

!  boolean_mul()

continue                                                   ! b * b

   boolean_mul% bits = b1% bits * b2% bits

return                                                     ! b * b

!  boolean_mul()

end function boolean_mul

! **********************************************************************

!  b1 / b2

elemental type( boolean_t) function boolean_div( b1, b2)

type( boolean_t), intent( in) :: b1, b2

!  boolean_div()

continue                                                   ! b / b

   boolean_div% bits = b1% bits / b2% bits

return                                                     ! b / b

!  boolean_div()

end function boolean_div

! **********************************************************************

!  bit counts: leadz(), lastz(), popcnt(), poppar()

! **********************************************************************

!  leadz( b)

elemental integer function boolean_leadz( b)

type( boolean_t), intent( in) :: b

!  scratch data and masks

   integer( kind= int_k) :: test, at_least

!  boolean_leadz()

continue                                                   ! leadz()

   test = b% bits

   if( test == 0_int_k )then                               ! catch end case
      boolean_leadz = bit_size( 0_int_k)
      return
   endif

   if( iand( lead_probe16, test) == 0_int_k )then          ! top half all zero
      at_least = 16
   else
      at_least = 0
      test = iand( lead_probe16, test)
   endif

   if( iand( lead_probe8, test) == 0_int_k )then           ! top quarter all zero
      at_least = at_least + 8
   else
      test = iand( lead_probe8, test)
   endif

   if( iand( lead_probe4, test) == 0_int_k )then           ! top eighth all zero
      at_least = at_least + 4
   else
      test = iand( lead_probe4, test)
   endif

   if( iand( lead_probe2, test) == 0_int_k )then           ! top sixteenth all zero
      at_least = at_least + 2
   else
      test = iand( lead_probe2, test)
   endif

   if( iand( lead_probe1, test) == 0_int_k )then           ! top bit zero
      at_least = at_least + 1
   endif

   boolean_leadz = at_least

return                                                     ! leadz()

!  boolean_leadz()

end function boolean_leadz

! **********************************************************************

!  lastz( b)

elemental integer function boolean_lastz( b)

type( boolean_t), intent( in) :: b

!  scratch data and masks

   integer( kind= int_k) :: test, at_least

!  boolean_lastz()

continue                                                   ! lastz()

   test = b% bits                                           ! operate on integer

   if( test == 0_int_k )then                               ! catch end case now
      boolean_lastz = bit_size( 0_int_k)
      return
   endif

   if( iand( last_probe16, test) == 0_int_k )then          ! bottom half all zero
      at_least = 16
   else
      at_least = 0
      test = iand( last_probe16, test)
   endif

   if( iand( last_probe8, test) == 0_int_k )then           ! bottom quarter all zero
      at_least = at_least + 8
   else
      test = iand( last_probe8, test)
   endif

   if( iand( last_probe4, test) == 0_int_k )then           ! bottom eighth all zero
      at_least = at_least + 4
   else
      test = iand( last_probe4, test)
   endif

   if( iand( last_probe2, test) == 0_int_k )then           ! bottom sixteenth all zero
      at_least = at_least + 2
   else
      test = iand( last_probe2, test)
   endif

   if( iand( last_probe1, test) == 0_int_k )then           ! bottom bit zero
      at_least = at_least + 1
   endif

   boolean_lastz = at_least

return                                                     ! lastz()

!  boolean_lastz()

end function boolean_lastz

! **********************************************************************

!  popcnt( b)

elemental integer function boolean_popcnt( b)

type( boolean_t), intent( in) :: b

!  scratch data and masks

   integer( kind= int_k) :: test, t1, t2, t4, t8

!  boolean_popcnt()

continue                                                   ! popcnt()

   test = b% bits                                           ! operate on integer

   t1 = iand( test, p1)                                    ! 1 bit from each nibble
   t2 = iand( test, p2)
   t4 = iand( test, p4)
   t8 = iand( test, p8)

   test = t1 + ishft( t2, -1) + ishft( t4, -2) + ishft( t8, -3)

! each nibble now contains [ 0, 1, 2, 3]

   t1 = iand( test, hi_nibble)
   t2 = iand( test, lo_nibble)

! add each of 4 high nibbles with each of 4 low nibbles

   test = iand( ishft( t1, -4) + t2, lo_nibble)

! add each of 4 bytes & mask off low byte

   test = test + ishft( test, -8) + ishft( test, -16) + ishft( test, -24)

   boolean_popcnt = iand( test, low_byte)

return                                                     ! popcnt()

!  boolean_popcnt()

end function boolean_popcnt

! **********************************************************************

!  poppar( b)

elemental integer function boolean_poppar( b)

type( boolean_t), intent( in) :: b

!  local data

   integer( kind= int_k) :: test, t1, t2, t4, t8

!  boolean_poppar()

continue                                                   ! poppar()

   test = b% bits                                           ! operate on integer

   t1 = iand( test, p1)                                    ! 1 bit from each nibble
   t2 = iand( test, p2)
   t4 = iand( test, p4)
   t8 = iand( test, p8)

   test = t1 + ishft( t2, -1) + ishft( t4, -2) + ishft( t8, -3)

   t1 = iand( test, hi_nibble)
   t2 = iand( test, lo_nibble)
   test = iand( ishft( t1, -4) + t2, lo_nibble)
   test = test + ishft( test, -8) + ishft( test, -16) + ishft( test, -24)

   boolean_poppar = iand( test, low_bit)

return                                                     ! poppar()

!  boolean_poppar()

end function boolean_poppar

! **********************************************************************

!  .hamd. hamming distance

elemental integer function boolean_hamd( b1, b2)

type( boolean_t), intent( in) :: b1, b2

!  boolean_hamd()

continue                                                   ! b .hamd. b

   boolean_hamd = popcnt( bool( ieor( b1% bits, b2% bits)))

return                                                     ! b .hamd. b

!  boolean_hamd()

end function boolean_hamd

! **********************************************************************

!  .shift. shift operator

elemental integer function boolean_shift( b, i)

type( boolean_t), intent( in) :: b

integer( kind= int_k), intent( in) :: i

!  boolean_shift()

continue                                                   ! b .shift. b

   boolean_shift = ishft( b% bits, i)

return                                                     ! b .shift. b

!  boolean_shift()

end function boolean_shift

! **********************************************************************

!  .rotate. rotate operator

elemental integer function boolean_rotate( b, i)

type( boolean_t), intent( in) :: b

integer( kind= int_k), intent( in) :: i

!  boolean_rotate()

continue                                                   ! b .rotate. b

   boolean_rotate = ishftc( b% bits, i)

return                                                     ! b .rotate. b

!  boolean_rotate()

end function boolean_rotate

! **********************************************************************

!  masks: mask(), maskl(), maskr()

! **********************************************************************

!  mask( i)

elemental type( boolean_t) function boolean_mask( i)

integer( kind= int_k), intent( in) :: i

!  boolean_mask() local

   integer, parameter :: bs = bit_size( i)

!  boolean_mask()

continue                                                   ! mask()

   bits: select case( i)

   case( 1: bs) bits                                       ! [ 1, 32] ==> 00... 0011... 11

      boolean_mask% bits = right_mask( i)

   case( -bs: -1) bits                                     ! [ -32, -1] ==> 11... 1100... 00

      boolean_mask% bits = left_mask( abs( i))

   case default bits                                       ! otherwise 00... 00

      boolean_mask% bits = 0_int_k

   end select bits

return                                                     ! mask()

!  boolean_mask()

end function boolean_mask

! **********************************************************************

!  maskl( i)

elemental type( boolean_t) function boolean_maskl( i)

integer( kind= int_k), intent( in) :: i

!  boolean_maskl() local

   integer, parameter :: bs = bit_size( i)

!  boolean_maskl()

continue                                                   ! maskl()

   bits: select case( i)

   case( 1: bs) bits                                       ! [ 1, 32] ==> 11... 1100... 00

      boolean_maskl% bits = left_mask( i)

   case default bits                                       ! otherwise 00... 00

      boolean_maskl% bits = 0_int_k

   end select bits

return                                                     ! maskl()

!  boolean_maskl()

end function boolean_maskl

! **********************************************************************

!  boolean_maskr( i)

elemental type( boolean_t) function boolean_maskr( i)

integer( kind= int_k), intent( in) :: i

!  boolean_maskr() local

   integer, parameter :: bs = bit_size( i)

!  boolean_maskr()

continue                                                   ! maskr()

   bits: select case( i)

   case( 1: bs) bits                                       ! [ 1, 32] ==> 00... 0011... 11

      boolean_maskr% bits = right_mask( i)

   case default bits                                       ! otherwise 00... 00

      boolean_maskr% bits = 0_int_k

   end select bits

return                                                     ! maskr()

!  boolean_maskr()

end function boolean_maskr

! **********************************************************************

!  shifts: ishft(), ishftc(), dshftl(), dshftr(), dshftc()

! **********************************************************************

!  ishft( b, i)

elemental type( boolean_t) function boolean_ishft( b, i)

type( boolean_t), intent( in) :: b

integer( kind= int_k), intent( in) :: i

!  boolean_ishft()

continue                                         ! ishft()

   boolean_ishft% bits = ishft( b% bits, i)

return                                           ! ishft()

!  boolean_ishft()

end function boolean_ishft

! **********************************************************************

!  ishftc( b, i1, i2)

elemental type( boolean_t) function boolean_ishftc( b, i1, i2)

type( boolean_t), intent( in) :: b

integer( kind= int_k), intent( in) :: i1, i2

!  boolean_ishftc()

continue                                         ! ishftc()

   boolean_ishftc% bits = ishftc( b% bits, i1, i2)

return                                           ! ishftc()

!  boolean_ishftc()

end function boolean_ishftc

! **********************************************************************

!  dshftl( bl, br, i)

elemental type( boolean_t) function boolean_dshftl( bl, br, i)

type( boolean_t), intent( in) :: bl, br

integer( kind= int_k), intent( in) :: i

!  local data

   type( boolean_t) :: btl, btr

!  boolean_dshftl()

continue                                         ! dshftl()

!  trap out endcase

   if( i < 0 )then
      boolean_dshftl% bits = 0_int_k
      return

   elseif( i == 0 )then
      boolean_dshftl% bits = bl% bits
      return

   endif

   if( i < bit_size( i) )then                    ! if shift within one int
      btl% bits = ishft( bl% bits, i)
      btr% bits = ishft( br% bits, i - bit_size( i))

      boolean_dshftl% bits = ior( btl% bits, btr% bits)

   elseif( i == bit_size( i) )then               ! shift is exactly one int
      boolean_dshftl% bits = br% bits

   else                                          ! if shift out of range
      boolean_dshftl% bits = 0_int_k
   endif

return                                           ! dshftl()

!  boolean_dshftl()

end function boolean_dshftl

! **********************************************************************

!  dshftr( bl, br, i)

elemental type( boolean_t) function boolean_dshftr( bl, br, i)

type( boolean_t), intent( in) :: bl, br

integer( kind= int_k), intent( in) :: i

!  local data

   type( boolean_t) :: btl, btr

!  boolean_dshftr()

continue                                         ! dshftr()

!  trap out endcase

   if( i < 0 )then
      boolean_dshftr% bits = 0_int_k
      return

   elseif( i == 0 )then
      boolean_dshftr% bits = br% bits
      return

   endif

   if( i < bit_size( i) )then                    ! if shift within one int
      btl% bits = ishft( bl% bits, bit_size( i) - i)
      btr% bits = ishft( br% bits, -i)

      boolean_dshftr% bits = ior( btl% bits, btr% bits)

   elseif( i == bit_size( i) )then               ! shift is exactly one int
      boolean_dshftr% bits = bl% bits

   else                                          ! if shift out of range
      boolean_dshftr% bits = 0_int_k
   endif

return                                           ! dshftr()

!  boolean_dshftr()

end function boolean_dshftr

! **********************************************************************

!  dshftc( bl, br, i)

elemental subroutine boolean_dshftc( bl, br, i)

type( boolean_t), intent( inout) :: bl, br

integer( kind= int_k), intent( in) :: i

!  local data

   type( boolean_t) :: btl, btr, carryl, carryr

   integer :: ia

!  boolean_dshftc()

continue                                         ! dshftc()

   ia = abs( i)

   if( ia > bit_size( i) ) return

   if( ia == bit_size( i) )then                  ! if exactly swapping words
      btl% bits = br% bits
      btr% bits = bl% bits

      bl% bits = btl% bits
      br% bits = btr% bits

   elseif( i<bit_size( i) .and. i>=1 )then       ! if i+ shift left
      carryl% bits = ishft( bl% bits, i - bit_size( i))
      carryr% bits = ishft( br% bits, i - bit_size( i))

      btl% bits = ishft( bl% bits, i)
      btr% bits = ishft( br% bits, i)

      bl% bits = ior( btl% bits, carryr% bits)
      br% bits = ior( btr% bits, carryl% bits)

   elseif( ia<bit_size( i) .and. ia>=1 )then     ! if i- shift right
      carryl% bits = ishft( bl% bits, bit_size( i) + i)
      carryr% bits = ishft( br% bits, bit_size( i) + i)

      btl% bits = ishft( bl% bits, i)
      btr% bits = ishft( br% bits, i)

      bl% bits = ior( btl% bits, carryr% bits)
      br% bits = ior( btr% bits, carryl% bits)

   endif                                         ! else do nothing

return                                           ! dshftc()

!  boolean_dshftc()

end subroutine boolean_dshftc

! **********************************************************************

!  mil std bit functions

! **********************************************************************

!  boolean ibset

elemental type( boolean_t) function boolean_ibset(b, i)

type( boolean_t), intent( in) :: b

integer( kind= int_k), intent( in) :: i

!  boolean_ibset()

continue                                        ! ibset()

   boolean_ibset% bits = ibset( b% bits, i)

return                                          ! ibset()

!  boolean_ibset()

end function boolean_ibset

! **********************************************************************

!  boolean ibclr

elemental type( boolean_t) function boolean_ibclr(b, i)

type( boolean_t), intent( in) :: b

integer( kind= int_k), intent( in) :: i

!  boolean_ibclr()

continue                                        ! ibclr()

   boolean_ibclr% bits = ibclr( b% bits, i)

return                                          ! ibclr()

!  boolean_ibclr()

end function boolean_ibclr

! **********************************************************************

!  boolean btest

elemental logical function boolean_btest(b, i)

type( boolean_t), intent( in) :: b

integer( kind= int_k), intent( in) :: i

!  boolean_btest()

continue                                        ! btest()

   boolean_btest = btest( b% bits, i)

return                                          ! btest()

!  boolean_btest()

end function boolean_btest

! **********************************************************************

!  boolean bztest

elemental logical function boolean_bztest(b, i)

type( boolean_t), intent( in) :: b

integer( kind= int_k), intent( in) :: i

!  boolean_bztest() local

   integer, parameter :: bit = 1

!  boolean_bztest()

continue                                        ! bztest()

   boolean_bztest = iand( ishft( bit, i), b% bits) == 0

return                                          ! bztest()

!  boolean_bztest()

end function boolean_bztest

! **********************************************************************

!  boolean mvbits

elemental subroutine boolean_mvbits(b1, i, l, b2, j)

type( boolean_t), intent( in) :: b1

integer( kind= int_k), intent( in) :: i, l, j

type( boolean_t), intent( out) :: b2

!  boolean_mvbits()

continue                                        ! mvbits()

   call mvbits( b1% bits, i, l, b2% bits, j)

return                                          ! mvbits()

!  boolean_mvbits()

end subroutine boolean_mvbits

! **********************************************************************

!  boolean_ibits

elemental type( boolean_t) function boolean_ibits( b, i, l)

type( boolean_t), intent( in) :: b

integer( kind= int_k), intent( in) :: i, l

!  boolean_ibits()

continue                                        ! ibits()

   boolean_ibits% bits = ibits( b% bits, i, l)

return                                          ! ibits()

!  boolean_ibits()

end function boolean_ibits

! **********************************************************************

!  rev_endian() for type boolean

! **********************************************************************

!  boolean_rev_endian()

elemental type( boolean_t) function boolean_rev_endian( a)

type( boolean_t), intent( in) :: a

!  boolean_rev_endian() local

   integer, parameter :: num_bytes = bit_size( a% bits) / bit_size( 0_byte_k)

   integer( kind= byte_k), dimension( num_bytes) :: tmp

!  boolean_rev_endian()

continue                                                   ! rev_endian()

   tmp = transfer( a, tmp)

   tmp( 1: num_bytes) = tmp( num_bytes: 1: -1)             ! reverse

   boolean_rev_endian = transfer( tmp, boolean_rev_endian)

return                                                     ! rev_endian()

!  boolean_rev_endian()

end function boolean_rev_endian

! **********************************************************************

!  bit_size() for type boolean

! **********************************************************************

!  boolean_bit_size()

elemental integer function boolean_bit_size( b)

type( boolean_t), intent( in) :: b

!  boolean_bit_size()

continue                                         ! bit_size()

   boolean_bit_size = bit_size( b% bits)

return                                           ! bit_size()

!  boolean_bit_size()

end function boolean_bit_size

! **********************************************************************

!  boolean_swap()

elemental subroutine boolean_swap( a, b)

type( boolean_t), intent( inout) :: a, b

!  int_swap() local

   type( boolean_t) :: t1, t2

!  int_swap()

continue                                         ! swap()

   t1 = a

   t2 = b

   b = t1

   a = t2

return                                           ! swap()

!  boolean_swap()

end subroutine boolean_swap

! **********************************************************************

!  type_boolean

! **********************************************************************
! $Id: typebool.f90 1.8 2000/07/03 13:21:54Z Dan Release $

end module                                       ! eof