setbits32 Function

public function setbits32(string) result(answer)

Arguments

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

Return Value integer(kind=int32)


Contents

Source Code


Source Code

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