Skip to content

Commit

Permalink
automatically added checking of the return value of all allocate() st…
Browse files Browse the repository at this point in the history 
…atements in the code; added this using a Perl script; the script added a total of 2431 checking statements
  • Loading branch information
@komatits
komatits committed Jun 16, 2018
1 parent 70954a5 commit b0e6799
Show file tree
Hide file tree
Showing 130 changed files with 4,356 additions and 1,489 deletions.
46 changes: 39 additions & 7 deletions src/auxiliaries/combine_surf_data.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -164,12 +164,18 @@ program combine_surf_data
nglob = NGLOB_AB

! allocates arrays
allocate(ibool(NGLLX,NGLLY,NGLLZ,NSPEC_AB))
allocate(mask_ibool(NGLOB_AB))
allocate(num_ibool(NGLOB_AB))
allocate(xstore(NGLOB_AB))
allocate(ystore(NGLOB_AB))
allocate(ibool(NGLLX,NGLLY,NGLLZ,NSPEC_AB),stat=ier)
if (ier /= 0) call my_local_exit_MPI_without_rank('error allocating array 1107')
allocate(mask_ibool(NGLOB_AB),stat=ier)
if (ier /= 0) call my_local_exit_MPI_without_rank('error allocating array 1108')
allocate(num_ibool(NGLOB_AB),stat=ier)
if (ier /= 0) call my_local_exit_MPI_without_rank('error allocating array 1109')
allocate(xstore(NGLOB_AB),stat=ier)
if (ier /= 0) call my_local_exit_MPI_without_rank('error allocating array 1110')
allocate(ystore(NGLOB_AB),stat=ier)
if (ier /= 0) call my_local_exit_MPI_without_rank('error allocating array 1111')
allocate(zstore(NGLOB_AB),stat=ier)
if (ier /= 0) call my_local_exit_MPI_without_rank('error allocating array 1112')
if (ier /= 0) stop 'error allocating array ibool etc.'

! surface file
Expand All @@ -185,6 +191,7 @@ program combine_surf_data

if (it == 1) then
allocate(ibelm_surf(nspec_surf),stat=ier)
if (ier /= 0) call my_local_exit_MPI_without_rank('error allocating array 1113')
if (ier /= 0) stop 'error allocating array ibelm_surf'
endif
read(28) ibelm_surf
Expand All @@ -194,9 +201,11 @@ program combine_surf_data
if (it == 1) then
if (FILE_ARRAY_IS_3D) then
allocate(data_3D(NGLLX,NGLLY,NGLLZ,NSPEC_AB),dat3D(NGLLX,NGLLY,NGLLZ,NSPEC_AB),stat=ier)
if (ier /= 0) call my_local_exit_MPI_without_rank('error allocating array 1114')
if (ier /= 0) stop 'error allocating array data_3D'
else
allocate(data_2D(NGLLX,NGLLY,nspec_surf),dat2D(NGLLX,NGLLY,nspec_surf),stat=ier)
if (ier /= 0) call my_local_exit_MPI_without_rank('error allocating array 1115')
if (ier /= 0) stop 'error allocating array data_2D'
endif
endif
Expand Down Expand Up @@ -325,9 +334,12 @@ program combine_surf_data
nglob = NGLOB_AB

! allocates arrays
allocate(ibool(NGLLX,NGLLY,NGLLZ,NSPEC_AB))
allocate(mask_ibool(NGLOB_AB))
allocate(ibool(NGLLX,NGLLY,NGLLZ,NSPEC_AB),stat=ier)
if (ier /= 0) call my_local_exit_MPI_without_rank('error allocating array 1116')
allocate(mask_ibool(NGLOB_AB),stat=ier)
if (ier /= 0) call my_local_exit_MPI_without_rank('error allocating array 1117')
allocate(num_ibool(NGLOB_AB),stat=ier)
if (ier /= 0) call my_local_exit_MPI_without_rank('error allocating array 1118')
if (ier /= 0) stop 'error allocating array ibool etc.'


