csr_write Subroutine

   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