PROGRAM splitfiles,10
!
!-----------------------------------------------------------------------
!
!  Variable Declarations. (Local Variables)
!
!-----------------------------------------------------------------------
!
  IMPLICIT NONE
!
!-----------------------------------------------------------------------
!
!  Misc. local variables:
!
!-----------------------------------------------------------------------
!
  INTEGER nx,ny,nz,nstyps
  INTEGER nxp,nyp

  INTEGER :: exbcbufsz     ! add by wyh

  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 :: numfiles

  INTEGER :: lfname
  CHARACTER (LEN=80) :: filename
!
!-----------------------------------------------------------------------
!
!  Include files:
!
!-----------------------------------------------------------------------
!
!-----------------------------------------------------------------------
!
!  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'
!
!-----------------------------------------------------------------------
!
!  Message passing variables.
!
!-----------------------------------------------------------------------
!
  INCLUDE 'mp.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

  nxp = (nx - 3)/nproc_x + 3
  nyp = (ny - 3)/nproc_y + 3
!
!-----------------------------------------------------------------------
!
!  Split the initial data files
!
!-----------------------------------------------------------------------
!
  IF (initopt == 3) THEN
    IF (inifmt == 1) THEN
      WRITE (6, *) 'Splitting initial history dump files...'
      CALL splitdump (inifile,nxp,nyp,nz)
      CALL splitdump (inigbf,nxp,nyp,nz)
    ELSE
      WRITE (6, *) 'File not in binary format. Not split'
    END IF
!------------- add by wyh for split restart files ---------------------
  ELSE IF (initopt == 2) THEN
    IF (lbcopt == 2) THEN 
      exbcbufsz = 22*nx*ny*nz
    ELSE
      exbcbufsz = 1
    END IF

    WRITE (6, *) 'Splitting restart file...'
    CALL splitrestart (rstinf,nxp,nyp,nz, nstyps, exbcbufsz)
!----------------------------------------------------------------------
  END IF
!
!-----------------------------------------------------------------------
!
!  Split the terrain data file
!
!-----------------------------------------------------------------------
!

  IF (ternopt == 2) THEN
    WRITE (6, *) 'Splitting terrain file...'
    CALL splitterrain (terndta,nxp,nyp)
  END IF

!
!-----------------------------------------------------------------------
!
!  Split the surface and soil data files
!
!-----------------------------------------------------------------------
!

  IF (sfcdat == 2 .or. sfcdat == 3 ) THEN
    WRITE (6, *) 'Splitting surface data file...'
    CALL splitsoil (sfcdtfl,nxp,nyp,nstyps)
  END IF

  IF ((soilinit == 2 .or. soilinit == 3 ) .AND. (initopt == 3)) THEN
    WRITE (6, *) 'Splitting soil data file...'
    CALL splitsoilini (soilinfl,nxp,nyp,nstyps)
  END IF

!
!-----------------------------------------------------------------------
!
!  Split the external boundary data files
!
!-----------------------------------------------------------------------
!
  IF (lbcopt == 2) THEN
    WRITE (6, *) 'Splitting EXBC files...'
    numfiles = nint((tstop - tstart - dtbig)/tintvebd) + 10
                                       ! Go past the end in case an exbc
! file past the end time is needed.
    CALL ctim2abss ( year,month,day,hour,minute,second, abstinit)
    abststop  = abstinit + nint(tstop)

    DO i = 1, numfiles+1
      abstfcst = abstinit + (i-1) * tintvebd + nint(tstart)
      CALL getbcfn (abstfcst, exbcname, tinitebd, tintvebd,             &
           filename, lfname, istat)
      filename(lfname+1:lfname+1) = " "

      IF (istat == 0) THEN
        CALL splitexbc (filename,nxp,nyp,nz)
      END IF
    END DO
  END IF

  STOP
END PROGRAM splitfiles