       SUBROUTINE rdneiaped(iocont, ioline, nmtval, nmions, ncont, 
     &                      npseudo, nlines, tval, cont, cenerg,
     &                      conEl, conIon, conpt, consiz, pseudo, 
     &                      penerg, psupt, psusiz, lineE, lineEm, 
     &                      lineEl, lineIon, linpt, linsiz, status)

       INTEGER nmtval, nmions, ncont, npseudo, nlines

       REAL tval(nmtval), cont(ncont), cenerg(ncont)
       REAL pseudo(npseudo), penerg(npseudo)
       REAL lineE(nlines), lineEm(nlines)

       INTEGER conpt(nmions, nmtval), consiz(nmions, nmtval)
       INTEGER psupt(nmions, nmtval), psusiz(nmions, nmtval)
       INTEGER conEl(nmions, nmtval), conIon(nmions, nmtval)
       INTEGER lineEl(nlines), lineIon(nlines), linpt(nmtval)
       INTEGER linsiz(nmtval)

       INTEGER iocont, ioline, status

C Subroutine to actually read the data from the APED style files. This
C routine assumes that the files are opened and pointed at the primary
C HDU.
C Arguments :
C       iocont    I       i: I/O channel for continuum file
C       ioline    I       i: I/O channel for line file
C       nmtval    I       i: number of tabulated temperatures
C       nmions    I       i: number of tabulated ions
C       ncont     I       i: Total number of continuum bins
C       npseudo   I       i: Total number of pseudo-continuum bins
C       nlines    I       i: Total number of lines
C       tval      R       r: tabulated temperatures
C       cont      R       r: Tabulated continua
C       cenerg    R       r: Energies for tabulated continua
c       conEl     I       r: Atomic number for tabulated continuum and pseudo
c       conIon    I       r: Ion stage for tabulated continuum and pseudo
C       conpt     I       r: Offsets in the cont array for each ion and kT
C       consiz    I       r: Sizes in the cont array for each ion and kT
C       pseudo    R       r: Tabulated pseudo-continua
C       penerg    R       r: Energies for tabulated pseudo-continua
C       psupt     I       r: Offsets in the pseudo array for each ion and kT
C       psusiz    I       r: Sizes in the pseudo array for each ion and kT
C       lineE     R       r: Tabulated line energies
C       lineEm    R       r: Tabulated line emissivities
C       lineEl    I       r: Tabulated line elements
c       lineIon   I       r: Tabulated line ions
C       linpt     I       r: Offsets in the line arrays for each kT
C       linsiz    I       r: Sizes in the line arrays for each kT
C       status    I       r: Error status (0==OK)

      REAL keVtoA, KeVtoK
      PARAMETER(keVtoA=12.39854,keVtoK=1.1604505e7)

      INTEGER itemp, irow, nread, i, hdutyp, nrows
      INTEGER iptc, iptp, iptl, icol(8)

      LOGICAL qanyf

      CHARACTER comment*72, contxt*72, extnam*10
      CHARACTER contch(8)*10, linech(4)*10

      DATA contch /'N_Cont', 'E_Cont', 'Continuum', 'N_Pseudo',
     &             'E_Pseudo', 'Pseudo', 'Z', 'rmJ' /
      DATA linech /'Lambda', 'Epsilon', 'Element', 'Ion'/


C First do the continuum file. Loop round the relevant extensions

      iptc = 1
      iptp = 1
      itemp = 0

      CALL ftmrhd(iocont, 1, hdutyp, status)

      DO WHILE ( status .EQ. 0 )

         CALL ftgkys(iocont, 'EXTNAME', extnam, comment, status)
         WRITE(contxt, '(a,i6)') 
     &    'Failed to read EXTNAME for temperature #', nmtval
         IF ( status .NE. 0 ) GOTO 999

         IF ( extnam .NE. 'EMISSIVITY' ) GOTO 100

         itemp = itemp + 1

