!##################################################################
!##################################################################
!######                                                      ######
!######                SUBROUTINE HDFREAD                    ######
!######                                                      ######
!######                     Developed by                     ######
!######     Center for Analysis and Prediction of Storms     ######
!######                University of Oklahoma                ######
!######                                                      ######
!##################################################################
!##################################################################


PROGRAM join_bin2hdf,2
!
!-----------------------------------------------------------------------
!
!  To join together a set of ARPS history or data files produced by the
!  processors of MPP machines with message passing.
!
!  Input data file is in binary format and the output is in HDF4 format
!
!-----------------------------------------------------------------------
!
!  AUTHOR:
!  Yunheng Wang (05/16/2002)
!  based on joinhdf.f90
!
!  MODIFICATION HISTORY.
!
!
!-----------------------------------------------------------------------
!
  IMPLICIT NONE

  INCLUDE 'mp.inc'
!
!-----------------------------------------------------------------------
!
!  Misc. local variables:
!
!-----------------------------------------------------------------------
!
  INTEGER nxsm,nysm,nz, nstyps
  INTEGER ireturn

  CHARACTER (LEN=120) :: filename
  CHARACTER (LEN=120) :: filename1
  
  INTEGER :: hdfcmpropt

!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
!  Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
  WRITE(*,*) "Enter the filename (base name):"
  READ(*,'(a)') filename
  WRITE(*,*) "Enter nproc_x, nproc_y:"
  READ(*,*) nproc_x, nproc_y
  WRITE(*,*) "Enter  hdfcompr  HDF4 compression option:"      
!  WRITE(*,*) "     = 0  no compression;"
!  WRITE(*,*) "     = 1, fast gzip compression;"
!  WRITE(*,*) "     = 2, high gzip compression;"
!  WRITE(*,*) "     = 3, adaptive or skipping Huffman compression;"
!  WRITE(*,*) "     = 4-7, as above plus mapping reals to 16 bit integers."
!  WRITE(*,*) "       Note that only options 0-2 work on Cray platforms."
  READ(*,*) hdfcmpropt

  filename1 = TRIM(filename)//"_0101"

  CALL get_dims_from_data(1,filename1,nxsm,nysm,nz,nstyps, ireturn)

  IF (ireturn /= 0) THEN
    WRITE (6,*) 'JOINFILE: WARNING, error returned from get_dims_from_data', &
       ireturn
  ENDIF

  WRITE (6, *) 'Joining files ...'

  CALL joinbin2hdf (filename,nxsm,nysm,nz,nstyps,hdfcmpropt)

  WRITE (6, *) 'Done joining files ...'

END PROGRAM join_bin2hdf