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

Fix name of CTXT variable

Browse Source
This commit is contained in:
Salvatore Filippone
2020-11-17 14:36:29 +01:00
parent c14ce5409e
commit b751d726a1
298 changed files with 3664 additions and 3379 deletions
Download Patch File Download Diff File Expand all files Collapse all files
examples/fileread/amg_cexample_1lev.f90
+32 -30
View File
@@ -77,7 +77,8 @@ program amg_cexample_1lev
integer :: nlev
! parallel environment parameters
integer :: ictxt, iam, np
type(psb_ctxt_type) :: ctxt
integer :: iam, np
! other variables
integer :: i,info,j,m_problem
@@ -90,12 +91,12 @@ program amg_cexample_1lev
! initialize the parallel environment
call psb_init(ictxt)
call psb_info(ictxt,iam,np)
call psb_init(ctxt)
call psb_info(ctxt,iam,np)
if (iam < 0) then
! This should not happen, but just in case
call psb_exit(ictxt)
call psb_exit(ctxt)
stop
endif
@@ -113,9 +114,9 @@ program amg_cexample_1lev
! get parameters
call get_parms(ictxt,mtrx_file,rhs_file,filefmt,itmax,tol)
call get_parms(ctxt,mtrx_file,rhs_file,filefmt,itmax,tol)
call psb_barrier(ictxt)
call psb_barrier(ctxt)
t1 = psb_wtime()
! read and assemble the matrix A and the right-hand side b
@@ -144,11 +145,11 @@ program amg_cexample_1lev
end select
if (info /= psb_success_) then
write(0,*) 'Error while reading input matrix '
call psb_abort(ictxt)
call psb_abort(ctxt)
end if
m_problem = aux_a%get_nrows()
call psb_bcast(ictxt,m_problem)
call psb_bcast(ctxt,m_problem)
! At this point aux_b may still be unallocated
if (psb_size(aux_b,1) == m_problem) then
@@ -170,17 +171,17 @@ program amg_cexample_1lev
enddo
endif
else
call psb_bcast(ictxt,m_problem)
call psb_bcast(ctxt,m_problem)
end if
call psb_barrier(ictxt)
call psb_barrier(ctxt)
if (iam == psb_root_) write(*,'("Partition type: block")')
call psb_matdist(aux_A, A, ictxt, desc_A,info,parts=part_block)
call psb_matdist(aux_A, A, ctxt, desc_A,info,parts=part_block)
call psb_scatter(b_glob,b,desc_a,info,root=psb_root_)
t2 = psb_wtime() - t1
call psb_amx(ictxt, t2)
call psb_amx(ctxt, t2)
if (iam == psb_root_) then
write(*,'(" ")')
@@ -193,7 +194,7 @@ program amg_cexample_1lev
! set RAS
call P%init(ictxt,'AS',info)
call P%init(ctxt,'AS',info)
! set number of overlaps
@@ -206,7 +207,7 @@ program amg_cexample_1lev
call P%build(A,desc_A,info)
tprec = psb_wtime()-t1
call psb_amx(ictxt, tprec)
call psb_amx(ctxt, tprec)
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='amg_precbld')
@@ -222,13 +223,13 @@ program amg_cexample_1lev
! solve Ax=b with preconditioned Krylov method: BiCGSTAB
kmethod = 'BiCGSTAB'
call psb_barrier(ictxt)
call psb_barrier(ctxt)
t1 = psb_wtime()
call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,istop=2)
t2 = psb_wtime() - t1
call psb_amx(ictxt,t2)
call psb_amx(ctxt,t2)
call psb_geasb(r,desc_A,info,scratch=.true.)
call psb_geaxpby(cone,b,czero,r,desc_A,info)
@@ -239,9 +240,9 @@ program amg_cexample_1lev
amatsize = a%sizeof()
descsize = desc_a%sizeof()
precsize = p%sizeof()
call psb_sum(ictxt,amatsize)
call psb_sum(ictxt,descsize)
call psb_sum(ictxt,precsize)
call psb_sum(ctxt,amatsize)
call psb_sum(ctxt,descsize)
call psb_sum(ctxt,precsize)
call P%descr(info)
if (iam == psb_root_) then
@@ -290,27 +291,28 @@ program amg_cexample_1lev
call psb_spfree(A, desc_A,info)
call P%free(info)
call psb_cdfree(desc_A,info)
call psb_exit(ictxt)
call psb_exit(ctxt)
stop
9999 continue
call psb_error(ictxt)
call psb_error(ctxt)
contains
!
! get parameters from standard input
!
subroutine get_parms(ictxt,mtrx,rhs,filefmt,itmax,tol)
subroutine get_parms(ctxt,mtrx,rhs,filefmt,itmax,tol)
implicit none
integer :: ictxt, itmax
type(psb_ctxt_type) :: ctxt
integer :: itmax
real(psb_spk_) :: tol
character(len=*) :: mtrx, rhs,filefmt
integer :: iam, np, inp_unit
character(len=1024) :: filename
call psb_info(ictxt,iam,np)
call psb_info(ctxt,iam,np)
if (iam == psb_root_) then
if (command_argument_count()>0) then
@@ -319,7 +321,7 @@ contains
open(inp_unit,file=filename,action='read',iostat=info)
if (info /= 0) then
write(psb_err_unit,*) 'Could not open file ',filename,' for input'
call psb_abort(ictxt)
call psb_abort(ctxt)
stop
else
write(psb_err_unit,*) 'Opened file ',trim(filename),' for input'
@@ -338,11 +340,11 @@ contains
end if
end if
call psb_bcast(ictxt,mtrx)
call psb_bcast(ictxt,rhs)
call psb_bcast(ictxt,filefmt)
call psb_bcast(ictxt,itmax)
call psb_bcast(ictxt,tol)
call psb_bcast(ctxt,mtrx)
call psb_bcast(ctxt,rhs)
call psb_bcast(ctxt,filefmt)
call psb_bcast(ctxt,itmax)
call psb_bcast(ctxt,tol)
end subroutine get_parms
end program amg_cexample_1lev
examples/fileread/amg_cexample_ml.f90
+34 -32
View File
@@ -91,7 +91,8 @@ program amg_cexample_ml
integer :: nlev
! parallel environment parameters
integer :: ictxt, iam, np
type(psb_ctxt_type) :: ctxt
integer :: iam, np
! other variables
integer :: choice
@@ -105,12 +106,12 @@ program amg_cexample_ml
! initialize the parallel environment
call psb_init(ictxt)
call psb_info(ictxt,iam,np)
call psb_init(ctxt)
call psb_info(ctxt,iam,np)
if (iam < 0) then
! This should not happen, but just in case
call psb_exit(ictxt)
call psb_exit(ctxt)
stop
endif
@@ -128,9 +129,9 @@ program amg_cexample_ml
! get parameters
call get_parms(ictxt,mtrx_file,rhs_file,filefmt,choice,itmax,tol)
call get_parms(ctxt,mtrx_file,rhs_file,filefmt,choice,itmax,tol)
call psb_barrier(ictxt)
call psb_barrier(ctxt)
t1 = psb_wtime()
! read and assemble the matrix A and the right-hand side b
@@ -159,11 +160,11 @@ program amg_cexample_ml
end select
if (info /= psb_success_) then
write(0,*) 'Error while reading input matrix '
call psb_abort(ictxt)
call psb_abort(ctxt)
end if
m_problem = aux_a%get_nrows()
call psb_bcast(ictxt,m_problem)
call psb_bcast(ctxt,m_problem)
! At this point aux_b may still be unallocated
if (psb_size(aux_b,1) == m_problem) then
@@ -185,17 +186,17 @@ program amg_cexample_ml
enddo
endif
else
call psb_bcast(ictxt,m_problem)
call psb_bcast(ctxt,m_problem)
end if
call psb_barrier(ictxt)
call psb_barrier(ctxt)
if (iam == psb_root_) write(*,'("Partition type: block")')
call psb_matdist(aux_A, A, ictxt, desc_A,info,parts=part_block)
call psb_matdist(aux_A, A, ctxt, desc_A,info,parts=part_block)
call psb_scatter(b_glob,b,desc_a,info,root=psb_root_)
t2 = psb_wtime() - t1
call psb_amx(ictxt, t2)
call psb_amx(ctxt, t2)
if (iam == psb_root_) then
write(*,'(" ")')
@@ -212,7 +213,7 @@ program amg_cexample_ml
! GS sweep as pre/post-smoother and UMFPACK as coarsest-level
! solver
call P%init(ictxt,'ML',info)
call P%init(ctxt,'ML',info)
kmethod = 'CG'
case(2)
@@ -243,7 +244,7 @@ program amg_cexample_ml
! build the preconditioner
call psb_barrier(ictxt)
call psb_barrier(ctxt)
t1 = psb_wtime()
! build the preconditioner
@@ -251,7 +252,7 @@ program amg_cexample_ml
call P%smoothers_build(A,desc_A,info)
tprec = psb_wtime()-t1
call psb_amx(ictxt, tprec)
call psb_amx(ctxt, tprec)
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='amg_precbld')
@@ -265,13 +266,13 @@ program amg_cexample_ml
! solve Ax=b with preconditioned CG
call psb_barrier(ictxt)
call psb_barrier(ctxt)
t1 = psb_wtime()
call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,itrace=1,istop=2)
t2 = psb_wtime() - t1
call psb_amx(ictxt,t2)
call psb_amx(ctxt,t2)
call psb_geasb(r,desc_A,info,scratch=.true.)
call psb_geaxpby(cone,b,czero,r,desc_A,info)
@@ -282,9 +283,9 @@ program amg_cexample_ml
amatsize = a%sizeof()
descsize = desc_a%sizeof()
precsize = p%sizeof()
call psb_sum(ictxt,amatsize)
call psb_sum(ictxt,descsize)
call psb_sum(ictxt,precsize)
call psb_sum(ctxt,amatsize)
call psb_sum(ctxt,descsize)
call psb_sum(ctxt,precsize)
call P%descr(info)
@@ -334,27 +335,28 @@ program amg_cexample_ml
call psb_spfree(A, desc_A,info)
call P%free(info)
call psb_cdfree(desc_A,info)
call psb_exit(ictxt)
call psb_exit(ctxt)
stop
9999 continue
call psb_error(ictxt)
call psb_error(ctxt)
contains
!
! get parameters from standard input
!
subroutine get_parms(ictxt,mtrx,rhs,filefmt,choice,itmax,tol)
subroutine get_parms(ctxt,mtrx,rhs,filefmt,choice,itmax,tol)
implicit none
integer :: ictxt, choice, itmax
type(psb_ctxt_type) :: ctxt
integer :: choice, itmax
real(psb_spk_) :: tol
character(len=*) :: mtrx, rhs,filefmt
integer :: iam, np, inp_unit
character(len=1024) :: filename
call psb_info(ictxt,iam,np)
call psb_info(ctxt,iam,np)
if (iam == psb_root_) then
if (command_argument_count()>0) then
@@ -363,7 +365,7 @@ contains
open(inp_unit,file=filename,action='read',iostat=info)
if (info /= 0) then
write(psb_err_unit,*) 'Could not open file ',filename,' for input'
call psb_abort(ictxt)
call psb_abort(ctxt)
stop
else
write(psb_err_unit,*) 'Opened file ',trim(filename),' for input'
@@ -383,12 +385,12 @@ contains
end if
end if
call psb_bcast(ictxt,mtrx)
call psb_bcast(ictxt,rhs)
call psb_bcast(ictxt,filefmt)
call psb_bcast(ictxt,choice)
call psb_bcast(ictxt,itmax)
call psb_bcast(ictxt,tol)
call psb_bcast(ctxt,mtrx)
call psb_bcast(ctxt,rhs)
call psb_bcast(ctxt,filefmt)
call psb_bcast(ctxt,choice)
call psb_bcast(ctxt,itmax)
call psb_bcast(ctxt,tol)
end subroutine get_parms
end program amg_cexample_ml
examples/fileread/amg_dexample_1lev.f90
+32 -30
View File
@@ -77,7 +77,8 @@ program amg_dexample_1lev
integer :: nlev
! parallel environment parameters
integer :: ictxt, iam, np
type(psb_ctxt_type) :: ctxt
integer :: iam, np
! other variables
integer :: i,info,j,m_problem
@@ -90,12 +91,12 @@ program amg_dexample_1lev
! initialize the parallel environment
call psb_init(ictxt)
call psb_info(ictxt,iam,np)
call psb_init(ctxt)
call psb_info(ctxt,iam,np)
if (iam < 0) then
! This should not happen, but just in case
call psb_exit(ictxt)
call psb_exit(ctxt)
stop
endif
@@ -113,9 +114,9 @@ program amg_dexample_1lev
! get parameters
call get_parms(ictxt,mtrx_file,rhs_file,filefmt,itmax,tol)
call get_parms(ctxt,mtrx_file,rhs_file,filefmt,itmax,tol)
call psb_barrier(ictxt)
call psb_barrier(ctxt)
t1 = psb_wtime()
! read and assemble the matrix A and the right-hand side b
@@ -144,11 +145,11 @@ program amg_dexample_1lev
end select
if (info /= psb_success_) then
write(0,*) 'Error while reading input matrix '
call psb_abort(ictxt)
call psb_abort(ctxt)
end if
m_problem = aux_a%get_nrows()
call psb_bcast(ictxt,m_problem)
call psb_bcast(ctxt,m_problem)
! At this point aux_b may still be unallocated
if (psb_size(aux_b,1) == m_problem) then
@@ -170,17 +171,17 @@ program amg_dexample_1lev
enddo
endif
else
call psb_bcast(ictxt,m_problem)
call psb_bcast(ctxt,m_problem)
end if
call psb_barrier(ictxt)
call psb_barrier(ctxt)
if (iam == psb_root_) write(*,'("Partition type: block")')
call psb_matdist(aux_A, A, ictxt, desc_A,info,parts=part_block)
call psb_matdist(aux_A, A, ctxt, desc_A,info,parts=part_block)
call psb_scatter(b_glob,b,desc_a,info,root=psb_root_)
t2 = psb_wtime() - t1
call psb_amx(ictxt, t2)
call psb_amx(ctxt, t2)
if (iam == psb_root_) then
write(*,'(" ")')
@@ -193,7 +194,7 @@ program amg_dexample_1lev
! set RAS
call P%init(ictxt,'AS',info)
call P%init(ctxt,'AS',info)
! set number of overlaps
@@ -206,7 +207,7 @@ program amg_dexample_1lev
call P%build(A,desc_A,info)
tprec = psb_wtime()-t1
call psb_amx(ictxt, tprec)
call psb_amx(ctxt, tprec)
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='amg_precbld')
@@ -222,13 +223,13 @@ program amg_dexample_1lev
! solve Ax=b with preconditioned Krylov method: BiCGSTAB
kmethod = 'BiCGSTAB'
call psb_barrier(ictxt)
call psb_barrier(ctxt)
t1 = psb_wtime()
call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,istop=2)
t2 = psb_wtime() - t1
call psb_amx(ictxt,t2)
call psb_amx(ctxt,t2)
call psb_geasb(r,desc_A,info,scratch=.true.)
call psb_geaxpby(done,b,dzero,r,desc_A,info)
@@ -239,9 +240,9 @@ program amg_dexample_1lev
amatsize = a%sizeof()
descsize = desc_a%sizeof()
precsize = p%sizeof()
call psb_sum(ictxt,amatsize)
call psb_sum(ictxt,descsize)
call psb_sum(ictxt,precsize)
call psb_sum(ctxt,amatsize)
call psb_sum(ctxt,descsize)
call psb_sum(ctxt,precsize)
call P%descr(info)
if (iam == psb_root_) then
@@ -290,27 +291,28 @@ program amg_dexample_1lev
call psb_spfree(A, desc_A,info)
call P%free(info)
call psb_cdfree(desc_A,info)
call psb_exit(ictxt)
call psb_exit(ctxt)
stop
9999 continue
call psb_error(ictxt)
call psb_error(ctxt)
contains
!
! get parameters from standard input
!
subroutine get_parms(ictxt,mtrx,rhs,filefmt,itmax,tol)
subroutine get_parms(ctxt,mtrx,rhs,filefmt,itmax,tol)
implicit none
integer :: ictxt, itmax
type(psb_ctxt_type) :: ctxt
integer :: itmax
real(psb_dpk_) :: tol
character(len=*) :: mtrx, rhs,filefmt
integer :: iam, np, inp_unit
character(len=1024) :: filename
call psb_info(ictxt,iam,np)
call psb_info(ctxt,iam,np)
if (iam == psb_root_) then
if (command_argument_count()>0) then
@@ -319,7 +321,7 @@ contains
open(inp_unit,file=filename,action='read',iostat=info)
if (info /= 0) then
write(psb_err_unit,*) 'Could not open file ',filename,' for input'
call psb_abort(ictxt)
call psb_abort(ctxt)
stop
else
write(psb_err_unit,*) 'Opened file ',trim(filename),' for input'
@@ -338,11 +340,11 @@ contains
end if
end if
call psb_bcast(ictxt,mtrx)
call psb_bcast(ictxt,rhs)
call psb_bcast(ictxt,filefmt)
call psb_bcast(ictxt,itmax)
call psb_bcast(ictxt,tol)
call psb_bcast(ctxt,mtrx)
call psb_bcast(ctxt,rhs)
call psb_bcast(ctxt,filefmt)
call psb_bcast(ctxt,itmax)
call psb_bcast(ctxt,tol)
end subroutine get_parms
end program amg_dexample_1lev
examples/fileread/amg_dexample_ml.f90
+34 -32
View File
@@ -91,7 +91,8 @@ program amg_dexample_ml
integer :: nlev
! parallel environment parameters
integer :: ictxt, iam, np
type(psb_ctxt_type) :: ctxt
integer :: iam, np
! other variables
integer :: choice
@@ -105,12 +106,12 @@ program amg_dexample_ml
! initialize the parallel environment
call psb_init(ictxt)
call psb_info(ictxt,iam,np)
call psb_init(ctxt)
call psb_info(ctxt,iam,np)
if (iam < 0) then
! This should not happen, but just in case
call psb_exit(ictxt)
call psb_exit(ctxt)
stop
endif
@@ -128,9 +129,9 @@ program amg_dexample_ml
! get parameters
call get_parms(ictxt,mtrx_file,rhs_file,filefmt,choice,itmax,tol)
call get_parms(ctxt,mtrx_file,rhs_file,filefmt,choice,itmax,tol)
call psb_barrier(ictxt)
call psb_barrier(ctxt)
t1 = psb_wtime()
! read and assemble the matrix A and the right-hand side b
@@ -159,11 +160,11 @@ program amg_dexample_ml
end select
if (info /= psb_success_) then
write(0,*) 'Error while reading input matrix '
call psb_abort(ictxt)
call psb_abort(ctxt)
end if
m_problem = aux_a%get_nrows()
call psb_bcast(ictxt,m_problem)
call psb_bcast(ctxt,m_problem)
! At this point aux_b may still be unallocated
if (psb_size(aux_b,1) == m_problem) then
@@ -185,17 +186,17 @@ program amg_dexample_ml
enddo
endif
else
call psb_bcast(ictxt,m_problem)
call psb_bcast(ctxt,m_problem)
end if
call psb_barrier(ictxt)
call psb_barrier(ctxt)
if (iam == psb_root_) write(*,'("Partition type: block")')
call psb_matdist(aux_A, A, ictxt, desc_A,info,parts=part_block)
call psb_matdist(aux_A, A, ctxt, desc_A,info,parts=part_block)
call psb_scatter(b_glob,b,desc_a,info,root=psb_root_)
t2 = psb_wtime() - t1
call psb_amx(ictxt, t2)
call psb_amx(ctxt, t2)
if (iam == psb_root_) then
write(*,'(" ")')
@@ -212,7 +213,7 @@ program amg_dexample_ml
! GS sweep as pre/post-smoother and UMFPACK as coarsest-level
! solver
call P%init(ictxt,'ML',info)
call P%init(ctxt,'ML',info)
kmethod = 'CG'
case(2)
@@ -243,7 +244,7 @@ program amg_dexample_ml
! build the preconditioner
call psb_barrier(ictxt)
call psb_barrier(ctxt)
t1 = psb_wtime()
! build the preconditioner
@@ -251,7 +252,7 @@ program amg_dexample_ml
call P%smoothers_build(A,desc_A,info)
tprec = psb_wtime()-t1
call psb_amx(ictxt, tprec)
call psb_amx(ctxt, tprec)
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='amg_precbld')
@@ -265,13 +266,13 @@ program amg_dexample_ml
! solve Ax=b with preconditioned CG
call psb_barrier(ictxt)
call psb_barrier(ctxt)
t1 = psb_wtime()
call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,itrace=1,istop=2)
t2 = psb_wtime() - t1
call psb_amx(ictxt,t2)
call psb_amx(ctxt,t2)
call psb_geasb(r,desc_A,info,scratch=.true.)
call psb_geaxpby(done,b,dzero,r,desc_A,info)
@@ -282,9 +283,9 @@ program amg_dexample_ml
amatsize = a%sizeof()
descsize = desc_a%sizeof()
precsize = p%sizeof()
call psb_sum(ictxt,amatsize)
call psb_sum(ictxt,descsize)
call psb_sum(ictxt,precsize)
call psb_sum(ctxt,amatsize)
call psb_sum(ctxt,descsize)
call psb_sum(ctxt,precsize)
call P%descr(info)
@@ -334,27 +335,28 @@ program amg_dexample_ml
call psb_spfree(A, desc_A,info)
call P%free(info)
call psb_cdfree(desc_A,info)
call psb_exit(ictxt)
call psb_exit(ctxt)
stop
9999 continue
call psb_error(ictxt)
call psb_error(ctxt)
contains
!
! get parameters from standard input
!
subroutine get_parms(ictxt,mtrx,rhs,filefmt,choice,itmax,tol)
subroutine get_parms(ctxt,mtrx,rhs,filefmt,choice,itmax,tol)
implicit none
integer :: ictxt, choice, itmax
type(psb_ctxt_type) :: ctxt
integer :: choice, itmax
real(psb_dpk_) :: tol
character(len=*) :: mtrx, rhs,filefmt
integer :: iam, np, inp_unit
character(len=1024) :: filename
call psb_info(ictxt,iam,np)
call psb_info(ctxt,iam,np)
if (iam == psb_root_) then
if (command_argument_count()>0) then
@@ -363,7 +365,7 @@ contains
open(inp_unit,file=filename,action='read',iostat=info)
if (info /= 0) then
write(psb_err_unit,*) 'Could not open file ',filename,' for input'
call psb_abort(ictxt)
call psb_abort(ctxt)
stop
else
write(psb_err_unit,*) 'Opened file ',trim(filename),' for input'
@@ -383,12 +385,12 @@ contains
end if
end if
call psb_bcast(ictxt,mtrx)
call psb_bcast(ictxt,rhs)
call psb_bcast(ictxt,filefmt)
call psb_bcast(ictxt,choice)
call psb_bcast(ictxt,itmax)
call psb_bcast(ictxt,tol)
call psb_bcast(ctxt,mtrx)
call psb_bcast(ctxt,rhs)
call psb_bcast(ctxt,filefmt)
call psb_bcast(ctxt,choice)
call psb_bcast(ctxt,itmax)
call psb_bcast(ctxt,tol)
end subroutine get_parms
end program amg_dexample_ml
examples/fileread/amg_sexample_1lev.f90
+32 -30
View File
@@ -77,7 +77,8 @@ program amg_sexample_1lev
integer :: nlev
! parallel environment parameters
integer :: ictxt, iam, np
type(psb_ctxt_type) :: ctxt
integer :: iam, np
! other variables
integer :: i,info,j,m_problem
@@ -90,12 +91,12 @@ program amg_sexample_1lev
! initialize the parallel environment
call psb_init(ictxt)
call psb_info(ictxt,iam,np)
call psb_init(ctxt)
call psb_info(ctxt,iam,np)
if (iam < 0) then
! This should not happen, but just in case
call psb_exit(ictxt)
call psb_exit(ctxt)
stop
endif
@@ -113,9 +114,9 @@ program amg_sexample_1lev
! get parameters
call get_parms(ictxt,mtrx_file,rhs_file,filefmt,itmax,tol)
call get_parms(ctxt,mtrx_file,rhs_file,filefmt,itmax,tol)
call psb_barrier(ictxt)
call psb_barrier(ctxt)
t1 = psb_wtime()
! read and assemble the matrix A and the right-hand side b
@@ -144,11 +145,11 @@ program amg_sexample_1lev
end select
if (info /= psb_success_) then
write(0,*) 'Error while reading input matrix '
call psb_abort(ictxt)
call psb_abort(ctxt)
end if
m_problem = aux_a%get_nrows()
call psb_bcast(ictxt,m_problem)
call psb_bcast(ctxt,m_problem)
! At this point aux_b may still be unallocated
if (psb_size(aux_b,1) == m_problem) then
@@ -170,17 +171,17 @@ program amg_sexample_1lev
enddo
endif
else
call psb_bcast(ictxt,m_problem)
call psb_bcast(ctxt,m_problem)
end if
call psb_barrier(ictxt)
call psb_barrier(ctxt)
if (iam == psb_root_) write(*,'("Partition type: block")')
call psb_matdist(aux_A, A, ictxt, desc_A,info,parts=part_block)
call psb_matdist(aux_A, A, ctxt, desc_A,info,parts=part_block)
call psb_scatter(b_glob,b,desc_a,info,root=psb_root_)
t2 = psb_wtime() - t1
call psb_amx(ictxt, t2)
call psb_amx(ctxt, t2)
if (iam == psb_root_) then
write(*,'(" ")')
@@ -193,7 +194,7 @@ program amg_sexample_1lev
! set RAS
call P%init(ictxt,'AS',info)
call P%init(ctxt,'AS',info)
! set number of overlaps
@@ -206,7 +207,7 @@ program amg_sexample_1lev
call P%build(A,desc_A,info)
tprec = psb_wtime()-t1
call psb_amx(ictxt, tprec)
call psb_amx(ctxt, tprec)
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='amg_precbld')
@@ -222,13 +223,13 @@ program amg_sexample_1lev
! solve Ax=b with preconditioned Krylov method: BiCGSTAB
kmethod = 'BiCGSTAB'
call psb_barrier(ictxt)
call psb_barrier(ctxt)
t1 = psb_wtime()
call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,istop=2)
t2 = psb_wtime() - t1
call psb_amx(ictxt,t2)
call psb_amx(ctxt,t2)
call psb_geasb(r,desc_A,info,scratch=.true.)
call psb_geaxpby(sone,b,szero,r,desc_A,info)
@@ -239,9 +240,9 @@ program amg_sexample_1lev
amatsize = a%sizeof()
descsize = desc_a%sizeof()
precsize = p%sizeof()
call psb_sum(ictxt,amatsize)
call psb_sum(ictxt,descsize)
call psb_sum(ictxt,precsize)
call psb_sum(ctxt,amatsize)
call psb_sum(ctxt,descsize)
call psb_sum(ctxt,precsize)
call P%descr(info)
if (iam == psb_root_) then
@@ -290,27 +291,28 @@ program amg_sexample_1lev
call psb_spfree(A, desc_A,info)
call P%free(info)
call psb_cdfree(desc_A,info)
call psb_exit(ictxt)
call psb_exit(ctxt)
stop
9999 continue
call psb_error(ictxt)
call psb_error(ctxt)
contains
!
! get parameters from standard input
!
subroutine get_parms(ictxt,mtrx,rhs,filefmt,itmax,tol)
subroutine get_parms(ctxt,mtrx,rhs,filefmt,itmax,tol)
implicit none
integer :: ictxt, itmax
type(psb_ctxt_type) :: ctxt
integer :: itmax
real(psb_spk_) :: tol
character(len=*) :: mtrx, rhs,filefmt
integer :: iam, np, inp_unit
character(len=1024) :: filename
call psb_info(ictxt,iam,np)
call psb_info(ctxt,iam,np)
if (iam == psb_root_) then
if (command_argument_count()>0) then
@@ -319,7 +321,7 @@ contains
open(inp_unit,file=filename,action='read',iostat=info)
if (info /= 0) then
write(psb_err_unit,*) 'Could not open file ',filename,' for input'
call psb_abort(ictxt)
call psb_abort(ctxt)
stop
else
write(psb_err_unit,*) 'Opened file ',trim(filename),' for input'
@@ -338,11 +340,11 @@ contains
end if
end if
call psb_bcast(ictxt,mtrx)
call psb_bcast(ictxt,rhs)
call psb_bcast(ictxt,filefmt)
call psb_bcast(ictxt,itmax)
call psb_bcast(ictxt,tol)
call psb_bcast(ctxt,mtrx)
call psb_bcast(ctxt,rhs)
call psb_bcast(ctxt,filefmt)
call psb_bcast(ctxt,itmax)
call psb_bcast(ctxt,tol)
end subroutine get_parms
end program amg_sexample_1lev
examples/fileread/amg_sexample_ml.f90
+34 -32
View File
@@ -91,7 +91,8 @@ program amg_sexample_ml
integer :: nlev
! parallel environment parameters
integer :: ictxt, iam, np
type(psb_ctxt_type) :: ctxt
integer :: iam, np
! other variables
integer :: choice
@@ -105,12 +106,12 @@ program amg_sexample_ml
! initialize the parallel environment
call psb_init(ictxt)
call psb_info(ictxt,iam,np)
call psb_init(ctxt)
call psb_info(ctxt,iam,np)
if (iam < 0) then
! This should not happen, but just in case
call psb_exit(ictxt)
call psb_exit(ctxt)
stop
endif
@@ -128,9 +129,9 @@ program amg_sexample_ml
! get parameters
call get_parms(ictxt,mtrx_file,rhs_file,filefmt,choice,itmax,tol)
call get_parms(ctxt,mtrx_file,rhs_file,filefmt,choice,itmax,tol)
call psb_barrier(ictxt)
call psb_barrier(ctxt)
t1 = psb_wtime()
! read and assemble the matrix A and the right-hand side b
@@ -159,11 +160,11 @@ program amg_sexample_ml
end select
if (info /= psb_success_) then
write(0,*) 'Error while reading input matrix '
call psb_abort(ictxt)
call psb_abort(ctxt)
end if
m_problem = aux_a%get_nrows()
call psb_bcast(ictxt,m_problem)
call psb_bcast(ctxt,m_problem)
! At this point aux_b may still be unallocated
if (psb_size(aux_b,1) == m_problem) then
@@ -185,17 +186,17 @@ program amg_sexample_ml
enddo
endif
else
call psb_bcast(ictxt,m_problem)
call psb_bcast(ctxt,m_problem)
end if
call psb_barrier(ictxt)
call psb_barrier(ctxt)
if (iam == psb_root_) write(*,'("Partition type: block")')
call psb_matdist(aux_A, A, ictxt, desc_A,info,parts=part_block)
call psb_matdist(aux_A, A, ctxt, desc_A,info,parts=part_block)
call psb_scatter(b_glob,b,desc_a,info,root=psb_root_)
t2 = psb_wtime() - t1
call psb_amx(ictxt, t2)
call psb_amx(ctxt, t2)
if (iam == psb_root_) then
write(*,'(" ")')
@@ -212,7 +213,7 @@ program amg_sexample_ml
! GS sweep as pre/post-smoother and UMFPACK as coarsest-level
! solver
call P%init(ictxt,'ML',info)
call P%init(ctxt,'ML',info)
kmethod = 'CG'
case(2)
@@ -243,7 +244,7 @@ program amg_sexample_ml
! build the preconditioner
call psb_barrier(ictxt)
call psb_barrier(ctxt)
t1 = psb_wtime()
! build the preconditioner
@@ -251,7 +252,7 @@ program amg_sexample_ml
call P%smoothers_build(A,desc_A,info)
tprec = psb_wtime()-t1
call psb_amx(ictxt, tprec)
call psb_amx(ctxt, tprec)
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='amg_precbld')
@@ -265,13 +266,13 @@ program amg_sexample_ml
! solve Ax=b with preconditioned CG
call psb_barrier(ictxt)
call psb_barrier(ctxt)
t1 = psb_wtime()
call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,itrace=1,istop=2)
t2 = psb_wtime() - t1
call psb_amx(ictxt,t2)
call psb_amx(ctxt,t2)
call psb_geasb(r,desc_A,info,scratch=.true.)
call psb_geaxpby(sone,b,szero,r,desc_A,info)
@@ -282,9 +283,9 @@ program amg_sexample_ml
amatsize = a%sizeof()
descsize = desc_a%sizeof()
precsize = p%sizeof()
call psb_sum(ictxt,amatsize)
call psb_sum(ictxt,descsize)
call psb_sum(ictxt,precsize)
call psb_sum(ctxt,amatsize)
call psb_sum(ctxt,descsize)
call psb_sum(ctxt,precsize)
call P%descr(info)
@@ -334,27 +335,28 @@ program amg_sexample_ml
call psb_spfree(A, desc_A,info)
call P%free(info)
call psb_cdfree(desc_A,info)
call psb_exit(ictxt)
call psb_exit(ctxt)
stop
9999 continue
call psb_error(ictxt)
call psb_error(ctxt)
contains
!
! get parameters from standard input
!
subroutine get_parms(ictxt,mtrx,rhs,filefmt,choice,itmax,tol)
subroutine get_parms(ctxt,mtrx,rhs,filefmt,choice,itmax,tol)
implicit none
integer :: ictxt, choice, itmax
type(psb_ctxt_type) :: ctxt
integer :: choice, itmax
real(psb_spk_) :: tol
character(len=*) :: mtrx, rhs,filefmt
integer :: iam, np, inp_unit
character(len=1024) :: filename
call psb_info(ictxt,iam,np)
call psb_info(ctxt,iam,np)
if (iam == psb_root_) then
if (command_argument_count()>0) then
@@ -363,7 +365,7 @@ contains
open(inp_unit,file=filename,action='read',iostat=info)
if (info /= 0) then
write(psb_err_unit,*) 'Could not open file ',filename,' for input'
call psb_abort(ictxt)
call psb_abort(ctxt)
stop
else
write(psb_err_unit,*) 'Opened file ',trim(filename),' for input'
@@ -383,12 +385,12 @@ contains
end if
end if
call psb_bcast(ictxt,mtrx)
call psb_bcast(ictxt,rhs)
call psb_bcast(ictxt,filefmt)
call psb_bcast(ictxt,choice)
call psb_bcast(ictxt,itmax)
call psb_bcast(ictxt,tol)
call psb_bcast(ctxt,mtrx)
call psb_bcast(ctxt,rhs)
call psb_bcast(ctxt,filefmt)
call psb_bcast(ctxt,choice)
call psb_bcast(ctxt,itmax)
call psb_bcast(ctxt,tol)
end subroutine get_parms
end program amg_sexample_ml
examples/fileread/amg_zexample_1lev.f90
+32 -30
View File
@@ -77,7 +77,8 @@ program amg_zexample_1lev
integer :: nlev
! parallel environment parameters
integer :: ictxt, iam, np
type(psb_ctxt_type) :: ctxt
integer :: iam, np
! other variables
integer :: i,info,j,m_problem
@@ -90,12 +91,12 @@ program amg_zexample_1lev
! initialize the parallel environment
call psb_init(ictxt)
call psb_info(ictxt,iam,np)
call psb_init(ctxt)
call psb_info(ctxt,iam,np)
if (iam < 0) then
! This should not happen, but just in case
call psb_exit(ictxt)
call psb_exit(ctxt)
stop
endif
@@ -113,9 +114,9 @@ program amg_zexample_1lev
! get parameters
call get_parms(ictxt,mtrx_file,rhs_file,filefmt,itmax,tol)
call get_parms(ctxt,mtrx_file,rhs_file,filefmt,itmax,tol)
call psb_barrier(ictxt)
call psb_barrier(ctxt)
t1 = psb_wtime()
! read and assemble the matrix A and the right-hand side b
@@ -144,11 +145,11 @@ program amg_zexample_1lev
end select
if (info /= psb_success_) then
write(0,*) 'Error while reading input matrix '
call psb_abort(ictxt)
call psb_abort(ctxt)
end if
m_problem = aux_a%get_nrows()
call psb_bcast(ictxt,m_problem)
call psb_bcast(ctxt,m_problem)
! At this point aux_b may still be unallocated
if (psb_size(aux_b,1) == m_problem) then
@@ -170,17 +171,17 @@ program amg_zexample_1lev
enddo
endif
else
call psb_bcast(ictxt,m_problem)
call psb_bcast(ctxt,m_problem)
end if
call psb_barrier(ictxt)
call psb_barrier(ctxt)
if (iam == psb_root_) write(*,'("Partition type: block")')
call psb_matdist(aux_A, A, ictxt, desc_A,info,parts=part_block)
call psb_matdist(aux_A, A, ctxt, desc_A,info,parts=part_block)
call psb_scatter(b_glob,b,desc_a,info,root=psb_root_)
t2 = psb_wtime() - t1
call psb_amx(ictxt, t2)
call psb_amx(ctxt, t2)
if (iam == psb_root_) then
write(*,'(" ")')
@@ -193,7 +194,7 @@ program amg_zexample_1lev
! set RAS
call P%init(ictxt,'AS',info)
call P%init(ctxt,'AS',info)
! set number of overlaps
@@ -206,7 +207,7 @@ program amg_zexample_1lev
call P%build(A,desc_A,info)
tprec = psb_wtime()-t1
call psb_amx(ictxt, tprec)
call psb_amx(ctxt, tprec)
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='amg_precbld')
@@ -222,13 +223,13 @@ program amg_zexample_1lev
! solve Ax=b with preconditioned Krylov method: BiCGSTAB
kmethod = 'BiCGSTAB'
call psb_barrier(ictxt)
call psb_barrier(ctxt)
t1 = psb_wtime()
call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,istop=2)
t2 = psb_wtime() - t1
call psb_amx(ictxt,t2)
call psb_amx(ctxt,t2)
call psb_geasb(r,desc_A,info,scratch=.true.)
call psb_geaxpby(zone,b,zzero,r,desc_A,info)
@@ -239,9 +240,9 @@ program amg_zexample_1lev
amatsize = a%sizeof()
descsize = desc_a%sizeof()
precsize = p%sizeof()
call psb_sum(ictxt,amatsize)
call psb_sum(ictxt,descsize)
call psb_sum(ictxt,precsize)
call psb_sum(ctxt,amatsize)
call psb_sum(ctxt,descsize)
call psb_sum(ctxt,precsize)
call P%descr(info)
if (iam == psb_root_) then
@@ -290,27 +291,28 @@ program amg_zexample_1lev
call psb_spfree(A, desc_A,info)
call P%free(info)
call psb_cdfree(desc_A,info)
call psb_exit(ictxt)
call psb_exit(ctxt)
stop
9999 continue
call psb_error(ictxt)
call psb_error(ctxt)
contains
!
! get parameters from standard input
!
subroutine get_parms(ictxt,mtrx,rhs,filefmt,itmax,tol)
subroutine get_parms(ctxt,mtrx,rhs,filefmt,itmax,tol)
implicit none
integer :: ictxt, itmax
type(psb_ctxt_type) :: ctxt
integer :: itmax
real(psb_dpk_) :: tol
character(len=*) :: mtrx, rhs,filefmt
integer :: iam, np, inp_unit
character(len=1024) :: filename
call psb_info(ictxt,iam,np)
call psb_info(ctxt,iam,np)
if (iam == psb_root_) then
if (command_argument_count()>0) then
@@ -319,7 +321,7 @@ contains
open(inp_unit,file=filename,action='read',iostat=info)
if (info /= 0) then
write(psb_err_unit,*) 'Could not open file ',filename,' for input'
call psb_abort(ictxt)
call psb_abort(ctxt)
stop
else
write(psb_err_unit,*) 'Opened file ',trim(filename),' for input'
@@ -338,11 +340,11 @@ contains
end if
end if
call psb_bcast(ictxt,mtrx)
call psb_bcast(ictxt,rhs)
call psb_bcast(ictxt,filefmt)
call psb_bcast(ictxt,itmax)
call psb_bcast(ictxt,tol)
call psb_bcast(ctxt,mtrx)
call psb_bcast(ctxt,rhs)
call psb_bcast(ctxt,filefmt)
call psb_bcast(ctxt,itmax)
call psb_bcast(ctxt,tol)
end subroutine get_parms
end program amg_zexample_1lev
examples/fileread/amg_zexample_ml.f90
+34 -32
View File
@@ -91,7 +91,8 @@ program amg_zexample_ml
integer :: nlev
! parallel environment parameters
integer :: ictxt, iam, np
type(psb_ctxt_type) :: ctxt
integer :: iam, np
! other variables
integer :: choice
@@ -105,12 +106,12 @@ program amg_zexample_ml
! initialize the parallel environment
call psb_init(ictxt)
call psb_info(ictxt,iam,np)
call psb_init(ctxt)
call psb_info(ctxt,iam,np)
if (iam < 0) then
! This should not happen, but just in case
call psb_exit(ictxt)
call psb_exit(ctxt)
stop
endif
@@ -128,9 +129,9 @@ program amg_zexample_ml
! get parameters
call get_parms(ictxt,mtrx_file,rhs_file,filefmt,choice,itmax,tol)
call get_parms(ctxt,mtrx_file,rhs_file,filefmt,choice,itmax,tol)
call psb_barrier(ictxt)
call psb_barrier(ctxt)
t1 = psb_wtime()
! read and assemble the matrix A and the right-hand side b
@@ -159,11 +160,11 @@ program amg_zexample_ml
end select
if (info /= psb_success_) then
write(0,*) 'Error while reading input matrix '
call psb_abort(ictxt)
call psb_abort(ctxt)
end if
m_problem = aux_a%get_nrows()
call psb_bcast(ictxt,m_problem)
call psb_bcast(ctxt,m_problem)
! At this point aux_b may still be unallocated
if (psb_size(aux_b,1) == m_problem) then
@@ -185,17 +186,17 @@ program amg_zexample_ml
enddo
endif
else
call psb_bcast(ictxt,m_problem)
call psb_bcast(ctxt,m_problem)
end if
call psb_barrier(ictxt)
call psb_barrier(ctxt)
if (iam == psb_root_) write(*,'("Partition type: block")')
call psb_matdist(aux_A, A, ictxt, desc_A,info,parts=part_block)
call psb_matdist(aux_A, A, ctxt, desc_A,info,parts=part_block)
call psb_scatter(b_glob,b,desc_a,info,root=psb_root_)
t2 = psb_wtime() - t1
call psb_amx(ictxt, t2)
call psb_amx(ctxt, t2)
if (iam == psb_root_) then
write(*,'(" ")')
@@ -212,7 +213,7 @@ program amg_zexample_ml
! GS sweep as pre/post-smoother and UMFPACK as coarsest-level
! solver
call P%init(ictxt,'ML',info)
call P%init(ctxt,'ML',info)
kmethod = 'CG'
case(2)
@@ -243,7 +244,7 @@ program amg_zexample_ml
! build the preconditioner
call psb_barrier(ictxt)
call psb_barrier(ctxt)
t1 = psb_wtime()
! build the preconditioner
@@ -251,7 +252,7 @@ program amg_zexample_ml
call P%smoothers_build(A,desc_A,info)
tprec = psb_wtime()-t1
call psb_amx(ictxt, tprec)
call psb_amx(ctxt, tprec)
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='amg_precbld')
@@ -265,13 +266,13 @@ program amg_zexample_ml
! solve Ax=b with preconditioned CG
call psb_barrier(ictxt)
call psb_barrier(ctxt)
t1 = psb_wtime()
call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,itrace=1,istop=2)
t2 = psb_wtime() - t1
call psb_amx(ictxt,t2)
call psb_amx(ctxt,t2)
call psb_geasb(r,desc_A,info,scratch=.true.)
call psb_geaxpby(zone,b,zzero,r,desc_A,info)
@@ -282,9 +283,9 @@ program amg_zexample_ml
amatsize = a%sizeof()
descsize = desc_a%sizeof()
precsize = p%sizeof()
call psb_sum(ictxt,amatsize)
call psb_sum(ictxt,descsize)
call psb_sum(ictxt,precsize)
call psb_sum(ctxt,amatsize)
call psb_sum(ctxt,descsize)
call psb_sum(ctxt,precsize)
call P%descr(info)
@@ -334,27 +335,28 @@ program amg_zexample_ml
call psb_spfree(A, desc_A,info)
call P%free(info)
call psb_cdfree(desc_A,info)
call psb_exit(ictxt)
call psb_exit(ctxt)
stop
9999 continue
call psb_error(ictxt)
call psb_error(ctxt)
contains
!
! get parameters from standard input
!
subroutine get_parms(ictxt,mtrx,rhs,filefmt,choice,itmax,tol)
subroutine get_parms(ctxt,mtrx,rhs,filefmt,choice,itmax,tol)
implicit none
integer :: ictxt, choice, itmax
type(psb_ctxt_type) :: ctxt
integer :: choice, itmax
real(psb_dpk_) :: tol
character(len=*) :: mtrx, rhs,filefmt
integer :: iam, np, inp_unit
character(len=1024) :: filename
call psb_info(ictxt,iam,np)
call psb_info(ctxt,iam,np)
if (iam == psb_root_) then
if (command_argument_count()>0) then
@@ -363,7 +365,7 @@ contains
open(inp_unit,file=filename,action='read',iostat=info)
if (info /= 0) then
write(psb_err_unit,*) 'Could not open file ',filename,' for input'
call psb_abort(ictxt)
call psb_abort(ctxt)
stop
else
write(psb_err_unit,*) 'Opened file ',trim(filename),' for input'
@@ -383,12 +385,12 @@ contains
end if
end if
call psb_bcast(ictxt,mtrx)
call psb_bcast(ictxt,rhs)
call psb_bcast(ictxt,filefmt)
call psb_bcast(ictxt,choice)
call psb_bcast(ictxt,itmax)
call psb_bcast(ictxt,tol)
call psb_bcast(ctxt,mtrx)
call psb_bcast(ctxt,rhs)
call psb_bcast(ctxt,filefmt)
call psb_bcast(ctxt,choice)
call psb_bcast(ctxt,itmax)
call psb_bcast(ctxt,tol)
end subroutine get_parms
end program amg_zexample_ml
examples/pdegen/amg_dexample_1lev.f90
+26 -24
View File
@@ -85,7 +85,8 @@ program amg_dexample_1lev
integer :: itmax, iter, itrace, istop
! parallel environment parameters
integer :: ictxt, iam, np
type(psb_ctxt_type) :: ctxt
integer :: iam, np
! other variables
integer :: i,info,j
@@ -98,12 +99,12 @@ program amg_dexample_1lev
character(len=20) :: name, kmethod
! initialize the parallel environment
call psb_init(ictxt)
call psb_info(ictxt,iam,np)
call psb_init(ctxt)
call psb_info(ctxt,iam,np)
if (iam < 0) then
! This should not happen, but just in case
call psb_exit(ictxt)
call psb_exit(ctxt)
stop
endif
@@ -121,15 +122,15 @@ program amg_dexample_1lev
! get parameters
call get_parms(ictxt,idim,itmax,tol)
call get_parms(ctxt,idim,itmax,tol)
! allocate and fill in the coefficient matrix, rhs and initial guess
call psb_barrier(ictxt)
call psb_barrier(ctxt)
t1 = psb_wtime()
call amg_gen_pde3d(ictxt,idim,a,b,x,desc_a,afmt,&
call amg_gen_pde3d(ctxt,idim,a,b,x,desc_a,afmt,&
& a1,a2,a3,b1,b2,b3,c,g,info)
call psb_barrier(ictxt)
call psb_barrier(ctxt)
t2 = psb_wtime() - t1
if(info /= psb_success_) then
info=psb_err_from_subroutine_
@@ -142,7 +143,7 @@ program amg_dexample_1lev
! set RAS
call P%init(ictxt,'AS',info)
call P%init(ctxt,'AS',info)
! set number of overlaps
@@ -155,7 +156,7 @@ program amg_dexample_1lev
call P%build(A,desc_A,info)
tprec = psb_wtime()-t1
call psb_amx(ictxt, tprec)
call psb_amx(ctxt, tprec)
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='amg_precbld')
@@ -171,13 +172,13 @@ program amg_dexample_1lev
! solve Ax=b with preconditioned Krylov method: BiCGSTAB
kmethod = 'BiCGSTAB'
call psb_barrier(ictxt)
call psb_barrier(ctxt)
t1 = psb_wtime()
call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,itrace=1,istop=2)
t2 = psb_wtime() - t1
call psb_amx(ictxt,t2)
call psb_amx(ctxt,t2)
call psb_geall(r,desc_A,info)
call r%zero()
@@ -191,9 +192,9 @@ program amg_dexample_1lev
descsize = desc_a%sizeof()
precsize = p%sizeof()
system_size = desc_a%get_global_rows()
call psb_sum(ictxt,amatsize)
call psb_sum(ictxt,descsize)
call psb_sum(ictxt,precsize)
call psb_sum(ctxt,amatsize)
call psb_sum(ctxt,descsize)
call psb_sum(ctxt,precsize)
call P%descr(info)
@@ -221,26 +222,27 @@ program amg_dexample_1lev
call psb_spfree(A, desc_A,info)
call P%free(info)
call psb_cdfree(desc_A,info)
call psb_exit(ictxt)
call psb_exit(ctxt)
stop
9999 continue
call psb_error(ictxt)
call psb_error(ctxt)
contains
!
! get parameters from standard input
!
subroutine get_parms(ictxt,idim,itmax,tol)
subroutine get_parms(ctxt,idim,itmax,tol)
implicit none
integer :: idim, ictxt, itmax
type(psb_ctxt_type) :: ctxt
integer :: idim, itmax
real(psb_dpk_) :: tol
integer :: iam, np, inp_unit
character(len=1024) :: filename
call psb_info(ictxt,iam,np)
call psb_info(ctxt,iam,np)
if (iam == psb_root_) then
if (command_argument_count()>0) then
@@ -249,7 +251,7 @@ contains
open(inp_unit,file=filename,action='read',iostat=info)
if (info /= 0) then
write(psb_err_unit,*) 'Could not open file ',filename,' for input'
call psb_abort(ictxt)
call psb_abort(ctxt)
stop
else
write(psb_err_unit,*) 'Opened file ',trim(filename),' for input'
@@ -267,9 +269,9 @@ contains
end if
end if
call psb_bcast(ictxt,idim)
call psb_bcast(ictxt,itmax)
call psb_bcast(ictxt,tol)
call psb_bcast(ctxt,idim)
call psb_bcast(ctxt,itmax)
call psb_bcast(ctxt,tol)
end subroutine get_parms
end program amg_dexample_1lev
examples/pdegen/amg_dexample_ml.f90
+30 -28
View File
@@ -103,7 +103,8 @@ program amg_dexample_ml
integer :: nlev
! parallel environment parameters
integer :: ictxt, iam, np
type(psb_ctxt_type) :: ctxt
integer :: iam, np
! other variables
integer :: choice
@@ -118,12 +119,12 @@ program amg_dexample_ml
! initialize the parallel environment
call psb_init(ictxt)
call psb_info(ictxt,iam,np)
call psb_init(ctxt)
call psb_info(ctxt,iam,np)
if (iam < 0) then
! This should not happen, but just in case
call psb_exit(ictxt)
call psb_exit(ctxt)
stop
endif
@@ -141,15 +142,15 @@ program amg_dexample_ml
! get parameters
call get_parms(ictxt,choice,idim,itmax,tol)
call get_parms(ctxt,choice,idim,itmax,tol)
! allocate and fill in the coefficient matrix, rhs and initial guess
call psb_barrier(ictxt)
call psb_barrier(ctxt)
t1 = psb_wtime()
call amg_gen_pde3d(ictxt,idim,a,b,x,desc_a,afmt,&
call amg_gen_pde3d(ctxt,idim,a,b,x,desc_a,afmt,&
& a1,a2,a3,b1,b2,b3,c,g,info)
call psb_barrier(ictxt)
call psb_barrier(ctxt)
t2 = psb_wtime() - t1
if(info /= psb_success_) then
info=psb_err_from_subroutine_
@@ -169,7 +170,7 @@ program amg_dexample_ml
! GS sweep as pre/post-smoother and UMFPACK as coarsest-level
! solver
call P%init(ictxt,'ML',info)
call P%init(ctxt,'ML',info)
kmethod = 'CG'
case(2)
@@ -178,7 +179,7 @@ program amg_dexample_ml
! ILU(0) on the blocks) as pre- and post-smoother, and 8 block-Jacobi
! sweeps (with ILU(0) on the blocks) as coarsest-level solver
call P%init(ictxt,'ML',info)
call P%init(ctxt,'ML',info)
call P%set('SMOOTHER_TYPE','BJAC',info)
call P%set('COARSE_SOLVE','BJAC',info)
call P%set('COARSE_SWEEPS',8,info)
@@ -190,7 +191,7 @@ program amg_dexample_ml
! GS sweeps as pre/post-smoother, a distributed coarsest
! matrix, and MUMPS as coarsest-level solver
call P%init(ictxt,'ML',info)
call P%init(ctxt,'ML',info)
call P%set('ML_CYCLE','WCYCLE',info)
call P%set('SMOOTHER_SWEEPS',2,info)
call P%set('COARSE_SOLVE','MUMPS',info)
@@ -199,7 +200,7 @@ program amg_dexample_ml
end select
call psb_barrier(ictxt)
call psb_barrier(ctxt)
t1 = psb_wtime()
! build the preconditioner
@@ -207,7 +208,7 @@ program amg_dexample_ml
call P%smoothers_build(A,desc_A,info)
tprec = psb_wtime()-t1
call psb_amx(ictxt, tprec)
call psb_amx(ctxt, tprec)
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='amg_precbld')
@@ -222,13 +223,13 @@ program amg_dexample_ml
! solve Ax=b with preconditioned Krylov method
call psb_barrier(ictxt)
call psb_barrier(ctxt)
t1 = psb_wtime()
call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,itrace=1,istop=2)
t2 = psb_wtime() - t1
call psb_amx(ictxt,t2)
call psb_amx(ctxt,t2)
call psb_geall(r,desc_A,info)
call r%zero()
@@ -242,9 +243,9 @@ program amg_dexample_ml
descsize = desc_a%sizeof()
precsize = p%sizeof()
system_size = desc_a%get_global_rows()
call psb_sum(ictxt,amatsize)
call psb_sum(ictxt,descsize)
call psb_sum(ictxt,precsize)
call psb_sum(ctxt,amatsize)
call psb_sum(ctxt,descsize)
call psb_sum(ctxt,precsize)
call P%descr(info)
@@ -272,26 +273,27 @@ program amg_dexample_ml
call psb_spfree(A, desc_A,info)
call P%free(info)
call psb_cdfree(desc_A,info)
call psb_exit(ictxt)
call psb_exit(ctxt)
stop
9999 continue
call psb_error(ictxt)
call psb_error(ctxt)
contains
!
! get parameters from standard input
!
subroutine get_parms(ictxt,choice,idim,itmax,tol)
subroutine get_parms(ctxt,choice,idim,itmax,tol)
implicit none
integer :: choice, idim, ictxt, itmax
type(psb_ctxt_type) :: ctxt
integer :: choice, idim, itmax
real(psb_dpk_) :: tol
integer :: iam, np, inp_unit
character(len=1024) :: filename
call psb_info(ictxt,iam,np)
call psb_info(ctxt,iam,np)
if (iam == psb_root_) then
if (command_argument_count()>0) then
@@ -300,7 +302,7 @@ contains
open(inp_unit,file=filename,action='read',iostat=info)
if (info /= 0) then
write(psb_err_unit,*) 'Could not open file ',filename,' for input'
call psb_abort(ictxt)
call psb_abort(ctxt)
stop
else
write(psb_err_unit,*) 'Opened file ',trim(filename),' for input'
@@ -318,10 +320,10 @@ contains
end if
end if
call psb_bcast(ictxt,choice)
call psb_bcast(ictxt,idim)
call psb_bcast(ictxt,itmax)
call psb_bcast(ictxt,tol)
call psb_bcast(ctxt,choice)
call psb_bcast(ctxt,idim)
call psb_bcast(ctxt,itmax)
call psb_bcast(ctxt,tol)
end subroutine get_parms
examples/pdegen/amg_dpde_mod.f90
+29 -28
View File
@@ -67,7 +67,7 @@ contains
! subroutine to allocate and fill in the coefficient matrix and
! the rhs.
!
subroutine amg_d_gen_pde3d(ictxt,idim,a,bv,xv,desc_a,afmt,&
subroutine amg_d_gen_pde3d(ctxt,idim,a,bv,xv,desc_a,afmt,&
& a1,a2,a3,b1,b2,b3,c,g,info,f,amold,vmold,imold,partition,nrl,iv)
use psb_base_mod
use psb_util_mod
@@ -92,7 +92,8 @@ contains
type(psb_dspmat_type) :: a
type(psb_d_vect_type) :: xv,bv
type(psb_desc_type) :: desc_a
integer(psb_ipk_) :: ictxt, info
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: info
character(len=*) :: afmt
procedure(d_func_3d), optional :: f
class(psb_d_base_sparse_mat), optional :: amold
@@ -130,7 +131,7 @@ contains
name = 'create_matrix'
call psb_erractionsave(err_act)
call psb_info(ictxt, iam, np)
call psb_info(ctxt, iam, np)
if (present(f)) then
@@ -176,12 +177,12 @@ contains
end if
nt = nr
call psb_sum(ictxt,nt)
call psb_sum(ctxt,nt)
if (nt /= m) then
write(psb_err_unit,*) iam, 'Initialization error ',nr,nt,m
info = -1
call psb_barrier(ictxt)
call psb_abort(ictxt)
call psb_barrier(ctxt)
call psb_abort(ctxt)
return
end if
@@ -189,7 +190,7 @@ contains
! First example of use of CDALL: specify for each process a number of
! contiguous rows
!
call psb_cdall(ictxt,desc_a,info,nl=nr)
call psb_cdall(ctxt,desc_a,info,nl=nr)
myidx = desc_a%get_global_indices()
nlr = size(myidx)
@@ -200,15 +201,15 @@ contains
if (size(iv) /= m) then
write(psb_err_unit,*) iam, 'Initialization error: wrong IV size',size(iv),m
info = -1
call psb_barrier(ictxt)
call psb_abort(ictxt)
call psb_barrier(ctxt)
call psb_abort(ctxt)
return
end if
else
write(psb_err_unit,*) iam, 'Initialization error: IV not present'
info = -1
call psb_barrier(ictxt)
call psb_abort(ictxt)
call psb_barrier(ctxt)
call psb_abort(ctxt)
return
end if
@@ -216,7 +217,7 @@ contains
! Second example of use of CDALL: specify for each row the
! process that owns it
!
call psb_cdall(ictxt,desc_a,info,vg=iv)
call psb_cdall(ctxt,desc_a,info,vg=iv)
myidx = desc_a%get_global_indices()
nlr = size(myidx)
@@ -258,21 +259,21 @@ contains
write(psb_err_unit,*) iam,iamx,iamy,iamz, 'Initialization error: NR vs NLR ',&
& nr,nlr,mynx,myny,mynz
info = -1
call psb_barrier(ictxt)
call psb_abort(ictxt)
call psb_barrier(ctxt)
call psb_abort(ctxt)
end if
!
! Third example of use of CDALL: specify for each process
! the set of global indices it owns.
!
call psb_cdall(ictxt,desc_a,info,vl=myidx)
call psb_cdall(ctxt,desc_a,info,vl=myidx)
case default
write(psb_err_unit,*) iam, 'Initialization error: should not get here'
info = -1
call psb_barrier(ictxt)
call psb_abort(ictxt)
call psb_barrier(ctxt)
call psb_abort(ctxt)
return
end select
@@ -282,7 +283,7 @@ contains
if (info == psb_success_) call psb_geall(xv,desc_a,info)
if (info == psb_success_) call psb_geall(bv,desc_a,info)
call psb_barrier(ictxt)
call psb_barrier(ctxt)
talc = psb_wtime()-t0
if (info /= psb_success_) then
@@ -308,7 +309,7 @@ contains
! loop over rows belonging to current process in a block
! distribution.
call psb_barrier(ictxt)
call psb_barrier(ctxt)
t1 = psb_wtime()
do ii=1, nlr,nb
ib = min(nb,nlr-ii+1)
@@ -409,11 +410,11 @@ contains
deallocate(val,irow,icol)
call psb_barrier(ictxt)
call psb_barrier(ctxt)
t1 = psb_wtime()
call psb_cdasb(desc_a,info,mold=imold)
tcdasb = psb_wtime()-t1
call psb_barrier(ictxt)
call psb_barrier(ctxt)
t1 = psb_wtime()
if (info == psb_success_) then
if (present(amold)) then
@@ -422,7 +423,7 @@ contains
call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt)
end if
end if
call psb_barrier(ictxt)
call psb_barrier(ctxt)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='asb rout.'
@@ -438,13 +439,13 @@ contains
goto 9999
end if
tasb = psb_wtime()-t1
call psb_barrier(ictxt)
call psb_barrier(ctxt)
ttot = psb_wtime() - t0
call psb_amx(ictxt,talc)
call psb_amx(ictxt,tgen)
call psb_amx(ictxt,tasb)
call psb_amx(ictxt,ttot)
call psb_amx(ctxt,talc)
call psb_amx(ctxt,tgen)
call psb_amx(ctxt,tasb)
call psb_amx(ctxt,ttot)
if(iam == psb_root_) then
tmpfmt = a%get_fmt()
write(psb_out_unit,'("The matrix has been generated and assembled in ",a3," format.")')&
@@ -459,7 +460,7 @@ contains
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
9999 call psb_error_handler(ctxt,err_act)
return
end subroutine amg_d_gen_pde3d
examples/pdegen/amg_sexample_1lev.f90
+26 -24
View File
@@ -85,7 +85,8 @@ program amg_sexample_1lev
integer :: itmax, iter, itrace, istop
! parallel environment parameters
integer :: ictxt, iam, np
type(psb_ctxt_type) :: ctxt
integer :: iam, np
! other variables
integer :: i,info,j
@@ -98,12 +99,12 @@ program amg_sexample_1lev
character(len=20) :: name, kmethod
! initialize the parallel environment
call psb_init(ictxt)
call psb_info(ictxt,iam,np)
call psb_init(ctxt)
call psb_info(ctxt,iam,np)
if (iam < 0) then
! This should not happen, but just in case
call psb_exit(ictxt)
call psb_exit(ctxt)
stop
endif
@@ -121,15 +122,15 @@ program amg_sexample_1lev
! get parameters
call get_parms(ictxt,idim,itmax,tol)
call get_parms(ctxt,idim,itmax,tol)
! allocate and fill in the coefficient matrix, rhs and initial guess
call psb_barrier(ictxt)
call psb_barrier(ctxt)
t1 = psb_wtime()
call amg_gen_pde3d(ictxt,idim,a,b,x,desc_a,afmt,&
call amg_gen_pde3d(ctxt,idim,a,b,x,desc_a,afmt,&
& a1,a2,a3,b1,b2,b3,c,g,info)
call psb_barrier(ictxt)
call psb_barrier(ctxt)
t2 = psb_wtime() - t1
if(info /= psb_success_) then
info=psb_err_from_subroutine_
@@ -142,7 +143,7 @@ program amg_sexample_1lev
! set RAS
call P%init(ictxt,'AS',info)
call P%init(ctxt,'AS',info)
! set number of overlaps
@@ -155,7 +156,7 @@ program amg_sexample_1lev
call P%build(A,desc_A,info)
tprec = psb_wtime()-t1
call psb_amx(ictxt, tprec)
call psb_amx(ctxt, tprec)
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='amg_precbld')
@@ -171,13 +172,13 @@ program amg_sexample_1lev
! solve Ax=b with preconditioned Krylov method: BiCGSTAB
kmethod = 'BiCGSTAB'
call psb_barrier(ictxt)
call psb_barrier(ctxt)
t1 = psb_wtime()
call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,itrace=1,istop=2)
t2 = psb_wtime() - t1
call psb_amx(ictxt,t2)
call psb_amx(ctxt,t2)
call psb_geall(r,desc_A,info)
call r%zero()
@@ -191,9 +192,9 @@ program amg_sexample_1lev
descsize = desc_a%sizeof()
precsize = p%sizeof()
system_size = desc_a%get_global_rows()
call psb_sum(ictxt,amatsize)
call psb_sum(ictxt,descsize)
call psb_sum(ictxt,precsize)
call psb_sum(ctxt,amatsize)
call psb_sum(ctxt,descsize)
call psb_sum(ctxt,precsize)
call P%descr(info)
@@ -221,26 +222,27 @@ program amg_sexample_1lev
call psb_spfree(A, desc_A,info)
call P%free(info)
call psb_cdfree(desc_A,info)
call psb_exit(ictxt)
call psb_exit(ctxt)
stop
9999 continue
call psb_error(ictxt)
call psb_error(ctxt)
contains
!
! get parameters from standard input
!
subroutine get_parms(ictxt,idim,itmax,tol)
subroutine get_parms(ctxt,idim,itmax,tol)
implicit none
integer :: idim, ictxt, itmax
type(psb_ctxt_type) :: ctxt
integer :: idim, itmax
real(psb_spk_) :: tol
integer :: iam, np, inp_unit
character(len=1024) :: filename
call psb_info(ictxt,iam,np)
call psb_info(ctxt,iam,np)
if (iam == psb_root_) then
if (command_argument_count()>0) then
@@ -249,7 +251,7 @@ contains
open(inp_unit,file=filename,action='read',iostat=info)
if (info /= 0) then
write(psb_err_unit,*) 'Could not open file ',filename,' for input'
call psb_abort(ictxt)
call psb_abort(ctxt)
stop
else
write(psb_err_unit,*) 'Opened file ',trim(filename),' for input'
@@ -267,9 +269,9 @@ contains
end if
end if
call psb_bcast(ictxt,idim)
call psb_bcast(ictxt,itmax)
call psb_bcast(ictxt,tol)
call psb_bcast(ctxt,idim)
call psb_bcast(ctxt,itmax)
call psb_bcast(ctxt,tol)
end subroutine get_parms
end program amg_sexample_1lev
examples/pdegen/amg_sexample_ml.f90
+30 -28
View File
@@ -103,7 +103,8 @@ program amg_sexample_ml
integer :: nlev
! parallel environment parameters
integer :: ictxt, iam, np
type(psb_ctxt_type) :: ctxt
integer :: iam, np
! other variables
integer :: choice
@@ -118,12 +119,12 @@ program amg_sexample_ml
! initialize the parallel environment
call psb_init(ictxt)
call psb_info(ictxt,iam,np)
call psb_init(ctxt)
call psb_info(ctxt,iam,np)
if (iam < 0) then
! This should not happen, but just in case
call psb_exit(ictxt)
call psb_exit(ctxt)
stop
endif
@@ -141,15 +142,15 @@ program amg_sexample_ml
! get parameters
call get_parms(ictxt,choice,idim,itmax,tol)
call get_parms(ctxt,choice,idim,itmax,tol)
! allocate and fill in the coefficient matrix, rhs and initial guess
call psb_barrier(ictxt)
call psb_barrier(ctxt)
t1 = psb_wtime()
call amg_gen_pde3d(ictxt,idim,a,b,x,desc_a,afmt,&
call amg_gen_pde3d(ctxt,idim,a,b,x,desc_a,afmt,&
& a1,a2,a3,b1,b2,b3,c,g,info)
call psb_barrier(ictxt)
call psb_barrier(ctxt)
t2 = psb_wtime() - t1
if(info /= psb_success_) then
info=psb_err_from_subroutine_
@@ -169,7 +170,7 @@ program amg_sexample_ml
! GS sweep as pre/post-smoother and UMFPACK as coarsest-level
! solver
call P%init(ictxt,'ML',info)
call P%init(ctxt,'ML',info)
kmethod = 'CG'
case(2)
@@ -178,7 +179,7 @@ program amg_sexample_ml
! ILU(0) on the blocks) as pre- and post-smoother, and 8 block-Jacobi
! sweeps (with ILU(0) on the blocks) as coarsest-level solver
call P%init(ictxt,'ML',info)
call P%init(ctxt,'ML',info)
call P%set('SMOOTHER_TYPE','BJAC',info)
call P%set('COARSE_SOLVE','BJAC',info)
call P%set('COARSE_SWEEPS',8,info)
@@ -190,7 +191,7 @@ program amg_sexample_ml
! GS sweeps as pre/post-smoother, a distributed coarsest
! matrix, and MUMPS as coarsest-level solver
call P%init(ictxt,'ML',info)
call P%init(ctxt,'ML',info)
call P%set('ML_CYCLE','WCYCLE',info)
call P%set('SMOOTHER_SWEEPS',2,info)
call P%set('COARSE_SOLVE','MUMPS',info)
@@ -199,7 +200,7 @@ program amg_sexample_ml
end select
call psb_barrier(ictxt)
call psb_barrier(ctxt)
t1 = psb_wtime()
! build the preconditioner
@@ -207,7 +208,7 @@ program amg_sexample_ml
call P%smoothers_build(A,desc_A,info)
tprec = psb_wtime()-t1
call psb_amx(ictxt, tprec)
call psb_amx(ctxt, tprec)
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='amg_precbld')
@@ -222,13 +223,13 @@ program amg_sexample_ml
! solve Ax=b with preconditioned Krylov method
call psb_barrier(ictxt)
call psb_barrier(ctxt)
t1 = psb_wtime()
call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,itrace=1,istop=2)
t2 = psb_wtime() - t1
call psb_amx(ictxt,t2)
call psb_amx(ctxt,t2)
call psb_geall(r,desc_A,info)
call r%zero()
@@ -242,9 +243,9 @@ program amg_sexample_ml
descsize = desc_a%sizeof()
precsize = p%sizeof()
system_size = desc_a%get_global_rows()
call psb_sum(ictxt,amatsize)
call psb_sum(ictxt,descsize)
call psb_sum(ictxt,precsize)
call psb_sum(ctxt,amatsize)
call psb_sum(ctxt,descsize)
call psb_sum(ctxt,precsize)
call P%descr(info)
@@ -272,26 +273,27 @@ program amg_sexample_ml
call psb_spfree(A, desc_A,info)
call P%free(info)
call psb_cdfree(desc_A,info)
call psb_exit(ictxt)
call psb_exit(ctxt)
stop
9999 continue
call psb_error(ictxt)
call psb_error(ctxt)
contains
!
! get parameters from standard input
!
subroutine get_parms(ictxt,choice,idim,itmax,tol)
subroutine get_parms(ctxt,choice,idim,itmax,tol)
implicit none
integer :: choice, idim, ictxt, itmax
type(psb_ctxt_type) :: ctxt
integer :: choice, idim, itmax
real(psb_spk_) :: tol
integer :: iam, np, inp_unit
character(len=1024) :: filename
call psb_info(ictxt,iam,np)
call psb_info(ctxt,iam,np)
if (iam == psb_root_) then
if (command_argument_count()>0) then
@@ -300,7 +302,7 @@ contains
open(inp_unit,file=filename,action='read',iostat=info)
if (info /= 0) then
write(psb_err_unit,*) 'Could not open file ',filename,' for input'
call psb_abort(ictxt)
call psb_abort(ctxt)
stop
else
write(psb_err_unit,*) 'Opened file ',trim(filename),' for input'
@@ -318,10 +320,10 @@ contains
end if
end if
call psb_bcast(ictxt,choice)
call psb_bcast(ictxt,idim)
call psb_bcast(ictxt,itmax)
call psb_bcast(ictxt,tol)
call psb_bcast(ctxt,choice)
call psb_bcast(ctxt,idim)
call psb_bcast(ctxt,itmax)
call psb_bcast(ctxt,tol)
end subroutine get_parms
examples/pdegen/amg_spde_mod.f90
+29 -28
View File
@@ -67,7 +67,7 @@ contains
! subroutine to allocate and fill in the coefficient matrix and
! the rhs.
!
subroutine amg_s_gen_pde3d(ictxt,idim,a,bv,xv,desc_a,afmt,&
subroutine amg_s_gen_pde3d(ctxt,idim,a,bv,xv,desc_a,afmt,&
& a1,a2,a3,b1,b2,b3,c,g,info,f,amold,vmold,imold,partition,nrl,iv)
use psb_base_mod
use psb_util_mod
@@ -92,7 +92,8 @@ contains
type(psb_sspmat_type) :: a
type(psb_s_vect_type) :: xv,bv
type(psb_desc_type) :: desc_a
integer(psb_ipk_) :: ictxt, info
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: info
character(len=*) :: afmt
procedure(s_func_3d), optional :: f
class(psb_s_base_sparse_mat), optional :: amold
@@ -130,7 +131,7 @@ contains
name = 'create_matrix'
call psb_erractionsave(err_act)
call psb_info(ictxt, iam, np)
call psb_info(ctxt, iam, np)
if (present(f)) then
@@ -176,12 +177,12 @@ contains
end if
nt = nr
call psb_sum(ictxt,nt)
call psb_sum(ctxt,nt)
if (nt /= m) then
write(psb_err_unit,*) iam, 'Initialization error ',nr,nt,m
info = -1
call psb_barrier(ictxt)
call psb_abort(ictxt)
call psb_barrier(ctxt)
call psb_abort(ctxt)
return
end if
@@ -189,7 +190,7 @@ contains
! First example of use of CDALL: specify for each process a number of
! contiguous rows
!
call psb_cdall(ictxt,desc_a,info,nl=nr)
call psb_cdall(ctxt,desc_a,info,nl=nr)
myidx = desc_a%get_global_indices()
nlr = size(myidx)
@@ -200,15 +201,15 @@ contains
if (size(iv) /= m) then
write(psb_err_unit,*) iam, 'Initialization error: wrong IV size',size(iv),m
info = -1
call psb_barrier(ictxt)
call psb_abort(ictxt)
call psb_barrier(ctxt)
call psb_abort(ctxt)
return
end if
else
write(psb_err_unit,*) iam, 'Initialization error: IV not present'
info = -1
call psb_barrier(ictxt)
call psb_abort(ictxt)
call psb_barrier(ctxt)
call psb_abort(ctxt)
return
end if
@@ -216,7 +217,7 @@ contains
! Second example of use of CDALL: specify for each row the
! process that owns it
!
call psb_cdall(ictxt,desc_a,info,vg=iv)
call psb_cdall(ctxt,desc_a,info,vg=iv)
myidx = desc_a%get_global_indices()
nlr = size(myidx)
@@ -258,21 +259,21 @@ contains
write(psb_err_unit,*) iam,iamx,iamy,iamz, 'Initialization error: NR vs NLR ',&
& nr,nlr,mynx,myny,mynz
info = -1
call psb_barrier(ictxt)
call psb_abort(ictxt)
call psb_barrier(ctxt)
call psb_abort(ctxt)
end if
!
! Third example of use of CDALL: specify for each process
! the set of global indices it owns.
!
call psb_cdall(ictxt,desc_a,info,vl=myidx)
call psb_cdall(ctxt,desc_a,info,vl=myidx)
case default
write(psb_err_unit,*) iam, 'Initialization error: should not get here'
info = -1
call psb_barrier(ictxt)
call psb_abort(ictxt)
call psb_barrier(ctxt)
call psb_abort(ctxt)
return
end select
@@ -282,7 +283,7 @@ contains
if (info == psb_success_) call psb_geall(xv,desc_a,info)
if (info == psb_success_) call psb_geall(bv,desc_a,info)
call psb_barrier(ictxt)
call psb_barrier(ctxt)
talc = psb_wtime()-t0
if (info /= psb_success_) then
@@ -308,7 +309,7 @@ contains
! loop over rows belonging to current process in a block
! distribution.
call psb_barrier(ictxt)
call psb_barrier(ctxt)
t1 = psb_wtime()
do ii=1, nlr,nb
ib = min(nb,nlr-ii+1)
@@ -409,11 +410,11 @@ contains
deallocate(val,irow,icol)
call psb_barrier(ictxt)
call psb_barrier(ctxt)
t1 = psb_wtime()
call psb_cdasb(desc_a,info,mold=imold)
tcdasb = psb_wtime()-t1
call psb_barrier(ictxt)
call psb_barrier(ctxt)
t1 = psb_wtime()
if (info == psb_success_) then
if (present(amold)) then
@@ -422,7 +423,7 @@ contains
call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt)
end if
end if
call psb_barrier(ictxt)
call psb_barrier(ctxt)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='asb rout.'
@@ -438,13 +439,13 @@ contains
goto 9999
end if
tasb = psb_wtime()-t1
call psb_barrier(ictxt)
call psb_barrier(ctxt)
ttot = psb_wtime() - t0
call psb_amx(ictxt,talc)
call psb_amx(ictxt,tgen)
call psb_amx(ictxt,tasb)
call psb_amx(ictxt,ttot)
call psb_amx(ctxt,talc)
call psb_amx(ctxt,tgen)
call psb_amx(ctxt,tasb)
call psb_amx(ctxt,ttot)
if(iam == psb_root_) then
tmpfmt = a%get_fmt()
write(psb_out_unit,'("The matrix has been generated and assembled in ",a3," format.")')&
@@ -459,7 +460,7 @@ contains
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
9999 call psb_error_handler(ctxt,err_act)
return
end subroutine amg_s_gen_pde3d