C**********************************************************************
C**********************************************************************
C** 
C**  File: writebinex1.for
C**
C**  Description: An example of how to use the writebin routines.
C**
C**  Date: 17th July 2004
C**
C**********************************************************************
C**
C** Copyright (c) 2004 Scott A. Belmonte
C** All rights reserved.
C**
C** Redistribution and use in source and binary forms, with or without 
C** modification, are permitted provided that the following conditions
C** are met:
C**
C** Redistributions of source code must retain the above copyright
C** notice, this list of conditions and the following disclaimer.
C**
C** Redistributions in binary form must reproduce the above copyright
C** notice, this list of conditions and the following disclaimer in
C** the documentation and/or other materials provided with the
C** distribution.
C**
C** Neither the name of the copyright holder nor the names of any
C** contributors may be used to endorse or promote products derived
C** from this software without specific prior written permission.
C**
C** THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND
C** CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
C** INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
C** MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
C** DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS
C** BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
C** EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
C** TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
C** DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
C** ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR
C** TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF
C** THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
C** SUCH DAMAGE.
C**
C**********************************************************************
C**********************************************************************
      PROGRAM WRITE_BIN_EX1
      IMPLICIT NONE
C
C     Functions
C
      INTEGER WRITE_BIN_UINT16
      INTEGER WRITE_BIN_REAL
      INTEGER WRITE_BIN_FILE
C
C     Variables
C
      INTEGER   REAL_SIZE          ! Size of REAL in bytes
      PARAMETER(REAL_SIZE = 4)
C
      INTEGER   UINT16_SIZE        ! Size of UINT16 in bytes
      PARAMETER(UINT16_SIZE = 2)
C
      INTEGER   HEIGHT
      PARAMETER(HEIGHT = 620)
C
      INTEGER   WIDTH
      PARAMETER(WIDTH = 480)
C
      INTEGER   HDR_SIZE           ! Header size (2 UINT16s)
      PARAMETER(HDR_SIZE = 2*UINT16_SIZE)
C
      INTEGER   FILELEN            ! Length of file in bytes
      PARAMETER(FILELEN = HDR_SIZE + WIDTH*HEIGHT*REAL_SIZE)
C
      BYTE      BUFFER(FILELEN)    ! Buffer to hold the file
      REAL      DATA(WIDTH*HEIGHT) ! Data to be written
      INTEGER   I, INDEX
C
C     Initialise buffer
C
      DO I = 1, FILELEN
          BUFFER(I) = 0
      ENDDO
C
C     Fill DATA with an arbitrary number, 3.1416,
C     for this example
C
      DO I = 1, WIDTH*HEIGHT
          DATA(I) = 3.1416
      ENDDO
C
C     Write the width and height to the buffer as
C     unsigned 16-bit (2 byte) integers. Then write
C     the data to the buffer. The byte order is not
C     swapped.
C
      INDEX = 1
      INDEX = INDEX + WRITE_BIN_UINT16(BUFFER(INDEX), WIDTH, .FALSE.)
      INDEX = INDEX + WRITE_BIN_UINT16(BUFFER(INDEX), HEIGHT, .FALSE.)
      DO I = 1, WIDTH*HEIGHT
        INDEX = INDEX + WRITE_BIN_REAL(BUFFER(INDEX), DATA(I), .FALSE.)
      ENDDO
C
C     Write buffer to a file.
C
      IF (WRITE_BIN_FILE('example.dat', BUFFER, FILELEN) .NE. 0)
     $    GOTO 901
      RETURN
C
C     Error traps
C
 901  WRITE(*,*) '** Error writing binary file!'
      RETURN
      END
C