C @(#)vmsdaosubs.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
C
C VMS-specific routines, mostly for ASCII input and output.
C
C Peter B. Stetson                      1991 April 18
C
C#######################################################################
C
      SUBROUTINE  INFILE (LUN, FILE, IFLAG)
      IMPLICIT    NONE
C
C=======================================================================
C
C VAX/VMS FORTRAN-specific subroutine to open a sequential disk data
C file for reading.
C
C Input arguments
C
C IFILE  is the logical unit number to be used.
C
C  FILE  is the filename.
C
C Output argument
C
C IFLAG  is an error flag: = 0 if no problem; = -1 if the file could 
C        not be opened.
C
C=======================================================================
C
      CHARACTER*30 FILE
      INTEGER      LUN
      INTEGER      IFLAG
C
C-----------------------------------------------------------------------
C
      OPEN (LUN, FILE=FILE, STATUS='OLD', ERR=9100, READONLY)
      IFLAG=0
      RETURN                                             ! Normal return
C
C-----------------------------------------------------------------------
C
C Error
C
 9100 IFLAG=-1
      RETURN
      END!
C
C#######################################################################
C
      SUBROUTINE  OUTFIL (LUN, FILE, ISTAT)
      IMPLICIT    NONE
C
C=======================================================================
C
C VAX/VMS FORTRAN-specific subroutine to open a sequential disk data
C file for writing.
C
C Input arguments
C
C   LUN  is the logical unit number to be used.
C  FILE  is the filename
C
C=======================================================================
C
      CHARACTER*30 FILE
      INTEGER      LUN
      INTEGER      ISTAT
C
      OPEN (LUN, FILE=FILE, STATUS='NEW', CARRIAGECONTROL='FORTRAN')
      ISTAT = 0
      RETURN
      END!
C
C#######################################################################
C
      SUBROUTINE  CLFILE (IFILE)
      IMPLICIT NONE
C=======================================================================
C
C VAX/VMS FORTRAN-specific subroutine to close a sequential disk data
C file.
C
C Input argument
C
C IFILE  is the logical unit number.
C
C=======================================================================
      INTEGER  IFILE
C
      CLOSE (IFILE)
      RETURN
      END!
C
C#######################################################################
C
      CHARACTER*(*) FUNCTION CASE (STRING)
      CHARACTER*(*) STRING
      INTEGER       LS
      INTEGER       LC
      INTEGER       I
      INTEGER       J
C=========================================================================
C
C For VMS, force lower-case letters to upper case.
C
      LS = LEN(STRING)
      LC = LEN(CASE)
      DO I=1,MIN(LC,LS)
         J = ICHAR(STRING(I:I))
         IF ((J .GE. 97) .AND. (J .LE. 122)) THEN
            J = J-32
            CASE(I:I) = CHAR(J)
         ELSE
            CASE(I:I) = STRING(I:I)
         END IF
      END DO
      IF (LC .GT. LS) CASE(LS+1:LC) = ' '
      RETURN
      END!
C
C#######################################################################
C
      SUBROUTINE OVRWRT (LINE, IWHICH)
      IMPLICIT   NONE
      CHARACTER*(*) LINE
      INTEGER       IWHICH
C
      IF (IWHICH .EQ. 1) THEN
C
C Do not overwrite anything.  Do not allow to be overwritten by forcing
C an extra carriage return.
C        
         WRITE (6,1) LINE
    1    FORMAT (' ', A/)
      ELSE IF (IWHICH .EQ. 2) THEN
C
C Overwrite.  Allow to be overwritten.
C
         WRITE (6,2) LINE
    2    FORMAT ('+', A)
      ELSE IF (IWHICH .EQ. 3) THEN
C
C Overwrite, but do not allow to be overwritten.
C
         WRITE (6,3) LINE
    3    FORMAT ('+', A/)
      ELSE
C
C Do not overwrite, but allow to be overwritten
C
         WRITE (6,4) LINE
    4    FORMAT (' ', A)
      END IF
      RETURN
      END!
C
C#######################################################################
C
      SUBROUTINE  BYEBYE
      IMPLICIT   NONE
      WRITE (6,6)
    6 FORMAT (/' Goodbye.'/)
      CALL EXIT
      END!
C
C#######################################################################
C
      SUBROUTINE  OOPS
      IMPLICIT   NONE
      WRITE (6,6)
    6 FORMAT (/' Sorry about that.'/)
      CALL EXIT
      END!
C
C#######################################################################
C
      SUBROUTINE FABORT
      IMPLICIT   NONE
C
C Dummy subroutine --- needed on Suns.
C
      RETURN
      END!