diff --git a/test/serial/Makefile b/test/serial/Makefile index d9d9eff5..1d052fba 100644 --- a/test/serial/Makefile +++ b/test/serial/Makefile @@ -20,8 +20,9 @@ d_coo_matgen: d_coo_matgen.o $(F90LINK) $(LINKOPT) d_coo_matgen.o -o d_coo_matgen $(PSBLAS_LIB) $(LDLIBS) /bin/mv d_coo_matgen $(EXEDIR) psb_d_cxx_impl.o d_matgen.o: psb_d_cxx_mat_mod.o -d_matgen: d_matgen.o psb_d_cxx_mat_mod.o psb_d_cxx_impl.o - $(F90LINK) $(LINKOPT) d_matgen.o psb_d_cxx_mat_mod.o psb_d_cxx_impl.o -o d_matgen $(PSBLAS_LIB) $(LDLIBS) +psb_d_cyy_impl.o d_matgen.o: psb_d_cyy_mat_mod.o +d_matgen: d_matgen.o psb_d_cxx_mat_mod.o psb_d_cxx_impl.o psb_d_cyy_mat_mod.o psb_d_cyy_impl.o psb_d_czz_mat_mod.o + $(F90LINK) $(LINKOPT) d_matgen.o psb_d_cxx_mat_mod.o psb_d_cxx_impl.o psb_d_cyy_mat_mod.o psb_d_cyy_impl.o psb_d_czz_mat_mod.o -o d_matgen $(PSBLAS_LIB) $(LDLIBS) /bin/mv d_matgen $(EXEDIR) .f90.o: @@ -30,6 +31,8 @@ d_matgen: d_matgen.o psb_d_cxx_mat_mod.o psb_d_cxx_impl.o clean: /bin/rm -f d_coo_matgen.o d_matgen.o \ + psb_d_czz_mat_mod.o \ + psb_d_cyy_mat_mod.o psb_d_cyy_impl.o \ psb_d_cxx_mat_mod.o psb_d_cxx_impl.o *$(.mod) verycleanlib: (cd ../..; make veryclean) diff --git a/test/serial/d_matgen.f03 b/test/serial/d_matgen.f03 index 6c3ee512..2ec83c2a 100644 --- a/test/serial/d_matgen.f03 +++ b/test/serial/d_matgen.f03 @@ -5,6 +5,8 @@ program d_matgen use psb_d_csr_mat_mod use psb_d_mat_mod use psb_d_cxx_mat_mod + use psb_d_cyy_mat_mod + use psb_d_czz_mat_mod implicit none ! input parameters @@ -30,6 +32,8 @@ program d_matgen integer :: iter, itmax,itrace, istopc, irst integer(psb_long_int_k_) :: amatsize, precsize, descsize real(psb_dpk_) :: err, eps + !type(psb_d_cyy_sparse_mat) :: acyy + !type(psb_d_czz_sparse_mat) :: aczz type(psb_d_cxx_sparse_mat) :: acxx ! other variables @@ -61,6 +65,8 @@ program d_matgen ! call psb_barrier(ictxt) t1 = psb_wtime() + !call create_matrix(idim,a,b,x,desc_a,ictxt,afmt,info,acyy) + !call create_matrix(idim,a,b,x,desc_a,ictxt,afmt,info,aczz) call create_matrix(idim,a,b,x,desc_a,ictxt,afmt,info,acxx) call psb_barrier(ictxt) t2 = psb_wtime() - t1 diff --git a/test/serial/psb_d_cyy_impl.f03 b/test/serial/psb_d_cyy_impl.f03 new file mode 100644 index 00000000..22098ac5 --- /dev/null +++ b/test/serial/psb_d_cyy_impl.f03 @@ -0,0 +1,596 @@ +! +! A minimal, non functional implementation of a matrix type module. +! +subroutine psb_d_cyy_csmv(alpha,a,x,beta,y,info,trans) + use psb_sparse_mod + use psb_d_cyy_mat_mod, psb_protect_name => psb_d_cyy_csmv + implicit none + class(psb_d_cyy_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:) + real(psb_dpk_), intent(inout) :: y(:) + integer, intent(out) :: info + character, optional, intent(in) :: trans + + character :: trans_ + integer :: i,j,k,m,n, nnz, ir, jc + real(psb_dpk_) :: acc + logical :: tra + Integer :: err_act + character(len=20) :: name='d_cyy_csmv' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + return +end subroutine psb_d_cyy_csmv + +subroutine psb_d_cyy_csmm(alpha,a,x,beta,y,info,trans) + use psb_sparse_mod + use psb_d_cyy_mat_mod, psb_protect_name => psb_d_cyy_csmm + implicit none + class(psb_d_cyy_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:,:) + real(psb_dpk_), intent(inout) :: y(:,:) + integer, intent(out) :: info + character, optional, intent(in) :: trans + + character :: trans_ + integer :: i,j,k,m,n, nnz, ir, jc, nc + real(psb_dpk_), allocatable :: acc(:) + logical :: tra + Integer :: err_act + character(len=20) :: name='d_cyy_csmm' + logical, parameter :: debug=.false. + + info = psb_success_ +end subroutine psb_d_cyy_csmm + +subroutine psb_d_cyy_cssv(alpha,a,x,beta,y,info,trans) + use psb_sparse_mod + use psb_d_cyy_mat_mod, psb_protect_name => psb_d_cyy_cssv + implicit none + class(psb_d_cyy_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:) + real(psb_dpk_), intent(inout) :: y(:) + integer, intent(out) :: info + character, optional, intent(in) :: trans + + character :: trans_ + integer :: i,j,k,m,n, nnz, ir, jc + real(psb_dpk_) :: acc + real(psb_dpk_), allocatable :: tmp(:) + logical :: tra + Integer :: err_act + character(len=20) :: name='d_cyy_cssv' + logical, parameter :: debug=.false. + + info = psb_success_ +end subroutine psb_d_cyy_cssv + +subroutine psb_d_cyy_cssm(alpha,a,x,beta,y,info,trans) + use psb_sparse_mod + use psb_d_cyy_mat_mod, psb_protect_name => psb_d_cyy_cssm + implicit none + class(psb_d_cyy_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:,:) + real(psb_dpk_), intent(inout) :: y(:,:) + integer, intent(out) :: info + character, optional, intent(in) :: trans + + character :: trans_ + integer :: i,j,k,m,n, nnz, ir, jc, nc + real(psb_dpk_) :: acc + real(psb_dpk_), allocatable :: tmp(:,:) + logical :: tra + Integer :: err_act + character(len=20) :: name='d_cyy_cssm' + logical, parameter :: debug=.false. + + info = psb_success_ + +end subroutine psb_d_cyy_cssm + +function psb_d_cyy_csnmi(a) result(res) + use psb_sparse_mod + use psb_d_cyy_mat_mod, psb_protect_name => psb_d_cyy_csnmi + implicit none + class(psb_d_cyy_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + + integer :: i,j,k,m,n, nr, ir, jc, nc + real(psb_dpk_) :: acc + logical :: tra + Integer :: err_act + character(len=20) :: name='d_csnmi' + logical, parameter :: debug=.false. + res = dzero +end function psb_d_cyy_csnmi + +function psb_d_cyy_csnm1(a) result(res) + use psb_sparse_mod + use psb_d_cyy_mat_mod, psb_protect_name => psb_d_cyy_csnm1 + + implicit none + class(psb_d_cyy_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + + integer :: i,j,k,m,n, nnz, ir, jc, nc, info + real(psb_dpk_) :: acc + real(psb_dpk_), allocatable :: vt(:) + logical :: tra + Integer :: err_act + character(len=20) :: name='d_cyy_csnm1' + logical, parameter :: debug=.false. + res = -done + return +end function psb_d_cyy_csnm1 + +subroutine psb_d_cyy_rowsum(d,a) + use psb_sparse_mod + use psb_d_cyy_mat_mod, psb_protect_name => psb_d_cyy_rowsum + class(psb_d_cyy_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(out) :: d(:) + + integer :: i,j,k,m,n, nnz, ir, jc, nc + real(psb_dpk_) :: acc + real(psb_dpk_), allocatable :: vt(:) + logical :: tra + Integer :: err_act, info, int_err(5) + character(len=20) :: name='rowsum' + logical, parameter :: debug=.false. + return +end subroutine psb_d_cyy_rowsum + +subroutine psb_d_cyy_arwsum(d,a) + use psb_sparse_mod + use psb_d_cyy_mat_mod, psb_protect_name => psb_d_cyy_arwsum + class(psb_d_cyy_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(out) :: d(:) + + integer :: i,j,k,m,n, nnz, ir, jc, nc + real(psb_dpk_) :: acc + real(psb_dpk_), allocatable :: vt(:) + logical :: tra + Integer :: err_act, info, int_err(5) + character(len=20) :: name='rowsum' + logical, parameter :: debug=.false. +end subroutine psb_d_cyy_arwsum + +subroutine psb_d_cyy_colsum(d,a) + use psb_sparse_mod + use psb_d_cyy_mat_mod, psb_protect_name => psb_d_cyy_colsum + class(psb_d_cyy_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(out) :: d(:) + + integer :: i,j,k,m,n, nnz, ir, jc, nc + real(psb_dpk_) :: acc + real(psb_dpk_), allocatable :: vt(:) + logical :: tra + Integer :: err_act, info, int_err(5) + character(len=20) :: name='colsum' + logical, parameter :: debug=.false. +end subroutine psb_d_cyy_colsum + +subroutine psb_d_cyy_aclsum(d,a) + use psb_sparse_mod + use psb_d_cyy_mat_mod, psb_protect_name => psb_d_cyy_aclsum + class(psb_d_cyy_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(out) :: d(:) + + integer :: i,j,k,m,n, nnz, ir, jc, nc + real(psb_dpk_) :: acc + real(psb_dpk_), allocatable :: vt(:) + logical :: tra + Integer :: err_act, info, int_err(5) + character(len=20) :: name='aclsum' + logical, parameter :: debug=.false. +end subroutine psb_d_cyy_aclsum + +subroutine psb_d_cyy_get_diag(a,d,info) + use psb_sparse_mod + use psb_d_cyy_mat_mod, psb_protect_name => psb_d_cyy_get_diag + implicit none + class(psb_d_cyy_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(out) :: d(:) + integer, intent(out) :: info + + Integer :: err_act, mnm, i, j, k + character(len=20) :: name='get_diag' + logical, parameter :: debug=.false. + info = psb_success_ +end subroutine psb_d_cyy_get_diag + +subroutine psb_d_cyy_scal(d,a,info) + use psb_sparse_mod + use psb_d_cyy_mat_mod, psb_protect_name => psb_d_cyy_scal + implicit none + class(psb_d_cyy_sparse_mat), intent(inout) :: a + real(psb_dpk_), intent(in) :: d(:) + integer, intent(out) :: info + + Integer :: err_act,mnm, i, j, m + character(len=20) :: name='scal' + logical, parameter :: debug=.false. + info = psb_success_ +end subroutine psb_d_cyy_scal + +subroutine psb_d_cyy_scals(d,a,info) + use psb_sparse_mod + use psb_d_cyy_mat_mod, psb_protect_name => psb_d_cyy_scals + implicit none + class(psb_d_cyy_sparse_mat), intent(inout) :: a + real(psb_dpk_), intent(in) :: d + integer, intent(out) :: info + + Integer :: err_act,mnm, i, j, m + character(len=20) :: name='scal' + logical, parameter :: debug=.false. + info = psb_success_ +end subroutine psb_d_cyy_scals + +subroutine psb_d_cyy_reallocate_nz(nz,a) + use psb_sparse_mod + use psb_d_cyy_mat_mod, psb_protect_name => psb_d_cyy_reallocate_nz + implicit none + integer, intent(in) :: nz + class(psb_d_cyy_sparse_mat), intent(inout) :: a + Integer :: err_act, info + character(len=20) :: name='d_cyy_reallocate_nz' + logical, parameter :: debug=.false. + +end subroutine psb_d_cyy_reallocate_nz + +subroutine psb_d_cyy_mold(a,b,info) + use psb_sparse_mod + use psb_d_cyy_mat_mod, psb_protect_name => psb_d_cyy_mold + implicit none + class(psb_d_cyy_sparse_mat), intent(in) :: a + class(psb_d_base_sparse_mat), intent(out), allocatable :: b + integer, intent(out) :: info + Integer :: err_act + character(len=20) :: name='reallocate_nz' + logical, parameter :: debug=.false. +end subroutine psb_d_cyy_mold + +subroutine psb_d_cyy_allocate_mnnz(m,n,a,nz) + use psb_sparse_mod + use psb_d_cyy_mat_mod, psb_protect_name => psb_d_cyy_allocate_mnnz + implicit none + integer, intent(in) :: m,n + class(psb_d_cyy_sparse_mat), intent(inout) :: a + integer, intent(in), optional :: nz + Integer :: err_act, info, nz_ + character(len=20) :: name='allocate_mnz' + logical, parameter :: debug=.false. +end subroutine psb_d_cyy_allocate_mnnz + +subroutine psb_d_cyy_csgetptn(imin,imax,a,nz,ia,ja,info,& + & jmin,jmax,iren,append,nzin,rscale,cscale) + use psb_sparse_mod + use psb_d_cyy_mat_mod, psb_protect_name => psb_d_cyy_csgetptn + implicit none + + class(psb_d_cyy_sparse_mat), intent(in) :: a + integer, intent(in) :: imin,imax + integer, intent(out) :: nz + integer, allocatable, intent(inout) :: ia(:), ja(:) + integer,intent(out) :: info + logical, intent(in), optional :: append + integer, intent(in), optional :: iren(:) + integer, intent(in), optional :: jmin,jmax, nzin + logical, intent(in), optional :: rscale,cscale + + logical :: append_, rscale_, cscale_ + integer :: nzin_, jmin_, jmax_, err_act, i + character(len=20) :: name='csget' + logical, parameter :: debug=.false. + +end subroutine psb_d_cyy_csgetptn + +subroutine psb_d_cyy_csgetrow(imin,imax,a,nz,ia,ja,val,info,& + & jmin,jmax,iren,append,nzin,rscale,cscale) + use psb_sparse_mod + use psb_d_cyy_mat_mod, psb_protect_name => psb_d_cyy_csgetrow + implicit none + + class(psb_d_cyy_sparse_mat), intent(in) :: a + integer, intent(in) :: imin,imax + integer, intent(out) :: nz + integer, allocatable, intent(inout) :: ia(:), ja(:) + real(psb_dpk_), allocatable, intent(inout) :: val(:) + integer,intent(out) :: info + logical, intent(in), optional :: append + integer, intent(in), optional :: iren(:) + integer, intent(in), optional :: jmin,jmax, nzin + logical, intent(in), optional :: rscale,cscale + + logical :: append_, rscale_, cscale_ + integer :: nzin_, jmin_, jmax_, err_act, i + character(len=20) :: name='csget' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ +end subroutine psb_d_cyy_csgetrow + +subroutine psb_d_cyy_csgetblk(imin,imax,a,b,info,& + & jmin,jmax,iren,append,rscale,cscale) + use psb_sparse_mod + use psb_d_cyy_mat_mod, psb_protect_name => psb_d_cyy_csgetblk + implicit none + + class(psb_d_cyy_sparse_mat), intent(in) :: a + class(psb_d_coo_sparse_mat), intent(inout) :: b + integer, intent(in) :: imin,imax + integer,intent(out) :: info + logical, intent(in), optional :: append + integer, intent(in), optional :: iren(:) + integer, intent(in), optional :: jmin,jmax + logical, intent(in), optional :: rscale,cscale + Integer :: err_act, nzin, nzout + character(len=20) :: name='csget' + logical :: append_ + logical, parameter :: debug=.false. + + info = psb_success_ +end subroutine psb_d_cyy_csgetblk + +subroutine psb_d_cyy_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + use psb_sparse_mod + use psb_d_cyy_mat_mod, psb_protect_name => psb_d_cyy_csput + implicit none + + class(psb_d_cyy_sparse_mat), intent(inout) :: a + real(psb_dpk_), intent(in) :: val(:) + integer, intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax + integer, intent(out) :: info + integer, intent(in), optional :: gtl(:) + + Integer :: err_act + character(len=20) :: name='d_cyy_csput' + logical, parameter :: debug=.false. + integer :: nza, i,j,k, nzl, isza, int_err(5) + info = psb_success_ + +end subroutine psb_d_cyy_csput + +subroutine psb_d_cyy_reinit(a,clear) + use psb_sparse_mod + use psb_d_cyy_mat_mod, psb_protect_name => psb_d_cyy_reinit + implicit none + + class(psb_d_cyy_sparse_mat), intent(inout) :: a + logical, intent(in), optional :: clear + + Integer :: err_act, info + character(len=20) :: name='reinit' + logical :: clear_ + logical, parameter :: debug=.false. + + info = psb_success_ +end subroutine psb_d_cyy_reinit + +subroutine psb_d_cyy_trim(a) + use psb_sparse_mod + use psb_d_cyy_mat_mod, psb_protect_name => psb_d_cyy_trim + implicit none + class(psb_d_cyy_sparse_mat), intent(inout) :: a + Integer :: err_act, info, nz, m + character(len=20) :: name='trim' + logical, parameter :: debug=.false. + + info = psb_success_ +end subroutine psb_d_cyy_trim + +subroutine psb_d_cyy_print(iout,a,iv,eirs,eics,head,ivr,ivc) + use psb_sparse_mod + use psb_d_cyy_mat_mod, psb_protect_name => psb_d_cyy_print + implicit none + + integer, intent(in) :: iout + class(psb_d_cyy_sparse_mat), intent(in) :: a + integer, intent(in), optional :: iv(:) + integer, intent(in), optional :: eirs,eics + character(len=*), optional :: head + integer, intent(in), optional :: ivr(:), ivc(:) + + Integer :: err_act + character(len=20) :: name='d_cyy_print' + logical, parameter :: debug=.false. + + integer :: irs,ics,i,j, nmx, ni, nr, nc, nz +end subroutine psb_d_cyy_print + +subroutine psb_d_cp_cyy_from_coo(a,b,info) + use psb_sparse_mod + use psb_d_cyy_mat_mod, psb_protect_name => psb_d_cp_cyy_from_coo + implicit none + + class(psb_d_cyy_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(in) :: b + integer, intent(out) :: info + + type(psb_d_coo_sparse_mat) :: tmp + integer, allocatable :: itemp(:) + !locals + logical :: rwshr_ + Integer :: nza, nr, i,j,irw, idl,err_act, nc + Integer, Parameter :: maxtry=8 + integer :: debug_level, debug_unit + character(len=20) :: name + + info = psb_success_ +end subroutine psb_d_cp_cyy_from_coo + +subroutine psb_d_cp_cyy_to_coo(a,b,info) + use psb_sparse_mod + use psb_d_cyy_mat_mod, psb_protect_name => psb_d_cp_cyy_to_coo + implicit none + + class(psb_d_cyy_sparse_mat), intent(in) :: a + class(psb_d_coo_sparse_mat), intent(inout) :: b + integer, intent(out) :: info + + integer, allocatable :: itemp(:) + !locals + logical :: rwshr_ + Integer :: nza, nr, nc,i,j,irw, idl,err_act + Integer, Parameter :: maxtry=8 + integer :: debug_level, debug_unit + character(len=20) :: name + + info = psb_success_ +end subroutine psb_d_cp_cyy_to_coo + +subroutine psb_d_mv_cyy_to_coo(a,b,info) + use psb_sparse_mod + use psb_d_cyy_mat_mod, psb_protect_name => psb_d_mv_cyy_to_coo + implicit none + + class(psb_d_cyy_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(inout) :: b + integer, intent(out) :: info + + integer, allocatable :: itemp(:) + !locals + logical :: rwshr_ + Integer :: nza, nr, nc,i,j,irw, idl,err_act + Integer, Parameter :: maxtry=8 + integer :: debug_level, debug_unit + character(len=20) :: name + + info = psb_success_ +end subroutine psb_d_mv_cyy_to_coo + +subroutine psb_d_mv_cyy_from_coo(a,b,info) + use psb_sparse_mod + use psb_d_cyy_mat_mod, psb_protect_name => psb_d_mv_cyy_from_coo + implicit none + + class(psb_d_cyy_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(inout) :: b + integer, intent(out) :: info + + integer, allocatable :: itemp(:) + !locals + logical :: rwshr_ + Integer :: nza, nr, i,j,irw, idl,err_act, nc + Integer, Parameter :: maxtry=8 + integer :: debug_level, debug_unit + character(len=20) :: name + + info = psb_success_ +end subroutine psb_d_mv_cyy_from_coo + +subroutine psb_d_mv_cyy_to_fmt(a,b,info) + use psb_sparse_mod + use psb_d_cyy_mat_mod, psb_protect_name => psb_d_mv_cyy_to_fmt + implicit none + + class(psb_d_cyy_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(inout) :: b + integer, intent(out) :: info + + !locals + type(psb_d_coo_sparse_mat) :: tmp + logical :: rwshr_ + Integer :: nza, nr, i,j,irw, idl,err_act, nc + Integer, Parameter :: maxtry=8 + integer :: debug_level, debug_unit + character(len=20) :: name + + info = psb_success_ + +end subroutine psb_d_mv_cyy_to_fmt + +subroutine psb_d_cp_cyy_to_fmt(a,b,info) + use psb_sparse_mod + use psb_d_cyy_mat_mod, psb_protect_name => psb_d_cp_cyy_to_fmt + implicit none + + class(psb_d_cyy_sparse_mat), intent(in) :: a + class(psb_d_base_sparse_mat), intent(inout) :: b + integer, intent(out) :: info + + !locals + type(psb_d_coo_sparse_mat) :: tmp + logical :: rwshr_ + Integer :: nza, nr, i,j,irw, idl,err_act, nc + Integer, Parameter :: maxtry=8 + integer :: debug_level, debug_unit + character(len=20) :: name + + info = psb_success_ +end subroutine psb_d_cp_cyy_to_fmt + +subroutine psb_d_mv_cyy_from_fmt(a,b,info) + use psb_sparse_mod + use psb_d_cyy_mat_mod, psb_protect_name => psb_d_mv_cyy_from_fmt + implicit none + + class(psb_d_cyy_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(inout) :: b + integer, intent(out) :: info + + !locals + type(psb_d_coo_sparse_mat) :: tmp + logical :: rwshr_ + Integer :: nza, nr, i,j,irw, idl,err_act, nc + Integer, Parameter :: maxtry=8 + integer :: debug_level, debug_unit + character(len=20) :: name + + info = psb_success_ + +end subroutine psb_d_mv_cyy_from_fmt + +subroutine psb_d_cp_cyy_from_fmt(a,b,info) + use psb_sparse_mod + use psb_d_cyy_mat_mod, psb_protect_name => psb_d_cp_cyy_from_fmt + implicit none + + class(psb_d_cyy_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(in) :: b + integer, intent(out) :: info + + !locals + type(psb_d_coo_sparse_mat) :: tmp + logical :: rwshr_ + Integer :: nz, nr, i,j,irw, idl,err_act, nc + Integer, Parameter :: maxtry=8 + integer :: debug_level, debug_unit + character(len=20) :: name + + info = psb_success_ +end subroutine psb_d_cp_cyy_from_fmt + +subroutine psb_d_cyy_cp_from(a,b) + use psb_sparse_mod + use psb_d_cyy_mat_mod, psb_protect_name => psb_d_cyy_cp_from + implicit none + + class(psb_d_cyy_sparse_mat), intent(inout) :: a + type(psb_d_cyy_sparse_mat), intent(in) :: b + Integer :: err_act, info + character(len=20) :: name='cp_from' + logical, parameter :: debug=.false. + + info = psb_success_ + +end subroutine psb_d_cyy_cp_from + +subroutine psb_d_cyy_mv_from(a,b) + use psb_sparse_mod + use psb_d_cyy_mat_mod, psb_protect_name => psb_d_cyy_mv_from + implicit none + + class(psb_d_cyy_sparse_mat), intent(inout) :: a + type(psb_d_cyy_sparse_mat), intent(inout) :: b + Integer :: err_act, info + character(len=20) :: name='mv_from' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ +end subroutine psb_d_cyy_mv_from + diff --git a/test/serial/psb_d_cyy_mat_mod.f03 b/test/serial/psb_d_cyy_mat_mod.f03 new file mode 100644 index 00000000..5c66a5b6 --- /dev/null +++ b/test/serial/psb_d_cyy_mat_mod.f03 @@ -0,0 +1,423 @@ +module psb_d_cyy_mat_mod + + use psb_d_base_mat_mod + + type, extends(psb_d_base_sparse_mat) :: psb_d_cyy_sparse_mat + + integer, allocatable :: irp(:), ja(:) + real(psb_dpk_), allocatable :: val(:) + + contains + procedure, pass(a) :: get_size => d_cyy_get_size + procedure, pass(a) :: get_nzeros => d_cyy_get_nzeros + procedure, pass(a) :: get_fmt => d_cyy_get_fmt + procedure, pass(a) :: sizeof => d_cyy_sizeof + procedure, pass(a) :: d_csmm => psb_d_cyy_csmm + procedure, pass(a) :: d_csmv => psb_d_cyy_csmv + procedure, pass(a) :: d_inner_cssm => psb_d_cyy_cssm + procedure, pass(a) :: d_inner_cssv => psb_d_cyy_cssv + procedure, pass(a) :: d_scals => psb_d_cyy_scals + procedure, pass(a) :: d_scal => psb_d_cyy_scal + procedure, pass(a) :: csnmi => psb_d_cyy_csnmi + procedure, pass(a) :: csnm1 => psb_d_cyy_csnm1 + procedure, pass(a) :: rowsum => psb_d_cyy_rowsum + procedure, pass(a) :: arwsum => psb_d_cyy_arwsum + procedure, pass(a) :: colsum => psb_d_cyy_colsum + procedure, pass(a) :: aclsum => psb_d_cyy_aclsum + procedure, pass(a) :: reallocate_nz => psb_d_cyy_reallocate_nz + procedure, pass(a) :: allocate_mnnz => psb_d_cyy_allocate_mnnz + procedure, pass(a) :: cp_to_coo => psb_d_cp_cyy_to_coo + procedure, pass(a) :: cp_from_coo => psb_d_cp_cyy_from_coo + procedure, pass(a) :: cp_to_fmt => psb_d_cp_cyy_to_fmt + procedure, pass(a) :: cp_from_fmt => psb_d_cp_cyy_from_fmt + procedure, pass(a) :: mv_to_coo => psb_d_mv_cyy_to_coo + procedure, pass(a) :: mv_from_coo => psb_d_mv_cyy_from_coo + procedure, pass(a) :: mv_to_fmt => psb_d_mv_cyy_to_fmt + procedure, pass(a) :: mv_from_fmt => psb_d_mv_cyy_from_fmt + procedure, pass(a) :: csput => psb_d_cyy_csput + procedure, pass(a) :: get_diag => psb_d_cyy_get_diag + procedure, pass(a) :: csgetptn => psb_d_cyy_csgetptn + procedure, pass(a) :: d_csgetrow => psb_d_cyy_csgetrow + procedure, pass(a) :: get_nz_row => d_cyy_get_nz_row + procedure, pass(a) :: reinit => psb_d_cyy_reinit + procedure, pass(a) :: trim => psb_d_cyy_trim + procedure, pass(a) :: print => psb_d_cyy_print + procedure, pass(a) :: free => d_cyy_free + procedure, pass(a) :: mold => psb_d_cyy_mold + procedure, pass(a) :: psb_d_cyy_cp_from + generic, public :: cp_from => psb_d_cyy_cp_from + procedure, pass(a) :: psb_d_cyy_mv_from + generic, public :: mv_from => psb_d_cyy_mv_from + + end type psb_d_cyy_sparse_mat + + private :: d_cyy_get_nzeros, d_cyy_free, d_cyy_get_fmt, & + & d_cyy_get_size, d_cyy_sizeof, d_cyy_get_nz_row + + interface + subroutine psb_d_cyy_reallocate_nz(nz,a) + import :: psb_d_cyy_sparse_mat + integer, intent(in) :: nz + class(psb_d_cyy_sparse_mat), intent(inout) :: a + end subroutine psb_d_cyy_reallocate_nz + end interface + + interface + subroutine psb_d_cyy_reinit(a,clear) + import :: psb_d_cyy_sparse_mat + class(psb_d_cyy_sparse_mat), intent(inout) :: a + logical, intent(in), optional :: clear + end subroutine psb_d_cyy_reinit + end interface + + interface + subroutine psb_d_cyy_trim(a) + import :: psb_d_cyy_sparse_mat + class(psb_d_cyy_sparse_mat), intent(inout) :: a + end subroutine psb_d_cyy_trim + end interface + + interface + subroutine psb_d_cyy_mold(a,b,info) + import :: psb_d_cyy_sparse_mat, psb_d_base_sparse_mat, psb_long_int_k_ + class(psb_d_cyy_sparse_mat), intent(in) :: a + class(psb_d_base_sparse_mat), intent(out), allocatable :: b + integer, intent(out) :: info + end subroutine psb_d_cyy_mold + end interface + + interface + subroutine psb_d_cyy_allocate_mnnz(m,n,a,nz) + import :: psb_d_cyy_sparse_mat + integer, intent(in) :: m,n + class(psb_d_cyy_sparse_mat), intent(inout) :: a + integer, intent(in), optional :: nz + end subroutine psb_d_cyy_allocate_mnnz + end interface + + interface + subroutine psb_d_cyy_print(iout,a,iv,eirs,eics,head,ivr,ivc) + import :: psb_d_cyy_sparse_mat + integer, intent(in) :: iout + class(psb_d_cyy_sparse_mat), intent(in) :: a + integer, intent(in), optional :: iv(:) + integer, intent(in), optional :: eirs,eics + character(len=*), optional :: head + integer, intent(in), optional :: ivr(:), ivc(:) + end subroutine psb_d_cyy_print + end interface + + interface + subroutine psb_d_cp_cyy_to_coo(a,b,info) + import :: psb_d_coo_sparse_mat, psb_d_cyy_sparse_mat + class(psb_d_cyy_sparse_mat), intent(in) :: a + class(psb_d_coo_sparse_mat), intent(inout) :: b + integer, intent(out) :: info + end subroutine psb_d_cp_cyy_to_coo + end interface + + interface + subroutine psb_d_cp_cyy_from_coo(a,b,info) + import :: psb_d_cyy_sparse_mat, psb_d_coo_sparse_mat + class(psb_d_cyy_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(in) :: b + integer, intent(out) :: info + end subroutine psb_d_cp_cyy_from_coo + end interface + + interface + subroutine psb_d_cp_cyy_to_fmt(a,b,info) + import :: psb_d_cyy_sparse_mat, psb_d_base_sparse_mat + class(psb_d_cyy_sparse_mat), intent(in) :: a + class(psb_d_base_sparse_mat), intent(inout) :: b + integer, intent(out) :: info + end subroutine psb_d_cp_cyy_to_fmt + end interface + + interface + subroutine psb_d_cp_cyy_from_fmt(a,b,info) + import :: psb_d_cyy_sparse_mat, psb_d_base_sparse_mat + class(psb_d_cyy_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(in) :: b + integer, intent(out) :: info + end subroutine psb_d_cp_cyy_from_fmt + end interface + + interface + subroutine psb_d_mv_cyy_to_coo(a,b,info) + import :: psb_d_cyy_sparse_mat, psb_d_coo_sparse_mat + class(psb_d_cyy_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(inout) :: b + integer, intent(out) :: info + end subroutine psb_d_mv_cyy_to_coo + end interface + + interface + subroutine psb_d_mv_cyy_from_coo(a,b,info) + import :: psb_d_cyy_sparse_mat, psb_d_coo_sparse_mat + class(psb_d_cyy_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(inout) :: b + integer, intent(out) :: info + end subroutine psb_d_mv_cyy_from_coo + end interface + + interface + subroutine psb_d_mv_cyy_to_fmt(a,b,info) + import :: psb_d_cyy_sparse_mat, psb_d_base_sparse_mat + class(psb_d_cyy_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(inout) :: b + integer, intent(out) :: info + end subroutine psb_d_mv_cyy_to_fmt + end interface + + interface + subroutine psb_d_mv_cyy_from_fmt(a,b,info) + import :: psb_d_cyy_sparse_mat, psb_d_base_sparse_mat + class(psb_d_cyy_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(inout) :: b + integer, intent(out) :: info + end subroutine psb_d_mv_cyy_from_fmt + end interface + + interface + subroutine psb_d_cyy_cp_from(a,b) + import :: psb_d_cyy_sparse_mat, psb_dpk_ + class(psb_d_cyy_sparse_mat), intent(inout) :: a + type(psb_d_cyy_sparse_mat), intent(in) :: b + end subroutine psb_d_cyy_cp_from + end interface + + interface + subroutine psb_d_cyy_mv_from(a,b) + import :: psb_d_cyy_sparse_mat, psb_dpk_ + class(psb_d_cyy_sparse_mat), intent(inout) :: a + type(psb_d_cyy_sparse_mat), intent(inout) :: b + end subroutine psb_d_cyy_mv_from + end interface + + + interface + subroutine psb_d_cyy_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + import :: psb_d_cyy_sparse_mat, psb_dpk_ + class(psb_d_cyy_sparse_mat), intent(inout) :: a + real(psb_dpk_), intent(in) :: val(:) + integer, intent(in) :: nz,ia(:), ja(:),& + & imin,imax,jmin,jmax + integer, intent(out) :: info + integer, intent(in), optional :: gtl(:) + end subroutine psb_d_cyy_csput + end interface + + interface + subroutine psb_d_cyy_csgetptn(imin,imax,a,nz,ia,ja,info,& + & jmin,jmax,iren,append,nzin,rscale,cscale) + import :: psb_d_cyy_sparse_mat, psb_dpk_ + class(psb_d_cyy_sparse_mat), intent(in) :: a + integer, intent(in) :: imin,imax + integer, intent(out) :: nz + integer, allocatable, intent(inout) :: ia(:), ja(:) + integer,intent(out) :: info + logical, intent(in), optional :: append + integer, intent(in), optional :: iren(:) + integer, intent(in), optional :: jmin,jmax, nzin + logical, intent(in), optional :: rscale,cscale + end subroutine psb_d_cyy_csgetptn + end interface + + interface + subroutine psb_d_cyy_csgetrow(imin,imax,a,nz,ia,ja,val,info,& + & jmin,jmax,iren,append,nzin,rscale,cscale) + import :: psb_d_cyy_sparse_mat, psb_dpk_ + class(psb_d_cyy_sparse_mat), intent(in) :: a + integer, intent(in) :: imin,imax + integer, intent(out) :: nz + integer, allocatable, intent(inout) :: ia(:), ja(:) + real(psb_dpk_), allocatable, intent(inout) :: val(:) + integer,intent(out) :: info + logical, intent(in), optional :: append + integer, intent(in), optional :: iren(:) + integer, intent(in), optional :: jmin,jmax, nzin + logical, intent(in), optional :: rscale,cscale + end subroutine psb_d_cyy_csgetrow + end interface + + interface + subroutine psb_d_cyy_csgetblk(imin,imax,a,b,info,& + & jmin,jmax,iren,append,rscale,cscale) + import :: psb_d_cyy_sparse_mat, psb_dpk_, psb_d_coo_sparse_mat + class(psb_d_cyy_sparse_mat), intent(in) :: a + class(psb_d_coo_sparse_mat), intent(inout) :: b + integer, intent(in) :: imin,imax + integer,intent(out) :: info + logical, intent(in), optional :: append + integer, intent(in), optional :: iren(:) + integer, intent(in), optional :: jmin,jmax + logical, intent(in), optional :: rscale,cscale + end subroutine psb_d_cyy_csgetblk + end interface + + interface + subroutine psb_d_cyy_cssv(alpha,a,x,beta,y,info,trans) + import :: psb_d_cyy_sparse_mat, psb_dpk_ + class(psb_d_cyy_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:) + real(psb_dpk_), intent(inout) :: y(:) + integer, intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_d_cyy_cssv + subroutine psb_d_cyy_cssm(alpha,a,x,beta,y,info,trans) + import :: psb_d_cyy_sparse_mat, psb_dpk_ + class(psb_d_cyy_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:,:) + real(psb_dpk_), intent(inout) :: y(:,:) + integer, intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_d_cyy_cssm + end interface + + interface + subroutine psb_d_cyy_csmv(alpha,a,x,beta,y,info,trans) + import :: psb_d_cyy_sparse_mat, psb_dpk_ + class(psb_d_cyy_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:) + real(psb_dpk_), intent(inout) :: y(:) + integer, intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_d_cyy_csmv + subroutine psb_d_cyy_csmm(alpha,a,x,beta,y,info,trans) + import :: psb_d_cyy_sparse_mat, psb_dpk_ + class(psb_d_cyy_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:,:) + real(psb_dpk_), intent(inout) :: y(:,:) + integer, intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_d_cyy_csmm + end interface + + + interface + function psb_d_cyy_csnmi(a) result(res) + import :: psb_d_cyy_sparse_mat, psb_dpk_ + class(psb_d_cyy_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + end function psb_d_cyy_csnmi + end interface + + interface + function psb_d_cyy_csnm1(a) result(res) + import :: psb_d_cyy_sparse_mat, psb_dpk_ + class(psb_d_cyy_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + end function psb_d_cyy_csnm1 + end interface + + interface + subroutine psb_d_cyy_rowsum(d,a) + import :: psb_d_cyy_sparse_mat, psb_dpk_ + class(psb_d_cyy_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(out) :: d(:) + end subroutine psb_d_cyy_rowsum + end interface + + interface + subroutine psb_d_cyy_arwsum(d,a) + import :: psb_d_cyy_sparse_mat, psb_dpk_ + class(psb_d_cyy_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(out) :: d(:) + end subroutine psb_d_cyy_arwsum + end interface + + interface + subroutine psb_d_cyy_colsum(d,a) + import :: psb_d_cyy_sparse_mat, psb_dpk_ + class(psb_d_cyy_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(out) :: d(:) + end subroutine psb_d_cyy_colsum + end interface + + interface + subroutine psb_d_cyy_aclsum(d,a) + import :: psb_d_cyy_sparse_mat, psb_dpk_ + class(psb_d_cyy_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(out) :: d(:) + end subroutine psb_d_cyy_aclsum + end interface + + interface + subroutine psb_d_cyy_get_diag(a,d,info) + import :: psb_d_cyy_sparse_mat, psb_dpk_ + class(psb_d_cyy_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(out) :: d(:) + integer, intent(out) :: info + end subroutine psb_d_cyy_get_diag + end interface + + interface + subroutine psb_d_cyy_scal(d,a,info) + import :: psb_d_cyy_sparse_mat, psb_dpk_ + class(psb_d_cyy_sparse_mat), intent(inout) :: a + real(psb_dpk_), intent(in) :: d(:) + integer, intent(out) :: info + end subroutine psb_d_cyy_scal + end interface + + interface + subroutine psb_d_cyy_scals(d,a,info) + import :: psb_d_cyy_sparse_mat, psb_dpk_ + class(psb_d_cyy_sparse_mat), intent(inout) :: a + real(psb_dpk_), intent(in) :: d + integer, intent(out) :: info + end subroutine psb_d_cyy_scals + end interface + + + +contains + + function d_cyy_sizeof(a) result(res) + implicit none + class(psb_d_cyy_sparse_mat), intent(in) :: a + integer(psb_long_int_k_) :: res + res = 0 + end function d_cyy_sizeof + + function d_cyy_get_fmt(a) result(res) + implicit none + class(psb_d_cyy_sparse_mat), intent(in) :: a + character(len=5) :: res + res = 'CYY' + end function d_cyy_get_fmt + + function d_cyy_get_nzeros(a) result(res) + implicit none + class(psb_d_cyy_sparse_mat), intent(in) :: a + integer :: res + res = 0 + end function d_cyy_get_nzeros + + function d_cyy_get_size(a) result(res) + implicit none + class(psb_d_cyy_sparse_mat), intent(in) :: a + integer :: res + res = 0 + end function d_cyy_get_size + + + + function d_cyy_get_nz_row(idx,a) result(res) + + implicit none + + class(psb_d_cyy_sparse_mat), intent(in) :: a + integer, intent(in) :: idx + integer :: res + res = 0 + end function d_cyy_get_nz_row + + subroutine d_cyy_free(a) + implicit none + class(psb_d_cyy_sparse_mat), intent(inout) :: a + return + end subroutine d_cyy_free + +end module psb_d_cyy_mat_mod diff --git a/test/serial/psb_d_czz_mat_mod.f03 b/test/serial/psb_d_czz_mat_mod.f03 new file mode 100644 index 00000000..ca51a23c --- /dev/null +++ b/test/serial/psb_d_czz_mat_mod.f03 @@ -0,0 +1,13 @@ +module psb_d_czz_mat_mod + + use psb_d_base_mat_mod + + type, extends(psb_d_base_sparse_mat) :: psb_d_czz_sparse_mat + + integer, allocatable :: irp(:), ja(:) + real(psb_dpk_), allocatable :: val(:) + + contains + end type psb_d_czz_sparse_mat +contains +end module psb_d_czz_mat_mod