!+CALCRPSF
SUBROUTINE CALCRF
    IMPLICIT NONE
    !
    ! Description:
    !  Wrapper program to run (spawn) some/all of the following tasks
    !     ST2RPSF - convert from o/p of STWFITS to OGIP RPSF FITS format
    !     RBNRPSF - rebins an RPSF dataset
    !     PCRPSF  - generate a theoretical RPSF for the ROSAT PSPC
    !     HRIRPSF - generate a theoretical RPSF for the ROSAT HRI
    !     RPSFQDP - dumps an RPSF dataset to a QDP file
    !
    ! User i/ps required (prompted for):
    !  None here, isolated in GP_CALRPSF (see below), and prompted for as
    !  necessary by the individual tasks.
    !
    !  PROGRAMMERS !!: When adding new theoretical generators, remember to update
    !                  the qpred "help" in GP_CALCRPSF.
    !
    ! Called routines
    !  subroutine FCECHO           : (FTOOLS) write to standard i/o
    !  subroutine FCERR	       : (FTOOLS) write to standard error
    !  subroutine GP_CALCRPSF      : (below) gets parameters from the par file
    !  subroutine DO_CALCRPSF      : (below) the 'main' routine
    !
    ! Compilation:
    !  subroutines require CALLIB, FTOOLS, FITSIO
    !
    ! Origin:
    !  Original
    !
    ! Authors/Modification History:
    !  Ian M George     (1.0.0: 94 Jan 31), original
    !  Ian M George     (1.1.0: 94 Feb 03), clean up properly
    !  Ian M George     (1.2.0: 94 Feb 14), added ROSAT HRI
    !  Ian M George     (1.3.0: 94 Mar 08), cleaned up parameter getting routine
    !  Ian M George     (1.3.1: 94 Sep 12), minor stuff in parameter getting routine
    !  MFC              (1.3.2: 20 Apr 16) convert to f90
    character(7) version
    parameter (version = '1.3.2')
    !-
    ! Internals
    character(40) taskname
    integer chatter, schatter, ierr
    character(16) telescop, instrume
    character(25) context
    character(80) infil, outfil, message
    logical qst2rpsf, qrbnrpsf, qpred, qrpsfqdp, killit

    ! Initialize
    COMMON/task/taskname
    taskname = 'CALCRPSF ' // version
    ierr = 0

    message = '** CALCRPSF ' // version
    call fcecho(message)

    ! Get Parameters from the par file
    call gp_calcrpsf(infil, outfil, telescop, instrume, &
            chatter, schatter, &
            qst2rpsf, qrbnrpsf, qpred, qrpsfqdp, killit, ierr)
    if(ierr.NE.0) goto 926

    ! Do the nasty deed(s)
    call do_calcrpsf(infil, outfil, telescop, instrume, &
            chatter, schatter, &
            qst2rpsf, qrbnrpsf, qpred, qrpsfqdp, killit, ierr)

    ! Inform user of failure, if necessary
    926     if(ierr.NE.0) then
        context = 'Fatal'
        message = '** CALCRPSF ' // version // ' ERROR : ' // context
        call fcecho(message)
        call fcerr(context)
    else
        message = '** CALCRPSF ' // version // ' Finished'
        call fcecho(message)
    endif

    return
end


