dbcsr_special_finalize Subroutine

public subroutine dbcsr_special_finalize(matrix, reshuffle)

Arguments

TypeIntentOptionalAttributesName
type(dbcsr_type), intent(inout) :: matrix
logical, intent(in), optional :: reshuffle

Contents


Source Code

   SUBROUTINE dbcsr_special_finalize(matrix, reshuffle)
      TYPE(dbcsr_type), INTENT(INOUT)                    :: matrix
      LOGICAL, INTENT(IN), OPTIONAL                      :: reshuffle

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

      INTEGER                                            :: handle
      LOGICAL                                            :: can_quick, sort_data

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

      CALL timeset(routineN, handle)

      IF (matrix%nblks .NE. 0) &
         DBCSR_ABORT("Optimized finalize requires empty matrix.")
      IF (dbcsr_valid_index(matrix)) &
         DBCSR_ABORT("Optimized finalize requires invalid matrix.")
      IF (.NOT. ASSOCIATED(matrix%wms)) &
         DBCSR_ABORT("Optimized finalize requires work matrices exist.")
      IF (SIZE(matrix%wms) .NE. 1) &
         DBCSR_ABORT("Optimized finalize requires single work matrix")

      !
      ! If possible, data copying is avoided.
      IF (PRESENT(reshuffle)) THEN
         sort_data = reshuffle
      ELSE
         sort_data = .FALSE.
      END IF
!$OMP     BARRIER
      can_quick = can_quickly_finalize(matrix)
!$OMP     BARRIER

      ! If the matrix, work matrices, and environment fit several
      ! criteria, then a quick O(1) finalization is performed.
      IF (can_quick .AND. .NOT. sort_data) THEN
         CALL quick_finalize(matrix)
      ELSE
         IF (.NOT. sort_data) &
            DBCSR_ABORT("merge_single_wm only supports data sorting")
         !
         ! Ensure needed index arrays at least exist.
!$OMP        MASTER
         !
         IF (.NOT. ASSOCIATED(matrix%wms(1)%row_i)) THEN
            CALL ensure_array_size(matrix%wms(1)%row_i, ub=0)
         END IF
         IF (.NOT. ASSOCIATED(matrix%wms(1)%col_i)) THEN
            CALL ensure_array_size(matrix%wms(1)%col_i, ub=0)
         END IF
         IF (.NOT. ASSOCIATED(matrix%wms(1)%blk_p)) THEN
            CALL ensure_array_size(matrix%wms(1)%blk_p, ub=0)
         END IF
         !
!$OMP        END MASTER
!$OMP        BARRIER
         !
!$OMP        PARALLEL DEFAULT (NONE), SHARED(matrix)
         CALL dbcsr_merge_single_wm(matrix)
!$OMP        END PARALLEL

      END IF

!$OMP     MASTER
      ! Clean up.
      IF (ASSOCIATED(matrix%wms)) THEN
         CALL dbcsr_work_destroy_all(matrix)
      END IF
      matrix%valid = .TRUE.
!$OMP     END MASTER
!$OMP     BARRIER
      IF (dbg) THEN
!$OMP        SINGLE
         CALL dbcsr_verify_matrix(matrix)
!$OMP        END SINGLE
      END IF
!$OMP     BARRIER
      CALL timestop(handle)
   END SUBROUTINE dbcsr_special_finalize