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

psblas3-integer8:

Browse Source 
base/internals/psb_indx_map_fnd_owner.F90
 base/internals/psi_desc_index.F90
 base/internals/psi_extrct_dl.F90
 base/internals/psi_idx_cnv.f90
 base/internals/psi_idx_ins_cnv.f90
 base/internals/psi_ovrl_upd.f90

Internals should now be fixed.
psblas3-type-indexed
Salvatore Filippone 13 years ago
parent 72d52a981d
commit baa0d54a03
6 changed files with 55 additions and 25 deletions
Show Stats Download Patch File Download Diff File

2
base/internals/psb_indx_map_fnd_owner.F90
Unescape Escape View File

@ -230,7 +230,7 @@ subroutine psb_indx_map_fnd_owner(idx,iprc,idxmap,info)
do
if (j > size(answers,1)) then
! Last resort attempt.
j = psb_ibsrch(ih,size(answers,1),answers(:,1))
j = psb_ibsrch(ih,size(answers,1,kind=psb_ipk_),answers(:,1))
if (j == -1) then
write(psb_err_unit,*) me,'psi_fnd_owner: searching for ',ih, &
& 'not found : ',size(answers,1),':',answers(:,1)

2
base/internals/psi_desc_index.F90
Unescape Escape View File

@ -183,7 +183,7 @@ subroutine psi_desc_index(desc,index_in,dep_list,&
i = i + nerv + 1
end do
ihinsz=i
call mpi_alltoall(sdsz,1,psb_mpi_integer,rvsz,1,mpi_integer,icomm,info)
call mpi_alltoall(sdsz,1,psb_mpi_integer,rvsz,1,psb_mpi_integer,icomm,info)
if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='mpi_alltoall')
goto 9999

12
base/internals/psi_extrct_dl.F90
Unescape Escape View File

