PROGRAM split_general,3 !----------------------------------------------------------------------- ! ! PURPOSE: ! Split any files in either HDF 4 format or netCDF format into ! patches. The files can contain 1d, 2d, 3d or 4d either integer ! arrays or float arrays. The patched files will contain the same ! data as original file but in evenly divided subdomain specified ! by the user. ! !----------------------------------------------------------------------- ! ! Author: Yunheng Wang (10/27/2006) ! ! MODIFICATIONS: ! !----------------------------------------------------------------------- ! IMPLICIT NONE !----------------------------------------------------------------------- ! ! NAMELIST variables ! !----------------------------------------------------------------------- INTEGER :: finfmt ! = 3, for HDF4 ! = 7, for netCDF INTEGER :: finopt ! = 1, regular files ! = 2, explicit list CHARACTER(LEN=256) :: fheader ! for finopt = 1 only CHARACTER(LEN=256) :: ftrailer REAL :: tintv_in REAL :: tbgn_in REAL :: tend_in INTEGER, PARAMETER :: nfile_max = 100 ! for finopt = 2 INTEGER :: nfile ! also used for general purpose CHARACTER(LEN=256) :: filenames(nfile_max) NAMELIST /file_names/ finfmt, finopt, fheader, ftrailer, & tbgn_in,tintv_in,tend_in, nfile, filenames INTEGER :: nproc_x, nproc_y LOGICAL :: dimnamein CHARACTER(LEN=256) :: xdimname, ydimname LOGICAL :: stagdims INTEGER :: varidx, nxidx, nyidx NAMELIST /message_passing/ nproc_x, nproc_y, & dimnamein, xdimname, ydimname, stagdims, & varidx, nxidx, nyidx CHARACTER(LEN=256) :: outdirname NAMELIST /output/ outdirname INTEGER :: debug NAMELIST /debugging/ debug ! !----------------------------------------------------------------------- ! ! Misc. local variables ! !----------------------------------------------------------------------- INTEGER :: nf INTEGER :: istatus !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ! ! Begin of executable code below ! !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ finfmt = 7 finopt = 2 fheader = ' ' ftrailer = ' ' tintv_in = 0.0 tbgn_in = 0.0 tend_in = 0.0 nfile = 0 filenames(:) = ' ' READ(5,file_names,ERR=999) WRITE(6,'(1x,a)' ) 'Namelist file_names was successfully read.' WRITE(6,'(3x,a,i3)') 'Input finopt = ', finopt WRITE(6,'(3x,a,i3)') 'Input finfmt = ', finfmt IF (finopt == 1) THEN CALL getinfns(finfmt, fheader, ftrailer, tintv_in, tbgn_in, tend_in,& filenames, nfile_max, nfile, istatus) IF (istatus < 0) STOP END IF WRITE(6,'(3x,a,i3)') 'Input nfile = ', nfile WRITE(6,'(3x,a)') 'Files to split are:' DO nf=1,nfile WRITE(6,'(7x,a,i3,a,a)') 'No.',nf,' is ',TRIM(filenames(nf)) END DO nproc_x = 1 nproc_y = 1 dimnamein = .TRUE. xdimname = ' ' ydimname = ' ' stagdims = .FALSE. varidx = 2 nxidx = 1 nyidx = 2 READ(5,message_passing,ERR=999) WRITE(6,'(/,1x,a)' ) 'Namelist message_passing was successfully read.' WRITE(6,'(3x,a,i3)') 'nproc_x = ', nproc_x WRITE(6,'(3x,a,i3)') 'nproc_y = ', nproc_y WRITE(6,'(3x,a,l2)') 'dimnamein = ', dimnamein WRITE(6,'(3x,a,I2)') ' varidx = ', varidx WRITE(6,'(3x,a,I2)') ' nxidx = ', nxidx WRITE(6,'(3x,a,I2)') ' nyidx = ', nyidx WRITE(6,'(3x,a,a)') 'xdimname = ', TRIM(xdimname) WRITE(6,'(3x,a,a)') 'ydimname = ', TRIM(ydimname) WRITE(6,'(3x,a,L2)') 'stagdims = ', stagdims outdirname = './' READ(5,output,ERR=999) WRITE(6,'(/,1x,a)' ) 'Namelist output was successfully read.' WRITE(6,'(3x,2a)') 'outdirname = ', TRIM(outdirname) debug = 0 READ(5,debugging,ERR=999) WRITE(6,'(/,1x,a)' ) 'Namelist debugging was successfully read.' WRITE(6,'(3x,a,i3,/)') 'debug = ', debug WRITE(6,'(1x,a,/)') '*****************************' !----------------------------------------------------------------------- ! ! Calling specific subroutines to do the main job ! !----------------------------------------------------------------------- IF (finfmt == 3) THEN CALL splithdf(filenames,nfile,dimnamein,xdimname,ydimname, & varidx,nxidx,nyidx,nproc_x,nproc_y,outdirname,debug, & istatus) ELSE IF (finfmt == 7 .OR. finfmt == 8) THEN CALL splitncdf(filenames,nfile,stagdims,xdimname,ydimname, & nproc_x,nproc_y,outdirname,debug, & istatus) ELSE WRITE(6,'(1x,a,I2)') 'ERROR: unsupported file format = ',finfmt WRITE(6,'(1x,a)') ' The program only support files '// & 'in HDF 4 format (finfmt = 3) or netCDF format (finfmt = 7/8)' istatus = 1 END IF GO TO 100 !----------------------------------------------------------------------- ! ! Just before termination ! !----------------------------------------------------------------------- 999 WRITE(6,'(1x, a,a)') 'Error reading NAMELIST file. Job stopped.' STOP 100 CONTINUE IF (istatus == 0) THEN WRITE(6,'(/,4x,a,/)') '==== Program SPLIT terminated normally ====' ELSE WRITE(6,'(/,4x,a,I3,a/)') '**** Program SPLIT terminated with error = ',istatus,' ****' END IF STOP END PROGRAM split_general SUBROUTINE getinfns(finfmt, fheader, ftrailer, tintv_in, tbgn_in, tend_in, & 1 filenames, nfile_max, nfile, istatus) !----------------------------------------------------------------------- ! ! Purpose: ! Construct filenames array from input parameters ! !----------------------------------------------------------------------- IMPLICIT NONE INTEGER, INTENT(IN) :: finfmt CHARACTER(LEN=*), INTENT(IN) :: fheader, ftrailer REAL, INTENT(IN) :: tbgn_in, tintv_in, tend_in INTEGER, INTENT(IN) :: nfile_max CHARACTER(LEN=256), INTENT(OUT) :: filenames(nfile_max) INTEGER, INTENT(OUT) :: nfile INTEGER, INTENT(OUT) :: istatus !----------------------------------------------------------------------- ! ! Misc. local variables ! !----------------------------------------------------------------------- CHARACTER(LEN=3) :: fmtstr INTEGER :: n REAL :: time INTEGER :: lheader, ltrailer INTEGER :: itime !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ! ! Begin of executable code ! !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ IF (finfmt == 3) THEN fmtstr = 'hdf' ELSE IF (finfmt == 7 .OR. finfmt == 8) THEN fmtstr = 'net' ELSE WRITE(6,'(/,1x,a,I2,/)') 'ERROR: unsupported data format: ',finfmt istatus = -1 RETURN END IF lheader = LEN_TRIM(fheader) ltrailer= LEN_TRIM(ftrailer) nfile = 0 time = tbgn_in DO n = 1, nfile_max IF (time > tend_in + 0.01*tintv_in) EXIT nfile = nfile + 1 itime = INT(time) WRITE(filenames(n),'(3a,I6.6,a)') fheader(1:lheader),'.',fmtstr, & itime,ftrailer(1:ltrailer) time = tbgn_in + n*tintv_in END DO RETURN END SUBROUTINE getinfns