calc_norms_c Subroutine

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

Calculates norms of the entire matrix with minimal overhead.

Arguments

TypeIntentOptionalAttributesName
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
complex(kind=real_4), intent(in), DIMENSION(:):: DATA

Contents

Source Code


Source Code

      SUBROUTINE calc_norms_c (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
         COMPLEX(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)
# 602 "/__w/dbcsr/dbcsr/src/mm/dbcsr_mm_common.F"
               bpe = bp + rbs(row)*cbs(col) - 1
               norms(blk) = REAL(SUM(ABS(DATA(bp:bpe))**2), KIND=sp)
# 605 "/__w/dbcsr/dbcsr/src/mm/dbcsr_mm_common.F"
         END DO
!$OMP     end do
!$OMP     end parallel
      END SUBROUTINE calc_norms_c