Merge branch 'development' into ExperimentMixed

samples/advanced/MixedPrec/Makefile

@@ -0,0 +1,72 @@
+AMGDIR=../../..
+AMGINCDIR=$(AMGDIR)/include
+include $(AMGINCDIR)/Make.inc.amg4psblas
+AMGMODDIR=$(AMGDIR)/modules
+AMGLIBDIR=$(AMGDIR)/lib
+AMG_LIBS=-L$(AMGLIBDIR) -lpsb_linsolve -lamg_prec -lpsb_prec -lpsb_ext
+FINCLUDES=$(FMFLAG). $(FMFLAG)$(AMGMODDIR) $(FMFLAG)$(AMGINCDIR) $(PSBLAS_INCLUDES) $(FIFLAG).
+
+LINKOPT=
+EXEDIR=./runs
+
+PSBMIXED=psb_mixed_support_mod.o
+
+DGEN2D=amg_d_pde2d_poisson_mod.o amg_d_pde2d_exp_mod.o \
+  amg_d_pde2d_gauss_mod.o amg_d_pde2d_box_mod.o
+DGEN3D=amg_d_pde3d_poisson_mod.o amg_d_pde3d_exp_mod.o \
+  amg_d_pde3d_gauss_mod.o amg_d_pde3d_box_mod.o 	
+SGEN2D=amg_s_pde2d_poisson_mod.o amg_s_pde2d_exp_mod.o \
+  amg_s_pde2d_gauss_mod.o amg_s_pde2d_box_mod.o
+SGEN3D=amg_s_pde3d_poisson_mod.o amg_s_pde3d_exp_mod.o \
+  amg_s_pde3d_gauss_mod.o amg_s_pde3d_box_mod.o 	
+
+all: dir amg_d_pde3d 
+
+dir:
+	(if test ! -d $(EXEDIR); then mkdir $(EXEDIR); fi)
+
+amg_d_pde3d: amg_d_pde3d.o amg_d_genpde_mod.o $(DGEN3D) $(PSBMIXED) data_input.o
+	$(FLINK) $(LINKOPT) amg_d_pde3d.o  amg_d_genpde_mod.o $(DGEN3D) $(PSBMIXED) data_input.o \
+         -o amg_d_pde3d $(AMG_LIBS) $(PSBLAS_LIBS) $(AMG_LDLIBS) $(LDLIBS)
+	/bin/mv amg_d_pde3d $(EXEDIR)
+
+amg_s_pde3d: amg_s_pde3d.o amg_s_genpde_mod.o $(SGEN3D) data_input.o
+	$(FLINK) $(LINKOPT) amg_s_pde3d.o  amg_s_genpde_mod.o  $(SGEN3D) data_input.o \
+         -o amg_s_pde3d $(AMG_LIBS) $(PSBLAS_LIBS) $(LDLIBS)
+	/bin/mv amg_s_pde3d $(EXEDIR)
+
+amg_d_pde2d: amg_d_pde2d.o amg_d_genpde_mod.o  $(DGEN2D) data_input.o
+	$(FLINK) $(LINKOPT) amg_d_pde2d.o amg_d_genpde_mod.o $(DGEN2D) data_input.o \
+         -o amg_d_pde2d $(AMG_LIBS) $(PSBLAS_LIBS) $(LDLIBS)
+	/bin/mv amg_d_pde2d $(EXEDIR)
+
+amg_s_pde2d: amg_s_pde2d.o amg_s_genpde_mod.o $(SGEN2D) data_input.o
+	$(FLINK) $(LINKOPT) amg_s_pde2d.o amg_s_genpde_mod.o $(SGEN2D) data_input.o \
+          -o amg_s_pde2d $(AMG_LIBS) $(PSBLAS_LIBS) $(LDLIBS)
+	/bin/mv amg_s_pde2d $(EXEDIR)
+
+
+amg_d_pde3d.o amg_s_pde3d.o amg_d_pde2d.o amg_s_pde2d.o: data_input.o
+
+amg_d_pde3d.o: amg_d_genpde_mod.o $(DGEN3D) $(PSBMIXED)
+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
+
+
+clean:
+	/bin/rm -f data_input.o *.o *$(.mod)\
+        $(EXEDIR)/amg_d_pde3d  $(EXEDIR)/amg_s_pde3d $(EXEDIR)/amg_d_pde2d  $(EXEDIR)/amg_s_pde2d
+
+verycleanlib:
+	(cd ../..; make veryclean)
+lib:
+	(cd ../../; make library)

samples/advanced/MixedPrec/amg_d_pde2d_box_mod.f90

