pd_blk_cs Function

private pure function pd_blk_cs(ld, od, DATA, tr, ro, co) result(pd_cs)

Arguments

TypeIntentOptionalAttributesName
integer, intent(in) :: ld
integer, intent(in) :: od
real(kind=dp), intent(in), DIMENSION(ld, od):: DATA
logical, intent(in) :: tr
integer, intent(in) :: ro
integer, intent(in) :: co

Return Value real(kind=dp)


Contents

Source Code


Source Code

   PURE FUNCTION pd_blk_cs(ld, od, DATA, tr, ro, co) RESULT(pd_cs)
      INTEGER, INTENT(IN)                                :: ld, od
      REAL(KIND=dp), DIMENSION(ld, od), INTENT(IN)       :: DATA
      LOGICAL, INTENT(IN)                                :: tr
      INTEGER, INTENT(IN)                                :: ro, co
      REAL(KIND=dp)                                      :: pd_cs

      INTEGER                                            :: c, cs, r, rs

      pd_cs = 0.0_dp
      rs = ld; cs = od
      IF (tr) THEN
         CALL swap(rs, cs)
         DO r = 1, rs
            DO c = 1, cs
               pd_cs = pd_cs + DATA(c, r)*LOG(ABS(REAL((ro + r - 1), KIND=dp)*REAL((co + c - 1), KIND=dp)))
            END DO
         END DO
      ELSE
         DO c = 1, cs
            DO r = 1, rs
               pd_cs = pd_cs + DATA(r, c)*LOG(ABS(REAL((ro + r - 1), KIND=dp)*REAL((co + c - 1), KIND=dp)))
            END DO
         END DO
      END IF
   END FUNCTION pd_blk_cs