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