@@ -0,0 +1,89 @@
+!
+!
+!                             AMG4PSBLAS version 1.0
+!    Algebraic Multigrid Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!
+!    (C) Copyright 2021
+!
+!        Salvatore Filippone
+!        Pasqua D'Ambra
+!        Fabio Durastante
+!
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the AMG4PSBLAS group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific prior written permission.
+!
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!
+module amg_d_pde2d_box_mod
+  use psb_base_mod, only : psb_dpk_, dzero, done
+  real(psb_dpk_), save, private :: epsilon=done/80
+contains
+  subroutine pde_set_parm2d_box(dat)
+    real(psb_dpk_), intent(in) :: dat
+    epsilon = dat
+  end subroutine pde_set_parm2d_box
+  !
+  ! functions parametrizing the differential equation
+  !
+  function b1_box(x,y)
+    implicit none 
+    real(psb_dpk_) :: b1_box
+    real(psb_dpk_), intent(in) :: x,y
+    b1_box = done/1.414_psb_dpk_
+  end function b1_box
+  function b2_box(x,y)
+    implicit none 
+    real(psb_dpk_) ::  b2_box
+    real(psb_dpk_), intent(in) :: x,y
+    b2_box = done/1.414_psb_dpk_
+  end function b2_box
+  function c_box(x,y)
+    implicit none 
+    real(psb_dpk_) ::  c_box
+    real(psb_dpk_), intent(in) :: x,y
+    c_box = dzero
+  end function c_box
+  function a1_box(x,y)
+    implicit none 
+    real(psb_dpk_) ::  a1_box
+    real(psb_dpk_), intent(in) :: x,y
+    a1_box=done*epsilon
+  end function a1_box
+  function a2_box(x,y)
+    implicit none 
+    real(psb_dpk_) ::  a2_box
+    real(psb_dpk_), intent(in) :: x,y
+    a2_box=done*epsilon
+  end function a2_box
+  function g_box(x,y)
+    implicit none 
+    real(psb_dpk_) ::  g_box
+    real(psb_dpk_), intent(in) :: x,y
+    g_box = dzero
+    if (x == done) then
+      g_box = done
+    else if (x == dzero) then
+      g_box = done
+    end if
+  end function g_box
+end module amg_d_pde2d_box_mod

samples/advanced/MixedPrec/amg_d_pde2d_exp_mod.f90

@@ -0,0 +1,89 @@
+!
+!
+!                             AMG4PSBLAS version 1.0
+!    Algebraic Multigrid Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!
+!    (C) Copyright 2021
+!
+!        Salvatore Filippone
+!        Pasqua D'Ambra
+!        Fabio Durastante
+!
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the AMG4PSBLAS group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific prior written permission.
+!
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!
+module amg_d_pde2d_exp_mod
+  use psb_base_mod, only : psb_dpk_, done, dzero
+  real(psb_dpk_), save, private :: epsilon=done/80
+contains
+  subroutine pde_set_parm2d_exp(dat)
+    real(psb_dpk_), intent(in) :: dat
+    epsilon = dat
+  end subroutine pde_set_parm2d_exp
+  !
+  ! functions parametrizing the differential equation
+  !
+  function b1_exp(x,y)
+    implicit none 
+    real(psb_dpk_) :: b1_exp
+    real(psb_dpk_), intent(in) :: x,y
+    b1_exp = dzero
+  end function b1_exp
+  function b2_exp(x,y)
+    implicit none 
+    real(psb_dpk_) ::  b2_exp
+    real(psb_dpk_), intent(in) :: x,y
+    b2_exp = dzero
+  end function b2_exp
+  function c_exp(x,y)
+    implicit none 
+    real(psb_dpk_) ::  c_exp
+    real(psb_dpk_), intent(in) :: x,y
+    c_exp = dzero
+  end function c_exp
+  function a1_exp(x,y)
+    implicit none 
+    real(psb_dpk_) ::  a1_exp
+    real(psb_dpk_), intent(in) :: x,y
+    a1_exp=done*epsilon*exp(-(x+y))
+  end function a1_exp
+  function a2_exp(x,y)
+    implicit none 
+    real(psb_dpk_) ::  a2_exp
+    real(psb_dpk_), intent(in) :: x,y
+    a2_exp=done*epsilon*exp(-(x+y))
+  end function a2_exp
+  function g_exp(x,y)
+    implicit none 
+    real(psb_dpk_) ::  g_exp
+    real(psb_dpk_), intent(in) :: x,y
+    g_exp = dzero
+    if (x == done) then
+      g_exp = done
+    else if (x == dzero) then
+      g_exp = done
+    end if
+  end function g_exp
+end module amg_d_pde2d_exp_mod

samples/advanced/MixedPrec/amg_d_pde2d_gauss_mod.f90

@@ -0,0 +1,89 @@
+!
+!
+!                             AMG4PSBLAS version 1.0
+!    Algebraic Multigrid Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!
+!    (C) Copyright 2021
+!
+!        Salvatore Filippone
+!        Pasqua D'Ambra
+!        Fabio Durastante
+!
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the AMG4PSBLAS group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific prior written permission.
+!
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!
+module amg_d_pde2d_gauss_mod
+  use psb_base_mod, only : psb_dpk_, done, dzero
+  real(psb_dpk_), save, private :: epsilon=done/80
+contains
+  subroutine pde_set_parm2d_gauss(dat)
+    real(psb_dpk_), intent(in) :: dat
+    epsilon = dat
+  end subroutine pde_set_parm2d_gauss
+  !
+  ! functions parametrizing the differential equation
+  !
+  function b1_gauss(x,y)
+    implicit none 
+    real(psb_dpk_) :: b1_gauss
+    real(psb_dpk_), intent(in) :: x,y
+    b1_gauss=done/sqrt(3.0_psb_dpk_)-2*x*exp(-(x**2+y**2))
+  end function b1_gauss
+  function b2_gauss(x,y)
+    implicit none 
+    real(psb_dpk_) ::  b2_gauss
+    real(psb_dpk_), intent(in) :: x,y
+    b2_gauss=done/sqrt(3.0_psb_dpk_)-2*y*exp(-(x**2+y**2))
+  end function b2_gauss
+  function c_gauss(x,y)
+    implicit none 
+    real(psb_dpk_) ::  c_gauss
+    real(psb_dpk_), intent(in) :: x,y
+    c_gauss=dzero
+  end function c_gauss
+  function a1_gauss(x,y)
+    implicit none 
+    real(psb_dpk_) ::  a1_gauss
+    real(psb_dpk_), intent(in) :: x,y
+    a1_gauss=epsilon*exp(-(x**2+y**2))
+  end function a1_gauss
+  function a2_gauss(x,y)
+    implicit none 
+    real(psb_dpk_) ::  a2_gauss
+    real(psb_dpk_), intent(in) :: x,y
+    a2_gauss=epsilon*exp(-(x**2+y**2))
+  end function a2_gauss
+  function g_gauss(x,y)
+    implicit none 
+    real(psb_dpk_) ::  g_gauss
+    real(psb_dpk_), intent(in) :: x,y
+    g_gauss = dzero
+    if (x == done) then
+      g_gauss = done
+    else if (x == dzero) then
+      g_gauss = done
+    end if
+  end function g_gauss
+end module amg_d_pde2d_gauss_mod

