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

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
......
......@@ -276,7 +276,7 @@
print *,"bandred_&
&MATH_DATATYPE&
&: error in cudaMalloc"
stop
stop 1
endif
successCUDA = cuda_malloc(tmat_dev, nbw*nbw* size_of_datatype)
......@@ -284,7 +284,7 @@
print *,"bandred_&
&MATH_DATATYPE&
&: error in cudaMalloc"
stop
stop 1
endif
successCUDA = cuda_malloc(vav_dev, nbw*nbw* size_of_datatype)
......@@ -292,7 +292,7 @@
print *,"bandred_&
&MATH_DATATYPE&
&: error in cudaMalloc"
stop
stop 1
endif
endif ! useGPU
......@@ -309,7 +309,7 @@
if (useGPU) then
print *,"qr decomposition at the moment not supported with GPU"
stop
stop 1
endif
if (which_qr_decomposition == 1) then
......@@ -317,20 +317,20 @@
allocate(tauvector(na), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"bandred_real: error when allocating tauvector "//errorMessage
stop
stop 1
endif
allocate(blockheuristic(nblk), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"bandred_real: error when allocating blockheuristic "//errorMessage
stop
stop 1
endif
l_rows = local_index(na, my_prow, np_rows, nblk, -1)
allocate(vmrCPU(max(l_rows,1),na), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"bandred_real: error when allocating vmrCPU "//errorMessage
stop
stop 1
endif
vmrCols = na
......@@ -355,13 +355,13 @@
allocate(work_blocked(work_size), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"bandred_real: error when allocating work_blocked "//errorMessage
stop
stop 1
endif
work_blocked = CONST_0_0
deallocate(vmrCPU, stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"bandred_real: error when deallocating vmrCPU "//errorMessage
stop
stop 1
endif
endif ! which_qr_decomposition
......@@ -379,7 +379,7 @@
print *,"bandred_&
&MATH_DATATYPE&
&: error in cudaMemcpy"
stop
stop 1
endif
endif ! useGPU
......@@ -410,7 +410,7 @@
print *,"bandred_&
&MATH_DATATYPE&
&: error when deallocating vr "//errorMessage
stop
stop 1
endif
endif
allocate(vr(l_rows + 1), stat=istat, errmsg=errorMessage)
......@@ -418,7 +418,7 @@
print *,"bandred_&
&MATH_DATATYPE&
&: error when allocating vr "//errorMessage
stop
stop 1
endif
endif
......@@ -430,14 +430,14 @@
print *,"bandred_&
&MATH_DATATYPE&
&: error when allocating vmrCUDA "//errorMessage
stop
stop 1
endif
successCUDA = cuda_free(vmr_dev)
if (.not.(successCUDA)) then
print *,"bandred_&
&MATH_DATATYPE&: error in cuda_free"
stop
stop 1
endif
endif
......@@ -451,14 +451,14 @@
print *,"bandred_&
&MATH_DATATYPE&
&: error when allocating vmrCUDA "//errorMessage
stop
stop 1
endif
successCUDA = cuda_malloc(vmr_dev, vmr_size* size_of_datatype)
if (.not.(successCUDA)) then
print *,"bandred_&
&MATH_DATATYPE&
&: error in cudaMalloc: vmr_dev"
stop
stop 1
endif
endif
......@@ -470,7 +470,7 @@
print *,"bandred_&
&MATH_DATATYPE&
&: error when deallocating umcCUDA "//errorMessage
stop
stop 1
endif
successCUDA = cuda_free(umc_dev)
......@@ -478,7 +478,7 @@
print *,"bandred_&
&MATH_DATATYPE&
&: error in cudaFree umc_dev"
stop
stop 1
endif
endif
......@@ -493,7 +493,7 @@
print *,"bandred_&
&MATH_DATATYPE&
&: error when deallocating umcCUDA "//errorMessage
stop
stop 1
endif
successCUDA = cuda_malloc(umc_dev, umc_size* size_of_datatype)
......@@ -501,7 +501,7 @@
print *,"bandred_&
&MATH_DATATYPE&
&: error in cudaMalloc umc_dev"
stop
stop 1
endif
endif
......@@ -517,7 +517,7 @@
print *,"bandred_&
&MATH_DATATYPE&
&: error when allocating vmrCPU "//errorMessage
stop
stop 1
endif
allocate(umcCPU(max(l_cols,1),2*n_cols), stat=istat, errmsg=errorMessage)
......@@ -525,7 +525,7 @@
print *,"bandred_&
&MATH_DATATYPE&
&: error when allocating umcCPU "//errorMessage
stop
stop 1
endif
allocate(vr(l_rows+1), stat=istat, errmsg=errorMessage)
......@@ -533,7 +533,7 @@
print *,"bandred_&
&MATH_DATATYPE&
&: error when allocating vr "//errorMessage
stop
stop 1
endif
endif ! use GPU
......@@ -608,7 +608,7 @@
print *,"bandred_&
&MATH_DATATYPE&
&: error in cudaMemcpy2d"
stop
stop 1
endif
endif
......@@ -977,7 +977,7 @@
print *, "bandred_&
&MATH_DATATYPE&
&: cuda memcpy a_dev failed ", istat
stop
stop 1
endif
endif
endif
......@@ -1107,7 +1107,7 @@
print *,"bandred_&
&MATH_DATATYPE&
&: error in cudaMemcpy"
stop
stop 1
endif
successCUDA = cuda_memcpy(umc_dev, &
#if REALCASE == 1
......@@ -1121,7 +1121,7 @@
print *,"bandred_&
&MATH_DATATYPE&
&: error in cudaMemcpy"
stop
stop 1
endif
do i=0,(istep*nbw-1)/tile_size
......@@ -1171,7 +1171,7 @@
print *,"bandred_&
&MATH_DATATYPE&
&: error in cudaMemcpy"
stop
stop 1
endif
successCUDA = cuda_memcpy( &
......@@ -1186,7 +1186,7 @@
print *,"bandred_&
&MATH_DATATYPE&
&: error in cudaMemcpy"
stop
stop 1
endif
endif ! l_cols>0 .and. l_rows>0
......@@ -1408,7 +1408,7 @@
print *,"bandred_&
&MATH_DATATYPE&
&: error when allocating tmpCUDA "//errorMessage
stop
stop 1
endif
call timer%start("mpi_communication")
......@@ -1441,7 +1441,7 @@
print *,"bandred_&
&MATH_DATATYPE&
&: error when deallocating tmpCUDA "//errorMessage
stop
stop 1
endif
endif
endif ! l_cols
......@@ -1459,14 +1459,14 @@
print *,"bandred_&
&MATH_DATATYPE&
&: error in cudaMemcpy"
stop
stop 1
endif
successCUDA = cuda_memcpy(tmat_dev,loc(tmat(1,1,istep)),nbw*nbw*size_of_datatype,cudaMemcpyHostToDevice)
if (.not.(successCUDA)) then
print *,"bandred_&
&MATH_DATATYPE&
&: error in cudaMemcpy"
stop
stop 1
endif
call timer%start("cublas")
......@@ -1485,7 +1485,7 @@
print *,"bandred_&
&MATH_DATATYPE&
&: error in cudaMemcpy"
stop
stop 1
endif
call timer%start("cublas")
......@@ -1513,7 +1513,7 @@
print *,"bandred_&
&MATH_DATATYPE&
&: error in cudaMemcpy"
stop
stop 1
endif
#if REALCASE == 1
......@@ -1530,7 +1530,7 @@
print *,"bandred_&
&MATH_DATATYPE&
&: error in cudaMemcpy"
stop
stop 1
endif
! U = U - 0.5 * V * VAV
......@@ -1562,7 +1562,7 @@
print *,"bandred_&
&MATH_DATATYPE&
&: error in cudaMemcpy"
stop
stop 1
endif
! Transpose umc -> umr (stored in vmr, second half)
......@@ -1593,7 +1593,7 @@
print *,"bandred_&
&MATH_DATATYPE&
&: error in cudaMemcpy"
stop
stop 1
endif
successCUDA = cuda_memcpy(umc_dev, &
......@@ -1608,7 +1608,7 @@
print *,"bandred_&
&MATH_DATATYPE&
&: error in cudaMemcpy"
stop
stop 1
endif
! A = A - V*U**T - U*V**T
......@@ -1653,7 +1653,7 @@
print *,"bandred_&
&MATH_DATATYPE&
&: error when allocating tmpCPU "//errorMessage
stop
stop 1
endif
#ifdef WITH_MPI
......@@ -1677,7 +1677,7 @@
print *,"bandred_&
&MATH_DATATYPE&
&: error when deallocating tmpCPU "//errorMessage
stop
stop 1
endif
endif
......@@ -1829,7 +1829,7 @@
print *,"bandred_&
&MATH_DATATYPE&
&: error when deallocating vr "//errorMessage
stop
stop 1
endif
endif
......@@ -1839,7 +1839,7 @@
print *,"bandred_&
&MATH_DATATYPE&
&: error when deallocating umcCPU "//errorMessage
stop
stop 1
endif
endif
......@@ -1849,7 +1849,7 @@
print *,"bandred_&
&MATH_DATATYPE&
&: error when deallocating vmrCPU "//errorMessage
stop
stop 1