setbits16 Function

function setbits16(string) result(answer)
integer(kind=int16)          :: answer
character(len=16),intent(in) :: string
integer                      :: pos
integer                      :: lgth
   answer=0_int16
   lgth=len(string)
   if(lgth /= bit_size(answer))then
      write(stderr,*)'*setbits16* 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,*)'*setbits16* unknown value. must be 0 or 1. found [',string(pos:pos),'] at position ',pos,' in ',string
      end select
   enddo
end function setbits16