Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(dbcsr_type), | intent(inout) | :: | matrix | |||
logical, | intent(in), | optional | :: | reshuffle |
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