C @(#)unxdaosubs.for	17.1.1.1 (ES0-DMD) 01/25/02 17:14:10
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 010322		last modif
C 
C===========================================================================
C
      SUBROUTINE FABORT
      IMPLICIT     NONE
      RETURN
      END
C
C=================================================================
C
      SUBROUTINE CLFILE (LUN)
      IMPLICIT NONE
      INTEGER  LUN
      CLOSE (LUN)
      END
C
C=========================================================================
C
      SUBROUTINE BYEBYE
      IMPLICIT NONE
      WRITE (6,*)
      WRITE (6,*) 'Good bye.'
      WRITE (6,*)
      STOP
      END
C
C==========================================================================
C
      SUBROUTINE  OOPS
      IMPLICIT     NONE
      WRITE (6,*)
      WRITE (6,*) 'Sorry about that.'
      WRITE (6,*)
      STOP
      END
C
C==============================================================================
C
      SUBROUTINE INFILE (LUN, FILE, ISTAT)
      IMPLICIT     NONE
      INTEGER      LUN	
      CHARACTER*30 FILE
      INTEGER      ISTAT
C
      CHARACTER*100 EXPAND
      OPEN (LUN, FILE=EXPAND(FILE), STATUS='OLD', ERR=999)
      ISTAT = 0
      RETURN
  999 ISTAT = -1
      RETURN
      END
C
C========================================================
C
      CHARACTER*(*) FUNCTION EXPAND(FILE)
      IMPLICIT     NONE
      CHARACTER*30 FILE
      INTEGER I
      INTEGER J
      INTEGER K
C
      K = 0
      DO I=2,29
         IF (FILE(I:I) .EQ. ':') THEN
            CALL GETENV (FILE(1:I-1), EXPAND)
            DO J=1,100
               IF (EXPAND(J:J) .NE. ' ') K=J
            END DO
            IF (K .NE. 0) THEN
               EXPAND = EXPAND(1:K)//'/'//FILE(I+1:30)
               RETURN
            END IF
         END IF
      END DO
      EXPAND = FILE
      RETURN
      END
C
C======================================================
C
      SUBROUTINE OUTFIL (LUN, FILE, ISTAT)
      IMPLICIT     NONE
      INTEGER      LUN
      CHARACTER*30 FILE
      INTEGER      ISTAT
      CHARACTER*30 ANSWER
      CHARACTER*100 EXPAND
      LOGICAL EXIST
C
 1000 INQUIRE (FILE=EXPAND(FILE), EXIST=EXIST)
      IF (EXIST) THEN
         CALL STUPID ('This file already exists: '//FILE)
         ANSWER = 'OVERWRITE'
         CALL GETNAM ('NEW OUTPUT FILE NAME:', ANSWER)
         IF (ANSWER .EQ. 'OVERWRITE') THEN
            OPEN (LUN, FILE=EXPAND(FILE), STATUS='OLD')
            CLOSE (LUN, STATUS='DELETE')
         ELSE
            FILE = ANSWER
            GO TO 1000
         END IF
      END IF
      OPEN (LUN, FILE=EXPAND(FILE), STATUS='NEW', IOSTAT=ISTAT)
      RETURN
      END
C
C====================================================
C
      CHARACTER*(*) FUNCTION CASE (STRING)
      IMPLICIT      NONE
      CHARACTER*(*) STRING
C
C FOR UNIX, LEAVE THE CASES OF THE CHARACTERS ALONE!
C
      CASE = STRING
      RETURN
      END 
C
C
C====================================================
C
      SUBROUTINE OVRWRT (LINE, IWHICH)
      IMPLICIT      NONE
      CHARACTER*(*) LINE
      INTEGER       IWHICH
C
      CHARACTER*79 OUTPUT
      INTEGER LEN
C
      IF (IWHICH .EQ. 1) THEN
         WRITE (6,1) LINE
    1    FORMAT (A)
      ELSE IF (IWHICH .EQ. 2) THEN
         IF (LEN(LINE) .LT. 79) THEN
            OUTPUT = ' '
            OUTPUT = LINE
            WRITE (6,2) OUTPUT, CHAR(13)
            WRITE (6,2) OUTPUT, CHAR(13)
    2       FORMAT (A, A1, $)
         ELSE
            WRITE (6,2) LINE, CHAR(13)
         END IF
      ELSE IF (IWHICH .EQ. 3) THEN
         WRITE (6,3) LINE
    3    FORMAT (A)
      ELSE
         WRITE (6,4) LINE, CHAR(13)
    4    FORMAT (/A, A1, $)
      END IF
      RETURN
      END
C