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

Start of interface fixing for CDALL and friends.

Browse Source
ILmat
Salvatore Filippone 8 years ago
parent 6e5df61dc0
commit 99fa0fdc20
4 changed files with 40 additions and 40 deletions
Show Stats Download Patch File Download Diff File

8
base/modules/tools/psb_cd_tools_mod.f90
Unescape Escape View File

@ -156,18 +156,18 @@ module psb_cd_tools_mod
interface psb_cdall interface psb_cdall
subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,vll,flag,nl,repl,& subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,flag,nl,repl,&
& globalcheck,lidx) & globalcheck,lidx)
import :: psb_ipk_, psb_lpk_, psb_desc_type, psb_parts import :: psb_ipk_, psb_lpk_, psb_desc_type, psb_parts
implicit None implicit None
procedure(psb_parts) :: parts procedure(psb_parts) :: parts
integer(psb_ipk_), intent(in) :: mg,ng,ictxt, vg(:), vl(:),nl,lidx(:) integer(psb_lpk_), intent(in) :: mg,ng, vl(:)
integer(psb_lpk_), intent(in) :: vll(:) integer(psb_ipk_), intent(in) :: ictxt, vg(:), lidx(:),nl
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
logical, intent(in) :: repl, globalcheck logical, intent(in) :: repl, globalcheck
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
type(psb_desc_type), intent(out) :: desc type(psb_desc_type), intent(out) :: desc
optional :: mg,ng,parts,vg,vl,flag,nl,repl, globalcheck,lidx,vll optional :: mg,ng,parts,vg,vl,flag,nl,repl, globalcheck,lidx
end subroutine psb_cdall end subroutine psb_cdall
end interface end interface

10
base/tools/psb_cd_inloc.f90
Unescape Escape View File

@ -49,7 +49,8 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx)
use psb_hash_map_mod use psb_hash_map_mod
implicit None implicit None
!....Parameters... !....Parameters...
integer(psb_ipk_), intent(in) :: ictxt, v(:) integer(psb_ipk_), intent(in) :: ictxt
integer(psb_lpk_), intent(in) :: v(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
type(psb_desc_type), intent(out) :: desc type(psb_desc_type), intent(out) :: desc
logical, intent(in), optional :: globalcheck logical, intent(in), optional :: globalcheck
@ -57,9 +58,10 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx)
!locals !locals
integer(psb_ipk_) :: i,j,np,me,loc_row,err,& integer(psb_ipk_) :: i,j,np,me,loc_row,err,&
& loc_col,nprocs,n, k,glx,nlu,& & loc_col,nprocs,k,glx,nlu,&
& flag_, err_act,m, novrl, norphan,& & flag_, err_act, novrl, norphan,&
& npr_ov, itmpov, i_pnt, nrt & npr_ov, itmpov, i_pnt
integer(psb_lpk) :: m, n, nrt
integer(psb_ipk_) :: int_err(5),exch(3) integer(psb_ipk_) :: int_err(5),exch(3)
integer(psb_ipk_), allocatable :: temp_ovrlap(:), tmpgidx(:,:), vl(:),& integer(psb_ipk_), allocatable :: temp_ovrlap(:), tmpgidx(:,:), vl(:),&
& nov(:), ov_idx(:,:), ix(:) & nov(:), ov_idx(:,:), ix(:)

41
base/tools/psb_cdall.f90
Unescape Escape View File

