remap_layers3D Subroutine

private subroutine remap_layers3D(refs_size, refs_size_layers3D, refs_displ_layers3D, data_size, meta_size)

Remap the 4-rank array in a 3-rank array by introducing the virtual coordinate

Arguments

Type IntentOptional 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

Source Code

   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