dbcsr_print Subroutine

public subroutine dbcsr_print(matrix, nodata, matlab_format, variable_name, unit_nr)

Prints a BCSR matrix (block-style, not full)

Arguments

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

matrix

logical, intent(in), optional :: nodata

don't print actual data

logical, intent(in), optional :: matlab_format

don't print actual data

character(len=*), intent(in), optional :: variable_name
integer, intent(in), optional :: unit_nr

Contents

Source Code


Source Code

   SUBROUTINE dbcsr_print(matrix, nodata, matlab_format, variable_name, unit_nr)
      !! Prints a BCSR matrix (block-style, not full)

      TYPE(dbcsr_type), INTENT(IN)                       :: matrix
         !! matrix
      LOGICAL, INTENT(IN), OPTIONAL                      :: nodata, matlab_format
         !! don't print actual data
      CHARACTER(LEN=*), INTENT(IN), OPTIONAL             :: variable_name
      INTEGER, INTENT(IN), OPTIONAL                      :: unit_nr

      CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_print', routineP = moduleN//':'//routineN

      COMPLEX(KIND=real_4), DIMENSION(:), POINTER        :: c_sp
      COMPLEX(KIND=real_8), DIMENSION(:), POINTER        :: c_dp
      INTEGER                                            :: ablk_p, bc, blk, blk_p, br, ebr, fblk, &
                                                            handle, ibr, iunit, lblk, m, mn, n, &
                                                            sblk
      INTEGER, DIMENSION(:), POINTER                     :: col_blk_offset, col_blk_size, &
                                                            local_cols, local_rows, &
                                                            row_blk_offset, row_blk_size
      LOGICAL                                            :: my_matlab_format, tr, yesprint
      REAL(KIND=dp)                                      :: blk_cs
      REAL(KIND=real_4), DIMENSION(:), POINTER           :: r_sp
      REAL(KIND=real_8), DIMENSION(:), POINTER           :: r_dp

