PROGRAM splitfiles,18
!
!-----------------------------------------------------------------------
!
! Variable Declarations. (Local Variables)
!
!-----------------------------------------------------------------------
!
IMPLICIT NONE
!
!-----------------------------------------------------------------------
!
! Misc. local variables:
!
!-----------------------------------------------------------------------
!
INTEGER nx,ny,nz,nstyps
INTEGER nxsm,nysm
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
!wdt Copyright (c) 2001 Weather Decision Technologies, Inc.
!wdt begin block
REAL, ALLOCATABLE :: buf_r(:,:,:)
INTEGER, ALLOCATABLE :: buf_i(:,:,:)
INTEGER (KIND=selected_int_kind(4)), ALLOCATABLE:: buf_i16(:,:,:)
INTEGER sstat
!wdt end
integer mp_opt_save
!-----------------------------------------------------------------------
!
! 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'
!wdt kwthomas update
!-----------------------------------------------------------------------
!
! Nudging
!
!-----------------------------------------------------------------------
INCLUDE 'nudging.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
! Undo what initpara() did so we don't do this twice and get the wrong answers.
if ( mp_opt > 0 ) then
nx = ( nx - 3 ) * nproc_x + 3;
ny = ( ny - 3 ) * nproc_y + 3;
endif
! 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
!wdt Copyright (c) 2001 Weather Decision Technologies, Inc.
IF ((inifmt == 3) .or. (ternfmt == 1) .or. (exbcfmt == 1) .or. &
(soilfmt == 1) .or. (sfcfmt == 1)) THEN ! HDF format used
ALLOCATE(buf_r(nxsm,nysm,nz))
ALLOCATE(buf_i(nxsm,nysm,nz))
ALLOCATE(buf_i16(nxsm,nysm,nz))
ENDIF
!-----------------------------------------------------------------------
!
! Split the initial data files
!
!-----------------------------------------------------------------------
IF (initopt == 3) THEN
WRITE (6, *) 'Splitting initial history dump files...'
!wdt Copyright (c) 2001 Weather Decision Technologies, Inc.
! CALL splitdump (inifile,nxsm,nysm,nz)
! CALL splitdump (inigbf,nxsm,nysm,nz)
IF (inifmt == 1) THEN
CALL splitdump
(inifile,nxsm,nysm,nz)
CALL splitdump
(inigbf,nxsm,nysm,nz)
ELSE IF (inifmt == 3) THEN
CALL split_hdf
(inifile,nxsm,nysm,nz,buf_r,buf_i,buf_i16,sstat)
CALL split_hdf
(inigbf,nxsm,nysm,nz,buf_r,buf_i,buf_i16,sstat)
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,nxsm,nysm,nz, nstyps, exbcbufsz)
!----------------------------------------------------------------------
END IF
!
!-----------------------------------------------------------------------
!
! Split the terrain data file
!
!-----------------------------------------------------------------------
IF (ternopt == 2) THEN
WRITE (6, *) 'Splitting terrain file...'
!wdt Copyright (c) 2001 Weather Decision Technologies, Inc.
! CALL splitterrain(terndta,nxsm,nysm)
IF (ternfmt == 1) THEN
CALL split_hdf
(terndta,nxsm,nysm,1,buf_r,buf_i,buf_i16,sstat)
ELSE
CALL splitterrain
(terndta,nxsm,nysm)
ENDIF
END IF
!-----------------------------------------------------------------------
!
! Split the surface and soil data files
!
!-----------------------------------------------------------------------
IF (sfcdat == 2 .or. sfcdat == 3 ) THEN
WRITE (6, *) 'Splitting surface data file...'
!wdt Copyright (c) 2001 Weather Decision Technologies, Inc.
! CALL splitsoil(sfcdtfl,nxsm,nysm,nstyps)
IF (sfcfmt == 1) THEN
CALL split_hdf
(sfcdtfl,nxsm,nysm,1,buf_r,buf_i,buf_i16,sstat)
ELSE
CALL splitsoil
(sfcdtfl,nxsm,nysm,nstyps)
ENDIF
END IF
IF ((soilinit == 2 .or. soilinit == 3 ) .AND. (initopt == 3)) THEN
WRITE (6, *) 'Splitting soil data file...'
!wdt Copyright (c) 2001 Weather Decision Technologies, Inc.
! CALL splitsoilini(soilinfl,nxsm,nysm,nstyps)
IF (soilfmt == 1) THEN
CALL split_hdf
(soilinfl,nxsm,nysm,1,buf_r,buf_i,buf_i16,sstat)
ELSE
CALL splitsoilini
(soilinfl,nxsm,nysm,nstyps)
ENDIF
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)
!
! We will need to turn off "mpi_opt" when getbcfn() is called, as that routine
! will want to try to read the split file which doesn't exist.
!
mp_opt_save = mp_opt
DO i = 1, numfiles+1
abstfcst = abstinit + (i-1) * tintvebd + nint(tstart)
mp_opt = 0
CALL getbcfn
(abstfcst, exbcname, tinitebd, tintvebd, &
filename, lfname, istat)
! Restore the value
mp_opt = mp_opt_save
!wdt update: filename -> filename(1:lfname) in loop below
IF (istat == 0) THEN
!wdt Copyright (c) 2001 Weather Decision Technologies, Inc.
! CALL splitexbc(filename(1:lfname),nxsm,nysm,nz)
IF (exbcfmt == 1) THEN
CALL split_hdf
(filename(1:lfname),nxsm,nysm,nz, &
buf_r,buf_i,buf_i16,sstat)
ELSE
!wdt update
CALL splitexbc
(filename(1:lfname)//' ',nxsm,nysm,nz)
ENDIF
END IF
END DO
END IF
!wdt kwthomas update
!-----------------------------------------------------------------------
!
! Split the "incr" files.
!
!-----------------------------------------------------------------------
IF (nudgopt == 1 ) THEN
WRITE (6,*) 'splitting incr file'
! WRITE (6,*) "WARNING: INCR files currently not supported."
!wdt Copyright (c) 2002 Weather Decision Technologies, Inc.
CALL split_hdf
(incrfnam,nxsm,nysm,nz,buf_r,buf_i,buf_i16,sstat)
ENDIF
!wdt Copyright (c) 2001 Weather Decision Technologies, Inc. deallocate
IF ((inifmt == 3) .or. (ternfmt == 1) .or. (exbcfmt == 1) .or. &
(soilfmt == 1) .or. (sfcfmt == 1)) THEN ! HDF format used
DEALLOCATE(buf_r)
DEALLOCATE(buf_i)
DEALLOCATE(buf_i16)
ENDIF
call arpsstop
("Normal Finish", 0)
END PROGRAM splitfiles