setup_rec_index_2d Subroutine

private subroutine setup_rec_index_2d(matrix_set, n_rows, n_cols)

Arguments

Type IntentOptional Attributes Name
type(dbcsr_2d_array_type), intent(inout) :: matrix_set
integer, intent(in) :: n_rows
integer, intent(in) :: n_cols

Source Code

   SUBROUTINE setup_rec_index_2d(matrix_set, n_rows, n_cols)
      TYPE(dbcsr_2d_array_type), INTENT(INOUT)           :: matrix_set
      INTEGER, INTENT(IN)                                :: n_rows, n_cols

      CHARACTER(len=*), PARAMETER :: routineN = 'setup_rec_index_2d'
      LOGICAL, PARAMETER                                 :: dbg = .FALSE.

      INTEGER                                            :: handle, i_col, i_row, t_f, t_l, t_size

!$    INTEGER                                  :: ithread
      LOGICAL                                  :: thread_redist

!   ---------------------------------------------------------------------------

      CALL timeset(routineN, handle)
      DO i_row = 1, n_rows
         DO i_col = 1, n_cols
            IF (.FALSE.) &
               CALL dbcsr_reset_vlocals(matrix_set%mats(i_row, i_col), &
                                        matrix_set%image_dist)
            IF (dbg) THEN
               WRITE (*, *) routineN//" m, n, size", &
                  SIZE(matrix_set%mats(i_row, i_col)%coo_l), &
                  dbcsr_nblkrows_local(matrix_set%mats(i_row, i_col)), &
                  dbcsr_nblkcols_local(matrix_set%mats(i_row, i_col))
               WRITE (*, '(3(1X,I7))') matrix_set%mats(i_row, i_col)%coo_l
            END IF
            IF (careful_mod) THEN
               IF (SIZE(matrix_set%mats(i_row, i_col)%coo_l) .NE. matrix_set%mats(i_row, i_col)%nblks*3) &
                  DBCSR_ABORT("Block count mismatch.")
            END IF
            thread_redist = ASSOCIATED(matrix_set%mats(i_row, i_col)%thr_c)
            t_size = SIZE(matrix_set%mats(i_row, i_col)%coo_l)/3
            t_f = 1
            t_l = t_size
!$OMP       PARALLEL IF (thread_redist) DEFAULT (NONE) &
!$OMP       PRIVATE (ithread) &
!$OMP       FIRSTPRIVATE (t_f, t_l, t_size) &
!$OMP       SHARED (matrix_set, i_row, i_col, thread_redist)
!$          ithread = OMP_GET_THREAD_NUM()
!$          IF (thread_redist) THEN
!$             t_f = matrix_set%mats(i_row, i_col)%thr_c(ithread + 1) + 1
!$             t_l = matrix_set%mats(i_row, i_col)%thr_c(ithread + 2)
!$          END IF
            t_size = t_l - t_f + 1
!$OMP       BARRIER
            IF (t_size .GT. 0) THEN
               CALL call_rec_sort_index( &
                  dbcsr_nblkrows_local(matrix_set%mats(i_row, i_col)), &
                  dbcsr_nblkcols_local(matrix_set%mats(i_row, i_col)), &
                  t_size, &
                  matrix_set%mats(i_row, i_col)%coo_l((t_f*3 - 2):(t_l*3)))
            END IF
!$OMP       END PARALLEL
         END DO
      END DO
      CALL timestop(handle)
   END SUBROUTINE setup_rec_index_2d