dbcsr_create_template Subroutine

private subroutine dbcsr_create_template(matrix, template, name, dist, matrix_type, row_blk_size, col_blk_size, row_blk_size_obj, col_blk_size_obj, nze, data_type, data_buffer, data_memory_type, index_memory_type, max_rbs, max_cbs, row_blk_offset, col_blk_offset, reuse_arrays, mutable_work, make_index, replication_type)

Arguments

TypeIntentOptionalAttributesName
type(dbcsr_type), intent(inout) :: matrix
type(dbcsr_type), intent(in) :: template
character(len=*), intent(in), optional :: name
type(dbcsr_distribution_obj), intent(in), optional :: dist
character, intent(in), optional :: matrix_type
integer, intent(inout), optional DIMENSION(:), POINTER, CONTIGUOUS:: row_blk_size
integer, intent(inout), optional DIMENSION(:), POINTER, CONTIGUOUS:: col_blk_size
type(array_i1d_obj), intent(in), optional :: row_blk_size_obj
type(array_i1d_obj), intent(in), optional :: col_blk_size_obj
integer, intent(in), optional :: nze
integer, intent(in), optional :: data_type
type(dbcsr_data_obj), intent(in), optional :: data_buffer
type(dbcsr_memtype_type), intent(in), optional :: data_memory_type
type(dbcsr_memtype_type), intent(in), optional :: index_memory_type
integer, intent(in), optional :: max_rbs
integer, intent(in), optional :: max_cbs
type(array_i1d_obj), intent(in), optional :: row_blk_offset
type(array_i1d_obj), intent(in), optional :: col_blk_offset
logical, intent(in), optional :: reuse_arrays
logical, intent(in), optional :: mutable_work
logical, intent(in), optional :: make_index
character, intent(in), optional :: replication_type

Contents

Source Code


