SUBROUTINE headbc (nbounc, idelpro, fr1, iubc, iu06, nest)
! ----------------------------------------------------------------------
!**** *HEADBC* - OUTPUT OF THE COARSE GRID BOUNDARY VALUE FILE HEADER.
!     R. PORTZ     MPI          JANUARY 1991
!*    PURPOSE.
!     --------
!       WRITE A HEADER TO THE BOUNDARY VALUE OUTPUT FILE.
!**   INTERFACE.
!     ----------
!       *CALL* *HEADBC (NBOUNC, IDELPRO, FR1, IU19, IU06)*
!          *NBOUNC*  - NUMBER OF OUTPUT POINTS.
!          *IDELPRO* - PROPAGATION = OUTPUT TIMESTEP (SECONDS).
!          *FR1*     - FIRST FREQUENCY (HERTZ).
!          *IU19*    - OUTPUT UNIT OF BOUNDARY VALUES.
!          *IU06*    - PRINTER OUTPUT UNIT.
!     METHOD.
!     -------
!       SEQUENCIAL UNFORMATED WRITE TO UNIT.
!     EXTERNALS.
!     ----------
!       *ABORT*     - TERMINATES PROCESSING.
!     REFERENCE.
!     ----------
!       NONE.
! ----------------------------------------------------------------------
USE params ; USE fredir
IMPLICIT NONE

REAL   , INTENT(IN):: fr1
INTEGER, INTENT(IN):: nbounc(nests), idelpro, iubc, iu06, nest

!     PARAMETER (TH0 = 0., CO = 1.1)
REAL,PARAMETER :: co = 1.1
!*     VARIABLE.   TYPE.     PURPOSE.
!      ---------   -------   --------
!        *TH0*     REAL      FIRST DIRECTION IN DEGREES.
!        *CO*      REAL      FREQUENCY RATIO.
REAL :: th0, xang, xbou, xdel, xfre
! ----------------------------------------------------------------------
th0 = th(1)
!*    1. FORMAT AND WRITE HEADER.
!        ------------------------
xang = REAL (nang)
xfre = REAL (nfre)
xbou = REAL (nbounc (nest) )
xdel = REAL (idelpro)

WRITE( iubc, ERR = 2000) xang, xfre, th0, fr1, co, xbou, xdel
RETURN
! ----------------------------------------------------------------------
!*    2. ERROR MESSAGE.
!        --------------
2000 CONTINUE
WRITE(iu06,*) '****************************************'
WRITE(iu06,*) '*                                      *'
WRITE(iu06,*) '*    FATAL ERROR IN SUB. HEADBC        *'
WRITE(iu06,*) '*    ===========================       *'
WRITE(iu06,*) '*                                      *'
WRITE(iu06,*) '*    WRITE ERROR FROM UNIT : IUBC = ', iubc
WRITE(iu06,*) '*                                      *'
WRITE(iu06,*) '*        PROGRAM ABORTS                *'
WRITE(iu06,*) '****************************************'

CALL ABORT
END SUBROUTINE headbc