samples/advanced/MixedPrec/amg_d_pde2d_poisson_mod.f90

@@ -0,0 +1,89 @@
+!
+!
+!                             AMG4PSBLAS version 1.0
+!    Algebraic Multigrid Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!
+!    (C) Copyright 2021
+!
+!        Salvatore Filippone
+!        Pasqua D'Ambra
+!        Fabio Durastante
+!
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the AMG4PSBLAS group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific prior written permission.
+!
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!
+module amg_d_pde2d_poisson_mod
+  use psb_base_mod, only : psb_dpk_, dzero, done
+  real(psb_dpk_), save, private :: epsilon=done/80
+contains
+  subroutine pde_set_parm2d_poisson(dat)
+    real(psb_dpk_), intent(in) :: dat
+    epsilon = dat
+  end subroutine pde_set_parm2d_poisson
+  !
+  ! functions parametrizing the differential equation
+  !
+  function b1_poisson(x,y)
+    implicit none 
+    real(psb_dpk_) :: b1_poisson
+    real(psb_dpk_), intent(in) :: x,y
+    b1_poisson = dzero
+  end function b1_poisson
+  function b2_poisson(x,y)
+    implicit none 
+    real(psb_dpk_) ::  b2_poisson
+    real(psb_dpk_), intent(in) :: x,y
+    b2_poisson = dzero
+  end function b2_poisson
+  function c_poisson(x,y)
+    implicit none 
+    real(psb_dpk_) ::  c_poisson
+    real(psb_dpk_), intent(in) :: x,y
+    c_poisson = dzero
+  end function c_poisson
+  function a1_poisson(x,y)
+    implicit none 
+    real(psb_dpk_) ::  a1_poisson
+    real(psb_dpk_), intent(in) :: x,y
+    a1_poisson=done*epsilon
+  end function a1_poisson
+  function a2_poisson(x,y)
+    implicit none 
+    real(psb_dpk_) ::  a2_poisson
+    real(psb_dpk_), intent(in) :: x,y
+    a2_poisson=done*epsilon
+  end function a2_poisson
+  function g_poisson(x,y)
+    implicit none 
+    real(psb_dpk_) ::  g_poisson
+    real(psb_dpk_), intent(in) :: x,y
+    g_poisson = dzero
+    if (x == done) then
+      g_poisson = done
+    else if (x == dzero) then
+      g_poisson = done
+    end if
+  end function g_poisson
+end module amg_d_pde2d_poisson_mod

samples/advanced/MixedPrec/amg_d_pde3d_box_mod.f90

@@ -0,0 +1,101 @@
+!
+!
+!                             AMG4PSBLAS version 1.0
+!    Algebraic Multigrid Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!
+!    (C) Copyright 2021
+!
+!        Salvatore Filippone
+!        Pasqua D'Ambra
+!        Fabio Durastante
+!
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the AMG4PSBLAS group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific prior written permission.
+!
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!
+module amg_d_pde3d_box_mod
+  use psb_base_mod, only : psb_dpk_, done, dzero
+  real(psb_dpk_), save, private :: epsilon=done/80
+contains
+  subroutine pde_set_parm3d_box(dat)
+    real(psb_dpk_), intent(in) :: dat
+    epsilon = dat
+  end subroutine pde_set_parm3d_box
+  !
+  ! functions parametrizing the differential equation
+  !
+  function b1_box(x,y,z)
+    implicit none 
+    real(psb_dpk_) :: b1_box
+    real(psb_dpk_), intent(in) :: x,y,z
+    b1_box=done/sqrt(3.0_psb_dpk_)
+  end function b1_box
+  function b2_box(x,y,z)
+    implicit none 
+    real(psb_dpk_) ::  b2_box
+    real(psb_dpk_), intent(in) :: x,y,z
+    b2_box=done/sqrt(3.0_psb_dpk_)
+  end function b2_box
+  function b3_box(x,y,z)
+    implicit none 
+    real(psb_dpk_) ::  b3_box
+    real(psb_dpk_), intent(in) :: x,y,z
+    b3_box=done/sqrt(3.0_psb_dpk_)
+  end function b3_box
+  function c_box(x,y,z)
+    implicit none 
+    real(psb_dpk_) ::  c_box
+    real(psb_dpk_), intent(in) :: x,y,z
+    c_box=dzero
+  end function c_box
+  function a1_box(x,y,z)
+    implicit none 
+    real(psb_dpk_) ::  a1_box
+    real(psb_dpk_), intent(in) :: x,y,z
+    a1_box=epsilon
+  end function a1_box
+  function a2_box(x,y,z)
+    implicit none 
+    real(psb_dpk_) ::  a2_box
+    real(psb_dpk_), intent(in) :: x,y,z
+    a2_box=epsilon
+  end function a2_box
+  function a3_box(x,y,z)
+    implicit none 
+    real(psb_dpk_) ::  a3_box
+    real(psb_dpk_), intent(in) :: x,y,z
+    a3_box=epsilon
+  end function a3_box
+  function g_box(x,y,z)
+    implicit none 
+    real(psb_dpk_) ::  g_box
+    real(psb_dpk_), intent(in) :: x,y,z
+    g_box= dzero
+    if (x == done) then
+      g_box = done
+    else if (x == dzero) then
+      g_box = done
+    end if
+  end function g_box
+end module amg_d_pde3d_box_mod

