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