Write a CSR matrix to file
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| type(csr_type), | intent(in) | :: | csr_mat | |||
| integer, | intent(in) | :: | unit_nr |
unit number to which output is written |
||
| logical, | intent(in), | optional | :: | upper_triangle |
If true (default: false), write only upper triangular part of matrix |
|
| real(kind=real_8), | intent(in), | optional | :: | threshold |
threshold on the absolute value of the elements to be printed |
|
| logical, | intent(in), | optional | :: | binary |
SUBROUTINE csr_write(csr_mat, unit_nr, upper_triangle, threshold, binary)
!! Write a CSR matrix to file
TYPE(csr_type), INTENT(IN) :: csr_mat
INTEGER, INTENT(IN) :: unit_nr
!! unit number to which output is written
LOGICAL, INTENT(IN), OPTIONAL :: upper_triangle
!! If true (default: false), write only upper triangular part of matrix
REAL(KIND=real_8), INTENT(IN), OPTIONAL :: threshold
!! threshold on the absolute value of the elements to be printed
LOGICAL, INTENT(IN), OPTIONAL :: binary
CHARACTER(LEN=*), PARAMETER :: routineN = 'csr_write'
CHARACTER(LEN=default_string_length) :: data_format
COMPLEX(KIND=real_4), ALLOCATABLE, DIMENSION(:) :: nzval_to_master_c_sp
COMPLEX(KIND=real_8), ALLOCATABLE, DIMENSION(:) :: nzval_to_master_c_dp
INTEGER :: handle, i, ii, k, l, m, mynode, &
numnodes, rowind, tag1, tag2, tag3
INTEGER, ALLOCATABLE, DIMENSION(:) :: colind_to_master, nzerow_to_master, &
sizes_numrowlocal, sizes_nzelocal
LOGICAL :: bin, ut
REAL(KIND=real_4), ALLOCATABLE, DIMENSION(:) :: nzval_to_master_r_sp
REAL(KIND=real_8) :: thld
REAL(KIND=real_8), ALLOCATABLE, DIMENSION(:) :: nzval_to_master_r_dp
CALL timeset(routineN, handle)
IF (PRESENT(upper_triangle)) THEN
ut = upper_triangle
ELSE
ut = .FALSE.
END IF
IF (PRESENT(threshold)) THEN
thld = threshold
ELSE
thld = 0.0_dp
END IF
IF (PRESENT(binary)) THEN
bin = binary
ELSE
bin = .FALSE.
END IF
IF (.NOT. csr_mat%valid) &
DBCSR_ABORT("can not write invalid CSR matrix")
tag1 = 0
tag2 = 1
tag3 = 2
CALL mp_environ(numnodes, mynode, csr_mat%mp_group)
! gather sizes (number of local non-zero elements and number of local rows)
ALLOCATE (sizes_nzelocal(numnodes))
ALLOCATE (sizes_numrowlocal(numnodes))
CALL mp_gather(csr_mat%nze_local, sizes_nzelocal, 0, csr_mat%mp_group)
CALL mp_gather(csr_mat%nrows_local, sizes_numrowlocal, 0, csr_mat%mp_group)
! for each node, send matrix data to node 0 (master) and write data
DO i = 0, numnodes - 1
ii = i
IF (mynode .EQ. 0) THEN ! allocations for receiving data from node i
ALLOCATE (colind_to_master(sizes_nzelocal(ii + 1)))
ALLOCATE (nzerow_to_master(sizes_numrowlocal(ii + 1)))
SELECT CASE (csr_mat%nzval_local%data_type)
CASE (dbcsr_type_real_4)
data_format = "(2(I8),E23.6E2)"
ALLOCATE (nzval_to_master_r_sp(sizes_nzelocal(ii + 1)))
CASE (dbcsr_type_real_8)
data_format = "(2(I8),E23.14E3)"
ALLOCATE (nzval_to_master_r_dp(sizes_nzelocal(ii + 1)))
CASE (dbcsr_type_complex_4)
data_format = "(2(I8),2(E23.6E2))"
ALLOCATE (nzval_to_master_c_sp(sizes_nzelocal(ii + 1)))
CASE (dbcsr_type_complex_8)
data_format = "(2(I8),2(E23.14E3))"
ALLOCATE (nzval_to_master_c_dp(sizes_nzelocal(ii + 1)))
END SELECT
END IF
IF (mynode .EQ. 0) THEN ! receive at node 0
IF (ii .EQ. 0) THEN ! data from node 0, no need for mpi routines
colind_to_master(:) = csr_mat%colind_local(:)
nzerow_to_master(:) = csr_mat%nzerow_local(:)
SELECT CASE (csr_mat%nzval_local%data_type)
CASE (dbcsr_type_real_4)
nzval_to_master_r_sp(:) = csr_mat%nzval_local%r_sp(:)
CASE (dbcsr_type_real_8)
nzval_to_master_r_dp(:) = csr_mat%nzval_local%r_dp(:)
CASE (dbcsr_type_complex_4)
nzval_to_master_c_sp(:) = csr_mat%nzval_local%c_sp(:)
CASE (dbcsr_type_complex_8)
nzval_to_master_c_dp(:) = csr_mat%nzval_local%c_dp(:)
END SELECT
ELSE ! receive data from nodes with rank > 0
CALL mp_recv(colind_to_master, ii, tag1, csr_mat%mp_group)
CALL mp_recv(nzerow_to_master, ii, tag2, csr_mat%mp_group)
SELECT CASE (csr_mat%nzval_local%data_type)
CASE (dbcsr_type_real_4)
CALL mp_recv(nzval_to_master_r_sp, ii, tag3, csr_mat%mp_group)
CASE (dbcsr_type_real_8)
CALL mp_recv(nzval_to_master_r_dp, ii, tag3, csr_mat%mp_group)
CASE (dbcsr_type_complex_4)
CALL mp_recv(nzval_to_master_c_sp, ii, tag3, csr_mat%mp_group)
CASE (dbcsr_type_complex_8)
CALL mp_recv(nzval_to_master_c_dp, ii, tag3, csr_mat%mp_group)
END SELECT
END IF
END IF
IF ((mynode .EQ. ii) .AND. (ii .NE. 0)) THEN ! send from nodes with rank > 0
CALL mp_send(csr_mat%colind_local, 0, tag1, csr_mat%mp_group)
CALL mp_send(csr_mat%nzerow_local, 0, tag2, csr_mat%mp_group)
SELECT CASE (csr_mat%nzval_local%data_type)
CASE (dbcsr_type_real_4)
CALL mp_send(csr_mat%nzval_local%r_sp, 0, tag3, csr_mat%mp_group)
CASE (dbcsr_type_real_8)
CALL mp_send(csr_mat%nzval_local%r_dp, 0, tag3, csr_mat%mp_group)
CASE (dbcsr_type_complex_4)
CALL mp_send(csr_mat%nzval_local%c_sp, 0, tag3, csr_mat%mp_group)
CASE (dbcsr_type_complex_8)
CALL mp_send(csr_mat%nzval_local%c_dp, 0, tag3, csr_mat%mp_group)
END SELECT
END IF
IF (mynode .EQ. 0) THEN ! write data received at node 0
!WRITE(unit_nr,"(A27)") "#row ind, col ind, value"
m = 0
DO k = 1, sizes_numrowlocal(ii + 1)
rowind = k + SUM(sizes_numrowlocal(1:ii)) ! row index: local to global
DO l = 1, nzerow_to_master(k)
m = m + 1
IF ((.NOT. ut) .OR. (rowind .LE. colind_to_master(m))) THEN
SELECT CASE (csr_mat%nzval_local%data_type)
CASE (dbcsr_type_real_4)
IF (ABS(nzval_to_master_r_sp(m)) .GE. thld) THEN
IF (bin) THEN
WRITE (unit_nr) rowind, colind_to_master(m), nzval_to_master_r_sp(m)
ELSE
WRITE (unit_nr, data_format) rowind, colind_to_master(m), &
nzval_to_master_r_sp(m)
END IF
END IF
CASE (dbcsr_type_real_8)
IF (ABS(nzval_to_master_r_dp(m)) .GE. thld) THEN
IF (bin) THEN
WRITE (unit_nr) rowind, colind_to_master(m), nzval_to_master_r_dp(m)
ELSE
WRITE (unit_nr, data_format) rowind, colind_to_master(m), &
nzval_to_master_r_dp(m)
END IF
END IF
CASE (dbcsr_type_complex_4)
IF (ABS(nzval_to_master_c_sp(m)) .GE. thld) THEN
IF (bin) THEN
WRITE (unit_nr) rowind, colind_to_master(m), nzval_to_master_c_sp(m)
ELSE
WRITE (unit_nr, data_format) rowind, colind_to_master(m), &
nzval_to_master_c_sp(m)
END IF
END IF
CASE (dbcsr_type_complex_8)
IF (ABS(nzval_to_master_c_dp(m)) .GE. thld) THEN
IF (bin) THEN
WRITE (unit_nr) rowind, colind_to_master(m), nzval_to_master_c_dp(m)
ELSE
WRITE (unit_nr, data_format) rowind, colind_to_master(m), &
nzval_to_master_c_dp(m)
END IF
END IF
END SELECT
END IF
END DO
END DO
DEALLOCATE (colind_to_master)
DEALLOCATE (nzerow_to_master)
SELECT CASE (csr_mat%nzval_local%data_type)
CASE (dbcsr_type_real_4)
DEALLOCATE (nzval_to_master_r_sp)
CASE (dbcsr_type_real_8)
DEALLOCATE (nzval_to_master_r_dp)
CASE (dbcsr_type_complex_4)
DEALLOCATE (nzval_to_master_c_sp)
CASE (dbcsr_type_complex_8)
DEALLOCATE (nzval_to_master_c_dp)
END SELECT
END IF
END DO
CALL timestop(handle)
END SUBROUTINE csr_write