Expand Down Expand Up @@ -413,3 +425,23 @@ program combine_surf_data

end program combine_surf_data

!
!-------------------------------------------------------------------------------------------------
!

! version without rank number printed in the error message

subroutine my_local_exit_MPI_without_rank(error_msg)

implicit none

character(len=*) error_msg

! write error message to screen
write(*,*) error_msg(1:len(error_msg))
write(*,*) 'Error detected, aborting MPI...'

stop 'Fatal error'

end subroutine my_local_exit_MPI_without_rank

39 changes: 37 additions & 2 deletions src/auxiliaries/combine_vol_data.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -172,8 +172,10 @@ program combine_vol_data

! ibool and global point arrays file
allocate(ibool(NGLLX,NGLLY,NGLLZ,NSPEC_AB),stat=ier)
if (ier /= 0) call my_local_exit_MPI_without_rank('error allocating array 1141')
if (ier /= 0) stop 'error allocating array ibool'
allocate(xstore(NGLOB_AB),ystore(NGLOB_AB),zstore(NGLOB_AB),stat=ier)
if (ier /= 0) call my_local_exit_MPI_without_rank('error allocating array 1142')
if (ier /= 0) stop 'error allocating array xstore etc.'

if (ADIOS_FOR_MESH) then
Expand All @@ -192,10 +194,12 @@ program combine_vol_data


allocate(data_sp(NGLLX,NGLLY,NGLLZ,NSPEC_AB),stat=ier)
if (ier /= 0) call my_local_exit_MPI_without_rank('error allocating array 1143')
if (ier /= 0) stop 'error allocating single precision data array'

if (CUSTOM_REAL == SIZE_DOUBLE) then
allocate(data_dp(NGLLX,NGLLY,NGLLZ,NSPEC_AB),stat=ier)
if (ier /= 0) call my_local_exit_MPI_without_rank('error allocating array 1144')
if (ier /= 0) stop 'error allocating double precision data array'
endif

Expand Down Expand Up @@ -287,6 +291,7 @@ program combine_vol_data

! ibool file
allocate(ibool(NGLLX,NGLLY,NGLLZ,NSPEC_AB),stat=ier)
if (ier /= 0) call my_local_exit_MPI_without_rank('error allocating array 1145')