samples/advanced/MixedPrec/amg_d_pde3d_exp_mod.f90

@@ -0,0 +1,101 @@
+!
+!
+!                             AMG4PSBLAS version 1.0
+!    Algebraic Multigrid Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!
+!    (C) Copyright 2021
+!
+!        Salvatore Filippone
+!        Pasqua D'Ambra
+!        Fabio Durastante
+!
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the AMG4PSBLAS group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific prior written permission.
+!
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!
+module amg_d_pde3d_exp_mod
+  use psb_base_mod, only : psb_dpk_, done, dzero
+  real(psb_dpk_), save, private :: epsilon=done/160
+contains
+  subroutine pde_set_parm3d_exp(dat)
+    real(psb_dpk_), intent(in) :: dat
+    epsilon = dat
+  end subroutine pde_set_parm3d_exp
+  !
+  ! functions parametrizing the differential equation
+  !
+  function b1_exp(x,y,z)
+    implicit none 
+    real(psb_dpk_) :: b1_exp
+    real(psb_dpk_), intent(in) :: x,y,z
+    b1_exp=dzero/sqrt(3.0_psb_dpk_)
+  end function b1_exp
+  function b2_exp(x,y,z)
+    implicit none 
+    real(psb_dpk_) ::  b2_exp
+    real(psb_dpk_), intent(in) :: x,y,z
+    b2_exp=dzero/sqrt(3.0_psb_dpk_)
+  end function b2_exp
+  function b3_exp(x,y,z)
+    implicit none 
+    real(psb_dpk_) ::  b3_exp
+    real(psb_dpk_), intent(in) :: x,y,z
+    b3_exp=dzero/sqrt(3.0_psb_dpk_)
+  end function b3_exp
+  function c_exp(x,y,z)
+    implicit none 
+    real(psb_dpk_) ::  c_exp
+    real(psb_dpk_), intent(in) :: x,y,z
+    c_exp=dzero
+  end function c_exp
+  function a1_exp(x,y,z)
+    implicit none 
+    real(psb_dpk_) ::  a1_exp
+    real(psb_dpk_), intent(in) :: x,y,z
+    a1_exp=epsilon*exp(-(x+y+z))
+  end function a1_exp
+  function a2_exp(x,y,z)
+    implicit none 
+    real(psb_dpk_) ::  a2_exp
+    real(psb_dpk_), intent(in) :: x,y,z
+    a2_exp=epsilon*exp(-(x+y+z))
+  end function a2_exp
+  function a3_exp(x,y,z)
+    implicit none 
+    real(psb_dpk_) ::  a3_exp
+    real(psb_dpk_), intent(in) :: x,y,z
+    a3_exp=epsilon*exp(-(x+y+z))
+  end function a3_exp
+  function g_exp(x,y,z)
+    implicit none 
+    real(psb_dpk_) ::  g_exp
+    real(psb_dpk_), intent(in) :: x,y,z
+    g_exp = dzero
+    if (x == done) then
+      g_exp = done
+    else if (x == dzero) then
+      g_exp = done
+    end if
+  end function g_exp
+end module amg_d_pde3d_exp_mod

samples/advanced/MixedPrec/amg_d_pde3d_gauss_mod.f90

