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, & i, sendbuf, data_area_size, & data_type, type_size, & 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 TYPE(mp_comm_type) :: mp_group TYPE(mp_file_type) :: thefile 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