1! { dg-options "-floop-nest-optimize -O3" }
2
3MODULE spme
4  INTEGER, PARAMETER :: dp=8
5  PRIVATE
6  PUBLIC :: get_patch
7CONTAINS
8  SUBROUTINE get_patch ( part, box, green, npts, p, rhos, is_core, is_shell,&
9                         unit_charge, charges, coeff, n )
10    INTEGER, POINTER                 :: box
11    REAL(KIND=dp), &
12      DIMENSION(-(n-1):n-1, 0:n-1), &
13      INTENT(IN)                             :: coeff
14    INTEGER, DIMENSION(3), INTENT(IN)        :: npts
15    REAL(KIND=dp), DIMENSION(:, :, :), &
16      INTENT(OUT)                            :: rhos
17    REAL(KIND=dp)                            :: q
18    REAL(KIND=dp), DIMENSION(3)              :: delta, r
19    CALL get_delta ( box, r, npts, delta, nbox )
20    CALL spme_get_patch ( rhos, nbox, delta, q, coeff )
21  END SUBROUTINE get_patch
22  SUBROUTINE spme_get_patch ( rhos, n, delta, q, coeff )
23    REAL(KIND=dp), DIMENSION(:, :, :), &
24      INTENT(OUT)                            :: rhos
25    REAL(KIND=dp), DIMENSION(3), INTENT(IN)  :: delta
26    REAL(KIND=dp), INTENT(IN)                :: q
27    REAL(KIND=dp), &
28      DIMENSION(-(n-1):n-1, 0:n-1), &
29      INTENT(IN)                             :: coeff
30    INTEGER, PARAMETER                       :: nmax = 12
31    REAL(KIND=dp), DIMENSION(3, -nmax:nmax)  :: w_assign
32    REAL(KIND=dp), DIMENSION(3, 0:nmax-1)    :: deltal
33    REAL(KIND=dp), DIMENSION(3, 1:nmax)      :: f_assign
34    DO l = 1, n-1
35       deltal ( 3, l ) = deltal ( 3, l-1 ) * delta ( 3 )
36    END DO
37    DO j = -(n-1), n-1, 2
38       DO l = 0, n-1
39          w_assign ( 1, j ) =  w_assign ( 1, j ) + &
40                         coeff ( j, l ) * deltal ( 1, l )
41       END DO
42       f_assign (3, i ) = w_assign ( 3, j )
43       DO i2 = 1, n
44          DO i1 = 1, n
45             rhos ( i1, i2, i3 ) = r2 * f_assign ( 1, i1 )
46          END DO
47       END DO
48    END DO
49  END SUBROUTINE spme_get_patch
50  SUBROUTINE get_delta ( box, r, npts, delta, n )
51    INTEGER, POINTER :: box
52    REAL(KIND=dp), DIMENSION(3), INTENT(IN)  :: r
53    INTEGER, DIMENSION(3), INTENT(IN)        :: npts
54    REAL(KIND=dp), DIMENSION(3), INTENT(OUT) :: delta
55    INTEGER, DIMENSION(3)                    :: center
56    REAL(KIND=dp), DIMENSION(3)              :: ca, grid_i, s
57    CALL real_to_scaled(s,r,box)
58    s = s - REAL ( NINT ( s ),KIND=dp)
59    IF ( MOD ( n, 2 ) == 0 ) THEN
60       ca ( : ) = REAL ( center ( : ) )
61    END IF
62    delta ( : ) = grid_i ( : ) - ca ( : )
63  END SUBROUTINE get_delta
64END MODULE spme
65