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

Fixes for IPK8

Browse Source
This commit is contained in:
sfilippone
2025-06-01 20:56:11 +02:00
parent 4d0226b7d6
commit 07fa2323eb
162 changed files with 1873 additions and 1338 deletions
Download Patch File Download Diff File Expand all files Collapse all files
test/fileread/psb_cf_sample.f90
+4 -4
View File
@@ -185,7 +185,7 @@ program psb_cf_sample
endif
call psb_barrier(ctxt)
call distr_mtpart(psb_root_,ctxt)
call distr_mtpart(ione*psb_root_,ctxt)
call getv_mtpart(ivg)
call psb_matdist(aux_a, a, ctxt,desc_a,info,fmt=afmt,vg=ivg)
@@ -194,7 +194,7 @@ program psb_cf_sample
call psb_matdist(aux_a, a, ctxt,desc_a,info,fmt=afmt,parts=part_block)
end select
call psb_scatter(b_col_glob,b_col,desc_a,info,root=psb_root_)
call psb_scatter(b_col_glob,b_col,desc_a,info,root=ione*psb_root_)
call psb_geall(x_col,desc_a,info)
call x_col%zero()
call psb_geasb(x_col,desc_a,info)
@@ -274,9 +274,9 @@ program psb_cf_sample
& desc_a%get_fmt()
end if
call psb_gather(x_col_glob,x_col,desc_a,info,root=psb_root_)
call psb_gather(x_col_glob,x_col,desc_a,info,root=ione*psb_root_)
if (info == psb_success_) &
& call psb_gather(r_col_glob,r_col,desc_a,info,root=psb_root_)
& call psb_gather(r_col_glob,r_col,desc_a,info,root=ione*psb_root_)
if (info /= psb_success_) goto 9999
if (iam == psb_root_) then
write(psb_err_unit,'(" ")')
test/fileread/psb_df_sample.f90
+4 -4
View File
@@ -185,7 +185,7 @@ program psb_df_sample
endif
call psb_barrier(ctxt)
call distr_mtpart(psb_root_,ctxt)
call distr_mtpart(ione*psb_root_,ctxt)
call getv_mtpart(ivg)
call psb_matdist(aux_a, a, ctxt,desc_a,info,fmt=afmt,vg=ivg)
@@ -194,7 +194,7 @@ program psb_df_sample
call psb_matdist(aux_a, a, ctxt,desc_a,info,fmt=afmt,parts=part_block)
end select
call psb_scatter(b_col_glob,b_col,desc_a,info,root=psb_root_)
call psb_scatter(b_col_glob,b_col,desc_a,info,root=ione*psb_root_)
call psb_geall(x_col,desc_a,info)
call x_col%zero()
call psb_geasb(x_col,desc_a,info)
@@ -276,9 +276,9 @@ program psb_df_sample
& desc_a%get_fmt()
end if
call psb_gather(x_col_glob,x_col,desc_a,info,root=psb_root_)
call psb_gather(x_col_glob,x_col,desc_a,info,root=ione*psb_root_)
if (info == psb_success_) &
& call psb_gather(r_col_glob,r_col,desc_a,info,root=psb_root_)
& call psb_gather(r_col_glob,r_col,desc_a,info,root=ione*psb_root_)
if (info /= psb_success_) goto 9999
if (iam == psb_root_) then
write(psb_err_unit,'(" ")')
test/fileread/psb_sf_sample.f90
+4 -4
View File
@@ -185,7 +185,7 @@ program psb_sf_sample
endif
call psb_barrier(ctxt)
call distr_mtpart(psb_root_,ctxt)
call distr_mtpart(ione*psb_root_,ctxt)
call getv_mtpart(ivg)
call psb_matdist(aux_a, a, ctxt,desc_a,info,fmt=afmt,vg=ivg)
@@ -194,7 +194,7 @@ program psb_sf_sample
call psb_matdist(aux_a, a, ctxt,desc_a,info,fmt=afmt,parts=part_block)
end select
call psb_scatter(b_col_glob,b_col,desc_a,info,root=psb_root_)
call psb_scatter(b_col_glob,b_col,desc_a,info,root=ione*psb_root_)
call psb_geall(x_col,desc_a,info)
call x_col%zero()
call psb_geasb(x_col,desc_a,info)
@@ -276,9 +276,9 @@ program psb_sf_sample
& desc_a%get_fmt()
end if
call psb_gather(x_col_glob,x_col,desc_a,info,root=psb_root_)
call psb_gather(x_col_glob,x_col,desc_a,info,root=ione*psb_root_)
if (info == psb_success_) &
& call psb_gather(r_col_glob,r_col,desc_a,info,root=psb_root_)
& call psb_gather(r_col_glob,r_col,desc_a,info,root=ione*psb_root_)
if (info /= psb_success_) goto 9999
if (iam == psb_root_) then
write(psb_err_unit,'(" ")')
test/fileread/psb_zf_sample.f90
+4 -4
View File
@@ -185,7 +185,7 @@ program psb_zf_sample
endif
call psb_barrier(ctxt)
call distr_mtpart(psb_root_,ctxt)
call distr_mtpart(ione*psb_root_,ctxt)
call getv_mtpart(ivg)
call psb_matdist(aux_a, a, ctxt,desc_a,info,fmt=afmt,vg=ivg)
@@ -194,7 +194,7 @@ program psb_zf_sample
call psb_matdist(aux_a, a, ctxt,desc_a,info,fmt=afmt,parts=part_block)
end select
call psb_scatter(b_col_glob,b_col,desc_a,info,root=psb_root_)
call psb_scatter(b_col_glob,b_col,desc_a,info,root=ione*psb_root_)
call psb_geall(x_col,desc_a,info)
call x_col%zero()
call psb_geasb(x_col,desc_a,info)
@@ -274,9 +274,9 @@ program psb_zf_sample
& desc_a%get_fmt()
end if
call psb_gather(x_col_glob,x_col,desc_a,info,root=psb_root_)
call psb_gather(x_col_glob,x_col,desc_a,info,root=ione*psb_root_)
if (info == psb_success_) &
& call psb_gather(r_col_glob,r_col,desc_a,info,root=psb_root_)
& call psb_gather(r_col_glob,r_col,desc_a,info,root=ione*psb_root_)
if (info /= psb_success_) goto 9999
if (iam == psb_root_) then
write(psb_err_unit,'(" ")')
test/pdegen/psb_d_pde2d.F90
+6 -6
View File
@@ -328,7 +328,7 @@ contains
allocate(bndx(0:npx),bndy(0:npy))
! We can reuse idx2ijk for process indices as well.
call idx2ijk(iamx,iamy,iam,npx,npy,base=0)
call idx2ijk(iamx,iamy,iam,npx,npy,base=mzero)
! Now let's split the 2D square in rectangles
call dist1Didx(bndx,idim,npx)
mynx = bndx(iamx+1)-bndx(iamx)
@@ -368,7 +368,7 @@ contains
!
! Use adjcncy methods
!
integer(psb_mpk_), allocatable :: neighbours(:)
integer(psb_ipk_), allocatable :: neighbours(:)
integer(psb_mpk_) :: cnt
logical, parameter :: debug_adj=.true.
if (debug_adj.and.(np > 1)) then
@@ -376,19 +376,19 @@ contains
allocate(neighbours(np))
if (iamx < npx-1) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx+1,iamy,npx,npy,base=0)
call ijk2idx(neighbours(cnt),iamx+1,iamy,npx,npy,base=mzero)
end if
if (iamy < npy-1) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx,iamy+1,npx,npy,base=0)
call ijk2idx(neighbours(cnt),iamx,iamy+1,npx,npy,base=mzero)
end if
if (iamx >0) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx-1,iamy,npx,npy,base=0)
call ijk2idx(neighbours(cnt),iamx-1,iamy,npx,npy,base=mzero)
end if
if (iamy >0) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx,iamy-1,npx,npy,base=0)
call ijk2idx(neighbours(cnt),iamx,iamy-1,npx,npy,base=mzero)
end if
call psb_realloc(cnt, neighbours,info)
call desc_a%set_p_adjcncy(neighbours)
test/pdegen/psb_d_pde3d.F90
+8 -8
View File
@@ -345,7 +345,7 @@ contains
allocate(bndx(0:npx),bndy(0:npy),bndz(0:npz))
! We can reuse idx2ijk for process indices as well.
call idx2ijk(iamx,iamy,iamz,iam,npx,npy,npz,base=0)
call idx2ijk(iamx,iamy,iamz,iam,npx,npy,npz,base=mzero)
! Now let's split the 3D cube in hexahedra
call dist1Didx(bndx,idim,npx)
mynx = bndx(iamx+1)-bndx(iamx)
@@ -389,7 +389,7 @@ contains
!
! Use adjcncy methods
!
integer(psb_mpk_), allocatable :: neighbours(:)
integer(psb_ipk_), allocatable :: neighbours(:)
integer(psb_mpk_) :: cnt
logical, parameter :: debug_adj=.true.
if (debug_adj.and.(np > 1)) then
@@ -397,27 +397,27 @@ contains
allocate(neighbours(np))
if (iamx < npx-1) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx+1,iamy,iamz,npx,npy,npz,base=0)
call ijk2idx(neighbours(cnt),iamx+1,iamy,iamz,npx,npy,npz,base=mzero)
end if
if (iamy < npy-1) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx,iamy+1,iamz,npx,npy,npz,base=0)
call ijk2idx(neighbours(cnt),iamx,iamy+1,iamz,npx,npy,npz,base=mzero)
end if
if (iamz < npz-1) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx,iamy,iamz+1,npx,npy,npz,base=0)
call ijk2idx(neighbours(cnt),iamx,iamy,iamz+1,npx,npy,npz,base=mzero)
end if
if (iamx >0) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx-1,iamy,iamz,npx,npy,npz,base=0)
call ijk2idx(neighbours(cnt),iamx-1,iamy,iamz,npx,npy,npz,base=mzero)
end if
if (iamy >0) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx,iamy-1,iamz,npx,npy,npz,base=0)
call ijk2idx(neighbours(cnt),iamx,iamy-1,iamz,npx,npy,npz,base=mzero)
end if
if (iamz >0) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx,iamy,iamz-1,npx,npy,npz,base=0)
call ijk2idx(neighbours(cnt),iamx,iamy,iamz-1,npx,npy,npz,base=mzero)
end if
call psb_realloc(cnt, neighbours,info)
call desc_a%set_p_adjcncy(neighbours)
test/pdegen/psb_s_pde2d.F90
+6 -6
View File
@@ -328,7 +328,7 @@ contains
allocate(bndx(0:npx),bndy(0:npy))
! We can reuse idx2ijk for process indices as well.
call idx2ijk(iamx,iamy,iam,npx,npy,base=0)
call idx2ijk(iamx,iamy,iam,npx,npy,base=mzero)
! Now let's split the 2D square in rectangles
call dist1Didx(bndx,idim,npx)
mynx = bndx(iamx+1)-bndx(iamx)
@@ -368,7 +368,7 @@ contains
!
! Use adjcncy methods
!
integer(psb_mpk_), allocatable :: neighbours(:)
integer(psb_ipk_), allocatable :: neighbours(:)
integer(psb_mpk_) :: cnt
logical, parameter :: debug_adj=.true.
if (debug_adj.and.(np > 1)) then
@@ -376,19 +376,19 @@ contains
allocate(neighbours(np))
if (iamx < npx-1) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx+1,iamy,npx,npy,base=0)
call ijk2idx(neighbours(cnt),iamx+1,iamy,npx,npy,base=mzero)
end if
if (iamy < npy-1) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx,iamy+1,npx,npy,base=0)
call ijk2idx(neighbours(cnt),iamx,iamy+1,npx,npy,base=mzero)
end if
if (iamx >0) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx-1,iamy,npx,npy,base=0)
call ijk2idx(neighbours(cnt),iamx-1,iamy,npx,npy,base=mzero)
end if
if (iamy >0) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx,iamy-1,npx,npy,base=0)
call ijk2idx(neighbours(cnt),iamx,iamy-1,npx,npy,base=mzero)
end if
call psb_realloc(cnt, neighbours,info)
call desc_a%set_p_adjcncy(neighbours)
test/pdegen/psb_s_pde3d.F90
+8 -8
View File
@@ -345,7 +345,7 @@ contains
allocate(bndx(0:npx),bndy(0:npy),bndz(0:npz))
! We can reuse idx2ijk for process indices as well.
call idx2ijk(iamx,iamy,iamz,iam,npx,npy,npz,base=0)
call idx2ijk(iamx,iamy,iamz,iam,npx,npy,npz,base=mzero)
! Now let's split the 3D cube in hexahedra
call dist1Didx(bndx,idim,npx)
mynx = bndx(iamx+1)-bndx(iamx)
@@ -389,7 +389,7 @@ contains
!
! Use adjcncy methods
!
integer(psb_mpk_), allocatable :: neighbours(:)
integer(psb_ipk_), allocatable :: neighbours(:)
integer(psb_mpk_) :: cnt
logical, parameter :: debug_adj=.true.
if (debug_adj.and.(np > 1)) then
@@ -397,27 +397,27 @@ contains
allocate(neighbours(np))
if (iamx < npx-1) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx+1,iamy,iamz,npx,npy,npz,base=0)
call ijk2idx(neighbours(cnt),iamx+1,iamy,iamz,npx,npy,npz,base=mzero)
end if
if (iamy < npy-1) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx,iamy+1,iamz,npx,npy,npz,base=0)
call ijk2idx(neighbours(cnt),iamx,iamy+1,iamz,npx,npy,npz,base=mzero)
end if
if (iamz < npz-1) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx,iamy,iamz+1,npx,npy,npz,base=0)
call ijk2idx(neighbours(cnt),iamx,iamy,iamz+1,npx,npy,npz,base=mzero)
end if
if (iamx >0) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx-1,iamy,iamz,npx,npy,npz,base=0)
call ijk2idx(neighbours(cnt),iamx-1,iamy,iamz,npx,npy,npz,base=mzero)
end if
if (iamy >0) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx,iamy-1,iamz,npx,npy,npz,base=0)
call ijk2idx(neighbours(cnt),iamx,iamy-1,iamz,npx,npy,npz,base=mzero)
end if
if (iamz >0) then
cnt = cnt + 1
call ijk2idx(neighbours(cnt),iamx,iamy,iamz-1,npx,npy,npz,base=0)
call ijk2idx(neighbours(cnt),iamx,iamy,iamz-1,npx,npy,npz,base=mzero)
end if
call psb_realloc(cnt, neighbours,info)
call desc_a%set_p_adjcncy(neighbours)