C @(#)sunsubs.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
      subroutine fabort
      call sun_abort
      return
      end
c
c=================================================================
c
      subroutine clfile (lun)
      close (lun)
      end
c
c=========================================================================
c
      subroutine byebye
      write (6,*)
      write (6,*) 'Good bye.'
      write (6,*)
      stop
      end
c
c==========================================================================
c
      subroutine  oops
      write (6,*)
      write (6,*) 'Sorry about that.'
      write (6,*)
      stop
      end
c
c==============================================================================
c
      subroutine infile (lun, file, istat)
      character*100 expand
      character*30 file
      open (lun, file=expand(file), status='old', err=999)
      istat = 0
      return
  999 istat = -1
      return
      end
c
c========================================================
c
      character*100 function expand(file)
      character*30 file
      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)
      character*100 expand
      character*30 file, answer
      logical exist
 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)
      character*(*) string
c
c For UNIX, leave the cases of the characters alone!
c
      case = string
      return
      end 
c
c
c
      subroutine ovrwrt (line, iwhich)
      character*(*) line
      character*79 output
      integer len
      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)
    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