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.
stopcriterion
Salvatore Filippone 8 years ago
parent c99c587c44
commit d675e315ca

@ -193,16 +193,8 @@ program mld_cf_sample
b_col_glob(i) = 1.d0 b_col_glob(i) = 1.d0
enddo enddo
endif endif
call psb_bcast(ictxt,b_col_glob(1:m_problem))
else else
call psb_bcast(ictxt,m_problem) 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 end if
! switch over different partition types ! switch over different partition types
@ -214,8 +206,7 @@ program mld_cf_sample
call part_block(i,m_problem,np,ipv,nv) call part_block(i,m_problem,np,ipv,nv)
ivg(i) = ipv(1) ivg(i) = ipv(1)
enddo enddo
call psb_matdist(aux_a, a, ictxt, & call psb_matdist(aux_a, a, ictxt,desc_a,info,fmt=afmt,v=ivg)
& desc_a,info,b_glob=b_col_glob,b=b_col,fmt=afmt,v=ivg)
else if (ipart == 2) then else if (ipart == 2) then
if (iam == psb_root_) then if (iam == psb_root_) then
write(psb_out_unit,'("Partition type: graph")') write(psb_out_unit,'("Partition type: graph")')
@ -226,14 +217,13 @@ program mld_cf_sample
!!$ call psb_barrier(ictxt) !!$ call psb_barrier(ictxt)
call distr_mtpart(psb_root_,ictxt) call distr_mtpart(psb_root_,ictxt)
call getv_mtpart(ivg) call getv_mtpart(ivg)
call psb_matdist(aux_a, a, ictxt, & call psb_matdist(aux_a, a, ictxt,desc_a,info,fmt=afmt,v=ivg)
& desc_a,info,b_glob=b_col_glob,b=b_col,fmt=afmt,v=ivg)
else else
if (iam == psb_root_) write(psb_out_unit,'("Partition type: block")') if (iam == psb_root_) write(psb_out_unit,'("Partition type: block")')
call psb_matdist(aux_a, a, ictxt, & call psb_matdist(aux_a, a, ictxt, desc_a,info,fmt=afmt,parts=part_block)
& desc_a,info,b_glob=b_col_glob,b=b_col,fmt=afmt,parts=part_block)
end if 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 psb_geall(x_col,desc_a,info)
call x_col%zero() call x_col%zero()
call psb_geasb(x_col,desc_a,info) call psb_geasb(x_col,desc_a,info)

@ -193,16 +193,8 @@ program mld_df_sample
b_col_glob(i) = 1.d0 b_col_glob(i) = 1.d0
enddo enddo
endif endif
call psb_bcast(ictxt,b_col_glob(1:m_problem))
else else
call psb_bcast(ictxt,m_problem) 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 end if
! switch over different partition types ! switch over different partition types
@ -214,8 +206,7 @@ program mld_df_sample
call part_block(i,m_problem,np,ipv,nv) call part_block(i,m_problem,np,ipv,nv)
ivg(i) = ipv(1) ivg(i) = ipv(1)
enddo enddo
call psb_matdist(aux_a, a, ictxt, & call psb_matdist(aux_a, a, ictxt,desc_a,info,fmt=afmt,v=ivg)
& desc_a,info,b_glob=b_col_glob,b=b_col,fmt=afmt,v=ivg)
else if (ipart == 2) then else if (ipart == 2) then
if (iam == psb_root_) then if (iam == psb_root_) then
write(psb_out_unit,'("Partition type: graph")') write(psb_out_unit,'("Partition type: graph")')
@ -226,14 +217,13 @@ program mld_df_sample
!!$ call psb_barrier(ictxt) !!$ call psb_barrier(ictxt)
call distr_mtpart(psb_root_,ictxt) call distr_mtpart(psb_root_,ictxt)
call getv_mtpart(ivg) call getv_mtpart(ivg)
call psb_matdist(aux_a, a, ictxt, & call psb_matdist(aux_a, a, ictxt,desc_a,info,fmt=afmt,v=ivg)
& desc_a,info,b_glob=b_col_glob,b=b_col,fmt=afmt,v=ivg)
else else
if (iam == psb_root_) write(psb_out_unit,'("Partition type: block")') if (iam == psb_root_) write(psb_out_unit,'("Partition type: block")')
call psb_matdist(aux_a, a, ictxt, & call psb_matdist(aux_a, a, ictxt, desc_a,info,fmt=afmt,parts=part_block)
& desc_a,info,b_glob=b_col_glob,b=b_col,fmt=afmt,parts=part_block)
end if 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 psb_geall(x_col,desc_a,info)
call x_col%zero() call x_col%zero()
call psb_geasb(x_col,desc_a,info) call psb_geasb(x_col,desc_a,info)

