calc_norms_s Subroutine

private subroutine calc_norms_s(norms, nblks, blki, rbs, cbs, DATA)

Calculates norms of the entire matrix with minimal overhead.

Arguments

Type IntentOptional Attributes Name
real(kind=sp), intent(out), DIMENSION(:) :: norms
integer, intent(in) :: nblks
integer, intent(in), DIMENSION(3, nblks) :: blki
integer, intent(in), DIMENSION(:) :: rbs
integer, intent(in), DIMENSION(:) :: cbs
real(kind=real_4), intent(in), DIMENSION(:) :: DATA

Source Code

      SUBROUTINE calc_norms_s (norms, nblks, &
                                           blki, rbs, cbs, DATA)
     !! Calculates norms of the entire matrix with minimal overhead.
         REAL(kind=sp), DIMENSION(:), INTENT(OUT) :: norms
         INTEGER, INTENT(IN)                      :: nblks
         INTEGER, DIMENSION(3, nblks), INTENT(IN) :: blki
         INTEGER, DIMENSION(:), INTENT(IN)        :: rbs, cbs
         REAL(kind=real_4), DIMENSION(:), &
            INTENT(IN)                            :: DATA

         INTEGER                                  :: blk, bp, bpe, row, col

         REAL(KIND=real_8), EXTERNAL              :: DDOT
#if defined (__ACCELERATE)
         REAL(KIND=real_8), EXTERNAL              :: SDOT
#else
         REAL(KIND=real_4), EXTERNAL              :: SDOT
#endif

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

!$OMP     parallel default(none) &
!$OMP              shared(DATA, norms, nblks, rbs, cbs, blki) &
!$OMP              private(row, col, blk, bp, bpe)
!$OMP     do schedule(dynamic)
         DO blk = 1, nblks
            bp = blki(3, blk)
            row = blki(1, blk)
            col = blki(2, blk)
# 724 "/__w/dbcsr/dbcsr/src/mm/dbcsr_mm_common.F"
               bpe = rbs(row)*cbs(col)
               norms(blk) = REAL((SDOT (bpe, data(bp), 1, data(bp), 1)), KIND = sp)
# 730 "/__w/dbcsr/dbcsr/src/mm/dbcsr_mm_common.F"
         END DO
!$OMP     end do
!$OMP     end parallel
      END SUBROUTINE calc_norms_s