!+ Subroutine to open anon-specific file for output.
!
! Method:
!       Straightforward.
!
! Current Owner of Code: J. M. Edwards
!
! History:
!       Version         Date                    Comment
!       1.0             12-04-95                First Version under RCS
!                                               (J. M. Edwards)
!
! Description of Code:
!   FORTRAN 77  with extensions listed in documentation.
!
!- ---------------------------------------------------------------------
      SUBROUTINE OPEN_FILE_OUT(IERR, IUNIT, REQUEST)
!
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/error.pcf'
!
!     DUMMY ARGUMENTS.
      INTEGER	!, INTENT(OUT)
     &     IERR
!             ERROR FLAG
      INTEGER	!, INTENT(IN)
     &     IUNIT
!             I/O UNIT NUMBER
      CHARACTER	!, INTENT(IN)
     &     REQUEST*(*)
!             REQUEST PROMPT FOR FILE
!
!     LOCAL VARAIBLES.
!
      LOGICAL
     &     LOCK_CODE
!             LOGICAL TO FORBID INTERACTIVE LOOPING
      EXTERNAL
     &     LOCK_CODE
!
      CHARACTER
     &     CHAR_YN*1
!             TERMINAL RESPONSE
     &   , FILE_OUT*80
!             NAME OF OUTPUT FILE
      INTEGER
     &     IOS
!             I/O ERROR FLAG
      LOGICAL
     &     L_OPEN
!             OPEN FLAG
     &   , L_EXIST
!             EXISTENCE FLAG
!
!
!     CHECK WHETHER THE UNIT FOR THE OUTPUT FILE IS ALREADY OPEN.
      INQUIRE(UNIT=IUNIT, OPENED=L_OPEN)
      IF (L_OPEN) THEN
         WRITE(IU_ERR, '(/, A16, I5, A)') '*** ERROR: UNIT ', IUNIT
     &      , ' IS ALREADY OPEN ELSEWHERE.'
         IERR=I_ERR_IO
         RETURN
      ENDIF
!
!     REQUEST THE NAME OF THE OUTPUT FILE.
      WRITE(IU_USER, '(/A)') REQUEST
      READ(IU_STDIN, '(A)') FILE_OUT
!
!     CHECK WHETHER THE FILE EXISTS.
100   INQUIRE(FILE=FILE_OUT, EXIST=L_EXIST)
      IF (L_EXIST) THEN
         INQUIRE(FILE=FILE_OUT, OPENED=L_OPEN)
         WRITE(IU_ERR, '(/A)') 'THIS FILE ALREADY EXISTS.'
         IF (L_OPEN) THEN
            WRITE(IU_USER, '(A)') 'THIS FILE IS ALREADY OPEN.'
         ENDIF
         IF (LOCK_CODE(.TRUE.)) THEN
            INCLUDE 'batch_error.finc'
         ELSE
            WRITE(IU_USER, '(/A/)') 'DO YOU WISH TO OVERWRITE? (Y/N).'
            READ(IU_STDIN, '(A)') CHAR_YN
            IF ( (CHAR_YN.NE.'Y').AND.(CHAR_YN.NE.'y') ) THEN
               WRITE(IU_USER, '(/A/)')
     &            'PLEASE SPECIFY ANOTHER NAME OR QUIT.'
               READ(IU_STDIN, '(A)') FILE_OUT
               IF ( (FILE_OUT(1:2).EQ.'?Q').OR.
     &              (FILE_OUT(1:2).EQ.'?q') ) THEN
                  WRITE(IU_USER, '(/A/)') '*** PROGRAM TERMINATED.'
                  IERR=I_ERR_FATAL
                  RETURN
               ELSE
                  GOTO 100
               ENDIF
            ENDIF
         ENDIF
      ENDIF
!
!     FILE MAY NOW SAFELY BE OPENED.
      OPEN(UNIT=IUNIT, FILE=FILE_OUT, IOSTAT=IOS
     &   , STATUS='UNKNOWN'
     &   )
      IF (IOS.NE.0) THEN
         WRITE(IU_ERR, '(/, 3A)') '*** ERROR: FILE', FILE_OUT
     &      , ' COULD NOT BE OPENED.'
         IERR=I_ERR_IO
         RETURN
      ENDIF
!
!
      RETURN
      END
