fdurastante
/
amg4psblas
mirror of https://github.com/sfilippone/amg4psblas.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

mld2p4-2:

Browse Source 
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.
stopcriterion
Salvatore Filippone 8 years ago
parent d675e315ca
commit 2974bf09cd
8 changed files with 82 additions and 163 deletions
Show Stats Download Patch File Download Diff File

32
examples/fileread/mld_cexample_1lev.f90
Unescape Escape View File

@ -69,9 +69,9 @@ program mld_cexample_ml
type(mld_cprec_type) :: P type(mld_cprec_type) :: P
! right-hand side, solution and residual vectors ! right-hand side, solution and residual vectors
complex(psb_spk_), allocatable , save :: b(:), x(:), r(:), & type(psb_c_vect_type) :: b, x, r
& x_glob(:), r_glob(:) complex(psb_spk_), allocatable , save :: x_glob(:), r_glob(:)
complex(psb_spk_), allocatable, target :: aux_b(:,:) complex(psb_spk_), allocatable, target :: aux_b(:,:)
complex(psb_spk_), pointer :: b_glob(:) complex(psb_spk_), pointer :: b_glob(:)
! solver and preconditioner parameters ! solver and preconditioner parameters
@ -172,22 +172,14 @@ program mld_cexample_ml
b_glob(i) = 1.d0 b_glob(i) = 1.d0
enddo enddo
endif endif
call psb_bcast(ictxt,b_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_glob =>aux_b(:,1)
call psb_bcast(ictxt,b_glob(1:m_problem))
end if end if
call psb_barrier(ictxt) call psb_barrier(ictxt)
if (iam == psb_root_) write(*,'("Partition type: block")') if (iam == psb_root_) write(*,'("Partition type: block")')
call psb_matdist(aux_A, A, ictxt, & call psb_matdist(aux_A, A, ictxt, desc_A,info,parts=part_block)
& desc_A,info,b_glob=b_glob,b=b, parts=part_block) call psb_scatter(b_glob,b,desc_a,info,root=psb_root_)
t2 = psb_wtime() - t1 t2 = psb_wtime() - t1
@ -221,7 +213,7 @@ program mld_cexample_ml
! set the initial guess ! set the initial guess
call psb_geall(x,desc_A,info) call psb_geall(x,desc_A,info)
x(:) =0.0 call x%zero()
call psb_geasb(x,desc_A,info) call psb_geasb(x,desc_A,info)
! solve Ax=b with preconditioned BiCGSTAB ! solve Ax=b with preconditioned BiCGSTAB
@ -234,13 +226,11 @@ program mld_cexample_ml
t2 = psb_wtime() - t1 t2 = psb_wtime() - t1
call psb_amx(ictxt,t2) call psb_amx(ictxt,t2)
call psb_geall(r,desc_A,info) call psb_geasb(r,desc_A,info,scratch=.true.)
r(:) =0.0
call psb_geasb(r,desc_A,info)
call psb_geaxpby(cone,b,czero,r,desc_A,info) call psb_geaxpby(cone,b,czero,r,desc_A,info)
call psb_spmm(-cone,A,x,cone,r,desc_A,info) call psb_spmm(-cone,A,x,cone,r,desc_A,info)
call psb_genrm2s(resmx,r,desc_A,info) resmx = psb_genrm2(r,desc_A,info)
call psb_geamaxs(resmxp,r,desc_A,info) resmxp = psb_geamax(r,desc_A,info)
amatsize = a%sizeof() amatsize = a%sizeof()
descsize = desc_a%sizeof() descsize = desc_a%sizeof()
@ -268,9 +258,9 @@ program mld_cexample_ml
write(*,'("Total memory occupation for PREC : ",i12)')precsize write(*,'("Total memory occupation for PREC : ",i12)')precsize
end if 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_) & 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 (info /= psb_success_) goto 9999
if (iam == psb_root_) then if (iam == psb_root_) then
write(0,'(" ")') write(0,'(" ")')

30
examples/fileread/mld_cexample_ml.f90
Unescape Escape View File

