Remap the 4-rank array in a 3-rank array by introducing the virtual coordinate
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in), | DIMENSION(:, :, :, :), CONTIGUOUS, POINTER | :: | refs_size | ||
integer, | intent(out), | DIMENSION(:, :, :), CONTIGUOUS, POINTER | :: | refs_size_layers3D | ||
integer, | intent(out), | DIMENSION(:, :, :), CONTIGUOUS, POINTER | :: | refs_displ_layers3D | ||
integer, | intent(out) | :: | data_size | |||
integer, | intent(out) | :: | meta_size |
SUBROUTINE remap_layers3D(refs_size, refs_size_layers3D, refs_displ_layers3D, &
!! Remap the 4-rank array in a 3-rank array by introducing the virtual coordinate
data_size, meta_size)
INTEGER, DIMENSION(:, :, :, :), INTENT(IN), &
CONTIGUOUS, POINTER :: refs_size
INTEGER, DIMENSION(:, :, :), INTENT(OUT), &
CONTIGUOUS, POINTER :: refs_size_layers3D, refs_displ_layers3D
INTEGER, INTENT(OUT) :: data_size, meta_size
INTEGER :: ilayer, image, iproc, nimages, &
nlayers3D, nprocs
nimages = SIZE(refs_size, 2)
nlayers3D = SIZE(refs_size, 3)
nprocs = SIZE(refs_size, 4)
!
ALLOCATE (refs_size_layers3D(idata:imeta, nlayers3D, 0:nimages*nprocs - 1))
ALLOCATE (refs_displ_layers3D(idata:imeta, nlayers3D, 0:nimages*nprocs - 1))
data_size = 0; meta_size = 0
!
!$OMP PARALLEL DO DEFAULT (NONE) &
!$OMP SHARED (nprocs, nimages, nlayers3D, &
!$OMP refs_size_layers3D, refs_displ_layers3D, refs_size) &
!$OMP PRIVATE (iproc,image,ilayer) &
!$OMP REDUCTION (MAX : data_size, meta_size)
DO iproc = 0, nprocs - 1
DO ilayer = 1, nlayers3D
DO image = 1, nimages
refs_size_layers3D(:, ilayer, image + iproc*nimages - 1) = refs_size(:, image, ilayer, iproc)
data_size = MAX(data_size, refs_size(idata, image, ilayer, iproc))
meta_size = MAX(meta_size, refs_size(imeta, image, ilayer, iproc))
END DO
refs_displ_layers3D(:, ilayer, iproc*nimages) = 0
DO image = 1, nimages - 1
refs_displ_layers3D(:, ilayer, image + iproc*nimages) = &
refs_displ_layers3D(:, ilayer, image + iproc*nimages - 1) + refs_size(:, image, ilayer, iproc)
END DO
END DO
END DO
!$OMP END PARALLEL DO
END SUBROUTINE remap_layers3D