! -------------------------------------------------------------------------
!+GP_CALCRPSF
subroutine gp_calcrpsf(infil, outfil, telescop, instrume, &
        chatter, schatter, &
        qst2rpsf, qrbnrpsf, qpred, qrpsfqdp, killit, ierr)

    IMPLICIT NONE
    integer chatter, schatter, ierr
    character*(*) telescop, instrume
    character*(*) infil, outfil
    logical qst2rpsf, qrbnrpsf, qpred, qrpsfqdp, killit
    !
    ! Description:
    !  Gets the parameters required by CALCRPSF from the parameter file
    !  NOTE - The par file is assumed to have been opened.
    !
    ! User i/ps required (prompted for):
    !  INFILE      - name of i/p FITS SOURCE file (produced by stwfits)
    ! ??? incomplete
    !
    ! Origin:
    !  Original
    !
    ! Called Routines
    !  subroutine FCECHO           : (FTOOLS) writes to standard o/p device
    !  subroutine WT_FERRMSG       : (CALLIB) Writes standard FITSIO message etc
    !
    ! Compilation:
    !  requires XPI/Host interface etc and CALLIB
    !
    ! Authors/Modification History:
    !  Ian M George     (1.0.0: 1994 Jan 31), Original
    !  Ian M George     (1.1.0: 1994 Mar 08), Added infil=NONE option
    character(7) version
    parameter (version = '1.1.0')
    !-
    ! Internals
    character(40)  errstr, wrnstr
    character(40) string
    character(80)  message
    ! Initialize
    errstr = '** GP_CALCRPSF ' // version // ' ERROR: '
    wrnstr = '** GP_CALCRPSF ' // version // ' WARNING: '
    qpred = .true.
    ierr = 0
    telescop = 'UNKNOWN'
    instrume = 'UNKNOWN'

    ! Go get 'em coyboy....

    ! Get the name of the i/p file (from stwfits)
    call uclgst('infil', infil, ierr)
    if(ierr.NE.0) then
        message = errstr // 'Getting INFIL parameter'
        call fcecho(message)
        return
    endif

    ! Get the name of the o/p FITS file in OGIP-standard format
    call uclgst('outfil', outfil, ierr)
    if(ierr.NE.0) then
        message = errstr // 'Getting OUTFIL parameter'
        call fcecho(message)
        return
    endif
    if(outfil.EQ.' ') then
        message = errstr // 'No OUTFIL entered'
        call fcecho(message)
        ierr = 1
        return
    endif

    ! Get the chattiness flag
    call uclgsi('chatter', chatter, ierr)
    if(ierr.NE.0) then
        message = errstr // 'Getting CHATTER parameter'
        call fcecho(message)
        ierr = 0
        message = errstr // 'Setting CHATTER = 10'
        call fcecho(message)
        chatter = 9
    endif

    ! Give user info if requested
    if(chatter.GE.20) then
        message = ' ... using GP_CALCRPSF ' // version
        call fcecho(message)
    endif

    ! get clobber parameter ...

    call uclgsb('clobber', killit, ierr)
    if(ierr.NE.0) then
        message = errstr // 'Getting CLOBBER parameter'
        call fcecho(message)
        ierr = 0
    endif

    ! Get the chattiness flag (for spawned tasks)
    call uclgsi('schatter', schatter, ierr)
    if(ierr.NE.0) then
        message = errstr // 'Getting SCHATTER parameter'
        call fcecho(message)
        ierr = 0
        message = errstr // 'Setting SCHATTER = 10'
        call fcecho(message)
        schatter = 9
    endif

    ! Skip to qpred if no i/p file
    call crmvlbk(infil)
    if(infil(:4).EQ.'NONE'.or.infil(:4).EQ.'none'&
            .or.infil.EQ.' ')then
        qst2rpsf = .false.
        qrbnrpsf = .false.
        goto 564
    endif

    ! Get the logicals indicating which tasks are to be spawned
    ! ... st2rpsf
    call uclgsb('qst2rpsf', qst2rpsf, ierr)
    if(ierr.NE.0) then
        message = errstr // 'Getting QST2RPSF parameter'
        call fcecho(message)
        return
    endif
    ! ... rbnrpsf
    call uclgsb('qrbnrpsf', qrbnrpsf, ierr)
    if(ierr.NE.0) then
        message = errstr // 'Getting QRBNRPSF parameter'
        call fcecho(message)
        return
    endif
    ! ... the prediction routines
    564    continue
    call uclgst('qpred', string, ierr)
    if(ierr.NE.0) then
        message = errstr // 'Getting QPRED parameter'
        call fcecho(message)
        return
    endif
    call crmvlbk(string)
    if(string(:1).eq.'T'.or.string(:1).eq.'t'&
            .or.string(:2).eq.'.T'.or.string(:2).eq.'.T'&
            .or.string(:1).eq.'y'.or.string(:1).eq.'Y') then
        qpred = .true.
        if((.not.qst2rpsf) .AND. (.not.qrbnrpsf)) then
            call uclgst('telescop', telescop, ierr)
            if(ierr.NE.0) then
                message = errstr // 'Getting TELESCOP parameter'
                call fcecho(message)
                return
            endif
            call uclgst('instrume', instrume, ierr)
            if(ierr.NE.0) then
                message = errstr // 'Getting INSTRUME parameter'
                call fcecho(message)
                return
            endif
        endif
    elseif(string(:1).eq.'F'.or.string(:1).eq.'f'&
            .or.string(:2).eq.'.F'.or.string(:2).eq.'.F'&
            .or.string(:1).eq.'N'.or.string(:1).eq.'n') then
        qpred = .false.
    elseif(string(:1).eq.'?'.or.string(:4).eq.'help'&
            .or.string(:4).eq.'HELP') then
        message = ' ... PSF datasets can be generated for ' // &
                'the following instruments:'
        call fcecho(message)
        message = '     ROSAT HRI       (using hrirpsf)'
        call fcecho(message)
        message = '     ROSAT PSPC      (using pcrpsf)'
        call fcecho(message)
        goto 564
    else
        message = errstr // ' Unrecognized answer'
        call fcecho(message)
        message = ' ... allowed values: yes/no, true/false, or ?'
        call fcecho(message)
        goto 564
    endif

    ! ... rpsfqdp
    call uclgsb('qrpsfqdp', qrpsfqdp, ierr)
    if(ierr.NE.0) then
        message = errstr // 'Getting QRPSFQDP parameter'
        call fcecho(message)
        return
    endif

    return
