dbcsr_finalize Subroutine

   SUBROUTINE dbcsr_finalize(matrix, reshuffle)
      !! Creates the final dbcsr_type matrix from the working matrix.
      !! Work matrices (array or tree-based) are merged into the base DBCSR matrix.
      !! If a matrix is marked as having a valid index, then nothing is done.
      !! Deleted blocks are pruned from the index.

      TYPE(dbcsr_type), INTENT(INOUT)                    :: matrix
         !! final matrix
      LOGICAL, INTENT(IN), OPTIONAL                      :: reshuffle
         !! whether the data should be reshuffled, default is false

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

      INTEGER                                            :: handle, i, nblks, nwms, start_offset
      INTEGER, ALLOCATABLE, DIMENSION(:)                 :: empty_row_p
      INTEGER, DIMENSION(:), POINTER, SAVE               :: old_blk_p, old_col_i, old_row_p
      LOGICAL                                            :: can_quick, fake_row_p, sort_data, spawn

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

      CALL timeset(routineN, handle)

!$OMP     MASTER
      NULLIFY (old_blk_p, old_col_i, old_row_p)
!$OMP     END MASTER

!$OMP     BARRIER
      ! If the matrix is not marked as dirty then skip the work.
      IF (dbcsr_valid_index(matrix)) THEN
         !"No need to finalize a valid matrix, skipping."
         !
         ! A matrix with a valid index should not have associated work
         ! arrays.  This may happen when this routine is called on a
         ! matrix that was not changed.
!$OMP        BARRIER
!$OMP        MASTER
         IF (ASSOCIATED(matrix%wms)) &
            CALL dbcsr_work_destroy_all(matrix)
         matrix%valid = .TRUE.
!$OMP        END MASTER
!$OMP        BARRIER
         CALL timestop(handle)
         RETURN
      END IF
      !
      ! If possible, data copying is avoided.
      IF (PRESENT(reshuffle)) THEN
         sort_data = reshuffle
      ELSE
         sort_data = .FALSE.
      END IF
      !
      ! Now make sure that a valid row_p exists. Also clear the row_p if
      ! the matrix is declared to have 0 blocks.
!$OMP     MASTER
      fake_row_p = .NOT. ASSOCIATED(matrix%row_p)
      IF (ASSOCIATED(matrix%row_p)) THEN
         fake_row_p = SIZE(matrix%row_p) .LE. 1
      END IF
      fake_row_p = fake_row_p .OR. matrix%nblks .EQ. 0
!$OMP     END MASTER
      !
      ! See where data will be appended in the main data
      ! area. Alternatively, set to the start if the matrix is declared
      ! to have no data. (This value is ignored if reshuffle is true
      ! because the main data area is always new.)
      start_offset = matrix%nze
      i = dbcsr_get_data_size_used(matrix)
!$OMP     MASTER
      matrix%nze = 0
!$OMP     END MASTER
!$OMP     BARRIER
!$OMP     ATOMIC
      matrix%nze = matrix%nze + i
!$OMP     BARRIER
      IF (dbg) THEN
         WRITE (*, *) routineN//" sizes", matrix%nze, i, &
            dbcsr_data_get_size_referenced(matrix%data_area), &
            dbcsr_data_get_size(matrix%data_area)
      END IF
      IF (.FALSE. .AND. dbcsr_data_get_size_referenced(matrix%data_area) .NE. &
          matrix%nze) THEN
         IF (matrix%nze .NE. dbcsr_data_get_size_referenced(matrix%data_area)) &
            DBCSR_WARN("Should reshuffle.")
         IF (ASSOCIATED(matrix%wms)) THEN
            sort_data = .NOT. dbcsr_wm_use_mutable(matrix%wms(1))
         END IF
      END IF
      IF (sort_data .AND. matrix%nze .GT. 0) THEN
         CALL dbcsr_add_wm_from_matrix(matrix)
         matrix%nze = 0
!$OMP        MASTER
         fake_row_p = .TRUE.
