********************************************************************************
*                                                                              *
*  2DHF version 1-2003                                                         *
*  Copyright (C) 1996  Jacek Kobus, Leif Laaksonen, Dage Sundholm              *
*                                                                              *
*  This software may be used and distributed according to the terms            *
*  of the GNU General Public License, see README and COPYING.                  *
*                                                                              *
********************************************************************************
c ### inpa ###
c
c    This routine examines the contents of IA and extracts a
c    character string of 8 chars. This string is stored in IBUF.
c    The remaining non-blank characters (if any) are ignored.

      subroutine inpa(guf)
      implicit integer*4 (i-n)
      implicit real*8 (a-h,o-z)
      character*1 ia,iblnk,iall,ibuf
      character*8 ibufr,guf

      common/iochan/ iinp5,iinp11,iinp12,iinp13,iinp14,
     &               iout6,iout21,iout22,iout23,iout24
      common/work/jrec,jump,istrt(40),inumb(40),ia(80)
      dimension ibuf(8),iall(60)
      equivalence (ibuf(1),ibufr)

      data iblnk/' '/
      data iall/'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j',
     &          'k', 'l', 'm', 'n', 'o', 'p', 'q', 'r', 's', 't',
     &          'u', 'v', 'w', 'x', 'y', 'z', '-', '-', '-', ' ',
     &          'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J',
     &          'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T',
     &          'U', 'V', 'W', 'X', 'Y', 'Z', '-', '-', '-', ' '/

      do i=1,8
         ibuf(i)=iblnk
      enddo
      jrec = jrec + 1
      if(jrec .gt. jump) goto 11
      n = inumb(jrec)
      nstrt = istrt(jrec)
      if (n.gt.8) n=8
      do i = 1,n
         ibuf(i) = ia(nstrt)
         nstrt = nstrt + 1
      enddo

11    guf=ibufr

      return
      end