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

Fixes for IPK8

Browse Source
This commit is contained in:
sfilippone
2025-06-01 20:57:09 +02:00
parent 2f4c9dd579
commit b246223597
47 changed files with 377 additions and 349 deletions
Download Patch File Download Diff File Expand all files Collapse all files
samples/advanced/fileread/amg_cf_sample.f90
+3 -3
View File
@@ -342,7 +342,7 @@ program amg_cf_sample
call build_mtpart(aux_a,lnp)
endif
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)
case default
@@ -589,9 +589,9 @@ program amg_cf_sample
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,'(" ")')
samples/advanced/fileread/amg_df_sample.f90
+3 -3
View File
@@ -342,7 +342,7 @@ program amg_df_sample
call build_mtpart(aux_a,lnp)
endif
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)
case default
@@ -589,9 +589,9 @@ program amg_df_sample
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,'(" ")')
samples/advanced/fileread/amg_sf_sample.f90
+3 -3
View File
@@ -342,7 +342,7 @@ program amg_sf_sample
call build_mtpart(aux_a,lnp)
endif
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)
case default
@@ -589,9 +589,9 @@ program amg_sf_sample
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,'(" ")')
samples/advanced/fileread/amg_zf_sample.f90
+3 -3
View File
@@ -342,7 +342,7 @@ program amg_zf_sample
call build_mtpart(aux_a,lnp)
endif
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)
case default
@@ -589,9 +589,9 @@ program amg_zf_sample
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,'(" ")')
samples/advanced/pdegen/amg_d_genpde_mod.F90
+14 -14
View File
@@ -275,7 +275,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)
@@ -319,7 +319,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
@@ -327,27 +327,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)
@@ -741,7 +741,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)
@@ -781,7 +781,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
@@ -789,19 +789,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)
samples/advanced/pdegen/amg_s_genpde_mod.F90
+14 -14
View File
@@ -275,7 +275,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)
@@ -319,7 +319,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
@@ -327,27 +327,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)
@@ -741,7 +741,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)
@@ -781,7 +781,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
@@ -789,19 +789,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)