examples/pdegen/mld_dexample_1lev.f90
 examples/pdegen/mld_dexample_ml.f90
 examples/pdegen/mld_sexample_1lev.f90
 examples/pdegen/mld_sexample_ml.f90
 tests/pdegen/ppde.f90
 tests/pdegen/spde.f90

Clean matrix generation code for pdegen examples.
stopcriterion
Salvatore Filippone 17 years ago
parent 8782eb20df
commit f25cb7fb4d

@ -296,10 +296,8 @@ contains
integer :: x,y,z,ia,indx_owner integer :: x,y,z,ia,indx_owner
integer :: np, iam integer :: np, iam
integer :: element integer :: element
integer :: nv, inv
integer, allocatable :: irow(:),icol(:) integer, allocatable :: irow(:),icol(:)
real(psb_dpk_), allocatable :: val(:) real(psb_dpk_), allocatable :: val(:)
integer, allocatable :: prv(:)
! deltah dimension of each grid cell ! deltah dimension of each grid cell
! deltat discretization time ! deltat discretization time
real(psb_dpk_) :: deltah real(psb_dpk_) :: deltah
@ -329,10 +327,10 @@ contains
if(iam == psb_root_) write(0,'("Generating Matrix (size=",i0x,")...")')n if(iam == psb_root_) write(0,'("Generating Matrix (size=",i0x,")...")')n
call psb_cdall(ictxt,desc_a,info,mg=n,parts=parts) call psb_cdall(ictxt,desc_a,info,mg=n,parts=parts)
call psb_spall(a,desc_a,info,nnz=nnz) if (info == 0) call psb_spall(a,desc_a,info,nnz=nnz)
! define rhs from boundary conditions; also build initial guess ! define rhs from boundary conditions; also build initial guess
call psb_geall(b,desc_a,info) if (info == 0) call psb_geall(b,desc_a,info)
call psb_geall(xv,desc_a,info) if (info == 0) call psb_geall(xv,desc_a,info)
if (info /= 0) then if (info /= 0) then
info=4010 info=4010
call psb_errpush(info,name) call psb_errpush(info,name)
@ -344,7 +342,7 @@ contains
! a bunch of rows per call. ! a bunch of rows per call.
! !
allocate(val(20*nbmax),irow(20*nbmax),& allocate(val(20*nbmax),irow(20*nbmax),&
&icol(20*nbmax),prv(np),stat=info) &icol(20*nbmax),stat=info)
if (info /= 0 ) then if (info /= 0 ) then
info=4000 info=4000
call psb_errpush(info,name) call psb_errpush(info,name)
@ -359,10 +357,8 @@ contains
! distribution. ! distribution.
do glob_row = 1, n do glob_row = 1, n
call parts(glob_row,n,np,prv,nv) ! Figure out which rows are local to the current process:
do inv = 1, nv if (psb_is_owned(glob_row,desc_a)) then
indx_owner = prv(inv)
if (indx_owner == iam) then
! local matrix pointer ! local matrix pointer
element=1 element=1
! compute gridpoint coordinates ! compute gridpoint coordinates
@ -496,7 +492,6 @@ contains
if(info /= 0) exit if(info /= 0) exit
end if end if
end do end do
end do
call psb_barrier(ictxt) call psb_barrier(ictxt)
t2 = psb_wtime()-t1 t2 = psb_wtime()-t1
@ -525,7 +520,7 @@ contains
call psb_amx(ictxt,tasb) call psb_amx(ictxt,tasb)
if(iam == psb_root_) then if(iam == psb_root_) then
write(*,'("The matrix has been generated and assembeld in ",a3," format.")')& write(*,'("The matrix has been generated and assembled in ",a3," format.")')&
& a%fida(1:3) & a%fida(1:3)
write(*,'("-pspins time : ",es10.4)')tins write(*,'("-pspins time : ",es10.4)')tins
write(*,'("-insert time : ",es10.4)')t2 write(*,'("-insert time : ",es10.4)')t2

