mat_base Subroutine

subroutine mat_base(x,base,eps,s,n)

! ident_16="@(#) M_matrix mat_base(3fp) store representation of x in s(1 n) using specified base"

doubleprecision            :: x
doubleprecision,intent(in) :: base
doubleprecision,intent(in) :: eps
doubleprecision            :: s(*)
integer                    :: n

doubleprecision :: t

integer      :: l
integer      :: j
integer      :: k
integer      :: m

   l = 1
   if (x .ge. 0.0d0)then
      s(l) = plus
   else
      s(l) = minus
   endif
   s(l+1) = zero
   s(l+2) = dot
   x = dabs(x)
   if (x .ne. 0.0d0) then
      k = dlog(x)/dlog(base)
   else
      k = 0
   endif
   if (x .gt. 1.0d0) k = k + 1
   x = x/base**k
   if (base*x .ge. base) k = k + 1
   if (base*x .ge. base) x = x/base
   if (eps .ne. 0.0d0)then
      m = (-1)*dlog(eps)/dlog(base) + 4
   else
      m = 54
   endif
   do l = 4, m
      x = base*x
      j = int(x)
      s(l) = dble(j)
      x = x - s(l)
      s(l)=s(l)+48
   enddo
   s(m+1) = comma
   if (k .ge. 0) s(m+2) = plus
   if (k .lt. 0) s(m+2) = minus
   t = dabs(dble(k))
   n = m + 3
   if (t .ge. base) n = n + int(dlog(t)/dlog(base))
   l = n
   INFINITE: do
      j = int(dmod(t,base))
      s(l) = dble(j+48)
      l = l - 1
      t = t/base
      if (l .lt. m+3) exit
   enddo INFINITE
end subroutine mat_base