Commit 78543e3c authored by Andreas Marek's avatar Andreas Marek

Error in "error handling"

It could happen that ELPA stopped with an error but an exit code "0"
was given, i.e. one could assume everything was fine when it was not!
Now each Fortran "stop" was replaced with "stop 1" to prevent this
parent 122c88bb
......@@ -77,7 +77,7 @@ module mod_check_for_gpu
if (.not.(success)) then
print *,"error in cuda_getdevicecount"
stop
stop 1
endif
! make sure that all nodes have the same number of GPU's, otherwise
......@@ -108,7 +108,7 @@ module mod_check_for_gpu
if (.not.(success)) then
print *,"Cannot set CudaDevice"
stop
stop 1
endif
if (wantDebugMessage) then
print '(3(a,i0))', 'MPI rank ', myid, ' uses GPU #', deviceNumber
......
......@@ -116,7 +116,7 @@
allocate(z_p(na,0:max_threads-1), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"merge_systems: error when allocating z_p "//errorMessage
stop
stop 1
endif
#endif
......@@ -581,19 +581,19 @@
allocate(ev(max_local_cols,MIN(max_strip,MAX(1,nqcols1))), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"merge_systems: error when allocating ev "//errorMessage
stop
stop 1
endif
allocate(qtmp1(MAX(1,l_rows),max_local_cols), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"merge_systems: error when allocating qtmp1 "//errorMessage
stop
stop 1
endif
allocate(qtmp2(MAX(1,l_rows),MIN(max_strip,MAX(1,nqcols1))), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"merge_systems: error when allocating qtmp2 "//errorMessage
stop
stop 1
endif
! if (useGPU) then
......@@ -777,7 +777,7 @@
deallocate(ev, qtmp1, qtmp2, stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"merge_systems: error when deallocating ev "//errorMessage
stop
stop 1
endif
endif
......@@ -785,7 +785,7 @@
deallocate(z_p, stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"merge_systems: error when deallocating z_p "//errorMessage
stop
stop 1
endif
#endif
......@@ -849,7 +849,7 @@
allocate(qtmp(l_rows,l_cols_out), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"resort_ev: error when allocating qtmp "//errorMessage
stop
stop 1
endif
nc = 0
......@@ -904,7 +904,7 @@
deallocate(qtmp, stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"resort_ev: error when deallocating qtmp "//errorMessage
stop
stop 1
endif
end subroutine resort_ev_&
&PRECISION
......
......@@ -106,7 +106,7 @@ subroutine solve_tridi_&
allocate(limits(0:np_cols), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"solve_tridi: error when allocating limits "//errorMessage
stop
stop 1
endif
limits(0) = 0
......@@ -157,7 +157,7 @@ subroutine solve_tridi_&
deallocate(limits, stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"solve_tridi: error when deallocating limits "//errorMessage
stop
stop 1
endif
call timer%stop("solve_tridi" // PRECISION_SUFFIX)
......@@ -171,13 +171,13 @@ subroutine solve_tridi_&
allocate(l_col(na), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"solve_tridi: error when allocating l_col "//errorMessage
stop
stop 1
endif
allocate(p_col(na), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"solve_tridi: error when allocating p_col "//errorMessage
stop
stop 1
endif
n = 0
......@@ -195,13 +195,13 @@ subroutine solve_tridi_&
allocate(l_col_bc(na), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"solve_tridi: error when allocating l_col_bc "//errorMessage
stop
stop 1
endif
allocate(p_col_bc(na), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"solve_tridi: error when allocating p_col_bc "//errorMessage
stop
stop 1
endif
p_col_bc(:) = -1
......@@ -230,7 +230,7 @@ subroutine solve_tridi_&
deallocate(limits,l_col,p_col,l_col_bc,p_col_bc, stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"solve_tridi: error when deallocating l_col "//errorMessage
stop
stop 1
endif
call timer%stop("solve_tridi" // PRECISION_SUFFIX)
......@@ -410,7 +410,7 @@ subroutine solve_tridi_&
allocate(limits(0:ndiv), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"solve_tridi_col: error when allocating limits "//errorMessage
stop
stop 1
endif
limits(0) = 0
......@@ -463,13 +463,13 @@ subroutine solve_tridi_&
allocate(qmat1(max_size,max_size), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"solve_tridi_col: error when allocating qmat1 "//errorMessage
stop
stop 1
endif
allocate(qmat2(max_size,max_size), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"solve_tridi_col: error when allocating qmat2 "//errorMessage
stop
stop 1
endif
qmat1 = 0 ! Make sure that all elements are defined
......@@ -519,7 +519,7 @@ subroutine solve_tridi_&
deallocate(qmat1, qmat2, stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"solve_tridi_col: error when deallocating qmat2 "//errorMessage
stop
stop 1
endif
endif
......@@ -529,7 +529,7 @@ subroutine solve_tridi_&
allocate(l_col(na), p_col_i(na), p_col_o(na), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"solve_tridi_col: error when allocating l_col "//errorMessage
stop
stop 1
endif
do i=1,na
......@@ -569,7 +569,7 @@ subroutine solve_tridi_&
deallocate(limits, l_col, p_col_i, p_col_o, stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"solve_tridi_col: error when deallocating l_col "//errorMessage
stop
stop 1
endif
call timer%stop("solve_tridi_col" // PRECISION_SUFFIX)
......@@ -611,7 +611,7 @@ subroutine solve_tridi_&
allocate(ds(nlen), es(nlen), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"solve_tridi_single: error when allocating ds "//errorMessage
stop
stop 1
endif
! Save d and e for the case that dstedc fails
......@@ -626,7 +626,7 @@ subroutine solve_tridi_&
allocate(work(lwork), iwork(liwork), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"solve_tridi_single: error when allocating work "//errorMessage
stop
stop 1
endif
call timer%start("blas")
call PRECISION_STEDC('I', nlen, d, e, q, ldq, work, lwork, iwork, liwork, info)
......@@ -657,7 +657,7 @@ subroutine solve_tridi_&
deallocate(work,iwork,ds,es, stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"solve_tridi_single: error when deallocating ds "//errorMessage
stop
stop 1
endif
! Check if eigenvalues are monotonically increasing
......@@ -680,7 +680,7 @@ subroutine solve_tridi_&
allocate(qtmp(nlen), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"solve_tridi_single: error when allocating qtmp "//errorMessage
stop
stop 1
endif
dtmp = d(i+1)
......@@ -698,7 +698,7 @@ subroutine solve_tridi_&
deallocate(qtmp, stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"solve_tridi_single: error when deallocating qtmp "//errorMessage
stop
stop 1
endif
endif
......
......@@ -506,7 +506,7 @@
print *,"trans_ev_&
&MATH_DATATYPE&
&: error when deallocating hvm "//errorMessage
stop
stop 1
endif
if (useGPU) then
......@@ -519,7 +519,7 @@
print *,"trans_ev_&
&MATH_DATATYPE&
&: error when deallocating hvm1 "//errorMessage
stop
stop 1
endif
!deallocate(q_dev, tmp_dev, hvm_dev, tmat_dev)
......
......@@ -949,7 +949,7 @@
#if COMPLEXCASE == 1
print *,"tridiag_complex: error when deallocating tmp "//errorMessage
#endif
stop
stop 1
endif
if (useGPU) then
......@@ -983,14 +983,14 @@
if (istat .ne. 0) then
print *,"tridiag_real: error when allocating tmp "//errorMessage
stop
stop 1
endif
#endif
#if COMPLEXCASE == 1
allocate(tmp_real(na), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"tridiag_complex: error when allocating tmp_real "//errorMessage
stop
stop 1
endif
#endif
......@@ -1024,14 +1024,14 @@
deallocate(tmp, stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"tridiag_real: error when deallocating tmp "//errorMessage
stop
stop 1
endif
#endif
#if COMPLEXCASE == 1
deallocate(tmp_real, stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"tridiag_complex: error when deallocating tmp_real "//errorMessage
stop
stop 1
endif
#endif
......
This diff is collapsed.
......@@ -109,7 +109,7 @@
cudaMemcpyDeviceToHost)
if (.not.(successCUDA)) then
print *,"pack_row_group_complex_gpu: error in cudaMemcpy"
stop
stop 1
endif
end subroutine
......@@ -136,7 +136,7 @@
cudaMemcpyHostToDevice)
if (.not.(successCUDA)) then
print *,"unpack_row_group_complex_gpu: error in cudaMemcpy"
stop
stop 1
endif
call launch_my_unpack_c_kernel_complex_&
&PRECISION&
......
......@@ -155,14 +155,14 @@
allocate(block_limits(0:n_pes), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"error allocating block_limits "//errorMessage
stop
stop 1
endif
call divide_band(nblocks_total, n_pes, block_limits)
allocate(block_limits2(0:n_pes), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"error allocating block_limits2 "//errorMessage
stop
stop 1
endif
call divide_band(nblocks_total2, n_pes, block_limits2)
......@@ -174,7 +174,7 @@
allocate(ireq_ab2(1:nblocks2), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"error allocating ireq_ab2 "//errorMessage
stop
stop 1
endif
#ifdef WITH_MPI
......@@ -422,14 +422,14 @@
! allocate(mpi_statuses(MPI_STATUS_SIZE,nblocks2), stat=istat, errmsg=errorMessage)
! if (istat .ne. 0) then
! print *,"error allocating mpi_statuses "//errorMessage
! stop
! stop 1
! endif
call mpi_waitall(nblocks2,ireq_ab2,MPI_STATUSES_IGNORE,mpierr)
! deallocate(mpi_statuses, stat=istat, errmsg=errorMessage)
! if (istat .ne. 0) then
! print *,"error deallocating mpi_statuses "//errorMessage
! stop
! stop 1
! endif
call mpi_barrier(communicator,mpierr)
......@@ -440,19 +440,19 @@
deallocate(block_limits, stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"error deallocating block_limits "//errorMessage
stop
stop 1
endif
deallocate(block_limits2, stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"error deallocating block_limits2 "//errorMessage
stop
stop 1
endif
deallocate(ireq_ab2, stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"error deallocating ireq_ab2 "//errorMessage
stop
stop 1
endif
call timer%stop("band_band_real" // PRECISION_SUFFIX)
......
......@@ -279,7 +279,7 @@
&_2stage_&
&PRECISION&
&" // ": error when allocating tmat "//errorMessage
stop
stop 1
endif
! Reduction full -> band
......@@ -315,7 +315,7 @@
&MATH_DATATYPE&
&_2stage_&
&PRECISION " // ": error when allocating e "//errorMessage
stop
stop 1
endif
ttt0 = MPI_Wtime()
......@@ -352,7 +352,7 @@
print *,"solve_evp_&
&MATH_DATATYPE&
&_2stage: error when allocating q_real"//errorMessage
stop
stop 1
endif
#endif
......@@ -383,7 +383,7 @@
print *,"solve_evp_&
&MATH_DATATYPE&
&_2stage: error when deallocating e "//errorMessage
stop
stop 1
endif
#if COMPLEXCASE == 1
......@@ -394,7 +394,7 @@
print *,"solve_evp_&
&MATH_DATATYPE&
&_2stage: error when deallocating q_real"//errorMessage
stop
stop 1
endif
#endif
! Backtransform stage 1
......@@ -425,7 +425,7 @@
&MATH_DATATYPE&
&_2stage_&
&PRECISION " // ": error when deallocating hh_trans "//errorMessage
stop
stop 1
endif
if(present(bandwidth)) then
......@@ -461,7 +461,7 @@
&MATH_DATATYPE&
_2stage_&
&PRECISION " // ": error when deallocating tmat"//errorMessage
stop
stop 1
endif
endif ! not present(bandwidth)
......
......@@ -197,7 +197,7 @@
print *,"tridiag_band_&
&MATH_DATATYPE&
&: error when allocating global_id "//errorMessage
stop
stop 1
endif
global_id(:,:) = 0
......@@ -209,7 +209,7 @@
print *,"tridiag_band_&
&MATH_DATATYPE&
&: error when allocating global_id_tmp "//errorMessage
stop
stop 1
endif
#endif
......@@ -225,7 +225,7 @@
print *,"tridiag_band_&
&MATH_DATATYPE&
&: error when deallocating global_id_tmp "//errorMessage
stop
stop 1
endif
#endif /* WITH_OPENMP */
call timer%stop("mpi_communication")
......@@ -242,7 +242,7 @@
print *,"tridiag_band_&
&MATH_DATATYPE&
&: error when allocating block_limits"//errorMessage
stop
stop 1
endif
call divide_band(nblocks_total, n_pes, block_limits)
......@@ -257,7 +257,7 @@
print *,"tridiag_band_&
&MATH_DATATYPE&
&: error when allocating ab"//errorMessage
stop
stop 1
endif
ab = 0 ! needed for lower half, the extra block should also be set to 0 for safety
......@@ -280,7 +280,7 @@
print *,"tridiag_band_&
&MATH_DATATYPE&
&: error when allocating limits"//errorMessage
stop
stop 1
endif
call determine_workload(na, nb, np_rows, limits)
......@@ -307,14 +307,14 @@
allocate(hh_trans_real(nb,num_hh_vecs), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"tridiag_band_real: error when allocating hh_trans_real"//errorMessage
stop
stop 1
endif
#endif
#if COMPLEXCASE == 1
allocate(hh_trans_complex(nb,num_hh_vecs), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"tridiag_band_complex: error when allocating hh_trans_comples "//errorMessage
stop
stop 1
endif
#endif
......@@ -325,14 +325,14 @@
print *,"tridiag_band_&
&MATH_DATATYPE&
&: error when allocating ireq_hhr"//errorMessage
stop
stop 1
endif
allocate(ireq_hhs(nblocks), stat=istat, errmsg=errorMessage) ! Send requests
if (istat .ne. 0) then
print *,"tridiag_band_&
&MATH_DATATYEP&
&: error when allocating ireq_hhs"//errorMessage
stop
stop 1
endif
num_hh_vecs = 0
......@@ -384,7 +384,7 @@
print *,"tridiag_band_&
&MATH_DATATYPE&
&: error when allocating hh_gath"//errorMessage
stop
stop 1
endif
allocate(hh_send(nb,max_blk_size,nblocks), stat=istat, errmsg=errorMessage) ! send buffer for HH vectors
......@@ -392,7 +392,7 @@
print *,"tridiag_band_&
&MATH_DATATYPE&
&: error when allocating hh_send"//errorMessage
stop
stop 1
endif
#if REALCASE == 1
......@@ -410,7 +410,7 @@
print *,"tridiag_band_&
&MATH_DATATYPE&
&: error when allocating hh_cnt"//errorMessage
stop
stop 1
endif
allocate(hh_dst(nblocks), stat=istat, errmsg=errorMessage)
......@@ -418,7 +418,7 @@
print *,"tridiag_band_&
&MATH_DATATYPE&
&: error when allocating hh_dst"//errorMessage
stop
stop 1
endif
hh_cnt(:) = 1 ! The first transfomation vector is always 0 and not calculated at all
......@@ -434,7 +434,7 @@
print *,"tridiag_band_&
&MATH_DATATYPE&
&: error when allocating snd_limits"//errorMessage
stop
stop 1
endif
do iblk=1,nblocks
call determine_workload(na-(iblk+block_limits(my_pe)-1)*nb, nb, np_rows, snd_limits(:,iblk))
......@@ -459,7 +459,7 @@
print *,"tridiag_band_&
&MATH_DATATYPE&
&: error when allocating omp_block_limits"//errorMessage
stop
stop 1
endif
! Get the OpenMP block limits
......@@ -470,7 +470,7 @@
print *,"tridiag_band_&
&MATH_DATATYPE&
&: error when allocating hv_t, tau_t"//errorMessage
stop
stop 1
endif
#if REALCASE == 1
......@@ -1386,7 +1386,7 @@
! allocate(mpi_statuses(MPI_STATUS_SIZE,max(nblocks,num_chunks)), stat=istat, errmsg=errorMessage)
! if (istat .ne. 0) then
! print *,"tridiag_band_real: error when allocating mpi_statuses"//errorMessage
! stop
! stop 1
! endif
call mpi_waitall(nblocks, ireq_hhs, MPI_STATUSES_IGNORE, mpierr)
......@@ -1394,7 +1394,7 @@
! deallocate(mpi_statuses, stat=istat, errmsg=errorMessage)
! if (istat .ne. 0) then
! print *,"tridiag_band_real: error when deallocating mpi_statuses"//errorMessage
! stop
! stop 1
! endif
call timer%stop("mpi_communication")
#endif /* WITH_MPI */
......@@ -1423,7 +1423,7 @@
print *,"tridiag_band_&
&MATH_DATATYPE&
&: error when deallocating ab"//errorMessage
stop
stop 1
endif
deallocate(ireq_hhr, ireq_hhs, stat=istat, errmsg=errorMessage)
......@@ -1431,7 +1431,7 @@
print *,"tridiag_band_&
&MATH_DATATYPE&
&: error when deallocating ireq_hhr, ireq_hhs"//errorMessage
stop
stop 1
endif
deallocate(hh_cnt, hh_dst, stat=istat, errmsg=errorMessage)
......@@ -1439,7 +1439,7 @@
print *,"tridiag_band_&
&MATH_DATATYPE&
&: error when deallocating hh_cnt, hh_dst"//errorMessage
stop
stop 1
endif
deallocate(hh_gath, hh_send, stat=istat, errmsg=errorMessage)
......@@ -1447,7 +1447,7 @@
print *,"tridiag_band_&
&MATH_DATATYPE&
&: error when deallocating hh_gath, hh_send"//errorMessage
stop
stop 1
endif
deallocate(limits, snd_limits, stat=istat, errmsg=errorMessage)
......@@ -1455,7 +1455,7 @@
print *,"tridiag_band_&
&MATH_DATATYPE&
&: error when deallocating limits, send_limits"//errorMessage
stop
stop 1
endif
deallocate(block_limits, stat=istat, errmsg=errorMessage)
......@@ -1463,7 +1463,7 @@
print *,"tridiag_band_&
&MATH_DATATYPE&
&: error when deallocating block_limits"//errorMessage
stop
stop 1
endif
deallocate(global_id, stat=istat, errmsg=errorMessage)
......@@ -1471,7 +1471,7 @@
print *,"tridiag_band_&
&MATH_DATATYPE&
&: error when allocating global_id"//errorMessage
stop
stop 1
endif
call timer%stop("tridiag_band_&
......
......@@ -704,7 +704,7 @@ module ELPA2_utilities
!#ifdef WITH_GPU_VERSION
! if (actual_kernel .ne. REAL_ELPA_KERNEL_GPU) then
! print *,"if build with GPU you cannot choose another real kernel"
! stop
! stop 1
! endif
!#endif
......@@ -765,7 +765,7 @@ module ELPA2_utilities
!#ifdef WITH_GPU_VERSION
! if (actual_kernel .ne. COMPLEX_ELPA_KERNEL_GPU) then
! print *,"if build with GPU you cannot choose another complex kernel"
! stop
! stop 1
! endif
!#endif
......
......@@ -71,7 +71,7 @@
if (istat .ne. 0) then
print *,"elpa_cholesky_&
&MATH_DATATYPE&: error when allocating tmp1 "//errorMessage
stop
stop 1
endif
allocate(tmp2(nblk,nblk), stat=istat, errmsg=errorMessage)
......@@ -79,7 +79,7 @@
print *,"elpa_cholesky_&
&MATH_DATATYPE&
&: error when allocating tmp2 "//errorMessage
stop
stop 1
endif
tmp1 = 0
......@@ -90,7 +90,7 @@
print *,"elpa_cholesky_&
&MATH_DATATYPE&
&: error when allocating tmatr "//errorMessage
stop
stop 1
endif
allocate(tmatc(l_cols,nblk), stat=istat, errmsg=errorMessage)
......@@ -98,7 +98,7 @@
print *,"elpa_cholesky_&
&MATH_DATATYPE&
&: error when allocating tmatc "//errorMessage
stop
stop 1
endif
tmatr = 0
......@@ -277,7 +277,7 @@
print *,"elpa_cholesky_&
&MATH_DATATYPE&
&: error when deallocating tmp1 "//errorMessage
stop
stop 1
endif
! Set the lower triangle to 0, it contains garbage (form the above matrix multiplications)
......
......@@ -58,7 +58,7 @@
print *,"elpa_invert_trm_&
&MATH_DATATYPE&
&: error when allocating tmp1 "//errorMessage
stop
stop 1
endif
allocate(tmp2(nblk,nblk), stat=istat, errmsg=errorMessage)
......@@ -66,7 +66,7 @@
print *,"elpa_invert_trm_&