
C Routine to read the Mission DataBase to get some piece of information.
C The database is arranged for Mission:SubMission:Instrument:Datamode and 
C uses an inheritance structure such that any keyword is searched for 
C first at the Datamode level, then the Instrument, then the SubMission, 
C and finally the Mission eg the entry Mission:Instrument:x overrides the
C entry Mission:x. If a string is not detected then Status=-1 and Result=" ".

      SUBROUTINE XSL_MDBS(Mission, SubMission, Instrument, Datamode, 
     &                    Keyword, Result, Status)

      CHARACTER*(*) Mission, SubMission, Instrument, Datamode, Keyword 
      CHARACTER*(*) Result
      INTEGER Status

C Argument :
C   Mission     C*(*)          i: Mission in use
C   SubMission  C*(*)          i: SubMission in use - mainly used to
C                                 distinguish between ROSAT RDF and OLD format
C   Instrument  C*(*)          i: Instrument in use
C   Datamode    C*(*)          i: Datamode in use
C   Keyword     C*(*)          i: Keyword requested
C   Result      C*(*)          r: Value of the keyword
C   Status      I              r: 0==OK, -1==not found

      INCLUDE 'xsel.inc'

      INTEGER MAXSTR
      PARAMETER (MAXSTR=500)

      INTEGER lun, lkey, ierr, i, j, lfil, istr, nstr
      INTEGER nkey, ntestkey, ltkey

      CHARACTER*255 key(4), testkey(4), filenm, wrtstr
      CHARACTER*1024 inline
      CHARACTER*20 savmis, testmis
      CHARACTER*1024 savstr(MAXSTR), teststr

      LOGICAL qdone, qmatch

      INTEGER lenact, lchop
      EXTERNAL lenact, lchop

      SAVE savmis, savstr, nstr

      DATA savmis /'NONE'/

      Status = 0

      CALL UPC(Mission)

c Check whether this is a new mission. If so read the appropriate data
c from the MDB file.

      IF ( savmis .NE. Mission ) THEN

C Check whether there is an XSELECT_MDB environment variable defined. If
C so use this as the filename otherwise construct the filename using the
C FTOOLS variable.

         CALL TRLOG('XSELECT_MDB', 11, filenm, lfil)
         IF ( lfil .EQ. 0 ) THEN
            filenm = xslnam(:lenact(xslnam))//'.mdb'
            CALL ptend(xsldsk, xsldir, filenm)
         ENDIF

C Open the MDB file

         CALL getlun(lun)
         CALL openwr(lun, filenm, 'old', ' ', ' ', 0, 1, ierr)
         IF ( ierr .NE. 0 ) THEN
            wrtstr = 'Failed to open '//filenm
            CALL xselwrite(wrtstr, 5)
            Status = 1
            RETURN
         ENDIF

C Loop through the file accumulating the savstr array

         nstr = 0
         READ(lun, '(a)', iostat=ierr) inline
         qdone = .FALSE.
         IF ( ierr .NE. 0 ) qdone = .TRUE.

         DO WHILE ( .NOT.qdone )

            testmis = inline(:lenact(Mission))
            CALL upc(testmis)

            IF ( testmis .EQ. Mission ) THEN
               IF ( nstr .LE. MAXSTR ) THEN
                  nstr = nstr + 1
                  savstr(nstr) = inline
               ELSE
                  wrtstr = 'The number of entries in the mdb file '//
     &                     'exceeds the maximum allowed'
                  CALL XSELWRITE(wrtstr, 5)
                  wrtstr = 'Increase MAXSTR in xsel_mdb.f'
                  CALL XSELWRITE(wrtstr, 5)
                  qdone = .TRUE.
               ENDIF
            ENDIF

            IF ( .NOT.qdone ) THEN
               READ(lun, '(a)', iostat=ierr) inline
               IF ( ierr .NE. 0 ) qdone = .TRUE.
            ENDIF

         ENDDO

         CLOSE(lun)
         CALL frelun(lun)

         savmis = Mission

      ENDIF

C Loop round the possible combinations of search keys

      DO i = 1, 4

