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

mld2p4:

Browse Source 
tests/fileread/mld_cf_sample.f90
 tests/fileread/mld_df_sample.f90
 tests/fileread/mld_sf_sample.f90
 tests/fileread/mld_zf_sample.f90

Modified mat_dist and df_sample.
This commit is contained in:
Salvatore Filippone
2017-02-12 20:29:52 +00:00
parent c99c587c44
commit d675e315ca
4 changed files with 16 additions and 56 deletions
Download Patch File Download Diff File Expand all files Collapse all files
tests/fileread/mld_cf_sample.f90
+4 -14
View File
@@ -193,16 +193,8 @@ program mld_cf_sample
b_col_glob(i) = 1.d0
enddo
endif
call psb_bcast(ictxt,b_col_glob(1:m_problem))
else
call psb_bcast(ictxt,m_problem)
call psb_realloc(m_problem,1,aux_b,ircode)
if (ircode /= 0) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
endif
b_col_glob =>aux_b(:,1)
call psb_bcast(ictxt,b_col_glob(1:m_problem))
end if
! switch over different partition types
@@ -214,8 +206,7 @@ program mld_cf_sample
call part_block(i,m_problem,np,ipv,nv)
ivg(i) = ipv(1)
enddo
call psb_matdist(aux_a, a, ictxt, &
& desc_a,info,b_glob=b_col_glob,b=b_col,fmt=afmt,v=ivg)
call psb_matdist(aux_a, a, ictxt,desc_a,info,fmt=afmt,v=ivg)
else if (ipart == 2) then
if (iam == psb_root_) then
write(psb_out_unit,'("Partition type: graph")')
@@ -226,14 +217,13 @@ program mld_cf_sample
!!$ call psb_barrier(ictxt)
call distr_mtpart(psb_root_,ictxt)
call getv_mtpart(ivg)
call psb_matdist(aux_a, a, ictxt, &
& desc_a,info,b_glob=b_col_glob,b=b_col,fmt=afmt,v=ivg)
call psb_matdist(aux_a, a, ictxt,desc_a,info,fmt=afmt,v=ivg)
else
if (iam == psb_root_) write(psb_out_unit,'("Partition type: block")')
call psb_matdist(aux_a, a, ictxt, &
& desc_a,info,b_glob=b_col_glob,b=b_col,fmt=afmt,parts=part_block)
call psb_matdist(aux_a, a, ictxt, desc_a,info,fmt=afmt,parts=part_block)
end if
call psb_scatter(b_col_glob,b_col,desc_a,info,root=psb_root_)
call psb_geall(x_col,desc_a,info)
call x_col%zero()
call psb_geasb(x_col,desc_a,info)
tests/fileread/mld_df_sample.f90
+4 -14
View File
@@ -193,16 +193,8 @@ program mld_df_sample
b_col_glob(i) = 1.d0
enddo
endif
call psb_bcast(ictxt,b_col_glob(1:m_problem))
else
call psb_bcast(ictxt,m_problem)
call psb_realloc(m_problem,1,aux_b,ircode)
if (ircode /= 0) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
endif
b_col_glob =>aux_b(:,1)
call psb_bcast(ictxt,b_col_glob(1:m_problem))
end if
! switch over different partition types
@@ -214,8 +206,7 @@ program mld_df_sample
call part_block(i,m_problem,np,ipv,nv)
ivg(i) = ipv(1)
enddo
call psb_matdist(aux_a, a, ictxt, &
& desc_a,info,b_glob=b_col_glob,b=b_col,fmt=afmt,v=ivg)
call psb_matdist(aux_a, a, ictxt,desc_a,info,fmt=afmt,v=ivg)
else if (ipart == 2) then
if (iam == psb_root_) then
write(psb_out_unit,'("Partition type: graph")')
@@ -226,14 +217,13 @@ program mld_df_sample
!!$ call psb_barrier(ictxt)
call distr_mtpart(psb_root_,ictxt)
call getv_mtpart(ivg)
call psb_matdist(aux_a, a, ictxt, &
& desc_a,info,b_glob=b_col_glob,b=b_col,fmt=afmt,v=ivg)
call psb_matdist(aux_a, a, ictxt,desc_a,info,fmt=afmt,v=ivg)
else
if (iam == psb_root_) write(psb_out_unit,'("Partition type: block")')
call psb_matdist(aux_a, a, ictxt, &
& desc_a,info,b_glob=b_col_glob,b=b_col,fmt=afmt,parts=part_block)
call psb_matdist(aux_a, a, ictxt, desc_a,info,fmt=afmt,parts=part_block)
end if
call psb_scatter(b_col_glob,b_col,desc_a,info,root=psb_root_)
call psb_geall(x_col,desc_a,info)
call x_col%zero()
call psb_geasb(x_col,desc_a,info)
tests/fileread/mld_sf_sample.f90
+4 -14
View File
@@ -193,16 +193,8 @@ program mld_sf_sample
b_col_glob(i) = 1.d0
enddo
endif
call psb_bcast(ictxt,b_col_glob(1:m_problem))
else
call psb_bcast(ictxt,m_problem)
call psb_realloc(m_problem,1,aux_b,ircode)
if (ircode /= 0) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
endif
b_col_glob =>aux_b(:,1)
call psb_bcast(ictxt,b_col_glob(1:m_problem))
end if
! switch over different partition types
@@ -214,8 +206,7 @@ program mld_sf_sample
call part_block(i,m_problem,np,ipv,nv)
ivg(i) = ipv(1)
enddo
call psb_matdist(aux_a, a, ictxt, &
& desc_a,info,b_glob=b_col_glob,b=b_col,fmt=afmt,v=ivg)
call psb_matdist(aux_a, a, ictxt,desc_a,info,fmt=afmt,v=ivg)
else if (ipart == 2) then
if (iam == psb_root_) then
write(psb_out_unit,'("Partition type: graph")')
@@ -226,14 +217,13 @@ program mld_sf_sample
!!$ call psb_barrier(ictxt)
call distr_mtpart(psb_root_,ictxt)
call getv_mtpart(ivg)
call psb_matdist(aux_a, a, ictxt, &
& desc_a,info,b_glob=b_col_glob,b=b_col,fmt=afmt,v=ivg)
call psb_matdist(aux_a, a, ictxt,desc_a,info,fmt=afmt,v=ivg)
else
if (iam == psb_root_) write(psb_out_unit,'("Partition type: block")')
call psb_matdist(aux_a, a, ictxt, &
& desc_a,info,b_glob=b_col_glob,b=b_col,fmt=afmt,parts=part_block)
call psb_matdist(aux_a, a, ictxt, desc_a,info,fmt=afmt,parts=part_block)
end if
call psb_scatter(b_col_glob,b_col,desc_a,info,root=psb_root_)
call psb_geall(x_col,desc_a,info)
call x_col%zero()
call psb_geasb(x_col,desc_a,info)
tests/fileread/mld_zf_sample.f90
+4 -14
View File
@@ -193,16 +193,8 @@ program mld_zf_sample
b_col_glob(i) = 1.d0
enddo
endif
call psb_bcast(ictxt,b_col_glob(1:m_problem))
else
call psb_bcast(ictxt,m_problem)
call psb_realloc(m_problem,1,aux_b,ircode)
if (ircode /= 0) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
endif
b_col_glob =>aux_b(:,1)
call psb_bcast(ictxt,b_col_glob(1:m_problem))
end if
! switch over different partition types
@@ -214,8 +206,7 @@ program mld_zf_sample
call part_block(i,m_problem,np,ipv,nv)
ivg(i) = ipv(1)
enddo
call psb_matdist(aux_a, a, ictxt, &
& desc_a,info,b_glob=b_col_glob,b=b_col,fmt=afmt,v=ivg)
call psb_matdist(aux_a, a, ictxt,desc_a,info,fmt=afmt,v=ivg)
else if (ipart == 2) then
if (iam == psb_root_) then
write(psb_out_unit,'("Partition type: graph")')
@@ -226,14 +217,13 @@ program mld_zf_sample
!!$ call psb_barrier(ictxt)
call distr_mtpart(psb_root_,ictxt)
call getv_mtpart(ivg)
call psb_matdist(aux_a, a, ictxt, &
& desc_a,info,b_glob=b_col_glob,b=b_col,fmt=afmt,v=ivg)
call psb_matdist(aux_a, a, ictxt,desc_a,info,fmt=afmt,v=ivg)
else
if (iam == psb_root_) write(psb_out_unit,'("Partition type: block")')
call psb_matdist(aux_a, a, ictxt, &
& desc_a,info,b_glob=b_col_glob,b=b_col,fmt=afmt,parts=part_block)
call psb_matdist(aux_a, a, ictxt, desc_a,info,fmt=afmt,parts=part_block)
end if
call psb_scatter(b_col_glob,b_col,desc_a,info,root=psb_root_)
call psb_geall(x_col,desc_a,info)
call x_col%zero()
call psb_geasb(x_col,desc_a,info)