SUBROUTINE motble(string, lenn, numpar, qaddtv, emxmod, emnmod,
     &                  filenm, modlnm, qmerr, ierr)

      IMPLICIT NONE

      INTEGER lenn, ierr, newfil
      INTEGER numpar

      REAL emxmod, emnmod

      CHARACTER*(*) string

      LOGICAL qaddtv, qmerr

      CHARACTER*(*) filenm, modlnm

c Model routine for the table models. This gets the filename to be used and 
c extracts from it model information.

c  string	c*	i/r:parse string
c  lenn		i	i/r:parse position
c  numpar	i	r:no. of parameters
c  qaddtv	l	i:if true additive table, otherwise multiplicative.
c  emxmod	r	r:max energy for model
c  emnmod	r	r:min energy for model
c  filenm       c*      r:table model filename
c  modlnm       c*      r:table model name
c  qmerr	l	i:if true model errors were included in table file
c  ierr		i	r:error flag - <>0 is error

c  10/2/94  kaa      modification to use FITS format files

      INCLUDE '../../inc/xspec.inc'

      INTEGER iqarr
      INTEGER idesc, ilun, index
      INTEGER nret, iflag, idelim, lenact
      INTEGER nenerg, nintpm, naddpm

      CHARACTER*23 desc(2)
      CHARACTER*72 comment, contxt
      CHARACTER*255 wrtstr

      LOGICAL qend, qanyf, qrshft, qfladd

      DATA desc/'Add. Model filename', 'Mul. Model filename'/

c  Extract the filename from the parse string.

      IF (qaddtv) THEN
         idesc = 1
      ELSE
         idesc = 2
      ENDIF

      qend = .FALSE.
      DO WHILE (.NOT.qend)

         CALL xgtstr(string, lenn, 1, desc(idesc), 1, filenm, nret,
     &               iflag, idelim)

c  if a filename was given then try to open it

         IF (nret.EQ.1) THEN
            WRITE (wrtstr, '(3a)') desc(idesc), ' : ', 
     &                             filenm(:lenact(filenm))
            CALL xwrite(wrtstr, 15)
            CALL getlun(ilun)
            CALL xsftop(ilun, filenm, 0, index, ierr)
            IF (ierr.NE.0) THEN
               WRITE (wrtstr, '(3a,i5)') 
     &             'Failed to open file ', filenm(:lenact(filenm)),
     &             ': fitsio error= ', ierr
               CALL xwrite(wrtstr, 10)
               CALL frelun(ilun)
            ELSE
               qend = .TRUE.
            ENDIF
         ENDIF

c  if no file has been successfully read then prompt for a replacement.

         IF (.NOT.qend) THEN
            ierr = newfil('model',filenm(:lenact(filenm)),' ',string)
            lenn = 0
            IF ( ierr .NE. 0 ) RETURN
            IF ( string(:lenact(string)) .EQ. 'none' ) THEN
               ierr = -1
               RETURN
            ENDIF
         ENDIF

      ENDDO

c read the model name (in the primary header)

      CALL ftgkys(ilun, 'MODLNAME', modlnm, comment, ierr)
      contxt = 'Failed to read MODLNAME keyword'
      IF ( ierr .NE. 0 ) GOTO 100

c read the keyword that flags whether a redshift parameter
c is required

      CALL ftgkyl(ilun, 'REDSHIFT', qrshft, comment, ierr)
      contxt = 'Failed to read REDSHIFT keyword'
      IF ( ierr .NE. 0 ) GOTO 100

c read the keyword that flags whether the file contains an additive
c or multiplicative model. If it is the wrong type then write a warning.

      CALL ftgkyl(ilun, 'ADDMODEL', qfladd, comment, ierr)
      contxt = 'Failed to read ADDMODEL keyword'
      IF ( ierr .NE. 0 ) GOTO 100

      IF ( qaddtv .AND. .NOT.qfladd ) THEN
         CALL xwrite(
     &    ' Warning : this file contains a multiplicative model', 10)
      ELSEIF ( .NOT.qaddtv .AND. qfladd ) THEN
         CALL xwrite(
     &    ' Warning : this file contains an additive model', 10)
      ENDIF         

c go to the parameter definition extension

      CALL ftmahd(ilun, 2, index, ierr)
      contxt = 'Failed to go to first extension'
      IF ( ierr .NE. 0 ) GOTO 100

c get the number of parameters

      CALL ftgkyj(ilun, 'NINTPARM', nintpm, comment, ierr)
      contxt = 'Failed to read NINTPARM keyword'
      IF ( ierr .NE. 0 ) GOTO 100

      CALL ftgkyj(ilun, 'NADDPARM', naddpm, comment, ierr)
      contxt = 'Failed to read NADDPARM keyword'
      IF ( ierr .NE. 0 ) GOTO 100

      numpar = nintpm + naddpm
      IF ( qrshft ) numpar = numpar + 1

c go to the second extension to read the low and high energies over which
c the model is tabulated

      CALL ftmahd(ilun, 3, index, ierr)
      contxt = 'Failed to go to second extension'
      IF ( ierr .NE. 0 ) GOTO 100

c get the number of energies

      CALL ftgkyj(ilun, 'NAXIS2', nenerg, comment, ierr)
      contxt = 'Failed to read the NAXIS2 keyword'
      IF ( ierr .NE. 0 ) GOTO 100

c and the first and last energies

      CALL ftgcve(ilun, 1, 1, 1, 1, 0., emnmod, qanyf, ierr)
      contxt = 'Failed to read the first energy'
      IF ( ierr .NE. 0 ) GOTO 100

      CALL ftgcve(ilun, 2, nenerg, 1, 1, 0., emxmod, qanyf, ierr)
      contxt = 'Failed to read the last energy'
      IF ( ierr .NE. 0 ) GOTO 100

c go to the third extension to check whether there are errors attached
c to the model spectra

      CALL ftmahd(ilun, 4, index, ierr)
      contxt = 'Failed to go to third extension'
      IF ( ierr .NE. 0 ) GOTO 100

      iqarr = -1
      CALL udmget(naddpm+1, 1, iqarr, ierr)
      contxt = 'Failed to get memory for qarr'
      IF ( ierr .NE. 0 ) GOTO 100

      CALL merr_info(ilun, nenerg, naddpm, MEMB(iqarr), qmerr, ierr)
      contxt = 'Failed to get error information'
      IF ( ierr .NE. 0 ) GOTO 100

      CALL udmfre(iqarr, 1, ierr)
      contxt = 'Failed to free memory for qarr'
      IF ( ierr .NE. 0 ) GOTO 100

c close the file

      CALL ftclos(ilun, ierr)
      contxt = 'Failed to close the file'
      IF ( ierr .NE. 0 ) GOTO 100

 100  CONTINUE
      IF ( ierr .NE. 0 ) THEN
         WRITE(wrtstr,'(a,i5)') 'MOTBLE: FITSIO error number ', ierr
         CALL xwrite(wrtstr, 10)
         CALL xwrite(contxt, 10)
      ENDIF

      CALL frelun(ilun)

      RETURN
      END