1! { dg-do compile }
2! { dg-additional-options "-ffrontend-optimize" }
3! PR 84270 - this used to be rejected.
4! Test case by Michael Weinert
5
6module fp_precision
7
8   integer, parameter   :: fp = selected_real_kind(13)
9
10end module fp_precision
11
12      subroutine lhcal(nrot,orth,ngpts,vgauss,vr_0)
13
14      use fp_precision  ! floating point precision
15
16      implicit none
17
18!--->    rotation matrices and rotations (input)
19      integer,          intent(in)  :: nrot
20!     real(kind=fp),    intent(in)  :: orth(3,3,nrot)  ! fine at all -O
21      real(kind=fp),    intent(in)  :: orth(3,3,*)
22
23!--->    gaussian integration points
24      integer,          intent(in)  :: ngpts
25      real(kind=fp),    intent(in)  :: vgauss(3,*)
26
27!--->    output results
28      real(kind=fp),    intent(out) :: vr_0(3)
29
30      real(kind=fp)     :: v(3),vr(3)
31      integer           :: n,nn
32
33      vr_0 = 0
34      do nn=1,ngpts
35         v(:) = vgauss(:,nn)
36!--->    apply rotations
37         do n=2,nrot
38            vr = matmul( orth(:,:,n), v )
39            vr_0 = vr_0 + vr
40         enddo
41      enddo
42
43      return
44      end subroutine lhcal
45