I am trying to allocate an array of a derived type in a subroutine after I read in the size of the array from a file, but it fails in read_grid()
when calling allocate()
. It could be something silly I have not noticed, but I have been looking at this for a while now.
The derived type itself has some allocatable arrays of reals, maybe that is the issue? But then how do I initialise the array without knowing its size ahead of time?
The code in question (simplified with only the relevant bits)
program solver
use types
implicit none
type(t_grid), allocatable, dimension(:) :: g
call read_grid(g)
! continue with program
end program myprogram
and read_grid.f90
has the following:
subroutine read_grid(g)
use types
implicit none
type(t_grid), allocatable, intent(out) :: g(:)
integer :: n, no_grids, ni, nj
! file IO happens here, this works fine
read(2) no_grids
write(6,*) ' Number of grids ', no_grids
! no_grids gets read in fine
! **** THIS IS WHERE SIGSEGV happens
allocate(g(no_grids))
do n = 1,no_grids
! Allocate arrays in current element of g and read in values
read(2) ni, nj
g(n)%ni = ni; g(n)%nj = nj;
write(6,*) ' Size of grid', n, 'ni =', ni, 'nj =', nj
! Allocate and then read the coordinates
allocate(g(n)%x(ni,nj),g(n)%y(ni,nj))
read(2) g(n)%x; read(2) g(n)%y;
! ... and so on with reading in everything else
end do
close(2)
write(6,*)
end subroutine read_grid
and the t_grid
is defined as such in types.f90
module types
type t_grid
integer :: ni, nj
real, dimension(:,:), allocatable :: x, y
! and lots of other 2D arrays
end type t_grid
end module types
The actual error after compiling with gfortran
is āProgram received signal SIGSEGV: Segmentation fault - invalid memory reference.ā and the backtrace points to the marked line read_grid.f90
.
When building with -fcheck=all
the error becomes: āFortran runtime error: Allocatable actual argument āgā is not allocatedā pointing to call read_grid()
but I thought it was fine to allocate arrays in subroutines?
I am using gfortran 13.2.1 with flags -g -fbacktrace -fcheck=all
Iām a bit new to using Fortran so any help is very much appreciated, and let me know if you need any other information.