@ -334,10 +334,8 @@ contains
integer :: x,y,z,ia,indx_owner integer :: x,y,z,ia,indx_owner
integer :: np, iam integer :: np, iam
integer :: element integer :: element
integer :: nv, inv
integer, allocatable :: irow(:),icol(:) integer, allocatable :: irow(:),icol(:)
real(psb_dpk_), allocatable :: val(:) real(psb_dpk_), allocatable :: val(:)
integer, allocatable :: prv(:)
! deltah dimension of each grid cell ! deltah dimension of each grid cell
! deltat discretization time ! deltat discretization time
real(psb_dpk_) :: deltah real(psb_dpk_) :: deltah
@ -367,10 +365,10 @@ contains
if(iam == psb_root_) write(0,'("Generating Matrix (size=",i0x,")...")')n if(iam == psb_root_) write(0,'("Generating Matrix (size=",i0x,")...")')n
call psb_cdall(ictxt,desc_a,info,mg=n,parts=parts) call psb_cdall(ictxt,desc_a,info,mg=n,parts=parts)
call psb_spall(a,desc_a,info,nnz=nnz) if (info == 0) call psb_spall(a,desc_a,info,nnz=nnz)
! define rhs from boundary conditions; also build initial guess ! define rhs from boundary conditions; also build initial guess
call psb_geall(b,desc_a,info) if (info == 0) call psb_geall(b,desc_a,info)
call psb_geall(xv,desc_a,info) if (info == 0) call psb_geall(xv,desc_a,info)
if (info /= 0) then if (info /= 0) then
info=4010 info=4010
call psb_errpush(info,name) call psb_errpush(info,name)
@ -382,7 +380,7 @@ contains
! a bunch of rows per call. ! a bunch of rows per call.
! !
allocate(val(20*nbmax),irow(20*nbmax),& allocate(val(20*nbmax),irow(20*nbmax),&
&icol(20*nbmax),prv(np),stat=info) &icol(20*nbmax),stat=info)
if (info /= 0 ) then if (info /= 0 ) then
info=4000 info=4000
call psb_errpush(info,name) call psb_errpush(info,name)
@ -397,10 +395,8 @@ contains
! distribution. ! distribution.
do glob_row = 1, n do glob_row = 1, n
call parts(glob_row,n,np,prv,nv) ! Figure out which rows are local to the current process:
do inv = 1, nv if (psb_is_owned(glob_row,desc_a)) then
indx_owner = prv(inv)
if (indx_owner == iam) then
! local matrix pointer ! local matrix pointer
element=1 element=1
! compute gridpoint coordinates ! compute gridpoint coordinates
@ -534,7 +530,6 @@ contains
if(info /= 0) exit if(info /= 0) exit
end if end if
end do end do
end do
call psb_barrier(ictxt) call psb_barrier(ictxt)
t2 = psb_wtime()-t1 t2 = psb_wtime()-t1
@ -563,7 +558,7 @@ contains
call psb_amx(ictxt,tasb) call psb_amx(ictxt,tasb)
if(iam == psb_root_) then if(iam == psb_root_) then
write(*,'("The matrix has been generated and assembeld in ",a3," format.")')& write(*,'("The matrix has been generated and assembled in ",a3," format.")')&
& a%fida(1:3) & a%fida(1:3)
write(*,'("-pspins time : ",es10.4)')tins write(*,'("-pspins time : ",es10.4)')tins
write(*,'("-insert time : ",es10.4)')t2 write(*,'("-insert time : ",es10.4)')t2