@@ -0,0 +1,101 @@
+!
+!
+!                             AMG4PSBLAS version 1.0
+!    Algebraic Multigrid Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!
+!    (C) Copyright 2021
+!
+!        Salvatore Filippone
+!        Pasqua D'Ambra
+!        Fabio Durastante
+!
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the AMG4PSBLAS group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific prior written permission.
+!
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!
+module amg_d_pde3d_gauss_mod
+  use psb_base_mod, only : psb_dpk_, done, dzero
+  real(psb_dpk_), save, private :: epsilon=done/80
+contains
+  subroutine pde_set_parm3d_gauss(dat)
+    real(psb_dpk_), intent(in) :: dat
+    epsilon = dat
+  end subroutine pde_set_parm3d_gauss
+  !
+  ! functions parametrizing the differential equation
+  !
+  function b1_gauss(x,y,z)
+    implicit none 
+    real(psb_dpk_) :: b1_gauss
+    real(psb_dpk_), intent(in) :: x,y,z
+    b1_gauss=done/sqrt(3.0_psb_dpk_)-2*x*exp(-(x**2+y**2+z**2))
+  end function b1_gauss
+  function b2_gauss(x,y,z)
+    implicit none 
+    real(psb_dpk_) ::  b2_gauss
+    real(psb_dpk_), intent(in) :: x,y,z
+    b2_gauss=done/sqrt(3.0_psb_dpk_)-2*y*exp(-(x**2+y**2+z**2))
+  end function b2_gauss
+  function b3_gauss(x,y,z)
+    implicit none 
+    real(psb_dpk_) ::  b3_gauss
+    real(psb_dpk_), intent(in) :: x,y,z
+    b3_gauss=done/sqrt(3.0_psb_dpk_)-2*z*exp(-(x**2+y**2+z**2))
+  end function b3_gauss
+  function c_gauss(x,y,z)
+    implicit none 
+    real(psb_dpk_) ::  c_gauss
+    real(psb_dpk_), intent(in) :: x,y,z
+    c_gauss=dzero
+  end function c_gauss
+  function a1_gauss(x,y,z)
+    implicit none 
+    real(psb_dpk_) ::  a1_gauss
+    real(psb_dpk_), intent(in) :: x,y,z
+    a1_gauss=epsilon*exp(-(x**2+y**2+z**2))
+  end function a1_gauss
+  function a2_gauss(x,y,z)
+    implicit none 
+    real(psb_dpk_) ::  a2_gauss
+    real(psb_dpk_), intent(in) :: x,y,z
+    a2_gauss=epsilon*exp(-(x**2+y**2+z**2))
+  end function a2_gauss
+  function a3_gauss(x,y,z)
+    implicit none 
+    real(psb_dpk_) ::  a3_gauss
+    real(psb_dpk_), intent(in) :: x,y,z
+    a3_gauss=epsilon*exp(-(x**2+y**2+z**2))
+  end function a3_gauss
+  function g_gauss(x,y,z)
+    implicit none 
+    real(psb_dpk_) ::  g_gauss
+    real(psb_dpk_), intent(in) :: x,y,z
+    g_gauss = dzero
+    if (x == done) then
+      g_gauss = done
+    else if (x == dzero) then
+      g_gauss = done
+    end if
+  end function g_gauss
+end module amg_d_pde3d_gauss_mod

samples/advanced/MixedPrec/amg_d_pde3d_poisson_mod.f90

@@ -0,0 +1,101 @@
+!
+!
+!                             AMG4PSBLAS version 1.0
+!    Algebraic Multigrid Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!
+!    (C) Copyright 2021
+!
+!        Salvatore Filippone
+!        Pasqua D'Ambra
+!        Fabio Durastante
+!
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the AMG4PSBLAS group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific prior written permission.
+!
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!
+module amg_d_pde3d_poisson_mod
+  use psb_base_mod, only : psb_dpk_, done, dzero
+  real(psb_dpk_), save, private :: epsilon=done/80
+contains
+  subroutine pde_set_parm3d_poisson(dat)
+    real(psb_dpk_), intent(in) :: dat
+    epsilon = dat
+  end subroutine pde_set_parm3d_poisson
+  !
+  ! functions parametrizing the differential equation
+  !
+  function b1_poisson(x,y,z)
+    implicit none 
+    real(psb_dpk_) :: b1_poisson
+    real(psb_dpk_), intent(in) :: x,y,z
+    b1_poisson=dzero
+  end function b1_poisson
+  function b2_poisson(x,y,z)
+    implicit none 
+    real(psb_dpk_) ::  b2_poisson
+    real(psb_dpk_), intent(in) :: x,y,z
+    b2_poisson=dzero
+  end function b2_poisson
+  function b3_poisson(x,y,z)
+    implicit none 
+    real(psb_dpk_) ::  b3_poisson
+    real(psb_dpk_), intent(in) :: x,y,z
+    b3_poisson=dzero
+  end function b3_poisson
+  function c_poisson(x,y,z)
+    implicit none 
+    real(psb_dpk_) ::  c_poisson
+    real(psb_dpk_), intent(in) :: x,y,z
+    c_poisson=dzero
+  end function c_poisson
+  function a1_poisson(x,y,z)
+    implicit none 
+    real(psb_dpk_) ::  a1_poisson
+    real(psb_dpk_), intent(in) :: x,y,z
+    a1_poisson=epsilon
+  end function a1_poisson
+  function a2_poisson(x,y,z)
+    implicit none 
+    real(psb_dpk_) ::  a2_poisson
+    real(psb_dpk_), intent(in) :: x,y,z
+    a2_poisson=epsilon
+  end function a2_poisson
+  function a3_poisson(x,y,z)
+    implicit none 
+    real(psb_dpk_) ::  a3_poisson
+    real(psb_dpk_), intent(in) :: x,y,z
+    a3_poisson=epsilon
+  end function a3_poisson
+  function g_poisson(x,y,z)
+    implicit none 
+    real(psb_dpk_) ::  g_poisson
+    real(psb_dpk_), intent(in) :: x,y,z
+    g_poisson = dzero
+    if (x == done) then
+      g_poisson = done
+    else if (x == dzero) then
+      g_poisson = done
+    end if
+  end function g_poisson
+end module amg_d_pde3d_poisson_mod

samples/advanced/MixedPrec/data_input.f90