C Set up the search key array. We search for matches starting with all three
C possible keys and working down. By construction we know that the mission
C keyword matches so don't bother with that.

         nkey = 0

         IF ( i .LE. 3 ) THEN
            IF ( lenact(SubMission) .GT. 0 .AND. 
     &           SubMission .NE. 'NONE' ) THEN
               nkey = nkey + 1
               key(nkey) = SubMission
            ENDIF
         ENDIF

         IF ( i .LE. 2 ) THEN
            IF ( lenact(Instrument) .GT. 0 .AND. 
     &           Instrument .NE. 'NONE' ) THEN
               nkey = nkey + 1
               key(nkey) = Instrument
            ENDIF
         ENDIF

         IF ( i .EQ. 1 ) THEN
            IF ( lenact(Datamode) .GT. 0 .AND. 
     &           Datamode .NE. 'NONE' ) THEN
               nkey = nkey + 1
               key(nkey) = Datamode
            ENDIF
         ENDIF

         nkey = nkey + 1
         key(nkey) = Keyword

         DO j = 1, nkey
            CALL upc(key(j))
         ENDDO

C Loop through the savstr array looking for the key

         qdone = .FALSE.
         istr = 0
         DO WHILE ( .not.qdone .AND. istr .NE. nstr )

            istr = istr + 1
            teststr = savstr(istr)(lenact(Mission)+2:)

c Split up into individual keys

            ntestkey = 0
            lkey = LENACT(teststr)
            DO WHILE ( index(teststr,':') .NE. 0 )
               ntestkey = ntestkey + 1
               testkey(ntestkey) = teststr(:index(teststr,':')-1)
               teststr = teststr(index(teststr,':')+1:)
            ENDDO
            ntestkey = ntestkey + 1
            lkey = index(teststr,' ')
            testkey(ntestkey) = teststr(:lkey-1)
            teststr = teststr(lkey+1:)

            DO j = 1, ntestkey
               CALL upc(testkey(j))
               IF ( index(testkey(j),'*') .NE. 0 ) THEN
                  testkey(j) = testkey(j)(:index(testkey(j),'*')-1)
               ENDIF
            ENDDO

            IF ( nkey .EQ. ntestkey ) THEN

C check whether testkey and key arrays match allowing for wild cards in teststr.

               qmatch = .TRUE.
               DO j = 1, nkey
                  lkey = lenact(key(j))
                  ltkey = lenact(testkey(j))
                  IF ( key(j)(:lkey) .NE. testkey(j)(:ltkey) ) 
     &                 qmatch = .FALSE.
               ENDDO

               IF ( qmatch) qdone = .TRUE.

            ENDIF

         ENDDO

C If we were successful then return the rest of the string

         IF ( qdone ) THEN
            IF ( lenact(teststr) .GT. 0 ) THEN
               Result = teststr(lchop(teststr):lenact(teststr))
            ELSE
               Result = ' '
            ENDIF
            RETURN
         ENDIF

      ENDDO

C We were not successful so return Status=-1 and Result=" "

      Status = -1
      Result = " "

      RETURN
      END

c *************************************************************

      SUBROUTINE XSL_MDBJ(Mission, SubMission, Instrument, Datamode, 
     &                    Keyword, Result,Status)

      CHARACTER*(*) Mission, SubMission, Instrument, Datamode, Keyword
      INTEGER Result, Status

C Argument :
C   Mission     C*(*)          i: Mission in use
C   SubMission  C*(*)          i: SubMission in use - mainly used to
C                                 distinguish between ROSAT RDF and OLD format
C   Instrument  C*(*)          i: Instrument in use
C   Datamode    C*(*)          i: Datamode in use
C   Keyword     C*(*)          i: Keyword requested
C   Result      I              r: Value of the keyword
C   Status      I              r: 0==OK, -1==not found, other==error

      CHARACTER*255 string

      INTEGER lenact
      EXTERNAL lenact

C get the argument as a string

      CALL XSL_MDBS(Mission, SubMission, Instrument, Datamode, Keyword, 
     &              string, Status)

