setup_rec_index_images Subroutine

private subroutine setup_rec_index_images(meta_buffer, img_nblks_rows, img_nblks_cols, refs_size, refs_displ, size_index, has_threads)

Arguments

Type IntentOptional Attributes Name
integer, intent(inout), DIMENSION(:) :: meta_buffer
integer, intent(in), DIMENSION(:) :: img_nblks_rows
integer, intent(in), DIMENSION(:) :: img_nblks_cols
integer, intent(in), DIMENSION(:) :: refs_size
integer, intent(in), DIMENSION(:) :: refs_displ
integer, intent(in) :: size_index
logical, intent(in) :: has_threads

Contents


Source Code

   SUBROUTINE setup_rec_index_images(meta_buffer, img_nblks_rows, img_nblks_cols, &
                                     refs_size, refs_displ, size_index, has_threads)
      INTEGER, DIMENSION(:), INTENT(INOUT)               :: meta_buffer
      INTEGER, DIMENSION(:), INTENT(IN)                  :: img_nblks_rows, img_nblks_cols, &
                                                            refs_size, refs_displ
      INTEGER, INTENT(IN)                                :: size_index
      LOGICAL, INTENT(IN)                                :: has_threads

      CHARACTER(len=*), PARAMETER :: routineN = 'setup_rec_index_images'

      INTEGER                                            :: handle, in, nblkcols_local, &
                                                            nblkrows_local, t_f, t_l, t_size

!$    INTEGER                           :: ithread

      CALL timeset(routineN, handle)
      IF (has_threads) THEN
         nblkrows_local = img_nblks_rows(1)
      ELSE
         nblkcols_local = img_nblks_cols(1)
      END IF
      !
      DO in = 1, SIZE(refs_size)
         IF (refs_size(in) .EQ. 0) CYCLE
         ! Number of blocks
         t_size = (refs_size(in) - size_index)/3
         IF (has_threads) THEN
            nblkcols_local = img_nblks_cols(in)
         ELSE
            nblkrows_local = img_nblks_rows(in)
         END IF
         t_f = 1
         t_l = t_size
!$OMP    PARALLEL IF (has_threads) DEFAULT (NONE) &
!$OMP    PRIVATE (ithread) &
!$OMP    FIRSTPRIVATE (t_f, t_l, t_size) &
!$OMP    SHARED (meta_buffer, in, has_threads, refs_displ, &
!$OMP            size_index, nblkrows_local, nblkcols_local)
!$       ithread = OMP_GET_THREAD_NUM() + 1
!$       IF (has_threads) THEN
!$          t_f = meta_buffer(refs_displ(in) + ithread) + 1
!$          t_l = meta_buffer(refs_displ(in) + ithread + 1)
!$       END IF
         t_size = t_l - t_f + 1
         IF (t_size .GT. 0) THEN
            CALL rec_sort_index(1, nblkrows_local, &
                                1, nblkcols_local, &
                                t_size, &
                                meta_buffer(refs_displ(in) + size_index + t_f*3 - 2: &
                                            refs_displ(in) + size_index + t_l*3), &
                                0)
         END IF
!$OMP    END PARALLEL
      END DO
      CALL timestop(handle)
   END SUBROUTINE setup_rec_index_images