!
SUBROUTINE splithdf(filenames,nfile,dimnamein, xdimname, ydimname, & 1,5
varidx_dim, nxidx, nyidx, nproc_x,nproc_y, &
outdirname, debug,istatus)
!
!-----------------------------------------------------------------------
!
! PURPOSE:
!
! Split files in HDF4 format into patches. The patched files will
! contain the same data as original file but in evenly divided
! subdomain specified by the user.
!
!-----------------------------------------------------------------------
!
! Author: Yunheng Wang (11/07/2006)
!
! MODIFICATIONS:
!
!-----------------------------------------------------------------------
!
IMPLICIT NONE
!-----------------------------------------------------------------------
!
! Variable declaration
!
!-----------------------------------------------------------------------
INTEGER, INTENT(IN) :: nfile
CHARACTER(LEN=*), INTENT(IN) :: filenames(nfile)
CHARACTER(LEN=*), INTENT(IN) :: outdirname
CHARACTER(LEN=*), INTENT(IN) :: xdimname, ydimname
LOGICAL, INTENT(IN) :: dimnamein
! .TRUE. get attributes xdimname/ydimname for global x size and y size
! .FALSE. get x/y size by reading varidx with dimensions nxidx, nyidx
INTEGER, INTENT(IN) :: varidx_dim, nxidx, nyidx
INTEGER, INTENT(IN) :: nproc_x, nproc_y
INTEGER, INTENT(IN) :: debug
INTEGER, INTENT(OUT) :: istatus
!-----------------------------------------------------------------------
!
! Dimensions and work arrays
!
!-----------------------------------------------------------------------
INTEGER :: nxlg, nylg
INTEGER :: nx, ny
CHARACTER(LEN=1), ALLOCATABLE :: attvalstr(:)
INTEGER, ALLOCATABLE :: attvali(:)
REAL, ALLOCATABLE :: attvalr(:)
INTEGER, ALLOCATABLE :: variin(:), variout(:)
INTEGER, ALLOCATABLE :: varain(:), varaout(:)
INTEGER(KIND=SELECTED_INT_KIND(4)), ALLOCATABLE :: vari16in(:), vari16out(:)
INTEGER :: finid
CHARACTER(LEN=256), ALLOCATABLE :: outfilenames(:,:)
INTEGER, ALLOCATABLE :: foutids(:,:)
INTEGER, ALLOCATABLE :: varido (:,:)
INTEGER, ALLOCATABLE :: dimouts0(:,:,:)
!
!-----------------------------------------------------------------------
!
! Misc. local variables
!
!-----------------------------------------------------------------------
INTEGER, PARAMETER :: MAX_RANK = 5
INTEGER :: nf, dindx
INTEGER :: iout, iin
INTEGER :: nxid, nyid
INTEGER :: iloc, jloc
INTEGER :: comp_code, comp_prm(1)
INTEGER :: ngatts, nvars ! file info
CHARACTER(LEN=256) :: dimname, attname, varname
INTEGER :: attnum, atttype, attnval ! attribute info
INTEGER :: varid, varidx ! variable info
INTEGER :: vartype, varndims, varnatts
INTEGER :: vardim, varinsize, varoutsize
INTEGER :: variallsize, varaallsize, vari16allsize
INTEGER :: varibllsize, varabllsize, vari16bllsize
INTEGER :: vardimsize(MAX_RANK), vardimoutsize(MAX_RANK)
INTEGER :: startidx(MAX_RANK), stride(MAX_RANK)
INTEGER :: dimid ! dimension info
INTEGER :: sin1d, sin2d, sin3d, sin4d
INTEGER :: sout1d, sout2d, sout3d, sout4d
INTEGER :: nd1, nd2, nd3, nd4, nd5 ! Assume the max rank is 5
INTEGER :: allocstrlen, allocrlen, allocilen
INTEGER :: resetx, resety
!
!-----------------------------------------------------------------------
!
! Including files
!
!-----------------------------------------------------------------------
INCLUDE 'hdf.f90'
!-----------------------------------------------------------------------
!
! HDF Functions
!
!-----------------------------------------------------------------------
INTEGER :: sfstart, sfend, sffinfo, sfginfo, sfgainfo, sfgcompress ! file and quiry
INTEGER :: sffattr, sfrnatt, sfsnatt, sfrcatt, sfscatt ! attribute
INTEGER :: sfdimid, sfsdmname ! Dimension
INTEGER :: sfselect, sfendacc, sfcreate, sfrdata, sfwdata ! Variable
INTEGER :: sfscompress
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
! Begin of executable code below
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!-----------------------------------------------------------------------
!
! Check dimensions first
!
!-----------------------------------------------------------------------
finid = sfstart(filenames(1),DFACC_READ)
IF (finid <= 0) CALL print_err
(finid,'Cannot open data set.')
IF (dimnamein) THEN ! Read global attributes for dimension size
nxid = sffattr(finid, xdimname)
istatus = sfrnatt(finid, nxid, nxlg)
nyid = sffattr(finid, ydimname)
istatus = sfrnatt(finid, nyid, nylg)
ELSE ! Read variable dimensions
varid = sfselect(finid,varidx_dim)
istatus = sfginfo (varid,varname,varndims,vardimsize,vartype,varnatts)
nxlg = vardimsize(nxidx)
nylg = vardimsize(nyidx)
END IF
WRITE(6,'(1x,2(a,I5))') 'Dimensions in file to be split are: nx = ',nxlg,', ny = ',nylg
IF (MOD((nxlg-3),nproc_x) /= 0 ) THEN
WRITE(6,'(1x,a)') 'ERROR: Wrong dimension size'
WRITE(6,'(1x,2(a,I5),a)') ' Dimension size in X direction (',nxlg,&
') is not divisible by nproc_x (',nproc_x,').'
istatus = -1
RETURN
END IF
IF (MOD((nylg-3),nproc_y) /= 0 ) THEN
WRITE(6,'(1x,a)') 'ERROR: Wrong dimension size'
WRITE(6,'(1x,2(a,I5),a)') ' Dimension size in Y direction (',nylg,&
') is not divisible by nproc_y (',nproc_y,').'
istatus = -2
RETURN
END IF
istatus = sfend(finid)
!-----------------------------------------------------------------------
!
! Loop over filenames
!
!-----------------------------------------------------------------------
ALLOCATE(outfilenames(nproc_x,nproc_y), STAT = istatus)
ALLOCATE(foutids(nproc_x,nproc_y), STAT = istatus)
ALLOCATE(varido (nproc_x,nproc_y), STAT = istatus)
ALLOCATE(dimouts0(MAX_RANK,nproc_x,nproc_y), STAT = istatus)
ALLOCATE(attvalr(1), STAT = istatus)
ALLOCATE(attvali(1), STAT = istatus)
ALLOCATE(attvalstr(1024), STAT = istatus)
allocrlen = 1
allocilen = 1
allocstrlen = 1024
startidx(:) = 0
stride(:) = 1
variallsize = 0
vari16allsize = 0
varaallsize = 0
varibllsize = 0
vari16bllsize = 0
varabllsize = 0
DO nf = 1,nfile
WRITE(6,'(/,1x,a,I6)') '== Processing file No. ',nf
IF (debug > 0) WRITE(6,'(/,1x,2a)') 'Opening file - ',TRIM(filenames(nf))
finid = sfstart(filenames(nf),DFACC_READ)
IF (finid <= 0) CALL print_err(finid,'Cannot open data set.')
dindx = INDEX(filenames(nf),'/',.TRUE.) + 1
DO jloc = 1,nproc_y ! Create patches
DO iloc = 1,nproc_x
WRITE(outfilenames(iloc,jloc),'(3a,2I2.2)') &
TRIM(outdirname),TRIM(filenames(nf)(dindx:)),'_',iloc,jloc
IF (debug > 0) WRITE(6,'(1x,2a)') 'Creating file - ',TRIM(outfilenames(iloc,jloc))
foutids(iloc,jloc) = sfstart(outfilenames(iloc,jloc),DFACC_CREATE)
IF (foutids(iloc,jloc) <= 0) CALL print_err(finid,'Cannot open data set.')
END DO
END DO
!
! Set dimensions
!
nx = (nxlg-3)/nproc_x + 3
ny = (nylg-3)/nproc_y + 3
istatus = sffinfo(finid,nvars,ngatts)
!-----------------------------------------------------------------------
!
! Read/write Global attributes
!
!-----------------------------------------------------------------------
IF (debug > 1) WRITE(6,'(5x,a,I2)') 'Total global attributs - ',ngatts
DO attnum = 0,ngatts-1
istatus = sfgainfo(finid,attnum,attname,atttype,attnval)
IF (attnval /= 1 .AND. atttype /= DFNT_CHAR8) THEN
WRITE(6,'(1x,a,/)') 'ERROR: No support for attribute arrays still.'
istatus = -3
RETURN
ELSE
IF (debug > 2) WRITE(6,'(9x,2a)') 'Attribute name - ',TRIM(attname)
END IF
SELECT CASE (atttype)
CASE (DFNT_CHAR8) ! Character string
IF (attnval > allocstrlen) THEN
DEALLOCATE(attvalstr, STAT = istatus)
ALLOCATE (attvalstr(attnval), STAT = istatus)
allocstrlen = attnval
attvalstr = ' '
END IF
istatus = sfrcatt(finid, attnum, attvalstr)
DO jloc = 1,nproc_y ! Write CHARACTER global attributes
DO iloc = 1,nproc_x
istatus = sfscatt(foutids(iloc,jloc), TRIM(attname), atttype, attnval, attvalstr)
END DO
END DO
CASE (DFNT_FLOAT32) ! REAL number
IF (attnval > allocrlen) THEN
DEALLOCATE(attvalr, STAT = istatus)
ALLOCATE (attvalr(attnval), STAT = istatus)
allocrlen = attnval
attvalr = 0.0
END IF
istatus = sfrnatt(finid, attnum, attvalr)
DO jloc = 1,nproc_y ! Write REAL global attributes
DO iloc = 1,nproc_x
istatus = sfsnatt(foutids(iloc,jloc), TRIM(attname), atttype, attnval, attvalr)
END DO
END DO
CASE (DFNT_INT32) ! INTEGER number
IF (attnval > allocilen) THEN
DEALLOCATE(attvali, STAT = istatus)
ALLOCATE (attvali(attnval), STAT = istatus)
allocilen = attnval
attvali = 0
END IF
IF ( TRIM(attname) == TRIM(xdimname) ) THEN
attvali(1) = nx
ELSE IF ( TRIM(attname) == TRIM(ydimname) ) THEN
attvali(1) = ny
ELSE
istatus = sfrnatt(finid, attnum, attvali)
END IF
DO jloc = 1,nproc_y ! Write integer global attributes
DO iloc = 1,nproc_x
istatus = sfsnatt(foutids(iloc,jloc), TRIM(attname), atttype, attnval, attvali)
END DO
END DO
CASE DEFAULT
WRITE (6,'(/,1x,a,I2,3a,/)') 'ERROR: unsupported attribute type (', &
atttype,') for attribute ', TRIM(attname),'.'
istatus = -4
RETURN
END SELECT
END DO
!-----------------------------------------------------------------------
!
! Read/write each variable
!
!-----------------------------------------------------------------------
IF (debug > 1) WRITE(6,'(5x,a,I2)') 'Total variables - ',nvars
DO varidx = 0,nvars-1
vardimsize(:) = 1
varid = sfselect(finid,varidx)
istatus = sfginfo (varid,varname,varndims,vardimsize,vartype,varnatts)
IF (debug >2) WRITE(6,'(9x,2a)') 'Processing variables - ',TRIM(varname)
istatus = sfgcompress(varid,comp_code,comp_prm)
IF (istatus /= SUCCEED) THEN
! WRITE(6,'(1x,3a)') 'ERROR: HDF error from sfgcompress with variable ',TRIM(varname),'.'
! RETURN
comp_code = 0
comp_prm(1) = 0
END IF
IF (debug >3) WRITE(6,'(13x,2(a,I2))') 'comp_code = ',comp_code,', comp_prm = ',comp_prm(1)
! attnum = sffattr(varid, 'hdf_comp_prm') ! Whether the data set is compressed?
! IF (attnum == FAIL) THEN
! comp_prm(1) = 0
! ELSE
! istatus = sfrnatt(varid, attnum, comp_prm)
! END IF
! comp_code = 0
! IF (comp_prm(1) /= 0) THEN
! attnum = sffattr(varid, 'hdf_comp_code')
! istatus = sfrnatt(varid, attnum, comp_code)
! END IF
vardimoutsize(:) = vardimsize(:)
resetx = 0 ! Assume we only split the first two dimensions
resety = 0
IF (vardimsize(1) == nxlg) THEN ! Check the first dimension of nx/ny
vardimoutsize(1) = nx
resetx = 1
ELSE IF (vardimsize(1) == nylg) THEN
vardimoutsize(1) = ny
resety = 1
END IF
! Check the second dimension as necessary
IF (varndims > 1 .AND. vardimsize(2) == nylg) THEN
vardimoutsize(2) = ny
resety = 2
END IF
varinsize = 1
varoutsize = 1
DO vardim = 1, varndims
varinsize = vardimsize(vardim)*varinsize
varoutsize = vardimoutsize(vardim)*varoutsize
IF (debug > 4) WRITE(6,'(13x,2(I4,a))') &
vardimsize(vardim),'(in) - ', vardimoutsize(vardim), '(out).'
END DO
sin1d = vardimsize(1) ! size of one column, INPUT
sin2d = sin1d*vardimsize(2) ! size of one slice (xy)
sin3d = sin2d*vardimsize(3) ! size of one cell (xyz)
sin4d = sin3d*vardimsize(4)
sout1d = vardimoutsize(1) ! size of one column, OUTPUT
sout2d = sout1d*vardimoutsize(2)
sout3d = sout2d*vardimoutsize(3)
sout4d = sout3d*vardimoutsize(4)
dimouts0(:,:,:) = 0 ! The starting index of each dimensions for each subdomain
DO jloc = 1,nproc_y ! Create data set
DO iloc = 1,nproc_x
varido(iloc,jloc) = sfcreate(foutids(iloc,jloc), varname, &
vartype, varndims, vardimoutsize)
IF (resetx > 0) THEN
dimid = sfdimid(varido(iloc,jloc),resetx-1)
istatus = sfsdmname(dimid,xdimname)
dimouts0(resetx,iloc,jloc) = (iloc-1)*(nx-3)
END IF
IF (resety > 0) THEN
dimid = sfdimid(varido(iloc,jloc),resety-1)
istatus = sfsdmname(dimid,ydimname)
dimouts0(resety,iloc,jloc) = (jloc-1)*(ny-3)
END IF
istatus = sfscompress(varido(iloc,jloc), comp_code, comp_prm)
END DO
END DO
SELECT CASE (vartype)
CASE (dfnt_float32)
IF (varinsize > varaallsize) THEN ! Allocate input array only when necessary
IF (ALLOCATED(varain)) DEALLOCATE(varain, STAT = istatus)
ALLOCATE(varain(varinsize), STAT = istatus)
varaallsize = varinsize
END IF
IF (varoutsize > varabllsize) THEN ! Allocate output array only when necessary
IF (ALLOCATED(varaout)) DEALLOCATE(varaout, STAT = istatus)
ALLOCATE(varaout(varoutsize), STAT = istatus)
varabllsize = varoutsize
END IF
istatus = sfrdata(varid, startidx, stride, vardimsize, varain)
DO jloc = 1,nproc_y ! Write patches variables
DO iloc = 1,nproc_x
IF (debug > 3) THEN
WRITE(6,FMT='(13x,a,2(I4,a))',ADVANCE='NO') &
'Writing to processor - (',iloc,',',jloc,') with: '
DO vardim = 1,varndims
WRITE(6,FMT='(I4,a)',ADVANCE='NO') dimouts0(vardim,iloc,jloc),' '
END DO
WRITE(6,*)
END IF
DO nd5 = 1, vardimoutsize(5) ! Assume max rank is 5, IMPORTANT
DO nd4 = 1, vardimoutsize(4)
DO nd3 = 1, vardimoutsize(3)
DO nd2 = 1, vardimoutsize(2)
DO nd1 = 1, vardimoutsize(1)
iin = nd1+dimouts0(1,iloc,jloc) &
+ (nd2+dimouts0(2,iloc,jloc)-1)*sin1d &
+ (nd3+dimouts0(3,iloc,jloc)-1)*sin2d &
+ (nd4+dimouts0(4,iloc,jloc)-1)*sin3d &
+ (nd5+dimouts0(5,iloc,jloc)-1)*sin4d
iout = nd1 + (nd2-1)*sout1d + (nd3-1)*sout2d &
+ (nd4-1)*sout3d + (nd5-1)*sout4d
IF (debug > 3) WRITE(6,'(13x,a,2I2,3(a,I4),4I4)') &
'Processor - ',iloc,jloc,': Extracting from ',iin, &
' to ',iout,' at ',nd1,nd2,nd3,nd4,nd5
varaout(iout) = varain(iin)
END DO
END DO
END DO
END DO
END DO
istatus = sfwdata(varido(iloc,jloc), startidx, stride, vardimoutsize, varaout)
IF (istatus /= SUCCEED) CALL print_err(istatus,'ERROR: sfwdata')
END DO
END DO
CASE (dfnt_int32)
IF (varinsize > variallsize) THEN ! Allocate input array only when necessary
IF (ALLOCATED(variin)) DEALLOCATE(variin, STAT = istatus)
ALLOCATE(variin(varinsize), STAT = istatus)
variallsize = varinsize
END IF
IF (varoutsize > varibllsize) THEN ! Allocate output array only when necessary
IF (ALLOCATED(variout)) DEALLOCATE(variout, STAT = istatus)
ALLOCATE(variout(varoutsize), STAT = istatus)
varibllsize = varoutsize
END IF
istatus = sfrdata(varid, startidx, stride, vardimsize, variin)
DO jloc = 1,nproc_y ! Write patches variables
DO iloc = 1,nproc_x
IF (debug > 3) THEN
WRITE(6,FMT='(13x,a,2(I4,a))',ADVANCE='NO') &
'Writing to processor - (',iloc,',',jloc,') with: '
DO vardim = 1,varndims
WRITE(6,FMT='(I4,a)',ADVANCE='NO') dimouts0(vardim,iloc,jloc),' '
END DO
WRITE(6,*)
END IF
DO nd5 = 1, vardimoutsize(5) ! Assume max rank is 5, IMPORTANT
DO nd4 = 1, vardimoutsize(4)
DO nd3 = 1, vardimoutsize(3)
DO nd2 = 1, vardimoutsize(2)
DO nd1 = 1, vardimoutsize(1)
iin = nd1+dimouts0(1,iloc,jloc) &
+ (nd2+dimouts0(2,iloc,jloc)-1)*sin1d &
+ (nd3+dimouts0(3,iloc,jloc)-1)*sin2d &
+ (nd4+dimouts0(4,iloc,jloc)-1)*sin3d &
+ (nd5+dimouts0(5,iloc,jloc)-1)*sin4d
iout = nd1 + (nd2-1)*sout1d + (nd3-1)*sout2d &
+ (nd4-1)*sout3d + (nd5-1)*sout4d
IF (debug > 3) WRITE(6,'(13x,a,2I2,3(a,I4),4I4)') &
'Processor - ',iloc,jloc,': Extracting from ',iin, &
' to ',iout,' at ',nd1,nd2,nd3,nd4,nd5
variout(iout) = variin(iin)
END DO
END DO
END DO
END DO
END DO
istatus = sfwdata(varido(iloc,jloc), startidx, stride, vardimoutsize, variout)
IF (istatus /= SUCCEED) CALL print_err(istatus,'ERROR: sfwdata')
END DO
END DO
CASE (dfnt_int16)
IF (varinsize > vari16allsize) THEN ! Allocate input array only when necessary
IF (ALLOCATED(vari16in)) DEALLOCATE(vari16in, STAT = istatus)
ALLOCATE(vari16in(varinsize), STAT = istatus)
vari16allsize = varinsize
END IF
IF (varoutsize > vari16bllsize) THEN ! Allocate output array only when necessary
IF (ALLOCATED(vari16out)) DEALLOCATE(vari16out, STAT = istatus)
ALLOCATE(vari16out(varoutsize), STAT = istatus)
vari16bllsize = varoutsize
END IF
istatus = sfrdata(varid, startidx, stride, vardimsize, vari16in)
DO jloc = 1,nproc_y ! Write patches variables
DO iloc = 1,nproc_x
IF (debug > 3) THEN
WRITE(6,FMT='(13x,a,2(I4,a))',ADVANCE='NO') &
'Writing to processor - (',iloc,',',jloc,') with: '
DO vardim = 1,varndims
WRITE(6,FMT='(I4,a)',ADVANCE='NO') dimouts0(vardim,iloc,jloc),' '
END DO
WRITE(6,*)
END IF
DO nd5 = 1, vardimoutsize(5) ! Assume max rank is 5, IMPORTANT
DO nd4 = 1, vardimoutsize(4)
DO nd3 = 1, vardimoutsize(3)
DO nd2 = 1, vardimoutsize(2)
DO nd1 = 1, vardimoutsize(1)
iin = nd1+dimouts0(1,iloc,jloc) &
+ (nd2+dimouts0(2,iloc,jloc)-1)*sin1d &
+ (nd3+dimouts0(3,iloc,jloc)-1)*sin2d &
+ (nd4+dimouts0(4,iloc,jloc)-1)*sin3d &
+ (nd5+dimouts0(5,iloc,jloc)-1)*sin4d
iout = nd1 + (nd2-1)*sout1d + (nd3-1)*sout2d &
+ (nd4-1)*sout3d + (nd5-1)*sout4d
IF (debug > 3) WRITE(6,'(13x,a,2I2,3(a,I4),4I4)') &
'Processor - ',iloc,jloc,': Extracting from ',iin, &
' to ',iout,' at ',nd1,nd2,nd3,nd4,nd5
vari16out(iout) = vari16in(iin)
END DO
END DO
END DO
END DO
END DO
istatus = sfwdata(varido(iloc,jloc), startidx, stride, vardimoutsize, vari16out)
IF (istatus /= SUCCEED) CALL print_err(istatus,'ERROR: sfwdata')
END DO
END DO
CASE DEFAULT
WRITE(6,'(1x,a,I2,3a,/)') 'ERROR: Unsupported variable type (', &
vartype,') for variable ',TRIM(varname),'.'
istatus = -5
RETURN
END SELECT
!
! Data set attributes
!
DO attnum = 0,varnatts-1
istatus = sfgainfo(varid,attnum,attname,atttype,attnval)
IF (debug > 2) WRITE(6,'(13x,2a)') 'Attribute name - ',TRIM(attname)
SELECT CASE (atttype)
CASE (DFNT_CHAR8) ! Character string
IF (attnval > allocstrlen) THEN
DEALLOCATE(attvalstr, STAT = istatus)
ALLOCATE (attvalstr(attnval), STAT = istatus)
allocstrlen = attnval
attvalstr = ' '
END IF
istatus = sfrcatt(varid, attnum, attvalstr)
DO jloc = 1,nproc_y ! Write CHARACTER var attributes
DO iloc = 1,nproc_x
istatus = sfscatt(varido(iloc,jloc), TRIM(attname), atttype, attnval, attvalstr)
END DO
END DO
CASE (DFNT_FLOAT32) ! REAL number
IF (attnval > allocrlen) THEN
DEALLOCATE(attvalr, STAT = istatus)
ALLOCATE (attvalr(attnval), STAT = istatus)
allocrlen = attnval
attvalr = 0.0
END IF
istatus = sfrnatt(varid, attnum, attvalr)
DO jloc = 1,nproc_y ! Write REAL global attributes
DO iloc = 1,nproc_x
istatus = sfsnatt(varido(iloc,jloc), TRIM(attname), atttype, attnval, attvalr)
END DO
END DO
CASE (DFNT_INT32) ! INTEGER number
IF (attnval > allocilen) THEN
DEALLOCATE(attvali, STAT = istatus)
ALLOCATE (attvali(attnval), STAT = istatus)
allocilen = attnval
attvali = 0
END IF
istatus = sfrnatt(varid, attnum, attvali)
DO jloc = 1,nproc_y ! Write integer global attributes
DO iloc = 1,nproc_x
istatus = sfsnatt(varido(iloc,jloc), TRIM(attname), atttype, attnval, attvali)
END DO
END DO
CASE DEFAULT
WRITE (6,'(/,1x,a,I2,5a,/)') 'ERROR: unsupported attribute type (', &
atttype,') for attribute ', TRIM(attname), &
' of variable ',TRIM(varname),'.'
istatus = -4
RETURN
END SELECT
END DO
!
! Close data sets
!
istatus = sfendacc(varid)
DO jloc = 1,nproc_y
DO iloc = 1,nproc_x
istatus = sfendacc(varido(iloc,jloc))
END DO
END DO
END DO
!
! Close files
!
IF (debug > 0) WRITE(6,'(1x,a)') 'Closing all files ...'
DO jloc = 1,nproc_y ! Close patches
DO iloc = 1,nproc_x
istatus = sfend(foutids(iloc,jloc))
END DO
END DO
istatus = sfend(finid) ! Close file
END DO
DEALLOCATE(outfilenames, foutids, varido, STAT = istatus)
DEALLOCATE(attvalstr, attvali, attvalr, STAT = istatus)
DEALLOCATE(dimouts0, STAT = istatus)
IF (ALLOCATED(varain)) DEALLOCATE(varain, varaout, STAT = istatus)
IF (ALLOCATED(variin)) DEALLOCATE(variin, variout, STAT = istatus)
IF (ALLOCATED(vari16in)) DEALLOCATE(vari16in, vari16out, STAT = istatus)
RETURN
END SUBROUTINE splithdf
SUBROUTINE print_err(istat,message) 6
IMPLICIT NONE
INTEGER, INTENT(IN) :: istat
CHARACTER(*), INTENT(IN) :: message
PRINT *, TRIM(message)
STOP 'HDF error!'
RETURN
END SUBROUTINE print_err