1! { dg-do compile }
2! PR fortran/33343
3!
4! Check conformance of array actual arguments to
5! elemental function.
6!
7! Contributed by Mikael Morin  <mikael.morin@tele2.fr>
8!
9      module geometry
10      implicit none
11      integer, parameter :: prec = 8
12      integer, parameter :: length = 10
13      contains
14      elemental function Mul(a, b)
15      real(kind=prec) :: a
16      real(kind=prec) :: b, Mul
17      intent(in)      :: a, b
18      Mul = a * b
19      end function Mul
20
21      pure subroutine calcdAcc2(vectors, angles)
22      real(kind=prec),      dimension(:)          :: vectors
23      real(kind=prec), dimension(size(vectors),2) :: angles
24      intent(in) :: vectors, angles
25      real(kind=prec), dimension(size(vectors)) :: ax
26      real(kind=prec), dimension(size(vectors),2) :: tmpAcc
27      tmpAcc(1,:) = Mul(angles(1,1:2),ax(1)) ! Ok
28      tmpAcc(:,1) = Mul(angles(:,1),ax)      ! OK
29      tmpAcc(:,:) = Mul(angles(:,:),ax) ! { dg-error "Incompatible ranks in elemental procedure" }
30      end subroutine calcdAcc2
31      end module geometry
32