@ -72,8 +72,8 @@ program mld_cexample_ml
type(mld_cprec_type) :: P type(mld_cprec_type) :: P
! right-hand side, solution and residual vectors ! right-hand side, solution and residual vectors
complex(psb_spk_), allocatable , save :: b(:), x(:), r(:), & type(psb_c_vect_type) :: b, x, r
& x_glob(:), r_glob(:) complex(psb_spk_), allocatable , save :: x_glob(:), r_glob(:)
complex(psb_spk_), allocatable, target :: aux_b(:,:) complex(psb_spk_), allocatable, target :: aux_b(:,:)
complex(psb_spk_), pointer :: b_glob(:) complex(psb_spk_), pointer :: b_glob(:)
@ -176,22 +176,14 @@ program mld_cexample_ml
b_glob(i) = 1.d0 b_glob(i) = 1.d0
enddo enddo
endif endif
call psb_bcast(ictxt,b_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_glob =>aux_b(:,1)
call psb_bcast(ictxt,b_glob(1:m_problem))
end if end if
call psb_barrier(ictxt) call psb_barrier(ictxt)
if (iam == psb_root_) write(*,'("Partition type: block")') if (iam == psb_root_) write(*,'("Partition type: block")')
call psb_matdist(aux_A, A, ictxt, & call psb_matdist(aux_A, A, ictxt, desc_A,info,parts=part_block)
& desc_A,info,b_glob=b_glob,b=b, parts=part_block) call psb_scatter(b_glob,b,desc_a,info,root=psb_root_)
t2 = psb_wtime() - t1 t2 = psb_wtime() - t1
@ -258,7 +250,7 @@ program mld_cexample_ml
! set the initial guess ! set the initial guess
call psb_geall(x,desc_A,info) call psb_geall(x,desc_A,info)
x(:) =0.0 call x%zero()
call psb_geasb(x,desc_A,info) call psb_geasb(x,desc_A,info)
! solve Ax=b with preconditioned BiCGSTAB ! solve Ax=b with preconditioned BiCGSTAB
@ -271,13 +263,11 @@ program mld_cexample_ml
t2 = psb_wtime() - t1 t2 = psb_wtime() - t1
call psb_amx(ictxt,t2) call psb_amx(ictxt,t2)
call psb_geall(r,desc_A,info) call psb_geasb(r,desc_A,info,scratch=.true.)
r(:) =0.0
call psb_geasb(r,desc_A,info)
call psb_geaxpby(cone,b,czero,r,desc_A,info) call psb_geaxpby(cone,b,czero,r,desc_A,info)
call psb_spmm(-cone,A,x,cone,r,desc_A,info) call psb_spmm(-cone,A,x,cone,r,desc_A,info)
call psb_genrm2s(resmx,r,desc_A,info) resmx = psb_genrm2(r,desc_A,info)
call psb_geamaxs(resmxp,r,desc_A,info) resmxp = psb_geamax(r,desc_A,info)
amatsize = a%sizeof() amatsize = a%sizeof()
descsize = desc_a%sizeof() descsize = desc_a%sizeof()
@ -305,9 +295,9 @@ program mld_cexample_ml
write(*,'("Total memory occupation for PREC : ",i12)')precsize write(*,'("Total memory occupation for PREC : ",i12)')precsize
end if 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_) & 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 (info /= psb_success_) goto 9999
if (iam == psb_root_) then if (iam == psb_root_) then
write(0,'(" ")') write(0,'(" ")')

28
examples/fileread/mld_dexample_1lev.f90
Unescape Escape View File