@ -300,7 +300,6 @@ contains
integer :: nv, inv integer :: nv, inv
integer, allocatable :: irow(:),icol(:) integer, allocatable :: irow(:),icol(:)
real(psb_spk_), allocatable :: val(:) real(psb_spk_), allocatable :: val(:)
integer, allocatable :: prv(:)
! deltah dimension of each grid cell ! deltah dimension of each grid cell
! deltat discretization time ! deltat discretization time
real(psb_spk_) :: deltah real(psb_spk_) :: deltah
@ -330,10 +329,10 @@ contains
if(iam == psb_root_) write(0,'("Generating Matrix (size=",i0x,")...")')n if(iam == psb_root_) write(0,'("Generating Matrix (size=",i0x,")...")')n
call psb_cdall(ictxt,desc_a,info,mg=n,parts=parts) call psb_cdall(ictxt,desc_a,info,mg=n,parts=parts)
call psb_spall(a,desc_a,info,nnz=nnz) if (info == 0) call psb_spall(a,desc_a,info,nnz=nnz)
! define rhs from boundary conditions; also build initial guess ! define rhs from boundary conditions; also build initial guess
call psb_geall(b,desc_a,info) if (info == 0) call psb_geall(b,desc_a,info)
call psb_geall(xv,desc_a,info) if (info == 0) call psb_geall(xv,desc_a,info)
if (info /= 0) then if (info /= 0) then
info=4010 info=4010
call psb_errpush(info,name) call psb_errpush(info,name)
@ -345,7 +344,7 @@ contains
! a bunch of rows per call. ! a bunch of rows per call.
! !
allocate(val(20*nbmax),irow(20*nbmax),& allocate(val(20*nbmax),irow(20*nbmax),&
&icol(20*nbmax),prv(np),stat=info) &icol(20*nbmax),stat=info)
if (info /= 0 ) then if (info /= 0 ) then
info=4000 info=4000
call psb_errpush(info,name) call psb_errpush(info,name)
@ -360,10 +359,8 @@ contains
! distribution. ! distribution.
do glob_row = 1, n do glob_row = 1, n
call parts(glob_row,n,np,prv,nv) ! Figure out which rows are local to the current process:
do inv = 1, nv if (psb_is_owned(glob_row,desc_a)) then
indx_owner = prv(inv)
if (indx_owner == iam) then
! local matrix pointer ! local matrix pointer
element=1 element=1
! compute gridpoint coordinates ! compute gridpoint coordinates
@ -497,7 +494,6 @@ contains
if(info /= 0) exit if(info /= 0) exit
end if end if
end do end do
end do
call psb_barrier(ictxt) call psb_barrier(ictxt)
t2 = psb_wtime()-t1 t2 = psb_wtime()-t1
@ -526,7 +522,7 @@ contains
call psb_amx(ictxt,tasb) call psb_amx(ictxt,tasb)
if(iam == psb_root_) then if(iam == psb_root_) then
write(*,'("The matrix has been generated and assembeld in ",a3," format.")')& write(*,'("The matrix has been generated and assembled in ",a3," format.")')&
& a%fida(1:3) & a%fida(1:3)
write(*,'("-pspins time : ",es10.4)')tins write(*,'("-pspins time : ",es10.4)')tins
write(*,'("-insert time : ",es10.4)')t2 write(*,'("-insert time : ",es10.4)')t2

