| ! { dg-do run } |
| ! PR 34566 - logical matmul used to give the wrong result. |
| ! We check this by running through every permutation in |
| ! multiplying two 3*3 matrices, and all permutations of multiplying |
| ! a 3-vector and a 3*3 matrices and checking against equivalence |
| ! with integer matrix multiply. |
| program main |
| implicit none |
| integer, parameter :: ki=4 |
| integer, parameter :: dimen=3 |
| integer :: i, j, k |
| real, dimension(dimen,dimen) :: r1, r2 |
| integer, dimension(dimen,dimen) :: m1, m2 |
| logical(kind=ki), dimension(dimen,dimen) :: l1, l2 |
| logical(kind=ki), dimension(dimen*dimen) :: laux |
| logical(kind=ki), dimension(dimen) :: lv |
| integer, dimension(dimen) :: iv |
| |
| do i=0,2**(dimen*dimen)-1 |
| forall (k=1:dimen*dimen) |
| laux(k) = btest(i, k-1) |
| end forall |
| l1 = reshape(laux,shape(l1)) |
| m1 = ltoi(l1) |
| |
| ! Check matrix*matrix multiply |
| do j=0,2**(dimen*dimen)-1 |
| forall (k=1:dimen*dimen) |
| laux(k) = btest(i, k-1) |
| end forall |
| l2 = reshape(laux,shape(l2)) |
| m2 = ltoi(l2) |
| if (any(matmul(l1,l2) .neqv. (matmul(m1,m2) /= 0))) then |
| STOP 1 |
| end if |
| end do |
| |
| ! Check vector*matrix and matrix*vector multiply. |
| do j=0,2**dimen-1 |
| forall (k=1:dimen) |
| lv(k) = btest(j, k-1) |
| end forall |
| iv = ltoi(lv) |
| if (any(matmul(lv,l1) .neqv. (matmul(iv,m1) /=0))) then |
| STOP 2 |
| end if |
| if (any(matmul(l1,lv) .neqv. (matmul(m1,iv) /= 0))) then |
| STOP 3 |
| end if |
| end do |
| end do |
| |
| contains |
| elemental function ltoi(v) |
| implicit none |
| integer :: ltoi |
| real :: rtoi |
| logical(kind=4), intent(in) :: v |
| if (v) then |
| ltoi = 1 |
| else |
| ltoi = 0 |
| end if |
| end function ltoi |
| |
| end program main |