Fix for test program

pull/4/merge
sfilippone 3 months ago
parent b6f92354d3
commit ca6fce0765

@ -46,6 +46,11 @@ amg_s_pde3d.o: amg_s_genpde_mod.o $(SGEN3D)
amg_d_pde2d.o: amg_d_genpde_mod.o $(DGEN2D)
amg_s_pde2d.o: amg_s_genpde_mod.o $(SGEN2D)
amg_d_genpde_mod.o: $(DGEN3D)
amg_s_genpde_mod.o: $(SGEN3D)
amg_d_genpde_mod.o: $(DGEN2D)
amg_s_genpde_mod.o: $(SGEN2D)
check: all
cd runs && ./amg_d_pde2d <amg_pde2d.inp && ./amg_s_pde2d<amg_pde2d.inp

@ -82,7 +82,8 @@ program amg_d_pde2d
! input parameters
character(len=20) :: kmethd, ptype
character(len=5) :: afmt, pdecoeff
character(len=5) :: afmt
character(len=32) :: pdecoeff
integer(psb_ipk_) :: idim
integer(psb_epk_) :: system_size

@ -49,7 +49,7 @@ contains
implicit none
real(psb_dpk_) :: b1_const
real(psb_dpk_), intent(in) :: x,y
b1_const = @ROONE@/1.414_psb_dpk_
b1_const = done/1.414_psb_dpk_
end function b1_const
function b2_const(x,y)
implicit none

