dbcsr_mm_multrec_finalize Subroutine

public subroutine dbcsr_mm_multrec_finalize(this, meta_buffer)

Sets up recursive multiplication

Arguments

TypeIntentOptionalAttributesName
type(dbcsr_mm_multrec_type), intent(inout) :: this
integer, intent(inout), optional DIMENSION(:):: meta_buffer

Contents


Source Code

   SUBROUTINE dbcsr_mm_multrec_finalize(this, meta_buffer)
      !! Sets up recursive multiplication
      TYPE(dbcsr_mm_multrec_type), INTENT(inout)         :: this
      INTEGER, DIMENSION(:), INTENT(INOUT), OPTIONAL     :: meta_buffer

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

      INTEGER                                            :: handle, ithread, lb_meta, &
                                                            nblocks, nthreads, ub_meta

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

      CALL timeset(routineN, handle)
      IF (.NOT. this%initialized) &
         DBCSR_ABORT("multrec not initialized.")

      CALL dbcsr_mm_csr_finalize(this%csr)

      ! Release the carrier
      IF (this%new_row_max_epss) DEALLOCATE (this%row_max_epss)

      IF (PRESENT(meta_buffer)) THEN
         ithread = 0; nthreads = 1
!$       ithread = OMP_GET_THREAD_NUM(); nthreads = OMP_GET_NUM_THREADS()
         ! Copy wms data into matrix
         lb_meta = meta_buffer(ithread + 1)
         nblocks = (meta_buffer(ithread + 2) - lb_meta)/3
         ub_meta = lb_meta + nblocks
         meta_buffer(lb_meta + 1:ub_meta) = this%product_wm%row_i(1:nblocks)
         lb_meta = ub_meta
         ub_meta = lb_meta + nblocks
         meta_buffer(lb_meta + 1:ub_meta) = this%product_wm%col_i(1:nblocks)
         lb_meta = ub_meta
         ub_meta = lb_meta + nblocks
         meta_buffer(lb_meta + 1:ub_meta) = this%product_wm%blk_p(1:nblocks)
      ELSE
         CALL remap_local2global(this%product_wm%row_i, &
                                 this%product_wm%col_i, &
                                 this%c_local_rows, this%c_local_cols, &
                                 this%original_lastblk + 1, this%product_wm%lastblk)

         ! if filtering is requested remove small blocks, unless the sparsity needs to be kept
         IF (this%use_eps .AND. .NOT. this%keep_sparsity) THEN
            CALL multrec_filtering(this)
         ELSE
            this%product_wm%datasize_after_filtering = this%product_wm%datasize
         END IF
      END IF

      this%initialized = .FALSE.
      CALL timestop(handle)
   END SUBROUTINE dbcsr_mm_multrec_finalize