Applying in-place filtering on the workspace. \brief Use Frobenius norm
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
real(kind=real_8), | intent(in) | :: | filter_eps | |||
integer, | intent(inout) | :: | nblks | |||
integer, | intent(inout), | DIMENSION(1:nblks) | :: | rowi | ||
integer, | intent(inout), | DIMENSION(1:nblks) | :: | coli | ||
integer, | intent(inout), | DIMENSION(1:nblks) | :: | blkp | ||
integer, | intent(in), | DIMENSION(:) | :: | rbs | ||
integer, | intent(in), | DIMENSION(:) | :: | cbs | ||
integer, | intent(inout) | :: | nze | |||
real(kind=real_4), | intent(inout), | DIMENSION(:) | :: | DATA |
SUBROUTINE multrec_filtering_s (filter_eps, nblks, rowi, coli, blkp, &
rbs, cbs, nze, DATA)
!! Applying in-place filtering on the workspace.
!! \brief Use Frobenius norm
REAL(kind=real_8), INTENT(IN) :: filter_eps
INTEGER, INTENT(INOUT) :: nblks, nze
INTEGER, DIMENSION(1:nblks), INTENT(INOUT) :: rowi, coli, blkp
INTEGER, DIMENSION(:), INTENT(IN) :: rbs, cbs
REAL(kind=real_4), DIMENSION(:), &
INTENT(INOUT) :: DATA
INTEGER :: blk, lastblk, blk_nze, blk_p
REAL(kind=real_8) :: nrm
REAL(KIND=real_8), EXTERNAL :: DZNRM2, DDOT
#if defined (__ACCELERATE)
REAL(KIND=real_8), EXTERNAL :: SCNRM2, SDOT
#else
REAL(KIND=real_4), EXTERNAL :: SCNRM2, SDOT
#endif
REAL(kind=real_8) :: filter_eps_opt
# 719 "/__w/dbcsr/dbcsr/src/mm/dbcsr_mm_multrec.F"
! Avoid square root
filter_eps_opt = filter_eps**2
# 724 "/__w/dbcsr/dbcsr/src/mm/dbcsr_mm_multrec.F"
lastblk = 0
nze = 0
!
DO blk = 1, nblks
blk_p = blkp(blk)
IF (blk_p .EQ. 0) CYCLE
blk_nze = rbs(rowi(blk))*cbs(coli(blk))
IF (blk_nze .EQ. 0) CYCLE ! Skip empty blocks
nrm = REAL((SDOT (blk_nze, data(blk_p), 1, data(blk_p), 1)), KIND = real_8)
IF (nrm .GE. filter_eps_opt) THEN
! Keep block
lastblk = lastblk + 1
IF (lastblk .LT. blk) THEN
rowi(lastblk) = rowi(blk)
coli(lastblk) = coli(blk)
blkp(lastblk) = blkp(blk)
END IF
nze = nze + blk_nze
END IF
END DO
!
nblks = lastblk
END SUBROUTINE multrec_filtering_s