end
! -------------------------------------------------------------------------
!+DO_CALCRPSF
subroutine do_calcrpsf(infil, outfil, telescop, instrume, &
        chatter, schatter, &
        qst2rpsf, qrbnrpsf, qpred, qrpsfqdp, killit, ierr)

    IMPLICIT NONE
    integer chatter, schatter, ierr
    character*(*) telescop, instrume
    character*(*) infil, outfil
    logical qst2rpsf, qrbnrpsf, qpred, qrpsfqdp, killit
    !
    ! Description:
    !  Program which actually spawns all the necessary standalones
    !
    ! Passed parameters
    ! ???
    !
    ! Origin:
    !  Original
    !
    ! Called Routines
    ! Task  STW2PHA		: (CALTOOLS) Converts for STWFITS o/p to OGIP standard
    ! Task  MATHPHA		: (HEASARC) Performs maths on PHA datasets
    !
    ! Authors/Modification History:
    !  Ian M George     (1.0.0:1994 Jan 31), original... ROSAT PSPC only
    !  Ian M George     (1.1.0: 94 Feb 14), added ROSAT HRI
    !  Ian M George     (1.1.1: 1994 Sep 12), infil=infile etc
    character(7) version
    parameter (version = '1.1.1')
    !-
    ! Internals
    integer status, lspawn, fcstln, clenact
    integer nstrs, lstr(20), i
    real ftsver
    character(80) str(20), dummy
    character(80) message, blank
    character(512) cbuf
    character(40) errstr, wrnstr
    character(80) dummystr(1), ill_fil(3)
    logical qokfil, qmore, exist
    ! Initialize
    status = 0
    ierr = 0
    dummystr(1) = ' '
    blank = ' '
    qmore = .false.
    errstr = '** DO_CALCRPSF ' // version // ' ERROR:'
    wrnstr = '** DO_CALCRPSF ' // version // ' WARNING:'

    ! Give user info if requested
    if(chatter.GE.20) then
        message = ' ... using DO_CALCRPSF ' // version
        call fcecho(message)
        call ftvers(ftsver)
        write(message, '(a,f6.3)')&
                ' ... using FITSIO Version ', ftsver
        call fcecho(message)
    endif

    ! The Host-interface considers all characters after a ! to be a comment,
    !   even if its enclosed within double quotes. Thus files specified to
    !   be overwritten should be removed (under unix/ultrix) here, in main,
    !   rather than passing a filename precceded by a "!" to the spawned
    !   tasks (ho, hum, yawn, yawn)
    ill_fil(1) = 'st2rpsf.tmp'
    ill_fil(2) = 'rbnrpsf.tmp'
    ill_fil(3) = 'rpsfpred.tmp'
    call ck_file(outfil, ill_fil, 3, qokfil, killit, chatter)
    if(.NOT.qokfil) then
        message = errstr // 'OUTFIL has an illegal name'
        call fcecho(message)
        message = ' ...... (name is reserved for a temporary file)'
        call fcecho(message)
        ierr = 1
        goto 482
    endif

    ! Check that the o/p file doesn't already exist or is otherwise illegal
    call ck_file(outfil, dummystr, 1, qokfil, killit, chatter)
    if(.NOT.qokfil) then
        message = '... Offending file is OUTFIL: ' // outfil(:50)
        call fcecho(message)
        ierr = -1
        goto 482
    endif

    ! Clean up any 'old' temporary files which might be around
    INQUIRE(FILE = 'st2rpsf.tmp', EXIST = exist)
    if(exist) call delfil('st2rpsf.tmp')
    INQUIRE(FILE = 'rbnrpsf.tmp', EXIST = exist)
    if(exist) call delfil('rbnrpsf.tmp')
    INQUIRE(FILE = 'rpsfpred.tmp', EXIST = exist)
    if(exist) call delfil('rpsfpred.tmp')

    ! --------------------------- ST2RPSF -------------------------
    ! ... construct the command string and spawn ST2RPSF task if necessary

    if(qst2rpsf) then
        if(qrbnrpsf.OR.qpred.OR.qrpsfqdp) then
            qmore = .true.
        else
            qmore = .false.
        endif
        call crmvblk(infil)
        call crmvblk(outfil)
        write(str(1), '(a,i12)') 'chatter=', schatter
        str(2) = ' infil="' // infil(:clenact(infil)) // '"'
        if(qmore) then
            str(3) = ' outfil=' // 'st2rpsf.tmp'
        else
            str(3) = ' outfil=' // outfil
        endif
        nstrs = 3
        do i = 1, nstrs
            call crmvblk(str(i))
            lstr(i) = fcstln(str(i))
        enddo

        cbuf = 'st2rpsf'
        lspawn = fcstln(cbuf)
        do i = 1, nstrs
            dummy = str(i)
            cbuf = cbuf(:lspawn) // ' ' // dummy(:lstr(i))
            lspawn = fcstln(cbuf)
        enddo
        call fcecho(blank)
        message = ' *** spawning ST2RPSF ' // &
                'to convert o/p from STWFITS:'
        call fcecho(message)
        if(lspawn.lt.80) then
            message = cbuf(:lspawn)
        else
            message = cbuf(:70) // ' (etc...)'
        endif
        call fcecho(message)

        status = 0
        call cspawn(cbuf, lspawn, status)
        if(status.NE.0) then
            message = errstr // ' Problem with ST2RPSF spawn'
            call fcecho(message)
            write(message, '(a,i12)')&
                    ' ... CSPAWN Error flag = ', status
            call fcecho(message)
            ierr = 1
            goto 482
        endif
        message = ' *** completed spawn to ST2RPSF'
        call fcecho(blank)
        if(qmore) then
            infil = 'st2rpsf.tmp'
        endif
    endif
    ! ------------------------------------------------------------

    ! --------------------------- RBNRPSF -------------------------
    ! ... construct the command string and spawn RBNRPSF task if necessary

    if(qrbnrpsf) then
        if(qpred.OR.qrpsfqdp) then
            qmore = .true.
        else
            qmore = .false.
        endif
        call crmvblk(infil)
        call crmvblk(outfil)
        write(str(1), '(a,i12)') 'chatter=', schatter
        str(2) = ' infile="' // infil(:clenact(infil)) // '"'
        if(qmore) then
            str(3) = ' outfile=' // 'rbnrpsf.tmp'
        else
            str(3) = ' outfile=' // outfil
        endif
        nstrs = 3
        do i = 1, nstrs
            call crmvblk(str(i))
            lstr(i) = fcstln(str(i))
        enddo

        cbuf = 'rbnrpsf'
        lspawn = fcstln(cbuf)
        do i = 1, nstrs
            dummy = str(i)
            cbuf = cbuf(:lspawn) // ' ' // dummy(:lstr(i))
            lspawn = fcstln(cbuf)
        enddo
        call fcecho(blank)
        message = ' *** spawning RBNRPSF ' // &
                'to convert rebin RPSF dataset:'
        call fcecho(message)
        if(lspawn.lt.80) then
            message = cbuf(:lspawn)
        else
            message = cbuf(:70) // ' (etc...)'
        endif
        call fcecho(message)

        status = 0
        call cspawn(cbuf, lspawn, status)
        if(status.NE.0) then
            message = errstr // ' Problem with RBNRPSF spawn'
            call fcecho(message)
            write(message, '(a,i12)')&
                    ' ... CSPAWN Error flag = ', status
            call fcecho(message)
            ierr = 1
            goto 482
        endif
        message = ' *** completed spawn to RBNRPSF'
        call fcecho(blank)
        if(qmore) then
            infil = 'rbnrpsf.tmp'
        endif
    endif

    ! ------------------------------------------------------------

    ! --------------------------- PREDICTED guys -------------------------
    ! ... construct the command string and spawn tasks to generate predicted
    ! RPSF dataset (if requested)

    if(qpred) then
        if(qrpsfqdp) then
            qmore = .true.
        else
            qmore = .false.
        endif
        ! ... Go get the mission & instruments from the file
        if((qst2rpsf) .OR. (qrbnrpsf)) then
            call gt_misinst(infil, telescop, instrume, ierr)
            if(ierr.NE.0) goto 482
        endif

        ! ... check we can handle the telescop/instrument
        call crmvblk(telescop)
        if(telescop(:5).NE.'ROSAT') then
            message = errstr // ' Unsupported Mission/Satellite'
            call fcecho(message)
            ierr = 1
            goto 482
        endif
        call crmvblk(instrume)
        ! .... ROSAT PSPC
        if(instrume(:4).EQ.'PSPC') then
            call crmvblk(infil)
            call crmvblk(outfil)
            write(str(1), '(a,i12)') 'chatter=', schatter
            str(2) = ' infile="' // infil(:clenact(infil)) // '"'
            if(qmore) then
                str(3) = ' outfile=' // 'rpsfpred.tmp'
            else
                str(3) = ' outfile=' // outfil
            endif
            nstrs = 3
            if((qst2rpsf).OR.(qrbnrpsf))then
                str(4) = 'bkgd = %'
                nstrs = nstrs + 1
            endif
            do i = 1, nstrs
                call crmvblk(str(i))
                lstr(i) = fcstln(str(i))
            enddo

            cbuf = 'pcrpsf'
            lspawn = fcstln(cbuf)
            do i = 1, nstrs
                dummy = str(i)
                cbuf = cbuf(:lspawn) // ' ' // dummy(:lstr(i))
                lspawn = fcstln(cbuf)
            enddo
            call fcecho(blank)
            message = ' *** spawning PCRPSF ' // &
                    'to generate prediced RPSF dataset:'
            call fcecho(message)
            if(lspawn.lt.80) then
                message = cbuf(:lspawn)
            else
                message = cbuf(:70) // ' (etc...)'
            endif
            call fcecho(message)

            status = 0
            call cspawn(cbuf, lspawn, status)
            if(status.NE.0) then
                message = errstr // ' Problem with PCRPSF spawn'
                call fcecho(message)
                write(message, '(a,i12)')&
                        ' ... CSPAWN Error flag = ', status
                call fcecho(message)
                ierr = 1
                goto 482
            endif
            message = ' *** completed spawn to PCRPSF'
            call fcecho(blank)
            if(qmore) then
                infil = 'rpsfpred.tmp'
            endif
            ! .... ROSAT HRI
        elseif(instrume(:3).EQ.'HRI') then
            call crmvblk(infil)
            call crmvblk(outfil)
            write(str(1), '(a,i12)') 'chatter=', schatter
            str(2) = ' infile="' // infil(:clenact(infil)) // '"'
            if(qmore) then
                str(3) = ' outfile=' // 'rpsfpred.tmp'
            else
                str(3) = ' outfile=' // outfil
            endif
            nstrs = 3
            if((qst2rpsf).OR.(qrbnrpsf))then
                str(4) = 'bkgd = %'
                nstrs = nstrs + 1
            endif
            do i = 1, nstrs
                call crmvblk(str(i))
                lstr(i) = fcstln(str(i))
            enddo

            cbuf = 'hrirpsf'
            lspawn = fcstln(cbuf)
            do i = 1, nstrs
                dummy = str(i)
                cbuf = cbuf(:lspawn) // ' ' // dummy(:lstr(i))
                lspawn = fcstln(cbuf)
            enddo
            call fcecho(blank)
            message = ' *** spawning HRIRPSF ' // &
                    'to generate prediced RPSF dataset:'
            call fcecho(message)
            if(lspawn.lt.80) then
                message = cbuf(:lspawn)
            else
                message = cbuf(:70) // ' (etc...)'
            endif
            call fcecho(message)

            status = 0
            call cspawn(cbuf, lspawn, status)
            if(status.NE.0) then
                message = errstr // ' Problem with HRIRPSF spawn'
                call fcecho(message)
                write(message, '(a,i12)')&
                        ' ... CSPAWN Error flag = ', status
                call fcecho(message)
                ierr = 1
                goto 482
            endif
            message = ' *** completed spawn to HRIRPSF'
            call fcecho(blank)
            if(qmore) then
                infil = 'rpsfpred.tmp'
            endif
        else
            message = errstr // ' Unsupported Detector'
            call fcecho(message)
            ierr = 1
            goto 482
        endif
    endif

    ! ------------------------------------------------------------

    ! --------------------------- RPSFQDP -------------------------
    ! ... construct the command string and spawn RPSFQDP task if necessary

    if(qrpsfqdp) then
        call crmvblk(infil)
        call crmvblk(outfil)
        write(str(1), '(a,i12)') 'chatter=', schatter
        str(2) = ' datafile="' // infil(:clenact(infil)) // '"'
        str(3) = ' outfile=' // outfil
        nstrs = 3
        do i = 1, nstrs
            call crmvblk(str(i))
            lstr(i) = fcstln(str(i))
        enddo

        cbuf = 'rpsfqdp'
        lspawn = fcstln(cbuf)
        do i = 1, nstrs
            dummy = str(i)
            cbuf = cbuf(:lspawn) // ' ' // dummy(:lstr(i))
            lspawn = fcstln(cbuf)
        enddo
        call fcecho(blank)
        message = ' *** spawning RPSFQDP ' // &
                'to convert RPSF dataset to QDP:'
        call fcecho(message)
        if(lspawn.lt.80) then
            message = cbuf(:lspawn)
        else
            message = cbuf(:70) // ' (etc...)'
        endif
        call fcecho(message)

        status = 0
        call cspawn(cbuf, lspawn, status)
        if(status.NE.0) then
            message = errstr // ' Problem with RPSFQDP spawn'
            call fcecho(message)
            write(message, '(a,i12)')&
                    ' ... CSPAWN Error flag = ', status
            call fcecho(message)
            ierr = 1
            goto 482
        endif
        message = ' *** completed spawn to RPSFQDP'
        call fcecho(blank)
    endif

    ! ------------------------------------------------------------

    ! Clean up the temporary files, if any
    ! Clean up any 'old' temporary files which might be around
    INQUIRE(FILE = 'st2rpsf.tmp', EXIST = exist)
    if(exist) call delfil('st2rpsf.tmp')
    INQUIRE(FILE = 'rbnrpsf.tmp', EXIST = exist)
    if(exist) call delfil('rbnrpsf.tmp')
    INQUIRE(FILE = 'rpsfpred.tmp', EXIST = exist)
    if(exist) call delfil('rpsfpred.tmp')

    ! Check of errors
    482    if(ierr.ne.0) then
        message = errstr // ' Fatal'
        call fcecho(message)
    endif

    return
