fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-18 11:52:11 +00:00
Code Issues Packages Projects Releases Wiki Activity

psblas2-dev:

Browse Source 
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 fixes into serial sorting routines.
This commit is contained in:
Salvatore Filippone
2008-05-23 09:40:01 +00:00
parent 5df01d3927
commit fb5fdf4f1a
20 changed files with 65 additions and 42 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/serial/aux/dasr.f90
+2 -1
View File
@@ -303,7 +303,8 @@ subroutine dasr(n,x,dir)
endif
case default
write(0,*) 'isr error !',dir
call psb_errpush(4001,r_name='dasr',a_err='wrong dir')
call psb_error()
end select
base/serial/aux/dasrx.f90
+2 -1
View File
@@ -343,7 +343,8 @@ subroutine dasrx(n,x,indx,dir,flag)
endif
case default
write(0,*) 'isrx error dir ',dir
call psb_errpush(4001,r_name='dasrx',a_err='wrong dir')
call psb_error()
end select
base/serial/aux/dmsr.f90
+4 -3
View File
@@ -54,8 +54,8 @@ subroutine dmsr(n,x,idir)
allocate(iaux(0:n+1),stat=info)
if (info/=0) then
write(0,*) 'IMSR: memory allocation failed',info
return
call psb_errpush(4000,r_name='dmsr')
call psb_error()
endif
if (idir==psb_sort_up_) then
@@ -86,7 +86,8 @@ subroutine dmsr(n,x,idir)
deallocate(iaux,stat=info)
if (info/=0) then
write(0,*) 'IMSR: memory deallocation failed',info
call psb_errpush(4000,r_name='dmsr')
call psb_error()
endif
return
end subroutine dmsr
base/serial/aux/dmsrx.f90
+5 -4
View File
@@ -45,7 +45,7 @@ subroutine dmsrx(n,x,indx,idir,flag)
real(psb_dpk_) :: swap
if (n<0) then
write(0,*) 'Error: DMSRX: N<0'
!!$ write(0,*) 'Error: DMSRX: N<0'
return
endif
@@ -61,8 +61,8 @@ subroutine dmsrx(n,x,indx,idir,flag)
allocate(iaux(0:n+1),stat=info)
if (info/=0) then
write(0,*) 'DMSRX: memory allocation failed',info
return
call psb_errpush(4000,r_name='dmsrx')
call psb_error()
endif
if (idir == psb_sort_up_) then
@@ -96,7 +96,8 @@ subroutine dmsrx(n,x,indx,idir,flag)
deallocate(iaux,stat=info)
if (info/=0) then
write(0,*) 'DMSRX: memory deallocation failed',info
call psb_errpush(4000,r_name='dmsrx')
call psb_error()
endif
return
end subroutine dmsrx
base/serial/aux/dsr.f90
+2 -1
View File
@@ -303,7 +303,8 @@ subroutine dsr(n,x,dir)
endif
case default
write(0,*) 'isr error !',dir
call psb_errpush(4001,r_name='dsr',a_err='wrong dir')
call psb_error()
end select
base/serial/aux/dsrx.f90
+4 -2
View File
@@ -58,7 +58,8 @@ subroutine dsrx(n,x,indx,dir,flag)
case(psb_sort_keep_idx_)
! do nothing
case default
write(0,*) 'Error in isrx: invalid flag',flag
call psb_errpush(4001,r_name='isrx',a_err='wrong flag')
call psb_error()
end select
!
@@ -345,7 +346,8 @@ subroutine dsrx(n,x,indx,dir,flag)
endif
case default
write(0,*) 'isrx error dir ',dir
call psb_errpush(4001,r_name='dsrx',a_err='wrong dir')
call psb_error()
end select
base/serial/aux/iasr.f90
+2 -1
View File
@@ -303,7 +303,8 @@ subroutine iasr(n,x,dir)
endif
case default
write(0,*) 'isr error !',dir
call psb_errpush(4001,r_name='iasr',a_err='wrong dir')
call psb_error()
end select
base/serial/aux/iasrx.f90
+4 -2
View File
@@ -58,7 +58,8 @@ subroutine iasrx(n,x,indx,dir,flag)
case(psb_sort_keep_idx_)
! do nothing
case default
write(0,*) 'Error in isrx: invalid flag',flag
call psb_errpush(4001,r_name='iasrx',a_err='wrong flag')
call psb_error()
end select
!
@@ -343,7 +344,8 @@ subroutine iasrx(n,x,indx,dir,flag)
endif
case default
write(0,*) 'isrx error dir ',dir
call psb_errpush(4001,r_name='iasrx',a_err='wrong dir')
call psb_error()
end select
base/serial/aux/imsr.f90
+4 -4
View File
@@ -46,7 +46,6 @@ subroutine imsr(n,x,idir)
integer :: lswap
if (n<0) then
!!$ write(0,*) 'Error: IMSR: N<0'
return
endif
@@ -54,8 +53,8 @@ subroutine imsr(n,x,idir)
allocate(iaux(0:n+1),stat=info)
if (info/=0) then
write(0,*) 'IMSR: memory allocation failed',info
return
call psb_errpush(4000,r_name='imsr')
call psb_error()
endif
if (idir==psb_sort_up_) then
@@ -86,7 +85,8 @@ subroutine imsr(n,x,idir)
deallocate(iaux,stat=info)
if (info/=0) then
write(0,*) 'IMSR: memory deallocation failed',info
call psb_errpush(4000,r_name='imsr')
call psb_error()
endif
return
end subroutine imsr
base/serial/aux/imsrx.f90
+4 -4
View File
@@ -45,7 +45,6 @@ subroutine imsrx(n,x,indx,idir,flag)
integer :: lswap, ixswap
if (n<0) then
write(0,*) 'Error: IMSRX: N<0'
return
endif
@@ -61,8 +60,8 @@ subroutine imsrx(n,x,indx,idir,flag)
allocate(iaux(0:n+1),stat=info)
if (info/=0) then
write(0,*) 'IMSRX: memory allocation failed',info
return
call psb_errpush(4000,r_name='imsrx')
call psb_error()
endif
if (idir == psb_sort_up_) then
@@ -96,7 +95,8 @@ subroutine imsrx(n,x,indx,idir,flag)
deallocate(iaux,stat=info)
if (info/=0) then
write(0,*) 'IMSRX: memory deallocation failed',info
call psb_errpush(4000,r_name='imsrx')
call psb_error()
endif
return
end subroutine imsrx
base/serial/aux/isr.f90
+2 -1
View File
@@ -303,7 +303,8 @@ subroutine isr(n,x,dir)
endif
case default
write(0,*) 'isr error !',dir
call psb_errpush(4001,r_name='isr',a_err='wrong dir')
call psb_error()
end select
base/serial/aux/isrx.f90
+4 -2
View File
@@ -57,7 +57,8 @@ subroutine isrx(n,x,indx,dir,flag)
case(psb_sort_keep_idx_)
! do nothing
case default
write(0,*) 'Error in isrx: invalid flag',flag
call psb_errpush(4001,r_name='isrx',a_err='wrong flag')
call psb_error()
end select
!
@@ -345,7 +346,8 @@ subroutine isrx(n,x,indx,dir,flag)
endif
case default
write(0,*) 'isrx error dir ',dir
call psb_errpush(4001,r_name='isrx',a_err='wrong dir')
call psb_error()
end select
base/serial/aux/zalsr.f90
+2 -1
View File
@@ -304,7 +304,8 @@ subroutine zalsr(n,x,dir)
endif
case default
write(0,*) 'isr error !',dir
call psb_errpush(4001,r_name='zalsr',a_err='wrong dir')
call psb_error()
end select
base/serial/aux/zalsrx.f90
+4 -2
View File
@@ -59,7 +59,8 @@ subroutine zalsrx(n,x,indx,dir,flag)
case(psb_sort_keep_idx_)
! do nothing
case default
write(0,*) 'Error in isrx: invalid flag',flag
call psb_errpush(4001,r_name='zalsrx',a_err='wrong flag')
call psb_error()
end select
!
@@ -347,7 +348,8 @@ subroutine zalsrx(n,x,indx,dir,flag)
endif
case default
write(0,*) 'isrx error dir ',dir
call psb_errpush(4001,r_name='zalsrx',a_err='wrong dir')
call psb_error()
end select
base/serial/aux/zamsr.f90
+4 -3
View File
@@ -54,8 +54,8 @@ subroutine zamsr(n,x,idir)
allocate(iaux(0:n+1),stat=info)
if (info/=0) then
write(0,*) 'IMSR: memory allocation failed',info
return
call psb_errpush(4000,r_name='zamsr')
call psb_error()
endif
if (idir==psb_asort_up_) then
@@ -86,7 +86,8 @@ subroutine zamsr(n,x,idir)
deallocate(iaux,stat=info)
if (info/=0) then
write(0,*) 'IMSR: memory deallocation failed',info
call psb_errpush(4000,r_name='zamsr')
call psb_error()
endif
return
end subroutine zamsr
base/serial/aux/zamsrx.f90
+4 -4
View File
@@ -45,7 +45,6 @@ subroutine zamsrx(n,x,indx,idir,flag)
complex(psb_dpk_) :: swap
if (n<0) then
write(0,*) 'Error: DMSRX: N<0'
return
endif
@@ -61,8 +60,8 @@ subroutine zamsrx(n,x,indx,idir,flag)
allocate(iaux(0:n+1),stat=info)
if (info/=0) then
write(0,*) 'DMSRX: memory allocation failed',info
return
call psb_errpush(4000,r_name='zamsrx')
call psb_error()
endif
if (idir == psb_asort_up_) then
@@ -96,7 +95,8 @@ subroutine zamsrx(n,x,indx,idir,flag)
deallocate(iaux,stat=info)
if (info/=0) then
write(0,*) 'DMSRX: memory deallocation failed',info
call psb_errpush(4000,r_name='zamsrx')
call psb_error()
endif
return
end subroutine zamsrx
base/serial/aux/zasr.f90
+2 -1
View File
@@ -304,7 +304,8 @@ subroutine zasr(n,x,dir)
endif
case default
write(0,*) 'isr error !',dir
call psb_errpush(4001,r_name='zasr',a_err='wrong dir')
call psb_error()
end select
base/serial/aux/zasrx.f90
+4 -2
View File
@@ -59,7 +59,8 @@ subroutine zasrx(n,x,indx,dir,flag)
case(psb_sort_keep_idx_)
! do nothing
case default
write(0,*) 'Error in isrx: invalid flag',flag
call psb_errpush(4001,r_name='zasrx',a_err='wrong flag')
call psb_error()
end select
!
@@ -347,7 +348,8 @@ subroutine zasrx(n,x,indx,dir,flag)
endif
case default
write(0,*) 'isrx error dir ',dir
call psb_errpush(4001,r_name='zasrx',a_err='wrong dir')
call psb_error()
end select
base/serial/aux/zlsr.f90
+2 -1
View File
@@ -304,7 +304,8 @@ subroutine zlsr(n,x,dir)
endif
case default
write(0,*) 'isr error !',dir
call psb_errpush(4001,r_name='zlsr',a_err='wrong dir')
call psb_error()
end select
base/serial/aux/zlsrx.f90
+4 -2
View File
@@ -59,7 +59,8 @@ subroutine zlsrx(n,x,indx,dir,flag)
case(psb_sort_keep_idx_)
! do nothing
case default
write(0,*) 'Error in isrx: invalid flag',flag
call psb_errpush(4001,r_name='zlsrx',a_err='wrong flag')
call psb_error()
end select
!
@@ -347,7 +348,8 @@ subroutine zlsrx(n,x,indx,dir,flag)
endif
case default
write(0,*) 'isrx error dir ',dir
call psb_errpush(4001,r_name='zlsrx',a_err='wrong dir')
call psb_error()
end select