dbcsr_work_create Subroutine

   SUBROUTINE dbcsr_work_create(matrix, nblks_guess, sizedata_guess, n, &
                                work_mutable, memory_type)
      !! Creates a the working matrix(es) for a DBCSR matrix.

      TYPE(dbcsr_type), INTENT(INOUT)                    :: matrix
         !! new matrix
      INTEGER, INTENT(IN), OPTIONAL                      :: nblks_guess, sizedata_guess, n
         !! estimated number of blocks
         !! estimated size of data
         !! number work matrices to create, default is 1
      LOGICAL, INTENT(in), OPTIONAL                      :: work_mutable
         !! use mutable work type, default is what was specified in create
      TYPE(dbcsr_memtype_type), INTENT(IN), OPTIONAL     :: memory_type

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

      INTEGER                                            :: handle, iw, nw, ow
      LOGICAL                                            :: wms_new, wms_realloc
      TYPE(dbcsr_work_type), DIMENSION(:), POINTER       :: wms

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

      CALL timeset(routineN, handle)
      IF (PRESENT(n)) THEN
         nw = n
      ELSE
         nw = 1
!$       IF (omp_in_parallel()) THEN
!$          nw = omp_get_num_threads()
!$       ELSE
!$          nw = omp_get_max_threads()
!$       END IF
      END IF
!$OMP     MASTER
      wms_new = .NOT. ASSOCIATED(matrix%wms)
      wms_realloc = .FALSE.
      IF (ASSOCIATED(matrix%wms)) THEN
         ow = SIZE(matrix%wms)
         IF (ow .LT. nw) &
            DBCSR_WARN("Number of work matrices less than threads.")
         IF (ow .LT. nw) wms_realloc = .TRUE.
      END IF
      IF (PRESENT(work_mutable)) THEN
         matrix%work_mutable = work_mutable
      END IF
      IF (wms_realloc) THEN
         ALLOCATE (wms(nw))
         wms(1:ow) = matrix%wms(1:ow)
         DEALLOCATE (matrix%wms)
         matrix%wms => wms
         DO iw = ow + 1, nw
            CALL dbcsr_init_wm(matrix%wms(iw), matrix%data_type, &
                               nblks_guess=nblks_guess, sizedata_guess=sizedata_guess, &
                               memory_type=memory_type)
            IF (matrix%work_mutable) &
               CALL dbcsr_mutable_new(matrix%wms(iw)%mutable, &
                                      dbcsr_get_data_type(matrix))
         END DO
      END IF
      IF (wms_new) THEN
         ALLOCATE (matrix%wms(nw))
         DO iw = 1, nw
            CALL dbcsr_init_wm(matrix%wms(iw), matrix%data_type, &
                               nblks_guess=nblks_guess, sizedata_guess=sizedata_guess, &
                               memory_type=memory_type)
            IF (matrix%work_mutable) &
               CALL dbcsr_mutable_new(matrix%wms(iw)%mutable, &
                                      dbcsr_get_data_type(matrix))
         END DO
      END IF
      matrix%valid = .FALSE.
!$OMP     END MASTER
      CALL timestop(handle)
   END SUBROUTINE dbcsr_work_create