Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
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 |
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