Writes a DBCSR matrix in a file file's header consists of 3 sub-headers: sub-header1 contains: 1 string: (of length version_len) the current version of this routine, 1 string: (of length default_string_length) matrix_name, 1 character: matrix_type, 4 integers: numnodes, data_type, nblkrows_total, nblkcols_total, 2 vectors: row_blk_size (length = nblkrows_total), col_blk_size (length = nblkcols_total), sub-header2 contains: 2 integers: nblks, data_area_size, sub-header3 contains: 3 vectors: row_p (length = nblkrows_total+1), col_i (length = nblks), blk_p (length = nblks); and the file's body contains the block data
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| type(dbcsr_type), | intent(in) | :: | matrix |
DBCSR matrix |
||
| character(len=*), | intent(in) | :: | filepath |
path to the file |
SUBROUTINE dbcsr_binary_write(matrix, filepath)
!! Writes a DBCSR matrix in a file
!! file's header consists of 3 sub-headers:
!! sub-header1 contains:
!! 1 string: (of length version_len) the current version of this routine,
!! 1 string: (of length default_string_length) matrix_name,
!! 1 character: matrix_type,
!! 4 integers: numnodes, data_type, nblkrows_total, nblkcols_total,
!! 2 vectors: row_blk_size (length = nblkrows_total),
!! col_blk_size (length = nblkcols_total),
!! sub-header2 contains:
!! 2 integers: nblks, data_area_size,
!! sub-header3 contains:
!! 3 vectors: row_p (length = nblkrows_total+1),
!! col_i (length = nblks),
!! blk_p (length = nblks);
!! and the file's body contains the block data
IMPLICIT NONE
TYPE(dbcsr_type), INTENT(IN) :: matrix
!! DBCSR matrix
CHARACTER(len=*), INTENT(IN) :: filepath
!! path to the file
CHARACTER(LEN=*), PARAMETER :: routineN = 'dbcsr_binary_write'
INTEGER :: nblkrows_total, nblkcols_total, &
nblks, size_of_pgrid, &
thefile, i, sendbuf, data_area_size, &
data_type, type_size, &
mp_group, mynode, numnodes, &
ginfo_size, linfo_size, handle
INTEGER, DIMENSION(:), POINTER :: row_p, col_i, blk_p, &
row_blk_size, col_blk_size
INTEGER, DIMENSION(:, :), POINTER :: pgrid
TYPE(mp_type_descriptor_type) :: mp_type
TYPE(dbcsr_mp_obj) :: mp_env
TYPE(dbcsr_distribution_obj) :: distribution
TYPE(dbcsr_data_obj) :: data_area
COMPLEX(sp), DIMENSION(:), POINTER :: c_sp
COMPLEX(dp), DIMENSION(:), POINTER :: c_dp
REAL(sp), DIMENSION(:), POINTER :: r_sp
REAL(dp), DIMENSION(:), POINTER :: r_dp
CHARACTER :: matrix_type
CHARACTER(LEN=80) :: matrix_name_v_1_0
CHARACTER(LEN=default_string_length) :: matrix_name
INTEGER, PARAMETER :: version_len = 10
CHARACTER(LEN=version_len), PARAMETER :: version = "DBCSRv_1.0"
INTEGER, ALLOCATABLE, DIMENSION(:) :: linfo_sizes, da_sizes
INTEGER(kind=file_offset), ALLOCATABLE, DIMENSION(:) :: bdata_disps, bdata_offsets, &
subh2_disps, subh2_offsets, &
subh3_disps, subh3_offsets
INTEGER(kind=file_offset), PARAMETER :: BOF = 0
INTEGER, PARAMETER :: char_count = version_len + default_string_length + 1 !version, matrix_name, matrix_type
CALL timeset(routineN, handle)
IF (default_string_length /= 80) &
CALL dbcsr_warn(__LOCATION__, "Changing the default string length affects "// &
"the format of the written matrix. Version needs to be adjusted")
nblkrows_total = dbcsr_nblkrows_total(matrix)
nblkcols_total = dbcsr_nblkcols_total(matrix)
distribution = dbcsr_distribution(matrix)
matrix_name = dbcsr_name(matrix)
data_area = dbcsr_data_area(matrix)
matrix_type = dbcsr_get_matrix_type(matrix)
data_type = dbcsr_get_data_type(matrix)
mp_env = dbcsr_distribution_mp(distribution)
mp_group = dbcsr_mp_group(mp_env)
nblks = dbcsr_get_num_blocks(matrix)
row_p => matrix%row_p
col_i => matrix%col_i
blk_p => matrix%blk_p
row_blk_size => array_data(matrix%row_blk_size)
col_blk_size => array_data(matrix%col_blk_size)
pgrid => dbcsr_mp_pgrid(mp_env)
size_of_pgrid = SIZE(pgrid)
CALL mp_environ(numnodes, mynode, mp_group)
ALLOCATE (linfo_sizes(numnodes), da_sizes(numnodes), &
subh2_disps(numnodes), subh2_offsets(numnodes), &
subh3_disps(numnodes), subh3_offsets(numnodes), &
bdata_disps(numnodes), bdata_offsets(numnodes))
subh2_disps(:) = (/((i - 1)*2, i=1, numnodes)/)
subh3_disps = BOF
bdata_disps = BOF
linfo_sizes = BOF
subh2_offsets = BOF
subh3_offsets = BOF
bdata_offsets = BOF
da_sizes = BOF
ginfo_size = char_count + 4 + nblkrows_total + nblkcols_total
linfo_size = 1 + nblkrows_total + 2*nblks
sendbuf = linfo_size
CALL mp_allgather(sendbuf, linfo_sizes, mp_group)
CALL cumsum_l(INT(linfo_sizes, kind=file_offset), subh3_disps)
subh3_disps(:) = CSHIFT(subh3_disps, shift=-1) + ginfo_size + 2*numnodes
subh3_disps(1) = ginfo_size + 2*numnodes
data_area_size = dbcsr_data_get_size_referenced(matrix%data_area)
sendbuf = data_area_size
CALL mp_allgather(sendbuf, da_sizes, mp_group)
CALL cumsum_l(INT(da_sizes, kind=file_offset), bdata_disps)
bdata_disps(:) = CSHIFT(bdata_disps, shift=-1) + SUM(INT(linfo_sizes, KIND=file_offset)) + &
ginfo_size + numnodes*2
bdata_disps(1) = SUM(INT(linfo_sizes, KIND=file_offset)) + ginfo_size + numnodes*2
CALL mp_file_open(mp_group, thefile, filepath, file_amode_create + file_amode_wronly)
IF (mynode .EQ. 0) THEN
CALL mp_file_write_at(thefile, BOF, version)
matrix_name_v_1_0 = matrix_name
CALL mp_file_write_at(thefile, BOF + version_len*mpi_character_size, matrix_name_v_1_0)
CALL mp_file_write_at(thefile, BOF + (version_len + default_string_length)*mpi_character_size, matrix_type)
CALL mp_file_write_at(thefile, BOF + char_count*mpi_character_size, &
(/size_of_pgrid, data_type, &
nblkrows_total, nblkcols_total, &
row_blk_size, col_blk_size/))
END IF
! write sub-header2
subh2_disps(:) = subh2_disps(:) + ginfo_size
subh2_offsets(:) = BOF + (subh2_disps - char_count)*mpi_integer_size + &
char_count*mpi_character_size
CALL mp_file_write_at_all(thefile, subh2_offsets(mynode + 1), (/nblks, data_area_size/))
! write sub-header3
subh3_offsets(:) = BOF + (subh3_disps - char_count)*mpi_integer_size + &
char_count*mpi_character_size
CALL mp_file_write_at_all(thefile, subh3_offsets(mynode + 1), (/row_p, col_i, blk_p/))
! write block data
mp_type = dbcsr_mp_type_from_anytype(data_area)
CALL mp_type_size(mp_type, type_size)
bdata_offsets(:) = BOF + (/((bdata_disps(i) - bdata_disps(1))*type_size, i=1, numnodes)/) + &
(bdata_disps(1) - char_count)*mpi_integer_size + &
char_count*mpi_character_size
SELECT CASE (data_type)
CASE (dbcsr_type_real_4)
r_sp => data_area%d%r_sp
CALL mp_file_write_at_all(thefile, bdata_offsets(mynode + 1), r_sp, msglen=data_area_size)
CASE (dbcsr_type_real_8)
r_dp => data_area%d%r_dp
CALL mp_file_write_at_all(thefile, bdata_offsets(mynode + 1), r_dp, msglen=data_area_size)
CASE (dbcsr_type_complex_4)
c_sp => data_area%d%c_sp
CALL mp_file_write_at_all(thefile, bdata_offsets(mynode + 1), c_sp, msglen=data_area_size)
CASE (dbcsr_type_complex_8)
c_dp => data_area%d%c_dp
CALL mp_file_write_at_all(thefile, bdata_offsets(mynode + 1), c_dp, msglen=data_area_size)
END SELECT
CALL mp_file_close(thefile)
DEALLOCATE (linfo_sizes, da_sizes)
DEALLOCATE (subh2_disps, subh2_offsets, subh3_disps, subh3_offsets)
DEALLOCATE (bdata_disps, bdata_offsets)
CALL timestop(handle)
CONTAINS
SUBROUTINE cumsum_l(arr, cumsum)
INTEGER(kind=file_offset), DIMENSION(:), &
INTENT(IN) :: arr
INTEGER(kind=file_offset), DIMENSION(SIZE(arr)), &
INTENT(OUT) :: cumsum
INTEGER :: i
cumsum(1) = arr(1)
DO i = 2, SIZE(arr)
cumsum(i) = cumsum(i - 1) + arr(i)
END DO
END SUBROUTINE cumsum_l
END SUBROUTINE dbcsr_binary_write