C read an integer

      IF ( Status .EQ. 0 ) THEN

         IF ( lenact(string) .EQ. 1 ) THEN 
            READ(string(1:1), '(i1)', iostat=Status) Result
         ELSEIF ( lenact(string) .EQ. 2 ) THEN 
            READ(string(1:2), '(i2)', iostat=Status) Result
         ELSEIF ( lenact(string) .EQ. 3 ) THEN 
            READ(string(1:3), '(i3)', iostat=Status) Result
         ELSEIF ( lenact(string) .EQ. 4 ) THEN 
            READ(string(1:4), '(i4)', iostat=Status) Result
         ELSEIF ( lenact(string) .EQ. 5 ) THEN 
            READ(string(1:5), '(i5)', iostat=Status) Result
         ELSEIF ( lenact(string) .EQ. 6 ) THEN 
            READ(string(1:6), '(i6)', iostat=Status) Result
         ELSEIF ( lenact(string) .EQ. 7 ) THEN 
            READ(string(1:7), '(i7)', iostat=Status) Result
         ELSEIF ( lenact(string) .EQ. 8 ) THEN 
            READ(string(1:8), '(i8)', iostat=Status) Result
         ENDIF

      ENDIF

      IF ( Status .NE. 0 ) Result = 0

      RETURN
      END

c *************************************************************

      SUBROUTINE XSL_MDBE(Mission, SubMission, Instrument, Datamode, 
     &                    Keyword, Result,Status)

      CHARACTER*(*) Mission, SubMission, Instrument, Datamode, Keyword
      REAL Result
      INTEGER Status

C Argument :
C   Mission     C*(*)          i: Mission in use
C   SubMission  C*(*)          i: SubMission in use - mainly used to
C                                 distinguish between ROSAT RDF and OLD format
C   Instrument  C*(*)          i: Instrument in use
C   Datamode    C*(*)          i: Datamode in use
C   Keyword     C*(*)          i: Keyword requested
C   Result      R              r: Value of the keyword
C   Status      I              r: 0==OK, -1==not found, other==error

      CHARACTER*255 string

      INTEGER lenact
      EXTERNAL lenact

C get the argument as a string

      CALL XSL_MDBS(Mission, SubMission, Instrument, Datamode, Keyword, 
     &              string, Status)

C read a real

      IF ( Status .EQ. 0 ) THEN
         READ(string(:lenact(string)), '(g15.0)', iostat=Status) Result
      ENDIF

      IF ( Status .NE. 0 ) Result = 0

      RETURN
      END

c *************************************************************

      SUBROUTINE XSL_MDBD(Mission, SubMission, Instrument, Datamode, 
     &                    Keyword, Result,Status)

      CHARACTER*(*) Mission, SubMission, Instrument, Datamode, Keyword
      DOUBLE PRECISION Result
      INTEGER Status

C Argument :
C   Mission     C*(*)          i: Mission in use
C   SubMission  C*(*)          i: SubMission in use - mainly used to
C                                 distinguish between ROSAT RDF and OLD format
C   Instrument  C*(*)          i: Instrument in use
C   Datamode    C*(*)          i: Datamode in use
C   Keyword     C*(*)          i: Keyword requested
C   Result      D              r: Value of the keyword
C   Status      I              r: 0==OK, -1==not found, other==error

      CHARACTER*255 string

      INTEGER lenact
      EXTERNAL lenact

C get the argument as a string

      CALL XSL_MDBS(Mission, SubMission, Instrument, Datamode, Keyword, 
     &              string, Status)

C read a double precision

      IF ( Status .EQ. 0 ) THEN
         READ(string(:lenact(string)), '(g15.0)', iostat=Status) Result
      ENDIF

      IF ( Status .NE. 0 ) Result = 0

      RETURN
      END

c *************************************************************

      SUBROUTINE XSL_MDBB(Mission, SubMission, Instrument, Datamode, 
     &                    Keyword, Result,Status)

      CHARACTER*(*) Mission, SubMission, Instrument, Datamode, Keyword
      INTEGER Status
      LOGICAL Result

C Argument :
C   Mission     C*(*)          i: Mission in use
C   SubMission  C*(*)          i: SubMission in use - mainly used to
C                                 distinguish between ROSAT RDF and OLD format
C   Instrument    C*(*)        i: Instrument in use
C   Datamode    C*(*)          i: Datamode in use
C   Keyword     C*(*)          i: Keyword requested
C   Result      L              r: Value of the keyword
C   Status      I              r: 0==OK, -1==not found, other==error

      CHARACTER*255 string

      INTEGER lenact
      EXTERNAL lenact

C get the argument as a string

      CALL XSL_MDBS(Mission, SubMission, Instrument, Datamode, Keyword, 
     &              string, Status)

