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