PROGRAM joinfiles,3
!
!-----------------------------------------------------------------------
!
!  To join together history dumps files produced by the processors
!  of MPP machines with message passing.
!
!  Variable Declarations. (Local Variables)
!
!-----------------------------------------------------------------------
!
!  MODIFICATION HISTORY.
!
!  11/06/1995 (M. Xue)
!  Set the start time for file joining to zero instead of tstart.
!  tstart may not be at the history dump time for a restart run.
!  The program will skip the times when the corresponding files
!  are not found.
!
!-----------------------------------------------------------------------
!
  IMPLICIT NONE
!
!-----------------------------------------------------------------------
!
!  Misc. local variables:
!
!-----------------------------------------------------------------------
!
  INTEGER :: nx,ny,nz,nstyps
  INTEGER :: nxsm,nysm

  REAL :: wrmax            ! Maximun value of canopy moisture
  INTEGER :: i

  CHARACTER (LEN=80  ) :: logfn  ! A string used as the log file filename.
  INTEGER :: llogfn      ! The length of the log file filename.
  CHARACTER (LEN=80) :: tmplnth  ! Temporary array to store namelist logname
  INTEGER :: nlogfn      ! The length of the namelog file filename.
  INTEGER :: logfunt     ! FORTRAN unit number for log file output.
  INTEGER :: lenstr      ! Length of a string
  INTEGER :: istat       ! Flag set by open statement on the status
                         ! of file opening
  LOGICAL :: iexist      ! Flag set by inquire statement for file
                         ! existence
  REAL :: temscl      ! Grid scale used to calculate cdvdmp
  REAL :: dtsml0,dtsfc0    ! Temporary variable

  CHARACTER (LEN=19) :: initime  ! Real time in form of 'year-mo-dy:hr:mn:ss'
  INTEGER :: ndumps, time
  CHARACTER (LEN=80) :: next
!
!-----------------------------------------------------------------------
!
!  Include files:
!
!-----------------------------------------------------------------------
!
  INCLUDE 'mp.inc'
!
!-----------------------------------------------------------------------
!
!  Global constants and parameters, most of them specify the
!  model run options.
!
!-----------------------------------------------------------------------
!
  INCLUDE 'globcst.inc'
!
!-----------------------------------------------------------------------
!
!  Control parameters defining the boundary condition types.
!
!-----------------------------------------------------------------------
!
  INCLUDE 'bndry.inc'
!
!-----------------------------------------------------------------------
!
!  Universal physical constants such as gas constants.
!
!-----------------------------------------------------------------------
!
  INCLUDE 'phycst.inc'
!
!-----------------------------------------------------------------------
!
!  External boundary parameters and variables.
!
!-----------------------------------------------------------------------
!
  INCLUDE 'exbc.inc'
!
!-----------------------------------------------------------------------
!
!  namelist Declarations:
!
!-----------------------------------------------------------------------
!

!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
!  Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
!-----------------------------------------------------------------------
!
!  Read the input file to check what input options, which need input
!  data files have been set.
!
!-----------------------------------------------------------------------
!
  CALL initpara(nx, ny, nz, nstyps)
  nproc_x = nproc_x_in
  nproc_y = nproc_y_in

  ! Convert to processor nx & ny (initpara thinks we're in non-MP mode)

  IF (nx /= nproc_x*int((nx-3)/nproc_x)+3) THEN
    nx = nproc_x*int((nx-3)/nproc_x+0.9999999999999) + 3
    IF (myproc == 0) THEN
      WRITE (6,*) "WARNING: adjusting nx to fit on ",nproc_x," processors:"
      WRITE(6,'(5x,a,i5)') "   new nx =",nx
    ENDIF
  ENDIF
  IF (ny /= nproc_y*int((ny-3)/nproc_y)+3) THEN
    ny = nproc_y*int((ny-3)/nproc_y+0.9999999999999) + 3
    IF (myproc == 0) THEN
      WRITE (6,*) "WARNING: adjusting ny to fit on ",nproc_y," processors:"
      WRITE(6,'(5x,a,i5)') "   new ny =",ny
    ENDIF
  ENDIF

  nxsm = (nx - 3)/nproc_x + 3
  nysm = (ny - 3)/nproc_y + 3

  IF( thisdmp == 0.0 ) THEN
    PRINT*,                                                             &
        'The history dump option was off. No file joining was done.'
    STOP
  END IF

  ndumps = nint((tstop-tstart)/thisdmp) + 1
!
!-----------------------------------------------------------------------
!
!  Join the base state data dump
!
!-----------------------------------------------------------------------
!
  tmplnth = dirname(1:ldirnam)//'/'//runname(1:lfnkey)//'.bingrdbas'
  CALL joindumps (tmplnth,nxsm,nysm,nz)
!
!-----------------------------------------------------------------------
!
!  Join the history dump files
!
!-----------------------------------------------------------------------
!
  time = INT(tstart)

  DO i = 1, ndumps

    WRITE (next, '(i6.6)') time

    tmplnth = dirname(1:ldirnam)//'/'//                                 &
              runname(1:lfnkey)//'.bin'//next

    CALL joindumps (tmplnth,nxsm,nysm,nz)

    time = time + INT (thisdmp)

  END DO

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

END PROGRAM joinfiles