!$OMP        END MASTER
      END IF
      start_offset = dbcsr_data_get_size_referenced(matrix%data_area) + 1
      IF (matrix%nze .EQ. 0) start_offset = 1
!$OMP     MASTER
      matrix%index(dbcsr_slot_nze) = matrix%nze
      IF (fake_row_p) THEN
         ALLOCATE (empty_row_p(matrix%nblkrows_total + 1))
         empty_row_p(:) = 0
         CALL dbcsr_addto_index_array(matrix, dbcsr_slot_row_p, &
                                      DATA=empty_row_p, extra=0)
         CALL dbcsr_addto_index_array(matrix, dbcsr_slot_col_i, &
                                      reservation=0)
         CALL dbcsr_addto_index_array(matrix, dbcsr_slot_blk_p, &
                                      reservation=0)
         CALL dbcsr_repoint_index(matrix)
      END IF
!$OMP     END MASTER
      !
!$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
         !
!$OMP        MASTER
         !
         ! Create work matrices if not yet existing
         IF (.NOT. ASSOCIATED(matrix%wms)) THEN
            nwms = 1
!$          nwms = omp_get_num_threads()
            CALL dbcsr_work_create(matrix, n=nwms)
         END IF
!$OMP        END MASTER
!$OMP        BARRIER
         !
         ! Ensure index arrays at least exist.
!$OMP        DO SCHEDULE (STATIC, 1)
         DO i = 1, SIZE(matrix%wms)
            IF (.NOT. ASSOCIATED(matrix%wms(i)%row_i)) THEN
               CALL ensure_array_size(matrix%wms(i)%row_i, ub=0)
            END IF
            IF (.NOT. ASSOCIATED(matrix%wms(i)%col_i)) THEN
               CALL ensure_array_size(matrix%wms(i)%col_i, ub=0)
            END IF
            IF (.NOT. ASSOCIATED(matrix%wms(i)%blk_p)) THEN
               CALL ensure_array_size(matrix%wms(i)%blk_p, ub=0)
            END IF
         END DO
!$OMP        ENDDO
         !
         ! Check for deleted blocks
!$OMP        MASTER
         nblks = matrix%row_p(matrix%nblkrows_total + 1)
         IF (ANY(matrix%blk_p(1:nblks) .EQ. 0)) THEN
            CALL dbcsr_index_prune_deleted(matrix)
         END IF
         old_row_p => matrix%row_p
         old_col_i => matrix%col_i
         old_blk_p => matrix%blk_p
!$OMP        END MASTER
         !
!$OMP        BARRIER
         ! Check to see if we will need to create a parallel environment
         ! (needed when there are multiple work matrices but we are not
         ! in an OpenMP parallel section.)
         !
         ! A parallel section is created and used when the matrix has
         ! more work matrices. It's a shortcut when the finalize is
         ! called from a non-parallel environment whereas the matrix was
         ! built/modified in a parallel environment
         nwms = SIZE(matrix%wms)
         spawn = .FALSE.
!$       IF (.NOT. omp_in_parallel()) THEN
!$          IF (nwms .GT. 1) spawn = .TRUE.
!$       END IF
         IF (spawn) THEN
!$OMP           PARALLEL IF (spawn) &
!$OMP                    DEFAULT (NONE) &
!$OMP                    SHARED (matrix, old_row_p, old_col_i, old_blk_p,&
!$OMP                            start_offset, sort_data)
            CALL dbcsr_merge_all(matrix, &
                                 old_row_p, old_col_i, old_blk_p, &
                                 sort_data=sort_data)
!$OMP           END PARALLEL
         ELSE
            CALL dbcsr_merge_all(matrix, &
                                 old_row_p, old_col_i, old_blk_p, &
                                 sort_data=sort_data)
         END IF
      END IF
!$OMP BARRIER
!$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 MASTER
      IF (fake_row_p) THEN
         DEALLOCATE (empty_row_p)
      END IF
!$OMP END MASTER
!$OMP BARRIER
      CALL timestop(handle)
   END SUBROUTINE dbcsr_finalize