blob: 51d83e406652b275f266543b7c46edcffeed17e3 [file] [log] [blame]
! { dg-options "-floop-nest-optimize -O3" }
MODULE spme
INTEGER, PARAMETER :: dp=8
PRIVATE
PUBLIC :: get_patch
CONTAINS
SUBROUTINE get_patch ( part, box, green, npts, p, rhos, is_core, is_shell,&
unit_charge, charges, coeff, n )
INTEGER, POINTER :: box
REAL(KIND=dp), &
DIMENSION(-(n-1):n-1, 0:n-1), &
INTENT(IN) :: coeff
INTEGER, DIMENSION(3), INTENT(IN) :: npts
REAL(KIND=dp), DIMENSION(:, :, :), &
INTENT(OUT) :: rhos
REAL(KIND=dp) :: q
REAL(KIND=dp), DIMENSION(3) :: delta, r
CALL get_delta ( box, r, npts, delta, nbox )
CALL spme_get_patch ( rhos, nbox, delta, q, coeff )
END SUBROUTINE get_patch
SUBROUTINE spme_get_patch ( rhos, n, delta, q, coeff )
REAL(KIND=dp), DIMENSION(:, :, :), &
INTENT(OUT) :: rhos
REAL(KIND=dp), DIMENSION(3), INTENT(IN) :: delta
REAL(KIND=dp), INTENT(IN) :: q
REAL(KIND=dp), &
DIMENSION(-(n-1):n-1, 0:n-1), &
INTENT(IN) :: coeff
INTEGER, PARAMETER :: nmax = 12
REAL(KIND=dp), DIMENSION(3, -nmax:nmax) :: w_assign
REAL(KIND=dp), DIMENSION(3, 0:nmax-1) :: deltal
REAL(KIND=dp), DIMENSION(3, 1:nmax) :: f_assign
DO l = 1, n-1
deltal ( 3, l ) = deltal ( 3, l-1 ) * delta ( 3 )
END DO
DO j = -(n-1), n-1, 2
DO l = 0, n-1
w_assign ( 1, j ) = w_assign ( 1, j ) + &
coeff ( j, l ) * deltal ( 1, l )
END DO
f_assign (3, i ) = w_assign ( 3, j )
DO i2 = 1, n
DO i1 = 1, n
rhos ( i1, i2, i3 ) = r2 * f_assign ( 1, i1 )
END DO
END DO
END DO
END SUBROUTINE spme_get_patch
SUBROUTINE get_delta ( box, r, npts, delta, n )
INTEGER, POINTER :: box
REAL(KIND=dp), DIMENSION(3), INTENT(IN) :: r
INTEGER, DIMENSION(3), INTENT(IN) :: npts
REAL(KIND=dp), DIMENSION(3), INTENT(OUT) :: delta
INTEGER, DIMENSION(3) :: center
REAL(KIND=dp), DIMENSION(3) :: ca, grid_i, s
CALL real_to_scaled(s,r,box)
s = s - REAL ( NINT ( s ),KIND=dp)
IF ( MOD ( n, 2 ) == 0 ) THEN
ca ( : ) = REAL ( center ( : ) )
END IF
delta ( : ) = grid_i ( : ) - ca ( : )
END SUBROUTINE get_delta
END MODULE spme