dbcsr_init_wm Subroutine

private subroutine dbcsr_init_wm(wm, data_type, nblks_guess, sizedata_guess, memory_type)

Initializes one work matrix

Arguments

Type IntentOptional Attributes Name
type(dbcsr_work_type), intent(out) :: wm

initialized work matrix

integer, intent(in) :: data_type
integer, intent(in), optional :: nblks_guess

estimated number of blocks estimated size of data

integer, intent(in), optional :: sizedata_guess

estimated number of blocks estimated size of data

type(dbcsr_memtype_type), intent(in), optional :: memory_type

Source Code

   SUBROUTINE dbcsr_init_wm(wm, data_type, nblks_guess, sizedata_guess, memory_type)
      !! Initializes one work matrix

      TYPE(dbcsr_work_type), INTENT(OUT)                 :: wm
         !! initialized work matrix
      INTEGER, INTENT(IN)                                :: data_type
      INTEGER, INTENT(IN), OPTIONAL                      :: nblks_guess, sizedata_guess
         !! estimated number of blocks
         !! estimated size of data
      TYPE(dbcsr_memtype_type), INTENT(IN), OPTIONAL     :: memory_type

      CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_init_wm'
      INTEGER                                            :: handle, nblks, stat

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

      IF (careful_mod) CALL timeset(routineN, handle)
      wm%lastblk = 0
      wm%datasize = 0
      ! Index
      IF (PRESENT(nblks_guess)) THEN
         nblks = nblks_guess
         IF (nblks_guess < 0) &
            DBCSR_ABORT("Can not have negative block count.")
         ALLOCATE (wm%row_i(nblks), stat=stat)
         IF (stat /= 0) DBCSR_ABORT("wm%row_i")
         ALLOCATE (wm%col_i(nblks), stat=stat)
         IF (stat /= 0) DBCSR_ABORT("wm%col_i")
         ALLOCATE (wm%blk_p(nblks), stat=stat)
         IF (stat /= 0) DBCSR_ABORT("wm%blk_p")
      ELSE
         NULLIFY (wm%row_i, wm%col_i, wm%blk_p)
         !nblks = CEILING (REAL (matrix%nblkrows_local * matrix%nblkcols_local)&
         !     / REAL (dbcsr_mp_numnodes (dbcsr_distribution_mp (matrix%dist))))
      END IF
      ! Data
      CALL dbcsr_data_init(wm%data_area)
      IF (PRESENT(sizedata_guess)) THEN
         IF (sizedata_guess < 0) &
            DBCSR_ABORT("Can not have negative data size.")
         CALL dbcsr_data_new(wm%data_area, data_type, &
                             data_size=sizedata_guess, memory_type=memory_type)
      ELSE
         CALL dbcsr_data_new(wm%data_area, data_type, memory_type=memory_type)
      END IF
      CALL dbcsr_mutable_init(wm%mutable)
      IF (careful_mod) CALL timestop(handle)
   END SUBROUTINE dbcsr_init_wm