psblas2-dev:

base/serial/aux/dasr.f90
 base/serial/aux/dasrx.f90
 base/serial/aux/dsr.f90
 base/serial/aux/dsrx.f90
 base/serial/aux/iasr.f90
 base/serial/aux/iasrx.f90
 base/serial/aux/isr.f90
 base/serial/aux/isrx.f90
 base/serial/aux/zalsr.f90
 base/serial/aux/zalsrx.f90
 base/serial/aux/zasr.f90
 base/serial/aux/zasrx.f90
 base/serial/aux/zlsr.f90
 base/serial/aux/zlsrx.f90

Added sensible error handling into serial sorting routines.
This commit is contained in:
Salvatore Filippone
2008-05-23 09:22:02 +00:00
parent 959a184c24
commit 5df01d3927
14 changed files with 57 additions and 57 deletions
+4 -4
View File
@@ -134,8 +134,8 @@ subroutine dasr(n,x,dir)
end do outer_up
if (i == ilx) then
if (x(i) /= piv) then
write(0,*) 'Should never ever get here????!!!!'
stop
call psb_errpush(4001,r_name='dasr',a_err='impossible pivot condition')
call psb_error()
endif
i = i + 1
endif
@@ -258,8 +258,8 @@ subroutine dasr(n,x,dir)
end do outer_dw
if (i == ilx) then
if (x(i) /= piv) then
write(0,*) 'Should never ever get here????!!!!'
stop
call psb_errpush(4001,r_name='dasr',a_err='impossible pivot condition')
call psb_error()
endif
i = i + 1
endif
+4 -4
View File
@@ -160,8 +160,8 @@ subroutine dasrx(n,x,indx,dir,flag)
end do outer_up
if (i == ilx) then
if (x(i) /= piv) then
write(0,*) 'Should never ever get here????!!!!'
stop
call psb_errpush(4001,r_name='dasrx',a_err='impossible pivot condition')
call psb_error()
endif
i = i + 1
endif
@@ -298,8 +298,8 @@ subroutine dasrx(n,x,indx,dir,flag)
end do outer_dw
if (i == ilx) then
if (x(i) /= piv) then
write(0,*) 'Should never ever get here????!!!!'
stop
call psb_errpush(4001,r_name='dasrx',a_err='impossible pivot condition')
call psb_error()
endif
i = i + 1
endif
+4 -4
View File
@@ -134,8 +134,8 @@ subroutine dsr(n,x,dir)
end do outer_up
if (i == ilx) then
if (x(i) /= piv) then
write(0,*) 'Should never ever get here????!!!!'
stop
call psb_errpush(4001,r_name='dsr',a_err='impossible pivot condition')
call psb_error()
endif
i = i + 1
endif
@@ -258,8 +258,8 @@ subroutine dsr(n,x,dir)
end do outer_dw
if (i == ilx) then
if (x(i) /= piv) then
write(0,*) 'Should never ever get here????!!!!'
stop
call psb_errpush(4001,r_name='dsr',a_err='impossible pivot condition')
call psb_error()
endif
i = i + 1
endif
+4 -4
View File
@@ -161,8 +161,8 @@ subroutine dsrx(n,x,indx,dir,flag)
end do outer_up
if (i == ilx) then
if (x(i) /= piv) then
write(0,*) 'Should never ever get here????!!!!'
stop
call psb_errpush(4001,r_name='dsrx',a_err='impossible pivot condition')
call psb_error()
endif
i = i + 1
endif
@@ -300,8 +300,8 @@ subroutine dsrx(n,x,indx,dir,flag)
end do outer_dw
if (i == ilx) then
if (x(i) /= piv) then
write(0,*) 'Should never ever get here????!!!!'
stop
call psb_errpush(4001,r_name='dsrx',a_err='impossible pivot condition')
call psb_error()
endif
i = i + 1
endif
+4 -4
View File
@@ -134,8 +134,8 @@ subroutine iasr(n,x,dir)
end do outer_up
if (i == ilx) then
if (x(i) /= piv) then
write(0,*) 'Should never ever get here????!!!!'
stop
call psb_errpush(4001,r_name='iasr',a_err='impossible pivot condition')
call psb_error()
endif
i = i + 1
endif
@@ -258,8 +258,8 @@ subroutine iasr(n,x,dir)
end do outer_dw
if (i == ilx) then
if (x(i) /= piv) then
write(0,*) 'Should never ever get here????!!!!'
stop
call psb_errpush(4001,r_name='iasr',a_err='impossible pivot condition')
call psb_error()
endif
i = i + 1
endif
+4 -4
View File
@@ -160,8 +160,8 @@ subroutine iasrx(n,x,indx,dir,flag)
end do outer_up
if (i == ilx) then
if (x(i) /= piv) then
write(0,*) 'Should never ever get here????!!!!'
stop
call psb_errpush(4001,r_name='iasrx',a_err='impossible pivot condition')
call psb_error()
endif
i = i + 1
endif
@@ -298,8 +298,8 @@ subroutine iasrx(n,x,indx,dir,flag)
end do outer_dw
if (i == ilx) then
if (x(i) /= piv) then
write(0,*) 'Should never ever get here????!!!!'
stop
call psb_errpush(4001,r_name='iasrx',a_err='impossible pivot condition')
call psb_error()
endif
i = i + 1
endif
+4 -4
View File
@@ -134,8 +134,8 @@ subroutine isr(n,x,dir)
end do outer_up
if (i == ilx) then
if (x(i) /= piv) then
write(0,*) 'Should never ever get here????!!!!'
stop
call psb_errpush(4001,r_name='isr',a_err='impossible pivot condition')
call psb_error()
endif
i = i + 1
endif
@@ -258,8 +258,8 @@ subroutine isr(n,x,dir)
end do outer_dw
if (i == ilx) then
if (x(i) /= piv) then
write(0,*) 'Should never ever get here????!!!!'
stop
call psb_errpush(4001,r_name='isr',a_err='impossible pivot condition')
call psb_error()
endif
i = i + 1
endif
+5 -5
View File
@@ -159,9 +159,9 @@ subroutine isrx(n,x,indx,dir,flag)
end if
end do outer_up
if (i == ilx) then
if (x(i) /= piv) then
write(0,*) 'Should never ever get here????!!!!'
stop
if (x(i) /= piv) then
call psb_errpush(4001,r_name='isrx',a_err='impossible pivot condition')
call psb_error()
endif
i = i + 1
endif
@@ -300,8 +300,8 @@ subroutine isrx(n,x,indx,dir,flag)
end do outer_dw
if (i == ilx) then
if (x(i) /= piv) then
write(0,*) 'Should never ever get here????!!!!'
stop
call psb_errpush(4001,r_name='isrx',a_err='impossible pivot condition')
call psb_error()
endif
i = i + 1
endif
+4 -4
View File
@@ -135,8 +135,8 @@ subroutine zalsr(n,x,dir)
end do outer_up
if (i == ilx) then
if (x(i) /= piv) then
write(0,*) 'Should never ever get here????!!!!'
stop
call psb_errpush(4001,r_name='zalsr',a_err='impossible pivot condition')
call psb_error()
endif
i = i + 1
endif
@@ -259,8 +259,8 @@ subroutine zalsr(n,x,dir)
end do outer_dw
if (i == ilx) then
if (x(i) /= piv) then
write(0,*) 'Should never ever get here????!!!!'
stop
call psb_errpush(4001,r_name='zalsr',a_err='impossible pivot condition')
call psb_error()
endif
i = i + 1
endif
+4 -4
View File
@@ -162,8 +162,8 @@ subroutine zalsrx(n,x,indx,dir,flag)
end do outer_up
if (i == ilx) then
if (x(i) /= piv) then
write(0,*) 'Should never ever get here????!!!!'
stop
call psb_errpush(4001,r_name='zalsrx',a_err='impossible pivot condition')
call psb_error()
endif
i = i + 1
endif
@@ -302,8 +302,8 @@ subroutine zalsrx(n,x,indx,dir,flag)
end do outer_dw
if (i == ilx) then
if (x(i) /= piv) then
write(0,*) 'Should never ever get here????!!!!'
stop
call psb_errpush(4001,r_name='zalsrx',a_err='impossible pivot condition')
call psb_error()
endif
i = i + 1
endif
+4 -4
View File
@@ -135,8 +135,8 @@ subroutine zasr(n,x,dir)
end do outer_up
if (i == ilx) then
if (x(i) /= piv) then
write(0,*) 'Should never ever get here????!!!!'
stop
call psb_errpush(4001,r_name='zasr',a_err='impossible pivot condition')
call psb_error()
endif
i = i + 1
endif
@@ -259,8 +259,8 @@ subroutine zasr(n,x,dir)
end do outer_dw
if (i == ilx) then
if (x(i) /= piv) then
write(0,*) 'Should never ever get here????!!!!'
stop
call psb_errpush(4001,r_name='zasr',a_err='impossible pivot condition')
call psb_error()
endif
i = i + 1
endif
+4 -4
View File
@@ -162,8 +162,8 @@ subroutine zasrx(n,x,indx,dir,flag)
end do outer_up
if (i == ilx) then
if (x(i) /= piv) then
write(0,*) 'Should never ever get here????!!!!'
stop
call psb_errpush(4001,r_name='zasrx',a_err='impossible pivot condition')
call psb_error()
endif
i = i + 1
endif
@@ -302,8 +302,8 @@ subroutine zasrx(n,x,indx,dir,flag)
end do outer_dw
if (i == ilx) then
if (x(i) /= piv) then
write(0,*) 'Should never ever get here????!!!!'
stop
call psb_errpush(4001,r_name='zasrx',a_err='impossible pivot condition')
call psb_error()
endif
i = i + 1
endif
+4 -4
View File
@@ -135,8 +135,8 @@ subroutine zlsr(n,x,dir)
end do outer_up
if (i == ilx) then
if (x(i) /= piv) then
write(0,*) 'Should never ever get here????!!!!'
stop
call psb_errpush(4001,r_name='zlsr',a_err='impossible pivot condition')
call psb_error()
endif
i = i + 1
endif
@@ -259,8 +259,8 @@ subroutine zlsr(n,x,dir)
end do outer_dw
if (i == ilx) then
if (x(i) /= piv) then
write(0,*) 'Should never ever get here????!!!!'
stop
call psb_errpush(4001,r_name='zlsr',a_err='impossible pivot condition')
call psb_error()
endif
i = i + 1
endif
+4 -4
View File
@@ -162,8 +162,8 @@ subroutine zlsrx(n,x,indx,dir,flag)
end do outer_up
if (i == ilx) then
if (x(i) /= piv) then
write(0,*) 'Should never ever get here????!!!!'
stop
call psb_errpush(4001,r_name='zlsrx',a_err='impossible pivot condition')
call psb_error()
endif
i = i + 1
endif
@@ -302,8 +302,8 @@ subroutine zlsrx(n,x,indx,dir,flag)
end do outer_dw
if (i == ilx) then
if (x(i) /= piv) then
write(0,*) 'Should never ever get here????!!!!'
stop
call psb_errpush(4001,r_name='zlsrx',a_err='impossible pivot condition')
call psb_error()
endif
i = i + 1
endif