@ -132,7 +132,8 @@ subroutine psi_extract_dep_list(ictxt,is_bld,is_upd,desc_str,dep_list,&
#endif
! ....scalar parameters...
logical :: is_bld, is_upd
integer(psb_ipk_) :: np,dl_lda,mode, info, ictxt
integer(psb_mpik_) :: ictxt
integer(psb_ipk_) :: np,dl_lda,mode, info
! ....array parameters....
integer(psb_ipk_) :: desc_str(*),dep_list(dl_lda,0:np),length_dl(0:np)
@ -141,9 +142,10 @@ subroutine psi_extract_dep_list(ictxt,is_bld,is_upd,desc_str,dep_list,&
integer(psb_ipk_) :: int_err(5)
! .....local scalars...
integer(psb_ipk_) :: i,me,nprow,pointer_dep_list,proc,j,err_act
integer(psb_ipk_) :: err, icomm
integer(psb_ipk_) :: i,pointer_dep_list,proc,j,err_act
integer(psb_ipk_) :: err
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_mpik_) :: icomm, me, npr
character name*20
name='psi_extrct_dl'
@ -153,7 +155,7 @@ subroutine psi_extract_dep_list(ictxt,is_bld,is_upd,desc_str,dep_list,&
info = psb_success_
call psb_info(ictxt,me,nprow)
call psb_info(ictxt,me,npr)
do i=0,np
length_dl(i) = 0
enddo
@ -173,7 +175,7 @@ subroutine psi_extract_dep_list(ictxt,is_bld,is_upd,desc_str,dep_list,&
if ((desc_str(i+1) /= 0).or.(desc_str(i+2) /= 0)) then
! ..if number of element to be exchanged !=0
proc=desc_str(i)
if ((proc < 0).or.(proc >= nprow)) then
if ((proc < 0).or.(proc >= npr)) then
if (debug_level >= psb_debug_inner_)&
& write(debug_unit,*) me,' ',trim(name),': error ',i,desc_str(i)
info = 9999

4
base/internals/psi_idx_cnv.f90
Unescape Escape View File

@ -322,7 +322,7 @@ subroutine psi_idx_cnvs(idxin,idxout,desc,info,mask,owned)
mask_=.true.
end if
iout = idxin
call psi_idx_cnv(1,iout,desc,info,mask=mask_,owned=owned)
call psi_idx_cnv(ione,iout,desc,info,mask=mask_,owned=owned)
idxout=iout(1)
return
@ -347,7 +347,7 @@ subroutine psi_idx_cnvs1(idxin,desc,info,mask,owned)
end if
iout(1) = idxin
call psi_idx_cnv(1,iout,desc,info,mask=mask_,owned=owned)
call psi_idx_cnv(ione,iout,desc,info,mask=mask_,owned=owned)
idxin = iout(1)
return

4
base/internals/psi_idx_ins_cnv.f90
Unescape Escape View File

@ -325,7 +325,7 @@ subroutine psi_idx_ins_cnvs2(idxin,idxout,desc,info,mask)
end if
iout(1) = idxin
call psi_idx_ins_cnv(1,iout,desc,info,mask_)
call psi_idx_ins_cnv(ione,iout,desc,info,mask_)
idxout = iout(1)
return
@ -395,7 +395,7 @@ subroutine psi_idx_ins_cnvs1(idxin,desc,info,mask)
end if
iout(1) = idxin
call psi_idx_ins_cnv(1,iout,desc,info,mask_)
call psi_idx_ins_cnv(ione,iout,desc,info,mask_)
idxin = iout(1)
return

56
base/internals/psi_ovrl_upd.f90
Unescape Escape View File

@ -42,6 +42,7 @@ subroutine psi_sovrl_updr1(x,desc_a,update,info)
! locals
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err
name='psi_sovrl_updr1'
@ -82,7 +83,8 @@ subroutine psi_sovrl_updr1(x,desc_a,update,info)
case default
! wrong value for choice argument
info = psb_err_iarg_invalid_value_
call psb_errpush(info,name,i_err=(/3,update,0,0,0/))
ierr(1) = 3; ierr(2)=update;
call psb_errpush(info,name,i_err=ierr)
goto 9999
end select
@ -112,6 +114,7 @@ subroutine psi_sovrl_updr2(x,desc_a,update,info)
! locals
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err
name='psi_sovrl_updr2'
@ -152,7 +155,8 @@ subroutine psi_sovrl_updr2(x,desc_a,update,info)
case default
! wrong value for choice argument
info = psb_err_iarg_invalid_value_
call psb_errpush(info,name,i_err=(/3,update,0,0,0/))
ierr(1) = 3; ierr(2)=update;
call psb_errpush(info,name,i_err=ierr)
goto 9999
end select
@ -181,6 +185,7 @@ subroutine psi_dovrl_updr1(x,desc_a,update,info)
! locals
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err
name='psi_dovrl_updr1'
@ -221,7 +226,8 @@ subroutine psi_dovrl_updr1(x,desc_a,update,info)
case default
! wrong value for choice argument
info = psb_err_iarg_invalid_value_
call psb_errpush(info,name,i_err=(/3,update,0,0,0/))
ierr(1) = 3; ierr(2)=update;
call psb_errpush(info,name,i_err=ierr)
goto 9999
end select
@ -251,6 +257,7 @@ subroutine psi_dovrl_updr2(x,desc_a,update,info)
! locals
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err
name='psi_dovrl_updr2'
@ -291,7 +298,8 @@ subroutine psi_dovrl_updr2(x,desc_a,update,info)
case default
! wrong value for choice argument
info = psb_err_iarg_invalid_value_
call psb_errpush(info,name,i_err=(/3,update,0,0,0/))
ierr(1) = 3; ierr(2)=update;
call psb_errpush(info,name,i_err=ierr)
goto 9999
end select
@ -320,6 +328,7 @@ subroutine psi_covrl_updr1(x,desc_a,update,info)
! locals
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err
name='psi_covrl_updr1'
@ -360,7 +369,8 @@ subroutine psi_covrl_updr1(x,desc_a,update,info)
case default
! wrong value for choice argument
info = psb_err_iarg_invalid_value_
call psb_errpush(info,name,i_err=(/3,update,0,0,0/))
ierr(1) = 3; ierr(2)=update;
call psb_errpush(info,name,i_err=ierr)
goto 9999
end select
@ -390,6 +400,7 @@ subroutine psi_covrl_updr2(x,desc_a,update,info)
! locals
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err
name='psi_covrl_updr2'
@ -430,7 +441,8 @@ subroutine psi_covrl_updr2(x,desc_a,update,info)
case default
! wrong value for choice argument
info = psb_err_iarg_invalid_value_
call psb_errpush(info,name,i_err=(/3,update,0,0,0/))
ierr(1) = 3; ierr(2)=update;
call psb_errpush(info,name,i_err=ierr)
goto 9999
end select
@ -459,6 +471,7 @@ subroutine psi_zovrl_updr1(x,desc_a,update,info)
! locals
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err
name='psi_zovrl_updr1'
@ -499,7 +512,8 @@ subroutine psi_zovrl_updr1(x,desc_a,update,info)
case default
! wrong value for choice argument
info = psb_err_iarg_invalid_value_
call psb_errpush(info,name,i_err=(/3,update,0,0,0/))
ierr(1) = 3; ierr(2)=update;
call psb_errpush(info,name,i_err=ierr)
goto 9999
end select
@ -529,6 +543,7 @@ subroutine psi_zovrl_updr2(x,desc_a,update,info)
! locals
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err
name='psi_zovrl_updr2'
@ -569,7 +584,8 @@ subroutine psi_zovrl_updr2(x,desc_a,update,info)
case default
! wrong value for choice argument
info = psb_err_iarg_invalid_value_
call psb_errpush(info,name,i_err=(/3,update,0,0,0/))
ierr(1) = 3; ierr(2)=update;
call psb_errpush(info,name,i_err=ierr)
goto 9999
end select
@ -598,6 +614,7 @@ subroutine psi_iovrl_updr1(x,desc_a,update,info)
! locals
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err
name='psi_iovrl_updr1'
@ -639,7 +656,8 @@ subroutine psi_iovrl_updr1(x,desc_a,update,info)
case default
! wrong value for choice argument
info = psb_err_iarg_invalid_value_
call psb_errpush(info,name,i_err=(/3,update,0,0,0/))
ierr(1) = 3; ierr(2)=update;
call psb_errpush(info,name,i_err=ierr)
goto 9999
end select
@ -669,6 +687,7 @@ subroutine psi_iovrl_updr2(x,desc_a,update,info)
! locals
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err
name='psi_iovrl_updr2'
@ -710,7 +729,8 @@ subroutine psi_iovrl_updr2(x,desc_a,update,info)
case default
! wrong value for choice argument
info = psb_err_iarg_invalid_value_
call psb_errpush(info,name,i_err=(/3,update,0,0,0/))
ierr(1) = 3; ierr(2)=update;
call psb_errpush(info,name,i_err=ierr)
goto 9999
end select
@ -743,6 +763,7 @@ subroutine psi_sovrl_upd_vect(x,desc_a,update,info)
! locals
real(psb_spk_), allocatable :: xs(:)
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm, nx
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err
@ -791,7 +812,8 @@ subroutine psi_sovrl_upd_vect(x,desc_a,update,info)
case default
! wrong value for choice argument
info = psb_err_iarg_invalid_value_
call psb_errpush(info,name,i_err=(/3,update,0,0,0/))
ierr(1) = 3; ierr(2)=update;
call psb_errpush(info,name,i_err=ierr)
goto 9999
end select
call x%sct(nx,desc_a%ovrlap_elem(:,1),xs,szero)
@ -825,6 +847,7 @@ subroutine psi_dovrl_upd_vect(x,desc_a,update,info)
! locals
real(psb_dpk_), allocatable :: xs(:)
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm, nx
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err
@ -873,7 +896,8 @@ subroutine psi_dovrl_upd_vect(x,desc_a,update,info)
case default
! wrong value for choice argument
info = psb_err_iarg_invalid_value_
call psb_errpush(info,name,i_err=(/3,update,0,0,0/))
ierr(1) = 3; ierr(2)=update;
call psb_errpush(info,name,i_err=ierr)
goto 9999
end select
call x%sct(nx,desc_a%ovrlap_elem(:,1),xs,dzero)
@ -908,6 +932,7 @@ subroutine psi_covrl_upd_vect(x,desc_a,update,info)
! locals
complex(psb_spk_), allocatable :: xs(:)
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm, nx
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err
@ -956,7 +981,8 @@ subroutine psi_covrl_upd_vect(x,desc_a,update,info)
case default
! wrong value for choice argument
info = psb_err_iarg_invalid_value_
call psb_errpush(info,name,i_err=(/3,update,0,0,0/))
ierr(1) = 3; ierr(2)=update;
call psb_errpush(info,name,i_err=ierr)
goto 9999
end select
call x%sct(nx,desc_a%ovrlap_elem(:,1),xs,czero)
@ -990,6 +1016,7 @@ subroutine psi_zovrl_upd_vect(x,desc_a,update,info)
! locals
complex(psb_dpk_), allocatable :: xs(:)
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm, nx
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err
@ -1038,7 +1065,8 @@ subroutine psi_zovrl_upd_vect(x,desc_a,update,info)
case default
! wrong value for choice argument
info = psb_err_iarg_invalid_value_
call psb_errpush(info,name,i_err=(/3,update,0,0,0/))
ierr(1) = 3; ierr(2)=update;
call psb_errpush(info,name,i_err=ierr)
goto 9999
end select
call x%sct(nx,desc_a%ovrlap_elem(:,1),xs,zzero)

Write Preview
Loading…
Cancel
Save