Prints a BCSR matrix (block-style, not full)
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| 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 |
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