I would like to ask your help regarding the fortran code presented at the bottom of this post.
With gfortran, the code compiles and works as intended. In contrast, with flang (new), the following error is raised.
error: Semantic errors in test/test.f90
./test/test.f90:58:17: error: Pointer bounds remapping target must have rank 1 or be simply contiguous
rank (2); wt_(1:ldwt, 1:ld2wt, 1:m) => wt
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
./test/test.f90:59:17: error: Pointer bounds remapping target must have rank 1 or be simply contiguous
rank (3); wt_(1:ldwt, 1:ld2wt, 1:m) => wt
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
./test/test.f90:65:17: error: Pointer bounds remapping target must have rank 1 or be simply contiguous
rank (2); t_(1:n, 1:m) => t
^^^^^^^^^^^^^^^^^
./test/test.f90:71:17: error: Pointer bounds remapping target must have rank 1 or be simply contiguous
rank (2); wtt_(1:n, 1:m) => wtt
Questions:
- Is my use of
select rankand/or pointer assignment non-conform, or is this aflangbug/limitation? - Is there a more elegant way to achieve the same result? I need to carry out this scaling operation at various points of the calling code, and the argument arrays are quite often in the “wrong” shape.
program test
implicit none
integer :: n, m, ldwt, ld2wt
real, allocatable :: wt1(:), t1(:), wtt1(:)
real, allocatable :: wt2(:,:,:), t2(:,:), wtt2(:,:)
n = 3
m = 2
ldwt = n
ld2wt = m
! rank-1 arrays
allocate(wt1(ldwt*ld2wt*m), t1(n*m), wtt1(n*m))
t1 = 1.0
wt1 = 2.0
call scale_mat(n, m, wt1, ldwt, ld2wt, t1, wtt1)
print *, "wtt1=", wtt1
! high-rank arrays
allocate(wt2(ldwt, ld2wt, m), t2(n, m), wtt2(n, m))
t2 = 1.0
wt2 = 2.0
call scale_mat(n, m, wt2, ldwt, ld2wt, t2, wtt2)
print *, "wtt2=", wtt2
contains
pure subroutine scale_mat(n, m, wt, ldwt, ld2wt, t, wtt)
!! Scale matrix `t` using `wt`, i.e., compute `wtt = wt*t`.
integer, intent(in) :: n
!! Number of rows of data in `t`.
integer, intent(in) :: m
!! Number of columns of data in `t`.
real, intent(in), target :: wt(..)
!! Array of shape conformable to `(ldwt,ld2wt,m)` holding the weights.
integer, intent(in) :: ldwt
!! Leading dimension of array `wt`.
integer, intent(in) :: ld2wt
!! Second dimension of array `wt`.
real, intent(in), target :: t(..)
!! Array of shape conformable to `(n,m)` being scaled by `wt`.
real, intent(out), target :: wtt(..)
!! Array of shape conformable to `(n,m)` holding the result of weighting array `t` by
!! array `wt`. Array `wtt` can be the same as `t` only if the arrays in `wt` are upper
!! triangular with zeros below the diagonal.
! Local scalars
integer :: i, j
real, pointer :: wt_(:, :, :), t_(:, :), wtt_(:, :)
if (n == 0 .or. m == 0) return
select rank (wt)
rank (1); wt_(1:ldwt, 1:ld2wt, 1:m) => wt
rank (2); wt_(1:ldwt, 1:ld2wt, 1:m) => wt
rank (3); wt_(1:ldwt, 1:ld2wt, 1:m) => wt
rank default; error stop "Invalid rank of `wt`."
end select
select rank (t)
rank (1); t_(1:n, 1:m) => t
rank (2); t_(1:n, 1:m) => t
rank default; error stop "Invalid rank of `t`."
end select
select rank (wtt)
rank (1); wtt_(1:n, 1:m) => wtt
rank (2); wtt_(1:n, 1:m) => wtt
rank default; error stop "Invalid rank of `wtt`."
end select
if (wt_(1, 1, 1) >= 0.0) then
if (ldwt >= n) then
if (ld2wt >= m) then
! WT is an N-array of M by M matrices
do j = 1, m
do i = 1, n
wtt_(i, j) = dot_product(wt_(i, j, :), t_(i, :))
end do
end do
else
! WT is an N-array of diagonal matrices
do j = 1, m
wtt_(:, j) = wt_(:, 1, j)*t_(:, j)
end do
end if
else
if (ld2wt >= m) then
! WT is an M by M matrix
do j = 1, m
do i = 1, n
wtt_(i, j) = dot_product(wt_(1, j, :), t_(i, :))
end do
end do
else
! WT is a diagonal matrix
do j = 1, m
wtt_(:, j) = wt_(1, 1, j)*t_(:, j)
end do
end if
end if
else
! WT is a scalar
wtt_ = abs(wt_(1, 1, 1))*t_
end if
end subroutine scale_mat
end program test
