@RonShepard and any other readers interested in something like this,
Please consider working with stdlib and introducing some general facilities in there that all the Fortran practitioners can make use of.
Also, avoid copying data as much as possible in such a facility.
In addition to the bitsets module I suggested upthread, if something additional is required for a specific need, here is another custom type to consider as merely a crude starting point. Based on a “NY minute” worth of thought, methinks the fields in such a “bucket” should be the length of a colloquial “byte” i.e., 8 bits. Further insight might change this thinking. Anyways, here it is: how is it for the “best” Fortran has to offer, does this pass muster?
! File p.f90
module bitbucket_m
use, intrinsic :: iso_c_binding, only : I1 => c_int8_t, I4 => c_int32_t, I8 => c_int64_t, c_loc, &
c_f_pointer
private
type, public :: bitbucket_t
! Field of 8-bit integers
private
integer(I1) :: m_fields(8) = 0_i1
contains
private
procedure, pass(this) :: zap_fields
procedure, pass(this), public :: int32 => get_int32
procedure, pass(this), public :: int64 => get_int64
generic, public :: zap => zap_fields
end type bitbucket_t
type :: pos_t
integer :: pos = 0
end type
type(pos_t), public, parameter :: POS0 = pos_t()
type(pos_t), public, parameter :: POS32 = pos_t( pos=32 )
contains
subroutine zap_fields( this, idx )
! Argument list
class(bitbucket_t), intent(inout) :: this
integer, intent(in) :: idx(:)
! Local variable
this%m_fields( idx ) = 0_i1
return
end subroutine zap_fields
function get_int32( this, pos ) result(pvals)
! Argument list
class(bitbucket_t), intent(in), target :: this
type(pos_t), intent(in) :: pos
! Function result
integer(I4), pointer :: pvals
pvals => null()
select case ( pos%pos )
case ( 0 )
call c_f_pointer( cptr=c_loc(this%m_fields(1)), fptr=pvals )
case ( 32 )
call c_f_pointer( cptr=c_loc(this%m_fields(3)), fptr=pvals )
end select
return
end function get_int32
function get_int64( this ) result(pval)
! Argument list
class(bitbucket_t), intent(in), target :: this
! Function result
integer(I8), pointer :: pval
call c_f_pointer( cptr=c_loc(this%m_fields), fptr=pval )
return
end function get_int64
end module
use, intrinsic :: iso_fortran_env, only : int32, int64
block
integer(int32) :: i32
integer(int64) :: i64
print *, "Block 1: using copy assignment with a type conversion function"
i32 = -123456
i64 = bit32_to_64( i32 )
print "(*(g0))", "i32 = ", i32
print "(*(g0))", "i64 = ", i64
print "(g0,b0)", "i32 (bit pattern): ", i32
print "(g0,b64)","i64 (bit pattern): ", i64
end block
print *
block
use bitbucket_m, only : bitbucket_t, POS0
type(bitbucket_t) :: bucket
print *, "Block 2: using a custom type"
bucket%int32( POS0 ) = -123456
print "(*(g0))", "bucket%int32( POS0 ) = ", bucket%int32( POS0 )
print "(*(g0))", "bucket%int64() = ", bucket%int64()
print "(g0,b0)", "bucket%int32( POS0 ) (bit pattern): ", bucket%int32( POS0 )
print "(g0,b64)","bucket%int64() (bit pattern): ", bucket%int64()
end block
contains
! copy an int32 to the first 32 bits of an int64
elemental integer(int64) function bit32_to_64(i32) result(i64)
integer(int32), intent(in) :: i32
integer :: bit
i64 = 0
do bit=0,31
i64 = merge(ibset(i64,bit),ibclr(i64,bit),btest(i32,bit))
end do
end function
end
C:\temp>gfortran -Wall p.f90 -o p.exe
C:\temp>p.exe
Block 1: using copy assignment with a type conversion function
i32 = -123456
i64 = 4294843840
i32 (bit pattern): 11111111111111100001110111000000
i64 (bit pattern): 11111111111111100001110111000000
Block 2: using a custom type
bucket%int32( POS0 ) = -123456
bucket%int64() = 4294843840
bucket%int32( POS0 ) (bit pattern): 11111111111111100001110111000000
bucket%int64() (bit pattern): 11111111111111100001110111000000
C:\temp>