C Get the temperature in this extension and convert to keV from K

         CALL ftgkye(iocont, 'TEMPERATURE', tval(itemp), comment, 
     &               status)
         WRITE(contxt, '(a,i6)') 
     &     'Failed to find TEMPERAT for temperature #', itemp
         IF ( status .NE. 0 ) GOTO 999

         tval(itemp) = tval(itemp) / keVtoK

c Get the number of rows in this extension

         CALL ftgkyj(iocont, 'NAXIS2', nrows, comment, status)
         WRITE(contxt, '(a,i6)') 
     &     'Failed to read NAXIS2 for temperature #', itemp
         IF ( status .NE. 0 ) GOTO 999

c Set to -1 parts of the pointer, element, and ion arrays that we will not
c read use.

         DO i = nrows+1, nmions
            conpt(i, itemp) = -1
            consiz(i, itemp) = -1
            conEl(i, itemp) = -1
            conIon(i, itemp) = -1
         ENDDO

C Get the column numbers we need for this extension

         DO i = 1, 8
            CALL ftgcno(iocont, .false., contch(i), icol(i), status)
            WRITE(contxt, '(a,a10,a,i6)') 
     &       'Failed to find ', contch(i), ' for temperature #', itemp
            IF ( status .NE. 0 ) GOTO 999
         ENDDO

C and loop round the ions

         DO irow = 1, nrows

C get the number of continuum values to read

            CALL ftgcvj(iocont, icol(1), irow, 1, 1, 0, nread, qanyf, 
     &                  status)
            WRITE(contxt,'(a,i6,i6)') 
     &        'Failed to read N_cont ', itemp, irow
            IF ( status .NE. 0 ) GOTO 999

C read the energies and the continuum values

            CALL ftgcve(iocont, icol(2), irow, 1, nread, 0., 
     &                  cenerg(iptc), qanyf, status)
            WRITE(contxt,'(a,i6,i6)') 
     &        'Failed to read E_Cont ', itemp, irow
            IF ( status .NE. 0 ) GOTO 999

            CALL ftgcve(iocont, icol(3), irow, 1, nread, 1.e-31, 
     &                  cont(iptc), qanyf, status)
            WRITE(contxt,'(a,i6,i6)') 
     &        'Failed to read Continuum ', itemp, irow
            IF ( status .NE. 0 ) GOTO 999


C Set the pointer and size arrays and update the pointer

            conpt(irow, itemp) = iptc
            consiz(irow, itemp) = nread
            iptc = iptc + nread

C get the number of pseudo-continuum values to read

            CALL ftgcvj(iocont, icol(4), irow, 1, 1, 0, nread, qanyf, 
     &                  status)
            WRITE(contxt,'(a,i6,i6)') 
     &        'Failed to read N_Pseudo ', itemp, irow
            IF ( status .NE. 0 ) GOTO 999

C read the energies and the pseudo-continuum values

            CALL ftgcve(iocont, icol(5), irow, 1, nread, 0., 
     &                  penerg(iptp), qanyf, status)
            WRITE(contxt,'(a,i6,i6)') 
     &        'Failed to read E_Pseudo ', itemp, irow
            IF ( status .NE. 0 ) GOTO 999

            CALL ftgcve(iocont, icol(6), irow, 1, nread, 1.e-31, 
     &                  pseudo(iptp), qanyf, status)
            WRITE(contxt,'(a,i6,i6)') 
     &        'Failed to read Pseudo ', itemp, irow
            IF ( status .NE. 0 ) GOTO 999

C Set the pointer and size arrays and update the pointer

            psupt(irow, itemp) = iptp
            psusiz(irow, itemp) = nread
            iptp = iptp + nread

