I am trying to code a computationally efficient PACK operation over a polymorphic array and I am running on issues with gfortran 9.2.0:
The PACK operation has to work on a polymorphic array of a derived type quantity, and return a result on itself
For reasons I'm not explaining here, this array should not be reallocated
In general, there is overlap between the locations of the returned indices, and those of the original array: something like array(1:5) = array([2,4,6,8,10])
I'm having problems, as the only version of the assigment I've tried with gfortran is with a loop - all array-based version either produce compiler or runtime segfaults.
An example is reported in this program:
module m
implicit none
type, public :: t
integer :: i = 0
contains
procedure, private, pass(this) :: t_assign => t_to_t
generic :: assignment(=) => t_assign
end type t
type, public, extends(t) :: tt
integer :: j = 0
contains
procedure, private, pass(this) :: t_assign => t_to_tt
end type tt
contains
elemental subroutine t_to_t(this,that)
class(t), intent(inout) :: this
class(t), intent(in ) :: that
this%i = that%i
end subroutine t_to_t
elemental subroutine t_to_tt(this,that)
class(tt), intent(inout) :: this
class(t ), intent(in ) :: that
this%i = that%i
select type (thatPtr=>that)
type is (t)
this%j = 0
type is (tt)
this%j = thatPtr%j
class default
! Cannot stop here
this%i = -1
this%j = -1
end select
end subroutine t_to_tt
end module m
program test_poly_pack
use m
implicit none
integer, parameter :: n = 100
integer :: i,j
class(t), allocatable :: poly(:),otherPoly(:)
allocate(t :: poly(n))
allocate(t :: otherPoly(10))
! Assign dummy values
forall(i=1:n) poly(i)%i = i
! Array assignment with indices => ICE segfault:
! internal compiler error: Segmentation fault
otherPoly(1:10) = poly([10,20,30,40,50,60,70,80,90,100])
! Scalar assignment with loop -> OK
do i=1,10
otherPoly(i) = poly(10*i)
end do
! Array assignment with PACK => Compiles OK, Segfault on runtime. GDB returns:
! Thread 1 received signal SIGSEGV, Segmentation fault.
! 0x000000000040163d in m::t_to_t (this=..., that=...) at test_poly_pack.f90:31
! 31 this%i = that%i
otherPoly(1:10) = pack(poly,mod([(j,j=1,100)],10)==0)
do i=1,10
print *, ' polymorphic(',i,')%i = ',otherPoly(i)%i
end do
end program test_poly_pack
Am I doing anything wrong, and/or is this only a compiler bug or there is any best practices I should be following?
The crashes are compiler bugs. When the compiler says internal compiler error ... Please submit a full bug report, you really can trust it and you should act accordingly (and submit the bug report). The runtime crash is a compiler bug as well (wrong code).
If you know the actual types at the time of the assignment, you can use type guards
select type (p => poly)
type is (t)
select type(op => otherpoly)
type is (t)
op(1:10) = pack(p,mod([(j,j=1,100)],10)==0)
end select
end select
If you need it to be polymorphic - you probably have to reallocate
allocate(otherPoly(1:10),source = pack(poly,mod([(j,j=1,100)],10)==0))
until the bugs you hopefully reported are fixed.
A similar question was answered in Fortran runtime warning: temporary array. However, the solutions do not quite help me in my case.
Inside a subroutine, I have a subroutine call as:
subroutine initialize_prim(prim)
real(kind=wp), dimension(2, -4:204), intent(out) :: prim
call double_gaussian(prim(1, :))
end subroutine initialize_prim
subroutine double_gaussian(y)
real(kind=wp), dimension(-4:204), intent(out) :: y
integer :: i
do i = -4, 204
y(i) = 0.5 * ( &
exp(-((r(i) - r0))**2) + exp(-((r(i) + r0)/std_dev)**2))
end do
end subroutine double_gaussian
This gives an error message saying that fortran creates a temporary array for "y" in "double_gaussian". Having read a bit about continguous arrays, I understand why this error appears.
Now, looking at my whole program, it would be very tedious to invert the order of the arrays for "prim", so that solution is not really possible.
For creating assumed-shapes in "double_gaussian", I tried doing,
real(kind=wp), dimension(:), intent(out) :: y
integer :: i
do i = -4, 204
y(i) = 0.5 * ( &
exp(-((r(i) - r0))**2) + exp(-((r(i) + r0)/std_dev)**2))
end do
end subroutine double_gaussian
This, however, causes fortran to crash with the error message
"Index '-4' of dimension 1 of array 'y' below lower bound of 1".
It seems that for the assumed-shape format, the indexing is nonetheless assumed to start with 1, whereas it starts at -4 as in my case.
Is there a way to resolve this issue?
I think that you have perhaps misinterpreted a compiler warning as an error. Usually compilers issue a warning when they create temporary arrays - it's a useful aid to high-performance programming. But I'm not sure a compiler ever regards that as an error. And yes, I understand why you might not want to re-order your array just to avoid that
As for the crash - you have discovered that Fortran routines don't automagically know about the lower bounds of arrays which you have carefully set to be other than 1 (nor their upper bounds either). If it is necessary you have to pass the bounds (usually only the lower bound, the routine can figure out the upper bound itself) in the argument list.
However, it rarely is necessary, and it doesn't seem to be in your code - the loop to set each value of the y array could (if I understand correctly) be replaced by
y = 0.5 * (exp(-((r - r0))**2) + exp(-((r + r0)/std_dev)**2))
PS I think that this part of your question, about routines not respecting other-than-1 array lower bounds, is almost certainly a duplicate of several others asked hereabouts but which I couldn't immediately find.
When I compile the program below, I have an error and a warning in the call Coor_Trans command line as
Warning: Line truncated
Error: Syntax error in argument list
I compile the program several times, but it does not work. Maybe there is something wrong with my call command.
program 3D
implicit none
integer :: i,j,k
integer, parameter :: FN=2,FML=5,FMH=5
integer, parameter :: NBE=FN*FML*FMH
real, parameter :: pi = 4*atan(1.0)
real(kind=4), dimension(1:FN,1:FML+1,1:FMH+1) :: BEXL,BEYL,BEZL
real(kind=4), dimension(1:FN,1:FML,1:FMH) :: BEXC,BEYC,BEZC,BE2A,BE2B,ANGLE
real(kind=4), dimension(1:NBE,1:1,1:1) :: BEXC1,BEYC1,BEZC1,BE2A1,BE2B1,ANGLE1
real(kind=4), dimension(1:NBE,1:NBE) :: LOC_PTS1,LOC_PTS2,LOC_PTS3
real :: LOC_1,LOC_2,LOC_3
do i=1,FN
do j=1,FML
do k=1,FMH
BEXC(i,j,k) = 0.5*(BEXL(i,j,k) + BEXL(i,j+1,k))
BEYC(i,j,k) = 0.5*(BEYL(i,j,k) + BEYL(i,j+1,k))
BEZC(i,j,k) = 0.5*(BEZL(i,j,k) + BEZL(i,j,k+1))
BE2A(i,j,k) = FL(i)/FML + j*0 + k*0
BE2B(i,j,k) = FH(i)/FMH + j*0 + k*0
ANGLE(i,j,k) = BETA(i) + j*0 + k*0
end do
end do
end do
BEXC1 = reshape(BEXC,(/NBE,1,1/))
BEYC1 = reshape(BEYC,(/NBE,1,1/))
BEZC1 = reshape(BEZC,(/NBE,1,1/))
BE2A1 = reshape(BE2A,(/NBE,1,1/))
BE2B1 = reshape(BE2B,(/NBE,1,1/))
ANGLE1 = reshape(ANGLE,(/NBE,1,1/))
do i=1,NBE
do j=1,NBE
call Coor_Trans(BEXC1(i,1,1),BEYC1(i,1,1),BEZC1(i,1,1),BEXC1(j,1,1),BEYC1(j,1,1),BEZC1(j,1,1),ANGLE1(j,1,1),LOC_1,LOC_2,LOC_3)
LOC_PTS1(i,j) = LOC_1
LOC_PTS2(i,j) = LOC_2
LOC_PTS3(i,j) = LOC_3
end do
end do
end program 3D
subroutine Coor_Trans(GLOB_PTSX1,GLOB_PTSY1,GLOB_PTSZ1,GLOB_PTSX2,GLOB_PTSY2,GLOB_PTSZ2,BETA,LOC_PTS1,LOC_PTS2,LOC_PTS3)
implicit none
real(kind=4), intent(in) :: GLOB_PTSX1,GLOB_PTSY1,GLOB_PTSZ1,GLOB_PTSX2,GLOB_PTSY2,GLOB_PTSZ2,BETA
real(kind=4), intent(out) :: LOC_PTS1,LOC_PTS2,LOC_PTS3
real, parameter :: pi = 4*atan(1.0)
real :: E1,E2
E1 = cos(BETA/180*pi)
E2 = sin(BETA/180*pi)
LOC_PTS1 = (GLOB_PTSX1-GLOB_PTSX2)*E1 + (GLOB_PTSY1-GLOB_PTSY2)*E2
LOC_PTS2 = (GLOB_PTSZ1-GLOB_PTSZ2)
LOC_PTS3 = -(GLOB_PTSX1-GLOB_PTSX2)*E2 + (GLOB_PTSY1-GLOB_PTSY2)*E1
!return
end subroutine Coor_Trans
The length of your call statement is too long. The default maximum width of a line is 132.
The compiler will truncate input lines at that width [as it did--and said so with the warning]. After that, you had an incomplete line (e.g. call foo(a,b that was missing the closing )) which generated the second warning message.
The best solution is to break up the long line with a continuation character, namely &:
call Coor_Trans(BEXC1(i,1,1),BEYC1(i,1,1),BEZC1(i,1,1), &
BEXC1(j,1,1),BEYC1(j,1,1),BEZC1(j,1,1), &
ANGLE1(j,1,1),LOC_1,LOC_2,LOC_3)
Most C-style guides recommend keeping lines at <= 80 chars. IMO, that's a good practice even with fortran.
Note, with GNU fortran, you can increase the limit with the -ffree-line-length-<n> command line option. So, you could try -ffree-line-length-512, but, I'd do the continuation above
Historical footnote: 132 columns was the maximum width that a high speed, chain driven, sprocket feed, fanfold paper, line printer could print.
The Fortran standard imposes a limit on the length of line that compilers are required to deal with, these days it's 132 characters. You can break the line at a suitable place and use a continuation line. Something like this:
call Coor_Trans(BEXC1(i,1,1),BEYC1(i,1,1),BEZC1(i,1,1),BEXC1(j,1,1), &
BEYC1(j,1,1),BEZC1(j,1,1),ANGLE1(j,1,1),LOC_1,LOC_2,LOC_3)
Notice the & at the end of the continued line.
Once the line is truncated arbitrarily it is syntactically erroneous, which explains the second part of your compiler's complaint.
Your compiler probably has an option to force it to read longer lines.
In my code:
DO i=1,numJog,1
IF(val(i) .EQV. .TRUE.)THEN
DO j=1,contVenc,1
result(j) = i
END DO
END IF
END DO
Where val is a logical array, and result is a integer array.
For example, if val is:
F
T
F
T
Then, i=2 and i=4.
But the result array just write 4 twice. For example:
DO i=1,contVenc,1
WRITE(*,*) result(i)
END DO
The result is:
4
4
Instead of
2
4
If I make some changes in my code like:
DO i=1,numJog,1
IF(val(i) .EQV. .TRUE.)THEN
WRITE(*,*) i
END IF
END DO
The result is:
2
4
As I wanted.
Conclusion, I think this second loop is causing this problem.
Yes, your second loop is at fault here. You haven't said what contVenc is, but it crucially doesn't change at any point in the fragment you have there. That just means that the same elements of result are being assigned to whenever you have a .TRUE. in val.
In your case they are both set to 2 for the first .TRUE. and are then both set to 4 for the second.
You are more likely to mean something like (with extra tidying):
j = 0
DO i=1,numJog
IF (val(i)) THEN
j = j+1 ! Test this as a bound
result(j) = i
END IF
END DO
But then, I'd just use PACK. Your intended loop has the same effect as
result(1:COUNT(val(1:numJog))) = PACK([(i,i=1,numJog)], val(1:numJog))
Again hoping that result is large enough.
That said, if numJog is just the size of the array val (that is, you aren't just doing this on a sub-array) then, as High Performance Mark comments,
result(1:COUNT(val)) = PACK([(i,i=1,SIZE(val))], val)
avoids tracking this size separately.
Finally, with result an allocatable (Fortran 2003) array you needn't even (but still can) worry about counting the number of wanted indices and that the array is sufficiently large:
result = PACK([(i,i=1,SIZE(val))], val)
I want to write something like :
b=0e0
do j=1,n
b(j,j) = f(x)*real(j)
end do
in an impicit way like, say
b=0e0
(b(j,j)=f(x)*real(j),j=1,n)
which isn't working. If the r.h.s. of the expression doesn't depend on j, I can of course do this:
b=0e0
c([(k,k=1,n*n,n+1)])=f(x)
b=reshape(c,shape(b))
but I'd love to have a more elegant and flexible one lined way, like a FORALL statement, e.g.
b=0e0
FORALL (j=1:n) b(j,j)=f(x)*real(j)
, but this is unfortunately a bit too restricted for the case where I need it. For the purpose of initialization there is something called DATA statement, which so far also didn't help me.
Thanks in advance!
You can define a subroutine that sets the diagonal of a matrix to a vector, as shown below.
program xdiag
implicit none
integer, parameter :: n = 3
real :: xmat(n,n) = 0.0
integer :: i
call set_diag([1.0,4.0,9.0],xmat)
do i=1,n
print*,xmat(i,:)
end do
contains
subroutine set_diag(diag,xmat)
real, intent(in) :: diag(:)
real, intent(in out) :: xmat(:,:)
integer :: i,n
n = size(diag)
if (any(shape(xmat) /= n)) then
print*,"in set_diag, size(diag) =",size(diag)," shape(xmat)=",shape(xmat)," should all be equal, STOPPING"
stop
end if
forall (i=1:n) xmat(i,i) = diag(i)
end subroutine set_diag
end program xdiag
! output:
! 1. 0. 0.
! 0. 4. 0.
! 0. 0. 9.