@ -338,7 +338,6 @@ contains
integer :: nv, inv integer :: nv, inv
integer, allocatable :: irow(:),icol(:) integer, allocatable :: irow(:),icol(:)
real(psb_spk_), allocatable :: val(:) real(psb_spk_), allocatable :: val(:)
integer, allocatable :: prv(:)
! deltah dimension of each grid cell ! deltah dimension of each grid cell
! deltat discretization time ! deltat discretization time
real(psb_spk_) :: deltah real(psb_spk_) :: deltah
@ -368,10 +367,10 @@ contains
if(iam == psb_root_) write(0,'("Generating Matrix (size=",i0x,")...")')n if(iam == psb_root_) write(0,'("Generating Matrix (size=",i0x,")...")')n
call psb_cdall(ictxt,desc_a,info,mg=n,parts=parts) call psb_cdall(ictxt,desc_a,info,mg=n,parts=parts)
call psb_spall(a,desc_a,info,nnz=nnz) if (info == 0) call psb_spall(a,desc_a,info,nnz=nnz)
! define rhs from boundary conditions; also build initial guess ! define rhs from boundary conditions; also build initial guess
call psb_geall(b,desc_a,info) if (info == 0) call psb_geall(b,desc_a,info)
call psb_geall(xv,desc_a,info) if (info == 0) call psb_geall(xv,desc_a,info)
if (info /= 0) then if (info /= 0) then
info=4010 info=4010
call psb_errpush(info,name) call psb_errpush(info,name)
@ -383,7 +382,7 @@ contains
! a bunch of rows per call. ! a bunch of rows per call.
! !
allocate(val(20*nbmax),irow(20*nbmax),& allocate(val(20*nbmax),irow(20*nbmax),&
&icol(20*nbmax),prv(np),stat=info) &icol(20*nbmax),stat=info)
if (info /= 0 ) then if (info /= 0 ) then
info=4000 info=4000
call psb_errpush(info,name) call psb_errpush(info,name)
@ -398,10 +397,8 @@ contains
! distribution. ! distribution.
do glob_row = 1, n do glob_row = 1, n
call parts(glob_row,n,np,prv,nv) ! Figure out which rows are local to the current process:
do inv = 1, nv if (psb_is_owned(glob_row,desc_a)) then
indx_owner = prv(inv)
if (indx_owner == iam) then
! local matrix pointer ! local matrix pointer
element=1 element=1
! compute gridpoint coordinates ! compute gridpoint coordinates
@ -535,7 +532,6 @@ contains
if(info /= 0) exit if(info /= 0) exit
end if end if
end do end do
end do
call psb_barrier(ictxt) call psb_barrier(ictxt)
t2 = psb_wtime()-t1 t2 = psb_wtime()-t1
@ -564,7 +560,7 @@ contains
call psb_amx(ictxt,tasb) call psb_amx(ictxt,tasb)
if(iam == psb_root_) then if(iam == psb_root_) then
write(*,'("The matrix has been generated and assembeld in ",a3," format.")')& write(*,'("The matrix has been generated and assembled in ",a3," format.")')&
& a%fida(1:3) & a%fida(1:3)
write(*,'("-pspins time : ",es10.4)')tins write(*,'("-pspins time : ",es10.4)')tins
write(*,'("-insert time : ",es10.4)')t2 write(*,'("-insert time : ",es10.4)')t2

@ -1,4 +1,5 @@
!!$ !!$
!!$
!!$ MLD2P4 version 1.0 !!$ MLD2P4 version 1.0
!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package !!$ MultiLevel Domain Decomposition Parallel Preconditioners Package
!!$ based on PSBLAS (Parallel Sparse BLAS version 2.2) !!$ based on PSBLAS (Parallel Sparse BLAS version 2.2)
@ -18,14 +19,14 @@
!!$ 2. Redistributions in binary form must reproduce the above copyright !!$ 2. Redistributions in binary form must reproduce the above copyright
!!$ notice, this list of conditions, and the following disclaimer in the !!$ notice, this list of conditions, and the following disclaimer in the
!!$ documentation and/or other materials provided with the distribution. !!$ documentation and/or other materials provided with the distribution.
!!$ 3. The name of the PSBLAS group or the names of its contributors may !!$ 3. The name of the MLD2P4 group or the names of its contributors may
!!$ not be used to endorse or promote products derived from this !!$ not be used to endorse or promote products derived from this
!!$ software without specific written permission. !!$ software without specific written permission.
!!$ !!$
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS !!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED !!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR !!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS !!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR !!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF !!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS !!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
@ -265,7 +266,7 @@ program ppde
contains contains
! !
! get iteration parameters from the command line ! get iteration parameters from standard input
! !
subroutine get_parms(ictxt,kmethd,prectype,afmt,idim,istopc,itmax,itrace,irst) subroutine get_parms(ictxt,kmethd,prectype,afmt,idim,istopc,itmax,itrace,irst)
integer :: ictxt integer :: ictxt
@ -389,14 +390,15 @@ contains
! - ------ - ------ - ------ - ----- - ------ - ------ + a4 u ! - ------ - ------ - ------ - ----- - ------ - ------ + a4 u
! dxdx dydy dzdz dx dy dz ! dxdx dydy dzdz dx dy dz
! !
! = 0 ! with Dirichlet boundary conditions, on the unit cube 0<=x,y,z<=1.
! !
! boundary condition: dirichlet ! Boundary conditions are set in a very simple way, by adding
! 0< x,y,z<1 ! equations of the form
!
! u(x,y) = exp(-x^2-y^2-z^2)
!
! Note that if a1=a2=a3=a4=0., the PDE is the well-known Laplace equation.
! !
! u(x,y,z)(2b1+2b2+2b3+a1+a2+a3)+u(x-1,y,z)(-b1-a1)+u(x,y-1,z)(-b2-a2)+
! + u(x,y,z-1)(-b3-a3)-u(x+1,y,z)b1-u(x,y+1,z)b2-u(x,y,z+1)b3
use psb_base_mod use psb_base_mod
implicit none implicit none
integer :: idim integer :: idim
@ -422,7 +424,6 @@ contains
integer :: element integer :: element
integer, allocatable :: irow(:),icol(:) integer, allocatable :: irow(:),icol(:)
real(psb_dpk_), allocatable :: val(:) real(psb_dpk_), allocatable :: val(:)
integer, allocatable :: prv(:)
! deltah dimension of each grid cell ! deltah dimension of each grid cell
! deltat discretization time ! deltat discretization time
real(psb_dpk_) :: deltah real(psb_dpk_) :: deltah