@@ -0,0 +1,324 @@
+!   
+!   
+!                             AMG4PSBLAS version 1.0
+!    Algebraic Multigrid Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!    
+!    (C) Copyright 2021 
+!  
+!        Salvatore Filippone  
+!        Pasqua D'Ambra   
+!        Fabio Durastante        
+!   
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the AMG4PSBLAS group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific prior written permission.
+!   
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!   
+!  
+module data_input
+  use psb_base_mod, only : psb_spk_, psb_dpk_, psb_ipk_
+  
+  interface read_data
+    module procedure read_char, read_int, read_int_array,&
+         & read_double, read_double_array, &
+         & read_single, read_single_array, read_logical,&
+         & string_read_char, string_read_int, string_read_int_array,&
+         & string_read_double, string_read_double_array,&
+         & string_read_single, string_read_single_array, &
+         & string_read_logical
+  end interface read_data
+  interface trim_string
+    module procedure trim_string
+  end interface
+
+  character(len=4096), private  :: charbuf
+  character, private, parameter :: def_marker="!"
+  character, private, parameter :: cmt_marker="%"
+
+contains
+  subroutine get_buffer(file,buffer)
+    integer(psb_ipk_), intent(in)          :: file
+    character(len=*), intent(inout)        :: buffer
+    integer :: idx
+    do 
+      read(file,'(a)',end=999) buffer
+      buffer = adjustl(buffer)
+      idx=index(charbuf,cmt_marker)
+      if (idx == 1 ) then
+        cycle
+      else  
+        exit
+      end if      
+    end do
+999 continue
+    return
+  end subroutine get_buffer
+  
+  subroutine read_logical(val,file,marker)
+    logical, intent(out) :: val
+    integer(psb_ipk_), intent(in)          :: file
+    character(len=1), optional, intent(in) :: marker
+
+    call get_buffer(file,charbuf)
+    call read_data(val,charbuf,marker)
+
+  end subroutine read_logical
+
+  subroutine read_char(val,file,marker)
+    character(len=*), intent(out) :: val
+    integer(psb_ipk_), intent(in)           :: file
+    character(len=1), optional, intent(in) :: marker
+
+    call get_buffer(file,charbuf)
+    call read_data(val,charbuf,marker)
+
+  end subroutine read_char
+
+  subroutine read_int(val,file,marker)
+    integer(psb_ipk_), intent(out) :: val
+    integer(psb_ipk_), intent(in)  :: file
+    character(len=1), optional, intent(in) :: marker
+
+    call get_buffer(file,charbuf)
+    call read_data(val,charbuf,marker)
+
+  end subroutine read_int
+
+  subroutine read_int_array(val,file,marker)
+    integer(psb_ipk_), intent(out) :: val(:)
+    integer(psb_ipk_), intent(in)  :: file
+    character(len=1), optional, intent(in) :: marker
+
+    call get_buffer(file,charbuf)
+    call read_data(val,charbuf,marker)
+    
+  end subroutine read_int_array
+
+  subroutine read_single(val,file,marker)
+    real(psb_spk_), intent(out) :: val
+    integer(psb_ipk_), intent(in)         :: file
+    character(len=1), optional, intent(in) :: marker
+
+    call get_buffer(file,charbuf)
+    call read_data(val,charbuf,marker)
+
+  end subroutine read_single
+
+  subroutine read_single_array(val,file,marker)
+    real(psb_spk_), intent(out) :: val(:)
+    integer(psb_ipk_), intent(in)         :: file
+    character(len=1), optional, intent(in) :: marker
+
+    call get_buffer(file,charbuf)
+    call read_data(val,charbuf,marker)
+
+  end subroutine read_single_array
+
+  subroutine read_double(val,file,marker)
+    real(psb_dpk_), intent(out) :: val
+    integer(psb_ipk_), intent(in)         :: file
+    character(len=1), optional, intent(in) :: marker
+
+    call get_buffer(file,charbuf)
+    call read_data(val,charbuf,marker)
+
+  end subroutine read_double
+
+  subroutine read_double_array(val,file,marker)
+    real(psb_dpk_), intent(out) :: val(:)
+    integer(psb_ipk_), intent(in)         :: file
+    character(len=1), optional, intent(in) :: marker
+
+    call get_buffer(file,charbuf)
+    call read_data(val,charbuf,marker)
+
+  end subroutine read_double_array
+
+  subroutine string_read_char(val,file,marker)
+    character(len=*), intent(out) :: val
+    character(len=*), intent(in)  :: file
+    character(len=1), optional, intent(in) :: marker
+    character(len=1)    :: marker_
+    character(len=1024) :: charbuf
+    integer(psb_ipk_) :: idx
+    if (present(marker)) then 
+      marker_ = marker
+    else
+      marker_ = def_marker
+    end if
+    read(file,'(a)')charbuf
+    charbuf = adjustl(charbuf)
+    idx=index(charbuf,marker_)
+    if (idx == 0) idx = len(charbuf)+1
+    read(charbuf(1:idx-1),'(a)') val
+  end subroutine string_read_char
+
+  subroutine string_read_int(val,file,marker)
+    integer(psb_ipk_), intent(out) :: val
+    character(len=*), intent(in)  :: file
+    character(len=1), optional, intent(in) :: marker
+    character(len=1)    :: marker_
+    character(len=1024) :: charbuf
+    integer(psb_ipk_) :: idx
+    if (present(marker)) then 
+      marker_ = marker
+    else
+      marker_ = def_marker
+    end if
+    read(file,'(a)')charbuf
+    charbuf = adjustl(charbuf)
+    idx=index(charbuf,marker_)
+    if (idx == 0) idx = len(charbuf)+1
+    read(charbuf(1:idx-1),*) val
+  end subroutine string_read_int
+
+  subroutine string_read_int_array(val,file,marker)
+    integer(psb_ipk_), intent(out) :: val(:)
+    character(len=*), intent(in)  :: file
+    character(len=1), optional, intent(in) :: marker
+    character(len=1)    :: marker_
+    character(len=1024) :: charbuf
+    integer(psb_ipk_) :: idx
+    if (present(marker)) then 
+      marker_ = marker
+    else
+      marker_ = def_marker
+    end if
+    read(file,'(a)')charbuf
+    charbuf = adjustl(charbuf)
+    idx=index(charbuf,marker_)
+    if (idx == 0) idx = len(charbuf)+1
+    read(charbuf(1:idx-1),*) val(:)
+  end subroutine string_read_int_array
+
+  subroutine string_read_single(val,file,marker)
+    real(psb_spk_), intent(out) :: val
+    character(len=*), intent(in)         :: file
+    character(len=1), optional, intent(in) :: marker
+    character(len=1)    :: marker_
+    character(len=1024) :: charbuf
+    integer(psb_ipk_) :: idx
+    if (present(marker)) then 
+      marker_ = marker
+    else
+      marker_ = def_marker
+    end if
+    read(file,'(a)')charbuf
+    charbuf = adjustl(charbuf)
+    idx=index(charbuf,marker_)
+    if (idx == 0) idx = len(charbuf)+1
+    read(charbuf(1:idx-1),*) val
+  end subroutine string_read_single
+
+  subroutine string_read_single_array(val,file,marker)
+    real(psb_spk_), intent(out) :: val(:)
+    character(len=*), intent(in)         :: file
+    character(len=1), optional, intent(in) :: marker
+    character(len=1)    :: marker_
+    character(len=1024) :: charbuf
+    integer(psb_ipk_) :: idx
+    if (present(marker)) then 
+      marker_ = marker
+    else
+      marker_ = def_marker
+    end if
+    read(file,'(a)')charbuf
+    charbuf = adjustl(charbuf)
+    idx=index(charbuf,marker_)
+    if (idx == 0) idx = len(charbuf)+1
+    read(charbuf(1:idx-1),*) val(:)
+  end subroutine string_read_single_array
+
+  subroutine string_read_double(val,file,marker)
+    real(psb_dpk_), intent(out) :: val
+    character(len=*), intent(in)         :: file
+    character(len=1), optional, intent(in) :: marker
+    character(len=1)    :: marker_
+    character(len=1024) :: charbuf
+    integer(psb_ipk_) :: idx
+    if (present(marker)) then 
+      marker_ = marker
+    else
+      marker_ = def_marker
+    end if
+    read(file,'(a)')charbuf
+    charbuf = adjustl(charbuf)
+    idx=index(charbuf,marker_)
+    if (idx == 0) idx = len(charbuf)+1
+    read(charbuf(1:idx-1),*) val
+  end subroutine string_read_double
+
+  subroutine string_read_double_array(val,file,marker)
+    real(psb_dpk_), intent(out) :: val(:)
+    character(len=*), intent(in)         :: file
+    character(len=1), optional, intent(in) :: marker
+    character(len=1)    :: marker_
+    character(len=1024) :: charbuf
+    integer(psb_ipk_) :: idx
+    if (present(marker)) then 
+      marker_ = marker
+    else
+      marker_ = def_marker
+    end if
+    read(file,'(a)')charbuf
+    charbuf = adjustl(charbuf)
+    idx=index(charbuf,marker_)
+    if (idx == 0) idx = len(charbuf)+1
+    read(charbuf(1:idx-1),*) val(:)
+  end subroutine string_read_double_array
+
+  subroutine string_read_logical(val,file,marker)
+    logical, intent(out) :: val
+    character(len=*), intent(in)         :: file
+    character(len=1), optional, intent(in) :: marker
+    character(len=1)    :: marker_
+    character(len=1024) :: charbuf
+    integer(psb_ipk_) :: idx
+    if (present(marker)) then 
+      marker_ = marker
+    else
+      marker_ = def_marker
+    end if
+    read(file,'(a)')charbuf
+    charbuf = adjustl(charbuf)
+    idx=index(charbuf,marker_)
+    if (idx == 0) idx = len(charbuf)+1
+    read(charbuf(1:idx-1),*) val
+  end subroutine string_read_logical
+
+  function  trim_string(string,marker)
+    character(len=*), intent(in) :: string
+    character(len=1), optional, intent(in) :: marker
+    character(len=len(string))    :: trim_string
+    character(len=1)              :: marker_
+    integer(psb_ipk_) :: idx
+    if (present(marker)) then 
+      marker_ = marker
+    else
+      marker_ = def_marker
+    end if
+    idx=index(string,marker_)
+    trim_string = adjustl(string(idx:))
+  end function trim_string
+end module data_input
+

