C @(#)tderror.for	17.1.1.1 (ES0-DMD) 01/25/02 17:47:14
C===========================================================================
C Copyright (C) 1995 European Southern Observatory (ESO)
C
C This program is free software; you can redistribute it and/or 
C modify it under the terms of the GNU General Public License as 
C published by the Free Software Foundation; either version 2 of 
C the License, or (at your option) any later version.
C
C This program is distributed in the hope that it will be useful,
C but WITHOUT ANY WARRANTY; without even the implied warranty of
C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
C GNU General Public License for more details.
C
C You should have received a copy of the GNU General Public 
C License along with this program; if not, write to the Free 
C Software Foundation, Inc., 675 Massachusetss Ave, Cambridge, 
C MA 02139, USA.
C
C Corresponding concerning ESO-MIDAS should be addressed as follows:
C	Internet e-mail: midas@eso.org
C	Postal address: European Southern Observatory
C			Data Management Division 
C			Karl-Schwarzschild-Strasse 2
C			D 85748 Garching bei Muenchen 
C			GERMANY
C===========================================================================
C
C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C.COPYRIGHT: Copyright (c) 1987 European Southern Observatory,
C                                         all rights reserved
C
C.VERSION: 1.0  ESO-FORTRAN Conversion, AA  17:27 - 11 DEC 1987
C
C.LANGUAGE: F77+ESOext
C
C.AUTHOR: J.D.PONZ
C  900219  KB, throw out SX calls...
C  901008  MP, add call to GENLGN....
C
C.IDENTIFICATION        TDERROR.FOR
C.KEYWORDS           TABLE, APPLICATIONS
C.ENVIRONMENT  MIDAS
C.PURPOSE
C              Display error messages for different user levels
C
C------------------------------------------------------------------
      SUBROUTINE TDERRR(ERROR,MSG,STATUS)
      IMPLICIT NONE
      INTEGER ERROR      !   IN  : ERROR CODE
      CHARACTER*(*) MSG  !   IN  : MESSAGE
      INTEGER STATUS     !   OUT : STATUS
C
      INTEGER IERR,STAT,IAV,ICODE,KUN,KNUL
      CHARACTER*3 ERRLAB
      CHARACTER*60 ERRFIL,FILNAM*80
      CHARACTER*8 KEY
      CHARACTER*80 MESS
C
      ERRFIL = 'MID_INCLUDE:APP1ERR.INC'//' '
      IF (ERROR.GE.0) THEN
          MESS = 'TBL_'//MSG
          CALL STETER(ERROR,MESS)
      ELSE
          IERR   = -ERROR
C
C ... convert error code into ASCII
C
          WRITE (ERRLAB,9000) IERR
C
C ... branch according to error level
C
          CALL GENLGN(ERRFIL,FILNAM,80) 
          CALL STKRDI('ERROR',2,1,IAV,ICODE,KUN,KNUL,STAT)
          GO TO (20,10,30),ICODE + 1
C
C  novice user (= 1)
   10     KEY    = 'NOVICE.'
          CALL DISFIL(FILNAM,KEY(1:7),ERRLAB,STAT)
          GO TO 40
C
C  average user (= 0, default)
   20     KEY    = 'USER.'
          CALL DISFIL(FILNAM,KEY(1:5),ERRLAB,STAT)
          GO TO 40
C
C  expert user (= 2)
   30     KEY    = 'EXPERT.'
          CALL DISFIL(FILNAM,KEY(1:7),ERRLAB,STAT)
      END IF

   40 RETURN
C
 9000 FORMAT (I3.3)
      END