@ -1,4 +1,5 @@
!!$ !!$
!!$
!!$ MLD2P4 version 1.0 !!$ MLD2P4 version 1.0
!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package !!$ MultiLevel Domain Decomposition Parallel Preconditioners Package
!!$ based on PSBLAS (Parallel Sparse BLAS version 2.2) !!$ based on PSBLAS (Parallel Sparse BLAS version 2.2)
@ -18,14 +19,14 @@
!!$ 2. Redistributions in binary form must reproduce the above copyright !!$ 2. Redistributions in binary form must reproduce the above copyright
!!$ notice, this list of conditions, and the following disclaimer in the !!$ notice, this list of conditions, and the following disclaimer in the
!!$ documentation and/or other materials provided with the distribution. !!$ documentation and/or other materials provided with the distribution.
!!$ 3. The name of the PSBLAS group or the names of its contributors may !!$ 3. The name of the MLD2P4 group or the names of its contributors may
!!$ not be used to endorse or promote products derived from this !!$ not be used to endorse or promote products derived from this
!!$ software without specific written permission. !!$ software without specific written permission.
!!$ !!$
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS !!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED !!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR !!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS !!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR !!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF !!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS !!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
@ -265,7 +266,7 @@ program spde
contains contains
! !
! get iteration parameters from the command line ! get iteration parameters from standard input
! !
subroutine get_parms(ictxt,kmethd,prectype,afmt,idim,istopc,itmax,itrace,irst) subroutine get_parms(ictxt,kmethd,prectype,afmt,idim,istopc,itmax,itrace,irst)
integer :: ictxt integer :: ictxt
@ -389,14 +390,15 @@ contains
! - ------ - ------ - ------ - ----- - ------ - ------ + a4 u ! - ------ - ------ - ------ - ----- - ------ - ------ + a4 u
! dxdx dydy dzdz dx dy dz ! dxdx dydy dzdz dx dy dz
! !
! = 0 ! with Dirichlet boundary conditions, on the unit cube 0<=x,y,z<=1.
! !
! boundary condition: dirichlet ! Boundary conditions are set in a very simple way, by adding
! 0< x,y,z<1 ! equations of the form
!
! u(x,y) = exp(-x^2-y^2-z^2)
!
! Note that if a1=a2=a3=a4=0., the PDE is the well-known Laplace equation.
! !
! u(x,y,z)(2b1+2b2+2b3+a1+a2+a3)+u(x-1,y,z)(-b1-a1)+u(x,y-1,z)(-b2-a2)+
! + u(x,y,z-1)(-b3-a3)-u(x+1,y,z)b1-u(x,y+1,z)b2-u(x,y,z+1)b3
use psb_base_mod use psb_base_mod
implicit none implicit none
integer :: idim integer :: idim
@ -422,7 +424,6 @@ contains
integer :: element integer :: element
integer, allocatable :: irow(:),icol(:) integer, allocatable :: irow(:),icol(:)
real(psb_spk_), allocatable :: val(:) real(psb_spk_), allocatable :: val(:)
integer, allocatable :: prv(:)
! deltah dimension of each grid cell ! deltah dimension of each grid cell
! deltat discretization time ! deltat discretization time
real(psb_spk_) :: deltah real(psb_spk_) :: deltah

Loading…
Cancel
Save