!   ---------------------------------------------------------------------------

      CALL timeset(routineN, handle)
      IF (.NOT. dbcsr_valid_index(matrix)) &
         DBCSR_WARN("Can not print invalid matrix.")

      iunit = default_output_unit
      IF (PRESENT(unit_nr)) iunit = unit_nr

      my_matlab_format = .FALSE.
      IF (PRESENT(matlab_format)) my_matlab_format = matlab_format
      yesprint = .TRUE.
      IF (PRESENT(nodata)) yesprint = .NOT. nodata
      WRITE (iunit, *) routineP//' Contents of matrix named ', matrix%name
      WRITE (iunit, *) routineP//' Flags ', matrix%symmetry, &
         matrix%negate_real, matrix%negate_imaginary, "type", &
         dbcsr_get_data_type(matrix), "serial", matrix%serial_number
      WRITE (iunit, '(1X,A,3(1X,I9,1X,A))') routineP, matrix%nblks, "blocks", &
         matrix%nze, "nzes,", dbcsr_get_data_size(matrix), "data els", &
         dbcsr_data_get_size_referenced(matrix%data_area), "used"
      WRITE (iunit, '(1X,A,I5,A,I5)') routineP//" Full size", &
         matrix%nfullrows_total, "x", matrix%nfullcols_total
      WRITE (iunit, '(1X,A,I5,A,I5)') routineP//" Blocked size", &
         matrix%nblkrows_total, "x", matrix%nblkcols_total
      SELECT CASE (matrix%data_type)
      CASE (dbcsr_type_real_8)
         CALL dbcsr_get_data(matrix%data_area, r_dp)
      CASE (dbcsr_type_real_4)
         CALL dbcsr_get_data(matrix%data_area, r_sp)
      CASE (dbcsr_type_complex_8)
         CALL dbcsr_get_data(matrix%data_area, c_dp)
      CASE (dbcsr_type_complex_4)
         CALL dbcsr_get_data(matrix%data_area, c_sp)
      END SELECT
      row_blk_size => array_data(matrix%row_blk_size)
      col_blk_size => array_data(matrix%col_blk_size)
      row_blk_offset => array_data(matrix%row_blk_offset)
      col_blk_offset => array_data(matrix%col_blk_offset)

      IF (matrix%nblks .GT. 0) THEN
         IF (matrix%list_indexing) THEN
            IF (SIZE(matrix%coo_l) .NE. 3*matrix%nblks) &
               DBCSR_ABORT("Wrong list")
            ebr = 1
            sblk = 3
         ELSE
            ebr = matrix%nblkrows_total
            sblk = 1
         END IF
         DO ibr = 1, ebr
            IF (matrix%list_indexing) THEN
               fblk = 1
               lblk = SIZE(matrix%coo_l)
            ELSE
               br = ibr
               fblk = matrix%row_p(br) + 1
               lblk = matrix%row_p(br + 1)
               m = row_blk_size(br)
            END IF
            DO blk = fblk, lblk, sblk
               IF (matrix%list_indexing) THEN
                  br = matrix%coo_l(blk)
                  bc = matrix%coo_l(blk + 1)
                  IF (matrix%local_indexing) THEN
                     local_rows => array_data(matrix%local_rows)
                     local_cols => array_data(matrix%local_cols)
                     br = local_rows(br)
                     bc = local_cols(bc)
                  END IF
                  m = row_blk_size(br)
                  ablk_p = matrix%coo_l(blk + 2)
               ELSE
                  bc = matrix%col_i(blk)
                  ablk_p = matrix%blk_p(blk)
               END IF
               n = col_blk_size(bc)
               mn = m*n
               blk_p = ABS(ablk_p)
               tr = ablk_p .LT. 0
               block_exists: IF (blk_p .NE. 0) THEN
                  IF (mn .GT. 0) THEN
                     SELECT CASE (matrix%data_type)
                     CASE (dbcsr_type_real_8)
                        blk_cs = REAL(DOT_PRODUCT(r_dp(blk_p:blk_p + mn - 1), &
                                                  r_dp(blk_p:blk_p + mn - 1)), KIND=dp)
                        !CALL &
                        !     dbcsr_printmat(r_dp(blk_p:blk_p+mn-1),m,n, tr=tr)
                     CASE (dbcsr_type_real_4)
                        blk_cs = REAL(DOT_PRODUCT(r_sp(blk_p:blk_p + mn - 1), &
                                                  r_sp(blk_p:blk_p + mn - 1)), KIND=dp)
                        !CALL &
                        !     dbcsr_printmat(r_sp(blk_p:blk_p+mn-1),m,n, tr=tr)
                     CASE (dbcsr_type_complex_8)
                        blk_cs = REAL(DOT_PRODUCT(c_dp(blk_p:blk_p + mn - 1), &
                                                  c_dp(blk_p:blk_p + mn - 1)), KIND=dp)
                        !CALL &
                        !     dbcsr_printmat(c_dp(blk_p:blk_p+mn-1),m,n, tr=tr)
                     CASE (dbcsr_type_complex_4)
                        blk_cs = REAL(DOT_PRODUCT(c_sp(blk_p:blk_p + mn - 1), &
                                                  c_sp(blk_p:blk_p + mn - 1)), KIND=dp)
                        !CALL &
                        !     dbcsr_printmat(c_sp(blk_p:blk_p+mn-1),m,n, tr=tr)
                     END SELECT
                  ELSE
                     blk_cs = 0.0_dp
                  END IF
                  !WRITE(iunit,*)routineP//' chksum for (',br,',',bc,') at',&
                  !     blk_p,'l',mn,'= ', blk_cs,'size',m,n
                  IF (.NOT. my_matlab_format) WRITE (iunit, '(A,I6,",",I6,A,I7,A,I6,I6,"=",I7,A,E12.3)') &
                     !" Checksum for (",br,bc,") at ",blk_p," size ",m,n,mn,&
                     " Checksum for (", br, bc, ") at ", ablk_p, " size ", m, n, mn, &
                     " checksum=", blk_cs
                  IF (yesprint .AND. blk_p .NE. 0) THEN
                     IF (mn .GT. 0) THEN
                        SELECT CASE (matrix%data_type)
                        CASE (dbcsr_type_real_8)
                           !WRITE(iunit,'(10(1X,F7.2))')r_dp(blk_p:blk_p+mn-1)
                           IF (my_matlab_format) THEN
                              CALL dbcsr_printmat_matlab_d(r_dp(blk_p:blk_p + mn - 1), m, n, &
                                                           row_blk_offset(br), col_blk_offset(bc), iunit, tr=tr, &
                                                           variable_name=variable_name)
                           ELSE
                              CALL dbcsr_printmat(r_dp(blk_p:blk_p + mn - 1), m, n, iunit=iunit, tr=tr)
                           END IF
                        CASE (dbcsr_type_real_4)
                           IF (my_matlab_format) THEN
                              CALL dbcsr_printmat_matlab_s(r_sp(blk_p:blk_p + mn - 1), m, n, &
                                                           row_blk_offset(br), col_blk_offset(bc), iunit, tr=tr, &
                                                           variable_name=variable_name)
                           ELSE
                              CALL dbcsr_printmat(r_sp(blk_p:blk_p + mn - 1), m, n, iunit=iunit, tr=tr)
                           END IF
                        CASE (dbcsr_type_complex_8)
                           IF (my_matlab_format) THEN
                              CALL dbcsr_printmat_matlab_z(c_dp(blk_p:blk_p + mn - 1), m, n, &
                                                           row_blk_offset(br), col_blk_offset(bc), iunit, tr=tr, &
                                                           variable_name=variable_name)
                           ELSE
                              CALL dbcsr_printmat(c_dp(blk_p:blk_p + mn - 1), m, n, iunit=iunit, tr=tr)
                           END IF
                        CASE (dbcsr_type_complex_4)
                           IF (my_matlab_format) THEN
                              CALL dbcsr_printmat_matlab_c(c_sp(blk_p:blk_p + mn - 1), m, n, &
                                                           row_blk_offset(br), col_blk_offset(bc), iunit, tr=tr, &
                                                           variable_name=variable_name)
                           ELSE
                              CALL dbcsr_printmat(c_sp(blk_p:blk_p + mn - 1), m, n, iunit=iunit, tr=tr)
                           END IF
                        END SELECT
                     END IF
                  END IF
               END IF block_exists
            END DO
         END DO
      END IF
      CALL timestop(handle)
   END SUBROUTINE dbcsr_print