@ -69,9 +69,9 @@ program mld_dexample_ml
type(mld_dprec_type) :: P type(mld_dprec_type) :: P
! right-hand side, solution and residual vectors ! right-hand side, solution and residual vectors
real(psb_dpk_), allocatable , save :: b(:), x(:), r(:), & type(psb_d_vect_type) :: b, x, r
& x_glob(:), r_glob(:) real(psb_dpk_), allocatable , save :: x_glob(:), r_glob(:)
real(psb_dpk_), allocatable, target :: aux_b(:,:) real(psb_dpk_), allocatable, target :: aux_b(:,:)
real(psb_dpk_), pointer :: b_glob(:) real(psb_dpk_), pointer :: b_glob(:)
! solver and preconditioner parameters ! solver and preconditioner parameters
@ -173,22 +173,14 @@ program mld_dexample_ml
b_glob(i) = 1.d0 b_glob(i) = 1.d0
enddo enddo
endif endif
call psb_bcast(ictxt,b_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_glob =>aux_b(:,1)
call psb_bcast(ictxt,b_glob(1:m_problem))
end if end if
call psb_barrier(ictxt) call psb_barrier(ictxt)
if (iam == psb_root_) write(*,'("Partition type: block")') if (iam == psb_root_) write(*,'("Partition type: block")')
call psb_matdist(aux_A, A, ictxt, & call psb_matdist(aux_A, A, ictxt, desc_A,info,parts=part_block)
& desc_A,info,b_glob=b_glob,b=b, parts=part_block) call psb_scatter(b_glob,b,desc_a,info,root=psb_root_)
t2 = psb_wtime() - t1 t2 = psb_wtime() - t1
@ -228,7 +220,7 @@ program mld_dexample_ml
! set the initial guess ! set the initial guess
call psb_geall(x,desc_A,info) call psb_geall(x,desc_A,info)
x(:) =0.0 call x%zero()
call psb_geasb(x,desc_A,info) call psb_geasb(x,desc_A,info)
! solve Ax=b with preconditioned BiCGSTAB ! solve Ax=b with preconditioned BiCGSTAB
@ -241,13 +233,11 @@ program mld_dexample_ml
t2 = psb_wtime() - t1 t2 = psb_wtime() - t1
call psb_amx(ictxt,t2) call psb_amx(ictxt,t2)
call psb_geall(r,desc_A,info) call psb_geasb(r,desc_A,info,scratch=.true.)
r(:) =0.0
call psb_geasb(r,desc_A,info)
call psb_geaxpby(done,b,dzero,r,desc_A,info) call psb_geaxpby(done,b,dzero,r,desc_A,info)
call psb_spmm(-done,A,x,done,r,desc_A,info) call psb_spmm(-done,A,x,done,r,desc_A,info)
call psb_genrm2s(resmx,r,desc_A,info) resmx = psb_genrm2(r,desc_A,info)
call psb_geamaxs(resmxp,r,desc_A,info) resmxp = psb_geamax(r,desc_A,info)
amatsize = a%sizeof() amatsize = a%sizeof()
descsize = desc_a%sizeof() descsize = desc_a%sizeof()

31
examples/fileread/mld_dexample_ml.f90
Unescape Escape View File

@ -72,8 +72,8 @@ program mld_dexample_ml
type(mld_dprec_type) :: P type(mld_dprec_type) :: P
! right-hand side, solution and residual vectors ! right-hand side, solution and residual vectors
real(psb_dpk_), allocatable , save :: b(:), x(:), r(:), & type(psb_d_vect_type) :: b, x, r
& x_glob(:), r_glob(:) real(psb_dpk_), allocatable , save :: x_glob(:), r_glob(:)
real(psb_dpk_), allocatable, target :: aux_b(:,:) real(psb_dpk_), allocatable, target :: aux_b(:,:)
real(psb_dpk_), pointer :: b_glob(:) real(psb_dpk_), pointer :: b_glob(:)
@ -175,22 +175,14 @@ program mld_dexample_ml
b_glob(i) = 1.d0 b_glob(i) = 1.d0
enddo enddo
endif endif
call psb_bcast(ictxt,b_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_glob =>aux_b(:,1)
call psb_bcast(ictxt,b_glob(1:m_problem))
end if end if
call psb_barrier(ictxt) call psb_barrier(ictxt)
if (iam == psb_root_) write(*,'("Partition type: block")') if (iam == psb_root_) write(*,'("Partition type: block")')
call psb_matdist(aux_A, A, ictxt, & call psb_matdist(aux_A, A, ictxt, desc_A,info,parts=part_block)
& desc_A,info,b_glob=b_glob,b=b, parts=part_block) call psb_scatter(b_glob,b,desc_a,info,root=psb_root_)
t2 = psb_wtime() - t1 t2 = psb_wtime() - t1
@ -267,9 +259,8 @@ program mld_dexample_ml
end if end if
! set the initial guess ! set the initial guess
call psb_geall(x,desc_A,info) call psb_geall(x,desc_A,info)
x(:) =0.0 call x%zero()
call psb_geasb(x,desc_A,info) call psb_geasb(x,desc_A,info)
! solve Ax=b with preconditioned BiCGSTAB ! solve Ax=b with preconditioned BiCGSTAB
@ -282,13 +273,11 @@ program mld_dexample_ml
t2 = psb_wtime() - t1 t2 = psb_wtime() - t1
call psb_amx(ictxt,t2) call psb_amx(ictxt,t2)
call psb_geall(r,desc_A,info) call psb_geasb(r,desc_A,info,scratch=.true.)
r(:) =0.0
call psb_geasb(r,desc_A,info)
call psb_geaxpby(done,b,dzero,r,desc_A,info) call psb_geaxpby(done,b,dzero,r,desc_A,info)
call psb_spmm(-done,A,x,done,r,desc_A,info) call psb_spmm(-done,A,x,done,r,desc_A,info)
call psb_genrm2s(resmx,r,desc_A,info) resmx = psb_genrm2(r,desc_A,info)
call psb_geamaxs(resmxp,r,desc_A,info) resmxp = psb_geamax(r,desc_A,info)
amatsize = a%sizeof() amatsize = a%sizeof()
descsize = desc_a%sizeof() descsize = desc_a%sizeof()
@ -316,9 +305,9 @@ program mld_dexample_ml
write(*,'("Total memory occupation for PREC : ",i12)')precsize write(*,'("Total memory occupation for PREC : ",i12)')precsize
end if 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_) & 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 (info /= psb_success_) goto 9999
if (iam == psb_root_) then if (iam == psb_root_) then
write(0,'(" ")') write(0,'(" ")')

32
examples/fileread/mld_sexample_1lev.f90
Unescape Escape View File

@ -69,9 +69,9 @@ program mld_sexample_ml
type(mld_sprec_type) :: P type(mld_sprec_type) :: P
! right-hand side, solution and residual vectors ! right-hand side, solution and residual vectors
real(psb_spk_), allocatable , save :: b(:), x(:), r(:), & type(psb_s_vect_type) :: b, x, r
& x_glob(:), r_glob(:) real(psb_spk_), allocatable , save :: x_glob(:), r_glob(:)
real(psb_spk_), allocatable, target :: aux_b(:,:) real(psb_spk_), allocatable, target :: aux_b(:,:)
real(psb_spk_), pointer :: b_glob(:) real(psb_spk_), pointer :: b_glob(:)
! solver and preconditioner parameters ! solver and preconditioner parameters
@ -172,22 +172,14 @@ program mld_sexample_ml
b_glob(i) = 1.d0 b_glob(i) = 1.d0
enddo enddo
endif endif
call psb_bcast(ictxt,b_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_glob =>aux_b(:,1)
call psb_bcast(ictxt,b_glob(1:m_problem))
end if end if
call psb_barrier(ictxt) call psb_barrier(ictxt)
if (iam == psb_root_) write(*,'("Partition type: block")') if (iam == psb_root_) write(*,'("Partition type: block")')
call psb_matdist(aux_A, A, ictxt, & call psb_matdist(aux_A, A, ictxt, desc_A,info,parts=part_block)
& desc_A,info,b_glob=b_glob,b=b, parts=part_block) call psb_scatter(b_glob,b,desc_a,info,root=psb_root_)
t2 = psb_wtime() - t1 t2 = psb_wtime() - t1
@ -221,7 +213,7 @@ program mld_sexample_ml
! set the initial guess ! set the initial guess
call psb_geall(x,desc_A,info) call psb_geall(x,desc_A,info)
x(:) =0.0 call x%zero()
call psb_geasb(x,desc_A,info) call psb_geasb(x,desc_A,info)
! solve Ax=b with preconditioned BiCGSTAB ! solve Ax=b with preconditioned BiCGSTAB
@ -234,13 +226,11 @@ program mld_sexample_ml
t2 = psb_wtime() - t1 t2 = psb_wtime() - t1
call psb_amx(ictxt,t2) call psb_amx(ictxt,t2)
call psb_geall(r,desc_A,info) call psb_geasb(r,desc_A,info,scratch=.true.)
r(:) =0.0
call psb_geasb(r,desc_A,info)
call psb_geaxpby(sone,b,szero,r,desc_A,info) call psb_geaxpby(sone,b,szero,r,desc_A,info)
call psb_spmm(-sone,A,x,sone,r,desc_A,info) call psb_spmm(-sone,A,x,sone,r,desc_A,info)
call psb_genrm2s(resmx,r,desc_A,info) resmx = psb_genrm2(r,desc_A,info)
call psb_geamaxs(resmxp,r,desc_A,info) resmxp = psb_geamax(r,desc_A,info)
amatsize = a%sizeof() amatsize = a%sizeof()
descsize = desc_a%sizeof() descsize = desc_a%sizeof()
@ -268,9 +258,9 @@ program mld_sexample_ml
write(*,'("Total memory occupation for PREC : ",i12)')precsize write(*,'("Total memory occupation for PREC : ",i12)')precsize
end if 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_) & 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 (info /= psb_success_) goto 9999
if (iam == psb_root_) then if (iam == psb_root_) then
write(0,'(" ")') write(0,'(" ")')

30
examples/fileread/mld_sexample_ml.f90
Unescape Escape View File

@ -72,8 +72,8 @@ program mld_sexample_ml
type(mld_sprec_type) :: P type(mld_sprec_type) :: P
! right-hand side, solution and residual vectors ! right-hand side, solution and residual vectors
real(psb_spk_), allocatable , save :: b(:), x(:), r(:), & type(psb_s_vect_type) :: b, x, r
& x_glob(:), r_glob(:) real(psb_spk_), allocatable , save :: x_glob(:), r_glob(:)
real(psb_spk_), allocatable, target :: aux_b(:,:) real(psb_spk_), allocatable, target :: aux_b(:,:)
real(psb_spk_), pointer :: b_glob(:) real(psb_spk_), pointer :: b_glob(:)
@ -176,22 +176,14 @@ program mld_sexample_ml
b_glob(i) = 1.d0 b_glob(i) = 1.d0
enddo enddo
endif endif
call psb_bcast(ictxt,b_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_glob =>aux_b(:,1)
call psb_bcast(ictxt,b_glob(1:m_problem))
end if end if
call psb_barrier(ictxt) call psb_barrier(ictxt)
if (iam == psb_root_) write(*,'("Partition type: block")') if (iam == psb_root_) write(*,'("Partition type: block")')
call psb_matdist(aux_A, A, ictxt, & call psb_matdist(aux_A, A, ictxt, desc_A,info,parts=part_block)
& desc_A,info,b_glob=b_glob,b=b, parts=part_block) call psb_scatter(b_glob,b,desc_a,info,root=psb_root_)
t2 = psb_wtime() - t1 t2 = psb_wtime() - t1
@ -258,7 +250,7 @@ program mld_sexample_ml
! set the initial guess ! set the initial guess
call psb_geall(x,desc_A,info) call psb_geall(x,desc_A,info)
x(:) =0.0 call x%zero()
call psb_geasb(x,desc_A,info) call psb_geasb(x,desc_A,info)
! solve Ax=b with preconditioned BiCGSTAB ! solve Ax=b with preconditioned BiCGSTAB
@ -271,13 +263,11 @@ program mld_sexample_ml
t2 = psb_wtime() - t1 t2 = psb_wtime() - t1
call psb_amx(ictxt,t2) call psb_amx(ictxt,t2)
call psb_geall(r,desc_A,info) call psb_geasb(r,desc_A,info,scratch=.true.)
r(:) =0.0
call psb_geasb(r,desc_A,info)
call psb_geaxpby(sone,b,szero,r,desc_A,info) call psb_geaxpby(sone,b,szero,r,desc_A,info)
call psb_spmm(-sone,A,x,sone,r,desc_A,info) call psb_spmm(-sone,A,x,sone,r,desc_A,info)
call psb_genrm2s(resmx,r,desc_A,info) resmx = psb_genrm2(r,desc_A,info)
call psb_geamaxs(resmxp,r,desc_A,info) resmxp = psb_geamax(r,desc_A,info)
amatsize = a%sizeof() amatsize = a%sizeof()
descsize = desc_a%sizeof() descsize = desc_a%sizeof()
@ -305,9 +295,9 @@ program mld_sexample_ml
write(*,'("Total memory occupation for PREC : ",i12)')precsize write(*,'("Total memory occupation for PREC : ",i12)')precsize
end if 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_) & 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 (info /= psb_success_) goto 9999
if (iam == psb_root_) then if (iam == psb_root_) then
write(0,'(" ")') write(0,'(" ")')

32
examples/fileread/mld_zexample_1lev.f90
Unescape Escape View File

@ -69,9 +69,9 @@ program mld_zexample_ml
type(mld_zprec_type) :: P type(mld_zprec_type) :: P
! right-hand side, solution and residual vectors ! right-hand side, solution and residual vectors
complex(psb_dpk_), allocatable , save :: b(:), x(:), r(:), & type(psb_z_vect_type) :: b, x, r
& x_glob(:), r_glob(:) complex(psb_dpk_), allocatable , save :: x_glob(:), r_glob(:)
complex(psb_dpk_), allocatable, target :: aux_b(:,:) complex(psb_dpk_), allocatable, target :: aux_b(:,:)
complex(psb_dpk_), pointer :: b_glob(:) complex(psb_dpk_), pointer :: b_glob(:)
! solver and preconditioner parameters ! solver and preconditioner parameters
@ -171,22 +171,14 @@ program mld_zexample_ml
b_glob(i) = 1.d0 b_glob(i) = 1.d0
enddo enddo
endif endif
call psb_bcast(ictxt,b_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_glob =>aux_b(:,1)
call psb_bcast(ictxt,b_glob(1:m_problem))
end if end if
call psb_barrier(ictxt) call psb_barrier(ictxt)
if (iam == psb_root_) write(*,'("Partition type: block")') if (iam == psb_root_) write(*,'("Partition type: block")')
call psb_matdist(aux_A, A, ictxt, & call psb_matdist(aux_A, A, ictxt, desc_A,info,parts=part_block)
& desc_A,info,b_glob=b_glob,b=b, parts=part_block) call psb_scatter(b_glob,b,desc_a,info,root=psb_root_)
t2 = psb_wtime() - t1 t2 = psb_wtime() - t1
@ -220,7 +212,7 @@ program mld_zexample_ml
! set the initial guess ! set the initial guess
call psb_geall(x,desc_A,info) call psb_geall(x,desc_A,info)
x(:) =0.0 call x%zero()
call psb_geasb(x,desc_A,info) call psb_geasb(x,desc_A,info)
! solve Ax=b with preconditioned BiCGSTAB ! solve Ax=b with preconditioned BiCGSTAB
@ -233,13 +225,11 @@ program mld_zexample_ml
t2 = psb_wtime() - t1 t2 = psb_wtime() - t1
call psb_amx(ictxt,t2) call psb_amx(ictxt,t2)
call psb_geall(r,desc_A,info) call psb_geasb(r,desc_A,info,scratch=.true.)
r(:) =0.0
call psb_geasb(r,desc_A,info)
call psb_geaxpby(zone,b,zzero,r,desc_A,info) call psb_geaxpby(zone,b,zzero,r,desc_A,info)
call psb_spmm(-zone,A,x,zone,r,desc_A,info) call psb_spmm(-zone,A,x,zone,r,desc_A,info)
call psb_genrm2s(resmx,r,desc_A,info) resmx = psb_genrm2(r,desc_A,info)
call psb_geamaxs(resmxp,r,desc_A,info) resmxp = psb_geamax(r,desc_A,info)
amatsize = a%sizeof() amatsize = a%sizeof()
descsize = desc_a%sizeof() descsize = desc_a%sizeof()
@ -267,9 +257,9 @@ program mld_zexample_ml
write(*,'("Total memory occupation for PREC : ",i12)')precsize write(*,'("Total memory occupation for PREC : ",i12)')precsize
end if 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_) & 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 (info /= psb_success_) goto 9999
if (iam == psb_root_) then if (iam == psb_root_) then
write(0,'(" ")') write(0,'(" ")')

30
examples/fileread/mld_zexample_ml.f90
Unescape Escape View File

@ -72,8 +72,8 @@ program mld_zexample_ml
type(mld_zprec_type) :: P type(mld_zprec_type) :: P
! right-hand side, solution and residual vectors ! right-hand side, solution and residual vectors
complex(psb_dpk_), allocatable , save :: b(:), x(:), r(:), & type(psb_z_vect_type) :: b, x, r
& x_glob(:), r_glob(:) complex(psb_dpk_), allocatable , save :: x_glob(:), r_glob(:)
complex(psb_dpk_), allocatable, target :: aux_b(:,:) complex(psb_dpk_), allocatable, target :: aux_b(:,:)
complex(psb_dpk_), pointer :: b_glob(:) complex(psb_dpk_), pointer :: b_glob(:)
@ -175,22 +175,14 @@ program mld_zexample_ml
b_glob(i) = 1.d0 b_glob(i) = 1.d0
enddo enddo
endif endif
call psb_bcast(ictxt,b_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_glob =>aux_b(:,1)
call psb_bcast(ictxt,b_glob(1:m_problem))
end if end if
call psb_barrier(ictxt) call psb_barrier(ictxt)
if (iam == psb_root_) write(*,'("Partition type: block")') if (iam == psb_root_) write(*,'("Partition type: block")')
call psb_matdist(aux_A, A, ictxt, & call psb_matdist(aux_A, A, ictxt, desc_A,info,parts=part_block)
& desc_A,info,b_glob=b_glob,b=b, parts=part_block) call psb_scatter(b_glob,b,desc_a,info,root=psb_root_)
t2 = psb_wtime() - t1 t2 = psb_wtime() - t1
@ -257,7 +249,7 @@ program mld_zexample_ml
! set the initial guess ! set the initial guess
call psb_geall(x,desc_A,info) call psb_geall(x,desc_A,info)
x(:) =0.0 call x%zero()
call psb_geasb(x,desc_A,info) call psb_geasb(x,desc_A,info)
! solve Ax=b with preconditioned BiCGSTAB ! solve Ax=b with preconditioned BiCGSTAB
@ -270,13 +262,11 @@ program mld_zexample_ml
t2 = psb_wtime() - t1 t2 = psb_wtime() - t1
call psb_amx(ictxt,t2) call psb_amx(ictxt,t2)
call psb_geall(r,desc_A,info) call psb_geasb(r,desc_A,info,scratch=.true.)
r(:) =0.0
call psb_geasb(r,desc_A,info)
call psb_geaxpby(zone,b,zzero,r,desc_A,info) call psb_geaxpby(zone,b,zzero,r,desc_A,info)
call psb_spmm(-zone,A,x,zone,r,desc_A,info) call psb_spmm(-zone,A,x,zone,r,desc_A,info)
call psb_genrm2s(resmx,r,desc_A,info) resmx = psb_genrm2(r,desc_A,info)
call psb_geamaxs(resmxp,r,desc_A,info) resmxp = psb_geamax(r,desc_A,info)
amatsize = a%sizeof() amatsize = a%sizeof()
descsize = desc_a%sizeof() descsize = desc_a%sizeof()
@ -304,9 +294,9 @@ program mld_zexample_ml
write(*,'("Total memory occupation for PREC : ",i12)')precsize write(*,'("Total memory occupation for PREC : ",i12)')precsize
end if 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_) & 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 (info /= psb_success_) goto 9999
if (iam == psb_root_) then if (iam == psb_root_) then
write(0,'(" ")') write(0,'(" ")')

Write Preview
Loading…
Cancel
Save