samples/advanced/MixedPrec/psb_mixed_support_mod.f90

@@ -0,0 +1,170 @@
+module psb_mixed_support_mod
+  use psb_base_mod
+
+contains
+
+  subroutine psb_d2s_cscnv(a,b,info,type,mold)
+    implicit none 
+    class(psb_dspmat_type), intent(in)    :: a
+    class(psb_sspmat_type), intent(out)   :: b
+    integer(psb_ipk_), intent(out)                   :: info
+    character(len=*), optional, intent(in) :: type
+    class(psb_s_base_sparse_mat), intent(in), optional :: mold
+
+    type(psb_d_coo_sparse_mat) :: dcoo
+    type(psb_s_coo_sparse_mat) :: scoo
+    integer(psb_ipk_)  :: err_act
+    character(len=20)  :: name='from_coo'
+    logical, parameter :: debug=.false.
+
+    info = psb_success_
+    call psb_erractionsave(err_act)
+
+    call a%cp_to(dcoo)
+    call coo_d2s(dcoo,scoo,info)
+
+    if (present(mold)) then
+
+      allocate(b%a, mold=mold,stat=info)
+
+    else if (present(type)) then
+
+      select case (psb_toupper(type))
+      case ('CSR')
+        allocate(psb_s_csr_sparse_mat :: b%a, stat=info)
+      case ('COO')
+        allocate(psb_s_coo_sparse_mat :: b%a, stat=info)
+      case ('CSC')
+        allocate(psb_s_csc_sparse_mat :: b%a, stat=info)
+      case default
+        info = psb_err_format_unknown_
+        call psb_errpush(info,name,a_err=type)
+        goto 9999
+      end select
+    end if
+    call b%a%mv_from_coo(scoo,info)
+    call psb_erractionrestore(err_act)
+    return
+
+9999 call psb_error_handler(err_act)
+
+    return
+  contains
+    subroutine coo_d2s(dcoo,scoo,info)
+      type(psb_d_coo_sparse_mat) :: dcoo
+      type(psb_s_coo_sparse_mat) :: scoo
+      integer(psb_ipk_), intent(out)                   :: info
+
+      integer(psb_ipk_) :: i,j,nr,nc,nz
+      info = psb_success_
+      nr = dcoo%get_nrows()
+      nc = dcoo%get_ncols()
+      nz = dcoo%get_nzeros()
+      call scoo%allocate(nr,nc,nz)
+      do i=1,nz
+        scoo%ia(i) = dcoo%ia(i)
+        scoo%ja(i) = dcoo%ja(i)
+        scoo%val(i) = dcoo%val(i)
+      end do
+      call scoo%set_nzeros(nz)
+      return
+    end subroutine coo_d2s
+
+  end subroutine psb_d2s_cscnv
+
+  subroutine psb_s2d_cscnv(a,b,info,type,mold)
+    implicit none 
+    class(psb_sspmat_type), intent(in)    :: a
+    class(psb_dspmat_type), intent(out)   :: b
+    integer(psb_ipk_), intent(out)                   :: info
+    character(len=*), optional, intent(in) :: type
+    class(psb_d_base_sparse_mat), intent(in), optional :: mold
+
+    type(psb_d_coo_sparse_mat) :: dcoo
+    type(psb_s_coo_sparse_mat) :: scoo
+    integer(psb_ipk_)  :: err_act
+    character(len=20)  :: name='from_coo'
+    logical, parameter :: debug=.false.
+
+    info = psb_success_
+    call psb_erractionsave(err_act)
+
+    call a%cp_to(scoo)
+    call coo_s2d(scoo,dcoo,info)
+
+    if (present(mold)) then
+
+      allocate(b%a, mold=mold,stat=info)
+
+    else if (present(type)) then
+
+      select case (psb_toupper(type))
+      case ('CSR')
+        allocate(psb_d_csr_sparse_mat :: b%a, stat=info)
+      case ('COO')
+        allocate(psb_d_coo_sparse_mat :: b%a, stat=info)
+      case ('CSC')
+        allocate(psb_d_csc_sparse_mat :: b%a, stat=info)
+      case default
+        info = psb_err_format_unknown_
+        call psb_errpush(info,name,a_err=type)
+        goto 9999
+      end select
+    end if
+    call b%a%mv_from_coo(dcoo,info)
+    call psb_erractionrestore(err_act)
+    return
+
+9999 call psb_error_handler(err_act)
+
+    return
+  contains
+    subroutine coo_s2d(scoo,dcoo,info)
+      type(psb_d_coo_sparse_mat) :: dcoo
+      type(psb_s_coo_sparse_mat) :: scoo
+      integer(psb_ipk_), intent(out)                   :: info
+
+      integer(psb_ipk_) :: i,j,nr,nc,nz
+      info = psb_success_
+      nr = scoo%get_nrows()
+      nc = scoo%get_ncols()
+      nz = scoo%get_nzeros()
+      call scoo%allocate(nr,nc,nz)
+      do i=1,nz
+        dcoo%ia(i) = scoo%ia(i)
+        dcoo%ja(i) = scoo%ja(i)
+        dcoo%val(i) = scoo%val(i)
+      end do
+      call dcoo%set_nzeros(nz)
+      return
+    end subroutine coo_s2d
+
+  end subroutine psb_s2d_cscnv
+
+  subroutine psb_d2s_vect(dv,sv,info,mold)
+    class(psb_d_vect_type), intent(inout) :: dv
+    class(psb_s_vect_type), intent(inout) :: sv
+    integer(psb_ipk_), intent(out)        :: info    
+    class(psb_s_base_vect_type), intent(in), optional :: mold
+
+    real(psb_spk_), allocatable :: xv(:)
+
+    info = psb_success_
+    xv = dv%get_vect()
+    call sv%bld(xv,mold=mold)
+  end subroutine psb_d2s_vect
+
+  subroutine psb_s2d_vect(sv,dv,info,mold)
+    class(psb_d_vect_type), intent(inout) :: dv
+    class(psb_s_vect_type), intent(inout) :: sv
+    integer(psb_ipk_), intent(out)        :: info    
+    class(psb_d_base_vect_type), intent(in), optional :: mold
+
+    real(psb_dpk_), allocatable :: xv(:)
+
+    info = psb_success_
+    xv = sv%get_vect()
+    call dv%bld(xv,mold=mold)
+  end subroutine psb_s2d_vect
+
+end module psb_mixed_support_mod