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