c Get the atomic number for the element and the ion whose continuum and 
c pseudo-continuum has just been read. Subtract 1 from the ion number since
c we will be using a convention where neutral is 0.

            CALL ftgcvj(iocont, icol(7), irow, 1, 1, 0, 
     &                  conEl(irow,itemp), qanyf, status)
            WRITE(contxt,'(a,i6,i6)') 
     &        'Failed to read Z ', itemp, irow
            IF ( status .NE. 0 ) GOTO 999

            CALL ftgcvj(iocont, icol(8), irow, 1, 1, 0, 
     &                  conIon(irow,itemp), qanyf, status)
            WRITE(contxt,'(a,i6,i6)') 
     &        'Failed to read rmJ ', itemp, irow
            IF ( status .NE. 0 ) GOTO 999

C End loop over rows

         ENDDO

 100     CONTINUE
         CALL ftmrhd(iocont, 1, hdutyp, status) 

C and end loop over temperatures (extensions)

      ENDDO

      status = 0

C Now repeat for the line file

      iptl = 1
      itemp = 0

      CALL ftmrhd(ioline, 1, hdutyp, status)

      DO WHILE ( status .EQ. 0 )

         CALL ftgkys(ioline, 'EXTNAME', extnam, comment, status)
         WRITE(contxt, '(a,i6)') 
     &    'Failed to read EXTNAME for temperature #', nmtval
         IF ( status .NE. 0 ) GOTO 999

         IF ( extnam .NE. 'EMISSIVITY' ) GOTO 200

         itemp = itemp + 1

C Get the column numbers we need for this extension

         DO i = 1, 4
            CALL ftgcno(ioline, .false., linech(i), icol(i), status)
            WRITE(contxt, '(a,a10,a,i6)') 
     &       'Failed to find ', linech(i), ' for temperature #', itemp
            IF ( status .NE. 0 ) GOTO 999
         ENDDO

C get the number of lines to read

         CALL ftgkyj(ioline, 'NAXIS2', nread, comment, status)
         WRITE(contxt, '(a,i6)')
     &    'Failed to read NAXIS2 for temperature #', i
         IF ( status .NE. 0 ) GOTO 999

C read the line energies, emissivities, elements, and ions - again subtract
C 1 from the ion so that neutral is 0.

         CALL ftgcve(ioline, icol(1), 1, 1, nread, 0., 
     &               lineE(iptl), qanyf, status)
         WRITE(contxt,'(a,i6)') 
     &     'Failed to read Lambda ', itemp
         IF ( status .NE. 0 ) GOTO 999

         CALL ftgcve(ioline, icol(2), 1, 1, nread, 0., 
     &               lineEm(iptl), qanyf, status)
         WRITE(contxt,'(a,i6)') 
     &     'Failed to read epsilon ', itemp
         IF ( status .NE. 0 ) GOTO 999

         CALL ftgcvj(ioline, icol(3), 1, 1, nread, 0, 
     &               lineEl(iptl), qanyf, status)
         WRITE(contxt,'(a,i6)') 
     &     'Failed to read Element ', itemp
         IF ( status .NE. 0 ) GOTO 999

         CALL ftgcvj(ioline, icol(4), 1, 1, nread, 0, 
     &               lineIon(iptl), qanyf, status)
         WRITE(contxt,'(a,i6)') 
     &     'Failed to read Ion ', itemp
         IF ( status .NE. 0 ) GOTO 999
         lineIon(iptl) = lineIon(iptl) - 1

C Current lineE are in wavelength (Angstrom) so convert to keV.

         DO i = 1, nread
            lineE(iptl+i-1) = keVtoA/lineE(iptl+i-1)
         ENDDO

C Set the pointer and size arrays and update the pointer

         linpt(itemp) = iptl
         linsiz(itemp) = nread
         iptl = iptl + nread

C and end loop over temperatures (extensions)

 200     CONTINUE
         CALL ftmrhd(ioline, 1, hdutyp, status)

      ENDDO
      status = 0

 999  CONTINUE
      IF ( status .NE. 0 ) THEN
         CALL xwrite(contxt, 10)
         WRITE(contxt, '(a,i4)') 'Error in RDNEIAPED : status = ', 
     &                           status
         CALL xwrite(contxt, 10)
      ENDIF

      RETURN
      END