@ -1,4 +1,4 @@
subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,vll,flag,nl,repl, globalcheck,lidx) subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,flag,nl,repl, globalcheck,lidx)
use psb_desc_mod use psb_desc_mod
use psb_serial_mod use psb_serial_mod
use psb_const_mod use psb_const_mod
@ -8,22 +8,23 @@ subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,vll,flag,nl,repl, globa
use psi_mod use psi_mod
implicit None implicit None
procedure(psb_parts) :: parts procedure(psb_parts) :: parts
integer(psb_ipk_), intent(in) :: mg,ng,ictxt, vg(:), vl(:),nl,lidx(:) integer(psb_lpk_), intent(in) :: mg,ng, vl(:)
integer(psb_lpk_), intent(in) :: vll(:) integer(psb_ipk_), intent(in) :: ictxt, vg(:), lidx(:),nl
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
logical, intent(in) :: repl, globalcheck logical, intent(in) :: repl, globalcheck
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
type(psb_desc_type), intent(out) :: desc type(psb_desc_type), intent(out) :: desc
optional :: mg,ng,parts,vg,vl,vll,flag,nl,repl, globalcheck,lidx optional :: mg,ng,parts,vg,vl,flag,nl,repl, globalcheck,lidx
interface interface
subroutine psb_cdals(m, n, parts, ictxt, desc, info) subroutine psb_cdals(m, n, parts, ictxt, desc, info)
use psb_desc_mod use psb_desc_mod
procedure(psb_parts) :: parts procedure(psb_parts) :: parts
integer(psb_ipk_), intent(in) :: m,n,ictxt integer(psb_lpk_), intent(in) :: m,n
Type(psb_desc_type), intent(out) :: desc integer(psb_ipk_), intent(in) :: ictxt
integer(psb_ipk_), intent(out) :: info Type(psb_desc_type), intent(out) :: desc
integer(psb_ipk_), intent(out) :: info
end subroutine psb_cdals end subroutine psb_cdals
subroutine psb_cdalv(v, ictxt, desc, info, flag) subroutine psb_cdalv(v, ictxt, desc, info, flag)
use psb_desc_mod use psb_desc_mod
@ -33,15 +34,6 @@ subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,vll,flag,nl,repl, globa
Type(psb_desc_type), intent(out) :: desc Type(psb_desc_type), intent(out) :: desc
end subroutine psb_cdalv end subroutine psb_cdalv
subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx) subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx)
use psb_desc_mod
implicit None
integer(psb_ipk_), intent(in) :: ictxt, v(:)
integer(psb_ipk_), intent(out) :: info
type(psb_desc_type), intent(out) :: desc
logical, intent(in), optional :: globalcheck
integer(psb_ipk_), intent(in), optional :: idx(:)
end subroutine psb_cd_inloc
subroutine psb_cd_inlocl(v, ictxt, desc, info, globalcheck,idx)
use psb_desc_mod use psb_desc_mod
implicit None implicit None
integer(psb_ipk_), intent(in) :: ictxt integer(psb_ipk_), intent(in) :: ictxt
@ -50,16 +42,18 @@ subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,vll,flag,nl,repl, globa
type(psb_desc_type), intent(out) :: desc type(psb_desc_type), intent(out) :: desc
logical, intent(in), optional :: globalcheck logical, intent(in), optional :: globalcheck
integer(psb_ipk_), intent(in), optional :: idx(:) integer(psb_ipk_), intent(in), optional :: idx(:)
end subroutine psb_cd_inlocl end subroutine psb_cd_inloc
subroutine psb_cdrep(m, ictxt, desc,info) subroutine psb_cdrep(m, ictxt, desc,info)
use psb_desc_mod use psb_desc_mod
integer(psb_ipk_), intent(in) :: m,ictxt integer(psb_lpk_), intent(in) :: m
integer(psb_ipk_), intent(in) :: ictxt
Type(psb_desc_type), intent(out) :: desc Type(psb_desc_type), intent(out) :: desc
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_cdrep end subroutine psb_cdrep
end interface end interface
character(len=20) :: name character(len=20) :: name
integer(psb_ipk_) :: err_act, n_, flag_, i, me, np, nlp, nnv, lr integer(psb_ipk_) :: err_act, flag_, i, me, np, nlp, nnv, lr
integer(psb_lpk_) :: n_
integer(psb_ipk_), allocatable :: itmpsz(:) integer(psb_ipk_), allocatable :: itmpsz(:)
integer(psb_mpk_) :: iictxt integer(psb_mpk_) :: iictxt
@ -149,8 +143,9 @@ subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,vll,flag,nl,repl, globa
end if end if
if (info == psb_success_) then if (info == psb_success_) then
select type(aa => desc%indxmap) select type(aa => desc%indxmap)
type is (psb_repl_map) type is (psb_repl_map)
call aa%repl_map_init(iictxt,nl,info) n_ = nl
call aa%repl_map_init(iictxt,n_,info)
type is (psb_gen_block_map) type is (psb_gen_block_map)
call aa%gen_block_map_init(iictxt,nl,info) call aa%gen_block_map_init(iictxt,nl,info)
class default class default

