IO: Rewrite write_metablocks_h5() and rename it.
The new name is store_metablocks_h5(). Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
This commit is contained in:
parent
9e87eb0740
commit
68e6e95b7b
418
sources/io.F90
418
sources/io.F90
@ -3784,7 +3784,7 @@ module io
|
||||
|
||||
call store_attributes_h5(file_id, problem, .true., status)
|
||||
|
||||
call write_metablocks_h5(file_id)
|
||||
call store_metablocks_h5(file_id, status)
|
||||
|
||||
call store_datablocks_h5(file_id, status)
|
||||
|
||||
@ -4267,61 +4267,44 @@ module io
|
||||
!
|
||||
!===============================================================================
|
||||
!
|
||||
! subroutine WRITE_METABLOCKS_H5:
|
||||
! subroutine STORE_METABLOCKS_H5:
|
||||
! ------------------------------
|
||||
!
|
||||
! Subroutine stores all meta blocks with their complete fields in 'metablock'
|
||||
! group in a provided file identifier.
|
||||
! Subroutine stores all meta blocks' data in the group 'metablocks'.
|
||||
!
|
||||
! Arguments:
|
||||
!
|
||||
! fid - the HDF5 file identifier;
|
||||
! loc_id - the location in which store the datablocks;
|
||||
! status - the subroutine call status;
|
||||
!
|
||||
!===============================================================================
|
||||
!
|
||||
subroutine write_metablocks_h5(fid)
|
||||
subroutine store_metablocks_h5(loc_id, status)
|
||||
|
||||
! import procedures and variables from other modules
|
||||
!
|
||||
use blocks , only : block_meta, list_meta
|
||||
use blocks , only : ndims, nchildren, nsides
|
||||
use blocks , only : get_last_id, get_mblocks
|
||||
use hdf5 , only : hid_t, hsize_t
|
||||
use hdf5 , only : h5gcreate_f, h5gclose_f
|
||||
use iso_fortran_env, only : error_unit
|
||||
use hdf5
|
||||
use blocks , only : block_meta, list_meta
|
||||
use blocks , only : ns => nsides, nc => nchildren
|
||||
use blocks , only : get_last_id, get_mblocks
|
||||
use helpers, only : print_message
|
||||
|
||||
! local variables are not implicit by default
|
||||
!
|
||||
implicit none
|
||||
|
||||
! subroutine arguments
|
||||
!
|
||||
integer(hid_t), intent(in) :: fid
|
||||
integer(hid_t), intent(in) :: loc_id
|
||||
integer , intent(out) :: status
|
||||
|
||||
! local variables
|
||||
!
|
||||
integer(hid_t) :: gid
|
||||
integer(kind=4) :: i, j, l, n, p
|
||||
type(block_meta), pointer :: pmeta
|
||||
|
||||
integer(hid_t) :: grp_id
|
||||
|
||||
integer :: nm, l, n, p, i, j
|
||||
#if NDIMS == 3
|
||||
integer(kind=4) :: k
|
||||
#endif /* NDIMS == 3 */
|
||||
integer :: iret
|
||||
integer(hsize_t), dimension(1) :: am, cm
|
||||
integer(hsize_t), dimension(2) :: dm, pm
|
||||
#if NDIMS == 2
|
||||
integer(hsize_t), dimension(4) :: nm
|
||||
#endif /* NDIMS == 2 */
|
||||
#if NDIMS == 3
|
||||
integer(hsize_t), dimension(5) :: nm
|
||||
integer :: k
|
||||
#endif /* NDIMS == 3 */
|
||||
|
||||
! local allocatable arrays
|
||||
!
|
||||
integer(kind=4), dimension(:) , allocatable :: idx
|
||||
integer(kind=4), dimension(:) , allocatable :: par, dat
|
||||
integer(kind=4), dimension(:) , allocatable :: id, cpu, lev, cfg, ref, lea
|
||||
real (kind=8), dimension(:) , allocatable :: xmn, xmx, ymn, ymx, zmn, zmx
|
||||
integer(kind=4), dimension(:,:), allocatable :: chl, pos, cor
|
||||
integer(hsize_t), dimension(5) :: dims
|
||||
|
||||
integer(kind=4), dimension(:,:) , allocatable :: fields
|
||||
integer(kind=4), dimension(:,:) , allocatable :: children
|
||||
#if NDIMS == 2
|
||||
integer(kind=4), dimension(:,:,:,:) , allocatable :: edges
|
||||
integer(kind=4), dimension(:,:,:) , allocatable :: corners
|
||||
@ -4331,260 +4314,163 @@ module io
|
||||
integer(kind=4), dimension(:,:,:,:,:), allocatable :: edges
|
||||
integer(kind=4), dimension(:,:,:,:) , allocatable :: corners
|
||||
#endif /* NDIMS == 3 */
|
||||
real(kind=8) , dimension(:,:,:) , allocatable :: bounds
|
||||
|
||||
! local pointers
|
||||
!
|
||||
type(block_meta), pointer :: pmeta
|
||||
character(len=*), parameter :: loc = 'IO::store_metablocks_h5()'
|
||||
|
||||
! local parameters
|
||||
!
|
||||
character(len=*), parameter :: loc = 'IO::write_metablocks_h5()'
|
||||
!
|
||||
!-------------------------------------------------------------------------------
|
||||
!
|
||||
! create the group for metadata
|
||||
!
|
||||
call h5gcreate_f(fid, 'metablocks', gid, iret)
|
||||
call h5gcreate_f(loc_id, 'metablocks', grp_id, status)
|
||||
if (status >= 0) then
|
||||
nm = get_mblocks()
|
||||
if (nm > 0) then
|
||||
|
||||
! check if the group has been created successfuly
|
||||
!
|
||||
if (iret >= 0) then
|
||||
allocate(fields(nm,16), children(nm,nc), bounds(nm,3,2), &
|
||||
#if NDIMS == 3
|
||||
faces(nm,NDIMS,ns,ns,ns), &
|
||||
edges(nm,NDIMS,ns,ns,ns), corners(nm,ns,ns,ns), &
|
||||
#else /* NDIMS == 3 */
|
||||
edges(nm,NDIMS,ns,ns), corners(nm,ns,ns), &
|
||||
#endif /* NDIMS == 3 */
|
||||
stat = status)
|
||||
|
||||
if (status == 0) then
|
||||
|
||||
fields(:,:) = -1
|
||||
children(:,:) = -1
|
||||
#if NDIMS == 3
|
||||
faces(:,:,:,:,:) = -1
|
||||
edges(:,:,:,:,:) = -1
|
||||
corners(:,:,:,:) = -1
|
||||
#else /* NDIMS == 3 */
|
||||
edges(:,:,:,:) = -1
|
||||
corners(:,:,:) = -1
|
||||
#endif /* NDIMS == 3 */
|
||||
bounds(:,:,:) = 0.0d+00
|
||||
|
||||
l = 0
|
||||
pmeta => list_meta
|
||||
do while(associated(pmeta))
|
||||
l = l + 1
|
||||
|
||||
fields(l, 1) = pmeta%id
|
||||
fields(l, 2) = pmeta%process
|
||||
fields(l, 3) = pmeta%level
|
||||
fields(l, 4) = pmeta%conf
|
||||
fields(l, 5) = pmeta%refine
|
||||
fields(l, 6) = pmeta%pos(1)
|
||||
fields(l, 7) = pmeta%pos(2)
|
||||
#if NDIMS == 3
|
||||
fields(l, 8) = pmeta%pos(3)
|
||||
#endif /* NDIMS == 3 */
|
||||
fields(l, 9) = pmeta%coords(1)
|
||||
fields(l,10) = pmeta%coords(2)
|
||||
#if NDIMS == 3
|
||||
fields(l,11) = pmeta%coords(3)
|
||||
#endif /* NDIMS == 3 */
|
||||
|
||||
if (pmeta%leaf) fields(l,12) = 1
|
||||
if (associated(pmeta%data) ) fields(l,13) = 1
|
||||
if (associated(pmeta%parent)) fields(l,14) = pmeta%parent%id
|
||||
|
||||
do p = 1, nc
|
||||
if (associated(pmeta%child(p)%ptr)) &
|
||||
children(l,p) = pmeta%child(p)%ptr%id
|
||||
end do
|
||||
|
||||
! prepate dimensions
|
||||
!
|
||||
am(1) = get_mblocks()
|
||||
cm(1) = get_last_id()
|
||||
dm(1) = get_mblocks()
|
||||
dm(2) = nchildren
|
||||
pm(1) = get_mblocks()
|
||||
pm(2) = NDIMS
|
||||
nm(1) = get_mblocks()
|
||||
nm(2) = nsides
|
||||
nm(3) = nsides
|
||||
#if NDIMS == 2
|
||||
nm(4) = ndims
|
||||
do j = 1, ns
|
||||
do i = 1, ns
|
||||
do n = 1, NDIMS
|
||||
if (associated(pmeta%edges(i,j,n)%ptr)) &
|
||||
edges(l,n,i,j) = pmeta%edges(i,j,n)%ptr%id
|
||||
end do ! NDIMS
|
||||
if (associated(pmeta%corners(i,j)%ptr)) &
|
||||
corners(l,i,j) = pmeta%corners(i,j)%ptr%id
|
||||
end do ! i = 1, ns
|
||||
end do ! j = 1, ns
|
||||
#endif /* NDIMS == 2 */
|
||||
#if NDIMS == 3
|
||||
nm(4) = nsides
|
||||
nm(5) = ndims
|
||||
do k = 1, ns
|
||||
do j = 1, ns
|
||||
do i = 1, ns
|
||||
do n = 1, NDIMS
|
||||
if (associated(pmeta%faces(i,j,k,n)%ptr)) &
|
||||
faces(l,n,i,j,k) = pmeta%faces(i,j,k,n)%ptr%id
|
||||
if (associated(pmeta%edges(i,j,k,n)%ptr)) &
|
||||
edges(l,n,i,j,k) = pmeta%edges(i,j,k,n)%ptr%id
|
||||
end do ! NDIMS
|
||||
if (associated(pmeta%corners(i,j,k)%ptr)) &
|
||||
corners(l,i,j,k) = pmeta%corners(i,j,k)%ptr%id
|
||||
end do ! i = 1, ns
|
||||
end do ! j = 1, ns
|
||||
end do ! k = 1, ns
|
||||
#endif /* NDIMS == 3 */
|
||||
|
||||
! only store data from processes that have any meta blocks
|
||||
!
|
||||
if (am(1) > 0) then
|
||||
|
||||
! allocate arrays to store meta block fields
|
||||
!
|
||||
allocate(idx(cm(1)))
|
||||
allocate(par(am(1)))
|
||||
allocate(dat(am(1)))
|
||||
allocate(id (am(1)))
|
||||
allocate(cpu(am(1)))
|
||||
allocate(lev(am(1)))
|
||||
allocate(cfg(am(1)))
|
||||
allocate(ref(am(1)))
|
||||
allocate(lea(am(1)))
|
||||
allocate(xmn(am(1)))
|
||||
allocate(xmx(am(1)))
|
||||
allocate(ymn(am(1)))
|
||||
allocate(ymx(am(1)))
|
||||
allocate(zmn(am(1)))
|
||||
allocate(zmx(am(1)))
|
||||
allocate(chl(dm(1),dm(2)))
|
||||
allocate(pos(pm(1),pm(2)))
|
||||
allocate(cor(pm(1),pm(2)))
|
||||
#if NDIMS == 2
|
||||
allocate(edges (nm(1),nm(2),nm(3),nm(4)))
|
||||
allocate(corners(nm(1),nm(2),nm(3)))
|
||||
#endif /* NDIMS == 2 */
|
||||
bounds(l,1,1) = pmeta%xmin
|
||||
bounds(l,1,2) = pmeta%xmax
|
||||
bounds(l,2,1) = pmeta%ymin
|
||||
bounds(l,2,2) = pmeta%ymax
|
||||
#if NDIMS == 3
|
||||
allocate(faces (nm(1),nm(2),nm(3),nm(4),nm(5)))
|
||||
allocate(edges (nm(1),nm(2),nm(3),nm(4),nm(5)))
|
||||
allocate(corners(nm(1),nm(2),nm(3),nm(4)))
|
||||
bounds(l,3,1) = pmeta%zmin
|
||||
bounds(l,3,2) = pmeta%zmax
|
||||
#endif /* NDIMS == 3 */
|
||||
|
||||
! reset stored arrays
|
||||
!
|
||||
idx(:) = -1
|
||||
par(:) = -1
|
||||
dat(:) = -1
|
||||
lea(:) = -1
|
||||
chl(:,:) = -1
|
||||
#if NDIMS == 2
|
||||
edges(:,:,:,:) = -1
|
||||
corners(:,:,:) = -1
|
||||
#endif /* NDIMS == 2 */
|
||||
pmeta => pmeta%next
|
||||
end do ! over all meta blocks
|
||||
|
||||
dims(1:2) = [ nm, 16 ]
|
||||
call store_dataset_h5(grp_id, 'fields', &
|
||||
H5T_NATIVE_INTEGER, dims(1:2), fields, status)
|
||||
dims(1:2) = [ nm, nc ]
|
||||
call store_dataset_h5(grp_id, 'children', &
|
||||
H5T_NATIVE_INTEGER, dims(1:2), children, status)
|
||||
#if NDIMS == 3
|
||||
faces(:,:,:,:,:) = -1
|
||||
edges(:,:,:,:,:) = -1
|
||||
corners(:,:,:,:) = -1
|
||||
dims(1:5) = [ nm, NDIMS, ns, ns, ns ]
|
||||
call store_dataset_h5(grp_id, 'faces', &
|
||||
H5T_NATIVE_INTEGER, dims(1:5), faces, status)
|
||||
dims(1:5) = [ nm, NDIMS, ns, ns, ns ]
|
||||
call store_dataset_h5(grp_id, 'edges', &
|
||||
H5T_NATIVE_INTEGER, dims(1:5), edges, status)
|
||||
dims(1:4) = [ nm, ns, ns, ns ]
|
||||
call store_dataset_h5(grp_id, 'corners', &
|
||||
H5T_NATIVE_INTEGER, dims(1:4), corners, status)
|
||||
#else /* NDIMS == 3 */
|
||||
dims(1:4) = [ nm, NDIMS, ns, ns ]
|
||||
call store_dataset_h5(grp_id, 'edges', &
|
||||
H5T_NATIVE_INTEGER, dims(1:4), edges, status)
|
||||
dims(1:3) = [ nm, ns, ns ]
|
||||
call store_dataset_h5(grp_id, 'corners', &
|
||||
H5T_NATIVE_INTEGER, dims(1:3), corners, status)
|
||||
#endif /* NDIMS == 3 */
|
||||
dims(1:3) = [ nm, 3, 2 ]
|
||||
call store_dataset_h5(grp_id, 'bounds', &
|
||||
H5T_NATIVE_DOUBLE, dims(1:3), bounds, status)
|
||||
|
||||
! reset the block counter
|
||||
!
|
||||
l = 0
|
||||
else
|
||||
call print_message(loc, "Could not allocate space for metablocks!")
|
||||
end if
|
||||
|
||||
! associate pmeta with the first block on the meta block list
|
||||
!
|
||||
pmeta => list_meta
|
||||
|
||||
! iterate over all meta blocks and fill in the arrays for storage
|
||||
!
|
||||
do while(associated(pmeta))
|
||||
|
||||
! increase the block counter
|
||||
!
|
||||
l = l + 1
|
||||
|
||||
! store meta block fields
|
||||
!
|
||||
idx(pmeta%id) = l
|
||||
|
||||
if (associated(pmeta%parent)) par(l) = pmeta%parent%id
|
||||
if (associated(pmeta%data) ) dat(l) = 1
|
||||
|
||||
id (l) = pmeta%id
|
||||
cpu(l) = pmeta%process
|
||||
lev(l) = pmeta%level
|
||||
cfg(l) = pmeta%conf
|
||||
ref(l) = pmeta%refine
|
||||
pos(l,:) = pmeta%pos(:)
|
||||
cor(l,:) = pmeta%coords(:)
|
||||
|
||||
if (pmeta%leaf) lea(l) = 1
|
||||
|
||||
xmn(l) = pmeta%xmin
|
||||
xmx(l) = pmeta%xmax
|
||||
ymn(l) = pmeta%ymin
|
||||
ymx(l) = pmeta%ymax
|
||||
zmn(l) = pmeta%zmin
|
||||
zmx(l) = pmeta%zmax
|
||||
|
||||
do p = 1, nchildren
|
||||
if (associated(pmeta%child(p)%ptr)) chl(l,p) = pmeta%child(p)%ptr%id
|
||||
end do
|
||||
|
||||
! store face, edge and corner neighbor pointers
|
||||
!
|
||||
#if NDIMS == 2
|
||||
do i = 1, nsides
|
||||
do j = 1, nsides
|
||||
do n = 1, ndims
|
||||
if (associated(pmeta%edges(i,j,n)%ptr)) &
|
||||
edges(l,i,j,n) = pmeta%edges(i,j,n)%ptr%id
|
||||
end do ! ndims
|
||||
if (associated(pmeta%corners(i,j)%ptr)) &
|
||||
corners(l,i,j) = pmeta%corners(i,j)%ptr%id
|
||||
end do ! i = 1, nsides
|
||||
end do ! j = 1, nsides
|
||||
#endif /* NDIMS == 2 */
|
||||
#if NDIMS == 3
|
||||
do i = 1, nsides
|
||||
do j = 1, nsides
|
||||
do k = 1, nsides
|
||||
do n = 1, ndims
|
||||
if (associated(pmeta%faces(i,j,k,n)%ptr)) &
|
||||
faces(l,i,j,k,n) = pmeta%faces(i,j,k,n)%ptr%id
|
||||
if (associated(pmeta%edges(i,j,k,n)%ptr)) &
|
||||
edges(l,i,j,k,n) = pmeta%edges(i,j,k,n)%ptr%id
|
||||
end do ! ndims
|
||||
if (associated(pmeta%corners(i,j,k)%ptr)) &
|
||||
corners(l,i,j,k) = pmeta%corners(i,j,k)%ptr%id
|
||||
end do ! i = 1, nsides
|
||||
end do ! j = 1, nsides
|
||||
end do ! k = 1, nsides
|
||||
deallocate(fields, children, bounds, faces, edges, corners, stat=status)
|
||||
#else /* NDIMS == 3 */
|
||||
deallocate(fields, children, bounds, edges, corners, stat=status)
|
||||
#endif /* NDIMS == 3 */
|
||||
|
||||
! associate pmeta with the next block on the list
|
||||
!
|
||||
pmeta => pmeta%next
|
||||
|
||||
end do ! over all meta blocks
|
||||
|
||||
! store meta block data in the HDF5 file
|
||||
!
|
||||
call write_array(gid, 'indices', cm(1) , idx)
|
||||
call write_array(gid, 'parent' , am(1) , par)
|
||||
call write_array(gid, 'data' , am(1) , dat)
|
||||
call write_array(gid, 'id' , am(1) , id )
|
||||
call write_array(gid, 'cpu' , am(1) , cpu)
|
||||
call write_array(gid, 'level' , am(1) , lev)
|
||||
call write_array(gid, 'config' , am(1) , cfg)
|
||||
call write_array(gid, 'refine' , am(1) , ref)
|
||||
call write_array(gid, 'leaf' , am(1) , lea)
|
||||
call write_array(gid, 'xmin' , am(1) , xmn)
|
||||
call write_array(gid, 'xmax' , am(1) , xmx)
|
||||
call write_array(gid, 'ymin' , am(1) , ymn)
|
||||
call write_array(gid, 'ymax' , am(1) , ymx)
|
||||
call write_array(gid, 'zmin' , am(1) , zmn)
|
||||
call write_array(gid, 'zmax' , am(1) , zmx)
|
||||
call write_array(gid, 'child' , dm(:) , chl(:,:))
|
||||
call write_array(gid, 'pos' , pm(:) , pos(:,:))
|
||||
call write_array(gid, 'coord' , pm(:) , cor(:,:))
|
||||
#if NDIMS == 2
|
||||
call write_array(gid, 'edges' , nm(1:4), edges(:,:,:,:))
|
||||
call write_array(gid, 'corners', nm(1:3), corners(:,:,:))
|
||||
#endif /* NDIMS == 2 */
|
||||
#if NDIMS == 3
|
||||
call write_array(gid, 'faces' , nm(1:5), faces(:,:,:,:,:))
|
||||
call write_array(gid, 'edges' , nm(1:5), edges(:,:,:,:,:))
|
||||
call write_array(gid, 'corners', nm(1:4), corners(:,:,:,:))
|
||||
#endif /* NDIMS == 3 */
|
||||
|
||||
! deallocate allocated arrays
|
||||
!
|
||||
if (allocated(idx)) deallocate(idx)
|
||||
if (allocated(par)) deallocate(par)
|
||||
if (allocated(dat)) deallocate(dat)
|
||||
if (allocated(id) ) deallocate(id)
|
||||
if (allocated(cpu)) deallocate(cpu)
|
||||
if (allocated(lev)) deallocate(lev)
|
||||
if (allocated(cfg)) deallocate(cfg)
|
||||
if (allocated(ref)) deallocate(ref)
|
||||
if (allocated(lea)) deallocate(lea)
|
||||
if (allocated(xmn)) deallocate(xmn)
|
||||
if (allocated(xmx)) deallocate(xmx)
|
||||
if (allocated(ymn)) deallocate(ymn)
|
||||
if (allocated(ymx)) deallocate(ymx)
|
||||
if (allocated(zmn)) deallocate(zmn)
|
||||
if (allocated(zmx)) deallocate(zmx)
|
||||
if (allocated(chl)) deallocate(chl)
|
||||
if (allocated(cor)) deallocate(cor)
|
||||
#if NDIMS == 3
|
||||
if (allocated(faces)) deallocate(faces)
|
||||
#endif /* NDIMS == 3 */
|
||||
if (allocated(edges)) deallocate(edges)
|
||||
if (allocated(corners)) deallocate(corners)
|
||||
if (status /= 0) &
|
||||
call print_message(loc, "Could not deallocate space of metablocks!")
|
||||
|
||||
end if ! meta blocks > 0
|
||||
|
||||
! close the group
|
||||
!
|
||||
call h5gclose_f(gid, iret)
|
||||
|
||||
! check if the group has been closed successfuly
|
||||
!
|
||||
if (iret > 0) then
|
||||
|
||||
! print error about the problem with closing the group
|
||||
!
|
||||
write(error_unit,"('[',a,']: ',a)") trim(loc) &
|
||||
, "Cannot close the group!"
|
||||
|
||||
end if
|
||||
|
||||
call h5gclose_f(grp_id, status)
|
||||
if (status < 0) &
|
||||
call print_message(loc, "Could not close group 'metablocks'!")
|
||||
else
|
||||
|
||||
! print error about the problem with creating the group
|
||||
!
|
||||
write(error_unit,"('[',a,']: ',a)") trim(loc) &
|
||||
, "Cannot create the group!"
|
||||
|
||||
call print_message(loc, "Could not create group 'metablocks'!")
|
||||
end if
|
||||
|
||||
!-------------------------------------------------------------------------------
|
||||
!
|
||||
end subroutine write_metablocks_h5
|
||||
end subroutine store_metablocks_h5
|
||||
!
|
||||
!===============================================================================
|
||||
!
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user