|
|
@ -70,6 +70,16 @@ contains
|
|
|
|
!
|
|
|
|
!
|
|
|
|
! functions parametrizing the differential equation
|
|
|
|
! functions parametrizing the differential equation
|
|
|
|
!
|
|
|
|
!
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
!
|
|
|
|
|
|
|
|
! Note: b1, b2 and b3 are the coefficients of the first
|
|
|
|
|
|
|
|
! derivative of the unknown function. The default
|
|
|
|
|
|
|
|
! we apply here is to have them zero, so that the resulting
|
|
|
|
|
|
|
|
! matrix is symmetric/hermitian and suitable for
|
|
|
|
|
|
|
|
! testing with CG and FCG.
|
|
|
|
|
|
|
|
! When testing methods for non-hermitian matrices you can
|
|
|
|
|
|
|
|
! change the B1/B2/B3 functions to e.g. done/sqrt((3*done))
|
|
|
|
|
|
|
|
!
|
|
|
|
function b1(x,y,z)
|
|
|
|
function b1(x,y,z)
|
|
|
|
use psb_base_mod, only : psb_dpk_, done, dzero
|
|
|
|
use psb_base_mod, only : psb_dpk_, done, dzero
|
|
|
|
implicit none
|
|
|
|
implicit none
|
|
|
@ -138,7 +148,7 @@ contains
|
|
|
|
! the rhs.
|
|
|
|
! the rhs.
|
|
|
|
!
|
|
|
|
!
|
|
|
|
subroutine psb_d_gen_pde3d(ctxt,idim,a,bv,xv,desc_a,afmt,info,&
|
|
|
|
subroutine psb_d_gen_pde3d(ctxt,idim,a,bv,xv,desc_a,afmt,info,&
|
|
|
|
& f,amold,vmold,imold,partition,nrl,iv)
|
|
|
|
& f,amold,vmold,imold,partition,nrl,iv,tnd)
|
|
|
|
use psb_base_mod
|
|
|
|
use psb_base_mod
|
|
|
|
use psb_util_mod
|
|
|
|
use psb_util_mod
|
|
|
|
!
|
|
|
|
!
|
|
|
@ -169,7 +179,7 @@ contains
|
|
|
|
class(psb_d_base_vect_type), optional :: vmold
|
|
|
|
class(psb_d_base_vect_type), optional :: vmold
|
|
|
|
class(psb_i_base_vect_type), optional :: imold
|
|
|
|
class(psb_i_base_vect_type), optional :: imold
|
|
|
|
integer(psb_ipk_), optional :: partition, nrl,iv(:)
|
|
|
|
integer(psb_ipk_), optional :: partition, nrl,iv(:)
|
|
|
|
|
|
|
|
logical, optional :: tnd
|
|
|
|
! Local variables.
|
|
|
|
! Local variables.
|
|
|
|
|
|
|
|
|
|
|
|
integer(psb_ipk_), parameter :: nb=20
|
|
|
|
integer(psb_ipk_), parameter :: nb=20
|
|
|
@ -198,6 +208,7 @@ contains
|
|
|
|
real(psb_dpk_) :: t0, t1, t2, t3, tasb, talc, ttot, tgen, tcdasb
|
|
|
|
real(psb_dpk_) :: t0, t1, t2, t3, tasb, talc, ttot, tgen, tcdasb
|
|
|
|
integer(psb_ipk_) :: err_act
|
|
|
|
integer(psb_ipk_) :: err_act
|
|
|
|
procedure(d_func_3d), pointer :: f_
|
|
|
|
procedure(d_func_3d), pointer :: f_
|
|
|
|
|
|
|
|
logical :: tnd_
|
|
|
|
character(len=20) :: name, ch_err,tmpfmt
|
|
|
|
character(len=20) :: name, ch_err,tmpfmt
|
|
|
|
|
|
|
|
|
|
|
|
info = psb_success_
|
|
|
|
info = psb_success_
|
|
|
@ -492,9 +503,9 @@ contains
|
|
|
|
t1 = psb_wtime()
|
|
|
|
t1 = psb_wtime()
|
|
|
|
if (info == psb_success_) then
|
|
|
|
if (info == psb_success_) then
|
|
|
|
if (present(amold)) then
|
|
|
|
if (present(amold)) then
|
|
|
|
call psb_spasb(a,desc_a,info,mold=amold)
|
|
|
|
call psb_spasb(a,desc_a,info,mold=amold,bld_and=tnd)
|
|
|
|
else
|
|
|
|
else
|
|
|
|
call psb_spasb(a,desc_a,info,afmt=afmt)
|
|
|
|
call psb_spasb(a,desc_a,info,afmt=afmt,bld_and=tnd)
|
|
|
|
end if
|
|
|
|
end if
|
|
|
|
end if
|
|
|
|
end if
|
|
|
|
call psb_barrier(ctxt)
|
|
|
|
call psb_barrier(ctxt)
|
|
|
@ -559,7 +570,7 @@ program pdgenmv
|
|
|
|
! input parameters
|
|
|
|
! input parameters
|
|
|
|
character(len=5) :: acfmt, agfmt
|
|
|
|
character(len=5) :: acfmt, agfmt
|
|
|
|
integer :: idim
|
|
|
|
integer :: idim
|
|
|
|
|
|
|
|
logical :: tnd
|
|
|
|
! miscellaneous
|
|
|
|
! miscellaneous
|
|
|
|
real(psb_dpk_), parameter :: one = 1.d0
|
|
|
|
real(psb_dpk_), parameter :: one = 1.d0
|
|
|
|
real(psb_dpk_) :: t1, t2, tprec, flops, tflops,&
|
|
|
|
real(psb_dpk_) :: t1, t2, tprec, flops, tflops,&
|
|
|
@ -646,14 +657,14 @@ program pdgenmv
|
|
|
|
!
|
|
|
|
!
|
|
|
|
! get parameters
|
|
|
|
! get parameters
|
|
|
|
!
|
|
|
|
!
|
|
|
|
call get_parms(ctxt,acfmt,agfmt,idim)
|
|
|
|
call get_parms(ctxt,acfmt,agfmt,idim,tnd)
|
|
|
|
|
|
|
|
call psb_init_timers()
|
|
|
|
!
|
|
|
|
!
|
|
|
|
! allocate and fill in the coefficient matrix and initial vectors
|
|
|
|
! allocate and fill in the coefficient matrix and initial vectors
|
|
|
|
!
|
|
|
|
!
|
|
|
|
call psb_barrier(ctxt)
|
|
|
|
call psb_barrier(ctxt)
|
|
|
|
t1 = psb_wtime()
|
|
|
|
t1 = psb_wtime()
|
|
|
|
call psb_gen_pde3d(ctxt,idim,a,bv,xv,desc_a,'CSR ',info,partition=3)
|
|
|
|
call psb_gen_pde3d(ctxt,idim,a,bv,xv,desc_a,'CSR ',info,partition=3,tnd=tnd)
|
|
|
|
call psb_barrier(ctxt)
|
|
|
|
call psb_barrier(ctxt)
|
|
|
|
t2 = psb_wtime() - t1
|
|
|
|
t2 = psb_wtime() - t1
|
|
|
|
if(info /= psb_success_) then
|
|
|
|
if(info /= psb_success_) then
|
|
|
@ -935,6 +946,7 @@ program pdgenmv
|
|
|
|
write(psb_out_unit,'("Total memory occupation for DESC_A: ",i12)')descsize
|
|
|
|
write(psb_out_unit,'("Total memory occupation for DESC_A: ",i12)')descsize
|
|
|
|
|
|
|
|
|
|
|
|
end if
|
|
|
|
end if
|
|
|
|
|
|
|
|
call psb_print_timers(ctxt)
|
|
|
|
|
|
|
|
|
|
|
|
!
|
|
|
|
!
|
|
|
|
! cleanup storage and exit
|
|
|
|
! cleanup storage and exit
|
|
|
@ -962,10 +974,11 @@ contains
|
|
|
|
!
|
|
|
|
!
|
|
|
|
! get iteration parameters from standard input
|
|
|
|
! get iteration parameters from standard input
|
|
|
|
!
|
|
|
|
!
|
|
|
|
subroutine get_parms(ctxt,acfmt,agfmt,idim)
|
|
|
|
subroutine get_parms(ctxt,acfmt,agfmt,idim,tnd)
|
|
|
|
type(psb_ctxt_type) :: ctxt
|
|
|
|
type(psb_ctxt_type) :: ctxt
|
|
|
|
character(len=*) :: agfmt, acfmt
|
|
|
|
character(len=*) :: agfmt, acfmt
|
|
|
|
integer :: idim
|
|
|
|
integer :: idim
|
|
|
|
|
|
|
|
logical :: tnd
|
|
|
|
integer :: np, iam
|
|
|
|
integer :: np, iam
|
|
|
|
integer :: intbuf(10), ip
|
|
|
|
integer :: intbuf(10), ip
|
|
|
|
|
|
|
|
|
|
|
@ -978,10 +991,13 @@ contains
|
|
|
|
read(psb_inp_unit,*) agfmt
|
|
|
|
read(psb_inp_unit,*) agfmt
|
|
|
|
write(*,*) 'Size of discretization cube?'
|
|
|
|
write(*,*) 'Size of discretization cube?'
|
|
|
|
read(psb_inp_unit,*) idim
|
|
|
|
read(psb_inp_unit,*) idim
|
|
|
|
|
|
|
|
write(*,*) 'Try comm/comp overlap?'
|
|
|
|
|
|
|
|
read(psb_inp_unit,*) tnd
|
|
|
|
endif
|
|
|
|
endif
|
|
|
|
call psb_bcast(ctxt,acfmt)
|
|
|
|
call psb_bcast(ctxt,acfmt)
|
|
|
|
call psb_bcast(ctxt,agfmt)
|
|
|
|
call psb_bcast(ctxt,agfmt)
|
|
|
|
call psb_bcast(ctxt,idim)
|
|
|
|
call psb_bcast(ctxt,idim)
|
|
|
|
|
|
|
|
call psb_bcast(ctxt,tnd)
|
|
|
|
|
|
|
|
|
|
|
|
if (iam == 0) then
|
|
|
|
if (iam == 0) then
|
|
|
|
write(psb_out_unit,'("Testing matrix : ell1")')
|
|
|
|
write(psb_out_unit,'("Testing matrix : ell1")')
|
|
|
@ -989,6 +1005,8 @@ contains
|
|
|
|
write(psb_out_unit,'("Number of processors : ",i0)')np
|
|
|
|
write(psb_out_unit,'("Number of processors : ",i0)')np
|
|
|
|
write(psb_out_unit,'("Data distribution : BLOCK")')
|
|
|
|
write(psb_out_unit,'("Data distribution : BLOCK")')
|
|
|
|
write(psb_out_unit,'(" ")')
|
|
|
|
write(psb_out_unit,'(" ")')
|
|
|
|
|
|
|
|
write(psb_out_unit,'("Storage formats ",a)') acfmt,' ',agfmt
|
|
|
|
|
|
|
|
write(psb_out_unit,'("Testing overlap ND ",l8)') tnd
|
|
|
|
end if
|
|
|
|
end if
|
|
|
|
return
|
|
|
|
return
|
|
|
|
|
|
|
|
|
|
|
|