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.
psblas3-type-indexed
Salvatore Filippone 17 years ago
parent 959a184c24
commit 5df01d3927

@ -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

Loading…
Cancel
Save