1! { dg-do compile } 2! { dg-options "-floop-nest-optimize -O1" } 3 4MODULE d3_poly 5 INTEGER, PUBLIC, PARAMETER :: max_grad2=5 6 INTEGER, PUBLIC, PARAMETER :: max_grad3=3 7 INTEGER, PUBLIC, PARAMETER :: cached_dim2=(max_grad2+1)*(max_grad2+2)/2 8 INTEGER, PUBLIC, PARAMETER :: cached_dim3=(max_grad3+1)*(max_grad3+2)*(max_grad3+3)/6 9 INTEGER, SAVE, DIMENSION(3,cached_dim3) :: a_mono_exp3 10 INTEGER, SAVE, DIMENSION(cached_dim2,cached_dim2) :: a_mono_mult2 11 INTEGER, SAVE, DIMENSION(cached_dim3,cached_dim3) :: a_mono_mult3 12 INTEGER, SAVE, DIMENSION(4,cached_dim3) :: a_mono_mult3a 13CONTAINS 14SUBROUTINE init_d3_poly_module() 15 INTEGER :: grad, i, ii, ij, j, subG 16 INTEGER, DIMENSION(3) :: monoRes3 17 DO grad=0,max_grad2 18 DO i=grad,0,-1 19 DO j=grad-i,0,-1 20 END DO 21 END DO 22 END DO 23 DO ii=1,cached_dim3 24 DO ij=ii,cached_dim2 25 a_mono_mult2(ij,ii)=a_mono_mult2(ii,ij) 26 END DO 27 END DO 28 DO ii=1,cached_dim3 29 DO ij=ii,cached_dim3 30 monoRes3=a_mono_exp3(:,ii)+a_mono_exp3(:,ij) 31 a_mono_mult3(ii,ij)=mono_index3(monoRes3(1),monoRes3(2),monoRes3(3))+1 32 a_mono_mult3(ij,ii)=a_mono_mult3(ii,ij) 33 END DO 34 END DO 35 DO i=1,cached_dim3 36 DO j=1,4 37 a_mono_mult3a(j,i)=a_mono_mult3(j,i) 38 END DO 39 END DO 40END SUBROUTINE 41PURE FUNCTION mono_index3(i,j,k) RESULT(res) 42 INTEGER, INTENT(in) :: i, j, k 43 res=grad*(grad+1)*(grad+2)/6+(sgrad)*(sgrad+1)/2+k 44END FUNCTION 45END MODULE d3_poly 46