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

First version of indx_map modules with LPK glob indices.

Browse Source
ILmat
Salvatore Filippone 8 years ago
parent d5ecddc3ba
commit 113281bc12
7 changed files with 1720 additions and 1566 deletions
Show Stats Download Patch File Download Diff File

44
base/modules/auxil/psb_hash_mod.f90
Unescape Escape View File

@ -83,6 +83,10 @@ module psb_hash_mod
module procedure psb_hash_searchinskey, psb_hash_lsearchinskey
end interface psb_hash_searchinskey
interface psb_hash_searchkey
module procedure psb_hash_searchkey, psb_hash_lsearchkey
end interface psb_hash_searchkey
interface psb_move_alloc
module procedure HashTransfer
end interface
@ -535,4 +539,44 @@ contains
end do
end subroutine psb_hash_searchkey
subroutine psb_hash_lsearchkey(key,val,hash,info)
integer(psb_lpk_), intent(in) :: key
type(psb_hash_type) :: hash
integer(psb_lpk_), intent(out) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: hsize,hmask, hk, hd
info = HashOK
if (.not.allocated(hash%table) ) then
val = HashFreeEntry
return
end if
hsize = hash%hsize
hmask = hash%hmask
hk = iand(hashval(key),hmask)
if (hk == 0) then
hd = 1
else
hd = hsize - hk
hd = ior(hd,1)
end if
hash%nsrch = hash%nsrch + 1
do
hash%nacc = hash%nacc + 1
if (hash%table(hk,1) == key) then
val = hash%table(hk,2)
return
end if
if (hash%table(hk,1) == HashFreeEntry) then
val = HashFreeEntry
! !$ info = HashNotFound
return
end if
hk = hk - hd
if (hk < 0) hk = hk + hsize
end do
end subroutine psb_hash_lsearchkey
end module psb_hash_mod

1975
base/modules/desc/psb_gen_block_map_mod.f90
View File

File diff suppressed because it is too large Load Diff

4
base/modules/desc/psb_glist_map_mod.f90
Unescape Escape View File

@ -153,12 +153,12 @@ contains
use psb_penv_mod
use psb_sort_mod
implicit none
integer(psb_ipk_), intent(in) :: idx(:)
integer(psb_lpk_), intent(in) :: idx(:)
integer(psb_ipk_), allocatable, intent(out) :: iprc(:)
class(psb_glist_map), intent(in) :: idxmap
integer(psb_ipk_), intent(out) :: info
integer(psb_mpk_) :: ictxt, iam, np
integer(psb_ipk_) :: nv, i, ngp
integer(psb_lpk_) :: nv, i, ngp
ictxt = idxmap%get_ctxt()
call psb_info(ictxt,iam,np)

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

