From f409859a7da4fa279a90b9c5f8d354e9aab986d8 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Fri, 13 Apr 2018 12:15:34 +0100 Subject: [PATCH] Fixed declarations in cd_inloc. Reorganized matgen. --- base/tools/psb_cd_inloc.f90 | 8 +-- test/pargen/psb_d_pde2d.f90 | 97 ++++++++++++++-------------- test/pargen/psb_d_pde3d.f90 | 122 ++++++++++++++++++------------------ test/pargen/psb_s_pde2d.f90 | 97 ++++++++++++++-------------- test/pargen/psb_s_pde3d.f90 | 122 ++++++++++++++++++------------------ 5 files changed, 220 insertions(+), 226 deletions(-) diff --git a/base/tools/psb_cd_inloc.f90 b/base/tools/psb_cd_inloc.f90 index ce1290a9..d50090ec 100644 --- a/base/tools/psb_cd_inloc.f90 +++ b/base/tools/psb_cd_inloc.f90 @@ -183,12 +183,12 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx) novrl = 0 npr_ov = 0 norphan = 0 - do i=1, m - if (tmpgidx(i,2) < 1) then + do il=1, m + if (tmpgidx(il,2) < 1) then norphan = norphan + 1 - else if (tmpgidx(i,2) > 1) then + else if (tmpgidx(il,2) > 1) then novrl = novrl + 1 - npr_ov = npr_ov + tmpgidx(i,2) + npr_ov = npr_ov + tmpgidx(il,2) end if end do if (norphan > 0) then diff --git a/test/pargen/psb_d_pde2d.f90 b/test/pargen/psb_d_pde2d.f90 index b88fcd9f..1a9a6cfa 100644 --- a/test/pargen/psb_d_pde2d.f90 +++ b/test/pargen/psb_d_pde2d.f90 @@ -92,8 +92,8 @@ contains ! subroutine to allocate and fill in the coefficient matrix and ! the rhs. ! - subroutine psb_d_gen_pde2d(ictxt,idim,a,bv,xv,desc_a,afmt,& - & a1,a2,b1,b2,c,g,info,f,amold,vmold,imold,partition,nrl,iv) + subroutine psb_d_gen_pde2d(ictxt,idim,a,bv,xv,desc_a,afmt,info,& + & f,amold,vmold,imold,partition,nrl,iv) use psb_base_mod use psb_util_mod ! @@ -112,7 +112,6 @@ contains ! Note that if b1=b2=c=0., the PDE is the Laplace equation. ! implicit none - procedure(d_func_2d) :: b1,b2,c,a1,a2,g integer(psb_ipk_) :: idim type(psb_dspmat_type) :: a type(psb_d_vect_type) :: xv,bv @@ -466,6 +465,51 @@ contains return end subroutine psb_d_gen_pde2d + ! + ! functions parametrizing the differential equation + ! + function b1(x,y) + use psb_base_mod, only : psb_dpk_ + real(psb_dpk_) :: b1 + real(psb_dpk_), intent(in) :: x,y + b1=done/sqrt((2*done)) + end function b1 + function b2(x,y) + use psb_base_mod, only : psb_dpk_ + real(psb_dpk_) :: b2 + real(psb_dpk_), intent(in) :: x,y + b2=done/sqrt((2*done)) + end function b2 + function c(x,y) + use psb_base_mod, only : psb_dpk_ + real(psb_dpk_) :: c + real(psb_dpk_), intent(in) :: x,y + c=0.d0 + end function c + function a1(x,y) + use psb_base_mod, only : psb_dpk_ + real(psb_dpk_) :: a1 + real(psb_dpk_), intent(in) :: x,y + a1=done/80 + end function a1 + function a2(x,y) + use psb_base_mod, only : psb_dpk_ + real(psb_dpk_) :: a2 + real(psb_dpk_), intent(in) :: x,y + a2=done/80 + end function a2 + function g(x,y) + use psb_base_mod, only : psb_dpk_, done, dzero + real(psb_dpk_) :: g + real(psb_dpk_), intent(in) :: x,y + g = dzero + if (x == done) then + g = done + else if (x == dzero) then + g = exp(-y**2) + end if + end function g + end module psb_d_pde2d_mod program psb_d_pde2d @@ -536,7 +580,7 @@ program psb_d_pde2d ! call psb_barrier(ictxt) t1 = psb_wtime() - call psb_gen_pde2d(ictxt,idim,a,bv,xxv,desc_a,afmt,a1,a2,b1,b2,c,g,info) + call psb_gen_pde2d(ictxt,idim,a,bv,xxv,desc_a,afmt,info) call psb_barrier(ictxt) t2 = psb_wtime() - t1 if(info /= psb_success_) then @@ -743,51 +787,6 @@ contains write(iout,*)' >= 1 do tracing every itrace' write(iout,*)' iterations ' end subroutine pr_usage - - ! - ! functions parametrizing the differential equation - ! - function b1(x,y) - use psb_base_mod, only : psb_dpk_ - real(psb_dpk_) :: b1 - real(psb_dpk_), intent(in) :: x,y - b1=done/sqrt((2*done)) - end function b1 - function b2(x,y) - use psb_base_mod, only : psb_dpk_ - real(psb_dpk_) :: b2 - real(psb_dpk_), intent(in) :: x,y - b2=done/sqrt((2*done)) - end function b2 - function c(x,y) - use psb_base_mod, only : psb_dpk_ - real(psb_dpk_) :: c - real(psb_dpk_), intent(in) :: x,y - c=0.d0 - end function c - function a1(x,y) - use psb_base_mod, only : psb_dpk_ - real(psb_dpk_) :: a1 - real(psb_dpk_), intent(in) :: x,y - a1=done/80 - end function a1 - function a2(x,y) - use psb_base_mod, only : psb_dpk_ - real(psb_dpk_) :: a2 - real(psb_dpk_), intent(in) :: x,y - a2=done/80 - end function a2 - function g(x,y) - use psb_base_mod, only : psb_dpk_, done, dzero - real(psb_dpk_) :: g - real(psb_dpk_), intent(in) :: x,y - g = dzero - if (x == done) then - g = done - else if (x == dzero) then - g = exp(-y**2) - end if - end function g end program psb_d_pde2d diff --git a/test/pargen/psb_d_pde3d.f90 b/test/pargen/psb_d_pde3d.f90 index 8d56972d..c7ede976 100644 --- a/test/pargen/psb_d_pde3d.f90 +++ b/test/pargen/psb_d_pde3d.f90 @@ -94,8 +94,8 @@ contains ! subroutine to allocate and fill in the coefficient matrix and ! the rhs. ! - subroutine psb_d_gen_pde3d(ictxt,idim,a,bv,xv,desc_a,afmt,& - & a1,a2,a3,b1,b2,b3,c,g,info,f,amold,vmold,imold,partition,nrl,iv) + subroutine psb_d_gen_pde3d(ictxt,idim,a,bv,xv,desc_a,afmt,info,& + & f,amold,vmold,imold,partition,nrl,iv) use psb_base_mod use psb_util_mod ! @@ -114,7 +114,7 @@ contains ! Note that if b1=b2=b3=c=0., the PDE is the Laplace equation. ! implicit none - procedure(d_func_3d) :: b1,b2,b3,c,a1,a2,a3,g +! procedure(d_func_3d) :: b1,b2,b3,c,a1,a2,a3,g integer(psb_ipk_) :: idim type(psb_dspmat_type) :: a type(psb_d_vect_type) :: xv,bv @@ -491,7 +491,62 @@ contains return end subroutine psb_d_gen_pde3d - + ! + ! functions parametrizing the differential equation + ! + function b1(x,y,z) + use psb_base_mod, only : psb_dpk_ + real(psb_dpk_) :: b1 + real(psb_dpk_), intent(in) :: x,y,z + b1=done/sqrt((3*done)) + end function b1 + function b2(x,y,z) + use psb_base_mod, only : psb_dpk_ + real(psb_dpk_) :: b2 + real(psb_dpk_), intent(in) :: x,y,z + b2=done/sqrt((3*done)) + end function b2 + function b3(x,y,z) + use psb_base_mod, only : psb_dpk_ + real(psb_dpk_) :: b3 + real(psb_dpk_), intent(in) :: x,y,z + b3=done/sqrt((3*done)) + end function b3 + function c(x,y,z) + use psb_base_mod, only : psb_dpk_ + real(psb_dpk_) :: c + real(psb_dpk_), intent(in) :: x,y,z + c=dzero + end function c + function a1(x,y,z) + use psb_base_mod, only : psb_dpk_ + real(psb_dpk_) :: a1 + real(psb_dpk_), intent(in) :: x,y,z + a1=done/80 + end function a1 + function a2(x,y,z) + use psb_base_mod, only : psb_dpk_ + real(psb_dpk_) :: a2 + real(psb_dpk_), intent(in) :: x,y,z + a2=done/80 + end function a2 + function a3(x,y,z) + use psb_base_mod, only : psb_dpk_ + real(psb_dpk_) :: a3 + real(psb_dpk_), intent(in) :: x,y,z + a3=done/80 + end function a3 + function g(x,y,z) + use psb_base_mod, only : psb_dpk_, done, dzero + real(psb_dpk_) :: g + real(psb_dpk_), intent(in) :: x,y,z + g = dzero + if (x == done) then + g = done + else if (x == dzero) then + g = exp(y**2-z**2) + end if + end function g end module psb_d_pde3d_mod @@ -564,8 +619,7 @@ program psb_d_pde3d ! call psb_barrier(ictxt) t1 = psb_wtime() - call psb_gen_pde3d(ictxt,idim,a,bv,xxv,desc_a,afmt,& - & a1,a2,a3,b1,b2,b3,c,g,info) + call psb_gen_pde3d(ictxt,idim,a,bv,xxv,desc_a,afmt,info) call psb_barrier(ictxt) t2 = psb_wtime() - t1 if(info /= psb_success_) then @@ -776,62 +830,6 @@ contains write(iout,*)' >= 1 do tracing every itrace' write(iout,*)' iterations ' end subroutine pr_usage - ! - ! functions parametrizing the differential equation - ! - function b1(x,y,z) - use psb_base_mod, only : psb_dpk_ - real(psb_dpk_) :: b1 - real(psb_dpk_), intent(in) :: x,y,z - b1=done/sqrt((3*done)) - end function b1 - function b2(x,y,z) - use psb_base_mod, only : psb_dpk_ - real(psb_dpk_) :: b2 - real(psb_dpk_), intent(in) :: x,y,z - b2=done/sqrt((3*done)) - end function b2 - function b3(x,y,z) - use psb_base_mod, only : psb_dpk_ - real(psb_dpk_) :: b3 - real(psb_dpk_), intent(in) :: x,y,z - b3=done/sqrt((3*done)) - end function b3 - function c(x,y,z) - use psb_base_mod, only : psb_dpk_ - real(psb_dpk_) :: c - real(psb_dpk_), intent(in) :: x,y,z - c=dzero - end function c - function a1(x,y,z) - use psb_base_mod, only : psb_dpk_ - real(psb_dpk_) :: a1 - real(psb_dpk_), intent(in) :: x,y,z - a1=done/80 - end function a1 - function a2(x,y,z) - use psb_base_mod, only : psb_dpk_ - real(psb_dpk_) :: a2 - real(psb_dpk_), intent(in) :: x,y,z - a2=done/80 - end function a2 - function a3(x,y,z) - use psb_base_mod, only : psb_dpk_ - real(psb_dpk_) :: a3 - real(psb_dpk_), intent(in) :: x,y,z - a3=done/80 - end function a3 - function g(x,y,z) - use psb_base_mod, only : psb_dpk_, done, dzero - real(psb_dpk_) :: g - real(psb_dpk_), intent(in) :: x,y,z - g = dzero - if (x == done) then - g = done - else if (x == dzero) then - g = exp(y**2-z**2) - end if - end function g end program psb_d_pde3d diff --git a/test/pargen/psb_s_pde2d.f90 b/test/pargen/psb_s_pde2d.f90 index da28721f..71dd92f9 100644 --- a/test/pargen/psb_s_pde2d.f90 +++ b/test/pargen/psb_s_pde2d.f90 @@ -92,8 +92,8 @@ contains ! subroutine to allocate and fill in the coefficient matrix and ! the rhs. ! - subroutine psb_s_gen_pde2d(ictxt,idim,a,bv,xv,desc_a,afmt,& - & a1,a2,b1,b2,c,g,info,f,amold,vmold,imold,partition,nrl,iv) + subroutine psb_s_gen_pde2d(ictxt,idim,a,bv,xv,desc_a,afmt,info,& + & f,amold,vmold,imold,partition,nrl,iv) use psb_base_mod use psb_util_mod ! @@ -112,7 +112,6 @@ contains ! Note that if b1=b2=c=0., the PDE is the Laplace equation. ! implicit none - procedure(s_func_2d) :: b1,b2,c,a1,a2,g integer(psb_ipk_) :: idim type(psb_sspmat_type) :: a type(psb_s_vect_type) :: xv,bv @@ -466,6 +465,51 @@ contains return end subroutine psb_s_gen_pde2d + ! + ! functions parametrizing the differential equation + ! + function b1(x,y) + use psb_base_mod, only : psb_spk_ + real(psb_spk_) :: b1 + real(psb_spk_), intent(in) :: x,y + b1=sone/sqrt((2*sone)) + end function b1 + function b2(x,y) + use psb_base_mod, only : psb_spk_ + real(psb_spk_) :: b2 + real(psb_spk_), intent(in) :: x,y + b2=sone/sqrt((2*sone)) + end function b2 + function c(x,y) + use psb_base_mod, only : psb_spk_ + real(psb_spk_) :: c + real(psb_spk_), intent(in) :: x,y + c=0.d0 + end function c + function a1(x,y) + use psb_base_mod, only : psb_spk_ + real(psb_spk_) :: a1 + real(psb_spk_), intent(in) :: x,y + a1=sone/80 + end function a1 + function a2(x,y) + use psb_base_mod, only : psb_spk_ + real(psb_spk_) :: a2 + real(psb_spk_), intent(in) :: x,y + a2=sone/80 + end function a2 + function g(x,y) + use psb_base_mod, only : psb_spk_, sone, szero + real(psb_spk_) :: g + real(psb_spk_), intent(in) :: x,y + g = szero + if (x == sone) then + g = sone + else if (x == szero) then + g = exp(-y**2) + end if + end function g + end module psb_s_pde2d_mod program psb_s_pde2d @@ -536,7 +580,7 @@ program psb_s_pde2d ! call psb_barrier(ictxt) t1 = psb_wtime() - call psb_gen_pde2d(ictxt,idim,a,bv,xxv,desc_a,afmt,a1,a2,b1,b2,c,g,info) + call psb_gen_pde2d(ictxt,idim,a,bv,xxv,desc_a,afmt,info) call psb_barrier(ictxt) t2 = psb_wtime() - t1 if(info /= psb_success_) then @@ -743,51 +787,6 @@ contains write(iout,*)' >= 1 do tracing every itrace' write(iout,*)' iterations ' end subroutine pr_usage - - ! - ! functions parametrizing the differential equation - ! - function b1(x,y) - use psb_base_mod, only : psb_spk_ - real(psb_spk_) :: b1 - real(psb_spk_), intent(in) :: x,y - b1=sone/sqrt((2*sone)) - end function b1 - function b2(x,y) - use psb_base_mod, only : psb_spk_ - real(psb_spk_) :: b2 - real(psb_spk_), intent(in) :: x,y - b2=sone/sqrt((2*sone)) - end function b2 - function c(x,y) - use psb_base_mod, only : psb_spk_ - real(psb_spk_) :: c - real(psb_spk_), intent(in) :: x,y - c=0.d0 - end function c - function a1(x,y) - use psb_base_mod, only : psb_spk_ - real(psb_spk_) :: a1 - real(psb_spk_), intent(in) :: x,y - a1=sone/80 - end function a1 - function a2(x,y) - use psb_base_mod, only : psb_spk_ - real(psb_spk_) :: a2 - real(psb_spk_), intent(in) :: x,y - a2=sone/80 - end function a2 - function g(x,y) - use psb_base_mod, only : psb_spk_, sone, szero - real(psb_spk_) :: g - real(psb_spk_), intent(in) :: x,y - g = szero - if (x == sone) then - g = sone - else if (x == szero) then - g = exp(-y**2) - end if - end function g end program psb_s_pde2d diff --git a/test/pargen/psb_s_pde3d.f90 b/test/pargen/psb_s_pde3d.f90 index 09827f8b..d6570ad8 100644 --- a/test/pargen/psb_s_pde3d.f90 +++ b/test/pargen/psb_s_pde3d.f90 @@ -94,8 +94,8 @@ contains ! subroutine to allocate and fill in the coefficient matrix and ! the rhs. ! - subroutine psb_s_gen_pde3d(ictxt,idim,a,bv,xv,desc_a,afmt,& - & a1,a2,a3,b1,b2,b3,c,g,info,f,amold,vmold,imold,partition,nrl,iv) + subroutine psb_s_gen_pde3d(ictxt,idim,a,bv,xv,desc_a,afmt,info,& + & f,amold,vmold,imold,partition,nrl,iv) use psb_base_mod use psb_util_mod ! @@ -114,7 +114,7 @@ contains ! Note that if b1=b2=b3=c=0., the PDE is the Laplace equation. ! implicit none - procedure(s_func_3d) :: b1,b2,b3,c,a1,a2,a3,g +! procedure(s_func_3d) :: b1,b2,b3,c,a1,a2,a3,g integer(psb_ipk_) :: idim type(psb_sspmat_type) :: a type(psb_s_vect_type) :: xv,bv @@ -491,7 +491,62 @@ contains return end subroutine psb_s_gen_pde3d - + ! + ! functions parametrizing the differential equation + ! + function b1(x,y,z) + use psb_base_mod, only : psb_spk_ + real(psb_spk_) :: b1 + real(psb_spk_), intent(in) :: x,y,z + b1=sone/sqrt((3*sone)) + end function b1 + function b2(x,y,z) + use psb_base_mod, only : psb_spk_ + real(psb_spk_) :: b2 + real(psb_spk_), intent(in) :: x,y,z + b2=sone/sqrt((3*sone)) + end function b2 + function b3(x,y,z) + use psb_base_mod, only : psb_spk_ + real(psb_spk_) :: b3 + real(psb_spk_), intent(in) :: x,y,z + b3=sone/sqrt((3*sone)) + end function b3 + function c(x,y,z) + use psb_base_mod, only : psb_spk_ + real(psb_spk_) :: c + real(psb_spk_), intent(in) :: x,y,z + c=szero + end function c + function a1(x,y,z) + use psb_base_mod, only : psb_spk_ + real(psb_spk_) :: a1 + real(psb_spk_), intent(in) :: x,y,z + a1=sone/80 + end function a1 + function a2(x,y,z) + use psb_base_mod, only : psb_spk_ + real(psb_spk_) :: a2 + real(psb_spk_), intent(in) :: x,y,z + a2=sone/80 + end function a2 + function a3(x,y,z) + use psb_base_mod, only : psb_spk_ + real(psb_spk_) :: a3 + real(psb_spk_), intent(in) :: x,y,z + a3=sone/80 + end function a3 + function g(x,y,z) + use psb_base_mod, only : psb_spk_, sone, szero + real(psb_spk_) :: g + real(psb_spk_), intent(in) :: x,y,z + g = szero + if (x == sone) then + g = sone + else if (x == szero) then + g = exp(y**2-z**2) + end if + end function g end module psb_s_pde3d_mod @@ -564,8 +619,7 @@ program psb_s_pde3d ! call psb_barrier(ictxt) t1 = psb_wtime() - call psb_gen_pde3d(ictxt,idim,a,bv,xxv,desc_a,afmt,& - & a1,a2,a3,b1,b2,b3,c,g,info) + call psb_gen_pde3d(ictxt,idim,a,bv,xxv,desc_a,afmt,info) call psb_barrier(ictxt) t2 = psb_wtime() - t1 if(info /= psb_success_) then @@ -776,62 +830,6 @@ contains write(iout,*)' >= 1 do tracing every itrace' write(iout,*)' iterations ' end subroutine pr_usage - ! - ! functions parametrizing the differential equation - ! - function b1(x,y,z) - use psb_base_mod, only : psb_spk_ - real(psb_spk_) :: b1 - real(psb_spk_), intent(in) :: x,y,z - b1=sone/sqrt((3*sone)) - end function b1 - function b2(x,y,z) - use psb_base_mod, only : psb_spk_ - real(psb_spk_) :: b2 - real(psb_spk_), intent(in) :: x,y,z - b2=sone/sqrt((3*sone)) - end function b2 - function b3(x,y,z) - use psb_base_mod, only : psb_spk_ - real(psb_spk_) :: b3 - real(psb_spk_), intent(in) :: x,y,z - b3=sone/sqrt((3*sone)) - end function b3 - function c(x,y,z) - use psb_base_mod, only : psb_spk_ - real(psb_spk_) :: c - real(psb_spk_), intent(in) :: x,y,z - c=szero - end function c - function a1(x,y,z) - use psb_base_mod, only : psb_spk_ - real(psb_spk_) :: a1 - real(psb_spk_), intent(in) :: x,y,z - a1=sone/80 - end function a1 - function a2(x,y,z) - use psb_base_mod, only : psb_spk_ - real(psb_spk_) :: a2 - real(psb_spk_), intent(in) :: x,y,z - a2=sone/80 - end function a2 - function a3(x,y,z) - use psb_base_mod, only : psb_spk_ - real(psb_spk_) :: a3 - real(psb_spk_), intent(in) :: x,y,z - a3=sone/80 - end function a3 - function g(x,y,z) - use psb_base_mod, only : psb_spk_, sone, szero - real(psb_spk_) :: g - real(psb_spk_), intent(in) :: x,y,z - g = szero - if (x == sone) then - g = sone - else if (x == szero) then - g = exp(y**2-z**2) - end if - end function g end program psb_s_pde3d