1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
|
! { 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
|
