
      SUBROUTINE inprmf(inrfil, n_energies, resp_energies, n_channels, 
     &                  ch_bounds, rsp_min, ngroup, max_tot_groups,
     &                  max_elements, ichanb, ichane, resp_matrix,
     &                  num_elements, num_tot_groups, ierr)

      IMPLICIT NONE

      INTEGER N_energies , N_channels
      INTEGER Max_elements , Max_tot_groups
 
      REAL Resp_energies(0:N_energies) , Resp_matrix(Max_elements)
      REAL Ch_bounds(N_channels,2)
      REAL Rsp_min
 
      INTEGER Ngroup(N_energies)
      INTEGER Ichanb(Max_tot_groups) , Ichane(Max_tot_groups)
      INTEGER Num_elements , Num_tot_groups , Ierr

      CHARACTER inrfil*(*)

c This routine actually reads in the response matrix.
c Arguments :
c     Inrfil           c     i: The name of the response matrix
c     N_energies       i     i: Number of response energy bins
c     Resp_energies    r     i: Response energy ranges
c     N_channels       i     i: Number of channels
c     Ch_bounds        r     i: Channel energy boundaries
c     Rsp_min          r     i: The minimum response value that will be stored
c     Ngroup           i     r: The number of response groups for each energy
c     Max_tot_groups   i     i: The maximum number of total response groups
c     Ichanb           i     r: Start channel for each response group
c     Ichane           i     r: End channel for each response group
c     Max_elements     i     i: Maximum number of response elements
c     Resp_matrix      r     r: Response matrix elements
c     Num_elements     i     r: Number of response matrix elements calculated
c     Num_tot_groups   i     r: Total number of response groups calculated
c     Ierr             i     r: Error status    0 = OK

      INTEGER ilun, block, i, j, col(6), nchan, nentr

      CHARACTER comment*72, contxt*72

      LOGICAL qanyf

      INTEGER lenact
      EXTERNAL lenact

c Open the input response matrix

      CALL getlun(ilun)
      CALL ftopen(ilun, inrfil, 0, block, ierr)
      contxt = 'Failed to open '//inrfil(:lenact(inrfil))
      IF ( ierr .NE. 0 ) GOTO 999

c Go to the EBOUNDS extension

      CALL xfndxt(ilun, 'RESPONSE', 'EBOUNDS', comment, ierr)
      contxt = 'INPRMF: Unable to find EBOUNDS extension'
      IF (ierr .NE. 0) GOTO 999

c Get the columns for E_MIN and E_MAX

      CALL ftgcno(ilun, .FALSE., 'E_MIN', col(1), ierr)
      contxt = 'INPRMF: Cannot find E_MIN column'
      IF (ierr .NE. 0) GOTO 999

      CALL ftgcno(ilun, .FALSE., 'E_MAX', col(2), ierr)
      contxt = 'INPRMF: Cannot find E_MAX column'
      IF (ierr .NE. 0) GOTO 999

c Read the energy bounds

      DO i = 1, N_channels

         CALL FTGCVE(ilun, col(1), i, 1, 1, 0., ch_bounds(i,1), qanyf,
     &               ierr)
         contxt = 'INPRMF: Cannot read E_MIN data'
         IF (ierr .NE. 0) GOTO 999

         CALL FTGCVE(ilun, col(2), i, 1, 1, 0., ch_bounds(i,2), qanyf,
     &               ierr)
         contxt = 'INPRMF: Cannot read E_MAX data'
         IF (ierr .NE. 0) GOTO 999

      ENDDO

c Now go to RSP_MATRIX extension - close and reopen the file in case the
c extensions are out of order

      CALL FTCLOS(ilun, ierr)
      contxt = 'INPRMF: Failed to close file'
      IF (ierr .NE. 0) GOTO 999
      CALL ftopen(ilun, inrfil, 0, block, ierr)
      contxt = 'Failed to reopen '//inrfil(:lenact(inrfil))
      IF ( ierr .NE. 0 ) GOTO 999

      CALL xfndxt(ilun, 'RESPONSE', 'RSP_MATRIX', comment, ierr)
      contxt = 'INPRMF: Unable to find RSP_MATRIX extension'
      IF (ierr .NE. 0) GOTO 999

c Get the LO_THRES keyword

      CALL ftgkye(ilun, 'LO_THRES', rsp_min, comment, ierr)
      contxt = 'INPRMF: Cannot read LO_THRES'
      IF (ierr .NE. 0) GOTO 999

