fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-16 02:49:03 +00:00
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'development' into remap-coarse

Browse Source
This commit is contained in:
Salvatore Filippone
2020-07-23 12:21:14 +02:00
parent 97a1cfca3e c78dce6ee0
commit db7def0433
107 changed files with 3663 additions and 2311 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/internals/psi_bld_tmphalo.f90
+1
View File
@@ -104,6 +104,7 @@ subroutine psi_bld_tmphalo(desc,info)
call desc%indxmap%l2gip(helem(1:nh),info)
if (info == psb_success_) call desc%indxmap%fnd_owner(helem(1:nh),hproc,info)
if (info == psb_success_) call desc%indxmap%set_halo_owner(hproc,info)
if (info == psb_success_) call desc%indxmap%xtnd_p_adjcncy(hproc)
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='fnd_owner')
base/internals/psi_crea_index.f90
+32 -8
View File
@@ -71,9 +71,9 @@ subroutine psi_i_crea_index(desc_a,index_in,index_out,nxch,nsnd,nrcv,info)
integer(psb_ipk_),parameter :: root=psb_root_,no_comm=-1
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name
logical, parameter :: do_timings=.false.
logical, parameter :: do_timings=.false., shuffle_dep_list=.false.
integer(psb_ipk_), save :: idx_phase1=-1, idx_phase2=-1, idx_phase3=-1
integer(psb_ipk_), save :: idx_phase11=-1, idx_phase12=-1, idx_phase13=-1
integer(psb_ipk_), save :: idx_phase21=-1, idx_phase22=-1, idx_phase13=-1
info = psb_success_
name='psi_crea_index'
@@ -95,10 +95,10 @@ subroutine psi_i_crea_index(desc_a,index_in,index_out,nxch,nsnd,nrcv,info)
& idx_phase2 = psb_get_timer_idx("PSI_CREA_INDEX: phase2")
if ((do_timings).and.(idx_phase3==-1)) &
& idx_phase3 = psb_get_timer_idx("PSI_CREA_INDEX: phase3")
!!$ if ((do_timings).and.(idx_phase11==-1)) &
!!$ & idx_phase11 = psb_get_timer_idx("PSI_CREA_INDEX: phase11 ")
!!$ if ((do_timings).and.(idx_phase12==-1)) &
!!$ & idx_phase12 = psb_get_timer_idx("PSI_CREA_INDEX: phase12")
if ((do_timings).and.(idx_phase21==-1)) &
& idx_phase21 = psb_get_timer_idx("PSI_CREA_INDEX: phase21 ")
if ((do_timings).and.(idx_phase22==-1)) &
& idx_phase22 = psb_get_timer_idx("PSI_CREA_INDEX: phase22")
!!$ if ((do_timings).and.(idx_phase13==-1)) &
!!$ & idx_phase13 = psb_get_timer_idx("PSI_CREA_INDEX: phase13")
@@ -123,6 +123,7 @@ subroutine psi_i_crea_index(desc_a,index_in,index_out,nxch,nsnd,nrcv,info)
if (do_timings) call psb_tic(idx_phase2)
if (choose_sorting(dlmax,dlavg,np)) then
if (do_timings) call psb_tic(idx_phase21)
call psi_bld_glb_dep_list(ictxt,&
& loc_dl,length_dl,c_dep_list,dl_ptr,info)
if (info /= 0) then
@@ -131,13 +132,15 @@ subroutine psi_i_crea_index(desc_a,index_in,index_out,nxch,nsnd,nrcv,info)
!!$ call psi_dl_check(dep_list,dl_lda,np,length_dl)
!!$
!!$ ! ....now i can sort dependency lists.
if (do_timings) call psb_toc(idx_phase21)
if (do_timings) call psb_tic(idx_phase22)
call psi_sort_dl(dl_ptr,c_dep_list,length_dl,ictxt,info)
if (info /= 0) then
write(0,*) me,trim(name),' From sort_dl ',info
end if
ldl = length_dl(me)
loc_dl = c_dep_list(dl_ptr(me):dl_ptr(me)+ldl-1)
if (do_timings) call psb_toc(idx_phase22)
!!$ if(info /= psb_success_) then
!!$ call psb_errpush(psb_err_from_subroutine_,name,a_err='psi_sort_dl')
!!$ goto 9999
@@ -146,7 +149,26 @@ subroutine psi_i_crea_index(desc_a,index_in,index_out,nxch,nsnd,nrcv,info)
else
! Do nothing
ldl = length_dl(me)
loc_dl = loc_dl(1:ldl)
loc_dl = loc_dl(1:ldl)
if (shuffle_dep_list) then
!
! Apply a random shuffle to the dependency list
! should improve the behaviour
!
block
! Algorithm 3.4.2P from TAOCP vol 2.
integer(psb_ipk_) :: tmp
integer :: j,k
real :: u
do j=ldl,2,-1
call random_number(u)
k = min(j,floor(j*u)+1)
tmp = loc_dl(k)
loc_dl(k) = loc_dl(j)
loc_dl(j) = tmp
end do
end block
end if
end if
if (do_timings) call psb_toc(idx_phase2)
@@ -189,7 +211,9 @@ contains
logical :: val
val = .not.(((dlmax>(26*4)).or.((dlavg>=(26*2)).and.(np>=128))))
val = (dlmax<16)
!val = .true.
val = .false.
end function choose_sorting
end subroutine psi_i_crea_index
base/modules/desc/psb_gen_block_map_mod.F90
+6 -6
View File
@@ -2192,7 +2192,7 @@ contains
integer(psb_ipk_) :: lb, ub, m
choice: if (n >5) then
binsrch: if (n > 8) then
lb = 1
ub = n
ipos = -1
@@ -2201,7 +2201,7 @@ contains
m = (lb+ub)/2
if (key==v(m)) then
ipos = m
exit choice
exit binsrch
else if (key < v(m)) then
ub = m-1
else
@@ -2215,7 +2215,7 @@ contains
else
! No binary search, do everything in the final cleanup
ipos = 0
end if choice
end if binsrch
! Final cleanup
! This is needed because V may contain repeated entries
@@ -2239,7 +2239,7 @@ contains
integer(psb_ipk_) :: lb, ub, m
choice: if (n >5) then
binsrch: if (n > 8) then
lb = 1
ub = n
ipos = -1
@@ -2248,7 +2248,7 @@ contains
m = (lb+ub)/2
if (key==v(m)) then
ipos = m
exit choice
exit binsrch
else if (key < v(m)) then
ub = m-1
else
@@ -2262,7 +2262,7 @@ contains
else
! No binary search, do everything in the final cleanup
ipos = 0
end if choice
end if binsrch
! Final cleanup
! This is needed because V may contain repeated entries
base/modules/penv/psi_c_collective_mod.F90
+1 -1
View File
@@ -1048,7 +1048,7 @@ contains
idx = bsdindx(ip+1)
p2ptag = psb_complex_tag
call mpi_send(valsnd(idx+1:idx+sz),sz,&
& psb_mpi_r_dpk_,prcid(ip+1),&
& psb_mpi_c_spk_,prcid(ip+1),&
& p2ptag, icomm,iret)
p2ptag = psb_int_swap_tag
call mpi_send(iasnd(idx+1:idx+sz),sz,&
base/modules/penv/psi_e_collective_mod.F90
+1 -1
View File
@@ -1416,7 +1416,7 @@ contains
idx = bsdindx(ip+1)
p2ptag = psb_int8_tag
call mpi_send(valsnd(idx+1:idx+sz),sz,&
& psb_mpi_r_dpk_,prcid(ip+1),&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,iret)
p2ptag = psb_int_swap_tag
call mpi_send(iasnd(idx+1:idx+sz),sz,&
base/modules/penv/psi_i2_collective_mod.F90
+1 -1
View File
@@ -1416,7 +1416,7 @@ contains
idx = bsdindx(ip+1)
p2ptag = psb_int2_tag
call mpi_send(valsnd(idx+1:idx+sz),sz,&
& psb_mpi_r_dpk_,prcid(ip+1),&
& psb_mpi_i2pk_,prcid(ip+1),&
& p2ptag, icomm,iret)
p2ptag = psb_int_swap_tag
call mpi_send(iasnd(idx+1:idx+sz),sz,&
base/modules/penv/psi_m_collective_mod.F90
+1 -1
View File
@@ -1416,7 +1416,7 @@ contains
idx = bsdindx(ip+1)
p2ptag = psb_int4_tag
call mpi_send(valsnd(idx+1:idx+sz),sz,&
& psb_mpi_r_dpk_,prcid(ip+1),&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,iret)
p2ptag = psb_int_swap_tag
call mpi_send(iasnd(idx+1:idx+sz),sz,&
base/modules/penv/psi_s_collective_mod.F90
+1 -1
View File
@@ -1539,7 +1539,7 @@ contains
idx = bsdindx(ip+1)
p2ptag = psb_real_tag
call mpi_send(valsnd(idx+1:idx+sz),sz,&
& psb_mpi_r_dpk_,prcid(ip+1),&
& psb_mpi_r_spk_,prcid(ip+1),&
& p2ptag, icomm,iret)
p2ptag = psb_int_swap_tag
call mpi_send(iasnd(idx+1:idx+sz),sz,&
base/modules/penv/psi_z_collective_mod.F90
+1 -1
View File
@@ -1048,7 +1048,7 @@ contains
idx = bsdindx(ip+1)
p2ptag = psb_dcomplex_tag
call mpi_send(valsnd(idx+1:idx+sz),sz,&
& psb_mpi_r_dpk_,prcid(ip+1),&
& psb_mpi_c_dpk_,prcid(ip+1),&
& p2ptag, icomm,iret)
p2ptag = psb_int_swap_tag
call mpi_send(iasnd(idx+1:idx+sz),sz,&
base/tools/psb_c_map.f90
+2 -3
View File
@@ -159,7 +159,7 @@ subroutine psb_c_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty)
end if
if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%p_desc_V,info)
if (info /= psb_success_) then
write(psb_err_unit,*) trim(name),' Error from inner routines',info
write(psb_err_unit,*) iam,' ',trim(name),' Error from inner routines',info
info = -1
else
if (.not.present(vty)) call yt%free(info)
@@ -173,7 +173,6 @@ subroutine psb_c_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty)
nc1 = map%desc_U%get_local_cols()
nr2 = map%desc_V%get_global_rows()
nc2 = map%desc_V%get_local_cols()
if (present(vtx).and.present(vty)) then
ptx => vtx
pty => vty
@@ -194,7 +193,7 @@ subroutine psb_c_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty)
end if
if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%desc_V,info)
if (info /= psb_success_) then
write(psb_err_unit,*) trim(name),' Error from inner routines',info
write(psb_err_unit,*) iam,' ',trim(name),' Error from inner routines',info
info = -1
else
if (.not.(present(vtx).and.present(vty) )) then
base/tools/psb_csphalo.F90
+1 -1
View File
@@ -1284,7 +1284,7 @@ Subroutine psb_c_lc_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,&
if(psb_get_errstatus() /= 0) return
info=psb_success_
name='psb_lc_csr_sphalo'
name='psb_c_lc_csr_sphalo'
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999
base/tools/psb_d_map.f90
+2 -3
View File
@@ -159,7 +159,7 @@ subroutine psb_d_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty)
end if
if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%p_desc_V,info)
if (info /= psb_success_) then
write(psb_err_unit,*) trim(name),' Error from inner routines',info
write(psb_err_unit,*) iam,' ',trim(name),' Error from inner routines',info
info = -1
else
if (.not.present(vty)) call yt%free(info)
@@ -173,7 +173,6 @@ subroutine psb_d_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty)
nc1 = map%desc_U%get_local_cols()
nr2 = map%desc_V%get_global_rows()
nc2 = map%desc_V%get_local_cols()
if (present(vtx).and.present(vty)) then
ptx => vtx
pty => vty
@@ -194,7 +193,7 @@ subroutine psb_d_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty)
end if
if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%desc_V,info)
if (info /= psb_success_) then
write(psb_err_unit,*) trim(name),' Error from inner routines',info
write(psb_err_unit,*) iam,' ',trim(name),' Error from inner routines',info
info = -1
else
if (.not.(present(vtx).and.present(vty) )) then
base/tools/psb_dsphalo.F90
+1 -1
View File
@@ -1284,7 +1284,7 @@ Subroutine psb_d_ld_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,&
if(psb_get_errstatus() /= 0) return
info=psb_success_
name='psb_ld_csr_sphalo'
name='psb_d_ld_csr_sphalo'
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999
base/tools/psb_s_map.f90
+2 -3
View File
@@ -159,7 +159,7 @@ subroutine psb_s_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty)
end if
if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%p_desc_V,info)
if (info /= psb_success_) then
write(psb_err_unit,*) trim(name),' Error from inner routines',info
write(psb_err_unit,*) iam,' ',trim(name),' Error from inner routines',info
info = -1
else
if (.not.present(vty)) call yt%free(info)
@@ -173,7 +173,6 @@ subroutine psb_s_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty)
nc1 = map%desc_U%get_local_cols()
nr2 = map%desc_V%get_global_rows()
nc2 = map%desc_V%get_local_cols()
if (present(vtx).and.present(vty)) then
ptx => vtx
pty => vty
@@ -194,7 +193,7 @@ subroutine psb_s_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty)
end if
if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%desc_V,info)
if (info /= psb_success_) then
write(psb_err_unit,*) trim(name),' Error from inner routines',info
write(psb_err_unit,*) iam,' ',trim(name),' Error from inner routines',info
info = -1
else
if (.not.(present(vtx).and.present(vty) )) then
base/tools/psb_ssphalo.F90
+1 -1
View File
@@ -1284,7 +1284,7 @@ Subroutine psb_s_ls_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,&
if(psb_get_errstatus() /= 0) return
info=psb_success_
name='psb_ls_csr_sphalo'
name='psb_s_ls_csr_sphalo'
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999
base/tools/psb_z_map.f90
+2 -3
View File
@@ -159,7 +159,7 @@ subroutine psb_z_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty)
end if
if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%p_desc_V,info)
if (info /= psb_success_) then
write(psb_err_unit,*) trim(name),' Error from inner routines',info
write(psb_err_unit,*) iam,' ',trim(name),' Error from inner routines',info
info = -1
else
if (.not.present(vty)) call yt%free(info)
@@ -173,7 +173,6 @@ subroutine psb_z_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty)
nc1 = map%desc_U%get_local_cols()
nr2 = map%desc_V%get_global_rows()
nc2 = map%desc_V%get_local_cols()
if (present(vtx).and.present(vty)) then
ptx => vtx
pty => vty
@@ -194,7 +193,7 @@ subroutine psb_z_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty)
end if
if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%desc_V,info)
if (info /= psb_success_) then
write(psb_err_unit,*) trim(name),' Error from inner routines',info
write(psb_err_unit,*) iam,' ',trim(name),' Error from inner routines',info
info = -1
else
if (.not.(present(vtx).and.present(vty) )) then
base/tools/psb_zsphalo.F90
+1 -1
View File
@@ -1284,7 +1284,7 @@ Subroutine psb_z_lz_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,&
if(psb_get_errstatus() /= 0) return
info=psb_success_
name='psb_lz_csr_sphalo'
name='psb_z_lz_csr_sphalo'
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999