if (ADIOS_FOR_MESH) then
call read_ibool_adios_mesh(mesh_handle, ibool_offset, &
Expand Down Expand Up @@ -444,6 +449,7 @@ subroutine cvd_count_totals_ext_mesh(num_node,node_list,LOCAL_PATH, &
! gets ibool
if (.not. HIGH_RESOLUTION_MESH) then
allocate(ibool(NGLLX,NGLLY,NGLLZ,NSPEC_AB),stat=ier)
if (ier /= 0) call my_local_exit_MPI_without_rank('error allocating array 1146')
if (ier /= 0) stop 'error allocating array ibool'

if (ADIOS_FOR_MESH) then
Expand Down Expand Up @@ -472,6 +478,7 @@ subroutine cvd_count_totals_ext_mesh(num_node,node_list,LOCAL_PATH, &

! mark element corners (global AVS or DX points)
allocate(mask_ibool(NGLOB_AB),stat=ier)
if (ier /= 0) call my_local_exit_MPI_without_rank('error allocating array 1147')
if (ier /= 0) stop 'error allocating array mask_ibool'
mask_ibool = .false.
do ispec=1,NSPEC_AB
Expand Down Expand Up @@ -541,6 +548,7 @@ subroutine cvd_write_corners(NSPEC_AB,NGLOB_AB,ibool,xstore,ystore,zstore,dat, &
write(IOVTK, '(a,i12,a)') 'POINTS ', npp, ' float'
! creates array to hold point data
allocate(total_dat(npp),stat=ier)
if (ier /= 0) call my_local_exit_MPI_without_rank('error allocating array 1148')
if (ier /= 0) stop 'error allocating total dat array'
total_dat(:) = 0.0
#else
Expand All @@ -552,6 +560,7 @@ subroutine cvd_write_corners(NSPEC_AB,NGLOB_AB,ibool,xstore,ystore,zstore,dat, &

! writes our corner point locations
allocate(mask_ibool(NGLOB_AB),stat=ier)
if (ier /= 0) call my_local_exit_MPI_without_rank('error allocating array 1149')
if (ier /= 0) stop 'error allocating array mask_ibool'
mask_ibool(:) = .false.
numpoin = 0
Expand Down Expand Up @@ -733,6 +742,7 @@ subroutine cvd_write_GLL_points(NSPEC_AB,NGLOB_AB,ibool,xstore,ystore,zstore,dat
write(IOVTK, '(a,i12,a)') 'POINTS ', npp, ' float'
! creates array to hold point data
allocate(total_dat(npp),stat=ier)
if (ier /= 0) call my_local_exit_MPI_without_rank('error allocating array 1150')
if (ier /= 0) stop 'error allocating total dat array'
total_dat(:) = 0.0
#else
Expand All @@ -744,6 +754,7 @@ subroutine cvd_write_GLL_points(NSPEC_AB,NGLOB_AB,ibool,xstore,ystore,zstore,dat

! writes out point locations and values
allocate(mask_ibool(NGLOB_AB),stat=ier)
if (ier /= 0) call my_local_exit_MPI_without_rank('error allocating array 1151')
if (ier /= 0) stop 'error allocating array mask_ibool'

mask_ibool(:) = .false.
Expand Down Expand Up @@ -811,8 +822,10 @@ subroutine cvd_write_corner_elements(NSPEC_AB,NGLOB_AB,ibool, &
endif

! writes out element indices
allocate(mask_ibool(NGLOB_AB))
allocate(mask_ibool(NGLOB_AB),stat=ier)
if (ier /= 0) call my_local_exit_MPI_without_rank('error allocating array 1152')
allocate(num_ibool(NGLOB_AB),stat=ier)
if (ier /= 0) call my_local_exit_MPI_without_rank('error allocating array 1153')
if (ier /= 0) stop 'error allocating array mask_ibool'

mask_ibool(:) = .false.
Expand Down Expand Up @@ -941,8 +954,10 @@ subroutine cvd_write_GLL_elements(NSPEC_AB,NGLOB_AB,ibool, &
endif

! sets numbering num_ibool respecting mask
allocate(mask_ibool(NGLOB_AB))
allocate(mask_ibool(NGLOB_AB),stat=ier)
if (ier /= 0) call my_local_exit_MPI_without_rank('error allocating array 1154')
allocate(num_ibool(NGLOB_AB),stat=ier)
if (ier /= 0) call my_local_exit_MPI_without_rank('error allocating array 1155')
if (ier /= 0) stop 'error allocating array mask_ibool'

mask_ibool(:) = .false.
Expand Down Expand Up @@ -1010,3 +1025,23 @@ subroutine cvd_write_GLL_elements(NSPEC_AB,NGLOB_AB,ibool, &

end subroutine cvd_write_GLL_elements

!
!-------------------------------------------------------------------------------------------------
!

! version without rank number printed in the error message

subroutine my_local_exit_MPI_without_rank(error_msg)

implicit none

character(len=*) error_msg

! write error message to screen
write(*,*) error_msg(1:len(error_msg))
write(*,*) 'Error detected, aborting MPI...'

stop 'Fatal error'

end subroutine my_local_exit_MPI_without_rank

28 changes: 23 additions & 5 deletions src/auxiliaries/combine_vol_data_vtk_binary.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -119,7 +119,8 @@ program combine_vol_data
! writes point and scalar information
! loops over slices (process partitions)
np = 0
allocate(pts(3*npp))
allocate(pts(3*npp),stat=ier)
if (ier /= 0) call exit_MPI_without_rank('error allocating array 1156')
do it = 1, num_node

iproc = node_list(it)
Expand All @@ -134,8 +135,10 @@ program combine_vol_data

! ibool and global point arrays file
allocate(ibool(NGLLX,NGLLY,NGLLZ,NSPEC_AB),stat=ier)
if (ier /= 0) call exit_MPI_without_rank('error allocating array 1157')
if (ier /= 0) stop 'error allocating array ibool'
allocate(xstore(NGLOB_AB),ystore(NGLOB_AB),zstore(NGLOB_AB),stat=ier)
if (ier /= 0) call exit_MPI_without_rank('error allocating array 1158')
if (ier /= 0) stop 'error allocating array xstore etc.'

read(27) NSPEC_IRREGULAR
Expand All @@ -146,10 +149,12 @@ program combine_vol_data
close(27)

allocate(data_sp(NGLLX,NGLLY,NGLLZ,NSPEC_AB),stat=ier)
if (ier /= 0) call exit_MPI_without_rank('error allocating array 1159')
if (ier /= 0) stop 'error allocating single precision data array'

if (CUSTOM_REAL == SIZE_DOUBLE) then
allocate(data_dp(NGLLX,NGLLY,NGLLZ,NSPEC_AB),stat=ier)
if (ier /= 0) call exit_MPI_without_rank('error allocating array 1160')
if (ier /= 0) stop 'error allocating double precision data array'
endif

Expand Down Expand Up @@ -208,7 +213,8 @@ program combine_vol_data
ne = 0
np = 0

allocate(conn(8,nee))
allocate(conn(8,nee),stat=ier)
if (ier /= 0) call exit_MPI_without_rank('error allocating array 1161')

do it = 1, num_node

Expand All @@ -225,6 +231,7 @@ program combine_vol_data
read(27) NGLOB_AB
! ibool file
allocate(ibool(NGLLX,NGLLY,NGLLZ,NSPEC_AB),stat=ier)
if (ier /= 0) call exit_MPI_without_rank('error allocating array 1162')
if (ier /= 0) stop 'error allocating array ibool'
read(27) NSPEC_IRREGULAR
read(27) ibool
Expand Down Expand Up @@ -257,7 +264,8 @@ program combine_vol_data
endif
print *, 'Total number of elements: ', ne

allocate(celltype(nee))
allocate(celltype(nee),stat=ier)
if (ier /= 0) call exit_MPI_without_rank('error allocating array 1163')
celltype=12

call write_unstructured_mesh(mesh_file,len_trim(mesh_file), 1, npp, pts, nee, celltype, conn, &
Expand Down Expand Up @@ -322,6 +330,7 @@ subroutine cvd_count_totals_ext_mesh(num_node,node_list,LOCAL_PATH, &
! gets ibool
if (.not. HIGH_RESOLUTION_MESH) then
allocate(ibool(NGLLX,NGLLY,NGLLZ,NSPEC_AB),stat=ier)
if (ier /= 0) call exit_MPI_without_rank('error allocating array 1164')
if (ier /= 0) stop 'error allocating array ibool'
read(27) NSPEC_IRREGULAR
read(27) ibool
Expand All @@ -344,6 +353,7 @@ subroutine cvd_count_totals_ext_mesh(num_node,node_list,LOCAL_PATH, &

! mark element corners (global AVS or DX points)
allocate(mask_ibool(NGLOB_AB),stat=ier)
if (ier /= 0) call exit_MPI_without_rank('error allocating array 1165')
if (ier /= 0) stop 'error allocating array mask_ibool'
mask_ibool = .false.
do ispec=1,NSPEC_AB
Expand Down Expand Up @@ -410,13 +420,15 @@ subroutine cvd_write_corners(NSPEC_AB,NGLOB_AB,ibool,xstore,ystore,zstore,dat, &
! writes out total number of points
if (it == 1) then
allocate(total_dat(npp),stat=ier)
if (ier /= 0) call exit_MPI_without_rank('error allocating array 1166')
if (ier /= 0) stop 'error allocating total dat array'
total_dat(:) = 0.0

endif

! writes our corner point locations
allocate(mask_ibool(NGLOB_AB),stat=ier)
if (ier /= 0) call exit_MPI_without_rank('error allocating array 1167')
if (ier /= 0) stop 'error allocating array mask_ibool'
mask_ibool(:) = .false.
numpoin = 0
Expand Down Expand Up @@ -562,13 +574,15 @@ subroutine cvd_write_GLL_points(NSPEC_AB,NGLOB_AB,ibool,xstore,ystore,zstore,dat
! writes out total number of points
if (it == 1) then
allocate(total_dat(npp),stat=ier)
if (ier /= 0) call exit_MPI_without_rank('error allocating array 1168')
if (ier /= 0) stop 'error allocating total dat array'
total_dat(:) = 0.0

endif

! writes out point locations and values
allocate(mask_ibool(NGLOB_AB),stat=ier)
if (ier /= 0) call exit_MPI_without_rank('error allocating array 1169')
if (ier /= 0) stop 'error allocating array mask_ibool'

mask_ibool(:) = .false.
Expand Down Expand Up @@ -629,8 +643,10 @@ subroutine cvd_write_corner_elements(NSPEC_AB,NGLOB_AB,ibool, &
endif

! writes out element indices
allocate(mask_ibool(NGLOB_AB))
allocate(mask_ibool(NGLOB_AB),stat=ier)
if (ier /= 0) call exit_MPI_without_rank('error allocating array 1170')
allocate(num_ibool(NGLOB_AB),stat=ier)
if (ier /= 0) call exit_MPI_without_rank('error allocating array 1171')
if (ier /= 0) stop 'error allocating array mask_ibool'

mask_ibool(:) = .false.
Expand Down Expand Up @@ -740,8 +756,10 @@ subroutine cvd_write_GLL_elements(NSPEC_AB,NGLOB_AB,ibool, &
endif

! sets numbering num_ibool respecting mask
allocate(mask_ibool(NGLOB_AB))
allocate(mask_ibool(NGLOB_AB),stat=ier)
if (ier /= 0) call exit_MPI_without_rank('error allocating array 1172')
allocate(num_ibool(NGLOB_AB),stat=ier)
if (ier /= 0) call exit_MPI_without_rank('error allocating array 1173')
if (ier /= 0) stop 'error allocating array mask_ibool'

mask_ibool(:) = .false.
Expand Down
25 changes: 23 additions & 2 deletions src/auxiliaries/convolve_source_timefunction.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -39,7 +39,7 @@ program convolve_source_time_function

implicit none

integer :: i,j,N_j,number_remove,nlines
integer :: i,j,N_j,number_remove,nlines,ier

double precision :: alpha,dt,tau_j,source,exponentval,t1,t2,displ1,displ2,gamma,height,half_duration_triangle

Expand All @@ -55,7 +55,8 @@ program convolve_source_time_function
close(33)

! allocate arrays
allocate(timeval(nlines),sem(nlines),sem_fil(nlines))
allocate(timeval(nlines),sem(nlines),sem_fil(nlines),stat=ier)
if (ier /= 0) call my_local_exit_MPI_without_rank('error allocating array 1181')

! read the input seismogram
do i = 1,nlines
Expand Down Expand Up @@ -133,3 +134,23 @@ program convolve_source_time_function

end program convolve_source_time_function

!
!-------------------------------------------------------------------------------------------------
!

! version without rank number printed in the error message

subroutine my_local_exit_MPI_without_rank(error_msg)

implicit none

character(len=*) error_msg

! write error message to screen
write(*,*) error_msg(1:len(error_msg))
write(*,*) 'Error detected, aborting MPI...'

stop 'Fatal error'

end subroutine my_local_exit_MPI_without_rank

Loading

0 comments on commit b0e6799

Please sign in to comment.