c Get the columns for the input vectors

      CALL ftgcno(ilun, .FALSE., 'ENERG_LO', col(1), ierr)
      contxt = 'INPRMF: Cannot find ENERG_LO column'
      IF (ierr .NE. 0) GOTO 999

      CALL ftgcno(ilun, .FALSE., 'ENERG_HI', col(2), ierr)
      contxt = 'INPRMF: Cannot find ENERG_HI column'
      IF (ierr .NE. 0) GOTO 999

      CALL ftgcno(ilun, .FALSE., 'N_GRP', col(3), ierr)
      contxt = 'INPRMF: Cannot find N_GRP column'
      IF (ierr .NE. 0) GOTO 999

      CALL ftgcno(ilun, .FALSE., 'F_CHAN', col(4), ierr)
      contxt = 'INPRMF: Cannot find F_CHAN column'
      IF (ierr .NE. 0) GOTO 999

      CALL ftgcno(ilun, .FALSE., 'N_CHAN', col(5), ierr)
      contxt = 'INPRMF: Cannot find N_CHAN column'
      IF (ierr .NE. 0) GOTO 999

      CALL ftgcno(ilun, .FALSE., 'MATRIX', col(6), ierr)
      contxt = 'INPRMF: Cannot find MATRIX column'
      IF (ierr .NE. 0) GOTO 999

c Get the first response energy

      CALL ftgcve(ilun, col(1), 1, 1, 1, 0., resp_energies(0), qanyf, 
     &            ierr)
      contxt = 'INPRMF: Cannot read ENERG_LO data'
      IF (ierr .NE. 0) GOTO 999

c Loop round energies loading the response matrix

      Num_elements = 0
      Num_tot_groups = 0

      DO i = 1, N_energies

c Read the response energy

         CALL ftgcve(ilun, col(2), i, 1, 1, 0., resp_energies(i), 
     &               qanyf, ierr)
         contxt = 'INPRMF: Cannot read ENERG_HI data'
         IF (ierr .NE. 0) GOTO 999

c Read the number of groups

         CALL ftgcvj(ilun, col(3), i, 1, 1, 0, Ngroup(i), qanyf, ierr)
         contxt = 'INPRMF: Cannot read N_GRP data'
         IF (ierr .NE. 0) GOTO 999

c Loop round the groups for this energy - nentr accumulates how many
c response entries there are for this energy

         nentr = 0
         DO j = 1, Ngroup(i)

c Read the start channel and number of channels for this group

            Num_tot_groups = Num_tot_groups + 1

            CALL ftgcvj(ilun, col(4), i, j, 1, 0, 
     &                  ichanb(Num_tot_groups), qanyf, ierr)
            contxt = 'INPRMF: Cannot read F_CHAN data'
            IF (ierr .NE. 0) GOTO 999

            CALL ftgcvj(ilun, col(5), i, j, 1, 0, nchan, qanyf, ierr)
            contxt = 'INPRMF: Cannot read N_CHAN data'
            IF (ierr .NE. 0) GOTO 999

            nentr = nentr + nchan
            ichane(Num_tot_groups) = ichanb(Num_tot_groups) + nchan-1

         ENDDO

c Read the matrix data

         CALL ftgcve(ilun, col(6), i, 1, nentr, 0.,
     &               resp_matrix(Num_elements+1), qanyf, ierr)
         contxt = 'INPRMF: Cannot read MATRIX data'
         IF (ierr .NE. 0) GOTO 999

         Num_elements = Num_elements + nentr

      ENDDO

c Close the response matrix file

      CALL ftclos(ilun, ierr)
      contxt = 'INPRMF: Failed to close file'
      IF (ierr .NE. 0) GOTO 999
      CALL frelun(ilun)

      WRITE(contxt, '(a,i7,a)') '...', Num_tot_groups, 
     &        ' groups and '
      CALL xwrite(contxt, 10)
      WRITE(contxt, '(a,i7,a,a)') '...', Num_elements, 
     &        ' response values from ', inrfil(:LENACT(inrfil))
      CALL xwrite(contxt, 10)

 999  CONTINUE
      IF ( Ierr.NE.0 ) THEN
         CALL xwrite(contxt,10)
         WRITE(contxt,'(a,i4)') ' error = ', ierr
         CALL xwrite(contxt,10)
      ENDIF

      RETURN
      END