@ -193,16 +193,8 @@ program mld_sf_sample
b_col_glob(i) = 1.d0 b_col_glob(i) = 1.d0
enddo enddo
endif endif
call psb_bcast(ictxt,b_col_glob(1:m_problem))
else else
call psb_bcast(ictxt,m_problem) 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 end if
! switch over different partition types ! switch over different partition types
@ -214,8 +206,7 @@ program mld_sf_sample
call part_block(i,m_problem,np,ipv,nv) call part_block(i,m_problem,np,ipv,nv)
ivg(i) = ipv(1) ivg(i) = ipv(1)
enddo enddo
call psb_matdist(aux_a, a, ictxt, & call psb_matdist(aux_a, a, ictxt,desc_a,info,fmt=afmt,v=ivg)
& desc_a,info,b_glob=b_col_glob,b=b_col,fmt=afmt,v=ivg)
else if (ipart == 2) then else if (ipart == 2) then
if (iam == psb_root_) then if (iam == psb_root_) then
write(psb_out_unit,'("Partition type: graph")') write(psb_out_unit,'("Partition type: graph")')
@ -226,14 +217,13 @@ program mld_sf_sample
!!$ call psb_barrier(ictxt) !!$ call psb_barrier(ictxt)
call distr_mtpart(psb_root_,ictxt) call distr_mtpart(psb_root_,ictxt)
call getv_mtpart(ivg) call getv_mtpart(ivg)
call psb_matdist(aux_a, a, ictxt, & call psb_matdist(aux_a, a, ictxt,desc_a,info,fmt=afmt,v=ivg)
& desc_a,info,b_glob=b_col_glob,b=b_col,fmt=afmt,v=ivg)
else else
if (iam == psb_root_) write(psb_out_unit,'("Partition type: block")') if (iam == psb_root_) write(psb_out_unit,'("Partition type: block")')
call psb_matdist(aux_a, a, ictxt, & call psb_matdist(aux_a, a, ictxt, desc_a,info,fmt=afmt,parts=part_block)
& desc_a,info,b_glob=b_col_glob,b=b_col,fmt=afmt,parts=part_block)
end if 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 psb_geall(x_col,desc_a,info)
call x_col%zero() call x_col%zero()
call psb_geasb(x_col,desc_a,info) call psb_geasb(x_col,desc_a,info)

@ -193,16 +193,8 @@ program mld_zf_sample
b_col_glob(i) = 1.d0 b_col_glob(i) = 1.d0
enddo enddo
endif endif
call psb_bcast(ictxt,b_col_glob(1:m_problem))
else else
call psb_bcast(ictxt,m_problem) 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 end if
! switch over different partition types ! switch over different partition types
@ -214,8 +206,7 @@ program mld_zf_sample
call part_block(i,m_problem,np,ipv,nv) call part_block(i,m_problem,np,ipv,nv)
ivg(i) = ipv(1) ivg(i) = ipv(1)
enddo enddo
call psb_matdist(aux_a, a, ictxt, & call psb_matdist(aux_a, a, ictxt,desc_a,info,fmt=afmt,v=ivg)
& desc_a,info,b_glob=b_col_glob,b=b_col,fmt=afmt,v=ivg)
else if (ipart == 2) then else if (ipart == 2) then
if (iam == psb_root_) then if (iam == psb_root_) then
write(psb_out_unit,'("Partition type: graph")') write(psb_out_unit,'("Partition type: graph")')
@ -226,14 +217,13 @@ program mld_zf_sample
!!$ call psb_barrier(ictxt) !!$ call psb_barrier(ictxt)
call distr_mtpart(psb_root_,ictxt) call distr_mtpart(psb_root_,ictxt)
call getv_mtpart(ivg) call getv_mtpart(ivg)
call psb_matdist(aux_a, a, ictxt, & call psb_matdist(aux_a, a, ictxt,desc_a,info,fmt=afmt,v=ivg)
& desc_a,info,b_glob=b_col_glob,b=b_col,fmt=afmt,v=ivg)
else else
if (iam == psb_root_) write(psb_out_unit,'("Partition type: block")') if (iam == psb_root_) write(psb_out_unit,'("Partition type: block")')
call psb_matdist(aux_a, a, ictxt, & call psb_matdist(aux_a, a, ictxt, desc_a,info,fmt=afmt,parts=part_block)
& desc_a,info,b_glob=b_col_glob,b=b_col,fmt=afmt,parts=part_block)
end if 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 psb_geall(x_col,desc_a,info)
call x_col%zero() call x_col%zero()
call psb_geasb(x_col,desc_a,info) call psb_geasb(x_col,desc_a,info)

Loading…
Cancel
Save