mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-16 10:52:08 +00:00
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:
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user