dbcsr_binary_write Subroutine

public 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

Arguments

TypeIntentOptionalAttributesName
type(dbcsr_type), intent(in) :: matrix

DBCSR matrix

character(len=*), intent(in) :: filepath

path to the file


Contents

Source Code


Source Code

   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