fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-17 11:22:09 +00:00
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.
This commit is contained in:
Salvatore Filippone
2012-01-31 12:01:35 +00:00
parent 72d52a981d
commit baa0d54a03
6 changed files with 55 additions and 25 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/internals/psb_indx_map_fnd_owner.F90
+1 -1
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)
base/internals/psi_desc_index.F90
+1 -1
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
base/internals/psi_extrct_dl.F90
+7 -5
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
base/internals/psi_idx_cnv.f90
+2 -2
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
base/internals/psi_idx_ins_cnv.f90
+2 -2
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
base/internals/psi_ovrl_upd.f90
+42 -14
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)