setbits8 Function

public function setbits8(string) result(answer)

Arguments

Type IntentOptional Attributes Name
character(len=8), intent(in) :: string

Return Value integer(kind=int8)


Contents

Source Code


Source Code

function setbits8(string) result(answer)
integer(kind=int8)          :: answer
character(len=8),intent(in) :: string
integer                     :: pos
integer                     :: lgth
   answer=0_int8
   lgth=len(string)
   if(lgth /= bit_size(answer))then
      write(stderr,*)'*setbits8* wrong string length =',lgth
      lgth=min(lgth,int(bit_size(answer)))
   endif
   do pos=1,lgth
      select case(string(pos:pos))
       case('1')
         answer = ibset(answer, pos-1)
       case('0')
         answer = ibclr(answer, pos-1)
       case default
         write(stderr,*)'*setbits8* unknown value. must be 0 or 1. found [',string(pos:pos),'] at position ',pos,' in ',string
      end select
   enddo
end function setbits8