1! { dg-do compile }
2! { dg-options "-floop-nest-optimize -O2" }
3
4SUBROUTINE integrate_core_1(grid,coef_xyz,pol_x,pol_y,&
5             pol_z,map,sphere_bounds,cmax,gridbounds)
6    INTEGER, PARAMETER :: dp=8
7    INTEGER, INTENT(IN)    :: sphere_bounds(*), cmax, &
8                              map(-cmax:cmax,1:3), &
9                              gridbounds(2,3)
10    REAL(dp), INTENT(IN) :: grid(gridbounds(1,1):gridbounds(2,1), &
11             gridbounds(1,2):gridbounds(2,2),&
12             gridbounds(1,3):gridbounds(2,3))
13    INTEGER, PARAMETER     :: lp = 1
14    REAL(dp), INTENT(IN)   :: pol_x(0:lp,-cmax:cmax), &
15                              pol_y(1:2,0:lp,-cmax:0), &
16                              pol_z(1:2,0:lp,-cmax:0)
17    REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6)
18    INTEGER   :: i, ig, igmax, igmin, j, j2, &
19                 jg, jg2, jgmin, k, k2, kg, &
20                 kg2, kgmin, lxp, sci
21    REAL(dp)  :: coef_x(4,0:lp), &
22                 coef_xy(2,((lp+1)*(lp+2))/2), &
23                 s(4)
24    DO kg=kgmin,0
25       DO jg=jgmin,0
26          coef_x=0.0_dp
27          DO ig=igmin,igmax
28             DO lxp=0,lp
29                coef_x(:,lxp)=coef_x(:,lxp)+s(:)*pol_x(lxp,ig)
30             ENDDO
31          END DO
32             coef_xy(:,3)=coef_xy(:,3)+coef_x(3:4,0)*pol_y(2,1,jg)
33       END DO
34                coef_xyz(3)=coef_xyz(3)+coef_xy(1,3)*pol_z(1,0,kg)
35    END DO
36  END SUBROUTINE integrate_core_1
37