C if the string is "yes" then return true, if "no" then return false.

      Result = .FALSE.
      IF ( Status .EQ. 0 ) THEN
         IF ( string(1:1) .EQ. 'y' .OR. 
     &        string(1:1) .EQ. 'Y' ) Result = .TRUE.
      ENDIF

      RETURN
      END

c *************************************************************

      SUBROUTINE XSL_MDB_INST(Mission, Submis, Instru, Obsno, Status)

      CHARACTER*(*) Mission, Submis, Instru
      INTEGER Obsno, Status

C Argument :
C   Mission     C*(*)          i: Mission in use
C   SubMission  C*(*)          i: SubMission in use
C   Instru      C*(*)        i/r: Instrument name - on return full name of 
C                                 matched Instrument
C   Obsno       I              r: Number of the detectot, -5 if none found
C   Status      I              r: 0==OK, -1==not found, other==error

      INTEGER best, match, i, iflag, idelim, lenn, lenb, lene
      INTEGER idet

      LOGICAL qdone, qskip

      CHARACTER detstr*255, outname*255

      Status = 0

      CALL upc(Instru)

C Get the instrument string for this mission

      CALL XSL_MDBS(Mission, Submis, ' ', ' ', 'instruments', detstr, 
     &              Status)

      best = 0
      idet = 0
      obsno = -5
      outname = 'NONE'
      lenn = 0
      qdone = .FALSE.

C Loop around the instruments in the string

      DO WHILE ( .NOT.qdone )

         CALL xgtarg(detstr, lenn, lenb, lene, qskip, iflag, idelim)
         IF ( iflag .NE. 0 ) GOTO 100
         idet = idet + 1

C Find how well the input name matches this Instrument

         match = 0
         DO i = lenb, lene
            IF ( index(Instru,detstr(i:i)) .NE. 0 ) match = match + 1
         ENDDO

C If this the best match then set out the output name and obsno

         IF ( match .GT. best ) THEN
            best = match
            outname = detstr(lenb:lene)
            obsno = idet
         ENDIF

      ENDDO

 100  CONTINUE
      Instru = outname(:MIN(len(outname),len(Instru)))

      RETURN
      END

c *************************************************************

      SUBROUTINE XSL_MDB_MODE(Mission, Submis, Instru, Datamode, Status)

      CHARACTER*(*) Mission, Submis, Instru, Datamode
      INTEGER Status

C Argument :
C   Mission     C*(*)          i: Mission in use
C   SubMission  C*(*)          i: SubMission in use
C   Instru      C*(*)          i: Instrument in use
C   Datamode    C*(*)        i/r: Datamode name - on return full name of 
C                                 matched Datamode
C   Status      I              r: 0==OK, -1==not found, other==error

      INTEGER best, match, i, iflag, idelim, lenn, lenb, lene

      LOGICAL qdone, qskip

      CHARACTER modstr*255, outname*255, updmode*255, upmods*255

      INTEGER lenact
      EXTERNAL lenact

      Status = 0

      updmode = Datamode
      CALL upc(updmode)

C Get the modes string for this mission and instrument

      CALL XSL_MDBS(Mission, Submis, Instru, ' ', 'modes', modstr, 
     &              Status)

      upmods = modstr
      CALL upc(upmods)

      best = 0
      outname = 'NONE'
      lenn = 0
      qdone = .FALSE.

C Loop around the instruments in the string

      DO WHILE ( .NOT.qdone )

         CALL xgtarg(modstr, lenn, lenb, lene, qskip, iflag, idelim)
         IF ( iflag .NE. 0 ) GOTO 100


C If we have an exact match then we are done

         IF ( upmods(lenb:lenn) .EQ. updmode(1:lenact(updmode)) )
     &       RETURN

C Find how well the input name matches this Datamode

         match = 0
         DO i = lenb, lene
            IF ( index(updmode,upmods(i:i)) .NE. 0 ) match = match + 1
         ENDDO

C If this the best match then set out the output name and obsno

         IF ( match .GT. best ) THEN
            best = match
            outname = modstr(lenb:lene)
         ENDIF

      ENDDO

 100  CONTINUE
      Datamode = outname(:MIN(len(outname),len(Datamode)))

      RETURN
      END



