mirror of
https://github.com/sfilippone/amg4psblas.git
synced 2026-10-06 22:55:12 +00:00
mld2p4-2:
examples/fileread/mld_cexample_1lev.f90 examples/fileread/mld_cexample_ml.f90 examples/fileread/mld_dexample_1lev.f90 examples/fileread/mld_dexample_ml.f90 examples/fileread/mld_sexample_1lev.f90 examples/fileread/mld_sexample_ml.f90 examples/fileread/mld_zexample_1lev.f90 examples/fileread/mld_zexample_ml.f90 Fix interface for matdist.
This commit is contained in:
Salvatore Filippone
@@ -69,9 +69,9 @@ program mld_cexample_ml
|
||||
type(mld_cprec_type) :: P
|
||||
|
||||
! right-hand side, solution and residual vectors
|
||||
complex(psb_spk_), allocatable , save :: b(:), x(:), r(:), &
|
||||
& x_glob(:), r_glob(:)
|
||||
complex(psb_spk_), allocatable, target :: aux_b(:,:)
|
||||
type(psb_c_vect_type) :: b, x, r
|
||||
complex(psb_spk_), allocatable , save :: x_glob(:), r_glob(:)
|
||||
complex(psb_spk_), allocatable, target :: aux_b(:,:)
|
||||
complex(psb_spk_), pointer :: b_glob(:)
|
||||
|
||||
! solver and preconditioner parameters
|
||||
@@ -172,22 +172,14 @@ program mld_cexample_ml
|
||||
b_glob(i) = 1.d0
|
||||
enddo
|
||||
endif
|
||||
call psb_bcast(ictxt,b_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_glob =>aux_b(:,1)
|
||||
call psb_bcast(ictxt,b_glob(1:m_problem))
|
||||
end if
|
||||
|
||||
call psb_barrier(ictxt)
|
||||
if (iam == psb_root_) write(*,'("Partition type: block")')
|
||||
call psb_matdist(aux_A, A, ictxt, &
|
||||
& desc_A,info,b_glob=b_glob,b=b, parts=part_block)
|
||||
call psb_matdist(aux_A, A, ictxt, desc_A,info,parts=part_block)
|
||||
call psb_scatter(b_glob,b,desc_a,info,root=psb_root_)
|
||||
|
||||
t2 = psb_wtime() - t1
|
||||
|
||||
@@ -221,7 +213,7 @@ program mld_cexample_ml
|
||||
! set the initial guess
|
||||
|
||||
call psb_geall(x,desc_A,info)
|
||||
x(:) =0.0
|
||||
call x%zero()
|
||||
call psb_geasb(x,desc_A,info)
|
||||
|
||||
! solve Ax=b with preconditioned BiCGSTAB
|
||||
@@ -234,13 +226,11 @@ program mld_cexample_ml
|
||||
t2 = psb_wtime() - t1
|
||||
call psb_amx(ictxt,t2)
|
||||
|
||||
call psb_geall(r,desc_A,info)
|
||||
r(:) =0.0
|
||||
call psb_geasb(r,desc_A,info)
|
||||
call psb_geasb(r,desc_A,info,scratch=.true.)
|
||||
call psb_geaxpby(cone,b,czero,r,desc_A,info)
|
||||
call psb_spmm(-cone,A,x,cone,r,desc_A,info)
|
||||
call psb_genrm2s(resmx,r,desc_A,info)
|
||||
call psb_geamaxs(resmxp,r,desc_A,info)
|
||||
resmx = psb_genrm2(r,desc_A,info)
|
||||
resmxp = psb_geamax(r,desc_A,info)
|
||||
|
||||
amatsize = a%sizeof()
|
||||
descsize = desc_a%sizeof()
|
||||
@@ -268,9 +258,9 @@ program mld_cexample_ml
|
||||
write(*,'("Total memory occupation for PREC : ",i12)')precsize
|
||||
end if
|
||||
|
||||
call psb_gather(x_glob,x_col,desc_a,info,root=psb_root_)
|
||||
call psb_gather(x_glob,x,desc_a,info,root=psb_root_)
|
||||
if (info == psb_success_) &
|
||||
& call psb_gather(r_glob,r_col,desc_a,info,root=psb_root_)
|
||||
& call psb_gather(r_glob,r,desc_a,info,root=psb_root_)
|
||||
if (info /= psb_success_) goto 9999
|
||||
if (iam == psb_root_) then
|
||||
write(0,'(" ")')
|
||||
|
||||
@@ -72,8 +72,8 @@ program mld_cexample_ml
|
||||
type(mld_cprec_type) :: P
|
||||
|
||||
! right-hand side, solution and residual vectors
|
||||
complex(psb_spk_), allocatable , save :: b(:), x(:), r(:), &
|
||||
& x_glob(:), r_glob(:)
|
||||
type(psb_c_vect_type) :: b, x, r
|
||||
complex(psb_spk_), allocatable , save :: x_glob(:), r_glob(:)
|
||||
complex(psb_spk_), allocatable, target :: aux_b(:,:)
|
||||
complex(psb_spk_), pointer :: b_glob(:)
|
||||
|
||||
@@ -176,22 +176,14 @@ program mld_cexample_ml
|
||||
b_glob(i) = 1.d0
|
||||
enddo
|
||||
endif
|
||||
call psb_bcast(ictxt,b_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_glob =>aux_b(:,1)
|
||||
call psb_bcast(ictxt,b_glob(1:m_problem))
|
||||
end if
|
||||
|
||||
call psb_barrier(ictxt)
|
||||
if (iam == psb_root_) write(*,'("Partition type: block")')
|
||||
call psb_matdist(aux_A, A, ictxt, &
|
||||
& desc_A,info,b_glob=b_glob,b=b, parts=part_block)
|
||||
call psb_matdist(aux_A, A, ictxt, desc_A,info,parts=part_block)
|
||||
call psb_scatter(b_glob,b,desc_a,info,root=psb_root_)
|
||||
|
||||
t2 = psb_wtime() - t1
|
||||
|
||||
@@ -258,7 +250,7 @@ program mld_cexample_ml
|
||||
! set the initial guess
|
||||
|
||||
call psb_geall(x,desc_A,info)
|
||||
x(:) =0.0
|
||||
call x%zero()
|
||||
call psb_geasb(x,desc_A,info)
|
||||
|
||||
! solve Ax=b with preconditioned BiCGSTAB
|
||||
@@ -271,13 +263,11 @@ program mld_cexample_ml
|
||||
t2 = psb_wtime() - t1
|
||||
call psb_amx(ictxt,t2)
|
||||
|
||||
call psb_geall(r,desc_A,info)
|
||||
r(:) =0.0
|
||||
call psb_geasb(r,desc_A,info)
|
||||
call psb_geasb(r,desc_A,info,scratch=.true.)
|
||||
call psb_geaxpby(cone,b,czero,r,desc_A,info)
|
||||
call psb_spmm(-cone,A,x,cone,r,desc_A,info)
|
||||
call psb_genrm2s(resmx,r,desc_A,info)
|
||||
call psb_geamaxs(resmxp,r,desc_A,info)
|
||||
resmx = psb_genrm2(r,desc_A,info)
|
||||
resmxp = psb_geamax(r,desc_A,info)
|
||||
|
||||
amatsize = a%sizeof()
|
||||
descsize = desc_a%sizeof()
|
||||
@@ -305,9 +295,9 @@ program mld_cexample_ml
|
||||
write(*,'("Total memory occupation for PREC : ",i12)')precsize
|
||||
end if
|
||||
|
||||
call psb_gather(x_glob,x_col,desc_a,info,root=psb_root_)
|
||||
call psb_gather(x_glob,x,desc_a,info,root=psb_root_)
|
||||
if (info == psb_success_) &
|
||||
& call psb_gather(r_glob,r_col,desc_a,info,root=psb_root_)
|
||||
& call psb_gather(r_glob,r,desc_a,info,root=psb_root_)
|
||||
if (info /= psb_success_) goto 9999
|
||||
if (iam == psb_root_) then
|
||||
write(0,'(" ")')
|
||||
|
||||
@@ -69,9 +69,9 @@ program mld_dexample_ml
|
||||
type(mld_dprec_type) :: P
|
||||
|
||||
! right-hand side, solution and residual vectors
|
||||
real(psb_dpk_), allocatable , save :: b(:), x(:), r(:), &
|
||||
& x_glob(:), r_glob(:)
|
||||
real(psb_dpk_), allocatable, target :: aux_b(:,:)
|
||||
type(psb_d_vect_type) :: b, x, r
|
||||
real(psb_dpk_), allocatable , save :: x_glob(:), r_glob(:)
|
||||
real(psb_dpk_), allocatable, target :: aux_b(:,:)
|
||||
real(psb_dpk_), pointer :: b_glob(:)
|
||||
|
||||
! solver and preconditioner parameters
|
||||
@@ -173,22 +173,14 @@ program mld_dexample_ml
|
||||
b_glob(i) = 1.d0
|
||||
enddo
|
||||
endif
|
||||
call psb_bcast(ictxt,b_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_glob =>aux_b(:,1)
|
||||
call psb_bcast(ictxt,b_glob(1:m_problem))
|
||||
end if
|
||||
|
||||
call psb_barrier(ictxt)
|
||||
if (iam == psb_root_) write(*,'("Partition type: block")')
|
||||
call psb_matdist(aux_A, A, ictxt, &
|
||||
& desc_A,info,b_glob=b_glob,b=b, parts=part_block)
|
||||
call psb_matdist(aux_A, A, ictxt, desc_A,info,parts=part_block)
|
||||
call psb_scatter(b_glob,b,desc_a,info,root=psb_root_)
|
||||
|
||||
t2 = psb_wtime() - t1
|
||||
|
||||
@@ -228,7 +220,7 @@ program mld_dexample_ml
|
||||
! set the initial guess
|
||||
|
||||
call psb_geall(x,desc_A,info)
|
||||
x(:) =0.0
|
||||
call x%zero()
|
||||
call psb_geasb(x,desc_A,info)
|
||||
|
||||
! solve Ax=b with preconditioned BiCGSTAB
|
||||
@@ -241,13 +233,11 @@ program mld_dexample_ml
|
||||
t2 = psb_wtime() - t1
|
||||
call psb_amx(ictxt,t2)
|
||||
|
||||
call psb_geall(r,desc_A,info)
|
||||
r(:) =0.0
|
||||
call psb_geasb(r,desc_A,info)
|
||||
call psb_geasb(r,desc_A,info,scratch=.true.)
|
||||
call psb_geaxpby(done,b,dzero,r,desc_A,info)
|
||||
call psb_spmm(-done,A,x,done,r,desc_A,info)
|
||||
call psb_genrm2s(resmx,r,desc_A,info)
|
||||
call psb_geamaxs(resmxp,r,desc_A,info)
|
||||
resmx = psb_genrm2(r,desc_A,info)
|
||||
resmxp = psb_geamax(r,desc_A,info)
|
||||
|
||||
amatsize = a%sizeof()
|
||||
descsize = desc_a%sizeof()
|
||||
|
||||
@@ -72,8 +72,8 @@ program mld_dexample_ml
|
||||
type(mld_dprec_type) :: P
|
||||
|
||||
! right-hand side, solution and residual vectors
|
||||
real(psb_dpk_), allocatable , save :: b(:), x(:), r(:), &
|
||||
& x_glob(:), r_glob(:)
|
||||
type(psb_d_vect_type) :: b, x, r
|
||||
real(psb_dpk_), allocatable , save :: x_glob(:), r_glob(:)
|
||||
real(psb_dpk_), allocatable, target :: aux_b(:,:)
|
||||
real(psb_dpk_), pointer :: b_glob(:)
|
||||
|
||||
@@ -175,22 +175,14 @@ program mld_dexample_ml
|
||||
b_glob(i) = 1.d0
|
||||
enddo
|
||||
endif
|
||||
call psb_bcast(ictxt,b_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_glob =>aux_b(:,1)
|
||||
call psb_bcast(ictxt,b_glob(1:m_problem))
|
||||
end if
|
||||
|
||||
call psb_barrier(ictxt)
|
||||
if (iam == psb_root_) write(*,'("Partition type: block")')
|
||||
call psb_matdist(aux_A, A, ictxt, &
|
||||
& desc_A,info,b_glob=b_glob,b=b, parts=part_block)
|
||||
call psb_matdist(aux_A, A, ictxt, desc_A,info,parts=part_block)
|
||||
call psb_scatter(b_glob,b,desc_a,info,root=psb_root_)
|
||||
|
||||
t2 = psb_wtime() - t1
|
||||
|
||||
@@ -267,9 +259,8 @@ program mld_dexample_ml
|
||||
end if
|
||||
|
||||
! set the initial guess
|
||||
|
||||
call psb_geall(x,desc_A,info)
|
||||
x(:) =0.0
|
||||
call x%zero()
|
||||
call psb_geasb(x,desc_A,info)
|
||||
|
||||
! solve Ax=b with preconditioned BiCGSTAB
|
||||
@@ -282,13 +273,11 @@ program mld_dexample_ml
|
||||
t2 = psb_wtime() - t1
|
||||
call psb_amx(ictxt,t2)
|
||||
|
||||
call psb_geall(r,desc_A,info)
|
||||
r(:) =0.0
|
||||
call psb_geasb(r,desc_A,info)
|
||||
call psb_geasb(r,desc_A,info,scratch=.true.)
|
||||
call psb_geaxpby(done,b,dzero,r,desc_A,info)
|
||||
call psb_spmm(-done,A,x,done,r,desc_A,info)
|
||||
call psb_genrm2s(resmx,r,desc_A,info)
|
||||
call psb_geamaxs(resmxp,r,desc_A,info)
|
||||
resmx = psb_genrm2(r,desc_A,info)
|
||||
resmxp = psb_geamax(r,desc_A,info)
|
||||
|
||||
amatsize = a%sizeof()
|
||||
descsize = desc_a%sizeof()
|
||||
@@ -316,9 +305,9 @@ program mld_dexample_ml
|
||||
write(*,'("Total memory occupation for PREC : ",i12)')precsize
|
||||
end if
|
||||
|
||||
call psb_gather(x_glob,x_col,desc_a,info,root=psb_root_)
|
||||
call psb_gather(x_glob,x,desc_a,info,root=psb_root_)
|
||||
if (info == psb_success_) &
|
||||
& call psb_gather(r_glob,r_col,desc_a,info,root=psb_root_)
|
||||
& call psb_gather(r_glob,r,desc_a,info,root=psb_root_)
|
||||
if (info /= psb_success_) goto 9999
|
||||
if (iam == psb_root_) then
|
||||
write(0,'(" ")')
|
||||
|
||||
@@ -69,9 +69,9 @@ program mld_sexample_ml
|
||||
type(mld_sprec_type) :: P
|
||||
|
||||
! right-hand side, solution and residual vectors
|
||||
real(psb_spk_), allocatable , save :: b(:), x(:), r(:), &
|
||||
& x_glob(:), r_glob(:)
|
||||
real(psb_spk_), allocatable, target :: aux_b(:,:)
|
||||
type(psb_s_vect_type) :: b, x, r
|
||||
real(psb_spk_), allocatable , save :: x_glob(:), r_glob(:)
|
||||
real(psb_spk_), allocatable, target :: aux_b(:,:)
|
||||
real(psb_spk_), pointer :: b_glob(:)
|
||||
|
||||
! solver and preconditioner parameters
|
||||
@@ -172,22 +172,14 @@ program mld_sexample_ml
|
||||
b_glob(i) = 1.d0
|
||||
enddo
|
||||
endif
|
||||
call psb_bcast(ictxt,b_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_glob =>aux_b(:,1)
|
||||
call psb_bcast(ictxt,b_glob(1:m_problem))
|
||||
end if
|
||||
|
||||
call psb_barrier(ictxt)
|
||||
if (iam == psb_root_) write(*,'("Partition type: block")')
|
||||
call psb_matdist(aux_A, A, ictxt, &
|
||||
& desc_A,info,b_glob=b_glob,b=b, parts=part_block)
|
||||
call psb_matdist(aux_A, A, ictxt, desc_A,info,parts=part_block)
|
||||
call psb_scatter(b_glob,b,desc_a,info,root=psb_root_)
|
||||
|
||||
t2 = psb_wtime() - t1
|
||||
|
||||
@@ -221,7 +213,7 @@ program mld_sexample_ml
|
||||
! set the initial guess
|
||||
|
||||
call psb_geall(x,desc_A,info)
|
||||
x(:) =0.0
|
||||
call x%zero()
|
||||
call psb_geasb(x,desc_A,info)
|
||||
|
||||
! solve Ax=b with preconditioned BiCGSTAB
|
||||
@@ -234,13 +226,11 @@ program mld_sexample_ml
|
||||
t2 = psb_wtime() - t1
|
||||
call psb_amx(ictxt,t2)
|
||||
|
||||
call psb_geall(r,desc_A,info)
|
||||
r(:) =0.0
|
||||
call psb_geasb(r,desc_A,info)
|
||||
call psb_geasb(r,desc_A,info,scratch=.true.)
|
||||
call psb_geaxpby(sone,b,szero,r,desc_A,info)
|
||||
call psb_spmm(-sone,A,x,sone,r,desc_A,info)
|
||||
call psb_genrm2s(resmx,r,desc_A,info)
|
||||
call psb_geamaxs(resmxp,r,desc_A,info)
|
||||
resmx = psb_genrm2(r,desc_A,info)
|
||||
resmxp = psb_geamax(r,desc_A,info)
|
||||
|
||||
amatsize = a%sizeof()
|
||||
descsize = desc_a%sizeof()
|
||||
@@ -268,9 +258,9 @@ program mld_sexample_ml
|
||||
write(*,'("Total memory occupation for PREC : ",i12)')precsize
|
||||
end if
|
||||
|
||||
call psb_gather(x_glob,x_col,desc_a,info,root=psb_root_)
|
||||
call psb_gather(x_glob,x,desc_a,info,root=psb_root_)
|
||||
if (info == psb_success_) &
|
||||
& call psb_gather(r_glob,r_col,desc_a,info,root=psb_root_)
|
||||
& call psb_gather(r_glob,r,desc_a,info,root=psb_root_)
|
||||
if (info /= psb_success_) goto 9999
|
||||
if (iam == psb_root_) then
|
||||
write(0,'(" ")')
|
||||
|
||||
@@ -72,8 +72,8 @@ program mld_sexample_ml
|
||||
type(mld_sprec_type) :: P
|
||||
|
||||
! right-hand side, solution and residual vectors
|
||||
real(psb_spk_), allocatable , save :: b(:), x(:), r(:), &
|
||||
& x_glob(:), r_glob(:)
|
||||
type(psb_s_vect_type) :: b, x, r
|
||||
real(psb_spk_), allocatable , save :: x_glob(:), r_glob(:)
|
||||
real(psb_spk_), allocatable, target :: aux_b(:,:)
|
||||
real(psb_spk_), pointer :: b_glob(:)
|
||||
|
||||
@@ -176,22 +176,14 @@ program mld_sexample_ml
|
||||
b_glob(i) = 1.d0
|
||||
enddo
|
||||
endif
|
||||
call psb_bcast(ictxt,b_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_glob =>aux_b(:,1)
|
||||
call psb_bcast(ictxt,b_glob(1:m_problem))
|
||||
end if
|
||||
|
||||
call psb_barrier(ictxt)
|
||||
if (iam == psb_root_) write(*,'("Partition type: block")')
|
||||
call psb_matdist(aux_A, A, ictxt, &
|
||||
& desc_A,info,b_glob=b_glob,b=b, parts=part_block)
|
||||
call psb_matdist(aux_A, A, ictxt, desc_A,info,parts=part_block)
|
||||
call psb_scatter(b_glob,b,desc_a,info,root=psb_root_)
|
||||
|
||||
t2 = psb_wtime() - t1
|
||||
|
||||
@@ -258,7 +250,7 @@ program mld_sexample_ml
|
||||
! set the initial guess
|
||||
|
||||
call psb_geall(x,desc_A,info)
|
||||
x(:) =0.0
|
||||
call x%zero()
|
||||
call psb_geasb(x,desc_A,info)
|
||||
|
||||
! solve Ax=b with preconditioned BiCGSTAB
|
||||
@@ -271,13 +263,11 @@ program mld_sexample_ml
|
||||
t2 = psb_wtime() - t1
|
||||
call psb_amx(ictxt,t2)
|
||||
|
||||
call psb_geall(r,desc_A,info)
|
||||
r(:) =0.0
|
||||
call psb_geasb(r,desc_A,info)
|
||||
call psb_geasb(r,desc_A,info,scratch=.true.)
|
||||
call psb_geaxpby(sone,b,szero,r,desc_A,info)
|
||||
call psb_spmm(-sone,A,x,sone,r,desc_A,info)
|
||||
call psb_genrm2s(resmx,r,desc_A,info)
|
||||
call psb_geamaxs(resmxp,r,desc_A,info)
|
||||
resmx = psb_genrm2(r,desc_A,info)
|
||||
resmxp = psb_geamax(r,desc_A,info)
|
||||
|
||||
amatsize = a%sizeof()
|
||||
descsize = desc_a%sizeof()
|
||||
@@ -305,9 +295,9 @@ program mld_sexample_ml
|
||||
write(*,'("Total memory occupation for PREC : ",i12)')precsize
|
||||
end if
|
||||
|
||||
call psb_gather(x_glob,x_col,desc_a,info,root=psb_root_)
|
||||
call psb_gather(x_glob,x,desc_a,info,root=psb_root_)
|
||||
if (info == psb_success_) &
|
||||
& call psb_gather(r_glob,r_col,desc_a,info,root=psb_root_)
|
||||
& call psb_gather(r_glob,r,desc_a,info,root=psb_root_)
|
||||
if (info /= psb_success_) goto 9999
|
||||
if (iam == psb_root_) then
|
||||
write(0,'(" ")')
|
||||
|
||||
@@ -69,9 +69,9 @@ program mld_zexample_ml
|
||||
type(mld_zprec_type) :: P
|
||||
|
||||
! right-hand side, solution and residual vectors
|
||||
complex(psb_dpk_), allocatable , save :: b(:), x(:), r(:), &
|
||||
& x_glob(:), r_glob(:)
|
||||
complex(psb_dpk_), allocatable, target :: aux_b(:,:)
|
||||
type(psb_z_vect_type) :: b, x, r
|
||||
complex(psb_dpk_), allocatable , save :: x_glob(:), r_glob(:)
|
||||
complex(psb_dpk_), allocatable, target :: aux_b(:,:)
|
||||
complex(psb_dpk_), pointer :: b_glob(:)
|
||||
|
||||
! solver and preconditioner parameters
|
||||
@@ -171,22 +171,14 @@ program mld_zexample_ml
|
||||
b_glob(i) = 1.d0
|
||||
enddo
|
||||
endif
|
||||
call psb_bcast(ictxt,b_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_glob =>aux_b(:,1)
|
||||
call psb_bcast(ictxt,b_glob(1:m_problem))
|
||||
end if
|
||||
|
||||
call psb_barrier(ictxt)
|
||||
if (iam == psb_root_) write(*,'("Partition type: block")')
|
||||
call psb_matdist(aux_A, A, ictxt, &
|
||||
& desc_A,info,b_glob=b_glob,b=b, parts=part_block)
|
||||
call psb_matdist(aux_A, A, ictxt, desc_A,info,parts=part_block)
|
||||
call psb_scatter(b_glob,b,desc_a,info,root=psb_root_)
|
||||
|
||||
t2 = psb_wtime() - t1
|
||||
|
||||
@@ -220,7 +212,7 @@ program mld_zexample_ml
|
||||
! set the initial guess
|
||||
|
||||
call psb_geall(x,desc_A,info)
|
||||
x(:) =0.0
|
||||
call x%zero()
|
||||
call psb_geasb(x,desc_A,info)
|
||||
|
||||
! solve Ax=b with preconditioned BiCGSTAB
|
||||
@@ -233,13 +225,11 @@ program mld_zexample_ml
|
||||
t2 = psb_wtime() - t1
|
||||
call psb_amx(ictxt,t2)
|
||||
|
||||
call psb_geall(r,desc_A,info)
|
||||
r(:) =0.0
|
||||
call psb_geasb(r,desc_A,info)
|
||||
call psb_geasb(r,desc_A,info,scratch=.true.)
|
||||
call psb_geaxpby(zone,b,zzero,r,desc_A,info)
|
||||
call psb_spmm(-zone,A,x,zone,r,desc_A,info)
|
||||
call psb_genrm2s(resmx,r,desc_A,info)
|
||||
call psb_geamaxs(resmxp,r,desc_A,info)
|
||||
resmx = psb_genrm2(r,desc_A,info)
|
||||
resmxp = psb_geamax(r,desc_A,info)
|
||||
|
||||
amatsize = a%sizeof()
|
||||
descsize = desc_a%sizeof()
|
||||
@@ -267,9 +257,9 @@ program mld_zexample_ml
|
||||
write(*,'("Total memory occupation for PREC : ",i12)')precsize
|
||||
end if
|
||||
|
||||
call psb_gather(x_glob,x_col,desc_a,info,root=psb_root_)
|
||||
call psb_gather(x_glob,x,desc_a,info,root=psb_root_)
|
||||
if (info == psb_success_) &
|
||||
& call psb_gather(r_glob,r_col,desc_a,info,root=psb_root_)
|
||||
& call psb_gather(r_glob,r,desc_a,info,root=psb_root_)
|
||||
if (info /= psb_success_) goto 9999
|
||||
if (iam == psb_root_) then
|
||||
write(0,'(" ")')
|
||||
|
||||
@@ -72,8 +72,8 @@ program mld_zexample_ml
|
||||
type(mld_zprec_type) :: P
|
||||
|
||||
! right-hand side, solution and residual vectors
|
||||
complex(psb_dpk_), allocatable , save :: b(:), x(:), r(:), &
|
||||
& x_glob(:), r_glob(:)
|
||||
type(psb_z_vect_type) :: b, x, r
|
||||
complex(psb_dpk_), allocatable , save :: x_glob(:), r_glob(:)
|
||||
complex(psb_dpk_), allocatable, target :: aux_b(:,:)
|
||||
complex(psb_dpk_), pointer :: b_glob(:)
|
||||
|
||||
@@ -175,22 +175,14 @@ program mld_zexample_ml
|
||||
b_glob(i) = 1.d0
|
||||
enddo
|
||||
endif
|
||||
call psb_bcast(ictxt,b_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_glob =>aux_b(:,1)
|
||||
call psb_bcast(ictxt,b_glob(1:m_problem))
|
||||
end if
|
||||
|
||||
call psb_barrier(ictxt)
|
||||
if (iam == psb_root_) write(*,'("Partition type: block")')
|
||||
call psb_matdist(aux_A, A, ictxt, &
|
||||
& desc_A,info,b_glob=b_glob,b=b, parts=part_block)
|
||||
call psb_matdist(aux_A, A, ictxt, desc_A,info,parts=part_block)
|
||||
call psb_scatter(b_glob,b,desc_a,info,root=psb_root_)
|
||||
|
||||
t2 = psb_wtime() - t1
|
||||
|
||||
@@ -257,7 +249,7 @@ program mld_zexample_ml
|
||||
! set the initial guess
|
||||
|
||||
call psb_geall(x,desc_A,info)
|
||||
x(:) =0.0
|
||||
call x%zero()
|
||||
call psb_geasb(x,desc_A,info)
|
||||
|
||||
! solve Ax=b with preconditioned BiCGSTAB
|
||||
@@ -270,13 +262,11 @@ program mld_zexample_ml
|
||||
t2 = psb_wtime() - t1
|
||||
call psb_amx(ictxt,t2)
|
||||
|
||||
call psb_geall(r,desc_A,info)
|
||||
r(:) =0.0
|
||||
call psb_geasb(r,desc_A,info)
|
||||
call psb_geasb(r,desc_A,info,scratch=.true.)
|
||||
call psb_geaxpby(zone,b,zzero,r,desc_A,info)
|
||||
call psb_spmm(-zone,A,x,zone,r,desc_A,info)
|
||||
call psb_genrm2s(resmx,r,desc_A,info)
|
||||
call psb_geamaxs(resmxp,r,desc_A,info)
|
||||
resmx = psb_genrm2(r,desc_A,info)
|
||||
resmxp = psb_geamax(r,desc_A,info)
|
||||
|
||||
amatsize = a%sizeof()
|
||||
descsize = desc_a%sizeof()
|
||||
@@ -304,9 +294,9 @@ program mld_zexample_ml
|
||||
write(*,'("Total memory occupation for PREC : ",i12)')precsize
|
||||
end if
|
||||
|
||||
call psb_gather(x_glob,x_col,desc_a,info,root=psb_root_)
|
||||
call psb_gather(x_glob,x,desc_a,info,root=psb_root_)
|
||||
if (info == psb_success_) &
|
||||
& call psb_gather(r_glob,r_col,desc_a,info,root=psb_root_)
|
||||
& call psb_gather(r_glob,r,desc_a,info,root=psb_root_)
|
||||
if (info /= psb_success_) goto 9999
|
||||
if (iam == psb_root_) then
|
||||
write(0,'(" ")')
|
||||
|
||||
Reference in New Issue
Block a user