Added psb_mixed_support

samples/advanced/MixedPrec/Makefile

@@ -8,6 +8,9 @@ FINCLUDES=$(FMFLAG). $(FMFLAG)$(AMGMODDIR) $(FMFLAG)$(AMGINCDIR) $(PSBLAS_INCLUD
 
 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 \
@@ -22,7 +25,7 @@ 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) data_input.o
+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) data_input.o \
          -o amg_d_pde3d $(AMG_LIBS) $(PSBLAS_LIBS) $(AMG_LDLIBS) $(LDLIBS)
 	/bin/mv amg_d_pde3d $(EXEDIR)

samples/advanced/MixedPrec/psb_mixed_support_mod.f90

@@ -0,0 +1,172 @@
+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
+    integer(psb_ipk_),optional, intent(in)           :: dupl, upd
+    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
+    integer(psb_ipk_),optional, intent(in)           :: dupl, upd
+    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(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(scoo,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_d2s_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