21
base/tools/psb_cdals.f90
Unescape Escape View File

@ -52,15 +52,18 @@ subroutine psb_cdals(m, n, parts, ictxt, desc, info)
implicit None implicit None
procedure(psb_parts) :: parts procedure(psb_parts) :: parts
!....Parameters... !....Parameters...
integer(psb_ipk_), intent(in) :: M,N,ictxt integer(psb_lpk_), intent(in) :: M,N
integer(psb_ipk_), intent(in) :: ictxt
Type(psb_desc_type), intent(out) :: desc Type(psb_desc_type), intent(out) :: desc
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
!locals !locals
integer(psb_ipk_) :: counter,i,j,loc_row,err,loc_col,& integer(psb_ipk_) :: counter,i,j,loc_row,err,loc_col,&
& l_ov_ix,l_ov_el,idx, err_act, itmpov, k, glx, nlx & l_ov_ix,l_ov_el,idx, err_act, itmpov, k, glx, nlx
integer(psb_lpk_) :: iglob
integer(psb_ipk_) :: int_err(5),exch(3) integer(psb_ipk_) :: int_err(5),exch(3)
integer(psb_ipk_), allocatable :: temp_ovrlap(:), loc_idx(:) integer(psb_lpk_), allocatable :: loc_idx(:)
integer(psb_ipk_), allocatable :: temp_ovrlap(:)
integer(psb_ipk_), allocatable :: prc_v(:) integer(psb_ipk_), allocatable :: prc_v(:)
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: me, np, nprocs integer(psb_ipk_) :: me, np, nprocs
@ -174,15 +177,15 @@ subroutine psb_cdals(m, n, parts, ictxt, desc, info)
desc%lprm(1) = 0 desc%lprm(1) = 0
k = 0 k = 0
do i=1,m do iglob=1,m
if (info == psb_success_) then if (info == psb_success_) then
call parts(i,m,np,prc_v,nprocs) call parts(iglob,m,np,prc_v,nprocs)
if (nprocs > np) then if (nprocs > np) then
info=psb_err_partfunc_toomuchprocs_ info=psb_err_partfunc_toomuchprocs_
int_err(1)=3 int_err(1)=3
int_err(2)=np int_err(2)=np
int_err(3)=nprocs int_err(3)=nprocs
int_err(4)=i int_err(4)=iglob
err=info err=info
call psb_errpush(err,name,int_err) call psb_errpush(err,name,int_err)
goto 9999 goto 9999
@ -190,7 +193,7 @@ subroutine psb_cdals(m, n, parts, ictxt, desc, info)
info=psb_err_partfunc_toofewprocs_ info=psb_err_partfunc_toofewprocs_
int_err(1)=3 int_err(1)=3
int_err(2)=nprocs int_err(2)=nprocs
int_err(3)=i int_err(3)=iglob
err=info err=info
call psb_errpush(err,name,int_err) call psb_errpush(err,name,int_err)
goto 9999 goto 9999
@ -200,7 +203,7 @@ subroutine psb_cdals(m, n, parts, ictxt, desc, info)
info=psb_err_partfunc_wrong_pid_ info=psb_err_partfunc_wrong_pid_
int_err(1)=3 int_err(1)=3
int_err(2)=prc_v(j) int_err(2)=prc_v(j)
int_err(3)=i int_err(3)=iglob
err=info err=info
call psb_errpush(err,name,int_err) call psb_errpush(err,name,int_err)
goto 9999 goto 9999
@ -218,7 +221,7 @@ subroutine psb_cdals(m, n, parts, ictxt, desc, info)
if (prc_v(j) == me) then if (prc_v(j) == me) then
! this point belongs to me ! this point belongs to me
k = k + 1 k = k + 1
call psb_ensure_size((k+1),loc_idx,info,pad=-ione) call psb_ensure_size((k+1),loc_idx,info,pad=-1_psb_lpk_)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_ensure_size') call psb_errpush(info,name,a_err='psb_ensure_size')

Write Preview
Loading…
Cancel
Save