fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Reworked all the sorting routines from templates.

Browse Source 
Also merged blsrch into gen_block_map_mod, where it belongs.
pull/6/head
Salvatore Filippone 7 years ago
parent 9ca93af839
commit b06c612f9a
14 changed files with 3844 additions and 6354 deletions
Show Stats Download Patch File Download Diff File

9
base/modules/aux/psb_c_sort_mod.f90
Unescape Escape View File

@ -44,6 +44,15 @@ module psb_c_sort_mod
use psb_const_mod use psb_const_mod
interface psb_msort_unique
subroutine psb_cmsort_u(x,nout,dir)
import
complex(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(out) :: nout
integer(psb_ipk_), optional, intent(in) :: dir
end subroutine psb_cmsort_u
end interface psb_msort_unique
type psb_c_heap type psb_c_heap
integer(psb_ipk_) :: last, dir integer(psb_ipk_) :: last, dir
complex(psb_spk_), allocatable :: keys(:) complex(psb_spk_), allocatable :: keys(:)

29
base/modules/aux/psb_d_sort_mod.f90
Unescape Escape View File

@ -44,6 +44,15 @@ module psb_d_sort_mod
use psb_const_mod use psb_const_mod
interface psb_msort_unique
subroutine psb_dmsort_u(x,nout,dir)
import
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(out) :: nout
integer(psb_ipk_), optional, intent(in) :: dir
end subroutine psb_dmsort_u
end interface psb_msort_unique
type psb_d_heap type psb_d_heap
integer(psb_ipk_) :: last, dir integer(psb_ipk_) :: last, dir
real(psb_dpk_), allocatable :: keys(:) real(psb_dpk_), allocatable :: keys(:)
@ -79,6 +88,26 @@ module psb_d_sort_mod
end subroutine psb_dmsort end subroutine psb_dmsort
end interface psb_msort end interface psb_msort
interface psb_bsrch
function psb_dbsrch(key,n,v) result(ipos)
import
integer(psb_ipk_) :: ipos, n
real(psb_dpk_) :: key
real(psb_dpk_) :: v(:)
end function psb_dbsrch
end interface psb_bsrch
interface psb_ssrch
function psb_dssrch(key,n,v) result(ipos)
import
implicit none
integer(psb_ipk_) :: ipos, n
real(psb_dpk_) :: key
real(psb_dpk_) :: v(:)
end function psb_dssrch
end interface psb_ssrch
interface interface
subroutine psi_d_msort_up(n,k,l,iret) subroutine psi_d_msort_up(n,k,l,iret)
import import

47
base/modules/aux/psb_i_sort_mod.f90
Unescape Escape View File

@ -43,30 +43,6 @@
module psb_i_sort_mod module psb_i_sort_mod
use psb_const_mod use psb_const_mod
interface psb_iblsrch
function psb_iblsrch(key,n,v) result(ipos)
import :: psb_ipk_
integer(psb_ipk_) :: ipos, key, n
integer(psb_ipk_) :: v(:)
end function psb_iblsrch
end interface psb_iblsrch
interface psb_ibsrch
function psb_ibsrch(key,n,v) result(ipos)
import :: psb_ipk_
integer(psb_ipk_) :: ipos, key, n
integer(psb_ipk_) :: v(:)
end function psb_ibsrch
end interface psb_ibsrch
interface psb_issrch
function psb_issrch(key,n,v) result(ipos)
import :: psb_ipk_
implicit none
integer(psb_ipk_) :: ipos, key, n
integer(psb_ipk_) :: v(:)
end function psb_issrch
end interface psb_issrch
interface psb_isaperm interface psb_isaperm
logical function psb_isaperm(n,eip) logical function psb_isaperm(n,eip)
@ -76,9 +52,10 @@ module psb_i_sort_mod
end function psb_isaperm end function psb_isaperm
end interface psb_isaperm end interface psb_isaperm
interface psb_msort_unique interface psb_msort_unique
subroutine psb_imsort_u(x,nout,dir) subroutine psb_imsort_u(x,nout,dir)
import :: psb_ipk_, psb_spk_, psb_dpk_ import
integer(psb_ipk_), intent(inout) :: x(:) integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(out) :: nout integer(psb_ipk_), intent(out) :: nout
integer(psb_ipk_), optional, intent(in) :: dir integer(psb_ipk_), optional, intent(in) :: dir
@ -120,6 +97,26 @@ module psb_i_sort_mod
end subroutine psb_imsort end subroutine psb_imsort
end interface psb_msort end interface psb_msort
interface psb_bsrch
function psb_ibsrch(key,n,v) result(ipos)
import
integer(psb_ipk_) :: ipos, n
integer(psb_ipk_) :: key
integer(psb_ipk_) :: v(:)
end function psb_ibsrch
end interface psb_bsrch
interface psb_ssrch
function psb_issrch(key,n,v) result(ipos)
import
implicit none
integer(psb_ipk_) :: ipos, n
integer(psb_ipk_) :: key
integer(psb_ipk_) :: v(:)
end function psb_issrch
end interface psb_ssrch
interface interface
subroutine psi_i_msort_up(n,k,l,iret) subroutine psi_i_msort_up(n,k,l,iret)
import import

29
base/modules/aux/psb_s_sort_mod.f90
Unescape Escape View File

@ -44,6 +44,15 @@ module psb_s_sort_mod
use psb_const_mod use psb_const_mod
interface psb_msort_unique
subroutine psb_smsort_u(x,nout,dir)
import
real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(out) :: nout
integer(psb_ipk_), optional, intent(in) :: dir
end subroutine psb_smsort_u
end interface psb_msort_unique
type psb_s_heap type psb_s_heap
integer(psb_ipk_) :: last, dir integer(psb_ipk_) :: last, dir
real(psb_spk_), allocatable :: keys(:) real(psb_spk_), allocatable :: keys(:)
@ -79,6 +88,26 @@ module psb_s_sort_mod
end subroutine psb_smsort end subroutine psb_smsort
end interface psb_msort end interface psb_msort
interface psb_bsrch
function psb_sbsrch(key,n,v) result(ipos)
import
integer(psb_ipk_) :: ipos, n
real(psb_spk_) :: key
real(psb_spk_) :: v(:)
end function psb_sbsrch
end interface psb_bsrch
interface psb_ssrch
function psb_sssrch(key,n,v) result(ipos)
import
implicit none
integer(psb_ipk_) :: ipos, n
real(psb_spk_) :: key
real(psb_spk_) :: v(:)
end function psb_sssrch
end interface psb_ssrch
interface interface
subroutine psi_s_msort_up(n,k,l,iret) subroutine psi_s_msort_up(n,k,l,iret)
import import

9
base/modules/aux/psb_z_sort_mod.f90
Unescape Escape View File

@ -44,6 +44,15 @@ module psb_z_sort_mod
use psb_const_mod use psb_const_mod
interface psb_msort_unique
subroutine psb_zmsort_u(x,nout,dir)
import
complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(out) :: nout
integer(psb_ipk_), optional, intent(in) :: dir
end subroutine psb_zmsort_u
end interface psb_msort_unique
type psb_z_heap type psb_z_heap
integer(psb_ipk_) :: last, dir integer(psb_ipk_) :: last, dir
complex(psb_dpk_), allocatable :: keys(:) complex(psb_dpk_), allocatable :: keys(:)

97
base/modules/desc/psb_gen_block_map_mod.f90
Unescape Escape View File

@ -90,7 +90,8 @@ module psb_gen_block_map_mod
& block_get_fmt, block_l2gs1, block_l2gs2, block_l2gv1,& & block_get_fmt, block_l2gs1, block_l2gs2, block_l2gv1,&
& block_l2gv2, block_g2ls1, block_g2ls2, block_g2lv1,& & block_l2gv2, block_g2ls1, block_g2ls2, block_g2lv1,&
& block_g2lv2, block_g2ls1_ins, block_g2ls2_ins,& & block_g2lv2, block_g2ls1_ins, block_g2ls2_ins,&
& block_g2lv1_ins, block_g2lv2_ins, block_clone, block_reinit & block_g2lv1_ins, block_g2lv2_ins, block_clone, block_reinit,&
& gen_block_search
integer(psb_ipk_), private :: laddsz=500 integer(psb_ipk_), private :: laddsz=500
@ -992,7 +993,6 @@ contains
subroutine block_fnd_owner(idx,iprc,idxmap,info) subroutine block_fnd_owner(idx,iprc,idxmap,info)
use psb_penv_mod use psb_penv_mod
use psb_sort_mod
implicit none implicit none
integer(psb_ipk_), intent(in) :: idx(:) integer(psb_ipk_), intent(in) :: idx(:)
integer(psb_ipk_), allocatable, intent(out) :: iprc(:) integer(psb_ipk_), allocatable, intent(out) :: iprc(:)
@ -1009,7 +1009,7 @@ contains
return return
end if end if
do i=1, nv do i=1, nv
ip = psb_iblsrch(idx(i)-1,np+1,idxmap%vnl) ip = gen_block_search(idx(i)-1,np+1,idxmap%vnl)
iprc(i) = ip - 1 iprc(i) = ip - 1
end do end do
@ -1226,52 +1226,49 @@ contains
return return
end subroutine block_reinit end subroutine block_reinit
!!$
!!$ subroutine block_reinit(idxmap,info) !
!!$ use psb_penv_mod ! This is a purely internal version of "binary" search
!!$ use psb_error_mod ! specialized for gen_block usage.
!!$ use psb_realloc_mod !
!!$ implicit none function gen_block_search(key,n,v) result(ipos)
!!$ class(psb_gen_block_map), intent(inout) :: idxmap implicit none
!!$ integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: ipos, key, n
!!$ integer(psb_ipk_) :: err_act, nr,nc,k, nl, ictxt integer(psb_ipk_) :: v(:)
!!$ integer(psb_ipk_), allocatable :: idx(:),lidx(:)
!!$ character(len=20) :: name='block_reinit' integer(psb_ipk_) :: lb, ub, m
!!$ logical, parameter :: debug=.false.
!!$ if (n < 5) then
!!$ info = psb_success_ ! don't bother with binary search for very
!!$ call psb_get_erraction(err_act) ! small vectors
!!$ ictxt = idxmap%get_ctxt() ipos = 0
!!$ nr = idxmap%get_lr() do
!!$ nc = idxmap%get_lc() if (ipos == n) return
!!$ if (nc>nr) then if (key < v(ipos+1)) return
!!$ lidx = (/(k,k=nr+1,nc)/) ipos = ipos + 1
!!$ idx = (/(k,k=nr+1,nc)/) end do
!!$ call idxmap%l2gip(idx,info) else
!!$ end if lb = 1
!!$ if (info /= 0) & ub = n
!!$ & write(0,*) 'From l2gip',info ipos = -1
!!$
!!$ call idxmap%init(ictxt,nr,info) do while (lb <= ub)
!!$ if (nc>nr) then m = (lb+ub)/2
!!$ call idxmap%g2lip_ins(idx,info,lidx=lidx) if (key==v(m)) then
!!$ end if ipos = m
!!$ return
!!$ else if (key < v(m)) then
!!$ if (info /= psb_success_) then ub = m-1
!!$ info = psb_err_from_subroutine_ else
!!$ call psb_errpush(info,name) lb = m + 1
!!$ goto 9999 end if
!!$ end if enddo
!!$ call psb_erractionrestore(err_act) if (v(ub) > key) then
!!$ return ub = ub - 1
!!$ end if
!!$ ipos = ub
!!$9999 call psb_error_handler(err_act) endif
!!$ return
!!$ return end function gen_block_search
!!$ end subroutine block_reinit
!!$
end module psb_gen_block_map_mod end module psb_gen_block_map_mod

9
base/modules/desc/psb_hash_map_mod.f90
Unescape Escape View File

@ -134,6 +134,8 @@ contains
& val = val + size(idxmap%hashv)*psb_sizeof_int & val = val + size(idxmap%hashv)*psb_sizeof_int
if (allocated(idxmap%glb_lc)) & if (allocated(idxmap%glb_lc)) &
& val = val + size(idxmap%glb_lc)*psb_sizeof_int & val = val + size(idxmap%glb_lc)*psb_sizeof_int
if (allocated(idxmap%loc_to_glob)) &
& val = val + size(idxmap%loc_to_glob)*psb_sizeof_int
val = val + psb_sizeof(idxmap%hash) val = val + psb_sizeof(idxmap%hash)
end function hash_sizeof end function hash_sizeof
@ -743,6 +745,9 @@ contains
end subroutine hash_g2lv2_ins end subroutine hash_g2lv2_ins
!
! init from VL, with checks on input.
!
subroutine hash_init_vl(idxmap,ictxt,vl,info) subroutine hash_init_vl(idxmap,ictxt,vl,info)
use psb_penv_mod use psb_penv_mod
use psb_error_mod use psb_error_mod
@ -870,7 +875,9 @@ contains
end subroutine hash_init_vg end subroutine hash_init_vg
!
! init from VL, with no checks on input
!
subroutine hash_init_vlu(idxmap,ictxt,ntot,nl,vlu,info) subroutine hash_init_vlu(idxmap,ictxt,ntot,nl,vlu,info)
use psb_penv_mod use psb_penv_mod
use psb_error_mod use psb_error_mod

35
base/serial/sort/psb_c_msort_impl.f90
Unescape Escape View File

@ -41,6 +41,41 @@
! Addison-Wesley ! Addison-Wesley
! !
subroutine psb_cmsort_u(x,nout,dir)
use psb_c_sort_mod, psb_protect_name => psb_cmsort_u
use psb_error_mod
implicit none
complex(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(out) :: nout
integer(psb_ipk_), optional, intent(in) :: dir
integer(psb_ipk_) :: n, k
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name
name='psb_msort_u'
call psb_erractionsave(err_act)
n = size(x)
call psb_msort(x,dir=dir)
nout = min(1,n)
do k=2,n
if (x(k) /= x(nout)) then
nout = nout + 1
x(nout) = x(k)
endif
enddo
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_cmsort_u

93
base/serial/sort/psb_d_msort_impl.f90
Unescape Escape View File

@ -41,6 +41,99 @@
! Addison-Wesley ! Addison-Wesley
! !
subroutine psb_dmsort_u(x,nout,dir)
use psb_d_sort_mod, psb_protect_name => psb_dmsort_u
use psb_error_mod
implicit none
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(out) :: nout
integer(psb_ipk_), optional, intent(in) :: dir
integer(psb_ipk_) :: n, k
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name
name='psb_msort_u'
call psb_erractionsave(err_act)
n = size(x)
call psb_msort(x,dir=dir)
nout = min(1,n)
do k=2,n
if (x(k) /= x(nout)) then
nout = nout + 1
x(nout) = x(k)
endif
enddo
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_dmsort_u
function psb_dbsrch(key,n,v) result(ipos)
use psb_d_sort_mod, psb_protect_name => psb_dbsrch
implicit none
integer(psb_ipk_) :: ipos, n
real(psb_dpk_) :: key
real(psb_dpk_) :: v(:)
integer(psb_ipk_) :: lb, ub, m, i
ipos = -1
if (n<5) then
do i=1,n
if (key.eq.v(i)) then
ipos = i
return
end if
enddo
return
end if
lb = 1
ub = n
do while (lb.le.ub)
m = (lb+ub)/2
if (key.eq.v(m)) then
ipos = m
lb = ub + 1
else if (key < v(m)) then
ub = m-1
else
lb = m + 1
end if
enddo
return
end function psb_dbsrch
function psb_dssrch(key,n,v) result(ipos)
use psb_d_sort_mod, psb_protect_name => psb_dssrch
implicit none
integer(psb_ipk_) :: ipos, n
real(psb_dpk_) :: key
real(psb_dpk_) :: v(:)
integer(psb_ipk_) :: i
ipos = -1
do i=1,n
if (key.eq.v(i)) then
ipos = i
return
end if
enddo
return
end function psb_dssrch
subroutine psb_dmsort(x,ix,dir,flag) subroutine psb_dmsort(x,ix,dir,flag)
use psb_d_sort_mod, psb_protect_name => psb_dmsort use psb_d_sort_mod, psb_protect_name => psb_dmsort
use psb_error_mod use psb_error_mod

143
base/serial/sort/psb_i_msort_impl.f90
Unescape Escape View File

@ -95,59 +95,65 @@
return return
end function psb_isaperm end function psb_isaperm
function psb_iblsrch(key,n,v) result(ipos)
use psb_i_sort_mod, psb_protect_name => psb_iblsrch
implicit none
integer(psb_ipk_) :: ipos, key, n
integer(psb_ipk_) :: v(:)
integer(psb_ipk_) :: lb, ub, m subroutine psb_imsort_u(x,nout,dir)
use psb_i_sort_mod, psb_protect_name => psb_imsort_u
if (n < 5) then use psb_error_mod
! don't bother with binary search for very implicit none
! small vectors integer(psb_ipk_), intent(inout) :: x(:)
ipos = 0 integer(psb_ipk_), intent(out) :: nout
do integer(psb_ipk_), optional, intent(in) :: dir
if (ipos == n) return
if (key < v(ipos+1)) return integer(psb_ipk_) :: n, k
ipos = ipos + 1 integer(psb_ipk_) :: err_act
end do
else integer(psb_ipk_) :: ierr(5)
lb = 1 character(len=20) :: name
ub = n
ipos = -1 name='psb_msort_u'
call psb_erractionsave(err_act)
do while (lb <= ub)
m = (lb+ub)/2 n = size(x)
if (key==v(m)) then
ipos = m call psb_msort(x,dir=dir)
return nout = min(1,n)
else if (key < v(m)) then do k=2,n
ub = m-1 if (x(k) /= x(nout)) then
else nout = nout + 1
lb = m + 1 x(nout) = x(k)
end if endif
enddo enddo
if (v(ub) > key) then
!!$ write(0,*) 'Check: ',ub,v(ub),key
ub = ub - 1
end if
ipos = ub
endif
return return
end function psb_iblsrch
9999 call psb_error_handler(err_act)
return
end subroutine psb_imsort_u
function psb_ibsrch(key,n,v) result(ipos) function psb_ibsrch(key,n,v) result(ipos)
use psb_i_sort_mod, psb_protect_name => psb_ibsrch use psb_i_sort_mod, psb_protect_name => psb_ibsrch
implicit none implicit none
integer(psb_ipk_) :: ipos, key, n integer(psb_ipk_) :: ipos, n
integer(psb_ipk_) :: key
integer(psb_ipk_) :: v(:) integer(psb_ipk_) :: v(:)
integer(psb_ipk_) :: lb, ub, m integer(psb_ipk_) :: lb, ub, m, i
ipos = -1
if (n<5) then
do i=1,n
if (key.eq.v(i)) then
ipos = i
return
end if
enddo
return
end if
lb = 1 lb = 1
ub = n ub = n
ipos = -1
do while (lb.le.ub) do while (lb.le.ub)
m = (lb+ub)/2 m = (lb+ub)/2
@ -166,7 +172,8 @@
function psb_issrch(key,n,v) result(ipos) function psb_issrch(key,n,v) result(ipos)
use psb_i_sort_mod, psb_protect_name => psb_issrch use psb_i_sort_mod, psb_protect_name => psb_issrch
implicit none implicit none
integer(psb_ipk_) :: ipos, key, n integer(psb_ipk_) :: ipos, n
integer(psb_ipk_) :: key
integer(psb_ipk_) :: v(:) integer(psb_ipk_) :: v(:)
integer(psb_ipk_) :: i integer(psb_ipk_) :: i
@ -182,56 +189,6 @@
return return
end function psb_issrch end function psb_issrch
subroutine psb_imsort_u(x,nout,dir)
use psb_i_sort_mod, psb_protect_name => psb_imsort_u
use psb_error_mod
implicit none
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(out) :: nout
integer(psb_ipk_), optional, intent(in) :: dir
integer(psb_ipk_) :: dir_, n, err_act, k
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name
name='psb_msort_u'
call psb_erractionsave(err_act)
if (present(dir)) then
dir_ = dir
else
dir_= psb_sort_up_
end if
select case(dir_)
case( psb_sort_up_, psb_sort_down_, psb_asort_up_, psb_asort_down_)
! OK keep going
case default
ierr(1) = 3; ierr(2) = dir_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999
end select
n = size(x)
call psb_imsort(x,dir=dir_)
nout = min(1,n)
do k=2,n
if (x(k) /= x(nout)) then
nout = nout + 1
x(nout) = x(k)
endif
enddo
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_imsort_u
subroutine psb_imsort(x,ix,dir,flag) subroutine psb_imsort(x,ix,dir,flag)
use psb_i_sort_mod, psb_protect_name => psb_imsort use psb_i_sort_mod, psb_protect_name => psb_imsort
use psb_error_mod use psb_error_mod

93
base/serial/sort/psb_s_msort_impl.f90
Unescape Escape View File

@ -41,6 +41,99 @@
! Addison-Wesley ! Addison-Wesley
! !
subroutine psb_smsort_u(x,nout,dir)
use psb_s_sort_mod, psb_protect_name => psb_smsort_u
use psb_error_mod
implicit none
real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(out) :: nout
integer(psb_ipk_), optional, intent(in) :: dir
integer(psb_ipk_) :: n, k
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name
name='psb_msort_u'
call psb_erractionsave(err_act)
n = size(x)
call psb_msort(x,dir=dir)
nout = min(1,n)
do k=2,n
if (x(k) /= x(nout)) then
nout = nout + 1
x(nout) = x(k)
endif
enddo
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_smsort_u
function psb_sbsrch(key,n,v) result(ipos)
use psb_s_sort_mod, psb_protect_name => psb_sbsrch
implicit none
integer(psb_ipk_) :: ipos, n
real(psb_spk_) :: key
real(psb_spk_) :: v(:)
integer(psb_ipk_) :: lb, ub, m, i
ipos = -1
if (n<5) then
do i=1,n
if (key.eq.v(i)) then
ipos = i
return
end if
enddo
return
end if
lb = 1
ub = n
do while (lb.le.ub)
m = (lb+ub)/2
if (key.eq.v(m)) then
ipos = m
lb = ub + 1
else if (key < v(m)) then
ub = m-1
else
lb = m + 1
end if
enddo
return
end function psb_sbsrch
function psb_sssrch(key,n,v) result(ipos)
use psb_s_sort_mod, psb_protect_name => psb_sssrch
implicit none
integer(psb_ipk_) :: ipos, n
real(psb_spk_) :: key
real(psb_spk_) :: v(:)
integer(psb_ipk_) :: i
ipos = -1
do i=1,n
if (key.eq.v(i)) then
ipos = i
return
end if
enddo
return
end function psb_sssrch
subroutine psb_smsort(x,ix,dir,flag) subroutine psb_smsort(x,ix,dir,flag)
use psb_s_sort_mod, psb_protect_name => psb_smsort use psb_s_sort_mod, psb_protect_name => psb_smsort
use psb_error_mod use psb_error_mod

35
base/serial/sort/psb_z_msort_impl.f90
Unescape Escape View File

@ -41,6 +41,41 @@
! Addison-Wesley ! Addison-Wesley
! !
subroutine psb_zmsort_u(x,nout,dir)
use psb_z_sort_mod, psb_protect_name => psb_zmsort_u
use psb_error_mod
implicit none
complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(out) :: nout
integer(psb_ipk_), optional, intent(in) :: dir
integer(psb_ipk_) :: n, k
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name
name='psb_msort_u'
call psb_erractionsave(err_act)
n = size(x)
call psb_msort(x,dir=dir)
nout = min(1,n)
do k=2,n
if (x(k) /= x(nout)) then
nout = nout + 1
x(nout) = x(k)
endif
enddo
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_zmsort_u

9568
configure vendored
View File

File diff suppressed because it is too large Load Diff

2
configure.ac
Unescape Escape View File

@ -393,7 +393,7 @@ if test "X$FCOPT" == "X" ; then
# other compilers .. # other compilers ..
FCOPT="-fast $FCOPT" FCOPT="-fast $FCOPT"
elif test "X$psblas_cv_fc" == X"cray" ; then elif test "X$psblas_cv_fc" == X"cray" ; then
FCOPT="-O3 -em $FCOPT" FCOPT="-O3 -em -J. $FCOPT"
elif test "X$psblas_cv_fc" == X"nag" ; then elif test "X$psblas_cv_fc" == X"nag" ; then
# NAG compiler .. # NAG compiler ..
FCOPT="-O2 " FCOPT="-O2 "

Write Preview
Loading…
Cancel
Save