Source Code

   SUBROUTINE dbcsr_create_template(matrix, template, name, dist, matrix_type, &
                                    row_blk_size, col_blk_size, row_blk_size_obj, col_blk_size_obj, &
                                    nze, data_type, &
                                    data_buffer, data_memory_type, index_memory_type, &
                                    max_rbs, max_cbs, &
                                    row_blk_offset, col_blk_offset, &
                                    reuse_arrays, mutable_work, make_index, replication_type)
      TYPE(dbcsr_type), INTENT(INOUT)                    :: matrix
      TYPE(dbcsr_type), INTENT(IN)                       :: template
      CHARACTER(len=*), INTENT(IN), OPTIONAL             :: name
      TYPE(dbcsr_distribution_obj), INTENT(IN), OPTIONAL :: dist
      CHARACTER, INTENT(IN), OPTIONAL                    :: matrix_type
      INTEGER, DIMENSION(:), INTENT(INOUT), OPTIONAL, &
         POINTER, CONTIGUOUS                             :: row_blk_size, col_blk_size
      TYPE(array_i1d_obj), INTENT(IN), OPTIONAL          :: row_blk_size_obj, col_blk_size_obj
      INTEGER, INTENT(IN), OPTIONAL                      :: nze, data_type
      TYPE(dbcsr_data_obj), INTENT(IN), OPTIONAL         :: data_buffer
      TYPE(dbcsr_memtype_type), INTENT(IN), OPTIONAL     :: data_memory_type, index_memory_type
      INTEGER, INTENT(IN), OPTIONAL                      :: max_rbs, max_cbs
      TYPE(array_i1d_obj), INTENT(IN), OPTIONAL          :: row_blk_offset, col_blk_offset
      LOGICAL, INTENT(IN), OPTIONAL                      :: reuse_arrays, mutable_work, make_index
      CHARACTER, INTENT(IN), OPTIONAL                    :: replication_type

      CHARACTER                                          :: new_matrix_type, new_replication_type
      CHARACTER(len=default_string_length)               :: new_name
      INTEGER                                            :: new_data_type, new_max_cbs, new_max_rbs
      LOGICAL                                            :: my_make_index, new_mutable_work
      TYPE(array_i1d_obj)                                :: new_col_blk_offset, new_row_blk_offset
      TYPE(dbcsr_distribution_obj)                       :: new_dist
      TYPE(dbcsr_memtype_type)                           :: new_data_memory_type, &
                                                            new_index_memory_type

      INTEGER, DIMENSION(:), POINTER, CONTIGUOUS         :: blk_size

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

      IF (PRESENT(name)) THEN
         new_name = TRIM(name)
      ELSE
         new_name = TRIM(dbcsr_name(template))
      END IF
      IF (PRESENT(dist)) THEN
         new_dist = dist
      ELSE
         new_dist = dbcsr_distribution(template)
      END IF
      IF (PRESENT(matrix_type)) THEN
         new_matrix_type = matrix_type
      ELSE
         new_matrix_type = dbcsr_get_matrix_type(template)
      END IF
      !
      IF ((PRESENT(row_blk_size) .NEQV. PRESENT(col_blk_size)) .OR. &
          (PRESENT(row_blk_size_obj) .NEQV. PRESENT(col_blk_size_obj))) THEN
         DBCSR_ABORT("Both row_blk_size and col_blk_size must be provided")
      END IF
      !
      IF (PRESENT(max_rbs)) new_max_rbs = max_rbs
      IF (PRESENT(row_blk_offset)) new_row_blk_offset = row_blk_offset
      NULLIFY (blk_size)
      IF (PRESENT(row_blk_size_obj)) THEN
         blk_size => array_data(row_blk_size_obj)
      ELSEIF (PRESENT(row_blk_size)) THEN
         blk_size => row_blk_size
      END IF
      IF (ASSOCIATED(blk_size)) THEN
         IF (.NOT. PRESENT(max_rbs)) &
            new_max_rbs = MAXVAL(blk_size)
      ELSE
         IF (.NOT. PRESENT(max_rbs)) &
            new_max_rbs = dbcsr_max_row_size(template)
         IF (.NOT. PRESENT(row_blk_offset)) &
            new_row_blk_offset = template%row_blk_offset
      END IF
      !
      IF (PRESENT(max_cbs)) new_max_cbs = max_cbs
      IF (PRESENT(col_blk_offset)) new_col_blk_offset = col_blk_offset
      NULLIFY (blk_size)
      IF (PRESENT(col_blk_size_obj)) THEN
         blk_size => array_data(col_blk_size_obj)
      ELSEIF (PRESENT(col_blk_size)) THEN
         blk_size => col_blk_size
      END IF
      IF (ASSOCIATED(blk_size)) THEN
         IF (.NOT. PRESENT(max_cbs)) &
            new_max_cbs = MAXVAL(blk_size)
      ELSE
         IF (.NOT. PRESENT(max_cbs)) &
            new_max_cbs = dbcsr_max_col_size(template)
         IF (.NOT. PRESENT(col_blk_offset)) &
            new_col_blk_offset = template%col_blk_offset
      END IF
      IF (PRESENT(data_type)) THEN
         new_data_type = data_type
      ELSE
         new_data_type = dbcsr_get_data_type(template)
      END IF
      IF (PRESENT(data_memory_type)) THEN
         new_data_memory_type = data_memory_type
      ELSE
         new_data_memory_type = dbcsr_get_data_memory_type(template)
      END IF
      IF (PRESENT(index_memory_type)) THEN
         new_index_memory_type = index_memory_type
      ELSE
         new_index_memory_type = dbcsr_get_index_memory_type(template)
      END IF
      IF (PRESENT(replication_type)) THEN
         new_replication_type = replication_type
      ELSE
         new_replication_type = dbcsr_get_replication_type(template)
      END IF
      IF (PRESENT(mutable_work)) THEN
         new_mutable_work = mutable_work
      ELSE
         new_mutable_work = dbcsr_use_mutable(template)
      END IF
      IF (PRESENT(row_blk_size_obj)) THEN
         CALL dbcsr_create(matrix, name=new_name, dist=new_dist, &
                           matrix_type=new_matrix_type, &
                           row_blk_size_obj=row_blk_size_obj, &
                           col_blk_size_obj=col_blk_size_obj, &
                           nze=nze, &
                           data_type=new_data_type, &
                           data_buffer=data_buffer, &
                           data_memory_type=new_data_memory_type, &
                           index_memory_type=new_index_memory_type, &
                           max_rbs=new_max_rbs, max_cbs=new_max_cbs, &
                           row_blk_offset=row_blk_offset, col_blk_offset=col_blk_offset, &
                           reuse_arrays=reuse_arrays, &
                           mutable_work=new_mutable_work, &
                           make_index=make_index, &
                           replication_type=new_replication_type)
      ELSEIF (PRESENT(row_blk_size)) THEN
         CALL dbcsr_create(matrix, name=new_name, dist=new_dist, &
                           matrix_type=new_matrix_type, &
                           row_blk_size=row_blk_size, &
                           col_blk_size=col_blk_size, &
                           nze=nze, &
                           data_type=new_data_type, &
                           data_buffer=data_buffer, &
                           data_memory_type=new_data_memory_type, &
                           index_memory_type=new_index_memory_type, &
                           max_rbs=new_max_rbs, max_cbs=new_max_cbs, &
                           row_blk_offset=row_blk_offset, col_blk_offset=col_blk_offset, &
                           reuse_arrays=reuse_arrays, &
                           mutable_work=new_mutable_work, &
                           make_index=make_index, &
                           replication_type=new_replication_type)
      ELSE
         CALL dbcsr_create(matrix, name=new_name, dist=new_dist, &
                           matrix_type=new_matrix_type, &
                           row_blk_size_obj=template%row_blk_size, &
                           col_blk_size_obj=template%col_blk_size, &
                           nze=nze, &
                           data_type=new_data_type, &
                           data_buffer=data_buffer, &
                           data_memory_type=new_data_memory_type, &
                           index_memory_type=new_index_memory_type, &
                           max_rbs=new_max_rbs, max_cbs=new_max_cbs, &
                           row_blk_offset=new_row_blk_offset, col_blk_offset=new_col_blk_offset, &
                           thread_dist=dbcsr_distribution(template), &
                           reuse_arrays=reuse_arrays, &
                           mutable_work=new_mutable_work, &
                           make_index=make_index, &
                           replication_type=new_replication_type)
      END IF
      ! Copy stuff from the meta-array.  These are not normally needed,
      ! but have to be here for creating matrices from "image" matrices.
      my_make_index = .TRUE.
      IF (PRESENT(make_index)) my_make_index = make_index
      IF (my_make_index) THEN
         matrix%index(dbcsr_slot_home_prow) = template%index(dbcsr_slot_home_prow)
         matrix%index(dbcsr_slot_home_rowi) = template%index(dbcsr_slot_home_rowi)
         matrix%index(dbcsr_slot_home_pcol) = template%index(dbcsr_slot_home_pcol)
         matrix%index(dbcsr_slot_home_coli) = template%index(dbcsr_slot_home_coli)
         matrix%index(dbcsr_slot_home_vprow) = template%index(dbcsr_slot_home_vprow)
         matrix%index(dbcsr_slot_home_vpcol) = template%index(dbcsr_slot_home_vpcol)
      END IF
      IF (PRESENT(row_blk_size) .AND. .NOT. PRESENT(row_blk_offset)) THEN
         CALL array_release(new_row_blk_offset)
      END IF
      IF (PRESENT(col_blk_size) .AND. .NOT. PRESENT(col_blk_offset)) THEN
         CALL array_release(new_col_blk_offset)
      END IF

   END SUBROUTINE dbcsr_create_template