@ -61,7 +61,8 @@ module psb_hash_map_mod
type, extends(psb_indx_map) :: psb_hash_map
integer(psb_ipk_) :: hashvsize, hashvmask
integer(psb_ipk_), allocatable :: hashv(:), glb_lc(:,:), loc_to_glob(:)
integer(psb_ipk_), allocatable :: hashv(:)
integer(psb_lpk_), allocatable :: glb_lc(:,:), loc_to_glob(:)
type(psb_hash_type) :: hash
contains
@ -78,20 +79,20 @@ module psb_hash_map_mod
procedure, nopass :: row_extendable => hash_row_extendable
procedure, pass(idxmap) :: l2gs1 => hash_l2gs1
procedure, pass(idxmap) :: l2gs2 => hash_l2gs2
procedure, pass(idxmap) :: l2gv1 => hash_l2gv1
procedure, pass(idxmap) :: l2gv2 => hash_l2gv2
procedure, pass(idxmap) :: ll2gs1 => hash_l2gs1
procedure, pass(idxmap) :: ll2gs2 => hash_l2gs2
procedure, pass(idxmap) :: ll2gv1 => hash_l2gv1
procedure, pass(idxmap) :: ll2gv2 => hash_l2gv2
procedure, pass(idxmap) :: g2ls1 => hash_g2ls1
procedure, pass(idxmap) :: g2ls2 => hash_g2ls2
procedure, pass(idxmap) :: g2lv1 => hash_g2lv1
procedure, pass(idxmap) :: g2lv2 => hash_g2lv2
procedure, pass(idxmap) :: lg2ls1 => hash_g2ls1
procedure, pass(idxmap) :: lg2ls2 => hash_g2ls2
procedure, pass(idxmap) :: lg2lv1 => hash_g2lv1
procedure, pass(idxmap) :: lg2lv2 => hash_g2lv2
procedure, pass(idxmap) :: g2ls1_ins => hash_g2ls1_ins
procedure, pass(idxmap) :: g2ls2_ins => hash_g2ls2_ins
procedure, pass(idxmap) :: g2lv1_ins => hash_g2lv1_ins
procedure, pass(idxmap) :: g2lv2_ins => hash_g2lv2_ins
procedure, pass(idxmap) :: lg2ls1_ins => hash_g2ls1_ins
procedure, pass(idxmap) :: lg2ls2_ins => hash_g2ls2_ins
procedure, pass(idxmap) :: lg2lv1_ins => hash_g2lv1_ins
procedure, pass(idxmap) :: lg2lv2_ins => hash_g2lv2_ins
procedure, pass(idxmap) :: hash_cpy
generic, public :: assignment(=) => hash_cpy
@ -159,11 +160,11 @@ contains
subroutine hash_l2gs1(idx,idxmap,info,mask,owned)
implicit none
class(psb_hash_map), intent(in) :: idxmap
integer(psb_ipk_), intent(inout) :: idx
integer(psb_lpk_), intent(inout) :: idx
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: mask
logical, intent(in), optional :: owned
integer(psb_ipk_) :: idxv(1)
integer(psb_lpk_) :: idxv(1)
info = 0
if (present(mask)) then
if (.not.mask) return
@ -179,13 +180,21 @@ contains
implicit none
class(psb_hash_map), intent(in) :: idxmap
integer(psb_ipk_), intent(in) :: idxin
integer(psb_ipk_), intent(out) :: idxout
integer(psb_lpk_), intent(out) :: idxout
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: mask
logical, intent(in), optional :: owned
idxout = idxin
call idxmap%l2gip(idxout,info,mask,owned)
integer(psb_lpk_) :: idxv(1)
info = 0
if (present(mask)) then
if (.not.mask) return
end if
idxv(1) = idxin
call idxmap%l2gip(idxv,info,owned=owned)
idxout = idxv(1)
end subroutine hash_l2gs2
@ -193,7 +202,7 @@ contains
subroutine hash_l2gv1(idx,idxmap,info,mask,owned)
implicit none
class(psb_hash_map), intent(in) :: idxmap
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_lpk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: mask(:)
logical, intent(in), optional :: owned
@ -249,7 +258,7 @@ contains
implicit none
class(psb_hash_map), intent(in) :: idxmap
integer(psb_ipk_), intent(in) :: idxin(:)
integer(psb_ipk_), intent(out) :: idxout(:)
integer(psb_lpk_), intent(out) :: idxout(:)
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: mask(:)
logical, intent(in), optional :: owned
@ -270,11 +279,11 @@ contains
subroutine hash_g2ls1(idx,idxmap,info,mask,owned)
implicit none
class(psb_hash_map), intent(in) :: idxmap
integer(psb_ipk_), intent(inout) :: idx
integer(psb_lpk_), intent(inout) :: idx
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: mask
logical, intent(in), optional :: owned
integer(psb_ipk_) :: idxv(1)
integer(psb_lpk_) :: idxv(1)
info = 0
if (present(mask)) then
@ -290,14 +299,21 @@ contains
subroutine hash_g2ls2(idxin,idxout,idxmap,info,mask,owned)
implicit none
class(psb_hash_map), intent(in) :: idxmap
integer(psb_ipk_), intent(in) :: idxin
integer(psb_lpk_), intent(in) :: idxin
integer(psb_ipk_), intent(out) :: idxout
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: mask
logical, intent(in), optional :: owned
integer(psb_lpk_) :: idxv(1)
info = 0
idxout = idxin
call idxmap%g2lip(idxout,info,mask,owned)
if (present(mask)) then
if (.not.mask) return
end if
idxv(1) = idxin
call idxmap%g2lip(idxv,info,owned=owned)
idxout = idxv(1)
end subroutine hash_g2ls2
@ -307,11 +323,12 @@ contains
use psb_sort_mod
implicit none
class(psb_hash_map), intent(in) :: idxmap
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_lpk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: mask(:)
logical, intent(in), optional :: owned
integer(psb_ipk_) :: i, is, mglob, ip, lip, nrow, ncol, nrm
integer(psb_ipk_) :: i, is, mglob, lip, nrow, nrm
integer(psb_lpk_) :: ncol, ip, tlip
integer(psb_mpk_) :: ictxt, iam, np
logical :: owned_
@ -358,8 +375,10 @@ contains
cycle
endif
call hash_inner_cnv(ip,lip,idxmap%hashvmask,idxmap%hashv,idxmap%glb_lc,nrm)
if (lip < 0) &
& call psb_hash_searchkey(ip,lip,idxmap%hash,info)
if (lip < 0) then
call psb_hash_searchkey(ip,tlip,idxmap%hash,info)
lip = tlip
end if
if (owned_) then
if (lip<=nrow) then
idx(i) = lip
@ -394,8 +413,10 @@ contains
cycle
endif
call hash_inner_cnv(ip,lip,idxmap%hashvmask,idxmap%hashv,idxmap%glb_lc,nrm)
if (lip < 0) &
& call psb_hash_searchkey(ip,lip,idxmap%hash,info)
if (lip < 0) then
call psb_hash_searchkey(ip,tlip,idxmap%hash,info)
lip = tlip
end if
if (owned_) then
if (lip<=nrow) then
idx(i) = lip
@ -421,18 +442,20 @@ contains
subroutine hash_g2lv2(idxin,idxout,idxmap,info,mask,owned)
implicit none
class(psb_hash_map), intent(in) :: idxmap
integer(psb_ipk_), intent(in) :: idxin(:)
integer(psb_lpk_), intent(in) :: idxin(:)
integer(psb_ipk_), intent(out) :: idxout(:)
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: mask(:)
logical, intent(in), optional :: owned
integer(psb_ipk_) :: is, im
integer(psb_lpk_), allocatable :: tidx(:)
is = size(idxin)
im = min(is,size(idxout))
idxout(1:im) = idxin(1:im)
call idxmap%g2lip(idxout(1:im),info,mask,owned)
call psb_realloc(im,tidx,info)
tidx(1:im) = idxin(1:im)
call idxmap%g2lip(tidx(1:im),info,mask,owned)
idxout(1:im) = tidx(1:im)
if (is > im) then
write(0,*) 'g2lv2 err -3'
info = -3
@ -447,12 +470,13 @@ contains
use psb_sort_mod
implicit none
class(psb_hash_map), intent(inout) :: idxmap
integer(psb_ipk_), intent(inout) :: idx
integer(psb_lpk_), intent(inout) :: idx
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: mask
integer(psb_ipk_), intent(in), optional :: lidx
integer(psb_ipk_) :: idxv(1), lidxv(1)
integer(psb_lpk_) :: idxv(1)
integer(psb_ipk_) :: lidxv(1)
info = 0
if (present(mask)) then
@ -473,15 +497,28 @@ contains
subroutine hash_g2ls2_ins(idxin,idxout,idxmap,info,mask,lidx)
implicit none
class(psb_hash_map), intent(inout) :: idxmap
integer(psb_ipk_), intent(in) :: idxin
integer(psb_lpk_), intent(in) :: idxin
integer(psb_ipk_), intent(out) :: idxout
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: mask
integer(psb_ipk_), intent(in), optional :: lidx
integer(psb_lpk_) :: idxv(1)
integer(psb_ipk_) :: lidxv(1)
info = 0
if (present(mask)) then
if (.not.mask) return
end if
idxout = idxin
call idxmap%g2lip_ins(idxout,info,mask=mask,lidx=lidx)
idxv(1) = idxin
if (present(lidx)) then
lidxv(1) = lidx
call idxmap%g2lip_ins(idxv,info,lidx=lidxv)
else
call idxmap%g2lip_ins(idxv,info)
end if
idxout = idxv(1)
end subroutine hash_g2ls2_ins
@ -493,13 +530,14 @@ contains
use psb_penv_mod
implicit none
class(psb_hash_map), intent(inout) :: idxmap
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_lpk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: mask(:)
integer(psb_ipk_), intent(in), optional :: lidx(:)
integer(psb_ipk_) :: i, is, mglob, ip, lip, nrow, ncol, &
& nxt, err_act
integer(psb_ipk_) :: i, is, lip, nrow, ncol, &
& err_act
integer(psb_lpk_) :: mglob, ip, nxt, tlip
integer(psb_ipk_) :: ictxt, me, np
character(len=20) :: name,ch_err
@ -540,18 +578,20 @@ contains
idx(i) = -1
cycle
endif
call hash_inner_cnv(ip,lip,idxmap%hashvmask,idxmap%hashv,idxmap%glb_lc,ncol)
if (lip < 0) then
call hash_inner_cnv(ip,lip,idxmap%hashvmask,&
& idxmap%hashv,idxmap%glb_lc,ncol)
if (lip < 0) then
tlip = lip
nxt = lidx(i)
if (nxt <= nrow) then
idx(i) = -1
cycle
endif
call psb_hash_searchinskey(ip,lip,nxt,idxmap%hash,info)
call psb_hash_searchinskey(ip,tlip,nxt,idxmap%hash,info)
if (info >=0) then
if (nxt == lip) then
if (nxt == tlip) then
ncol = max(ncol,nxt)
call psb_ensure_size(ncol,idxmap%loc_to_glob,info,pad=-ione,addsz=laddsz)
call psb_ensure_size(ncol,idxmap%loc_to_glob,info,pad=-1_psb_lpk_,addsz=laddsz)
if (info /= psb_success_) then
info=1
ch_err='psb_ensure_size'
@ -593,12 +633,13 @@ contains
idx(i) = -1
cycle
endif
call psb_hash_searchinskey(ip,lip,nxt,idxmap%hash,info)
call psb_hash_searchinskey(ip,tlip,nxt,idxmap%hash,info)
lip = tlip
if (info >=0) then
if (nxt == lip) then
ncol = max(nxt,ncol)
call psb_ensure_size(ncol,idxmap%loc_to_glob,info,pad=-ione,addsz=laddsz)
call psb_ensure_size(ncol,idxmap%loc_to_glob,info,pad=-1_psb_lpk_,addsz=laddsz)
if (info /= psb_success_) then
info=1
ch_err='psb_ensure_size'
@ -636,13 +677,15 @@ contains
endif
nxt = ncol + 1
call hash_inner_cnv(ip,lip,idxmap%hashvmask,idxmap%hashv,idxmap%glb_lc,ncol)
if (lip < 0) &
& call psb_hash_searchinskey(ip,lip,nxt,idxmap%hash,info)
if (lip < 0) then
call psb_hash_searchinskey(ip,tlip,nxt,idxmap%hash,info)
lip = tlip
end if
if (info >=0) then
if (nxt == lip) then
ncol = nxt
call psb_ensure_size(ncol,idxmap%loc_to_glob,info,pad=-ione,addsz=laddsz)
call psb_ensure_size(ncol,idxmap%loc_to_glob,info,pad=-1_psb_lpk_,addsz=laddsz)
if (info /= psb_success_) then
info=1
ch_err='psb_ensure_size'
@ -678,13 +721,15 @@ contains
endif
nxt = ncol + 1
call hash_inner_cnv(ip,lip,idxmap%hashvmask,idxmap%hashv,idxmap%glb_lc,ncol)
if (lip < 0) &
& call psb_hash_searchinskey(ip,lip,nxt,idxmap%hash,info)
if (lip < 0) then
call psb_hash_searchinskey(ip,tlip,nxt,idxmap%hash,info)
lip = tlip
end if
if (info >=0) then
if (nxt == lip) then
ncol = nxt
call psb_ensure_size(ncol,idxmap%loc_to_glob,info,pad=-ione,addsz=laddsz)
call psb_ensure_size(ncol,idxmap%loc_to_glob,info,pad=-1_psb_lpk_,addsz=laddsz)
if (info /= psb_success_) then
info=1
ch_err='psb_ensure_size'
@ -726,18 +771,20 @@ contains
subroutine hash_g2lv2_ins(idxin,idxout,idxmap,info,mask,lidx)
implicit none
class(psb_hash_map), intent(inout) :: idxmap
integer(psb_ipk_), intent(in) :: idxin(:)
integer(psb_lpk_), intent(in) :: idxin(:)
integer(psb_ipk_), intent(out) :: idxout(:)
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: mask(:)
integer(psb_ipk_), intent(in), optional :: lidx(:)
integer(psb_lpk_), allocatable :: tidx(:)
integer(psb_ipk_) :: is, im
is = size(idxin)
im = min(is,size(idxout))
idxout(1:im) = idxin(1:im)
call idxmap%g2lip_ins(idxout(1:im),info,mask=mask,lidx=lidx)
call psb_realloc(im,tidx,info)
tidx(1:im) = idxin(1:im)
call idxmap%g2lip_ins(tidx(1:im),info,mask=mask,lidx=lidx)
idxout(1:im) = tidx(1:im)
if (is > im) then
write(0,*) 'g2lv2_ins err -3'
info = -3
@ -756,12 +803,14 @@ contains
implicit none
class(psb_hash_map), intent(inout) :: idxmap
integer(psb_mpk_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: vl(:)
integer(psb_lpk_), intent(in) :: vl(:)
integer(psb_ipk_), intent(out) :: info
! To be implemented
integer(psb_mpk_) :: iam, np
integer(psb_ipk_) :: i, nlu, nl, m, nrt,int_err(5)
integer(psb_ipk_), allocatable :: vlu(:), ix(:)
integer(psb_ipk_) :: i, nlu, nl, nrt,int_err(5)
integer(psb_lpk_) :: m
integer(psb_lpk_), allocatable :: vlu(:)
integer(psb_lpk_), allocatable :: ix(:)
character(len=20), parameter :: name='hash_map_init_vl'
info = 0
@ -831,8 +880,9 @@ contains
integer(psb_ipk_), intent(out) :: info
! To be implemented
integer(psb_mpk_) :: iam, np
integer(psb_ipk_) :: i, j, nl, n, int_err(5)
integer(psb_ipk_), allocatable :: vlu(:)
integer(psb_ipk_) :: i, j, nl, int_err(5)
integer(psb_lpk_) :: n
integer(psb_lpk_), allocatable :: vlu(:)
info = 0
call psb_info(ictxt,iam,np)
@ -886,7 +936,8 @@ contains
implicit none
class(psb_hash_map), intent(inout) :: idxmap
integer(psb_mpk_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: vlu(:), nl, ntot
integer(psb_lpk_), intent(in) :: vlu(:), ntot
integer(psb_ipk_), intent(in) :: nl
integer(psb_ipk_), intent(out) :: info
! To be implemented
integer(psb_mpk_) :: iam, np
@ -1127,8 +1178,8 @@ contains
end subroutine hash_inner_cnvs1
subroutine hash_inner_cnvs2(x,y,hashmask,hashv,glb_lc,nrm)
integer(psb_ipk_), intent(in) :: hashmask,hashv(0:),glb_lc(:,:)
integer(psb_ipk_), intent(in) :: x
integer(psb_ipk_), intent(in) :: hashmask,hashv(0:)
integer(psb_lpk_), intent(in) :: x, glb_lc(:,:)
integer(psb_ipk_), intent(out) :: y
integer(psb_ipk_), intent(in) :: nrm
integer(psb_ipk_) :: ih, key, idx,nh,tmp,lb,ub,lm
@ -1175,10 +1226,11 @@ contains
subroutine hash_inner_cnv1(n,x,hashmask,hashv,glb_lc,mask,nrm)
integer(psb_ipk_), intent(in) :: n,hashmask,hashv(0:),glb_lc(:,:)
integer(psb_ipk_), intent(in) :: n,hashmask,hashv(0:)
integer(psb_lpk_), intent(in) :: glb_lc(:,:)
logical, intent(in), optional :: mask(:)
integer(psb_ipk_), intent(in), optional :: nrm
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_lpk_), intent(inout) :: x(:)
integer(psb_ipk_) :: i, ih, key, idx,nh,tmp,lb,ub,lm
!
@ -1460,9 +1512,11 @@ contains
implicit none
class(psb_hash_map), intent(inout) :: idxmap
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act, nr,nc,k, nl, ntot
integer(psb_ipk_) :: err_act, nr,nc,k, nl
integer(psb_lpk_) :: ntot
integer(psb_mpk_) :: ictxt, me, np
integer(psb_ipk_), allocatable :: idx(:),lidx(:)
integer(psb_ipk_), allocatable :: lidx(:)
integer(psb_lpk_), allocatable :: idx(:)
character(len=20) :: name='hash_reinit'
logical, parameter :: debug=.false.

52
base/modules/desc/psb_indx_map_mod.f90
Unescape Escape View File

@ -167,38 +167,44 @@ module psb_indx_map_mod
procedure, pass(idxmap) :: clone => base_clone
procedure, pass(idxmap) :: reinit => base_reinit
procedure, pass(idxmap) :: l2gs1 => base_l2gs1
procedure, pass(idxmap) :: l2gs2 => base_l2gs2
procedure, pass(idxmap) :: l2gv1 => base_l2gv1
procedure, pass(idxmap) :: l2gv2 => base_l2gv2
!!$ procedure, pass(idxmap) :: l2gs1 => base_l2gs1
!!$ procedure, pass(idxmap) :: l2gs2 => base_l2gs2
!!$ procedure, pass(idxmap) :: l2gv1 => base_l2gv1
!!$ procedure, pass(idxmap) :: l2gv2 => base_l2gv2
procedure, pass(idxmap) :: ll2gs1 => base_ll2gs1
procedure, pass(idxmap) :: ll2gs2 => base_ll2gs2
procedure, pass(idxmap) :: ll2gv1 => base_ll2gv1
procedure, pass(idxmap) :: ll2gv2 => base_ll2gv2
generic, public :: l2g => l2gs2, l2gv2, ll2gs2, ll2gv2
generic, public :: l2gip => l2gs1, l2gv1, ll2gs1, ll2gv1
procedure, pass(idxmap) :: g2ls1 => base_g2ls1
procedure, pass(idxmap) :: g2ls2 => base_g2ls2
procedure, pass(idxmap) :: g2lv1 => base_g2lv1
procedure, pass(idxmap) :: g2lv2 => base_g2lv2
!!$ generic, public :: l2g => l2gs2, l2gv2
!!$ generic, public :: l2gip => l2gs1, l2gv1
generic, public :: l2g => ll2gs2, ll2gv2
generic, public :: l2gip => ll2gs1, ll2gv1
!!$ procedure, pass(idxmap) :: g2ls1 => base_g2ls1
!!$ procedure, pass(idxmap) :: g2ls2 => base_g2ls2
!!$ procedure, pass(idxmap) :: g2lv1 => base_g2lv1
!!$ procedure, pass(idxmap) :: g2lv2 => base_g2lv2
procedure, pass(idxmap) :: lg2ls1 => base_lg2ls1
procedure, pass(idxmap) :: lg2ls2 => base_lg2ls2
procedure, pass(idxmap) :: lg2lv1 => base_lg2lv1
procedure, pass(idxmap) :: lg2lv2 => base_lg2lv2
generic, public :: g2l => g2ls2, g2lv2, lg2ls2, lg2lv2
generic, public :: g2lip => g2ls1, g2lv1, lg2ls1, lg2lv1
procedure, pass(idxmap) :: g2ls1_ins => base_g2ls1_ins
procedure, pass(idxmap) :: g2ls2_ins => base_g2ls2_ins
procedure, pass(idxmap) :: g2lv1_ins => base_g2lv1_ins
procedure, pass(idxmap) :: g2lv2_ins => base_g2lv2_ins
!!$ generic, public :: g2l => g2ls2, g2lv2
!!$ generic, public :: g2lip => g2ls1, g2lv1
generic, public :: g2l => lg2ls2, lg2lv2
generic, public :: g2lip => lg2ls1, lg2lv1
!!$ procedure, pass(idxmap) :: g2ls1_ins => base_g2ls1_ins
!!$ procedure, pass(idxmap) :: g2ls2_ins => base_g2ls2_ins
!!$ procedure, pass(idxmap) :: g2lv1_ins => base_g2lv1_ins
!!$ procedure, pass(idxmap) :: g2lv2_ins => base_g2lv2_ins
procedure, pass(idxmap) :: lg2ls1_ins => base_lg2ls1_ins
procedure, pass(idxmap) :: lg2ls2_ins => base_lg2ls2_ins
procedure, pass(idxmap) :: lg2lv1_ins => base_lg2lv1_ins
procedure, pass(idxmap) :: lg2lv2_ins => base_lg2lv2_ins
generic, public :: g2l_ins => g2ls2_ins, g2lv2_ins, lg2ls2_ins, lg2lv2_ins
generic, public :: g2lip_ins => g2ls1_ins, g2lv1_ins, lg2ls1_ins, lg2lv1_ins
!!$ generic, public :: g2l_ins => g2ls2_ins, g2lv2_ins
!!$ generic, public :: g2lip_ins => g2ls1_ins, g2lv1_ins
generic, public :: g2l_ins => lg2ls2_ins, lg2lv2_ins
generic, public :: g2lip_ins => lg2ls1_ins, lg2lv1_ins
procedure, pass(idxmap) :: fnd_owner => psb_indx_map_fnd_owner
procedure, pass(idxmap) :: init_vl => base_init_vl
@ -242,9 +248,9 @@ module psb_indx_map_mod
interface
subroutine psb_indx_map_fnd_owner(idx,iprc,idxmap,info)
import :: psb_indx_map, psb_ipk_
import :: psb_indx_map, psb_ipk_, psb_lpk_
implicit none
integer(psb_ipk_), intent(in) :: idx(:)
integer(psb_lpk_), intent(in) :: idx(:)
integer(psb_ipk_), allocatable, intent(out) :: iprc(:)
class(psb_indx_map), intent(in) :: idxmap
integer(psb_ipk_), intent(out) :: info
@ -1150,7 +1156,7 @@ contains
implicit none
class(psb_indx_map), intent(inout) :: idxmap
integer(psb_mpk_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: vl(:)
integer(psb_lpk_), intent(in) :: vl(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='base_init_vl'

893
base/modules/desc/psb_list_map_mod.f90
Unescape Escape View File

@ -49,9 +49,7 @@ module psb_list_map_mod
integer(psb_lpk_), allocatable :: loc_to_glob(:)
integer(psb_ipk_), allocatable :: glob_to_loc(:)
contains
procedure, pass(idxmap) :: init_vl => list_initvl
procedure, pass(idxmap) :: init_lvl => list_initlvl
procedure, pass(idxmap) :: init_vl => list_initlvl
procedure, pass(idxmap) :: sizeof => list_sizeof
procedure, pass(idxmap) :: asb => list_asb
@ -61,30 +59,30 @@ module psb_list_map_mod
procedure, nopass :: get_fmt => list_get_fmt
procedure, nopass :: row_extendable => list_row_extendable
procedure, pass(idxmap) :: l2gs1 => list_l2gs1
procedure, pass(idxmap) :: l2gs2 => list_l2gs2
procedure, pass(idxmap) :: l2gv1 => list_l2gv1
procedure, pass(idxmap) :: l2gv2 => list_l2gv2
!!$ procedure, pass(idxmap) :: l2gs1 => list_l2gs1
!!$ procedure, pass(idxmap) :: l2gs2 => list_l2gs2
!!$ procedure, pass(idxmap) :: l2gv1 => list_l2gv1
!!$ procedure, pass(idxmap) :: l2gv2 => list_l2gv2
procedure, pass(idxmap) :: ll2gs1 => list_ll2gs1
procedure, pass(idxmap) :: ll2gs2 => list_ll2gs2
procedure, pass(idxmap) :: ll2gv1 => list_ll2gv1
procedure, pass(idxmap) :: ll2gv2 => list_ll2gv2
procedure, pass(idxmap) :: g2ls1 => list_g2ls1
procedure, pass(idxmap) :: g2ls2 => list_g2ls2
procedure, pass(idxmap) :: g2lv1 => list_g2lv1
procedure, pass(idxmap) :: g2lv2 => list_g2lv2
!!$ procedure, pass(idxmap) :: g2ls1 => list_g2ls1
!!$ procedure, pass(idxmap) :: g2ls2 => list_g2ls2
!!$ procedure, pass(idxmap) :: g2lv1 => list_g2lv1
!!$ procedure, pass(idxmap) :: g2lv2 => list_g2lv2
procedure, pass(idxmap) :: lg2ls1 => list_lg2ls1
procedure, pass(idxmap) :: lg2ls2 => list_lg2ls2
procedure, pass(idxmap) :: lg2lv1 => list_lg2lv1
procedure, pass(idxmap) :: lg2lv2 => list_lg2lv2
procedure, pass(idxmap) :: g2ls1_ins => list_g2ls1_ins
procedure, pass(idxmap) :: g2ls2_ins => list_g2ls2_ins
procedure, pass(idxmap) :: g2lv1_ins => list_g2lv1_ins
procedure, pass(idxmap) :: g2lv2_ins => list_g2lv2_ins
!!$ procedure, pass(idxmap) :: g2ls1_ins => list_g2ls1_ins
!!$ procedure, pass(idxmap) :: g2ls2_ins => list_g2ls2_ins
!!$ procedure, pass(idxmap) :: g2lv1_ins => list_g2lv1_ins
!!$ procedure, pass(idxmap) :: g2lv2_ins => list_g2lv2_ins
procedure, pass(idxmap) :: lg2ls1_ins => list_lg2ls1_ins
procedure, pass(idxmap) :: lg2ls2_ins => list_lg2ls2_ins
@ -138,113 +136,113 @@ contains
end subroutine list_free
subroutine list_l2gs1(idx,idxmap,info,mask,owned)
implicit none
class(psb_list_map), intent(in) :: idxmap
integer(psb_ipk_), intent(inout) :: idx
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: mask
logical, intent(in), optional :: owned
integer(psb_ipk_) :: idxv(1)
info = 0
if (present(mask)) then
if (.not.mask) return
end if
idxv(1) = idx
call idxmap%l2gip(idxv,info,owned=owned)
idx = idxv(1)
end subroutine list_l2gs1
subroutine list_l2gs2(idxin,idxout,idxmap,info,mask,owned)
implicit none
class(psb_list_map), intent(in) :: idxmap
integer(psb_ipk_), intent(in) :: idxin
integer(psb_ipk_), intent(out) :: idxout
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: mask
logical, intent(in), optional :: owned
idxout = idxin
call idxmap%l2gip(idxout,info,mask,owned)
end subroutine list_l2gs2
subroutine list_l2gv1(idx,idxmap,info,mask,owned)
implicit none
class(psb_list_map), intent(in) :: idxmap
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: mask(:)
logical, intent(in), optional :: owned
integer(psb_ipk_) :: i
logical :: owned_
info = 0
if (present(mask)) then
if (size(mask) < size(idx)) then
info = -1
return
end if
end if
if (present(owned)) then
owned_ = owned
else
owned_ = .false.
end if
if (present(mask)) then
do i=1, size(idx)
if (mask(i)) then
if ((1<=idx(i)).and.(idx(i) <= idxmap%get_lr())) then
idx(i) = idxmap%loc_to_glob(idx(i))
else if ((idxmap%get_lr() < idx(i)).and.(idx(i) <= idxmap%local_cols)&
& .and.(.not.owned_)) then
idx(i) = idxmap%loc_to_glob(idx(i))
else
idx(i) = -1
end if
end if
end do
else if (.not.present(mask)) then
do i=1, size(idx)
if ((1<=idx(i)).and.(idx(i) <= idxmap%get_lr())) then
idx(i) = idxmap%loc_to_glob(idx(i))
else if ((idxmap%get_lr() < idx(i)).and.(idx(i) <= idxmap%local_cols)&
& .and.(.not.owned_)) then
idx(i) = idxmap%loc_to_glob(idx(i))
else
idx(i) = -1
end if
end do
end if
end subroutine list_l2gv1
subroutine list_l2gv2(idxin,idxout,idxmap,info,mask,owned)
implicit none
class(psb_list_map), intent(in) :: idxmap
integer(psb_ipk_), intent(in) :: idxin(:)
integer(psb_ipk_), intent(out) :: idxout(:)
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: mask(:)
logical, intent(in), optional :: owned
integer(psb_ipk_) :: is, im
is = size(idxin)
im = min(is,size(idxout))
idxout(1:im) = idxin(1:im)
call idxmap%l2gip(idxout(1:im),info,mask,owned)
if (is > im) info = -3
end subroutine list_l2gv2
!!$ subroutine list_l2gs1(idx,idxmap,info,mask,owned)
!!$ implicit none
!!$ class(psb_list_map), intent(in) :: idxmap
!!$ integer(psb_ipk_), intent(inout) :: idx
!!$ integer(psb_ipk_), intent(out) :: info
!!$ logical, intent(in), optional :: mask
!!$ logical, intent(in), optional :: owned
!!$ integer(psb_ipk_) :: idxv(1)
!!$ info = 0
!!$ if (present(mask)) then
!!$ if (.not.mask) return
!!$ end if
!!$
!!$ idxv(1) = idx
!!$ call idxmap%l2gip(idxv,info,owned=owned)
!!$ idx = idxv(1)
!!$
!!$ end subroutine list_l2gs1
!!$
!!$ subroutine list_l2gs2(idxin,idxout,idxmap,info,mask,owned)
!!$ implicit none
!!$ class(psb_list_map), intent(in) :: idxmap
!!$ integer(psb_ipk_), intent(in) :: idxin
!!$ integer(psb_ipk_), intent(out) :: idxout
!!$ integer(psb_ipk_), intent(out) :: info
!!$ logical, intent(in), optional :: mask
!!$ logical, intent(in), optional :: owned
!!$
!!$ idxout = idxin
!!$ call idxmap%l2gip(idxout,info,mask,owned)
!!$
!!$ end subroutine list_l2gs2
!!$
!!$
!!$ subroutine list_l2gv1(idx,idxmap,info,mask,owned)
!!$ implicit none
!!$ class(psb_list_map), intent(in) :: idxmap
!!$ integer(psb_ipk_), intent(inout) :: idx(:)
!!$ integer(psb_ipk_), intent(out) :: info
!!$ logical, intent(in), optional :: mask(:)
!!$ logical, intent(in), optional :: owned
!!$ integer(psb_ipk_) :: i
!!$ logical :: owned_
!!$ info = 0
!!$
!!$ if (present(mask)) then
!!$ if (size(mask) < size(idx)) then
!!$ info = -1
!!$ return
!!$ end if
!!$ end if
!!$ if (present(owned)) then
!!$ owned_ = owned
!!$ else
!!$ owned_ = .false.
!!$ end if
!!$
!!$ if (present(mask)) then
!!$
!!$ do i=1, size(idx)
!!$ if (mask(i)) then
!!$ if ((1<=idx(i)).and.(idx(i) <= idxmap%get_lr())) then
!!$ idx(i) = idxmap%loc_to_glob(idx(i))
!!$ else if ((idxmap%get_lr() < idx(i)).and.(idx(i) <= idxmap%local_cols)&
!!$ & .and.(.not.owned_)) then
!!$ idx(i) = idxmap%loc_to_glob(idx(i))
!!$ else
!!$ idx(i) = -1
!!$ end if
!!$ end if
!!$ end do
!!$
!!$ else if (.not.present(mask)) then
!!$
!!$ do i=1, size(idx)
!!$ if ((1<=idx(i)).and.(idx(i) <= idxmap%get_lr())) then
!!$ idx(i) = idxmap%loc_to_glob(idx(i))
!!$ else if ((idxmap%get_lr() < idx(i)).and.(idx(i) <= idxmap%local_cols)&
!!$ & .and.(.not.owned_)) then
!!$ idx(i) = idxmap%loc_to_glob(idx(i))
!!$ else
!!$ idx(i) = -1
!!$ end if
!!$ end do
!!$
!!$ end if
!!$
!!$ end subroutine list_l2gv1
!!$
!!$ subroutine list_l2gv2(idxin,idxout,idxmap,info,mask,owned)
!!$ implicit none
!!$ class(psb_list_map), intent(in) :: idxmap
!!$ integer(psb_ipk_), intent(in) :: idxin(:)
!!$ integer(psb_ipk_), intent(out) :: idxout(:)
!!$ integer(psb_ipk_), intent(out) :: info
!!$ logical, intent(in), optional :: mask(:)
!!$ logical, intent(in), optional :: owned
!!$ integer(psb_ipk_) :: is, im
!!$
!!$ is = size(idxin)
!!$ im = min(is,size(idxout))
!!$ idxout(1:im) = idxin(1:im)
!!$ call idxmap%l2gip(idxout(1:im),info,mask,owned)
!!$ if (is > im) info = -3
!!$
!!$ end subroutine list_l2gv2
!!$
subroutine list_ll2gs1(idx,idxmap,info,mask,owned)
implicit none
@ -353,126 +351,126 @@ contains
end subroutine list_ll2gv2
subroutine list_g2ls1(idx,idxmap,info,mask,owned)
implicit none
class(psb_list_map), intent(in) :: idxmap
integer(psb_ipk_), intent(inout) :: idx
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: mask
logical, intent(in), optional :: owned
integer(psb_ipk_) :: idxv(1)
info = 0
if (present(mask)) then
if (.not.mask) return
end if
idxv(1) = idx
call idxmap%g2lip(idxv,info,owned=owned)
idx = idxv(1)
end subroutine list_g2ls1
subroutine list_g2ls2(idxin,idxout,idxmap,info,mask,owned)
implicit none
class(psb_list_map), intent(in) :: idxmap
integer(psb_ipk_), intent(in) :: idxin
integer(psb_ipk_), intent(out) :: idxout
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: mask
logical, intent(in), optional :: owned
idxout = idxin
call idxmap%g2lip(idxout,info,mask,owned)
end subroutine list_g2ls2
subroutine list_g2lv1(idx,idxmap,info,mask,owned)
use psb_sort_mod
implicit none
class(psb_list_map), intent(in) :: idxmap
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: mask(:)
logical, intent(in), optional :: owned
integer(psb_ipk_) :: i, is, ix
logical :: owned_
info = 0
if (present(mask)) then
if (size(mask) < size(idx)) then
info = -1
return
end if
end if
if (present(owned)) then
owned_ = owned
else
owned_ = .false.
end if
is = size(idx)
if (present(mask)) then
if (idxmap%is_valid()) then
do i=1,is
if (mask(i)) then
if ((1 <= idx(i)).and.(idx(i) <= idxmap%global_rows)) then
ix = idxmap%glob_to_loc(idx(i))
if ((ix > idxmap%get_lr()).and.(owned_)) ix = -1
idx(i) = ix
else
idx(i) = -1
end if
end if
end do
else
idx(1:is) = -1
info = -1
end if
else if (.not.present(mask)) then
if (idxmap%is_valid()) then
do i=1, is
if ((1 <= idx(i)).and.(idx(i) <= idxmap%global_rows)) then
ix = idxmap%glob_to_loc(idx(i))
if ((ix > idxmap%get_lr()).and.(owned_)) ix = -1
idx(i) = ix
else
idx(i) = -1
end if
end do
else
idx(1:is) = -1
info = -1
end if
end if
end subroutine list_g2lv1
subroutine list_g2lv2(idxin,idxout,idxmap,info,mask,owned)
implicit none
class(psb_list_map), intent(in) :: idxmap
integer(psb_ipk_), intent(in) :: idxin(:)
integer(psb_ipk_), intent(out) :: idxout(:)
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: mask(:)
logical, intent(in), optional :: owned
integer(psb_ipk_) :: is, im
is = size(idxin)
im = min(is,size(idxout))
idxout(1:im) = idxin(1:im)
call idxmap%g2lip(idxout(1:im),info,mask,owned)
if (is > im) info = -3
end subroutine list_g2lv2
!!$
!!$ subroutine list_g2ls1(idx,idxmap,info,mask,owned)
!!$ implicit none
!!$ class(psb_list_map), intent(in) :: idxmap
!!$ integer(psb_ipk_), intent(inout) :: idx
!!$ integer(psb_ipk_), intent(out) :: info
!!$ logical, intent(in), optional :: mask
!!$ logical, intent(in), optional :: owned
!!$ integer(psb_ipk_) :: idxv(1)
!!$ info = 0
!!$
!!$ if (present(mask)) then
!!$ if (.not.mask) return
!!$ end if
!!$
!!$ idxv(1) = idx
!!$ call idxmap%g2lip(idxv,info,owned=owned)
!!$ idx = idxv(1)
!!$
!!$ end subroutine list_g2ls1
!!$
!!$ subroutine list_g2ls2(idxin,idxout,idxmap,info,mask,owned)
!!$ implicit none
!!$ class(psb_list_map), intent(in) :: idxmap
!!$ integer(psb_ipk_), intent(in) :: idxin
!!$ integer(psb_ipk_), intent(out) :: idxout
!!$ integer(psb_ipk_), intent(out) :: info
!!$ logical, intent(in), optional :: mask
!!$ logical, intent(in), optional :: owned
!!$
!!$ idxout = idxin
!!$ call idxmap%g2lip(idxout,info,mask,owned)
!!$
!!$ end subroutine list_g2ls2
!!$
!!$
!!$ subroutine list_g2lv1(idx,idxmap,info,mask,owned)
!!$ use psb_sort_mod
!!$ implicit none
!!$ class(psb_list_map), intent(in) :: idxmap
!!$ integer(psb_ipk_), intent(inout) :: idx(:)
!!$ integer(psb_ipk_), intent(out) :: info
!!$ logical, intent(in), optional :: mask(:)
!!$ logical, intent(in), optional :: owned
!!$ integer(psb_ipk_) :: i, is, ix
!!$ logical :: owned_
!!$
!!$ info = 0
!!$
!!$ if (present(mask)) then
!!$ if (size(mask) < size(idx)) then
!!$ info = -1
!!$ return
!!$ end if
!!$ end if
!!$ if (present(owned)) then
!!$ owned_ = owned
!!$ else
!!$ owned_ = .false.
!!$ end if
!!$
!!$ is = size(idx)
!!$
!!$ if (present(mask)) then
!!$ if (idxmap%is_valid()) then
!!$ do i=1,is
!!$ if (mask(i)) then
!!$ if ((1 <= idx(i)).and.(idx(i) <= idxmap%global_rows)) then
!!$ ix = idxmap%glob_to_loc(idx(i))
!!$ if ((ix > idxmap%get_lr()).and.(owned_)) ix = -1
!!$ idx(i) = ix
!!$ else
!!$ idx(i) = -1
!!$ end if
!!$ end if
!!$ end do
!!$ else
!!$ idx(1:is) = -1
!!$ info = -1
!!$ end if
!!$
!!$ else if (.not.present(mask)) then
!!$
!!$ if (idxmap%is_valid()) then
!!$ do i=1, is
!!$ if ((1 <= idx(i)).and.(idx(i) <= idxmap%global_rows)) then
!!$ ix = idxmap%glob_to_loc(idx(i))
!!$ if ((ix > idxmap%get_lr()).and.(owned_)) ix = -1
!!$ idx(i) = ix
!!$ else
!!$ idx(i) = -1
!!$ end if
!!$ end do
!!$ else
!!$ idx(1:is) = -1
!!$ info = -1
!!$ end if
!!$
!!$ end if
!!$
!!$ end subroutine list_g2lv1
!!$
!!$ subroutine list_g2lv2(idxin,idxout,idxmap,info,mask,owned)
!!$ implicit none
!!$ class(psb_list_map), intent(in) :: idxmap
!!$ integer(psb_ipk_), intent(in) :: idxin(:)
!!$ integer(psb_ipk_), intent(out) :: idxout(:)
!!$ integer(psb_ipk_), intent(out) :: info
!!$ logical, intent(in), optional :: mask(:)
!!$ logical, intent(in), optional :: owned
!!$
!!$ integer(psb_ipk_) :: is, im
!!$
!!$ is = size(idxin)
!!$ im = min(is,size(idxout))
!!$ idxout(1:im) = idxin(1:im)
!!$ call idxmap%g2lip(idxout(1:im),info,mask,owned)
!!$ if (is > im) info = -3
!!$
!!$ end subroutine list_g2lv2
@ -610,18 +608,221 @@ contains
end subroutine list_lg2lv2
!!$ subroutine list_g2ls1_ins(idx,idxmap,info,mask,lidx)
!!$ use psb_realloc_mod
!!$ use psb_sort_mod
!!$ implicit none
!!$ class(psb_list_map), intent(inout) :: idxmap
!!$ integer(psb_ipk_), intent(inout) :: idx
!!$ integer(psb_ipk_), intent(out) :: info
!!$ logical, intent(in), optional :: mask
!!$ integer(psb_ipk_), intent(in), optional :: lidx
!!$
!!$ integer(psb_ipk_) :: idxv(1), lidxv(1)
!!$
!!$ info = 0
!!$ if (present(mask)) then
!!$ if (.not.mask) return
!!$ end if
!!$ idxv(1) = idx
!!$ if (present(lidx)) then
!!$ lidxv(1) = lidx
!!$ call idxmap%g2lip_ins(idxv,info,lidx=lidxv)
!!$ else
!!$ call idxmap%g2lip_ins(idxv,info)
!!$ end if
!!$
!!$ idx = idxv(1)
!!$
!!$ end subroutine list_g2ls1_ins
!!$
!!$ subroutine list_g2ls2_ins(idxin,idxout,idxmap,info,mask,lidx)
!!$ implicit none
!!$ class(psb_list_map), intent(inout) :: idxmap
!!$ integer(psb_ipk_), intent(in) :: idxin
!!$ integer(psb_ipk_), intent(out) :: idxout
!!$ integer(psb_ipk_), intent(out) :: info
!!$ logical, intent(in), optional :: mask
!!$ integer(psb_ipk_), intent(in), optional :: lidx
!!$
!!$ idxout = idxin
!!$ call idxmap%g2lip_ins(idxout,info,mask=mask,lidx=lidx)
!!$
!!$ end subroutine list_g2ls2_ins
!!$
!!$
!!$ subroutine list_g2lv1_ins(idx,idxmap,info,mask,lidx)
!!$ use psb_realloc_mod
!!$ use psb_sort_mod
!!$ implicit none
!!$ class(psb_list_map), intent(inout) :: idxmap
!!$ integer(psb_ipk_), intent(inout) :: idx(:)
!!$ integer(psb_ipk_), intent(out) :: info
!!$ logical, intent(in), optional :: mask(:)
!!$ integer(psb_ipk_), intent(in), optional :: lidx(:)
!!$
!!$ integer(psb_ipk_) :: i, is, ix, lix
!!$
!!$ info = 0
!!$ is = size(idx)
!!$
!!$ if (present(mask)) then
!!$ if (size(mask) < size(idx)) then
!!$ info = -1
!!$ return
!!$ end if
!!$ end if
!!$ if (present(lidx)) then
!!$ if (size(lidx) < size(idx)) then
!!$ info = -1
!!$ return
!!$ end if
!!$ end if
!!$
!!$
!!$ if (idxmap%is_asb()) then
!!$ ! State is wrong for this one !
!!$ idx = -1
!!$ info = -1
!!$
!!$ else if (idxmap%is_valid()) then
!!$
!!$ if (present(lidx)) then
!!$ if (present(mask)) then
!!$ do i=1, is
!!$ if (mask(i)) then
!!$ if ((1<= idx(i)).and.(idx(i) <= idxmap%global_rows)) then
!!$ ix = idxmap%glob_to_loc(idx(i))
!!$ if (ix < 0) then
!!$ ix = lidx(i)
!!$ call psb_ensure_size(ix,idxmap%loc_to_glob,info,addsz=laddsz)
!!$ if ((ix <= idxmap%local_rows).or.(info /= 0)) then
!!$ info = -4
!!$ return
!!$ end if
!!$ idxmap%local_cols = max(ix,idxmap%local_cols)
!!$ idxmap%loc_to_glob(ix) = idx(i)
!!$ idxmap%glob_to_loc(idx(i)) = ix
!!$ end if
!!$ idx(i) = ix
!!$ else
!!$ idx(i) = -1
!!$ end if
!!$ end if
!!$ end do
!!$
!!$ else if (.not.present(mask)) then
!!$
!!$ do i=1, is
!!$ if ((1<= idx(i)).and.(idx(i) <= idxmap%global_rows)) then
!!$ ix = idxmap%glob_to_loc(idx(i))
!!$ if (ix < 0) then
!!$ ix = lidx(i)
!!$ call psb_ensure_size(ix,idxmap%loc_to_glob,info,addsz=laddsz)
!!$ if ((ix <= idxmap%local_rows).or.(info /= 0)) then
!!$ info = -4
!!$ return
!!$ end if
!!$ idxmap%local_cols = max(ix,idxmap%local_cols)
!!$ idxmap%loc_to_glob(ix) = idx(i)
!!$ idxmap%glob_to_loc(idx(i)) = ix
!!$ end if
!!$ idx(i) = ix
!!$ else
!!$ idx(i) = -1
!!$ end if
!!$ end do
!!$ end if
!!$
!!$ else if (.not.present(lidx)) then
!!$
!!$ if (present(mask)) then
!!$ do i=1, is
!!$ if (mask(i)) then
!!$ if ((1<= idx(i)).and.(idx(i) <= idxmap%global_rows)) then
!!$ ix = idxmap%glob_to_loc(idx(i))
!!$ if (ix < 0) then
!!$ ix = idxmap%local_cols + 1
!!$ call psb_ensure_size(ix,idxmap%loc_to_glob,info,addsz=laddsz)
!!$ if (info /= 0) then
!!$ info = -4
!!$ return
!!$ end if
!!$ idxmap%local_cols = ix
!!$ idxmap%loc_to_glob(ix) = idx(i)
!!$ idxmap%glob_to_loc(idx(i)) = ix
!!$ end if
!!$ idx(i) = ix
!!$ else
!!$ idx(i) = -1
!!$ end if
!!$ end if
!!$ end do
!!$
!!$ else if (.not.present(mask)) then
!!$
!!$ do i=1, is
!!$ if ((1<= idx(i)).and.(idx(i) <= idxmap%global_rows)) then
!!$ ix = idxmap%glob_to_loc(idx(i))
!!$ if (ix < 0) then
!!$ ix = idxmap%local_cols + 1
!!$ call psb_ensure_size(ix,idxmap%loc_to_glob,info,addsz=laddsz)
!!$ if (info /= 0) then
!!$ info = -4
!!$ return
!!$ end if
!!$ idxmap%local_cols = ix
!!$ idxmap%loc_to_glob(ix) = idx(i)
!!$ idxmap%glob_to_loc(idx(i)) = ix
!!$ end if
!!$ idx(i) = ix
!!$ else
!!$ idx(i) = -1
!!$ end if
!!$ end do
!!$ end if
!!$ end if
!!$
!!$ else
!!$ idx = -1
!!$ info = -1
!!$ end if
!!$
!!$ end subroutine list_g2lv1_ins
!!$
!!$ subroutine list_g2lv2_ins(idxin,idxout,idxmap,info,mask,lidx)
!!$ implicit none
!!$ class(psb_list_map), intent(inout) :: idxmap
!!$ integer(psb_ipk_), intent(in) :: idxin(:)
!!$ integer(psb_ipk_), intent(out) :: idxout(:)
!!$ integer(psb_ipk_), intent(out) :: info
!!$ logical, intent(in), optional :: mask(:)
!!$ integer(psb_ipk_), intent(in), optional :: lidx(:)
!!$
!!$ integer(psb_ipk_) :: is, im
!!$
!!$ is = size(idxin)
!!$ im = min(is,size(idxout))
!!$ idxout(1:im) = idxin(1:im)
!!$ call idxmap%g2lip_ins(idxout(1:im),info,mask=mask,lidx=lidx)
!!$ if (is > im) info = -3
!!$
!!$ end subroutine list_g2lv2_ins
!!$
subroutine list_g2ls1_ins(idx,idxmap,info,mask,lidx)
subroutine list_lg2ls1_ins(idx,idxmap,info,mask,lidx)
use psb_realloc_mod
use psb_sort_mod
implicit none
class(psb_list_map), intent(inout) :: idxmap
integer(psb_ipk_), intent(inout) :: idx
integer(psb_lpk_), intent(inout) :: idx
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: mask
integer(psb_ipk_), intent(in), optional :: lidx
integer(psb_ipk_) :: idxv(1), lidxv(1)
integer(psb_lpk_) :: idxv(1)
integer(psb_ipk_) :: lidxv(1)
info = 0
if (present(mask)) then
@ -637,193 +838,17 @@ contains
idx = idxv(1)
end subroutine list_g2ls1_ins
end subroutine list_lg2ls1_ins
subroutine list_g2ls2_ins(idxin,idxout,idxmap,info,mask,lidx)
subroutine list_lg2ls2_ins(idxin,idxout,idxmap,info,mask,lidx)
implicit none
class(psb_list_map), intent(inout) :: idxmap
integer(psb_ipk_), intent(in) :: idxin
integer(psb_lpk_), intent(in) :: idxin
integer(psb_ipk_), intent(out) :: idxout
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: mask
integer(psb_ipk_), intent(in), optional :: lidx
idxout = idxin
call idxmap%g2lip_ins(idxout,info,mask=mask,lidx=lidx)
end subroutine list_g2ls2_ins
subroutine list_g2lv1_ins(idx,idxmap,info,mask,lidx)
use psb_realloc_mod
use psb_sort_mod
implicit none
class(psb_list_map), intent(inout) :: idxmap
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: mask(:)
integer(psb_ipk_), intent(in), optional :: lidx(:)
integer(psb_ipk_) :: i, is, ix, lix
info = 0
is = size(idx)
if (present(mask)) then
if (size(mask) < size(idx)) then
info = -1
return
end if
end if
if (present(lidx)) then
if (size(lidx) < size(idx)) then
info = -1
return
end if
end if
if (idxmap%is_asb()) then
! State is wrong for this one !
idx = -1
info = -1
else if (idxmap%is_valid()) then
if (present(lidx)) then
if (present(mask)) then
do i=1, is
if (mask(i)) then
if ((1<= idx(i)).and.(idx(i) <= idxmap%global_rows)) then
ix = idxmap%glob_to_loc(idx(i))
if (ix < 0) then
ix = lidx(i)
call psb_ensure_size(ix,idxmap%loc_to_glob,info,addsz=laddsz)
if ((ix <= idxmap%local_rows).or.(info /= 0)) then
info = -4
return
end if
idxmap%local_cols = max(ix,idxmap%local_cols)
idxmap%loc_to_glob(ix) = idx(i)
idxmap%glob_to_loc(idx(i)) = ix
end if
idx(i) = ix
else
idx(i) = -1
end if
end if
end do
else if (.not.present(mask)) then
do i=1, is
if ((1<= idx(i)).and.(idx(i) <= idxmap%global_rows)) then
ix = idxmap%glob_to_loc(idx(i))
if (ix < 0) then
ix = lidx(i)
call psb_ensure_size(ix,idxmap%loc_to_glob,info,addsz=laddsz)
if ((ix <= idxmap%local_rows).or.(info /= 0)) then
info = -4
return
end if
idxmap%local_cols = max(ix,idxmap%local_cols)
idxmap%loc_to_glob(ix) = idx(i)
idxmap%glob_to_loc(idx(i)) = ix
end if
idx(i) = ix
else
idx(i) = -1
end if
end do
end if
else if (.not.present(lidx)) then
if (present(mask)) then
do i=1, is
if (mask(i)) then
if ((1<= idx(i)).and.(idx(i) <= idxmap%global_rows)) then
ix = idxmap%glob_to_loc(idx(i))
if (ix < 0) then
ix = idxmap%local_cols + 1
call psb_ensure_size(ix,idxmap%loc_to_glob,info,addsz=laddsz)
if (info /= 0) then
info = -4
return
end if
idxmap%local_cols = ix
idxmap%loc_to_glob(ix) = idx(i)
idxmap%glob_to_loc(idx(i)) = ix
end if
idx(i) = ix
else
idx(i) = -1
end if
end if
end do
else if (.not.present(mask)) then
do i=1, is
if ((1<= idx(i)).and.(idx(i) <= idxmap%global_rows)) then
ix = idxmap%glob_to_loc(idx(i))
if (ix < 0) then
ix = idxmap%local_cols + 1
call psb_ensure_size(ix,idxmap%loc_to_glob,info,addsz=laddsz)
if (info /= 0) then
info = -4
return
end if
idxmap%local_cols = ix
idxmap%loc_to_glob(ix) = idx(i)
idxmap%glob_to_loc(idx(i)) = ix
end if
idx(i) = ix
else
idx(i) = -1
end if
end do
end if
end if
else
idx = -1
info = -1
end if
end subroutine list_g2lv1_ins
subroutine list_g2lv2_ins(idxin,idxout,idxmap,info,mask,lidx)
implicit none
class(psb_list_map), intent(inout) :: idxmap
integer(psb_ipk_), intent(in) :: idxin(:)
integer(psb_ipk_), intent(out) :: idxout(:)
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: mask(:)
integer(psb_ipk_), intent(in), optional :: lidx(:)
integer(psb_ipk_) :: is, im
is = size(idxin)
im = min(is,size(idxout))
idxout(1:im) = idxin(1:im)
call idxmap%g2lip_ins(idxout(1:im),info,mask=mask,lidx=lidx)
if (is > im) info = -3
end subroutine list_g2lv2_ins
subroutine list_lg2ls1_ins(idx,idxmap,info,mask,lidx)
use psb_realloc_mod
use psb_sort_mod
implicit none
class(psb_list_map), intent(inout) :: idxmap
integer(psb_lpk_), intent(inout) :: idx
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: mask
integer(psb_ipk_), intent(in), optional :: lidx
integer(psb_lpk_) :: idxv(1)
integer(psb_ipk_) :: lidxv(1)
@ -831,7 +856,7 @@ contains
if (present(mask)) then
if (.not.mask) return
end if
idxv(1) = idx
idxv(1) = idxin
if (present(lidx)) then
lidxv(1) = lidx
call idxmap%g2lip_ins(idxv,info,lidx=lidxv)
@ -839,21 +864,7 @@ contains
call idxmap%g2lip_ins(idxv,info)
end if
idx = idxv(1)
end subroutine list_lg2ls1_ins
subroutine list_lg2ls2_ins(idxin,idxout,idxmap,info,mask,lidx)
implicit none
class(psb_list_map), intent(inout) :: idxmap
integer(psb_lpk_), intent(in) :: idxin
integer(psb_ipk_), intent(out) :: idxout
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: mask
integer(psb_ipk_), intent(in), optional :: lidx
idxout = idxin
call idxmap%g2lip_ins(idxout,info,mask=mask,lidx=lidx)
idxout = idxv(1)
end subroutine list_lg2ls2_ins
@ -1057,7 +1068,7 @@ contains
end if
lvl(1:nl) = vl(1:nl)
call idxmap%init_lvl(ictxt,lvl,info)
call idxmap%init_vl(ictxt,lvl,info)
end subroutine list_initvl

118
base/modules/desc/psb_repl_map_mod.f90
Unescape Escape View File

@ -58,20 +58,20 @@ module psb_repl_map_mod
procedure, pass(idxmap) :: reinit => repl_reinit
procedure, nopass :: get_fmt => repl_get_fmt
procedure, pass(idxmap) :: l2gs1 => repl_l2gs1
procedure, pass(idxmap) :: l2gs2 => repl_l2gs2
procedure, pass(idxmap) :: l2gv1 => repl_l2gv1
procedure, pass(idxmap) :: l2gv2 => repl_l2gv2
procedure, pass(idxmap) :: ll2gs1 => repl_l2gs1
procedure, pass(idxmap) :: ll2gs2 => repl_l2gs2
procedure, pass(idxmap) :: ll2gv1 => repl_l2gv1
procedure, pass(idxmap) :: ll2gv2 => repl_l2gv2
procedure, pass(idxmap) :: g2ls1 => repl_g2ls1
procedure, pass(idxmap) :: g2ls2 => repl_g2ls2
procedure, pass(idxmap) :: g2lv1 => repl_g2lv1
procedure, pass(idxmap) :: g2lv2 => repl_g2lv2
procedure, pass(idxmap) :: lg2ls1 => repl_g2ls1
procedure, pass(idxmap) :: lg2ls2 => repl_g2ls2
procedure, pass(idxmap) :: lg2lv1 => repl_g2lv1
procedure, pass(idxmap) :: lg2lv2 => repl_g2lv2
procedure, pass(idxmap) :: g2ls1_ins => repl_g2ls1_ins
procedure, pass(idxmap) :: g2ls2_ins => repl_g2ls2_ins
procedure, pass(idxmap) :: g2lv1_ins => repl_g2lv1_ins
procedure, pass(idxmap) :: g2lv2_ins => repl_g2lv2_ins
procedure, pass(idxmap) :: lg2ls1_ins => repl_g2ls1_ins
procedure, pass(idxmap) :: lg2ls2_ins => repl_g2ls2_ins
procedure, pass(idxmap) :: lg2lv1_ins => repl_g2lv1_ins
procedure, pass(idxmap) :: lg2lv2_ins => repl_g2lv2_ins
procedure, pass(idxmap) :: fnd_owner => repl_fnd_owner
@ -107,11 +107,11 @@ contains
subroutine repl_l2gs1(idx,idxmap,info,mask,owned)
implicit none
class(psb_repl_map), intent(in) :: idxmap
integer(psb_ipk_), intent(inout) :: idx
integer(psb_lpk_), intent(inout) :: idx
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: mask
logical, intent(in), optional :: owned
integer(psb_ipk_) :: idxv(1)
integer(psb_lpk_) :: idxv(1)
info = 0
if (present(mask)) then
if (.not.mask) return
@ -127,13 +127,20 @@ contains
implicit none
class(psb_repl_map), intent(in) :: idxmap
integer(psb_ipk_), intent(in) :: idxin
integer(psb_ipk_), intent(out) :: idxout
integer(psb_lpk_), intent(out) :: idxout
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: mask
logical, intent(in), optional :: owned
idxout = idxin
call idxmap%l2gip(idxout,info,mask,owned)
integer(psb_lpk_) :: idxv(1)
info = 0
if (present(mask)) then
if (.not.mask) return
end if
idxv(1) = idxin
call idxmap%l2gip(idxv,info,owned=owned)
idxout = idxv(1)
end subroutine repl_l2gs2
@ -141,11 +148,11 @@ contains
subroutine repl_l2gv1(idx,idxmap,info,mask,owned)
implicit none
class(psb_repl_map), intent(in) :: idxmap
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_lpk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: mask(:)
logical, intent(in), optional :: owned
integer(psb_ipk_) :: i
integer(psb_lpk_) :: i
logical :: owned_
info = 0
@ -191,12 +198,12 @@ contains
implicit none
class(psb_repl_map), intent(in) :: idxmap
integer(psb_ipk_), intent(in) :: idxin(:)
integer(psb_ipk_), intent(out) :: idxout(:)
integer(psb_lpk_), intent(out) :: idxout(:)
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: mask(:)
logical, intent(in), optional :: owned
integer(psb_ipk_) :: is, im
integer(psb_ipk_) :: i
integer(psb_lpk_) :: is, im
integer(psb_lpk_) :: i
logical :: owned_
info = 0
@ -247,11 +254,11 @@ contains
subroutine repl_g2ls1(idx,idxmap,info,mask,owned)
implicit none
class(psb_repl_map), intent(in) :: idxmap
integer(psb_ipk_), intent(inout) :: idx
integer(psb_lpk_), intent(inout) :: idx
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: mask
logical, intent(in), optional :: owned
integer(psb_ipk_) :: idxv(1)
integer(psb_lpk_) :: idxv(1)
info = 0
if (present(mask)) then
@ -267,26 +274,35 @@ contains
subroutine repl_g2ls2(idxin,idxout,idxmap,info,mask,owned)
implicit none
class(psb_repl_map), intent(in) :: idxmap
integer(psb_ipk_), intent(in) :: idxin
integer(psb_lpk_), intent(in) :: idxin
integer(psb_ipk_), intent(out) :: idxout
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: mask
logical, intent(in), optional :: owned
idxout = idxin
call idxmap%g2lip(idxout,info,mask,owned)
integer(psb_lpk_) :: idxv(1)
info = 0
if (present(mask)) then
if (.not.mask) return
end if
idxv(1) = idxin
call idxmap%g2lip(idxv,info,owned=owned)
idxout = idxv(1)
end subroutine repl_g2ls2
end subroutine repl_g2ls2
subroutine repl_g2lv1(idx,idxmap,info,mask,owned)
implicit none
class(psb_repl_map), intent(in) :: idxmap
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_lpk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: mask(:)
logical, intent(in), optional :: owned
integer(psb_ipk_) :: i, is
integer(psb_lpk_) :: i, is
logical :: owned_
info = 0
@ -363,13 +379,13 @@ contains
subroutine repl_g2lv2(idxin,idxout,idxmap,info,mask,owned)
implicit none
class(psb_repl_map), intent(in) :: idxmap
integer(psb_ipk_), intent(in) :: idxin(:)
integer(psb_lpk_), intent(in) :: idxin(:)
integer(psb_ipk_), intent(out) :: idxout(:)
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: mask(:)
logical, intent(in), optional :: owned
integer(psb_ipk_) :: is, im,i
integer(psb_lpk_) :: is, im,i
logical :: owned_
info = 0
@ -453,12 +469,13 @@ contains
use psb_sort_mod
implicit none
class(psb_repl_map), intent(inout) :: idxmap
integer(psb_ipk_), intent(inout) :: idx
integer(psb_lpk_), intent(inout) :: idx
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: mask
integer(psb_ipk_), intent(in), optional :: lidx
integer(psb_ipk_) :: idxv(1),lidxv(1)
integer(psb_lpk_) :: idxv(1)
integer(psb_ipk_) :: lidxv(1)
info = 0
if (present(mask)) then
@ -478,14 +495,27 @@ contains
subroutine repl_g2ls2_ins(idxin,idxout,idxmap,info,mask,lidx)
implicit none
class(psb_repl_map), intent(inout) :: idxmap
integer(psb_ipk_), intent(in) :: idxin
integer(psb_lpk_), intent(in) :: idxin
integer(psb_ipk_), intent(out) :: idxout
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: mask
integer(psb_ipk_), intent(in), optional :: lidx
idxout = idxin
call idxmap%g2lip_ins(idxout,info,mask=mask,lidx=lidx)
integer(psb_lpk_) :: idxv(1)
integer(psb_ipk_) :: lidxv(1)
info = 0
if (present(mask)) then
if (.not.mask) return
end if
idxv(1) = idxin
if (present(lidx)) then
lidxv(1) = lidx
call idxmap%g2lip_ins(idxv,info,lidx=lidxv)
else
call idxmap%g2lip_ins(idxv,info)
end if
idxout = idxv(1)
end subroutine repl_g2ls2_ins
@ -495,12 +525,12 @@ contains
use psb_sort_mod
implicit none
class(psb_repl_map), intent(inout) :: idxmap
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_lpk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: mask(:)
integer(psb_ipk_), intent(in), optional :: lidx(:)
integer(psb_ipk_) :: i, is
integer(psb_lpk_) :: i, is
info = 0
is = size(idx)
@ -579,13 +609,13 @@ contains
subroutine repl_g2lv2_ins(idxin,idxout,idxmap,info,mask,lidx)
implicit none
class(psb_repl_map), intent(inout) :: idxmap
integer(psb_ipk_), intent(in) :: idxin(:)
integer(psb_lpk_), intent(in) :: idxin(:)
integer(psb_ipk_), intent(out) :: idxout(:)
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: mask(:)
integer(psb_ipk_), intent(in), optional :: lidx(:)
integer(psb_ipk_) :: is, im, i
integer(psb_lpk_) :: is, im, i
info = 0
@ -669,7 +699,7 @@ contains
subroutine repl_fnd_owner(idx,iprc,idxmap,info)
use psb_penv_mod
implicit none
integer(psb_ipk_), intent(in) :: idx(:)
integer(psb_lpk_), intent(in) :: idx(:)
integer(psb_ipk_), allocatable, intent(out) :: iprc(:)
class(psb_repl_map), intent(in) :: idxmap
integer(psb_ipk_), intent(out) :: info
@ -695,7 +725,7 @@ contains
use psb_error_mod
implicit none
class(psb_repl_map), intent(inout) :: idxmap
integer(psb_ipk_), intent(in) :: nl
integer(psb_lpk_), intent(in) :: nl
integer(psb_mpk_), intent(in) :: ictxt
integer(psb_ipk_), intent(out) :: info
! To be implemented

Write Preview
Loading…
Cancel
Save