We are developing a solver based on several structured grids which are connected.
For this reason some information is needed only in grid boundaries (face edges vertex).
To reduce the memory consumed we decided to the following structure:
TYPE single_neigh INTEGER :: num1, num2, num3 INTEGER, allocatable, dimension(:) :: dirface contains procedure, public :: init procedure, public :: zeroing procedure, public :: getBlocAndIndexes END TYPE TYPE neigh_type INTEGER :: nb TYPE(single_neigh), ALLOCATABLE, DIMENSION(:) :: list contains procedure, public :: allocate_zero procedure, public :: change_size_keeping_data procedure, public :: check_size_type procedure, public :: copy_val END TYPE neigh_type
Then we define a new type “neigh_type” with the neighborhood for each point
TYPE typebloc… TYPE(neigh_type), allocatable, dimension(:,:,:) :: PointsNeighs ! for all grid points END TYPE typebloc
Which is allocated with
ALLOCATE(bloc_init(b1)%PointsNeighs(nx,ny,nz))
for the whole 3D grid, but only for the indices (ix, iy,iz) when information is needed
bloc_init(b)%PointsNeighs(ix,iy,iz)%list is updated using some “object oriented” procedure (change_size_keeping_data or allocate_zero).
The code then is something like this:
DO b = 1, number_of_grids DO iz = iz_min, iz_max DO iy = iy_min, iy_max DO ix = ix_min, ix_max ind = 0 IF (bloc_init(b)%PointsNeighs(ix,iy,iz)%nb>0) THEN DO n = 1, bloc_init(b)%PointsNeighs(ix,iy,iz)%nb !!WRITE(*,*)bloc_init(b)%PointsNeighs(iu,iv,iw)%list(n)%point_type IF(bloc_init(b)%PointsNeighs(ix,iy,iz)%list(n)%num1 .EQ. (ind_edge)) THEN ind = ind + 1 END IF END DO END IF END DO END DO END DO END DO
The code works fine with Intel(R) Visual Fortran Composer XE 2013 SP1 Update 1 Integration for Microsoft Visual Studio* 2010, 14.0.0074.201
However with the compiler “composer_xe_2015.3.187“ in Linux the code works well in debug (O0) and O1 but fails in 02 and more complex release configurations with the error : forrtl: severe (174): SIGSEGV, segmentation fault occurred
Our tests show that the problem is in the last IF (line 09). If we uncomment the WRITE(*,*) in line 08 the code works. It seems then that the code does not “take the time” to access …%list(n)
A corollary of this question is the efficiency of this program. The array list is deallocated and reallocated each time its size change, is it then contiguous in memory? Are they some other issues?