diff --git a/test/pargen/ppde.f90 b/test/pargen/ppde.f90 index b13a7c70..25bb26e9 100644 --- a/test/pargen/ppde.f90 +++ b/test/pargen/ppde.f90 @@ -65,7 +65,7 @@ program ppde use psb_base_mod use psb_prec_mod use psb_krylov_mod - use psbn_d_mat_mod + use psb_d_mat_mod implicit none ! input parameters @@ -78,7 +78,7 @@ program ppde real(psb_dpk_) :: t1, t2, tprec ! sparse matrix and preconditioner - type(psbn_d_sparse_mat) :: a + type(psb_d_sparse_mat) :: a !!$ type(psb_dspmat_type) :: a type(psb_dprec_type) :: prec ! descriptor @@ -343,8 +343,8 @@ contains ! Note that if a1=a2=a3=a4=0., the PDE is the well-known Laplace equation. ! use psb_base_mod - use psbn_d_mat_mod - use psbn_d_csc_mat_mod + use psb_d_mat_mod + use psb_d_csc_mat_mod implicit none integer :: idim integer, parameter :: nb=20 @@ -352,10 +352,10 @@ contains type(psb_desc_type) :: desc_a integer :: ictxt, info character :: afmt*5 - type(psbn_d_sparse_mat) :: a - type(psbn_d_csc_sparse_mat) :: acsc - type(psbn_d_coo_sparse_mat) :: acoo - type(psbn_d_csr_sparse_mat) :: acsr + type(psb_d_sparse_mat) :: a + type(psb_d_csc_sparse_mat) :: acsc + type(psb_d_coo_sparse_mat) :: acoo + type(psb_d_csr_sparse_mat) :: acsr real(psb_dpk_) :: zt(nb),glob_x,glob_y,glob_z integer :: m,n,nnz,glob_row,nlr,i,ii,ib,k integer :: x,y,z,ia,indx_owner diff --git a/test/pargen/psbn_d_csc_impl.f03 b/test/pargen/psbn_d_csc_impl.f03 new file mode 100644 index 00000000..333b1b20 --- /dev/null +++ b/test/pargen/psbn_d_csc_impl.f03 @@ -0,0 +1,1822 @@ + +!===================================== +! +! +! +! Computational routines +! +! +! +! +! +! +!===================================== + +subroutine d_csc_csmv_impl(alpha,a,x,beta,y,info,trans) + use psb_error_mod + use psb_d_csc_mat_mod, psb_protect_name => d_csc_csmv_impl + implicit none + class(psb_d_csc_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_csc_csmv' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = 0 + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = 1121 + call psb_errpush(info,name) + goto 9999 + endif + + + tra = ((trans_=='T').or.(trans_=='t')) + + if (tra) then + m = a%get_ncols() + n = a%get_nrows() + else + n = a%get_ncols() + m = a%get_nrows() + end if + + + if (alpha == dzero) then + if (beta == dzero) then + do i = 1, m + y(i) = dzero + enddo + else + do i = 1, m + y(i) = beta*y(i) + end do + endif + return + end if + + if (tra) then + + if (beta == dzero) then + + if (alpha == done) then + do i=1,m + acc = dzero + do j=a%icp(i), a%icp(i+1)-1 + acc = acc + a%val(j) * x(a%ia(j)) + enddo + y(i) = acc + end do + + else if (alpha == -done) then + + do i=1,m + acc = dzero + do j=a%icp(i), a%icp(i+1)-1 + acc = acc + a%val(j) * x(a%ia(j)) + enddo + y(i) = -acc + end do + + else + + do i=1,m + acc = dzero + do j=a%icp(i), a%icp(i+1)-1 + acc = acc + a%val(j) * x(a%ia(j)) + enddo + y(i) = alpha*acc + end do + + end if + + + else if (beta == done) then + + if (alpha == done) then + do i=1,m + acc = dzero + do j=a%icp(i), a%icp(i+1)-1 + acc = acc + a%val(j) * x(a%ia(j)) + enddo + y(i) = y(i) + acc + end do + + else if (alpha == -done) then + + do i=1,m + acc = dzero + do j=a%icp(i), a%icp(i+1)-1 + acc = acc + a%val(j) * x(a%ia(j)) + enddo + y(i) = y(i) -acc + end do + + else + + do i=1,m + acc = dzero + do j=a%icp(i), a%icp(i+1)-1 + acc = acc + a%val(j) * x(a%ia(j)) + enddo + y(i) = y(i) + alpha*acc + end do + + end if + + else if (beta == -done) then + + if (alpha == done) then + do i=1,m + acc = dzero + do j=a%icp(i), a%icp(i+1)-1 + acc = acc + a%val(j) * x(a%ia(j)) + enddo + y(i) = -y(i) + acc + end do + + else if (alpha == -done) then + + do i=1,m + acc = dzero + do j=a%icp(i), a%icp(i+1)-1 + acc = acc + a%val(j) * x(a%ia(j)) + enddo + y(i) = -y(i) -acc + end do + + else + + do i=1,m + acc = dzero + do j=a%icp(i), a%icp(i+1)-1 + acc = acc + a%val(j) * x(a%ia(j)) + enddo + y(i) = -y(i) + alpha*acc + end do + + end if + + else + + if (alpha == done) then + do i=1,m + acc = dzero + do j=a%icp(i), a%icp(i+1)-1 + acc = acc + a%val(j) * x(a%ia(j)) + enddo + y(i) = beta*y(i) + acc + end do + + else if (alpha == -done) then + + do i=1,m + acc = dzero + do j=a%icp(i), a%icp(i+1)-1 + acc = acc + a%val(j) * x(a%ia(j)) + enddo + y(i) = beta*y(i) - acc + end do + + else + + do i=1,m + acc = dzero + do j=a%icp(i), a%icp(i+1)-1 + acc = acc + a%val(j) * x(a%ia(j)) + enddo + y(i) = beta*y(i) + alpha*acc + end do + + end if + + end if + + else if (.not.tra) then + + if (beta == dzero) then + do i=1, m + y(i) = dzero + end do + else if (beta == done) then + ! Do nothing + else if (beta == -done) then + do i=1, m + y(i) = -y(i) + end do + else + do i=1, m + y(i) = beta*y(i) + end do + end if + + if (alpha.eq.done) then + + do i=1,n + do j=a%icp(i), a%icp(i+1)-1 + ir = a%ia(j) + y(ir) = y(ir) + a%val(j)*x(i) + end do + enddo + + else if (alpha.eq.-done) then + + do i=1,n + do j=a%icp(i), a%icp(i+1)-1 + ir = a%ia(j) + y(ir) = y(ir) - a%val(j)*x(i) + end do + enddo + + else + + do i=1,n + do j=a%icp(i), a%icp(i+1)-1 + ir = a%ia(j) + y(ir) = y(ir) + alpha*a%val(j)*x(i) + end do + enddo + + end if + + endif + + if (a%is_triangle().and.a%is_unit()) then + do i=1, min(m,n) + y(i) = y(i) + alpha*x(i) + end do + end if + + call psb_erractionrestore(err_act) + return +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + +end subroutine d_csc_csmv_impl + +subroutine d_csc_csmm_impl(alpha,a,x,beta,y,info,trans) + use psb_error_mod + use psb_d_csc_mat_mod, psb_protect_name => d_csc_csmm_impl + implicit none + class(psb_d_csc_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_csc_csmm' + logical, parameter :: debug=.false. + + info = 0 + call psb_erractionsave(err_act) + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + tra = ((trans_=='T').or.(trans_=='t')) + if (.not.a%is_asb()) then + info = 1121 + call psb_errpush(info,name) + goto 9999 + endif + + if (tra) then + m = a%get_ncols() + n = a%get_nrows() + else + n = a%get_ncols() + m = a%get_nrows() + end if + + nc = min(size(x,2) , size(y,2) ) + + allocate(acc(nc), stat=info) + if(info /= 0) then + info=4010 + call psb_errpush(info,name,a_err='allocate') + goto 9999 + end if + + if (alpha == dzero) then + if (beta == dzero) then + do i = 1, m + y(i,:) = dzero + enddo + else + do i = 1, m + y(i,:) = beta*y(i,:) + end do + endif + return + end if + + if (tra) then + + if (beta == dzero) then + + if (alpha == done) then + do i=1,m + acc = dzero + do j=a%icp(i), a%icp(i+1)-1 + acc = acc + a%val(j) * x(a%ia(j),:) + enddo + y(i,:) = acc + end do + + else if (alpha == -done) then + + do i=1,m + acc = dzero + do j=a%icp(i), a%icp(i+1)-1 + acc = acc + a%val(j) * x(a%ia(j),:) + enddo + y(i,:) = -acc + end do + + else + + do i=1,m + acc = dzero + do j=a%icp(i), a%icp(i+1)-1 + acc = acc + a%val(j) * x(a%ia(j),:) + enddo + y(i,:) = alpha*acc + end do + + end if + + + else if (beta == done) then + + if (alpha == done) then + do i=1,m + acc = dzero + do j=a%icp(i), a%icp(i+1)-1 + acc = acc + a%val(j) * x(a%ia(j),:) + enddo + y(i,:) = y(i,:) + acc + end do + + else if (alpha == -done) then + + do i=1,m + acc = dzero + do j=a%icp(i), a%icp(i+1)-1 + acc = acc + a%val(j) * x(a%ia(j),:) + enddo + y(i,:) = y(i,:) -acc + end do + + else + + do i=1,m + acc = dzero + do j=a%icp(i), a%icp(i+1)-1 + acc = acc + a%val(j) * x(a%ia(j),:) + enddo + y(i,:) = y(i,:) + alpha*acc + end do + + end if + + else if (beta == -done) then + + if (alpha == done) then + do i=1,m + acc = dzero + do j=a%icp(i), a%icp(i+1)-1 + acc = acc + a%val(j) * x(a%ia(j),:) + enddo + y(i,:) = -y(i,:) + acc + end do + + else if (alpha == -done) then + + do i=1,m + acc = dzero + do j=a%icp(i), a%icp(i+1)-1 + acc = acc + a%val(j) * x(a%ia(j),:) + enddo + y(i,:) = -y(i,:) -acc + end do + + else + + do i=1,m + acc = dzero + do j=a%icp(i), a%icp(i+1)-1 + acc = acc + a%val(j) * x(a%ia(j),:) + enddo + y(i,:) = -y(i,:) + alpha*acc + end do + + end if + + else + + if (alpha == done) then + do i=1,m + acc = dzero + do j=a%icp(i), a%icp(i+1)-1 + acc = acc + a%val(j) * x(a%ia(j),:) + enddo + y(i,:) = beta*y(i,:) + acc + end do + + else if (alpha == -done) then + + do i=1,m + acc = dzero + do j=a%icp(i), a%icp(i+1)-1 + acc = acc + a%val(j) * x(a%ia(j),:) + enddo + y(i,:) = beta*y(i,:) - acc + end do + + else + + do i=1,m + acc = dzero + do j=a%icp(i), a%icp(i+1)-1 + acc = acc + a%val(j) * x(a%ia(j),:) + enddo + y(i,:) = beta*y(i,:) + alpha*acc + end do + + end if + + end if + + else if (.not.tra) then + + if (beta == dzero) then + do i=1, m + y(i,:) = dzero + end do + else if (beta == done) then + ! Do nothing + else if (beta == -done) then + do i=1, m + y(i,:) = -y(i,:) + end do + else + do i=1, m + y(i,:) = beta*y(i,:) + end do + end if + + if (alpha.eq.done) then + + do i=1,n + do j=a%icp(i), a%icp(i+1)-1 + ir = a%ia(j) + y(ir,:) = y(ir,:) + a%val(j)*x(i,:) + end do + enddo + + else if (alpha.eq.-done) then + + do i=1,n + do j=a%icp(i), a%icp(i+1)-1 + ir = a%ia(j) + y(ir,:) = y(ir,:) - a%val(j)*x(i,:) + end do + enddo + + else + + do i=1,n + do j=a%icp(i), a%icp(i+1)-1 + ir = a%ia(j) + y(ir,:) = y(ir,:) + alpha*a%val(j)*x(i,:) + end do + enddo + + end if + + endif + + if (a%is_triangle().and.a%is_unit()) then + do i=1, min(m,n) + y(i,:) = y(i,:) + alpha*x(i,:) + end do + end if + + call psb_erractionrestore(err_act) + return +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + +end subroutine d_csc_csmm_impl + + +subroutine d_csc_cssv_impl(alpha,a,x,beta,y,info,trans) + use psb_error_mod + use psb_d_csc_mat_mod, psb_protect_name => d_csc_cssv_impl + implicit none + class(psb_d_csc_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_csc_cssv' + logical, parameter :: debug=.false. + + info = 0 + call psb_erractionsave(err_act) + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + if (.not.a%is_asb()) then + info = 1121 + call psb_errpush(info,name) + goto 9999 + endif + + tra = ((trans_=='T').or.(trans_=='t')) + m = a%get_nrows() + + if (.not. (a%is_triangle())) then + info = 1121 + call psb_errpush(info,name) + goto 9999 + end if + + + if (alpha == dzero) then + if (beta == dzero) then + do i = 1, m + y(i) = dzero + enddo + else + do i = 1, m + y(i) = beta*y(i) + end do + endif + return + end if + + if (beta == dzero) then + call inner_cscsv(tra,a%is_lower(),a%is_unit(),a%get_nrows(),& + & a%icp,a%ia,a%val,x,y) + if (alpha == done) then + ! do nothing + else if (alpha == -done) then + do i = 1, m + y(i) = -y(i) + end do + else + do i = 1, m + y(i) = alpha*y(i) + end do + end if + else + allocate(tmp(m), stat=info) + if (info /= 0) then + return + end if + tmp(1:m) = x(1:m) + call inner_cscsv(tra,a%is_lower(),a%is_unit(),a%get_nrows(),& + & a%icp,a%ia,a%val,tmp,y) + do i = 1, m + y(i) = alpha*tmp(i) + beta*y(i) + end do + end if + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + +contains + + subroutine inner_cscsv(tra,lower,unit,n,icp,ia,val,x,y) + implicit none + logical, intent(in) :: tra,lower,unit + integer, intent(in) :: icp(*), ia(*),n + real(psb_dpk_), intent(in) :: val(*) + real(psb_dpk_), intent(in) :: x(*) + real(psb_dpk_), intent(out) :: y(*) + + integer :: i,j,k,m, ir, jc + real(psb_dpk_) :: acc + + if (tra) then + + if (lower) then + if (unit) then + do i=1, n + acc = dzero + do j=icp(i), icp(i+1)-1 + acc = acc + val(j)*y(ia(j)) + end do + y(i) = x(i) - acc + end do + else if (.not.unit) then + do i=1, n + acc = dzero + do j=icp(i), icp(i+1)-2 + acc = acc + val(j)*y(ia(j)) + end do + y(i) = (x(i) - acc)/val(icp(i+1)-1) + end do + end if + else if (.not.lower) then + + if (unit) then + do i=n, 1, -1 + acc = dzero + do j=icp(i), icp(i+1)-1 + acc = acc + val(j)*y(ia(j)) + end do + y(i) = x(i) - acc + end do + else if (.not.unit) then + do i=n, 1, -1 + acc = dzero + do j=icp(i)+1, icp(i+1)-1 + acc = acc + val(j)*y(ia(j)) + end do + y(i) = (x(i) - acc)/val(icp(i)) + end do + end if + + end if + + else if (.not.tra) then + + do i=1, n + y(i) = x(i) + end do + + if (lower) then + if (unit) then + do i=n, 1, -1 + acc = y(i) + do j=icp(i), icp(i+1)-1 + jc = ia(j) + y(jc) = y(jc) - val(j)*acc + end do + end do + else if (.not.unit) then + do i=n, 1, -1 + y(i) = y(i)/val(icp(i+1)-1) + acc = y(i) + do j=icp(i), icp(i+1)-2 + jc = ia(j) + y(jc) = y(jc) - val(j)*acc + end do + end do + end if + else if (.not.lower) then + + if (unit) then + do i=1, n + acc = y(i) + do j=icp(i), icp(i+1)-1 + jc = ia(j) + y(jc) = y(jc) - val(j)*acc + end do + end do + else if (.not.unit) then + do i=1, n + y(i) = y(i)/val(icp(i)) + acc = y(i) + do j=icp(i)+1, icp(i+1)-1 + jc = ia(j) + y(jc) = y(jc) - val(j)*acc + end do + end do + end if + + end if + end if + end subroutine inner_cscsv + +end subroutine d_csc_cssv_impl + + + +subroutine d_csc_cssm_impl(alpha,a,x,beta,y,info,trans) + use psb_error_mod + use psb_d_csc_mat_mod, psb_protect_name => d_csc_cssm_impl + implicit none + class(psb_d_csc_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_base_csmm' + logical, parameter :: debug=.false. + + info = 0 + call psb_erractionsave(err_act) + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + if (.not.a%is_asb()) then + info = 1121 + call psb_errpush(info,name) + goto 9999 + endif + + + tra = ((trans_=='T').or.(trans_=='t')) + m = a%get_nrows() + nc = min(size(x,2) , size(y,2)) + + if (.not. (a%is_triangle())) then + info = 1121 + call psb_errpush(info,name) + goto 9999 + end if + + + if (alpha == dzero) then + if (beta == dzero) then + do i = 1, m + y(i,:) = dzero + enddo + else + do i = 1, m + y(i,:) = beta*y(i,:) + end do + endif + return + end if + + if (beta == dzero) then + call inner_cscsm(tra,a%is_lower(),a%is_unit(),a%get_nrows(),nc,& + & a%icp,a%ia,a%val,x,size(x,1),y,size(y,1),info) + do i = 1, m + y(i,1:nc) = alpha*y(i,1:nc) + end do + else + allocate(tmp(m,nc), stat=info) + if(info /= 0) then + info=4010 + call psb_errpush(info,name,a_err='allocate') + goto 9999 + end if + + tmp(1:m,:) = x(1:m,1:nc) + call inner_cscsm(tra,a%is_lower(),a%is_unit(),a%get_nrows(),nc,& + & a%icp,a%ia,a%val,tmp,size(tmp,1),y,size(y,1),info) + do i = 1, m + y(i,1:nc) = alpha*tmp(i,1:nc) + beta*y(i,1:nc) + end do + end if + + if(info /= 0) then + info=4010 + call psb_errpush(info,name,a_err='inner_cscsm') + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + + +contains + + subroutine inner_cscsm(tra,lower,unit,nr,nc,& + & icp,ia,val,x,ldx,y,ldy,info) + implicit none + logical, intent(in) :: tra,lower,unit + integer, intent(in) :: nr,nc,ldx,ldy,icp(*),ia(*) + real(psb_dpk_), intent(in) :: val(*), x(ldx,*) + real(psb_dpk_), intent(out) :: y(ldy,*) + integer, intent(out) :: info + integer :: i,j,k,m, ir, jc + real(psb_dpk_), allocatable :: acc(:) + + info = 0 + allocate(acc(nc), stat=info) + if(info /= 0) then + info=4010 + return + end if + + + if (tra) then + + if (lower) then + if (unit) then + do i=1, nr + acc = dzero + do j=a%icp(i), a%icp(i+1)-1 + acc = acc + a%val(j)*y(a%ia(j),1:nc) + end do + y(i,1:nc) = x(i,1:nc) - acc + end do + else if (.not.unit) then + do i=1, nr + acc = dzero + do j=a%icp(i), a%icp(i+1)-2 + acc = acc + a%val(j)*y(a%ia(j),1:nc) + end do + y(i,1:nc) = (x(i,1:nc) - acc)/a%val(a%icp(i+1)-1) + end do + end if + else if (.not.lower) then + + if (unit) then + do i=nr, 1, -1 + acc = dzero + do j=a%icp(i), a%icp(i+1)-1 + acc = acc + a%val(j)*y(a%ia(j),1:nc) + end do + y(i,1:nc) = x(i,1:nc) - acc + end do + else if (.not.unit) then + do i=nr, 1, -1 + acc = dzero + do j=a%icp(i)+1, a%icp(i+1)-1 + acc = acc + a%val(j)*y(a%ia(j),1:nc) + end do + y(i,1:nc) = (x(i,1:nc) - acc)/a%val(a%icp(i)) + end do + end if + + end if + + else if (.not.tra) then + + do i=1, nr + y(i,1:nc) = x(i,1:nc) + end do + + if (lower) then + if (unit) then + do i=nr, 1, -1 + acc = y(i,1:nc) + do j=a%icp(i), a%icp(i+1)-1 + jc = a%ia(j) + y(jc,1:nc) = y(jc,1:nc) - a%val(j)*acc + end do + end do + else if (.not.unit) then + do i=nr, 1, -1 + y(i,1:nc) = y(i,1:nc)/a%val(a%icp(i+1)-1) + acc = y(i,1:nc) + do j=a%icp(i), a%icp(i+1)-2 + jc = a%ia(j) + y(jc,1:nc) = y(jc,1:nc) - a%val(j)*acc + end do + end do + end if + else if (.not.lower) then + + if (unit) then + do i=1, nr + acc = y(i,1:nc) + do j=a%icp(i), a%icp(i+1)-1 + jc = a%ia(j) + y(jc,1:nc) = y(jc,1:nc) - a%val(j)*acc + end do + end do + else if (.not.unit) then + do i=1, nr + y(i,1:nc) = y(i,1:nc)/a%val(a%icp(i)) + acc = y(i,1:nc) + do j=a%icp(i)+1, a%icp(i+1)-1 + jc = a%ia(j) + y(jc,1:nc) = y(jc,1:nc) - a%val(j)*acc + end do + end do + end if + + end if + end if + end subroutine inner_cscsm + +end subroutine d_csc_cssm_impl + +function d_csc_csnmi_impl(a) result(res) + use psb_error_mod + use psb_d_csc_mat_mod, psb_protect_name => d_csc_csnmi_impl + implicit none + class(psb_d_csc_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + + integer :: i,j,k,m,n, nr, ir, jc, nc, info + real(psb_dpk_), allocatable :: acc(:) + logical :: tra + Integer :: err_act + character(len=20) :: name='d_csnmi' + logical, parameter :: debug=.false. + + + res = dzero + nr = a%get_nrows() + nc = a%get_ncols() + allocate(acc(nr),stat=info) + if (info /= 0) then + return + end if + acc(:) = dzero + do i=1, nc + do j=a%icp(i),a%icp(i+1)-1 + acc(a%ia(j)) = acc(a%ia(j)) + abs(a%val(j)) + end do + end do + do i=1, nr + res = max(res,acc(i)) + end do + deallocate(acc) + +end function d_csc_csnmi_impl + +!===================================== +! +! +! +! Data management +! +! +! +! +! +!===================================== + + +subroutine d_csc_csgetrow_impl(imin,imax,a,nz,ia,ja,val,info,& + & jmin,jmax,iren,append,nzin,rscale,cscale) + ! Output is always in COO format + use psb_error_mod + use psb_const_mod + use psb_error_mod + use psb_d_base_mat_mod + use psb_d_csc_mat_mod, psb_protect_name => d_csc_csgetrow_impl + implicit none + + class(psb_d_csc_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 = 0 + + if (present(jmin)) then + jmin_ = jmin + else + jmin_ = 1 + endif + if (present(jmax)) then + jmax_ = jmax + else + jmax_ = a%get_ncols() + endif + + if ((imaxisz) then + call psb_ensure_size(int(1.25*nzin_)+1,ia,info) + call psb_ensure_size(int(1.25*nzin_)+1,ja,info) + call psb_ensure_size(int(1.25*nzin_)+1,val,info) + isz = min(size(ia),size(ja),size(val)) + end if + nz = nz + 1 + val(nzin_) = a%val(j) + ia(nzin_) = iren(a%ia(j)) + ja(nzin_) = iren(i) + end if + enddo + end do + else + do i=icl, lcl + do j=a%icp(i), a%icp(i+1) - 1 + if ((imin <= a%ia(j)).and.(a%ia(j)<=imax)) then + nzin_ = nzin_ + 1 + if (nzin_>isz) then + call psb_ensure_size(int(1.25*nzin_)+1,ia,info) + call psb_ensure_size(int(1.25*nzin_)+1,ja,info) + call psb_ensure_size(int(1.25*nzin_)+1,val,info) + isz = min(size(ia),size(ja),size(val)) + end if + nz = nz + 1 + val(nzin_) = a%val(j) + ia(nzin_) = (a%ia(j)) + ja(nzin_) = (i) + end if + enddo + end do + end if + end subroutine csc_getrow + +end subroutine d_csc_csgetrow_impl + + + +subroutine d_csc_csput_impl(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + use psb_error_mod + use psb_realloc_mod + use psb_d_csc_mat_mod, psb_protect_name => d_csc_csput_impl + implicit none + + class(psb_d_csc_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_csc_csput' + logical, parameter :: debug=.false. + integer :: nza, i,j,k, nzl, isza, int_err(5) + + info = 0 + nza = a%get_nzeros() + + if (a%is_bld()) then + ! Build phase should only ever be in COO + info = 1121 + + else if (a%is_upd()) then + call d_csc_srch_upd(nz,ia,ja,val,a,& + & imin,imax,jmin,jmax,info,gtl) + + if (info /= 0) then + + info = 1121 + end if + + else + ! State is wrong. + info = 1121 + end if + if (info /= 0) then + call psb_errpush(info,name) + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + + +contains + + subroutine d_csc_srch_upd(nz,ia,ja,val,a,& + & imin,imax,jmin,jmax,info,gtl) + + use psb_const_mod + use psb_realloc_mod + use psb_string_mod + use psb_sort_mod + implicit none + + class(psb_d_csc_sparse_mat), intent(inout) :: a + integer, intent(in) :: nz, imin,imax,jmin,jmax + integer, intent(in) :: ia(:),ja(:) + real(psb_dpk_), intent(in) :: val(:) + integer, intent(out) :: info + integer, intent(in), optional :: gtl(:) + integer :: i,ir,ic, ilr, ilc, ip, & + & i1,i2,nr,nc,nnz,dupl,ng, nar, nac + integer :: debug_level, debug_unit + character(len=20) :: name='d_csc_srch_upd' + + info = 0 + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + dupl = a%get_dupl() + + if (.not.a%is_sorted()) then + info = -4 + return + end if + + ilr = -1 + ilc = -1 + nnz = a%get_nzeros() + nar = a%get_nrows() + nac = a%get_ncols() + + if (present(gtl)) then + ng = size(gtl) + + select case(dupl) + case(psb_dupl_ovwrt_,psb_dupl_err_) + ! Overwrite. + ! Cannot test for error, should have been caught earlier. + + ilr = -1 + ilc = -1 + do i=1, nz + ir = ia(i) + ic = ja(i) + if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then + ir = gtl(ir) + ic = gtl(ic) + if ((ic > 0).and.(ic <= nac)) then + i1 = a%icp(ic) + i2 = a%icp(ic+1) + nr=i2-i1 + + ip = psb_ibsrch(ir,nr,a%ia(i1:i2-1)) + if (ip>0) then + a%val(i1+ip-1) = val(i) + else + if (debug_level >= psb_debug_serial_) & + & write(debug_unit,*) trim(name),& + & ': Was searching ',ir,' in: ',i1,i2,& + & ' : ',a%ia(i1:i2-1) + info = i + return + end if + + else + + if (debug_level >= psb_debug_serial_) & + & write(debug_unit,*) trim(name),& + & ': Discarding row that does not belong to us.' + end if + end if + end do + + case(psb_dupl_add_) + ! Add + ilr = -1 + ilc = -1 + do i=1, nz + ir = ia(i) + ic = ja(i) + if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then + ir = gtl(ir) + ic = gtl(ic) + if ((ic > 0).and.(ic <= nac)) then + i1 = a%icp(ic) + i2 = a%icp(ic+1) + nr=i2-i1 + + ip = psb_ibsrch(ir,nr,a%ia(i1:i2-1)) + if (ip>0) then + a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) + else + if (debug_level >= psb_debug_serial_) & + & write(debug_unit,*) trim(name),& + & ': Was searching ',ir,' in: ',i1,i2,& + & ' : ',a%ia(i1:i2-1) + info = i + return + end if + else + if (debug_level >= psb_debug_serial_) & + & write(debug_unit,*) trim(name),& + & ': Discarding row that does not belong to us.' + end if + + end if + end do + + case default + info = -3 + if (debug_level >= psb_debug_serial_) & + & write(debug_unit,*) trim(name),& + & ': Duplicate handling: ',dupl + end select + + else + + select case(dupl) + case(psb_dupl_ovwrt_,psb_dupl_err_) + ! Overwrite. + ! Cannot test for error, should have been caught earlier. + + ilr = -1 + ilc = -1 + do i=1, nz + ir = ia(i) + ic = ja(i) + + if ((ic > 0).and.(ic <= nac)) then + i1 = a%icp(ic) + i2 = a%icp(ic+1) + nr=i2-i1 + + ip = psb_ibsrch(ir,nr,a%ia(i1:i2-1)) + if (ip>0) then + a%val(i1+ip-1) = val(i) + else + if (debug_level >= psb_debug_serial_) & + & write(debug_unit,*) trim(name),& + & ': Was searching ',ir,' in: ',i1,i2,& + & ' : ',a%ia(i1:i2-1) + info = i + return + end if + + else + if (debug_level >= psb_debug_serial_) & + & write(debug_unit,*) trim(name),& + & ': Discarding col that does not belong to us.' + end if + + end do + + case(psb_dupl_add_) + ! Add + ilr = -1 + ilc = -1 + do i=1, nz + ir = ia(i) + ic = ja(i) + if ((ic > 0).and.(ic <= nac)) then + i1 = a%icp(ic) + i2 = a%icp(ic+1) + nr=i2-i1 + + ip = psb_ibsrch(ir,nr,a%ia(i1:i2-1)) + if (ip>0) then + a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) + else + if (debug_level >= psb_debug_serial_) & + & write(debug_unit,*) trim(name),& + & ': Was searching ',ir,' in: ',i1,i2,& + & ' : ',a%ia(i1:i2-1) + info = i + return + end if + else + if (debug_level >= psb_debug_serial_) & + & write(debug_unit,*) trim(name),& + & ': Discarding col that does not belong to us.' + end if + end do + + case default + info = -3 + if (debug_level >= psb_debug_serial_) & + & write(debug_unit,*) trim(name),& + & ': Duplicate handling: ',dupl + end select + + end if + + end subroutine d_csc_srch_upd + +end subroutine d_csc_csput_impl + + + +subroutine d_cp_csc_from_coo_impl(a,b,info) + use psb_const_mod + use psb_realloc_mod + use psb_d_base_mat_mod + use psb_d_csc_mat_mod, psb_protect_name => d_cp_csc_from_coo_impl + implicit none + + class(psb_d_csc_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 = 0 + ! This is to have fix_coo called behind the scenes + call tmp%cp_from_coo(b,info) + if (info ==0) call a%mv_from_coo(tmp,info) + +end subroutine d_cp_csc_from_coo_impl + + + +subroutine d_cp_csc_to_coo_impl(a,b,info) + use psb_const_mod + use psb_d_base_mat_mod + use psb_d_csc_mat_mod, psb_protect_name => d_cp_csc_to_coo_impl + implicit none + + class(psb_d_csc_sparse_mat), intent(in) :: a + class(psb_d_coo_sparse_mat), intent(out) :: 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 = 0 + + nr = a%get_nrows() + nc = a%get_ncols() + nza = a%get_nzeros() + + call b%allocate(nr,nc,nza) + + do i=1, nc + do j=a%icp(i),a%icp(i+1)-1 + b%ia(j) = a%ia(j) + b%ja(j) = i + b%val(j) = a%val(j) + end do + end do + + call b%set_nzeros(a%get_nzeros()) + call b%set_nrows(a%get_nrows()) + call b%set_ncols(a%get_ncols()) + call b%set_dupl(a%get_dupl()) + call b%set_state(a%get_state()) + call b%set_triangle(a%is_triangle()) + call b%set_upper(a%is_upper()) + call b%set_unit(a%is_unit()) + call b%fix(info) + + +end subroutine d_cp_csc_to_coo_impl + + +subroutine d_mv_csc_to_coo_impl(a,b,info) + use psb_const_mod + use psb_realloc_mod + use psb_d_base_mat_mod + use psb_d_csc_mat_mod, psb_protect_name => d_mv_csc_to_coo_impl + implicit none + + class(psb_d_csc_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(out) :: 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 = 0 + + nr = a%get_nrows() + nc = a%get_ncols() + nza = a%get_nzeros() + + call b%set_nzeros(a%get_nzeros()) + call b%set_nrows(a%get_nrows()) + call b%set_ncols(a%get_ncols()) + call b%set_dupl(a%get_dupl()) + call b%set_state(a%get_state()) + call b%set_triangle(a%is_triangle()) + call b%set_upper(a%is_upper()) + call b%set_unit(a%is_unit()) + + call move_alloc(a%ia,b%ia) + call move_alloc(a%val,b%val) + call psb_realloc(nza,b%ja,info) + if (info /= 0) return + do i=1, nc + do j=a%icp(i),a%icp(i+1)-1 + b%ja(j) = i + end do + end do + call a%free() + call b%fix(info) + +end subroutine d_mv_csc_to_coo_impl + + + +subroutine d_mv_csc_from_coo_impl(a,b,info) + use psb_const_mod + use psb_realloc_mod + use psb_d_base_mat_mod + use psb_d_csc_mat_mod, psb_protect_name => d_mv_csc_from_coo_impl + implicit none + + class(psb_d_csc_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, icl + Integer, Parameter :: maxtry=8 + integer :: debug_level, debug_unit + character(len=20) :: name + + info = 0 + + call b%fix(info, idir=1) + if (info /= 0) return + + nr = b%get_nrows() + nc = b%get_ncols() + nza = b%get_nzeros() + + call a%set_nrows(b%get_nrows()) + call a%set_ncols(b%get_ncols()) + call a%set_dupl(b%get_dupl()) + call a%set_state(b%get_state()) + call a%set_triangle(b%is_triangle()) + call a%set_upper(b%is_upper()) + call a%set_unit(b%is_unit()) + ! Dirty trick: call move_alloc to have the new data allocated just once. + call move_alloc(b%ja,itemp) + call move_alloc(b%ia,a%ia) + call move_alloc(b%val,a%val) + call psb_realloc(max(nr+1,nc+1),a%icp,info) + call b%free() + + if (nza <= 0) then + a%icp(:) = 1 + else + a%icp(1) = 1 + if (nc < itemp(nza)) then + write(debug_unit,*) trim(name),': CLSHR=.false. : ',& + &nc,itemp(nza),' Expect trouble!' + info = 12 + end if + + j = 1 + i = 1 + icl = itemp(j) + + outer: do + inner: do + if (i >= icl) exit inner + if (i > nc) then + write(debug_unit,*) trim(name),& + & 'Strange situation: i>nr ',i,nc,j,nza,icl,idl + exit outer + end if + a%icp(i+1) = a%icp(i) + i = i + 1 + end do inner + j = j + 1 + if (j > nza) exit + if (itemp(j) /= icl) then + a%icp(i+1) = j + icl = itemp(j) + i = i + 1 + endif + if (i > nc) exit + enddo outer + ! + ! Cleanup empty rows at the end + ! + if (j /= (nza+1)) then + write(debug_unit,*) trim(name),': Problem from loop :',j,nza + info = 13 + endif + do + if (i > nc) exit + a%icp(i+1) = j + i = i + 1 + end do + + endif + + +end subroutine d_mv_csc_from_coo_impl + + +subroutine d_mv_csc_to_fmt_impl(a,b,info) + use psb_const_mod + use psb_realloc_mod + use psb_d_base_mat_mod + use psb_d_csc_mat_mod, psb_protect_name => d_mv_csc_to_fmt_impl + implicit none + + class(psb_d_csc_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(out) :: 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 = 0 + + select type (b) + class is (psb_d_coo_sparse_mat) + call a%mv_to_coo(b,info) + ! Need to fix trivial copies! +! !$ class is (psb_d_csc_sparse_mat) +! !$ call a%mv_to_coo(b,info) + class default + call tmp%mv_from_fmt(a,info) + if (info == 0) call b%mv_from_coo(tmp,info) + end select + +end subroutine d_mv_csc_to_fmt_impl +!!$ + +subroutine d_cp_csc_to_fmt_impl(a,b,info) + use psb_const_mod + use psb_realloc_mod + use psb_d_base_mat_mod + use psb_d_csc_mat_mod, psb_protect_name => d_cp_csc_to_fmt_impl + implicit none + + class(psb_d_csc_sparse_mat), intent(in) :: a + class(psb_d_base_sparse_mat), intent(out) :: 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 = 0 + + + select type (b) + class is (psb_d_coo_sparse_mat) + call a%cp_to_coo(b,info) + class default + call tmp%cp_from_fmt(a,info) + if (info == 0) call b%mv_from_coo(tmp,info) + end select + +end subroutine d_cp_csc_to_fmt_impl + + +subroutine d_mv_csc_from_fmt_impl(a,b,info) + use psb_const_mod + use psb_realloc_mod + use psb_d_base_mat_mod + use psb_d_csc_mat_mod, psb_protect_name => d_mv_csc_from_fmt_impl + implicit none + + class(psb_d_csc_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 = 0 + + select type (b) + class is (psb_d_coo_sparse_mat) + call a%mv_from_coo(b,info) + class default + call tmp%mv_from_fmt(b,info) + if (info == 0) call a%mv_from_coo(tmp,info) + end select + +end subroutine d_mv_csc_from_fmt_impl + + + +subroutine d_cp_csc_from_fmt_impl(a,b,info) + use psb_const_mod + use psb_realloc_mod + use psb_d_base_mat_mod + use psb_d_csc_mat_mod, psb_protect_name => d_cp_csc_from_fmt_impl + implicit none + + class(psb_d_csc_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 :: nza, nr, i,j,irw, idl,err_act, nc + Integer, Parameter :: maxtry=8 + integer :: debug_level, debug_unit + character(len=20) :: name + + info = 0 + + select type (b) + class is (psb_d_coo_sparse_mat) + call a%cp_from_coo(b,info) + class default + call tmp%cp_from_fmt(b,info) + if (info == 0) call a%mv_from_coo(tmp,info) + end select +end subroutine d_cp_csc_from_fmt_impl + diff --git a/test/pargen/psbn_d_csc_mat_mod.f03 b/test/pargen/psbn_d_csc_mat_mod.f03 new file mode 100644 index 00000000..edf296c7 --- /dev/null +++ b/test/pargen/psbn_d_csc_mat_mod.f03 @@ -0,0 +1,1384 @@ +module psb_d_csc_mat_mod + + use psb_d_base_mat_mod + + type, extends(psb_d_base_sparse_mat) :: psb_d_csc_sparse_mat + + integer, allocatable :: icp(:), ia(:) + real(psb_dpk_), allocatable :: val(:) + + contains + procedure, pass(a) :: get_nzeros => d_csc_get_nzeros + procedure, pass(a) :: get_fmt => d_csc_get_fmt + procedure, pass(a) :: get_diag => d_csc_get_diag + procedure, pass(a) :: d_base_csmm => d_csc_csmm + procedure, pass(a) :: d_base_csmv => d_csc_csmv + procedure, pass(a) :: d_base_cssm => d_csc_cssm + procedure, pass(a) :: d_base_cssv => d_csc_cssv + procedure, pass(a) :: d_scals => d_csc_scals + procedure, pass(a) :: d_scal => d_csc_scal + procedure, pass(a) :: csnmi => d_csc_csnmi + procedure, pass(a) :: reallocate_nz => d_csc_reallocate_nz + procedure, pass(a) :: csput => d_csc_csput + procedure, pass(a) :: allocate_mnnz => d_csc_allocate_mnnz + procedure, pass(a) :: cp_to_coo => d_cp_csc_to_coo + procedure, pass(a) :: cp_from_coo => d_cp_csc_from_coo + procedure, pass(a) :: cp_to_fmt => d_cp_csc_to_fmt + procedure, pass(a) :: cp_from_fmt => d_cp_csc_from_fmt + procedure, pass(a) :: mv_to_coo => d_mv_csc_to_coo + procedure, pass(a) :: mv_from_coo => d_mv_csc_from_coo + procedure, pass(a) :: mv_to_fmt => d_mv_csc_to_fmt + procedure, pass(a) :: mv_from_fmt => d_mv_csc_from_fmt + procedure, pass(a) :: d_csgetrow => d_csc_csgetrow + procedure, pass(a) :: get_size => d_csc_get_size + procedure, pass(a) :: free => d_csc_free + procedure, pass(a) :: trim => d_csc_trim + procedure, pass(a) :: print => d_csc_print + procedure, pass(a) :: sizeof => d_csc_sizeof + end type psb_d_csc_sparse_mat + private :: d_csc_get_nzeros, d_csc_csmm, d_csc_csmv, d_csc_cssm, d_csc_cssv, & + & d_csc_csput, d_csc_reallocate_nz, d_csc_allocate_mnnz, & + & d_csc_free, d_csc_print, d_csc_get_fmt, d_csc_csnmi, get_diag, & + & d_cp_csc_to_coo, d_cp_csc_from_coo, & + & d_mv_csc_to_coo, d_mv_csc_from_coo, & + & d_cp_csc_to_fmt, d_cp_csc_from_fmt, & + & d_mv_csc_to_fmt, d_mv_csc_from_fmt, & + & d_csc_scals, d_csc_scal, d_csc_trim, d_csc_csgetrow, d_csc_get_size, & + & d_csc_sizeof + + + interface + subroutine d_cp_csc_to_fmt_impl(a,b,info) + use psb_const_mod + use psb_d_base_mat_mod + import psb_d_csc_sparse_mat + class(psb_d_csc_sparse_mat), intent(in) :: a + class(psb_d_base_sparse_mat), intent(out) :: b + integer, intent(out) :: info + end subroutine d_cp_csc_to_fmt_impl + end interface + + interface + subroutine d_cp_csc_from_fmt_impl(a,b,info) + use psb_const_mod + use psb_d_base_mat_mod + import psb_d_csc_sparse_mat + class(psb_d_csc_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(in) :: b + integer, intent(out) :: info + end subroutine d_cp_csc_from_fmt_impl + end interface + + + interface + subroutine d_cp_csc_to_coo_impl(a,b,info) + use psb_const_mod + use psb_d_base_mat_mod + import psb_d_csc_sparse_mat + class(psb_d_csc_sparse_mat), intent(in) :: a + class(psb_d_coo_sparse_mat), intent(out) :: b + integer, intent(out) :: info + end subroutine d_cp_csc_to_coo_impl + end interface + + interface + subroutine d_cp_csc_from_coo_impl(a,b,info) + use psb_const_mod + use psb_d_base_mat_mod + import psb_d_csc_sparse_mat + class(psb_d_csc_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(in) :: b + integer, intent(out) :: info + end subroutine d_cp_csc_from_coo_impl + end interface + + interface + subroutine d_mv_csc_to_fmt_impl(a,b,info) + use psb_const_mod + use psb_d_base_mat_mod + import psb_d_csc_sparse_mat + class(psb_d_csc_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(out) :: b + integer, intent(out) :: info + end subroutine d_mv_csc_to_fmt_impl + end interface + + interface + subroutine d_mv_csc_from_fmt_impl(a,b,info) + use psb_const_mod + use psb_d_base_mat_mod + import psb_d_csc_sparse_mat + class(psb_d_csc_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(inout) :: b + integer, intent(out) :: info + end subroutine d_mv_csc_from_fmt_impl + end interface + + + interface + subroutine d_mv_csc_to_coo_impl(a,b,info) + use psb_const_mod + use psb_d_base_mat_mod + import psb_d_csc_sparse_mat + class(psb_d_csc_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(out) :: b + integer, intent(out) :: info + end subroutine d_mv_csc_to_coo_impl + end interface + + interface + subroutine d_mv_csc_from_coo_impl(a,b,info) + use psb_const_mod + use psb_d_base_mat_mod + import psb_d_csc_sparse_mat + class(psb_d_csc_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(inout) :: b + integer, intent(out) :: info + end subroutine d_mv_csc_from_coo_impl + end interface + + interface + subroutine d_csc_csput_impl(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + use psb_const_mod + import psb_d_csc_sparse_mat + class(psb_d_csc_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 d_csc_csput_impl + end interface + + interface + subroutine d_csc_csgetrow_impl(imin,imax,a,nz,ia,ja,val,info,& + & jmin,jmax,iren,append,nzin,rscale,cscale) + use psb_const_mod + import psb_d_csc_sparse_mat + implicit none + + class(psb_d_csc_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 d_csc_csgetrow_impl + end interface + + interface d_csc_cssm_impl + subroutine d_csc_cssv_impl(alpha,a,x,beta,y,info,trans) + use psb_const_mod + import psb_d_csc_sparse_mat + class(psb_d_csc_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 d_csc_cssv_impl + subroutine d_csc_cssm_impl(alpha,a,x,beta,y,info,trans) + use psb_const_mod + import psb_d_csc_sparse_mat + class(psb_d_csc_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 d_csc_cssm_impl + end interface + + interface d_csc_csmm_impl + subroutine d_csc_csmv_impl(alpha,a,x,beta,y,info,trans) + use psb_const_mod + import psb_d_csc_sparse_mat + class(psb_d_csc_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 d_csc_csmv_impl + subroutine d_csc_csmm_impl(alpha,a,x,beta,y,info,trans) + use psb_const_mod + import psb_d_csc_sparse_mat + class(psb_d_csc_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 d_csc_csmm_impl + end interface + + interface d_csc_csnmi_impl + function d_csc_csnmi_impl(a) result(res) + use psb_const_mod + import psb_d_csc_sparse_mat + class(psb_d_csc_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + end function d_csc_csnmi_impl + end interface + + + +contains + + !===================================== + ! + ! + ! + ! Getters + ! + ! + ! + ! + ! + !===================================== + + + function d_csc_sizeof(a) result(res) + implicit none + class(psb_d_csc_sparse_mat), intent(in) :: a + integer(psb_long_int_k_) :: res + res = 8 + res = res + psb_sizeof_dp * size(a%val) + res = res + psb_sizeof_int * size(a%icp) + res = res + psb_sizeof_int * size(a%ia) + + end function d_csc_sizeof + + function d_csc_get_fmt(a) result(res) + implicit none + class(psb_d_csc_sparse_mat), intent(in) :: a + character(len=5) :: res + res = 'CSC' + end function d_csc_get_fmt + + function d_csc_get_nzeros(a) result(res) + implicit none + class(psb_d_csc_sparse_mat), intent(in) :: a + integer :: res + res = a%icp(a%m+1)-1 + end function d_csc_get_nzeros + + function d_csc_get_size(a) result(res) + implicit none + class(psb_d_csc_sparse_mat), intent(in) :: a + integer :: res + + res = -1 + + if (allocated(a%ia)) then + if (res >= 0) then + res = min(res,size(a%ia)) + else + res = size(a%ia) + end if + end if + if (allocated(a%val)) then + if (res >= 0) then + res = min(res,size(a%val)) + else + res = size(a%val) + end if + end if + + end function d_csc_get_size + + !===================================== + ! + ! + ! + ! Data management + ! + ! + ! + ! + ! + !===================================== + + + subroutine d_csc_reallocate_nz(nz,a) + use psb_error_mod + use psb_realloc_mod + implicit none + integer, intent(in) :: nz + class(psb_d_csc_sparse_mat), intent(inout) :: a + Integer :: err_act, info + character(len=20) :: name='d_csc_reallocate_nz' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + call psb_realloc(nz,a%ia,info) + if (info == 0) call psb_realloc(nz,a%val,info) + if (info == 0) call psb_realloc(max(nz,a%m+1,a%n+1),a%icp,info) + if (info /= 0) then + call psb_errpush(4000,name) + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + + end subroutine d_csc_reallocate_nz + + subroutine d_csc_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + use psb_const_mod + use psb_error_mod + implicit none + class(psb_d_csc_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_csc_csput' + logical, parameter :: debug=.false. + integer :: nza, i,j,k, nzl, isza, int_err(5) + + call psb_erractionsave(err_act) + info = 0 + + if (nz <= 0) then + info = 10 + int_err(1)=1 + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + if (size(ia) < nz) then + info = 35 + int_err(1)=2 + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + if (size(ja) < nz) then + info = 35 + int_err(1)=3 + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + if (size(val) < nz) then + info = 35 + int_err(1)=4 + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + if (nz == 0) return + + call d_csc_csput_impl(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + if (info /= 0) goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + end subroutine d_csc_csput + + subroutine d_csc_csgetrow(imin,imax,a,nz,ia,ja,val,info,& + & jmin,jmax,iren,append,nzin,rscale,cscale) + ! Output is always in COO format + use psb_error_mod + use psb_const_mod + implicit none + + class(psb_d_csc_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 + Integer :: err_act + character(len=20) :: name='csget' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = 0 + + call d_csc_csgetrow_impl(imin,imax,a,nz,ia,ja,val,info,& + & jmin,jmax,iren,append,nzin,rscale,cscale) + + if (info /= 0) goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + + end subroutine d_csc_csgetrow + + + subroutine d_csc_csgetblk(imin,imax,a,b,info,& + & jmin,jmax,iren,append,rscale,cscale) + ! Output is always in COO format + use psb_error_mod + use psb_const_mod + implicit none + + class(psb_d_csc_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. + + call psb_erractionsave(err_act) + info = 0 + + if (present(append)) then + append_ = append + else + append_ = .false. + endif + if (append_) then + nzin = a%get_nzeros() + else + nzin = 0 + endif + + call a%csget(imin,imax,nzout,b%ia,b%ja,b%val,info,& + & jmin=jmin, jmax=jmax, iren=iren, append=append_, & + & nzin=nzin, rscale=rscale, cscale=cscale) + + if (info /= 0) goto 9999 + + call b%set_nzeros(nzin+nzout) + call b%fix(info) + if (info /= 0) goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + + end subroutine d_csc_csgetblk + + + subroutine d_csc_csclip(a,b,info,& + & imin,imax,jmin,jmax,rscale,cscale) + ! Output is always in COO format + use psb_error_mod + use psb_const_mod + implicit none + + class(psb_d_csc_sparse_mat), intent(in) :: a + class(psb_d_coo_sparse_mat), intent(out) :: b + integer,intent(out) :: info + integer, intent(in), optional :: imin,imax,jmin,jmax + logical, intent(in), optional :: rscale,cscale + + Integer :: err_act, nzin, nzout, imin_, imax_, jmin_, jmax_, mb,nb + character(len=20) :: name='csget' + logical :: rscale_, cscale_ + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = 0 + + nzin = 0 + if (present(imin)) then + imin_ = imin + else + imin_ = 1 + end if + if (present(imax)) then + imax_ = imax + else + imax_ = a%get_nrows() + end if + if (present(jmin)) then + jmin_ = jmin + else + jmin_ = 1 + end if + if (present(jmax)) then + jmax_ = jmax + else + jmax_ = a%get_ncols() + end if + if (present(rscale)) then + rscale_ = rscale + else + rscale_ = .true. + end if + if (present(cscale)) then + cscale_ = cscale + else + cscale_ = .true. + end if + + if (rscale_) then + mb = imax_ - imin_ +1 + else + mb = a%get_nrows() ! Should this be imax_ ?? + endif + if (cscale_) then + nb = jmax_ - jmin_ +1 + else + nb = a%get_ncols() ! Should this be jmax_ ?? + endif + call b%allocate(mb,nb) + + call a%csget(imin_,imax_,nzout,b%ia,b%ja,b%val,info,& + & jmin=jmin_, jmax=jmax_, append=.false., & + & nzin=nzin, rscale=rscale_, cscale=cscale_) + + if (info /= 0) goto 9999 + + call b%set_nzeros(nzin+nzout) + call b%fix(info) + + if (info /= 0) goto 9999 + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + + end subroutine d_csc_csclip + + + subroutine d_csc_free(a) + implicit none + + class(psb_d_csc_sparse_mat), intent(inout) :: a + + if (allocated(a%icp)) deallocate(a%icp) + if (allocated(a%ia)) deallocate(a%ia) + if (allocated(a%val)) deallocate(a%val) + call a%set_null() + call a%set_nrows(0) + call a%set_ncols(0) + + return + + end subroutine d_csc_free + + subroutine d_csc_trim(a) + use psb_realloc_mod + use psb_error_mod + implicit none + class(psb_d_csc_sparse_mat), intent(inout) :: a + Integer :: err_act, info, nz, n + character(len=20) :: name='trim' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = 0 + n = a%get_ncols() + nz = a%get_nzeros() + if (info == 0) call psb_realloc(n+1,a%icp,info) + if (info == 0) call psb_realloc(nz,a%ia,info) + if (info == 0) call psb_realloc(nz,a%val,info) + + if (info /= 0) goto 9999 + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + + end subroutine d_csc_trim + + subroutine d_cp_csc_to_coo(a,b,info) + use psb_error_mod + use psb_realloc_mod + implicit none + class(psb_d_csc_sparse_mat), intent(in) :: a + class(psb_d_coo_sparse_mat), intent(out) :: b + integer, intent(out) :: info + + Integer :: err_act + character(len=20) :: name='to_coo' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = 0 + call d_cp_csc_to_coo_impl(a,b,info) + if (info /= 0) goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + call psb_errpush(info,name) + + if (err_act /= psb_act_ret_) then + call psb_error() + end if + return + + end subroutine d_cp_csc_to_coo + + subroutine d_cp_csc_from_coo(a,b,info) + use psb_error_mod + use psb_realloc_mod + implicit none + class(psb_d_csc_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(in) :: b + integer, intent(out) :: info + + Integer :: err_act + character(len=20) :: name='from_coo' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = 0 + call d_cp_csc_from_coo_impl(a,b,info) + if (info /= 0) goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + call psb_errpush(info,name) + + if (err_act /= psb_act_ret_) then + call psb_error() + end if + return + + end subroutine d_cp_csc_from_coo + + + subroutine d_cp_csc_to_fmt(a,b,info) + use psb_error_mod + use psb_realloc_mod + implicit none + class(psb_d_csc_sparse_mat), intent(in) :: a + class(psb_d_base_sparse_mat), intent(out) :: b + integer, intent(out) :: info + + Integer :: err_act + character(len=20) :: name='to_fmt' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = 0 + call d_cp_csc_to_fmt_impl(a,b,info) + if (info /= 0) goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + call psb_errpush(info,name) + + if (err_act /= psb_act_ret_) then + call psb_error() + end if + return + + end subroutine d_cp_csc_to_fmt + + subroutine d_cp_csc_from_fmt(a,b,info) + use psb_error_mod + use psb_realloc_mod + implicit none + class(psb_d_csc_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(in) :: b + integer, intent(out) :: info + + Integer :: err_act + character(len=20) :: name='from_fmt' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = 0 + call d_cp_csc_from_fmt_impl(a,b,info) + if (info /= 0) goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + call psb_errpush(info,name) + + if (err_act /= psb_act_ret_) then + call psb_error() + end if + return + + end subroutine d_cp_csc_from_fmt + + + subroutine d_mv_csc_to_coo(a,b,info) + use psb_error_mod + use psb_realloc_mod + implicit none + class(psb_d_csc_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(out) :: b + integer, intent(out) :: info + + Integer :: err_act + character(len=20) :: name='to_coo' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = 0 + call d_mv_csc_to_coo_impl(a,b,info) + if (info /= 0) goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + call psb_errpush(info,name) + + if (err_act /= psb_act_ret_) then + call psb_error() + end if + return + + end subroutine d_mv_csc_to_coo + + subroutine d_mv_csc_from_coo(a,b,info) + use psb_error_mod + use psb_realloc_mod + implicit none + class(psb_d_csc_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(inout) :: b + integer, intent(out) :: info + + Integer :: err_act + character(len=20) :: name='from_coo' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = 0 + call d_mv_csc_from_coo_impl(a,b,info) + if (info /= 0) goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + call psb_errpush(info,name) + + if (err_act /= psb_act_ret_) then + call psb_error() + end if + return + + end subroutine d_mv_csc_from_coo + + + subroutine d_mv_csc_to_fmt(a,b,info) + use psb_error_mod + use psb_realloc_mod + implicit none + class(psb_d_csc_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(out) :: b + integer, intent(out) :: info + + Integer :: err_act + character(len=20) :: name='to_fmt' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = 0 + call d_mv_csc_to_fmt_impl(a,b,info) + if (info /= 0) goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + call psb_errpush(info,name) + + if (err_act /= psb_act_ret_) then + call psb_error() + end if + return + + end subroutine d_mv_csc_to_fmt + + subroutine d_mv_csc_from_fmt(a,b,info) + use psb_error_mod + use psb_realloc_mod + implicit none + class(psb_d_csc_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(inout) :: b + integer, intent(out) :: info + + Integer :: err_act + character(len=20) :: name='from_fmt' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = 0 + call d_mv_csc_from_fmt_impl(a,b,info) + if (info /= 0) goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + call psb_errpush(info,name) + + if (err_act /= psb_act_ret_) then + call psb_error() + end if + return + + end subroutine d_mv_csc_from_fmt + + subroutine d_csc_allocate_mnnz(m,n,a,nz) + use psb_error_mod + use psb_realloc_mod + implicit none + integer, intent(in) :: m,n + class(psb_d_csc_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. + + call psb_erractionsave(err_act) + info = 0 + if (m < 0) then + info = 10 + call psb_errpush(info,name,i_err=(/1,0,0,0,0/)) + goto 9999 + endif + if (n < 0) then + info = 10 + call psb_errpush(info,name,i_err=(/2,0,0,0,0/)) + goto 9999 + endif + if (present(nz)) then + nz_ = nz + else + nz_ = max(7*m,7*n,1) + end if + if (nz_ < 0) then + info = 10 + call psb_errpush(info,name,i_err=(/3,0,0,0,0/)) + goto 9999 + endif + + if (info == 0) call psb_realloc(n+1,a%icp,info) + if (info == 0) call psb_realloc(nz_,a%ia,info) + if (info == 0) call psb_realloc(nz_,a%val,info) + if (info == 0) then + a%icp=0 + call a%set_nrows(m) + call a%set_ncols(n) + call a%set_bld() + call a%set_triangle(.false.) + call a%set_unit(.false.) + end if + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + + end subroutine d_csc_allocate_mnnz + + + subroutine d_csc_print(iout,a,iv,eirs,eics,head,ivr,ivc) + use psb_string_mod + implicit none + + integer, intent(in) :: iout + class(psb_d_csc_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_csc_print' + logical, parameter :: debug=.false. + + character(len=80) :: frmtv + integer :: irs,ics,i,j, nmx, ni, nr, nc, nz + + if (present(eirs)) then + irs = eirs + else + irs = 0 + endif + if (present(eics)) then + ics = eics + else + ics = 0 + endif + + if (present(head)) then + write(iout,'(a)') '%%MatrixMarket matrix coordinate real general' + write(iout,'(a,a)') '% ',head + write(iout,'(a)') '%' + write(iout,'(a,a)') '% COO' + endif + + nr = a%get_nrows() + nc = a%get_ncols() + nz = a%get_nzeros() + nmx = max(nr,nc,1) + ni = floor(log10(1.0*nmx)) + 1 + + write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' + write(iout,*) nr, nc, nz + if(present(iv)) then + do i=1, nr + do j=a%icp(i),a%icp(i+1)-1 + write(iout,frmtv) iv(a%ia(j)),iv(i),a%val(j) + end do + enddo + else + if (present(ivr).and..not.present(ivc)) then + do i=1, nr + do j=a%icp(i),a%icp(i+1)-1 + write(iout,frmtv) ivr(a%ia(j)),i,a%val(j) + end do + enddo + else if (present(ivr).and.present(ivc)) then + do i=1, nr + do j=a%icp(i),a%icp(i+1)-1 + write(iout,frmtv) ivr(a%ia(j)),ivc(i),a%val(j) + end do + enddo + else if (.not.present(ivr).and.present(ivc)) then + do i=1, nr + do j=a%icp(i),a%icp(i+1)-1 + write(iout,frmtv) (a%ia(j)),ivc(i),a%val(j) + end do + enddo + else if (.not.present(ivr).and..not.present(ivc)) then + do i=1, nr + do j=a%icp(i),a%icp(i+1)-1 + write(iout,frmtv) (a%ia(j)),(i),a%val(j) + end do + enddo + endif + endif + + end subroutine d_csc_print + + + !===================================== + ! + ! + ! + ! Computational routines + ! + ! + ! + ! + ! + ! + !===================================== + + + subroutine d_csc_csmv(alpha,a,x,beta,y,info,trans) + use psb_error_mod + implicit none + class(psb_d_csc_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_csc_csmv' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + if (.not.a%is_asb()) then + info = 1121 + call psb_errpush(info,name) + goto 9999 + endif + + + call d_csc_csmm_impl(alpha,a,x,beta,y,info,trans) + + if (info /= 0) goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + + end subroutine d_csc_csmv + + subroutine d_csc_csmm(alpha,a,x,beta,y,info,trans) + use psb_error_mod + implicit none + class(psb_d_csc_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_csc_csmm' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + + + call d_csc_csmm_impl(alpha,a,x,beta,y,info,trans) + + if (info /= 0) goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + + end subroutine d_csc_csmm + + + subroutine d_csc_cssv(alpha,a,x,beta,y,info,trans) + use psb_error_mod + implicit none + class(psb_d_csc_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_csc_cssv' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + if (.not.a%is_asb()) then + info = 1121 + call psb_errpush(info,name) + goto 9999 + endif + + + if (.not. (a%is_triangle())) then + info = 1121 + call psb_errpush(info,name) + goto 9999 + end if + + call d_csc_cssm_impl(alpha,a,x,beta,y,info,trans) + + call psb_erractionrestore(err_act) + return + + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + + + end subroutine d_csc_cssv + + + + subroutine d_csc_cssm(alpha,a,x,beta,y,info,trans) + use psb_error_mod + implicit none + class(psb_d_csc_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_csc_csmm' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + if (.not.a%is_asb()) then + info = 1121 + call psb_errpush(info,name) + goto 9999 + endif + + + if (.not. (a%is_triangle())) then + info = 1121 + call psb_errpush(info,name) + goto 9999 + end if + + call d_csc_cssm_impl(alpha,a,x,beta,y,info,trans) + call psb_erractionrestore(err_act) + return + + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + + end subroutine d_csc_cssm + + function d_csc_csnmi(a) result(res) + use psb_error_mod + use psb_const_mod + implicit none + class(psb_d_csc_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + + Integer :: err_act + character(len=20) :: name='csnmi' + logical, parameter :: debug=.false. + + + res = d_csc_csnmi_impl(a) + + return + + end function d_csc_csnmi + + subroutine d_csc_get_diag(a,d,info) + use psb_error_mod + use psb_const_mod + implicit none + class(psb_d_csc_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 = 0 + call psb_erractionsave(err_act) + + mnm = min(a%get_nrows(),a%get_ncols()) + if (size(d) < mnm) then + info=35 + call psb_errpush(info,name,i_err=(/2,size(d),0,0,0/)) + goto 9999 + end if + + + do i=1, mnm + do k=a%icp(i),a%icp(i+1)-1 + j=a%ia(k) + if ((j==i) .and.(j <= mnm )) then + d(i) = a%val(k) + endif + enddo + end do + do i=mnm+1,size(d) + d(i) = dzero + end do + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + + end subroutine d_csc_get_diag + + + subroutine d_csc_scal(d,a,info) + use psb_error_mod + use psb_const_mod + implicit none + class(psb_d_csc_sparse_mat), intent(inout) :: a + real(psb_dpk_), intent(in) :: d(:) + integer, intent(out) :: info + + Integer :: err_act,mnm, i, j, n + character(len=20) :: name='scal' + logical, parameter :: debug=.false. + + info = 0 + call psb_erractionsave(err_act) + + n = a%get_ncols() + if (size(d) < n) then + info=35 + call psb_errpush(info,name,i_err=(/2,size(d),0,0,0/)) + goto 9999 + end if + + do i=1, n + do j = a%icp(i), a%icp(i+1) -1 + a%val(j) = a%val(j) * d(a%ia(j)) + end do + enddo + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + + end subroutine d_csc_scal + + + subroutine d_csc_scals(d,a,info) + use psb_error_mod + use psb_const_mod + implicit none + class(psb_d_csc_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 = 0 + call psb_erractionsave(err_act) + + + do i=1,a%get_nzeros() + a%val(i) = a%val(i) * d + enddo + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + + end subroutine d_csc_scals + + + +end module psb_d_csc_mat_mod diff --git a/test/serial/d_coo_matgen.f03 b/test/serial/d_coo_matgen.f03 index 18f199fd..a7641bea 100644 --- a/test/serial/d_coo_matgen.f03 +++ b/test/serial/d_coo_matgen.f03 @@ -3,8 +3,8 @@ program d_coo_matgen use psb_base_mod use psb_prec_mod use psb_krylov_mod - use psbn_d_base_mat_mod - use psbn_d_csr_mat_mod + use psb_d_base_mat_mod + use psb_d_csr_mat_mod implicit none ! input parameters @@ -153,8 +153,8 @@ contains integer :: element integer, allocatable :: irow(:),icol(:),myidx(:) real(psb_dpk_), allocatable :: val(:) - type(psbn_d_coo_sparse_mat) :: acoo - type(psbn_d_csr_sparse_mat) :: acsr + type(psb_d_coo_sparse_mat) :: acoo + type(psb_d_csr_sparse_mat) :: acsr ! deltah dimension of each grid cell ! deltat discretization time real(psb_dpk_) :: deltah diff --git a/test/serial/d_matgen.f03 b/test/serial/d_matgen.f03 index 7b587f5e..b92cd23c 100644 --- a/test/serial/d_matgen.f03 +++ b/test/serial/d_matgen.f03 @@ -3,9 +3,9 @@ program d_matgen use psb_base_mod use psb_prec_mod use psb_krylov_mod - use psbn_d_base_mat_mod - use psbn_d_csr_mat_mod - use psbn_d_mat_mod + use psb_d_base_mat_mod + use psb_d_csr_mat_mod + use psb_d_mat_mod implicit none ! input parameters @@ -139,7 +139,7 @@ contains ! Note that if a1=a2=a3=a4=0., the PDE is the well-known Laplace equation. ! use psb_base_mod - use psbn_d_cxx_mat_mod + use psb_d_cxx_mat_mod implicit none integer :: idim integer, parameter :: nb=20 @@ -155,10 +155,10 @@ contains integer :: element integer, allocatable :: irow(:),icol(:),myidx(:) real(psb_dpk_), allocatable :: val(:), diag(:) - type(psbn_d_sparse_mat) :: a_n - type(psbn_d_coo_sparse_mat) :: acoo - type(psbn_d_csr_sparse_mat) :: acsr - type(psbn_d_cxx_sparse_mat) :: acxx + type(psb_d_sparse_mat) :: a_n + type(psb_d_coo_sparse_mat) :: acoo + type(psb_d_csr_sparse_mat) :: acsr + type(psb_d_cxx_sparse_mat) :: acxx ! deltah dimension of each grid cell ! deltat discretization time real(psb_dpk_) :: deltah, anorm diff --git a/test/serial/psbn_d_cxx_impl.f03 b/test/serial/psbn_d_cxx_impl.f03 index 377202ed..b07990e8 100644 --- a/test/serial/psbn_d_cxx_impl.f03 +++ b/test/serial/psbn_d_cxx_impl.f03 @@ -14,9 +14,9 @@ subroutine d_cxx_csmv_impl(alpha,a,x,beta,y,info,trans) use psb_error_mod - use psbn_d_cxx_mat_mod, psb_protect_name => d_cxx_csmv_impl + use psb_d_cxx_mat_mod, psb_protect_name => d_cxx_csmv_impl implicit none - class(psbn_d_cxx_sparse_mat), intent(in) :: a + class(psb_d_cxx_sparse_mat), intent(in) :: a real(psb_dpk_), intent(in) :: alpha, beta, x(:) real(psb_dpk_), intent(inout) :: y(:) integer, intent(out) :: info @@ -278,9 +278,9 @@ end subroutine d_cxx_csmv_impl subroutine d_cxx_csmm_impl(alpha,a,x,beta,y,info,trans) use psb_error_mod - use psbn_d_cxx_mat_mod, psb_protect_name => d_cxx_csmm_impl + use psb_d_cxx_mat_mod, psb_protect_name => d_cxx_csmm_impl implicit none - class(psbn_d_cxx_sparse_mat), intent(in) :: a + class(psb_d_cxx_sparse_mat), intent(in) :: a real(psb_dpk_), intent(in) :: alpha, beta, x(:,:) real(psb_dpk_), intent(inout) :: y(:,:) integer, intent(out) :: info @@ -548,9 +548,9 @@ end subroutine d_cxx_csmm_impl subroutine d_cxx_cssv_impl(alpha,a,x,beta,y,info,trans) use psb_error_mod - use psbn_d_cxx_mat_mod, psb_protect_name => d_cxx_cssv_impl + use psb_d_cxx_mat_mod, psb_protect_name => d_cxx_cssv_impl implicit none - class(psbn_d_cxx_sparse_mat), intent(in) :: a + class(psb_d_cxx_sparse_mat), intent(in) :: a real(psb_dpk_), intent(in) :: alpha, beta, x(:) real(psb_dpk_), intent(inout) :: y(:) integer, intent(out) :: info @@ -637,7 +637,7 @@ contains subroutine inner_cxxsv(tra,a,x,y) implicit none logical, intent(in) :: tra - class(psbn_d_cxx_sparse_mat), intent(in) :: a + class(psb_d_cxx_sparse_mat), intent(in) :: a real(psb_dpk_), intent(in) :: x(:) real(psb_dpk_), intent(out) :: y(:) @@ -742,9 +742,9 @@ end subroutine d_cxx_cssv_impl subroutine d_cxx_cssm_impl(alpha,a,x,beta,y,info,trans) use psb_error_mod - use psbn_d_cxx_mat_mod, psb_protect_name => d_cxx_cssm_impl + use psb_d_cxx_mat_mod, psb_protect_name => d_cxx_cssm_impl implicit none - class(psbn_d_cxx_sparse_mat), intent(in) :: a + class(psb_d_cxx_sparse_mat), intent(in) :: a real(psb_dpk_), intent(in) :: alpha, beta, x(:,:) real(psb_dpk_), intent(inout) :: y(:,:) integer, intent(out) :: info @@ -844,7 +844,7 @@ contains subroutine inner_cxxsm(tra,a,x,y,info) implicit none logical, intent(in) :: tra - class(psbn_d_cxx_sparse_mat), intent(in) :: a + class(psb_d_cxx_sparse_mat), intent(in) :: a real(psb_dpk_), intent(in) :: x(:,:) real(psb_dpk_), intent(out) :: y(:,:) integer, intent(out) :: info @@ -955,9 +955,9 @@ end subroutine d_cxx_cssm_impl function d_cxx_csnmi_impl(a) result(res) use psb_error_mod - use psbn_d_cxx_mat_mod, psb_protect_name => d_cxx_csnmi_impl + use psb_d_cxx_mat_mod, psb_protect_name => d_cxx_csnmi_impl implicit none - class(psbn_d_cxx_sparse_mat), intent(in) :: a + class(psb_d_cxx_sparse_mat), intent(in) :: a real(psb_dpk_) :: res integer :: i,j,k,m,n, nr, ir, jc, nc @@ -999,11 +999,11 @@ subroutine d_cxx_csgetrow_impl(imin,imax,a,nz,ia,ja,val,info,& use psb_error_mod use psb_const_mod use psb_error_mod - use psbn_d_base_mat_mod - use psbn_d_cxx_mat_mod, psb_protect_name => d_cxx_csgetrow_impl + use psb_d_base_mat_mod + use psb_d_cxx_mat_mod, psb_protect_name => d_cxx_csgetrow_impl implicit none - class(psbn_d_cxx_sparse_mat), intent(in) :: a + class(psb_d_cxx_sparse_mat), intent(in) :: a integer, intent(in) :: imin,imax integer, intent(out) :: nz integer, allocatable, intent(inout) :: ia(:), ja(:) @@ -1100,7 +1100,7 @@ contains use psb_sort_mod implicit none - class(psbn_d_cxx_sparse_mat), intent(in) :: a + class(psb_d_cxx_sparse_mat), intent(in) :: a integer :: imin,imax,jmin,jmax integer, intent(out) :: nz integer, allocatable, intent(inout) :: ia(:), ja(:) @@ -1175,10 +1175,10 @@ end subroutine d_cxx_csgetrow_impl subroutine d_cxx_csput_impl(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) use psb_error_mod use psb_realloc_mod - use psbn_d_cxx_mat_mod, psb_protect_name => d_cxx_csput_impl + use psb_d_cxx_mat_mod, psb_protect_name => d_cxx_csput_impl implicit none - class(psbn_d_cxx_sparse_mat), intent(inout) :: a + class(psb_d_cxx_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 @@ -1239,7 +1239,7 @@ contains use psb_sort_mod implicit none - class(psbn_d_cxx_sparse_mat), intent(inout) :: a + class(psb_d_cxx_sparse_mat), intent(inout) :: a integer, intent(in) :: nz, imin,imax,jmin,jmax integer, intent(in) :: ia(:),ja(:) real(psb_dpk_), intent(in) :: val(:) @@ -1269,7 +1269,7 @@ contains ng = size(gtl) select case(dupl) - case(psbn_dupl_ovwrt_,psbn_dupl_err_) + case(psb_dupl_ovwrt_,psb_dupl_err_) ! Overwrite. ! Cannot test for error, should have been caught earlier. @@ -1307,7 +1307,7 @@ contains end if end do - case(psbn_dupl_add_) + case(psb_dupl_add_) ! Add ilr = -1 ilc = -1 @@ -1351,7 +1351,7 @@ contains else select case(dupl) - case(psbn_dupl_ovwrt_,psbn_dupl_err_) + case(psb_dupl_ovwrt_,psb_dupl_err_) ! Overwrite. ! Cannot test for error, should have been caught earlier. @@ -1387,7 +1387,7 @@ contains end do - case(psbn_dupl_add_) + case(psb_dupl_add_) ! Add ilr = -1 ilc = -1 @@ -1430,15 +1430,15 @@ end subroutine d_cxx_csput_impl subroutine d_cp_cxx_from_coo_impl(a,b,info) use psb_const_mod use psb_realloc_mod - use psbn_d_base_mat_mod - use psbn_d_cxx_mat_mod, psb_protect_name => d_cp_cxx_from_coo_impl + use psb_d_base_mat_mod + use psb_d_cxx_mat_mod, psb_protect_name => d_cp_cxx_from_coo_impl implicit none - class(psbn_d_cxx_sparse_mat), intent(inout) :: a - class(psbn_d_coo_sparse_mat), intent(in) :: b + class(psb_d_cxx_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(in) :: b integer, intent(out) :: info - type(psbn_d_coo_sparse_mat) :: tmp + type(psb_d_coo_sparse_mat) :: tmp integer, allocatable :: itemp(:) !locals logical :: rwshr_ @@ -1458,12 +1458,12 @@ end subroutine d_cp_cxx_from_coo_impl subroutine d_cp_cxx_to_coo_impl(a,b,info) use psb_const_mod - use psbn_d_base_mat_mod - use psbn_d_cxx_mat_mod, psb_protect_name => d_cp_cxx_to_coo_impl + use psb_d_base_mat_mod + use psb_d_cxx_mat_mod, psb_protect_name => d_cp_cxx_to_coo_impl implicit none - class(psbn_d_cxx_sparse_mat), intent(in) :: a - class(psbn_d_coo_sparse_mat), intent(out) :: b + class(psb_d_cxx_sparse_mat), intent(in) :: a + class(psb_d_coo_sparse_mat), intent(out) :: b integer, intent(out) :: info integer, allocatable :: itemp(:) @@ -1506,12 +1506,12 @@ end subroutine d_cp_cxx_to_coo_impl subroutine d_mv_cxx_to_coo_impl(a,b,info) use psb_const_mod use psb_realloc_mod - use psbn_d_base_mat_mod - use psbn_d_cxx_mat_mod, psb_protect_name => d_mv_cxx_to_coo_impl + use psb_d_base_mat_mod + use psb_d_cxx_mat_mod, psb_protect_name => d_mv_cxx_to_coo_impl implicit none - class(psbn_d_cxx_sparse_mat), intent(inout) :: a - class(psbn_d_coo_sparse_mat), intent(out) :: b + class(psb_d_cxx_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(out) :: b integer, intent(out) :: info integer, allocatable :: itemp(:) @@ -1556,12 +1556,12 @@ end subroutine d_mv_cxx_to_coo_impl subroutine d_mv_cxx_from_coo_impl(a,b,info) use psb_const_mod use psb_realloc_mod - use psbn_d_base_mat_mod - use psbn_d_cxx_mat_mod, psb_protect_name => d_mv_cxx_from_coo_impl + use psb_d_base_mat_mod + use psb_d_cxx_mat_mod, psb_protect_name => d_mv_cxx_from_coo_impl implicit none - class(psbn_d_cxx_sparse_mat), intent(inout) :: a - class(psbn_d_coo_sparse_mat), intent(inout) :: b + class(psb_d_cxx_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(inout) :: b integer, intent(out) :: info integer, allocatable :: itemp(:) @@ -1650,16 +1650,16 @@ end subroutine d_mv_cxx_from_coo_impl subroutine d_mv_cxx_to_fmt_impl(a,b,info) use psb_const_mod use psb_realloc_mod - use psbn_d_base_mat_mod - use psbn_d_cxx_mat_mod, psb_protect_name => d_mv_cxx_to_fmt_impl + use psb_d_base_mat_mod + use psb_d_cxx_mat_mod, psb_protect_name => d_mv_cxx_to_fmt_impl implicit none - class(psbn_d_cxx_sparse_mat), intent(inout) :: a - class(psbn_d_base_sparse_mat), intent(out) :: b + class(psb_d_cxx_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(out) :: b integer, intent(out) :: info !locals - type(psbn_d_coo_sparse_mat) :: tmp + type(psb_d_coo_sparse_mat) :: tmp logical :: rwshr_ Integer :: nza, nr, i,j,irw, idl,err_act, nc Integer, Parameter :: maxtry=8 @@ -1669,7 +1669,7 @@ subroutine d_mv_cxx_to_fmt_impl(a,b,info) info = 0 select type (b) - class is (psbn_d_coo_sparse_mat) + class is (psb_d_coo_sparse_mat) call a%mv_to_coo(b,info) class default call tmp%mv_from_fmt(a,info) @@ -1682,16 +1682,16 @@ end subroutine d_mv_cxx_to_fmt_impl subroutine d_cp_cxx_to_fmt_impl(a,b,info) use psb_const_mod use psb_realloc_mod - use psbn_d_base_mat_mod - use psbn_d_cxx_mat_mod, psb_protect_name => d_cp_cxx_to_fmt_impl + use psb_d_base_mat_mod + use psb_d_cxx_mat_mod, psb_protect_name => d_cp_cxx_to_fmt_impl implicit none - class(psbn_d_cxx_sparse_mat), intent(in) :: a - class(psbn_d_base_sparse_mat), intent(out) :: b + class(psb_d_cxx_sparse_mat), intent(in) :: a + class(psb_d_base_sparse_mat), intent(out) :: b integer, intent(out) :: info !locals - type(psbn_d_coo_sparse_mat) :: tmp + type(psb_d_coo_sparse_mat) :: tmp logical :: rwshr_ Integer :: nza, nr, i,j,irw, idl,err_act, nc Integer, Parameter :: maxtry=8 @@ -1702,7 +1702,7 @@ subroutine d_cp_cxx_to_fmt_impl(a,b,info) select type (b) - class is (psbn_d_coo_sparse_mat) + class is (psb_d_coo_sparse_mat) call a%cp_to_coo(b,info) class default call tmp%cp_from_fmt(a,info) @@ -1715,16 +1715,16 @@ end subroutine d_cp_cxx_to_fmt_impl subroutine d_mv_cxx_from_fmt_impl(a,b,info) use psb_const_mod use psb_realloc_mod - use psbn_d_base_mat_mod - use psbn_d_cxx_mat_mod, psb_protect_name => d_mv_cxx_from_fmt_impl + use psb_d_base_mat_mod + use psb_d_cxx_mat_mod, psb_protect_name => d_mv_cxx_from_fmt_impl implicit none - class(psbn_d_cxx_sparse_mat), intent(inout) :: a - class(psbn_d_base_sparse_mat), intent(inout) :: b + class(psb_d_cxx_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(inout) :: b integer, intent(out) :: info !locals - type(psbn_d_coo_sparse_mat) :: tmp + type(psb_d_coo_sparse_mat) :: tmp logical :: rwshr_ Integer :: nza, nr, i,j,irw, idl,err_act, nc Integer, Parameter :: maxtry=8 @@ -1734,7 +1734,7 @@ subroutine d_mv_cxx_from_fmt_impl(a,b,info) info = 0 select type (b) - class is (psbn_d_coo_sparse_mat) + class is (psb_d_coo_sparse_mat) call a%mv_from_coo(b,info) class default call tmp%mv_from_fmt(b,info) @@ -1748,16 +1748,16 @@ end subroutine d_mv_cxx_from_fmt_impl subroutine d_cp_cxx_from_fmt_impl(a,b,info) use psb_const_mod use psb_realloc_mod - use psbn_d_base_mat_mod - use psbn_d_cxx_mat_mod, psb_protect_name => d_cp_cxx_from_fmt_impl + use psb_d_base_mat_mod + use psb_d_cxx_mat_mod, psb_protect_name => d_cp_cxx_from_fmt_impl implicit none - class(psbn_d_cxx_sparse_mat), intent(inout) :: a - class(psbn_d_base_sparse_mat), intent(in) :: b + class(psb_d_cxx_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(in) :: b integer, intent(out) :: info !locals - type(psbn_d_coo_sparse_mat) :: tmp + type(psb_d_coo_sparse_mat) :: tmp logical :: rwshr_ Integer :: nza, nr, i,j,irw, idl,err_act, nc Integer, Parameter :: maxtry=8 @@ -1767,7 +1767,7 @@ subroutine d_cp_cxx_from_fmt_impl(a,b,info) info = 0 select type (b) - class is (psbn_d_coo_sparse_mat) + class is (psb_d_coo_sparse_mat) call a%cp_from_coo(b,info) class default call tmp%cp_from_fmt(b,info) diff --git a/test/serial/psbn_d_cxx_mat_mod.f03 b/test/serial/psbn_d_cxx_mat_mod.f03 index b71bffbe..a978207b 100644 --- a/test/serial/psbn_d_cxx_mat_mod.f03 +++ b/test/serial/psbn_d_cxx_mat_mod.f03 @@ -1,8 +1,8 @@ -module psbn_d_cxx_mat_mod +module psb_d_cxx_mat_mod - use psbn_d_base_mat_mod + use psb_d_base_mat_mod - type, extends(psbn_d_base_sparse_mat) :: psbn_d_cxx_sparse_mat + type, extends(psb_d_base_sparse_mat) :: psb_d_cxx_sparse_mat integer, allocatable :: irp(:), ja(:) real(psb_dpk_), allocatable :: val(:) @@ -34,7 +34,7 @@ module psbn_d_cxx_mat_mod procedure, pass(a) :: free => d_cxx_free procedure, pass(a) :: trim => d_cxx_trim procedure, pass(a) :: print => d_cxx_print - end type psbn_d_cxx_sparse_mat + end type psb_d_cxx_sparse_mat private :: d_cxx_get_nzeros, d_cxx_csmm, d_cxx_csmv, d_cxx_cssm, d_cxx_cssv, & & d_cxx_csput, d_cxx_reallocate_nz, d_cxx_allocate_mnnz, & & d_cxx_free, d_cxx_print, d_cxx_get_fmt, d_cxx_csnmi, get_diag, & @@ -48,10 +48,10 @@ module psbn_d_cxx_mat_mod interface subroutine d_cp_cxx_to_fmt_impl(a,b,info) use psb_const_mod - use psbn_d_base_mat_mod - import psbn_d_cxx_sparse_mat - class(psbn_d_cxx_sparse_mat), intent(in) :: a - class(psbn_d_base_sparse_mat), intent(out) :: b + use psb_d_base_mat_mod + import psb_d_cxx_sparse_mat + class(psb_d_cxx_sparse_mat), intent(in) :: a + class(psb_d_base_sparse_mat), intent(out) :: b integer, intent(out) :: info end subroutine d_cp_cxx_to_fmt_impl end interface @@ -59,10 +59,10 @@ module psbn_d_cxx_mat_mod interface subroutine d_cp_cxx_from_fmt_impl(a,b,info) use psb_const_mod - use psbn_d_base_mat_mod - import psbn_d_cxx_sparse_mat - class(psbn_d_cxx_sparse_mat), intent(inout) :: a - class(psbn_d_base_sparse_mat), intent(in) :: b + use psb_d_base_mat_mod + import psb_d_cxx_sparse_mat + class(psb_d_cxx_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(in) :: b integer, intent(out) :: info end subroutine d_cp_cxx_from_fmt_impl end interface @@ -71,10 +71,10 @@ module psbn_d_cxx_mat_mod interface subroutine d_cp_cxx_to_coo_impl(a,b,info) use psb_const_mod - use psbn_d_base_mat_mod - import psbn_d_cxx_sparse_mat - class(psbn_d_cxx_sparse_mat), intent(in) :: a - class(psbn_d_coo_sparse_mat), intent(out) :: b + use psb_d_base_mat_mod + import psb_d_cxx_sparse_mat + class(psb_d_cxx_sparse_mat), intent(in) :: a + class(psb_d_coo_sparse_mat), intent(out) :: b integer, intent(out) :: info end subroutine d_cp_cxx_to_coo_impl end interface @@ -82,10 +82,10 @@ module psbn_d_cxx_mat_mod interface subroutine d_cp_cxx_from_coo_impl(a,b,info) use psb_const_mod - use psbn_d_base_mat_mod - import psbn_d_cxx_sparse_mat - class(psbn_d_cxx_sparse_mat), intent(inout) :: a - class(psbn_d_coo_sparse_mat), intent(in) :: b + use psb_d_base_mat_mod + import psb_d_cxx_sparse_mat + class(psb_d_cxx_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(in) :: b integer, intent(out) :: info end subroutine d_cp_cxx_from_coo_impl end interface @@ -93,10 +93,10 @@ module psbn_d_cxx_mat_mod interface subroutine d_mv_cxx_to_fmt_impl(a,b,info) use psb_const_mod - use psbn_d_base_mat_mod - import psbn_d_cxx_sparse_mat - class(psbn_d_cxx_sparse_mat), intent(inout) :: a - class(psbn_d_base_sparse_mat), intent(out) :: b + use psb_d_base_mat_mod + import psb_d_cxx_sparse_mat + class(psb_d_cxx_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(out) :: b integer, intent(out) :: info end subroutine d_mv_cxx_to_fmt_impl end interface @@ -104,10 +104,10 @@ module psbn_d_cxx_mat_mod interface subroutine d_mv_cxx_from_fmt_impl(a,b,info) use psb_const_mod - use psbn_d_base_mat_mod - import psbn_d_cxx_sparse_mat - class(psbn_d_cxx_sparse_mat), intent(inout) :: a - class(psbn_d_base_sparse_mat), intent(inout) :: b + use psb_d_base_mat_mod + import psb_d_cxx_sparse_mat + class(psb_d_cxx_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(inout) :: b integer, intent(out) :: info end subroutine d_mv_cxx_from_fmt_impl end interface @@ -116,10 +116,10 @@ module psbn_d_cxx_mat_mod interface subroutine d_mv_cxx_to_coo_impl(a,b,info) use psb_const_mod - use psbn_d_base_mat_mod - import psbn_d_cxx_sparse_mat - class(psbn_d_cxx_sparse_mat), intent(inout) :: a - class(psbn_d_coo_sparse_mat), intent(out) :: b + use psb_d_base_mat_mod + import psb_d_cxx_sparse_mat + class(psb_d_cxx_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(out) :: b integer, intent(out) :: info end subroutine d_mv_cxx_to_coo_impl end interface @@ -127,10 +127,10 @@ module psbn_d_cxx_mat_mod interface subroutine d_mv_cxx_from_coo_impl(a,b,info) use psb_const_mod - use psbn_d_base_mat_mod - import psbn_d_cxx_sparse_mat - class(psbn_d_cxx_sparse_mat), intent(inout) :: a - class(psbn_d_coo_sparse_mat), intent(inout) :: b + use psb_d_base_mat_mod + import psb_d_cxx_sparse_mat + class(psb_d_cxx_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(inout) :: b integer, intent(out) :: info end subroutine d_mv_cxx_from_coo_impl end interface @@ -138,8 +138,8 @@ module psbn_d_cxx_mat_mod interface subroutine d_cxx_csput_impl(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) use psb_const_mod - import psbn_d_cxx_sparse_mat - class(psbn_d_cxx_sparse_mat), intent(inout) :: a + import psb_d_cxx_sparse_mat + class(psb_d_cxx_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 @@ -151,10 +151,10 @@ module psbn_d_cxx_mat_mod subroutine d_cxx_csgetrow_impl(imin,imax,a,nz,ia,ja,val,info,& & jmin,jmax,iren,append,nzin,rscale,cscale) use psb_const_mod - import psbn_d_cxx_sparse_mat + import psb_d_cxx_sparse_mat implicit none - class(psbn_d_cxx_sparse_mat), intent(in) :: a + class(psb_d_cxx_sparse_mat), intent(in) :: a integer, intent(in) :: imin,imax integer, intent(out) :: nz integer, allocatable, intent(inout) :: ia(:), ja(:) @@ -170,8 +170,8 @@ module psbn_d_cxx_mat_mod interface d_cxx_cssm_impl subroutine d_cxx_cssv_impl(alpha,a,x,beta,y,info,trans) use psb_const_mod - import psbn_d_cxx_sparse_mat - class(psbn_d_cxx_sparse_mat), intent(in) :: a + import psb_d_cxx_sparse_mat + class(psb_d_cxx_sparse_mat), intent(in) :: a real(psb_dpk_), intent(in) :: alpha, beta, x(:) real(psb_dpk_), intent(inout) :: y(:) integer, intent(out) :: info @@ -179,8 +179,8 @@ module psbn_d_cxx_mat_mod end subroutine d_cxx_cssv_impl subroutine d_cxx_cssm_impl(alpha,a,x,beta,y,info,trans) use psb_const_mod - import psbn_d_cxx_sparse_mat - class(psbn_d_cxx_sparse_mat), intent(in) :: a + import psb_d_cxx_sparse_mat + class(psb_d_cxx_sparse_mat), intent(in) :: a real(psb_dpk_), intent(in) :: alpha, beta, x(:,:) real(psb_dpk_), intent(inout) :: y(:,:) integer, intent(out) :: info @@ -191,8 +191,8 @@ module psbn_d_cxx_mat_mod interface d_cxx_csmm_impl subroutine d_cxx_csmv_impl(alpha,a,x,beta,y,info,trans) use psb_const_mod - import psbn_d_cxx_sparse_mat - class(psbn_d_cxx_sparse_mat), intent(in) :: a + import psb_d_cxx_sparse_mat + class(psb_d_cxx_sparse_mat), intent(in) :: a real(psb_dpk_), intent(in) :: alpha, beta, x(:) real(psb_dpk_), intent(inout) :: y(:) integer, intent(out) :: info @@ -200,8 +200,8 @@ module psbn_d_cxx_mat_mod end subroutine d_cxx_csmv_impl subroutine d_cxx_csmm_impl(alpha,a,x,beta,y,info,trans) use psb_const_mod - import psbn_d_cxx_sparse_mat - class(psbn_d_cxx_sparse_mat), intent(in) :: a + import psb_d_cxx_sparse_mat + class(psb_d_cxx_sparse_mat), intent(in) :: a real(psb_dpk_), intent(in) :: alpha, beta, x(:,:) real(psb_dpk_), intent(inout) :: y(:,:) integer, intent(out) :: info @@ -212,8 +212,8 @@ module psbn_d_cxx_mat_mod interface d_cxx_csnmi_impl function d_cxx_csnmi_impl(a) result(res) use psb_const_mod - import psbn_d_cxx_sparse_mat - class(psbn_d_cxx_sparse_mat), intent(in) :: a + import psb_d_cxx_sparse_mat + class(psb_d_cxx_sparse_mat), intent(in) :: a real(psb_dpk_) :: res end function d_cxx_csnmi_impl end interface @@ -236,21 +236,21 @@ contains function d_cxx_get_fmt(a) result(res) implicit none - class(psbn_d_cxx_sparse_mat), intent(in) :: a + class(psb_d_cxx_sparse_mat), intent(in) :: a character(len=5) :: res res = 'CXX' end function d_cxx_get_fmt function d_cxx_get_nzeros(a) result(res) implicit none - class(psbn_d_cxx_sparse_mat), intent(in) :: a + class(psb_d_cxx_sparse_mat), intent(in) :: a integer :: res res = a%irp(a%m+1)-1 end function d_cxx_get_nzeros function d_cxx_get_size(a) result(res) implicit none - class(psbn_d_cxx_sparse_mat), intent(in) :: a + class(psb_d_cxx_sparse_mat), intent(in) :: a integer :: res res = -1 @@ -290,7 +290,7 @@ contains use psb_realloc_mod implicit none integer, intent(in) :: nz - class(psbn_d_cxx_sparse_mat), intent(inout) :: a + class(psb_d_cxx_sparse_mat), intent(inout) :: a Integer :: err_act, info character(len=20) :: name='d_cxx_reallocate_nz' logical, parameter :: debug=.false. @@ -323,7 +323,7 @@ contains use psb_const_mod use psb_error_mod implicit none - class(psbn_d_cxx_sparse_mat), intent(inout) :: a + class(psb_d_cxx_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 @@ -389,7 +389,7 @@ contains use psb_const_mod implicit none - class(psbn_d_cxx_sparse_mat), intent(in) :: a + class(psb_d_cxx_sparse_mat), intent(in) :: a integer, intent(in) :: imin,imax integer, intent(out) :: nz integer, allocatable, intent(inout) :: ia(:), ja(:) @@ -433,8 +433,8 @@ contains use psb_const_mod implicit none - class(psbn_d_cxx_sparse_mat), intent(in) :: a - class(psbn_d_coo_sparse_mat), intent(inout) :: b + class(psb_d_cxx_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 @@ -492,8 +492,8 @@ contains use psb_const_mod implicit none - class(psbn_d_cxx_sparse_mat), intent(in) :: a - class(psbn_d_coo_sparse_mat), intent(out) :: b + class(psb_d_cxx_sparse_mat), intent(in) :: a + class(psb_d_coo_sparse_mat), intent(out) :: b integer,intent(out) :: info integer, intent(in), optional :: imin,imax,jmin,jmax logical, intent(in), optional :: rscale,cscale @@ -578,7 +578,7 @@ contains subroutine d_cxx_free(a) implicit none - class(psbn_d_cxx_sparse_mat), intent(inout) :: a + class(psb_d_cxx_sparse_mat), intent(inout) :: a if (allocated(a%irp)) deallocate(a%irp) if (allocated(a%ja)) deallocate(a%ja) @@ -595,7 +595,7 @@ contains use psb_realloc_mod use psb_error_mod implicit none - class(psbn_d_cxx_sparse_mat), intent(inout) :: a + class(psb_d_cxx_sparse_mat), intent(inout) :: a Integer :: err_act, info, nz, m character(len=20) :: name='trim' logical, parameter :: debug=.false. @@ -628,8 +628,8 @@ contains use psb_error_mod use psb_realloc_mod implicit none - class(psbn_d_cxx_sparse_mat), intent(in) :: a - class(psbn_d_coo_sparse_mat), intent(out) :: b + class(psb_d_cxx_sparse_mat), intent(in) :: a + class(psb_d_coo_sparse_mat), intent(out) :: b integer, intent(out) :: info Integer :: err_act @@ -660,8 +660,8 @@ contains use psb_error_mod use psb_realloc_mod implicit none - class(psbn_d_cxx_sparse_mat), intent(inout) :: a - class(psbn_d_coo_sparse_mat), intent(in) :: b + class(psb_d_cxx_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(in) :: b integer, intent(out) :: info Integer :: err_act @@ -693,8 +693,8 @@ contains use psb_error_mod use psb_realloc_mod implicit none - class(psbn_d_cxx_sparse_mat), intent(in) :: a - class(psbn_d_base_sparse_mat), intent(out) :: b + class(psb_d_cxx_sparse_mat), intent(in) :: a + class(psb_d_base_sparse_mat), intent(out) :: b integer, intent(out) :: info Integer :: err_act @@ -725,8 +725,8 @@ contains use psb_error_mod use psb_realloc_mod implicit none - class(psbn_d_cxx_sparse_mat), intent(inout) :: a - class(psbn_d_base_sparse_mat), intent(in) :: b + class(psb_d_cxx_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(in) :: b integer, intent(out) :: info Integer :: err_act @@ -758,8 +758,8 @@ contains use psb_error_mod use psb_realloc_mod implicit none - class(psbn_d_cxx_sparse_mat), intent(inout) :: a - class(psbn_d_coo_sparse_mat), intent(out) :: b + class(psb_d_cxx_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(out) :: b integer, intent(out) :: info Integer :: err_act @@ -790,8 +790,8 @@ contains use psb_error_mod use psb_realloc_mod implicit none - class(psbn_d_cxx_sparse_mat), intent(inout) :: a - class(psbn_d_coo_sparse_mat), intent(inout) :: b + class(psb_d_cxx_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(inout) :: b integer, intent(out) :: info Integer :: err_act @@ -823,8 +823,8 @@ contains use psb_error_mod use psb_realloc_mod implicit none - class(psbn_d_cxx_sparse_mat), intent(inout) :: a - class(psbn_d_base_sparse_mat), intent(out) :: b + class(psb_d_cxx_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(out) :: b integer, intent(out) :: info Integer :: err_act @@ -855,8 +855,8 @@ contains use psb_error_mod use psb_realloc_mod implicit none - class(psbn_d_cxx_sparse_mat), intent(inout) :: a - class(psbn_d_base_sparse_mat), intent(inout) :: b + class(psb_d_cxx_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(inout) :: b integer, intent(out) :: info Integer :: err_act @@ -889,7 +889,7 @@ contains use psb_realloc_mod implicit none integer, intent(in) :: m,n - class(psbn_d_cxx_sparse_mat), intent(inout) :: a + class(psb_d_cxx_sparse_mat), intent(inout) :: a integer, intent(in), optional :: nz Integer :: err_act, info, nz_ character(len=20) :: name='allocate_mnz' @@ -949,7 +949,7 @@ contains implicit none integer, intent(in) :: iout - class(psbn_d_cxx_sparse_mat), intent(in) :: a + class(psb_d_cxx_sparse_mat), intent(in) :: a integer, intent(in), optional :: iv(:) integer, intent(in), optional :: eirs,eics character(len=*), optional :: head @@ -1042,7 +1042,7 @@ contains subroutine d_cxx_csmv(alpha,a,x,beta,y,info,trans) use psb_error_mod implicit none - class(psbn_d_cxx_sparse_mat), intent(in) :: a + class(psb_d_cxx_sparse_mat), intent(in) :: a real(psb_dpk_), intent(in) :: alpha, beta, x(:) real(psb_dpk_), intent(inout) :: y(:) integer, intent(out) :: info @@ -1086,7 +1086,7 @@ contains subroutine d_cxx_csmm(alpha,a,x,beta,y,info,trans) use psb_error_mod implicit none - class(psbn_d_cxx_sparse_mat), intent(in) :: a + class(psb_d_cxx_sparse_mat), intent(in) :: a real(psb_dpk_), intent(in) :: alpha, beta, x(:,:) real(psb_dpk_), intent(inout) :: y(:,:) integer, intent(out) :: info @@ -1126,7 +1126,7 @@ contains subroutine d_cxx_cssv(alpha,a,x,beta,y,info,trans) use psb_error_mod implicit none - class(psbn_d_cxx_sparse_mat), intent(in) :: a + class(psb_d_cxx_sparse_mat), intent(in) :: a real(psb_dpk_), intent(in) :: alpha, beta, x(:) real(psb_dpk_), intent(inout) :: y(:) integer, intent(out) :: info @@ -1180,7 +1180,7 @@ contains subroutine d_cxx_cssm(alpha,a,x,beta,y,info,trans) use psb_error_mod implicit none - class(psbn_d_cxx_sparse_mat), intent(in) :: a + class(psb_d_cxx_sparse_mat), intent(in) :: a real(psb_dpk_), intent(in) :: alpha, beta, x(:,:) real(psb_dpk_), intent(inout) :: y(:,:) integer, intent(out) :: info @@ -1231,7 +1231,7 @@ contains use psb_error_mod use psb_const_mod implicit none - class(psbn_d_cxx_sparse_mat), intent(in) :: a + class(psb_d_cxx_sparse_mat), intent(in) :: a real(psb_dpk_) :: res Integer :: err_act @@ -1249,7 +1249,7 @@ contains use psb_error_mod use psb_const_mod implicit none - class(psbn_d_cxx_sparse_mat), intent(in) :: a + class(psb_d_cxx_sparse_mat), intent(in) :: a real(psb_dpk_), intent(out) :: d(:) integer, intent(out) :: info @@ -1297,7 +1297,7 @@ contains use psb_error_mod use psb_const_mod implicit none - class(psbn_d_cxx_sparse_mat), intent(inout) :: a + class(psb_d_cxx_sparse_mat), intent(inout) :: a real(psb_dpk_), intent(in) :: d(:) integer, intent(out) :: info @@ -1339,7 +1339,7 @@ contains use psb_error_mod use psb_const_mod implicit none - class(psbn_d_cxx_sparse_mat), intent(inout) :: a + class(psb_d_cxx_sparse_mat), intent(inout) :: a real(psb_dpk_), intent(in) :: d integer, intent(out) :: info @@ -1370,4 +1370,4 @@ contains -end module psbn_d_cxx_mat_mod +end module psb_d_cxx_mat_mod