end


! -----------------------------------------------------------
!+ GT_MISINST
subroutine gt_misinst(inexp, telescop, instrume, ierr)

    IMPLICIT NONE
    integer ierr
    character*(*) inexp, telescop, instrume
    !
    ! Description
    !  Opens, reads & returns the telescope & instrument keyword values
    ! from infil
    !
    ! Author/Modification History
    !  Ian M George (1.0.0:1994 Feb 03), quick'n'dirty orginal
    character(7) version
    parameter (version = '1.0.0')
    !-
    ! Internals
    integer status, iunit, block, extn, htype
    integer clenact
    character(40) wrnstr, errstr
    character(80) infil, comm, message
    ! Initialize
    status = 0
    ierr = 0
    errstr = '** GT_MISINST ' // version // ' ERROR:'
    wrnstr = '** GT_MISINST' // version // ' WARNING:'


    ! Parse the supplied filename, stripping off incld extension numbers
    call fcpars(inexp, infil, extn, status)
    if(status.NE.0) then
        message = errstr // ' Problem parsing the expression:'
        call fcecho(message)
        message = ' ......    ' // inexp(:MIN(50, clenact(inexp)))
        call fcecho(message)
        ierr = 1
        return
    endif

    if(extn.LE.0) extn = 1

    ! Open the file
    call cgetlun(iunit)
    call ftopen(iunit, infil, 0, block, status)
    IF (status.NE.0) THEN
        message = errstr // ' opening file: ' // infil(:20)
        call wt_ferrmsg(status, message)
        ierr = 1
        return
    ENDIF

    ! Move to correct extension (first extension),
    call ftmahd(iunit, extn + 1, htype, status)


    ! Read the keys
    call ftgkys(iunit, 'TELESCOP', telescop, comm, status)
    if(status.NE.0) then
        telescop = ' '
    endif
    call ftgkys(iunit, 'INSTRUME', instrume, comm, status)
    if(status.NE.0) then
        instrume = ' '
    endif


    ! Close the file
    call ftclos(iunit, status)

    return
end