@ -70,7 +70,8 @@ program amg_d_pde3d
use psb_krylov_mod
use psb_util_mod
use data_input
use amg_d_pde3d_base_mod
use amg_d_pde3d_poisson_mod
use amg_d_pde3d_const_mod
use amg_d_pde3d_exp_mod
use amg_d_pde3d_box_mod
use amg_d_pde3d_gauss_mod
@ -82,7 +83,8 @@ program amg_d_pde3d
! input parameters
character(len=20) :: kmethd, ptype
character(len=5) :: afmt, pdecoeff
character(len=5) :: afmt
character(len=32) :: pdecoeff
integer(psb_ipk_) :: idim
integer(psb_epk_) :: system_size
@ -254,7 +256,8 @@ program amg_d_pde3d
call amg_gen_pde3d(ctxt,idim,a,b,x,desc_a,afmt,&
& a1_poisson,a2_poisson,a3_poisson,&
& b1_poisson,b2_poisson,b3_poisson,c_poisson,g_poisson,info)
case("CONST") call amg_gen_pde3d(ctxt,idim,a,b,x,desc_a,afmt,&
case("CONST")
call amg_gen_pde3d(ctxt,idim,a,b,x,desc_a,afmt,&
& a1_const,a2_const,a3_const,&
& b1_const,b2_const,b3_const,c_const,g_const,info)
case("EXP")

@ -34,68 +34,68 @@
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
module amg_d_pde3d_base_mod
module amg_d_pde3d_const_mod
use psb_base_mod, only : psb_dpk_, done, dzero
real(psb_dpk_), save, private :: epsilon=done/80
contains
subroutine pde_set_parm3d_base(dat)
subroutine pde_set_parm3d_const(dat)
real(psb_dpk_), intent(in) :: dat
epsilon = dat
end subroutine pde_set_parm3d_base
end subroutine pde_set_parm3d_const
!
! functions parametrizing the differential equation
!
function b1_base(x,y,z)
function b1_const(x,y,z)
implicit none
real(psb_dpk_) :: b1_base
real(psb_dpk_) :: b1_const
real(psb_dpk_), intent(in) :: x,y,z
b1_base=done/sqrt(3.0_psb_dpk_)
end function b1_base
function b2_base(x,y,z)
b1_const=done/sqrt(3.0_psb_dpk_)
end function b1_const
function b2_const(x,y,z)
implicit none
real(psb_dpk_) :: b2_base
real(psb_dpk_) :: b2_const
real(psb_dpk_), intent(in) :: x,y,z
b2_base=done/sqrt(3.0_psb_dpk_)
end function b2_base
function b3_base(x,y,z)
b2_const=done/sqrt(3.0_psb_dpk_)
end function b2_const
function b3_const(x,y,z)
implicit none
real(psb_dpk_) :: b3_base
real(psb_dpk_) :: b3_const
real(psb_dpk_), intent(in) :: x,y,z
b3_base=dzero/sqrt(3.0_psb_dpk_)
end function b3_base
function c_base(x,y,z)
b3_const=dzero/sqrt(3.0_psb_dpk_)
end function b3_const
function c_const(x,y,z)
implicit none
real(psb_dpk_) :: c_base
real(psb_dpk_) :: c_const
real(psb_dpk_), intent(in) :: x,y,z
c_base=dzero
end function c_base
function a1_base(x,y,z)
c_const=dzero
end function c_const
function a1_const(x,y,z)
implicit none
real(psb_dpk_) :: a1_base
real(psb_dpk_) :: a1_const
real(psb_dpk_), intent(in) :: x,y,z
a1_base=epsilon
end function a1_base
function a2_base(x,y,z)
a1_const=epsilon
end function a1_const
function a2_const(x,y,z)
implicit none
real(psb_dpk_) :: a2_base
real(psb_dpk_) :: a2_const
real(psb_dpk_), intent(in) :: x,y,z
a2_base=epsilon
end function a2_base
function a3_base(x,y,z)
a2_const=epsilon
end function a2_const
function a3_const(x,y,z)
implicit none
real(psb_dpk_) :: a3_base
real(psb_dpk_) :: a3_const
real(psb_dpk_), intent(in) :: x,y,z
a3_base=epsilon
end function a3_base
function g_base(x,y,z)
a3_const=epsilon
end function a3_const
function g_const(x,y,z)
implicit none
real(psb_dpk_) :: g_base
real(psb_dpk_) :: g_const
real(psb_dpk_), intent(in) :: x,y,z
g_base = dzero
g_const = dzero
if (x == done) then
g_base = done
g_const = done
else if (x == dzero) then
g_base = done
g_const = done
end if
end function g_base
end module amg_d_pde3d_base_mod
end function g_const
end module amg_d_pde3d_const_mod

@ -82,7 +82,8 @@ program amg_s_pde2d
! input parameters
character(len=20) :: kmethd, ptype
character(len=5) :: afmt, pdecoeff
character(len=5) :: afmt
character(len=32) :: pdecoeff
integer(psb_ipk_) :: idim
integer(psb_epk_) :: system_size

@ -49,7 +49,7 @@ contains
implicit none
real(psb_spk_) :: b1_const
real(psb_spk_), intent(in) :: x,y
b1_const = @ROONE@/1.414_psb_spk_
b1_const = sone/1.414_psb_spk_
end function b1_const
function b2_const(x,y)
implicit none

@ -70,7 +70,8 @@ program amg_s_pde3d
use psb_krylov_mod
use psb_util_mod
use data_input
use amg_s_pde3d_base_mod
use amg_s_pde3d_poisson_mod
use amg_s_pde3d_const_mod
use amg_s_pde3d_exp_mod
use amg_s_pde3d_box_mod
use amg_s_pde3d_gauss_mod
@ -82,7 +83,8 @@ program amg_s_pde3d
! input parameters
character(len=20) :: kmethd, ptype
character(len=5) :: afmt, pdecoeff
character(len=5) :: afmt
character(len=32) :: pdecoeff
integer(psb_ipk_) :: idim
integer(psb_epk_) :: system_size
@ -254,7 +256,8 @@ program amg_s_pde3d
call amg_gen_pde3d(ctxt,idim,a,b,x,desc_a,afmt,&
& a1_poisson,a2_poisson,a3_poisson,&
& b1_poisson,b2_poisson,b3_poisson,c_poisson,g_poisson,info)
case("CONST") call amg_gen_pde3d(ctxt,idim,a,b,x,desc_a,afmt,&
case("CONST")
call amg_gen_pde3d(ctxt,idim,a,b,x,desc_a,afmt,&
& a1_const,a2_const,a3_const,&
& b1_const,b2_const,b3_const,c_const,g_const,info)
case("EXP")

@ -34,68 +34,68 @@
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
module amg_s_pde3d_base_mod
module amg_s_pde3d_const_mod
use psb_base_mod, only : psb_spk_, sone, szero
real(psb_spk_), save, private :: epsilon=sone/80
contains
subroutine pde_set_parm3d_base(dat)
subroutine pde_set_parm3d_const(dat)
real(psb_spk_), intent(in) :: dat
epsilon = dat
end subroutine pde_set_parm3d_base
end subroutine pde_set_parm3d_const
!
! functions parametrizing the differential equation
!
function b1_base(x,y,z)
function b1_const(x,y,z)
implicit none
real(psb_spk_) :: b1_base
real(psb_spk_) :: b1_const
real(psb_spk_), intent(in) :: x,y,z
b1_base=sone/sqrt(3.0_psb_spk_)
end function b1_base
function b2_base(x,y,z)
b1_const=sone/sqrt(3.0_psb_spk_)
end function b1_const
function b2_const(x,y,z)
implicit none
real(psb_spk_) :: b2_base
real(psb_spk_) :: b2_const
real(psb_spk_), intent(in) :: x,y,z
b2_base=sone/sqrt(3.0_psb_spk_)
end function b2_base
function b3_base(x,y,z)
b2_const=sone/sqrt(3.0_psb_spk_)
end function b2_const
function b3_const(x,y,z)
implicit none
real(psb_spk_) :: b3_base
real(psb_spk_) :: b3_const
real(psb_spk_), intent(in) :: x,y,z
b3_base=szero/sqrt(3.0_psb_spk_)
end function b3_base
function c_base(x,y,z)
b3_const=szero/sqrt(3.0_psb_spk_)
end function b3_const
function c_const(x,y,z)
implicit none
real(psb_spk_) :: c_base
real(psb_spk_) :: c_const
real(psb_spk_), intent(in) :: x,y,z
c_base=szero
end function c_base
function a1_base(x,y,z)
c_const=szero
end function c_const
function a1_const(x,y,z)
implicit none
real(psb_spk_) :: a1_base
real(psb_spk_) :: a1_const
real(psb_spk_), intent(in) :: x,y,z
a1_base=epsilon
end function a1_base
function a2_base(x,y,z)
a1_const=epsilon
end function a1_const
function a2_const(x,y,z)
implicit none
real(psb_spk_) :: a2_base
real(psb_spk_) :: a2_const
real(psb_spk_), intent(in) :: x,y,z
a2_base=epsilon
end function a2_base
function a3_base(x,y,z)
a2_const=epsilon
end function a2_const
function a3_const(x,y,z)
implicit none
real(psb_spk_) :: a3_base
real(psb_spk_) :: a3_const
real(psb_spk_), intent(in) :: x,y,z
a3_base=epsilon
end function a3_base
function g_base(x,y,z)
a3_const=epsilon
end function a3_const
function g_const(x,y,z)
implicit none
real(psb_spk_) :: g_base
real(psb_spk_) :: g_const
real(psb_spk_), intent(in) :: x,y,z
g_base = szero
g_const = szero
if (x == sone) then
g_base = sone
g_const = sone
else if (x == szero) then
g_base = sone
g_const = sone
end if
end function g_base
end module amg_s_pde3d_base_mod
end function g_const
end module amg_s_pde3d_const_mod

Loading…
Cancel
Save