fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-06 22:55:08 +00:00
Code Issues Packages Projects Releases Wiki Activity

psblas3:

Browse Source 
base/internals/psi_bld_tmphalo.f90
 base/internals/psi_crea_index.f90
 base/internals/psi_desc_index.F90
 base/internals/psi_fnd_owner.F90
 base/modules/psb_desc_mod.F90
 base/modules/psb_indx_map_mod.f90
 base/serial/impl/psb_d_coo_impl.f90
 base/tools/psb_cdins.f90
 base/tools/psb_dspins.f90
 base/tools/psb_glob_to_loc.f90
 base/tools/psb_loc_to_glob.f90
 test/fileread/cf_sample.f90
 test/fileread/df_sample.f90
 test/fileread/sf_sample.f90
 test/fileread/zf_sample.f90
 test/kernel/d_file_spmv.f90
 test/kernel/pdgenspmv.f90
 test/pargen/runs/ppde.inp

Take out desc%indxmap% indirection where it makes sense, take 1.
This commit is contained in:
Salvatore Filippone
2013-10-02 09:26:37 +00:00
parent cfc6255040
commit cfa9940e59
18 changed files with 472 additions and 115 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/internals/psi_bld_tmphalo.f90
+2 -2
View File
@@ -100,8 +100,8 @@ subroutine psi_bld_tmphalo(desc,info)
helem(i) = n_row+i ! desc%loc_to_glob(n_row+i)
end do
call desc%indxmap%l2gip(helem(1:nh),info)
call desc%indxmap%fnd_owner(helem(1:nh),hproc,info)
call desc%l2gip(helem(1:nh),info)
call desc%fnd_owner(helem(1:nh),hproc,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='fnd_owner')
base/internals/psi_crea_index.f90
+3 -3
View File
@@ -81,7 +81,7 @@ subroutine psi_crea_index(desc_a,index_in,index_out,glob_idx,nxch,nsnd,nrcv,info
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
ictxt = desc_a%indxmap%get_ctxt()
ictxt = desc_a%get_ctxt()
call psb_info(ictxt,me,np)
if (np == -1) then
@@ -107,8 +107,8 @@ subroutine psi_crea_index(desc_a,index_in,index_out,glob_idx,nxch,nsnd,nrcv,info
& write(debug_unit,*) me,' ',trim(name),': calling extract_dep_list'
mode = 1
call psi_extract_dep_list(desc_a%indxmap%get_ctxt(),&
& desc_a%indxmap%is_bld(), desc_a%indxmap%is_upd(),&
call psi_extract_dep_list(ictxt,&
& desc_a%is_bld(), desc_a%is_upd(),&
& index_in, dep_list,length_dl,np,max(1,dl_lda),mode,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='extrct_dl')
base/internals/psi_desc_index.F90
+5 -5
View File
@@ -145,8 +145,8 @@ subroutine psi_desc_index(desc,index_in,dep_list,&
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
ictxt = desc%indxmap%get_ctxt()
icomm = desc%indxmap%get_mpic()
ictxt = desc%get_context()
icomm = desc%get_mpic()
call psb_info(ictxt,me,np)
if (np == -1) then
info = psb_err_context_error_
@@ -261,7 +261,7 @@ subroutine psi_desc_index(desc,index_in,dep_list,&
end do
else
call desc%indxmap%l2g(index_in(i+1:i+nerv),&
call desc%l2g(index_in(i+1:i+nerv),&
& sndbuf(bsdindx(proc+1)+1:bsdindx(proc+1)+nerv),&
& info)
@@ -310,13 +310,13 @@ subroutine psi_desc_index(desc,index_in,dep_list,&
i = i + 1
nerv = sdsz(proc+1)
desc_index(i) = nerv
call desc%indxmap%g2l(sndbuf(bsdindx(proc+1)+1:bsdindx(proc+1)+nerv),&
call desc%g2l(sndbuf(bsdindx(proc+1)+1:bsdindx(proc+1)+nerv),&
& desc_index(i+1:i+nerv),info)
i = i + nerv + 1
nesd = rvsz(proc+1)
desc_index(i) = nesd
call desc%indxmap%g2l(rcvbuf(brvindx(proc+1)+1:brvindx(proc+1)+nesd),&
call desc%g2l(rcvbuf(brvindx(proc+1)+1:brvindx(proc+1)+nesd),&
& desc_index(i+1:i+nesd),info)
i = i + nesd + 1
end do
base/internals/psi_fnd_owner.F90
+2 -2
View File
@@ -109,10 +109,10 @@ subroutine psi_fnd_owner(nv,idx,iprc,desc,info)
goto 9999
end if
call desc%indxmap%fnd_owner(idx(1:nv),iprc,info)
call desc%fnd_owner(idx(1:nv),iprc,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='indxmap%fnd_owner')
call psb_errpush(psb_err_from_subroutine_,name,a_err='desc%fnd_owner')
goto 9999
end if
call psb_erractionrestore(err_act)
base/modules/psb_desc_mod.F90
+44 -2
View File
@@ -219,7 +219,8 @@ module psb_desc_mod
procedure, pass(desc) :: is_repl => psb_is_repl_desc
procedure, pass(desc) :: get_mpic => psb_cd_get_mpic
procedure, pass(desc) :: get_dectype => psb_cd_get_dectype
procedure, pass(desc) :: get_context => psb_cd_get_context
procedure, pass(desc) :: get_context => psb_cd_get_context
procedure, pass(desc) :: get_ctxt => psb_cd_get_context
procedure, pass(desc) :: get_local_rows => psb_cd_get_local_rows
procedure, pass(desc) :: get_local_cols => psb_cd_get_local_cols
procedure, pass(desc) :: get_global_rows => psb_cd_get_global_rows
@@ -232,6 +233,7 @@ module psb_desc_mod
procedure, pass(desc) :: nullify => nullify_desc
procedure, pass(desc) :: get_fmt => cd_get_fmt
procedure, pass(desc) :: fnd_owner => cd_fnd_owner
procedure, pass(desc) :: l2gs1 => cd_l2gs1
procedure, pass(desc) :: l2gs2 => cd_l2gs2
procedure, pass(desc) :: l2gv1 => cd_l2gv1
@@ -282,7 +284,7 @@ module psb_desc_mod
private :: nullify_desc, cd_get_fmt,&
& cd_l2gs1, cd_l2gs2, cd_l2gv1, cd_l2gv2, cd_g2ls1,&
& cd_g2ls2, cd_g2lv1, cd_g2lv2, cd_g2ls1_ins,&
& cd_g2ls2_ins, cd_g2lv1_ins, cd_g2lv2_ins
& cd_g2ls2_ins, cd_g2lv1_ins, cd_g2lv2_ins, cd_fnd_owner
integer(psb_ipk_), private, save :: cd_large_threshold=psb_default_large_threshold
@@ -1434,4 +1436,44 @@ contains
end subroutine cd_g2lv2_ins
subroutine cd_fnd_owner(idx,iprc,desc,info)
use psb_error_mod
implicit none
integer(psb_ipk_), intent(in) :: idx(:)
integer(psb_ipk_), allocatable, intent(out) :: iprc(:)
class(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='cd_fnd_owner'
logical, parameter :: debug=.false.
info = psb_success_
call psb_erractionsave(err_act)
if (allocated(desc%indxmap)) then
call desc%indxmap%fnd_owner(idx,iprc,info)
else
info = psb_err_invalid_cd_state_
end if
if (info /= psb_success_) then
call psb_errpush(info,name)
goto 9999
end if
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
Return
end subroutine cd_fnd_owner
end module psb_desc_mod
base/modules/psb_indx_map_mod.f90
+1 -1
View File
@@ -75,7 +75,7 @@ module psb_indx_map_mod
!!
!! 1. Each global index I is owned by at least one process;
!!
!! 2. On each process, indices from 1 to N_ROW (desc%indxmap%get_lr())
!! 2. On each process, indices from 1 to N_ROW (desc%get_local_rows())
!! are locally owned; the value of N_ROW can be determined upon allocation
!! based on the index distribution (see also the interface to CDALL).
!!
base/serial/impl/psb_d_coo_impl.f90
+392 -77
View File
@@ -2725,7 +2725,7 @@ contains
subroutine d_coo_srch_upd(nz,ia,ja,val,a,&
& imin,imax,jmin,jmax,info,gtl)
use psb_const_mod
use psb_realloc_mod
use psb_string_mod
@@ -3412,6 +3412,7 @@ subroutine psb_d_fix_coo_inner(nzin,dupl,ia,ja,val,nzout,info,idir)
use psb_d_base_mat_mod, psb_protect_name => psb_d_fix_coo_inner
use psb_string_mod
use psb_ip_reord_mod
use psb_sort_mod
implicit none
integer(psb_ipk_), intent(in) :: nzin, dupl
@@ -3422,10 +3423,12 @@ subroutine psb_d_fix_coo_inner(nzin,dupl,ia,ja,val,nzout,info,idir)
!locals
integer(psb_ipk_), allocatable :: iaux(:)
integer(psb_ipk_) :: nza, nzl,iret,idir_, dupl_
integer(psb_ipk_) :: i,j, irw, icl, err_act
integer(psb_ipk_) :: i,j, irw, icl, err_act, ixp,ki,kx
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name = 'psb_fixcoo'
real(psb_dpk_), allocatable :: vtx(:)
integer(psb_ipk_), allocatable :: itx(:), jtx(:)
info = psb_success_
@@ -3455,86 +3458,398 @@ subroutine psb_d_fix_coo_inner(nzin,dupl,ia,ja,val,nzout,info,idir)
case(0) ! Row major order
call msort_up(nzin,ia(1:),iaux(1:),iret)
if (iret == 0) &
& call psb_ip_reord(nzin,val,ia,ja,iaux)
i = 1
j = i
do while (i <= nzin)
do while ((ia(j) == ia(i)))
j = j+1
if (j > nzin) exit
enddo
nzl = j - i
call msort_up(nzl,ja(i:),iaux(1:),iret)
if (.false.) then
call msort_up(nzin,ia(1:),iaux(1:),iret)
if (iret == 0) &
& call psb_ip_reord(nzl,val(i:i+nzl-1),&
& ia(i:i+nzl-1),ja(i:i+nzl-1),iaux)
i = j
enddo
i = 1
irw = ia(i)
icl = ja(i)
j = 1
select case(dupl_)
case(psb_dupl_ovwrt_)
do
j = j + 1
if (j > nzin) exit
if ((ia(j) == irw).and.(ja(j) == icl)) then
val(i) = val(j)
else
i = i+1
val(i) = val(j)
ia(i) = ia(j)
ja(i) = ja(j)
irw = ia(i)
icl = ja(i)
endif
& call psb_ip_reord(nzin,val,ia,ja,iaux)
i = 1
j = i
do while (i <= nzin)
do while ((ia(j) == ia(i)))
j = j+1
if (j > nzin) exit
enddo
nzl = j - i
call msort_up(nzl,ja(i:),iaux(1:),iret)
if (iret == 0) &
& call psb_ip_reord(nzl,val(i:i+nzl-1),&
& ja(i:i+nzl-1),iaux)
i = j
enddo
case(psb_dupl_add_)
i = 1
irw = ia(i)
icl = ja(i)
j = 1
do
j = j + 1
if (j > nzin) exit
if ((ia(j) == irw).and.(ja(j) == icl)) then
val(i) = val(i) + val(j)
else
i = i+1
val(i) = val(j)
ia(i) = ia(j)
ja(i) = ja(j)
irw = ia(i)
icl = ja(i)
endif
select case(dupl_)
case(psb_dupl_ovwrt_)
do
j = j + 1
if (j > nzin) exit
if ((ia(j) == irw).and.(ja(j) == icl)) then
val(i) = val(j)
else
i = i+1
val(i) = val(j)
ia(i) = ia(j)
ja(i) = ja(j)
irw = ia(i)
icl = ja(i)
endif
enddo
case(psb_dupl_add_)
do
j = j + 1
if (j > nzin) exit
if ((ia(j) == irw).and.(ja(j) == icl)) then
val(i) = val(i) + val(j)
else
i = i+1
val(i) = val(j)
ia(i) = ia(j)
ja(i) = ja(j)
irw = ia(i)
icl = ja(i)
endif
enddo
case(psb_dupl_err_)
do
j = j + 1
if (j > nzin) exit
if ((ia(j) == irw).and.(ja(j) == icl)) then
call psb_errpush(psb_err_duplicate_coo,name)
goto 9999
else
i = i+1
val(i) = val(j)
ia(i) = ia(j)
ja(i) = ja(j)
irw = ia(i)
icl = ja(i)
endif
enddo
case default
write(psb_err_unit,*) 'Error in fix_coo: unsafe dupl',dupl_
info =-7
end select
!!$ write(0,*) 'End of fix_coo ia',ia(1:i)
!!$ write(0,*) 'End of fix_coo ja',ja(1:i)
else if (.true.) then
call msort_up(nzin,ia(1:),iaux(1:),iret)
if (iret == 0) &
& call psb_ip_reord(nzin,val,ia,ja,iaux)
i = 1
j = 1
ki = 0
select case(dupl_)
case(psb_dupl_ovwrt_)
do while (i <= nzin)
do while ((ia(j) == ia(i)))
j = j+1
if (j > nzin) exit
enddo
nzl = j - i
call msort_up(nzl,ja(i:),iaux(1:),iret)
if (iret == 0) &
& call psb_ip_reord(nzl,val(i:i+nzl-1),&
& ja(i:i+nzl-1),iaux)
kx = 0
ki = ki + 1
val(ki) = val(i+kx)
ia(ki) = ia(i+kx)
ja(ki) = ja(i+kx)
irw = ia(ki)
icl = ja(ki)
do kx = 1,nzl-1
if (ja(i+kx) == icl) then
val(ki) = val(i+kx)
else
ki = ki+1
val(ki) = val(i+kx)
ja(ki) = ja(i+kx)
ia(ki) = irw
icl = ja(ki)
endif
enddo
i = j
enddo
case(psb_dupl_add_)
do while (i <= nzin)
do while ((ia(j) == ia(i)))
j = j+1
if (j > nzin) exit
enddo
nzl = j - i
call msort_up(nzl,ja(i:),iaux(1:),iret)
if (iret == 0) &
& call psb_ip_reord(nzl,val(i:i+nzl-1),&
& ja(i:i+nzl-1),iaux)
kx = 0
ki = ki + 1
val(ki) = val(i+kx)
ia(ki) = ia(i+kx)
ja(ki) = ja(i+kx)
irw = ia(ki)
icl = ja(ki)
do kx = 1,nzl-1
if (ja(i+kx) == icl) then
val(ki) = val(ki) + val(i+kx)
else
ki = ki+1
val(ki) = val(i+kx)
ja(ki) = ja(i+kx)
ia(ki) = irw
icl = ja(ki)
!!$ write(0,*) 'ki icl kx',ki,icl,kx,' ja',ja(ki)
endif
enddo
i = j
enddo
case(psb_dupl_err_)
do while (i <= nzin)
do while ((ia(j) == ia(i)))
j = j+1
if (j > nzin) exit
enddo
nzl = j - i
if (.false.) then
call msort_up(nzl,ja(i:),iaux(1:),iret)
if (iret == 0) &
& call psb_ip_reord(nzl,val(i:i+nzl-1),&
& ja(i:i+nzl-1),iaux)
kx = 0
ki = ki + 1
val(ki) = val(i+kx)
ia(ki) = ia(i+kx)
ja(ki) = ja(i+kx)
irw = ia(ki)
icl = ja(ki)
do kx = 1,nzl-1
if (ja(i+kx) == icl) then
call psb_errpush(psb_err_duplicate_coo,name)
goto 9999
else
ki = ki+1
val(ki) = val(i+kx)
ja(ki) = ja(i+kx)
ia(ki) = irw
icl = ja(ki)
endif
enddo
else
call psb_msort(ja(i:i+nzl-1),ix=iaux,dir=psb_sort_up_)
kx = 0
ki = ki + 1
val(ki) = val(i+iaux(1+kx)-1)
ia(ki) = ia(i+kx)
ja(ki) = ja(i+kx)
irw = ia(ki)
icl = ja(ki)
do kx = 1,nzl-1
if (ja(i+kx) == icl) then
call psb_errpush(psb_err_duplicate_coo,name)
goto 9999
else
ki = ki+1
val(ki) = val(i+iaux(1+kx)-1)
ja(ki) = ja(i+kx)
ia(ki) = irw
icl = ja(ki)
endif
enddo
end if
i = j
enddo
case default
write(psb_err_unit,*) 'Error in fix_coo: unsafe dupl',dupl_
info =-7
end select
i = ki
else if (.false.) then
allocate(itx(nzin),jtx(nzin),vtx(nzin),stat=info)
if (info /= psb_success_) return
call psb_msort(ia(1:nzin),ix=iaux,dir=psb_sort_up_)
do i=1, nzin
ixp = iaux(i)
vtx(i) = val(ixp)
itx(i) = ia(i)
jtx(i) = ja(ixp)
end do
!!$ call psb_msort(itx(1:nzin),ix=iaux,dir=psb_sort_up_)
!!$ do i=1, nzin
!!$ ixp = iaux(i)
!!$ val(i) = vtx(ixp)
!!$ ia(i) = itx(i)
!!$ ja(i) = jtx(ixp)
!!$ end do
!!$
i = 1
j = i
ki = 1
do while (i <= nzin)
do while ((itx(j) == itx(i)))
j = j+1
if (j > nzin) exit
enddo
nzl = j - i
call msort_up(nzl,jtx(i:),iaux(1:),iret)
if (iret == 0) &
& call psb_ip_reord(nzl,vtx(i:i+nzl-1),&
& jtx(i:i+nzl-1),iaux)
ia(ki:ki+nzl-1) = itx(i:i+nzl-1)
val(ki) = vtx(i)
ja(ki) = jtx(i)
icl = jtx(i)
kx = 0
select case(dupl_)
case(psb_dupl_ovwrt_)
do
kx = kx + 1
if (kx >= nzl) exit
if (jtx(i+kx) == icl) then
val(ki) = vtx(i+kx)
else
ki = ki+1
val(ki) = vtx(i+kx)
ja(ki) = ja(i+kx)
icl = ja(i+kx)
endif
enddo
case(psb_dupl_add_)
do
kx = kx + 1
if (kx >= nzl) exit
if (jtx(i+kx) == icl) then
val(ki) = val(ki) + vtx(i+kx)
else
ki = ki+1
val(ki) = vtx(i+kx)
ja(ki) = ja(i+kx)
icl = ja(i+kx)
endif
enddo
case(psb_dupl_err_)
do
kx = kx + 1
if (kx >= nzl) exit
if (jtx(i+kx) == icl) then
call psb_errpush(psb_err_duplicate_coo,name)
goto 9999
else
ki = ki+1
val(ki) = vtx(i+kx)
ja(ki) = ja(i+kx)
icl = ja(i+kx)
endif
enddo
case default
write(psb_err_unit,*) 'Error in fix_coo: unsafe dupl',dupl_
info =-7
end select
i = j
enddo
case(psb_dupl_err_)
do
j = j + 1
if (j > nzin) exit
if ((ia(j) == irw).and.(ja(j) == icl)) then
call psb_errpush(psb_err_duplicate_coo,name)
goto 9999
else
i = i+1
val(i) = val(j)
ia(i) = ia(j)
ja(i) = ja(j)
irw = ia(i)
icl = ja(i)
endif
enddo
case default
write(psb_err_unit,*) 'Error in fix_coo: unsafe dupl',dupl_
info =-7
end select
i = ki
!!$
!!$ i = 1
!!$ irw = ia(i)
!!$ icl = ja(i)
!!$ j = 1
!!$
!!$ select case(dupl_)
!!$ case(psb_dupl_ovwrt_)
!!$
!!$ do
!!$ j = j + 1
!!$ if (j > nzin) exit
!!$ if ((ia(j) == irw).and.(ja(j) == icl)) then
!!$ val(i) = val(j)
!!$ else
!!$ i = i+1
!!$ val(i) = val(j)
!!$ ia(i) = ia(j)
!!$ ja(i) = ja(j)
!!$ irw = ia(i)
!!$ icl = ja(i)
!!$ endif
!!$ enddo
!!$
!!$ case(psb_dupl_add_)
!!$
!!$ do
!!$ j = j + 1
!!$ if (j > nzin) exit
!!$ if ((ia(j) == irw).and.(ja(j) == icl)) then
!!$ val(i) = val(i) + val(j)
!!$ else
!!$ i = i+1
!!$ val(i) = val(j)
!!$ ia(i) = ia(j)
!!$ ja(i) = ja(j)
!!$ irw = ia(i)
!!$ icl = ja(i)
!!$ endif
!!$ enddo
!!$
!!$ case(psb_dupl_err_)
!!$ do
!!$ j = j + 1
!!$ if (j > nzin) exit
!!$ if ((ia(j) == irw).and.(ja(j) == icl)) then
!!$ call psb_errpush(psb_err_duplicate_coo,name)
!!$ goto 9999
!!$ else
!!$ i = i+1
!!$ val(i) = val(j)
!!$ ia(i) = ia(j)
!!$ ja(i) = ja(j)
!!$ irw = ia(i)
!!$ icl = ja(i)
!!$ endif
!!$ enddo
!!$ case default
!!$ write(psb_err_unit,*) 'Error in fix_coo: unsafe dupl',dupl_
!!$ info =-7
!!$ end select
!!$
!!$ end if
end if
if(debug_level >= psb_debug_serial_)&
& write(debug_unit,*) trim(name),': end second loop'
base/tools/psb_cdins.f90
+6 -6
View File
@@ -118,9 +118,9 @@ subroutine psb_cdinsrc(nz,ia,ja,desc_a,info,ila,jla)
end if
if (present(ila).and.present(jla)) then
call desc_a%indxmap%g2l(ia(1:nz),ila(1:nz),info,owned=.true.)
call desc_a%g2l(ia(1:nz),ila(1:nz),info,owned=.true.)
if (info == psb_success_) &
& call desc_a%indxmap%g2l_ins(ja(1:nz),jla(1:nz),info,mask=(ila(1:nz)>0))
& call desc_a%g2l_ins(ja(1:nz),jla(1:nz),info,mask=(ila(1:nz)>0))
else
if (present(ila).or.present(jla)) then
write(psb_err_unit,*) 'Inconsistent call : ',present(ila),present(jla)
@@ -131,10 +131,10 @@ subroutine psb_cdinsrc(nz,ia,ja,desc_a,info,ila,jla)
call psb_errpush(info,name)
goto 9999
end if
call desc_a%indxmap%g2l(ia(1:nz),ila_(1:nz),info,owned=.true.)
call desc_a%g2l(ia(1:nz),ila_(1:nz),info,owned=.true.)
if (info == psb_success_) then
jla_(1:nz) = ja(1:nz)
call desc_a%indxmap%g2lip_ins(jla_(1:nz),info,mask=(ila_(1:nz)>0))
call desc_a%g2lip_ins(jla_(1:nz),info,mask=(ila_(1:nz)>0))
end if
deallocate(ila_,jla_,stat=info)
end if
@@ -249,7 +249,7 @@ subroutine psb_cdinsc(nz,ja,desc,info,jla,mask,lidx)
end if
if (present(jla)) then
call desc%indxmap%g2l_ins(ja(1:nz),jla(1:nz),info,mask=mask,lidx=lidx)
call desc%g2l_ins(ja(1:nz),jla(1:nz),info,mask=mask,lidx=lidx)
else
allocate(jla_(nz),stat=info)
if (info /= psb_success_) then
@@ -257,7 +257,7 @@ subroutine psb_cdinsc(nz,ja,desc,info,jla,mask,lidx)
call psb_errpush(info,name)
goto 9999
end if
call desc%indxmap%g2l_ins(ja(1:nz),jla_(1:nz),info,mask=mask,lidx=lidx)
call desc%g2l_ins(ja(1:nz),jla_(1:nz),info,mask=mask,lidx=lidx)
deallocate(jla_)
end if
base/tools/psb_dspins.f90
+6 -6
View File
@@ -128,8 +128,8 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
goto 9999
end if
call desc_a%indxmap%g2l(ia(1:nz),ila(1:nz),info,owned=.true.)
call desc_a%indxmap%g2l_ins(ja(1:nz),jla(1:nz),info,mask=(ila(1:nz)>0))
call desc_a%g2l(ia(1:nz),ila(1:nz),info,owned=.true.)
call desc_a%g2l_ins(ja(1:nz),jla(1:nz),info,mask=(ila(1:nz)>0))
if (info /= psb_success_) then
ierr(1) = info
@@ -174,8 +174,8 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
goto 9999
end if
call desc_a%indxmap%g2l(ia(1:nz),ila(1:nz),info)
call desc_a%indxmap%g2l(ja(1:nz),jla(1:nz),info)
call desc_a%g2l(ia(1:nz),ila(1:nz),info)
call desc_a%g2l(ja(1:nz),jla(1:nz),info)
call a%csput(nz,ila,jla,val,ione,nrow,ione,ncol,info)
if (info /= psb_success_) then
@@ -277,8 +277,8 @@ subroutine psb_dspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info)
goto 9999
end if
call desc_ar%indxmap%g2l(ia(1:nz),ila(1:nz),info,owned=.true.)
call desc_ac%indxmap%g2l_ins(ja(1:nz),jla(1:nz),info, mask=(ila(1:nz)>0))
call desc_ar%g2l(ia(1:nz),ila(1:nz),info,owned=.true.)
call desc_ac%g2l_ins(ja(1:nz),jla(1:nz),info, mask=(ila(1:nz)>0))
if (psb_errstatus_fatal()) then
ierr(1) = info
base/tools/psb_glob_to_loc.f90
+2 -2
View File
@@ -94,7 +94,7 @@ subroutine psb_glob_to_loc2v(x,y,desc_a,info,iact,owned)
act = psb_toupper(act)
n = size(x)
call desc_a%indxmap%g2l(x(1:n),y(1:n),info,owned=owned)
call desc_a%g2l(x(1:n),y(1:n),info,owned=owned)
select case(act)
case('E','I')
@@ -217,7 +217,7 @@ subroutine psb_glob_to_loc1v(x,desc_a,info,iact,owned)
act = psb_toupper(act)
call desc_a%indxmap%g2lip(x,info,owned=owned)
call desc_a%g2lip(x,info,owned=owned)
select case(act)
case('E','I')
base/tools/psb_loc_to_glob.f90
+2 -2
View File
@@ -80,7 +80,7 @@ subroutine psb_loc_to_glob2v(x,y,desc_a,info,iact)
endif
act=psb_toupper(act)
call desc_a%indxmap%l2g(x,y,info)
call desc_a%l2g(x,y,info)
if (info /= psb_success_) then
select case(act)
@@ -190,7 +190,7 @@ subroutine psb_loc_to_glob1v(x,desc_a,info,iact)
endif
act = psb_toupper(act)
call desc_a%indxmap%l2gip(x,info)
call desc_a%l2gip(x,info)
if (info /= psb_success_) then
select case(act)
test/fileread/cf_sample.f90
+1 -1
View File
@@ -283,7 +283,7 @@ program cf_sample
write(psb_out_unit,'("Total memory occupation for PREC: ",i12)')precsize
write(psb_out_unit,'("Total memory occupation for DESC_A: ",i12)')descsize
write(psb_out_unit,'("Storage type for DESC_A : ",a)')&
& desc_a%indxmap%get_fmt()
& desc_a%get_fmt()
end if
call psb_gather(x_col_glob,x_col,desc_a,info,root=psb_root_)
test/fileread/df_sample.f90
+1 -1
View File
@@ -289,7 +289,7 @@ program df_sample
write(psb_out_unit,'("Total memory occupation for PREC: ",i12)')precsize
write(psb_out_unit,'("Total memory occupation for DESC_A: ",i12)')descsize
write(psb_out_unit,'("Storage type for DESC_A : ",a)')&
& desc_a%indxmap%get_fmt()
& desc_a%get_fmt()
end if
!!$ call psb_precdump(prec,info,prefix=trim(mtrx_file)//'_')
test/fileread/sf_sample.f90
+1 -1
View File
@@ -286,7 +286,7 @@ program sf_sample
write(psb_out_unit,'("Total memory occupation for PREC: ",i12)')precsize
write(psb_out_unit,'("Total memory occupation for DESC_A: ",i12)')descsize
write(psb_out_unit,'("Storage type for DESC_A : ",a)')&
& desc_a%indxmap%get_fmt()
& desc_a%get_fmt()
end if
!!$ call psb_precdump(prec,info,prefix=trim(mtrx_file)//'_')
test/fileread/zf_sample.f90
+1 -1
View File
@@ -283,7 +283,7 @@ program zf_sample
write(psb_out_unit,'("Total memory occupation for PREC: ",i12)')precsize
write(psb_out_unit,'("Total memory occupation for DESC_A: ",i12)')descsize
write(psb_out_unit,'("Storage type for DESC_A : ",a)')&
& desc_a%indxmap%get_fmt()
& desc_a%get_fmt()
end if
call psb_gather(x_col_glob,x_col,desc_a,info,root=psb_root_)
test/kernel/d_file_spmv.f90
+1 -1
View File
@@ -275,7 +275,7 @@ program d_file_spmv
write(psb_out_unit,'("MBYTES/S : ",F20.3)') bdwdth
bdwdth = times*nbytes/(tt2*1.d6)
write(psb_out_unit,'("MBYTES/S (trans): ",F20.3)') bdwdth
write(psb_out_unit,'("Storage type for DESC_A: ",a)') desc_a%indxmap%get_fmt()
write(psb_out_unit,'("Storage type for DESC_A: ",a)') desc_a%get_fmt()
end if
test/kernel/pdgenspmv.f90
+1 -1
View File
@@ -169,7 +169,7 @@ program pdgenspmv
write(psb_out_unit,'("MBYTES/S : ",F20.3)') bdwdth
bdwdth = times*nbytes/(tt2*1.d6)
write(psb_out_unit,'("MBYTES/S (trans): ",F20.3)') bdwdth
write(psb_out_unit,'("Storage type for DESC_A: ",a)') desc_a%indxmap%get_fmt()
write(psb_out_unit,'("Storage type for DESC_A: ",a)') desc_a%get_fmt()
write(psb_out_unit,'("Total memory occupation for DESC_A: ",i12)')descsize
end if
test/pargen/runs/ppde.inp
+1 -1
View File
@@ -2,7 +2,7 @@
BICGSTAB Iterative method BICGSTAB CGS BICG BICGSTABL RGMRES
BJAC Preconditioner NONE DIAG BJAC
CSR Storage format for matrix A: CSR COO JAD
040 Domain size (acutal system is this**3)
100 Domain size (acutal system is this**3)
2 Stopping criterion
1000 MAXIT
01 ITRACE